smalltalk.rc
author Claus Gittinger <cg@exept.de>
Sat, 08 Jan 2000 16:34:48 +0100
changeset 412 5414bfdd71bc
parent 409 3a136424d8e6
child 413 a74f3ec42fde
permissions -rw-r--r--
*** empty log message ***

"/
"/ $Header$
"/
"/ MIMEType: application/x-smalltalk-source
"/
"/ ST/X startup configuration & command file:
"/
"/ startup configuration for smalltalk
"/
"/ - everything in here are plain smalltalk expressions;
"/ - statements with in a group are separated by a period.
"/ - Each group of statements has to be delimited by an exclamation
"/   character.
"/ - avoid exclas in comments (or double them)
"/ - nested comments are not allowed - take care.
"/
"/ remember: this is fileOut-format
"/
"/ comments can be either:
"/ - standard smalltalk comments (i.e. from dquote to dquote)
"/ - ST/X end of line comments (i.e. dquote followed by /)
"/
"/    "this is a comment"
"/    "/ another comment
"/
"/***************************************************************
"/ PLEASE: only add things here, if they are of general interrest
"/         and NEITHER site specific NOT display specific.
"/
"/ site specific things are to be added to "h_<hostname>.rc"
"/ display specifics to "d_<displayName>.rc"
"/ and private user stuff in "private.rc"
"/***************************************************************

"/
"/ allow definition of the systemPath from an environment variable
"/ for example, to only try files in a users home and /usr/local/lib/smalltalk,
"/ add the following in your shell-profile:
"/      export STX_SYSTEMPATH=$HOME:/usr/local/lib/smalltalk
"/ notice, that shell variable names are NOT expanded again in STX_SYSTEMPATH
"/ Make certain that all relevant files are found along your path - you may see
"/ funny viewStyles, colors and stupid strings if wrong.
"/

|path systemPath|

(path := OperatingSystem getEnvironment:'STX_SYSTEMPATH') notNil ifTrue:[
    Smalltalk systemPath:(path asCollectionOfSubstringsSeparatedBy:$:)
] ifFalse:[
    "/ look for gnu-smalltalk class files along my PATH.
    "/ if found, remove that directory from the PATH to avoid
    "/ autoloading wrong classes.
    (path := Smalltalk getSystemFileName:'initialize.st') notNil ifTrue:[
	path := path asFilename directoryName.
	('smalltalk.rc [info]: found gnu-smalltalk sources in ' , path , '; removed from systemPath.') infoPrintCR.
	Smalltalk systemPath:(Smalltalk systemPath remove:path; yourself).
    ]
].
(path := OperatingSystem getEnvironment:'STX_PACKAGEPATH') notNil ifTrue:[
    Smalltalk packagePath:(path asCollectionOfSubstringsSeparatedBy:$:).
"/    'setting packagePath from STX_PACKAGEPATH' printCR.
"/    'packagePath: ' print. Smalltalk packagePath printCR.
] ifFalse:[
    "/
    "/ if running in the development environment,
    "/ only use the local packages.
    "/
    '../../../stx/doc' asFilename exists ifTrue:[
	Smalltalk packagePath removeAll; add:'../../..'.    
"/        'setting packagePath for local operation' printCR.
"/        'packagePath: ' print. Smalltalk packagePath printCR.
    ].
    "/
    "/ any additional local packages ?.
    "/
    'packages' asFilename exists ifTrue:[
	 Smalltalk packagePath addFirst:'./packages'.    
"/        'additional local packages' printCR.
"/        'packagePath: ' print. Smalltalk packagePath printCR.
    ].
].

'../../doc' asFilename exists ifTrue:[
    Smalltalk systemPath addFirst:'../..'.
].

"/ but, the current directory should always be first ...
(Smalltalk systemPath includes:'.') ifTrue:[
    Smalltalk systemPath remove:'.'.
].
Smalltalk systemPath addFirst:'.'.
Smalltalk flushPathCaches.
!

|args|

