Commit | Line | Data |
---|---|---|
7af5ad59 PH |
1 | /OS8 FORTRAN II COMPILER V5 |
2 | / | |
3 | / | |
4 | / | |
5 | / | |
6 | / | |
7 | / | |
8 | / | |
9 | // | |
10 | / | |
11 | / | |
12 | / | |
13 | / | |
14 | /COPYRIGHT (C) 1971,1974,1975 | |
15 | /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. | |
16 | / | |
17 | / | |
18 | / | |
19 | /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A | |
20 | /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- | |
21 | /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER | |
22 | /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE | |
23 | /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO | |
24 | /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE | |
25 | /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. | |
26 | / | |
27 | / | |
28 | /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT | |
29 | /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL | |
30 | /EQUIPMRNT COROPATION. | |
31 | / | |
32 | /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS | |
33 | /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. | |
34 | / | |
35 | / | |
36 | / | |
37 | / | |
38 | / | |
39 | / | |
40 | \f/ | |
41 | / SYMBOL TABLE FOR FORTRAN COMPILER (8K- PDP-8) | |
42 | / FOR USE WITH DISK/DECTAPE MONITOR SYSTEM | |
43 | / CHANGE LOCATION 'XFINI' TO A 'JMP I LFINI' THEN | |
44 | /ASSEMBLE AND SAVE | |
45 | / .PAL FORT.PA | |
46 | / .PAL FPATCH.PA | |
47 | / | |
48 | / .LO FORT.BN$FPATCH.BN$ | |
49 | / | |
50 | / .SA SYS FORT | |
51 | / | |
52 | / | |
53 | ||
54 | FIELD 0 | |
55 | *200 | |
56 | INBUF, TEXT /PDP-8 FORTRAN DEC-08-A2B1-5A/ | |
57 | ||
58 | *1000 | |
59 | BEGIN, PLS /INITIALIZATION ROUTINE | |
60 | TLS | |
61 | RFC | |
62 | CDF 00 | |
63 | TAD CM1300 /SET SYMBOL TABLE TO ZEROS (6300-7577 FIELD 1) | |
64 | DCA INDX | |
65 | TAD BSYMP | |
66 | DCA TPTT | |
67 | LP, DCA I TPTT | |
68 | ISZ INDX | |
69 | JMP LP | |
70 | TAD CM60 | |
71 | DCA INDX | |
72 | TAD BTTAB | |
73 | DCA TPTT | |
74 | DCA I TPTT /ZERO OUT TEMPORARY TABLES IN FIELD 0 | |
75 | ISZ INDX | |
76 | JMP .-2 | |
77 | CDF 10 | |
78 | TAD MIN104 /ZERO EVERYTHING FROM ZERO TO 107 | |
79 | DCA INDX | |
80 | TAD CP6 | |
81 | DCA TPTT | |
82 | LPP, DCA I TPTT | |
83 | ISZ INDX | |
84 | JMP LPP | |
85 | TAD TPT /MOVE DATA FROM TABLE TO FIELD 0 | |
86 | DCA TPTT | |
87 | REP, CDF 00 | |
88 | TAD I TPTT | |
89 | SNA /END OF FIELD 0 INITIALIZATION? | |
90 | JMP DN /YES | |
91 | DCA LOC | |
92 | TAD I TPTT | |
93 | CDF 10 | |
94 | DCA I LOC | |
95 | JMP REP | |
96 | DN, TAD I TPTT /MOVE DATA FROM TABLE TO FIELD 1 | |
97 | SNA /END FIELD 1 INITIALIZATION | |
98 | JMP DNN /YES | |
99 | DCA LOC | |
100 | TAD I TPTT | |
101 | DCA I LOC | |
102 | JMP DN | |
103 | DNN, CIF 10 | |
104 | JMP I STRT | |
105 | LOC, 0 | |
106 | INDX, 0 | |
107 | MIN104, L7-ASSIGN | |
108 | CP6, L7-1 | |
109 | CM1300, -1300 | |
110 | CM60, -60 | |
111 | BTTAB, ITTAB-1 | |
112 | BSYMP, BSYM-1 /BOTTOM OF TEMPORARY SYMBOL TABLE | |
113 | STRT, FORST /STARTING POINT AFTER INITIALIZATION | |
114 | TPTT=10 | |
115 | TPT, TABLE-1 | |
116 | TABLE, | |
117 | PUNCH | |
118 | LTTYPE | |
119 | 15 | |
120 | DOEND | |
121 | 45 | |
122 | FTTAB | |
123 | 51 | |
124 | ITTAB | |
125 | 47 | |
126 | TSYM-3 | |
127 | 50 | |
128 | TSYM | |
129 | 55 | |
130 | -25 | |
131 | 56 | |
132 | BSYM | |
133 | 57 | |
134 | BSYM | |
135 | 71 | |
136 | 5777 | |
137 | 74 | |
138 | 3000 | |
139 | MIKE4 | |
140 | 3377 | |
141 | POINTZ | |
142 | 3377 | |
143 | BASE | |
144 | INBUF | |
145 | BASE2 | |
146 | INBUF+100 | |
147 | SCOUNT | |
148 | 0 | |
149 | SCOUNT+1 | |
150 | 0 | |
151 | SCOUNT+2 | |
152 | 0 | |
153 | QONE | |
154 | 0 | |
155 | QONE+1 | |
156 | 0 | |
157 | QONE+2 | |
158 | 0 | |
159 | QONE+3 | |
160 | 0 | |
161 | QONE+4 | |
162 | 0 | |
163 | QONE+5 | |
164 | 0 | |
165 | QONE+6 | |
166 | 0 | |
167 | 0 /THIS TERMINATES FIELD ZERO INITIALIZATION | |
168 | 2375 | |
169 | 4000 | |
170 | 2376 | |
171 | 4000 | |
172 | 2377 | |
173 | 4000 | |
174 | 0 | |
175 | ||
176 | \f/ ERROR MESSAGE TABLE AND TEXT | |
177 | ||
178 | ELIST, -ERR1-1; EMSG1 /ILLEGAL CONTINUATION | |
179 | -ERR2-1; IE /ILLEGAL ARITHMETIC EXPRESSION | |
180 | -ERR3-1; IE | |
181 | -ERR6-1; IE | |
182 | -ERR9-1; EMSG3 | |
183 | -ERR10-1; EMSG4 | |
184 | -ERR12-1; EMSG4 | |
185 | -ERR14-1; EMSG4 | |
186 | -ERR15-1; EMSG3 | |
187 | -ERR16-1; EMSG5 | |
188 | -ERR17-1; EMSG6 | |
189 | -ERR18-1; SE /SYNTAX ERROR | |
190 | -ERR28-1; SE | |
191 | -ERR29-1; SE | |
192 | -ERR30-1; EMSG8 /ILLEGAL VARIABLE | |
193 | -ERR31-1; SE | |
194 | -ERR35-1; SE | |
195 | -ERR36-1; EMSG36 | |
196 | -ERR37-1; CE | |
197 | -ERR38-1; EMSG9 /ILLEGAL DO NESTING | |
198 | -ERR39-1; SE | |
199 | -ERR40-1; IE | |
200 | -ERR41-1; EMSG10 /EXPRESSION TOO BIG | |
201 | -ERR42-1; IE | |
202 | -ERR43-1; EMSG11 /MIXED MODE | |
203 | -ERR44-1; EMSG9 | |
204 | -ERR47-1; SF /SUBR. OR FUNCT. STMT. NOT FIRST | |
205 | -ERR48-1; SE | |
206 | -ERR50-1; SE | |
207 | -ERR51-1; SE | |
208 | -ERR52-1;IE | |
209 | -ERR53-1; EMSG12 /ILLEGAL SUBSCRIPT | |
210 | -ERR54-1; EMSG13 /ILLEGAL EQUIVALENCING | |
211 | -ERR59-1; SE | |
212 | -ERR60-1; EMSG3 | |
213 | 0; EMSG14 /COMPILER MALFUNCTION | |
214 | ||
215 | EMSG1, TEXT /ILLEGAL CONTINUATION/ | |
216 | IE, TEXT /ILLEGAL ARITHMETIC EXPRESSION/ | |
217 | EMSG3, TEXT /ILLEGAL STATEMENT/ | |
218 | EMSG4, TEXT /ILLEGAL CONSTANT/ | |
219 | EMSG5, TEXT /ILLEGAL STATEMENT NUMBER/ | |
220 | EMSG6, TEXT /SYMBOL TABLE EXCEEDED/ | |
221 | SE, TEXT /SYNTAX ERROR/ | |
222 | EMSG8, TEXT /ILLEGAL VARIABLE/ | |
223 | EMSG9, TEXT /ILLEGAL OR EXCESSIVE DO NESTING/ | |
224 | EMSG10, TEXT /ARITHMETIC EXPRESSION TOO COMPLEX/ | |
225 | EMSG11, TEXT /MIXED MODE EXPRESSION/ | |
226 | EMSG12, TEXT /EXCESSIVE SUBSCRIPTS/ | |
227 | EMSG13, TEXT /ILLEGAL EQUIVALENCING/ | |
228 | EMSG14, TEXT /COMPILER MALFUNCTION/ | |
229 | CE, TEXT /UNBALANCED QUOTES/ | |
230 | SF, TEXT /SUBR. OR FUNCT. STMT. NOT FIRST/ | |
231 | EMSG36, TEXT /ARRAY TOO LARGE/ | |
232 | \fITTAB=710 | |
233 | FTTAB=ITTAB+30 | |
234 | DOEND=2377 | |
235 | BSYM=6300 | |
236 | TSYM=7600 | |
237 | ||
238 | / THE STATEMENT TYPE TABLE FOLLOWS | |
239 | *2600 | |
240 | STYPE, 7361 /-DO | |
241 | 0000 | |
242 | LDO | |
243 | 6672 /-IF | |
244 | 0000 | |
245 | LIF | |
246 | 7061 /-GO | |
247 | 5361 /-TO | |
248 | LGOTO | |
249 | 7477 /-CA | |
250 | 6364 /-LL | |
251 | CAL | |
252 | 5573 /-RE | |
253 | 5353 /-TU | |
254 | LRET | |
255 | 7461 /-CO | |
256 | 6154 /-NT | |
257 | LCONT | |
258 | 5454 /-ST | |
259 | 6060 /-OP | |
260 | LSTOP | |
261 | 5777 /-PA | |
262 | 5255 /-US | |
263 | LPAUSE | |
264 | 5573 /-RE | |
265 | 7674 /-AD | |
266 | LREAD | |
267 | 5056 /-WR | |
268 | 6654 /-IT | |
269 | LWRIT | |
270 | 7161 /-FO | |
271 | 5563 /-RM | |
272 | LFRMAT | |
273 | 7262 /-EN | |
274 | 7400 /-D | |
275 | LLAST | |
276 | 7461 /-CO | |
277 | 6263 /-MM | |
278 | LCOMON | |
279 | 7367 /-DI | |
280 | 6273 /-ME | |
281 | LDIMEN | |
282 | 7257 /-EQ | |
283 | 5267 /-UI | |
284 | ||
285 | EQUI | |
286 | -0611 /-FI | |
287 | -1611 /-NI | |
288 | LFIN | |
289 | XXSUBR, 5453 /-SU | |
290 | 7556 /-BR | |
291 | LSUB | |
292 | 7153 /-FU | |
293 | 6175 /-NC | |
294 | LFUNC | |
295 | 0000 /THIS IS THE END OF LIST | |
296 | AREA1, 0 | |
297 | AREA2, 0 | |
298 | ||
299 | / THE PRECEDENCE TABLE FOLLOWS, NON-ZERO PREC. OPERATORS APPEAR | |
300 | -45 / PREC('%') = 7 NOTE: '%' REPLACES '**' | |
301 | 700 | |
302 | -52 / PREC('*') = 5 | |
303 | 500 | |
304 | -57 / PREC('/') = 5 | |
305 | 500 | |
306 | -53 / PREC('+') = 4 | |
307 | 400 | |
308 | -55 / PREC('-') = 4 | |
309 | 400 | |
310 | -75 / PREC('=') = 1 | |
311 | 100 | |
312 | -74 / PREC('<') = 1 NOTE: '<' IMPLIES SUBSCRIPTED ASSIGNMENT | |
313 | 100 | |
314 | 1 /THIS IS THE END OF THE TABLE | |
315 | THOU, -1750 | |
316 | -144 | |
317 | -12 | |
318 | -1 | |
319 | ||
320 | / THE PERMANENT SYMBOL TABLE BEGINS HERE | |
321 | *6000 | |
322 | 1501 /MAIN | |
323 | 1116 | |
324 | 0001 | |
325 | 0601 /FAD | |
326 | 0400 | |
327 | 0001 | |
328 | 2324 /STO | |
329 | 1700 | |
330 | 0001 | |
331 | 0623 /FSB | |
332 | 0200 | |
333 | 0001 | |
334 | 0615 /FMP | |
335 | 2000 | |
336 | 0001 | |
337 | 0604 /FDV | |
338 | 2600 | |
339 | 0001 | |
340 | 1520 /MPY | |
341 | 3100 | |
342 | 0001 | |
343 | 0411 /DIV | |
344 | 2600 | |
345 | 0001 | |
346 | 2205 /READ | |
347 | 0104 | |
348 | 0001 | |
349 | 2722 /WRITE | |
350 | 1124 | |
351 | 0501 | |
352 | 1117 /IOH | |
353 | 1000 | |
354 | 0001 | |
355 | 5060 /(0 | |
356 | 0000 | |
357 | 0001 | |
358 | 1215 /JMP | |
359 | 2000 | |
360 | 0001 | |
361 | 1617 /NOP | |
362 | 2000 | |
363 | 0001 | |
364 | 0516 /ENTRY | |
365 | 2422 | |
366 | 3101 | |
367 | 0501 /EAP | |
368 | 2000 | |
369 | 0001 | |
370 | 2001 /PAUSE | |
371 | 2523 | |
372 | 0501 | |
373 | OPTADI, 2401 /TAD I | |
374 | 0440 | |
375 | 1101 | |
376 | OPTAD, 2401 /TAD | |
377 | 0400 | |
378 | 0001 | |
379 | OPDCA, 0403 /DCA | |
380 | 0100 | |
381 | 0001 | |
382 | OPJMPI, 1215 /JMP I | |
383 | 2040 | |
384 | 1101 | |
385 | 2205 /RETRN | |
386 | 2422 | |
387 | 1601 | |
388 | 0320 /CPAGE | |
389 | 0107 | |
390 | 0501 | |
391 | OPSNA, 2316 /SNA | |
392 | 0100 | |
393 | 0001 | |
394 | 2320 /SPC | |
395 | 0300 | |
396 | 0001 | |
397 | 0301 /CALL | |
398 | 1414 | |
399 | 0001 | |
400 | 0313 /CKIO | |
401 | 1117 | |
402 | 0001 | |
403 | 1014 /HLT | |
404 | 2400 | |
405 | 0001 | |
406 | OPCLA, 0314 /CLA | |
407 | 0100 | |
408 | 0001 | |
409 | 0614 /FLOT | |
410 | 1724 | |
411 | 0001 | |
412 | 1106 /IFAD | |
413 | 0104 | |
414 | 0001 | |
415 | 0311 /CIA | |
416 | 0100 | |
417 | 0001 | |
418 | 0310 /CHS | |
419 | 2300 | |
420 | 0001 | |
421 | 0611 /FIX | |
422 | 3000 | |
423 | 0001 | |
424 | 1123 /ISTO | |
425 | 2417 | |
426 | 0001 | |
427 | 2001 /PAGE | |
428 | 0705 | |
429 | 0001 | |
430 | BLCK, 0214 /BLOCK | |
431 | 1703 | |
432 | 1301 | |
433 | 0516 /END | |
434 | 0400 | |
435 | 0001 | |
436 | 1401 /LAP | |
437 | 2000 | |
438 | 0001 | |
439 | 0317 /COMMN | |
440 | 1515 | |
441 | 1601 | |
442 | 1123 /ISZ | |
443 | 3200 | |
444 | 0001 | |
445 | 2325 /SUBSC | |
446 | 0223 | |
447 | 0301 | |
448 | DUMMY, 0425 /DUMMY | |
449 | 1515 | |
450 | 3101 | |
451 | 0122 /ARG | |
452 | 0700 | |
453 | 0001 | |
454 | 0314 /CLEAR | |
455 | 0501 | |
456 | 2201 | |
457 | 1111 /IIPOW | |
458 | 2017 | |
459 | 2701 | |
460 | 0611 /FIPOW | |
461 | 2017 | |
462 | 2701 | |
463 | 1106 /IFPOW | |
464 | 2017 | |
465 | 2701 | |
466 | 0606 /FFPOW | |
467 | 2017 | |
468 | 2701 | |
469 | 0403 /DCA I | |
470 | 0140 | |
471 | 1101 | |
472 | 0103 /ACH | |
473 | 1000 | |
474 | 0001 | |
475 | OPEN, 1720 /OPEN | |
476 | 0516 | |
477 | 0001 | |
478 | 0522 /ERROR | |
479 | 2217 | |
480 | 2201 | |
481 | 1116 /INC | |
482 | 0300 | |
483 | 0001 | |
484 | FORTR, 0617 /FORTR | |
485 | 2224 | |
486 | 2201 | |
487 | OPCMA, 0315 /CMA | |
488 | 0100 | |
489 | 0001 | |
490 | OPIAC, 1101 /IAC | |
491 | 0300 | |
492 | 0001 | |
493 | EXIT, 0530 /EXIT | |
494 | 1124 | |
495 | 0001 | |
496 | \f FIELD 1 | |
497 | *0 | |
498 | FIRSTF, 1 | |
499 | *7 | |
500 | L7, 0 | |
501 | L10, 0 | |
502 | L11, 0 | |
503 | L12, 0 /LAST LINE'S CONTENTS FOR OPTOMIZATION | |
504 | 0 | |
505 | L14, 0 | |
506 | L15, 2377 /POINTER INTO DOEND LIST | |
507 | L16, 0 | |
508 | L17, 0 | |
509 | L20, 0 /FLAG, NON-ZERO IF '=' SEEN | |
510 | L21, 0 | |
511 | L22, 0 /SUBSCRIPT NESTING LEVEL | |
512 | L23, 0 /USED BY "DUMARG" AND "IOHAR" PATCH | |
513 | L24, 0 /LINE POINTER | |
514 | L25, 0 /HIGHEST SUBSCRIPT TEMP USED | |
515 | L26, 0 /USED FOR DIMENSION INFORMATION | |
516 | 0 /UNUSED | |
517 | L30, 0 /FOLLOWING EIGHT LOCS ARE USED BY ENTITY | |
518 | L31, 0 | |
519 | L32, 0 | |
520 | L33, 0 | |
521 | L34, 0 | |
522 | L35, 0 | |
523 | L36, 0 | |
524 | L37, 0 | |
525 | L40, 0 /CONTAINS THE CURRENT TRIPLE NUMBER | |
526 | L41, 0 /THIS IS THE POINTER INTO THE PUSH DOWN LIST | |
527 | L42, 0 /THESE TWO LOCATIONS ARE USED BY THE TRIPLE PROCESSOR | |
528 | L43, 0 / | |
529 | L44, 0 /CONTAINS ONE FOR RIGHT OF EQUALS, ZERO FOR LEFT | |
530 | L45, FTTAB /CONTAINS LARFEST FLOATING POINT TEMPORARY NUMBER USED | |
531 | L46, 0 /CONTAINS NUMBER OF THE TRIPLE CURRENTLY IN THE AC | |
532 | L47, 7575 /CONTAINS THREE LESS THAN START OF FCON TABLE | |
533 | L50, 7600 /CONTAINS START OF DIMENSION TABLE | |
534 | L51, ITTAB /CONTAINS LARGEST INTEGER TEMPORARY NUMBER USED | |
535 | L52, 0 /CONTAINS ONE IF RETURN FROM GENER IS DESIRED FOR BALANCE | |
536 | L53, 0 /CONTAINS THE LAST CREATED LABEL | |
537 | L54, 0 /CONTAINS THE LABEL FOR THE CURRENT STATEMENT | |
538 | L55, -25 /CONTAINS THE MAXIMUM ALLOWABLE NUMBER OF UNENDED DOS | |
539 | L56, 6300 /CONTAINS BEGINNING OF SYMBOL TABLE | |
540 | L57, 6300 /CONTAINS END OF SYMBOL TABLE | |
541 | L60, 0 /"INDIRECT =" FLAG FOR S.S LEFT OF EQUALS SIGN | |
542 | L61, 0 /NON-ZERO IF LAST STMT READ IS A COMMENT | |
543 | L62, 0 /NEXT FOUR LOCATIONS USED BY GENER AND ENTITY | |
544 | L63, 0 /CONTAINS THE CURRENT OPERATOR | |
545 | L64, 0 /POINTS TO THE LAST OPERATOR IN THE STACK | |
546 | L65, 0 /CONTAINS THE PRECEDENCE OF THE CURRENT OPERATOR | |
547 | BPAREN, 0 /PARENTHESIS COUNTER | |
548 | L67, 0 /ONE FOR FUNCTION AND ZERO FOR SUBROUTINE | |
549 | L70, 0 /CONTAINS POINTER TO SUBPROGRAM NAME | |
550 | L71, 5777 /BEGINNING OF PUSHDOWN LIST | |
551 | L72, 0 /SET TO ONE IF SUBSCRIPT IS ENCOUNTERED | |
552 | L73, 0 / | |
553 | L74, 3000 /BEGINNING OF ERASABLE LOCATIONS USED FOR PARAMETERS | |
554 | L75, 0 /SET TO ONE SUPPRESS /OUTPUT FROM COMPILER | |
555 | L76, 0 / | |
556 | L77, 0 /CONTAINS ADDRESS OF LAST ENTRY INTO FCON OR SYMBOL TABLE | |
557 | /THE FOLLOWING THREE LOCS ARE USED BY THE | |
558 | /LITERAL COLLECTER | |
559 | COUNT2, 0 /NUMBER OF DIGITS TO RIGHT OF DECIMAL POINT | |
560 | ESIGN, 0 /0 MEANS POSITIVE EXPONENT, 1 MEANS NEGATIVE | |
561 | FPSW, 0 /0 MEANS INTEGER CONSTANT, 1 MEANS FLOATING POINT | |
562 | MIKE4,MA, 3377 | |
563 | MIKE8,TOTAL, 0 | |
564 | INTA, 0 | |
565 | INTB,MIKE7, 0 | |
566 | SNUM,MB, 0 | |
567 | POINTZ, 3377 | |
568 | CHK, 0 | |
569 | IMPDO, 0 /"IMPLIED DO-LOOP IN PROGRESS" FLAG | |
570 | KOUNT, 0 | |
571 | ASSIGN, LASIGN /ROUTINE TO PROCESS ASSIGNMENT STATEMENTS | |
572 | PUTCH, LPUTCH /ROUTINE TO PUT A CHARACTER BACK IN THE INPUT BUFFER | |
573 | PROP, LPROP /PRINTS OPCODES | |
574 | PRCRL, LPRCRL /PRINTS CREATED LABELS | |
575 | PRINT, LPRINT /PRINTS ONE ASCII CHAR | |
576 | P2, LP2 /PRINT TWO PACKED ASCII CHARS | |
577 | GETCH, LGETCH /GETS ONE CHARACTER OUT OF THE INPUT BUFFER | |
578 | LUNCH, LLUNCH /PRINTS ERROR COMMENTS | |
579 | MODE, LMODE /DETERMINES THE MODE OF THE ARGUMENT | |
580 | LOOK, LLOOK /CHECKS FOR THE REST OF THE INPUT STATEMENT | |
581 | ZZZ, LZZZ /PRINTS OUT STATEMENT LABELS | |
582 | ENTITY, LENTT /GETS THE NEXT LOGICAL INPUT PARAMETER | |
583 | SYMTAB, LSYMTB /ENTERS SYMBOLS INTO THE SYMBOL TABLE | |
584 | DUMARG, LDMARG /SEES IF PARAMETER IS A DUMMY ARG OR SUBSCRIPT | |
585 | PRSYM, LPRSYM /PRINTS SYMBOLS | |
586 | CREATE, LCREAT /CREATES LABELS | |
587 | PROTAC, LPRTAC /PRINTS CONTENTS OF AC IN OCTAL | |
588 | PLAB, LPLAB /PRINTS LABELS | |
589 | PIFF, LPIFF /PUTS OUT AN IFF FOR THE CONTENTS OF THE AC | |
590 | TRIPL, LTRIPL /PROCESSES THE TRIPLES GENERATED FROM AN EXPRESSION | |
591 | GENER, LGENER /GENERATES THE TRIPLES | |
592 | LCHNG, CHNG /TEST FOR DUMMY ARG AND REPLACE | |
593 | CLAB, LCLAB /HANGS A CREATED LABEL ON THE NEXT LINE | |
594 | STORE, LSTORE /STORES THE CONTENTS OF THE AC | |
595 | FPROP, LFPROP /PUT OUT CALLS TO F.P. ROUTINES | |
596 | ZER, LZER | |
597 | DUM, LDUM /PROCESSES OCCURRANCES OF DUMMY ARGUMENTS IN LISTS | |
598 | DIM, LDIM /LOOKS UP DIMENSION INFORMATION ON VARIABLES | |
599 | PUNCH, LTTYPE /ADDRESS OF CURRENT OUTPUT ROUTINE | |
600 | C2, 2 | |
601 | C3, 3 | |
602 | \fC40, 40 | |
603 | C7240, 5440 /THIS WAS COLON-SPACE NOW ITS COMMA-SPACE | |
604 | C77, 77 | |
605 | CM40, -40 | |
606 | CM4046, -4046 | |
607 | CM50, -50 | |
608 | CM51, -51 | |
609 | CM54, -54 | |
610 | CM2, -2 | |
611 | CM3, -3 | |
612 | CHECK, LCHECK | |
613 | SMODE, LSMODE | |
614 | BSS, LBSS | |
615 | ARG, LARG | |
616 | C54, 54 | |
617 | BASE, INBUF | |
618 | BASE2, INBUF+100 | |
619 | C4000, 4000 | |
620 | GNB, LGNB | |
621 | \f *177 | |
622 | START, CLA /COME HERE AT BEGINNING OF EACH STMT | |
623 | DCA FIRSTF | |
624 | START1, TAD IMPDO | |
625 | SZA CLA | |
626 | JMP ERR1 /IF IMPDO<>0 THEN WE MUST HAVE SCREWED UP ON | |
627 | /CONTINUATIONS (I THINK) | |
628 | ISZ CHK /IS THERE A STMT IN THE BUFFER? | |
629 | JMP .+3 | |
630 | JMS I SWAP /YES, SWITCH BUFFER POINTERS | |
631 | JMP .+3 | |
632 | TAD BASE | |
633 | JMS I RCD /NO, READ THE NEXT LINE | |
634 | TEST, TAD L15 | |
635 | TAD CM3 | |
636 | DCA L16 /SET UP XR FOR DO TERMINATION TEST | |
637 | TAD L54 | |
638 | CIA | |
639 | TAD I L16 | |
640 | SZA CLA /ARE WE TERMINATING A DO? | |
641 | JMP ATRY | |
642 | JMS LDNEXT /TERMINATE DO LOOP | |
643 | JMP TEST /SEE IF THERE IS ANY MORE... | |
644 | ATRY, TAD L61 | |
645 | SZA CLA /A COMMENT? | |
646 | JMP CMNT | |
647 | TAD CHK | |
648 | SZA CLA /ILLEGAL CONTINUATION? | |
649 | ERR1, JMS I LUNCH | |
650 | JMS I STMT /GET THE STMT NR... | |
651 | TAD L32 | |
652 | SNA | |
653 | JMP .+4 /NO STMT NUMBER | |
654 | CIA | |
655 | TAD L12 | |
656 | SZA CLA /CAN WE OMIT A TERMINAL JMP? | |
657 | JMS I PRINT | |
658 | DCA L24 | |
659 | FLST, JMS LIST /PUNCH SOURCE STMT | |
660 | JMS I WIPE /ZERO THE SUBSCRIPT TEMP. TABLE | |
661 | TAD L32 | |
662 | DCA L54 | |
663 | TAD CM2 | |
664 | DCA L64 | |
665 | SKP | |
666 | ACA, DCA I BAREA1 | |
667 | JMS I GETCH | |
668 | JMP ALPH | |
669 | NOP | |
670 | JMS I PUTCH /PUT CHARACTER BACK | |
671 | ALPH, RTL CLL | |
672 | RTL | |
673 | RTL | |
674 | DCA L65 | |
675 | JMS I GETCH | |
676 | JMP ALPH2 | |
677 | NOP | |
678 | JMS I PUTCH /PUT CHARACTER BACK | |
679 | ALPH2, TAD L65 | |
680 | ISZ L64 | |
681 | JMP ACA | |
682 | DCA I BAREA2 | |
683 | DCA CHK | |
684 | TAD SSTYP /COMPARE THESE CHARS WITH DISPATCH TABLE | |
685 | DCA L17 | |
686 | TRY, TAD I L17 | |
687 | SNA /END OF THE TABLE? | |
688 | JMP I ASSIGN /YES, MUST BE ARITHMETIC STMT | |
689 | TAD I BAREA1 | |
690 | SZA CLA | |
691 | JMP NOHIT2 | |
692 | TAD I BAREA2 | |
693 | TAD I L17 | |
694 | SZA CLA | |
695 | JMP NOHIT1 | |
696 | TAD I L17 /FOUND A MATCH, GO TO PROPER HANDLER... | |
697 | DCA L30 | |
698 | JMP I L30 | |
699 | NOHIT2, ISZ L17 | |
700 | NOHIT1, ISZ L17 | |
701 | JMP TRY /DOESN'T MATCH, TRY AGAIN | |
702 | ||
703 | LDNEXT, 0 | |
704 | TAD L15 /RESET THE DO END POINTER | |
705 | TAD CM3 | |
706 | DCA L15 | |
707 | TAD L15 | |
708 | IAC | |
709 | DCA L16 | |
710 | CMA | |
711 | TAD L55 | |
712 | DCA L55 | |
713 | JMS I PROP /PUNCH 'JMP <LABEL>' | |
714 | 6044 | |
715 | TAD I L16 | |
716 | JMS I PRCRL | |
717 | JMS I PRINT | |
718 | TAD I L16 /PUNCH '<LABEL>,' | |
719 | JMS I CLAB | |
720 | JMS I PRINT | |
721 | JMP I LDNEXT | |
722 | ||
723 | PTEM, 0 | |
724 | ||
725 | LIST, 0 /PUNCH THE SOURCE STATEMENT | |
726 | TAD BASE /GET THE POINTER | |
727 | DCA PTEM | |
728 | TAD I PTEM /PUNCH A CHARACTER PAIR... | |
729 | JMS I P2 | |
730 | TAD I PTEM | |
731 | ISZ PTEM | |
732 | AND C77 | |
733 | SZA CLA /END OF THE BUFFER? | |
734 | JMP LIST+3 | |
735 | JMS I PRINT /YES, PUNCH A CR-LF AND RETURN | |
736 | JMP I LIST | |
737 | ||
738 | CMNT, JMS I PRINT /WE HAVE A COMMENT | |
739 | DCA L24 | |
740 | JMS LIST | |
741 | JMP START1 /ALLOW COMMENTS BEFORE SUBR. OR FUNCTION STMT. | |
742 | ||
743 | ||
744 | BAREA1, AREA1 | |
745 | BAREA2, AREA2 | |
746 | RCD, LRCD | |
747 | SSTYP, STYPE-1 /POINTER TO STATMENT TABLE IN FIELD 1 | |
748 | WIPE, LWIPE | |
749 | STMT, LSTMT | |
750 | SWAP, LSWAP | |
751 | \f *400 | |
752 | / THE FOLLOWING ROUTINE IS ENTERED WITH THE BUFFER POINTER IN THE AC | |
753 | / IT PUTS ONE LINE INTO THE BUFFER, | |
754 | / CHECKS FOR COMMENTS AND COUTINUATION LINES, AND IF IT IS A | |
755 | / CONTINUATION IT SETS KOUNT TO THE PROPER COLUMN | |
756 | / | |
757 | LRCD, 0 | |
758 | DCA TEM1 /SAVE THE BUFFER POINTER | |
759 | DCA I TEM1 | |
760 | DCA CHK /ZERO CONTINUATION FLAG | |
761 | DCA L20 /ZERO THE EQUALS FLAG | |
762 | DCA L61 /ZERO THE COMMENT FLAG | |
763 | TAD CM111 /BUFFER LIMIT IS 72 CHARACTERS | |
764 | DCA IX | |
765 | LRCDL, CLA | |
766 | JMS LPTRIN | |
767 | AND D177 | |
768 | SZA /LEADER OR BLANK TAPE? | |
769 | TAD CM177 | |
770 | SNA /RUBOUT? | |
771 | JMP LRCDL | |
772 | TAD (177-15 | |
773 | SNA | |
774 | JMP LCAR | |
775 | TAD (15-11 | |
776 | SNA | |
777 | JMP TAB | |
778 | TAD (11-40 | |
779 | SPA | |
780 | JMP LRCDL | |
781 | TAD (40-75 | |
782 | SNA /AN '=' ? | |
783 | ISZ L20 | |
784 | TAD C75 /CHAR OK... RESTORE IT & PUT IN BUFFER | |
785 | JMS KRONK /PUT IT IN THE BUFFER... | |
786 | JMP LRCDL /AND GET ANOTHER | |
787 | ||
788 | LCAR, TAD IX /PROCESS A CAR RETURN... | |
789 | CIA | |
790 | TAD CM111 | |
791 | SNA CLA /NULL STATEMENT? | |
792 | JMP LRCDL /YES, IGNORE | |
793 | JMS KRONK /PUT A ZERO IN THE BUFFER | |
794 | TAD I TEM1 | |
795 | TAD CM3 | |
796 | SNA | |
797 | JMP COMNT | |
798 | TAD CM20 | |
799 | SZA CLA /TEST FOR "S" IN COLUMN ONE | |
800 | JMP TINUE | |
801 | JMP I (SCODE | |
802 | COMNT, ISZ L61 /SET COMMENT FLAG... | |
803 | TAD C40 | |
804 | JMP STORSL | |
805 | ||
806 | TINUE, TAD TEM1 /CHECK FOR CONTINUATION... | |
807 | TAD C3 | |
808 | DCA P /SET THE POINTER TO COLS. 6 AND 7 | |
809 | TAD I P | |
810 | AND C5700 /NON-ZERO OR NON BLANK IN COL 6 | |
811 | TAD C4000 /MAKES THIS A CONTINUATION... | |
812 | SNA CLA /IS IT? | |
813 | JMP LRCDA /MAYBE... | |
814 | LRCDX, TAD B7 /YES, MAKE IT START IN COL 7 | |
815 | DCA KOUNT | |
816 | ISZ CHK /INCREMENT THE CONTINUATION FLAG | |
817 | TAD I TEM1 | |
818 | STORSL, TAD C5700 /MAKE THIS INTO A COMMENT LINE | |
819 | DCA I TEM1 | |
820 | JMP I LRCD /THEN RETURN | |
821 | ||
822 | LRCDA, TAD I P /NUMERIC AND NON-ZERO IN COL 7 MAKES | |
823 | AND C77 /THIS A CONTINUATION... | |
824 | TAD CM61 | |
825 | SPA CLA /IS IT? | |
826 | JMP LRCDX+3 /NO, RETURN | |
827 | IAC /YES, MAKE IT START IN COL 8 | |
828 | JMP LRCDX | |
829 | ||
830 | TAB, TAD C40 /PROCESS TAB CHARACTERS... | |
831 | JMS KRONK /PUT SOME SPACES IN THE BUFFER | |
832 | TAD IX | |
833 | TAD C3 /MAKE 1ST TAB GO TO COL 7 | |
834 | SMA /ARE WE AT END OF THE BUFFER? | |
835 | CLA /YES, FORCE TERMINATION | |
836 | AND B7 | |
837 | SZA CLA /MODULO 8? | |
838 | JMP TAB /NO, PUNCH SOME MORE SPACES | |
839 | JMP LRCDL /YES, GET ANOTHER CHAR | |
840 | ||
841 | KRONK, 0 /PUT A CHARACTER IN THE BUFFER... | |
842 | DCA CAR | |
843 | CLA IAC | |
844 | TAD IX /FIRST COMPUTE BUFFER ADDRESS... | |
845 | SNA /PAST COL. 72? | |
846 | JMP I KRONK /YES-RETN. | |
847 | TAD C111 /NO | |
848 | CLL RAR | |
849 | TAD TEM1 | |
850 | DCA P | |
851 | TAD CAR /PICK UP THE CHARACTER | |
852 | AND C77 | |
853 | SZL /ZERO LINK SAYS WE WANT THE LEFT HALF | |
854 | JMP .+5 | |
855 | RTL | |
856 | RTL | |
857 | RTL | |
858 | DCA I P | |
859 | TAD I P /ADD IN THE LEFT 6 BITS | |
860 | DCA I P /AND SALT THEM AWAY... | |
861 | ISZ IX /BUFFER OVERFLOW? | |
862 | JMP I KRONK | |
863 | ||
864 | LPTRIN, 0 /PAPER TAPE READER INPUT ROUTINE | |
865 | RSF | |
866 | JMP .-1 | |
867 | RRB RFC | |
868 | JMP I LPTRIN | |
869 | ||
870 | CAR, 0 /TEMPORARY, HOLDS THE CURRENT CHARACTER | |
871 | P, 0 /THIS IS THE BUFFER POINTER | |
872 | TEM1, 0 /THIS CONTAINS THE CURRENT BUFFER ADDRESS | |
873 | IX, 0 /THIS IS THE CHARACTER COUNTER | |
874 | CM111, -111 /MINUS THE BUFFER LIMIT PLUS ONE | |
875 | C111, 111 /THIS IS THE BUFFER LIMIT PLUS ONE | |
876 | D177, 177 | |
877 | CM177, -177 | |
878 | C75, 75 | |
879 | B7, 7 | |
880 | C5700, 5700 | |
881 | CM61, -61 | |
882 | CM20, -20 | |
883 | M1700, -1700 | |
884 | \f *600 | |
885 | CAL, TAD KOUNT /SUBROUTINE CALL STMT PROCESSOR | |
886 | DCA COUNT3 | |
887 | JMS I ENTITY | |
888 | JMP I ASSIGN | |
889 | JMP ON | |
890 | COUNT3, 0 | |
891 | Q12, 12 | |
892 | JMP I ASSIGN | |
893 | ON, JMS I GNB | |
894 | SNA /ANY ARGUMENTS? | |
895 | JMP CR2 /NO | |
896 | TAD CM50 | |
897 | SZA /MAYBE, IS THIS A '(' ? | |
898 | JMP I ASSIGN | |
899 | JMS I ZZZ /YES, PUNCH STMT NR, IF ANY | |
900 | TAD COUNT3 | |
901 | DCA KOUNT | |
902 | ISZ L44 | |
903 | DCA L46 /AC SWITCH | |
904 | DCA L52 /IF STATEMENT SWITCH | |
905 | JMS I GENER /LET TRIPLE GENERATOR PROCESS IT | |
906 | DCA L46 /ZERO AC AGAIN | |
907 | JMP START /COMPLETE, GET NEXT STATEMENT | |
908 | CR2, ISZ L32 /NO ARGUMENTS | |
909 | JMS I SYMTAB | |
910 | TAD L77 | |
911 | DCA GLU | |
912 | JMS I ZZZ /PUNCH '<LABEL>, CALL 0,<NAME>' | |
913 | JMS I FPROP | |
914 | GLU, 0 | |
915 | JMP START | |
916 | LGNB, 0 | |
917 | JMS LGTC | |
918 | DCA GLU | |
919 | TAD GLU | |
920 | TAD CM40 | |
921 | SNA CLA | |
922 | JMP LGNB+1 | |
923 | TAD GLU | |
924 | JMP I LGNB | |
925 | LGETCH, 0 | |
926 | JMS I GNB | |
927 | SNA /IS IT A END OF CARD | |
928 | JMP PUNC /YES ITS PUNTUATION | |
929 | TAD QM32 | |
930 | SPA SNA /IS IT ALPHABETIC | |
931 | JMP ALPHA //YES | |
932 | TAD CM40 | |
933 | CLL | |
934 | TAD Q12 | |
935 | SZL /IS IT NUMERIC? | |
936 | ISZ LGETCH /NUMERIC | |
937 | PUNC, ISZ LGETCH /PUNCTUATION | |
938 | ALPHA, CLA /ALPHABETIC | |
939 | TAD GLU | |
940 | JMP I LGETCH /RETURN | |
941 | / THIS ROUTINE DETERMINES WHETHER SYMBOL IS FP OR INTEBER | |
942 | / ROUTINE SKIPS IF SYMBOL IS INTEGER | |
943 | LMODE, 0 | |
944 | SMA /IF ITS PLUS WE HAVE AN INTEGER | |
945 | JMP AINT /WE HAVE AN INTEGER | |
946 | RAL /GET NEXT BIT | |
947 | SPA /CHECK THIS BIT | |
948 | JMP FV /ITS EITHER A FCON OR VARIABLE | |
949 | RTL /GET NEXT TWO BITS | |
950 | SNL /IS IT AN OPERATOR | |
951 | ERR2, JMS I LUNCH /YES | |
952 | AFP, SMA CLA /CHECK THIS BIT | |
953 | JMP AINT /ITS AN INTEGER | |
954 | JMP I LMODE /SYMBOL WAS F P MODE | |
955 | FV, RAR /RESTORE AC TO ORIGINAL CONTENTS | |
956 | CIA /SET NEGATIVE | |
957 | TAD L47 /ADD START OF FCON TABLE | |
958 | SPA /IS /SYMBOL FCON | |
959 | JMP AFP /YES | |
960 | CIA /NO /RESTORE AC AGAIN | |
961 | TAD L47 | |
962 | DCA ATEM /SAVE THE RESTORED NUMBER | |
963 | TAD I ATEM /GET THE POINTER TO THE VARIABLE | |
964 | TAD CM1100 /SUBTRACT AN I | |
965 | SPA /IS IT LESS THAN I | |
966 | JMP AFP /YES ITS FLOATING POINT | |
967 | TAD CON1 /NOW SUBTRACT AN N | |
968 | SPA CLA /IS IT LESS THAN N | |
969 | AINT, ISZ LMODE /YES | |
970 | CON1, CLA /CLEAR THE AC FOR THE RETURN | |
971 | JMP I LMODE | |
972 | ATEM, 0 | |
973 | CM1100, -1100 | |
974 | QM32, -32 | |
975 | LGTC, 0 /GET A CHARACTER FROM THE BUFFER | |
976 | TAD KOUNT | |
977 | ISZ KOUNT | |
978 | CLL RAR /LINK TELLS IF LEFT OR RIGHT HALF | |
979 | TAD BASE | |
980 | DCA GLU | |
981 | TAD I GLU | |
982 | SZL /WHICH CHARACTER | |
983 | JMP MMSK | |
984 | RTR | |
985 | RTR | |
986 | RTR | |
987 | MMSK, AND C77 | |
988 | SZA | |
989 | JMP I LGTC | |
990 | TAD CHK | |
991 | SPA CLA /DO WE WANT A NEW LINE YET? | |
992 | JMP I LGTC /NOT YET... | |
993 | TAD BASE2 /YES, USE THE ALTERNATE BUFFER | |
994 | JMS I RLCD | |
995 | TAD CHK | |
996 | SZA CLA /IS IT A CONTINUATION? | |
997 | JMP .+4 | |
998 | CMA /NO, SET FLAG AND RETURN W ZERO AC | |
999 | DCA CHK | |
1000 | JMP I LGTC | |
1001 | JMS LSWAP /YES, SWITCH BUFFERS AND CONTINUE | |
1002 | DCA CHK | |
1003 | JMP LGTC+1 | |
1004 | ||
1005 | RLCD, LRCD | |
1006 | LSWAP, 0 /SWITCH THE LINE BUFFER POINTERS | |
1007 | TAD BASE | |
1008 | DCA ATEM | |
1009 | TAD BASE2 | |
1010 | DCA BASE | |
1011 | TAD ATEM | |
1012 | DCA BASE2 | |
1013 | JMP I LSWAP | |
1014 | \f *1000 | |
1015 | / THE POINTER TO THE CURRENT LOCATION IN THE PUSH LIST IS | |
1016 | / IN LOC 41, THE CURRENT TRIPLE NUMBER IS IN LOCATION 40 | |
1017 | / LOC 44 MUST BE SET TO 0 IF THERE IS AN '=' , TO 1 IF NOT. | |
1018 | PBEGN, AREA2 /START OF THE PRECEDENCE LIST | |
1019 | BINTEG, TAD L32 /HERE IF ENTITY SENT AN INTEGER | |
1020 | JMP I BPUSH /PUSH IT INTO STACK | |
1021 | FLPT, JMS I FCON /HERE IF ENTITY FOUND A FLOATING POINT CON | |
1022 | SKP /ENTER IT INTO FPTABLE | |
1023 | BLPHA, JMS I SYMTAB /HERE IF ENTITY FOUND A VARIABLE | |
1024 | TAD L77 /PICK UP POINTER INTO SYM TAB OR FLPT TAB AN | |
1025 | JMP I BPUSH /PUSH IT DOWN | |
1026 | LABELX, JMP I LGENER | |
1027 | LGENER, 0 /ENTRY POINT | |
1028 | TAD C5000 | |
1029 | DCA L40 /* | |
1030 | DCA L21 /ZERO THE SYMBOL TABLE SWITCH | |
1031 | TAD L71 | |
1032 | DCA L41 /SET PUSH DOWN POINTER | |
1033 | DCA L22 | |
1034 | DCA BPAREN /ZERO OUT THE PAREN SWITCH | |
1035 | TAD C4000 | |
1036 | DCA I L41 /FIRST PUSH DOWN LEFT CLOSURE NAMELY 0 | |
1037 | BNEXT, JMS I ENTITY /THIS WILL GET THE NEXT DATUM TO BE PROCESSE | |
1038 | JMP HOO /END OF STATEMENT RETURN,TREAT LIKE PUNCTION | |
1039 | JMP BLPHA /VARIABLE RETURN | |
1040 | JMP BINTEG /INTEGER RETURN | |
1041 | JMP FLPT /FLOATING POINT RETURN | |
1042 | HOO, TAD CM50 /PUNCTIOATION RETURN, | |
1043 | SNA /IS IT ( | |
1044 | JMP I BPAR /YES | |
1045 | TAD C7753 | |
1046 | SZA /IS IT AN '=' ? | |
1047 | JMP BRET | |
1048 | TAD L44 /WE HAVE AN '=', IS IT LEGAL? | |
1049 | SNA CLA | |
1050 | JMP BRET /IT IS | |
1051 | TAD IMPDO | |
1052 | SZA CLA /ARE WE IN AN IMPLIED DO LOOP? | |
1053 | JMP I PIOEQL /YES - TERMINATE LOOP CODE | |
1054 | ERR3, JMS I LUNCH | |
1055 | PIOEQL, IOEQL | |
1056 | BRET, TAD C0075 | |
1057 | DCA L63 | |
1058 | TAD I L41 /CHECK FOR A UNARY OPERATOR | |
1059 | TAD C4000 | |
1060 | AND C7000 | |
1061 | SZA CLA /WAS IT AN OPERAATOR AT ALL | |
1062 | JMP PREC /NO, STILL NOT UNARY OPERATOR | |
1063 | TAD L63 | |
1064 | TAD C7725 | |
1065 | SNA /IS IT A '+' | |
1066 | JMP BNEXT /YES, IGNORE IT | |
1067 | TAD CM2 /NO | |
1068 | SZA CLA /IS IT A '-' ? | |
1069 | JMP ERR3 | |
1070 | TAD C4643 /THIS IS THE UNARY MINUS | |
1071 | JMP I BPUSH | |
1072 | PREC, TAD PBEGN /HERE IS WHERE WE FIND THE PRECIDENCE | |
1073 | DCA L17 | |
1074 | DCA L65 | |
1075 | SKP | |
1076 | RETUR, ISZ L17 /PICK UP NEXT OP CODE IN LIST | |
1077 | TAD I L17 /TO GET THE NEXT LIST ITEM | |
1078 | SMA SZA /IS THIS THE END OF THE LIST | |
1079 | JMP BMORE /NO, THE ASSUMPTION IS THAT THE PRECIDENCE | |
1080 | TAD L63 /IS ZERO | |
1081 | SZA CLA /IS THIS THE RIGHT TABLE ENTRY | |
1082 | JMP RETUR /TRY AGAIN (IT WASN"T) | |
1083 | TAD I L17 /TO GET THE PRECEDENCE | |
1084 | DCA L65 | |
1085 | BMORE, CLA IAC /HERE WE ARE GOING TO SEE IF THERE IS A PREC | |
1086 | TAD L41 | |
1087 | DCA L64 /L64 NOW POINTS TO THE PREVIOUS OPERATOR | |
1088 | TAD I L64 | |
1089 | TAD C4000 | |
1090 | AND C7000 | |
1091 | SZA /IS THERE A VALID OPERATOR ON THE STACK? | |
1092 | JMP ERR3 /APPARENTLY NOT... | |
1093 | TAD I L64 /IF THE PRECEDENCE OF THE PREVIOUS OPERATOR | |
1094 | AND C700 /IS NON-ZERO, AND ITS PRECEDENCE IS GREATER | |
1095 | SNA /THAN OR EQUAL TO THE PRECEDENCE OF THE | |
1096 | JMP NO /CURRENT OPERATOR, THEN PROCESS THE PREVIOUS | |
1097 | CIA /OPERATOR; IF NOT WE WILL PROBABLY PUT | |
1098 | TAD L65 /THE CURRENT OPERATOR ON THE STACK AND GET | |
1099 | SMA SZA CLA /ANOTHER ITEM FROM THE STATEMENT BUFFER... | |
1100 | JMP NO | |
1101 | ISZ L40 /YES, INCREMENT THE TRIPLE NUMBER AND.... | |
1102 | JMS I TRIPL /PROCESS THE PREVIOUS OPERATOR | |
1103 | ISZ L41 /*****NOTE WHAT IF IT WAS UNARY************ | |
1104 | TAD I L41 | |
1105 | TAD C3135 /THIS IS MINUS UNARY MINUS | |
1106 | SZA CLA | |
1107 | ISZ L41 /DELETE THE LAST 3 ITEMS AND REPLACE WITH TR | |
1108 | TAD L46 | |
1109 | DCA I L41 | |
1110 | JMP BMORE /TRY FOR ANOTHER TRIPLE | |
1111 | NO, TAD L63 | |
1112 | SNA /IS IT A END OF STATEMENT MARK | |
1113 | JMP I LCDONE /IT WAS--WE ARE ALL FINISHED, EXCEPT CHECKING | |
1114 | TAD CM51 | |
1115 | SNA /IS IT A ')' ? | |
1116 | JMP I LKPAR /YES | |
1117 | TAD CM3 | |
1118 | SZA /IS IT A ',' ? | |
1119 | JMP NCOMMA /NO | |
1120 | TAD BPAREN | |
1121 | SNA CLA /IS A COMMA LEGAL HERE? | |
1122 | JMP I LCDONE /MAYBE... | |
1123 | NCOMMA, TAD CM21 | |
1124 | SNA CLA /IS IT AN EQUALS SIGN? | |
1125 | ISZ L44 /YES - SET EQUALS SWITCH ON | |
1126 | TAD L63 /PUT THE OPERATOR ON THE STACK | |
1127 | TAD L65 /ADD THE PRECEDENCE | |
1128 | TAD C4000 | |
1129 | JMP I BPUSH | |
1130 | / | |
1131 | BPUSH, PUSH | |
1132 | C5000, 5000 | |
1133 | BPAR, ALPAR | |
1134 | C7753, 7753 | |
1135 | C0075, 75 | |
1136 | C7000, 7000 | |
1137 | CM21, -21 | |
1138 | C7725, 7725 | |
1139 | C4643, 4643 | |
1140 | C700, 700 | |
1141 | C3135, 3135 | |
1142 | LCDONE, CDONE | |
1143 | LKPAR, KPAR | |
1144 | FCON, LFCON | |
1145 | \f *1200 | |
1146 | PUSH, DCA L63 | |
1147 | CLA CMA | |
1148 | TAD L41 /SPACE THE POINTER UP ONE | |
1149 | DCA L41 /* | |
1150 | TAD L63 | |
1151 | DCA I L41 /* | |
1152 | JMP I LBNEXT /BACK TO BEGINING | |
1153 | / THIS IS TO PROCESS SUBSCRIPTS OR FUNCTION CALLS--- | |
1154 | / IF ARITHMETIC, JUST DELETE BOTH ( AND ) | |
1155 | KPAR, TAD I L64 | |
1156 | TAD C3730 /MINUS LEFT PAREN | |
1157 | SZA /IS IT ( | |
1158 | JMP BCON /NO-- CHECK SOME MORE | |
1159 | TAD I L41 /DELETE PARENS | |
1160 | DCA I L64 | |
1161 | ISZ L41 /UPDATE POINTER | |
1162 | LAPP, ISZ BPAREN /DO PARENS BALENCE | |
1163 | JMP I LBNEXT | |
1164 | TAD L52 /YES | |
1165 | SNA CLA /SHOULD WE RETURN IF BALANCED | |
1166 | JMP I LBNEXT | |
1167 | TAD L46 | |
1168 | SZA CLA | |
1169 | JMP CDONE | |
1170 | TAD I L41 | |
1171 | DCA L77 | |
1172 | JMS I XTAD /GENERATE TAD OR (TAD I) | |
1173 | DCA I L41 /ZERO IS INTEGER | |
1174 | CDONE, TAD L41 | |
1175 | CMA | |
1176 | TAD L71 | |
1177 | SZA /WELL... | |
1178 | ERR6, JMS I LUNCH /HA...YOU GOOFED | |
1179 | JMS I XZQ | |
1180 | JMP I .+1 | |
1181 | LABELX | |
1182 | BCON, IAC /IS IT FUNCTION | |
1183 | ISZ L40 | |
1184 | SNA | |
1185 | JMP BFOUT /YES | |
1186 | IAC /NO-- NOW IS IT SUBSCRIPT | |
1187 | SNA | |
1188 | JMP SOUT /YES | |
1189 | TAD C7772 /NO | |
1190 | SZA /IS IT COMMA | |
1191 | JMP ERR6 /NO - BYE BYE CHARLIE | |
1192 | ISZ L64 | |
1193 | ISZ L64 | |
1194 | TAD I L64 | |
1195 | TAD C3724 /IS IT A COMMA | |
1196 | SNA | |
1197 | JMP BFOUT /FOUND TWO COMMAS,MUST BE FUNCTION | |
1198 | TAD C5 /NO | |
1199 | SNA /IS IT A PRIME | |
1200 | JMP BFOUT /GOT A FUNCTION | |
1201 | IAC /NO | |
1202 | SZA CLA | |
1203 | JMP ERR6 /SORRY, IT AIN'T NUTTIN | |
1204 | SOUT, JMS I PLSBSC /PROCESS A SUBSCRIPT | |
1205 | CMA | |
1206 | TAD L22 | |
1207 | DCA L22 | |
1208 | SKP | |
1209 | BFOUT, JMS I FUNCT | |
1210 | JMP LAPP | |
1211 | FUNCT, LFUNCT | |
1212 | / THIS IS WHERE WE FIND OUT WHAT KIND OF LPAR | |
1213 | ALPAR, CMA | |
1214 | TAD BPAREN | |
1215 | DCA BPAREN | |
1216 | TAD I L41 | |
1217 | TAD C4000 | |
1218 | AND B7000 /IS IT AN OPERAND | |
1219 | SZA CLA | |
1220 | JMP CUNT /NO , TRY SOME MORE | |
1221 | IAC | |
1222 | JMP PRIME | |
1223 | CUNT, TAD I L41 /PICK UP TOP LIST ITEM | |
1224 | TAD C2 /ADD TWO TO FIND THE DIMENSION INTO(INFO) | |
1225 | DCA L64 | |
1226 | TAD I L64 | |
1227 | AND C20 /JUST WANT ONLY THIS ONE BIT(DIMENSION) | |
1228 | SNA CLA /IS IT DIMENSIONED | |
1229 | JMP PRIME /NO ITS GOT TO BE A FUNCTION CALL | |
1230 | ISZ L22 | |
1231 | CMA | |
1232 | PRIME, TAD C4047 | |
1233 | JMP PUSH /GO PUSH A PRIME, IT IS THE FUNCTIONS LEFT PAREN | |
1234 | XZQ, LXZQ | |
1235 | LBNEXT, BNEXT | |
1236 | C3730, 3730 | |
1237 | C7772, 7772 | |
1238 | C3724, 3724 | |
1239 | C5, 5 | |
1240 | D7, 7 | |
1241 | B7000, 7000 | |
1242 | C20, 20 | |
1243 | C4047, 4047 | |
1244 | XTAD, LXTAD | |
1245 | LPUTCH, 0 | |
1246 | CLA CMA | |
1247 | TAD KOUNT | |
1248 | DCA KOUNT | |
1249 | JMP I LPUTCH | |
1250 | ||
1251 | LASIGN, TAD L20 /ARITHMETIC STATEMENT PROCESSOR | |
1252 | SNA CLA /IS THERE AN '=' IN THE STMT? | |
1253 | ERR9, JMS I LUNCH /NO, BETTER COMPLAIN... | |
1254 | TAD D7 /SET POINTER TO COL 7 | |
1255 | DCA KOUNT | |
1256 | JMS I ZZZ /PUNCH THE LABEL, IF ANY | |
1257 | DCA L46 | |
1258 | DCA L44 | |
1259 | DCA L52 | |
1260 | JMS I GENER /PROCESS IT... | |
1261 | TAD L63 | |
1262 | SZA CLA /WAS TERMINATOR A <CR/LF> ? | |
1263 | JMP ERR9 /NO, ILLEGAL STATEMENT ERROR ... | |
1264 | JMP START | |
1265 | PLSBSC, LSUBSC | |
1266 | ||
1267 | LPRCRL, 0 /SUBROUTINE PRINTS CREATED LABELS | |
1268 | DCA LPRCTM | |
1269 | TAD C36 /PUNCH '^' | |
1270 | JMS I PRINT | |
1271 | TAD LPRCTM /PUNCH THE LETTERS | |
1272 | JMS I P2 | |
1273 | JMP I LPRCRL | |
1274 | C36, 36 | |
1275 | LPRCTM, 0 | |
1276 | \f *1400 | |
1277 | PRET, ISZ LENTT /PUNCTIONATION EXIT POINT | |
1278 | FRET, ISZ LENTT /FLOATING POINT EXIT POINT | |
1279 | XIRET, ISZ LENTT /INTEGER EXIT POINT | |
1280 | XARET, ISZ LENTT /VARIABLE EXIT | |
1281 | ERET, JMP I LENTT /CR END OF LINE EXIT | |
1282 | LENTT, 0 /ENTRY POINT | |
1283 | CLA /WIPE OUT PSEUDO ACCUMULATOR | |
1284 | DCA L32 | |
1285 | DCA L31 | |
1286 | DCA COUNT2 /RESET ALL KINDS OF THINGS TO ZERO | |
1287 | DCA L36 | |
1288 | DCA L37 | |
1289 | DCA L30 | |
1290 | DCA FPSW | |
1291 | DCA ESIGN | |
1292 | TAD CM6 | |
1293 | DCA L65 /SET UP FOR MAXIMUM OF 6 CHARS | |
1294 | JMS I GETCH /GET THE FIRST INPUT CHARACTER | |
1295 | JMP .+3 /ALPHA RETURN | |
1296 | JMP PUNCT /PUNCTIONATION RETURN | |
1297 | JMP DIG /DIGIT RETURN | |
1298 | JMS PACK /STORE THIS CHARACTER | |
1299 | JMS I GETCH /GET ANOTHER CHACTER | |
1300 | JMP .-2 /ALPHA- IS OK | |
1301 | SKP /PUNCTUATION | |
1302 | JMP .-4 /DIGIT--IS OK PROCESS IT | |
1303 | JMS I PUTCH /PUT THAT PUNCTUATION BACK IN THE BUFFER | |
1304 | TAD L32 | |
1305 | AND CC7700 /MAKE SURE NAME IS <= 5 CHARACTERS LONG | |
1306 | DCA L32 | |
1307 | JMP XARET /RETURN WITH VARIABLE | |
1308 | ||
1309 | PACK, 0 /THIS PACK CHARS INTO L30 L31 AND L32 | |
1310 | DCA L64 /SAVE THE CHAR... | |
1311 | TAD L65 | |
1312 | SNA /DO WE HAVE SIX CHARS ALREADY? | |
1313 | JMP I PACK /YES - IGNORE | |
1314 | STL; RAR | |
1315 | TAD P33 | |
1316 | DCA LTEM | |
1317 | ISZ L65 | |
1318 | C7, 7 | |
1319 | TAD L64 | |
1320 | CDF 10 | |
1321 | SNL /DO WE HAVE LEFT OR RIGHT HALF? | |
1322 | JMP .+5 | |
1323 | CLL RTL /MUST BE LEFT HALF... | |
1324 | RTL | |
1325 | RTL | |
1326 | SKP | |
1327 | TAD I LTEM | |
1328 | DCA I LTEM | |
1329 | CDF 00 | |
1330 | JMP I PACK | |
1331 | LTEM, 0 | |
1332 | ||
1333 | PUNCT, SNA /HERE TO PROCESS PUNCTION---IS IT A CARIAGE RET | |
1334 | JMP ERET /YES, GO RIGHT BACKTO THE CALLER....BY-BY | |
1335 | TAD C7722 /IS IT A PERIOD | |
1336 | SNA | |
1337 | JMP CC /YES--WE ASSUME THAT THIS LENTT IS A FLOATING | |
1338 | TAD C7 | |
1339 | SNA /IS IT A QUOTE? | |
1340 | JMP I QUOTE /YES - CHARACTER LITERAL | |
1341 | TAD CM3 | |
1342 | SZA /IS IT AN ASTERISK | |
1343 | JMP NAH /NO | |
1344 | JMS I GETCH /YES- PEEK AT NEXT CHAR | |
1345 | JMP NOASS /ALPHA-- PUT IT BACK | |
1346 | JMP ASSCK /PUNCTUATION-- CHECK FOR AN ASTERISK | |
1347 | NOASS, JMS I PUTCH /DIGIT---PUT IT BACK | |
1348 | NAH, TAD X52 /RESTORE CHARACTER TO WHAT IT WAS | |
1349 | JMP PRET /THATS ALL---IT WAS PUNCTIONATION | |
1350 | ASSCK, TAD CM52 /ANOTHER PUNCTUATION--IS IT (*) | |
1351 | SZA | |
1352 | JMP NOASS /NO---PUT IT BACK | |
1353 | TAD C45 /IT WAS-- CHANGE ** TO PERCENT | |
1354 | JMP PRET /---ALTERED PUNCTUATION | |
1355 | DIG, AND C17 /FIRST CHAR WAS A DIGIT, DONT KNOW IS INTEGER O | |
1356 | DCA L32 /AT ANY RATE SAVE IT IN THE PSEUDO ACCUMULATER | |
1357 | CA, JMS I GETCH /GET ANOTHER CHACTER | |
1358 | JMP I LTESTE /ALPHA--GO SEE IF IT IS AN -E- | |
1359 | SKP /PUNCT | |
1360 | JMP BONT /DIGIT GO PROCESS IT | |
1361 | TAD C7722 /PUNCTUATION HERE, IS IT A PERIOD | |
1362 | SZA | |
1363 | JMP I LCOP / IT IS . WE HAVE A FLOATING POINT NUMBER | |
1364 | CC, TAD FPSW | |
1365 | SZA | |
1366 | ERR10, JMS I LUNCH /TOO MANY (.) | |
1367 | ISZ FPSW | |
1368 | DCA COUNT2 | |
1369 | JMP CA /GO BACK AND GET ANOTHER CHAR | |
1370 | BONT, AND C17 /***COME HERE WITH ANOTHER DIGIT. | |
1371 | DCA L36 /SAVE IT | |
1372 | ISZ COUNT2 | |
1373 | JMS I LMUL10 / AC = AC * 10 + DIGIT | |
1374 | JMP CA /GO GET ANOTHER CHAR | |
1375 | P33, L30+3 | |
1376 | CM6, -6 | |
1377 | C7722, 7722 | |
1378 | X52, 52 | |
1379 | CM52, -52 | |
1380 | C17, 17 | |
1381 | LTESTE, TESTE | |
1382 | C45, 45 | |
1383 | LCOP, COP | |
1384 | LMUL10, MUL10 | |
1385 | QUOTE, LQUOTE | |
1386 | ||
1387 | ||
1388 | DMPLIN, 0 /SUBROUTINE TO DUMP "LAST LINE" BUFFER | |
1389 | ISZ L24 | |
1390 | TAD I L24 /GET NEXT CHAR | |
1391 | JMS I PUNCH /PUNCH IT | |
1392 | TAD I L24 | |
1393 | TAD CM212 | |
1394 | SZA CLA /IS CHAR A LINE FEED? | |
1395 | JMP DMPLIN+1 /NO | |
1396 | CLA IAC | |
1397 | DCA L24 /RESET POINTER | |
1398 | DCA L12 /ZERO CONTENTS FLAG | |
1399 | JMP I DMPLIN /RETURN | |
1400 | CM212, -212 | |
1401 | CC7700, 7700 | |
1402 | \f *1600 | |
1403 | TESTE, TAD C7773 /IS IT E | |
1404 | SZA | |
1405 | JMP COP /NO, GO PUT IT BACK AND PROCESS | |
1406 | / HERE IF EXPONENT FOLLOWES | |
1407 | DCA L37 /IT WAS AN E | |
1408 | / THIS ROUTINE IS TO PROCESS THE EXPONENT THAT FOLLOWES THE -E- THAT WE | |
1409 | / | |
1410 | ISZ FPSW /MAKE SURE THE FLOATING POINT SWITCH WAS KICKED | |
1411 | JMS I GETCH /GET ANOTHER CHAR | |
1412 | JMP ERR12 /ALPHA , CANT BE-- SO LONG, ITS BEEN NICE | |
1413 | SKP /PUNCT | |
1414 | JMP CD /DIGIT, GO PROCESS IT | |
1415 | TAD X7725 /IS IT PULS SIGN | |
1416 | SNA | |
1417 | JMP CF /YES, IGNOR IT | |
1418 | TAD CM2 | |
1419 | SZA /IS IT MINUS | |
1420 | JMP COP /NO, GO PROCESS THE FLOATING POINT NUMBER | |
1421 | CLA CMA | |
1422 | DCA ESIGN /YES- REMEMBER THAT THE EXPONENT WAS MINUS | |
1423 | CF, JMS I GETCH /GET ANOTHER CHAR | |
1424 | JMP COP /ALPHA, ALL READY TO PROCESS | |
1425 | JMP COP /PUNCTUATION, READY TO PROCESS | |
1426 | CD, AND X17 /DIGIT | |
1427 | DCA L36 /SAVE IT IN 36 AND.. | |
1428 | TAD L37 /MULTIPLY THE - EXPONENT TO DATE- BY 10 | |
1429 | RAL CLL | |
1430 | DCA L37 | |
1431 | TAD L37 | |
1432 | RAL CLL | |
1433 | RAL CLL | |
1434 | TAD L37 | |
1435 | TAD L36 /AND ADD IN THIS DIGIT I.E. 37C10* | |
1436 | DCA L37 / L37 = 10 * L37 + L36 | |
1437 | JMP CF /GO DO IT AGAIN | |
1438 | COP, JMS I PUTCH | |
1439 | CLA CLL /PROCESS THIS NUMBER | |
1440 | TAD FPSW /IS IT AN INTEGER | |
1441 | SZA CLA | |
1442 | JMP CH /NO, MUST BE FLOATING POINT | |
1443 | / INTEGER IS IN ACC | |
1444 | TAD L30 /YESS | |
1445 | SNA /MAKE SURE INTEGER IS VALID | |
1446 | TAD L31 | |
1447 | SZA CLA | |
1448 | JMP ERR12 | |
1449 | TAD L32 | |
1450 | SPA CLA | |
1451 | ERR12, JMS I LUNCH /TOO BIG | |
1452 | JMP I .+1 /TAKE INTEGER RETURN WITH INTEGER IN 32 | |
1453 | XIRET | |
1454 | CH, TAD L37 /WAS THIS AN E-CONVERSION NUMBER | |
1455 | ISZ ESIGN /EXPONENT POSITIVE? | |
1456 | CIA /YES | |
1457 | TAD COUNT2 /ADD POST-DECIMAL COUNTER | |
1458 | CLL | |
1459 | SNA | |
1460 | JMP CM /NOTHING TO DO | |
1461 | SMA /DETERMINE WHETHER TO | |
1462 | CML CIA /MULTIPLY OR DIVIDE | |
1463 | DCA COUNT2 | |
1464 | RAL | |
1465 | TAD CJ | |
1466 | DCA CK | |
1467 | JMS XFLOAT /SET UP THE NUMBER | |
1468 | CK, HLT /JMP I (MULT OR JMP I (DIVIDE | |
1469 | ISZ COUNT2 | |
1470 | JMP CK /LOOP ON COUNT | |
1471 | JMP I LPOLIS /FINISH UP | |
1472 | ||
1473 | CM, JMS XFLOAT | |
1474 | JMP I LPOLIS | |
1475 | CJ, JMS I .+1 | |
1476 | MULT | |
1477 | DIVIDE | |
1478 | ||
1479 | / THIS ROUTINE CONVERTS THE NUMBER TO FLOATING POINT | |
1480 | XFLOAT, 0 | |
1481 | CLA CLL | |
1482 | TAD L32 /CHECK IF THE ACCUMULATED NUMBER IS ZERO | |
1483 | SNA | |
1484 | TAD L31 | |
1485 | SNA | |
1486 | TAD L30 | |
1487 | SNA CLA | |
1488 | JMP I LFRET /IT WAS ZERO SEND A FLOATING POINT ZERO BACK-- | |
1489 | TAD C2440 /IT IS NOT ZERO--SET THE EXPON TO 36 BASE 10 | |
1490 | DCA L37 | |
1491 | JMS NORMAL /GO TO THE NORMALIZE ROUTINE | |
1492 | JMP I XFLOAT /AT THIS POINT THE MANTISA AND EXPON ARE SEPERA | |
1493 | / ALSO NOTICE THAT WE HAVE 36 BINARY DIGITS I E THE WHOLE 3 WORDS ARE U | |
1494 | / NORMAL IZATION OF A F P NUMBER | |
1495 | NORMAL, 0 | |
1496 | DA, TAD L30 /WE MUST SHIFT UNTIL THE HIGH ORDER WORD GOES N | |
1497 | SPA CLA | |
1498 | JMP I NORMAL /IT IS NEG., ALL DONE | |
1499 | JMS I LLSHIF /GO DO A TRIPLE PRECISION LEFT SHIFT | |
1500 | TAD L37 /AND SUBTRACT ONE FROM THE EXPONENT | |
1501 | TAD C7770 /NOTE-- THE 3 LOW ORDER BITS ARE NOT USED | |
1502 | SPA /IF THIS DOESNT SKIP WE HAVE F P OVERFLOW | |
1503 | JMP ERR12 /BY-BY NUMBER TOO LARGE FOR THE MACHINE | |
1504 | DCA L37 | |
1505 | JMP DA | |
1506 | / THE FOLLOWING ROUTINE SAVES THE ACC IN THE MQ | |
1507 | C7773, 7773 | |
1508 | X7725, 7725 | |
1509 | X17, 17 | |
1510 | C7770, 7770 | |
1511 | LPOLIS, POLISH | |
1512 | LFRET, FRET | |
1513 | C2440, 2440 | |
1514 | LLSHIF, LSHIFT | |
1515 | ||
1516 | SCODE, CDF 10 /SHIFT S-CODE 2 COLS. LEFT | |
1517 | TAD I (TEM1 | |
1518 | CDF 0 | |
1519 | DCA SLOC1 | |
1520 | TAD SLOC1 | |
1521 | IAC | |
1522 | DCA SLOC2 | |
1523 | ISZ L61 /SET COMMENT FLAG | |
1524 | SCODL, TAD I SLOC2 | |
1525 | DCA I SLOC1 | |
1526 | TAD I SLOC2 | |
1527 | AND C77 | |
1528 | SNA CLA /END OF LINE? | |
1529 | JMP I (STORSL+2 | |
1530 | ISZ SLOC1 | |
1531 | ISZ SLOC2 | |
1532 | JMP SCODL /AND CONTINUE PROCESS | |
1533 | ||
1534 | SLOC1, 0 | |
1535 | SLOC2, 0 | |
1536 | \f *2000 | |
1537 | XSAVE, 0 /-- THE F.P. AC IS IN LOCS 30-32 | |
1538 | TAD L30 /-- THE "MQ" IS IN LOCS 33-35 | |
1539 | DCA L33 /---THE EXPONENT IS IN LOCS 37 | |
1540 | TAD L31 | |
1541 | DCA L34 | |
1542 | TAD L32 | |
1543 | DCA L35 | |
1544 | JMP I XSAVE | |
1545 | / SHIFTS THE PSEUDO-ACC LEFT ONE PLACE | |
1546 | LSHIFT, 0 | |
1547 | CLA CLL | |
1548 | TAD L32 | |
1549 | RAL | |
1550 | DCA L32 | |
1551 | TAD L31 | |
1552 | RAL | |
1553 | DCA L31 | |
1554 | TAD L30 | |
1555 | RAL | |
1556 | DCA L30 | |
1557 | JMP I LSHIFT | |
1558 | / THE FOLLOWING ROUTINE ADDS THE MQ TO THE ACC | |
1559 | ADD, 0 | |
1560 | CLA CLL | |
1561 | TAD L32 | |
1562 | TAD L35 | |
1563 | DCA L32 | |
1564 | RAL | |
1565 | TAD L31 | |
1566 | TAD L34 | |
1567 | DCA L31 | |
1568 | RAL | |
1569 | TAD L30 | |
1570 | TAD L33 | |
1571 | DCA L30 | |
1572 | JMP I ADD | |
1573 | / THE FOLLOWING ROUTINE SHIFTS THE ACC RIGHT ONE PLACE | |
1574 | RSHIFT, 0 | |
1575 | CLA CLL | |
1576 | TAD L30 | |
1577 | RAR | |
1578 | DCA L30 | |
1579 | TAD L31 | |
1580 | RAR | |
1581 | DCA L31 | |
1582 | TAD L32 | |
1583 | RAR | |
1584 | DCA L32 | |
1585 | JMP I RSHIFT | |
1586 | / | |
1587 | / | |
1588 | MULT, 0 /ACCCACC*10 MQ | |
1589 | JMS RSHIFT | |
1590 | JMS XSAVE | |
1591 | JMS RSHIFT | |
1592 | JMS RSHIFT | |
1593 | JMS ADD /THIS FINISHES THE MULT BY 10 | |
1594 | TAD L37 /NOW DIDDLE THE EXPONENT | |
1595 | TAD C40 | |
1596 | SPA /OVERFLOW TEST | |
1597 | ERR14, JMS I LUNCH /FLOATING POINT OVERFLOW | |
1598 | DCA L37 | |
1599 | JMS I LNRMAL /MAKE SURE THE F P NUMBER IS STILL IN NORMAL FO | |
1600 | JMP I MULT | |
1601 | DIVIDE, 0 /DIVIDE THE F P NUMBER BY 10 | |
1602 | JMS RSHIFT /BASED ON THE FACT THAT .1 BASE 10 C .000110011 | |
1603 | JMS XSAVE /THAT IS WE MULTIPLE BY ONE TENTH | |
1604 | TAD C7766 /THIS IS A COUNTER********************** | |
1605 | DCA ZCTR | |
1606 | DB, JMS RSHIFT | |
1607 | JMS ADD | |
1608 | ISZ ZCTR | |
1609 | SKP | |
1610 | JMP DC | |
1611 | JMS RSHIFT | |
1612 | JMS RSHIFT | |
1613 | JMS RSHIFT | |
1614 | JMS ADD | |
1615 | JMP DB | |
1616 | DC, TAD L37 | |
1617 | TAD C7750 /********INSERT HERE THE CONSTANT************ | |
1618 | DCA L37 /WE HAVE JUST DIDDLED THE EXPONENT BY THE PROP | |
1619 | JMS I LNRMAL /MAKE SURE IT IS STILL NORMALIZ D | |
1620 | JMP I DIVIDE | |
1621 | ZCTR, 0 | |
1622 | MUL10, 0 /THIS MULTIPLIES THE TRIPLE PREC. INTEGER INT E | |
1623 | JMS LSHIFT /BY 10 | |
1624 | JMS XSAVE | |
1625 | JMS LSHIFT | |
1626 | JMS LSHIFT | |
1627 | JMS ADD | |
1628 | TAD L36 /NOW CRAM THE DIGIT THAT WE WANT TO ADD INTO TH | |
1629 | DCA L35 /* | |
1630 | DCA L34 | |
1631 | DCA L33 | |
1632 | JMS ADD /AND ADD IT TO THE ACC | |
1633 | JMP I MUL10 /IN OTHER WORDS ACCCACC*10 DIGIT | |
1634 | POLISH, CLA CLL /THIS TAKES THE SEPARATE MANTISSA AND EXP--ENT. | |
1635 | TAD C400 /AND PUTS THEM INTO 7090 FORM. THIS IS THE R-U | |
1636 | DCA L35 /27 DIGITS | |
1637 | DCA L34 /ROUND FACTOR IS CRAMED INTO THE MQ | |
1638 | DCA L33 | |
1639 | JMS ADD /AND ADDED TO THE INTEGER IN THE ACC | |
1640 | SNL /IF THE LINK IS ON, WE OVERFLEW ON THE CARRY | |
1641 | JMP POLSH /WE DIDNT | |
1642 | TAD C4000 /SET THE ACC TO .1000000000 (THE REST OF IT IS | |
1643 | DCA L30 | |
1644 | TAD L37 /DIDDLE THE EXPONENT BY ONE. THIS IS A FINKIE N | |
1645 | TAD J10 | |
1646 | SNA | |
1647 | JMP ERR14 /EXPONENT OVERFLOW ... | |
1648 | DCA L37 | |
1649 | POLSH, TAD C7767 /NOW SHIFT THE ENTIRE ACC RIGHT 9 TIMES | |
1650 | DCA ZCTR /( THATS SO WE WILL HAVE ROOM TO STICK IN THE E | |
1651 | HOOP, JMS RSHIFT | |
1652 | ISZ ZCTR | |
1653 | JMP HOOP | |
1654 | TAD L37 /CRAM THE EXP | |
1655 | TAD L30 /INTO THE ACC | |
1656 | DCA L30 /AND VOILA, WE ARE DONE. GO TAKE THE FPOINT EX | |
1657 | JMP I .+1 | |
1658 | FRET | |
1659 | LNRMAL, NORMAL | |
1660 | C7766, 7766 | |
1661 | C7750, 7750 | |
1662 | C400, 400 | |
1663 | J10, 10 | |
1664 | C7767, 7767 | |
1665 | \f *2200 | |
1666 | / THE FOLLOWING ROUTINE LOOKS FOR A STATEMENT NUMBER | |
1667 | LSTMT, 0 | |
1668 | JMS I CLEAR /CLEAR THE PSEUDO ACC AND MQ | |
1669 | TAD C7240 /DON'T LET LGTC GET ANOTHER LINE YET(CHK MUST BE NEG., BUT NOT 4000!!) | |
1670 | DCA CHK | |
1671 | IAC | |
1672 | DCA KOUNT | |
1673 | LABEL, JMS I GTCL /GET A CHARACTER | |
1674 | SNA /IS THIS A CAR RET? | |
1675 | ERR15, JMS I LUNCH /YES, INCOMPLETE STATEMENT | |
1676 | TAD CM40 | |
1677 | SNA /SPACE? | |
1678 | JMP SPACE | |
1679 | TAD CM32 | |
1680 | CLL | |
1681 | TAD C12 | |
1682 | SNL / 260 <= CHAR < 272 ? | |
1683 | ERR16, JMS I LUNCH | |
1684 | DCA L36 /SAVE THIS DIGIT... | |
1685 | JMS I MULT10 / ACC = 10 * ACC + L36 | |
1686 | SPACE, TAD KOUNT | |
1687 | TAD DM6 | |
1688 | SPA CLA /END OF STMT NR FIELD? | |
1689 | JMP LABEL /NOT YET... | |
1690 | JMS I GTCL /SKIP OVER COL 6 | |
1691 | SNA CLA /IS IT A CAR RET? | |
1692 | JMP ERR15 | |
1693 | TAD L31 /SEE IF STMT NR IS LEGAL... | |
1694 | SZA | |
1695 | JMP ERR16 | |
1696 | TAD L32 | |
1697 | SPA CLA /IS STMT NR < 2048 ? | |
1698 | JMP ERR16 /NO, STMT NR TOO BIG | |
1699 | JMP I LSTMT | |
1700 | CLEAR, LCLEAR | |
1701 | GTCL, LGTC | |
1702 | MULT10, MUL10 | |
1703 | CM32, -32 | |
1704 | DM6, -6 | |
1705 | C12, 12 | |
1706 | / | |
1707 | / SUBROUTINEE TO PRINT A SYMBOL | |
1708 | / | |
1709 | / JMS I PRSYM | |
1710 | / | |
1711 | LPRSYM, 0 /THIS ROUTINE PRINTS SYMBOLS | |
1712 | DCA LCH | |
1713 | TAD LCH | |
1714 | SMA /IS IT AN INTEGER CONSTANT | |
1715 | JMP ICON /YES PROCESS IT | |
1716 | RTL /SHIFT THE NEXT BIT INTO THE LINK | |
1717 | SNL /IS IT A TEMPORARY | |
1718 | JMP TEMPO /ITS A TEMPORARY | |
1719 | RTR /RESTORE THE SYMBOL | |
1720 | CIA /SET IT NEGATIVE | |
1721 | TAD L47 /SUBTRACT THE BEGINNING OF THE XFCON TABLE | |
1722 | SPA CLA /DO WE HAVE AN FCON | |
1723 | JMP XFCON /YES PROCESS IT | |
1724 | TAD LCH | |
1725 | TAD C2 /ADD TWO TO THE SYMBOL TABLE POINTER | |
1726 | DCA LP2 /AND SAVE IT | |
1727 | TAD I LP2 /GET THE CONTROL BITS FOR THE SYMBOL | |
1728 | RAR /GET EXTERNAL SUBROUTINE BIT IN LINK | |
1729 | SZL CLA /IS THIS AN EXTERNAL SUBROUTINE | |
1730 | JMP SKPIT /YES...DONT PUT OUT THE BACK SLASH | |
1731 | TAD C34 | |
1732 | JMS I PRINT | |
1733 | SKPIT, TAD I LCH | |
1734 | JMS LP2 /PRINT THEM | |
1735 | ISZ LCH | |
1736 | TAD I LCH | |
1737 | JMS LP2 /AND PRINT THEM | |
1738 | ISZ LCH | |
1739 | TAD I LCH | |
1740 | AND X7700 /MASK SO WE DONT PUT OUT CONTROL BITS | |
1741 | JMS LP2 /AND PRINT IT | |
1742 | JMP I LPRSYM /NOW RETURN | |
1743 | LP2, 0 /THIS IS THE ROUTINE THAT PRINTS TWO CHARACTERS | |
1744 | DCA UNCH /SAVE THE CHARS | |
1745 | TAD UNCH /GET THEM AGAIN | |
1746 | RTR /ROTAT FIRST CHAR INTO POSITION | |
1747 | RTR | |
1748 | RTR | |
1749 | AND C77 /MASK SECOND CHARACTER | |
1750 | SZA /IS IT AN ACTUAL CHARACTER | |
1751 | JMS I PRINT /YES PRINT IT | |
1752 | TAD UNCH /GET THE TWO CHARS AGAIN | |
1753 | AND C77 /MASK OUT FIRST CHARACTER | |
1754 | SZA /IS IT ACTUALLY A CHARACTER | |
1755 | JMS I PRINT /YES PRINT IT | |
1756 | JMP I LP2 /AND RETURN | |
1757 | ICON, CLA /INTEGER CONSTANT, PUNCH A '(' | |
1758 | TAD K50 | |
1759 | JMS I PRINT | |
1760 | TAD LCH /AND THE NUMBER | |
1761 | PROCT, JMS I PROTAC | |
1762 | JMP I LPRSYM /RETURN | |
1763 | TEMPO, RTL | |
1764 | SPA CLA /SUBSCRIPT TEMPORARY? | |
1765 | JMP SBSCR | |
1766 | RTL | |
1767 | TAD D33 /PUNCH '[' FOR INTEGER AND ']' FOR FLOATING PT | |
1768 | JMS I PRINT /AND PRINT IT | |
1769 | TAD LCH | |
1770 | SPA /DO WE STILL HAVE A TEMPORARY | |
1771 | JMS I TEMPOR /YES GET THE TEMPORARY NUMBER | |
1772 | JMS I PRINT /AND PRINT IT | |
1773 | JMP I LPRSYM /RETURN | |
1774 | SBSCR, TAD D33 /SUBSCRIPT TEMPORARY, PUNCH A '[' | |
1775 | JMS I PRINT | |
1776 | TAD LCH | |
1777 | JMS I SUBTEM /AND 4 DIGITS | |
1778 | JMP PROCT | |
1779 | XFCON, TAD C35 /FLOATING POINT CONSTANT... | |
1780 | JMS I PRINT /PUNCH A ']' | |
1781 | TAD LCH | |
1782 | CIA | |
1783 | TAD L50 /SUBTRACT FROM END OF TABLE | |
1784 | JMP PROCT | |
1785 | D33, 33 | |
1786 | C35, 35 | |
1787 | K50, 50 | |
1788 | C34, 34 | |
1789 | X7700, 7700 | |
1790 | LCH, 0 | |
1791 | UNCH, 0 | |
1792 | SUBTEM, LSBTEM | |
1793 | TEMPOR, LTMPOR | |
1794 | \f *2400 | |
1795 | / | |
1796 | / SUBROUNTINE TO DO SYMBOL TABLE MANIPULATIONS | |
1797 | / | |
1798 | C300, 300 | |
1799 | C212, 212 | |
1800 | C215, 215 | |
1801 | SCOUNT, 0 /CURRENT NUMBER OF SYMBOLS | |
1802 | XCTR, 0 /COUNTER | |
1803 | FCOUNT, 0 /CURRENT NUMBER OF FCONS | |
1804 | LSYMTB, 0 | |
1805 | CLA /CLEAR THE AC | |
1806 | LOOP1, TAD L56 /GET BEGINNING OF SYMBOL TABLE | |
1807 | DCA LSYMTM /AND SAVE IN TABLE | |
1808 | TAD SCOUNT /GET NUMBER OF SYMBOLS CURRENTLY | |
1809 | CMA | |
1810 | DCA XCTR /USE AS A COUNTER | |
1811 | TAD C7700 /GIVE SEARCH A MASK TO USE ON LAST SYMBOL | |
1812 | JMS SEARCH /LOOK FOR OCCURRENCE OF SYMBOL IN TABLE | |
1813 | JMP ZCHECK /SYMBOL IS IN TABLE CHECK IT | |
1814 | TAD L57 /TELL ENTER WHERE TO PUT THE SYMBOL | |
1815 | JMS ENTER /ENTER THE SYMBOL | |
1816 | TAD C3 /UPDATE THE POINTER | |
1817 | DCA L57 /AND SAVE IT | |
1818 | DCA L21 /ZERO SWITCH SINCE SYMBOL JUST LOADED | |
1819 | ISZ SCOUNT /UPDATE COUNT OF SYMBOLS | |
1820 | JMP LOOP1 /GO BACK AND CHECK IT | |
1821 | ZCHECK, TAD L77 /GET POINTER INTO SYMBOL TABLE | |
1822 | TAD C2 /MOVE TO LAST WORD | |
1823 | DCA LSYMTM /SAVE IT | |
1824 | TAD I LSYMTM /GET THE CONTROL BITS | |
1825 | AND L21 /AND THE MASK | |
1826 | SZA CLA /ARE ANY ILLEGAL BITS ON | |
1827 | ERR54, JMS I LUNCH /ERROR 54 ... PROBABLY IN EQUIVALENCING ... | |
1828 | TAD L32 /NOW OR IN NEW BITS | |
1829 | CMA | |
1830 | AND I LSYMTM | |
1831 | TAD L32 | |
1832 | DCA I LSYMTM | |
1833 | JMP I LSYMTB /RETURN | |
1834 | / FLOATING CONSTANT IS IN 30 THRU 32 | |
1835 | LFCON, 0 | |
1836 | CLA | |
1837 | MLOOP, TAD L47 /GET BEGINNING OF FCON TABLE | |
1838 | TAD C3 /MOVE TO ACTUAL START OF TABLE | |
1839 | DCA LSYMTM /AND SAVE | |
1840 | TAD FCOUNT /GET NUMBER OF FCONS SO FAR | |
1841 | CMA | |
1842 | DCA XCTR /AND USE FOR A COUNTER | |
1843 | CMA /GIVE SEARCH A MASK FOR THE LAST WORD | |
1844 | JMS SEARCH /SEARCH THE TABLE FOR THE CURRENT FCON | |
1845 | JMP I LFCON /ITS ALREADY IN THERE JUST RETURN | |
1846 | TAD L47 /TELL ENTER WHERE TO PUT THE FCON | |
1847 | JMS ENTER /ENTER THE FCON | |
1848 | TAD CM3 /AND UPDATE IT | |
1849 | DCA L47 /AND SAVE | |
1850 | ISZ FCOUNT /UPDATE NUMBER OF FCONS | |
1851 | JMP MLOOP /GO BACK AND CHECK | |
1852 | / THIS IS THE ROUTINE THAT SEARCHES THE TABLES FOR | |
1853 | / OCCURRENCES OF THE CURRENT SYMBOL OR FCON | |
1854 | SEARCH, 0 | |
1855 | DCA ENTER /SAVE THE MASK | |
1856 | MBACK, ISZ XCTR /SEE IF WE HAVE PROCESSED ALL SYMBOLS | |
1857 | SKP /NO GO ON | |
1858 | JMP QRET /YES | |
1859 | TAD I LSYMTM /GET FIRST WORD OF SYMBOL | |
1860 | CIA /NEGATE | |
1861 | TAD L30 /SUBTRACT FIRST WORD OF CURRENT SYMBOL | |
1862 | ISZ LSYMTM /INCREMENT POINTER | |
1863 | SZA CLA /DO THEY MATCH | |
1864 | JMP I1 /NO GO TO NEXT SYMBOL | |
1865 | TAD I LSYMTM /YES GET SECOND WORD OF SYMBOL | |
1866 | CIA | |
1867 | TAD L31 /SUBTRACT SECOND WORD OF CURRENT SYMBOL | |
1868 | ISZ LSYMTM /ADVANCE POINTER | |
1869 | SZA CLA /DO THEY MATCH | |
1870 | JMP I2 /NO GO TO NEXT SYMBOL | |
1871 | TAD I LSYMTM /SEE IF NEXT WORD MATCHES | |
1872 | AND ENTER /MASK OUT DESIRED PORTIONS | |
1873 | CIA | |
1874 | TAD L32 /SUBTRACT THIRD CURRENT WORD | |
1875 | AND ENTER /K AGAIN | |
1876 | ISZ LSYMTM /ADVANCE POINTER | |
1877 | SZA CLA /DO THEY MATCH | |
1878 | JMP MBACK /NO GO TO NEXT SYMBOL | |
1879 | TAD LSYMTM /YES | |
1880 | TAD CM3 /MOVE BACK POINTYER | |
1881 | DCA L77 /PUT POINTER IN PAGE ZERO | |
1882 | JMP I SEARCH /RETURN | |
1883 | QRET, ISZ SEARCH /SET UP RETURN FOR NOT FOUND | |
1884 | JMP I SEARCH /RETURN | |
1885 | I1, ISZ LSYMTM /ADVANCE POINTER | |
1886 | I2, ISZ LSYMTM /ADVANCE PIINTER | |
1887 | JMP MBACK /GO TO NEXT SYMBOL | |
1888 | / THIS ROUTINE ENTERS THE CURRENT SYMBOL INTO THE TABLE SPECIFIED | |
1889 | ENTER, 0 | |
1890 | DCA LSYMTM /SAVE ADDRESS | |
1891 | TAD L47 /GET BEGINNING OF FCON TABLE | |
1892 | CMA | |
1893 | TAD L57 /SUBTRACT END OF SYMBOL TABLE | |
1894 | C7700, SMA CLA /IS THERE ROOM FOR ANOTHER SYMBOL OR FCON | |
1895 | ERR17, JMS I LUNCH /NO | |
1896 | TAD L30 /YES GEYT FIRST WORD | |
1897 | DCA I LSYMTM /STORE IT | |
1898 | TAD LSYMTM | |
1899 | DCA L11 /SET UP AUTO - XR | |
1900 | TAD L31 | |
1901 | DCA I L11 | |
1902 | TAD L32 | |
1903 | DCA I L11 | |
1904 | TAD LSYMTM /GET THE ADDRESS BACK INTO THE AC | |
1905 | JMP I ENTER /AND RETURN | |
1906 | DUMPLN, DMPLIN | |
1907 | LSYMTM=. | |
1908 | LPRINT, 0 / CONVERTS FROM TRIMMED TO EIGHT BIT ASCII | |
1909 | DCA LFCON /SAVE THE CHARACTER | |
1910 | TAD L75 /S GET THE SUPPRESS PRINTING WITCH | |
1911 | SZA CLA | |
1912 | JMP I LPRINT | |
1913 | ISZ L24 /IS THIS A NEW LINE? | |
1914 | SKP /NO | |
1915 | JMS I DUMPLN /YES - DUMP THE OLD ONE FIRST | |
1916 | TAD LFCON /NO...GET THE CHARACTER | |
1917 | SNA /IS IT A CR | |
1918 | JMP CRLF /YES...PUT OUT CRLF | |
1919 | AND C40 /CHECK BIT SIX | |
1920 | CLL RAL | |
1921 | CIA /AC CONTAINS 0 OR -100 | |
1922 | TAD C300 /NOW CONTAINS 300 OR 200 | |
1923 | TAD LFCON /NOW ADD THE CHARACTER IN | |
1924 | \fPRIT, DCA I L24 /AND STORE IT IN THE BUFFER | |
1925 | JMP I LPRINT | |
1926 | CRLF, TAD C215 /GET AN EIGHT BIT CR | |
1927 | DCA I L24 /STORE IT IN THE BUFFER | |
1928 | ISZ L24 | |
1929 | TAD C212 | |
1930 | DCA I L24 /STORE A LINE FEED TOO | |
1931 | CLA CMA | |
1932 | DCA L24 /SET SWITCH TO DUMP LINE ON NEXT CHAR | |
1933 | JMP I .+1 | |
1934 | PRIT+1 | |
1935 | \fLCOMON, CLA | |
1936 | JMS I LOOK /CHECK REST OF STATEMENT NAME | |
1937 | -2 /TWO CHARACTERS | |
1938 | -17 /O | |
1939 | -16 /N | |
1940 | GETVAR, JMS I ENTITY /GET A VARIABLE | |
1941 | SKP /NOT A VARIZBLE | |
1942 | JMP VARI /WE GOT A VARIABLE | |
1943 | NOP | |
1944 | B20, 20 | |
1945 | ERR18, JMS I LUNCH /ERROR | |
1946 | VARI, TAD C40 | |
1947 | TAD L32 /PUT IN COMMON BIT | |
1948 | DCA L32 | |
1949 | TAD K37 /GET MASK FOR SYMBOL TABLE SWITCH | |
1950 | DCA L21 /PUT IN THE SWITCH | |
1951 | JMS I SYMTAB /PUT SYMBOL IN TABLE | |
1952 | JMS I ENTITY /LOOK FOR A COMMA | |
1953 | JMP START /THAT'S ALL GOT A CR-LF... | |
1954 | K37, 37 | |
1955 | K27, 27 | |
1956 | JMP .+3 /ERROR | |
1957 | TAD CM54 /CHECK FOR COMMA | |
1958 | SZA CLA /IS IT A COMMA | |
1959 | JMP ERR18 /NO...ERROR | |
1960 | JMP GETVAR /GET ANOTHER VARIABLE | |
1961 | LDIMEN, JMS I LOOK /LOOK FOR REST OF STATEMENT | |
1962 | -5 /FIVE CHARS | |
1963 | -16 /N | |
1964 | -23 /S | |
1965 | -11 /I | |
1966 | -17 /O | |
1967 | -16 /N | |
1968 | QAGAIN, CLA CMA /-U | |
1969 | DCA REDY /SET SWITH FOR VARIABLE | |
1970 | QGET, JMS I ENTITY /GET WHATEVER IS NEXT IN LINE | |
1971 | JMP QDONE /IT EAS A CR | |
1972 | JMP .+4 /IT WAS A VARIABLE | |
1973 | JMP ASUBSC /IT WAS ONE OF THE SUBSCRIPTS | |
1974 | JMP ERR18 /WE BETTER NOT GET ANY FP NUMBERS | |
1975 | JMP QPUNC /IT WAS A PUNCTION | |
1976 | ISZ REDY | |
1977 | JMP ERR18 /WE WERENT READY FOR A VAR | |
1978 | TAD B20 | |
1979 | TAD L32 | |
1980 | DCA L32 | |
1981 | TAD K27 /GET THE MASK FOR THE SYMBOL TABLE | |
1982 | DCA L21 /PUT IN THE SWITCH | |
1983 | JMS I SYMTAB /PUT SYMBOL IN TABLE | |
1984 | CMA CLA | |
1985 | TAD L47 /GET BEGINNING OF TABLE | |
1986 | DCA L16 | |
1987 | TAD L77 /GET TABLE ADDRESS | |
1988 | DCA I L16 | |
1989 | CLA CMA | |
1990 | DCA V /SET WITCH TO SAY WEVE GOTTEN A VAR | |
1991 | JMP QGET /GET NEXT THING | |
1992 | QPUNC, TAD CM54 | |
1993 | SNA /IS IT A COMMA | |
1994 | JMP COMMA /YES | |
1995 | TAD C3 | |
1996 | SNA | |
1997 | JMP QRPAR /RIGHT PAREN | |
1998 | IAC | |
1999 | SNA /IS IT A LEFT PAREN | |
2000 | ISZ V /PRECEDED BY A VAR | |
2001 | JMP ERR18 /NO - ERROR | |
2002 | CLA CMA | |
2003 | DCA XLP /SET SWITCH TO SHOW LPAR | |
2004 | JMP QGET | |
2005 | ASUBSC, ISZ XLP /DID WE JUST GET LPAR | |
2006 | JMP SECOND /NO...BETTER BE SECOND SUBSC | |
2007 | TAD L32 /GET INTEGER | |
2008 | DCA I L16 /PUT IN DIMTAB | |
2009 | CMA CLA | |
2010 | DCA QONE /SET SWITCH TO SHOW WE HAVE ONE SUBSC | |
2011 | JMP QGET | |
2012 | COMMA, ISZ QONE /DOES THIS COMMA SEPARATE SUBSCS | |
2013 | JMP RIGHT /NO...LAST CHAR BETTER HAVE BEEN L RPAR | |
2014 | CMA CLA | |
2015 | DCA SEC /SET SWITCH TO EXPECT SECOND SUBSCRIPT | |
2016 | JMP QGET | |
2017 | SECOND, ISZ SEC /IS THIS SECOND SUBSCRIPT | |
2018 | JMP ERR18 /NO...ERROR | |
2019 | TAD 32 /GET INTEGER | |
2020 | DCA I L16 | |
2021 | CMA CLA | |
2022 | DCA R /SET SWITCH FOR RPAR | |
2023 | JMP QGET | |
2024 | QRPAR, ISZ QONE /HAVE WE GOTTEN ONE SUBSC | |
2025 | JMP QTWO /NO...CHECK FOR TWO | |
2026 | IAC /ONLY ONE SO USE 1 AS SECOND | |
2027 | DCA I L16 | |
2028 | QBACK, CMA CLA | |
2029 | DCA RIG | |
2030 | TAD L47 /GET BEGINNING OF TABLE | |
2031 | DCA L50 /SAVE IN LOW CORE | |
2032 | TAD L47 | |
2033 | TAD CM3 /SUBTRACT THREE FROM ADDRESS | |
2034 | DCA L47 /AND SAVE | |
2035 | JMP QGET /WE EXPECT COMMA OR CR | |
2036 | QTWO, ISZ R /HAVE WE GOTTEN TWO | |
2037 | JMP ERR18 /NO...ERROR | |
2038 | JMP QBACK | |
2039 | RIGHT, ISZ RIG /DID WE JUST GET RPAR | |
2040 | JMP ERR18 /NO...ERROR | |
2041 | JMP QAGAIN | |
2042 | QDONE, ISZ RIG | |
2043 | JMP ERR18 | |
2044 | JMP START | |
2045 | QONE, 0 | |
2046 | RIG, 0 | |
2047 | R, 0 | |
2048 | REDY, 0 | |
2049 | V, 0 | |
2050 | XLP, 0 | |
2051 | SEC, 0 | |
2052 | \f *3000 | |
2053 | LGOTO, TAD L74 | |
2054 | DCA L16 /USE AUTO INDEXING | |
2055 | DCA L76 | |
2056 | JMS I ENTITY | |
2057 | NOP | |
2058 | SKP | |
2059 | JMP ALAB /WE HAVE A LABEL | |
2060 | JMP I ASSIGN | |
2061 | TAD CM50 /IF PUNCT...CHECK FOR LEFT PAREN | |
2062 | SZA CLA /IS IT ( | |
2063 | JMP I ASSIGN | |
2064 | ANEXT, JMS I ENTITY | |
2065 | NOP | |
2066 | SKP | |
2067 | JMP THERE /WE HAVE A LABEL | |
2068 | NOP | |
2069 | ERR28, JMS I LUNCH | |
2070 | THERE, TAD L32 /GET THE LABEL | |
2071 | DCA I L16 /PUT IN LIST | |
2072 | ISZ L76 | |
2073 | JMS I GNB | |
2074 | TAD CM54 /CHECK FOR BEING A COMMA | |
2075 | SNA /IS IT A COMMA | |
2076 | JMP ANEXT /YES GET ANOTHER LABEL | |
2077 | TAD C3 /CHECK FOR BEING A RIGHT PAREN | |
2078 | SZA CLA /IS IT A ) | |
2079 | JMP I ASSIGN | |
2080 | JMS I GNB | |
2081 | TAD CM54 /CHECK FOR ANOTHER COMMA | |
2082 | SZA /IS IT ANOTHER | |
2083 | JMS I PUTCH /IGNORE ANYTHING ELSE ... | |
2084 | JMS I ENTITY /GET THE CONTROL VARIABLE | |
2085 | SKP | |
2086 | JMP .+4 /WE GOT IT | |
2087 | NOP | |
2088 | NOP | |
2089 | ERR29, JMS I LUNCH | |
2090 | DCA L21 /ZERO THE SYMBOL TABLE SWITCH | |
2091 | JMS I SYMTAB /PUT VARIABLE IN SYMBOL TABLE | |
2092 | TAD L77 /GET ADD RESS OF SYMBOL | |
2093 | JMS I MODE /CHECK THE MODE OF THE VAIABLE | |
2094 | ERR30, JMS I LUNCH /ITS FLOATING POINT | |
2095 | JMS I ZZZ /PUT OUT STMT LABEL | |
2096 | JMS LXTAD /LOAD VARIABLE WITH TAD OR TAD* | |
2097 | JMS I PROP /PUT OUT OP CODE | |
2098 | Q6066, 6066 /OP CODE IS TAD | |
2099 | JMS I CREATE /GET THE NEXT CREATED LABEL | |
2100 | JMS I PRCRL /PRINT THE CREATED LABEL | |
2101 | JMS I PRINT /PUT OUT CR LF | |
2102 | JMS I PROP /PUT OUT OP CODE | |
2103 | 6071 /OP CODE IS DCA | |
2104 | TAD GO7 | |
2105 | JMS I PROTAC | |
2106 | JMS I PRINT /PUT OUT CRLF | |
2107 | JMS I PROP /PUNCH 'TAD I 7' | |
2108 | OPTADI | |
2109 | TAD GO7 | |
2110 | JMS I PROTAC | |
2111 | JMS I PRINT | |
2112 | JMS I PROP /PUNCH 'DCA 7' | |
2113 | OPDCA | |
2114 | TAD GO7 | |
2115 | JMS I PROTAC | |
2116 | JMS I PRINT | |
2117 | JMS I PROP /PUNCH 'JMP I 7' | |
2118 | OPJMPI | |
2119 | TAD GO7 | |
2120 | JMS I PROTAC | |
2121 | JMS I PRINT | |
2122 | TAD L76 /PUNCH 'CPAGE <N+1>' | |
2123 | IAC | |
2124 | JMS I PIFF | |
2125 | TAD L53 /PUNCH '<CR.LABEL2>, <CR.LABEL2>' | |
2126 | JMS I CLAB | |
2127 | TAD L53 | |
2128 | JMS I PRCRL | |
2129 | JMS I PRINT | |
2130 | TAD L76 /NOW PUNCH THE LABELS | |
2131 | CIA /SET NEGATIVE | |
2132 | DCA L76 | |
2133 | TAD L74 | |
2134 | DCA L16 /USE AUTO INDEXING AGAIN | |
2135 | TAD I L16 /GET THE NEXT LABEL | |
2136 | JMS I PLAB /PRINT THE LABEL | |
2137 | JMS I PRINT /PUT OUT CRLF | |
2138 | ISZ L76 | |
2139 | JMP .-4 /NO | |
2140 | JMP START | |
2141 | / THE FOLLOWING SECTION IS TO TREAT REGULAR GOTO S | |
2142 | ALAB, JMS I ZZZ | |
2143 | TAD L32 | |
2144 | JMS PRJUMP /PUT OUT A JUMP TO THE LABEL IN "L32" | |
2145 | JMP START | |
2146 | ||
2147 | LXTAD, 0 | |
2148 | TAD L77 /GET ADDRESS AGAIN | |
2149 | JMS I DUMARG | |
2150 | TAD CM3 | |
2151 | TAD Q6066 /TAD OR TAD* | |
2152 | DCA OP /USE AS OPERATOR | |
2153 | JMS I PROP /PUT OUT OP CODE | |
2154 | OP, 0 | |
2155 | TAD L77 /GET ADDRESS AGAIN | |
2156 | JMS I PRSYM /PRINT THE SYMBOL | |
2157 | JMS I PRINT /PUT OUT A CR LF | |
2158 | JMP I LXTAD | |
2159 | ||
2160 | LLEAD, 0 /PUNCH SOME LEADER... | |
2161 | DCA L7 | |
2162 | JMS I PUNCH | |
2163 | ISZ L7 | |
2164 | JMP .-2 | |
2165 | JMP I LLEAD | |
2166 | GO7, 7 | |
2167 | ||
2168 | PRJUMP, 0 /SUBROUTINE TO PUT OUT A JUMP | |
2169 | DCA LLEAD /STORE THE LABEL | |
2170 | JMS I PROP | |
2171 | 6044 /JMP | |
2172 | TAD LLEAD | |
2173 | JMS I PLAB /PUT OUT THE LABEL | |
2174 | JMS I PRINT /PUT OUT A CRLF | |
2175 | TAD LLEAD | |
2176 | DCA L12 /SET CONTENTS OF LAST LINE TO LABEL | |
2177 | JMP I PRJUMP | |
2178 | \f *3200 | |
2179 | / THE FOLLOWING ROUTINE PUNCHES OCTAL NUMBERS | |
2180 | ||
2181 | LPRTAC, 0 | |
2182 | DCA TMP /SAVE THE NUMBER | |
2183 | DCA TM | |
2184 | TAD CM4 /PUT OUT FOUR CHARACTERS | |
2185 | DCA DCTR /CHARACTER COUNTER | |
2186 | BK, TAD TMP /GET THE NUMBER | |
2187 | RAL /ROTATE IT LEFT ONE | |
2188 | RTL /ROTATE TWO LEFT...THAT MAKES ONE OCTAL DIGIT | |
2189 | DCA TMP /SAVE THE ROTATED NUMBER | |
2190 | TAD TMP /GET IT IN ACCUMULATOR | |
2191 | AND C3 | |
2192 | RAL /GET THE DIGIT INTO THE LOW-ORDER AC | |
2193 | ISZ DCTR /IS THIS THE LAST DIGIT? | |
2194 | JMP .+4 /NO, CONTINUE | |
2195 | TAD C60 /MAKE IT LOOK LIKE A TRIMMED ASCII DIGIT | |
2196 | JMS I PRINT /PRINT THE DIGIT | |
2197 | JMP I LPRTAC | |
2198 | SZA /DO WE HAVE A ZERO DIGIT? | |
2199 | JMP .+4 | |
2200 | TAD TM | |
2201 | SNA CLA /YES, IS IT A LEADING ZERO? | |
2202 | JMP BK /YES, IGNORE IT | |
2203 | TAD C60 | |
2204 | JMS I PRINT | |
2205 | ISZ TM /DON'T SUPPRESS ZEROS ANY MORE | |
2206 | JMP BK /NOW...PUT OUT ANOTHER | |
2207 | TMP, 0 | |
2208 | TM, 0 | |
2209 | CM4, -4 | |
2210 | C60, 60 | |
2211 | LIF, TAD CM4 | |
2212 | DCA COUNT1 /SET UP COUNTER | |
2213 | JMS I GNB | |
2214 | TAD CM50 /CHECK FOR LEFT PAREN | |
2215 | SZA CLA /IS IT A ( | |
2216 | JMP I ASSIGN | |
2217 | JMS I PUTCH /YES...PUT IT BACK FOR GENER | |
2218 | JMS I ZZZ | |
2219 | ISZ L52 /SET BALANCED PARENS SWITCH FOR GENER | |
2220 | ISZ L44 /SET SWITCH FOR RIGHT SIDE OF EQUALS SIGN | |
2221 | JMS I GENER /NOW CALL GENER AND PROCESS EXPRESSION | |
2222 | TAD I L41 | |
2223 | JMS I MODE /WHAT IS ITS MODE | |
2224 | JMS I GETHI /GET HI ORDER P.P. AC | |
2225 | TAD CDCA41 | |
2226 | DCA LIFDCA /SET UP INSTRUCTION TO STORE LABELS | |
2227 | LABL, JMS I ENTITY /GET A LABEL | |
2228 | D34, 34 | |
2229 | SKP | |
2230 | JMP INTEG /WE GO A LABEL | |
2231 | C46, 46 | |
2232 | ERR31, JMS I LUNCH /DIDNT GET A LABEL | |
2233 | INTEG, TAD L32 /GET THE LABEL | |
2234 | ISZ LIFDCA | |
2235 | LIFDCA, .-. /STORE LABELS IN L42 THROUGH L44 | |
2236 | DCTR=LIFDCA | |
2237 | ISZ COUNT1 /HAVE WE GOTTEN TOO MANY LABELS | |
2238 | SKP /NO | |
2239 | JMP ERR31 /YES | |
2240 | JMS I GNB | |
2241 | SNA /SEE IF ITS A CR | |
2242 | JMP .+5 /ITS A CR | |
2243 | TAD CM54 /CHECK FOR COMMA | |
2244 | SZA CLA /IS IT A COMMA | |
2245 | JMP ERR31 | |
2246 | JMP LABL /YES | |
2247 | ISZ COUNT1 /DID WE GET THE RIGHT NUMBER OF LABELS | |
2248 | JMP ERR31 /NO | |
2249 | TAD L42 | |
2250 | CIA | |
2251 | TAD L44 | |
2252 | SNA CLA /IF THE JUMPS FOR AC<0 AND AC>0 ARE EQUAL | |
2253 | JMP ISPECL /WE CAN SAVE SOME CODE | |
2254 | TAD L43 | |
2255 | CIA | |
2256 | TAD L44 | |
2257 | SNA CLA /IF THE JUMPS FOR AC=0 AND AC>0 ARE EQUAL | |
2258 | JMP SPCONL /WE CAN ALSO SAVE SOME CODE | |
2259 | JMS I PROP /PUT OUT OP CODE | |
2260 | 6105 /OP CODE IS SNA | |
2261 | JMS I PRINT /PUT OUT CRLF | |
2262 | TAD L43 | |
2263 | JMS I PRJMP /OUTPUT THE ZERO BRANCH | |
2264 | SPCONL, JMS I PROP /PUT OUT OP CODE | |
2265 | 6110 /OP CODE IS P SPA CLA | |
2266 | JMS I PRINT /PUT OUT CRLF | |
2267 | TAD L42 /OUTPUT THE NEGATIVE BRANCH | |
2268 | IFCOMN, JMS I PRJMP | |
2269 | TAD L44 | |
2270 | JMS I PRJMP /OUTPUT THE POSITIVE (>0) BRANCH | |
2271 | DCA L46 /ZERO AC | |
2272 | JMP START /GO GET NEXT STATEMENT | |
2273 | ISPECL, JMS I PROP /PUNCH 'SNA CLA' | |
2274 | OPSNA | |
2275 | JMS I PROP | |
2276 | OPCLA | |
2277 | JMS I PRINT | |
2278 | TAD L43 | |
2279 | JMP IFCOMN /OUTPUT THE ZERO AND POSITIVE BRANCHES | |
2280 | PRJMP, PRJUMP | |
2281 | COUNT1, 0 | |
2282 | LCREAT, 0 | |
2283 | ISZ L53 /INCREMENT BY ONE... | |
2284 | TAD L53 | |
2285 | AND C77 | |
2286 | TAD CM33 | |
2287 | SMA CLA /HAVE WE BEEN HERE 26 TIMES? | |
2288 | TAD C46 /YES, BUMP THE HIGH ORDER DIGIT | |
2289 | TAD L53 | |
2290 | DCA L53 /AND SAVE | |
2291 | TAD L53 /NOW RETURN IT IN AC | |
2292 | JMP I LCREAT /RETURN | |
2293 | LPLAB, 0 /THIS PRINTS REGULAR LABELS | |
2294 | DCA TMP /FIRST SAVE LABEL | |
2295 | TAD D34 /NOW PUNCH A '\' | |
2296 | JMS I PRINT | |
2297 | TAD TMP /GET LABEL | |
2298 | JMS I DECOUT /AND PRINT IT | |
2299 | JMP I LPLAB /RETURN | |
2300 | GETHI, LGETHI | |
2301 | CDCA41, DCA L41 | |
2302 | CM33, -33 | |
2303 | DECOUT, LDCOUT | |
2304 | ||
2305 | /TELETYPE OUTPUT ROUTINE FOR ERROR MESSAGES | |
2306 | LTTYPE, 0 | |
2307 | TSF | |
2308 | JMP .-1 | |
2309 | TLS | |
2310 | CLA | |
2311 | JMP I LTTYPE | |
2312 | ||
2313 | \f *3400 | |
2314 | DORET, JMP I XDO | |
2315 | ISZDO, JMS I PROP | |
2316 | 6170 /ISZ | |
2317 | TAD L30 | |
2318 | JMS I PRSYM | |
2319 | JMS I PRINT | |
2320 | JMP DOSUBT /GO GENERATE THE LIMIT TEST | |
2321 | NUMB, 0 | |
2322 | SWIT, 0 | |
2323 | DM5, -5 | |
2324 | CM24, -24 | |
2325 | C5001, 5001 | |
2326 | LEQI, EQI | |
2327 | ||
2328 | LDO, JMS I ZZZ | |
2329 | JMS I ENTITY /LOOK FOR THE SCOPE LABEL | |
2330 | C55, 55 | |
2331 | SKP | |
2332 | JMP SLAB /WE GOT THE SCOPE LABEL | |
2333 | E53, 53 | |
2334 | JMP I ASSIGN | |
2335 | SLAB, TAD L32 /GET THE INTEGER | |
2336 | JMS XDO /PUT OUT DO-LOOP CODE | |
2337 | JMP START /NORMAL EXIT | |
2338 | JMP ERR35 /IMPLIED DO EXIT - ERROR | |
2339 | ||
2340 | XDO, 0 /DO LOOP SUBROUTINE - ENTERED WITH | |
2341 | /TARGET LABEL IN AC | |
2342 | DCA I L15 /PUT IN DO END PUSH DOWN LIST | |
2343 | TAD L74 | |
2344 | DCA L16 /SET UP LIST OF DO ENDS | |
2345 | DCA L21 /ZERO THE SYMBOL TABLE SWITCH | |
2346 | CMA CLA | |
2347 | DCA SWIT /SET SWITCH FOR CONTROL VARIABLE | |
2348 | TAD DM5 | |
2349 | DCA NUMB /SET COUNTER OF NUMBER OF PARAMETERS | |
2350 | GETMOR, JMS I ENTITY /LOOK FOR A PARAMETER | |
2351 | JMP .+3 /ERR | |
2352 | JMP CVAR /GOT A VARIABLE | |
2353 | JMP DPAR /GOT AN INTEGER | |
2354 | C21, 21 | |
2355 | JMP ERR35 | |
2356 | CVAR, JMS I SYMTAB /PUT SYMBOL IN TABLE | |
2357 | TAD L77 /GET ADDRESS | |
2358 | JMS I MODE /DETERMINE MODE OF SYMBOL | |
2359 | JMP ERR35 | |
2360 | TAD L77 /GET ADDRESS AGAIN | |
2361 | DOSTOR, DCA I L16 /SAVE | |
2362 | ISZ NUMB /HAVE WE GOTTEN TOO MANY PARAMS | |
2363 | SKP /NO | |
2364 | ERR35, JMS I LUNCH /YES, DO ERROR ... | |
2365 | JMS I GNB | |
2366 | SNA /IS IT CR | |
2367 | JMP ALLDNE+1 /YES WERE DONE | |
2368 | TAD CM51 | |
2369 | SNA /IS IT A RIGHT PAREN? | |
2370 | JMP ALLDNE /YES-FINISH UP AND TAKE IMPLIED DO EXIT | |
2371 | TAD CM24 | |
2372 | SZA /IS IT = | |
2373 | JMP MCOM /NO | |
2374 | ISZ SWIT /IS SWITCH SET FOR IT | |
2375 | JMP ERR35 /NO | |
2376 | JMP GETMOR /YESS...GO BACK FOR ANOTHER PARAMETER | |
2377 | MCOM, TAD C21 /CHECK FOR COMMA | |
2378 | ISZ SWIT /IF NO EQUAL SIGN YET | |
2379 | SZA /OR IF THIS ISN'T A COMMA | |
2380 | JMP ERR35 /THEN ITS AN ERROR | |
2381 | JMP GETMOR /GET ANOTHER | |
2382 | DPAR, TAD L32 /GET THE INTEGER | |
2383 | ISZ SWIT /HAVE WE SEEN AN EQUAL SIGN? | |
2384 | JMP DOSTOR /YES - SAVE THE INTEGER AND PROCEED | |
2385 | JMP ERR35 /NO | |
2386 | ALLDNE, ISZ XDO /BUMP RETURN POINTER IF TERMINATOR WAS RPAR | |
2387 | CLA IAC | |
2388 | DCA I L16 /STORE A ONE IN THE FOURTH (OR FIFTH) ARGUMENT | |
2389 | TAD C2 | |
2390 | TAD NUMB | |
2391 | SPA CLA /DID WE GET AT LEAST THREE ARGS? | |
2392 | JMP ERR35 /NO | |
2393 | ISZ L44 | |
2394 | TAD L74 /GET ERASABLE LOCATIONS | |
2395 | DCA L16 /USE THE AUTO INDEX REGISTERS | |
2396 | TAD I L16 /GET CONTROL VARIABLE | |
2397 | DCA L30 /AND PUT IN THIRTY | |
2398 | TAD I L16 /GET INITIAL VALUE | |
2399 | DCA L31 /AND SAVE IT | |
2400 | TAD I L16 /GET FINAL VALUE | |
2401 | DCA L32 /AND SAVE IT | |
2402 | TAD I L16 /GET INCREMENT | |
2403 | DCA L33 /AND SAVE IT | |
2404 | TAD L74 /GET ADDR OF ERASABLE AGAIN | |
2405 | IAC /INCREMENT ONCE | |
2406 | DCA L41 /TELL TRIPL WHERE TO FIND THE DUMMY TRIPLES | |
2407 | TAD L74 /GET IT AGAIN | |
2408 | DCA L16 /USE AUTO INDEX TO STORE TRIPLE | |
2409 | DCA L46 /ZERO THE AC | |
2410 | TAD C5001 /SET UP INITIAL TRIPLE NUMBER | |
2411 | DCA L40 | |
2412 | TAD L33 | |
2413 | CIA | |
2414 | TAD L31 | |
2415 | SNA CLA /IF INITIAL VALUE = STEP SIZE | |
2416 | JMP STCTLV /NO NEED TO COMPUTE THE DIFFERENCE | |
2417 | TAD L33 /GET STEP SIZE | |
2418 | DCA I L16 /PUT IN TRIPLE | |
2419 | TAD C55 /PUT IN A MINUS SIGN | |
2420 | DCA I L16 | |
2421 | TAD L31 /GET INITIAL VALUE | |
2422 | DCA I L16 | |
2423 | JMS I TRIPL /PROCESS THE TRIPLE | |
2424 | STCTLV, JMS I LEQI /STORE ANSWER IN CONTROL VARIABLE | |
2425 | JMS I CLAB /PUT A CDREATED LABVEL ON THE NEXT STATEMENT | |
2426 | TAD L53 /GET THE CREATED LABEL | |
2427 | DCA I L15 /AND PUT IN DO END LIST | |
2428 | TAD L74 | |
2429 | DCA L16 | |
2430 | TAD L33 /GET STEP SIZE | |
2431 | CLL RAR | |
2432 | SNA /IF STEP SIZE=1 THEN | |
2433 | JMP ISZDO /WE CAN USE AN ISZ TO INCREMENT | |
2434 | RAL | |
2435 | DCA I L16 | |
2436 | TAD E53 /WERE GOING TO ADD | |
2437 | DCA I L16 | |
2438 | / L30 IS IN THE THIRD POSITION SINCE WE CALLED "EQI" | |
2439 | JMS I TRIPL /ADD STEP SIZE TO CONTROL VARIABLE | |
2440 | JMS I LEQI /STORE ANSWER IN CONTROL VARIABLE | |
2441 | DOSUBT, TAD L74 | |
2442 | DCA L16 | |
2443 | TAD L30 /GET THE CONTROL VARIABLE | |
2444 | DCA I L16 | |
2445 | TAD C55 /WERE GOING TO SUBTRACT | |
2446 | DCA I L16 | |
2447 | TAD L32 /GET FINAL VALUE | |
2448 | DCA I L16 | |
2449 | JMS I TRIPL /SUBTRACT CONTROL VARIABLE FROM FINAL VALUE | |
2450 | \f DCA L46 /CLEAR THE AC FLAG | |
2451 | JMS I PROP | |
2452 | 6110 /SPA CLA | |
2453 | JMS I PRINT | |
2454 | JMS I PROP | |
2455 | 6044 /PUT OUT A JMP | |
2456 | JMS I CREATE /TO A CREATED LABEL | |
2457 | DCA I L15 /PUT CREATED LABEL IN DO END LIST | |
2458 | TAD L53 /GET LABEL | |
2459 | JMS I PRCRL /AND PRINT IT | |
2460 | JMS I PRINT /CRLF | |
2461 | ISZ L55 /INCREMENT UNENDED DO COUNTER | |
2462 | SKP | |
2463 | ERR38, JMS I LUNCH /TOOO MANY UNENDED DOS | |
2464 | JMP I .+1 | |
2465 | DORET /RETURN FROM SUBROUTINE "XDO" | |
2466 | ||
2467 | EQI, 0 | |
2468 | TAD L74 | |
2469 | DCA L16 | |
2470 | TAD L46 /GET RESULT OF PREVIOUS COMPUTATION | |
2471 | DCA I L16 | |
2472 | TAD E75 /GET EQUALS SIGN | |
2473 | DCA I L16 | |
2474 | TAD L30 /GET CONTROL VARAIBLE | |
2475 | DCA I L16 | |
2476 | JMS I TRIPL /PROCESS | |
2477 | DCA L46 /WIPE AC SWITCH | |
2478 | JMP I EQI /RETURN | |
2479 | LFUNCT, 0 | |
2480 | DCA ARGCNT | |
2481 | TAD L46 /GET AC | |
2482 | SZA CLA /IS IT ZERO | |
2483 | JMS I STORE /NO...STORE THE AC | |
2484 | TAD L53 /GET CURRENT CREATED LABEL | |
2485 | DCA L73 /AND SAVE | |
2486 | CLA CMA /AC IS MINUS ONE | |
2487 | TAD L41 /PUSH LIST POINTER | |
2488 | DCA L42 /PUSH LIST POINTER MINUS ONE | |
2489 | CKFNCT, ISZ L42 /INCREMENT POINTER | |
2490 | ISZ L42 /AGAIN | |
2491 | TAD I L42 /GET THE OPERATOR | |
2492 | TAD CM4047 /SUBTRACT THE FUNCTION OPERATOR | |
2493 | SZA /IS THIS THE FUNCTION OPERATOR | |
2494 | JMP CKSBSC /NO | |
2495 | CLA IAC /YES...THE FUNCTION NAME IS IN THE NEXT LOCATIO | |
2496 | TAD L42 /THIS POINTS TO IT | |
2497 | DCA SAVE /AND SAVE | |
2498 | TAD I SAVE | |
2499 | TAD C2 | |
2500 | DCA EQI | |
2501 | TAD I EQI | |
2502 | AND CM2 | |
2503 | IAC | |
2504 | DCA I EQI | |
2505 | MOR, CLA CMA /NOW EXAM THE ARGUMENTS | |
2506 | TAD L42 /WERE POINTING TO THE FIRST ARGUMENT | |
2507 | DCA L42 /SAVE THE POINTER | |
2508 | ISZ ARGCNT | |
2509 | JMS I LCHNG /CHECK L42 FOR ZERO OR DUMMY ARG | |
2510 | DCA I L42 /REPLACE IT BY UPDATED VALUE | |
2511 | TAD L42 /IT WASNT...SEE IF IT WAS THE LAST ARGUMENT | |
2512 | CIA | |
2513 | TAD L41 /SUBTRACT THE END OF ARGUMENT LIST | |
2514 | SNA CLA /IS IT ZERO | |
2515 | JMP OUT /YES...WE'VE COMPLETED THIS PHASE | |
2516 | CLA CMA /NO...MOVE THE POINTER BACK ONE | |
2517 | TAD L42 | |
2518 | DCA L42 /AND SAVE | |
2519 | JMP MOR /NOW CHECK THE NEXT ARGUMENT | |
2520 | OUT, TAD SAVE /GET THE POINTER TO THE FUMCTION NAME AGAIN | |
2521 | DCA L42 /AND PUT IN 42 | |
2522 | TAD I L42 /GET THE ARGUMENT | |
2523 | DCA FUNOP /USE FPROP TO PUT OUT THE CALL TO THE FUNCTION | |
2524 | TAD ARGCNT /GIVE FPROP THE NUMBER OF ARGUMENTS | |
2525 | JMS I FPROP /PUT OUT THE CALL TO THE FUNCTION | |
2526 | FUNOP, 0 | |
2527 | TAD L73 /NOW RESTORE THE CREATED LABEL LOCATION | |
2528 | DCA L53 | |
2529 | MNEXT, TAD L42 /GET THE POINTER | |
2530 | TAD CM2 /MOVE POINTER TO ARGUMENT | |
2531 | DCA L42 /AND SAVE | |
2532 | TAD I L42 /GET NEXT ARGUMENT | |
2533 | JMS I PSYMOT /GENERATE AN "ARG" FOR THE ARGUMENT | |
2534 | TAD L42 /GET THE POINTER | |
2535 | CIA /SET IT NEGATIVE | |
2536 | TAD L41 /ADD | |
2537 | SZA CLA /ARE THEY EQUAL | |
2538 | JMP MNEXT /NO THERE ARE MORE ARGS | |
2539 | TAD I SAVE /YES...GET THE FUNCTION NAME | |
2540 | JMS I MODE /WHAT MODE IS IT | |
2541 | TAD E400 /ITS FLOATING POINT | |
2542 | TAD L40 /ITS INTEGER | |
2543 | DCA L46 /PUT THE TRIPLE NUMBER IN THE AC SWITCH | |
2544 | TAD SAVE /YES...CHANGE PUSH LIST POINTER | |
2545 | DCA L41 /STORE POINTER TO NAME IN PUSH LIST POINTER | |
2546 | TAD L46 /GET CURRENT TRIPLE NUMBER | |
2547 | DCA I L41 /AND PUT IT IN THE PUSH LIST | |
2548 | JMP I LFUNCT /RETURN | |
2549 | CKSBSC, IAC | |
2550 | SZA CLA /IS IT THE SUBSCRIPT OPERATOR? | |
2551 | JMP I CKF /NO - KEEP LOOKING | |
2552 | JMP I .+1 | |
2553 | ERR39 | |
2554 | PSYMOT, SYMOUT | |
2555 | SAVE, 0 | |
2556 | ARGCNT, 0 | |
2557 | E75, 75 | |
2558 | CM4047, -4047 | |
2559 | E400, 400 | |
2560 | ||
2561 | TAD C47 | |
2562 | JMS I PPACK | |
2563 | LQUOTE, JMS I PGTC /GET A CHARACTER | |
2564 | SNA | |
2565 | ERR37, JMS I LUNCH /CARRIAGE RETURN - ERROR | |
2566 | TAD CM47 | |
2567 | SZA | |
2568 | JMP LQUOTE-2 /IF NOT A QUOTE, STORE IT | |
2569 | JMP I .+1 | |
2570 | FRET | |
2571 | C47, 47 | |
2572 | CM47, -47 | |
2573 | PGTC, LGTC | |
2574 | PPACK, PACK | |
2575 | CKF, CKFND | |
2576 | \f *4000 | |
2577 | LCONT, JMS I LOOK /CHECK REST OF LINE | |
2578 | -4 /LOOK FOR FOUR CHARACTERS | |
2579 | -11 /I | |
2580 | -16 /N | |
2581 | -25 /U | |
2582 | -5 /E | |
2583 | JMS I ZZZ | |
2584 | JMS I PROP /PUNCH 'NOP' | |
2585 | 6047 | |
2586 | JMS I PRINT /PUT OUT A CRLF | |
2587 | JMP START /GO GET NEXT STATEMENT | |
2588 | ||
2589 | LPAUSE, JMS I LOOK /CHECK REST OF STATEMENT TYPE | |
2590 | -1 /JUST ONE CHARACTER | |
2591 | -5 /E | |
2592 | CLA CMA | |
2593 | LSTOP, DCA SW /SET SWITCH FOR STOP OR PAUSE | |
2594 | DCA L32 | |
2595 | JMS I ENTITY /LOOK FOR THE OPTIONAL INTEGER | |
2596 | JMP MCR /WE GOT A CR | |
2597 | SKP /ERR | |
2598 | JMP .+3 /WE GOT AN INTEGER | |
2599 | NOP /ERR | |
2600 | JMP I ASSIGN | |
2601 | ||
2602 | MCR, JMS I ZZZ | |
2603 | ISZ SW /PAUSE OR STOP? | |
2604 | JMP STOP | |
2605 | JMS I FPROP /PUNCH 'CALL 0,CKIO' | |
2606 | 6116 | |
2607 | JMS I PROP /PRINT OP CODE | |
2608 | 6066 /OPCODE IS TAD | |
2609 | TAD L32 /GET THE INTEGER | |
2610 | JMS I PRSYM /PRINT IT | |
2611 | JMS I PRINT /CR | |
2612 | JMS I PROP | |
2613 | 6121 | |
2614 | JMS I PRINT | |
2615 | JMS I PROP | |
2616 | 6124 | |
2617 | JMS I PRINT /PUT OUT CRLF | |
2618 | JMP START /GO GET NEXT STATEMENT | |
2619 | ||
2620 | STOP, JMS OSTOP | |
2621 | JMP START | |
2622 | ||
2623 | OSTOP, 0 /PUNCH 'CALL 0,CKIO' | |
2624 | JMS I FPROP | |
2625 | 6116 | |
2626 | JMS I CLAB /PUNCH '<LAB>, HLT' | |
2627 | JMS I PROP | |
2628 | 6121 | |
2629 | JMS I PRINT | |
2630 | JMS I PROP /PUNCH 'JMP <LAB>' | |
2631 | 6044 | |
2632 | TAD L53 | |
2633 | JMS I PRCRL | |
2634 | JMS I PRINT | |
2635 | JMP I OSTOP | |
2636 | ||
2637 | SW, 0 | |
2638 | LFRMAT, JMS I LOOK /CHECK REST OF STATEMENT TYPE | |
2639 | -2 /TWO CHARACTERS | |
2640 | -1 /A | |
2641 | -24 /T | |
2642 | ISZ OSTOP | |
2643 | TAD L74 | |
2644 | DCA L10 | |
2645 | DCA L76 | |
2646 | JMS I PROP | |
2647 | 6044 | |
2648 | JMS I CREATE | |
2649 | JMS I PRCRL | |
2650 | JMS I PRINT | |
2651 | JMS I GNB /READ UNTIL A PAREN IS GOTTEN | |
2652 | TAD CM50 /SUBTRACT A ( | |
2653 | SZA CLA /IS IT A ( | |
2654 | ERR39, JMS I LUNCH /NO...ILLEGAL CHARACTER | |
2655 | TAD C50 /GET A LEFT PAREN | |
2656 | JMP PAREN /AND GO START COUNTING PARENS | |
2657 | AGAIN, JMS I GTC | |
2658 | SNA /IS IT A CR | |
2659 | JMS I PUTCH | |
2660 | PAREN, RTL CLL /SHIF CHAR LEFT | |
2661 | RTL | |
2662 | RTL | |
2663 | DCA L32 /SAVE THE CHAR | |
2664 | JMS I GTC | |
2665 | SNA /IS IT A CR | |
2666 | DCA OSTOP | |
2667 | TAD L32 /PACK THE TWO CHARS (SOME DONE AT FRMTCK) | |
2668 | JMP I FRMTCK /GO CHECK IF FORMAT STMT. TOO BIG | |
2669 | FRMT, TAD OSTOP /GET BALANCED PAREN SWITCH | |
2670 | SZA CLA /ARE THEY BALANCED | |
2671 | JMP AGAIN /NO GET SOME MORE CHARS | |
2672 | TAD L76 | |
2673 | JMS I PIFF | |
2674 | TAD L74 | |
2675 | DCA L10 | |
2676 | TAD L76 | |
2677 | CIA | |
2678 | DCA L76 | |
2679 | JMS I ZZZ | |
2680 | TAD I L10 | |
2681 | JMS I PROTAC | |
2682 | JMS I PRINT | |
2683 | ISZ L76 | |
2684 | JMP .-4 | |
2685 | TAD L53 /PUNCH '<LABEL>,' | |
2686 | JMS I CLAB | |
2687 | JMS I PRINT | |
2688 | JMP START | |
2689 | GTC, LGTC | |
2690 | PXSUBR, XXSUBR | |
2691 | C50, 50 | |
2692 | ||
2693 | LPIFF, 0 /PUNCH 'IFF <N>' | |
2694 | DCA LZZZ /ENTER WITH N IN THE AC | |
2695 | JMS I PROP | |
2696 | 6102 | |
2697 | TAD LZZZ | |
2698 | JMS I PROTAC | |
2699 | JMS I PRINT | |
2700 | JMP I LPIFF | |
2701 | ||
2702 | LZZZ, 0 /PUNCH THE CURRENT LABEL, IF ANY | |
2703 | TAD L54 | |
2704 | SNA /IS THERE A LABEL? | |
2705 | JMP ZZZRET /NO | |
2706 | JMS I PLAB /PUNCH '<LABEL>, ' | |
2707 | TAD C7240 | |
2708 | JMS I P2 | |
2709 | ZZZRET, DCA I PXSUBR /MAKE SUBROUTINES AND FUNCTIONS ILLEGAL | |
2710 | JMP I LZZZ | |
2711 | FRMTCK, CKFRMT | |
2712 | \f *4200 | |
2713 | LTRIPL, 0 | |
2714 | JMS I XZQL /FIRST CHECK IF A TRIPLE IS LEGAL HERE | |
2715 | TAD L41 /GET PUSH LIST POINTER | |
2716 | IAC /INCREMENT TO POINT TO OPERATOR | |
2717 | DCA L42 /OPERATOR POINTER | |
2718 | TAD L42 /GET IT AGAIN | |
2719 | IAC /INCREMENT IT | |
2720 | DCA L43 /OPERAND TWO POINTER | |
2721 | TAD I L42 /GET OPERATOR | |
2722 | AND C77 /MASK GARBAGE BITS | |
2723 | TAD CM41 /SUBTRACT AN ADD INDIRECT OPERATOR | |
2724 | SNA CLA /IS OPERATOR <DOLLAR> | |
2725 | JMP I LADDIN /YES PROCESS IT | |
2726 | TAD I L43 /NO...GET OPERAND TWO | |
2727 | JMS I DUMARG /SEE IF ITS A DUMMY ARGUMENT | |
2728 | SKP /YES IT IS | |
2729 | JMP CK2 /NO ..CHECK THE OTHER ARGUMENT | |
2730 | TAD I L42 /YES GET THE OPERATOR | |
2731 | AND C77 /MASK GARBAGE BITS | |
2732 | TAD EM75 /IS IT AN EQUALS SIGN | |
2733 | SNA /IS OP C | |
2734 | JMP LEQUIN /YES USE C* | |
2735 | IAC /SEE IF ITS ALREADY EQUALS INDIRECT | |
2736 | SZA CLA /IS OP C* | |
2737 | JMS I LDUMTW /YES TWO IS DUMMY ARG | |
2738 | CK2, CLA | |
2739 | TAD I L41 /NO IS OPND ONE A SYMBOL | |
2740 | JMS I DUMARG /SEE IF ITS A DUMMY ARGUMENT | |
2741 | JMS I LDUMON /IT IS | |
2742 | CLA CLL /NOW LETS SEE WHAT THE OPERATOR IS | |
2743 | TAD I L42 /GET THE OPERATOR | |
2744 | AND C77 /MASK OUT GARBAGE BITS | |
2745 | TAD CM53 | |
2746 | SNA /IS IT | |
2747 | JMP I LAADD /YES | |
2748 | IAC | |
2749 | SNA /IS IT * | |
2750 | JMP I LMUL /YES | |
2751 | TAD CM3 | |
2752 | SNA /IS IT - | |
2753 | JMP I LASUB /YES | |
2754 | TAD CM2 | |
2755 | SNA /IS IT / | |
2756 | JMP I LDIV /YES | |
2757 | TAD CM16 | |
2758 | SNA /IS IT C | |
2759 | JMP I LEQU /YES | |
2760 | IAC | |
2761 | SNA /IS IT C* | |
2762 | JMP I LEIND /YES | |
2763 | TAD J27 | |
2764 | SNA /IS IT ** | |
2765 | JMP I LEXP /YES | |
2766 | TAD C2 | |
2767 | SNA /IS IT A UNARY MINUS | |
2768 | JMP I LUMIN /YES | |
2769 | ERR40, JMS I LUNCH /NO BETTER COP OUT | |
2770 | LDMARG, 0 | |
2771 | SMA /IS HIGH ORDER BIT ON | |
2772 | JMP INC /NO...ITS NEITHER A SYMBOL OR A TRIPLE NUMBER | |
2773 | RAL /GET NEXT BIT | |
2774 | SMA /IS IT ON | |
2775 | JMP MAYBE /NO...WE MIGHT HAVE A SUBSCRIPT THOUGH | |
2776 | RAR /YES...RESTOR THE PARAMETER | |
2777 | CIA /SET IT NEGATIVE | |
2778 | TAD L47 /SUBTRACT IT FROMTHE START OF THE FCON TABLE | |
2779 | SPA /IS THE RELULT POSITIVE | |
2780 | JMP INC /NO...ITS AN FCON NOT A SYMBOL | |
2781 | CIA /YESS...RESTORE ORIGINAL PARAMETER | |
2782 | TAD L47 | |
2783 | TAD C2 /YES MOVE POINTER TO CONTROL BITS | |
2784 | DCA L23 /SAVE | |
2785 | TAD I L23 /GET THE CONTROL BITS | |
2786 | AND C10 /MASK ALL BUT DUMMY ARG BIT OUT | |
2787 | INC1, SNA CLA /IS THIS SYMBOL. A DUMMY ARG | |
2788 | INC, ISZ LDMARG /NO...INCREMENT THE RETURN | |
2789 | CLA /CLEAR THE ACCUMULATOR | |
2790 | JMP I LDMARG /AND RETURN | |
2791 | MAYBE, AND F400 /MASK THE SUBSCRIPT BIT OF THE TRIPLE NUMBER | |
2792 | JMP INC1 /AND CHECK BECAUSE WE TREAT SUBSCS AS DUMMY ARG | |
2793 | ARET, JMP I LTRIPL /THIS IS THE RETURN FROM TRIPLE | |
2794 | ||
2795 | LEQUIN, TAD C74 | |
2796 | DCA I L42 /SET OP TO =* | |
2797 | JMP CK2 | |
2798 | C74, 74 | |
2799 | / | |
2800 | / THIS ROUTINE CHECKS THE REST OF THE CHARS FOR A STATEMENT | |
2801 | LLOOK, 0 | |
2802 | JMS GLOOK /GET CHARACTER COUNT | |
2803 | DCA LTRIPL | |
2804 | ABACK, JMS I GNB | |
2805 | JMS GLOOK /ADD IN THE TEST CHAR | |
2806 | SZA CLA /WERE THEY EQUAL | |
2807 | JMP I ASSIGN /NO...IT MUST BE AN ASSIGNMENT STATEMENT | |
2808 | ISZ LTRIPL /THEY MATCH...ARE WE DONE | |
2809 | JMP ABACK /NO | |
2810 | JMP I LLOOK /RETURN | |
2811 | ||
2812 | GLOOK, 0 | |
2813 | CDF 10 | |
2814 | TAD I LLOOK | |
2815 | ISZ LLOOK | |
2816 | CDF 00 | |
2817 | JMP I GLOOK | |
2818 | / | |
2819 | LAADD, AADD | |
2820 | LADDIN, ADDIND | |
2821 | LASUB, ASUB | |
2822 | LEQU, EQU | |
2823 | LEIND, EIND | |
2824 | LEXP, EXP | |
2825 | LUMIN, UMIN | |
2826 | CM41, -41 | |
2827 | EM75, -75 | |
2828 | LDUMTW, DUMTWO | |
2829 | CM16, -16 | |
2830 | C10, 10 | |
2831 | F400, 400 | |
2832 | LDUMON, DUMONE | |
2833 | CM53, -53 | |
2834 | LMUL, MUL | |
2835 | LDIV, DIV | |
2836 | XZQL, LXZQ | |
2837 | J27, 27 | |
2838 | ||
2839 | CKFND, TAD L42 /SEE IF POINTER IS INTO SYMB. TABLE | |
2840 | TAD K2000 /(IT HAS HAPPENED!) | |
2841 | SZA CLA | |
2842 | JMP I CKFNCP | |
2843 | JMP I .+1 /YES-ERROR | |
2844 | ERR39 | |
2845 | CKFNCP, CKFNCT | |
2846 | K2000, 2000 | |
2847 | \f *4400 | |
2848 | / FIGURE OUT WHATS IN AC | |
2849 | LCHECK, 0 | |
2850 | TAD L46 /GET WHATS IN THE AC | |
2851 | CIA /SET NEGATIVE | |
2852 | TAD I L41 /SUBTRACT | |
2853 | SNA CLA /ARE THEY EQUAL | |
2854 | JMP ONE /YES | |
2855 | TAD L46 /GET AC AGAIN | |
2856 | CIA /SET NEGATIVE | |
2857 | TAD I L43 /SUBTRACT TWO | |
2858 | SNA CLA /ARE THEY EQUAL | |
2859 | JMP TWO /YES | |
2860 | TAD L46 /GET THE AC | |
2861 | SNA CLA /IS IT ZERO | |
2862 | JMP NONE /NO YES YES YES | |
2863 | JMP SOME /JUST SIMETHING IN AC | |
2864 | ONE, ISZ LCHECK | |
2865 | NONE, ISZ LCHECK | |
2866 | SOME, ISZ LCHECK | |
2867 | TWO, JMP I LCHECK | |
2868 | ||
2869 | / FINDS TEMPORARY THAT TRIPLE NUMBER IS ASSIGNED TO | |
2870 | ||
2871 | LTMPOR, 0 | |
2872 | DCA LFPROP /SAVE TRIPLE NUMBER | |
2873 | TAD LFPROP | |
2874 | JMS I MODE /DETERMINE ITS MODE | |
2875 | TAD C30 /FLOATING POINT | |
2876 | TAD TTAB /INTEGER | |
2877 | DCA LCHECK | |
2878 | TAD CM30 | |
2879 | DCA FOP /SET UP COUNT FOR SEARCH | |
2880 | LTLP1, TAD I LCHECK | |
2881 | CIA | |
2882 | TAD LFPROP | |
2883 | SNA CLA /IS THIS THE ONE? | |
2884 | JMP ZEROIT /YES - ZERO IT OUT AND RETURN IT | |
2885 | ISZ LCHECK | |
2886 | ISZ FOP | |
2887 | JMP LTLP1 /LOOP OVER ENTIRE TABLE | |
2888 | TAD LCHECK /NOT FOUND - WE HAVE TO ASSIGN IT | |
2889 | TAD CM30 | |
2890 | DCA LCHECK /RESET POINTERS FOR ZERO SEARCH | |
2891 | TAD CM30 | |
2892 | DCA FOP | |
2893 | LTLP2, TAD I LCHECK | |
2894 | SNA CLA /IS THIS TEMPORARY FREE? | |
2895 | JMP TEMPTY /YES | |
2896 | ISZ LCHECK | |
2897 | ISZ FOP | |
2898 | JMP LTLP2 /CHECK THEM ALL | |
2899 | ERR41, JMS I LUNCH /OUT OF TEMPORARIES | |
2900 | TEMPTY, TAD LCHECK | |
2901 | CIA | |
2902 | TAD L45 | |
2903 | SNA CLA /ADJUST THE NUMBER OF FLOATING POINT TEMPS | |
2904 | ISZ L45 | |
2905 | TAD LCHECK | |
2906 | CIA | |
2907 | TAD L51 | |
2908 | SNA CLA /ADJUST THE NUMBER OF INTEGER TEMPS | |
2909 | ISZ L51 | |
2910 | TAD LFPROP /STORE TRIPLE NUMBER IN THIS TEMPORARY SLOT | |
2911 | ZEROIT, DCA I LCHECK | |
2912 | TAD FOP | |
2913 | TAD C31 /GET POSITIVE NUMBER FROM TABLE COUNTER | |
2914 | JMP I LTMPOR /RETURN | |
2915 | C31, 31 | |
2916 | ||
2917 | LFPROP, 0 /THIS ROUTINE PUNCHES SUBROUTINE CALLS | |
2918 | DCA FOP /SAVE THE NUMBER OF ARGUMENTS | |
2919 | JMS I PROP | |
2920 | 6113 /PUT OUT THE CALL | |
2921 | TAD FOP /GET THE NUMBER OF ARGUMENTS | |
2922 | JMS I PROTAC /PRINT IT | |
2923 | TAD C54 /GET A COMMA | |
2924 | JMS I PRINT /PRINT IT | |
2925 | CDF 10 | |
2926 | TAD I LFPROP | |
2927 | CDF 00 | |
2928 | JMS I PRSYM | |
2929 | JMS I PRINT | |
2930 | ISZ LFPROP /INCREMENT RETURN | |
2931 | JMP I LFPROP /RETURN | |
2932 | FOP, 0 | |
2933 | / COME HERE IF OP IS - | |
2934 | ASUB, JMS I SMODE /MAKE SURE THAT BOTH ARGS ARE OF SAME MODE | |
2935 | TAD I L43 /GET OPERAND TWO | |
2936 | JMS I MODE | |
2937 | JMP FSUB /ITS FLOATING POINT | |
2938 | JMS LCHECK /ITS INTEGER...CHECK WHATS IN THE AC | |
2939 | JMP STWO /TWO IS IN THE AC | |
2940 | JMS I STORE /SMETHING IS IN THE AC | |
2941 | JMS I LADDON /NOTHING IS IN THE AC...ADD ONE TO IT | |
2942 | ASBCMN, JMS I LCOMP /ONE IS IN AC...COMPLEMENT IT | |
2943 | JMS I LADDTW /ADD TWO TO IT | |
2944 | JMP I LRETUR /AND RETURN | |
2945 | STWO, JMS I LCOMP /TWO IS IN AC...COMPLEMENT IT | |
2946 | JMS I LADDON /ADD ONE TO IT | |
2947 | JMS I LCOMP /AND COMPLEMENT IT AGAIN | |
2948 | JMP I LRETUR /AND RETURN | |
2949 | FSUB, JMS LCHECK /FLOATING POINT...CHECK THE AC | |
2950 | JMP FS /TWO IS IN AC | |
2951 | JMS I STORE /SOMETHING IN AC...STORE IT | |
2952 | JMP FAS /NOTHING IN AC | |
2953 | JMP ASBCMN /ONE IS IN AC - COMPLEMENT AND ADD TWO | |
2954 | FAS, JMS I LADDTW /NOTHING IN AC...ADD TWO IN | |
2955 | FS, IAC /WE HAVE ONE ARG | |
2956 | JMS I FPROP | |
2957 | 6011 | |
2958 | JMS I ARG /PUT OUT THE ARG PSEUDO OP | |
2959 | TAD I L41 /GET ARGUMENT ONE | |
2960 | IRET, JMS I PRSYM /AND PUT IT OUT | |
2961 | JMS I PRINT /PUT OUT CRLF | |
2962 | JMP I LRETUR | |
2963 | TTAB, ITTAB /THIS IS THE STARTING ADDRESS OF THE TEMP TABLE | |
2964 | LCOMP, COMP | |
2965 | LADDON, ADDONE | |
2966 | C30, 30 | |
2967 | CM30, -30 | |
2968 | LRETUR, RETURN | |
2969 | LADDTW, ADDTWO | |
2970 | ||
2971 | /CHECK SIZE OF FORMAT STMT. | |
2972 | / | |
2973 | CKFRMT, DCA I L10 /CONTINUE PACK ROUTINE | |
2974 | ISZ L76 | |
2975 | TAD L76 | |
2976 | TAD M174 /IS IT TOO BIG | |
2977 | SMA CLA | |
2978 | JMP I ILCON /YES-GIVE IT ILLEGAL CONT. MESSAGE | |
2979 | JMP I LFRMT /NO-GO BACK | |
2980 | LFRMT, FRMT | |
2981 | M174, -174 | |
2982 | ILCON, ERR1 /ILLEGAL CONTINUATION MESSAGE | |
2983 | \f *4600 | |
2984 | / PROCESS * | |
2985 | ADDIND, JMS I CHECK /CHECK WHATS IN THE AC | |
2986 | NOP /TWO IS IN AC | |
2987 | SKP /N SOMETHING IS IN AC | |
2988 | SKP /NOTHING IS IN AC | |
2989 | JMS I STORE /STORE WHATEVER IS IN AC | |
2990 | TAD I L41 /GET OPERAND ONE | |
2991 | JMS I MODE /WHAT MODE IS IT | |
2992 | JMP FLOT /YES IT FLOATING POINT | |
2993 | JMS I PROP /IST INTEGER... | |
2994 | 6063 /PUT OUT A TAD* | |
2995 | LOOP6, TAD I L41 /GET THE FIRST OPERAND AGAIN | |
2996 | JMP I LIRET /GO TO THE RETURN ROUTINE | |
2997 | FLOT, IAC /WE ONLY HAVE ONE ARG | |
2998 | JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE | |
2999 | 6132 /PUT OUT A CALL TO FLOATING INDIRECT ADD | |
3000 | JMS I ARG /PUT OUT THE ARG PSEUDO OP | |
3001 | JMP LOOP6 /AND JUMP BACK | |
3002 | / THIS PUTS OUT OPCODES FOR AN ADD | |
3003 | ADDL, 0 | |
3004 | CLL RAR | |
3005 | SNA /TEST FOR 0 OR 1 | |
3006 | JMP ADSPCL | |
3007 | RAL /NOT 0 OR 1, TREAT NORMALLY | |
3008 | JMS I MODE /WHAT MODE ARE WE IN | |
3009 | JMP LOOP7 /YES | |
3010 | JMS I PROP /PUT OUT A TAD | |
3011 | 6066 | |
3012 | JMP I ADDL /RETURN | |
3013 | LOOP7, IAC /WE ONLY HAVE ONE ARGUMENT | |
3014 | JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE | |
3015 | 6003 /PUT OUT A FLOATING ADD | |
3016 | JMS I ARG /PUT OUT THE ARG PSEUDO OP | |
3017 | JMP I ADDL /AND RETURN | |
3018 | ADSPCL, ISZ ADDL | |
3019 | ISZ ADDL /BUMP RETURN POINT PAST ARGUMENT TO "TAD" | |
3020 | SNL /0? | |
3021 | JMP I ADDL /YUP - DON'T PUT OUT NUTTIN | |
3022 | JMS I PROP | |
3023 | OPIAC /PUT OUT "IAC" | |
3024 | JMP I ADDL | |
3025 | ||
3026 | / STORES CONTENTS OF AC IN TEMPORARY | |
3027 | / PUT OUT DCA OR CALL STO | |
3028 | / FOLLOWED BY THE TEMPORARY LOC | |
3029 | LSTORE, 0 | |
3030 | TAD L46 /GET THE AC | |
3031 | JMS I MODE /WHAT MODE IS IT | |
3032 | JMP FSTO /ITS FLOATING POINT | |
3033 | JMS I PROP | |
3034 | 6071 /ITS INTEGER...PUT OUT A DCA | |
3035 | STORET, TAD L46 /GET THE AC AGAIN | |
3036 | JMS I PRSYM /PRINT WHATEVER IS IN IT | |
3037 | JMS I PRINT /PUT OUT A CRLF | |
3038 | DCA L46 /ZERO THE AC | |
3039 | JMP I LSTORE /AND RETURN | |
3040 | FSTO, IAC /WE ONLY HAVE ONE ARG | |
3041 | JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE | |
3042 | 6006 /PUT OUT A CALL TOFLOATING STORE | |
3043 | JMS I ARG /PUT OUT THE ARG PSEUDO OP | |
3044 | JMP STORET /AND JMP BACK | |
3045 | COMP, 0 | |
3046 | TAD L46 /GET THE AC | |
3047 | JMS I MODE /WHAT MODE IS IT | |
3048 | JMP FCOM /ITS FLOATING POINT | |
3049 | JMS I PROP /ITS INYTEGER | |
3050 | 6135 /PUT OUT A CIA | |
3051 | JMS I PRINT /PUT OUT A CRLF | |
3052 | JMP I COMP /AND RETURN | |
3053 | FCOM, JMS I FPROP | |
3054 | 6140 /TO FLOATING CHANGE SIGN | |
3055 | JMP I COMP | |
3056 | / COME HERE IF OP IS * | |
3057 | MUL, JMS I SMODE /CHECK FOR SAME MODE | |
3058 | JMS I CHECK /CHECK WHATS IN THE AC | |
3059 | JMP TMUL /TWO IS IN THE AC | |
3060 | JMS I STORE /SOMETHING IS IN AC...STORE IT | |
3061 | JMS I KADDON /NOTHING IS IN AC..GET ONE IN AC | |
3062 | AMUL, TAD I L43 /GET OPERND TWO | |
3063 | JMS I MODE /WHAT MODE IS IT | |
3064 | TAD EM6 | |
3065 | TAD C6022 | |
3066 | DCA FML /SAVE OPCODE | |
3067 | IAC | |
3068 | JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE | |
3069 | FML, 0 | |
3070 | JMS I ARG /PUT OUT THE ARG PSEUDO OP | |
3071 | TAD I L43 /GET OPERAND TWO | |
3072 | JMP I LIRET /AND GO TO THE RETURN ROUTINE | |
3073 | TMUL, TAD I L41 /GET OPERAND ONE AND REPLACE OPERAND TWO | |
3074 | DCA I L43 | |
3075 | JMP AMUL /AND JUMP BACK | |
3076 | KADDON, ADDONE | |
3077 | LIRET, IRET | |
3078 | EM6, -6 | |
3079 | C6022, 6022 | |
3080 | ||
3081 | LSUB, JMS I LOOK /CHECK REST OF STATEMENT | |
3082 | -6 / | |
3083 | -17 /O | |
3084 | -25 /U | |
3085 | -24 /T | |
3086 | -11 /I | |
3087 | -16 /N | |
3088 | -5 /E | |
3089 | JMP I .+1 | |
3090 | TART | |
3091 | ||
3092 | LCLEAR, 0 /CLEAR THE PSEUDO ACC AND MQ | |
3093 | DCA L30 | |
3094 | DCA L31 | |
3095 | DCA L32 | |
3096 | DCA L33 | |
3097 | DCA L34 | |
3098 | DCA L35 | |
3099 | JMP I LCLEAR | |
3100 | *5000 | |
3101 | / THIS ROUTINE TAKES CARE OF TWO BEING DUMMY ARG | |
3102 | DUMTWO, 0 | |
3103 | TAD I L41 /GET OPND ONE | |
3104 | DCA FDV /AND SAVE | |
3105 | TAD I L43 /GET OPND TWO | |
3106 | DCA I L41 /ZERO OPND ONE | |
3107 | JMS DUMONE /PROCESS DUMMY ARGUMENT | |
3108 | TAD FDV /GET SAVED OPERAND | |
3109 | DCA I L41 /AND USE AS OPERAND | |
3110 | TAD L46 /GET TRIPLE NUMBER | |
3111 | DCA I L43 /AND REPLACE | |
3112 | JMP I DUMTWO /RETURN | |
3113 | / TAKES CARE OF ONE BIING DUMMY ARG | |
3114 | DUMONE, 0 | |
3115 | TAD I L42 /GET OPERATOR | |
3116 | DCA ASTOP /AND SAVE | |
3117 | TAD E41 /GET ADD INDIRECT OPERATOR | |
3118 | DCA I L42 /AND REPLACE OPERATOR | |
3119 | CDF 10 | |
3120 | TAD I TRIPL | |
3121 | CDF 00 | |
3122 | DCA FEX /AND SAVE RETURN | |
3123 | JMS I TRIPL /CALL TRIPL | |
3124 | TAD L46 /GET TRIPLE NUMBER | |
3125 | DCA I L41 /AND REPLACE OPERAND | |
3126 | TAD ASTOP /RESTORE OPERATOR | |
3127 | DCA I L42 | |
3128 | ISZ L40 /ADVANCE TRIPLE | |
3129 | TAD FEX /RESTORE RETURN | |
3130 | CDF 10 | |
3131 | DCA I TRIPL | |
3132 | CDF 00 | |
3133 | JMP I DUMONE /RETURN | |
3134 | / COME HERE IF OP IS / | |
3135 | DIV, JMS I SMODE /CHECK FOR SAME MODE | |
3136 | JMS I CHECK /CHECK WHATS IN THE AC | |
3137 | JMP DIVE /TWO IS IN AC | |
3138 | \f JMS I STORE /THERES SOMETHING IN THE AC...STORE IT | |
3139 | SKP /NOTHING IS IN AC | |
3140 | JMS I STORE /THERES SOMETHING IN THE AC...STORE IT | |
3141 | JMS I MADDTW /GET TWO INTO THE AC | |
3142 | DIVE, TAD I L41 /GET OPERAND ONE | |
3143 | JMS I MODE /WHAT MODE IS IT | |
3144 | TAD FM6 | |
3145 | TAD C6025 | |
3146 | DCA FDV /SAVE OERATOR | |
3147 | IAC | |
3148 | JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE | |
3149 | FDV, 0 | |
3150 | JMS I ARG /PUT OUT THE ARG PSEUDO OP | |
3151 | TAD I L41 /GET OPERAND ONE | |
3152 | JMP I MIRET /JUMP TO RETURN ROUTINE | |
3153 | / COME HERE IF OP IS ** | |
3154 | EXP, JMS I CHECK /CHECK WHATS IN THE AC | |
3155 | JMP FEXP /TWO IS IN AC | |
3156 | JMS I STORE /THERES SOMETHING IN THE AC...STORE IT | |
3157 | SKP /NOW NOTHING IS IN AC | |
3158 | JMS I STORE /THERES SOMETHING IN THE AC...STORE IT | |
3159 | JMS I MADDTW /GET TWO IN AC | |
3160 | FEXP, TAD I L41 | |
3161 | JMS I MODE | |
3162 | TAD C6 | |
3163 | DCA FDV | |
3164 | TAD I L43 /GET OPERAND TWO | |
3165 | JMS I MODE /WHAT IS ITS MODE | |
3166 | TAD C3 /FLOATING POINT | |
3167 | TAD C6207 /INTEGER | |
3168 | TAD FDV | |
3169 | DCA FEX /SAVE REOUTINE POINTER | |
3170 | IAC | |
3171 | JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE | |
3172 | FEX, 0 | |
3173 | TAD I L41 /GET OPERAND ONE | |
3174 | DCA I L43 /SAVE IN OPERAND TWO | |
3175 | TAD FEX /GET THE OP CODE JUST PUT OUT | |
3176 | TAD CM6207 /SUBTRACT THE INTEGER TO INTEGER CASE | |
3177 | SZA CLA /WAS THIS THE INTEGER INTEGER CASE | |
3178 | TAD L50 /NO, GET A FLOATING POINT POINTER | |
3179 | DCA I L41 /AND SUBSTITUTE IT FOR OPERAND ONE | |
3180 | JMS I ARG /PUT OUT THE PSEUDO OP ARG | |
3181 | \f TAD I L43 /GET THE REAL OPERAND ONE IN THE AC | |
3182 | JMP I MIRET /JUMP TO THE RETURN ROUTINE | |
3183 | /COMES HERE IF THE VARIABLE TO THE LEFT OF THE '=' IS SUBSCRIPTED | |
3184 | EIND, TAD C132 /GET AN ASTERISK | |
3185 | DCA L60 /PUT IT IN SIXTY | |
3186 | /COMES HERE IF THE OPERATOR IS AN '=' | |
3187 | EQU, JMS I CHECK /CHECK WHATS IN THE AC | |
3188 | NOP /TWO IS IN THE AC | |
3189 | JMS I STORE /THERES SOMETHING IN THE AC...STORE IT | |
3190 | JMS I TADDON /NOTHING IS IN AC...ADD ONE TO IT | |
3191 | TAD I L43 /GET OPERA ND TWO | |
3192 | JMS I MODE /WHAT IS ITS MODE | |
3193 | JMP FEQU /ITS FLOATING POINT | |
3194 | TAD L46 /GET THE AC | |
3195 | JMS I MODE /WHAT MODE IS IT | |
3196 | JMP I LFIX /ITS FLOATING POINT | |
3197 | EFIX, TAD L60 /GET EQUALS INDIRECT LOCATION | |
3198 | TAD C6071 /ADD A DCA | |
3199 | DCA ASTOP /AND SAVE OPCODE | |
3200 | JMS I PROP /POT OUT THE OPCODE | |
3201 | ASTOP, 3 | |
3202 | EQRET, DCA L46 /ZERO THE AC | |
3203 | TAD I L43 /GET OPERAND TWO | |
3204 | JMS I PRSYM /PRINT IT | |
3205 | JMS I PRINT /PUT OUT A CRLF | |
3206 | DCA L60 /ZERO SIXTY | |
3207 | JMP I .+1 /AND RETURN | |
3208 | ARET | |
3209 | FEQU, TAD L46 /GET THE AC | |
3210 | JMS I MODE /WHAT MODE IS IT | |
3211 | SKP /ITS FLOATING POINT | |
3212 | JMS I LFLOAT /ITS INTEGER...FLOAT IT | |
3213 | JMP I .+1 | |
3214 | XXX | |
3215 | ||
3216 | LARG, 0 | |
3217 | JMS I PROP | |
3218 | 6201 | |
3219 | JMP I LARG | |
3220 | ||
3221 | TADDON, ADDONE | |
3222 | E41, 41 | |
3223 | MADDTW, ADDTWO | |
3224 | FM6, -6 | |
3225 | C6025, 6025 | |
3226 | MIRET, IRET | |
3227 | C6, 6 | |
3228 | C6207, 6207 | |
3229 | LFIX, FIX | |
3230 | C6071, 6071 | |
3231 | LFLOAT, FLOAT | |
3232 | CM6207, -6207 | |
3233 | C132, 132 | |
3234 | \f *5200 | |
3235 | XXX, TAD L60 /GET THE INDIRECT EQUALS SWITCH | |
3236 | SNA CLA /IS THE SWITCH ON | |
3237 | TAD CM140 /NO, FLOATING POINT STORE | |
3238 | TAD C6146 /YES...ISTO | |
3239 | DCA FSTOP /SAVE OPCODE | |
3240 | IAC /WE ONLY HAVE ONE ARG | |
3241 | JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE | |
3242 | FSTOP, 6146 | |
3243 | JMS I ARG /PUT OUT THE ARG PSEUDO OP | |
3244 | JMP I .+1 /JUMP BACK | |
3245 | EQRET | |
3246 | / THIS ADDS OPERAND ONE TO THE AC | |
3247 | ADDONE, 0 | |
3248 | TAD I L41 /GET OPERAND ONE | |
3249 | JMS I LADDL /PUT OUT OPCODES FOR AN ADD | |
3250 | TAD I L41 /GET FIRST OPERAND | |
3251 | JMS I PRSYM /PUT OUT SYMBOL | |
3252 | JMS I PRINT /PUT OUT CR LF | |
3253 | TAD I L41 /GET OPERAND ONE | |
3254 | DCA L46 /PUTN THE AC | |
3255 | JMP I ADDONE /RETURN | |
3256 | UMIN, JMS I CHECK /CHECK WHATSN THE AC | |
3257 | NOP /TWOSN AC | |
3258 | JMS I STORE /THERES SOMETHINGN THE AC...STORET | |
3259 | JMS ADDONE /NOTHINGSN AC NOW...PUT ONEN AC | |
3260 | JMS I MCOMP /AND COMPLEMENTT | |
3261 | JMP RETURN /AND RETURN | |
3262 | AADD, JMS I SMODE | |
3263 | JMS I CHECK /CHECK WHATSN THE AC | |
3264 | JMP AONE /TWOSN AC | |
3265 | JMS I STORE /THERES SOMETHINGN THE AC...STORET | |
3266 | JMS ADDONE /GET ONEN AC | |
3267 | JMS ADDTWO /ONESN AC | |
3268 | JMP RETURN /RETURN | |
3269 | AONE, JMS ADDONE /ADD ONE TO TWO | |
3270 | JMP RETURN /AND RETURN | |
3271 | LPROP, 0 | |
3272 | CDF 10 | |
3273 | TAD I LPROP | |
3274 | CDF 00 | |
3275 | JMS I PRSYM /AND PRINT THE SYMBOL | |
3276 | TAD C40 /GET A SPACE | |
3277 | JMS I PRINT /PUT OUT | |
3278 | ISZ LPROP /INCREMENT RETURN | |
3279 | JMP I LPROP /AND RETURN | |
3280 | / THIS ADDS OPERAND TWO TO THE AC | |
3281 | ADDTWO, 0 | |
3282 | TAD I L43 /GET OPERAND TWO | |
3283 | JMS I LADDL /PUT OUT OPCODES FOR AN ADD | |
3284 | TAD I L43 /GET SECOND OPERAND | |
3285 | JMS I PRSYM /PRINT THE SYMBOL | |
3286 | JMS I PRINT /PUT OUT CR LF | |
3287 | TAD I L43 /GET OPERAND TWO | |
3288 | DCA L46 /AND PUTN AC | |
3289 | JMP I ADDTWO /RETURN | |
3290 | LXZQ, 0 /CHECK FOR EXPRESSION LEFT OF = | |
3291 | CLA | |
3292 | TAD L22 /GET SUBSCRIPT NESTING DEPTH | |
3293 | TAD L44 /GET EQUALS SIGN SWITCH | |
3294 | SNA CLA /ARE THEY BOTH ZERO | |
3295 | ERR42, JMS I LUNCH /N YES ...THATS AN ERROR | |
3296 | JMP I LXZQ /RETURN | |
3297 | RETURN, TAD I L41 /THISS THE RETURN...GET OPERAND ONE | |
3298 | JMS I MODE /WHAT MODEST | |
3299 | TAD G400 /ITS FLOATING POINT...TURN F.P. BIT ON | |
3300 | TAD L40 /ADD CURRENT TRIPLE NUMBER | |
3301 | DCA L46 /PUTN AC SW | |
3302 | JMP I NARET /AND NOW RETURN FROM THE ROUTINE | |
3303 | FLOAT, 0 | |
3304 | JMS I FPROP /PUT OUT A CAL TO THE FLOAT ROUTINE | |
3305 | 6127 | |
3306 | JMP I FLOAT /AND RETURN | |
3307 | FIX, JMS I FPROP /PUT OUT A CAL | |
3308 | 6143 /TO THE FIX ROUTINE | |
3309 | JMP I .+1 /AND JUMP BACKLADDL, ADDL | |
3310 | EFIX | |
3311 | C6146, 6146 | |
3312 | LADDL, ADDL | |
3313 | MCOMP, COMP | |
3314 | G400, 400 | |
3315 | NARET, ARET | |
3316 | LSMODE, 0 | |
3317 | TAD I L43 /GET FIRST OPERAND | |
3318 | JMS I MODE /FIND WHAT ITS MODE IS | |
3319 | JMP IBM /ITS FLOATING POINT | |
3320 | TAD I L41 /GET OPERAND TWO | |
3321 | JMS I MODE /THIS BETTER BE INTEGER TOO | |
3322 | JMP .+5 /ITS NOT, LUNCH | |
3323 | JMP I LSMODE /GREAT, RETURN | |
3324 | IBM, TAD I L41 /GET OPERAND TWO | |
3325 | JMS I MODE /THIS BETTER BE F.P. TOO | |
3326 | JMP I LSMODE /IT IS RETURN | |
3327 | ERR43, JMS I LUNCH /ERROR | |
3328 | LPUNCH, 0 | |
3329 | PSF /IS PUNCH READY | |
3330 | JMP .-1 /NO, TRY AGAIN | |
3331 | PLS /YES, PUNCH THE CHARACTER | |
3332 | CLA /CLEAR THE ACCUMULATOR | |
3333 | JMP I LPUNCH /AND RETURN | |
3334 | CM140, -140 | |
3335 | ||
3336 | LFINI, 0 /FINAL CLEANUP AT END OF COMPILATION | |
3337 | JMS I FPROP /PUNCH 'CALL 0,OPEN' | |
3338 | OPEN | |
3339 | JMS I PROP /PUNCH A 'PAUSE' | |
3340 | 6060 | |
3341 | JMS I PRINT | |
3342 | JMS I PRINT /FORCE LAST LINE OUT | |
3343 | TAD CM100 | |
3344 | JMS I LEADR /PUNCH SOME LEADER | |
3345 | CDF 10 | |
3346 | XFINI, HLT /JMP I LFINI, FOR DISK SYSTEM ... | |
3347 | CIF 0 | |
3348 | JMP I D1000 /BEGIN NEXT COMPILATION | |
3349 | D1000, 1000 | |
3350 | CM100, -100 | |
3351 | LEADR, LLEAD | |
3352 | ||
3353 | FORST, JMS I PRINT /FORTRAN STARTING POINT | |
3354 | JMS I (LIST | |
3355 | DCA .-1 | |
3356 | TAD (LPUNCH | |
3357 | DCA PUNCH | |
3358 | TAD CM50 | |
3359 | JMS I LEADR | |
3360 | JMS I PROP | |
3361 | FORTR | |
3362 | JMS I PRINT | |
3363 | JMP I .+1 | |
3364 | START1 | |
3365 | ||
3366 | PAGE | |
3367 | \f *5400 | |
3368 | LLAST, TAD C4000 /END OF COMPILATION, SET CHK SO THAT | |
3369 | DCA CHK /LGTC WILL NOT READ ANOTHER LINE... | |
3370 | JMS I GNB | |
3371 | SZA | |
3372 | JMP I ASSIGN | |
3373 | JMS I (OSTOP /PUNCH A 'HLT' ETC. | |
3374 | TAD L55 | |
3375 | TAD C25 | |
3376 | SZA CLA /IS DO LIST EMPTY? | |
3377 | ERR44, JMS I LUNCH /NO, COMPLAIN... | |
3378 | MORDUM, TAD L56 /GET POINTER INTO SYMBOL TABLE | |
3379 | TAD C2 /ADD TWO TO IT FOR CONTROL BITS | |
3380 | DCA L72 /SAVE ADDRESS OF CONTROL BITS | |
3381 | TAD I L72 /GET THE CONTROL BITS | |
3382 | AND E10 /MASK ALL BUT THE DUMMY ARG BIT | |
3383 | SNA CLA /IS THE DUMMY ARG BIT ON | |
3384 | JMP LEDOUT /NO, PUT OUT DUMMY SUBSCRIPT DEFNS | |
3385 | JMS I DEFN /YES, PUT OUT THE VARIABLE NAME | |
3386 | JMS I PROP /PUT OUT THE OP CODE | |
3387 | 6154 /WHICH IS BSS | |
3388 | TAD C2 /RESERVE TWO LOCATIONS | |
3389 | JMS I PROTAC /PRINT THE TWO | |
3390 | JMS I PRINT | |
3391 | ISZ L56 /ADVANCE THE POINTER | |
3392 | ISZ L56 | |
3393 | ISZ L56 | |
3394 | JMP MORDUM /GO BACK AND DO THE NEXT ONE | |
3395 | LEDOUT, DCA L72 /ZERO LOCATION 72 | |
3396 | LEDOT1, TAD L25 /GET THE NUMBER OF SUBSCRIPT TEMPS | |
3397 | CMA | |
3398 | TAD L72 /SUBTRACT FROM THE NUMBER WEVE DEFINED | |
3399 | SNA CLA /HAVE WE DEFINED THEM ALL YET | |
3400 | JMP GOOON /YES, NOW PUT OUT THE END | |
3401 | TAD K5200 /GET SUBSCRIPT DESIGNATOR | |
3402 | TAD L72 /GET WHICH SUBSCRIPT | |
3403 | JMS I PRSYM /AND PRINT IT | |
3404 | TAD C7240 /GET THE TERMINATOR | |
3405 | JMS I P2 /PRINT IT | |
3406 | JMS I PROP /PRINT THE OP CODE | |
3407 | 6154 /WHICH IS BSS | |
3408 | TAD C2 /RESERVE TWO LOCATIONS | |
3409 | JMS I PROTAC | |
3410 | JMS I PRINT /CRLF | |
3411 | ISZ L72 /GO ON TO THE NEXT ONE | |
3412 | JMP LEDOT1 | |
3413 | GOOON, JMS I PROP | |
3414 | 6157 /PUT OUT AN END | |
3415 | JMS I PRINT /PUT OUT A CRLF | |
3416 | DCA L65 /ZERO THE PSEUDO LOCATION COUNTER | |
3417 | TAD START /CLA = -600 | |
3418 | JMS I LEAD /PUT OUT LOTS OF LEADER CODE | |
3419 | JMS I PROP | |
3420 | 6162 /PUT OUT A LAP | |
3421 | JMS I PRINT | |
3422 | SYM, TAD L57 | |
3423 | CIA | |
3424 | TAD L56 | |
3425 | SZA CLA /ARE THERE ANY SYMBOLS | |
3426 | JMP SYM1 | |
3427 | TAD MIKE8 | |
3428 | SZA CLA /NO, IS THERE ANY EQUIVALENCING? | |
3429 | JMP I LPTEMP | |
3430 | JMP I .+1 | |
3431 | PTEMP | |
3432 | SYM1, TAD L56 | |
3433 | TAD C2 | |
3434 | DCA L72 | |
3435 | TAD I L72 /GET THE CONTROL BITS | |
3436 | DCA L72 /SAVE THEN | |
3437 | TAD L72 /GET THE BITS | |
3438 | AND E7 /MASK | |
3439 | SZA CLA /ARE THEY FUNCT NAME, | |
3440 | JMP UP /YES | |
3441 | JMS I DEFN /PUT IT OUT | |
3442 | TAD L72 | |
3443 | AND E20 /MASK ALL BUT THE DIMEN | |
3444 | SNA CLA /IS EITHER ONE ON | |
3445 | JMP NORM /NO | |
3446 | TAD L56 | |
3447 | JMS I DIM | |
3448 | DCA L26 | |
3449 | TAD I L14 /GET THE SECOND DIMENSION | |
3450 | CLL CIA /AND NEGATE | |
3451 | DCA L73 /SAVE | |
3452 | SZL | |
3453 | ERR36, JMS I LUNCH | |
3454 | TAD L26 | |
3455 | ISZ L73 | |
3456 | JMP .-4 | |
3457 | ACK, DCA L26 | |
3458 | TAD L56 | |
3459 | JMS I MODE /DETERMINE MODE OF SYMBOL | |
3460 | TAD L26 | |
3461 | RAL CLL | |
3462 | TAD L26 | |
3463 | SZL | |
3464 | JMP ERR36 | |
3465 | DCA L26 | |
3466 | TAD L72 | |
3467 | AND C40 | |
3468 | SZA CLA | |
3469 | JMP COM | |
3470 | JMS I BSS | |
3471 | UP, ISZ L56 | |
3472 | ISZ L56 | |
3473 | ISZ L56 | |
3474 | JMP SYM | |
3475 | NORM, IAC | |
3476 | JMP ACK | |
3477 | C25, 25 | |
3478 | E7, 7 | |
3479 | K5200, 5200 | |
3480 | DEFN, LDEFN | |
3481 | E20, 20 | |
3482 | E10, 10 | |
3483 | LPTEMP, EEK | |
3484 | LEAD, LLEAD | |
3485 | COM, JMS I PROP | |
3486 | 6165 | |
3487 | TAD L26 | |
3488 | JMS I PROTAC | |
3489 | JMS I PRINT | |
3490 | JMP UP | |
3491 | \f *5600 | |
3492 | C7600, 7600 | |
3493 | C177, 177 | |
3494 | LBSS, 0 | |
3495 | TAD L65 /GET THE LOCATION COUNTER | |
3496 | TAD L26 /ADD THE CURRENT AMOUNT TO IT | |
3497 | AND C7600 /MASK ALL BUT THE PAGE BITS | |
3498 | DCA L64 /SAVE THE NUMBER OF PAGES | |
3499 | TAD L65 /GET THE LOCATION COUNTER AGAIN | |
3500 | TAD L26 /ADD THE CURRENT DISPLACEMENT AGAIN | |
3501 | AND C177 /NOW GET THE NUMBER OF LOCATIONS OVER A PAGE | |
3502 | DCA L65 /AND SAVE | |
3503 | L, TAD L64 /GET THE NUMBER OF PAGES TO BE RESERVED | |
3504 | SNA /ARE THERE ANY TO BE RESERVED | |
3505 | JMP CRAM /NO...JUST PUT OUT STRAIGHT NUMBER OF LOCATIONS | |
3506 | TAD C7600 /YES...SUBTRACT ONE FROM THE PAGE COUNT | |
3507 | DCA L64 /AND SAVE IT | |
3508 | TAD L65 /GET THE NUMBER OF EXTRA LOCATIONS | |
3509 | DCA L26 /AND PUT IN THE DISPLACEMENT LOCATION | |
3510 | JMS I PROTAC /PUT OUT A ZERO | |
3511 | JMS I PRINT /PUT OUT A CRLF | |
3512 | JMS I PROP /PUT OUT THE OPCODE | |
3513 | 6151 /WHICH IS THE PAGE PSEUDO OP | |
3514 | JMS I PRINT /PUT OUT A CRLF | |
3515 | JMP L /NOW SEE IF WE HAVE PUT OUT ENOUGH PAGES | |
3516 | CRAM, JMS I PROP /NOW PUNCH 'BLOCK <N>' | |
3517 | BLCK | |
3518 | TAD L26 | |
3519 | JMS I PROTAC | |
3520 | JMS I PRINT | |
3521 | JMP I LBSS | |
3522 | LDEFN, 0 | |
3523 | TAD L56 /GET THE POINTER TO THE SYMBOL | |
3524 | JMS I PRSYM /PRINT THE SYMBOL | |
3525 | TAD C7240 /GET THE TERMINATOR | |
3526 | JMS I P2 /PRINT IT | |
3527 | JMP I LDEFN /AND RETURN | |
3528 | AFCON, TAD L47 /GET START OF FCON TABLE | |
3529 | TAD C3 /UPDATE IT | |
3530 | DCA L56 /SAVE UPDATED ADDRESS | |
3531 | FLOOP, TAD L50 /GET END OF FCON TABLE | |
3532 | CIA | |
3533 | TAD L56 /SUBTRACT FROM CURRENT POINTER | |
3534 | SNA CLA /ARE WE DONE | |
3535 | JMP ALTHRU /YES | |
3536 | TAD CM3 /NO, GET MINUS THREE | |
3537 | DCA L63 /TO USE AS A COUNTER | |
3538 | JMS LDEFN /DEFINE IT | |
3539 | TAD I L56 /GET THE FIRST WORD | |
3540 | ISZ L56 /ADVANCE THE POINTER TO THE NEXT WORD | |
3541 | JMS I PROTAC /PRINT THE WORD | |
3542 | JMS I PRINT /PUT OUT A CRLF | |
3543 | ISZ L63 /HAVE WE PUT OUT ALL THREE WORDS | |
3544 | JMP .-5 /NO...PUT OUT ANOTHER | |
3545 | JMP FLOOP /YES...GET THE NEXT CONSTANT | |
3546 | PTEMP, TAD K561 | |
3547 | DCA L56 | |
3548 | FTLOOP, TAD L45 | |
3549 | CMA | |
3550 | TAD L56 | |
3551 | SNA CLA | |
3552 | JMP ITEMP | |
3553 | TAD C3 | |
3554 | DCA L26 | |
3555 | TAD K5400 /GET F.P. DESIGNATOR | |
3556 | JMS LDEFN /PRINT THE SYMBOL | |
3557 | JMS I BSS /RESERVE THE LOCATIONS FOR IT | |
3558 | ISZ L56 /INCREMENT THE POINTER | |
3559 | JMP FTLOOP | |
3560 | ITEMP, TAD K531 | |
3561 | DCA L56 | |
3562 | ILOOP, TAD L51 | |
3563 | CMA | |
3564 | TAD L56 | |
3565 | SNA CLA | |
3566 | JMP SUBOUT | |
3567 | IAC | |
3568 | DCA L26 | |
3569 | TAD K5000 /GET THE INTEGER TEMP DESIGNATOR | |
3570 | JMS LDEFN /PRINT IT | |
3571 | JMS I BSS /RESERVE LOCATIONS FOR IT | |
3572 | ISZ L56 /INCREMENT THE POINTER | |
3573 | JMP ILOOP | |
3574 | ALTHRU, TAD D6 /PUNCH AN 'IFF 6' | |
3575 | JMS I PIFF /SO THAT ENTRY WILL NOT BE AT END OF THE PAGE | |
3576 | JMS I PROP | |
3577 | 6055 /PUT OUT AN EAP | |
3578 | JMS I PRINT | |
3579 | TAD L70 /GET THE SUBROUTINE FUNCTION POINTER | |
3580 | SZA CLA /IS IT ZERO | |
3581 | JMP THRU /NO...WE MUST BE IN A SUBR OR A FUNC | |
3582 | JMS I PROP /YES ...WERE IN A MAIN PROGRAM | |
3583 | 6052 /PUT OUT ENT | |
3584 | TAD C6000 /POINTER TO THE SYMBOL MAIN | |
3585 | JMS I PRSYM /PRINT THE SYMBOL | |
3586 | JMS I PRINT /PUT OUT A CRLF | |
3587 | TAD C6000 /GET THE POINTER TO MAIN AGAIN | |
3588 | JMS I PRSYM /PRINT IT | |
3589 | TAD C7240 /GET A COLON | |
3590 | JMS I P2 /PRINT THEM | |
3591 | JMS I PROP | |
3592 | 6047 | |
3593 | JMS I PRINT /PUT OUT A CRLF | |
3594 | THRU, JMS I FINI | |
3595 | 6201 /CDF FIELD 0 | |
3596 | JMP I C7600 /AND RETURN TO THE MONITOR ... | |
3597 | C6000, 6000 | |
3598 | SUBOUT, DCA L56 | |
3599 | SUBOT1, TAD L25 | |
3600 | CMA | |
3601 | TAD L56 | |
3602 | SNA CLA | |
3603 | JMP AFCON | |
3604 | JMS I PROP /PUT OUT THE OP CODE | |
3605 | 6176 /WHICH IS DUMMY | |
3606 | TAD X5200 /GET SUBSCRIPT DESIGNATOR | |
3607 | TAD L56 /GET THE POINTER | |
3608 | JMS I PRSYM /PRINT THE SYMBOL | |
3609 | JMS I PRINT /CRLF | |
3610 | ISZ L56 | |
3611 | JMP SUBOT1 | |
3612 | K5000, 5000-ITTAB | |
3613 | K5400, 5400-FTTAB | |
3614 | K531, ITTAB+1 | |
3615 | K561, FTTAB+1 | |
3616 | X5200, 5200 | |
3617 | FINI, LFINI | |
3618 | D6, 6 | |
3619 | \f *6000 | |
3620 | /FUNCTION AND SUBROUTINE STATEMENT PROCESSOR | |
3621 | LFUNC, JMS I LOOK /CHECK REST OF STATEMENT | |
3622 | MFOUR, -4 / | |
3623 | -24 /T | |
3624 | -11 /I | |
3625 | -17 /O | |
3626 | -16 /N | |
3627 | CLA IAC /SET SWITCH | |
3628 | TART, DCA L67 /THIS IS THE SWITCH | |
3629 | TAD FIRSTF | |
3630 | SNA CLA /INSURE SUBR. OR FUNCT. IS FIRST STMT. | |
3631 | ERR47, JMS I LUNCH | |
3632 | JMS SUBB | |
3633 | CLA CMA | |
3634 | TAD C6275 /THIS IS THE PLACE TO STORE FUNCTION NAME | |
3635 | DCA L11 /USE AUTO INDEXING TO STORE THE NAME | |
3636 | TAD L30 /GET THE FIRST WORD | |
3637 | DCA I L11 /PUT IT IN THE SYMBOL TABLE | |
3638 | TAD L31 /GET THE SECOND WORD | |
3639 | DCA I L11 /PUT IT IN THE TABLE | |
3640 | TAD L32 /GET THE THIRD WORD | |
3641 | IAC /TURN THE EXTERNAL SYMBOL BIT ON | |
3642 | DCA I L11 /AND PUT IT IN THE TABLE | |
3643 | TAD C6275 /GET THE POINTER | |
3644 | DCA L70 /AND PUT IT IN LOC 70 | |
3645 | JMS I PROP | |
3646 | 6052 /PUT OUT AN ENT | |
3647 | TAD L70 /GET THE SUBROUTINE NAME | |
3648 | JMS I PRSYM /PRINT IT | |
3649 | JMS I PRINT /PUT OUT A CRLF | |
3650 | CLA CMA | |
3651 | DCA READY /SET SWITCH | |
3652 | TAD L70 /GET THE SUB NAME | |
3653 | JMS I PRSYM /PUT IT OUT | |
3654 | TAD C7240 | |
3655 | JMS I P2 /PUT IT OUT | |
3656 | JMS I PROP /PUT OUT THE OP CODE 'BLOCK 2' | |
3657 | BLCK | |
3658 | TAD C2 | |
3659 | JMS I PROTAC | |
3660 | JMS I PRINT | |
3661 | DCA WHICH /ZERO THE SWITCH WHICH TELLS WHICH WORD | |
3662 | MORE, JMS I GNB | |
3663 | SNA /CHECK FOR END OF CARD | |
3664 | JMP CKCR | |
3665 | TAD CM50 /CHECK FOR LEFT PAREN | |
3666 | SNA /IS IT A LPAR | |
3667 | JMP GET1 /YES | |
3668 | TAD MFOUR | |
3669 | SNA /IS IT A COMMA | |
3670 | JMP XGET /YES | |
3671 | TAD C3 | |
3672 | SNA CLA /IS IT A LPAR | |
3673 | JMP START /YES | |
3674 | JMP ERR48 /NO | |
3675 | GET1, ISZ READY /WERE WE READY FOR LPAR | |
3676 | JMP ERR48 /NO, ERROR ... | |
3677 | XGET, JMS SUBB | |
3678 | TAD L32 | |
3679 | TAD TEN | |
3680 | DCA L32 | |
3681 | TAD C77 /GET MASK FOR SYMBOL TABLE | |
3682 | DCA L21 /AND PUT INTO THE SWITCH | |
3683 | JMS I SYMTAB /AND PUT IN SYMBOL TABLE | |
3684 | JMS I PROP | |
3685 | DUMMY | |
3686 | TAD L77 | |
3687 | JMS I PRSYM | |
3688 | JMS I PRINT | |
3689 | DLOOP, JMS I PROP | |
3690 | 6063 /PUT OUT A TAD* | |
3691 | TAD L70 /GET THE FUNCTION NAME | |
3692 | JMS I PRSYM /AND PRINT IT | |
3693 | JMS I PRINT /PUT OUT A CRLF | |
3694 | JMS I PROP | |
3695 | 6071 /PUT OUT A DCA | |
3696 | TAD L77 /GET ADDRESS OF SYMBOL | |
3697 | JMS I PRSYM /PRINT IT | |
3698 | TAD WHICH /GET THE WHICH SWITCH | |
3699 | RAR /GET THE LOW BIT INTO THE LINK | |
3700 | SNL CLA /IS THE WHICH SWITCH BIT SWITCHED | |
3701 | JMP NEXT /NO...THAT MEANS WERE ON THE FIRST WORD | |
3702 | TAD E43 /YES...WERE ON SECOND WORD...GET A "#" | |
3703 | JMS I PRINT /PRINT IT | |
3704 | NEXT, JMS I PRINT | |
3705 | JMS I PROP /PUT OUT AN INC (ISZ WHICH DOES NOT SKIP) | |
3706 | 6237 | |
3707 | TAD L70 /GET THE FUNCTION NAME | |
3708 | JMS I PRSYM /AND PRINT IT | |
3709 | TAD E43 | |
3710 | JMS I PRINT | |
3711 | JMS I PRINT /PUT OUT A CRLF | |
3712 | ISZ WHICH /INCREMENT THE SHICH SWITCH | |
3713 | TAD WHICH /GET THE SWITCH | |
3714 | RAR /GET LOW BIT IN THE LINK | |
3715 | SZL CLA /IS THE LOW BIT ON | |
3716 | JMP DLOOP /YES...WORK ON THE SECOND WORD | |
3717 | JMP MORE /GO GET SOME MORE | |
3718 | READY, 0 | |
3719 | SUBB, 0 | |
3720 | JMS I ENTITY | |
3721 | SKP | |
3722 | JMP I SUBB | |
3723 | E43, 43 | |
3724 | TEN, 10 | |
3725 | JMP ERR48 | |
3726 | WHICH, 0 | |
3727 | C6275, 6275 /SUBROUTINE OR FUNCTION NAME POINTER | |
3728 | CKCR, ISZ READY | |
3729 | ERR48, JMS I LUNCH | |
3730 | JMP START | |
3731 | ||
3732 | IOEQL, CLA CMA /ROUTINE TO TERMINATE IMPLIED DO LOOPS | |
3733 | TAD IMPDO | |
3734 | DCA IMPDO /REDUCE THE DEPTH BY 1 | |
3735 | JMS I DONEXT /GENERATE END-OF-LOOP CODE | |
3736 | JMS I GNB | |
3737 | TAD CM51 | |
3738 | SZA CLA /SKIP TO A RIGHT PAREN | |
3739 | JMP .-3 | |
3740 | JMP I .+1 | |
3741 | IOH0 | |
3742 | DONEXT, LDNEXT | |
3743 | \f *6172 | |
3744 | C6030, 6030 | |
3745 | LWRIT, JMS I LOOK /LOOK FOR REST OF STATEMENT | |
3746 | -1 | |
3747 | -5 | |
3748 | TAD C3 | |
3749 | LREAD, TAD C6030 /GET THE POINTER TO READ AND WRITE | |
3750 | DCA IOP /USE AS A PARAMETER WITH FPROP | |
3751 | JMS I GNB | |
3752 | TAD CM50 | |
3753 | SZA CLA /IS THIS A LEFT PAREN? | |
3754 | JMP I ASSIGN | |
3755 | JMS SUBA | |
3756 | JMS I ZZZ | |
3757 | TAD C2 | |
3758 | JMS I FPROP | |
3759 | IOP, 0 | |
3760 | JMS I ARG | |
3761 | TAD L32 | |
3762 | JMS I PRSYM | |
3763 | JMS I PRINT | |
3764 | JMS I ARG | |
3765 | JMS I GNB | |
3766 | TAD CM54 /IS IT A COMMA | |
3767 | SZA CLA | |
3768 | JMP ERR50 /NO, ERROR ... | |
3769 | JMS SUBA | |
3770 | TAD L32 /GET FORMAT | |
3771 | SMA | |
3772 | JMS I PLAB | |
3773 | SPA | |
3774 | JMS I PRSYM | |
3775 | JMS I GNB | |
3776 | TAD CM51 /CHECK FOR A RIGHT PAREN | |
3777 | SZA CLA /IS IT? | |
3778 | ERR50, JMS I LUNCH | |
3779 | JMS I PRINT | |
3780 | IOH0, JMS I GNB | |
3781 | SNA | |
3782 | JMP IOH2 | |
3783 | TAD CM54 | |
3784 | SNA CLA /IS IT A COMMA | |
3785 | JMP IOH3 /YES ... | |
3786 | IOH1, JMS I PUTCH /NO...PUT IT BACK | |
3787 | JMS I GNB /THIS STMT IS TRANSFERRED TO! | |
3788 | TAD CM50 | |
3789 | SNA CLA | |
3790 | JMP I IOPEN /OPEN PAREN - MAY BE IMPLIED DO-LOOP | |
3791 | IOH1BK, JMS I PUTCH | |
3792 | DCA L52 /SET SWITCHES FOR GENER | |
3793 | DCA L46 | |
3794 | ISZ L44 | |
3795 | JMS I GENER /START PROCESSING THE IO LIST | |
3796 | TAD L41 | |
3797 | DCA L42 | |
3798 | TAD L53 | |
3799 | DCA L73 /SAVE CREATED LABEL LOC | |
3800 | DCA L23 /ZERO TEMPORARY FOR "DUMARG" | |
3801 | JMS I LCHNG /TEST FOR 0 OR DUMMY ARG | |
3802 | DCA I L41 | |
3803 | TAD L23 /GET TEMPORARY FROM "DUMARG" | |
3804 | SZA CLA /ZERO MEANS NON-VARIABLE NAME | |
3805 | TAD I L23 /NON-ZERO POINTS TO FLAG WORD OF VAR | |
3806 | AND Q20 | |
3807 | SNA CLA /DO WE HAVE AN ARRAY NAME? | |
3808 | JMP NOSYMB /NO | |
3809 | JMS I PROP | |
3810 | OPCMA /PUT OUT A "CMA" TO DISTINGUISH THIS CALL | |
3811 | JMS I PRINT /FROM A REGULAR CALL TO "IOH" | |
3812 | TAD C2 | |
3813 | JMS I FPROP | |
3814 | 6036 /OUTPUT A "CALL 2,IOH" | |
3815 | JMS I ARG | |
3816 | TAD L23 | |
3817 | TAD CM2 | |
3818 | JMS I DIM /GET THE DIMENSIONS | |
3819 | DCA IOP | |
3820 | TAD I L14 | |
3821 | CIA | |
3822 | DCA L44 | |
3823 | TAD L23 | |
3824 | TAD CM2 | |
3825 | JMS I MODE /GET THE MODE OF THE ARRAY | |
3826 | TAD C4000 /FLOATING POINT - ADD 4000 TO AC | |
3827 | TAD IOP | |
3828 | ISZ L44 | |
3829 | JMP .-2 /COMPUTE PRODUCT OF DIMENSIONS PLUS MODE BIT | |
3830 | JMS I PROTAC /PRINT IT | |
3831 | JMS I PRINT | |
3832 | JMP IOHRSM /GO PRINT ARRAY NAME | |
3833 | NOSYMB, TAD L46 | |
3834 | SZA CLA | |
3835 | JMS I STORE | |
3836 | IAC /THERE WILL BE ONE ARGUMENT | |
3837 | JMS I FPROP /PUT OUT THE CALL TO IOH | |
3838 | 6036 | |
3839 | IOHRSM, TAD L73 | |
3840 | DCA L53 /RESTORE CREATED LABEL LOC | |
3841 | TAD I L41 | |
3842 | JMS I QSYMOT | |
3843 | TAD L63 /GET TERMINATING CHAR | |
3844 | SNA CLA /WAS IT A <CR>? | |
3845 | JMP IOH2 /YES | |
3846 | IOH3, JMS I GNB /GENTLY LOOK AHEAD ... | |
3847 | SNA CLA /DO WE HAVE A ',<CR>' ? | |
3848 | JMP START /YES, DO NOT TERMINATE YET ... | |
3849 | JMP IOH1 /NO, PUSH IT BACK & PROCESS NEXT ITEM | |
3850 | IOH2, IAC /THERE WILL BE ONE ARGUMENT | |
3851 | JMS I FPROP /PUT OUT A CALL TO IOH | |
3852 | 6036 | |
3853 | JMS I ARG /PUT OUT THE PSEUDO OP ARG | |
3854 | JMS I PROTAC | |
3855 | JMS I PRINT | |
3856 | JMP START | |
3857 | SUBA, 0 | |
3858 | JMS I ENTITY | |
3859 | JMP ERR51 /ITS A CR | |
3860 | JMP ERR51+1 /ITS A VARIABLE | |
3861 | JMP I SUBA | |
3862 | Q20, 20 | |
3863 | ERR51, JMS I LUNCH | |
3864 | DCA L21 /ZERO THE SYMBOL TABLE SWITCH | |
3865 | JMS I SYMTAB | |
3866 | TAD L77 | |
3867 | JMS I MODE | |
3868 | JMP ERR51 | |
3869 | TAD L77 | |
3870 | DCA L32 | |
3871 | TAD L32 | |
3872 | JMS I DUMARG | |
3873 | JMP ERR51 | |
3874 | JMP I SUBA | |
3875 | IOPEN, IOOPEN | |
3876 | QSYMOT, SYMOUT | |
3877 | \f *6400 | |
3878 | LRET, JMS I LOOK /CHECK REST OF STATEMENT | |
3879 | -2 | |
3880 | -22 | |
3881 | -16 | |
3882 | JMS I ZZZ | |
3883 | TAD L70 | |
3884 | SNA CLA /ARE WE COMPILING MAIN PROGRAM? | |
3885 | ERR60, JMS I LUNCH /YES | |
3886 | TAD L67 | |
3887 | SNA CLA | |
3888 | JMP INT /ITS A SUBROUTINE | |
3889 | TAD L70 /GET HE NAME OF THE FUNCTION | |
3890 | JMS I MODE /IS IT FP OR INTEGER | |
3891 | JMP .+4 /ITS FP | |
3892 | JMS I PROP | |
3893 | 6066 /OPCODE IS TAD | |
3894 | JMP .+5 /PUT OUT THE SYMBOL | |
3895 | IAC /THERE IS ONE ARGUMENT | |
3896 | JMS I FPROP | |
3897 | 6003 | |
3898 | JMS I ARG | |
3899 | TAD F34 /GET A BACK SLASH | |
3900 | JMS I PRINT | |
3901 | TAD L70 /GET THE NAME OF THE FUNCTION | |
3902 | JMS I PRSYM /PRINT THE NAME | |
3903 | JMS I PRINT /PUT OUT A CRLF | |
3904 | INT, JMS I PROP | |
3905 | 6077 /OPCODE IS RTN | |
3906 | TAD L70 /GET THE FUNCTION NAME | |
3907 | JMS I PRSYM /PRINT IT | |
3908 | JMS I PRINT /PUT OUT A CRLF | |
3909 | JMP START /WERE DONE | |
3910 | ||
3911 | LGETHI, 0 /PUNCH 'TAD ACH' | |
3912 | JMS I PROP | |
3913 | 6066 | |
3914 | JMS I PROP /PRINT THE OP CODE | |
3915 | 6226 /WHICH IS ACH (HIGH ORDER AC) | |
3916 | JMS I PRINT | |
3917 | JMS I FPROP /PUNCH 'CALL 0,CLEAR' | |
3918 | 6204 | |
3919 | JMP I LGETHI | |
3920 | LDIM, 0 /GETS THE 1ST DIMENSION OF THIS VARIABLE | |
3921 | DCA LGETHI /SYMBOL TABLE ADDRESS IS IN THE AC | |
3922 | CMA | |
3923 | TAD L50 | |
3924 | DCA L14 | |
3925 | LK, TAD I L14 /SEARCH THE DIMENSION TABLE | |
3926 | CIA | |
3927 | TAD LGETHI | |
3928 | SNA CLA | |
3929 | JMP .+4 | |
3930 | ISZ L14 | |
3931 | ISZ L14 | |
3932 | JMP LK | |
3933 | TAD I L14 /EXIT WITH DIMENSION IN THE AC | |
3934 | JMP I LDIM | |
3935 | / THIS PROCESSES SUBSCRIPTS | |
3936 | SUBRET, JMP I LSUBSC /RETURN FROM SUBSC | |
3937 | LSBTEM, 0 /THIS ROUTINE MAKES AN ENTRY | |
3938 | DCA TRIP /IN SUBSCRIPT TEMPORARY TABLE | |
3939 | TAD FBASE | |
3940 | DCA POINT | |
3941 | TAD CM40 | |
3942 | DCA PCTR | |
3943 | LOOP, TAD I POINT /LOOK FOR CURRENT TRIPLE NR | |
3944 | SNA /OR END OF TABLE... | |
3945 | JMP YES | |
3946 | CIA | |
3947 | TAD TRIP | |
3948 | SNA CLA | |
3949 | JMP GOT | |
3950 | ISZ POINT | |
3951 | ISZ PCTR | |
3952 | JMP LOOP | |
3953 | ERR53, JMS I LUNCH | |
3954 | YES, TAD TRIP | |
3955 | DCA I POINT | |
3956 | GOT, TAD FBASE | |
3957 | CIA | |
3958 | TAD POINT | |
3959 | DCA POINT | |
3960 | TAD POINT | |
3961 | CIA | |
3962 | TAD L25 | |
3963 | SPA CLA /IF TEMPORARY NR > L25 | |
3964 | ISZ L25 /BUMP L25 | |
3965 | TAD POINT | |
3966 | JMP I LSBTEM | |
3967 | LWIPE, 0 /ZERO THE SUBSCRIPT TEMP. TABLE | |
3968 | TAD FBASE | |
3969 | DCA POINT | |
3970 | TAD CM40 | |
3971 | DCA PCTR | |
3972 | LOOP2, DCA I POINT | |
3973 | ISZ POINT | |
3974 | ISZ PCTR | |
3975 | JMP LOOP2 | |
3976 | JMP I LWIPE | |
3977 | LZER, 0 | |
3978 | ISZ LZER /INCREMANT | |
3979 | JMS I PROTAC /PUT OUT A ZERO | |
3980 | JMP I LZER /AND REUTURN | |
3981 | LCLAB, 0 | |
3982 | SNA /IF NO LABEL IN AC, | |
3983 | JMS I CREATE /CREATE A LABEL | |
3984 | JMS I PRCRL /AND PRINT IT | |
3985 | TAD C7240 /PUT OUT A COLON AND SPACE | |
3986 | JMS I P2 | |
3987 | JMP I LCLAB /RETURN | |
3988 | FBASE, 4600 | |
3989 | POINT, 0 | |
3990 | PCTR, 0 | |
3991 | TRIP, 0 | |
3992 | F34, 34 | |
3993 | LSUBSC, 0 | |
3994 | TAD L46 | |
3995 | SZA /IS THERE ANYTHING IN THE AC? | |
3996 | CHANGE, SKP CLA /******************************** | |
3997 | / TRY CHANGING THIS LOCATION TO A "JMS I MODE" | |
3998 | / TO LIMIT THE CHECK TO THE INTEGER AC! | |
3999 | / COULD SAVE UP TO 30% IN HEAVILY SUBSCRIPTED F.P. | |
4000 | / EXPRESSIONS! (IMPORTANT - TEST WITH F.P. SUBSCRIPTS) | |
4001 | SKP /NOTHING IN THE AC | |
4002 | JMS I STORE /YES - STORE IT | |
4003 | IAC | |
4004 | DCA L63 | |
4005 | TAD L53 | |
4006 | DCA L73 | |
4007 | TAD L41 | |
4008 | DCA L42 | |
4009 | ISZ L41 | |
4010 | TAD I L41 | |
4011 | TAD CM4046 | |
4012 | SNA CLA /WAS IT A PRIME | |
4013 | JMP BACK | |
4014 | JMS I LCHNG | |
4015 | DCA L63 | |
4016 | ISZ L41 | |
4017 | ISZ L41 | |
4018 | ISZ L42 | |
4019 | \f ISZ L42 | |
4020 | IAC | |
4021 | BACK, ISZ L41 | |
4022 | DCA SYMOUT | |
4023 | JMS CHNG | |
4024 | DCA L65 | |
4025 | ISZ L42 | |
4026 | ISZ L42 | |
4027 | JMS CHNG | |
4028 | DCA LDUM /SAVE ARRAY POINTER (OR 0 IF DUMMY) | |
4029 | TAD L73 /NOW RESTORE THE CREATED LABEL LOC | |
4030 | DCA L53 | |
4031 | TAD SYMOUT | |
4032 | SNA CLA /HOW MANY SUBSCRIPTS? | |
4033 | JMP .+7 /ONE - SKIP OUTPUTTING "TAD" | |
4034 | JMS I PROP | |
4035 | 6066 | |
4036 | TAD I L41 | |
4037 | JMS I DIM | |
4038 | JMS I PRSYM | |
4039 | JMS I PRINT | |
4040 | TAD I L41 | |
4041 | JMS I MODE | |
4042 | JMP FP | |
4043 | CASUB, TAD H200 | |
4044 | TAD L40 | |
4045 | DCA I L41 /STORE TRIPLE NUMBER WITH MODE BITS IN PD STACK | |
4046 | TAD SYMOUT /GET NUMBER OF ARGUMENTS (2 OR 3) | |
4047 | TAD C2 | |
4048 | JMS I FPROP /PUT OUT A CALL TO THE SUBSCRIPTING ROUTINE | |
4049 | 6173 /TO THE SUBSCRIPTING ROUTINE | |
4050 | TAD SYMOUT | |
4051 | SNA CLA /ONLY ONE ARG? | |
4052 | JMP .+3 /YES - DON'T OUTPUT FIRST SUBSCRIPT | |
4053 | TAD L63 | |
4054 | JMS SYMOUT | |
4055 | TAD L65 | |
4056 | JMS SYMOUT | |
4057 | TAD LDUM /GET THE ARRAY NAME | |
4058 | JMS SYMOUT /OUTPUT IT AS AN ARGUMENT | |
4059 | TAD I L41 | |
4060 | JMS I PRSYM /OUTPUT THE DESTINATION TEMPORARY | |
4061 | JMS I PRINT | |
4062 | TAD I L41 | |
4063 | DCA L12 /MARK IT AS THE CONTENTS OF THE LAST LINE | |
4064 | JMP I FSUBSC /RETURN | |
4065 | FP, JMS I PROP | |
4066 | OPCMA /OPCODE IS CMA | |
4067 | JMS I PRINT | |
4068 | TAD H400 /SET MODE TO FLOATING POINT | |
4069 | JMP CASUB | |
4070 | SYMOUT, 0 | |
4071 | DCA CHNG | |
4072 | TAD CHNG | |
4073 | SNA CLA | |
4074 | JMS I CLAB /CREATE LABEL IF DUMMY ARG | |
4075 | JMS I ARG | |
4076 | TAD CHNG | |
4077 | SNA /IS IT ZERO | |
4078 | JMS I ZER /YES PUT OUT A ZERO | |
4079 | JMS I PRSYM /OTHERWISE PUT OUT SUBSCRIPT | |
4080 | JMS I PRINT /PUT OUT A CRLF | |
4081 | JMP I SYMOUT | |
4082 | ||
4083 | LDSPCL, DCA L24 | |
4084 | JMS I CREATE | |
4085 | JMS I PRCRL /CHANGE LAST LINE TO STORE IN NEW DESTINATION | |
4086 | DCA L12 /MARK LAST LINE USELESS FOR OPTOMIZATION | |
4087 | JMP LDMRET | |
4088 | LDUM, 0 | |
4089 | ISZ LDUM /INCREMENT RETURN | |
4090 | TAD I L42 /GET THE THING WHICH IS DUMMY | |
4091 | CIA | |
4092 | TAD L12 /DID WE JUST PUT THIS OUT AS A SUBSCRIPT | |
4093 | SNA CLA /DESTINATION?? | |
4094 | JMP LDSPCL /YES - SAVE OODLES OF CODE | |
4095 | JMS I PROP | |
4096 | 6066 /PUT OUT A TAD | |
4097 | TAD I L42 | |
4098 | JMS I PRSYM /PUT IT OUT | |
4099 | JMS I PRINT /PUT OUT A CRLF | |
4100 | JMS I PROP | |
4101 | 6071 /PUT OUT A DCA | |
4102 | JMS I CREATE /CREATE A LABEL | |
4103 | JMS I PRCRL /AND PRINT IT | |
4104 | JMS I PRINT /PUT OUT A CRLF | |
4105 | JMS I PROP | |
4106 | 6066 | |
4107 | TAD I L42 | |
4108 | JMS I PRSYM | |
4109 | TAD H43 | |
4110 | JMS I PRINT | |
4111 | JMS I PRINT | |
4112 | JMS I PROP | |
4113 | 6071 | |
4114 | TAD L53 | |
4115 | JMS I PRCRL | |
4116 | TAD H43 | |
4117 | JMS I PRINT | |
4118 | LDMRET, JMS I PRINT | |
4119 | JMP I LDUM /RETURN | |
4120 | CHNG, 0 | |
4121 | TAD I L42 /NO...THERES TWO SUBSCRIPTS | |
4122 | SNA | |
4123 | TAD H6041 | |
4124 | DCA I L42 | |
4125 | TAD I L42 | |
4126 | JMS I DUMARG /SEE IF SECOND SUBSC IS A DUMMY ARG | |
4127 | JMS I DUM /YES IT IS A DUMMY ARG | |
4128 | TAD I L42 /GET THE SECOND SUBSC | |
4129 | JMP I CHNG | |
4130 | ||
4131 | H400, 400 | |
4132 | H200, 200 | |
4133 | H43, 43 | |
4134 | FSUBSC, SUBRET | |
4135 | H6041, 6041 | |
4136 | \f *7000 | |
4137 | IOHTMP,MCHAR, 0 | |
4138 | NPOINT,LLUNCH, 0 | |
4139 | CLA | |
4140 | DCA L75 | |
4141 | DCA L24 /ZERO "BUFFER WAITING TO PRINT" FLAG | |
4142 | DCA IMPDO /ZERO IMPLIED DO LOOP FLAG | |
4143 | TAD TTYPE /CHANGE TO TTY OUTPUT | |
4144 | DCA PUNCH | |
4145 | JMS I LLIST /TYPE THE CURRENT LINE | |
4146 | CLL CMA RAL | |
4147 | TAD KOUNT /USE THE BUFFER POINTER AS AN INDEX | |
4148 | SMA | |
4149 | CMA | |
4150 | DCA L7 | |
4151 | TAD C40 /NOW PUT OUT SOME SPACES... | |
4152 | JMS I PRINT | |
4153 | ISZ L7 | |
4154 | JMP .-3 | |
4155 | TAD D36 /AND AN '^' | |
4156 | JMS I PRINT | |
4157 | JMS I PRINT | |
4158 | TAD LELIST /NOW TYPE THE ERROR MESSAGE | |
4159 | DCA L10 | |
4160 | UNCH1, TAD I L10 | |
4161 | SZA /END OF TABLE? | |
4162 | TAD LLUNCH | |
4163 | SNA CLA /IS THIS THE MSG WE WANT? | |
4164 | JMP UNCH2 | |
4165 | ISZ L10 /NO | |
4166 | JMP UNCH1 | |
4167 | UNCH2, TAD BASE | |
4168 | CIA | |
4169 | TAD I L10 | |
4170 | JMS I LLIST /FAKE LISTER INTO PRINTING ERROR MESG | |
4171 | JMS I PRINT /FORCE BUFFER | |
4172 | TAD EPNCH /BACK TO PUNCH OUTPUT | |
4173 | DCA PUNCH | |
4174 | ISZ L75 /SET THE NON-PRINT SWITCH | |
4175 | TAD CHK /IF ERROR OCCURED WHILE PROCESSING END STMT. | |
4176 | TAD C4000 /CHK WILL BE 4000-WANT TO ABORT IMMEDIATELY | |
4177 | SZA CLA /WAS IT END STMT? | |
4178 | JMP START /NO-GO PROCESS NEXT STMT. | |
4179 | JMP I (THRU /YES-CLEAN UP AND ABORT | |
4180 | LLIST, LIST | |
4181 | D36, 36 | |
4182 | LELIST, ELIST-1 /ERROR LIST ... | |
4183 | TTYPE, LTTYPE | |
4184 | EPNCH, LPUNCH | |
4185 | CTR, 0 | |
4186 | TEM, 0 | |
4187 | / THIS ROUTINE PRINTS THE CONTENTS OF THE AC IN DECIMAL | |
4188 | PARCT,LDCOUT, 0 | |
4189 | DCA TEM /SAVE THE AC | |
4190 | TAD CM3 /WE WILL PUT OUT FOUR CHARACTERS | |
4191 | DCA CTR | |
4192 | TAD ASE /THIS IS THE ASE OF THE CONVERSION TABLE | |
4193 | DCA NPOINT /SAVE IT IN THE POINTER | |
4194 | DCA FLAG | |
4195 | LOP, DCA MCHAR /ZERO OUT THE CHARACTER | |
4196 | TAD TEM /GET THE NUMBER AGAIN | |
4197 | TAD I NPOINT /TO GET THE ITEM IN THE TABLE | |
4198 | SPA /IS THE RESULT POSITIVE | |
4199 | JMP LOPRST /NO...RESTORE THE NUMBER | |
4200 | DCA TEM /AND SAVE THIS VALUE | |
4201 | TAD D60 | |
4202 | DCA FLAG /SET FLAG TO SHOW THAT WE HAVE SOMETHING | |
4203 | ISZ MCHAR /YES...INCREMENT THE OUTPUT CHARACTER | |
4204 | JMP LOP+1 /TRY THE SEQUENCE AGAIN | |
4205 | LOPRST, CLA | |
4206 | TAD MCHAR | |
4207 | TAD FLAG | |
4208 | SZA /DO WE HAVE A SIGNIFICANT DIGIT? | |
4209 | JMS I PRINT /YES - PRINT IT | |
4210 | ISZ NPOINT | |
4211 | ISZ CTR | |
4212 | JMP LOP /AND GET THE NEXT DIGIT | |
4213 | TAD TEM /GET THE CHARACTER TO OUTPUT | |
4214 | TAD D60 /PUT IT IN TRIMMED ASCII FORM | |
4215 | JMS I PRINT /PRINT IT | |
4216 | JMP I LDCOUT /YES...RETURN TO CALLING PROGRAM | |
4217 | ASE, THOU | |
4218 | FLAG, 0 | |
4219 | ||
4220 | ||
4221 | IOOPEN, TAD KOUNT | |
4222 | DCA IOHTMP /SAVE POINTER TO LEFT PAREN +1 | |
4223 | CLA CMA | |
4224 | DCA PARCT /INITIALIZE PAREN COUNTER | |
4225 | TAD KOUNT | |
4226 | DCA TEM /TEM POINTS TO ENTITY (OR PREV ONE IF A VAR) | |
4227 | IOPENL, JMS I ENTITY /GET SOMETHING | |
4228 | ERR52, JMS I LUNCH /END OF STMT - BAD | |
4229 | JMP IOPENL /VARIABLE - DON'T UPDATE TEM | |
4230 | D60, 60 | |
4231 | JMP IOPENL-2 /CONSTANT - UPDATE TEM | |
4232 | TAD CM51 /PUNCTUATION - TEST FOR RIGHT PAREN | |
4233 | SNA | |
4234 | JMP IORPAR /YES | |
4235 | IAC | |
4236 | SNA /LEFT PAREN? | |
4237 | JMP IOLPAR | |
4238 | TAD CM25 | |
4239 | SNA CLA /IF CHAR IS AN EQUAL SIGL | |
4240 | TAD PARCT | |
4241 | IAC | |
4242 | SZA CLA /AND WE ARE ON THE TOP LEVEL OF PARENTHESES | |
4243 | JMP IOPENL-2 | |
4244 | TAD TEM /THEN WE HAVE AN IMPLIED DO | |
4245 | DCA KOUNT | |
4246 | JMS I DO /GENERATE DO LOOP CODE | |
4247 | JMP ERR52 /NOT TERMINATED WITH RPAR - ERROR | |
4248 | ISZ IMPDO /BUMP IMPLIED DO COUNT | |
4249 | TAD IOHTMP | |
4250 | DCA KOUNT /RESTORE CHAR PTR TO BEGINNING OF LOOP | |
4251 | JMP I .+1 | |
4252 | IOH1+1 /COMPILE INNARDS OF LOOP | |
4253 | ||
4254 | IOLPAR, CLA CMA | |
4255 | TAD PARCT | |
4256 | JMP IOPENL-3 /BUMP PAREN COUNT UP AND LOOP | |
4257 | ||
4258 | IORPAR, ISZ PARCT /BUMP PAREN COUNT DOWN | |
4259 | JMP IOPENL-2 /LOOP IF NOT BALANCED | |
4260 | TAD IOHTMP | |
4261 | DCA KOUNT /BALANCED - NOT AN IMPLIED DO | |
4262 | JMP I .+1 | |
4263 | IOH1BK /COMPILE NORMALLY | |
4264 | CM25, -25 | |
4265 | DO, XDO | |
4266 | \f *7200 | |
4267 | EQUI, JMS I LOOK /CHECK REST OF STATEMENT TYPE | |
4268 | -7 /THERE ARE 7 MORE CHARACTERS | |
4269 | -26 /V | |
4270 | -1 /-A | |
4271 | -14 /-L | |
4272 | -5 /-E | |
4273 | -16 /-N | |
4274 | -3 /-C | |
4275 | -5 /-E | |
4276 | RETA, ISZ SNUM /INCREMENT THE STRING NUMBER | |
4277 | JMS CCCC /GET AND CHECK THE NEXT NON-BLANK CHARACTER | |
4278 | SKP /ONLY LEGAL CHAR HERE IS A "(" | |
4279 | JMP RETB /WE GOT THE "(" | |
4280 | NOP | |
4281 | JMP ERR59 | |
4282 | RETB, JMS I ENTITY /LOOK FOR A VARIABLE | |
4283 | SKP | |
4284 | JMP LA /GOT IT, ANYTHING ELSE IS AN ERROR | |
4285 | NOP | |
4286 | NOP | |
4287 | JMP ERR59 | |
4288 | LA, ISZ L32 /TURN EQUIVALENCE BIT ON | |
4289 | ISZ L32 | |
4290 | TAD K57 /GET MASK FOR SYMBOL TABLE | |
4291 | DCA L21 /PUT IN THE SYMBOL TABLE SWITCH | |
4292 | JMS I SYMTAB /PUT IN SYMBOL TABLE | |
4293 | TAD L77 /GET THE POINTER | |
4294 | ISZ MIKE4 /AND PUT IN EQUIVALENCE TABLE | |
4295 | DCA I MIKE4 | |
4296 | TAD SNUM /GET THE CURRENT STRING NUMBER | |
4297 | ISZ MIKE4 /AND PUT IT IN THE EQUIVALENCE TABLE | |
4298 | DCA I MIKE4 | |
4299 | ISZ MIKE8 /INCREMENT NUMBER OF ENTRIES | |
4300 | JMS CCCC /GET NEXT PUNCTUATION | |
4301 | JMP ERR59 /C/R, THAT'S AN ERROR ... | |
4302 | JMP .+3 /LEFT PAREN, VARIABLE IS SUBSCRIPTED | |
4303 | JMP LB /COMMA, NOT SUBSCRIPTED, STRING CONTINUES | |
4304 | JMP LC /RIGHT PAREN, NOT SUBSCRIPTED, END OF STRING | |
4305 | JMS I ENTITY /LOOK FOR SUBSCRIPT | |
4306 | NOP | |
4307 | SKP | |
4308 | JMP LD /GOT IT, ANYTHING ELSE IS ERROR | |
4309 | NOP | |
4310 | JMP ERR59 | |
4311 | LD, CLA CMA /SUBTRACT ONE FROM | |
4312 | TAD L32 /FIRST SUBSCRIPT | |
4313 | DCA INTA /AND SAVE | |
4314 | JMS CCCC /GET NEXT PUNCTUATION | |
4315 | NOP /CR IS ILLEGAL HERE | |
4316 | JMP RETB-1 /SO IS LEFT PAREN | |
4317 | SKP /COMMA, DOUBLY SUBSCRIPTED | |
4318 | JMP LF /RIGHT PAREN, SINGLY SUBSCRIPTED | |
4319 | JMS I ENTITY /GET OTHER SUBSCRIPT | |
4320 | NOP | |
4321 | SKP | |
4322 | JMP LG /GOT IT | |
4323 | NOP | |
4324 | JMP LD-1 | |
4325 | LG, TAD L32 /SET IT NEGATIVE | |
4326 | CIA | |
4327 | DCA INTB /AND SAVE IT | |
4328 | JMS CCCC /GET NEXT PUNCTUATION | |
4329 | NOP | |
4330 | NOP | |
4331 | ERR59, JMS I LUNCH | |
4332 | TAD L77 /RIGHT PAREN IS ONLY LEGAL CHARACTER | |
4333 | JMS I DIM /GET DIMENSION INFORMATION | |
4334 | DCA CCCC /AND SAVE | |
4335 | SKP /GO TO TEST PART OF LOOP | |
4336 | TAD CCCC /THIS LOOP IS A MAKESHIFT MULTIPLY | |
4337 | ISZ INTB /ARE WE DONE | |
4338 | JMP .-2 /NO | |
4339 | TAD INTA /YES, ADD FIRST SUBSCRIPT | |
4340 | DCA INTA /AND SAVE | |
4341 | LF, TAD L77 /GET POINTER TO VARIABLE | |
4342 | JMS I MODE /WHAT MODE IS IT | |
4343 | TAD INTA /F.P., MULTIPLY BY THREE | |
4344 | RAL CLL /INTEGER | |
4345 | TAD INTA | |
4346 | IAC /ADD ONE TO ANSWER | |
4347 | ISZ MIKE4 /AND PUT IN EQUIVALENCE TABLE | |
4348 | DCA I MIKE4 | |
4349 | JMS CCCC /GET NEXT PUNCTUATION | |
4350 | NOP | |
4351 | JMP RETB-1 /CR AND "(" ARE ILLEGAL HERE | |
4352 | JMP RETB /COMMA MEANS STRING NOT FINISHED | |
4353 | JMP LI /")" MEANS STRING FINISHED | |
4354 | LC, CLA IAC /HERE WE CRAM A ONE INTO EQUIVALENCE | |
4355 | ISZ MIKE4 | |
4356 | DCA I MIKE4 | |
4357 | LI, JMS CCCC /WE FINISHED A STRING, ARE THERE MORE | |
4358 | JMP START /NO | |
4359 | SKP | |
4360 | JMP RETA /YES | |
4361 | JMP RETB-1 /"(" AND ")" ARE ILLEGAL HERE | |
4362 | LB, CLA IAC /CRAM A ONE INTO TABLE | |
4363 | ISZ MIKE4 | |
4364 | DCA I MIKE4 | |
4365 | JMP RETB /AND GO BACK | |
4366 | / | |
4367 | / THIS"ROUTINE GETS AND CHECKS THE NEXT NON-BLANK CHAR | |
4368 | / | |
4369 | CCCC, 0 | |
4370 | JMS I GNB | |
4371 | SNA /PUNCTUATION IS WHAT WE WANT | |
4372 | JMP I CCCC /ITS A CR | |
4373 | TAD CM54 | |
4374 | SNA /IS IT A COMMA | |
4375 | JMP XCOMMA /YES | |
4376 | TAD C3 | |
4377 | SNA /IS IT A ")" | |
4378 | JMP XRPAR /YES | |
4379 | IAC | |
4380 | SNA /IS IT A "(" | |
4381 | JMP XLPAR /YES | |
4382 | JMP RETB-1 /NONE OF THE ABOVE | |
4383 | XRPAR, ISZ CCCC | |
4384 | XCOMMA, ISZ CCCC | |
4385 | XLPAR, ISZ CCCC | |
4386 | JMP I CCCC | |
4387 | K57, 57 | |
4388 | ||
4389 | LFIN, JMS I GNB | |
4390 | SZA CLA | |
4391 | JMP I ASSIGN | |
4392 | JMS I ZZZ /PRINT LABEL ON "FINI" | |
4393 | JMP I .+1 | |
4394 | IOH2 | |
4395 | ||
4396 | /THE FOLLOWING CODE IS TO PROCESS THE EQUIVALENCE TABLE | |
4397 | /AT THE END OF A COMPILATION | |
4398 | \f *7376 | |
4399 | EEK, ISZ MIKE4 | |
4400 | ISZ MIKE4 | |
4401 | DCA I MIKE4 /SET END OF LIST | |
4402 | JMS INIT /INITIALIZE POINTERS | |
4403 | AAB, TAD MA /SET POINTERS TO STRING NUMBERS | |
4404 | TAD C3 | |
4405 | DCA MB | |
4406 | ISZ MA | |
4407 | ISZ MA | |
4408 | AAC, ISZ MB | |
4409 | AA, ISZ MB | |
4410 | TAD I MA /GET FIRST STRING NUMBER | |
4411 | CIA | |
4412 | TAD I MB /SUBTRACT FROM SECOND | |
4413 | SZA CLA /ARE THEY THE SAME | |
4414 | JMP KICK1 /NO, ADVANCE POINTERS | |
4415 | ISZ MA /YES, MOVE TO LINEAR SUBSCRIPT | |
4416 | ISZ MB | |
4417 | TAD I MA /GET FIRST SUBSC | |
4418 | CIA | |
4419 | TAD I MB /SUBTRACT FROM SECOND | |
4420 | SPA CLA SNA /IS FIRST ONE SMALLER | |
4421 | JMP KICK2 /NO, JUST ADVANCE POINTERS | |
4422 | TAD MA /YES, SWITCH PLACES | |
4423 | TAD CM2 | |
4424 | DCA MA | |
4425 | TAD MB | |
4426 | TAD CM2 | |
4427 | DCA MB | |
4428 | TAD CM3 | |
4429 | DCA INIT | |
4430 | RAUCH, TAD I MA | |
4431 | DCA L76 | |
4432 | TAD I MB | |
4433 | DCA I MA | |
4434 | TAD L76 | |
4435 | DCA I MB | |
4436 | ISZ MA | |
4437 | ISZ MB | |
4438 | ISZ INIT | |
4439 | JMP RAUCH | |
4440 | TAD MA | |
4441 | TAD CM2 | |
4442 | DCA MA | |
4443 | JMP AA /NOW THEYRE SWITCHED, CHECK AGAIN | |
4444 | KICK2, CLA CMA /MOVE BACK FIRST POINTER | |
4445 | TAD MA | |
4446 | DCA MA | |
4447 | JMP AAC | |
4448 | KICK1, ISZ MA /MOVE UP FIRST POINTER | |
4449 | ISZ MIKE7 /ARE WE OUT OF ENTRIES | |
4450 | JMP AAB /NO | |
4451 | / | |
4452 | / NOW THE SORTING IS DONE | |
4453 | / | |
4454 | JMS INIT /INITIALIZE POINTERS | |
4455 | DCA TOTAL /ZERO OUT TOTAL | |
4456 | MIKE2, ISZ MA | |
4457 | TAD I MA | |
4458 | JMS I PRSYM /PUT OUT THE SYMBOL | |
4459 | TAD C7240 | |
4460 | JMS I P2 /PUT OUT THE TERMINATOR | |
4461 | IAC | |
4462 | TAD I MA | |
4463 | DCA L14 | |
4464 | TAD I L14 /GET CONTROL BITS FROM SYMBOL TABLE | |
4465 | AND P20 | |
4466 | SNA CLA /IS IT DIMENSIONED | |
4467 | JMP MIKE5 /NO | |
4468 | TAD I MA /YES, COMPUTE THE TOTAL LENGTH | |
4469 | JMS I DIM | |
4470 | DCA L26 | |
4471 | TAD I L14 | |
4472 | CIA | |
4473 | DCA L73 | |
4474 | TAD L26 | |
4475 | ISZ L73 | |
4476 | JMP .-2 | |
4477 | SKP /GOT IT | |
4478 | MIKE5, IAC /IF NOT DIMENSIONED, USE ONE A LENGTH | |
4479 | DCA MB /SAVE LENGTH | |
4480 | TAD I MA | |
4481 | JMS I MODE /WHAT IS THE MODE OF THE SYMBOL | |
4482 | TAD MB /FP, MULTIPLY BY THREE | |
4483 | RAL CLL | |
4484 | TAD MB | |
4485 | DCA INIT /SAVE IT | |
4486 | TAD TOTAL /GET TOTAL REMAINING LENGTH OF STRING | |
4487 | CIA | |
4488 | TAD INIT /SUBTRACT CURRENT LENGTH FROM IT | |
4489 | SPA CLA /WHICH IS BIGGER | |
4490 | JMP .+3 /REMAINING PORTION IS BIGGER | |
4491 | TAD INIT /CURRENT PORTION IS BIGGER, REPLACE REMAINING PORTION | |
4492 | DCA TOTAL | |
4493 | ISZ MA | |
4494 | TAD MA | |
4495 | TAD C3 | |
4496 | DCA MB | |
4497 | TAD I MB /GET NEXT ENTRY STRING NUMBER | |
4498 | CIA | |
4499 | TAD I MA /SUBTRACT CURRENT STRING NUMBER | |
4500 | SZA CLA /ARE THEY EQUAL | |
4501 | JMP MIKE1 /NO | |
4502 | ISZ MA /YES, GET THE DIFFERENCE | |
4503 | ISZ MB | |
4504 | TAD I MB | |
4505 | CIA | |
4506 | TAD I MA | |
4507 | DCA MB /AND SAVE | |
4508 | TAD MB /SUBTRACT DIFFERENCE FROM TOTAL REMAINING | |
4509 | CIA | |
4510 | TAD TOTAL | |
4511 | MIKE6, DCA TOTAL /SAVE | |
4512 | TAD MB /GET THE DIFFERENCE | |
4513 | DCA L26 | |
4514 | JMS I BSS /RESERVE THAT MANY LOCATIONS | |
4515 | ISZ MIKE7 /ARE WE DONE | |
4516 | JMP MIKE2 /NO | |
4517 | JMP I ROGER /YES | |
4518 | MIKE1, TAD TOTAL /SWITCH TOTAL TO THE CURRENT LOCATION | |
4519 | DCA MB | |
4520 | ISZ MA /EQUALIZE POINTERS | |
4521 | JMP MIKE6 | |
4522 | / | |
4523 | INIT, 0 | |
4524 | TAD MIKE8 /GET ENTRY COUNT | |
4525 | CIA /SET NEGATIVE | |
4526 | DCA MIKE7 /SAVE | |
4527 | TAD POINTZ /GET TABLE POINTER | |
4528 | DCA MA /SAVE | |
4529 | JMP I INIT | |
4530 | / | |
4531 | ROGER, PTEMP | |
4532 | P20, 20 | |
4533 | $ | |
4534 | ||
4535 | \f |