Elliott 803 Algol 60 Compiler (reconstructed)

File: stack.t2

For general comments see here
LineAddressObject Code LabelF1N1BF2N2CommentsCheck
1 0  ; tape2/stack.t2
2 0  ;--------------------------------------------------------------------
3 0  ; enter block
4 0  ;
5 0  =6776+ 
6 6776+ EnterBlock:; 
7 6776+0600027 lod stkpt   ;stack pointer
8 6777 1000142400000 exa frmpt/sto 0;save at frame address @6777
9 6778 0040000 o02 0   ;=1 @6778
10 6778+0760027 o37 stkpt   ;decrement stack ptr
11 6779   call     ;set up entry points, if needed @6779
11+16779 7300041000011 lnk CheckStack.lnk:jmp CheckStack.ent 
12 6780 1015212 jmp CkoRet   ;check for oflo, then return @6780
13 6780+ ;
14 6780+0000017 o00 +15   ;in-line constant??? not referenced
15 6781  ;
16 6781 1000000L6781:jmp Return   ;no refs, apart from ssymtab??? @6781
17 6781+ ;--------------------------------------------------------------------
18 6781+ ; leave block
19 6781+ ;
20 6781+ LeaveBlock:; 
21 6781+0600030 lod frmpt   ;
22 6782 2000136600000 sto stkpt/lod 0; @6782
23 6783 0400030 sto frmpt   ; @6783
24 6783+1015212 jmp CkoRet   ;
25 6784  ;--------------------------------------------------------------------
26 6784  ; copy array parameter called by value
27 6784  ;
28 6784  CopyVArray:; 
29 6784 2000066577777 sto Link1/lod -1; @6784
30 6785 2000072600000 sto arg1/lod 0; @6785
31 6786 1220024 srl 20   ;number of words involved @6786
32 6786+0435121 stn W6737   ;store (negated)
33 6787 0455121 inc W6737   ;add one for loop @6787
34 6787+0160027 bus stkpt   ;make space on stack
35 6788 0400027 sto stkpt   ;store updated stack pointer @6788
36 6788+0415122 sto W6738   ;and work pointer for copy
37 6789   call     ;make sure there's room @6789
37+16789 7300041000011 lnk CheckStack.lnk:jmp CheckStack.ent 
38 6790  cva1:; 
39 6790 2200066577776 inc Link1/lod -2;fetch word @6790
40 6791 2264512400000 inc W6738/sto 0;and store it @6791
41 6792 0655121 lis W6737   ;bump counter @6792
42 6792+1035206 jn cva1   ;loop back until done
43 6793 0600027 lod stkpt   ;base address @6793
44 6793+0115141 add W6753   ;=2 for array pointer
45 6794  CkoRet:; 
46 6794 1060013 jo IntOflo   ;check for overflows @6794
47 6794+1000024 jmp return   ;and return
48 6795  ;--------------------------------------------------------------------
49 6795  ; allocate array, parameters in-line
50 6795  ;
51 6795  AllocArray::; 
52 6795  AllocArray:; 
53 6795 2200006600000 inc T2Link/lod 0; @6795
54 6796 0400015 sto Link1   ; @6796
55 6796+0075137 and W6751   ;=8191
56 6797 0200015 exa Link1   ;array address @6797
57 6797+1220015 srl 13   ;shift right to get number of subs
58 6798 0400016 sto arg1   ;save, temp @6798
59 6798+0075140 and W6752   ;=077, mask off number
60 6799 0435120 stn W6736   ;save it, (negated) @6799
61 6799+0560027 o27 stkpt   ;make space on stack for BL
62 6800 2700136400000 o27 stkpt/sto 0;and store number @6800
63 6801 0455120 inc W6736   ;bump count @6801
64 6801+0600016 lod arg1   ;get saved bit
65 6802 1220007 srl 7   ;get N1 part of word @6802
66 6802+0420016 stn arg1   ;save, (negated)
67 6803 0600027 lod stkpt   ;get stack pointer @6803
68 6803+0415121 sto W6737   ;save it
69 6804 0040000 o02 0   ;=1 @6804
70 6804+0415122 sto W6738   ;
71 6805  ;L6805:
72 6805  .aa1:; 
73 6805 2200006600000 inc T2Link/lod 0;get bound item @6805
74 6806 0415123 sto W6739   ; @6806
75 6806+0415126 sto W6742   ;
76 6807 1200024 sra 20   ;get lower bound @6807
77 6807+0415124 sto W6740   ;save it
78 6808 1115265 jmp .aa2   ;jump out to patch @6808
79 6808+ ; displaced code:
80 6808+ =6837+ 
81 6837+ .aa2:; 
82 6837+1360000 ara 0   ;get upper bound back
83 6838 1320002 sll 2   ; adjust scale?
84 6838+1115230 jmp .aa3    
85 6839  ;L6808P:
86 6839  =6808+ 
87 6808+ .aa3:; 
88 6808+0415125 sto W6741   ;
89 6809 0615137 lod W6751   ;=+8191 @6809
90 6809+0475123 ans W6739   ;clean up upper bound
91 6810 0475124 ans W6740   ;clean up lower bound @6810
92 6810+0615126 lod W6742   ;original bound item
93 6811 1035260 jn .aa10   ; @6811
94 6811+1320001 sll 1   ;
95 6812 1035262 jn .aa11   ; @6812
96 6812+ .aa4:; 
97 6812+ ;L6812P:
98 6812+0615124 lod W6740   ;lower bound
99 6813  .aa5:; 
100 6813  ;L6813:
101 6813 2264506400000 inc W6737/sto 0;store in bound list @6813
102 6814 0615125 lod W6741   ; @6814
103 6814+1035263 jn .aa12   ;
104 6815 1320001 sll 1   ; @6815
105 6815+1135264 jn .aa13   ;
106 6816  .aa6:; 
107 6816  ;L6816:
108 6816 0055123 o02 W6739   ;upper bound + 1 @6816
109 6816+ .aa7:; 
110 6816+ ;L6816P:
111 6816+0135124 sub W6740   ;less lower bound == stride
112 6817 2264506400000 inc W6737/sto 0;store in bound list @6817
113 6818 1120011 jn SubOflo   ;mustn't be < 0 @6818
114 6818+1255122 mul W6738   ;calculate space requirement
115 6819 1360000 ara 0   ; @6819
116 6819+0415122 sto W6738   ;and store
117 6820 0655120 lis W6736   ;more subscripts? @6820
118 6820+1035225 jn .aa1   ;yes, loop back
119 6821  ;
120 6821 0055122 o02 W6738   ;total size requirement+1 @6821
121 6821+1320024 sll 20   ;move to N1 position
122 6822 0000136500000 o00 stkpt/ads 0;store in stack @6822
123 6823 0640027 lis stkpt   ;bump stack @6823
124 6823+0415121 sto W6737   ;save pointer
125 6824  .aa8:; 
126 6824  ;L6824:
127 6824 0055122 o02 W6738   ;size required+1 @6824
128 6824+0160027 bus stkpt   ;subtract from stack ptr
129 6825 2200066377777 inc Link1/sto -1;store info variable @6825
130 6826 0400027 sto stkpt   ;store updated stack pointer @6826
131 6826+0120031 sub lomem   ;lower limit of used memory
132 6827 1034671 jn L6585   ;out of space, try deleting compiler @6827
133 6827+ .aa9:; 
134 6827+ ;L6827P:
135 6827+0615121 lod W6737   ;
136 6828 0000136377777 o00 stkpt/sto -1; @6828
137 6829 0040016 o02 arg1   ; @6829
138 6829+0400016 sto arg1   ;
139 6830 1035250 jn .aa8   ; @6830
140 6830+0615141 lod W6753   ;
141 6831 0560027 o27 stkpt   ; @6831
142 6831+1000000 jmp Return   ;
143 6832  ;
144 6832  .aa10:; 
145 6832  ;L6832:
146 6832 0064522600000 o00 W6740/lod 0; @6832
147 6833 0415124 sto W6740   ; @6833
148 6833+1015235 jmp .aa5   ;
149 6834  ;
150 6834  .aa11:; 
151 6834  ;L6834:
152 6834 0635124 lcs W6740   ; @6834
153 6834+1115234 jmp .aa4   ;
154 6835  ;
155 6835  .aa12:; 
156 6835  ;L6835:
157 6835 0064516040000 o00 W6739/o02 0; @6835
158 6836 1115240 jmp .aa7   ; @6836
159 6836+ ;
160 6836+ .aa13:; 
161 6836+ ;L6836P:
162 6836+0635123 lcs W6739   ;
163 6837 1015240 jmp .aa6   ; @6837
164 6837+ ;
165 6837+ =6839 
166 6839  .aa14:; 
167 6839  ;L6839:
168 6839   call     ; @6839
168+16839 7300041000013 lnk CheckStacka.lnk:jmp CheckStacka.ent 
169 6840 1115253 jmp .aa9   ; @6840
170 6840+ ;
171 6840+0000000 o00 0   ;
172 6841  ;--------------------------------------------------------------------
173 6841  AllocArray.aa15:; 
174 6841  ;L6841:
175 6841 1015240 jmp .aa6   ; @6841
176 6841+ ;--------------------------------------------------------------------
177 6841+ ; unwind stack after call-by-name proc has finished
178 6841+ ;
179 6841+ Unwind::; 
180 6841+ Unwind:; 
181 6841+0400015 sto Link1   ;save return value (if any)
182 6842 0064536600000 o00 DLink/lod 0; @6842
183 6843 2000072600000 sto arg1/lod 0;get return address from stk @6843
184 6844 0400001 sto T2Link   ;store for return @6844
185 6844+0615127 lod DLink   ;is sign bit set?
186 6845 1135301 jn .2   ;yes, -> @6845
187 6845+0615143 lod MaskN1N2   ;=<00 8191:00 8191>
188 6846 0064536460000 o00 DLink/ans 0;clean up @6846
189 6847  .1:; 
190 6847 2200136600000 inc stkpt/lod 0;unstack old link @6847
191 6848 0415127 sto DLink   ;store dynamic link @6848
192 6848+0600015 lod Link1   ;reload possible result
193 6849 1015212 jmp CkoRet   ;and return @6849
194 6849+ ;
195 6849+ .2:; 
196 6849+0600016 lod arg1   ;
197 6850   calln ,   ;UnstkData.2 @6850
197+16850 7364531115337 lnk W6742:jmp StackData.2 
198 6851 1015277 jmp .1   ; @6851
199 6851+ ;
200 6851+0000000 o00 0   ;
201 6852  ;
202 6852  .3:; 
203 6852 1015277 jmp .1   ; @6852
204 6852+ ;--------------------------------------------------------------------
205 6852+ ; prepare for call to proc with call-by-name args
206 6852+ ; on entry: acc contains calling procs return address
207 6852+ ;
208 6852+ Setup::; 
209 6852+ Setup:; 
210 6852+0215127 exa DLink   ; @6852+
211 6853 0000136400000 o00 stkpt/sto 0; @6853
212 6854 0040000 o02 0   ; @6854
213 6854+0760027 o37 stkpt   ;
214 6855   call     ; @6855
214+16855 7300041000011 lnk CheckStack.lnk:jmp CheckStack.ent 
215 6856 0064536600000 o00 DLink/lod 0; @6856
216 6857 1035314 jn .1   ;is bit already set? yes-> @6857
217 6857+0115142 add TopBit   ;sign bit
218 6858 0064536400000 o00 DLink/sto 0;turn bit on in stack @6858
219 6859 1015212 jmp CkoRet   ; @6859
220 6859+ ;
221 6859+0000000 o00 0   ;
222 6860  ;
223 6860  .1:; 
224 6860   calln ,   ; @6860
224+16860 7364531015325 lnk W6742:jmp StackData.0 
225 6861 0615142 lod TopBit   ;sign bit @6861
226 6861+0515127 ads DLink   ;
227 6862 1015212 jmp CkoRet   ; @6862
228 6862+ ;
229 6862+0000000 o00 0   ;
230 6863  ;--------------------------------------------------------------------
231 6863  ; return number of words of free store left
232 6863  ; if less than minimum return 1, we'll catch attempts to
233 6863  ; allocate space anyway!
234 6863  ;
235 6863  StoreMax::; 
236 6863  StoreMax:; 
237 6863 0600027 lod stkpt   ; @6863
238 6863+0116217 add N76   ;=-76 reserved space at bottom
239 6864 1135321 jn .1   ; @6864
240 6864+1155321 jz .1   ;
241 6865 1000052 jmp retlnk1   ; return amount left @6865
242 6865+ ;
243 6865+ .1:; 
244 6865+0040000 o02 0   ;=1 not true, but it'll do
245 6866 1000052 jmp retlnk1   ;return 1 @6866
246 6866+ ;
247 6866+0000000 o00 0   ;
248 6867  ;--------------------------------------------------------------------
249 6867  L6867:; 
250 6867 1000000 jmp Return   ;only referred to by symtab @6867
251 6867+ ;--------------------------------------------------------------------
252 6867+ ; stack routine - copy data to stack
253 6867+ ; used by print/read/recursive proc call
254 6867+ ; acc contains 00 n : 00 p
255 6867+ ; where n = number of words tp save, p = address of words
256 6867+ ;
257 6867+ StackData::; 
258 6867+ .lnk= ëÿ¿P/@hëÿ¿hX@Ø ôÿ¿ÿW6742; 
259 6867+ ;
260 6867+ StackData:; 
261 6867+0200001 exa T2Link   ;hide argument
262 6868 0415126 sto .lnk   ;save return address @6868
263 6868+0200001 exa T2Link   ;reload argument
264 6869  .0:; 
265 6869  ;L6869:
266 6869 0075143 and MaskN1N2   ;=<008191:008191> @6869
267 6869+0415125 sto W6741   ;address (p)
268 6870 1220024 srl 20   ;get n @6870
269 6870+0435124 stn W6740   ;-length
270 6871 0455124 inc W6740   ;+1 @6871
271 6871+0160027 bus stkpt   ;stkpt-n
272 6872 0400027 sto stkpt   ;stkpt := stkpt - n @6872
273 6872+0415123 sto W6739   ;workptr
274 6873   call     ;make sure there's room @6873
274+16873 7300041000011 lnk CheckStack.lnk:jmp CheckStack.ent 
275 6874  .1:; 
276 6874 2264526577777 inc W6741/lod -1;get source word @6874
277 6875 2264516400000 inc W6739/sto 0;store on stack @6875
278 6876 0655124 lis W6740   ;count @6876
279 6876+1035332 jn .1   ;repeat if more
280 6877  .ret:; 
281 6877   ret     ; @6877
281+16877 0064533000001 o00 StackData.lnk/jmp 1 
282 6878  ;--------------------------------------------------------------------
283 6878  ; unstack data, used at end of print/read, and after proc calls
284 6878  ; restore items saved by above, param in acc in same format as above
285 6878  ;
286 6878  UnstkData:; 
287 6878 0200001 exa T2Link   ;hide arg @6878
288 6878+0415126 sto .lnk   ;save return address
289 6879 0200001 exa T2Link   ; @6879
290 6879+ .2:; 
291 6879+ ;L6879P:
292 6879+0075143 and MaskN1N2   ;=<00 8191:00 8191>
293 6880 0415125 sto W6741   ;address (p) @6880
294 6880+1220024 srl 20   ;get n
295 6881 0435124 stn W6740   ;store as count @6881
296 6881+0455124 inc W6740   ;increment
297 6882  .3:; 
298 6882 2200136600000 inc stkpt/lod 0;unstack word @6882
299 6883 2264526377777 inc W6741/sto -1;store back in place @6883
300 6884 0655124 lis W6740   ;count @6884
301 6884+1035342 jn .3   ;repeat if more
302 6885 0600015 lod Link1   ;return value (proc exits) @6885
303 6885+1015335 jmp StackData.ret   ;and return
304 6886  ;--------------------------------------------------------------------

Page created by Bill Purvis, last updated: January 09 2004