args := Smalltalk commandLineArguments.
((args size > 0) and:[args last = '--buildClasses']) ifTrue:[
    'binary' asFilename isDirectory ifFalse:[
	'smalltalk.rc [warning]: no binary directory for classes.' errorPrintCR.
    ] ifTrue:[
	"/
	"/ load all lazy classes
	"/
	Autoload subclasses do:[:aClass |
	    Autoload autoloadFailedSignal handle:[:ex |
		'smalltalk.rc [warning]: autoload failed' errorPrintCR.
		ex return.
	    ] do:[
		'smalltalk.rc [info]: loading ' infoPrint. aClass name infoPrint. ' ...' infoPrintCR.
		aClass autoload.
	    ]
	].

	"/
	"/ binary save all classes
	"/
	Autoload loadedClasses do:[:cls |
	    'smalltalk.rc [info]: saving binary of ' infoPrint. cls name infoPrint. ' ...' infoPrintCR.
	    cls binaryFileOut.
	    OperatingSystem executeCommand:'mv *.cls binary'.
	]
    ].
    Smalltalk exit
].

"/
"/ map Language variable setting to known and handled
"/ values:
"/
Language == #De ifTrue:[
    Language := #german
].

"/
"/ check for display-classes being compiled into the system;
"/ (and if display connection can be established)
"/ if not, enter a simple read-eval-print loop
"/
Smalltalk isHeadless ifFalse:[
  Display isNil ifTrue:[
    (args includes:'--noDisplay') ifFalse:[
	DeviceWorkstation notNil ifTrue:[
	    'smalltalk.rc [warning]: No Display connection.' errorPrintCR.
	    'smalltalk.rc [info]: Either set the DISPLAY environment variable,' infoPrintCR.
	    'smalltalk.rc [info]: or start smalltalk with a -display argument.' infoPrintCR.
	    Smalltalk isStandAloneApp ifTrue:[
		Smalltalk exit
	    ].

	    '' errorPrintCR.
	    'Textmode (enter smalltalk expressions terminated by single exclamation mark;' errorPrintCR.
	    OperatingSystem isUNIXlike ifTrue:[
		'          CTRL-D to leave line-by-line interpreter.)' errorPrintCR.
	    ] ifFalse:[
		'          CTRL-Z to leave line-by-line interpreter.)' errorPrintCR.
	    ].
	    Smalltalk readEvalPrint.
	    Smalltalk exit
	] ifFalse:[
	    Smalltalk isStandAloneApp ifFalse:[
		'smalltalk.rc [warning]: Configuration without display.' errorPrintCR.
	    ]
	].
    ].
  ].
].

"/
"/ this makes X-errors be handled immediately (so you see,
"/ where it occured) but slows down the system soooo muuuucccchhh ..
"/ if commented out, errors will be reported asynchronously.
"/ (I enable this, when things go bad during startup)
"/
"/ Display unBuffered.

"/
"/ this starts the incremental GC earlier
"/ (default is 500000)
"/ the number given is the number of bytes which have to be allocated
"/ since the last GC, to start the incremental GC running.
"/ (see ObjectMemory>>documentation)
"/ Claus: I moved this to the private.rc file
"/
"/ ObjectMemory incrementalGCLimit:100000. 

"/
"/ this starts the incremental GC when freeSpace drops below a limit
"/ (default is nil - i.e. dont look at freeSpace)
"/ (see ObjectMemory>>documentation)
"/ Claus: I moved this to the private.rc file
"/
"/ ObjectMemory freeSpaceGCLimit:300000. 

"/ experimental: try to always keep some bytes in the pocket
"/ this changes the memory policy, to start the background collector whenever
"/ freespace drops below 250k or 500k have been allocated since the last GC. 
"/ AND to allocate more memory, if (after the collect) less than 1Mb is free.
"/ Doing so makes the system behave better if lots of memory is required
"/ for short periods of time, since it prepares itself for that situation
"/ during idle time. (I often walk around in the fileBrowser, loading big
"/ files like XWorkstation.st or SystemBrowser.st ....)

ObjectMemory freeSpaceGCAmount:1000000. 
ObjectMemory freeSpaceGCLimit:250000. 
ObjectMemory incrementalGCLimit:500000. 
ObjectMemory oldSpaceIncrement:500000.
ObjectMemory startBackgroundCollectorAt:5. 
ObjectMemory startBackgroundFinalizationAt:5. 

"/ experimental:
"/ run the background collector at a dynamic priority - it will
"/ now always get a chance to make some progress ...

