--- a/BCompiler.st Sun Apr 20 12:14:00 1997 +0200
+++ b/BCompiler.st Sun Apr 20 12:20:49 1997 +0200
@@ -53,37 +53,37 @@
[Instance variables:]
- codeBytes <ByteArry> bytecodes
- codeIndex <SmallInteger> next index to put into code array
- litArray <OrderedCollection> literals
- stackDelta <SmallInteger> return value of byteCodeFor:
- extra <Symbol> return value of byteCodeFor:
- lineno <Boolean> return value of byteCodeFor:
- extraLiteral <Symbol> return value of byteCodeFor:
- maxStackDepth <SmallInteger> stack need of method
- relocList <Array> used temporary for relocation
+ codeBytes <ByteArry> bytecodes
+ codeIndex <SmallInteger> next index to put into code array
+ litArray <OrderedCollection> literals
+ stackDelta <SmallInteger> return value of byteCodeFor:
+ extra <Symbol> return value of byteCodeFor:
+ lineno <Boolean> return value of byteCodeFor:
+ extraLiteral <Symbol> return value of byteCodeFor:
+ maxStackDepth <SmallInteger> stack need of method
+ relocList <Array> used temporary for relocation
[Class variables:]
- JumpToAbsJump <Dictionary> internal table to map opcodes
-
- SequenceNumber <Integer> counting intermediate stc-compiled
- objects (for unique o-file naming)
-
- STCCompilationDefines passed to stc as command line arguments
- STCCompilationIncludes
- STCCompilationOptions
- <String>
-
- STCCompilation <Symbol> #always, #primitiveOnly or #never
- controls when stc compilation is wanted
-
- ShareCode <Boolean> reuse byteArrays for common (simple) code sequences
- This is normally a 'good' optimization,
- expect if you plan to modify the byteCodes.
+ JumpToAbsJump <Dictionary> internal table to map opcodes
+
+ SequenceNumber <Integer> counting intermediate stc-compiled
+ objects (for unique o-file naming)
+
+ STCCompilationDefines passed to stc as command line arguments
+ STCCompilationIncludes
+ STCCompilationOptions
+ <String>
+
+ STCCompilation <Symbol> #always, #primitiveOnly or #never
+ controls when stc compilation is wanted
+
+ ShareCode <Boolean> reuse byteArrays for common (simple) code sequences
+ This is normally a 'good' optimization,
+ expect if you plan to modify the byteCodes.
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -188,7 +188,7 @@
!
compile:aString forClass:aClass inCategory:cat notifying:requestor
- install:install skipIfSame:skipIfSame silent:silent foldConstants:fold
+ install:install skipIfSame:skipIfSame silent:silent foldConstants:fold
"the basic workhorse method for compiling:
compile a source-string for a method in classToCompileFor.
@@ -220,113 +220,113 @@
compiler notifying:requestor.
silent ifTrue:[
"/ compiler ignoreErrors.
- compiler ignoreWarnings
+ compiler ignoreWarnings
].
"/ compiler nextToken.
(compiler parseMethodSpec == #Error) ifTrue:[
- compiler parseError:'syntax error in method specification'.
- tree := #Error
+ compiler parseError:'syntax error in method specification'.
+ tree := #Error
] ifFalse:[
- lazy ifTrue:[
- "/
- "/ that one method IS required
- "/
- (aClass isMeta and:[compiler selector == #version]) ifTrue:[
- lazy := false
- ]
- ].
-
- lazy ifFalse:[
- "check if same source"
- (skipIfSame and:[(sel := compiler selector) notNil]) ifTrue:[
- oldMethod := aClass compiledMethodAt:sel.
- oldMethod notNil ifTrue:[
- oldMethod source = aString ifTrue:[
- oldMethod isInvalid ifFalse:[
- silencio ifFalse:[
- Transcript showCR:(' unchanged: ',aClass name,' ',compiler selector)
- ].
- "
- same. however, category may be different
- "
- (cat notNil and:[cat ~= oldMethod category]) ifTrue:[
- oldMethod category:cat.
- oldMethod changed:#category.
+ lazy ifTrue:[
+ "/
+ "/ that one method IS required
+ "/
+ (aClass isMeta and:[compiler selector == #version]) ifTrue:[
+ lazy := false
+ ]
+ ].
+
+ lazy ifFalse:[
+ "check if same source"
+ (skipIfSame and:[(sel := compiler selector) notNil]) ifTrue:[
+ oldMethod := aClass compiledMethodAt:sel.
+ oldMethod notNil ifTrue:[
+ oldMethod source = aString ifTrue:[
+ oldMethod isInvalid ifFalse:[
+ silencio ifFalse:[
+ Transcript showCR:(' unchanged: ',aClass name,' ',compiler selector)
+ ].
+ "
+ same. however, category may be different
+ "
+ (cat notNil and:[cat ~= oldMethod category]) ifTrue:[
+ oldMethod category:cat.
+ oldMethod changed:#category.
"/ aClass updateRevisionString.
- aClass addChangeRecordForMethodCategory:oldMethod category:cat.
- silencio ifFalse:[
- Transcript showCR:(' (category change only)')
- ].
- ].
- "
- and package may be too.
- "
- pkg := Class packageQuerySignal raise.
- (pkg notNil and:[pkg ~~ oldMethod package]) ifTrue:[
- oldMethod package:pkg.
- silencio ifFalse:[
- Transcript showCR:(' (package-id change only)')
- ].
- ].
- ^ oldMethod
- ]
- ]
- ]
- ].
- tree := compiler parseMethodBody.
- compiler tree:tree.
- ]
+ aClass addChangeRecordForMethodCategory:oldMethod category:cat.
+ silencio ifFalse:[
+ Transcript showCR:(' (category change only)')
+ ].
+ ].
+ "
+ and package may be too.
+ "
+ pkg := Class packageQuerySignal raise.
+ (pkg notNil and:[pkg ~~ oldMethod package]) ifTrue:[
+ oldMethod package:pkg.
+ silencio ifFalse:[
+ Transcript showCR:(' (package-id change only)')
+ ].
+ ].
+ ^ oldMethod
+ ]
+ ]
+ ]
+ ].
+ tree := compiler parseMethodBody.
+ compiler tree:tree.
+ ]
].
(compiler errorFlag or:[tree == #Error]) ifTrue:[
- compiler showErrorMessageForClass:aClass.
- ^ #Error
+ compiler showErrorMessageForClass:aClass.
+ ^ #Error
].
sel := compiler selector.
"if no error and also no selector ..."
sel isNil ifTrue:[
- "... it was just a comment or other empty stuff"
- ^ nil
+ "... it was just a comment or other empty stuff"
+ ^ nil
].
lazy ifFalse:[
- "
- freak-out support ...
- "
- (compiler hasNonOptionalPrimitiveCode
- or:[(compiler hasPrimitiveCode and:[self canCreateMachineCode])
- or:[STCCompilation == #always and:[sel ~~ #doIt]]]) ifTrue:[
- newMethod := compiler
- compileToMachineCode:aString
- forClass:aClass
- inCategory:cat
- notifying:requestor
- install:install
- skipIfSame:skipIfSame
- silent:silent.
-
- newMethod == #Error ifTrue:[
- compiler showErrorMessageForClass:aClass.
- ^ #Error
- ].
-
- (newMethod == #CannotLoad) ifTrue:[
- newMethod := compiler trappingStubMethodFor:aString inCategory:cat.
-
- keptOldCode := false.
- install ifTrue:[
- "/
- "/ be very careful with existing methods
- "/ (otherwise, you could easily make your system unusable in systems which cannot load)
- "/
- sel notNil ifTrue:[
- oldMethod := aClass compiledMethodAt:sel
- ].
- (oldMethod notNil and:[oldMethod code ~= newMethod code]) ifTrue:[
- answer := Dialog
- confirm:'installation of binary code is not possible or disabled.
+ "
+ freak-out support ...
+ "
+ (compiler hasNonOptionalPrimitiveCode
+ or:[(compiler hasPrimitiveCode and:[self canCreateMachineCode])
+ or:[STCCompilation == #always and:[sel ~~ #doIt]]]) ifTrue:[
+ newMethod := compiler
+ compileToMachineCode:aString
+ forClass:aClass
+ inCategory:cat
+ notifying:requestor
+ install:install
+ skipIfSame:skipIfSame
+ silent:silent.
+
+ newMethod == #Error ifTrue:[
+ compiler showErrorMessageForClass:aClass.
+ ^ #Error
+ ].
+
+ (newMethod == #CannotLoad) ifTrue:[
+ newMethod := compiler trappingStubMethodFor:aString inCategory:cat.
+
+ keptOldCode := false.
+ install ifTrue:[
+ "/
+ "/ be very careful with existing methods
+ "/ (otherwise, you could easily make your system unusable in systems which cannot load)
+ "/
+ sel notNil ifTrue:[
+ oldMethod := aClass compiledMethodAt:sel
+ ].
+ (oldMethod notNil and:[oldMethod code ~= newMethod code]) ifTrue:[
+ answer := Dialog
+ confirm:'installation of binary code is not possible or disabled.
Shall I use the old methods functionality
or instead create a dummy trap method for it ?
@@ -337,31 +337,31 @@
Close this warnBox to abort the compilation.
'
- yesLabel:'trap code'
- noLabel:'keep old'.
- answer isNil ifTrue:[
- ^ #Error
- ].
- answer == false ifTrue:[
- newMethod code:(oldMethod code).
- keptOldCode := true.
- ].
- ].
- aClass addSelector:sel withMethod:newMethod
- ].
- Transcript show:'*** '.
- sel notNil ifTrue:[
- Transcript show:(sel ,' ')
- ].
- keptOldCode ifTrue:[
- msg := 'not really compiled - method still shows previous behavior'.
- ] ifFalse:[
- msg := 'not compiled to machine code - created a stub instead.'.
- ].
- Transcript showCR:msg.
- ].
- ^ newMethod
- ].
+ yesLabel:'trap code'
+ noLabel:'keep old'.
+ answer isNil ifTrue:[
+ ^ #Error
+ ].
+ answer == false ifTrue:[
+ newMethod code:(oldMethod code).
+ keptOldCode := true.
+ ].
+ ].
+ aClass addSelector:sel withMethod:newMethod
+ ].
+ Transcript show:'*** '.
+ sel notNil ifTrue:[
+ Transcript show:(sel ,' ')
+ ].
+ keptOldCode ifTrue:[
+ msg := 'not really compiled - method still shows previous behavior'.
+ ] ifFalse:[
+ msg := 'not compiled to machine code - created a stub instead.'.
+ ].
+ Transcript showCR:msg.
+ ].
+ ^ newMethod
+ ].
].
"
@@ -370,59 +370,59 @@
compile itself when first called.
"
lazy ifTrue:[
- newMethod := LazyMethod new.
- (ClassCategoryReader sourceMode == #sourceReference) ifTrue:[
- sourceFile := ObjectMemory nameForSources.
- sourceFile notNil ifTrue:[
- sourceStream := sourceFile asFilename appendingWriteStream.
- ]
- ].
- sourceStream isNil ifTrue:[
- newMethod source:aString.
- ] ifFalse:[
- sourceStream setToEnd.
- pos := sourceStream position.
- sourceStream nextChunkPut:aString.
- sourceStream close.
- newMethod sourceFilename:sourceFile position:pos.
- ].
- newMethod category:cat.
- newMethod package:(Class packageQuerySignal raise).
+ newMethod := LazyMethod new.
+ (ClassCategoryReader sourceMode == #sourceReference) ifTrue:[
+ sourceFile := ObjectMemory nameForSources.
+ sourceFile notNil ifTrue:[
+ sourceStream := sourceFile asFilename appendingWriteStream.
+ ]
+ ].
+ sourceStream isNil ifTrue:[
+ newMethod source:aString.
+ ] ifFalse:[
+ sourceStream setToEnd.
+ pos := sourceStream position.
+ sourceStream nextChunkPut:aString.
+ sourceStream close.
+ newMethod sourceFilename:sourceFile position:pos.
+ ].
+ newMethod category:cat.
+ newMethod package:(Class packageQuerySignal raise).
"/ Project notNil ifTrue:[
"/ newMethod package:(Project currentPackageName)
"/ ].
- aClass addSelector:sel withLazyMethod:newMethod.
- ^ newMethod
+ aClass addSelector:sel withLazyMethod:newMethod.
+ ^ newMethod
].
(primNr := compiler primitiveNumber) isNil ifTrue:[
- "
- produce symbolic code first
- "
- symbolicCodeArray := compiler genSymbolicCode.
-
- (symbolicCodeArray == #Error) ifTrue:[
- Transcript show:' '.
- sel notNil ifTrue:[
- Transcript show:(sel ,' ')
- ].
- Transcript showCR:'translation error'.
- ^ #Error
- ].
-
- "
- take this, producing bytecode
- (someone willin' to make machine code :-)
- "
- ((compiler genByteCodeFrom:symbolicCodeArray) == #Error) ifTrue:[
- Transcript show:' '.
- sel notNil ifTrue:[
- Transcript show:(sel ,' ')
- ].
- Transcript showCR:'relocation error - must be simplified'.
- ^ #Error
- ].
+ "
+ produce symbolic code first
+ "
+ symbolicCodeArray := compiler genSymbolicCode.
+
+ (symbolicCodeArray == #Error) ifTrue:[
+ Transcript show:' '.
+ sel notNil ifTrue:[
+ Transcript show:(sel ,' ')
+ ].
+ Transcript showCR:'translation error'.
+ ^ #Error
+ ].
+
+ "
+ take this, producing bytecode
+ (someone willin' to make machine code :-)
+ "
+ ((compiler genByteCodeFrom:symbolicCodeArray) == #Error) ifTrue:[
+ Transcript show:' '.
+ sel notNil ifTrue:[
+ Transcript show:(sel ,' ')
+ ].
+ Transcript showCR:'relocation error - must be simplified'.
+ ^ #Error
+ ].
].
"
@@ -430,9 +430,9 @@
"
newMethod := compiler createMethod.
primNr notNil ifTrue:[
- newMethod code:(compiler checkForPrimitiveCode:primNr).
+ newMethod code:(compiler checkForPrimitiveCode:primNr).
] ifFalse:[
- newMethod byteCode:(compiler code).
+ newMethod byteCode:(compiler code).
].
"/ newMethod numberOfMethodVars:(compiler numberOfMethodVars).
"/ newMethod numberOfMethodArgs:(compiler numberOfMethodArgs).
@@ -442,9 +442,9 @@
if there where any corrections, install the updated source
"
(newSource := compiler correctedSource) notNil ifTrue:[
- newMethod source:newSource
+ newMethod source:newSource
] ifFalse:[
- newMethod source:aString.
+ newMethod source:aString.
].
newMethod category:cat.
newMethod package:(Class packageQuerySignal raise).
@@ -453,11 +453,11 @@
"/ ].
install ifTrue:[
- aClass addSelector:sel withMethod:newMethod
+ aClass addSelector:sel withMethod:newMethod
].
silencio ifFalse:[
- Transcript showCR:(' compiled: ', aClass name,' ', sel)
+ Transcript showCR:(' compiled: ', aClass name,' ', sel)
].
^ newMethod
@@ -581,7 +581,7 @@
or nil if not found."
CC isNil ifTrue:[
- ^ 'cc'
+ ^ 'cc'
].
^ CC
@@ -1341,7 +1341,237 @@
"
should add more here, to be able to fileIn ST-80 methods
containing primitive calls (who gives me the numbers ... ?)
- "
+ mhmh - got some ..."
+
+ "/ 18 Number @
+ "/ 21 LargePositiveInteger +
+ "/ 22 LargePositiveInteger -
+ "/ 29 LargePositiveInteger *
+ "/ 30 LargePositiveInteger /
+ "/ 31 LargePositiveInteger \\
+ "/ 32 LargePositiveInteger //
+ "/ 34 LargePositiveInteger bitAnd:
+ "/ 35 LargePositiveInteger bitOr:
+ "/ 36 LargePositiveInteger bitXor:
+ "/ 37 LargePositiveInteger bitShift:
+ "/ 40 SmallInteger asFloat
+ "/ 41 Float +
+ "/ 42 Float -
+ "/ 49 Float *
+ "/ 50 Float /
+ "/ 52 Float fractionPart
+ "/ 54 Float timesTwoPower:
+ "/ 70 Behavior basicNew
+ "/ 71 Behavior basicNew:
+ "/ 89 Behavior flushVMmethodCache
+ "/ 91 InputState primCursorLocPut:
+ "/ 105 ByteArray replaceElementsFrom:to:withByteArray:startingAt:
+ "/ 223 ByteString =
+ "/ 306 ObjectMemory class sizesAtStartup
+ "/ 307 ObjectMemory class defaultSizesAtStartup
+ "/ 309 ObjectMemory class defaultThresholds
+ "/ 326 ObjectMemory class getMemoryUsageAndZeroFragmentationStatisticsIf:
+ "/ 395 ExternalInterface ???
+ "/ 400 FormBitmap class newWidth:height:
+ "/ 414 TwoByteString replaceElementsFrom:to:withTwoByteString:startingAt:
+ "/ 415 TwoByteString =
+ "/ 417 String trueCompare:
+ "/ 418 ByteString nextIndexOf:from:to:
+ "/ 419 ByteString prevIndexOf:from:to:
+ "/ 422 WeakArray indexOf:replaceWith:startingAt:stoppingAt:
+ "/ 522 Behavior flushVMmethodCacheEntriesFor:
+ "/ 524 Context nFromVPC:
+ "/ 525 Context vFromNPC:
+ "/ 532 Object shallowCopy
+ "/ 536 Behavior atomicAllInstances
+ "/ 537 Object allOwners
+ "/ 538 ObjectMemory class allObjects
+ "/ 546 UninterpretedBytes longAt:
+ "/ 548 UninterpretedBytes floatAt:
+ "/ 550 UninterpretedBytes longFloatAt:
+ "/ 544 UninterpretedBytes unsignedLongAt:
+ "/ 559 ByteArray replaceBytesFrom:to:with:startingAt:
+ "/ 560 Double class fromNumber:
+ "/ 561 Double +
+ "/ 562 Double -
+ "/ 569 Double *
+ "/ 570 Double /
+ "/ 572 Double fractionPart
+ "/ 574 Double timesTwoPower:
+ "/ 576 Double sin
+ "/ 577 Double cos
+ "/ 578 Double tan
+ "/ 579 Double arcSin
+ "/ 580 Double arcCos
+ "/ 581 Double arcTan
+ "/ 582 Double sqrt
+ "/ 583 Double ln
+ "/ 584 Double exp
+ "/ 585 Double raisedTo:
+ "/ 587 Double floorLog10
+ "/ 588 Double asFloat
+ "/ 591 Float cos
+ "/ 592 Float arcSin
+ "/ 593 Float arcCos
+ "/ 600 Float sin
+ "/ 601 Float tan
+ "/ 602 Float arcTan
+ "/ 603 Float sqrt
+ "/ 604 Float ln
+ "/ 605 Float exp
+ "/ 606 Float raisedTo:
+ "/ 609 Float floorLog10
+ "/ 610 Filename getDatesErrInto:
+ "/ 614 DosFilename class getVolumes
+ "/ 615 UnixFilename primSetProtection:errInto:
+ "/ 616 UnixFilename class primSetCreationMask:errInto:
+ "/ 617 UnixFilename primGetProtectionErrInto:
+ "/ 620 Filename listDirectoryErrInto:
+ "/ 621 Filename deleteErrInto:
+ "/ 622 Filename isDirectoryErrInto:
+ "/ 623 Filename renameTo:errInto:
+ "/ 624 Filename makeDirectoryErrInto:
+ "/ 625 Filename class defaultDirectoryErrInto:
+ "/ 626 Filename fileSizeErrInto:
+ "/ 627 Filename isWritableErrInto:
+ "/ 628 Filename setWritable:errInto:
+ "/ 629 Filename existsErrInto:
+ "/ 630 SocketAccessor setOptionsLevel:name:value:
+ "/ 631 SocketAccessor getOptionsLevel:name:
+ "/ 632 SocketAccessor primGetName
+ "/ 633 SocketAccessor primGetPeer
+ "/ 634 SocketAccessor atMark
+ "/ 637 UnixTtyAccessor primGetOptions
+ "/ 638 UnixTtyAccessor setOptions:
+ "/ 639 UnixRealTtyAccessor modemBits:mask:sendBreak:
+ "/ 640 IPSocketAddress class primHostAddressByName:
+ "/ 641 IPSocketAddress class netAddressByName:
+ "/ 642 IPSocketAddress class protocolNumberByName:
+ "/ 643 IPSocketAddress class servicePortByName:
+ "/ 645 IPSocketAddress class primHostNameByAddress:
+ "/ 646 IPSocketAddress class netNameByAddress:
+ "/ 647 IPSocketAddress class protocolNameByNumber:
+ "/ 648 IPSocketAddress class serviceNameByPort:
+ "/ 649 SocketAccessor class getHostname
+ "/ 650 Filename primOpenFileNamed:direction:creation:errorInto:
+ "/ 651 IOAccessor primClose
+ "/ 652 UnixPipeAccessor class primPipeErrorInto:
+ "/ 653 UnixPseudoTtyAccessor class primPtyErrorInto:
+ "/ 654 SocketAccessor class primPairErrorInto:
+ "/ 655 UnixRealTtyAccessor class primOpen:errInto:
+ "/ 660 IOAccessor primReadInto:startingAt:for:
+ "/ 661 IOAccessor primWriteFrom:startingAt:for:
+ "/ 662 IOAccessor primSeekTo:
+ "/ 664 IOAccessor truncateTo:
+ "/ 665 DosDiskFileAccessor commit
+ "/ 666 IOAccessor primGetSize
+ "/ 667 MacDiskFileAccessor lock:for:
+ "/ 669 UnixIOAccessor bytesForRead
+ "/ 670 SocketAccessor class primFamily:type:protocol:errInto:
+ "/ 671 SocketAccessor primAccept
+ "/ 672 SocketAccessor bindTo:
+ "/ 673 SocketAccessor listenFor:
+ "/ 674 SocketAccessor primConnectTo:
+ "/ 675 SocketAccessor primReceiveFrom:buffer:start:for:flags:
+ "/ 676 SocketAccessor sendTo:buffer:start:for:flags:
+ "/ 677 SocketAccessor shutdown:
+ "/ 681 UnixProcess class primFork:arguments:environment:descriptors:errorTo:
+ "/ 682 UnixProcess class reapOne
+ "/ 683 UnixProcess kill:
+ "/ 690 CEnvironment class primEnvironment
+ "/ 697 OSErrorHolder class errorDescriptionFor:
+ "/ 697 ErrorHolder class errorDescriptionFor:
+ "/ 698 SocketAccessor class primInit:
+ "/ 700 ParagraphEditor class getExternalSelectionOrNil:
+ "/ 701 ParagraphEditor class putExternalSelection:with:
+ "/ 705 Screen ringBell
+ "/ 706 Cursor class primOpenImage:mask:hotSpotX:hotSpotY:background:foreground:
+ "/ 707 Cursor primBeCursor
+ "/ 708 Cursor primFreeCursor
+ "/ 772 SoundManager enumerateSoundsFrom:
+ "/ 773 SoundManager playSoundFrom:sound:
+ "/ 774 SoundManager simpleBeep:
+ "/ 775 Pixmap primFromClipboard
+ "/ 776 Pixmap toClipboard
+ "/ 808 Context findNextMarkedUpTo:
+ "/ 809 Context terminateTo:
+ "/ 710 DosTtyAccessor class primOpen:errInto:
+ "/ 711 DosTtyAccessor primClose
+ "/ 712 DosTtyAccessor primReadInto:startingAt:for:
+ "/ 713 DosTtyAccessor primWriteFrom:startingAt:for:
+ "/ 714 DosTtyAccessor primGetOptions
+ "/ 715 DosTtyAccessor primSetOptions:
+ "/ 716 DosTtyAccessor setSem:forWrite:
+ "/ 717 DosTtyAccessor modemBits:mask:sendBreak:
+ "/ 750 MacFilename class getVolumes
+ "/ 752 MacFilename primSetCreator:type:errInto:
+ "/ 754 MacIOAccessor class getAccessories
+ "/ 755 MacIOAccessor class runAccessory:
+ "/ 756 MacOSFilename class getFileTypes:errInto:
+ "/ 757 MacOSFilename putFileWithPrompt:errInto:
+ "/ 758 MacOSFilename getFileInfoErrInto:
+ "/ 759 MacOSFilename stringFromVRefErrInto:
+ "/ 761 MacOSFilename class getStartupFilesErrInto:
+ "/ 770 DosFilename printPSFileErrInto:
+ "/ 771 DosFilename printTextFileErrInto:
+ "/ 780 MacTtyAccessor class primOpen:errInto:
+ "/ 781 MacTtyAccessor primClose
+ "/ 782 MacTtyAccessor primReadInto:startingAt:for:
+ "/ 783 MacTtyAccessor primWriteFrom:startingAt:for:
+ "/ 786 MacTtyAccessor primGetOptions
+ "/ 787 MacTtyAccessor setOptions:
+ "/ 788 MacTtyAccessor primBreak:
+ "/ 790 MacTtyAccessor primGetStatus
+ "/ 792 MacTtyAccessor setSem:forWrite:
+ "/ 793 MacTtyAccessor primAssertDTR:
+ "/ 794 MacTtyAccessor primGetSize
+ "/ 933 ByteArray copyBitsClippedStride:...
+ "/ 934 ByteArray tileBits32By32Stride:...
+ "/ 935 Screen dragShape:...
+ "/ 936 Screen resizeRectangle...
+ "/ 937 Screen displayShape:...
+ "/ 938 Window resizeFromUserWithMinimum:maximum:
+ "/ 940 Window primClose
+ "/ 942 Window getDimensions
+ "/ 943 Window moveTo:resize:
+ "/ 944 Window primMap
+ "/ 945 Window class primNewAt:extent:min:max:windowType:
+ "/ 946 Screen flush
+ "/ 947 Screen getScreenDimensions
+ "/ 948 Window unmap
+ "/ 950 Screen sync
+ "/ 951 Window setIconMask:
+ "/ 952 Window label:iconLabel:
+ "/ 953 Window raise
+ "/ 954 Window lower
+ "/ 955 Screen queryStackingOrder
+ "/ 956 TextMeasurer primScanCharactersFrom:...
+ "/ 957 GraphicsContext displayMappedString:from:to:at:withMap:
+ "/ 959 Window setBackgroundPixel:
+ "/ 960 Screen class primOpen:
+ "/ 965 UnmappableSurface contentsOfAreaOriginX:y:width:height:
+ "/ 966 Window contentsOfAreaOriginX:y:width:height:
+ "/ 967 Screen contentsOfAreaOriginX:y:width:height:
+ "/ 970 Mask class primExtent:depth:
+ "/ 971 Mask privateClose
+ "/ 976 GraphicsContext displayCharacterOfIndex:at:
+ "/ 978 DeviceFont class listFonts
+ "/ 979 DeviceFont primLoadFont
+ "/ 980 DeviceFont primUnLoadFont
+ "/ 985 GraphicsContext displayLineFrom:to:
+ "/ 986 GraphicsContext displayPolyline:at:
+ "/ 987 GraphicsContext displayPolygon:at:
+ "/ 988 GraphicsContext primDisplayRectangleOrigin:extent:
+ "/ 989 GraphicsContext primDisplayRectangularBorderOrigin:extent:
+ "/ 990 GraphicsContext primDisplayArcBBoxOrigin:extent:startAngle:sweepAngle:
+ "/ 991 GraphicsContext primDisplayWedgeBBoxOrigin:extent:startAngle:sweepAngle:
+ "/ 992 GraphicsContext displayMask:at:"
+ "/ 993 GraphicsContext displayUninterpretedImageBits:at:
+ "/ 994 GraphicsContext primCopyRectangularAreaExtent:from:sourceOffset:destinationOffset:
+ "/ 995 GraphicsContext primCopyMaskedArea:from:sourceOffset:destinationOffset:
+ "/ 996 Screen deviceColormap
+ "/ 998 GraphicsContext displayUninterpretedMonoImageBits:foreground:background:at:
+
cls notNil ifTrue:[
^ (cls compiledMethodAt:sel) code
].
@@ -1353,13 +1583,13 @@
newMethod := Method new:(litArray size).
litArray notNil ifTrue:[
- "/ fixup CheapBlocks method-field in literal array,
- litArray do:[:aLiteral |
- (aLiteral isMemberOf:CheapBlock) ifTrue:[
- aLiteral setMethod:newMethod.
- ]
- ].
- newMethod literals:litArray
+ "/ fixup CheapBlocks method-field in literal array,
+ litArray do:[:aLiteral |
+ (aLiteral isMemberOf:CheapBlock) ifTrue:[
+ aLiteral setMethod:newMethod.
+ ]
+ ].
+ newMethod literals:litArray
].
newMethod numberOfMethodVars:(self numberOfMethodVars).
@@ -1367,7 +1597,7 @@
newMethod stackSize:(self maxStackDepth).
primitiveResource notNil ifTrue:[
- newMethod setResourceFlag
+ newMethod setResourceFlag
].
^ newMethod
@@ -1393,238 +1623,238 @@
needRetry := true.
symCodeSize := symbolicCodeArray size.
ShareCode ifTrue:[
- codeBytes := self checkForCommonCode:symbolicCodeArray.
- codeBytes notNil ifTrue:[
- ^ self
- ].
+ codeBytes := self checkForCommonCode:symbolicCodeArray.
+ codeBytes notNil ifTrue:[
+ ^ self
+ ].
].
codeSize := symCodeSize.
[needRetry] whileTrue:[
- stackDepth := 0.
- maxStackDepth := 0.
-
- codeBytes := ByteArray uninitializedNew:codeSize.
- relocInfo := Array basicNew:(codeSize + 1).
- symIndex := 1.
- codeIndex := 1.
-
- needRetry := false.
- round := round + 1.
-
- [symIndex <= symCodeSize] whileTrue:[
- relocInfo at:symIndex put:codeIndex.
-
- codeSymbol := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- stackDelta := 0.
- extra := extraLiteral := nil.
- lineno := false.
-
- self appendByteCodeFor:codeSymbol.
-
- extraLiteral notNil ifTrue:[
- self addLiteral:extraLiteral
- ].
-
- lineno ifTrue:[
- self appendByte:((symbolicCodeArray at:symIndex) min:255).
- symIndex := symIndex + 1.
- codeSymbol == #lineno16 ifTrue:[
- self appendByte:((symbolicCodeArray at:symIndex) min:255).
- symIndex := symIndex + 1
- ]
- ].
-
- extra notNil ifTrue:[
- nextSym := symbolicCodeArray at:symIndex.
-
- (extra == #number) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- self appendSignedByte:index
-
- ] ifFalse:[ (extra == #number16) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 2.
- self appendSignedWord:index
-
- ] ifFalse:[ (extra == #unsigned16) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 2.
- self appendWord:index
-
- ] ifFalse:[ (extra == #index) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- self appendByte:index
-
- ] ifFalse:[ (extra == #lit) ifTrue:[
- index := self addLiteral:nextSym.
- symIndex := symIndex + 1.
- self appendByte:index
-
- ] ifFalse:[ (extra == #speciallit) ifTrue:[
- index := self addLiteral:nextSym.
- index > 255 ifTrue:[
- self parseError:'too many globals (' ,
- (symbolicCodeArray at:symIndex) ,
- ' index=' , index printString ,
- ') in method - please simplify'.
- ^ #Error
- ].
- symIndex := symIndex + 1.
- self appendByte:index.
-
- ] ifFalse:[ (extra == #speciallitS) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- self appendByte:index.
-
- ] ifFalse:[ (extra == #speciallitL) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 2.
- self appendWord:index.
-
- ] ifFalse:[ (extra == #offset) ifTrue:[
- relocInfo at:symIndex put:codeIndex.
- self addReloc:symIndex.
- symIndex := symIndex + 1.
- self appendByte:0
-
- ] ifFalse:[ (extra == #indexLevel) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- self appendByte:index.
- level := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:level
-
- ] ifFalse:[ (extra == #offsetNvarNarg) ifTrue:[
- relocInfo at:symIndex put:codeIndex.
- self addReloc:symIndex.
- symIndex := symIndex + 1.
- self appendEmptyByte.
- nvars := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:nvars.
- level := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:level
-
- ] ifFalse:[ (extra == #absoffset) ifTrue:[
- relocInfo at:symIndex put:codeIndex.
- self addReloc:symIndex.
- addr := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:(addr bitAnd:16rFF).
- self appendByte:((addr bitShift:-8) bitAnd:16rFF).
-
- ] ifFalse:[ (extra == #absoffsetNvarNarg) ifTrue:[
- relocInfo at:symIndex put:codeIndex.
- self addReloc:symIndex.
- addr := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:(addr bitAnd:16rFF).
- self appendByte:((addr bitShift:-8) bitAnd:16rFF).
- nvars := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:nvars.
- level := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:level
-
- ] ifFalse:[ (extra == #special) ifTrue:[
- ((codeSymbol == #send)
- or:[codeSymbol == #sendSelf
- or:[codeSymbol == #superSend
- or:[codeSymbol == #hereSend]]]) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- nargs := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:nargs.
- self appendByte:index.
-
- (codeSymbol == #superSend
- or:[codeSymbol == #hereSend]) ifTrue:[
- index := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:index
- ].
- stackDelta := nargs negated.
- codeSymbol == #sendSelf ifTrue:[
- stackDelta := stackDelta + 1
- ]
- ] ifFalse:[ (codeSymbol == #sendDrop) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- nargs := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:nargs.
- self appendByte:index.
- stackDelta := (nargs + 1) negated
- ]]
-
- ] ifFalse:[ (extra == #specialL) ifTrue:[
- ((codeSymbol == #sendL)
- or:[codeSymbol == #sendSelfL
- or:[codeSymbol == #superSendL
- or:[codeSymbol == #hereSendL]]]) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 2.
- nargs := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:nargs.
- self appendWord:index.
- (codeSymbol == #superSendL
- or:[codeSymbol == #hereSendL]) ifTrue:[
- index := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 2.
- self appendWord:index.
- ].
- stackDelta := nargs negated.
- codeSymbol == #sendSelfL ifTrue:[
- stackDelta := stackDelta + 1
- ]
- ]
- ] ifFalse:[ (extra == #specialSend) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- self appendByte:index.
-
- ] ifFalse:[
- "/ self halt:'internal error'
+ stackDepth := 0.
+ maxStackDepth := 0.
+
+ codeBytes := ByteArray uninitializedNew:codeSize.
+ relocInfo := Array basicNew:(codeSize + 1).
+ symIndex := 1.
+ codeIndex := 1.
+
+ needRetry := false.
+ round := round + 1.
+
+ [symIndex <= symCodeSize] whileTrue:[
+ relocInfo at:symIndex put:codeIndex.
+
+ codeSymbol := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ stackDelta := 0.
+ extra := extraLiteral := nil.
+ lineno := false.
+
+ self appendByteCodeFor:codeSymbol.
+
+ extraLiteral notNil ifTrue:[
+ self addLiteral:extraLiteral
+ ].
+
+ lineno ifTrue:[
+ self appendByte:((symbolicCodeArray at:symIndex) min:255).
+ symIndex := symIndex + 1.
+ codeSymbol == #lineno16 ifTrue:[
+ self appendByte:((symbolicCodeArray at:symIndex) min:255).
+ symIndex := symIndex + 1
+ ]
+ ].
+
+ extra notNil ifTrue:[
+ nextSym := symbolicCodeArray at:symIndex.
+
+ (extra == #number) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ self appendSignedByte:index
+
+ ] ifFalse:[ (extra == #number16) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 2.
+ self appendSignedWord:index
+
+ ] ifFalse:[ (extra == #unsigned16) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 2.
+ self appendWord:index
+
+ ] ifFalse:[ (extra == #index) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ self appendByte:index
+
+ ] ifFalse:[ (extra == #lit) ifTrue:[
+ index := self addLiteral:nextSym.
+ symIndex := symIndex + 1.
+ self appendByte:index
+
+ ] ifFalse:[ (extra == #speciallit) ifTrue:[
+ index := self addLiteral:nextSym.
+ index > 255 ifTrue:[
+ self parseError:'too many globals (' ,
+ (symbolicCodeArray at:symIndex) ,
+ ' index=' , index printString ,
+ ') in method - please simplify'.
+ ^ #Error
+ ].
+ symIndex := symIndex + 1.
+ self appendByte:index.
+
+ ] ifFalse:[ (extra == #speciallitS) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ self appendByte:index.
+
+ ] ifFalse:[ (extra == #speciallitL) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 2.
+ self appendWord:index.
+
+ ] ifFalse:[ (extra == #offset) ifTrue:[
+ relocInfo at:symIndex put:codeIndex.
+ self addReloc:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:0
+
+ ] ifFalse:[ (extra == #indexLevel) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ self appendByte:index.
+ level := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:level
+
+ ] ifFalse:[ (extra == #offsetNvarNarg) ifTrue:[
+ relocInfo at:symIndex put:codeIndex.
+ self addReloc:symIndex.
+ symIndex := symIndex + 1.
+ self appendEmptyByte.
+ nvars := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:nvars.
+ level := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:level
+
+ ] ifFalse:[ (extra == #absoffset) ifTrue:[
+ relocInfo at:symIndex put:codeIndex.
+ self addReloc:symIndex.
+ addr := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:(addr bitAnd:16rFF).
+ self appendByte:((addr bitShift:-8) bitAnd:16rFF).
+
+ ] ifFalse:[ (extra == #absoffsetNvarNarg) ifTrue:[
+ relocInfo at:symIndex put:codeIndex.
+ self addReloc:symIndex.
+ addr := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:(addr bitAnd:16rFF).
+ self appendByte:((addr bitShift:-8) bitAnd:16rFF).
+ nvars := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:nvars.
+ level := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:level
+
+ ] ifFalse:[ (extra == #special) ifTrue:[
+ ((codeSymbol == #send)
+ or:[codeSymbol == #sendSelf
+ or:[codeSymbol == #superSend
+ or:[codeSymbol == #hereSend]]]) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ nargs := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:nargs.
+ self appendByte:index.
+
+ (codeSymbol == #superSend
+ or:[codeSymbol == #hereSend]) ifTrue:[
+ index := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:index
+ ].
+ stackDelta := nargs negated.
+ codeSymbol == #sendSelf ifTrue:[
+ stackDelta := stackDelta + 1
+ ]
+ ] ifFalse:[ (codeSymbol == #sendDrop) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ nargs := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:nargs.
+ self appendByte:index.
+ stackDelta := (nargs + 1) negated
+ ]]
+
+ ] ifFalse:[ (extra == #specialL) ifTrue:[
+ ((codeSymbol == #sendL)
+ or:[codeSymbol == #sendSelfL
+ or:[codeSymbol == #superSendL
+ or:[codeSymbol == #hereSendL]]]) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 2.
+ nargs := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:nargs.
+ self appendWord:index.
+ (codeSymbol == #superSendL
+ or:[codeSymbol == #hereSendL]) ifTrue:[
+ index := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 2.
+ self appendWord:index.
+ ].
+ stackDelta := nargs negated.
+ codeSymbol == #sendSelfL ifTrue:[
+ stackDelta := stackDelta + 1
+ ]
+ ]
+ ] ifFalse:[ (extra == #specialSend) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ self appendByte:index.
+
+ ] ifFalse:[
+ "/ self halt:'internal error'
- ]]]]]]]]]]]]]]]]
- ].
-
- stackDepth := stackDepth + stackDelta.
- (stackDepth > maxStackDepth) ifTrue:[
- maxStackDepth := stackDepth
- ]
- ].
- relocInfo at:symIndex put:codeIndex.
-
- needRetry ifFalse:[
- "
- now relocate - returns true if ok, false if we have to do it again
- (when short jumps have been changed to long jumps)
- "
- relocList notNil ifTrue:[
- needRetry := (self relocateWith:symbolicCodeArray relocInfo:relocInfo) not.
- "
- if returned with false, a relative jump was made into
- an absolute jump - need to start over with one more byte space
- "
- needRetry ifTrue:[
- relocList := nil.
- codeSize := codeSize + 1.
- ]
- ]
- ] ifTrue:[
- 'Compiler [info]: compiling again ...' infoPrintCR.
- ]
+ ]]]]]]]]]]]]]]]]
+ ].
+
+ stackDepth := stackDepth + stackDelta.
+ (stackDepth > maxStackDepth) ifTrue:[
+ maxStackDepth := stackDepth
+ ]
+ ].
+ relocInfo at:symIndex put:codeIndex.
+
+ needRetry ifFalse:[
+ "
+ now relocate - returns true if ok, false if we have to do it again
+ (when short jumps have been changed to long jumps)
+ "
+ relocList notNil ifTrue:[
+ needRetry := (self relocateWith:symbolicCodeArray relocInfo:relocInfo) not.
+ "
+ if returned with false, a relative jump was made into
+ an absolute jump - need to start over with one more byte space
+ "
+ needRetry ifTrue:[
+ relocList := nil.
+ codeSize := codeSize + 1.
+ ]
+ ]
+ ] ifTrue:[
+ 'Compiler [info]: compiling again ...' infoPrintCR.
+ ]
].
"code printNL."
^ errorFlag
@@ -1643,27 +1873,27 @@
thisStatement := tree.
[thisStatement notNil] whileTrue:[
- lastStatement := thisStatement.
- thisStatement codeForSideEffectOn:codeStream inBlock:nil for:self.
- thisStatement := thisStatement nextStatement
+ lastStatement := thisStatement.
+ thisStatement codeForSideEffectOn:codeStream inBlock:nil for:self.
+ thisStatement := thisStatement nextStatement
].
(lastStatement isNil or:[lastStatement isReturnNode not])
ifTrue:[
- "not a return - add retSelf"
- "
- if the last statement was a send for side-effect,
- replace the previous drop by a retSelf.
- In this case we have to keep an extra retSelf bacause
- it could be a jump target.
- "
- (lastStatement notNil
- and:[(code := codeStream contents) notNil
- and:[code size > 0
- and:[code last == #drop]]]) ifTrue:[
- codeStream backStep.
- codeStream nextPut:#retSelf
- ].
- codeStream nextPut:#retSelf
+ "not a return - add retSelf"
+ "
+ if the last statement was a send for side-effect,
+ replace the previous drop by a retSelf.
+ In this case we have to keep an extra retSelf bacause
+ it could be a jump target.
+ "
+ (lastStatement notNil
+ and:[(code := codeStream contents) notNil
+ and:[code size > 0
+ and:[code last == #drop]]]) ifTrue:[
+ codeStream backStep.
+ codeStream nextPut:#retSelf
+ ].
+ codeStream nextPut:#retSelf
].
^ codeStream contents
@@ -1691,12 +1921,12 @@
(sel == #bitOr:) ifTrue:[^ true].
(sel == #new:) ifTrue:[^ true].
(sel == #basicNew:) ifTrue:[
- "/ this one is critical - some redefine it
- receiver isGlobal ifTrue:[
- (#('String' 'ByteArray' 'Array'
- 'Point' 'Rectangle' 'Object')
- includes:receiver name) ifTrue:[^ true].
- ].
+ "/ this one is critical - some redefine it
+ receiver isGlobal ifTrue:[
+ (#('String' 'ByteArray' 'Array'
+ 'Point' 'Rectangle' 'Object')
+ includes:receiver name) ifTrue:[^ true].
+ ].
].
^ false
@@ -1746,12 +1976,12 @@
(sel == #new) ifTrue:[^ true].
(sel == #basicNew) ifTrue:[
- "/ this one is critical - some redefine it
- receiver isGlobal ifTrue:[
- (#('String' 'ByteArray' 'Array'
- 'Point' 'Rectangle' 'Object')
- includes:receiver name) ifTrue:[^ true].
- ].
+ "/ this one is critical - some redefine it
+ receiver isGlobal ifTrue:[
+ (#('String' 'ByteArray' 'Array'
+ 'Point' 'Rectangle' 'Object')
+ includes:receiver name) ifTrue:[^ true].
+ ].
].
^ false
@@ -1763,12 +1993,12 @@
"return true, if unary selector sel is a special selector"
^ #(Array String FloatArray DoubleArray
- Point Symbol Smalltalk Processor
- SmallInteger Character Float
- Process
- Set IdentitySet Dictionary IdentityDictionary
- Sempahore
- OrderedCollection
+ Point Symbol Smalltalk Processor
+ SmallInteger Character Float
+ Process
+ Set IdentitySet Dictionary IdentityDictionary
+ Sempahore
+ OrderedCollection
) includesIdentical:nm
"Created: 13.4.1996 / 20:15:35 / cg"
@@ -2039,7 +2269,7 @@
!ByteCodeCompiler methodsFor:'machine code generation'!
compileToMachineCode:aString forClass:aClass inCategory:cat
- notifying:requestor install:install skipIfSame:skipIfSame silent:silent
+ notifying:requestor install:install skipIfSame:skipIfSame silent:silent
"this is called to compile primitive code.
This is EXPERIMENTAL and going to be changed to raise an error,
an redefined in subclasses which can do it (either by direct compilation, or by calling
@@ -2057,19 +2287,19 @@
(mP isDirectory
and:[mP isReadable
and:[mP isWritable]]) ifFalse:[
- self parseError:('no access to tempDir: ' , mP pathName) position:1.
- ^ #CannotLoad
+ self parseError:('no access to tempDir: ' , mP pathName) position:1.
+ ^ #CannotLoad
].
ObjectFileLoader isNil ifTrue:[^ #CannotLoad].
STCCompilation == #never ifTrue:[^ #CannotLoad].
(stcPath := self class incrementalStcPath) isNil ifTrue:[
- self parseError:'no stc compiler available - cannot create machine code' position:1.
- ^ #CannotLoad
+ self parseError:'no stc compiler available - cannot create machine code' position:1.
+ ^ #CannotLoad
].
(ccPath := self class ccPath) isNil ifTrue:[
- self parseError:'no cc compiler available - cannot create machine code' position:1.
- ^ #CannotLoad
+ self parseError:'no cc compiler available - cannot create machine code' position:1.
+ ^ #CannotLoad
].
"/ generate a unique name, consisting of my processID and a sequence number
@@ -2077,7 +2307,7 @@
"/ lifes
SequenceNumber isNil ifTrue:[
- SequenceNumber := 0.
+ SequenceNumber := 0.
].
SequenceNumber := SequenceNumber + 1.
@@ -2086,153 +2316,153 @@
stFileName := './' , initName , '.st'.
stream := stFileName asFilename writeStream.
stream isNil ifTrue:[
- self parseError:'cannot create temporary sourcefile for compilation'.
- ^ #CannotLoad
+ self parseError:'cannot create temporary sourcefile for compilation'.
+ ^ #CannotLoad
].
[
- sep := stream class chunkSeparator.
-
- class := aClass.
- class isMeta ifTrue:[
- class := aClass soleInstance
- ].
- supers := class allSuperclasses.
- supers notNil ifTrue:[
- supers reverseDo:[:cls|
- cls ~~ Object ifTrue:[
- cls isLoaded ifFalse:[
- stream close.
- ^ #CannotLoad
- ].
- cls fileOutDefinitionOn:stream.
- stream nextPut:sep; cr.
- ]
- ]
- ].
- class fileOutDefinitionOn:stream.
- stream nextPut:sep; cr.
-
- class privateClassesSorted do:[:aPrivateClass |
- aPrivateClass fileOutDefinitionOn:stream.
- stream nextPut:sep; cr.
- ].
-
- class fileOutPrimitiveDefinitionsOn:stream.
-
- stream nextPut:sep.
- className := class name.
-
- stream nextPutAll:className.
- aClass isMeta ifTrue:[
- stream nextPutAll:' class'.
- ].
- stream nextPutAll:' methodsFor:'''; nextPutAll:cat; nextPutAll:''''.
- stream nextPut:sep; cr.
-
- stream nextPutLine:'"{ Line: 0 }"';
- nextChunkPut:aString;
- space; nextPut:sep.
-
- stream close.
-
- "
- call stc to compile it
- "
- oFileName := './' , initName , '.o'.
- cFileName := './' , initName , '.c'.
- oFileName asFilename delete.
- cFileName asFilename delete.
-
- stcFlags := '-commonSymbols +sharedLibCode +newIncremental -E:errorOutput -N' , initName .
- cFlags := OperatingSystem getOSDefine.
- cFlags isNil ifTrue:[
- cFlags := ''
- ].
-
- STCCompilationDefines notNil ifTrue:[
- cFlags := cFlags , ' ' , STCCompilationDefines
- ].
- STCCompilationIncludes notNil ifTrue:[
- stcFlags := STCCompilationIncludes , ' ' , stcFlags.
- cFlags := cFlags , ' ' , STCCompilationIncludes.
- ].
- STCCompilationOptions notNil ifTrue:[
- stcFlags := STCCompilationOptions , ' ' , stcFlags
- ].
- CCCompilationOptions notNil ifTrue:[
- cFlags := cFlags , ' ' , CCCompilationOptions
- ].
-
- command := stcPath , ' ' , stcFlags , ' -C ' , stFileName.
+ sep := stream class chunkSeparator.
+
+ class := aClass.
+ class isMeta ifTrue:[
+ class := aClass soleInstance
+ ].
+ supers := class allSuperclasses.
+ supers notNil ifTrue:[
+ supers reverseDo:[:cls|
+ cls ~~ Object ifTrue:[
+ cls isLoaded ifFalse:[
+ stream close.
+ ^ #CannotLoad
+ ].
+ cls fileOutDefinitionOn:stream.
+ stream nextPut:sep; cr.
+ ]
+ ]
+ ].
+ class fileOutDefinitionOn:stream.
+ stream nextPut:sep; cr.
+
+ class privateClassesSorted do:[:aPrivateClass |
+ aPrivateClass fileOutDefinitionOn:stream.
+ stream nextPut:sep; cr.
+ ].
+
+ class fileOutPrimitiveDefinitionsOn:stream.
+
+ stream nextPut:sep.
+ className := class name.
+
+ stream nextPutAll:className.
+ aClass isMeta ifTrue:[
+ stream nextPutAll:' class'.
+ ].
+ stream nextPutAll:' methodsFor:'''; nextPutAll:cat; nextPutAll:''''.
+ stream nextPut:sep; cr.
+
+ stream nextPutLine:'"{ Line: 0 }"';
+ nextChunkPut:aString;
+ space; nextPut:sep.
+
+ stream close.
+
+ "
+ call stc to compile it
+ "
+ oFileName := './' , initName , '.o'.
+ cFileName := './' , initName , '.c'.
+ oFileName asFilename delete.
+ cFileName asFilename delete.
+
+ stcFlags := '-commonSymbols +sharedLibCode +newIncremental -E:errorOutput -N' , initName .
+ cFlags := OperatingSystem getOSDefine.
+ cFlags isNil ifTrue:[
+ cFlags := ''
+ ].
+
+ STCCompilationDefines notNil ifTrue:[
+ cFlags := cFlags , ' ' , STCCompilationDefines
+ ].
+ STCCompilationIncludes notNil ifTrue:[
+ stcFlags := STCCompilationIncludes , ' ' , stcFlags.
+ cFlags := cFlags , ' ' , STCCompilationIncludes.
+ ].
+ STCCompilationOptions notNil ifTrue:[
+ stcFlags := STCCompilationOptions , ' ' , stcFlags
+ ].
+ CCCompilationOptions notNil ifTrue:[
+ cFlags := cFlags , ' ' , CCCompilationOptions
+ ].
+
+ command := stcPath , ' ' , stcFlags , ' -C ' , stFileName.
"/ 'executing: ' infoPrint. command infoPrintCR.
- errorStream := 'errorOutput' asFilename writeStream.
-
- self activityNotification:'compiling (stc)'.
- ok := OperatingSystem
- executeCommand:command
- inputFrom:nil
- outputTo:errorStream
- errorTo:errorStream
- onError:[:stat|
- status := stat.
- false
- ].
-
- cFileName asFilename exists ifTrue:[
- ok ifFalse:[
- 'Compiler [info]: oops - system says it failed - but c-file is there ...' infoPrintCR.
- ok := true
- ]
- ] ifFalse:[
- ok := false
- ].
-
- ok ifTrue:[
- "/ now compile to machine code
-
- command := ccPath , ' ' , cFlags , ' -c ' , cFileName.
+ errorStream := 'errorOutput' asFilename writeStream.
+
+ self activityNotification:'compiling (stc)'.
+ ok := OperatingSystem
+ executeCommand:command
+ inputFrom:nil
+ outputTo:errorStream
+ errorTo:errorStream
+ onError:[:stat|
+ status := stat.
+ false
+ ].
+
+ cFileName asFilename exists ifTrue:[
+ ok ifFalse:[
+ 'Compiler [info]: oops - system says it failed - but c-file is there ...' infoPrintCR.
+ ok := true
+ ]
+ ] ifFalse:[
+ ok := false
+ ].
+
+ ok ifTrue:[
+ "/ now compile to machine code
+
+ command := ccPath , ' ' , cFlags , ' -c ' , cFileName.
"/ 'executing: ' infoPrint. command infoPrintCR.
- self activityNotification:'compiling (cc)'.
- ok := OperatingSystem
- executeCommand:command
- inputFrom:nil
- outputTo:errorStream
- errorTo:errorStream
- onError:[:stat|
- status := stat.
- false
- ].
-
- oFileName asFilename exists ifTrue:[
- ok ifFalse:[
- 'Compiler [info]: system says it failed - but o-file is there ...' infoPrintCR.
- ok := true
- ]
- ] ifFalse:[
- ok := false
- ].
-
- "for debugging - leave c intermediate"
- STCKeepCIntermediate == true ifFalse:[
- OperatingSystem removeFile:cFileName.
- ].
- ].
-
- ok ifFalse:[
- (status notNil and:[status couldNotExecute]) ifTrue:[
- eMsg := 'oops, no STC - cannot create machine code'
- ] ifFalse:[
- errorStream := 'errorOutput' asFilename readStream.
- errorStream notNil ifTrue:[
- errorMessages := errorStream contents.
- errorMessages notNil ifTrue:[
- errorMessages := errorMessages asStringCollection.
- errorMessages size > 20 ifTrue:[
- errorMessages := (errorMessages copyTo:20) copyWith:'... more messages skipped'
- ].
+ self activityNotification:'compiling (cc)'.
+ ok := OperatingSystem
+ executeCommand:command
+ inputFrom:nil
+ outputTo:errorStream
+ errorTo:errorStream
+ onError:[:stat|
+ status := stat.
+ false
+ ].
+
+ oFileName asFilename exists ifTrue:[
+ ok ifFalse:[
+ 'Compiler [info]: system says it failed - but o-file is there ...' infoPrintCR.
+ ok := true
+ ]
+ ] ifFalse:[
+ ok := false
+ ].
+
+ "for debugging - leave c intermediate"
+ STCKeepCIntermediate == true ifFalse:[
+ OperatingSystem removeFile:cFileName.
+ ].
+ ].
+
+ ok ifFalse:[
+ (status notNil and:[status couldNotExecute]) ifTrue:[
+ eMsg := 'oops, no STC - cannot create machine code'
+ ] ifFalse:[
+ errorStream := 'errorOutput' asFilename readStream.
+ errorStream notNil ifTrue:[
+ errorMessages := errorStream contents.
+ errorMessages notNil ifTrue:[
+ errorMessages := errorMessages asStringCollection.
+ errorMessages size > 20 ifTrue:[
+ errorMessages := (errorMessages copyTo:20) copyWith:'... more messages skipped'
+ ].
"/ errorMessages := errorMessages collect:[:line |
"/ (line startsWith:(stFileName , ':')) ifTrue:[
"/ 'Line: ' , (line copyFrom:(stFileName size + 2))
@@ -2240,209 +2470,209 @@
"/ line
"/ ]
"/ ].
- errorMessages := errorMessages asString
- ].
- ].
- errorMessages isNil ifTrue:[
- errorMessages := ''
- ].
- errorMessages isEmpty ifTrue:[
- eMsg := 'STC / CC error during compilation:\\unspecified error'
- ] ifFalse:[
- eMsg := 'STC / CC error during compilation:\\',errorMessages
- ].
- eMsg := eMsg withCRs
- ].
- 'errorOutput' asFilename remove.
- self activityNotification:'compilation failed'.
- self parseError:eMsg position:1.
-
- OperatingSystem removeFile:oFileName.
- OperatingSystem removeFile:'errorOutput'.
- self activityNotification:''.
- ^ #Error
- ].
-
- self activityNotification:''.
- OperatingSystem removeFile:'errorOutput'.
-
- (ObjectFileLoader notNil
- and:[ObjectFileLoader canLoadObjectFiles]) ifFalse:[
- self parseError:'no dynamic load configured - cannot load machine code' position:1.
- OperatingSystem removeFile:cFileName.
- OperatingSystem removeFile:oFileName.
- ^ #CannotLoad
- ].
-
- "
- if required, make a shared or otherwise loadable object file for it
- "
- self activityNotification:'linking'.
- oFileName := ObjectFileLoader createLoadableObjectFor:initName.
- oFileName isNil ifTrue:[
- "/ something went wrong
- self parseError:(ObjectFileLoader lastError) position:1.
- ^ #CannotLoad
- ].
-
- oFileName asFilename exists ifFalse:[
- OperatingSystem removeFile:oFileName.
- self parseError:'link failed - cannot create machine code' position:1.
- ^ #CannotLoad
- ].
-
- "
- move it into the modules directory
- "
- moduleFileName := STCModulePath , '/' , initName , '.' , (oFileName asFilename suffix).
- oFileName asFilename moveTo:moduleFileName.
- oFileName := moduleFileName.
-
- "
- load the objectfile
- "
- self activityNotification:'loading'.
- handle := ObjectFileLoader loadDynamicObject:moduleFileName.
- handle isNil ifTrue:[
- OperatingSystem removeFile:moduleFileName.
- self parseError:'dynamic load failed - cannot create machine code' position:1.
- ^ #CannotLoad
- ].
+ errorMessages := errorMessages asString
+ ].
+ ].
+ errorMessages isNil ifTrue:[
+ errorMessages := ''
+ ].
+ errorMessages isEmpty ifTrue:[
+ eMsg := 'STC / CC error during compilation:\\unspecified error'
+ ] ifFalse:[
+ eMsg := 'STC / CC error during compilation:\\',errorMessages
+ ].
+ eMsg := eMsg withCRs
+ ].
+ 'errorOutput' asFilename remove.
+ self activityNotification:'compilation failed'.
+ self parseError:eMsg position:1.
+
+ OperatingSystem removeFile:oFileName.
+ OperatingSystem removeFile:'errorOutput'.
+ self activityNotification:''.
+ ^ #Error
+ ].
+
+ self activityNotification:''.
+ OperatingSystem removeFile:'errorOutput'.
+
+ (ObjectFileLoader notNil
+ and:[ObjectFileLoader canLoadObjectFiles]) ifFalse:[
+ self parseError:'no dynamic load configured - cannot load machine code' position:1.
+ OperatingSystem removeFile:cFileName.
+ OperatingSystem removeFile:oFileName.
+ ^ #CannotLoad
+ ].
+
+ "
+ if required, make a shared or otherwise loadable object file for it
+ "
+ self activityNotification:'linking'.
+ oFileName := ObjectFileLoader createLoadableObjectFor:initName.
+ oFileName isNil ifTrue:[
+ "/ something went wrong
+ self parseError:(ObjectFileLoader lastError) position:1.
+ ^ #CannotLoad
+ ].
+
+ oFileName asFilename exists ifFalse:[
+ OperatingSystem removeFile:oFileName.
+ self parseError:'link failed - cannot create machine code' position:1.
+ ^ #CannotLoad
+ ].
+
+ "
+ move it into the modules directory
+ "
+ moduleFileName := STCModulePath , '/' , initName , '.' , (oFileName asFilename suffix).
+ oFileName asFilename moveTo:moduleFileName.
+ oFileName := moduleFileName.
+
+ "
+ load the objectfile
+ "
+ self activityNotification:'loading'.
+ handle := ObjectFileLoader loadDynamicObject:moduleFileName.
+ handle isNil ifTrue:[
+ OperatingSystem removeFile:moduleFileName.
+ self parseError:'dynamic load failed - cannot create machine code' position:1.
+ ^ #CannotLoad
+ ].
"/ ('handle is ' , handle printString) infoPrintCR.
- "/ try libs to resolve symbols.
- address := ObjectFileLoader getFunction:'__' , initName , '_Init' from:handle.
- address isNil ifTrue:[
- address := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
- address isNil ifTrue:[
- (ObjectFileLoader hasUndefinedSymbolsIn:handle) ifTrue:[
- ObjectFileLoader searchedLibraries do:[:libName |
- (ObjectFileLoader hasUndefinedSymbolsIn:handle) ifTrue:[
- Transcript showCR:' ... trying ' , libName , ' to resolve undefined symbols ...'.
- dummyHandle := Array new:4.
- dummyHandle := ObjectFileLoader primLoadDynamicObject:libName into:dummyHandle.
- dummyHandle isNil ifTrue:[
- Transcript showCR:' ... load of library ' , libName , ' failed.'.
- ]
- ]
- ].
- (ObjectFileLoader hasUndefinedSymbolsIn:handle) isNil ifTrue:[
- Transcript showCR:('LOADER: still undefined symbols in ',initName,'.').
- ].
- ].
-
- ]
- ].
-
- address := ObjectFileLoader getFunction:'__' , initName , '_Init' from:handle.
- address isNil ifTrue:[
- address := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
- address isNil ifTrue:[
- (ObjectFileLoader getListOfUndefinedSymbolsFrom:handle) size > 0 ifTrue:[
- ObjectFileLoader listUndefinedSymbolsIn:handle.
- eMsg := 'undefined symbols in primitive code'.
- ] ifFalse:[
- eMsg := initName , '_Init() lookup failed'
- ].
-
- ObjectFileLoader unloadDynamicObject:handle.
-
- OperatingSystem removeFile:moduleFileName.
- self parseError:(eMsg , ' - cannot create machine code') position:1.
- ^ #CannotLoad
- ]
- ].
+ "/ try libs to resolve symbols.
+ address := ObjectFileLoader getFunction:'__' , initName , '_Init' from:handle.
+ address isNil ifTrue:[
+ address := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
+ address isNil ifTrue:[
+ (ObjectFileLoader hasUndefinedSymbolsIn:handle) ifTrue:[
+ ObjectFileLoader searchedLibraries do:[:libName |
+ (ObjectFileLoader hasUndefinedSymbolsIn:handle) ifTrue:[
+ Transcript showCR:' ... trying ' , libName , ' to resolve undefined symbols ...'.
+ dummyHandle := Array new:4.
+ dummyHandle := ObjectFileLoader primLoadDynamicObject:libName into:dummyHandle.
+ dummyHandle isNil ifTrue:[
+ Transcript showCR:' ... load of library ' , libName , ' failed.'.
+ ]
+ ]
+ ].
+ (ObjectFileLoader hasUndefinedSymbolsIn:handle) isNil ifTrue:[
+ Transcript showCR:('LOADER: still undefined symbols in ',initName,'.').
+ ].
+ ].
+
+ ]
+ ].
+
+ address := ObjectFileLoader getFunction:'__' , initName , '_Init' from:handle.
+ address isNil ifTrue:[
+ address := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
+ address isNil ifTrue:[
+ (ObjectFileLoader getListOfUndefinedSymbolsFrom:handle) size > 0 ifTrue:[
+ ObjectFileLoader listUndefinedSymbolsIn:handle.
+ eMsg := 'undefined symbols in primitive code'.
+ ] ifFalse:[
+ eMsg := initName , '_Init() lookup failed'
+ ].
+
+ ObjectFileLoader unloadDynamicObject:handle.
+
+ OperatingSystem removeFile:moduleFileName.
+ self parseError:(eMsg , ' - cannot create machine code') position:1.
+ ^ #CannotLoad
+ ]
+ ].
"/ ('init at ' , address printString) infoPrintCR.
- m := ObjectFileLoader
- callInitFunctionAt:address
- specialInit:true
- forceOld:true
- interruptable:false
- argument:2
- identifyAs:handle
- returnsObject:true.
-
- "
- did it work ?
- "
- newMethod := aClass compiledMethodAt:selector.
- newMethod notNil ifTrue:[
- m ~~ newMethod ifTrue:[
- 'Compiler [error]: loaded method installed itself elsewhere' errorPrintCR.
- ].
-
- newMethod source:aString.
- newMethod package:(Class packageQuerySignal raise).
+ m := ObjectFileLoader
+ callInitFunctionAt:address
+ specialInit:true
+ forceOld:true
+ interruptable:false
+ argument:2
+ identifyAs:handle
+ returnsObject:true.
+
+ "
+ did it work ?
+ "
+ newMethod := aClass compiledMethodAt:selector.
+ newMethod notNil ifTrue:[
+ m ~~ newMethod ifTrue:[
+ 'Compiler [error]: loaded method installed itself elsewhere' errorPrintCR.
+ ].
+
+ newMethod source:aString.
+ newMethod package:(Class packageQuerySignal raise).
"/ Project notNil ifTrue:[
"/ newMethod package:(Project currentPackageName)
"/ ].
"/ aClass updateRevisionString.
- aClass addChangeRecordForMethod:newMethod.
- (silent or:[Smalltalk silentLoading == true]) ifFalse:[
- Transcript showCR:(' compiled: ', className,' ',selector,' - machine code')
- ].
- ObjectMemory flushCaches.
-
- handle method:newMethod.
-
- "/ check for obsolete loaded objects and unload them
-
- ObjectFileLoader loadedObjectHandlesDo:[:anotherHandle |
- anotherHandle isMethodHandle ifTrue:[
- anotherHandle method isNil ifTrue:[
- ObjectFileLoader unloadObjectFile:anotherHandle pathName.
- OperatingSystem removeFile:anotherHandle pathName.
- ]
- ]
- ].
- ^ newMethod.
- ].
-
- OperatingSystem removeFile:moduleFileName.
- self parseError:'dynamic load failed' position:1.
- ^ #CannotLoad
+ aClass addChangeRecordForMethod:newMethod.
+ (silent or:[Smalltalk silentLoading == true]) ifFalse:[
+ Transcript showCR:(' compiled: ', className,' ',selector,' - machine code')
+ ].
+ ObjectMemory flushCaches.
+
+ handle method:newMethod.
+
+ "/ check for obsolete loaded objects and unload them
+
+ ObjectFileLoader loadedObjectHandlesDo:[:anotherHandle |
+ anotherHandle isMethodHandle ifTrue:[
+ anotherHandle method isNil ifTrue:[
+ ObjectFileLoader unloadObjectFile:anotherHandle pathName.
+ OperatingSystem removeFile:anotherHandle pathName.
+ ]
+ ]
+ ].
+ ^ newMethod.
+ ].
+
+ OperatingSystem removeFile:moduleFileName.
+ self parseError:'dynamic load failed' position:1.
+ ^ #CannotLoad
] valueNowOrOnUnwindDo:[
- STCKeepSTIntermediate ifFalse:[
- OperatingSystem removeFile:stFileName.
- ].
+ STCKeepSTIntermediate ifFalse:[
+ OperatingSystem removeFile:stFileName.
+ ].
].
"
|m|
Object subclass:#Test
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'tests'.
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'tests'.
m := ByteCodeCompiler
- compile:'foo ^ ''hello'''
- forClass:Test
- inCategory:'tests'
- notifying:nil
- install:false
- skipIfSame:false.
+ compile:'foo ^ ''hello'''
+ forClass:Test
+ inCategory:'tests'
+ notifying:nil
+ install:false
+ skipIfSame:false.
m inspect
"
"
|m|
Object subclass:#Test
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'tests'.
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'tests'.
m := ByteCodeCompiler
- compileToMachineCode:'foo %{ RETURN (_MKSMALLINT(1)); %}'
- forClass:Test
- inCategory:'tests'
- notifying:nil
- install:false
- skipIfSame:false
- silent:false.
+ compileToMachineCode:'foo %{ RETURN (_MKSMALLINT(1)); %}'
+ forClass:Test
+ inCategory:'tests'
+ notifying:nil
+ install:false
+ skipIfSame:false
+ silent:false.
m inspect
"
@@ -2456,37 +2686,37 @@
osType := OperatingSystem getOSType.
osType = 'irix' ifTrue:[
- "
- link it to a shared object
- "
- oFileName := './' , baseFileName , '.o'.
- soFileName := './' , baseFileName , '.so'.
- OperatingSystem removeFile:soFileName.
- OperatingSystem executeCommand:'ld -shared -all -o ' , soFileName , ' ' , oFileName.
- OperatingSystem removeFile:oFileName.
- ^ soFileName.
+ "
+ link it to a shared object
+ "
+ oFileName := './' , baseFileName , '.o'.
+ soFileName := './' , baseFileName , '.so'.
+ OperatingSystem removeFile:soFileName.
+ OperatingSystem executeCommand:'ld -shared -all -o ' , soFileName , ' ' , oFileName.
+ OperatingSystem removeFile:oFileName.
+ ^ soFileName.
].
osType = 'sys5_4' ifTrue:[
- "
- link it to a shared object
- "
- oFileName := './' , baseFileName , '.o'.
- soFileName := './' , baseFileName , '.so'.
- OperatingSystem removeFile:soFileName.
- OperatingSystem executeCommand:'ld -G -o ' , soFileName , ' ' , oFileName.
- OperatingSystem removeFile:oFileName.
- ^ soFileName.
+ "
+ link it to a shared object
+ "
+ oFileName := './' , baseFileName , '.o'.
+ soFileName := './' , baseFileName , '.so'.
+ OperatingSystem removeFile:soFileName.
+ OperatingSystem executeCommand:'ld -G -o ' , soFileName , ' ' , oFileName.
+ OperatingSystem removeFile:oFileName.
+ ^ soFileName.
].
osType = 'linux' ifTrue:[
- "
- link it to a shared object
- "
- oFileName := './' , baseFileName , '.o'.
- soFileName := './' , baseFileName , '.so'.
- OperatingSystem removeFile:soFileName.
- OperatingSystem executeCommand:'ld -shared -o ' , soFileName , ' ' , oFileName.
- OperatingSystem removeFile:oFileName.
- ^ soFileName.
+ "
+ link it to a shared object
+ "
+ oFileName := './' , baseFileName , '.o'.
+ soFileName := './' , baseFileName , '.so'.
+ OperatingSystem removeFile:soFileName.
+ OperatingSystem executeCommand:'ld -shared -o ' , soFileName , ' ' , oFileName.
+ OperatingSystem removeFile:oFileName.
+ ^ soFileName.
].
^ oFileName
@@ -2502,7 +2732,7 @@
newMethod := Method new:(litArray size).
litArray notNil ifTrue:[
- newMethod literals:litArray
+ newMethod literals:litArray
].
newMethod makeUncompiled.
@@ -2523,6 +2753,6 @@
!ByteCodeCompiler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.112 1997-04-16 17:14:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.113 1997-04-20 10:20:49 cg Exp $'
! !
ByteCodeCompiler initialize!
--- a/ByteCodeCompiler.st Sun Apr 20 12:14:00 1997 +0200
+++ b/ByteCodeCompiler.st Sun Apr 20 12:20:49 1997 +0200
@@ -53,37 +53,37 @@
[Instance variables:]
- codeBytes <ByteArry> bytecodes
- codeIndex <SmallInteger> next index to put into code array
- litArray <OrderedCollection> literals
- stackDelta <SmallInteger> return value of byteCodeFor:
- extra <Symbol> return value of byteCodeFor:
- lineno <Boolean> return value of byteCodeFor:
- extraLiteral <Symbol> return value of byteCodeFor:
- maxStackDepth <SmallInteger> stack need of method
- relocList <Array> used temporary for relocation
+ codeBytes <ByteArry> bytecodes
+ codeIndex <SmallInteger> next index to put into code array
+ litArray <OrderedCollection> literals
+ stackDelta <SmallInteger> return value of byteCodeFor:
+ extra <Symbol> return value of byteCodeFor:
+ lineno <Boolean> return value of byteCodeFor:
+ extraLiteral <Symbol> return value of byteCodeFor:
+ maxStackDepth <SmallInteger> stack need of method
+ relocList <Array> used temporary for relocation
[Class variables:]
- JumpToAbsJump <Dictionary> internal table to map opcodes
-
- SequenceNumber <Integer> counting intermediate stc-compiled
- objects (for unique o-file naming)
-
- STCCompilationDefines passed to stc as command line arguments
- STCCompilationIncludes
- STCCompilationOptions
- <String>
-
- STCCompilation <Symbol> #always, #primitiveOnly or #never
- controls when stc compilation is wanted
-
- ShareCode <Boolean> reuse byteArrays for common (simple) code sequences
- This is normally a 'good' optimization,
- expect if you plan to modify the byteCodes.
+ JumpToAbsJump <Dictionary> internal table to map opcodes
+
+ SequenceNumber <Integer> counting intermediate stc-compiled
+ objects (for unique o-file naming)
+
+ STCCompilationDefines passed to stc as command line arguments
+ STCCompilationIncludes
+ STCCompilationOptions
+ <String>
+
+ STCCompilation <Symbol> #always, #primitiveOnly or #never
+ controls when stc compilation is wanted
+
+ ShareCode <Boolean> reuse byteArrays for common (simple) code sequences
+ This is normally a 'good' optimization,
+ expect if you plan to modify the byteCodes.
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -188,7 +188,7 @@
!
compile:aString forClass:aClass inCategory:cat notifying:requestor
- install:install skipIfSame:skipIfSame silent:silent foldConstants:fold
+ install:install skipIfSame:skipIfSame silent:silent foldConstants:fold
"the basic workhorse method for compiling:
compile a source-string for a method in classToCompileFor.
@@ -220,113 +220,113 @@
compiler notifying:requestor.
silent ifTrue:[
"/ compiler ignoreErrors.
- compiler ignoreWarnings
+ compiler ignoreWarnings
].
"/ compiler nextToken.
(compiler parseMethodSpec == #Error) ifTrue:[
- compiler parseError:'syntax error in method specification'.
- tree := #Error
+ compiler parseError:'syntax error in method specification'.
+ tree := #Error
] ifFalse:[
- lazy ifTrue:[
- "/
- "/ that one method IS required
- "/
- (aClass isMeta and:[compiler selector == #version]) ifTrue:[
- lazy := false
- ]
- ].
-
- lazy ifFalse:[
- "check if same source"
- (skipIfSame and:[(sel := compiler selector) notNil]) ifTrue:[
- oldMethod := aClass compiledMethodAt:sel.
- oldMethod notNil ifTrue:[
- oldMethod source = aString ifTrue:[
- oldMethod isInvalid ifFalse:[
- silencio ifFalse:[
- Transcript showCR:(' unchanged: ',aClass name,' ',compiler selector)
- ].
- "
- same. however, category may be different
- "
- (cat notNil and:[cat ~= oldMethod category]) ifTrue:[
- oldMethod category:cat.
- oldMethod changed:#category.
+ lazy ifTrue:[
+ "/
+ "/ that one method IS required
+ "/
+ (aClass isMeta and:[compiler selector == #version]) ifTrue:[
+ lazy := false
+ ]
+ ].
+
+ lazy ifFalse:[
+ "check if same source"
+ (skipIfSame and:[(sel := compiler selector) notNil]) ifTrue:[
+ oldMethod := aClass compiledMethodAt:sel.
+ oldMethod notNil ifTrue:[
+ oldMethod source = aString ifTrue:[
+ oldMethod isInvalid ifFalse:[
+ silencio ifFalse:[
+ Transcript showCR:(' unchanged: ',aClass name,' ',compiler selector)
+ ].
+ "
+ same. however, category may be different
+ "
+ (cat notNil and:[cat ~= oldMethod category]) ifTrue:[
+ oldMethod category:cat.
+ oldMethod changed:#category.
"/ aClass updateRevisionString.
- aClass addChangeRecordForMethodCategory:oldMethod category:cat.
- silencio ifFalse:[
- Transcript showCR:(' (category change only)')
- ].
- ].
- "
- and package may be too.
- "
- pkg := Class packageQuerySignal raise.
- (pkg notNil and:[pkg ~~ oldMethod package]) ifTrue:[
- oldMethod package:pkg.
- silencio ifFalse:[
- Transcript showCR:(' (package-id change only)')
- ].
- ].
- ^ oldMethod
- ]
- ]
- ]
- ].
- tree := compiler parseMethodBody.
- compiler tree:tree.
- ]
+ aClass addChangeRecordForMethodCategory:oldMethod category:cat.
+ silencio ifFalse:[
+ Transcript showCR:(' (category change only)')
+ ].
+ ].
+ "
+ and package may be too.
+ "
+ pkg := Class packageQuerySignal raise.
+ (pkg notNil and:[pkg ~~ oldMethod package]) ifTrue:[
+ oldMethod package:pkg.
+ silencio ifFalse:[
+ Transcript showCR:(' (package-id change only)')
+ ].
+ ].
+ ^ oldMethod
+ ]
+ ]
+ ]
+ ].
+ tree := compiler parseMethodBody.
+ compiler tree:tree.
+ ]
].
(compiler errorFlag or:[tree == #Error]) ifTrue:[
- compiler showErrorMessageForClass:aClass.
- ^ #Error
+ compiler showErrorMessageForClass:aClass.
+ ^ #Error
].
sel := compiler selector.
"if no error and also no selector ..."
sel isNil ifTrue:[
- "... it was just a comment or other empty stuff"
- ^ nil
+ "... it was just a comment or other empty stuff"
+ ^ nil
].
lazy ifFalse:[
- "
- freak-out support ...
- "
- (compiler hasNonOptionalPrimitiveCode
- or:[(compiler hasPrimitiveCode and:[self canCreateMachineCode])
- or:[STCCompilation == #always and:[sel ~~ #doIt]]]) ifTrue:[
- newMethod := compiler
- compileToMachineCode:aString
- forClass:aClass
- inCategory:cat
- notifying:requestor
- install:install
- skipIfSame:skipIfSame
- silent:silent.
-
- newMethod == #Error ifTrue:[
- compiler showErrorMessageForClass:aClass.
- ^ #Error
- ].
-
- (newMethod == #CannotLoad) ifTrue:[
- newMethod := compiler trappingStubMethodFor:aString inCategory:cat.
-
- keptOldCode := false.
- install ifTrue:[
- "/
- "/ be very careful with existing methods
- "/ (otherwise, you could easily make your system unusable in systems which cannot load)
- "/
- sel notNil ifTrue:[
- oldMethod := aClass compiledMethodAt:sel
- ].
- (oldMethod notNil and:[oldMethod code ~= newMethod code]) ifTrue:[
- answer := Dialog
- confirm:'installation of binary code is not possible or disabled.
+ "
+ freak-out support ...
+ "
+ (compiler hasNonOptionalPrimitiveCode
+ or:[(compiler hasPrimitiveCode and:[self canCreateMachineCode])
+ or:[STCCompilation == #always and:[sel ~~ #doIt]]]) ifTrue:[
+ newMethod := compiler
+ compileToMachineCode:aString
+ forClass:aClass
+ inCategory:cat
+ notifying:requestor
+ install:install
+ skipIfSame:skipIfSame
+ silent:silent.
+
+ newMethod == #Error ifTrue:[
+ compiler showErrorMessageForClass:aClass.
+ ^ #Error
+ ].
+
+ (newMethod == #CannotLoad) ifTrue:[
+ newMethod := compiler trappingStubMethodFor:aString inCategory:cat.
+
+ keptOldCode := false.
+ install ifTrue:[
+ "/
+ "/ be very careful with existing methods
+ "/ (otherwise, you could easily make your system unusable in systems which cannot load)
+ "/
+ sel notNil ifTrue:[
+ oldMethod := aClass compiledMethodAt:sel
+ ].
+ (oldMethod notNil and:[oldMethod code ~= newMethod code]) ifTrue:[
+ answer := Dialog
+ confirm:'installation of binary code is not possible or disabled.
Shall I use the old methods functionality
or instead create a dummy trap method for it ?
@@ -337,31 +337,31 @@
Close this warnBox to abort the compilation.
'
- yesLabel:'trap code'
- noLabel:'keep old'.
- answer isNil ifTrue:[
- ^ #Error
- ].
- answer == false ifTrue:[
- newMethod code:(oldMethod code).
- keptOldCode := true.
- ].
- ].
- aClass addSelector:sel withMethod:newMethod
- ].
- Transcript show:'*** '.
- sel notNil ifTrue:[
- Transcript show:(sel ,' ')
- ].
- keptOldCode ifTrue:[
- msg := 'not really compiled - method still shows previous behavior'.
- ] ifFalse:[
- msg := 'not compiled to machine code - created a stub instead.'.
- ].
- Transcript showCR:msg.
- ].
- ^ newMethod
- ].
+ yesLabel:'trap code'
+ noLabel:'keep old'.
+ answer isNil ifTrue:[
+ ^ #Error
+ ].
+ answer == false ifTrue:[
+ newMethod code:(oldMethod code).
+ keptOldCode := true.
+ ].
+ ].
+ aClass addSelector:sel withMethod:newMethod
+ ].
+ Transcript show:'*** '.
+ sel notNil ifTrue:[
+ Transcript show:(sel ,' ')
+ ].
+ keptOldCode ifTrue:[
+ msg := 'not really compiled - method still shows previous behavior'.
+ ] ifFalse:[
+ msg := 'not compiled to machine code - created a stub instead.'.
+ ].
+ Transcript showCR:msg.
+ ].
+ ^ newMethod
+ ].
].
"
@@ -370,59 +370,59 @@
compile itself when first called.
"
lazy ifTrue:[
- newMethod := LazyMethod new.
- (ClassCategoryReader sourceMode == #sourceReference) ifTrue:[
- sourceFile := ObjectMemory nameForSources.
- sourceFile notNil ifTrue:[
- sourceStream := sourceFile asFilename appendingWriteStream.
- ]
- ].
- sourceStream isNil ifTrue:[
- newMethod source:aString.
- ] ifFalse:[
- sourceStream setToEnd.
- pos := sourceStream position.
- sourceStream nextChunkPut:aString.
- sourceStream close.
- newMethod sourceFilename:sourceFile position:pos.
- ].
- newMethod category:cat.
- newMethod package:(Class packageQuerySignal raise).
+ newMethod := LazyMethod new.
+ (ClassCategoryReader sourceMode == #sourceReference) ifTrue:[
+ sourceFile := ObjectMemory nameForSources.
+ sourceFile notNil ifTrue:[
+ sourceStream := sourceFile asFilename appendingWriteStream.
+ ]
+ ].
+ sourceStream isNil ifTrue:[
+ newMethod source:aString.
+ ] ifFalse:[
+ sourceStream setToEnd.
+ pos := sourceStream position.
+ sourceStream nextChunkPut:aString.
+ sourceStream close.
+ newMethod sourceFilename:sourceFile position:pos.
+ ].
+ newMethod category:cat.
+ newMethod package:(Class packageQuerySignal raise).
"/ Project notNil ifTrue:[
"/ newMethod package:(Project currentPackageName)
"/ ].
- aClass addSelector:sel withLazyMethod:newMethod.
- ^ newMethod
+ aClass addSelector:sel withLazyMethod:newMethod.
+ ^ newMethod
].
(primNr := compiler primitiveNumber) isNil ifTrue:[
- "
- produce symbolic code first
- "
- symbolicCodeArray := compiler genSymbolicCode.
-
- (symbolicCodeArray == #Error) ifTrue:[
- Transcript show:' '.
- sel notNil ifTrue:[
- Transcript show:(sel ,' ')
- ].
- Transcript showCR:'translation error'.
- ^ #Error
- ].
-
- "
- take this, producing bytecode
- (someone willin' to make machine code :-)
- "
- ((compiler genByteCodeFrom:symbolicCodeArray) == #Error) ifTrue:[
- Transcript show:' '.
- sel notNil ifTrue:[
- Transcript show:(sel ,' ')
- ].
- Transcript showCR:'relocation error - must be simplified'.
- ^ #Error
- ].
+ "
+ produce symbolic code first
+ "
+ symbolicCodeArray := compiler genSymbolicCode.
+
+ (symbolicCodeArray == #Error) ifTrue:[
+ Transcript show:' '.
+ sel notNil ifTrue:[
+ Transcript show:(sel ,' ')
+ ].
+ Transcript showCR:'translation error'.
+ ^ #Error
+ ].
+
+ "
+ take this, producing bytecode
+ (someone willin' to make machine code :-)
+ "
+ ((compiler genByteCodeFrom:symbolicCodeArray) == #Error) ifTrue:[
+ Transcript show:' '.
+ sel notNil ifTrue:[
+ Transcript show:(sel ,' ')
+ ].
+ Transcript showCR:'relocation error - must be simplified'.
+ ^ #Error
+ ].
].
"
@@ -430,9 +430,9 @@
"
newMethod := compiler createMethod.
primNr notNil ifTrue:[
- newMethod code:(compiler checkForPrimitiveCode:primNr).
+ newMethod code:(compiler checkForPrimitiveCode:primNr).
] ifFalse:[
- newMethod byteCode:(compiler code).
+ newMethod byteCode:(compiler code).
].
"/ newMethod numberOfMethodVars:(compiler numberOfMethodVars).
"/ newMethod numberOfMethodArgs:(compiler numberOfMethodArgs).
@@ -442,9 +442,9 @@
if there where any corrections, install the updated source
"
(newSource := compiler correctedSource) notNil ifTrue:[
- newMethod source:newSource
+ newMethod source:newSource
] ifFalse:[
- newMethod source:aString.
+ newMethod source:aString.
].
newMethod category:cat.
newMethod package:(Class packageQuerySignal raise).
@@ -453,11 +453,11 @@
"/ ].
install ifTrue:[
- aClass addSelector:sel withMethod:newMethod
+ aClass addSelector:sel withMethod:newMethod
].
silencio ifFalse:[
- Transcript showCR:(' compiled: ', aClass name,' ', sel)
+ Transcript showCR:(' compiled: ', aClass name,' ', sel)
].
^ newMethod
@@ -581,7 +581,7 @@
or nil if not found."
CC isNil ifTrue:[
- ^ 'cc'
+ ^ 'cc'
].
^ CC
@@ -1341,7 +1341,237 @@
"
should add more here, to be able to fileIn ST-80 methods
containing primitive calls (who gives me the numbers ... ?)
- "
+ mhmh - got some ..."
+
+ "/ 18 Number @
+ "/ 21 LargePositiveInteger +
+ "/ 22 LargePositiveInteger -
+ "/ 29 LargePositiveInteger *
+ "/ 30 LargePositiveInteger /
+ "/ 31 LargePositiveInteger \\
+ "/ 32 LargePositiveInteger //
+ "/ 34 LargePositiveInteger bitAnd:
+ "/ 35 LargePositiveInteger bitOr:
+ "/ 36 LargePositiveInteger bitXor:
+ "/ 37 LargePositiveInteger bitShift:
+ "/ 40 SmallInteger asFloat
+ "/ 41 Float +
+ "/ 42 Float -
+ "/ 49 Float *
+ "/ 50 Float /
+ "/ 52 Float fractionPart
+ "/ 54 Float timesTwoPower:
+ "/ 70 Behavior basicNew
+ "/ 71 Behavior basicNew:
+ "/ 89 Behavior flushVMmethodCache
+ "/ 91 InputState primCursorLocPut:
+ "/ 105 ByteArray replaceElementsFrom:to:withByteArray:startingAt:
+ "/ 223 ByteString =
+ "/ 306 ObjectMemory class sizesAtStartup
+ "/ 307 ObjectMemory class defaultSizesAtStartup
+ "/ 309 ObjectMemory class defaultThresholds
+ "/ 326 ObjectMemory class getMemoryUsageAndZeroFragmentationStatisticsIf:
+ "/ 395 ExternalInterface ???
+ "/ 400 FormBitmap class newWidth:height:
+ "/ 414 TwoByteString replaceElementsFrom:to:withTwoByteString:startingAt:
+ "/ 415 TwoByteString =
+ "/ 417 String trueCompare:
+ "/ 418 ByteString nextIndexOf:from:to:
+ "/ 419 ByteString prevIndexOf:from:to:
+ "/ 422 WeakArray indexOf:replaceWith:startingAt:stoppingAt:
+ "/ 522 Behavior flushVMmethodCacheEntriesFor:
+ "/ 524 Context nFromVPC:
+ "/ 525 Context vFromNPC:
+ "/ 532 Object shallowCopy
+ "/ 536 Behavior atomicAllInstances
+ "/ 537 Object allOwners
+ "/ 538 ObjectMemory class allObjects
+ "/ 546 UninterpretedBytes longAt:
+ "/ 548 UninterpretedBytes floatAt:
+ "/ 550 UninterpretedBytes longFloatAt:
+ "/ 544 UninterpretedBytes unsignedLongAt:
+ "/ 559 ByteArray replaceBytesFrom:to:with:startingAt:
+ "/ 560 Double class fromNumber:
+ "/ 561 Double +
+ "/ 562 Double -
+ "/ 569 Double *
+ "/ 570 Double /
+ "/ 572 Double fractionPart
+ "/ 574 Double timesTwoPower:
+ "/ 576 Double sin
+ "/ 577 Double cos
+ "/ 578 Double tan
+ "/ 579 Double arcSin
+ "/ 580 Double arcCos
+ "/ 581 Double arcTan
+ "/ 582 Double sqrt
+ "/ 583 Double ln
+ "/ 584 Double exp
+ "/ 585 Double raisedTo:
+ "/ 587 Double floorLog10
+ "/ 588 Double asFloat
+ "/ 591 Float cos
+ "/ 592 Float arcSin
+ "/ 593 Float arcCos
+ "/ 600 Float sin
+ "/ 601 Float tan
+ "/ 602 Float arcTan
+ "/ 603 Float sqrt
+ "/ 604 Float ln
+ "/ 605 Float exp
+ "/ 606 Float raisedTo:
+ "/ 609 Float floorLog10
+ "/ 610 Filename getDatesErrInto:
+ "/ 614 DosFilename class getVolumes
+ "/ 615 UnixFilename primSetProtection:errInto:
+ "/ 616 UnixFilename class primSetCreationMask:errInto:
+ "/ 617 UnixFilename primGetProtectionErrInto:
+ "/ 620 Filename listDirectoryErrInto:
+ "/ 621 Filename deleteErrInto:
+ "/ 622 Filename isDirectoryErrInto:
+ "/ 623 Filename renameTo:errInto:
+ "/ 624 Filename makeDirectoryErrInto:
+ "/ 625 Filename class defaultDirectoryErrInto:
+ "/ 626 Filename fileSizeErrInto:
+ "/ 627 Filename isWritableErrInto:
+ "/ 628 Filename setWritable:errInto:
+ "/ 629 Filename existsErrInto:
+ "/ 630 SocketAccessor setOptionsLevel:name:value:
+ "/ 631 SocketAccessor getOptionsLevel:name:
+ "/ 632 SocketAccessor primGetName
+ "/ 633 SocketAccessor primGetPeer
+ "/ 634 SocketAccessor atMark
+ "/ 637 UnixTtyAccessor primGetOptions
+ "/ 638 UnixTtyAccessor setOptions:
+ "/ 639 UnixRealTtyAccessor modemBits:mask:sendBreak:
+ "/ 640 IPSocketAddress class primHostAddressByName:
+ "/ 641 IPSocketAddress class netAddressByName:
+ "/ 642 IPSocketAddress class protocolNumberByName:
+ "/ 643 IPSocketAddress class servicePortByName:
+ "/ 645 IPSocketAddress class primHostNameByAddress:
+ "/ 646 IPSocketAddress class netNameByAddress:
+ "/ 647 IPSocketAddress class protocolNameByNumber:
+ "/ 648 IPSocketAddress class serviceNameByPort:
+ "/ 649 SocketAccessor class getHostname
+ "/ 650 Filename primOpenFileNamed:direction:creation:errorInto:
+ "/ 651 IOAccessor primClose
+ "/ 652 UnixPipeAccessor class primPipeErrorInto:
+ "/ 653 UnixPseudoTtyAccessor class primPtyErrorInto:
+ "/ 654 SocketAccessor class primPairErrorInto:
+ "/ 655 UnixRealTtyAccessor class primOpen:errInto:
+ "/ 660 IOAccessor primReadInto:startingAt:for:
+ "/ 661 IOAccessor primWriteFrom:startingAt:for:
+ "/ 662 IOAccessor primSeekTo:
+ "/ 664 IOAccessor truncateTo:
+ "/ 665 DosDiskFileAccessor commit
+ "/ 666 IOAccessor primGetSize
+ "/ 667 MacDiskFileAccessor lock:for:
+ "/ 669 UnixIOAccessor bytesForRead
+ "/ 670 SocketAccessor class primFamily:type:protocol:errInto:
+ "/ 671 SocketAccessor primAccept
+ "/ 672 SocketAccessor bindTo:
+ "/ 673 SocketAccessor listenFor:
+ "/ 674 SocketAccessor primConnectTo:
+ "/ 675 SocketAccessor primReceiveFrom:buffer:start:for:flags:
+ "/ 676 SocketAccessor sendTo:buffer:start:for:flags:
+ "/ 677 SocketAccessor shutdown:
+ "/ 681 UnixProcess class primFork:arguments:environment:descriptors:errorTo:
+ "/ 682 UnixProcess class reapOne
+ "/ 683 UnixProcess kill:
+ "/ 690 CEnvironment class primEnvironment
+ "/ 697 OSErrorHolder class errorDescriptionFor:
+ "/ 697 ErrorHolder class errorDescriptionFor:
+ "/ 698 SocketAccessor class primInit:
+ "/ 700 ParagraphEditor class getExternalSelectionOrNil:
+ "/ 701 ParagraphEditor class putExternalSelection:with:
+ "/ 705 Screen ringBell
+ "/ 706 Cursor class primOpenImage:mask:hotSpotX:hotSpotY:background:foreground:
+ "/ 707 Cursor primBeCursor
+ "/ 708 Cursor primFreeCursor
+ "/ 772 SoundManager enumerateSoundsFrom:
+ "/ 773 SoundManager playSoundFrom:sound:
+ "/ 774 SoundManager simpleBeep:
+ "/ 775 Pixmap primFromClipboard
+ "/ 776 Pixmap toClipboard
+ "/ 808 Context findNextMarkedUpTo:
+ "/ 809 Context terminateTo:
+ "/ 710 DosTtyAccessor class primOpen:errInto:
+ "/ 711 DosTtyAccessor primClose
+ "/ 712 DosTtyAccessor primReadInto:startingAt:for:
+ "/ 713 DosTtyAccessor primWriteFrom:startingAt:for:
+ "/ 714 DosTtyAccessor primGetOptions
+ "/ 715 DosTtyAccessor primSetOptions:
+ "/ 716 DosTtyAccessor setSem:forWrite:
+ "/ 717 DosTtyAccessor modemBits:mask:sendBreak:
+ "/ 750 MacFilename class getVolumes
+ "/ 752 MacFilename primSetCreator:type:errInto:
+ "/ 754 MacIOAccessor class getAccessories
+ "/ 755 MacIOAccessor class runAccessory:
+ "/ 756 MacOSFilename class getFileTypes:errInto:
+ "/ 757 MacOSFilename putFileWithPrompt:errInto:
+ "/ 758 MacOSFilename getFileInfoErrInto:
+ "/ 759 MacOSFilename stringFromVRefErrInto:
+ "/ 761 MacOSFilename class getStartupFilesErrInto:
+ "/ 770 DosFilename printPSFileErrInto:
+ "/ 771 DosFilename printTextFileErrInto:
+ "/ 780 MacTtyAccessor class primOpen:errInto:
+ "/ 781 MacTtyAccessor primClose
+ "/ 782 MacTtyAccessor primReadInto:startingAt:for:
+ "/ 783 MacTtyAccessor primWriteFrom:startingAt:for:
+ "/ 786 MacTtyAccessor primGetOptions
+ "/ 787 MacTtyAccessor setOptions:
+ "/ 788 MacTtyAccessor primBreak:
+ "/ 790 MacTtyAccessor primGetStatus
+ "/ 792 MacTtyAccessor setSem:forWrite:
+ "/ 793 MacTtyAccessor primAssertDTR:
+ "/ 794 MacTtyAccessor primGetSize
+ "/ 933 ByteArray copyBitsClippedStride:...
+ "/ 934 ByteArray tileBits32By32Stride:...
+ "/ 935 Screen dragShape:...
+ "/ 936 Screen resizeRectangle...
+ "/ 937 Screen displayShape:...
+ "/ 938 Window resizeFromUserWithMinimum:maximum:
+ "/ 940 Window primClose
+ "/ 942 Window getDimensions
+ "/ 943 Window moveTo:resize:
+ "/ 944 Window primMap
+ "/ 945 Window class primNewAt:extent:min:max:windowType:
+ "/ 946 Screen flush
+ "/ 947 Screen getScreenDimensions
+ "/ 948 Window unmap
+ "/ 950 Screen sync
+ "/ 951 Window setIconMask:
+ "/ 952 Window label:iconLabel:
+ "/ 953 Window raise
+ "/ 954 Window lower
+ "/ 955 Screen queryStackingOrder
+ "/ 956 TextMeasurer primScanCharactersFrom:...
+ "/ 957 GraphicsContext displayMappedString:from:to:at:withMap:
+ "/ 959 Window setBackgroundPixel:
+ "/ 960 Screen class primOpen:
+ "/ 965 UnmappableSurface contentsOfAreaOriginX:y:width:height:
+ "/ 966 Window contentsOfAreaOriginX:y:width:height:
+ "/ 967 Screen contentsOfAreaOriginX:y:width:height:
+ "/ 970 Mask class primExtent:depth:
+ "/ 971 Mask privateClose
+ "/ 976 GraphicsContext displayCharacterOfIndex:at:
+ "/ 978 DeviceFont class listFonts
+ "/ 979 DeviceFont primLoadFont
+ "/ 980 DeviceFont primUnLoadFont
+ "/ 985 GraphicsContext displayLineFrom:to:
+ "/ 986 GraphicsContext displayPolyline:at:
+ "/ 987 GraphicsContext displayPolygon:at:
+ "/ 988 GraphicsContext primDisplayRectangleOrigin:extent:
+ "/ 989 GraphicsContext primDisplayRectangularBorderOrigin:extent:
+ "/ 990 GraphicsContext primDisplayArcBBoxOrigin:extent:startAngle:sweepAngle:
+ "/ 991 GraphicsContext primDisplayWedgeBBoxOrigin:extent:startAngle:sweepAngle:
+ "/ 992 GraphicsContext displayMask:at:"
+ "/ 993 GraphicsContext displayUninterpretedImageBits:at:
+ "/ 994 GraphicsContext primCopyRectangularAreaExtent:from:sourceOffset:destinationOffset:
+ "/ 995 GraphicsContext primCopyMaskedArea:from:sourceOffset:destinationOffset:
+ "/ 996 Screen deviceColormap
+ "/ 998 GraphicsContext displayUninterpretedMonoImageBits:foreground:background:at:
+
cls notNil ifTrue:[
^ (cls compiledMethodAt:sel) code
].
@@ -1353,13 +1583,13 @@
newMethod := Method new:(litArray size).
litArray notNil ifTrue:[
- "/ fixup CheapBlocks method-field in literal array,
- litArray do:[:aLiteral |
- (aLiteral isMemberOf:CheapBlock) ifTrue:[
- aLiteral setMethod:newMethod.
- ]
- ].
- newMethod literals:litArray
+ "/ fixup CheapBlocks method-field in literal array,
+ litArray do:[:aLiteral |
+ (aLiteral isMemberOf:CheapBlock) ifTrue:[
+ aLiteral setMethod:newMethod.
+ ]
+ ].
+ newMethod literals:litArray
].
newMethod numberOfMethodVars:(self numberOfMethodVars).
@@ -1367,7 +1597,7 @@
newMethod stackSize:(self maxStackDepth).
primitiveResource notNil ifTrue:[
- newMethod setResourceFlag
+ newMethod setResourceFlag
].
^ newMethod
@@ -1393,238 +1623,238 @@
needRetry := true.
symCodeSize := symbolicCodeArray size.
ShareCode ifTrue:[
- codeBytes := self checkForCommonCode:symbolicCodeArray.
- codeBytes notNil ifTrue:[
- ^ self
- ].
+ codeBytes := self checkForCommonCode:symbolicCodeArray.
+ codeBytes notNil ifTrue:[
+ ^ self
+ ].
].
codeSize := symCodeSize.
[needRetry] whileTrue:[
- stackDepth := 0.
- maxStackDepth := 0.
-
- codeBytes := ByteArray uninitializedNew:codeSize.
- relocInfo := Array basicNew:(codeSize + 1).
- symIndex := 1.
- codeIndex := 1.
-
- needRetry := false.
- round := round + 1.
-
- [symIndex <= symCodeSize] whileTrue:[
- relocInfo at:symIndex put:codeIndex.
-
- codeSymbol := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- stackDelta := 0.
- extra := extraLiteral := nil.
- lineno := false.
-
- self appendByteCodeFor:codeSymbol.
-
- extraLiteral notNil ifTrue:[
- self addLiteral:extraLiteral
- ].
-
- lineno ifTrue:[
- self appendByte:((symbolicCodeArray at:symIndex) min:255).
- symIndex := symIndex + 1.
- codeSymbol == #lineno16 ifTrue:[
- self appendByte:((symbolicCodeArray at:symIndex) min:255).
- symIndex := symIndex + 1
- ]
- ].
-
- extra notNil ifTrue:[
- nextSym := symbolicCodeArray at:symIndex.
-
- (extra == #number) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- self appendSignedByte:index
-
- ] ifFalse:[ (extra == #number16) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 2.
- self appendSignedWord:index
-
- ] ifFalse:[ (extra == #unsigned16) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 2.
- self appendWord:index
-
- ] ifFalse:[ (extra == #index) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- self appendByte:index
-
- ] ifFalse:[ (extra == #lit) ifTrue:[
- index := self addLiteral:nextSym.
- symIndex := symIndex + 1.
- self appendByte:index
-
- ] ifFalse:[ (extra == #speciallit) ifTrue:[
- index := self addLiteral:nextSym.
- index > 255 ifTrue:[
- self parseError:'too many globals (' ,
- (symbolicCodeArray at:symIndex) ,
- ' index=' , index printString ,
- ') in method - please simplify'.
- ^ #Error
- ].
- symIndex := symIndex + 1.
- self appendByte:index.
-
- ] ifFalse:[ (extra == #speciallitS) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- self appendByte:index.
-
- ] ifFalse:[ (extra == #speciallitL) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 2.
- self appendWord:index.
-
- ] ifFalse:[ (extra == #offset) ifTrue:[
- relocInfo at:symIndex put:codeIndex.
- self addReloc:symIndex.
- symIndex := symIndex + 1.
- self appendByte:0
-
- ] ifFalse:[ (extra == #indexLevel) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- self appendByte:index.
- level := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:level
-
- ] ifFalse:[ (extra == #offsetNvarNarg) ifTrue:[
- relocInfo at:symIndex put:codeIndex.
- self addReloc:symIndex.
- symIndex := symIndex + 1.
- self appendEmptyByte.
- nvars := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:nvars.
- level := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:level
-
- ] ifFalse:[ (extra == #absoffset) ifTrue:[
- relocInfo at:symIndex put:codeIndex.
- self addReloc:symIndex.
- addr := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:(addr bitAnd:16rFF).
- self appendByte:((addr bitShift:-8) bitAnd:16rFF).
-
- ] ifFalse:[ (extra == #absoffsetNvarNarg) ifTrue:[
- relocInfo at:symIndex put:codeIndex.
- self addReloc:symIndex.
- addr := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:(addr bitAnd:16rFF).
- self appendByte:((addr bitShift:-8) bitAnd:16rFF).
- nvars := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:nvars.
- level := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:level
-
- ] ifFalse:[ (extra == #special) ifTrue:[
- ((codeSymbol == #send)
- or:[codeSymbol == #sendSelf
- or:[codeSymbol == #superSend
- or:[codeSymbol == #hereSend]]]) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- nargs := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:nargs.
- self appendByte:index.
-
- (codeSymbol == #superSend
- or:[codeSymbol == #hereSend]) ifTrue:[
- index := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:index
- ].
- stackDelta := nargs negated.
- codeSymbol == #sendSelf ifTrue:[
- stackDelta := stackDelta + 1
- ]
- ] ifFalse:[ (codeSymbol == #sendDrop) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- nargs := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:nargs.
- self appendByte:index.
- stackDelta := (nargs + 1) negated
- ]]
-
- ] ifFalse:[ (extra == #specialL) ifTrue:[
- ((codeSymbol == #sendL)
- or:[codeSymbol == #sendSelfL
- or:[codeSymbol == #superSendL
- or:[codeSymbol == #hereSendL]]]) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 2.
- nargs := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 1.
- self appendByte:nargs.
- self appendWord:index.
- (codeSymbol == #superSendL
- or:[codeSymbol == #hereSendL]) ifTrue:[
- index := symbolicCodeArray at:symIndex.
- symIndex := symIndex + 2.
- self appendWord:index.
- ].
- stackDelta := nargs negated.
- codeSymbol == #sendSelfL ifTrue:[
- stackDelta := stackDelta + 1
- ]
- ]
- ] ifFalse:[ (extra == #specialSend) ifTrue:[
- index := nextSym.
- symIndex := symIndex + 1.
- self appendByte:index.
-
- ] ifFalse:[
- "/ self halt:'internal error'
+ stackDepth := 0.
+ maxStackDepth := 0.
+
+ codeBytes := ByteArray uninitializedNew:codeSize.
+ relocInfo := Array basicNew:(codeSize + 1).
+ symIndex := 1.
+ codeIndex := 1.
+
+ needRetry := false.
+ round := round + 1.
+
+ [symIndex <= symCodeSize] whileTrue:[
+ relocInfo at:symIndex put:codeIndex.
+
+ codeSymbol := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ stackDelta := 0.
+ extra := extraLiteral := nil.
+ lineno := false.
+
+ self appendByteCodeFor:codeSymbol.
+
+ extraLiteral notNil ifTrue:[
+ self addLiteral:extraLiteral
+ ].
+
+ lineno ifTrue:[
+ self appendByte:((symbolicCodeArray at:symIndex) min:255).
+ symIndex := symIndex + 1.
+ codeSymbol == #lineno16 ifTrue:[
+ self appendByte:((symbolicCodeArray at:symIndex) min:255).
+ symIndex := symIndex + 1
+ ]
+ ].
+
+ extra notNil ifTrue:[
+ nextSym := symbolicCodeArray at:symIndex.
+
+ (extra == #number) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ self appendSignedByte:index
+
+ ] ifFalse:[ (extra == #number16) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 2.
+ self appendSignedWord:index
+
+ ] ifFalse:[ (extra == #unsigned16) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 2.
+ self appendWord:index
+
+ ] ifFalse:[ (extra == #index) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ self appendByte:index
+
+ ] ifFalse:[ (extra == #lit) ifTrue:[
+ index := self addLiteral:nextSym.
+ symIndex := symIndex + 1.
+ self appendByte:index
+
+ ] ifFalse:[ (extra == #speciallit) ifTrue:[
+ index := self addLiteral:nextSym.
+ index > 255 ifTrue:[
+ self parseError:'too many globals (' ,
+ (symbolicCodeArray at:symIndex) ,
+ ' index=' , index printString ,
+ ') in method - please simplify'.
+ ^ #Error
+ ].
+ symIndex := symIndex + 1.
+ self appendByte:index.
+
+ ] ifFalse:[ (extra == #speciallitS) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ self appendByte:index.
+
+ ] ifFalse:[ (extra == #speciallitL) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 2.
+ self appendWord:index.
+
+ ] ifFalse:[ (extra == #offset) ifTrue:[
+ relocInfo at:symIndex put:codeIndex.
+ self addReloc:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:0
+
+ ] ifFalse:[ (extra == #indexLevel) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ self appendByte:index.
+ level := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:level
+
+ ] ifFalse:[ (extra == #offsetNvarNarg) ifTrue:[
+ relocInfo at:symIndex put:codeIndex.
+ self addReloc:symIndex.
+ symIndex := symIndex + 1.
+ self appendEmptyByte.
+ nvars := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:nvars.
+ level := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:level
+
+ ] ifFalse:[ (extra == #absoffset) ifTrue:[
+ relocInfo at:symIndex put:codeIndex.
+ self addReloc:symIndex.
+ addr := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:(addr bitAnd:16rFF).
+ self appendByte:((addr bitShift:-8) bitAnd:16rFF).
+
+ ] ifFalse:[ (extra == #absoffsetNvarNarg) ifTrue:[
+ relocInfo at:symIndex put:codeIndex.
+ self addReloc:symIndex.
+ addr := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:(addr bitAnd:16rFF).
+ self appendByte:((addr bitShift:-8) bitAnd:16rFF).
+ nvars := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:nvars.
+ level := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:level
+
+ ] ifFalse:[ (extra == #special) ifTrue:[
+ ((codeSymbol == #send)
+ or:[codeSymbol == #sendSelf
+ or:[codeSymbol == #superSend
+ or:[codeSymbol == #hereSend]]]) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ nargs := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:nargs.
+ self appendByte:index.
+
+ (codeSymbol == #superSend
+ or:[codeSymbol == #hereSend]) ifTrue:[
+ index := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:index
+ ].
+ stackDelta := nargs negated.
+ codeSymbol == #sendSelf ifTrue:[
+ stackDelta := stackDelta + 1
+ ]
+ ] ifFalse:[ (codeSymbol == #sendDrop) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ nargs := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:nargs.
+ self appendByte:index.
+ stackDelta := (nargs + 1) negated
+ ]]
+
+ ] ifFalse:[ (extra == #specialL) ifTrue:[
+ ((codeSymbol == #sendL)
+ or:[codeSymbol == #sendSelfL
+ or:[codeSymbol == #superSendL
+ or:[codeSymbol == #hereSendL]]]) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 2.
+ nargs := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 1.
+ self appendByte:nargs.
+ self appendWord:index.
+ (codeSymbol == #superSendL
+ or:[codeSymbol == #hereSendL]) ifTrue:[
+ index := symbolicCodeArray at:symIndex.
+ symIndex := symIndex + 2.
+ self appendWord:index.
+ ].
+ stackDelta := nargs negated.
+ codeSymbol == #sendSelfL ifTrue:[
+ stackDelta := stackDelta + 1
+ ]
+ ]
+ ] ifFalse:[ (extra == #specialSend) ifTrue:[
+ index := nextSym.
+ symIndex := symIndex + 1.
+ self appendByte:index.
+
+ ] ifFalse:[
+ "/ self halt:'internal error'
- ]]]]]]]]]]]]]]]]
- ].
-
- stackDepth := stackDepth + stackDelta.
- (stackDepth > maxStackDepth) ifTrue:[
- maxStackDepth := stackDepth
- ]
- ].
- relocInfo at:symIndex put:codeIndex.
-
- needRetry ifFalse:[
- "
- now relocate - returns true if ok, false if we have to do it again
- (when short jumps have been changed to long jumps)
- "
- relocList notNil ifTrue:[
- needRetry := (self relocateWith:symbolicCodeArray relocInfo:relocInfo) not.
- "
- if returned with false, a relative jump was made into
- an absolute jump - need to start over with one more byte space
- "
- needRetry ifTrue:[
- relocList := nil.
- codeSize := codeSize + 1.
- ]
- ]
- ] ifTrue:[
- 'Compiler [info]: compiling again ...' infoPrintCR.
- ]
+ ]]]]]]]]]]]]]]]]
+ ].
+
+ stackDepth := stackDepth + stackDelta.
+ (stackDepth > maxStackDepth) ifTrue:[
+ maxStackDepth := stackDepth
+ ]
+ ].
+ relocInfo at:symIndex put:codeIndex.
+
+ needRetry ifFalse:[
+ "
+ now relocate - returns true if ok, false if we have to do it again
+ (when short jumps have been changed to long jumps)
+ "
+ relocList notNil ifTrue:[
+ needRetry := (self relocateWith:symbolicCodeArray relocInfo:relocInfo) not.
+ "
+ if returned with false, a relative jump was made into
+ an absolute jump - need to start over with one more byte space
+ "
+ needRetry ifTrue:[
+ relocList := nil.
+ codeSize := codeSize + 1.
+ ]
+ ]
+ ] ifTrue:[
+ 'Compiler [info]: compiling again ...' infoPrintCR.
+ ]
].
"code printNL."
^ errorFlag
@@ -1643,27 +1873,27 @@
thisStatement := tree.
[thisStatement notNil] whileTrue:[
- lastStatement := thisStatement.
- thisStatement codeForSideEffectOn:codeStream inBlock:nil for:self.
- thisStatement := thisStatement nextStatement
+ lastStatement := thisStatement.
+ thisStatement codeForSideEffectOn:codeStream inBlock:nil for:self.
+ thisStatement := thisStatement nextStatement
].
(lastStatement isNil or:[lastStatement isReturnNode not])
ifTrue:[
- "not a return - add retSelf"
- "
- if the last statement was a send for side-effect,
- replace the previous drop by a retSelf.
- In this case we have to keep an extra retSelf bacause
- it could be a jump target.
- "
- (lastStatement notNil
- and:[(code := codeStream contents) notNil
- and:[code size > 0
- and:[code last == #drop]]]) ifTrue:[
- codeStream backStep.
- codeStream nextPut:#retSelf
- ].
- codeStream nextPut:#retSelf
+ "not a return - add retSelf"
+ "
+ if the last statement was a send for side-effect,
+ replace the previous drop by a retSelf.
+ In this case we have to keep an extra retSelf bacause
+ it could be a jump target.
+ "
+ (lastStatement notNil
+ and:[(code := codeStream contents) notNil
+ and:[code size > 0
+ and:[code last == #drop]]]) ifTrue:[
+ codeStream backStep.
+ codeStream nextPut:#retSelf
+ ].
+ codeStream nextPut:#retSelf
].
^ codeStream contents
@@ -1691,12 +1921,12 @@
(sel == #bitOr:) ifTrue:[^ true].
(sel == #new:) ifTrue:[^ true].
(sel == #basicNew:) ifTrue:[
- "/ this one is critical - some redefine it
- receiver isGlobal ifTrue:[
- (#('String' 'ByteArray' 'Array'
- 'Point' 'Rectangle' 'Object')
- includes:receiver name) ifTrue:[^ true].
- ].
+ "/ this one is critical - some redefine it
+ receiver isGlobal ifTrue:[
+ (#('String' 'ByteArray' 'Array'
+ 'Point' 'Rectangle' 'Object')
+ includes:receiver name) ifTrue:[^ true].
+ ].
].
^ false
@@ -1746,12 +1976,12 @@
(sel == #new) ifTrue:[^ true].
(sel == #basicNew) ifTrue:[
- "/ this one is critical - some redefine it
- receiver isGlobal ifTrue:[
- (#('String' 'ByteArray' 'Array'
- 'Point' 'Rectangle' 'Object')
- includes:receiver name) ifTrue:[^ true].
- ].
+ "/ this one is critical - some redefine it
+ receiver isGlobal ifTrue:[
+ (#('String' 'ByteArray' 'Array'
+ 'Point' 'Rectangle' 'Object')
+ includes:receiver name) ifTrue:[^ true].
+ ].
].
^ false
@@ -1763,12 +1993,12 @@
"return true, if unary selector sel is a special selector"
^ #(Array String FloatArray DoubleArray
- Point Symbol Smalltalk Processor
- SmallInteger Character Float
- Process
- Set IdentitySet Dictionary IdentityDictionary
- Sempahore
- OrderedCollection
+ Point Symbol Smalltalk Processor
+ SmallInteger Character Float
+ Process
+ Set IdentitySet Dictionary IdentityDictionary
+ Sempahore
+ OrderedCollection
) includesIdentical:nm
"Created: 13.4.1996 / 20:15:35 / cg"
@@ -2039,7 +2269,7 @@
!ByteCodeCompiler methodsFor:'machine code generation'!
compileToMachineCode:aString forClass:aClass inCategory:cat
- notifying:requestor install:install skipIfSame:skipIfSame silent:silent
+ notifying:requestor install:install skipIfSame:skipIfSame silent:silent
"this is called to compile primitive code.
This is EXPERIMENTAL and going to be changed to raise an error,
an redefined in subclasses which can do it (either by direct compilation, or by calling
@@ -2057,19 +2287,19 @@
(mP isDirectory
and:[mP isReadable
and:[mP isWritable]]) ifFalse:[
- self parseError:('no access to tempDir: ' , mP pathName) position:1.
- ^ #CannotLoad
+ self parseError:('no access to tempDir: ' , mP pathName) position:1.
+ ^ #CannotLoad
].
ObjectFileLoader isNil ifTrue:[^ #CannotLoad].
STCCompilation == #never ifTrue:[^ #CannotLoad].
(stcPath := self class incrementalStcPath) isNil ifTrue:[
- self parseError:'no stc compiler available - cannot create machine code' position:1.
- ^ #CannotLoad
+ self parseError:'no stc compiler available - cannot create machine code' position:1.
+ ^ #CannotLoad
].
(ccPath := self class ccPath) isNil ifTrue:[
- self parseError:'no cc compiler available - cannot create machine code' position:1.
- ^ #CannotLoad
+ self parseError:'no cc compiler available - cannot create machine code' position:1.
+ ^ #CannotLoad
].
"/ generate a unique name, consisting of my processID and a sequence number
@@ -2077,7 +2307,7 @@
"/ lifes
SequenceNumber isNil ifTrue:[
- SequenceNumber := 0.
+ SequenceNumber := 0.
].
SequenceNumber := SequenceNumber + 1.
@@ -2086,153 +2316,153 @@
stFileName := './' , initName , '.st'.
stream := stFileName asFilename writeStream.
stream isNil ifTrue:[
- self parseError:'cannot create temporary sourcefile for compilation'.
- ^ #CannotLoad
+ self parseError:'cannot create temporary sourcefile for compilation'.
+ ^ #CannotLoad
].
[
- sep := stream class chunkSeparator.
-
- class := aClass.
- class isMeta ifTrue:[
- class := aClass soleInstance
- ].
- supers := class allSuperclasses.
- supers notNil ifTrue:[
- supers reverseDo:[:cls|
- cls ~~ Object ifTrue:[
- cls isLoaded ifFalse:[
- stream close.
- ^ #CannotLoad
- ].
- cls fileOutDefinitionOn:stream.
- stream nextPut:sep; cr.
- ]
- ]
- ].
- class fileOutDefinitionOn:stream.
- stream nextPut:sep; cr.
-
- class privateClassesSorted do:[:aPrivateClass |
- aPrivateClass fileOutDefinitionOn:stream.
- stream nextPut:sep; cr.
- ].
-
- class fileOutPrimitiveDefinitionsOn:stream.
-
- stream nextPut:sep.
- className := class name.
-
- stream nextPutAll:className.
- aClass isMeta ifTrue:[
- stream nextPutAll:' class'.
- ].
- stream nextPutAll:' methodsFor:'''; nextPutAll:cat; nextPutAll:''''.
- stream nextPut:sep; cr.
-
- stream nextPutLine:'"{ Line: 0 }"';
- nextChunkPut:aString;
- space; nextPut:sep.
-
- stream close.
-
- "
- call stc to compile it
- "
- oFileName := './' , initName , '.o'.
- cFileName := './' , initName , '.c'.
- oFileName asFilename delete.
- cFileName asFilename delete.
-
- stcFlags := '-commonSymbols +sharedLibCode +newIncremental -E:errorOutput -N' , initName .
- cFlags := OperatingSystem getOSDefine.
- cFlags isNil ifTrue:[
- cFlags := ''
- ].
-
- STCCompilationDefines notNil ifTrue:[
- cFlags := cFlags , ' ' , STCCompilationDefines
- ].
- STCCompilationIncludes notNil ifTrue:[
- stcFlags := STCCompilationIncludes , ' ' , stcFlags.
- cFlags := cFlags , ' ' , STCCompilationIncludes.
- ].
- STCCompilationOptions notNil ifTrue:[
- stcFlags := STCCompilationOptions , ' ' , stcFlags
- ].
- CCCompilationOptions notNil ifTrue:[
- cFlags := cFlags , ' ' , CCCompilationOptions
- ].
-
- command := stcPath , ' ' , stcFlags , ' -C ' , stFileName.
+ sep := stream class chunkSeparator.
+
+ class := aClass.
+ class isMeta ifTrue:[
+ class := aClass soleInstance
+ ].
+ supers := class allSuperclasses.
+ supers notNil ifTrue:[
+ supers reverseDo:[:cls|
+ cls ~~ Object ifTrue:[
+ cls isLoaded ifFalse:[
+ stream close.
+ ^ #CannotLoad
+ ].
+ cls fileOutDefinitionOn:stream.
+ stream nextPut:sep; cr.
+ ]
+ ]
+ ].
+ class fileOutDefinitionOn:stream.
+ stream nextPut:sep; cr.
+
+ class privateClassesSorted do:[:aPrivateClass |
+ aPrivateClass fileOutDefinitionOn:stream.
+ stream nextPut:sep; cr.
+ ].
+
+ class fileOutPrimitiveDefinitionsOn:stream.
+
+ stream nextPut:sep.
+ className := class name.
+
+ stream nextPutAll:className.
+ aClass isMeta ifTrue:[
+ stream nextPutAll:' class'.
+ ].
+ stream nextPutAll:' methodsFor:'''; nextPutAll:cat; nextPutAll:''''.
+ stream nextPut:sep; cr.
+
+ stream nextPutLine:'"{ Line: 0 }"';
+ nextChunkPut:aString;
+ space; nextPut:sep.
+
+ stream close.
+
+ "
+ call stc to compile it
+ "
+ oFileName := './' , initName , '.o'.
+ cFileName := './' , initName , '.c'.
+ oFileName asFilename delete.
+ cFileName asFilename delete.
+
+ stcFlags := '-commonSymbols +sharedLibCode +newIncremental -E:errorOutput -N' , initName .
+ cFlags := OperatingSystem getOSDefine.
+ cFlags isNil ifTrue:[
+ cFlags := ''
+ ].
+
+ STCCompilationDefines notNil ifTrue:[
+ cFlags := cFlags , ' ' , STCCompilationDefines
+ ].
+ STCCompilationIncludes notNil ifTrue:[
+ stcFlags := STCCompilationIncludes , ' ' , stcFlags.
+ cFlags := cFlags , ' ' , STCCompilationIncludes.
+ ].
+ STCCompilationOptions notNil ifTrue:[
+ stcFlags := STCCompilationOptions , ' ' , stcFlags
+ ].
+ CCCompilationOptions notNil ifTrue:[
+ cFlags := cFlags , ' ' , CCCompilationOptions
+ ].
+
+ command := stcPath , ' ' , stcFlags , ' -C ' , stFileName.
"/ 'executing: ' infoPrint. command infoPrintCR.
- errorStream := 'errorOutput' asFilename writeStream.
-
- self activityNotification:'compiling (stc)'.
- ok := OperatingSystem
- executeCommand:command
- inputFrom:nil
- outputTo:errorStream
- errorTo:errorStream
- onError:[:stat|
- status := stat.
- false
- ].
-
- cFileName asFilename exists ifTrue:[
- ok ifFalse:[
- 'Compiler [info]: oops - system says it failed - but c-file is there ...' infoPrintCR.
- ok := true
- ]
- ] ifFalse:[
- ok := false
- ].
-
- ok ifTrue:[
- "/ now compile to machine code
-
- command := ccPath , ' ' , cFlags , ' -c ' , cFileName.
+ errorStream := 'errorOutput' asFilename writeStream.
+
+ self activityNotification:'compiling (stc)'.
+ ok := OperatingSystem
+ executeCommand:command
+ inputFrom:nil
+ outputTo:errorStream
+ errorTo:errorStream
+ onError:[:stat|
+ status := stat.
+ false
+ ].
+
+ cFileName asFilename exists ifTrue:[
+ ok ifFalse:[
+ 'Compiler [info]: oops - system says it failed - but c-file is there ...' infoPrintCR.
+ ok := true
+ ]
+ ] ifFalse:[
+ ok := false
+ ].
+
+ ok ifTrue:[
+ "/ now compile to machine code
+
+ command := ccPath , ' ' , cFlags , ' -c ' , cFileName.
"/ 'executing: ' infoPrint. command infoPrintCR.
- self activityNotification:'compiling (cc)'.
- ok := OperatingSystem
- executeCommand:command
- inputFrom:nil
- outputTo:errorStream
- errorTo:errorStream
- onError:[:stat|
- status := stat.
- false
- ].
-
- oFileName asFilename exists ifTrue:[
- ok ifFalse:[
- 'Compiler [info]: system says it failed - but o-file is there ...' infoPrintCR.
- ok := true
- ]
- ] ifFalse:[
- ok := false
- ].
-
- "for debugging - leave c intermediate"
- STCKeepCIntermediate == true ifFalse:[
- OperatingSystem removeFile:cFileName.
- ].
- ].
-
- ok ifFalse:[
- (status notNil and:[status couldNotExecute]) ifTrue:[
- eMsg := 'oops, no STC - cannot create machine code'
- ] ifFalse:[
- errorStream := 'errorOutput' asFilename readStream.
- errorStream notNil ifTrue:[
- errorMessages := errorStream contents.
- errorMessages notNil ifTrue:[
- errorMessages := errorMessages asStringCollection.
- errorMessages size > 20 ifTrue:[
- errorMessages := (errorMessages copyTo:20) copyWith:'... more messages skipped'
- ].
+ self activityNotification:'compiling (cc)'.
+ ok := OperatingSystem
+ executeCommand:command
+ inputFrom:nil
+ outputTo:errorStream
+ errorTo:errorStream
+ onError:[:stat|
+ status := stat.
+ false
+ ].
+
+ oFileName asFilename exists ifTrue:[
+ ok ifFalse:[
+ 'Compiler [info]: system says it failed - but o-file is there ...' infoPrintCR.
+ ok := true
+ ]
+ ] ifFalse:[
+ ok := false
+ ].
+
+ "for debugging - leave c intermediate"
+ STCKeepCIntermediate == true ifFalse:[
+ OperatingSystem removeFile:cFileName.
+ ].
+ ].
+
+ ok ifFalse:[
+ (status notNil and:[status couldNotExecute]) ifTrue:[
+ eMsg := 'oops, no STC - cannot create machine code'
+ ] ifFalse:[
+ errorStream := 'errorOutput' asFilename readStream.
+ errorStream notNil ifTrue:[
+ errorMessages := errorStream contents.
+ errorMessages notNil ifTrue:[
+ errorMessages := errorMessages asStringCollection.
+ errorMessages size > 20 ifTrue:[
+ errorMessages := (errorMessages copyTo:20) copyWith:'... more messages skipped'
+ ].
"/ errorMessages := errorMessages collect:[:line |
"/ (line startsWith:(stFileName , ':')) ifTrue:[
"/ 'Line: ' , (line copyFrom:(stFileName size + 2))
@@ -2240,209 +2470,209 @@
"/ line
"/ ]
"/ ].
- errorMessages := errorMessages asString
- ].
- ].
- errorMessages isNil ifTrue:[
- errorMessages := ''
- ].
- errorMessages isEmpty ifTrue:[
- eMsg := 'STC / CC error during compilation:\\unspecified error'
- ] ifFalse:[
- eMsg := 'STC / CC error during compilation:\\',errorMessages
- ].
- eMsg := eMsg withCRs
- ].
- 'errorOutput' asFilename remove.
- self activityNotification:'compilation failed'.
- self parseError:eMsg position:1.
-
- OperatingSystem removeFile:oFileName.
- OperatingSystem removeFile:'errorOutput'.
- self activityNotification:''.
- ^ #Error
- ].
-
- self activityNotification:''.
- OperatingSystem removeFile:'errorOutput'.
-
- (ObjectFileLoader notNil
- and:[ObjectFileLoader canLoadObjectFiles]) ifFalse:[
- self parseError:'no dynamic load configured - cannot load machine code' position:1.
- OperatingSystem removeFile:cFileName.
- OperatingSystem removeFile:oFileName.
- ^ #CannotLoad
- ].
-
- "
- if required, make a shared or otherwise loadable object file for it
- "
- self activityNotification:'linking'.
- oFileName := ObjectFileLoader createLoadableObjectFor:initName.
- oFileName isNil ifTrue:[
- "/ something went wrong
- self parseError:(ObjectFileLoader lastError) position:1.
- ^ #CannotLoad
- ].
-
- oFileName asFilename exists ifFalse:[
- OperatingSystem removeFile:oFileName.
- self parseError:'link failed - cannot create machine code' position:1.
- ^ #CannotLoad
- ].
-
- "
- move it into the modules directory
- "
- moduleFileName := STCModulePath , '/' , initName , '.' , (oFileName asFilename suffix).
- oFileName asFilename moveTo:moduleFileName.
- oFileName := moduleFileName.
-
- "
- load the objectfile
- "
- self activityNotification:'loading'.
- handle := ObjectFileLoader loadDynamicObject:moduleFileName.
- handle isNil ifTrue:[
- OperatingSystem removeFile:moduleFileName.
- self parseError:'dynamic load failed - cannot create machine code' position:1.
- ^ #CannotLoad
- ].
+ errorMessages := errorMessages asString
+ ].
+ ].
+ errorMessages isNil ifTrue:[
+ errorMessages := ''
+ ].
+ errorMessages isEmpty ifTrue:[
+ eMsg := 'STC / CC error during compilation:\\unspecified error'
+ ] ifFalse:[
+ eMsg := 'STC / CC error during compilation:\\',errorMessages
+ ].
+ eMsg := eMsg withCRs
+ ].
+ 'errorOutput' asFilename remove.
+ self activityNotification:'compilation failed'.
+ self parseError:eMsg position:1.
+
+ OperatingSystem removeFile:oFileName.
+ OperatingSystem removeFile:'errorOutput'.
+ self activityNotification:''.
+ ^ #Error
+ ].
+
+ self activityNotification:''.
+ OperatingSystem removeFile:'errorOutput'.
+
+ (ObjectFileLoader notNil
+ and:[ObjectFileLoader canLoadObjectFiles]) ifFalse:[
+ self parseError:'no dynamic load configured - cannot load machine code' position:1.
+ OperatingSystem removeFile:cFileName.
+ OperatingSystem removeFile:oFileName.
+ ^ #CannotLoad
+ ].
+
+ "
+ if required, make a shared or otherwise loadable object file for it
+ "
+ self activityNotification:'linking'.
+ oFileName := ObjectFileLoader createLoadableObjectFor:initName.
+ oFileName isNil ifTrue:[
+ "/ something went wrong
+ self parseError:(ObjectFileLoader lastError) position:1.
+ ^ #CannotLoad
+ ].
+
+ oFileName asFilename exists ifFalse:[
+ OperatingSystem removeFile:oFileName.
+ self parseError:'link failed - cannot create machine code' position:1.
+ ^ #CannotLoad
+ ].
+
+ "
+ move it into the modules directory
+ "
+ moduleFileName := STCModulePath , '/' , initName , '.' , (oFileName asFilename suffix).
+ oFileName asFilename moveTo:moduleFileName.
+ oFileName := moduleFileName.
+
+ "
+ load the objectfile
+ "
+ self activityNotification:'loading'.
+ handle := ObjectFileLoader loadDynamicObject:moduleFileName.
+ handle isNil ifTrue:[
+ OperatingSystem removeFile:moduleFileName.
+ self parseError:'dynamic load failed - cannot create machine code' position:1.
+ ^ #CannotLoad
+ ].
"/ ('handle is ' , handle printString) infoPrintCR.
- "/ try libs to resolve symbols.
- address := ObjectFileLoader getFunction:'__' , initName , '_Init' from:handle.
- address isNil ifTrue:[
- address := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
- address isNil ifTrue:[
- (ObjectFileLoader hasUndefinedSymbolsIn:handle) ifTrue:[
- ObjectFileLoader searchedLibraries do:[:libName |
- (ObjectFileLoader hasUndefinedSymbolsIn:handle) ifTrue:[
- Transcript showCR:' ... trying ' , libName , ' to resolve undefined symbols ...'.
- dummyHandle := Array new:4.
- dummyHandle := ObjectFileLoader primLoadDynamicObject:libName into:dummyHandle.
- dummyHandle isNil ifTrue:[
- Transcript showCR:' ... load of library ' , libName , ' failed.'.
- ]
- ]
- ].
- (ObjectFileLoader hasUndefinedSymbolsIn:handle) isNil ifTrue:[
- Transcript showCR:('LOADER: still undefined symbols in ',initName,'.').
- ].
- ].
-
- ]
- ].
-
- address := ObjectFileLoader getFunction:'__' , initName , '_Init' from:handle.
- address isNil ifTrue:[
- address := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
- address isNil ifTrue:[
- (ObjectFileLoader getListOfUndefinedSymbolsFrom:handle) size > 0 ifTrue:[
- ObjectFileLoader listUndefinedSymbolsIn:handle.
- eMsg := 'undefined symbols in primitive code'.
- ] ifFalse:[
- eMsg := initName , '_Init() lookup failed'
- ].
-
- ObjectFileLoader unloadDynamicObject:handle.
-
- OperatingSystem removeFile:moduleFileName.
- self parseError:(eMsg , ' - cannot create machine code') position:1.
- ^ #CannotLoad
- ]
- ].
+ "/ try libs to resolve symbols.
+ address := ObjectFileLoader getFunction:'__' , initName , '_Init' from:handle.
+ address isNil ifTrue:[
+ address := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
+ address isNil ifTrue:[
+ (ObjectFileLoader hasUndefinedSymbolsIn:handle) ifTrue:[
+ ObjectFileLoader searchedLibraries do:[:libName |
+ (ObjectFileLoader hasUndefinedSymbolsIn:handle) ifTrue:[
+ Transcript showCR:' ... trying ' , libName , ' to resolve undefined symbols ...'.
+ dummyHandle := Array new:4.
+ dummyHandle := ObjectFileLoader primLoadDynamicObject:libName into:dummyHandle.
+ dummyHandle isNil ifTrue:[
+ Transcript showCR:' ... load of library ' , libName , ' failed.'.
+ ]
+ ]
+ ].
+ (ObjectFileLoader hasUndefinedSymbolsIn:handle) isNil ifTrue:[
+ Transcript showCR:('LOADER: still undefined symbols in ',initName,'.').
+ ].
+ ].
+
+ ]
+ ].
+
+ address := ObjectFileLoader getFunction:'__' , initName , '_Init' from:handle.
+ address isNil ifTrue:[
+ address := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
+ address isNil ifTrue:[
+ (ObjectFileLoader getListOfUndefinedSymbolsFrom:handle) size > 0 ifTrue:[
+ ObjectFileLoader listUndefinedSymbolsIn:handle.
+ eMsg := 'undefined symbols in primitive code'.
+ ] ifFalse:[
+ eMsg := initName , '_Init() lookup failed'
+ ].
+
+ ObjectFileLoader unloadDynamicObject:handle.
+
+ OperatingSystem removeFile:moduleFileName.
+ self parseError:(eMsg , ' - cannot create machine code') position:1.
+ ^ #CannotLoad
+ ]
+ ].
"/ ('init at ' , address printString) infoPrintCR.
- m := ObjectFileLoader
- callInitFunctionAt:address
- specialInit:true
- forceOld:true
- interruptable:false
- argument:2
- identifyAs:handle
- returnsObject:true.
-
- "
- did it work ?
- "
- newMethod := aClass compiledMethodAt:selector.
- newMethod notNil ifTrue:[
- m ~~ newMethod ifTrue:[
- 'Compiler [error]: loaded method installed itself elsewhere' errorPrintCR.
- ].
-
- newMethod source:aString.
- newMethod package:(Class packageQuerySignal raise).
+ m := ObjectFileLoader
+ callInitFunctionAt:address
+ specialInit:true
+ forceOld:true
+ interruptable:false
+ argument:2
+ identifyAs:handle
+ returnsObject:true.
+
+ "
+ did it work ?
+ "
+ newMethod := aClass compiledMethodAt:selector.
+ newMethod notNil ifTrue:[
+ m ~~ newMethod ifTrue:[
+ 'Compiler [error]: loaded method installed itself elsewhere' errorPrintCR.
+ ].
+
+ newMethod source:aString.
+ newMethod package:(Class packageQuerySignal raise).
"/ Project notNil ifTrue:[
"/ newMethod package:(Project currentPackageName)
"/ ].
"/ aClass updateRevisionString.
- aClass addChangeRecordForMethod:newMethod.
- (silent or:[Smalltalk silentLoading == true]) ifFalse:[
- Transcript showCR:(' compiled: ', className,' ',selector,' - machine code')
- ].
- ObjectMemory flushCaches.
-
- handle method:newMethod.
-
- "/ check for obsolete loaded objects and unload them
-
- ObjectFileLoader loadedObjectHandlesDo:[:anotherHandle |
- anotherHandle isMethodHandle ifTrue:[
- anotherHandle method isNil ifTrue:[
- ObjectFileLoader unloadObjectFile:anotherHandle pathName.
- OperatingSystem removeFile:anotherHandle pathName.
- ]
- ]
- ].
- ^ newMethod.
- ].
-
- OperatingSystem removeFile:moduleFileName.
- self parseError:'dynamic load failed' position:1.
- ^ #CannotLoad
+ aClass addChangeRecordForMethod:newMethod.
+ (silent or:[Smalltalk silentLoading == true]) ifFalse:[
+ Transcript showCR:(' compiled: ', className,' ',selector,' - machine code')
+ ].
+ ObjectMemory flushCaches.
+
+ handle method:newMethod.
+
+ "/ check for obsolete loaded objects and unload them
+
+ ObjectFileLoader loadedObjectHandlesDo:[:anotherHandle |
+ anotherHandle isMethodHandle ifTrue:[
+ anotherHandle method isNil ifTrue:[
+ ObjectFileLoader unloadObjectFile:anotherHandle pathName.
+ OperatingSystem removeFile:anotherHandle pathName.
+ ]
+ ]
+ ].
+ ^ newMethod.
+ ].
+
+ OperatingSystem removeFile:moduleFileName.
+ self parseError:'dynamic load failed' position:1.
+ ^ #CannotLoad
] valueNowOrOnUnwindDo:[
- STCKeepSTIntermediate ifFalse:[
- OperatingSystem removeFile:stFileName.
- ].
+ STCKeepSTIntermediate ifFalse:[
+ OperatingSystem removeFile:stFileName.
+ ].
].
"
|m|
Object subclass:#Test
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'tests'.
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'tests'.
m := ByteCodeCompiler
- compile:'foo ^ ''hello'''
- forClass:Test
- inCategory:'tests'
- notifying:nil
- install:false
- skipIfSame:false.
+ compile:'foo ^ ''hello'''
+ forClass:Test
+ inCategory:'tests'
+ notifying:nil
+ install:false
+ skipIfSame:false.
m inspect
"
"
|m|
Object subclass:#Test
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'tests'.
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'tests'.
m := ByteCodeCompiler
- compileToMachineCode:'foo %{ RETURN (_MKSMALLINT(1)); %}'
- forClass:Test
- inCategory:'tests'
- notifying:nil
- install:false
- skipIfSame:false
- silent:false.
+ compileToMachineCode:'foo %{ RETURN (_MKSMALLINT(1)); %}'
+ forClass:Test
+ inCategory:'tests'
+ notifying:nil
+ install:false
+ skipIfSame:false
+ silent:false.
m inspect
"
@@ -2456,37 +2686,37 @@
osType := OperatingSystem getOSType.
osType = 'irix' ifTrue:[
- "
- link it to a shared object
- "
- oFileName := './' , baseFileName , '.o'.
- soFileName := './' , baseFileName , '.so'.
- OperatingSystem removeFile:soFileName.
- OperatingSystem executeCommand:'ld -shared -all -o ' , soFileName , ' ' , oFileName.
- OperatingSystem removeFile:oFileName.
- ^ soFileName.
+ "
+ link it to a shared object
+ "
+ oFileName := './' , baseFileName , '.o'.
+ soFileName := './' , baseFileName , '.so'.
+ OperatingSystem removeFile:soFileName.
+ OperatingSystem executeCommand:'ld -shared -all -o ' , soFileName , ' ' , oFileName.
+ OperatingSystem removeFile:oFileName.
+ ^ soFileName.
].
osType = 'sys5_4' ifTrue:[
- "
- link it to a shared object
- "
- oFileName := './' , baseFileName , '.o'.
- soFileName := './' , baseFileName , '.so'.
- OperatingSystem removeFile:soFileName.
- OperatingSystem executeCommand:'ld -G -o ' , soFileName , ' ' , oFileName.
- OperatingSystem removeFile:oFileName.
- ^ soFileName.
+ "
+ link it to a shared object
+ "
+ oFileName := './' , baseFileName , '.o'.
+ soFileName := './' , baseFileName , '.so'.
+ OperatingSystem removeFile:soFileName.
+ OperatingSystem executeCommand:'ld -G -o ' , soFileName , ' ' , oFileName.
+ OperatingSystem removeFile:oFileName.
+ ^ soFileName.
].
osType = 'linux' ifTrue:[
- "
- link it to a shared object
- "
- oFileName := './' , baseFileName , '.o'.
- soFileName := './' , baseFileName , '.so'.
- OperatingSystem removeFile:soFileName.
- OperatingSystem executeCommand:'ld -shared -o ' , soFileName , ' ' , oFileName.
- OperatingSystem removeFile:oFileName.
- ^ soFileName.
+ "
+ link it to a shared object
+ "
+ oFileName := './' , baseFileName , '.o'.
+ soFileName := './' , baseFileName , '.so'.
+ OperatingSystem removeFile:soFileName.
+ OperatingSystem executeCommand:'ld -shared -o ' , soFileName , ' ' , oFileName.
+ OperatingSystem removeFile:oFileName.
+ ^ soFileName.
].
^ oFileName
@@ -2502,7 +2732,7 @@
newMethod := Method new:(litArray size).
litArray notNil ifTrue:[
- newMethod literals:litArray
+ newMethod literals:litArray
].
newMethod makeUncompiled.
@@ -2523,6 +2753,6 @@
!ByteCodeCompiler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.112 1997-04-16 17:14:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.113 1997-04-20 10:20:49 cg Exp $'
! !
ByteCodeCompiler initialize!