Smalltalk.st
author claus
Fri, 25 Feb 1994 14:05:47 +0100
changeset 62 e1b4369c61fb
parent 50 71f3b9444905
child 70 73055652dd21
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1988 by Claus Gittinger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     3
              All Rights Reserved
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
a27a279701f8 Initial revision
claus
parents:
diff changeset
    13
Object subclass:#Smalltalk
a27a279701f8 Initial revision
claus
parents:
diff changeset
    14
       instanceVariableNames:''
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
    15
       classVariableNames:'ExitBlocks CachedClasses SystemPath 
10
claus
parents: 8
diff changeset
    16
                           StartupClass StartupSelector StartupArguments
claus
parents: 8
diff changeset
    17
                           CachedAbbreviations'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
       poolDictionaries:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
       category:'System-Support'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    21
a27a279701f8 Initial revision
claus
parents:
diff changeset
    22
Smalltalk comment:'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    23
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
    24
COPYRIGHT (c) 1988 by Claus Gittinger
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    25
             All Rights Reserved
a27a279701f8 Initial revision
claus
parents:
diff changeset
    26
a27a279701f8 Initial revision
claus
parents:
diff changeset
    27
This is one of the central classes in the system;
a27a279701f8 Initial revision
claus
parents:
diff changeset
    28
it provides all system-startup, shutdown and maintenance support.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    29
Also global variables are kept here.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    30
a27a279701f8 Initial revision
claus
parents:
diff changeset
    31
As you will notice, this is NOT a Dictionary
a27a279701f8 Initial revision
claus
parents:
diff changeset
    32
 - my implementation of globals is totally different
a27a279701f8 Initial revision
claus
parents:
diff changeset
    33
   (due to the need to be able to access globals from c-code as well).
a27a279701f8 Initial revision
claus
parents:
diff changeset
    34
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
    35
$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.14 1994-02-25 13:05:29 claus Exp $
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    36
'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    37
a27a279701f8 Initial revision
claus
parents:
diff changeset
    38
Smalltalk at:#ErrorNumber put:nil!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    39
Smalltalk at:#ErrorString put:nil!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    40
Smalltalk at:#Language put:#english!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    41
Smalltalk at:#LanguageTerritory put:#usa!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    42
Smalltalk at:#Initializing put:false!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    43
Smalltalk at:#SilentLoading put:false!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    44
Smalltalk at:#MemoryLimit put:nil!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    45
Smalltalk at:#SignalCatchBlock put:nil!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    46
a27a279701f8 Initial revision
claus
parents:
diff changeset
    47
!Smalltalk class methodsFor:'time-versions'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    48
a27a279701f8 Initial revision
claus
parents:
diff changeset
    49
majorVersion
a27a279701f8 Initial revision
claus
parents:
diff changeset
    50
    "return the major version number"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    51
a27a279701f8 Initial revision
claus
parents:
diff changeset
    52
    ^ 2
a27a279701f8 Initial revision
claus
parents:
diff changeset
    53
a27a279701f8 Initial revision
claus
parents:
diff changeset
    54
    "Smalltalk majorVersion"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    55
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    56
a27a279701f8 Initial revision
claus
parents:
diff changeset
    57
minorVersion
a27a279701f8 Initial revision
claus
parents:
diff changeset
    58
    "return the minor version number"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    59
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
    60
    ^ 9
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    61
a27a279701f8 Initial revision
claus
parents:
diff changeset
    62
    "Smalltalk minorVersion"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    63
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    64
a27a279701f8 Initial revision
claus
parents:
diff changeset
    65
revision
a27a279701f8 Initial revision
claus
parents:
diff changeset
    66
    "return the revision number"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    67
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
    68
    ^ 1
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    69
a27a279701f8 Initial revision
claus
parents:
diff changeset
    70
    "Smalltalk revision"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    71
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    72
a27a279701f8 Initial revision
claus
parents:
diff changeset
    73
version
a27a279701f8 Initial revision
claus
parents:
diff changeset
    74
    "return the version string"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    75
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
    ^ (self majorVersion printString ,
a27a279701f8 Initial revision
claus
parents:
diff changeset
    77
       '.',
a27a279701f8 Initial revision
claus
parents:
diff changeset
    78
       self minorVersion printString ,
a27a279701f8 Initial revision
claus
parents:
diff changeset
    79
       '.',
a27a279701f8 Initial revision
claus
parents:
diff changeset
    80
       self revision printString)
a27a279701f8 Initial revision
claus
parents:
diff changeset
    81
a27a279701f8 Initial revision
claus
parents:
diff changeset
    82
    "Smalltalk version"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    83
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    84
a27a279701f8 Initial revision
claus
parents:
diff changeset
    85
versionDate
a27a279701f8 Initial revision
claus
parents:
diff changeset
    86
    "return the version date"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    87
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
    88
    ^ '18-feb-1994'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    89
a27a279701f8 Initial revision
claus
parents:
diff changeset
    90
    "Smalltalk versionDate"
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
    91
!      
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    92
a27a279701f8 Initial revision
claus
parents:
diff changeset
    93
copyright
a27a279701f8 Initial revision
claus
parents:
diff changeset
    94
    "return a copyright string"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    95
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
    96
    ^ 'Copyright (c) 1988-94 by Claus Gittinger'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    97
a27a279701f8 Initial revision
claus
parents:
diff changeset
    98
    "Smalltalk copyright"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    99
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   100
a27a279701f8 Initial revision
claus
parents:
diff changeset
   101
hello
a27a279701f8 Initial revision
claus
parents:
diff changeset
   102
    "return a greeting string"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   103
a27a279701f8 Initial revision
claus
parents:
diff changeset
   104
    (Language == #german) ifTrue:[
27
d98f9dd437f7 *** empty log message ***
claus
parents: 24
diff changeset
   105
        ^ 'Willkommen bei SmallTalk/X version '
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   106
          , self version , ' vom ' , self versionDate
a27a279701f8 Initial revision
claus
parents:
diff changeset
   107
    ].
2
claus
parents: 1
diff changeset
   108
    (Language == #french) ifTrue:[
27
d98f9dd437f7 *** empty log message ***
claus
parents: 24
diff changeset
   109
        ^ 'Bienvenue a SmallTalk/X version '
2
claus
parents: 1
diff changeset
   110
          , self version , ' de ' , self versionDate
claus
parents: 1
diff changeset
   111
    ].
27
d98f9dd437f7 *** empty log message ***
claus
parents: 24
diff changeset
   112
    ^ 'Hello World - here is SmallTalk/X version '
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   113
      , self version , ' of ' , self versionDate
a27a279701f8 Initial revision
claus
parents:
diff changeset
   114
a27a279701f8 Initial revision
claus
parents:
diff changeset
   115
    "Smalltalk hello"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   116
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   117
a27a279701f8 Initial revision
claus
parents:
diff changeset
   118
timeStamp
a27a279701f8 Initial revision
claus
parents:
diff changeset
   119
    "return a string useful for timestamping a file"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   120
a27a279701f8 Initial revision
claus
parents:
diff changeset
   121
    ^ '''From Smalltalk/X, Version:' , (Smalltalk version) , ' on '
a27a279701f8 Initial revision
claus
parents:
diff changeset
   122
      , Date today printString , ' at ' , Time now printString
a27a279701f8 Initial revision
claus
parents:
diff changeset
   123
      , ''''
a27a279701f8 Initial revision
claus
parents:
diff changeset
   124
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   125
a27a279701f8 Initial revision
claus
parents:
diff changeset
   126
!Smalltalk class methodsFor:'initialization'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   127
a27a279701f8 Initial revision
claus
parents:
diff changeset
   128
initialize
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   129
    "initialize all other classes; setup dispatcher processes etc.
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   130
     - this one is the first entry into the smalltalk world right after startup,
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   131
       ususally followed by Smalltalk>>start"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   132
a27a279701f8 Initial revision
claus
parents:
diff changeset
   133
    self initGlobalsFromEnvironment.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   134
a27a279701f8 Initial revision
claus
parents:
diff changeset
   135
    "sorry - there are some, which MUST be initialized before ..
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   136
     reason: if any error happens during init, we need Signals, Stdout etc. to be there"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   137
a27a279701f8 Initial revision
claus
parents:
diff changeset
   138
    Object initialize.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   139
    ExternalStream initialize.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   140
    self initStandardStreams.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   141