Smalltalk addStartBlock:[
    'smalltalk.rc [info]: start timeSlicing...' infoPrintCR.
    Processor startTimeSlicing.
    Processor supportDynamicPriorities:true.
    ObjectMemory backgroundCollectProcess priorityRange:(4 to:9).
    ObjectMemory backgroundFinalizationProcess priorityRange:(4 to:9).
].

"/ experimental: configure the memory manager to quickly increase
"/ its oldSpace, as long as it stays below 8Mb (i.e. do not enter
"/ a blocking mark&sweep or compress, but go straight ahead increasing
"/ the oldSpace). Above that, behave as usual, i.e. try a GC first,
"/ then increase the oldSpace size if that did not help.
"/ If you have a machine with lots of (real) memory, you may want to
"/ increase the number. The value below should be ok for 16-32Mb machines.
"/
ObjectMemory fastMoreOldSpaceLimit:8*1024*1024.
ObjectMemory fastMoreOldSpaceAllocation:true.
!

"/ another experimental (and a secret for now, since I dont want
"/ you to play with those ;-)
"/ For now, this is experimental. Once the best numbers
"/ have been found, I'll hardwire them and document it ...

|a|
ObjectMemory newSpaceSize > (500*1024) ifTrue:[
    a := #(nil nil nil nil -16 -4 -2 -2 0 0 16 nil) copy.
] ifFalse:[
"/         min max cpy /32 /16 /8 /4 /2 /4 /8 /16 /32 "
    "/
    "/ slow tenure - keeps objects longer in newSpace,
    "/  producing more scavenge overhead, but releasing IGC somewhat
    "/
"/  a := #(nil nil nil -100 -8 -4 -1  1 2  4  8   16 nil) copy.
"/  a := #(nil nil nil nil -16 -4  0  0  0 4 16 nil) copy.

    "fast tenure"
    "/
    "/ fast tenure - moves objects earlier into oldSpace,
    "/ releasing newSpace collector; however, the oldSpace IGC
    "/ may have more work to do.
    "/
    a := #(nil nil nil nil -20 -8 -3 -1 -1 1 16 nil) copy.
].
ObjectMemory tenureParameters:a.

"/
"/ lazy loading
"/ (faster fileIn) - this is EXPERIMENTAL.
"/
"/ - if turned on, an autoload operation will only create methodStubs
"/   (uncompiled) which trap when called the first time.
"/   The bytecode compiler will compile them when first executen.
"/
"/ - if turned off, an autoload will load & compile the while class,
"/   which makes autoloading slower, but avoids the initial delays
"/
"/ This is much like just-in-time compilation, but on a higher level.
"/ If there are any problems with lazy methods, disable the following
"/ and let me (cg@exept.ssw.de) know what happened.
"/
Autoload compileLazy:true.

"/
"/ define the language (you can also set the LANG-shell variable)
"/ (currently #english, #german and #french are supported).
"/ some fragments for other languages (japanese ;-) exist.
"/ Setting it here will override the LANG variable setting,
"/ if neither set here nor in LANG, #english is the default.
"/ see (and enhance) the resource files
"/ Claus: supposed to be done in private.rc or via LANG variable
"/
"/ Smalltalk language:#german.
"/ Smalltalk language:#english. 

"/
"/ this defines stuff relating to the host we are running on
"/
"/ 'smalltalk.rc [info]: reading ''host.rc'' ...' infoPrintCR.
Smalltalk fileIn:'host.rc'.

"/
"/ this handles all variant display stuff
"/ (i.e. things which might change, when DISPLAY is set different)
"/ Notice, that the display may be different from the host we run on;
"/ Host specific things are configured in host.rc.
"/
"/ 'smalltalk.rc [info]: reading ''display.rc'' ...' infoPrintCR.
Display notNil ifTrue:[
    Smalltalk fileIn:'display.rc'.
].

"/
"/ Ask user to accept Licence.
"/ exit, if rejected.
"/
"/ You may find this annoying - but lawers say: "this is a must ..." ;-)
"/ (it will not be shown when coming up via a snapshot image)
"/ Also, the licenceBox can be suppressed with a command-line argument;
"/ however, if you do so, we assume you have read & accepted it at least
"/ once (since this command-line-argument is not documented, you obviously
"/ read the code below).

