--- a/BCompiler.st Mon Jan 17 10:14:07 1994 +0100
+++ b/BCompiler.st Fri Feb 25 13:52:15 1994 +0100
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.8 1994-01-16 03:51:28 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.9 1994-02-25 12:50:45 claus Exp $
'!
!ByteCodeCompiler class methodsFor:'documentation'!
@@ -128,8 +128,7 @@
If skipIsSame is true, and the source is the same as an existing
methods source, this is a noop (for fast fileIn)."
- |compiler newMethod tree lits machineCode
- symbolicCodeArray sharedCode sharedCodeSymbol oldMethod|
+ |compiler newMethod tree lits symbolicCodeArray oldMethod|
aString isNil ifTrue:[^ nil].
@@ -191,29 +190,6 @@
^ #Error
].
- (OperatingSystem getSystemType = 'hpux') ifFalse:[
- "check for primitive code"
- compiler primitiveNumber notNil ifTrue:[
- machineCode := compiler checkForPrimitiveCode:compiler primitiveNumber.
- machineCode isNil ifTrue:[
- Transcript showCr:'primitive ', compiler primitiveNumber printString , ' is not supported'.
- ^ #Error
- ]
- ].
-
- machineCode isNil ifTrue:[
- "check for shared-code (only trivial methods)"
-
- sharedCodeSymbol := compiler checkForSharedCode:symbolicCodeArray.
- sharedCodeSymbol notNil ifTrue:[
- sharedCode := self sharedCodeFunctionFor:sharedCodeSymbol
- ].
- "try to make it machine code"
-
- machineCode := compiler checkForMachineCode:symbolicCodeArray
- ].
- ].
-
"finally create the new method-object"
newMethod := Method new.
@@ -224,14 +200,6 @@
newMethod literals:lits
].
newMethod byteCode:(compiler code).
- sharedCode notNil ifTrue:[
- newMethod code:sharedCode
- ] ifFalse:[
- machineCode notNil ifTrue:[
- newMethod code:machineCode.
- newMethod dynamic:true
- ]
- ].
newMethod source:aString.
newMethod category:cat.
newMethod numberOfMethodVars:(compiler numberOfMethodVars).
@@ -249,6 +217,23 @@
^ newMethod
! !
+!ByteCodeCompiler class methodsFor:'constants'!
+
+byteCodeFor:aSymbol
+ "only some exported codes handled here (for BlockNode)"
+
+ (aSymbol == #blockRetTop) ifTrue:[^ 6].
+ (aSymbol == #push0) ifTrue:[^120].
+ (aSymbol == #push1) ifTrue:[^121].
+ (aSymbol == #push2) ifTrue:[^139].
+ (aSymbol == #pushMinus1) ifTrue:[^122].
+ (aSymbol == #pushNil) ifTrue:[^ 10].
+ (aSymbol == #pushTrue) ifTrue:[^ 11].
+ (aSymbol == #pushFalse) ifTrue:[^ 12].
+ (aSymbol == #pushSelf) ifTrue:[^ 15].
+ self error
+! !
+
!ByteCodeCompiler methodsFor:'accessing'!
literalArray
@@ -953,1007 +938,3 @@
self error:'invalid code symbol'.
errorFlag := #Error
! !
-
-!ByteCodeCompiler class methodsFor:'machine code constants'!
-
-sharedCodeFunctionFor:aSymbol
- "return the address of a shared code-function;
- the code below looks ugly, but adds some speed to instvar-access
- methods"
-
- |codeSymbol|
-
- (aSymbol == #retSelf) ifTrue:[
-%{
- extern OBJ __retSelf();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retSelf;
-#endif
- RETURN ( _MKSMALLINT((int)__retSelf) );
-%}
- ].
- (aSymbol == #retNil) ifTrue:[
-%{
- extern OBJ __retNil();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retNil;
-#endif
- RETURN ( _MKSMALLINT((int)__retNil) );
-%}
- ].
- (aSymbol == #retTrue) ifTrue:[
-%{
- extern OBJ __retTrue();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retTrue;
-#endif
- RETURN ( _MKSMALLINT((int)__retTrue) );
-%}
- ].
- (aSymbol == #retFalse) ifTrue:[
-%{
- extern OBJ __retFalse();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retFalse;
-#endif
- RETURN ( _MKSMALLINT((int)__retFalse) );
-%}
- ].
- (aSymbol == #ret0) ifTrue:[
-%{
- extern OBJ __ret0();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __ret0;
-#endif
- RETURN ( _MKSMALLINT((int)__ret0) );
-%}
- ].
- (aSymbol == #blockRet0) ifTrue:[
-%{
- extern OBJ __bRet0();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __bRet0;
-#endif
- RETURN ( _MKSMALLINT((int)__bRet0) );
-%}
- ].
- (aSymbol == #blockRetNil) ifTrue:[
-%{
- extern OBJ __bRetNil();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __bRetNil;
-#endif
- RETURN ( _MKSMALLINT((int)__bRetNil) );
-%}
- ].
- (aSymbol == #blockRetTrue) ifTrue:[
-%{
- extern OBJ __bRetTrue();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __bRetTrue;
-#endif
- RETURN ( _MKSMALLINT((int)__bRetTrue) );
-%}
- ].
- (aSymbol == #blockRetFalse) ifTrue:[
-%{
- extern OBJ __bRetFalse();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __bRetFalse;
-#endif
- RETURN ( _MKSMALLINT((int)__bRetFalse) );
-%}
- ].
- (aSymbol == #retInstVar1) ifTrue:[
-%{
- extern OBJ __retInst0();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst0;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst0) );
-%}
- ].
- (aSymbol == #retInstVar2) ifTrue:[
-%{
- extern OBJ __retInst1();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst1;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst1) );
-%}
- ].
- (aSymbol == #retInstVar3) ifTrue:[
-%{
- extern OBJ __retInst2();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst2;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst2) );
-%}
- ].
- (aSymbol == #retInstVar4) ifTrue:[
-%{
- extern OBJ __retInst3();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst3;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst3) );
-%}
- ].
- (aSymbol == #retInstVar5) ifTrue:[
-%{
- extern OBJ __retInst4();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst4;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst4) );
-%}
- ].
- (aSymbol == #retInstVar6) ifTrue:[
-%{
- extern OBJ __retInst5();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst5;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst5) );
-%}
- ].
- (aSymbol == #retInstVar7) ifTrue:[
-%{
- extern OBJ __retInst6();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst6;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst6) );
-%}
- ].
- (aSymbol == #retInstVar8) ifTrue:[
-%{
- extern OBJ __retInst7();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst7;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst7) );
-%}
- ].
- (aSymbol == #retInstVar9) ifTrue:[
-%{
- extern OBJ __retInst8();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst8;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst8) );
-%}
- ].
- (aSymbol == #retInstVar10) ifTrue:[
-%{
- extern OBJ __retInst9();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst9;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst9) );
-%}
- ].
- (aSymbol == #retInstVar11) ifTrue:[
-%{
- extern OBJ __retInst10();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst10;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst10) );
-%}
- ].
- (aSymbol == #retInstVar12) ifTrue:[
-%{
- extern OBJ __retInst11();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst11;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst11) );
-%}
- ].
- (aSymbol == #retInstVar13) ifTrue:[
-%{
- extern OBJ __retInst12();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst12;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst12) );
-%}
- ].
- (aSymbol == #retInstVar14) ifTrue:[
-%{
- extern OBJ __retInst13();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst13;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst13) );
-%}
- ].
- (aSymbol == #retInstVar15) ifTrue:[
-%{
- extern OBJ __retInst14();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst14;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst14) );
-%}
- ].
- (aSymbol == #retInstVar16) ifTrue:[
-%{
- extern OBJ __retInst15();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst15;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst15) );
-%}
- ].
- (aSymbol == #retInstVar17) ifTrue:[
-%{
- extern OBJ __retInst16();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst16;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst16) );
-%}
- ].
- (aSymbol == #retInstVar18) ifTrue:[
-%{
- extern OBJ __retInst17();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst17;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst17) );
-%}
- ].
- (aSymbol == #retInstVar19) ifTrue:[
-%{
- extern OBJ __retInst18();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst18;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst18) );
-%}
- ].
- (aSymbol == #retInstVar20) ifTrue:[
-%{
- extern OBJ __retInst19();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst19;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst19) );
-%}
- ].
- (aSymbol == #retInstVar21) ifTrue:[
-%{
- extern OBJ __retInst20();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst20;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst20) );
-%}
- ].
- (aSymbol == #retInstVar22) ifTrue:[
-%{
- extern OBJ __retInst21();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst21;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst21) );
-%}
- ].
- (aSymbol == #retInstVar23) ifTrue:[
-%{
- extern OBJ __retInst22();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst22;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst22) );
-%}
- ].
- (aSymbol == #retInstVar24) ifTrue:[
-%{
- extern OBJ __retInst23();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst23;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst23) );
-%}
- ].
- (aSymbol == #retInstVar25) ifTrue:[
-%{
- extern OBJ __retInst24();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst24;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst24) );
-%}
- ].
- (aSymbol == #retInstVar26) ifTrue:[
-%{
- extern OBJ __retInst25();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst25;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst25) );
-%}
- ].
- (aSymbol == #retInstVar27) ifTrue:[
-%{
- extern OBJ __retInst26();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst26;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst26) );
-%}
- ].
- (aSymbol == #retInstVar28) ifTrue:[
-%{
- extern OBJ __retInst27();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst27;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst27) );
-%}
- ].
- (aSymbol == #retInstVar29) ifTrue:[
-%{
- extern OBJ __retInst28();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst28;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst28) );
-%}
- ].
- (aSymbol == #retInstVar30) ifTrue:[
-%{
- extern OBJ __retInst29();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst29;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst29) );
-%}
- ].
- (aSymbol == #retInstVar31) ifTrue:[
-%{
- extern OBJ __retInst30();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst30;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst30) );
-%}
- ].
-
- (aSymbol == #storeInstVar1) ifTrue:[
-%{
- extern OBJ __setInst0();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst0;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst0) );
-%}
- ].
- (aSymbol == #storeInstVar2) ifTrue:[
-%{
- extern OBJ __setInst1();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst1;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst1) );
-%}
- ].
- (aSymbol == #storeInstVar3) ifTrue:[
-%{
- extern OBJ __setInst2();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst2;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst2) );
-%}
- ].
- (aSymbol == #storeInstVar4) ifTrue:[
-%{
- extern OBJ __setInst3();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst3;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst3) );
-%}
- ].
- (aSymbol == #storeInstVar5) ifTrue:[
-%{
- extern OBJ __setInst4();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst4;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst4) );
-%}
- ].
- (aSymbol == #storeInstVar6) ifTrue:[
-%{
- extern OBJ __setInst5();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst5;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst5) );
-%}
- ].
- (aSymbol == #storeInstVar7) ifTrue:[
-%{
- extern OBJ __setInst6();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst6;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst6) );
-%}
- ].
- (aSymbol == #storeInstVar8) ifTrue:[
-%{
- extern OBJ __setInst7();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst7;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst7) );
-%}
- ].
- (aSymbol == #storeInstVar9) ifTrue:[
-%{
- extern OBJ __setInst8();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst8;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst8) );
-%}
- ].
- (aSymbol == #storeInstVar10) ifTrue:[
-%{
- extern OBJ __setInst9();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst9;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst9) );
-%}
- ].
- (aSymbol == #storeInstVar11) ifTrue:[
-%{
- extern OBJ __setInst10();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst10;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst10) );
-%}
- ].
- (aSymbol == #storeInstVar12) ifTrue:[
-%{
- extern OBJ __setInst11();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst11;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst11) );
-%}
- ].
- (aSymbol == #storeInstVar13) ifTrue:[
-%{
- extern OBJ __setInst12();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst12;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst12) );
-%}
- ].
- (aSymbol == #storeInstVar13) ifTrue:[
-%{
- extern OBJ __setInst12();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst12;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst12) );
-%}
- ].
- (aSymbol == #storeInstVar14) ifTrue:[
-%{
- extern OBJ __setInst13();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst13;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst13) );
-%}
- ].
- (aSymbol == #storeInstVar15) ifTrue:[
-%{
- extern OBJ __setInst14();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst14;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst14) );
-%}
- ].
- (aSymbol == #storeInstVar16) ifTrue:[
-%{
- extern OBJ __setInst15();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst15;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst15) );
-%}
- ].
- (aSymbol == #storeInstVar17) ifTrue:[
-%{
- extern OBJ __setInst16();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst16;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst16) );
-%}
- ].
- (aSymbol == #storeInstVar18) ifTrue:[
-%{
- extern OBJ __setInst17();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst17;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst17) );
-%}
- ].
- (aSymbol == #storeInstVar19) ifTrue:[
-%{
- extern OBJ __setInst18();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst18;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst18) );
-%}
- ].
- (aSymbol == #storeInstVar20) ifTrue:[
-%{
- extern OBJ __setInst19();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst19;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst19) );
-%}
- ].
- (aSymbol == #storeInstVar21) ifTrue:[
-%{
- extern OBJ __setInst20();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst20;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst20) );
-%}
- ].
- (aSymbol == #storeInstVar22) ifTrue:[
-%{
- extern OBJ __setInst21();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst21;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst21) );
-%}
- ].
- (aSymbol == #storeInstVar23) ifTrue:[
-%{
- extern OBJ __setInst22();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst22;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst22) );
-%}
- ].
- (aSymbol == #storeInstVar23) ifTrue:[
-%{
- extern OBJ __setInst22();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst22;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst22) );
-%}
- ].
- (aSymbol == #storeInstVar24) ifTrue:[
-%{
- extern OBJ __setInst23();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst23;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst23) );
-%}
- ].
- (aSymbol == #storeInstVar25) ifTrue:[
-%{
- extern OBJ __setInst24();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst24;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst24) );
-%}
- ].
- (aSymbol == #storeInstVar26) ifTrue:[
-%{
- extern OBJ __setInst25();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst25;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst25) );
-%}
- ].
- (aSymbol == #storeInstVar27) ifTrue:[
-%{
- extern OBJ __setInst26();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst26;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst26) );
-%}
- ].
- (aSymbol == #storeInstVar28) ifTrue:[
-%{
- extern OBJ __setInst27();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst27;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst27) );
-%}
- ].
- (aSymbol == #storeInstVar29) ifTrue:[
-%{
- extern OBJ __setInst28();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst28;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst28) );
-%}
- ].
- (aSymbol == #storeInstVar30) ifTrue:[
-%{
- extern OBJ __setInst29();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst29;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst29) );
-%}
- ].
- (aSymbol == #storeInstVar31) ifTrue:[
-%{
- extern OBJ __setInst30();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst30;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst30) );
-%}
- ].
- ^ nil
-! !
-
-!ByteCodeCompiler methodsFor:'machine code generation'!
-
-checkForSharedCode:symbolicCodeArray
- "if this method is a very simple one,
- we can use the shared compiled code"
-
- |codeSymbol nArgs index|
-
- symbolicCodeArray isNil ifTrue:[^ nil].
- codeSymbol := symbolicCodeArray at:1.
- nArgs := methodArgs size.
- (nArgs == 0) ifTrue:[
- (codeSymbol == #retSelf) ifTrue:[^ codeSymbol].
- (codeSymbol == #retTrue) ifTrue:[^ codeSymbol].
- (codeSymbol == #retFalse) ifTrue:[^ codeSymbol].
- (codeSymbol == #retNil) ifTrue:[^ codeSymbol].
- (codeSymbol == #ret0) ifTrue:[^ codeSymbol].
- ('retInstVar*' match:codeSymbol) ifTrue:[^ codeSymbol].
-
- (codeSymbol == #pushMethodArg1) ifTrue:[
- ((symbolicCodeArray at:2) == #storeInstVar) ifTrue:[
- index := symbolicCodeArray at:3.
- ((symbolicCodeArray at:4) == #retSelf) ifTrue:[
- ^ ('storeInstVar' , index printString) asSymbol
- ].
- ^ nil
- ].
- ('storeInstVar*' match:(symbolicCodeArray at:2)) ifTrue:[
- ((symbolicCodeArray at:3) == #retSelf) ifTrue:[^ symbolicCodeArray at:2]
- ].
- ^ nil
- ].
-
- codeSymbol == #pushInstVar ifTrue:[
- index := symbolicCodeArray at:2.
- (symbolicCodeArray at:3) == #retTop ifTrue:[
- ^ ('retInstVar' , index printString) asSymbol
- ].
- ^ nil
- ]
- ].
- ^ nil
-!
-
-checkForMachineCode:symbolicCodeArray
- "if this method is a simple one,
- we can compile it into machine code"
-
- |code1 code2 code3 name|
-
- symbolicCodeArray isNil ifTrue:[^ nil].
-
- code1 := symbolicCodeArray at:1.
- (code1 == #retNum) ifTrue:[
- ^ self codeForRetNum:(symbolicCodeArray at:2)
- ].
- (code1 == #pushNum) ifTrue:[
- code2 := symbolicCodeArray at:3.
- (code2 == #retTop) ifTrue:[
- ^ self codeForRetNum:(symbolicCodeArray at:2)
- ].
- ^ nil
- ].
- (code1 == #pushMethodArg1) ifTrue:[
- code2 := symbolicCodeArray at:2.
- ((code2 == #storeGlobal)
- or:[code2 == #storeClassVar]) ifTrue:[
- code3 := symbolicCodeArray at:4.
- (code3 == #retSelf) ifTrue:[
- name := symbolicCodeArray at:3.
- ^ self codeForSetCell:name
- ]
- ].
- ^ nil
- ].
- (code1 == #pushGlobal) ifTrue:[
- code2 := symbolicCodeArray at:8.
- (code2 == #retTop) ifTrue:[
- name := symbolicCodeArray at:2.
- ^ self codeForRetCell:name
- ].
- ^ nil
- ].
- (code1 == #pushClassVar) ifTrue:[
- code2 := symbolicCodeArray at:8.
- (code2 == #retTop) ifTrue:[
- name := symbolicCodeArray at:2.
- ^ self codeForRetCell:name
- ].
- ^ nil
- ].
- (code1 == #pushLit) ifTrue:[
- code2 := symbolicCodeArray at:3.
- (code2 == #retTop) ifTrue:[
- ^ nil
- ].
- ^ nil
- ].
- ^ nil
-!
-
-codeForRetNum:value
- "^ number will be coded into machine code"
-
- |count b conIndex tagHi newCode|
-
- count := self codeProtoForRetNumEnd - self codeProtoForRetNum.
-
- b := ExternalBytes address:(self codeProtoForRetNum).
-
- "search for sequence 0x92345678"
-
- tagHi := false.
- 1 to:count-3 do:[:index |
- (b at:index) == 16r92 ifTrue:[
- (b at:index+1) == 16r34 ifTrue:[
- (b at:index+2) == 16r56 ifTrue:[
- (b at:index+3) == 16r78 ifTrue:[
- conIndex := index.
- tagHi := true
- ]
- ]
- ]
- ]
- ].
-
- conIndex isNil ifTrue:["'search failed' printNewline. "^ nil].
- tagHi ifFalse:['low tag unsupported' printNewline. ^ nil].
-
- "allocate code ..."
-
- newCode := ExternalBytes newForText:count.
- newCode isNil ifTrue:[
- 'alloc of text (size ' print. count print. ') failed' printNewline.
- ^ nil
- ].
-
- "copy from proto"
- 1 to:count do:[:index |
- newCode at:index put:(b at:index)
- ].
- "put in ret-value"
- newCode at:conIndex put:((value bitShift:-24) bitAnd:16rFF).
- newCode at:conIndex+1 put:((value bitShift:-16) bitAnd:16rFF).
- newCode at:conIndex+2 put:((value bitShift:-8) bitAnd:16rFF).
- newCode at:conIndex+3 put:(value bitAnd:16rFF).
- tagHi ifTrue:[
- newCode at:conIndex
- put:((newCode at:conIndex) bitOr:16r80)
- ] ifFalse:[
- ].
-'address is:' print. (newCode address printStringRadix:16) printNewline.
- ^ newCode address
-
- "ByteCodeCompiler new codeForRetNum:15"
-!
-codeForRetCell:aGlobalOrClassVariableSymbol
- "^ global will be coded into machine code"
-
- |cell count b conIndex newCode msbFirst|
-
- cell := Smalltalk cellAt:aGlobalOrClassVariableSymbol.
- cell isNil ifTrue:[^ nil].
-
- count := self codeProtoForRetCellEnd - self codeProtoForRetCell.
-
- b := ExternalBytes address:(self codeProtoForRetCell).
-
- msbFirst := true.
-
- "search for sequence 0x12345678 // 78563412"
- 1 to:count - 3 do:[:index |
- (b at:index) == 16r12 ifTrue:[
- (b at:index+1) == 16r34 ifTrue:[
- (b at:index+2) == 16r56 ifTrue:[
- (b at:index+3) == 16r78 ifTrue:[
- conIndex := index
- ]
- ]
- ]
- ].
- conIndex isNil ifTrue:[
- (b at:index) == 16r78 ifTrue:[
- (b at:index+1) == 16r56 ifTrue:[
- (b at:index+2) == 16r34 ifTrue:[
- (b at:index+3) == 16r12 ifTrue:[
- conIndex := index.
- msbFirst := false
- ]
- ]
- ]
- ]
- ]
- ].
-
- conIndex isNil ifTrue:["'search failed' printNewline. " ^ nil].
-
- "allocate code ..."
-
- newCode := ExternalBytes newForText:count.
- newCode isNil ifTrue:['alloc of text (size ' print. count print. ') failed' printNewline.^ nil].
-
- "copy from proto"
- 1 to:count do:[:index |
- newCode at:index put:(b at:index)
- ].
- "put in cell address"
- msbFirst ifTrue:[
- newCode at:conIndex put:((cell bitShift:-24) bitAnd:16rFF).
- newCode at:conIndex+1 put:((cell bitShift:-16) bitAnd:16rFF).
- newCode at:conIndex+2 put:((cell bitShift:-8) bitAnd:16rFF).
- newCode at:conIndex+3 put:(cell bitAnd:16rFF).
- ] ifFalse:[
- newCode at:conIndex+3 put:((cell bitShift:-24) bitAnd:16rFF).
- newCode at:conIndex+2 put:((cell bitShift:-16) bitAnd:16rFF).
- newCode at:conIndex+1 put:((cell bitShift:-8) bitAnd:16rFF).
- newCode at:conIndex put:(cell bitAnd:16rFF).
- ].
-
-'address is:' print. (newCode address printStringRadix:16) printNewline.
- ^ newCode address
-
- "ByteCodeCompiler new codeForRetCell:#Transcript"
-!
-
-codeForSetCell:aGlobalOrClassVariableSymbol
- "global := arg will be coded into machine code"
-
- |cell count b conIndex newCode|
-
- cell := Smalltalk cellAt:aGlobalOrClassVariableSymbol.
- cell isNil ifTrue:[^ nil].
-
- count := self codeProtoForSetCellEnd - self codeProtoForSetCell.
-
- b := ExternalBytes address:(self codeProtoForSetCell).
-
- "search for sequence 0x12345678"
- 1 to:count - 3 do:[:index |
- (b at:index) == 16r12 ifTrue:[
- (b at:index+1) == 16r34 ifTrue:[
- (b at:index+2) == 16r56 ifTrue:[
- (b at:index+3) == 16r78 ifTrue:[
- conIndex := index
- ]
- ]
- ]
- ]
- ].
-
- conIndex isNil ifTrue:["'search failed' printNewline." ^ nil].
-
- "allocate code ..."
-
- newCode := ExternalBytes newForData:count.
- newCode isNil ifTrue:['alloc of data (size ' print. count print. ') failed' printNewline.^ nil].
-
- "copy from proto"
- 1 to:count do:[:index |
- newCode at:index put:(b at:index)
- ].
- "put in cell address"
- newCode at:conIndex put:((cell bitShift:-24) bitAnd:16rFF).
- newCode at:conIndex+1 put:((cell bitShift:-16) bitAnd:16rFF).
- newCode at:conIndex+2 put:((cell bitShift:-8) bitAnd:16rFF).
- newCode at:conIndex+3 put:(cell bitAnd:16rFF).
-
-'address is:' print. (newCode address printStringRadix:16) printNewline.
- ^ newCode address
-
- "ByteCodeCompiler new codeForSetCell:#xyz"
-!
-
-codeProtoForRetNum
-%{ /* NOCONTEXT */
- extern OBJ __retNumProto();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retNumProto;
-#endif
- RETURN ( _MKSMALLINT((int)__retNumProto) );
-%}
-!
-
-codeProtoForRetNumEnd
-%{ /* NOCONTEXT */
- extern OBJ __retNumProtoEnd();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retNumProtoEnd;
-#endif
- RETURN ( _MKSMALLINT((int)__retNumProtoEnd) );
-%}
-!
-
-codeProtoForRetCell
-%{ /* NOCONTEXT */
- extern OBJ __retCellProto();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retCellProto;
-#endif
- RETURN ( _MKSMALLINT((int)__retCellProto) );
-%}
-!
-
-codeProtoForRetCellEnd
-%{ /* NOCONTEXT */
- extern OBJ __retCellProtoEnd();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retCellProtoEnd;
-#endif
- RETURN ( _MKSMALLINT((int)__retCellProtoEnd) );
-%}
-!
-
-codeProtoForSetCell
-%{ /* NOCONTEXT */
- extern OBJ __setCellProto();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setCellProto;
-#endif
- RETURN ( _MKSMALLINT((int)__setCellProto) );
-%}
-!
-
-codeProtoForSetCellEnd
-%{ /* NOCONTEXT */
- extern OBJ __setCellProtoEnd();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setCellProtoEnd;
-#endif
- RETURN ( _MKSMALLINT((int)__setCellProtoEnd) );
-%}
-
-! !
--- a/BlockNode.st Mon Jan 17 10:14:07 1994 +0100
+++ b/BlockNode.st Fri Feb 25 13:52:15 1994 +0100
@@ -26,7 +26,7 @@
implement interpreted blocks
-$Header: /cvs/stx/stx/libcomp/BlockNode.st,v 1.4 1993-12-11 01:06:41 claus Exp $
+$Header: /cvs/stx/stx/libcomp/BlockNode.st,v 1.5 1994-02-25 12:51:06 claus Exp $
'!
!BlockNode class methodsFor:'instance creation'!
@@ -144,9 +144,9 @@
oldValue := (blockArgs at:1) value.
(blockArgs at:1) value:anArg.
- exitBlock := [:val |
+ exitBlock := [:v |
(blockArgs at:1) value:oldValue.
- ^ val
+ ^ v
].
val := statements evaluate.
@@ -168,10 +168,10 @@
(blockArgs at:1) value:arg1.
(blockArgs at:2) value:arg2.
- exitBlock := [:val |
+ exitBlock := [:v |
(blockArgs at:1) value:oldValue1.
(blockArgs at:2) value:oldValue2.
- ^ val
+ ^ v
].
val := statements evaluate.
@@ -196,11 +196,11 @@
(blockArgs at:2) value:arg2.
(blockArgs at:3) value:arg3.
- exitBlock := [:val |
+ exitBlock := [:v |
(blockArgs at:1) value:oldValue1.
(blockArgs at:2) value:oldValue2.
(blockArgs at:3) value:oldValue3.
- ^ val
+ ^ v
].
val := statements evaluate.
@@ -228,12 +228,12 @@
(blockArgs at:3) value:arg3.
(blockArgs at:4) value:arg4.
- exitBlock := [:val |
+ exitBlock := [:v |
(blockArgs at:1) value:oldValue1.
(blockArgs at:2) value:oldValue2.
(blockArgs at:3) value:oldValue3.
(blockArgs at:4) value:oldValue4.
- ^ val
+ ^ v
].
val := statements evaluate.
@@ -258,11 +258,11 @@
oldValues at:i put:(blockArgs at:i) value.
(blockArgs at:i) value:(argArray at:i).
].
- exitBlock := [:val |
+ exitBlock := [:v |
1 to:argArray size do:[:i |
( blockArgs at:i) value:(oldValues at:i)
].
- ^ val
+ ^ v
].
val := statements evaluate.
@@ -432,81 +432,74 @@
"simple things can be made cheap blocks right now -
resulting in a simple pushLit instruction ..."
- |cheapy e val|
+ |cheapy e val code|
statements isNil ifTrue:[
"a []-block"
- cheapy := Block code:(ByteCodeCompiler sharedCodeFunctionFor:#blockRetNil)
- byteCode:nil
+ cheapy := Block code:nil
+ byteCode:(ByteArray with:(ByteCodeCompiler byteCodeFor:#pushNil)
+ with:(ByteCodeCompiler byteCodeFor:#blockRetTop))
nargs:(blockArgs size)
sourcePosition:nil
initialPC:nil
literals:nil
- dynamic:true.
+ dynamic:false.
^ ConstantNode type:#Block value:cheapy
].
- statements nextStatement isNil ifTrue:[
- (statements isMemberOf:StatementNode) ifTrue:[
- e := statements expression.
- e isConstant ifTrue:[
- val := e value.
- val == 0 ifTrue:[
- "a [0]-block"
+ statements nextStatement notNil ifTrue:[^ nil].
+ (statements isMemberOf:StatementNode) ifFalse:[^ nil].
- cheapy := Block code:(ByteCodeCompiler sharedCodeFunctionFor:#blockRet0)
- byteCode:nil
- nargs:(blockArgs size)
- sourcePosition:nil
- initialPC:nil
- literals:nil
- dynamic:true.
- ^ ConstantNode type:#Block value:cheapy
- ].
- val == true ifTrue:[
- "a [true]-block"
+ e := statements expression.
+ e isConstant ifFalse:[^ nil].
- cheapy := Block code:(ByteCodeCompiler sharedCodeFunctionFor:#blockRetTrue)
- byteCode:nil
- nargs:(blockArgs size)
- sourcePosition:nil
- initialPC:nil
- literals:nil
- dynamic:true.
- ^ ConstantNode type:#Block value:cheapy
- ].
- val == false ifTrue:[
- "a [false]-block"
+ val := e value.
+ val == 0 ifTrue:[
+ "a [0]-block"
- cheapy := Block code:(ByteCodeCompiler sharedCodeFunctionFor:#blockRetFalse)
- byteCode:nil
- nargs:(blockArgs size)
- sourcePosition:nil
- initialPC:nil
- literals:nil
- dynamic:true.
- ^ ConstantNode type:#Block value:cheapy
- ].
- val == nil ifTrue:[
- "a [nil]-block"
+ code := ByteArray with:(ByteCodeCompiler byteCodeFor:#push0)
+ with:(ByteCodeCompiler byteCodeFor:#blockRetTop).
+ ].
+ val == 1 ifTrue:[
+ "a [1]-block"
- cheapy := Block code:(ByteCodeCompiler sharedCodeFunctionFor:#blockRetNil)
- byteCode:nil
- nargs:(blockArgs size)
- sourcePosition:nil
- initialPC:nil
- literals:nil
- dynamic:true.
- ^ ConstantNode type:#Block value:cheapy
- ]
- ]
- ]
+ code := ByteArray with:(ByteCodeCompiler byteCodeFor:#push1)
+ with:(ByteCodeCompiler byteCodeFor:#blockRetTop).
].
-"
- statements printOn:Transcript.
-"
+ val == true ifTrue:[
+ "a [true]-block"
+
+ code := ByteArray with:(ByteCodeCompiler byteCodeFor:#pushTrue)
+ with:(ByteCodeCompiler byteCodeFor:#blockRetTop).
+ ].
+
+ val == false ifTrue:[
+ "a [false]-block"
+
+ code := ByteArray with:(ByteCodeCompiler byteCodeFor:#pushFalse)
+ with:(ByteCodeCompiler byteCodeFor:#blockRetTop).
+ ].
+
+ val == nil ifTrue:[
+ "a [nil]-block"
+
+ code := ByteArray with:(ByteCodeCompiler byteCodeFor:#pushNil)
+ with:(ByteCodeCompiler byteCodeFor:#blockRetTop).
+ ].
+
+ code notNil ifTrue:[
+ cheapy := Block code:nil
+ byteCode:code
+ nargs:(blockArgs size)
+ sourcePosition:nil
+ initialPC:nil
+ literals:nil
+ dynamic:false.
+ ^ ConstantNode type:#Block value:cheapy
+ ].
+
^ nil
! !
--- a/ByteCodeCompiler.st Mon Jan 17 10:14:07 1994 +0100
+++ b/ByteCodeCompiler.st Fri Feb 25 13:52:15 1994 +0100
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.8 1994-01-16 03:51:28 claus Exp $
+$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.9 1994-02-25 12:50:45 claus Exp $
'!
!ByteCodeCompiler class methodsFor:'documentation'!
@@ -128,8 +128,7 @@
If skipIsSame is true, and the source is the same as an existing
methods source, this is a noop (for fast fileIn)."
- |compiler newMethod tree lits machineCode
- symbolicCodeArray sharedCode sharedCodeSymbol oldMethod|
+ |compiler newMethod tree lits symbolicCodeArray oldMethod|
aString isNil ifTrue:[^ nil].
@@ -191,29 +190,6 @@
^ #Error
].
- (OperatingSystem getSystemType = 'hpux') ifFalse:[
- "check for primitive code"
- compiler primitiveNumber notNil ifTrue:[
- machineCode := compiler checkForPrimitiveCode:compiler primitiveNumber.
- machineCode isNil ifTrue:[
- Transcript showCr:'primitive ', compiler primitiveNumber printString , ' is not supported'.
- ^ #Error
- ]
- ].
-
- machineCode isNil ifTrue:[
- "check for shared-code (only trivial methods)"
-
- sharedCodeSymbol := compiler checkForSharedCode:symbolicCodeArray.
- sharedCodeSymbol notNil ifTrue:[
- sharedCode := self sharedCodeFunctionFor:sharedCodeSymbol
- ].
- "try to make it machine code"
-
- machineCode := compiler checkForMachineCode:symbolicCodeArray
- ].
- ].
-
"finally create the new method-object"
newMethod := Method new.
@@ -224,14 +200,6 @@
newMethod literals:lits
].
newMethod byteCode:(compiler code).
- sharedCode notNil ifTrue:[
- newMethod code:sharedCode
- ] ifFalse:[
- machineCode notNil ifTrue:[
- newMethod code:machineCode.
- newMethod dynamic:true
- ]
- ].
newMethod source:aString.
newMethod category:cat.
newMethod numberOfMethodVars:(compiler numberOfMethodVars).
@@ -249,6 +217,23 @@
^ newMethod
! !
+!ByteCodeCompiler class methodsFor:'constants'!
+
+byteCodeFor:aSymbol
+ "only some exported codes handled here (for BlockNode)"
+
+ (aSymbol == #blockRetTop) ifTrue:[^ 6].
+ (aSymbol == #push0) ifTrue:[^120].
+ (aSymbol == #push1) ifTrue:[^121].
+ (aSymbol == #push2) ifTrue:[^139].
+ (aSymbol == #pushMinus1) ifTrue:[^122].
+ (aSymbol == #pushNil) ifTrue:[^ 10].
+ (aSymbol == #pushTrue) ifTrue:[^ 11].
+ (aSymbol == #pushFalse) ifTrue:[^ 12].
+ (aSymbol == #pushSelf) ifTrue:[^ 15].
+ self error
+! !
+
!ByteCodeCompiler methodsFor:'accessing'!
literalArray
@@ -953,1007 +938,3 @@
self error:'invalid code symbol'.
errorFlag := #Error
! !
-
-!ByteCodeCompiler class methodsFor:'machine code constants'!
-
-sharedCodeFunctionFor:aSymbol
- "return the address of a shared code-function;
- the code below looks ugly, but adds some speed to instvar-access
- methods"
-
- |codeSymbol|
-
- (aSymbol == #retSelf) ifTrue:[
-%{
- extern OBJ __retSelf();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retSelf;
-#endif
- RETURN ( _MKSMALLINT((int)__retSelf) );
-%}
- ].
- (aSymbol == #retNil) ifTrue:[
-%{
- extern OBJ __retNil();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retNil;
-#endif
- RETURN ( _MKSMALLINT((int)__retNil) );
-%}
- ].
- (aSymbol == #retTrue) ifTrue:[
-%{
- extern OBJ __retTrue();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retTrue;
-#endif
- RETURN ( _MKSMALLINT((int)__retTrue) );
-%}
- ].
- (aSymbol == #retFalse) ifTrue:[
-%{
- extern OBJ __retFalse();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retFalse;
-#endif
- RETURN ( _MKSMALLINT((int)__retFalse) );
-%}
- ].
- (aSymbol == #ret0) ifTrue:[
-%{
- extern OBJ __ret0();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __ret0;
-#endif
- RETURN ( _MKSMALLINT((int)__ret0) );
-%}
- ].
- (aSymbol == #blockRet0) ifTrue:[
-%{
- extern OBJ __bRet0();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __bRet0;
-#endif
- RETURN ( _MKSMALLINT((int)__bRet0) );
-%}
- ].
- (aSymbol == #blockRetNil) ifTrue:[
-%{
- extern OBJ __bRetNil();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __bRetNil;
-#endif
- RETURN ( _MKSMALLINT((int)__bRetNil) );
-%}
- ].
- (aSymbol == #blockRetTrue) ifTrue:[
-%{
- extern OBJ __bRetTrue();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __bRetTrue;
-#endif
- RETURN ( _MKSMALLINT((int)__bRetTrue) );
-%}
- ].
- (aSymbol == #blockRetFalse) ifTrue:[
-%{
- extern OBJ __bRetFalse();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __bRetFalse;
-#endif
- RETURN ( _MKSMALLINT((int)__bRetFalse) );
-%}
- ].
- (aSymbol == #retInstVar1) ifTrue:[
-%{
- extern OBJ __retInst0();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst0;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst0) );
-%}
- ].
- (aSymbol == #retInstVar2) ifTrue:[
-%{
- extern OBJ __retInst1();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst1;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst1) );
-%}
- ].
- (aSymbol == #retInstVar3) ifTrue:[
-%{
- extern OBJ __retInst2();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst2;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst2) );
-%}
- ].
- (aSymbol == #retInstVar4) ifTrue:[
-%{
- extern OBJ __retInst3();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst3;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst3) );
-%}
- ].
- (aSymbol == #retInstVar5) ifTrue:[
-%{
- extern OBJ __retInst4();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst4;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst4) );
-%}
- ].
- (aSymbol == #retInstVar6) ifTrue:[
-%{
- extern OBJ __retInst5();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst5;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst5) );
-%}
- ].
- (aSymbol == #retInstVar7) ifTrue:[
-%{
- extern OBJ __retInst6();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst6;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst6) );
-%}
- ].
- (aSymbol == #retInstVar8) ifTrue:[
-%{
- extern OBJ __retInst7();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst7;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst7) );
-%}
- ].
- (aSymbol == #retInstVar9) ifTrue:[
-%{
- extern OBJ __retInst8();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst8;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst8) );
-%}
- ].
- (aSymbol == #retInstVar10) ifTrue:[
-%{
- extern OBJ __retInst9();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst9;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst9) );
-%}
- ].
- (aSymbol == #retInstVar11) ifTrue:[
-%{
- extern OBJ __retInst10();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst10;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst10) );
-%}
- ].
- (aSymbol == #retInstVar12) ifTrue:[
-%{
- extern OBJ __retInst11();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst11;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst11) );
-%}
- ].
- (aSymbol == #retInstVar13) ifTrue:[
-%{
- extern OBJ __retInst12();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst12;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst12) );
-%}
- ].
- (aSymbol == #retInstVar14) ifTrue:[
-%{
- extern OBJ __retInst13();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst13;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst13) );
-%}
- ].
- (aSymbol == #retInstVar15) ifTrue:[
-%{
- extern OBJ __retInst14();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst14;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst14) );
-%}
- ].
- (aSymbol == #retInstVar16) ifTrue:[
-%{
- extern OBJ __retInst15();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst15;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst15) );
-%}
- ].
- (aSymbol == #retInstVar17) ifTrue:[
-%{
- extern OBJ __retInst16();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst16;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst16) );
-%}
- ].
- (aSymbol == #retInstVar18) ifTrue:[
-%{
- extern OBJ __retInst17();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst17;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst17) );
-%}
- ].
- (aSymbol == #retInstVar19) ifTrue:[
-%{
- extern OBJ __retInst18();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst18;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst18) );
-%}
- ].
- (aSymbol == #retInstVar20) ifTrue:[
-%{
- extern OBJ __retInst19();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst19;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst19) );
-%}
- ].
- (aSymbol == #retInstVar21) ifTrue:[
-%{
- extern OBJ __retInst20();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst20;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst20) );
-%}
- ].
- (aSymbol == #retInstVar22) ifTrue:[
-%{
- extern OBJ __retInst21();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst21;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst21) );
-%}
- ].
- (aSymbol == #retInstVar23) ifTrue:[
-%{
- extern OBJ __retInst22();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst22;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst22) );
-%}
- ].
- (aSymbol == #retInstVar24) ifTrue:[
-%{
- extern OBJ __retInst23();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst23;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst23) );
-%}
- ].
- (aSymbol == #retInstVar25) ifTrue:[
-%{
- extern OBJ __retInst24();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst24;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst24) );
-%}
- ].
- (aSymbol == #retInstVar26) ifTrue:[
-%{
- extern OBJ __retInst25();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst25;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst25) );
-%}
- ].
- (aSymbol == #retInstVar27) ifTrue:[
-%{
- extern OBJ __retInst26();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst26;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst26) );
-%}
- ].
- (aSymbol == #retInstVar28) ifTrue:[
-%{
- extern OBJ __retInst27();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst27;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst27) );
-%}
- ].
- (aSymbol == #retInstVar29) ifTrue:[
-%{
- extern OBJ __retInst28();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst28;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst28) );
-%}
- ].
- (aSymbol == #retInstVar30) ifTrue:[
-%{
- extern OBJ __retInst29();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst29;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst29) );
-%}
- ].
- (aSymbol == #retInstVar31) ifTrue:[
-%{
- extern OBJ __retInst30();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retInst30;
-#endif
- RETURN ( _MKSMALLINT((int)__retInst30) );
-%}
- ].
-
- (aSymbol == #storeInstVar1) ifTrue:[
-%{
- extern OBJ __setInst0();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst0;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst0) );
-%}
- ].
- (aSymbol == #storeInstVar2) ifTrue:[
-%{
- extern OBJ __setInst1();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst1;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst1) );
-%}
- ].
- (aSymbol == #storeInstVar3) ifTrue:[
-%{
- extern OBJ __setInst2();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst2;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst2) );
-%}
- ].
- (aSymbol == #storeInstVar4) ifTrue:[
-%{
- extern OBJ __setInst3();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst3;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst3) );
-%}
- ].
- (aSymbol == #storeInstVar5) ifTrue:[
-%{
- extern OBJ __setInst4();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst4;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst4) );
-%}
- ].
- (aSymbol == #storeInstVar6) ifTrue:[
-%{
- extern OBJ __setInst5();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst5;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst5) );
-%}
- ].
- (aSymbol == #storeInstVar7) ifTrue:[
-%{
- extern OBJ __setInst6();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst6;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst6) );
-%}
- ].
- (aSymbol == #storeInstVar8) ifTrue:[
-%{
- extern OBJ __setInst7();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst7;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst7) );
-%}
- ].
- (aSymbol == #storeInstVar9) ifTrue:[
-%{
- extern OBJ __setInst8();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst8;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst8) );
-%}
- ].
- (aSymbol == #storeInstVar10) ifTrue:[
-%{
- extern OBJ __setInst9();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst9;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst9) );
-%}
- ].
- (aSymbol == #storeInstVar11) ifTrue:[
-%{
- extern OBJ __setInst10();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst10;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst10) );
-%}
- ].
- (aSymbol == #storeInstVar12) ifTrue:[
-%{
- extern OBJ __setInst11();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst11;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst11) );
-%}
- ].
- (aSymbol == #storeInstVar13) ifTrue:[
-%{
- extern OBJ __setInst12();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst12;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst12) );
-%}
- ].
- (aSymbol == #storeInstVar13) ifTrue:[
-%{
- extern OBJ __setInst12();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst12;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst12) );
-%}
- ].
- (aSymbol == #storeInstVar14) ifTrue:[
-%{
- extern OBJ __setInst13();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst13;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst13) );
-%}
- ].
- (aSymbol == #storeInstVar15) ifTrue:[
-%{
- extern OBJ __setInst14();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst14;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst14) );
-%}
- ].
- (aSymbol == #storeInstVar16) ifTrue:[
-%{
- extern OBJ __setInst15();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst15;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst15) );
-%}
- ].
- (aSymbol == #storeInstVar17) ifTrue:[
-%{
- extern OBJ __setInst16();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst16;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst16) );
-%}
- ].
- (aSymbol == #storeInstVar18) ifTrue:[
-%{
- extern OBJ __setInst17();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst17;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst17) );
-%}
- ].
- (aSymbol == #storeInstVar19) ifTrue:[
-%{
- extern OBJ __setInst18();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst18;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst18) );
-%}
- ].
- (aSymbol == #storeInstVar20) ifTrue:[
-%{
- extern OBJ __setInst19();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst19;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst19) );
-%}
- ].
- (aSymbol == #storeInstVar21) ifTrue:[
-%{
- extern OBJ __setInst20();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst20;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst20) );
-%}
- ].
- (aSymbol == #storeInstVar22) ifTrue:[
-%{
- extern OBJ __setInst21();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst21;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst21) );
-%}
- ].
- (aSymbol == #storeInstVar23) ifTrue:[
-%{
- extern OBJ __setInst22();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst22;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst22) );
-%}
- ].
- (aSymbol == #storeInstVar23) ifTrue:[
-%{
- extern OBJ __setInst22();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst22;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst22) );
-%}
- ].
- (aSymbol == #storeInstVar24) ifTrue:[
-%{
- extern OBJ __setInst23();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst23;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst23) );
-%}
- ].
- (aSymbol == #storeInstVar25) ifTrue:[
-%{
- extern OBJ __setInst24();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst24;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst24) );
-%}
- ].
- (aSymbol == #storeInstVar26) ifTrue:[
-%{
- extern OBJ __setInst25();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst25;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst25) );
-%}
- ].
- (aSymbol == #storeInstVar27) ifTrue:[
-%{
- extern OBJ __setInst26();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst26;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst26) );
-%}
- ].
- (aSymbol == #storeInstVar28) ifTrue:[
-%{
- extern OBJ __setInst27();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst27;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst27) );
-%}
- ].
- (aSymbol == #storeInstVar29) ifTrue:[
-%{
- extern OBJ __setInst28();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst28;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst28) );
-%}
- ].
- (aSymbol == #storeInstVar30) ifTrue:[
-%{
- extern OBJ __setInst29();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst29;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst29) );
-%}
- ].
- (aSymbol == #storeInstVar31) ifTrue:[
-%{
- extern OBJ __setInst30();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setInst30;
-#endif
- RETURN ( _MKSMALLINT((int)__setInst30) );
-%}
- ].
- ^ nil
-! !
-
-!ByteCodeCompiler methodsFor:'machine code generation'!
-
-checkForSharedCode:symbolicCodeArray
- "if this method is a very simple one,
- we can use the shared compiled code"
-
- |codeSymbol nArgs index|
-
- symbolicCodeArray isNil ifTrue:[^ nil].
- codeSymbol := symbolicCodeArray at:1.
- nArgs := methodArgs size.
- (nArgs == 0) ifTrue:[
- (codeSymbol == #retSelf) ifTrue:[^ codeSymbol].
- (codeSymbol == #retTrue) ifTrue:[^ codeSymbol].
- (codeSymbol == #retFalse) ifTrue:[^ codeSymbol].
- (codeSymbol == #retNil) ifTrue:[^ codeSymbol].
- (codeSymbol == #ret0) ifTrue:[^ codeSymbol].
- ('retInstVar*' match:codeSymbol) ifTrue:[^ codeSymbol].
-
- (codeSymbol == #pushMethodArg1) ifTrue:[
- ((symbolicCodeArray at:2) == #storeInstVar) ifTrue:[
- index := symbolicCodeArray at:3.
- ((symbolicCodeArray at:4) == #retSelf) ifTrue:[
- ^ ('storeInstVar' , index printString) asSymbol
- ].
- ^ nil
- ].
- ('storeInstVar*' match:(symbolicCodeArray at:2)) ifTrue:[
- ((symbolicCodeArray at:3) == #retSelf) ifTrue:[^ symbolicCodeArray at:2]
- ].
- ^ nil
- ].
-
- codeSymbol == #pushInstVar ifTrue:[
- index := symbolicCodeArray at:2.
- (symbolicCodeArray at:3) == #retTop ifTrue:[
- ^ ('retInstVar' , index printString) asSymbol
- ].
- ^ nil
- ]
- ].
- ^ nil
-!
-
-checkForMachineCode:symbolicCodeArray
- "if this method is a simple one,
- we can compile it into machine code"
-
- |code1 code2 code3 name|
-
- symbolicCodeArray isNil ifTrue:[^ nil].
-
- code1 := symbolicCodeArray at:1.
- (code1 == #retNum) ifTrue:[
- ^ self codeForRetNum:(symbolicCodeArray at:2)
- ].
- (code1 == #pushNum) ifTrue:[
- code2 := symbolicCodeArray at:3.
- (code2 == #retTop) ifTrue:[
- ^ self codeForRetNum:(symbolicCodeArray at:2)
- ].
- ^ nil
- ].
- (code1 == #pushMethodArg1) ifTrue:[
- code2 := symbolicCodeArray at:2.
- ((code2 == #storeGlobal)
- or:[code2 == #storeClassVar]) ifTrue:[
- code3 := symbolicCodeArray at:4.
- (code3 == #retSelf) ifTrue:[
- name := symbolicCodeArray at:3.
- ^ self codeForSetCell:name
- ]
- ].
- ^ nil
- ].
- (code1 == #pushGlobal) ifTrue:[
- code2 := symbolicCodeArray at:8.
- (code2 == #retTop) ifTrue:[
- name := symbolicCodeArray at:2.
- ^ self codeForRetCell:name
- ].
- ^ nil
- ].
- (code1 == #pushClassVar) ifTrue:[
- code2 := symbolicCodeArray at:8.
- (code2 == #retTop) ifTrue:[
- name := symbolicCodeArray at:2.
- ^ self codeForRetCell:name
- ].
- ^ nil
- ].
- (code1 == #pushLit) ifTrue:[
- code2 := symbolicCodeArray at:3.
- (code2 == #retTop) ifTrue:[
- ^ nil
- ].
- ^ nil
- ].
- ^ nil
-!
-
-codeForRetNum:value
- "^ number will be coded into machine code"
-
- |count b conIndex tagHi newCode|
-
- count := self codeProtoForRetNumEnd - self codeProtoForRetNum.
-
- b := ExternalBytes address:(self codeProtoForRetNum).
-
- "search for sequence 0x92345678"
-
- tagHi := false.
- 1 to:count-3 do:[:index |
- (b at:index) == 16r92 ifTrue:[
- (b at:index+1) == 16r34 ifTrue:[
- (b at:index+2) == 16r56 ifTrue:[
- (b at:index+3) == 16r78 ifTrue:[
- conIndex := index.
- tagHi := true
- ]
- ]
- ]
- ]
- ].
-
- conIndex isNil ifTrue:["'search failed' printNewline. "^ nil].
- tagHi ifFalse:['low tag unsupported' printNewline. ^ nil].
-
- "allocate code ..."
-
- newCode := ExternalBytes newForText:count.
- newCode isNil ifTrue:[
- 'alloc of text (size ' print. count print. ') failed' printNewline.
- ^ nil
- ].
-
- "copy from proto"
- 1 to:count do:[:index |
- newCode at:index put:(b at:index)
- ].
- "put in ret-value"
- newCode at:conIndex put:((value bitShift:-24) bitAnd:16rFF).
- newCode at:conIndex+1 put:((value bitShift:-16) bitAnd:16rFF).
- newCode at:conIndex+2 put:((value bitShift:-8) bitAnd:16rFF).
- newCode at:conIndex+3 put:(value bitAnd:16rFF).
- tagHi ifTrue:[
- newCode at:conIndex
- put:((newCode at:conIndex) bitOr:16r80)
- ] ifFalse:[
- ].
-'address is:' print. (newCode address printStringRadix:16) printNewline.
- ^ newCode address
-
- "ByteCodeCompiler new codeForRetNum:15"
-!
-codeForRetCell:aGlobalOrClassVariableSymbol
- "^ global will be coded into machine code"
-
- |cell count b conIndex newCode msbFirst|
-
- cell := Smalltalk cellAt:aGlobalOrClassVariableSymbol.
- cell isNil ifTrue:[^ nil].
-
- count := self codeProtoForRetCellEnd - self codeProtoForRetCell.
-
- b := ExternalBytes address:(self codeProtoForRetCell).
-
- msbFirst := true.
-
- "search for sequence 0x12345678 // 78563412"
- 1 to:count - 3 do:[:index |
- (b at:index) == 16r12 ifTrue:[
- (b at:index+1) == 16r34 ifTrue:[
- (b at:index+2) == 16r56 ifTrue:[
- (b at:index+3) == 16r78 ifTrue:[
- conIndex := index
- ]
- ]
- ]
- ].
- conIndex isNil ifTrue:[
- (b at:index) == 16r78 ifTrue:[
- (b at:index+1) == 16r56 ifTrue:[
- (b at:index+2) == 16r34 ifTrue:[
- (b at:index+3) == 16r12 ifTrue:[
- conIndex := index.
- msbFirst := false
- ]
- ]
- ]
- ]
- ]
- ].
-
- conIndex isNil ifTrue:["'search failed' printNewline. " ^ nil].
-
- "allocate code ..."
-
- newCode := ExternalBytes newForText:count.
- newCode isNil ifTrue:['alloc of text (size ' print. count print. ') failed' printNewline.^ nil].
-
- "copy from proto"
- 1 to:count do:[:index |
- newCode at:index put:(b at:index)
- ].
- "put in cell address"
- msbFirst ifTrue:[
- newCode at:conIndex put:((cell bitShift:-24) bitAnd:16rFF).
- newCode at:conIndex+1 put:((cell bitShift:-16) bitAnd:16rFF).
- newCode at:conIndex+2 put:((cell bitShift:-8) bitAnd:16rFF).
- newCode at:conIndex+3 put:(cell bitAnd:16rFF).
- ] ifFalse:[
- newCode at:conIndex+3 put:((cell bitShift:-24) bitAnd:16rFF).
- newCode at:conIndex+2 put:((cell bitShift:-16) bitAnd:16rFF).
- newCode at:conIndex+1 put:((cell bitShift:-8) bitAnd:16rFF).
- newCode at:conIndex put:(cell bitAnd:16rFF).
- ].
-
-'address is:' print. (newCode address printStringRadix:16) printNewline.
- ^ newCode address
-
- "ByteCodeCompiler new codeForRetCell:#Transcript"
-!
-
-codeForSetCell:aGlobalOrClassVariableSymbol
- "global := arg will be coded into machine code"
-
- |cell count b conIndex newCode|
-
- cell := Smalltalk cellAt:aGlobalOrClassVariableSymbol.
- cell isNil ifTrue:[^ nil].
-
- count := self codeProtoForSetCellEnd - self codeProtoForSetCell.
-
- b := ExternalBytes address:(self codeProtoForSetCell).
-
- "search for sequence 0x12345678"
- 1 to:count - 3 do:[:index |
- (b at:index) == 16r12 ifTrue:[
- (b at:index+1) == 16r34 ifTrue:[
- (b at:index+2) == 16r56 ifTrue:[
- (b at:index+3) == 16r78 ifTrue:[
- conIndex := index
- ]
- ]
- ]
- ]
- ].
-
- conIndex isNil ifTrue:["'search failed' printNewline." ^ nil].
-
- "allocate code ..."
-
- newCode := ExternalBytes newForData:count.
- newCode isNil ifTrue:['alloc of data (size ' print. count print. ') failed' printNewline.^ nil].
-
- "copy from proto"
- 1 to:count do:[:index |
- newCode at:index put:(b at:index)
- ].
- "put in cell address"
- newCode at:conIndex put:((cell bitShift:-24) bitAnd:16rFF).
- newCode at:conIndex+1 put:((cell bitShift:-16) bitAnd:16rFF).
- newCode at:conIndex+2 put:((cell bitShift:-8) bitAnd:16rFF).
- newCode at:conIndex+3 put:(cell bitAnd:16rFF).
-
-'address is:' print. (newCode address printStringRadix:16) printNewline.
- ^ newCode address
-
- "ByteCodeCompiler new codeForSetCell:#xyz"
-!
-
-codeProtoForRetNum
-%{ /* NOCONTEXT */
- extern OBJ __retNumProto();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retNumProto;
-#endif
- RETURN ( _MKSMALLINT((int)__retNumProto) );
-%}
-!
-
-codeProtoForRetNumEnd
-%{ /* NOCONTEXT */
- extern OBJ __retNumProtoEnd();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retNumProtoEnd;
-#endif
- RETURN ( _MKSMALLINT((int)__retNumProtoEnd) );
-%}
-!
-
-codeProtoForRetCell
-%{ /* NOCONTEXT */
- extern OBJ __retCellProto();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retCellProto;
-#endif
- RETURN ( _MKSMALLINT((int)__retCellProto) );
-%}
-!
-
-codeProtoForRetCellEnd
-%{ /* NOCONTEXT */
- extern OBJ __retCellProtoEnd();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __retCellProtoEnd;
-#endif
- RETURN ( _MKSMALLINT((int)__retCellProtoEnd) );
-%}
-!
-
-codeProtoForSetCell
-%{ /* NOCONTEXT */
- extern OBJ __setCellProto();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setCellProto;
-#endif
- RETURN ( _MKSMALLINT((int)__setCellProto) );
-%}
-!
-
-codeProtoForSetCellEnd
-%{ /* NOCONTEXT */
- extern OBJ __setCellProtoEnd();
-#if defined(SYSV4) && defined(i386)
- OBJ (*dummy)() = __setCellProtoEnd;
-#endif
- RETURN ( _MKSMALLINT((int)__setCellProtoEnd) );
-%}
-
-! !
--- a/CascadeNd.st Mon Jan 17 10:14:07 1994 +0100
+++ b/CascadeNd.st Fri Feb 25 13:52:15 1994 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/Attic/CascadeNd.st,v 1.4 1994-01-16 03:51:33 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/CascadeNd.st,v 1.5 1994-02-25 12:51:15 claus Exp $
'!
!CascadeNode methodsFor: 'code generation'!
@@ -38,6 +38,53 @@
self codeSendOn:aStream inBlock:b valueNeeded:false
! !
+!CascadeNode methodsFor: 'printing'!
+
+printOn:aStream indent:i
+ |needParen selectorParts index index2 arg nargs|
+
+ index := 1.
+ selectorParts := OrderedCollection new.
+ [index == 0] whileFalse:[
+ index2 := selector indexOf:$: startingAt:index.
+ index2 ~~ 0 ifTrue:[
+ selectorParts add:(selector copyFrom:index to:index2).
+ index2 := index2 + 1
+ ].
+ index := index2
+ ].
+
+ receiver printOn:aStream indent:i.
+ aStream nextPutAll:'; '.
+
+ nargs := argArray size.
+ nargs == 0 ifTrue:[
+ selector printOn:aStream
+ ] ifFalse:[
+ 1 to:nargs do:[:argIndex |
+ aStream space.
+ (selectorParts at:argIndex) printOn:aStream.
+ aStream space.
+ arg := argArray at:argIndex.
+ needParen := false.
+ arg isMessage ifTrue:[
+ arg isBinaryMessage ifFalse:[
+ arg isUnaryMessage ifFalse:[
+ needParen := true
+ ]
+ ].
+ ].
+ needParen ifTrue:[
+ aStream nextPutAll:'('
+ ].
+ arg printOn:aStream indent:i.
+ needParen ifTrue:[
+ aStream nextPutAll:') '
+ ].
+ ]
+ ]
+! !
+
!CascadeNode methodsFor: 'evaluating'!
evaluate
--- a/CascadeNode.st Mon Jan 17 10:14:07 1994 +0100
+++ b/CascadeNode.st Fri Feb 25 13:52:15 1994 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/CascadeNode.st,v 1.4 1994-01-16 03:51:33 claus Exp $
+$Header: /cvs/stx/stx/libcomp/CascadeNode.st,v 1.5 1994-02-25 12:51:15 claus Exp $
'!
!CascadeNode methodsFor: 'code generation'!
@@ -38,6 +38,53 @@
self codeSendOn:aStream inBlock:b valueNeeded:false
! !
+!CascadeNode methodsFor: 'printing'!
+
+printOn:aStream indent:i
+ |needParen selectorParts index index2 arg nargs|
+
+ index := 1.
+ selectorParts := OrderedCollection new.
+ [index == 0] whileFalse:[
+ index2 := selector indexOf:$: startingAt:index.
+ index2 ~~ 0 ifTrue:[
+ selectorParts add:(selector copyFrom:index to:index2).
+ index2 := index2 + 1
+ ].
+ index := index2
+ ].
+
+ receiver printOn:aStream indent:i.
+ aStream nextPutAll:'; '.
+
+ nargs := argArray size.
+ nargs == 0 ifTrue:[
+ selector printOn:aStream
+ ] ifFalse:[
+ 1 to:nargs do:[:argIndex |
+ aStream space.
+ (selectorParts at:argIndex) printOn:aStream.
+ aStream space.
+ arg := argArray at:argIndex.
+ needParen := false.
+ arg isMessage ifTrue:[
+ arg isBinaryMessage ifFalse:[
+ arg isUnaryMessage ifFalse:[
+ needParen := true
+ ]
+ ].
+ ].
+ needParen ifTrue:[
+ aStream nextPutAll:'('
+ ].
+ arg printOn:aStream indent:i.
+ needParen ifTrue:[
+ aStream nextPutAll:') '
+ ].
+ ]
+ ]
+! !
+
!CascadeNode methodsFor: 'evaluating'!
evaluate
--- a/Explainer.st Mon Jan 17 10:14:07 1994 +0100
+++ b/Explainer.st Fri Feb 25 13:52:15 1994 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/Explainer.st,v 1.2 1993-12-11 01:07:14 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Explainer.st,v 1.3 1994-02-25 12:51:26 claus Exp $
'!
!Explainer class methodsFor:'documentation'!
@@ -344,7 +344,7 @@
|class|
((className endsWith:'class') and:[className ~= 'Metaclass']) ifTrue:[
- class := Smalltalk at:(className copyFrom:1 to:(className size - 5)) asSymbol class
+ class := Smalltalk at:(className copyTo:(className size - 5)) asSymbol class
] ifFalse:[
class := Smalltalk at:(className asSymbol).
].
--- a/MessageNd.st Mon Jan 17 10:14:07 1994 +0100
+++ b/MessageNd.st Fri Feb 25 13:52:15 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/Attic/MessageNd.st,v 1.6 1994-01-16 03:51:36 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/MessageNd.st,v 1.7 1994-02-25 12:51:37 claus Exp $
'!
!MessageNode class methodsFor:'instance creation'!
@@ -46,13 +46,13 @@
(recNode isConstant and:[argNode isConstant]) ifTrue:[
"check if we can do it ..."
selectorString knownAsSymbol ifTrue:[
- (recNode respondsTo:selectorString asSymbol) ifTrue:[
+ selector := selectorString asSymbol.
+ (recNode respondsTo:selector) ifTrue:[
"we could do much more here - but then, we need a dependency from
the folded selectors method to the method we generate code for ...
limit optimizations to those that will never change
(or - if you change them - you will crash so bad ...)
"
- selector := selectorString asSymbol.
recVal := recNode evaluate.
argVal := argNode evaluate.
(recVal respondsToArithmetic and:[argVal respondsToArithmetic]) ifTrue:[
--- a/MessageNode.st Mon Jan 17 10:14:07 1994 +0100
+++ b/MessageNode.st Fri Feb 25 13:52:15 1994 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/MessageNode.st,v 1.6 1994-01-16 03:51:36 claus Exp $
+$Header: /cvs/stx/stx/libcomp/MessageNode.st,v 1.7 1994-02-25 12:51:37 claus Exp $
'!
!MessageNode class methodsFor:'instance creation'!
@@ -46,13 +46,13 @@
(recNode isConstant and:[argNode isConstant]) ifTrue:[
"check if we can do it ..."
selectorString knownAsSymbol ifTrue:[
- (recNode respondsTo:selectorString asSymbol) ifTrue:[
+ selector := selectorString asSymbol.
+ (recNode respondsTo:selector) ifTrue:[
"we could do much more here - but then, we need a dependency from
the folded selectors method to the method we generate code for ...
limit optimizations to those that will never change
(or - if you change them - you will crash so bad ...)
"
- selector := selectorString asSymbol.
recVal := recNode evaluate.
argVal := argNode evaluate.
(recVal respondsToArithmetic and:[argVal respondsToArithmetic]) ifTrue:[
--- a/ObjFLoader.st Mon Jan 17 10:14:07 1994 +0100
+++ b/ObjFLoader.st Fri Feb 25 13:52:15 1994 +0100
@@ -28,16 +28,41 @@
(goal is to allow loading of binary classes)
-$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.4 1994-01-08 17:05:10 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.5 1994-02-25 12:51:52 claus Exp $
'!
%{
+/*
+ * by default, use whatever the system provides
+ */
+#ifdef sunos
+# define SUN_DL
+#endif
+
#ifdef NeXT
+# define NEXT_DL
+#endif
+
+#ifdef SYSV4
+# define SYSV4_DL
+#endif
+
+/*
+ * but GNU_DL overwrites this
+ */
+#ifdef GNU_DL
+# undef SYSV4_DL
+# undef NEXT_DL
+# undef SUN_DL
+#endif
+
+#ifdef NEXT_DL
# ifndef _RLD_H_
# define _RLD_H_
# include <rld.h>
# endif
-#endif /* NeXT */
+#endif /* NEXT_DL */
+
static OBJ loadAddrLow, loadAddrHi;
%}
@@ -272,7 +297,7 @@
|baseName p t l handle address stubName|
stubName := 'stub000' , (StubNr printStringRadix:16).
- stubName := stubName copyFrom:(stubName size - 7) to:(stubName size).
+ stubName := stubName copyFrom:(stubName size - 7).
baseName := self createStubSource:stubName calling:functionName args:argTypes returning:returnType.
baseName isNil ifTrue:[^ nil].
@@ -454,11 +479,11 @@
^ true
].
(argType == #Float) ifTrue:[
- aStream nextPutAll:'_isFloat(' , argName , ')'.
+ aStream nextPutAll:'__isFloat(' , argName , ')'.
^ true
].
(argType == #String) ifTrue:[
- aStream nextPutAll:'_isString(' , argName , ')'.
+ aStream nextPutAll:'__isString(' , argName , ')'.
^ true
].
(argType == #Boolean) ifTrue:[
@@ -903,7 +928,7 @@
].
className := OperatingSystem baseNameOf:aFileName.
(className endsWith:'.o') ifTrue:[
- className := className copyFrom:1 to:(className size - 2)
+ className := className copyTo:(className size - 2)
].
OperatingSystem getOSType = 'sys5.4' ifTrue:[
symName := '_' , className , '_Init'
@@ -934,87 +959,104 @@
Return a non-nil handle if ok, nil otherwise.
This function is not supported on all architectures."
- |low hi|
+ |handle|
- "had to separate due to UNLIMITEDSTACK need"
- self primOpenDynamicObject:pathName.
-%{
- low = loadAddrLow;
- hi = loadAddrHi;
-%}
-.
- low notNil ifTrue:[
- ^ (hi * 16r10000) + low
- ].
-
- ^ nil
+ handle := self primOpenDynamicObject:pathName into:(Array new:2).
+ ^ handle
"sys5.4:
|handle|
handle := ObjectFileLoader openDynamicObject:'../stc/mod1.so'.
- ObjectFileLoader getSymbol:'module1' from:handle"
+ ObjectFileLoader getSymbol:'module1' from:handle
+ "
"next:
|handle|
handle := ObjectFileLoader openDynamicObject:'../goodies/Path/AbstrPath.o'.
- ObjectFileLoader getSymbol:'__AbstractPath_Init' from:handle"
+ ObjectFileLoader getSymbol:'__AbstractPath_Init' from:handle
+ "
+ "GLD:
+ |handle|
+ handle := ObjectFileLoader openDynamicObject:'../clients/Tetris/Tetris.o'.
+ ObjectFileLoader getSymbol:'__TetrisBlock_Init' from:handle
+ "
!
-primOpenDynamicObject:pathName
+primOpenDynamicObject:pathName into:aBuffer
"open an object-file (map into my address space).
- This function is not supported on all architectures."
+ This function is not supported on all architectures.
+ Dont depend on the returned value or class of it, it depends
+ on the underlying dynamic load package."
%{ /* UNLIMITEDSTACK */
-#ifdef SYSV4
+#ifdef GNU_DL
+# include "dld.h"
+ if (__isString(pathName)) {
+ if (dld_link(_stringVal(pathName))) {
+ dld_perror("cant link");
+ RETURN ( nil );
+ }
+ RETURN ( pathName );
+ }
+ RETURN ( nil );
+#endif
+
+#ifdef SYSV4_DL
+# include <dlfcn.h>
+ void *handle;
+
+ if ((pathName == nil) || __isString(pathName)) {
+ if (pathName == nil)
+ handle = dlopen((char *)0, RTLD_NOW);
+ else
+ handle = dlopen(_stringVal(pathName), RTLD_NOW);
+
+ if (! handle) {
+ printf("dlopen %s error: <%s>\n", _stringVal(pathName), dlerror());
+ RETURN (nil);
+ }
+
+ printf("open %s handle = %x\n", _stringVal(pathName), handle);
+ _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(1),
+ _MKSMALLINT( (int)handle & 0xFFFF ));
+ _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(2),
+ _MKSMALLINT( ((int)handle >> 16) & 0xFFFF ));
+ }
+#endif
+
+#ifdef SUN_DL
# include <dlfcn.h>
void *handle;
loadAddrLow = nil;
loadAddrHi = nil;
- if ((pathName == nil) || _isString(pathName)) {
- if (pathName == nil)
- handle = dlopen((char *)0, RTLD_NOW);
- else
- handle = dlopen(_stringVal(pathName), RTLD_NOW);
- if (handle) {
- printf("open %s handle = %x\n", _stringVal(pathName), handle);
- loadAddrLow = _MKSMALLINT( (int)handle & 0xFFFF );
- loadAddrHi = _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
- } else {
- printf("dlopen %s error: <%s>\n", _stringVal(pathName), dlerror());
- }
- RETURN ( self );
- }
-#endif
-#ifdef sunos
-# include <dlfcn.h>
- void *handle;
-
- loadAddrLow = nil;
- loadAddrHi = nil;
- if ((pathName == nil) || _isString(pathName)) {
+ if ((pathName == nil) || __isString(pathName)) {
if (pathName == nil)
handle = dlopen((char *)0, 1);
else
handle = dlopen(_stringVal(pathName), 1);
- if (handle) {
- printf("open %s handle = %x\n", _stringVal(pathName), handle);
- loadAddrLow = _MKSMALLINT( (int)handle & 0xFFFF );
- loadAddrHi = _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
- } else {
+
+ if (! handle) {
printf("dlopen %s error: <%s>\n", _stringVal(pathName), dlerror());
+ RETURN (nil);
}
- RETURN ( self );
+
+ printf("open %s handle = %x\n", _stringVal(pathName), handle);
+ _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(1),
+ _MKSMALLINT( (int)handle & 0xFFFF ));
+ _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(2),
+ _MKSMALLINT( ((int)handle >> 16) & 0xFFFF ));
}
#endif
-#ifdef NeXT
+
+#ifdef NEXT_DL
long result;
char *files[2];
NXStream *errOut;
loadAddrLow = nil;
loadAddrHi = nil;
- if (_isString(pathName)) {
+ if (__isString(pathName)) {
files[0] = (char *) _stringVal(pathName);
files[1] = (char *) 0;
errOut = NXOpenFile(2, 2);
@@ -1023,28 +1065,40 @@
files,
(char *)0);
NXClose(errOut);
- if (result) {
- printf("rld_load %s ok\n", _stringVal(pathName));
- /* a dummy handle */
- loadAddrLow = _MKSMALLINT(1);
- loadAddrHi = _MKSMALLINT(0);
+ if (! result) {
+ printf("rld_load %s failed\n", _stringVal(pathName));
+ RETURN (nil);
}
- RETURN ( self );
+
+ printf("rld_load %s ok\n", _stringVal(pathName));
+ _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(1), _MKSMALLINT(1));
+ _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(2), _MKSMALLINT(0));
}
- RETURN ( nil );
#endif
-%}
+%}.
+ ^ aBuffer
!
closeDynamicObject:handle
"close an object-file (unmap from my address space)."
|low hi|
+%{
+#ifdef GNU_DL
+# include "dld.h"
+ if (__isString(handle)) {
+ if (dld_unlink_by_file(_stringVal(handle), 1)) {
+ dld_perror("cant unlink");
+ }
+ RETURN ( self );
+ }
+#endif
+%}.
- hi := handle // 16r10000.
- low := handle \\ 16r10000.
+ hi := handle at:1.
+ low := handle at:2.
%{
-#ifdef SYSV4
+#ifdef SYSV4_DL
# include <dlfcn.h>
void *h;
int val;
@@ -1056,7 +1110,8 @@
dlclose(h);
}
#endif
-#ifdef sunos
+
+#ifdef SUN_DL
# include <dlfcn.h>
void *h;
int val;
@@ -1078,10 +1133,28 @@
|low hi lowAddr hiAddr|
- hi := handle // 16r10000.
- low := handle \\ 16r10000.
%{
-#ifdef SYSV4
+#ifdef GNU_DL
+# include "dld.h"
+ void (*func)();
+
+ if (__isString(aString)) {
+ func = (void (*) ()) dld_get_func(_stringVal(aString));
+ if (func) {
+ printf("addr = %x\n", (INT)func);
+ lowAddr = _MKSMALLINT( (INT)func & 0xFFFF );
+ hiAddr = _MKSMALLINT( ((INT)func >> 16) & 0xFFFF );
+ } else {
+ dld_perror("get_func");
+ }
+ }
+#endif
+%}.
+
+ hi := handle at:1.
+ low := handle at:2.
+%{
+#ifdef SYSV4_DL
# include <dlfcn.h>
void *h;
void *addr;
@@ -1090,7 +1163,7 @@
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
- if (_isString(aString)) {
+ if (__isString(aString)) {
printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
addr = dlsym(h, _stringVal(aString));
if (addr) {
@@ -1103,7 +1176,8 @@
}
}
#endif
-#ifdef sunos
+
+#ifdef SUN_DL
# include <dlfcn.h>
void *h;
void *addr;
@@ -1112,7 +1186,7 @@
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
- if (_isString(aString)) {
+ if (__isString(aString)) {
printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
addr = dlsym(h, _stringVal(aString));
if (addr) {
@@ -1125,12 +1199,13 @@
}
}
#endif
-#ifdef NeXT
+
+#ifdef NEXT_DL
unsigned long addr;
long result;
NXStream *errOut;
- if (_isString(aString)) {
+ if (__isString(aString)) {
printf("get sym <%s>\n", _stringVal(aString));
errOut = NXOpenFile(2, 2);
result = rld_lookup(errOut,
@@ -1154,11 +1229,11 @@
releaseSymbolTable
"this is needed on NeXT to forget loaded names. If this wasnt done,
- the same class could nat be loaded in again due to multiple defines.
+ the same class could not be loaded in again due to multiple defines.
On other architectures, this is not needed and therefore a noop."
%{
-#ifdef NeXT
+#ifdef NEXT_DL
NXStream *errOut;
errOut = NXOpenFile(2, 2);
--- a/ObjectFileLoader.st Mon Jan 17 10:14:07 1994 +0100
+++ b/ObjectFileLoader.st Fri Feb 25 13:52:15 1994 +0100
@@ -28,16 +28,41 @@
(goal is to allow loading of binary classes)
-$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.4 1994-01-08 17:05:10 claus Exp $
+$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.5 1994-02-25 12:51:52 claus Exp $
'!
%{
+/*
+ * by default, use whatever the system provides
+ */
+#ifdef sunos
+# define SUN_DL
+#endif
+
#ifdef NeXT
+# define NEXT_DL
+#endif
+
+#ifdef SYSV4
+# define SYSV4_DL
+#endif
+
+/*
+ * but GNU_DL overwrites this
+ */
+#ifdef GNU_DL
+# undef SYSV4_DL
+# undef NEXT_DL
+# undef SUN_DL
+#endif
+
+#ifdef NEXT_DL
# ifndef _RLD_H_
# define _RLD_H_
# include <rld.h>
# endif
-#endif /* NeXT */
+#endif /* NEXT_DL */
+
static OBJ loadAddrLow, loadAddrHi;
%}
@@ -272,7 +297,7 @@
|baseName p t l handle address stubName|
stubName := 'stub000' , (StubNr printStringRadix:16).
- stubName := stubName copyFrom:(stubName size - 7) to:(stubName size).
+ stubName := stubName copyFrom:(stubName size - 7).
baseName := self createStubSource:stubName calling:functionName args:argTypes returning:returnType.
baseName isNil ifTrue:[^ nil].
@@ -454,11 +479,11 @@
^ true
].
(argType == #Float) ifTrue:[
- aStream nextPutAll:'_isFloat(' , argName , ')'.
+ aStream nextPutAll:'__isFloat(' , argName , ')'.
^ true
].
(argType == #String) ifTrue:[
- aStream nextPutAll:'_isString(' , argName , ')'.
+ aStream nextPutAll:'__isString(' , argName , ')'.
^ true
].
(argType == #Boolean) ifTrue:[
@@ -903,7 +928,7 @@
].
className := OperatingSystem baseNameOf:aFileName.
(className endsWith:'.o') ifTrue:[
- className := className copyFrom:1 to:(className size - 2)
+ className := className copyTo:(className size - 2)
].
OperatingSystem getOSType = 'sys5.4' ifTrue:[
symName := '_' , className , '_Init'
@@ -934,87 +959,104 @@
Return a non-nil handle if ok, nil otherwise.
This function is not supported on all architectures."
- |low hi|
+ |handle|
- "had to separate due to UNLIMITEDSTACK need"
- self primOpenDynamicObject:pathName.
-%{
- low = loadAddrLow;
- hi = loadAddrHi;
-%}
-.
- low notNil ifTrue:[
- ^ (hi * 16r10000) + low
- ].
-
- ^ nil
+ handle := self primOpenDynamicObject:pathName into:(Array new:2).
+ ^ handle
"sys5.4:
|handle|
handle := ObjectFileLoader openDynamicObject:'../stc/mod1.so'.
- ObjectFileLoader getSymbol:'module1' from:handle"
+ ObjectFileLoader getSymbol:'module1' from:handle
+ "
"next:
|handle|
handle := ObjectFileLoader openDynamicObject:'../goodies/Path/AbstrPath.o'.
- ObjectFileLoader getSymbol:'__AbstractPath_Init' from:handle"
+ ObjectFileLoader getSymbol:'__AbstractPath_Init' from:handle
+ "
+ "GLD:
+ |handle|
+ handle := ObjectFileLoader openDynamicObject:'../clients/Tetris/Tetris.o'.
+ ObjectFileLoader getSymbol:'__TetrisBlock_Init' from:handle
+ "
!
-primOpenDynamicObject:pathName
+primOpenDynamicObject:pathName into:aBuffer
"open an object-file (map into my address space).
- This function is not supported on all architectures."
+ This function is not supported on all architectures.
+ Dont depend on the returned value or class of it, it depends
+ on the underlying dynamic load package."
%{ /* UNLIMITEDSTACK */
-#ifdef SYSV4
+#ifdef GNU_DL
+# include "dld.h"
+ if (__isString(pathName)) {
+ if (dld_link(_stringVal(pathName))) {
+ dld_perror("cant link");
+ RETURN ( nil );
+ }
+ RETURN ( pathName );
+ }
+ RETURN ( nil );
+#endif
+
+#ifdef SYSV4_DL
+# include <dlfcn.h>
+ void *handle;
+
+ if ((pathName == nil) || __isString(pathName)) {
+ if (pathName == nil)
+ handle = dlopen((char *)0, RTLD_NOW);
+ else
+ handle = dlopen(_stringVal(pathName), RTLD_NOW);
+
+ if (! handle) {
+ printf("dlopen %s error: <%s>\n", _stringVal(pathName), dlerror());
+ RETURN (nil);
+ }
+
+ printf("open %s handle = %x\n", _stringVal(pathName), handle);
+ _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(1),
+ _MKSMALLINT( (int)handle & 0xFFFF ));
+ _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(2),
+ _MKSMALLINT( ((int)handle >> 16) & 0xFFFF ));
+ }
+#endif
+
+#ifdef SUN_DL
# include <dlfcn.h>
void *handle;
loadAddrLow = nil;
loadAddrHi = nil;
- if ((pathName == nil) || _isString(pathName)) {
- if (pathName == nil)
- handle = dlopen((char *)0, RTLD_NOW);
- else
- handle = dlopen(_stringVal(pathName), RTLD_NOW);
- if (handle) {
- printf("open %s handle = %x\n", _stringVal(pathName), handle);
- loadAddrLow = _MKSMALLINT( (int)handle & 0xFFFF );
- loadAddrHi = _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
- } else {
- printf("dlopen %s error: <%s>\n", _stringVal(pathName), dlerror());
- }
- RETURN ( self );
- }
-#endif
-#ifdef sunos
-# include <dlfcn.h>
- void *handle;
-
- loadAddrLow = nil;
- loadAddrHi = nil;
- if ((pathName == nil) || _isString(pathName)) {
+ if ((pathName == nil) || __isString(pathName)) {
if (pathName == nil)
handle = dlopen((char *)0, 1);
else
handle = dlopen(_stringVal(pathName), 1);
- if (handle) {
- printf("open %s handle = %x\n", _stringVal(pathName), handle);
- loadAddrLow = _MKSMALLINT( (int)handle & 0xFFFF );
- loadAddrHi = _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
- } else {
+
+ if (! handle) {
printf("dlopen %s error: <%s>\n", _stringVal(pathName), dlerror());
+ RETURN (nil);
}
- RETURN ( self );
+
+ printf("open %s handle = %x\n", _stringVal(pathName), handle);
+ _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(1),
+ _MKSMALLINT( (int)handle & 0xFFFF ));
+ _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(2),
+ _MKSMALLINT( ((int)handle >> 16) & 0xFFFF ));
}
#endif
-#ifdef NeXT
+
+#ifdef NEXT_DL
long result;
char *files[2];
NXStream *errOut;
loadAddrLow = nil;
loadAddrHi = nil;
- if (_isString(pathName)) {
+ if (__isString(pathName)) {
files[0] = (char *) _stringVal(pathName);
files[1] = (char *) 0;
errOut = NXOpenFile(2, 2);
@@ -1023,28 +1065,40 @@
files,
(char *)0);
NXClose(errOut);
- if (result) {
- printf("rld_load %s ok\n", _stringVal(pathName));
- /* a dummy handle */
- loadAddrLow = _MKSMALLINT(1);
- loadAddrHi = _MKSMALLINT(0);
+ if (! result) {
+ printf("rld_load %s failed\n", _stringVal(pathName));
+ RETURN (nil);
}
- RETURN ( self );
+
+ printf("rld_load %s ok\n", _stringVal(pathName));
+ _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(1), _MKSMALLINT(1));
+ _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(2), _MKSMALLINT(0));
}
- RETURN ( nil );
#endif
-%}
+%}.
+ ^ aBuffer
!
closeDynamicObject:handle
"close an object-file (unmap from my address space)."
|low hi|
+%{
+#ifdef GNU_DL
+# include "dld.h"
+ if (__isString(handle)) {
+ if (dld_unlink_by_file(_stringVal(handle), 1)) {
+ dld_perror("cant unlink");
+ }
+ RETURN ( self );
+ }
+#endif
+%}.
- hi := handle // 16r10000.
- low := handle \\ 16r10000.
+ hi := handle at:1.
+ low := handle at:2.
%{
-#ifdef SYSV4
+#ifdef SYSV4_DL
# include <dlfcn.h>
void *h;
int val;
@@ -1056,7 +1110,8 @@
dlclose(h);
}
#endif
-#ifdef sunos
+
+#ifdef SUN_DL
# include <dlfcn.h>
void *h;
int val;
@@ -1078,10 +1133,28 @@
|low hi lowAddr hiAddr|
- hi := handle // 16r10000.
- low := handle \\ 16r10000.
%{
-#ifdef SYSV4
+#ifdef GNU_DL
+# include "dld.h"
+ void (*func)();
+
+ if (__isString(aString)) {
+ func = (void (*) ()) dld_get_func(_stringVal(aString));
+ if (func) {
+ printf("addr = %x\n", (INT)func);
+ lowAddr = _MKSMALLINT( (INT)func & 0xFFFF );
+ hiAddr = _MKSMALLINT( ((INT)func >> 16) & 0xFFFF );
+ } else {
+ dld_perror("get_func");
+ }
+ }
+#endif
+%}.
+
+ hi := handle at:1.
+ low := handle at:2.
+%{
+#ifdef SYSV4_DL
# include <dlfcn.h>
void *h;
void *addr;
@@ -1090,7 +1163,7 @@
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
- if (_isString(aString)) {
+ if (__isString(aString)) {
printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
addr = dlsym(h, _stringVal(aString));
if (addr) {
@@ -1103,7 +1176,8 @@
}
}
#endif
-#ifdef sunos
+
+#ifdef SUN_DL
# include <dlfcn.h>
void *h;
void *addr;
@@ -1112,7 +1186,7 @@
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
- if (_isString(aString)) {
+ if (__isString(aString)) {
printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
addr = dlsym(h, _stringVal(aString));
if (addr) {
@@ -1125,12 +1199,13 @@
}
}
#endif
-#ifdef NeXT
+
+#ifdef NEXT_DL
unsigned long addr;
long result;
NXStream *errOut;
- if (_isString(aString)) {
+ if (__isString(aString)) {
printf("get sym <%s>\n", _stringVal(aString));
errOut = NXOpenFile(2, 2);
result = rld_lookup(errOut,
@@ -1154,11 +1229,11 @@
releaseSymbolTable
"this is needed on NeXT to forget loaded names. If this wasnt done,
- the same class could nat be loaded in again due to multiple defines.
+ the same class could not be loaded in again due to multiple defines.
On other architectures, this is not needed and therefore a noop."
%{
-#ifdef NeXT
+#ifdef NEXT_DL
NXStream *errOut;
errOut = NXOpenFile(2, 2);
--- a/Parser.st Mon Jan 17 10:14:07 1994 +0100
+++ b/Parser.st Fri Feb 25 13:52:15 1994 +0100
@@ -43,7 +43,7 @@
a method - this is done by sending parseXXX message to a parser and asking
the parser for referencedXVars or modifiedXVars (see SystemBrowser).
-$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.8 1994-01-16 03:51:39 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.9 1994-02-25 12:52:15 claus Exp $
'!
!Parser class methodsFor:'evaluating expressions'!
@@ -814,50 +814,75 @@
pos := tokenPosition.
receiver := self keywordExpression.
(receiver == #Error) ifTrue:[^ #Error].
- [tokenType == $;] whileTrue:[
- receiver isMessage ifFalse:[
- self syntaxError:'left side of cascade must be a message expression'
- position:pos to:tokenPosition
- ].
- self nextToken.
- (tokenType == #Identifier) ifTrue:[
- sel := tokenName.
- self selectorCheck:sel position:tokenPosition to:(tokenPosition + sel size - 1).
- receiver := CascadeNode receiver:receiver selector:sel.
- self nextToken
- ] ifFalse:[
- (tokenType == #BinaryOperator) ifTrue:[
+ (tokenType == $;) ifTrue:[
+ [tokenType == $;] whileTrue:[
+ receiver isMessage ifFalse:[
+ self syntaxError:'left side of cascade must be a message expression'
+ position:pos to:tokenPosition
+ ].
+ self nextToken.
+ (tokenType == #Identifier) ifTrue:[
sel := tokenName.
self selectorCheck:sel position:tokenPosition to:(tokenPosition + sel size - 1).
- self nextToken.
- arg := self unaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- receiver := CascadeNode receiver:receiver selector:sel arg:arg
+ receiver := CascadeNode receiver:receiver selector:sel.
+ self nextToken
] ifFalse:[
- (tokenType == #Keyword) ifTrue:[
- pos := tokenPosition.
+ (tokenType == #BinaryOperator) ifTrue:[
sel := tokenName.
+ self selectorCheck:sel position:tokenPosition to:(tokenPosition + sel size - 1).
self nextToken.
- arg := self binaryExpression.
+ arg := self unaryExpression.
(arg == #Error) ifTrue:[^ #Error].
- args := Array with:arg.
- [tokenType == #Keyword] whileTrue:[
- sel := sel , tokenName.
+ receiver := CascadeNode receiver:receiver selector:sel arg:arg
+ ] ifFalse:[
+ (tokenType == #Keyword) ifTrue:[
+ pos := tokenPosition.
+ sel := tokenName.
self nextToken.
arg := self binaryExpression.
(arg == #Error) ifTrue:[^ #Error].
- args := args copyWith:arg.
- pos2 := tokenPosition
- ].
- self selectorCheck:sel position:pos to:pos2.
- receiver := CascadeNode receiver:receiver selector:sel args:args
- ] ifFalse:[
- (tokenType == #Error) ifTrue:[^ #Error].
- self syntaxError:('invalid cascade; ' , tokenType printString , ' unexpected')
- position:tokenPosition to:source position - 1.
- ^ #Error
+ args := Array with:arg.
+ [tokenType == #Keyword] whileTrue:[
+ sel := sel , tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := args copyWith:arg.
+ pos2 := tokenPosition
+ ].
+ self selectorCheck:sel position:pos to:pos2.
+ receiver := CascadeNode receiver:receiver selector:sel args:args
+ ] ifFalse:[
+ (tokenType == #Error) ifTrue:[^ #Error].
+ self syntaxError:('invalid cascade; ' , tokenType printString , ' unexpected')
+ position:tokenPosition to:source position - 1.
+ ^ #Error
+ ]
]
]
+ ].
+
+ "obscure (uspecified ?) if selector follows; Question:
+
+ is
+ 'expr sel1; sel2 sel3'
+
+ to be parsed as:
+ (t := expr.
+ t sel1.
+ t sel2) sel3
+
+ or:
+ (t := expr.
+ t sel1.
+ t sel2 sel3)
+ "
+ ((tokenType == #Identifier)
+ or:[(tokenType == #BinaryOperator)
+ or:[tokenType == #Keyword]]) ifTrue:[
+ self syntaxError:'ambigous cascade - please group using ( ...)'
+ position:tokenPosition to:source position - 1.
+ ^ #Error
]
].
^ receiver
@@ -1324,7 +1349,7 @@
aClass := classToCompileFor.
classToCompileFor isMeta ifTrue:[
className := aClass name.
- className := className copyFrom:1 to:(className size - 5).
+ className := className copyTo:(className size - 5).
aClass := Smalltalk at:(className asSymbol).
aClass isNil ifTrue:[
aClass := classToCompileFor
@@ -1390,7 +1415,7 @@
aClass := classToCompileFor.
aClass isMeta ifTrue:[
className := aClass name.
- className := className copyFrom:1 to:(className size - 5).
+ className := className copyTo:(className size - 5).
baseClass := Smalltalk at:(className asSymbol).
baseClass notNil ifTrue:[
aClass := baseClass
@@ -1653,14 +1678,14 @@
^ nil
!
-findBestVariableFor:aString
- "collect known variables with their levenshtein distances to aString;
+findBestVariablesFor:aString
+ "collect known variables with their spelling distances to aString;
return the 10 best suggestions"
|names dists searchBlock args vars globalVarName aClass className baseClass n|
- names := VariableArray new.
- dists := VariableArray new.
+ names := OrderedCollection new.
+ dists := OrderedCollection new.
"block arguments"
searchBlock := currentBlock.
@@ -1718,7 +1743,7 @@
aClass := classToCompileFor.
aClass isMeta ifTrue:[
className := aClass name.
- className := className copyFrom:1 to:(className size - 5).
+ className := className copyTo:(className size - 5).
baseClass := Smalltalk at:(className asSymbol).
baseClass notNil ifTrue:[
aClass := baseClass
@@ -1746,7 +1771,6 @@
"misc"
#('self' 'super' 'nil' 'thisContext') do:[:name |
- "only compare strings where length is about right"
names add:name.
dists add:(aString spellAgainst: "levenshteinTo:"name)
].
@@ -1756,11 +1780,43 @@
dists := dists reverse.
names := names reverse.
n := names size min:10.
- ^ names copyFrom:1 to:n
+ ^ names copyTo:n
].
^ nil
!
+findBestSelectorsFor:aString
+ "collect known selectors with their spelling distances to aString;
+ return the 10 best suggestions"
+
+ |info best worst n|
+
+ info := SortedCollection new.
+ info sortBlock:[:a :b | a value > b value].
+
+ n := 0.
+
+ "block arguments"
+ Symbol allInstancesDo:[:sym |
+ |dist|
+
+ dist := aString spellAgainst:sym.
+ dist > 20 ifTrue:[
+ info add:(sym -> dist).
+ n := n + 1.
+ n > 10 ifTrue:[
+ info removeLast.
+ ]
+ ]
+ ].
+
+ ^ info asOrderedCollection collect:[:a | a key]
+
+ "Time millisecondsToRun:[Parser new findBestSelectorsFor:#foo]"
+ "Parser new findBestSelectorsFor:#findBestSel"
+ "Parser new findBestSelectorsFor:#fildBestSelectrFr"
+!
+
correctVariable
"notify error and correct if user wants to;
return #Error if there was no correction
@@ -1781,7 +1837,7 @@
]
].
- suggestedNames := self findBestVariableFor:varName.
+ suggestedNames := self findBestVariablesFor:varName.
suggestedNames notNil ifTrue:[
newName := self askForVariable:'correct variable to: ' fromList:suggestedNames.
newName isNil ifTrue:[^ #Error].
--- a/Scanner.st Mon Jan 17 10:14:07 1994 +0100
+++ b/Scanner.st Fri Feb 25 13:52:15 1994 +0100
@@ -29,7 +29,7 @@
All Rights Reserved
Scanner reads from a stream and returns individual smalltalk tokens
-$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.5 1994-01-08 17:05:17 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.6 1994-02-25 12:50:14 claus Exp $
'!
!Scanner class methodsFor:'instance creation'!
@@ -208,16 +208,39 @@
startPos := source position.
source next.
thisChar := source peek.
- [thisChar notNil and:[thisChar ~~ (Character doubleQuote)]] whileTrue:[
- thisChar == (Character cr) ifTrue:[
- tokenLineNr := tokenLineNr + 1.
+
+ "special ST/X addition:
+ a $/ right after initial double quote makes it an up-to-end-of-line comment,
+ which is very useful to comment out parts of filed-in source code.
+ Since this is non standard, use it in very rare cases only.
+ (maybe the upcoming ansi-standard adds something similar)"
+
+ thisChar == $/ ifTrue:[
+ [thisChar notNil and:[thisChar ~~ Character cr]] whileTrue:[
+ saveComments ifTrue:[
+ comment := comment copyWith:thisChar
+ ].
+ thisChar := source nextPeek.
].
- saveComments ifTrue:[
- comment := comment copyWith:thisChar
+ tokenLineNr := tokenLineNr + 1.
+ self warning:'end-of-line comments are a nonstandard feature of ST/X'
+ position:startPos
+ to:(source position)
+ ] ifFalse:[
+ [thisChar notNil and:[thisChar ~~ (Character doubleQuote)]] whileTrue:[
+ thisChar == (Character cr) ifTrue:[
+ tokenLineNr := tokenLineNr + 1.
+ ].
+ saveComments ifTrue:[
+ comment := comment copyWith:thisChar
+ ].
+ thisChar := source nextPeek
].
- source next.
- thisChar := source peek
+ thisChar isNil ifTrue:[
+ self warning:'unclosed comment' position:startPos to:(source position)
+ ].
].
+
saveComments ifTrue:[
currentComments isNil ifTrue:[
currentComments := OrderedCollection with:comment
@@ -226,9 +249,6 @@
]
].
- thisChar isNil ifTrue:[
- self warning:'unclosed comment' position:startPos to:(source position)
- ].
"skip final dQuote"
source next.
!
@@ -423,7 +443,7 @@
max := 10.
[true] whileTrue:[
(nextChar notNil and:[nextChar isAlphaNumeric]) ifFalse:[
- ^ string copyFrom:1 to:index
+ ^ string copyTo:index
].
(index == max) ifTrue:[
oldString := string.
@@ -506,7 +526,7 @@
]
].
source next.
- tokenValue := string copyFrom:1 to:(index - 1).
+ tokenValue := string copyTo:(index - 1).
tokenType := #Primitive.
tokenLineNr := tokenLineNr + (tokenValue occurrencesOf:(Character cr)).
^ tokenType
@@ -633,7 +653,7 @@
nextChar := source next
]
].
- tokenValue := string copyFrom:1 to:(index - 1).
+ tokenValue := string copyTo:(index - 1).
tokenType := #String.
^ tokenType
! !
--- a/UnaryNd.st Mon Jan 17 10:14:07 1994 +0100
+++ b/UnaryNd.st Fri Feb 25 13:52:15 1994 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/Attic/UnaryNd.st,v 1.5 1994-01-16 03:51:45 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/UnaryNd.st,v 1.6 1994-02-25 12:49:52 claus Exp $
'!
!UnaryNode class methodsFor:'instance creation'!
@@ -34,11 +34,11 @@
^ self receiver:r selector:s fold:true
!
-receiver:r selector:s fold:folding
- "return a new UnaryNode for sending selector s to receiver r.
+receiver:r selector:selectorString fold:folding
+ "return a new UnaryNode for sending selector selectorString to receiver r.
If folding is true, fold constant expressions."
- |result recVal sym|
+ |result recVal selector|
"
The constant folding code can usually not optimize things - this may change
@@ -49,44 +49,52 @@
r isConstant ifTrue:[
"check if we can do it ..."
recVal := r evaluate.
- s knownAsSymbol ifTrue:[
- (recVal respondsTo:sym) ifTrue:[
+ selectorString knownAsSymbol ifTrue:[
+ selector := selectorString asSymbol.
+ (recVal respondsTo:selector) ifTrue:[
"
we could do much more here - but then, we need a dependency from
the folded selectors method to the method we generate code for ...
limit optimizations to those that will never change
(or, if you change them, it will crash badly anyway ...)
"
- Number domainErrorSignal handle:[:ex |
+ SignalSet anySignal "Number domainErrorSignal" handle:[:ex |
+ "in case of an error, abort fold and return original"
ex return
] do:[
- sym := s asSymbol.
recVal respondsToArithmetic ifTrue:[
(#( negated abs asPoint degreesToRadians radiansToDegrees
exp ln log sqrt reciprocal
- arcCos arcSin arcTan sin cos tan) includes:sym)
+ arcCos arcSin arcTan sin cos tan) includes:selector)
ifTrue:[
- result := recVal perform:sym.
+ result := recVal perform:selector.
^ ConstantNode type:(ConstantNode typeOfConstant:result)
value:result
]
].
(recVal isMemberOf:Character) ifTrue:[
- (#( asciiValue asInteger digitValue) includes:sym)
+ (#( asciiValue asInteger digitValue) includes:selector)
ifTrue:[
- result := recVal perform:sym.
+ result := recVal perform:selector.
^ ConstantNode type:(ConstantNode typeOfConstant:result)
value:result
]
].
(recVal isMemberOf:String) ifTrue:[
- (sym == #withCRs) ifTrue:[
- result := recVal perform:sym.
+ (selector == #withCRs) ifTrue:[
+ result := recVal perform:selector.
^ ConstantNode type:(ConstantNode typeOfConstant:result)
value:result
]
].
- ^ (self basicNew) receiver:r selector:s args:nil lineno:0
+ (recVal isMemberOf:Array) ifTrue:[
+ (#(asFloatArray asDoubleArray) includes:selector) ifTrue:[
+ result := recVal perform:selector.
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result)
+ value:result
+ ]
+ ].
+ ^ (self basicNew) receiver:r selector:selector args:nil lineno:0
].
"when we reach here, something went wrong (something like 0.0 log)"
^ 'error occured when evaluating constant expression'
@@ -94,7 +102,7 @@
]
]
].
- ^ (self basicNew) receiver:r selector:s args:nil lineno:0
+ ^ (self basicNew) receiver:r selector:selectorString args:nil lineno:0
! !
!UnaryNode methodsFor:'queries'!
--- a/UnaryNode.st Mon Jan 17 10:14:07 1994 +0100
+++ b/UnaryNode.st Fri Feb 25 13:52:15 1994 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/UnaryNode.st,v 1.5 1994-01-16 03:51:45 claus Exp $
+$Header: /cvs/stx/stx/libcomp/UnaryNode.st,v 1.6 1994-02-25 12:49:52 claus Exp $
'!
!UnaryNode class methodsFor:'instance creation'!
@@ -34,11 +34,11 @@
^ self receiver:r selector:s fold:true
!
-receiver:r selector:s fold:folding
- "return a new UnaryNode for sending selector s to receiver r.
+receiver:r selector:selectorString fold:folding
+ "return a new UnaryNode for sending selector selectorString to receiver r.
If folding is true, fold constant expressions."
- |result recVal sym|
+ |result recVal selector|
"
The constant folding code can usually not optimize things - this may change
@@ -49,44 +49,52 @@
r isConstant ifTrue:[
"check if we can do it ..."
recVal := r evaluate.
- s knownAsSymbol ifTrue:[
- (recVal respondsTo:sym) ifTrue:[
+ selectorString knownAsSymbol ifTrue:[
+ selector := selectorString asSymbol.
+ (recVal respondsTo:selector) ifTrue:[
"
we could do much more here - but then, we need a dependency from
the folded selectors method to the method we generate code for ...
limit optimizations to those that will never change
(or, if you change them, it will crash badly anyway ...)
"
- Number domainErrorSignal handle:[:ex |
+ SignalSet anySignal "Number domainErrorSignal" handle:[:ex |
+ "in case of an error, abort fold and return original"
ex return
] do:[
- sym := s asSymbol.
recVal respondsToArithmetic ifTrue:[
(#( negated abs asPoint degreesToRadians radiansToDegrees
exp ln log sqrt reciprocal
- arcCos arcSin arcTan sin cos tan) includes:sym)
+ arcCos arcSin arcTan sin cos tan) includes:selector)
ifTrue:[
- result := recVal perform:sym.
+ result := recVal perform:selector.
^ ConstantNode type:(ConstantNode typeOfConstant:result)
value:result
]
].
(recVal isMemberOf:Character) ifTrue:[
- (#( asciiValue asInteger digitValue) includes:sym)
+ (#( asciiValue asInteger digitValue) includes:selector)
ifTrue:[
- result := recVal perform:sym.
+ result := recVal perform:selector.
^ ConstantNode type:(ConstantNode typeOfConstant:result)
value:result
]
].
(recVal isMemberOf:String) ifTrue:[
- (sym == #withCRs) ifTrue:[
- result := recVal perform:sym.
+ (selector == #withCRs) ifTrue:[
+ result := recVal perform:selector.
^ ConstantNode type:(ConstantNode typeOfConstant:result)
value:result
]
].
- ^ (self basicNew) receiver:r selector:s args:nil lineno:0
+ (recVal isMemberOf:Array) ifTrue:[
+ (#(asFloatArray asDoubleArray) includes:selector) ifTrue:[
+ result := recVal perform:selector.
+ ^ ConstantNode type:(ConstantNode typeOfConstant:result)
+ value:result
+ ]
+ ].
+ ^ (self basicNew) receiver:r selector:selector args:nil lineno:0
].
"when we reach here, something went wrong (something like 0.0 log)"
^ 'error occured when evaluating constant expression'
@@ -94,7 +102,7 @@
]
]
].
- ^ (self basicNew) receiver:r selector:s args:nil lineno:0
+ ^ (self basicNew) receiver:r selector:selectorString args:nil lineno:0
! !
!UnaryNode methodsFor:'queries'!