--- a/patches Tue Aug 09 00:36:54 1994 +0200
+++ b/patches Mon Oct 10 04:36:13 1994 +0100
@@ -1,215 +1,404 @@
"
- set some kludge flags
+ This file is processed at initial startup
+ - not when resuming an image.
"
-"
-ProcessorScheduler pureEventDriven.
+"this allows turning off processes and running
+ pure event driven - for debugging only.
+
+ If the system has been created without thread
+ support (i.e. a quick port without asm-support)
+ it will do this automatically. So, normally you
+ should not uncomment the line below.
+"
+"
+ ProcessorScheduler pureEventDriven.
"
!
-
"
install uncompiled classes as autoload
classes ... (if not already present)
+ Autoloaded classes will be automatically filed-in
+ when first accessed. This allows a smaller executable,
+ but creates a short delay, when the class is loaded on
+ first access.
+
+ You can add more classes to these lists -
+ i.e. all your classes you like to have around,
+ but which are not needed often enough to justify
+ machine code for them ...
"
-|optional optionalGames optionalDemos optionalApps optionalBench compat|
+|optionalClasses optionalGames optionalDemos optionalApps optionalBench
+ optionalTools optionalViews compat|
Transcript showCr:'installing autoloaded classes ...'.
optionalGames := #(
- Tetris TetrisBlock TicTacToe
- ).
+ Tetris TetrisBlock TicTacToe
+ ).
+
+optionalDemos := #(
+ Animation GlobeDemo RoundGlobe
+ GLTeapotDemo GLTeapotView
+ GLPlaneDemoView1 GLPlaneDemoView2
+ GLSphereDemoView1 GLSphereDemoView2
+ GLObjectDemoView GLCubeDemoView GLTetraDemoView
+ GLWireCubeDemoView GLWireSphereDemoView
+ GLCubeDemoView2 Logo3DView1 GLPlanetDemoView
+ ).
+
+optionalApps := #(
+ AddressBook AddressBook2 InitialLabelView AddressView
+
+ DrawTool DrawObject DrawLine DrawText
+ DrawRectangle DrawRoundRectangle DrawEllipse
+ DrawPolygon DrawCurve DrawGroup DrawView DrawImage
+ PatternMenu
+
+ LogicTool LogicView LogicObject Connection Input Output
+ Low High Inverter AndGate OrGate AndGate2 NandGate2 OrGate2 NorGate2 ExorGate2
+ AndGate3
+
+ MailView MailHandler MailLetter MailReplyTextView
+
+ NewsView NewsHandler NNTPHandler NumberSet
+
+ ArchiveView DirectoryView DirectoryViewObject
+ DirectoryObject FileObject
+
+ DocumentView DocumentReader
+ DisplayText DisplayPicture DisplayIcon DisplaySound
+
+ Clock ClockView RoundClock RoundClock2
+
+ VocPanel VocBrowser VocView SoundStream
+
+ Keyword KeywordSet ManualBrowser ManualMaker ManualView
+ ).
+
+optionalTools := #(
+ Builder BuilderView BuilderTreeView
+ BuilderClassBox BuilderVariablesBox
+
+ SystemBrowser DebugView FileBrowser DirectoryBrowser
+ ProjectView Launcher Workspace ChangesBrowser
+ InspectorView OrderedCollectionInspectorView ContextInspectorView
+ DictionaryInspectorView
+ ImageInspectorView ColorInspectorView
+ ).
+
+optionalViews := #(
+ Scale HorizontalScale GLXView Point3D SliderBox
+ DialogBox OptionBox TextBox
+ InputView Ruler TextRuler
+ Slider HorizontalSlider
+ SteppingSlider HorizontalSteppingSlider
+ ProcessView
+ VariableHorizontalPanel
+ FontPanel FramedBox FileSelectionBox FileSaveBox
+ RadioButton RadioButtonGroup MotionButton MenuButton PullDownMenu
+
+ TwoColumnTextView DiffTextView
+ FilenameEditField FilenameEnterBox
+
+ HelpView
+
+ ScreenSaver LightInTheDark LightInTheDark2
+
+ ImageView ImageEditView
+ Depth1Image Depth2Image Depth4Image Depth8Image Depth24Image
+ TreeView TreeGraphView ClassTreeView ClassTreeGraphView WindowTreeView
+ EventMonitor ProcessMonitor MemoryMonitor MemoryUsageView
+
+ ColorPanel HLSPanel RGBPanel ColorWheel ThreeSliderPanel
+ ColorSlider HueSlider RGBSlider SteppingColorSlider SteppingHueSlider
+
+ TabulatorSpecification MultiColListEntry
+ ).
+
+"notice, that it does not really make sense to
+ run Benchmarks in interpreted mode ..."
+
+optionalBench := #(
+ SlopstoneBenchmark SmopstoneBenchmark
+
+ "DeltaBlue benchmark"
+ AbstractConstraint BinaryConstraint Constraint
+ DBMethod DBVariable EditConstraint
+ EqualityConstraint Plan Planner ScaleConstraint
+ StayConstraint Strength UnaryConstraint XMouseConstraint
+ YMouseConstraint
+
+ "RichardsBenchmarks"
+ DeviceTaskDataRecord HandlerTaskDataRecord
+ IdleTaskDataRecord Packet RBObject RichardsBenchmarks
+ TaskControlBlock TaskState WorkerTaskDataRecord
+
+ "self benchmarks"
+ AbstractBenchmark AtAllPutBenchmark BenchmarkRunner
+ BubbleSort2Array BubbleSort2Benchmark BubbleSortBenchmark
+ Cons FastSumToBenchmark HanoiBenchmark HanoiDisk
+ IncrementAllBenchmark IntMM2Array IntMM2Benchmark
+ IntMM2Matrix IntMMBenchmark MM2Benchmark MMBenchmark
+ NestedLoopBenchmark Perm2Benchmark PermArray PermBenchmark
+ PuzzleArray PuzzleBenchmark Queens2Benchmark QueensBenchmark
+ Quicksort2Array Quicksort2Benchmark QuicksortBenchmark
+ RecurseBenchmark SieveBenchmark SumAllBenchmark
+ SumFromToBenchmark SumToBenchmark TakBenchmark TaklBenchmark
+ Towers2Benchmark Towers2Disk TowersBenchmark
+ TowersBenchmarkElement TreeSort2Benchmark TreeSort2Node
+ TreeSortBenchmark TreeSortNodeBenchmark
+ ).
+
+optionalClasses := #(
+ GIFReader TIFFReader FaceReader WindowsIconReader SunRasterReader
+ XBMReader JPEGReader PBMReader ST80FormReader XPMReader
+ PCXReader
+
+ EpsonFX1PrinterStream HPLjetIIPrinterStream
+ PostscriptPrinterStream
+ Decompiler Polygon
+ ChangeSetBrowser
+ MessageTracer
+
+ PersistencyManager BinaryIOManager BinaryInputManager
+ BinaryOutputManager DBFile BinaryObjectStorage
+
+ RDoItServer
+
+ HandlerCollection
+ ).
+
+optionalViews do:[:s |
+ "install if not already compiled-in"
+ (Smalltalk at:s) isNil ifTrue:[
+ Autoload subclass:s
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'autoloaded-Views'
+ ]
+].
+
+optionalTools do:[:s |
+ "install if not already compiled-in"
+ (Smalltalk at:s) isNil ifTrue:[
+ Autoload subclass:s
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'autoloaded-Tools'
+ ]
+].
optionalGames do:[:s |
"install if not already compiled-in"
(Smalltalk at:s) isNil ifTrue:[
- Autoload subclass:s
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'autoloaded-Games & Demos'
+ Autoload subclass:s
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'autoloaded-Games & Demos'
]
].
-optionalDemos := #(
- Animation GlobeDemo RoundGlobe
- GLTeapotDemo GLTeapotView SliderBox
- GLPlaneDemoView1 GLPlaneDemoView2
- GLSphereDemoView1 GLSphereDemoView2
- GLObjectDemoView GLCubeDemoView GLTetraDemoView
- Logo3DView1
- ).
-
optionalDemos do:[:s |
"install if not already compiled-in"
(Smalltalk at:s) isNil ifTrue:[
- Autoload subclass:s
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'autoloaded-Games & Demos'
+ Autoload subclass:s
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'autoloaded-Games & Demos'
]
].
-optionalApps := #(
- AddressBook
- DrawTool DrawObject DrawLine DrawText
- DrawRectangle DrawRoundRectangle DrawEllipse
- DrawPolygon DrawCurve DrawGroup DrawView DrawImage
- PatternMenu
-
- LogicTool
- MailView MailHandler MailLetter
- NewsView NewsHandler NNTPHandler NumberSet
- ArchiveView DirectoryView DirectoryViewObject
- DirectoryObject FileObject
- DocumentView DocumentReader
- DisplayText DisplayPicture DisplayIcon DisplaySound
- Builder BuilderView BuilderTreeView
- BuilderClassBox BuilderVariablesBox
- Clock ClockView RoundClock
-
- VocPanel VocBrowser VocView SoundStream
- ).
-
optionalApps do:[:s |
"install if not already compiled-in"
(Smalltalk at:s) isNil ifTrue:[
- Autoload subclass:s
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'autoloaded-Applications'
+ Autoload subclass:s
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'autoloaded-Applications'
]
].
-optionalBench := #(
- SlopstoneBenchmark SmopstoneBenchmark
-
- "DeltaBlue benchmark"
- AbstractConstraint BinaryConstraint Constraint
- DBMethod DBVariable EditConstraint
- EqualityConstraint Plan Planner ScaleConstraint
- StayConstraint Strength UnaryConstraint XMouseConstraint
- YMouseConstraint
-
- "RichardsBenchmarks"
- DeviceTaskDataRecord HandlerTaskDataRecord
- IdleTaskDataRecord Packet RBObject RichardsBenchmarks
- TaskControlBlock TaskState WorkerTaskDataRecord
-
- "self benchmarks"
- AbstractBenchmark AtAllPutBenchmark BenchmarkRunner
- BubbleSort2Array BubbleSort2Benchmark BubbleSortBenchmark
- Cons FastSumToBenchmark HanoiBenchmark HanoiDisk
- IncrementAllBenchmark IntMM2Array IntMM2Benchmark
- IntMM2Matrix IntMMBenchmark MM2Benchmark MMBenchmark
- NestedLoopBenchmark Perm2Benchmark PermArray PermBenchmark
- PuzzleArray PuzzleBenchmark Queens2Benchmark QueensBenchmark
- Quicksort2Array Quicksort2Benchmark QuicksortBenchmark
- RecurseBenchmark SieveBenchmark SumAllBenchmark
- SumFromToBenchmark SumToBenchmark TakBenchmark TaklBenchmark
- Towers2Benchmark Towers2Disk TowersBenchmark
- TowersBenchmarkElement TreeSort2Benchmark TreeSort2Node
- TreeSortBenchmark TreeSortNodeBenchmark
- ).
-
optionalBench do:[:s |
"install if not already compiled-in"
(Smalltalk at:s) isNil ifTrue:[
- Autoload subclass:s
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'autoloaded-Benchmarks'
+ Autoload subclass:s
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'autoloaded-Benchmarks'
+ ]
+].
+
+optionalClasses do:[:s |
+ "install if not already compiled-in"
+ (Smalltalk at:s) isNil ifTrue:[
+ Autoload subclass:s
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'autoloaded-Classes'
+ ]
+].
+
+"
+ a kludge: we have added new ImageReaders above - tell Image
+"
+"avoid introducing a new global ..."
+(Smalltalk includesKey:#Image) ifTrue:[
+ (Smalltalk at:#Image) isBehavior ifTrue:[
+ (Smalltalk at:#Image) initializeFileFormatTable.
]
].
-optional := #(
- HelpView
- Scale HorizontalScale GLXView Point3D SliderBox
- DialogBox OptionBox TextBox
- InputView
- ProcessView
- DirectoryBrowser FileBrowser
- VariableHorizontalPanel
- FontPanel FramedBox FileSelectionBox
- RadioButton RadioButtonGroup MotionButton MenuButton PullDownMenu
- GIFReader TIFFReader FaceReader WindowsIconReader SunReader
- XBMReader JPEGReader PBMReader ST80FormReader
- EpsonFX1PrinterStream HPLjetIIPrinterStream
- PostscriptPrinterStream
- Decompiler Polygon
- ScreenSaver LightInTheDark LightInTheDark2
- ChangeSetBrowser
- ImageView ImageEditView ImageInspectorView
- Depth1Image Depth2Image Depth4Image Depth8Image Depth24Image
- TreeView TreeGraphView ClassTreeView ClassTreeGraphView WindowTreeView
- EventMonitor ProcessMonitor MemoryMonitor MemoryUsageView
- ColorPanel HLSPanel RGBPanel ColorWheel ThreeSliderPanel
- ColorSlider HueSlider RGBSlider
+"
+ some ST80 name aliases
+ (actually, much more is needed - this is just a start ...)
+"
+(Smalltalk at:#StandardSystemView) notNil ifTrue:[Smalltalk at:#ScheduledWindow put:StandardSystemView].
+(Smalltalk at:#Color) notNil ifTrue:[Smalltalk at:#ColorValue put:Color].
+(Smalltalk at:#Socket) notNil ifTrue:[Smalltalk at:#UnixSocketAccessor put:Socket].
+Smalltalk at:#BlockClosure put:Block.
- PersistencyManager BinaryIOManager BinaryInputManager
- BinaryOutputManager DBFile BinaryObjectStorage
- ).
+FileDirectory notNil ifTrue:[Smalltalk at:#Disk put:(FileDirectory directoryNamed:'/')].
-optional do:[:s |
- "install if not already compiled-in"
- (Smalltalk at:s) isNil ifTrue:[
- Autoload subclass:s
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'autoloaded-Classes'
- ]
-].
-
-Transcript showCr:'installing ST-80 compatibility (autoloaded) classes ...'.
-
-"a kludge: we have added new ImageReaders above - tell Image"
-Image initializeFileFormatTable.
-
-"some ST80 name aliases"
-Smalltalk at:#ScheduledWindow put:StandardSystemView.
-Smalltalk at:#ColorValue put:Color.
-Smalltalk at:#BlockClosure put:Block.
-Smalltalk at:#Disk put:( FileDirectory directoryNamed:'/').
+"
+ ST/X has (currently) no Double, but Float is what ST-80's Double is ...
+"
+Smalltalk at:#Double put:Float.
compat := #(BitBlt Pen Commander
- OpaqueForm
- AbstractPath Arc Circle Curve LinearFit
- Arrow Line Path Spline Ellipse DrawingPen
- Filename ActionMenu FillInTheBlank
- KeyedSet
- DialogView FormView
- NoController MouseMenuController
- StandardSystemController
- WeakDictionary WeakIdentityDictionary
- ValueHolder ComposedTextView
- UnixSocketAccessor StringHolder
- ).
+ OpaqueForm
+ AbstractPath Arc Circle Curve LinearFit
+ Arrow Line Path Spline Ellipse DrawingPen
+ ActionMenu FillInTheBlank
+ KeyedSet
+ DialogView FormView
+ NoController MouseMenuController
+ StandardSystemController
+ ValueHolder ComposedTextView
+ StringHolder
+ ).
compat do:[:s |
"install if not already compiled-in"
(Smalltalk at:s) isNil ifTrue:[
- Autoload subclass:s
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'autoloaded-ST80-Classes'
+ Autoload subclass:s
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'autoloaded-ST80-Classes'
]
]
!
-
Transcript showCr:'installing patches ...' !
-
!OperatingSystem class methodsFor:'queries'!
-"IO signals do not work currently ..."
-
supportsIOInterrupts
"return true, if the OS supports IO availability interrupts
(i.e. SIGPOLL/SIGIO)."
+"IO signals do not work currently
+(I dont know why - streams work, but sockets fail to produce
+ an IO signal ..... help help help"
+
^ false
+!
+!
+!LazyMethod methodsFor:'error handling'!
+XXnoByteCode
+ "this is triggered by the interpreter when a lazy method is about to
+ be executed (by sending the to-be executed method this message).
+ Hard-compile the method, install its bytecode in the receiver,
+ and recall it."
+
+ |code m sender spec class selector|
+
+ "compile the method"
+
+ [
+ Access wait.
+ [
+ m := self asByteCodeMethod.
+ ] valueNowOrOnUnwindDo:[
+ Access signal.
+ ].
+ ] valueUninterruptably.
+
+ (m isNil or:[(byteCode := m byteCode) isNil]) ifTrue:[
+"/ Access signal.
+
+ class := self containingClass.
+ selector := thisContext sender selector.
+
+ class notNil ifTrue:[
+ spec := class name , '>>' , selector
+ ] ifFalse:[
+ spec := 'unknown>>' , selector
+ ].
+ "
+ this error is triggered, if the compilation of a lazy method
+ failed - this happens for example, if a lazy methods code has been
+ changed in a fileBrowser without checking the code for syntactical
+ correctnes, or if the instvars of an autoloaded classes superclass
+ have been changed without changing the subclasses code ...
+ You should enter the SystemBrowser on this method, and try accepting
+ to see what the problem is.
+ The methods class is found in the local 'class',
+ the selector is found in the local 'selector'.
+ "
+ ^ CompilationFailedSignal raiseRequestWith:self
+ errorString:('compilation of lazy method ' , spec , ' failed')
+ ].
+ "
+ thisContext sender is the context of the original send
+ (the failed one)
+ "
+ sender := thisContext sender.
+ literals := m literals.
+ flags := m flags.
+ ObjectMemory flushCaches.
+"/ Access signal.
+
+ ^ self valueWithReceiver:(sender receiver)
+ arguments:(sender args)
+ selector:(sender selector)
+
! !
+!Text methodsFor:'converting'!
+from:aString
+ "setup my contents from the argument, aString"
+
+ |numberOfLines "{ Class:SmallInteger }"
+ start "{ Class:SmallInteger }"
+ stop "{ Class:SmallInteger }" |
+
+ numberOfLines := aString occurrencesOf:(Character cr).
+ (aString endsWith:(Character cr)) ifFalse:[
+ numberOfLines := numberOfLines + 1.
+ ].
+ self grow:numberOfLines.
+ start := 1.
+ 1 to:numberOfLines do:[:lineNr |
+ stop := aString indexOf:(Character cr) startingAt:start.
+ stop == 0 ifTrue:[
+ stop := aString size
+ ] ifFalse: [
+ stop := stop - 1.
+ ].
+
+ (stop < start) ifTrue: [
+ self at:lineNr put:(String new:0)
+ ] ifFalse: [
+ self at:lineNr put:(aString copyFrom:start to:stop)
+ ].
+ start := stop + 2
+ ]
+
+! !