-
Notifications
You must be signed in to change notification settings - Fork 2
/
0015-Compiler.st
1675 lines (1575 loc) · 60.3 KB
/
0015-Compiler.st
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
'From Smalltalk 5.5k XM November 24 on 22 November 1980 at 2:57:08 am.'
"Decompiler"
Class new title: 'Decompiler'
subclassof: Object
fields: 'method temps instvars literals stack isReference literalNames'
declare: 'breakPC highlight ';
sharing: ByteCodes;
asFollows
This class has not yet been commented
Initialization
decompile: sel class: class | strm block ignore p
[method ← class method: sel.
method length<8⇒[⇑self quickCode: sel class: class]
self initSymbols: class.
stack ← (Vector new: (method◦3)-(method◦5)) asStream.
block ← self block: method◦6+1 to: method length
pc⦂ ignore hasValue⦂ ignore.
stack empty≡false⇒[user notify: 'stack not empty']
self convertMacros: block sel: sel.
strm ← Stream default.
self printPattern: sel on: strm.
strm crtab: 1.
block printon: strm indent: 1 precedence: 0 forValue: false decompiler: self.
[(p←method word: 1)≠0⇒[strm append: ' primitive: '; print: p]].
⇑strm contents asParagraph makeBoldPattern]
findPC: x [breakPC← x. highlight← 1 to: 1]
highlight [⇑highlight]
highlight: x [⇑highlight← x]
Symbols
initSymbols: class | i lit env
["Init temps with made-up names"
temps ← Vector new: method◦5.
for⦂ i to: temps length do⦂
[temps◦i ← 't' + i asString].
instvars ← class instvars.
literals ← MessageDict new literalsIn: method.
literalNames ← Vector new: literals length.
env ← class wholeEnvironment, Smalltalk, Undeclared.
for⦂ i to: literals length do⦂
[lit ← literals◦i.
literalNames◦i ←
[lit is: UniqueString⇒[lit]
lit is: ObjectReference⇒[self invertRef: lit environment: env]
lit≡FieldReference⇒['']
lit asString]]]
instvar: i
[⇑instvars◦(i-codeLoadField+1)]
invertRef: ref environment: env | table n
[for⦂ table from: env do⦂
[n←table invertRef: ref⇒[⇑n]].
⇑'unknown']
literal: i | index lit str
[index ← i-codeLoadLit+1.
lit ← literals◦index. str ← literalNames◦index.
lit is: ObjectReference⇒[⇑str]
(lit is: UniqueString) or⦂ (lit is: Vector)⇒[⇑'↪' + str]
⇑str]
literalIndirect: i
[⇑literalNames◦(i-codeLoadLitInd+1)]
selector: i
[i>166 and⦂ i<208⇒[⇑SpecialOops◦(i-166)]
⇑literalNames◦(i-codeSendLit+1)]
temp: i
[⇑temps◦(i-codeLoadTemp+1)]
Byte Interpretation
block: start to: end pc⦂ pc hasValue⦂ v
| block code byte j stackPos t
["Decompile the method from start to end into a ParsedBlock and return the
instance of ParsedBlock. Assign to pc the value of the pc after leaving
the block. If at run time this block will leave a value on the stack,
set hasValue to true."
block ← ParsedBlock default. pc value← end+1.
stackPos ← stack position.
code ← Stream new of: method from: start to: end.
for⦂ byte from: code do⦂
[byte<0200⇒[self loadByte: byte code: code]
byte<0210⇒[self controlByte: byte code: code block: block]
byte<0214⇒[self loadByte: byte code: code "extended loads"]
byte=0214⇒[self selectorByte: byte code: code at: code position "extended selector"]
byte<0260⇒
[j←self jumpByte: byte code: code block: block.
code end⇒[pc value←j]]
self selectorByte: byte code: code at: code position]
"If there is an additional item on the stack, it will be the value
of this block"
stack position>stackPos⇒
[t←stack pop. v value←true.
block empty and⦂ (t is: ParsedBlock)⇒[⇑t]
block next← t.
⇑block]
v value←false.
[block empty⇒[block next← nil]].
"pretend that returns jump to end of method"
[block returns or⦂ (block◦block position) returns⇒
[pc value← method length+1]].
⇑block]
checkForRemoteCode: jump code: code block: block | m ignore t j b
"Check if this is a jump around remote code."
[jump>code limit⇒[⇑false]
"remote code should terminate with a toEnd, and then a jump back"
method◦(jump-3)≠toEnd⇒[⇑false]
t ← method◦(jump-2).
t<0240 or⦂ t>0243⇒[⇑false]
j ← t-0244*256+(method◦(jump-1)).
jump+j ≠ (code position+1) ⇒[⇑false]
m ← stack pop.
((m isnt: ParsedMessage) or⦂ m rcvr≡toLoadThisCtxt≡false) or⦂
(self selector: m op)≠↪remoteCopy⇒
[stack next← m. ⇑false]
"it's a piece of remote code"
b ← self block: code position+1 to: jump-4
pc⦂ ignore hasValue⦂ ignore.
stack next← ParsedRemote new expr: b.
code position← jump-1]
conditionalJump: elseStart code: code block: block
| cond ifExpr thenExpr elseExpr thenJump elseJump ignore newBlock
hasValue last
[ifExpr ← stack pop.
thenExpr ← self block: code position+1 to: elseStart-1
pc⦂ thenJump hasValue⦂ hasValue.
"ensure jump is within block (in case thenExpr returns)"
thenJump ← thenJump min: code limit+1.
"if jump goes back, then it's a loop"
thenJump<elseStart⇒
[self loop: thenJump whileExpr: ifExpr doExpr: thenExpr
code: code block: block doSize: elseStart-code position-1.
code position← elseStart-1]
elseExpr ← self block: elseStart to: thenJump-1
pc⦂ elseJump hasValue⦂ ignore.
"if elseJump is backwards, it is not part of the elseExpr"
[elseJump<code position⇒
[code position← thenJump-3. last←true]
code position← thenJump-1].
[thenJump+1=code limit "still might be last"
and⦂ (method◦thenJump≥0240 and⦂ method◦thenJump≤0247)⇒
[last←true]].
[thenJump=code limit
and⦂ (method◦thenJump≥0220 and⦂ method◦thenJump≤0227)⇒
[last←true]].
"check for and⦂ or or⦂"
hasValue and⦂ (thenExpr position=1 and⦂ thenExpr◦1≡toLoadTrue)⇒
[stack next← ParsedDisjunct new left: ifExpr right:
[elseExpr position=1⇒[elseExpr◦1] elseExpr] ]
hasValue and⦂ (elseExpr position=1 and⦂ elseExpr◦1≡toLoadFalse)⇒
[stack next← ParsedConjunct new left: ifExpr right:
[thenExpr position=1⇒[thenExpr◦1] thenExpr] ]
"it's an if statement"
cond ← ParsedConditional new
ifExpr: ifExpr thenExpr: thenExpr elseExpr: elseExpr.
"If the then part has a value, put the conditional in a block, and put the
block on the stack. (If the compiler is working right the else part will
leave a value, too ... this is not checked)."
hasValue⇒
[newBlock←ParsedBlock default. newBlock next← cond.
stack next← newBlock]
"If the thenExpr jumps to the end of the current block,
or to a jump backwards at the end of the current block,
or to a ⇑self at the end of the method,
append the cond
to the current block. Otherwise, embed it in a new block."
(code end or⦂ last≡true) or⦂
(thenJump+1=method length and⦂ method◦thenJump=toLoadSelf)⇒
[block next← cond]
newBlock←ParsedBlock default. newBlock next← cond.
block next← newBlock]
controlByte: byte code: code block: block | var t strm
[byte=toSmashPop⇒
[var ← self makeLoad: code next code: code.
block next← ParsedAssignment new var: var expr: stack pop]
byte=toSmash⇒
["smash no pop at the end of a block will require the next byte
to be fetched from after the limit of the block"
code end⇒
[strm ← Stream new of: method from: code limit+1 to: method length.
var ← self makeLoad: strm next code: strm.
block next← ParsedAssignment new var: var expr: stack pop]
var ← self makeLoad: code next code: code.
block next← ParsedAssignment new var: var expr: stack pop.
"uncascade assignment statements"
stack next← var]
byte=toPop⇒
[block next← stack pop]
byte=toReturn⇒
[t ← stack pop.
stack empty≡false⇒[user notify: 'stack not empty']
"elide final ⇑self"
t≡toLoadSelf and⦂ code position=method length⇒[]
block doesReturn.
block next← t]
byte=toEnd⇒
[user notify: 'unexpected']
byte=toLoadThisCtxt⇒
[stack next← byte]
byte=toSuper⇒
[stack pop. "delete ref to self"
stack next← byte]
user notify: 'unknown control byte']
jumpByte: byte code: code block: block | offset j
"If this is an unconditional jump, return the position in the method to which it jumps. If this is a conditional jump forward, parse a conditional statement. Conditional jumps backward are not produced by the current compiler."
[byte<0230⇒["short unconditional jump forward"
⇑byte-0220+code position+2]
byte<0240⇒["short conditional jump forward"
self conditionalJump: byte-0230+code position+2 code: code block: block.
⇑code position+1]
byte<0250⇒["long unconditional jump"
offset ← code next.
j ← byte-0244*256+offset+code position+1.
self checkForRemoteCode: j code: code block: block.
⇑j]
byte<0254⇒[code skip: 1. "long conditional jump backward"
user notify: 'conditional jump backward not expected']
byte<0260⇒["long conditional jump forward"
offset ← code next.
self conditionalJump: byte-0254*256+offset+code position+1
code: code block: block.
⇑code position+1]
user notify: 'not a jump byte']
loadByte: byte code: code | t lit
[t ← self makeLoad: byte code: code.
t≥codeLoadLit and⦂ t<codeLoadLitInd⇒
[lit ← literals◦(t-codeLoadLit+1).
lit≡FieldReference⇒
[self remoteReference: code]
lit is: ObjectReference⇒
[stack next← ParsedObjectReference new var: t]
stack next← t]
stack next← t]
loop: jumpBack whileExpr: whileExpr doExpr: doExpr code: code block: block
doSize: doSize
| n b ignore
["jumpBack will jump to the beginning of whileExpr. In the case of for statements or while's with a block in the condition, the whileExpr should include more than just the last expression. Kludge: find all the statements needed by re-decompiling."
n ← code position-doSize jmpSize.
b ← self block: jumpBack to: n pc⦂ ignore hasValue⦂ ignore.
"discard unwanted statements from block"
block skip: 1-b position.
block next← ParsedLoop new
whileExpr: [b position=1⇒[whileExpr] b] doExpr: doExpr]
makeLoad: byte code: code | offset
["check for extended loads"
byte≥0210 and⦂ byte≤0213⇒
["extended reference codes:
0210 - extended inst
0211 - extended temp
0212 - extended literal
0213 - extended literal indirect"
offset←256*(byte-0207).
⇑code next+offset]
⇑byte asCompilerCode]
remoteReference: code | i obj offset var
[i ← stack pop.
offset ← [i≤124⇒[↪(0 1 2 10)◦(i-120)] literals◦(i-codeLoadLit+1)].
obj ← stack pop.
code skip: 2. "skip new object:offset: "
var ← [obj=toLoadTempframe⇒[codeLoadTemp+offset-1]
obj=toLoadSelf⇒[codeLoadField+offset-1]
user notify: 'bad remote reference'].
stack next← ParsedFieldReference new var: var]
selectorByte: byte code: code at: p | op sel i nArgs args rcvr
["check for extended selector codes"
op ← [byte=toSendLitLong⇒[code next+codeSendLit] byte asCompilerCode].
"find the corresponding selector and the number of args it expects"
sel ← self selector: op.
nArgs ← sel numArgs.
rcvr ← stack pop.
[nArgs=0⇒[args←false]
nArgs=1⇒[args←stack pop]
args ← Vector new: nArgs.
for⦂ i from: nArgs to: 1 by: ¬1 do⦂
[args◦i ← stack pop]].
stack next← ParsedMessage new rcvr: rcvr op: op args: args.
p=breakPC⇒[stack last hasPC]]
Macros
convertMacros: block sel: sel | macros compilerTemps vec loc i
["replace statement patterns with corresponding macros when possible"
macros ← (Vector new: 10) asStream.
"for each temp, compilerTemps is false if it is a user temp, true if it is a
compiler temp, and nil if not yet known"
compilerTemps ← Vector new: temps length.
for⦂ i to: sel numArgs do⦂
[compilerTemps◦i ← false].
block findMacros: macros compilerTemps: compilerTemps.
"insert macros in reverse order to keep indices from being messed up"
vec ← macros contents.
for⦂ i from: vec length-1 to: 1 by: ¬2 do⦂
[vec◦i≡nil⇒[]
vec◦i insertMacro: vec◦(i+1) decompiler: self].
"set names of compiler temps to empty string"
for⦂ i to: temps length do⦂
[compilerTemps◦i≡true⇒[temps◦i ← '']]]
Printing
printPattern: sel on: strm | i n keywords
[n←sel numArgs.
[n=0⇒[strm append: sel; space "unary"]
keywords←sel keywords.
for⦂ i to: keywords length do⦂
[strm append: keywords◦i; space; append: temps◦i; space]].
n=(method◦5)⇒[]
strm append: '| '. "temps beyond args"
for⦂ i from: n+1 to: method◦5 do⦂ [strm append: temps◦i; space]]
quickCode: sel class: class | t strm
[method length=2⇒[⇑sel asParagraph makeBoldPattern]
method length=5⇒
[t ← method◦5.
strm ← Stream default.
strm append: sel; append: ' [⇑'; append: class instvars◦(t+1); append: ']'.
⇑strm contents asParagraph makeBoldPattern]
⇑'undeciperable method' asParagraph]
SystemOrganization classify: ↪Decompiler under: 'Compiler'.
"Generator"
Class new title: 'Generator'
subclassof: Object
fields: 'literals nTemps maxTemp local environment parser supered root requestor sourceStream sourceParagraph'
declare: '';
sharing: ByteCodes;
asFollows
I generate code parsed by parser. The symbol tables I use are local and environment. The run-time needs of the code are recorded in literals, nTemps, and maxTemp. If a message was passed to super, then supered is true. I remember my root context to abort in case of error.
Services
compile: sourceParagraph in: class under: category notifying: requestor | selector
[user displayoffwhile⦂
[sourceStream ← sourceParagraph asStream.
selector ← self compileIn: class⇒
[class organization classify: selector under: category]].
⇑selector]
evaluate: sourceStream in: context to: receiver notifying: requestor
| method nvars value tframe
[method ← user displayoffwhile⦂ [self evaluateIn: context to: receiver].
root≡true≡false⇒ [⇑method] "compilation failed, return false or corrected value"
nvars ← nTemps.
context⇒ "frame copy here because interpret loses control"
[tframe ← context tempframe◦(1 to: nvars) copyto: (Vector new: method◦3).
value ← context interpret: method with: tframe.
tframe◦(1 to: nvars) copyto: context tempframe.
⇑value]
⇑Context new have: receiver interpret: method]
Errors
abortWith: errorString | mySender
[[WhatFlag⇒ [user notify: errorString]].
mySender ← thisContext swapSender: root sender.
root sender ← nil. root ← nil. parser terminate.
mySender release. mySender ← nil.
user restoredisplay.
⇑requestor notify: errorString at: sourceStream position in: sourceStream]
"Parser notify"
notify: errorString
[parser notify: errorString]
"ParsedObjectReference remote"
terminate
[root ← nil]
"Parser terminate"
Code generation
compileIn: class
| block method nargs selector primitive
[parser ← Parser new. root ← thisContext. parser from: sourceStream to: self.
self initSymbols: class.
block ← ParsedBlock default.
selector ← parser pattern: block. nargs ← nTemps.
parser temporaries: block. primitive ← parser body: block.
parser mustBeDone. parser ← nil.
block mustReturn: true "defaults to ⇑self".
[method ← [primitive=0 and⦂ nargs=0⇒ [block quickCode] false]⇒ []
method ← self generate: block in: class.
method◦2 ← primitive; ◦4 ← nargs].
class install: selector method: method literals: literals
code: [sourceParagraph is: Paragraph⇒ [sourceParagraph]
sourceStream asArray] backpointers: nil.
[HuhFlag⇒ [Huh←nil. Huh ← (self decompile: method onto: Stream default) contents. HuhFlag←false]].
⇑selector]
"compile"
decompile: method onto: s
[method length<6⇒
[s append: 'Quick code: '; append: method asBytes. ⇑s]
s print: method◦4; append: ' args; ';
print: method◦5; append: ' temps; ';
print: (method◦3) - (method◦5); append: ' stack; ';
print: (method◦6) -6 /2; append: ' literals; '.
[(method◦2) > 0⇒ [s append: ' primitive: '; print: method◦2; append: ';']].
s print: method length; append: ' bytes total.'; cr.
method◦2 = 40⇒ [⇑s]
⇑self decompileBytes: method onto: s]
decompileBytes: method onto: s
| dict x i c m t
[dict ← Dictionary new init: 64.
dict insertall: ((128 to: 131) copy, 125 concat: (144 to: 175) copy)
with: ↪(
'←^' '←' '^' '⇑' 'end'
'jmp1' 'jmp2' 'jmp3 ' 'jmp4' 'jmp5' 'jmp6' 'jmp7' 'jmp8'
'bfp1' 'bfp2' 'bfp3 ' 'bfp4' 'bfp5' 'bfp6' 'bfp7' 'bfp8'
'jmp' 'jmp' 'jmp' 'jmp' 'jmp' 'jmp' 'jmp' 'jmp'
'bfp' 'bfp' 'bfp' 'bfp' 'bfp' 'bfp' 'bfp' 'bfp').
for⦂ x from: local contents do⦂
[i←local◦x. t ← i land: 255.
[i>255 and⦂ t<16⇒ [i←((i lshift: ¬8)-1 lshift: 4) + t]].
dict insert: i with: x].
for⦂ x from: stdSelectors contents do⦂
[dict insert: stdSelectors◦x with: [x is: Integer⇒ [x inString] x]].
for⦂ i to: 5 do⦂ [dict insert: toLoadConst+i-1 with: ↪('¬1' '0' '1' '2' '10')◦i].
for⦂ t from: (m ← (method◦(method◦6 +1 to: method length)) asStream) do⦂
[[t≥toLoadFieldLong and⦂ t≤toSendLitLong⇒ [t←((t-0207) lshift: 8)+ m next]].
[c ← dict lookup: t⇒ [s append: c] s append: '#'. s append: t base8].
s space.
t < toLongJmp⇒ [] t ≥ 0260⇒ []
s print: t\8 -4 *256 + m next; space].
s cr.
⇑s]
evaluateIn: context to: receiver
| block method class nvars
[ "If context is false, receiver will evaluate in top level"
block ← ParsedBlock default.
parser ← Parser new. root ← thisContext.
parser from: sourceStream to: self.
[context⇒
[self initSymbols: (class ← context mclass).
context variableNamesInto: self with: ParsedBlock default.
nvars ← nTemps.
root ← thisContext. "because variableNamesInto nil'ed it"]
self initSymbols: (class ← receiver class)].
parser temporaries: block; statements: block; mustBeDone. parser ← nil.
block mustReturn: false "returns last value".
method ← self generate: block in: class.
[HuhFlag⇒ [Huh←nil. Huh ← (self decompile: method onto: Stream default) contents. HuhFlag←false]].
root ← true. "to signify success"
nTemps ← nvars.
⇑method]
"evaluate"
generate: block in: class
| header method code lit stack
[[(lit ← literals find: nil)>0⇒ [literals ← (literals◦(1 to: lit-1)) copy]].
[supered⇒ [literals ← literals, (Smalltalk ref: class title unique)]].
header ← 6 + (2* literals length).
code ← (method ← String new: header + block sizeForValue) asStream.
code
next ← 0; next ← 0; next ← 0;
next ← 0; next ← maxTemp; next ← header.
for⦂ lit from: literals do⦂
[code next ← lit PTR lshift: ¬8; next ← lit PTR land: 0377].
stack ← ParseStack init.
block emitForValue: code on: stack.
[stack position≠1⇒ [user notify: 'Compiler stack discrepancy']].
[code position≠method length⇒ [user notify: 'Compiler code size discrepancy']].
method◦3 ← maxTemp + stack length.
⇑method] "compile|evaluate"
Parse tree
assignment: var expr: expr
[⇑ParsedAssignment new var: var expr: expr]
"Parser expression"
block
[⇑ParsedBlock default]
"Parser primary|Parser alternatives"
evalKeyword: arg
[⇑arg]
"Parser keywordMessage"
ifExpr: ifExpr thenExpr: thenExpr elseExpr: elseExpr
[⇑ParsedConditional new ifExpr: ifExpr thenExpr: thenExpr elseExpr: elseExpr]
"ifthen...|Parser alternatives"
keywordMessage: rcvr selector: sel args: args
[sel='and⦂'⇒
[⇑ParsedConjunct new left: rcvr right: args local];
= 'or⦂'⇒
[⇑ParsedDisjunct new left: rcvr right: args local]
⇑self rcvr: rcvr selector: sel args: (args remote: self)]
"Parser keywordMessage"
noEvalKeyword: arg
[⇑arg asRemoteCode: self]
"Parser keywordMessage"
nullStatement: block
[block next ← toLoadNil. ⇑block]
"ifthen|Parser statements"
rcvr: rcvr selector: sel args: args
[[rcvr≡toSuper⇒ [supered←true]].
⇑ParsedMessage new rcvr: rcvr op: (self encodeSel: sel) args: args]
"loop|keywordMessage|Parser binaryMessage|Parser unaryMessage"
receivingVar: expr | rcvr var "who in expr is cascade recipient"
[rcvr ← expr emittedReceiver⇒
[var ← rcvr emittedVariable⇒ [⇑var]
var ← self newTemp. "if a non-variable, compute it just once"
expr emittedReceiver ← ParsedAssignment new var: var expr: rcvr.
⇑var]
parser notify: 'MAY ONLY FOLLOW A MESSAGE']
"Parser cascade"
variable: name
| var global ref unq
[var ← local lookup: name⇒ [⇑var]
[unq ← name hasBeenUniqued⇒
[for⦂ global from: environment do⦂
[ref ← global lookupRef: unq⇒
[⇑codeLoadLitInd + (self litIndex: ref)]]]].
requestor interactive⇒
[parser notify: '➲Smalltalk declare: ↪' + name + ' as: nil➲TO DECLARE GLOBAL']
user show: ' (' + name + ' is Undeclared) '.
unq ← name unique.
Undeclared declare: unq.
⇑codeLoadLitInd + (self litIndex: (Undeclared ref: unq))]
"Parser expression|Parser primary"
Macros
for: var from: startMinus1 to: stop do: ritual on: block | temp
[temp ← self newTempForMacro.
"temp←stop. var←startMinus1. while⦂ temp≥(var ← 1+var) do⦂ ritual"
block next ← ParsedAssignment new var: temp expr: stop;
next ← ParsedAssignment new var: var expr: startMinus1;
next ← ParsedLoop new
whileExpr:
(ParsedMessage new rcvr: temp op: toGeq args:
(ParsedAssignment new var: var
expr: (ParsedMessage new rcvr: toLoad1 op: toPlus args: var)))
doExpr: ritual]
"for...todoargs"
forfromdo: block args: args | var sequence ritual strm
[var ← (args◦1) local. sequence ← args◦2. ritual ← (args◦3) local.
strm ← self newTempForMacro.
"strm ← sequence asStream. while⦂ (var ← strm next) do⦂ ritual"
block next ← ParsedAssignment new var: strm
expr: (ParsedMessage new rcvr: sequence op: toAsStream args: false);
next ← ParsedLoop new
whileExpr:
(ParsedAssignment new var: var
expr: (ParsedMessage new rcvr: strm op: toNext args: false))
doExpr: ritual]
"macro (perform)"
forfromtobydo: block args: args
["for⦂ var from: (start to: stop by: step) do⦂ ritual"
args◦2 ← self rcvr: args◦2 selector: 'to:by:' args: (args◦(3 to: 4)) copy.
self forfromdo: block args: (args◦↪(1 2 5)) copy]
"macro (perform)"
forfromtodo: block args: args
[self for: (args◦1) local
from: (ParsedMessage new rcvr: args◦2 op: toMinus args: toLoad1)
to: args◦3
do: (args◦4) local
on: block]
"macro (perform)"
fortodo: block args: args
[self for: (args◦1) local
from: toLoad0
to: args◦2
do: (args◦3) local
on: block]
"macro (perform)"
ifthen: block args: args
[block next ← self ifExpr: (args◦1) local thenExpr: (args◦2) local elseExpr: (self nullStatement: ParsedBlock default)]
"macro (perform)"
ifthenelse: block args: args
[block next ← self ifExpr: (args◦1) local thenExpr: (args◦2) local elseExpr: (args◦3) local]
"macro (perform)"
macro: block selector: sel args: args
| special
[special ← inLineMsgs lookup: sel⇒
[self perform: special with: block with: args]
Context canunderstand: sel unique⇒
[block next ← self rcvr: toLoadThisCtxt selector: sel args: (args remote: self)]
⇑false]
"Parser keywordMessage"
untildo: block args: args
[block next ← ParsedLoop new whileExpr: (ParsedNegation new rcvr: (args◦1) local op: toEq args: toLoadFalse) doExpr: (args◦2) local]
"macro (perform)"
whiledo: block args: args
[block next ← ParsedLoop new whileExpr: (args◦1) local doExpr: (args◦2) local]
"macro (perform)"
Table maintenance
balance
[⇑nTemps]
"Parser cascade"
comment: s
"Class fieldNamesInto"
contents
"Class fieldNamesInto"
declaration: block name: name asArg: asArg
| permVar tempVar
[tempVar ← self newTemp.
permVar ← local lookup: name ⇒
[asArg and⦂ permVar isField⇒
[block next ← ParsedAssignment new var: permVar expr: tempVar]
parser notify: 'NAME ALREADY IN USE']
local insert: name with: tempVar]
"Parser declaration|temporaries"
encodeSel: sel
| code
[code ← stdSelectors lookup: sel⇒ [⇑code]
⇑codeSendLit+ (self litIndex: [sel class≡Integer⇒ [UST1◦(sel+1)] sel unique])]
"rcvr|ParsedFieldReference remote|ParsedRemote remote"
identifier: s
[local insert: s with: (nTemps ← nTemps + 1)]
"Class fieldNamesInto"
initSymbols: class | s
[environment ← class wholeEnvironment, Smalltalk.
local ← Dictionary new copyfrom: stdPrimaries.
nTemps ← codeLoadField-1.
for⦂ s from: class instvars do⦂
[local insert: s with: (nTemps ← nTemps + 1)].
nTemps ← maxTemp ← 0. literals ← Vector new: 123. supered ← false]
"compile|evaluate"
juggle | oldTemps
[oldTemps ← maxTemp. maxTemp ← nTemps. ⇑oldTemps]
"Parser macro"
literal: x | i
[[x class≡Integer⇒ [0≠(i←↪(¬1 0 1 2 10) find: x)⇒ [⇑toLoadConst+i-1]]].
⇑codeLoadLit + (self litIndex: x)]
"Parser primary|ParsedFieldReference remote"
litIndex: oop | i t
[for⦂ i to: 123 do⦂
[(t ← literals◦i)≡nil⇒ [literals◦i←oop. ⇑i-1]
t class≡oop class⇒ [t sameAs: oop⇒ [⇑i-1]]].
parser notify: 'MORE THAN 123 LITERALS REFERENCED']
"encodeSel|literal"
newTemp
[(nTemps ← nTemps+1) > maxTemp and⦂ (maxTemp ← nTemps) > 256⇒
[parser notify: 'MORE THAN 256 TEMPS REQUIRED']
⇑codeLoadTemp + nTemps-1]
"receivingVar|declaration"
newTempForMacro "juggle arranged that maxTemp are needed by args of macro"
[nTemps ← maxTemp. ⇑self newTemp]
"forfromdo|forfromtodo"
separator: c
"Class fieldNamesInto"
trailer: s
"Class fieldNamesInto"
unbalance: nTemps
"Parser cascade"
unjuggle: oldTemps
[maxTemp ← oldTemps max: maxTemp]
"Parser macro"
SystemOrganization classify: ↪Generator under: 'Compiler'.
"ParsedAssignment"
Class new title: 'ParsedAssignment'
subclassof: Object
fields: 'var expr elide'
declare: '';
sharing: ByteCodes;
asFollows
I am a node in a compiler parse tree. I represent an assignment of an expression to a variable.
Initialization
var: var expr: expr
Code generation
emitForEffect: code on: stack
[expr emitForValue: code on: stack. stack pop: 1.
elide⇒ ["var begins the next statement" code next ← toSmash]
code next ← toSmashPop.
var emitBytes: code]
emitForValue: code on: stack
[expr emitForValue: code on: stack.
code next ← toSmash.
var emitBytes: code]
emittedVariable
[⇑var]
firstPush
[⇑expr firstPush]
sizeForEffect: nextPush
[⇑expr sizeForValue + 1 + [elide ← nextPush≡var⇒ [0] var sizeForValue]]
sizeForValue
[⇑expr sizeForValue + 1 + var sizeForValue]
Miscellaneous
printon: s
[s append: '('; print: var; append: '←'; print: expr; append: ')']
Decompiling
expr [⇑expr]
findMacros: macros compilerTemps: compilerTemps
[var findMacros: macros compilerTemps: compilerTemps.
expr findMacros: macros compilerTemps: compilerTemps]
isForFromInit: loop | cond b nextMess
["return true if I could be the first initialization statement for a
for⦂ from: loop."
(expr isnt: ParsedMessage) or⦂ expr op≠toAsStream⇒[⇑false]
loop isnt: ParsedLoop⇒[⇑false]
b ← loop whileExpr.
(b isnt: ParsedBlock) or⦂ b position≠2⇒[⇑false]
b◦1 isnt: ParsedAssignment⇒[⇑false]
nextMess ← (b◦1) expr.
nextMess isnt: ParsedMessage⇒[⇑false]
nextMess rcvr≠var or⦂ nextMess op≠toNext⇒[⇑false]
⇑true]
isForFromToInit: start loop: loop | b incr test
["return true if I could be the first initialization statement for a
for⦂ to: do⦂ or a for⦂ from: to: do⦂ loop"
"I should set the upper bound, start should set the var to start-1"
(start isnt: ParsedAssignment) or⦂ (loop isnt: ParsedLoop)⇒[⇑false]
[start expr≡toLoad0⇒[]
start expr isnt: ParsedMessage⇒[⇑false]
start expr op≠toMinus or⦂ start expr args≠toLoad1⇒[⇑false]].
"the loop condition should increment the var and compare it with the
upper bound"
b ← loop whileExpr.
(b isnt: ParsedBlock) or⦂ b position≠2⇒[⇑false]
incr ← b◦1.
incr isnt: ParsedAssignment⇒[⇑false]
incr var≠start var⇒[⇑false]
(incr expr isnt: ParsedMessage) or⦂ incr expr op≠toPlus⇒[⇑false]
incr expr rcvr≠toLoad1 or⦂ incr expr args≠start var⇒[⇑false]
test ← b◦2.
test isnt: ParsedMessage⇒[⇑false]
(test rcvr≠var or⦂ test op≠toGeq) or⦂ test args≠incr var⇒[⇑false]
⇑true]
printon: strm indent: level precedence: p forValue: v decompiler: decompiler
[ [p>1⇒[strm append: '(']].
var printon: strm indent: level precedence: 1
forValue: true decompiler: decompiler.
strm append: ' ← '.
expr printon: strm indent: level+2 precedence: 1
forValue: true decompiler: decompiler.
p>1⇒[strm append: ')']]
var [⇑var]
SystemOrganization classify: ↪ParsedAssignment under: 'Compiler'.
"ParsedBlock"
Class new title: 'ParsedBlock'
subclassof: Stream
fields: 'returns'
declare: '';
sharing: ByteCodes;
asFollows
I am a stream to collect the statements of a block and then to become a node in a compiler parse tree.
Initialization
default
[limit ← 1. array ← Vector new: 1. position ← 0. returns ← false]
doesReturn
[returns ← true]
mustReturn: fromMethod
[returns⇒ []
[fromMethod⇒
[position>0 and⦂ (array◦position) emitsLoad⇒ [array◦position ← toLoadSelf] self next ← toLoadSelf]].
self doesReturn]
Code generation
emitForEffect: code on: stack
[returns⇒ [self emitForValue: code on: stack. stack pop: 1]
self emitExceptLast: code on: stack.
(array◦position) emitForEffect: code on: stack]
emitForValue: code on: stack
[self emitExceptLast: code on: stack.
(array◦position) emitForValue: code on: stack.
returns⇒ [code next ← toReturn]]
firstPush
[⇑(array◦1) firstPush]
sizeForEffect: nextPush
[returns⇒ [⇑self sizeForValue]
⇑self sizeExceptLast + ((array◦position) sizeForEffect: nextPush)]
sizeForTruth: trueSkip falsity: falseSkip
[returns⇒ [⇑self sizeForValue]
⇑self sizeExceptLast + (array◦position sizeForTruth: trueSkip falsity: falseSkip)]
sizeForValue
[⇑self sizeExceptLast + (array◦position) sizeForValue + [returns⇒ [1] 0]]
Miscellaneous
printon: s | i
[s append: '['.
for⦂ i to: position-1 do⦂ [s print: (array◦i); append: '. '].
[returns⇒ [s append: '⇑']].
[position>0⇒ [s print: (array◦position)]].
s append: ']']
quickCode | t v
[position=1 and⦂ (returns and⦂ (v←array◦1) emitsLoad)⇒
[v=toLoadSelf⇒ [t ← String new: 2. t◦1←0; ◦2←1. ⇑t]
v isField⇒
[t ← String new: 5. t◦1←0; ◦2←40; ◦3←0; ◦4←0; ◦5←v. ⇑t]
⇑false]
⇑false]
returns
[⇑returns]
Private
emitExceptLast: code on: stack
| i
[for⦂ i to: position-1 do⦂ [(array◦i) emitForEffect: code on: stack]]
sizeExceptLast
| i next nextPush size
[size ← 0. next ← array◦position.
for⦂ i to: position-1 do⦂
[nextPush ← next firstPush. next ← array◦(position-i).
size ← size + (next sizeForEffect: nextPush)].
⇑size]
Decompiling
findMacros: macros compilerTemps: compilerTemps | i s t
"Look for for statements. If one of my statements is the init statement for a for, append myself and the index of that statement to the stream macros. Mark its compiler-generated temp. If the temp is subsequently used before being re-assigned, the pattern can't be a for after all, and will be deleted from macros."
[for⦂ i to: position do⦂
[s ← array◦i.
(s isnt: ParsedAssignment) or⦂
(s var<codeLoadTemp or⦂ s var>(codeLoadTemp+255))⇒ "not a for"
[s findMacros: macros compilerTemps: compilerTemps]
t ← s var-codeLoadTemp+1.
i≤(position-2) and⦂ (s isForFromToInit: array◦(i+1) loop: array◦(i+2))⇒
[macros next← self; next← i.
compilerTemps◦t ← true.
"check other parts of the for"
s expr findMacros: macros compilerTemps: compilerTemps.
array◦(i+1) findMacros: macros compilerTemps: compilerTemps.
(array◦(i+2)) doExpr findMacros: macros compilerTemps: compilerTemps.
i ← i+2]
i≤(position-1) and⦂ (array◦i isForFromInit: array◦(i+1))⇒
[macros next← self; next← i.
compilerTemps◦t ← true.
s expr findMacros: macros compilerTemps: compilerTemps.
(array◦(i+1)) doExpr findMacros: macros compilerTemps: compilerTemps.
i ← i+1]
s findMacros: macros compilerTemps: compilerTemps]]
insertMacro: loc decompiler: decompiler | macro n i
["create a parsed for loop, and replace the old statements by it"
macro ← ParsedForLoop new block: self loc: loc decompiler: decompiler.
array◦loc ← macro.
n ← macro nStatements.
for⦂ i from: loc+n to: position do⦂
[array◦(i-n+1) ← array◦i].
position ← position-n+1]
printon: strm indent: level precedence: p forValue: v decompiler: decompiler | i
["ignore precedence, since the block is enclosed in brackets"
position=0⇒[strm append: '[]' ]
strm append: '['.
for⦂ i to: position-1 do⦂
[array◦i printon: strm indent: level precedence: 0
forValue: false decompiler: decompiler.
strm append: '.'; crtab: level].
[returns⇒[strm append: '⇑']].
array◦position printon: strm indent: level precedence: 0
forValue: (returns or⦂ v) decompiler: decompiler.
strm append: ']' ]
As yet unclassified
emitForTruth: trueSkip falsity: falseSkip into: code on: stack
[returns⇒ [self emitForValue: code on: stack]
self emitExceptLast: code on: stack.
(array◦position) emitForTruth: trueSkip falsity: falseSkip into: code on: stack]
SystemOrganization classify: ↪ParsedBlock under: 'Compiler'.
"ParsedConditional"
Class new title: 'ParsedConditional'
subclassof: Object
fields: 'ifExpr thenExpr elseExpr thenSize elseSize jmpSize'
declare: '';
asFollows
I am a node in a compiler parse tree. I represent a condition and two alternatives.
Initialization
ifExpr: ifExpr thenExpr: thenExpr elseExpr: elseExpr
Code generation
emitForEffect: code on: stack
[ifExpr emitForValue: code on: stack.
thenSize emitBfp: code on: stack.
thenExpr emitForEffect: code on: stack.
[jmpSize>0⇒ [elseSize emitJmp: code on: stack]].
elseExpr emitForEffect: code on: stack]
emitForValue: code on: stack
[ifExpr emitForValue: code on: stack.
thenSize emitBfp: code on: stack.
thenExpr emitForValue: code on: stack.
stack pop: 1.
[jmpSize>0⇒ [elseSize emitJmp: code on: stack]].
elseExpr emitForValue: code on: stack]
firstPush
[⇑ifExpr firstPush]
sizeForEffect: nextPush
[elseSize ← elseExpr sizeForEffect: nextPush.
jmpSize ← [thenExpr returns⇒ [0] elseSize jmpSize].
thenSize ← (thenExpr sizeForEffect: ¬1) + jmpSize.
⇑ifExpr sizeForValue + thenSize bfpSize + thenSize + elseSize]
sizeForValue
[elseSize ← elseExpr sizeForValue.
jmpSize ← [thenExpr returns⇒ [0] elseSize jmpSize].
thenSize ← thenExpr sizeForValue + jmpSize.
⇑ifExpr sizeForValue + thenSize bfpSize + thenSize + elseSize]
Miscellaneous
printon: s
[s append: 'if⦂ '; print: ifExpr; append: 'then⦂ '; print: thenExpr; append: 'else⦂ '; print: elseExpr]
returns
[⇑thenExpr returns and⦂ elseExpr returns]
Decompiling
findMacros: macros compilerTemps: compilerTemps
[ifExpr findMacros: macros compilerTemps: compilerTemps.
thenExpr findMacros: macros compilerTemps: compilerTemps.
elseExpr findMacros: macros compilerTemps: compilerTemps]
printon: strm indent: level precedence: p forValue: v decompiler: decompiler
| pos char
[ifExpr printon: strm indent: level precedence: 0
forValue: true decompiler: decompiler.
strm append: ' ⇒'.
[thenExpr position>1 or⦂ (thenExpr◦1 is: ParsedConditional)⇒
[strm crtab: level+1] strm space].
thenExpr printon: strm indent: level+1 precedence: 0
forValue: v decompiler: decompiler.
elseExpr position=1 and⦂ elseExpr last≡nil⇒[]
strm crtab: level.
"Kludge!! Delete brackets around else block"
pos←strm position. char←strm pop.
elseExpr printon: strm indent: level precedence: 0
forValue: v decompiler: decompiler.
strm skip: ¬1. strm◦pos←char]
SystemOrganization classify: ↪ParsedConditional under: 'Compiler'.
"ParsedConjunct"
Class new title: 'ParsedConjunct'
subclassof: Object
fields: 'left right rightSize'
declare: '';
sharing: ByteCodes;
asFollows
I am a node in a compiler parse tree. I represent (left and⦂ right) and try to optimize the code generation thereof.
Initialization
left: left right: right
Code generation
emitForEffect: code on: stack
[left emitForValue: code on: stack.
rightSize emitBfp: code on: stack.
right emitForEffect: code on: stack]
emitForTruth: trueSkip falsity: falseSkip into: code on: stack
[left emitForTruth: 0 falsity: rightSize+falseSkip into: code on: stack.
right emitForTruth: trueSkip falsity: falseSkip into: code on: stack]
emitForValue: code on: stack
[left emitForValue: code on: stack.
rightSize emitBfp: code on: stack.
right emitForValue: code on: stack.
1 emitJmp: code on: stack.
code next ← toLoadFalse]
firstPush
[⇑left firstPush]
sizeForEffect: nextPush
[rightSize ← right sizeForEffect: ¬1.
⇑left sizeForValue + rightSize bfpSize + rightSize]
sizeForTruth: trueSkip falsity: falseSkip
[rightSize ← right sizeForTruth: trueSkip falsity: falseSkip.
⇑(left sizeForTruth: 0 falsity: rightSize+falseSkip) + rightSize]
sizeForValue
[rightSize ← right sizeForValue + 1.
⇑left sizeForValue + rightSize bfpSize + rightSize + 1]
Miscellaneous
emittedReceiver
[⇑left]
emittedReceiver ← left
printon: s
[s append: '('; print: left; append: ' and⦂ '; print: right; append: ')']
Decompiling
findMacros: macros compilerTemps: compilerTemps
[left findMacros: macros compilerTemps: compilerTemps.
right findMacros: macros compilerTemps: compilerTemps]
printon: strm indent: level precedence: p forValue: v decompiler: decompiler
[ [p≥2⇒[strm append: '(']].
left printon: strm indent: level precedence: 2
forValue: true decompiler: decompiler.
strm append: ' and⦂ '.
right printon: strm indent: level precedence: 2
forValue: v decompiler: decompiler.
p≥2⇒[strm append: ')']]
SystemOrganization classify: ↪ParsedConjunct under: 'Compiler'.
"ParsedDisjunct"
Class new title: 'ParsedDisjunct'
subclassof: Object
fields: 'left right rightSize'
declare: '';
sharing: ByteCodes;
asFollows
I am a node in a compiler parse tree. I represent (left or⦂ right) and try to optimize the code generation thereof.
Initialization
left: left right: right
Code generation
emitForEffect: code on: stack
[left emitForValue: code on: stack.
rightSize jmpSize emitBfp: code on: stack.
rightSize emitJmp: code on: stack.
right emitForEffect: code on: stack]
emitForTruth: trueSkip falsity: falseSkip into: code on: stack
[left emitForTruth: rightSize+trueSkip falsity: 0 into: code on: stack.