"St80Sources.V00 (16 December 1980 4:31:56 pm )"
"82" Association$'As yet unclassified'
[key: t1 value: t2 | |
key ← t1.
value ← t2].
"66" Association$'As yet unclassified'
[value← val | |
↑value ← val].
"51" Association$'As yet unclassified'
[key | |
↑key].
"112" Association$'As yet unclassified'
[printon: strm | |
strm print: key.
strm append: '->'.
strm print: value].
"55" Association$'As yet unclassified'
[value | |
↑value].
"66" SymbolTable$'Insertion'
[ name ← x | |
↑super name value← x].
"74" SymbolTable$'Access to parts'
[ref: name ← val | |
↑super name ← val].
"61" SymbolTable$'Searching'
[ name | |
↑(super name) value].
"245" SymbolTable$'Growing and shrinking'
[growto: size | name copy |
copy ← self class new init: size "create a copy of the new size".
self do: [:name | copy insert: name withref: (self ref: name)].
self copyfrom: copy "hash each entry into it"].
"204" SymbolTable$'Insertion'
[declare: name as: x | a s |
(name is: Vector)
ifTrue:
[s ← x asStream.
name do: [:a | self declare: a as: s next]]
ifFalse:
[self declare: name.
self name ← x]].
"84" UserView$'As yet unclassified'
[primEIANext← char | |<primitive: 75>
↑self croak].
"135" Bitmap$'As yet unclassified'
[ x ← val | |<primitive: 18>
NoteTaker
ifTrue: [user croak]
ifFalse: [↑self instfield: x ← val]].
"162" Bitmap$'As yet unclassified'
[fromStream: strm | i hi lo |
(1 to: self length) do:
[:i | hi ← strm next.
lo ← strm next.
self i ← (hi lshift: 8) + lo]].
"123" Bitmap$'As yet unclassified'
[ x | |<primitive: 17>
NoteTaker
ifTrue: [user croak]
ifFalse: [↑self instfield: x]].
"151" Bitmap$'As yet unclassified'
[toStream: strm | i |
(1 to: self length) do:
[:i | strm next← self i lshift: 8.
strm next← self i land: 255]].
"111" Bitmap$'As yet unclassified'
[printon: strm | |
strm append: 'a Bitmap of length '.
strm print self length].
"137" Bitmap$'As yet unclassified'
[fromString: s | i |
(1 to: self length) do: [:i | self i ← s (i + i) + (s (i + i - 1) lshift: 8)]].
"512" ClassOrganizer$'Conversion to text'
[fromParagraph: para | t i j g |
user displayoffwhile [
(t ← para asVector.
self globalComment← t 1.
commentVector ← Vector new: t length - 1.
groupVector ← Vector new: t length - 1.
(1 to: t length - 1) do:
[:i | g ← t (i + 1).
commentVector i ← g 1.
[0 = (j ← g find: #←)] whileFalseDo: [ "reconstitute ← suffixes"
g ← g replace: j - 1 to: j by: (g (j - 1) + '←') unique inVector].
groupVector i ← (g copy: 2 to: g length) sort])]].
"344" ClassOrganizer$'Access to parts'
[delete: selector | i |
"delete this from all categories"
(1 to: groupVector length) do:
[:i | (groupVector i has: selector)
ifTrue:
[groupVector i ← groupVector i delete: selector.
((groupVector i) length = 0 and: [commentVector i = default])
ifTrue: [self deleteCategory: i]]]].
"151" ClassOrganizer$'Access to parts'
[asStream | v t |
v ← Stream new of: (Vector new: 200).
groupVector do: [:t | v append: t].
↑v contents asStream].
"251" ClassOrganizer$'Conversion to text'
[asParagraph | s i |
s ← Stream default.
s print: self globalComment.
(1 to: commentVector length) do:
[:i | s cr.
s print: ((commentVector i) inVector concat: groupVector i)].
↑s contents asParagraph].
"685" ClassOrganizer$'Access to parts'
[classify: selector under: heading | s h n |
(selector is: Vector)
ifTrue: [selector do: [:s | self classify: s under: heading]]
ifFalse:
[s ← commentVector find: heading.
(s > 0 and: [(groupVector s has: selector)])
ifTrue: [↑self].
(h ← self invert: selector)
ifTrue:
[heading = default
ifTrue: [↑self].
n ← commentVector find: h.
groupVector n ← groupVector n delete: selector].
s = 0
ifTrue: [s ← self insert: heading].
groupVector s ← groupVector s insertSorted: selector.
n ← commentVector find: default.
(n > 0 and: [(groupVector n) length = 0])
ifTrue: [self deleteCategory: n]]].
"120" ClassOrganizer$'Access to parts'
[globalCommentItself | |
↑globalComment "used only by Class archiveOn:changesOnly:"].
"82" ClassOrganizer$'Initialization'
[classInit | |
default ← 'As yet unclassified'].
"174" ClassOrganizer$'Access to parts'
[invert: selector | i |
(1 to: groupVector length) do:
[:i | (groupVector i has: selector)
ifTrue: [↑commentVector i]].
↑false].
"119" ClassOrganizer$'Access to parts'
[has: sel | t |
groupVector do:
[:t | (t has: sel)
ifTrue: [↑true]].
↑false].
"200" ClassOrganizer$'Initialization'
[init: sortedVec | |
self globalComment← 'This class has not yet been commented'.
commentVector ← 'As yet unclassified' inVector.
groupVector ← sortedVec inVector].
"177" ClassOrganizer$'Access to parts'
[category: str | i |
i ← commentVector find: str.
i = 0
ifTrue: [user notify: 'No such category: ' + str]
ifFalse: [↑groupVector i]].
"87" ClassOrganizer$'Access to parts'
[globalComment | |
↑globalComment asParagraph text].
"67" ClassOrganizer$'Access to parts'
[categories | |
↑commentVector].
"488" ClassOrganizer$'Access to parts'
[insert: heading | di dgroup hi |
"force default category to end, delete if empty"
(di ← commentVector find: default) > 0
ifTrue: [dgroup ← groupVector di].
commentVector ← {(commentVector without: di) , heading}.
groupVector ← {(groupVector without: di) , (Vector new: 0)}.
hi ← commentVector length.
(di = 0 or: [dgroup length = 0])
ifTrue: [↑hi].
commentVector ← {commentVector , default}.
groupVector ← {groupVector , dgroup}.
↑hi].
"151" ClassOrganizer$'Access to parts'
[deleteCategory: index | |
groupVector ← groupVector without: index.
commentVector ← commentVector without: index].
"108" ClassOrganizer$'Access to parts'
[globalComment← t1 | |
"String or RemoteParagraph"
globalComment ← t1].
"142" RemoteParagraph$'As yet unclassified'
[fromParagraph: p | |
self position← file position "write me (only once!) on file".
p storeOn: file].
"94" RemoteParagraph$'As yet unclassified'
[position | |
↑hipos + 1000 * 2000 + (lowpos + 1000)].
"148" RemoteParagraph$'As yet unclassified'
[position← p | |
p ← p intdiv: 2000.
hipos ← (p 1) asInteger - 1000.
lowpos ← (p 2) asInteger - 1000].
"94" RemoteParagraph$'As yet unclassified'
[fromString: s | |
self fromParagraph: s asParagraph].
"60" Paragraph$'Text alignment'
[flushright | |
alignment ← 4].
"336" Paragraph$'Manipulation of format runs'
[makerun: len val: val | str i |
"Make up a solid run of value val"
len = 0
ifTrue: [↑nullString].
str ← String new: len - 1 / 255 + 1 * 2.
(1 to: str length by: 2) do:
[:i | str i ← (len > 255
ifTrue: [255]
ifFalse: [len]).
str (i + 1) ← val.
len ← len - 255].
↑str].
"48" Paragraph$'Normal access'
[ x | |
↑text x].
"99" Paragraph$'Manipulation of format runs'
[runcat: x to: y | |
↑self runcat: x and: [y] and: ['']].
"446" Paragraph$'Manipulation of format runs'
[run: a to: b | c |
"subrange of run"
a > b
ifTrue: [↑nullString].
runs nil
ifTrue: [↑self makerun: 1 + b - a val: 0].
a ← self runfind: a.
b ← self runfind: b.
c ← runs copy: a 1 to: b 1 + 1 "copy the sub-run".
a 1 = (b 1)
ifTrue: [c 1 ← 1 + (b 2) - (a 2)]
ifFalse:
[c 1 ← 1 + (runs (a 1)) - (a 2) "trim the end lengths".
c (c length - 1) ← b 2].
↑c].
"57" Paragraph$'Text alignment'
[justify | |
alignment ← 1].
"504" Paragraph$'Normal access'
[replace: a to: b by: c | |
"alters self - doesnt copy"
(runs nil and: [(c isnt: self class)])
ifFalse: [runs ← self runcat: (self run: 1 to: a - 1) and: [((c is: self class)
ifTrue: [c runs]
ifFalse: [self makerun: c length val: (runs empty
ifTrue: [0]
ifFalse: [runs ((self runfind: b) 1 + 1)])])] and: [(self run: b + 1 to: text length)]].
text ← text replace: a to: b by: ((c is: self class)
ifTrue: [c text]
ifFalse: [c])].
"52" Paragraph$'Normal access'
[asParagraph | |
↑self].
"185" Paragraph$'Normal access'
[copy: a to: b | |
"Return a copied subrange of this paragraph"
↑self class new text: (text copy: a to: b) runs: (self run: a to: b) alignment: alignment].
"84" Paragraph$'Manipulation of format runs'
[allBold | |
self maskrunsunder: 1 to: 1].
"86" Paragraph$'Manipulation of format runs'
[allItalic | |
self maskrunsunder: 2 to: 2].
"161" Paragraph$'Filing'
[storeOn: file | |
file nextString← text.
runs nil
ifTrue: [file next← 0]
ifFalse: [file nextString← runs].
file next← alignment].
"45" Paragraph$'Normal access'
[text | |
↑text].
"58" Paragraph$'Normal access'
[asVector | |
↑text asVector].
"154" Paragraph$'Manipulation of format runs'
[runs | |
"return runs or default if none"
runs nil
ifTrue: [↑self makerun: text length val: 0].
↑runs].
"835" Paragraph$'Manipulation of format runs'
[runcat: r1 and: r2 and: r3 | i r olen len oc c nr |
nr ← Stream new "concatenate and compact 3 runs" of: (String new: 30).
oc ← false.
(1 to: 3) do:
[:i | r ← (i = 1
ifTrue: [r1]
ifFalse:
[i = 2
ifTrue: [r2]
ifFalse: [r3]]).
r length = 0
ifFalse:
[r ← r asStream.
[len ← r next] whileTrueDo:
[c ← r next.
len = 0
ifFalse:
[ "ignore empty runs (shouldn't be any)"
oc = c
ifTrue:
[(olen ← olen + len) 255
ifFalse:
[nr next← 255.
nr next← oc.
olen ← olen - 255]]
ifFalse:
[oc
ifTrue:
[nr next← olen.
nr next← oc] "first time thru".
olen ← len.
oc ← c]]]]].
oc
ifTrue:
[nr next← olen "leftovers".
nr next← oc].
↑nr contents].
"919" Paragraph$'Bravo conversions'
[bravoRuns: s | i old len dif new bit bits |
"Encode the runs in a Bravo paragraph trailer onto a Stream"
s append: "assume Ctrl-Z is already there"
(alignment = 1
ifTrue: ['j\g']
ifFalse:
[alignment = 2
ifTrue: ['c\g']
ifFalse: ['\g']]).
runs nil
ifFalse:
[len ← 0.
old ← 256.
bits ← #(1 2 4 ).
(1 to: runs length by: 2) do:
[:i | dif ← old lxor: (new ← runs (i + 1)).
(dif land: 247) = 0
ifTrue: [ "No changes"
len ← len + (runs i)]
ifFalse:
[i = 1
ifFalse: [len printon: s].
(1 to: 3) do:
[:bit | (dif land: bits bit) = 0
ifFalse: [s next← ((new land: bits bit) 0
ifTrue: ['biu']
ifFalse: ['BIU']) bit]].
(dif land: 240) 0
ifTrue:
[ "Font change"
s append: 'f'.
s print: (new lshift: 4).
s space].
old ← new.
len ← runs i]]].
s cr].
"94" Paragraph$'Initialization of parts'
[text: t1 alignment: t2 | |
text ← t1.
alignment ← t2].
"303" Paragraph$'Press printing'
[hideData: complete | s |
s ← Stream new of: (String new: 150).
s next← complete.
complete = 0
ifTrue: [s nextword← text length]
ifFalse: [s nextString← text].
s nextString← (runs nil
ifTrue: [nullString]
ifFalse: [runs]).
s next← alignment.
↑s contents].
"49" Paragraph$'Press printing'
[pressCode | |
↑99].
"59" Paragraph$'Text alignment'
[flushleft | |
alignment ← 0].
"54" Paragraph$'Normal access'
[length | |
↑text length].
"108" Paragraph$'Normal access'
[findString: str startingAt: start | |
↑text findString: str startingAt: start].
"108" Paragraph$'Initialization of parts'
[copy | |
↑self class new text: text runs: runs alignment: alignment].
"184" Paragraph$'Press printing'
[hidePress: press complete: c | |
press skipcode: self pressCode "not called by Form-Path-Image, but probably by Class printout" data: (self hideData: c)].
"58" Paragraph$'Normal access'
[asStream | |
↑text asStream].
"372" Paragraph$'Manipulation of format runs'
[maskrun: i to: j under: m to: val | r k |
"Alter my runs so that the bits selected by m become val." "Maybe merge this with mergestyle"
r ← self run: i to: j.
(2 to: r length by: 2) do: [:k | r k ← (r k land: 255 - m) + val].
runs ← self runcat: (self run: 1 to: i - 1) and: [r] and: [(self run: j + 1 to: text length)]].
"79" StyleSheet$'As yet unclassified'
[NoteTakerize | x |
(fontset 0) NTformat].
"74" StyleSheet$'Access to Parts'
[font: fontindex | |
↑fontset fontindex].
"54" StyleSheet$'Access to Parts'
[tabsize | |
↑tabsize].
"56" StyleSheet$'Access to Parts'
[linelead | |
↑linelead].
"52" StyleSheet$'Access to Parts'
[effect | |
↑effect].
"235" StyleSheet$'Initialization'
[fontset: t1 lineheight: t2 linelead: t3 baseline: t4 tabsize: t5 spacesize: t6 effect: t7 | |
fontset ← t1.
lineheight ← t2.
linelead ← t3.
baseline ← t4.
tabsize ← t5.
spacesize ← t6.
effect ← t7].
"86" StyleSheet$'Access to Parts'
[fontfamily: fontindex | |
↑fontset family: fontindex].
"82" StyleSheet$'Access to Parts'
[fontsize: fontindex | |
↑fontset size: fontindex].
"60" StyleSheet$'Access to Parts'
[lineheight | |
↑lineheight].
"56" StyleSheet$'Access to Parts'
[baseline | |
↑baseline].
"192" StyleSheet$'Initialization'
[fontset: t1 | |
fontset ← t1.
self fontset: fontset lineheight: fontset height linelead: 0 baseline: fontset baseline tabsize: 32 spacesize: 4 effect: storing].
"58" StyleSheet$'Access to Parts'
[spacesize | |
↑spacesize].
"159" Object$'System Primitives'
[performDangerously: selector with: arg1 with: arg2 with: arg3 | |<primitive: 36>
"selector had better take 3 args"
user croak].
"162" Object$'System Primitives'
[messageNotUnderstood: op withArgs: args from: sender | |
thisContext sender← sender.
user notify: 'Message not understood: ' + op].
"322" Object$'Printing'
[printon: strm | t |
strm append: (self nil
ifTrue: ['nil']
ifFalse:
[self false
ifTrue: ['false']
ifFalse:
[self true
ifTrue: ['true']
ifFalse:
[t ← self class title.
strm append: (('AEIO' has: t 1)
ifTrue: ['an ']
ifFalse: ['a ']).
t]]])].
"120" Object$'Construction'
[asVector | v |
self nil
ifTrue: [↑Vector new: 0].
v ← Vector new: 1.
v 1 ← self.
↑v].
"81" Object$'Compiler Defaults'
[argsOff: stack | |
self
ifTrue: [stack pop: 1]].
"124" Object$'System Primitives'
[nail | |
NoteTaker
ifFalse: [↑self Altonail] "Nail me in core and return my core address"].
"54" Object$'Compiler Defaults'
[remote: generator | |
].
"113" Object$'Compiler Defaults'
[printon: strm indent: level precedence: p forValue: v decompiler: decompiler | |
].
"132" Object$'System Primitives'
[nextInstance | |<primitive: 82>
"return next in enumeration of my class, false if done"
user croak].
"56" Object$'Aspects'
[hash | |<primitive: 39>
user croak].
"74" Object$'Aspects'
[title | |
↑self class title + '.' + self asOop base8].
"125" Object$'Construction'
[copy | |
"create new copy of self"
(self is: Object)
ifTrue: [↑self].
↑self class copy: self].
"64" Object$'Aspects'
[instfield: n | |<primitive: 37>
user croak].
"85" Object$'Aspects'
[canunderstand: selector | |
↑self class canunderstand: selector].
"145" Object$'Compiler Defaults'
[notify: errorString at: position in: stream | |
↑self notify: errorString at: position in: stream for: self class].
"52" Object$'Classification'
[species | |
↑self class].
"57" Object$'Printing'
[print | |
user show: self asString].
"83" Object$'Aspects'
[ref: index | |
↑FieldReference new object: self offset: index].
"64" Object$'Classification'
[class | |<primitive: 24>
user croak].
"64" Object$'Classification'
[isnt: x | |
↑self class x false].
"63" Object$'Construction'
[asStream | |
↑self asVector asStream].
"57" Object$'Aspects'
[asOop | |<primitive: 39>
user croak].
"47" Object$'Classification'
[isArray | |
↑false].
"48" Rectangle$'Aspects'
[rightside | |
↑corner x].
"110" Rectangle$'Conversion'
[printon: strm | |
strm print: origin.
strm append: ' rect: '.
strm print: corner].
"61" Rectangle$'Altering'
[growby: pt | |
corner ← corner + pt].
"45" Rectangle$'Aspects'
[hash | |
↑super hash].
"71" Rectangle$'Arithmetic'
[has: pt | |
↑origin pt and: [pt < corner]].
"87" Rectangle$'Initialization'
[copy | |
↑origin copy "new rectangle" rect: corner copy].
"50" Rectangle$'Aspects'
[size | |
↑corner - origin].
"52" Rectangle$'Altering'
[growto: t1 | |
corner ← t1].
"111" Rectangle$'Conversion'
[bitmapLength | extent |
extent ← corner - origin.
↑extent y * (extent x + 15 / 16)].
"124" Rectangle$'Arithmetic'
[max: rect | |
↑Rectangle new origin: (origin min: rect origin) corner: (corner max: rect corner)].
"62" Rectangle$'Arithmetic'
[empty | |
↑origin < corner false].
"62" Rectangle$'Image'
[comp | |
self color: black mode: xoring].
"43" Rectangle$'Aspects'
[minX | |
↑origin x].
"43" Rectangle$'Aspects'
[minY | |
↑origin y].
"43" Rectangle$'Aspects'
[maxY | |
↑corner y].
"43" Rectangle$'Aspects'
[maxX | |
↑corner x].
"342" Rectangle$'Altering'
[maxstretch: bound | bx by boundr selfr |
bx ← (bound corner - origin) x.
by ← (bound corner - origin) y.
boundr ← bx asFloat / by.
selfr ← self width asFloat / self height.
selfr > boundr
ifTrue: [self extent← bx (bx asFloat / selfr) asInteger]
ifFalse: [self extent← (by asFloat * selfr) asInteger by]].
"45" Rectangle$'Aspects'
[bottom | |
↑corner y].
"130" Rectangle$'Conversion'
[hardcopy: pf thickness: th | r |
((self inset: 0 - th) minus: self) do: [:r | pf showrect: r color: 0]].
"145" Rectangle$'Arithmetic'
[include: r | |
"Returns the merge with an adjacent rectangle."
↑(origin min: r origin) rect: (corner max: r corner)].
"120" Rectangle$'Arithmetic'
[nearest: pt | |
↑((origin x max: pt x) min: corner x) ((origin y max: pt y) min: corner y)].
"115" Rectangle$'Border'
[outline: thick | t |
t ← 1 1 * thick.
(self inset: t) clear: black.
self clear: white].
"83" Rectangle$'Border'
[outline | |
"default border is two thick"
self outline: 2].
"155" Rectangle$'Aspects'
[corners | v |
v ← Vector new: 4.
v 1 ← origin.
v 2 ← corner x origin y.
v 3 ← corner.
v 4 ← origin x corner y.
↑v].
"104" Rectangle$'Aspects'
[height← h | |
"change my bottom y to make my height h"
corner y← origin y + h].
"51" Rectangle$'Aspects'
[origin← t1 | |
origin ← t1].
"51" Rectangle$'Aspects'
[corner← t1 | |
corner ← t1].
"78" Rectangle$'Aspects'
[extent← extent | |
corner ← origin + extent.
↑extent].
"184" Rectangle$'Altering'
[dragto: dest | v i |
self blt: dest mode: storing.
v ← dest rect: dest + self extent.
(self minus: v) do: [:i | i clear].
origin ← dest.
corner ← v corner].
"84" Rectangle$'Altering'
[moveto: pt | |
corner ← corner + pt - origin.
origin ← pt].
"389" Rectangle$'Border'
[boxcomp | t1 |
"paints a border withoud disturbing interior"
(t1 ← Rectangle new origin: origin - (2 2) corner: corner x + 2 origin y) color: black mode: xoring.
t1 moveto: origin x - 2 corner y.
t1 color: black mode: xoring.
t1 origin← corner x (origin y - 2).
t1 color: black mode: xoring.
t1 moveto: origin - (2 2).
t1 color: black mode: xoring].
"84" Rectangle$'Altering'
[moveby: pt | |
origin ← origin + pt.
corner ← corner + pt].
"485" Rectangle$'Initialization'
[fromuser | t |
origin ← OriginCursor showwhile [ "Show the origin cursor until the user presses a mouse button,
then get my origin"
(user waitbug)] "Show the corner cursor and complement me until the user presses
a button again. The loop is arranged so
that complementing stays on for a little while.".
t ← origin.
CornerCursor showwhile [([corner ← t.
t ← user mpnext] whileTrueDo:
[self comp.
t ← t max: origin.
self comp])]].
"55" Rectangle$'Aspects'
[width | |
↑corner x - origin x].
"94" Rectangle$'Image'
[clear | |
"default is backround"
self color: background mode: storing].
"69" Rectangle$'Image'
[comp: color | |
self color: color mode: xoring].
"450" Rectangle$'Aspects'
[side: side | |
"Returns one side as a rectangle." "Sides are numbered 0-3. +1 goes counterclockwise. Xor: 2 gets opposite side."
side = 0
ifTrue: [↑origin rect: corner x "top" origin y].
side = 1
ifTrue: [↑origin rect: origin x "left" corner y].
side = 2
ifTrue: [↑origin x "bottom" corner y rect: corner].
side = 3
ifTrue: [↑corner x "right" origin y rect: corner].
.
user notify: 'Invalid side'].
"54" Rectangle$'Image'
[flash | |
self comp.
self comp].
"352" Rectangle$'Aspects'
[edge: side | |
"Returns one side as a number." "Sides are numbered 0-3. +1 goes counterclockwise. lxor: 2 gets opposite side."
side = 0
ifTrue: [↑origin y "top"].
side = 1
ifTrue: [↑origin x "left"].
side = 2
ifTrue: [↑corner y "bottom"].
side = 3
ifTrue: [↑corner x "right"].
.
user notify: 'Invalid side'].
"65" Rectangle$'Image'
[reverse | |
self color: black mode: xoring].
"390" Rectangle$'Altering'
[usermove: bound | m lim |
lim ← bound corner - self extent.
self bordercomp.
m ← user mp.
[true] whileTrueDo:
[user redbug
ifTrue:
[self bordercomp.
self moveto: (bound origin max: ((m ← user mp) min: lim)).
self bordercomp].
[user anybug and: [m = user mp]] whileTrueDo: [].
user bluebug
ifTrue:
[user waitnobug.
↑self bordercomp]]].
"590" Rectangle$'Altering'
[usersize: bound | m lim |
self origin nil
ifTrue:
[origin ← user mp.
self extent← 16].
self bordercomp.
m ← user mp.
[true] whileTrueDo:
[lim ← bound corner - self extent.
user redbug
ifTrue:
[self bordercomp.
self moveto: (bound origin max: ((m ← user mp) min: lim)).
self bordercomp].
user yellowbug
ifTrue:
[self bordercomp.
corner ← m ← (user mp min: bound corner) max: origin.
self bordercomp].
[user anybug and: [m = user mp]] whileTrueDo: [].
user bluebug
ifTrue:
[user waitnobug.
↑self bordercomp]]].
"1382" Rectangle$'Image'
[rotate | size maskr spt mpt tpt data temp atab btab i unit |
"(00 rect: 128128) rotate."
size ← self extent x.
spt ← size size "size must be a power of 2".
data ← Rectangle new origin: origin extent: spt.
maskr ← Rectangle new origin: (mpt ← origin + (0 size)) extent: spt.
temp ← Rectangle new origin: (tpt ← mpt + (size 0)) extent: spt.
atab ← {0 0 , (1 0) , (0 0) , (0 1) , (1 1) , (0 1) , (1 0) , (1 0) , (1 0)}.
btab ← {0 0 , (1 1) , (0 0) , (1 1) , (1 1) , (1 1)}.
unit ← size / 2.
maskr clear: white.
(Rectangle new origin: mpt extent: unit unit) clear: black.
[unit < 1] whileFalseDo:
[(1 to: 3) do:
[:i | "flip left and right halves"
temp clear: white.
maskr blt: atab i * unit + tpt mode: storing.
maskr blt: atab (3 + i) * unit + tpt mode: oring.
data bltcomp: tpt mode: erasing.
temp blt: atab (6 + i) * unit + origin mode: xoring].
(1 to: 3) do:
[:i | "flip diagonals"
temp clear: white.
maskr blt: btab i * unit + tpt mode: storing.
data bltcomp: tpt mode: erasing.
temp blt: btab (3 + i) * unit + origin mode: xoring].
(unit ← unit / 2) < 1
ifFalse:
[maskr blt: 0 unit + mpt mode: erasing.
maskr blt: unit 0 + mpt mode: erasing.
maskr blt: unit * 2 0 + mpt mode: oring.
maskr blt: 0 (2 * unit) + mpt mode: oring]]].
"86" Rectangle$'ST76'
[ALTObitsFromString: str mode: mode | |<primitive: 75>
user croak].
"86" Rectangle$'ST76'
[ALTObitsIntoString: str mode: mode | |<primitive: 75>
user croak].
"80" Rectangle$'ST76'
[ALTObltcomp: dest mode: mode | |<primitive: 75>
user croak].
"91" Rectangle$'ST76'
[ALTObrush: dest mode: mode color: color | |<primitive: 75>
user croak].
"75" Rectangle$'Conversion'
[hardcopy: pf | |
self hardcopy: pf thickness: 2].
"76" Rectangle$'ST76'
[ALTOblt: dest mode: mode | |<primitive: 75>
user croak].
"79" Rectangle$'ST76'
[ALTOcolor: color mode: mode | |<primitive: 75>
user croak].
"69" Rectangle$'Altering'
[usermove | |
self usermove: user screenrect].
"69" Rectangle$'Altering'
[usersize | |
self usersize: user screenrect].
"511" Rectangle$'Initialization'
[fromuserevenword | t |
origin ← OriginCursor showwhile [ "Show the origin cursor until the user presses a mouse button,
then get my origin"
(user waitbug)] "Show the corner cursor and complement me until the user presses
a button again. The loop is arranged so
that complementing stays on for a little while.".
t ← origin.
CornerCursor showwhile [([corner ← t.
t ← user mpnext] whileTrueDo:
[self comp.
t ← t x + 15 | 16 t y max: origin.
self comp])]].
"221" Rectangle$'Arithmetic'
[+ delta | |
↑Rectangle new "Return a Rectangle which is the sum of me and delta (which is a Rectangle, Point, or Number)" origin: origin + delta asRectOrigin corner: corner + delta asRectCorner].
"228" Rectangle$'Arithmetic'
[- delta | |
↑Rectangle new "Return a Rectangle which is the difference of me and delta (which is a Rectangle, Point, or Number)" origin: origin - delta asRectOrigin corner: corner - delta asRectCorner].
"79" Rectangle$'Arithmetic'
[= r | |
↑origin = r origin and: [corner = r corner]].
"225" Rectangle$'Arithmetic'
[* scale | |
↑Rectangle new "Return a Rectangle which is the product of me and scale (which is a Rectangle, Point, or Number)" origin: origin * scale asRectOrigin corner: corner * scale asRectCorner].
"226" Rectangle$'Arithmetic'
[/ scale | |
↑Rectangle new "Return a Rectangle which is the quotient of me and scale (which is a Rectangle, Point, or Number)" origin: origin / scale asRectOrigin corner: corner / scale asRectCorner].
"383" Rectangle$'Conversion'
[bitsFromStream: strm | rec s |
rec ← origin rect: origin + (self width (16 min: self height)).
s ← rec bitmap.
[rec maxY corner y] whileTrueDo:
[s fromStream: strm.
rec bitsFromString: s.
rec moveby: 0 16].
rec minY < corner y
ifTrue:
[rec corner y← corner y.
s ← nil.
s ← rec bitmap.
s fromStream: strm.
rec bitsFromString: s]].
"117" Rectangle$'Conversion'
[bitmap | extent |
extent ← corner - origin.
↑Bitmap new: extent y * (extent x + 15 / 16)].
"59" Rectangle$'Aspects'
[area | |
↑self width * self height].
"59" Rectangle$'Conversion'
[asRectangle | |
"Return self."].
"52" Rectangle$'Conversion'
[asRectCorner | |
↑corner].
"52" Rectangle$'Conversion'
[asRectOrigin | |
↑origin].
"87" Rectangle$'Altering'
[translate: pt | |
origin ← origin + pt.
corner ← corner + pt].
"100" Rectangle$'Initialization'
[origin: t1 extent: extent | |
origin ← t1.
corner ← origin + extent].
"118" Rectangle$'Conversion'
[bitStringLength | extent |
extent ← corner - origin.
↑2 * extent y * (extent x + 15 / 16)].
"384" Rectangle$'Border'
[border: thick color: color | t3 |
"paints a border withoud disturbing interior"
(t3 ← Rectangle new origin: origin - (thick thick) corner: corner x + thick origin y) clear: color.
t3 moveto: origin x - thick corner y.
t3 clear: color.
t3 origin← corner x (origin y - thick).
t3 clear: color.
t3 moveto: origin - (thick thick).
t3 clear: color].
"121" Rectangle$'Arithmetic'
[intersect: r | |
↑Rectangle new origin: (origin max: r origin) corner: (corner min: r corner)].
"227" Rectangle$'Image'
[brush: dest mode: mode color: color | |
NoteTaker
ifTrue: [DisplayBLTer copyRect: self toPoint: dest effect: 8 + (mode land: 3) screen: color]
ifFalse: [self ALTObrush: dest mode: mode color: color]].
"337" Rectangle$'Image'
[blowup: at by: scale | z dest |
dest ← Rectangle new origin: at extent: self extent * scale.
((dest has: origin) or: [(dest has: corner)])
ifTrue:
[z ← self bitsIntoString.
dest outline.
self moveto: dest origin.
self bitsFromString: z]
ifFalse: [dest outline].
self blowup: at by: scale spacing: 1].
"252" Rectangle$'Arithmetic'
[side: side distanceTo: pt | |
side = 0
ifTrue: [↑pt y - origin y].
side = 1
ifTrue: [↑pt x - origin x].
side = 2
ifTrue: [↑corner y - pt y].
side = 3
ifTrue: [↑corner x - pt x].
.
user notify: 'Invalid side'].
"191" Rectangle$'Arithmetic'
[sideNearest: pt | d dmin i imin |
dmin ← 32767.
(0 to: 3) do:
[:i | dmin > (d ← self side: i distanceTo: pt) abs
ifTrue:
[dmin ← d.
imin ← i]].
↑imin].
"342" Rectangle$'Aspects'
[withSide: side at: pt | |
"Returns a rectangle with one side moved."
side = 0
ifTrue: [↑origin x pt y rect: corner].
side = 1
ifTrue: [↑pt x origin y rect: corner].
side = 2
ifTrue: [↑origin rect: corner x pt y].
side = 3
ifTrue: [↑origin rect: pt x corner y].
.
user notify: 'Invalid side'].
"370" Rectangle$'Conversion'
[bitsOntoStream: strm | rec s |
rec ← origin rect: origin + (self width (16 min: self height)).
(s ← self bitmap) all← 0.
[rec maxY corner y] whileTrueDo:
[rec bitsIntoString: s.
rec moveby: 0 16.
s toStream: strm].
rec minY < corner y
ifTrue:
[rec height← corner y - rec miny.
s ← rec bitsIntoString.
s toStream: strm]].
"83" Rectangle$'Initialization'
[origin: t1 corner: t2 | |
origin ← t1.
corner ← t2].
"189" Rectangle$'Image'
[blt: dest mode: mode | |
NoteTaker
ifTrue: [DisplayBLTer copyRect: self toPoint: dest effect: (mode land: 3) screen: 0]
ifFalse: [self ALTOblt: dest mode: mode]].
"201" Rectangle$'Image'
[bltcomp: dest mode: mode | |
NoteTaker
ifTrue: [DisplayBLTer copyRect: self toPoint: dest effect: 4 + (mode land: 3) screen: 0]
ifFalse: [self ALTObltcomp: dest mode: mode]].
"206" Rectangle$'Image'
[color: color mode: mode | |
NoteTaker
ifTrue: [DisplayBLTer copyRect: self toPoint: origin effect: 12 + (mode land: 3) screen: color]
ifFalse: [self ALTOcolor: color mode: mode]].
"80" Rectangle$'Arithmetic'
[inset: p1 and: p2 | |
↑origin + p1 rect: corner - p2].
"116" Rectangle$'Conversion'
[bitsIntoString | str |
str ← self bitmap.
self bitsIntoString: str mode: storing.
↑str].
"128" Rectangle$'Conversion'
[bitsIntoString: str | |
self bitsIntoString: str mode: storing "default stores bits into the string"].
"125" Rectangle$'Conversion'
[bitsFromString: str | |
self bitsFromString: str mode: storing "default stores bits onto display"].
"349" Rectangle$'Aspects'
[withEdge: side at: coord | |
"Returns a rectangle with one side moved."
side = 0
ifTrue: [↑origin x coord rect: corner].
side = 1
ifTrue: [↑coord origin y rect: corner].
side = 2
ifTrue: [↑origin rect: corner x coord].
side = 3
ifTrue: [↑origin rect: coord corner y].
.
user notify: 'Invalid side'].
"71" Rectangle$'Image'
[clear: color | |
self color: color mode: storing].
"72" Rectangle$'Arithmetic'
[inset: p1 | |
↑origin + p1 rect: corner - p1].
"101" Rectangle$'Aspects'
[width← w | |
"change my right x to make my width w"
corner x← origin x + w].
"43" Rectangle$'Aspects'
[origin | |
↑origin].
"52" Rectangle$'Aspects'
[extent | |
↑corner - origin].
"59" Rectangle$'Arithmetic'
[center | |
↑origin + corner / 2].
"705" Rectangle$'Arithmetic'
[minus: r | s yorg ycor |
"return Vector of Rectangles comprising
the part of me not intersecting r "
"Make sure the intersection is non-empty"
(origin r corner and: [r origin corner])
ifFalse: [↑self inVector].
s ← (Vector new: 4) asStream.
r origin y > origin y
ifTrue: [s next← origin rect: corner x (yorg ← r origin y)]
ifFalse: [yorg ← origin y].
r corner y < corner y
ifTrue: [s next← origin x (ycor ← r corner y) rect: corner]
ifFalse: [ycor ← corner y].
r origin x > origin x
ifTrue: [s next← origin x yorg rect: r origin x ycor].
r corner x < corner x
ifTrue: [s next← r corner x yorg rect: corner x ycor].
↑s contents].
"43" Rectangle$'Aspects'
[corner | |
↑corner].
"56" Rectangle$'Aspects'
[height | |
↑corner y - origin y].
"94" Rectangle$'Arithmetic'
[intersects: r | |
↑(origin max: r origin) < (corner min: r corner)].
"139" Rectangle$'Arithmetic'
[isWithin: rect | |
"am I equal to or contained within rect"
↑origin rect origin and: [corner rect corner]].
"118" BitBlt$'Access to Parts'
[sourceRaster: t1 | |
"length of a 'scanline' source in 16-bit words"
sourceRaster ← t1].
"128" BitBlt$'Setup'
[clipRect: rect | |
clipX ← rect minX.
clipY ← rect minY.
clipWidth ← rect width.
clipHeight ← rect height].
"222" BitBlt$'Setup'
[destForm: t1 | |
destForm ← t1.
self clipRect: (0 0 rect: destForm extent).
destRaster ← destForm width + 15 / 16.
dest ← (NoteTaker
ifTrue: [destForm bits]
ifFalse: [destForm bits lock])].
"90" BitBlt$'Setup'
[destOrigin: destOrigin | |
destX ← destOrigin x.
destY ← destOrigin y].
"189" BitBlt$'Setup'
[sourceForm: t1 | |
sourceForm ← t1.
sourceRaster ← sourceForm width + 15 / 16.
source ← (NoteTaker
ifTrue: [sourceForm bits]
ifFalse: [sourceForm bits lock])].
"126" BitBlt$'Setup'
[sourceRect: rect | |
sourceX ← rect minX.
sourceY ← rect minY.
width ← rect width.
height ← rect height].
"106" BitBlt$'Operations'
[installDisplay | |<primitive: 67>
user croak "set up source=cursor, dest=display"].
"336" Form$'EDITING'
[blinkbrush: parentimage | pt |
pt ← parentimage mp "to show current position of brush in the form.".
brush displayat: parentimage rectangle origin + pt effect: 2 clippedBy: user screenrect.
brush displayat: parentimage rectangle origin + pt effect: 2 clippedBy: user screenrect.
↑parentimage rectangle origin + pt].
"396" Form$'EDITING'
[newbrush: superimage | pt rect |
OriginCursor topage1.
user waitbug.
pt ← superimage mp + superimage rectangle origin.
rect ← pt rect: pt.
CornerCursor topage1.
[user nobug] whileFalseDo:
[rect reverse.
rect reverse.
pt ← superimage mp + superimage rectangle origin.
rect corner← rect origin max: pt].
brush ← Form new fromrectangle: rect.
NormalCursor topage1].
"108" Form$'MODULE ACCESS'
[figure | |
↑figure "return the figure( color assiciated with black) for the form "].
"148" Path$'MODIFYING PATHS'
[deleteindex: i | r |
r ← array (i + 1 to: position).
position ← i - 1.
self append: r.
array (position + 1) ← nil].
"108" Path$'TRANSFORMATIONS'
[+ delta | i |
↑self copy "add delta to every point in the path" translate: delta].
"314" Path$'ACCESSING PATHS'
[pointnearestto: p | distance i nearest d |
distance ← p dist: self 1 "return the index of the point in the path nearest (manhatten norm) to p.".
nearest ← 1.
(1 to: position) do:
[:i | d ← p dist: self i.
d < distance
ifTrue:
[nearest ← i.
distance ← d]].
↑nearest].
"345" Path$'MODIFYING PATHS'
[insert: pt atindex: index | r |
index > position "insert pt at index in the path"
ifTrue: [self next← pt]
ifFalse:
[r ← (position = limit
ifTrue: [self grow]
ifFalse: [self growby: 0]).
position ← 0.
self append: (r 1 to: index - 1).
self next← pt.
self append: r (index to: r length)]].
"782" Path$'SPECIAL PATHS'
[addlinefrom: p1 to: p2 | x1 y1 dx dy yinc x0 y0 cdl i |
dx ← p2 x "for now just add points to the space at alto resolution between p1 and p2
inclusive" - p1 x.
dy ← p2 y - p1 y.
dx < 0
ifTrue:
[dx ← 0 - dx.
dy ← 0 - dy.
x0 ← p2 x.
y0 ← p2 y]
ifFalse:
[x0 ← p1 x.
y0 ← p1 y].
dy 0
ifTrue: [yinc ← 1]
ifFalse:
[yinc ← 0 - 1.
dy ← 0 - dy].
dx dy
ifTrue:
[cdl ← dx / 2.
(0 to: dx) do:
[:i | self add: x0 y0.
cdl ← cdl + dy.
x0 ← x0 + 1.
cdl > dx
ifTrue:
[cdl ← cdl - dx.
y0 ← y0 + yinc]]]
ifFalse:
[ "y is fastest mover"
cdl ← dy / 2.
(0 to: dy) do:
[:i | self add: x0 y0.
cdl ← cdl + dx.
y0 ← y0 + yinc.
cdl > dy
ifTrue:
[cdl ← cdl - dy.
x0 ← x0 + 1]]]].
"224" Path$'MEASURING'
[rectangle | r i |
r ← Rectangle new "return the bounding rectangle that includes all the points in the path." origin: self 1 extent: 1 1.
(1 to: self length) do: [:i | r ← r include: self i].
↑r].
"193" Path$'TRANSFORMATIONS'
[normalize | delta i |
delta ← self origin "subtract the origin of the path from every point in the path".
(1 to: self length) do: [:i | self i ← self i - delta]].
"131" Path$'MEASURING'
[width | |
↑self size "return the width of the bounding rectangle that includes all the points in the path." x].
"170" Path$'SYSTEM'
[printon: strm | t |
strm append: 'a Path: '.
(array is: String)
ifTrue: [strm space append: self]
ifFalse: [self do: [:t | strm space print: t]]].
"465" Path$'SPECIAL PATHS'
[addarcfrom: p1 via: p2 to: p3 | pa pb i k s |
s ← Path new "Kaehler method for Flegal curve" init.
s add: p1.
pa ← p2 - p1.
pb ← p3 - p2.
k ← 5 max: pa x abs + pa y abs + pb x abs + pb y abs / 20.
(1 to: k) do: [:i | "k is a guess how many segments are appropriate"
s add: pa * i / k + p1 * (k - i) + (pb * (i - 1) / k + p2 * (i - 1)) / (k - 1)].
s add: p3.
(1 to: s length - 1) do: [:i | self addlinefrom: s i to: s (i + 1)]].
"148" Path$'TRANSFORMATIONS'
[translate: delta | i |
(1 to: self length "add delta to every point in the path") do: [:i | self i ← self i + delta]].
"103" Path$'BUILDING PATHS'
[comment | |
"see Set for these ... add:, append:, and ← are the main ones"].
"80" Path$'INIT'
[init | |
self default "must be executed for each new instance."].
"143" Path$'MEASURING'
[extent | |
↑self rectangle "return the extent of the bounding rectangle that includes all the points in the path." extent].
"143" Path$'MEASURING'
[corner | |
↑self rectangle "return the corner of the bounding rectangle that includes all the points in the path." corner].
"133" Path$'MEASURING'
[height | |
↑self size "return the height of the bounding rectangle that includes all the points in the path." y].
"143" Path$'MEASURING'
[origin | |
↑self rectangle "return the origin of the bounding rectangle that includes all the points in the path." origin].
"35" Path$'SYSTEM'
[pressCode | |
↑6].
"145" Path$'SYSTEM'
[copy | t |
t ← Path new "returns a new instance of Path that is a copy " init.
t append: (array (1 to: position)) copy.
↑t].
"141" Path$'MEASURING'
[size | |
↑self rectangle "return the extent of the bounding rectangle that includes all the points in the path." extent].
"149" Path$'TRANSFORMATIONS'
[scale: factor | i |
(1 to: self length "scale every point in the path by factor") do: [:i | self i ← self i * factor]].
"136" Set$'Index operations'
[ i ← val | |
position + 1 = i
ifTrue: [self next← val]
ifFalse: [↑array i ← val "self checkIndex:"]].
"65" Set$'Index operations'
[ i | |
↑array i "self checkIndex:"].
"51" Set$'Value operations'
[add: x | |
self next← x].
"93" Set$'Initialization'
[of: t1 to: t2 | |
array ← t1.
position ← t2.
limit ← array length].
"316" Set$'Arithmetic operations'
[product: s | product i |
product ← Set new "product of two sets ... sets must be of equal length" default.
self length = s length
ifTrue:
[(1 to: position) do: [:i | product add: s i * (self i)].
↑product].
user notify: 'product undefined...sets are not of equal length'].
"177" Set$'Index operations'
[deleteI: i | v j |
v ← self i.
(i to: position - 1) do: [:j | array j ← array (j + 1)].
array position ← nil.
position ← position - 1.
↑v].
"175" Set$'Viewing'
[printon: strm | t |
strm append: 'a Set: '.
(array is: String)
ifTrue: [strm append: self]
ifFalse: [self do:
[:t | strm space.
strm print: t]]].
"52" Set$'Initialization'
[default | |
self vector: 8].
"82" Set$'Initialization'
[vector: t1 | |
limit ← t1.
self of: (Vector new: limit)].
"178" Set$'Private'
[growby: n | old |
old ← Set new "grow and reset self. return old Set for copying" of: array to: position.
self of: (array species new: limit + n) to: 0.
↑old].
"67" Set$'Value operations'
[append: x | |
x do: [:x | self next← x]].
"93" Set$'Viewing'
[viewer: v | |
views nil
ifTrue: [views ← Set default].
views next← v].
"82" Set$'Initialization'
[string: t1 | |
limit ← t1.
self of: (String new: limit)].
"29" Set$'Viewing'
[asSet | |
].
"39" Set$'Viewing'
[length | |
↑position].
"58" Set$'Value operations'
[has: x | |
↑(self find: x) > 0].
"45" Set$'Viewing'
[copy | |
↑self viewer copy].
"86" Set$'Value operations'
[insert: x | |
(self find: x) = 0
ifTrue: [self next← x]].
"107" Set$'Value operations'
[find: v | i |
(1 to: position) do:
[:i | array i = v
ifTrue: [↑i]].
↑0].
"45" Set$'Viewing'
[species | |
↑array species].
"69" Set$'Private'
[next | |
user notify: 'no direct reading of a Set'].
"112" Set$'Private'
[checkIndex: i | |
(i 1 and: [i position])
ifTrue: [↑i].
↑user notify: 'illegal index'].
"127" Set$'Value operations'
[delete: x | i |
(1 to: position) do:
[:i | array i x
ifTrue: [↑self deleteI: i]].
↑false].
"44" Set$'Viewing'
[asStream | |
↑self viewer].
"45" SetReader$'Reading'
[asSet | |
↑self copy].
"69" SetReader$'Reading'
[length | |
↑limit - position "how much left"].
"152" SetReader$'Reading'
[copy | t1 |
"yield contents all at once as a Set"
↑(t1 ← Set new) of: (array species new: limit - position).
t1 append: self].
"134" SetReader$'Initialization'
[of: t1 from: t2 for: n | |
array ← t1.
position ← t2.
position ← position - 1.
limit ← position + n].
"120" Set$'Viewing'
[viewRange: i to: j | |
↑SetReader new "self viewer:" of: array from: i to: j "max: 1" "min: position"].
"391" Set$'Index operations'
[insertI: i value: v | old j |
i > position
ifTrue: [self next← v]
ifFalse:
[old ← array.
position = limit
ifTrue:
[limit ← limit + (10 max: limit / 4).
array ← array species new: limit.
(1 to: i - 1) do: [:j | array j ← old j]].
(position to: i by: 1) do: [:j | array (j + 1) ← old j].
array i ← v.
position ← position + 1]].
"60" Set$'Viewing'
[initView: v | |
↑v of: array to: position].
"90" Set$'Viewing'
[notViewed: v | |
views delete: v.
views empty
ifTrue: [views ← nil]].
"215" Set$'Index operations'
[deleteI: i to: j | n k |
n ← j - i + 1.
(i to: position - n) do: [:k | array k ← array (k + n)].
(position - n + 1 to: position) do: [:k | array k ← nil].
position ← position - n].
"108" Set$'Viewing'
[viewer | |
↑SetReader new of: array from: 1 to: position "self viewRange: 1 to: position"].
"72" Set$'Private'
[pastend← x | |
↑self append: self grow.
self next← x].
"339" Set$'Arithmetic operations'
[dotproduct: s | i dotproduct |
dotproduct ← 0.0 "dot product of two sets ... sets must be of equal length".
self length = s length
ifTrue:
[(1 to: position) do: [:i | dotproduct ← dotproduct + (s i * (self i))].
↑dotproduct].
user notify: 'dot product undefined...sets are not of equal length'].
"183" Set$'Arithmetic operations'
[summation | i summation |
summation ← 0.0 "sum of the values in the set".
(1 to: position) do: [:i | summation ← summation + (self i)].
↑summation].
"123" Set$'Private'
[grow | |
↑self growby: (10 max: limit / 4 "self grown and reset. returns another Set with old contents")].
"521" Form$'EDITING'
[line: parentimage | pt1 pt2 path pt |
BlankCursor topage1 "line tool for forms.".
[user redbug] whileFalseDo: [pt1 ← self blinkbrush: parentimage].
brush displayat: pt1 effect: color clippedBy: user screenrect.
[user nobug] whileFalseDo: [pt2 ← self blinkbrush: parentimage].
brush displayat: pt2 effect: color clippedBy: user screenrect.
path ← Path new init.
path addlinefrom: pt1 to: pt2.
path do: [:pt | brush displayat: pt effect: color clippedBy: user screenrect].
NormalCursor topage1].
"134" Form$'PATTERN ACCESS'
[black | i |
(1 to: bits length "sets all bits in the form to black ( to ones)") do: [:i | bits i ← 0 - 1]].
"131" Form$'PATTERN ACCESS'
[white | i |
(1 to: bits length "sets all bits in the form to white ( to zeros)") do: [:i | bits i ← 0]].
"132" Form$'PATTERN ACCESS'
[gray | i |
(1 to: bits length "sets all bits in the form to gray ( to gray)") do: [:i | bits i ← 10922]].
"76" Form$'MODULE ACCESS'
[width | |
↑extent x "return the width of the Form"].
"722" Form$'DISPLAY'
[displayat: path effect: effect clippedBy: cliprect | r i clippedrect |
(path is: Point) "basic form display primitive"
ifTrue:
[r ← Rectangle new origin: path extent: self extent.
r bitsFromString: bits mode: effect clippedBy: cliprect.
aurorarunning
ifTrue: [user displayoffwhile [
(clippedrect ← r intersect: user screenrect.
aurora destination: clippedrect.
aurora source: clippedrect.
aurora figure: figure.
aurora ground: ground.
aurora function: 1103 "AoverB".
aurora doit.
aurora function: 0.
aurora doit)]]]
ifFalse:
[(path is: Path)
ifTrue: [(1 to: path length) do: [:i | self displayat: path i effect: effect clippedBy: cliprect]]]].
"663" Form$'EDITING'
[arc: parentimage | pt1 pt2 pt3 path pt |
BlankCursor topage1 "arc tool for forms.".
[user redbug] whileFalseDo: [pt1 ← self blinkbrush: parentimage].
brush displayat: pt1 effect: color clippedBy: user screenrect.
[user nobug] whileFalseDo: [pt2 ← self blinkbrush: parentimage].
brush displayat: pt2 effect: color clippedBy: user screenrect.
[user redbug] whileFalseDo: [pt3 ← self blinkbrush: parentimage].
brush displayat: pt3 effect: color clippedBy: user screenrect.
path ← Path new init.
path addarcfrom: pt1 via: pt2 to: pt3.
path do: [:pt | brush displayat: pt effect: color clippedBy: user screenrect].
NormalCursor topage1].
"521" Form$'EDITING'
[resize: superimage | pt f |
superimage boxcomp.
CornerCursor topage1.
user waitbug.
[user nobug] whileFalseDo:
[superimage reverse.
superimage reverse.
pt ← superimage superimage mp + superimage superimage rectangle origin.
superimage corner← pt max: superimage origin + (16 16)].
f ← Form new fromrectangle: superimage rectangle.
bits ← f bits.
extent ← f extent.
offset ← 0 0.
superimage white.
superimage resize.
superimage display.
superimage boxcomp.
NormalCursor topage1].
"268" Form$'INIT'
[extent: t1 figure: t2 ground: t3 offset: t4 | |
extent ← t1.
figure ← t2.
ground ← t3.
offset ← t4.
bits ← Bitmap new: extent y "creates a virtual bit map with width = (extent x) and height = (extent y) with the bits all 1." * (extent x + 15 / 16)].
"109" Form$'MODULE ACCESS'
[ground | |
↑ground "return the ground ( color assiciated with white) for the form "].
"104" Form$'As yet unclassified'
[extent: t1 bits: t2 offset: t3 | |
extent ← t1.
bits ← t2.
offset ← t3].
"231" Form$'SYSTEM'
[hideData: complete | s t3 |
(t3 ← Stream new "a Form does not split across page boundaries") of: (s ← String new: 12).
t3 nextPoint← extent.
t3 nextPoint← offset.
t3 nextword← figure.
t3 nextword← ground.
↑s].
"35" Form$'SYSTEM'
[pressCode | |
↑5].
"49" Form$'MODULE ACCESS'
[length | |
↑bits length].
"108" Form$'SYSTEM'
[copy | t |
t ← Form new "return a copy of myself" extent: extent.
t bits: bits copy.
↑t].
"121" Menu$'User interactions'
[fbug | index |
index ← self bugit "for fixed menus" "get the index".
↑index "return index"].
"75" Menu$'User interactions'
[show | |
frame clear: black.
text displayall].
"149" Menu$'Initialization'
[stringFromVector: v | s |
s ← Stream default "DW classInit".
v do:
[:v | s append: v.
s cr].
self string: s contents].
"128" Menu$'User interactions'
[moveto: pt | |
self clear.
frame moveto: pt.
text frame moveto: pt + 2.
thisline moveto: pt + 2].
"156" Menu$'User interactions'
[zbug | index bits |
bits ← self movingsetup.
[(index ← self bugit) = 0] whileTrueDo: [].
frame bitsFromString: bits.
↑index].
"116" Menu$'User interactions'
[rebug | |
user waitbug "wait for button down again".
↑self bug "bugcursor showwhile"].
"729" Menu$'Internal'
[bugit | pt bits rect |
user nobug
ifTrue: [↑0].
"accidental bug returns 0"
thisline comp.
[true] whileTrueDo:
[(text frame has: (pt ← user mp))
ifTrue:
[user anybug
ifTrue:
[(thisline has: pt)
ifFalse:
[text charofpoint: pt andrect [:rect | rect].
pt ← rect origin.
thisline comp "selection follows mouse".
thisline moveto: text frame origin x pt y.
thisline comp]]
ifFalse: [↑1 + (thisline origin y - text frame origin y / text lineheight) "return index"]]
ifFalse:
[thisline comp "he left the menu".
[text frame has: user mp] whileFalseDo:
[user nobug
ifTrue: [↑0]].
thisline comp "return 0 for abort"]] "he came back"].
"46" Menu$'User interactions'
[frame | |
↑frame].
"51" Menu$'User interactions'
[clear | |
frame clear].
"47" Textframe$'Access to Parts'
[para | |
↑para].
"646" Textframe$'Testing'
[Testing | |
"
Stuff to do:
Fast type-in
Try out line buffer
TD measureall. TD enter.
TimesRoman10 fromStrike: 'TimesRoman10'.
user time [TD align; align; align; align.] 575
until user anybug do [TD align].
| p. user print: (p←user waitbug); cr.
user print: (p←TD charofpoint: p); cr.
user print: (TD pointofchar: p1); cr.
TD pointofchar: 68
TD displayall; nselect: user waitbug.
TD clearfrom: user mp y a TDTextImage
TD reversefrom: 1 to: 20.
| i. spy every: 10; on [for i to: 100 do
[TD displayall ]]; report: 'show.spy'; close.
spy every: 10; on [TD select: user waitbug]; report: 'select.spy'; close.
"].
"86" Textframe$'Displaying'
[show: t1 | |
para ← t1.
self measureall.
self displayall].
"160" Textframe$'Line management'
[lineofy: y | |
"Return line number for a given y (may be out of range!)"
↑y - frame minY / style lineheight + 1 min: lastline].
"76" Textframe$'Initialization'
[classInit | |
space ← 32.
cr ← 13.
tab ← 9].
"48" Textframe$'Displaying'
[comp | |
window comp].
"59" TextScanner$'Access to parts'
[leftx | |
↑destX - width].
"2944" TextScanner$'Scanning'
[scanline: line at: y stopx: t3 stopchar: stopchar | ascii runx reason emphasis newrun endrun padwidth relx tabsize spacepad t15 |
stopx ← t3.
chari ← line starti - 1.
spacecount ← line spaces.
padwidth ← line padwidth.
destX ← spacex ← runx ← frame minX.
emphasis ← charpad ← spacepad ← 0.
tabsize ← style tabsize.
spacei ← 1.
(t15 ← para alignment) = 0
ifFalse:
[ "LeftFlush"
t15 = 1
ifTrue:
[spacecount > 0
ifTrue:
[ "Justified"
charpad ← padwidth / (line stopi - chari + spacecount).
charpad > 0
ifTrue:
[padwidth ← padwidth - (charpad * (line stopi - chari - 2 - spacecount)).
printing
ifTrue: [(frame minX y rect: frame maxX (y + style lineheight)) clear: white]].
spacepad ← padwidth / spacecount.
spacecount ← spacecount - (padwidth \ spacecount)]]
ifFalse:
[t15 = 2
ifTrue: [destX ← destX + (padwidth / 2)]
ifFalse:
[ "Centered"
t15 = 4
ifTrue: [destX ← destX + padwidth]]]] "RightFlush".
reason ← 10.
[reason < 10] whileFalseDo:
[ "2=>stopx, 3=>stopchar, 4=>CR,
10=>end of run, 11=>ascii out of range, 12-254=>exception chars"
reason = 10
ifTrue:
[reason ← 255.
chari stopchar
ifTrue: [reason ← 3]
ifFalse:
[ "new run"
printing
ifTrue: [self emphasize: emphasis leftx: runx rightx: destX liney: y].
runx ← destX.
chari ← chari + 1.
newrun ← para runAndVal: chari.
emphasis ← newrun 2 land: 15.
endrun ← newrun 1 + chari - 1 min: stopchar.
self setfont: (newrun 2 lshift: 4) liney: y]]
ifFalse:
[NoteTaker
ifFalse: [source ← glyphs lock].
reason ← self scanword: endrun.
NoteTaker
ifFalse: [glyphs unlock].
reason > 10
ifTrue:
[reason = 12
ifTrue:
[spacecount ← spacecount - 1 "space".
spacecount = 0
ifTrue: [spacepad ← spacepad + 1].
spacei ← chari.
spacex ← destX.
width ← spacesize + spacepad.
printing
ifTrue:
[super effect: 28.
self callBLT]]
ifFalse:
[reason = 13
ifTrue:
[relx ← destX - frame minX "tab".
width ← (para alignment > 0
ifTrue: [tabsize + charpad]
ifFalse: [relx + tabsize | tabsize - relx]).
printing
ifTrue:
[super effect: 28.
self callBLT]]
ifFalse:
[reason = 11
ifTrue: [ascii ← maxascii + 1].
sourceX ← xtable (ascii + 1).
width ← xtable (ascii + 2) - sourceX.
printing
ifTrue:
[super effect: 16.
self callBLT].
width ← width + charpad]].
(destX ← destX + width) > stopx
ifTrue: [reason ← 2]
ifFalse:
[chari endrun
ifTrue: [reason ← 10]
ifFalse: [chari ← chari + 1]]]
ifFalse:
[reason = 4
ifTrue: [width ← 0] "CR"]]].
printing
ifTrue: [self emphasize: emphasis leftx: runx rightx: destX liney: y]].
"1385" TextScanner$'Scanning'
[emphasize: emphasis leftx: leftx rightx: rightx liney: liney | y y2 |
"Should eventually use self callBLT, to get windowing and go faster"
(font nil or: [font height = style lineheight])
ifFalse:
[font ascent < style baseline
ifTrue:
[y ← liney + (style baseline - font ascent).
(leftx liney rect: rightx y) clear: white].
font descent < (style lineheight - style baseline)
ifTrue:
[y ← liney + (style baseline + font descent).
y2 ← y + (style lineheight - (style baseline + font descent)).
(leftx y rect: rightx y2) clear: white]].
emphasis = 0
ifFalse:
[emphasis 8
ifTrue:
[emphasis ← emphasis - 8 "Strike-out".
y ← liney + (style baseline / 2).
(leftx y rect: rightx (y + 1)) clear: black].
emphasis 4
ifTrue:
[emphasis ← emphasis - 4 "Underline".
y ← liney + style baseline.
(leftx y rect: rightx (y + 1)) clear: black].
emphasis 2
ifTrue:
[emphasis ← emphasis - 2 "Itallic".
y ← liney + style lineheight - 4.
[y liney] whileFalseDo:
[(leftx liney rect: rightx - 1 y) blt: leftx + 1 liney mode: storing.
(leftx liney rect: leftx + 1 y) clear: white.
y ← y - 4]].
emphasis 1
ifTrue:
[emphasis ← emphasis - 1 "Bold".
(leftx liney rect: rightx (liney + style lineheight)) blt: leftx + 1 liney mode: oring]]].
"98" TextScanner$'Access to parts'
[spacecount | |
↑0 - spacecount "because counted down from zero"].
"263" TextScanner$'Initialization'
[classInit | |
"TextScanner classInit."
space ← 32.
tab ← 9.
cr ← 13.
(defaultExceptions ← Vector new: 256) all← 0.
defaultExceptions (space + 1) ← 12.
defaultExceptions (tab + 1) ← 13.
defaultExceptions (cr + 1) ← 4].
"536" TextScanner$'Initialization'
[setfont: newfont liney: liney | |
newfont = fontno
ifTrue: [ "Just bump y if same font"
destY ← liney + style baseline - font ascent]
ifFalse:
[font ← style font: (fontno ← newfont).
xtable ← font xtable.
spacesize ← font spacewidth.
minascii ← font minascii.
maxascii ← font maxascii.
glyphs ← font glyphs.
printing
ifTrue:
[sourceRaster ← font raster.
destY ← liney + style baseline - font ascent.
height ← font height.
NoteTaker
ifTrue: [source ← glyphs]]]].
"72" TextScanner$'Initialization'
[exceptionTable: t1 | |
exceptions ← t1].
"881" TextScanner$'Scanning'
[scanword: endrun | ascii |<primitive: 76>
"Scan or print text until terminated by x-value, special character or new format run.
Returns an Integer as follows:
2=>stopx, 10=>end of run, 11=>ascii out of range,
else exceptionschari (4=CR, 12=space, 13=tab)"
super effect: 16 "exceptions and xtable are Vectors of Integers, printing is Boolean, rest are Integers" "becomes: super effect: 3 in new encoding".
[chari > endrun] whileFalseDo:
[ascii ← text chari.
exceptions (ascii + 1) 0
ifTrue: [↑exceptions (ascii + 1)].
(ascii < minascii or: [ascii > maxascii])
ifTrue: [↑11].
sourceX ← xtable (ascii + 1).
width ← xtable (ascii + 2) - sourceX.
printing
ifTrue: [self callBLT].
width ← width + charpad.
destX ← destX + width.
destX > stopx
ifTrue: [↑2].
chari ← chari + 1].
chari ← chari - 1.
↑10].
"52" TextScanner$'Access to parts'
[rightx | |
↑destX].
"344" TextScanner$'Initialization'
[frame: t1 window: w para: t3 style: t4 printing: t5 | |
frame ← t1.
para ← t3.
style ← t4.
printing ← t5.
super init.
self screen: white.
self toDisplay.
exceptions ← defaultExceptions.
fontno ← 1 "indicates font not set".
text ← (para ← para asParagraph) text.
NoteTaker
ifTrue: [self window: w]].
"53" TextScanner$'Access to parts'
[spacei | |
↑spacei].
"53" TextScanner$'Access to parts'
[spacex | |
↑spacex].
"914" TextScanner$'Scanning'
[type: ascii | |
"For incremental typing in a line"
exceptions (ascii + 1) 0
ifTrue: [↑exceptions (ascii + 1)].
(ascii < minascii or: [ascii > maxascii])
ifTrue: [ascii ← maxascii + 1].
stopx ← frame maxX.
sourceX ← xtable (ascii + 1).
(ascii space and: [ascii tab])
ifTrue: [width ← xtable (ascii + 2) - sourceX]
ifFalse:
[ascii = space
ifTrue: [width ← spacesize]
ifFalse: [width ← style tabsize]].
(destX + width > stopx or: [ascii = cr])
ifTrue: [↑1].
(destX destY rect: stopx - width (destY + height)) blt: destX + width destY mode: storing "slide the rest of the line over".
(ascii space and: [ascii tab])
ifTrue: [super effect: 16]
ifFalse: [super effect: 28].
(NoteTaker or: [effect = 28])
ifTrue: [self callBLT]
ifFalse:
[source ← glyphs lock.
self callBLT.
glyphs unlock].
destX ← destX + width.
↑0].
"80" TextScanner$'Access to parts'
[chari | |
↑chari "index of last char scanned"].
"137" Textframe$'Displaying'
[printer: printing | |
↑TextScanner new frame: frame window: window para: para style: style printing: printing].
"118" Textframe$'Line management'
[yofline: line | |
"top y of given line"
↑frame minY + (line - 1 * style lineheight)].
"88" Textframe$'Displaying'
[outline | |
"from TextFrame"
window border: 2 color: black].
"324" Textframe$'Initialization'
[frame: t1 window: t2 para: t3 style: t4 | |
frame ← t1.
window ← t2.
para ← t3.
style ← t4.
(NoteTaker or: [frame nil])
ifFalse: [frame ← window ← frame intersect: user screenrect].
lines ← Vector new: 32.
lastline ← 0.
(para nil or: [frame nil])
ifFalse: [self measureall]].
"861" Textframe$'Measuring'
[charofpoint: point andrect rect | linei leftx rightx y chari P orig r |
"Return character index of character at point" "TD enter."
linei ← 0 max: (self lineofy: point y).
y ← self yofline: linei.
linei = 0
ifTrue:
[chari ← 1.
orig ← frame minX (y + style lineheight)]
ifFalse:
[point y > (y + style lineheight)
ifTrue:
[self pointofchar: para length + 1 andrect [:r | r].
rect value← r.
↑para length + 1].
P ← self printer: false.
P scanline: lines linei at: y stopx: point x stopchar: (lines linei) stopi.
chari ← P chari.
rightx ← P rightx.
leftx ← P leftx.
(point x (leftx + rightx / 2) or: [para chari = cr])
ifTrue: [orig ← leftx y]
ifFalse:
[chari ← chari + 1.
orig ← rightx y]].
rect value← Rectangle new origin: orig extent: 0 style lineheight.
↑chari].
"655" Textframe$'Measuring'
[pointofchar: index andrect rect | linei y P orig |
"Return origin of character index"
linei ← self lineofchar: index.
y ← self yofline: linei.
index > para length
ifTrue:
[(para length = 0 or: [para para length = cr])
ifTrue: [orig ← frame minX (y + style lineheight)]
ifFalse:
[P ← self printer: false.
P scanline: lines linei at: y stopx: 9999 stopchar: index - 1.
orig ← P rightx y]]
ifFalse:
[.
P ← self printer: false.
P scanline: lines linei at: y stopx: 9999 stopchar: index.
orig ← P leftx y].
rect value← Rectangle new origin: orig extent: 0 style lineheight.
↑orig].
"70" Textframe$'Displaying'
[show | |
self measureall.
self displayall].
"69" Textframe$'Displaying'
[clear | |
(frame intersect: window) clear].
"158" Textframe$'Initialization'
[para: t1 frame: t2 style: t3 | |
para ← t1.
frame ← t2.
style ← t3.
self frame: frame window: frame para: para style: style].
"90" Textframe$'Scheduling'
[aboutToFrame | |
"My frame is about to change. I dont care."].
"374" Textframe$'Displaying'
[put: t1 at: pt centered: center | rect |
para ← t1.
window ← frame ← pt rect: 1000 1000.
para ← para asParagraph.
self measureall.
self pointofchar: para length + 1 andrect [:rect | rect].
window growto: rect corner.
center
ifTrue: [window moveby: pt - window center].
window ← window inset: 3 2.
window clear: white.
self show].
"101" Textframe$'Displaying'
[put: t1 centered: pt | |
para ← t1.
self put: para at: pt centered: true].
"118" Textframe$'Scheduling'
[takeCursor | |
user cursorloc← window center "Move the cursor to the center of my window."].
"146" Textframe$'Initialization'
[para: t1 frame: t2 | |
para ← t1.
frame ← t2.
self frame: frame window: frame para: para style: DefaultTextStyle].
"111" Textframe$'Measuring'
[lastshown | ignored |
↑self charofpoint: window corner andrect [:ignored | ignored]].
"104" Textframe$'Access to Parts'
[frame← t1 | |
frame ← t1.
window ← frame "Change my frame and window."].
"51" Textframe$'Access to Parts'
[window | |
↑window].
"157" Textframe$'Measuring'
[scrolln: n | ignored |
↑self charofpoint: frame corner x (frame origin y + (n * style lineheight)) andrect [:ignored | ignored]].
"83" AltoFileDirectory$'Alto'
[flush | |
bitsFile nil
ifFalse: [bitsFile flush]].
"689" AltoFileDirectory$'Dictionary'
[nextEntry: file | s elen |
dirFile nil
ifTrue:
[(file name compare: dirname) = 2
ifTrue:
[file serialNumber: {32768 , 100} "return system directory file. known serialNumber and leader".
file leader: 4096.
↑file].
self error: 'directory not open']
ifFalse:
[ "return the next file entry, ignore deleted entries,
and leave dirFile positioned before next entry"
[s ← dirFile nextword] whileTrueDo:
[elen ← s land: dfmask - 1.
(s allmask: dfmask)
ifTrue:
[file readFrom: dirFile.
dirFile skip: elen * 2 - (file fileSize + 2).
↑file].
"deleted entry, again"
dirFile skipwords: elen - 1].
↑false]].
"495" AltoFileDirectory$'FileDirectory'
[virtualToReal: vadr | t2 d |
"inverse of realToVirtual:" "vadr < 0 or vadr totalPages [
self error: 'illegal virtual address']" "faster to do /\ for normal Integers" "t ← vadr intdiv: diskPages.
sec ← t2 intdiv: nSectors"
vadr < diskPages
ifTrue:
[d ← 0.
t2 ← vadr]
ifFalse:
[d ← 2.
t2 ← vadr \ diskPages].
↑(t2 \ nSectors "sector" lshift: 12) + (t2 / nSectors "cylinder & head" lshift: 2) + d "disk" "(vadr / diskPages) lshift: 1"].
"336" AltoFileDirectory$'Alto'
[configure: s | nDisks nHeads nTracks |
nDisks ← s nextword "read disk configuration from a Stream:
either leader page of SysDir or beginning of DiskDescriptor".
nTracks ← s nextword.
nHeads ← s nextword.
nSectors ← s nextword.
diskPages ← nTracks * nHeads * nSectors.
totalPages ← nDisks * diskPages].
"1429" AltoFileDirectory$'Dictionary'
[Position← entry | name elen s holepos holesize entrysize nlen sk |
name ← entry name "entry format
1 n (length in words, including this one) + undeleted bit (dfmask)
2-3 serialNumber
4 version
5 0?
6 virtual address of page 0
7-n name as Bcpl string (extra 0 if length even)".
(dirFile nil and: [(name compare: dirname) = 2])
ifTrue: [↑true].
self reset.
holepos ← false.
holesize ← dfmask.
nlen ← name length.
entrysize ← self entrySize: entry "desired entry size".
[s ← dirFile nextword] whileTrueDo:
[elen ← s land: dfmask - 1 "entry length in words".
entrysize > elen
ifTrue: [sk ← 2 "entry too small"]
ifFalse:
[s = elen
ifTrue:
[sk ← 2 "deleted entry. check hole size for later inserting or renaming".
elen < holesize
ifTrue:
[holesize ← elen "hole is the smallest so far".
holepos ← dirFile position]]
ifFalse:
[ "normal entry, big enough"
dirFile skip: 10.
nlen dirFile next
ifTrue: [sk ← 13 "name wrong size"]
ifFalse:
[sk ← 13 - nlen.
(name compare: (dirFile next: nlen)) = 2
ifTrue:
[dirFile skip: sk "name match, position back to beginning of entry".
↑entry]]]] "sk is the character offset from the entry header word to the next entry".
dirFile skip: elen * 2 + sk].
holepos
ifTrue: [dirFile position← holepos - 2] "at end of dirFile".
↑false].
"224" AltoFileDirectory$'Alto'
[diskID | f u |
(f ← self oldFile: 'sys.boot' "return user name and disk name installed in O.S.") readonly.
f position← 512.
u ← f nextString.
f padNext.
u ← {u , f nextString}.
f close.
↑u].
"183" AltoFile$'DictionaryEntry'
[storeOn: s | |
s append: serialNumber.
s nextword← 1.
s nextword← 0.
s nextword← directory realToVirtual: leader.
s nextString← name.
s padNext← 0].
"103" AltoFile$'DictionaryEntry'
[fileSize | |
↑11 + (name length "sn, version, fn, leader, name" lor: 1)].
"116" AltoFilePage$'Alto'
[freePage | |
page fill: 11 to: 16 with: 255 "label for a free page: version, sn1, sn2 = 1"].
"65" AltoFilePage$'FilePage'
[serialNumber | |
↑page (13 to: 16)].
"151" AltoFilePage$'FilePage'
[init | |
page nil
ifTrue: [super init]
ifFalse: [ "nextp, backp, lnused, numch, pn"
page fill: 1 to: 10 with: 0]].
"49" AltoFilePage$'FilePage'
[address | |
↑address].
"82" AltoFilePage$'FilePage'
[length: len | |
page word: numch ← len "self header:"].
"49" AltoFilePage$'FilePage'
[headerLength | |
↑16].
"72" AltoFilePage$'FilePage'
[length | |
↑page word: numch "self header:"].
"80" AltoFilePage$'FilePage'
[lastPage | |
↑(page word: nextp) "self header:" = 0].
"168" AltoFilePage$'FilePage'
[serialNumber: sn | |
page copy: 13 to: 16 with: sn from: 1 to: 4 "page(13 to: 16) ← sn" "self header:".
page word: vn ← 1 "fixed version"].
"76" AltoFilePage$'FilePage'
[pageNumber | |
↑page word: pagen "self header:"].
"57" AltoFilePage$'FilePage'
[address: t1 | |
address ← t1].
"84" AltoFilePage$'FilePage'
[pageNumber: pn | |
page word: pagen ← pn "self header:"].
"71" FilePage$'Dictionary'
[ i ← v | |
↑page (self checkIndex: i) ← v].
"63" FilePage$'Dictionary'
[ i | |
↑page (self checkIndex: i)].
"83" FilePage$'Page'
[dataLength | |
↑512 "physical length of data in page. default"].
"152" FilePage$'Page'
[asStream: s | offset |
offset ← self headerLength.
↑s of: self dataString from: offset + 1 to: offset + self length "self dataEnd"].
"85" FilePage$'Page'
[headerLength | |
↑0 "length of stuff before data begins in page"].
"57" FilePage$'Page'
[dataBeginning | |
↑self headerLength].
"103" FilePage$'Page'
[dataMaxEnd | |
↑self headerLength "physical end of data in page" + self dataLength].
"35" FilePage$'Page'
[page | |
↑page].
"117" FilePage$'Page'
[pageLength | |
↑self headerLength "physical size of page" + self dataLength + self trailerLength].
"83" FilePage$'Page'
[trailerLength | |
↑0 "length of stuff after data ends in page"].
"89" FilePage$'File'
[doCommand: com error: s | |
↑file doCommand: com page: self error: s].
"41" FilePage$'Page'
[dataString | |
↑page].
"52" FilePage$'DictionaryEntry'
[dictionary | |
↑file].
"60" FilePage$'DictionaryEntry'
[dictionary: t1 | |
file ← t1].
"108" FilePage$'DictionaryEntry'
[name: sp | |
self init.
self serialNumber: sp 1.
self pageNumber: sp 2].
"90" FilePage$'Page'
[header: n ← v | |
↑page word: n ← v "set and return n-th header word"].
"185" FilePage$'DictionaryEntry'
[init | |
page nil
ifTrue: [page ← String new: self pageLength "self page:"].
self length: 0 "not sure who depends on this besides FileStream read:"].
"35" FilePage$'File'
[file | |
↑file].
"78" FilePage$'Page'
[length | |
self subError "logical length of data in page"].
"129" FilePage$'File'
[write | |
↑file Write: self "some files, e.g. AltoFile, will return a last empty page instead of a full one"].
"102" FilePage$'File'
[get: pn | |
self pageNumber: pn "recycle self".
self length: 0.
↑file Get: self].
"49" FilePage$'Initialize'
[page: t1 | |
page ← t1].
"91" FilePage$'Page'
[word: i | |
↑page word: self headerLength "no bounds checking" / 2 + i].
"60" FilePage$'Page'
[full | |
↑self length = self dataLength].
"135" FilePage$'Page'
[checkIndex: i | |
(i > 0 and: [i self length])
ifTrue: [↑i + self headerLength].
self error: 'illegal index'].
"95" FilePage$'Page'
[dataEnd | |
↑self headerLength "logical end of data in page" + self length].
"66" FilePage$'Dictionary'
[asStream | |
↑self asStream: Stream new].
"77" FilePage$'Page'
[address | |
self subError "page address, e.g. on a disk"].
"50" FilePage$'Page'
[length: len | |
self subError].
"52" FilePage$'File'
[endFile | |
↑file endFile: self].
"95" FilePage$'Page'
[lastPage | |
↑self pageNumber "is this last page in file?" file lastPage].
"101" FilePage$'Page'
[word: i ← v | |
↑page word: (self headerLength "no bounds checking" / 2 + i) ← v].
"49" FilePage$'Page'
[address: a | |
self subError].
"74" FilePage$'Page'
[dataEnd: pos | |
self length: pos - self headerLength].
"56" FilePage$'Page'
[serialNumber | |
↑file serialNumber].
"55" FilePage$'Page'
[serialNumber: sn | |
self subError].
"104" FilePage$'File'
[read: pn | |
self pageNumber: pn "recycle self".
self length: 0.
↑file Read: self].
"49" FilePage$'Page'
[pageNumber | |
self subError].
"102" FilePage$'Dictionary'
[reopen | |
file reopen.
file makeEntry: self "self may have been released"].
"74" FilePage$'Page'
[header: n | |
↑page word: n "return n-th header word"].
"53" FilePage$'Page'
[pageNumber: pn | |
self subError].
"49" FilePage$'Initialize'
[file: t1 | |
file ← t1].
"121" Dict$'Name-Value Access'
[ name ← value | |
↑self write: (self newEntry "replace or insert" name: name value: value)].
"71" Dict$'Entry Access'
[list: entries | |
self match: entries to: user].
"114" Dict$'Name-Value Access'
[ name | entry |
(entry ← self find: name "find")
ifTrue: [↑entry value].
↑false].
"286" Dict$'Entry Creation'
[makeEntry: entry | cl |
"entry or name"
cl ← self entryClass.
(cl false or: [(entry Is: cl)])
ifTrue: [↑entry].
"entry should not be converted or is the correct type" "convert entry from a name to an entry with that name"
↑self newEntry name: entry].
"167" Dict$'Entry Creation'
[nextEntry: entry | |
↑entry "return next name and value in entry, or false.
if insert or delete occurs after previous next, may be problem"].
"81" Dict$'Stream Access'
[position← name | |
↑self Position← self makeEntry: name].
"72" Dict$'Entry Access'
[retrieve: entry | |
↑self find: entry "match:?"].
"249" Dict$'Stream Access'
[Position← entry | |
↑self position← entry name "position to name, or position to insert place and return false if not found.
subclass had better define position← or Position← (preferably)
otherwise circularity results!!!"].
"87" Dict$'Entry Creation'
[entryClass | |
self subError "a subclass of DictionaryEntry"].
"119" Dict$'Entry Operations'
[Rename: entry from: nentry | |
self Delete: entry.
self Insert: (entry name: nentry name)].
"322" Dict$'Entry Access'
[rename: entry newName: name | nentry |
(self Find: (nentry ← self makeEntry: name "not tested"))
ifTrue: [↑self error: 'already exists' error: nentry].
(self Find: (entry ← self makeEntry: entry))
ifTrue:
[self Rename: entry from: nentry.
↑entry].
↑self error: 'not found' entry: entry].
"323" Dict$'Entry Operations'
[Match: entries to: strm | entry pat ents |
self reset "default (unordered) is to compare entire dictionary with entries".
self do:
[:entry | ents ← entries asStream.
[ents and: [(pat ← ents next)]] whileTrueDo:
[(pat match: entry)
ifTrue:
[ents ← false.
strm next← entry]]]].
"86" Dict$'Stream Access'
[append: dict | entry |
dict do: [:entry | self write: entry]].
"59" Dict$'Name-Value Access'
[lookup: name | |
↑self name].
"100" Dict$'Entry Access'
[found: entry | |
↑self nextEntry: entry "found, fill it in from dictionary"].
"60" Dict$'Entry Access'
[store: entry | |
↑self write: entry].
"66" Dict$'File-Based dictionary'
[file | |
↑false "return my file"].
"403" Dict$'Entry Access'
[match: entries to: strm | entry nentries |
"return a Set of entries which match those in entries
(can include exact values and patterns and ranges)"
((entries is: Vector) or: [(entries Is: Set)])
ifFalse: [entries ← entries inVector].
nentries ← Set new vector: entries length.
entries do: [:entry | nentries next← self makeEntry: entry].
↑self Match: nentries to: strm].
"68" Dict$'Initialize'
[init: initialSize | |
"default is to ignore"].
"163" Dict$'Entry Access'
[get: entry | |
(self Find: (entry ← self makeEntry: entry "find or insert"))
ifTrue: [↑self found: entry].
self Insert: entry.
↑entry].
"187" Dict$'Entry Access'
[insert: entry | |
(self Find: (entry ← self makeEntry: entry))
ifTrue: [↑self error: 'not inserted (already found)' entry: entry].
self Insert: entry.
↑entry].
"153" Dict$'File-Based dictionary'
[obsolete | |
self file "is my information obsolete (should I regenerate it)?"
ifTrue: [↑self file obsolete].
↑false].
"157" Dict$'Entry Access'
[find: entry | |
(self Find: (entry ← self makeEntry: entry))
ifTrue: [↑self found: entry].
↑self error: 'not found' entry: entry].
"181" Dict$'File-Based dictionary'
[release | |
"obsolete and deallocate storage, especially if connected to an external view,
e.g. a File"
self file
ifTrue: [self file release]].
"109" Dict$'Entry Operations'
[entrySize: entry | |
self subError "storage size of entry, constant or variable"].
"94" Dict$'Stream Access'
[next | |
↑self nextEntry: self newEntry "return next entry or false"].
"92" Dict$'Entry Operations'
[Find: entry | |
↑self Position← entry "is entry in dictionary?"].
"185" Dict$'Entry Access'
[delete: entry | |
(self Find: (entry ← self makeEntry: entry))
ifTrue:
[self Delete: entry.
↑entry].
↑self error: 'not deleted (not found)' entry: entry].
"68" Dict$'Stream Access'
[asStream | |
"leave position where it is"].
"78" Dict$'Entry Operations'
[error: e entry: entry | |
↑false "entry error: e"].
"188" Dict$'Entry Access'
[replace: entry | |
(self Find: (entry ← self makeEntry: entry))
ifTrue:
[self Replace: entry.
↑entry].
↑self error: 'not replaced (not found)' entry: entry].
"118" Dict$'Entry Access'
[match: entries | set |
set ← Set new vector: 50.
self match: entries to: set.
↑set contents].
"183" Dict$'Entry Access'
[write: entry | |
"replace or insert"
(self Find: (entry ← self makeEntry: entry))
ifTrue: [self Replace: entry]
ifFalse: [self Insert: entry].
↑entry].
"43" Dict$'File-Based dictionary'
[open | |
].
"112" Dict$'Name-Value Access'
[insert: name with: value | |
↑self insert: (self newEntry name: name value: value)].
"114" Dict$'Name-Value Access'
[replace: name with: value | |
↑self replace: (self newEntry name: name value: value)].
"54" Dict$'Entry Access'
[contents | |
↑self match: '*'].
"62" Dict$'Entry Access'
[create: entry | |
↑self insert: entry].
"73" Dict$'Stream Access'
[reset | |
self subError "position to beginning"].
"92" Dict$'Entry Operations'
[Delete: entry | |
self subError "entry found (next), delete it"].
"96" Dict$'Entry Operations'
[Insert: entry | |
self subError "entry not found, insert it (next)"].
"78" Dict$'Stream Access'
[position | |
self subError "current position (name)"].
"168" Dict$'File-Based dictionary'
[close | |
self obsolete
ifFalse:
[ "possible cleanup before a release"
self file
ifTrue: [self file close].
self release]].
"58" Dict$'Entry Access'
[read: entry | |
↑self find: entry].
"108" Dict$'Entry Access'
[exists: entry | |
↑self Find: (self makeEntry: entry) "doesn't initialize too much"].
"103" Dict$'File-Based dictionary'
[reopen | |
self open "reinitialize, especially if a File is involved"].
"97" Dict$'Entry Creation'
[newEntry | t1 |
↑(t1 ← self entryClass new) dictionary: self.
t1 init].
"102" Dict$'Entry Operations'
[Replace: entry | |
self subError "entry found (next), replace it's value"].
"48" Dict$'Entry Access'
[list | |
self list: '*'].
"55" AltoFile$'Dictionary'
[entryClass | |
↑AltoFilePage].
"332" AltoFileAddressTable$'Reading and writing'
[ i ← val | virt |
virt ← dp0 realToVirtual: val.
starts nil
ifTrue:
[super i ← virt.
↑val].
super i ← virt - i + starts last "superclass tries for constant runs".
offset > 0
ifTrue: [↑val].
"OK if same run"
values last← virt.
↑val "else fix new run value base"].
"113" AltoFileAddressTable$'Reading and writing'
[ i | base |
base ← super i.
↑dp0 virtualToReal: base + offset].
"304" AltoFileAddressTable$'Reading and writing'
[position← p | l |
"shortens (for file shorten)"
p > max
ifTrue: [user notify: 'invalid extension']
ifFalse:
[max ← p.
(l ← starts findSorted: max) < starts length
ifTrue:
[starts ← starts copy: 1 to: l.
values ← values copy: 1 to: l]]].
"401" RunVector$'Reading and writing'
[ i ← val | |
offset ← 0.
min nil
ifTrue:
[min ← max ← i.
starts ← i inVector.
values ← val inVector]
ifFalse:
[i - 1 max
ifTrue:
[user notify: 'RunVectors must be loaded sequentially'.
↑val].
max ← i.
val = values last
ifTrue:
[offset ← i - starts last.
↑val].
starts ← {starts , i}.
values ← {values , val}.
↑val]].
"49" RunVector$'Reading and writing'
[max | |
↑max].
"149" RunVector$'Reading and writing'
[ i | index |
index ← starts findSorted: i.
offset ← i - (starts index) "distance into run".
↑values index].
"49" RunVector$'Reading and writing'
[min | |
↑min].
"90" RunVector$'Reading and writing'
[length | |
max nil
ifTrue: [↑0].
↑max - min + 1].
"72" Array$'Reading and Writing'
[ x ← val | |
↑x subscripts: self ← val].
"60" Array$'Reading and Writing'
[ x | |
↑x subscripts: self].
"61" Array$'Copying and Altering'
[+ arg | |
↑self concat: arg].
"101" Array$'Reading and Writing'
[> v | |
"for sorting vectors by first element"
↑self 1 > (v 1)].
"101" Array$'Reading and Writing'
[< v | |
"for sorting vectors by first element"
↑self 1 < (v 1)].
"228" Array$'Reading and Writing'
[= arg | x |
arg isArray
ifTrue:
[self length arg length
ifTrue: [↑false].
(1 to: self length) do:
[:x | self x = (arg x)
ifFalse: [↑false]].
↑true]
ifFalse: [↑false]].
"77" Array$'Copying and Altering'
[growby: n | |
↑self growto: self length + n].
"72" Array$'Reading and Writing'
[last← val | |
↑self self length ← val].
"82" Array$'Reading and Writing'
[length | |
user notify: 'message not understood.'].
"146" Array$'Comparing'
[hash | |
"make sure = arrays hash =ly"
self length = 0
ifTrue: [↑17171].
↑(self 1) hash + (self self length) hash].
"102" Array$'Mapping'
[cansubscript: a | i |
self do:
[:i | (i cansubscript: a)
ifFalse: [↑false]]].
"53" Array$'Searching'
[has: x | |
↑(self find: x) 0].
"72" Array$'Copying and Altering'
[copy | |
↑self copy: 1 to: self length].
"85" Array$'Mapping'
[subscripts: x | |
"subarrays"
↑Substring new data: x map: self].
"217" Array$'Mapping'
[subscripts: x ← val | |
"subrange replacement"
self length val length
ifTrue: [user notify: 'lengths not commensurate']
ifFalse:
[val copyto: (Substring new data: x map: self).
↑val]].
"51" Array$'Compatibility'
[isIntervalBy1 | |
↑false].
"104" Array$'Searching'
[find: x | i |
(1 to: self length) do:
[:i | self i = x
ifTrue: [↑i]].
↑0].
"46" Array$'Compatibility'
[species | |
↑Vector].
"113" Array$'Copying and Altering'
[growto: n | |
↑self copy: 1 to: self length "copyto:" to: (self species new: n)].
"177" Array$'Copying and Altering'
[delete: obj | s each |
s ← (self species new: self length) asStream.
self do:
[:each | obj = each
ifFalse: [s next← each]].
↑s contents].
"61" Array$'Reading and Writing'
[last | |
↑self self length].
"57" Array$'Conversion'
[asStream | |
↑Stream new of: self].
"39" Array$'Compatibility'
[isArray | |
].
"93" Array$'Reading and Writing'
[all← val | i |
(1 to: self length) do: [:i | self i ← val]].
"58" Array$'Conversion'
[viewer | |
↑SetReader new of: self].
"52" Array$'Reading and Writing'
[first | |
↑self 1].
"81" Array$'Copying and Altering'
[grow | |
↑self growto: (4 max: self length * 2)].
"233" Array$'Permutation'
[sort | |
self sort: 1 to: self length "Permute my elements so they are sorted nondescending. Note: if I am a substring, only my map will be permuted. In certain situations, this may not be what you expect."].
"94" Array$'Permutation'
[reverse | |
↑Substring new data: self map: (self length to: 1 by: 1)].
"213" Array$'Permutation'
[permutationToSort | |
↑(self (1 to: self length "Return a Vector, permutation, such that selfpermutation is sorted nondescending. Do not alter self.") copy sort: 1 to: self length) map].
"115" Array$'Copying and Altering'
[insertNonDescending: x | |
"self is assumed to be sorted"
↑self insertSorted: x].
"83" Array$'Copying and Altering'
[copyto: t | |
↑self copy: 1 to: self length to: t].
"124" Array$'Searching'
[count: x | i n |
n ← 0.
(1 to: self length) do:
[:i | x = (self i)
ifTrue: [n ← n + 1]].
↑n].
"238" Array$'Copying and Altering'
[notNil | t i |
"copy self (which contains no falses) removing all nils"
t ← (self species new: self length - (self count: nil)) asStream.
self do:
[:i | i nil
ifFalse: [t next← i]].
↑t asArray].
"253" Array$'Copying and Altering'
[replace: a to: b by: s | x xs |
x ← self species new: self length + s length - (1 + b - a).
xs ← x asStream.
self copy: 1 to: a - 1 to: xs.
s copy: 1 to: s length to: xs.
self copy: b + 1 to: self length to: xs.
↑x].
"1203" Array$'Permutation'
[sort: i to: j | di dij dj tt ij k l n |
(n ← j + 1 "Sort elements i through j of self to be nondescending." "The prefix d means the data at." - i) 1
ifFalse:
[ "Nothing to sort." "Sort di,dj."
di ← self i.
dj ← self j.
di > dj
ifTrue:
[self swap: i with: j.
tt ← di.
di ← dj.
dj ← tt].
n = 2
ifFalse:
[ "They are the only two elements."
ij ← i + j lshift: 1 "ij is the midpoint of i and j." "Sort di,dij,dj. Make dij be their median.".
dij ← self ij.
di > dij
ifTrue:
[self swap: i with: ij.
dij ← di]
ifFalse:
[dj < dij
ifTrue:
[self swap: j with: ij.
dij ← dj]].
n = 3
ifFalse:
[ "They are the only three elements." "Find k>i and l<j such that dk,dij,dl are in reverse order. Swap k and l. Repeat this procedure until j and k pass each other."
k ← i.
l ← j.
[[self (l ← l - 1) > dij] whileTrueDo: [].
[self (k ← k + 1) < dij] whileTrueDo: [].
k l] whileTrueDo: [self swap: k with: l "Now l<k (either 1 or 2 less), and di through dl are all less than dk through dj. Sort those two segments."].
self sort: i to: l.
self sort: k to: j]]]].
"107" Array$'Searching'
[findnon: x | i |
(1 to: self length) do:
[:i | self i x
ifTrue: [↑i]].
↑0].
"152" Array$'Permutation'
[promote: t | n |
n ← self find: t.
n = 0
ifFalse:
[self (n to: 2 by: 1) ← self (n - 1 to: 1 by: 1).
self 1 ← t]].
"105" Array$'Copying and Altering'
[copy: a to: b | |
↑self copy: a to: b to: (self species new: b - a + 1)].
"338" Array$'Copying and Altering'
[without: index | s me i |
"if index in range, return self without index"
(index cansubscript: self)
ifTrue:
[s ← (self species new: self length - 1) asStream.
me ← self asStream.
(1 to: self length) do:
[:i | i = index
ifTrue: [me next]
ifFalse: [s next← me next]].
↑s asArray]].
"96" Array$'Permutation'
[swap: i with: j | t |
t ← self i.
self i ← self j.
self j ← t].
"46" Array$'Conversion'
[sum | |
↑self sumTo: 0].
"153" Array$'Copying and Altering'
[concat: arg | x s |
x ← self species new: self length + arg length.
self copyto: (s ← x asStream).
arg copyto: s.
↑x].
"67" Array$'Conversion'
[asSet | |
↑Set new of: self to: self length].
"201" Array$'Copying and Altering'
[copy: a to: b to: t | i s me |
s ← t asStream.
me ← Stream new of: self from: a to: b.
(a to: b) do: [:i | "general code wont stop at false"
s next← me next].
↑t].
"304" Array$'Searching'
[findSorted: x | lo mid hi |
" returns index of largest element x "
hi ← self length + 1.
lo ← 1.
[lo < hi] whileTrueDo:
[ "binary search; self must be sorted"
self (mid ← lo + hi / 2) > x
ifTrue: [hi ← mid]
ifFalse: [lo ← mid + 1]].
↑hi - 1 " 0resultlength "].
"85" Dictionary$'Searching'
[ name ← val | |
↑values (self findorerror: name) ← val].
"222" Dictionary$'Private'
[growto: size | name copy |
copy ← self class new init: size "create a copy of the new size".
self do: [:name | copy insert: name with: self name].
self copyfrom: copy "hash each entry into it"].
"73" Dictionary$'Searching'
[ name | |
↑values (self findorerror: name)].
"185" Dictionary$'Inserting and Deleting'
[delete: name | |
(name is: Vector)
ifTrue: [super delete: name]
ifFalse:
[values (self findorerror: name) ← nil.
super delete: name]].
"155" Dictionary$'Inserting and Deleting'
[tally: name | x |
(x ← self find: name)
ifTrue: [↑values x ← values x + 1].
self insert: name with: 1.
↑1].
"44" Dictionary$'Private'
[values | |
↑values].
"141" Dictionary$'Inserting and Deleting'
[with: names values: vals | i |
(1 to: names length) do: [:i | self insert: names i with: vals i]].
"141" Dictionary$'Inserting and Deleting'
[insertall: names | |
"default value is nil"
self insertall: names with: (Vector new: names length)].
"168" Dictionary$'Inserting and Deleting'
[insertall: names with: vals | i |
"insert many entries"
(1 to: names length) do: [:i | self insert: names i with: vals i]].
"92" Dictionary$'Private'
[swap: i with: j | |
values swap: i with: j.
super swap: i with: j].
"111" Dictionary$'Initialization'
[copyfrom: dict | |
self objects← dict objects copy.
values ← dict values copy].
"298" Dictionary$'Inversion'
[asInvertedVector | s i v |
"in form ((value, object), ...)"
s ← (Vector new: objects length) asStream.
(1 to: objects length) do:
[:i | objects i nil
ifFalse:
[v ← Vector new: 2.
v 1 ← values i.
v 2 ← objects i.
s next← v]].
↑s contents].
"131" Dictionary$'Inserting and Deleting'
[insert: name with: value | |
self insert: name.
values (self findorerror: name) ← value].
"167" Dictionary$'Inversion'
[invertto: dict | i |
(1 to: objects length) do:
[:i | objects i nil
ifFalse: [dict insert: values i with: objects i]].
↑dict].
"258" Dictionary$'Private'
[rehash | i copy |
copy ← Dictionary new init: self size "create a copy".
(1 to: objects length) "hash each entry into it" do:
[:i | objects i nil
ifFalse: [copy insert: objects i with: values i]].
self copyfrom: copy].
"92" Dictionary$'Inversion'
[invert | |
↑self invertto: (Dictionary new init: objects length)].
"102" Dictionary$'Searching'
[lookup: name | x |
(x ← self find: name)
ifTrue: [↑values x].
↑false].
"133" Dictionary$'Inversion'
[invert: obj | i |
(1 to: values length) do:
[:i | values i = obj
ifTrue: [↑objects i]].
↑false].
"181" Dictionary$'Inserting and Deleting'
[clean | name |
"release unreferenced entries"
self do:
[:name | "slick, huh"
(self name) refct = 1
ifTrue: [self delete: name]]].
"92" Dictionary$'Initialization'
[init: size | |
values ← Vector new: size.
super init: size].
"239" HashSet$'Private'
[growto: t1 | t2 t3 |
"faster insert for growing"
t2 ← self class new init: t1.
t1 < objects length
ifTrue: [self do: [:t3 | t2 insert: t3]]
ifFalse: [self do: [:t3 | t2 rawinsert: t3]].
objects ← t2 objects].
"375" HashSet$'Insertion and deletion'
[delete: obj | i j l |
(obj is: Vector)
ifTrue: [obj do: [:i | self delete: i]]
ifFalse:
[i ← self findorerror: obj.
objects i ← nil.
l ← objects length.
[objects (i ← (i = l
ifTrue: [1]
ifFalse: [i + 1])) nil] whileFalseDo:
[i = (j ← self findornil: objects i)
ifFalse: [self swap: i with: j]]]].
"43" HashSet$'Private'
[objects | |
↑objects].
"67" HashSet$'Access to parts'
[asStream | |
↑self contents asStream].
"179" HashSet$'Access to parts'
[contents | obj strm |
strm ← (Vector new: objects length) asStream.
objects do:
[:obj | obj nil
ifFalse: [strm next← obj]].
↑strm contents].
"51" HashSet$'Private'
[objects← t1 | |
objects ← t1].
"238" HashSet$'Private'
[rehash | i copy |
copy ← HashSet new init: self size "create a copy".
(1 to: objects length) "hash each entry into it" do:
[:i | objects i nil
ifFalse: [copy insert: objects i]].
objects ← copy objects].
"215" HashSet$'Private'
[sparse | i n |
n ← objects length "true if (1 max: 1/4 of table) is nil".
(1 to: objects length) do:
[:i | objects i nil
ifTrue:
[(n ← n - 4) 0
ifTrue: [↑true]]].
↑false].
"90" HashSet$'Insertion and deletion'
[insertall: objs | x |
objs do: [:x | self insert: x]].
"102" HashSet$'Initialization'
[copyfrom: hset | |
"take on state of hset"
objects ← hset objects copy].
"66" HashSet$'Private'
[swap: i with: j | |
objects swap: i with: j].
"214" HashSet$'Searching'
[findorerror: name | i |
i ← self findornil: name.
objects i = name
ifTrue: [↑i].
"allow the user to put a correct value into i"
user notify: name asString + ' cannot be found'.
↑i].
"297" HashSet$'Private'
[findorinsert: obj | i |
"insert if not found, "
i ← self findornil: obj.
objects i = obj
ifTrue: [↑i].
"found it"
self sparse
ifTrue:
[objects i ← obj.
↑i].
"insert if room"
self growto: objects length * 2 "grow".
↑self findorinsert: obj "and insert"].
"357" HashSet$'Private'
[findornil: obj | i loc |
"index if found or available slot"
loc ← obj hash \ objects length.
(1 to: objects length) do:
[:i | loc ← (loc = objects length
ifTrue: [1]
ifFalse: [loc + 1]).
objects loc nil
ifTrue: [↑loc].
objects loc = obj
ifTrue: [↑loc]].
↑1 "table full - caller must check for hit"].
"418" HashSet$'Growing and shrinking'
[packprobes | tot n l i obj t |
"(fullness, avg #probes)"
tot ← n ← 0.
l ← objects length.
(1 to: l) do:
[:i | (obj ← objects i) nil
ifFalse:
[t ← obj hash \ l.
tot ← tot + (i < t
ifTrue: [l - t + i]
ifFalse: [i - t]).
n ← n + 1]].
n = 0
ifTrue: [↑{1 , 1}].
↑{n asFloat / l , (tot asFloat / n)} "Class md packprobes(0.4921875 2.53968255 )"].
"51" HashSet$'Initialization'
[init | |
self init: 4].
"194" HashSet$'As yet unclassified'
[lookup: obj | i |
"object if found, else false (object=obj but may not obj)"
i ← self findornil: obj.
objects i = obj
ifTrue: [↑objects i].
↑false].
"76" HashSet$'Searching'
[has: obj | |
↑objects (self findornil: obj) = obj].
"80" HashSet$'Initialization'
[init: size | |
objects ← Vector new: (size max: 2)].
"88" HashSet$'Initialization'
[copy | |
" a copy of me"
↑self class new copyfrom: self].
"55" HashSet$'Access to parts'
[size | |
↑objects length].
"85" HashSet$'Insertion and deletion'
[insert: obj | i |
self findorinsert: obj.
↑obj].
"319" HashSet$'Growing and shrinking'
[shrink | table oldtable |
oldtable ← self.
table ← oldtable growto: (2 max: oldtable size / 2).
[table size = oldtable size] whileFalseDo:
[(oldtable size - table size) print.
user show: ' '.
oldtable ← table.
table ← oldtable growto: (2 max: oldtable size / 2)].
↑table].
"141" HashSet$'Searching'
[find: obj | i |
"index if found, else false"
i ← self findornil: obj.
objects i = obj
ifTrue: [↑i].
↑false].
"135" HashSet$'Private'
[rawinsert: t1 | t2 |
"assumes there is room for the new one"
t2 ← self findornil: t1.
objects t2 ← t1.
↑t2].
"184" Array$'Conversion'
[frequencies | d x |
"return a sorted vector ((freq item) (freq item) ...)"
d ← Dictionary new init: 64.
self do: [:x | d tally: x].
↑d asInvertedVector sort].
"238" Array$'Conversion'
[transform each to expr | s i |
"a copy of me with each element transformed"
s ← (self species new: self length) asStream.
(1 to: self length) do:
[:i | each value← self i.
s next← expr eval].
↑s asArray].
"147" Array$'Searching'
[find x suchThat predicate | i |
(1 to: self length) do:
[:i | x value← self i.
predicate eval
ifTrue: [↑i]].
↑0].
"259" Array$'Copying and Altering'
[insertSorted: x | a c i |
"self is assumed to be sorted"
i ← self findSorted: x.
c ← (a ← self species new: self length + 1) asStream.
self (1 to: i) copyto: c.
c next← x.
self (i + 1 to: self length) copyto: c.
↑a].
"251" Array$'Searching'
[all variable suchThat expr | s i x |
"a copy of some of me"
s ← (self species new: self length) asStream.
(1 to: self length) do:
[:i | x ← self i.
variable value← x.
expr eval
ifTrue: [s next← x]].
↑s contents].
"159" Array$'Searching'
[first x suchThat predicate | i |
(1 to: self length) do:
[:i | x value← self i.
predicate eval
ifTrue: [↑self i]].
↑false].
"157" Array$'Conversion'
[sumTo: subTotal | x |
"add all my elements to this subTotal (usually 0 or 0.0)"
self do: [:x | subTotal ← subTotal + x].
↑subTotal].
"94" AltoFile$'DictionaryEntry'
[init | |
super init.
pageAddresses ← AltoFileAddressTable new].
"259" AltoFile$'File'
[doCommand: com page: page error: e | |
error ← nullString.
(self dskprim: directory diskNumber address: page address command: com page: page page)
ifTrue: [↑page].
error ← self errorString: error "set by dskprim:...".
↑self error: e].
"613" AltoFile$'Alto'
[errorString: status | t s |
status = 1 "see Alto hardware manual for details on error word format"
ifTrue: [↑'primitive failure, bad args?'].
s ← Stream default.
s append: #('' 'hardware error or sector overflow' 'check error' 'disk command specified illegal sector' ) (1 + (status land: 3)).
(1 to: 6) do:
[:t | (status allmask: (128 lshift: 1 - t))
ifTrue:
[s space.
s append: #('seek failed, possible illegal track' 'seek in progress' 'disk unit not ready' 'hardware late' 'hardware not transferring' 'checksum' ) t]].
s space.
s append: status base8.
↑s contents].
"39" AltoFile$'Alto'
[leader | |
↑leader].
"61" AltoFile$'Alto'
[pageAddresses: t1 | |
pageAddresses ← t1].
"897" AltoFile$'File'
[Write: page | nextPage labelDirty returnPage |
((labelDirty ← page lastPage) and: [page full])
ifTrue:
[returnPage ← nextPage ← self newPage "last page can't be full, so glue on another page".
directory allocate: nextPage after: (directory realToVirtual: page address).
nextPage init.
nextPage header: backp ← page address.
nextPage pageNumber: (lastpn ← page pageNumber + 1).
nextPage serialNumber: serialNumber.
nextPage doCommand: CWW error: 'writePage: (allocate)' "link to current page".
page header: nextp ← nextPage address.
pageAddresses
ifTrue: [pageAddresses lastpn ← nextPage address] "growSmalltalkBy:"]
ifFalse: [returnPage ← page] "whenever a last (or second last) page is written, write label also".
self doCommand: (labelDirty
ifTrue: [CWW]
ifFalse: [CCW]) page: page error: 'writePage:'.
type ← read + write.
↑returnPage].
"100" AltoFile$'Dictionary'
[open | |
type ← read "don't find last page immediately. for later close"].
"391" 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)])]].
"787" AltoFile$'File'
[endFile: page | nextPage pn |
page false
ifTrue: [pn ← 1 "free all of file"]
ifFalse:
[page full
ifTrue:
[nextPage ← self Write: page "if page was a full last page, next is an empty (and now last) page".
nextPage lastPage
ifTrue: [↑nextPage].
page ← self read: page pageNumber + 1.
page empty
ifTrue: [↑page].
page length: 0].
page header: nextp ← 0.
self Write: page "free rest of file".
pn ← page pageNumber].
lastpn ← false "reset by readPage:".
[lastpn false and: [(nextPage ← self read: (pn ← pn + 1))]] whileTrueDo:
[nextPage init.
nextPage freePage.
nextPage doCommand: CWW error: 'endFile:'.
directory deallocate: nextPage].
page
ifTrue: [pageAddresses position← lastpn ← page pageNumber].
↑page].
"47" AltoFile$'Alto'
[leader: t1 | |
leader ← t1].
"838" AltoFile$'File'
[Read: page | pn p palen |
pn ← page pageNumber.
pageAddresses
ifTrue: [palen ← pageAddresses length]
ifFalse:
[pn = 0
ifTrue: [palen ← 0]
ifFalse: [↑false]].
((palen min: pn) to: pn) do:
[:p | page pageNumber: p "set up page for checking" "zeroed by machine code
header: nextp ← [p < palen [pageAddresses(p+1)] 0];
header: backp ← [p=0 [0]; =1[leader] pageAddresses(p-1)];
length: [p < palen [page dataLength] 0];".
page address: (p = 0
ifTrue: [leader]
ifFalse: [pageAddresses p]).
page doCommand: CCR error: 'readPage:'.
page lastPage
ifTrue:
[(lastpn ← p) < pn
ifTrue: [↑false]]
ifFalse:
[(p palen and: [pageAddresses])
ifTrue: [pageAddresses (p + 1) ← page header: nextp] "no need to store if already known or no page table"]].
↑page].
"239" AltoFile$'DictionaryEntry'
[readFrom: s | |
serialNumber ← s next: 4 "read file description from SysDir".
s skip: 4 "self version: s nextword. s skip: 2".
leader ← directory virtualToReal: s nextword.
name ← s nextString.
s padNext].
"306" AltoFile$'File'
[Get: page | p pn |
pn ← page pageNumber.
(self Read: page)
ifTrue: [↑page].
"page now contains last page"
(lastpn to: pn - 1) do:
[:p | page pageNumber: p.
page length: page dataLength "this writes current and allocates next (empty) page".
page ← self Write: page].
↑page].
"440" AltoFile$'File'
[classInit | |
AltoFilePool declare: #(CRR CCR CCW CWW ) as: #(18496 18512 18520 18536 ) "before filing in:
Smalltalk declare: AltoFilePool as: (SymbolTable new init: 32)" "disk commands".
AltoFilePool declare: #(dfmask boffset dirname ) as: #(1024 32 'SysDir.' ) "bit means active directory entry" "byte offset of bit table in DiskDescriptor".
AltoFilePool declare: #(nextp backp numch pagen vn ) as: #(1 2 4 5 6 )].
"100" AltoFile$'Dictionary'
[close | |
type ← self updateLeader: (self read: 0) "to look at at reopen"].
"388" AltoFile$'Alto'
[dskprim: diskNumber address: a command: com page: string | |<primitive: 79>
"0/1" "starting Alto disk address" "disk command (usually CCR, CCW, CWW)" "string containing label and data"
error ← 1 "if disk routine encounters an error,
error ← (DCB status, to be interpreted by errorString:).
false" "if other error occurs, e.g. nil instead of Integer...".
↑false].
"64" AltoFile$'File'
[findLastPage | |
self read: 20000.
↑lastpn].
"540" AltoFile$'Alto'
[updateLeader: page | s time lastwrite |
time ← user timewords "see <Alto>AltoFileSys.D, (p.3 leader page) for further info".
s ← page asStream.
(type anymask: write)
ifTrue:
[directory flush "set creation/write/read date and file name".
lastwrite ← time.
s append: time.
s append: time.
s append: time.
name empty
ifFalse: [s nextString← name]]
ifFalse:
[ "remember creation, skip write, update read date"
lastwrite ← s next: 4.
s skip: 4.
s append: time].
self Write: page.
↑lastwrite].
"63" File$'DictionaryEntry'
[printon: strm | |
strm append: name].
"103" File$'DictionaryEntry'
[init | |
lastpn ← false.
error ← nullString.
serialNumber ← String new: 4].
"170" File$'File Length'
[length | page |
page ← self read: self lastPage "length in characters" "defeat ST76 optimization".
.
↑lastpn - 1 * page dataLength + page length].
"86" File$'FileDirectory'
[rename: newName | |
↑directory rename: self newName: newName].
"64" File$'FilePage'
[get: pn | |
↑self Get: (self makeEntry: pn)].
"37" File$'FilePage'
[error | |
↑error].
"237" FileStream$'File'
[settopage: p char: c | |
(self read: p asSmall "mainly for compatibility, since page sizes may vary.
in general, use position←, wordposition←")
ifTrue: [self skip: c asSmall]
ifFalse: [self error: 'no page']].
"73" FileStream$'Stream'
[ i ← v | |
self position← i - 1.
↑self next← v].
"66" FileStream$'Stream'
[ i | |
self position← i - 1.
↑self next].
"93" FileStream$'File'
[flush | |
self obsolete
ifTrue: [↑page].
self fixEnd.
↑page write].
"277" FileStream$'Filin/Filout'
[filin | p |
user cr.
self readonly.
self end
ifTrue: [self file error: 'empty file']
ifFalse:
[[p ← self nextParagraph] whileTrueDo:
[FilinSource ← self.
user print: nil p text.
user space].
self close.
FilinSource ← nil]].
"70" FileStream$'Stream'
[wordposition← w | |
↑self position: w size: 2].
"132" FileStream$'Print'
[printout: source | t2 |
(t2 ← self asPressPrinter) stamp.
t2 printchanges: source.
t2 close.
t2 toPrinter].
"66" FileStream$'Stream'
[position← p | |
↑self position: p size: 1].
"166" FileStream$'File'
[shorten | |
self on: "normally called by close and not directly by user"
(page dataEnd: (limit ← position).
page endFile).
position ← limit].
"126" FileStream$'Filin/Filout'
[filout: source | t2 |
(t2 ← self asParagraphPrinter) stamp.
t2 printchanges: source.
t2 close].
"110" FileStream$'Stream'
[printon: strm | |
super printon: strm.
strm append: ' on '.
self file printon: strm].
"302" FileStream$'Print'
[toPrinter | pp p |
user displayoffwhile [
"print an unformatted or Bravo file as a press file"
(pp ← (self directory file: self name + 'Press') asPressPrinter.
self readonly.
[p ← self nextParagraph] whileTrueDo: [pp print: p].
self close)].
pp close.
pp toPrinter].
"267" FileStream$'Access Modes'
[writeshorten | |
self setMode: write + shorten "allow write and shorten File upon closing. in general, this would be faster for overwriting Files since pages might not have to be read first. at present, treated same as readwriteshorten"].
"170" FileStream$'Stream'
[end | |
self reopen.
position < limit
ifTrue: [↑false].
(self read: page pageNumber + 1)
ifTrue: [↑position = limit "page empty"].
↑true].
"501" FileStream$'Stream'
[append: s | |
"try to make some special cases go much faster"
(s is: String)
ifTrue:
[s length > 80
ifTrue:
[self writeString: s from: 1 to: s length.
↑s]]
ifFalse:
[(s is: Stream)
ifTrue:
[(s limit - s position > 80 and: [(s asArray is: String)])
ifTrue:
[self writeString: s asArray from: s position + 1 to: s limit.
↑s]]
ifFalse:
[(s is: FileStream)
ifTrue:
[self writeFile: s for: nil.
↑s]]].
↑super append: s].
"48" FileStream$'Dictionary'
[file | |
↑page file].
"166" FileStream$'Stream'
[next: n from: strm | |
(n > 80 and: [(strm is: FileStream)])
ifTrue: [self writeFile: strm for: n]
ifFalse: [↑super next: n from: strm]].
"135" FileStream$'Stream'
[length | |
page lastPage
ifTrue: [↑page pageNumber - 1 * page dataLength + page length].
↑self file length].
"48" FileStream$'Dictionary'
[obsolete | |
↑dirty].
"78" FileStream$'Stream'
[word: i | |
self wordposition← i - 1.
↑self nextword].
"76" FileStream$'Filin/Filout'
[filout | |
self filout: Changes contents sort].
"134" FileStream$'Stream'
[contents | s |
self readonly "read all of a File".
self reset.
s ← self next: self length.
self close.
↑s].
"85" FileStream$'Stream'
[word: i ← v | |
self wordposition← i - 1.
↑self nextword← v].
"251" FileStream$'Initialize'
[on: t1 | |
"some page from a File, usually page 1, or another FileStream"
page ← t1.
(page is: FileStream)
ifTrue: [page ← page page].
page asStream: self.
externalViews insert: self "obsolete flag".
dirty ← false].
"653" FileStream$'Stream'
[skip: n | p plen |
n = 0
ifFalse:
[self reopen.
p ← position + n.
(n > 0
ifTrue: [p limit]
ifFalse:
[self fixEnd "important on last page".
p < page dataBeginning])
ifTrue:
[plen ← page dataLength "simply: self position ← self position + n.
however, since we are incurable optimizers..." "assume p is not Large, otherwise use intdiv:".
p ← p - page dataBeginning.
(self positionPage: page pageNumber + (n < 0
ifTrue: [p + 1 / plen - 1]
ifFalse: [p / plen]) character: p \ plen)
ifFalse: [self error: 'cannot skip ' + n asString]]
ifFalse: [ "same page"
position ← p]]].
"313" FileStream$'Stream'
[settoend | |
self reopen "self position ← self length" "make sure file is open so lastPage is correct" "when writing on the last page, lastPage may be too small".
(self read: (self file lastPage max: page pageNumber))
ifTrue: [position ← limit]
ifFalse: [self error: 'settoend???']].
"504" FileStream$'Stream'
[into: s endError: err | charsRead len t |
len ← s length.
len > 80
ifTrue: [charsRead ← len - (self readString: s from: 1 to: len)]
ifFalse:
[ "in line: super into: s endError: err"
charsRead ← 0 "read until count or stream is exhausted".
[charsRead < len and: [(t ← self next)]] whileTrueDo: [s (charsRead ← charsRead + 1) ← t]].
err
ifTrue:
[charsRead = len
ifTrue: [↑s].
user notify: 'only read first ' + charsRead asString]
ifFalse: [↑charsRead]].
"339" FileStream$'Stream'
[pastend← v | |
self writing
ifTrue:
[self reopen
ifTrue: [↑self next← v].
(limit < page dataMaxEnd or: [(self nextPage
ifTrue: [position = limit]
ifFalse: [self error: 'could not get page'])])
ifTrue: [limit ← page dataMaxEnd].
↑self next← v]
ifFalse: [self error: 'no writing allowed']].
"134" FileStream$'Stream'
[pastend | |
(self reopen or: [(page lastPage false and: [self nextPage])])
ifTrue: [↑self next].
↑false].
"59" FileStream$'Stream'
[position | |
↑self positionSize: 1].
"103" FileStream$'Stream'
[reset | |
(self read: 1) "self position ← 0"
ifFalse: [self error: 'reset']].
"249" FileStream$'Dictionary'
[close | |
self obsolete
ifFalse:
[self writing
ifTrue:
[(rwmode anymask: shorten)
ifTrue: [self shorten]
ifFalse: [self flush]].
dirty ← limit ← 0.
self file close.
externalViews delete: self]].
"873" FileStream$'Fast Access'
[readString: s from: start to: stop | len charsLeft |
self readonly "for reading a subrange of a large String from a file (quickly, if BitBlt is used);
called by FileStream into:endError:".
self reopen.
start ← start - 1.
charsLeft ← stop - start "keep going until all of the requested characters are copied or
until end of file. if end of current page only, next page is read.".
[charsLeft > 0 and: [self end false]] whileTrueDo:
[len ← limit - position "len = # characters of current page that will fit in String" min: charsLeft.
charsLeft ← charsLeft - len "copy subrange of page into String".
s copy: start + 1 to: start + len with: array from: position + 1 to: position + len "update source and destination pointers".
position ← position + len.
start ← start + len "return the number of characters not read"].
↑charsLeft].
"1079" FileStream$'File'
[read: pn | p |
pn < 1 "normally accessed by nextPage, position:size:, reopen, reset, settoend"
ifTrue: [↑false].
self obsolete
ifTrue:
[page reopen "reopen the file, (re)read the page".
(p ← page read: pn)
ifTrue: [self on: p]
ifFalse: [↑false]]
ifFalse:
[(pn = page pageNumber and: [(page length > 0 or: [position > page dataBeginning])])
ifTrue:
[self fixEnd.
page asStream: self]
ifFalse:
[ "current page has wrong page number or is empty (possibly from error)"
self writing
ifTrue:
[((pn > page pageNumber and: [page full false])
ifTrue: [position ← page dataMaxEnd "fill up last page when positioning past it"]
ifFalse: [ "otherwise, fixEnd"
position > page dataEnd])
ifTrue: [page dataEnd: (limit ← position)].
p ← page write.
p pageNumber = pn
ifFalse: [ "already have next page, e.g. at end of AltoFile" "read it or create it"
p ← page get: pn]]
ifFalse: [p ← page read: pn].
p
ifTrue: [(page ← p) asStream: self]
ifFalse: [↑false]]]].
"58" FileStream$'Fast Access'
[streamPosition | |
↑position].
"78" FileStream$'Fast Access'
[streamPosition← t1 | |
position ← t1.
↑position].
"1234" FileStream$'Fast Access'
[writeFile: fs for: charsLeft | start len maxLimit |
"for copying part or all of one file to another (quickly, if BitBlt is used);
charsLeft nil means copy until end, otherwise a number of characters.
called by FileStream append:, next:from:"
self writing
ifFalse: [self error: 'read only!'].
self reopen.
fs readonly.
fs reopen.
maxLimit ← page dataMaxEnd "keep going until all of the requested characters are copied or
until end of file. if end of current page only, next page is read.".
[(charsLeft nil or: [charsLeft > 0]) and: [fs end false]] whileTrueDo:
[ "end of current destination page?"
position = maxLimit
ifTrue: [self nextPage].
start ← fs streamPosition.
len ← maxLimit - position min: fs limit - start.
charsLeft nil
ifFalse:
[len ← len min: charsLeft.
charsLeft ← charsLeft - len] "copy subrange of source page into destination page".
array copy: position + 1 to: position + len with: fs asArray from: start + 1 to: start + len "update source and destination pointers".
fs streamPosition← start + len.
position ← position + len.
position > limit
ifTrue: [limit ← position]].
↑charsLeft nil
ifTrue: [0]
ifFalse: [charsLeft]].
"869" FileStream$'Fast Access'
[writeString: s from: start to: stop | len charsLeft maxLimit |
"for writing a subrange of a large String onto a file (quickly, if BitBlt is used);
called by FileStream append:"
self writing
ifFalse: [self error: 'read only!'].
self reopen.
start ← start - 1.
charsLeft ← stop - start.
maxLimit ← page dataMaxEnd "keep going until all of the requested characters are copied".
[charsLeft > 0] whileTrueDo:
[ "end of current page?"
position = maxLimit
ifTrue: [self nextPage].
len ← maxLimit - position min: charsLeft.
charsLeft ← charsLeft - len "copy subrange of String into page".
array copy: position + 1 to: position + len with: s from: start + 1 to: start + len "update source and destination pointers".
start ← start + len.
position ← position + len.
position > limit
ifTrue: [limit ← position]].
↑s].
"449" FileStream$'File'
[positionPage: pn character: c | |
(self read: pn) "normally accessed by position:size:, skip:"
ifTrue:
[position ← position + c "c assumed between 0 and page dataLength. position, limit were set in on:".
(position limit or: [self writing])
ifTrue: [↑true].
position ← limit.
↑false]
ifFalse:
[c = 0
ifTrue: [↑self positionPage: pn - 1 "try end of previous page" character: page dataLength].
↑false]].
"306" FileStream$'File'
[pad: size | rem |
rem ← ( "skip to next boundary of size and return how many characters skipped"
(page dataLength \ size = 0
ifTrue: [position - page dataBeginning]
ifFalse: [self position]) \ size) asSmall.
rem = 0
ifTrue: [↑0].
self skip: size - rem.
↑size - rem].
"322" FileStream$'File'
[pad: size with: val | rem |
rem ← ( "pad to next boundary of size and return how many characters padded"
(page dataLength \ size = 0
ifTrue: [position - page dataBeginning]
ifFalse: [self position]) \ size) asSmall.
rem = 0
ifTrue: [↑0].
self next: (size - rem) ← val.
↑size - rem].
"365" FileStream$'Fast Access'
[readPages: n | charsLeft len s |
len ← n * page dataLength "read n pages of characters".
s ← String new: len "charsRead ← self into: s endError: false.".
charsLeft ← self readString: s from: 1 to: len.
charsLeft = 0
ifTrue: [↑s].
"read len chars" "return characters read only before end of file"
↑s copy: 1 to: len - charsLeft].
"231" FileStream$'Filin/Filout'
[nextParagraph | text |
self end "Bravo format paragraph (or self contents if no trailer)"
ifTrue: [↑false].
text ← self upto: 26 "ctrl-z".
↑text asParagraph applyBravo: self at: 1 to: text length].
"37" FileStream$'File'
[page | |
↑page].
"147" FileStream$'File'
[fixEnd | |
(self writing and: [position > page dataEnd])
ifTrue: [page dataEnd: (limit ← position) "fix the end of page"]].
"133" FileStream$'Print'
[printoutclass: class | t2 |
(t2 ← self asPressPrinter) stamp.
t2 printclass: class.
t2 close.
t2 toPrinter].
"92" CodeWindow$'Initialization'
[classInit | |
stdTemplates ← (0 0 rect: 36 36) inVector].
"90" CodeWindow$'Initialization'
[hardcopy: p | pane |
panes do: [:pane | pane hardcopy: p]].
"67" CodePane$'Window protocol'
[show | |
frame outline.
pared show].
"127" CodePane$'Browse/Notify protocol'
[formerly: oldpara | |
"should not be called before 'showing:'"
pared formerly: oldpara].
"157" CodePane$'Browse/Notify protocol'
[reflects: selection | |
"am I trying to show the code of selectorPane selection?"
↑class nil and: [selection > 0]].
"70" CodePane$'Browse/Notify protocol'
[oldContents | |
↑pared formerly].
"236" CodePane$'Browse/Notify protocol'
[compile: parag in: defaultClass under: category | |
↑(self compiler: defaultClass) new compile: parag in: (class nil
ifTrue: [defaultClass]
ifFalse: [class]) under: category notifying: self].
"95" CodePane$'Initialization'
[class: t1 selector: t2 para: para | |
class ← t1.
selector ← t2].
"40" CodePane$'Initialization'
[init | |
].
"56" CharLine$'Access to Parts'
[stopi← t1 | |
stopi ← t1].
"134" CharLine$'Initialization'
[starti: t1 stopi: t2 spaces: t3 padwidth: t4 | |
starti ← t1.
stopi ← t2.
spaces ← t3.
padwidth ← t4].
"91" CharLine$'Operations'
[slide: delta | |
starti ← starti + delta.
stopi ← stopi + delta].
"149" CharLine$'Operations'
[= line | |
↑(starti = line starti and: [stopi = line stopi]) and: [(spaces = line spaces and: [padwidth = line padwidth])]].
"54" CharLine$'Access to Parts'
[padwidth | |
↑padwidth].
"48" CharLine$'Access to Parts'
[stopi | |
↑stopi].
"50" CharLine$'Access to Parts'
[spaces | |
↑spaces].
"50" CharLine$'Access to Parts'
[starti | |
↑starti].
"954" CodePane$'Window protocol'
[yellowbug | t1 |
(t1 ← editmenu bug) = 5
ifTrue: [self doit]
ifFalse:
[t1 = 1
ifTrue: [scrollBar hidewhile [(pared again)]]
ifFalse:
[t1 = 2
ifTrue: [pared copyselection]
ifFalse:
[t1 = 3
ifTrue: [pared cut]
ifFalse:
[t1 = 4
ifTrue: [pared paste]
ifFalse:
[t1 = 6
ifTrue:
[pared formerly
ifTrue: [scrollBar hidewhile [
((selectorPane compile: pared contents)
ifTrue: [pared formerly: false])]]
ifFalse: [frame flash]]
ifFalse:
[t1 = 7
ifTrue: [pared undo]
ifFalse:
[t1 = 8
ifTrue:
[pared formerly
ifTrue:
[pared Deletion← pared contents.
scrollBar hidewhile [(self showing: pared formerly)]]
ifFalse: [frame flash]]
ifFalse:
[t1 = 9
ifTrue: [pared realign]]]]]]]]]].
"149" CodePane$'Browse/Notify protocol'
[execute: parseStream for: codePane | |
"as my own selectorPane"
↑self execute: parseStream in: false to: nil].
"260" CodePane$'Browse/Notify protocol'
[execute: parseStream in: context to: receiver | cls |
cls ← (context
ifTrue: [context mclass]
ifFalse: [receiver class]).
↑(self compiler: cls) new evaluate: parseStream in: context to: receiver notifying: self].
"60" CodePane$'Browse/Notify protocol'
[interactive | |
↑true].
"144" CodePane$'Browse/Notify protocol'
[compile: parag | |
"as my own selectorPane"
↑self compile: parag in: class under: 'As yet unclassified'].
"234" CodePane$'Browse/Notify protocol'
[notify: errorString at: position in: stream | |
pared fintype.
pared selectRange: (position to: position).
pared replace: ('' + errorString + '.') asParagraph.
pared selectAndScroll.
↑false].
"189" CodePane$'Window protocol'
[frame← t1 | |
frame ← t1.
pared nil "Change my frame and that of my pared (if any)."
ifFalse:
[pared frame← frame.
scrollBar on: frame from: pared]].
"64" TextImage$'ACCESS TO PARTS'
[formerly: t1 | |
oldEntity ← t1].
"247" TextImage$'EDITING'
[fixframe: f | dy |
dy ← (frame nil
ifTrue: [0]
ifFalse: [self frameoffset]).
window ← f copy.
frame ← Rectangle new origin: window origin + (2 dy) extent: window width - 4 9999.
self measureall.
↑window].
"1197" TextImage$'SELECTION'
[selecting | pt t h1 h2 c h drag2 selection |
t ← self charofpoint: (pt ← user mp) andrect [:h1 | h1].
self complement: off.
self fintype.
(t = c1 and: [c1 = c2])
ifTrue:
[[ "bugged hairline - maybe double-bug"
user redbug and: [t = (self charofpoint: user mp andrect [:h | h])]] whileTrueDo: [ "wait for unclick or drawing selection"
].
user redbug false
ifTrue:
[self selectword.
self select.
↑true]].
sel ← on "draw out and record (c1 and c2) a selection".
c1 ← c2 ← t.
h2 ← h1 + (1 0).
self complementfrom: h1 to: h2.
selection ← true.
[pt ← user mpnext] whileTrueDo:
[c ← self charofpoint: pt andrect [:h | h].
c1 = c2
ifTrue: [drag2 ← c c2].
drag2
ifTrue:
[c < c1
ifTrue: [self pointofchar: (c ← c1) andrect [:h | h]].
self complementfrom: h to: h2.
c2 ← c.
h2 ← h]
ifFalse:
[c > c2
ifTrue: [self pointofchar: (c ← c2) andrect [:h | h]].
self complementfrom: h1 to: h.
c1 ← c.
h1 ← h].
h1 = h2
ifTrue: [self complementfrom: h1 to: (h2 ← h1 + (1 0))]].
drag2
ifFalse: [ "get rid of extra line in backwards select"
self complementfrom: h2 - (1 0) to: h2]].
"740" TextImage$'SCROLLING'
[scrollby: n | oldw topline |
(n > 0 and: [n + (topline ← self lineofy: window minY) > lastline])
ifTrue: [n ← lastline - topline].
n ← n * self lineheight max: self frameoffset.
frame moveby: 0 (0 - n).
n abs window height
ifTrue:
[self show.
self select]
ifFalse:
[ "need only to reshow part of window"
oldw ← window.
window ← (n < 0
ifTrue: [window inset: 0 0 and: [0 (0 - n)]]
ifFalse: [window inset: 0 n and: [0 0]]).
window blt: window origin - (0 n) mode: storing.
n < 0
ifTrue: [window corner y← window origin y - n]
ifFalse: [window origin y← self yofline: (self lineofy: window corner y - n)].
self displayall.
self select.
window ← oldw]].
"1453" TextImage$'SELECTION'
[selectword | a b dir t level open close s slen t10 |
a ← b ← dir ← 1 "Select bracketed or word range, as a result of double-bug.".
s ← para text.
slen ← s length.
level ← 1.
open ← '([{<''"
'.
close ← ')]}>''"
'.
c1 1
ifTrue:
[dir ← 1.
t ← c1]
ifFalse:
[c1 > slen
ifTrue: [t ← c1 - 1]
ifFalse:
[t ← open find: (a ← para (c1 - 1)).
t > 0
ifTrue:
[ "delim on left"
dir ← 1.
b ← close t.
t ← c1 - 1]
ifFalse:
[ "match to the right"
t ← close find: (a ← para c1).
t > 0
ifTrue:
[ "delim on right"
dir ← 1.
b ← open t.
t ← c1]
ifFalse:
[ "match to the left"
a ← 1.
t ← c1]]]] "no delims - select a token".
[level = 0 or: [(dir = 1
ifTrue: [t slen]
ifFalse: [t 1])]] whileFalseDo:
[(t10 ← s (t ← t + dir)) = b
ifTrue: [level ← level - 1]
ifFalse:
[ "leaving nest"
t10 = a
ifTrue: [level ← level + 1]
ifFalse:
[ "entering nest"
.
a = 1
ifTrue:
[(s t) tokenish
ifTrue:
[ "token check goes left "
t = 1
ifTrue:
[c1 ← dir ← 1.
t ← c2]]
ifFalse:
[dir = 1
ifTrue:
[c1 ← t + 1.
dir ← 1.
t ← c2 - 1]
ifFalse: [ "then right"
level ← 0]]]]]].
level 0
ifTrue: [t ← t + dir].
dir = 1
ifTrue: [c2 ← t min: slen + 1]
ifFalse: [c1 ← t + 1]].
"311" TextImage$'SELECTION'
[selectAndScroll | l dy c1y ignored |
l ← self lineheight.
self select.
c1y ← (self pointofchar: c1 andrect [:ignored | ignored]) y.
dy ← c1y - window minY.
dy 0
ifTrue: [dy ← c1y + l - 1 - window maxY max: 0].
dy 0
ifTrue: [self scrollby: dy abs + l - 1 / l * dy sign]].
"92" TextImage$'ACCESS TO PARTS'
[frameoffset | |
↑frame minY "a useful number" - window minY].
"513" TextImage$'SELECTION'
[reversefrom: char1 to: char2 | h1 h2 rect |
self pointofchar: char1 andrect [:rect | rect] "Complement the dots corresponding to the the lines and part-lines of the paragraph between the left edge of char1 and the left edge of char2. If char1 = char2, this is sort of a no-op. If char1 > char2, this is undefined.".
h1 ← rect.
char2 = char1
ifTrue: [h2 ← h1 + (1 0)]
ifFalse:
[self pointofchar: char2 andrect [:rect | rect].
h2 ← rect].
self complementfrom: h1 to: h2].
"121" TextImage$'EDITING'
[copyselection | |
Scrap ← self selection "copy the current selection and store it in the Scrap."].
"211" TextImage$'Editing'
[againOnce | t |
t ← para findString: Deletion startingAt: c2.
t = 0
ifTrue: [↑false].
self unselect.
c1 ← t.
c2 ← c1 + Deletion length.
self replace: Scrap.
self selectAndScroll].
"69" TextImage$'ACCESS TO PARTS'
[begintypein← t1 | |
begintypein ← t1].
"165" TextImage$'SYSTEM'
[copy | t |
t ← TextImage new paragraph: para copy frame: frame copy style: style copy.
t c1← c1.
t c2← c2.
t begintypein← begintypein.
↑t].
"1341" 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"
more next← char]]].
self replace: more.
c1 ← c2.
self selectAndScroll].
"175" TextImage$'EDITING'
[cut | |
self fintype "cut out the current selection and redisplay the paragraph.".
self replace: nullString.
self selectAndScroll.
Scrap ← Deletion].
"51" TextImage$'ACCESS TO PARTS'
[contents | |
↑para].
"224" TextImage$'SELECTION'
[complement: nsel | |
nsel = sel
ifFalse:
[ "already that way"
(nsel = on and: [(user rawkbck or: [user redbug])])
ifFalse:
[ "slippage"
sel ← nsel.
self reversefrom: c1 to: c2]]].
"1229" TextImage$'EDITING'
[checklooks | t val mask range |
t ← #(166 150 137 151 230 214 201 215 135 159 144 143 128 127 129 131 180 149 199 223 208 207 192 191 240 226 ) find: user kbck.
t = 0
ifTrue: [↑false].
user kbd.
oldEntity
ifFalse:
[oldEntity ← para.
para ← para copy].
t = 25
ifTrue: [para ← para toBravo]
ifFalse:
[ "ctl-T"
t = 26
ifTrue: [para ← para fromBravo]
ifFalse:
[ "ctl-F"
.
val ← #(1 2 4 256 1 2 4 256 0 16 32 48 64 80 96 112 128 144 160 176 192 208 224 240 ) t "ctl-b i - x B I X" "ctl-0 1 ... 9" "ctl-shift-0 1 ... 5".
val = 256
ifTrue:
[mask ← 255.
val ← 0]
ifFalse:
[ "reset all"
val < 0
ifTrue:
[mask ← 0 - val.
val ← 0]
ifFalse:
[ "reset emphasis"
(val > 0 and: [val < 16])
ifTrue: [mask ← val]
ifFalse: [ "set emphasis"
mask ← 240]]] "set font".
para maskrun: c1 to: c2 - 1 under: mask to: val "fix paragraph".
mask = 240
ifTrue: [self replace: c1 to: c2 - 1 "remeasure if changing fonts" with: (para copy: c1 to: c2 - 1)]
ifFalse: [ "otherwise just redisplay lines"
self displaylines: (self lineofchar: c1) to: (self lineofchar: c2)].
self select]]].
"108" TextImage$'SELECTION'
[selection | |
para text empty
ifTrue: [↑para copy].
↑para copy: c1 to: c2 - 1].
"61" TextImage$'SELECTION'
[complement | |
self complement: on].
"57" TextImage$'SELECTION'
[selectRange | |
↑c1 to: c2 - 1].
"117" TextImage$'SELECTION'
[selectRange: r | |
self complement: off.
c1 ← r start.
c2 ← r stop.
self complement: on].
"245" TextImage$'INIT'
[classInit | |
bs ← 8.
ctlw ← 145.
esc ← 160.
cut ← 173.
paste ← 158.
Scrap ← Deletion ← nullString.
on ← 1.
off ← 0.
paragraphmenu ← Menu new string: 'again
copy
cut
paste
doit
compile
undo
cancel
align
fit
resize
'].
"48" TextImage$'INIT'
[close | |
superimage ← nil].
"136" TextImage$'ACCESS TO PARTS'
[height | rect |
self pointofchar: para length + 1 andrect [:rect | rect].
↑rect corner y - frame minY].
"211" TextImage$'INIT'
[paragraph: t1 frame: t2 style: t3 | |
para ← t1.
frame ← t2.
style ← t3.
nil para
ifTrue: [para ← nullString].
c1 ← c2 ← begintypein ← 1.
self para: para frame: frame style: style].
"61" TextImage$'ACCESS TO PARTS'
[Deletion← s | |
Deletion ← s].
"1156" TextImage$'SELECTION'
[complementfrom: hair1 to: hair2 | temprect |
hair1 minY "Complement the screen dots corresponding to the lines and part-lines of the paragraph between hair1 inclusive and hair2 exclusive. If hair1 = hair2, this is a no-op. If hair1 > hair2, they are reversed. This complementing happens in three parts, A, B, and C, between points 1 and 2, according to the following illustration:
1AAA
BBBB
BBBB
BBBB
CCC2
unless there is just one line involved, as in:
1DD2
" "one line case" = hair2 minY
ifTrue: [(((hair1 minX hair2 minX
ifTrue: [hair1 origin rect: hair2 corner]
ifFalse: [hair2 origin rect: hair1 corner]) intersect: frame) intersect: window) comp]
ifFalse:
[hair1 minY > hair2 minY
ifTrue:
[temprect ← hair1.
hair1 ← hair2.
hair2 ← temprect].
temprect ← frame minX hair1 maxY rect: frame maxX hair2 minY.
(((hair1 origin rect: temprect maxX temprect minY) intersect: frame) intersect: window) comp.
((temprect intersect: frame) intersect: window) comp.
(((temprect minX temprect maxY rect: hair2 corner) intersect: frame) intersect: window) comp]].
"112" TextImage$'DISPLAY'
[show | |
lastline = 0
ifTrue: [super show]
ifFalse: [self displayall].
sel ← off].
"411" TextImage$'EDITING'
[fit | rect |
(window intersect: frame) "make the bounding rectangle of the TextImage contain all the textwhile not changing the width of the TextImage." white.
frame extent← frame width 1000.
self pointofchar: para length + 1 andrect [:rect | rect].
frame extent← frame width (rect corner y - frame origin y).
self show.
frame border: 1 color: 1.
self reversefrom: c1 to: c2].
"51" TextImage$'ACCESS TO PARTS'
[c1← t1 | |
c1 ← t1].
"51" TextImage$'ACCESS TO PARTS'
[c2← t1 | |
c2 ← t1].
"89" TextImage$'EDITING'
[undo | |
self fintype.
self replace: Deletion.
self complement].
"135" TextImage$'EDITING'
[align | |
para alignment← #(1 2 4 0 0 ) (1 + para alignment).
self displayall.
self reversefrom: c1 to: c2].
"94" TextImage$'SELECTION'
[selectionAsStream | |
↑Stream new of: para text from: c1 to: c2 - 1].
"62" TextImage$'ACCESS TO PARTS'
[frame← f | |
self fixframe: f].
"56" TextImage$'ACCESS TO PARTS'
[formerly | |
↑oldEntity].
"55" TextImage$'DISPLAY'
[leave | |
self complement: off].
"60" TextImage$'SELECTION'
[unselect | |
self complement: off].
"215" TextImage$'EDITING'
[replace: t | |
oldEntity
ifFalse:
[oldEntity ← para.
para ← para copy].
begintypein
ifFalse: [Deletion ← self selection].
self replace: c1 to: c2 - 1 with: t.
c2 ← c1 + t length].
"105" TextImage$'SELECTION'
[select | |
sel ← off.
c1 nil
ifTrue: [c1 ← c2 ← 1].
self complement: on].
"55" TextImage$'ACCESS TO PARTS'
[Scrap← s | |
Scrap ← s].
"80" TextImage$'DISPLAY'
[enter | |
begintypein ← false.
self show.
self select].
"75" TextImage$'SYSTEM'
[presson: press in: r | |
↑para presson: press in: r].
"239" TextImage$'Editing'
[again | many |
many ← user leftShiftKey.
self fintype
ifTrue:
[Scrap ← Scrap text.
self select].
many
ifTrue: [[self againOnce] whileTrueDo: []]
ifFalse:
[self againOnce
ifFalse: [frame flash]]].
"182" TextImage$'EDITING'
[paste | |
self fintype "paste the Scrap over the current selection and redisplay the paragraph.".
self unselect.
self replace: Scrap.
self selectAndScroll].
"98" TextImage$'SELECTION'
[select: t | |
self complement: off.
c1 ← c2 ← t.
self selectAndScroll].
"139" TextImage$'PARAGRAPH EDITOR'
[scrollPos | t |
t ← self height - self lineheight.
t = 0
ifTrue: [↑0.0].
↑0.0 - self frameoffset / t].
"84" TextImage$'PARAGRAPH EDITOR'
[scrollUp: n | |
self scrollby: n / self lineheight].
"58" TextImage$'EDITING'
[realign | |
self align.
sel ← on].
"204" TextImage$'EDITING'
[fintype | |
begintypein
ifTrue:
[begintypein < c1
ifTrue:
[Scrap ← para copy: begintypein to: c1 - 1.
c1 ← begintypein].
begintypein ← false]
ifFalse: [↑false]].
"105" TextImage$'PARAGRAPH EDITOR'
[scrollTo: f | |
self scrollUp: self frameoffset + (f * self height) - 4].
"921" ScrollBar$'Scheduling'
[eachtime | p cx r |
"This needs to be restructured"
(rect has: (p ← user mp))
ifTrue:
[cx ← rect center x - 2.
p x < cx
ifTrue:
[r ← Rectangle new origin: rect origin corner: cx rect maxY.
DownCursor showwhile [([r has: (p ← user mp)] whileTrueDo:
[(self slide: p)
ifTrue: [owner scrollTo: (position minY - rect minY - 4) asFloat / (rect height - 12)]
ifFalse:
[user redbug
ifTrue: [self reposition [(owner scrollUp: rect origin y - p y)]]]])]]
ifFalse:
[r ← Rectangle new origin: cx rect minY corner: rect corner.
UpCursor showwhile [([r has: (p ← user mp)] whileTrueDo:
[(self slide: p)
ifTrue: [owner scrollTo: (position minY - rect minY - 4) asFloat / (rect height - 12)]
ifFalse:
[user redbug
ifTrue: [self reposition [(owner scrollUp: p y - rect origin y)]]]])]]]
ifFalse: [↑false]].
"41" ScrollBar$'Scheduling'
[lasttime | |
].
"84" ScrollBar$'Initialization'
[on: f from: o | |
self on: f from: o at: o scrollPos].
"181" ScrollBar$'Image'
[show | |
"Save background and turn gray"
bitstr ← rect bitsIntoString.
rect clear: black.
(rect inset: 2 2 and: [1 2]) clear: white.
position outline].
"398" ScrollBar$'Scheduling'
[slide: p | bug |
(position has: p)
ifTrue:
[JumpCursor showwhile [
(bug ← false.
[(position has: user mp) and: [bug false]] whileTrueDo:
[user redbug
ifTrue:
[bug ← true.
[user redbug] whileTrueDo: [self reshow [(position moveto: position origin x ((user mp y max: rect origin y + 4) min: rect corner y - 12))]]]])].
↑bug].
↑false].
"189" ScrollBar$'Image'
[hide | |
"restore background"
bitstr nil
ifTrue: [user notify: 'Attempt to hide unshown scrollbar']
ifFalse:
[rect bitsFromString: bitstr.
bitstr ← nil]].
"159" ScrollBar$'Initialization'
[useBitmap | |
bitstr nil
ifFalse: [bitstr ← bitstr asBitmap] " | x. ScrollBar allInstances transform x to x useBitmap. "].
"193" ScrollBar$'Image'
[boxPosition← f | |
position moveto: rect origin + (9 (4 + ((f < 0.0
ifTrue: [0.0]
ifFalse:
[f > 1.0
ifTrue: [1.0]
ifFalse: [f]]) * (rect height - 16))))].
"87" ScrollBar$'Image'
[hidewhile expr | v |
self hide.
v ← expr eval.
self show.
↑v].
"988" ScrollBar$'Initialization'
[classInit | |
UpCursor ← Cursor new fromtext: '
1000000000000000
1100000000000000
1110000000000000
1111000000000000
1111100000000000
1111110000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000'.
DownCursor ← Cursor new fromtext: '
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1100000000000000
1111110000000000
1111100000000000
1111000000000000
1110000000000000
1100000000000000
1000000000000000'.
JumpCursor ← Cursor new fromtext: '
0111000000000000
1111100000000000
1111100000000000
0111000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000' offset: 2 1].
"49" ScrollBar$'Scheduling'
[close | |
owner ← nil].
"60" ScrollBar$'Scheduling'
[firsttime | |
↑rect has: user mp].
"112" ScrollBar$'Image'
[reshow expr | r |
r ← position inset: 2.
expr eval.
r clear: white.
position outline].
"252" ScrollBar$'Initialization'
[on: frame from: t2 at: f | |
owner ← t2.
rect ← Rectangle new origin: frame origin - (32 2) extent: 32 (frame height + 4).
position ← Rectangle new origin: rect origin + (9 4) extent: 16 8.
self boxPosition← f].
"110" ScrollBar$'Image'
[reposition expr | |
self reshow [
(expr eval.
self boxPosition← owner scrollPos)]].
"290" CodePane$'Initialization'
[showing: paragraph | |
pared ← TextImage new para: paragraph asParagraph frame: nil.
pared formerly: false.
pared fixframe: frame.
self windowenter.
scrollBar ← (scrollBar nil
ifTrue: [ScrollBar new]
ifFalse: [scrollBar]) on: frame from: pared].
"360" CodePane$'Window protocol'
[eachtime | |
user kbck
ifTrue: [↑self kbd].
(frame has: user mp)
ifTrue:
[user anybug
ifTrue:
[user redbug
ifTrue: [↑self redbug].
user yellowbug
ifTrue: [↑self yellowbug].
user bluebug
ifTrue: [↑false]]
ifFalse:
[user anykeys
ifTrue: [↑self keyset]]]
ifFalse: [↑self outside]].
"57" PressPrinter$'Closing'
[toPrinter | |
press toPrinter].
"65" PressPrinter$'Initialization'
[defaultframe | |
↑defaultframe].
"601" PressPrinter$'Writing'
[print: para in: rect | result oldpara |
(rect width = 0 or: [rect height = 0])
ifTrue: [user notify: 'zero dimension'].
oldpara ← para.
[(result ← para presson: press in: rect) is: Integer] whileFalseDo:
[self nextpage "rest of para goes on next page".
para ← result.
rect ← rect minX frame minY rect: rect maxX ypos "original para can hide information. if it split across page boundaries,
the format may vary. other completion flags can be added later"].
oldpara hidePress: press complete: (oldpara para
ifTrue: [0]
ifFalse: [1]).
↑ypos ← result].
"180" PressPrinter$'Initialization'
[classInit | inch |
inch ← 2540 "1 inch in micas".
defaultframe ← (1.1 * inch) asInteger (1 * inch) rect: (7.75 * inch) asInteger (10 * inch)].
"85" PressPrinter$'Initialization'
[init | |
super init.
page ← 1.
ypos ← frame maxY].
"49" PressPrinter$'Closing'
[close | |
press close].
"296" PressPrinter$'Writing'
[nextpage: h | n |
press page.
page ← page + 1.
ypos ← frame maxY.
h
ifTrue:
[n ← page asString.
press setp: frame maxX + 800 (ypos + 960).
press selectfont: (press fontindex: 0 style: DefaultTextStyle) - 1.
press append: n.
press showchars: n length]].
"68" PressFile$'Bitmaps/Dots'
[setmode: m | |
DL next← 2.
DL next← m].
"378" PressFile$'Entity/Page/File Commands'
[box: rect hue: hue sat: sat bright: bright containing expr | w r |
self entity: (self transrect: (w ← rect inset: 2)) containing [
((w minus: rect) do: [:r | self showrect: r color: 0].
ColorPrint
ifTrue:
[self hue: hue.
self saturation: sat.
self showrect: rect color: bright.
self brightness: 0].
expr eval)]].
"151" PressFile$'Entity/Page/File Commands'
[entity: box containing expr | v |
self startEntity.
boundbox ← box.
v ← expr eval.
self closeEntity.
↑v].
"128" PressFile$'EL commands'
[skipcontrol: n type: t | |
EL next← 242 "n bytes have been put in DL".
EL nextword← n.
EL next← t].
"121" PressFile$'Bitmaps/Dots'
[setcoding: c dots: d lines: l | |
DL next← 1.
DL next← c.
DL nextword← d.
DL nextword← l].
"41" PressFile$'Aspects'
[scale | |
↑scale].
"1065" PressFile$'Reading'
[readPart | t |
estate ← false "read parts until we find a printed page or end".
[t ← parts nextword] whileTrueDo:
[Pstart ← parts nextword.
t 0
ifTrue:
[parts skip: 4 "not a printed page".
t > 0 "font or other part" "a non-standard part. let document (estate?) interpret" "DL position ← Pstart*recordsize.
estate fromPress: self name: t value: DL"]
ifFalse:
[ "go to end of last record of entity list, ignoring padding"
t ← parts nextword "length".
DL position← Pstart + t * recordsize - (1 + parts nextword * 2).
EL ← Set new vector: 50 "scan backwards for beginning of entity list, reading entities".
[(t ← DL nextword) > 0] whileTrueDo:
[t < 12
ifTrue: [user notify: 'illegal entity']
ifFalse:
[DL skipwords: 0 - t "read entity and trailer (last 12 words of entity)".
EL next← DL next: t - 12 * 2.
EL next← DL next: 24.
DL skipwords: 1 - t] "now reverse: trailer, entity (1st), ... (last)"].
↑EL ← (EL asArray (EL length to: 1 by: 1)) asStream]].
↑false].
"108" PressFile$'Bitmaps/Dots'
[setsizewidth: w height: h | |
DL nextword← 2.
DL nextword← w.
DL nextword← h].
"65" PressFile$'Entity/Page/File Commands'
[clip: boundingbox | |
].
"122" PressFile$'Bitmaps/Dots'
[dots exp | dlpos |
dlpos ← self padword.
exp eval.
self showdots: DL wordposition - dlpos].
"119" PressFile$'Bitmaps/Dots'
[setwindowwidth: w height: h | |
self setwindowwidth: w height: h skipdots: 0 skiplines: 0].
"106" PressFile$'EL commands'
[showrectwidth: w height: h | |
EL next← 254.
EL nextword← w.
EL nextword← h].
"385" PressFile$'Lines/Objects'
[drawdiscat: pt radius: radius | dx dy i |
radius 16
ifFalse:
[dx ← #(5 4 3 1 1 3 4 5 5 4 3 1 1 3 4 5 ).
dy ← #(1 3 4 5 5 4 3 1 1 3 4 5 5 4 3 1 ).
self showobject [
(self moveto: pt + (dx 16 * radius / 5 (dy 16 * radius / 5)).
(1 to: 16) do: [:i | self drawto: pt + (dx i * radius / 5 (dy i * radius / 5))])]]].
"544" PressFile$'Lines/Objects'
[drawlinefrom: p1 to: p2 width: width | d length t1 t2 |
(d ← p2 - p1) = (0 0)
ifFalse:
[d x← d x asFloat.
d y← d y asFloat.
width ← width asFloat.
length ← (d x * d x + (d y * d y)) sqrt.
d x← (d x * width / length) asInteger.
d y← (d y * width / length) asInteger.
t1 ← d y (0 - d x).
t2 ← 0 - d y d x.
self showobject [
(self moveto: p1 + t1.
self drawto: p2 + t1.
self drawto: p2 + t2.
self drawto: p1 + t2.
self drawto: p1 + t1)]].
self drawdiscat: p2 radius: width].
"96" PressFile$'Entity/Page/File Commands'
[toPrinter | |
self toPrinter: self defaultPrinterName].
"51" PressFile$'EL commands'
[space | |
EL next← 247].
"104" PressFile$'Private'
[padpage | |
↑(DL pad: recordsize with: 0) "words of padding to end of page" / 2].
"52" PressFile$'Private'
[append: x | |
↑DL append: x].
"300" PressFile$'Initialization'
[of: t1 | |
DL ← t1.
EL ← Set new string: 200.
FL ← Set new string: 40.
parts ← Set new string: 40.
fontcodes ← Vector new: 0.
fontdefs ← Vector new: 0.
estate ← Vector new: 3 "font, spacex, spacey, ...".
prevstyle ← nil.
self scale: PressScale.
self startPage].
"174" PressFile$'Private'
[closePage | |
self closeEntity.
EL empty
ifFalse:
[DL padNext← 0.
DL nextword← 0.
DL append: EL asReadStream.
self part: 0 start: Pstart]].
"214" PressFile$'Private'
[part: type start: start | padding |
padding ← self padpage.
parts nextword← type.
parts nextword← start.
parts nextword← self recordnum - start.
parts nextword← padding.
self startPage].
"673" PressFile$'Bitmaps/Dots'
[bitmap: rect bits: bits | w w16 h |
w ← rect width "some pecularities of spruce:
scale must be 32, and multiples of 16 for width (maybe extra stuff prints)".
w16 ← w + 15 | 16 "width to next word boundary".
h ← rect height "origin should be set earlier".
self dots [
(self setcoding: 0 dots: w16 lines: h "bitmap".
self setmode: 3 "to right and to bottom of page".
self setsizewidth: scale * w16 height: scale * h.
self setwindowwidth: (ColorPrint
ifTrue: [w]
ifFalse: [w16]) height: h.
self dotsfollow.
bits
ifTrue: [DL append: bits "bits supplied"]
ifFalse: [ "else from screen"
rect bitsOntoStream: DL])]].
"72" PressFile$'EL commands'
[onlyoncopy: n | |
EL next← 237.
EL next← n].
"56" PressFile$'EL commands'
[resetspace | |
EL next← 246].
"218" PressFile$'EL commands'
[setspacey: y | |
estate 3 = y
ifFalse:
[estate 3 ← y.
(y 0 and: [y 2047])
ifTrue: [EL nextword← 26624 + y "short form"]
ifFalse:
[EL next← 245.
EL nextword← y]]].
"88" PressFile$'EL commands'
[showchar: char | |
EL next← 243 "immediate".
EL next← char].
"109" PressFile$'EL commands'
[skipcontrol: n | |
EL next← 235 "immediate".
EL next← n "now put n bytes in EL"].
"169" PressFile$'Lines/Objects'
[drawcurve: v | |
v length 12
ifTrue: [user notify: 'illegal drawcurve']
ifFalse:
[DL nextword← 2.
v do: [:v | DL nextword← v]]].
"180" PressFile$'Lines/Objects'
[showobject exp | p |
p ← self padword "expression containing moveto, drawto, drawcurve".
exp eval.
EL next← 251.
EL nextword← DL wordposition - p].
"59" PressFile$'Bitmaps/Dots'
[dotsfollow | |
DL nextword← 3].
"90" PressFile$'EL commands'
[showdots: nwords | |
EL next← 252.
EL nextNumber: 4 ← nwords].
"72" PressFile$'EL commands'
[brightness: b | |
EL next← 248.
EL next← b].
"96" PressFile$'EL commands'
[showdotsopaque: nwords | |
EL next← 253.
EL nextNumber: 4 ← nwords].
"516" PressFile$'Private'
[closeEntity: etype | |
EL wordposition = ELstart
ifFalse:
[ "Put a trailer into the EL"
EL padNext← 255 "word-pad EL with <Nop>".
EL next← etype.
EL next← 0 "fontset" "dlstart relative to DL location in file".
EL nextNumber: 4 ← DLstart - (Pstart * recordsize).
EL nextNumber: 4 ← DL position - DLstart.
EL nextPoint← eorigin "entity origin".
EL nextPoint← boundbox origin.
EL nextPoint← boundbox extent.
EL nextword← EL wordposition - ELstart + 1.
self startEntity]].
"122" PressFile$'Private'
[part exp code: c | fp |
self closePage.
fp ← self recordnum.
exp eval.
self part: c start: fp].
"169" PressFile$'Private'
[startEntity | |
DLstart ← DL position.
ELstart ← EL wordposition.
boundbox ← 0 asRectangle.
eorigin ← 0 0.
estate all← 1.
estate 1 ← 0].
"92" PressFile$'Private'
[startPage | |
EL reset.
Pstart ← self recordnum.
self startEntity].
"110" PressFile$'Entity/Page/File Commands'
[pictureinit | |
self pictureinit: user screenrect scale: PressScale].
"155" PressFile$'Private'
[padword | |
"make object (lines or dots) start on word boundary"
DL padNext← 0
ifTrue: [self skipchars: 1].
↑DL wordposition].
"72" PressFile$'EL commands'
[saturation: s | |
EL next← 250.
EL next← s].
"128" PressFile$'Lines/Objects'
[object expr atScreen: p | |
self showobject [
(self objectGotoScreen: p pen: 0.
expr eval)]].
"77" PressFile$'Lines/Objects'
[drawto: p | |
DL nextword← 1.
DL nextPoint← p].
"160" PressFile$'Lines/Objects'
[drawlinefromscreen: p1 to: p2 width: width | |
↑self drawlinefrom: (self transpt: p1) to: (self transpt: p2) width: width * scale].
"155" PressFile$'Entity/Page/File Commands'
[pictureinit: rect scale: t2 | |
scale ← t2.
boundbox ← boundbox include: (self transrect: rect).
self somefont].
"112" PressFile$'Lines/Objects'
[objectGotoScreen: p pen: pen | |
DL nextword← pen.
DL nextPoint← self transpt: p].
"371" EFTPSender$'Initialization'
[net: n host: h | |
super net: n host: h soc: (Int32 new "Each instance of an EFTPSender has a unique lclSocket, but
always goes to socket 020 of the receiver" high: 0 low: 16) "unlike plain sockets, we only want acks from this dest.".
filterInput ← true.
self retransmit: 5 every: 180.
outPac ← false.
transaction ← 0.
ackType ← 25].
"309" EFTPSender$'Receiving'
[process: packet | error |
"The printer is trying to tell me something"
packet pupType = 27
ifTrue:
[error ← packet dataString "error 33!!!".
self freePacket: packet.
user show: 'remote server aborted: '.
user show: error (3 to: error length).
abortTransfer ← true]].
"374" RPPSocket$'Timer Interupts'
[timerFired | |
(ackOK or: [abortTransfer]) "This piece of code only runs when a Timer fires;
Don't do an active return"
ifFalse:
[ "This transaction has been terminated"
self timerOn
ifTrue: [self completePup: outPac "retransmit"]
ifFalse:
[user show: 'Excessive retransmits in RPP retransmit'.
abortTransfer ← true]]].
"504" RPPSocket$'Sending Data'
[send: t1 | |
myStream ← t1.
"Sends a whole stream, and an end sequence.
let the caller hand in a stream, or a file already opened"
outPac
ifFalse: [outPac ← self freePacket].
seqNum ← 0.
abortTransfer ← eof ← false.
[eof or: [abortTransfer]] whileFalseDo: [self sendData].
abortTransfer
ifTrue:
[self reset.
↑false].
"We hit the end of file, do the end sequence and close the connection"
self sendEndSequence
ifTrue: [↑myStream].
↑false "all done!"].
"185" RPPSocket$'Intialization'
[init | |
self retransmit: 10 every: 180.
seqNum ← transaction ← 0.
outPac ← ackOK ← false.
abortTransfer ← true "stop an old timer from perhaps firing"].
"87" RPPSocket$'Termination'
[reset | |
outPac ← self freePacket: outPac.
self timerOff].
"354" RPPSocket$'Sending Data'
[sendPacket | |
"general routine to send the outPac packet, maybe retransmit, get ack"
ackOK ← abortTransfer ← false.
outPac pupID1← seqNum.
outPac pupID0← transaction "pupID0 can be used by one of my subclasses".
self setAddressesAndComplete: outPac.
[abortTransfer or: [ackOK]] whileFalseDo: [].
seqNum ← seqNum + 1].
"377" RPPSocket$'Handle Input'
[socProcess: Ipac | |
"I have received a packet"
Ipac pupType = ackType
ifTrue:
[(Ipac pupID1 = seqNum and: [Ipac pupID0 = transaction])
ifTrue:
[self timerOff "a legal acknowledgement".
ackOK ← true] "an old acknowledgement".
self freePacket: Ipac]
ifFalse:
[ "must be a trasmission started elsewhere"
self process: Ipac]].
"765" RPPSocket$'Sending Data'
[sendData | i t buf len |
buf ← outPac pupString "send one packet of data from myStream".
i ← 24 "data bytes are 1-512, 25-536".
(myStream is: FileStream)
ifTrue: [len ← 512 - (myStream readString: buf from: i + 1 "read characters faster (should work especially well for the usual case:
FileStreams starting on a page boundary, with page sizes of 512)" to: i + 512)]
ifFalse:
[ "fill the buffer the slow, careful way"
[i < 536 and: [(t ← myStream next)]] whileTrueDo: [buf (i ← i + 1) ← t].
len ← i - 24].
eof ← len < 512.
len = 0
ifFalse:
[ "empty packet. don't send"
outPac pupType← 24 "Data" "set the packet length".
outPac dataLength← len "send packet reliably or abort, then return".
self sendPacket]].
"413" RPPSocket$'Sending Data'
[sendEndSequence | |
outPac pupType← 26 "This will do the 3-way handshake, and close the connection.
send end, wait for ack" "end" "set the packet length".
outPac pupLength← 22.
self sendPacket "gets sent reliably, we hope".
abortTransfer
ifTrue:
[self reset.
↑false].
"send the last gratuitous end, do not try to retransmit"
.
self sendPacketOnce.
self reset.
↑true].
"264" RPPSocket$'Sending Data'
[sendPacketOnce | |
"special routine to send the outPac packet, no retransmission"
outPac pupID1← seqNum.
outPac pupID0← transaction "pupID0 can be used by one of my subclasses".
self setAddressesAndComplete: outPac.
self timerOff].
"81" RPPSocket$'Termination'
[release | |
self reset.
inQ ← false.
super release].
"221" RPPSocket$'Sending Data'
[sendBlock: str | |
outPac dataString← str "Take the data from a string (1-532 bytes), send it out; uses outPac".
self sendPacket "tries to do it reliably".
abortTransfer
ifTrue: [↑false]].
"98" RPPSocket$'Handle Input'
[process: packet | |
self freePacket: packet "my subclasses use this"].
"135" RetransmitSocket$'Subclass'
[timerFired | |
self timerOn "subclass should redefine this" "again, e.g. self completePup: pac" "done"].
"271" RetransmitSocket$'Socket'
[setAddressesAndComplete: pac | |
pac addressBlock← outAddBlock "this may need to be bracketed as critical?" "start timer".
retransCount ← 0.
retransTimer reset.
self completePup: pac "self startTimer.
super setAddressesAndComplete: pac"].
"82" RetransmitSocket$'Timer'
[startTimer | |
retransCount ← 0.
retransTimer reset].
"155" Queue$'FIFO access'
[next | |
readposition position
ifTrue:
[readposition ← position ← 0.
↑false].
↑array (readposition ← readposition + 1)].
"140" Queue$'FIFO access'
[peek | |
readposition position
ifTrue:
[readposition ← position ← 0.
↑false].
↑array (readposition + 1)].
"89" Queue$'Stream protocol'
[contents | |
↑(array (readposition + 1 to: position)) copy].
"106" Queue$'FIFO access'
[deQ1 | n |
"A noninterruptable dequeue"
Top critical [(n ← self dequeue)].
↑n].
"154" Queue$'Stream protocol'
[of: t1 from: t2 to: t3 | |
array ← t1.
position ← t2.
limit ← t3.
user notify: 'of:from:to: is not appropriate for Queues'].
"68" Queue$'FIFO access'
[skip: x | |
readposition ← readposition + x].
"66" Queue$'Stream protocol'
[reset | |
readposition ← position ← 0].
"63" Queue$'Stream protocol'
[empty | |
↑readposition position].
"61" Queue$'Stream protocol'
[end | |
↑readposition position].
"104" Queue$'FIFO access'
[enQ1: n | |
"A noninterruptable enqueue"
Top critical [(super next← n)].
↑n].
"107" Queue$'Stream protocol'
[of: t1 | |
array ← t1.
position ← 0.
readposition ← 0.
limit ← array length].
"158" Queue$'FIFO access'
[dequeue | |
readposition position
ifTrue:
[readposition ← position ← 0.
↑false].
↑array (readposition ← readposition + 1)].
"60" Queue$'FIFO access'
[length | |
↑position - readposition].
"235" Queue$'Stream protocol'
[pastend← x | n |
readposition = 0
ifTrue: [↑super pastend← x].
n ← position - readposition.
array (1 to: n) ← array (readposition + 1 to: position).
readposition ← 0.
position ← n.
↑self next← x].
"197" Queue$'FIFO access'
[dequeue: num | n |
position - readposition < num
ifTrue: [↑false].
n ← (array (readposition + 1 to: readposition + num)) copy.
readposition ← readposition + num.
↑n].
"246" Queue$'LIFO access'
[push: x | |
"treat as LIFO queue"
readposition > 0
ifTrue:
[array readposition ← x.
readposition ← readposition - 1]
ifFalse: [ "readpositon > 0, just jam it in"
self insert: x] "otherwise insert on front"].
"271" Timer$'Timing Behavior'
[fire | |
"Time is up, add the action to the Queue to be evaled"
timerActions next← action.
Top wakeup: 12.
activeTime ← nil.
lastTimer ← nil.
nextTimer nil
ifTrue: [self shutoff]
ifFalse:
[nextTimer startup.
nextTimer ← nil]].
"197" Timer$'Initialization'
[init16 | |
"Initialize the process wakened by a Timer timing out"
Top install [([true] whileTrueDo:
[currentTimer fire.
Top sleep: 16])] at: 16.
Top enable: 16].
"362" Timer$'Timing Behavior'
[disable | |
"Remove this timer from the list"
Top critical [
((self currentTimer and: [nextTimer nil])
ifTrue:
[self shutoff.
Top deepsleep: 16].
lastTimer nil
ifFalse: [lastTimer deletenext].
nextTimer nil
ifFalse: [nextTimer deletelast].
activeTime ← nil.
lastTimer ← nil.
nextTimer ← nil)]].
"132" Timer$'Timing Behavior'
[startup | |
lastTimer ← nil "make this the next Timer to fire".
currentTimer ← self.
self primstartup].
"250" Timer$'Initialization'
[init12 | nextAction |
"Initialize the process which evals Timer actions"
Top install [([true] whileTrueDo:
[[nextAction ← timerActions next] whileTrueDo: [nextAction eval].
Top sleep: 12])] at: 12.
Top enable: 12].
"161" Timer$'Timing Behavior'
[activetime | |<primitive: 75>
↑activeTime "If this is the current Timer return the time until it fires, otherwise return activeTime"].
"51" Timer$'List Behavior'
[nexttimer | |
↑nextTimer].
"300" Timer$'List Behavior'
[insertlast: t1 | |
lastTimer ← t1.
activeTime ← self activetime "Insert a new Timer before this one. When inserting a Timer in front of another, the activeTime of the later one must be reduced so it is the amount of time after the new Timers firing" - lastTimer activetime].
"288" Timer$'List Behavior'
[deletelast | |
activeTime ← activeTime + lastTimer activetime "Delete the Timer before this one. When deleting a Timer, the activeTime of the Timer after it must be increased by its activeTime".
(lastTimer ← lastTimer lasttimer) nil
ifTrue: [self startup]].
"107" Timer$'List Behavior'
[deletenext | |
nextTimer ← nextTimer nexttimer "Delete the Timer after this one"].
"60" Timer$'List Behavior'
[insertnext: t1 | |
nextTimer ← t1].
"51" Timer$'List Behavior'
[lasttimer | |
↑lastTimer].
"141" Timer$'Timing Behavior'
[primstartup | |<primitive: 75>
"this message informs the virtual machine that this is the next Timer to fire"
].
"162" Timer$'Initialization'
[classInit | |
"Initialize the processes used by the Timers"
timerActions ← Queue new of: (Vector new: 4).
self init16.
self init12].
"100" Timer$'Initialization'
[for: t1 action t2 | |
delay ← t1.
action ← t2 "Initialize a new Timer"].
"936" Timer$'Initialization'
[reset | nextTimeout foundit |
Top critical [
"Set up this Timer to add <action> to the Queue of remote Contexts to be evaled after an interval of <delay> sixtieths of a second. Find the proper place in the doubly linked list and calculate the amount of time to run after the preceeding timer fires"
(activeTime nil
ifFalse: [self disable].
activeTime ← delay.
nextTimer ← currentTimer.
lastTimer ← nil.
foundit ← false.
[foundit] whileFalseDo:
[nextTimer nil
ifTrue: [foundit ← true]
ifFalse:
[.
(nextTimeout ← nextTimer activetime) > activeTime
ifTrue: [foundit ← true]
ifFalse:
[.
activeTime ← activeTime - nextTimeout.
lastTimer ← nextTimer.
nextTimer ← lastTimer nexttimer]]].
nextTimer nil
ifFalse: [nextTimer insertlast: self].
lastTimer nil
ifTrue: [self startup]
ifFalse: [lastTimer insertnext: self])]].
"171" Timer$'Timing Behavior'
[shutoff | |<primitive: 75>
currentTimer ← nil "this message informs the virtual machine and class Timer that there are no more Timers to fire"].
"87" Timer$'List Behavior'
[release | |
lastTimer ← nil.
nextTimer ← nil.
action ← nil].
"158" RetransmitSocket$'Timer'
[retransmit: t1 every: delay | |
retransMax ← t1.
retransTimer ← Timer new.
retransTimer for: delay action [(self timerFired)]].
"152" RetransmitSocket$'Socket'
[release | |
retransTimer nil
ifFalse:
[ "release circular structure"
retransTimer disable.
retransTimer ← nil]].
"96" RetransmitSocket$'Timer'
[timerOff | |
retransTimer nil
ifFalse: [retransTimer disable]].
"193" RetransmitSocket$'Timer'
[timerOn | |
(retransCount ← retransCount + 1 "turn on timer if retry count has not been reached") retransMax
ifTrue: [retransTimer reset]
ifFalse: [↑false]].
"48" Socket$'Access to Parts'
[frnNet | |
↑frnNet].
"80" Socket$'Overwrite by Subclasses'
[socProcess: Ipac | |
self freePacket: Ipac].
"507" Socket$'Initialization'
[net: t1 host: t2 soc: t3 | |
frnNet ← t1.
frnHost ← t2.
frnSocNum ← t3.
lclSocNum ← Int32 new "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)" high: self nail low: user ticks.
self unNail.
self from: lclSocNum net: frnNet host: frnHost soc: frnSocNum].
"146" Socket$'Initialization'
[default | |
self net: 0 host: 0 soc: (Int32 new "default local socket number and leave frn port open" high: 0 low: 0)].
"69" Socket$'Access to Parts'
[frnHost← t1 | |
frnHost ← t1.
↑frnHost].
"124" Socket$'Process outgoing packet'
[setAddressesAndComplete: pac | |
pac addressBlock← outAddBlock.
self completePup: pac].
"140" RoutingUpdater$'Overwrite from Socket'
[timerFired | |
self timerOn
ifTrue: [self completePup: outPac]
ifFalse: [resultSet ← true]].
"206" RoutingUpdater$'Sending'
[update | i |
(1 to: 255) do:
[:i | routingTable i ← 0.
routingHopCount i ← 8].
resultSet ← false.
self setAddressesAndComplete: outPac.
[resultSet] whileFalseDo: []].
"241" RoutingUpdater$'Initialization'
[init | |
super net: 0 host: 0 soc: 2 asInt32 "create a new local soc number, broadcast to socket 2".
outPac ← self freePacket.
outPac pupType← 128.
outPac dataString← ''.
self retransmit: 3 every: 300].
"550" RoutingUpdater$'Overwrite from Socket'
[socProcess: pac | block gateway net count i |
pac pupType "an input has arrived, we are running at a higher level.
Check the packet type" = 129
ifTrue:
[self timerOff.
resultSet ← NETNUM ← pac sourceNet.
block ← pac pupString.
gateway ← pac sourceHost.
(25 to: 24 + pac dataLength by: 4) do:
[:i | net ← block i.
count ← block (i + 3) + 1.
count < (routingHopCount net)
ifTrue:
[routingTable net ← gateway.
routingHopCount net ← count]]].
self freePacket: pac].
"48" Pacbuf$'Etc'
[ i ← v | |
↑pupString i ← v].
"40" Pacbuf$'Etc'
[ i | |
↑pupString i].
"98" Pacbuf$'PUP Header'
[pupID← pID | |
pupString word: 5 ← pID high.
pupString word: 6 ← pID low].
"54" Pacbuf$'PUP Header'
[pupID1 | |
↑pupString word: 6].
"59" Pacbuf$'PUP Header'
[pupType← pT | |
pupString 8 ← pT].
"60" Pacbuf$'PUP Header'
[destNet← dN | |
pupString 13 ← dN].
"53" Pacbuf$'PUP Header'
[destHost | |
↑pupString 14].
"56" Pacbuf$'PUP Header'
[destSoc0 | |
↑pupString word: 8].
"82" Pacbuf$'Initialization'
[init | |
pupString ← String new: 558.
locked ← false].
"68" Pacbuf$'Ethernet header'
[ethType← eT | |
pupString word: 2 ← eT].
"56" Pacbuf$'PUP Header'
[destSoc1 | |
↑pupString word: 9].
"146" Pacbuf$'Etc'
[lock | |
locked
ifTrue: [E notify: 'trying to lock a buffer already locked']
ifFalse:
[locked ← true.
↑pupString lock]].
"68" Pacbuf$'PUP Header'
[transportControl← tC | |
pupString 7 ← tC].
"51" Pacbuf$'PUP Header'
[pupType | |
↑pupString 8].
"48" Pacbuf$'Etc'
[word: i | |
↑pupString word: i].
"52" Pacbuf$'PUP Header'
[destNet | |
↑pupString 13].
"151" Pacbuf$'Etc'
[unlock | |
locked
ifTrue:
[locked ← false.
pupString unlock]
ifFalse: [user notify: 'trying to unlock a buffer not locked']].
"56" Pacbuf$'Etc'
[word: i ← v | |
↑pupString word: i ← v].
"86" Pacbuf$'Data '
[dataLength← len | |
↑pupString word: 3 ← len + 22 "self pupLength"].
"59" Pacbuf$'Data '
[dataWord: i | |
↑pupString word: i + 12].
"54" Pacbuf$'PUP Header'
[pupID0 | |
↑pupString word: 5].
"52" Pacbuf$'Etc'
[header | |
↑pupString (1 to: 24)].
"69" Pacbuf$'Data '
[dataWord: i ← v | |
↑pupString word: (i + 12) ← v].
"143" Pacbuf$'PUP Checksum'
[checksumOK | |
"Boolean, returns true or false"
↑self checksum "just look at the current packet" = self doChecksum].
"101" Pacbuf$'PUP Header'
[destSocNum | |
↑Int32 new high: (pupString word: 8) low: (pupString word: 9)].
"62" Pacbuf$'Ethernet header'
[imEthDestHost | |
↑pupString 1].
"67" Pacbuf$'PUP Header'
[totLengthWords | |
↑self pupLength + 5 / 2].
"96" Pacbuf$'PUP Header'
[pupID | |
↑Int32 new high: (pupString word: 5) low: (pupString word: 6)].
"61" Pacbuf$'Ethernet header'
[imEthSrcHost | |
↑pupString 2].
"66" Pacbuf$'PUP Header'
[addressBlock | |
↑pupString (13 to: 24)].
"63" Pacbuf$'PUP Header'
[destSoc1← i | |
↑pupString word: 9 ← i].
"57" Pacbuf$'PUP Header'
[pupLength | |
↑pupString word: 3].
"66" Pacbuf$'PUP Header'
[sourceSoc0← i | |
↑pupString word: 11 ← i].
"66" Pacbuf$'PUP Header'
[sourceSoc1← i | |
↑pupString word: 12 ← i].
"93" Pacbuf$'PUP Header'
[swapPorts | i |
(13 to: 18) do: [:i | pupString swap: i with: i + 6]].
"60" Pacbuf$'PUP Header'
[transportControl | |
↑pupString 7].
"83" Pacbuf$'PUP Checksum'
[checksum | |
↑pupString word: self pupLength + 1 / 2 + 2].
"77" Pacbuf$'Data '
[dataLength | |
↑(pupString word: 3) - 22 "self pupLength"].
"79" Pacbuf$'Data '
[dataString | |
↑pupString copy: 25 to: 24 + self dataLength].
"60" Pacbuf$'Ethernet header'
[ethType | |
↑pupString word: 2].
"65" Pacbuf$'PUP Header'
[pupID0← pID | |
↑pupString word: 5 ← pID].
"65" Pacbuf$'PUP Header'
[pupID1← pID | |
↑pupString word: 6 ← pID].
"63" Pacbuf$'PUP Header'
[destSoc0← i | |
↑pupString word: 8 ← i].
"229" Pacbuf$'Data '
[dataString← str | i |
i ← str length.
i > 532
ifTrue: [user notify: 'Data string too big for single PUP']
ifFalse:
[pupString copy: 25 to: 24 + i with: str from: 1 to: i.
self dataLength← i.
↑str]].
"63" Pacbuf$'Etc'
[pupString← t1 | |
pupString ← t1.
↑pupString].
"42" Pacbuf$'Etc'
[pupString | |
↑pupString].
"66" Pacbuf$'PUP Header'
[pupLength← pL | |
↑pupString word: 3 ← pL].
"36" Pacbuf$'Etc'
[locked | |
↑locked].
"179" Pacbuf$'PUP Header'
[addressBlock← addBlock | |
"for quickly setting the 6 fields"
pupString copy: 13 to: 24 with: addBlock from: 1 to: 12 "pupString(13 to: 24) ← addBlock"].
"61" Pacbuf$'PUP Header'
[destHost← dH | |
pupString 14 ← dH].
"103" Pacbuf$'PUP Header'
[destSocNum← dSN | |
pupString word: 8 ← dSN high.
pupString word: 9 ← dSN low].
"54" Pacbuf$'PUP Header'
[sourceNet | |
↑pupString 19].
"62" Pacbuf$'PUP Header'
[sourceNet← sN | |
pupString 19 ← sN].
"55" Pacbuf$'PUP Header'
[sourceHost | |
↑pupString 20].
"63" Pacbuf$'PUP Header'
[sourceHost← sH | |
pupString 20 ← sH].
"59" Pacbuf$'PUP Header'
[sourceSoc0 | |
↑pupString word: 11].
"59" Pacbuf$'PUP Header'
[sourceSoc1 | |
↑pupString word: 12].
"107" Pacbuf$'PUP Header'
[sourceSocNum← sSN | |
pupString word: 11 ← sSN high.
pupString word: 12 ← sSN low].
"74" Pacbuf$'Ethernet header'
[imEthDestHost← iEDH | |
pupString 1 ← iEDH].
"160" Pacbuf$'Etc'
[lockwith: string | |
locked
ifTrue: [E notify: 'trying to lock a buffer already locked']
ifFalse:
[locked ← string.
↑pupString lock]].
"73" Pacbuf$'Ethernet header'
[imEthSrcHost← iESH | |
pupString 2 ← iESH].
"308" Pacbuf$'PUP Checksum'
[doChecksum | i cs |<primitive: 75>
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].
"93" Pacbuf$'PUP Checksum'
[checksum← cs | |
pupString word: (self pupLength + 1 / 2 + 2) ← cs].
"105" Pacbuf$'PUP Header'
[sourceSocNum | |
↑Int32 new high: (pupString word: 11) low: (pupString word: 12)].
"382" Socket$'Initialization'
[from: t1 net: t2 host: t3 soc: t4 | |
lclSocNum ← t1.
frnNet ← t2.
frnHost ← t3.
frnSocNum ← t4.
outAddBlock ← String new: 12 "this is the most general initialization, both lcl soc# and frnPort given".
self setOutAddBlock.
computeOutgoingCS ← filterInput ← false.
sockeTable insert: lclSocNum with: self "put me in socket table".
self doMoreInit].
"491" Socket$'Process outgoing packet'
[defaultAddresses: pac | |
"overwrites any fields which are 0"
pac destNet = 0
ifTrue: [pac destNet← frnNet].
pac destHost = 0
ifTrue: [pac destHost← frnHost].
(pac destSoc0 = 0 and: [pac destSoc1 = 0])
ifTrue: [pac destSocNum← frnSocNum].
pac sourceNet = 0
ifTrue: [pac sourceNet← NETNUM].
pac sourceHost = 0
ifTrue: [pac sourceHost← ALTONUM].
(pac sourceSoc0 = 0 and: [pac sourceSoc1 = 0])
ifTrue: [pac sourceSocNum← lclSocNum]].
"116" Socket$'Process outgoing packet'
[defaultAndComplete: pac | |
self defaultAddresses: pac.
self completePup: pac].
"70" Socket$'Access to Parts'
[computeOutgoingCS | |
↑computeOutgoingCS].
"99" Socket$'Access to Parts'
[computeOutgoingCS← t1 | |
computeOutgoingCS ← t1.
↑computeOutgoingCS].
"846" Socket$'Process outgoing packet'
[completePup: pac | t |
"the user must have set all 6 address fields,ID, length, and type" "Now route the packet appropriately, assuming we have Ethernet..."
NETNUM = pac destNet
ifTrue: [pac imEthDestHost← pac destHost]
ifFalse:
[ "most common case"
0 = pac destNet
ifTrue: [pac imEthDestHost← 0]
ifFalse:
[ "broadcast"
0 = (t ← routingTable pac destNet)
ifTrue:
[user show: '
Inaccessible destination net: ' + pac destNet asString + ', packet not sent.'.
↑pac].
.
pac imEthDestHost← t]].
pac imEthSrcHost← ALTONUM.
pac ethType← 512.
pac transportControl← 0 "as a socket we have an option about computing outgoing checksums".
pac checksum← (computeOutgoingCS
ifTrue: [pac doChecksum]
ifFalse: [1]) "Fix this up later......".
E sendOutput: pac.
↑pac].
"82" Socket$'Initialization'
[wakeup | |
"when E goes from ethAsleep to ethAwak"
].
"111" Socket$'Access to Parts'
[enable | |
user show: 'someone did unnecessary enable' "now a no-op".
self print].
"50" Socket$'Access to Parts'
[frnHost | |
↑frnHost].
"309" Socket$'Initialization'
[setOutAddBlock | |
outAddBlock 1 ← frnNet.
outAddBlock 2 ← frnHost.
outAddBlock word: 2 ← frnSocNum high.
outAddBlock word: 3 ← frnSocNum low.
outAddBlock 7 ← NETNUM.
outAddBlock 8 ← ALTONUM.
outAddBlock word: 5 ← lclSocNum high.
outAddBlock word: 6 ← lclSocNum low].
"66" Socket$'Access to Parts'
[frnNet← t1 | |
frnNet ← t1.
↑frnNet].
"89" Socket$'Process outgoing packet'
[setAddresses: pac | |
pac addressBlock← outAddBlock].
"58" Socket$'Access to Parts'
[filterInput | |
↑filterInput].
"81" Socket$'Access to Parts'
[filterInput← t1 | |
filterInput ← t1.
↑filterInput].
"54" Socket$'Access to Parts'
[frnSocNum | |
↑frnSocNum].
"75" Socket$'Access to Parts'
[frnSocNum← t1 | |
frnSocNum ← t1.
↑frnSocNum].
"54" Socket$'Access to Parts'
[lclSocNum | |
↑lclSocNum].
"75" Socket$'Access to Parts'
[lclSocNum← t1 | |
lclSocNum ← t1.
↑lclSocNum].
"53" Socket$'Overwrite by Subclasses'
[doMoreInit | |
].
"112" Socket$'Access to Parts'
[disable | |
user show: 'unnecessary disable' "left for compatibility".
self close].
"526" Socket$'Process incoming packet'
[acceptPacbuf: Ipac | temp |
(filterInput and: [(frnNet Ipac sourceNet "if we get here, we know that the input distributer has verified the
PUP dest as being us (or a broadcast, if broadcast filter is off).
We do not have responsibility for verifying incoming checksum.
First, check if we've been asked to filter by source:" or: [(frnHost Ipac sourceHost or: [frnSocNum Ipac sourceSocNum])])])
ifTrue: [↑self socDispose: Ipac].
"It's good, take it..."
↑self socProcess: Ipac].
"98" Socket$'Overwrite by Subclasses'
[release | |
"disable Timers, undo circular structures etc."].
"111" Socket$'Overwrite by Subclasses'
[sleep | |
"the user is quitting. I don't care, but my subclasses might"].
"80" Socket$'Overwrite by Subclasses'
[socDispose: Ipac | |
self freePacket: Ipac].
"113" Socket$'Overwrite by Subclasses'
[kill | |
"whole world about to go. I don't care, but my subclasses might"].
"125" NameUser$'Handle input'
[timerFired | |
self timerOn
ifTrue: [self completePup: outPac]
ifFalse: [resultSet ← true]].
"1095" NameUser$'Handle input'
[socProcess: Ipac | i j best bestHops |
"overwrite from Socket"
"called from Ether stuff, running at a very high level"
resultSet "dummy block"
ifFalse:
[ "we are not waiting!!" "must be the answer, or an error"
self timerOff.
resultSet ← true.
146 = Ipac pupType "error"
ifFalse:
[ "user show: (Ipac dataString). "
.
145 Ipac pupType "error"
ifFalse:
[ "user show: 'unknown pup received by name user.'" "an answer arrived"
.
result ← Ipac dataString "1 or more 6 byte blocks".
result length = 6
ifFalse:
[ "all done" "more than one, find the nearest address"
.
best ← 1.
bestHops ← 16.
(1 to: result length by: 6) do:
[:i | NETNUM = (result i)
ifTrue:
[best ← i.
bestHops ← 0]
ifFalse:
[.
j ← routingHopCount (result i).
j < bestHops
ifTrue:
[best ← i.
bestHops ← j]
ifFalse:
[]]].
result ← result copy: best to: best + 5]]]] "dummy block" "all done".
self freePacket: Ipac].
"186" NameUser$'Initialization'
[init | |
E wakeup "create a NameUser, to socket 4, from a default local socket number".
self net: 0 host: 0 soc: 4 asInt32.
self retransmit: 2 every: 300].
"283" NameUser$'Output requests'
[getAddressBlock: str | |
result ← resultSet ← false "returns a string, 6 bytes: net/host/socket".
outPac ← self freePacket.
outPac pupType← 144.
outPac dataString← str.
self setAddressesAndComplete: outPac.
[resultSet] whileFalseDo: [].
↑result].
"116" NameUser$'Output requests'
[getName: str | |
"convert string address back to host name"
"not implemented yet"].
"253" NameUser$'Output requests'
[getAddressString: str | temp |
"return string representation"
(temp ← self getAddressBlock: str)
ifTrue: [↑(temp 1) base8 + '#' + (temp 2) base8 + '#' + (temp word: 2) base8 + '|' + (temp word: 3) base8].
↑false].
"397" Socket$'Initialization'
[hostName: name | a nh |
a ← NameUser init "lookup name, then set net and host numbers (maybe socket?)".
nh ← a getAddressBlock: name "since this socket may get many responses,
make sure socket is not half deleted from sockeTable after first response".
Top critical [(a close)].
nh
ifTrue: [self net: nh 1 host: nh 2]
ifFalse: [ "invalid name?"
↑false]].
"97" Socket$'Initialization'
[to: h | |
self net: NETNUM host: h "convenient default if on my net"].
"225" Socket$'Initialization'
[from: t1 | |
lclSocNum ← t1.
self from: lclSocNum net: 0 host: 0 soc: (Int32 new "set lcl soc number, leave frnPort open -- useful for creating
a well-known socket as a listener" high: 0 low: 0)].
"127" Socket$'Access to Parts'
[close | |
self release.
(sockeTable lookup: lclSocNum)
ifTrue: [sockeTable delete: lclSocNum]].
"331" 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 destSoc0← socNumber high.
packet destSoc1← socNumber low "I assume that the length and type have been done".
self completePup: packet].
"208" Socket$'Access to Parts'
[freePacket | p |
freeQ
ifTrue:
[ "get a packet"
(p ← freeQ next)
ifTrue: [↑p].
user show: 'Warning, empty freeQ, in Socket'.
↑false]
ifFalse: [↑Pacbuf new init]].
"138" Socket$'Access to Parts'
[freePacket: p | |
"put a used packet into free queue"
(freeQ and: [p])
ifTrue: [freeQ next← p].
↑false].
"58" SafeQ$'As yet unclassified'
[enable | |
enabled ← true].
"299" SafeQ$'As yet unclassified'
[next← arg | i |
"short comment"
enabled
ifTrue: [(readposition + 1 to: position) do:
[:i | array i arg
ifTrue: [E notify: 'putting same guy on Q twice']]].
arg locked
ifTrue: [E notify: 'putting locked Pacbuf on Q']
ifFalse: [super next← arg]].
"52" SafeQ$'As yet unclassified'
[status | |
↑enabled].
"68" SafeQ$'As yet unclassified'
[length | |
↑position - readposition].
"60" SafeQ$'As yet unclassified'
[disable | |
enabled ← false].
"221" PQueue$'FIFO access'
[next | n |<primitive: 75>
Top critical [
(readposition position
ifTrue:
[readposition ← position ← 0.
n ← false]
ifFalse: [n ← array (readposition ← readposition + 1)])].
↑n].
"191" PQueue$'FIFO access'
[peek | n |
Top critical [
(readposition position
ifTrue:
[readposition ← position ← 0.
n ← false]
ifFalse: [n ← array (readposition + 1)])].
↑n].
"118" PQueue$'Stream protocol'
[contents | n |
Top critical [(n ← (array (readposition + 1 to: position)) copy)].
↑n].
"156" PQueue$'Stream protocol'
[of: t1 from: t2 to: t3 | |
array ← t1.
position ← t2.
limit ← t3.
user notify: 'of:from:to: is not appropriate for PQueues'].
"87" PQueue$'FIFO access'
[skip: x | |
Top critical [(readposition ← readposition + x)]].
"41" PQueue$'FIFO access'
[myend | |
↑true].
"85" PQueue$'Stream protocol'
[reset | |
Top critical [(readposition ← position ← 0)]].
"107" PQueue$'Stream protocol'
[empty | l |<primitive: 75>
Top critical [(l ← readposition position)].
↑l].
"90" PQueue$'Stream protocol'
[end | n |
Top critical [(n ← readposition position)].
↑n].
"131" PQueue$'Stream protocol'
[of: t1 | |
array ← t1.
Top critical [
(position ← 0.
readposition ← 0.
limit ← array length)]].
"392" PQueue$'FIFO access'
[pastend← x | n i |
"simple arg"
Top critical [
(position limit
ifTrue:
[readposition = 0
ifTrue: [super pastend← x]
ifFalse:
[n ← position - readposition.
(1 to: n) do: [:i | array i ← array (readposition + i)].
readposition ← 0.
position ← n.
self next← x]]
ifFalse: [array (position ← position + 1) ← x])].
↑x].
"241" PQueue$'FIFO access'
[dequeue: num | n |
Top critical [
(position - readposition < num
ifTrue: [n ← false]
ifFalse:
[n ← (array (readposition + 1 to: readposition + num)) copy.
readposition ← readposition + num])].
↑n].
"89" PQueue$'FIFO access'
[length | l |
Top critical [(l ← position - readposition)].
↑l].
"273" PQueue$'LIFO access'
[push: x | |
"treat as LIFO queue"
Top critical [
(readposition > 0
ifTrue:
[array readposition ← x.
readposition ← readposition - 1]
ifFalse: [ "readpositon > 0, just jam it in"
self insert: x])] "otherwise insert on front"].
"1357" PressFile$'Entity/Page/File Commands'
[toPrinter: ndest | psocket dest np t perr |
"a printer name"
ndest false
ifTrue: [↑false].
"don't try to print"
E nil
ifTrue:
[t ← (String new: 100) "use O.S. if Smalltalk ethercode not alive" asStream.
t append: 'Empress. '.
t append: self name.
ndest length > 0
ifTrue:
[t space.
t append: ndest.
t append: '/H'].
t append: '; Resume.~ Small.Boot'.
user quitThen: t asReadStream]
ifFalse:
[dest ← ''.
perr ← psocket ← false.
np ← printers length + 1.
DL readonly.
[ndest] whileTrueDo:
[(perr or: [ndest empty])
ifTrue:
[perr ← false.
ndest ← self selectPrinter: dest]
ifFalse:
[dest = ndest
ifFalse:
[ "to same printer"
dest ← ndest "close previous socket".
psocket
ifTrue:
[psocket close.
psocket ← false]].
psocket
ifFalse:
[ "create new socket"
(psocket ← EFTPSender new hostName: dest)
ifTrue: [psocket wakeup]
ifFalse:
[user cr.
user show: 'name lookup failure']] "send file".
(psocket and: [(user displayoffwhile [(psocket send: DL reset)])])
ifTrue: [ndest ← false "success--stop"]
ifFalse: [ "failure--switch servers?"
perr ← true]] "cleanup after success or abort"].
DL close.
psocket
ifTrue: [psocket close]]].
"134" PressFile$'EL commands'
[setp: p | |
EL next← 238 "self setx: p x; sety: p y".
EL nextword← p x.
EL next← 239.
EL nextword← p y].
"86" PressFile$'Initialization'
[reset | |
DL readwriteshorten.
DL reset.
self of: DL].
"3446" PressFile$'Reading'
[nextControl | command t entity |
command ← nil "return the next skip-control information".
[true] whileTrueDo:
[(estate and: [command]) false
ifTrue:
[(t ← EL next "either or both false. get next entity")
ifTrue:
[estate ← EL next viewer.
command ← nil.
t 1 SMentity
ifTrue: [estate ← false "ignore this entity"]
ifFalse:
[DLstart ← (t (3 to: 6)) asStream nextNumber: 4.
DL position← Pstart * recordsize + DLstart]]
ifFalse:
[ "no more entities on current part (page)"
self readPart
ifFalse: [ "no more pages"
↑false]]]
ifFalse:
[entity ← estate.
[command ← entity next] whileTrueDo:
[command < 64 "some stuff arranged by probable frequency"
ifTrue: [DL skip: (command land: 31) "show-characters-short (0-037)
skip-characters-short (040-077)" + 1]
ifFalse:
[command = 238
ifTrue: [entity nextword "set-x"]
ifFalse:
[command = 239
ifTrue: [entity nextword "set-y"]
ifFalse:
[command < 96
ifTrue: [DL skip: (command land: 31) "show-characters-and-skip (0100-0137)" + 2]
ifFalse:
[command < 112
ifTrue: [entity next "set-space-x-short (0140-0147)
set-space-y-short (0150-0157)" "(command land: 7)*256 +"]
ifFalse:
[command < 128
ifFalse:
[ "font" "command land: 017"
command = 242
ifTrue:
[t ← entity nextword "skip-control-bytes".
entity next SMentity
ifTrue: [DL skip: t "ignore"]
ifFalse: [↑DL next: t]]
ifFalse:
[command = 240
ifTrue: [DL skip: entity next "show-characters"]
ifFalse:
[command = 255
ifFalse:
[ "nop"
command < 235
ifFalse:
[ "available (0200-0237)
spare (0240-0352)"
command = 235
ifTrue: [↑entity next: entity next "skip-control-bytes-immediate"].
command = 236
ifTrue: [entity skipwords: 5 "alternative"]
ifFalse:
[command = 237
ifTrue: [entity next "only-on-copy"]
ifFalse:
[command = 241
ifTrue: [DL skip: entity next "skip characters"]
ifFalse:
[command = 243
ifTrue: [entity next "show-character-immediate"]
ifFalse:
[command < 246
ifTrue: [entity nextword "set-space-x (0364)
set-space-y (0365)"]
ifFalse:
[command < 248
ifFalse:
[ "reset-space (0366)
space (0367)"
command < 251
ifTrue: [entity next "set-brightness (0370)
set-hue (0371)
set-saturation (0372)"]
ifFalse:
[command = 251
ifTrue: [DL skipwords: entity nextword "show-object"]
ifFalse:
[command < 254
ifTrue: [DL skipwords: (entity nextNumber: 4) "show-dots (0374)
show-dots-opaque (0375)"]
ifFalse:
[command = 254
ifTrue: [entity skipwords: 2 "show-rectangle"]]]]]]]]]]]]]]]]]]]]]]]].
"1001" PressFile$'Private'
[classInit | a p |
Smalltalk declare: #PressScale as: 32 "PressFile classInit.".
recordsize ← 512.
SMentity ← 5.
a ← (String new: 250) asStream "from [Maxc1]<Altodocs>NetTopology.Press, October 1980. in order of net number".
printers ← #('Navajo' 'Menlo' 'Clover' 'Lilac' 'Kanji' 'Wonder' 'Quake' 'Puff' 'White' 'Colorado' 'Niagara' 'Tioga' 'Yoda' 'Lily' 'Ranger' 'Windfall' 'Genesee' 'Amarok' 'Yankee' 'Cyclops' 'Rover' 'SPGEng' 'Emperor' 'Thud' 'Adelie' 'Daisy' 'RockHopper' 'Bud' ) "net #" "printer names" " 1" "HENRIETTA" " 3" "PARC: BLDG 35, FLOOR 2" " 5" "PARC: BLDG 34" " 6" "PARC: BLDG 35, FLOOR 1&3" "10" "A&E" "12" "PASADENA" "14" "WEBSTER" "20" "PARC: BLDG 32" "21" "SPG" "23" "DALLAS" "26" "DC" "27" "WEBSTER" "33" "TORONTO" "34" "STAMFORD" "36" "LEESBURG" "54" "A&E" "55" "A&E" "56" "A&E" "60" "BAYHILL" "62" "?".
printers do:
[:p | a append: p.
a cr].
a append: 'same printer'.
a cr.
a append: 'no printer'.
printerMenu ← Menu new string: a contents].
"184" PressFile$'Reading'
[filin | p |
self open.
[p ← self nextParagraph] whileTrueDo:
[FilinSource ← self.
user print: nil p text.
user space].
FilinSource ← nil.
self close].
"1763" PressFile$'Entity/Page/File Commands'
[close | p i font t4 |
DL writing false
ifTrue: [DL close]
ifFalse:
[self closePage.
(parts false or: [parts empty])
ifFalse:
[ "if present, include the external file part --- added Sept 80"
FL empty
ifFalse:
[self part [(DL append: FL)] code: 2.
FL reset.
self padpage] "put font names and descriptions into font directory (part)".
self part [((1 to: fontdefs length) do:
[:i | font ← fontdefs i.
DL nextword← 16.
DL nextword← i - 1.
DL next← font min.
DL next← font max.
self Bcpl: font name pad: 20.
DL next← font face.
DL next← font min.
DL nextword← font pointsize.
DL nextword← 0])] code: 1 "write part directory. Pstart is current page position".
DL append: parts asReadStream.
self padpage.
p ← self recordnum "document directory".
DL nextword← 27183 "press password".
DL nextword← p + 1 "number of records".
DL nextword← parts position / 8 "number of parts".
DL nextword← Pstart "part dir and length".
DL nextword← p - Pstart.
DL nextword← 1 "backpointer to obsolete doc dir".
DL append: user timewords "2 time words".
DL nextword← 1 "first and last copies".
DL nextword← 1.
DL nextword← 1 "first and last pages".
DL nextword← 1.
DL nextword← 'S' 1 "solid color (looked at by color printers)".
DL next: (2 * (127 - 12)) ← 255.
p ← user now.
self Bcpl: self name pad: 52.
self Bcpl: (currentProfile nil
ifTrue: [dp0 diskID 1]
ifFalse: [currentProfile printedBy]) pad: 32.
self Bcpl: ((t4 ← (String new: 40) asStream) print: p 1.
t4 space.
t4 print: p 2.
t4 contents) pad: 40.
self padpage.
DL close.
parts reset]]].
"138" PressFile$'EL commands'
[showrect: rect | |
self setp: rect origin.
EL next← 254.
EL nextword← rect width.
EL nextword← rect height].
"591" PressFile$'Bitmaps/Dots'
[AIS: file width: w height: h croprect: r at: pt scale: s | |
self setp: (self transpt: pt).
self dots [
(self setcoding: 8 dots: w lines: h "byte samples".
self setmode: 3 "to right and to bottom of page".
self setsizewidth: (s * r width * scale) asInteger height: (s * r height * scale) asInteger.
self setwindowwidth: r width height: r height skipdots: r minX skiplines: r minY.
self dotsfromAIS: file)] "
(dp0 pressfile: 'pix.press') somefont; AIS: 'girl.ais' width: 512 height: 512 croprect: (5050 rect: 500500) at: 3680 scale: 0.65; close.
"].
"218" PressFile$'Bitmaps/Dots'
[dotsfromAIS: file | f |
f ← file length inString + file + (file length even
ifTrue: [' ']
ifFalse: ['']) "BCPLize".
DL nextword← 4.
DL nextword← 4.
DL append: f.
FL append: f].
"173" PressFile$'Bitmaps/Dots'
[setwindowwidth: w height: h skipdots: sd skiplines: sl | |
DL nextword← 1.
DL nextword← sd.
DL nextword← w.
DL nextword← sl.
DL nextword← h].
"135" PressFile$'Aspects'
[defaultPrinterName | |
↑currentProfile nil
ifTrue: [PrinterName]
ifFalse: [currentProfile printerName]].
"358" PressFile$'Entity/Page/File Commands'
[screenout: rect scale: t2 | |
scale ← t2.
user displayoffwhile [
"puts a bit map image onto the PressFile. The standard
scaling is 32 micas per Alto dot. 22 looks better, Dover only
works with 32"
(self somefont.
self setp: (self transrect: rect) origin.
self bitmap: rect bits: false.
self close)]].
"217" PressFile$'Reading'
[nextParagraph | s p |
(s ← self nextControl)
ifTrue:
[s ← s asStream.
p ← Paragraph new.
s next = p pressCode
ifTrue: [↑p fromPress: self value: s].
↑false]
ifFalse: [↑false]].
"77" PressFile$'Lines/Objects'
[moveto: p | |
DL nextword← 0.
DL nextPoint← p].
"66" PressFile$'Entity/Page/File Commands'
[page | |
self closePage].
"504" PressFile$'Entity/Page/File Commands'
[selectPrinter: oldName | t |
user cr.
user show: 'select a printer (currently '.
user show: ((oldName false or: [oldName empty])
ifTrue: ['none']
ifFalse: [oldName]).
user show: ')'.
user cursorloc← user screenrect center.
user restoredisplay.
t ← 0.
[t = 0] whileTrueDo: [t ← printerMenu wbug].
↑t printers length
ifTrue: [printers t]
ifFalse:
[t = (printers length + 1)
ifTrue: [oldName]
ifFalse: [ "same" "none"
false]]].
"105" PressFile$'Entity/Page/File Commands'
[selectPrinter | |
↑self selectPrinter: self defaultPrinterName].
"58" PressFile$'Private'
[data | |
↑DL "slightly dangerous"].
"102" PressFile$'Fonts'
[codefont: code style: style | |
↑fontdefs (self fontindex: code style: style)].
"218" PressFile$'EL commands'
[setspacex: x | |
estate 2 = x
ifFalse:
[estate 2 ← x.
(x 0 and: [x 2047])
ifTrue: [EL nextword← 24576 + x "short form"]
ifFalse:
[EL next← 244.
EL nextword← x]]].
"49" WidthTable$'Access'
[pointsize | |
↑pointsize].
"39" WidthTable$'Access'
[face | |
↑face].
"45" WidthTable$'Access'
[descent | |
↑descent].
"37" WidthTable$'Access'
[tab | |
↑tab].
"37" WidthTable$'Access'
[max | |
↑max].
"43" WidthTable$'Access'
[tab← t | |
tab ← t].
"367" WidthTable$'Initialization'
[lookup | key font i |
key ← name + pointsize asString + (#('' 'I' 'B' 'BI' ) (face + 1)).
(font ← WidthDict lookup: key)
ifTrue: [↑font].
self fontfrom: (dp0 oldFile: 'Fonts.Widths') readonly.
#(9 13 32 ) do:
[:i | (i min and: [i max])
ifTrue: [widths (i - min + 1) ← 0]].
WidthDict insert: key with: self.
↑self].
"37" WidthTable$'Access'
[min | |
↑min].
"259" WidthTable$'Reading FONTS.WIDTHS'
[findfield: n on: file | IXH t4 |
[IXH ← file nextword.
(t4 ← IXH bits: (0 to: 3)) = 0 "type"
ifTrue: [user notify: 'field not found']
ifFalse: [t4 n]] whileTrueDo: [file skipwords: (IXH land: 4095) "length" - 1]].
"1231" WidthTable$'Reading FONTS.WIDTHS'
[fontfrom: file | i code fam fmin fmax start len found w scale |
file reset "find code for font family".
fam ← ''.
[fam = name] whileFalseDo:
[self findfield: 1 on: file.
code ← file nextword.
fam ← file next: (len ← file next).
file skip: 19 - len "now search for proper face"].
found ← false "Convert from points to micas".
scale ← (pointsize asFloat * 2540 / 72) asInteger.
[found] whileFalseDo:
[self findfield: 4 on: file.
found ← (file next = code).
file next face
ifTrue: [found ← false].
fmin ← file next.
fmax ← file next.
i ← file nextword.
(i scale and: [i 0])
ifTrue: [found ← false].
file skip: 4.
start ← file nextword.
file skip: 4].
scale ← (i 0
ifTrue: [1]
ifFalse: [ "don't need to scale"
pointsize asFloat * 254 / 7200]).
min ← fmin.
max ← fmax "get bb and x-tables".
file wordposition← start + 1.
descent ← 0 - (scale * file nextword) asInteger.
file nextword.
ascent ← (scale * file nextword) asInteger.
file nextword.
widths ← Vector new: max - min + 1.
(1 to: widths length) do:
[:i | w ← file nextword.
widths i ← (w > 0
ifTrue: [(scale * w) asInteger]
ifFalse: [0])].
file close].
"39" WidthTable$'Access'
[space | |
↑150].
"86" WidthTable$'Initialization'
[classInit | |
WidthDict ← Dictionary init.
tab ← 500].
"43" WidthTable$'Access'
[ascent | |
↑ascent].
"489" WidthTable$'Access'
[scan: strm until: width exceeds: maxw | char w |
[char ← strm next] whileTrueDo:
[char < min
ifTrue:
[(char = 32 or: [(char = 13 or: [char = 9])])
ifTrue: [↑{char , width}].
user notify: 'char too low']
ifFalse:
[char > max
ifTrue: [user notify: 'char too high']
ifFalse:
[(w ← widths (char + 1 - min)) = 0
ifTrue: [↑{char , width}].
(width ← width + w) > maxw
ifTrue: [↑{true , width}]]]].
↑{false , width}].
"39" WidthTable$'Access'
[name | |
↑name].
"108" WidthTable$'Initialization'
[named: t1 pointsize: t2 face: t3 | |
name ← t1.
pointsize ← t2.
face ← t3].
"755" PressFile$'Fonts'
[fontindex: code style: style | ix font n |
code ← code land: 243 "return index if in font dictionary" "Remove underline and strikeout".
style = prevstyle
ifTrue:
[(ix ← fontcodes find: code) > 0
ifTrue: [↑ix]]
ifFalse:
[fontcodes all← nil "invalid across style change".
prevstyle ← style].
n ← code / 16 + 1.
font ← (WidthTable new named: (style fontfamily: n) pointsize: (style fontsize: n) face: (code / 2 land: 1) + (code * 2 land: 2)) lookup.
(ix ← fontdefs find: font) > 0
ifTrue:
[fontcodes ix ← code.
↑ix].
"add entry to font dictionary"
fontdefs length = 16
ifTrue:
[user notify: 'too many fonts'.
↑1].
fontcodes ← {fontcodes , code}.
fontdefs ← {fontdefs , font}.
↑fontcodes length].
"101" PressFile$'Fonts'
[selectfont: f | |
estate 1 = f
ifFalse: [EL next← 112 + (estate 1 ← f)]].
"182" PressFile$'EL commands'
[skipchars: n | |
n = 0
ifFalse:
[(n 1 and: [n 32])
ifTrue: [EL next← 32 + n "short form" - 1]
ifFalse:
[EL next← 241.
EL next← n]]].
"177" PressFile$'EL commands'
[showchars: n | |
n = 0
ifFalse:
[(n 1 and: [n 32])
ifTrue: [EL next← n - 1 "short form"]
ifFalse:
[EL next← 240.
EL next← n]]].
"178" PressFile$'EL commands'
[showchars: n skip: t | |
(t = 1 and: [(n 1 and: [n 32])])
ifTrue: [EL next← 64 + n - 1]
ifFalse:
[self showchars: n.
self skipchars: t]].
"307" PressFile$'Private'
[skipcode: code data: s | t |
(t ← s length "called by hidePress:complete:. s is a String" + 1) < 256
ifTrue:
[self skipcontrol: t "immediate, in EL".
EL next← code.
EL append: s]
ifFalse:
[ "in DL"
DL next← code.
DL append: s.
self skipcontrol: t type: SMentity]].
"219" PressFile$'Private'
[Bcpl: s pad: n | slen |
slen ← s length "write a Bcpl string and padding to fill n bytes (used by close)" min: n - 1.
DL next← slen.
DL append: s (1 to: slen).
DL next: (n - (slen + 1)) ← 0].
"42" PressFile$'Aspects'
[name | |
↑DL name].
"65" PressFile$'EL commands'
[hue: b | |
EL next← 249.
EL next← b].
"375" PressFile$'Reading'
[open | t |
DL readonly "read the parts (and font directory?)" "reopen?".
DL settoend.
DL skip: 0 - recordsize.
(DL nextword = 27183 and: [DL nextword = (self recordnum + 1)])
ifTrue:
[t ← DL nextword.
DL position: DL nextword size: recordsize.
parts ← (DL next: t * 8) viewer.
self readPart]
ifFalse: [self error: 'not a press file']].
"56" PressFile$'Initialization'
[scale: t1 | |
scale ← t1].
"139" PressFile$'EL commands'
[showrect: rect color: c | |
ColorPrint
ifTrue: [self brightness: c].
self showrect: (self transrect: rect)].
"67" PressFile$'Private'
[closeEntity | |
self closeEntity: SMentity].
"159" PressFile$'Transformations'
[transrect: rect | |
↑Rectangle new origin: (self transpt: rect minX rect maxY) corner: (self transpt: rect maxX rect minY)].
"76" PressFile$'Entity/Page/File Commands'
[entityorigin: t1 | |
eorigin ← t1].
"67" PressFile$'Private'
[recordnum | |
↑DL positionSize: recordsize].
"70" PressFile$'EL commands'
[sety: y | |
EL next← 239.
EL nextword← y].
"70" PressFile$'EL commands'
[setx: x | |
EL next← 238.
EL nextword← x].
"122" PressFile$'Transformations'
[transpt: p | |
↑Point new x: (p x * scale) asInteger y: (25400 - (p y * scale)) asInteger].
"127" PressFile$'Fonts'
[somefont | |
"fool self into writing non-empty fontdir"
self fontindex: 5 * 16 style: DefaultTextStyle].
"88" PressPrinter$'Initialization'
[of: t1 | |
strm ← t1.
press ← PressFile new of: strm].
"127" PressPrinter$'Writing'
[print: para | |
self print: para in: (Rectangle new origin: frame origin corner: frame maxX ypos)].
"59" PressPrinter$'Initialization'
[press: t1 | |
press ← t1].
"60" PressPrinter$'Writing'
[nextpage | |
self nextpage: true].
"56" ParagraphPrinter$'Access to state'
[frame | |
↑frame].
"64" ParagraphPrinter$'Access to state'
[style← t1 | |
style ← t1].
"262" ParagraphPrinter$'Class stuff'
[printForget: selector class: class | |
"Print a line that causes a message to be forgotten"
user cr.
user show: '~' + class title + ' ' + selector.
self print: (class title + ' derstands: ' + selector + '.
') asParagraph].
"70" ParagraphPrinter$'Access to state'
[defaultframe | |
↑defaultframe].
"206" ParagraphPrinter$'Initialization'
[classInit | inch |
inch ← 2540 "1 inch in micas".
defaultframe ← (0.75 * inch) asInteger (1 * inch) rect: (7.75 * inch) asInteger (10 * inch).
defaultleading ← 0].
"59" ParagraphPrinter$'Initialization'
[of: t1 | |
strm ← t1].
"52" ParagraphPrinter$'Closing'
[close | |
strm close].
"139" ParagraphPrinter$'Initialization'
[init | |
self frame← self defaultframe.
self leading← defaultleading.
self style← DefaultTextStyle].
"1843" 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].
user displayoffwhile [
(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: [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]]]])]].
"74" ParagraphPrinter$'Access to state'
[defaultleading | |
↑defaultleading].
"400" ParagraphPrinter$'Class stuff'
[printclass: class | c first |
(class is: Vector)
ifTrue:
[first ← true.
class do:
[:c | first
ifTrue: [first ← false]
ifFalse: [self nextpage].
self printclass: c]]
ifFalse: [user displayoffwhile [
((class is: UniqueString)
ifTrue: [class ← Smalltalk class].
user cr.
user show: class title.
class paraprinton: self)]]].
"108" ParagraphPrinter$'Writing'
[print: para | |
"A dummy, subclasses will override"
strm append: para text].
"281" ParagraphPrinter$'Class stuff'
[stamp | s t |
t ← user now "date and time".
s ← Stream default.
s append: '''From '.
s append: user version.
s append: ' on '.
s print: t 1.
s append: ' at '.
s print: t 2.
s append: '.'' '.
s cr.
self print: s contents asParagraph].
"68" ParagraphPrinter$'Access to state'
[leading← t1 | |
leading ← t1].
"64" ParagraphPrinter$'Access to state'
[frame← t1 | |
frame ← t1].
"374" CodePane$'Window protocol'
[hardcopy: pf | t2 |
selectorPane self "if this is just part of a CodeWindow, then print entire Paragraph with no frame.
unfortunately, the test for this is a kludge. otherwise, print clipped"
ifTrue:
[(t2 ← PressPrinter init) press: pf.
t2 print: pared contents]
ifFalse:
[frame hardcopy: pf thickness: 1.
pared hardcopy: pf]].
"49" CodePane$'Window protocol'
[kbd | |
pared kbd].
"56" CodePane$'Window protocol'
[keyset | |
↑pared keyset].
"56" CodePane$'Window protocol'
[leave | |
scrollBar hide].
"62" CodePane$'Window protocol'
[picked | |
↑frame has: user mp].
"59" CodePane$'Window protocol'
[redbug | |
↑pared selecting].
"67" CodePane$'Browse/Notify protocol'
[contents | |
↑pared contents].
"796" CodePane$'Window protocol'
[doit | s val d t4 |
d ← (NoteTaker
ifTrue: [false]
ifFalse:
[user leftShiftKey
ifTrue: [mem 55]
ifFalse: [false]]).
d
ifTrue: [mem 55 ← 58].
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.
pared Scrap← ((t4 ← (String new: 100) asStream) space.
t4 print: val.
t4 contents asParagraph).
pared selectRange: (s to: s).
pared paste].
scrollBar show.
d
ifTrue: [mem 55 ← d]].
"56" CodePane$'Window protocol'
[enter | |
scrollBar show].
"92" CodePane$'Browse/Notify protocol'
[dirty | |
pared formerly
ifTrue: [↑frame].
↑false].
"102" CodePane$'Browse/Notify protocol'
[selectRange: r | |
pared selectRange: r.
pared selectAndScroll].
"61" CodePane$'Initialization'
[from: t1 | |
selectorPane ← t1].
"126" CodePane$'Initialization'
[classInit | |
editmenu ← Menu new string: 'again
copy
cut
paste
doit
compile
undo
cancel
align'].
"62" CodePane$'Window protocol'
[outside | |
↑scrollBar startup].
"103" CodePane$'Window protocol'
[close | |
pared unselect.
selectorPane ← pared ← nil.
scrollBar close].
"74" CodePane$'Window protocol'
[windowenter | |
self outline.
pared enter].
"85" CodePane$'Window protocol'
[windowleave | |
pared nil
ifFalse: [pared leave]].
"172" LADVariableNode$'Initialization'
[NTinit | |
"rehash for new oops after Vmem write"
(NoteTaker and: [initted false])
ifTrue:
[self classInit.
initted ← true]].
"338" LADVariableNode$'Code Generation'
[emitStorePop: stack on: strm | |
(code between: 0 and: [7])
ifTrue: [strm next← ShortStoP + code "short stopop inst"]
ifFalse:
[(code between: 16 and: [23])
ifTrue: [strm next← ShortStoP + 8 + code - 16 "short stopop temp"]
ifFalse: [self emitLong: StorePop on: strm]].
stack pop: 1].
"272" LADVariableNode$'Code Generation'
[emitForReturn: stack on: strm | |
(code LdSelf and: [code LdNil])
ifTrue:
[ "short returns"
strm next← EndMethod - 4 + (code - LdSelf).
stack push: 1 "doesnt seem right"]
ifFalse: [super emitForReturn: stack on: strm]].
"98" LADVariableNode$'Code Generation'
[emitStore: stack on: strm | |
self emitLong: Store on: strm].
"91" LADVariableNode$'Code Generation'
[sizeForStore: encoder | |
self reserve: encoder.
↑2].
"148" LADVariableNode$'Code Generation'
[sizeForStorePop: encoder | |
self reserve: encoder.
(code < 24 and: [(code nomask: 8)])
ifTrue: [↑1].
↑2].
"117" LADVariableNode$'Simplifying'
[canBeSpecialArgument | |
"can I be an argument of (e.g.) ifTrue:?"
↑code < LdNil].
"141" LADVariableNode$'Initialization'
[name: varName key: objRef index: i type: type | |
name ← varName.
self key: objRef index: i type: type].
"81" LADVariableNode$'Printing'
[printon: strm indent: level | |
strm append: name].
"120" LADVariableNode$'Initialization'
[name: string key: object code: byte | |
name ← string.
key ← object.
code ← byte].
"175" LADLiteralNode$'Code Generation'
[emitForValue: stack on: strm | |
code < 256
ifTrue: [strm next← code]
ifFalse: [self emitLong: LdInstLong on: strm].
stack push: 1].
"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].
"542" LADLeafNode$'Code Generation'
[emitLong: mode on: strm | type index |
"emit extended variable access"
code < 256
ifTrue:
[code < 16
ifTrue:
[type ← 0.
index ← code]
ifFalse:
[code < 32
ifTrue:
[type ← 1.
index ← code - 16]
ifFalse:
[code < 96
ifTrue:
[type ← code / 32 + 1.
index ← code \ 32]
ifFalse: [user notify: 'Sends should be handled in SelectorNode']]]]
ifFalse:
[index ← code \ 256.
type ← code / 256 - 1].
strm next← mode.
strm next← type * 64 + index].
"154" LADLeafNode$'Code Generation'
[emitOn: strm | |
code < 256
ifTrue: [strm next← code]
ifFalse:
[strm next← code / 256.
strm next← code \ 256]].
"69" LADLeafNode$'Code Generation'
[emitForEffect: stack on: strm | |
].
"98" LADLeafNode$'Aspects'
[= literal | t |
↑key class literal class and: [(key sameAs: literal)]].
"120" LADLeafNode$'Initialization'
[name: literal key: object index: i type: type | |
self key: object index: i type: type].
"196" LADLeafNode$'Code Generation'
[reserve: encoder | |
"if this is a yet unused literal of type -code, reserve it"
code < 0
ifTrue: [code ← self code: (encoder litIndex: key) type: 0 - code]].
"64" LADLeafNode$'Code Generation'
[sizeForEffect: encoder | |
↑0].
"80" LADLeafNode$'Code Generation'
[size: encoder | |
↑self sizeForValue: encoder].
"41" LADLeafNode$'Aspects'
[code | |
↑code].
"47" LADLeafNode$'Aspects'
[hash | t |
↑key hash].
"116" LADLeafNode$'Code Generation'
[sizeForValue: encoder | |
self reserve: encoder.
code < 256
ifTrue: [↑1].
↑2].
"39" LADLeafNode$'Aspects'
[key | |
↑key].
"87" LADLeafNode$'Initialization'
[key: object code: byte | |
key ← object.
code ← byte].
"118" LADLeafNode$'Initialization'
[key: object index: i type: type | |
self key: object code: (self code: i type: type)].
"179" LADLeafNode$'Private'
[code: index type: type | |
index false
ifTrue: [↑0 - type].
CodeLimits type > index
ifTrue: [↑CodeBases type + index].
↑type * 256 + index].
"188" LADParseNode$'Code Generation'
[emitBranch: dist pop: stack on: strm | |
stack pop: 1.
dist = 0
ifTrue: [strm next← Pop]
ifFalse: [self emitShortOrLong: dist code: Bfp on: strm]].
"221" LADParseNode$'Private'
[emitShortOrLong: dist code: shortCode on: strm | |
(1 dist and: [dist JmpLimit])
ifTrue: [strm next← shortCode + dist - 1]
ifFalse: [self emitLong: dist code: shortCode + 16 on: strm]].
"126" LADParseNode$'Code Generation'
[emitForReturn: stack on: strm | |
self emitForValue: stack on: strm.
strm next← EndMethod].
"396" LADParseNode$'Private'
[emitLong: dist code: longCode on: strm | code |
"force a two-byte jump"
code ← longCode.
dist < 0
ifTrue: [dist ← dist + 1024]
ifFalse:
[dist > 1023
ifTrue: [dist ← 1]
ifFalse: [code ← code + 4]].
dist < 0
ifTrue: [user notify: 'A block compiles more than 1K bytes of code']
ifFalse:
[strm next← dist / 256 + code.
strm next← dist \ 256]].
"107" LADParseNode$'Printing'
[printon: strm indent: level precedence: p | |
self printon: strm indent: level].
"71" LADParseNode$'Simplifying'
[asCollectionElements: length | |
↑false].
"107" LADParseNode$'Simplifying'
[canBeSpecialArgument | |
"can I be an argument of (e.g.) ifTrue:?"
↑false].
"113" LADParseNode$'Printing'
[printon: strm | |
strm append: ''.
self printon: strm indent: 0.
strm append: ' '].
"894" LADParseNode$'Initialization'
[classInit | |
"LADParseNode classInit. LADVariableNode classInit." " | x. LADParseNode classvars contents sort transform x to x+' '+(LADParseNode classvars ref: x) refct asString " "Smalltalk allCallsOn: (LADParseNode classvars ref: NodeTrueFalse) from: (SystemOrganization superclassOrder: 'S80-Compiler') " "LADParseNode classvars clean."
.
LdInstType ← 1.
LdTempType ← 2.
LdLitType ← 3.
LdLitIndType ← 4.
SendType ← 5.
CodeBases ← #(0 16 32 64 208 ).
CodeLimits ← #(16 16 32 32 16 ).
LdSelf ← 112.
LdTrue ← 113.
LdFalse ← 114.
LdNil ← 115.
LdMinus1 ← 116.
LdInstLong ← 128.
Store ← 129.
StorePop ← 130.
ShortStoP ← 96.
SendLong ← 131.
LdSuper ← 133.
Pop ← 135.
Dup ← 136.
LdThisContext ← 137.
EndMethod ← 124.
EndRemote ← 125.
Jmp ← 144.
Bfp ← 152.
JmpLimit ← 8.
JmpLong ← 160.
SendPlus ← 176.
Send ← 208.
SendLimit ← 16].
"96" LADParseNode$'Code Generation'
[sizeForEffect: encoder | |
↑(self sizeForValue: encoder) + 1].
"132" LADParseNode$'Code Generation'
[emitJump: dist on: strm | |
dist = 0
ifFalse: [self emitShortOrLong: dist code: Jmp on: strm]].
"136" LADParseNode$'Code Generation'
[emitLongJump: dist on: strm | |
"force a two byte jump"
self emitLong: dist code: JmpLong on: strm].
"111" LADParseNode$'Code Generation'
[sizeBranch: dist | |
dist = 0
ifTrue: [↑1].
↑self sizeShortOrLong: dist].
"108" LADParseNode$'Private'
[sizeShortOrLong: dist | |
(1 dist and: [dist JmpLimit])
ifTrue: [↑1].
↑2].
"45" LADParseNode$'Simplifying'
[simplify | |
].
"96" LADParseNode$'Code Generation'
[sizeForReturn: encoder | |
↑(self sizeForValue: encoder) + 1].
"109" LADParseNode$'Code Generation'
[sizeJump: dist | |
dist = 0
ifTrue: [↑0].
↑self sizeShortOrLong: dist].
"62" LADParseNode$'Encoding'
[encodeSelector: selector | |
↑nil].
"135" LADParseNode$'Code Generation'
[emitForEffect: stack on: strm | |
self emitForValue: stack on: strm.
strm next← Pop.
stack pop: 1].
"717" LADSelectorNode$'Code Generation'
[emit: stack args: nArgs on: strm super: supered | index |
stack pop: nArgs.
(supered false and: [(code - Send < SendLimit and: [nArgs < 3])])
ifTrue: [ "short send"
strm next← (code < Send
ifTrue: [code]
ifFalse: [ "special"
nArgs * 16 + code])]
ifFalse:
[index ← (code < 256
ifTrue: [code - Send]
ifFalse: [code \ 256]).
(index < 32 and: [nArgs 7])
ifTrue:
[ "medium send"
strm next← SendLong + (supered
ifTrue: [2]
ifFalse: [0]).
strm next← nArgs * 32 + index]
ifFalse:
[ "long send"
.
strm next← SendLong + 1 + (supered
ifTrue: [2]
ifFalse: [0]).
strm next← nArgs.
strm next← index]]].
"484" LADSelectorNode$'Code Generation'
[size: encoder args: nArgs super: supered | index |
self reserve: encoder.
(supered false and: [(code - Send < SendLimit and: [nArgs < 3])])
ifTrue: [↑1].
"short send"
(supered and: [code < Send])
ifTrue: [ "super special:"
code ← self code: (encoder litIndex: key) type: 5].
index ← (code < 256
ifTrue: [code - Send]
ifFalse: [code \ 256]).
(index < 32 and: [nArgs 7])
ifTrue: [↑2].
"medium send"
↑3 "long send"].
"80" LADSelectorNode$'Printing'
[printon: strm indent: level | |
strm append: key].
"126" LADSelectorNode$'Code Generation'
[emit: stack args: nArgs on: strm | |
self emit: stack args: nArgs on: strm super: false].
"133" LADEncoder$'Encoding'
[encodeLiteral: object | |
↑self name: object key: object class: LADLiteralNode type: LdLitType set: litSet].
"45" LADEncoder$'Results'
[maxTemp | |
↑nTemps].
"126" LADEncoder$'Errors'
[notify: string | req |
requestor
ifTrue:
[req ← requestor.
self release.
req notify: string]].
"288" LADEncoder$'Initialization'
[initScopeAndLiteralTables | |
scopeTable ← Dictionary new copyfrom: stdVariables.
litSet ← HashSet new copyfrom: stdLiterals.
selectorSet ← HashSet new copyfrom: stdSelectors.
litIndSet ← HashSet new init: 16.
literalStream ← (Vector new: 32) asStream].
"165" LADEncoder$'Initialization'
[nTemps: n literals: lits class: t3 | |
"Decompile"
class ← t3.
nTemps ← n.
(literalStream ← lits asStream) position← lits length].
"122" LADEncoder$'Private'
[reallyBind: name | node |
node ← self newTemp: name.
scopeTable insert: name with: node.
↑node].
"61" LADEncoder$'Initialization'
[noteSuper | |
supered ← true].
"212" LADEncoder$'Initialization'
[fillDict: dict with: t2 mapping: keys to: codes | cs key |
class ← t2.
cs ← codes asStream.
keys do: [:key | dict insert: key with: (class new name: key key: key code: cs next)]].
"189" LADEncoder$'Initialization'
[fillSet: set with: t2 mapping: keys to: codes | cs key |
class ← t2.
cs ← codes asStream.
keys do: [:key | set insert: (class new key: key code: cs next)]].
"260" LADEncoder$'Initialization'
[bind: name | node |
"declare a temporary; error not if a field or class variable"
((scopeTable has: name) or: [(class classvars has: name)])
ifTrue: [self notify: 'Name already used in this class'].
↑self reallyBind: name].
"135" LADEncoder$'Private'
[global: ref name: name | |
↑self name: name key: ref class: LADVariableNode type: LdLitIndType set: litIndSet].
"219" LADEncoder$'Private'
[name: name key: key class: leafNodeClass type: type set: set | t |
(t ← set lookup: key)
ifTrue: [↑t].
t ← leafNodeClass new name: name key: key index: false type: type.
set insert: t.
↑t].
"190" LADEncoder$'Initialization'
[autoBind: name | node |
"declare a block argument as a temp if not already declared"
(node ← scopeTable lookup: name)
ifTrue: [↑node].
↑self bind: name].
"195" LADEncoder$'Encoding'
[litIndex: literal | p |
p ← literalStream position.
p = 64
ifTrue:
[requestor notify: 'MORE THAN 64 LITERALS REFERENCED'.
↑0].
literalStream next← literal.
↑p].
"491" LADEncoder$'Encoding'
[encodeVariable: name | varNode global ref unq |
(varNode ← scopeTable lookup: name)
ifTrue: [↑varNode].
(unq ← name hasBeenUniqued)
ifTrue: [symbolTables do:
[:global | (ref ← global lookupRef: unq)
ifTrue: [↑self global: ref name: unq]]].
requestor interactive
ifTrue:
[self notify: 'Undeclared'.
↑0].
user show: ' (' + name + ' is Undeclared) '.
unq ← name unique.
Undeclared declare: unq.
↑self global: (Undeclared ref: unq) name: unq].
"139" LADEncoder$'Initialization'
[newTemp: name | |
nTemps ← nTemps + 1.
↑LADVariableNode new name: name index: nTemps - 1 type: LdTempType].
"145" LADEncoder$'Encoding'
[encodeSelector: selector | |
↑self name: selector key: selector class: LADSelectorNode type: SendType set: selectorSet].
"414" LADEncoder$'Results'
[literals: primitive nArgs: nArgs | |
(primitive > 0 or: [nArgs > 4])
ifTrue:
[self litIndex: nArgs * 256 + primitive.
self litIndex: (Smalltalk ref: class title unique)]
ifFalse:
[supered
ifTrue:
[literalStream last (Smalltalk ref: class title unique)
ifFalse: [self litIndex: (Smalltalk ref: class title unique)]]].
↑LiteralKeeperCrock ← literalStream contents].
"54" LADEncoder$'Errors'
[release | |
requestor ← false].
"460" LADBlockNode$'Initialization'
[statements: stmts returns: returnBool | penult |
"decompile"
statements ← ((stmts length > 1 and: [(penult ← stmts (stmts length - 1).
(penult is: LADMessageNode) and: [penult isReturningIf])])
ifTrue:
[returnBool ← false.
(stmts (1 to: stmts length - 1)) copy]
ifFalse:
[stmts length = 0
ifTrue: [NodeNullBlock]
ifFalse: [stmts]]).
arguments ← Vector new: 0.
returns ← returnBool].
"222" LADBlockNode$'Printing'
[printArgumentsOn: strm indent: level | arg |
arguments length = 0
ifFalse:
[arguments reverse do:
[:arg | strm append: ':'.
strm append: arg key.
strm space].
strm append: '| ']].
"93" LADBlockNode$'Initialization'
[arguments: argNodes | |
"decompile"
arguments ← argNodes].
"169" LADBlockNode$'Code Generation'
[sizeExceptLast: encoder | i c |
c ← 0.
(1 to: statements length - 1) do: [:i | c ← c + (statements i sizeForEffect: encoder)].
↑c].
"177" LADBlockNode$'Initialization'
[default | |
"[] argument of missing kwyword in ifTrue: or ifFalse:"
statements ← NodeNullBlock.
arguments ← Vector new: 0.
returns ← false].
"126" LADBlockNode$'Simplifying'
[simplify | i |
(1 to: statements length) do: [:i | statements i ← (statements i) simplify]].
"333" LADBlockNode$'Initialization'
[arguments: argNodes statements: stmts returns: returnBool from: encoder | |
"compile"
arguments ← argNodes.
statements ← (stmts length > 0
ifTrue: [stmts]
ifFalse:
[argNodes length > 0
ifTrue: [{stmts , arguments last}]
ifFalse: [NodeNullBlock]]).
returns ← returnBool].
"308" LADBlockNode$'Initialization'
[transformRemoteVariable | |
"hack converts remote vars to [:x | x] so value← will work"
(NoteTaker or: [returns])
ifTrue: [↑false].
statements length 1
ifTrue: [↑false].
(statements 1 isnt: LADVariableNode)
ifTrue: [↑false].
arguments ← statements.
↑true].
"128" LADBlockNode$'Simplifying'
[justNil | |
returns
ifTrue: [↑false].
↑statements length = 1 and: [statements 1 NodeNil]].
"132" LADBlockNode$'Simplifying'
[justFalse | |
returns
ifTrue: [↑false].
↑statements length = 1 and: [statements 1 NodeFalse]].
"55" LADBlockNode$'Initialization'
[returns | |
↑returns].
"122" LADBlockNode$'Simplifying'
[canBeSpecialArgument | |
"can I be an argument of (e.g.) ifTrue:?"
↑arguments length = 0].
"241" LADBlockNode$'Printing'
[printon: strm indent: level | |
statements length 1
ifFalse: [strm crtab: level].
strm append: '['.
self printArgumentsOn: strm indent: level.
self printStatementsOn: strm indent: level.
strm append: ']'].
"158" LADBlockNode$'Code Generation'
[emitExceptLast: stack on: strm | i |
(1 to: statements length - 1) do: [:i | statements i emitForEffect: stack on: strm]].
"130" LADBlockNode$'Simplifying'
[justTrue | |
returns
ifTrue: [↑false].
↑statements length = 1 and: [statements 1 NodeTrue]].
"261" LADBlockNode$'Code Generation'
[emitForEvaluatedEffect: stack on: strm | |
returns
ifTrue:
[self emitForEvaluatedValue: stack on: strm.
stack pop: 1]
ifFalse:
[self emitExceptLast: stack on: strm.
statements last emitForEffect: stack on: strm]].
"241" LADBlockNode$'Code Generation'
[emitForEvaluatedValue: stack on: strm | |
self emitExceptLast: stack on: strm.
returns
ifTrue: [statements last emitForReturn: stack on: strm]
ifFalse: [statements last emitForValue: stack on: strm]].
"206" LADBlockNode$'Code Generation'
[sizeForEvaluatedEffect: encoder | |
returns
ifTrue: [↑self sizeForEvaluatedValue: encoder].
↑(self sizeExceptLast: encoder) + (statements last sizeForEffect: encoder)].
"473" LADBlockNode$'Code Generation'
[emitForValue: stack on: strm | arg oldRemote |
strm next← LdThisContext.
stack push: 1.
nArgsNode emitForValue: stack on: strm.
remoteCopyNode emit: stack args: 1 on: strm.
self emitLongJump: size on: strm "jmp-around must be 2 bytes".
stack push: arguments length.
arguments do: [:arg | arg emitStorePop: stack on: strm].
self emitForEvaluatedValue: stack on: strm.
self returns
ifFalse: [strm next← EndRemote].
stack pop: 1].
"218" LADBlockNode$'Code Generation'
[sizeForEvaluatedValue: encoder | |
↑(self sizeExceptLast: encoder) + (returns
ifTrue: [statements last sizeForReturn: encoder]
ifFalse: [statements last sizeForValue: encoder])].
"458" LADBlockNode$'Code Generation'
[sizeForValue: encoder | arg |
nArgsNode ← encoder encodeLiteral: arguments length.
remoteCopyNode ← encoder encodeSelector: #blockCopy:.
size ← (self sizeForEvaluatedValue: encoder) + (self returns
ifTrue: [0]
ifFalse: [1]) "endBlock".
arguments do: [:arg | size ← size + (arg sizeForStorePop: encoder)].
↑1 + (nArgsNode sizeForValue: encoder) "current" + (remoteCopyNode size: encoder) + 2 "long jmp" + size].
"161" LADBlockNode$'Initialization'
[quickCode | |
(statements length = 1 and: [(statements 1 is: LADVariableNode)])
ifTrue: [↑(statements 1) code].
↑false].
"491" LADBlockNode$'Printing'
[printStatementsOn: strm indent: level | i len shown |
len ← shown ← statements length.
(level = 1 and: [statements len NodeSelf])
ifTrue: [shown ← 1 max: shown - 1]
ifFalse:
[(len = 1 and: [statements 1 NodeNil])
ifTrue: [shown ← shown - 1]].
(1 to: shown) do:
[:i | (i = len and: [returns])
ifTrue: [strm append: '↑'].
statements i printon: strm indent: level.
i < shown
ifTrue:
[strm append: '.'.
strm crtab: level]]].
"64" LADBlockNode$'Initialization'
[returnLast | |
returns ← true].
"312" LADBlockNode$'Initialization'
[mustReturn | |
returns
ifFalse:
[((statements last is: LADMessageNode) and: [statements last isReturningIf])
ifFalse:
[returns ← true.
statements NodeNullBlock
ifTrue: [statements ← NodeSelf inVector]
ifFalse: [statements ← {statements , NodeSelf}]]]].
"232" LADMessageNode$'Private Initialization'
[transformAnd: encoder | |
(self transformBoolean: encoder)
ifTrue: [arguments ← {arguments 1 , (LADBlockNode new statements: NodeFalse inVector returns: false)}]
ifFalse: [↑false]].
"232" LADMessageNode$'Private Initialization'
[transformOr: encoder | |
(self transformBoolean: encoder)
ifTrue: [arguments ← {(LADBlockNode new statements: NodeTrue inVector returns: false) , (arguments 1)}]
ifFalse: [↑false]].
"233" LADMessageNode$'Private Initialization'
[transformIfTrue: encoder | |
(self transformBoolean: encoder)
ifTrue: [arguments ← {arguments 1 , (LADBlockNode new statements: NodeNil inVector returns: false)}]
ifFalse: [↑false]].
"157" LADMessageNode$'Private Initialization'
[transformWhile: encoder | |
↑(self transformBoolean: encoder) and: [(self canBeSpecial: receiver from: encoder)]].
"716" LADMessageNode$'Code Generation'
[emitIf: stack on: strm value: forValue | thenExpr thenSize elseExpr elseSize |
thenSize ← sizes 1.
elseSize ← sizes 2.
(forValue false and: [elseSize > 0])
ifTrue: [super emitForEffect: stack on: strm]
ifFalse:
[thenExpr ← arguments 1.
elseExpr ← arguments 2.
receiver emitForValue: stack on: strm.
self emitBranch: thenSize pop: stack on: strm.
(forValue false and: [elseSize = 0])
ifTrue: [thenExpr emitForEvaluatedEffect: stack on: strm]
ifFalse:
[thenExpr emitForEvaluatedValue: stack on: strm.
stack pop: 1.
thenExpr returns
ifFalse: [self emitJump: elseSize on: strm].
elseExpr emitForEvaluatedValue: stack on: strm]]].
"707" LADMessageNode$'Code Generation'
[sizeIf: encoder value: forValue | thenExpr thenSize elseExpr elseSize |
thenExpr ← arguments 1.
elseExpr ← arguments 2.
forValue false
ifTrue:
[(elseExpr justNil or: [elseExpr justFalse])
ifTrue:
[elseSize ← 0.
thenSize ← thenExpr sizeForEvaluatedEffect: encoder]
ifFalse: [↑super sizeForEffect: encoder]]
ifFalse:
[elseSize ← elseExpr sizeForEvaluatedValue: encoder.
thenSize ← (thenExpr sizeForEvaluatedValue: encoder) + (thenExpr returns
ifTrue: [0]
ifFalse: [self sizeJump: elseSize])].
sizes 1 ← thenSize.
sizes 2 ← elseSize.
↑(receiver sizeForValue: encoder) + (self sizeBranch: thenSize) + thenSize + elseSize].
"677" LADMessageNode$'Code Generation'
[sizeWhile: encoder value: forValue | cond stmt bfpSize |
cond ← receiver "L1: ... Bfp(L2) ... Jmp(L1) L2: nil (nil for value only)".
stmt ← arguments 1.
sizes ← Vector new: 3 "justStmt, wholeLoop, justJump".
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"].
"57" LADMessageNode$'Printing'
[precedence | |
↑precedence].
"247" LADMessageNode$'Private Initialization'
[transform: encoder | |
special = 0
ifTrue: [↑false].
(self perform: macroTransformers special with: encoder)
ifTrue: [sizes ← Vector new: arguments length]
ifFalse:
[special ← 0.
↑false]].
"184" LADMessageNode$'Code Generation'
[sizeForEffect: encoder | |
special > 0
ifTrue: [↑self perform: macroSizers special with: encoder with: false].
↑super sizeForEffect: encoder].
"152" LADMessageNode$'Private Initialization'
[isReturningIf | |
special = 3
ifTrue: [↑(arguments 1) returns and: [(arguments 2) returns]].
↑false].
"275" LADMessageNode$'Simplifying'
[simplify | n i s |
((n ← #(asArray ) find: selector key) > 0 and: [(s ← self perform: #(simplifyCollection ) n)])
ifTrue: [↑s].
receiver ← receiver simplify.
(1 to: arguments length) do: [:i | arguments i ← (arguments i) simplify]].
"446" LADMessageNode$'Initialization'
[receiver: rcvr selector: selName arguments: args precedence: p from: encoder | |
"compile"
self receiver: rcvr arguments: args precedence: p.
special ← macroSelectors find: selName.
(self transform: encoder)
ifTrue: [selector ← LADSelectorNode new key: macroSelectors special code: #macro]
ifFalse:
[selector ← encoder encodeSelector: selName.
rcvr NodeSuper
ifTrue: [encoder noteSuper]]].
"233" LADMessageNode$'Initialization'
[receiver: rcvr selector: selNode arguments: args precedence: p | |
"decompile"
self receiver: rcvr arguments: args precedence: p.
special ← macroSelectors find: selNode key.
selector ← selNode].
"745" LADMessageNode$'Printing'
[printKeywords: key arguments: args on: strm indent: level | keywords part prev arg |
args length = 0
ifTrue:
[strm space.
strm append: key.
↑self].
keywords ← key keywords.
prev ← receiver.
(1 to: args length) do:
[:part | arg ← args part.
(((prev is: LADBlockNode) or: [((prev is: LADMessageNode) and: [prev precedence 3])]) or: [(part > 1 and: [(arg is: LADBlockNode)])])
ifTrue: [strm crtab: level + 1]
ifFalse: [ "newline after big args"
strm space].
key ← keywords part.
strm append: key.
strm space.
arg printon: strm indent: level + 2 precedence: (precedence = 2
ifTrue: [1]
ifFalse:
[key = '←'
ifTrue: [4]
ifFalse: [precedence]]).
prev ← arg]].
"219" LADMessageNode$'Code Generation'
[emitForEffect: stack on: strm | |
special > 0
ifTrue: [self perform: macroEmitters special with: stack with: strm with: false]
ifFalse: [super emitForEffect: stack on: strm]].
"353" LADMessageNode$'Initialization'
[store: expr from: encoder | |
"ctxt tempAt: n -> ctxt tempAt: n put: expr (see Assignment)"
selector key #tempAt:
ifTrue: [user notify: 'cant transform this message']
ifFalse: [↑LADMessageNode new receiver: receiver selector: #tempAt:put: arguments: {arguments , expr} precedence: precedence from: encoder]].
"296" LADMessageNode$'Printing'
[printon: strm indent: level precedence: p | parenthesize |
parenthesize ← precedence > p or: [(p = 3 and: [precedence = 3 "both keywords"])].
parenthesize
ifTrue: [strm append: '('].
self printon: strm indent: level.
parenthesize
ifTrue: [strm append: ')']].
"336" LADMessageNode$'Simplifying'
[asCollectionElements: length | s |
"{1,2,3}"
(selector key #elementStream and: [receiver key = length])
ifTrue: [↑(Vector new: length) asStream].
(selector key #nextElement: and: [(s ← receiver asCollectionElements: length + 1)])
ifTrue:
[s next← (arguments 1) simplify.
↑s].
↑false].
"236" LADMessageNode$'Private Initialization'
[transformIfFalse: encoder | |
(self transformBoolean: encoder)
ifTrue: [arguments ← {(LADBlockNode new statements: NodeNil inVector returns: false) , (arguments 1)}]
ifFalse: [↑false]].
"186" LADMessageNode$'Private Initialization'
[transformIfTrueIfFalse: encoder | |
↑(self canBeSpecial: arguments 1 from: encoder) and: [(self canBeSpecial: arguments 2 from: encoder)]].
"628" LADMessageNode$'Code Generation'
[emitWhile: stack on: strm value: forValue | cond stmt stmtSize loopSize |
cond ← receiver "L1: ... Bfp(L2)|(Bfp(1)Jmp(L2)) ... Jmp(L1) L2: ".
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]].
"184" LADMessageNode$'Private Initialization'
[receiver: rcvr arguments: args precedence: p | |
receiver ← rcvr.
arguments ← args.
sizes ← Vector new: arguments length.
precedence ← p].
"315" LADMessageNode$'Printing'
[printon: strm indent: level | |
receiver
ifTrue: [receiver printon: strm indent: level precedence: precedence].
(special between: 1 and: [5])
ifTrue: [self printIfOn: strm indent: level]
ifFalse: [self printKeywords: selector key arguments: arguments on: strm indent: level]].
"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: )].
"213" LADMessageNode$'Private Initialization'
[addLeftArrow: lastArg encoder: encoder | |
"for ST76 compatibility"
selector ← encoder encodeSelector: (selector key + '←') unique.
arguments ← {arguments , lastArg}].
"195" LADMessageNode$'Private Initialization'
[canBeSpecial: node from: encoder | |
node canBeSpecialArgument
ifTrue: [↑node is: LADBlockNode].
↑encoder notify: '←Must be a block or a variable'].
"122" LADMessageNode$'Private Initialization'
[transformBoolean: encoder | |
↑self canBeSpecial: arguments 1 from: encoder].
"406" LADMessageNode$'Code Generation'
[emitForValue: stack on: strm | argument |
special > 0
ifTrue: [self perform: macroEmitters special with: stack with: strm with: true]
ifFalse:
[receiver
ifTrue: [receiver emitForValue: stack on: strm].
arguments do: [:argument | argument emitForValue: stack on: strm].
selector emit: stack args: arguments length on: strm super: receiver NodeSuper]].
"525" LADMessageNode$'Code Generation'
[sizeForValue: encoder | argument c s z |
special > 0
ifTrue: [↑self perform: macroSizers special with: encoder with: true].
receiver NodeSuper
ifTrue: [selector ← selector copy "only necess for splOops"].
c ← (selector size: encoder args: arguments length super: receiver NodeSuper) + (receiver
ifTrue: [receiver sizeForValue: encoder]
ifFalse: [0]).
s ← sizes asStream.
arguments do:
[:argument | s next← z ← argument sizeForValue: encoder.
c ← c + z].
↑c].
"654" LADMessageNode$'Printing'
[printIfOn: strm indent: level | |
(arguments 2) justNil
ifTrue: [↑self printKeywords: #ifTrue: arguments: (arguments 1) inVector on: strm indent: level].
(arguments 2) justFalse
ifTrue: [↑self printKeywords: #and: arguments: (arguments 1) inVector on: strm indent: level].
(arguments 1) justNil
ifTrue: [↑self printKeywords: #ifFalse: arguments: (arguments 2) inVector on: strm indent: level].
(arguments 1) justTrue
ifTrue: [↑self printKeywords: #or: arguments: (arguments 2) inVector on: strm indent: level].
self printKeywords: #ifTrue:ifFalse: arguments: arguments on: strm indent: level].
"316" LADCollectionNode$'Initialization'
[elements: vec from: encoder | |
"compile"
elements ← vec.
lengthAsNode ← encoder encodeLiteral: vec length.
elementStreamNode ← encoder encodeSelector: #elementStream.
insertIntoNode ← encoder encodeSelector: #nextElement:.
asArrayNode ← encoder encodeSelector: #asArray].
"329" LADCollectionNode$'Code Generation'
[emitForValue: stack on: strm | element |
lengthAsNode emitForValue: stack on: strm.
elementStreamNode emit: stack args: 0 on: strm.
elements do:
[:element | element emitForValue: stack on: strm.
insertIntoNode emit: stack args: 1 on: strm].
asArrayNode emit: stack args: 0 on: strm].
"309" LADCollectionNode$'Code Generation'
[sizeForValue: encoder | element c |
c ← (lengthAsNode sizeForValue: encoder) + (elementStreamNode size: encoder) + (asArrayNode size: encoder) + (elements length * (insertIntoNode size: encoder)).
elements do: [:element | c ← c + (element sizeForValue: encoder)].
↑c].
"111" LADCollectionNode$'Initialization'
[elements: vec | |
"Decompile via MessageNode simplify"
elements ← vec].
"259" LADCollectionNode$'Printing'
[printon: strm indent: level | i len |
len ← elements length.
strm append: '{'.
(1 to: len) do:
[:i | elements i printon: strm indent: level.
i < len
ifTrue:
[strm append: ','.
strm space]].
strm append: '}'].
"125" LADCollectionNode$'Simplifying'
[simplify | i |
(1 to: elements length) do: [:i | elements i ← (elements i) simplify]].
"172" LADMessageNode$'Simplifying'
[simplifyCollection | strm |
(strm ← receiver asCollectionElements: 0)
ifTrue: [↑LADCollectionNode new elements: strm contents].
↑false].
"167" LADMessageNode$'Initialization'
[cascadeReceiver | rcvr |
(receiver NodeSuper or: [special > 0])
ifTrue: [↑false].
rcvr ← receiver.
receiver ← false.
↑rcvr].
"774" LADEncoder$'Initialization'
[init: cls context: ctxt notifying: req | variable node n homeNode indexNode |
requestor ← req.
class ← cls.
nTemps ← 0.
supered ← false.
symbolTables ← {class wholeEnvironment , Smalltalk}.
self initScopeAndLiteralTables.
n ← 1.
class instvars do:
[:variable | node ← LADVariableNode new name: variable index: (n ← n + 1) type: LdInstType.
scopeTable insert: variable with: node].
ctxt
ifTrue:
[homeNode ← self bind: 'homeContext' "first temp = ctxt passed as arg".
n ← 0.
ctxt tempNames do:
[:variable | indexNode ← self encodeLiteral: (n ← n + 1).
node ← LADMessageNode new receiver: homeNode selector: #tempAt: arguments: indexNode inVector precedence: 3 from: self.
scopeTable insert: variable with: node]]].
"854" LADVariableNode$'Initialization'
[classInit | encoder specials |
"LADVariableNode classInit."
encoder ← LADEncoder new.
stdVariables ← Dictionary new init: 16.
encoder fillDict: stdVariables with: LADVariableNode mapping: #('self' 'thisContext' 'super' 'nil' 'false' 'true' ) to: {LdSelf , LdThisContext , LdSuper , LdNil , LdFalse , LdTrue}.
stdSelectors ← HashSet new init: 64.
specials ← (SpecialOops (10 to: SpecialOops length)) copy.
specials (19 ~ 23) ← {#length , #next , 'next←' unique , #end , #}.
encoder fillSet: stdSelectors with: LADSelectorNode mapping: specials to: (SendPlus to: SendPlus + 31).
stdLiterals ← HashSet new init: 16.
encoder fillSet: stdLiterals with: LADLiteralNode mapping: #(1 0 1 2 ) to: (LdMinus1 to: LdMinus1 + 3).
encoder initScopeAndLiteralTables.
self classInit2: encoder.
initted ← NoteTaker].
"405" LADVariableNode$'Initialization'
[classInit2: encoder | |
"LADVariableNode classInit."
NodeNil ← encoder encodeVariable: 'nil'.
NodeTrue ← encoder encodeVariable: 'true'.
NodeFalse ← encoder encodeVariable: 'false'.
NodeSelf ← encoder encodeVariable: 'self'.
NodeThisContext ← encoder encodeVariable: 'thisContext'.
NodeSuper ← encoder encodeVariable: 'super'.
NodeNullBlock ← NodeNil inVector].
"251" LADVariableNode$'Code Generation'
[emitForValue: stack on: strm | |
code < 256
ifTrue:
[strm next← (code = LdSuper
ifTrue: [LdSelf]
ifFalse: [code]).
stack push: 1]
ifFalse:
[self emitLong: LdInstLong on: strm.
stack push: 1]].
"168" LADVariableNode$'Code Generation'
[sizeForReturn: encoder | |
(code LdSelf and: [code LdNil])
ifTrue: [ "short returns"
↑1].
↑super sizeForReturn: encoder].
"127" LADVariableNode$'Initialization'
[name: varName index: i type: type | |
self name: varName key: varName index: i type: type].
"342" LADParser$'Parser'
[argumentFreeExpression: cascading | rcvr |
"primaryExpression {unarySelector} MessageNode"
(rcvr ← self primaryExpression: cascading)
ifTrue:
[[hereType #word] whileTrueDo: [rcvr ← LADMessageNode new receiver: rcvr selector: self advance unique arguments: #() precedence: 1 from: encoder].
↑rcvr].
↑false].
"848" LADParser$'Parser'
[primaryExpression: cascading | |
"variable VariableNode
constant LiteralNode
'{' {expression ','} [expression] '}' CollectionNode
';' ; when allowed
- number number
| '(' expression ')' | block "
hereType #word
ifTrue: [↑encoder encodeVariable: self advance].
(hereType #string or: [(hereType #number or: [hereType #literal])])
ifTrue: [↑encoder encodeLiteral: self advance].
hereType #leftParenthesis
ifTrue: [↑self subExpression].
hereType #leftBracket
ifTrue: [↑self block].
(hereType #semicolon and: [cascading])
ifTrue: [↑self advance].
hereType #leftBrace
ifTrue: [↑self collection].
((here #- or: [here '' unique]) and: [tokenType #number])
ifTrue:
[ "ST76"
self advance.
↑encoder encodeLiteral: self advance negated].
↑false].
"636" LADParser$'Parser'
[arguments: maxArgs precedence: p | selector args type |
"unarySelector | binarySelector arg | keyword arg {keyword arg}
{selector, arguments, precedence}"
selector ← Stream default.
args ← (Vector new: 4) asStream.
type ← hereType.
[hereType type] whileTrueDo:
[selector append: self advance.
hereType #word
ifTrue:
[args position = maxArgs
ifTrue: [↑self notify: 'Too many arguments'].
args next← encoder bind: self advance]
ifFalse:
[maxArgs > 0
ifTrue: [↑self expected: 'argument name']]].
↑{(encoder encodeSelector: selector contents unique) , args contents , p}].
"528" LADParser$'Parser'
[simpleExpression: cascading | rcvr msg |
"keywordFreeExpression {keyword keywordFreeExpression} MessageNode"
(rcvr ← self keywordFreeExpression: cascading)
ifTrue:
[(hereType #keyword and: [(msg ← self keywordMessage)])
ifTrue: [rcvr ← LADMessageNode new receiver: rcvr selector: msg 1 arguments: msg 2 precedence: 3 from: encoder].
hereType #leftArrow
ifTrue:
[ "ST76"
self advance.
↑rcvr addLeftArrow: self expression encoder: encoder].
↑rcvr]
ifFalse: [↑false]].
"472" LADParser$'Parser'
[keywordFreeExpression: cascading | rcvr msg |
"argumentFreeExpression {binarySelector argumentFreeExpression}
MessageNode"
(rcvr ← self argumentFreeExpression: cascading)
ifTrue:
[[(hereType #binary or: [hereType #verticalBar]) and: [(msg ← self binaryMessage "or hereTypecomma)" "ST76")]] whileTrueDo: [rcvr ← LADMessageNode new receiver: rcvr selector: msg 1 arguments: msg 2 precedence: 2 from: encoder].
↑rcvr].
↑false].
"50" LADParser$'Parser'
[more | |
↑hereType #doIt].
"351" 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".
hereType #leftBracket
ifTrue: [↑args concat: temps].
self expected: 'Left bracket'].
"759" LADParser$'Parser'
[pattern | sap |
"unarySelector | binarySelector arg | keyword arg {keyword arg}
{selector, arguments, precedence}"
sap ← (hereType #keyword
ifTrue: [self arguments: 999 precedence: 3]
ifFalse:
[(hereType #binary or: [(hereType #verticalBar or: [hereType #comma])])
ifTrue: [self arguments: 1 precedence: 2]
ifFalse:
[hereType #word
ifTrue: [self arguments: 0 precedence: 1]
ifFalse: [↑false]]]).
hereType #leftArrow
ifTrue:
[ "ST76"
self advance.
sap 1 ← encoder encodeSelector: ((sap 1) key + '←') unique.
hereType #word
ifTrue:
[sap 2 ← {sap 2 , (encoder bind: self advance)}.
↑sap].
↑self expected: 'argument name']
ifFalse: [↑sap]].
"60" LADParser$'Name Parsing for Debugger'
[unbind: name | |
].
"384" LADParser$'Parser'
[primitive | n |
here #<
ifTrue:
[self advance.
here = 'primitive:'
ifTrue:
[self advance.
((n ← self match: #number) and: [(n is: Integer)])
ifTrue:
[here #>
ifTrue:
[self advance.
↑n].
↑self expected: '>']
ifFalse: [↑self expected: 'Number']]
ifFalse: [↑self expected: 'primitive:']]
ifFalse: [↑0]].
"63" LADParser$'Name Parsing for Debugger'
[bind: name | |
↑name].
"758" LADParser$'Test'
[test: class | s |
"LADParser new test: Point."
user waitnobug.
#('noOp []' 'max: p2 [↑(x>p2 x and: [y>p2 y]) ifTrue: [self] ifFalse: [p2]]' 'coord: p2 [[x>p2 x and: [y>p2 y]] whileTrue: [self past: p2]]' '& z | a b c [a←z. b←z*a max: z/a length/(c←a length+2 min: z)]' 'to: p2 by: d [↑Interval new from: self to: p2 by: d]' 'incAll: coll [coll do: [:x. self inc: x with: ''string'']]' 'cascade: a [↑a+3 to: 4; from: 5; length]' ) do:
[:s | user cr.
user show: (self parse: s class: class noPattern: false context: false notifying: user) simplify asString.
user cr.
user waitnobug.
user waitbug].
[(s ← user read) length = 0] whileFalseDo:
[user cr.
user show: (self compile: s in: class) simplify asString.
user cr]].
"847" 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)
ifTrue: [stmts next← expr]
ifFalse:
[doit
ifTrue: [stmts next← encoder encodeVariable: 'nil']
ifFalse: [↑self expected: 'Expression']].
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].
"147" LADParser$'Scanner'
[advance | t |
t ← here.
here ← token.
hereType ← tokenType.
hereMark ← mark.
hereType
ifTrue: [self scanToken].
↑t].
"401" LADParser$'Public'
[parse: sourceStream class: class noPattern: noPattern context: ctxt notifying: req | m |
self init: sourceStream notifying: req "noPattern is false for a compile".
encoder ← LADEncoder new init: class context: ctxt notifying: self.
m ← self method: noPattern context: ctxt.
encoder ← nil "break cycle".
hereType #doIt
ifTrue: [↑m].
self notify: 'Unexpected construct'].
"136" LADAssignmentNode$'Code Generation'
[sizeForEffect: encoder | |
↑(value sizeForValue: encoder) + (variable sizeForStorePop: encoder)].
"97" LADAssignmentNode$'Initialization'
[variable: var value: exp | |
variable ← var.
value ← exp].
"188" LADAssignmentNode$'Printing'
[printon: strm indent: level precedence: p | |
p < 4
ifTrue: [strm append: '('].
self printon: strm indent: level.
p < 4
ifTrue: [strm append: ')']].
"145" LADAssignmentNode$'Code Generation'
[emitForValue: stack on: strm | |
value emitForValue: stack on: strm.
variable emitStore: stack on: strm].
"132" LADAssignmentNode$'Code Generation'
[sizeForValue: encoder | |
↑(value sizeForValue: encoder) + (variable sizeForStore: encoder)].
"72" LADAssignmentNode$'Simplifying'
[simplify | |
value ← value simplify].
"163" LADAssignmentNode$'Printing'
[printon: strm indent: level | |
variable printon: strm indent: level.
strm append: ' ← '.
value printon: strm indent: level + 2].
"193" LADAssignmentNode$'Initialization'
[variable: var value: exp from: encoder | |
"compile"
(var is: LADMessageNode)
ifTrue: [↑var store: exp from: encoder].
variable ← var.
value ← exp].
"149" LADAssignmentNode$'Code Generation'
[emitForEffect: stack on: strm | |
value emitForValue: stack on: strm.
variable emitStorePop: stack on: strm].
"309" LADCascadeNode$'Code Generation'
[emitForValue: stack on: strm | i |
receiver emitForValue: stack on: strm.
(1 to: messages length - 1) do:
[:i | strm next← Dup.
stack push: 1.
messages i emitForValue: stack on: strm.
strm next← Pop.
stack pop: 1].
messages last emitForValue: stack on: strm].
"214" LADCascadeNode$'Code Generation'
[sizeForValue: encoder | msg size |
size ← (receiver sizeForValue: encoder) + (messages length - 1 * 2).
messages do: [:msg | size ← size + (msg sizeForValue: encoder)].
↑size].
"147" LADCascadeNode$'Initialization'
[receiver: rcvr messages: msgs | |
"user show: 'abc'; tab; show: 'abc'; cr"
receiver ← rcvr.
messages ← msgs].
"235" LADCascadeNode$'Printing'
[printon: strm indent: level | i |
receiver printon: strm indent: level.
(1 to: messages length) do:
[:i | messages i printon: strm indent: level.
i < messages length
ifTrue: [strm append: ';']]].
"91" LADCascadeNode$'Simplifying'
[simplify | msg |
messages do: [:msg | msg ← msg simplify]].
"1120" LADParser$'Parser'
[expression | var expr msgs temp rcvr |
"[variable '←'] expression AssignmentNode
rcvr message {; message} MessageNode | CascadeNode"
(hereType #word and: [tokenType #leftArrow])
ifTrue:
[var ← encoder encodeVariable: here.
self advance.
self advance.
(expr ← self expression)
ifTrue: [↑LADAssignmentNode new variable: var value: expr from: encoder].
↑self expected: 'Expression']
ifFalse:
[(expr ← self simpleExpression: false)
ifTrue:
[(hereType #semicolon and: [(expr is: LADMessageNode)])
ifTrue:
[msgs ← expr inVector asStream settoend.
rcvr ← expr cascadeReceiver.
rcvr false
ifTrue: [↑self notify: 'cannot cascade super'].
[hereType #semicolon] whileTrueDo:
[expr ← self simpleExpression: true.
(expr is: LADMessageNode)
ifTrue:
[expr cascadeReceiver
ifTrue: [msgs next← expr]
ifFalse: [↑self notify: 'invalid cascade']]
ifFalse: [↑self expected: 'Message']].
↑LADCascadeNode new receiver: rcvr messages: msgs contents]
ifFalse: [↑expr]]
ifFalse: [↑false]]].
"319" LADParser$'Parser'
[subExpression | e |
"'(' expression ')' expression"
(self match: #leftParenthesis)
ifTrue:
[(e ← self expression)
ifTrue:
[(self match: #rightParenthesis)
ifTrue: [↑e].
↑self expected: 'Right parenthesis']
ifFalse: [↑self expected: 'Expression']]
ifFalse: [↑false]].
"283" LADMethodNode$'Initialization'
[selector: selOrFalse arguments: args precedence: p temporaries: temps block: blk encoder: t6 primitive: prim | |
encoder ← t6.
selectorOrFalse ← selOrFalse.
precedence ← p.
arguments ← args.
temporaries ← temps.
block ← blk.
primitive ← prim].
"48" ParseStack$'Results'
[position | |
↑position].
"63" ParseStack$'Initialization'
[init | |
length ← position ← 0].
"103" ParseStack$'Changes'
[push: n | |
(position ← position + n) > length
ifTrue: [length ← position]].
"44" ParseStack$'Results'
[length | |
↑length].
"116" ParseStack$'Changes'
[pop: n | |
(position ← position - n) < 0
ifTrue: [user notify: 'Parse stack underflow']].
"269" LADMethodNode$'Code Generation'
[emitOn: strm | stack limit |
limit ← strm limit.
stack ← ParseStack init.
block emitForValue: stack on: strm.
strm next← EndMethod.
strm position = limit
ifTrue: [↑strm asArray].
user notify: 'Compiler code size discrepancy'].
"70" LADMethodNode$'Code Generation'
[selector | |
↑selectorOrFalse key].
"1560" LADMethodNode$'Code Generation'
[generate | blkSize method headerSize lit stack strm nArgs |
method ← ((primitive = 0 and: [arguments length = 0])
ifTrue: [self quickCode: selectorOrFalse]
ifFalse: [false]).
method
ifTrue: [↑method].
nArgs ← arguments length.
blkSize ← block sizeForEvaluatedValue: encoder.
literals ← encoder literals: primitive nArgs: nArgs.
literals length > 63
ifTrue: [user notify: 'Too many literals referenced']
ifFalse:
[headerSize ← 4 + (2 * literals length).
method ← (NoteTaker
ifTrue: [CompiledMethod]
ifFalse: [String]) new: headerSize + blkSize + 3.
strm ← method asStream.
strm position← 2 * literals length + 4.
stack ← ParseStack init.
block emitForEvaluatedValue: stack on: strm.
stack position 1
ifTrue: [user notify: 'Compiler stack discrepancy']
ifFalse:
[strm position (method length - 3)
ifTrue: [user notify: 'Compiler code size discrepancy']
ifFalse:
[ "Header"
method 3 ← ((nArgs 4 and: [primitive = 0])
ifTrue: [nArgs]
ifFalse: [7]) * 32 + encoder maxTemp.
method 4 ← headerSize - 4 + (encoder maxTemp + stack length > 12
ifTrue: [128]
ifFalse: [0]) + 1 "Literals".
NoteTaker
ifTrue:
[method key: selectorOrFalse key.
(1 to: literals length) do: [:lit | method literalAt: lit put: literals lit]]
ifFalse:
[method word: 1 ← selectorOrFalse key asOop.
(1 to: literals length) do: [:lit | method word: (lit + 2) ← (literals lit) asOop]].
↑strm asArray]]]].
"1050" LADMethodNode$'Code Generation'
[install: sourceParagraph in: class | text cfile clname catname newMethod |
class install: selectorOrFalse key method: (newMethod ← self generate) literals: literals code: sourceParagraph backpointers: nil "write source and set pointer to it. Source format is:
'' length '' class$'category'<cr>[<code>].<cr> ".
cfile ← SourceFiles 2.
cfile readwriteshorten.
cfile settoend "changes file".
text ← sourceParagraph text "source code".
clname ← class title.
catname ← class organization invert: selectorOrFalse key.
newMethod setSourcePosition: cfile position inFile: 1 "changes".
cfile append: '"' " string lengths plus $''<cr>[].<cr> ".
cfile append: (text length + clname length + catname length + 8) asString.
cfile append: '" ' "put out length".
cfile append: clname.
cfile append: '$'''.
cfile append: catname.
cfile append: ''''.
cfile cr.
cfile append: '['.
cfile append: text.
cfile append: '].'.
cfile cr "put out code".
cfile readonly "leave readonly for browsing and to keep clean"].
"68" LADMethodNode$'Simplifying'
[simplify | |
block ← block simplify].
"448" LADMethodNode$'Code Generation'
[quickCode: sel | v |
sel false
ifTrue: [↑false].
(v ← block quickCode)
ifTrue:
[v < 0
ifTrue: [↑false].
v = LdSelf
ifTrue: [↑self quick: sel hi: 160 lo: 1].
v < (CodeBases LdInstType + (CodeLimits LdInstType))
ifTrue: [↑self quick: sel hi: 192 + v lo: 1].
(v / 256 = 1 and: [v \ 256 < 32])
ifTrue: [↑self quick: sel hi: 192 + (v \ 256) lo: 1].
↑false]
ifFalse: [↑false]].
"656" LADMethodNode$'Printing'
[printon: strm | s args |
selectorOrFalse
ifTrue:
[(precedence = 1 and: [selectorOrFalse key isarrow false])
ifTrue:
[ "ST76"
strm append: selectorOrFalse key.
strm space]
ifFalse:
[args ← arguments asStream.
selectorOrFalse key keywords do:
[:s | strm append: s.
strm space.
strm append: args next key.
strm space]]].
strm append: ' | '.
temporaries do:
[:s | strm append: s key.
strm space].
strm append: '|'.
primitive > 0
ifTrue:
[strm append: ' <primitive: '.
strm print: primitive.
strm append: '>'].
strm crtab: 1.
block printStatementsOn: strm indent: 1].
"327" LADMethodNode$'Code Generation'
[quick: selector hi: hibyte lo: lobyte | method |
method ← (NoteTaker
ifTrue: [CompiledMethod]
ifFalse: [String]) new: 7.
method 3 ← hibyte.
method 4 ← lobyte.
NoteTaker
ifTrue: [method key: selectorOrFalse key]
ifFalse: [method word: 1 ← selector key asOop].
↑method].
"977" LADParser$'Parser'
[method: doit context: ctxt | sap blk prim temps |
"sap={selector, arguments, precedence}" "pattern [ | temporaries ] block MethodNode"
doit
ifTrue:
[sap ← (ctxt false
ifTrue: [{(encoder encodeSelector: #DoIt) , #() , 1}]
ifFalse: [{(encoder encodeSelector: #DoItIn:) , (encoder encodeVariable: 'homeContext') inVector , 3}]).
temps ← (hereType #verticalBar
ifTrue: [self temporaries]
ifFalse: [#()]).
(blk ← self statements: #() doit: true)
ifTrue: [blk returnLast].
prim ← 0]
ifFalse:
[(sap ← self pattern)
ifTrue:
[temps ← self temporaries.
prim ← self primitive.
blk ← self statements: #() doit: false]].
(sap and: [blk])
ifTrue:
[self more
ifTrue: [↑self expected: 'Nothing more'].
↑LADMethodNode new selector: sap 1 arguments: sap 2 precedence: sap 3 temporaries: temps block: blk mustReturn encoder: encoder primitive: prim]
ifFalse: [↑self expected: 'pattern']].
"392" LADParser$'Errors'
[notify: string | |
mark false
ifTrue: [↑false].
hereMark ← hereMark + (tokenType #doIt
ifTrue: [1]
ifFalse: [0]) + (hereType #doIt
ifTrue: [1]
ifFalse: [0]).
tokenType ← mark ← false.
encoder release "break cycles".
source skip: hereMark - source position - 1.
requestor notify: string.
here ← 30 inString.
hereType ← #doIt.
↑false].
"92" LADParser$'Scanner'
[match: type | |
hereType type
ifTrue: [↑self advance].
↑false].
"678" LADParser$'Parser'
[block | blk argNodes argument |
" '[' {:var.} (:var|statements) ']' BlockNode"
argNodes ← (Vector new: 1) asStream.
(self match: #leftBracket)
ifTrue:
[[(self match: #colon) and: [((argument ← self match: #word)
ifTrue: [argNodes next← encoder autoBind: argument]
ifFalse: [↑self expected: 'Argument name'])]] whileTrueDo: [].
(argNodes empty or: [(self match: #verticalBar)]) false
ifTrue: [↑self expected: 'Vertical bar'].
((blk ← self statements: argNodes contents doit: false) and: [(self match: #rightBracket)])
ifTrue: [↑blk].
↑self expected: 'Period or right bracket']
ifFalse: [↑self expected: 'Left bracket']].
"120" LADParser$'Private'
[init: sourceStream notifying: req | |
requestor ← req.
super scan: sourceStream.
self advance].
"79" LADParser$'Errors'
[expected: string | |
↑self notify: string + ' expected'].
"242" LADParser$'Parser'
[binaryMessage | selector arg |
"binarySelector arg {selector, {arg}}"
selector ← self advance.
(arg ← self argumentFreeExpression: false)
ifTrue: [↑{selector unique , arg inVector}].
↑self expected: 'argument'].
"466" LADParser$'Parser'
[collection | exprs e |
"'{' {simpleExpression ','} [simpleExpression] '}' CollectionNode"
(self match: #leftBrace)
ifTrue:
[exprs ← (Vector new: 10) asStream.
[((e ← self simpleExpression: false) and: [exprs next← e]) and: [(self match: #comma)]] whileTrueDo: [].
(self match: #rightBrace)
ifTrue: [↑LADCollectionNode new elements: exprs contents from: encoder].
↑self expected: 'Comma or right brace']
ifFalse: [↑false]].
"71" LADParser$'Name Parsing for Debugger'
[encodeSelector: sel | |
↑sel].
"390" LADParser$'Parser'
[keywordMessage | selector arg args |
"{keyword arg} {selector, args}"
selector ← Stream default.
args ← (Vector new: 4) asStream.
[hereType #keyword] whileTrueDo:
[selector append: self advance.
(arg ← self keywordFreeExpression: false)
ifTrue: [args next← arg]
ifFalse: [↑self expected: 'argument']].
↑{selector contents unique , args contents}].
"374" LADParser$'Parser'
[temporaries | vars |
"[ '|' {variable} ] {variable, ..., variable}"
(self match: #verticalBar) and: [((self match: #verticalBar)
ifTrue: [↑#()].
vars ← (Vector new: 8) asStream.
[hereType #word] whileTrueDo: [vars next← encoder bind: self advance].
(self match: #verticalBar)
ifTrue: [↑vars contents])].
↑self expected: 'Vertical bar'].
"197" LADScanner$'Mulit-Character Scans'
[xAbbreviation | |
" "
tokenType ← #binary "token ← (<= ~= >= ==) (( ) find: self step inUniqueString)".
token ← self step inUniqueString].
"591" LADScanner$'Mulit-Character Scans'
[xLitQuote | type s |
"UniqueStrings and Vectors"
s ← Stream default.
self step "litQuote".
typeTable hereChar #leftParenthesis
ifTrue:
[self step "leftPar".
[typeTable hereChar #rightParenthesis] whileFalseDo: [s next← self step].
self step "rightPar".
tokenType ← #literal.
token ← s contents asVector]
ifFalse:
[s next← self step "first char".
[(type ← typeTable hereChar) #xLetter or: [(type = #xDigit or: [type #colon])]] whileTrueDo: [s next← self step].
tokenType ← #literal.
token ← s contents unique]].
"179" LADScanner$'Mulit-Character Scans'
[xControlZ | |
"ignore trailer"
(self skipThrough: 13)
ifTrue: [self scanToken]
ifFalse: [self error: 'Missing cr in Bravo trailer']].
"184" LADScanner$'Mulit-Character Scans'
[xDoubleQuote | |
"ignore comment"
(self skipThrough: hereChar)
ifTrue: [self scanToken]
ifFalse: [self error: 'Unmatched comment quote']].
"329" LADScanner$'Mulit-Character Scans'
[xLetter | type s |
"form a word or keyword"
s ← Stream default.
[(type ← typeTable hereChar) #xLetter or: [type #xDigit]] whileTrueDo: [s next← self step].
type #colon
ifTrue:
[s next← self step.
tokenType ← #keyword]
ifFalse: [tokenType ← #word].
token ← s contents].
"491" LADScanner$'Mulit-Character Scans'
[xSingleQuote | start s |
"string"
start ← source position.
self step.
s ← Stream default.
[hereChar = 39 and: [(aheadChar = 39
ifTrue:
[self step.
false]
ifFalse: [true])]] whileFalseDo:
[s next← self step.
(hereChar = 30 "doit" and: [source end])
ifTrue:
[ "Ran off end, back up."
source skip: start - 1 - source position.
↑self error: 'Unmatched string quote']].
self step.
token ← s contents.
tokenType ← #string].
"63" LADScanner$'Errors'
[notify: string | |
user notify: string].
"184" LADScanner$'Subroutines'
[testDigit: char radix: radix | |
↑(char 48 and: [char < (48 + radix) "0-9"]) or: [(radix > 10 and: [(char 65 and: [char < (65 - 10 + radix) "A-Z"])])]].
"236" LADScanner$'Mulit-Character Scans'
[xRelational | |
"check for <= ~= >= == "
tokenType ← #binary.
token ← self step inUniqueString.
hereChar = 61
ifTrue:
[ "="
self step.
token ← #( ) (#(< ~ > = ) find: token)]].
"269" LADScanner$'Main Scanner'
[scanToken | |
mark ← source position.
tokenType ← typeTable hereChar.
tokenType 1 = 120
ifTrue: [ "x as first letter means perform to compute token & type"
self perform: tokenType]
ifFalse: [token ← self step inUniqueString]].
"300" LADScanner$'Subroutines'
[skipThrough: char | start |
"false if unmatched."
start ← source position.
self step.
[self step = char] whileFalseDo:
[(hereChar = 30 and: [source end "doit"])
ifTrue:
[source skip: start - 1 "Ran off end, back up." - source position.
↑false]].
↑true].
"1003" LADScanner$'Initialization'
[classInit | |
"LADScanner classInit."
typeTable ← Vector new: 256.
typeTable (1 to: 256) all← #binary "default".
typeTable #(9 10 12 13 32 ) all← #xDelimiter "tab lf ff cr space".
typeTable #(1 6 14 18 ) all← #xAbbreviation " ".
typeTable 15 ← #xLitQuote.
typeTable 26 ← #xControlZ.
typeTable 30 ← #doIt.
typeTable 34 ← #xDoubleQuote.
typeTable 39 ← #xSingleQuote.
typeTable 40 ← #leftParenthesis.
typeTable 41 ← #rightParenthesis.
typeTable 44 ← #comma.
typeTable 46 ← #period.
typeTable (48 to: 57) all← #xDigit.
typeTable #(3 58 ) all← #colon.
typeTable 59 ← #semicolon.
typeTable #(60 61 62 126 ) all← #xRelational " < = > ~ ".
typeTable ((65 to: 90) concat: (97 to: 122)) all← #xLetter.
typeTable 91 ← #leftBracket.
typeTable 93 ← #rightBracket.
typeTable 94 ← #upArrow.
typeTable 95 ← #leftArrow.
typeTable 123 ← #leftBrace.
typeTable 124 ← #verticalBar.
typeTable 125 ← #rightBrace].
"994" 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])]].
"101" LADScanner$'Subroutines'
[convert: str radix: radix | |
↑Integer new fromString: str radix: radix].
"207" LADScanner$'Subroutines'
[scanInteger: radix | s |
"Should be merged with Integer readFrom: "
s ← Stream default.
[self testDigit: hereChar radix: radix] whileTrueDo: [s next← self step].
↑s contents].
"47" LADScanner$'Errors'
[interactive | |
↑false].
"186" LADScanner$'Initialization'
[scan: inputStringOrStream | |
source ← inputStringOrStream asStream "initialize reader".
mark ← source position.
self step.
self step.
self scanToken].
"62" LADScanner$'Errors'
[error: string | |
self notify: string].
"204" LADScanner$'Subroutines'
[step | c |
c ← hereChar.
hereChar ← aheadChar.
(aheadChar ← source next)
ifTrue:
[aheadChar = 0
ifTrue: [aheadChar ← 256]]
ifFalse: [aheadChar ← 30 "doit"].
↑c].
"156" LADScanner$'Mulit-Character Scans'
[xDelimiter | |
"ignore blanks etc."
[typeTable hereChar #xDelimiter] whileTrueDo: [self step].
self scanToken].
"516" LADCompiler$'Private'
[translate: stream noPattern: noPattern | tree |
LADVariableNode new NTinit "post-vmem init once only".
tree ← LADParser new parse: stream class: class noPattern: noPattern context: context notifying: self.
NoteTaker false
ifTrue:
[self notify: (Statistics new symbolic: tree generate) "self notify: (LADDecompiler new classInit decompile: [context[DoItIn:] DoIt]
in: class method: tree generate asCompiledMethod) asString.".
↑false].
failure
ifTrue: [↑false].
↑tree].
"214" LADCompiler$'Private'
[from: source class: cls instance: rcvr context: ctxt notifying: req | |
sourceStream ← source asStream.
class ← cls.
instance ← rcvr.
context ← ctxt.
requestor ← req.
failure ← false].
"527" LADCompiler$'Public'
[evaluate: stream in: ctxt to: receiver notifying: t4 | methodNode method cls |
requestor ← t4.
cls ← (ctxt
ifTrue: [ctxt receiver]
ifFalse: [receiver]) class.
self from: stream class: cls instance: receiver context: ctxt notifying: requestor.
(methodNode ← user displayoffwhile [(self translate: stream noPattern: true)])
ifTrue:
[method ← methodNode generate.
context
ifTrue: [↑instance execute: method with: context].
↑instance execute: method]
ifFalse: [↑failureValue]].
"196" LADCompiler$'Errors'
[notify: string | |
failure ← true.
user restoredisplay.
failureValue ← requestor notify: string at: (sourceStream position min: sourceStream limit) + 1 in: sourceStream].
"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.
methodNode install: parag in: cls.
cls organization classify: selector under: category.
↑selector].
↑false].
"219" CodePane$'As yet unclassified'
[compiler: defaultClass | |
((class nil
ifTrue: [defaultClass]
ifFalse: [class]) usesNewSyntax or: [(NoteTaker or: [user leftShiftKey])])
ifTrue: [↑LADCompiler].
↑Generator].
"60" CodePane$'Window protocol'
[outline | |
frame outline: 1].
"82" Window$'Framing'
[show | |
self outline.
growing
ifFalse: [self showtitle]].
"543" Window$'Framing'
[editTitle | pared w |
pared ← TextImage new para: titlepara frame: nil.
pared formerly: false.
pared fixframe: titleframe window + (1 2).
pared enter.
w ← titleframe window.
[user anybug and: [(w has: user mp) false]] whileFalseDo:
[user kbck
ifTrue: [pared kbd]
ifFalse:
[user redbug
ifTrue:
[(w has: user mp)
ifTrue: [pared selecting]]
ifFalse:
[user yellowbug
ifTrue:
[(w has: user mp)
ifTrue: [w flash]]]]].
titlepara ← pared contents.
self showtitle].
"101" Window$'Framing'
[fixframe: f | |
↑Rectangle new origin: f origin extent: (f extent max: 32 32)].
"63" Window$'Default Event responses'
[yellowbug | |
frame flash].
"100" Window$'Default Event responses'
[aboutToFrame | |
"My frame is about to change. I dont care."].
"43" Window$'Framing'
[title | |
↑'Untitled'].
"97" Window$'Framing'
[takeCursor | |
user cursorloc← frame center "Move the cursor to my center."].
"158" Window$'Default Event responses'
[print | t1 |
(t1 ← dp0 pressfile: (self title + '.press.') asFileName) screenout: frame scale: PressScale.
t1 toPrinter].
"62" Window$'Default Event responses'
[hardcopy | |
frame flash].
"68" Window$'Default Event responses'
[kbd | |
user kbd.
frame flash].
"60" Window$'Default Event responses'
[redbug | |
frame flash].
"60" Window$'Default Event responses'
[keyset | |
frame flash].
"558" Window$'Scheduling'
[eachtime | |
(frame has: user mp)
ifTrue:
[user kbck
ifTrue: [↑self kbd].
user anybug
ifTrue:
[user redbug
ifTrue: [↑self redbug].
user yellowbug
ifTrue: [↑self yellowbug].
user bluebug
ifTrue: [↑self bluebug]]
ifFalse:
[user anykeys
ifTrue: [↑self keyset]]]
ifFalse:
[self outside
ifFalse:
[user anybug
ifTrue:
[(frame has: user mp)
ifFalse: [↑false]]
ifFalse:
[user kbck
ifTrue:
[user kbd.
frame flash] "flush typing outside"]]]].
"60" Window$'Scheduling'
[lasttime | |
self leave.
↑exitflag].
"48" Window$'Default Event responses'
[leave | |
].
"58" Window$'Scheduling'
[schedule | |
user restartup: self].
"586" Window$'Framing'
[fixedwidthfromuser: width | a b oldframe |
user waitnobug.
frame nil
ifFalse:
[self aboutToFrame.
self erase].
a ← OriginCursor showwhile [user waitbug].
growing ← true.
self frame: (frame ← self fixframe: (a rect: a + (width 32))).
self show.
CornerCursor showwhile [([a ← user mpnext] whileTrueDo:
[a x← frame corner x.
oldframe nil
ifTrue: [user cursorloc← a max: frame corner].
oldframe ← frame copy.
self frame: (frame ← self fixframe: (frame growto: a)).
self moveFrom: oldframe])].
growing ← false.
self takeCursor].
"90" Window$'Framing'
[erase | |
(frame inset: 2 2) clear.
self clearTitle: background].
"572" Window$'Framing'
[newframe | a oldframe |
user waitnobug.
user restoredisplay.
frame nil
ifFalse:
[self aboutToFrame.
self erase].
a ← OriginCursor showwhile [user waitbug].
growing ← true.
frame ← self fixframe: (a rect: a + 32).
frame outline.
CornerCursor showwhile [([a ← user mpnext] whileTrueDo:
[oldframe nil
ifTrue: [user cursorloc← a max: frame corner].
oldframe ← frame copy.
frame ← self fixframe: (frame growto: a).
(oldframe inset: 2) clear.
frame outline])].
self frame: frame.
growing ← false.
self takeCursor].
"38" Window$'Framing'
[frame | |
↑frame].
"57" Window$'Default Event responses'
[enter | |
self show].
"59" Window$'Framing'
[frame: f | |
frame ← self fixframe: f].
"72" Window$'Initialization'
[reset | |
exitflag ← true.
growing ← false].
"296" Window$'Initialization'
[classInit | |
"Window classInit"
border ← 2 2.
titleframe ← Textframe new para: nil frame: nil.
titleloc ← 3 (4 - titleframe lineheight).
titlerun ← String new: 2.
titlerun word: 1 ← 255.
windowmenu ← Menu new string: 'under
frame
close
print
printbits
'].
"181" Window$'Default Event responses'
[outside | |
(titleframe window has: user mp)
ifTrue:
[user anybug
ifTrue: [self editTitle]
ifFalse: [↑false]]
ifFalse: [↑false]].
"48" Window$'Default Event responses'
[close | |
].
"109" Window$'Scheduling'
[firsttime | |
(frame has: user mp)
ifTrue:
[self reset.
↑self enter].
↑false].
"353" Window$'Default Event responses'
[bluebug | t1 |
(t1 ← windowmenu bug) = 1
ifTrue: [↑exitflag ← false].
t1 = 2
ifTrue:
[self newframe.
self enter]
ifFalse:
[t1 = 3
ifTrue:
[self close.
self erase.
user unschedule: self.
↑false].
t1 = 4
ifTrue: [self hardcopy]
ifFalse:
[t1 = 5
ifTrue: [self print]]]].
"91" Window$'Framing'
[clearTitle: color | |
(titleframe window inset: 2 2) clear: color].
"83" Window$'Framing'
[moveFrom: oldframe | |
(oldframe inset: 2) clear.
self show].
"212" Window$'Framing'
[showtitle | |
titlepara nil
ifTrue: [titlepara ← Paragraph new text: self title runs: titlerun alignment: 0].
titleframe put: titlepara at: frame origin + titleloc.
titleframe outline].
"71" Window$'Framing'
[outline | |
frame outline "Clear and outline me."].
"364" CodeWindow$'Initialization'
[class: class selector: selector para: para formerly: oldpara | codePane |
codePane ← CodePane new class: class selector: selector para: nil.
self title: class title + ' ' + selector with: codePane inVector at: stdTemplates.
self newframe.
self show.
codePane showing: para.
codePane formerly: oldpara.
codePane from: codePane].
"70" CodeWindow$'Initialization'
[editTitle | |
titleframe window flash].
"148" FilePane$'As yet unclassified'
[classInit | |
"FilePane classInit."
editmenu ← Menu new string: 'again
copy
cut
paste
doit
put
undo
get
align'].
"892" FilePane$'As yet unclassified'
[yellowbug | t1 |
(t1 ← editmenu bug) = 1
ifTrue: [pared again]
ifFalse:
[t1 = 2
ifTrue: [pared copyselection]
ifFalse:
[t1 = 3
ifTrue: [pared cut]
ifFalse:
[t1 = 4
ifTrue: [pared paste]
ifFalse:
[t1 = 5
ifTrue: [self doit]
ifFalse:
[t1 = 6
ifTrue:
[pared formerly
ifTrue: [user displayoffwhile [
(file readwriteshorten.
file reset.
file append: pared contents.
file close.
pared formerly: false)]]
ifFalse: [frame flash]]
ifFalse:
[t1 = 7
ifTrue: [pared undo]
ifFalse:
[t1 = 8
ifTrue: [user displayoffwhile [(scrollBar hidewhile [(self showing: file contents asParagraph)])]]
ifFalse:
[t1 = 9
ifTrue: [pared realign]]]]]]]]]].
"58" FilePane$'As yet unclassified'
[file: t1 | |
file ← t1].
"256" CodeWindow$'Initialization'
[file: file | filePane |
filePane ← FilePane new file: file.
self title: file name with: filePane inVector at: stdTemplates.
self newframe.
self show.
filePane showing: file contents asParagraph.
filePane from: filePane].
"95" PanedWindow$'Window protocol'
[kbd | pane |
(pane ← self pickedpane)
ifTrue: [↑pane kbd]].
"101" PanedWindow$'Window protocol'
[redbug | pane |
(pane ← self pickedpane)
ifTrue: [↑pane redbug]].
"101" PanedWindow$'Window protocol'
[keyset | pane |
(pane ← self pickedpane)
ifTrue: [↑pane keyset]].
"389" PanedWindow$'Window protocol'
[eachtime | pane |
(frame has: user mp)
ifTrue:
[user bluebug
ifTrue: [↑self bluebug].
panes do: [:pane | pane startup]]
ifFalse:
[self outside
ifFalse:
[user anybug
ifTrue:
[(frame has: user mp)
ifFalse: [↑false]]
ifFalse:
[user kbck
ifTrue:
[user kbd.
frame flash] "flush typing outside"]]]].
"94" PanedWindow$'Window protocol'
[show | pane |
super show.
panes do: [:pane | pane outline]].
"86" PanedWindow$'Window protocol'
[leave | pane |
panes do: [:pane | pane windowleave]].
"280" PanedWindow$'Window protocol'
[hardcopy: pf | pane |
self hardcopyTitle: pf "print frame rectangle".
frame hardcopy: pf "print all panes".
panes do: [:pane | pane hardcopy: pf "print cursor if it's inside"].
(frame has: user mp)
ifTrue: [user currentCursor hardcopy: pf]].
"115" PanedWindow$'Window protocol'
[fixframe: f | |
↑Rectangle new origin: f origin extent: (f extent max: 160 80)].
"79" PanedWindow$'Window protocol'
[erase | |
self titlerect clear.
super erase].
"99" PanedWindow$'Window protocol'
[enter | pane |
super show.
panes do: [:pane | pane windowenter]].
"410" PanedWindow$'Window protocol'
[frame: t1 | templateStream template pane orig ext |
"(Re)initialize my frame, and tell my panes their locations."
frame ← t1.
templateStream ← templates asStream.
orig ← frame origin - 1.
ext ← frame extent + 2.
panes do:
[:pane | template ← templateStream next "It would be nice to have parallel fors as in MLISP.".
pane frame← template * ext / 36 + orig inset: 1]].
"107" PanedWindow$'Window protocol'
[yellowbug | pane |
(pane ← self pickedpane)
ifTrue: [↑pane yellowbug]].
"349" PanedWindow$'Window protocol'
[hardcopyTitle: pf | |
self showtitle "refresh title (since it's a class var)" "draw title rectangle".
titleframe window hardcopy: pf "print title text (make frame larger)".
titleframe para presson: pf in: (pf transrect: (titleframe frame origin rect: titleframe frame corner + (999 2))) style: titleframe style].
"80" PanedWindow$'Window protocol'
[close | pane |
panes do: [:pane | pane close]].
"91" PanedWindow$'Pane services'
[vanish | |
self close.
self erase.
user unschedule: self].
"51" PanedWindow$'Window protocol'
[title | |
↑title].
"72" PanedWindow$'Window protocol'
[takeCursor | |
(panes 1) takeCursor].
"315" PanedWindow$'Initialization'
[title: t1 with: t2 at: t3 | pane |
"The instance variable templates is a set of Rectangles for the frames of the panes normalized such that the whole PanedWindow is a frame of 00 rect: 3636."
title ← t1.
panes ← t2.
templates ← t3.
self reset.
panes do: [:pane | pane init]].
"144" PanedWindow$'Private'
[titlerect | |
↑frame origin - (2 (DefaultTextStyle lineheight + 4)) rect: frame corner x frame origin y + (2 0)].
"131" PanedWindow$'Window protocol'
[pickedpane | pane |
panes do:
[:pane | pane picked
ifTrue: [↑pane]].
frame flash.
↑false].
"178" PanedWindow$'Window protocol'
[hardcopy | p |
user displayoffwhile [
(p ← dp0 pressfile: (self title + '.press') asFileName.
self hardcopy: p.
p close.
p toPrinter)]].
"166" FileStream$'CodePane Editor'
[edit | |
NoteTaker
ifTrue: [user schedule: (CodeWindow new file: self)]
ifFalse: [user restartup: (CodeWindow new file: self)]].
"103" FileStream$'Print'
[asPressPrinter | |
↑PressPrinter init "default format for printt etc." of: self].
"47" FileStream$'File'
[name | |
↑self file name].
"109" FileStream$'Dictionary'
[release | |
self obsolete
ifFalse:
[dirty ← limit ← 0.
self file release]].
"530" FileStream$'File'
[positionSize: size | len pos |
len ← page dataLength "compute the position for an object of a given size,
e.g. characters (1), words (2), fixed length (n),
from the current character position and the current page".
(size = 1 or: [len \ size 0])
ifTrue:
[pos ← page pageNumber - 1 * len + (position - page dataBeginning).
size = 1
ifTrue: [↑pos].
↑pos / size]
ifFalse: [ "page length is a multiple of size"
↑page pageNumber - 1 * (len / size) + (position - page dataBeginning / size)]].
"721" FileStream$'File'
[position: objpos size: size | len pn c pos |
len ← page dataLength "set the current character position and the current page
from the position of an object of a given size (see positionSize:)".
size = len
ifTrue:
[pn ← objpos + 1 "page size".
c ← 0]
ifFalse:
[pos ← objpos.
size = 1
ifFalse:
[len \ size = 0
ifTrue: [len ← len / size "page length is a multiple of size"]
ifFalse:
[pos ← objpos * size.
size ← 1]] "obtain quotient (page) and remainder (position)".
pos ← pos intdiv: len.
pn ← 1 + (pos 1) asSmall.
c ← size * (pos 2) asSmall].
(self positionPage: pn character: c)
ifTrue: [↑objpos].
self error: 'cannot read page ' + pn asString].
"141" FileStream$'Access Modes'
[readwriteshorten | |
self setMode: read + write "allow read and write and shorten File upon closing" + shorten].
"57" FileStream$'File'
[directory | |
↑self file directory].
"127" FileStream$'Filin/Filout'
[filoutclass: class | t2 |
(t2 ← self asParagraphPrinter) stamp.
t2 printclass: class.
t2 close].
"126" FileStream$'Access Modes'
[readwrite | |
self setMode: read + write "allow read and write but don't automatically shorten"].
"64" FtpDirectory$'FileDirectory'
[commands | |
↑command contents].
"120" FtpDirectory$'FileDirectory'
[delete: name | |
command append: ' Delete/C '.
command append: (self checkName: name)].
"327" FtpDirectory$'FileDirectory'
[replace: name | s |
s ← self checkName: name.
(directory compare: 'maxc') = 2
ifTrue:
[self delete: s.
self store: s]
ifFalse:
[ "store as highest version (ifs only)"
command append: ' Store/S '.
command append: s.
command space.
command append: s.
command append: '!H']].
"196" FtpDirectory$'FileDirectory'
[retrieve: remote as: local | |
command append: ' Retrieve/S '.
command append: (self checkName: remote).
command space.
command append: (self checkName: local)].
"190" FtpDirectory$'FileDirectory'
[store: local as: remote | |
command append: ' Store/S '.
command append: (self checkName: local).
command space.
command append: (self checkName: remote)].
"154" FtpDirectory$'FileDirectory'
[connect: name password: pw | |
command append: ' Connect/C '.
command append: name.
command space.
command append: pw].
"195" FtpDirectory$'FileDirectory'
[retrieve: s | t |
(s is: Vector)
ifTrue: [s do: [:t | self retrieve: t]]
ifFalse:
[command append: ' Retrieve/C '.
command append: (self checkName: s)]].
"172" FtpDirectory$'FileDirectory'
[directoryName: name | |
command append: ' Directory/C ' "this message should be directory:, but until rewriting...".
command append: name].
"137" FtpDirectory$'FileDirectory'
[closeThen: s | |
command append: '; '.
command append: s.
user quitThen: command contents.
self open].
"203" FtpDirectory$'FileDirectory'
[rename: oldName newName: newName | |
command append: ' Rename/C '.
command append: (self checkName: oldName).
command space.
command append: (self checkName: newName)].
"80" FtpDirectory$'FileDirectory'
[close | |
self closeThen: 'Resume. Small.Boot'].
"186" FtpDirectory$'FileDirectory'
[store: s | t |
(s is: Vector)
ifTrue: [s do: [:t | self store: t]]
ifFalse:
[command append: ' Store/C '.
command append: (self checkName: s)]].
"180" FtpDirectory$'FileDirectory'
[login: name password: pw | |
name empty
ifFalse:
[command append: ' Login/C '.
command append: name.
command space.
command append: pw]].
"194" FtpDirectory$'FileDirectory'
[open | |
command ← Stream new of: (String new: 100).
command append: 'Ftp '.
command append: directory.
self login: self userName password: self userPassword].
"73" FileDirectory$'FileStream'
[pressfilin: s | |
self filin: s format: 2].
"73" FileDirectory$'FileStream'
[file: name | |
↑(self get: name) asStream].
"62" FileDirectory$'DictionaryEntry'
[dictionary | |
↑directory].
"70" FileDirectory$'DictionaryEntry'
[dictionary: t1 | |
directory ← t1].
"79" FileDirectory$'FileStream'
[newFile: name | |
↑(self insert: name) asStream].
"144" FileDirectory$'FTP'
[retrieve: s | t |
(s is: Vector)
ifTrue: [s do: [:t | self retrieve: t as: t]]
ifFalse: [↑self retrieve: s as: s]].
"81" FileDirectory$'Dictionary'
[entryClass | |
self subError "a subclass of File"].
"54" FileDirectory$'FTP'
[server: t1 | |
directory ← t1].
"102" FileDirectory$'File'
[allocateSN: file | |
self subError "allocate a new serial number for a File"].
"210" FileDirectory$'Dictionary'
[printon: strm | |
strm append: (self obsolete
ifTrue: ['a closed ']
ifFalse: ['an open ']).
strm append: self class title.
strm append: ' on '.
self server printon: strm].
"135" FileDirectory$'FTP'
[store: s | t |
(s is: Vector)
ifTrue: [s do: [:t | self store: t as: t]]
ifFalse: [↑self store: s as: s]].
"84" FileDirectory$'FTP'
[login: name | |
↑self login: name password: '' "or prompt?"].
"67" FileDirectory$'FTP'
[login: name password: pw | |
self subError].
"126" FileDirectory$'FTP'
[userName | |
↑currentProfile nil
ifTrue: ['']
ifFalse: [currentProfile userName: self server]].
"67" FileDirectory$'Dictionary'
[open | |
externalViews insert: self].
"134" FileDirectory$'FTP'
[userPassword | |
↑currentProfile nil
ifTrue: ['']
ifFalse: [currentProfile userPassword: self server]].
"822" FileDirectory$'Dictionary'
[insert: file | old |
file ← self makeEntry: file "note: this changes the default behavior found in Dict.
this creates a new version rather than generating an error if the name exists".
self versionNumbers
ifTrue: [file ← self makeEntry: (file name "ignore explicit version and directory will create a next version" asStream upto: '!' 1)]
ifFalse:
[(self Find: file)
ifTrue:
[old ← self makeEntry: file name + '$' "otherwise, if the file already exists,
rename it to name$, deleting that file first if it exists".
(self Find: old)
ifTrue: [self Delete: old].
self rename: file name newName: old name "reposition to original name".
(self Find: file)
ifTrue: [self error: 'insert/rename ??' entry: file]] "file didn't exist"].
self Insert: file.
↑file].
"170" FileDirectory$'Dictionary'
[Find: file | name |
(name ← self checkName: file name)
ifTrue:
[file name: name.
↑self Position← file].
file error: 'illegal name'].
"119" FileDirectory$'File'
[newPage | |
↑(self makeEntry: nullString) "return a dummy FilePage from a dummy File" newPage].
"71" FileDirectory$'Dictionary'
[error: e entry: file | |
↑file error: e].
"248" FileDirectory$'FTP'
[retrieve: s1 as: s2 | f t4 |
(self exists: s1)
ifTrue: [f ← self oldFile: s1]
ifFalse: [↑false].
f readonly.
(t4 ← ((s2 is: FileStream)
ifTrue: [s2]
ifFalse: [dp0 file: s2])) append: f.
t4 close.
f close].
"246" FileDirectory$'FTP'
[store: s1 as: s2 | f t4 |
(s1 is: FileStream)
ifTrue: [f ← s1]
ifFalse:
[(dp0 exists: s1)
ifTrue: [f ← dp0 oldFile: s1]
ifFalse: [↑false]].
f readonly.
(t4 ← self file: s2) append: f.
t4 close.
f close].
"77" FileDirectory$'FileStream'
[oldFile: name | |
↑(self find: name) asStream].
"88" FileDirectory$'FileStream'
[pressfile: name | |
↑PressFile new of: (self file: name)].
"46" FileDirectory$'FTP'
[server | |
↑directory].
"279" FileDirectory$'FTP'
[asFtpDirectory | ftp |
(ftp ← FtpDirectory new "to allow convenient (kludgey) access to file servers (e.g. phylum, dpj) via Ftp") server: self server.
ftp open.
ftp userName empty
ifTrue: [ftp login: self userName password: self userPassword].
↑ftp].
"50" FileDirectory$'File'
[directory | |
↑directory].
"77" FileDirectory$'Juniper'
[closeTransaction | |
"default is to do nothing"].
"267" FileDirectory$'Dictionary'
[checkName: s | |
(s empty "default behavior is to get rid of ending period.
subclasses can do any kind of checking they want and
return false if name is no good" or: [s last ('.' 1)])
ifTrue: [↑s].
↑s copy: 1 to: s length - 1].
"114" FileDirectory$'Dictionary'
[close | |
self obsolete
ifFalse:
[externalViews delete: self.
self release]].
"64" FileDirectory$'Initialize'
[directory: t1 | |
directory ← t1].
"98" FileDirectory$'File'
[versionNumbers | |
↑false "generally, version numbers are not supported"].
"68" FileDirectory$'FileStream'
[filin: s | |
self filin: s format: 1].
"81" FileDirectory$'Juniper'
[exceptionHandler: eh | |
"default is to do nothing"].
"681" FileDirectory$'FileStream'
[filin: s format: ft | |
user displayoffwhile [
"read Class definitions or Changes from FileStreams or PressFiles
ft: 1 (FileStream=Bravo), 2 (Press)"
((s is: Vector)
ifTrue: [s do: [:s | self filin: s format: ft]]
ifFalse:
[ "special case for Alto and patterns"
((s is: String) and: [((s has: '*' 1) or: [(s has: '#' 1)])])
ifTrue: [self filin: (self filesMatching: s) format: ft]
ifFalse:
[(s is: UniqueString)
ifTrue: [s ← s + "Class name"
(ft = 1
ifTrue: ['.st']
ifFalse: ['.press'])].
(ft = 1
ifTrue: [self oldFile: s]
ifFalse: [self pressfile: s]) filin]])]].
"116" FileStream$'Filin/Filout'
[backup | |
self directory "assume ivy open" dp0
ifTrue: [ivy replace: self name]].
"144" FileStream$'Access Modes'
[writing | |
rwmode nil
ifTrue: [↑self readwriteshorten "default mode. true"].
↑(rwmode land: write) = write].
"257" FileStream$'Access Modes'
[setMode: m | |
rwmode = m
ifFalse:
[ "don't flush if first time or not write mode or continuing write mode"
(rwmode nil or: [((rwmode nomask: write) or: [(m anymask: write)])])
ifFalse: [self flush].
rwmode ← m]].
"62" FileStream$'Access Modes'
[readonly | |
self setMode: read].
"67" FileStream$'File'
[nextPage | |
↑self read: page pageNumber + 1].
"458" FileStream$'Dictionary'
[reopen | pos |
dirty
ifTrue:
[ "self obsolete"
pos ← position "reopen to current position".
(self read: page pageNumber)
ifTrue: [position ← pos min: limit]
ifFalse:
[ "if that page doesn't exist, go to last one that does.
note that settoend would be recursive"
(self read: self file lastPage)
ifTrue: [position ← limit]
ifFalse: [self error: 'cannot reopen or settoend']]]
ifFalse: [↑false]].
"484" BravoPrinter$'Writing'
[print: para | l r |
para ← para asParagraph.
eject
ifTrue:
[self eject.
eject ← false].
strm append: para text.
strm next← 26 "↑Z".
l ← frame origin x.
r ← frame corner x.
l self defaultframe origin x
ifTrue:
[strm append: 'l'.
strm print: l].
r self defaultframe corner x
ifTrue:
[strm append: 'z'.
strm print: r].
leading self defaultleading
ifTrue:
[strm append: 'e'.
strm print: leading].
para bravoRuns: strm].
"61" BravoPrinter$'Writing'
[eject | |
strm next← 12.
strm cr].
"70" BravoPrinter$'Initialization'
[init | |
super init.
eject ← false].
"97" BravoPrinter$'Writing'
[nextpage | |
eject
ifTrue: [self eject]
ifFalse: [eject ← true]].
"114" FileStream$'Filin/Filout'
[asParagraphPrinter | |
↑BravoPrinter init "default format for filout etc." of: self].
"63" FileStream$'Stream'
[wordposition | |
↑self positionSize: 2].
"81" File$'FileStream'
[asStream | |
↑FileStream new on: (self open.
self get: 1)].
"73" File$'DictionaryEntry'
[match: entry | |
↑self name match: entry name].
"335" File$'FilePage'
[Get: page | p pn |
pn ← page pageNumber.
(p ← self Read: page)
ifTrue: [↑p].
"current last page of the file is assumed full"
(lastpn + 1 to: pn - 1) "return an empty last page which is not written yet" do:
[:p | page pageNumber: p.
page ← self Write: page].
page pageNumber: pn.
page length: 0.
↑page].
"283" File$'Initialize'
[classInit | |
FilePool declare: #(read write shorten ) as: #(1 2 4 ) "subclasses of File may want to share variables in pools.
execute before filin:
Smalltalk declare: XFilePool as: (SymbolTable new init: 16).
in classInit: XFilePool declare: () as: ()"].
"33" File$'Dictionary'
[close | |
].
"66" File$'FilePage'
[read: pn | |
↑self Read: (self makeEntry: pn)].
"116" File$'FileDirectory'
[type: t1 | |
"used by different Files in different ways, e.g. read/write mode"
type ← t1].
"252" File$'Dictionary'
[makeEntry: page | t2 |
(page is: self entryClass)
ifTrue:
[page init.
page serialNumber: serialNumber.
↑page].
↑(t2 ← self entryClass new) dictionary: self.
t2 init.
t2 pageNumber: page.
t2 serialNumber: serialNumber].
"53" File$'DictionaryEntry'
[dictionary | |
↑directory].
"61" File$'DictionaryEntry'
[dictionary: t1 | |
directory ← t1].
"76" File$'Dictionary'
[entryClass | |
self subError "a subclass of FilePage"].
"50" File$'DictionaryEntry'
[name: t1 | |
name ← t1].
"76" File$'Dictionary'
[found: page | |
self subError "read an existing page"].
"256" File$'FilePage'
[doCommand: com page: page error: s | |
self subError "execute a File command on page. if an error occurs, include
error ← 'some error message'.
self error: s
if s is false, returns false.
otherwise s is passed to an error routine"].
"107" File$'File Length'
[lastFullPage | |
(self read: self lastPage) full
ifTrue: [↑lastpn].
↑lastpn - 1].
"42" File$'DictionaryEntry'
[name | |
↑name].
"114" File$'FilePage'
[Write: page | |
self subError "update lastpn, write page and return result (maybe next page)"].
"66" File$'Dictionary'
[open | |
self findLastPage "compute lastpn"].
"35" File$'Dictionary'
[release | |
].
"63" File$'Dictionary'
[Find: page | |
↑page pageNumber lastpn].
"51" File$'FilePage'
[newPage | |
↑self makeEntry: 0].
"190" File$'Initialize'
[sameFile | |
"is File's current internal representation the same as what is stored externally? if so, usually can avoid some initialization, directory lookup"
↑false].
"122" File$'File Length'
[endFile: page | |
self subError "make File end with this FilePage. false means delete all of File"].
"106" File$'File Length'
[lastPage | |
lastpn
ifTrue: [ "length in pages"
↑lastpn].
↑self findLastPage].
"56" File$'FilePage'
[newPage: pn | |
↑self makeEntry: pn].
"72" File$'FilePage'
[Read: page | |
self subError "return page or false"].
"141" File$'File Length'
[pageFrom: len | |
↑(len - 1 "compute page number for a character index" / self entryClass new dataLength) asSmall + 1].
"50" File$'FileDirectory'
[directory | |
↑directory].
"47" File$'Name'
[serialNumber | |
↑serialNumber].
"436" File$'Name'
[serialNumber: s | |
(s is: String) "stored as a String of 4 characters rather than as various Numbers"
ifTrue: [serialNumber ← s]
ifFalse:
[(s is: Substring)
ifTrue: [serialNumber ← s copy]
ifFalse:
[(s is: Integer)
ifTrue:
[serialNumber word: 1 ← 0.
serialNumber word: 2 ← s]
ifFalse:
[ "Vector of Integers"
serialNumber word: 1 ← s 1.
serialNumber word: 2 ← s 2]]]].
"58" File$'FileDirectory'
[directory: t1 | |
directory ← t1].
"60" File$'FileDirectory'
[delete | |
↑directory delete: self].
"197" File$'File Length'
[findLastPage | |
↑lastpn ← self pageFrom: self length "the default definitions for findLastPage and length are circular.
at least one of them must be defined by a subclass"].
"129" File$'Dictionary'
[reopen | |
self sameFile
ifFalse: [ "init and directory access"
directory get: self init].
self open].
"94" File$'File Length'
[lastPage: t1 | |
"for those who know what they're doing"
lastpn ← t1].
"245" File$'FilePage'
[error: e | t2 |
e
ifTrue:
[e ← ((t2 ← Stream default) append: name.
t2 append: ' in '.
t2 append: e.
t2 append: ', '.
t2 append: error.
t2 contents).
error ← nullString.
↑super error: e].
↑false].
"40" File$'FileDirectory'
[type | |
↑type].
"1350" File$'Documentation'
[help | |
"
A common way to access a File is through a FileStream.
to create a FileStream on either an old or new file:
<FileStream> ← <FileDirectory> file: <String>. (see also oldFile: and newFile:)
e.g. f ← dp0 file: 'test'.
The default access mode (readwriteshorten) allows you to read or write, and
automatically shorten a File (to its current position) upon closing). If you want to
only read a file, readonly mode is faster and safer.
Some common ways to access a FileStream (see Stream and FileStream):
reading a character (an Integer between 0 and 255)
next,
reading a String of characters
upto: , next:, nextString, contents
reading other kinds of objects
nextword, word:, nextNumber:, nextParagraph
writing characters
next←, ←
writing a String of characters
append:, nextString←
writing other kinds of objects
nextword, word:←, print:
finding position
position, wordposition, length, end, positionSize:
changing position (besides reading/writing)
position←, skip:, skipTo:, reset, settoend, wordposition←, position:size:
When finished with a FileStream, <FileStream> close.
For information about using or creating other views of file organizations (Btree, file-based object dictionaries, Findit), about WFS and Juniper files, and general file problems, see Steve Weyer.
"].
"60" AltoFileDirectory$'Dictionary'
[entryClass | |
↑AltoFile].
"245" AltoFileDirectory$'FileDirectory'
[allocateSN: file | sn |
bitsFile position← 8.
sn ← bitsFile next: 4.
sn word: 2 ← (sn word: 2) + 1 = 0
ifTrue: [sn word: 1 ← (sn word: 1) "overflow" + 1].
bitsFile skip: 4.
bitsFile append: sn.
↑sn].
"993" AltoFileDirectory$'Alto'
[growSmalltalkBy: n | zfpt i file page a zlen |
i ← 1 "dp0 growSmalltalkBy: 100." "find and read last page of small.boot, then extend file".
zlen ← 96.
zfpt ← CoreLocs new base: Vmem specialLocs 7 length: zlen * 2.
[zfpt (i + zlen) = 0] whileFalseDo: [i ← i + 1].
a ← zfpt (i + zlen - 1) + (zfpt i) - (zfpt (i - 1)) - 1.
self open.
file ← self makeEntry: 'small.boot.'.
page ← file newPage.
page address: (self virtualToReal: a).
page doCommand: CRR error: 'cannot read last page. growSmalltalkBy:' "bypass reading file and creating random access table, just extend it".
page lastPage
ifTrue:
[file serialNumber: page serialNumber.
file lastPage: page pageNumber.
file pageAddresses: false "Read:, Write: check this".
file Get: (page pageNumber: page pageNumber + n).
user space.
user print: self freePages.
user show: ' pages left.']
ifFalse: [self error: 'growSmalltalkBy:. last page not last or 2 successive user grows']].
"715" AltoFileDirectory$'FileDirectory'
[realToVirtual: adr | |
↑(adr lshift: 12) "see virtualToReal:.
Alto address format is
bits
0-3 sector number (0 - 015, i.e. 12 or 14 sectors)
4-12 cylinder number (0 - 0312, Model 31; 0-0625, Model 44)
13 head number (0-1)
14 disk number (0-1)
15 restore bit.
in a system with two separable disks, addresses on disk 1 have a 0 disk bit, which is complemented by the disk primitive" "sector: field" + (nSectors * ((adr land: 4092) "cylinder and head: field*" lshift: 2)) + "disk: field*pages per disk"
((adr land: 2) = 2
ifTrue: [diskPages]
ifFalse: [0]) "diskPages*(adr land: 2)/2" "vadr < 0 or vadr totalPages [
self error: 'illegal disk address']"].
"535" AltoFileDirectory$'Alto'
[addEntry: file | entrysize holesize |
"called only by Insert: and rename:newName:"
(holesize ← dirFile nextword)
ifTrue:
[holesize ← holesize land: dfmask - 1 "either a deleted entry or rename entry".
dirFile skip: 2] "at end".
entrysize ← self entrySize: file.
dirFile readwrite.
dirFile nextword← entrysize + dfmask.
file storeOn: dirFile.
(holesize and: [entrysize < holesize])
ifTrue: [dirFile nextword← holesize - entrysize "mark remaining hole"].
dirFile readonly.
bitsFile flush].
"389" AltoFileDirectory$'Alto'
[deleteEntry: file | p |
p ← dirFile position "called only by Delete: and rename:newName:
read and save".
self nextEntry: file.
dirFile position← p "delete it from directory (turn off bit in entry length word)".
p ← dirFile nextword land: dfmask - 1.
dirFile skip: 2.
dirFile readwrite.
dirFile nextword← p.
dirFile readonly.
dirFile skip: 2.
↑file].
"1142" AltoFileDirectory$'FileDirectory'
[rename: file newName: newName | holesize pos |
(newName ← self checkName: newName)
ifTrue:
[self position← newName
ifTrue: [self error: 'new name already exists: ' + newName]
ifFalse: [ "a possible insertion place"
pos ← dirFile position]]
ifFalse: [self error: 'illegal new name: ' + newName].
(self Find: (file ← self makeEntry: file))
ifTrue:
[holesize ← dirFile nextword land: dfmask - 1.
dirFile skip: 2.
file name: newName.
(self entrySize: file) "new size of entry" holesize
ifTrue:
[pos ← dirFile position "new entry will fit in current entry" "read and save entry".
self nextEntry: file]
ifFalse: [ "delete and save entry"
self deleteEntry: file] "position to same entry or hole discovered earlier".
dirFile position← pos.
self addEntry: (file name: newName).
(file type is: Integer)
ifTrue: [file type: write "file is open. defer leader page change until someone closes it"]
ifFalse:
[ "close file: updating name in leader page"
file type: write.
file close]]
ifFalse: [file error: 'rename: old name does not exist']].
"826" AltoFileDirectory$'Alto'
[checkName: fname fixing: fixing | x copy special |
fname empty
ifTrue:
[fixing
ifTrue: [↑'$'].
"empty name"
↑false]
ifFalse:
[fname length > 38
ifTrue:
[fixing
ifTrue: [fname ← fname (1 to: 38)]
ifFalse: [ "name too long"
↑false]].
copy ← (String new: fname length + 1) asStream.
special ← '.-+$!?'.
fname do:
[:x | (x isletter "check characters: alphanumeric or 6 special" or: [((special has: x) or: [x isdigit])])
ifTrue: [copy next← x]
ifFalse:
[fixing
ifTrue: [copy next← special 2]
ifFalse: [ "illegal character"
↑false]]].
fixing
ifTrue:
[fname last = (special 1)
ifTrue: [copy skip: 1]]
ifFalse:
[fname last (special 1)
ifTrue: [copy next← special 1]].
↑copy contents]].
"108" AltoFileDirectory$'Alto'
[diskNumber | |
↑directory "directory is: Integer [" "] directory diskNumber"].
"477" AltoFileDirectory$'Alto'
[deallocate: page | index ch m |
dirFile nil
ifTrue: [self open].
index ← self realToVirtual: page address "character position".
bitsFile position← index / 8 + boffset.
ch ← bitsFile next "bit position".
m ← 128 lshift: 0 - (index land: 7) "make page free by turning off bit in DiskDescriptor".
(ch land: m) = m
ifTrue:
[bitsFile skip: 1.
bitsFile next← ch - m]
ifFalse:
[user cr.
user show: 'page already free (dealloc:)']].
"1703" AltoFileDirectory$'Alto'
[allocate: nextPage after: address | index stop ch m vadr |
index ← false.
[true] whileTrueDo:
[ "go around bittable from address to end, and beginning to address.
we start over again if the table appears full or bitsFile is out of sync"
(index and: [stop totalPages])
ifTrue:
[stop ← address "wrap around to where we started".
index ← 0]
ifFalse:
[index false
ifFalse: [ "first time or bitsFile out of sync" "disk probabbly full"
user quitThen: '// YOUR DISK IS FULL - Please make some space available.
// Then resume Smalltalk and interrupt or continue as desired...'].
self open "index by bits rather than bytes? close enough for now".
index ← address land: 8.
stop ← totalPages].
bitsFile position← index / 8 + boffset.
[index and: [(index ← index + 8) stop]] whileTrueDo:
[(ch ← bitsFile next) = 255
ifFalse:
[ "8 full" "check that bitsFile position is correct --
possibly out of sync with index if growSmalltalkBy: occurred?"
bitsFile position (index / 8 + boffset)
ifTrue: [index ← false]
ifFalse:
[m ← 128.
(index - 8 to: index - 1) do:
[:vadr | (ch land: m) "nomask:" = 0
ifTrue:
[bitsFile skip: 1 "page appears free. first update DiskDescriptor".
bitsFile next← ch ← ch lor: m "then check if page is really free".
vadr = 0
ifFalse:
[ "O.S. boot"
(nextPage init.
nextPage freePage.
nextPage address: (self virtualToReal: vadr).
nextPage doCommand: CCR error: false)
ifTrue: [↑vadr] "page not really free"]] "page not free according to bit".
m ← m lshift: 1]]]]]].
"63" AltoFileDirectory$'Dictionary'
[obsolete | |
↑dirFile nil].
"352" AltoFileDirectory$'Alto'
[freePages | npages ch i |
self open.
bitsFile position← boffset.
npages ← 0.
(1 to: totalPages by: 8) do:
[:i | (ch ← bitsFile next) = 255
ifFalse:
[ "all used" "possibly up to 8 unused"
npages ← npages + 8.
[ch = 0] whileFalseDo:
[npages ← npages - (ch land: 1).
ch ← ch lshift: 1]]].
↑npages].
"1983" AltoFileDirectory$'Dictionary'
[open | f s a page len elen type |
nil dirFile
ifFalse:
[ "assume some defaults in case DSHAPE is not in SysDir leader page.
these should only be needed if the disk is old (and not scavenged).
they will not work if a 14 sector system is missing DSHAPE (unlikely) since addresses of first page of directory and of DiskDescriptor might be computed incorrectly.
in a Smalltalk-76 system, nSectors, diskPages had better eventually match:
| a. a ← Vmem specialLocs13. mem(a+5), (mem(a+6))
"
nSectors ← 12.
diskPages ← 812 * nSectors.
totalPages ← 2 * diskPages "read SysDir leader page to find out file system configuration. see AltoFileSys.D".
f ← self find: dirname "to prevent address of page 1 from being stored".
f pageAddresses: false "length of property list, in words".
page ← f read: 0.
len ← page 494.
len 210
ifFalse:
[ "scan file properties for DSHAPE"
s ← page asStream.
s skipwords: page 493.
[len > 0] whileTrueDo:
[type ← s next.
type = 0
ifTrue: [len ← 0 "0 terminates list. property not found. try to read if from DiskDescriptor"]
ifFalse:
[elen ← s next.
(type = 1 and: [elen = 5])
ifTrue:
[self configure: s "DSHAPE. read property" "set flags so configure and loop are not done again".
s ← false.
len ← 0]
ifFalse:
[ "skip over other property"
len ← len - elen.
s skipwords: elen - 1]]]] "now, with the correct (or default) file system configuration,
store the virtual address of next page (1), and create a FileStream on SysDir".
a ← AltoFileAddressTable new.
a 1 ← page header: nextp.
f pageAddresses: a.
(dirFile ← f asStream) readonly.
(bitsFile ← self oldFile: 'DiskDescriptor') readwrite.
s
ifTrue: [self configure: bitsFile "configuration not read from SysDir. this will work for 12 sector systems.
14 sector systems should have had the DSHAPE property"].
super open]].
"257" AltoFileDirectory$'Alto'
[filesMatching: pattern | files v i |
files ← self match: (pattern last = ('.' 1)
ifTrue: [pattern]
ifFalse: [pattern + '.']).
v ← Vector new: files length.
(1 to: v length) do: [:i | v i ← (files i) name].
↑v].
"72" AltoFileDirectory$'Dictionary'
[release | |
dirFile ← bitsFile ← nil].
"102" AltoFileDirectory$'Dictionary'
[entrySize: file | |
↑1 + (file fileSize "entry size in words" / 2)].
"142" AltoFileDirectory$'Dictionary'
[reset | |
self obsolete
ifTrue: [self open]
ifFalse: [self flush].
dirFile readonly.
dirFile reset].
"127" AltoFileDirectory$'Dictionary'
[Delete: file | t2 |
(t2 ← self deleteEntry: file) open.
t2 endFile: false.
bitsFile flush].
"470" AltoFileDirectory$'Dictionary'
[Insert: file | sn page |
file serialNumber: (sn ← self allocateSN: file) "allocate a new page (more success after O.S. stuff, bittable etc.)".
self allocate: (page ← file newPage) after: 800 "write 0th -- leader, in the process filling it in and then creating first page".
page init.
page serialNumber: sn.
page length: page dataLength.
file leader: page address.
file type: write.
file updateLeader: page.
self addEntry: file].
"88" AltoFileDirectory$'FileDirectory'
[checkName: s | |
↑self checkName: s fixing: false].
"179" AltoFileDirectory$'Dictionary'
[close | |
self obsolete
ifFalse:
[dirFile close.
bitsFile nil
ifFalse: [ "an interrupted open?"
bitsFile close].
super close]].
"649" AltoFileDirectory$'Alto'
[stampBoot | a file page |
a ← Vmem specialLocs "dp0 stampBoot." "update the time stamps in leader page of current boot file" "find SafeId for current boot file" 13.
file ← self makeEntry: ''.
file serialNumber: {mem a , (mem (a + 1))} "read page one of the boot file to find out the leader address".
page ← file makeEntry: 1.
page address: mem (a + 4) "then set leader address and dirty flag, and close file
thereby updating create/write/read dates, but not name".
file doCommand: CCR page: page error: 'cannot read page 1 of boot file'.
file leader: (page header: backp).
file type: write.
file close].
"176" Textframe$'Printing'
[hardcopy | pf |
user displayoffwhile [
(pf ← dp0 pressfile: 'frame.press'.
window hardcopy: pf.
self hardcopy: pf.
pf close.
pf toPrinter)]].
"318" Textframe$'Measuring'
[measureall | starti stopi linei |
"Set up lines for text displayer"
starti ← linei ← 1.
stopi ← para length.
[starti > stopi] whileFalseDo:
[self line: linei ← self measurefrom: starti to: stopi.
starti ← (lines linei) stopi + 1.
linei ← linei + 1].
self trimLinesTo: linei - 1].
"1201" Textframe$'Printing'
[hardcopy: pf | first last lasty len parag left right top bottom rect |
para nil
ifTrue: [self makeParagraph].
parag ← para asParagraph.
frame = window
ifTrue: [parag presson: pf in: (pf transrect: window) style: style]
ifFalse:
[left ← frame minX max: window minX.
right ← window maxX min: frame maxX.
bottom ← window maxY min: frame maxY.
top ← window minY max: frame minY.
lasty ← top + 4 "slop for char finding and making print rect larger".
first ← self charofpoint: left + 1 lasty andrect [:rect | rect].
len ← parag length.
(frame minX left and: [frame maxX right])
ifTrue: [(parag copy: first to: len) "paragraph is inset and may be scrolled" presson: pf in: (pf transrect: (left top rect: right (bottom + 4))) style: style]
ifFalse: [ "yuk, frame extends left or right so do it a line at a time for clipping"
[first < len and: [lasty < bottom]] whileTrueDo:
[last ← (self charofpoint: right - 1 lasty andrect [:rect | rect]) min: len.
lasty ← lasty + rect height.
(parag copy: first to: last) presson: pf in: (pf transrect: (left rect minY rect: right lasty)) style: style.
first ← last + 1]]]].
"1054" Textframe$'Measuring'
[measurefrom: starti to: stopi | line chari spacecount rightbits P stopx |
"measure and return a line"
line ← CharLine new starti: starti stopi: stopi spaces: 0 padwidth: 0.
P ← self printer: false.
P scanline: line at: 0 stopx: (stopx ← frame maxX) stopchar: stopi.
chari ← P chari.
spacecount ← P spacecount.
(chari = stopi or: [para chari = cr])
ifTrue:
[ "CR or string end"
rightbits ← stopx - P rightx.
spacecount ← 0]
ifFalse:
[spacecount > 0
ifTrue:
[ "Back up to space"
chari ← P spacei.
rightbits ← stopx - P spacex.
(chari > starti and: [para (chari - 1) = space])
ifTrue:
[spacecount ← spacecount - 1.
rightbits ← rightbits + P rightx - P leftx]
ifFalse:
[(chari < stopi and: [para (chari + 1) = space])
ifTrue: [chari ← chari + 1]] "double spaces".
spacecount ← 1 max: spacecount - 1]
ifFalse:
[chari ← chari - 1.
rightbits ← stopx - P leftx]] "Back 1 char".
↑line starti: starti stopi: chari spaces: spacecount padwidth: rightbits].
"206" Textframe$'Line management'
[trimLinesTo: last | i |
(last + 1 to: lastline) do: [:i | lines i ← nil].
(lastline ← last) < (lines length / 2)
ifTrue: [lines ← lines growby: 0 - (lines length / 2)]].
"49" Textframe$'Access to Parts'
[frame | |
↑frame].
"117" Textframe$'Displaying'
[clearfrom: y | |
((frame origin x y rect: frame corner) intersect: window) clear: white].
"65" Textframe$'Access to Parts'
[lineheight | |
↑style lineheight].
"255" Textframe$'Measuring'
[maxx: char | i rect maxx |
self measureall.
maxx ← 0.
(1 to: lastline) do:
[:i | self pointofchar: (lines i) stopi andrect [:rect | rect].
rect corner x > maxx
ifTrue: [maxx ← rect corner x]].
↑maxx rect corner y].
"165" Textframe$'Displaying'
[displayall | liney |
"display all the lines in window"
liney ← self displaylines: 1 to: lastline.
self clearfrom: liney "self outline"].
"940" Textframe$'Displaying'
[displaylines: startline to: stopline | liney line P lineheight boty leftx |
"display a range, windowed"
lineheight ← style lineheight.
startline ← startline max: (self lineofy: window minY).
stopline ← stopline min: (self lineofy: window maxY - lineheight).
liney ← self yofline: startline.
boty ← liney + lineheight.
P ← self printer: true "P should do left and right clearing, since it has clip rect".
(startline to: stopline) do:
[:startline | line ← lines startline.
para alignment > 1
ifTrue:
[leftx ← frame minX + (para alignment = 4
ifTrue: [line padwidth]
ifFalse: [line padwidth / 2]).
(window minX liney rect: leftx boty) clear: white].
P scanline: line at: liney stopx: window maxX stopchar: line stopi.
(para alignment nomask: 1)
ifTrue: [(P rightx liney rect: window maxX boty) clear: white].
liney ← boty.
boty ← boty + lineheight].
↑liney].
"67" Textframe$'Displaying'
[erase | |
(window inset: 2 2) clear].
"96" Textframe$'Displaying'
[put: t1 at: pt | |
para ← t1.
self put: para at: pt centered: false].
"4411" Textframe$'Editing'
[replace: starti to: stopi with: insert | i j k startline stopline oldlastline newline range stopped oldlines begini oldy newy moveRect |
"cut or paste"
para replace: starti to: stopi by: insert "do the replacement in the string".
lastline = 0
ifTrue:
[self measureall.
self displayall]
ifFalse:
[ "if lines have never been set up,
measure them and display all the
lines falling in the window"
oldlines ← lines copy.
oldlastline ← lastline.
i ← startline ← self lineofchar: starti "find the starting and stopping lines".
stopline ← self lineofchar: stopi.
range ← insert length - (stopi - starti + 1) "how many characters being
inserted or deleted" "If the starting line is not also the first line, then measuring must commence from line preceding the one in which starti appears. For example, deleting a line with only a carriage return may move characters following the deleted portion of text into the line preceding the deleted line.".
begini ← (lines i) starti.
startline > 1
ifTrue:
[newline ← self measurefrom: (lines (startline - 1)) starti to: para length.
lines (startline - 1) = newline
ifFalse:
[ "no backwrap" "start in line preceding that containing the starting character"
startline ← startline - 1.
self line: startline ← newline.
begini ← newline stopi + 1]].
begini > para length
ifTrue:
[self trimLinesTo: (i - 1 max: 0) "nil lines after cut--remeasure last line below".
para length = 0
ifTrue:
[ "cut entire paragraph--clear and return"
window clear: white.
↑self]].
stopped ← false.
j ← stopline.
[stopped or: [begini > para length]] whileFalseDo:
[self line: i ← newline ← self measurefrom: begini to: para length.
[(j > oldlastline or: [newline stopi "no more old line to compare with" < (stopi ← (oldlines j) stopi + range)]) or: [stopped]] whileFalseDo:
[stopi = newline stopi
ifTrue:
[ "got the match"
oldy ← self yofline: j + "get source and destination y's for moving the unchanged lines"
(range < 0
ifTrue: [0]
ifFalse: [1]).
newy ← self yofline: i + (range < 0
ifTrue: [0]
ifFalse: [1]).
stopline ← i.
stopped ← true "fill in the new line vector with the old unchanged lines.
Update their starting and stopping indices on the way.".
((j ← j + 1) to: oldlastline) do: [:k | self line: (i ← i + 1) ← oldlines k slide: range].
self trimLinesTo: i "trim off obsolete lines, if any"]
ifFalse: [j ← j + 1]].
begini ← newline stopi + 1.
i ← i + 1 "Now the lines are up to date. What remains is the move the 'unchanged' lines and display those which have changed."].
begini > para length
ifTrue: [ "If at the end of previous lines simply display lines
from the line in which the first character of the
replacement occured through the end of the paragraph."
self displaylines: startline to: (stopline ← i min: lastline)]
ifFalse:
[ "Otherwise prepare to move the unchanged lines. moveRect defines the portion of the window containing the lines which may be move en masse." "Deletion -- moving 'up' the screen or ..."
moveRect ← window minX (oldy max: window minY) rect: window corner "Insertion -- moving 'down' the screen.
Shorten moveRect by height of insertion or ...".
oldy newy
ifTrue: [moveRect corner← window corner + (0 (oldy - newy))]
ifFalse:
[ "Deletion, and top of moveRect will fall above top of window.
Increase the origin of moveRect by the amount that would fall above
(hence outside) the window."
newy < window minY
ifTrue: [moveRect origin← window minX (oldy + window minY - newy)]] "Move it.".
moveRect blt: window minX (newy max: window minY) mode: storing "Display the new lines.".
self displaylines: startline to: stopline "A deletion may have 'pulled' previously undisplayed lines into the window.
If so, display them.".
(newy < oldy and: [(self yofline: oldlastline + 1) > window maxY])
ifTrue: [self displaylines: (self lineofy: window maxY - (oldy - newy)) to: (stopline ← self lineofy: window maxY)]] "If we have done a deletion, obsolete material may remain at the bottom of the window. If so, clear it out.".
oldlastline lastline
ifTrue: [self clearfrom: (self yofline: lastline + 1)]]].
"219" Textframe$'Line management'
[adjustLines: i by: delta | |
"add to indices of charlines beginning with stopi in i"
lines i stopi← (lines i) stopi + delta.
(i + 1 to: lastline) do: [:i | lines i slide: delta]].
"175" Textframe$'Line management'
[lineofchar: index | i |
"Return line number (may be 0)"
(1 to: lastline) do:
[:i | index (lines i) stopi
ifTrue: [↑i]].
↑lastline].
"848" Textframe$'Testing'
[Initializations | |
"
Smalltalk declare: Undeclared contents from: Undeclared.
Smalltalk declare: (Cream10 STBig TestSet TestStyle TestPara TD TDFlag NoteTaker).
NoteTaker ← false.
(dp0 file: 'Cream10.strike') append: DefaultTextStyle fonts1; close.
TextDisplayer classInit.
Cream10 ← Font new fromStrike: 'Cream10'.
STBig ← Font new fromStrike: 'STBig'.
TestSet ← FontSet init. TestSet 0 ← Cream10. TestSet1 ← STBig.
TestStyle ← StyleSheet new fontset: TestSet.
TestPara ← Paragraph new text:
'again
copy
cut
paste
doit
compile
undo
cancel
align
'.
TestPara text: TestPara text runs: TestPara runs alignment: 0.
TextEditor classInit.
TD ←TDTextImage new.
user schedule: (TD ← TDCodePane new showing: TestPara).
| r. TD frame: (r ← Rectangle new fromuser) window: r para: TestPara style: TestStyle.
TD measureall.
"].
"56" Textframe$'Initialization'
[style: t1 | |
style ← t1].
"226" Textframe$'Line management'
[line: i ← line | |
"store a line, track last, and grow lines if necessary"
i > lastline
ifTrue: [lastline ← i].
lastline > lines length
ifTrue: [lines ← lines grow].
↑lines i ← line].
"129" Textframe$'Conversion'
[makeParagraph | |
para nil "simulate ListPane for hardcopy"
ifTrue: [para ← 'NIL !' asParagraph]].
"39" Textframe$'Image'
[style | |
↑style].
"460" Menu$'Initialization'
[string: t1 | i pt tpara |
str ← t1.
str last 13
ifTrue: [str ← str + '
'].
text ← Textframe new para: (tpara ← str asParagraph) frame: (Rectangle new origin: (pt ← 0 0) corner: 1000 1000).
pt ← text maxx: str length + 1.
text frame growto: pt + (4 0).
text measureall.
tpara center.
frame ← text frame inset: 2 2.
thisline ← Rectangle new origin: text frame origin corner: text frame corner x text lineheight].
"263" Menu$'Internal'
[movingsetup | pt bits |
pt ← user mp - thisline center "center prev item on mouse".
text frame moveby: pt.
thisline moveby: pt.
frame moveby: pt.
bits ← frame bitsIntoString "save background".
frame clear: black.
text displayall.
↑bits].
"61" Menu$'User interactions'
[has: pt | |
↑text frame has: pt].
"287" Menu$'User interactions'
[wbug | index bits |
bits ← self movingsetup "save background, display menu" "wait until a mouse button is down".
[user anybug] whileFalseDo: [ "get selection (possibly 0)"
].
index ← self bugit "restore background".
frame bitsFromString: bits.
↑index].
"162" Menu$'Initialization'
[rescan | |
" | each. Menu allInstances notNil transform each to each rescan."
self string: str "rescan (for new fonts, lineheight)"].
"212" Menu$'User interactions'
[bug | index bits |
bits ← self movingsetup "set up and save background".
index ← self bugit "get the index".
frame bitsFromString: bits "restore background".
↑index "return index"].
"2478" Form$'EDITING'
[edit: parentimage | pt f c file t6 |
[false] whileFalseDo:
[ "Simple Form editor for now." "forever for now"
pt ← parentimage mp " blink the current brush".
BlankCursor topage1.
self blinkbrush: parentimage.
user redbug
ifTrue:
[(parentimage contains: (pt ← self blinkbrush: parentimage))
ifTrue:
[brush displayat: pt effect: color clippedBy: parentimage rectangle.
[user redbug] whileTrueDo:
[brush displayat: (self blinkbrush: parentimage) effect: color clippedBy: parentimage rectangle]]
ifFalse:
[NormalCursor topage1.
bits ← parentimage rectangle bitsIntoString.
↑self]]
ifFalse:
[user kbck
ifTrue:
[c ← user kbd.
c = 120
ifTrue:
[user clearshow: 'x gridding is '.
parentimage xgrid print.
user cr.
parentimage xgrid: (user request: 'x gridding . . . ') asInteger]
ifFalse:
[c = 121
ifTrue:
[user clearshow: 'y gridding is '.
parentimage ygrid print.
user cr.
parentimage ygrid: (user request: 'y gridding . . . ') asInteger]
ifFalse:
[c = 114
ifTrue:
[file ← user request: 'filename of Form . . .'.
brush ← Form new read: file.
brush figure: 1.
brush ground: 0]]]]
ifFalse:
[user yellowbug
ifTrue:
[NormalCursor topage1.
(t6 ← formmenu bug) = 1
ifTrue: [self newbrush: parentimage]
ifFalse:
[ "get a new brush"
t6 = 2
ifTrue:
[color ← 1]
ifFalse:
[ "set the color of the brush to black"
t6 = 3
ifTrue:
[color ← 3]
ifFalse:
[ "set the color of the brush to white"
t6 = 4
ifTrue: [self line: parentimage]
ifFalse:
[t6 = 5
ifTrue: [self arc: parentimage]
ifFalse:
[t6 = 6
ifTrue:
[self white.
parentimage display]
ifFalse:
[ "erase the whole form"
t6 = 7
ifTrue: [self resize: parentimage]
ifFalse:
[ "change size"
t6 = 8
ifTrue: [self setfigure: parentimage]
ifFalse:
[t6 = 9
ifTrue: [self setground: parentimage]]]]]]]]]]
ifFalse:
[user bluebug
ifTrue:
[bits ← parentimage rectangle bitsIntoString.
NormalCursor topage1.
↑self] "exit back to the parentimage"]]]]].
"114" Form$'MODULE ACCESS'
[figure: t1 | |
figure ← t1 "set the figure ( color assiciated with black) for the form "].
"210" Form$'INIT'
[fromImage: image | |
self extent: image extent "creates a virtual bit map with width = (image width) and height = (image height) with the bits in image.".
bits ← image rectangle bitsIntoString].
"180" Form$'INIT'
[fromrectangle: r | |
self extent: r extent "creates a virtual bit map with width = (r width) and height = (r height) with the bits in r.".
bits ← r bitsIntoString].
"114" Form$'MODULE ACCESS'
[ground: t1 | |
ground ← t1 "set the ground ( color assiciated with white) for the form "].
"107" Form$'SYSTEM'
[hidePress: press complete: c | |
press skipcode: self pressCode data: (self hideData: c)].
"197" Form$'EDITING'
[setfigure: parentimage | |
figure ← figure + 1 "for now just increment the figure color by 1 \ 14" \ 14.
self displayat: parentimage origin effect: 0 clippedBy: user screenrect].
"197" Form$'EDITING'
[setground: parentimage | |
ground ← ground + 1 "for now just increment the ground color by 1 \ 14" \ 14.
self displayat: parentimage origin effect: 0 clippedBy: user screenrect].
"79" Form$'MODULE ACCESS'
[offset | |
offset nil
ifTrue: [↑0 0].
↑offset].
"194" Form$'FILING'
[write: filename | t2 |
(t2 ← dp0 file: filename "Saves the Form in the format width,height,bits.") nextword← self width.
t2 nextword← self height.
t2 append: bits.
t2 close].
"82" Form$'PATTERN ACCESS'
[bits | |
↑bits "return the string containing the bits)"].
"142" Form$'INIT'
[halftoneInteger | screen i |
screen ← 0.
(1 to: 4) do: [:i | screen ← (screen lshift: 4) lor: (bits i land: 15)].
↑screen].
"216" Form$'INIT'
[fromHalftone: halftone | i j line |
self extent: 16 16.
(1 to: 4) do:
[:i | line ← (halftone land: 15) * 4369.
(0 to: 3) do: [:j | bits (j * 4 + i) ← line].
halftone ← halftone lshift: 4]].
"300" Form$'SYSTEM'
[presson: press in: r | hs y |
(hs ← press scale * self height) > r height
ifTrue: [↑self].
"not enough room left on current page.
assume for now that it will at least fit on an entire page"
press setp: r origin x (y ← r corner y - hs).
press bitmap: self bits: bits.
↑y].
"418" Form$'INIT'
[classInit | |
black ← 0 - 1 "sets up colors and effects for BITBLT.".
white ← 0.
over ← 0.
under ← 1.
reverse ← 2.
brush ← Form new extent: 5 5.
brush black.
color ← 1.
formmenu ← Menu new string: 'brush
black
white
line
arc
erase
size
figure
ground
'.
dotsetter ← BitBlt new init " a BitBlt for pattern access.".
dotsetter extent: 1 1.
aurorarunning ← false.
aurora ← nil "Aurora new"].
"91" Form$'MODULE ACCESS'
[extent | |
↑extent "return the extent (widthheight) of the Form"].
"179" Form$'SYSTEM'
[asInstance | s |
s ← Stream new default.
s nextPoint← extent.
s nextPoint← offset.
s nextword← figure.
s nextword← ground.
s nextString← bits.
↑s contents].
"396" Form$'PATTERN ACCESS'
[black: pt | |
(0 0 "sets the bit at pt in the form to black ( to one)" pt and: [pt extent])
ifTrue:
[dotsetter dest: (NoteTaker
ifTrue: [bits]
ifFalse: [bits lock]).
dotsetter destRaster: extent x + 15 / 16.
dotsetter destOrigin: pt.
dotsetter screen: black.
dotsetter effect: 12.
dotsetter callBLT.
NoteTaker
ifFalse: [bits unlock]]].
"78" Form$'MODULE ACCESS'
[height | |
↑extent y "return the height of the Form"].
"90" Form$'MODULE ACCESS'
[offset: t1 | |
offset ← t1.
↑self "set the offset of the form "].
"401" Form$'FILING'
[read: filename | f strip w h form stripheight leftoverlines i |
f ← dp0 oldFile: filename "Reads the Form from the disk in the format width,height,bits.".
f readonly.
w ← f nextword.
h ← f nextword.
extent ← w h.
w * h < 64000
ifTrue:
[bits ← (Form new extent: extent) bits.
f into: bits.
f close]
ifFalse:
[f close.
user notify: 'too many bits to be a Form']].
"196" Form$'INIT'
[extent: t1 | |
extent ← t1.
self extent: extent figure: 0 ground: 1 offset: 0 0 "creates a virtual bit map with width = (extent x) and height = (extent y) with the bits all 1."].
"89" Form$'PATTERN ACCESS'
[bits: t1 | |
bits ← t1 "reset the string containing the bits)"].
"174" Form$'SYSTEM'
[fromInstance: file | |
extent ← file nextPoint.
offset ← file nextPoint.
figure ← file nextword.
ground ← file nextword.
bits ← file nextString.
↑self].
"27" Form$'INIT'
[close | |
].
"171" Form$'INIT'
[fromuser | r |
r ← Rectangle new "create a new Form whose rectangle is specified by the user. " fromuser.
self extent: r extent.
bits ← r bitsIntoString].
"253" Form$'SYSTEM'
[fromPress: press value: s | nbytes |
extent ← s nextPoint.
offset ← s nextPoint.
figure ← s nextword.
ground ← s nextword.
nbytes ← 2 * extent y * (extent x + 15 / 16).
press data skip: 0 - nbytes.
bits ← press data next: nbytes].
"248" Form$'INIT'
[fromuserevenword | r |
r ← Rectangle new "create a new Form whose rectangle is specified by the user,
truncated to nearest multiple of 16 (for Spruce printing). " fromuserevenword.
self extent: r extent.
bits ← r bitsIntoString].
"157" BitBlt$'Operations'
[callBLT | |<primitive: 66>
(screen is: Form)
ifTrue:
[screen ← screen halftoneInteger.
self callBLT]
ifFalse: [user croak]].
"141" BitBlt$'Setup'
[window: rect | |
"this is public"
NoteTaker
ifTrue: [self clipRect: (rect intersect: (0 0 rect: destForm extent))]].
"185" BitBlt$'Setup'
[forCursor | |
self effect: 0.
self screen: black.
dest ← source ← 281.
width ← height ← 16.
destRaster ← sourceRaster ← 1.
destX ← destY ← sourceX ← sourceY ← 0].
"121" BitBlt$'Setup'
[init | |
self effect: 0.
self screen: black.
destX ← destY ← width ← height ← sourceX ← sourceY ← 0].
"1558" BitBlt$'Operations'
[stringReplace: destString with: sourcestring from: start to: stop and: replacement from: rstart to: rstop | slock |
NoteTaker
ifTrue: [↑false].
"Works for BitBlt parameters less than 4096. Replaces a subrange of a string. Called only by String replace:to:by:from:to:. Concatenates into destString:
sourcestring(1 to: start - 1)
replacement(rstart to: rstop)
sourcestring(stop + 1 to: sourcestring length).
assumes String arguments"
destString length = 0
ifTrue: [↑destString].
(replacement is: String) false
ifTrue: [↑false].
((stop 4096 or: [sourcestring length - stop 4096]) or: [(start + rstop - rstart 4096 or: [rstart > 4096])])
ifTrue: [↑false].
((start < 1 or: [stop > sourcestring length]) or: [(rstart < 1 or: [rstop > replacement length])])
ifTrue: [user notify: 'illegal subscript']
ifFalse:
[destRaster ← destY ← sourceRaster ← sourceY ← 0.
self effect: 0.
self screen: black.
height ← 1.
dest ← destString lock.
source ← slock ← sourcestring lock.
width ← start - 1 * 8.
width = 0
ifFalse:
[sourceX ← destX ← 0.
self callBLT].
destX ← width.
width ← 1 + rstop - rstart * 8.
width = 0
ifFalse:
[sourceX ← rstart - 1 * 8.
source ← replacement lock.
self callBLT.
replacement unlock].
destX ← destX + width.
width ← sourcestring length - stop * 8.
width = 0
ifFalse:
[source ← slock.
sourceX ← stop * 8.
self callBLT].
destString 1 ← destString 1.
sourcestring unlock.
destString unlock.
↑destString]].
"64" BitBlt$'Setup'
[fromDisplay | |
self sourceForm: DisplayForm].
"223" BitBlt$'Setup'
[toDisplay | |
NoteTaker
ifTrue:
[self destForm: DisplayForm.
source nil
ifTrue: [self sourceForm: DisplayForm]]
ifFalse:
[dest ← mem 54.
destRaster ← user screenrect width / 32 * 2]].
"197" BitBlt$'Access to Parts'
[effect: anInteger | |
NoteTaker
ifTrue: [effect ← #(35 39 38 36 44 45 41 33 51 55 54 52 19 23 22 20 ) ((anInteger land: 15) + 1)]
ifFalse: [effect ← anInteger]].
"56" BitBlt$'Access to Parts'
[height: t1 | |
height ← t1].
"139" BitBlt$'Access to Parts'
[screen: t1 | |
screen ← t1.
(screen is: Form)
ifTrue:
[screenForm ← screen.
screen ← screenForm bits]].
"56" BitBlt$'Access to Parts'
[source: t1 | |
source ← t1].
"102" BitBlt$'Access to Parts'
[window | |
↑clipX clipY rect: clipX + clipWidth (clipY + clipHeight)].
"52" BitBlt$'Access to Parts'
[dest: t1 | |
dest ← t1].
"265" BitBlt$'Operations'
[copyRect: rect toPoint: point effect: eff screen: halftone | |
self screen: halftone "careful -- assumes dest, destRaster, source and sourceRaster are set!!".
self effect: eff.
self destOrigin: point.
self sourceRect: rect.
self callBLT].
"1051" BitBlt$'Operations'
[stringCopy: destString from: start to: stop with: replacement from: rstart to: rstop | |
NoteTaker
ifTrue: [↑false].
"Copies equal subranges from one string to another. Works for BitBlt parameters up to 4096. maybe too much set up for short strings. Currently, called by String copy:to:with:from:to:"
width ← 1 + stop - start.
width = 0
ifTrue: [↑destString].
((start > 4096 or: [rstart > 4096]) or: [width 4096])
ifTrue: [↑false].
((width < 0 or: [width (1 + rstop - rstart)]) or: [((start < 1 or: [stop > destString length]) or: [(rstart < 1 or: [rstop > replacement length])])])
ifTrue: [user notify: 'illegal range or subscript']
ifFalse:
[destRaster ← destY ← sourceRaster ← sourceY ← 0.
self effect: 0.
self screen: black.
height ← 1.
width ← width * 8.
dest ← destString lock.
destX ← start - 1 * 8.
source ← replacement lock.
sourceX ← rstart - 1 * 8.
self callBLT.
replacement unlock "mark dirty".
destString 1 ← destString 1.
destString unlock.
↑destString]].
"83" BitBlt$'Setup'
[classInit | |
pageOneCursor ← 281 "location of hardware cursor"].
"75" BitBlt$'Setup'
[extent: extent | |
width ← extent x.
height ← extent y].
"1010" BitBlt$'Operations'
[bltObj: t1 field: t2 to: last fromObj: t4 field: t5 | |
"Dangerous non-refct copy specific to method literals."
destForm ← t1.
destY ← t2.
sourceForm ← t4.
sourceY ← t5.
destY < 1
ifTrue: [user notify: 'bltObj field spec is 1-origin, like vectors']
ifFalse:
[sourceX ← destX ← clipX ← 0.
width ← clipWidth ← 16.
height ← clipHeight ← last - destY + 1.
clipY ← destY ← destY - 1.
sourceY ← sourceY - 1 "the bits are 0-origin".
sourceForm nil
ifTrue:
[screen ← (NoteTaker
ifTrue: [0]
ifFalse: [1]).
self effect: 12]
ifFalse:
[screen ← 0.
self effect: 0].
sourceRaster ← destRaster ← 1.
NoteTaker
ifTrue:
[source ← sourceForm.
dest ← destForm "word fields".
self callBLT]
ifFalse:
[dest ← destForm nail.
sourceForm nil
ifTrue: [source ← dest]
ifFalse: [source ← sourceForm nail].
self callBLT.
dest ← destForm unNail.
sourceForm nil
ifFalse: [source ← sourceForm unNail]]]].
"119" BitBlt$'Access to Parts'
[destRaster: t1 | |
"length of a 'scanline' destination in 16-bit words"
destRaster ← t1].
"347" Rectangle$'Conversion'
[bitsFromString: str mode: mode | t3 |
NoteTaker
ifTrue:
[(t3 ← BitBlt new toDisplay) effect: mode.
t3 sourceForm: (Form new extent: corner - origin bits: str offset: nil).
t3 destOrigin: origin.
t3 sourceRect: (0 0 rect: corner - origin).
t3 callBLT]
ifFalse: [self ALTObitsFromString: str mode: mode]].
"338" Rectangle$'Conversion'
[bitsIntoString: str mode: mode | t3 |
NoteTaker
ifTrue:
[(t3 ← BitBlt new fromDisplay) effect: mode.
t3 destForm: (Form new extent: corner - origin bits: str offset: nil).
t3 destOrigin: 0 0.
t3 sourceRect: (origin rect: corner).
t3 callBLT]
ifFalse: [self ALTObitsIntoString: str mode: mode]].
"73" Rectangle$'Altering'
[translateto: pt | |
self translate: pt - origin].
"1160" Rectangle$'Image'
[blowup: at by: scale spacing: spacing | extent z inc sinc slice width height dest i j spread |
extent ← self extent.
scale ← scale asPoint.
spacing ← spacing asPoint.
dest ← Rectangle new origin: at extent: extent * scale.
z ← 1 0.
width ← extent x.
height ← 0 extent y.
spread ← (scale - spacing) x.
(1 to: 2) do:
[:i | "first do horiz, then vert"
inc ← z * 1.
sinc ← z * scale.
slice ← Rectangle new origin: z * width + (i = 1
ifTrue: [self origin]
ifFalse: [at]) extent: z + height.
dest ← at + (z * (scale * width)).
(1 to: width) do:
[:j | "slice it up"
dest ← dest - sinc.
slice moveby: inc.
slice blt: dest mode: storing].
slice ← Rectangle new origin: at + z extent: height + (z * (scale - 1)).
(1 to: width) do:
[:j | "clear slice source"
slice clear: white.
slice moveby: sinc].
slice ← Rectangle new origin: at extent: height + (z * (scale * width - 1)).
(1 to: spread - 1) do: [:j | "spread it out"
slice blt: at + z mode: oring].
z ← 0 1 "flip to do vertical".
width ← extent y.
height ← (scale * extent) x 0.
spread ← (scale - spacing) y]].
"1136" Rectangle$'Conversion'
[bitsFromString: bitmap mode: mode clippedBy: clipRect | destRect t5 t6 |
NoteTaker
ifTrue:
[ "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]
ifFalse:
[self bitmapLength bitmap length
ifTrue: [user notify: 'wrong bitmap length']
ifFalse:
[destRect ← self intersect: user screenrect.
nil clipRect
ifFalse: [destRect ← destRect intersect: clipRect].
(t6 ← BitBlt init) dest: mem 54.
t6 destRaster← user screenrect width / 16 | 2.
t6 destOrigin: destRect origin.
t6 sourceRaster: corner x - origin x + 15 / 16.
t6 sourceRect: (destRect origin - origin rect: destRect origin - origin + destRect extent).
t6 source: bitmap lock.
t6 effect: 16 + (mode land: 3) "dest in bank 1, source in bank 0".
t6 callBLT.
bitmap unlock]]].
"1181" Rectangle$'Conversion'
[bitsIntoString: bitmap mode: mode clippedBy: clipRect | sourceRect t5 t6 |
NoteTaker
ifTrue:
[ "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]
ifFalse:
[self bitmapLength bitmap length
ifTrue: [user notify: 'wrong bitmap length']
ifFalse:
[sourceRect ← self intersect: user screenrect.
clipRect nil
ifFalse: [sourceRect ← sourceRect intersect: clipRect].
(t6 ← BitBlt init) destRaster: corner x - origin x + 15 / 16.
t6 destOrigin: sourceRect origin - origin.
t6 sourceRect: (sourceRect origin - origin rect: sourceRect origin - origin + sourceRect extent).
t6 source: mem 54.
t6 sourceRaster: user screenrect width / 16 | 2.
t6 dest: bitmap lock.
t6 effect: 32 + (mode land: 3) "dest in bank 0, source in bank 1".
t6 callBLT.
bitmap unlock]]].
"1020" Rectangle$'Image'
[blt: dest mode: mode clippedBy: clipRect | destRect clippedSource t6 t7 |
NoteTaker
ifTrue:
[ "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"
(t6 ← DisplayBLTer copy) window: clipRect.
t6 copyRect: self toPoint: dest effect: (mode land: 3) screen: 0]
ifFalse:
[destRect ← (Rectangle new origin: dest extent: self extent) intersect: user screenrect.
nil clipRect
ifFalse: [destRect ← destRect intersect: clipRect] "find the source for the bits after clipping".
clippedSource ← origin + destRect origin - dest.
(t7 ← BitBlt init toDisplay) destOrigin: destRect origin.
t7 source: mem 54.
t7 sourceRaster: user screenrect width / 16 | 2.
t7 sourceRect: (clippedSource rect: clippedSource + destRect extent).
t7 effect: 48 + (mode land: 3) "source and dest in bank 1 (display)".
t7 callBLT]].
"1110" Rectangle$'Image'
[brush: dest mode: mode color: color clippedBy: clipRect | destRect clippedSource t7 t8 |
NoteTaker
ifTrue:
[ "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"
(t7 ← DisplayBLTer copy) window: clipRect.
t7 copyRect: self toPoint: dest effect: 8 + (mode land: 3) screen: color]
ifFalse:
[destRect ← (Rectangle new origin: dest extent: self extent) intersect: user screenrect.
nil clipRect
ifFalse: [destRect ← destRect intersect: clipRect] "find the source for the bits after clipping".
clippedSource ← origin + destRect origin - dest.
(t8 ← BitBlt init) screen: color.
t8 dest: mem 54.
t8 destRaster: user screenrect width / 16 | 2.
t8 destOrigin: destRect origin.
t8 source: mem 54.
t8 sourceRaster: user screenrect width / 16 | 2.
t8 sourceRect: (clippedSource rect: clippedSource + destRect extent).
t8 effect: 8 + (mode land: 3) + 48 "paint on display".
t8 callBLT]].
"47" Rectangle$'Aspects'
[leftside | |
↑origin x].
"42" Rectangle$'Aspects'
[top | |
↑origin y].
"54" Turtle$'As yet unclassified'
[pen: t1 | |
pen ← t1].
"58" Turtle$'As yet unclassified'
[width: w | |
self pen: w].
"66" Turtle$'As yet unclassified'
[home | |
location ← frame center].
"69" Turtle$'As yet unclassified'
[color: color | |
self screen: color].
"61" Turtle$'As yet unclassified'
[place: t1 | |
location ← t1].
"807" Turtle$'As yet unclassified'
[drawLoopX: xDelta Y: yDelta | dx dy px py P i |<primitive: 77>
"This is the Bresenham plotting algorithm (IBM Systems Journal Vol 4 No. 1, 1965).
It chooses a principal direction, and maintains a potential, P.
When P's sign changes, it is time to move in the minor direction as well."
dx ← xDelta sign.
dy ← yDelta sign.
px ← yDelta abs.
py ← xDelta abs.
super callBLT "first point".
py > px
ifTrue:
[ "more horizontal"
P ← py / 2.
(1 to: py) do:
[:i | destX ← destX + dx.
(P ← P - px) < 0
ifTrue:
[destY ← destY + dy.
P ← P + py].
super callBLT]]
ifFalse:
[ "more vertical"
P ← px / 2.
(1 to: px) do:
[:i | destY ← destY + dy.
(P ← P - py) < 0
ifTrue:
[destX ← destX + dx.
P ← P + px].
super callBLT]]].
"62" Turtle$'As yet unclassified'
[black | |
self screen: black].
"50" Turtle$'As yet unclassified'
[width | |
↑width].
"69" Turtle$'As yet unclassified'
[erase | |
super window clear: white].
"107" Turtle$'As yet unclassified'
[go: dist | |
self goto: direction asRadians asDirection * dist + location].
"58" Turtle$'As yet unclassified'
[up | |
direction ← 270.0].
"58" Turtle$'As yet unclassified'
[pendn | |
penDown ← true].
"59" Turtle$'As yet unclassified'
[penup | |
penDown ← false].
"134" Turtle$'As yet unclassified'
[goto: p | old |
old ← location.
location ← p.
penDown
ifTrue: [self drawfrom: old to: location]].
"83" Turtle$'As yet unclassified'
[turn: degrees | |
direction ← direction + degrees].
"60" Turtle$'As yet unclassified'
[inking: t1 | |
inking ← t1].
"58" Turtle$'As yet unclassified'
[frame: t1 | |
frame ← t1].
"357" Turtle$'As yet unclassified'
[init | |
source ← sourceRaster ← (NoteTaker
ifFalse: [0]).
super init.
super toDisplay.
frame ← user screenrect.
self pendn.
self color: black.
self width: 1.
self inking: storing.
self home.
self up " | n i [n←Turtle init. n color: gray; width: 4; inking: oring.
for i to: 50 do [n go: i*4; turn: 89]]"].
"50" Turtle$'As yet unclassified'
[frame | |
↑frame].
"62" Turtle$'As yet unclassified'
[white | |
self screen: white].
"648" Turtle$'As yet unclassified'
[drawfrom: p1 to: p2 | offset delta dx dy px py P i |
(pen is: Integer)
ifTrue:
[self effect: 16 + 12 + (inking land: 3).
width ← height ← pen.
offset ← pen / 2 (pen / 2)]
ifFalse:
[(pen is: Form)
ifTrue:
[self effect: 16 + (inking land: 3).
super sourceForm: pen.
width ← pen width.
height ← pen height.
offset ← pen offset]
ifFalse: [user notify: 'pen must be a Form or Integer']].
destX ← (p1 x - offset x) asInteger.
destY ← (p1 y - offset y) asInteger.
self drawLoopX: (p2 x - p1 x) asInteger Y: (p2 y - p1 y) asInteger.
(pen is: Form)
ifTrue: [super release: pen]].
"860" Rectangle$'Image'
[fillin: color mode: mode | T bits p s dirs i which |
"Rectangle new fromuser fillin: gray"
T ← Turtle init.
p ← origin + (self width 0).
s ← Rectangle new origin: p extent: self extent.
dirs ← {1 0 , (1 0) , (0 1) , (0 1)}.
bits ← s bitsIntoString.
self blt: p mode: storing "s ← self".
user waitbug.
T place: user mp.
T pendn.
[user anybug] whileTrueDo: [ "draw seed in self"
T goto: user mp].
self blt: p mode: xoring "s ← seed only".
s blt: origin mode: xoring "take seed out of self".
user waitbug.
[user anybug] whileTrueDo: [(0 to: 2 by: 2) do:
[:which | (1 to: 2) "smear seed around" do: [:i | s blt: dirs (which + i) + p mode: oring].
self blt: p mode: erasing]].
s brush: origin mode: mode color: color "then clip to outline" "paint it in".
s bitsFromString: bits "restore background to s"].
"113" InspectWindow$'Initialization'
[classInit | |
stdTemplates ← {(0 0 rect: 12 36) , (12 0 rect: 36 36)}].
"152" VariablePane$'Notify/Inspect protocol'
[execute: parseStream for: t2 | |
valuePane ← t2.
↑valuePane execute: parseStream in: context to: values 1].
"182" VariablePane$'Window protocol'
[yellowbug | |
selection = 0
ifTrue: [window flash]
ifFalse: [scrollBar hidewhile [
(varmenu bug = 1
ifTrue: [self value inspect])]]].
"85" VariablePane$'Initialization'
[classInit | |
varmenu ← Menu new string: 'inspect'].
"118" VariablePane$'Private'
[value | |
selection = 1
ifTrue: [↑values 1].
↑values 2 inspectfield: selection - 1].
"112" VariablePane$'Initialization'
[names: vars values: t2 wrt: t3 | |
values ← t2.
context ← t3.
self of: vars].
"60" VariablePane$'Initialization'
[to: t1 | |
valuePane ← t1].
"89" VariablePane$'ListPane protocol'
[selected | |
valuePane showing: self value asString].
"84" VariablePane$'Notify/Inspect protocol'
[compile: parag | |
window flash.
↑false].
"74" VariablePane$'ListPane protocol'
[deselected | |
valuePane showing: ''].
"987" ListPane$'Private'
[scrollUp: amount | linetomove |
self compselection.
amount ← amount | style lineheight.
linetomove ← (self lineofy: window minY + amount "abs") max: 1.
amount > 0
ifTrue:
[lastline = lastShown
ifFalse:
[self locked
ifTrue:
[selection + 1 = firstShown
ifTrue: [window flash]
ifFalse: [self firstShown: (linetomove min: selection + 1)]]
ifFalse: [self firstShown: (linetomove min: lastline - (window height / style lineheight) + 1)]]]
ifFalse:
[firstShown = 1
ifFalse:
[self locked
ifTrue:
[selection + 1 = lastShown
ifTrue: [window flash]
ifFalse: [self lastShown: (lastShown - (firstShown - linetomove) max: selection + 1)]]
ifFalse:
[.
self lastShown: (lastShown - (firstShown - linetomove) max: (lastline min: window height / style lineheight))]]].
(window origin x ((self yofline: lastline) + style lineheight) rect: window corner) clear: white.
↑self select: selection].
"658" ListPane$'Private'
[fill | |
firstShown nil
ifTrue: [self makeParagraph]
ifFalse: [lastShown ← self lineofy: window maxY - (style lineheight - 1)].
(self locked or: [selection > 0])
ifTrue:
[selection < firstShown
ifTrue: [frame origin y← window minY - (selection * style lineheight) + style lineheight]
ifFalse:
[selection > lastShown
ifTrue: [frame origin y← window minY - (selection * style lineheight + style lineheight) + (window maxY - window minY | style lineheight) min: window minY]]].
firstShown ← self lineofy: window minY + (style lineheight - 1).
lastShown ← self lineofy: window maxY - (style lineheight - 1)].
"116" ListPane$'Subclass defaults'
[deselected | |
"I just lost my selection. I dont care, but my subclasses might."].
"56" ListPane$'Pane protocol'
[yellowbug | |
window flash].
"223" ListPane$'Initialization'
[of: t1 | |
"Acquire the specified list and show me scrolled to the top"
list ← t1.
selection ← 0.
self makeParagraph.
self frame← window.
self outline.
self displayall.
self deselected].
"58" ListPane$'Private'
[init | |
self para: nil frame: nil].
"119" ListPane$'Subclass defaults'
[selected | |
"A new selection is highlighted. I dont care, but my subclasses might"].
"261" ListPane$'Pane protocol'
[frame← t1 | |
"(Re)initialize my window"
window ← t1.
(frame ← window inset: 2 0 and: [0 0]) width← 999.
self fill.
scrollBar ← (scrollBar nil
ifTrue: [ScrollBar new]
ifFalse: [scrollBar]) on: window from: self].
"61" ListPane$'Pane protocol'
[kbd | |
window flash.
user kbd].
"361" ListPane$'Pane protocol'
[eachtime | |
(window has: user mp)
ifTrue:
[user kbck
ifTrue: [↑self kbd].
user anybug
ifTrue:
[user redbug
ifTrue: [↑self redbug].
user yellowbug
ifTrue: [↑self yellowbug].
user bluebug
ifTrue: [↑false]]
ifFalse:
[user anykeys
ifTrue: [↑self keyset]]]
ifFalse: [↑self outside]].
"882" ListPane$'Pane protocol'
[hardcopy: pf | t cr first last lasty lineNum parag left right lineheight |
window hardcopy: pf thickness: 1.
para nil
ifTrue: [self makeParagraph].
parag ← para asParagraph.
t ← para asStream.
last ← 0.
cr ← 13.
left ← frame minX.
right ← window maxX.
lasty ← frame minY.
lineheight ← self lineheight.
(firstShown to: lastShown) do:
[:lineNum | first ← last.
((t skipTo: cr) or: [lineNum = lastShown])
ifTrue: [last ← t position]
ifFalse: [user notify: 'not enough lines'].
(lineNum = selection and: [selection > 0])
ifTrue: [(self selectionRect "outline selection; complementing doesn't look good" - (0 1) inset: 0 1) hardcopy: pf thickness: 1].
(parag copy: first + 1 to: last - 1) presson: pf in: (pf transrect: (left lasty rect: right (lasty + lineheight + 4))) style: style.
lasty ← lasty + lineheight]].
"453" ListPane$'Pane protocol'
[keyset | c t2 |
c ← user currentCursor "As long as any keyset keys are down, react to keys 2 and 8 down by scrolling up or down a line at a time. If key 4 is down as well, scroll faster.".
self scrollControl [
((t2 ← user keyset) = 6
ifTrue: [2]
ifFalse:
[t2 = 12
ifTrue: [2]
ifFalse:
[t2 = 2
ifTrue: [1]
ifFalse:
[t2 = 8
ifTrue: [1]
ifFalse: [0]]]])].
c show].
"53" ListPane$'Pane protocol'
[lasttime | |
self leave].
"54" ListPane$'Pane protocol'
[leave | |
scrollBar hide].
"61" ListPane$'Pane protocol'
[picked | |
↑window has: user mp].
"444" ListPane$'Pane protocol'
[redbug | newSel f |
"Deselect selection and select cursor item, if any"
(f ← self locked)
ifFalse:
[self compselection.
newSel ← ((self lineofy: user mp y) max: 1) - 1.
XeqCursor showwhile [(self select: (newSel = selection
ifTrue: [0]
ifFalse: [newSel]))]].
[user redbug and: [(window has: user mp)]] whileTrueDo:
[f
ifTrue:
[f flash.
self compselection.
self compselection]]].
"164" ListPane$'Subclass defaults'
[locked | |
"My subclasses may want to prohibit a change of selection"
↑selection = 0
ifTrue: [false]
ifFalse: [self dirty]].
"82" ListPane$'Private'
[displayall | |
self displaylines: firstShown to: lastShown].
"54" ListPane$'Pane protocol'
[enter | |
scrollBar show].
"111" ListPane$'Subclass defaults'
[dirty | |
"My subclasses may want to prohibit a change of selection"
↑false].
"44" ListPane$'Private'
[dummy | |
↑''].
"496" ListPane$'Initialization'
[revise: newlist with: sel | changing |
"Acquire newlist. Do not change firstShown. Select sel if in list."
(changing ← list newlist)
ifTrue:
[list ← newlist.
window clear: white.
self makeParagraph.
self fill.
self displayall]
ifFalse:
[selection > 0
ifTrue:
[(changing ← list selection sel)
ifTrue: [self compselection]]
ifFalse: [changing ← true]].
changing
ifTrue:
[selection ← 1.
self select: (list find: sel)]].
"581" ListPane$'Initialization'
[select: lineNum | oldSel |
oldSel ← selection "Select my non-dummy displayed entry whose subscript is lineNum; highlight it; if it is different from selection, tell me to select. If there is no such entry, set selection to 0 and if it wasnt 0 before, tell me to deselect.".
((1 max: firstShown - 1) lineNum and: [lineNum (list length min: lastShown - 1)])
ifTrue:
[selection ← lineNum.
self compselection.
oldSel selection
ifTrue: [self selected]]
ifFalse:
[selection ← 0.
oldSel selection
ifTrue: [self deselected]]].
"60" ListPane$'Pane protocol'
[outside | |
↑scrollBar startup].
"143" ListPane$'Pane protocol'
[close | |
"Zero my selection so it wont be grayed when I close. Break cycles."
selection ← 0.
scrollBar close].
"110" ListPane$'Pane protocol'
[firsttime | |
(window has: user mp)
ifTrue: [self enter]
ifFalse: [↑false]].
"163" ListPane$'Pane protocol'
[scrollPos | |
((firstShown nil or: [list nil]) or: [list length = 0])
ifTrue: [↑0.0].
↑(firstShown - 1) asFloat / list length].
"140" ListPane$'Pane protocol'
[windowenter | |
"Refresh my image. Reaffirm selection."
self outline.
self displayall.
self compselection].
"85" ListPane$'Pane protocol'
[windowleave | |
self compselection.
self grayselection].
"141" ListPane$'Private'
[compselection | |
"If I have a selection, complement its image."
selection 0
ifTrue: [self selectionRect comp]].
"258" ListPane$'Private'
[selectionRect | newy |
↑(Rectangle new "I have a selection. Return its highlighting rectangle." origin: frame minX (newy ← selection * style lineheight + frame minY) corner: frame maxX (newy + style lineheight)) intersect: window].
"371" ListPane$'Private'
[firstShown: new | delta deltaPt |
delta ← new - firstShown.
deltaPt ← 0 (0 - delta * style lineheight) "negative".
firstShown ← new.
lastShown ← lastShown + delta.
frame moveby: deltaPt.
(window origin - deltaPt rect: window corner) blt: window origin mode: storing.
self displaylines: (firstShown max: lastShown - delta + 1) to: lastShown].
"130" ListPane$'Pane protocol'
[scrollTo: f | place y |
↑self scrollUp: (f * lastline) asInteger - firstShown + 1 * style lineheight].
"113" ListPane$'Private'
[grayselection | |
selection 0
ifTrue: [self selectionRect color: ltgray mode: oring]].
"454" ListPane$'Private'
[lastShown: new | delta deltaPt |
delta ← new - lastShown "negative".
deltaPt ← 0 (0 - delta * style lineheight) "positive".
lastShown ← new.
firstShown ← firstShown + delta.
frame moveby: deltaPt.
(Rectangle new origin: window origin extent: window width (window height - deltaPt y | style lineheight)) blt: window origin + deltaPt mode: storing.
self displaylines: firstShown to: (firstShown - delta - 1 min: lastShown)].
"59" ListPane$'Pane protocol'
[outline | |
window outline: 1].
"565" ListPane$'Private'
[makeParagraph | i len s |
"Given firstShown, compute lastShown."
firstShown nil
ifTrue:
[firstShown ← 1.
selection ← 0].
s ← (String new: 200) asStream.
s append: self dummy.
s cr.
list nil
ifFalse: [(1 to: list length) do:
[:i | list i printon: s.
s cr]].
s append: self dummy.
s cr.
para ← s contents asParagraph.
self measureall.
lastShown ← self lineofy: window maxY - (style lineheight - 1).
frame corner y← (self yofline: lastline) + style lineheight.
selection > lastShown
ifTrue: [selection ← 0]].
"501" InspectWindow$'Initialization'
[of: object | instanceVarPane instanceValuePane safeVec n |
instanceVarPane ← VariablePane new.
instanceValuePane ← CodePane new.
self title: object class title with: {instanceVarPane , instanceValuePane} at: stdTemplates.
self newframe.
self show.
instanceVarPane to: instanceValuePane.
instanceValuePane from: instanceVarPane.
safeVec ← Vector new: 2.
safeVec all← object.
instanceVarPane names: (#(self ) concat: object fields) values: safeVec wrt: false].
"83" InspectWindow$'Private'
[contents | |
"called by of: via Class fieldNamesInto"].
"85" InspectWindow$'Private'
[comment: s | |
"called by of: via Class fieldNamesInto"].
"85" InspectWindow$'Private'
[trailer: s | |
"called by of: via Class fieldNamesInto"].
"107" InspectWindow$'Private'
[identifier: s | |
"called by of: via Class fieldNamesInto"
variables next← s].
"87" InspectWindow$'Private'
[separator: c | |
"called by of: via Class fieldNamesInto"].
"178" Object$'Aspects'
[inspect | |
NoteTaker
ifTrue: [user schedule: (InspectWindow new of: self)]
ifFalse:
[user leaveTop.
user restartup: (InspectWindow new of: self)]].
"48" Object$'Classification'
[isNumber | |
↑false].
"156" Object$'System Primitives'
[startup | |
"loopless scheduling"
self firsttime
ifTrue:
[[self eachtime] whileTrueDo: [].
↑self lasttime].
↑false].
"58" Object$'Comparison'
[sameAs: object | |
↑self object].
"136" Object$'Construction'
[inVector | vec |
vec ← Vector new: 1 "Return me as the sole element of a new Vector.".
vec 1 ← self.
↑vec].
"50" Object$'Compiler Defaults'
[returns | |
↑false].
"111" Object$'Printing'
[asString | strm |
strm ← (String new: 16) asStream.
self printon: strm.
↑strm contents].
"150" Object$'System Primitives'
[swap variable | x |
"assign me to variable and return its old value"
x ← variable value.
variable value← self.
↑x].
"146" Object$'System Primitives'
[perform: message | |
"Send an arbitrary message to self"
message mustTake: 0.
↑self performDangerously: message].
"67" Object$'System Primitives'
[refct | |<primitive: 34>
user croak].
"50" Object$'Compiler Defaults'
[isField | |
↑false].
"62" Object$'Classification'
[Isnt: x | |
↑(self Is: x) false].
"51" Object$'Comparison'
[empty | |
↑self length = 0].
"121" Object$'System Primitives'
[doesNotUnderstand: message | |
user notify: 'Message not understood: ' + message selector].
"77" Object$'System Primitives'
[execute: method | |<primitive: 78>
user croak].
"99" Object$'System Primitives'
[execute: method with: arg1 with: arg2 | |<primitive: 78>
user croak].
"388" Object$'System Primitives'
[execute: method withArgs: vec | t3 |
(t3 ← vec length) = 0
ifTrue: [↑self execute: method].
t3 = 1
ifTrue: [↑self execute: method with: vec 1].
t3 = 2
ifTrue: [↑self execute: method with: vec 1 with: vec 2].
t3 = 3
ifTrue: [↑self execute: method with: vec 1 with: vec 2 with: vec 3].
user notify: 'More than 3 args for execute:'].
"110" Object$'System Primitives'
[execute: method with: arg1 with: arg2 with: arg3 | |<primitive: 78>
user croak].
"52" Object$'As yet unclassified'
[comment: cccc | |
].
"117" Object$'As yet unclassified'
[Altonail | |<primitive: 75>
user croak "Nail me in core and return my core address"].
"69" Object$'Construction'
[asParagraph | |
↑self asString asParagraph].
"115" Object$'Printing'
[fullprint | strm |
strm ← Stream default.
self fullprinton: strm.
user show: strm contents].
"441" Object$'Aspects'
[instfields | field |
self class "Return an Array of all my field values or many of my elements." isVariable
ifTrue: [↑(1 ~ self class instsize transform [:field | field] to [(self instfield: field)]) concat: self (self length 50
ifTrue: [1 ~ self length]
ifFalse: [1 ~ 20 concat: (self length - 20 to: self length)])].
↑1 ~ self class instsize transform [:field | field] to [(self instfield: field)]].
"271" Object$'Aspects'
[inspectfield: n | fixedSize |
"used by variable panes"
self class isVariable
ifTrue:
[fixedSize ← self class instsize.
n > fixedSize
ifTrue: [↑self (self fields n - fixedSize)].
↑self instfield: n]
ifFalse: [↑self instfield: n]].
"62" Object$'Compiler Defaults'
[sizeForEffect: nextPush | |
↑0].
"70" Object$'Aspects'
[instfield: n ← val | |<primitive: 38>
user croak].
"184" Object$'System Primitives'
[perform: selector with: arg1 | |
"Send the 1-argument message, selector, to self"
selector mustTake: 1.
↑self performDangerously: selector with: arg1].
"88" Object$'Compiler Defaults'
[asRemoteCode: generator | |
↑ParsedRemote new expr: self].
"52" Object$'Compiler Defaults'
[emitsLoad | |
↑false].
"58" Object$'Compiler Defaults'
[emittedReceiver | |
↑false].
"58" Object$'Compiler Defaults'
[emittedVariable | |
↑false].
"54" Object$'Compiler Defaults'
[interactive | |
↑false].
"264" Object$'Printing'
[fullprinton: strm | |
self nil
ifTrue: [strm append: 'nil']
ifFalse:
[self false
ifTrue: [strm append: 'false']
ifFalse:
[self true
ifTrue: [strm append: 'true']
ifFalse: [self class print: self on: strm]]]].
"276" Object$'System Primitives'
[installError | code old |
code ← Object md method: #error.
old ← SpecialOops 1.
old asOop (mem 3)
ifTrue: [user notify: 'Object installError failed']
ifFalse: [Top critical [
(mem 3 ← code asOop.
SpecialOops 1 ← code)]]].
"119" Object$'Printing'
[asFullString | strm |
strm ← (String new: 20) asStream.
self fullprinton: strm.
↑strm contents].
"105" Object$'As yet unclassified'
[AltounNail | |<primitive: 75>
user croak "Release me from being nailed"].
"84" Object$'As yet unclassified'
[printon: strm indent: level | |
self printon: strm].
"84" Object$'Compiler Defaults'
[findMacros: macros compilerTemps: compilerTemps | |
].
"49" Object$'As yet unclassified'
[comment | |
↑''].
"86" Object$'Construction'
[, x | v |
v ← Vector new: 2.
v 1 ← self.
v 2 ← x.
↑v].
"42" Object$'Comparison'
[= x | |
↑self x].
"50" Object$'Comparison'
[ x | |
↑self > x false].
"167" Object$'Compiler Defaults'
[ code | |
↑(NoteTaker
ifTrue: [LADCompiler]
ifFalse: [Generator]) new evaluate: code asStream in: false to: self notifying: self].
"50" Object$'Comparison'
[ x | |
↑self < x false].
"50" Object$'Comparison'
[ x | |
↑self = x false].
"142" Object$'Classification'
[Is: x | |
"Is the class x a superclass or class of self"
self class x
ifTrue: [↑true].
↑self class Isa: x].
"95" Object$'Comparison'
[ x | |<primitive: 78>
↑self x "In case this is reached by perform:"].
"55" Object$'System Primitives'
[PTR | |<primitive: 39>
].
"54" Object$'Classification'
[is: x | |
↑self class x].
"114" Object$'System Primitives'
[unNail | |
NoteTaker
ifFalse: [↑self AltounNail] "Release me from being nailed"].
"150" Object$'System Primitives'
[performDangerously: selector | |<primitive: 36>
"Send self the message, selector; it had better be unary"
user croak].
"206" Object$'System Primitives'
[perform: selector with: arg1 with: arg2 | |
"Send the 2-argument message, selector, to self"
selector mustTake: 2.
↑self performDangerously: selector with: arg1 with: arg2].
"228" Object$'System Primitives'
[perform: selector with: arg1 with: arg2 with: arg3 | |
"Send the 3-argument message, selector, to self"
selector mustTake: 3.
↑self performDangerously: selector with: arg1 with: arg2 with: arg3].
"136" Object$'System Primitives'
[performDangerously: selector with: arg1 | |<primitive: 36>
"selector had better take 1 arg"
user croak].
"148" Object$'System Primitives'
[performDangerously: selector with: arg1 with: arg2 | |<primitive: 36>
"selector had better take 2 args"
user croak].
"66" Object$'Compiler Defaults'
[emitForEffect: code on: stack | |
].
"222" Object$'Compiler Defaults'
[emitForTruth: trueSkip falsity: falseSkip into: code on: stack | |
self emitForValue: code on: stack.
trueSkip jmpSize + falseSkip emitBfp: code on: stack.
trueSkip emitJmp: code on: stack].
"476" StackPane$'Private'
[spawn | mclass selector parag oldparag |
mclass ← (list (selection max: 1)) mclass.
selector ← self selector.
parag ← (codePane
ifTrue: [codePane contents]
ifFalse:
[(mclass canunderstand: selector)
ifTrue: [mclass code: selector]
ifFalse: ['']]).
oldparag ← (codePane
ifTrue: [codePane oldContents]
ifFalse: [false]).
self compselection.
self select: 0.
mclass edit: selector para: parag formerly: oldparag].
"86" StackPane$'Private'
[terminate | |
"called by parser close during initialization"].
"70" StackPane$'Initialization'
[interrupt: flag | |
proceed 1 ← flag].
"966" StackPane$'Private'
[continue: restarting | ctxt |
"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 vanish.
list ← nil.
NoteTaker
ifTrue:
[thisContext sender release.
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].
"102" StackPane$'ListPane protocol'
[locked | |
↑contextVarPane and: [(selection > 0 and: [self dirty])]].
"84" StackPane$'Private'
[contents | |
"called by selected via Class fieldNamesInto"].
"98" StackPane$'Private'
[declaration: dummy1 name: string asArg: dummy2 | |
variables next← string].
"86" StackPane$'Private'
[notify: msg | |
"selected context doesnt know its variables"].
"86" StackPane$'Private'
[comment: s | |
"called by selected via Class fieldNamesInto"].
"86" StackPane$'Private'
[trailer: s | |
"called by selected via Class fieldNamesInto"].
"80" StackPane$'NotifyWindow protocol'
[dirty | |
↑codePane and: [codePane dirty]].
"246" StackPane$'ListPane protocol'
[deselected | |
contextVarPane false
ifFalse:
[codePane showing: ''.
contextVarPane names: (Vector new: 0) values: #(nil ) wrt: false.
instanceVarPane names: (Vector new: 0) values: #(nil ) wrt: false]].
"210" StackPane$'NotifyWindow protocol'
[execute: parseStream for: t2 | |
codePane ← t2.
↑proceed 2 ← codePane execute: parseStream in: (selection = 0
ifTrue: [false]
ifFalse: [list selection]) to: nil].
"104" StackPane$'Initialization'
[classInit | |
stackmenu ← Menu new string: 'stack
spawn
proceed
restart'].
"557" StackPane$'Window protocol'
[yellowbug | t1 |
scrollBar hidewhile [
((t1 ← stackmenu bug) = 1
ifTrue: [self revise: (list 1) "show a full backtrace" stack with: (selection = 0
ifFalse: [list selection])]
ifFalse:
[t1 = 2
ifTrue: [self spawn "spawn a code editor"]
ifFalse:
[t1 = 3
ifTrue: [self continue: false "return to selected context"]
ifFalse:
[t1 = 4
ifTrue:
[NoteTaker
ifTrue: [ "restart selected context"
frame flash]
ifFalse: [self continue: true]]]]])]].
"178" StackPane$'Window protocol'
[close | |
NoteTaker
ifTrue: [super close]
ifFalse:
[Top enable: proceed 3.
super close.
list
ifTrue: [(list 1) releaseFully]]].
"210" StackPane$'Private'
[code | mclass selector |
"code of my selected context"
mclass ← (list selection) mclass.
selector ← self selector.
↑(mclass canunderstand: selector) and: [(mclass code: selector)]].
"155" StackPane$'Private'
[selector | context |
context ← list (selection max: 1).
↑context sender nil
ifTrue: [false]
ifFalse: [context selector]].
"239" StackPane$'Initialization'
[context: t1 at: level instance: t3 code: t4 | |
contextVarPane ← t1.
instanceVarPane ← t3.
codePane ← t4.
variables ← (Vector new: 16) asStream.
proceed nil
ifTrue: [proceed ← {false , nil , level}]].
"308" StackPane$'Initialization'
[context: t1 instance: t2 code: t3 | |
contextVarPane ← t1.
instanceVarPane ← t2.
codePane ← t3.
variables ← (Vector new: 16) asStream.
proceed nil
ifTrue: [proceed ← (NoteTaker
ifTrue: [{false , nil , nil}]
ifFalse: [{false , nil , Top currentPriority}])]].
"219" StackPane$'Private'
[releaseAboveSelection | |
selection > 1
ifTrue:
[list (selection - 1) sender← nil.
(list 1) release "Fully"].
NoteTaker
ifFalse: [ "??"
(list (selection max: 1)) verifyFrames]].
"514" StackPane$'NotifyWindow protocol'
[compile: parseStream | ctxt selector method mcl |
ctxt ← list (selection max: 1).
mcl ← ctxt mclass.
proceed 2 ← selector ← codePane compile: parseStream in: mcl under: 'As yet unclassified'
ifTrue:
[(codePane reflects: selection)
ifTrue:
[(method ← mcl md methodorfalse: selector)
ifTrue:
[self releaseAboveSelection.
ctxt restartWith: method.
proceed 1 ← true.
self of: list (selection to: list length) copy.
self select: 1]]]].
"997" StackPane$'ListPane protocol'
[selected | context instance code safeVec |
contextVarPane false
ifFalse:
[context ← list selection.
instance ← context receiver.
NoteTaker
ifFalse: [Decompiler new findPC: context pc].
code ← self code.
codePane showing: (code
ifTrue: [code]
ifFalse: ['']).
NoteTaker
ifFalse: [codePane selectRange: Decompiler new highlight].
variables reset.
context variableNamesInto: self with: nil.
code
ifTrue:
[contextVarPane names: (#(thisContext ) concat: variables contents) values: {context , context tempframe} wrt: context.
context tempframe nil
ifTrue: [user notify: 'NIL TEMPFRAME']]
ifFalse: [contextVarPane names: #(thisContext ) values: context inVector wrt: context].
variables reset.
instance class fieldNamesInto: self.
safeVec ← Vector new: 2.
safeVec all← instance.
instanceVarPane names: (#(self ) concat: variables contents) values: safeVec wrt: context.
contextVarPane select: 1]].
"108" StackPane$'Private'
[identifier: s | |
"called by selected via Class fieldNamesInto"
variables next← s].
"88" StackPane$'Private'
[separator: c | |
"called by selected via Class fieldNamesInto"].
"534" NotifyWindow$'Initialization'
[of: titleString level: level interrupt: flag | stackPane |
NotifyFlag ← false.
stackPane ← StackPane new.
self title: titleString with: stackPane inVector at: smallTemplates.
smallFrame moveto: (level > 1
ifTrue: [300 50]
ifFalse: [user screenrect center - (smallFrame extent / 2)]).
self frame: (self fixframe: smallFrame).
self show.
stackPane context: false at: level instance: false code: false.
stackPane interrupt: flag.
stackPane of: (Top level) inVector.
NotifyFlag ← true].
"305" NotifyWindow$'Initialization'
[classInit | |
smallTemplates ← (0 0 rect: 36 36) inVector.
bigTemplates ← {(0 0 rect: 12 18) , (12 0 rect: 36 18) , (0 18 rect: 12 27) , (12 18 rect: 36 27) , (0 27 rect: 12 36) , (12 27 rect: 36 36)}.
smallFrame ← 204 366 rect: 404 402].
"149" NotifyWindow$'Window protocol'
[close | |
super close.
NoteTaker
ifTrue:
[self erase.
user unschedule: self.
thisContext systemRestart]].
"155" NotifyWindow$'Window protocol'
[enter | |
enoughpanes
ifTrue: [super enter]
ifFalse: [self of: title stackPane: panes 1 codePane: CodePane new]].
"988" NotifyWindow$'As yet unclassified'
[of: t1 stackPane: stackPane codePane: codePane | contextVarPane contextValuePane instanceVarPane instanceValuePane |
title ← t1.
NotifyFlag ← false "Create the remaining four panes.".
contextVarPane ← VariablePane new.
contextValuePane ← CodePane new.
instanceVarPane ← VariablePane new.
instanceValuePane ← CodePane new "Create the six-paned window.".
self title: title with: {stackPane , codePane , contextVarPane , contextValuePane , instanceVarPane , instanceValuePane} at: bigTemplates.
self frame: frame.
self show "Initialize the six panes.".
stackPane context: contextVarPane instance: instanceVarPane code: codePane.
codePane from: stackPane.
contextVarPane to: contextValuePane.
contextValuePane from: contextVarPane.
instanceVarPane to: instanceValuePane.
instanceValuePane from: instanceVarPane.
stackPane select: 0.
stackPane makeParagraph.
stackPane displayall.
stackPane deselected.
enoughpanes ← NotifyFlag ← true].
"104" NotifyWindow$'Window protocol'
[aboutToFrame | |
enoughpanes ← panes length = 6.
super aboutToFrame].
"548" NotifyWindow$'Initialization'
[of: titleString stack: stack interrupt: flag | stackPane |
NotifyFlag ← false.
stackPane ← StackPane new.
self title: titleString with: stackPane inVector at: smallTemplates.
smallFrame moveto: ((NoteTaker or: [Top currentPriority 1])
ifTrue: [user screenrect center - (smallFrame extent / 2)]
ifFalse: [300 50]).
self frame: (self fixframe: smallFrame).
self show.
stackPane context: false instance: false code: false.
stackPane interrupt: flag.
stackPane of: stack inVector.
NotifyFlag ← true].
"225" SyntaxWindow$'As yet unclassified'
[aboutToFrame | nw t s c |
t ← title.
s ← panes 1.
c ← panes 2.
user unschedule: self.
nw ← NotifyWindow new frame: frame.
nw of: t stackPane: s codePane: c.
user restartup: nw].
"150" SyntaxWindow$'Initialization'
[classInit | |
stdTemplates ← {(0 0 rect: 12 36) , (12 0 rect: 36 36)}.
stdFrame ← 60 320 rect: 570 500].
"609" SyntaxWindow$'Initialization'
[of: errorString at: position in: stream for: class from: context | stackPane codePane |
stackPane ← StackPane new.
codePane ← CodePane new class: class selector: nil para: nil.
self title: class title with: {stackPane , codePane} at: stdTemplates.
stdFrame moveto: user screenrect center - (stdFrame extent / 2).
self frame: (self fixframe: stdFrame).
self show.
stackPane context: false instance: false code: codePane.
stackPane of: context inVector.
codePane showing: stream asArray.
codePane from: stackPane.
codePane notify: errorString at: position in: stream].
"347" 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]].
"163" Object$'Compiler Defaults'
[sizeForTruth: trueSkip falsity: falseSkip | jump |
jump ← trueSkip jmpSize.
↑self sizeForValue + (jump + falseSkip) bfpSize + jump].
"138" Object$'Construction'
[recopy | |
"recursively copy whole structure"
(self is: Object)
ifTrue: [↑self].
↑self class recopy: self].
"148" Object$'System Primitives'
[perform: selector withArgs: vec | |
selector mustTake: vec length.
↑self performDangerously: selector withArgs: vec].
"453" Object$'System Primitives'
[performDangerously: selector withArgs: vec | t3 |
(t3 ← vec length) = 0
ifTrue: [↑self performDangerously: selector].
t3 = 1
ifTrue: [↑self performDangerously: selector with: vec 1].
t3 = 2
ifTrue: [↑self performDangerously: selector with: vec 1 with: vec 2].
t3 = 3
ifTrue: [↑self performDangerously: selector with: vec 1 with: vec 2 with: vec 3].
user notify: 'More than 3 args for perform:'].
"147" Object$'Printing'
[filout | file |
↑user displayoffwhile [
(file ← dp0 file: self title asFileName.
self fullprinton: file.
file close)]].
"305" Object$'Aspects'
[fields | |
self class "Return an Array of all my field names or many of my subscripts." isVariable
ifTrue: [↑self class instvars concat: (self length 50
ifTrue: [1 to: self length]
ifFalse: [(1 to: 20) concat: (self length - 20 to: self length)])].
↑self class instvars].
"33" Object$'Aspects'
[itself | |
].
"77" Object$'As yet unclassified'
[become: other | |<primitive: 35>
user croak].
"81" Object$'As yet unclassified'
[growTo: newLength | |<primitive: 33>
user croak].
"80" Object$'Aspects'
[subError | |
self error: 'message not defined by subclass'].
"87" Object$'System Primitives'
[execute: method with: arg | |<primitive: 78>
user croak].
"51" Object$'Compiler Defaults'
[sizeForValue | |
↑0].
"65" Object$'Compiler Defaults'
[emitForValue: code on: stack | |
].
"49" Object$'Compiler Defaults'
[firstPush | |
↑1].
"50" Object$'Aspects'
[error: s | |
↑user notify: s].
"369" FontSet$'Access'
[ n ← font | |
(n > (fonts length - 1) or: [n < 0])
ifTrue: [user notify: 'fontset offset < 0 or > 15 illegal']
ifFalse:
[names (n + 1) ← font name asUppercase.
fonts (n + 1) ← font.
ascent < font ascent
ifTrue: [ascent ← font ascent].
descent < font descent
ifTrue: [descent ← font descent].
height ← ascent + descent]].
"40" FontSet$'Access'
[ascent | |
↑ascent].
"118" FontSet$'Initialization'
[init | |
fonts ← Vector new: 16.
names ← Vector new: 16.
height ← ascent ← descent ← 0].
"48" Font$'Access to Parts'
[descent | |
↑descent].
"50" Font$'Access to Parts'
[maxascii | |
↑maxascii].
"50" Font$'Access to Parts'
[minascii | |
↑minascii].
"46" Font$'Access to Parts'
[ascent | |
↑ascent].
"46" Font$'Access to Parts'
[glyphs | |
↑glyphs].
"46" Font$'Access to Parts'
[raster | |
↑raster].
"46" Font$'Access to Parts'
[xtable | |
↑xtable].
"73" Font$'Access to Parts'
[height | |
↑ascent + descent "height of font"].
"42" Font$'Access to Parts'
[name | |
↑name].
"93" Font$'Access to Parts'
[widthof: glyph | |
↑xtable (glyph + 2) - (xtable (glyph + 1))].
"620" Font$'Initialization'
[fromStrike: t1 | strike i |
"Build instance from strike file."
name ← t1.
strike ← dp0 oldFile: name + '.strike.'.
strike nextword "skip header".
minascii ← strike nextword.
maxascii ← strike nextword.
maxwidth ← strike nextword.
length ← strike nextword.
ascent ← strike nextword.
descent ← strike nextword.
xoffset ← strike nextword "If (horrors!) we should ever kern.".
raster ← strike nextword.
glyphs ← (Bitmap new: raster * self height) fromStream: strike.
xtable ← (Vector new: maxascii + 3) all← 0.
(minascii + 1 to: maxascii + 3) do: [:i | xtable i ← strike nextword]].
"92" Font$'Access to Parts'
[charForm: ascii | |
"should return a Form copied out of glyphs"].
"50" Font$'Access to Parts'
[maxwidth | |
↑maxwidth].
"94" Font$'Access to Parts'
[spacewidth | w |
w ← self widthof: 32.
w = 0
ifTrue: [↑4].
↑w].
"301" FontSet$'Access'
[ n | |
(n > (fonts length - 1) or: [n < 0])
ifTrue: [user notify: 'fontset offset < 0 or > 15 illegal']
ifFalse:
[(fonts (n + 1) Is: Font)
ifTrue: [↑fonts (n + 1)].
(fonts 1 Is: Font)
ifTrue: [↑fonts 1].
user notify: 'No valid fonts in this FontSet']].
"240" FontSet$'Access'
[family: n | s char |
"return the family name taken out of names"
names n nil
ifTrue: [n ← 1].
s ← Stream default.
names n do:
[:char | char isletter
ifTrue: [s next← char]
ifFalse: [↑s contents]]].
"40" FontSet$'Access'
[height | |
↑height].
"42" FontSet$'Access'
[descent | |
↑descent].
"256" FontSet$'Access'
[size: n | s c size |
"return size from fontname"
names n nil
ifTrue: [n ← 1].
size ← 0.
s ← (names n) asStream.
[(c ← s next) isletter] whileTrueDo: [].
[size ← size * 10 + (c - 48).
c ← s next] whileTrueDo: [].
↑size].
"42" FontSet$'Access'
[baseline | |
↑ascent].
"38" FontSet$'Access'
[names | |
↑names].
"62" Paragraph$'Normal access'
[textStyle | |
↑DefaultTextStyle].
"151" Paragraph$'Filing'
[readFrom: file | |
text ← file nextString.
runs ← file nextString.
alignment ← file next.
runs empty
ifTrue: [runs ← nil]].
"192" Paragraph$'Manipulation of format runs'
[runfind: index | run t |
"index into run"
run ← 1.
[(t ← index - (runs run)) > 0] whileTrueDo:
[index ← t.
run ← run + 2].
↑{run , index}].
"122" Paragraph$'Manipulation of format runs'
[maskrunsunder: m to: val | |
self maskrun: 1 to: text length under: m to: val].
"483" Paragraph$'Bravo conversions'
[fromBravo | newpara newtext loc i j |
"Find Bravo trailers and return a copy of self with them applied"
newpara ← self copy.
loc ← 1.
[(i ← (newtext ← newpara text) find: 26) 0] whileTrueDo:
[j ← newtext (i + 1 to: newtext length) find: 13.
newpara applyBravo: newtext (i + 1 to: i + j) at: loc to: i - 1.
newpara replace: i to: (i + j = newtext length
ifTrue: [i + j]
ifFalse: [i + j - 1]) by: ''.
loc ← i + 1].
↑newpara].
"105" Paragraph$'Press printing'
[presson: press in: r | |
↑self presson: press in: r style: self textStyle].
"56" Paragraph$'Text alignment'
[alignment | |
↑alignment].
"64" Paragraph$'Text alignment'
[alignment← t1 | |
alignment ← t1].
"115" Paragraph$'Initialization of parts'
[text: t1 runs: t2 alignment: t3 | |
text ← t1.
runs ← t2.
alignment ← t3].
"1587" Paragraph$'Bravo conversions'
[applyBravo: s at: i to: j | v ch t bslash cr |
s ← s asStream "Alter runs of characters i through j according to trailer.
see Ibis<Bravo>Trailer.Memo for further info.
some functions may not be implemented, thus parsed and ignored.
paragraph looks.
implemented: justification (j), centering (c).
ignored: left margin (l), first line left margin (d), right margin (z),
line leading (x), paragraph leading (e), vertical tab (y), keep (k), profile (q),
tab tables ( () )".
cr ← 13.
bslash ← '\' 1.
[(ch ← s next) = bslash] whileFalseDo:
[(ch false or: [ch = cr])
ifTrue: [↑self].
"no more"
(t ← 'jcq' find: ch) > 0
ifTrue:
[t = 1
ifTrue: [self justify]
ifFalse:
[t = 2
ifTrue: [self center]]]
ifFalse:
[(t ← '(ldzxeyk' find: ch) > 0
ifTrue:
[t = 1
ifTrue: [s skipTo: ')' 1]
ifFalse: [s integerScan]]] "character looks.
implemented: font (f), bold (bB), italic (iI), underline (uU).
ignored: graphic (g), visible (v), overstrike (s), superscript (o), tabcolor (t)"].
[(ch ← s next) and: [ch cr]] whileTrueDo:
[ "run length"
((ch 48 and: [ch 57 "isdigit"])
ifTrue: [s skip: 1]
ifFalse: [ch = 32])
ifTrue: [i ← i + s integerScan]
ifFalse:
[(t ← 'bBiIuU' find: ch) > 0
ifTrue: [self maskrun: i to: j under: #(1 1 2 2 4 4 ) t to: #(1 0 2 0 4 0 ) t]
ifFalse:
[(t ← 'fot' find: ch) > 0
ifTrue:
[v ← s integerScan "new value follows".
t = 1
ifTrue: [self maskrun: i to: j under: 240 to: (v lshift: 4)]]]]]].
"167" Paragraph$'Manipulation of format runs'
[allFont: n | |
(n is: String)
ifTrue: [n ← (self textStyle fontnames find: n) - 1].
self maskrunsunder: 240 to: n * 16].
"294" Paragraph$'Manipulation of format runs'
[runAndVal: index | run t |
"length and value at index"
runs nil
ifTrue: [↑{text length - index + 1 , 0}].
run ← 1.
[(t ← index - (runs run)) > 0] whileTrueDo:
[index ← t.
run ← run + 2].
↑{runs run - index + 1 , (runs (run + 1))}].
"59" ParagraphScanner$'Initialization'
[in: t1 | |
rect ← t1].
"135" ParagraphScanner$'Scanning'
[tab | |
spaces ← 0.
tabpos next← textstrm position.
tabpos next← width ← width + font tab | font tab].
"47" ParagraphScanner$'Access'
[width | |
↑width].
"195" ParagraphScanner$'Initialization'
[of: t1 to: t2 style: t3 | |
para ← t1.
press ← t2.
style ← t3.
textstrm ← '' asStream.
runstrm ← para runs asStream.
tabpos ← (Vector new: 10) asStream].
"246" ParagraphScanner$'Private scanning'
[newrun | len pos |
(len ← runstrm next)
ifTrue:
[pos ← textstrm position.
textstrm of: para text from: pos + 1 to: pos + len.
font ← press codefont: runstrm next style: style]
ifFalse: [↑false]].
"61" ParagraphScanner$'Scanning'
[backup | |
textstrm skip: 1].
"62" ParagraphScanner$'Access'
[position | |
↑textstrm position].
"100" ParagraphScanner$'Initialization'
[init | |
ascent ← descent ← width ← spaces ← 0.
tabpos reset].
"1187" ParagraphScanner$'Scanning'
[scan | maxw sp char t spos slim srunpos sasc sdesc swidth ssp sfont stpos |
"Scan up to a zero-width character, back up to last blank if width exceeded" "Save state"
(textstrm end and: [self newrun false])
ifTrue: [↑false].
maxw ← rect width.
[ascent ← ascent max: font ascent.
descent ← descent max: font descent.
sp ← font space.
[t ← font scan: textstrm until: width exceeds: maxw.
(char ← t 1) true
ifFalse: [width ← t 2].
char = 32] whileTrueDo:
[spos ← textstrm position "Save state".
slim ← textstrm limit.
srunpos ← runstrm position.
stpos ← tabpos position.
sasc ← ascent.
sdesc ← descent.
swidth ← width.
ssp ← spaces.
sfont ← font.
spaces ← spaces + 1.
width ← width + sp].
char
ifTrue:
[((char true and: [nil spos]) and: [2 * ascent rect height])
ifTrue:
[textstrm of: para text "Back up to just past last blank (if another line fits)" from: spos + 1 to: slim.
runstrm position← srunpos.
tabpos position← stpos.
ascent ← sasc.
descent ← sdesc.
width ← swidth.
spaces ← ssp.
font ← sfont.
↑32].
↑char]
ifFalse: [self newrun]] whileTrueDo: [].
↑false].
"2777" ParagraphScanner$'Printing'
[printfrom: charpos aligned: align skip: n | ybot a b ix iy px xs sp rs len tpos ts ntab rval ifont w ps t21 |
"Returns false if goes below bottom"
(ybot ← rect corner "this code basically writes the EL (entity list) for a line" "bottom of character -- ascent not really ascent but height" y - ascent) < rect origin y
ifTrue: [↑false].
"won't fit"
a ← charpos + 1.
b ← textstrm position - n.
a > b
ifFalse:
[ "No text"
ts ← tabpos viewer.
tpos ← ts next.
px ← false.
xs ← rect width - width.
ix ← rect minX + (align = 2 "left margin offset"
ifTrue: [xs / 2]
ifFalse:
[align = 4
ifTrue: [xs]
ifFalse: [0]]) "set baseline of character. do setx before showchars".
press sety: (iy ← ybot + descent).
sp ← font space "kludge?".
align = 1
ifFalse: [ "do setspacex before showchars"
press setspacex: sp].
rs ← (para run: a to: b) asStream.
[len ← rs next] whileTrueDo:
[press selectfont: (press fontindex: (rval ← rs next) style: style) - 1.
b ← a + len.
(rval land: 4) = 0
ifFalse:
[ "no underlining" "unfortunately, we must rescan this part of line to find out how wide it is"
ifont ← press codefont: rval style: style "a WidthTable".
ps ← (para (a to: b - 1)) asStream.
w ← {true , 0}.
[w 1] whileTrueDo:
[w ← ifont scan: ps until: w 2 exceeds: rect width.
(t21 ← w 1) = 32
ifTrue: [w 2 ← w 2 + ifont space]
ifFalse:
[t21 = 9
ifTrue: [w 2 ← w 2 + ifont tab | ifont tab]]].
px
ifFalse: [ "use current x position"
press setx: ix] "change y position to show rectangle, then change y back again".
press sety: iy - 40.
press showrectwidth: w 2 height: 30.
press sety: iy].
ntab ← 0.
[tpos and: [tpos < b]] whileTrueDo:
[ "Put out tabs"
tpos = a
ifFalse:
[ "no text between this tab and last" "put out accumulated tabs or initial x"
ntab > 0
ifTrue:
[press skipchars: ntab.
press setx: px.
ntab ← 0]
ifFalse:
[px
ifFalse: [press setx: (px ← ix)]].
press showchars: tpos - a].
ntab ← ntab + 1.
px ← ix + ts next.
a ← tpos + 1.
tpos ← ts next].
ntab > 0
ifTrue:
[press skipchars: ntab.
press setx: px]
ifFalse:
[px
ifFalse: [press setx: (px ← ix)]].
(align = 1 and: [tpos false])
ifTrue:
[ "Reset space width"
spaces = 0
ifFalse: [press setspacex: xs / spaces + sp].
align ← 0].
rs end
ifTrue:
[press showchars: b - a "for more compactness, maybe" skip: n.
↑ybot].
press showchars: b - a.
a ← b]].
n > 0
ifTrue: [press skipchars: n "skip over ending blank or carriage return"].
↑ybot].
"1414" Paragraph$'Press printing'
[presson: press in: r style: style | char pos s3 y chop |
(text length "Output paragraph inside rectangle (page coordinates)" "probably ParagraphScanner should handle this" > 0 and: [text 1 = 12])
ifTrue: [↑self copy: 2 to: text length "formfeed --> page break"].
y ← r corner y "We change corner y later".
s3 ← ParagraphScanner new of: self to: press style: style.
s3 init in: r.
pos ← s3 position.
chop ← (alignment = 1
ifTrue: [0]
ifFalse: [alignment]).
[y and: [(char ← s3 scan)]] whileTrueDo:
[char = 9
ifTrue: [s3 tab]
ifFalse:
[(char = 32 or: [char = 13])
ifTrue:
[(y ← s3 printfrom: pos aligned: "carriage return or exceeded max width and backed up to blank"
(char = 32
ifTrue: [alignment]
ifFalse: [chop]) skip: 1)
ifTrue:
[r corner y← y.
s3 init in: r.
pos ← s3 position]]
ifFalse:
[char true
ifTrue:
[s3 backup "exceeded max width with no blanks in line".
(y ← s3 printfrom: pos aligned: 0 skip: 0)
ifTrue:
[r corner y← y.
s3 init in: r.
pos ← s3 position]] "user notify: 'unimplemented control char'"]] "Put out trailing text if any"].
(y and: [(pos = s3 position or: [(y ← s3 printfrom: pos aligned: chop skip: 0)])])
ifTrue:
[press append: text.
↑y].
press append: text (1 to: pos).
↑self copy: pos + 1 to: text length].
"79" Paragraph$'Initialization of parts'
[text: t1 | |
text ← t1.
alignment ← 0].
"456" Paragraph$'Manipulation of format runs'
[makeBoldPattern | s i c |
s ← text asStream.
i ← 0.
[(c ← s next)
ifTrue:
[ " scan to bracket, bar or comment "
c = 91
ifTrue: [true]
ifFalse:
[c = 124
ifTrue: [true]
ifFalse:
[c = 34
ifTrue: [true]
ifFalse:
[c = 25
ifTrue: [true]
ifFalse: [false]]]]]
ifFalse: [true]] whileFalseDo: [ "end"
i ← i + 1].
self maskrun: 1 to: i under: 1 to: 1].
"56" Paragraph$'Text alignment'
[center | |
alignment ← 2].
"108" Paragraph$'Normal access'
[subst: x for: y | |
"runs are not supported yet here"
↑text subst: x for: y].
"489" Paragraph$'Press printing'
[fromPress: press value: s | len x |
s next = 0
ifTrue:
[len ← s nextword "text is in DL" "amount to skip from where we are now to end of text".
x ← (s limit > 255
ifTrue: [s limit "control info came from DL"]
ifFalse: [ "from EL"
0]).
press data skip: 0 - x - len.
text ← press data next: len.
press data skip: x]
ifFalse: [text ← s nextString].
runs ← s nextString.
alignment ← s next.
runs empty
ifTrue: [runs ← nil]].
"167" Paragraph$'Bravo conversions'
[toBravo | s |
s ← (String new: text length * 2) asStream.
s append: text.
s next← 26.
self bravoRuns: s.
↑s contents asParagraph].
"119" RemoteParagraph$'As yet unclassified'
[asParagraph | |
file position← self position.
↑Paragraph new readFrom: file].
"78" RemoteParagraph$'As yet unclassified'
[asString | |
↑self asParagraph text].
"95" RemoteParagraph$'As yet unclassified'
[on: t1 | |
"Refer me to a specific file"
file ← t1].
"303" Cursor$'Initialization'
[fromtext: str offset: t2 | i s n c |
offset ← t2.
bitstr ← Bitmap new: 16 "Not great, but compatible with printon.".
s ← str asStream.
s next.
(1 to: 16) do:
[:i | n ← 0.
[(c ← s next) = 48 or: [c = 49]] whileTrueDo: [n ← (n lshift: 1) + (c - 48)].
bitstr i ← n]].
"108" Cursor$'Printing'
[hardcopy: pf | |
self hardcopy: pf at: user mp "use current cursor position" - offset].
"55" Cursor$'Showing'
[show | |
user currentCursor: self].
"146" Cursor$'Showing'
[showwhile expr | oldcursor value |
oldcursor ← user currentCursor.
self show.
value ← expr eval.
oldcursor show.
↑value].
"48" Cursor$'Access to Parts'
[offset | |
↑offset].
"97" Cursor$'Initialization'
[asForm | |
↑Form new extent: self extent bits: bitstr offset: offset].
"46" Cursor$'Access to Parts'
[bits | |
↑bitstr].
"220" Cursor$'Printing'
[printon: strm | i |
strm append: 'Cursor new fromtext: '''.
(1 to: 16) do:
[:i | strm cr.
bitstr i printon: strm base: 2].
strm append: ''' offset: '.
strm print: offset.
strm append: '.'].
"211" Cursor$'Printing'
[hardcopy: pf at: loc | rect |
rect ← loc extent: 16 16 "print cursor image at some point location into a presssfile".
pf setp: (pf transrect: rect) origin.
pf bitmap: rect bits: bitstr].
"84" Cursor$'Initialization'
[fromString: t1 offset: t2 | |
bitstr ← t1.
offset ← t2].
"49" Cursor$'Access to Parts'
[extent | |
↑16 16].
"43" Cursor$'Showing'
[topage1 | |
self show].
"56" Cursor$'Access to Parts'
[offset: t1 | |
offset ← t1].
"79" Cursor$'Initialization'
[fromtext: str | |
self fromtext: str offset: 0 0].
"99" Cursor$'Initialization'
[fromString: t1 | |
bitstr ← t1.
self fromString: bitstr offset: 0 0].
"387" UserView$'Mouse, Cursor, Keys'
[currentCursor: c | coff p t4 |
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".
NoteTaker
ifTrue: [self mapDisplay]
ifFalse:
[(t4 ← BitBlt new) forCursor.
t4 source: c bits lock.
t4 effect: 0.
t4 callBLT.
c bits unlock]].
"68" UserView$'Mouse, Cursor, Keys'
[currentCursor | |
↑currentCursor].
"66" UserView$'Changes'
[changedMessages | |
↑Changes contents sort].
"78" UserView$'As yet unclassified'
[primEIAPeek | |<primitive: 75>
↑self croak].
"79" UserView$'As yet unclassified'
[primKbdBlock | |<primitive: 47>
↑self croak].
"78" UserView$'As yet unclassified'
[primPort: n | |<primitive: 75>
↑self croak].
"234" UserView$'Screen Views'
[screenrect: t1 vtab: t2 htab: t3 scale: t4 color: t5 projectWindow: t6 disp: t7 sched: t8 | |
screenrect ← t1.
vtab ← t2.
htab ← t3.
scale ← t4.
color ← t5.
projectWindow ← t6.
disp ← t7.
sched ← t8].
"50" UserView$'Dialog Window'
[space | |
disp space].
"315" UserView$'System quit/resume'
[quitThen: s continue: r | t3 |
s
ifTrue:
[(t3 ← dp0 oldFile: 'rem.cm.' "something for O.S. to do") settoend.
t3 append: s.
t3 append: '; '.
t3 append: (r
ifTrue: ['Resume.~ small.boot']
ifFalse: ['Quit.~; Resume.~ small.boot']).
t3 cr.
t3 flush].
self quit].
"136" UserView$'Mouse, Cursor, Keys'
[leftShiftKey | |
"left shift key down?"
NoteTaker
ifTrue: [↑false].
↑(mem 482 land: 64) = 0].
"62" UserView$'Mouse, Cursor, Keys'
[tablet | |
↑mem 448 0].
"50" UserView$'Changes'
[noChanges | |
Changes init].
"272" UserView$'Mouse, Cursor, Keys'
[rawkbd | stroke |
(NoteTaker and: ['NoEventQ'])
ifTrue:
[[self rawkbck] whileFalseDo: [].
↑self primKbdNext].
[stroke ← self rawkbck] whileFalseDo: [ "wait for activity"
].
Events next.
↑stroke "if key down, return stroke"].
"555" UserView$'As yet unclassified'
[forAllMethods mvar do expr | n md sel |
AllClassNames do: [:n | user displayoffwhile [
(user show: n.
user cr.
md ← (Smalltalk n) md.
md do:
[:sel | mvar value← md method: sel.
expr eval])]] " | dict x m
[dict← Dictionary init.
user forAllMethods m do
[m length<8[]
(m3)>12[]
dict tally: m5].
dict contents sort transform x to x,(dictx)]
((1 381 ) (2 640 ) (3 638 ) (4 464 ) (5 365 ) (6 215 ) (7 179 ) (8 140 ) (9 70 ) (10 61 ) (11 45 ) (12 20 ) (13 10 ) (14 2 ) (15 1 ) )
"].
"78" UserView$'Dialog Window'
[croak | |
self notify: 'A primitive has failed.'].
"176" UserView$'As yet unclassified'
[currentDisplay: form | |
DisplayForm ← form.
screenrect ← 0 0 rect: form extent.
vtab ← htab ← mxoffset ← myoffset ← 0.
self mapDisplay].
"652" MessageDict$'Inserting and Deleting'
[insert: name method: m literals: l code: c backpointers: b | i copy |
(i ← self find: name)
ifTrue:
[ "if name is already there"
self freeMethod: methods i.
NoteTaker
ifFalse: [self holdLiterals: l] "CompiledMethod already did it".
methods i ← m.
NoteTaker
ifFalse: [code i ← c]]
ifFalse:
[ "then insert it, and return self"
copy ← (self sparse
ifTrue: [self]
ifFalse: [self growto: methods length * 2]) "Otherwise, copy if necessary".
copy objects (copy findornil: name) ← name "and insert".
↑copy insert: name method: m literals: l code: c backpointers: b]].
"372" MessageDict$'Private'
[growto: size | name copy i |
copy ← MessageDict new init: size "create a copy of the new size".
self do:
[:name | i ← self findorerror: name "hash each entry into it".
copy ← copy insert: name method: methods i literals: (literals nil
ifFalse: [literals i]) code: (NoteTaker
ifFalse: [code i]) backpointers: nil].
↑copy].
"298" MessageDict$'Code aspect of Strings'
[literalsIn: method | |
"return the literal vector imbedded in this method"
NoteTaker
ifTrue:
[method nil
ifTrue: [↑Vector new: 0].
↑method literals]
ifFalse: [ "CompiledMethod knows how"
↑self holdLiterals: (self rawLiteralsIn: method)]].
"339" MessageDict$'Code aspect of Strings'
[holdLiterals: v | |
"raise refct of all literals"
NoteTaker
ifTrue: [↑v].
"CompiledMethod already did it"
v nil
ifTrue: [↑v].
v length = 0
ifTrue: [↑v].
"make a copy and blt nils over it before freeing"
BitBlt new bltObj: v copy field: 1 to: v length fromObj: nil field: 0.
↑v].
"249" MessageDict$'Code aspect of Strings'
[freeLiterals: v | m i t |
"lower refct of all literals"
v length = 0
ifFalse:
[m ← v nail.
(1 to: v length) do:
[:i | t ← mem (m + i - 1).
v i ← nil.
mem (m + i - 1) ← t].
v unNail]].
"200" MessageDict$'Inserting and Deleting'
[delete: name | i |
i ← self findorerror: name.
self freeMethod: methods i.
methods i ← nil.
NoteTaker
ifFalse: [code i ← nil].
super delete: name].
"211" MessageDict$'Code aspect of Strings'
[holdMethods: v | i |
"a random insertion just to make it legal form"
(1 to: v length) do: [:i | self insert: i method: v i literals: nil code: nil backpointers: nil]].
"483" MessageDict$'Code aspect of Strings'
[freeMethod: m | |
"method pointed to by some vector (dict or keeper)
and (upon entry) by m. If any other owners, refct will be >2.
*Expects Interpreter to nil args on callers stack*"
m nil
ifFalse:
[NoteTaker
ifTrue: [(nil swap [:m | m]) free]
ifFalse:
[ "CompiledMethod knows how, but refct must be the same"
m refct > 2
ifTrue: [MethodKeeper next← m]
ifFalse: [ "keep it"
self rawLiteralsIn: m]]]].
"138" MessageDict$'Initialization'
[copyfrom: dict | |
self objects← dict objects copy.
methods ← dict methods copy.
code ← dict code copy].
"141" MessageDict$'Private'
[swap: i with: j | |
methods swap: i with: j.
NoteTaker
ifFalse: [code swap: i with: j].
super swap: i with: j].
"220" MessageDict$'Code aspect of Strings'
[freeMethods | v i |
"Free kept methods no longer used"
v ← MethodKeeper contents.
MethodKeeper ← (Vector new: 10) asStream.
(1 to: v length) do: [:i | self freeMethod: v i]].
"117" MessageDict$'Access to parts'
[methodorfalse: name | i |
(i ← self find: name)
ifTrue: [↑methods i].
↑false].
"55" MessageDict$'Access to parts'
[methods | |
↑methods].
"377" MessageDict$'Code aspect of Strings'
[rawLiteralsIn: method | v nlits |
"returns the literal vector WITHOUT REFI (for freeMethod: and literalsIn:)"
method nil
ifTrue: [↑Vector new: 0].
method length < 10
ifTrue: [↑Vector new: 0].
nlits ← method 6 - 6 / 2.
v ← Vector new: (nlits max: 2).
BitBlt new bltObj: v field: 1 to: nlits fromObj: method field: 4.
↑v].
"149" MessageDict$'Access to parts'
[code: name ← str | |
NoteTaker
ifTrue: [↑str].
"NT doesnt store code"
↑code (self findorerror: name) ← str].
"208" MessageDict$'Inserting and Deleting'
[close | i |
"recycle all code and literals pointed to"
(1 to: methods length) do:
[:i | methods i nil
ifFalse: [self freeMethod: methods i]].
self init].
"49" MessageDict$'Access to parts'
[code | |
↑code].
"148" MessageDict$'Access to parts'
[invert: method | i |
(1 to: methods length) do:
[:i | methods i method
ifTrue: [↑objects i]].
↑false].
"87" MessageDict$'Access to parts'
[method: name | |
↑methods (self findorerror: name)].
"130" MessageDict$'Access to parts'
[code: name | |
NoteTaker
ifTrue: [↑'no code' asParagraph].
↑code (self findorerror: name)].
"144" MessageDict$'Initialization'
[init: size | |
methods ← Vector new: size.
NoteTaker
ifFalse: [code ← Vector new: size].
super init: size].
"106" MessageDict$'Access to parts'
[literals: name | |
↑self literalsIn: methods (self findorerror: name)].
"979" UserView$'Misc System Stuff'
[initCompilerUnspecialize | c code sel i class m bother oldChanges |
"user initCompilerUnspecialize.
SpecialOops(32~41)← (end class blockCopy: value value: nil new new: x y).
SpecialOops37← nil.
user initCompilerSpecialize."
oldChanges ← Changes.
Changes ← HashSet init "Unspecialize the last 10 selectors".
SpecialOops (32 ~ 41) all← nil.
self initCompilerSelectors.
user displayoffwhile [(AllClassNames do:
[:c | user show: c + ' 1'.
user cr.
class ← Smalltalk c.
class md do:
[:sel | "recompile all methods w/special bytes"
m ← class method: sel.
m length 8
ifFalse:
[ "quick"
bother ← false.
(m 6 + 1 to: m length) do:
[:i | (m i 198 and: [m i 207])
ifTrue: [bother ← true]].
bother
ifTrue: [class recompile: sel]]].
Changes init])].
PriorityScheduler new initsched.
nil installError.
MessageDict new freeMethods.
Changes ← oldChanges].
"443" UserView$'Misc System Stuff'
[initCompilerSelectors | c code sel |
c ← Dictionary new init: 64.
code ← 176 - 1.
SpecialOops (10 ~ 41) do:
[:sel | code ← code + 1 "Atoms not wanted here -- only strings and characters".
sel nil
ifFalse:
[sel ← ((sel length = 1 and: [(sel 1) isletter false])
ifTrue: [sel 1]
ifFalse: [sel asString]).
c insert: sel with: code]].
ByteCodes declare: #stdSelectors as: c].
"591" UserView$'Notify Window'
[notifier: titleString level: lev interrupt: flag | |
self restoredisplay "Restore the full display. Schedule a one-paned window to notify the user that errorString happened.".
NotifyFlag false
ifTrue:
[disp cr.
disp append: 'NotifyFlag is false...'.
disp cr.
disp append: ' top-blank shows stack, user restart aborts,'.
disp cr.
disp append: ' tempframe shows args, ctrl-d proceeds'.
disp cr.
disp append: titleString.
disp cr.
disp show.
(Top lev) debug.
↑false].
↑NotifyWindow new of: titleString level: lev interrupt: flag].
"44" UserView$'Time'
[today | |
↑self now 1].
"414" UserView$'Screen Views'
[screenextent: extent tab: tab | |
mem 53 ← color * 16384 + (scale = 2
ifTrue: [32768]
ifFalse: [0]) + (tab x / 16 * 256) + (extent x / 16 | 2).
mem 55 ← extent y * scale / 2.
mem 51 ← 1 max: tab y / 2.
htab ← tab x | 16.
vtab ← mem 51 * 2.
screenrect ← 0 0 rect: extent x | 32 (extent y | 2).
self currentCursor: currentCursor.
self reconfigure.
self restore].
"593" UserView$'Notify Window'
[notifier: titleString stack: stack interrupt: flag | |
self restoredisplay "Restore the full display. Schedule a one-paned window to notify the user that errorString happened.".
NotifyFlag false
ifTrue:
[disp cr.
disp append: 'NotifyFlag is false...'.
disp cr.
disp append: ' sender debug shows stack, user restart aborts,'.
disp cr.
disp append: ' tempframe shows args, ctrl-d proceeds'.
disp cr.
disp append: titleString.
disp cr.
disp show.
stack debug.
↑false].
↑NotifyWindow new of: titleString stack: stack interrupt: flag].
"61" UserView$'Dialog Window'
[request: s | |
↑disp request: s].
"493" UserView$'Notify Window'
[notify: errorString | notifyWindow |
notifyWindow ← self notifier: errorString stack: thisContext sender "Create a notify window looking at the Context stack" interrupt: false.
notifyWindow
ifTrue:
[NoteTaker
ifTrue:
[self schedule: notifyWindow.
user run]
ifFalse:
[thisContext sender← nil.
Top currentPriority = 1
ifTrue: [self restartup: notifyWindow]
ifFalse:
[self scheduleOnBottom: notifyWindow.
Top errorReset]]]].
"140" UserView$'System quit/resume'
[InLd: fileid | |<primitive: 75>
"write out the core image, then load in OS"
user notify: 'file problem'].
"50" UserView$'Window Scheduling'
[sched | |
↑sched].
"72" UserView$'Dialog Window'
[show: str | |
disp append: str.
disp show].
"82" UserView$'Time'
[time expr | t |
t ← self ticks.
expr eval.
↑self ticks - t].
"159" UserView$'Screen Views'
[displayoffwhile expr | t v |
NoteTaker
ifTrue: [↑expr eval].
t ← mem 55.
mem 55 ← 58.
v ← expr eval.
mem 55 ← t.
↑v].
"163" UserView$'Window Scheduling'
[scheduleOnBottom: window | |
sched nil
ifTrue: [sched ← window asVector]
ifFalse: [sched ← sched concat: window asVector]].
"89" UserView$'Time'
[ticks | |
"Return the 38.08-millisecond interval timer"
↑mem 280].
"132" Date$'Aspects'
[daysinmonth: m | |
↑#(31 28 31 30 31 30 31 31 30 31 30 31 ) m + (m = 2
ifTrue: [self leap]
ifFalse: [0])].
"235" Date$'Aspects'
[weekdayIndex | a d |
day (self monthday: 3)
ifTrue:
[a ← year - 1.
d ← 306]
ifFalse:
[a ← year.
d ← 59 - self leap] "Tuesday=1,..., Monday=7".
↑d + day + a + (a / 4) + (a / 400) - (a / 100) \ 7 + 1].
"204" Date$'Arithmetic'
[previous: di | |
↑self + (0 - (7 + self weekdayIndex "e.g. previous: 6 (Sunday) returns Date which is previous closest Sunday.
note: di=self weekdayIndex returns self+0" - di \ 7))].
"186" Date$'Arithmetic'
[+ days | t |
days ← day + days.
t ← Date new.
(days > 0 and: [days < 366])
ifTrue:
[t day← days "same year".
t year← year.
↑t].
↑t day: days year: year].
"227" Date$'Setting state'
[day: t1 year: t2 | d |
day ← t1.
year ← t2.
[day > (d ← self daysinyear)] whileTrueDo:
[year ← year + 1.
day ← day - d].
[day 0] whileTrueDo:
[year ← year - 1.
day ← day + self daysinyear]].
"179" Date$'Aspects'
[monthday: m | |
"Return first day-in-year of m'th month"
↑#(0 31 59 90 120 151 181 212 243 273 304 334 ) m + (m > 2
ifTrue: [self leap]
ifFalse: [0])].
"232" Date$'Arithmetic'
[- date | |
(date is: Date)
ifTrue:
[year = date year
ifTrue: [↑day - date day].
↑year - 1 / 4 - (date year / 4) + day + date daysleft + (year - 1 - date year * 365)]
ifFalse: [↑self + (0 - date)]].
"374" Date$'Setting state'
[day: t1 month: month year: t3 | |
day ← t1.
year ← t3.
year < 100
ifTrue: [year ← 1900 + year].
(month ← self whichmonth: month) false
ifTrue: [user notify: 'illegal month']
ifFalse:
[(day < 1 or: [day > (self daysinmonth: month)])
ifTrue: [user notify: 'illegal day in month']
ifFalse: [day ← day + (self monthday: month)]]].
"51" Date$'Aspects'
[daysinyear | |
↑365 + self leap].
"293" Date$'Aspects'
[whichmonth: m | a |
"M may be a (partial) month name, or a number. Return the month number, or false"
(m Is: String)
ifTrue:
[m ← m + '*'.
(1 to: 12) do:
[:a | (m match: monthnames a "first partial match")
ifTrue: [↑a]].
↑false].
↑m 1 and: [m 12]].
"801" Date$'Printing and reading'
[printon: strm format: f | i m t5 t6 |
m ← self month "f is print format.
1-3 positions to print day,month,year respectively
4 character separator
5 month format (1 month #, 2 first 3 chars, 3 entire name)
6 year format (1 year #, 2 year #\100)".
(1 to: 3) do:
[:i | (t5 ← f i) = 1
ifTrue: [day - (self monthday: m) printon: strm]
ifFalse:
[t5 = 2
ifTrue:
[(t6 ← f 5) = 1
ifTrue: [m printon: strm]
ifFalse:
[t6 = 2
ifTrue: [strm append: monthnames m (1 to: 3)]
ifFalse: [strm append: monthnames m]]]
ifFalse:
[t5 = 3
ifTrue: [(f 6 = 1
ifTrue: [year]
ifFalse: [year \ 100]) printon: strm]]].
i < 3
ifTrue:
[f 4 0
ifTrue: [strm next← f 4 "separator"]]]].
"94" Date$'Printing and reading'
[printon: strm | |
self printon: strm format: #(1 2 3 32 3 1 )].
"59" Date$'Setting state'
[default | |
↑user now "today" 1].
"137" Date$'Aspects'
[asSeconds | |
"Seconds since the beginning of time (local time)"
↑secsinday * (self - (Date new day: 1 year: 1901))].
"58" Date$'Aspects'
[monthname | |
↑monthnames self month].
"99" Date$'Arithmetic'
[< date | |
year = date year
ifTrue: [↑day < date day].
↑year < date year].
"73" Date$'Arithmetic'
[= date | |
↑day = date day and: [year = date year]].
"99" Date$'Arithmetic'
[> date | |
year = date year
ifTrue: [↑day > date day].
↑year > date year].
"121" Date$'Printing and reading'
[format: f | strm |
strm ← Stream default.
self printon: strm format: f.
↑strm contents].
"56" Date$'Aspects'
[hash | |
↑(year lshift: 3) lxor: day].
"294" Date$'Setting state'
[fromDays: d | |
d ← d asInteger "d = days since Jan 1 1901. There are 1461 days in a 4-year cycle.
2000 is a leap year, so no extra correction is necessary.
day:year: will fix things up" intdiv: 1461.
self day: 1 + (d 2) asSmall year: 1901 + ((d 1) asSmall * 4)].
"42" Date$'Aspects'
[year← t1 | |
year ← t1].
"256" Date$'Aspects'
[month | m leap |
leap ← self leap.
(12 to: 1 by: 1) do:
[:m | #(0 31 59 90 120 151 181 212 243 273 304 334 ) m + (m > 2
ifTrue: [leap]
ifFalse: [0]) "self monthday: m" < day
ifTrue: [↑m]].
user notify: 'illegal month'].
"40" Date$'Aspects'
[day← t1 | |
day ← t1].
"89" Date$'Printing and reading'
[readfrom: strm | |
self readfrom: strm format: #(1 2 3 )].
"55" Date$'Aspects'
[daysleft | |
↑self daysinyear - day].
"297" Date$'Printing and reading'
[readfrom: strm format: order | dmy i |
strm #today
ifTrue: [↑self default].
order nil
ifTrue: [order ← #(1 2 3 )].
dmy ← Vector new: 3.
(1 to: 3) do: [:i | "dmy length"
dmy (order i) ← strm next].
self day: dmy 1 month: dmy 2 year: dmy 3].
"97" Date$'Printing and reading'
[from: s | |
self readfrom: s asVector "asSet" viewer format: nil].
"170" Date$'Initialization'
[classInit | |
monthnames ← #(January February March April May June July August September October November December ).
secsinday ← 24 * 60 * 60].
"113" Date$'Aspects'
[weekday | |
↑#(Tuesday Wednesday Thursday Friday Saturday Sunday Monday ) self weekdayIndex].
"34" Date$'Aspects'
[year | |
↑year].
"163" Date$'Aspects'
[leap | |
year \ 4 = 0
ifTrue:
[year \ 100 = 0
ifTrue:
[year \ 400 = 0
ifTrue: [↑1].
↑0]
ifFalse: [↑1]]
ifFalse: [↑0]].
"32" Date$'Aspects'
[day | |
↑day].
"69" Date$'Aspects'
[dayinmonth | |
↑day - (self monthday: self month)].
"38" Date$'Aspects'
[dayinyear | |
↑day].
"65" Date$'Aspects'
[daysinmonth | |
↑self daysinmonth: self month].
"239" Number$'Arithmetic'
[ipow: x | |
"fixed powers in log n steps"
x = 0
ifTrue: [↑1].
x = 1
ifTrue: [↑self].
x > 1
ifTrue: [↑(self * self ipow: x / 2) * (self ipow: x \ 2)].
user notify: 'power must be positive for integers'].
"46" Number$'Arithmetic'
[> n | |
↑self - n > 0].
"46" Number$'Arithmetic'
[< n | |
↑self - n < 0].
"75" Number$'Conversions'
[asPtY | |
"pretend to be a Point for Point +-*/"].
"75" Number$'Conversions'
[asPtX | |
"pretend to be a Point for Point +-*/"].
"46" Number$'Arithmetic'
[= n | |
↑self - n = 0].
"93" Number$'Conversions'
[printon: strm | |
self printon: strm base: 10 "default print radix"].
"54" Number$'Arithmetic'
[ arg | |
↑self = arg false].
"80" Number$'Arithmetic'
[between: min and: max | |
↑min self and: [self max]].
"63" Number$'Intervals, Points'
[ y | |
↑Point new x: self y: y].
"56" Number$'As yet unclassified'
[hex | |
↑self base: 16].
"76" Number$'Subscripts'
[cansubscript: a | |
↑self asInteger cansubscript: a].
"62" Number$'Subscripts'
[subscripts: a | |
↑a self asInteger].
"74" Number$'Subscripts'
[subscripts: a ← val | |
↑a self asInteger ← val].
"65" Number$'Arithmetic'
[abs | |
self < 0
ifTrue: [↑self * 1]].
"78" Number$'Intervals, Points'
[to: x | |
↑Interval new from: self to: x by: 1].
"96" Number$'Arithmetic'
[compare: i | |
self < i
ifTrue: [↑1].
self = i
ifTrue: [↑2].
↑3].
"41" Number$'Compatibility'
[isNumber | |
].
"121" Number$'Conversions'
[asRectangle | |
↑self self "Return a Rectangle with me as all coordinates." rect: self self].
"90" Number$'Conversions'
[asRectCorner | |
"pretend to be a Rectangle for Rectangle +-*/"].
"90" Number$'Conversions'
[asRectOrigin | |
"pretend to be a Rectangle for Rectangle +-*/"].
"66" Number$'Arithmetic'
[max: arg | |
self < arg
ifTrue: [↑arg]].
"138" Number$'Arithmetic'
[factorial | |
"I only work for positive integer values"
self = 0
ifTrue: [↑1].
↑self * (self - 1) factorial].
"245" Number$'Arithmetic'
[log2 | i cnt |
"floor of log base 2"
self < 0
ifTrue: [↑(self * 1) log2].
self < 1
ifTrue: [↑(self / self / self) log2 * 1].
i ← 1.
cnt ← 0.
[self i] whileTrueDo:
[i ← i + i.
cnt ← cnt + 1].
↑cnt - 1].
"117" Number$'Arithmetic'
[sign | |
↑self = 0
ifTrue: [0]
ifFalse:
[self < 0
ifTrue: [1]
ifFalse: [1]]].
"84" Number$'Intervals, Points'
[to: x by: y | |
↑Interval new from: self to: x by: y].
"66" Number$'Arithmetic'
[min: arg | |
self > arg
ifTrue: [↑arg]].
"92" Number$'Intervals, Points'
[for: n | |
↑Interval new from: self to: self + (n - 1) by: 1].
"49" Number$'Conversions'
[base8 | |
↑self base: 8].
"88" Number$'Intervals, Points'
[within: int | |
↑int start self and: [self int stop]].
"46" Number$'Compatibility'
[isLarge | |
↑false].
"150" Number$'Conversions'
[base: b | s |
s ← Stream default.
s append: '0'.
self printon: s base: b.
b = 16
ifTrue: [s append: 'H'].
↑s contents].
"97" Number$'As yet unclassified'
[bits: interval | |
↑self bits: interval start to: interval stop].
"96" Number$'Conversions'
[asPoint | |
↑self self "Return a Point with me as both coordinates."].
"76" Number$'Intervals, Points'
[~ x | |
↑Interval new from: self to: x by: 1].
"841" Number$'As yet unclassified'
[hex4 | strm i x bytes d t |
strm ← (String new: 5) asStream.
strm space.
x ← self asInteger.
x isLarge
ifTrue:
[bytes ← x bytes.
d ← bytes last.
d > 15
ifTrue:
[t ← d / 16.
strm next← (t < 10
ifTrue: [48 + t]
ifFalse: [55 + t])].
t ← d \ 16.
strm next← (t < 10
ifTrue: [48 + t]
ifFalse: [55 + t]).
(bytes length - 1 to: 1 by: 1) do:
[:i | d ← bytes i.
t ← d / 16.
strm next← (t < 10
ifTrue: [48 + t]
ifFalse: [55 + t]).
t ← d \ 16.
strm next← (t < 10
ifTrue: [48 + t]
ifFalse: [55 + t])].
↑strm contents].
bytes ← String new: 4.
(1 to: 4) do:
[:i | bytes i ← x \ 16.
x ← x lshift: 4].
(4 to: 1 by: 1) do:
[:i | t ← bytes i.
strm next← (t < 10
ifTrue: [48 + t]
ifFalse: [55 + t])].
↑strm contents].
"48" Time$'Setting state'
[seconds: t1 | |
s ← t1].
"48" Time$'Setting state'
[minutes: t1 | |
m ← t1].
"46" Time$'Setting state'
[hours: t1 | |
h ← t1].
"32" Time$'Aspects'
[hours | |
↑h].
"58" Time$'Aspects'
[asSeconds | |
↑3600 * h + (60 * m + s)].
"217" Time$'Setting state'
[fromSeconds: sec | |
sec ← sec asInteger "seconds since midnight (adjusted for time zone and DST)" intdiv: 3600.
h ← (sec 1) asSmall.
sec ← (sec 2) asSmall.
m ← sec / 60.
s ← sec \ 60].
"382" Time$'Printing'
[printon: strm | |
"Format is h:mm:ss am/pm"
strm print: (h > 12
ifTrue: [h - 12]
ifFalse:
[h < 1
ifTrue: [12]
ifFalse: [h]]).
strm append: (m < 10
ifTrue: [':0']
ifFalse: [':']).
strm print: m.
strm append: (s < 10
ifTrue: [':0']
ifFalse: [':']).
strm print: s.
strm space append: (h < 12
ifTrue: ['am']
ifFalse: ['pm'])].
"63" Time$'Setting state'
[default | |
↑user now "right now" 2].
"1642" UserView$'Time'
[convertTime: s returnSecs: format | d dd t dfirst dlast m570 m571 |
"s is total seconds from midnight Jan 1 1901 GMT (Greenwich mean time).
see maxc <AltoDocs>AltoTime.Press for details" "time zone specific parameters"
NoteTaker
ifTrue:
[m570 ← 16505.
m571 ← 305 "Zap! Youre in Palo Alto!"]
ifFalse:
[m570 ← mem 376.
m571 ← mem 377] "adjust for time zone".
s ← s + ((m570 0
ifTrue: [1]
ifFalse: [ "west" "east"
1]) * (3600 * (m570 bits: (1 to: 4) "hours") + (60 * (m571 bits: (1 to: 6) "additonal minutes")))).
t ← s intdiv: 86400 "current day (in local standard time)".
d ← Date new fromDays: t 1.
format
ifFalse: [t ← Time new fromSeconds: t 2] "check for DST. correct DST parameters for nonleap years and
round to previous Sunday if necessary" "day of the year on or before which DST takes effect".
dfirst ← m570 land: 511 "bits: (7 to: 15)".
(dfirst = 366
ifTrue: [false]
ifFalse:
[ "DST not in effect"
(dd ← d day) (dfirst ← dfirst + d leap - 1)
ifTrue:
[dlast ← (m571 land: 511) "day of the year on or before which DST ends" "bits: (7 to: 15)" + d leap - 1.
dd < dlast "if false, definitely after" and: [dd < ((Date new day: dlast year: d year) previous: 6) day]]
ifFalse: [ "possibly earlier than or at beginning of range"
dd ((Date new day: dfirst year: d year) previous: 6) day]])
ifTrue:
[format
ifTrue: [ "daylight savings time in effect. add an hour"
s ← s + 3600]
ifFalse:
[t hours = 23
ifTrue:
[d ← d + 1.
t hours: 0]
ifFalse: [t hours: t hours + 1]]].
format
ifTrue: [↑s].
↑{d , t}].
"124" UserView$'Screen Views'
[restoredisplay | |
NoteTaker
ifFalse:
[mem 272 ← 48.
mem 55 ← screenrect height / 2]].
"166" UserView$'Misc System Stuff'
[versionName | s |
s ← self version asStream "skip Smalltalk".
s skipTo: 32 "return version identification, e.g. 5.5f".
↑s upto: 32].
"2002" UserView$'Misc System Stuff'
[printCrossReference: classNames on: f | dict m md frame l each s class |
"user displayoffwhile [
user printCrossReference: user classNames
on: (dp0 file: 'CrossReference.Press')].
user classNames
(SystemOrganization category: 'xyz')
(class1 class2)"
dict ← Dictionary init: 200.
(1 to: 32) do: [:m | dict insert: SpecialOops (9 + m) with: #((Primitives ) () ) copy].
classNames transform [:each | each] to [
(user show: each.
user space.
md ← (Smalltalk each) md.
md do:
[:m | "Tally all the UniqueString literals"
(s ← dict lookup: m)
ifFalse: [dict insert: m with: (s ← #(() () ) copy)].
(s 1 has: each)
ifFalse:
[s 1 ← {s 1 , each}.
(md literals: m) do:
[:l | (l is: UniqueString)
ifTrue:
[(s ← dict lookup: l)
ifFalse: [dict insert: l with: (s ← #(() () ) copy)].
(s 2 has: each)
ifFalse: [s 2 ← {s 2 , (each , m)}]]]]])].
f ← f asPressPrinter.
f stamp.
frame ← f defaultframe "Print the messages out sorted".
dict contents sort do:
[:m | user show: m.
user space.
f frame← frame.
md ← dict m.
s ← (String new: 200) asStream.
s append: m.
s append: ((md 1) length = 0
ifTrue: [' ( - undefined - ']
ifFalse: [' (']).
(md 1) sort do:
[:l | s append: l.
s append: ', '].
s skip: 2.
s append: ')'.
f print: (s contents asParagraph maskrun: 1 to: m length under: 1 to: 1).
f frame← frame minX + 500 frame minY rect: frame corner.
s reset.
(md 1 has: #Primitives)
ifTrue:
[s append: 'untallied.'.
md 2 ← #()]
ifFalse:
[(md 2) length = 0
ifTrue: [s append: '- unreferenced -']].
class ← #-.
(md 2) sort do:
[:l | l 1 = class
ifTrue: [s append: ', ']
ifFalse:
[class #-
ifTrue: [s cr].
s append: '('.
s append: l 1.
s append: ') '.
class ← l 1].
s append: l 2].
f print: s contents asParagraph].
f close.
f toPrinter].
"235" SystemOrganizer$'Filout and printing'
[filoutCategory: cat | all a |
user displayoffwhile [
(all ← self superclassOrder: cat.
(dp0 file: (cat + '.st.') asFileName) filoutclass: all.
all do: [:a | (Smalltalk a) noChanges])]].
"110" SystemOrganizer$'Filout and printing'
[printAll | cat |
commentVector do: [:cat | self printCategory: cat]].
"174" SystemOrganizer$'Filout and printing'
[printCategory: cat | |
user displayoffwhile [((dp0 file: (cat + '.press') asFileName) printoutclass: (self superclassOrder: cat))]].
"804" SystemOrganizer$'Filout and printing'
[superclassOrder: cat | all lis title i c sup |
"Arrange classes in superclass order so they can be filed in"
lis ← (self category: cat) copy.
all ← (Vector new: lis length) asStream.
[lis length > 0] whileTrueDo:
[i ← 1.
title ← lis i.
sup ← c ← Smalltalk title.
sup ← sup superclass.
[ "Make sure it doesn't have an as yet uncollected superclass"
sup nil or: [(lis has: sup title unique)]] whileFalseDo: [sup ← sup superclass].
[sup nil] whileFalseDo:
[i ← i + 1.
title ← lis i.
sup ← c ← Smalltalk title.
sup ← sup superclass "check as yet uncollected superclass".
[sup nil or: [(lis has: sup title unique)]] whileFalseDo: [sup ← sup superclass]].
all next← title.
lis ← lis delete: title].
↑all contents].
"452" UserView$'Misc System Stuff'
[writeSources: newSources | |
user file: newSources classes: SystemOrganization changesOnly: newSources end "write a new Sources file (usually on [phylum]Smalltalk.Sources.xxx
(i.e. xxx = user versionName))
if it's a new file or empty, write all Sources. otherwise it better be a copy of
the previous Sources file (only changes will be appended. do the copy with ftp)" false.
Sources close.
Sources ← newSources].
"195" UserView$'Misc System Stuff'
[classInit | |
" UserView classInit. "
screenMenu ← Menu new string: 'exit to overview
snapshot
quit
open a subview
open a browser
open a workspace
turtle demo'].
"104" UserView$'Dialog Window'
[next← x | |
disp cr "simulate a Vector Stream".
disp print: x.
disp show].
"555" UserView$'Misc System Stuff'
[writeChangedMessages: ChangedMessages | class m ms |
ChangedMessages settoend "append changed messages to a file (usually on [phylum])".
ChangedMessages cr.
ChangedMessages cr.
ChangedMessages asParagraphPrinter stamp.
class ← ''.
user changedMessages do:
[:m | ms ← m asStream.
(ms upto: 32) = class
ifTrue:
[ChangedMessages append: ', '.
ChangedMessages append: (ms upto: 32)]
ifFalse:
[ChangedMessages cr.
ChangedMessages append: m.
class ← m asStream upto: 32]].
ChangedMessages close].
"318" UserView$'Changes'
[changedCategories | titles space str |
space ← ' ' 1 "return a vector of the names of class categories which have been changed".
titles ← HashSet new init.
Changes contents do: [:str | titles insert: (SystemOrganization invert: ((Stream new of: str) upto: space) unique)].
↑titles contents].
"97" UserView$'Misc System Stuff'
[releaseMessage | |
user clearshow: 'Welcome to ' + user version].
"3060" UserView$'Misc System Stuff'
[systemworkspace1 | |
"for system releasers only!!!
this has been partitioned into three workspaces for editing convenience:
systemworkspace1
steps 0-4: general comments, handling Sources, creating a release.
systemworkspace2
steps 5-7: doing a vmem write or surgery, storing finished files on Phylum
systemworkspace3
step 8: after a release, e.g. updating press files
0. This boot file should be named small.boot for vmem writing, surgery, and command file purposes. If you made changes to the Sources disk be sure to update the current versions of (Xm)Smalltalk.Run, (Xm)Smalltalk.Syms, and (Xm)Byterp.mb on [Ivy]<Smalltalk>. This procedure works best on a Dorado for speed and disk space reasons, and it also can be done on an Alto (double disk O.S. required for vmem write). Microcode changes (including making non-xm versions) must(?) be done on an Alto. Step 5 (vmem writing) assumes enough space for another boot file. To turn off display during execution, hold down left shift key while selecting 'doit'.
For those who want to vmem write their own versions, do not execute steps 4, 7 or 8 without further editing of file and directory names. Underlined items are typical values and normally must be edited to be useful.
1. to create an xm version: filin changes and selected goodies. Undeclared must be empty for release to work (step 4). copy the categories of classes which have changed to systemworkspace3 (for later printing) and recompile it.
dp0 filin: ('changes.st').
phylum filin: ('<Small-goodies>xx.st').
Undeclared contents inVector, user changedCategories
2. update version number/letter and comments in UserView version
3. the Sources file will be ordinarily be created in step 4. if only a few changes are involved, it may be somewhat faster to copy the old sources file to the new sources file (this step). then step 4 will only append changes.
phylum store: Sources reset as: 'Smalltalk.Sources.' + user versionName.
4. checks Undeclared, writes all or appends changed messages to Sources file, updates ChangedMessages, inits Changes, puts up greeting, and sets the default user name & password. note: this is only to be executed for releasing the Smalltalk system itself (supply the proper password!!). if you plan to do a vmem write next, better to do this as first line of step 5.
user releaseExternalViews.
phylum name: 'Smalltalk' password: 'password'.
user release.
phylum name: 'Smalltalk-User' password: 'Smalltalk'.
to write out the sources for a private version, specify which directory to use (don't leave Smalltalk as the default) and which categories and/or classes are to be included.
| c classes. user releaseExternalViews. classes ← (Vector new: 50) asStream.
phylum name: 'name' password: 'password'.
for c from: ('category1' class1) do [
c is: String [classes append: (SystemOrganization category: c)]
classes next ← c].
user file: (phylum file: '<ddd>xx.Sources.' + user versionName)
classes: classes contents changesOnly: false.
"].
"2101" UserView$'Misc System Stuff'
[systemworkspace2 | |
"for system releasers only!!!
5. if no surgery or vmem write involved, skip to step 7. start here with an xm version to make a non-xm version. specify option below:
1 vmem write (includes xm surgery)
2 xm surgery
3 non-xm surgery
to make things totally automatic, edit in your valid Maxc name and password, otherwise Ftp will ask you later (some of the file transfers can be edited out (i.e. if files are already present; also Ramload is superfluous on Dorado). in the case of surgery only, at the end you will have to hit a key after safing.
| option prefix dir file.
option ← 1.
dir ← phylum asFtpDirectory.
dir directoryName: 'Smalltalk-76'.
prefix ← [option=3 [''] 'Xm'].
for file from: ('Smalltalk.Run' 'Smalltalk.Syms' 'Byterp.Mb') do [
dir retrieve: prefix + file as: file].
dir closeThen: ([option=1 ['delete oldsmall.boot;
copy newsmall.boot ← small.boot; '] '']) +
'ftp maxc Login/c yourname yourpassword directory/c alto retrieve/c packmu.run ramload.run;
Resume small.boot;
Ramload/N Byterp.mb/F 1000/A;
Smalltalk.run'.
option=1 [(VirtualMemory new) giveBirth3. user quit]
Vmem ramwrite: (dp0 oldFile: 'byterp.mb').
Vmem surgery: (dp0 oldFile: 'Smalltalk.run').
6. after a successful vmem write or surgery, execute this (selecting here is tricky or type in a Dispframe)
user systemStartup.
7. edit lastversion (and Smalltalk password) and execute the following, then close this window (clean up screen for non-xm?), and quit. it then renames old versions of files, stores new versions of files, e.g. remote XmSmall.Boot becomes XmSmall.Boot.5.5g and local Small.Boot becomes remote XmSmall.Boot
| lastversion dir file remotefile.
lastversion ← '5.5j'.
dir ← phylum asFtpDirectory.
dir login: 'Smalltalk' password: 'password'.
for file from: ('Small.Boot' 'Smalltalk.Syms') do [
remotefile ← ([user hasXM ['Xm'] '']) + file.
dir rename: remotefile newName: remotefile + '.' + lastversion;
store: file as: remotefile].
(dp0 file: 'rem.cm') append: dir commands; cr; close.
user releaseMessage.
"].
"1103" UserView$'Misc System Stuff'
[systemworkspace3 | |
"for system releasers only!!!
8. to update press files for system categories or cross reference listing directly on Phylum, browse or spawn this window. edit pf to specify a list of system categories to print, usually from step 1, e.g. user changedCategories: ('Basic Data Structures' ...) or SystemOrganization categories (for all); delete toPrinter if you don't want the press files printed. edit xref to be user classNames if you want to generate a cross reference listing.
| pf xref cat.
pf ← ('Text Objects' 'Kernel Classes' 'Press File Support' 'IFS File System' 'Alto File System' 'Panes and Menus' 'Files' 'Juniper' 'Windows' 'Graphical Objects' 'Numbers' 'Basic Data Structures' ).
xref ← ().
user releaseExternalViews.
phylum name: 'Smalltalk' password: 'password'.
for cat from: pf do [
((phylum file: (cat + '.Press') asFileName) asPressPrinter) stamp;
printclass: (SystemOrganization category: cat); close; toPrinter].
xref empty []
user printCrossReference: xref on: (phylum file: 'CrossReference.Press').
"].
"921" UserView$'Misc System Stuff'
[initCompilerSpecialize | c code sel i class m bother oldChanges special |
oldChanges ← Changes.
Changes ← HashSet init "Specialize the last 10 selectors".
(1 to: 10) do: [:i | mem (i + 31 + 2) ← (SpecialOops (i + 31)) asOop].
self initCompilerSelectors.
special ← (SpecialOops (32 ~ 41)) copy.
user displayoffwhile [(AllClassNames do:
[:c | user show: c + ' 1'.
user cr.
class ← Smalltalk c.
class md do:
[:sel | "recompile all methods w/special selectors"
m ← class method: sel.
m length 8
ifFalse:
[ "quick"
bother ← false.
(class md literals: sel) do:
[:i | ((i is: UniqueString) and: [(special has: i)])
ifTrue: [bother ← true]].
bother
ifTrue: [class recompile: sel]]].
Changes init])].
PriorityScheduler new initsched.
nil installError.
MessageDict new freeMethods.
Changes ← oldChanges].
"130" UserView$'System quit/resume'
[snapshotPrimitive | |<primitive: 83>
"write the OT and Data of this Smalltalk out"
user croak].
"90" UserView$'Dialog Window'
[clearshow: str | |
disp clear.
disp append: str.
disp show].
"49" UserView$'Dialog Window'
[read | |
↑disp read].
"90" UserView$'Mouse, Cursor, Keys'
[waitnobug | |
[self anybug] whileTrueDo: [].
↑self mp].
"171" UserView$'Window Scheduling'
[unschedule: window | t |
0 < (t ← sched find: window)
ifTrue: [sched ← sched (1 to: t - 1) concat: sched (t + 1 to: sched length)]].
"649" UserView$'Window Scheduling'
[run: topFlag | i w forward |
"topFlag means sched1 already is awake"
forward ← (topFlag
ifTrue:
[w ← sched 1.
[w eachtime] whileTrueDo: [].
w lasttime]
ifFalse: [true]).
[true] whileTrueDo:
[i ← 0.
[(i ← i + 1) > sched length
ifFalse:
[w ← (forward
ifTrue: [sched i]
ifFalse: [sched (sched length + 1 - i)]).
w firsttime]] whileFalseDo: [].
i > sched length
ifTrue:
[ "check for bug in empty space"
user yellowbug
ifTrue: [self bugScreenMenu]]
ifFalse:
[sched promote: w.
[w eachtime] whileTrueDo: [].
forward ← w lasttime]]].
"112" ProjectWindow$'Changing views'
[runParent | |
"leave this view by installing the one above"
parent install].
"95" ProjectWindow$'Window behavior'
[yellowbug | |
actionMenu bug = 1
ifTrue: [self install]].
"87" ProjectWindow$'Initialization'
[classInit | |
actionMenu ← Menu new string: 'enter'].
"95" ProjectWindow$'Window behavior'
[close | |
"break circular links"
userview ← parent ← nil].
"173" ProjectWindow$'Initialization'
[init | |
"a new window"
self userview: (user copyIn: self) changes: HashSet init parent: user projectWindow.
self newframe.
self show].
"133" ProjectWindow$'Initialization'
[userview: t1 changes: t2 parent: t3 | |
"load state"
userview ← t1.
changes ← t2.
parent ← t3].
"212" ProjectWindow$'Changing views'
[putTitle | |
titlepara nil
ifTrue: [titlepara ← 'Top View' asParagraph allBold].
titleframe put: titlepara centered: user screenrect extent x / 3 8.
titleframe outline].
"195" ProjectWindow$'Changing views'
[install | |
"Establish this project and its userview as the current screen view"
Changes ← changes.
(user ← userview) install.
self putTitle.
user restart].
"203" UserView$'Screen Views'
[projectWindow | |
projectWindow nil
ifTrue:
[projectWindow ← ProjectWindow new.
projectWindow userview: self changes: Changes parent: projectWindow].
↑projectWindow].
"63" UserView$'Dialog Window'
[show | |
disp outline.
disp show].
"58" SystemPane$'Initialization'
[to: t1 | |
classPane ← t1].
"88" SystemPane$'Initialization'
[classInit | |
sysmenu ← Menu new string: 'filout
print'].
"317" SystemPane$'Window protocol'
[yellowbug | t1 |
selection < 3
ifTrue: [window flash]
ifFalse: [scrollBar hidewhile [
((t1 ← sysmenu bug) = 1
ifTrue: [SystemOrganization filoutCategory: list selection]
ifFalse:
[t1 = 2
ifTrue: [SystemOrganization printCategory: list selection]])]]].
"191" SystemPane$'Window protocol'
[enter | |
"be sure I am up to date"
mySysOrgVersion user classNames
ifTrue: [super enter]
ifFalse:
[window outline.
self update.
super enter]].
"162" SystemPane$'Initialization'
[update | |
self of: (#(AllClasses SystemOrganization ) concat: SystemOrganization categories).
mySysOrgVersion ← user classNames].
"111" SystemPane$'Window protocol'
[leave | |
"I am up to date"
mySysOrgVersion ← user classNames.
super leave].
"75" SystemPane$'ListPane protocol'
[selected | |
classPane of: self classes].
"80" SystemPane$'ListPane protocol'
[deselected | |
classPane of: (Vector new: 0)].
"657" SystemPane$'Browser protocol'
[compile: parag | class cat className |
selection = 2
ifTrue:
[SystemOrganization fromParagraph: parag.
self update]
ifFalse:
[ "new organization"
cat ← (selection 1
ifTrue: [false]
ifFalse: [list selection]).
class ← nil parag.
(class Is: Class)
ifTrue:
[className ← class title unique.
cat
ifTrue: [SystemOrganization classify: className under: cat].
mySysOrgVersion user classNames
ifTrue:
[selection > 0
ifTrue: [classPane of: (cat
ifTrue: [SystemOrganization category: cat]
ifFalse: [user classNames])]]
ifFalse: [self update]]]].
"256" SystemPane$'Browser protocol'
[noCode | |
selection = 0
ifTrue: [↑''].
selection = 2
ifTrue: [↑SystemOrganization].
↑'Class new title: ''NameOfClass''
subclassof: Object
fields: ''names of fields''
declare: ''names of class variables''' copy].
"61" SystemPane$'Browser protocol'
[dirty | |
↑classPane dirty].
"354" 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].
"242" SystemPane$'Browser protocol'
[classes | |
"return a Vector of the classes in my selected category"
selection = 1
ifTrue: [↑user classNames].
selection 2
ifTrue: [↑Vector new: 0].
↑SystemOrganization category: list selection].
"148" ClassPane$'ListPane protocol'
[deselected | |
organizationPane class: nil "I just lost my selection. Tell organizationPane to display nothing."].
"95" ClassPane$'Initialization'
[classInit | |
editmenu ← Menu new string: 'filout
print
forget'].
"442" ClassPane$'Window protocol'
[yellowbug | t1 |
selection = 0 "If there is a selection, let the user choose a command from the menu."
ifTrue: [window flash]
ifFalse:
[(t1 ← editmenu bug) = 1
ifTrue: [(Smalltalk (list selection) "filout") filout]
ifFalse:
[t1 = 2
ifTrue: [(Smalltalk (list selection) "print") printout]
ifFalse:
[t1 = 3
ifTrue: [systemPane forget: list selection "forget"]]]]].
"73" ClassPane$'Window protocol'
[close | |
systemPane ← nil.
super close].
"78" ClassPane$'Browser protocol'
[compile: parag | |
systemPane compile: parag].
"208" ClassPane$'ListPane protocol'
[selected | |
organizationPane class: Smalltalk (list selection) "My selection just changed. Tell organizationPane to display the categories of my newly selected Class."].
"67" ClassPane$'Browser protocol'
[dirty | |
↑organizationPane dirty].
"96" ClassPane$'Browser protocol'
[noCode | |
selection = 0
ifTrue: [↑systemPane noCode].
↑''].
"91" ClassPane$'Initialization'
[from: t1 to: t2 | |
systemPane ← t1.
organizationPane ← t2].
"197" OrganizationPane$'Browser protocol'
[spawn: selector with: parag formerly: oldparag | |
selectorPane compselection.
selectorPane select: 0.
class edit: selector para: parag formerly: oldparag].
"197" OrganizationPane$'Initialization'
[listFor: t1 | |
class ← t1.
↑class nil
ifTrue: [Vector new: 0]
ifFalse: [#(ClassDefinition ClassOrganization ) concat: class organization categories]].
"70" OrganizationPane$'Browser protocol'
[dirty | |
↑selectorPane dirty].
"263" OrganizationPane$'Browser protocol'
[forget: selector | cat |
class derstands: selector.
cat ← list selection.
self revise: (self listFor: class) with: cat.
selection > 0
ifTrue: [selectorPane revise: (class organization category: cat) with: selector]].
"93" OrganizationPane$'Initialization'
[from: t1 to: t2 | |
classPane ← t1.
selectorPane ← t2].
"156" OrganizationPane$'ListPane protocol'
[deselected | |
selectorPane of: (Vector new: 0) "I just lost my selection. Tell selectorPane to display nothing."].
"95" OrganizationPane$'Initialization'
[classInit | |
editmenu ← Menu new string: 'filout
print'].
"621" OrganizationPane$'Window protocol'
[yellowbug | t1 |
selection 1 "If there is a selection, let the user choose a command from the menu."
ifTrue: [window flash]
ifFalse:
[ "Can't filout or print definition by itself"
(t1 ← editmenu bug) = 1
ifTrue:
[selection = 2 "filout the selected category"
ifTrue: [class filoutOrganization]
ifFalse: [class filoutCategory: list selection]]
ifFalse:
[t1 = 2
ifTrue:
[selection = 2 "print the selected category"
ifTrue: [window flash]
ifFalse: [ "Can't print organization"
class printoutCategory: list selection]]]]].
"79" OrganizationPane$'Window protocol'
[close | |
classPane ← nil.
super close].
"81" OrganizationPane$'Browser protocol'
[code: selector | |
↑class code: selector].
"168" OrganizationPane$'As yet unclassified'
[syntaxChoice | |
"kludge for new choosing syntax"
class nil
ifFalse:
[class usesNewSyntax
ifTrue: [↑class new]]].
"654" OrganizationPane$'Browser protocol'
[compile: parag | sel cat |
(class nil or: [selection = 1])
ifTrue: [classPane compile: parag]
ifFalse:
[ "new definition"
selection = 2
ifTrue:
[class organization fromParagraph: parag.
self class: class]
ifFalse:
[ "new organization"
cat ← (selection = 0
ifTrue: ['As yet unclassified']
ifFalse: [list selection]).
(sel ← selectorPane compile: parag in: class under: cat)
ifTrue:
[self revise: (self listFor: class) with: cat.
selection 0
ifTrue: [selectorPane revise: (class organization category: cat) with: sel]]
ifFalse: [↑false]]]].
"174" OrganizationPane$'ListPane protocol'
[selected | |
selectorPane of: (selection 2
ifTrue: [Vector new: 0]
ifFalse: [class organization category: list selection])].
"349" OrganizationPane$'Browser protocol'
[noCode | |
class nil
ifTrue: [↑classPane noCode].
selection = 0
ifTrue: [↑''].
selection = 1
ifTrue: [↑class definition].
selection = 2
ifTrue: [↑class organization].
↑'Message name and Arguments | Temporary variables | "short comment"
"long comment if necessary"
Smalltalk
Statements'].
"96" OrganizationPane$'Initialization'
[class: t1 | |
class ← t1.
self of: (self listFor: class)].
"74" OrganizationPane$'Browser protocol'
[execute: parag | |
↑class parag].
"130" SelectorPane$'Browser protocol'
[compile: parag in: class under: heading | |
↑codePane compile: parag in: class under: heading].
"91" SelectorPane$'Initialization'
[classInit | |
editmenu ← Menu new string: 'spawn
forget'].
"355" SelectorPane$'Window protocol'
[yellowbug | t1 |
selection = 0
ifTrue: [window flash]
ifFalse: [scrollBar hidewhile [
((t1 ← editmenu bug) = 1
ifTrue: [organizationPane spawn: list selection with: codePane contents formerly: codePane oldContents]
ifFalse:
[t1 = 2
ifTrue: [organizationPane forget: list selection]])]]].
"82" SelectorPane$'Window protocol'
[close | |
organizationPane ← nil.
super close].
"160" SelectorPane$'Browser protocol'
[execute: parseStream for: t2 | |
codePane ← t2.
↑codePane execute: parseStream in: false to: organizationPane syntaxChoice].
"94" SelectorPane$'ListPane protocol'
[deselected | |
codePane showing: organizationPane noCode].
"88" SelectorPane$'Browser protocol'
[compile: parag | |
↑organizationPane compile: parag].
"110" SelectorPane$'ListPane protocol'
[selected | |
codePane showing: (organizationPane code: list selection)].
"62" SelectorPane$'Browser protocol'
[dirty | |
↑codePane dirty].
"92" SelectorPane$'Initialization'
[from: t1 to: t2 | |
organizationPane ← t1.
codePane ← t2].
"727" BrowseWindow$'Initialization'
[default | systemPane classPane orgPane selectorPane codePane |
"Let the user draw a five-paned window to browse through classes."
systemPane ← SystemPane new "Create the panes.".
classPane ← ClassPane new.
orgPane ← OrganizationPane new.
selectorPane ← SelectorPane new.
codePane ← CodePane new "Acquire them.".
self title: 'Classes' with: {systemPane , classPane , orgPane , selectorPane , codePane} at: stdTemplates.
self newframe.
self show "Interconnect them.".
systemPane to: classPane.
classPane from: systemPane to: orgPane.
orgPane from: classPane to: selectorPane.
selectorPane from: orgPane to: codePane.
codePane from: selectorPane "Display them.".
systemPane update].
"187" BrowseWindow$'Initialization'
[classInit | |
stdTemplates ← {(0 0 rect: 10 14) , (10 0 rect: 18 14) , (18 0 rect: 28 14) , (28 0 rect: 36 14) , (0 14 rect: 36 36)}].
"799" UserView$'Screen Views'
[bugScreenMenu | n i t3 |
(t3 ← screenMenu bug) = 1
ifTrue:
[projectWindow nil
ifFalse: [projectWindow runParent]]
ifFalse:
[t3 = 2
ifTrue: [user snapshot]
ifFalse:
[t3 = 3
ifTrue: [user quit]
ifFalse:
[t3 = 4
ifTrue: [self schedule: ProjectWindow init]
ifFalse:
[t3 = 5
ifTrue: [self schedule: BrowseWindow default]
ifFalse:
[t3 = 6
ifTrue: [self schedule: (CodeWindow new class: UserView selector: #workspace para: (UserView code: #workspace) formerly: false)]
ifFalse:
[t3 = 7
ifTrue:
[n ← Turtle init.
n color: black.
n width: 4.
n inking: oring.
(1 to: 50) do:
[:i | n go: i * 4.
n turn: 89]]]]]]]]].
"91" UserView$'Screen Views'
[color: t1 scale: t2 | |
color ← t1.
scale ← t2.
self install].
"397" UserView$'As yet unclassified'
[NTshrink | i j |
self NTshrink1.
UserView understands: 'NTshrink1' "1st time only".
Undeclared init.
(1 to: USTable length) do: [:i | "delete obsolete atoms"
(1 to: (USTable i) length) do:
[:j | (USTable i j) refct = 1
ifTrue: [USTable i j ← nil]]].
#a rehash "shrink USTable".
user 'disp' of: (String new: 256) "reduce disp buffer"].
"75" UserView$'Window Scheduling'
[promote: window | |
sched promote: window].
"150" UserView$'Mouse, Cursor, Keys'
[kbck | t |
(t ← self rawkbck)
ifTrue: [↑kbMap t].
NoteTaker
ifTrue: [↑false].
self purgealittle.
↑false].
"90" UserView$'Dialog Window'
[clear | |
"clear disp of debris and characters"
disp clear].
"90" UserView$'Mouse, Cursor, Keys'
[waitbug | |
[self anybug] whileFalseDo: [].
↑self mp].
"331" UserView$'Time'
[dateAndTime: secs | |
↑self convertTime: (self rawtotalsecs: secs) "secs is a String of 4 characters representing seconds (in GMT) since Jan 1 1901.
convert it to a LargeInteger (rawtotalsecs:), then return a Vector (Date, Time),
which is corrected for local time zone and daylight savings" returnSecs: false].
"336" UserView$'Time'
[rawtotalsecs: secs | s |
s ← Natural new: 4 "secs is a String of 4 characters representing seconds (in GMT) since Jan 1 1901.
copy (in reverse order) to a Natural string, then return a LargeInteger".
s 1 ← secs 4.
s 2 ← secs 3.
s 3 ← secs 2.
s 4 ← secs 1.
↑LargeInteger new bytes: s neg: false].
"163" UserView$'Time'
[totalsecs: secs | |
↑self convertTime: (self rawtotalsecs: secs) "convert from GMT to local and correct for Daylight Savings" returnSecs: true].
"58" UserView$'Window Scheduling'
[topWindow | |
↑sched 1].
"272" UserView$'System quit/resume'
[st80FileInit | |
" user st80FileInit. "
dp0 release.
SourceFiles ← Vector new: 4.
SourceFiles 1 ← dp0 file: 'ST80Sources.v00'.
(SourceFiles 1) readonly.
SourceFiles 2 ← dp0 file: 'ST80Changes.v00'.
(SourceFiles 2) readonly].
"123" UserView$'Mouse, Cursor, Keys'
[yellowbug | |
↑self buttons "From Smalltalk 5.4i on 30 October 1979 at 2:28:57 pm." = 2].
"599" UserView$'Misc System Stuff'
[file: file classes: classes changesOnly: ch | cl |
"called by UserView release to write just changes or entire system on a
new file. also, see comment in Class archiveOn:changesOnly:.
write class comment and message text onto a FileStream (which could refer
to an AltoFile, ILFile, etc.). either just changes or everything are
written and replaced with RemoteParagraph references"
ch
ifTrue: [file settoend]
ifFalse: [file reset].
file readwriteshorten.
classes do: [:cl | Smalltalk cl archiveOn: file changesOnly: ch].
file close.
file readonly].
"70" UserView$'As yet unclassified'
[save | |<primitive: 75>
user croak].
"381" UserView$'Window Scheduling'
[restartup: window | |
NoteTaker
ifTrue: [ "Equivalent to schedule new window, restart, and redbug in window, except firsttime is already done."
self schedule: window]
ifFalse:
[thisContext sender releaseFully.
thisContext sender← nil.
NormalCursor topage1.
self schedule: window.
thisContext tempframe all← nil.
self run: true]].
"290" ILFileDirectory$'Dictionary'
[Find: file | |
↑self openFile: file mode: "since there can be many readers but only one writer, default mode is for
read only. writing will cause file to be closed and reopened for writing"
(file type = write
ifTrue: [WriteOld]
ifFalse: [ReadOld])].
"102" ILFileDirectory$'IFS'
[allocatePage | |
isocket nil
ifTrue: [self open].
↑isocket freePacket].
"58" ILFile$'IFS'
[allocatePage | |
↑directory allocatePage].
"180" ILFile$'File'
[endFile: page | |
self writeMode: page "make sure we can write" "update length. this will end file with this page".
lastpn ← page pageNumber.
↑self Write: page].
"280" ILFile$'File'
[Read: page | |
page pageNumber > lastpn
ifTrue: [↑false].
"no page" "don't extend beyond eof. length of page is 0, but request is for 512 bytes"
page mode: NoExtend.
page header: 5 ← 512 "self dataLength".
↑self doCommand: Read page: page error: 'Read:'].
"345" ILFilePage$'IFS'
[mode: m | |
page 29 ← (page 29 "current meaning of 5 read/write bits (from high to low):
0-1
0 read or write anywhere
1 no holes (read or write) zeros past end
2 don't extend on read or write
3 check extend (Error)
2
1 set eof
3-4
0 undefined" "m is a byte which is already shifted" land: 7) + m].
"123" ILFilePage$'FilePage'
[serialNumber | sn |
sn ← String new: 4.
sn 1 ← sn 2 ← 0.
sn word: 2 ← self header: 2.
↑sn].
"75" ILFilePage$'FilePage'
[serialNumber: sn | |
self header: 2 ← sn word: 2].
"338" ILFilePage$'FilePage'
[length: len | |
self header: 1 ← 10 + len "10 bytes in a normal header block. ILParameterBlock can change things.
also negative lengths can shorten it and change pupLength" "length of command block, including data" "number of data bytes to read/write".
self header: 5 ← len "set pupLength".
super length: len].
"57" ILFilePage$'FilePage'
[headerLength | |
↑34 "4+20+10"].
"79" ILFilePage$'FilePage'
[length | |
↑self header: 5 "valid for read or write"].
"354" ILFilePage$'FilePage'
[pageNumber | |
↑((self header: 3) "extract page number from 27-bit byte address. ignore high 5 mode bits.
dividing byte adress (which may be a LargeInteger) by self dataLength (512)
is the correct but slow way to do this. byte address 0 = page 1" land: 2047) * 128 "lshift: 7, maybe large" + ((self header: 4) lshift: 9) + 1].
"197" ILFilePage$'FilePage'
[pageNumber: pn | |
pn ← pn - 1 "inverse of pageNumber. set 5 mode bits to 0".
self header: 3 ← pn / 128 "lshift: 7, except for large pn".
self header: 4 ← pn lshift: 9].
"447" ILFilePage$'IFS'
[command: com | |
page pupType← LeafType "operation word (header 1)
0-4
opcode
5
0 request
1 answer
6-15
inclusive byte length of operation block" "make operation a request, preserve length set earlier".
page 25 ← (page 25 land: 3) + (com lshift: 3) "left half pupID1".
page 11 ← (com = Reset
ifTrue: [OpenConnection]
ifFalse:
[com = Quit
ifTrue: [DestroyConnection]
ifFalse: [Data]])].
"117" EtherFilePage$'FilePage'
[init | |
page nil
ifTrue: [page ← file allocatePage "self page:"].
self length: 0].
"89" EtherFilePage$'FilePage'
[length: len | |
page pupLength← len + self headerLength - 2].
"60" EtherFilePage$'FilePage'
[dataString | |
↑page pupString].
"112" EtherFilePage$'FilePage'
[headerLength | |
↑44 "ethernet encap.(4), pup header(20), file label (20=default)"].
"82" EtherFilePage$'FilePage'
[length | |
↑page pupLength - (self headerLength - 2)].
"61" EtherFilePage$'FilePage'
[trailerLength | |
↑2 "checksum"].
"178" EtherFilePage$'FilePage'
[header: n | |
↑page word: 12 + n "for accessing information after pup header, e.g. file commands and parameters.
n = 1 to (self headerLength-24)/2"].
"52" EtherFilePage$'Ether'
[pupType | |
↑page pupType].
"58" EtherFilePage$'Ether'
[pupType← p | |
↑page pupType← p].
"72" EtherFilePage$'FilePage'
[header: n ← v | |
↑page word: (12 + n) ← v].
"43" EtherFilePage$'Ether'
[packet | |
↑page].
"51" ILFile$'Dictionary'
[entryClass | |
↑ILFilePage].
"885" ILFile$'File'
[classInit | i sym names |
ILFilePool declare: #NotFound as: '207' "ILFile classInit.".
names ← #(1011 (BadLeafHandle ) 1024 (AnswerBit ) 1024 (RequestBits ) 176 (LeafType ) 0 (Error Open Close Delete ) 6 (Read Write Reset ) 96 (SetEof ) 128 (NoExtend ) 64 (NoHoles ) 6400 (WriteOld ) 30976 (ReadOld ) 4224 (CreateNew ) 0 (Data Ack Noop ) 5 (OpenConnection ) 9 (DestroyConnection Dally Quit BrokenConnection ) ) asStream "5-bit operations for left field command block word" "read/write modes" "no holes, set eof" "don't extend file on read or write" "for writing past end" "open file modes" "read, write, extend, any explicit, highest" "read, any explicit, highest" "read, write, extend, create, any explicit, next" "control codes for left half of pupID1 field" "if Reset".
names do: [:i | names next do:
[:sym | ILFilePool declare: sym as: i.
i ← i + 1]]].
"134" ILFile$'File'
[close | |
self close: "ignore errors if file was readonly"
(type = read
ifTrue: [false]
ifFalse: ['close'])].
"1313" ILFile$'File'
[doCommand: com page: page error: e | in ecode t6 |
page command: com.
[true] whileTrueDo:
[directory open "make sure connection is open".
error ← nullString.
(in ← directory socket sendPacket: page packet)
ifTrue:
[in 11 = BrokenConnection
ifTrue: [ecode ← 1]
ifFalse:
[ "turn packet into a ILFilePage"
in ← ((t6 ← self entryClass new) dictionary: self.
t6 page: in) "check if answer is of same type as request".
((page header: 1) land: RequestBits) + AnswerBit = ((in header: 1) land: RequestBits)
ifTrue: [↑in].
ecode ← in header: 2]]
ifFalse: [ "no response?"
ecode ← false] "some kind of problem".
com = Quit
ifTrue: [↑false].
"ignore"
(ecode false or: [ecode = 1])
ifTrue: [directory release "make new connection"].
(ecode = 1 or: [ecode = 1011])
ifTrue:
[self reopen "try again after some reinitializing" "reopen file" "init page with new handle only -- don't lose mode, length, etc.".
page serialNumber: serialNumber]
ifFalse:
[error ← (ecode
ifTrue:
[e
ifTrue: [self errorString: ecode]
ifFalse: [ecode asString]]
ifFalse: [directory directory + ' not responding']).
e
ifTrue: [self error: e "proceeding tries again"]
ifFalse: [↑false]]]].
"1316" ILFile$'File'
[errorString: errorCode | ef ename errorString notfound dollar cr t8 |
(errorCode is: String)
ifTrue:
[errorString ← errorCode.
errorCode ← ((errorString 1) isdigit
ifTrue: [errorString asInteger]
ifFalse: [0])]
ifFalse: [errorString ← errorCode asString].
ename ← '<System>Ifs.Errors'.
(self name compare: ename) = 2
ifTrue: [↑errorString + ' (cannot access Ifs.Errors !!!)' "recursion"].
notfound ← errorString + ' (error code not found)'.
errorCode 0
ifTrue: [↑notfound].
dollar ← '$' 1.
cr ← 13.
ef ← directory oldFile: ename.
ef readonly.
errorString ← false "scan through the errors file looking for lines of the form:
$$nn some message
".
[errorString] whileFalseDo:
[(ef skipTo: dollar)
ifTrue:
[ef next = dollar
ifTrue:
[(t8 ← ef integerScan "valid line") > errorCode
ifTrue: [errorString ← notfound "since errors are ordered"]
ifFalse:
[t8 = errorCode
ifTrue:
[errorString ← (String new: 200) asStream.
errorString print: errorCode.
[ef peek = dollar or: [ef peek = cr]] whileFalseDo:
[errorString append: (ef upto: cr).
errorString space].
errorString ← errorString contents]]]]
ifFalse: [ "end of file"
errorString ← notfound]].
ef close.
↑errorString].
"385" ILFile$'File'
[writeMode: page | |
type = write "make sure we can write on file"
ifFalse:
[ "turn on writing by closing and reopening file. eventually there might be
a simpler way to change file mode"
self close.
type ← write.
(directory Find: self)
ifTrue: [page serialNumber: serialNumber "file handle changed"]
ifFalse: [self error: 'file failed to reopen']]].
"69" ILFile$'File'
[findLastPage | |
↑lastpn "already known from open"].
"245" ILFile$'File'
[close: e | p |
type ← read "close file, possibly ignoring errors" "for next open" "shorten header block to first 2 words: command&length, file handle".
p ← self newPage.
p length: 6.
self doCommand: Close page: p error: e].
"392" ILFile$'File'
[Write: page | pn |
(pn ← page pageNumber) > (lastpn + 1)
ifTrue: [self error: 'illegal page number']
ifFalse:
[ "make sure we can write"
self writeMode: page.
page mode: (pn lastpn
ifTrue: [SetEof]
ifFalse: [NoHoles]).
self doCommand: Write page: page error: 'Write:' "file possibly extended".
pn = (lastpn + 1)
ifTrue: [lastpn ← pn].
↑page]].
"78" ILFile$'File'
[open | |
"do nothing. lastpn set by ILFileDirectory Find:"].
"48" ILFile$'File'
[release | |
self close: false].
"56" ILFileDirectory$'Dictionary'
[entryClass | |
↑ILFile].
"46" ILFileDirectory$'IFS'
[socket | |
↑isocket].
"86" ILFileDirectory$'IFS'
[name: t1 password: t2 | |
userName ← t1.
userPassword ← t2].
"221" ILFileDirectory$'Dictionary'
[Delete: file | t2 |
(t2 ← file newPage "delete a file (highest version)
shorten header block to 2 words: command&length, file handle") length: 6.
t2 doCommand: Delete error: 'Delete:'].
"164" ILFileDirectory$'Dictionary'
[Insert: file | |
file type: write.
(self openFile: file mode: CreateNew)
ifTrue: [↑file].
file error: 'Insert: cannot create'].
"58" ILFileDirectory$'Dictionary'
[versionNumbers | |
↑true].
"61" ILFileDirectory$'Dictionary'
[obsolete | |
↑isocket nil].
"95" ILFileDirectory$'IFS'
[noAck | |
isocket noAck "an optimization for intense ether activity"].
"118" ILFileDirectory$'IFS'
[userName | |
(userName nil or: [userName empty])
ifTrue: [↑super userName].
↑userName].
"284" ILSocket$'Socket'
[timerFired | |
(result or: [abortTransfer]) "timer has fired -- retransmit or abort"
ifFalse:
[ "bug?--timer may not have been disabled yet"
self timerOn
ifTrue: [self completePup: outPac "retransmit"]
ifFalse: [ "abort"
abortTransfer ← true]]].
"381" ILSocket$'Socket'
[socProcess: Ipac | |
(Ipac 12 "check if this is a packet we want. normally left half of pupID1 = Data (0).
in case of DestroyConnection, control code might be Dallying (10)" "pupID1" = seqNum and: [Ipac pupType = LeafType])
ifTrue:
[self timerOff "turn off timer, save result".
result ← Ipac]
ifFalse: [ "recycle packet"
self freePacket: Ipac]].
"1346" ILSocket$'Socket'
[sendPacket: t1 | nseq |
outPac ← t1.
result ← abortTransfer ← false "send a packet, wait for result, and acknowledge.
RetransmitSocket setAddressesAndComplete: sets timer
ILSocket socProcess: receives answers
ILSocket timerFired handles retransmissions" "alloc, receiver seq".
outPac pupID0← outPac 12 ← seqNum "command, send seq" "pupID1 ← (outPac pupID1 land: 0177400) +".
self setAddressesAndComplete: outPac "while waiting for packet to arrive, set up ack".
nseq ← seqNum + 1 \ 256.
outPac 11 = DestroyConnection
ifTrue:
[ "assume reply will be Dally. send Quit to shut down connection a little faster"
outAck
ifFalse:
[ "create ack"
self setAck.
outAck pupID0← outAck 12 ← seqNum].
outAck 11 ← Quit.
retransMax ← 0 "same sequence numbers as previous"]
ifFalse:
[outAck
ifTrue: [outAck pupID0← outAck 12 ← nseq "acknowledgement for Open & Data"] "in rapid interchanges, the next request is an implicit ack, so it's faster not to send one. however, packets unacknowledged for ~5 secs. at the server end can cause degraded performance"] "now wait for socProcess: to set result, or timerFired to set abortTransfer".
[result or: [abortTransfer]] whileFalseDo: [].
result
ifTrue:
[seqNum ← nseq.
outAck
ifTrue: [self completePup: outAck "send ack"]].
↑result].
"84" ILSocket$'Socket'
[noAck | |
outAck ← false "if acknowledgements are not needed"].
"204" ILSocket$'Socket'
[setAck | |
outAck ← self freePacket "create acknowledgement packet".
outAck pupType← LeafType.
outAck dataString← '' "control code".
outAck 11 ← Ack.
self setAddresses: outAck].
"226" ILSocket$'Socket'
[net: n host: h | |
seqNum ← 0 "usually called by hostName:".
super net: n host: h soc: 35 asInt32.
self retransmit: 8 every: (n = NETNUM
ifTrue: [400]
ifFalse: [ "same net"
1800]).
self setAck].
"147" ILParameterBlock$'Initialization'
[packet← t1 | |
packet ← t1.
self position: 26 "default is an empty (data) packet, except first header word"].
"165" ILParameterBlock$'Changing values'
[nextword← w | strm |
strm ← packet pupString asStream.
strm skip: position.
strm nextword← w.
self position: strm position].
"209" ILParameterBlock$'Changing values'
[nextString← s | strm |
strm ← packet pupString asStream.
strm skip: position.
strm nextword← s length.
strm append: s.
strm padNext← 0.
self position: strm position].
"239" ILParameterBlock$'Changing values'
[position: t1 | |
position ← t1.
packet pupLength← position - 2 "changing length of data in packet" "set inclusive byte length in first command word; rest set later".
packet word: 13 ← position - 24].
"604" ILFileDirectory$'Dictionary'
[open | page t2 |
isocket nil "self obsolete"
ifTrue:
[(isocket ← ILSocket new hostName: directory "name of IFS/Leaf server")
ifFalse:
[isocket ← nil.
user notify: directory + ' (name not found)'].
super open.
page ← self newPage "treat packet in page as a parameter block".
(t2 ← ILParameterBlock new) packet← page packet.
t2 nextword← 0 "host number (0 = this, 1 = all)".
t2 nextString← self userName.
t2 nextString← self userPassword.
(page doCommand: Reset error: false)
ifFalse:
[isocket ← nil.
user notify: 'open (reset)']]].
"271" ILFileDirectory$'Dictionary'
[release | t1 |
self obsolete
ifFalse:
[ "shorten header block to 0 words.
DestroyConnection. after this the connection is gone"
(t1 ← self newPage) length: 10.
t1 doCommand: Quit error: false.
isocket close.
isocket ← nil]].
"1273" ILFileDirectory$'IFS'
[openFile: file mode: m | page t4 |
self open "open bit modes
read
write
extend
multiple (0)
create name
explicit version in name (2b)
no, old, next or old, any
default (if no version specified) (2b)
no, lowest, highest, next
unused (7b)".
page ← file newPage "treat packet in page as a parameter block".
(t4 ← ILParameterBlock new) packet← page packet.
t4 nextword← 0 "file handle".
t4 nextword← m "modes".
t4 nextString← self userName.
t4 nextString← self userPassword.
t4 nextString← '' "connect name".
t4 nextString← '' "connect password".
t4 nextString← self checkName: file name "answer bits (in page header: 5)
same (5b)
version (4b)
bad, default lowest, default highest, default next, !*, !L, !H, !N, explicit old, explicit lowest, explicit highest, explicit next, explicit new, explicit-less, explicit between, explicit greater".
(page ← file doCommand: Open page: page error: false)
ifTrue:
[file serialNumber: page serialNumber "open returns file length".
file lastPage: (page pageNumber - (((page header: 4) land: 511) = 0
ifTrue: [1]
ifFalse: [ "full last page"
0]) max: 1)]
ifFalse:
[file error = NotFound
ifTrue: [↑false].
↑file error: 'open ' + (file errorString: file error)]].
"138" ILFileDirectory$'IFS'
[userPassword | |
(userPassword nil or: [userPassword empty])
ifTrue: [↑super userPassword].
↑userPassword].
"875" UserView$'Misc System Stuff'
[release | m |
(m ← Undeclared contents "prepare to release this version (after editing UserView version)
and possibly copying Sources file (see writeSources:)") length > 0
ifTrue: [user notify: 'Undeclared contains ' + m asString]
ifFalse:
[user displayoffwhile [
(m ← Sources directory "either create a new Sources file (write all messages) or append only changes" checkName: '<Smalltalk>Smalltalk.Sources.' + user versionName "for repeated releases in same version.
should also work for Sources local (if renamed)".
user writeSources: (m = Sources name
ifTrue: [Sources]
ifFalse: [Sources directory file: m]) "make workspace local".
UserView md code: #workspace ← UserView code: #workspace.
user writeChangedMessages: (phylum file: '<Smalltalk>ChangedMessages'))].
user noChanges.
user releaseMessage]].
"78" UserView$'As yet unclassified'
[primKbdPeek | |<primitive: 44>
↑self croak].
"78" UserView$'As yet unclassified'
[primKbdNext | |<primitive: 45>
↑self croak].
"208" UserView$'Window Scheduling'
[restart | i |
Events nil
ifTrue:
[Events ← EventQueue init "Top init3. initialize Event queue and Time interrupt"].
NormalCursor topage1.
self restart [(user run)]].
"200" UserView$'Mouse, Cursor, Keys'
[cursorloc← pt | |
NoteTaker
ifTrue: [↑self primCursorLoc← pt - (mxoffset myoffset)].
mem 276 ← pt x - mxoffset * scale.
mem 277 ← pt y - myoffset * scale].
"96" UserView$'Dialog Window'
[frame | |
"return rectangle of dialogue window"
↑disp text frame].
"119" VariableLengthClass$'Initialization'
[classInit | |
"gets propagated to a dummy instance"
(self new: 1) classInit].
"269" VariableLengthClass$'Instance access'
[allInstances | |
user notify: 'use allInstances: instead to specify the length range' "the length ranges are 0,1,2,3,4,5,6,7,8 individually and groups 9 (to 16), 17 (to 32), 33 (to 64), 65, 129, 257, 513, 1025, 2049, and 4197"].
"214" VariableLengthClass$'Instance access'
[howMany: len | v |
"how many instances of this class and length are in use now?"
v ← self allInstancesEver: len.
thisContext destroyAndReturn: v length - (v count: nil)].
"405" VariableLengthClass$'Instance access'
[new: length | |<primitive: 30>
length > 16384
ifTrue: [user notify: length asString + ' is too big a String']
ifFalse:
[length > 8192
ifTrue: [user notify: length asString + ' is too big a Vector']
ifFalse:
[length < 0
ifTrue: [user notify: length asString + ' -- negative length is invalid']
ifFalse: [↑self new: length asInteger]]]].
"142" VariableLengthClass$'Instance access'
[copy: inst | t i |
t ← self new: inst length.
(1 to: inst length) do: [:i | t i ← inst i].
↑t].
"153" VariableLengthClass$'Instance access'
[recopy: inst | t i |
t ← self new: inst length.
(1 to: inst length) do: [:i | t i ← (inst i) recopy].
↑t].
"602" VariableLengthClass$'Instance access'
[allInstancesEver: len | indx vec PCLs i |
"returns a vector containing all instances of this class and length mixed with nils"
NoteTaker
ifTrue: [user notify: 'not implemented']
ifFalse:
[ "for large lengths, instances come in groups with lengths within a single power of 2"
PCLs ← Vmem pclassesOf: self length: len "vector of PCLs".
vec ← Vector new: 128 * PCLs length.
(1 to: PCLs length) do: [:i | vec (i - 1 * 128 + 1 to: i * 128) all← PCLs i].
thisContext destroyAndReturn: (self fromFreelist: (Vmem freelistOffset: len) fill: vec)]].
"101" VariableLengthClass$'Instance access'
[allInstances: len | |
↑(self allInstancesEver: len) notNil].
"97" VariableLengthClass$'Instance access'
[new | |
user notify: 'use new: <Integer=length> here.'].
"63" VariableLengthClass$'Instance access'
[isVariable | |
↑true].
"423" UserView$'Misc System Stuff'
[classNames | classes x c |
"an alphabetized Vector of all Smalltalk class titles uniqued"
AllClassNames nil
ifTrue:
[classes ← (Vector new: 20) asStream.
Smalltalk do:
[:x | c ← Smalltalk x.
((c is: Class) or: [(c is: VariableLengthClass)])
ifTrue: [classes next← x]
ifFalse:
[]].
AllClassNames ← classes contents sort]
ifFalse:
[.
↑AllClassNames]].
"66" UserView$'Mouse, Cursor, Keys'
[nobug | |
↑self anybug false].
"156" UserView$'System quit/resume'
[hasXM | |
NoteTaker
ifTrue: [ "return true if this is XM Smalltalk"
↑true].
↑mem 103 0 "1 for XM, 0 for normal"].
"69" UserView$'System quit/resume'
[quit | |
self quitFrom: self "yup"].
"43" UserView$'Time'
[time | |
↑self now 2].
"355" UserView$'Mouse, Cursor, Keys'
[kbd: char | |
"stuff char into the event queue"
(char is: String)
ifTrue: [char ← char 1].
Events next← UserEvent new x: self x "event x" y: self y "event y" type: 1 stroke: (kbMap find: char) "2=up, 1=down" elapsed: Events elapsedtime "1-336" "1-32767 sixtieths of a sec" time: Events time + Events elapsedtime].
"59" UserView$'System quit/resume'
[Swat | |<primitive: 75>
].
"360" UserView$'System quit/resume'
[releaseExternalViews | t |
Sources close "close some things that we know about, everything else gets released".
dp0 close.
dp1 close "release (obsolete) some external views, usually File related".
(externalViews length to: 1 by: 1) do:
[:t | (externalViews t) release.
externalViews t ← nil].
externalViews reset].
"341" UserView$'As yet unclassified'
[calibrate | t1 t2 |
user primPort: 330 mask: 0 ← 32 "center display".
((50 50) asRectangle inset: 4) comp.
((550 350) asRectangle inset: 4) comp.
user waitclickbug.
t1 ← (user touchPrim: 1) (user touchPrim: 0).
user waitclickbug.
t2 ← (user touchPrim: 1) (user touchPrim: 0).
↑t1 rect: t2].
"315" UserView$'As yet unclassified'
[mapDisplay | t1 |
(DisplayBLTer ← BitBlt init) sourceForm: DisplayForm.
DisplayBLTer destForm: DisplayForm.
(t1 ← BitBlt init) sourceForm: currentCursor asForm.
t1 destForm: DisplayForm.
t1 sourceRect: (0 0 rect: currentCursor extent).
t1 effect: oring.
t1 installDisplay].
"65" UserView$'Mouse, Cursor, Keys'
[bluebug | |
↑self buttons = 1].
"64" UserView$'Mouse, Cursor, Keys'
[anykeys | |
↑self keyset > 0].
"237" UserView$'Mouse, Cursor, Keys'
[buttons | t |
NoteTaker
ifTrue: [↑self primMouseKeys land: 7].
t ← 7 - (mem 488 land: 7).
t = 0
ifTrue: [↑t].
↑(t land: 1) * 2 + ((t land: 2) "force red-yel-blu to 4-2-1" / 2) + (t land: 4)].
"83" UserView$'As yet unclassified'
[cursorLink: bool | |<primitive: 75>
↑self croak].
"316" UserView$'As yet unclassified'
[displayHeight: h | |
h ← h | 16.
DisplayForm refct > 4
ifTrue: [user croak]
ifFalse:
[user currentDisplay: (Form new extent: 640 16 bits: (String new: 16 * 80) offset: nil).
user currentDisplay: (Form new extent: 640 h bits: (String new: h * 80) offset: nil).
↑h]].
"84" UserView$'As yet unclassified'
[primCursorLoc← pt | |<primitive: 43>
↑self croak].
"919" UserView$'As yet unclassified'
[NTpreshrink | i |
Class derstands: #(archiveOn:changesOnly: asFollows bytesof: changelist: endCategoryOn: endChangesOn: filout filoutCategory: filoutOrganization paraprinton: printCategory:on: printMethod:on: printout printoutCategory: readfrom: readfrom:format: startCategory:on: startChangesOn: textLocal ).
UserView derstands: #(backup changedClasses file:classes:changesOnly: hasXM initCompiler makeSources: oopsToFile printCrossReference: quitFrom: reclaim release sourcesTo:changesOnly: systemStartup time NTpreshrink ).
Paragraph derstands: #(bravoRuns fromBravo toBravo applyBravo:at:to: ).
Form derstands: #(newbrush: blinkbrush: line: arc: resize: edit: classInit ).
Number derstands: #hex4.
{Form , Paragraph , TextImage} do: [:i | i derstands: #(hidePress:complete: fromPress:value: presson:in: )].
gJuniperConstants ← WoodstockFilePool ← nil.
AllClassNames ← nil].
"347" UserView$'Mouse, Cursor, Keys'
[kbdnext | event |
NoteTaker
ifTrue:
[self kbck
ifTrue: [↑self kbd].
↑false]
ifFalse:
[ "returns next character (mapped) if any; otherwise false"
[(event ← Events dequeue) or: [(event ← Events primitiveDequeue)]] whileTrueDo:
[event isKbdDown
ifTrue: [↑kbMap event stroke]].
↑false]].
"375" UserView$'Mouse, Cursor, Keys'
[rawkbck | event rdpt stroke |
"flush events until key down or no event."
(NoteTaker and: ['NoEventQ'])
ifTrue:
[[stroke ← user primKbdPeek] whileTrueDo:
[stroke 0
ifTrue: [↑stroke].
user primKbdNext].
↑false].
[event ← Events peek] whileTrueDo:
[event isKbdDown
ifTrue: [↑event stroke].
Events next].
↑false].
"1262" UserView$'As yet unclassified'
[NTshrink1 | i |
Class derstands: #(archiveOn:changesOnly: asFollows bytesof: changelist: endCategoryOn: endChangesOn: filout filoutCategory: filoutOrganization paraprinton: printCategory:on: printMethod:on: printout printoutCategory: readfrom: readfrom:format: startCategory:on: startChangesOn: textLocal ).
UserView derstands: #(backup changedClasses convertTime:returnSecs: file:classes:changesOnly: growSmalltalk: hasXM initCompiler InLd: makeSources: now oopsToFile overlay: printCrossReference: quitFrom: rawtotalsecs reclaim release releaseExternalViews sourcesTo:changesOnly: systemStartup ticks time time timewords today totalsecs ).
Paragraph derstands: #(bravoRuns fromBravo toBravo applyBravo:at:to: ).
Form derstands: #(newbrush: blinkbrush: line: arc: resize: edit: classInit ).
Number derstands: #hex4.
{Form , Paragraph , TextImage} do: [:i | i derstands: #(hidePress:complete: fromPress:value: presson:in: )].
EtherPool ← gJuniperConstants ← AltoFilePool ← WoodstockFilePool ← nil.
Smalltalk do:
[:i | "delete unused globals, esp clamped classes"
((Smalltalk ref: i) refct = 1 and: [Smalltalk i nil])
ifTrue:
[Smalltalk delete: i.
SystemOrganization delete: i]].
AllClassNames ← nil].
"330" UserView$'As yet unclassified'
[NTshrink2 | i j |
"prompt for deleting unrefd messages"
self classNames do: [:i | (Smalltalk i) md do:
[:j | user redbug
ifFalse:
[j refct = 4
ifTrue:
[ "UST, md, contents, j"
(user request: i + ' ' + j) length = 0
ifTrue: [Smalltalk i derstands: j]]]]]].
"78" UserView$'As yet unclassified'
[primEIANext | |<primitive: 75>
↑self croak].
"44" UserView$'Dialog Window'
[cr | |
disp cr].
"80" UserView$'As yet unclassified'
[primMouseKeys | |<primitive: 46>
↑self croak].
"78" UserView$'As yet unclassified'
[primMousePt | |<primitive: 42>
↑self croak].
"92" UserView$'As yet unclassified'
[primPort: n mask: m ← val | |<primitive: 75>
↑self croak].
"216" UserView$'As yet unclassified'
[touchPrim: channel | t |
self primPort: 96 mask: 0 ← channel + 1 * 256.
self primPort: 256 mask: (1 - 448) ← channel.
t ← self primPort: 448.
self primPort: 96 mask: 0 ← 0.
↑t].
"260" UserView$'Mouse, Cursor, Keys'
[mp | |
NoteTaker
ifTrue: [↑self primMousePt + (mxoffset myoffset)].
scale = 2
ifTrue: [↑Point new x: mem 276 + mxoffset / 2 y: mem 277 + myoffset / 2].
↑Point new x: mem 276 + mxoffset y: mem 277 + myoffset].
"46" UserView$'Dialog Window'
[tab | |
disp tab].
"79" UserView$'As yet unclassified'
[notifyNT: pString | |
↑self notify: pString].
"294" UserView$'System quit/resume'
[snapshot | i |
"write the OT and Data of this Smalltalk out"
(1 to: 4) do:
[:i | SourceFiles i nil
ifFalse: [(SourceFiles i) close]].
dp0 close.
dp1 close.
InitialContext ← thisContext.
self snapshotPrimitive.
self mapDisplay.
self restore].
"44" UserView$'Dialog Window'
[ev | |
disp ev].
"52" UserView$'Mouse, Cursor, Keys'
[x | |
↑self mp x].
"52" UserView$'Mouse, Cursor, Keys'
[y | |
↑self mp y].
"68" UserView$'Dialog Window'
[print: x | |
disp print: x.
disp show].
"154" UserView$'System quit/resume'
[quitFrom: controller | |
self overlay: #(0 0 0 0 0 ).
self hasXM
ifTrue:
[screenrect clear.
controller restore]].
"376" UserView$'System quit/resume'
[overlay: fileid | t |
dp0 stampBoot.
self releaseExternalViews "put the ethernet to sleep".
E nil
ifFalse: [E sleep] "turn off display during quit/resume".
t ← mem 272.
mem 272 ← 0.
self InLd: fileid "we start here after a resume".
mem 272 ← t.
[user keyset > 0] whileTrueDo:
[user show: 'The keyset is stuck'.
user cr]].
"286" UserView$'Changes'
[changedClasses | titles space str |
space ← ' ' 1 "return a vector of the names of classes which have been changed".
titles ← HashSet new init.
Changes contents do:
[:str | titles insert: ((Stream new of: str) upto: space) "class title"].
↑titles contents].
"143" UserView$'Mouse, Cursor, Keys'
[kbd | |
[self rawkbck] whileFalseDo:
[NoteTaker
ifFalse: [self purgealittle]].
↑kbMap self rawkbd].
"3544" UserView$'Misc System Stuff'
[version | |
↑'Smalltalk 5.5k ' + (user hasXM
ifTrue: ['XM ']
ifFalse: ['']) + 'November 20?' "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.
"].
"284" UserView$'Window Scheduling'
[restart code | u |
u ← code cleancopy.
u sender← nil.
thisContext sender releaseFully.
thisContext sender← nil.
code ← nil "release caller chain".
MessageDict new freeMethods "release held code".
disp frame flash.
[true] whileTrueDo: [u eval]].
"246" UserView$'Window Scheduling'
[restore | w |
NoteTaker
ifTrue:
[Dorado
ifFalse: [kbMap ← NTkbMap]].
screenrect clear.
projectWindow nil
ifFalse: [projectWindow putTitle].
(sched length to: 1 by: 1) do: [:w | (sched w) show]].
"94" UserView$'Screen Views'
[install | |
self screenextent: screenrect extent tab: htab vtab].
"62" UserView$'Time'
[now | |
↑self dateAndTime: self timewords].
"77" UserView$'As yet unclassified'
[touched | |
↑screenrect has: self touchPt].
"316" UserView$'As yet unclassified'
[touchPt | t1 t2 t3 |
false
ifTrue: [user calibrate]
ifFalse:
[ "paste result below"
t1 ← 880 833 rect: 609 671.
t2 ← 50 50 rect: 550 350.
t3 ← (self touchPrim: 1) asFloat (self touchPrim: 0) asFloat.
↑t2 origin + (t3 - t1 origin / t1 extent * t2 extent)]].
"57" UserView$'Window Scheduling'
[run | |
self run: false].
"66" Etherworld$'Utility messages'
[SIO: sioArg | |<primitive: 75>
].
"318" Etherworld$'Utility messages'
[fill | outstanding |
"I want to replenish the freeQ"
(freeQ false or: [freeQ nil])
ifFalse:
[outstanding ← Pacbuf howMany - freeQ length.
user cr.
user show: outstanding asString + ' packets outstanding'.
[freeQ length = 10] whileFalseDo: [freeQ next← Pacbuf init]]].
"70" Etherworld$'Output Routines'
[doOutput: string | |<primitive: 75>
].
"599" Etherworld$'Utility messages'
[printon: s | |
etherState = ethDead
ifTrue: [s append: 'Etherworld, etherState = ethDead.']
ifFalse:
[.
s append: 'Etherworld running on '.
s print: NETNUM.
s append: '#' + ALTONUM base8 + '#'.
s cr.
freeQ
ifTrue:
[s print: freeQ length.
s append: ' Pacbufs in freeQ']
ifFalse: [s append: 'no freeQ'].
s cr.
s append: 'etherState = '.
etherState = ethAsleep
ifTrue: [s append: 'etherAsleep']
ifFalse:
[.
etherState = ethAwake
ifTrue: [s append: 'etherAwake']
ifFalse:
[.
s print: etherState]]]].
"1077" Etherworld$'Initialization/Termination'
[wakeup | socket |
"Try to get everything up and running"
etherState = ethAwake
ifTrue: [self etherStart]
ifFalse:
[ "do nothing, kick the receiver"
.
etherState = ethDead
ifTrue: [self sleep].
etherState = ethAsleep
ifTrue:
[ALTONUM ← self getMachineID "this is the tricky one, need to get our machine # and routing table.
may have come up on a different network and host, assume the worst".
self setMachineID: ALTONUM.
NETNUM ← 0.
sockeTable values do:
[:socket | socket nil
ifFalse: [socket setOutAddBlock]].
etherState ← ethAwake.
self etherStart.
routingUpdateUser update.
NETNUM = 0
ifTrue:
[etherState ← ethAsleep.
user notify: 'no routing tables']
ifFalse:
[ "tell leftover sockets current net&host, and that we are awake again"
sockeTable values do:
[:socket | socket nil
ifFalse:
[socket setOutAddBlock.
socket wakeup]]]]
ifFalse:
[.
self notify: 'In wakeup, found Ethernet in some unknown state.']]].
"85" Etherworld$'User messages'
[broadcastFilterSet: val | |<primitive: 75>
user croak].
"1005" Etherworld$'Initialization/Termination'
[kill | socket |
"shuts down ethernet and PUP world completely"
etherState = ethDead "Should free up all of the storage, etc.....
Would need to wakeup or Init, to get started again.
Device may have been running"
ifFalse:
[ "do nothing"
etherState = ethAwake
ifTrue: [self sleep].
sockeTable values do:
[:socket | socket nil
ifFalse: [socket kill]].
Top terminate: IntProcLevel.
Top terminate: InputProcLevel.
ethInPacNext
ifTrue:
[ethInPacNext nil
ifFalse:
[ethInPacNext locked
ifTrue: [ethInPacNext unlock]]].
ethInPacNext ← false "Release the PQueues to avoid circular data structures".
(freeQ and: [freeQ nil])
ifTrue:
[freeQ release.
freeQ ← nil].
justArrivedQ nil
ifTrue:
[justArrivedQ release.
justArrivedQ ← nil].
routingUpdateUser nil
ifFalse: [routingUpdateUser release].
routingUpdateUser ← routingTable ← routingHopCount ← nil.
etherState ← ethDead]].
"239" Etherworld$'Initialization/Termination'
[setLights | |
IntLight ← Rectangle new origin: 576 0 extent: 16 16.
InputLight ← Rectangle new origin: 592 0 extent: 16 16.
OutputLight ← Rectangle new origin: 576 16 extent: 16 16].
"934" Etherworld$'Initialization/Termination'
[Init | i |
"move from state ethDead to ethAsleep"
"if we were already running, bring it all down, just in case!!"
etherState = ethDead
ifFalse: [self kill] "now sure we are ethDead".
NETNUM ← ALTONUM ← 0 "may get reset later".
self setLights.
(justArrivedQ ← SafeQ new of: (Vector new: 20)) enable.
freeQ
ifTrue:
[(freeQ ← SafeQ new of: (Vector new: 20)) enable.
(1 to: 10) do: [:i | freeQ next← Pacbuf init]]
ifFalse: [justArrivedQ disable].
ethInPacNext ← self freePacket.
sockeTable ← Dictionary new init: 10.
routingTable ← String new: 255.
routingTable all← 0 "1-255, 0 is special".
routingHopCount ← String new: 255.
routingHopCount all← 8.
routingUpdateUser ← RoutingUpdater init.
self installIntProc.
self installInputProc.
IntProc enable.
InputProc enable.
etherState ← ethAsleep "we are still asleep, must do a wakeup to get numbers, start, etc."].
"1036" Etherworld$'Input Interrupt Routines'
[installIntProc | |
IntProc ← Top install [([true] whileTrueDo:
[IntLight comp "infinite loop for process in scheduler.
Interrupt just happened, running at a high level, interface off.
Something just happened, do the common cases first.
Input is wired down below; only comes here if OK.
Note: we can only come here if last action was to start the rec!!" "copy out the packet first".
ethInPacNext
ifTrue: [self copyinput: ethInPacNext pupString]
ifFalse:
[ "user cr; show: 'warning, no packet pre-fetched. tell John'."
(ethInPacNext ← self freePacket)
ifTrue: [self copyinput: ethInPacNext pupString] "user cr; show: 'input lost'"] "start the receiver".
self SIO: 2.
ethInPacNext
ifTrue:
[justArrivedQ next← ethInPacNext "now process this input".
ethInPacNext ← self freePacket.
Top wakeup: InputProcLevel "all done"].
IntLight comp.
IntProc sleep "last action in the loop"])] at: IntProcLevel].
"888" Etherworld$'Input Interrupt Routines'
[installInputProc | inBuf destSoc |
InputProc ← Top install [([true] whileTrueDo:
[InputLight comp "infinite loop for process in scheduler".
[inBuf ← justArrivedQ next] whileTrueDo:
[(checkIncomingCS and: [inBuf checksumOK "process each incoming buffer, know it's a PUP" "verify the incoming checksum" false])
ifTrue: [self freePacket: inBuf "reject it, done"]
ifFalse:
[ "To be honest, we should check the destNet and destHost,
but they generally have to be OK.....
OK to pass the packet on"
(destSoc ← sockeTable lookup: inBuf destSocNum)
ifTrue: [destSoc acceptPacbuf: inBuf]
ifFalse:
[ "couldn't find a socket for it, done"
.
self freePacket: inBuf]]].
InputLight comp.
InputProc sleep "last action in the loop"])] at: InputProcLevel].
"635" Etherworld$'Initialization/Termination'
[sleep | socket |
"be sure to do this before a user quit"
etherState = ethDead
ifTrue: [self Init]
ifFalse:
[ "that is, go from dead to asleep"
etherState = ethAsleep
ifFalse:
[ "already asleep"
etherState = ethAwake
ifTrue:
[sockeTable values "try to shut down gracefully" do:
[:socket | socket nil
ifFalse: [socket sleep] "warn the sockets, leaves them in table"].
self etherStop.
etherState ← ethAsleep "when next we wake up, may be on a new machine/net"]
ifFalse:
[ "when next we wake up, may be on a new machine/net"
]]]].
"167" Etherworld$'Initialization/Termination'
[etherStop | |
"temporarily shuts off the ether stuff"
Top critical [
(mem 385 ← 0.
self SIO: 3.
mem 384 ← 0)]].
"285" Etherworld$'Utility messages'
[notify: strng | |
"turn off the Ethernet before doing a user notify"
self etherStop.
user show: ' Etherworld stopped'.
Top currentPriority 1
ifTrue:
[user cr.
user show: 'priority is ' + Top currentPriority asString].
user notify: strng].
"72" Etherworld$'Utility messages'
[getMachineID | |
↑(self SIO: 0) \ 256].
"70" Etherworld$'Utility messages'
[setMachineID: ID | |
mem 392 ← ID].
"361" Etherworld$'Initialization/Termination'
[etherStart | |
"allows ether to start running again"
etherState = ethAwake "makes sure the interrupt is on, and kicks the device"
ifTrue:
[mem 385 = 0
ifTrue: [mem 385 ← ethIntBits].
self SIO: 3 "forces it to wake up again"]
ifFalse:
[.
self notify: 'Attempt to etherStart when not awake!!.']].
"64" Etherworld$'User messages'
[awake | |
↑etherState = ethAwake].
"283" Etherworld$'Utility messages'
[printSocketTable | i |
sockeTable nil
ifTrue:
[user cr.
user show: 'no socketTable']
ifFalse: [sockeTable objects do:
[:i | i nil
ifFalse:
[user cr.
user print: i.
user show: ', '.
user print: sockeTable i]]]].
"643" Etherworld$'Initialization/Termination'
[classInit | |
Smalltalk declare: #(E ) "if this needs to be filed in again, execute this first
Smalltalk declare: EtherPool as: (SymbolTable new init: 32).
access variables from outside with (for example) with EtherPoolethAwake".
EtherPool declare: #(ethInPacNext checkIncomingCS IntProcLevel InputProcLevel ethIntBits etherState ethAwake ethAsleep ethDead ) as: {false , false , 14 , 13 , 16 , 0 , 3 , 1 , 0}.
EtherPool declare: #(NETNUM ALTONUM freeQ justArrivedQ sockeTable routingTable routingHopCount routingUpdateUser IntProc InputProc broadcastFilter IntLight InputLight OutputLight )].
"90" Etherworld$'Input Interrupt Routines'
[copyinput: string | |<primitive: 75>
user croak].
"725" 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.
mem 390 ← ethOutPac totLengthWords "EthOutCntLoc".
(post ← self doOutput: ethOutPac pupString) 511
ifTrue:
[user cr.
user show: 'Warning, bad output post: ' + post base8].
OutputLight comp)] "end of the critical part"].
"198" Etherworld$'User messages'
[broadcastFilter: val | |
val
ifTrue:
[broadcastFilter ← true.
self broadcastFilterSet: 1]
ifFalse:
[broadcastFilter ← false.
self broadcastFilterSet: 0]].
"214" Etherworld$'User messages'
[freePacket | p |
freeQ
ifTrue:
[ "get a packet"
(p ← freeQ next)
ifTrue: [↑p].
user show: 'Warning, empty freeQ, in Etherworld'.
↑false]
ifFalse: [↑Pacbuf new init]].
"140" Etherworld$'User messages'
[freePacket: p | |
"put a used packet into free queue"
(freeQ and: [p])
ifTrue: [freeQ next← p].
↑false].
"74" Etherworld$'Utility messages'
[error: str | |
user cr.
user show: str].
"274" Etherworld$'Utility messages'
[printRoutingTable | i |
(1 to: 255) do:
[:i | routingTable i 0
ifTrue:
[user cr.
user show: 'To net ' + i asString + ' via host ' + (routingTable i) asString + ', hop count = ' + (routingHopCount i) asString]].
user cr].
"889" UserView$'As yet unclassified'
[Doradowritem | today image space table i n t7 |
"user Doradowritem."
Changes init.
MethodKeeper ← (Vector new: 10) asStream.
E nil
ifTrue: [E ← Etherworld new].
NTmapper new mapDorado.
(t7 ← dp0 file: 'Disp.nt') append: (user instfield: 7) contents.
t7 close.
user displayoffwhile [
(image ← dp0 file: (n ← (user today format: #(2 1 0 0 2 0 )) + '.im').
space ← dp0 file: 'objectspace.nt'.
space readonly.
table ← dp0 file: 'objecttable.nt'.
table readonly.
image append: (space length / 2) asLarge inFourBytes.
image append: (table length / 2) asLarge inFourBytes.
image pad: 512 with: 0.
image append: space.
image pad: 512 with: 0.
image append: table.
space close.
table close.
image close)].
user quitThen: 'ftp Phylum log/c guest guest conn/c smalltalk-80 st80 sto/c st80sources.v00 st80changes.v00 ' + n].
"164" UserView$'Mouse, Cursor, Keys'
[mpnext | |
self redbug "return next mouse point if red button or tablet is down; otherwise false"
ifTrue: [↑self mp].
↑false].
"70" UserView$'As yet unclassified'
[core | |<primitive: 48>
user croak].
"218" UserView$'Time'
[timewords | s |
s ← String new: 4 "seconds (in GMT) since Jan 1 1901: as a String".
NoteTaker
ifTrue: [self timeWordsInto: s]
ifFalse:
[s word: 1 ← mem 378.
s word: 2 ← mem 379].
↑s].
"55" UserView$'Screen Views'
[screenrect | |
↑screenrect].
"171" UserView$'Screen Views'
[copyIn: p | |
↑UserView new screenrect: screenrect copy vtab: vtab htab: htab scale: scale color: color projectWindow: p disp: disp sched: #()].
"136" UserView$'Window Scheduling'
[leaveTop | |
"leave the top window if there is one"
sched length = 0
ifFalse: [(sched 1) leave]].
"983" Dispframe$'Dialog'
[kbd | n t |
"false if user pauses, nil if ctrl-d, all input since prompt if "
[user kbck] whileTrueDo:
[t ← user kbd.
t = 132
ifTrue:
[self append: 'done.'.
self show.
↑nil].
"ctl-d for done"
t = 8
ifTrue:
[self last = prompt
ifFalse: [self skip: 1]]
ifFalse:
[ "backspace"
t = 30
ifTrue:
[n ← array (position to: 1 by: 1) find: prompt.
n = 0
ifTrue:
[self append: 'lost beginning'.
self prompt]
ifFalse:
[t ← self last: n - 1.
self next← doit.
self show.
↑t]]
ifFalse:
[ "do-it (LF)"
t = 145
ifTrue:
[self last = prompt
ifFalse:
[self skip: 1 "ctl-w for backspace word".
[position > 0 and: [self last tokenish]] whileTrueDo: [self skip: 1]]]
ifFalse:
[t = 151
ifTrue:
[self reset.
self prompt]
ifFalse: [ "ctl-x clears frame"
self next← t]]]]].
self show.
↑false].
"330" Dispframe$'Scheduler'
[eachtime | t |
(text window has: user mp)
ifTrue:
[user kbck
ifTrue:
[(t ← self kbd)
ifTrue:
[t nil
ifFalse:
[self space.
self print: nil t].
self prompt]]
ifFalse:
[user bluebug
ifTrue: [↑false]]]
ifFalse:
[user anybug
ifTrue: [↑false]]].
"124" Dispframe$'Scheduler'
[lasttime | |
self last = prompt
ifTrue:
[self skip: 2.
self show].
↑user bluebug false].
"115" Dispframe$'Dialog'
[request: s | |
"false if ctrl-d, all input since prompt if "
self append: s.
↑self read].
"89" Dispframe$'Image'
[moveto: pt | |
(text window inset: 2 2) dragto: pt - (2 2)].
"37" Dispframe$'Scheduler'
[leave | |
].
"82" Dispframe$'Initialization'
[rect: r | |
self init.
self frame← r.
self clear].
"332" Dispframe$'Image'
[show | t |
text show: self contents asParagraph.
[text lastshown position] whileFalseDo:
[position < (t ← text scrolln: 1)
ifFalse:
[t ← array copy: t + 1 to: position.
text show: t asParagraph.
position ← 0.
self append: t "self dequeue: (text scrolln: 1).
text show: self contents"]]].
"54" Dispframe$'Access to Parts'
[frame | |
↑text frame].
"55" Dispframe$'Image'
[clear | |
self reset.
self show].
"47" Dispframe$'Access to Parts'
[text | |
↑text].
"125" Dispframe$'Dialog'
[ev | t |
[self cr.
t ← self request: ''] whileTrueDo:
[self space.
self print: nil t].
↑false].
"74" Dispframe$'Dialog'
[prompt | |
self cr.
self next← prompt.
self show].
"79" Dispframe$'Initialization'
[classInit | |
prompt ← '' 1.
doit ← ' ' 1].
"89" Dispframe$'Initialization'
[init | |
text ← Textframe new.
self of: (String new: 16)].
"131" Dispframe$'Scheduler'
[firsttime | |
(text window has: user mp)
ifTrue:
[self outline.
self prompt]
ifFalse: [↑false]].
"55" Dispframe$'Access to Parts'
[text: t1 | |
text ← t1].
"57" Dispframe$'Image'
[outline | |
text window outline: 2].
"226" Dispframe$'Dialog'
[read | t |
"false if ctrl-d, all input since prompt if "
self next← prompt.
self show.
[user kbck
ifTrue: [t ← self kbd]
ifFalse: [false]] whileFalseDo: [].
t nil
ifTrue: [↑false].
↑t].
"68" Dispframe$'Initialization'
[frame← r | |
text para: nil frame: r].
"254" UserView$'Dialog Window'
[newdisp | |
"for when some class associated with running Dispframe changed"
self unschedule: disp.
disp ← Dispframe new rect: (8 0 rect: 150 96).
self schedule: disp.
self clearshow: 'New Dialogue window created.
'].
"258" UserView$'System quit/resume'
[quitThen: str | rem rest |
rem ← (dp0 file: 'rem.cm') "quit, then have OS execute str" readonly.
rest ← rem next: rem length.
rem readwrite.
rem reset.
rem append: str.
rem cr.
rem append: rest.
rem close.
self quit].
"64" UserView$'Mouse, Cursor, Keys'
[anybug | |
↑self buttons > 0].
"64" UserView$'Mouse, Cursor, Keys'
[redbug | |
↑self buttons = 4].
"67" UserView$'Mouse, Cursor, Keys'
[tabletabsolute | |
mem 86 ← 1].
"65" UserView$'Mouse, Cursor, Keys'
[tabletbug | |
↑mem 448 < 0].
"1889" UserView$'Misc System Stuff'
[initCompiler | code sel c t |
"Initialize shared variables of parser and generators" "user initCompiler."
Smalltalk declare: #(TokenCodes ByteCodes ).
TokenCodes nil
ifTrue: [TokenCodes ← SymbolTable new init: 32].
ByteCodes nil
ifTrue:
[ByteCodes ← SymbolTable new init: 32.
Integer sharing: ByteCodes].
TokenCodes declare: #(aRightBrack aPeriod aLeftPar aSemicolon aCondArrow aHand aReturnArrow aLeftBrack aRightPar aLeftArrow aBinary aNumber aString aKeyword aGibberish aColon aDigit aWord ) as: #(1 2 3 4 5 6 7 8 9 10 20 30 31 41 42 43 44 45 ) "First 2 in this order" "All above must be less, all below must be greater" "All below must be in that order".
ByteCodes declare: #(toLoadField toLoadTemp toLoadLit toLoadLitInd toLoadCtxt toLoadTempframe toLoadConst toLoad0 toLoad1 toLoadSelf toLoadNil toLoadFalse toLoadTrue toSmashPop toSmash toPop toReturn toEnd toLoadThisCtxt toSuper toShortJmp toShortBfp toLongJmp toLongBfp toPlus toMinus toGtr toGeq toNext toEq toSendLit toLoadFieldLong toLoadTempLong toLoadLitLong toLoadLitIndLong toSendLitLong codeLoadField codeLoadTemp codeLoadLit codeLoadLitInd codeSendLit ) as: #(0 16 32 64 112 116 120 121 122 113 125 126 127 128 129 130 131 132 133 134 144 152 160 168 176 177 179 181 194 197 208 136 137 138 139 140 256 512 768 1024 1280 ).
c ← Dictionary new init: 16.
c insertall: #('self' 'thisContext' 'super' 'nil' 'false' 'true' ) with: #(113 133 134 125 126 127 ).
ByteCodes declare: #stdPrimaries as: c.
self initCompilerSelectors.
c ← Dictionary new init: 8.
c insertall: #('whiledo' 'untildo' 'forto:do' 'forfrom:do' 'forfrom:to:by:do' 'forfrom:to:do' 'ifthenelse' 'ifthen' ) with: #(whiledo:args: untildo:args: fortodo:args: forfromdo:args: forfromtobydo:args: forfromtodo:args: ifthenelse:args: ifthen:args: ).
ByteCodes declare: #inLineMsgs as: c].
"622" UserView$'Misc System Stuff'
[oopsToFile | a c i t s cs f ts |
f ← dp0 file: 'oops'.
cs ← user classNames transform [:a | a] to [Smalltalk a].
t ← cs transform [:a | a] to [a asOop].
ts ← t permutationToSort.
ts do:
[:i | f append: (t i) base8.
f tab.
f append: (cs i) title.
f cr].
cs ts do:
[:c | f cr.
f append: c title.
f cr.
s ← c md contents "selectors".
t ← s transform [:a | a] to [(c md method: a) asOop] "method oops".
t permutationToSort do:
[:i | f tab.
f append: (t i) base8.
f tab.
f append: s i.
f cr].
user show: c title.
user cr].
f close].
"2104" UserView$'Misc System Stuff'
[workspace | |
user notify: 'Not meant to be executed' "
XEROX - Learning Research Group
user screenextent: 640580 tab: 050.
NotifyFlag ← true.
Changes init.
user changedMessages
user changedClasses
user changedCategories
Undeclared contents
to set the default printer
PrinterName←'Menlo'.
PrinterName←(PressFile new) selectPrinter: PrinterName.
to change phylum to access your account
user releaseExternalViews. phylum name: 'name' password: 'password'.
dp0 filin: ('Changes.st').
(dp0 file: 'changes.st') filout.
(dp0 file: 'xxx') edit.
dp0 pressfilin: ('xxx.press').
(dp0 filesMatching: '*.st') sort
dp0 list. dp0 freePages
dp0 delete: 'old'
dp0 rename: 'old' newName: 'new'
for reinitializing Sources and phylum
Sources release. phylum release. Sources reopen.
to make Smalltalk Sources local
| s. s ← 'Smalltalk.Sources.'.
(phylum asFtpDirectory) retrieve: '<Smalltalk>' + s + user versionName as: s; close.
Sources on: (dp0 file: s).
to switch back to remote Sources
Sources close; on: (phylum file: '<Smalltalk>Smalltalk.Sources.' + user versionName).
to filin a remote Smalltalk file
phylum filin: ('<Small-goodies>NotifyChange.st').
to print a remote/local press file
(phylum pressfile: '<Smalltalk>xxx.press') toPrinter.
(dp0 pressfile: 'xxx.press') toPrinter: 'Lilac'.
File noChanges.
BitRect new fromuser; edit.
user schedule: (defaultBitRectEditor newframe).
DocumentEditor new defaultdocument: 'test'.
DocumentEditor new init: (Document new fromPress: 'test.document').
user releaseExternalViews.
E sleep. E kill. E ← nil.
E ← Etherworld new. E broadcastFilter: true. E wakeup.
Sources reopen.
for primary Smalltalk access to file servers and printers at other sites.
substitute yourserver for phylum above, compile this workspace
PrinterName ← 'name-of-your-printer'.
Smalltalk declare: yourserver.
yourserver ← ILFileDirectory new directory: 'name-of-your-server'.
yourserver name: 'Smalltalk-User' password: 'Smalltalk'.
Sources on: (yourserver file: '<Smalltalk>Smalltalk.Sources.' + user versionName).
Changes init.
user Swat.
"].
"65" UserView$'Misc System Stuff'
[purgealittle | |<primitive: 0>
].
"97" UserView$'Mouse, Cursor, Keys'
[waitnokey | |
[self keyset = 0] whileFalseDo: [self rawkbck]].
"66" UserView$'Time'
[totalsecs | |
↑self totalsecs: self timewords].
"209" UserView$'Dialog Window'
[newdisploc: origin and: corner | |
"for moving disp"
(disp text "user newdisploc: 80 and: 15096" frame inset: 2 2) clear.
disp text frame← origin rect: corner.
disp show].
"560" UserView$'Misc System Stuff'
[systemStartup | |
"To do after system flush and installation of new core image"
Top top.
Window classInit "The following screen extent seems to really fill the screen in x,
the Alto Hardware Manual to the contrary notwithstanding.".
self screenextent: 640 580 tab: 0 50.
Sources release.
dp0 release.
dp1 release.
self releaseExternalViews.
E nil
ifFalse: [ "ignore broadcasts"
E broadcastFilter: true].
NoteTaker
ifTrue: [self afterBirth]
ifFalse:
[VirtualMemory new thisvmem.
Vmem afterBirth]].
"155" UserView$'Window Scheduling'
[schedule: window | |
sched nil
ifTrue: [sched ← window inVector]
ifFalse: [sched ← window inVector concat: sched]].
"154" UserView$'Mouse, Cursor, Keys'
[keyset | |
NoteTaker
ifTrue: [↑(self primMouseKeys lshift: 3) land: 31].
↑31 - ((mem 488 lshift: 3) land: 31)].
"83" UserView$'Mouse, Cursor, Keys'
[waitclickbug | |
self waitnobug.
↑self waitbug].
"60" UserView$'Screen Views'
[reconfigure | |<primitive: 75>
].
"159" UserView$'System quit/resume'
[backup | |
"back up smalltalk on ivy and resume"
ivy open.
ivy delete: 'small.boot'.
ivy store: 'small.boot'.
ivy close].
"157" UserView$'Misc System Stuff'
[growSmalltalk: numberofdiskpages | |
"for preemptive growth of Small.boot on disk"
dp0 growSmalltalkBy: numberofdiskpages].
"68" UserView$'Mouse, Cursor, Keys'
[tabletrelative | |
mem 86 ← 1].
"72" UserView$'Time'
[rawtotalsecs | |
↑self rawtotalsecs: self timewords].
"405" UserView$'Misc System Stuff'
[reclaim | c cl cv |
" Should only be called from bugScreenMenu !! "
user cr.
user show: 'Reclaiming... '.
cl ← {CodePane , ScrollBar , PanedWindow , ListPane , Generator , Parser}.
cv ← Context allInstances.
user print: cv length.
cv do:
[:c | (cl has: c mclass)
ifTrue: [c release]].
cv all← nil.
user show: ' reduced to ' + Context howMany asString + '.'].
"83" UserView$'Time'
[timeWordsInto: s | |<primitive: 81>
"s length=4!"
user croak].
"443" SymbolTable$'Searching'
[allCallsOn: selector from: classNames | className s w cl sel |
(selector is: Vector)
ifFalse: [selector ← selector inVector].
s ← Stream default.
user displayoffwhile [(classNames do:
[:className | cl ← self className.
selector do:
[:sel | w ← cl whosends: sel.
w length = 0
ifFalse:
[s append: className.
s append: ''.
s append: w asString.
s cr]]])].
↑s contents].
"89" SymbolTable$'Insertion'
[define: name as: x | |
"synonym"
↑self declare: name as: x].
"87" SymbolTable$'Insertion'
[insert: name withref: ref | |
super insert: name with: ref].
"162" SymbolTable$'Searching'
[allRefs | |
"what methods reference my variables (I am probably 'Undeclared')"
↑self allRefsTo: self contents from: user classNames].
"309" SymbolTable$'Searching'
[allRefsTo: symbol from: classNames | s |
(symbol is: Vector)
ifFalse: [symbol ← symbol inVector].
↑Smalltalk allCallsOn: (symbol transform [:s | s] to [(self ref: s)]) from: classNames "
Smalltalk allRefsTo: ST80 from: (SystemOrganization superclassOrder: 'S80-Compiler')
"].
"70" ObjectReference$'Indirection'
[value← t1 | |
object ← t1.
↑object].
"64" ObjectReference$'Initialization'
[object: t1 | |
object ← t1].
"51" ObjectReference$'Indirection'
[eval | |
↑object].
"90" ObjectReference$'Conversion'
[printon: strm | |
strm append: '->'.
strm print: object].
"52" ObjectReference$'Indirection'
[value | |
↑object].
"147" SymbolTable$'Insertion'
[insert: name with: x | |
(self has: name)
ifFalse: [super insert: name with: ObjectReference new].
self name ← x].
"68" SymbolTable$'Searching'
[lookupRef: name | |
↑super lookup: name].
"277" SymbolTable$'Growing and shrinking'
[rehash | i copy |
copy ← SymbolTable new init: self size "create a copy".
(1 to: objects length) "hash each entry into it" do:
[:i | objects i nil
ifFalse: [copy insert: objects i withref: values i]].
self copyfrom: copy].
"389" SymbolTable$'Insertion'
[declare: name from: symTab | a |
"take name(s), ref(s) and value(s) from symTab"
(name is: Vector)
ifTrue: [name do: [:a | self declare: a from: symTab]]
ifFalse:
[(self has: name)
ifFalse:
[(symTab has: name)
ifTrue:
[super insert: name with: (symTab ref: name).
symTab delete: name]
ifFalse: [self insert: name with: nil]]]].
"103" SymbolTable$'Searching'
[lookup: name | r |
(r ← super lookup: name)
ifTrue: [↑r value].
↑false].
"180" SymbolTable$'Searching'
[invert: obj | i |
(1 to: values length) do:
[:i | nil (values i)
ifFalse:
[obj (values i) value
ifTrue: [↑objects i]]].
↑false].
"373" SymbolTable$'As yet unclassified'
[forEachClass class selector selector do action | name cl s |
user cr.
user show: 'anybug to interrupt.'.
user cr.
AllClassNames do:
[:name | user anybug
ifFalse:
[user show: name.
user cr.
class value← cl ← Smalltalk name.
user displayoffwhile [(cl md do:
[:s | selector value← s.
action eval])]]]].
"139" SymbolTable$'Searching'
[invertRef: obj | i |
(1 to: values length) do:
[:i | obj (values i)
ifTrue: [↑objects i]].
↑false].
"145" SymbolTable$'Insertion'
[declare: name | |
"Take ref(s) and value(s) from Undeclared, if name(s) there"
self declare: name from: Undeclared].
"182" SymbolTable$'Growing and shrinking'
[clean | name |
"release unreferenced entries"
self do:
[:name | "slick, huh"
(super name) refct = 1
ifTrue: [self delete: name]]].
"62" SymbolTable$'Access to parts'
[ref: name | |
↑super name].
"144" MethodDictionary$'As yet unclassified'
[has: key | probe |
(probe ← super at: (self find: key)) nil
ifTrue: [↑false].
↑probe key = key].
"101" MethodDictionary$'As yet unclassified'
[methodorfalse: sel | |
↑self at: sel ifAbsent [(↑false)]].
"118" MethodDictionary$'As yet unclassified'
[method: sel | |
↑self at: sel ifAbsent [(self error: sel + ' not found')]].
"166" LADDictionary$'As yet unclassified'
[noCheckAdd: anAssociation | |
self at: (self find: anAssociation key) put: anAssociation.
tally ← tally + 1.
↑anAssociation].
"147" LADDictionary$'As yet unclassified'
[at: key ifAbsent expr | val |
val ← super at: (self find: key).
val nil
ifTrue: [↑expr eval].
↑val].
"233" LADDictionary$'As yet unclassified'
[add: anAssociation | index |
index ← self find: anAssociation key.
(super at: index) nil
ifTrue: [tally ← tally + 1].
self at: index put: anAssociation.
self fullCheck.
↑anAssociation].
"320" LADDictionary$'As yet unclassified'
[find: key | index len probe pass |
len ← self length.
pass ← 1.
index ← key hash \ len + 1.
[(probe ← super at: index) nil or: [probe key = key]] whileFalseDo:
[(index ← index + 1) > len
ifTrue:
[index ← 1.
(pass ← pass + 1) > 2
ifTrue: [↑index]]].
↑index].
"204" LADDictionary$'As yet unclassified'
[contents | s i |
s ← Stream new of: (Vector new: self length).
(1 to: self length) do:
[:i | self i nil
ifFalse: [s next← (self i) key]].
↑s contents].
"104" LADSet$'As yet unclassified'
[at: index | |
NoteTaker
ifTrue: [↑self index].
↑contents index].
"110" LADSet$'As yet unclassified'
[fullCheck | |
self length - tally (self length / 4)
ifTrue: [self grow]].
"52" LADSet$'As yet unclassified'
[init | |
tally ← 0].
"49" LADSet$'As yet unclassified'
[size | |
↑tally].
"179" LADSet$'As yet unclassified'
[at: index put: anAssociation | |
"should be primitive"
NoteTaker
ifTrue: [↑self index ← anAssociation].
↑contents index ← anAssociation].
"100" LADSet$'As yet unclassified'
[length | |
NoteTaker
ifTrue: [↑super length].
↑contents length].
"291" LADSet$'As yet unclassified'
[grow | oldContents newSelf oldTally i |
NoteTaker
ifTrue:
[newSelf ← self species new: self length * 2.
newSelf init "tally ← 0".
(1 to: self length) do:
[:i | self i nil
ifFalse: [newSelf noCheckAdd: self i]].
self become: newSelf]].
"107" UniqueString$'Reading and Writing'
[ x ← val | |
user notify: 'UniqueStrings are not for writing into'].
"110" UniqueString$'Selectors'
[isinfix | x |
self length 1
ifTrue: [↑false].
↑(self 1) isletter false].
"46" UniqueString$'Initialization'
[unique | |
].
"50" UniqueString$'Compatibility'
[recopy | |
↑self].
"55" UniqueString$'Conversion'
[asString | |
↑super copy].
"262" UniqueString$'Initialization'
[rehash | old s i |
" a rehash. "
old ← USTable.
USTable ← Vector new: old length.
(1 to: old length) do:
[:i | USTable i ← Vector new: 0.
old i do:
[:s | s nil
ifFalse: [self intern: s]].
old i ← nil]].
"48" UniqueString$'Comparison'
[= x | |
↑self x].
"101" UniqueString$'Initialization'
[str: s | j |
(1 to: s length) do: [:j | super j ← s j].
↑self].
"66" UniqueString$'Conversion'
[printon: strm | |
strm append: self].
"393" UniqueString$'Initialization'
[hasInterned: s | i v |
"false if String s hasnt been interned, else s unique"
s length = 1
ifTrue:
[s 1 < 128
ifTrue: [↑UST1 (s 1 + 1)]].
v ← USTable (s stringhash \ USTable length + 1).
(1 to: v length) do:
[:i | v i nil
ifFalse:
[s length = (v i) length
ifTrue:
[s = (v i)
ifTrue: [↑v i]]]].
↑false].
"219" UniqueString$'Selectors'
[mustTake: nargs | |
"fatal error if I am not a selector that takes nargs arguments"
self numArgs nargs
ifTrue: [user notify: self + ' does not take ' + nargs asString + ' arguments']].
"341" UniqueString$'Initialization'
[intern: s | ustr h |
(ustr ← self hasInterned: s)
ifTrue: [↑ustr].
"check if already exists"
ustr ← ((s is: UniqueString)
ifTrue: [s]
ifFalse: [ "create a new one"
(UniqueString new: s length) str: s]).
h ← s stringhash \ USTable length + 1.
USTable h ← {USTable h , ustr}.
↑ustr].
"481" UniqueString$'Selectors'
[numArgs | len n i t4 |
"the number of arguments I take when I am a selector"
len ← self length.
len = 1
ifTrue: [↑(self 1) isletter
ifTrue: [0]
ifFalse: [1]].
n ← 0 "count colons, dots, and arrows".
(1 to: len) do:
[:i | (t4 ← self i) = 58
ifTrue: [n ← n + 1]
ifFalse:
[t4 = 3
ifTrue: [n ← n + 1]
ifFalse:
[t4 = 95
ifTrue: [n ← n + 1]
ifFalse:
[t4 = 7
ifTrue: [n ← n + 1]]]]].
↑n].
"497" UniqueString$'Selectors'
[keywords | result strm i l char colon ocolon |
"return a vector of the keywords that compose me"
'←' = self
ifTrue: [↑#('' '←' )].
result ← (Vector new: 10) asStream.
strm ← Stream default.
colon ← ':' 1.
ocolon ← '' 1.
i ← 1.
l ← self length.
[i l] whileTrueDo:
[char ← self i.
strm append: char.
((char = colon or: [char = ocolon]) or: [i = l])
ifTrue:
[result next← strm contents.
strm reset].
i ← i + 1].
↑result contents].
"200" UniqueString$'Initialization'
[classInit | i a v |
"make up table of 1-char atoms"
v ← Vector new: 128.
a ← String new: 1.
(1 to: 128) do:
[:i | a 1 ← i - 1.
v i ← a unique].
UST1 ← v].
"57" UniqueString$'Comparison'
[stringhash | |
↑super hash].
"55" UniqueString$'Comparison'
[hash | |<primitive: 39>
].
"163" UniqueString$'Selectors'
[iskeyword | x |
"ends with colon"
self length 1
ifTrue: [↑false].
x ← self self length.
x = 58
ifTrue: [↑true].
↑x = 3].
"120" UniqueString$'Selectors'
[isarrow | |
"ends with ←"
self length 1
ifTrue: [↑false].
↑self self length = 95].
"48" UniqueString$'Compatibility'
[copy | |
↑self].
"93" UniqueString$'Selectors'
[isuneval | x |
"ends with open colon"
↑self self length = 3].
"53" UniqueString$'Compatibility'
[species | |
↑String].
"311" Object$'System Primitives'
[error | sender op n args i |
"after compiling execute: nil installError. "
sender ← thisContext sender.
op ← sender thisop.
n ← op numArgs.
args ← Vector new: n.
(n to: 1 by: 1) do: [:i | args i ← sender pop].
↑self messageNotUnderstood: op withArgs: args from: sender].
"315" MethodContext$'Initialization'
[goBaby | height |
NoteTaker ← true.
MethodKeeper ← (Vector new: 10) asStream.
externalViews ← Set new vector: 10.
height ← 760 " 480 376 ".
user currentDisplay: (Form new extent: 640 height bits: (Bitmap new: 640 / 16 * height) offset: nil).
[true] whileTrueDo: [self run]].
"619" Class$'Message access'
[install: name method: method literals: literals code: code backpointers: backpointers | c |
NoteTaker
ifFalse:
[literals length > 60
ifTrue:
[user show: literals length asString + ' literals **'.
user cr]].
NoteTaker
ifTrue: [messagedict add: method]
ifFalse: [messagedict ← messagedict insert: name method: method literals: literals code: code asParagraph makeBoldPattern backpointers: backpointers].
lastClass ← self.
lastSelector ← name.
lastParagraph ← code.
Changes insert: (c ← title + ' ' + name).
(Changes has: (c ← '~' + c))
ifTrue: [Changes delete: c]].
"99" Class$'Access to parts'
[isVariable | |
NoteTaker
ifTrue: [↑instsize allmask: 4096].
↑false].
"76" Class$'Instance access'
[printon: strm | |
strm append: 'Class ' + title].
"58" Class$'Instance access'
[default | |
↑self new default].
"91" Class$'System Organization'
[category | |
↑SystemOrganization invert: self title unique].
"116" Class$'Message access'
[space | a s |
s ← 0.
messagedict do: [:a | s ← s + (messagedict method: a) length].
↑s].
"101" Class$'Instance access'
[init | |
"init and default get propagated to instances"
↑self new init].
"55" Class$'Filin and Filout'
[endCategoryOn: pstrm | |
].
"204" Class$'Instance access'
[new: length | |
"To allow fixed-length classes to simulate variable-length ones"
self isVariable
ifTrue: [user croak]
ifFalse: [↑self new init: length] "By convention"].
"146" Class$'Instance access'
[recopy: inst | t i |
t ← self new.
(1 to: self instsize) do: [:i | t instfield: i ← (inst instfield: i) recopy].
↑t].
"135" Class$'Instance access'
[copy: inst | t i |
t ← self new.
(1 to: self instsize) do: [:i | t instfield: i ← inst instfield: i].
↑t].
"82" Class$'Filin and Filout'
[endChangesOn: pstrm | |
pstrm print: ' ' asParagraph].
"90" Class$'Filin and Filout'
[printMethod: sel on: pstrm | |
pstrm print: (self code: sel)].
"153" Class$'Filin and Filout'
[startChangesOn: pstrm | |
pstrm print: (('
' + title + ' asFollows ') asParagraph maskrunsunder: 241 to: 81) "Font 5, Bold"].
"941" Class$'Filin and Filout'
[paraprinton: strm | para frame s heading org |
"Strm is actually a ParagraphPrinter"
para ← ('"' + title + '"') asParagraph.
para maskrunsunder: 241 to: 81 "Font ← 5, Bold".
frame ← strm defaultframe "defeat ST76 optimization".
.
strm frame← 15000 frame origin y rect: 20000 frame corner y.
strm print: para.
strm frame← frame.
strm print: ((self definition + ';
asFollows ') asParagraph maskrunsunder: 241 to: 81).
org ← self organization.
strm print: ('
' + org globalComment) asParagraph allItalic.
org categories do: [:heading | self printCategory: heading on: strm].
self endChangesOn: strm.
strm print: ('SystemOrganization classify: ' + title + ' under: ''' + (SystemOrganization invert: title unique) + '''. ') asParagraph.
(self Class or: [self VariableLengthClass])
ifFalse:
[(self canunderstand: #classInit)
ifTrue: [strm print: (title + ' classInit ') asParagraph]]].
"206" Class$'Filin and Filout'
[noChanges | s t |
t ← title + ' *'.
Changes contents do:
[:s | ((s 1 = 126 "~" and: [(t match: s (2 to: s length))]) or: [(t match: s)])
ifTrue: [Changes delete: s]]].
"135" Class$'Filin and Filout'
[filoutCategory: cat | |
(dp0 file: (title + '-' + cat + '.st') asFileName) filout: (self changelist: cat)].
"177" Class$'Instance access'
[instfield: i | |
"prevent user from getting freelist"
i > Class instsize
ifTrue: [user notify: 'arg too big']
ifFalse: [↑super instfield: i]].
"82" Class$'Message access'
[canunderstand: selector | |
↑messagedict has: selector].
"118" Class$'Filin and Filout'
[printout | |
user displayoffwhile [((dp0 file: title + '.press.') printoutclass: self)]].
"135" Class$'Message access'
[notify: errorString at: position in: stream | |
↑self notify: errorString at: position in: stream for: self].
"211" Class$'Message access'
[whosends: selector | s l a |
s ← Stream default.
messagedict do: [:a | (messagedict literals: a) do:
[:l | selector l
ifTrue:
[s append: a.
s space]]].
↑s contents].
"75" Class$'Message access'
[method: sel | |
↑messagedict methodorfalse: sel].
"45" Class$'Access to parts'
[title | |
↑title].
"50" Class$'Organization'
[classvars | |
↑classvars].
"210" Class$'Initialization'
[subclassof: t1 | |
superclass ← t1.
((superclass isnt: Class) and: [(superclass isnt: VariableLengthClass)])
ifTrue: [user notify: 'Superclass is not yet defined or not a Class']].
"538" Class$'Message access'
[code: sel | |
"last paragraph returned is cached (mainly for NotifyWindows)"
lastParagraph ← ((sel lastSelector and: [self lastClass])
ifTrue: [lastParagraph]
ifFalse:
[sel = #ClassOrganization
ifTrue: [self organization]
ifFalse:
[user leftShiftKey
ifTrue: [self decompile: sel]
ifFalse:
[NoteTaker
ifTrue: [self getSource80: sel]
ifFalse: [messagedict code: sel]]]]) asParagraph.
lastClass ← self.
lastSelector ← sel.
↑lastParagraph].
"54" Class$'Organization'
[environment | |
↑environment].
"338" Class$'Initialization'
[bytesize: n | |
"non-pointer declaration"
self self realself
ifTrue: [self realself bytesize: n]
ifFalse:
[NoteTaker
ifTrue: [instsize ← (instsize land: 8191) + (n = 8
ifTrue: [0]
ifFalse: [16384])]
ifFalse: [fieldtype ← 32 + (n = 8
ifTrue: [8]
ifFalse: [16])]]].
"106" Class$'Initialization'
[veryspecial: n | |
"inaccessible fields"
instsize ← self instvars length + n].
"139" Class$'Message access'
[understands: code | selector old |
"install method"
↑self understands: code classified: 'As yet unclassified'].
"768" Class$'Initialization'
[declare: v | var recom |
self self realself
ifTrue: [self realself declare: v]
ifFalse:
[classvars nil
ifTrue: [classvars ← SymbolTable init].
(v is: String)
ifTrue: [self declare: v asVector]
ifFalse:
[recom ← false.
(v is: Vector)
ifTrue: [v do:
[:var | ((Smalltalk has: var) or: [(Undeclared has: var)])
ifTrue: [recom ← true]]]
ifFalse:
[((Smalltalk has: v) or: [(Undeclared has: v)])
ifTrue: [recom ← true]].
recom
ifTrue: [user notify: 'Methods recompile if you proceed, global became local'].
(v is: Vector)
ifTrue: [v do: [:var | classvars insert: var with: nil]]
ifFalse: [classvars insert: v with: nil].
recom
ifTrue: [self compileall]]]].
"55" Class$'Access to parts'
[superclass | |
↑superclass].
"372" Class$'Message access'
[compileall | s c |
"does not modify code, just compiles it"
messagedict do: [:s | self recompile: s].
self Object
ifTrue: [nil installError] "to recompile the whole system (check out big changes) execute:
| n [for n from: AllClassNames do
[user show: n; cr. (Smalltalkn) compileall.
Changes init. MessageDict new freeMethods]] "].
"299" Class$'Organization'
[organization | o |
classvars nil
ifTrue: [self declare: #ClassOrganization].
o ← classvars lookup: #ClassOrganization.
(o is: ClassOrganizer)
ifTrue: [↑o].
o ← ClassOrganizer new init: messagedict contents sort.
classvars insert: #ClassOrganization with: o.
↑o].
"81" Class$'Filin and Filout'
[readfrom: strm | |
↑self readfrom: strm format: nil].
"290" Class$'Instance access'
[print: inst on: strm | ivars i |
ivars ← self instvars.
strm append: '('.
strm append: title.
strm append: ' new '.
(1 to: instsize) do:
[:i | strm append: ivars i.
strm append: ': '.
strm print: (inst instfield: i).
strm space].
strm append: ')'].
"443" Class$'Initialization'
[title: name insystem: system | cl |
superclass ← Object.
(system has: name)
ifTrue:
[cl ← (system name) class.
cl self class
ifTrue: [↑self].
user notify: name + ' will change from a ' + cl title + ' to a ' + self class title + ' if you proceed...'].
system declare: name as: self.
AllClassNames ← AllClassNames insertSorted: name.
SystemOrganization classify: name under: 'As yet unclassified'].
"491" Class$'Message access'
[derstands: selector | c |
"overstands? undersits? - forget it"
(selector is: Vector)
ifTrue: [selector do: [:c | self derstands: c]]
ifFalse:
[(messagedict has: selector) false
ifFalse:
[messagedict ← messagedict delete: selector.
self organization delete: selector.
lastClass ← lastSelector ← lastParagraph ← nil.
(Changes has: (c ← title + ' ' + selector))
ifTrue: [Changes delete: c].
Changes insert: (c ← '~' + c).
↑c]]].
"776" Class$'Filin and Filout'
[asFollows | s heading selector p t5 |
self self realself
ifTrue: [self realself asFollows]
ifFalse:
[heading ← 'As yet unclassified' "handles Bravo or Press (Smalltalk generated) files".
[(p ← FilinSource nextParagraph) and: [(s ← p text) ' ']] whileTrueDo:
[s 1 = 13
ifTrue: [s ← s copy: 2 to: s length "throw away initial cr before comment and headings"].
(t5 ← p runs 2) = 2 "italic"
ifTrue: [self organization globalComment← s]
ifFalse:
[t5 = 81 "5, bold"
ifTrue: [heading ← s]
ifFalse:
[(self canunderstand: (selector ← self understands: p classified: heading))
ifTrue:
[user show: selector.
user space]
ifFalse: [user show: '(an uncompiled method) ']]]]]].
"93" Class$'Filin and Filout'
[readfrom: strm format: f | |
↑self new readfrom: strm format: f].
"296" Class$'Message access'
[describe: method on: strm | sel cls |
"append mclass and selector"
cls ← self.
[cls nil
ifTrue:
[cls ← self.
sel ← #?]
ifFalse: [sel ← cls md invert: method]] whileFalseDo: [cls ← cls superclass].
strm append: cls title.
strm space.
strm append: sel].
"62" Class$'Initialization'
[myinstvars← t1 | |
myinstvars ← t1].
"62" Reader$'Internal readers'
[step | |
nextchar ← source next].
"650" Reader$'Initialization'
[classInit | strm type first last i |
"Initialize the type and mask tables"
typetable ← String new: 256.
strm ← Stream new of: #(5 0 255 1 65 90 1 97 122 2 48 57 3 58 58 3 3 3 4 9 10 4 12 13 4 32 32 6 34 34 6 25 25 7 39 39 8 21 21 9 26 26 10 30 30 11 40 41 ) "(initialize)" "upper and lower case letters" "digits" "colon, open colon" "TAB, LF, FF, CR, blank" "5 is one-char tokens" "comment quote and " "string quote" "high-minus" "↑Z (format trailer)" "DOIT" "open and close paren".
[type ← strm next] whileTrueDo:
[first ← strm next.
last ← strm next.
(first + 1 to: last + 1) do: [:i | typetable i ← type]]].
"117" Reader$'Initialization'
[of: s | |
typetbl ← typetable.
token ← Stream default.
source ← s asStream.
self step].
"83" TokenCollector$'Finalization'
[notify: errorString | |
user notify: errorString].
"148" TokenCollector$'Finalization'
[contents | |
"Close all parentheses first"
[parenstack empty] whileFalseDo: [self rightparen].
↑sink contents].
"50" TokenCollector$'Constructors'
[comment: s | |
].
"50" TokenCollector$'Constructors'
[trailer: s | |
].
"103" TokenCollector$'Constructors'
[onechar: c | x |
x ← String new: 1.
x 1 ← c.
self next← x unique].
"69" TokenCollector$'Constructors'
[keyword: s | |
self next← s unique].
"72" TokenCollector$'Constructors'
[integer: s | |
self next← s asInteger].
"74" TokenCollector$'Initialization'
[default | |
self to: (Vector new: 20)].
"105" TokenCollector$'Constructors'
[leftparen | |
parenstack next← sink.
sink ← (Vector new: 10) asStream].
"179" TokenCollector$'Constructors'
[rightparen | |
parenstack empty
ifFalse:
[ "Error will be caught elsewhere"
parenstack last next← sink contents.
sink ← parenstack pop]].
"71" TokenCollector$'Constructors'
[otheratom: s | |
self next← s unique].
"61" TokenCollector$'Constructors'
[string: s | |
self next← s].
"96" TokenCollector$'Finalization'
[next← obj | |
sink next← obj "subclasses can override easily"].
"119" TokenCollector$'Initialization'
[to: v | |
"Initialize"
sink ← v asStream.
parenstack ← (Vector new: 5) asStream].
"109" TokenCollector$'Constructors'
[float: i fraction: f exp: e | |
self next← (i + '.' + f + 'e' + e) asFloat].
"72" TokenCollector$'Constructors'
[identifier: s | |
self next← s unique].
"52" TokenCollector$'Constructors'
[separator: c | |
].
"73" Reader$'Main reader'
[read | |
↑self readInto: TokenCollector default].
"538" Reader$'Main reader'
[readnum | val d e |
val ← self rdint: 21.
nextchar = 46
ifTrue:
[ "check for decimal point"
self step.
(nextchar false or: [nextchar isdigit false])
ifTrue:
[collector integer: val.
collector onechar: 46]
ifFalse:
[ "was <Integer> . "
d ← self rdint: 1 "fraction part".
nextchar = 101
ifTrue:
[ "check for e<exponent> "
self step.
e ← self rdint: 21]
ifFalse: [e ← ''].
collector float: val fraction: d exp: e]]
ifFalse: [collector integer: val]].
"539" Reader$'Internal readers'
[rdint: char | |
"Read an integer, allow char as first char"
token reset.
nextchar = char
ifTrue:
[token next← char.
self step].
[nextchar] whileTrueDo:
[nextchar < 48
ifTrue: [↑token contents].
nextchar > 57
ifTrue:
[ "allow ABCDEFGH for hex"
nextchar > 72
ifTrue: [↑token contents].
nextchar < 65
ifTrue: [↑token contents].
token next← nextchar.
nextchar ← source next]
ifFalse:
[.
token next← nextchar.
nextchar ← source next]].
↑token contents].
"388" Reader$'Internal readers'
[upto: char | start |
"Knows about doubled ' in strings"
start ← source position.
token reset.
[nextchar ← source next] whileTrueDo:
[nextchar = char
ifTrue:
[self step.
char 39
ifTrue: [↑false].
nextchar 39
ifTrue: [↑false]].
token next← nextchar "Ran off end, back up."].
source skip: start - 1 - source position.
↑true].
"1489" Reader$'Main reader'
[readInto: t1 | x |
collector ← t1.
[nextchar] whileTrueDo:
[x ← typetbl (nextchar + 1) "See classInit for the meanings of the type codes".
x = 4
ifTrue:
[collector separator: nextchar.
nextchar ← source next]
ifFalse:
[x = 1
ifTrue: [self readatom: 0]
ifFalse:
[x = 5
ifTrue:
[collector onechar: nextchar.
nextchar ← source next]
ifFalse:
[x = 6
ifTrue:
[(self upto: nextchar)
ifTrue: [collector notify: 'Unmatched comment quote']
ifFalse: [collector comment: token contents]]
ifFalse:
[x = 2
ifTrue: [self readnum]
ifFalse:
[x = 11
ifTrue:
[nextchar = 40
ifTrue: [collector leftparen]
ifFalse: [collector rightparen].
nextchar ← source next]
ifFalse:
[x = 7
ifTrue:
[(self upto: nextchar)
ifTrue: [collector notify: 'Unmatched string quote']
ifFalse: [collector string: token contents]]
ifFalse:
[x = 8
ifTrue: [self readnum]
ifFalse:
[x = 9
ifTrue:
[(self upto: 13)
ifTrue: [collector notify: '↑Z without CR']
ifFalse: [collector trailer: token contents]]
ifFalse:
[x = 10
ifTrue: [↑collector contents].
x = 3
ifTrue: [self readatom: 1]]]]]]]]]]].
↑collector contents].
"719" Reader$'Main reader'
[readatom: ncolons | type s t4 |
token reset.
[token next← nextchar.
(nextchar ← source next)
ifTrue: [(type ← typetbl (nextchar + 1)) 3]
ifFalse: [false]] whileTrueDo:
[type = 3
ifTrue: [ncolons ← ncolons + 1]].
s ← token contents.
ncolons = 0
ifTrue: [collector identifier: s]
ifFalse:
[ncolons > 1
ifTrue: [collector otheratom: s]
ifFalse:
[.
s length = 1
ifTrue: [collector otheratom: s]
ifFalse:
[ ": or alone"
(t4 ← s s length) = 58
ifTrue: [collector keyword: s]
ifFalse:
[t4 = 3
ifTrue: [collector keyword: s]
ifFalse:
[.
collector otheratom: s "Colon wasn't last character"]]]]]].
"177" Class$'Access to parts'
[fieldNamesInto: collector | |
superclass nil
ifFalse: [superclass fieldNamesInto: collector].
↑(Reader new of: myinstvars) readInto: collector].
"166" Class$'Access to parts'
[Isa: x | |
"is x on my superclass chain?"
superclass x
ifTrue: [↑true].
superclass nil
ifTrue: [↑false].
↑superclass Isa: x].
"106" Class$'Initialization'
[environment← t1 | |
environment ← t1 "for resetting to reread sharing clauses"].
"100" Class$'Initialization'
[classInit | |
"gets propagated to a dummy instance"
self new classInit].
"156" Class$'Instance access'
[allInstances | |
NoteTaker
ifTrue: [user notify: 'use allInstancesdo in ST80']
ifFalse: [↑self allInstancesEver notNil]].
"97" Class$'Message access'
[selectors | |
"Return a Vector of all my selectors."
↑self messages].
"182" Class$'Filin and Filout'
[definition | strm |
"return a string that defines me (Class new title etc.)"
strm ← (String new: 50) asStream.
self printdefon: strm.
↑strm contents].
"1124" Class$'Filin and Filout'
[printdefon: strm | s |
"print my definition on strm"
strm append: self class title.
strm append: ' new title: '.
strm append: title unique.
strm cr.
strm tab.
strm append: 'subclassof: ' + (superclass nil
ifTrue: ['nil']
ifFalse: [superclass title]).
strm cr.
strm tab.
strm append: 'fields: ' + myinstvars asString.
strm cr.
strm tab.
strm append: 'declare: '''.
classvars contents do:
[:s | s = #ClassOrganization
ifFalse:
[strm append: s.
strm space]].
strm append: ''''.
NoteTaker
ifTrue:
[(instsize nomask: 16384)
ifTrue:
[strm semicrtab.
strm append: 'bytesize: '.
(strm print: (instsize anymask: 8192))
ifTrue: []
ifFalse: []]]
ifFalse:
[fieldtype 16
ifTrue:
[strm semicrtab.
strm append: 'bytesize: '.
strm print: fieldtype - 32].
instsize (s ← self instvars) length
ifTrue:
[strm semicrtab.
strm append: 'veryspecial: '.
strm print: instsize - s length]].
environment nil
ifFalse: [environment do:
[:s | strm semicrtab.
strm append: 'sharing: ' + (Smalltalk invert: s)]]].
"101" Class$'Filin and Filout'
[changelist: cat | |
↑{title unique , (self organization category: cat)}].
"205" Class$'Organization'
[clean | name |
"release unreferenced classvars"
classvars do:
[:name | (name #ClassOrganization and: [(classvars ref: name) refct = 1])
ifTrue: [classvars delete: name]]].
"158" Class$'Instance access'
[init: n | |
"init and default get propagated to instances"
self isVariable
ifTrue: [↑(self new: n) init].
↑self new init: n].
"168" Class$'Initialization'
[sharing: table | |
self self realself
ifTrue: [self realself sharing: table]
ifFalse: [environment ← {environment asVector , table}]].
"321" Class$'Initialization'
[obsolete | |
"invalidate further communication"
title ← 'AnObsolete' + title.
classvars ← nil "recycle class variables".
messagedict close "invalidate and recycle local messages".
environment ← self "keep me around for old instances".
superclass ← Object "invalidate superclass messages"].
"330" Class$'Access to parts'
[instsize | |
"Return the number of user accessable instance fields"
NoteTaker
ifTrue: [↑instsize land: 2047].
↑fieldtype 32
ifTrue: [0]
ifFalse:
[self Class
ifTrue: [instsize - 1]
ifFalse:
[self VariableLengthClass
ifTrue: [instsize - 20]
ifFalse: [instsize]]]].
"79" Class$'Message access'
[bytesof: sel | |
↑(messagedict method: sel) asBytes].
"85" Class$'Message access'
[messages | |
↑{messagedict contents , #ClassOrganization}].
"94" FieldNameCollector$'Invalid fields'
[leftparen | |
self next← '(' "just for error message"].
"95" FieldNameCollector$'Invalid fields'
[rightparen | |
self next← ')' "just for error message"].
"109" FieldNameCollector$'Invalid fields'
[next← value | |
user notify: 'Invalid field name: ' + value asString].
"69" FieldNameCollector$'Valid fields'
[identifier: s | |
sink next← s].
"248" Class$'Access to parts'
[instvars | |
self lastInstvarClass
ifTrue: [↑lastInstvars copy].
"cache last computation of instvars"
lastInstvarClass ← self.
lastInstvars ← self fieldNamesInto: FieldNameCollector default.
↑lastInstvars copy].
"64" Class$'Initialization'
[abstract | |
self fields: nullString].
"119" Class$'Editing'
[execute: code | |
"disposable methods"
self understands: 'doit [' + code + ']'.
↑self new doit].
"305" Class$'Editing'
[edit: selector | para s v |
para ← (selector = #ClassOrganization
ifTrue: [self organization asParagraph]
ifFalse:
[(messagedict has: selector)
ifTrue: [self code: selector]
ifFalse: [nullString asParagraph]]).
self edit: selector para: para formerly: false].
"103" Class$'Initialization'
[realself | |
↑Smalltalk title unique "as opposed to possible filin ghost"].
"841" Class$'Access to parts'
[invertRef: refs | cl env source ref inv sym t |
"Refs may be a vector (to allow batching)"
(refs isnt: Vector)
ifTrue: [↑(self invert: refs inVector) 1].
env ← (self wholeEnvironment concat: {Undeclared , Smalltalk}) asStream.
source ← Dictionary init.
↑refs transform [:ref | ref] to [
(cl ← self.
env reset.
[(sym ← env next) false
ifTrue: [inv ← 'unknown ' concat: ref asOop base8]
ifFalse:
[(cl nil and: [sym cl classvars])
ifTrue:
[t ← cl title.
cl ← cl superclass]
ifFalse: [t ← false].
(inv ← sym invertRef: ref) false
ifTrue: [false]
ifFalse:
[t
ifFalse:
[(t ← source lookup: sym)
ifFalse: [source insert: sym with: (t ← Smalltalk invert: sym)]].
inv ← (t concat: ' ') concat: inv]]] whileFalseDo: [].
inv)]].
"628" Class$'Initialization'
[rename: newtitle | name newname oldclass category |
name ← title unique.
newname ← newtitle unique.
(Smalltalk has: newname)
ifTrue:
[oldclass ← Smalltalk newname.
user notify: 'All ' + newtitle + 's will become obsolete if you proceed'.
oldclass obsolete]
ifFalse:
[category ← SystemOrganization invert: name.
AllClassNames ← AllClassNames insertSorted: newname.
SystemOrganization classify: newname under: category].
Smalltalk delete: name.
AllClassNames ← AllClassNames delete: name.
SystemOrganization delete: name.
title ← newtitle.
Smalltalk declare: newname as: self].
"1031" Class$'Initialization'
[fields: t1 | r a b s h |
"list of instance variables"
myinstvars ← t1.
messagedict ← (NoteTaker
ifTrue: [MethodDictionary init: 4]
ifFalse: [MessageDict init]).
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 howMany > 0
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:
[ "just adding new inst fields"
user notify: title + ' methods recompile if you proceed...'.
self compileall].
r md init.
self fixSubClassesOf: r.
r obsolete.
Smalltalk title unique ← self.
self initClass]]].
"262" Class$'Instance access'
[howMany | v n |
"how many instances of this class are in use now?"
NoteTaker
ifTrue:
[n ← 0.
self allInstances: v do [(n ← n + 1)].
↑n].
v ← self allInstancesEver.
thisContext destroyAndReturn: v length - (v count: nil)].
"96" Class$'Message access'
[copy: sel from: class | |
self copy: sel from: class classified: nil].
"179" Class$'Message access'
[canUnderstand: selector | |
(messagedict has: selector)
ifTrue: [↑self].
superclass nil
ifTrue: [↑false].
↑superclass canUnderstand: selector].
"587" Class$'Instance access'
[allInstancesEver | indx vec PCLs i |
"returns a vector containing all instances of this class mixed with nils"
NoteTaker
ifTrue: [user notify: 'not implemented']
ifFalse:
[ "Works for all classes. Some additional instances may be created after the
vector is filled but before you get to use it."
PCLs ← Vmem pclassesOf: self "vector of PCLs".
vec ← Vector new: 128 * PCLs length.
(1 to: PCLs length) do: [:i | vec (i - 1 * 128 + 1 to: i * 128) all← PCLs i].
thisContext destroyAndReturn: (self fromFreelist: Class instsize fill: vec)]].
"183" Class$'Organization'
[wholeEnvironment | |
↑(classvars asVector concat: environment asVector) concat: (superclass nil
ifTrue: [#()]
ifFalse: [superclass wholeEnvironment])].
"55" Class$'Access to parts'
[myinstvars | |
↑myinstvars].
"245" Class$'Initialization'
[copyof: oldClass subclassof: newSubClass | |
title ← oldClass title.
self subclassof: newSubClass.
classvars ← oldClass classvars.
environment ← oldClass environment.
self newFieldsForSubClass: oldClass myinstvars].
"214" Class$'Initialization'
[fixSubClassesOf: oldClass | n subClass |
user classNames do:
[:n | subClass ← Smalltalk n.
subClass superclass oldClass
ifTrue: [Class new copyof: subClass subclassof: self]]].
"260" Class$'Initialization'
[initClass | |
fieldtype ← 16.
instsize ← self instvars length.
instsize > 256
ifTrue: [user notify: 'too many instance variables']
ifFalse:
[NoteTaker
ifTrue: [instsize ← instsize + 1 * 2 + 8192].
self organization]].
"1082" Class$'Initialization'
[newFieldsForSubClass: t1 | r a b |
"list of instance variables"
myinstvars ← t1.
messagedict ← MessageDict init.
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 howMany > 0
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:
[ "changing inst fields"
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"].
"1034" Class$'Message access'
[archiveOn: file changesOnly: ch | org m |
user cr "this should be called only by the system releaser
(via UserView file:classes:changesOnly:) !!!
if you want to archive your own classes (useful only if you have stable code
and intend to clean up afterwards with a vmem write), see Steve.
write comment and method text on a FileStream for some file.
ch [write only changes (non-remote String/Paraagraphs)] write everything".
user show: title.
org ← self organization.
(ch and: [(org globalCommentItself "org globalComment always yields a String, so a small kludge is in order" is: RemoteParagraph)])
ifFalse: [org globalComment← (RemoteParagraph new on: file) fromString: org globalComment] "archive in category&alphabetical rather than hash order (messagedict)".
org do:
[:m | (ch and: [((messagedict code: m) is: RemoteParagraph)])
ifFalse:
[messagedict code: m ← (RemoteParagraph new on: file) fromParagraph: (self code: m).
ch
ifTrue:
[user space.
user show: m]]]].
"365" Class$'As yet unclassified'
[regenerate: sel | old new tree |
sel nil
ifTrue: [messagedict do: [:sel | user displayoffwhile [(self regenerate: sel)]]]
ifFalse:
[ "user show: title; space; show: sel; cr."
.
tree ← self decompile: sel.
new ← tree generate.
old ← self method: sel "user print: old length; space; print: new length; cr.".
↑new]].
"251" Class$'Instance access'
[allInstances each do expr | inst |
inst ← self someInstance.
inst false
ifFalse:
[each value← inst.
expr eval.
[inst ← inst nextInstance] whileTrueDo:
[each value← inst.
expr eval].
each value← false]].
"136" Class$'Instance access'
[someInstance | |<primitive: 84>
"return first instance of this class, false if there are none"
user croak].
"1050" Class$'Message access'
[getSource80: sel | meth loc file pos char len str |
"get source text from file, or decompile"
(meth ← messagedict methodorfalse: sel)
ifFalse: [↑self decompile: sel].
loc ← meth length.
file ← meth loc.
pos ← file land: 63 "high order 6 bits of pos".
file ← file / 64 "top 2 bits are file index".
pos ← pos * 256 + (meth (loc - 1)).
pos ← pos * 256 + (meth (loc - 2)).
pos = 0
ifTrue: [↑self decompile: sel].
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]].
"63" Class$'Access to parts'
[ x ← val | |
↑classvars x ← val].
"48" Class$'Access to parts'
[md | |
↑messagedict].
"51" Class$'Access to parts'
[ x | |
↑classvars x].
"244" Class$'System Organization'
[moveFromCat: cat1 to: cat2 | |
((cat1 is: String) and: [(cat2 is: String)])
ifTrue: [SystemOrganization move: self title unique from: cat1 to: cat2]
ifFalse: [user notify: 'Category name must be a String']].
"62" Class$'Instance access'
[new | |<primitive: 29>
user croak].
"226" Class$'Editing'
[ed: selector | c s |
c ← self code: selector.
user clearshow: c.
[s ← user request: 'substitute: '] whileTrueDo:
[c ← c subst: s for: (user request: 'for: ').
user clearshow: c].
self understands: c].
"1157" LADDecompiler$'Initialization'
[decompile: selOrFalse in: class method: method | i primitive nTemps lits |
instVars ← class instvars.
(1 to: instVars length) do: [:i | instVars i ← LADVariableNode new name: instVars i index: i - 1 type: LdInstType].
method isQuick
ifTrue: [↑self quickMethod: method selector: selOrFalse].
"parse the header"
nLits ← method numLiterals.
nTemps ← method numTemps.
nArgs ← method numArgs.
primitive ← method primitive "create symbol tables".
tempVars ← Vector new: nTemps.
(1 to: nTemps) do: [:i | tempVars i ← LADVariableNode new name: 't' + i asString index: i - 1 type: LdTempType].
literals ← Vector new: nLits.
lits ← method literals.
(1 to: nLits) do: [:i | literals i ← LADLiteralNode new key: lits i index: i - 1 type: LdLitType].
postfixStream ← method asStream.
postfixStream skip: nLits * 2 + 4.
NoteTaker
ifTrue:
[postfixStream limit: postfixStream limit - 3 "three on end for file pos"].
symbolTables ← {class wholeEnvironment , Smalltalk , Undeclared}.
self reverse "reverse the bytes".
↑(self method: selOrFalse primitive: primitive literals: lits class: class) simplify].
"684" LADDecompiler$'Decompiler'
[quickMethod: method selector: selOrFalse | block flags |
flags ← method 3 / 32.
block ← (flags = 5
ifTrue: [LADBlockNode new default mustReturn]
ifFalse:
[flags = 6
ifTrue: [LADBlockNode new statements: (instVars (method 3 \ 32 + 1)) inVector returns: true]
ifFalse: [user notify: 'improper short method']]).
↑LADMethodNode new selector: (selOrFalse
ifTrue: [LADSelectorNode new key: selOrFalse code: nil]
ifFalse: [false]) arguments: #() precedence: (selOrFalse isinfix
ifTrue: [2]
ifFalse:
[selOrFalse iskeyword
ifTrue: [3]
ifFalse: [1]]) temporaries: #() block: block encoder: nil primitive: 0].
"608" LADDecompiler$'Decompiler'
[method: selOrFalse primitive: primitive literals: lits class: class | method |
"pattern block"
method ← LADMethodNode new selector: (selOrFalse
ifTrue: [LADSelectorNode new key: selOrFalse code: nil]
ifFalse: [selOrFalse]) arguments: self arguments precedence: (selOrFalse isinfix
ifTrue: [2]
ifFalse:
[selOrFalse iskeyword
ifTrue: [3]
ifFalse: [1]]) temporaries: self temporaries block: self statements encoder: (LADEncoder new initScopeAndLiteralTables nTemps: tempVars length literals: lits class: class) primitive: primitive.
↑method].
"135" LADDecompiler$'Reverser Performs'
[goto: nibble | |
nibble < 8
ifTrue: [self jmp: nibble + 1]
ifFalse: [self bfp: nibble - 7]].
"87" LADDecompiler$'Decoding'
[decodeInstanceVariable: which | |
↑instVars (which + 1)].
"324" LADDecompiler$'Decoding'
[decodePoolVariable: which | global ref name |
ref ← (literals (which + 1)) key.
symbolTables do:
[:global | (name ← global invertRef: ref)
ifTrue: [↑LADVariableNode new name: name key: ref index: which type: LdLitIndType]].
self error: 'Obsolete global/class/pool variable referenced'].
"109" LADDecompiler$'Reverser Performs'
[send: lowbits | |
prefixStream next← self decodeSelector: lowbits \ 16].
"108" LADDecompiler$'Reverser Performs'
[ldLitInd: which | |
prefixStream next← self decodePoolVariable: which].
"166" LADDecompiler$'Reverser Performs'
[gotoLong: nibble | |
nibble < 8
ifTrue: [self jmp: (self long: nibble - 4)]
ifFalse: [self bfp: (self long: nibble - 12)]].
"106" LADDecompiler$'Reverser Performs'
[sendSpecial: which | |
prefixStream next← self decodeSpecial: which].
"100" LADDecompiler$'Reverser Performs'
[ldLit: which | |
prefixStream next← self decodeLiteral: which].
"88" LADDecompiler$'Decoding'
[decodeTemporaryVariable: which | |
↑tempVars (which + 1)].
"80" LADDecompiler$'Reverser Performs'
[pop: lowbits | |
prefixStream next← #:pop].
"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].
"625" LADDecompiler$'Decompiler'
[remote | block args sel |
"[{:x} | ...]"
hereType #:endMethod
ifFalse: [ "endRemote elided"
self require: #:endRemote].
block ← self block.
self match: #:begin "st76 back-jump".
self require: #:come.
args ← (Vector new: 2) asStream.
(self match: #:arguments)
ifTrue: [[self match: #:pop] whileTrueDo:
[args next← self require: LADVariableNode.
self require: #:store]].
sel ← self advance.
sel key = #blockCopy:
ifTrue: [self advance].
self exactly: NodeThisContext.
block transformRemoteVariable
ifTrue: [↑block].
"ST76 only"
↑block arguments: args contents].
"130" LADDecompiler$'Reverser Subroutines'
[come: dist | |
prefixStream next← #:come.
self reverseTo: postfixStream position + dist].
"91" LADDecompiler$'Reverser Subroutines'
[long: octal | |
↑octal * 256 + postfixStream next].
"664" LADDecompiler$'Initialization'
[decompile: sel in: class | old newBytes tree |
NoteTaker
ifTrue:
[ST80 false
ifTrue: [self classInit].
↑self decompile: sel in: class method: (class method: sel)].
ST80
ifTrue: [self ST76Init].
true
ifTrue:
[tree ← self decompile76: sel in: class method: (class method: sel) "user notify: '*'.".
↑tree].
"special version to check out ST80 decompiling
Convert old bytes to new then decompile new bytes"
tree ← self decompile76: sel in: class method: (class method: sel) "user notify: '*'. ".
newBytes ← tree generate asCompiledMethod.
self classInit.
↑self decompile: sel in: class method: newBytes].
"339" LADDecompiler$'Decompiler'
[expression | e |
"assignment | message | variable | literal | control"
aheadType #:store
ifTrue: [↑self assignment].
(e ← self match: LADVariableNode)
ifTrue: [↑e].
(e ← self match: LADSelectorNode)
ifTrue: [↑self message: e].
(e ← self match: LADLiteralNode)
ifTrue: [↑e].
↑self control].
"155" LADDecompiler$'Decompiler'
[assignment | var |
var ← self advance.
self require: #:store.
↑LADAssignmentNode new variable: var value: self expression].
"445" LADDecompiler$'Decompiler'
[statements | stmts e returns |
returns ← self match: #:endMethod.
stmts ← (Vector new: 10) asStream.
e ← self expression.
(self match: #:endMethod)
ifTrue: [e ← self expression "last return was inaccessible"].
[e] whileTrueDo:
[stmts next← e.
e ← ((self match: #:pop)
ifTrue: [self expression]
ifFalse: [self control])].
↑LADBlockNode new statements: stmts reverseContents returns: returns].
"409" LADDecompiler$'Decompiler'
[conditional: withElse | if then else |
"if ifTrue: then ifFalse: else"
withElse
ifTrue:
[else ← self block.
self require: #:come]
ifFalse: [else ← LADBlockNode default].
then ← self block.
self require: #:come.
↑LADMessageNode new receiver: self expression selector: (LADSelectorNode new key: #ifTrue:ifFalse: code: #macro) arguments: {then , else} precedence: 3].
"88" LADDecompiler$'Reverser Subroutines'
[abguments | |
↑(tempVars (1 to: nArgs)) copy].
"77" LADDecompiler$'Errors'
[confused | |
self error: 'unexpected object code'].
"431" LADDecompiler$'ST76'
[decodeConstant76: which | |
which = 1
ifTrue: [↑NodeSelf].
which > 12
ifTrue:
[which = 13
ifTrue: [↑NodeNil].
which = 14
ifTrue: [↑NodeFalse].
↑NodeTrue]
ifFalse:
[which = 12
ifTrue: [↑LADLiteralNode new key: 10 code: 3].
which < 8
ifTrue: [user notify: 'Cant decode context-rel loads']
ifFalse: [↑LADLiteralNode new key: which - 8 - 1 code: LdMinus1 + which - 8]]].
"1108" LADDecompiler$'ST76'
[decompile76: selOrFalse in: class method: string | i primitive nTemps lits |
instVars ← class instvars.
(1 to: instVars length) do: [:i | instVars i ← LADVariableNode new name: instVars i index: i - 1 type: LdInstType].
string length 6
ifTrue: [↑self quickMethod76: string selector: selOrFalse].
"parse the header"
postfixStream ← string asStream.
postfixStream skip: 1.
primitive ← postfixStream next.
postfixStream skip: 1.
nArgs ← postfixStream next.
nTemps ← postfixStream next.
nLits ← postfixStream next - 6 / 2 "create symbol tables".
tempVars ← Vector new: nTemps.
(1 to: nTemps) do: [:i | tempVars i ← LADVariableNode new name: 't' + i asString index: i - 1 type: LdTempType].
literals ← Vector new: nLits.
lits ← Vector new: nLits.
(1 to: nLits) do: [:i | literals i ← LADLiteralNode new key: lits i ← postfixStream nextword asObject index: i - 1 type: LdLitType].
symbolTables ← {class wholeEnvironment , Smalltalk , Undeclared}.
self reverse "reverse the bytes".
↑self method: selOrFalse primitive: primitive literals: lits class: class].
"96" LADDecompiler$'Scanner'
[match: type | |
hereType type
ifTrue: [↑self advance].
↑false].
"105" LADDecompiler$'Decompiler'
[block | |
"ignores for-effect pop"
self match: #:pop.
↑self statements].
"117" LADDecompiler$'Reverser'
[reverseTo: limit | |
[postfixStream position limit] whileFalseDo: [self reverseNext]].
"713" 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 performDangerously: sel with: byte - (baseTable group) "checked in classInit".
↑sel].
"326" LADDecompiler$'Decoding'
[decodeConstant: lowbits | |
lowbits 4
ifTrue: [↑LADLiteralNode new key: 1 + lowbits - 4 code: LdMinus1 + lowbits - 4].
lowbits = 0
ifTrue: [↑NodeSelf].
lowbits = 1
ifTrue: [↑NodeTrue].
lowbits = 2
ifTrue: [↑NodeFalse].
lowbits = 3
ifTrue: [↑NodeNil].
self confused: lowbits].
"78" LADDecompiler$'Decoding'
[decodeLiteral: which | |
↑literals (which + 1)].
"138" LADDecompiler$'Decoding'
[decodeSelector: which | |
↑LADSelectorNode new key: (literals (which + 1)) key index: which type: SendType].
"130" LADDecompiler$'Decoding'
[decodeSpecial: which | |
↑LADSelectorNode new key: specialTable (which + 1) code: SendPlus + which].
"687" LADDecompiler$'ST76'
[quickMethod76: method selector: selOrFalse | block node |
block ← (method 2 = 1
ifTrue: [LADBlockNode new default mustReturn]
ifFalse:
[method 2 = 40
ifTrue: [LADBlockNode new statements: (instVars (method 5 + 1)) inVector returns: true]
ifFalse: [user notify: 'improper short method']]).
node ← LADMethodNode new selector: (selOrFalse
ifTrue: [LADSelectorNode new key: selOrFalse code: nil]
ifFalse: [false]) arguments: #() precedence: (selOrFalse isinfix
ifTrue: [2]
ifFalse:
[selOrFalse iskeyword
ifTrue: [3]
ifFalse: [1]]) temporaries: #() block: block encoder: nil primitive: 0.
↑node].
"853" LADDecompiler$'Initialization'
[classInit | x |
"LADDecompiler classInit."
typeTable ← #(ldInst: ldTemp: ldLit: ldLit: ldLitInd: ldLitInd: shortStoP: constAndRet: sundry: goto: gotoLong: sendSpecial: sendSpecial: send: send: send: ) "16 groups of 16 byte codes each" "typeTable transform x to [x mustTake: 1]. check for performDangerously".
baseTable ← #(0 16 32 32 64 64 96 112 128 144 160 176 176 208 208 208 ) "subtract base of group to get low bits".
sundryTable ← #(longLoad: longSto: longStoPop: longSend: longSend: longSuper: longSuper: pop: dup: ldThisContext: ldHome: confused: confused: confused: confused: confused: ) "sundryTable transform x to [x mustTake: 1]. check for performDangerously".
specialTable ← (SpecialOops (10 ~ 41)) copy.
specialTable (19 ~ 23) ← {#length , #next , 'next←' unique , #end , #}.
ST80 ← true].
"341" LADDecompiler$'Reverser'
[reverse | |
self backScan "Check for backward jumps".
nextBegin ← beginStream next.
prefixStream ← (Vector new: postfixStream limit * 2) asStream.
self reverseTo: postfixStream limit "Reverse the method".
prefixStream ← prefixStream reverseContents asStream.
self advance.
self advance "Start the scanner"].
"445" LADDecompiler$'Reverser Performs'
[constAndRet: lowbits | |
lowbits < 8
ifTrue: [prefixStream next← self decodeConstant: lowbits]
ifFalse:
[lowbits < 12
ifTrue:
[prefixStream next← self decodeConstant: lowbits - 8.
self endMethod: lowbits]
ifFalse:
[lowbits = 12
ifTrue: [self endMethod: lowbits]
ifFalse:
[lowbits = 13
ifTrue: [self endRemote: lowbits]
ifFalse: [self confused: lowbits]]]]].
"256" LADDecompiler$'Reverser Performs'
[shortStoP: lowbits | |
prefixStream next← #:store.
prefixStream next← (lowbits < 8
ifTrue: [self decodeInstanceVariable: lowbits]
ifFalse: [self decodeTemporaryVariable: lowbits - 8]).
prefixStream next← #:pop].
"527" LADDecompiler$'Reverser Subroutines'
[jmp: dist | nargs argLoc p |
dist < 0
ifTrue: [prefixStream next← #:while]
ifFalse:
[argLoc ← postfixStream position.
ST80
ifTrue:
[nargs ← 0 "collect arguments to block".
[(p ← postfixStream peek) = StorePop or: [(p between: ShortStoP and: [ShortStoP + 15])]] whileTrueDo:
[self reverseNext.
nargs ← nargs + 1].
nargs > 0
ifTrue: [prefixStream next← #:arguments]].
self come: dist - (postfixStream position - argLoc).
prefixStream next← #:else]].
"99" LADDecompiler$'Reverser Subroutines'
[bfp: dist | |
self come: dist.
prefixStream next← #:then].
"100" LADDecompiler$'Reverser Performs'
[ldThisContext: lowbits | |
prefixStream next← NodeThisContext].
"110" LADDecompiler$'Reverser Performs'
[ldInst: which | |
prefixStream next← self decodeInstanceVariable: which].
"111" LADDecompiler$'Reverser Performs'
[ldTemp: which | |
prefixStream next← self decodeTemporaryVariable: which].
"205" LADDecompiler$'Reverser Performs'
[sundry: nibble | sel |
sel ← sundryTable (nibble + 1).
sel 1 = 58 ":"
ifTrue: [prefixStream next← sel]
ifFalse: [self performDangerously: sel with: nibble]].
"92" LADDecompiler$'Reverser Performs'
[endMethod: lowbits | |
prefixStream next← #:endMethod].
"232" LADDecompiler$'Reverser Performs'
[endRemote: lowbits | |
prefixStream next← #:endRemote.
(postfixStream peek between: JmpLong and: [JmpLong + 3])
ifTrue: [postfixStream skip: 2] "skip ST76 back-jmp so it wont make a :while"].
"400" LADDecompiler$'Decompiler'
[control | |
"conditional | loop"
(self match: #:then)
ifTrue:
[(self match: #:else)
ifTrue:
[(self match: #:while)
ifTrue: [↑self while: false].
↑self conditional: true]
ifFalse:
[(self match: #:while)
ifTrue: [↑self while: true].
↑self conditional: false]]
ifFalse:
[(self match: #:else)
ifTrue: [↑self remote].
↑false]].
"86" LADDecompiler$'Errors'
[confused: lowbits | |
self error: 'unexpected object code'].
"80" LADDecompiler$'Reverser Performs'
[dup: lowbits | |
prefixStream next← #:dup].
"81" LADDecompiler$'ST76'
[sendLong76: lowbits | |
self send76: postfixStream next].
"122" LADDecompiler$'ST76'
[storePop76: lowbits | |
prefixStream next← #:store.
self reverseNext.
prefixStream next← #:pop].
"75" LADDecompiler$'ST76'
[ldSuper76: lowbits | |
prefixStream next← #:super].
"86" LADDecompiler$'Reverser Performs'
[ldSelf: lowbits | |
prefixStream next← #:ldSelf].
"89" LADDecompiler$'ST76'
[send76: which | |
prefixStream next← self decodeSelector: which].
"83" LADDecompiler$'ST76'
[ldInstLong76: lowbits | |
self ldInst: postfixStream next].
"87" LADDecompiler$'ST76'
[ldLitIndLong76: lowbits | |
self ldLitInd: postfixStream next].
"98" LADDecompiler$'ST76'
[ldConst76: lowbits | |
prefixStream next← self decodeConstant76: lowbits].
"321" LADDecompiler$'Scanner'
[advance | old |
old ← here.
here ← ahead.
hereType ← aheadType.
ahead ← prefixStream next.
aheadType ← ((ahead is: UniqueString)
ifTrue:
[ahead 1 = 58
ifTrue: [ ":"
ahead]
ifFalse: [#:selector]]
ifFalse: [ahead class "VariableNode or LiteralNode"]).
↑old].
"81" LADDecompiler$'ST76'
[ldLitLong76: lowbits | |
self ldLit: postfixStream next].
"83" LADDecompiler$'ST76'
[ldTempLong76: lowbits | |
self ldTemp: postfixStream next].
"460" LADDecompiler$'Reverser Performs'
[longLoad: lowbits | extension type index |
extension ← postfixStream next.
type ← extension / 64.
index ← extension \ 64.
prefixStream next← (type = 0
ifTrue: [self decodeInstanceVariable: index]
ifFalse:
[type = 1
ifTrue: [self decodeTemporaryVariable: index]
ifFalse:
[type = 2
ifTrue: [self decodeLiteral: index]
ifFalse:
[type = 3
ifTrue: [self decodePoolVariable: index]]]])].
"127" LADDecompiler$'Reverser Performs'
[longStoPop: lowbits | |
self store: lowbits.
self longLoad: lowbits.
self pop: lowbits].
"84" LADDecompiler$'Reverser Performs'
[store: lowbits | |
prefixStream next← #:store].
"105" LADDecompiler$'Scanner'
[require: type | |
hereType type
ifTrue: [↑self advance].
self confused].
"878" LADDecompiler$'Decompiler'
[message: selector | sel prec rcvr n args i supered |
"receiver selector arguments"
ST80 false
ifTrue: [↑self message76: selector].
supered ← self match: #:super.
sel ← selector key.
n ← sel numArgs.
args ← Vector new: n.
(n to: 1 by: 1) do: [:i | args i ← self expression].
prec ← (sel isinfix
ifTrue: [2]
ifFalse:
[sel iskeyword
ifTrue: [3]
ifFalse: [1]]).
hereType #:pop
ifTrue: [↑self cascade: (LADMessageNode new "last msg of cascade" receiver: false selector: selector arguments: args precedence: prec)].
rcvr ← (supered
ifTrue:
[self exactly: NodeSelf.
NodeSuper]
ifFalse:
[(self match: #:dup)
ifTrue: [false]
ifFalse: [ "prior msgs of cascade"
self expression]]).
↑LADMessageNode new receiver: rcvr selector: selector arguments: args precedence: prec].
"105" LADDecompiler$'Scanner'
[exactly: symbol | |
here symbol
ifTrue: [↑self advance].
self confused].
"915" LADDecompiler$'Reverser'
[backScan | byte dist start |
"quickly locates destinations (begins) of back jumps
to handle old for-loops, and while loops with multi-stmt conditions"
start ← postfixStream position.
beginStream ← (Vector new: 2) asStream.
postfixStream do:
[:byte | byte < JmpLong
ifTrue:
[ST80
ifTrue:
[byte < 128
ifFalse:
[byte 134
ifTrue:
[postfixStream next "extension bytes".
(byte = 132 or: [byte = 134])
ifTrue: [postfixStream next]]]]
ifFalse:
[byte < 136
ifFalse:
[byte 140
ifTrue: [postfixStream next "ST76"]]]]
ifFalse:
[byte SendPlus
ifFalse:
[dist ← byte \ 8 - 4 * 256 + postfixStream next.
dist 0 "byte>(JmpLong+3)"
ifFalse: [beginStream next← postfixStream position + 1 + dist]]]].
beginStream ← beginStream contents sort asStream.
postfixStream position← start].
"246" LADDecompiler$'Reverser Performs'
[longSend: lowbits | |
prefixStream next← ((lowbits allmask: 1)
ifTrue: [self decodeSelector: postfixStream next \ 32]
ifFalse:
[postfixStream next "nargs".
self decodeSelector: postfixStream next])].
"514" LADDecompiler$'ST76'
[message76: selector | sel rcvr n args i |
"receiver selector arguments"
sel ← selector key.
rcvr ← ((self match: #:super)
ifTrue:
[self exactly: NodeSelf.
NodeSuper]
ifFalse: [self expression]).
n ← sel numArgs.
args ← Vector new: n.
(n to: 1 by: 1) do: [:i | args i ← self expression].
↑LADMessageNode new receiver: rcvr selector: selector arguments: args precedence: (sel isinfix
ifTrue: [2]
ifFalse:
[sel iskeyword
ifTrue: [3]
ifFalse: [1]])].
"980" LADDecompiler$'ST76'
[ST76Init | x |
"LADDecompiler new ST76Init."
typeTable ← #(ldInst: ldTemp: ldLit: ldLit: ldLitInd: ldLitInd: ldLitInd: ldConst76: sundry: goto: gotoLong: sendSpecial76: sendSpecial76: send76: send76: send76: ) "16 groups of 16 byte codes each" "typeTable transform x to [x mustTake: 1]. check for performDangerously".
baseTable ← #(0 16 32 32 64 64 64 112 128 144 160 176 176 208 208 208 ) "subtract base of group to get low bits".
sundryTable ← #(storePop76: store: pop: endMethod: endRemote: ldThisContext: ldSuper76: ldSelf: ldInstLong76: ldTempLong76: ldLitLong76: ldLitIndLong76: sendLong76: confused: confused: confused: ) "colon marks self-explanatory codes; rest get performed" "sundryTable transform x to [x mustTake: 1]. check for performDangerously".
constantTable ← (SpecialOops (2 ~ 9)) copy.
specialTable ← (SpecialOops (10 ~ 41)) copy.
specialTable (19 ~ 23) ← {#length , #next , 'next←' unique , #end , #}.
ST80 ← false].
"183" LADDecompiler$'ST76'
[sendSpecial76: which | |
(which 18 and: [which 22])
ifTrue: [which ← #(19 20 18 22 21 ) (which - 17)].
prefixStream next← self decodeSpecial: which].
"276" LADDecompiler$'Reverser Performs'
[longSuper: lowbits | |
prefixStream next← #:super.
prefixStream next← ((lowbits allmask: 1)
ifTrue: [self decodeSelector: postfixStream next \ 32]
ifFalse:
[postfixStream next "nargs".
self decodeSelector: postfixStream next])].
"104" LADDecompiler$'Reverser Performs'
[longSto: lowbits | |
self store: lowbits.
self longLoad: lowbits].
"296" LADDecompiler$'Decompiler'
[cascade: lastMessage | messages |
messages ← lastMessage inVector asStream settoend.
[self match: #:pop] whileTrueDo: [messages next← self message: (self require: LADSelectorNode)].
↑LADCascadeNode new receiver: self expression messages: messages reverseContents].
"108" LADDecompiler$'Reverser Subroutines'
[temporaries | |
↑(tempVars (nArgs + 1 to: tempVars length)) copy].
"115" Class$'Message access'
[decompile: sel | |
↑user displayoffwhile [(LADDecompiler new decompile: sel in: self)]].
"681" Class$'Message access'
[copy: sel from: class classified: cat | s code |
"Useful when modifying an existing class"
(sel is: Vector)
ifTrue: [sel do: [:s | self copy: s from: class classified: cat]]
ifFalse:
[(sel is: String)
ifTrue: [self copy: (class organization category: sel) from: class classified: cat]
ifFalse:
[code ← class code: sel.
code nil
ifFalse:
[cat nil
ifTrue: [cat ← class organization invert: sel].
(messagedict has: sel)
ifTrue:
[code text = (self code: sel) text
ifFalse: [user notify: title + ' ' + sel + ' will be redefined if you proceed.']].
self understands: code classified: cat]]]].
"232" Class$'Message access'
[understands: code classified: heading | |
"compile and install method"
↑(NoteTaker
ifTrue: [LADCompiler]
ifFalse: [Generator]) new compile: code asParagraph in: self under: heading notifying: self].
"351" Class$'Filin and Filout'
[filoutOrganization | t1 |
"So we can merge separate work on organization"
user show: title.
user cr.
user displayoffwhile [
((t1 ← dp0 file: title + '.org.') append: title + ' organization fromParagraph:'.
t1 cr.
t1 append: self organization asParagraph text asString.
t1 append: 'asParagraph '.
t1 close)]].
"309" Class$'Editing'
[edit: selector para: para formerly: oldpara | |
NoteTaker
ifTrue: [user schedule: (CodeWindow new class: self selector: selector para: para formerly: oldpara)]
ifFalse:
[user leaveTop.
user restartup: (CodeWindow new class: self selector: selector para: para formerly: oldpara)]].
"193" Class$'Instance access'
[fromFreelist: i fill: vec | |<primitive: 75>
"i = zero order index of freelist in class instance.
vec = vector in pclasses of all possible instances."
user croak].
"203" Class$'Filin and Filout'
[printCategory: s on: pstrm | sel |
self startCategory: s on: pstrm.
(self organization category: s) do: [:sel | self printMethod: sel on: pstrm].
self endCategoryOn: pstrm].
"138" Class$'Filin and Filout'
[startCategory: s on: pstrm | |
pstrm print: (('
' + s) asParagraph maskrunsunder: 241 to: 81) "Font 5, Bold"].
"264" Class$'Initialization'
[title: t subclassof: s fields: f declare: d | |
t 1 (t 1) asUppercase
ifTrue:
[user notify: 'Please capitalize each word in class title: ' + t.
↑false].
self title: t.
self subclassof: s.
self fields: f.
self declare: d].
"142" Class$'Filin and Filout'
[printoutCategory: cat | |
(dp0 file: (title + '-' + cat + '.press') asFileName) printout: (self changelist: cat)].
"71" Class$'Message access'
[shrink | |
messagedict ← messagedict shrink].
"132" Class$'Filin and Filout'
[filout | |
user displayoffwhile [
((dp0 file: title + '.st.') filoutclass: self.
self noChanges)]].
"109" Class$'Initialization'
[title: t1 | |
title ← t1.
self title: (title ← title unique) insystem: Smalltalk].
"194" Class$'Message access'
[textLocal | s |
s ← self organization "makes comment and methods local".
s globalComment← s globalComment.
messagedict do: [:s | messagedict code: s ← self code: s]].
"231" Class$'As yet unclassified'
[recompile: selector | c |
"does not modify code, just compiles it"
c ← messagedict code: selector.
self understands: c asParagraph.
messagedict code: selector ← c "leave remote paragraphs alone"].
"153" Class$'As yet unclassified'
[usesNewSyntax | |
self LADObject
ifTrue: [↑true].
superclass nil
ifTrue: [↑false].
↑superclass usesNewSyntax].
"193" Class$'System Organization'
[category: cat | |
(cat is: String)
ifTrue: [SystemOrganization add: self title unique under: cat]
ifFalse: [user notify: 'Category name must be a String']].
"528" Class$'Message access'
[code80: sel | |
"last paragraph returned is cached (mainly for NotifyWindows)" "return this paragraph xlated to st80 syntax"
(sel lastSelector and: [self lastClass])
ifFalse:
[lastParagraph ← (sel = #ClassOrganization
ifTrue: [self organization]
ifFalse: [ "Paragraph or RemoteParagraph"
messagedict code: sel]) asParagraph.
lastClass ← self.
lastSelector ← sel].
↑(Generator80 new make80: lastParagraph in: self under: nil notifying: nil) asParagraph makeBoldPattern].
"399" Integer$'LargeInteger Compatability'
[ n | t |
n = 1 "behave like a Natural"
ifTrue:
[self < 0
ifTrue: [↑((self land: 255) lxor: 255) + 1 land: 255].
↑self land: 255]
ifFalse:
[n = 2
ifTrue:
[self < 0
ifTrue:
[t ← (self lshift: 8) lxor: 255.
(self land: 255) = 0
ifTrue: [↑t + 1 land: 255].
↑t]
ifFalse: [↑self lshift: 8]]
ifFalse: [↑0]]].
"165" Integer$'Arithmetic'
[+ arg | t |
(arg is: Integer)
ifTrue: [↑self asLarge + arg].
t ← arg asInteger.
t isLarge
ifTrue: [↑self asLarge + arg].
↑self + t].
"99" Integer$'Arithmetic'
[> arg | t |
t ← arg asInteger.
t isLarge
ifTrue: [↑t neg].
↑self > t].
"118" Integer$'Arithmetic'
[< arg | t |
t ← arg asInteger.
t isLarge
ifTrue: [t neg false]
ifFalse: [↑self < t]].
"165" Integer$'Arithmetic'
[- arg | t |
(arg is: Integer)
ifTrue: [↑self asLarge - arg].
t ← arg asInteger.
t isLarge
ifTrue: [↑self asLarge - arg].
↑self - t].
"84" Integer$'As yet unclassified'
[maxVal | |
NoteTaker
ifTrue: [↑16383].
↑32767].
"151" Integer$'Arithmetic'
[= arg | t |
arg isNumber
ifTrue:
[t ← arg asInteger.
t isLarge
ifTrue: [↑false].
↑self = t]
ifFalse: [↑false]].
"107" Integer$'Arithmetic'
[ arg | t |
t ← arg asInteger.
t isLarge
ifTrue: [↑t neg false].
↑self t].
"86" Integer$'As yet unclassified'
[minVal | |
NoteTaker
ifTrue: [↑16384].
↑32768].
"99" Integer$'Arithmetic'
[ arg | t |
t ← arg asInteger.
t isLarge
ifTrue: [↑t neg].
↑self t].
"149" Integer$'Arithmetic'
[ arg | t |
arg isNumber
ifTrue:
[t ← arg asInteger.
t isLarge
ifTrue: [↑true].
↑self t]
ifFalse: [↑true]].
"285" Integer$'Printing'
[printon: strm | |
self < 0
ifTrue:
[self = self minVal
ifTrue: [strm append: (NoteTaker
ifTrue: ['16384']
ifFalse: ['32768'])]
ifFalse:
[strm append: ''.
0 - self printon: strm base: 10]]
ifFalse: [self printon: strm base: 10]].
"168" Integer$'Bit Manipulation'
[lshift: arg | |<primitive: 13>
(NoteTaker and: [arg class Integer])
ifTrue: [↑self asLarge lshift: arg].
↑self lshift: arg asSmall].
"179" Integer$'Arithmetic'
[* arg | t |<primitive: 9>
(arg is: Integer)
ifTrue: [↑self asLarge * arg].
t ← arg asInteger.
t isLarge
ifTrue: [↑self asLarge * arg].
↑self * t].
"196" Integer$'Arithmetic'
[/ arg | |<primitive: 10>
0 = arg
ifTrue: [user notify: 'Attempt to divide by 0']
ifFalse:
[arg isLarge
ifTrue: [↑self asLarge / arg].
↑self / arg asInteger]].
"66" Integer$'Arithmetic'
[| arg | |
"truncate"
↑self / arg * arg].
"204" Integer$'Arithmetic'
[\ arg | |<primitive: 11>
"mod"
0 = arg
ifTrue: [user notify: 'Attempt to divide by 0']
ifFalse:
[arg isLarge
ifTrue: [↑self asLarge \ arg].
↑self \ arg asInteger]].
"90" Integer$'As yet unclassified'
[between: min and: max | |
↑self min and: [self max]].
"270" Integer$'Compiler Bytecodes'
[emitBfp: code on: stack | |
stack pop: 1.
0 = self
ifTrue: [code next← toPop]
ifFalse:
[(1 self and: [self 8])
ifTrue: [code next← self + toShortBfp - 1]
ifFalse: [ "short bfp"
code emitLong: toLongBfp by: self]]].
"225" Integer$'Compiler Bytecodes'
[emitJmp: code on: stack | |
0 = self
ifFalse:
[(1 self and: [self 8])
ifTrue: [code next← self + toShortJmp - 1]
ifFalse: [ "short jmp"
code emitLong: toLongJmp by: self]]].
"94" Integer$'Bit Manipulation'
[hash | |
"used to find large integers in dictionaries"
↑self].
"472" Integer$'Printing'
[printon: strm base: b | i j x |
(x ← self) < 0
ifTrue:
[i ← 1.
digitbuffer 1 ← 16384 \ b * 2 + self - 32768 \ b "Im trying to print 16-bit nos.".
x ← 16384 / b * 2 + (self - 32768 / b)]
ifFalse: [i ← 0].
[x b] whileTrueDo:
[digitbuffer (i ← i + 1) ← x \ b.
x ← x / b].
digitbuffer (i ← i + 1) ← x.
(1 to: i) do:
[:j | x ← digitbuffer i.
strm next← (x < 10
ifTrue: [48 + x]
ifFalse: [55 + x]).
i ← i - 1]].
"108" Integer$'Characters'
[isalphanumeric | |
self isletter
ifTrue: [↑true].
"lower-case"
↑self isdigit].
"49" Integer$'Copying and Purging'
[copy | |
↑self].
"128" Integer$'Subscripts'
[instfield: i | |
"small integer gives trouble"
i = 1
ifTrue: [↑self].
user notify: 'arg too big'].
"137" Integer$'Printing'
[absprinton: strm | rem |
rem ← self \ 10.
self > 9
ifTrue: [self / 10 absprinton: strm].
strm next← rem + 48].
"101" Integer$'Characters'
[asLowercase | |
65 self
ifTrue:
[self 90
ifTrue: [↑self + 32]]].
"291" Integer$'Characters'
[compareChar: c | a |
a ← self "self asLowercase compare: c asLowercase" "written in-line for speed".
65 a
ifTrue:
[a 90
ifTrue: [a ← a + 32]].
65 c
ifTrue:
[c 90
ifTrue: [c ← c + 32]].
a < c
ifTrue: [↑1].
a = c
ifTrue: [↑2].
↑3].
"121" Integer$'Conversion'
[oneToMeAsStream | |
"used by for-loops"
↑Stream new of: (Interval new from: 1 to: self by: 1)].
"63" Integer$'Conversion'
[asFloat | |<primitive: 62>
user croak].
"248" Integer$'Conversion'
[asLarge | me digits |
"convert to LargeInteger"
me ← self bytes.
digits ← Natural new: me length.
digits 1 ← me 1.
digits length = 2
ifTrue: [digits 2 ← me 2].
↑LargeInteger new bytes: digits neg: self neg].
"78" Integer$'Subscripts'
[cansubscript: a | |
↑self 1 and: [self a length]].
"307" Integer$'Compiler Bytecodes'
[emitBytes: code | c t |
self < 256
ifTrue: [code next← self]
ifFalse:
[c ← self lshift: 8.
t ← self land: 255.
#(16 16 32 48 48 ) c > t
ifTrue: [code next← #(0 16 32 64 208 ) c + t]
ifFalse:
[code next← toLoadFieldLong + c - 1.
code next← t]]].
"51" Integer$'Copying and Purging'
[recopy | |
↑self].
"54" Integer$'Arithmetic'
[even | |
↑(self land: 1) = 0].
"74" Integer$'Bit Manipulation'
[lor: arg | |<primitive: 16>
↑arg lor: self].
"148" Integer$'Subscripts'
[subscripts: a | |
(self cansubscript: a)
ifTrue: [↑a self].
user notify: 'Subscript out of bounds: ' + self asString].
"350" Integer$'Subscripts'
[subscripts: a ← val | t |
(self cansubscript: a)
ifTrue:
[t ← val asInteger.
((a Is: String) and: [((t isnt: Integer) or: [(t between: 0 and: [255]) false])])
ifTrue: [user notify: 'Improper store into String']
ifFalse: [↑a self ← t]]
ifFalse: [user notify: 'Subscript out of bounds: ' + self asString]].
"97" Integer$'Arithmetic'
[sameAs: arg | |
"arg assumed to be of same class as self"
↑self = arg].
"217" Integer$'Arithmetic'
[compare: arg | |
(arg is: Integer)
ifTrue:
[self < arg
ifTrue: [↑1].
self = arg
ifTrue: [↑2].
↑3]
ifFalse: [↑self natcompare: arg bytes "4 - (arg bytes natcompare: self)"]].
"94" Integer$'Compiler Bytecodes'
[isField | |
↑self codeLoadField and: [self < codeLoadTemp]].
"70" Integer$'LargeInteger Compatability'
[last | |
↑self self length].
"128" Integer$'LargeInteger Compatability'
[length | |
(self 256 "behave like a Natural" or: [self 256])
ifTrue: [↑2].
↑1].
"175" Integer$'Bit Manipulation'
[field: spec | right |
"spec=width*16 + right (15=left, 0=right)"
right ← 15 - (spec land: 15).
↑self bits: right - (spec / 16) + 1 to: right].
"115" Integer$'LargeInteger Compatability'
[neg | |
self < 0 "behave like a LargeInteger"
ifTrue: [↑true].
↑false].
"558" Integer$'Compiler Bytecodes'
[asCompilerCode | |
"I am a byte code. Return the corresponding compiler code"
self < 16
ifTrue: [↑self + codeLoadField "inst field"].
self < 32
ifTrue: [↑self - 16 + codeLoadTemp "temp"].
self < 64
ifTrue: [↑self - 32 + codeLoadLit "literal"].
self < 111
ifTrue: [↑self - 64 + codeLoadLitInd "indirect literal"].
self < 208
ifTrue: [↑self].
"context relative or constant ... not all values here are legal"
self < 256
ifTrue: [↑self - 208 + codeSendLit "selector"].
user notify: 'unexpected byte'].
"46" Integer$'Arithmetic'
[negate | |
↑0 - self].
"189" Integer$'Bit Manipulation'
[field: spec ← val | right |
"spec=width*16 + right (15=left, 0=right)"
right ← 15 - (spec land: 15).
↑self bits: (right - (spec / 16) + 1) to: right ← val].
"96" Integer$'Conversion'
[asObject | |<primitive: 40>
user notify: 'This object does not exist!'].
"78" Integer$'Conversion'
[inString | t |
t ← String new: 1.
t 1 ← self.
↑t].
"176" Integer$'Characters'
[tokenish | |
"test for token-chars"
self isletter
ifTrue: [↑true].
"lower-case"
self isdigit
ifTrue: [↑true].
"digits"
↑'.:' has: self].
"152" Integer$'Characters'
[isletter | |
self 97
ifTrue: [ " a "
↑self 122].
" z "
self 65
ifTrue: [ " A "
↑self 90].
" Z "
↑false].
"76" Integer$'Bit Manipulation'
[land: arg | |<primitive: 15>
↑arg land: self].
"69" Integer$'Copying and Purging'
[purge | |<primitive: 0>
user croak].
"97" Integer$'Characters'
[isdigit | |
self 48
ifTrue: [ " 0 "
↑self 57].
" 9 "
↑false].
"100" Integer$'Conversion'
[unsigned | |
self < 0
ifTrue: [↑65536.0 + self asFloat].
↑self asFloat].
"66" Integer$'Bit Manipulation'
[allmask: b | |
↑b = (self land: b)].
"66" Integer$'Bit Manipulation'
[anymask: b | |
↑0 (self land: b)].
"38" Integer$'Conversion'
[asSmall | |
].
"128" Integer$'Bit Manipulation'
[hibit | i |
(1 to: 16) do:
[:i | (self land: biton (17 - i)) 0
ifTrue: [↑17 - i]].
↑0].
"45" Integer$'Conversion'
[asInteger | |
↑self].
"76" Integer$'Bit Manipulation'
[lxor: arg | |<primitive: 14>
↑arg lxor: self].
"173" Integer$'Compiler Bytecodes'
[jmpSize | |
↑self = 0
ifTrue: [0]
ifFalse:
[self < 0
ifTrue: [2]
ifFalse:
[self > 8
ifTrue: [2]
ifFalse: [1]]]].
"128" Integer$'Compiler Bytecodes'
[bfpSize | |
↑self < 0
ifTrue: [2]
ifFalse:
[self > 8
ifTrue: [2]
ifFalse: [1]]].
"104" Integer$'Initialization'
[classInit | |
"Initialize the digit buffer"
digitbuffer ← String new: 16].
"65" Integer$'Bit Manipulation'
[nomask: b | |
↑0 = (self land: b)].
"75" Integer$'As yet unclassified'
[asInt32 | |
↑Int32 new high: 0 low: self].
"102" Integer$'Characters'
[asUppercase | |
97 self
ifTrue:
[self 122
ifTrue: [↑self - 32]]].
"47" Integer$'Arithmetic'
[negated | |
↑0 - self].
"139" Integer$'Conversion'
[asNatural | t |
t ← Natural new: self length.
t 1 ← self 1.
t length > 1
ifTrue: [t 2 ← self 2].
↑t].
"136" Integer$'LargeInteger Compatability'
[bytes | |
↑self "behave like a LargeInteger - negative integers behave like positive naturals"].
"110" Integer$'Arithmetic'
[unsignedadd: y | |
↑self + y "treat numbers as unsigned 8-bit quantities." land: 255].
"105" Integer$'Arithmetic'
[unsignedlessthan: y | |
↑self < y "treat numbers as unsigned 8-bit quantities."].
"1406" Integer$'Compiler Bytecodes'
[printon: strm indent: level precedence: p forValue: v decompiler: decompiler | lit |
v false
ifFalse:
[self < 112
ifTrue: [user notify: 'unknown code']
ifFalse:
[self < 128
ifTrue: [strm append: #('sender' 'self' '?' '?' '?' '?' '?' '?' '1' '0' '1' '2' '10' 'nil' 'false' 'true' ) (self - 111)]
ifFalse:
[self = 133
ifTrue: [strm append: 'thisContext']
ifFalse:
[self = 134
ifTrue: [strm append: 'super']
ifFalse:
[self < 167
ifTrue: [user notify: 'unknown code']
ifFalse:
[self < 208
ifTrue: [strm append: SpecialOops (self - 166)]
ifFalse:
[self < 256
ifTrue: [user notify: 'unknown code']
ifFalse:
[self < 512
ifTrue: [strm append: (decompiler instvar: self)]
ifFalse:
[self < 768
ifTrue: [strm append: (decompiler temp: self)]
ifFalse:
[self < 1024
ifTrue:
[lit ← decompiler literalDirect: self.
((lit is: UniqueString) or: [(lit is: Vector)])
ifTrue: [strm append: '#'].
lit printon: strm]
ifFalse:
[self < 1280
ifTrue: [strm append: (decompiler literalIndirect: self)]
ifFalse: [strm append: (decompiler selector: self)]]]]]]]]]]]]].
"47" Integer$'As yet unclassified'
[asInt16 | |
].
"310" Integer$'As yet unclassified'
[bits: left to: right | width mask |
" 0 is leftmost bit, 15 is rightmost"
width ← right - left + 1.
mask ← (width < 15
ifTrue: [biton (width + 1) - 1]
ifFalse:
[width = 15
ifTrue: [32767]
ifFalse: [1]]).
↑(self lshift: right - 15) land: mask].
"279" Integer$'LargeInteger Compatability'
[natcompare: arg | i len t4 t5 |
len ← self length.
(t4 ← arg length) < len
ifTrue: [↑3].
t4 > len
ifTrue: [↑1].
(len to: 1 by: 1) do:
[:i | (t5 ← self i) > (arg i)
ifTrue: [↑3].
t5 < (arg i)
ifTrue: [↑1]].
↑2].
"380" Integer$'LargeInteger Compatability'
[natnormalize: n | x i r f digit |
r ← Natural new: self length "n is the number of bits to shift by. The Natural number returned will be written over repeatedly, so we must make a new one." + 1.
x ← 0.
f ← n - 8.
(1 to: r length) do:
[:i | digit ← self i.
r i ← ((digit lshift: n) lor: x) land: 255.
x ← digit lshift: f].
↑r].
"58" Integer$'As yet unclassified'
[hex4 | |
↑self base: 16].
"212" Integer$'As yet unclassified'
[asOop | |
NoteTaker
ifTrue:
[self 0
ifTrue: [↑32768 + self].
"0...16K-1 --> 32K...48K-1"
↑65536 + self]
ifFalse: [ "-16K...-1 --> 48K...64K-1"
↑super asOop]].
"392" Integer$'Initialization'
[fromString: str radix: radix | maxdigit c val i |
maxdigit ← radix + (radix > 10
ifTrue: [55 - 1]
ifFalse: [48 - 1]).
val ← 0.
(1 to: str length) do:
[:i | c ← str i.
(c < 48 or: [c > maxdigit])
ifTrue: [↑false].
val ← val * radix + (c 57
ifTrue: [c - 48]
ifFalse:
[c < 65
ifTrue: [↑false].
c - 55])].
↑val].
"192" Integer$'Arithmetic'
[intdiv: arg | |
(arg is: Integer)
ifTrue: [↑{self / arg , (self \ arg)}].
(arg is: LargeInteger)
ifTrue: [↑self asLarge intdiv: arg].
user notify: 'I give up'].
"52" Integer$'LargeInteger Compatability'
[isInt | |
].
"153" Integer$'As yet unclassified'
[asRemoteCode: generator | |
↑super asRemoteCode: generator "Defeat generation of FieldReferences for remote variables"].
"112" Integer$'Compiler Bytecodes'
[emitsLoad | |
self < 256
ifTrue: [↑self < toSmashPop].
↑self < codeSendLit].
"148" Integer$'Compiler Bytecodes'
[emittedVariable | |
(self < 256
ifTrue: [self toSuper]
ifFalse: [self < codeSendLit])
ifFalse: [↑false]].
"53" Integer$'Arithmetic'
[odd | |
↑(self land: 1) = 1].
"372" Integer$'As yet unclassified'
[bits: left to: right ← val | width mask |
" 0 is leftmost bit, 15 is rightmost"
width ← right - left + 1.
mask ← (width < 15
ifTrue: [biton (width + 1) - 1]
ifFalse:
[width = 15
ifTrue: [32767]
ifFalse: [1]]).
↑(self land: ((mask lshift: 15 - right) lxor: 1)) lor: ((val land: mask) lshift: 15 - right)].
"87" Integer$'As yet unclassified'
[elementStream | |
↑Stream new of: (Vector new: self)].
"120" Integer$'As yet unclassified'
[inUniqueString | |
self < 128
ifTrue: [↑UST1 (self + 1)].
↑self inString unique].
"723" Integer$'Compiler Bytecodes'
[findMacros: macros compilerTemps: compilerTemps | i j assignment |
(self < codeLoadTemp or: [self > (codeLoadTemp + 255)])
ifFalse:
[ "this temp is not compiler-generated"
j ← self - codeLoadTemp + 1.
compilerTemps j false
ifFalse:
[compilerTemps j nil
ifTrue: [compilerTemps j ← false]
ifFalse:
[ "The temp isn't compiler-generated after all!! Nil out the macro"
(macros position to: 2 by: 2) do:
[:i | assignment ← macros (i - 1) (macros i).
assignment var = self
ifTrue:
[macros i ← nil.
macros (i - 1) ← nil.
compilerTemps j ← false.
↑nil]].
user notify: 'couldnt find bad macro']]]].
"148" Integer$'Compiler Bytecodes'
[sizeForValue | |
(self < 256 or: [#(16 16 32 48 48 ) (self lshift: 8) > (self land: 127)])
ifTrue: [↑1].
↑2].
"167" Integer$'Compiler Bytecodes'
[emitForValue: code on: stack | |
self = toSuper
ifTrue: [code next← toLoadSelf]
ifFalse: [self emitBytes: code].
stack push: 1].
"48" Integer$'Compiler Bytecodes'
[firstPush | |
].
"614" String$'Comparison'
[systemRehash | dicts d left loop |
String understands: 'hash | l m
[[(l← m← self length)2
[l=2[m←3]; =1[((self1) land: 0177)*0152] 052525]].
(self1)*060+(self(m-1)+l)]' "change the meaning of hash for Strings" "rehash the atom table".
#a rehash "rehash all dictionaries which have strings in them".
dicts ← HashSet allInstances + Dictionary allInstances + SymbolTable allInstances.
dicts do:
[:d | left ← d objects asStream.
loop ← left next.
[loop] whileTrueDo:
[(loop is: String)
ifTrue:
[d rehash.
loop ← false]
ifFalse: [loop ← left next]]]].
"201" String$'Copying and Altering'
[replace: a to: b by: s | |
(s Is: String)
ifTrue: [↑self replace: a to: b by: s from: 1 to: s length].
↑self replace: a to: b by: s asArray from: 1 to: s position].
"156" String$'Comparison'
[> s | |
↑(self compare: s) "Return true iff I collate after s. The collation sequence is ascii with case differences ignored." = 3].
"157" String$'Comparison'
[< s | |
↑(self compare: s) "Return true iff I collate before s. The collation sequence is ascii with case differences ignored." = 1].
"379" String$'Comparison'
[- s | i c ldiff |
(1 to: "Return a negative, zero, or positive integer as I compare < = or > s" "The collation sequence is ascii with case differences ignored."
((ldiff ← self length - s length) < 0
ifTrue: [self length]
ifFalse: [s length])) do:
[:i | (c ← UpperCase (self i + 1) - (UpperCase (s i + 1))) 0
ifTrue: [↑c]].
↑ldiff].
"79" String$'Conversion'
[asParagraph | |
↑Paragraph new text: self alignment: 0].
"123" String$'Conversion'
[asUppercase | s c |
s ← Stream default.
self do: [:c | s next← UpperCase (c + 1)].
↑s contents].
"418" String$'Conversion'
[asDecimalDigits | strm sign c val |
"Not asInteger, because the result may be a Float if it's too big"
strm ← Stream new of: self.
sign ← strm 21.
val ← (self length > 4
ifTrue: [0.0]
ifFalse: [0]).
strm do:
[:c | (c < 48 or: [c > 57])
ifTrue: [user notify: self + ' isn''t a valid integer']
ifFalse: [val ← val * 10 + (c - 48)]].
sign
ifTrue: [↑val * 1].
↑val].
"65" String$'Conversion'
[hasBeenUniqued | |
↑#a hasInterned: self].
"205" String$'Conversion'
[printon: strm | x |
"print inside string quotes"
strm next← 39.
self do:
[:x | strm next← x.
x = 39
ifTrue: [strm next← x]].
strm next← 39 "imbedded quotes get doubled"].
"61" String$'Conversion'
[asVector | |
↑self asStream asVector].
"130" String$'Copying and Altering'
[copy: a to: b | |
↑(self species new: 1 + b - a) copy: 1 to: 1 + b - a with: self from: a to: b].
"253" String$'Copying and Altering'
[concat: s | len |
((len ← self length) + s length > 20 and: [(s Is: String)])
ifTrue: [↑self replace: len + 1 "this concatenates more quickly if BitBlt is used" to: len by: s from: 1 to: s length].
↑super concat: s].
"102" String$'As yet unclassified'
[asCompiledMethod | |
↑self copyto: (CompiledMethod new: self length)].
"95" String$'Reading and Writing'
[length | |
↑self length "In case this is reached by perform:"].
"222" String$'Comparison'
[hash | l m |
(l ← m ← self length) 2
ifTrue:
[l = 2
ifTrue: [m ← 3]
ifFalse:
[l = 1
ifTrue: [↑(self 1 land: 127) * 106].
↑21845]].
↑self 1 * 48 + (self (m - 1) + l)].
"56" String$'System primitives'
[lock | |<primitive: 75>
].
"270" String$'Copying and Altering'
[findString: str startingAt: start | i t |
str length = 0
ifTrue: [↑0].
t ← str 1.
(start to: self length - str length + 1) do:
[:i | self i = t
ifTrue:
[self (i to: i + str length - 1) = str
ifTrue: [↑i]]].
↑0].
"346" String$'Conversion'
[asLarge | neg i large large10 |
"convert to a LargeInteger"
self 1 = 21
ifTrue: [neg ← true]
ifFalse: [neg ← false].
large ← 0 asLarge.
large10 ← 10 asLarge.
((neg
ifTrue: [2]
ifFalse: [1]) to: self length) do: [:i | large ← large * large10 + (self i - 48)].
neg
ifTrue: [↑large negated].
↑large].
"47" String$'Compatibility'
[species | |
↑String].
"118" String$'Reading and Writing'
[word: x | |
"read word in String"
↑self (x + x) + (self (x + x - 1) lshift: 8)].
"122" String$'Conversion'
[asBytes | s c |
s ← Stream default.
self do:
[:c | s append: c base8.
s space].
↑s contents].
"328" String$'Conversion'
[asFloat | strm int frac exp |
strm ← Stream new of: self.
int ← strm upto: 46.
frac ← strm upto: 101.
exp ← strm rest asInteger - frac length.
int ← (int concat: frac) asDecimalDigits asFloat.
exp = 0
ifTrue: [↑int].
exp > 0
ifTrue: [↑int * (10.0 ipow: exp)].
.
↑int / (10.0 ipow: 0 - exp)].
"58" String$'System primitives'
[unlock | |<primitive: 75>
].
"94" String$'Conversion'
[base8: i | |
"word: i in base 8 as a String"
↑(self word: i) base8].
"56" String$'Copying and Altering'
[recopy | |
↑self copy].
"74" String$'Conversion'
[unique | u |
"copy and intern"
↑#a intern: self].
"144" String$'Reading and Writing'
[word: x ← y | |
"write word in String"
self (x + x - 1) ← y lshift: 8.
self (x + x) ← y land: 255.
↑y].
"792" String$'Comparison'
[match: text | star pound pattern scanning p t back |
star ← 42 "*".
pound ← 35 "#".
pattern ← self asStream.
text ← text asStream.
scanning ← false.
[true] whileTrueDo:
[(p ← pattern next) = star
ifTrue:
[pattern end
ifTrue: [↑true].
scanning ← pattern position]
ifFalse:
[(t ← text next) false
ifTrue: [↑t p].
p false
ifTrue:
[scanning
ifTrue:
[back ← scanning - pattern position.
pattern skip: back.
text skip: back]
ifFalse: [↑false]]
ifFalse:
[(UpperCase (t + 1) = (UpperCase (p + 1)) or: [p = pound])
ifFalse:
[scanning
ifTrue:
[back ← scanning - pattern position.
pattern skip: back.
text skip: back + 1]
ifFalse: [↑false]]]]]].
"372" String$'Comparison'
[compare: s | i len lcomp u1 u2 t7 |
lcomp ← ((t7 ← self length) < (len ← s length)
ifTrue:
[len ← self length.
1]
ifFalse:
[t7 = len
ifTrue: [2]
ifFalse: [3]]).
(1 to: len) do:
[:i | (u1 ← UpperCase (self i + 1)) = (u2 ← UpperCase (s i + 1))
ifFalse:
[u1 < u2
ifTrue: [↑1].
↑3]].
↑lcomp].
"166" String$'Copying and Altering'
[growto: n | len |
(len ← self length) n
ifFalse: [len ← n].
↑(self species new: n) copy: 1 to: len with: self from: 1 to: len].
"127" String$'Reading and Writing'
[fill: a to: b with: val | i |
(a to: b) do: [:i | "eventually use BitBlt?"
self i ← val]].
"85" String$'Reading and Writing'
[all← val | |
self fill: 1 to: self length with: val].
"459" String$'Copying and Altering'
[replace: a to: b by: r from: c to: d | s t |
s ← self species new: self length + (d - c) - (b - a) "use BitBlt unless StringBlterfalse or index/sizes too large".
(StringBlter and: [(BitBlt new stringReplace: s with: self from: a to: b and: [r] from: c to: d)])
ifTrue: [↑s].
"see Array concat:"
t ← Stream new of: s.
self copy: 1 to: a - 1 to: t.
r copy: c to: d to: t.
self copy: b + 1 to: self length to: t.
↑s].
"659" String$'Copying and Altering'
[copy: a to: b with: s from: c to: d | i |
((b - a "like replace, except in place. self(a to: b) ← s(c to: d).
use BitBlt unless size too small, StringBlterfalse, or index/sizes too large" > 12 and: [StringBlter]) and: [(BitBlt new stringCopy: self from: a to: b with: s from: c to: d)])
ifFalse:
[(self s and: [(c < a and: [d a])])
ifTrue: [(b - a "overlap of second range with below first in same string.
copy in reverse order: self(b to: a by: 1) ← self(d to: c by: 1)" to: 0 by: 1) do: [:i | self (a + i) ← self (c + i)]]
ifFalse: [s copy: c to: d to: (Stream new of: self from: a to: b)]]].
"424" String$'As yet unclassified'
[inBase: b | neg i j large large10 |
"convert to a LargeInteger"
self 1 = 21
ifTrue: [neg ← true]
ifFalse: [neg ← false].
large ← 0 asLarge.
large10 ← b asLarge.
((neg
ifTrue: [2]
ifFalse: [1]) to: self length) do: [:i | large ← large * large10 + ((j ← self i) 65 "A"
ifTrue: [j - 65 + 10]
ifFalse: [j - 48 "0"])].
neg
ifTrue: [↑large negated].
↑large].
"69" String$'As yet unclassified'
[alignForDisplay | |<primitive: 84>
].
"84" String$'As yet unclassified'
[run: rcvr in: mclass | |<primitive: 75>
user croak].
"409" String$'As yet unclassified'
[setSourcePosition: pos inFile: f | loc p1 |
"set last three bytes to be pos in file (0-3)"
f > 3
ifTrue: [user notify: 'invalid file number']
ifFalse:
[loc ← self length - 2.
self (loc + 2) ← f * 64 + (p1 ← pos / 65536).
pos ← pos - (p1 * 65536) "into two bytes".
self (loc + 1) ← p1 ← pos / 256.
pos ← pos land: 255 "into one byte".
self loc ← pos]].
"93" String$'Conversion'
[asBitmap | t |
t ← Bitmap new: self length / 2.
↑t fromString: self].
"59" String$'As yet unclassified'
[stringhash | |
↑self hash].
"528" String$'Copying and Altering'
[subst: repl for: key | key1 i nskip result |
nskip ← 0.
key1 ← key 1.
result ← Stream default.
(1 to: self length) do:
[:i | " the Boyer Slow string replacement "
nskip > 0
ifTrue: [nskip ← nskip - 1]
ifFalse:
[self i = key1
ifTrue:
[self (i to: (self length min: i + key length - 1)) = key
ifTrue:
[result append: repl.
nskip ← key length - 1]
ifFalse: [result next← self i]]
ifFalse: [result next← self i]]].
↑result contents].
"999" String$'Conversion'
[asInteger | sign base maxdigit c val i i1 i2 |
self length = 0
ifTrue: [↑0].
i1 ← 1.
i2 ← self length.
sign ← (self 1 = 21
ifTrue:
[i1 ← 2.
1]
ifFalse: [1]).
base ← (self self length = 72
ifTrue:
[i2 ← i2 - 1.
16]
ifFalse:
[self i1 = 48
ifTrue: [8]
ifFalse: [10]]).
maxdigit ← (base = 16
ifTrue: [70]
ifFalse: [47 + base]).
val ← (self length > 4
ifTrue: [0.0]
ifFalse: [0]).
(i1 to: i2) "octal and hex packed into 16-bit Integers" do:
[:i | c ← self i.
(c < 48 or: [c > maxdigit])
ifTrue: [user notify: self + ' isn''t a valid Integer']
ifFalse: [val ← val * base + (c 57
ifTrue: [c - 48]
ifFalse: [c - 55])]].
val > 32767
ifTrue:
[(base = 8 or: [base = 16])
ifTrue:
[sign = 1
ifTrue:
[val < 65536
ifTrue: [↑(val - 65536) asInteger].
user notify: 'Warning: Octal or Hex number exceeds 16 bits']]].
↑(val * sign) asInteger].
"73" String$'Conversion'
[asFileName | |
↑dp0 checkName: self fixing: true].
"115" Vector$'Copying and Altering'
[, x | v |
v ← self growby: 1 "use a stream if youre in a hurry".
v last← x.
↑v].
"193" Vector$'Searching'
[max | biggest i |
biggest ← self 1 "return largest value in a vector".
(1 to: self length) do:
[:i | self i > biggest
ifTrue: [biggest ← self i]].
↑biggest].
"150" Vector$'Conversion'
[printon: strm | i |
strm append: '('.
(1 to: self length) do:
[:i | strm print: self i.
strm space].
strm append: ')'].
"38" Vector$'Conversion'
[asVector | |
].
"78" Vector$'Compiler argument list'
[argsOff: stack | |
stack pop: self length].
"111" Vector$'System primitives'
[nail | |<primitive: 75>
user croak "Nail me in core and return my core address"].
"96" Vector$'Compiler argument list'
[remote: generator | x |
self do: [:x | x remote: generator]].
"136" Vector$'As yet unclassified'
[hex | s y |
s ← (String new: 4 * self length) asStream.
self do: [:y | s append: y hex].
↑s contents].
"118" Vector$'Reading and Writing'
[length | |
"This is actually done in microcode"
↑self length "perform: needs this"].
"99" Vector$'System primitives'
[unNail | |<primitive: 75>
user croak "Release me from being nailed"].
"124" Vector$'Compiler argument list'
[sizeForValue | size x |
size ← 0.
self do: [:x | size ← size + x sizeForValue].
↑size].
"118" Vector$'Compiler argument list'
[emitForValue: code on: stack | x |
self do: [:x | x emitForValue: code on: stack]].
"72" Vector$'Compiler argument list'
[firstPush | |
↑(self 1) firstPush].
"212" Vector$'As yet unclassified'
[base: b | strm i |
"convert vector of numbers to a base"
strm ← Stream default.
(1 to: self length) do:
[:i | strm append: (self i base: b).
strm space].
↑strm contents].
"71" Stream$'Static reading and writing'
[ x ← val | |
↑array x ← val].
"516" Stream$'Sequential reading and writing'
[nextNumber: n ← v | vlen |
v ← v bytes "write a positive Integer or LargeInteger as n characters".
vlen ← v length.
n < vlen
ifTrue: [user notify: 'number too big']
ifFalse:
[n > vlen
ifTrue: [self next: (n - vlen) "pad beginning with 0's" ← 0]].
vlen = 1
ifTrue: [self next← v]
ifFalse:
[(vlen = 2 and: [(v is: Integer)])
ifTrue: [self nextword← v]
ifFalse: [ "LargeInteger (assume pos, no negative convention)"
self append: v reverse]]].
"53" Stream$'Character printing'
[cr | |
self next← 13].
"59" Stream$'Static reading and writing'
[ x | |
↑array x].
"663" Stream$'Sequential reading and writing'
[nextNumber: n | i s t |
s ← false "return next n characters s as a positive Integer or LargeInteger" "scan for first non-zero byte, then collect rest appropriately".
(1 to: n) do:
[:i | t ← self next.
s
ifTrue: [s (n + 1 "more LargeInteger: reverse order of significance" - i) ← t]
ifFalse:
[i = n
ifTrue: [↑t].
t = 0
ifFalse:
[(i (n - 2) or: [(t land: 128) "i=n-1" 0])
ifTrue:
[s ← Natural new: n + 1 "LargeInteger of 2 or more bytes" - i.
s last← t]
ifFalse: [ "positive Integer"
↑(t lshift: 8) + self next]]]].
↑LargeInteger new bytes: s neg: false].
"78" Stream$'Test and alter position'
[wordposition← w | |
self position← w * 2].
"244" Stream$'Sequential reading and writing'
[nextString | len |
↑self into: (String new: ((len ← self next) < 192
ifTrue: [len]
ifFalse: [ "up to 191 chars (BCPL compat)"
len - 192 * 256 + self next])) endError: true "up to 16383 chars"].
"53" Stream$'Character printing'
[tab | |
self next← 9].
"206" Stream$'Sequential reading and writing'
[nextString← s | len |
(len ← s length) < 192
ifTrue: [self next← len]
ifFalse:
[self next← len / 256 + 192.
self next← len \ 256].
self append: s.
↑s].
"68" Stream$'Test and alter position'
[position← t1 | |
position ← t1].
"214" Stream$'Initialization'
[of: t1 from: pos to: lim | len |
array ← t1.
limit ← (lim > (len ← array length)
ifTrue: [len]
ifFalse: [lim]).
position ← (pos 1
ifTrue: [0]
ifFalse: [pos - 1])].
"65" Stream$'Character printing'
[semicrtab | |
self append: ';
'].
"66" Stream$'Initialization'
[default | |
self of: (String new: 16)].
"107" Stream$'Coercions'
[asVector | |
"Convert a string to a vector of tokens"
↑(Reader new of: self) read].
"221" Stream$'Sequential reading and writing'
[ x | y |
(y ← self next)
ifTrue:
[ "peek for matching element"
x = y
ifTrue: [↑y].
"gobble it if found"
position ← position - 1.
↑false]
ifFalse: [↑false]].
"56" Stream$'Character printing'
[space | |
self next← 32].
"140" Stream$'Sequential reading and writing'
[pop: n | t |
position < n
ifTrue: [↑false].
t ← self last: n.
position ← position - n.
↑t].
"63" Stream$'Test and alter position'
[end | |
↑position limit].
"88" Stream$'Initialization'
[of: t1 | |
array ← t1.
position ← 0.
limit ← array length].
"80" Stream$'Test and alter position'
[loc | |
"synonym for compiler"
↑position].
"158" Stream$'Sequential reading and writing'
[pop | |
"use it as a LIFO"
position < 1
ifTrue: [↑false].
position ← position - 1.
↑array (position + 1)].
"105" Stream$'Sequential reading and writing'
[append: x | i |
"Array arg"
x do: [:i | self next← i].
↑x].
"355" Stream$'Compiler object code'
[emitLong: jmpOrBfp by: dist | |
dist < 0
ifTrue: [dist ← dist + 1024]
ifFalse:
[dist > 1023
ifTrue: [dist ← 1]
ifFalse: [jmpOrBfp ← jmpOrBfp + 4]].
dist < 0
ifTrue: [user notify: 'A block compiles more than 1K bytes of code']
ifFalse:
[self next← dist / 256 + jmpOrBfp.
self next← dist \ 256]].
"65" Stream$'Character printing'
[print: obj | |
obj printon: self].
"122" Stream$'Sequential reading and writing'
[nextword← val | |
self next← val lshift: 8.
self next← val land: 255.
↑val].
"109" Stream$'Sequential reading and writing'
[next: n from: strm | |
(1 to: n) do: [:n | self next← strm next]].
"109" Stream$'Sequential reading and writing'
[padNext← c | |
position even
ifTrue: [↑false].
↑self next← c].
"328" Stream$'Static reading and writing'
[insert: x | i |
"treat as LIFO queue, insert in front"
"grow array if necessary"
position = limit
ifTrue:
[array ← array grow.
limit ← array length].
(1 to: position) do: [:i | array (position - i + 2) ← array (position - i + 1)].
array 1 ← x.
position ← position + 1].
"580" Stream$'Sequential reading and writing'
[integerScan | sign base maxdigit c val |
sign ← "get the next Integer or LargeInteger (Float?) from a Stream.
copied from String asInteger"
(self 21
ifTrue: [1]
ifFalse: [1]).
base ← (self 48
ifTrue: [8]
ifFalse: [10]).
maxdigit ← 48 + base.
val ← 0.
[(c ← self next) and: [(c 48 and: [c < maxdigit])]] whileTrueDo: [val ← val * base + (c - 48)].
c
ifTrue: [self skip: 1].
(base = 8 and: [(val > 32767 and: [(sign = 1 and: [val < 65536])])])
ifTrue: [↑val asSmall].
↑(val * sign) asInteger].
"106" Stream$'Test and alter position'
[skipTo: x | y |
self do:
[:y | y = x
ifTrue: [↑true]].
↑false].
"161" Stream$'Sequential reading and writing'
[next | |<primitive: 20>
"simple result"
self myend
ifTrue: [↑self pastend].
↑array (position ← position + 1)].
"85" Stream$'Static reading and writing'
[rest | |
↑array copy: position + 1 to: limit].
"93" Stream$'Static reading and writing'
[last | |
position 0
ifTrue: [↑array position]].
"150" Stream$'Sequential reading and writing'
[peek | x |
(x ← self next)
ifTrue:
[position ← position - 1.
↑x].
"peek at next element"
↑false].
"81" Stream$'Static reading and writing'
[contents | |
↑array copy: 1 to: position].
"37" Stream$'Coercions'
[asStream | |
].
"168" Stream$'As yet unclassified'
[reverseContents | a s i |
a ← array species new: position.
s ← a asStream.
(position to: 1 by: 1) do: [:i | s next← array i].
↑a].
"62" Stream$'Test and alter position'
[limit: t1 | |
limit ← t1].
"151" Stream$'Sequential reading and writing'
[into: x | |
↑self into: x endError: true "generate an error if the Stream is exhausted before x is filled"].
"73" Stream$'Test and alter position'
[skip: x | |
position ← position + x].
"100" Stream$'Static reading and writing'
[last: n | |
↑(array (position - n + 1 to: position)) copy].
"170" Stream$'Sequential reading and writing'
[upto: x | y s |
s ← (String new: 250) asStream.
self do:
[:y | y = x
ifTrue: [↑s contents].
s next← y].
↑s contents].
"65" Stream$'Test and alter position'
[myend | |
↑position limit].
"42" Stream$'Coercions'
[asArray | |
↑array].
"67" Stream$'Test and alter position'
[settoend | |
position ← limit].
"178" Stream$'Sequential reading and writing'
[nextword | hi lo |
(hi ← self next)
ifTrue:
[(lo ← self next)
ifTrue: [↑(hi lshift: 8) + lo].
↑false]
ifFalse: [↑false]].
"110" Stream$'Test and alter position'
[pastend← x | |
array ← array grow.
limit ← array length.
↑self next← x].
"218" Stream$'Sequential reading and writing'
[dequeue: n | t |
position < n
ifTrue: [↑false].
t ← (array (1 to: n)) copy.
array (1 to: position - n) ← array (n + 1 to: position).
position ← position - n.
↑t].
"87" Stream$'Static reading and writing'
[first | |
position 0
ifTrue: [↑array 1]].
"60" Stream$'Test and alter position'
[reset | |
position ← 0].
"56" Stream$'Test and alter position'
[pastend | |
↑false].
"94" Stream$'Sequential reading and writing'
[dequeue | |
"use it as a FIFO"
↑self dequeue: 1].
"69" Stream$'Test and alter position'
[empty | |
"for"
↑position = 0].
"168" Stream$'Sequential reading and writing'
[next← x | |<primitive: 21>
"simple arg"
self myend
ifTrue: [↑self pastend← x].
↑array (position ← position + 1) ← x].
"60" Stream$'Test and alter position'
[position | |
↑position].
"54" Stream$'Test and alter position'
[limit | |
↑limit].
"80" Stream$'Coercions'
[viewer | |
↑SetReader new of: array from: 1 to: position].
"70" Stream$'Initialization'
[close | |
limit ← position.
position ← 0].
"106" Stream$'Sequential reading and writing'
[next: n | |
↑self into: (array species new: n) endError: true].
"94" Stream$'Sequential reading and writing'
[next: n ← v | |
(1 to: n) do: [:n | self next← v]].
"367" Stream$'Sequential reading and writing'
[into: x endError: err | i t len |
i ← 0 "Array result".
len ← x length "read until count or stream is exhausted".
[i < len and: [(t ← self next)]] whileTrueDo: [x (i ← i + 1) ← t].
err
ifTrue:
[t
ifTrue: [↑x].
user notify: 'only read first ' + i asString]
ifFalse: [ "return number that were read"
↑i]].
"178" Stream$'Coercions'
[asReadStream | |
↑Stream new "an alternative to Set/SetReader.
create another Stream which reads the contents of this one" of: array from: 1 to: position].
"88" Stream$'Sequential reading and writing'
[nextElement: element | |
self next← element].
"97" Stream$'Character printing'
[crtab: n | i |
self next← 13.
(1 to: n) do: [:i | self next← 9]].
"52" Stream$'Initialization'
[release | |
array ← nil].
"107" Stream$'As yet unclassified'
[do: aBlock | |
[self end] whileFalseDo: [aBlock value: self next].
↑nil].
"179" Stream$'Sequential reading and writing'
[padNext | |
position even "make position even (on word boundary), returning padding character if any"
ifTrue: [↑false].
↑self next].
"113" Stream$'Sequential reading and writing'
[nextPoint | x |
x ← self nextword.
↑Point new x: x y: self nextword].
"101" Stream$'Sequential reading and writing'
[nextPoint← p | |
self nextword← p x.
self nextword← p y].
"71" Stream$'Test and alter position'
[skipwords: w | |
self skip: 2 * w].
"73" Stream$'Test and alter position'
[wordposition | |
↑self position / 2].
"59" Float$'Conversion'
[fpart | |<primitive: 59>
user croak].
"100" Float$'Conversion'
[round | |
↑(self + (self < 0
ifTrue: [0.5]
ifFalse: [0.5])) asInteger].
"152" Float$'Conversion'
[asInteger | |<primitive: 60>
"Return an Integer = self ipart"
↑(self / 10000.0) asInteger * 10000 + (self \ 10000.0) asInteger].
"68" Float$'Arithmetic'
[+ arg | |<primitive: 49>
↑self + arg asFloat].
"68" Float$'Arithmetic'
[> arg | |<primitive: 52>
↑self > arg asFloat].
"68" Float$'Arithmetic'
[< arg | |<primitive: 51>
↑self < arg asFloat].
"68" Float$'Arithmetic'
[- arg | |<primitive: 50>
↑self - arg asFloat].
"600" Float$'Math functions'
[ln | a x x2 n P |
self 0.0 "see Computer Approximations, pp. 105-111, p. 227 (LOGE 2663)"
ifTrue: [user notify: 'ln not valid for ' + self asString]
ifFalse:
[x ← self + 0.0 "exponent".
n ← ln2 * (((x instfield: 1) / 2) asFloat - 0.5) "mantissa between 0.5 and 1.0".
.
x instfield: 1 ← 0.
x ← x * sqrt2.
x ← x - 1.0 / (x + 1.0).
x2 ← x * x.
P ← 0.0 "(0.2000000000046727e1 0.666666635059382 0.4000059794795
0.28525381498 0.2376245609) reverse copy".
#(0.23762456 0.28525381 0.40000598 0.66666664 2.0 ) do: [:a | P ← P * x2 + a].
↑n + (x * P)]].
"103" Float$'Arithmetic'
[= arg | |<primitive: 55>
arg isNumber
ifTrue: [↑self = arg asFloat].
↑false].
"68" Float$'Arithmetic'
[ arg | |<primitive: 53>
↑self arg asFloat].
"68" Float$'Arithmetic'
[ arg | |<primitive: 54>
↑self arg asFloat].
"68" Float$'Printing'
[printon: strm | |
self printon: strm digits: 8].
"68" Float$'Arithmetic'
[ arg | |<primitive: 56>
↑self arg asFloat].
"68" Float$'Arithmetic'
[* arg | |<primitive: 57>
↑self * arg asFloat].
"145" Float$'Arithmetic'
[/ arg | |<primitive: 58>
0.0 = arg
ifTrue: [user notify: 'Attempt to divide by 0.0']
ifFalse: [↑self / arg asFloat]].
"88" Float$'Arithmetic'
[| arg | |
"By analogy with integers"
↑(self / arg) ipart * arg].
"162" Float$'Arithmetic'
[\ arg | |
"By analogy with integers"
self < 0.0
ifTrue: [↑(self / arg) ipart + 1.0 * arg + self].
↑self - ((self / arg) ipart * arg)].
"504" Float$'Math functions'
[tan | x x2 sum const |
"for angles in radians"
self < 0.0
ifTrue: [↑self negated tan negated].
" normalize to 0self(pi/4) "
self > pi
ifTrue: [↑(self \ pi) tan].
self > halfpi
ifTrue: [↑(self - halfpi) tan negated].
self > fourthpi
ifTrue: [↑1.0 / (halfpi - self) tan].
sum ← x ← self.
x2 ← x * x.
#(0.3333314 0.1333924 0.05337406 0.024565089 0.002900525 0.0095168091 ) do: [:const | "Now compute the series"
sum ← const * (x ← x * x2) + sum].
↑sum].
"712" Float$'Math functions'
[exp | a n1 x x2 P Q |
self abs "see Computer Approximations, pp. 96-104, p. 205 (EXPB 1065)" > 9212.0 "1.0e4001 ln"
ifTrue: [user notify: 'exp overflow']
ifFalse:
[x ← self / ln2.
(n1 ← Float new "2.0 ipow: x asInteger") instfield: 1 ← x asInteger * 2.
(x ← x fpart) 0.5
ifTrue:
[n1 ← n1 * sqrt2.
x ← x - 0.5].
x2 ← x * x "compute 2.0 power: x".
P ← Q ← 0.0 "(0.25250428525576241933744e4 0.28875563776168927289e2) reverse copy".
#(28.875564 2525.0429 ) do: [:a | P ← P * x2 + a "(0.72857336028361108885189e4 0.375021654220866600213e3 0.1e1) reverse copy"].
#(1.0 375.02165 7285.7336 ) do: [:a | Q ← Q * x2 + a].
↑n1 * (Q + (x * P) / (Q - (x * P)))]].
"110" Float$'Math functions'
[neg | |
"Obsolete - use negated, which is uniform for all Numbers"
↑self negated].
"478" Float$'Math functions'
[sin | x x2 sum const |
"for angles in radians"
self < 0.0
ifTrue: [↑self negated sin negated].
" normalize to 0self(pi/4) "
self > twopi
ifTrue: [↑(self \ twopi) sin].
self > pi
ifTrue: [↑(self - pi) sin negated].
self > halfpi
ifTrue: [↑(pi - self) sin].
sum ← x ← self.
x2 ← x * x.
#(0.16666667 0.0083333315 1.98409e4 2.7526e6 2.39e8 ) do: [:const | "Now compute the series"
sum ← const * (x ← x * x2) + sum].
↑sum].
"38" Float$'Conversion'
[copy | |
↑self].
"129" Float$'Math functions'
[cos | |
"for angles in radians"
self < 0.0
ifTrue: [↑(self + halfpi) sin].
↑(halfpi - self) sin].
"557" Float$'Math functions'
[arctan | theta term y eps i |
"return angle in degrees good to .02 degrees."
self = 1.0
ifTrue: [↑45.0].
.
self = 1.0
ifTrue: [↑45.0].
.
self * self > 1.0
ifTrue:
[theta ← halfpi.
y ← 1.0 / (self * self).
term ← 1.0 / self abs]
ifFalse:
[theta ← 0.0.
y ← 0.0 - (self * self).
term ← self abs].
i ← 1.
eps ← 1.0e4.
[term abs > eps] whileTrueDo:
[theta ← theta + term.
term ← term * y * i asFloat / (i + 2) asFloat.
i ← i + 2].
theta ← self sign asFloat * theta * 360.0 / twopi.
↑theta].
"476" Float$'Conversion'
[asLarge | me digits nat i |
"convert to LargeInteger"
self < 0
ifTrue: [↑(0.0 - self) asLarge negated].
digits ← Stream default.
self = 0.0
ifTrue: [digits next← 0]
ifFalse:
[me ← self ipart.
[me 1] whileTrueDo:
[digits next← (me \ 256.0) asInteger.
me ← me / 256.0]].
digits ← digits contents.
nat ← Natural new: digits length.
(1 to: digits length) do: [:i | nat i ← digits i].
↑LargeInteger new bytes: nat neg: false].
"89" Float$'Arithmetic'
[hash | |
↑(self fpart * 100) asInteger lxor: self ipart asInteger].
"121" Float$'Arithmetic'
[near: n within: eps | |
↑(self - n) "for testing near equality, e.g. error convergence" abs eps].
"36" Float$'Conversion'
[asFloat | |
].
"303" Float$'Printing'
[printon: strm digits: digits | |
"print me using digits significant figures"
self > 0.0
ifTrue: [self absprinton: strm digits: digits]
ifFalse:
[self = 0.0
ifTrue: [strm append: '0.0']
ifFalse:
[strm append: ''.
0.0 - self absprinton: strm digits: digits]]].
"96" Float$'Conversion'
[asDegrees | |
"self assumed to be in radians"
↑self / radiansPerDegree].
"60" Float$'Conversion'
[asDirection | |
↑self cos self sin].
"40" Float$'Conversion'
[recopy | |
↑self].
"96" Float$'Conversion'
[asRadians | |
"self assumed to be in degrees"
↑self * radiansPerDegree].
"359" Float$'Math functions'
[sqrt | guess i |
self 0.0
ifTrue:
[self = 0.0
ifTrue: [↑0.0].
user notify: 'sqrt invalid for x<0.']
ifFalse:
[guess ← self + 0.0 "copy x".
guess instfield: 1 ← (guess instfield: 1) / 4 * 2 "and halve expt for first guess".
(1 to: 5) do: [:i | guess ← self - (guess * guess) / (guess * 2.0) + guess].
↑guess]].
"68" Float$'Math functions'
[log: base | |
↑self ln / base asFloat ln].
"95" Float$'Arithmetic'
[sameAs: arg | |
"arg assumed to be of same class as self"
↑self = arg].
"270" Float$'Printing'
[epart: base | x |
"gives floor log.base self"
self < base
ifTrue: [↑0].
"self assumed positive"
self < (base * base)
ifTrue: [↑1].
x ← 2 * (self epart: base * base) "binary recursion like ipow".
↑x + (self / (base ipow: x) epart: base)].
"602" Float$'Initialization'
[classInit | |
pi ← 3.1415927 "constants from Computer Approximations, pp. 182-183
pi = 3.14159265358979323846264338327950288
pi/2 = 1.57079632679489661923132169163975144
pi/4 = 0.78539816339744830961566084581987572
pi*2 = 6.28318530717958647692528676655900576
pi/180 = 0.01745329251994329576923690768488612
2.0 ln = 0.69314718055994530941723212145817657
2.0 sqrt = 1.41421356237309504880168872420969808".
halfpi ← pi / 2.0.
fourthpi ← pi / 4.0.
twopi ← pi * 2.0.
radiansPerDegree ← pi / 180.0.
degreesPerRadian ← 180.0 / pi.
ln2 ← 0.69314718.
sqrt2 ← 1.4142136].
"1050" Float$'Printing'
[absprinton: strm digits: digits | fuzz x exp q i |
"print me using digits significant figures"
exp ← "x is myself normalized to [1.0, 10.0), exp is my exponent"
(self < 1.0
ifTrue: [0 - (10.0 / self epart: 10.0)]
ifFalse: [self epart: 10.0]).
x ← self / (10.0 ipow: exp) "round the last digit to be printed".
fuzz ← 10.0 ipow: 1 - digits.
x ← 0.5 * fuzz + x "check if rounding has unnormalized x".
x 10.0
ifTrue:
[x ← x / 10.0.
exp ← exp + 1].
(exp < 6 and: [exp > 4])
ifTrue:
[q ← 0 "decimal notation".
exp < 0
ifTrue: [strm append: '0.0000' (1 to: 1 - exp)]]
ifFalse:
[.
q ← exp.
exp ← 0] "scientific notation" "use fuzz to track significance".
[x fuzz] whileTrueDo:
[i ← x asInteger.
strm next← 48 + i.
x ← x - i * 10.0.
fuzz ← fuzz * 10.0.
exp ← exp - 1.
exp = 1
ifTrue: [strm append: '.']].
[exp 1] whileTrueDo:
[strm next← 48.
exp ← exp - 1.
exp = 1
ifTrue: [strm append: '.']].
q 0
ifTrue:
[strm append: 'e'.
strm print: q]].
"109" Float$'Printing'
[roundTo: d | |
↑(self / d + (self < 0.0
ifTrue: [0.5]
ifFalse: [0.5])) ipart * d].
"47" Float$'Arithmetic'
[negated | |
↑0.0 - self].
"64" Float$'Arithmetic'
[near: n | |
↑self near: n within: 1.0e4].
"219" Float$'Math functions'
[ipow: x | |
"fixed powers in log n steps"
x = 0
ifTrue: [↑1.0].
x = 1
ifTrue: [↑self].
x > 1
ifTrue: [↑(self * self ipow: x / 2) * (self ipow: x \ 2)].
↑1.0 / (self ipow: 0 - x)].
"98" Float$'Conversion'
[ipart | |
"Returns a Float with zero fractional part"
↑self - self fpart].
"75" MethodContext$'Initialization'
[setRestart code | |
RestartCode ← code].
"68" MethodContext$'Access to Parts'
[tempAt: index | |
↑self index].
"70" MethodContext$'Initialization'
[systemRestart | |
RestartCode eval].
"61" MethodContext$'Blocks'
[remoteCopy | |
↑self blockCopy: 0].
"113" MethodContext$'Initialization'
[restart | |
pc ← method initialPC.
stackp ← method numArgs + method numTemps].
"70" MethodContext$'Debugger'
[erase | |
receiver ← nil.
super release].
"132" MethodContext$'Initialization'
[sender: t1 receiver: t2 mclass: ignored method: t4 | |
sender ← t1.
receiver ← t2.
method ← t4].
"59" MethodContext$'Access to Parts'
[receiver | |
↑receiver].
"55" MethodContext$'Access to Parts'
[method | |
↑method].
"95" MethodContext$'Initialization'
[run | |
self setRestart [(↑nil)].
user restore.
user run].
"716" MethodContext$'Initialization'
[send: selector to: rcvr | nargs i mcl context |
mcl ← rcvr class.
[mcl md has: selector] whileFalseDo:
[mcl ← mcl superclass.
mcl nil
ifTrue: [user notify: 'Message not understood: ' + selector]].
method ← (NoteTaker
ifTrue: [mcl method: selector]
ifFalse: [(mcl regenerate: selector) asCompiledMethod]).
context ← MethodContext new: method frameSize.
context sender: self receiver: rcvr mclass: mcl method: method.
nargs ← method numArgs.
(1 to: nargs) do: [:i | context temp: (nargs - i + 1) ← self pop].
context pc: method initialPC stackp: nargs + method numTemps.
↑context "
| NTP. NTP← MethodContext new. (NTP send: goBaby to: NTP) inspect.
"].
"83" MethodContext$'Initialization'
[init: size | |
tempsAndStack ← Vector new: size].
"315" MethodContext$'Initialization'
[goBaby | height |
NoteTaker ← true.
MethodKeeper ← (Vector new: 10) asStream.
externalViews ← Set new vector: 10.
height ← 760 " 480 376 ".
user currentDisplay: (Form new extent: 640 height bits: (Bitmap new: 640 / 16 * height) offset: nil).
[true] whileTrueDo: [self run]].
"87" MethodContext$'Access to Parts'
[tempAt: index put: value | |
↑self index ← value].
"79" MethodContext$'Initialization'
[pc: t1 stackp: t2 | |
pc ← t1.
stackp ← t2].
"121" MethodContext$'Blocks'
[blockCopy: nargs | |
↑(BlockContext new: self length) home: self startpc: pc + 2 nargs: nargs].
"182" ContextPart$'As yet unclassified'
[stack | a strm |
strm ← (Vector new: 20) asStream.
strm next← a ← self.
[(a ← a sender) nil] whileFalseDo: [strm next← a].
↑strm contents].
"142" ContextPart$'As yet unclassified'
[variableNamesInto: dest with: block | n |
self tempNames transform [:n | n] to [(dest identifier: n)]].
"126" ContextPart$'As yet unclassified'
[erase | i |
"release frames to break cycles"
(1 to: stackp) do: [:i | self i ← nil]].
"75" ContextPart$'As yet unclassified'
[sender← t1 | |
sender ← t1.
↑sender].
"294" ContextPart$'As yet unclassified'
[printon: strm | mclass |
strm append: self receiver class title.
mclass ← self mclass.
mclass self receiver class
ifFalse:
[strm append: '('.
strm append: mclass title.
strm append: ')'].
strm append: '>>'.
strm append: self method selector].
"115" ContextPart$'As yet unclassified'
[tempframe | i |
↑1 ~ self method numTemps transform [:i | i] to [self i]].
"216" ContextPart$'As yet unclassified'
[mclass | mclass sel |
mclass ← self receiver class.
sel ← self selector.
[mclass nil or: [(mclass canunderstand: sel)]] whileFalseDo: [mclass ← mclass superclass].
↑mclass].
"99" ContextPart$'As yet unclassified'
[pop | val |
val ← self stackp.
stackp ← stackp - 1.
↑val].
"57" ContextPart$'As yet unclassified'
[sender | |
↑sender].
"156" ContextPart$'As yet unclassified'
[releaseFully | c |
"release frames to break cycles"
c ← self.
[c nil] whileFalseDo:
[c ← c sender.
c erase]].
"73" ContextPart$'As yet unclassified'
[selector | |
↑self method selector].
"125" ContextPart$'As yet unclassified'
[tempNames | i |
↑1 ~ self method numTemps transform [:i | i] to [('t' + i asString)]].
"88" ContextPart$'As yet unclassified'
[push: val | |
↑self (stackp ← stackp + 1) ← val].
"68" ContextPart$'As yet unclassified'
[release | |
self releaseFully].
"127" ContextPart$'As yet unclassified'
[swapSender: coroutine | oldSender |
oldSender ← sender.
sender ← coroutine.
↑oldSender].
"179" BlockContext$'As yet unclassified'
[sender: t1 pc: t2 stackp: t3 home: t4 startpc: t5 nargs: t6 | |
sender ← t1.
pc ← t2.
stackp ← t3.
home ← t4.
startpc ← t5.
nargs ← t6].
"71" BlockContext$'As yet unclassified'
[tempAt: index | |
↑home index].
"85" BlockContext$'As yet unclassified'
[value: arg | |<primitive: 75>
self valueError].
"112" BlockContext$'As yet unclassified'
[home: t1 startpc: t2 nargs: t3 | |
home ← t1.
startpc ← t2.
nargs ← t3].
"110" BlockContext$'As yet unclassified'
[value: arg1 value: arg2 value: arg3 | |<primitive: 75>
self valueError].
"120" BlockContext$'As yet unclassified'
[value← val | |
"for compatibility with ST76 remote variables"
↑self value: val].
"76" BlockContext$'As yet unclassified'
[erase | |
home ← nil.
super release].
"331" BlockContext$'As yet unclassified'
[valueWithArgs: vec | t2 |
(t2 ← vec length) = 0
ifTrue: [↑self value].
t2 = 1
ifTrue: [↑self value: vec 1].
t2 = 2
ifTrue: [↑self value: vec 1 value: vec 2].
t2 = 3
ifTrue: [↑self value: vec 1 value: vec 2 value: vec 3].
user notify: 'More than 3 args for value:'].
"67" BlockContext$'As yet unclassified'
[receiver | |
↑home receiver].
"80" BlockContext$'As yet unclassified'
[value | |<primitive: 75>
self valueError].
"63" BlockContext$'As yet unclassified'
[method | |
↑home method].
"97" BlockContext$'As yet unclassified'
[valueError | |
user notify: 'Incompatible number of args'].
"98" BlockContext$'As yet unclassified'
[value: arg1 value: arg2 | |<primitive: 75>
self valueError].
"363" BlockContext$'As yet unclassified'
[eval | save val |
nargs = 0
ifTrue: [↑self value].
nargs = 1
ifTrue:
[save ← startpc "amazing crock for reading ST76 remote variable".
startpc ← startpc + (self method startpc < 112
ifTrue: [1]
ifFalse: [2]).
nargs ← 0.
val ← self value.
startpc ← save.
nargs ← 1.
↑val].
self valueError].
"90" BlockContext$'As yet unclassified'
[tempAt: index put: value | |
↑home index ← value].
"143" BlockContext$'As yet unclassified'
[blockCopy: t1 | |
nargs ← t1.
↑(BlockContext new: self length) home: home startpc: pc + 2 nargs: nargs].
"162" Point$'Arithmetic'
[+ delta | |
↑Point new "Return a Point that is the sum of me and delta (which is a Point or Number)" x: x + delta asPtX y: y + delta asPtY].
"45" Point$'Access to parts'
[y← t1 | |
y ← t1].
"58" Point$'Arithmetic'
[< pt | |
↑x < pt x and: [y < pt y]].
"169" Point$'Arithmetic'
[- delta | |
↑Point new "Return a Point that is the difference of me and delta (which is a Point or Number)" x: x - delta asPtX y: y - delta asPtY].
"45" Point$'Access to parts'
[x← t1 | |
x ← t1].
"58" Point$'Arithmetic'
[= pt | |
↑x = pt x and: [y = pt y]].
"58" Point$'Arithmetic'
[ pt | |
↑x pt x and: [y pt y]].
"58" Point$'Arithmetic'
[> pt | |
↑x > pt x and: [y > pt y]].
"90" Point$'Conversion'
[printon: strm | |
strm print: x.
strm append: ''.
strm print: y].
"58" Point$'Arithmetic'
[ pt | |
↑x pt x and: [y pt y]].
"36" Point$'Conversion'
[asPtX | |
↑x].
"106" Point$'Conversion'
[rect: p | |
"infix creation of rectangles"
↑Rectangle new origin: self corner: p].
"166" Point$'Arithmetic'
[* scale | |
↑Point new "Return a Point that is the product of me and scale (which is a Point or Number)" x: x * scale asPtX y: y * scale asPtY].
"167" Point$'Arithmetic'
[/ scale | |
↑Point new "Return a Point that is the quotient of me and scale (which is a Point or Number)" x: x / scale asPtX y: y / scale asPtY].
"69" Point$'Arithmetic'
[| grid | |
↑Point new x: x | grid y: y | grid].
"121" Point$'Arithmetic'
[dist: pt | t |
"distance (Manhattan norm) between pt and self"
t ← (pt - self) abs.
↑t x + t y].
"36" Point$'Conversion'
[asPtY | |
↑y].
"37" Point$'Access to parts'
[x | |
↑x].
"37" Point$'Access to parts'
[y | |
↑y].
"90" Point$'Arithmetic'
[length | |
↑(x asFloat * x asFloat + (y asFloat * y asFloat)) sqrt].
"36" Point$'Conversion'
[width | |
↑1].
"78" Point$'Arithmetic'
[normalize | |
self x← 0 "set selt to zero".
self y← 0].
"43" Point$'Initialization'
[copy | |
↑x y].
"90" Point$'Arithmetic'
[abs | |
"absolute value of a point"
↑Point new x: x abs y: y abs].
"115" Point$'SYSTEM'
[hideData: complete | s t3 |
(t3 ← Stream new) of: (s ← String new: 4).
t3 nextPoint← self.
↑s].
"36" Point$'SYSTEM'
[pressCode | |
↑7].
"108" Point$'SYSTEM'
[hidePress: press complete: c | |
press skipcode: self pressCode data: (self hideData: c)].
"60" Point$'Access to parts'
[hash | |
↑(x lshift: 2) lxor: y].
"361" Point$'Access to parts'
[theta | tan theta |
"return the angle the point makes with origin. right is 0; down is 90."
x = 0
ifTrue:
[y 0
ifTrue: [↑90.0].
↑270.0]
ifFalse:
[.
tan ← y asFloat / x asFloat.
theta ← tan arctan.
x 0
ifTrue:
[y 0
ifTrue: [↑theta].
↑360.0 + theta]
ifFalse:
[.
↑180.0 + theta]]].
"112" Point$'Conversion'
[asRectangle | |
↑self rect: self "Return a Rectangle with me as both origin and corner."].
"88" Point$'Conversion'
[asRectCorner | |
"pretend to be a Rectangle for Rectangle +-*/"].
"88" Point$'Conversion'
[asRectOrigin | |
"pretend to be a Rectangle for Rectangle +-*/"].
"77" Point$'Arithmetic'
[max: t | |
↑Point new x: (x max: t x) y: (y max: t y)].
"104" Point$'Arithmetic'
[translate: delta | |
x ← x + delta x "increment self by delta".
y ← y + delta y].
"77" Point$'Arithmetic'
[min: t | |
↑Point new x: (x min: t x) y: (y min: t y)].
"59" Point$'Initialization'
[x: t1 y: t2 | |
x ← t1.
y ← t2].
"41" Point$'Conversion'
[extent | |
↑1 1].
"40" Point$'Conversion'
[origin | |
↑self].
"50" Point$'Conversion'
[corner | |
↑self + (1 1)].
"37" Point$'Conversion'
[height | |
↑1].
"123" Point$'Arithmetic'
[normal | n |
"unit vector rotated 90 deg clockwise"
n ← y asFloat neg x asFloat.
↑n / n length].
"108" Point$'Conversion'
[extent: p | |
"infix creation of rectangles"
↑Rectangle new origin: self extent: p].
"51" Point$'Conversion'
[asPoint | |
"Return self."].
"81" Point$'SYSTEM'
[fromPress: press value: s | |
x ← s nextword.
y ← s nextword].
"88" Natural$'As yet unclassified'
[ n | |
super length < n
ifTrue: [↑0].
↑super n].
"427" Natural$'Arithmetic'
[natunnormalize: n lookfirst: a | x i r f digit |
n ← 0 - n.
x ← 0.
f ← n + 8.
i ← a.
digit ← self i.
[((digit lshift: n) lor: x) = 0 and: [i 1]] whileTrueDo:
[x ← digit lshift: f.
i ← i - 1.
digit ← self i].
r ← Natural new: i.
a ← i.
x ← self 1 lshift: n.
(1 to: a) do:
[:i | digit ← self (i + 1).
r i ← ((digit lshift: f) lor: x) land: 255.
x ← digit lshift: n].
↑r].
"476" Natural$'Arithmetic'
[natdivideandCarry: arg extra: pair | i len z |
z ← pair 2 "arg is an integer < 256 - returns remainder, smashes self to quotient - pair is a 2-vector of len (index of high order non-zero word in self) and a MachineDouble - be careful!!!".
z high← 0.
len ← pair 1.
(len to: 1 by: 1) do:
[:i | z low← self i.
self i ← z mdiv: arg].
self len = 0
ifTrue:
[len ← len - 1.
len = 0
ifTrue: [len ← 1]].
pair 1 ← len.
↑z high].
"80" Natural$'As yet unclassified'
[printon: strm | |
self printon: strm base: 10].
"340" Natural$'Arithmetic'
[natcompare: arg | i len t4 t5 |
"speeded up for Integer args, same speed for LargeInteger (Natural) args"
len ← self length.
(t4 ← arg length) < len
ifTrue: [↑3].
t4 > len
ifTrue: [↑1].
(len to: 1 by: 1) do:
[:i | (t5 ← arg i) < (self i)
ifTrue: [↑3].
t5 > (self i)
ifTrue: [↑1]].
↑2].
"364" Natural$'Arithmetic'
[natnormalize: n | x i r f digit |
r ← Natural new: self length "n is the number of bits to shift by. The Natural number returned will be written over repeatedly, so we must make a new one." + 1.
x ← 0.
f ← n - 8.
(1 to: r length) do:
[:i | digit ← self i.
r i ← ((digit lshift: n) lor: x) land: 255.
x ← digit lshift: f].
↑r].
"104" MachineDouble$'Arithmetic'
[< arg | |
high = arg high
ifTrue: [↑low < arg low].
↑high < arg high].
"186" MachineDouble$'As yet unclassified'
[printon: strm | |
strm append: '[MachineDouble 0'.
high printon: strm base: 8.
strm append: ' 0'.
low printon: strm base: 8.
strm append: ']'].
"114" MachineDouble$'As yet unclassified'
[asInt | n i |
"may return a negative number"
↑(high lshift: 8) lor: low].
"227" MachineDouble$'As yet unclassified'
[classInit | |
low4 ← 64 "low4 is a field description for the low order 4 bits of an Integer
high4 is a field description for the high order 4 bits of an 8-bit Integer".
high4 ← 68].
"187" MachineDouble$'Access'
[extract | x |
x ← low "returns low, moves high down and propagates sign.".
low ← high.
high ← ((low land: 128) = 0
ifTrue: [0]
ifFalse: [255]).
↑x].
"171" MachineDouble$'Arithmetic'
[decreaseby: y | x |
"y is a positive <256 integer"
x ← low - y.
x < 0
ifTrue: [high ← high - 1 land: 255].
low ← x land: 255.
↑self].
"486" MachineDouble$'Arithmetic'
[gets: x mtimes: y | xh xl yh yl p1 p2 |
xh ← x lshift: 4 "x and y are 8-bit positive #'s.
Does single precision unsigned multiplication
returning a double precision result.".
xl ← x land: 15.
yh ← y lshift: 4.
yl ← y land: 15.
low ← yl * xl.
high ← yh * xh.
p2 ← yh * xl.
p1 ← p2 + (yl * xh).
high ← high + (p1 lshift: 4).
low ← ((p1 land: 15) lshift: 4) + low.
low 256
ifTrue:
[high ← high + 1.
low ← low - 256].
↑self].
"58" MachineDouble$'Access'
[high← t1 | |
high ← t1.
↑self].
"173" MachineDouble$'Arithmetic'
[increaseby: y | x |
"y is a positive <256 integer"
x ← low + y.
x > 255
ifTrue: [high ← high + 1 land: 255].
low ← x land: 255.
↑self].
"76" MachineDouble$'As yet unclassified'
[init | |
low ← 0.
high ← 0.
↑self].
"56" MachineDouble$'Access'
[low← t1 | |
low ← t1.
↑self].
"794" MachineDouble$'Arithmetic'
[mdiv: y | x |
high > y "Ignores y high (assumes it to be zero. Also assumes that y > high.
This does a single precision unsigned divide into a double precision dividend
that results in a single precision quotient (returned) and
a single precision remainder(placed in self high).
Fixed for NT 15-bit Integers - Dan I."
ifTrue: [user notify: 'illegal MachineDouble division']
ifFalse:
[high < 64
ifTrue:
[x ← high * 256 + low.
high ← x \ y.
↑x / y].
high < 128
ifTrue:
[x ← (high lshift: 2) + (low lshift: 6) - y.
high ← x lshift: 2.
low ← low field: 38 ← x.
↑(self mdiv: y) + 64].
x ← (high lshift: 1) + (low lshift: 7) - y.
high ← x lshift: 1.
low ← low field: 23 ← x.
↑(self mdiv: y) + 128]].
"42" MachineDouble$'Access'
[high | |
↑high].
"40" MachineDouble$'Access'
[low | |
↑low].
"411" Natural$'As yet unclassified'
[printon: strm base: b | p z n b2 x |
"only works if b10"
p ← Stream default.
z ← {self length , MachineDouble new}.
n ← Natural new: super length.
b2 ← b * b.
self copyto: n.
[z 1 = 1 and: [n 1 < b2]] whileFalseDo:
[x ← n natdivideandCarry: b2 extra: z.
p next← x \ b + 48.
p next← x / b + 48].
n 1 printon: strm base: b.
strm append: p contents reverse].
"107" Natural$'As yet unclassified'
[classInit | |
Naturalzero ← Natural new: 1.
Naturalzero 1 ← 0.
↑self].
"1007" Natural$'Arithmetic'
[natsubtract: arg | shorter longer i z sum sl al ng lastdigit |
sl ← self length "returns an Integer that is created by this operation".
al ← arg length.
z ← MachineDouble init.
sl = al
ifTrue:
[i ← sl.
[self i = (arg i) and: [i > 1]] whileTrueDo: [i ← i - 1].
sl ← i.
(self i unsignedlessthan: arg i)
ifTrue:
[longer ← arg.
ng ← true.
shorter ← self]
ifFalse:
[longer ← self.
shorter ← arg.
ng ← false]]
ifFalse:
[sl < al
ifTrue:
[longer ← arg.
shorter ← self.
ng ← true.
sl ← al]
ifFalse:
[longer ← self.
shorter ← arg.
ng ← false]].
sum ← Natural new: longer length.
lastdigit ← 1.
(1 to: longer length) do:
[:i | z increaseby: longer i.
z decreaseby: shorter i.
sum i ← z extract 0
ifTrue: [lastdigit ← i]].
lastdigit = longer length
ifFalse:
[z ← Natural new: lastdigit.
(1 to: lastdigit) do: [:i | z i ← sum i].
sum ← z].
↑LargeInteger new bytes: sum neg: ng].
"626" Natural$'Arithmetic'
[nattimes: arg | prod z pl carry digit i j k |
(self length = 1 and: [self 1 = 0])
ifTrue: [↑Naturalzero].
pl ← self length + arg length.
prod ← Natural new: pl.
z ← MachineDouble new.
(1 to: pl) do: [:i | prod i ← 0].
(1 to: self length) do:
[:i | k ← i - 1.
carry ← 0.
digit ← self i.
digit 0
ifTrue:
[(1 to: arg length) do:
[:j | z gets: digit mtimes: arg j.
z increaseby: carry.
k ← k + 1.
z increaseby: prod k "k=i+j-1".
prod k ← z low.
carry ← z high].
prod (k + 1) ← carry]].
prod pl = 0
ifTrue: [↑prod growby: 1].
↑prod].
"456" Natural$'Arithmetic'
[natadd: arg | shorter longer i z sum |
z ← MachineDouble init "returns a Natural number".
self length < arg length
ifTrue:
[longer ← arg.
shorter ← self]
ifFalse:
[longer ← self.
shorter ← arg].
sum ← Natural new: longer length.
(1 to: longer length) do:
[:i | z increaseby: longer i.
z increaseby: shorter i.
sum i ← z extract].
z low 0
ifTrue:
[sum ← sum growby: 1.
sum last← z low].
↑sum].
"1664" Natural$'Arithmetic'
[natdiv: arg | quo rem ql d div dh dnh z z2 dl q i j k l carry digit flag |
l ← self length "returns a vector of (quotient, remainder)" - arg length + 1.
l 0
ifTrue: [↑{Naturalzero , self}].
d ← 8 - arg last hibit.
rem ← self natnormalize: d "makes a copy and shifts".
div ← arg natnormalize: d "shifts so high order word is >127".
quo ← Natural new: l.
dl ← div length - 1.
ql ← l.
dh ← div dl.
dnh ← (dl = 1
ifTrue: [0]
ifFalse: [div (dl - 1)]).
z ← MachineDouble init.
z2 ← MachineDouble new.
(1 to: ql) do:
[:k | "maintain quo*arg+rem=self"
j ← rem length + 1 - k.
z high← rem j.
z high = dh
ifTrue: [q ← 1]
ifFalse:
[z low← rem (j - 1).
q ← z mdiv: dh.
z low← (j < 3
ifTrue: [0]
ifFalse: [rem (j - 2)]).
z2 gets: q mtimes: dnh.
flag ← true.
[z < z2 and: [flag]] whileTrueDo:
[q ← q unsignedadd: 1.
z2 decreaseby: dnh.
z2 high < dh
ifTrue: [flag ← false]
ifFalse: [z2 high← z2 high - dh]]].
l ← j - dl.
z2 init.
carry ← 0.
(1 to: div length) do:
[:i | z gets: q mtimes: div i.
z2 increaseby: rem l.
z2 decreaseby: carry "subtract q * div from rem".
z2 decreaseby: z low.
carry ← z high.
rem l ← z2 extract.
l ← l + 1].
z2 low = 255
ifTrue:
[q ← q unsignedadd: 1.
l ← j - dl.
z init.
(1 to: div length) do:
[:i | z increaseby: rem l.
z increaseby: div i.
rem l ← z extract.
l ← l + 1]].
quo (quo length + 1 - k) ← q].
rem ← rem natunnormalize: d lookfirst: dl.
quo last = 0
ifTrue:
[ql < 2
ifFalse: [quo ← quo growby: 1]].
↑{quo , rem}].
"53" Natural$'As yet unclassified'
[isLarge | |
↑false].
"55" Natural$'As yet unclassified'
[species | |
↑Natural].
"130" Natural$'As yet unclassified'
[asInteger | |
self length = 1
ifTrue: [↑self 1].
↑LargeInteger new bytes: self neg: false].
"315" LargeInteger$'As yet unclassified'
[bits: left to: right | width mask |
" 0 is leftmost bit, 15 is rightmost"
width ← right - left + 1.
mask ← (width < 15
ifTrue: [biton (width + 1) - 1]
ifFalse:
[width = 15
ifTrue: [32767]
ifFalse: [1]]).
↑(self lshift: right - 15) land: mask].
"333" LargeInteger$'As yet unclassified'
[logicArg | b a i |
"convert to two byte twos complement number"
neg
ifTrue:
[b ← Natural new: 2.
b 1 ← (a ← (bytes 1 lxor: 255) + 1) land: 255.
a ← a lshift: 8.
b 2 ← (bytes 2 lxor: 255) + a land: 255.
↑LargeInteger new bytes: b neg: false] "if positive, just leave it"].
"43" LargeInteger$'Access'
[bytes | |
↑bytes].
"334" LargeInteger$'Arithmetic'
[+ arg | as r |
as ← arg neg "take care of sign. Arithmetic is done in Natural numbers.
if arg is Small, it behaves as a LargeInteger.".
neg as
ifTrue:
[r ← bytes natadd: arg bytes.
↑LargeInteger new bytes: r neg: neg].
r ← bytes natsubtract: arg bytes.
neg
ifTrue: [↑r negate].
.
↑r].
"92" LargeInteger$'Arithmetic'
[> arg | |
(self compare: arg) = 3
ifTrue: [↑self].
↑false].
"92" LargeInteger$'Arithmetic'
[< arg | |
(self compare: arg) = 1
ifTrue: [↑self].
↑false].
"364" LargeInteger$'Arithmetic'
[- arg | as r |
as ← arg neg "take care of sign. Arithmetic is done in Natural numbers.
if arg is Small, it behaves as a LargeInteger.".
neg as
ifTrue:
[r ← bytes natsubtract: arg bytes.
neg
ifTrue: [↑r neg← r neg false].
.
↑r]
ifFalse:
[r ← bytes natadd: arg bytes.
↑LargeInteger new bytes: r neg: neg]].
"143" LargeInteger$'Arithmetic'
[= arg | |
arg isNumber
ifTrue:
[(self compare: arg) = 2
ifTrue: [↑self].
↑false]
ifFalse: [↑false]].
"92" LargeInteger$'Arithmetic'
[ arg | |
(self compare: arg) < 3
ifTrue: [↑self].
↑false].
"92" LargeInteger$'Arithmetic'
[ arg | |
(self compare: arg) > 1
ifTrue: [↑self].
↑false].
"557" LargeInteger$'Bit Manipulation'
[lshift: n | a c s1 s2 h |
NoteTaker
ifTrue:
[a ← self logicArg.
c ← Natural new: 2.
c 1 ← a bytes 1.
c 2 ← a bytes 2.
a bytes: c neg: false.
(h ← n abs) 16
ifTrue: [↑0].
s1 ← h / 2.
s2 ← h - s1.
s1 ← 1 lshift: s1.
s2 ← 1 lshift: s2.
h ← s1 asLarge * s2 asLarge.
a ← (n < 0
ifTrue: [a / h]
ifFalse: [a * h]).
c ← Natural new: 2.
c 1 ← a bytes 1.
c 2 ← a bytes 2.
↑(LargeInteger new bytes: c neg: false) logicUnArg]
ifFalse: [↑self asSmall lshift: n]].
"252" LargeInteger$'Arithmetic'
[* arg | as r |
as ← arg neg "take care of sign. Arithmetic is done in Natural numbers.
if arg is Small, it behaves as a LargeInteger.".
r ← bytes nattimes: arg bytes.
↑LargeInteger new bytes: r neg: neg as false].
"76" LargeInteger$'Arithmetic'
[/ arg | |
↑((self intdiv: arg) 1) asInteger].
"118" LargeInteger$'Printing'
[printon: strm base: b | |
neg
ifTrue: [strm append: ''].
bytes printon: strm base: b].
"64" LargeInteger$'Arithmetic'
[\ arg | |
↑(self intdiv: arg) 2].
"418" LargeInteger$'Arithmetic'
[intdiv: arg | quo rem ng qr z |
qr ← bytes natdiv: arg bytes "returns a vector of (quotient, remainder)".
quo ← qr 1.
rem ← (qr 2) asInteger.
ng ← neg arg neg false.
quo last = 0
ifTrue:
[quo length < 2
ifFalse: [quo ← quo growby: 1]].
qr 1 ← LargeInteger new bytes: quo neg: ng.
qr 2 ← ((ng and: [0 rem])
ifTrue: [arg abs - rem]
ifFalse: [rem]).
↑qr].
"78" LargeInteger$'Access'
[neg← t1 | |
"Smashes sign - be careful!"
neg ← t1].
"57" LargeInteger$'Bit Manipulation'
[hash | |
↑bytes hash].
"39" LargeInteger$'Access'
[neg | |
↑neg].
"152" LargeInteger$'Arithmetic'
[abs | |
"Return the positive magnitude (absolute value) of this LargeInteger"
↑LargeInteger new bytes: bytes neg: false].
"43" LargeInteger$'Conversion'
[asLarge | |
].
"102" LargeInteger$'Conversion'
[asFloat | |
"Built for comfort, not for speed"
↑self asString asFloat].
"315" LargeInteger$'Arithmetic'
[compare: arg | i a |
(((bytes length = 1 and: [bytes 1 = 0]) and: [arg bytes length = 1]) and: [arg bytes 1 = 0])
ifTrue: [↑2].
neg
ifTrue:
[arg neg
ifTrue: [↑arg bytes natcompare: bytes].
↑1]
ifFalse:
[arg neg
ifTrue: [↑3].
↑bytes natcompare: arg bytes]].
"123" LargeInteger$'Access'
[bytes: t1 neg: t2 | |
bytes ← t1.
neg ← t2.
[bytes isLarge] whileTrueDo: [bytes ← bytes bytes]].
"64" LargeInteger$'Arithmetic'
[even | |
↑(bytes 1 land: 1) = 0].
"377" LargeInteger$'As yet unclassified'
[bits: left to: right ← val | width mask |
" 0 is leftmost bit, 15 is rightmost"
width ← right - left + 1.
mask ← (width < 15
ifTrue: [biton (width + 1) - 1]
ifFalse:
[width = 15
ifTrue: [32767]
ifFalse: [1]]).
↑(self land: ((mask lshift: 15 - right) lxor: 1)) lor: ((val land: mask) lshift: 15 - right)].
"219" LargeInteger$'Conversion'
[canBeSmall | i |
bytes length > 2
ifTrue: [(3 to: bytes length) do:
[:i | bytes i 0
ifTrue: [↑false]]].
(self 1 maxVal and: [self 1 minVal])
ifTrue: [↑true].
↑false].
"319" LargeInteger$'As yet unclassified'
[lor: n | a b c |
"simulated 16 bit logic"
NoteTaker
ifTrue:
[a ← self logicArg bytes.
b ← n asLarge logicArg bytes.
c ← Natural new: 2.
c 1 ← a 1 lor: b 1.
c 2 ← a 2 lor: b 2.
↑(LargeInteger new bytes: c neg: false) logicUnArg].
↑self asSmall lor: n].
"241" LargeInteger$'As yet unclassified'
[logicUnArg | |
"convert 2's complement to signed"
bytes length 2
ifTrue: [user notify: 'not logic arg']
ifFalse:
[bytes 2 128
ifTrue: [↑(self - 65536) asInteger].
↑self asInteger]].
"232" LargeInteger$'Access'
[bit: index | byte |
"Return bit number i in the binary representation of this number. Bit number 1 is the low order bit"
byte ← bytes (1 + (index - 1 / 8)).
↑(byte lshift: 0 - (index - 1 \ 8)) land: 1].
"180" LargeInteger$'Bit Manipulation'
[field: spec | right |
"spec=width*16 + right (15=left, 0=right)"
right ← 15 - (spec land: 15).
↑self bits: right - (spec / 16) + 1 to: right].
"89" LargeInteger$'Arithmetic'
[negate | |
↑LargeInteger new bytes: bytes neg: neg false].
"194" LargeInteger$'Bit Manipulation'
[field: spec ← val | right |
"spec=width*16 + right (15=left, 0=right)"
right ← 15 - (spec land: 15).
↑self bits: (right - (spec / 16) + 1) to: right ← val].
"397" LargeInteger$'Conversion'
[asObject | |
NoteTaker
ifTrue:
[self canBeSmall
ifTrue: [↑self asSmall asObject].
self < 49152
ifTrue:
[self < 32768
ifTrue: [self error: 'invalid oop']
ifFalse: [↑(self - 32768) asSmall]]
ifFalse:
[self 65536
ifTrue: [self error: 'invalid oop']
ifFalse: [↑(self - 65536) asSmall]]]
ifFalse: [↑self asSmall asObject]].
"330" LargeInteger$'Conversion'
[asSmall | t u |
"Truncate high bits to make small integer."
t ← bytes 1.
bytes length > 1
ifTrue:
[u ← bytes 2.
t ← ((NoteTaker
ifTrue: [(u land: 63) - (u land: 64)]
ifFalse: [u]) lshift: 8) + t].
neg
ifTrue:
[t = 0 minVal
ifTrue: [↑t].
↑0 - t]
ifFalse: [↑t]].
"70" LargeInteger$'Bit Manipulation'
[nomask: b | |
↑0 = (self land: b)].
"71" LargeInteger$'Bit Manipulation'
[allmask: b | |
↑b = (self land: b)].
"43" LargeInteger$'Conversion'
[isLarge | |
].
"71" LargeInteger$'Bit Manipulation'
[anymask: b | |
↑0 (self land: b)].
"90" LargeInteger$'Arithmetic'
[negated | |
↑LargeInteger new bytes: bytes neg: neg false].
"320" LargeInteger$'Bit Manipulation'
[land: n | a b c |
"simulated 16 bit logic"
NoteTaker
ifTrue:
[a ← self logicArg bytes.
b ← n asLarge logicArg bytes.
c ← Natural new: 2.
c 1 ← a 1 land: b 1.
c 2 ← a 2 land: b 2.
↑(LargeInteger new bytes: c neg: false) logicUnArg].
↑self asSmall land: n].
"168" LargeInteger$'Access'
[hibit | |
"Return the index of the high order bit of the binary representation of this number"
↑bytes last hibit + (8 * (bytes length - 1))].
"323" LargeInteger$'As yet unclassified'
[lxor: n | a b c |
"simulated 16 bit logic"
NoteTaker
ifTrue:
[a ← self logicArg bytes.
b ← n asLarge logicArg bytes.
c ← Natural new: 2.
c 1 ← a 1 lxor: b 1.
c 2 ← a 2 lxor: b 2.
↑(LargeInteger new bytes: c neg: false) logicUnArg].
↑self asSmall lxor: n].
"95" LargeInteger$'Conversion'
[asInteger | |
self canBeSmall
ifTrue: [↑self asSmall].
↑self].
"250" LargeInteger$'As yet unclassified'
[inFourBytes | four i |
bytes length > 4
ifTrue: [user notify: 'wont fit in 4 bytes']
ifFalse:
[four ← String new: 4.
four all← 0.
(1 to: bytes length) do: [:i | four (5 - i) ← bytes i].
↑four]].
"57" Message$'As yet unclassified'
[selector | |
↑selector].
"220" Message$'As yet unclassified'
[selector: sel args: vec | i |
self length vec length
ifTrue: [user notify: '# args doesnt match']
ifFalse:
[selector ← sel.
(1 to: vec length) do: [:i | self i ← vec i]]].
"145" Message$'As yet unclassified'
[selector: sel | |
self length 0
ifTrue: [user notify: '# args doesnt match']
ifFalse: [selector ← sel]].
"174" Message$'As yet unclassified'
[selector: sel arg: arg | |
self length 1
ifTrue: [user notify: '# args doesnt match']
ifFalse:
[selector ← sel.
self 1 ← arg]].
"59" CompiledMethod$'Header'
[flags | |
↑self 3 lshift: 5].
"99" CompiledMethod$'Header'
[initialPC | |
self isQuick
ifTrue: [↑0].
↑self numLiterals * 2 + 5].
"96" CompiledMethod$'Header'
[frameSize | |
self 4 < 128
ifTrue: [↑smallFrame].
↑largeFrame].
"73" CompiledMethod$'Association'
[key: key | |
↑self objectAt: 1 put: key].
"98" CompiledMethod$'Header'
[numLiterals | |
self isQuick
ifTrue: [↑0].
↑self 4 / 2 land: 63].
"146" CompiledMethod$'Header'
[isReturnField | |
"Return field # if code is quick, else false"
self flags = 6
ifTrue: [↑self numTemps].
↑false].
"100" CompiledMethod$'Header'
[isReturnSelf | |
"Return true if code is quick self"
↑self flags = 5].
"188" CompiledMethod$'Header'
[primitive | |
self flags < 7
ifTrue: [↑0].
"no prim, or quick prim"
↑(self literalAt: self numLiterals - 1) land: 255 "Prim # is in next-to-last literal"].
"49" CompiledMethod$'Association'
[value | |
↑self].
"131" CompiledMethod$'Header'
[isQuick | |
"Return non-false iff quick primitive (self or field)"
↑self flags between: 5 and: [6]].
"59" CompiledMethod$'Association'
[key | |
↑self objectAt: 1].
"69" CompiledMethod$'Literals'
[literalAt: i | |
↑self objectAt: i + 2].
"87" CompiledMethod$'Literals'
[literalAt: i put: val | |
↑self objectAt: i + 2 put: val].
"119" CompiledMethod$'Header'
[endPC | |
(self last between: 120 and: [124])
ifTrue: [↑self length].
↑self length - 3].
"179" CompiledMethod$'Header'
[numArgs | t1 |
(t1 ← self flags) 4
ifTrue: [↑self flags].
t1 < 7
ifTrue: [↑0].
↑((self literalAt: self numLiterals - 1) lshift: 8) land: 31].
"134" CompiledMethod$'Literals'
[objectAt: i | |<primitive: 73>
NoteTaker
ifTrue: [user croak]
ifFalse: [↑(self word: i) asObject]].
"144" CompiledMethod$'Literals'
[objectAt: i put: val | |<primitive: 74>
NoteTaker
ifTrue: [user croak]
ifFalse: [↑self word: i ← val asOop]].
"1973" CompiledMethod$'Initialization'
[classInit | |
"CompiledMethod classInit."
smallFrame ← 12.
largeFrame ← 32 "Context range for temps+stack".
byteNames ← #('in0' 'in1' 'in2' 'in3' 'in4' 'in5' 'in6' 'in7' 'in8' 'in9' 'in10' 'in11' 'in12' 'in13' 'in14' 'in15' 'tp0' 'tp1' 'tp2' 'tp3' 'tp4' 'tp5' 'tp6' 'tp7' 'tp8' 'tp9' 'tp10' 'tp11' 'tp12' 'tp13' 'tp14' 'tp15' 'lt0' 'lt1' 'lt2' 'lt3' 'lt4' 'lt5' 'lt6' 'lt7' 'lt8' 'lt9' 'lt10' 'lt11' 'lt12' 'lt13' 'lt14' 'lt15' 'lt16' 'lt17' 'lt18' 'lt19' 'lt20' 'lt21' 'lt22' 'lt23' 'lt24' 'lt25' 'lt26' 'lt27' 'lt28' 'lt29' 'lt30' 'lt31' 'gl0' 'gl1' 'gl2' 'gl3' 'gl4' 'gl5' 'gl6' 'gl7' 'gl8' 'gl9' 'gl10' 'gl11' 'gl12' 'gl13' 'gl14' 'gl15' 'gl16' 'gl17' 'gl18' 'gl19' 'gl20' 'gl21' 'gl22' 'gl23' 'gl24' 'gl25' 'gl26' 'gl27' 'gl28' 'gl29' 'gl30' 'gl31' 'si0' 'si1' 'si2' 'si3' 'si4' 'si5' 'si6' 'si7' 'st0' 'st1' 'st2' 'st3' 'st4' 'st5' 'st6' 'st7' 'self' 'true' 'false' 'nil' 'cNeg1' 'c0' 'c1' 'c2' 'retSelf' 'retTrue' 'retFalse' 'retNil' 'ret' 'blockRet' 'bad' 'bad' 'xLoad1' 'xSto' 'xPopSto' 'xSend' 'xxSend' 'xSuper' 'xxSuper' 'pop' 'dup' 'current' 'bad' 'bad' 'bad' 'bad' 'bad' 'bad' 'j1' 'j2' 'j3' 'j4' 'j5' 'j6' 'j7' 'j8' 'b1' 'b2' 'b3' 'b4' 'b5' 'b6' 'b7' 'b8' 'jB' 'jB' 'jB' 'jB' 'jF' 'jF' 'jF' 'jF' 'bT' 'bT' 'bT' 'bT' 'bF' 'bF' 'bF' 'bF' 'sPlus' 'sMinus' 'sLss' 'sGtr' 'sLeq' 'sGeq' 'sEqu' 'sNeq' 'sTimes' 'sOver' 'sRem' 'sMakePt' 'sLshift' 'sLxor' 'sLand' 'sLor' 'sSub' 'sSubGets' 'sLength' 'sNext' 'sNextGets' 'sEnd' 'sEq' 'sClass' 'sBCopy' 'sValue' 'sValue:' 'bad' 'sNew' 'sNew:' 'sX' 'sY' 's0.0' 's0.1' 's0.2' 's0.3' 's0.4' 's0.5' 's0.6' 's0.7' 's0.8' 's0.9' 's0.10' 's0.11' 's0.12' 's0.13' 's0.14' 's0.15' 's1.0' 's1.1' 's1.2' 's1.3' 's1.4' 's1.5' 's1.6' 's1.7' 's1.8' 's1.9' 's1.10' 's1.11' 's1.12' 's1.13' 's1.14' 's1.15' 's2.0' 's2.1' 's2.2' 's2.3' 's2.4' 's2.5' 's2.6' 's2.7' 's2.8' 's2.9' 's2.10' 's2.11' 's2.12' 's2.13' 's2.14' 's2.15' ).
byteNames length 256
ifTrue: [user notify: 'not 256 byte codes']].
"492" CompiledMethod$'Source Code'
[setSourcePosition: pos inFile: f | loc p1 |
"set last three bytes to be pos in file (0-3)"
f > 3
ifTrue: [user notify: 'invalid file number']
ifFalse:
[loc ← self length - 2.
self (loc + 2) ← f * 64 + (p1 ← pos / 65536).
p1 > 62
ifTrue:
[user show: 'Source file is getting full!!'.
user cr].
pos ← pos - (p1 * 65536) "into two bytes".
self (loc + 1) ← p1 ← pos / 256.
pos ← pos land: 255 "into one byte".
self loc ← pos]].
"154" CompiledMethod$'Literals'
[literals | lit |
"Return vector of literals"
↑1 ~ self numLiterals transform [:lit | lit] to [(self objectAt: lit + 2)]].
"141" CompiledMethod$'Header'
[numStack | |
self isQuick
ifTrue: [↑0].
"self or instvar"
↑self frameSize - self numTemps - self numArgs].
"93" CompiledMethod$'Header'
[numTemps | t |
self isQuick
ifTrue: [↑0].
↑self 3 land: 31].
"56" CompiledMethod$'Association'
[selector | |
↑self key].
"1632" CompiledMethod$'ByteCodes'
[symbolic | s d byte i nlits |
self isQuick
ifTrue:
[self isReturnSelf
ifTrue: [↑'quick ↑self'].
↑'quick ↑field: ' + self isReturnField asString]
ifFalse:
[d ← Stream default.
d cr.
d append: ' numArgs: '.
d print: self numArgs.
d cr.
d append: ' numTemps: '.
d print: self numTemps.
d cr.
d append: ' numLiterals: '.
d print: (nlits ← self numLiterals).
d cr.
self frameSize > smallFrame
ifTrue:
[d append: 'large frame'.
d cr].
self primitive > 0
ifTrue:
[d append: 'primitive: '.
d print: self primitive.
d cr].
d print: self literals.
d cr.
s ← Stream new of: self from: self initialPC to: self endPC.
s do:
[:byte | d append: byteNames (byte + 1).
d append: '('.
d append: byte base8.
d append: ')'.
d space.
byte < 128
ifFalse:
[byte 176
ifFalse:
[byte 130
ifTrue:
[ "long loads, stores"
i ← s next.
d append: #('inst' 'temp' 'lit' 'glob' ) (i / 64 + 1).
d print: i \ 64.
d space]
ifFalse:
[byte 134
ifTrue:
[ "long sends"
byte even false
ifTrue:
[i ← s next.
d append: '('.
d print: i / 32.
d append: ')'.
d print: i \ 32.
d space]
ifFalse:
[d append: '('.
d print: s next.
d append: ')'.
d print: s next.
d space]]
ifFalse:
[(160 byte and: [byte 175])
ifTrue:
[ "long jumps"
d print: byte \ 8 - 4 * 256 + s next.
d space]]]]]].
↑d contents]].
"99" Interval$'Reading and Writing'
[ x ← val | |
user notify: 'Intervals are not for writing into'].
"176" Interval$'Reading and Writing'
[ x | |
(x is: Integer)
ifTrue:
[x < 1
ifFalse:
[x > length
ifFalse: [↑start + (step * (x - 1))]]]
ifFalse: [↑super x]].
"54" Interval$'Reading and Writing'
[length | |
↑length].
"144" Interval$'Compatibility'
[cansubscript: a | |
↑length 0 or: [((start cansubscript: a) and: [(length - 1 * step + start cansubscript: a)])]].
"50" Interval$'Reading and Writing'
[stop | |
↑stop].
"110" Interval$'Compatibility'
[= int | |
↑start = int start and: [(stop = int stop and: [length = int length])]].
"95" Interval$'Compatibility'
[hash | |
↑(((start lshift: 2) lxor: stop) lshift: 1) lxor: length].
"72" Interval$'Random Numbers'
[randomInit | |
self randomInit: mem 280].
"247" Interval$'Initialization'
[from: t1 to: t2 by: t3 | |
start ← t1.
stop ← t2.
step ← t3.
length ← 1 + (stop - start / step).
step < 0
ifTrue:
[start < stop
ifTrue: [length ← 0]]
ifFalse:
[stop < start
ifTrue: [length ← 0]]].
"57" Interval$'Compatibility'
[isIntervalBy1 | |
↑step = 1].
"212" Interval$'Random Numbers'
[randomInit: x | |
"Call with const to get repeatable sequence"
step ← x "step holds the current state".
(start is: Float)
ifTrue: [length ← stop - start] "for Float intervals"].
"289" Interval$'Random Numbers'
[random | |
"See Lehmers linear congruential method, Knuth Vol. 1:
modulus m=2↑16
a=27181 odd, and 5 = a mod 8
c=13849 odd, and c/m around 0.21132"
step ← (13849 + (27181 * step)) asInt16.
↑(start + (length asFloat * (32768.0 + step) / 65536.0)) asSmall].
"52" Interval$'Reading and Writing'
[start | |
↑start].
"74" Substring$'Reading and Writing'
[ x ← val | |
↑data (map x) ← val].
"62" Substring$'Reading and Writing'
[ x | |
↑data (map x)].
"208" Substring$'Conversion'
[asStream | |
map isIntervalBy1
ifTrue: [ "direct stream for simple substrings"
↑Stream new of: data from: map start to: map stop].
↑Stream new of: self from: 1 to: map length].
"59" Substring$'Reading and Writing'
[length | |
↑map length].
"170" Substring$'Copying and Altering'
[swap: i with: j | t |
t ← map i "By permuting my map (a writable Array), swap elements i and j.".
map i ← map j.
map j ← t].
"56" Substring$'Compatability'
[species | |
↑data species].
"73" Substring$'Initialization'
[data: t1 map: t2 | |
data ← t1.
map ← t2].
"66" Substring$'Reading and Writing'
[map | |
↑map "Return my map."].
"84" BitRect$'Rectangle Protocol'
[height← h | |
self growby: 0 (h - self extent y)].
"71" BitRect$'Rectangle Protocol'
[corner← x | |
self growby: x - corner].
"76" BitRect$'Rectangle Protocol'
[extent← x | |
self growby: x - self extent].
"132" BitRect$'Showing'
[show | strips i |
strips ← self strips.
(1 to: strips length) do: [:i | strips i bitsFromString: data i]].
"51" BitRect$'Rectangle Protocol'
[= x | |
↑self x].
"160" BitRect$'Initialization'
[origin: t1 corner: t2 title: t3 stripheight: t4 data: t5 | |
origin ← t1.
corner ← t2.
title ← t3.
stripheight ← t4.
data ← t5].
"45" BitRect$'Access to parts'
[data | |
↑data].
"76" BitRect$'Rectangle Protocol'
[printon: strm | |
strm append: 'a BitRect'].
"60" BitRect$'Initialization'
[default | |
↑defaultpic recopy].
"233" BitRect$'Rectangle Protocol'
[growby: change | old |
old ← BitRect new origin: origin corner: corner title: title stripheight: stripheight data: data.
self title: title in: (origin rect: corner + change).
self copyBitsFrom: old].
"54" BitRect$'Press'
[length | |
↑self bitmapLength * 2].
"74" BitRectEditor$'Window protocol'
[redbug | |
dirty ← true.
tool redbug].
"139" RadioButtons$'Pushing a Button'
[setvalue: v | i |
i ← (vec find: v) "if value has been lost, set self to 1" max: 1.
self push: i.
↑i].
"139" RadioButtons$'Init and State'
[vec: t1 at: r height: t3 | |
vec ← t1.
size ← t3.
rect ← r rect: r + (vec length 1 * size).
cur ← 0].
"138" RadioButtons$'Init and State'
[vec: t1 at: r width: t3 | |
vec ← t1.
size ← t3.
rect ← r rect: r + (1 vec length * size).
cur ← 0].
"126" RadioButtons$'Pushing a Button'
[bug: pt | r a |
r ← pt - rect origin - (1 1) / size.
a ← r x + r y + 1.
↑self push: a].
"108" RadioButtons$'Init and State'
[moveto: pt | |
rect moveto: pt.
cur ← 0.
↑rect corner x rect origin y].
"55" RadioButtons$'Init and State'
[value | |
↑vec cur].
"52" RadioButtons$'Init and State'
[reset | |
cur ← 0].
"60" RadioButtons$'Init and State'
[has: pt | |
↑rect has: pt].
"47" RadioButtons$'Init and State'
[vec | |
↑vec].
"97" RadioButtons$'Pushing a Button'
[push: a | |
self release: cur thenPush: a.
↑vec (cur ← a)].
"492" RadioButtons$'Private'
[release: a thenPush: b | boxer offset |
a = b
ifFalse:
[offset ← (size = rect extent y
ifTrue: [size 0]
ifFalse: [0 size]).
a 0
ifTrue:
[boxer ← Rectangle new origin: offset * (a - 1) + rect origin + 1 extent: size size - 1.
boxer comp.
(boxer inset: 1 1) comp].
b 0
ifTrue:
[boxer ← Rectangle new origin: offset * (b - 1) + rect origin + 1 extent: size size - 1.
boxer comp.
(boxer inset: 1 1) comp]]].
"1623" BitRectTool$'Tool action'
[brush: sourceRect | minpt maxpt pt offset |
"use the bits in the BitRect sourceRect as a brush"
sourceRect moveto: brushpt "The inner painting loop should be fast - all the extra foliage below
is to move tests outside of the inner loop".
sourceRect show.
minpt ← self frame origin.
maxpt ← self frame corner - sourceRect extent.
offset ← sourceRect extent / 2 "If mode is storing or oring, use brush command, otherwise blt.
Use the unclipped form of brushing and grid=1 when possible".
(mode < xoring and: [grid = 1])
ifTrue: [[user redbug] whileTrueDo:
[(minpt (pt ← user mp - offset) and: [pt maxpt])
ifTrue: [sourceRect brush: pt mode: mode color: tone]
ifFalse: [sourceRect brush: pt mode: mode color: tone clippedBy: self frame]]]
ifFalse:
[(mode xoring and: [grid = 1])
ifTrue: [[user redbug] whileTrueDo:
[(minpt (pt ← user mp - offset) and: [pt maxpt])
ifTrue: [sourceRect blt: pt mode: mode]
ifFalse: [sourceRect blt: pt mode: mode clippedBy: self frame]]]
ifFalse:
[mode < xoring
ifTrue: [ "grid is > 1"
[user redbug] whileTrueDo:
[(minpt (pt ← self mpOnGrid - offset) and: [pt maxpt])
ifTrue: [sourceRect brush: pt mode: mode color: tone]
ifFalse: [sourceRect brush: pt mode: mode color: tone clippedBy: self frame]]]
ifFalse: [ "grid is > 1 and modexoring"
[user redbug] whileTrueDo:
[(minpt (pt ← self mpOnGrid - offset) and: [pt maxpt])
ifTrue: [sourceRect blt: pt mode: mode]
ifFalse: [sourceRect blt: pt mode: mode clippedBy: self frame]]]]]].
"62" BitRectTool$'Tool action'
[redbug | |
self perform: action].
"47" BitRectTool$'Tool action'
[brush | |
↑brush].
"316" BitRectTool$'Tool action'
[setbrush | rect |
rect ← self getRectangle.
(rect empty or: [50 50 < rect extent])
ifTrue: [pencil frame flash]
ifFalse:
[.
brush color: white mode: storing.
brush title: 'brush' in: rect.
brush saveScreenBits.
brush moveto: brushpt.
brush show.
action ← #paint]].
"121" BitRectTool$'Tool selection'
[brushpt: pt | |
"set the point at which the current brush will be shown"
brushpt ← pt].
"111" BitRectTool$'Tool action'
[mpOnGrid | |
"return mouse point rounded to grid"
↑user mp + (grid / 2) | grid].
"542" BitRectTool$'Tool selection'
[setfrom: butvec | pt |
(butvec 1 has: (pt ← user mp))
ifTrue: [action ← butvec 1 bug: pt]
ifFalse:
[(butvec 2 has: pt)
ifTrue:
[tone ← butvec 2 bug: pt.
tone = white
ifTrue: [pencil white]
ifFalse: [pencil black]]
ifFalse:
[(butvec 3 has: pt)
ifTrue: [mode ← butvec 3 bug: pt]
ifFalse:
[(butvec 4 has: pt)
ifTrue: [pencil width: (butvec 4 bug: pt)]
ifFalse:
[(butvec 5 has: pt)
ifTrue: [grid ← butvec 5 bug: pt]]]]]].
"81" BitRectTool$'Tool action'
[block | |
self getRectangle color: tone mode: mode].
"57" BitRectTool$'Tool selection'
[frame | |
↑pencil frame].
"58" BitRectTool$'Tool action'
[paint | |
self brush: brush].
"45" BitRectTool$'Tool action'
[tone | |
↑tone].
"813" BitRectTool$'Tool action'
[shade | p1 p2 a b t p r vs |
"down on redbug is black place.
up on redbug is white place. Subsequent redbugs
paint a shade of gray depending on position between
black and white (and beyond white to black again).
Yellow or blue bug terminates."
[user redbug] whileFalseDo: [p1 ← user mp "black"].
[user nobug] whileFalseDo: [p2 ← user mp "white"].
vs ← #(1 1025 1089 585 4681 6731 22058 27031 26986 31191 32108 5160 5128 8321 1025 1 0 ).
r ← 0 0 rect: 10 10.
b ← p1 - p2.
b ← b x asFloat b y asFloat.
a ← b x * b x + (b y * b y) / 16.0.
[user yellowbug or: [user bluebug]] whileFalseDo:
[user redbug
ifTrue:
[p ← user mp.
t ← b * (p - p2).
t ← (t x + t y / a) asInteger abs min: 16.
brush brush: p mode: mode color: vs (17 - t)]]].
"62" BitRectTool$'Tool selection'
[frame: f | |
pencil frame: f].
"45" BitRectTool$'Tool action'
[mode | |
↑mode].
"428" BitRectTool$'Class initialization'
[classInit | rect saveBits t i |
blowupScale ← 4 "make a vector of gray pens".
rect ← 0 0 rect: 9 9.
saveBits ← rect bitsIntoString.
t ← Turtle init.
graypens ← Vector new: 8.
(1 to: 8) do:
[:i | t width: i.
rect clear: white.
t place: 4 4.
t go: 0.
graypens i ← BitRect new title: 'graypen' in: rect.
(graypens i) saveScreenBits].
rect bitsFromString: saveBits].
"234" BitRectTool$'Class initialization'
[init | |
(pencil ← Turtle new) init.
pencil color: black.
pencil width: 2.
(brush ← BitRect new) title: 'brush' in: (0 0 rect: 16 16).
tone ← black.
mode ← 0.
grid ← 1.
action ← #draw].
"600" BitRectTool$'Tool action'
[getRectangle | rect newrect start t |
"rect must be in my frame"
start ← self mpOnGrid "the rect-newrect stuff is so that the complementing stays
on for a while".
rect ← newrect ← (Rectangle new origin: start corner: start) intersect: self frame "move the cursor slightly so that the user will notice the rectangle
being complemented".
user cursorloc← start + 4.
[user anybug] whileTrueDo:
[rect ← newrect.
rect comp.
t ← self mpOnGrid.
newrect ← (Rectangle new origin: (start min: t) corner: (start max: t)) intersect: self frame.
rect comp].
↑rect].
"1060" BitRectTool$'Tool action'
[blowup: smallRect to: bigRectFrame | bigRect box pt i turt flag bits |
bits ← bigRectFrame bitsIntoString.
bigRect ← bigRectFrame inset: 2 2.
smallRect blowup: bigRect origin by: blowupScale.
turt ← Turtle init.
box ← 0 0 rect: blowupScale - 1 (blowupScale - 1) "keep editing in blowup mode until the user presses a button
outside the big rect".
[flag] whileTrueDo:
[(bigRect has: (pt ← user mp))
ifTrue:
[box moveto: bigRect origin + (i ← pt - bigRect origin | blowupScale).
turt place: smallRect origin + (i / blowupScale).
user redbug
ifTrue:
[box color: black mode: storing.
turt black.
turt go: 0]
ifFalse:
[user yellowbug
ifTrue:
[box color: white mode: storing.
turt white.
turt go: 0]
ifFalse:
[user bluebug
ifTrue: [bigRect flash]]]]
ifFalse:
[user anybug
ifTrue:
[((bigRect inset: 5 5) has: pt)
ifTrue: [bigRect flash]
ifFalse: [ "quit"
flag ← false]]]].
bigRectFrame bitsFromString: bits].
"200" BitRectTool$'Tool selection'
[showon: butvec | |
butvec 1 setvalue: action.
butvec 2 setvalue: tone.
butvec 3 setvalue: mode.
butvec 4 setvalue: pencil width.
butvec 5 setvalue: grid].
"415" BitRectTool$'Tool action'
[draw | |
(tone = white or: [tone = black])
ifTrue:
[pencil place: self mpOnGrid - pencil frame origin.
grid = 1
ifTrue: [ "make drawing with grid 1 fast"
[user redbug] whileTrueDo: [pencil goto: user mp - pencil frame origin]]
ifFalse: [[user redbug] whileTrueDo: [pencil goto: self mpOnGrid - pencil frame origin]]]
ifFalse: [self brush: graypens pencil width]].
"465" BitRectTool$'Tool action'
[line | start end width |
start ← end ← self mpOnGrid - pencil frame origin.
width ← pencil width.
pencil xor.
pencil width: 1.
[user redbug] whileTrueDo:
[end ← self mpOnGrid - pencil frame origin.
pencil xor.
pencil place: start.
pencil goto: end.
pencil place: start.
pencil goto: end].
tone = white
ifTrue: [pencil white]
ifFalse: [pencil black].
pencil width: width.
pencil place: start.
pencil goto: end].
"605" BitRectTool$'Tool action'
[blowup | smallRect bigRectFrame |
smallRect ← self getRectangle.
bigRectFrame ← Rectangle new origin: smallRect corner extent: 4 4 + (smallRect extent * blowupScale).
(smallRect empty or: [bigRectFrame bitStringLength > 4000])
ifTrue:
[pencil frame flash.
↑nil].
.
(user screenrect has: bigRectFrame corner)
ifFalse:
[bigRectFrame moveto: smallRect origin - bigRectFrame extent.
(user screenrect has: bigRectFrame origin)
ifFalse:
[ "can't find a space for blown up image"
pencil frame flash.
↑nil]].
self blowup: smallRect to: bigRectFrame].
"139" BitRectEditor$'Initialization'
[picture: t1 | |
picture ← t1.
tool ← tools push: 1.
self frame: (picture origin rect: picture corner)].
"62" BitRectEditor$'Initialization'
[toolpic: a | |
toolpic ← a].
"332" BitRectEditor$'Window protocol'
[leave | |
nil saveActionPic
ifFalse:
[actionpic bitsFromString: saveActionPic.
saveActionPic ← nil].
nil saveToolPic
ifFalse:
[toolpic bitsFromString: saveToolPic.
saveToolPic ← nil].
dirty
ifTrue:
[picture saveScreenBits.
dirty ← false].
frame border: 3 color: white].
"51" BitRectEditor$'Window protocol'
[tool | |
↑tool].
"109" BitRectEditor$'Window protocol'
[fixframe: r | |
picture moveto: r origin.
r corner← picture corner.
↑r].
"1205" BitRectEditor$'Window protocol'
[enter | start pt b t4 |
super show "Periodically check if the mouse is still in the frame.
If not, stop showing the picture".
self lostMouse
ifTrue: [↑false].
picture show.
dirty ← false.
self lostMouse
ifTrue: [↑false].
actionbuttons do: [:b | b reset "show action menu above the picture"].
start ← frame origin - 1.
pt ← start - (0 actionpic extent y).
actionpic moveto: pt.
saveActionPic ← actionpic bitsIntoString.
self lostMouse
ifTrue: [↑false].
"last point I can return before having to restore bits under menus"
actionpic show.
pt ← actionbuttons 1 moveto: pt "action".
pt ← actionbuttons 3 moveto: pt "mode".
pt ← actionbuttons 4 moveto: pt "width" "show the next bank of action buttons".
pt ← start - (0 (actionpic extent y + 1 / 2)).
pt ← actionbuttons 2 moveto: pt "tone".
pt ← actionbuttons 5 moveto: pt "grid".
tool brushpt: (pt ← pt + (7 7)).
(t4 ← tool brush) moveto: pt.
t4 show "show the tool pic".
pt ← start - (toolpic extent x 0).
toolpic moveto: pt.
saveToolPic ← toolpic bitsIntoString.
toolpic show.
tools moveto: pt.
tools setvalue: tool.
tool frame: frame.
tool showon: actionbuttons].
"539" BitRectEditor$'Initialization'
[initmenu1 | s z |
s ← Vector new: 5.
z ← 20.
s 1 ← RadioButtons new vec: #(setbrush paint block draw line blowup ) at: 0 0 height: z "action".
s 2 ← RadioButtons new vec: {black , dkgray , gray , ltgray , white} at: 0 0 height: z "tone".
s 3 ← RadioButtons new vec: {0 , 1 , 2 , 3} at: 0 0 height: z "mode".
s 4 ← RadioButtons new vec: {1 , 2 , 4 , 8} at: 0 0 height: z "width".
s 5 ← RadioButtons new vec: {1 , 2 , 4 , 8 , 16 , 32} at: 0 0 height: z "grid".
actionbuttons ← s].
"66" BitRectEditor$'Initialization'
[actionpic: a | |
actionpic ← a].
"80" BitRectEditor$'Window protocol'
[lostMouse | |
↑(frame has: user mp) false].
"357" BitRectEditor$'Initialization'
[classInit | t i |
t ← Vector new: 6.
(1 to: t length) do: [:i | t i ← BitRectTool new init].
tools ← RadioButtons new vec: t at: 0 0 width: 20.
windowmenu ← Menu new string: 'under
move
grow
close
filout
printbits' "actionpic←BitRect new filin: 'actionpic'.
toolpic←BitRect new filin: 'toolpic'.".
self initmenu1].
"329" BitRectEditor$'Window protocol'
[outside | pt |
(toolpic has: (pt ← user mp))
ifTrue:
[user redbug
ifTrue:
[tool ← tools bug: pt.
tool frame: frame.
tool showon: actionbuttons]]
ifFalse:
[(actionpic has: pt)
ifTrue:
[user redbug
ifTrue: [tool setfrom: actionbuttons]]
ifFalse: [↑false]]].
"1087" BitImage$'EDITING'
[grayEdit | a b c i d p r v bits |
"edit up a gray pattern and return it"
r ← Rectangle new "first a rectangle for it. Then redbug is black, yellow is white,
blue terminates" fromuser.
bits ← 0.
a ← r extent.
a ← (a x max: a y) | 4.
a ← a a.
b ← r origin.
r extent← a.
r color: white mode: storing.
r moveby: 0 (0 - a y).
c ← a / 4.
d ← b rect: b + c.
[user bluebug] whileFalseDo:
[user redbug
ifTrue:
[p ← user mp - b / c.
i ← p y * 4 + p x + 1.
(i < 1 or: [i > 16])
ifTrue: [r flash]
ifFalse:
[d moveto: b + (c * p).
d color: black mode: storing.
bits ← bits lor: (1 lshift: 16 - i).
r color: bits mode: storing.
user waitnobug]]
ifFalse:
[user yellowbug
ifTrue:
[p ← user mp - b / c.
i ← p y * 4 + p x + 1.
(i < 1 or: [i > 16])
ifTrue: [r flash]
ifFalse:
[d moveto: b + (c * p).
d color: white mode: storing.
bits ← (1 lxor: (1 lshift: 16 - i)) land: bits.
r color: bits mode: storing.
user waitnobug]]]].
↑bits "aa grayEdit base8 ."].
"92" BitImage$'DISPLAY'
[show | |
super displayat: 0 0 effect: 0 clippedBy: user screenrect].
"65" BitImage$'MODULE ACCESS'
[moveto: pt | |
self translateto: pt].
"768" BitImage$'EDITING'
[arc | pt1 pt2 pt3 p pt |
BlankCursor topage1 "arc tool for forms.".
user clear.
user print: 'Redbug 3 points'.
user cr.
user print: 'Paints using current brush.'.
user waitnobug.
[user redbug] whileFalseDo: [pt1 ← self blinkbrush].
brush displayat: pt1 effect: color clippedBy: user screenrect.
user waitnobug.
[user redbug] whileFalseDo: [pt2 ← self blinkbrush].
brush displayat: pt2 effect: color clippedBy: user screenrect.
user waitnobug.
[user redbug] whileFalseDo: [pt3 ← self blinkbrush].
brush displayat: pt3 effect: color clippedBy: user screenrect.
XeqCursor show.
p ← Path new init.
p addarcfrom: pt1 via: pt2 to: pt3.
p do: [:pt | brush displayat: pt effect: color clippedBy: user screenrect].
NormalCursor show].
"145" BitImage$'DISPLAY'
[displayat: t1 effect: effect clippedBy: cliprect | |
path ← t1.
super displayat: path effect: effect clippedBy: cliprect].
"385" BitImage$'EDITING'
[resize: t1 | pt f |
superimage ← t1.
dotsetter leave.
CornerCursor topage1.
user waitbug.
[user nobug] whileFalseDo:
[self reverse.
self reverse.
pt ← superimage mp + superimage rectangle origin.
self corner← pt max: self origin + (16 16)].
self fromrectangle: rectangle.
self white.
self display.
NormalCursor topage1.
self edit: superimage].
"69" BitImage$'SYSTEM'
[printon: strm | t |
strm append: 'a Bitmage: '].
"854" BitImage$'EDITING'
[yellowbug | t1 |
(t1 ← bitimagemenu bug) = 1
ifTrue: [self resize: superimage]
ifFalse:
[ "change size"
t1 = 2
ifTrue: [self setfigure]
ifFalse:
[t1 = 3
ifTrue: [self setground]
ifFalse:
[t1 = 4
ifTrue: [self newbrush]
ifFalse:
[t1 = 5
ifTrue: [self pastebrush]
ifFalse:
[t1 = 6
ifTrue: [self arc]
ifFalse:
[t1 = 7
ifTrue: [Rectangle new fromuser fillin: dotsetter tool tone mode: dotsetter tool mode]
ifFalse:
[t1 = 8
ifTrue: [dotsetter tool shade]
ifFalse:
[t1 = 9
ifTrue: [self verticalsymmetry]
ifFalse:
[t1 = 10
ifTrue: [self horizontalsymmetry]
ifFalse:
[t1 = 11
ifTrue: [self rotate]]]]]]]]]]]].
"57" BitImage$'PATTERN ACCESS'
[strips: t1 | |
strips ← t1].
"39" BitImage$'SYSTEM'
[pressCode | |
↑3].
"36" BitImage$'SYSTEM'
[title | |
↑''].
"333" BitImage$'EDITING'
[rotate | r f i j |
r ← Rectangle new "90 degree rotation tool" fromuser.
(1 to: r width) do: [:i | (1 to: r height) do:
[:j | f ← Form new fromrectangle: (Rectangle new origin: r origin x + i (r top + j) extent: 1 1).
f displayat: r corner x + j (r top + i) effect: 0 clippedBy: user screenrect]]].
"184" BitImage$'SYSTEM'
[copy | t i |
t ← BitImage new "return a copy of myself" origin: origin copy extent: self extent copy.
(1 to: self length) do: [:i | t add: (self i) copy].
↑t].
"480" BitImage$'EDITING'
[edit: t1 | bits |
superimage ← t1.
XeqCursor show "uses the BitRect toolbox editor".
dotsetter ← BitRectEditor new picture: self.
dotsetter firsttime.
NormalCursor show.
[true] whileTrueDo:
[ "forever"
(dotsetter lostMouse and: [user anybug])
ifTrue:
[dotsetter outside
ifFalse:
[XeqCursor show.
dotsetter lasttime.
bits ← self fromrectangle: rectangle.
NormalCursor show.
↑bits]]
ifFalse: [dotsetter eachtime]]].
"171" BitImage$'EDITING'
[setfigure | t |
figure ← figure + 1 "for now just increment the figure color by 1 \ 12" \ 12.
self do: [:t | t form figure: figure].
self display].
"184" BitImage$'INIT'
[fromImage: image | |
self fromrectangle: image rectangle "creates a virtual bit map with width = (image width) and height = (image height) with the bits in image."].
"111" Image$'MODULE ACCESS'
[superimage | |
↑superimage "return the superimage (Image containing) of this Image."].
"236" Image$'BUILDING IMAGES'
[addimage: i | r |
rectangle ← rectangle include: (Rectangle new "add the Image i (as a subimage) and expand the
bounding rectangle of this image." origin: i origin + origin extent: i extent).
self add: i].
"144" Image$'CHANGING IMAGES'
[findbyrect: image | i |
(1 to: position) do:
[:i | (array i) rectangle = image rectangle
ifTrue: [↑i]].
↑0].
"271" Image$'CHANGING IMAGES'
[deleteimage: i | subimage |
subimage ← self i "delete the i th subimage and recompute the bounding rectangle of the Image".
self deleteI: i.
(subimage rectangle isWithin: rectangle)
ifFalse: [self resize "recompute bounding rectangle"]].
"87" Image$'PATTERN ACCESS'
[black | |
self color: black effect: 0 "black out the image"].
"43" BorderedText$'SYSTEM'
[pressCode | |
↑6].
"171" BorderedText$'SYSTEM'
[copy | t |
t ← BorderedText new paragraph: para copy frame: frame copy style: style copy.
t c1← c1.
t c2← c2.
t begintypein← begintypein.
↑t].
"665" BorderedText$'SYSTEM'
[presson: press in: r | scale |
scale ← press scale.
press setp: r origin x - scale (r corner y - (3 * scale)).
press showrectwidth: scale * (2 + self width) height: scale.
press setp: r origin x - scale (r corner y - (self height + 5 * scale)).
press showrectwidth: scale * (2 + self width) height: scale.
press setp: r origin x - scale (r corner y - (scale * (self height + 4))).
press showrectwidth: scale height: scale * (self height + 2).
press setp: r origin x + (scale * self width) (r corner y - (scale * (self height + 4))).
press showrectwidth: scale height: scale * (self height + 2).
↑para presson: press in: r].
"530" BorderedText$'DISPLAY'
[displayat: pt effect: effect clippedBy: cliprect | origin corner t6 |
super displayat: pt effect: effect clippedBy: cliprect "display text and border around it ".
origin ← frame origin.
corner ← frame corner.
(t6 ← Rectangle new origin: origin - (1 1) corner: corner x + 1 origin y) color: 1 mode: effect.
t6 moveto: origin x - 1 corner y.
t6 color: 1 mode: effect.
t6 origin← corner x (origin y - 1).
t6 color: 1 mode: effect.
t6 moveto: origin - (1 1).
t6 color: 1 mode: effect].
"194" Image$'PATTERN ACCESS'
[white | |
(form is: BorderedText) "white out the image"
ifTrue: [(rectangle inset: 1 1 and: [1 1]) clear: 0]
ifFalse:
[self color: white effect: over]].
"67" Image$'MODULE ACCESS'
[= image | |
↑rectangle = image rectangle].
"124" Image$'MODULE ACCESS'
[rightside | |
↑rectangle corner "return the rightmost x of the bounding rectangle of theImage." x].
"131" Image$'MODULE ACCESS'
[contains: pt | |
↑rectangle has: pt "return true if the bounding rectangle for the Image contains pt.."].
"90" Image$'PATTERN ACCESS'
[gray | |
self color: gray effect: storing "gray out the image"].
"270" Image$'TRANSFORMATIONS'
[normalize | delta i |
"recompute origin, rectangle and path so that: path origin = 00."
nil path
ifFalse:
[delta ← path origin copy.
path normalize.
origin translate: delta].
(1 to: self length) do: [:i | (self i) normalize]].
"178" Image$'SYSTEM'
[mp | p |
p ← user mp " returns a gridded point relative to my rectangle.".
p x← p x - rectangle origin x | xgrid.
p y← p y - rectangle origin y | ygrid.
↑p].
"173" Image$'SYSTEM'
[printon: strm | t |
strm append: 'an Image: '.
(array is: String)
ifTrue: [strm space append: self]
ifFalse: [self do: [:t | strm space print: t]]].
"76" Image$'ACCESS TO PARTS'
[form | |
↑form "return the form for this Image"].
"76" Image$'ACCESS TO PARTS'
[path | |
↑path "return the path for this Image"].
"63" Image$'ACCESS TO PARTS'
[superimage: t1 | |
superimage ← t1].
"97" Image$'CHANGING IMAGES'
[deletesubimage: i | |
self deleteindex: i "delete the ith subimage."].
"175" Image$'CHANGING IMAGES'
[subimage: i | sub s |
sub ← self i "return the ith subimage." s← Image new at: self origin + (sub 1) origin.
s add: 0 0 and: [sub 2].
↑s].
"209" Image$'CHANGING IMAGES'
[subimageat: pt | i |
i ← self indexofsubimageat: pt "return the subimage which contains pt (relative to self origin)
otherwise return false.".
i
ifTrue: [↑self i].
↑false].
"204" Image$'CHANGING IMAGES'
[substitute: form1 for: form2 | i |
(1 to: self length "everywhere in the imagesubstitute form1 for form2") do:
[:i | self i 2 form2
ifTrue: [self i 2 ← form1]]].
"270" Image$'INIT'
[origin: t1 rectangle: t2 path: t3 form: t4 figure: t5 ground: t6 xgrid: t7 ygrid: t8 | |
origin ← t1.
rectangle ← t2.
path ← t3.
form ← t4.
figure ← t5.
ground ← t6.
xgrid ← t7.
ygrid ← t8.
self default "basic message to create a new instance."].
"101" Image$'MODULE ACCESS'
[rectangle: r | |
rectangle ← r "redefine rectangle that bounds the Image."].
"201" Image$'CHANGING IMAGES'
[highlite | r i |
(1 to: position) do:
[:i | "reverse the ith subimage ."
r ← Rectangle new origin: self origin + (self i) origin extent: (self i) extent.
r comp]].
"173" Image$'BUILDING IMAGES'
[addform: f andpath: p | r |
self addpath: p andform: f "add p (set or point) and f ( Form ) and expand the
bounding rectangle of this image."].
"429" Image$'BUILDING IMAGES'
[addpath: p andform: f | r |
rectangle ← rectangle include: (r ← (Rectangle new "add p (set or point) and f ( Form ) and expand the
bounding rectangle of this image." origin: p origin extent: f extent "+ origin") include: (Rectangle new origin: p corner - (1 1) extent: f extent "+ origin")).
self add: (Image new origin: 0 0 rectangle: r path: p form: f figure: 1 ground: 0 xgrid: 1 ygrid: 1)].
"951" Image$'CHANGING IMAGES'
[edit: t1 | blackdot pt indexofsubimage subimage |
superimage ← t1.
nil form "eventually a general Image manipulator for now
just passes control to its subimages."
ifTrue:
[user waitnobug.
[1 = 2] whileFalseDo:
[ "until bug occurs outside rectangle"
(false = (rectangle has: user mp) and: [user anybug])
ifTrue: [↑self].
user kbck
ifTrue: [self kbd]
ifFalse:
[user redbug
ifTrue:
[indexofsubimage ← self smallestsubimageat: user mp - self rectangle origin.
indexofsubimage
ifTrue:
[subimage ← self indexofsubimage.
subimage translate: self origin.
subimage edit: self.
subimage translate: 0 0 - self origin]]
ifFalse:
[user yellowbug
ifTrue: [self yellowbug]]]]]
ifFalse:
[.
form ← form edit: self.
(form is: Form)
ifFalse: [ "origin ← (form origin) copy."
rectangle ← form frame copy].
↑self]].
"265" Image$'SYSTEM'
[copy | im i |
im ← Image new origin: origin copy rectangle: rectangle copy path: path copy form: form copy figure: figure copy ground: ground copy xgrid: xgrid copy ygrid: ygrid copy.
(1 to: self length) do: [:i | im add: (self i) copy].
↑im].
"53" Image$'ACCESS TO PARTS'
[hash | |
↑rectangle hash].
"98" Image$'SYSTEM'
[kbd | |
user kbd " default response for Images.".
self reverse.
self reverse].
"262" Image$'INIT'
[origin: t1 rectangle: t2 path: t3 form: t4 | |
origin ← t1.
rectangle ← t2.
path ← t3.
form ← t4.
self origin: origin rectangle: rectangle path: path form: form figure: 1 ground: 0 xgrid: 1 ygrid: 1 "basic message to create a new instance."].
"280" Image$'CHANGING IMAGES'
[indexofsubimageat: pt | i subimage |
(1 to: self length "return the index of the subimage which contains pt(relative to self origin)
otherwise return false.") do:
[:i | subimage ← self i.
(subimage rectangle has: pt)
ifTrue: [↑i]].
↑false].
"174" Image$'TRANSFORMATIONS'
[translate: delta | |
rectangle ← rectangle translate: delta "translate the origin and bounding rectangle of the Image.".
origin translate: delta].
"261" Image$'INIT'
[origin: t1 extent: extent | |
origin ← t1.
self origin: origin copy "create a new Image at origin with extent (widthheight). " rectangle: (Rectangle new origin: origin extent: extent) path: nil form: nil figure: 1 ground: 0 xgrid: 1 ygrid: 1].
"372" Image$'INIT'
[classInit | |
black ← 0 - 1 "sets up black and white as colors and over ,under and reverse as modes
also initializes the name screen as an image the size of the display".
white ← 0.
over ← 0.
under ← 1.
reverse ← 2.
screen ← Image new origin: user screenrect origin extent: user screenrect extent.
aurora ← nil "Aurora new".
aurorarunning ← false].
"104" Image$'MODULE ACCESS'
[extent | |
↑rectangle extent "return the extent (width,height) of the Image."].
"79" Image$'MODULE ACCESS'
[origin | |
↑origin "return the origin of the image."].
"89" Image$'MODULE ACCESS'
[corner | |
↑rectangle corner "return the corner of the Image."].
"91" Image$'MODULE ACCESS'
[height | |
↑rectangle extent "return the height of the Image." y].
"146" Image$'DISPLAY'
[display | |
self displayat: 0 0 "display all of the forms in the image on the screen " effect: 0 clippedBy: user screenrect].
"357" Image$'BUILDING IMAGES'
[add: p and: i | s |
rectangle ← rectangle include: ((Rectangle new "add p (set or point) and i ( Image or Form ) and expand the
bounding rectangle of this image." origin: p origin + origin extent: i size) include: (Rectangle new origin: p corner + origin extent: i size)).
s ← Set default.
s add: p.
s add: i.
self add: s].
"118" Image$'MODULE ACCESS'
[bottom | |
↑rectangle corner "return the bottom y of the bounding rectangle of theImage." y].
"87" Image$'MODULE ACCESS'
[origin: t1 | |
origin ← t1 "change the origin of the image."].
"124" Image$'PATTERN ACCESS'
[reverse | |
self color: black effect: 2 "reverse the image (black to white and white to black)"].
"180" Image$'CHANGING IMAGES'
[appendimage: newimage after: image | i |
i ← self findbyrect: image "append newimage into the image after image.".
self insertI: i + 1 value: newimage].
"170" Image$'CHANGING IMAGES'
[replaceimage: image with: newimage | i |
i ← self findbyrect: image "replace image with newimage in self.".
self replaceI: i value: newimage].
"89" Image$'MODULE ACCESS'
[center | |
↑rectangle center "return the center of the Image."].
"285" Image$'INIT'
[fromuser | |
rectangle ← Rectangle new "create a new Image whose rectangle is specified by the user. " fromuser.
self origin: rectangle origin rectangle: rectangle path: rectangle origin form: (Form new fromrectangle: rectangle) figure: 1 ground: 0 xgrid: 1 ygrid: 1].
"329" Image$'MODULE ACCESS'
[resize | i |
" Recompute the bounding rectangle of the Image"
nil form
ifTrue: [rectangle ← Rectangle new origin: origin extent: 1 1]
ifFalse: [rectangle ← Rectangle new origin: origin extent: form extent].
(1 to: self length) do: [:i | rectangle ← rectangle include: (self i) rectangle]].
"112" Image$'MODULE ACCESS'
[top | |
↑rectangle origin "return the top y of the bounding rectangle of theImage." y].
"96" Image$'MODULE ACCESS'
[corner← pt | |
rectangle corner← pt "modify the corner of the Image."].
"96" Image$'ACCESS TO PARTS'
[xgrid: t1 | |
xgrid ← t1 "set the x gridding module for this Image"].
"100" Image$'TRANSFORMATIONS'
[translateto: pt | |
self translate: pt - origin "move the Image to pt."].
"91" Image$'ACCESS TO PARTS'
[xgrid | |
↑xgrid "return the x gridding module for this Image"].
"96" Image$'PATTERN ACCESS'
[boxcomp | |
rectangle comp "border without disturbing the interior."].
"84" Image$'ACCESS TO PARTS'
[form: t1 | |
form ← t1 "change the form for this Image"].
"84" Image$'ACCESS TO PARTS'
[path: t1 | |
path ← t1 "change the path for this Image"].
"89" Image$'MODULE ACCESS'
[width | |
↑rectangle extent "return the width of the Image." x].
"91" Image$'ACCESS TO PARTS'
[ygrid | |
↑ygrid "return the y gridding module for this Image"].
"318" Image$'DISPLAY'
[displayat: pt effect: effect clippedBy: cliprect | i |
"display all of the subimages in this image "
nil form
ifFalse: [form displayat: path + pt + origin effect: effect clippedBy: cliprect].
(1 to: self length) do: [:i | self i displayat: pt + origin effect: effect clippedBy: cliprect]].
"96" Image$'ACCESS TO PARTS'
[ygrid: t1 | |
ygrid ← t1 "set the y gridding module for this Image"].
"315" Image$'INIT'
[blink: t1 | pt |
form ← t1.
pt ← self mp "to show current gridded position of the form... returns abs position.".
form displayat: rectangle origin + pt effect: 2 clippedBy: user screenrect.
form displayat: rectangle origin + pt effect: 2 clippedBy: user screenrect.
↑self rectangle origin + pt].
"233" Image$'CHANGING IMAGES'
[indexofsubimagebelow: yvalue | i subimage |
(1 to: self length "return the index of the first subimage below yvalue otherwise return false.") do:
[:i | (self i) top yvalue
ifTrue: [↑i]].
↑false].
"395" Image$'INIT'
[rectanglefromuser | f pt r |
r ← Rectangle new "create a Rectangle specified by the user and origin and corner are gridded. ".
f ← Form new extent: xgrid ygrid.
f black.
user waitnobug.
[user anybug] whileFalseDo:
[r origin← self blink: f].
[user nobug] whileFalseDo:
[r corner← self mp + rectangle origin max: r origin + f extent.
r reverse.
r reverse].
↑r].
"118" Image$'ACCESS TO PARTS'
[figure | |
↑figure "return the figure color (color associated with black) for this Image"].
"118" Image$'ACCESS TO PARTS'
[ground | |
↑ground "return the ground color (color associated with white) for this Image"].
"155" Image$'Fist and last'
[close | im |
array nil
ifFalse: [self asArray notNil do: [:im | im close]].
superimage ← nil.
form ← nil.
self vector: 0].
"122" Image$'MODULE ACCESS'
[leftside | |
↑rectangle origin "return the leftmost x of the bounding rectangle of theImage." x].
"498" Image$'SYSTEM'
[hideData: complete | s t3 |
(t3 ← Stream new "stores an instance of class Image on a press file. ignore complete") of: (s ← String new: 24).
t3 nextword← self length "number of subimages".
t3 nextPoint← origin.
t3 nextPoint← rectangle origin.
t3 nextPoint← rectangle corner.
t3 nextword← xgrid.
t3 nextword← ygrid.
t3 nextword← figure.
t3 nextword← ground.
t3 next← (form nil
ifTrue: [0]
ifFalse: [1]).
t3 next← (path nil
ifTrue: [0]
ifFalse: [1]).
↑s].
"36" Image$'SYSTEM'
[pressCode | |
↑1].
"126" Image$'ACCESS TO PARTS'
[figure: t1 | |
figure ← t1 "change the figure color (color associated with black) for this Image"].
"126" Image$'ACCESS TO PARTS'
[ground: t1 | |
ground ← t1 "change the ground color (color associated with white) for this Image"].
"364" Image$'SYSTEM'
[hidePress: press complete: c | |
c 0
ifTrue:
[ "called from PressPrinter print:in:"
form nil
ifFalse: [ "already done"
form hidePress: press complete: c].
path nil
ifFalse: [path hidePress: press complete: c]]
ifFalse: [ "1. called from Image presson:in:"
press skipcode: self pressCode data: (self hideData: c)]].
"244" Image$'DISPLAY'
[display: effect | |
self displayat: 0 0 "display all of the forms in the image on the screen
effect = 0 store
effect = 1 or
effect = 2 xor
effect = 3 and complement
" effect: effect clippedBy: user screenrect].
"517" Image$'CHANGING IMAGES'
[smallestsubimageat: pt | i smallest slf sml |
smallest ← false "return the index of the smallest subimage which contains pt(relative to self origin)
otherwise return false.".
(1 to: self length) do:
[:i | ((self i) rectangle has: pt)
ifTrue:
[smallest
ifTrue:
[slf ← (self i) rectangle.
sml ← (self smallest) rectangle.
slf area < sml area
ifTrue: [smallest ← i]]
ifFalse: [smallest ← i]]].
smallest
ifTrue: [↑self smallest].
↑smallest].
"809" Image$'DISPLAY'
[quickDisplayAt: pt scale: scal offset: delta | i rect x1 y1 x2 y2 |
x1 ← (scal * (rectangle minX "outline me and all of the subimages in this image in given scale" + pt x) + delta x) asInteger.
y1 ← (scal * (rectangle minY + pt y) + delta y) asInteger.
x2 ← (scal * (rectangle maxX + pt x) + delta x) asInteger.
y2 ← (scal * (rectangle maxY + pt y) + delta y) asInteger.
rect ← x1 y1 rect: x2 y2.
rect outline.
pt ← pt + origin.
(1 to: self length) do:
[:i | rect ← (self i) rectangle.
x1 ← (scal * (rect minX + pt x) + delta x) asInteger.
y1 ← (scal * (rect minY + pt y) + delta y) asInteger.
x2 ← (scal * (rect maxX + pt x) + delta x) asInteger.
y2 ← (scal * (rect maxY + pt y) + delta y) asInteger.
rect ← x1 y1 rect: x2 y2.
rect color: gray mode: oring]].
"97" Image$'MODULE ACCESS'
[rectangle | |
↑rectangle "return the rectangle that bounds the Image."].
"347" Image$'PATTERN ACCESS'
[color: color effect: effect | |
rectangle color: color mode: effect "basic rectangle call to blt.".
aurorarunning
ifTrue: [user displayoffwhile [
(aurora destination: rectangle.
aurora source: rectangle.
aurora figure: figure.
aurora ground: ground.
aurora function: 1103 "AoverB".
aurora doit)]]].
"82" Image$'DISPLAY'
[blink | |
self display: 2 "blink the image".
self display: 2].
"221" Image$'CHANGING IMAGES'
[outlinesubimage: i | r |
r ← Rectangle new "draw an outline(reversed boarder 2 units thick) about the ith subimage ." origin: self origin + (self i) origin extent: (self i) extent.
r comp].
"657" Image$'SYSTEM'
[presson: press in: r | yvalue t h rect |
(self length > 0 and: [r height < (h ← press scale * self height)])
ifTrue: [↑self].
"try on next page"
self hidePress: press complete: 1.
self do:
[:t | yvalue ← t presson: press in: r "if subimage didn't fit, print version will be clipped,
but entire subimage will be stored".
t hidePress: press complete: ((yvalue is: Integer)
ifTrue: [0]
ifFalse: [1])].
form nil
ifTrue: [↑r corner y - h].
rect ← r copy.
rect corner y← rect corner y - (path y * press scale) "form will be hidden by Image presson:in: or PressPrinter print:in:".
.
↑form presson: press in: rect].
"136" Image$'CHANGING IMAGES'
[comment | |
"see class Set for operations (deletion,replacement,insertion etc.) on subimages ( elements)."].
"80" Image$'TRANSFORMATIONS'
[griddedpoint: pt | |
↑pt x | xgrid (pt y | ygrid)].
"674" Image$'CHANGING IMAGES'
[subimageswithin: rect | image topleft fittedimage t |
image ← Image new "return an image containing my subimages that are within rect, otherwise return false." origin: rect origin extent: rect extent.
self do:
[:t | (t rectangle isWithin: rect)
ifTrue: [image addimage: (t translate: 0 0 - rect origin)]].
image length = 0
ifTrue: [↑false].
topleft ← (image 1) rectangle origin.
image do:
[:t | t rectangle origin < topleft
ifTrue: [topleft ← t rectangle origin]].
fittedimage ← Image new origin: topleft + rect origin extent: 1 1.
image do: [:t | fittedimage addimage: (t translate: 0 0 - topleft)].
↑fittedimage].
"1513" Image$'SYSTEM'
[fromPress: press value: s | numberofsubimages i code t |
self default "retrieves and builds an instance of class Image from a press file".
numberofsubimages ← s nextword.
origin ← s nextPoint.
i ← s nextPoint.
rectangle ← i rect: s nextPoint.
xgrid ← s nextword.
ygrid ← s nextword.
figure ← s nextword.
ground ← s nextword.
form ← s next.
path ← s next.
(1 to: numberofsubimages) do:
[:i | s ← press nextControl asStream.
code ← s next.
t ← Image new.
code = t pressCode
ifTrue: [self addimage: (t fromPress: press value: s)]
ifFalse: [user notify: 'subimage not Image']].
form = 0
ifTrue: [form ← nil]
ifFalse:
[s ← press nextControl asStream.
code ← s next.
form ← (code = 4
ifTrue: [TextImage new]
ifFalse:
[code = 5
ifTrue: [Form new]
ifFalse:
[code = 6
ifTrue: [BorderedText new]
ifFalse: [false]]]).
(form and: [code = form pressCode])
ifTrue:
[code = 4
ifTrue: [form frame← rectangle copy].
code = 6
ifTrue: [form frame← rectangle copy].
form fromPress: press value: s]
ifFalse: [user notify: 'illegal form']].
path = 0
ifTrue: [path ← nil]
ifFalse:
[s ← press nextControl asStream.
code ← s next.
path ← (code = 6
ifTrue: [Path new]
ifFalse:
[code = 7
ifTrue: [Point new]
ifFalse: [false]]).
(path and: [code = path pressCode])
ifTrue: [path fromPress: press value: s]
ifFalse: [user notify: 'illegal path']]].
"822" BitImage$'INIT'
[fromrectangle: rect | r i leftover image yposition |
super origin: rect origin "creates a virtual bit map with width = (r width) , height = (r height)
and the bits in rect. The Image is made up of forms that are stripheight high." extent: rect extent.
nstrips ← rect height + (stripheight - 1) / stripheight.
yposition ← 0.
leftover ← rect height \ stripheight.
leftover = 0
ifTrue: [leftover ← stripheight].
r ← Rectangle new origin: rect origin extent: rect width stripheight.
(1 to: nstrips) do:
[:i | i = nstrips
ifTrue: [r extent← rect width leftover].
image ← Image new origin: 0 0 extent: rect extent.
image form: (Form new fromrectangle: r).
image path: 0 yposition.
self addimage: image.
yposition ← yposition + stripheight.
r translate: 0 stripheight]].
"474" BitImage$'EDITING'
[line | pt1 pt2 p pt |
BlankCursor topage1 "line tool for forms.".
[user redbug] whileFalseDo: [pt1 ← self blinkbrush].
brush displayat: pt1 effect: color clippedBy: user screenrect.
[user nobug] whileFalseDo: [pt2 ← self blinkbrush].
brush displayat: pt2 effect: color clippedBy: user screenrect.
p ← Path new init.
p addlinefrom: pt1 to: pt2.
p do: [:pt | brush displayat: pt effect: color clippedBy: user screenrect].
NormalCursor topage1].
"171" BitImage$'EDITING'
[setground | t |
ground ← ground + 1 "for now just increment the ground color by 1 \ 12" \ 12.
self do: [:t | t form ground: ground].
self display].
"354" BitImage$'EDITING'
[newbrush | pt rect |
OriginCursor topage1.
user waitbug.
pt ← self mp + rectangle origin.
rect ← pt rect: pt.
CornerCursor topage1.
[user nobug] whileFalseDo:
[rect reverse.
rect reverse.
pt ← self mp + rectangle origin.
rect corner← rect origin max: pt].
brush ← Form new fromrectangle: rect.
NormalCursor topage1].
"59" BitImage$'PATTERN ACCESS'
[nstrips: t1 | |
nstrips ← t1].
"287" BitImage$'EDITING'
[pastebrush | pt1 |
user waitnobug "one-copy tool for forms.".
OriginCursor show.
user waitbug.
[user redbug] whileTrueDo: [pt1 ← self blinkbrush].
XeqCursor show.
brush displayat: pt1 effect: dotsetter tool mode clippedBy: user screenrect.
NormalCursor show].
"439" BitImage$'EDITING'
[horizontalsymmetry | r f i |
user clear "horizontal symmetry tool".
user show: 'Define rectangle. Reflection will be around lower edge'.
r ← Rectangle new fromuser.
XeqCursor show.
(1 to: r height) do:
[:i | f ← Form new fromrectangle: (Rectangle new origin: r origin x (r bottom - i) extent: r width 1).
f displayat: r origin x (r bottom + i) effect: 0 clippedBy: user screenrect].
NormalCursor show].
"330" BitImage$'FILING'
[write: filename | file subimage |
file ← dp0 file: filename "Saves the Form in the format nstrips , Form(1) , Form(2) , Form(3) . . .
Form(nstips). Where each Form is saved as width,height then bits. ".
file nextword← nstrips.
self do:
[:subimage | file append: subimage form asInstance].
file close].
"250" BitImage$'EDITING'
[blinkbrush | pt |
pt ← self mp "to show current position of brush in the BitImage." + rectangle origin.
brush displayat: pt effect: 2 clippedBy: user screenrect.
brush displayat: pt effect: 2 clippedBy: user screenrect.
↑pt].
"144" BitImage$'PATTERN ACCESS'
[erase | i |
(1 to: nstrips) do: [:i | "sets all bits in the BitImage to white ( to zeros)"
(strips i) white]].
"50" BitImage$'MODULE ACCESS'
[frame | |
↑rectangle].
"51" BitImage$'PATTERN ACCESS'
[nstrips | |
↑nstrips].
"50" BitImage$'PATTERN ACCESS'
[saveScreenBits | |
].
"440" BitImage$'EDITING'
[verticalsymmetry | r f i |
user clear "vertical symmetry tool".
user show: 'Define rectangle. Reflection will be around right-hand edge'.
r ← Rectangle new fromuser.
XeqCursor show.
(1 to: r width) do:
[:i | f ← Form new fromrectangle: (Rectangle new origin: r origin x + r width - i r top extent: 1 r height).
f displayat: r corner x + i r top effect: 0 clippedBy: user screenrect].
NormalCursor show].
"60" BitImage$'MODULE ACCESS'
[comment | |
"see class Image"].
"376" BitImage$'INIT'
[classInit | |
black ← 0 - 1 "sets up colors and effects for BITBLT.".
white ← 0.
over ← 0.
under ← 1.
reverse ← 2.
erase ← 3.
brush ← Form new extent: 5 5.
brush black.
color ← 1.
stripheight ← 20.
bitimagemenu ← Menu new string: 'size
figure
ground
newform
pasteform
arc
areafill
shade
vertical
horizontal
rotate
'.
aurora ← nil "Aurora new"].
"502" BitImage$'FILING'
[read: filename | file subimage strip yposition i |
self origin: 0 0 "Reads the Image in the format nstrips , Form(1) , Form(2) , Form(3) . . .
Form(nstips). Where each Form is saved as width,height then bits. " extent: 1 1.
yposition ← 0.
file ← (dp0 oldFile: filename) readonly.
nstrips ← file nextword.
(1 to: nstrips) do:
[:i | strip ← Form new fromInstance: file.
self addform: strip andpath: 0 yposition.
yposition ← yposition + strip height].
file close].
"149" BitImage$'INIT'
[fromuser | r |
r ← Rectangle new "create a new Form whose rectangle is specified by the user. " fromuser.
self fromrectangle: r].
"230" BitImage$'INIT'
[fromuserevenword | r |
r ← Rectangle new "create a new BitImage whose rectangle is specified by the user,
truncated to nearest multiple of 16 (for Spruce printing). " fromuserevenword.
self fromrectangle: r].
"100" BitImage$'PATTERN ACCESS'
[strips | |
↑strips "return the set of Forms making up this BitImage)"].
"104" BitRectEditor$'Window protocol'
[yellowbug | |
(picture is: BitImage)
ifTrue: [picture yellowbug]].
"620" BitRectEditor$'Window protocol'
[bluebug | t1 |
(picture is: BitImage)
ifTrue: [↑picture fromrectangle: picture rectangle].
(t1 ← windowmenu bug) = 1
ifTrue:
[self leave.
↑exitflag ← false].
"under"
t1 = 2
ifTrue:
[self leave.
self newframe.
self enter]
ifFalse:
[ "move"
t1 = 3
ifTrue: [self grow "grow"]
ifFalse:
[t1 = 4
ifTrue:
[self leave.
self erase "close".
user unschedule: self.
↑false].
t1 = 5
ifTrue:
[self leave.
picture filout.
self enter]
ifFalse:
[ "filout"
t1 = 6
ifTrue: [self print] "press file"]]]].
"812" BitRectEditor$'Window protocol'
[grow | oldframe newframe pt r |
self leave.
newframe ← picture origin rect: picture corner.
CornerCursor showwhile [
(pt ← user mp + 16.
[user nobug] whileTrueDo:
[newframe corner← pt.
newframe comp.
pt ← user mp + 16.
newframe comp].
[user anybug] whileTrueDo:
[newframe corner← pt.
newframe comp.
pt ← user mp + 16.
newframe comp])] "clear unused areas from old picture to background,
and clear new picture areas to white".
oldframe ← picture inset: 2 2 "2 is for erasing old border".
(oldframe minus: newframe) do: [:r | r clear: background].
(newframe minus: picture) do: [:r | r clear: white].
picture title: picture title in: newframe.
picture saveScreenBits.
self frame: newframe.
self show.
self takeCursor.
self enter].
"61" BitRectEditor$'Window protocol'
[title | |
↑picture title].
"110" BitRectEditor$'Window protocol'
[showtitle | |
"The BitRectEditor have a menu where the title used to be"].
"130" BitRect$'Editing'
[edit | a |
user leaveTop.
a ← BitRectEditor new picture: self.
a takeCursor.
a enter.
user restartup: a].
"47" BitRect$'Access to parts'
[title | |
↑title].
"68" BitRect$'Rectangle Protocol'
[hash | |<primitive: 39>
user croak].
"233" BitRect$'Filin and filout'
[filout | f i |
"write bits on a file"
f ← dp0 file: (title concat: '.pic.').
f nextword← self extent x.
f nextword← self extent y.
f nextword← stripheight.
data do: [:i | i toStream: f].
f close].
"71" BitRect$'Rectangle Protocol'
[growto: x | |
self growby: x - corner].
"789" BitRect$'Editing'
[copyBitsFrom: other | clippedStrip i j myStrips otherStrips myStrip otherStrip bb |
myStrips ← self strips "copy all bits from other that are within my area".
otherStrips ← other strips.
(1 to: myStrips length) do: [:i | (1 to: otherStrips length) do:
[:j | myStrip ← myStrips i.
otherStrip ← otherStrips j.
clippedStrip ← myStrip intersect: otherStrip.
clippedStrip empty
ifFalse:
[bb ← BitBlt init.
bb function← 0.
bb destbase← data i.
bb destraster← myStrip width + 15 / 16.
bb dest← clippedStrip origin - myStrip origin.
bb extent← clippedStrip extent.
bb sourcebase← other data j.
bb sourceraster← otherStrip width + 15 / 16.
bb source← clippedStrip origin - otherStrip origin.
bb bb callBLT]]]].
"171" BitRect$'Showing'
[saveScreenBits | strips i |
strips ← self strips.
(1 to: strips length) do: [:i | strips i bitsIntoString: data i mode: storing clippedBy: nil]].
"417" BitRect$'Initialization'
[title: t1 in: rect | nStrips i strips |
title ← t1.
origin ← rect origin.
corner ← rect corner "the strip height is chosen so that each bitstring is about 2048 bytes".
stripheight ← 1023 / (self extent x + 15 / 16).
nStrips ← self extent y + stripheight - 1 / stripheight.
data ← Vector new: nStrips.
strips ← self strips.
(1 to: nStrips) do: [:i | data i ← (strips i) bitmap]].
"712" BitRect$'Press'
[presson: press in: r | w h hs scale w16 y |
scale ← press scale.
h ← self height.
(hs ← scale * h) > r height
ifTrue: [↑self].
"not enough room left on current page.
assume for now that it will at least fit on an entire page"
w ← self width.
w16 ← w + 15 | 16 "width to next word boundary" "with w, prints on viola but not on spruce.
with w16, prints on spruce with garbage on end".
press setp: 0 (y ← r corner y - hs).
press dots [
(press setcoding: 1 dots: w16 lines: h "bitmap".
press setmode: 3 "to right and to bottom".
press setsizewidth: scale * w16 height: hs.
press setwindowwidth: w16 height: h.
press dotsfollow.
self bitsOntoStream: press data)].
↑y].
"130" BitRect$'Initialization'
[classInit | |
defaultpic ← BitRect new "the default picture is a gray rectangle" filin: 'defaultpic'].
"102" BitRect$'Rectangle Protocol'
[bitsOntoStream: strm | bits |
data do: [:bits | bits toStream: strm]].
"81" BitRect$'Rectangle Protocol'
[width← w | |
self growby: w - self extent x 0].
"113" BitRect$'Initialization'
[fromuser | |
self title: 'BitRect' in: Rectangle new fromuser.
self saveScreenBits].
"594" BitRect$'Filin and filout'
[filin: t1 | f i x y rect strips |
"read bits from a file"
title ← t1.
f ← dp0 oldFile: (title concat: '.pic.').
f readonly.
f end
ifTrue:
[f close.
user notify: 'no data']
ifFalse:
[x ← f nextword.
y ← f nextword.
rect ← Rectangle new origin: ((origin is: Point)
ifTrue: [origin]
ifFalse: [0 0]) extent: x y.
self title: title in: rect.
stripheight f nextword
ifTrue: [user notify: 'strip heights dont match']
ifFalse:
[strips ← self strips.
(1 to: strips length) do: [:i | f into: data i].
f close]]].
"499" BitRect$'Showing'
[strips | nStrips strips stripOrigin stripExtent i |
"return a vector of strips (Rectangles)"
(nStrips ← data length) = 1
ifTrue: [↑self inVector].
strips ← Vector new: nStrips.
stripOrigin ← origin.
stripExtent ← self width stripheight.
(1 to: nStrips - 1) do:
[:i | strips i ← Rectangle new origin: stripOrigin extent: stripExtent.
stripOrigin ← stripOrigin + (0 stripheight)].
strips nStrips ← Rectangle new origin: stripOrigin corner: corner.
↑strips].
"140" FormSet$'PARTS'
[descent | |
↑strike word: 7 "When form set treated as characters, describes distance from bottom of
form to baseline."].
"1451" FormSet$'ACCESS'
[from: first to: last ascent: ascent descent: descent style: t5 styleindex: t6 name: name | |
style ← t5.
styleindex ← t6.
self classInit "Make an empty formset.".
offsettable ← String new: last - first + 3 * 2.
offsettable all← 0.
offsettable word: (last - first + 3) ← 4 "width of illegal form".
strike ← String new: 9 + ascent "header" + descent "space for illegal form" * 2.
strike all← 0.
self type: 32768 "for the outside world".
self first: first.
self last: last.
self wordwidth: 1 "only illegal form".
self ascent: ascent.
self descent: descent.
self maxwidth: 4 "width of illegal form".
strike ← strike concat: offsettable (1 to: offsettable length) "mash in bits of illegal form" "leftside".
bitmover destraster← self wordwidth.
bitmover destx← 0.
bitmover desty← 0.
bitmover width← 1.
bitmover height← self ascent + self descent.
bitmover destbase← strike.
bitmover dstrike← true.
bitmover fill: storing color: black "rightside".
bitmover destx← 3.
bitmover dstrike← true.
bitmover fill: storing color: black "top".
bitmover width← 4.
bitmover height← 1.
bitmover destx← 0.
bitmover dstrike← true.
bitmover fill: storing color: black "bottom".
bitmover desty← self ascent + self descent - 1.
bitmover dstrike← true.
bitmover fill: storing color: black.
self install: strike.
self updateseglength.
style nil
ifFalse: [style setfont: styleindex name: name fromstring: strike]].
"82" FormSet$'ACCESS'
[space | |
↑space "return textframe that is space of formset"].
"118" FormSet$'INTERNAL'
[length | |
↑self last "Return length of formset, i.e. number of forms in set" - self first + 1].
"400" FormSet$'INTERNAL'
[checkindex | |
"check formindex for legality and make into number if necessary"
(formindex is: String)
ifTrue:
[formindex length > 1
ifTrue: [user notify: 'formindex out of range for FormSet.']
ifFalse: [formindex ← formindex 1]].
(formindex < self first or: [formindex > (self last + 1)])
ifTrue: [user notify: 'formindex out of range for this FormSet.']].
"437" FormSet$'PARTS'
[wordwidth | |
↑strike word: 9 "Also know as the raster of the formset.
The width in alto words of the bits of the formset. When the display of a
form is desired, the word and bit address of the bits of the form must
be discovered. Adding the wordwidth to the word portion of that value,
produces the word address of the second line of the bits of the form, and
so on until the height of the form is spanned."].
"118" FormSet$'ACCESS'
[changeascentto: newascent | |
self deltaascent: newascent - self ascent "new ascent for FormSet"].
"868" FormSet$'INTERNAL'
[deltaascent: delta | newstrike |
"ascent delta"
self ascent + delta < 0
ifTrue: [delta ← 0 - self ascent].
delta > 0
ifTrue:
[newstrike ← String new: 2 * self wordwidth "grow" * delta.
newstrike all← 0 "fill with white".
newstrike ← strike (1 to: 18) "add oldfont header and new space together" concat: newstrike (1 to: newstrike length).
newstrike ← newstrike concat: strike (19 to: strike length "now add on rest of old font")]
ifFalse:
[ "shrink"
newstrike ← strike (1 to: 18) concat: strike (19 + (0 - (2 * self wordwidth * delta)) to: strike length)].
newstrike word: 6 ← self ascent + delta "reset ascent word in font".
self install: newstrike "newstrike now font of interest".
self updateseglength.
style nil
ifFalse:
[style maxascent < self ascent
ifTrue: [style maxascent: self ascent]]].
"122" FormSet$'PARTS'
[last | |
↑strike word: 3 "Heritage from the world of fonts" "maximum formindex (ascii) in the strike"].
"123" FormSet$'ACCESS'
[changedescentto: newdescent | |
self deltadescent: newdescent - self descent "new ascent for FormSet"].
"796" FormSet$'INTERNAL'
[deltadescent: delta | newstrike somespace |
"descent delta"
self descent + delta < 0
ifTrue: [delta ← 0 - self descent].
delta > 0
ifTrue:
[somespace ← String new: 2 * self wordwidth * delta.
somespace all← 0.
newstrike ← strike (1 to: offsettable - 1 * 2) concat: somespace]
ifFalse:
[newstrike ← strike (1 to: offsettable - 1 * 2 + (self wordwidth * delta * 2))] "copy the xtable".
newstrike ← newstrike concat: strike (offsettable * 2 - 1 to: strike length).
newstrike word: 7 ← self descent + delta "reset descent word in font".
self install: newstrike "updatedfont now font of interest".
self updatemaxwidth.
self updateseglength.
style nil
ifFalse:
[style maxdescent < self descent
ifTrue: [style maxdescent: self descent]]].
"1946" FormSet$'INTERNAL'
[deltawidthof: index by: delta | newwordwidth newoffsettable newstrike normalizedindex normalizedlast i |
"change width of form at index"
delta < 0
ifTrue:
[delta abs > self width
ifTrue: [delta ← 0 - self width]].
newwordwidth ← (self strikerightx + 15 / 16 (i ← self strikerightx + delta + 15 / 16)
ifTrue: [i]
ifFalse: [self wordwidth]).
newoffsettable ← newwordwidth * (self ascent + self descent) "height" + 9 "header" + 1 "for 0 addressing".
XeqCursor showwhile [
(newstrike ← String new: 9 + (newwordwidth * (self ascent "header" + self descent)) "bits" * 2 "grow/shrink the bits".
newstrike all← 0.
(1 to: 8) "fill in header of new font" do: [:i | newstrike word: i ← strike word: i].
newstrike word: 9 ← newwordwidth "set raster in new font" "copy the xtable".
newstrike ← newstrike concat: strike (offsettable * 2 - 1 to: strike length) "set up to copy up to old bits of form in formset".
bitmover destraster← newwordwidth.
bitmover destx← 0.
bitmover desty← 0.
bitmover sourcex← 0.
bitmover sourcey← 0.
bitmover width← self originx + self width.
bitmover height← self ascent + self descent.
bitmover sourceraster← self wordwidth.
bitmover destbase← newstrike.
bitmover sourcebase← strike.
bitmover sstrike← true.
bitmover dstrike← true.
bitmover copy: storing "now copy remainder of font".
bitmover destx← self originx + self width + delta.
bitmover width← self strikerightx - self originx - self width.
bitmover sourcex← self originx + self width.
bitmover copy: storing "shift x-vals".
normalizedindex ← formindex - self first.
normalizedlast ← self last - self first.
(normalizedindex + 1 to: normalizedlast + 2 "max") do: [:i | newstrike word: (newoffsettable + i) ← delta + (newstrike word: newoffsettable + i)].
self install: newstrike "set up the updated copy of the formset".
self updatemaxwidth.
self updateseglength)]].
"575" 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 destraster← user screenrect width + 15 / 16.
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 destbase← mem 54.
bitmover sourcebase← strike.
bitmover strike← true.
bitmover copy: effect].
"2057" FormSet$'ACCESS'
[include: t1 with: form | newoffsettable newstrike i j |
formindex ← t1.
(formindex > self first "Put a form into the formset" and: [formindex < self last])
ifTrue: [self replace: formindex with: form]
ifFalse:
[formindex < 0
ifTrue: [user notify: 'Formindex < 0 illegal for formset.']
ifFalse:
[formindex > 255
ifTrue: [user notify: 'Formindex > 255 illegal for formset.']
ifFalse:
[formindex < self first
ifTrue:
[newoffsettable ← String new: self first - formindex + self abslength * 2.
newoffsettable all← 0.
j ← self first - formindex + 1.
(j to: newoffsettable length / 2) do: [:i | newoffsettable word: i ← strike word: offsettable + (i - j)]]
ifFalse:
[newoffsettable ← String new: self abslength + formindex - self last * 2.
newoffsettable all← 0.
(0 to: self length - 1) do: [:i | newoffsettable word: (i + 1) ← strike word: offsettable + i].
(self length to: newoffsettable length / 2) do: [:i | newoffsettable word: i ← strike word: offsettable + self length].
newoffsettable word: (newoffsettable length / 2) ← strike word: offsettable + self length + 1].
newstrike ← String new: 9 + (self wordwidth "header" * (self ascent + self descent)) "bits" * 2 "new space for bits".
(1 to: 9) "fill in header of new font" do: [:i | newstrike word: i ← strike word: i].
bitmover destraster← self wordwidth.
bitmover destx← 0.
bitmover desty← 0.
bitmover sourcex← 0.
bitmover sourcey← 0.
bitmover width← self strikerightx.
bitmover height← self ascent + self descent.
bitmover sourceraster← self wordwidth.
bitmover destbase← newstrike.
bitmover sourcebase← strike.
bitmover strike← true.
bitmover copy: storing "copy the xtable".
newstrike ← newstrike concat: newoffsettable (1 to: newoffsettable length).
self install: newstrike.
formindex < self first
ifTrue: [self first: formindex]
ifFalse: [self last: formindex].
self replace: formindex with: form]]]].
"89" FormSet$'ACCESS'
[currentformindex | |
↑formindex "return index of form last touched"].
"255" FormSet$'INTERNAL'
[updateseglength | |
strike word: 5 ← 5 + (self wordwidth "compute new segment length for formset" "length, ascent, descent, kern, and raster" * (self ascent + self descent)) "bits" + (self last "max" - self first "min" + 2) "xtabl"].
"164" FormSet$'ACCESS'
[fromspace: pt to: dest | |
formindex ← image ((space charofpt: pt) "get form selected from space" min: 256).
↑self copy: formindex to: dest].
"134" FormSet$'PARTS'
[last: last | |
strike word: 3 ← last "Heritage from the world of fonts" "maximum formindex (ascii) in the strike"].
"109" FormSet$'PARTS'
[maxwidth: maxwidth | |
strike word: 4 ← maxwidth "All forms in this set to this value"].
"741" 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 sourceraster← user screenrect width + 15 / 16.
bitmover destbase← strike.
bitmover sourcebase← mem 54.
bitmover dstrike← true.
bitmover copy: storing].
"123" FormSet$'PARTS'
[first | |
↑strike word: 2 "Heritage from the world of fonts" "minimum formindex (ascii) in the strike"].
"180" FormSet$'INTERNAL'
[abslength | |
↑self last "Return absolute length of formset, i.e. number of forms in set
plus space for illegal character and its rightx" - self first + 3].
"137" FormSet$'PARTS'
[first: first | |
strike word: 2 ← first "Heritage from the world of fonts" "minimum formindex (ascii) in the strike"].
"99" FormSet$'PARTS'
[segmentlength | |
↑strike word: 5 "Amount of space allocated for form set - 4"].
"170" FormSet$'ACCESS'
[changewidthof: t1 to: width | |
formindex ← t1.
self checkindex "new width for form at index".
self deltawidthof: formindex by: width - self width].
"130" FormSet$'PARTS'
[strikerightx | |
↑strike word: offsettable + (self last "Corner x of last form in form set" - self first) + 2].
"164" FormSet$'ACCESS'
[currentformorigin | imageindex |
imageindex ← image find: formindex "return index in image of form last touched".
↑space ptofchar: imageindex].
"98" FormSet$'ACCESS'
[classInit | |
bitmover ← BitBlt init "Just initialize the bitmover for now."].
"748" FormSet$'ACCESS'
[copyrange: start to: stop from: sourceset startingat: deststart | savebackground savebits i f |
user displayoffwhile [
"copy a range of forms from one set to another"
((sourceset is: FormSet)
ifFalse:
[(sourceset is: String)
ifTrue: [sourceset ← FormSet new from: sourceset]
ifFalse: [user notify: 'Illegal sourceset -- not String or Formset.']].
savebackground ← Form new size: sourceset maxwidth by: sourceset height.
savebackground translate: 0 0.
savebackground scale: 1.
savebits ← savebackground bitsIntoString.
(start to: stop) do:
[:i | f ← sourceset copy: i to: 0 0.
self include: deststart with: f.
deststart ← deststart + 1].
savebackground bitsFromString: savebits)]].
"195" FormSet$'ACCESS'
[fromstyle: t1 styleindex: t2 | |
style ← t1.
styleindex ← t2.
self classInit "Make a formset out of string in strike format".
self install: style fonts (styleindex + 1)].
"545" FormSet$'ACCESS'
[initspaceat: t1 | i run para |
spaceorigin ← t1.
image ← String new: 256 "make a space for formset viewing".
image all← 0.
(self first to: self last + 1) do: [:i | image (i + 1) ← i].
run ← String new: 2.
run word: 1 ← 16 * styleindex + 256.
para ← Paragraph new text: image runs: run alignment: 0.
space nil
ifFalse: [space erase].
space ← Textframe new para: para frame: (Rectangle new origin: spaceorigin extent: self last - self first * self maxwidth / 8 (self ascent + self descent * 6)) style: style].
"87" FormSet$'ACCESS'
[height | |
↑self ascent "return height of fromset" + self descent].
"1282" FormSet$'ACCESS'
[makecu: name scale: scale | f i iform bits drast srast |
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.
srast ← user screenrect width + 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 sourcebase← mem 54.
bitmover sourceraster← srast.
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)]].
"73" FormSet$'ACCESS'
[spaceframe | |
↑space frame "return frame of space"].
"158" FormSet$'PARTS'
[descent: descent | |
strike word: 7 ← descent "When form set treated as characters, describes distance from bottom of
form to baseline."].
"89" FormSet$'PARTS'
[maxwidth | |
↑strike word: 4 "All forms in this set to this value"].
"141" FormSet$'ACCESS'
[spaceorigin: t1 | |
spaceorigin ← t1.
space erase "reposition the space".
space frame origin← spaceorigin.
self show].
"102" FormSet$'ACCESS'
[widthof: t1 | |
formindex ← t1.
↑self width "return width of from at formindex"].
"264" FormSet$'INTERNAL'
[install: t1 | |
strike ← t1.
"set up a new or refreshed strike"
style nil
ifFalse: [style fonts (styleindex + 1) ← strike].
offsettable ← self wordwidth * (self ascent + self descent) + 9 "header" + 1 "for 0 addressing".
↑strike].
"116" FormSet$'ACCESS'
[newspace | |
space frame← Rectangle new "let user reshape/position space" fromuser.
self show].
"89" FormSet$'ACCESS'
[show | |
space outline "show all the forms in the set".
space show].
"126" FormSet$'INTERNAL'
[originx | |
↑strike word: offsettable + formindex "Return origin x of form at formindex" - self first].
"265" FormSet$'INTERNAL'
[updatemaxwidth | newmaxwidth i |
newmaxwidth ← 0 "update max width".
(offsettable to: offsettable + (self last - self first + 1)) do: [:i | newmaxwidth ← newmaxwidth max: (strike word: i + 1) - (strike word: i)].
self maxwidth: newmaxwidth].
"152" FormSet$'PARTS'
[ascent: ascent | |
strike word: 6 ← ascent "When form set treated as characters, describes distance from top of form
to baseline."].
"113" FormSet$'PARTS'
[type: type | |
strike word: 1 ← type "**BEWARE -- outside world has ideas about this value."].
"459" FormSet$'PARTS'
[wordwidth: wordwidth | |
strike word: 9 ← wordwidth "Also know as the raster of the formset.
The width in alto words of the bits of the formset. When the display of a
form is desired, the word and bit address of the bits of the form must
be discovered. Adding the wordwidth to the word portion of that value,
produces the word address of the second line of the bits of the form, and
so on until the height of the form is spanned."].
"586" 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 destraster← user screenrect width + 15 / 16.
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 destbase← mem 54.
bitmover sourcebase← strike.
bitmover strike← true.
bitmover copy: oring.
↑self widthof: formindex].
"184" FormSet$'INTERNAL'
[width | |
↑(strike word: offsettable + (formindex - self first "Return width of form at formindex") + 1) - (strike word: offsettable + (formindex - self first))].
"551" FormSet$'ACCESS'
[asForm: t1 | f |
formindex ← t1.
self checkindex "returns the form indexed by formindex .".
f ← Form new extent: self width self height.
bitmover destraster← f width + 15 / 16.
bitmover destx← 0.
bitmover desty← 0.
bitmover sourcex← self originx.
bitmover sourcey← 0.
bitmover width← self width.
bitmover height← self ascent + self descent.
bitmover sourceraster← self wordwidth.
bitmover destbase← f bits.
bitmover sourcebase← strike.
bitmover dstrike← false.
bitmover sstrike← true.
bitmover copy: storing.
↑f].
"134" FormSet$'ACCESS'
[from: t1 | |
strike ← t1.
self classInit "Make a formset out of string in strike format".
self install: strike].
"136" FormSet$'PARTS'
[ascent | |
↑strike word: 6 "When form set treated as characters, describes distance from top of form
to baseline."].
"101" FormSet$'PARTS'
[type | |
↑strike word: 1 "**BEWARE -- outside world has ideas about this value."].
"163" FormSet$'PARTS'
[kern | |
↑strike word: 8 "When form set treated as characters, describes distance this form is
to intrude into space of preceding character."].
"97" ParsedNode$'As yet unclassified'
[printCommentOn: str | |
str append: comment.
comment ← nil].
"66" ParsedNode$'As yet unclassified'
[comment: t1 | |
comment ← t1].
"58" ParsedNode$'As yet unclassified'
[comment | |
↑comment].
"127" JuniperFileController$'MISC (internal)'
[interface | |
"...returns the JuniperInterface controlling the file."
↑directory].
"194" JuniperFileController$'FILE REDEFINITIONS (restricted)'
[allocatePage | |
"...returns a new packet (Pacbuf) to be used as the data buffer in a JuniperPageBuffer."
↑self interface newPacket].
"574" JuniperFileController$'FILE REDEFINITIONS (restricted)'
[length: pLength | tRequest |
"...sets the number of bytes in the file to the integer pLength (an Integer)."
tRequest ← self newRequestParameterBlock "1".
tRequest longInteger: 1 ← pLength "2".
self doAction: sSetLength requestPrs: tRequest "3".
lastpn ← self pageFrom: pLength "4" "
1. Create a new request parameter block.
2. Set the length parameter to pLength.
3. Issue a 'set length' command to Juniper.
4. Determine the number of the last page of the file and assign it to the superClass field lastpn.
"].
"434" JuniperFileController$'FILE REDEFINITIONS (restricted)'
[endFile: pPageBuffer | |
"...adjusts the file length, writes pPageBuffer (a JuniperPageBuffer) on the file, and returns pPageBuffer."
self length: pPageBuffer pageNumber - 1 * pPageBuffer dataLength + pPageBuffer length "1".
self writePage: pPageBuffer "2".
↑pPageBuffer "
1. Set the file length to the total number of bytes in the file.
2. Write the page on Juniper.
"].
"1234" JuniperFileController$'FILE REDEFINITIONS (restricted)'
[Read: pPageBuffer | tRequest tResult pn |
"...returns false if the page number of pPageBuffer (a JuniperPageBuffer) is greater than the page number of the last page of the file; otherwise, the data for that page is read from the Juniper file system into the packet of pPageBuffer."
(pn ← pPageBuffer pageNumber) > lastpn
ifTrue: [↑false].
"1"
(lastpn = 1 and: [self empty])
ifTrue:
[pPageBuffer length: 0 " self Get: pPageBuffer"]
ifFalse:
[tRequest ← self newRequestParameterBlock "2".
tRequest parameter: 1 ← pn - 1 "3".
tResult ← self doAction: sReadPage requestPrs: tRequest "4".
pPageBuffer page: tResult packet "5".
pPageBuffer length: (tResult parameter: 1) "6"].
↑pPageBuffer "7" "
1. Return false if the page number of pPageBuffer is greater than that of the last page of the file.
2. Create a new request parameter block.
3. Set the page number parameter to that of pPageBuffer less 1. Juniper page numbers start at 0.
4. Issue a 'read page' request.
5. Set the pPageBuffer packet to that of the result parameter block.
6. Set the length of pPageBuffer to that returned in the result parameter block.
7. Return pPageBuffer modified.
"].
"124" JuniperPageBuffer$'FILE PAGE OPERATIONS'
[pageNumber | |
"...returns the page number of the page buffer."
↑fPageNumber].
"130" JuniperPageBuffer$'FILE PAGE OPERATIONS'
[serialNumber | |
"...returns the serial number of the page buffer."
↑fSerialNumber].
"157" JuniperPageBuffer$'FILE PAGE OPERATIONS'
[serialNumber: pSerialNumber | |
"...sets the serial number of the page buffer."
fSerialNumber ← pSerialNumber].
"159" JuniperPageBuffer$'FILE PAGE OPERATIONS'
[length: pLength | |
"...sets the number of bytes in the page buffer."
fLength ← pLength.
super length: pLength].
"120" JuniperPageBuffer$'FILE PAGE OPERATIONS'
[length | |
"...returns the number of bytes in the page buffer."
↑fLength].
"291" JuniperPageBuffer$'DOCUMENTATION'
[implementationNotes | |
"
FIELDS
fLength : an Integer specifiying the number of bytes in the page buffer.
fPageNumber : an Integer specifying the number of the page buffer.
fSerialNumber : an Integer specifying the serial number of the page buffer.
"].
"147" JuniperPageBuffer$'FILE PAGE OPERATIONS'
[pageNumber: pPageNumber | |
"...sets the page number of the page buffer."
fPageNumber ← pPageNumber].
"172" JuniperFileController$'FILE REDEFINITIONS (restricted)'
[entryClass | |
"...returns the class of objects managed by JuniperFileController objects."
↑JuniperPageBuffer].
"833" JuniperFileController$'FILE REDEFINITIONS (restricted)'
[Get: pPageBuffer | tNextPageNumber tNewPageNumber i |
"...reads the data from the page whose number is that specified by pPageBuffer (a JuniperPageBuffer) if such a page exists. Otherwise pPageBuffer should contains data to be written on the file at the appropriate place."
tNewPageNumber ← pPageBuffer pageNumber.
(tNewPageNumber lastpn and: [(lastpn > 1 or: [self length > 0])])
ifTrue: [↑self Read: pPageBuffer].
tNextPageNumber ← lastpn + 1.
tNewPageNumber = tNextPageNumber
ifFalse:
[self length: tNewPageNumber - 1 * pPageBuffer dataLength.
(tNextPageNumber to: tNewPageNumber - 1) do:
[:i | pPageBuffer pageNumber: i.
pPageBuffer ← self writePage: pPageBuffer]].
pPageBuffer pageNumber: tNewPageNumber.
pPageBuffer length: 0.
↑pPageBuffer].
"155" JuniperFileController$'MISC (internal)'
[longFileHandle: pLongFileHandle | |
"...sets the file's long file handle."
fLongFileHandle ← pLongFileHandle].
"163" JuniperFileController$'FILE REDEFINITIONS (restricted)'
[close | |
"...closes the file on the Juniper file system."
self doAction: sCloseFile requestPrs: nil].
"330" JuniperFileController$'FILE REDEFINITIONS (restricted)'
[length | tResult |
"...returns the number of bytes (an Integer) in the file."
tResult ← self doAction: sReadLength requestPrs: nil "1".
↑tResult longInteger: 1 "2" "
1. Issue a 'read length' command to Juniper.
2. Return the length from the result parameter block.
"].
"263" JuniperFileController$'DOCUMENTATION'
[implementationNotes | |
"
FIELDS
fLongFileHandle : a LongInteger representing the unique identifier for the file.
fShortFileHandle : an Integer representing the identifier for the file during a particular transaction.
"].
"879" JuniperFileController$'MISC (internal)'
[doAction: pAction requestPrs: pRequest | |
"...the specified request, pAction, (selected from gJuniperConstants) with its corresponding request parameter block, pRequest ( a JuniperRequestParameter Block), is issued to the Juniper file server (through the file interface). If no errors are found, a JuniperResultParameterBlock is returned; otherwise, error handling is invoked. If no request parameters are required, pRequest can be specified as nil."
pRequest nil
ifTrue:
[pRequest ← self newRequestParameterBlock] "1".
pRequest shortFileHandle← fShortFileHandle "2".
↑self interface doAction: pAction requestPrs: pRequest "3" "
1. Create a new request parameter block if one is not specified.
2. Set the short file handle parameter.
3. Issue the request to the Juniper interface and return the result parameter block.
"].
"123" JuniperFileController$'FILE REDEFINITIONS (restricted)'
[lastFullPage | |
↑self length / self entryClass new dataLength].
"1011" JuniperFileController$'FILE REDEFINITIONS (restricted)'
[Write: pPageBuffer | tPageNumber |
"...adjusts the length of the file if pPageBuffer is the last page, sends the data buffered in pPageBuffer (a JuniperPageBuffer) to the Juniper file system, and returns pPageBuffer."
tPageNumber ← pPageBuffer pageNumber.
tPageNumber < lastpn
ifFalse:
[ "1"
tPageNumber > (lastpn + 1)
ifTrue: [↑self error: 'invalid page number'].
"2"
self length: tPageNumber - 1 * pPageBuffer dataLength + pPageBuffer length "3"].
self writePage: pPageBuffer "4".
↑pPageBuffer "5" "
1. If the page number of pPageBuffer is less than the last page number of the file, do not readjust the file length.
2. If the page number of pPageBuffer is greater than the next available page number for the file, invoke error handling.
3. If pPageBuffer is the last page of the file or will immediately follow the last page of the file, adjust the file length.
4. Send the data to Juniper.
5. Return pPageBuffer unmodified.
"].
"181" JuniperFileController$'MISC (internal)'
[newRequestParameterBlock | |
"...initializes and returns a new JuniperRequestParameterBlock."
↑self interface newRequestParameterBlock].
"668" JuniperFileController$'FILE REDEFINITIONS (restricted)'
[open | tRequest tResult |
"...opens the file on the Juniper file system."
tRequest ← self newRequestParameterBlock "1".
tRequest nextDataBlockString← fLongFileHandle "2".
tResult ← self interface doAction: sOpenFile requestPrs: tRequest "3".
fShortFileHandle ← tResult parameter: 1 "4".
self findLastPage "5" "
1. Create a new request parameter block.
2. Set the long file handle parameter.
3. Issue an 'open file' command to Juniper.
4. Set the superClass field serialNumber to the short file handle returned by Juniper in the result parameter block.
5. Set the number of the last page of the file.
"].
"225" JuniperRequestParameterBlock$'OPERATIONS'
[parameter: pIndex ← pValue | |
"...sets pValue (an Integer) in the packet at the request parameter field specified by pIndex (an Integer)."
fPacket word: (16 + pIndex) ← pValue].
"1164" JuniperRequestParameterBlock$'OPERATIONS'
[nextDataBlockString← pString | tDataBlock tString tLength tMaxLength |
"...sets pString (a String) in the data block at the current position and advances the position."
fPacket pupLength← 554 "1".
tDataBlock ← self dataBlockGet "2".
tLength ← pString length "3".
tMaxLength ← tLength + 1 land: 2 "4".
tDataBlock nextword← tLength "5".
tDataBlock nextword← tMaxLength "6".
tDataBlock append: pString "7".
tDataBlock next: (tMaxLength - tLength) ← 0 "8".
self dataBlockAdvance: 4 + tMaxLength "9" "
1. Set the length of the packet to the maximum size. The length of each string in the data block is specified in the data block itself.
2. Get the data block (as a Stream) from the current position to the end.
3. Get the length of pString.
4. Determine the length of pString including padding needed to make its length even.
5. Set the length of pString in the data block (2 bytes).
6. Set the length of pString with padding in the data block (2 bytes).
7. Set pString in the data block.
8. Add padding in the data block.
9. Advance the current data block position past length, maximum length, and pString.
"].
"216" JuniperRequestParameterBlock$'OPERATIONS'
[shortFileHandle← pShortFileHandle | |
"...sets the request short file handle field in the packet to pShortFileHandle (an Integer)."
fPacket word: 15 ← pShortFileHandle].
"568" JuniperRequestParameterBlock$'OPERATIONS'
[longInteger: pPosition ← pValue | tString tPosition |
"...sets pValue (4 bytes of long integer) in the packet at the parameter position specified by pPosition (an Integer)."
tString ← fPacket pupString.
tPosition ← pPosition + 16 * 2 - 1.
(Stream new of: tString from: tPosition to: tPosition + 3) nextNumber: 4 ← pValue.
tString swap: tPosition with: tPosition + 2.
tString swap: tPosition + 1 with: tPosition + 3 "
1. the two words of a Juniper long integers are stored in reverse order from those in Smalltalk.
"].
"169" JuniperRequestParameterBlock$'OPERATIONS'
[opcode← pOpcode | |
"...sets the request opcode field in the packet to pOpcode (an Integer)."
fPacket word: 16 ← pOpcode].
"150" JuniperParameterBlock$'OPERATIONS'
[dataBlockLength | |
"...returns the number of bytes (an Integer) in the data block."
↑fPacket pupLength - 42].
"203" JuniperParameterBlock$'OPERATIONS'
[leader: pIndex ← pValue | |
"...sets pValue (an Integer) in the packet at the leader word specified by pIndex (an Integer)."
fPacket word: (12 + pIndex) ← pValue].
"175" JuniperParameterBlock$'OPERATIONS'
[dataBlockLength← pLength | |
"...sets the number of bytes in the data block to pLength (an Integer)."
fPacket pupLength← pLength + 42].
"193" JuniperParameterBlock$'OPERATIONS'
[dataBlockAdvance: pIncrement | |
"...advances the data block position by pIncrement (an Integer)."
fDataBlockPosition ← fDataBlockPosition + pIncrement].
"263" JuniperParameterBlock$'DOCUMENTATION'
[implementationNotes | |
"
FIELDS
fPacket : a Pacbuf for sending request commands and parameters to the Juniper file server.
fDataBlockPosition : an Integer specifying the current position in the data block of fPacket.
"].
"179" JuniperParameterBlock$'OPERATIONS'
[leader: pIndex | |
"...returns the leader word (an Integer) specified by pIndex (an Integer) from the packet."
↑fPacket word: 12 + pIndex].
"124" JuniperParameterBlock$'OPERATIONS'
[pupType | |
"...returns the pup type (an Integer) of the packet."
↑fPacket pupType].
"184" JuniperParameterBlock$'OPERATIONS'
[packet← pPacket | |
"...sets the packet to pPacket (a Pacbuf) and resets the data block position."
fPacket ← pPacket.
fDataBlockPosition ← 45].
"152" JuniperParameterBlock$'OPERATIONS'
[pupType← pPupType | |
"...sets the pup type of the packet to pPupType (an Integer)."
fPacket pupType← pPupType].
"97" JuniperParameterBlock$'OPERATIONS'
[packet | |
"...returns the packet (a Pacbuf)."
↑fPacket].
"196" JuniperParameterBlock$'OPERATIONS'
[dataBlockGet | |
"...returns the current data block as a Stream."
↑Stream new of: fPacket pupString from: fDataBlockPosition to: 4 + fPacket pupLength - 2].
"909" JuniperFileController$'FILE REDEFINITIONS (restricted)'
[writePage: pPageBuffer | tRequest |
"...sends the data buffered in pPageBuffer (a JuniperPageBuffer) to the Juniper file system provided the buffer is not empty."
pPageBuffer length = 0
ifFalse:
[ "1"
tRequest ← JuniperRequestParameterBlock new "2".
tRequest packet← pPageBuffer page "3".
tRequest leader: 1 ← 0.
tRequest leader: 2 ← 0 "4".
tRequest parameter: 1 ← pPageBuffer pageNumber - 1 "5".
self doAction: sWritePage requestPrs: tRequest "6"] "
1. If there is no data in pPageBuffer do nothing.
2. Create a new request parameter block.
3. Set the packet to that of pPageBuffer. This contains the data to be written on the Juniper file.
4. Set the authentication key and reserved word to 0.
5. Set the page number parameter to that of pPageBuffer less 1. Juniper page numbers start at 0.
6. Issue a 'write page' request.
"].
"204" ParsedFieldReference$'Decompiling'
[printon: strm indent: level precedence: p forValue: v decompiler: decompiler | |
var printon: strm indent: level precedence: p forValue: true decompiler: decompiler].
"154" ParsedFieldReference$'Code generation'
[sizeForValue | |
↑2 + toLoadVar sizeForValue + toLoadFieldReference sizeForValue + toObjectOffset sizeForValue].
"336" ParsedFieldReference$'Code generation'
[emitForValue: code on: stack | |
(var isField
ifTrue: [toLoadSelf]
ifFalse: [toLoadTempframe]) emitForValue: code on: stack.
toLoadVar emitForValue: code on: stack.
toLoadFieldReference emitForValue: code on: stack.
code next← toNew.
toObjectOffset emitBytes: code.
.
stack pop: 2].
"58" ParsedFieldReference$'Code generation'
[local | |
↑var].
"63" ParsedFieldReference$'Initialization'
[var: t1 | |
var ← t1].
"90" ParsedFieldReference$'Miscellaneous'
[printon: s | |
s append: 'FLD=> '.
s print: var].
"143" ParsedFieldReference$'Decompiling'
[findMacros: macros compilerTemps: compilerTemps | |
var findMacros: macros compilerTemps: compilerTemps].
"231" ParsedFieldReference$'Code generation'
[remote: generator | |
toLoadVar ← generator literal: (var land: 127) + 1.
toLoadFieldReference ← generator literal: FieldReference.
toObjectOffset ← generator encodeSel: #object:offset:].
"160" ParsedObjectReference$'Decompiling'
[printon: strm indent: level precedence: p forValue: v decompiler: decompiler | |
strm append: (decompiler literal: var)].
"87" ParsedObjectReference$'Code generation'
[sizeForValue | |
↑(var - 256) sizeForValue].
"162" ParsedObjectReference$'Code generation'
[emitForValue: code on: stack | |
"Turn literal indirect into literal direct"
var - 256 emitForValue: code on: stack].
"59" ParsedObjectReference$'Code generation'
[local | |
↑var].
"64" ParsedObjectReference$'Initialization'
[var: t1 | |
var ← t1].
"91" ParsedObjectReference$'Miscellaneous'
[printon: s | |
s append: 'OBJ=> '.
s print: var].
"144" ParsedObjectReference$'Decompiling'
[findMacros: macros compilerTemps: compilerTemps | |
var findMacros: macros compilerTemps: compilerTemps].
"67" ParsedObjectReference$'Code generation'
[remote: generator | |
].
"105" DictionaryEntry$'Filing'
[storeOn: file | |
self subError "store self as fileSize characters on file"].
"43" DictionaryEntry$'Initialize'
[init | |
].
"85" DictionaryEntry$'Other'
[dictionary | |
↑false "what dictionary did I come from?"].
"55" DictionaryEntry$'Initialize'
[dictionary: dict | |
].
"107" DictionaryEntry$'Other'
[match: entry | |
self subError "does self (some kind of pattern) match entry?"].
"84" DictionaryEntry$'Filing'
[readFrom: file | |
self subError "inverse of storeOn:"].
"49" DictionaryEntry$'Initialize'
[name: name | |
].
"88" DictionaryEntry$'Filing'
[fileSize | |
self subError "size in characters for filing"].
"384" Document$'SYSTEM'
[fromPress: t1 | press s |
displayorder ← t1.
user displayoffwhile [
"retrieves an instance of class Document from a press file"
(self default.
press ← dp0 pressfile: displayorder.
press open.
s ← press nextControl asStream.
s next = self pressCode
ifTrue: [self fromPress: press value: s]
ifFalse:
[user notify: 'error in pressfile'])]].
"277" Heading$'EDIT'
[up | delta |
self boxcomp "move the current character up one bit.".
self currentcharacter translate: 0 0 - (0 1).
delta ← origin copy.
self translate: 0 0 - delta.
self resize.
self translate: delta.
self white.
self display: 1.
self boxcomp].
"67" Heading$'SYSTEM'
[printon: strm | t |
strm append: 'a Heading '].
"346" Heading$'EDIT'
[right | i delta |
self boxcomp "move the current character and all those to the right of it to the right one bit.".
(currentcharacter to: self length) do: [:i | self i translate: 1 0].
delta ← origin copy.
self translate: 0 0 - delta.
self resize.
self translate: delta.
self white.
self display: 1.
self boxcomp].
"604" Heading$'SYSTEM'
[presson: press in: r | hs y t i pressscale |
(hs ← press scale * self height) > r height
ifTrue: [↑self].
"not enough room left on current page.
assume for now that it will at least fit on an entire page"
self hidePress: press complete: 1.
pressscale ← press scale.
press selectfont: (press fontindex: 16 * index style: DefaultTextStyle) - 1.
(1 to: self length) do:
[:i | press setx: r leftside + ((self i) leftside * pressscale).
press sety: r bottom - ((self i) top * pressscale).
press showchar: charactercodes i].
↑r bottom - (self height * pressscale)].
"616" Heading$'INIT'
[origin: t1 index: t2 charactercodes: t3 currentcharacter: t4 | char w delta |
origin ← t1.
index ← t2.
charactercodes ← t3.
currentcharacter ← t4.
formset ← FormSet new "initilization of a Heading (used in copy)" fromstyle: DefaultTextStyle styleindex: index.
nil charactercodes
ifTrue: [charactercodes ← Set new default].
self origin: origin extent: 200 formset height.
w ← 0.
delta ← origin copy.
self translate: 0 0 - delta.
charactercodes do:
[:char | char ← formset asForm: char.
self addpath: w 0 andform: char.
w ← w + char width].
self translate: delta.
↑self].
"271" Heading$'EDIT'
[down | delta |
self boxcomp "move the current character down one bit.".
self currentcharacter translate: 0 1.
delta ← origin copy.
self translate: 0 0 - delta.
self resize.
self translate: delta.
self white.
self display: 1.
self boxcomp].
"121" Heading$'INIT'
[classInit | |
headingmenu ← Menu new "menu for the Heading edits." string: 'right
left
up
down
font
'].
"354" Heading$'EDIT'
[left | i delta |
self boxcomp "move the current character and all those to the right of it to the left one bit.".
(currentcharacter to: self length) do: [:i | self i translate: 0 0 - (1 0)].
delta ← origin copy.
self translate: 0 0 - delta.
self resize.
self translate: delta.
self white.
self display: 1.
self boxcomp].
"308" Heading$'SYSTEM'
[hideData: complete | s i |
s ← Stream new "stores an instance of class Heading on a press file" of: (String new: 100).
s nextword← self length "number of characters".
s nextPoint← origin.
s nextword← index.
(1 to: self length) do: [:i | s nextword← charactercodes i].
↑s contents].
"38" Heading$'SYSTEM'
[pressCode | |
↑2].
"260" Heading$'SYSTEM'
[copy | h i |
h ← Heading new origin: rectangle origin copy index: index charactercodes: charactercodes copy currentcharacter: currentcharacter copy.
h rectangle: rectangle copy.
(1 to: self length) do: [:i | h add: (self i) copy].
↑h].
"1260" Heading$'EDIT'
[edit: parentimage | pt t3 |
self display: 0 "Simple Heading (line) editor for now.".
[1 = 2] whileFalseDo:
[ "forever for now"
user kbck
ifTrue: [self typein]
ifFalse:
[user yellowbug
ifTrue:
[(t3 ← headingmenu bug) = 1
ifTrue: [self right]
ifFalse:
[ "move current character right one bit"
t3 = 2
ifTrue: [self left]
ifFalse:
[ "move current character left one bit"
t3 = 3
ifTrue: [self up]
ifFalse:
[ "move current character up one bit"
t3 = 4
ifTrue: [self down]
ifFalse:
[ "move current character down one bit"
t3 = 5
ifTrue: [self newfont] "change fonts"]]]]]
ifFalse:
[user redbug
ifTrue:
[(rectangle has: (pt ← user mp))
ifTrue:
[pt ← pt - rectangle origin.
currentcharacter ← self indexofsubimageat: pt.
currentcharacter
ifTrue:
[self currentcharacter displayat: self origin effect: 2 clippedBy: user screenrect.
self currentcharacter displayat: self origin effect: 2 clippedBy: user screenrect]]
ifFalse: [↑self]]
ifFalse:
[user bluebug
ifTrue: [↑self] "exit back to the parentimage"]]]]].
"812" Heading$'EDIT'
[typein | w char charcount delta i |
self white.
(1 to: position) do: [:i | self i ← nil].
position ← 0.
w ← 0.
charcount ← 0.
charactercodes ← Set new default.
delta ← origin copy.
self translate: 0 0 - delta.
[(char ← user kbd) = 13] whileFalseDo:
[char = 8
ifTrue:
[ "back space"
charcount 0
ifTrue:
[w ← w - (self charcount) width.
(self charcount) white.
self deleteimage: charcount.
charactercodes deleteI: charcount.
charcount ← charcount - 1]]
ifFalse:
[charactercodes add: char.
char ← formset asForm: char.
char displayat: delta + (w 0) effect: 0 clippedBy: user screenrect.
self addpath: w 0 andform: char.
w ← w + char width.
charcount ← charcount + 1]].
self resize.
self translate: delta.
↑self].
"324" Heading$'INIT'
[origin: t1 formset: t2 currentcharacter: t3 | |
origin ← t1.
formset ← t2.
currentcharacter ← t3.
"initilization of a Heading (used in copy)"
(formset is: Integer)
ifTrue:
[formset ← FormSet new fromstyle: DefaultTextStyle styleindex: formset].
self origin: origin extent: 200 formset height].
"411" Heading$'SYSTEM'
[fromPress: press value: s | numberofcharacters i |
numberofcharacters ← s nextword "retrieves and builds an instance of class Heading from a press file".
origin ← s nextPoint.
index ← s nextword.
charactercodes ← Set new default.
(1 to: numberofcharacters) do: [:i | charactercodes add: s nextword].
↑self origin: origin index: index charactercodes: charactercodes currentcharacter: 1].
"637" Heading$'EDIT'
[newfont | w char charcount delta i |
index ← (user request: 'index of new font . . ') asInteger.
formset ← FormSet new fromstyle: DefaultTextStyle styleindex: index.
self white.
(1 to: position) do: [:i | self i ← nil].
position ← 0.
w ← 0.
charcount ← 0.
delta ← origin copy.
self translate: 0 0 - delta.
charactercodes do:
[:char | nil char
ifFalse:
[char ← formset asForm: char.
char displayat: delta + (w 0) effect: 0 clippedBy: user screenrect.
self addpath: w 0 andform: char.
w ← w + char width.
charcount ← charcount + 1]].
self resize.
self translate: delta.
↑self].
"769" Document$'SYSTEM'
[fromPress: press value: s | numberofsubimages t t1 i code |
numberofsubimages ← s nextword "builds an instance of class Document from a press file".
origin ← s nextPoint.
t ← s nextPoint.
t1 ← s nextPoint.
rectangle ← t rect: t1.
xgrid ← s nextword.
ygrid ← s nextword.
displayorder ← s nextString.
(1 to: numberofsubimages) do:
[:i | s ← press nextControl asStream.
code ← s next.
t ← (code = 1
ifTrue: [Image new]
ifFalse:
[code = 2
ifTrue: [Heading new]
ifFalse:
[code = 3
ifTrue: [BitImage new]
ifFalse: [false]]]).
(t and: [code = t pressCode])
ifTrue: [self addimage: (t fromPress: press value: s)]
ifFalse: [user notify: 'illegal code or code mismatch']].
↑self].
"154" Document$'EDITING'
[delete: image | i |
i ← self find: image "delete image from the document and leave its space. ".
i
ifTrue:
[self deleteI: i]].
"156" Document$'INIT'
[name: t1 | |
displayorder ← t1 "sets the name of the document ( displayorder is currently used for name... note that name is a string."].
"69" Document$'SYSTEM'
[printon: strm | t |
strm append: 'a Document '].
"54" Document$'INIT'
[classInit | |
micasperinch ← 2540].
"358" Document$'SYSTEM'
[hideData: complete | s |
s ← Stream new "stores an instance of class Document from a press file" of: (String new: 100).
s nextword← self length "number of subimages".
s nextPoint← origin.
s nextPoint← rectangle origin.
s nextPoint← rectangle corner.
s nextword← xgrid.
s nextword← ygrid.
s nextString← displayorder.
↑s contents].
"39" Document$'SYSTEM'
[pressCode | |
↑0].
"418" DocumentEditor$'FRAMING'
[show | |
XeqCursor show.
self outline.
growing
ifFalse:
[titleframe put: (Paragraph new text: self title runs: titlerun alignment: 0) at: frame origin + titleloc.
titleframe window outline.
titleframe show.
screenimage white.
screenimage displayat: 0 0 effect: 1 clippedBy: self frame.
selection
ifTrue: [selection boxcomp]
ifFalse:
[.
NormalCursor show]]].
"131" DocumentEditor$'EDITING'
[editTitle | |
titlepara ← document name asParagraph.
super editTitle.
document name: titlepara text].
"171" DocumentEditor$'EDITING'
[deselect | t |
selection
ifTrue:
[selection translate: 0 0 - screenimage origin.
selection do: [:t | t translate: selection origin]]].
"512" DocumentEditor$'EDITING'
[place | pt tempimage t |
"add the image in the scrap to the screenimage."
selection
ifTrue: [selection highlite].
self deselect.
selection ← scrap copy.
OriginCursor showwhile [
(user waitbug.
[user nobug] whileFalseDo:
[pt ← screenimage mp + screenimage rectangle origin.
selection translateto: pt.
selection blink])].
selection displayat: 0 0 effect: 1 clippedBy: self frame.
self deselect.
selection do:
[:t | screenimage add: t].
selection ← false].
"551" DocumentEditor$'EDITING'
[move | pt t |
selection
ifTrue:
[ "used to place subimages (paragraphs) in the Image."
user waitnobug.
OriginCursor show.
user waitbug.
selection highlite.
selection displayat: 0 0 effect: 3 clippedBy: frame.
[user redbug] whileTrueDo:
[pt ← screenimage mp + screenimage rectangle origin.
selection translateto: pt.
selection blink].
XeqCursor show.
selection displayat: 0 0 effect: 1 clippedBy: frame.
self deselect.
selection ← false.
NormalCursor show]
ifFalse: [frame flash]].
"223" DocumentEditor$'EDITING'
[copyselection | |
selection
ifTrue:
[ "copy the selection and put it in scrap"
XeqCursor show.
self closeScrap.
scrap ← selection copy.
NormalCursor show]
ifFalse: [frame flash]].
"1254" DocumentEditor$'EDITING'
[jump | y deltay yprime deltayprime rect pt newY scal r |
user waitnobug.
XeqCursor show.
self update.
y ← document height.
yprime ← frame height.
deltay ← documentwindow origin y - document origin y.
scal ← yprime asFloat / y.
deltayprime ← (scal * deltay) asInteger.
pt ← screenimage leftside + (1.0 - scal * frame width / 2) (screenimage top + deltayprime).
document quickDisplayAt: 0 0 scale: scal offset: frame minX + (1.0 - scal * frame width / 2) frame minY.
rect ← 0 0 rect: 1 1.
rect origin← pt.
rect corner x← pt x + (scal * frame width) asInteger.
rect corner y← pt y + (scal * frame height) asInteger.
user cursorloc← pt.
OriginCursor show.
user waitbug.
user redbug
ifTrue:
[rect comp.
[user redbug] whileTrueDo:
[r ← rect copy.
newY ← user mp y.
newY < (frame minY - rect height)
ifTrue: [newY ← frame minY - rect height].
newY > frame maxY
ifTrue: [newY ← frame maxY].
rect translateto: pt x newY.
r comp.
rect comp].
rect comp.
XeqCursor show.
deltayprime ← newY - frame origin y.
deltay ← y * deltayprime / yprime.
documentwindow translateto: 0 deltay.
selection ← false].
self buildscreenimage.
self show.
NormalCursor show].
"898" DocumentEditor$'DEFAULT EVENT RESPONSES'
[yellowbug | pt t2 |
(t2 ← documentmenu bug) = 1
ifTrue: [self move]
ifFalse:
[t2 = 2
ifTrue: [self delete]
ifFalse:
[t2 = 3
ifTrue: [self place]
ifFalse:
[t2 = 4
ifTrue: [self cut]
ifFalse:
[t2 = 5
ifTrue: [self paste]
ifFalse:
[t2 = 6
ifTrue: [self copyselection]
ifFalse:
[t2 = 7
ifTrue: [self top]
ifFalse:
[t2 = 8
ifTrue: [self bottom]
ifFalse:
[t2 = 9
ifTrue: [self jump]
ifFalse:
[t2 = 10
ifTrue: [self addspace]
ifFalse:
[t2 = 11
ifTrue: [self deletespace]
ifFalse:
[t2 = 12
ifTrue:
[self deselect.
selection ← false.
self show]]]]]]]]]]]]].
"54" DocumentEditor$'FRAMING'
[title | |
↑document name].
"406" DocumentEditor$'EDITING'
[addspace | image i k r delta |
self update "add whitespace to the document .".
selection ← false.
r ← document rectanglefromuser.
i ← document indexofsubimagebelow: r top - screenimage top + documentwindow top.
i
ifTrue:
[delta ← r height.
(i to: document length) do: [:k | document k translate: 0 delta].
document resize].
self buildscreenimage.
self show].
"386" DocumentEditor$'INIT'
[init: t1 | i |
document ← t1.
self fixedwidthfromuser: document width "This is the paragraph (subimage) level document editor.".
documentwindow ← Rectangle new origin: document rectangle origin extent: document width self frame height.
self buildscreenimage.
selection ← false.
user topWindow leave.
self takeCursor.
self enter.
user restartup: self].
"98" DocumentEditor$'EDITING'
[copy | |
self copyselection "copy the selection and put it in scrap"].
"383" DocumentEditor$'EDITING'
[update | i |
XeqCursor topage1 "update the document to reflect any changes in the subimages .".
selection
ifTrue: [self deselect].
document deleteI: firstindex to: lastindex "update document".
(1 to: screenimage length) do:
[:i | document insert: (screenimage i translate: 0 documentwindow origin y)].
document resize.
NormalCursor topage1].
"148" DocumentEditor$'DEFAULT EVENT RESPONSES'
[hardcopy | |
self leave "write a press file and hardcopy this document".
self top.
document hardcopy].
"121" DocumentEditor$'DEFAULT EVENT RESPONSES'
[print | |
document hardcopy "write a press file and hardcopy this document"].
"468" DocumentEditor$'DEFAULT EVENT RESPONSES'
[kbd | c x y |
c ← user kbd.
c = 120
ifTrue:
[user clearshow: 'x gridding is '.
document xgrid print.
user cr.
document xgrid: (x ← (user request: 'x gridding . . . ') asInteger).
screenimage xgrid: x]
ifFalse:
[c = 121
ifTrue:
[user clearshow: 'y gridding is '.
document ygrid print.
user cr.
document ygrid: (y ← (user request: 'y gridding . . . ') asInteger).
screenimage ygrid: y]]].
"939" DocumentEditor$'DEFAULT EVENT RESPONSES'
[redbug | pt rect newrect start t |
pt ← user mp.
start ← pt.
rect ← newrect ← Rectangle new origin: start corner: start.
selection
ifTrue:
[selection highlite.
self deselect.
selection ← false].
[user anybug] whileTrueDo:
[rect ← newrect.
rect comp.
t ← user mp.
newrect ← Rectangle new origin: (start min: t) corner: (start max: t).
rect comp].
rect width < 10
ifTrue:
[selection ← screenimage smallestsubimageat: pt - screenimage origin.
selection
ifTrue:
[selection translate: screenimage origin.
selection edit: screenimage.
selection translate: 0 0 - screenimage origin.
selection ← false]]
ifFalse:
[rect origin← screenimage griddedpoint: rect origin.
selection ← screenimage subimageswithin: (rect translate: 0 0 - screenimage origin).
selection
ifTrue:
[selection translate: screenimage origin.
selection highlite]]].
"831" DocumentEditor$'INIT'
[buildscreenimage | i r delta |
screenimage ← Image new "This function copies the subimages intersecting the document window
into the screen image." origin: self frame origin extent: self frame extent.
screenimage xgrid: document xgrid.
screenimage ygrid: document ygrid.
delta ← documentwindow origin y.
firstindex ← 1 " find the index of the first subimage that intersects the document window.".
[firstindex document length or: [(document firstindex) rectangle bottom > documentwindow top]] whileFalseDo: [firstindex ← firstindex + 1].
lastindex ← firstindex.
(firstindex to: document length) do:
[:i | (document i) rectangle top < documentwindow bottom
ifTrue:
[lastindex ← i.
screenimage add: (document i translate: 0 0 "copy" - (0 delta))]
ifFalse: [↑lastindex]]].
"79" DocumentEditor$'INIT'
[defaultdocument | |
self defaultdocument: 'document'].
"1011" DocumentEditor$'INIT'
[defaultdocument: name | defaultdocument run r textimage f im dot heading head text char b image row |
defaultdocument ← Document new " name is a string" origin: 0 0 extent: user screenrect extent.
defaultdocument name: name.
defaultdocument xgrid: DefaultTextStyle tab.
defaultdocument ygrid: DefaultTextStyle lineheight.
textimage ← BorderedText new.
textimage text: 'Text that is bordered' width: 200.
defaultdocument addform: textimage andpath: 0 0.
textimage ← TextImage new.
textimage text: 'This is a paragraph' width: 600.
defaultdocument addform: textimage andpath: 0 0.
b ← BitImage new fromrectangle: (Rectangle new origin: 0 200 extent: 100 100).
defaultdocument insert: b.
head ← Set new default.
text ← 'HEADING'.
text do: [:char | head add: char].
heading ← Heading new origin: 0 400 index: 9 charactercodes: head currentcharacter: 0.
defaultdocument insert: heading "defaultdocument insert: CurveIdiom new init.".
self init: defaultdocument].
"190" DocumentEditor$'DEFAULT EVENT RESPONSES'
[leave | |
document nil
ifFalse:
[selection
ifTrue: [selection highlite].
self update.
self buildscreenimage.
selection ← false]].
"371" DocumentEditor$'EDITING'
[cut | t |
selection
ifTrue:
[ "delete subimage (paragraph) from the screenimage and save it in the scrap"
XeqCursor show.
self closeScrap.
scrap ← selection.
self update.
selection do:
[:t | document bubbledelete: t].
selection ← false.
self buildscreenimage.
self show.
NormalCursor show]
ifFalse: [frame flash]].
"132" DocumentEditor$'FRAMING'
[newframe | |
self update.
self fixedwidthfromuser: document width.
self buildscreenimage.
self show].
"85" DocumentEditor$'DEFAULT EVENT RESPONSES'
[enter | |
selection ← false.
self show].
"510" DocumentEditor$'INIT'
[classInit | |
" DocumentEditor classInit. "
documentmenu ← Menu new string: 'move
erase
place
cut
paste
copy
top
bottom
jump
addspace
deletespace
show
'.
jumpcursor ← Cursor new fromtext: '
1111111111111111
1111111111111111
0000000000000000
0000000000000000
0000000000000000
0000000000000000
0000001110000000
0000011111000000
0000011111000000
0000001110000000
0000000000000000
0000000000000000
0000000000000000
0000000000000000
1111111111111111
1111111111111111' offset: 2 1].
"593" DocumentEditor$'EDITING'
[paste | pt t |
"add the subimage (paragraph) in the scrap to the screenimage."
selection
ifTrue: [selection highlite].
self update.
selection ← scrap copy.
OriginCursor showwhile [
(user waitbug.
[user nobug] whileFalseDo:
[pt ← screenimage mp + screenimage rectangle origin.
selection translateto: pt.
selection blink].
selection displayat: 0 0 effect: 1 clippedBy: self frame)].
self deselect.
selection do:
[:t | document bubbleinsert: (t translate: documentwindow origin)].
selection ← false.
self buildscreenimage.
self show].
"154" DocumentEditor$'DEFAULT EVENT RESPONSES'
[close | |
XeqCursor show.
document close.
document ← nil.
screenimage ← Vector new: 0.
NormalCursor show].
"420" DocumentEditor$'EDITING'
[deletespace | image i k r delta |
self update "delete whitespace from the document .".
selection ← false.
r ← document rectanglefromuser.
i ← document indexofsubimagebelow: r top - screenimage top + documentwindow top.
i
ifTrue:
[delta ← r height.
(i to: document length) do: [:k | document k translate: 0 (0 - delta)].
document resize].
self buildscreenimage.
self show].
"361" DocumentEditor$'EDITING'
[delete | t |
selection
ifTrue:
[ "delete subimage (paragraph) from the screenimage and save it in the scrap"
XeqCursor show.
self closeScrap.
scrap ← selection.
selection highlite.
selection display: 3.
selection do: [:t | screenimage delete: t].
selection ← false.
NormalCursor show]
ifFalse: [frame flash]].
"726" DocumentEditor$'EDITING'
[bottom | i delta |
selection
ifTrue:
[ "translate the current selection to the bottom of the window and update the document to reflect any changes in the subimages which are scrolled out of the screenimage."
delta ← selection rectangle corner - screenimage rectangle corner.
self update.
selection ← false.
documentwindow translate: 0 delta y "move window on document".
self buildscreenimage.
self show "reconstruct screen image, including reestablishing first and last indices"]
ifFalse:
[self update.
documentwindow ← Rectangle new origin: document rectangle corner - self frame height extent: document width self frame height.
self buildscreenimage.
self show]].
"700" DocumentEditor$'EDITING'
[top | i delta |
selection
ifTrue:
[ "translate the current selection to the top of the window and update the document to reflect any changes in the subimages which are scrolled out of the screenimage."
delta ← selection rectangle origin - screenimage rectangle origin.
self update.
selection ← false.
documentwindow translate: 0 delta y "move window on document".
self buildscreenimage.
self show "reconstruct screen image, including reestablishing first and last indices"]
ifFalse:
[self update.
documentwindow ← Rectangle new origin: document rectangle origin extent: document width self frame height.
self buildscreenimage.
self show]].
"82" DocumentEditor$'EDITING'
[closeScrap | |
scrap nil
ifFalse: [scrap close]].
"107" Document$'EDITING'
[edit | |
DocumentEditor new "Documents are edited with a DocumentEditor" init: self].
"276" Document$'EDITING'
[resize | delta t |
"make sure the document does not have subimages that have negative y values and resize the document"
position 1
ifTrue:
[(delta ← (self 1) top) 0
ifTrue: [self do: [:t | t translate: 0 (0 - delta)]]].
super resize].
"151" Document$'INIT'
[name | |
↑displayorder "returns the name of the document ( displayorder is currently used for name... note that name is a string."].
"297" Document$'SYSTEM'
[copy | im i |
im ← Document new origin: origin copy rectangle: rectangle copy path: path copy form: form copy figure: figure copy ground: ground copy xgrid: xgrid copy ygrid: ygrid copy.
(1 to: self length) do: [:i | im add: (self i) copy].
im name: self name copy.
↑im].
"304" Document$'EDITING'
[bubbledelete: image | delta i k |
i ← self find: image "delete image from the document and subtracting images extent y from all subimages below it.".
i
ifTrue:
[self deleteI: i.
delta ← image extent y.
(i to: self length) do: [:k | self k translate: 0 (0 - delta)]]].
"164" Document$'EDITING'
[insert: image | i |
i ← self findindex: image "insert image into the document keeping the document y-sorted.".
self insertI: i value: image].
"603" Document$'EDITING'
[findindex: image | y guess top bottom |
position = 0 "binary search on the origins of the rectangles surrounding my subimages
returns the index of the subimage just below image."
ifTrue: [↑1].
top ← 1.
bottom ← position.
y ← image rectangle origin y.
y (self 1) rectangle origin y
ifTrue: [↑1].
.
y (self position) rectangle origin y
ifTrue: [↑position + 1].
guess ← position / 2.
[bottom = (top + 1)] whileFalseDo:
[(self guess) rectangle origin y y
ifTrue: [bottom ← guess]
ifFalse: [top ← guess].
guess ← bottom + top / 2].
↑bottom].
"1356" Document$'SYSTEM'
[hardcopy | p i press bottoms rect pressscale pageheight pagewidth lastrect currentrect oldytop oldybottom |
oldytop ← 11 * micasperinch.
pageheight ← 11 * micasperinch.
pagewidth ← 8 * micasperinch.
user displayoffwhile [
(press ← dp0 pressfile: displayorder + '.doc'.
pressscale ← press scale.
self hidePress: press complete: 1.
p ← PressPrinter init.
p press: press.
p frame← 1 * micasperinch "in micas" (1 * micasperinch) rect: pagewidth - micasperinch (pageheight - micasperinch).
lastrect ← (self 1) rectangle * pressscale.
rect ← lastrect leftside (1 * micasperinch) rect: lastrect rightside (pageheight - lastrect top).
oldybottom ← p print: self 1 in: rect.
(2 to: self length) do:
[:i | oldybottom > oldytop
ifTrue:
[oldytop ← pageheight - micasperinch "page break"].
currentrect ← (self i) rectangle * pressscale.
currentrect top > lastrect bottom
ifTrue: [oldytop ← oldybottom + (lastrect bottom - currentrect top) "no overlap"]
ifFalse: [oldytop ← oldytop + (lastrect top - currentrect top) "overlap"].
rect ← currentrect leftside (1 * micasperinch) rect: currentrect rightside oldytop.
oldybottom ← p print: self i in: rect.
lastrect ← (self i) rectangle * pressscale].
press close.
press toPrinter "send over ethernet to printer")]].
"323" Document$'EDITING'
[bubbleinsert: image | delta i k |
i ← self findindex: image "insert image into the document keeping the document y-sorted and adding images extent y to all subimages below it.".
self insertI: i value: image.
delta ← image extent y.
(i + 1 to: self length) do: [:k | self k translate: 0 delta]].
"146" JuniperResultParameterBlock$'OPERATIONS'
[resultCode | |
"...returns the result code (an Integer) from the result packet."
↑fPacket word: 15].
"501" JuniperResultParameterBlock$'OPERATIONS'
[longInteger: pPosition | tArray tPosition |
"...returns the 4 bytes of long integer in the packet at the parameter position specified by pPosition (an Integer)."
tPosition ← pPosition + 15 * 2 - 1.
tArray ← (Stream new of: fPacket pupString from: tPosition to: tPosition + 3) next: 4.
tArray swap: 1 with: 3.
tArray swap: 2 with: 4 "1".
↑tArray asStream nextNumber: 4 "
1. Juniper long integers are stored in reverse order from those in Smalltalk.
"].
"735" JuniperResultParameterBlock$'OPERATIONS'
[nextDataBlockString | tDataBlock tString tLength tMaxLength |
"...returns the string in the data block at the current position and advances the position."
tDataBlock ← self dataBlockGet "1".
tLength ← tDataBlock nextword "2".
tMaxLength ← tDataBlock nextword "3".
tString ← tDataBlock next: tLength "4".
self dataBlockAdvance: 4 + tMaxLength "5".
↑tString "6" "
1. Get the data block (as a Stream) from the current position to the end.
2. Get the length of the next string.
3. Get the length of the string including possible padding.
4. Get the next string from the data block.
5. Position the data block past the length, maximum length, string, and padding.
6. Return the string.
"].
"193" JuniperResultParameterBlock$'OPERATIONS'
[parameter: pIndex | |
"...returns from the packet the result parameter (an Integer) specified by pIndex (an Integer)."
↑fPacket word: 15 + pIndex].
"165" MessageTally$'Public Tallying'
[on remote | val |
"Spy on the specified evaluation"
self from: remote.
timer reset.
val ← remote eval.
timer disable.
↑val].
"169" MessageTally$'Private Reporting'
[leaves: ldict | b mt |
b ← self breakdown.
b length = 0
ifTrue: [self into: ldict]
ifFalse: [b do: [:mt | mt leaves: ldict]]].
"89" MessageTally$'Public Reporting'
[report: filename | |
self report: filename cutoff: 2].
"64" MessageTally$'Private Reporting'
[> mt | |
↑tally < mt tally].
"64" MessageTally$'Private Reporting'
[< mt | |
↑tally > mt tally].
"66" MessageTally$'Private Reporting'
[= mt | |
↑mt method method].
"134" MessageTally$'Public Reporting'
[printon: s | |
class nil
ifTrue: [super printon: s]
ifFalse: [self printon: s total: 100]].
"298" MessageTally$'Private Tallying'
[tallyPath: context | m path mt c |
m ← context method.
path ← false.
rcvrs do:
[:mt | mt method m
ifTrue: [path ← mt]].
path false
ifTrue:
[path ← MessageTally new class: context receiver class method: m.
rcvrs ← {rcvrs , path}].
↑path bump].
"338" MessageTally$'Private Reporting'
[printon: s total: total | i v |
v ← (0.0 + tally / total * 1000.0 + 0.5) asInteger asString.
i ← v length.
s append: ' ' (i to: 2).
s append: v (1 to: i - 1).
s append: '.'.
s next← v i.
s space.
rcvrs nil
ifTrue: [s append: 'primitives']
ifFalse: [class describe: method on: s]].
"219" MessageTally$'Public Reporting'
[report: filename cutoff: pct | f |
"pct=(leaves,roots,tree) or one number for all"
f ← dp0 file: filename.
f append: filename.
f space.
self fullprinton: f cutoff: pct.
f close].
"277" MessageTally$'Private Reporting'
[breakdown | n b mt t4 |
b ← rcvrs.
(b nil or: [b length = 0])
ifTrue: [↑#()].
n ← tally.
b do: [:mt | n ← n - mt tally].
n > 0
ifTrue: [b ← {b , ((t4 ← MessageTally new) class: class method: method.
t4 primitives: n)}].
↑b].
"81" MessageTally$'Private Reporting'
[primitives: t1 | |
tally ← t1.
rcvrs ← nil].
"53" MessageTally$'Private Common'
[method | |
↑method].
"60" MessageTally$'Private Reporting'
[hash | |
↑method asOop].
"120" MessageTally$'Private Common'
[class: t1 method: t2 | |
class ← t1.
method ← t2.
tally ← 0.
rcvrs ← Vector new: 0].
"345" MessageTally$'As yet unclassified'
[for: number every: sixtieths onClass: newClass andMethod: newMethod | |
self abort.
timer ← Timer new for: sixtieths action [
((number ← number - 1) 0
ifTrue: [timer disable]
ifFalse:
[self tally: Top 1.
timer reset])].
self class: newClass method: newMethod.
timer reset].
"280" MessageTally$'Public Tallying'
[tally: context | root |
"Explicitly tally the specified context and its stack"
context method method
ifTrue: [↑self bump].
(root ← context sender) nil
ifTrue: [↑self bump tallyPath: context].
↑(self tally: root) tallyPath: context].
"206" MessageTally$'Private Reporting'
[into: set | mt i |
(i ← set find: self)
ifTrue: [mt ← set objects i]
ifFalse: [set insert: (mt ← MessageTally new class: class method: method)].
mt bump: tally].
"90" MessageTally$'Public Tallying'
[abort | |
(timer is: Timer)
ifTrue: [timer disable]].
"63" MessageTally$'Private Tallying'
[bump | |
tally ← tally + 1].
"212" MessageTally$'Public Tallying'
[every: sixtieths | |
"Create a spy that samples with the specified period"
self abort.
timer ← Timer new for: sixtieths action [
(self tally: Top 1.
timer reset)]].
"156" MessageTally$'Public Tallying'
[from: context | |
"Create a tallier from the specified root"
self class: context receiver class method: context method].
"93" MessageTally$'Public Tallying'
[reset | |
tally ← 0 "reset stats".
rcvrs ← Vector new: 0].
"105" MessageTally$'Public Tallying'
[classInit | |
Smalltalk define: #spy as: (MessageTally new every: 10)].
"224" MessageTally$'Private Reporting'
[cumprinton: s from: set total: total over: threshold | mt |
set contents sort do:
[:mt | mt tally > threshold
ifTrue:
[mt printon: s total: total.
s cr]
ifFalse: [↑self]]].
"102" MessageTally$'Public Tallying'
[close | |
"release storage"
class ← method ← tally ← rcvrs ← nil].
"338" MessageTally$'Private Reporting'
[treeprinton: s tab: tab total: total over: threshold | i mt |
tally threshold
ifFalse:
[tab > 0
ifTrue:
[(1 to: tab - 1) do: [:i | s append: ' |'].
self printon: s total: total.
s cr].
self breakdown sort do: [:mt | mt treeprinton: s tab: tab + 1 total: total over: threshold]]].
"735" MessageTally$'Public Reporting'
[fullprinton: s cutoff: pct | set mt i t |
user displayoffwhile [
(s print: tally.
s append: ' tallies'.
s cr.
tally = 0
ifFalse:
[s cr.
s cr.
(pct is: Vector)
ifFalse: [pct ← {pct , pct}].
pct 1 < 100
ifTrue:
[s append: '**Leaves**'.
s cr.
t ← (pct 1 * (tally - 1) / 100) asInteger.
set ← HashSet new init: 128.
self leaves: set.
self cumprinton: s from: set total: tally over: t.
s next← 12.
s cr.
set ← nil].
pct 2 < 100
ifTrue:
[s append: '**Tree**'.
s cr.
t ← (pct 2 * (tally - 1) / 100) asInteger.
self treeprinton: s tab: 0 total: tally over: t.
s next← 12.
s cr].
s skip: 2])]].
"305" MessageTally$'Public Tallying'
[moreon remote | val |
"Spy on the specified evaluation without resetting"
class ← remote receiver "use as follows:
eachtime
[spy every: 10.
spy moreon [super eachtime].
]" class.
method ← remote method.
timer reset.
val ← remote eval.
timer disable.
↑val].
"54" MessageTally$'Private Reporting'
[tally | |
↑tally].
"67" MessageTally$'Private Reporting'
[bump: n | |
tally ← tally + n].
"1202" FontWindow$'Scheduler'
[eachtime | t1 |
"while active"
(clearframe has: user mp)
ifTrue:
[user redbug
ifTrue: [self setbit: user mp color: black]
ifFalse:
[ "make dot black"
user yellowbug
ifTrue: [self setbit: user mp color: white]
ifFalse:
[ "make dot white"
user bluebug
ifTrue:
[(t1 ← fontmenu bug) = 1
ifTrue: [self strike]
ifFalse:
[ "put strike of font in dialogue window"
t1 = 2
ifTrue: [self setwidth]
ifFalse:
[ "grow character"
t1 = 3
ifTrue:
[self updateseglength: font raster: fontraster.
self updatemaxwidth "clean things up".
user notify: 'font debugging']
ifFalse:
[t1 = 4
ifTrue: [self frame]
ifFalse:
[ "move fontwindow"
t1 = 5
ifTrue:
[clearframe clear.
self updateseglength: font raster: fontraster.
self updatemaxwidth "clean things up".
user unschedule: self.
↑false]]]]]]
ifFalse:
[user kbck
ifTrue:
[char ← user kbd.
self setchar: char]]]]]
ifFalse:
[user anybug
ifTrue: [↑false]]].
"55" FontWindow$'Scheduler'
[lasttime | |
"upon exit"
].
"320" FontWindow$'Editing'
[setfont: t1 | |
font ← t1.
altostyle fonts fontnumber ← font.
fontraster ← font word: 9.
fontht ← (font word: 6) + (font word: 7) "ascent + descent".
fontxtabl ← fontraster * fontht + 9 "header" + 1 "for 0 addressing".
bitsetter width← 1.
bitsetter height← 1.
self setchar: charstr 1].
"585" FontWindow$'Editing'
[setchar: t1 | |
char ← t1.
charstr 1 ← char.
char ← (font word: 3) - (font word: 2) + 1 "char out of range".
(font word: 2) char
ifTrue:
[char (font word: 3)
ifTrue: [char ← char - (font word: 2)]].
charx ← font word: fontxtabl + char.
charwid ← (font word: fontxtabl + char + 1) - charx.
clearframe clear.
frame extent← charwid fontht.
clearframe ← frame inset: 2 2 "for clearing everything including outline" and: [charwid - (charwid * scale + 2) (fontht - (fontht * scale + 2))].
self show "FontWindow regenerate: setchar:"].
"535" FontWindow$'Editing'
[setwidth | newextentx outlineframe |
outlineframe ← clearframe inset: 1 1 "get new size" and: [0 1].
OriginCursor showwhile [
(user waitbug
ifTrue:
[[user anybug] whileTrueDo:
[outlineframe growto: clearframe origin x + 2 + (newextentx ← user mp x - clearframe origin x + 2 | scale) outlineframe corner y.
outlineframe border: 2 color: black.
outlineframe border: 2 color: background]]
ifFalse:
[])].
outlineframe border: 2 color: black.
self setwidth: newextentx / scale].
"188" FontWindow$'Strike format'
[cufixup | |
"Carnegie-Mellon fixup for scale compatibility"
boxer extent← scale - 1 (scale - 1).
frame extent← scale 0.
clearframe extent← scale 0].
"348" FontWindow$'Image'
[show | tempframe showrun showpara |
"refresh window"
showrun ← String new: 2.
showrun word: 1 ← 16 * (fontnumber - 1) + 256.
showpara ← Paragraph new text: charstr runs: showrun alignment: 0.
tempframe ← Textframe new para: showpara frame: frame style: altostyle.
tempframe show.
frame blowup: frame origin by: scale].
"155" FontWindow$'Image'
[frame | |
clearframe clear.
frame moveto: (OriginCursor showwhile [
(user waitbug
ifTrue: [user mp])]).
self setchar: char].
"1154" FontWindow$'Strike format'
[newfont: t1 maxcharwidth: maxcharwidth min: min max: max ascent: ascent kern: kern | raster i x |
fontht ← t1.
XeqCursor showwhile [
(raster ← 2 + max - min * maxcharwidth + 15 / 16.
font ← String new: 3 + max - min + (fontht * raster) + 9 * 2.
font word: 1 ← 32768 "format: strike, simple, varwidth".
font word: 2 ← min "min ascii code".
font word: 3 ← max "max ascii code".
font word: 4 ← maxcharwidth "max char width".
font word: 5 ← 2 + max - min + 5 + (fontht * raster) "segment length".
font word: 6 ← ascent "bits above baseline".
font word: 7 ← fontht - ascent "bits below baseline".
font word: 8 ← kern "kerning offset".
font word: 9 ← raster "#words per scan-line in bitmap".
font (18 + 1 to: 2 * raster * fontht + 18) all← 0 "chars all white".
ascent ← ascent min: fontht - 1 "keep baseline within char".
font (2 * raster * ascent + 18 + 1 to: ascent + 1 * raster * 2 + 18) all← 255 "put in a black baseline".
x ← 0.
(raster * fontht + 9 + 1 to: raster * fontht + 9 + 3 + max - min by: 1) do:
[:i | font word: i ← x.
x ← x + maxcharwidth "table of left x"])].
↑font].
"191" FontWindow$'Strike format'
[strike | i showstr |
"Put a strike of font into dialogue window"
showstr ← String new: 128.
(1 to: 128) do: [:i | showstr i ← i].
user clearshow: showstr].
"110" FontWindow$'Initialization'
[classInit | |
fontmenu ← Menu new string: 'strike
set width
debug
move
close'].
"280" FontWindow$'Strike format'
[updatemaxwidth | newmaxwidth i |
newmaxwidth ← 0 "update max width".
(fontxtabl to: fontxtabl + ((font word: 3) - (font word: 2) + 1) by: 1) do: [:i | newmaxwidth ← newmaxwidth max: (font word: i + 1) - (font word: i)].
font word: 4 ← newmaxwidth].
"1124" 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 lock.
bitmover destraster← bitwidth * scale + 15 / 16.
bitmover destx← 0.
bitmover desty← 0.
bitmover sourcebase← mem 54.
bitmover sourceraster← user screenrect extent x + 15 / 16.
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.
bits unlock.
self setchar: svchar].
"126" FontWindow$'Scheduler'
[firsttime | |
"upon entry"
(clearframe has: user mp)
ifTrue: [self show]
ifFalse: [↑false]].
"503" FontWindow$'Initialization'
[altostyle: t1 fontnumber: t2 at: origin | |
altostyle ← t1.
fontnumber ← t2.
"set up an instance"
fontmenu nil
ifTrue: [self init].
scale ← 9.
charstr ← String new: 1.
char ← 65.
charstr 1 ← char.
bitsetter ← BitBlt init.
boxer ← Rectangle new origin: 0 0 extent: scale - 1 (scale - 1).
frame ← Rectangle new origin: origin extent: scale 0.
clearframe ← Rectangle new origin: origin extent: scale 0.
self setfont: altostyle fonts fontnumber].
"272" FontWindow$'Strike format'
[updateseglength: newfont raster: newraster | |
newfont word: 5 ← 5 + (newraster * fontht) "compute new segment length for a font" "length, ascent, descent, kern, and raster" "bits" + ((font word: 3) "max" - (font word: 2) "min" + 2) "xtabl"].
"596" FontWindow$'Editing'
[setbit: bitpoint color: color | x y |
"turn bits on, off"
bitpoint ← bitpoint - frame origin.
x ← (0 max: charwid - 1) min: bitpoint x / scale.
y ← (0 max: fontht - 1) min: bitpoint y / scale.
boxer moveto: frame origin + (scale * x (scale * y)).
boxer color: color mode: storing "turn bit on/off in blowup".
bitsetter destraster← fontraster "set up bitblt table.".
bitsetter destx← charx + x.
bitsetter desty← y.
bitsetter destbase← font.
bitsetter dstrike← true "lock font and get core ptr".
bitsetter fill: storing color: color "turn bit on/off in font"].
"1937" FontWindow$'Editing'
[setwidth: delta | fontrightx newraster newxtabl newmaxwidth updatedfont i |
delta ← delta - charwid "change in width".
delta = 0
ifTrue:
[self show.
↑false].
.
fontrightx ← font word: fontxtabl + ((font word: 3) - (font word: 2)) + 2.
newraster ← (fontrightx + 15 / 16 (i ← fontrightx + delta + 15 / 16)
ifTrue: [i]
ifFalse: [fontraster]).
newxtabl ← newraster * fontht + 9 "header" + 1 "for 0 addressing".
XeqCursor showwhile [
(updatedfont ← String new: 9 + (newraster * fontht) "header" "bits" * 2 "grow/shrink the bits".
(1 to: 8) "fill in header of new font" do: [:i | updatedfont word: i ← font word: i].
updatedfont word: 9 ← newraster "set raster in new font" "copy the xtable".
updatedfont ← self appendxtable: updatedfont "set up to copy up to old bits of char".
bitsetter destraster← newraster.
bitsetter destx← 0.
bitsetter desty← 0.
bitsetter sourcex← 0.
bitsetter sourcey← 0.
bitsetter width← charx + charwid.
bitsetter height← fontht.
bitsetter sourceraster← fontraster.
bitsetter destbase← updatedfont.
bitsetter sourcebase← font.
bitsetter sstrike← true.
bitsetter dstrike← true.
bitsetter copy: storing.
delta < 0 "if char grown, clean out right side of char"
ifFalse:
[bitsetter destx← charx + charwid.
bitsetter width← delta.
bitsetter fill: storing color: 0] "now copy remainder of font".
bitsetter destx← charx + charwid + delta.
bitsetter width← fontrightx - charx - charwid.
bitsetter sourcex← charx + charwid.
bitsetter copy: storing "shift x-vals".
(char + 1 to: 2 + (updatedfont word: 3) - (updatedfont word: 2) "max") do: [:i | updatedfont word: (newxtabl + i) ← delta + (updatedfont word: newxtabl + i)].
clearframe clear "clear out old version of character".
self setfont: updatedfont "set up the new copy of the font".
self updateseglength: font raster: fontraster.
self updatemaxwidth)]].
"847" FontWindow$'Editing'
[setascent: ascentdelta | updatedfont ascent |
ascent ← font word: 6 "ascent delta".
ascent + ascentdelta < 0
ifTrue: [ascentdelta ← 0 - ascent].
ascentdelta > 0
ifTrue:
[updatedfont ← String new: 2 * fontraster * ascentdelta "grow".
updatedfont all← 0 "fill with white".
updatedfont ← font (1 to: 18) "add oldfont header and new space together" concat: updatedfont (1 to: updatedfont length).
updatedfont ← updatedfont concat: font (19 to: font length "now add on rest of old font")]
ifFalse:
[updatedfont ← font (1 to: 18) concat: font (19 + (0 - (2 * fontraster "shrink" * ascentdelta)) to: font length)].
updatedfont word: 6 ← ascent + ascentdelta "reset ascent word in font".
self setfont: updatedfont "updatedfont now font of interest".
self updateseglength: font raster: fontraster].
"185" FontWindow$'Strike format'
[appendxtable: thefont | |
thefont ← thefont concat: font (fontxtabl * 2 "put fontxtable on end of a grown/shrunk font" - 1 to: font length).
↑thefont].
"732" FontWindow$'Editing'
[setdescent: descentdelta | updatedfont descent space |
descent ← font word: 7 "descent delta".
descent + descentdelta < 0
ifTrue: [descentdelta ← 0 - descent].
descentdelta > 0
ifTrue:
[space ← String new: 2 * fontraster * descentdelta.
space all← 0.
updatedfont ← font (1 to: fontxtabl - 1 * 2) concat: space.
updatedfont ← self appendxtable: updatedfont]
ifFalse:
[updatedfont ← font (1 to: fontxtabl - 1 * 2 + (fontraster * descentdelta * 2)).
updatedfont ← self appendxtable: updatedfont].
updatedfont word: 7 ← descent + descentdelta "reset descent word in font".
self setfont: updatedfont "updatedfont now font of interest".
self updateseglength: font raster: fontraster].
"1100" FontWindow$'Help'
[help | |
"
**sysFontWindow is declared in the Smalltalk dictionary, and bound to the font window displayed on the screen of most system releases -- intended to provide an easy way to play around with the font editor.
**to create a window for editing default font 0 at middle-click:
user schedule: (sysFontWindow ← FontWindow new
altostyle: DefaultTextStyle
fontnumber: 1
at: (OriginCursor showwhile
[user waitbug [user mp]])).
**to create a new font
yourfont ← FontWindow new newfont: 16 maxcharwidth: 16 min: 0
max: 177 ascent: 12 kern: 0.
**to edit newly created font
yourtextstyle setfont: n name: yourfont. **insert it into a TextStyle
**now create a window as above with yourtextstyle and appropriate
fontnumber
**examples of manual manipulation of yourfontwindow:
sysFontWindow setascent: 2. **Deltas -- for entire font**
sysFontWindow setascent: 3.
sysFontWindow setdescent: 2.
sysFontWindow setdescent: 2.
sysFontWindow setchar: 046.
sysFontWindow setwidth: 5. **Absolute--for char in window.
Useful for characters of zero width.**
"].
"43" HalfToner$'Init/Access'
[npix | |
↑npix].
"554" HalfToner$'AIS to Bits'
[intoPress: p file: f | outrect |
"Creates an external file reference"
outrect ← p transrect: rect.
p setp: outrect origin.
p dots [
(p setcoding: 8 dots: npix lines: nlines "byte samples".
p setmode: 3 "to right and to bottom of page".
p setwindowwidth: pixelsPerLine height: lines skipdots: inset x skiplines: inset y.
p setsizewidth: outrect width height: outrect height.
p dotsfromAIS: f)] "
|p. p←dp0 pressfile: 'pix.press'.
p pictureinit. (HalfToner new test) intoPress: p file: 'Rolfup.AIS'. p close.
"].
"51" HalfToner$'Init/Access'
[rect← t1 | |
rect ← t1].
"47" HalfToner$'Init/Access'
[nlines | |
↑nlines].
"964" HalfToner$'Init/Access'
[setup: t1 | inrect croprect |
strm ← t1.
strm readonly.
((strm word: 2) 1024 or: [(strm word: 9) 8])
ifTrue: [user notify: 'bad file']
ifFalse:
[nlines ← lines ← strm word: 4.
npix ← pixelsPerLine ← strm nextword.
black ← 0.
white ← 255.
inrect ← 0 0 rect: pixelsPerLine lines.
inrect moveto: rect origin.
inrect usermove.
inrect comp "show whole".
croprect ← rect copy.
croprect moveto: inrect origin copy.
croprect maxstretch: inrect.
croprect userstretch: inrect.
inrect comp.
inset ← croprect origin - inrect origin.
pixelsPerLine ← croprect width.
lines ← pixelsPerLine * rect height / rect width.
rect width > pixelsPerLine
ifTrue:
[inpix ← 32 "blowup".
outpix ← 32 * rect width / pixelsPerLine]
ifFalse:
[ "shrink"
outpix ← 32.
inpix ← 32 * pixelsPerLine / rect width].
errorString ← String new: pixelsPerLine * outpix / inpix + 2.
errorString all← 0]].
"43" HalfToner$'Init/Access'
[strm | |
↑strm].
"340" HalfToner$'Init/Access'
[test | files |
files ← (dp0 filesMatching: '*.ais.') sort.
files empty
ifTrue: [user notify: 'no .ais files on disk']
ifFalse:
[strm ← dp0 file: files (Menu new stringFromVector: files) zbug.
strm readonly.
rect ← Rectangle new usersize.
self setup: strm.
self doFile] "
HalfToner new test.
"].
"43" HalfToner$'Init/Access'
[rect | |
↑rect].
"913" HalfToner$'AIS to Bits'
[decode: str using: s | i j k x cascadeRight cascadeDiag val error r msk masks |<primitive: 75>
masks ← #(128 64 32 16 8 4 2 1 ) "Change 8-bit grey from str filling s".
cascadeRight ← 0.
cascadeDiag ← errorString 1.
i ← msk ← j ← k ← 1.
x ← 0 - outpix.
s 1 ← 0.
(1 to: pixelsPerLine) do:
[:i | [x < 0] whileTrueDo:
[val ← str i - black.
(error ← cascadeRight - val) 0
ifTrue:
[s j ← masks msk "print Black" + (s j).
error > white
ifTrue: [error ← white]]
ifFalse:
[ "print White"
(error ← error + white) < 0
ifTrue: [error ← 0]].
error ← error / 2.
val ← error / 2.
errorString k ← cascadeDiag + val.
cascadeRight ← errorString (k + 1) + error.
cascadeDiag ← val.
(msk ← msk + 1) > 8
ifTrue:
[msk ← 1.
j ← j + 1.
s j ← 0].
x ← x + inpix.
k ← k + 1].
x ← x - outpix].
↑s].
"980" HalfToner$'AIS to Bits'
[doFile | str i s2 r y skipsum |
str ← String new: pixelsPerLine.
r ← 0 0 rect: pixelsPerLine * outpix / inpix 1.
r moveto: rect origin copy.
s2 ← String new: 1 + (pixelsPerLine * outpix / (8 * inpix)).
vect ← Vector new: lines.
strm reset.
strm position← 2048 + (inset y * npix) "crop top".
i ← 1.
y ← 0 - outpix.
skipsum ← 0.
[i lines] whileTrueDo:
[skipsum ← skipsum + inset x "inset left".
strm skip: skipsum.
skipsum ← 0 "do all tallied skips prior to next read".
strm into: str endError: true.
r bitsFromString: (self decode: str using: s2).
skipsum ← skipsum + npix - (pixelsPerLine + inset x).
r origin y← r origin y + 1.
r corner y← r corner y + 1.
(y ← y + inpix) 0
ifTrue:
[ "next line?"
i ← i + 1.
y ← y - outpix.
[y 0 and: [i lines]] whileTrueDo:
[i ← i + 1.
y ← y - outpix.
skipsum ← skipsum + npix]]
ifFalse: [skipsum ← skipsum - npix] "not next line"].
strm close].
"2002" JuniperInterface$'CLASS INIT'
[juniperConstants | |
"...returns the set of constants used to specify requests to and to interpret results from the Juniper file system."
↑#(168 sRequest sResult sUnsolicited sCustodian sSync sPineAck sNoop 5 sReadPage sWritePage sSetLength sReadLength sCloseFile sDestroyAnonymousFile sReadData sWriteData sReadAttribute sWriteAttribute sSetWriteLock sSetReadLock sReleaseReadLock 32 sChangePassword sRoom sOpenFile sCreateAnonymousFile sFindFile sLockQuery sTransCompletionQuery 42 sLogout sCloseTransaction sAbortTransaction sLoginRequest 60 sLookupFile sCreateFile sDestroyFile sRenameFile sNextFile sNextFewFiles 1 sCommandNak sCommandAck sHeresData sHeresEntry sHeresFileList sHeresLFH sHeresFile sHeresLength sLoginResponse sLogoutResponse sTransactionClosed sTransCompletionInfo sResourceData sHeresRoom 0 sTransactionAborted sReadLockBroken 8 sLogin sAddServer sResourceLocation 42 sUnimplementedFeature sIllegalLoginAttempt sSoftwareVersionMismatch sNoSuchUser sPasswordMismatch sBytesPerPageUnacceptable sServerTooBusy sOutOfSpace sNoFilesHere sNoDirectoryHere sIllegalFileName sFileNotFound sFileAlreadyExists sTransactionAborting sNoSuchOpenFile sBigFilesNotImplemented sIllegalAttribute sReadAttributeProtectionError sUserAskedForIt sWriteAttributeProtectionError sPackNotOnDrive sTooManyOpenFiles sProtectionViolation sFileNotOnPack sPackFull sFileRefOutOfBounds sFileSizeExcessive sByteRangeExcessive sPackNotOnMachine sNoSuchTransaction sBrokenLock sInconvenientUnwind sSequenceNumberGap sRecoveryUnderWay sTransactionClosing sCongestion 120 sBlockTooLarge sNoRouteToServer sServerUnknown sBadBytesPerPage sInvalidRequest sPupGlitch sUnableToDecrypt sNoResponseToRequest sNewServerUnwilling sTransactionInUnknownState sBadTimeForRequests ) "PineMsgType (Pup types)" "DataRequest" "TransactionRequest" "ActivityRequest" "DirectoryRequest" "ResultCode" "Unsolicited Code" "CustodianCode" "PineErrorCode" "TransTroubleCode" "Retryable" "UserDetected"].
"647" JuniperInterface$'TIMER (internal)'
[timerOn | |
"...assigns fTimer to a new timer object that wakes up every 100 seconds (6000 1/60 seconds) and issues a 'noop' command to Juniper. This is used to prevent Juniper from timing out during periods of inactivity."
self timerOff "1".
fTimer ← Timer new "2".
fTimer for: 6000 action [
(self noOp.
user show: '.'.
fTimer reset)] "3".
user cr.
fTimer reset "4" "
1. Make sure that the current timer is released.
2. Create a new timer.
3. Set the timer interval to 100 seconds. The action of the timer is to send a noop, show a dot in the dispFrame, and reset.
4. Activate the timer.
"].
"313" JuniperInterface$'USER CALLABLE'
[exceptionHandler: pExceptionHandler | |
"...specifies an exception handler to be invoked if any subsequent request discovers that the expected transaction has been closed. If no exception handler is set, a notify window is displayed."
fExceptionHandler ← pExceptionHandler].
"368" JuniperInterface$'FILE DIRECTORY (restricted)'
[Rename: oldFile from: newFile | tRequest newName |
"renames a file on Juniper"
tRequest ← self newRequestParameterBlock.
tRequest nextDataBlockString← oldFile name.
tRequest nextDataBlockString← newName ← self checkDirectory: newFile name.
self doAction: sRenameFile requestPrs: tRequest.
oldFile name: newName].
"152" JuniperInterface$'FILE DIRECTORY (restricted)'
[entryClass | |
"...returns the file class handled by the JuniperInterface."
↑JuniperFileController].
"781" JuniperInterface$'FILE DIRECTORY (restricted)'
[nextFile: pFile | tRequest tResult |
"same as LookupFile (Find:), but it pertains to the file whose name is lexically next after the fileName specified in the request. If the file is found, its name and long file handle are set in pFile (a JuniperFileController). Otherwise (no next file) false is returned."
fSpecialError ← sFileNotFound "1".
tRequest ← self newRequestParameterBlock "2".
tRequest nextDataBlockString← self checkDirectory: pFile name "3".
tResult ← self doAction: sNextFile requestPrs: tRequest "4".
fSpecialError true
ifTrue:
[fSpecialError ← nil.
↑false].
"5"
fSpecialError ← nil "6".
pFile longFileHandle: tResult nextDataBlockString.
pFile name: tResult nextDataBlockString "7".
↑pFile].
"910" JuniperInterface$'FILE DIRECTORY (restricted)'
[Match: entries to: strm | entry pat ents name i p lastname |
entries do:
[:pat | "search for Files matching patterns"
name ← self checkDirectory: pat name.
i ← name find: '*' 1.
p ← name find: '#' 1.
i ← (p = 0
ifTrue: [i]
ifFalse:
[i = 0
ifTrue: [p]
ifFalse: [i min: p]]).
i = 0
ifTrue:
[(self Find: pat)
ifTrue: [strm next← pat "exact name found"]]
ifFalse:
[ "pattern match over range of first to last possible matches"
pat ← self makeEntry: name.
entry ← self makeEntry: (name copy: 1 to: i - 1).
lastname ← name copy: 1 to: i.
lastname i ← 255.
[(entry ← self nextFile: entry) and: [entry name < lastname]] whileTrueDo:
[(pat match: entry)
ifTrue:
[strm next← entry "copy entry since nextFile smashes into it".
entry ← self makeEntry: entry name]]]]].
"156" JuniperInterface$'TIMER (internal)'
[timerOff | |
"...disables fTimer and sets it to nil."
fTimer nil
ifFalse:
[fTimer disable.
fTimer ← nil]].
"792" JuniperInterface$'JUNIPER COMMAND INTERFACE (restricted)'
[doLogin: pRequest | tResult |
"...is sent by login:password: with pRequest (a JuniperRequestParameter Block) set. doLogin: issues a login request, checks for errors, and retries if necessary. If no error occurs, a JuniperResultParameterBlock is returned; otherwise, error handling is invoked."
tResult ← JuniperResultParameterBlock new "1".
tResult packet← fJuniperSocket sendLogin: pRequest packet "2".
(self checkResult: tResult)
ifTrue: [↑tResult].
"3"
↑self doLogin: pRequest "4" "
1. Create a new result parameter block.
2. Issue a login request and set the result packet in the result parameter block.
3. Check the result and return it if there is no error.
4. Retry the request if there is a retryable error.
"].
"952" JuniperInterface$'MISC (internal)'
[login: pName password: pPassword | tRequest |
"...sets the necessary request parameters and invokes doLogin to issue a login request. pName (a String) specifies the name of an account on the Juniper file system. pPassword (a String) specifies the password of the account."
tRequest ← self newRequestParameterBlock "1".
tRequest leader: 3 ← sLogin "2".
tRequest leader: 4 ← 512 "3".
tRequest leader: 5 ← 7 "4".
tRequest leader: 6 ← self hash: pPassword "5".
tRequest nextDataBlockString← pName "6".
tRequest pupType← sCustodian "7".
↑self doLogin: tRequest "8" "
1. Create a new request parameter block.
2. Set the command to Login.
3. Set the number of bytes per page to 512.
4. Set the Juniper version number to 7 (Nov 80).
5. Set the hashed account password to pPassword hashed.
6. Set the account name to pName.
7. Set the packet pup type to custodian.
8. Issue the request and return the result.
"].
"336" JuniperInterface$'TEST / DIAGNOSTIC'
[test | |
"
dpj ← nil.
dpj ← JuniperInterface new.
dpj release.
dpj open.
dpj close.
| f [ dpj open. f ← dpj file: 'test.test'.
until [ f end ] do [ user show: (f next) inString. ]. f close. dpj close. ]
JuniperSocket howMany 2 1 2 2 2 11 Timer howMany 33 NameUser howMany 1 1 1
"].
"72" JuniperInterface$'USER CALLABLE'
[obsolete | |
↑fOpenIndicator nil].
"440" JuniperSocket$'Socket'
[timerFired | |
notWaiting "This piece of code only runs when a timer fires!
Thus, there is mutual exclusion between this and other timer code.
Runs below the ethernet input. Don't do an active return
Timer sometimes fires even though its been disabled!"
ifFalse:
[self timerOn
ifTrue: [self completePup: outPac "go ahead and retransmit....."]
ifFalse:
[notWaiting ← true.
result ← false]]].
"396" JuniperSocket$'Initialization/Termination'
[net: pNet host: pHost | |
"start with the well known Juniper listener, leave filterInput false"
super net: pNet host: pHost soc: 64 asInt32.
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"].
"1434" JuniperSocket$'Socket'
[socProcess: Ipac | temp |
loginPending
ifTrue:
[ "Juniper has responded, we're running at a high level" "handle this special case"
((frnNet Ipac sourceNet "watch out, src has not been checked" or: [frnHost Ipac sourceHost]) or: [(169 Ipac pupType or: [0 Ipac pupID0])])
ifFalse:
[ "discard it" "Ipac ← self freePacket: Ipac" "this must be it!"
frnSocNum high: Ipac sourceSoc0 low: Ipac sourceSoc1.
self setOutAddBlock.
self setAddresses: outAck "for later use" "generate an ack".
outAck pupID0← 0.
self completePup: outAck.
loginPending ← false.
notWaiting ← filterInput ← true.
result ← Ipac]]
ifFalse:
[ "src. and dest. should have been checked ??)"
Ipac pupType = 169
ifTrue:
[outAck pupID0← Ipac pupID0 "might be a retransmission of a previous Juniper response or what we want.
acknowledge in either case then see whether we want to keep the result".
self completePup: outAck.
(notWaiting or: [seqNum Ipac pupID0])
ifFalse:
[ "Ipac ← self freePacket: Ipac"
notWaiting ← true.
result ← Ipac]]
ifFalse:
[ "Ipac pupType = 0255 [Ipac←self freePacket: Ipac]" "discard pineack"
(notWaiting false and: [(Ipac pupType = 4 and: [(Ipac word: 23) = 2])])
ifTrue:
[self timerOff "no socket at Juniper".
notWaiting ← true.
result ← Ipac]
ifFalse:
[ "Ipac ← self freePacket: Ipac."
]]]].
"341" JuniperSocket$'Socket'
[sendRequest: t1 | |
outPac ← t1.
notWaiting ← false "General routine to send request packets, wait for ack, retransmit.
Will return the Juniper response packet, or else a false.".
outPac pupID0← seqNum ← seqNum + 1.
self setAddressesAndComplete: outPac.
[notWaiting] whileFalseDo: [ "all done"
].
↑result].
"491" JuniperSocket$'Socket'
[sendLogin: t1 | |
outPac ← t1.
frnSocNum high: 0 low: 64 "Special routine to send login, wait for ack, retransmit.
Need to reset seqNum, and get new Juniper socket number.
Will return the Juniper response packet, or else a false.".
self setOutAddBlock.
filterInput ← false.
outPac pupID0← 0.
outPac pupID1← seqNum ← 0.
notWaiting ← false.
loginPending ← true.
self setAddressesAndComplete: outPac.
[notWaiting] whileFalseDo: [ "all done"
].
↑result].
"1074" JuniperInterface$'USER CALLABLE'
[open | tResult |
"...opens the interface allowing access to files on the Juniper file system. A new transaction is started."
fOpenIndicator true
ifFalse:
[ "1"
E wakeup "2".
self release "3".
fJuniperSocket ← JuniperSocket new hostName: self server "4".
tResult ← self login: self userName password: self userPassword "5".
user cr.
user show: tResult nextDataBlockString "6".
self timerOn "7".
super open "8".
fOpenIndicator ← true "9"] "
1. If the interface is already open, do nothing.
2. Make sure that the EtherWorld mechanism is in a valid state.
3. Release the interface to insure a valid initial state. (An invalid state can occur from an error on some statement in a previous invocation of 'open').
4. Create and initialize a JuniperSocket (parameterize server name?).
5. Issue a login command.
6. Display the login message that is returned by Juniper.
7. Turn on a timer to issue periodic noop commands to prevent timeout.
8. Do predefined open operations.
9. Set the interface status to 'open'.
"].
"394" JuniperInterface$'USER CALLABLE'
[release | |
"...leaves the interface in a valid state after an error."
fOpenIndicator ← nil "1".
self timerOff "2".
fJuniperSocket nil
ifFalse:
[fJuniperSocket close "3".
fJuniperSocket ← nil "4"] "
1. Set the interface status to 'not open'.
2. Turn off the timer.
3. Close the JuniperSocket if it exists.
4. Release the JuniperSocket field.
"].
"159" JuniperInterface$'MISC (internal)'
[userName | |
"...returns the account name or a default (a String)."
fName nil
ifTrue: [↑super userName].
↑fName].
"179" JuniperInterface$'MISC (internal)'
[userPassword | |
"...returns the account password or a default (a String)."
fPassword nil
ifTrue: [↑super userPassword].
↑fPassword].
"1247" JuniperInterface$'FILE DIRECTORY (restricted)'
[Find: pFile | tRequest tResult |
"...sends a 'look up file' request to the Juniper file server. If the file is found, its name and long file handle are set in pFile (a JuniperFileController). Otherwise false is returned."
fSpecialError ← sFileNotFound "1".
tRequest ← self newRequestParameterBlock "2".
tRequest nextDataBlockString← self checkDirectory: pFile name "3".
tResult ← self doAction: sLookupFile requestPrs: tRequest "4".
fSpecialError true
ifTrue:
[fSpecialError ← nil.
↑false].
"5"
fSpecialError ← nil "6".
pFile longFileHandle: tResult nextDataBlockString.
pFile name: tResult nextDataBlockString "7" "
1. Set the error handling mechanism to ignore a 'file not found' error.
2. Create a new request parameter block.
3. Get the file name from pFile, add the default directory name to it if necessary, and write it in the request parameter block.
4. Issue a 'look up file' request and get the result parameter block.
5. If a 'file not found' error was encountered, reset the error handling mechanism and return false.
6. (no error encountered) Reset the error handling mechanism.
7. Set the long file handle and name (from the result parameter block) in pFile.
"].
"212" JuniperInterface$'JUNIPER COMMAND INTERFACE (restricted)'
[newPacket | |
"...returns a new packet (Pacbuf) from the JuniperSocket."
fJuniperSocket nil
ifTrue:
[self open].
↑fJuniperSocket freePacket].
"108" JuniperInterface$'FILE DIRECTORY (restricted)'
[server | |
↑'Juniper1' "should be an instance variable?"].
"282" JuniperInterface$'MISC (internal)'
[directory | |
"...Returns a string specifying the default file name directory. The default directory is fDefaultDirectory if it is not nil, otherwise it is self name"
fDefaultDirectory nil
ifTrue: [↑self userName].
↑fDefaultDirectory].
"388" JuniperInterface$'MISC (internal)'
[hash: pString | tHash1 tHash2 i |
"...returns a hash value for pString (a String)."
tHash1 ← 0.
tHash2 ← 0.
(1 to: pString length by: 2) do:
[:i | tHash1 ← tHash1 lxor: UpperCase (pString i + 1).
tHash2 ← tHash2 lxor: (i = pString length
ifTrue: [32]
ifFalse: [UpperCase (pString (i + 1) + 1)])].
↑tHash1 * 256 + tHash2].
"250" JuniperInterface$'USER CALLABLE'
[closeTransaction | |
"...closes the current transaction leaving the user logged in with all open files still open, and all read and write locks still in effect."
self doAction: sCloseTransaction requestPrs: nil].
"490" JuniperInterface$'CLASS INIT'
[classInit | tIndex tConstant |
"...initializes the constants in gJuniperConstants
(see [ivy] <Juniper>4.4> CommonPineDefs.mesa).
Do the following to initialize:
Smalltalk declare: gJuniperConstants as: (SymbolTable new init: 256).
JuniperInterface classInit."
self juniperConstants do:
[:tConstant | (tConstant is: Integer)
ifTrue:
[tIndex ← tConstant]
ifFalse:
[gJuniperConstants declare: tConstant as: tIndex.
tIndex ← tIndex + 1]]].
"543" JuniperInterface$'MISC (internal)'
[checkDirectory: pFileName | ps |
"...returns a string that has the default directory name added to the beginning of pFileName (a String) unless pFileName already begins with a directory name in which case it is returned unchanged. max length of ~58"
ps ← (String new: 60) asStream.
(pFileName length > 0 and: [pFileName 1 = ('<' 1)])
ifFalse:
[ps append: '<'.
ps append: self directory.
ps append: '>'].
ps append: pFileName.
ps last = ('.' 1)
ifTrue: [ps skip: 1].
↑ps contents].
"573" JuniperInterface$'FILE DIRECTORY (restricted)'
[Delete: pFile | tRequest |
"...deletes from the Juniper file system the file whose file name is specified by pFile (a JuniperFileController)."
tRequest ← self newRequestParameterBlock "1".
tRequest nextDataBlockString← self checkDirectory: pFile name "2".
self doAction: sDestroyFile requestPrs: tRequest "3" "
1. Create a new request parameter block.
2. Get the file name from pFile, add the default directory name to it if necessary, and write it in the request parameter block.
3. Issue a 'destroy file' request.
"].
"62" JuniperInterface$'USER CALLABLE'
[versionNumbers | |
↑true].
"260" JuniperInterface$'USER CALLABLE'
[name: pName password: pPassword | |
"...specifies the name and password of an account on the Juniper file system. This account will be logged into whenever the interface is opened."
fName ← pName.
fPassword ← pPassword].
"1071" JuniperInterface$'FILE DIRECTORY (restricted)'
[Insert: pFile | tRequest tResult |
"...issues a 'create file' request to the Juniper file server and sets the returned long file handle and name in pFile (a JuniperFileController)."
tRequest ← self newRequestParameterBlock "1".
tRequest longInteger: 2 ← 0 "user rawtotalsecs" "1.5".
tRequest nextDataBlockString← self checkDirectory: pFile name "2".
tRequest nextDataBlockString← '' "3".
tResult ← self doAction: sCreateFile requestPrs: tRequest "4".
pFile longFileHandle: tResult nextDataBlockString.
pFile name: tResult nextDataBlockString "5" "
1. Create a new request parameter block.
1.5 Set creation date (to default (current) -- later some specific date&time?)
2. Get the file name from pFile, add the default directory name to it if necessary, and write it in the request parameter block.
3. Blank the file server field of the request parameter block.
4. Issue a 'create file' request and get the result parameter block.
5. Set the long file handle and name (from the result parameter block) in pFile.
"].
"684" JuniperInterface$'TIMER (internal)'
[noOp | tPacket |
"...sends a noop command to the Juniper file server. It's only effect is to reset the timout mechanism of the server."
tPacket ← fJuniperSocket freePacket "1".
tPacket pupType← sNoop "2".
tPacket dataString← '' "3".
fJuniperSocket setAddressesAndComplete: tPacket.
fJuniperSocket timerOff "4" "
1. Get a new packet (Pacbuf).
2. Set packet pup type to 'noop'.
3. Set the dataString to the empty string. This has the necessary effect of setting the packet length to 0.
4. Send the packet. It is necessary to bypass the normal JuniperSocket interface (sendRequest:) because no acknowledgement is returned for the noop.
"].
"481" JuniperInterface$'USER CALLABLE'
[close | tResult |
"...ends the current transaction and closes the interface."
fOpenIndicator nil
ifFalse:
[ "1"
tResult ← self doAction: sLogout requestPrs: nil "2".
user cr.
user show: tResult nextDataBlockString "3".
super close "4"] "
1. If the interface is not open, do nothing.
2. Issue a logout command.
3. Display the logout message returned by Juniper.
4. delete self from externalViews, Release timers, fields, etc.
"].
"813" JuniperInterface$'JUNIPER COMMAND INTERFACE (restricted)'
[newRequestParameterBlock | tRequestParameterBlock |
"...initializes and returns a new JuniperRequestParameterBlock."
fJuniperSocket nil
ifTrue:
[self open] "1".
tRequestParameterBlock ← JuniperRequestParameterBlock new "2".
tRequestParameterBlock packet← fJuniperSocket freePacket "3".
tRequestParameterBlock dataBlockLength← 0 "4".
tRequestParameterBlock leader: 1 ← 0.
tRequestParameterBlock leader: 2 ← 0 "5".
↑tRequestParameterBlock "6" "
1. Open the interface if it is not already.
2. Create a new request parameter block.
3. Create a new packet and set it in the request parameter block.
4. Set the data block length to 0.
5. Set the authentication key and reserved word to 0.
6. Return the initialized request parameter block.
"].
"400" JuniperInterface$'JUNIPER COMMAND INTERFACE (restricted)'
[checkRetry: pErrorCode | |
"...is sent by checkResult to test for a retryable error. Returns true if so; false otherwise."
pErrorCode = sSequenceNumberGap
ifTrue: [↑true].
pErrorCode = sRecoveryUnderWay
ifTrue: [↑true].
pErrorCode = sTransactionClosing
ifTrue: [↑true].
pErrorCode = sCongestion
ifTrue: [↑true].
↑false].
"202" JuniperInterface$'USER CALLABLE'
[directory: pDirectory | |
"...specifies the directory name to be added to any file name that does not begin with a directory name."
fDefaultDirectory ← pDirectory].
"755" JuniperInterface$'DOCUMENTATION'
[implementationNotes | |
"
FIELDS
fName : a String representing the name of an account on the Juniper file system.
fPassword : a String representing the password of the same account.
fDefaultDirectory : a String representing the directory to be used as the default if one is not specified as part of a file name.
fJuniperSocket : a JuniperSocket used to interface to the etherWorld mechanism.
fTimer : a Timer used to periodically send noop commands when the interface is open to prevent timeout.
fExceptionHandler : an ExceptionHandler to invoke when a transaction is aborted.
fSpecialError : an error code to ignore on a command request.
fOpenIndicator : the interface status: true means open; nil means not open.
"].
"385" JuniperInterface$'JUNIPER COMMAND INTERFACE (restricted)'
[error: pMessage | tMessage |
"...is sent by checkResult if an error is encountered on a Juniper request. (pMessage is a String containing an appropriate error message.) The error message is formed and a notify window is displayed."
tMessage ← Stream default.
tMessage append: pMessage.
super error: tMessage contents].
"1872" JuniperInterface$'JUNIPER COMMAND INTERFACE (restricted)'
[checkResult: pResult | t2 |
"...is sent by doAction and doLogin to check the result of a Juniper request. pResult is a result parameter block (JuniperResultParameterBlock) containing the packet (Pacbuf) returned as a result of the request."
((pResult packet false or: [pResult pupType = 4]) or: [(pResult resultCode = sCommandNak and: [(pResult parameter: 1) = sTransactionAborting])])
ifTrue:
[ "3"
fExceptionHandler nil
ifFalse:
[fExceptionHandler trap "4"].
self error: 'No Juniper Transaction' "5"].
(t2 ← pResult resultCode) = sCommandAck
ifTrue: [↑true].
"6"
t2 = sCommandNak
ifTrue:
[ "7"
(self checkRetry: (pResult parameter: 1))
ifTrue: [↑false].
"8"
(pResult parameter: 1) = fSpecialError
ifTrue:
[fSpecialError ← true.
↑true].
"9"
self error: pResult nextDataBlockString "10"]
ifFalse: [↑true] "11" "
1. JuniperSocket sendRequest: and sendLogin: return false if no response is received from Juniper.
2. Invoke error handling if there is no response from Juniper.
3. Juniper returns an error pup (packet pup type = 4) if the transaction has been aborted.
4. If the transaction has been aborted and there is an exception handler, then trap to the handler.
5. Invoke error handling if control is returned or if there is no exception handler.
6. Return true if a 'command acknowledged' was returned (this means success with no result parameters).
7. If a 'command not acknowledged' was returned, an error condition exists.
8. Check for a retryable error and return false if so.
9. If the error is the same as that specified in the special error indicator, then indicate it and return true.
10. If not, invoke error handling.
11. Return true if a 'command not acknowledged' was not returned (this means success with result parameters).
"].
"1778" JuniperInterface$'JUNIPER COMMAND INTERFACE (restricted)'
[doAction: pAction requestPrs: pRequest | tResult |
"...corresponds to the Pine Protocol function. The specified request, pAction, (selected from gJuniperConstants) with its corresponding request parameter block, pRequest (a JuniperRequestParameterBlock), is issued to the Juniper file server (through JuniperSocket sendRequest:). A packet is returned and inserted into a result parameter block and checked for error conditions. If no errors are found, the result parameter block (a JuniperResultParameterBlock) is returned; otherwise, error handling is invoked. If no request parameters are required, pRequest can be specified as nil."
fOpenIndicator nil
ifTrue:
[self open] "1".
pRequest nil
ifTrue:
[pRequest ← self newRequestParameterBlock] "2".
fTimer disable "3".
pRequest opcode← pAction "4".
pRequest pupType← sRequest "5".
tResult ← JuniperResultParameterBlock new "6".
tResult packet← fJuniperSocket sendRequest: pRequest packet "7".
fTimer reset "8".
(self checkResult: tResult)
ifTrue: [↑tResult].
"9"
↑self doAction: pAction requestPrs: pRequest "10" "
1. Make sure the JuniperInterface is open.
2. Create a request parameter block if none was specified.
3. Disable the timer to insure that a noop command is not sent while the current request is in progress.
4. Set the command code in the packet.
5. Set the packet pup type to 'request'.
6. Create a result parameter block.
7. Send the request to the JuniperSocket with the packet from the request parameter block; set the result packet in the result parameter block.
8. Reset the timer.
9. Check the result; if valid, return it.
10. If false is returned, then a retryable error was encountered so retry the command.
"].
"92" ExceptionHandler$'MISC'
[result | |
"...returns the result set by 'result←'."
↑fResult].
"125" ExceptionHandler$'MISC'
[result← pResult | |
"...sets the result value of 'doonTrapDo' to pResult."
fResult ← pResult].
"2555" ExceptionHandler$'DOCUMENTATION'
[description | |
"
This class provides some exception handling capabilities that can be used in a variety of applications. It is intended to be used in the following way:
1. An ExceptionHandler object is created to supervise the execution of a block of statements.
EH ← ExceptionHandler new.
2. Each object that is capable of detecting an exception is informed of the existence of the ExceptionHandler object.
dpj exceptionHandler: EH.
3. The ExceptionHandler object is then sent the message 'do pCode onTrapDo pTrapCode'. The parameter pCode is a block of statements that is to be supervised by the ExceptionHandler object. The parameter pTrapCode is a block of statements that is to be executed whenever an exception is detected.
EH do [ ... ] onTrapDo [ ... ].
4. When an exception is detected during the execution of one of the statements in pCode the message 'trap' can be sent to the ExceptionHandler object which will then take control. If information about the exception is available, it can be relayed by sending the message 'trap:' with the information specified as the parameter.
EH trap. (or) EH trap: information.
5. When the ExceptionHandler object gets control it saves the parameter if one was sent, then executes pTrapCode. The saved parameter can be retrieved by sending the message 'trapCondition'. The statements in pTrapCode should take any actions necessary to handle the exception. Messages can be included in pTrapCode that tell the ExceptionHandler object what to do when pTrapCode completes. The available messages are:
5.1 'restart' which restarts the execution of pCode,
5.2 'continue' which continues pCode at the point at which 'trap' was sent,
5.3 'abort' which aborts the execution of pCode and returns control to the statement following 'do pCode onTrapDo pTrapCode'.
EH restart. (or) EH continue. (or) EH abort.
6. The message 'doonTrapDo' returns a result which can be specified during the execution of either pCode or pTrapCode by the message 'result ← pResult'. This result value can be retrieved anytime after it has been specified by sending the message 'result'.
EH result ← true.
[ EH result [ ... ] ].
7. If pCode is terminated abnormally from a user notify window, the message 'release' should be sent to return the ExceptionHandler object to its initial state.
EH release.
8. Special error checking is included in the ExceptionHandler object to detect calls to pTrapCode during the execution of pTrapCode and other invalid conditions.
"].
"194" ExceptionHandler$'POST TRAP SPECIFICATION'
[restart | |
"...specifies that the code interrupted by 'trap' or 'trap:' will be restarted when the trap code completes."
fPostTrapIndicator ← 0].
"503" ExceptionHandler$'EXAMPLES'
[juniperTest | e i max f |
"ExceptionHandler new juniperTest."
e ← ExceptionHandler new.
i ← 0.
max ← 5.
dpj exceptionHandler: e.
dpj open.
f ← dpj file: 'test.test'.
e do [
(f reset.
[f end] whileFalseDo:
[user show: f next inString])] onTrapDo [
(user cr.
user show: 'Juniper not responding'.
f release.
dpj release.
i ← i + 1.
i < max
ifTrue:
[e restart]
ifFalse: [e abort])].
user cr.
user show: 'done'.
f close.
dpj close].
"275" ExceptionHandler$'POST TRAP SPECIFICATION'
[abort | |
"...specifies that the code interrupted by 'trap' or 'trap:' will be aborted when the trap code completes. Control will return to the statement that follows the invocation of 'doonTrapDo'."
fPostTrapIndicator ← 1].
"162" ExceptionHandler$'TRAP HANDLER'
[trap | |
"...interrupts the execution of pCode and begins pTrapCode (from 'do pCode onTrapDo pTrapCode')."
self trap: nil].
"1613" ExceptionHandler$'TRAP HANDLER'
[trap: pTrapCondition | tTrapCode i |
"...interrupts the execution of pCode and begins pTrapCode (from 'do pCode onTrapDo pTrapCode'). The trap condition is set to pTrapCondition."
fStatusIndicator nil
ifTrue: [user notify: 'ExceptionHandler is not active']
ifFalse:
[ "1"
fStatusIndicator = 0
ifTrue: [user notify: 'ExceptionHandler trap code is already active'] "2"].
fStatusIndicator ← 0 "3".
fTrapCondition ← pTrapCondition "4".
fPostTrapIndicator ← 0 "5".
tTrapCode ← fTrapCode cleancopy "6".
tTrapCode eval "7".
(1 to: tTrapCode totalPT) "8" do:
[:i | fTrapCode setPT: i to: (tTrapCode getPT: i)].
fStatusIndicator ← 1 "9".
fPostTrapIndicator = 0 "10"
ifTrue:
[self restartCode]
ifFalse:
[fPostTrapIndicator = 1
ifTrue:
[self abortCode]
ifFalse:
[fPostTrapIndicator = 2]] "
1. If fStatusIndicator nil, then 'doonTrapDo' has not been invoked and there is no trap code to execute.
2. if fStatusIndicator = 0, then fTrapCode is active. This is an invalid state.
3. Set fStatusIndicator to indicate fTrapCode is active.
4. Set the trap condition to pTrapCondition.
5. Set the default post trap action to 'restart'.
6. Make a new copy of the context, fTrapCode.
7. Execute the new copy of fTrapCode.
8. Set the parameters and temporaries in the context, fTrapCode to those of the executed copy. This is done so that fCode will see any changes made to these variables by fTrapCode.
9. Set fStatusIndicator to indicate fTrapCode is not active.
10. Select the terminating action from the value of fPostTrapIndicator.
"].
"1540" ExceptionHandler$'CONTROL STRUCTURE'
[do pCode onTrapDo pTrapCode | |
"...executes the set of statements in the block pCode and, conditionally, the set of statements in the block pTrapCode. If 'trap' or 'trap:' is invoked during the execution of pCode, the execution is interrupted and pTrapCode is started. When pTrapCode completes, pCode is either continued, restarted, or aborted, depending on which of 'continue', 'restart', and 'abort' is sent during the execution of pTrapCode. A notify window is created if 'trap' or 'trap:' is sent when pCode is not active, or if 'doonTrapDo' is sent again before the first invocation completes."
fStatusIndicator nil
ifTrue:
[user notify: 'ExceptionHandler is active'] "1".
fStatusIndicator ← 1 "2".
fCode ← pCode "3".
fTrapCode ← pTrapCode "4".
fDoContext ← thisContext "5".
fTrapCondition ← nil "6".
fResult ← true "7".
fCode eval "8".
self release "9".
↑fResult "10" "
1. If fStatusIndicator nil, then the previous invocation of 'doonTrapDo' has not completed properly. Create a notify window in this case.
2. Set fStatusIndicator to indicate pCode is active.
3. Save pCode for execution and restart.
4. Save pTrapCode for later execution.
5. Save the context of 'doonTrapDo' for 'restart' and 'abort'.
6. Initialize the trap condition to nil.
7. Initialize the result of 'doonTrapDo ' to true.
8. Execute pCode.
9. Set fields to nil to release saved contexts.
10. Return fResult (which may have been modified during the execution of pCode or pTrapCode).
"].
"776" ExceptionHandler$'DOCUMENTATION'
[implementationNotes | |
"
FIELDS
fDoContext : a Context that controls the execution of the message 'doonTrapDo'.
fCode : a Context that controls the execution of the statements passed as the first parameter to 'doonTrapDo'.
fTrapCode : a Context that controls the execution of the statements passed as the second parameter to 'doonTrapDo'.
fTrapCondition : the object passed as the parameter to 'trap:'.
fResult : the object that is the result of 'doonTrapDo'.
fPostTrapIndicator : an Integer specifying the action to be taken after fTrapCode is executed.
fStatusIndicator : an Integer specifying the status of 'doonTrapDo'; nil means 'doonTrapDo' has not been invoked, 1 means fCode is active, 0 means fTrapCode is active.
"].
"136" ExceptionHandler$'MISC'
[trapCondition | |
"...returns the condition that was passed as the parameter to 'trap:'."
↑fTrapCondition].
"195" ExceptionHandler$'POST TRAP SPECIFICATION'
[continue | |
"...specifies that the code interrupted by 'trap' or 'trap:' will be continued when the trap code completes."
fPostTrapIndicator ← 2].
"363" ExceptionHandler$'TEST AND DIAGNOSTIC'
[test | guard i |
"ExceptionHandler new test."
guard ← ExceptionHandler new.
user clear.
i ← 0.
guard do [
(user show: i asString.
i ← i + 1.
guard trap: i.
user show: ' end')] onTrapDo [
(i < 10
ifTrue: [guard restart]
ifFalse: [guard continue])].
user show: ' done.'.
user cr.
↑guard result].
"522" ExceptionHandler$'TEST AND DIAGNOSTIC'
[testTransaction | e i max f |
"ExceptionHandler new testTransaction."
e ← ExceptionHandler new.
i ← 0.
max ← 5.
dpj exceptionHandler: e.
dpj open.
f ← dpj file: 'test.test'.
e do [
(f reset.
[f end] whileFalseDo:
[user show: f next inString])] onTrapDo [
(user cr.
user show: 'Juniper not responding'.
f release.
dpj release.
i ← i + 1.
i < max
ifTrue:
[e restart]
ifFalse: [e abort])].
user cr.
user show: 'done'.
f close.
dpj close].
"513" ExceptionHandler$'POST TRAP ACTION (internal)'
[restartCode | |
"...releases the context chain and restarts the block of statements passed as the first parameter to 'doonTrapDo'."
thisContext caller releaseTo: fCode "1".
fCode restart "2".
fCode push: fDoContext "3".
Top run: fCode at: Top currentPriority "4" "
1. Release the context chain from the caller of thisContext up to fCode.
2. Resets the pc and stack pointer of fCode.
3. Push the return context of fCode onto its tempframe.
4. Run fCode.
"].
"664" ExceptionHandler$'POST TRAP ACTION (internal)'
[abortCode | tDoContextCaller |
"...releases the context chain and returns fResult to the caller of 'doonTrapDo'."
tDoContextCaller ← fDoContext caller "1".
thisContext caller releaseTo: tDoContextCaller "2".
self release "3".
tDoContextCaller push: fResult "4".
Top run: tDoContextCaller at: Top currentPriority "5" "
1. Get the caller of 'doonTrapDo'.
2. Release the context chain from the caller of thisContext up to the caller of 'doonTrapDo'.
3. Set fields to nil to clean up pointers to unwanted contexts.
4. Return fResult to the caller of 'doonTrapDo'.
5. Run the caller of 'doonTrapDo'.
"].
"199" ExceptionHandler$'POST TRAP ACTION (internal)'
[release | |
"...resets the exception handler to its initial condition."
fCode ← nil.
fTrapCode ← nil.
fDoContext ← nil.
fStatusIndicator ← nil].
"360" ExceptionHandler$'EXAMPLES'
[loopTest | guard i |
"ExceptionHandler new loopTest."
guard ← ExceptionHandler new.
user clear.
i ← 0.
guard do [
(user show: i asString.
i ← i + 1.
guard trap: i.
user show: ' end')] onTrapDo [
(i < 10
ifTrue: [guard restart]
ifFalse: [guard continue])].
user show: ' done.'.
user cr.
↑guard result].
"307" IDict$'As yet unclassified'
[findorinsert: obj | i |
"insert if not found, "
i ← self findornil: obj.
objects i obj
ifTrue: [↑i].
"found it"
self sparse
ifTrue:
[objects i ← obj.
↑i].
"insert if room"
self growto: objects length * 2 "grow".
↑self findorinsert: obj "and insert"].
"367" IDict$'As yet unclassified'
[findornil: obj | i loc |
"index if found or available slot"
loc ← obj hash \ objects length.
(1 to: objects length) do:
[:i | loc ← (loc = objects length
ifTrue: [1]
ifFalse: [loc + 1]).
objects loc nil
ifTrue: [↑loc].
objects loc obj
ifTrue: [↑loc]].
↑1 "table full - caller must check for hit"].