"/
"/ WARNING: read the licence text before you:
"/      - disable the code below,
"/      - or start stx with a suppress argument.
"/

Smalltalk isStandAloneApp ifFalse:[
  Smalltalk isHeadless ifFalse:[
    Display notNil ifTrue:[
	(Smalltalk commandLineArguments includes:'--noLicenceBox') ifFalse:[
	    Smalltalk addStartBlock:[
		'smalltalk.rc [info]: show licence conditions ...' infoPrintCR.

		LicenceBox autoload.

		LicenceBox licenceRejectSignal handle:[:ex|
		    Smalltalk exit
		] do:[
		    (LicenceBox open) ifFalse:[Smalltalk exit].
		    Smalltalk at:#LicenceBox put:nil.
		].
	    ]
	]
    ]
  ]
].
!

"/
"/ read the abbrev.stc file, extract class names
"/ and install all nonExisting classes as autoloaded
"/
|needToReactivate|

HistoryManager notNil ifTrue:[
    needToReactivate := HistoryManager isActive.
    HistoryManager deactivate.
] ifFalse:[
    needToReactivate := false
].

Class withoutUpdatingChangesDo:[   
   'smalltalk.rc [info]: installing autoloaded classes ...' infoPrintCR.
   Smalltalk installAutoloadedClasses.
].
needToReactivate ifTrue:[HistoryManager activate].
"/
"/ some ST80 name aliases
"/ (actually, much more is needed - this is just a start ...)
"/
(cls := Smalltalk at:#StandardSystemView) notNil ifTrue:[
    Smalltalk at:#ScheduledWindow put:cls
].
(cls := Smalltalk at:#Socket) notNil ifTrue:[
    Smalltalk at:#UnixSocketAccessor put:cls.
    Smalltalk at:#SocketAccessor put:cls.
    Smalltalk at:#SocketAccessorByAddress put:cls.
].
Smalltalk at:#BlockClosure put:Block.
Smalltalk at:#CompiledMethod put:Method.
(cls := Smalltalk at:#DialogBox) notNil ifTrue:[
    Smalltalk at:#Dialog     put:cls.
    Smalltalk at:#DialogView put:cls.
    Smalltalk at:#FillInTheBlank put:cls.
].
Smalltalk at:#ByteString put:String.
Smalltalk at:#ByteSymbol put:Symbol.
Smalltalk at:#ByteEncodedString put:String.
Smalltalk at:#Console put:Stderr.
Smalltalk at:#HandlerList put:HandlerCollection.
Smalltalk at:#SignalCollection put:SignalSet.
Smalltalk at:#Timestamp put:AbsoluteTime.

"/ FileDirectory notNil ifTrue:[
"/     Smalltalk at:#Disk put:(Filename rootDirectory)
"/ ].

Display notNil ifTrue:[
    Smalltalk at:#Window put:(Display class).
    Smalltalk at:#Screen put:(Display class).
    Smalltalk at:#Sensor put:Display.
] ifFalse:[
    DeviceWorkstation notNil ifTrue:[
	Smalltalk at:#Window put:DeviceWorkstation.
	Smalltalk at:#Screen put:DeviceWorkstation.
    ]
].

"/
"/ ST/X has (currently) no Double, but Float is what ST-80's Double is ...
"/
Smalltalk at:#Double put:Float.

Smalltalk at:#Browser put:SystemBrowser.
!

"/
"/ read private (per user) stuff
"/
'smalltalk.rc [info]: reading ''private.rc'' ...' infoPrintCR.
Smalltalk fileIn:'private.rc'.

"/
"/ read saved configuration settings (if any)
"/
"/ 'smalltalk.rc [info]: reading ''settings.stx'' ...' infoPrintCR.
Object abortSignal handle:[:ex |
    ex return
] do:[
    (Smalltalk fileIn:'settings.stx') ifTrue:[
	'smalltalk.rc [info]: loaded preferences from ''settings.stx''' infoPrintCR.
    ]
]
!

