Commit | Line | Data |
---|---|---|
81e70d48 PH |
1 | /4 OS/8 FORTRAN (PASS ONE) |
2 | / | |
3 | / VERSION 4A PT 16-MAY-77 | |
4 | / | |
5 | / OS/8 FORTRAN COMPILER - PASS 1 | |
6 | / | |
7 | / BY: HANK MAURER | |
8 | / UPDATED BY: R.LARY + M. HURLEY | |
9 | / | |
10 | / | |
11 | /COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION | |
12 | / | |
13 | / | |
14 | / | |
15 | / | |
16 | / | |
17 | / | |
18 | / | |
19 | / | |
20 | / | |
21 | / | |
22 | /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE | |
23 | /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT | |
24 | /CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY | |
25 | /FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. | |
26 | / | |
27 | /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER | |
28 | /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED | |
29 | /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH | |
30 | /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. | |
31 | / | |
32 | /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE | |
33 | /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY | |
34 | /DIGITAL. | |
35 | / | |
36 | / | |
37 | / | |
38 | VERSON=4 | |
39 | \f/CHANGES FOR MAINTENANCE RELEASE (S.R.): | |
40 | ||
41 | /1. BUMPED VERSION NUMBER TO 304 | |
42 | /2. INCLUDED PATCH SEQ #4 (OCT DSN) FOR SF ERROR FIX | |
43 | /3. INCLUDED PATCH SEQ #6 (TEMP VARS IN ASF) | |
44 | /4. FIXED PROBLEM IN DATA STATEMENT | |
45 | /5. STOPPED HALT AFTER OT ERROR BY CONVERTING LOGICAL | |
46 | / VARS TO INTEGER IN ARITHMETIC IF STATEMENT | |
47 | /6. FIXED BUG RE /A AND .RA EXTENSION | |
48 | ||
49 | /LAST MINUTE CHANGES: | |
50 | ||
51 | /7. ALLOWED PARITY INPUT | |
52 | /8. IGNORE NULLS ON INPUT | |
53 | /9. FIXED BUG RE IGNORING LAST LINE IF IN ERROR | |
54 | / OR IN FACT IGNORING ANY LAST LINE IF NO END STATEMENT | |
55 | /10. ALLOW MULTIPLE INPUT FILES | |
56 | / | |
57 | / | |
58 | /CHANGES FOR OS/8 V3D AND OS/78 BY P.T. | |
59 | / .PATCH LEVEL NOW CONTAINED IN LOCATION 1130 | |
60 | \f *7 | |
61 | LINENO, 1 /2.01/ LINE NUMBER | |
62 | X10, 0 /AUTO INDEX REGISTERS | |
63 | X11, 0 | |
64 | X12, 0 | |
65 | NEXT, FREE-1 /FREE SPACE POINTER | |
66 | STACK, STACKS-1 /STACK POINTER | |
67 | CHRPTR, 0 /INPUT BUFFER POINTER | |
68 | X16, 0 | |
69 | X17, 0 | |
70 | STKLVL, STACKS-1 /STACK BASE LEVEL | |
71 | BUCKET, 0 /FIRST CHAR OF NAME | |
72 | WORD1, 0 /SIX WORD LITERAL BUFFER | |
73 | WORD2, 0 | |
74 | WORD3, 0 | |
75 | WORD4, 0 | |
76 | WORD5, 0 | |
77 | WORD6, 0 | |
78 | ACO, 0 /FLOATING AC OVERFLOW WORD | |
79 | OP1, 0 /SEVEN WORD OPERAND FOR "NUMBER" | |
80 | OP2, 0 | |
81 | OP3, 0 | |
82 | OP4, 0 | |
83 | OP5, 0 | |
84 | OP6, 0 | |
85 | OPO, 0 | |
86 | CHAR, 0 /ICHAR PUTS CHARACTER HERE | |
87 | NOCODE, 0 /IS 1 IF CODE GENERATION OFF | |
88 | NCHARS, 0 /SIZE OF INPUT LINE | |
89 | NUMELM, 0 /NUMBER OF VARS IN TYPED LIST | |
90 | TEMP, 0 | |
91 | TEMP2, 0 | |
92 | DECPT, 0 /SET 1 IF NUMBER CONTAINED . | |
93 | ESWIT, 0 /1 FOR E 0 FOR D | |
94 | NDIGIT, 0 /NUMBER OF DIGITS TO RIGHT OF . | |
95 | HCHAR, HCOUNT /HOLLERITH GETTER ROUTINE | |
96 | SNUM, 0 /POINTER TO ST ENTRY FOR STMT NUMBER | |
97 | IFSWIT, 0 /=1 IF INSIDE LOGICAL IF | |
98 | EXPON, 0 /HOLDS EXPONENT FOR CONVERSION | |
99 | TMPFIL, 0617;2224;2216;2415 /PASS1 OUTPUT FILE | |
100 | 0;0;0;0 /PASS2 OUTPUT FILE | |
101 | DOEND, 0 /SET 1 IF THIS STMT WAS A IF, | |
102 | /GOTO, RETURN, PAUSE, OR STOP | |
103 | THSNUM, 0 /CURRENT STATEMENT NUMBER | |
104 | DIMNUM, 0 /LINEARIZED SS FOR EQ | |
105 | DPRDCT, 0 /HOLDS DIMENSION PRODUCT | |
106 | EQTEMP, 0 /TEMP FOR EQUIVALENCE | |
107 | MQ, 0 /MQ FOR 12 BIT MULTIPLY | |
108 | MASTER, 0 /POINTER TO MASTER IN EQUIV GROUP | |
109 | MNUM, 0 /LINEARIZED SS FOR MASTER | |
110 | NSLAVE, 0 /NUMBER OF SLAVES IN GROUP | |
111 | PASS2O, 0 /START OF PASS 2 OVERLAY SECTION | |
112 | OUFILE, 0 /START OF PASS1 OUTPUT FILE | |
113 | DSERES, 0 /MAGIC NUMBER | |
114 | PROGNM, MAIN /POINTER TO PROG NAME | |
115 | ARGLST, 0 /POINTER TO ARG LIST | |
116 | FUNCTN, 0 /0=MAIN, 1=FUNCTION, -2=SUBROUTINE | |
117 | SETBIT, 0 /TEMPS FOR DECLARATION SCANNER | |
118 | BADBIT, 0 | |
119 | DOINDX, 0 /POINTER TO DO INDEX FOR DO LOOPS | |
120 | TLTEMP, 0 /TEMP FOR TYPE ROUTINE | |
121 | OWTEMP, 0 /TEMP FOR OUTWRD | |
122 | CNT72, -102 /72 COLUMN COUNTER | |
123 | DPUSED, 0 /=1 IF DOUBLE HARDWARE USED | |
124 | VERS, VERSON /VERSION NUMBER | |
125 | M211, -211 | |
126 | P211, 211 | |
127 | P240, 240 | |
128 | IXLNP5, LINE+5 /** | |
129 | IXLINE, LINE | |
130 | IXLINM, LINE-1 | |
131 | STMJMP, 0 /FOR DEFINE FILE | |
132 | \f/ OPCODES AND EQUS | |
133 | MAXHOL=100 /MAXIMUM HOLLERITH LITERAL | |
134 | COMREG=4600 /INTER-PASS COMMUNICATION REGION | |
135 | STACKS=4700 /STACK AREA | |
136 | NAME1=6200 /NAME AND HOLLERITH BUFFER (WAS 6400)** | |
137 | LINE=6300 /LINE BUFFER (WAS 6500)** | |
138 | INBUF=6600 /INPUT BUFFER (FIELD 1) | |
139 | OUBUF=7200 /OUTPUT BUFFER (DITTO) | |
140 | INDEVH=7200 /INPUT DEVICE HANDLER (WAS 7400)** | |
141 | PAUSOP=22 | |
142 | DPUSH=PAUSOP+1 | |
143 | BINRD1=DPUSH+1 /OPCODE DEFINITIONS | |
144 | FMTRD1=BINRD1+1 | |
145 | RCLOSE=FMTRD1+1 | |
146 | DARD1=RCLOSE+1 | |
147 | BINWR1=DARD1+1 | |
148 | FMTWR1=BINWR1+1 | |
149 | WCLOSE=FMTWR1+1 | |
150 | DAWR1=WCLOSE+1 | |
151 | DEFFIL=DAWR1+1 | |
152 | ASFDEF=DEFFIL+1 | |
153 | ARGSOP=ASFDEF+1 | |
154 | EOLCOD=ARGSOP+1 | |
155 | ERRCOD=EOLCOD+1 | |
156 | RETOPR=ERRCOD+1 | |
157 | REWOPR=RETOPR+1 | |
158 | STOROP=REWOPR+1 | |
159 | ENDOPR=STOROP+1 | |
160 | DEFLBL=ENDOPR+1 | |
161 | DOFINI=DEFLBL+1 | |
162 | ARTHIF=DOFINI+1 | |
163 | LIFBGN=ARTHIF+1 | |
164 | DOBEGN=LIFBGN+1 | |
165 | ENDFOP=DOBEGN+1 | |
166 | STOPOP=ENDFOP+1 | |
167 | ASNOPR=STOPOP+1 | |
168 | BAKOPR=ASNOPR+1 | |
169 | FMTOPR=BAKOPR+1 | |
170 | GO2OPR=FMTOPR+1 | |
171 | CGO2OP=GO2OPR+1 | |
172 | AGO2OP=CGO2OP+1 | |
173 | IOLMNT=AGO2OP+1 | |
174 | DATELM=IOLMNT+1 | |
175 | DREPTC=DATELM+1 | |
176 | DATAST=DREPTC+1 | |
177 | ENDELM=DATAST+1 | |
178 | PRGSTK=ENDELM+1 | |
179 | DOSTOR=PRGSTK+1 | |
180 | / ASSEMBLE STATEMENT | |
181 | PAGE | |
182 | RDLOOP, CIF 10 /FOR OS/8 2 PG HANDLERS** | |
183 | JMS I [ICHAR /GET CHAR FROM INPUT FILE | |
184 | JMP ENDLIN /END LINE OR CR | |
185 | TAD M211 /CHECK FOR TAB** | |
186 | SNA | |
187 | TAD (240-211 /CONVERT TO BLANK | |
188 | TAD P211 /** | |
189 | DCA I CHRPTR /SAVE CHAR | |
190 | ISZ CNT72 /PAST COLUMN 72 ? | |
191 | SKP | |
192 | JMP SKPLIN /SKIP 73 TO 80 | |
193 | TAD CHRPTR | |
194 | CIA CLL | |
195 | TAD (LINE+670 | |
196 | SZL CLA /TEST FOR TOO MANY CONTINUATIONS | |
197 | JMP RDLOOP | |
198 | JMS I [ERMSG /LINE TOO LONG | |
199 | 1424 | |
200 | SKPCOM, TAD X16 /RESTORE CHRPTR | |
201 | DCA CHRPTR | |
202 | SKPLIN, CIF 10 /** | |
203 | JMS I [ICHAR /SKIP REST OF LINE | |
204 | JMP ENDLIN | |
205 | CLA | |
206 | JMP SKPLIN | |
207 | ENDLIN, TAD CHRPTR /SAVE CHAR POSITION | |
208 | DCA X16 | |
209 | TAD CHRPTR | |
210 | DCA X10 /SAVE POSITION FOR COMMENT CHECK | |
211 | TAD (-102 /SET COLUMN COUNT | |
212 | DCA CNT72 | |
213 | TAD M6 | |
214 | DCA NCHARS | |
215 | GET6, CIF 10 /** | |
216 | JMS I [ICHAR /GET FIRST 6 CHARS | |
217 | JMP SHORTL /IGNORE SHORT LINES | |
218 | TAD M211 /IS CHAR A TAB ? ** | |
219 | SZA CLA | |
220 | JMP NOTAB /NO | |
221 | TAD P240 /TREAT FIRST TAB AS SIX BLANKS | |
222 | DCA I CHRPTR | |
223 | ISZ NCHARS | |
224 | JMP .-3 | |
225 | TAD P240 /FAKE CONTINUATION CHECK | |
226 | DCA CHAR | |
227 | JMP CCHECK /GO TO COMMENT CHECK | |
228 | SHORTL, TAD X16 /RESET CHAR POINTER | |
229 | DCA CHRPTR /TO IGNORE SHORT LINES | |
230 | JMP ENDLIN | |
231 | NOTAB, TAD CHAR | |
232 | DCA I CHRPTR | |
233 | ISZ NCHARS | |
234 | JMP GET6 /LOOP | |
235 | CCHECK, TAD I X10 /IS IT A COMMENT ? | |
236 | TAD (-303 | |
237 | SNA CLA | |
238 | JMP SKPCOM /COMMENT, SKIP REST | |
239 | NOCMNT, TAD CHAR /WAS SIXTH CHAR A BLANK ? | |
240 | TAD MMM240 | |
241 | SNA CLA | |
242 | JMP GOTLIN /YES, NO MORE CONTINUATIONS | |
243 | CCARD, TAD X16 /IGNORE THESE SIX CHARACTERS | |
244 | DCA CHRPTR | |
245 | JMP RDLOOP /CONTINUE WITH THIS LINE | |
246 | GOTLIN, TAD CHRPTR /COMPUTE -NCHARS-1 | |
247 | CIA | |
248 | TAD (LINE+4 | |
249 | DCA NCHARS | |
250 | TAD [LINE-1 /RESET CHAR POINTER | |
251 | DCA CHRPTR | |
252 | JMS I [CKCTLC /CHECK FOR CONTROL C | |
253 | LINE1, DCA THSNUM /ZERO CURRENT STMT NUMBER | |
254 | CLL CML RAR /SET LABEL DEFINE BIT | |
255 | JMS I [STMNUM /GO LOOK FOR LABEL | |
256 | JMP COMPIL /NONE THERE | |
257 | TAD SNUM /SAVE STATEMENT NUMBER | |
258 | DCA THSNUM | |
259 | TAD (DEFLBL /OUTPUT DEFINITION FOR THIS LABEL | |
260 | JMS I [OUTWRD | |
261 | TAD SNUM | |
262 | JMS I [OUTWRD /FOLLOWED BY THE LABEL ADDRESS | |
263 | COMPIL, JMS I [SAVECP | |
264 | ISZ LINENO /2.01/ PUT LINE NUMBER | |
265 | TAD LINENO /2.01/ INTO MQ | |
266 | 7421 /2.01/ | |
267 | CLA IAC | |
268 | DCA NOCODE /SET NOCODE SWITCH | |
269 | JMS I [ERMSG /SET UP DEFAULT ERROR MESSAGE | |
270 | 1513 | |
271 | JMS I [LEXPR /IS IT ARITHMETIC ? | |
272 | JMP NOTAR /NO | |
273 | JMS I [GETC /LOOK FOR = | |
274 | JMP NOTAR /NOT ARITHMETIC | |
275 | TAD MMM275 /= | |
276 | SNA CLA | |
277 | JMS I [EXPR /SCAN LEFT PART | |
278 | JMP NOTAR | |
279 | JMS I [ERMSG /SET MESSAGE TO ILLEGAL OPERATOR | |
280 | 1720 | |
281 | ISZ NCHARS /SHOULD BE NOTHING LEFT | |
282 | JMP NOTAR /IF THERE IS, ITS NOT ARITHMETIC | |
283 | ITSAR, JMS I [RESTCP /RESTORE TO START OF LINE | |
284 | DCA NOCODE /ALLON CODE | |
285 | JMS I [LEXPR /GET LEFT SIDE | |
286 | M6, -6 /V3C MUST BE HERE | |
287 | JMS I [GETC /SKIP = | |
288 | MMM240, -240 /SHOULD NEVER GET HERE | |
289 | CLA | |
290 | JMS I [EXPR /GET RIGHT SIDE | |
291 | MMM275, -275 /SHOULD NEVER GET HERE | |
292 | TAD (STOROP /OUTPUT STORE | |
293 | JMS I [OUTWRD | |
294 | JMP I [NEXTST /DO NEXT LINE | |
295 | NOTAR, JMS I [RESTCP /RESTART LINE | |
296 | DCA NOCODE | |
297 | JMS I [SAVECP /RESAVE CHAR POSITION | |
298 | TAD (CMDLST-1 | |
299 | DCA X10 | |
300 | JMP I (CMDLUP /GO SEARCH FOR KEYWORD | |
301 | \f/ KEYWORD SEARCH | |
302 | PAGE | |
303 | CMDLUP, CDF 10 /TABLE IN FIELD ONE | |
304 | TAD I X10 /GET NEXT 2 CHARS OF KEYWORD | |
305 | SZA | |
306 | JMP CMDLP2 /NOT DONE YET | |
307 | CLL CMA RAL /REMOVE CHAR POS FROM STACK | |
308 | TAD STACK | |
309 | DCA STACK | |
310 | TAD I X10 /GET ROUTINE ADDRESS | |
311 | CDF | |
312 | DCA STMJMP | |
313 | JMP I STMJMP /JUMP TO THE ROUTINE | |
314 | CMDLP2, DCA TEMP /SAVE THE TWO CHARS | |
315 | CDF | |
316 | JMS I [GET2C /GET TWO CHARS FROM THE INPUT | |
317 | JMP .+4 /NOT ENOUGH CHARS, CAN'T BE THIS ONE | |
318 | TAD TEMP /COMPARE | |
319 | SNA CLA | |
320 | JMP CMDLUP /MATCHES, KEEP GOING | |
321 | JMS I [RESTCP /RESTORE CHAR POS | |
322 | ISZ STACK | |
323 | ISZ STACK /AND SAVE IT AGAIN | |
324 | CDF 10 | |
325 | TAD I X10 /FIND END OF THIS COMMAND | |
326 | SZA CLA | |
327 | JMP .-2 | |
328 | ISZ X10 /SKIP ROUTINE ADDRESS | |
329 | TAD I X10 /IS THE LIST EXHAUSTED ? | |
330 | SZA | |
331 | JMP CMDLP2 /NO, GO AGAIN | |
332 | BADCMD, JMS I [ERMSG /TREAT AS BAD ARITHMETIC STMT | |
333 | ERCODE, 0 | |
334 | \f/ END OF STMT PROC | |
335 | NEXTLN, | |
336 | NEXTST, | |
337 | DOENDR, TAD STKLVL /RESET STACK POINTER | |
338 | DCA STACK | |
339 | JMS I [POP /LOOK FOR DO END | |
340 | CIA | |
341 | TAD THSNUM /DOES THIS LINE END A DO LOOP ? | |
342 | SZA CLA | |
343 | JMP NODOND /NO, REPLACE STACK AND COMPILE STMT | |
344 | TAD (DOFINI | |
345 | JMS I [OUTWRD /OUTPUT DO END COMMAND | |
346 | JMS I [POP /GET INDEX VARIABLE | |
347 | JMS I [OUTWRD | |
348 | TAD STACK /RESET STACK BASE LEVEL | |
349 | DCA STKLVL | |
350 | TAD DOEND /WAS THIS A LEGAL ENDING STMT ? | |
351 | SZA CLA | |
352 | JMS I [ERMSG | |
353 | 0504 /DO END ERROR | |
354 | DCA DOEND /KILL SWITCH | |
355 | JMP DOENDR | |
356 | NODOND, ISZ STACK /REPLACE STACK ENTRY | |
357 | DCA DOEND /KILL SWITCH | |
358 | TAD (EOLCOD /OUTPUT EOL CODE | |
359 | JMS I [OUTWRD | |
360 | DCA ERCODE /RESET ERROR CODE | |
361 | DCA IFSWIT /KILL IF SWITCH | |
362 | TAD (-6 /MOVE FIRST 6 CHARS | |
363 | DCA NCHARS | |
364 | TAD [LINE-1 /INTO START OF BUFFER | |
365 | DCA CHRPTR | |
366 | TAD I X16 | |
367 | DCA I CHRPTR | |
368 | ISZ NCHARS | |
369 | JMP .-3 | |
370 | JMP I (RDLOOP | |
371 | \f/ GOTO'S | |
372 | GOTO, ISZ DOEND /DO END ILLEGAL | |
373 | JMS I [STMNUM /IS IT A SIMPLE GOTO ? | |
374 | JMP CMPGO2 /NO, SEE IF ITS A COMPUTED ONE | |
375 | TAD (GO2OPR /OUTPUT GOTO OPERATOR | |
376 | JMS I [OUTWRD | |
377 | TAD SNUM /FOLLOWED BY STMT NUMBER | |
378 | JMS I [OUTWRD | |
379 | JMP I [NEXTST | |
380 | CMPGO2, JMS I [GETC /LOOK FOR ( | |
381 | JMP BADGO2 /BAD GOTO | |
382 | TAD (-250 | |
383 | SZA CLA | |
384 | JMP ASNGO2 /NOT ( , MAYBE ITS AN ASSIGNED GOTO | |
385 | TAD STACK /SAVE STACK POSITION | |
386 | DCA X12 | |
387 | DCA TEMP /ZERO BRANCH COUNTER | |
388 | GO2LUP, JMS I [STMNUM /GET NEXT STMT NUMBER | |
389 | JMP BADGO2 /MUST BE THERE | |
390 | TAD SNUM | |
391 | JMS I [PUSH /SAVE IT TEMPORARILY | |
392 | ISZ TEMP /BUMP BRANCH COUNT | |
393 | JMS I [COMARP /LOOK FOR COMMA OR RIGHT PAREN | |
394 | JMP BADGO2 /NEITHER | |
395 | JMP GO2LUP /COMMA, GO GET NEXT LABEL | |
396 | JMS I [GETC /SKIP NEXT CHAR (ITS A COMMA) | |
397 | JMP BADGO2 | |
398 | CLA | |
399 | TAD TEMP /SAVE COUNT | |
400 | JMS I [PUSH /ON STACK | |
401 | JMS I [EXPR /COMPILE INDEX EXPR | |
402 | JMP I [NEXTST | |
403 | TAD (CGO2OP /OUTPUT COMPUTED GOTO OPERATOR | |
404 | JMS I [OUTWRD | |
405 | JMS I [POP /GET COUNT | |
406 | CIA | |
407 | DCA TEMP /SAVE COMPLEMENT | |
408 | TAD TEMP | |
409 | CIA | |
410 | JMS I [OUTWRD /OUTPUT COUNT | |
411 | TAD X12 /RESTORE STACK POINTER | |
412 | DCA STACK | |
413 | TAD I X12 /MOVE STMT NUMBERS TO OUTPUT | |
414 | JMS I [OUTWRD | |
415 | ISZ TEMP | |
416 | JMP .-3 | |
417 | JMP I [NEXTST | |
418 | ASNGO2, JMS I [BACK1 /PUT BACK NON ( | |
419 | JMS I [LEXPR /GET ASSIGN VAR | |
420 | JMP BADGO2 | |
421 | TAD (AGO2OP /OUTPUT GOTO OPERATOR | |
422 | JMS I [OUTWRD | |
423 | JMP I [NEXTST | |
424 | BADGO2, JMS I [ERMSG | |
425 | 0724 | |
426 | JMP I [NEXTST | |
427 | \f/ I/O STATEMENTS | |
428 | PAGE | |
429 | RDWR, 0 /SUBR FOR IO STATEMENTS | |
430 | JMS I [CHECKC /LOOK FOR ( | |
431 | M250, -250 | |
432 | JMP BADRD | |
433 | JMS I [EXPR /COMPILE UNIT | |
434 | JMP I [BADCMD | |
435 | JMS I [COMARP | |
436 | JMP DAQUOT /LOOK FOR ' (DIRECT ACCESS I/O) | |
437 | JMP RDFMT /, | |
438 | TAD (BINRD1 /FORMATLESS READ/WRITE | |
439 | IOSTRT, TAD I RDWR /ADD ADJUSTOR | |
440 | JMS I [OUTWRD /OUTPUT BINARY READ | |
441 | IOLIST, JMS I [PUSH /MARK STACK | |
442 | JMS I [GETC /IS IT AN IMPLIED DO ? | |
443 | JMP ENDIOL /NO, END OF LIST | |
444 | TAD M250 | |
445 | SZA CLA | |
446 | JMP TRYIOE /NO, LOOK FOR IO ELEMENT | |
447 | JMS I [SAVECP /SAVE CHAR POS AT START OF IDO | |
448 | DCA IDOPAR /ZERO PAREN COUNTER | |
449 | FINDND, JMS I [GETNAM /GET A NAME IF THERE IS ONE | |
450 | XPURGE, PRGSTK /DON'T WORRY ITS A NOP | |
451 | JMS I [GETC /GET A CHAR | |
452 | JMP ENDIOL | |
453 | TAD M251 /IS IT A ) ? | |
454 | SNA | |
455 | JMP RPIOL /YES | |
456 | IAC /IS IT ( ? | |
457 | SNA | |
458 | JMP LPIOL /YES | |
459 | TAD (250-275 /IS IT = ? | |
460 | SZA CLA | |
461 | JMP FINDND /NONE OF THESE | |
462 | TAD IDOPAR /IS PAREN COUNT 0 ? | |
463 | SZA CLA | |
464 | JMP FINDND /NO, ITS FROM AN INNER LOOP | |
465 | JMS I [LOOKUP /THIS ELEMENT IS THE DO INDEX | |
466 | DCA DOINDX | |
467 | JMS I (DOSTUF /COMPILE THE LOOP | |
468 | JMP BADIOL /ERROR IN DO PARMS | |
469 | JMS I [CHECKC /MUST HAVE ) | |
470 | -251 | |
471 | JMP BADIOL | |
472 | TAD CHRPTR /SAVE CHAR POSITION | |
473 | DCA TEMP | |
474 | TAD NCHARS | |
475 | DCA TEMP2 | |
476 | JMS I [RESTCP /RESTORE TO START OF IMPLIED LOOP | |
477 | TAD TEMP2 /NOW SAVE POS AFTER LOOP | |
478 | JMS I [PUSH | |
479 | TAD TEMP | |
480 | JMS I [PUSH | |
481 | TAD DOINDX /AND DO INDEX | |
482 | JMP IOLIST | |
483 | LPIOL, ISZ IDOPAR /( INCREASES COUNT | |
484 | JMP FINDND | |
485 | RPIOL, CMA /) DECREASES COUNT | |
486 | TAD IDOPAR | |
487 | SMA | |
488 | JMP FINDND-1 | |
489 | CLA | |
490 | BADIOL, | |
491 | BADRD, JMS I [ERMSG /BAD IO STMT | |
492 | 2227 | |
493 | JMP I [NEXTST | |
494 | TRYIOE, JMS I [BACK1 /PUT BACK NON ( | |
495 | JMS I [LEXPR /GET IOLIST ELEMENT | |
496 | JMP BADRD /NOT THERE, ERROR | |
497 | JMS I [GETC /LOOK FOR A COMMA | |
498 | JMP .+4 /EOL | |
499 | TAD (-254 | |
500 | SZA | |
501 | JMP NOTIOL /NOT AN ELEMENT | |
502 | TAD (IOLMNT /OUTPUT OPCODE | |
503 | JMS I [OUTWRD | |
504 | JMP IOLIST+1 | |
505 | NOTIOL, TAD (254-275 /IS IT AN = (END OF IDO) | |
506 | SZA CLA | |
507 | JMP BADIOL /NO, BAD | |
508 | JMS I [POP /GET STUFF FROM THE STACK | |
509 | SNA | |
510 | JMP BADIOL /ZERO IS BAD | |
511 | DCA DOINDX /THIS IS THE INDEX | |
512 | JMS I [RESTCP /GET THE CHAR POSITION | |
513 | TAD XPURGE /OUTPUT PURGE OPERATOR | |
514 | JMS I [OUTWRD /BECAUSE AN EXTRA IS ON THE STK | |
515 | TAD (DOFINI /END LOOP | |
516 | JMS I [OUTWRD | |
517 | TAD DOINDX | |
518 | JMS I [OUTWRD | |
519 | JMS I [GETC /END OF LIST ? | |
520 | JMP ENDIOL | |
521 | TAD (-254 | |
522 | SZA CLA | |
523 | JMP BADIOL /MUST BE A COMMA | |
524 | JMP IOLIST+1 | |
525 | IDOPAR, 0 | |
526 | ENDIOL, JMS I [POP /IS THE MARK THERE ? | |
527 | SZA CLA | |
528 | JMP BADRD /NO, ERROR | |
529 | TAD I RDWR | |
530 | TAD (RCLOSE /END OF IO OPERATION | |
531 | JMS I [OUTWRD | |
532 | JMP I [NEXTST | |
533 | RDFMT, JMS I [STMNUM /LOOK FOR FMT LINE NUMBER | |
534 | JMP RTFMT | |
535 | JMS I [OUTWRD /OUTPUT PUSH COMMAND | |
536 | TAD SNUM /OUTPUT STMT NUMBER OF FORMAT | |
537 | JMS I [OUTWRD | |
538 | RDLIST, TAD (FMTRD1 /START OF FORMATTED READ | |
539 | TAD I RDWR /ADD ADJUSTOR | |
540 | JMS I [OUTWRD | |
541 | JMS I [CHECKC /LOOK FOR ) | |
542 | M251, -251 | |
543 | JMP BADRD | |
544 | JMP IOLIST /GO GET IO LIST | |
545 | RTFMT, JMS I [LEXPR /GET R.T. FORMAT | |
546 | JMP BADRD | |
547 | JMP RDLIST /GET LIST | |
548 | \f/DIRECT ACCESS I/O | |
549 | PAGE | |
550 | DAQUOT, JMS I [BACK1 | |
551 | JMS I [CHECKC /LOOK FOR ' | |
552 | -247 | |
553 | JMP BADRD /SYNTAX IS NO GOOD | |
554 | JMS I [EXPR /GET RECORD NUMBER EXPR | |
555 | JMP BADRD | |
556 | JMS I [CHECKC /LOOK FOR ) | |
557 | -251 | |
558 | JMP BADRD | |
559 | TAD (DARD1 /DIRECT ACCESS OPEN | |
560 | JMP IOSTRT | |
561 | FIND, JMP I [NEXTST /COOL ISN'T IT ? | |
562 | DFINFL, JMS I [EXPR /COMPILE UNIT | |
563 | JMP BADDEF /BAD DEFINE STMT | |
564 | DCA STMJMP /PERMIT VARIABLE FOR LOG UNIT | |
565 | JMS I [CHECKC /( | |
566 | -250 | |
567 | JMP BADDEF | |
568 | JMS I [EXPR /NUMBER OF RECORDS | |
569 | JMP BADDEF | |
570 | JMS I [CHECKC /, | |
571 | -254 | |
572 | JMP BADDEF | |
573 | JMS I [EXPR /RECORD SIZE | |
574 | JMP BADDEF | |
575 | JMS I [CHECKC /, | |
576 | -254 | |
577 | JMP BADDEF | |
578 | JMS I [CHECKC /U | |
579 | -325 | |
580 | JMP BADDEF | |
581 | JMS I [CHECKC /, | |
582 | MCOMA, -254 | |
583 | JMP BADDEF | |
584 | JMS I [GETNAM /GET INDEX VARIABLE | |
585 | JMP BADDEF | |
586 | JMS I [OUTWRD | |
587 | JMS I [LOOKUP | |
588 | JMS I [OUTWRD /OUTPUT INDEX VAR | |
589 | TAD (DEFFIL /OUTPUT DEFINE OPERATOR | |
590 | JMS I [OUTWRD | |
591 | JMS I [CHECKC /) | |
592 | -251 | |
593 | JMP BADDEF | |
594 | JMS I [GETC /ANOTHER DEFINE ? | |
595 | JMP I [NEXTST | |
596 | TAD MCOMA /, ? | |
597 | SNA CLA | |
598 | JMP DFINFL /YES, ANOTHER FILE | |
599 | BADDEF, JMS I [ERMSG /BAD DEFINE FILE STMT | |
600 | 0406 | |
601 | JMP I [NEXTST | |
602 | RESTCP, 0 /RESTORE CHAR POSITION FROM STACK | |
603 | JMS I [POP | |
604 | DCA CHRPTR | |
605 | JMS I [POP | |
606 | DCA NCHARS | |
607 | JMP I RESTCP | |
608 | INTEGE, JMS I [CHECKC /INTEGER STMT | |
609 | -322 | |
610 | JMP I [BADCMD | |
611 | JMS I [TYPLST | |
612 | 0101 | |
613 | 0100 | |
614 | NOP | |
615 | JMP I [NEXTST | |
616 | PAUZE, JMS I [CHECKC /LOOK FOR E | |
617 | -305 | |
618 | JMP I [BADCMD | |
619 | JMS I [GETC /ANY EXPR ? | |
620 | JMP NOARGP /MAKE IT PAUSE 1 | |
621 | JMS I [BACK1 /PUT IT BACK | |
622 | JMS I [EXPR /GET PAUSE NUMBER | |
623 | XPAUZ, PAUSOP | |
624 | OPAUZ, TAD XPAUZ /OUTPUT PAUSE OPERATOR | |
625 | JMS I [OUTWRD | |
626 | JMP I [NEXTST | |
627 | NOARGP, JMS I [OUTWRD /PUSH 1.0 | |
628 | TAD [ONE | |
629 | JMS I [OUTWRD | |
630 | JMP OPAUZ /GO PUT OPERATOR | |
631 | READ, JMS I (RDWR /COMPILE READ STMT | |
632 | 0 | |
633 | WRITE, JMS I [CHECKC /LOOK FOR E | |
634 | -305 | |
635 | JMP I [BADCMD | |
636 | JMS I (RDWR /COMPILE WRITE | |
637 | BINWR1-BINRD1 | |
638 | CKCTLC, 6401 /CHECK FOR CONTROL C | |
639 | TAD (7600 | |
640 | KRS | |
641 | TAD (-7603 /^C | |
642 | SNA CLA | |
643 | KSF | |
644 | JMP I CKCTLC | |
645 | JMP I (7600 | |
646 | ||
647 | XOCTAL, DCA WORD1 /** | |
648 | DCA WORD2 | |
649 | DCA WORD3 /STATEMENT NUM LEFT THERE** | |
650 | DCA WORD5 | |
651 | DCA WORD6 | |
652 | XCTAL1, DCA WORD4 | |
653 | JMS I [DIGIT /GET NEXT DIGIT | |
654 | JMP ENDOXT /NO DIGITS LEFT | |
655 | AND [7 /THROW AWAY SOME BITS | |
656 | DCA TEMP | |
657 | JMS I (AL1 /MOVE WORD LEFT THREE | |
658 | JMS I (AL1 | |
659 | JMS I (AL1 | |
660 | TAD WORD4 /ADD DIGIT TO WORD4 | |
661 | TAD TEMP | |
662 | JMP XCTAL1 /LOOP | |
663 | ENDOXT, TAD WORD2 /PUT WORDS INTO THE LEFT PLACE | |
664 | DCA WORD1 | |
665 | TAD WORD3 | |
666 | DCA WORD2 | |
667 | TAD WORD4 | |
668 | DCA WORD3 | |
669 | JMP DATAFP /GO STUFF IT AWAY | |
670 | \f/ DIMENSION, COMMON, REAL | |
671 | PAGE | |
672 | DIMENS, JMS I [IFCHEK | |
673 | JMS I [CHECKC /CHECK FOR "N" | |
674 | -316 | |
675 | JMP I [BADCMD /NO GOOD | |
676 | JMS I [TYPLST /PROCESS LIST | |
677 | 0000 /DIMENSION IS THE SIMPLEST CASE | |
678 | 0000 | |
679 | NOP /ERROR RETURN | |
680 | JMP I [NEXTST | |
681 | REAL, JMS I [IFCHEK /CHECK FOR INSIDE IF | |
682 | JMS I [TYPLST /PROCESS LIST | |
683 | 0102 /TYPE-REAL | |
684 | 0100 | |
685 | NOP | |
686 | JMP I [NEXTST | |
687 | COMPLE, JMS I [CHECKC /CHECK FOR "X" | |
688 | -330 | |
689 | JMP I [BADCMD | |
690 | JMS I [IFCHEK | |
691 | JMS I [TYPLST /PROCESS COMPLEX LIST | |
692 | 0103 | |
693 | 0100 | |
694 | NOP | |
695 | CLA IAC /SET DP SWITCH | |
696 | DCA DPUSED | |
697 | JMP I [NEXTST | |
698 | COMMON, JMS I [IFCHEK /BAD INSIDE LOGICAL IF | |
699 | JMS I [GETC /CHECK FOR SLASH | |
700 | JMP I [BADCMD | |
701 | TAD M257 | |
702 | SZA CLA | |
703 | JMP BLANKC /MUST BE BLANK COMMON | |
704 | JMS I [GETNAM /GET NAME OF COMMON | |
705 | JMP DBLSLS /MIGHT BE // | |
706 | JMS I [CHECKC /LOOK FOR / | |
707 | M257, -257 | |
708 | JMP BADCOM | |
709 | JMS I [LOOKUP /LOOKUP COMMON NAME | |
710 | IAC | |
711 | DCA COMNAM /SAVE ADDR OF TYPE WORD | |
712 | CDF 10 | |
713 | TAD I COMNAM /LOOK AT TYPE | |
714 | SZA | |
715 | TAD (-111 /MUST BE COMMON OR UNDEF. | |
716 | SZA CLA | |
717 | JMP BADCOM | |
718 | TAD (111 /SET CORRECT BITS | |
719 | DCA I COMNAM | |
720 | CDF | |
721 | DOCOMN, JMS I [TYPLST /HANDLE LIST | |
722 | 4000 | |
723 | 5460 | |
724 | JMP I [NEXTST | |
725 | TAD X12 | |
726 | DCA STACK /RESET STACK | |
727 | CDF 10 | |
728 | ISZ COMNAM /POINTER TO COMMON INFO | |
729 | DCA I NEXT /ZERO NEXT PTR WORD | |
730 | TAD I COMNAM /LOOK FOR END OF LIST | |
731 | SNA | |
732 | JMP EOCL /THIS IS IT | |
733 | DCA COMNAM /PROCEED DOWN LIST | |
734 | JMP .-4 | |
735 | EOCL, TAD NEXT /HOOK IN NEXT PART | |
736 | DCA I COMNAM | |
737 | TAD NUMELM | |
738 | DCA I NEXT /NUMBER IN THIS PART | |
739 | TAD NUMELM | |
740 | CIA | |
741 | DCA NUMELM | |
742 | CDF | |
743 | TAD I X12 /MOVE VARIABLE PTRS | |
744 | CDF 10 | |
745 | DCA I NEXT | |
746 | ISZ NUMELM | |
747 | JMP .-5 | |
748 | CDF | |
749 | JMS I [GETC /ANOTHER BLOCK ? | |
750 | JMP I [NEXTST /NO | |
751 | JMP COMMON+3 /MAYBE | |
752 | DBLSLS, JMS I [CHECKC /LOOK FOR SECOND SLASH | |
753 | -257 | |
754 | JMP BADCOM | |
755 | SKP | |
756 | BLANKC, JMS I [BACK1 /PUT BACK NON SLASH | |
757 | TAD (BLNKCN /USE BLANK COMMON | |
758 | DCA COMNAM | |
759 | JMP DOCOMN | |
760 | BADCOM, JMS I [ERMSG /ERROR IN COMMON STMT | |
761 | 0317 | |
762 | JMP I [NEXTST | |
763 | COMNAM, 0 | |
764 | \f/ EXTERNAL, FORMAT, BACKSPACE | |
765 | EXTERN, JMS I [TYPLST /PROCESS LIST | |
766 | 1000 | |
767 | 6660 | |
768 | NOP | |
769 | JMP I [NEXTST | |
770 | FORMAT, TAD (FMTOPR /OUTPUT FORMAT OPERATOR | |
771 | JMS I [OUTWRD | |
772 | TAD NCHARS /GET NUMBER OF WORDS | |
773 | CIA | |
774 | CLL RAR /NWORDS=(NCHARS+1)/2 | |
775 | FMTLUP, JMS I [OUTWRD /OUTPUT IT | |
776 | JMS I [GETCWB /GET THE CHARS | |
777 | JMP I [NEXTST /NO MORE | |
778 | AND [77 | |
779 | CLL RTL /SHIFT LEFT 6 | |
780 | RTL | |
781 | RTL | |
782 | DCA TEMP | |
783 | JMS I [GETCWB /GET OTHER HALF | |
784 | NOP /IGNORE END OF LINE | |
785 | AND [77 | |
786 | TAD TEMP /PUT THEM TOGETHER | |
787 | JMP FMTLUP /LOOP | |
788 | /NOTE : THE ENTIRE FORMAT INCLUDING PARENTHESIS () | |
789 | / IS PASSED TO THE CODE | |
790 | BACKSP, JMS I [CHECKC /CHECK FOR "E" | |
791 | -305 | |
792 | JMP I [BADCMD | |
793 | JMS I [EXPR /COMPILE UNIT EXPR | |
794 | JMP I [BADCMD | |
795 | TAD (BAKOPR /OUTPUT BACKSPACE OPERATOR | |
796 | JMS I [OUTWRD | |
797 | JMP I [NEXTST | |
798 | \f/ OUTPUT ROUTINE | |
799 | PAGE | |
800 | OUPTR, OUBUF | |
801 | OCOUNT, -401 | |
802 | OUTWRD, 0 /OUTPUT ROUTINE | |
803 | DCA OWTEMP /SAVE WORD | |
804 | TAD NOCODE | |
805 | SZA CLA | |
806 | JMP I OUTWRD /COOL IT IF NOCODE | |
807 | ISZ OCOUNT /TEST FOR BUFFER FULL | |
808 | JMP NOWRIT /STILL SOME ROOM | |
809 | JMS OUDUMP /DUMP THE BUFFER | |
810 | TAD OUBLOK-1 /RESET BUFFER PARAMETERS | |
811 | DCA OUPTR | |
812 | TAD (-400 | |
813 | DCA OCOUNT | |
814 | NOWRIT, TAD OWTEMP /PUT WORD | |
815 | CDF 10 | |
816 | DCA I OUPTR /INTO BUFFER | |
817 | CDF | |
818 | ISZ OUPTR /MOVE POINTER | |
819 | JMP I OUTWRD | |
820 | OULEN, 0 /NUMBER OF BLOCKS LEFT IN HOLE | |
821 | OUDUMP, 0 /DUMP OUT BUFFER | |
822 | TAD OULEN /ANY ROOM LEFT ? | |
823 | SNA | |
824 | JMP OUERR | |
825 | IAC | |
826 | DCA OULEN | |
827 | JMS I (7607 /CALL SYSTEM HANDLER | |
828 | 4210 | |
829 | OUBUF | |
830 | OUBLOK, 0 | |
831 | JMP OUERR | |
832 | ISZ OUBLOK /INCREMENT BLOCK NUMBER | |
833 | ISZ FILSIZ /ALSO SIZE OF FILE | |
834 | JMP I OUDUMP | |
835 | OUERR, JMS I [MESSAG /ERROR IN WRITING OR OPENING FILE | |
836 | 317 | |
837 | 306 | |
838 | \f/ END PASS ONE | |
839 | XEND, JMS I [CHECKC /LOOK FOR "D" | |
840 | -304 | |
841 | JMP I [BADCMD | |
842 | JMS I [GETC /END MUST BE ALL | |
843 | JMP ENDX | |
844 | L7700, SMA CLA /NEVER SKIPS | |
845 | JMP I [BADCMD | |
846 | ENDX, CDF 0 | |
847 | TAD (ENDOPR /OUTPUT END OF FILE | |
848 | JMS I [OUTWRD | |
849 | JMS OUDUMP /DUMP BUFFER | |
850 | CIF 10 | |
851 | JMS I L7700 /LOCK MONITOR IN | |
852 | 10 | |
853 | CIF 10 | |
854 | CLA IAC | |
855 | JMS I L200 /CLOSE TEMP FILE | |
856 | 4 | |
857 | TMPFIL | |
858 | FILSIZ, 0 | |
859 | JMP OUERR | |
860 | CIF 10 | |
861 | CLA IAC | |
862 | JMS I L200 /OPEN PASS 2 OUTPUT FILE | |
863 | L3, 3 | |
864 | OBLK, TMPFIL+4 /STARTING BLOCK | |
865 | 0 /SIZE | |
866 | JMP OUERR /ERROR | |
867 | TAD (COMREG-1 /SAVE IMPORTANT STUFF | |
868 | DCA X10 | |
869 | TAD NEXT /ADDR OF FREE SPACE | |
870 | DCA I X10 | |
871 | TAD STKLVL /STACK LEVEL | |
872 | DCA I X10 | |
873 | TAD OUFILE /START OF PASS1 OUTPUT FILE | |
874 | DCA I X10 | |
875 | TAD FILSIZ /ALSO THE SIZE | |
876 | DCA I X10 | |
877 | TAD PASS2O /START OF PASS2 OVERLAY | |
878 | DCA I X10 | |
879 | TAD OBLK /START OF PASS2 OUTPUT FILE | |
880 | DCA I X10 | |
881 | TAD OBLK+1 /AND MAX SIZE | |
882 | DCA I X10 | |
883 | TAD PROGNM /POINTER TO PROG NAME | |
884 | DCA I X10 | |
885 | TAD ARGLST /AND ARG LIST | |
886 | DCA I X10 | |
887 | TAD FUNCTN /AND PROG SWITCH | |
888 | DCA I X10 | |
889 | TAD DPUSED /STORE THE DP SWITCH | |
890 | DCA I X10 | |
891 | TAD VERS /AND THE VERSION NUMBER | |
892 | DCA I X10 | |
893 | CIF 10 | |
894 | JMS I L200 /CHAIN TO PASS TWO | |
895 | 6 | |
896 | PASS2B, 0 /FILLED BY ONCE ONLY CODE FOR PASS 1 | |
897 | RETURN, TAD (RETOPR /OUTPUT RETURN CODE | |
898 | JMS I [OUTWRD | |
899 | ISZ DOEND /DO END ILLEGAL HERE | |
900 | JMP I [NEXTST | |
901 | COMARP, 0 /LOOK FOR COMMA OR RIGHT PAREN | |
902 | JMS I [GETC | |
903 | JMP I COMARP | |
904 | TAD [-254 /COMMA ? | |
905 | SNA | |
906 | JMP .+5 | |
907 | TAD L3 /RIGHT PAREN ? | |
908 | SZA CLA | |
909 | JMP I COMARP | |
910 | ISZ COMARP | |
911 | ISZ COMARP /COMMA INCR ONCE | |
912 | JMP I COMARP | |
913 | LOGICA, JMS I [CHECKC /LOOK FOR L | |
914 | -314 | |
915 | JMP I [BADCMD /NO GOOD | |
916 | JMS I [TYPLST /PROCESS LIST | |
917 | 0105 | |
918 | 0100 | |
919 | L200, 0200 /NOP | |
920 | JMP I [NEXTST | |
921 | \f/ EQUIVALENCE (UGH!) | |
922 | PAGE | |
923 | EQUIV, JMS I [IFCHEK /BAD WITH IF | |
924 | JMS I [CHECKC /LOOK FOR "E" | |
925 | -305 | |
926 | JMP I [BADCMD | |
927 | EQVLUP, JMS I [CHECKC /LOOK FOR ( | |
928 | -250 | |
929 | JMP BADEQU | |
930 | TAD STACK /SAVE STACK POS | |
931 | DCA X17 | |
932 | DCA NSLAVE /NUMBER OF SLAVES = 0 | |
933 | JMS I [GETSS /GET THE MASTER | |
934 | JMP BADEQU | |
935 | SVMSTR, CDF 10 /1.03/ CHECK FOR ALREADY EQUIVALENCED | |
936 | TAD I TEMP2 /1.03/ | |
937 | CDF /1.03/ | |
938 | AND (200 /1.03/ (AS A SLAVE) | |
939 | SZA CLA /1.03/ | |
940 | JMP DOFUNY /3.01/BACK UP TO ITS MASTER | |
941 | TAD TEMP2 /SAVE THE MASTER TYPE ADDRESS | |
942 | DCA MASTER | |
943 | DCA SFUDGE /3.01/CLEAR OFFSET FUDGE | |
944 | TAD DIMNUM /SAVE THE MASTER SUBSCRIPT | |
945 | DCA MNUM | |
946 | GETSLV, JMS I [COMARP /LOOK FOR , OR ) | |
947 | JMP BADEQU | |
948 | JMP DOSLAV /, | |
949 | TAD NSLAVE /COMPLEMENT THE NUMBER OF SLAVES | |
950 | SNA | |
951 | JMP ENDGRP /NO SLAVES | |
952 | CIA | |
953 | DCA NSLAVE | |
954 | TAD X17 /RESTACK THE STORE | |
955 | DCA STACK | |
956 | EQLOOP, TAD I X17 /GET NEXT SUBSCRIPT NUMBER | |
957 | DCA TEMP | |
958 | TAD I X17 /AND NEXT TYPE WORD ADDRESS | |
959 | DCA TEMP2 | |
960 | CDF 10 | |
961 | TAD I TEMP2 /LOOK AT TYPE WORD | |
962 | TAD (200 /SET EQUIVALENCE BIT | |
963 | DCA I TEMP2 | |
964 | ISZ TEMP2 /MOVE TO EQUIVALENCE/DIMENSION PTR | |
965 | TAD I TEMP2 /PROPAGATE DIMENSION POINTER | |
966 | DCA I NEXT /TO EQUIVALENCE INFO BLOCK | |
967 | TAD NEXT /NOW STORE EQ INFO BLK ADDRESS | |
968 | DCA I TEMP2 /INTO EQ-DIM POINTER WORD | |
969 | CLA CMA | |
970 | TAD MASTER /STORE S.T. ADDR OF MASTER | |
971 | DCA I NEXT /INTO THE EQUIVALENCE BLOCK | |
972 | TAD MNUM /OUTPUT NUMBERS | |
973 | DCA I NEXT | |
974 | TAD TEMP | |
975 | DCA I NEXT | |
976 | CDF | |
977 | ISZ NSLAVE /ANY MORE SLAVES ? | |
978 | JMP EQLOOP /YES, EQUIVALENCE NOT YET ATTAINED | |
979 | ENDGRP, JMS I [GETC /FINI, ALL VARIABLES ARE CREATED | |
980 | JMP I [NEXTST /EQUIVALENCED | |
981 | TAD (-254 /IS NEXT CHAR A COMMA ? | |
982 | SNA CLA | |
983 | JMP EQVLUP /IF YES, DO NEXT GROUP | |
984 | BADEQU, JMS I [ERMSG /SYNTAX ERROR IN EQUIVALENCE | |
985 | 2123 | |
986 | JMP I [NEXTST | |
987 | EQUCOM, JMS I [ERMSG /MULTIPLE LEVELS OF EQUIVALENCE OR | |
988 | 2114 /MORE THAN ONE COMMON VARIABLE | |
989 | JMP I [NEXTST | |
990 | DOSLAV, ISZ NSLAVE /ANOTHER SLAVE VARIABLE | |
991 | JMS I [GETSS /GET THE GOODS | |
992 | JMP BADEQU | |
993 | CDF 10 | |
994 | TAD I TEMP2 /LOOK AT THE TYPE | |
995 | SMA CLA | |
996 | JMP SVSLAV /IT ISN'T IN COMMON | |
997 | TAD I MASTER /LOOK AT THE MASTERS TYPE | |
998 | SPA CLA | |
999 | JMP EQUCOM /MASTER IS IN COMMON TOO .. BAD | |
1000 | CDF | |
1001 | TAD MNUM /SAVE THE MAGIC NUMBER | |
1002 | JMS I [PUSH | |
1003 | TAD MASTER | |
1004 | JMS I [PUSH /AND THE S.T. ADDRESS | |
1005 | JMP SVMSTR /NOW GO MAKE THE NEW ONE MASTER | |
1006 | SVSLAV, TAD I TEMP2 /1.03/ PREVIOUSLY EQUIVALENCED ? | |
1007 | AND (200 /1.03/ | |
1008 | SZA CLA /1.03/ | |
1009 | JMP EQUCOM /1.03/ YES, ERROR | |
1010 | TAD DIMNUM /SAVE THE NEW SLAVE | |
1011 | TAD SFUDGE /3.01/ADD OFFSET FUDGE | |
1012 | CDF | |
1013 | JMS I [PUSH | |
1014 | TAD TEMP2 | |
1015 | JMS I [PUSH | |
1016 | JMP GETSLV /AND GO GET THE NEXT SLAVE | |
1017 | ||
1018 | SFUDGE, 0 | |
1019 | \f/ROUTINE TO HANDLE TRIVIAL CASES OF EQUIVALENCE CHAINING | |
1020 | /THIS WHOLE PAGE IS 3.01 | |
1021 | ||
1022 | DOFUNY, CLA IAC | |
1023 | TAD TEMP2 | |
1024 | DCA MASTER /GET POINTER TO EQUIVALENCE BLOCK | |
1025 | CDF 10 | |
1026 | TAD I MASTER | |
1027 | DCA X12 | |
1028 | CLA IAC | |
1029 | TAD I X12 /GET ADDRESS OF "REAL" MASTER'S | |
1030 | DCA MASTER /TYPE WORD | |
1031 | TAD I X12 | |
1032 | TAD DIMNUM | |
1033 | DCA MNUM /OFFSETS ARE ADDITIVE | |
1034 | TAD I X12 | |
1035 | DCA SFUDGE /SAVE OTHER HALF OF OFFSET TO ADD | |
1036 | CDF /TO SLAVES | |
1037 | JMP GETSLV / (PRAY) | |
1038 | PAGE | |
1039 | \f/ EQUIVALENCE (UGH!) | |
1040 | O1420, 1420 /1.03/ MUST BE FIRST ON PAGE | |
1041 | GETSS, 0 /GET THE LINEARIZED SUBSCRIPT | |
1042 | DCA DIMNUM | |
1043 | JMS I [GETNAM /GET THE VARIABLE | |
1044 | JMP I GETSS | |
1045 | JMS I [LOOKUP | |
1046 | IAC /ADDRESS OF TYPE WORD | |
1047 | DCA TEMP2 | |
1048 | CDF 10 | |
1049 | TAD I TEMP2 | |
1050 | CDF | |
1051 | O200, AND O1420 /1.03/ EXT, STMTFUN, SUBARG ? | |
1052 | SZA CLA | |
1053 | JMP I GETSS | |
1054 | TAD STACK | |
1055 | DCA X12 /SAVE STACK POSITION | |
1056 | DCA TEMP /ZERO NUMBER OF DIMENSIONS | |
1057 | TAD TEMP2 | |
1058 | IAC | |
1059 | DCA EQTEMP /ADDRESS OF EQ-DIM POINTER | |
1060 | JMS I [GETC | |
1061 | JMP I GETSS | |
1062 | TAD (-250 /LOOK FOR ( | |
1063 | SNA CLA | |
1064 | JMP DIMGET-1 /OK | |
1065 | JMS I [BACK1 | |
1066 | JMP RGETSS | |
1067 | DCA DIMNUM /DATA CALLS GETSS WITH AC = 7777 | |
1068 | DIMGET, JMS I (SMLNUM /GET A SUBSCRIPT | |
1069 | CLA CMA | |
1070 | TAD EXPON /SS-1 | |
1071 | JMS I [PUSH /SAVE SS | |
1072 | ISZ TEMP /BUMP COUNT OF SS | |
1073 | JMS I [COMARP /LOOK FOR , OR ) | |
1074 | JMP I GETSS | |
1075 | JMP DIMGET /, | |
1076 | CLA IAC /) | |
1077 | DCA DPRDCT /SET DIMENSION PRODUCT TO 1 | |
1078 | TAD X12 /RESTORE STACK POSITION | |
1079 | DCA STACK | |
1080 | TAD TEMP /COMPLEMENT NUMBER OF SS | |
1081 | CIA | |
1082 | DCA TEMP | |
1083 | CDF 10 | |
1084 | CLL CML RTR /2000 | |
1085 | AND I TEMP2 /HAS VARIABLE BEEN DIMENSIONED ? | |
1086 | SNA CLA | |
1087 | JMP I GETSS /NO, THATS BAD | |
1088 | TAD I EQTEMP /GET ADDRESS OF DIMENSION BLOCK | |
1089 | DCA EQTEMP | |
1090 | TAD I EQTEMP /IS NUMBER OF DIMENSIONS | |
1091 | TAD TEMP /EQUAL TO NUMBER OF SUBSCRIPTS ? | |
1092 | SZA CLA | |
1093 | JMP TRY1SS /1.03/ SEE IF ITS ONE SUBSCRIPT | |
1094 | CLA CLL IAC /+1 V3C | |
1095 | TAD I EQTEMP /+ NUMBER OF DIMENSIONS | |
1096 | TAD EQTEMP /+ ADDRESS OF COUNT WORD | |
1097 | DCA EQTEMP /GIVES ADDRESS OF NEXT TO LAST DIMENSION | |
1098 | LINEAR, CDF | |
1099 | TAD I X12 /GET NEXT SS - 1 | |
1100 | DCA MQ | |
1101 | TAD DPRDCT /MULTIPLY BY THE DIMENSION PRODUCT | |
1102 | JMS MUL12 /WHERE D.P. = 1,D1,D1D2,D1D2D3,... | |
1103 | TAD DIMNUM /ACCUMULATE THE SUM | |
1104 | DCA DIMNUM | |
1105 | CDF 10 | |
1106 | TAD I EQTEMP /ADDR OF LITERAL | |
1107 | IAC | |
1108 | DCA X11 /WORKING POINTER TO VALUE | |
1109 | TAD I X11 /GET DIMENSION INTO FAC | |
1110 | DCA WORD1 | |
1111 | TAD I X11 | |
1112 | DCA WORD2 | |
1113 | TAD I X11 | |
1114 | DCA WORD3 | |
1115 | CDF | |
1116 | JMS I [FIXNUM /GO FIX IT | |
1117 | DCA MQ | |
1118 | TAD DPRDCT /OF THE D.P. SERIES (ABOVE) | |
1119 | JMS MUL12 | |
1120 | DCA DPRDCT | |
1121 | CLA IAC /V3C BUMP POSITION POINTER | |
1122 | TAD EQTEMP | |
1123 | DCA EQTEMP | |
1124 | ISZ TEMP /ANY MORE SS ? | |
1125 | JMP LINEAR /YES | |
1126 | RGETSS, ISZ GETSS | |
1127 | JMP I GETSS | |
1128 | TRY1SS, CLA IAC /1.03/ | |
1129 | TAD TEMP /1.03/ ONLY ONE SS ? | |
1130 | SZA CLA /1.03/ | |
1131 | JMP I GETSS /1.03/ MORE, THATS NO GOOD | |
1132 | CDF /1.03/ | |
1133 | TAD I X12 /1.03/ GET THE SUBSCRIPT | |
1134 | DCA DIMNUM /1.03/ AND RETURN IT | |
1135 | JMP RGETSS /1.03/ | |
1136 | MUL12, 0 /12 BIT UNSIGNED MULTIPLY | |
1137 | DCA OP2 /SAVE OPERAND | |
1138 | TAD (-15 /SET SHIFT COUNT | |
1139 | DCA SC | |
1140 | JMP STMUL | |
1141 | M12LUP, TAD AC | |
1142 | SNL | |
1143 | JMP .+3 | |
1144 | CLL | |
1145 | TAD OP2 | |
1146 | RAR | |
1147 | STMUL, DCA AC | |
1148 | TAD MQ | |
1149 | RAR | |
1150 | DCA MQ | |
1151 | ISZ SC | |
1152 | JMP M12LUP | |
1153 | TAD MQ /RETURN VALUE | |
1154 | JMP I MUL12 | |
1155 | AC=OP3 | |
1156 | SC=OP4 | |
1157 | \f/ IF STATEMENTS | |
1158 | PAGE | |
1159 | IF, JMS I [EXPR /COMPILE CONDITION EXPRESSION | |
1160 | JMP I [BADCMD | |
1161 | JMS I [STMNUM /IS IT ARITHMETIC IF ? | |
1162 | JMP LOGIF | |
1163 | TAD (ARTHIF /START IF COMMAND | |
1164 | JMS I [OUTWRD | |
1165 | CLL CMA RTL | |
1166 | DCA TEMP | |
1167 | ISZ DOEND /DO END ILLEGAL HERE | |
1168 | JMP IFLABL /GET IF LABELS | |
1169 | IFLOOP, JMS I [CHECKC /LOOK FOR , | |
1170 | -254 | |
1171 | JMP I [NEXTST | |
1172 | JMS I [STMNUM /GET NEXT STMT NUMBER | |
1173 | JMP BADIF | |
1174 | IFLABL, TAD SNUM /OUTPUT LABEL | |
1175 | JMS I [OUTWRD | |
1176 | ISZ TEMP | |
1177 | JMP IFLOOP | |
1178 | JMP I [NEXTST | |
1179 | LOGIF, JMS IFCHEK /IF()IF()... NOT LEGAL | |
1180 | ISZ IFSWIT /CLEAR IF SWITCH | |
1181 | TAD (LIFBGN /START LOGICAL IF | |
1182 | JMS I [OUTWRD | |
1183 | JMP I (COMPIL /COMPILE THE STATEMENT | |
1184 | DOSWT, | |
1185 | IFCHEK, 0 /CHECK IF SWITCH | |
1186 | TAD IFSWIT | |
1187 | SNA CLA | |
1188 | JMP I IFCHEK | |
1189 | BADIF, JMS I [ERMSG | |
1190 | 1111 | |
1191 | JMP I [NEXTST | |
1192 | \f/ CALL STMT | |
1193 | CALL, JMS I [SAVECP /SAVE CHAR POS | |
1194 | JMS I [GETNAM /GET SUBROUTINE NAME | |
1195 | JMP BADCAL /NO NAME HERE IS BAD | |
1196 | JMS I [LOOKUP /GET ADDRESS OF TYPE WORD | |
1197 | IAC | |
1198 | DCA TEMP | |
1199 | CDF 10 | |
1200 | TAD I TEMP /LOOK AT TYPE | |
1201 | AND (6640 /ANYTHING BUT EXT OR ARG ? | |
1202 | SZA CLA | |
1203 | JMP BADCAL /YES, BAD | |
1204 | TAD I TEMP /SET EXT BIT | |
1205 | AND (137 /LEAVE TYPE AND ARG BITS | |
1206 | TAD (1000 | |
1207 | DCA I TEMP | |
1208 | CDF | |
1209 | JMS I [RESTCP /RESTORE CHAR POS | |
1210 | CLA IAC /SIGNAL THAT THIS IS A CALL | |
1211 | JMS I [LEXPR /COMPILE IT | |
1212 | XSTORE, DOSTOR /DON'T WORRY VIRGINIA, ITS A NOP | |
1213 | TAD OWTEMP /WHAT WAS THE LAST THING OUT ? | |
1214 | CLL | |
1215 | TAD (-63 /IF LESS THAN 63 | |
1216 | SNL CLA | |
1217 | JMP I [NEXTST /IT WAS AN ARG COUNT | |
1218 | TAD [ARGSOP /OTHERWISE IT WAS AN ARG LESS CALL | |
1219 | JMS I [OUTWRD /SO TELL PASS 2 ABOUT IT | |
1220 | JMS I [OUTWRD | |
1221 | JMP I [NEXTST | |
1222 | BADCAL, JMS I [ERMSG | |
1223 | 2316 | |
1224 | JMP I [NEXTST | |
1225 | \f/ DO DAH, DO DAH | |
1226 | DO, JMS I [IFCHEK /IF(...)DO IS ILLEGAL | |
1227 | JMS I [STMNUM /LOOK FOR ENDING STMT NUMBER | |
1228 | JMP I [BADCMD | |
1229 | JMS I [GETNAM /LOOKUP INDEX VARIABLE | |
1230 | JMP I [BADCMD | |
1231 | JMS I [LOOKUP | |
1232 | DCA DOINDX | |
1233 | JMS I [CHECKC /LOOK FOR = | |
1234 | -275 | |
1235 | JMP I [BADCMD | |
1236 | ISZ DOEND /CAN'T END DO LOOP ON A DO | |
1237 | JMS DOSTUF /GET DO PARAMETERS | |
1238 | JMP BADDO | |
1239 | TAD DOINDX /PUSH DO INDEX | |
1240 | JMS I [PUSH | |
1241 | TAD SNUM /PUSH ENDING STMT NUMBER | |
1242 | JMS I [PUSH | |
1243 | TAD STACK | |
1244 | DCA STKLVL /SAVE NEW STACK BASE | |
1245 | JMP I [NEXTST | |
1246 | ||
1247 | DOSTUF, 0 /SUBR FOR DO LOOP STUFF | |
1248 | JMS I [OUTWRD /OUTPUT DO INDEX | |
1249 | TAD DOINDX | |
1250 | JMS I [OUTWRD | |
1251 | JMS I [EXPR /GET EXPR FOR INITIAL VALUE | |
1252 | JMP I DOSTUF | |
1253 | TAD XSTORE /YES | |
1254 | JMS I [OUTWRD | |
1255 | JMS I [CHECKC /LOOK FOR COMMA | |
1256 | N254, -254 | |
1257 | JMP I DOSTUF | |
1258 | JMS I [EXPR /GET EXPR FOR FINAL VALUE | |
1259 | JMP I DOSTUF | |
1260 | JMS I [GETC /LOOK FOR A COMMA | |
1261 | JMP STEP1 /USE STEP OF 1 | |
1262 | TAD N254 | |
1263 | SZA CLA | |
1264 | JMP STEP1-1 | |
1265 | JMS I [EXPR /GET EXPR FOR STEP | |
1266 | JMP I DOSTUF | |
1267 | DORET, ISZ DOSTUF | |
1268 | TAD (DOBEGN /DO BEGIN OPERATOR | |
1269 | JMS I [OUTWRD | |
1270 | JMP I DOSTUF | |
1271 | JMS I [BACK1 /PUT BACK NON , (OFFICER BELOW LT.) | |
1272 | STEP1, JMS I [OUTWRD /OUTPUT A PUSH 1.0 | |
1273 | TAD (ONE | |
1274 | JMS I [OUTWRD | |
1275 | JMP DORET /FINISH DO STUFF | |
1276 | BADDO, JMS I [ERMSG /BAD DO COMMAND | |
1277 | 0417 | |
1278 | JMP I [NEXTST | |
1279 | BDERR, JMS I [ERMSG /ILLEGAL IN BLOCK DATA | |
1280 | 0223 | |
1281 | JMP I [NEXTST | |
1282 | \f/ TYPE STATEMENT SUBROUTINE | |
1283 | PAGE | |
1284 | TYPLST, 0 /HANDLE LIST FOR TYPE DELL | |
1285 | TAD STACK | |
1286 | DCA X12 /SAVE STACK POINTER | |
1287 | DCA NUMELM | |
1288 | TAD I TYPLST /GET SET BITS | |
1289 | DCA SETBIT | |
1290 | ISZ TYPLST | |
1291 | TAD I TYPLST /AND ILLEGAL BITS | |
1292 | DCA BADBIT | |
1293 | ISZ TYPLST | |
1294 | LSTLUP, JMS I [GETNAM /GET VARIABLE | |
1295 | JMP BADLST | |
1296 | JMS I [LOOKUP /S.T. SEARCH | |
1297 | DCA TLTEMP /SAVE VAR ADDRESS | |
1298 | TAD TLTEMP /PUT IT ON THE STACK | |
1299 | ISZ TLTEMP /NOW POINT TO TYPE WORD | |
1300 | JMS I [PUSH /INCREMENT NUMBER | |
1301 | ISZ NUMELM /INCREMENT NUMBER | |
1302 | CDF 10 | |
1303 | TAD I TLTEMP /COMPARE TYPES | |
1304 | AND BADBIT /CHECK FOR ILLEGAL BITS | |
1305 | SZA CLA | |
1306 | JMP TYPAGN /ATTEMPT TO RE-TYPE | |
1307 | TAD SETBIT /GET SET BITS | |
1308 | CMA /GENERATE MASK | |
1309 | AND I TLTEMP | |
1310 | TAD SETBIT /DO THE SET | |
1311 | DCA I TLTEMP /BUT NOT DIMENSION BIT | |
1312 | CDF | |
1313 | GETDIM, JMS I [GETC | |
1314 | JMP EOL | |
1315 | TAD (-250 /LOOK FOR ( | |
1316 | SZA | |
1317 | JMP NOTDIM /NOT DIMENSIONED | |
1318 | CLA IAC /INITIALIZE MAGIC NUMBER | |
1319 | DCA DSERES | |
1320 | CLA IAC | |
1321 | DCA DPRDCT /AND DIMENSION PRODUCT | |
1322 | TAD STACK | |
1323 | DCA X17 /SAVE STACK POINTER | |
1324 | DCA TEMP2 /DIMENSION COUNT=0 | |
1325 | JMP I (DIMLUP /GET DIMENSIONS | |
1326 | PUTDIM, TAD X17 | |
1327 | DCA STACK /RESTORE STACK | |
1328 | CDF 10 | |
1329 | TAD (3400 /DIM, EXT, SF ? | |
1330 | AND I TLTEMP | |
1331 | SZA CLA | |
1332 | JMP DIMAGN /ATTEMPT TP RE-DIMENSION | |
1333 | CLL CML RTR | |
1334 | TAD I TLTEMP /SET DIMENSION BIT | |
1335 | DCA I TLTEMP | |
1336 | ISZ TLTEMP | |
1337 | TAD TEMP2 /NUMBER OF DIMS. | |
1338 | DCA I NEXT | |
1339 | TAD I TLTEMP /GET EQUIVALENCE POINTER | |
1340 | SZA | |
1341 | DCA TLTEMP | |
1342 | TAD NEXT /STORE POINTER TO | |
1343 | DCA I TLTEMP /DIMENSION INFORMATION | |
1344 | TAD DPRDCT /SAVE DIM PRODUCT | |
1345 | DCA I NEXT | |
1346 | TAD DSERES /AND MAGIC NUMBER | |
1347 | DCA I NEXT | |
1348 | DCA I NEXT /ZERO MAGIC LITERAL POINTER | |
1349 | TAD TEMP2 | |
1350 | CIA | |
1351 | DCA TEMP2 /LEAVE LAST DIM | |
1352 | CDF | |
1353 | MOVDIM, TAD I X17 /1.03/ GET THE DIMENSION | |
1354 | CDF 10 /1.03/ | |
1355 | DCA I NEXT /1.03/ INTO THE DIMENSION INFO BLOCK | |
1356 | CDF /1.03/ | |
1357 | ISZ TEMP2 /1.03/ | |
1358 | JMP MOVDIM /1.03/ | |
1359 | NEXTEL, JMS I [GETC /LOOK FOR , | |
1360 | JMP TLRETN | |
1361 | TAD (-254 | |
1362 | SNA CLA | |
1363 | JMP LSTLUP /OK, GET NEXT MEMBER | |
1364 | ENDLST, JMS I [BACK1 | |
1365 | ISZ TYPLST | |
1366 | JMP I TYPLST | |
1367 | BADDIM, JMS I [ERMSG /DIMENSION ERROR | |
1368 | 0204 | |
1369 | JMP I TYPLST | |
1370 | BADLST, JMS I [ERMSG /ERROR IN LIST | |
1371 | 2404 | |
1372 | JMP I TYPLST | |
1373 | TYPAGN, JMS I [ERMSG | |
1374 | 2224 /RE-TYPE | |
1375 | JMP GETDIM | |
1376 | DIMAGN, JMS I [ERMSG /ATTEMPT TO RE DIMENSION | |
1377 | 2204 | |
1378 | JMP NEXTEL | |
1379 | NOTDIM, TAD (250-254 /IS IT A COMMA? | |
1380 | SZA CLA | |
1381 | JMP ENDLST | |
1382 | JMP LSTLUP /GET NEXT ELEMENT | |
1383 | EOL, | |
1384 | TLRETN, ISZ TYPLST | |
1385 | JMP I TYPLST /TAKE OK EXIT | |
1386 | ENDFIL, JMS I [CHECKC /LOOK FOR "E" | |
1387 | -305 | |
1388 | JMP I [BADCMD | |
1389 | JMS I [EXPR /COMPILE UNIT | |
1390 | JMP I [BADCMD | |
1391 | TAD (ENDFOP /OUTPUT ENDFILE OPERATOR | |
1392 | JMS I [OUTWRD | |
1393 | JMP I [NEXTST | |
1394 | DOUBLE, JMS I [CHECKC /LOOK FOR N | |
1395 | -316 | |
1396 | JMP I [BADCMD | |
1397 | ||
1398 | JMS I [IFCHEK /NOT ON AN IF | |
1399 | JMS I [TYPLST /PROCESS LIST | |
1400 | 0104 | |
1401 | 0100 | |
1402 | NOP | |
1403 | CLA IAC /SET THE DP SWITCH | |
1404 | DCA DPUSED | |
1405 | JMP I [NEXTST | |
1406 | \f/ SYMBOL TABLE LOOKERUPPER | |
1407 | PAGE | |
1408 | LOOKUP, 0 /SYMBOL TABLE LOOKUP FOR VARIABLE ENTRY | |
1409 | TAD NOCODE /IS THIS IN NOCODE MODE ? | |
1410 | SZA CLA | |
1411 | JMP I LOOKUP /YES, DO NOTHING | |
1412 | TAD BUCKET | |
1413 | TAD (ALIST-1 /GET START OF CORRECT BUCKET | |
1414 | CDF 10 | |
1415 | LOOK, DCA OLDN3 /SAVE ADDR OF PREVIOUS ENTRY | |
1416 | TAD I OLDN3 /GET ADDR OF NEXT ENTRY | |
1417 | SNA | |
1418 | JMP HOOKIN /NO NEXT ENTRY, ATTACH NEW ENTRY | |
1419 | TAD (2 /SKIP OVER TYPE AND DIM POINTER | |
1420 | DCA X10 | |
1421 | TAD (NAME1 | |
1422 | DCA PNAME /SETUP POINTER TO NAME | |
1423 | CDF | |
1424 | CHKNAM, TAD I PNAME /GET WORD NAME | |
1425 | CIA CLL | |
1426 | CDF 10 | |
1427 | TAD I X10 /COMPARE WITH THIS ENTRY | |
1428 | SZA CLA | |
1429 | JMP NOTSAM /DIFFERENT | |
1430 | CDF | |
1431 | TAD I PNAME | |
1432 | AND [77 /WAS THIS THE END OF NAME? | |
1433 | ISZ PNAME | |
1434 | SZA CLA | |
1435 | JMP CHKNAM /NO, KEEP COMPARING | |
1436 | CDF 10 | |
1437 | RLOOKU, TAD I OLDN3 /GET ADDR OF START OF ENTRY | |
1438 | CDF /AND RETURN IT IN THE AC | |
1439 | JMP I LOOKUP /RETURN ADDR OF SYMBOL | |
1440 | NOTSAM, SZL | |
1441 | JMP HOOKIN /NEW SYMBOL <CURRENT ONE | |
1442 | TAD I OLDN3 | |
1443 | JMP LOOK /CONTINUE SEARCH | |
1444 | HOOKIN, TAD I OLDN3 /HOOK NEW ENTRY INTO LIST | |
1445 | DCA I NEXT | |
1446 | TAD NEXT | |
1447 | DCA I OLDN3 | |
1448 | DCA I NEXT /ZERO TYPE WORD | |
1449 | DCA I NEXT /ZERO EQUIVALENCE/DIMENSION POINTER | |
1450 | TAD (NAME1 /PREPARE TO STICK IN THE NAME | |
1451 | DCA PNAME | |
1452 | CDF | |
1453 | ENTERN, TAD I PNAME /MOVE NAME INTO S.T. | |
1454 | CDF 10 | |
1455 | DCA I NEXT | |
1456 | CDF | |
1457 | TAD I PNAME | |
1458 | ISZ PNAME /END OF NAME? | |
1459 | AND [77 | |
1460 | SZA CLA | |
1461 | JMP ENTERN /NO, KEEP GOING | |
1462 | CDF 10 | |
1463 | STCHEK, TAD NEXT /CHECK FOR S.T. OVERFLOW | |
1464 | CIA CLL | |
1465 | TAD (4740 /5000 STARTS PASS2 SKELETON TABLES | |
1466 | SZL CLA | |
1467 | JMP RLOOKU | |
1468 | CDF | |
1469 | JMS I [ERMSG /S.T. FULL | |
1470 | 2324 | |
1471 | JMP I (ENDX /TREAT AS END OF INPUT | |
1472 | OLDN3, 0 /ADDR OF PREVIOUS ENTRY | |
1473 | N3SIZE, 0 /SIZE OF ENTRY | |
1474 | LTEMP, | |
1475 | PNAME, /POINTER TO NAME BUFFER | |
1476 | LUKUP2, 0 /LOOKUP FOR FIXED LENGTH SYMBOLS | |
1477 | TAD I LUKUP2 /GET THE BUCKET START | |
1478 | DCA OLDN3 /SAVE IT AS THE PREVIOUS ENTRY | |
1479 | ISZ LUKUP2 | |
1480 | TAD I LUKUP2 /GET THE ENTRY SIZE | |
1481 | ISZ LUKUP2 | |
1482 | DCA N3SIZE | |
1483 | TAD LUKUP2 /SAVE RETURN ADDR | |
1484 | DCA LOOKUP | |
1485 | TAD NOCODE /IS CODE GENERATION OFF ? | |
1486 | SZA CLA | |
1487 | JMP I LOOKUP /YES, JUST RETURN | |
1488 | CDF 10 | |
1489 | LOOK2, TAD I OLDN3 /GET ADDR OF NEXT ENTRY | |
1490 | SNA | |
1491 | JMP HOKIN2 /IF 0 ITS END OF LIST | |
1492 | IAC | |
1493 | DCA X10 /START OF VALUE INFO | |
1494 | TAD (WORD1-1 /SETUP POINTER TO PROTOTYPE | |
1495 | DCA X11 | |
1496 | TAD N3SIZE /AND TEMP OF ENTRY SIZE | |
1497 | DCA LTEMP | |
1498 | CHKVAL, CDF | |
1499 | TAD I X11 | |
1500 | CIA CLL /COMPARE THIS WORD OF THE VALUE | |
1501 | CDF 10 | |
1502 | TAD I X10 | |
1503 | SZA CLA | |
1504 | JMP NOTSM2 /NOT THIS ONE | |
1505 | ISZ LTEMP /INCR SIZE COUNT | |
1506 | JMP CHKVAL /MORE STUFF | |
1507 | JMP RLOOKU /RETURN WITH THE GOODS | |
1508 | NOTSM2, SZL | |
1509 | JMP HOKIN2 /NEW SYMBOL < CURRENT ONE | |
1510 | TAD I OLDN3 /CONTINUE SEARCH | |
1511 | DCA OLDN3 | |
1512 | JMP LOOK2 | |
1513 | HOKIN2, TAD I OLDN3 /HOOK NEW ENTRY INTO LIST | |
1514 | DCA I NEXT | |
1515 | TAD NEXT | |
1516 | DCA I OLDN3 | |
1517 | TAD (WORD1-1 /PREPARE TO STICK IN THE VALUE | |
1518 | DCA X11 | |
1519 | DCA I NEXT /ZERO TYPE WORD | |
1520 | CDF | |
1521 | ENTERV, TAD I X11 /MOVE VALUE INTO S.T. | |
1522 | CDF 10 | |
1523 | DCA I NEXT | |
1524 | ISZ N3SIZE /INCR SIZE COUNT | |
1525 | JMP ENTERV-1 | |
1526 | JMP STCHEK /STORE TYPE AND CHECK FOR OVERFLOW | |
1527 | STOP, TAD (STOPOP /OUTPUT STOP OPERATOR | |
1528 | JMS I [OUTWRD | |
1529 | ISZ DOEND /DO ILLEGAL ON STOP | |
1530 | JMP I [NEXTST | |
1531 | \f/ EXPRESSION ANALYZER | |
1532 | PAGE | |
1533 | EXPR, 0 /POLISHIZE EXPRESSION | |
1534 | TAD EXPR | |
1535 | JMS I [PUSH /SAVE RETURN ADDR | |
1536 | JMS I [PUSH /MARK STACK | |
1537 | UNOPR, JMS I [GETC /LOOK FOR UNARY OPERATOR | |
1538 | JMP MISARG /THERE HAS TO BE AN OPERAND | |
1539 | TAD (-253 /UNARY+(NOP) | |
1540 | SNA | |
1541 | JMP UNOPR | |
1542 | TAD (253-255 /UNARY- | |
1543 | SNA | |
1544 | JMP UMINUS | |
1545 | TAD (255-256 /.NOT. | |
1546 | SZA CLA | |
1547 | JMP OPRAND | |
1548 | DCA BUCKET /FOR CKNOT | |
1549 | JMS I (TRUFAL /.TRUE. OR .FALSE. ? | |
1550 | JMP CKNOT /NEITHER, IS IT >.NOT. | |
1551 | JMP .+3 /.TRUE. | |
1552 | TAD (NOTOPR /FALSE=.NOT.TRUE | |
1553 | JMS I [PUSH | |
1554 | JMS I [OUTWRD | |
1555 | TAD (TRUE | |
1556 | JMS I [OUTWRD | |
1557 | JMP I (NOSS | |
1558 | CKNOT, TAD BUCKET | |
1559 | TAD (-16 | |
1560 | SZA CLA | |
1561 | JMP OPRAND /MIGHT BE LITERAL .XXXXXX | |
1562 | TAD (NOTOPR /PUSH .NOT. OPERATOR | |
1563 | JMS I [PUSH | |
1564 | JMP UNOPR | |
1565 | UMINUS, TAD (UMOPR /PUSH UNARY MINUS | |
1566 | JMS I [PUSH | |
1567 | JMP UNOPR | |
1568 | OPRAND, JMS I [BACK1 /PUT BACK NON UNARY OPERATOR | |
1569 | JMS I [GETNAM /LOOK FOR VARIABLE REFERENCE | |
1570 | JMP NOTVAR /NOPE. | |
1571 | JMS I [LOOKUP /SYMBOL TABLE SEARCH | |
1572 | JMP I [OPR8R /GO OUTPUT PUSH-VAR | |
1573 | NOTVAR, JMS I [NUMBER /LOOK FOR A LITERAL | |
1574 | JMP NOTNUM /NO KIND OF NUMBER | |
1575 | JMP HOLCHK /INTEGER | |
1576 | JMP DPLIT /DOUBLE PRECISION | |
1577 | FPLIT, JMS I [LUKUP2 /FLOATING, ENTER INTO TABLE | |
1578 | FPLIST | |
1579 | -3 | |
1580 | JMP I [OPR8RL /PUSH VARIABLE, NO SUBSCRIPTS | |
1581 | DPLIT, JMS I [LUKUP2 /DOUBLE-PREC., ENTER IN TABLE | |
1582 | DPLIST | |
1583 | -6 | |
1584 | JMP I [OPR8RL | |
1585 | HOLCHK, JMS I [GETC /IS THIS HOLLERITH? | |
1586 | JMP .+5 | |
1587 | TAD (-310 | |
1588 | SNA CLA | |
1589 | JMP I (HFIELD /YES | |
1590 | JMS I [BACK1 | |
1591 | JMS I [LUKUP2 /FIND THE ENTRY | |
1592 | INTLST | |
1593 | -3 | |
1594 | JMP I [OPR8RL | |
1595 | NOTNUM, JMS I [GETC /LOOK FOR COMPLEX LITERAL | |
1596 | JMP MISARG /MISSING OPERAND | |
1597 | TAD (-250 /OPEN PAREN? | |
1598 | SZA | |
1599 | JMP QUOTE /GO LOOK FOR A STRING | |
1600 | JMS I [SAVECP /SAVE CHAR POSITION | |
1601 | JMS I [NUMBER /GET REAL PART | |
1602 | JMP I (NCMPLX /NO NUMBER | |
1603 | SKP /INTEGER-OK | |
1604 | JMP I (NCMPLX /DOUBLE-NOT LEGAL FOR COMPLEX | |
1605 | JMS I [CHECKC /LOOK FOR , | |
1606 | -254 | |
1607 | JMP I (NCMPLX /NO, CAN'T BE COMPLEX LIT. | |
1608 | TAD WORD1 /SAVE REAL PART | |
1609 | DCA TEMP | |
1610 | TAD WORD2 | |
1611 | DCA TEMP2 | |
1612 | TAD WORD3 | |
1613 | DCA CHAR | |
1614 | JMS I [NUMBER /GET IMAGINARY PART | |
1615 | JMP BADCL /NOT THERE, BAD | |
1616 | SKP /I | |
1617 | JMP BADCL /D-BAD | |
1618 | JMS I [CHECKC /LOOK FOR ) | |
1619 | -251 | |
1620 | JMP BADCL /NO ) BAD | |
1621 | TAD WORD1 /PUT IMAGINARY PART | |
1622 | DCA WORD4 | |
1623 | TAD WORD2 /INTO SECOND AHLF | |
1624 | DCA WORD5 | |
1625 | TAD WORD3 /OF COMPLEX LITERAL | |
1626 | DCA WORD6 | |
1627 | TAD TEMP /NOW RESTORE REAL PART | |
1628 | DCA WORD1 | |
1629 | TAD TEMP2 | |
1630 | DCA WORD2 | |
1631 | TAD CHAR | |
1632 | DCA WORD3 | |
1633 | CLL CMA RAL /REMOVE CHAR POS FROM STACK | |
1634 | TAD STACK /SINCE OTHERWISE IT GOES OUT | |
1635 | DCA STACK /AS CODE | |
1636 | JMS I [LUKUP2 /WHICH WE WILL NOW SEARCH | |
1637 | CMPLST /USE COMPLEX LIST | |
1638 | -6 | |
1639 | JMP I [OPR8RL | |
1640 | BADCL, JMS I [ERMSG /BAD COMPLEX LITERAL | |
1641 | 0314 | |
1642 | JMP I [BADEXP | |
1643 | MISARG, JMS I [ERMSG /MISSING OPERAND | |
1644 | 1517 | |
1645 | JMP I [BADEXP | |
1646 | \f/ EXPRESSION ANALYZER | |
1647 | PAGE | |
1648 | HQUOTE, 0 /SUBR FOR QUOTE STRINGS | |
1649 | JMS I [GETCWB /GET CHAR | |
1650 | JMP BADH | |
1651 | TAD [-247 /IS IT ' | |
1652 | SZA | |
1653 | JMP NOTQ2 /NO | |
1654 | JMS I [GETCWB | |
1655 | JMP LUHOL | |
1656 | TAD [-247 /LOOK FOR '' | |
1657 | SNA CLA | |
1658 | JMP NOTQ2 /REPLACE '' BY ' | |
1659 | JMS I [BACK1 /ITS END OF STRING | |
1660 | JMP LUHOL | |
1661 | NOTQ2, TAD [247 /RESTORE CHAR | |
1662 | AND [77 | |
1663 | JMP I HQUOTE | |
1664 | HFIELD, JMS I [FIXNUM /INTEGERIZE NUMBER | |
1665 | SNA | |
1666 | JMP BADH /ZERO IS BAD | |
1667 | CMA CLL | |
1668 | DCA TEMP | |
1669 | TAD (HCOUNT /SET SUBR POINTER | |
1670 | DOHOL, DCA HCHAR | |
1671 | TAD (-MAXHOL /SET COUNTER FOR MAX | |
1672 | DCA HOLCTR | |
1673 | TAD (NAME1 /SET UP NAME POINTER | |
1674 | DCA TEMP2 | |
1675 | PAKHOL, DCA I TEMP2 /PACK HOLLERITH STRING | |
1676 | JMS I HCHAR | |
1677 | CLL RTL | |
1678 | RTL | |
1679 | RTL | |
1680 | DCA I TEMP2 | |
1681 | JMS I HCHAR | |
1682 | TAD I TEMP2 | |
1683 | DCA I TEMP2 | |
1684 | ISZ TEMP2 | |
1685 | ISZ HOLCTR /CHECK FOR TOO MANY | |
1686 | JMP PAKHOL | |
1687 | BADH, JMS I [ERMSG /BAD OR TOO BIG HOLLERITH FIELD | |
1688 | 1017 | |
1689 | JMP I [BADEXP | |
1690 | LUHOL, TAD (33 /LOOK UP THIS LITERAL | |
1691 | DCA BUCKET | |
1692 | JMS I [LOOKUP | |
1693 | JMP I [OPR8RL | |
1694 | HCOUNT, 0 | |
1695 | ISZ TEMP /CHECK COUNT | |
1696 | SKP | |
1697 | JMP LUHOL /EXPIRED | |
1698 | JMS I [GETCWB /GET CHAR | |
1699 | JMP BADH | |
1700 | AND [77 /6-BIT IZE IT | |
1701 | JMP I HCOUNT | |
1702 | HOLCTR, 0 /COUNTER FOR HOLLERITH FIELDS | |
1703 | NCMPLX, JMS I [RESTCP /NOT COMPLEX LITERAL | |
1704 | JMS I [EXPR /MUST BE SUB EXPRESSION | |
1705 | JMP BADEXP | |
1706 | JMS I [GETC /LOOK FOR ) | |
1707 | JMP PARMM | |
1708 | TAD (-251 | |
1709 | SNA CLA | |
1710 | JMP I (NOSS /NO SUBSCRIPT LEGAL AFTER SUB EXPR | |
1711 | PARMM, JMS I [ERMSG /MISSING ) | |
1712 | 1515 | |
1713 | BADEXP, JMS I [POP /BAD EXPRESSION, | |
1714 | SZA CLA | |
1715 | JMP BADEXP /LOOK FOR STACK MARKER | |
1716 | JMS I [POP | |
1717 | DCA TEMP /RETURN ADDR. | |
1718 | JMP I TEMP | |
1719 | JMS I [BACK1 /PUT BACK TEMINAL CHAR | |
1720 | ENDEXP, JMS I [POP /GET NEXT THING FROM STACK | |
1721 | SNA | |
1722 | JMP EXPDUN /IF ZERO, FINISH | |
1723 | IAC /GET ADDR OF OPERATION NUMBER | |
1724 | DCA TEMP | |
1725 | TAD I TEMP /GET OPERATOR VALUE | |
1726 | JMS I [OUTWRD /OUTPUT OPERATOR XXXXXX | |
1727 | JMP ENDEXP /LOOP | |
1728 | EXPDUN, JMS I [POP /GET RETURN ADDR | |
1729 | IAC | |
1730 | DCA TEMP | |
1731 | JMP I TEMP | |
1732 | LETTER, 0 /GET A LETTER | |
1733 | JMS I [GETC | |
1734 | JMP I LETTER | |
1735 | TAD (-301 | |
1736 | SPA | |
1737 | JMP NLETR | |
1738 | TAD (301-333 | |
1739 | SMA | |
1740 | JMP NLETR | |
1741 | TAD (33 | |
1742 | ISZ LETTER | |
1743 | JMP I LETTER | |
1744 | NLETR, JMS I [BACK1 | |
1745 | JMP I LETTER | |
1746 | QUOTE, TAD (250-247 /IS IT ' | |
1747 | SZA | |
1748 | JMP MISARG /NO, OPERAND IS MISSING | |
1749 | TAD (HQUOTE /SET SUBR POINTER | |
1750 | JMP DOHOL | |
1751 | CHECKC, 0 /CHECK FOR A SINGLE CHAR | |
1752 | TAD I CHECKC /GET THE CHAR | |
1753 | DCA CCTEMP | |
1754 | ISZ CHECKC /SKIP PAST THE CHAR | |
1755 | JMS I [GETC /GET CHAR FROM INPUT | |
1756 | JMP I CHECKC /DIDN'T MAKE IT | |
1757 | TAD CCTEMP /IS THIS IT ? | |
1758 | SNA CLA | |
1759 | ISZ CHECKC /YES | |
1760 | JMP I CHECKC | |
1761 | CCTEMP, 0 | |
1762 | \f/ EXPRESSION ANALYZER | |
1763 | PAGE | |
1764 | BADFSS, JMS I [ERMSG | |
1765 | 2323 | |
1766 | JMP I [BADEXP | |
1767 | OPR8R, DCA TEMP | |
1768 | JMS I [OUTWRD /PUSH | |
1769 | TAD TEMP | |
1770 | JMS I [OUTWRD /OUTPUT OPERAND PTR | |
1771 | JMS I [GETC | |
1772 | JMP I [ENDEXP | |
1773 | TAD (-250 /IS IT S.S. OR FUNCTION | |
1774 | SZA | |
1775 | JMP NOTFSS | |
1776 | TAD STMJMP | |
1777 | TAD (-DFINFL | |
1778 | SNA CLA /FOR D.F.,PERMIT VARPARENS | |
1779 | JMP NOTFSS | |
1780 | ISZ TEMP /LOOK AT TYPE | |
1781 | CDF 10 | |
1782 | TAD (3420 /DIM, EXT, SF, OR ARG ? | |
1783 | AND I TEMP | |
1784 | SZA CLA | |
1785 | JMP NOTFUN /NOT A FUNCTION REFERENCE | |
1786 | TAD I TEMP | |
1787 | TAD (1000 /SET EXT BIT | |
1788 | DCA I TEMP | |
1789 | NOTFUN, CDF | |
1790 | SKP | |
1791 | JMS I [POP /PUT COUNT INTO AC | |
1792 | SSFUN, IAC /INCREMENT ARG COUNT | |
1793 | JMS I [PUSH /SAVE IT ON THE STACK | |
1794 | JMS I [EXPR /GET ARG (OR S.S.) | |
1795 | JMP I [BADEXP | |
1796 | JMS I [COMARP /LOOK FOR , OR ) | |
1797 | JMP BADFSS /NEITHER | |
1798 | JMP SSFUN-1 /, GET NEXT ARG (SUBSCRIPT?) | |
1799 | TAD (ARGSOP /YES, OUTPUT ARGLIST OPER | |
1800 | JMS I [OUTWRD | |
1801 | JMS I [POP /AND THE COUNT | |
1802 | JMS I [OUTWRD | |
1803 | NOSS, JMS I [GETC /GET NEXT CHAR | |
1804 | JMP I [ENDEXP | |
1805 | TAD (-253 /PREPARE IT | |
1806 | JMP NOTFSS+1 | |
1807 | OPR8RL, DCA TEMP /SAVE ADDR OF LITERAL | |
1808 | JMS I [OUTWRD | |
1809 | TAD TEMP | |
1810 | JMS I [OUTWRD | |
1811 | JMP NOSS | |
1812 | \f/ TYPLST PART TWO | |
1813 | DIMLUP, JMS I [NUMBER /GET DIMENSION | |
1814 | JMP VARDIM /MAYBE ITS VAR DIM ? | |
1815 | JMP .+3 /OK, INTEGER | |
1816 | JMP BADDIM | |
1817 | JMP BADDIM /DP AND FP ARE BAD | |
1818 | JMS I [FIXNUM /FIX IT FOR SOME STUFF | |
1819 | DCA MQ | |
1820 | TAD DPRDCT /GET NEW DIMENSION PRODUCT | |
1821 | JMS I [MUL12 | |
1822 | DCA DPRDCT | |
1823 | ISZ TEMP2 /INCREMENT DIM COUNT | |
1824 | TAD WORD2 /IF WORD2 OR AC NON ZERO | |
1825 | TAD AC /DIM IS TOO BIG | |
1826 | SZA CLA /1.03/ | |
1827 | JMP BADDIM /1.03/ | |
1828 | JMS I (ANORM /1.03/ RENORMALIZE THE NUMBER | |
1829 | JMS I [LUKUP2 /1.03/ ENTER IT INTO LITERAL LIST | |
1830 | INTLST /1.03/ | |
1831 | -3 /1.03/ | |
1832 | PSHDIM, JMS I [PUSH /1.03/ AND SAVE ON THE STACK | |
1833 | JMS I [COMARP /LOOK FOR , OR ) | |
1834 | JMP BADDIM | |
1835 | SKP /COMMA MEANS ANOTHER DIM FOLLOWS | |
1836 | JMP PUTDIM /) MEANS END OF DIMS | |
1837 | TAD DSERES /FORM NEXT VALUE OF MAGIC NUMBER | |
1838 | TAD DPRDCT | |
1839 | DCA DSERES | |
1840 | JMP DIMLUP /NOW LOOP FOR NEXT DIM | |
1841 | VDTEMP, 0 | |
1842 | VARDIM, CDF 10 /IS ARRAY AN ARG ? | |
1843 | TAD I TLTEMP | |
1844 | CDF | |
1845 | AND (20 | |
1846 | SNA CLA | |
1847 | JMP BADDIM /NO, BAD DIMENSION | |
1848 | JMS I [GETNAM /OK, GET DIMENSION | |
1849 | JMP BADDIM | |
1850 | JMS I [LOOKUP | |
1851 | IAC | |
1852 | DCA VDTEMP /ADDR OF TYPE WORD | |
1853 | CDF 10 /IS THA VARIABLE AN ARG ? | |
1854 | TAD I VDTEMP | |
1855 | AND (20 | |
1856 | CDF | |
1857 | SNA CLA | |
1858 | JMP BADDIM /NO, THATS BAD | |
1859 | DCA DPRDCT /3.02 ZERO DIM PRODUCT | |
1860 | ISZ TEMP2 /INCREMENT DIM COUNT | |
1861 | CMA /1.03/ | |
1862 | TAD VDTEMP /1.03/ SAVE DIMENSION VARIABLE | |
1863 | JMP PSHDIM /3.02 SAVE DIM ON STACK | |
1864 | MESSAG, 0 /PRINT PASS1 IMMEDIATE ERROR | |
1865 | TAD I MESSAG /GET CHAR ONE | |
1866 | ISZ MESSAG | |
1867 | JMS I (TTYOUT | |
1868 | TAD I MESSAG /GET CHAR TWO | |
1869 | JMS I (TTYOUT | |
1870 | TAD (215 /CR | |
1871 | JMS I (TTYOUT | |
1872 | TAD (212 /LF | |
1873 | JMS I (TTYOUT | |
1874 | JMP I (7605 /EXIT TO MONITOR | |
1875 | \f/ EXPRESSION ANALYZER REVISITED | |
1876 | PAGE | |
1877 | NOTFSS, TAD (250-253 /IS IT + | |
1878 | SZA | |
1879 | JMP .+3 | |
1880 | TAD (ADDOPR /YES | |
1881 | JMP GOTOPR | |
1882 | TAD (253-255 /IS IT - | |
1883 | SZA | |
1884 | JMP .+3 | |
1885 | TAD (SUBOPR /YES | |
1886 | JMP GOTOPR | |
1887 | TAD (255-252 /IS IT * | |
1888 | SZA | |
1889 | JMP NOTMUL /NO | |
1890 | JMS I [GETC | |
1891 | JMP NOTEXP | |
1892 | TAD (-252 /IS IT ** | |
1893 | SZA CLA | |
1894 | JMP .+3 | |
1895 | TAD (EXPOPR /YES | |
1896 | JMP GOTOPR | |
1897 | JMS I [BACK1 | |
1898 | NOTEXP, TAD (MULOPR /IT WAS * | |
1899 | JMP GOTOPR | |
1900 | NOTMUL, TAD (252-257 /IS IT / | |
1901 | SZA | |
1902 | JMP .+3 | |
1903 | TAD (DIVOPR /YES | |
1904 | JMP GOTOPR | |
1905 | IAC /IS IT . | |
1906 | SZA CLA | |
1907 | JMP I (ENDEXP-1 /NO, END OF EXPR | |
1908 | JMS CKEOPR /LOOK FOR EXTENDED OPERATOR | |
1909 | JMP BADOPR /NONE THERE | |
1910 | JMS I [CHECKC /CHECK FOR CLOSING . | |
1911 | -256 | |
1912 | JMP BADOPR /NOT THERE | |
1913 | CDF 10 /3.01/ | |
1914 | TAD I X10 /GET OPERATOR POINTER | |
1915 | CDF | |
1916 | JMP GOTOPR | |
1917 | CKEOPR, 0 /CHECK FOR EXTENDED OPERATOR | |
1918 | JMS I [GETNAM /GET NAME | |
1919 | JMP I CKEOPR /NONE | |
1920 | TAD (OPRLST-1 /PTR TO LIST | |
1921 | DCA X10 | |
1922 | OPRLUP, CDF 10 /3.01/ | |
1923 | TAD I X10 /COMPARE FIRST CHAR | |
1924 | CDF 0 | |
1925 | SNA | |
1926 | JMP I CKEOPR /END OF LIST | |
1927 | TAD BUCKET | |
1928 | SZA CLA | |
1929 | JMP NOTHIS /NOT THIS ONE | |
1930 | CDF 10 /3.01/ | |
1931 | TAD I X10 | |
1932 | CDF | |
1933 | TAD I (NAME1 /COMPARE 2ND AND 3RD | |
1934 | SZA CLA | |
1935 | JMP NOTHIS+1 /NOT THIS ONE | |
1936 | ISZ CKEOPR /BUMP RETURN | |
1937 | JMP I CKEOPR | |
1938 | NOTHIS, ISZ X10 /BUMP LIST PTR | |
1939 | ISZ X10 /AGAIN | |
1940 | JMP OPRLUP /KEEP GOING | |
1941 | BADOPR, JMS I [ERMSG /NOT LEGAL EXT. OPER. | |
1942 | 1720 | |
1943 | JMP I [BADEXP | |
1944 | GOTOPR, DCA NEWOP /SAVE NEWEST OPER. | |
1945 | JMS I [POP /GET STACK TOP | |
1946 | SNA | |
1947 | JMP PUSH2 /EMPTY | |
1948 | DCA OLDOP | |
1949 | TAD I OLDOP /COMPARE PREC. | |
1950 | CIA | |
1951 | TAD I NEWOP /NEW-OLD | |
1952 | SPA SNA CLA | |
1953 | JMP OUTOLD /OLD>NEW | |
1954 | TAD OLDOP | |
1955 | PUSH2, JMS I [PUSH /OLD < NEW | |
1956 | TAD NEWOP /GO PUSH BOTH | |
1957 | JMS I [PUSH | |
1958 | JMP I (UNOPR /GO LOOK FOR NEXT OPERAND | |
1959 | OUTOLD, ISZ OLDOP /OUTPUT OPERATOR | |
1960 | TAD I OLDOP | |
1961 | JMS I [OUTWRD | |
1962 | JMP GOTOPR+1 /TRY NEXT STACK ELEMENT | |
1963 | NEWOP=WORD1 | |
1964 | OLDOP=WORD2 | |
1965 | \f/ UTILITIES | |
1966 | GETCWB, 0 /GET A CHARACTER (PRESERVE BLANKS) | |
1967 | ISZ NCHARS | |
1968 | JMP .+4 | |
1969 | CLA CMA | |
1970 | DCA NCHARS /RESET NCHARS | |
1971 | JMP I GETCWB | |
1972 | ISZ GETCWB | |
1973 | TAD I CHRPTR /GET THE CHAR | |
1974 | JMP I GETCWB | |
1975 | SAVECP, 0 /SAVE CHAR POSITION | |
1976 | TAD NCHARS | |
1977 | JMS I [PUSH | |
1978 | TAD CHRPTR | |
1979 | JMS I [PUSH | |
1980 | JMP I SAVECP | |
1981 | FIXNUM, 0 /FIX FAC (I'M MOVING IT AGAIN) | |
1982 | TAD WORD1 /IS IT FIXED ? | |
1983 | TAD (-27 | |
1984 | SNA | |
1985 | JMP RETFN /YES, EXPONENT IS 23 | |
1986 | SMA CLA | |
1987 | JMP I FIXNUM /BAD IF EXP IS >23 | |
1988 | JMS I (AR1 /RIGHT SHIFT ONE | |
1989 | JMP FIXNUM+1 /TEST AGAIN | |
1990 | RETFN, TAD WORD3 /RETURN LOWEST 12 BITS | |
1991 | JMP I FIXNUM | |
1992 | \f/ UTILITIES | |
1993 | PAGE | |
1994 | GETC, 0 /GET A CHARACTER (IGNORING BLANKS) | |
1995 | ISZ NCHARS | |
1996 | JMP .+4 | |
1997 | CLA CMA | |
1998 | DCA NCHARS | |
1999 | JMP I GETC | |
2000 | TAD I CHRPTR | |
2001 | TAD (-240 /IS IT A BLANK | |
2002 | SNA | |
2003 | JMP GETC+1 /YES IGNORE IT | |
2004 | TAD (240 /FIX CHAR | |
2005 | ISZ GETC | |
2006 | JMP I GETC | |
2007 | ERMSG, 0 /ERROR MESSAGE HANDLER | |
2008 | CDF | |
2009 | TAD NOCODE /IS CODE GENERATION ON ? | |
2010 | SZA CLA | |
2011 | JMP NOTOUT /NO | |
2012 | TAD (ERRCOD /ERROR CODE TO OUTPUT FILE | |
2013 | JMS I [OUTWRD | |
2014 | TAD I ERMSG | |
2015 | ISZ ERMSG | |
2016 | JMS I [OUTWRD | |
2017 | JMP I ERMSG /RETURN | |
2018 | NOTOUT, TAD I ERMSG /SAVE THE ERROR CODE | |
2019 | ISZ ERMSG | |
2020 | DCA ERCODE | |
2021 | JMP I ERMSG | |
2022 | POP, 0 /PUT TOP OF STACK INTO AC | |
2023 | TAD STACK | |
2024 | DCA ERMSG | |
2025 | CLA CMA | |
2026 | TAD STACK | |
2027 | DCA STACK /DECREMENT STACK POINTER | |
2028 | TAD I ERMSG | |
2029 | JMP I POP | |
2030 | TRUFAL, 0 /CHECK FOR LOGICAL LITERALS | |
2031 | JMS I [GETNAM | |
2032 | JMP I TRUFAL | |
2033 | JMS I [CHECKC /LOOK FOR TERMINAL . | |
2034 | -256 | |
2035 | JMP I TRUFAL | |
2036 | TAD BUCKET /LOOK AT FIRST CHAR | |
2037 | TAD (-24 | |
2038 | SNA | |
2039 | JMP .+5 /ITS "T" | |
2040 | TAD (24-6 | |
2041 | SZA CLA | |
2042 | JMP I TRUFAL /ITS NEITHER | |
2043 | ISZ TRUFAL /ITS "F" | |
2044 | ISZ TRUFAL | |
2045 | JMP I TRUFAL | |
2046 | \f/ LEFT HALF EXPRESSION ANALYZER | |
2047 | LEXPR, 0 /GET LEFT HAND EXPRESSION | |
2048 | DCA LETEMP /SAVE CALL SWITCH | |
2049 | JMS I [GETNAM /LOOK FOR VAR NAME | |
2050 | JMP MSNGOP /MUST BE THERE | |
2051 | JMS I [OUTWRD /OUTPUT A ZERO (PUSH) | |
2052 | JMS I [LOOKUP /SEEK OUT ENTRY FOR THIS VAR | |
2053 | DCA TEMP | |
2054 | TAD TEMP | |
2055 | JMS I [OUTWRD | |
2056 | JMS I [GETC /LOOK FOR DIMENSIONS | |
2057 | JMP LEXPOK /NO ( | |
2058 | TAD (-250 | |
2059 | SZA CLA | |
2060 | JMP LEXPOK-1 /NO ( | |
2061 | ISZ TEMP /LOOK AT TYPE | |
2062 | CDF 10 | |
2063 | CLL CML RTR /DIMENSIONED ? | |
2064 | AND I TEMP | |
2065 | TAD LETEMP /OR A CALL ? | |
2066 | TAD NOCODE /OR CODE OFF ? | |
2067 | SZA CLA | |
2068 | JMP NOTSF /YES, NOT AN ARITHMETIC S.F. | |
2069 | TAD I TEMP | |
2070 | AND (1420 /EXT, SF, OR ARG ? | |
2071 | SNA CLA /V3C | |
2072 | TAD [-M6 /SEE IF CALLED FROM SPECIAL PLACE | |
2073 | TAD LEXPR /V3C COMPARE WITH ENTRY PT | |
2074 | SZA CLA | |
2075 | JMP ASFERR /THIS IS BAD IF SO | |
2076 | TAD I TEMP | |
2077 | TAD (400 | |
2078 | DCA I TEMP /SET A.S.F. BIT | |
2079 | CDF | |
2080 | TAD (ASFDEF /DEFINE ASF | |
2081 | JMS I [OUTWRD | |
2082 | NOTSF, CDF | |
2083 | SKP | |
2084 | JMS I [POP /ARG COUNT TO AC | |
2085 | SSLOOP, IAC /INCREMENT SS COUNT | |
2086 | JMS I [PUSH /SAVE ON THE STACK | |
2087 | JMS I [EXPR /COMPILE SUBSCRIPT | |
2088 | JMP FSSBAD+2 /ERROR WITHIN SS | |
2089 | JMS I [COMARP /LOOK FOR , OR ) | |
2090 | JMP FSSBAD /NEITHER (THERE WAS A BUG HERE) | |
2091 | JMP SSLOOP-1 /, GET NEXT ARG/SS | |
2092 | TAD (ARGSOP /OUTPUT SS OPERATOR | |
2093 | JMS I [OUTWRD | |
2094 | JMS I [POP /THEN COUNT | |
2095 | JMS I [OUTWRD | |
2096 | SKP | |
2097 | JMS I [BACK1 /PUT BACK A CHARACTER | |
2098 | LEXPOK, ISZ LEXPR | |
2099 | JMP I LEXPR /RETURN | |
2100 | MSNGOP, JMS I [ERMSG /MISSING OPERAND | |
2101 | 1517 | |
2102 | JMP I LEXPR | |
2103 | FSSBAD, JMS I [ERMSG /MISSING COMMA OR CLOSE PARENTHESIS | |
2104 | 2323 | |
2105 | JMS I [POP /GET ARG COUNT OFF STACK | |
2106 | CLA | |
2107 | JMP I LEXPR | |
2108 | ASFERR, JMS I [ERMSG /BAD ARITHMETIC STMT FUNCTION | |
2109 | 2306 | |
2110 | JMP NOTSF /DO THE REST OF THE ASF DEF | |
2111 | LETEMP, 0 | |
2112 | \f/UTILITIES | |
2113 | PAGE | |
2114 | G2CTMP, | |
2115 | PUSH, 0 /PUT AC ONTO STACK | |
2116 | DCA I STACK /STORE | |
2117 | TAD (STACKS+100 /CHECK FOR STACK OVERFLOW | |
2118 | CIA CLL | |
2119 | TAD STACK | |
2120 | SNL CLA | |
2121 | JMP I PUSH /OK, RETURN | |
2122 | DCA NOCODE /SET CODE GENERATION ON | |
2123 | JMS I [ERMSG | |
2124 | 2004 | |
2125 | JMP I [NEXTST | |
2126 | GET2C, 0 /GET 2 SIX BIT CHARS INTO ONE WPRD | |
2127 | JMS I [GETC /GET FIRST CHAR | |
2128 | JMP I GET2C | |
2129 | AND [77 | |
2130 | CLL RTL | |
2131 | RTL | |
2132 | RTL | |
2133 | DCA G2CTMP | |
2134 | JMS I [GETC /GET SECOND CHAR | |
2135 | JMP I GET2C | |
2136 | ISZ GET2C /FIX RETURN ADDR | |
2137 | AND [77 | |
2138 | TAD G2CTMP | |
2139 | JMP I GET2C | |
2140 | STMNUM, 0 /PICK UP STATEMENT NUMBER | |
2141 | DCA WORD4 /SAVE DEFINED BIT (IF ANY) | |
2142 | DCA WORD2 /ZERO SOME STUFF | |
2143 | DCA WORD3 | |
2144 | JMS DIGIT /GET A DIGIT | |
2145 | JMP I STMNUM /NONE THERE, NO STMT NUMBER | |
2146 | TAD (-60 /IS IT A LEADING 0 ? | |
2147 | SNA | |
2148 | JMP .-4 /YES, IGNORE IT | |
2149 | TAD (60 | |
2150 | CLL RTL | |
2151 | RTL | |
2152 | RTL | |
2153 | DCA WORD1 | |
2154 | JMS DIGIT /GET SECOND DIGIT | |
2155 | JMP ENDNUM /END OF NUMBER | |
2156 | TAD WORD1 | |
2157 | DCA WORD1 /COMBINE FIRST AND SECOND | |
2158 | JMS DIGIT | |
2159 | JMP ENDNUM | |
2160 | CLL RTL | |
2161 | RTL | |
2162 | RTL | |
2163 | DCA WORD2 | |
2164 | JMS DIGIT | |
2165 | JMP ENDNUM /COMBINE THIRD AND FOURTH | |
2166 | TAD WORD2 | |
2167 | DCA WORD2 | |
2168 | JMS DIGIT /GET FIFTH DIGIT | |
2169 | JMP ENDNUM | |
2170 | CLL RTL | |
2171 | RTL | |
2172 | RTL | |
2173 | DCA WORD3 | |
2174 | ENDNUM, JMS I [LUKUP2 /LOOK UP IN S.T. | |
2175 | SNLIST /STMT NUMBER LIST | |
2176 | -3 | |
2177 | ISZ STMNUM | |
2178 | DCA SNUM /SAVE S.T. ADDRESS OF LABEL | |
2179 | CDF 10 /SET TYPE WORD | |
2180 | TAD SNUM /GET ADDR OF TYPE | |
2181 | IAC | |
2182 | DCA SNTEMP | |
2183 | TAD I SNTEMP /GET TYPE WORD | |
2184 | CLL | |
2185 | TAD WORD4 /PUT IN THE DEFINITION BIT | |
2186 | SNL | |
2187 | DCA I SNTEMP /RESTORE IT IF NOT MULTIPLE DEFN | |
2188 | CDF | |
2189 | SNL CLA | |
2190 | JMP I STMNUM | |
2191 | JMS I [ERMSG | |
2192 | 1514 | |
2193 | JMP I STMNUM | |
2194 | SNTEMP, | |
2195 | DIGIT, 0 /GET A DIGIT | |
2196 | JMS I [GETC /GET A CHAR | |
2197 | JMP I DIGIT | |
2198 | TAD (-272 /IS IT > 271 (9) | |
2199 | SMA | |
2200 | JMP NODIGT /YES, ITS GREATER | |
2201 | TAD (272-260 /IS IT < 260 (0) | |
2202 | SPA | |
2203 | JMP NODIGT /YES, ITS LESS | |
2204 | TAD (60 | |
2205 | ISZ DIGIT | |
2206 | JMP I DIGIT /TAKE SUCCESSFUL RETURN | |
2207 | NODIGT, JMS I [BACK1 /RESTORE NON DIGIT | |
2208 | JMP I DIGIT | |
2209 | ASSIGN, JMS I [STMNUM /GET STMT NUMBER | |
2210 | JMP BADASN | |
2211 | JMS I [GET2C /LOOK FOR "TO" | |
2212 | JMP BADASN | |
2213 | TAD (-2417 | |
2214 | SNA CLA | |
2215 | JMS I [LEXPR /GET ASSIGN VARIABLE | |
2216 | JMP BADASN | |
2217 | TAD (ASNOPR /OUTPUT ASSIGN OPERATOR | |
2218 | JMS I [OUTWRD | |
2219 | TAD SNUM /NOW STMT NUMBER | |
2220 | JMS I [OUTWRD | |
2221 | JMP I [NEXTST | |
2222 | BADASN, JMS I [ERMSG | |
2223 | 0123 | |
2224 | JMP I [NEXTST | |
2225 | TTYOUT, 0 /TTY OUTPUT ROUTINE | |
2226 | TLS | |
2227 | TSF | |
2228 | JMP .-1 | |
2229 | CLA | |
2230 | JMP I TTYOUT | |
2231 | \f/ PRECEDENCE TABLE | |
2232 | PAGE | |
2233 | ADDOPR, 100 | |
2234 | 1 | |
2235 | SUBOPR, 100 | |
2236 | 2 | |
2237 | MULOPR, 200 | |
2238 | 3 | |
2239 | DIVOPR, 200 | |
2240 | 4 | |
2241 | EXPOPR, 500 | |
2242 | 5 | |
2243 | NOTOPR, 30 | |
2244 | 6 | |
2245 | UMOPR, 400 | |
2246 | 7 | |
2247 | EQOPR, 40 | |
2248 | 16 | |
2249 | NEOPR, 40 | |
2250 | 17 | |
2251 | GEOPR, 40 | |
2252 | 10 | |
2253 | GTOPR, 40 | |
2254 | 11 | |
2255 | LEOPR, 40 | |
2256 | 12 | |
2257 | LTOPR, 40 | |
2258 | 13 | |
2259 | ANDOPR, 20 | |
2260 | 14 | |
2261 | OROPR, 10 | |
2262 | 15 | |
2263 | XOROPR, 7 | |
2264 | 20 | |
2265 | EQVOPR, 7 | |
2266 | 21 | |
2267 | \f/ UTILITY ROUTINES | |
2268 | BACK1, 0 /BACK UP ONE CHAR | |
2269 | CLA CMA | |
2270 | TAD NCHARS | |
2271 | DCA NCHARS | |
2272 | CLA CMA | |
2273 | TAD CHRPTR | |
2274 | DCA CHRPTR | |
2275 | JMP I BACK1 | |
2276 | OADD, 0 /ADD OPERAND TO FAC | |
2277 | CLL | |
2278 | TAD OPO | |
2279 | TAD ACO | |
2280 | DCA ACO | |
2281 | RAL | |
2282 | TAD OP6 | |
2283 | TAD WORD6 | |
2284 | DCA WORD6 | |
2285 | RAL | |
2286 | TAD OP5 | |
2287 | TAD WORD5 | |
2288 | DCA WORD5 | |
2289 | RAL | |
2290 | TAD OP4 | |
2291 | TAD WORD4 | |
2292 | DCA WORD4 | |
2293 | RAL | |
2294 | TAD OP3 | |
2295 | TAD WORD3 | |
2296 | DCA WORD3 | |
2297 | RAL | |
2298 | TAD OP2 | |
2299 | TAD WORD2 | |
2300 | DCA WORD2 | |
2301 | JMP I OADD | |
2302 | \f/ FLOATING POINT DIVIDE ROUTINE | |
2303 | PAGE | |
2304 | FPDIV, 0 | |
2305 | JMS I DAR1 /UNNORMALIZE AC BY ONE | |
2306 | TAD OP1 /COMPUTE FINAL EXPONENT | |
2307 | CIA | |
2308 | TAD WORD1 | |
2309 | DCA OP1 /AND SAVE IT | |
2310 | TAD DM74 /SET ITERATION COUNTER | |
2311 | DCA DITCNT | |
2312 | TAD WORD2 | |
2313 | RAL /INITIALIZE LINK | |
2314 | FPDVLP, CLA RAR /COMPARE SIGNS | |
2315 | TAD OP2 | |
2316 | SPA CLA | |
2317 | JMP .+3 | |
2318 | TAD OPMAC /NEGATE OPERAND | |
2319 | JMS I DFNEG | |
2320 | JMS I DOADD /ADD OPERAND AND FAC | |
2321 | TAD D6 /RIGHT SHIFT QUOTIENT | |
2322 | RAL /PRESERVING ADD OVERFLOW BIT | |
2323 | DCA D6 | |
2324 | TAD D5 | |
2325 | RAL | |
2326 | DCA D5 | |
2327 | TAD D4 | |
2328 | RAL | |
2329 | DCA D4 | |
2330 | TAD D3 | |
2331 | RAL | |
2332 | DCA D3 | |
2333 | TAD D2 | |
2334 | RAL | |
2335 | DCA D2 | |
2336 | JMS I DAL1 /LEFT SHIFT FAC ONE | |
2337 | ISZ DITCNT /TEST ITERATION COUNT | |
2338 | JMP FPDVLP | |
2339 | TAD OP1 /PUT QUOTIENT INTO FAC | |
2340 | DCA WORD1 | |
2341 | TAD D2 | |
2342 | DCA WORD2 | |
2343 | TAD D3 | |
2344 | DCA WORD3 | |
2345 | TAD D4 | |
2346 | DCA WORD4 | |
2347 | TAD D5 | |
2348 | DCA WORD5 | |
2349 | TAD D6 | |
2350 | DCA WORD6 | |
2351 | DCA ACO | |
2352 | JMS I DNORM /NORMALIZE | |
2353 | JMP I FPDIV | |
2354 | D2, 0 | |
2355 | D3, 0 | |
2356 | D4, 0 | |
2357 | D5, 0 | |
2358 | D6, 0 | |
2359 | DITCNT, 0 | |
2360 | DAR1, AR1 | |
2361 | DAL1, AL1 | |
2362 | DM74, -74 | |
2363 | OPMAC, OPO-ACO | |
2364 | DFNEG, NEGFAC | |
2365 | DOADD, OADD | |
2366 | DNORM, ANORM | |
2367 | *STACKS-1 | |
2368 | -1 /TO PREVENT SPURIOUS DO ENDS | |
2369 | \f/ NUMERIC CONVERSION ROUTINE | |
2370 | PAGE | |
2371 | NUMBER, 0 /GENERAL NUMBER CONVERSION ROUTINE | |
2372 | DCA ESWIT /ZERO E/D SWITCH | |
2373 | DCA DECPT /ZERO DECIMAL POINT SWITCH | |
2374 | DCA WORD1 /ZERO FAC | |
2375 | DCA WORD2 | |
2376 | DCA WORD3 | |
2377 | DCA WORD4 | |
2378 | DCA WORD5 | |
2379 | DCA WORD6 | |
2380 | DCA ACO | |
2381 | DCA SIGN /CLEAR SIGN SWITCH | |
2382 | JMS I [GETC /GET A CHAR | |
2383 | JMP I NUMBER /NO CHAR IS NO NUMBER | |
2384 | JMS CHKSGN /CHECK FOR SIGN | |
2385 | SIGN, 0 /THIS SWITCH GETS SET | |
2386 | DCA NDIGIT /ZERO DIGIT COUNT | |
2387 | CONVLP, JMS I [DIGIT /GET A DIGIT | |
2388 | JMP TRYDEC /IS THERE A DECIMAL POINT ? | |
2389 | AND [17 | |
2390 | DCA NXTDGT /SAVE THE DIGIT | |
2391 | ISZ NDIGIT /INCR NUMBER OF DIGITS | |
2392 | TAD WORD2 /PREPARE TO MULT BY 10 | |
2393 | DCA OP2 | |
2394 | TAD WORD3 | |
2395 | DCA OP3 | |
2396 | TAD WORD4 | |
2397 | DCA OP4 | |
2398 | TAD WORD5 | |
2399 | DCA OP5 | |
2400 | TAD WORD6 | |
2401 | DCA OP6 | |
2402 | TAD ACO | |
2403 | DCA OPO | |
2404 | JMS I (AL1 /DOUBLE FAC | |
2405 | JMS I (AL1 /DOUBLE AGAIN | |
2406 | JMS I (OADD /TIMES FIVE | |
2407 | JMS I (AL1 /ONE MORE DOUBLING IS TIMES 10 | |
2408 | DCA OP2 | |
2409 | DCA OP3 /PUT NEWEST DIGIT INTO OPERAND | |
2410 | DCA OP4 | |
2411 | DCA OP5 | |
2412 | DCA OP6 | |
2413 | TAD NXTDGT | |
2414 | DCA OPO | |
2415 | JMS I (OADD /ADD IN NEWEST DIGIT | |
2416 | JMP CONVLP | |
2417 | TRYDEC, TAD DECPT /DECIMAL ALREADY ? | |
2418 | SZA CLA | |
2419 | JMP TRYE2 /YES, LOOK FOR EXPONENT | |
2420 | JMS I [GETC /LOOK FOR . | |
2421 | JMP DIGTST /SEE IF THERE WAS ANYTHING | |
2422 | TAD (-256 | |
2423 | SZA | |
2424 | JMP TRYE1 /TRY FOR E | |
2425 | JMS I [SAVECP /SAVE CHAR POS | |
2426 | JMS I (CKEOPR /CHECK FOR SPECIAL CASE OF LIT.RE. | |
2427 | JMP NOLDRE /NOT LIT.RE. | |
2428 | JMS I [RESTCP | |
2429 | JMS I [BACK1 /PUT BACK . IT BELONGS TO RELATIONAL | |
2430 | DIGTST, TAD NDIGIT /ANY DIGITS ? | |
2431 | SNA CLA | |
2432 | JMP I NUMBER /NO, NO NUMBER | |
2433 | JMP INTEGR /TAKE INTEGER EXIT | |
2434 | NOLDRE, ISZ DECPT /SET DECIMAL POINT SW | |
2435 | JMS I [RESTCP /RESTORE CHAR POS | |
2436 | JMP CONVLP-1 /LOOP FOR OTHER DIGITS | |
2437 | TRYE1, JMS I [BACK1 /PUT BACK NON . | |
2438 | TAD NDIGIT /ANY DIGITS YET ? | |
2439 | SNA CLA | |
2440 | JMP I NUMBER /NO, NO NUMBER | |
2441 | JMS EORD /LOOK OR E OR D | |
2442 | JMP INTEGR | |
2443 | TRYE2, JMS EORD /LOOK FOR E OR D | |
2444 | FPNUM, ISZ NUMBER | |
2445 | ISZ NUMBER | |
2446 | DCA EXPON /ZERO EXPONENT | |
2447 | JMS I (DODEC /HANDLE DIGITS RIGHT OF . | |
2448 | JMP DOSIGN-1 /GO DO SIGN | |
2449 | INTEGR, TAD (107 /PUT IN EXPONNT | |
2450 | DCA WORD1 | |
2451 | JMS I (ANORM /NORMALIZE | |
2452 | ISZ NUMBER /BUMP RETURN | |
2453 | DOSIGN, TAD SIGN /CHECK THE SIGN | |
2454 | SZA CLA | |
2455 | JMS I (NEGFAC /NEGATE IF NEGATIVE | |
2456 | JMP I NUMBER /RETURN | |
2457 | CHKSGN, 0 /CHECK FOR SIGN | |
2458 | TAD (-255 /IS IT - ? | |
2459 | SNA | |
2460 | ISZ I CHKSGN /YES, SET SWITCH | |
2461 | SZA | |
2462 | TAD (255-253 /IS IT + ? | |
2463 | SZA CLA | |
2464 | JMS I [BACK1 /RETURN CHAR OTHERWISE | |
2465 | JMP I CHKSGN | |
2466 | EORD, 0 /LOOK FOR E OR D | |
2467 | JMS I [GETC /LOOK FOR E OR D | |
2468 | JMP I EORD | |
2469 | TAD (-304 | |
2470 | CLL RAR | |
2471 | SZA CLA /E OR D? | |
2472 | JMP NOEORD /NO | |
2473 | SZL | |
2474 | ISZ ESWIT /SET SWITCH IF E | |
2475 | SNL | |
2476 | ISZ DPUSED /SET D.P. SWITCH IF D | |
2477 | JMP I (GETEXP /OK, GET EXPONENT | |
2478 | NOEORD, JMS I [BACK1 /PUT IT BACK CAUSE ITS NOT OURS | |
2479 | JMP I EORD | |
2480 | NXTDGT, 0 | |
2481 | REWIND, JMS I [EXPR /COMPILE UNIT | |
2482 | JMP I [NEXTST | |
2483 | TAD (REWOPR /OUTPUT REWIND OPERATOR | |
2484 | JMS I [OUTWRD | |
2485 | JMP I [NEXTST | |
2486 | \f/ NUMERIC CONVERSION ROUTINE | |
2487 | PAGE | |
2488 | SMLNUM, 0 /INPUT A NUMBER <= 4095 | |
2489 | EXPLUP, DCA EXPON /ZERO THE EXPONENT | |
2490 | JMS I [DIGIT /GET THE NEXT DIGIT | |
2491 | JMP I SMLNUM /NUMBER DONE | |
2492 | AND [17 | |
2493 | DCA OPO /SAVE THE DIGIT | |
2494 | TAD EXPON /MULT BY 10 | |
2495 | CLL RAL | |
2496 | CLL RAL | |
2497 | TAD EXPON | |
2498 | CLL RAL | |
2499 | TAD OPO /ADD IN DIGIT | |
2500 | JMP EXPLUP /STORE BACK INTO EXPONENT | |
2501 | GETEXP, DCA ESIGN /ZERO EXPONENT SIGN SWITCH | |
2502 | JMS I [GETC /GET A CHAR | |
2503 | JMP I (FPNUM+1 | |
2504 | JMS I (CHKSGN /IS IT A SIGN | |
2505 | FPRTNE, | |
2506 | ESIGN, 0 /THIS IS THE SWITCH TO SET | |
2507 | JMS SMLNUM /GO GET THE EXPONENT | |
2508 | FIXEXP, TAD ESIGN /CHECK EXPONENT SIGN | |
2509 | SNA CLA | |
2510 | JMP .+4 | |
2511 | TAD EXPON /COMPLEMENT EXPONENT | |
2512 | CIA | |
2513 | DCA EXPON | |
2514 | JMS DODEC /GO HANLE EXPONENT | |
2515 | CLL CML RTL /BUMP RETURN BY TWO (DP) OR 3 (FP) | |
2516 | TAD ESWIT /DEPENDING ON E/D SWITCH | |
2517 | TAD I [NUMBER | |
2518 | DCA I [NUMBER | |
2519 | JMP I (DOSIGN /CHECK THE SIGN | |
2520 | DODEC, 0 | |
2521 | TAD DO107 /NORMALIZE THE NUMBER | |
2522 | DCA WORD1 | |
2523 | JMS I (ANORM | |
2524 | TAD DECPT /WAS THERE A DECIMAL POINT ? | |
2525 | SZA CLA | |
2526 | TAD NDIGIT /HOW MANY DIGITS TO THE RIGHT ? | |
2527 | CIA | |
2528 | TAD EXPON /SUBTRACT THAT NUMBER FROM EXP | |
2529 | SMA | |
2530 | JMP POSEXP /EXPONENT IS POSITIVE | |
2531 | CIA | |
2532 | DCA EXPON /ONLY NEED ABS VALUE | |
2533 | TAD (FPDIV /DO DIVIDES | |
2534 | JMP .+3 | |
2535 | POSEXP, DCA EXPON | |
2536 | TAD (FPMUL /DO MULTIPLIES | |
2537 | DCA FPRTNE /MULTIPLY/DIVIDE ROUTINE | |
2538 | TAD (PETABL-1 /POWERS OF TEN TABLE | |
2539 | DCA X17 | |
2540 | EXPMUL, TAD EXPON /LOOK AT THE EXPONENT | |
2541 | SNA | |
2542 | JMP I DODEC /IF 0 ITS THRU | |
2543 | CLL RAR | |
2544 | DCA EXPON /PUT LOWEST BIT INTO LINK | |
2545 | SNL | |
2546 | JMP SKPEXP /THIS ONE DOESN'T COUNT | |
2547 | CDF 10 /3.01/ | |
2548 | TAD I X17 /MOVE FACTOR INTO OPERAND | |
2549 | DCA OP1 | |
2550 | TAD I X17 | |
2551 | DCA OP2 | |
2552 | TAD I X17 | |
2553 | DCA OP3 | |
2554 | TAD I X17 | |
2555 | DCA OP4 | |
2556 | TAD I X17 | |
2557 | DCA OP5 | |
2558 | TAD I X17 | |
2559 | DCA OP6 | |
2560 | DCA OPO | |
2561 | CDF | |
2562 | JMS I FPRTNE /MULTIPLY OR DIVIDE BY THIS FACTOR | |
2563 | JMP EXPMUL /CHECK NEXT BIT | |
2564 | SKPEXP, TAD X17 /SKIP OVER THIS FACTOR | |
2565 | TAD (6 | |
2566 | JMP EXPMUL-1 | |
2567 | AR1, 0 /SHIFT FAC RIGHT ONE | |
2568 | TAD WORD2 | |
2569 | CLL RAR | |
2570 | DCA WORD2 | |
2571 | TAD WORD3 | |
2572 | RAR | |
2573 | DCA WORD3 | |
2574 | TAD WORD4 | |
2575 | RAR | |
2576 | DCA WORD4 | |
2577 | TAD WORD5 | |
2578 | RAR | |
2579 | DCA WORD5 | |
2580 | TAD WORD6 | |
2581 | RAR | |
2582 | DCA WORD6 | |
2583 | TAD ACO | |
2584 | RAR | |
2585 | DCA ACO | |
2586 | ISZ WORD1 | |
2587 | DO107, 107 | |
2588 | JMP I AR1 | |
2589 | ||
2590 | AL1, 0 /SHIFT FAC LEFT ONE | |
2591 | TAD ACO | |
2592 | CLL RAL | |
2593 | DCA ACO | |
2594 | TAD WORD6 | |
2595 | RAL | |
2596 | DCA WORD6 | |
2597 | TAD WORD5 | |
2598 | RAL | |
2599 | DCA WORD5 | |
2600 | TAD WORD4 | |
2601 | RAL | |
2602 | DCA WORD4 | |
2603 | TAD WORD3 | |
2604 | RAL | |
2605 | DCA WORD3 | |
2606 | TAD WORD2 | |
2607 | RAL | |
2608 | DCA WORD2 | |
2609 | JMP I AL1 | |
2610 | \f/ NUMERIC CONVERSION ROUTINE | |
2611 | PAGE | |
2612 | FPMUL, 0 /FLOATING MULTIPLY ROUTINE | |
2613 | TAD WORD1 /COMPUTE NEW EXPONENT | |
2614 | TAD OP1 | |
2615 | DCA OP1 | |
2616 | TAD WORD2 /SAVE AC MANTISSA | |
2617 | DCA TW2 | |
2618 | TAD WORD3 | |
2619 | DCA TW3 | |
2620 | TAD WORD4 | |
2621 | DCA TW4 | |
2622 | TAD WORD5 | |
2623 | DCA TW5 | |
2624 | TAD WORD6 | |
2625 | DCA TW6 | |
2626 | TAD (-74 /SET ITERATION COUNTER | |
2627 | DCA ITRCNT | |
2628 | DCA WORD2 /ZERO FAC MANTISSA | |
2629 | DCA WORD3 | |
2630 | DCA WORD4 | |
2631 | DCA WORD5 | |
2632 | DCA WORD6 | |
2633 | DCA ACO | |
2634 | MULLUP, JMS I (AR1 /SHIFT FAC RIGHT ONE | |
2635 | TAD TW2 /SHIFT MULTIPLIER RIGHT | |
2636 | CLL RAR | |
2637 | DCA TW2 | |
2638 | TAD TW3 | |
2639 | RAR | |
2640 | DCA TW3 | |
2641 | TAD TW4 | |
2642 | RAR | |
2643 | DCA TW4 | |
2644 | TAD TW5 | |
2645 | RAR | |
2646 | DCA TW5 | |
2647 | TAD TW6 | |
2648 | RAR | |
2649 | DCA TW6 | |
2650 | SZL | |
2651 | JMS I (OADD /ADD IF LINK IS ONE | |
2652 | ISZ ITRCNT /BUMP COUNT | |
2653 | JMP MULLUP /LOOP | |
2654 | TAD OP1 /PUT IN CORRECT EXPONENT | |
2655 | DCA WORD1 | |
2656 | JMS I (ANORM /NORMALIZE THE RESULT | |
2657 | JMP I FPMUL | |
2658 | TW2, 0 | |
2659 | TW3, 0 | |
2660 | TW4, 0 | |
2661 | TW5, 0 | |
2662 | TW6, 0 | |
2663 | ANORM, 0 /NORMALIZE FAC | |
2664 | TAD WORD2 /IS MANTISSA 0 ? | |
2665 | SNA | |
2666 | TAD WORD3 | |
2667 | SNA | |
2668 | TAD WORD4 | |
2669 | SNA | |
2670 | TAD WORD5 | |
2671 | SNA | |
2672 | TAD WORD6 | |
2673 | SNA | |
2674 | TAD ACO | |
2675 | SNA CLA | |
2676 | JMP ZEXP /YES, ZERO EXPONENT | |
2677 | NORMLP, CLA CLL CML RTR /IS HIGH ORDER MANTISSA = 6000 | |
2678 | TAD WORD2 | |
2679 | SZA | |
2680 | JMP NO6000 /NO, SKIP THIS STUFF | |
2681 | TAD WORD3 /YES, IS THE REST 0 ? | |
2682 | SNA | |
2683 | TAD WORD4 | |
2684 | SNA | |
2685 | TAD WORD5 | |
2686 | SNA | |
2687 | TAD WORD6 | |
2688 | SNA | |
2689 | TAD ACO | |
2690 | SZA CLA /SKIP IF 600000 ... 0000 | |
2691 | NO6000, SPA CLA | |
2692 | JMP I ANORM /NORM IS DONE WHEN BITS DIFFER | |
2693 | JMS I (AL1 /SHIFT LEFT ONE | |
2694 | CLA CMA /DECREMENT EXPONENT | |
2695 | TAD WORD1 | |
2696 | DCA WORD1 | |
2697 | JMP NORMLP /LOOP | |
2698 | ZEXP, DCA WORD1 | |
2699 | JMP I ANORM | |
2700 | NEGFAC, 0 /NEGATE FAC | |
2701 | TAD (ACO /GET POINTER TO OPERAND | |
2702 | DCA NFPTR | |
2703 | TAD (-6 /SIX WORD NEGATE | |
2704 | DCA NFCNT | |
2705 | CLL | |
2706 | NFLOOP, RAL | |
2707 | TAD I NFPTR /GET NEXT WORD | |
2708 | CLL CML CIA | |
2709 | DCA I NFPTR /RESTORE AFTER COMPLEMENTING | |
2710 | CML CLA CMA /LINK GETS COMPLEMENTED ONCE HERE | |
2711 | TAD NFPTR /AND ONCE AGAIN HERE | |
2712 | DCA NFPTR /RESTORE DECREMENTED POINTER | |
2713 | ISZ NFCNT | |
2714 | JMP NFLOOP | |
2715 | JMP I NEGFAC | |
2716 | NFPTR, 0 | |
2717 | NFCNT, 0 | |
2718 | ITRCNT, | |
2719 | DHLRTH, 0 /HOLLERITH IN DATA SUBR | |
2720 | ISZ TEMP | |
2721 | SKP | |
2722 | JMP I DHLRTH | |
2723 | ISZ DHLRTH | |
2724 | JMS I [GETCWB | |
2725 | JMP DHOLER | |
2726 | JMP I DHLRTH | |
2727 | \f/ VARIABLE SCANNER | |
2728 | PAGE | |
2729 | GETNAM, 0 /GET VARIABLE NAME | |
2730 | JMS LETTER /FIRST CHAR MUST BE ALPHABETIC | |
2731 | JMP I GETNAM /NO VARIABLE | |
2732 | DCA BUCKET /FIRST ONE IS THE BUCKET | |
2733 | TAD (NAME1 | |
2734 | DCA NPTR /POINTER TO NAME BUFFER | |
2735 | CLL CMA RTL /SIX CHARS MAX (3 WORDS) | |
2736 | DCA NCNT | |
2737 | PAKLUP, JMS LETTER /GET A LETTER | |
2738 | SKP | |
2739 | JMP .+3 /WE GOT IT | |
2740 | JMS I [DIGIT /NO LETTER, IS IT A DIGIT ? | |
2741 | JMP NDONE /NO, NAMES OVER | |
2742 | CLL RTL | |
2743 | RTL | |
2744 | RTL /MOVE CHAR TO A HIGHER PLACE | |
2745 | DCA I NPTR /STORE IT | |
2746 | ISZ NCNT /BUMP COUNTER | |
2747 | JMP MORNAM /MORE TO COME | |
2748 | SKP | |
2749 | NDONE, DCA I NPTR /ZERO NEXT WORD | |
2750 | ISZ GETNAM /FIX RETURN ADDR | |
2751 | JMP I GETNAM | |
2752 | MORNAM, JMS LETTER /GET NEXT CHAR | |
2753 | SKP | |
2754 | JMP .+3 /ITS A LETTER | |
2755 | JMS I [DIGIT | |
2756 | JMP NDONE+1 /NO GOOD, NAMES OVER | |
2757 | TAD I NPTR | |
2758 | DCA I NPTR /COMBINE TWO CHARS | |
2759 | ISZ NPTR | |
2760 | JMP PAKLUP | |
2761 | NPTR, 0 | |
2762 | NCNT=OADD | |
2763 | \f/ DATA STATEMENT | |
2764 | DATA, JMS I [IFCHEK /IF(..)DATA ???? | |
2765 | TAD (DATAST /START DATA STATEMENT | |
2766 | JMS I [OUTWRD | |
2767 | DATLUP, CLA CMA /SET DIMNUM = -1 IF NO SUBSCRIPTS | |
2768 | JMS I [GETSS /GET LIST ELEMENT | |
2769 | JMP DATAER | |
2770 | TAD (DPUSH /OUTPUT DPUSH OPERATOR | |
2771 | JMS I [OUTWRD | |
2772 | CMA | |
2773 | TAD TEMP2 /FOLLOWED BY POINTER | |
2774 | JMS I [OUTWRD | |
2775 | TAD DIMNUM /FOLLOWED BY NUMBER | |
2776 | JMS I [OUTWRD | |
2777 | CDF 10 | |
2778 | TAD I TEMP2 /LOOK AT TYE TYPE | |
2779 | AND (20 /IS IT AN ARG ? | |
2780 | CDF | |
2781 | SZA CLA | |
2782 | JMP DATAER /YES, THATS BAD | |
2783 | JMS I [GETC /, ? | |
2784 | JMP DATAER | |
2785 | TAD (-254 | |
2786 | SNA | |
2787 | JMP DATLUP /LOOK FOR MORE | |
2788 | TAD (254-257 // ? | |
2789 | SZA CLA | |
2790 | JMP DATAER | |
2791 | JMP DLOOP2 /GO LOOK FOR ELEMENT | |
2792 | DATA3, TAD (WORD1-1 | |
2793 | DCA X10 /POINTER TO THE GOODS | |
2794 | TAD I X10 /THEN STUFF | |
2795 | JMS I [OUTWRD | |
2796 | ISZ TEMP | |
2797 | JMP .-3 | |
2798 | NXTDE, TAD (ENDELM /OUTPUT END OF ELEMENT | |
2799 | JMS I [OUTWRD | |
2800 | JMS I [GETC /LOOK FOR COMMA | |
2801 | JMP DATAER | |
2802 | TAD (-254 | |
2803 | SNA | |
2804 | JMP DLOOP2 /YES, GET MORE DATA | |
2805 | TAD (254-257 /SLASH ? | |
2806 | SZA CLA | |
2807 | JMP DATAER /NO, ERROR | |
2808 | JMS I [GETC /ANOTHER DATA GROUP ? | |
2809 | JMP I [NEXTST /NO | |
2810 | TAD (-254 /COMMA ? | |
2811 | SNA CLA | |
2812 | JMP DATA+1 /START A NEW DATA STMT | |
2813 | DATAER, JMS I [ERMSG | |
2814 | 0401 /OK WHEN THIS IS AN AND | |
2815 | JMP I [NEXTST | |
2816 | DHOLER, JMS I [ERMSG | |
2817 | 0410 /HOLLERITH DATA ERROR | |
2818 | JMP I [NEXTST | |
2819 | DQUOTE, 0 /GET CHAR FOR QUOTED DATA | |
2820 | JMS I [GETCWB | |
2821 | JMP DHOLER | |
2822 | TAD [-247 | |
2823 | SZA | |
2824 | JMP DNOTQ2 | |
2825 | JMS I [GETCWB | |
2826 | JMP I DQUOTE | |
2827 | TAD [-247 | |
2828 | SNA CLA | |
2829 | JMP DNOTQ2 /REPLACE '' BY ' | |
2830 | JMS I [BACK1 | |
2831 | JMP I DQUOTE | |
2832 | DNOTQ2, TAD [247 /FIX CHAR | |
2833 | ISZ DQUOTE | |
2834 | JMP I DQUOTE | |
2835 | OUT3WD, 0 /2.02/ OUTPUT 3 WORDS | |
2836 | TAD [DATELM /2.02/ OUTPUT ELEMENT HEAD | |
2837 | JMS I [OUTWRD /2.02/ | |
2838 | TAD (3 /2.02/ AND SIZE | |
2839 | JMS I [OUTWRD /2.02/ | |
2840 | TAD WORD1 /2.02/ NOW THREE WORDS | |
2841 | JMS I [OUTWRD /2.02/ | |
2842 | TAD WORD2 /2.02/ | |
2843 | JMS I [OUTWRD /2.02/ | |
2844 | TAD WORD3 /2.02/ | |
2845 | JMS I [OUTWRD /2.02/ | |
2846 | JMP I OUT3WD /2.02/ | |
2847 | \f/ DATA STATEMENT | |
2848 | PAGE | |
2849 | DLOOP2, JMS I [GETC | |
2850 | JMP DATAER | |
2851 | TAD (-250 /IS CHAR ( ? | |
2852 | SZA | |
2853 | JMP NOCMPD /NO, NOT COMPLEX DATA | |
2854 | JMS I [NUMBER /GET REAL PART | |
2855 | JMP DATAER | |
2856 | SKP | |
2857 | JMP DATAER /DP IS NG WITH COMPLEX | |
2858 | JMS OUT3WD /2.02/ OUTPUT 3 WORDS | |
2859 | JMS I [CHECKC /LOOK FOR COMMA | |
2860 | -254 | |
2861 | JMP DATAER /BAD IF NOT THERE | |
2862 | JMS I [NUMBER /GET IMAGINARY PART | |
2863 | JMP DATAER | |
2864 | SKP | |
2865 | JMP DATAER | |
2866 | JMS I [CHECKC /LOOK FOR ) | |
2867 | -251 | |
2868 | JMP DATAER /NOT THERE | |
2869 | JMP DATAFP /GO MOVE IMAGINARY PART | |
2870 | NOCMPD, IAC /IS IT QUOTED STRING ? | |
2871 | SZA | |
2872 | JMP NQUOTD /NO | |
2873 | TAD (DQUOTE /GET SUBR ADDRESS | |
2874 | JMP HOLDAT /GO HANDLE IT | |
2875 | NQUOTD, TAD (247-317 /IS IT AN O (OCTAL) | |
2876 | SNA | |
2877 | JMP I (XOCTAL /YES | |
2878 | TAD (317-256 /IS IT . | |
2879 | SNA CLA | |
2880 | JMS I (TRUFAL /CHECK FOR TRUE OR FALSE | |
2881 | JMP NOTF /NO TRUE-FALSE, TRY NUMBER | |
2882 | CLL CML RTR /2000 | |
2883 | DCA WORD2 | |
2884 | TAD WORD2 | |
2885 | SZA CLA | |
2886 | IAC | |
2887 | DCA WORD1 /TRUE=1.0 FALSE=0.0 | |
2888 | DCA WORD3 | |
2889 | JMP DATAFP /GO PUT IT | |
2890 | NOTF, JMS I [BACK1 /PUT BACK CHAR | |
2891 | JMS I [NUMBER /TRY FOR A NUMBER | |
2892 | JMP DATAER /ELEMENT MISSING | |
2893 | JMP TRYHOS /IF INTEGER, TRY FOR H OR * | |
2894 | TAD (-3 | |
2895 | DATAFP, TAD (-3 /FP DATA | |
2896 | DCA TEMP /SIZE OF ITEM | |
2897 | TAD [DATELM /DATA ELEMENT SIGNAL | |
2898 | JMS I [OUTWRD | |
2899 | TAD TEMP /THEN SIZE | |
2900 | CIA /ALWAYS POSITIVE | |
2901 | JMS I [OUTWRD | |
2902 | JMP DATA3 /GO OUTPUT THE DATA | |
2903 | TRYHOS, JMS I [GETC /LOOK FOR H | |
2904 | JMP DATAER | |
2905 | TAD (-310 | |
2906 | SZA | |
2907 | JMP TRYSTR /NOT H, MAYBE ITS * | |
2908 | JMS I [FIXNUM /INTEGERIZE IT | |
2909 | SNA | |
2910 | JMP DHOLER /HOLLERITH DATA ERROR | |
2911 | CMA | |
2912 | DCA TEMP /SAVE COUNT | |
2913 | TAD (DHLRTH /GET SUBR POINTER | |
2914 | HOLDAT, DCA HCHAR | |
2915 | CLL CMA RTL /2.02/ COUNT | |
2916 | DCA TEMP2 /2.02/ BY THREES | |
2917 | TAD (WORD1-1 /2.02/ | |
2918 | DCA X10 /2.02/ POINTER | |
2919 | HDLOOP, JMS I HCHAR /GET A CHAR | |
2920 | JMP EOHD /2.02/ | |
2921 | AND [77 /6 BITIZE IT | |
2922 | CLL RTL | |
2923 | RTL | |
2924 | RTL /UPPER-PART-OF-WORDIZE | |
2925 | DCA WORD3 /2.02/ STORAGIZE IT | |
2926 | JMS I HCHAR /GET ANOTHER | |
2927 | JMP LASTHD /LAST HALF WORD MUST GO OUT | |
2928 | AND [77 | |
2929 | TAD WORD3 /2.02/ COMBINIZE THE TWO HALVES | |
2930 | DCA I X10 /2.02/ STORE IT | |
2931 | ISZ TEMP2 /2.02/ THREE AT A TIME | |
2932 | JMP HDLOOP /2.02/ | |
2933 | JMS OUT3WD /2.02/ OUTPUT THREE | |
2934 | JMP HOLDAT+1 /2.02/ GO DO NEXT THREE WDS | |
2935 | EOHD, CLL CML RTL /2.02/ ANY CHARS IN THIS SET ? | |
2936 | TAD TEMP2 /2.02/ | |
2937 | SPA CLA /2.02/ | |
2938 | JMP NXTDE /2.02/ NO, DO NEXT ELEMENT | |
2939 | JMP .+4 /2.02/ YES, FILL IT OUT | |
2940 | LASTHD, TAD WORD3 /2.02/ FILL OUT LOWER CHAR | |
2941 | TAD (40 /2.02/ WITH A BLANK | |
2942 | DCA I X10 /2.02/ | |
2943 | TAD (4040 /2.02/ THEN FILL REST | |
2944 | DCA I X10 /2.02/ WITH BLANKS | |
2945 | TAD (4040 /2.02/ | |
2946 | DCA I X10 /2.02/ | |
2947 | JMP DATAFP /2.02/ GO OUTPUT IT | |
2948 | TRYSTR, TAD (310-252 /* | |
2949 | SNA CLA | |
2950 | JMP .+3 | |
2951 | JMS I [BACK1 /PUT BACK THAT CHAR | |
2952 | JMP DATAFP /ITS JUST AN INTEGER | |
2953 | TAD (DREPTC /REPETITION COUNT | |
2954 | JMS I [OUTWRD | |
2955 | JMS I [FIXNUM | |
2956 | JMS I [OUTWRD /OUTPUT COUNT | |
2957 | JMP DLOOP2 /LOOP | |
2958 | \f/ INITIALIZE READ IN | |
2959 | *6400 | |
2960 | INITLN, TAD IX7772 /READ FIRST SIX CHARS | |
2961 | DCA TEMP | |
2962 | TAD IXLINM | |
2963 | DCA CHRPTR | |
2964 | INITLP, CIF 10 | |
2965 | JMS I [ICHAR /READ A CHAR | |
2966 | JMP INITLN | |
2967 | TAD IXM211 /TAB ? | |
2968 | SZA CLA | |
2969 | JMP NIXTAB /NO THIS ONE | |
2970 | TAD IX0240 | |
2971 | DCA I CHRPTR | |
2972 | ISZ TEMP | |
2973 | JMP .-3 | |
2974 | JMP CHKCOM /DO COMMENT CHECK | |
2975 | NIXTAB, TAD CHAR | |
2976 | DCA I CHRPTR /STORE THE CHAR | |
2977 | ISZ TEMP | |
2978 | JMP INITLP | |
2979 | CHKCOM, TAD I IXLINE /COMMENT ? | |
2980 | TAD IXM303 | |
2981 | SNA CLA | |
2982 | JMP IGNORE /IGNORE IT | |
2983 | TAD I IXLNP5 /CONTINUATION ? | |
2984 | TAD IXM240 | |
2985 | SZA CLA | |
2986 | JMP IGNORE | |
2987 | TAD IX7700 /FIX CALL | |
2988 | CDF 10 /SEE WHAT HAPPENS WHEN YOU MOVE A ROUTINE** | |
2989 | DCA I IXINCL | |
2990 | CDF /** | |
2991 | CIF 10 | |
2992 | JMS I IX200 /REMOVE MONITOR | |
2993 | 11 | |
2994 | CDF 10 /FIX FIELD ONE STUFF | |
2995 | TAD I MOV1 | |
2996 | DCA I MOV2 | |
2997 | ISZ MOV1 | |
2998 | ISZ MOV2 | |
2999 | ISZ MOVCNT | |
3000 | JMP .-5 | |
3001 | CDF | |
3002 | JMP I IXRDFS /LOOK FOR PROG HEADER | |
3003 | MOV1, 2020 | |
3004 | MOV2, 20 | |
3005 | MOVCNT, -160 | |
3006 | IGNORE, CIF 10 /** | |
3007 | JMS I [ICHAR /SKIP TILL CARRIAGE RETURN | |
3008 | JMP INITLN | |
3009 | CLA | |
3010 | JMP IGNORE | |
3011 | IXRDFS, RDFRST | |
3012 | IXINCL, INCALL | |
3013 | IXM240, -240 | |
3014 | IXM303, -303 | |
3015 | IX0240, 0240 | |
3016 | IX200, 200 | |
3017 | IX7600, 7600 | |
3018 | IX7772, 7772 | |
3019 | IXM211, -211 | |
3020 | IX7700, 7700 /V3C | |
3021 | \f/ SEARCH FOR PROGRAM HEADER | |
3022 | PAGE | |
3023 | RDFRST, CIF 10 /** | |
3024 | JMS I [ICHAR /THIS IS A DUPLICATE OF THE CODE | |
3025 | JMP ENDLNF /AT LABEL 'RDLOOP' , ONLY THE | |
3026 | TAD (-211 | |
3027 | SNA | |
3028 | TAD (240-211 | |
3029 | TAD (211 | |
3030 | DCA I CHRPTR /NAMES HAVE BEEN CHANGED TO | |
3031 | ISZ CNT72 | |
3032 | SKP | |
3033 | JMP SKPFL2 | |
3034 | TAD CHRPTR /PROTECT THE ASSEMBLY | |
3035 | CIA CLL /(IT GETS THE FIRST LINE | |
3036 | TAD (LINE+270 /WHICH MAY BE SUBROUTINE OR | |
3037 | /FUNCTION. 1ST LINE SHORTER THAN REST BEC OF BUFFER OVERWRITES** | |
3038 | SZL CLA /OR SOMETHING ELSE, IN WHICH CASE | |
3039 | JMP RDFRST /ITS THE MAIN PROGRAM) | |
3040 | JMS I [ERMSG /LINE TOO LONG | |
3041 | 1424 | |
3042 | JMP SKPFL /SKIP REST | |
3043 | SKPFL2, CIF 10 /** | |
3044 | JMS I [ICHAR | |
3045 | JMP ENDLNF | |
3046 | CLA | |
3047 | JMP SKPFL2 | |
3048 | SKPCMF, TAD X16 /BY ORDER OF THE EMPEROR | |
3049 | DCA CHRPTR /MARIO DE NOBILI | |
3050 | ENDLNF, TAD CHRPTR | |
3051 | DCA X16 | |
3052 | TAD CHRPTR | |
3053 | DCA X10 | |
3054 | TAD (-102 | |
3055 | DCA CNT72 | |
3056 | TAD (-6 | |
3057 | DCA NCHARS | |
3058 | GET6F, CIF 10 /** | |
3059 | JMS I [ICHAR | |
3060 | JMP SKPCMF | |
3061 | TAD (-211 | |
3062 | SZA CLA | |
3063 | JMP NOTABF | |
3064 | TAD (240 | |
3065 | DCA I CHRPTR | |
3066 | ISZ NCHARS | |
3067 | JMP .-3 | |
3068 | TAD (240 | |
3069 | DCA CHAR | |
3070 | JMP CCHEKF | |
3071 | NOTABF, TAD CHAR | |
3072 | DCA I CHRPTR | |
3073 | ISZ NCHARS | |
3074 | JMP GET6F | |
3075 | CCHEKF, TAD I X10 | |
3076 | TAD (-303 | |
3077 | SZA CLA | |
3078 | JMP NOCMTF | |
3079 | SKPFL, CIF 10 /** | |
3080 | JMS I [ICHAR | |
3081 | JMP SKPCMF | |
3082 | CLA | |
3083 | JMP SKPFL | |
3084 | NOCMTF, TAD CHAR | |
3085 | TAD (-240 | |
3086 | SNA CLA | |
3087 | JMP GOTFST | |
3088 | CCARDF, TAD X16 | |
3089 | DCA CHRPTR | |
3090 | JMP RDFRST | |
3091 | GOTFST, TAD CHRPTR | |
3092 | CIA | |
3093 | TAD (LINE+4 | |
3094 | DCA NCHARS | |
3095 | TAD [LINE-1 | |
3096 | DCA CHRPTR | |
3097 | JMS I [SAVECP | |
3098 | TAD (HDRLST-1 | |
3099 | DCA X10 /PREPARE TO SEARCH THE LIST | |
3100 | CLOOP1, CDF 10 /(FNC NAMES UP IN FLD 1)** | |
3101 | TAD I X10 /OF LEGAL HEADER LINES | |
3102 | CDF | |
3103 | SZA /CODE IS AS UNDER 'CMDLUP' | |
3104 | JMP CLOOP2 | |
3105 | CLA CMA RAL | |
3106 | TAD STACK | |
3107 | DCA STACK | |
3108 | CDF 10 /** | |
3109 | TAD I X10 | |
3110 | CDF | |
3111 | DCA TEMP | |
3112 | JMP I TEMP | |
3113 | CLOOP2, DCA TEMP | |
3114 | JMS I [GET2C | |
3115 | JMP BADCMF | |
3116 | CIA | |
3117 | TAD TEMP | |
3118 | SNA CLA | |
3119 | JMP CLOOP1 | |
3120 | SEARCH, CDF 10 /** | |
3121 | TAD I X10 | |
3122 | CDF | |
3123 | SZA CLA | |
3124 | JMP SEARCH | |
3125 | ISZ X10 | |
3126 | JMS I [RESTCP | |
3127 | ISZ STACK | |
3128 | ISZ STACK | |
3129 | CDF 10 /** | |
3130 | TAD I X10 | |
3131 | CDF | |
3132 | SZA | |
3133 | JMP CLOOP2 | |
3134 | BADCMF, JMS I [RESTCP /NOT A FUNCTION OR SUBROUTINE | |
3135 | JMP I (LINE1 /SO GO TO MAIN PART OF COMPILER | |
3136 | BADDIE, JMS I [MESSAG /SOMETHING MISSING FROM SYS | |
3137 | 323 /S | |
3138 | 331 /Y | |
3139 | \f/ ANALYZE PROGRAM HEADER | |
3140 | PAGE | |
3141 | SUBRTN, CLA CMA /SET TO -1 FOR SUBR | |
3142 | JMP XXXFUN+1 | |
3143 | REAFUN, TAD (102 /SET TYPE TO REAL | |
3144 | DCA TYPE | |
3145 | JMP XXXFUN | |
3146 | LOGFUN, IAC /SET TYPE OF FUN | |
3147 | DBLFUN, IAC /WITH DOUBLEMINT GUM ! | |
3148 | CMPFUN, IAC | |
3149 | IAC | |
3150 | INTFUN, TAD (101 | |
3151 | DCA TYPE | |
3152 | JMS I [CHECKC /LOOK FOR 'N' | |
3153 | -316 | |
3154 | JMP BADBGN | |
3155 | XXXFUN, CLA IAC | |
3156 | DCA FUNCTN /SET SWITCH | |
3157 | CDF 10 /1.05/ KILL ENTRY FOR 'MAIN' | |
3158 | DCA I (ALIST+14 /1.05/ BUT DO IT BEFORE THE M BUCKET | |
3159 | CDF /1.05/ CONTAINS ANYTHING USEFULL | |
3160 | JMS I [GETNAM /GET FUNC/SUBR NAME | |
3161 | JMP BADBGN | |
3162 | JMS I [LOOKUP /PUT INTO SYMBOL TABLE | |
3163 | DCA PROGNM | |
3164 | TAD PROGNM /SET UP TYPE | |
3165 | IAC | |
3166 | DCA TEMP | |
3167 | TAD STACK | |
3168 | DCA X12 /SAVE POINTER | |
3169 | DCA TEMP2 /ZERO ARG COUNTER | |
3170 | CDF 10 | |
3171 | TAD TYPE /PUT IN THE TYPE BITS | |
3172 | TAD (1000 | |
3173 | DCA I TEMP | |
3174 | CDF | |
3175 | JMS I [CHECKC /LOOK OFR ( | |
3176 | -250 | |
3177 | JMP ISITFN /IS IT A FUNCTION ? | |
3178 | ARGLUP, JMS I [GETNAM /GET THE ARG | |
3179 | JMP BADBGN | |
3180 | JMS I [LOOKUP | |
3181 | IAC | |
3182 | DCA TEMP /ADDR OF TYPE WORD | |
3183 | CDF 10 | |
3184 | TAD I TEMP | |
3185 | SZA CLA | |
3186 | JMP BADBGN /ALREADY AN ARG | |
3187 | TAD (20 | |
3188 | DCA I TEMP | |
3189 | CDF | |
3190 | CMA | |
3191 | TAD TEMP /OUTPUT ADDR OF ARG | |
3192 | JMS I [PUSH | |
3193 | ISZ TEMP2 /KEEP COUNT | |
3194 | JMS I [COMARP /LOOK FOR , OR ) | |
3195 | JMP BADBGN /NEITHER | |
3196 | JMP ARGLUP /, | |
3197 | TAD TEMP2 /) HOW MANY ARGS ? | |
3198 | CDF 10 | |
3199 | DCA I NEXT /INTO ARG LIST | |
3200 | TAD TEMP2 | |
3201 | CIA | |
3202 | DCA TEMP2 | |
3203 | TAD NEXT /SAVE ADDR OF ARG LIST | |
3204 | DCA ARGLST | |
3205 | CDF | |
3206 | TAD X12 /RESTORE THE STACK | |
3207 | DCA STACK | |
3208 | MOVARG, TAD I X12 /PUT ARGS INTO ARG LIST | |
3209 | CDF 10 | |
3210 | DCA I NEXT | |
3211 | CDF | |
3212 | ISZ TEMP2 | |
3213 | JMP MOVARG | |
3214 | JMP I [NEXTST /DO NEXT LINE | |
3215 | TYPE=WORD6 | |
3216 | ISITFN, TAD FUNCTN /IS IT A FUNCTION | |
3217 | SPA SNA CLA /WITH NO ARGS ? | |
3218 | JMP I [NEXTST /NO, WE'RE OK | |
3219 | BADBGN, JMS I [ERMSG | |
3220 | 2010 | |
3221 | JMP I [NEXTST | |
3222 | BDATA, JMS I [CHECKC /LOOK FOR A | |
3223 | -301 | |
3224 | JMP BADBGN | |
3225 | CLL CMA RAL /SET FUNCTION SWITCH | |
3226 | DCA FUNCTN /2.02/ STORE IT DUMMY!! | |
3227 | TAD (BDLIST-1 /POINTER TO LIST OF PATCHES | |
3228 | DCA X10 | |
3229 | BDLOOP, CDF 10 | |
3230 | TAD I X10 /GET PATCH LOCATION | |
3231 | CDF | |
3232 | SNA | |
3233 | JMP I [NEXTST /NO MORE PATCHES | |
3234 | DCA TEMP /SAVE PATCH ADDRESS | |
3235 | TAD BADJMP /GET ERROR JUMP | |
3236 | DCA I TEMP /STORE IT | |
3237 | JMP BDLOOP /LOOP | |
3238 | BADJMP, JMP I [BDERR | |
3239 | \f/ INITIAL SYMBOL TABLE | |
3240 | FIELD 1 | |
3241 | *2020 | |
3242 | NOPUNC | |
3243 | *20 | |
3244 | ENPUNC | |
3245 | 0 | |
3246 | BLNKCN, 111;0 /BLANK COMMON SLOT | |
3247 | ALIST, 0;0;0;0;0;0;0;0;0;0;0;0;MAIN;0;0;0;0;0;0;0;0;0;0;0;0;0 | |
3248 | HOLIST, 0 | |
3249 | FPLIST, 0 | |
3250 | DPLIST, 0 | |
3251 | INTLST, ONE | |
3252 | CMPLST, 0 | |
3253 | SNLIST, 0 | |
3254 | ONE, THREE;0;1;2000;0 | |
3255 | THREE, SIX;0;2;3000;0 | |
3256 | SIX, 0;0;3;3000;0 | |
3257 | TRUE, 0;0145;0 | |
3258 | MAIN, 0;1000;0;0111;1600 | |
3259 | FREE, 0 | |
3260 | \f/ BLOCK DATA PATCH LIST | |
3261 | BDLIST, IF /BLOCK DATA PATCH LIST | |
3262 | DOUBLE | |
3263 | DO | |
3264 | GOTO | |
3265 | CALL | |
3266 | READ | |
3267 | REWIND | |
3268 | ENDFIL | |
3269 | FORMAT | |
3270 | WRITE | |
3271 | BACKSP | |
3272 | ASSIGN | |
3273 | STOP | |
3274 | PAUZE | |
3275 | DFINFL | |
3276 | FIND | |
3277 | ITSAR | |
3278 | 0 | |
3279 | \f/ INITIALIZATION | |
3280 | *2200 | |
3281 | START, SKP /NON-CHAINED ENTRY POINT | |
3282 | JMP .+5 /CCL ENTRY | |
3283 | CIF CDF 10 /START HERE | |
3284 | JMS I (200 /COMMAND DECODE | |
3285 | 5 | |
3286 | 0624 /DEFAULT EXT IS .FT | |
3287 | TAD I L7600 /IS AN OUTPUT FILE GIVEN ? | |
3288 | SNA CLA | |
3289 | JMP MYFILE /NO, USE FORTRN.TM | |
3290 | MOVOFN, TAD I OFNAME /MOVE NAME INTO PAGE 0 | |
3291 | CDF | |
3292 | DCA I NAMEOF | |
3293 | CDF 10 | |
3294 | ISZ NAMEOF | |
3295 | ISZ OFNAME | |
3296 | ISZ OFNSIZ | |
3297 | JMP MOVOFN | |
3298 | EXTEST, TAD I (7604 /SET DEFAULT EXTENSIONS | |
3299 | SZA | |
3300 | JMP EXTSET | |
3301 | TAD I (7643 | |
3302 | SPA | |
3303 | JMP GETRA /A WAS SET.USE RA | |
3304 | AND L41 /CHECK FOR L+G | |
3305 | SNA CLA | |
3306 | TAD (0610 /USE RL | |
3307 | TAD (1404 /USE LD | |
3308 | EXTSET, DCA I (7604 | |
3309 | TAD I (7604 | |
3310 | CDF 0 | |
3311 | DCA I NAMF | |
3312 | CDF 10 | |
3313 | TAD I (7611 | |
3314 | SNA | |
3315 | TAD (1423 /.LS FOR LISTING | |
3316 | DCA I (7611 | |
3317 | TAD I (7616 | |
3318 | SNA | |
3319 | TAD (1520 /.MP FOR LOAD MAP | |
3320 | DCA I (7616 | |
3321 | EFILE, CLA IAC /OPEN PASS1 OUTPUT FILE | |
3322 | JMS I (200 | |
3323 | 3 | |
3324 | OBLOK, TMPFL2 | |
3325 | OSIZE, 0 | |
3326 | JMP OBAD /BADDIE | |
3327 | CDF | |
3328 | TAD OBLOK /SAVE STARTING BLOCK | |
3329 | DCA OUBLOK | |
3330 | TAD OBLOK | |
3331 | DCA I (OUFILE | |
3332 | TAD OSIZE | |
3333 | DCA OULEN | |
3334 | CDF 10 | |
3335 | CLA IAC | |
3336 | JMS I (200 /GET PASS2 | |
3337 | 2 | |
3338 | SPASS2, PASS2N | |
3339 | 0 | |
3340 | JMP OBAD | |
3341 | CLA IAC | |
3342 | JMS I (200 | |
3343 | 2 | |
3344 | SP2O, PAS2ON /GET PASS2 OVERLAY | |
3345 | 0 | |
3346 | JMP OBAD | |
3347 | CDF /SAVE PASS2 AND PASS2O BLOCKS | |
3348 | TAD SPASS2 | |
3349 | DCA PASS2B | |
3350 | TAD SP2O /SKIP FIRST BLOCK | |
3351 | IAC /ITS THE CORE TABLE | |
3352 | DCA I (PASS2O | |
3353 | CIF | |
3354 | JMP INITLN /GO START COMPILE | |
3355 | MYFILE, CDF /PUT DEFAULT INTO 17600 | |
3356 | TAD I NAMOF | |
3357 | DCA I NAMEOF | |
3358 | TAD I NAMOF /ALSO INTO PAGE 0 | |
3359 | CDF 10 | |
3360 | DCA I OFNAME | |
3361 | ISZ NAMOF | |
3362 | ISZ NAMEOF | |
3363 | ISZ OFNAME | |
3364 | ISZ OFNSIZ | |
3365 | JMP MYFILE | |
3366 | CLA IAC /SET DEV TO SYS | |
3367 | DCA I L7600 | |
3368 | JMP EXTEST /GO OPEN FILE | |
3369 | OBAD, CIF CDF | |
3370 | JMP BADDIE | |
3371 | OFNAME, 7601 /IGNORE DEVICE (ALWAYS USE SYS) | |
3372 | NAMEOF, TMPFIL+4 | |
3373 | NAMOF, TMPFIL | |
3374 | OFNSIZ, -3 | |
3375 | TMPFL2, 0617;2224;2216;2415 /FORTRN.TM | |
3376 | PASS2N, 2001;2323;6200;2326 /PASS2.SV | |
3377 | PAS2ON, 2001;2323;6217;2326 /PASS2O.SV | |
3378 | NAMF, TMPFIL+7 | |
3379 | L7600, | |
3380 | GETRA, 7600 /CLA | |
3381 | TAD (2201 /V3C USE RA | |
3382 | JMP EXTSET | |
3383 | L41, 41 | |
3384 | \f PAGE | |
3385 | / PROGRAM HEADER LIST | |
3386 | HDRLST, TEXT 'INTEGERFUNCTIO' | |
3387 | INTFUN | |
3388 | TEXT 'REALFUNCTION' | |
3389 | REAFUN | |
3390 | TEXT 'COMPLEXFUNCTIO' | |
3391 | CMPFUN | |
3392 | TEXT 'DOUBLEPRECISIONFUNCTIO' | |
3393 | DBLFUN | |
3394 | TEXT 'LOGICALFUNCTIO' | |
3395 | LOGFUN | |
3396 | TEXT 'FUNCTION' | |
3397 | XXXFUN | |
3398 | TEXT 'SUBROUTINE' | |
3399 | SUBRTN | |
3400 | TEXT 'BLOCKDAT' | |
3401 | BDATA | |
3402 | 0 | |
3403 | \f/ PS-8 FILE INPUT ROUTINES | |
3404 | /NEED TWO PAGES BEC. MOVING ICHAR OUT OF FIELD 1 REQUIRES | |
3405 | /ALOT OF FIELD DIDDLING. | |
3406 | *5400 | |
3407 | MORCHR, TAD (214 /FIX CHAR | |
3408 | CDF 0 /** | |
3409 | DCA I QCHAR | |
3410 | CDF 10 | |
3411 | TAD I (ICHAR | |
3412 | IAC /UPDATE ADDR | |
3413 | DCA TCHAR | |
3414 | CIF CDF 0 | |
3415 | TAD I QCHAR /RETURN VALUE IN AC | |
3416 | JMP I TCHAR | |
3417 | TCHAR, 0 | |
3418 | QCHAR, CHAR | |
3419 | / EXTENDED OPERATOR LIST | |
3420 | OPRLST, -01;-1604;ANDOPR | |
3421 | -17;-2200;OROPR | |
3422 | -05;-2100;EQOPR | |
3423 | -16;-0500;NEOPR | |
3424 | -07;-0500;GEOPR | |
3425 | -07;-2400;GTOPR | |
3426 | -14;-0500;LEOPR | |
3427 | -14;-2400;LTOPR | |
3428 | -30;-1722;XOROPR | |
3429 | -05;-2126;EQVOPR | |
3430 | 0 | |
3431 | / EXPONENT TABLE | |
3432 | PETABL, 0004;2400;0000 /1E1 | |
3433 | 0000;0000;0000 | |
3434 | 0007;3100;0000 /1E2 | |
3435 | 0000;0000;0000 | |
3436 | 0016;2342;0000 /1E4 | |
3437 | 0000;0000;0000 | |
3438 | 0033;2765;7020 /1E8 | |
3439 | 0000;0000;0000 | |
3440 | 0066;2160;6744 /1E16 | |
3441 | 6770;1000;0 | |
3442 | 0153;2356;1326 /1E32 | |
3443 | 6501;2670;2655 | |
3444 | 0325;3023;6017 /1E64 | |
3445 | 5117;7747;6466 | |
3446 | 0652;2235;6443 /1E128 | |
3447 | 7114;0164;6145 | |
3448 | 1523;2523;7565 /1E256 | |
3449 | 7734;7374;7357 | |
3450 | 3245;3430;6320 /1E512 | |
3451 | 2565;1407;2176 | |
3452 | ENDSTM, 211;"E;"N;"D;215;211;215;232 /V3C | |
3453 | /FAKE END STATEMENT USED IF PROGRAM HAS NONE | |
3454 | \f PAGE | |
3455 | \f/MAIN PART OF OS/8 INPUT ROUTINES | |
3456 | ||
3457 | ICHAR, 0 /READ CHAR FROM INPUT FILE | |
3458 | CDF 10 | |
3459 | ISZ INJMP /BUMP THREE WAY UNPACK SWITCH | |
3460 | ISZ INCHCT | |
3461 | INJMPP, JMP INJMP | |
3462 | / CDF ** | |
3463 | TAD INEOF /DID LAST READ YEILD END OF FILE ? | |
3464 | SNA CLA | |
3465 | JMP INGBUF /NO, DO ANOTHER READ | |
3466 | GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE | |
3467 | JMP ENDIN /END OF INPUT | |
3468 | INGBUF, TAD INCTR /BUMP RECORD COUNTER | |
3469 | CLL IAC | |
3470 | SNL | |
3471 | DCA INCTR /RESTORE IF IT HASN'T OVERFLOWED | |
3472 | SZL | |
3473 | ISZ INEOF /SET END OF FILE SWITCH | |
3474 | CDF 10 /** | |
3475 | CIF 0 /** | |
3476 | JMS I INHNDL /DO THE READ | |
3477 | 0210 /ONE BLOCK TO FIELD 1 | |
3478 | INBUFP, INBUF | |
3479 | INREC, 0 | |
3480 | JMP INERR /HANDLER ERROR | |
3481 | INBREC, ISZ INREC /BUMP RECORD NUMBER | |
3482 | TAD INBUFP /RESET BUFFER POINTER | |
3483 | SVIBPT, DCA INPTR /V3C | |
3484 | TAD (-601 /SET CHAR COUNT | |
3485 | DCA INCHCT | |
3486 | TAD INJMPP /RESET THREE WAY JUMP SWITCH | |
3487 | DCA INJMP | |
3488 | JMP ICHAR+1 /GO AGAIN | |
3489 | INERR, ISZ INEOF /EITHER EOF OR BADDIE | |
3490 | SMA CLA | |
3491 | JMP INBREC /END OF FILE, DO NEXT FILE | |
3492 | JMP TERR /INPUT ERROR, GIVE I F AND EXIT | |
3493 | ENDIN, TAD (ENDSTM /V3C IF NO END STATEMENT, FORCE ONE | |
3494 | JMP SVIBPT | |
3495 | ||
3496 | /ENDIN, TAD INCALL /END OF INPUT IS USR IN CORE ? | |
3497 | / TAD (-200 | |
3498 | / CIF 0 /** | |
3499 | / SZA CLA | |
3500 | / JMP I (ENDX /NO, ITS END OF PROG | |
3501 | TERR, JMS I (MESSAG /YES, BAD INPUT. WAS SQ.BRCK** | |
3502 | 311 | |
3503 | 306 | |
3504 | INJMP, HLT /3 WAY CHAR UNPACK BRANCH | |
3505 | JMP ICHAR1 | |
3506 | JMP ICHAR2 | |
3507 | ICHAR3, TAD INJMPP /RESET JUMP SWITCH | |
3508 | DCA INJMP | |
3509 | TAD I INPTR | |
3510 | AND (7400 /COMBINE THE HIGH ORDER BITS | |
3511 | CLL RTR /OF THE TWO WORDS | |
3512 | RTR | |
3513 | TAD INTMP /TO FORM THE THIRD CHAR | |
3514 | RTR | |
3515 | RTR | |
3516 | ISZ INPTR /BUMP WORD POINTER | |
3517 | JMP ICHAR1+1 /DO SOME COMMON STUFF | |
3518 | ICHAR2, TAD I INPTR /SAVE THE HIGH ORDER BITS | |
3519 | AND (7400 | |
3520 | DCA INTMP /FOR THE THIRD CHAR | |
3521 | ISZ INPTR /GO TO THE SECOND WORD | |
3522 | ICHAR1, TAD I INPTR /GET THE LOW 8 BITS | |
3523 | / CDF | |
3524 | AND (177 /AND I MEAN ONLY 8 !! | |
3525 | SNA /V3C YOU WERE WRONG - YOU MEANT ONLY 7 | |
3526 | JMP ICHAR+1 | |
3527 | TAD (-32 /IS IT ^Z (END OF FILE) | |
3528 | SNA | |
3529 | JMP GETNEW /YES, LOOK FOR THE NEXT FILE | |
3530 | TAD (232-212 | |
3531 | SNA | |
3532 | JMP ICHAR+1 /IGNORE LINE FEEDS | |
3533 | TAD (212-215 | |
3534 | SNA | |
3535 | JMP ICHARN /RETURN ON CARRIAGE RETURN ** | |
3536 | IAC | |
3537 | SNA | |
3538 | JMP ICHAR+1 /IGNORE FORM FEEDS | |
3539 | JMP I (MORCHR /** | |
3540 | ICHARN, CIF CDF 0 | |
3541 | JMP I ICHAR | |
3542 | INTMP, 0 | |
3543 | INFPTR, 7617 /POINTER TO INPUT FILE LIST | |
3544 | INEOF, 1 | |
3545 | INCHCT, | |
3546 | INNEWF, -1 /FETCH HANDLER FOR NEXT FILE | |
3547 | CDF 0 /** | |
3548 | TAD (INDEVH+1 /THIS IS WHERE IT GOES ** | |
3549 | DCA INHNDL | |
3550 | CDF 10 | |
3551 | TAD I INFPTR /GET NEXT INPUT FILE INFO | |
3552 | SNA | |
3553 | JMP I INNEWF /NO MORE FILES | |
3554 | CDF 10 /WAS CIF 10** | |
3555 | JMS I INCALL /CALL MONITOR | |
3556 | 1 /FETCH HANDLER | |
3557 | INHNDL, 0 /ENTRY ADDR GOES HERE | |
3558 | JMP INERR+3 /THIS CAN'T HAPPEN HERE | |
3559 | TAD I INFPTR /GET LENGTH | |
3560 | AND (7760 | |
3561 | SZA /A ZERO HERE MEANS >=256 BLOCKS | |
3562 | TAD (17 /PUT IN SOME MORE BITS | |
3563 | CLL CML RTR | |
3564 | RTR | |
3565 | DCA INCTR /STORE LENGTH OF FILE | |
3566 | ISZ INFPTR | |
3567 | TAD I INFPTR /GET STARTING RECORD NUMBER | |
3568 | DCA INREC | |
3569 | ISZ INFPTR | |
3570 | DCA INEOF /CLEAR EOF FLAG | |
3571 | ISZ INNEWF | |
3572 | JMP I INNEWF | |
3573 | INCTR, 0 | |
3574 | INCALL, 200 /CHANGED TO 7700 AFTER FIRST TIME | |
3575 | INPTR, 0 | |
3576 | PAGE | |
3577 | \f/ KEYWORD LIST | |
3578 | CMDLST, -1106;0;IF /IF | |
3579 | -0417 | |
3580 | -2502 | |
3581 | -1405 | |
3582 | -2022 | |
3583 | -0503 | |
3584 | -1123 | |
3585 | -1117;0;DOUBLE /DOUBLE PRECISION | |
3586 | -0417;0;DO /DO | |
3587 | -0717 | |
3588 | -2417;0;GOTO /GOTO | |
3589 | -0317 | |
3590 | -1515 | |
3591 | -1716;0;COMMON /COMMON | |
3592 | -0317 | |
3593 | -1520 | |
3594 | -1405;0;COMPLE /COMPLEX | |
3595 | -0317 | |
3596 | -1624 | |
3597 | -1116 | |
3598 | -2505;0;NEXTST /CONTINUE | |
3599 | -0301 | |
3600 | -1414;0;CALL /CALL | |
3601 | -2205 | |
3602 | -0114;0;REAL /REAL | |
3603 | -2205 | |
3604 | -0104;0;READ /READ | |
3605 | -2205 | |
3606 | -2711 | |
3607 | -1604;0;REWIND /REWIND | |
3608 | -2205 | |
3609 | -2425 | |
3610 | -2216;0;RETURN /RETURN | |
3611 | -0516 | |
3612 | -0406 | |
3613 | -1114;0;ENDFIL /ENDFILE | |
3614 | -0516;0;XEND /END | |
3615 | -0411 | |
3616 | -1505 | |
3617 | -1623 | |
3618 | -1117;0;DIMENS /DIMENSION | |
3619 | -0401 | |
3620 | -2401;0;DATA /DATA | |
3621 | -0617 | |
3622 | -2215 | |
3623 | -0124;0;FORMAT /FORMAT | |
3624 | -2722 | |
3625 | -1124;0;WRITE /WRITE | |
3626 | -0521 | |
3627 | -2511 | |
3628 | -2601 | |
3629 | -1405 | |
3630 | -1603;0;EQUIV /EQUIVALENCE | |
3631 | -0405 | |
3632 | -0611 | |
3633 | -1605 | |
3634 | -0611 | |
3635 | -1405;0;DFINFL /DEFINEFILE | |
3636 | -1116 | |
3637 | -2405 | |
3638 | -0705;0;INTEGE /INTEGER | |
3639 | -1417 | |
3640 | -0711 | |
3641 | -0301;0;LOGICA /LOGICAL | |
3642 | -0530 | |
3643 | -2405 | |
3644 | -2216 | |
3645 | -0114;0;EXTERN /EXTERNAL | |
3646 | -0201 | |
3647 | -0313 | |
3648 | -2320 | |
3649 | -0103;0;BACKSP /BACKSPACE | |
3650 | -0123 | |
3651 | -2311 | |
3652 | -0716;0;ASSIGN /ASSIGN | |
3653 | -2001 | |
3654 | -2523;0;PAUZE /PAUSE | |
3655 | -2324 | |
3656 | -1720;0;STOP /STOP | |
3657 | -0611 | |
3658 | -1604;0;FIND /FIND | |
3659 | 0 /END OF LIST | |
3660 | $ | |
3661 | \f |