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