a27a279701f8 Initial revision
claus
parents:
diff changeset
   142
    "sorry, path must be set before ...
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   143
     reason: some classes need it during initialize (they might need resources, bitmaps etc)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   144
a27a279701f8 Initial revision
claus
parents:
diff changeset
   145
    self initSystemPath.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   146
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   147
    "must init display here - some classes (Color, Form) need it during initialize"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   148
a27a279701f8 Initial revision
claus
parents:
diff changeset
   149
    Workstation notNil ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   150
        Workstation initialize
a27a279701f8 Initial revision
claus
parents:
diff changeset
   151
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   152
10
claus
parents: 8
diff changeset
   153
    "define low-level debugging tools - graphical classes are not prepared yet
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   154
     to handle things ... - this will bring us into the MiniDebugger when an error occurs"
10
claus
parents: 8
diff changeset
   155
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   156
    Inspector := MiniInspector.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   157
    Debugger := MiniDebugger.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   158
    Compiler := ByteCodeCompiler.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   159
    Compiler isNil ifTrue:[
10
claus
parents: 8
diff changeset
   160
        "this allows at least immediate evaluations for runtime systems without compiler"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   161
        Compiler := Parser
a27a279701f8 Initial revision
claus
parents:
diff changeset
   162
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   163
10
claus
parents: 8
diff changeset
   164
    "now finally initialize all classes"
claus
parents: 8
diff changeset
   165
2
claus
parents: 1
diff changeset
   166
    self allBehaviorsDo:[:aClass |
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   167
        "avoid never-ending story ..."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   168
        (aClass ~~ Smalltalk) ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   169
            aClass initialize
a27a279701f8 Initial revision
claus
parents:
diff changeset
   170
        ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   171
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   172
    self initStandardTools.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   173
    self initInterrupts
a27a279701f8 Initial revision
claus
parents:
diff changeset
   174
a27a279701f8 Initial revision
claus
parents:
diff changeset
   175
    "Smalltalk initialize"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   176
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   177
a27a279701f8 Initial revision
claus
parents:
diff changeset
   178
initGlobalsFromEnvironment
a27a279701f8 Initial revision
claus
parents:
diff changeset
   179
    "setup globals from the shell-environment"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   180
a27a279701f8 Initial revision
claus
parents:
diff changeset
   181
    |envString firstChar i langString terrString|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   182
a27a279701f8 Initial revision
claus
parents:
diff changeset
   183
    "extract Language and LanguageTerritory from LANG variable.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   184
     the language and territory must not be abbreviated,
a27a279701f8 Initial revision
claus
parents:
diff changeset
   185
     valid is for example: english_usa
a27a279701f8 Initial revision
claus
parents:
diff changeset
   186
                           english
a27a279701f8 Initial revision
claus
parents:
diff changeset
   187
                           german
a27a279701f8 Initial revision
claus
parents:
diff changeset
   188
                           german_austria"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   189
a27a279701f8 Initial revision
claus
parents:
diff changeset
   190
    envString := OperatingSystem getEnvironment:'LANG'.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   191
    envString notNil ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   192
        i := envString indexOf:$_.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   193
        (i == 0) ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   194
            langString := envString.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   195
            terrString := envString
a27a279701f8 Initial revision
claus
parents:
diff changeset
   196
        ] ifFalse:[
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   197
            langString := envString copyTo:(i - 1).
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   198
            terrString := envString copyFrom:(i + 1)
a27a279701f8 Initial revision
claus
parents:
diff changeset
   199
        ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   200
        Language := langString asSymbol.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   201
        LanguageTerritory := terrString asSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
   202
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   203
a27a279701f8 Initial revision
claus
parents:
diff changeset
   204
    envString := OperatingSystem getEnvironment:'VIEW3D'.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   205
    envString notNil ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   206
        firstChar := (envString at:1) asLowercase.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   207
        (firstChar == $t) ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   208
            Smalltalk at:#View3D put:true
a27a279701f8 Initial revision
claus
parents:
diff changeset
   209
        ] ifFalse: [
a27a279701f8 Initial revision
claus
parents:
diff changeset
   210
            Smalltalk at:#View3D put:false
a27a279701f8 Initial revision
claus
parents:
diff changeset
   211
        ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   212
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   213
    "Smalltalk initGlobalsFromEnvironment"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   214
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   215
a27a279701f8 Initial revision
claus
parents:
diff changeset
   216
initStandardTools
a27a279701f8 Initial revision
claus
parents:
diff changeset
   217
    "predefine some tools we will need later
a27a279701f8 Initial revision
claus
parents:
diff changeset
   218
     - if the view-classes exist,
a27a279701f8 Initial revision
claus
parents:
diff changeset
   219
       they will redefine Inspector and Debugger for graphical interfaces"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   220
a27a279701f8 Initial revision
claus
parents:
diff changeset
   221
    "redefine debug-tools, if view-classes exist"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   222
a27a279701f8 Initial revision
claus
parents:
diff changeset
   223
    (Smalltalk at:#Display) notNil ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   224
        (Smalltalk at:#InspectorView) notNil ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   225
            Inspector := Smalltalk at:#InspectorView
a27a279701f8 Initial revision
claus
parents:
diff changeset
   226
        ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   227
        (Smalltalk at:#DebugView) notNil ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   228
            Debugger := Smalltalk at:#DebugView
a27a279701f8 Initial revision
claus
parents:
diff changeset
   229
        ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   230
        Display initialize
a27a279701f8 Initial revision
claus
parents:
diff changeset
   231
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   232
    "Smalltalk initStandardTools"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   233
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   234
a27a279701f8 Initial revision
claus
parents:
diff changeset
   235
initStandardStreams
a27a279701f8 Initial revision
claus
parents:
diff changeset
   236
    "initialize some well-known streams"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   237
a27a279701f8 Initial revision
claus
parents:
diff changeset
   238
    Stdout := NonPositionableExternalStream forStdout.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   239
    Stderr := NonPositionableExternalStream forStderr.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   240
    Stdin := NonPositionableExternalStream forStdin.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   241
    Printer := PrinterStream.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   242
    Transcript := Stderr
a27a279701f8 Initial revision
claus
parents:
diff changeset
   243
a27a279701f8 Initial revision
claus
parents:
diff changeset
   244
    "Smalltalk initStandardStreams"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   245
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   246
a27a279701f8 Initial revision
claus
parents:
diff changeset
   247
initInterrupts
a27a279701f8 Initial revision
claus
parents:
diff changeset
   248
    "initialize interrupts"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   249
a27a279701f8 Initial revision
claus
parents:
diff changeset
   250
    OperatingSystem enableUserInterrupts.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   251
    OperatingSystem enableSignalInterrupts.
2
claus
parents: 1
diff changeset
   252
    OperatingSystem enableFpExceptionInterrupts.
claus
parents: 1
diff changeset
   253
claus
parents: 1
diff changeset
   254
    ObjectMemory userInterruptHandler:self.
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   255
    ObjectMemory signalInterruptHandler:self.
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   256
    ObjectMemory recursionInterruptHandler:self.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   257
a27a279701f8 Initial revision
claus
parents:
diff changeset
   258
    "Smalltalk initInterrupts"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   259
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   260
a27a279701f8 Initial revision
claus
parents:
diff changeset
   261
initSystemPath
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   262
    "setup path to search for system files.
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   263
     the default path is set to:
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   264
            .
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   265
            ..
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   266
            $HOME
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   267
            $HOME/.smalltalk
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   268
            $SMALLTALK_LIBDIR
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   269
            /usr/local/lib/smalltalk
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   270
            /usr/lib/smalltalk
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   271
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   272
a27a279701f8 Initial revision
claus
parents:
diff changeset
   273
    |p|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   274
a27a279701f8 Initial revision
claus
parents:
diff changeset
   275
    "the path is set to search files first locally
a27a279701f8 Initial revision
claus
parents:
diff changeset
   276
     - this allows private stuff to override global stuff"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   277
a27a279701f8 Initial revision
claus
parents:
diff changeset
   278
    SystemPath := OrderedCollection new.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   279
    SystemPath add:'.'.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   280
    SystemPath add:'..'.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   281
    SystemPath add:(OperatingSystem getHomeDirectory).
a27a279701f8 Initial revision
claus
parents:
diff changeset
   282
    (OperatingSystem isDirectory:(OperatingSystem getHomeDirectory , '/.smalltalk')) ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   283
        SystemPath add:(OperatingSystem getHomeDirectory , '/.smalltalk')
a27a279701f8 Initial revision
claus
parents:
diff changeset
   284
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   285
    p := OperatingSystem getEnvironment:'SMALLTALK_LIBDIR'.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   286
    p notNil ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   287
        SystemPath add:p
a27a279701f8 Initial revision
claus
parents:
diff changeset
   288
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   289
    (OperatingSystem isDirectory:'/usr/local/lib/smalltalk') ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   290
        SystemPath add:'/usr/local/lib/smalltalk'
a27a279701f8 Initial revision
claus
parents:
diff changeset
   291
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   292
    (OperatingSystem isDirectory:'/usr/lib/smalltalk') ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   293
        SystemPath add:'/usr/lib/smalltalk'
a27a279701f8 Initial revision
claus
parents:
diff changeset
   294
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   295
a27a279701f8 Initial revision
claus
parents:
diff changeset
   296
    "Smalltalk initSystemPath"
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   297
    "Smalltalk systemPath"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   298
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   299
a27a279701f8 Initial revision
claus
parents:
diff changeset
   300
start
a27a279701f8 Initial revision
claus
parents:
diff changeset
   301
    "main startup, if there is a Display, initialize it
a27a279701f8 Initial revision
claus
parents:
diff changeset
   302
     and start dispatching; otherwise go into a read-eval-print loop"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   303
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   304
    |idx|
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   305
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   306
    Initializing := true.
10
claus
parents: 8
diff changeset
   307
    Processor := ProcessorScheduler new.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   308
a27a279701f8 Initial revision
claus
parents:
diff changeset
   309
    "read patches- and rc-file, do not add things into change-file"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   310
a27a279701f8 Initial revision
claus
parents:
diff changeset
   311
    Class updateChanges:false.
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   312
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   313
    self fileIn:'patches'.
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   314
10
claus
parents: 8
diff changeset
   315
    "look for a '-e filename' argument - this will force evaluation of
claus
parents: 8
diff changeset
   316
     filename only, no standard startup"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   317
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   318
    idx := Arguments indexOf:'-e'.
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   319
    idx ~~ 0 ifTrue:[
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   320
        self fileIn:(Arguments at:idx + 1).
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   321
        self exit
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   322
    ].
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   323
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   324
    (self fileIn:((Arguments at:1) , '.rc')) ifFalse:[
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   325
        "no .rc file where executable is; try default smalltalk.rc"
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   326
        self fileIn:'smalltalk.rc'
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   327
    ].
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   328
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   329
    Class updateChanges:true.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   330
a27a279701f8 Initial revision
claus
parents:
diff changeset
   331
    SilentLoading ifFalse:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   332
        Transcript showCr:(self hello).
a27a279701f8 Initial revision
claus
parents:
diff changeset
   333
        Transcript showCr:(self copyright).
a27a279701f8 Initial revision
claus
parents:
diff changeset
   334
        Transcript cr
a27a279701f8 Initial revision
claus
parents:
diff changeset
   335
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   336
a27a279701f8 Initial revision
claus
parents:
diff changeset
   337
    Initializing := false.
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   338
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   339
    "do not expect to get things fixed by setting it to false ... :-)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   340
    DemoMode ifTrue:[
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   341
        Transcript showCr:'    *** Unlicensed demo mode with restrictions ***'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   342
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   343
10
claus
parents: 8
diff changeset
   344
    "let display install itself into Processors dispatch"
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   345
    Display notNil ifTrue:[
10
claus
parents: 8
diff changeset
   346
        Display startDispatch.
claus
parents: 8
diff changeset
   347
claus
parents: 8
diff changeset
   348
        "this is a leftover - will vanish"
claus
parents: 8
diff changeset
   349
        ModalDisplay notNil ifTrue:[
claus
parents: 8
diff changeset
   350
            ModalDisplay startDispatch
claus
parents: 8
diff changeset
   351
        ]
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   352
    ].
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   353
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   354
    (StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   355
        StartupClass perform:StartupSelector withArguments:StartupArguments.
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   356
    ].
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   357
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   358
    [self saveMainLoop] whileTrue:[ ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   359
a27a279701f8 Initial revision
claus
parents:
diff changeset
   360
    "done"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   361
a27a279701f8 Initial revision
claus
parents:
diff changeset
   362
    self exit
a27a279701f8 Initial revision
claus
parents:
diff changeset
   363
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   364
a27a279701f8 Initial revision
claus
parents:
diff changeset
   365
restart
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   366
    "startup after an image has been loaded;
10
claus
parents: 8
diff changeset
   367
     there are three change-notifications made to dependents of ObjectMemory,
claus
parents: 8
diff changeset
   368
     which allow a stepwise re-init: #earlyRestart, #restarted and #returnFromSnapshot.
claus
parents: 8
diff changeset
   369
     #earlyRestart is send first, nothing has been setup yet.
claus
parents: 8
diff changeset
   370
                   (should be used to flush all device dependent entries)
claus
parents: 8
diff changeset
   371
     #restarted is send right after.
claus
parents: 8
diff changeset
   372
                   (should be used to recreate external resources (fds, bitmaps etc)
claus
parents: 8
diff changeset
   373
     #returnFromSnapshot is sent last
42
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
   374
                   (should be used to restart processes, reOpen Streams which cannot
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
   375
                    be automatically be reopened (i.e. Sockets, Pipes) and so on.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   376
     "
10
claus
parents: 8
diff changeset
   377
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   378
    |deb insp|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   379
a27a279701f8 Initial revision
claus
parents:
diff changeset
   380
    Initializing := true.
10
claus
parents: 8
diff changeset
   381
    Processor reInitialize.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   382
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   383
    "temporary switch back to dumb interface - to handle errors while view-stuff is
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   384
     not yet reinitialized"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   385
a27a279701f8 Initial revision
claus
parents:
diff changeset
   386
    insp := Inspector.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   387
    deb := Debugger.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   388
    Inspector := MiniInspector.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   389
    Debugger := MiniDebugger.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   390
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   391
    ObjectMemory changed:#earlyRestart.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   392
    ObjectMemory changed:#restarted.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   393
a27a279701f8 Initial revision
claus
parents:
diff changeset
   394
    "
a27a279701f8 Initial revision
claus
parents:
diff changeset
   395
     some must be reinitialized before ...
a27a279701f8 Initial revision
claus
parents:
diff changeset
   396
     - sorry, but order is important
a27a279701f8 Initial revision
claus
parents:
diff changeset
   397
    "
a27a279701f8 Initial revision
claus
parents:
diff changeset
   398
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   399
    Workstation notNil ifTrue:[
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   400
        Workstation reinitialize.
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   401
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   402
a27a279701f8 Initial revision
claus
parents:
diff changeset
   403
    ObjectMemory changed:#returnFromSnapshot.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   404
a27a279701f8 Initial revision
claus
parents:
diff changeset
   405
    OperatingSystem enableUserInterrupts.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   406
    OperatingSystem enableSignalInterrupts.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   407
10
claus
parents: 8
diff changeset
   408
    "and back to real interface"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   409
    Inspector := insp.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   410
    Debugger := deb.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   411
a27a279701f8 Initial revision
claus
parents:
diff changeset
   412
    Initializing := false.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   413
a27a279701f8 Initial revision
claus
parents:
diff changeset
   414
    "
a27a279701f8 Initial revision
claus
parents:
diff changeset
   415
     if there is no Transcript, go to stderr
a27a279701f8 Initial revision
claus
parents:
diff changeset
   416
    "
a27a279701f8 Initial revision
claus
parents:
diff changeset
   417
    Transcript isNil ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   418
        self initStandardStreams.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   419
        Transcript := Stderr
a27a279701f8 Initial revision
claus
parents:
diff changeset
   420
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   421
a27a279701f8 Initial revision
claus
parents:
diff changeset
   422
    Transcript cr.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   423
    Transcript showCr:('Smalltalk restarted from:' , ImageName).
a27a279701f8 Initial revision
claus
parents:
diff changeset
   424
    DemoMode ifTrue:[
50
71f3b9444905 *** empty log message ***
claus
parents: 44
diff changeset
   425
        Transcript showCr:'    *** Unlicensed demo mode with restrictions ***'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   426
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   427
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   428
    "
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   429
     give user a chance to re-customize things
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   430
    "
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   431
    Class updateChanges:false.
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   432
    (self fileIn:((Arguments at:1) , '_r.rc')) ifFalse:[
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   433
        "no _r.rc file where executable is; try default smalltalk_r.rc"
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   434
        self fileIn:'smalltalk_r.rc'
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   435
    ].
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   436
    Class updateChanges:true.
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   437
10
claus
parents: 8
diff changeset
   438
    "if there is a display, make it add itself to the dispatcher"
claus
parents: 8
diff changeset
   439
    Display notNil ifTrue:[
claus
parents: 8
diff changeset
   440
        Display startDispatch.
claus
parents: 8
diff changeset
   441
        ModalDisplay notNil ifTrue:[
claus
parents: 8
diff changeset
   442
            ModalDisplay startDispatch
claus
parents: 8
diff changeset
   443
        ]
claus
parents: 8
diff changeset
   444
    ].
claus
parents: 8
diff changeset
   445
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   446
    "this allows firing an application by defining
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   447
     these two globals during snapshot ... or in main"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   448
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   449
    (StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   450
        "allow customization by reading an image specific rc-file"
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   451
        ImageName notNil ifTrue:[
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   452
            (ImageName endsWith:'.img') ifTrue:[
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   453
                self fileIn:((ImageName copyTo:(ImageName size - 4)), '.rc')
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   454
            ] ifFalse:[
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   455
                self fileIn:(ImageName , '.rc')
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   456
            ]
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   457
        ].
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   458
        StartupClass perform:StartupSelector withArguments:StartupArguments.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   459
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   460
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   461
    [self saveMainLoop] whileTrue:[ ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   462
a27a279701f8 Initial revision
claus
parents:
diff changeset
   463
    self exit
a27a279701f8 Initial revision
claus
parents:
diff changeset
   464
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   465
a27a279701f8 Initial revision
claus
parents:
diff changeset
   466
saveMainLoop
a27a279701f8 Initial revision
claus
parents:
diff changeset
   467
    "main dispatching loop - exits with true for a bad exit (to restart),
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   468
     false for real exit."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   469
a27a279701f8 Initial revision
claus
parents:
diff changeset
   470
    Smalltalk at:#SignalCatchBlock put:[^ true].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   471
a27a279701f8 Initial revision
claus
parents:
diff changeset
   472
    "if view-classes exist, start dispatching;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   473
     otherwise go into a read-eval-print loop"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   474
a27a279701f8 Initial revision
claus
parents:
diff changeset
   475
    Display notNil ifTrue:[
10
claus
parents: 8
diff changeset
   476
        Processor dispatchLoop
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   477
    ] ifFalse:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   478
        self readEvalPrint
a27a279701f8 Initial revision
claus
parents:
diff changeset
   479
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   480
    ^ false
a27a279701f8 Initial revision
claus
parents:
diff changeset
   481
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   482
a27a279701f8 Initial revision
claus
parents:
diff changeset
   483
readEvalPrint
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   484
    "simple read-eval-print loop for non-graphical Minitalk"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   485
a27a279701f8 Initial revision
claus
parents:
diff changeset
   486
    |text|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   487
a27a279701f8 Initial revision
claus
parents:
diff changeset
   488
    'ST- ' print.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   489
    Stdin skipSeparators.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   490
    text := Stdin nextChunk.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   491
    [text notNil] whileTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   492
        (Compiler evaluate:text) printNewline.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   493
        'ST- ' print.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   494
        text := Stdin nextChunk
a27a279701f8 Initial revision
claus
parents:
diff changeset
   495
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   496
    '' printNewline
a27a279701f8 Initial revision
claus
parents:
diff changeset
   497
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   498
a27a279701f8 Initial revision
claus
parents:
diff changeset
   499
!Smalltalk class methodsFor:'accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   500
a27a279701f8 Initial revision
claus
parents:
diff changeset
   501
at:aKey
a27a279701f8 Initial revision
claus
parents:
diff changeset
   502
    "retrieve the value stored under aKey, a symbol"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   503
a27a279701f8 Initial revision
claus
parents:
diff changeset
   504
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   505
    extern OBJ _GETGLOBAL();
a27a279701f8 Initial revision
claus
parents:
diff changeset
   506
a27a279701f8 Initial revision
claus
parents:
diff changeset
   507
    RETURN ( _GETGLOBAL(aKey) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   508
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   509
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   510
a27a279701f8 Initial revision
claus
parents:
diff changeset
   511
at:aKey ifAbsent:aBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   512
    "retrieve the value stored under aKey.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   513
     If there is none stored this key, return the value of
a27a279701f8 Initial revision
claus
parents:
diff changeset
   514
     the evaluation of aBlock"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   515
a27a279701f8 Initial revision
claus
parents:
diff changeset
   516
    (self includesKey:aKey) ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   517
        ^ self at:aKey
a27a279701f8 Initial revision
claus
parents:
diff changeset
   518
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   519
    ^ aBlock value
a27a279701f8 Initial revision
claus
parents:
diff changeset
   520
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   521
a27a279701f8 Initial revision
claus
parents:
diff changeset
   522
at:aKey put:aValue
a27a279701f8 Initial revision
claus
parents:
diff changeset
   523
    "store the argument aValue under aKey, a symbol"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   524
a27a279701f8 Initial revision
claus
parents:
diff changeset
   525
    CachedClasses := nil.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   526
a27a279701f8 Initial revision
claus
parents:
diff changeset
   527
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   528
    extern OBJ _SETGLOBAL();
a27a279701f8 Initial revision
claus
parents:
diff changeset
   529
a27a279701f8 Initial revision
claus
parents:
diff changeset
   530
    RETURN ( _SETGLOBAL(aKey, aValue, (OBJ *)0) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   531
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   532
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   533
a27a279701f8 Initial revision
claus
parents:
diff changeset
   534
removeKey:aKey
a27a279701f8 Initial revision
claus
parents:
diff changeset
   535
    "remove the argument from the globals dictionary"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   536
a27a279701f8 Initial revision
claus
parents:
diff changeset
   537
    CachedClasses := nil.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   538
a27a279701f8 Initial revision
claus
parents:
diff changeset
   539
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   540
    extern OBJ _REMOVEGLOBAL();
a27a279701f8 Initial revision
claus
parents:
diff changeset
   541
a27a279701f8 Initial revision
claus
parents:
diff changeset
   542
    RETURN ( _REMOVEGLOBAL(aKey) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   543
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   544
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   545
a27a279701f8 Initial revision
claus
parents:
diff changeset
   546
includesKey:aKey
a27a279701f8 Initial revision
claus
parents:
diff changeset
   547
    "return true, if the key is known"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   548
a27a279701f8 Initial revision
claus
parents:
diff changeset
   549
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   550
    extern OBJ _KEYKNOWN();
a27a279701f8 Initial revision
claus
parents:
diff changeset
   551
a27a279701f8 Initial revision
claus
parents:
diff changeset
   552
    RETURN ( _KEYKNOWN(aKey) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   553
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   554
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   555
a27a279701f8 Initial revision
claus
parents:
diff changeset
   556
keyAtValue:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   557
    "return the symbol under which anObject is stored - or nil"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   558
a27a279701f8 Initial revision
claus
parents:
diff changeset
   559
    self allKeysDo:[:aKey |
a27a279701f8 Initial revision
claus
parents:
diff changeset
   560
        (self at:aKey) == anObject ifTrue:[^ aKey]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   561
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   562
a27a279701f8 Initial revision
claus
parents:
diff changeset
   563
    "Smalltalk keyAtValue:Object"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   564
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   565
a27a279701f8 Initial revision
claus
parents:
diff changeset
   566
keys
a27a279701f8 Initial revision
claus
parents:
diff changeset
   567
    "return a collection with all keys in the Smalltalk dictionary"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   568
a27a279701f8 Initial revision
claus
parents:
diff changeset
   569
    |keys|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   570
a27a279701f8 Initial revision
claus
parents:
diff changeset
   571
    keys := OrderedCollection new.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   572
    self allKeysDo:[:k | keys add:k].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   573
    ^ keys
a27a279701f8 Initial revision
claus
parents:
diff changeset
   574
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   575
a27a279701f8 Initial revision
claus
parents:
diff changeset
   576
!Smalltalk class methodsFor:'copying'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   577
a27a279701f8 Initial revision
claus
parents:
diff changeset
   578
shallowCopy
a27a279701f8 Initial revision
claus
parents:
diff changeset
   579
    "redefine copy - there is only one Smalltalk dictionary"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   580
a27a279701f8 Initial revision
claus
parents:
diff changeset
   581
    ^ self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   582
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   583
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   584
simpleDeepCopy
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   585
    "redefine copy - there is only one Smalltalk dictionary"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   586
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   587
    ^ self
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   588
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   589
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   590
deepCopyUsing:aDictionary
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   591
    "redefine copy - there is only one Smalltalk dictionary"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   592
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   593
    ^ self
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   594
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   595
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   596
deepCopy
a27a279701f8 Initial revision
claus
parents:
diff changeset
   597
    "redefine copy - there is only one Smalltalk dictionary"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   598
a27a279701f8 Initial revision
claus
parents:
diff changeset
   599
    ^ self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   600
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   601
a27a279701f8 Initial revision
claus
parents:
diff changeset
   602
!Smalltalk class methodsFor:'inspecting'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   603
a27a279701f8 Initial revision
claus
parents:
diff changeset
   604
inspect
a27a279701f8 Initial revision
claus
parents:
diff changeset
   605
    "redefined to launch a DictionaryInspector on the receiver
a27a279701f8 Initial revision
claus
parents:
diff changeset
   606
     (instead of the default InspectorView)."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   607
a27a279701f8 Initial revision
claus
parents:
diff changeset
   608
    DictionaryInspectorView isNil ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   609
        super inspect
a27a279701f8 Initial revision
claus
parents:
diff changeset
   610
    ] ifFalse:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   611
        DictionaryInspectorView openOn:self
a27a279701f8 Initial revision
claus
parents:
diff changeset
   612
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   613
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   614
a27a279701f8 Initial revision
claus
parents:
diff changeset
   615
!Smalltalk class methodsFor:'misc stuff'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   616
a27a279701f8 Initial revision
claus
parents:
diff changeset
   617
addExitBlock:aBlock
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   618
    "add a block to be executed when Smalltalk finishes.
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   619
     This feature is currently not used anywhere - but could be useful for
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   620
     cleanup in stand alone applications."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   621
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   622
    ExitBlocks isNil ifTrue:[
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   623
        ExitBlocks := Array with:aBlock
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   624
    ] ifFalse:[
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   625
        ExitBlocks add:aBlock
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   626
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   627
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   628
a27a279701f8 Initial revision
claus
parents:
diff changeset
   629
exit
a27a279701f8 Initial revision
claus
parents:
diff changeset
   630
    "finish Smalltalk system"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   631
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   632
    ExitBlocks notNil ifTrue:[
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   633
        ExitBlocks do:[:aBlock |
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   634
            aBlock value
a27a279701f8 Initial revision
claus
parents:
diff changeset
   635
        ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   636
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   637
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
   638
    mainExit(0);
a27a279701f8 Initial revision
claus
parents:
diff changeset
   639
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   640
.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   641
    OperatingSystem exit
a27a279701f8 Initial revision
claus
parents:
diff changeset
   642
a27a279701f8 Initial revision
claus
parents:
diff changeset
   643
    "Smalltalk exit"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   644
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   645
a27a279701f8 Initial revision
claus
parents:
diff changeset
   646
sleep:aDelay
a27a279701f8 Initial revision
claus
parents:
diff changeset
   647
    "wait for aDelay seconds"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   648
a27a279701f8 Initial revision
claus
parents:
diff changeset
   649
    OperatingSystem sleep:aDelay
a27a279701f8 Initial revision
claus
parents:
diff changeset
   650
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   651
a27a279701f8 Initial revision
claus
parents:
diff changeset
   652
!Smalltalk class methodsFor:'debugging'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   653
a27a279701f8 Initial revision
claus
parents:
diff changeset
   654
printStackBacktrace
a27a279701f8 Initial revision
claus
parents:
diff changeset
   655
    "print a stack backtrace"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   656
a27a279701f8 Initial revision
claus
parents:
diff changeset
   657
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
   658
    printStack(__context);
a27a279701f8 Initial revision
claus
parents:
diff changeset
   659
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   660
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   661
a27a279701f8 Initial revision
claus
parents:
diff changeset
   662
fatalAbort
a27a279701f8 Initial revision
claus
parents:
diff changeset
   663
    "abort program and dump core"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   664
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
   665
    fatal0(__context, "abort");
a27a279701f8 Initial revision
claus
parents:
diff changeset
   666
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   667
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   668
a27a279701f8 Initial revision
claus
parents:
diff changeset
   669
statistic
a27a279701f8 Initial revision
claus
parents:
diff changeset
   670
    "print some statistic data"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   671
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
   672
    statistic();
a27a279701f8 Initial revision
claus
parents:
diff changeset
   673
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   674
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   675
a27a279701f8 Initial revision
claus
parents:
diff changeset
   676
debugOn
10
claus
parents: 8
diff changeset
   677
    "temporary - turns some tracing on"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   678
a27a279701f8 Initial revision
claus
parents:
diff changeset
   679
    "LookupTrace := true.   "
a27a279701f8 Initial revision
claus
parents:
diff changeset
   680
    MessageTrace := true.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   681
    "AllocTrace := true.     "
a27a279701f8 Initial revision
claus
parents:
diff changeset
   682
    ObjectMemory flushInlineCaches
a27a279701f8 Initial revision
claus
parents:
diff changeset
   683
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   684
a27a279701f8 Initial revision
claus
parents:
diff changeset
   685
debugOff
10
claus
parents: 8
diff changeset
   686
    "temporary - turns tracing off"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   687
a27a279701f8 Initial revision
claus
parents:
diff changeset
   688
    LookupTrace := nil.    
a27a279701f8 Initial revision
claus
parents:
diff changeset
   689
    MessageTrace := nil
a27a279701f8 Initial revision
claus
parents:
diff changeset
   690
    ". AllocTrace := nil     "
a27a279701f8 Initial revision
claus
parents:
diff changeset
   691
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   692
a27a279701f8 Initial revision
claus
parents:
diff changeset
   693
executionDebugOn
10
claus
parents: 8
diff changeset
   694
    "temporary - turns tracing of interpreter on"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   695
a27a279701f8 Initial revision
claus
parents:
diff changeset
   696
    ExecutionTrace := true
a27a279701f8 Initial revision
claus
parents:
diff changeset
   697
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   698
a27a279701f8 Initial revision
claus
parents:
diff changeset
   699
executionDebugOff
10
claus
parents: 8
diff changeset
   700
    "temporary - turns tracing of interpreter off"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   701
a27a279701f8 Initial revision
claus
parents:
diff changeset
   702
    ExecutionTrace := nil
a27a279701f8 Initial revision
claus
parents:
diff changeset
   703
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   704
a27a279701f8 Initial revision
claus
parents:
diff changeset
   705
!Smalltalk class methodsFor:'looping'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   706
a27a279701f8 Initial revision
claus
parents:
diff changeset
   707
do:aBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   708
    "evaluate the argument, aBlock for all values in the Smalltalk dictionary"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   709
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
   710
    __allGlobalsDo(&aBlock COMMA_CON);
a27a279701f8 Initial revision
claus
parents:
diff changeset
   711
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   712
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   713
a27a279701f8 Initial revision
claus
parents:
diff changeset
   714
allKeysDo:aBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   715
    "evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   716
%{
a27a279701f8 Initial revision
claus
parents:
diff changeset
   717
    __allKeysDo(&aBlock COMMA_CON);
a27a279701f8 Initial revision
claus
parents:
diff changeset
   718
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   719
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   720
2
claus
parents: 1
diff changeset
   721
allBehaviorsDo:aBlock
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   722
    "evaluate the argument, aBlock for all classes in the system"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   723
a27a279701f8 Initial revision
claus
parents:
diff changeset
   724
    self allClasses do:aBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   725
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   726
2
claus
parents: 1
diff changeset
   727
allClassesDo:aBlock
claus
parents: 1
diff changeset
   728
    "evaluate the argument, aBlock for all classes in the system.
claus
parents: 1
diff changeset
   729
     Backward compatibility - use allBehaviorsDo: for ST-80 compatibility."
claus
parents: 1
diff changeset
   730
claus
parents: 1
diff changeset
   731
    ^ self allBehaviorsDo:aBlock
claus
parents: 1
diff changeset
   732
!
claus
parents: 1
diff changeset
   733
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   734
associationsDo:aBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   735
    "evaluate the argument, aBlock for all key/value pairs 
a27a279701f8 Initial revision
claus
parents:
diff changeset
   736
     in the Smalltalk dictionary"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   737
a27a279701f8 Initial revision
claus
parents:
diff changeset
   738
    self allKeysDo:[:aKey |
a27a279701f8 Initial revision
claus
parents:
diff changeset
   739
        aBlock value:(aKey -> (self at:aKey))
a27a279701f8 Initial revision
claus
parents:
diff changeset
   740
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   741
a27a279701f8 Initial revision
claus
parents:
diff changeset
   742
    "Smalltalk associationsDo:[:assoc | assoc printNewline]"
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   743
!
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   744
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   745
keysAndValuesDo:aBlock
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   746
    "evaluate the two-arg block, aBlock for all keys and values"
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   747
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   748
    self allKeysDo:[:aKey |
42
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
   749
        aBlock value:aKey value:(self at:aKey)
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   750
    ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   751
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   752
a27a279701f8 Initial revision
claus
parents:
diff changeset
   753
!Smalltalk class methodsFor:'queries'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   754
a27a279701f8 Initial revision
claus
parents:
diff changeset
   755
numberOfGlobals
a27a279701f8 Initial revision
claus
parents:
diff changeset
   756
    "return the number of global variables in the system"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   757
a27a279701f8 Initial revision
claus
parents:
diff changeset
   758
    |tally|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   759
a27a279701f8 Initial revision
claus
parents:
diff changeset
   760
    tally := 0.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   761
    self do:[:obj | tally := tally + 1].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   762
    ^ tally
a27a279701f8 Initial revision
claus
parents:
diff changeset
   763
a27a279701f8 Initial revision
claus
parents:
diff changeset
   764
    "Smalltalk numberOfGlobals"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   765
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   766
a27a279701f8 Initial revision
claus
parents:
diff changeset
   767
cellAt:aName
a27a279701f8 Initial revision
claus
parents:
diff changeset
   768
    "return the address of a global cell
a27a279701f8 Initial revision
claus
parents:
diff changeset
   769
     - used internally for compiler only"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   770
a27a279701f8 Initial revision
claus
parents:
diff changeset
   771
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   772
    extern OBJ _GETGLOBALCELL();
a27a279701f8 Initial revision
claus
parents:
diff changeset
   773
a27a279701f8 Initial revision
claus
parents:
diff changeset
   774
    RETURN ( _GETGLOBALCELL(aName) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
   775
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   776
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   777
a27a279701f8 Initial revision
claus
parents:
diff changeset
   778
references:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   779
    "return true, if I refer to the argument, anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   780
     must be reimplemented since Smalltalk is no real collection"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   781
a27a279701f8 Initial revision
claus
parents:
diff changeset
   782
    self do:[:o |
a27a279701f8 Initial revision
claus
parents:
diff changeset
   783
        (o == anObject) ifTrue:[^ true]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   784
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   785
    ^ false
a27a279701f8 Initial revision
claus
parents:
diff changeset
   786
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   787
a27a279701f8 Initial revision
claus
parents:
diff changeset
   788
allClasses
a27a279701f8 Initial revision
claus
parents:
diff changeset
   789
    "return a collection of all classes in the system"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   790
a27a279701f8 Initial revision
claus
parents:
diff changeset
   791
    CachedClasses isNil ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   792
        CachedClasses := IdentitySet new:400.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   793
        self do:[:anObject |
a27a279701f8 Initial revision
claus
parents:
diff changeset
   794
            anObject notNil ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   795
                (anObject isBehavior) ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   796
                    CachedClasses add:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   797
                ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   798
            ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   799
        ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   800
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   801
    ^ CachedClasses
a27a279701f8 Initial revision
claus
parents:
diff changeset
   802
a27a279701f8 Initial revision
claus
parents:
diff changeset
   803
    "Smalltalk allClasses"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   804
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   805
a27a279701f8 Initial revision
claus
parents:
diff changeset
   806
classNames
a27a279701f8 Initial revision
claus
parents:
diff changeset
   807
    "return a collection of all classNames in the system"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   808
a27a279701f8 Initial revision
claus
parents:
diff changeset
   809
    ^ self allClasses collect:[:aClass | aClass name]
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   810
!
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   811
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   812
systemPath
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   813
    "return a collection of directorynames, where smalltalk
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   814
     looks for system files (usually in subdirs such as resources,
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   815
     bitmaps, source etc.)"
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   816
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   817
    ^ SystemPath
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   818
!
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   819
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   820
startupClass:aClass selector:aSymbol arguments:anArrayOrNil
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   821
    "set the class, selector and arguments to be performed when smalltalk
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   822
     starts. Setting those before saving a snapshot, will make the saved
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   823
     image come up executing your application (instead of the normal mainloop)"
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   824
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   825
    StartupClass := aClass.
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   826
    StartupSelector := aSymbol.
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   827
    StartupArguments := anArrayOrNil
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   828
!
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   829
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   830
startupClass
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   831
    "return the class, that will get the start message when smalltalk
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   832
     starts and its non-nil. Usually this is nil, but saving an image 
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   833
     with a non-nil StartupClass allows stand-alone applications"
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   834
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   835
    ^ StartupClass
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   836
!
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   837
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   838
startupSelector
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   839
    "return the selector, that will be sent to StartupClass"
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   840
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   841
    ^ StartupSelector
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   842
!
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   843
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   844
startupArguments
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   845
    "return the arguments passed to StartupClass"
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   846
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   847
    ^ StartupArguments
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   848
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   849
a27a279701f8 Initial revision
claus
parents:
diff changeset
   850
!Smalltalk class methodsFor:'system management'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   851
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   852
renameClass:aClass to:newName
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   853
    "rename aClass to newName"
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   854
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   855
    |oldName oldSym newSym names cSym value|
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   856
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   857
    oldName := aClass name.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   858
    oldSym := oldName asSymbol.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   859
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   860
    ((self at:oldSym) == aClass) ifFalse:[^ self].
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   861
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   862
    "rename the class"
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   863
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   864
    aClass setName:newName.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   865
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   866
    "and its meta"
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   867
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   868
    aClass class setName:(newName , 'class').
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   869
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   870
    "store it in Smalltalk"
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   871
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   872
    newSym := newName asSymbol.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   873
    self at:oldSym put:nil.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   874
    self removeKey:oldSym.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   875
    self at:newSym put:aClass.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   876
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   877
    "rename class variables"
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   878
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   879
    names := aClass classVariableString asCollectionOfWords.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   880
    names do:[:name |
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   881
        cSym := (oldSym , ':' , name) asSymbol.
10
claus
parents: 8
diff changeset
   882
        value := self at:cSym.
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   883
        self at:cSym put:nil.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   884
        self removeKey:cSym.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   885
        cSym := (newSym , ':' , name) asSymbol.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   886
        self at:cSym put:value.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   887
    ].
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   888
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   889
    aClass addChangeRecordForClassRename:oldName to:newName
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   890
!
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   891
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   892
removeClass:aClass
a27a279701f8 Initial revision
claus
parents:
diff changeset
   893
    "remove the argument, aClass from the smalltalk dictionary;
2
claus
parents: 1
diff changeset
   894
     we have to flush the caches since these methods are now void.
claus
parents: 1
diff changeset
   895
     Also, class variables of aClass are removed."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   896
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   897
    |sym cSym names oldName|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   898
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   899
    oldName := aClass name.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   900
    sym := oldName asSymbol.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   901
    ((self at:sym) == aClass) ifFalse:[ ^ self].
2
claus
parents: 1
diff changeset
   902
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   903
    self at:sym put:nil. "nil it out for compiled accesses"
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   904
    self removeKey:sym. 
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   905
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   906
    "remove class variables"
2
claus
parents: 1
diff changeset
   907
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   908
    names := aClass classVariableString asCollectionOfWords.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   909
    names do:[:name |
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   910
        cSym := (sym , ':' , name) asSymbol.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   911
        self at:cSym asSymbol put:nil.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   912
        self removeKey:cSym
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   913
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   914
"
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   915
    actually could get along with less flushing
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   916
    (entries for aClass and subclasses only)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   917
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   918
    aClass allSubclassesDo:[:aSubclass |
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   919
        ObjectMemory flushInlineCachesForClass:aSubclass.
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   920
        ObjectMemory flushMethodCacheFor:aSubclass
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
   921
    ].
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   922
    ObjectMemory flushInlineCachesForClass:aClass.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   923
    ObjectMemory flushMethodCacheFor:aClass
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   924
"
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   925
    ObjectMemory flushInlineCaches.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   926
    ObjectMemory flushMethodCache.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
   927
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   928
    aClass addChangeRecordForClassRemove:oldName
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   929
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   930
a27a279701f8 Initial revision
claus
parents:
diff changeset
   931
browseChanges
a27a279701f8 Initial revision
claus
parents:
diff changeset
   932
    "startup a changes browser"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   933
a27a279701f8 Initial revision
claus
parents:
diff changeset
   934
    (self at:#ChangesBrowser) notNil ifTrue:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   935
        ChangesBrowser start
a27a279701f8 Initial revision
claus
parents:
diff changeset
   936
    ] ifFalse:[
a27a279701f8 Initial revision
claus
parents:
diff changeset
   937
        self error:'no ChangesBrowser'
a27a279701f8 Initial revision
claus
parents:
diff changeset
   938
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   939
a27a279701f8 Initial revision
claus
parents:
diff changeset
   940
    "Smalltalk browseChanges "
a27a279701f8 Initial revision
claus
parents:
diff changeset
   941
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   942
a27a279701f8 Initial revision
claus
parents:
diff changeset
   943
browseAllSelect:aBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   944
    "startup a browser for all methods for which aBlock returns true"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   945
a27a279701f8 Initial revision
claus
parents:
diff changeset
   946
    SystemBrowser browseAllSelect:aBlock
a27a279701f8 Initial revision
claus
parents:
diff changeset
   947
a27a279701f8 Initial revision
claus
parents:
diff changeset
   948
    " Smalltalk browseAllSelect:[:m | m literals isNil] "
a27a279701f8 Initial revision
claus
parents:
diff changeset
   949
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   950
a27a279701f8 Initial revision
claus
parents:
diff changeset
   951
browseImplementorsOf:aSelectorSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
   952
    "startup a browser for all methods implementing a particular message"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   953
a27a279701f8 Initial revision
claus
parents:
diff changeset
   954
    SystemBrowser browseImplementorsOf:aSelectorSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
   955
a27a279701f8 Initial revision
claus
parents:
diff changeset
   956
    " Smalltalk browseImplementorsOf:#at:put: "
a27a279701f8 Initial revision
claus
parents:
diff changeset
   957
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   958
a27a279701f8 Initial revision
claus
parents:
diff changeset
   959
browseAllCallsOn:aSelectorSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
   960
    "startup a browser for all methods sending a particular message"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   961
a27a279701f8 Initial revision
claus
parents:
diff changeset
   962
    SystemBrowser browseAllCallsOn:aSelectorSymbol
a27a279701f8 Initial revision
claus
parents:
diff changeset
   963
a27a279701f8 Initial revision
claus
parents:
diff changeset
   964
    " Smalltalk browseAllCallsOn:#at:put: "
a27a279701f8 Initial revision
claus
parents:
diff changeset
   965
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   966
10
claus
parents: 8
diff changeset
   967
readAbbreviations
claus
parents: 8
diff changeset
   968
    "read classname to filename mappings from abbrev.stc.
claus
parents: 8
diff changeset
   969
     sigh - all for those poor sys5.3 people ..."
claus
parents: 8
diff changeset
   970
claus
parents: 8
diff changeset
   971
    |aStream line index thisName abbrev|
claus
parents: 8
diff changeset
   972
claus
parents: 8
diff changeset
   973
    CachedAbbreviations := Dictionary new.
claus
parents: 8
diff changeset
   974
    aStream := self systemFileStreamFor:'abbrev.stc'.
claus
parents: 8
diff changeset
   975
    aStream notNil ifTrue:[
claus
parents: 8
diff changeset
   976
        [aStream atEnd] whileFalse:[
claus
parents: 8
diff changeset
   977
            line := aStream nextLine.
claus
parents: 8
diff changeset
   978
            line notNil ifTrue:[
claus
parents: 8
diff changeset
   979
                (line countWords == 2) ifTrue:[
claus
parents: 8
diff changeset
   980
                    index := line indexOfSeparatorStartingAt:1.
claus
parents: 8
diff changeset
   981
                    (index ~~ 0) ifTrue:[
62
e1b4369c61fb *** empty log message ***
claus
parents: 50
diff changeset
   982
                        thisName := line copyTo:(index - 1).
10
claus
parents: 8
diff changeset
   983
                        abbrev := (line copyFrom:index) withoutSeparators.
claus
parents: 8
diff changeset
   984
                        CachedAbbreviations at:thisName put:abbrev.
claus
parents: 8
diff changeset
   985
                    ]
claus
parents: 8
diff changeset
   986
                ]
claus
parents: 8
diff changeset
   987
            ]
claus
parents: 8
diff changeset
   988
        ].
claus
parents: 8
diff changeset
   989
        aStream close
claus
parents: 8
diff changeset
   990
    ]
claus
parents: 8
diff changeset
   991
!
claus
parents: 8
diff changeset
   992
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   993
systemFileStreamFor:aFileName
a27a279701f8 Initial revision
claus
parents:
diff changeset
   994
    "search aFileName in some standard places;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   995
     return a fileStream or nil if not found"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   996
a27a279701f8 Initial revision
claus
parents:
diff changeset
   997
    |aStream|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   998
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
   999
    (aFileName startsWith:'/') ifTrue:[
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1000
        "dont use path for absolute file names"
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1001
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1002
        ^ FileStream readonlyFileNamed:aFileName
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1003
    ].
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1004
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1005
    SystemPath do:[:dirName |
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1006
        aStream := FileStream readonlyFileNamed:(dirName , '/' , aFileName).
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1007
        aStream notNil ifTrue:[^ aStream]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1008
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1009
    ^ nil
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1010
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1011
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1012
fileNameForClass:aClassName
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1013
    "return a good filename for aClassName -
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1014
     using abbreviation file if there is one"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1015
10
claus
parents: 8
diff changeset
  1016
    |fileName abbrev|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1017
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1018
    fileName := aClassName.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1019
10
claus
parents: 8
diff changeset
  1020
    "first look, if the class exists and has a fileName"
claus
parents: 8
diff changeset
  1021
24
20cfbafcd0a3 *** empty log message ***
claus
parents: 13
diff changeset
  1022
" later ... - compiler should put the source file name into the class
10
claus
parents: 8
diff changeset
  1023
    Symbol hasInterned:aClassName ifTrue:[:sym |
claus
parents: 8
diff changeset
  1024
        |class|
claus
parents: 8
diff changeset
  1025
claus
parents: 8
diff changeset
  1026
        (Smalltalk includesKey:sym) ifTrue:[
claus
parents: 8
diff changeset
  1027
            class := Smalltalk at:sym.
claus
parents: 8
diff changeset
  1028
            class isClass ifTrue:[
claus
parents: 8
diff changeset
  1029
                abbrev := class classFileName.
claus
parents: 8
diff changeset
  1030
            ]
claus
parents: 8
diff changeset
  1031
        ]
claus
parents: 8
diff changeset
  1032
    ].
claus
parents: 8
diff changeset
  1033
"
claus
parents: 8
diff changeset
  1034
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1035
    "look for abbreviation"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1036
10
claus
parents: 8
diff changeset
  1037
    CachedAbbreviations isNil ifTrue:[
claus
parents: 8
diff changeset
  1038
        self readAbbreviations
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1039
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1040
10
claus
parents: 8
diff changeset
  1041
    abbrev := CachedAbbreviations at:fileName ifAbsent:[nil].
claus
parents: 8
diff changeset
  1042
    abbrev notNil ifTrue:[^ abbrev].
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1043
10
claus
parents: 8
diff changeset
  1044
    "no abbreviation found - if its a short name, take it"
claus
parents: 8
diff changeset
  1045
claus
parents: 8
diff changeset
  1046
    OperatingSystem maxFileNameLength < (fileName size + 3) ifTrue:[
claus
parents: 8
diff changeset
  1047
        "this will only be triggered on sys5.3 type systems"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1048
        self error:'cant find short for ' , fileName , ' in abbreviation file'
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1049
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1050
    ^ fileName
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1051
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1052
2
claus
parents: 1
diff changeset
  1053
classNameForFile:aFileName
10
claus
parents: 8
diff changeset
  1054
    "return the className which corresponds to an abbreviated fileName,
claus
parents: 8
diff changeset
  1055
     or nil if no special translation applies. The given filename arg should
claus
parents: 8
diff changeset
  1056
     NOT include any suffix such as '.st'."
2
claus
parents: 1
diff changeset
  1057
10
claus
parents: 8
diff changeset
  1058
    CachedAbbreviations isNil ifTrue:[
claus
parents: 8
diff changeset
  1059
        self readAbbreviations
2
claus
parents: 1
diff changeset
  1060
    ].
claus
parents: 1
diff changeset
  1061
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1062
    ^ CachedAbbreviations keyAtValue:aFileName ifAbsent:[aFileName].
2
claus
parents: 1
diff changeset
  1063
claus
parents: 1
diff changeset
  1064
    "Smalltalk classNameForFile:'DrawObj'"
claus
parents: 1
diff changeset
  1065
!
claus
parents: 1
diff changeset
  1066
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1067
fileInClassObject:aClassName from:aFileName
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1068
    "read in the named object file - look for it in some standard places;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1069
     return true if ok, false if failed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1070
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1071
    |aStream|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1072
42
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1073
    ObjectFileLoader isNil ifTrue:[^ false].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1074
    aStream := self systemFileStreamFor:aFileName.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1075
    aStream isNil ifTrue:[^ false].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1076
    aStream close.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1077
10
claus
parents: 8
diff changeset
  1078
    ^ (ObjectFileLoader loadClass:aClassName fromObjectFile:aFileName) notNil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1079
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1080
    " Smalltalk fileInClassObject:'AbstractPath' from:'../goodies/Paths/AbstrPath.o' "
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1081
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1082
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1083
fileIn:aFileName
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1084
    "read in the named file - look for it in some standard places;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1085
     return true if ok, false if failed"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1086
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1087
    |aStream|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1088
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1089
    aStream := self systemFileStreamFor:aFileName.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1090
    aStream isNil ifTrue:[^ false].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1091
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1092
    [aStream fileIn] valueNowOrOnUnwindDo:[aStream close].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1093
    ^ true
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1094
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1095
    "Smalltalk fileIn:'games/TicTacToe.st'"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1096
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1097
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1098
fileInChanges
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1099
    "read in the last changes file - bringing the system to the state it
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1100
     had when left the last time"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1101
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1102
    |upd|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1103
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1104
    "tell Class to NOT update the changes file now ..."
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1105
    upd := Class updateChanges:false.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1106
    [self fileIn:'changes'] valueNowOrOnUnwindDo:[Class updateChanges:upd]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1107
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1108
    "Smalltalk fileInChanges "
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1109
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1110
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1111
fileInClass:aClassName
10
claus
parents: 8
diff changeset
  1112
    "find a source/object file for aClassName and -if found - load it.
claus
parents: 8
diff changeset
  1113
     search is in some standard places"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1114
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1115
    |fName newClass upd ok|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1116
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1117
    upd := Class updateChanges:false.
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1118
    [
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1119
        ok := self fileIn:('fileIn/' , aClassName , '.ld').
42
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1120
        ObjectFileLoader notNil ifTrue:[
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1121
            ok ifFalse:[
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1122
                ok := self fileInClassObject:aClassName from:('binary/' , aClassName, '.so').
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1123
            ].
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1124
            ok ifFalse:[
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1125
                ok := self fileInClassObject:aClassName from:('binary/' , aClassName, '.o').
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1126
            ].
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1127
        ].
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1128
        ok ifFalse:[
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1129
            ok := self fileIn:(aClassName , '.st')
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1130
        ].
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1131
        ok ifFalse:[
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1132
            ok := self fileIn:('source/' , aClassName , '.st')
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1133
        ].
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1134
        ok ifFalse:[
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1135
            fName := self fileNameForClass:aClassName.
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1136
            fName notNil ifTrue:[
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1137
                ok := self fileIn:('fileIn/' , fName , '.ld').
42
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1138
                ObjectFileLoader notNil ifTrue:[
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1139
                    ok ifFalse:[
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1140
                        ok := self fileInClassObject:aClassName from:('binary/' , fName, '.so')
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1141
                    ].
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1142
                    ok ifFalse:[
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1143
                        ok := self fileInClassObject:aClassName from:('binary/' , fName, '.o')
e33491f6f260 *** empty log message ***
claus
parents: 27
diff changeset
  1144
                    ].
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1145
                ].
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1146
                ok ifFalse:[
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1147
                    ok := self fileIn:(fName , '.st')
8
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1148
                ].
639f407faddd last version before big change in dispatch
claus
parents: 7
diff changeset
  1149
                ok ifFalse:[
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1150
                    ok := self fileIn:('source/' , fName , '.st')
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1151
                ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1152
            ]
7
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1153
        ]
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1154
    ] valueNowOrOnUnwindDo:[Class updateChanges:upd].
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1155
    newClass := self at:(aClassName asSymbol).
bf6f603119df final release before Dispatcher
claus
parents: 5
diff changeset
  1156
    (newClass notNil and:[newClass implements:#initialize]) ifTrue:[newClass initialize]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1157
! !
2
claus
parents: 1
diff changeset
  1158
claus
parents: 1
diff changeset
  1159
!Smalltalk class methodsFor: 'binary storage'!
claus
parents: 1
diff changeset
  1160
claus
parents: 1
diff changeset
  1161
addGlobalsTo: globalDictionary manager: manager
claus
parents: 1
diff changeset
  1162
    | pools |
claus
parents: 1
diff changeset
  1163
    pools _ Set new.
claus
parents: 1
diff changeset
  1164
    self associationsDo: [:assoc|
claus
parents: 1
diff changeset
  1165
        assoc value == self ifFalse:[
claus
parents: 1
diff changeset
  1166
            assoc value isClass ifTrue: [
claus
parents: 1
diff changeset
  1167
                assoc value addGlobalsTo: globalDictionary manager: manager.
claus
parents: 1
diff changeset
  1168
                "pools addAll: assoc value sharedPools"
claus
parents: 1
diff changeset
  1169
            ] ifFalse: [
claus
parents: 1
diff changeset
  1170
                globalDictionary at: assoc put: self
claus
parents: 1
diff changeset
  1171
            ].
claus
parents: 1
diff changeset
  1172
            assoc value isNil ifFalse:[
claus
parents: 1
diff changeset
  1173
                globalDictionary at: assoc value put: self
claus
parents: 1
diff changeset
  1174
            ]
claus
parents: 1
diff changeset
  1175
        ]
claus
parents: 1
diff changeset
  1176
    ].
claus
parents: 1
diff changeset
  1177
claus
parents: 1
diff changeset
  1178
    pools do: [:poolDictionary|
claus
parents: 1
diff changeset
  1179
        poolDictionary addGlobalsTo: globalDictionary manager: manager
claus
parents: 1
diff changeset
  1180
    ]
claus
parents: 1
diff changeset
  1181
!
claus
parents: 1
diff changeset
  1182
claus
parents: 1
diff changeset
  1183
storeBinaryDefinitionOf: anObject on: stream manager: manager
claus
parents: 1
diff changeset
  1184
    | string |
claus
parents: 1
diff changeset
  1185
claus
parents: 1
diff changeset
  1186
    anObject class == Association ifTrue: [
claus
parents: 1
diff changeset
  1187
        string := 'Smalltalk associationAt: ', anObject key storeString
claus
parents: 1
diff changeset
  1188
    ] ifFalse: [
claus
parents: 1
diff changeset
  1189
        string := 'Smalltalk at: ', (self keyAtValue: anObject) storeString
claus
parents: 1
diff changeset
  1190
    ].
claus
parents: 1
diff changeset
  1191
    stream nextNumber: 2 put: string size.
claus
parents: 1
diff changeset
  1192
    string do: [:char| stream nextPut: char asciiValue]
claus
parents: 1
diff changeset
  1193
! !