"St80Changes.V00 (16 December 1980 4:31:57 pm )"
"80" BlockContext$'As yet unclassified'
[value | |<primitive: 26>
self valueError].
"85" BlockContext$'As yet unclassified'
[value: arg | |<primitive: 27>
self valueError].
"98" BlockContext$'As yet unclassified'
[value: arg1 value: arg2 | |<primitive: 27>
self valueError].
"110" BlockContext$'As yet unclassified'
[value: arg1 value: arg2 value: arg3 | |<primitive: 27>
self valueError].
"234" Class$'Initialization'
[bytesize: n | | "non-pointer declaration"
self self realself
ifTrue: [self realself bytesize: n]
ifFalse:
[instsize ← ntrue
ifTrue: [4096]
ifFalse: [n = 8 ifTrue: [4096] ifFalse: [12288]]]].
"99" Class$'Initialization'
[classInit | | "gets propagated to a dummy instance"
↑self new classInit].
"302" Class$'Message access'
[compileall | sel | "does not modify code, just compiles it"
messagedict do: [:sel | self recompile: sel]
"to recompile the whole system (check out big changes) execute:
user classNames do:
[:name |
user show: name; cr.
(Smalltalkname) compileall.
Changes init]. "].
"967" Class$'Initialization'
[fields: t1 | r a b s h |
"list of instance variables" "just adding new inst fields"
myinstvars ← t1.
messagedict ← MethodDictionary init: 4.
r ← self realself.
a ← self instvars.
h ← HashSet init.
a do:
[:s | (h has: s)
ifTrue: [user notify: s + ' is used already (maybe in superclass)']
ifFalse: [h insert: s]].
self = r
ifTrue: [self initClass]
ifFalse:
[a = (b ← r instvars)
ifTrue:
[r environment← nil.
r myinstvars← myinstvars.
r subclassof: superclass]
ifFalse:
[r someInstance
ifTrue: [user notify: 'All ' + title + 's become obsolete if you proceed...'].
classvars ← r classvars.
messagedict ← r md copy.
(a length b length or: [a (1 to: b length) b])
ifTrue:
[user notify: title + ' methods recompile if you proceed...'.
self compileall].
r md init.
self fixSubClassesOf: r.
r obsolete.
Smalltalk title unique ← self.
self initClass]]].
"228" Class$'Initialization'
[initClass | |
fieldtype ← 16.
instsize ← self instvars length.
instsize > 256
ifTrue: [user notify: 'too many instance variables']
ifFalse:
[instsize ← instsize + 8192.
self organization]].
"117" Class$'Access to parts'
[instsize | | "Return the number of user accessable instance fields"
↑instsize land: 4095].
"103" Class$'Instance access'
[new | |<primitive: 29>
self isVariable ifTrue: [↑self new: 0].
user croak].
"448" LADCompiler$'Public'
[compile: parag in: cls under: category notifying: t4 | methodNode selector |
requestor ← t4.
self from: parag class: cls instance: false context: false notifying: requestor.
(methodNode ← user displayoffwhile [(self translate: sourceStream noPattern: false)])
ifTrue:
[selector ← methodNode selector.
cls organization classify: selector under: category.
methodNode install: parag in: cls.
↑selector].
↑false].
"402" LADDecompiler$'Decompiler'
[while: truth | if then |
"if whileTrue: [then]"
then ← self block.
self require: #:come.
truth false
ifTrue: [self require: #:come].
if ← self block.
self require: #:begin.
↑LADMessageNode new receiver: if selector: (LADSelectorNode new key: (truth
ifTrue: [#whileTrueDo:]
ifFalse: [#whileFalseDo:]) code: #macro) arguments: then inVector precedence: 3].
"585" LADMessageNode$'Initialization'
[classInit | |
"LADMessageNode classInit."
macroSelectors ← #(ifTrue: ifFalse: ifTrue:ifFalse: and: or: whileFalseDo: whileTrueDo: ).
macroTransformers ← #(transformIfTrue: transformIfFalse: transformIfTrueIfFalse: transformAnd: transformOr: transformWhile: transformWhile: ).
macroEmitters ← #(emitIf:on:value: emitIf:on:value: emitIf:on:value: emitIf:on:value: emitIf:on:value: emitWhile:on:value: emitWhile:on:value: ).
macroSizers ← #(sizeIf:value: sizeIf:value: sizeIf:value: sizeIf:value: sizeIf:value: sizeWhile:value: sizeWhile:value: )].
"630" LADMessageNode$'Code Generation'
[emitWhile: stack on: strm value: forValue | cond stmt stmtSize loopSize |
"L1: ... Bfp(L2)|(Bfp(1)Jmp(L2)) ... Jmp(L1) L2: "
cond ← receiver.
stmt ← arguments 1.
stmtSize ← sizes 1.
loopSize ← sizes 2.
cond emitForEvaluatedValue: stack on: strm.
selector key #whileFalseDo:
ifTrue:
[self emitBranch: sizes 3 pop: stack on: strm.
self emitJump: stmtSize on: strm]
ifFalse: [self emitBranch: stmtSize pop: stack on: strm].
stmt emitForEvaluatedEffect: stack on: strm.
self emitJump: 0 - loopSize on: strm.
forValue
ifTrue:
[strm next← LdNil.
stack push: 1]].
"679" LADMessageNode$'Code Generation'
[sizeWhile: encoder value: forValue | cond stmt bfpSize |
"L1: ... Bfp(L2) ... Jmp(L1) L2: nil (nil for value only)" "justStmt, wholeLoop, justJump"
cond ← receiver.
stmt ← arguments 1.
sizes ← Vector new: 3.
sizes 1 ← (stmt sizeForEvaluatedEffect: encoder) + 2.
selector key #whileFalseDo:
ifTrue:
[sizes 3 ← self sizeJump: sizes 1.
bfpSize ← self sizeBranch: sizes 3]
ifFalse:
[sizes 3 ← self sizeBranch: sizes 1.
bfpSize ← 0].
sizes 2 ← (cond sizeForEvaluatedValue: encoder) + bfpSize + (sizes 3) + (sizes 1).
↑sizes 2 + (forValue
ifTrue: [1]
ifFalse: [0]) "+1 (push nil) for value only"].
"143" SymbolTable$'Insertion'
[insert: name with: x | |
(self has: name)
ifFalse: [super insert: name with: Association new].
self name ← x].
"72" Object$'As yet unclassified'
[do: aBlock || ↑self asStream do: aBlock].
"284" Class$'Instance access'
[copy: inst | copy i var |
var← self isVariable.
copy ← var ifTrue: [self new: inst length] ifFalse: [self new].
(1 to: self instsize) do: [:i | copy instfield: i ← inst instfield: i].
var ifTrue: [(1 to: inst length) do: [:i | copyi ← insti]].
↑copy].
"155" Class$'Instance access'
[new: length | | <primitive: 30>
self isVariable
ifTrue: [user croak]
ifFalse: [↑self new init: length] "ST76 convention"].
"1086" Class$'Initialization'
[newFieldsForSubClass: t1 | r a b |
"list of instance variables" "changing inst fields"
myinstvars ← t1.
messagedict ← MethodDictionary init: 4.
r ← self realself.
self = r
ifTrue: [user notify: 'problem in class redefinition. See coment at end of method']
ifFalse:
[(a ← self instvars) = (b ← r instvars)
ifTrue: [user notify: 'problem in class redefinition. See coment at end of method']
ifFalse:
[r someInstance
ifTrue: [user cr show: 'All ' + title + 's are obsolete.'].
classvars ← r classvars.
messagedict ← r md copy.
r md init.
(a length b length or: [a (1 to: b length) b])
ifTrue:
[user cr show: title + ' recompiled.'.
self compileall].
self fixSubClassesOf: r.
r obsolete.
Smalltalk title unique ← self.
self initClass]]
"Regarding the notifys in this method: It is my understanding
that this method will only be invoked when the conditions
leading to the notifys are false. If I'm available, I'd like to see
any case that results in notification.
Dave Robson"].
"278" Class$'Initialization'
[obsolete | |
title ← 'AnObsolete' + title.
classvars ← nil. "recycle class variables"
messagedict ← MethodDictionary init: 2. "invalidate and recycle local messages"
self someInstance ifTrue: [environment ← self] "keep me around for old instances"].
"525" Class$'Instance access'
[print: inst on: strm | ivars i |
ivars ← self instvars.
strm append: '(('+title+' new'.
self isVariable ifTrue:
[strm append: ': '; print: inst length].
strm append: ') '.
(1 to: instsize) do:
[:i | strm append: ivars i.
strm append: ': '.
strm print: (inst instfield: i).
strm space].
self isVariable ifTrue:
[(1 to: inst length) do:
[:i |
strm append: ' at: '; print: i.
strm append: ' put: '; print: insti; append: ';'].
strm append: 'itself'].
strm append: ')'].
"818" Class$'Filin and Filout'
[printdefon: strm | s |
"print my definition on strm"
strm append: self class title+' new title: #'+title.
strm cr; tab.
strm append: 'subclassof: ' + (superclass nil
ifTrue: ['nil']
ifFalse: [superclass title]).
strm cr; tab.
strm append: 'fields: ' + myinstvars asString.
strm cr; tab.
strm append: 'declare: '''.
classvars contents do:
[:s | s = #ClassOrganization
ifFalse:
[strm append: s.
strm space]].
strm append: ''''.
(instsize anymask: 4096)
ifTrue:
[strm semicrtab.
strm append: 'bytesize: '.
strm print: ((instsize anymask: 8192)
ifTrue: [(instsize anymask: 16384) ifFalse: [16]]
ifFalse: [8])].
environment nil
ifFalse: [environment do:
[:s | strm semicrtab.
strm append: 'sharing: ' + (Smalltalk invert: s)]]].
"108" Class$'As yet unclassified'
[recompile: selector | |
self understands: (self code: selector) asParagraph].
"303" Class$'Instance access'
[recopy: inst | copy i var |
var← self isVariable
copy ← var ifTrue: [self new: inst length] ifFalse: [self new].
(1 to: self instsize) do: [:i | copy instfield: i ← (inst instfield: i) recopy].
var ifTrue: [(1 to: inst length) do: [:i | copyi ← (insti) recopy]].
↑copy].
"162" Class$'Initialization'
[subclassof: cl | |
(cl is: Class)
ifTrue: [superclass ← cl]
ifFalse: [user notify: 'Superclass is not yet defined or not a Class']].
"92" Class$'Initialization'
[title: t | |
self title: (title ← t unique) insystem: Smalltalk].
"248" Class$'Message access'
[whosends: selector | senders lit sel |
senders ← Stream default.
messagedict do:
[:sel |
(messagedict method: sel) literals do:
[:lit |
selector lit ifTrue: [senders append: sel; space]]].
↑senders contents].
"62" LADCompiler$'Errors'
[interactive || ↑requestor interactive].
"166" LADDictionary$'As yet unclassified'
[at: key ifAbsent expr | val |
val ← super at: (self find: key).
(val nil or: [val key key]) ifTrue: [↑expr eval].
↑val].
"417" LADDictionary$'As yet unclassified'
[delete: key | loc old len entry |
loc ← self find: key.
((entry ← self at: loc) nil ifFalse: [entry key key])
ifTrue: [self error: 'Object not found'].
self at: loc put: nil.
len ← self length.
[loc ← loc = len ifTrue: [1] ifFalse: [loc + 1].
(self at: loc) nil]
whileTrueDo:
[loc = (old ← self find: (self at: loc) key) ifFalse: [self swap: loc with: old]]].
"208" LADLiteralNode$'Printing'
[printon: strm indent: level | |
"wouldn't handle UniqueString literals right"
((key is: UniqueString) or: [(key is: Vector)])
ifTrue: [strm append: '#'].
key printon: strm].
"60" LADParser$'Errors'
[interactive || ↑requestor interactive].
"71" LADSet$'As yet unclassified'
[asStream | |
↑self contents asStream].
"133" LADSet$'As yet unclassified'
[swap: one with: other | save |
save ← self one.
self one ← self other.
self other ← save].
"108" MethodDictionary$'As yet unclassified'
[delete: key | |
self become: (self copy deleteDangerously: key)].
"89" MethodDictionary$'As yet unclassified'
[deleteDangerously: key | |
super delete: key].
"72" Object$'As yet unclassified'
[do: aBlock || ↑self asStream do: aBlock].
"349" Object$'Compiler Defaults'
[notify: errorString at: position in: stream for: class | syntaxWindow |
NotifyFlag
ifTrue:
[syntaxWindow ← SyntaxWindow new of: errorString at: position in: stream for: class from: thisContext sender.
"thisContext sender← nil."
user restartup: syntaxWindow]
ifFalse:
[user notify: errorString.
↑false]].
"193" Array$'Copying and Altering'
[collect: aBlock | i len result |
result← self species new: (len← self length).
i←0.
[(i←i+1) len]
whileTrueDo: [resulti← aBlock value: selfi].
↑result].
"144" Class$'Instance access'
[allInstances | strm x |
strm← (Vector new: 16) asStream.
self allInstancesDo: [:x | strm next← x].
↑strm contents].
"238" Class$'Instance access'
[allInstancesDo: aBlock | inst |
inst← self someInstance.
inst ifTrue:
[aBlock value: inst.
[inst← inst nextInstance]
whileTrueDo: [aBlock value: inst].
false classself ifTrue: [aBlock value: false]]].
"146" Class$'Instance access'
[howMany | x n | "how many instances of this class are in use now?"
n ← 0.
self allInstancesDo: [:x | n ← n + 1].
↑n].
"1856" ParagraphPrinter$'Class stuff'
[printchanges: lis | selector class heading old mes s delFlg |
"prints Changes format: ('class message' 'class message' ...)
or alternate format: (class (message ...) class () ...) or both
If an element appears in the list of the form '~class message', this puts out a
line causing the system to forget that method. These come after any additons,
owing to the sort on Changes"
lis empty
ifTrue: [↑lis].
lis ← lis asStream.
old ← mes ← false.
[class] whileTrueDo:
[ "get next class, selector pair"
delFlg ← false.
(mes and: [(selector ← mes next)])
ifFalse:
[ "more of alternate form"
(s ← lis next)
ifTrue:
[(s is: UniqueString)
ifTrue:
[class ← Smalltalk lookup: s.
mes ← lis next asStream.
selector ← mes next]
ifFalse:
[ "Changes format"
s ← s asStream.
s peek = 126 "~"
ifTrue:
[s next "take it off stream".
delFlg ← true].
class ← Smalltalk (s upto: 32) unique.
selector ← s upto: 32]]
ifFalse: [class ← false]].
delFlg
ifTrue: [old ifTrue:
[old endCategoryOn: self.
old endChangesOn: self.
old← false].
self printForget: selector class: class]
ifFalse:
[ "same, different or no class"
old class
ifFalse:
[old
ifTrue:
[old endCategoryOn: self.
old endChangesOn: self].
class false
ifFalse:
[ "finished"
user cr.
user show: class title.
old ← class.
class startChangesOn: self.
heading ← 'As yet unclassified']].
class false
ifFalse:
[user space.
user show: selector.
s ← class organization invert: (selector ← selector unique).
s
ifTrue:
[s heading
ifTrue: [class startCategory: (heading ← s) on: self].
class printMethod: selector on: self]]]]].
"356" SystemPane$'Browser protocol'
[forget: className | t2 |
"user notify: 'Class ' + className + ' will disappear if you proceed...'."
(t2 ← Smalltalk className) noChanges.
t2 obsolete.
Smalltalk delete: className.
SystemOrganization delete: className.
AllClassNames ← AllClassNames delete: className.
classPane revise: self classes with: className].
"1466" TextImage$'Public Messages'
[kbd | more char |
"key struck on the keyboard"
(c1 < c2 and: [self checklooks])
ifTrue: [↑self show complement].
more ← Set new string: 16.
begintypein
ifFalse:
[Deletion ← self selection.
begintypein ← c1].
[char ← user kbdnext] whileTrueDo:
[char = bs
ifTrue:
[more empty "backspace"
ifTrue: [begintypein ← begintypein min: (c1 ← 1 max: c1 - 1)]
ifFalse: [more skip: 1]]
ifFalse:
[char = cut
ifTrue:
[self fintype.
c1 = c2
ifTrue: [c2 ← c1 + 1 min: para length + 1].
self replace: nullString.
self complement.
Scrap ← Deletion.
↑self].
char = paste
ifTrue: [↑self paste].
char = ctlw
ifTrue:
[ "ctl-w for backspace word"
more empty
ifFalse:
[self replace: more.
more reset.
c1 ← c2].
c1 ← 1 max: c1 - 1.
[c1 > 1 and: [(para (c1 - 1)) tokenish]] whileTrueDo: [c1 ← c1 - 1].
begintypein ← begintypein min: c1]
ifFalse:
[char = esc
ifTrue:
[ "select previous type-in"
more empty
ifTrue: [self unselect]
ifFalse:
[self replace: more.
c1 ← c2].
self fintype.
c1 ← c2 - Scrap length.
↑self complement].
"just a normal character"
(char between: 11 and: 12)
ifTrue: [more append: (char=11 ifTrue: ['ifTrue: '] ifFalse: ['ifFalse: '])]
ifFalse: [more next← char]]]].
self replace: more.
c1 ← c2.
self selectAndScroll].
"272" UserView$'System quit/resume'
[overlay: fileid | |
self releaseExternalViews.
E nil
ifFalse: [E sleep]. "put the ethernet to sleep"
self InLd: fileid.
[user keyset > 0] "we start here after a resume"
whileTrueDo: [user show: 'The keyset is stuck'.
user cr]].
"293" UserView$'System quit/resume'
[releaseExternalViews | t |
SourceFiles notNil do: [:t | t close].
dp0 close.
dp1 close.
(externalViews length to: 1 by: 1) do: "release (obsolete) known external views"
[:t | (externalViews t) release.
externalViews t ← nil].
externalViews reset].
"212" UserView$'System quit/resume'
[snapshot | i |
"write the OT and Data of this Smalltalk out"
self releaseExternalViews.
InitialContext ← thisContext.
self snapshotPrimitive.
self mapDisplay.
self restore].
"447" UserView$'Misc System Stuff'
[instanceCounts | n old changes name | "user instanceCounts"
changes← (Vector new: 16) asStream.
self classnames do:
[:name |
old← (InstanceCounts has: name)
i"417" LADDictionary$'As yet unclassified'
[delete: key | loc old len entry |
loc ← self find: key.
((entry ← self at: loc) nil or: [entry key key])
ifTrue: [self error: 'Object not found'].
self at: loc put: nil.
len ← self length.
[loc ← loc = len ifTrue: [1] ifFalse: [loc + 1].
(self at: loc) nil]
whileFalseDo:
[old ← self find: (self at: loc) key.
loc=old ifFalse: [self swap: loc with: old]]].
eCounts as: Dictionary init."].
rue: [InstanceCountsname]
ifFalse: [0].
n← (Smallta"449" UserView$'Misc System Stuff'
[instanceCounts | n old changes name | "user instanceCounts"
changes← (Vector new: 16) asStream.
self classNames do:
[:name |
old← (InstanceCounts has: name)
ifTrue: [InstanceCountsname]
ifFalse: [0].
n← (Smalltalkname) howMany.
old=n ifFalse:
[changes next← {name, n, n-old}.
InstanceCounts insert: name with: n]].
↑changes contents
"Smalltalk declare: #InstanceCounts as: Dictionary init."].
name) howMany.
old=n ifFalse:
[changes next← {name, n, n-old}.
InstanceCounts insert: name with: n]].
↑changes contents
"Smalltalk declare: InstanceCounts as: Dictionary init."].
"229" ContextPart$'As yet unclassified'
[mclass | mclass sel |
mclass ← self receiver class.
sel ← self selector.
[mclass superclass nil or: [(mclass canunderstand: sel)]]
whileFalseDo: [mclass ← mclass superclass].
↑mclass].
"282" LADParser$'Name Parsing for Debugger'
[parseArgsAndTemps: sourceStream notifying: req | args temps |
"for debugger"
self init: sourceStream notifying: req.
encoder ← self.
args ← self pattern 2.
temps ← self temporaries.
encoder ← nil. "break cycle"
↑args concat: temps].
"337" StackPane$'Private'
[code | mclass selector |
"code of my selected context"
mclass ← (list selection) mclass.
selector ← self selector.
↑(mclass canunderstand: selector)
ifTrue: [mclass code: selector]
ifFalse: [(LADDecompiler new decompile: selector in: mclass method: (listselection) method) asParagraph makeBoldPattern]].
"724" StackPane$'ListPane protocol'
[selected | context instance code safeVec |
contextVarPane ifFalse: [↑self].
context ← list selection.
instance ← context receiver.
code ← self code.
codePane showing: (code ifTrue: [code] ifFalse: ['']).
code
ifTrue:
[contextVarPane names: (#(thisContext ) concat: (self tempsAndArgs: code))
values: {context , context tempframe} wrt: context.
context tempframe nil ifTrue: [user notify: 'NIL TEMPFRAME']]
ifFalse: [contextVarPane names: #(thisContext ) values: context inVector wrt: context].
safeVec ← Vector new: 2.
safeVec all← instance.
instanceVarPane names: (#(self ) concat: instance class instvars) values: safeVec wrt: context.
contextVarPane select: 1].
"111" StackPane$'Private'
[tempsAndArgs: code ||
↑LADParser new parseArgsAndTemps: code asStream notifying: false].
"1017" CompiledMethod$'Source Code'
[getSource: class | loc file pos char len str |
"get source text from file, or decompile"
loc ← self length.
file ← self loc.
pos ← file land: 63 "high order 6 bits of pos".
file ← file / 64 "top 2 bits are file index".
pos ← pos * 256 + (self (loc - 1)).
pos ← pos * 256 + (self (loc - 2)).
pos = 0 ifTrue: [↑LADDecompiler new decompile: self selector in: class method: self].
file ← SourceFiles (file + 1) "get to correct file (should be readonly)".
file position← pos "read source text, this should be merged with filin stuff.
For now, it does not check matching selectors!!".
char ← file next.
char 34
ifTrue: [user notify: 'not pointing at length comment']
ifFalse:
[len ← file integerScan.
[(char ← file next) = 91] whileFalseDo: [ "skip class and category"
len ← len - 1 "and decrease len of code"].
len ← len - 2 "subtract for ].<cr> after code".
str ← String new: len.
file into: str "get code".
↑str asParagraph makeBoldPattern]].
"685" CompiledMethod$'Source Code'
[putSource: text class: class category: category inFile: fileindex | file clname |
file ← SourceFiles fileindex.
file readwriteshorten.
file settoend.
clname ← class title.
self setSourcePosition: file position inFile: fileindex-1.
file append: '"' " string lengths plus $''<cr>[].<cr> ".
file append: (text length + clname length + category length + 8) asString.
file append: '" ' "put out length".
file append: clname.
file append: '$'''.
file append: category.
file append: ''''.
file cr.
file append: '['.
file append: text.
file append: '].'.
file cr "put out code".
file readonly "leave readonly for browsing and to keep clean"].
"356" LADMethodNode$'Code Generation'
[installIn: class under: category source: sourceParagraph | selector method |
selector← selectorOrFalse key.
method ← self generate.
class install: method selector: selector under: category source: sourceParagraph.
method putSource: sourceParagraph text class: class category: category inFile: 2. "changes"
↑selector].
"480" Class$'Message access'
[code: sel | meth |
"last paragraph returned is cached (mainly for NotifyWindows)"
lastParagraph ← ((sel lastSelector and: [self lastClass])
ifTrue: [lastParagraph]
ifFalse:
[sel = #ClassOrganization
ifTrue: [self organization]
ifFalse: [(meth ← messagedict methodorfalse: sel)
ifTrue: [meth getSource: self]
ifFalse: ['method not found!']]]) asParagraph.
lastClass ← self.
lastSelector ← sel.
↑lastParagraph].
"353" Class$'Message access'
[install: method selector: selector under: category source: code | c |
self organization classify: selector under: category.
messagedict add: method.
lastClass ← self.
lastSelector ← selector.
lastParagraph ← code.
Changes insert: (c ← title + ' ' + selector).
(Changes has: (c ← '~' + c))
ifTrue: [Changes delete: c]].
"181" Class$'Message access'
[understands: code classified: heading | | "compile and install method"
↑LADCompiler new compile: code asParagraph in: self under: heading notifying: self].
"358" LADCompiler$'Public'
[compile: parag in: cls under: category notifying: t4 | methodNode |
requestor ← t4.
self from: parag class: cls instance: false context: false notifying: requestor.
(methodNode ← user displayoffwhile [(self translate: sourceStream noPattern: false)])
ifTrue: [↑methodNode installIn: cls under: category source: parag].
↑false].
"293" Class$'Initialization'
[initClass | |
(Vector new: 128) all← self. "CROCK to stick refct of classes"
fieldtype ← 16.
instsize ← self instvars length.
instsize > 256
ifTrue: [user notify: 'too many instance variables']
ifFalse:
[instsize ← instsize + 8192.
self organization]].
"106" Class$'Access to parts'
[instspec | | "Return the number of user accessable instance fields"
↑instsize].
"65" Class$'Access to parts'
[isBits | |
↑instsize nomask: 8r40000].
"66" Class$'Access to parts'
[isBytes | |
↑instsize nomask: 8r20000].
"70" Class$'Access to parts'
[isVariable | |
↑instsize allmask: 8r10000].
"702" LADDecompiler$'Reverser'
[reverseNext | byte group sel thisLoc |
byte ← postfixStream next "Mark loop beginnings: ".
[nextBegin and: [postfixStream position = nextBegin]] whileTrueDo:
[prefixStream last "ST80false and" #:store
ifTrue:
[ "handle for-loop optimization"
nextBegin ← false "store var test -> store var pop begin var test".
thisLoc ← postfixStream position.
postfixStream skip: 1.
self reverseNext.
prefixStream next← #:pop.
postfixStream position← thisLoc].
prefixStream next← #:begin.
nextBegin ← beginStream next].
group ← byte / 16 + 1.
sel ← typeTable group.
self perform: sel with: byte - (baseTable group) "checked in classInit".
↑sel].
"194" LADDecompiler$'Reverser Performs'
[sundry: nibble | sel |
sel ← sundryTable (nibble + 1).
sel 1 = 58 ":"
ifTrue: [prefixStream next← sel]
ifFalse: [self perform: sel with: nibble]].
"808" LADParser$'Parser'
[statements: argNodes doit: doit | stmts expr returns |
" 3. 4. 5. " "{expression '.'} [↑]expression BlockNode with supplied arguments"
hereType #rightBracket
ifTrue: [↑LADBlockNode new arguments: argNodes statements: #() returns: false from: encoder].
stmts ← (Vector new: 10) asStream.
returns ← false.
[returns ← self match: #upArrow.
expr ← self expression.
stmts next← expr
ifTrue: [expr]
ifFalse: [encoder encodeVariable: (doit ifTrue: ['nil'] ifFalse: ['self'])].
returns false
ifTrue: [self match: #period]
ifFalse:
[(hereType #rightBracket or: [hereType #doIt])
ifTrue: [false]
ifFalse: [↑self expected: 'end of block']]] whileTrueDo: [].
↑LADBlockNode new arguments: argNodes statements: stmts contents returns: returns from: encoder].
"139" Object$'System Primitives'
[perform: selector | |<primitive: 36>
"Send self the message, selector; it had better be unary"
user croak].
"125" Object$'System Primitives'
[perform: selector with: arg1 | |<primitive: 36>
"selector had better take 1 arg"
user croak].
"137" Object$'System Primitives'
[perform: selector with: arg1 with: arg2 | |<primitive: 36>
"selector had better take 2 args"
user croak].
"148" Object$'System Primitives'
[perform: selector with: arg1 with: arg2 with: arg3 | |<primitive: 36>
"selector had better take 3 args"
user croak].
"398" Object$'System Primitives'
[perform: selector withArgs: vec | t3 |
(t3 ← vec length) = 0
ifTrue: [↑self perform: selector].
t3 = 1
ifTrue: [↑self perform: selector with: vec 1].
t3 = 2
ifTrue: [↑self perform: selector with: vec 1 with: vec 2].
t3 = 3
ifTrue: [↑self perform: selector with: vec 1 with: vec 2 with: vec 3].
user notify: 'More than 3 args for perform:'].
"390" Rectangle$'Image'
[blt: dest mode: mode clippedBy: clipRect | |
"Copy the screen bits within my area to the rectangle whose
origin is dest and whose extent is the same as mine.
If clipRect is not nil, then copy only those bits within both
the destination rectangle and clipRect"
DisplayBLTer copy window: clipRect;
copyRect: self toPoint: dest effect: (mode land: 3) screen: 0].
"415" Rectangle$'Image'
[brush: dest mode: mode color: color clippedBy: clipRect | |
"Brush the screen bits within my area to the rectangle whose
origin is dest and whose extent is the same as mine.
If clipRect is not nil, then brush only those bits within both
the destination rectangle and clipRect"
DisplayBLTer copy window: clipRect;
copyRect: self toPoint: dest effect: 8 + (mode land: 3) screen: color].
"74" BlockContext$'As yet unclassified'
[erase | |
home ← nil.
super erase].
"69" ContextPart$'As yet unclassified'
[release | | self releaseTo: nil].
"74" ContextPart$'As yet unclassified'
[releaseFully | | self releaseTo: nil].
"174" ContextPart$'As yet unclassified'
[releaseTo: caller | c | "release frames to break cycles"
c ← self.
[c nil or: [ccaller]] whileFalseDo:
[c erase.
c ← c sender]].
"80" Message$'As yet unclassified'
[args | | ↑1~self length collect: [:x | selfx]].
"68" MethodContext$'Debugger'
[erase | |
receiver ← nil.
super erase].
"85" NotifyWindow$'Window protocol'
[close | |
super close.
thisContext systemRestart].
"67" NotifyWindow$'Window protocol'
[closeNoRestart | |
↑super close].
"220" Object$'System Primitives'
[doesNotUnderstand: message | selector args |
selector ← message selector.
args ← message args.
user notify: 'Message not understood: ' + selector.
↑self perform: selector withArgs: args].
"1076" StackPane$'Private'
[continue: restarting | ctxt | " user notify: '*'. MethodContext howMany 50 40 30"
"Close my window and resume my selected context, if any, else my first context. If interrupted (proceed1) or restarting or a recompiled method, don't return a value; otherwise, return proceed2."
user leftShiftKey
ifTrue: [mem 55 ← 58 "turn display off"].
selection = 0
ifTrue: [selection ← 1].
ctxt ← list selection.
self releaseAboveSelection "release abandoned contexts".
NoteTaker
ifFalse:
[restarting
ifTrue: [ctxt restart]
ifFalse:
[(proceed 1 and: [selection = 1])
ifFalse: [ "resume after interrupt"
ctxt push: proceed 2]]].
list ← false "Inhibit me closing.".
user topWindow closeNoRestart; erase.
user unschedule: user topWindow.
list ← nil.
NoteTaker
ifTrue:
[thisContext sender releaseTo: ctxt.
thisContext sender← ctxt.
↑proceed 2].
proceed 3 = 1
ifTrue: [thisContext sender release].
Top run: ctxt at: proceed 3.
Top enable: proceed 3.
Top wakeup: proceed 3.
Top resetCurrent].
"100" BlockContext$'As yet unclassified'
[printon: strm ||
strm append: '[] in '.
super printon: strm].
"350" Class$'Access to parts'
[instvars | |
self lastInstvarClass
ifTrue: [↑lastInstvars copy].
"cache last computation of instvars"
lastInstvarClass ← self.
lastInstvars ← self fieldNamesInto: FieldNameCollector default.
lastInstvars length>self instsize
ifTrue: [lastInstvars ← lastInstvars copy: 1 to: self instsize].
↑lastInstvars copy].
"102" CompiledMethod$'Association'
[printon: strm ||
strm append: 'a MethodContext for ' + self selector].
"111" ContextPart$'As yet unclassified'
[tempframe | i |
↑1 ~ self method numTemps collect: [:i | self tempAt: i]].
"989" LADScanner$'Mulit-Character Scans'
[xDigit | fracPart exp real radix |
"form a number"
tokenType ← #number.
real ← false.
radix ← self convert: (self scanInteger: 10) radix: 10.
hereChar = 114
ifTrue: "<radix>r<number>"
[self step.
token ← self convert: (self scanInteger: radix) radix: radix]
ifFalse:
[token ← radix.
radix ← 10].
(hereChar = 46 and: [(self testDigit: aheadChar radix: radix)])
ifTrue: ".<fraction>"
[self step.
real ← true.
fracPart ← self scanInteger: radix.
fracPart ← (self convert: fracPart radix: radix) asFloat /
(radix asFloat ipow: fracPart length).
token ← token asFloat + fracPart].
hereChar = 101
ifTrue: "e<exponent>"
[self step.
exp ← (hereChar = 45 "-"
ifTrue:
[self step.
0 - (self convert: (self scanInteger: 10) radix: 10)]
ifFalse: [self convert: (self scanInteger: 10) radix: 10]).
token ← token * (real
ifTrue: [radix asFloat ipow: exp]
ifFalse: [radix ipow: exp])]].
"122" NotifyWindow$'Window protocol'
[close | |
super close.
self erase.
user unschedule: self.
thisContext systemRestart].
"257" Object$'Aspects'
[inspectfield: n | fixedSize |
"used by variable panes"
self class isVariable
ifTrue:
[fixedSize ← self class instsize.
n > fixedSize
ifTrue: [↑self (n - fixedSize)].
↑self instfield: n]
ifFalse: [↑self instfield: n]].
"299" UserView$'System quit/resume'
[snapshot | i |
"write the OT and Data of this Smalltalk out"
self releaseExternalViews.
InitialContext ← thisContext.
self snapshotPrimitive.
self mapDisplay.
SourceFiles2 ← (dp0 file: 'st80changes.v00') readonly. "Avoid remap problem for now"
self restore].
"125" BitBlt$'Setup'
[sourceForm: t1 | |
sourceForm ← t1.
sourceRaster ← sourceForm width + 15 / 16.
source ← sourceForm bits].
"114" BitBlt$'Setup'
[toDisplay | |
self destForm: DisplayForm.
source nil ifTrue: [self sourceForm: DisplayForm]].
"137" Class$'Message access'
[classified: heading understands: code | |
"A synonym for replay"
↑self understands: code classified: heading].
"606" CodePane$'Window protocol'
[doit | s val t4 |
scrollBar hide "do automatic selection (ESC) on empty selections".
(s ← pared selectRange) empty
ifTrue:
[pared unselect.
pared fintype.
pared complement.
s ← pared selectRange].
val ← selectorPane execute: pared selectionAsStream for: self.
(val nil or: [s pared selectRange])
ifFalse:
[ "result is nil or error occurred" "automatically paste result"
s ← s stop + 1.
(t4 ← (String new: 100) asStream) space.
t4 print: val.
pared Scrap← t4 contents asParagraph.
pared selectRange: (s to: s).
pared paste].
scrollBar show].
"345" EFTPSender$'Initialization'
[net: n host: h | |
super net: n host: h soc: 16 "Each instance of an EFTPSender has a unique lclSocket, but
always goes to socket 020 of the receiver; unlike plain sockets, we only want acks from this dest.".
filterInput ← true.
self retransmit: 5 every: 180.
outPac ← false.
transaction ← 0.
ackType ← 25].
"85" Etherworld$'User messages'
[broadcastFilterSet: val | |<primitive: 90>
user croak].
"90" Etherworld$'Input Interrupt Routines'
[copyinput: string | |<primitive: 89>
user croak].
"95" Etherworld$'Output Routines'
[doOutput: string words: words | |<primitive: 91>
user croak
].
"700" Etherworld$'Output Routines'
[sendOutput: ethOutPac | post |
"This is the one and only place from which we send output.
Only one packet gets passed in to us at a time.
For performance, we wait here for the transmitter to post!!!!
Nominally, we are running at level 0; thus, this must be run
at a Top critical, to protect from multiple calls."
etherState ethAwake
ifTrue:
[self wakeup.
user show: 'starting Ethernet...'].
Top critical [
OutputLight comp.
(post ← self doOutput: ethOutPac pupString words: ethOutPac totLengthWords) 511
ifTrue:
[user cr.
user show: 'Warning, bad output post: ' + post base8].
OutputLight comp] "end of the critical part"].
"77" Etherworld$'Utility messages'
[SIO: sioArg | | <primitive: 87>
user croak].
"1036" FontWindow$'Strike format'
[makecu: name scale: cuscale | f svscale svchar bitwidth i bitmover bits |
"Put out font in Carnegie-Mellon format"
f ← dp0 file: name + '.cu.'.
self updateseglength: font raster: fontraster.
self updatemaxwidth.
svscale ← scale.
scale ← cuscale.
svchar ← char.
self cufixup.
f nextword← fontht * scale.
f nextword← (bitwidth ← font word: 4) * scale + 15 / 16.
bits ← String new: fontht * scale * (bitwidth * scale + 15 / 16) * 2.
bitmover ← BitBlt init.
bitmover destbase← bits.
bitmover destraster← bitwidth * scale + 15 / 16.
bitmover destx← 0.
bitmover desty← 0.
bitmover fromDisplay.
bitmover sourcex← frame origin x.
bitmover sourcey← frame origin y.
((font word: 2) to: (font word: 3) by: 1) do:
[:i | self setchar: i.
f nextword← i.
f nextword← charwid * scale.
bitmover width← frame extent x * scale.
bitmover height← frame extent y * scale.
bits all← 0.
bitmover copy: storing.
f append: bits].
f close.
scale ← svscale.
self cufixup.
self setchar: svchar].
"522" FormSet$'ACCESS'
[copy: t1 to: pt | f |
formindex ← t1.
self checkindex "copies the form indexed by formindex to pt." "f ← Image new size: (self width) (self height) at: pt.".
bitmover toDisplay.
bitmover destx← pt x.
bitmover desty← pt y.
bitmover sourcex← self originx.
bitmover sourcey← 0.
bitmover width← self width.
bitmover height← self ascent + self descent.
bitmover sourceraster← self wordwidth.
bitmover sourcebase← strike.
bitmover strike← true.
bitmover copy: oring.
↑self widthof: formindex].
"511" FormSet$'ACCESS'
[copy: t1 to: pt effect: effect | f |
formindex ← t1.
self checkindex "copies the form indexed by formindex to pt." "f ← Image new size: (self width) (self height) at: pt.".
bitmover toDisplay.
bitmover destx← pt x.
bitmover desty← pt y.
bitmover sourcex← self originx.
bitmover sourcey← 0.
bitmover width← self width.
bitmover height← self ascent + self descent.
bitmover sourceraster← self wordwidth.
bitmover sourcebase← strike.
bitmover strike← true.
bitmover copy: effect].
"1189" FormSet$'ACCESS'
[makecu: name scale: scale | f i iform bits drast |
user displayoffwhile [
"Put out strike in Carnegie-Mellon format.
A typical call might look like:
yourset ←
FormSet new style: DefaultTextStyle styleindex: 0.
yourset makecu: 'cream12' scale: 1.
"
f ← dp0 file: name + '.cu.'.
f nextword← self height * scale.
f nextword← self maxwidth * scale + 15 / 16.
bits ← String new: self height * scale * (self maxwidth * scale + 15 / 16) * 2.
drast ← self maxwidth * scale + 15 / 16.
(self first to: self last by: 1) do:
[:i | iform ← self asForm: i "self copy: i to: 00".
iform displayat: 0 0 effect: 0 clippedBy: user screenrect.
scale > 1
ifTrue: [iform blowup: 0 0 by: scale].
f nextword← i.
f nextword← self width * scale.
bitmover destbase← bits.
bitmover destraster← drast.
bitmover destx← 0.
bitmover desty← 0.
bitmover fromDisplay.
bitmover sourcex← 0.
bitmover sourcey← 0.
bitmover dstrike← false.
bitmover sstrike← true.
bitmover width← iform width * scale.
bitmover height← iform height * scale.
bits all← 0.
bitmover copy: storing.
f append: bits].
f close]].
"675" FormSet$'ACCESS'
[replace: t1 with: form | |
formindex ← t1.
self checkindex "Replace form in set. Check incoming form for compatibility with formset,
and insert form into formset.".
form width self width
ifTrue: [self changewidthof: formindex to: form width].
form displayat: 0 0 effect: 0 clippedBy: user screenrect "copy bits of form into formset".
bitmover destraster← self wordwidth.
bitmover destx← self originx.
bitmover desty← 0.
bitmover sourcex← 0.
bitmover sourcey← 0.
bitmover width← self width.
bitmover height← self ascent + self descent.
bitmover fromDisplay.
bitmover destbase← strike.
bitmover dstrike← true.
bitmover copy: storing].
"218" ILSocket$'Socket'
[net: n host: h | |
seqNum ← 0 "usually called by hostName:".
super net: n host: h soc: 35.
self retransmit: 8 every: (n = NETNUM
ifTrue: [400]
ifFalse: [ "same net"
1800]).
self setAck].
"73" Interval$'Random Numbers'
[randomInit | |
self randomInit: user ticks].
"388" JuniperSocket$'Initialization/Termination'
[net: pNet host: pHost | |
"start with the well known Juniper listener, leave filterInput false"
super net: pNet host: pHost soc: 64.
self retransmit: 3 every: 500 "8 sec".
outAck ← self freePacket "for the outgoing pineAck".
outAck pupType← 173.
outAck pupID1← 0.
outAck dataString← '' "also sets length; need to set addresses later"].
"178" NameUser$'Initialization'
[init | |
E wakeup "create a NameUser, to socket 4, from a default local socket number".
self net: 0 host: 0 soc: 4.
self retransmit: 2 every: 300].
"64" Pacbuf$'PUP Header'
[destSoc0 | |
↑pupString unsignedWord: 8].
"64" Pacbuf$'PUP Header'
[destSoc1 | |
↑pupString unsignedWord: 9].
"81" Pacbuf$'PUP Header'
[destSocNum | |
↑pupString doubleWordAt: 15 "words 8, 9"].
"91" Pacbuf$'PUP Header'
[destSocNum← dSN | |
pupString doubleWordAt: 15 ← dSN "words 8, 9"].
"308" Pacbuf$'PUP Checksum'
[doChecksum | i cs |<primitive: 88>
cs ← 0.
(3 to: self length + 1 / 2 + 2) do:
[:i | "does not work"
cs ← cs + (pupString word: i) "for packets with carries".
cs < 0
ifTrue: [cs ← (cs lshift: 1) + 1]
ifFalse: [cs ← cs lshift: 1]].
cs = 1
ifTrue: [cs ← 0].
↑cs].
"68" Pacbuf$'Ethernet header'
[ethType | |
↑pupString unsignedWord: 2].
"75" Pacbuf$'PUP Header'
[pupID | |
↑pupString doubleWordAt: 9 "words 5, 6"].
"62" Pacbuf$'PUP Header'
[pupID0 | |
↑pupString unsignedWord: 5].
"62" Pacbuf$'PUP Header'
[pupID1 | |
↑pupString unsignedWord: 6].
"85" Pacbuf$'PUP Header'
[pupID← pID | |
pupString doubleWordAt: 9 ← pID "words 5, 6"].
"65" Pacbuf$'PUP Header'
[pupLength | |
↑pupString unsignedWord: 3].
"67" Pacbuf$'PUP Header'
[sourceSoc0 | |
↑pupString unsignedWord: 11].
"67" Pacbuf$'PUP Header'
[sourceSoc1 | |
↑pupString unsignedWord: 12].
"85" Pacbuf$'PUP Header'
[sourceSocNum | |
↑pupString doubleWordAt: 21 "words 11, 12"].
"95" Pacbuf$'PUP Header'
[sourceSocNum← sSN | |
pupString doubleWordAt: 21 ← sSN "words 11, 12"].
"459" Rectangle$'Conversion'
[bitsFromString: bitmap mode: mode clippedBy: clipRect | t5 |
"Load the screen bits within my area from those stored in bitmap. If clipRect is not nil, then load only those bits within both myself and clipRect"
(t5 ← BitBlt new toDisplay window: clipRect) effect: mode.
t5 sourceForm: (Form new extent: corner - origin bits: bitmap offset: nil).
t5 destOrigin: origin.
t5 sourceRect: (0 0 rect: corner - origin).
t5 callBLT].
"477" Rectangle$'Conversion'
[bitsIntoString: bitmap mode: mode clippedBy: clipRect | t5 |
"Store the screen bits within my area into bitmap. If clipRect is not nil,
then store only those bits within both myself and clipRect,
leaving alone the other bits in bitmap"
(t5 ← BitBlt new fromDisplay window: clipRect) effect: mode.
t5 destForm: (Form new extent: corner - origin bits: bitmap offset: nil).
t5 destOrigin: 0 0.
t5 sourceRect: (origin rect: corner).
t5 callBLT].
"233" RoutingUpdater$'Initialization'
[init | |
super net: 0 host: 0 soc: 2 "create a new local soc number, broadcast to socket 2".
outPac ← self freePacket.
outPac pupType← 128.
outPac dataString← ''.
self retransmit: 3 every: 300].
"295" Socket$'Process outgoing packet'
[broadcast: packet to: t2 | |
"I want to broadcast this packet"
socNumber ← t2.
self setAddresses: packet.
packet destHost← 0.
packet destNet← 0.
packet destSocNum← socNumber "I assume that the length and type have been done".
self completePup: packet].
"121" Socket$'Initialization'
[default | |
self net: 0 host: 0 soc: 0 "default local socket number and leave frn port open"].
"176" Socket$'Initialization'
[from: t1 | |
self from: t1 net: 0 host: 0 soc: 0 "set lcl soc number, leave frnPort open -- useful for creating
a well-known socket as a listener"].
"420" Socket$'Initialization'
[net: t1 host: t2 soc: t3 | |
"default the local socket number:
use some memory dependent info (space) for the high word so that no two
sockets (instances) can be the same, also non-zero.
use time for low word, so that same instance will not usually have the
same socket number (odds = 1/65536)"
self from: ((self asOop land: 8r77777) * 65536 + user ticks) net: t1 host: t2 soc: t3].
"272" Socket$'Initialization'
[setOutAddBlock | |
outAddBlock 1 ← frnNet.
outAddBlock 2 ← frnHost.
outAddBlock doubleWordAt: 3 ← frnSocNum. "words 2, 3"
outAddBlock 7 ← NETNUM.
outAddBlock 8 ← ALTONUM.
outAddBlock doubleWordAt: 9 ← lclSocNum high "words 5, 6"].
"1010" StackPane$'Private'
[continue: restarting | ctxt | " user notify: '*'. MethodContext howMany 50 40 30"
"Close my window and resume my selected context, if any, else my first context. If interrupted (proceed1) or restarting or a recompiled method, don't return a value; otherwise, return proceed2."
selection = 0
ifTrue: [selection ← 1].
ctxt ← list selection.
self releaseAboveSelection "release abandoned contexts".
NoteTaker
ifFalse:
[restarting
ifTrue: [ctxt restart]
ifFalse:
[(proceed 1 and: [selection = 1])
ifFalse: [ "resume after interrupt"
ctxt push: proceed 2]]].
list ← false "Inhibit me closing.".
user topWindow closeNoRestart; erase.
user unschedule: user topWindow.
list ← nil.
NoteTaker
ifTrue:
[thisContext sender releaseTo: ctxt.
thisContext sender← ctxt.
↑proceed 2].
proceed 3 = 1
ifTrue: [thisContext sender release].
Top run: ctxt at: proceed 3.
Top enable: proceed 3.
Top wakeup: proceed 3.
Top resetCurrent].
"365" String$'Reading and Writing'
[doubleWordAt: i | b0 b1 b2 w |
"Primarily for reading socket #s in Pup headers"
b0 ← selfi. b1 ← self(i+1). b2 ← self(i+2). w ← self(i+3).
"Following sequence minimizes LargeInteger arithmetic for small results."
b2=0 ifFalse: [w ← b2*256 + w].
b1=0 ifFalse: [w ← b1*65536 + w].
b0=0 ifFalse: [w ← b0*16777216 + w].
↑w].
"210" String$'Reading and Writing'
[doubleWordAt: i ← value | w |
"Primarily for setting socket #s in Pup headers"
w ← value bytes.
selfi ← w4.
self(i+1) ← w3.
self(i+2) ← w2.
self(i+3) ← w1.
↑value].
"117" String$'Reading and Writing'
[unsignedWord: x | |
"Will replace word: someday"
↑self(x+x+1)*256 + (self(x+x))].
"232" UserView$'Misc System Stuff'
[allSenders: lit | result cl lis |
result ← (Vector new: 10) asStream.
Class allInstancesDo:
[:cl| lis ← cl whosends: lit.
lis length>0 ifTrue: [result next← {cl title, lis}]].
↑result contents].
"75" UserView$'Mouse, Cursor, Keys'
[buttons | |
↑self primMouseKeys land: 7].
"244" UserView$'Mouse, Cursor, Keys'
[currentCursor: c | coff p |
currentCursor ← c.
coff ← c offset.
p ← self mp.
mxoffset ← coff x - htab.
myoffset ← coff y - vtab.
self cursorloc← p "Cursor ref pt contin across boundary".
self mapDisplay].
"101" UserView$'Mouse, Cursor, Keys'
[cursorloc← pt | |
↑self primCursorLoc← pt - (mxoffset myoffset)].
"105" UserView$'Screen Views'
[displayoffwhile expr | |
↑expr eval "Don't bother turning off the display"].
"88" UserView$'Mouse, Cursor, Keys'
[keyset | |
↑(self primMouseKeys lshift: 3) land: 31].
"84" UserView$'Mouse, Cursor, Keys'
[mp | |
↑self primMousePt + (mxoffset myoffset)].
"127" UserView$'System quit/resume'
[quitFrom: controller | |
self overlay: #(0 0 0 0 0 ).
screenrect clear.
controller restore].
"46" UserView$'Screen Views'
[restoredisplay | |].
"132" UserView$'Time'
[timewords | s |
s ← String new: 4 "seconds (in GMT) since Jan 1 1901: as a String".
self timeWordsInto: s.
↑s].
"3485" UserView$'Misc System Stuff'
[version | |
↑'Smalltalk-80 December 16' "user version
low level disk address calculations are more general (necessary for 14-sector Dorado/Dolphin file systems)
better error recovery for broken and timed out Leaf connections
AltoFileDirectory disk page allocation/deallocation bugs fixed
miscellaneous printing fixes
Juniper fixes (2)
goodie: again-del-forget.st
Phylum account changes
default Leaf connection is logged in to <Smalltalk-User>
system release uses [Phylum]<Smalltalk-76> instead of [Ivy]<Smalltalk>
see UserView workspace for logging into your account on Phylum, changing default printer
September 3, 5.5j
duplicate packet fix
fixes to ether (routing table, name lookup, phylum, Int32), printer names,
files, UserView time messages, context simulation,
replace in BitBlt & Paragraph, NotifyWindow cleanup,
Class code: always decompiles with left shift key, window printing fixes,
SystemOrganization globalComment contains no nulls
the following changes files were included:
[phylum]<small-goodies>
5.5i.changes.st, notifychange.st, window-print-changes.st
[phylum]<findit>5.5i.more.changes.st
[maxc]<dolbec>int32change.st
[maxc>ingalls>fixes.st
[ivy]<kaehler>context-simulation.st
[ivy]<borning>context-changes.st
May 1, 5.5i
obscure file bugs eliminated; version features added (goody: File-version.st).
Ifs multiple connections fixed; Ifs error numbers looked up in Ifs.Errors.
duplicate packets eliminated at lowest level.
Int32 primitive fix. Juniper retransmit parameters increased
Integer compare: LargeInteger now works
CodePane/FilePane 'print' (within a CodeWindow) now prints entire Paragraph
rather than only part within window
ScrollBars hide during CodePane again & cancel. cancel saves your old text, so
an immediate undo will replace the current selection with your previous text.
April 11, 5.5h
Alto file names limited to 39 characters ('somestring' asFileName will fix
name, truncating if necessary). other misc. file, ether, simulator fixes.
BitBlt fixed so that BitRects don't lose their bits
BitBlt used to speedup reading&writing files, sending Press files to printers
ParagraphScanner puts underlining into Press files
printer names updated (PressFile classInit). hashing-changes.st included.
after font cataclysm, get new version of Fonts.Widths before printing
system release procedure modified
March 6, 5.5g
ether, file, vmem writing fixes. cursor clipping on screen boundary.
BitBlt used for String growing, copying, replacing
goodies included: display-off-after-notify.st, CodePane-doit.st,
context-simfix2.st, ILchanges.st, string-changes.st
see [Phylum]<Smalltalk> for the following files. () surround an optional prefix or suffix.
Document.Press
mini-guide to Smalltalk system and user interface
VersionHistory
information about versions up to 5.5g
ChangedMessages
a list of messages which have changed
xxx.Press
press file for CrossReference or for system category 'xxx' in current version
to save paper, consider consulting the LRG alcove copies
(Xm)Small.Boot(.version)
(Xm)Smalltalk.Syms(.version)
older versions of .Boot and .Syms are explicitly named.
Smalltalk.Sources.version
all Smalltalk.Sources (including the current one) are explicitly named
[Phylum]<Small-Goodies> contains miscellaneous bug fixes and new features (and even some documentation: goodies.bravo, .press) offered by the community of Smalltalk Users.
"].
"631" AltoFile$'File'
[sameFile | page s |
(page ← self newPage: 0) address: leader.
"if any of following tests fail, File will be reinitialized"
(((page doCommand: CCR error: false) "serial number match"
and: [page pageNumber "correct page number" = 0])
and: [s ← page asStream. "last write was by us"
type = (s next: 4) and: [s skip: 8. "same name"
(name compare: s nextString) = 2]])
ifTrue:
["check last page (if known)"
(lastpn and: [pageAddresses])
ifTrue: [page pageNumber: lastpn; address: pageAddresseslastpn.
↑(page doCommand: CCR error: false) and: [page lastPage]].
↑true]
ifFalse: [↑false]].
"378" Class$'Access to parts'
[instvars | |
self lastInstvarClass
ifTrue: [↑lastInstvars copy].
"cache last computation of instvars"
lastInstvarClass ← self.
lastInstvars ← self fieldNamesInto: FieldNameCollector default.
(instsizenilfalse and: [lastInstvars length>self instsize])
ifTrue: [lastInstvars ← lastInstvars copy: 1 to: self instsize].
↑lastInstvars copy].
"157" FileStream$'Stream'
[length | |
self reopen; fixEnd.
page lastPage
ifTrue: [↑page pageNumber - 1 * page dataLength + page length].
↑self file length].
"325" ILFile$'File'
[close: e | p | "close file, possibly ignoring errors"
type ← read. "for next open"
(directory obsolete and: [e=false]) ifTrue: [↑self "dont bother to reopen"].
"shorten header block to first 2 words: command&length, file handle"
p ← self newPage.
p length: 6.
self doCommand: Close page: p error: e].
"76" Integer$'Conversion'
[asObjectNoFail | |<primitive: 40>
↑#VanishedObject].
"212" UserView$'System quit/resume'
[snapshot | i |
"write the OT and Data of this Smalltalk out"
self releaseExternalViews.
InitialContext ← thisContext.
self snapshotPrimitive.
self mapDisplay.
self restore].