--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Smalltalk.st Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,1123 @@
+"
+ COPYRIGHT (c) 1988-93 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Object subclass:#Smalltalk
+ instanceVariableNames:''
+ classVariableNames:'exitBlocks CachedClasses'
+ poolDictionaries:''
+ category:'System-Support'
+!
+
+Smalltalk comment:'
+
+COPYRIGHT (c) 1988-93 by Claus Gittinger
+ All Rights Reserved
+
+This is one of the central classes in the system;
+it provides all system-startup, shutdown and maintenance support.
+Also global variables are kept here.
+
+As you will notice, this is NOT a Dictionary
+ - my implementation of globals is totally different
+ (due to the need to be able to access globals from c-code as well).
+
+%W% %E%
+'!
+
+Smalltalk at:#ErrorNumber put:nil!
+Smalltalk at:#ErrorString put:nil!
+Smalltalk at:#Language put:#english!
+Smalltalk at:#LanguageTerritory put:#usa!
+Smalltalk at:#Initializing put:false!
+Smalltalk at:#SilentLoading put:false!
+Smalltalk at:#RecursionLimit put:nil!
+Smalltalk at:#MemoryLimit put:nil!
+Smalltalk at:#SystemPath put:nil!
+Smalltalk at:#StartupClass put:nil!
+Smalltalk at:#StartupSelector put:nil!
+Smalltalk at:#SignalCatchBlock put:nil!
+
+!Smalltalk class methodsFor:'time-versions'!
+
+majorVersion
+ "return the major version number"
+
+ ^ 2
+
+ "Smalltalk majorVersion"
+!
+
+minorVersion
+ "return the minor version number"
+
+ ^ 7
+
+ "Smalltalk minorVersion"
+!
+
+revision
+ "return the revision number"
+
+ ^ 1
+
+ "Smalltalk revision"
+!
+
+version
+ "return the version string"
+
+ ^ (self majorVersion printString ,
+ '.',
+ self minorVersion printString ,
+ '.',
+ self revision printString)
+
+ "Smalltalk version"
+!
+
+versionDate
+ "return the version date"
+
+ ^ '9-Jul-1993'
+
+ "Smalltalk versionDate"
+!
+
+copyright
+ "return a copyright string"
+
+ ^ 'Copyright (c) 1988-93 by Claus Gittinger'
+
+ "Smalltalk copyright"
+!
+
+hello
+ "return a greeting string"
+
+ (Language == #german) ifTrue:[
+ ^ 'Willkommen bei Smalltalk/X version '
+ , self version , ' vom ' , self versionDate
+ ].
+ ^ 'Hello World - here is Smalltalk/X version '
+ , self version , ' of ' , self versionDate
+
+ "Smalltalk hello"
+!
+
+timeStamp
+ "return a string useful for timestamping a file"
+
+ ^ '''From Smalltalk/X, Version:' , (Smalltalk version) , ' on '
+ , Date today printString , ' at ' , Time now printString
+ , ''''
+! !
+
+!Smalltalk class methodsFor:'initialization'!
+
+initialize
+ "this one is called from init - initialize all other classes"
+
+ self initGlobalsFromEnvironment.
+
+ "sorry - there are some, which MUST be initialized before ..
+ reason: if any error happens during init, we need Stdout to be there"
+
+ Object initialize.
+
+ ExternalStream initialize.
+ self initStandardStreams.
+
+ "sorry, path must be set before ...
+ reason: some classes need it during initialize"
+
+ self initSystemPath.
+
+ "must init display here - some classes (Color) need it during
+ initialize"
+
+ Workstation notNil ifTrue:[
+ Workstation initialize
+ ].
+
+ Inspector := MiniInspector.
+ Debugger := MiniDebugger.
+ Compiler := ByteCodeCompiler.
+ Compiler isNil ifTrue:[
+ "this allows at least immediate evaluations"
+ Compiler := Parser
+ ].
+
+ self allClassesDo:[:aClass |
+ "aviod never-ending story ..."
+ (aClass ~~ Smalltalk) ifTrue:[
+ aClass initialize
+ ]
+ ].
+ self initStandardTools.
+ self initInterrupts
+
+ "Smalltalk initialize"
+!
+
+initGlobalsFromEnvironment
+ "setup globals from the shell-environment"
+
+ |envString firstChar i langString terrString|
+
+ "extract Language and LanguageTerritory from LANG variable.
+ the language and territory must not be abbreviated,
+ valid is for example: english_usa
+ english
+ german
+ german_austria"
+
+ envString := OperatingSystem getEnvironment:'LANG'.
+ envString notNil ifTrue:[
+ i := envString indexOf:$_.
+ (i == 0) ifTrue:[
+ langString := envString.
+ terrString := envString
+ ] ifFalse:[
+ langString := envString copyFrom:1 to:(i - 1).
+ terrString := envString copyFrom:(i + 1)
+ ].
+ Language := langString asSymbol.
+ LanguageTerritory := terrString asSymbol
+ ].
+
+ envString := OperatingSystem getEnvironment:'VIEW3D'.
+ envString notNil ifTrue:[
+ firstChar := (envString at:1) asLowercase.
+ (firstChar == $t) ifTrue:[
+ Smalltalk at:#View3D put:true
+ ] ifFalse: [
+ Smalltalk at:#View3D put:false
+ ]
+ ]
+ "Smalltalk initGlobalsFromEnvironment"
+!
+
+initStandardTools
+ "predefine some tools we will need later
+ - if the view-classes exist,
+ they will redefine Inspector and Debugger for graphical interfaces"
+
+ "redefine debug-tools, if view-classes exist"
+
+ (Smalltalk at:#Display) notNil ifTrue:[
+ (Smalltalk at:#InspectorView) notNil ifTrue:[
+ Inspector := Smalltalk at:#InspectorView
+ ].
+ (Smalltalk at:#DebugView) notNil ifTrue:[
+ Debugger := Smalltalk at:#DebugView
+ ].
+ Display initialize
+ ]
+ "Smalltalk initStandardTools"
+!
+
+initStandardStreams
+ "initialize some well-known streams"
+
+ Stdout := NonPositionableExternalStream forStdout.
+ Stderr := NonPositionableExternalStream forStderr.
+ Stdin := NonPositionableExternalStream forStdin.
+ Printer := PrinterStream.
+ Transcript := Stderr
+
+ "Smalltalk initStandardStreams"
+!
+
+initInterrupts
+ "initialize interrupts"
+
+ UserInterruptHandler := self.
+ ErrorInterruptHandler := self.
+ MemoryInterruptHandler := self.
+ SignalInterruptHandler := self.
+ ExceptionInterruptHandler := self.
+ OperatingSystem enableUserInterrupts.
+ OperatingSystem enableSignalInterrupts.
+ OperatingSystem enableFpExceptionInterrupts
+
+ "Smalltalk initInterrupts"
+!
+
+initSystemPath
+ "setup path to search for system files"
+
+ |p|
+
+ "the path is set to search files first locally
+ - this allows private stuff to override global stuff"
+
+ SystemPath := OrderedCollection new.
+ SystemPath add:'.'.
+ SystemPath add:'..'.
+ SystemPath add:(OperatingSystem getHomeDirectory).
+ (OperatingSystem isDirectory:(OperatingSystem getHomeDirectory , '/.smalltalk')) ifTrue:[
+ SystemPath add:(OperatingSystem getHomeDirectory , '/.smalltalk')
+ ].
+ p := OperatingSystem getEnvironment:'SMALLTALK_LIBDIR'.
+ p notNil ifTrue:[
+ SystemPath add:p
+ ].
+ (OperatingSystem isDirectory:'/usr/local/lib/smalltalk') ifTrue:[
+ SystemPath add:'/usr/local/lib/smalltalk'
+ ].
+ (OperatingSystem isDirectory:'/usr/lib/smalltalk') ifTrue:[
+ SystemPath add:'/usr/lib/smalltalk'
+ ].
+
+ "Smalltalk initSystemPath"
+ "SystemPath"
+!
+
+start
+ "main startup, if there is a Display, initialize it
+ and start dispatching; otherwise go into a read-eval-print loop"
+
+ Initializing := true.
+
+ "read patches- and rc-file, do not add things into change-file"
+
+ Class updateChanges:false.
+ [
+ self fileIn:'patches'.
+
+ (self fileIn:((Arguments at:1) , '.rc')) ifFalse:[
+ "no .rc file where executable is; try default smalltalk.rc"
+ self fileIn:'smalltalk.rc'
+ ]
+ ] valueNowOrOnUnwindDo:[Class updateChanges:true].
+
+ SilentLoading ifFalse:[
+ Transcript showCr:(self hello).
+ Transcript showCr:(self copyright).
+ Transcript cr
+ ].
+
+ Initializing := false.
+ DemoMode ifTrue:[
+ Transcript showCr:'Unlicensed demo mode with limitations.'
+ ].
+
+ [self saveMainLoop] whileTrue:[ ].
+
+ "done"
+
+ self exit
+!
+
+restart
+ "startup after an image has been loaded
+ "
+ |deb insp|
+
+ Initializing := true.
+
+ "temporary switch back to dumb interface"
+
+ insp := Inspector.
+ deb := Debugger.
+ Inspector := MiniInspector.
+ Debugger := MiniDebugger.
+
+ ObjectMemory changed:#restarted.
+
+ "
+ some must be reinitialized before ...
+ - sorry, but order is important
+ "
+
+ Workstation reinitialize.
+ View reinitialize.
+
+ ObjectMemory changed:#returnFromSnapshot.
+
+ OperatingSystem enableUserInterrupts.
+ OperatingSystem enableSignalInterrupts.
+
+ Inspector := insp.
+ Debugger := deb.
+
+ Initializing := false.
+
+
+ "
+ if there is no Transcript, go to stderr
+ "
+ Transcript isNil ifTrue:[
+ self initStandardStreams.
+ Transcript := Stderr
+ ].
+
+ Transcript cr.
+ Transcript showCr:('Smalltalk restarted from:' , ImageName).
+ DemoMode ifTrue:[
+ Transcript showCr:'Unlicensed demo mode with limitations.'
+ ].
+
+ "this allows firing an application by defining
+ these two globals during snapshot ..."
+
+ StartupClass notNil ifTrue:[
+ StartupSelector notNil ifTrue:[
+
+ "allow customization by reading an image specific rc-file"
+ ImageName notNil ifTrue:[
+ (ImageName endsWith:'.img') ifTrue:[
+ self fileIn:((ImageName copyFrom:1 to:(ImageName size - 4)), '.rc')
+ ] ifFalse:[
+ self fileIn:(ImageName , '.rc')
+ ]
+ ].
+ StartupClass perform:StartupSelector
+ ]
+ ].
+
+ Display notNil ifTrue:[
+ Display dispatch
+ ] ifFalse:[
+ self readEvalPrint
+ ].
+
+ self exit
+!
+
+saveMainLoop
+ "main dispatching loop - exits with true for a bad exit (to restart),
+ false for real exit"
+
+ Smalltalk at:#SignalCatchBlock put:[^ true].
+
+ "if view-classes exist, start dispatching;
+ otherwise go into a read-eval-print loop"
+
+ Display notNil ifTrue:[
+ Display dispatch
+ ] ifFalse:[
+ self readEvalPrint
+ ].
+ ^ false
+!
+
+readEvalPrint
+ "simple read-eval-print loop for non-graphical Tinytalk"
+
+ |text|
+
+ 'ST- ' print.
+ Stdin skipSeparators.
+ text := Stdin nextChunk.
+ [text notNil] whileTrue:[
+ (Compiler evaluate:text) printNewline.
+ 'ST- ' print.
+ text := Stdin nextChunk
+ ].
+ '' printNewline
+! !
+
+!Smalltalk class methodsFor:'accessing'!
+
+at:aKey
+ "retrieve the value stored under aKey, a symbol"
+
+%{ /* NOCONTEXT */
+ extern OBJ _GETGLOBAL();
+
+ RETURN ( _GETGLOBAL(aKey) );
+%}
+!
+
+at:aKey ifAbsent:aBlock
+ "retrieve the value stored under aKey.
+ If there is none stored this key, return the value of
+ the evaluation of aBlock"
+
+ (self includesKey:aKey) ifTrue:[
+ ^ self at:aKey
+ ].
+ ^ aBlock value
+!
+
+at:aKey put:aValue
+ "store the argument aValue under aKey, a symbol"
+
+ CachedClasses := nil.
+
+%{ /* NOCONTEXT */
+ extern OBJ _SETGLOBAL();
+
+ RETURN ( _SETGLOBAL(aKey, aValue, (OBJ *)0) );
+%}
+!
+
+removeKey:aKey
+ "remove the argument from the globals dictionary"
+
+ CachedClasses := nil.
+
+%{ /* NOCONTEXT */
+ extern OBJ _REMOVEGLOBAL();
+
+ RETURN ( _REMOVEGLOBAL(aKey) );
+%}
+!
+
+includesKey:aKey
+ "return true, if the key is known"
+
+%{ /* NOCONTEXT */
+ extern OBJ _KEYKNOWN();
+
+ RETURN ( _KEYKNOWN(aKey) );
+%}
+!
+
+keyAtValue:anObject
+ "return the symbol under which anObject is stored - or nil"
+
+ self allKeysDo:[:aKey |
+ (self at:aKey) == anObject ifTrue:[^ aKey]
+ ]
+
+ "Smalltalk keyAtValue:Object"
+!
+
+keys
+ "return a collection with all keys in the Smalltalk dictionary"
+
+ |keys|
+
+ keys := OrderedCollection new.
+ self allKeysDo:[:k | keys add:k].
+ ^ keys
+! !
+
+!Smalltalk class methodsFor:'copying'!
+
+shallowCopy
+ "redefine copy - there is only one Smalltalk dictionary"
+
+ ^ self
+!
+
+deepCopy
+ "redefine copy - there is only one Smalltalk dictionary"
+
+ ^ self
+! !
+
+!Smalltalk class methodsFor:'inspecting'!
+
+inspect
+ "redefined to launch a DictionaryInspector on the receiver
+ (instead of the default InspectorView)."
+
+ DictionaryInspectorView isNil ifTrue:[
+ super inspect
+ ] ifFalse:[
+ DictionaryInspectorView openOn:self
+ ]
+! !
+
+!Smalltalk class methodsFor:'misc stuff'!
+
+addExitBlock:aBlock
+ "add a block to be executed when Smalltalk finishes"
+
+ exitBlocks isNil ifTrue:[
+ exitBlocks := Array with:aBlock
+ ] ifFalse:[
+ exitBlocks add:aBlock
+ ]
+!
+
+exit
+ "finish Smalltalk system"
+
+ exitBlocks notNil ifTrue:[
+ exitBlocks do:[:aBlock |
+ aBlock value
+ ]
+ ].
+%{
+ mainExit(0);
+%}
+.
+ OperatingSystem exit
+
+ "Smalltalk exit"
+!
+
+sleep:aDelay
+ "wait for aDelay seconds"
+
+ OperatingSystem sleep:aDelay
+! !
+
+!Smalltalk class methodsFor:'debugging'!
+
+printStackBacktrace
+ "print a stack backtrace"
+
+%{
+ printStack(__context);
+%}
+!
+
+fatalAbort
+ "abort program and dump core"
+%{
+ fatal0(__context, "abort");
+%}
+!
+
+statistic
+ "print some statistic data"
+%{
+ statistic();
+%}
+!
+
+debugOn
+ "temporary"
+
+ "LookupTrace := true. "
+ MessageTrace := true.
+ "AllocTrace := true. "
+ ObjectMemory flushInlineCaches
+!
+
+debugOff
+ "temporary"
+
+ LookupTrace := nil.
+ MessageTrace := nil
+ ". AllocTrace := nil "
+!
+
+allocDebugOn
+ "temporary"
+
+ AllocTrace := true
+!
+
+allocDebugOff
+ "temporary"
+
+ AllocTrace := nil
+!
+
+executionDebugOn
+ "temporary"
+
+ ExecutionTrace := true
+!
+
+executionDebugOff
+ "temporary"
+
+ ExecutionTrace := nil
+! !
+
+!Smalltalk class methodsFor:'looping'!
+
+do:aBlock
+ "evaluate the argument, aBlock for all values in the Smalltalk dictionary"
+%{
+ __allGlobalsDo(&aBlock COMMA_CON);
+%}
+!
+
+allKeysDo:aBlock
+ "evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
+%{
+ __allKeysDo(&aBlock COMMA_CON);
+%}
+!
+
+allClassesDo:aBlock
+ "evaluate the argument, aBlock for all classes in the system"
+
+ self allClasses do:aBlock
+!
+
+associationsDo:aBlock
+ "evaluate the argument, aBlock for all key/value pairs
+ in the Smalltalk dictionary"
+
+ self allKeysDo:[:aKey |
+ aBlock value:(aKey -> (self at:aKey))
+ ]
+
+ "Smalltalk associationsDo:[:assoc | assoc printNewline]"
+! !
+
+!Smalltalk class methodsFor:'queries'!
+
+numberOfGlobals
+ "return the number of global variables in the system"
+
+ |tally|
+
+ tally := 0.
+ self do:[:obj | tally := tally + 1].
+ ^ tally
+
+ "Smalltalk numberOfGlobals"
+!
+
+cellAt:aName
+ "return the address of a global cell
+ - used internally for compiler only"
+
+%{ /* NOCONTEXT */
+ extern OBJ _GETGLOBALCELL();
+
+ RETURN ( _GETGLOBALCELL(aName) );
+%}
+!
+
+references:anObject
+ "return true, if I refer to the argument, anObject
+ must be reimplemented since Smalltalk is no real collection"
+
+ self do:[:o |
+ (o == anObject) ifTrue:[^ true]
+ ].
+ ^ false
+!
+
+allClasses
+ "return a collection of all classes in the system"
+
+ CachedClasses isNil ifTrue:[
+ CachedClasses := IdentitySet new:400.
+ self do:[:anObject |
+ anObject notNil ifTrue:[
+ (anObject isBehavior) ifTrue:[
+ CachedClasses add:anObject
+ ]
+ ]
+ ]
+ ].
+ ^ CachedClasses
+
+ "Smalltalk allClasses"
+!
+
+classNames
+ "return a collection of all classNames in the system"
+
+
+ ^ self allClasses collect:[:aClass | aClass name]
+! !
+
+!Smalltalk class methodsFor:'system management'!
+
+removeClass:aClass
+ "remove the argument, aClass from the smalltalk dictionary;
+ we have to flush the caches since these methods are now void"
+
+ |sym|
+
+ sym := aClass name asSymbol.
+ ((self at:sym) == aClass) ifTrue:[
+ self at:sym put:nil. "nil it out for compiled accesses"
+ " self removeKey:sym. "
+"
+ actually could get along with less flushing
+ (entries for aClass and subclasses only)
+
+ ObjectMemory flushInlineCachesForClass:aClass.
+ ObjectMemory flushMethodCacheFor:aClass
+"
+ ObjectMemory flushInlineCaches.
+ ObjectMemory flushMethodCache
+ ]
+!
+
+browseChanges
+ "startup a changes browser"
+
+ (self at:#ChangesBrowser) notNil ifTrue:[
+ ChangesBrowser start
+ ] ifFalse:[
+ self error:'no ChangesBrowser'
+ ]
+
+ "Smalltalk browseChanges "
+!
+
+browseAllSelect:aBlock
+ "startup a browser for all methods for which aBlock returns true"
+
+ SystemBrowser browseAllSelect:aBlock
+
+ " Smalltalk browseAllSelect:[:m | m literals isNil] "
+!
+
+browseImplementorsOf:aSelectorSymbol
+ "startup a browser for all methods implementing a particular message"
+
+ SystemBrowser browseImplementorsOf:aSelectorSymbol
+
+ " Smalltalk browseImplementorsOf:#at:put: "
+!
+
+browseAllCallsOn:aSelectorSymbol
+ "startup a browser for all methods sending a particular message"
+
+ SystemBrowser browseAllCallsOn:aSelectorSymbol
+
+ " Smalltalk browseAllCallsOn:#at:put: "
+!
+
+createSourceFilesIn:aFileDirectory
+ "create a new set of sources in aFileDirectory"
+
+ |aStream|
+
+ aStream := FileStream newFileNamed:'List.proto' in:aFileDirectory.
+ aStream isNil ifTrue:[
+ ^ self error:'cannot create prototype fileList:List.proto'
+ ].
+ self allClassesDo:[:aClass |
+ (aClass isMeta) ifFalse:[
+ Transcript show:('creating source for:' , aClass name , '...').
+
+ aStream nextPutAll:(aClass name , '.o').
+ aStream cr.
+
+ aClass fileOutIn:aFileDirectory.
+
+ Transcript cr
+ ]
+ ].
+ aStream close
+!
+
+createMakefileIn:aFileDirectory
+ "create a new Makefile in aFileDirectory"
+
+ |aStream classes fileNames superIndex count onum first
+ numClasses "{ Class: SmallInteger }" |
+
+ classes := VariableArray new:200.
+ classes grow:0.
+ fileNames := VariableArray new:200.
+ fileNames grow:0.
+
+ Transcript show:'building class tree ...'.
+
+ classes add:Object.
+ fileNames add:'Object'.
+ Object allSubclassesInOrderDo:[:aClass |
+ ((classes identityIndexOf:aClass startingAt:1) == 0) ifTrue:[
+ classes add:aClass.
+ fileNames add:(Smalltalk fileNameForClass:aClass name)
+ ]
+ ].
+ Transcript cr.
+ numClasses := classes size.
+
+ aStream := FileStream newFileNamed:'Makefile' in:aFileDirectory.
+ aStream isNil ifTrue:[
+ ^ self error:'cannot create Makefile'
+ ].
+
+ aStream nextPutAll:'LIBTOP=/usr/local/lib/smalltalk'. aStream cr.
+ aStream nextPutAll:'#LIBTOP=../..'. aStream cr.
+
+ aStream nextPutAll:'INCL=include'. aStream cr.
+ aStream nextPutAll:'#INCL2=../../include'. aStream cr.
+ aStream nextPutAll:'INCL2=/usr/include/smalltalk'. aStream cr.
+
+ aStream nextPutAll:'STC=/usr/local/bin/stc'. aStream cr.
+ aStream nextPutAll:'#STC=../../stc/stc'. aStream cr.
+
+ aStream nextPutAll:'#CFLAGS=-O'. aStream cr.
+ aStream nextPutAll:'STCOPT=+optinline +optspace'. aStream cr.
+ aStream nextPutAll:'STCFLAGS=-H$(INCL) -I$(INCL) -I$(INCL2)'. aStream cr.
+
+ aStream cr.
+ aStream nextPutAll:'smalltalk: $(INCLUDE) objs main.o'. aStream cr.
+ aStream cr.
+
+ aStream nextPutAll:'main.o: $(LIBTOP)/librun/main.c'. aStream cr.
+ aStream cr.
+
+ aStream nextPutAll:'$(INCLUDE):'. aStream cr.
+ aStream tab. aStream nextPutAll:'mkdir $(INCLUDE)'. aStream cr.
+ aStream cr.
+
+ aStream nextPutAll:'.SUFFIXES: .st .o'. aStream cr.
+ aStream nextPutAll:'.st.o:'. aStream cr.
+ aStream tab. aStream nextPutAll:'$(STC) $(STCFLAGS) $(CFLAGS) -c $*.st'.
+ aStream cr.
+ aStream cr.
+
+ aStream nextPutAll:'.SUFFIXES: .st .c'. aStream cr.
+ aStream nextPutAll:'.st.c:'. aStream cr.
+ aStream tab. aStream nextPutAll:'$(STC) $(STCFLAGS) $(CFLAGS) -C $*.st'.
+ aStream cr.
+ aStream cr.
+
+
+ onum := 1.
+ count := 0.
+
+ Transcript show:'appending o-file entries ...'.
+ 1 to:numClasses do:[:index |
+ (count == 0) ifTrue:[
+ aStream nextPutAll:'objs'.
+ aStream nextPutAll:(onum printString).
+ aStream nextPutAll:':'.
+ first := true
+ ].
+ first ifFalse:[
+ aStream nextPutAll:' \'. aStream cr
+ ] ifTrue:[
+ first := false
+ ].
+ aStream tab.
+ aStream nextPutAll:((fileNames at:index) , '.o').
+ count := count + 1.
+ (count == 10) ifTrue:[
+ aStream cr.
+ count := 0.
+ onum := onum + 1
+ ]
+ ].
+ aStream cr.
+ aStream cr.
+
+ aStream nextPutAll:'objs:'.
+ first := true.
+ 1 to:onum do:[:i |
+ first ifFalse:[
+ aStream nextPutAll:' \'. aStream cr
+ ] ifTrue:[
+ first := false
+ ].
+
+ aStream tab.
+ aStream nextPutAll:'objs'.
+ aStream nextPutAll:(i printString)
+ ].
+ aStream cr.
+ aStream cr.
+
+ Transcript cr.
+
+ "create dependency info"
+ Transcript show:'append dependency entries ...'.
+
+ 1 to:numClasses do:[:index |
+ aStream nextPutAll:((fileNames at:index) , '.o:').
+ aStream tab.
+ aStream nextPutAll:((fileNames at:index) , '.st').
+ first := true.
+ (classes at:index) allSuperclassesDo:[:superClass |
+ first ifFalse:[
+ aStream nextPutAll:' \'. aStream cr
+ ] ifTrue:[
+ first := false
+ ].
+
+ superIndex := classes indexOf:superClass.
+ aStream tab.
+ aStream nextPutAll:'$(INCLUDE)/'.
+ aStream nextPutAll:((fileNames at:superIndex) , '.H')
+ ].
+ aStream cr.
+ aStream cr
+ ].
+
+ Transcript cr.
+ aStream close.
+
+ "create abbreviation file"
+ aStream := FileStream newFileNamed:'abbrev.stc' in:aFileDirectory.
+ aStream isNil ifTrue:[
+ ^ self error:'cannot create abbrev.stc'
+ ].
+ 1 to:numClasses do:[:index |
+ ((classes at:index) name ~= (fileNames at:index)) ifTrue:[
+ aStream nextPutAll:(classes at:index) name.
+ aStream tab.
+ aStream nextPutAll:(fileNames at:index).
+ aStream cr
+ ]
+ ].
+ aStream close.
+
+ "create classlist file"
+ aStream := FileStream newFileNamed:'classList.stc' in:aFileDirectory.
+ aStream isNil ifTrue:[
+ ^ self error:'cannot create classList.stc'
+ ].
+ classes do:[:aClass |
+ aStream nextPutAll:aClass name.
+ aStream cr
+ ].
+ aStream close
+
+ " Smalltalk createMakefileIn:(FileDirectory directoryNamed:'source2.6') "
+!
+
+createNewSources
+ "create a new source directory, and fileOut all classes into this"
+
+ |nextVersion dirName here fileDirectory|
+
+ nextVersion := self minorVersion + 1.
+ dirName := 'source'
+ , self majorVersion printString
+ , '.'
+ , nextVersion printString.
+ here := FileDirectory currentDirectory.
+ (here createDirectory:dirName) ifFalse:[
+ self error:'cannot create new source directory'
+ ].
+ Transcript showCr:('creating sources in ' , dirName); endEntry.
+
+ fileDirectory := FileDirectory directoryNamed:dirName in:here.
+ self createSourceFilesIn:fileDirectory.
+ self createMakefileIn:fileDirectory
+
+ " Smalltalk createNewSources "
+!
+
+systemFileStreamFor:aFileName
+ "search aFileName in some standard places;
+ return a fileStream or nil if not found"
+
+ |aStream|
+
+ SystemPath do:[:dirName |
+ aStream := FileStream readonlyFileNamed:(dirName , '/' , aFileName).
+ aStream notNil ifTrue:[^ aStream]
+ ].
+ ^ nil
+!
+
+fileNameForClass:aClassName
+ "return a good filename for aClassName -
+ using abbreviation file if there is one"
+
+ |fileName aStream abbrev line thisName index|
+
+ fileName := aClassName.
+
+ fileName size < 10 ifTrue:[^ fileName].
+
+ "too bad - look for abbreviation"
+
+ aStream := self systemFileStreamFor:'abbrev.stc'.
+ aStream notNil ifTrue:[
+ [aStream atEnd] whileFalse:[
+ line := aStream nextLine.
+ line notNil ifTrue:[
+ (line countWords == 2) ifTrue:[
+ index := line indexOfSeparatorStartingAt:1.
+ (index ~~ 0) ifTrue:[
+ thisName := line copyFrom:1 to:(index - 1).
+ (thisName = fileName) ifTrue:[
+ abbrev := (line copyFrom:index) withoutSeparators.
+ aStream close.
+ ^ abbrev
+ ]
+ ]
+ ]
+ ]
+ ].
+ aStream close
+ ].
+
+ "no file found"
+ OperatingSystem maxFileNameLength >= (fileName size + 3) ifTrue:[
+ " self warn:'filename ' , fileName , ' will not work on sys5 machines' "
+ ] ifFalse:[
+ self error:'cant find short for ' , fileName , ' in abbreviation file'
+ ].
+ ^ fileName
+!
+
+fileInClassObject:aClassName from:aFileName
+ "read in the named object file - look for it in some standard places;
+ return true if ok, false if failed"
+
+ |aStream|
+
+ aStream := self systemFileStreamFor:aFileName.
+ aStream isNil ifTrue:[^ false].
+ aStream close.
+
+ (ObjectFileLoader loadClass:aClassName fromObjectFile:aFileName) isNil ifTrue:[^ false].
+ ^ true
+
+ " Smalltalk fileInClassObject:'AbstractPath' from:'../goodies/Paths/AbstrPath.o' "
+!
+
+fileIn:aFileName
+ "read in the named file - look for it in some standard places;
+ return true if ok, false if failed"
+
+ |aStream|
+
+ aStream := self systemFileStreamFor:aFileName.
+ aStream isNil ifTrue:[^ false].
+
+ [aStream fileIn] valueNowOrOnUnwindDo:[aStream close].
+ ^ true
+
+ " Smalltalk fileIn:'games/TicTacToe.st' "
+!
+
+fileInChanges
+ "read in the last changes file - bringing the system to the state it
+ had when left the last time"
+
+ |upd|
+
+ "tell Class to NOT update the changes file now ..."
+ upd := Class updateChanges:false.
+ [self fileIn:'changes'] valueNowOrOnUnwindDo:[Class updateChanges:upd]
+
+ "Smalltalk fileInChanges "
+!
+
+fileInClass:aClassName
+ "find a source/object file for aClassName and -if found - load it"
+
+ |fName newClass upd|
+
+ fName := self fileNameForClass:aClassName.
+ fName notNil ifTrue:[
+ upd := Class updateChanges:false.
+ [
+ (self fileIn:('fileIn/' , fName , '.ld')) ifFalse:[
+ (self fileInClassObject:aClassName from:('binary/' , fName, '.so')) ifFalse:[
+ (self fileInClassObject:aClassName from:('binary/' , fName, '.o')) ifFalse:[
+ self fileIn:(fName , '.st')
+ ]
+ ]
+ ]
+ ] valueNowOrOnUnwindDo:[Class updateChanges:upd].
+ newClass := self at:(aClassName asSymbol).
+ (newClass notNil
+ and:[newClass implements:#initialize]) ifTrue:[newClass initialize]
+ ]
+! !