"/
"/ just a quick check, if this ST/X installation seems to
"/ be halfway complete (it happened to some people, that
"/ their source/resource directories were not installed)
"/ - better to warn early ... 
"/
|anyWrong missing|
Smalltalk isStandAloneApp ifFalse:[
    anyWrong := false.
    missing := ''.

"/
"/ no longer needed - if we have the package,
"/ we also have the resources ...
"/
"/    (Smalltalk getResourceFileName:'SystemBrowser.rs' forClass:SystemBrowser) isNil ifTrue:[
"/        '***********************************************************************' errorPrintCR.
"/        '***** ATTENTION: please check installation of your >>resource<< files' errorPrintCR.
"/        '***** I will not be able to give non-english messages' errorPrintCR.
"/        anyWrong := true.
"/        missing := '''resources'' '.
"/    ].

"/
"/ no longer needed - if we have the package,
"/ we also have the styles ...
"/
"/    (Smalltalk getResourceFileName:'normal.style' forClass:View) isNil ifTrue:[
"/        '***********************************************************************' errorPrintCR.
"/        '***** ATTENTION: please check installation of your >>style<< files' errorPrintCR.
"/        '***** I will use a plain b&w viewStyle as a fallBack' errorPrintCR.
"/        anyWrong := true.
"/        missing := missing , '''resources'' '.
"/    ].

    (Smalltalk getSystemFileName:'source/Object.st') isNil ifTrue:[
      (Smalltalk getSystemFileName:'source/source.zip') isNil ifTrue:[
	(Smalltalk getSystemFileName:'source/libbasic.zip') isNil ifTrue:[
	  (Smalltalk getSourceFileName:'libbasic/Object.st') isNil ifTrue:[
	    "/
	    "/ there may still be a SourceCodeManager ...
	    "/
	    (Smalltalk at:#SourceCodeManager) isNil ifTrue:[
		'***********************************************************************' errorPrintCR.
		'***** ATTENTION: please check installation of your >>source<< files' errorPrintCR.
		'***** ' errorPrintCR.
		'***** the browser/debugger may not be able to show sourcecode.' errorPrintCR.
		'***** Also, autoloading may fail if sourceFiles are missing.' errorPrintCR.
		anyWrong := true.
		missing := missing , '''source'' '.
	    ]
	  ]
	]
      ]
    ].

"/
"/ no longer needed - if we have the package,
"/ we also have the bitmaps ...
"/
"/    (Smalltalk bitmapFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool') isNil ifTrue:[
"/        '***********************************************************************' errorPrintCR.
"/        '***** ATTENTION: please check installation of your >>bitmap<< files' errorPrintCR.
"/        anyWrong := true.
"/        missing := missing , '''bitmaps'' '.
"/    ].

    anyWrong ifTrue:[
	'*****' errorPrintCR.
	'***** directory(s) named: ' errorPrint. missing errorPrint. 'incomplete/not existing' errorPrintCR.
	'***** I could not find the missing directory along your path,' errorPrintCR.
	'***** which is:' errorPrintCR.
	Smalltalk systemPath do:[:dir |
	    ('*****        ' , dir storeString) errorPrintCR.
	].

	'*****' errorPrintCR.
	'***** Try: "make source bitmaps resources styles"' errorPrintCR.
	'*****  or: "make symlinks" to fix this.' errorPrintCR.
	'***********************************************************************' errorPrintCR.
    ]
]
!

"/
"/ set the package to some useful default
"/
Project notNil ifTrue:[
    Project setDefaultProject.
    Project current package:#'private'.
].

"/
"/ if error occurs, and debugger has problems coming up,
"/ uncomment the following ...
"/
"/ Debugger := MiniDebugger.

"/
"/ save an initial image; this will speedup the next startup
"/ (since all autoload-stuff will already be initialized)
"/

"/ 'st.img' asFilename exists ifFalse:[
"/     |doneWithStartupStuff|
"/ 
"/     doneWithStartupStuff := Semaphore new.
"/ 
"/     Smalltalk addStartBlock:[
"/      [
"/          doneWithStartupStuff wait.
"/             'smalltalk.rc [info]: saving initial image for faster future startup ...' infoPrintCR.
"/             ObjectMemory primSnapShotOn:'st.img'
"/      ] forkAt:1
"/     ].
"/ 
"/     Smalltalk addStartBlock:[
"/      [
"/          Delay waitForSeconds:10.
"/          doneWithStartupStuff signal
"/      ] forkAt:1
"/     ].
"/ ].
!