"

 COPYRIGHT (c) 1988 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 SystemPath 

                           StartupClass StartupSelector StartupArguments

                           CachedAbbreviations'

       poolDictionaries:''

       category:'System-Support'

!

Smalltalk comment:'

COPYRIGHT (c) 1988 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).

'!

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:#MemoryLimit 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"

    ^ 8

    "Smalltalk minorVersion"

!

revision

    "return the revision number"

    "Smalltalk revision"

!

version

    "return the version string"

    ^ (self majorVersion printString ,

       '.',

       self minorVersion printString ,

       '.',

       self revision printString)

    "Smalltalk version"

!

versionDate

    "return the version date"

    ^ '17-dec-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

    ].

    (Language == #french) ifTrue:[

        ^ 'Bienvenue a SmallTalk/X version '

          , self version , ' de ' , 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

    "initialize all other classes; setup dispatcher processes etc.

     - this one is the first entry into the smalltalk world right after startup,

       ususally followed by Smalltalk>>start"

    self initGlobalsFromEnvironment.

    "sorry - there are some, which MUST be initialized before ..

     reason: if any error happens during init, we need Signals, Stdout etc. to be there"

    Object initialize.

    ExternalStream initialize.

    self initStandardStreams.

    "sorry, path must be set before ...

     reason: some classes need it during initialize (they might need resources, bitmaps etc)"

    self initSystemPath.

    "must init display here - some classes (Color, Form) need it during initialize"

    Workstation notNil ifTrue:[

        Workstation initialize

    ].

    "define low-level debugging tools - graphical classes are not prepared yet

     to handle things ... - this will bring us into the MiniDebugger when an error occurs"

    Inspector := MiniInspector.

    Debugger := MiniDebugger.

    Compiler := ByteCodeCompiler.

    Compiler isNil ifTrue:[

        "this allows at least immediate evaluations for runtime systems without compiler"

        Compiler := Parser

    ].

    "now finally initialize all classes"

    self allBehaviorsDo:[:aClass |

        "avoid 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 copyTo:(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"

    OperatingSystem enableUserInterrupts.

    OperatingSystem enableSignalInterrupts.

    OperatingSystem enableFpExceptionInterrupts.

    ObjectMemory userInterruptHandler:self.

    ObjectMemory signalInterruptHandler:self.

    ObjectMemory recursionInterruptHandler:self.

    "Smalltalk initInterrupts"

!

initSystemPath

    "setup path to search for system files.

     the default path is set to:

            .

            ..

            $HOME

            $HOME/.smalltalk

            $SMALLTALK_LIBDIR

            /usr/local/lib/smalltalk

            /usr/lib/smalltalk

    "

    |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"

    "Smalltalk systemPath"

!

start

    "main startup, if there is a Display, initialize it

     and start dispatching; otherwise go into a read-eval-print loop"

    |idx|

    Initializing := true.

    Processor := ProcessorScheduler new.

    "read patches- and rc-file, do not add things into change-file"

    Class updateChanges:false.

    self fileIn:'patches'.

    "look for a '-e filename' argument - this will force evaluation of

     filename only, no standard startup"

    idx := Arguments indexOf:'-e'.

    idx ~~ 0 ifTrue:[

        self fileIn:(Arguments at:idx + 1).

        self exit

    ].

    (self fileIn:((Arguments at:1) , '.rc')) ifFalse:[

        "no .rc file where executable is; try default smalltalk.rc"

        self fileIn:'smalltalk.rc'

    ].

    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.'

    ].

    "let display install itself into Processors dispatch"

    Display notNil ifTrue:[

        Display startDispatch.

        "this is a leftover - will vanish"

        ModalDisplay notNil ifTrue:[

            ModalDisplay startDispatch

        ]

    ].

    (StartupClass notNil and:[StartupSelector notNil]) ifTrue:[

        StartupClass perform:StartupSelector withArguments:StartupArguments.

    ].

    [self saveMainLoop] whileTrue:[ ].

    "done"

    self exit

!

restart

    "startup after an image has been loaded;

     there are three change-notifications made to dependents of ObjectMemory,

     which allow a stepwise re-init: #earlyRestart, #restarted and #returnFromSnapshot.

     #earlyRestart is send first, nothing has been setup yet.

                   (should be used to flush all device dependent entries)

     #restarted is send right after.

                   (should be used to recreate external resources (fds, bitmaps etc)

     #returnFromSnapshot is sent last

     "

    |deb insp|

    Initializing := true.

    Processor reInitialize.

    "temporary switch back to dumb interface - to handle errors while view-stuff is

     not yet reinitialized"

    insp := Inspector.

    deb := Debugger.

    Inspector := MiniInspector.

    Debugger := MiniDebugger.

    ObjectMemory changed:#earlyRestart.

    ObjectMemory changed:#restarted.

    "

     some must be reinitialized before ...

     - sorry, but order is important

    "

    Workstation reinitialize.

    ObjectMemory changed:#returnFromSnapshot.

    OperatingSystem enableUserInterrupts.

    OperatingSystem enableSignalInterrupts.

    "and back to real interface"

    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.'

    ].

    "

     give user a chance to re-customize things

    "

    Class updateChanges:false.

    (self fileIn:((Arguments at:1) , '_r.rc')) ifFalse:[

        "no _r.rc file where executable is; try default smalltalk_r.rc"

        self fileIn:'smalltalk_r.rc'

    ].

    Class updateChanges:true.

    "if there is a display, make it add itself to the dispatcher"

    Display notNil ifTrue:[

        Display startDispatch.

        ModalDisplay notNil ifTrue:[

            ModalDisplay startDispatch

        ]

    ].

    "this allows firing an application by defining

     these two globals during snapshot ... or in main"

    (StartupClass notNil and:[StartupSelector notNil]) ifTrue:[

        "allow customization by reading an image specific rc-file"

        ImageName notNil ifTrue:[

            (ImageName endsWith:'.img') ifTrue:[

                self fileIn:((ImageName copyTo:(ImageName size - 4)), '.rc')

            ] ifFalse:[

                self fileIn:(ImageName , '.rc')

            ]

        ].

        StartupClass perform:StartupSelector withArguments:StartupArguments.

    ].

    [self saveMainLoop] whileTrue:[ ].

    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:[

        Processor dispatchLoop

    ] ifFalse:[

        self readEvalPrint

    ].

    ^ false

!

readEvalPrint

    "simple read-eval-print loop for non-graphical Minitalk"

    |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