Commit | Line | Data |
---|---|---|
81e70d48 PH |
1 | |
2 | / ############ ######### ######### | |
3 | / ############ ######### ######### | |
4 | / ### ### ### ### ### ### | |
5 | / ### ### ### ### ### ### | |
6 | / ### ### ### ### ### | |
7 | / ### ### ### ### ### | |
8 | / ############ ############### ######### | |
9 | / ############ ############### ######### | |
10 | / ### ### ### ### | |
11 | / ### ### ### ### | |
12 | / ### ### ### ### ### | |
13 | / ### ### ### ### ### | |
14 | / ### ### ### ######### | |
15 | / ### ### ### ######### | |
16 | / | |
17 | / | |
18 | / ######### ######### ### | |
19 | / ######### ######### ### | |
20 | / ### ### ### ### ### | |
21 | / ### ### ### ### ### | |
22 | / ### ### ### ### | |
23 | / ### ### ### ### | |
24 | / ### ############### ### | |
25 | / ### ############### ### | |
26 | / ### ### ### ### | |
27 | / ### ### ### ### | |
28 | / ### ### ### ### ### | |
29 | / ### ### ### ### ### | |
30 | / ######### ### ### ############### | |
31 | / ######### ### ### ############### | |
32 | / | |
33 | / | |
34 | / ######### | |
35 | / ######### | |
36 | / ### ### | |
37 | / ### ### | |
38 | / ### | |
39 | / ### | |
40 | / ######### ######### FROM N.WIRTH | |
41 | / ######### ######### ETH - ZUERICH | |
42 | / ### | |
43 | / ### | |
44 | / ### ### | |
45 | / ### ### | |
46 | / ######### | |
47 | / ######### | |
48 | / | |
49 | / | |
50 | /IMPLEMENTED ON A PDP-8/E COMPUTER WITH 28K-WORDS OF MEMORY | |
51 | /BY | |
52 | /PROF. HEINZ STEGBAUER | |
53 | /HTL-MOEDLING, IN 1979 | |
54 | ||
55 | EJECT P A S C A L - S | |
56 | VERSION=2 | |
57 | ||
58 | /C O R E L A Y O U T : | |
59 | ||
60 | ||
61 | ||
62 | /FIELD 0 0000 - 5777 INTERPRETER | |
63 | / 6000 - 6777 FILE- AND DEVICE BUFFERS | |
64 | / 7000 - 7577 COMPILER (INSYMBOL, NEXTCH) | |
65 | / 7600 - 7777 OS/8 - RESIDENT PART | |
66 | ||
67 | /FIELD 1 0000 - 7577 INTERMEDIATE CODE | |
68 | / 7600 - 7777 OS/8 - RESIDENT PART | |
69 | ||
70 | /FIELD 2 0000 - 3777 SYMBOL-TABLE | |
71 | / 4000 - XXXX STRING-TABLE | |
72 | / XXXX - 6377 CONSTANT-TABLE | |
73 | / 6400 - 7377 ARRAY-TABLE | |
74 | / 7400 - 7777 BLOCK-TABLE | |
75 | ||
76 | ||
77 | ||
78 | /AT COMPILETIME: | |
79 | ||
80 | /FIELD 3 0000 - 3777 NAMES OF SYMBOL-TABLE | |
81 | / 4000 - 7177 FSYS, SET-CONSTANTS, LISTS AND | |
82 | / TABLES, ERROR ROUTINES | |
83 | ||
84 | /FIELD 4 0000 - 6377 COMPILER | |
85 | / 6400 - 7777 AUXILIARY ROUTINES | |
86 | ||
87 | /FIELD 5 0000 - 7777 STACK FOR COMPILER OPERATION | |
88 | ||
89 | /FIELD 6 0000 - 7777 LONG ERROR MESSAGES | |
90 | ||
91 | ||
92 | ||
93 | /AT RUNTIME: | |
94 | ||
95 | /FIELD 3 0000 - 7777 /S T A C K (4K WORDS OF 48 BITS) | |
96 | /FIELD 4 0000 - 7777 | |
97 | /FIELD 5 0000 - 7777 | |
98 | /FIELD 6 0000 - 7777 | |
99 | ||
100 | ||
101 | CODEFIELD=10 | |
102 | TABLEFIELD=20 | |
103 | NAMEFIELD=30 | |
104 | SETFIELD=30 | |
105 | COMPFIELD=40 | |
106 | PUSHFIELD=50 | |
107 | ERRFIELD=60 | |
108 | STACKFIELD=30 | |
109 | \f/S T R U C T U R E O F T A B L E S : | |
110 | ||
111 | /SYMBOL-TABLE (4 WORDS PER ENTRY, MAX. 512 ENTRIES) | |
112 | /------------ | |
113 | ||
114 | TAB=0000 | |
115 | ||
116 | LINK=TAB /WORD 0, BITS 0-11 | |
117 | OBJ=TAB+1 /WORD 1, BITS 0-5 | |
118 | TYP=TAB+1 /WORD 1, BITS 6-11 | |
119 | REF=TAB+2 /WORD 2, BITS 0-5 | |
120 | NORMAL=TAB+2 /WORD 2, BIT 6 | |
121 | LEV=TAB+2 /WORD 2, BITS 7-11 | |
122 | ADR=TAB+3 /WORD 3, BITS 0-11 | |
123 | ||
124 | ||
125 | /STRING-TABLE (ARRAY[0:N] OF CHAR, 6 BITS/CHAR,FROM 4000 UPWARDS) | |
126 | /------------ | |
127 | ||
128 | ||
129 | /CONSTANT-TABLE (4 WORDS PER ENTRY, FROM 6400 DOWNWARDS) | |
130 | /-------------- | |
131 | ||
132 | ||
133 | /ARRAY-TABLE (8 WORDS PER ENTRY, MAX. 64 ENTRIES) | |
134 | /----------- | |
135 | ||
136 | ATAB=6400 | |
137 | ||
138 | / /WORD 0 UNUSED! | |
139 | INXTYP=ATAB+1 /WORD 1 | |
140 | ELTYP=ATAB+2 /WORD 2 | |
141 | ELREF=ATAB+3 /WORD 3 | |
142 | LOW=ATAB+4 /WORD 4 | |
143 | HIGH=ATAB+5 /WORD 5 | |
144 | ELSIZE=ATAB+6 /WORD 6 | |
145 | SIZE=ATAB+7 /WORD 7 | |
146 | ||
147 | ||
148 | /BLOCK-TABLE (4 WORDS PER ENTRY, MAX. 64 ENTRIES) | |
149 | /----------- | |
150 | ||
151 | BTAB=7400 | |
152 | ||
153 | LAST=BTAB /WORD 0 | |
154 | LASTPAR=BTAB+1 /WORD 1 | |
155 | PSIZE=BTAB+2 /WORD 2 | |
156 | VSIZE=BTAB+3 /WORD 3 | |
157 | \f/A S S E M B L E R D E F I N I T I O N S: | |
158 | ||
159 | L0001=CLA CLL IAC | |
160 | L0002=CLA STL RTL | |
161 | L0003=CLA STL IAC RAL | |
162 | L0004=CLA CLL IAC RTL | |
163 | L0006=CLA STL IAC RTL | |
164 | L0100=CLA CLL IAC BSW | |
165 | L2000=CLA STL RTR | |
166 | L4000=CLA STL RAR | |
167 | L7777=CLA CLL CMA | |
168 | L7776=CLA CLL CMA RAL | |
169 | L7775=CLA CLL CMA RTL | |
170 | L3777=CLA CLL CMA RAR | |
171 | L5777=CLA CLL CMA RTR | |
172 | \f/A R I T H M E T I C D E F I N I T I O N S: | |
173 | ||
174 | ||
175 | /MEMORY REFERENCED INSTRUCTIONS: | |
176 | ||
177 | FIXMRI GET=0000 | |
178 | FIXMRI ADD=1000 | |
179 | FIXMRI SUB=2000 | |
180 | FIXMRI MUL=3000 | |
181 | FIXMRI DIV=4000 | |
182 | FIXMRI MOD=5000 /ALSO: JMP=5000 | |
183 | FIXMRI PUT=6000 | |
184 | ||
185 | ||
186 | ||
187 | /OPERATE CLASS INSTRUCTIONS: | |
188 | ||
189 | NORM=7200 /REAL | |
190 | READREAL=7201 | |
191 | WRITEREAL=7202 | |
192 | TRUNC=7203 | |
193 | ROUND=7206 | |
194 | RSQUARE=7205 | |
195 | ||
196 | ZERO=7204 /BOTH TYPES | |
197 | ABSVAL=7000 | |
198 | NEGATE=7004 | |
199 | WRITELINE=7006 | |
200 | ||
201 | READINTEGER=7001 /INTEGER | |
202 | WRITEINTEGER=7002 | |
203 | FLOAT=7003 | |
204 | ISQUARE=7005 | |
205 | ||
206 | ||
207 | ||
208 | /SKIP - INSTRUCTIONS: | |
209 | ||
210 | SKIP=SKP | |
211 | SKEQ=SZA | |
212 | SKNE=SNA | |
213 | SKLT=SMA | |
214 | SKLE=SMA SZA | |
215 | SKGT=SPA SNA | |
216 | SKGE=SPA | |
217 | ||
218 | ||
219 | ||
220 | AAAAAA=JMS I 44 /ENTER MACRO MODE | |
221 | EEEEEE=0000 /RETURN TO PDP8 MODE | |
222 | ||
223 | INT=0177 | |
224 | REAL=7777 | |
225 | \f/C O M P I L E R D E F I N I T I O N S: | |
226 | DECIMAL | |
227 | /S Y M B O L S: | |
228 | ||
229 | INTCON=0 | |
230 | REALCON=1 | |
231 | CHARCON=2 | |
232 | STRING=3 | |
233 | NOTSY=4 | |
234 | PLUS=5 | |
235 | MINUS=6 | |
236 | TIMES=7 | |
237 | IDIVSY=8 | |
238 | RDIVSY=9 | |
239 | IMODSY=10 | |
240 | ANDSY=11 | |
241 | ORSY=12 | |
242 | EQL=13 | |
243 | NEQ=14 | |
244 | GTR=15 | |
245 | GEQ=16 | |
246 | LSS=17 | |
247 | LEQ=18 | |
248 | LPARENT=19 | |
249 | RPARENT=20 | |
250 | LBRACK=21 | |
251 | RBRACK=22 | |
252 | COMMA=23 | |
253 | SEMICOLON=24 | |
254 | PERIOD=25 | |
255 | COLON=26 | |
256 | BECOMES=27 | |
257 | CONSTSY=28 | |
258 | TYPESY=29 | |
259 | VARSY=30 | |
260 | FUNCTIONSY=31 | |
261 | PROCEDURESY=32 | |
262 | ARRAYSY=33 | |
263 | RECRDSY=34 | |
264 | PROGRAMSY=35 | |
265 | IDENT=36 | |
266 | BEGINSY=37 | |
267 | IFSYM=38 | |
268 | CASESY=39 | |
269 | REPTSY=40 | |
270 | WHILSY=41 | |
271 | FORSY=42 | |
272 | ENDSY=43 | |
273 | ELSESY=44 | |
274 | UNTILSY=45 | |
275 | OFSY=46 | |
276 | DOSY=47 | |
277 | TOSY=48 | |
278 | DOWNTOSY=49 | |
279 | THENSY=50 | |
280 | ||
281 | /O B J E C T S: | |
282 | ||
283 | KONSTANT=0 | |
284 | VARIABLE=1 | |
285 | TYPE1=2 | |
286 | PROZEDURE=3 | |
287 | FUNKTION=4 | |
288 | ||
289 | ||
290 | ||
291 | ||
292 | ||
293 | /T Y P E S: | |
294 | ||
295 | NOTYP=0 | |
296 | INTS=1 | |
297 | REALS=2 | |
298 | BOOLS=3 | |
299 | CHARS=4 | |
300 | ARRAY=5 | |
301 | RECORD=6 | |
302 | ||
303 | ||
304 | ||
305 | ||
306 | ||
307 | /P R O C E D U R E S: | |
308 | ||
309 | BLOCK=0 | |
310 | STATEMENT=1 | |
311 | ASSIGNMENT=2 | |
312 | COMPOUNDSTATEMENT=3 | |
313 | IFSTATEMENT=4 | |
314 | CASESTATEMENT=5 | |
315 | REPEATSTATEMENT=6 | |
316 | WHILESTATEMENT=7 | |
317 | FORSTATEMENT=8 | |
318 | STANDPROC=9 | |
319 | SELECTOR=10 | |
320 | CALL=11 | |
321 | STANDFCT=12 | |
322 | FACTOR=13 | |
323 | TERM=14 | |
324 | SIMPLEEXPRESSION=15 | |
325 | EXPRESSION=16 | |
326 | CONDECLARE=17 | |
327 | TYPDECLARE=18 | |
328 | VARDECLARE=19 | |
329 | PRODECLARE=20 | |
330 | CONSTANT=21 | |
331 | ARRAYTYP=22 | |
332 | TYPE=23 | |
333 | PARAMETERLIST=24 | |
334 | ONECASE=25 | |
335 | ||
336 | ||
337 | /P R O G R A M P A R A M E T E R S: | |
338 | ||
339 | TMAX=512 /MAX. NUMBER OF IDENTIFIERS | |
340 | AMAX=64 /MAX. NUMBER OF ARRAYS | |
341 | BMAX=64 /MAX. NUMBER OF BLOCKS (PROCEDURES+RECORDS) | |
342 | CMAX=1980 /MAX. SIZE OF INTERMEDIATE CODE | |
343 | CSMAX=30 /MAX. NUMBER OF CASES | |
344 | LMAX=16 /MAX. NUMBER OF LEVELS | |
345 | LLNG=80 /MAX. LENGTH OF INPUT LINE | |
346 | ALNG=8 /NO. OF SIGNIFICANT CHAR'S IN IDENTIFIERS | |
347 | ||
348 | OCTAL | |
349 | \f FIELD 0 | |
350 | /P A G E Z E R O : | |
351 | ||
352 | *4 | |
353 | EOF, 0 /END OF FILE SWITCH (BOOLEAN) | |
354 | EOLN, 1 /END OF LINE SWITCH ( - " - ) | |
355 | CC, 0 /CHARACTER-COUNTER | |
356 | ERRSW, 0 /ERROR IN LINE SWITCH | |
357 | ||
358 | *10 | |
359 | XR10, 0 /ONE AUTOINDEX REGISTER | |
360 | ||
361 | *20 | |
362 | PC, 0 /P R O G R A M - C O U N T E R | |
363 | ||
364 | /I N S T R U C T I O N - R E G I S T E R | |
365 | IRF, 0 /OP-CODE | |
366 | IRX, 0 /LEVEL | |
367 | IRY, 0 /ADDRESS OR VALUE | |
368 | ||
369 | /S T A C K - P O I N T E R S | |
370 | B, 0 /BASE INDEX | |
371 | T, 0 /STACK POINTER (SIMPLE INDEX) | |
372 | T3, 0 /= 4*T + 3 (ADDRESS OF WORD 3) | |
373 | T3T, 0 /T3 FOR ROUTINE 'TOSTACK' | |
374 | LOOK, 240 /NEXT CHARACTER (LOOK AHEAD) | |
375 | ||
376 | /----------- PAGE 0 LOC'S OF ARITHMETIC PACKAGE ---------------- | |
377 | *32 | |
378 | BCD, 0 /BINARY CODED DECIMAL DIGIT | |
379 | CHAR, 240 /CURRENT CHARACTER | |
380 | M, 22 /OUTPUT FORMAT PARAMETERS | |
381 | N, 0 /(DEFAULT VALUES: M=18, N=0) | |
382 | ||
383 | ACX, 0 / A C - R E G I S T E R | |
384 | ACS, 0 | |
385 | AC0, 0 | |
386 | AC1, 0 | |
387 | AC2, 0 | |
388 | AC3, 0 | |
389 | ||
390 | INTERPC /POINTER TO MACRO-INTERPRETER | |
391 | ||
392 | MQ1, 0 / M Q - R E G I S T E R | |
393 | MQ2, 0 | |
394 | MQ3, 0 | |
395 | ||
396 | OP0, 0 / O P - R E G I S T E R | |
397 | OP1, 0 | |
398 | OP2, 0 | |
399 | OP3, 0 | |
400 | OPX, 0 | |
401 | OPS, 0 | |
402 | MIN4, -4 /-4 (COUNTING WORDS) | |
403 | MIN44, -44 /-36 (COUNTING BITS) | |
404 | OS8, 7600 | |
405 | ||
406 | H1, 0 /4 GENERAL TEMPORARIES | |
407 | H2, 0 | |
408 | H3, 0 | |
409 | H4, 0 | |
410 | ||
411 | /NEW INSTRUCTIONS USED ALSO BY ARITHMETIC PACKAGE: | |
412 | ||
413 | HALVE=JMS I . /AC:=AC DIV 2 (SHIFT RIGHT) | |
414 | RACR | |
415 | DOUBLE=JMS I . /AC:=2*AC (SHIFT LEFT) | |
416 | RACL | |
417 | CLEAR=JMS I . /AC := 0 | |
418 | CLAC | |
419 | LOAD=CLEAR /AC := CONTENTS OF ACCUMULATOR (12 BIT INT.) | |
420 | ||
421 | READC=JMS I . /GET NEXT CHAR FROM INPUT DEVICE | |
422 | PTREAD, XNEXTCH /XREAD AT RUNTIME | |
423 | PRINTC=JMS I . /SEND CHAR TO OUTPUT DEVICE | |
424 | PTPRINT,XPRINT | |
425 | ZPRINT, XPRINT /CONSTANT POINTER TO XPRINT | |
426 | CRLF=JMS I . | |
427 | XCRLF | |
428 | SNALF=JMS I . /SKIP ON NOT ALFABETIC CHAR. (LETTER) | |
429 | XSNALF | |
430 | SKDIG=JMS I . /SKIP ON DIGIT | |
431 | XSKDIG | |
432 | BREAK=JMS I . /CHECK FOR CTRL-C | |
433 | XBREAK | |
434 | HALT=JMS I . /RUN-TIME ERROR HANDLING | |
435 | PTHALT, ERR21 /XHALT AT RUNTIME | |
436 | /--------------------------------------------------------------- | |
437 | ||
438 | ||
439 | /MACRO INSTRUCTIONS USED BY INTERPRETER: | |
440 | ||
441 | *100 | |
442 | ERROR=JMS I . /NON FATAL COMPILER ERRORS | |
443 | ZERROR | |
444 | FATAL=JMS I . /FATAL COMPILER ERRORS | |
445 | ZFATAL | |
446 | OFTAB=JMS I . /GET INFO FROM SYMBOL-TABLE | |
447 | ZOFTAB | |
448 | OFATAB=JMS I . /GET INFO FROM ARRAY-TABLE | |
449 | ZOFATAB | |
450 | OFBTAB=JMS I . /GET INFO FROM BLOCK-TABLE | |
451 | ZOFTAB | |
452 | OFDISPLAY=JMS I . /GET INFO FROM DISPLAY | |
453 | ZOFDISP | |
454 | TODISPLAY=JMS I . /PUT INFO INTO DISPLAY | |
455 | ZTODISP | |
456 | GETCONST=JMS I . /GET CONSTANT | |
457 | ZOFCONST | |
458 | CONTINUE=JMP I . | |
459 | ILOOP | |
460 | BUMP=JMS I . /MOVE STACK POINTER | |
461 | XBUMP | |
462 | ||
463 | SDF=JMS . /CHANGE TO TOP OF STACK - DATA FIELD | |
464 | 0 | |
465 | XSDF, CDF /VARIABLE! | |
466 | JMP I .-2 | |
467 | ||
468 | POPONE=JMS I . /POP ONE WORD (WORD 3 INTO AC) | |
469 | XPOPONE | |
470 | POPVAL=JMS I . /POP FOUR WORDS | |
471 | XPOPVAL | |
472 | POPNUM=JMS I . /POP NUMBER (=POP 4 WORDS AND UNPACK) | |
473 | XPOPNUM | |
474 | PUSHONE=JMS I . /PUSH ONE WORD | |
475 | XPUSHONE | |
476 | PUSHVAL=JMS I . /PUSH FOUR WORDS | |
477 | XPUSHVAL | |
478 | PUSHNUM=JMS I . /PUSH NUMBER (= PACK + PUSHVAL | |
479 | XPUSHNUM | |
480 | TOSTACK=JMS I . /INSERT ONE WORD INTO STACK[T3T] | |
481 | XTOSTACK | |
482 | OFCODE=JMS I . /GET INTERMEDIATE INSTRUCTION | |
483 | XOFCODE | |
484 | ||
485 | /LOCATIONS USED BY I/O-FILE HANDLING: | |
486 | ||
487 | IBUFFER=6000 /INPUT FILE BUFFER | |
488 | OBUFFER=7000 /OUTPUT FILE BUFFER | |
489 | IDEVBUF=6400 /PAGE OF INPUT DEVICE HANDLER | |
490 | ODEVBUF=6600 /PAGE OF OUTPUT DEVICE HANDLER | |
491 | ||
492 | IDEVH, 0 /ENTRY POINT OF INPUT DEVICE HANDLER | |
493 | ODEVH, 0 /ENTRY POINT OF OUTPUT DEVICE HANDLER | |
494 | NAME, ZBLOCK 4 /NAME OF OUTPUT FILE | |
495 | DEVNO, 0 /OUTPUT DEVICE NUMBER | |
496 | LEMPTY, 0 / -LENGTH OF EMPTY | |
497 | MBLOCKS,0 /COUNTING WRITTEN BLOCKS | |
498 | OBP, OBUFFER /BUFFER POINTER (SEE PUTC) | |
499 | OC3, -3 /3-CHARACTER SWITCH (SEE PUTC) | |
500 | ||
501 | I37, DCA CHAR /HALT PROGRAM - CLOSE OUTPUT FILE | |
502 | TAD [232 /WRITE EOF-MARK | |
503 | PRINTC /FILL REST OF BUFFER WITH ZEROES | |
504 | TAD [OBUFFER | |
505 | CIA | |
506 | TAD OBP | |
507 | SZA CLA | |
508 | JMP .-5 | |
509 | L7777 /COMPUTE ACTUAL LENGTH | |
510 | TAD LEMPTY /OF OUTPUT FILE | |
511 | CIA | |
512 | TAD MBLOCKS | |
513 | DCA ALOF | |
514 | CIF 10 | |
515 | TAD DEVNO | |
516 | JMS I [7700 /CALL USR TO CLOSE OUTPUT FILE | |
517 | 4 | |
518 | NAME | |
519 | ALOF, 0 | |
520 | ERRORD, HALT | |
521 | JMP I OS8 /RETURN TO KEYBOARD MONITOR | |
522 | \f/INSTRUCTION DECODER AND DISPATCH ROUTINE | |
523 | ||
524 | *200 | |
525 | ISTART, CLA CLL /STARTING ADDRESS | |
526 | DCA EOF | |
527 | L0001 | |
528 | DCA EOLN | |
529 | TAD [240 | |
530 | DCA CHAR | |
531 | TAD [240 | |
532 | DCA LOOK | |
533 | CLEAR | |
534 | DCA T /INITIALIZE THE STACK: | |
535 | BUMP | |
536 | PUSHVAL /S[1].I := 0 | |
537 | BUMP | |
538 | PUSHVAL /S[2].I := 0 | |
539 | BUMP | |
540 | PUSHVAL /S[3].I := 0 | |
541 | BUMP | |
542 | L0001 | |
543 | OFBTAB;LAST | |
544 | DCA H4 | |
545 | TAD H4 | |
546 | PUSHONE /S[4].I := BTAB[1].LAST | |
547 | DCA B /B := 0 | |
548 | L0001 | |
549 | DCA IRX | |
550 | TODISPLAY /DISPLAY[1] := 0 | |
551 | L0002 | |
552 | OFBTAB;VSIZE | |
553 | TAD MIN2 | |
554 | DCA T | |
555 | BUMP /T := BTAB[2].VSIZE - 1 | |
556 | TAD H4 | |
557 | OFTAB;ADR | |
558 | DCA PC /PC := TAB[ S[4].I ].ADR | |
559 | ||
560 | ILOOP, BREAK | |
561 | CLL /GET CURRENT INSTRUCTION | |
562 | TAD PC | |
563 | OFCODE | |
564 | MQL | |
565 | MQA | |
566 | BSW | |
567 | AND [77 | |
568 | DCA IRF | |
569 | MQA | |
570 | AND [77 | |
571 | DCA IRX | |
572 | STL | |
573 | TAD PC | |
574 | OFCODE | |
575 | DCA IRY | |
576 | ISZ PC /PC := PC + 1 | |
577 | ||
578 | TAD JUMP | |
579 | TAD IRF | |
580 | DCA .+1 | |
581 | HLT /JUMP TO INSTRUCTION ROUTINE | |
582 | JUMP, JMP I ILIST | |
583 | MIN2, -2 | |
584 | \f/INSTRUCTIONS OF STACK COMPUTER - ADDRESS TABLE: | |
585 | ||
586 | ILIST, I00 /LOAD ADDRESS | |
587 | I01 /LOAD VALUE | |
588 | I02 /LOAD INDIRECT | |
589 | I03 /UPDATE DISPLAY | |
590 | ZBLOCK 4 /CODES 4 - 7 UNUSED! | |
591 | I08 /CALL STANDERD FUNCTION | |
592 | I09 /OFFSET | |
593 | I10 /JUMP | |
594 | I11 /CONDITIONAL JUMP | |
595 | I12 /SWITCH CASE | |
596 | ILOOP /CODE 13 USED INTERNALLY! | |
597 | I14 /FOR1UP | |
598 | I15 /FOR2UP | |
599 | I16 /FOR1DOWN | |
600 | I17 /FOR2DOWN | |
601 | I18 /MARK STACK | |
602 | I19 /CALL | |
603 | I20 /INDEX1 | |
604 | I21 /INDEX | |
605 | I22 /LOAD BLOCK | |
606 | I23 /COPY BLOCK | |
607 | I24 /LITERAL | |
608 | I25 /LOAD CONSTANT | |
609 | I26 /FLOAT | |
610 | I27 /READ | |
611 | I28 /WRITE STRING | |
612 | I29 /WRITE1 (DEFAULT FIELD WIDTH) | |
613 | I30 /WRITE2 ( :M ) | |
614 | I31 /WRITE3 ( :M :N ) | |
615 | I32 /EXIT PROCEDURE | |
616 | I33 /EXIT FUNCTION | |
617 | I34 /LOAD ABSOLUTE | |
618 | I35 /LOGICAL NOT | |
619 | I36 /NEGATE | |
620 | PTI37, 7600 /HALT (BECOMES I37 IF FILE I/O!) | |
621 | I38 /STORE | |
622 | ZBLOCK 11 /CODES 39 - 47 UNUSED! | |
623 | I48 /ARITHMETIC OPERATIONS | |
624 | I49 /COMPARE INTEGERS | |
625 | I50 /COMPARE REALS | |
626 | I51 /LOGICAL OR | |
627 | I52 /LOGICAL AND | |
628 | ZBLOCK 10 /CODES 53 - 60 UNUSED! | |
629 | I61 /ASCII | |
630 | I62 /READLN | |
631 | I63 /WRITELN | |
632 | ||
633 | \f/INSTRUCTIONS OF STACK COMPUTER (A) | |
634 | ||
635 | I00, BUMP /LOAD ADDRESS | |
636 | OFDISPLAY | |
637 | TAD IRY | |
638 | PUSHONE | |
639 | CONTINUE | |
640 | ||
641 | I01, BUMP /LOAD VALUE | |
642 | OFDISPLAY | |
643 | TAD IRY | |
644 | POPVAL | |
645 | PUSHVAL | |
646 | CONTINUE | |
647 | ||
648 | I02, BUMP /LOAD INDIRECT | |
649 | OFDISPLAY | |
650 | TAD IRY | |
651 | POPONE | |
652 | POPVAL | |
653 | PUSHVAL | |
654 | CONTINUE | |
655 | ||
656 | I03, TAD IRX /UPDATE DISPLAY | |
657 | CIA | |
658 | TAD IRY | |
659 | DCA H1 | |
660 | TAD B | |
661 | DCA H3 | |
662 | UPDIS, TAD H3 | |
663 | TODISPLAY | |
664 | L7777 | |
665 | TAD IRX | |
666 | DCA IRX | |
667 | L0002 | |
668 | TAD H3 | |
669 | POPONE | |
670 | DCA H3 | |
671 | ISZ H1 | |
672 | JMP UPDIS | |
673 | CONTINUE | |
674 | ||
675 | I08, TAD IRY /CALL STANDARD FUNCTION | |
676 | TAD (JMS I STDFUNCT | |
677 | DCA .+2 | |
678 | POPNUM | |
679 | STFJMS, JMS . / J M S TO REQUESTED FUNCTION | |
680 | PUSHNUM | |
681 | CONTINUE | |
682 | ||
683 | STDFUNCT,XABS /0 | |
684 | XABS /1 | |
685 | XISQU /2 | |
686 | XRSQU /3 | |
687 | XODD /4 | |
688 | XCHR /5 | |
689 | STFJMS /6 | |
690 | XSUCC /7 | |
691 | XPRED /8 | |
692 | XROUND /9 | |
693 | RTRUNC /10 | |
694 | XSIN /11 | |
695 | XCOS /12 | |
696 | XEXP /13 | |
697 | XLOG /14 | |
698 | XSQRT /15 | |
699 | XATN /16 | |
700 | XEOF /17 | |
701 | XEOLN /18 | |
702 | XRAND /19 | |
703 | ||
704 | I09, POPONE /OFFSET | |
705 | TAD IRY | |
706 | PUSHONE | |
707 | CONTINUE | |
708 | ||
709 | I10, TAD IRY /JUMP | |
710 | DCA PC | |
711 | CONTINUE | |
712 | ||
713 | I11, POPONE /CONDITIONAL JUMP | |
714 | CLL RAR | |
715 | TAD IRY | |
716 | SNL | |
717 | DCA PC | |
718 | L7777 | |
719 | BUMP | |
720 | CONTINUE | |
721 | ||
722 | I12, POPVAL /SWITCH CASE | |
723 | L4000 | |
724 | AND AC1 | |
725 | CLL RAL | |
726 | TAD AC3 | |
727 | SZL | |
728 | CIA | |
729 | DCA H1 | |
730 | L7777 | |
731 | BUMP | |
732 | SCASE, CLL | |
733 | TAD IRY | |
734 | OFCODE | |
735 | TAD (-1500 /-1300 | |
736 | SZA CLA | |
737 | ERRORC, HALT /C A S E E R R O R ! | |
738 | STL | |
739 | TAD IRY | |
740 | OFCODE | |
741 | CIA | |
742 | TAD H1 | |
743 | SNA CLA | |
744 | JMP .+4 | |
745 | ISZ IRY | |
746 | ISZ IRY /(INCREMENTS, DOESN'T SKIP!) | |
747 | JMP SCASE | |
748 | IAC STL | |
749 | TAD IRY | |
750 | OFCODE | |
751 | DCA PC | |
752 | CONTINUE | |
753 | ||
754 | /I13 ... INTERNAL CODE (MARKS CASE SWITCH LIST) | |
755 | ||
756 | ||
757 | XEOF, 0 | |
758 | TAD EOF | |
759 | JMP .+3 | |
760 | XEOLN, 0 | |
761 | TAD EOLN | |
762 | LOAD | |
763 | BUMP | |
764 | JMP STFJMS+1 | |
765 | ||
766 | XSUCC, 0 | |
767 | L0001 | |
768 | JMP XCHR+1 | |
769 | XPRED, 0 | |
770 | L7777 | |
771 | JMP XCHR+1 | |
772 | XCHR, 0 | |
773 | TAD AC3 | |
774 | AND [77 | |
775 | LOAD | |
776 | JMP STFJMS+1 | |
777 | ||
778 | PAGE | |
779 | \f/INSTRUCTIONS OF STACK COMPUTER (B+C) | |
780 | ||
781 | I14, TAD UPSKIP /FOR1UP | |
782 | SKP | |
783 | I16, TAD DOSKIP /FOR1DOWN | |
784 | DCA FORUD1 | |
785 | L7777 /COMMON ROUTINE: | |
786 | TAD T | |
787 | POPNUM | |
788 | AAAAAAAAAAAAAAAA | |
789 | PUT INT&FORH1 | |
790 | EEEEEEEEEEEEEEEE | |
791 | POPNUM | |
792 | AAAAAAAAAAAAAAAA | |
793 | SUB INT&FORH1 | |
794 | FORUD1, SKGE /OR SKLE | |
795 | JMP FOR1EX | |
796 | GET INT&FORH1 | |
797 | EEEEEEEEEEEEEEEE | |
798 | L7776 | |
799 | TAD T | |
800 | POPONE | |
801 | PUSHNUM | |
802 | CONTINUE | |
803 | ||
804 | FOR1EX, EEEEEEEEEEEEEEEE | |
805 | TAD IRY | |
806 | DCA PC | |
807 | L7775 | |
808 | BUMP | |
809 | CONTINUE | |
810 | ||
811 | /NOTE THE STACK SITUATION: | |
812 | / | |
813 | / S[ T ] ... FINAL VALUE | |
814 | / S[T-1] ... INITIAL VALUE | |
815 | / S[T-2] ... ADDRESS OF CONTROL VARIABLE | |
816 | ||
817 | I15, TAD UPADD /FOR2UP | |
818 | DCA FORUD2 | |
819 | TAD UPSKIP | |
820 | JMP .+4 | |
821 | I17, TAD DOSUB /FOR2DOWN | |
822 | DCA FORUD2 | |
823 | TAD DOSKIP | |
824 | DCA FORUD3 | |
825 | L7776 /COMMON ROUTINE: | |
826 | TAD T | |
827 | POPONE | |
828 | DCA H2 | |
829 | TAD H2 | |
830 | POPNUM | |
831 | AAAAAAAAAAAAAAAA | |
832 | FORUD2, ADD INT&ONE /OR SUB INT&ONE | |
833 | PUT INT&FORH1 | |
834 | EEEEEEEEEEEEEEEE | |
835 | POPNUM | |
836 | AAAAAAAAAAAAAAAA | |
837 | SUB INT&FORH1 | |
838 | FORUD3, SKGE /OR SKLE | |
839 | JMP FOR2EX | |
840 | GET INT&FORH1 | |
841 | EEEEEEEEEEEEEEEE | |
842 | TAD H2 | |
843 | PUSHNUM | |
844 | TAD IRY | |
845 | DCA PC | |
846 | CONTINUE | |
847 | ||
848 | FOR2EX, EEEEEEEEEEEEEEEE | |
849 | L7775 | |
850 | BUMP | |
851 | CONTINUE | |
852 | ||
853 | UPSKIP, SKGE | |
854 | DOSKIP, SKLE | |
855 | UPADD, ADD INT&ONE | |
856 | DOSUB, SUB INT&ONE | |
857 | ||
858 | ONE, 0;0;0;1 | |
859 | FORH1, ZBLOCK 4 | |
860 | MINUS1, -1 | |
861 | BYTE, 77 | |
862 | LEVBITS,17 | |
863 | ||
864 | I18, L0004 /MARK STACK | |
865 | BUMP | |
866 | TAD IRY | |
867 | OFTAB;REF | |
868 | BSW | |
869 | AND BYTE | |
870 | OFTAB;VSIZE | |
871 | TAD MINUS1 | |
872 | PUSHONE | |
873 | BUMP | |
874 | TAD IRY | |
875 | PUSHONE | |
876 | CONTINUE | |
877 | ||
878 | I19, TAD IRY /CALL | |
879 | CIA | |
880 | TAD T | |
881 | DCA H1 | |
882 | L0004 | |
883 | TAD H1 | |
884 | POPONE | |
885 | DCA H2 | |
886 | TAD H2 | |
887 | OFTAB;LEV | |
888 | AND LEVBITS | |
889 | DCA H3 | |
890 | L0001 | |
891 | TAD H3 | |
892 | DCA IRX | |
893 | TAD H1 | |
894 | TODISPLAY | |
895 | L0003 | |
896 | TAD H1 | |
897 | POPONE | |
898 | TAD H1 | |
899 | DCA H4 | |
900 | L0001 | |
901 | TAD H1 | |
902 | DCA T3T | |
903 | TAD PC | |
904 | TOSTACK | |
905 | ISZ T3T | |
906 | TAD H3 | |
907 | DCA IRX | |
908 | OFDISPLAY | |
909 | TOSTACK | |
910 | ISZ T3T | |
911 | TAD B | |
912 | TOSTACK | |
913 | /-------------------- FALL THROUGH PAGE BOUNDARY ------------- | |
914 | CLEAR | |
915 | TAD T | |
916 | CMA CLL | |
917 | TAD H4 | |
918 | SNL CLA | |
919 | JMP .+4 | |
920 | BUMP | |
921 | PUSHVAL | |
922 | JMP .-7 | |
923 | TAD H1 | |
924 | DCA B | |
925 | TAD H2 | |
926 | OFTAB;ADR | |
927 | DCA PC | |
928 | CONTINUE | |
929 | ||
930 | I20, TAD (NOP /INDEX1 | |
931 | SKP | |
932 | I21, TAD (JMS MULTY /INDEX | |
933 | DCA INDEX1 | |
934 | TAD IRY /COMMON ROUTINE: | |
935 | OFATAB;HIGH | |
936 | CMA | |
937 | DCA H1 | |
938 | TAD IRY | |
939 | OFATAB;LOW | |
940 | TAD H1 | |
941 | CIA | |
942 | DCA H2 | |
943 | POPVAL | |
944 | L4000 | |
945 | AND AC1 | |
946 | CLL RAL | |
947 | TAD AC3 | |
948 | SZL | |
949 | CIA | |
950 | TAD H1 | |
951 | CLL | |
952 | TAD H2 | |
953 | DCA RELADR | |
954 | SNL | |
955 | ERRORB, HALT /INDEX OUT OF BOUNDS! | |
956 | INDEX1, NOP /OR JMS MULTY | |
957 | L7777 | |
958 | BUMP | |
959 | POPONE | |
960 | TAD RELADR | |
961 | PUSHONE | |
962 | CONTINUE | |
963 | ||
964 | RELADR=H4 | |
965 | ||
966 | MULTY, 0 | |
967 | TAD IRY | |
968 | OFATAB;ELSIZE | |
969 | CLL RAR | |
970 | MQL | |
971 | TAD (-14 /-12 (BITS) | |
972 | DCA H3 | |
973 | MBIT, SNL | |
974 | JMP .+3 | |
975 | CLL | |
976 | TAD RELADR | |
977 | RAR | |
978 | SWP | |
979 | RAR | |
980 | SWP | |
981 | ISZ H3 | |
982 | JMP MBIT | |
983 | SWP | |
984 | DCA RELADR | |
985 | JMP I MULTY | |
986 | ||
987 | I22, POPONE /LOAD BLOCK | |
988 | DCA H1 | |
989 | L7777 | |
990 | BUMP | |
991 | TAD IRY | |
992 | CMA | |
993 | DCA H2 | |
994 | JMP .+6 | |
995 | BUMP | |
996 | TAD H1 | |
997 | POPVAL | |
998 | PUSHVAL | |
999 | ISZ H1 | |
1000 | ISZ H2 | |
1001 | JMP .-6 | |
1002 | CONTINUE | |
1003 | ||
1004 | I23, L7777 /COPY BLOCK | |
1005 | TAD T | |
1006 | POPONE | |
1007 | DCA H1 | |
1008 | POPONE | |
1009 | DCA H2 | |
1010 | TAD IRY | |
1011 | CMA | |
1012 | DCA H3 | |
1013 | JMP .+7 | |
1014 | TAD H2 | |
1015 | POPVAL | |
1016 | TAD H1 | |
1017 | PUSHVAL | |
1018 | ISZ H1 | |
1019 | ISZ H2 | |
1020 | ISZ H3 | |
1021 | JMP .-7 | |
1022 | L7776 | |
1023 | BUMP | |
1024 | CONTINUE | |
1025 | ||
1026 | I24, BUMP /LITERAL (ADDRESSES ONLY!) | |
1027 | TAD IRY | |
1028 | LOAD | |
1029 | PUSHVAL | |
1030 | CONTINUE | |
1031 | ||
1032 | I25, BUMP /LOAD CONSTANT | |
1033 | TAD IRY | |
1034 | GETCONSTANT | |
1035 | PUSHVAL | |
1036 | CONTINUE | |
1037 | I61, POPONE /WRITE SPECIAL ASCII | |
1038 | PRINTC | |
1039 | L7777 | |
1040 | BUMP | |
1041 | CONTINUE | |
1042 | ||
1043 | ||
1044 | PAGE | |
1045 | \f/INSTRUCTIONS OF STACK COMPUTER (D) | |
1046 | ||
1047 | I26, TAD IRY /FLOAT | |
1048 | CIA | |
1049 | TAD T | |
1050 | DCA H1 | |
1051 | TAD H1 | |
1052 | POPNUM | |
1053 | JMS IFLOAT | |
1054 | TAD H1 | |
1055 | PUSHNUM | |
1056 | CONTINUE | |
1057 | ||
1058 | I27, TAD (JMS I READX-1 /READ | |
1059 | TAD IRY | |
1060 | DCA .+1 | |
1061 | JMS I READX | |
1062 | POPONE | |
1063 | PUSHNUM | |
1064 | JMP EXI27 | |
1065 | ||
1066 | READX, IINP | |
1067 | RINP | |
1068 | NOP | |
1069 | CINP | |
1070 | ||
1071 | I28, POPONE /WRITE STRING | |
1072 | DCA M | |
1073 | L7777 | |
1074 | BUMP | |
1075 | POPONE | |
1076 | CIA | |
1077 | DCA N | |
1078 | TAD IRY | |
1079 | CDF TABLEFIELD | |
1080 | JMS WSTRING | |
1081 | JMP EXI27 | |
1082 | ||
1083 | I29, TAD (TAD DFW-1 /WRITE (STANDARD FIELD WIDTH) | |
1084 | TAD IRY | |
1085 | DCA .+1 | |
1086 | TAD DFW | |
1087 | DCA M | |
1088 | JMP WRGO | |
1089 | ||
1090 | I30, POPONE /WRITE (SPECIFIED FIELD WIDTH) | |
1091 | DCA M | |
1092 | L7777 | |
1093 | BUMP | |
1094 | WRGO, POPNUM | |
1095 | L7777 | |
1096 | BUMP | |
1097 | DCA N | |
1098 | TAD (JMS I WRITEX-1 | |
1099 | TAD IRY | |
1100 | DCA .+1 | |
1101 | JMS I WRITEX | |
1102 | CONTINUE | |
1103 | ||
1104 | WRITEX, IOUT | |
1105 | ROUT | |
1106 | BOUT | |
1107 | COUT | |
1108 | ||
1109 | DFW, 12 | |
1110 | 22 | |
1111 | 12 | |
1112 | 1 | |
1113 | ||
1114 | I31, POPONE /WRITE ( X :M :N ) | |
1115 | DCA N | |
1116 | L7777 | |
1117 | BUMP | |
1118 | POPONE | |
1119 | DCA M | |
1120 | L7777 | |
1121 | BUMP | |
1122 | POPNUM | |
1123 | JMS I WRITEX+1 /REAL ONLY! | |
1124 | EXI27, L7777 | |
1125 | BUMP | |
1126 | CONTINUE | |
1127 | I32, L7776 /EXIT PROCEDURE | |
1128 | SKP | |
1129 | I33, L7777 /EXIT FUNCTION | |
1130 | TAD B | |
1131 | DCA T | |
1132 | BUMP | |
1133 | L0001 | |
1134 | TAD B | |
1135 | POPONE | |
1136 | DCA PC | |
1137 | L0003 | |
1138 | TAD B | |
1139 | POPONE | |
1140 | DCA B | |
1141 | CONTINUE | |
1142 | ||
1143 | I34, POPONE /LOAD (ABSOLUTE) | |
1144 | POPVAL | |
1145 | PUSHVAL | |
1146 | CONTINUE | |
1147 | ||
1148 | I35, POPONE /LOGICAL NOT | |
1149 | CLL RAR | |
1150 | CML | |
1151 | RAL | |
1152 | PUSHONE | |
1153 | CONTINUE | |
1154 | ||
1155 | I36, POPNUM /NEGATE | |
1156 | JMS XNEG | |
1157 | PUSHNUM | |
1158 | CONTINUE | |
1159 | ||
1160 | I38, POPVAL /STORE | |
1161 | L7777 | |
1162 | BUMP | |
1163 | POPONE | |
1164 | PUSHVAL | |
1165 | L7777 | |
1166 | BUMP | |
1167 | CONTINUE | |
1168 | ||
1169 | /I39 - I47 U N U S E D ! | |
1170 | ||
1171 | ||
1172 | /B O O L E A N O U T P U T | |
1173 | ||
1174 | BOUT, 0 | |
1175 | TAD AC3 | |
1176 | TAD (-5 | |
1177 | DCA N | |
1178 | TAD AC3 | |
1179 | SNA CLA | |
1180 | L0004 | |
1181 | TAD (TRUEFALSE^2 | |
1182 | JMS WSTRING | |
1183 | JMP I BOUT | |
1184 | ||
1185 | PAGE | |
1186 | \f/INSTRUCTIONS OF STACK COMPUTER (E) | |
1187 | ||
1188 | I48, POPNUM /ARITHMETIC: | |
1189 | JMS ENTR /INTEGER: | |
1190 | L7777 / + 48,1 | |
1191 | BUMP / - 48,2 | |
1192 | POPNUM / * 48,3 | |
1193 | TAD (MRITABL / DIV 48,4 | |
1194 | TAD IRY / MOD 48,5 | |
1195 | DCA H1 | |
1196 | TAD I H1 /REAL: | |
1197 | DCA H1 / + 48,10 | |
1198 | JMS I H1 / - 48,11 | |
1199 | PUSHNUM / * 48,12 | |
1200 | CONTINUE / / 48,13 | |
1201 | ||
1202 | I49, TAD (ISUB-RSUB /COMPARE (INTEGER) | |
1203 | I50, TAD (RSUB /COMPARE (REAL) | |
1204 | DCA H1 / = 50,7440 | |
1205 | POPNUM / <> 50,7450 | |
1206 | JMS ENTR / < 50,7500 | |
1207 | L7777 / <= 50,7540 | |
1208 | BUMP / > 50,7550 | |
1209 | POPNUM / >= 50,7510 | |
1210 | JMS I H1 /SUBTRACT | |
1211 | TAD IRY | |
1212 | JMS BOOL | |
1213 | LOAD | |
1214 | PUSHVAL | |
1215 | CONTINUE | |
1216 | ||
1217 | I51, POPONE /LOGICAL OR | |
1218 | DCA H1 | |
1219 | L7777 | |
1220 | BUMP | |
1221 | SDF | |
1222 | TAD H1 | |
1223 | CMA | |
1224 | AND I T3 | |
1225 | TAD H1 | |
1226 | DCA I T3 | |
1227 | CDF | |
1228 | CONTINUE | |
1229 | ||
1230 | I52, POPONE /LOGICAL AND | |
1231 | DCA H1 | |
1232 | L7777 | |
1233 | BUMP | |
1234 | SDF | |
1235 | TAD H1 | |
1236 | AND I T3 | |
1237 | DCA I T3 | |
1238 | CDF | |
1239 | CONTINUE | |
1240 | ||
1241 | /I53 - I61 U N U S E D ! | |
1242 | ||
1243 | READC | |
1244 | I62, TAD EOLN /READLN | |
1245 | SNA CLA | |
1246 | JMP .-3 | |
1247 | READC | |
1248 | CONTINUE | |
1249 | ||
1250 | I63, CRLF /WRITELN | |
1251 | CONTINUE | |
1252 | \f/AUXILIARY ROUTINES FOR 'WRITE STRING' AND 'BOOLEAN OUTPUT' | |
1253 | ||
1254 | WSTRING,0 | |
1255 | DCA H1 | |
1256 | RDF | |
1257 | TAD CCDF0 | |
1258 | DCA STRFLD | |
1259 | CCDF0, CDF 0 | |
1260 | TAD M | |
1261 | SNA | |
1262 | JMP NCHAR | |
1263 | TAD N /M-N | |
1264 | SPA SNA | |
1265 | JMP PARTLY | |
1266 | CIA | |
1267 | DCA H2 | |
1268 | TAD [240 | |
1269 | PRINTC | |
1270 | ISZ H2 | |
1271 | JMP .-3 | |
1272 | JMP NCHAR | |
1273 | PARTLY, CIA / N-M | |
1274 | TAD N /-N | |
1275 | DCA N /= -M | |
1276 | NCHAR, TAD H1 | |
1277 | STL RAR /STRING TABLE STARTS AT 4000! | |
1278 | DCA H2 | |
1279 | STRFLD, CDF TABLEFIELD | |
1280 | TAD I H2 | |
1281 | CDF 0 | |
1282 | SNL | |
1283 | BSW | |
1284 | JMS ASCII | |
1285 | ISZ H1 | |
1286 | ISZ N | |
1287 | JMP NCHAR | |
1288 | JMP I WSTRING | |
1289 | ||
1290 | ASCII, 0 | |
1291 | AND [77 | |
1292 | TAD [240 | |
1293 | AND [77 | |
1294 | TAD [240 | |
1295 | PRINTC | |
1296 | JMP I ASCII | |
1297 | \f/C H A R A C T E R I N P U T AND O U T P U T | |
1298 | ||
1299 | ||
1300 | CINP, 0 | |
1301 | READC | |
1302 | TAD CHAR | |
1303 | AND [77 | |
1304 | LOAD | |
1305 | JMP I CINP | |
1306 | ||
1307 | COUT, 0 | |
1308 | TAD M | |
1309 | SPA SNA | |
1310 | L0001 | |
1311 | CIA | |
1312 | DCA H2 | |
1313 | JMP .+3 | |
1314 | TAD [240 | |
1315 | PRINTC | |
1316 | ISZ H2 | |
1317 | JMP .-3 | |
1318 | TAD AC3 | |
1319 | JMS ASCII | |
1320 | JMP I COUT | |
1321 | ||
1322 | PAGE | |
1323 | \f/STACK INSTRUCTIONS | |
1324 | ||
1325 | XBUMP, 0 | |
1326 | SNA /IF (AC)=0 | |
1327 | L0001 /THEN T:=T+1 | |
1328 | CLL /ELSE T:=T+(AC) | |
1329 | SPA | |
1330 | CML | |
1331 | TAD T | |
1332 | DCA T | |
1333 | SZL | |
1334 | ERRORA, HALT /S T A C K O V E R F L O W ! | |
1335 | TAD T | |
1336 | CLL RAR | |
1337 | BSW | |
1338 | AND (70 | |
1339 | TAD (CDF STACKFIELD | |
1340 | DCA XSDF /SETUP CHANGE TO STACK FIELD INSTR. | |
1341 | TAD T /AND BUILD | |
1342 | STL RAL | |
1343 | STL RAL | |
1344 | DCA T3 /ADDRESS OF TOP ENTRY (LS WORD) | |
1345 | JMP I XBUMP | |
1346 | ||
1347 | ST3, | |
1348 | ADDRESS,0 /COMPUTE FULL ADDRESS | |
1349 | MQL /OF STACK LOCATION | |
1350 | MQA /AND CHANGE DATA FIELD | |
1351 | CLL RAR | |
1352 | BSW | |
1353 | AND (70 | |
1354 | TAD (CDF STACKFIELD | |
1355 | DCA STCDF | |
1356 | MQA | |
1357 | STL RAL | |
1358 | STL RAL | |
1359 | STCDF, CDF STACKFIELD | |
1360 | JMP I ADDRESS | |
1361 | ||
1362 | PACK, 0 /PACK REAL OR INTEGER NUMBER | |
1363 | TAD ACX /INTO AC0-4 (FOR PUSHING) | |
1364 | DCA AC0 | |
1365 | TAD ACS | |
1366 | TAD AC1 | |
1367 | DCA AC1 | |
1368 | JMP I PACK | |
1369 | ||
1370 | UNPACK, 0 /UNPACK POPPED NUMBER | |
1371 | L4000 /(EXTRACT SIGN, EXPONENT) | |
1372 | AND AC1 | |
1373 | DCA ACS | |
1374 | L3777 | |
1375 | AND AC1 | |
1376 | DCA AC1 | |
1377 | TAD AC0 | |
1378 | DCA ACX | |
1379 | DCA AC0 | |
1380 | JMP I UNPACK | |
1381 | ||
1382 | XPOPONE,0 | |
1383 | SNA | |
1384 | JMP TOPONE | |
1385 | JMS ADDRESS | |
1386 | DCA ST3 | |
1387 | TAD I ST3 | |
1388 | CDF | |
1389 | JMP I XPOPONE | |
1390 | TOPONE, SDF | |
1391 | TAD I T3 | |
1392 | CDF | |
1393 | JMP I XPOPONE | |
1394 | ||
1395 | XPUSHONE,0 | |
1396 | SDF | |
1397 | DCA I T3 | |
1398 | CDF | |
1399 | JMP I XPUSHONE | |
1400 | ||
1401 | XPOPVAL,0 | |
1402 | SNA | |
1403 | JMP TOPVAL | |
1404 | JMS ADDRESS | |
1405 | TAD MIN4 | |
1406 | DCA XR10 | |
1407 | TAD I XR10 | |
1408 | DCA AC0 | |
1409 | TAD I XR10 | |
1410 | DCA AC1 | |
1411 | TAD I XR10 | |
1412 | DCA AC2 | |
1413 | TAD I XR10 | |
1414 | DCA AC3 | |
1415 | CDF | |
1416 | JMP I XPOPVAL | |
1417 | TOPVAL, TAD T3 | |
1418 | SDF | |
1419 | JMP XPOPVAL+4 | |
1420 | ||
1421 | XPUSHVAL,0 | |
1422 | SNA | |
1423 | JMP ONTOP | |
1424 | JMS ADDRESS | |
1425 | TAD MIN4 | |
1426 | DCA XR10 | |
1427 | TAD AC0 | |
1428 | DCA I XR10 | |
1429 | TAD AC1 | |
1430 | DCA I XR10 | |
1431 | TAD AC2 | |
1432 | DCA I XR10 | |
1433 | TAD AC3 | |
1434 | DCA I XR10 | |
1435 | CDF | |
1436 | JMP I XPUSHVAL | |
1437 | ONTOP, TAD T3 | |
1438 | SDF | |
1439 | JMP XPUSHVAL+4 | |
1440 | ||
1441 | XPOPNUM,0 | |
1442 | JMS XPOPVAL | |
1443 | JMS UNPACK | |
1444 | JMP I XPOPNUM | |
1445 | ||
1446 | XPUSHNUM,0 | |
1447 | MQL | |
1448 | JMS PACK | |
1449 | MQA | |
1450 | JMS XPUSHVAL | |
1451 | JMP I XPUSHNUM | |
1452 | ||
1453 | XTOSTACK,0 | |
1454 | DCA PACK /TEMP. SAVE VALUE | |
1455 | TAD T3T | |
1456 | JMS ADDRESS | |
1457 | DCA ST3 | |
1458 | TAD PACK | |
1459 | DCA I ST3 | |
1460 | CDF | |
1461 | JMP I XTOSTACK | |
1462 | ||
1463 | PAGE | |
1464 | \f/TABLE INSTRUCTIONS | |
1465 | ||
1466 | ZOFTAB, / AC := TAB[ AC ].REF | |
1467 | ZOFBTAB,0 / AC := BTAB[ AC ].REF | |
1468 | CLL RTL | |
1469 | TAD I ZOFTAB /SELECTOR FOLLOWS CALL | |
1470 | DCA LOC | |
1471 | ISZ ZOFTAB | |
1472 | CDF TABLEFIELD | |
1473 | TAD I LOC | |
1474 | CDF | |
1475 | JMP I ZOFTAB | |
1476 | ||
1477 | ZOFATAB,0 / AC := ATAB[ AC ].REF | |
1478 | CLL RAL | |
1479 | CLL RTL | |
1480 | TAD I ZOFATAB /SELECTOR FOLLOWS CALL | |
1481 | DCA LOC | |
1482 | ISZ ZOFATAB | |
1483 | CDF TABLEFIELD | |
1484 | TAD I LOC | |
1485 | CDF | |
1486 | JMP I ZOFATAB | |
1487 | ||
1488 | ZOFDISP,0 / AC := DISPLAY[ IRX ] | |
1489 | TAD (DISPLAY | |
1490 | TAD IRX | |
1491 | DCA LOC | |
1492 | TAD I LOC | |
1493 | JMP I ZOFDISP | |
1494 | ||
1495 | ZTODISP,0 / DISPLAY[ IRX ] := AC | |
1496 | MQL | |
1497 | TAD (DISPLAY | |
1498 | TAD IRX | |
1499 | DCA LOC | |
1500 | MQA | |
1501 | DCA I LOC | |
1502 | JMP I ZTODISP | |
1503 | ||
1504 | XOFCODE,0 / AC := CODE[ AC.LINK ] | |
1505 | RAL /LINK=0 ... 1ST WORD | |
1506 | DCA LOC /LINK=1 ... 2ND WORD | |
1507 | CDF CODEFIELD | |
1508 | TAD I LOC | |
1509 | CDF | |
1510 | JMP I XOFCODE | |
1511 | ||
1512 | LOC, 0 /ADDRESS OF TABLE LOCATION | |
1513 | ||
1514 | ZOFCONST,0 /ENTER WITH ADDRESS-1 IN AC | |
1515 | DCA XR10 | |
1516 | CDF TABLEFIELD | |
1517 | TAD I XR10 | |
1518 | DCA AC0 | |
1519 | TAD I XR10 | |
1520 | DCA AC1 | |
1521 | TAD I XR10 | |
1522 | DCA AC2 | |
1523 | TAD I XR10 | |
1524 | DCA AC3 | |
1525 | CDF | |
1526 | JMP I ZOFCONST | |
1527 | \f/PREDEFINED R A N D O M - NUMBER GENERATOR | |
1528 | ||
1529 | XRAND, 0 | |
1530 | TAD DISMOV /DISABLE INTEGER- | |
1531 | DCA INTMOV /MULTIPLY-OVERFLOW | |
1532 | AAAAAAAAAAAAAAAA | |
1533 | GET INT&RN | |
1534 | MUL INT&ALFA /MOD 2^35 ! | |
1535 | PUT INT&RN | |
1536 | NORM /0 < RANDOM: REAL < 1 | |
1537 | EEEEEEEEEEEEEEEE | |
1538 | TAD ENAMOV /REENABLE | |
1539 | DCA INTMOV | |
1540 | BUMP | |
1541 | JMP I XRAND | |
1542 | ||
1543 | DISMOV, DCA AC0 | |
1544 | ENAMOV, JMSSNAC | |
1545 | ||
1546 | RN, 0000;3777;7777;7775 /2^35 - 3 (INTEGER) | |
1547 | ALFA, 0000;0000;0100;0003 /2^18 + 3 (INTEGER) | |
1548 | ||
1549 | ||
1550 | XODD, 0 | |
1551 | L0001 | |
1552 | AND AC3 | |
1553 | LOAD | |
1554 | JMP I XODD | |
1555 | ||
1556 | ||
1557 | XSKDIG, 0 /SKIP ON DIGIT | |
1558 | TAD CHAR | |
1559 | TAD (-"9-1 | |
1560 | CLL | |
1561 | TAD ("9+1-"0 | |
1562 | DCA BCD | |
1563 | SZL CLA | |
1564 | ISZ XSKDIG | |
1565 | JMP I XSKDIG | |
1566 | ||
1567 | XPRINT, 0 /INTERNAL PRINTER HANDLER | |
1568 | SNA | |
1569 | TAD CHAR | |
1570 | TLS | |
1571 | TSF | |
1572 | JMP .-1 | |
1573 | TAD [-215 | |
1574 | SZA CLA | |
1575 | JMP I XPRINT | |
1576 | TAD [212 | |
1577 | JMP XPRINT+3 | |
1578 | ||
1579 | SPRINT, 0 /SILENT PRINTER | |
1580 | CLA CLL | |
1581 | JMP I SPRINT | |
1582 | ||
1583 | XCRLF, 0 /CARRIAGE RETURN & LINE FEED | |
1584 | TAD [215 | |
1585 | PRINTC | |
1586 | JMP I XCRLF | |
1587 | ||
1588 | XBREAK, 0 /CHECK ^C AND ABORT | |
1589 | KSF | |
1590 | JMP I XBREAK | |
1591 | CLA | |
1592 | KRS | |
1593 | AND [177 | |
1594 | TAD (-3 | |
1595 | SZA CLA | |
1596 | JMP I XBREAK | |
1597 | JMP I OS8 | |
1598 | ||
1599 | PAGE | |
1600 | \f/ A R I T H M E T I C P A C K A G E | |
1601 | ||
1602 | INTERPC,0000 /PROGRAM COUNTER FOR MACRO-INSTRUCTIONS | |
1603 | CPAGE, 7600 | |
1604 | SZA CLA | |
1605 | NEXTINSTR, ISZ INTERPC /POINT TO NEXT INSTRUCTION | |
1606 | TAD I INTERPC /GET CODE | |
1607 | SNA /IF CODE=0000 | |
1608 | JMP I INTERPC /THEN RETURN TO PDP8-MODE | |
1609 | CLL RTL /ELSE SHIFT CODE NXXX | |
1610 | RTL | |
1611 | AND (7 /TO EXTRACT OPERATION CODE N | |
1612 | DCA OPCODE | |
1613 | TAD I INTERPC /GET CODE AGAIN, | |
1614 | AND (177 /MASK OUT REL.ADDRESS (OR FUNCTION CODE) | |
1615 | MQL | |
1616 | TAD CPAGE | |
1617 | C200, AND INTERPC /CURRENT PAGE BITS | |
1618 | MQA /+ RELATIVE ADDRESS | |
1619 | DCA OPADDR /= ABS. ADDRESS OF OPERAND (IF MRI) | |
1620 | SNL /IF D\I-BIT SET | |
1621 | JMP .+3 | |
1622 | TAD I OPADDR /THEN DO INDIRECT ADDRESSING | |
1623 | DCA OPADDR | |
1624 | TAD OPCODE | |
1625 | TAD (-7 | |
1626 | SNA CLA /IF CODE=7XXX | |
1627 | JMP OPRTYP /THEN OPERATE CLASS INSTRUCTION | |
1628 | MRITYP, TAD I OPADDR /ELSE MEMORY REFERENCED INSTR.: | |
1629 | DCA OPX /LOAD AND UNPACK OPERAND | |
1630 | ISZ OPADDR /INTO OP-REGISTER | |
1631 | L4000 | |
1632 | AND I OPADDR | |
1633 | DCA OPS | |
1634 | L3777 | |
1635 | AND I OPADDR | |
1636 | DCA OP1 | |
1637 | ISZ OPADDR | |
1638 | TAD I OPADDR | |
1639 | DCA OP2 | |
1640 | ISZ OPADDR | |
1641 | TAD I OPADDR | |
1642 | DCA OP3 | |
1643 | TAD I INTERPC /GET INSTRUCTION CODE AGAIN, | |
1644 | AND C200 /CHECK INTEGER\REAL-BIT | |
1645 | SZA CLA /AND BUILD A | |
1646 | TAD (7 | |
1647 | TAD OPCODE | |
1648 | TAD (JMS I MRITABL | |
1649 | DCA .+1 | |
1650 | OPCODE, JMS . / J M S TO THE REQUESTED ROUTINE | |
1651 | JMP NEXTINSTR | |
1652 | OPADDR, 0 | |
1653 | ||
1654 | /TABLE OF INTEGER ARITHMETIC ROUTINES: | |
1655 | MRITABL,OGET | |
1656 | IADD | |
1657 | ISUB | |
1658 | IMUL | |
1659 | IDIV | |
1660 | IMOD | |
1661 | OPUT | |
1662 | ||
1663 | /TABLE OF REAL ARITHMETIC ROUTINES: | |
1664 | OGET | |
1665 | RADD | |
1666 | RSUB | |
1667 | RMUL | |
1668 | RDIV | |
1669 | OJUMP | |
1670 | OPUT | |
1671 | ||
1672 | OPRTYP, TAD I INTERPC /DECODE OPERATE INSTRUCTION | |
1673 | SNL /BIT3 IS IN LINK (COMPLEMENTED!) | |
1674 | JMP SKIPTYP /SKIP INSTR. CODES ARE 74XX, 75XX | |
1675 | BSW /OPERATE INSTR. CODES ARE: | |
1676 | RTR /7000 - 7006 (INTEGER) | |
1677 | CLA MQA /7200 - 7206 (REAL) | |
1678 | AND (7 /EXTENDED FUNCTIONS: 70X7 | |
1679 | RAL | |
1680 | TAD (JMS I OPRTABL | |
1681 | DCA .+3 | |
1682 | TAD INTERPC /SAVE PC, SINCE OPR'S MAY CAUSE | |
1683 | DCA SAVEPC /RECURSIVE CALL OF INTERPRETER (1 LEVEL) | |
1684 | OPRJMS, JMS . / J M S TO APPROPRIATE ROUTINE | |
1685 | TAD SAVEPC /RESTORE PC | |
1686 | DCA INTERPC | |
1687 | JMP NEXTINSTR | |
1688 | SAVEPC, 0 | |
1689 | ||
1690 | NOOP=OPCODE | |
1691 | ||
1692 | /TABLE OF OPERATE CLASS INSTRUCTIONS: | |
1693 | OPRTABL,XABS; RNORM | |
1694 | IINP; RINP | |
1695 | IOUT; ROUT | |
1696 | IFLOAT; RTRUNC | |
1697 | XNEG; CLAC | |
1698 | XISQU; XRSQU | |
1699 | XCRLF; XROUND | |
1700 | NOOP /LINK TO FUNCTION DISPATCH ROUTINE | |
1701 | IFDEF FUNCTS < | |
1702 | *.-1 | |
1703 | FUNCTS /ENABLED ONLY IF FUNCTION PACKAGE PRESENT | |
1704 | > | |
1705 | ||
1706 | SKIPTYP,JMS BOOL /ALL SKIP INSTR. (INT & REAL) DONE HERE | |
1707 | ISZ INTERPC /(SEE ROUTINE 'BOOL' FOR COMMENTS) | |
1708 | JMP NEXTINSTR-1 | |
1709 | ||
1710 | OJUMP, 0 /JUMP (WITHIN MACRO CODE!!!) | |
1711 | L7775 | |
1712 | TAD OPADDR | |
1713 | DCA INTERPC | |
1714 | JMP NEXTINSTR+1 | |
1715 | ||
1716 | OPUT, 0 /STORE CONTENTS OF AC-REGISTER | |
1717 | L0004 /AT SPECIFIED MEMORY ADDRESS | |
1718 | CIA /-4 (OPADDR WAS MOVED AT MRITYP) | |
1719 | TAD OPADDR | |
1720 | DCA XR10 | |
1721 | TAD ACX | |
1722 | DCA I XR10 | |
1723 | TAD ACS | |
1724 | TAD AC1 | |
1725 | DCA I XR10 | |
1726 | TAD AC2 | |
1727 | DCA I XR10 | |
1728 | TAD AC3 | |
1729 | DCA I XR10 | |
1730 | JMP I OPUT | |
1731 | ||
1732 | PAGE | |
1733 | \f/R E A L N U M B E R I N P U T | |
1734 | / | |
1735 | /ACCEPTS A DECIMAL NUMBER IN ANY FORMAT, | |
1736 | /CONVERTS IT TO INTERNAL BYNARY FLOATING POINT NOTATION | |
1737 | /AND LEAVES IT IN THE AC-REGISTER. | |
1738 | /LEADING BLANKS ARE IGNORED; THE FIRST | |
1739 | /NON ACCEPTABLE CHARACTER TERMINATES THE NUMBER. | |
1740 | ||
1741 | DC=MQ2 /DIGIT COUNTER | |
1742 | OC=MQ3 /DIGIT EXCESS COUNTER | |
1743 | DP, 0 /DECIMAL POINT POSITION | |
1744 | ||
1745 | RINP, RETNUM /RETURN ADDR. SINCE COMPILER ENTERS AT 'FRACTN' | |
1746 | SKP CLA | |
1747 | READC /PASS OVER LEADING BLANKS | |
1748 | TAD CHAR | |
1749 | TAD (-240 | |
1750 | SNA CLA | |
1751 | JMP .-4 | |
1752 | JMS PMXXX /PROCESS + - I N T E G E R PART | |
1753 | TAD OC /COUNT LOOSEN DIGITS (IF THE INTERNAL | |
1754 | CIA /REPRESENTATION EXCEEDS 35 BITS, | |
1755 | DCA DC /FURTHER DIGITS ARE IGNORED, BUT | |
1756 | TAD CHAR /THEIR CONTRIBUTION TO MAGNITUDE | |
1757 | TAD (-". /MUST BE CONSIDERED!) | |
1758 | SZA CLA /IF INTEGER FOLLOWED BY DECIMAL POINT | |
1759 | JMP .+3 | |
1760 | READC | |
1761 | FRACTN, JMS BCONV /THEN PROCESS F R A C T I O N PART | |
1762 | TAD DC /COUNT DIGITS AFTER DEC. POINT | |
1763 | CIA | |
1764 | DCA DP /TO REMEMBER POSITION OF DEC. POINT | |
1765 | JMS IFLOAT /NORMALIZE THE NUMBER | |
1766 | TAD CHAR | |
1767 | TAD (-"E | |
1768 | SZA CLA /IF NEXT CHARACTER IS "E" | |
1769 | JMP ADJUST | |
1770 | AAAAAAAAAAAAAAAA | |
1771 | PUT NUMBUF /THEN STORE NUMBER TEMPORARELY | |
1772 | EEEEEEEEEEEEEEEE | |
1773 | READC | |
1774 | JMS PMXXX /AND PROCESS S C A L E - F A C T O R | |
1775 | TAD ACS | |
1776 | CLL RAL | |
1777 | TAD AC3 /GET IT FROM LOW ORDER WORD OF AC | |
1778 | SZL /IF NEGATIVE SIGN | |
1779 | CIA /THEN USE 2'S COMPLEMENT | |
1780 | TAD DP /ADD IT TO CURRENT POS. OF DEC. POINT | |
1781 | DCA DP | |
1782 | AAAAAAAAAAAAAAAA | |
1783 | GET NUMBUF /RECALL STORED MANTISSA | |
1784 | EEEEEEEEEEEEEEEE | |
1785 | ADJUST, TAD DP /NOW CONVERT DEC. FLOATING POINT TO | |
1786 | JMS SUP1 /TO BINARY FLOATING POINT NOTATION | |
1787 | JMP I RINP | |
1788 | ||
1789 | ||
1790 | PMXXX, 0 /SIGNED INTEGER INPUT & CONVERSION | |
1791 | CLEAR | |
1792 | DCA DC | |
1793 | DCA OC | |
1794 | TAD CHAR | |
1795 | TAD (-"+ | |
1796 | SNA | |
1797 | JMP .+6 | |
1798 | CLL RTR | |
1799 | SZA CLA | |
1800 | JMP .+4 | |
1801 | L4000 | |
1802 | DCA ACS | |
1803 | READC | |
1804 | JMS BCONV | |
1805 | JMP I PMXXX | |
1806 | ||
1807 | BCONV, 0 /UNSIGNED DIGIT STRING INPUT & CONVERSION | |
1808 | SKDIG | |
1809 | JMP I BCONV | |
1810 | TAD AC0 | |
1811 | SZA CLA | |
1812 | JMP OVER | |
1813 | CLL | |
1814 | JMS MUL10 | |
1815 | TAD BCD | |
1816 | DCA OP3 | |
1817 | DCA OP2 | |
1818 | DCA OP1 | |
1819 | JMS BADD | |
1820 | ISZ DC | |
1821 | SKP | |
1822 | OVER, ISZ OC | |
1823 | READC | |
1824 | JMP BCONV+1 | |
1825 | \f/F L O A T AND T R U N C ROUTINES | |
1826 | ||
1827 | ||
1828 | DISPLC=. | |
1829 | IFLOAT, 0 /COMPENSATE | |
1830 | TAD (43 /35 BITS DISPLACEMENT OF BINARY POINT | |
1831 | DCA ACX /WITH EXPONENT | |
1832 | JMS RNORM /AND NORMALIZE | |
1833 | JMP I IFLOAT | |
1834 | ||
1835 | RTRUNC, 0 | |
1836 | CLA CLL | |
1837 | TAD ACX | |
1838 | SPA SNA /IF ABS(AC)<1 OR AC=0 | |
1839 | JMP LESS0 /THEN TRUNC(AC):=0 | |
1840 | TAD MIN44 | |
1841 | DCA DISPLC /-(DISPLACEMENT OF BINARY POINT + 1) | |
1842 | SZL CLA /IF ABS(AC)>MAXINT | |
1843 | JMP ERROR2 /THEN O V E R F L O W | |
1844 | SKP | |
1845 | HALVE /ELSE ALIGN MANTISSA | |
1846 | ISZ DISPLC | |
1847 | JMP .-2 | |
1848 | DCA ACX /EXP=0 FOR INTEGERS | |
1849 | JMP I RTRUNC | |
1850 | LESS0, CLA | |
1851 | CLEAR | |
1852 | JMP I RTRUNC | |
1853 | ||
1854 | XROUND, 0 | |
1855 | L2000 | |
1856 | DCA OP1 | |
1857 | DCA OP2 | |
1858 | DCA OP3 | |
1859 | DCA OPX /X>=0: | |
1860 | TAD ACS /ROUND(X) = TRUNC(X+0.5) | |
1861 | DCA OPS /X<0: | |
1862 | JMS RADD /ROUND(X) = TRUNC(X-0.5) | |
1863 | JMS RTRUNC | |
1864 | JMP I XROUND | |
1865 | ||
1866 | PAGE | |
1867 | \f/R E A L N U M B E R O U T P U T | |
1868 | / | |
1869 | /PRINTS FLOATING POINT NUMBER X (CONTENTS OF AC-REGISTER) | |
1870 | /IN THE FORMAT SPECIFIED BY THE PARAMETERS M,N (PAGE 0) | |
1871 | /PERFORMS LIKE THE PASCAL-STATEMENT | |
1872 | / W R I T E ( X :M :N ) | |
1873 | ||
1874 | ||
1875 | /M /MINIMUM FIELD WIDTH | |
1876 | /N /FRACTION LENGTH | |
1877 | S=MQ1 /-NUMBER OF LEADING BLANKS | |
1878 | P=MQ2 /-NUMBER OF DIGITS PRECEDING THE DEC. POINT | |
1879 | F=MQ3 /-NUMBER OF DIGITS FOLLOWING THE DEC. POINT | |
1880 | ||
1881 | ||
1882 | ROUT, 0 | |
1883 | JMS FLCONV /BINARY TO DECIMAL FLOATING POINT | |
1884 | JMS EXBCD /EXTRACT BCD-DIGITS OF MANTISSA | |
1885 | TAD N | |
1886 | SPA SNA /WHICH FORMAT REQUESTED? | |
1887 | JMP FLOPNT | |
1888 | FIXPNT, CIA / -99999.99999 | |
1889 | DCA F /F:=-N | |
1890 | TAD DEXP | |
1891 | SPA /IF DEXP>0 | |
1892 | CLA /THEN P:=-(DEXP+1) | |
1893 | CMA /ELSE P:=-1 | |
1894 | DCA P | |
1895 | L7776 /S:=-(M-N-P-2) | |
1896 | TAD F | |
1897 | TAD P | |
1898 | TAD M | |
1899 | CIA | |
1900 | DCA S | |
1901 | TAD S | |
1902 | SMA CLA /IF S>=0 THEN USE FLOATING POINT FORMAT | |
1903 | JMP FLOPNT /(NUMBER TOO LARGE FOR FIXED POINT!) | |
1904 | L0002 | |
1905 | TAD N /ROUNDUP WITH (N+DEXP+1)TH DIGIT | |
1906 | TAD DEXP | |
1907 | SPA SNA /IF NOT WITHIN THE 11 DIGITS, THEN | |
1908 | JMP .+3 | |
1909 | TAD (-13 /ROUNDUP WITH 11TH DIGIT | |
1910 | SMA | |
1911 | CLA | |
1912 | TAD (13 | |
1913 | JMS UROUND | |
1914 | JMP FIXPNT+2 /ROUNDED MANTISSA = 10, CHECK WIDTH! | |
1915 | TAD DEXP /BEGINNING AT DIGIT POS. NUMBUF+DEXP | |
1916 | SMA /OR NUMBUF IF NUMBER >= 1 | |
1917 | CLA | |
1918 | JMS XOUT /DO THE FIXED POINT OUTPUT | |
1919 | JMP I ROUT | |
1920 | ||
1921 | ||
1922 | FLOPNT, L7777 / -9.999999999E+999 | |
1923 | DCA P /P:=-1 | |
1924 | TAD M | |
1925 | TAD (-12 | |
1926 | SPA | |
1927 | CLA | |
1928 | TAD (12 | |
1929 | DCA M /IF M<10 THEN M:=10 | |
1930 | TAD (-11 | |
1931 | DCA F /F:=-9 | |
1932 | TAD M /S:=-(M-17) | |
1933 | TAD (-21 | |
1934 | CIA | |
1935 | DCA S | |
1936 | TAD S | |
1937 | SPA CLA /IF S>=0 THEN | |
1938 | JMP .+7 | |
1939 | L7777 /S:=-1 | |
1940 | DCA S /F:=-(M-9) | |
1941 | TAD M | |
1942 | TAD (-11 | |
1943 | CIA | |
1944 | DCA F | |
1945 | L7776 | |
1946 | TAD F | |
1947 | CIA | |
1948 | JMS UROUND /ROUNDUP WITH (-F+1)TH DIGIT | |
1949 | STFW, 0022 /NOP (CARRY DOESN'T HARM!) | |
1950 | JMS XOUT /OUTPUT THE MANTISSA | |
1951 | TAD ("E | |
1952 | PRINTC /E | |
1953 | TAD DEXP | |
1954 | SPA CLA | |
1955 | L0002 | |
1956 | TAD ("+ | |
1957 | PRINTC /+ OR - | |
1958 | TAD DEXP | |
1959 | SPA | |
1960 | CIA /MAKE DEXP POSITIVE | |
1961 | JMS LDAC /LOAD IT IN AC-REGISTER (AS INTEGER) | |
1962 | L0003 | |
1963 | DCA M /SETUP A FIELD WIDTH OF 3, | |
1964 | TAD ("0-240 /CHANGE LEADING BLANKS TO ZEROES | |
1965 | JMS IOUT /AND USE INTEGER OUTPUT ROUTINE | |
1966 | TAD STFW /TO PRINT THE CHARACTERISTIC. | |
1967 | DCA M /THEN RESET STANDARD FIELD WIDTH | |
1968 | JMP I ROUT | |
1969 | ||
1970 | ||
1971 | ||
1972 | ||
1973 | /BUFFER FOR BCD-DIGITS: | |
1974 | 0 /IMPORTANT! (SEE ROUNDING) | |
1975 | NUMBUF, ZBLOCK 13 | |
1976 | ||
1977 | ||
1978 | ||
1979 | TEN, 0004 /REAL CONSTANT OF 10.0 | |
1980 | 2400 | |
1981 | 0000 | |
1982 | 0000 | |
1983 | ||
1984 | OPTEN, 7775 /REAL CONSTANT OF 0.1 (CURRENTLY NOT USED!) | |
1985 | 3146 | |
1986 | 3146 | |
1987 | 3146 | |
1988 | ||
1989 | LDAC, | |
1990 | CLAC, 0 /LOAD OR CLEAR AC-REGISTER | |
1991 | DCA AC3 | |
1992 | DCA AC2 | |
1993 | DCA AC1 | |
1994 | DCA AC0 | |
1995 | DCA ACS | |
1996 | DCA ACX | |
1997 | JMP I CLAC | |
1998 | ||
1999 | PAGE | |
2000 | \f/REAL NUMBER OUTPUT - AUXILIARY ROUTINES | |
2001 | ||
2002 | XDPOS=XR10 /AUTOINDEXING DIGITS | |
2003 | /DPOS=EXBCD /SIMPLE POINTER TO DIGITS | |
2004 | /DIG0=DOUT /NUMBUF-1 OR NUMBUF-2 (FIRST DIGIT OF MANTISSA) | |
2005 | DEXP=BCD /DECIMAL CHARACTERISTIC OF X | |
2006 | DCNT=. /DIGIT COUNTER | |
2007 | ||
2008 | FLCONV, 0 /CONVERT X*2^ACX ---> Z*10^DEXP, | |
2009 | DCA DEXP /WITH 1<=Z<10: | |
2010 | TAD AC1 | |
2011 | SNA CLA /IF NUMBER=0 THEN NO CONVERSION NECESSARY! | |
2012 | JMP I FLCONV | |
2013 | JMS SUP2 /DO SUPER CONVERSION | |
2014 | FLCLP, TAD DEXP | |
2015 | DCA DEXP | |
2016 | TAD ACX | |
2017 | SPA SNA /NOTE INTERNAL BINARY NOTATION: | |
2018 | JMP SMALL | |
2019 | TAD (-4 / 1 ..... 0.1000B+1 | |
2020 | SPA /10 ..... 0.1010B+4 | |
2021 | JMP .+5 | |
2022 | SZA CLA | |
2023 | JMP LARGE | |
2024 | TAD AC1 /HIGH ORDER WORD FOR 10 | |
2025 | TAD (-2400 /IS 2400 OCTAL! | |
2026 | SPA CLA | |
2027 | JMP I FLCONV | |
2028 | LARGE, AAAAAAAAAAAAAAAA | |
2029 | DIV TEN /:10 (OR 'MUL OPTEN' *0.1) | |
2030 | EEEEEEEEEEEEEEEE | |
2031 | L0001 | |
2032 | JMP FLCLP | |
2033 | SMALL, AAAAAAAAAAAAAAAA | |
2034 | MUL TEN /*10 | |
2035 | EEEEEEEEEEEEEEEE | |
2036 | L7777 | |
2037 | JMP FLCLP | |
2038 | ||
2039 | DPOS=. | |
2040 | EXBCD, 0 /EXTRACT BCD-DIGITS OF MANTISSA | |
2041 | TAD ACX | |
2042 | CMA | |
2043 | DCA DCNT | |
2044 | STL /(MIGHT CORRECT ILL 11TH DEC. DIGIT!) | |
2045 | DOUBLE /SHIFT OUT FIRST DIGIT | |
2046 | ISZ DCNT | |
2047 | JMP .-3 | |
2048 | TAD (NUMBUF-1 | |
2049 | DCA XDPOS | |
2050 | TAD (-12 /10 DIGITS REMAINING | |
2051 | DCA DCNT | |
2052 | DCA I (NUMBUF-1 /LEADING 0 FOR ROUNDING CARRY | |
2053 | SKP | |
2054 | JMS MUL10 | |
2055 | TAD AC0 | |
2056 | DCA I XDPOS | |
2057 | DCA AC0 | |
2058 | ISZ DCNT | |
2059 | JMP .-5 | |
2060 | TAD (NUMBUF-1 /POINT TO FIRST DIGIT | |
2061 | DCA DIG0 | |
2062 | JMP I EXBCD | |
2063 | ||
2064 | UROUND, 0 /ROUNDUP. ENTRY WITH DIGIT NO. | |
2065 | TAD DIG0 /WHERE TO START ROUNDING | |
2066 | DCA DPOS /IN HARDWARE AC | |
2067 | TAD (5 | |
2068 | CARRY, TAD (-12 | |
2069 | TAD I DPOS | |
2070 | SPA CLA | |
2071 | JMP OVR10 | |
2072 | DCA I DPOS | |
2073 | L7777 | |
2074 | TAD DPOS | |
2075 | DCA DPOS | |
2076 | ISZ I DPOS | |
2077 | JMP CARRY | |
2078 | OVR10, TAD DIG0 | |
2079 | CIA | |
2080 | TAD DPOS | |
2081 | SZA CLA /CARRY TO A NEW FIRST DIGIT? | |
2082 | JMP SKIPEX /NO | |
2083 | L7777 | |
2084 | TAD DIG0 | |
2085 | DCA DIG0 | |
2086 | ISZ DEXP | |
2087 | JMP I UROUND /MANTISSA=10 EXIT | |
2088 | SKIPEX, ISZ UROUND /NORMAL EXIT | |
2089 | JMP I UROUND | |
2090 | ||
2091 | XOUT, 0 /OUTPUT. ENTRY WITH DIGIT NO. | |
2092 | TAD DIG0 /WHERE TO START PRINTING | |
2093 | DCA XDPOS /IN HARDWARE AC | |
2094 | TAD (240 | |
2095 | PRINTC / -(S) BLANKS | |
2096 | ISZ S | |
2097 | JMP .-3 | |
2098 | TAD ACS | |
2099 | SPA CLA | |
2100 | TAD ("--240 | |
2101 | TAD (240 | |
2102 | PRINTC / THE SIGN (- OR BLANK) | |
2103 | JMS DOUT / -(P) DIGITS (OR ZERO) | |
2104 | ISZ P | |
2105 | JMP .-2 | |
2106 | TAD (". / THE DECIMAL POINT | |
2107 | PRINTC | |
2108 | JMS DOUT / -(F) DIGITS (OR ZEROES) | |
2109 | ISZ F | |
2110 | JMP .-2 | |
2111 | JMP I XOUT | |
2112 | ||
2113 | DIG0=. | |
2114 | DOUT, 0 /IF XDPOS POINTS INTO BUFFER | |
2115 | TAD XDPOS /THEN PRINT THE DIGIT | |
2116 | TAD (-NUMBUF-12 /ELSE PRINT A ZERO | |
2117 | CLL | |
2118 | TAD (14 | |
2119 | CLA | |
2120 | TAD I XDPOS | |
2121 | SNL | |
2122 | CLA | |
2123 | TAD ("0 | |
2124 | PRINTC | |
2125 | JMP I DOUT | |
2126 | ||
2127 | PAGE | |
2128 | \f/R E A L A R I T H M E T I C | |
2129 | / | |
2130 | /RADD: AC:=AC+OP | |
2131 | /RSUB: AC:=AC-OP | |
2132 | /RMUL: AC:=AC*OP | |
2133 | /RDIV: AC:=AC/OP | |
2134 | / | |
2135 | /RNORM: NORMALIZE AC TO STANDARD FLOATING POINT FORMAT | |
2136 | ||
2137 | ||
2138 | RADD, 0 | |
2139 | TAD OP1 | |
2140 | SNA CLA /IF OP=0 THEN DON'T WASTE TIME! | |
2141 | JMP I RADD | |
2142 | TAD AC1 | |
2143 | SNA CLA /IF AC=0 THEN SIMPLY ADD! | |
2144 | JMP OPMAX | |
2145 | TAD ACX /COMPARE MAGNITUDE OF OPERANDS | |
2146 | CIA /AND STORE NEGATIVE DIFFERENCE | |
2147 | TAD OPX | |
2148 | SMA | |
2149 | JMP OPMAX | |
2150 | DCA RDIV /TO USE AS SHIFT COUNTER | |
2151 | ACMAX, TAD OP1 /1/ ABS(AC)>ABS(OP) ---> SHIFT OP RIGHT | |
2152 | CLL RAR | |
2153 | DCA OP1 | |
2154 | TAD OP2 | |
2155 | RAR | |
2156 | DCA OP2 | |
2157 | TAD OP3 | |
2158 | RAR | |
2159 | DCA OP3 | |
2160 | ISZ RDIV | |
2161 | JMP ACMAX | |
2162 | JMP SETSGN | |
2163 | OPMAX, CMA /2/ ABS(OP)>=ABS(AC) | |
2164 | DCA RDIV | |
2165 | TAD OPX /RESULT IS OF MAGNITUDE OF OP | |
2166 | DCA ACX | |
2167 | SKP | |
2168 | HALVE /SHIFT AC RIGHT | |
2169 | ISZ RDIV | |
2170 | JMP .-2 | |
2171 | SETSGN, JMS OADD /MANTISSAS NOW ALIGNED! - ADD. | |
2172 | JMS RNORM /NORMALIZE RESULT | |
2173 | JMP I RADD | |
2174 | ||
2175 | RSUB, 0 | |
2176 | JMS OSUB /OP:=-OP | |
2177 | JMS RADD /AC:=AC+(-OP) | |
2178 | JMP I RSUB | |
2179 | OSUB, 0 | |
2180 | L4000 | |
2181 | TAD OPS | |
2182 | DCA OPS | |
2183 | JMP I OSUB | |
2184 | ||
2185 | RMUL, 0 | |
2186 | TAD OP1 | |
2187 | SNA CLA | |
2188 | JMS CLAC | |
2189 | TAD AC1 | |
2190 | SNA CLA /IF OP=0 OR AC=0 | |
2191 | JMP I RMUL /THEN DON'T WASTE TIME! | |
2192 | DCA MQ1 | |
2193 | DCA MQ2 /CLEAR MQ-REGISTER (FOR 'BMUL') | |
2194 | DCA MQ3 | |
2195 | TAD OPS /SETUP SIGN OF PRODUCT | |
2196 | TAD ACS | |
2197 | DCA ACS | |
2198 | L7777 | |
2199 | TAD OPX /COMPUTE EXPONENT OF PRODUCT | |
2200 | TAD ACX | |
2201 | DCA ACX | |
2202 | L0001 | |
2203 | JMS BMUL /MULTIPLY MANTISSAS | |
2204 | JMS RNORM | |
2205 | JMP I RMUL | |
2206 | ||
2207 | RDIV, 0 | |
2208 | TAD OP1 | |
2209 | SNA CLA | |
2210 | ERROR0, HALT /D I V I S I O N BY Z E R O ! | |
2211 | DCA MQ1 | |
2212 | DCA MQ2 /CLEAR MQ-REGISTER (FOR 'BDIV') | |
2213 | DCA MQ3 | |
2214 | TAD OPS /SETUP SIGN OF QUOTIENT | |
2215 | TAD ACS | |
2216 | DCA ACS | |
2217 | TAD OPX /COMPUTE EXPONENT OF QUOTIENT | |
2218 | CIA | |
2219 | TAD ACX | |
2220 | DCA ACX | |
2221 | JMS BDIV /DIVIDE MANTISSAS | |
2222 | JMS RNORM | |
2223 | JMP I RDIV | |
2224 | ||
2225 | RNORM, 0 | |
2226 | CLA CLL | |
2227 | TOOBIG, TAD AC1 | |
2228 | AND (4000 /(NO 'L4000' BECAUSE OF LINK!) | |
2229 | TAD AC0 | |
2230 | SNA CLA /WHILE MANTISSA TOO BIG (>=1) | |
2231 | JMP ROUNDUP | |
2232 | HALVE /HALVE IT (SHIFT RIGHT) | |
2233 | ISZ ACX /AND CORRECT THE EXPONENT (+1) | |
2234 | NOP | |
2235 | JMP TOOBIG | |
2236 | ROUNDUP,SZL /IF A BINARY 1 WAS SHIFTED OUT | |
2237 | ISZ AC3 /THEN ROUND MANTISSA | |
2238 | JMP NULLAC | |
2239 | ISZ AC2 | |
2240 | JMP NULLAC | |
2241 | ISZ AC1 /(CAN'T SKIP!) | |
2242 | JMP RNORM+1 | |
2243 | NULLAC, JMS SNAC /CHECK FOR NULL MANTISSA | |
2244 | JMP ISNULL | |
2245 | TOOSMALL,L2000 | |
2246 | AND AC1 | |
2247 | SZA CLA /WHILE MANTISSA TOO SMALL (<0.5) | |
2248 | JMP ISNULL+1 | |
2249 | DOUBLE /DOUBLE IT (SHIFT LEFT) | |
2250 | L7777 /AND CORRECT THE EXPONENT (-1) | |
2251 | TAD ACX | |
2252 | DCA ACX | |
2253 | JMP TOOSMALL | |
2254 | ISNULL, JMS CLAC | |
2255 | L2000 /CHECK FOR OVER- OR UNDERFLOW | |
2256 | TAD ACX | |
2257 | SMA CLA | |
2258 | JMP I RNORM /OKAY! | |
2259 | TAD ACX | |
2260 | SPA CLA | |
2261 | ERROR1, HALT /U N D E R F L O W ! | |
2262 | ERROR2, HALT /O V E R F L O W ! | |
2263 | ||
2264 | PAGE | |
2265 | \f/I N T E G E R I N P U T AND O U T P U T | |
2266 | / | |
2267 | / | |
2268 | ||
2269 | /M /MINIMUM FIELD WITH | |
2270 | DI, 0 /-NUMBER OF DIGITS TO PRINT | |
2271 | SI, 0 /-NUMBER OF LEADING BLANKS | |
2272 | LDBLANK,240 /OR OTHER LEADING CHARACTER | |
2273 | NEGATIV,0 /IF NUMBER NEGATIVE THEN -1 ELSE 0 | |
2274 | ||
2275 | IINP, 0 | |
2276 | SKP CLA | |
2277 | READC /IGNORE LEADING BLANKS | |
2278 | TAD CHAR | |
2279 | TAD (-240 | |
2280 | SNA CLA | |
2281 | JMP .-4 | |
2282 | JMS PMXXX /INPUT +-0123456789 AND CONVERT TO BINARY | |
2283 | JMS INORM /CHECK OVERFLOW (MAXINT=34359738367) | |
2284 | JMP I IINP | |
2285 | ||
2286 | PTD=IINP | |
2287 | ||
2288 | IOUT, 0 | |
2289 | TAD [240 /KLUDGE! CHOOSE THE LEADING CHARACTER | |
2290 | DCA LDBLANK /WITH A TAD (XXX-240 BEFORE CALLING IOUT | |
2291 | TAD ACS | |
2292 | SPA CLA | |
2293 | L7777 | |
2294 | DCA NEGATIV | |
2295 | TAD (NUMBUF+12 | |
2296 | DCA PTD /POINT TO RIGHTMOST POS. OF BUFFER | |
2297 | DCA I PTD /STORE A 0 CASE NUMBER=0 | |
2298 | DECONV, JMS SNAC | |
2299 | JMP OFORM | |
2300 | L7777 | |
2301 | TAD PTD /DECREMENT POINTER | |
2302 | DCA PTD | |
2303 | AAAAAAAAAAAAAAAA | |
2304 | DIV INT&IO /AC:=AC DIV 10 | |
2305 | EEEEEEEEEEEEEEEE | |
2306 | TAD MQ3 | |
2307 | CLL RAR /GET REST OF ABOVE DIVISION | |
2308 | JMP DECONV-1 /AND STORE AS BCD-DIGIT | |
2309 | OFORM, TAD (-NUMBUF-12 | |
2310 | TAD PTD | |
2311 | SMA | |
2312 | L7777 /AT LEAST ONE DIGIT TO PRINT (THINK OF 0) | |
2313 | DCA DI /DI:=-NUMBER OF DIGITS | |
2314 | TAD NEGATIV /TAKE ACCOUNT OF EV. - SIGN | |
2315 | TAD M | |
2316 | TAD DI | |
2317 | SPA /IF FIELD WIDTH < NO. OF DIGITS | |
2318 | CLA /THEN SI:=-1 | |
2319 | CMA /ELSE SI:=-(FIELD WIDTH - DIGITS) - 1 | |
2320 | DCA SI | |
2321 | JMP .+3 | |
2322 | LDCHAR, TAD LDBLANK | |
2323 | PRINTC /LEADING BLANKS | |
2324 | ISZ SI | |
2325 | JMP LDCHAR | |
2326 | EVMINS, ISZ NEGATIV | |
2327 | JMP ODIGS | |
2328 | TAD ("- | |
2329 | PRINTC /MINUS SIGN (IF ANY) | |
2330 | ODIGS, TAD I PTD | |
2331 | ISZ PTD | |
2332 | TAD ("0 | |
2333 | PRINTC /DIGIT STRING | |
2334 | ISZ DI | |
2335 | JMP ODIGS | |
2336 | JMP I IOUT | |
2337 | ||
2338 | INORM, 0 /INTEGER CLEARING HOUSE ROUTINE | |
2339 | L4000 | |
2340 | AND AC1 | |
2341 | TAD AC0 | |
2342 | SZA CLA /IF AC0<>0 OR AC1>3777 THEN | |
2343 | JMP ERROR2 /O V E R F L O W | |
2344 | JMS SNAC | |
2345 | DCA ACS /DON'T FORGET THE -0 PROBLEM! | |
2346 | JMP I INORM | |
2347 | ||
2348 | IO, 0000 /INTEGER CONSTANT OF 10 | |
2349 | 0000 | |
2350 | 0000 | |
2351 | 0012 | |
2352 | \f/VARIOUS SECONDARY ROUTINES: | |
2353 | ||
2354 | XABS, 0 /AC:=ABS(AC) | |
2355 | DCA ACS | |
2356 | JMP I XABS | |
2357 | ||
2358 | XNEG, 0 /AC:=-AC (REAL AND INTEGER) | |
2359 | L4000 | |
2360 | TAD ACS | |
2361 | DCA ACS | |
2362 | JMS INORM /BUT NOT AC:=-0 ! | |
2363 | JMP I XNEG | |
2364 | ||
2365 | OGET, 0 /COPY CONTENTS OF | |
2366 | DCA AC0 /OP-REGISTER INTO AC-REGISTER | |
2367 | TAD OP1 /(AC0 IS CLEARED!) | |
2368 | DCA AC1 | |
2369 | TAD OP2 | |
2370 | DCA AC2 | |
2371 | TAD OP3 | |
2372 | DCA AC3 | |
2373 | TAD OPS | |
2374 | DCA ACS | |
2375 | TAD OPX | |
2376 | DCA ACX | |
2377 | JMP I OGET | |
2378 | ||
2379 | ENTR, 0 /COPY CONTENTS OF | |
2380 | TAD AC1 /AC-REGISTER INTO OP-REGISTER | |
2381 | DCA OP1 /(AC0 UNCHANGED!) | |
2382 | TAD AC2 | |
2383 | DCA OP2 | |
2384 | TAD AC3 | |
2385 | DCA OP3 | |
2386 | TAD ACS | |
2387 | DCA OPS | |
2388 | TAD ACX | |
2389 | DCA OPX | |
2390 | JMP I ENTR | |
2391 | ||
2392 | BOOL, 0 /ENTER WITH SKIP-INSTRUCTION | |
2393 | DCA OSKIP /IN HARDWARE AC | |
2394 | JMS SNAC | |
2395 | SKP | |
2396 | L0001 | |
2397 | TAD ACS | |
2398 | OSKIP, 0000 | |
2399 | SKP CLA | |
2400 | L0001 | |
2401 | JMP I BOOL /EXIT WITH HARDWARE AC=1 IF TRUE (SKIP) | |
2402 | /OR AC=0 IF FALSE | |
2403 | ||
2404 | PAGE | |
2405 | \f/I N T E G E R A R I T H M E T I C | |
2406 | / | |
2407 | /IADD: AC:=AC+OP | |
2408 | /ISUB: AC:=AC-OP | |
2409 | /IMUL: AC:=AC*OP | |
2410 | /IDIV: AC:=AC DIV OP | |
2411 | /IMOD: AC:=AC MOD OP | |
2412 | ||
2413 | ||
2414 | IADD, 0 | |
2415 | JMS OADD | |
2416 | JMS INORM | |
2417 | JMP I IADD | |
2418 | OADD, 0 | |
2419 | TAD ACS | |
2420 | TAD OPS | |
2421 | SNA CLA /IF BOTH OPERANDS HAVE THE SAME SIGN | |
2422 | JMP SAMESGN /THEN SIMPLY ADD THEM | |
2423 | JMS CMOP /ELSE COMPLEMENT ONE OF THEM (OP) | |
2424 | JMS BADD /AND ADD | |
2425 | TAD AC1 /BUT TAKE CARE: | |
2426 | SMA CLA /IF RESULT POSITIVE (IN 2'S COMPLEMENT) | |
2427 | JMP .+4 /THEN OKAY | |
2428 | JMS CMAC /ELSE COMPLEMENT AC | |
2429 | TAD OPS /AND USE SIGN OF OP | |
2430 | DCA ACS | |
2431 | DCA AC0 /NO OVERFLOW IN THIS CASE! | |
2432 | JMP I OADD | |
2433 | SAMESGN,JMS BADD | |
2434 | JMP I OADD | |
2435 | ||
2436 | ISUB, 0 | |
2437 | JMS OSUB /OP:=-OP | |
2438 | JMS IADD /AC:=AC+(-OP) | |
2439 | JMP I ISUB | |
2440 | ||
2441 | IMUL, 0 | |
2442 | JMS SNOP /IF OP=0 | |
2443 | CLEAR /THEN PRODUCT IS 0 | |
2444 | DCA MQ1 | |
2445 | DCA MQ2 /CLEAR MQ-REGISTER (BMUL NEEDS THAT!) | |
2446 | DCA MQ3 | |
2447 | TAD OPS /SETUP SIGN OF PRODUCT | |
2448 | TAD ACS | |
2449 | DCA ACS | |
2450 | JMS BMUL /MULTIPLY | |
2451 | INTMOV, JMS SNAC /IF HIGH ORDER WORDS OF PRODUCT <>0 | |
2452 | SKP | |
2453 | JMP ERROR2 /THEN O V E R F L O W ! | |
2454 | JMS SWAP /GET LOW ORDER PART INTO AC | |
2455 | HALVE /(BMUL GIVES 2*PRODUCT!) | |
2456 | JMS INORM | |
2457 | JMP I IMUL | |
2458 | ||
2459 | ||
2460 | MODSGN=IMUL | |
2461 | ||
2462 | IDIV, 0 | |
2463 | JMS SNOP | |
2464 | JMP I [ERROR0 /D I V I S I O N BY Z E R O ! | |
2465 | DOUBLE | |
2466 | JMS SWAP /PUT 2*DIVIDEND INTO MQ-REGISTER | |
2467 | DCA AC1 /AND CLEAR AC (SEE BDIV INSTRUCTIONS) | |
2468 | DCA AC2 | |
2469 | DCA AC3 | |
2470 | TAD OPS /SETUP SIGN OF QUOTIENT | |
2471 | TAD ACS | |
2472 | DCA ACS | |
2473 | TAD ACS /PATCH: SERVES | |
2474 | DCA MODSGN /FOR MOD-FUNCTION | |
2475 | JMS BDIV /DIVIDE | |
2476 | JMS INORM | |
2477 | JMP I IDIV | |
2478 | ||
2479 | IMOD, 0 | |
2480 | JMS IDIV /DIVIDE OP INTO AC | |
2481 | JMS SWAP /GET 2*REST FROM MQ-REGISTER | |
2482 | HALVE /AND HALVE IT (SEE BDIV INSTR.) | |
2483 | TAD MODSGN | |
2484 | SPA CLA /IF REST NOT NEGATIVE | |
2485 | JMS SNAC | |
2486 | JMP MODOK /THEN OKAY | |
2487 | JMS BADD /ELSE ADD OP TO MAKE IT POSITIVE | |
2488 | JMS CMAC /MORE PRECISELY: AC:=-(AC-OP) | |
2489 | MODOK, DCA ACS /SIGN IS + | |
2490 | DCA AC0 | |
2491 | JMP I IMOD | |
2492 | \f/FOUR SECONDARY ROUTINES: | |
2493 | ||
2494 | SNAC, 0 /SKIP ON NONZERO AC | |
2495 | TAD AC3 | |
2496 | SNA | |
2497 | TAD AC2 | |
2498 | SNA | |
2499 | TAD AC1 | |
2500 | SZA CLA | |
2501 | ISZ SNAC | |
2502 | JMP I SNAC | |
2503 | ||
2504 | SNOP, 0 /SKIP ON NONZERO OP | |
2505 | TAD OP3 | |
2506 | SNA | |
2507 | TAD OP2 | |
2508 | SNA | |
2509 | TAD OP1 | |
2510 | SZA CLA | |
2511 | ISZ SNOP | |
2512 | JMP I SNOP | |
2513 | ||
2514 | CMAC, 0 /2'S COMPLEMENT OF AC | |
2515 | CLA CLL | |
2516 | TAD AC3 | |
2517 | CIA | |
2518 | DCA AC3 | |
2519 | TAD AC2 | |
2520 | CMA | |
2521 | SZL | |
2522 | IAC CLL | |
2523 | DCA AC2 | |
2524 | TAD AC1 | |
2525 | CMA | |
2526 | SZL | |
2527 | IAC CLL | |
2528 | DCA AC1 | |
2529 | JMP I CMAC | |
2530 | ||
2531 | CMOP, 0 /2'S COMPLEMENT OF OP | |
2532 | CLA CLL | |
2533 | TAD OP3 | |
2534 | CIA | |
2535 | DCA OP3 | |
2536 | TAD OP2 | |
2537 | CMA | |
2538 | SZL | |
2539 | IAC CLL | |
2540 | DCA OP2 | |
2541 | TAD OP1 | |
2542 | CMA | |
2543 | SZL | |
2544 | IAC CLL | |
2545 | DCA OP1 | |
2546 | JMP I CMOP | |
2547 | ||
2548 | JMSSNAC=JMS SNAC | |
2549 | ||
2550 | PAGE | |
2551 | \f | |
2552 | ||
2553 | /B I N A R Y A D D I T I O N | |
2554 | / | |
2555 | /AC0!AC1!AC2!AC3 := AC1!AC2!AC3 + OP1!OP2!OP3 | |
2556 | ||
2557 | TEMP3=. | |
2558 | ||
2559 | BADD, 0 | |
2560 | CLA CLL | |
2561 | TAD AC3 | |
2562 | TAD OP3 | |
2563 | DCA AC3 | |
2564 | RAL | |
2565 | TAD AC2 | |
2566 | TAD OP2 | |
2567 | DCA AC2 | |
2568 | RAL | |
2569 | TAD AC1 | |
2570 | TAD OP1 | |
2571 | DCA AC1 | |
2572 | RAL | |
2573 | TAD AC0 | |
2574 | DCA AC0 | |
2575 | JMP I BADD | |
2576 | ||
2577 | ||
2578 | ||
2579 | ||
2580 | /B I N A R Y M U L T I P L I C A T I O N | |
2581 | / | |
2582 | /OP=FACTOR | |
2583 | /FLOATING POINT: AC=FACTOR, MQ=0; AC=PRODUCT (HIGH ORDER) | |
2584 | /INTEGER: AC=FACTOR, MQ=0; MQ=2*PRODUCT (LOW ORDER) | |
2585 | ||
2586 | BMUL, 0 | |
2587 | TAD MIN44 /-36 | |
2588 | DCA BDIV | |
2589 | JMS SWAP | |
2590 | MULLP, JMS RACR | |
2591 | TAD MQ1 | |
2592 | RAR | |
2593 | DCA MQ1 | |
2594 | TAD MQ2 | |
2595 | RAR | |
2596 | DCA MQ2 | |
2597 | TAD MQ3 | |
2598 | RAR | |
2599 | DCA MQ3 | |
2600 | SZL | |
2601 | JMS BADD | |
2602 | ISZ BDIV | |
2603 | JMP MULLP | |
2604 | JMP I BMUL | |
2605 | \f/B I N A R Y D I V I S I O N | |
2606 | / | |
2607 | /OP=DIVISOR | |
2608 | /FLOATING POINT: AC=DIVIDEND, MQ=0; AC=QUOTIENT | |
2609 | /INTEGER: AC=0, MQ=2*DIVIDEND; AC=QUOTIENT, MQ=2*REST | |
2610 | ||
2611 | BDIV, 0 | |
2612 | TAD MIN44 /-36 | |
2613 | DCA BMUL | |
2614 | JMS CMOP | |
2615 | DIVLP, CLL /COMPARE AC AND OP | |
2616 | TAD AC3 | |
2617 | TAD OP3 | |
2618 | DCA TEMP3 /SAVE DIFFERENCE | |
2619 | RAL | |
2620 | TAD AC2 | |
2621 | TAD OP2 | |
2622 | DCA TEMP2 | |
2623 | RAL | |
2624 | TAD AC1 | |
2625 | TAD OP1 | |
2626 | SNL /AC > OP? | |
2627 | JMP .+6 | |
2628 | DCA AC1 /YES, SETUP DIFFERENCE | |
2629 | TAD TEMP2 | |
2630 | DCA AC2 | |
2631 | TAD TEMP3 | |
2632 | DCA AC3 | |
2633 | CLA | |
2634 | TAD MQ3 /SHIFT IN NEW BIT OF QUOTIENT | |
2635 | RAL /AND DOUBLE DIVIDEND | |
2636 | DCA MQ3 | |
2637 | TAD MQ2 | |
2638 | RAL | |
2639 | DCA MQ2 | |
2640 | TAD MQ1 | |
2641 | RAL | |
2642 | DCA MQ1 | |
2643 | JMS RACL | |
2644 | ISZ BMUL | |
2645 | JMP DIVLP | |
2646 | JMS SWAP | |
2647 | JMP I BDIV | |
2648 | \f/OTHER BINARY OPERATIONS: | |
2649 | ||
2650 | ||
2651 | ||
2652 | MUL2, | |
2653 | RACL, 0 /SHIFT AC ONE BIT LEFT (=DOUBLE) | |
2654 | TAD AC3 /TAKE CARE OF LINK CALLING RACL!!! | |
2655 | RAL | |
2656 | DCA AC3 | |
2657 | TAD AC2 | |
2658 | RAL | |
2659 | DCA AC2 | |
2660 | TAD AC1 | |
2661 | RAL | |
2662 | DCA AC1 | |
2663 | TAD AC0 | |
2664 | RAL | |
2665 | DCA AC0 | |
2666 | JMP I RACL | |
2667 | ||
2668 | ||
2669 | TEMP2=. | |
2670 | ||
2671 | MUL10, 0 /AC TIMES 10 | |
2672 | JMS ENTR /LINK MUST BE 0 ON ENTRY!!! | |
2673 | JMS MUL2 | |
2674 | JMS MUL2 | |
2675 | JMS BADD | |
2676 | JMS MUL2 | |
2677 | JMP I MUL10 | |
2678 | ||
2679 | ||
2680 | ||
2681 | ||
2682 | RACR, 0 /SHIFT AC ONE BIT RIGHT (=HALVE) | |
2683 | TAD AC0 | |
2684 | CLL RAR | |
2685 | DCA AC0 | |
2686 | TAD AC1 | |
2687 | RAR | |
2688 | DCA AC1 | |
2689 | TAD AC2 | |
2690 | RAR | |
2691 | DCA AC2 | |
2692 | TAD AC3 | |
2693 | RAR | |
2694 | DCA AC3 | |
2695 | JMP I RACR | |
2696 | ||
2697 | ||
2698 | ||
2699 | ||
2700 | ||
2701 | ||
2702 | ||
2703 | ||
2704 | SWAP, 0 /SWAP AC- AND MQ-REGISTER | |
2705 | TAD AC1 | |
2706 | MQL | |
2707 | TAD MQ1 | |
2708 | DCA AC1 | |
2709 | TAD AC2 | |
2710 | SWP | |
2711 | DCA MQ1 | |
2712 | TAD MQ2 | |
2713 | DCA AC2 | |
2714 | TAD AC3 | |
2715 | SWP | |
2716 | DCA MQ2 | |
2717 | TAD MQ3 | |
2718 | DCA AC3 | |
2719 | MQA | |
2720 | DCA MQ3 | |
2721 | JMP I SWAP | |
2722 | ||
2723 | PAGE | |
2724 | \f/ A R I T H M E T I C P A C K A G E | |
2725 | /OPTION: | |
2726 | / S U P E R C O N V E R S I O N O V E R L A Y | |
2727 | ||
2728 | ||
2729 | /POWERS OF TEN TABLE: | |
2730 | ||
2731 | P1E1, 0004;2400;0000;0000 / 1.0E+001 | |
2732 | 0007;3100;0000;0000 / 1.0E+002 | |
2733 | 0016;2342;0000;0000 / 1.0E+004 | |
2734 | 0033;2765;7020;0000 / 1.0E+008 | |
2735 | 0066;2160;6744;6770 / 1.0E+016 | |
2736 | 0153;2356;1326;6501 / 1.0E+032 | |
2737 | 0325;3023;6017;5120 / 1.0E+064 | |
2738 | 0652;2235;6443;7114 / 1.0E+128 | |
2739 | P1E256, 1523;2523;7565;7735 / 1.0E+256 | |
2740 | 3245;3430;6320;2565 / 1.0E+512 (SERVES AS A GUARD) | |
2741 | ||
2742 | P1E2N, 0 /POINTER INTO TABLE | |
2743 | DECP, 0 /DECIMAL CHARACTERISTIC | |
2744 | /DEXP=BCD / --- " --- (SEE 'FLCONV') | |
2745 | ||
2746 | SUP1, 0 /INPUT CONVERSION (OVERLAYS 'ADJUST') | |
2747 | SPA /IF DECIMAL CHARACTERISTIC >= 0 | |
2748 | JMP .+4 | |
2749 | DCA DECP /THEN STORE AS IT IS | |
2750 | TAD (MUL P1E1 /AND SETUP FOR MULTIPLY | |
2751 | JMP .+4 /WITH POWERS OF 10 | |
2752 | CIA | |
2753 | DCA DECP /ELSE MAKE IT POSITIVE | |
2754 | TAD (DIV P1E1 /AND SETUP FOR DIVIDE | |
2755 | DCA MD1E2N /BY POWERS OF 10 | |
2756 | ADJLP, TAD DECP | |
2757 | SNA /WHILE DECP<>0 DO: | |
2758 | JMP I SUP1 | |
2759 | CLL RAR /DECP:=DECP DIV 2 | |
2760 | DCA DECP | |
2761 | SNL /IF DECP WAS ODD | |
2762 | JMP .+4 | |
2763 | AAAAAAAAAAAAAAAA | |
2764 | MD1E2N, MUL . /THEN MULTIPLY WITH (DIVIDE BY) 1.0E+2N | |
2765 | EEEEEEEEEEEEEEEE | |
2766 | L0004 | |
2767 | TAD MD1E2N /POINT TO NEXT POWER OF TEN | |
2768 | DCA MD1E2N | |
2769 | JMP ADJLP | |
2770 | ||
2771 | ||
2772 | SUP2, 0 /OUTPUT CONVERSION (OVERLAYS 'FLCONV') | |
2773 | AAAAAAAAAAAAAAAA | |
2774 | PUT XAC /SAVE NUMBER IN AC | |
2775 | EEEEEEEEEEEEEEEE | |
2776 | TAD XAC /GET BINARY EXPONENT | |
2777 | SPA /(2'S COMPLEMENT!) | |
2778 | CIA /AND LOAD IT AS POSITIVE INTEGER | |
2779 | LOAD /INTO AC-REGISTER | |
2780 | AAAAAAAAAAAAAAAA/NOTE: LG(2) IS APPROXIMATED BY 1233/4096 | |
2781 | MUL INT&O1233 /*1233 | |
2782 | EEEEEEEEEEEEEEEE | |
2783 | L4000 | |
2784 | AND XAC | |
2785 | CLL RAL | |
2786 | TAD AC2 /DIV 4096 | |
2787 | SZL /IF XAC<0 | |
2788 | CMA /THEN DEXP := -XAC*1233 DIV 4096 - 1 | |
2789 | DCA DEXP /ELSE DEXP := XAC*1233 DIV 4096 | |
2790 | AAAAAAAAAAAAAAAA | |
2791 | GET XAC /RESTORE NUMBER | |
2792 | EEEEEEEEEEEEEEEE | |
2793 | TAD DEXP | |
2794 | CIA | |
2795 | JMS SUP1 /DO CONVERSION TO DECIMAL FLOATING POINT | |
2796 | JMP I SUP2 | |
2797 | ||
2798 | XAC, ZBLOCK 4 | |
2799 | O1233, 0000;0000;0000;2321 /1233 (INTEGER) | |
2800 | ||
2801 | ||
2802 | TRUEFALSE, TEXT /TRUEFALSE/ | |
2803 | ||
2804 | ||
2805 | XISQU, 0 /AC := AC^2 (INTEGER) | |
2806 | JMS ENTR | |
2807 | JMS IMUL | |
2808 | JMP I XISQU | |
2809 | ||
2810 | XRSQU, 0 /AC := AC^2 (REAL) | |
2811 | JMS ENTR | |
2812 | JMS RMUL | |
2813 | JMP I XRSQU | |
2814 | ||
2815 | PAGE | |
2816 | \f | |
2817 | /********************** | |
2818 | / S Q U A R E R O O T | |
2819 | / | |
2820 | / AC := SQRT(AC) | |
2821 | /********************** | |
2822 | ||
2823 | ||
2824 | XSQRT, 0 | |
2825 | TAD ACS | |
2826 | SPA CLA | |
2827 | ERROR3, HALT /SQUARE ROOT OF N E G A T I V E NUMBER! | |
2828 | TAD AC1 | |
2829 | SNA CLA | |
2830 | JMP I XSQRT /DON'T WASTE TIME FOR SQRT(0)! | |
2831 | L0001 | |
2832 | TAD ACX /TRANSFORM ARGUMENT TO THE FORM | |
2833 | SPA SZL / 2^(2*N) * F WITH 0.25 <= F < 1 | |
2834 | CML | |
2835 | RAR | |
2836 | DCA ROOTX /SAVE N | |
2837 | SNL /IF ODD(EXPONENT) | |
2838 | L7777 /THEN ACX:=-1 (0.25 <= F < 0.5) | |
2839 | DCA ACX /ELSE ACX:= 0 (0.5 <= F < 1 ) | |
2840 | AAAAAAAAAAAAAAAA | |
2841 | PUT SQARG /SAVE F | |
2842 | EEEEEEEEEEEEEEEE | |
2843 | TAD ACX /COMPUTE INITIAL VALUE X0 FOR NEWTON: | |
2844 | DCA OPOINT5 /X0:=F + 0.25 (0.25 <= F < 0.5) | |
2845 | L7777 /X0:=F/2 + 0.5 (0.5 <= F < 1 ) | |
2846 | DCA ACX | |
2847 | AAAAAAAAAAAAAAAA | |
2848 | ADD OPOINT5 | |
2849 | EEEEEEEEEEEEEEEE | |
2850 | L7775 /3 ITERATION LOOPS GUARANTEE | |
2851 | DCA NEWTON /FULL PRECISION! (MAX. ERROR: 8.0E-13) | |
2852 | SQLOOP, AAAAAAAAAAAAAAAA | |
2853 | PUT X123 | |
2854 | GET SQARG | |
2855 | DIV X123 | |
2856 | ADD X123 /X[I+1] := (F/X[I] + X[I])/2 | |
2857 | EEEEEEEEEEEEEEEE | |
2858 | L7777 /HALVE BY ACX:=ACX - 1 | |
2859 | TAD ACX | |
2860 | DCA ACX | |
2861 | ISZ NEWTON /IF DONE 3 LOOPS | |
2862 | JMP SQLOOP | |
2863 | TAD ROOTX /THEN INSERT EXPONENT N OF ROOT | |
2864 | TAD ACX | |
2865 | DCA ACX | |
2866 | JMP I XSQRT | |
2867 | ||
2868 | NEWTON=. /LOOP COUNTER | |
2869 | OPOINT5,0000 /CONSTANT OF 0.5 OR 0.25 (EXPONENT WORD | |
2870 | 2000 /SET AT EXECUTION TIME) | |
2871 | 0000 | |
2872 | 0000 | |
2873 | SQARG, 0 /REDUCED ARGUMENT F | |
2874 | 0 | |
2875 | 0 | |
2876 | 0 | |
2877 | X123, 0 /TEMPORARY FOR APPROXIMATE VALUE | |
2878 | 0 | |
2879 | 0 | |
2880 | 0 | |
2881 | ROOTX, 0 /TEMPORARY FOR ROOT EXPONENT N | |
2882 | \f | |
2883 | /********************************** | |
2884 | / N A T U R A L L O G A R I T H M | |
2885 | / | |
2886 | / AC := LN(AC) | |
2887 | /********************************** | |
2888 | ||
2889 | ||
2890 | /TABLE OF CONSTANTS: | |
2891 | ||
2892 | A0, 0001 /1.84375 | |
2893 | 3540 | |
2894 | 0000 | |
2895 | 0000 | |
2896 | ||
2897 | LNA0, 0000 /0.611801541106 | |
2898 | 2344 | |
2899 | 7603 | |
2900 | 2325 | |
2901 | ||
2902 | A1, 0001 /1.65625 | |
2903 | 3240 | |
2904 | 0000 | |
2905 | 0000 | |
2906 | ||
2907 | LNA1, 0000 /0.504556010752 | |
2908 | 2011 | |
2909 | 2512 | |
2910 | 4551 | |
2911 | ||
2912 | A2, 0001 /1.5 | |
2913 | 3000 | |
2914 | 0000 | |
2915 | 0000 | |
2916 | ||
2917 | LNA2, 7777 /0.405465108108 | |
2918 | 3174 | |
2919 | 6217 | |
2920 | 5457 | |
2921 | ||
2922 | A3, 0001 /1.375 | |
2923 | 2600 | |
2924 | 0000 | |
2925 | 0000 | |
2926 | ||
2927 | LNA3, 7777 /0.318453731119 | |
2928 | 2430 | |
2929 | 3057 | |
2930 | 0207 | |
2931 | ||
2932 | A4, 0001 /1.25 | |
2933 | 2400 | |
2934 | 0000 | |
2935 | 0000 | |
2936 | ||
2937 | LNA4, 7776 /0.223143551314 | |
2938 | 3443 | |
2939 | 7737 | |
2940 | 0746 | |
2941 | ||
2942 | A5, 0001 /1.1875 | |
2943 | 2300 | |
2944 | 0000 | |
2945 | 0000 | |
2946 | ||
2947 | LNA5, 7776 /0.171850256927 | |
2948 | 2577 | |
2949 | 6301 | |
2950 | 6051 | |
2951 | ||
2952 | A6, 0001 /1.09375 | |
2953 | 2140 | |
2954 | 0000 | |
2955 | 0000 | |
2956 | ||
2957 | LNA6, 7775 /0.0896121586897 | |
2958 | 2674 | |
2959 | 1512 | |
2960 | 1271 | |
2961 | ||
2962 | A7, 0001 /1.03125 | |
2963 | 2040 | |
2964 | 0000 | |
2965 | 0000 | |
2966 | ||
2967 | LNA7, 7773 /0.0307716586668 | |
2968 | 3740 | |
2969 | 5154 | |
2970 | 1636 | |
2971 | ||
2972 | ||
2973 | PAGE | |
2974 | ||
2975 | XLOG, 0 | |
2976 | TAD ACS | |
2977 | TAD AC1 | |
2978 | SPA SNA CLA | |
2979 | ERROR4, HALT /LOGARITHM OF ZERO OR NEGATIVE NUMBER! | |
2980 | AAAAAAAAAAAAAAAA | |
2981 | PUT LNARG /SAVE ARGUMENT X = 2^N * F | |
2982 | EEEEEEEEEEEEEEEE | |
2983 | DCA LNARG /REDUCE TO FRACTION PART (0.5 <= F < 1) | |
2984 | CLL | |
2985 | TAD ACX /GET N (IN TWO'S COMPLEMENT!) | |
2986 | SPA | |
2987 | CIA STL | |
2988 | JMS LDAC /LOAD IT AS INTEGER | |
2989 | RAR | |
2990 | DCA ACS | |
2991 | AAAAAAAAAAAAAAAA | |
2992 | FLOAT /CONVERT TO REAL | |
2993 | MUL LN2 /TIMES LN(2) | |
2994 | PUT LNTEMP /AND SAVE IT | |
2995 | EEEEEEEEEEEEEEEE | |
2996 | LNLOOP, TAD LNARG+1 /FOR FURTHER REDUCTION OF THE ARGUMENT | |
2997 | AND BIT234 /SELECT THE APPROPRIATE MULTIPLIERS A(K) | |
2998 | CLL RTR /AND THEIR LOGARITHMS FROM A TABLE, | |
2999 | RTR /ACCORDING TO THE RANGE OF F. | |
3000 | TAD (A0 | |
3001 | DCA PTAK | |
3002 | L0004 | |
3003 | TAD PTAK | |
3004 | DCA PTLNAK | |
3005 | AAAAAAAAAAAAAAAA | |
3006 | GET LNTEMP | |
3007 | SUB I PTLNAK /SUBTRACT LN( A(K) ) TO COMPENSATE | |
3008 | PUT LNTEMP | |
3009 | GET I PTAK /THE MULTIPLICATION WITH A(K) | |
3010 | MUL LNARG /F' = A(K)* .... *F | |
3011 | PUT LNARG | |
3012 | EEEEEEEEEEEEEEEE | |
3013 | TAD ACX | |
3014 | SNA CLA | |
3015 | JMP LNLOOP /IT IS GUARANTEED, THAT AFTER NO MORE | |
3016 | AAAAAAAAAAAAAAAA/THAN T H R E E E MULTIPLICATIONS | |
3017 | SUB ONEPT0 /F' FITS IN THE RANGE | |
3018 | PUT LNARG / 0 <= F'-1 < 2^(-5) | |
3019 | MUL LTC6 /NOW COMPUTE LN(F') VIA TAYLOR SERIES | |
3020 | ADD LTC5 | |
3021 | MUL LNARG | |
3022 | ADD LTC4 | |
3023 | MUL LNARG | |
3024 | ADD LTC3 | |
3025 | MUL LNARG | |
3026 | ADD LTC2 | |
3027 | MUL LNARG | |
3028 | ADD ONEPT0 | |
3029 | MUL LNARG | |
3030 | ADD LNTEMP /LN(X) = N*LN(2) - LN(A(K)) ... + LN(F') | |
3031 | EEEEEEEEEEEEEEEE | |
3032 | JMP I XLOG | |
3033 | ||
3034 | BIT234, 1600 /MASK TO EXTRACT BITS 00XXX0000000 | |
3035 | PTAK, A0 /POINTER INTO TABLE | |
3036 | PTLNAK, LNA0 / --- " --- | |
3037 | ||
3038 | LNARG, 0 /ARGUMENT REGISTER | |
3039 | 0 | |
3040 | 0 | |
3041 | 0 | |
3042 | ||
3043 | LNTEMP, 0 /TEMPORARY | |
3044 | 0 | |
3045 | 0 | |
3046 | 0 | |
3047 | ||
3048 | LN2, 0000 /0.69314718 | |
3049 | 2613 | |
3050 | 4413 | |
3051 | 7676 | |
3052 | ||
3053 | LTC6, 7776 / -1/6 | |
3054 | 6525 | |
3055 | 2525 | |
3056 | 2525 | |
3057 | ||
3058 | LTC5, 7776 / 1/5 | |
3059 | 3146 | |
3060 | 3146 | |
3061 | 3146 | |
3062 | ||
3063 | LTC4, 7777 / -1/4 | |
3064 | 6000 | |
3065 | 0000 | |
3066 | 0000 | |
3067 | ||
3068 | LTC3, 7777 / 1/3 | |
3069 | 2525 | |
3070 | 2525 | |
3071 | 2525 | |
3072 | ||
3073 | LTC2, 0000 / -1/2 | |
3074 | 6000 | |
3075 | 0000 | |
3076 | 0000 | |
3077 | \f | |
3078 | /**************************************** | |
3079 | / E X P O N E N T I A L F U N C T I O N | |
3080 | / | |
3081 | / AC := EXP(AC) | |
3082 | /**************************************** | |
3083 | ||
3084 | ||
3085 | ONEPT0, | |
3086 | EX0B8, 0001 / 2^(0/8) = 1 | |
3087 | 2000 | |
3088 | 0000 | |
3089 | 0000 | |
3090 | ||
3091 | EX1B8, 0001 / 2^(1/8) | |
3092 | 2134 | |
3093 | 5340 | |
3094 | 7437 | |
3095 | ||
3096 | EX2B8, 0001 / 2^(2/8) | |
3097 | 2301 | |
3098 | 5770 | |
3099 | 1214 | |
3100 | ||
3101 | EX3B8, 0001 / 2^(3/8) | |
3102 | 2457 | |
3103 | 7553 | |
3104 | 2515 | |
3105 | ||
3106 | EX4B8, 0001 / 2^(4/8) | |
3107 | 2650 | |
3108 | 1171 | |
3109 | 4637 | |
3110 | ||
3111 | EX5B8, 0001 / 2^(5/8) | |
3112 | 3053 | |
3113 | 1625 | |
3114 | 0212 | |
3115 | ||
3116 | EX6B8, 0001 / 2^(6/8) | |
3117 | 3272 | |
3118 | 1176 | |
3119 | 3126 | |
3120 | ||
3121 | EX7B8, 0001 / 2^(7/8) | |
3122 | 3526 | |
3123 | 0143 | |
3124 | 3476 | |
3125 | ||
3126 | ||
3127 | PAGE | |
3128 | ||
3129 | ||
3130 | ||
3131 | XEXP, 0 | |
3132 | DCA TWO2N | |
3133 | TAD (ONEPT0 | |
3134 | DCA TWO2M8 | |
3135 | AAAAAAAAAAAAAAAA | |
3136 | SKNE | |
3137 | JMP EXP0 /EXP(0)=1 | |
3138 | MUL LOG2E /X*LB(2) .... EXP(X) = 2^(X*LB(2)) | |
3139 | PUT EXTEMP | |
3140 | TRUNC /SPLIT PRODUCT INTO | |
3141 | PUT INT&TWO2N-3 /INTEGER PART N | |
3142 | FLOAT | |
3143 | SUB EXTEMP /AND FRACTION F (0 <= F < 1) | |
3144 | NEGATE | |
3145 | SKLT | |
3146 | JMP .+7 | |
3147 | ADD ONEPT0 | |
3148 | EEEEEEEEEEEEEEEE | |
3149 | TAD TWO2N | |
3150 | CMA | |
3151 | DCA TWO2N | |
3152 | AAAAAAAAAAAAAAAA | |
3153 | SKNE | |
3154 | JMP EXP0 | |
3155 | EEEEEEEEEEEEEEEE | |
3156 | L0003 | |
3157 | TAD ACX | |
3158 | SPA SNA /IF F>=1/8 THEN SPLIT F INTO | |
3159 | JMP APPROX | |
3160 | CMA CLL / M/8 + R (0 < M < 8, 0 <= R < 1/8) | |
3161 | DCA EXREST | |
3162 | DOUBLE | |
3163 | ISZ EXREST | |
3164 | JMP .-2 | |
3165 | TAD AC0 | |
3166 | CLL RTL | |
3167 | TAD (ONEPT0 | |
3168 | DCA TWO2M8 /POINT TO 2^(M/8) IN TABLE | |
3169 | DCA AC0 | |
3170 | TAD (-4 | |
3171 | DCA ACX | |
3172 | JMS RNORM /NORMALIZE | |
3173 | APPROX, AAAAAAAAAAAAAAAA/COMPUTE 2^R BY A CONTINUED FRACTION | |
3174 | SKNE | |
3175 | JMP EXP0 | |
3176 | PUT EXREST | |
3177 | GET EXD3 | |
3178 | DIV EXREST | |
3179 | ADD EXREST | |
3180 | PUT EXTEMP | |
3181 | GET EXC3 | |
3182 | DIV EXTEMP | |
3183 | SUB EXREST | |
3184 | ADD EXB3 | |
3185 | PUT EXTEMP | |
3186 | GET EXA3 | |
3187 | DIV EXTEMP | |
3188 | SUB ONEPT0 | |
3189 | SKIP | |
3190 | EXP0, GET ONEPT0 | |
3191 | MUL I TWO2M8 /MULTIPLY WITH 2^(M/8) | |
3192 | EEEEEEEEEEEEEEEE | |
3193 | TAD ACX | |
3194 | TAD TWO2N /INSERT 2^N | |
3195 | DCA ACX | |
3196 | JMS RNORM /CHECK FOR OVERFLOW | |
3197 | JMP I XEXP /EXP(X) = 2^N * 2^(M/8) * 2^R | |
3198 | ||
3199 | TWO2M8, 0 /POINTER TO TABLE | |
3200 | ||
3201 | EXTEMP, 0 /ARGUMENT AND TEMPORARY | |
3202 | 0 | |
3203 | 0 | |
3204 | 0 | |
3205 | ||
3206 | EXREST, 0 /TEMPORARY REGISTER | |
3207 | 0 | |
3208 | 0 | |
3209 | 0 | |
3210 | TWO2N, 0000 /HOLDS N (MUST BE HERE!!!) | |
3211 | ||
3212 | LOG2E, 0001 /1.442695040889 | |
3213 | 2705 | |
3214 | 2435 | |
3215 | 4512 | |
3216 | ||
3217 | EXA3, 0006 /34.624680981335 | |
3218 | 2123 | |
3219 | 7726 | |
3220 | 1367 | |
3221 | ||
3222 | EXB3, 0005 /17.312340490668 | |
3223 | 2123 | |
3224 | 7726 | |
3225 | 1367 | |
3226 | ||
3227 | EXC3, 0007 /-104.068449050280 | |
3228 | 7201 | |
3229 | 0605 | |
3230 | 7007 | |
3231 | ||
3232 | EXD3, 0005 /20.813689810056 | |
3233 | 2464 | |
3234 | 0467 | |
3235 | 7155 | |
3236 | \f | |
3237 | /**************************** | |
3238 | / S I N E AND C O S I N E | |
3239 | / | |
3240 | / AC := SIN(AC) | |
3241 | / AC := COS(AC) = SIN(AC+PI/2) | |
3242 | /**************************** | |
3243 | ||
3244 | ||
3245 | XCOS, 0 | |
3246 | AAAAAAAAAAAAAAAA | |
3247 | ADD PIS2 | |
3248 | EEEEEEEEEEEEEEEE | |
3249 | JMS XSIN | |
3250 | JMP I XCOS | |
3251 | ||
3252 | OPT5, 0000 /0.5 | |
3253 | 2000 | |
3254 | 0000 | |
3255 | 0000 | |
3256 | ||
3257 | PIS2, 0001 / PI/2 | |
3258 | 3110 | |
3259 | 3755 | |
3260 | 2421 | |
3261 | ||
3262 | PI, 0002 / PI | |
3263 | 3110 | |
3264 | 3755 | |
3265 | 2421 | |
3266 | ||
3267 | COS2, 0003 /-PI^2/2! | |
3268 | 6357 | |
3269 | 2363 | |
3270 | 1157 | |
3271 | ||
3272 | SIN3, 0003 /-PI^3/3! | |
3273 | 6452 | |
3274 | 7363 | |
3275 | 4611 | |
3276 | ||
3277 | PAGE | |
3278 | ||
3279 | COS4, 0003 / PI^4/4! | |
3280 | 2017 | |
3281 | 0174 | |
3282 | 1006 | |
3283 | ||
3284 | SIN5, 0002 / PI^5/5! | |
3285 | 2431 | |
3286 | 5361 | |
3287 | 4734 | |
3288 | ||
3289 | COS6, 0001 /-PI^6/6! | |
3290 | 6527 | |
3291 | 2361 | |
3292 | 7617 | |
3293 | ||
3294 | SIN7, 0000 /-PI^7/7! | |
3295 | 6313 | |
3296 | 2263 | |
3297 | 1630 | |
3298 | ||
3299 | COS8, 7776 / PI^8/8! | |
3300 | 3607 | |
3301 | 6501 | |
3302 | 5044 | |
3303 | ||
3304 | SIN9, 7775 / PI^9/9! | |
3305 | 2501 | |
3306 | 7015 | |
3307 | 1040 | |
3308 | ||
3309 | COS10, 7773 /-PI^10/10! | |
3310 | 7233 | |
3311 | 2174 | |
3312 | 5210 | |
3313 | ||
3314 | SCARG=EXTEMP /ARGUMENT REGISTER | |
3315 | ||
3316 | ||
3317 | XSIN, 0 | |
3318 | TAD ACS /SIN(-X) = -SIN(X), THUS | |
3319 | DCA SCS /SAVE SIGN | |
3320 | DCA ACS /AND MAKE ARGUMENT POSITIVE | |
3321 | AAAAAAAAAAAAAAAA/NOW REDUCE ARGUMENT: | |
3322 | DIV PI / X/PI = N + F (0 <= F < 1) | |
3323 | PUT SCARG /SIN(X) = (-1)^N * SIN(PI*F) | |
3324 | TRUNC | |
3325 | EEEEEEEEEEEEEEEE | |
3326 | L0001 | |
3327 | AND AC3 /IF ODD(N) THEN CHANGE SIGN | |
3328 | CLL RTR | |
3329 | TAD SCS | |
3330 | DCA SCS | |
3331 | AAAAAAAAAAAAAAAA | |
3332 | FLOAT | |
3333 | SUB SCARG /-F | |
3334 | SKNE | |
3335 | JMP SCRET | |
3336 | EEEEEEEEEEEEEEEE | |
3337 | TAD ACX | |
3338 | SZA CLA /IF F>=0.5 THEN | |
3339 | JMP .+4 | |
3340 | AAAAAAAAAAAAAAAA | |
3341 | ADD ONEPT0 /F := 1 - F | |
3342 | EEEEEEEEEEEEEEEE/ SIN(PI*F) = SIN(PI*(1-F)) | |
3343 | DCA ACS /NOW ARG. REDUCED TO 0 <= F <= 0.5 | |
3344 | L0002 | |
3345 | TAD ACX | |
3346 | SPA CLA /IF F<0.125 | |
3347 | JMP TAYSIN /THEN USE SINE-SERIES | |
3348 | AAAAAAAAAAAAAAAA/ELSE SIN(PI*F) = COS(PI*(0.5-F)) | |
3349 | SUB OPT5 | |
3350 | EEEEEEEEEEEEEEEE | |
3351 | DCA ACS /F := 0.5 - F | |
3352 | L0002 | |
3353 | TAD ACX | |
3354 | SPA CLA /IF F<0.125 | |
3355 | JMP TAYCOS-1 /THEN USE COSINE-SERIES DIRECTLY | |
3356 | L7777 /ELSE COS(PI*F) = 2 * COS(PI*F/2)^2 - 1 | |
3357 | TAD ACX | |
3358 | DCA ACX /F := F/2 (1/16 <= F <= 3/16) | |
3359 | L7777 | |
3360 | DCA HFLAG /SET HALVE ARGUMENT FLAG | |
3361 | TAYCOS, AAAAAAAAAAAAAAAA | |
3362 | PUT SCARG | |
3363 | MUL SCARG | |
3364 | PUT FQU /SQUARE ARG. | |
3365 | MUL COS10 | |
3366 | ADD COS8 | |
3367 | MUL FQU | |
3368 | ADD COS6 | |
3369 | MUL FQU | |
3370 | ADD COS4 | |
3371 | MUL FQU | |
3372 | ADD COS2 | |
3373 | MUL FQU | |
3374 | ADD ONEPT0 | |
3375 | EEEEEEEEEEEEEEEE | |
3376 | ISZ HFLAG /WAS F>=0.125? | |
3377 | JMP SCRET+1 | |
3378 | AAAAAAAAAAAAAAAA/YES | |
3379 | PUT FQU | |
3380 | MUL FQU / (COS^2 - | |
3381 | SUB OPT5 / - 0.5) | |
3382 | EEEEEEEEEEEEEEEE | |
3383 | ISZ ACX / *2 | |
3384 | HFLAG, NOP | |
3385 | JMP SCRET+1 | |
3386 | TAYSIN, AAAAAAAAAAAAAAAA | |
3387 | PUT SCARG | |
3388 | MUL SCARG | |
3389 | PUT FQU | |
3390 | MUL SIN9 | |
3391 | ADD SIN7 | |
3392 | MUL FQU | |
3393 | ADD SIN5 | |
3394 | MUL FQU | |
3395 | ADD SIN3 | |
3396 | MUL FQU | |
3397 | ADD PI | |
3398 | MUL SCARG | |
3399 | SCRET, EEEEEEEEEEEEEEEE | |
3400 | TAD AC1 | |
3401 | SZA CLA | |
3402 | TAD SCS /INSERT SIGN (AVOID -0 !) | |
3403 | DCA ACS | |
3404 | JMP I XSIN | |
3405 | ||
3406 | SCS, 0 /SIGN OF RESULT | |
3407 | ||
3408 | FQU, 0 /TEMPORARY FOR SQUARES ARG. | |
3409 | 0 | |
3410 | 0 | |
3411 | 0 | |
3412 | ||
3413 | PAGE | |
3414 | \f | |
3415 | /******************** | |
3416 | / A R C T A N G E N T | |
3417 | / | |
3418 | / AC := ARCTAN(AC) | |
3419 | /******************** | |
3420 | ||
3421 | ||
3422 | ||
3423 | XATN, 0 | |
3424 | TAD ACX | |
3425 | TAD (14 | |
3426 | SPA CLA /IF ARGUMENT VERY SMALL ( < 2^(-12) ) | |
3427 | JMP I XATN /THEN ARCTAN(X)=X | |
3428 | TAD ACS | |
3429 | DCA ATNS /SAVE SIGN ... ARCTAN(-X) = -ARCTAN(X) | |
3430 | DCA ACS /AND MAKE ARGUMENT POSITIVE | |
3431 | AAAAAAAAAAAAAAAA | |
3432 | PUT ATARG | |
3433 | EEEEEEEEEEEEEEEE | |
3434 | TAD ACX | |
3435 | SPA SNA CLA /IF X>=1 | |
3436 | JMP .+7 | |
3437 | AAAAAAAAAAAAAAAA | |
3438 | GET ONEPT0 /THEN X := 1/X | |
3439 | DIV ATARG /ARCTAN(X) = PI/2 - ARCTAN(1/X) | |
3440 | PUT ATARG | |
3441 | EEEEEEEEEEEEEEEE/NOW ARGUMENT REDUCED TO 0 < X <= 1 | |
3442 | L7777 | |
3443 | DCA GT1FLAG /FLAG ARGUMENT > 1 | |
3444 | TAD ACX | |
3445 | SPA CLA /IF X>=0.5 THEN USE ADD.THEOREM: | |
3446 | JMP ATN05 | |
3447 | ISZ ATARG /2*X | |
3448 | ADDFLAG,NOP | |
3449 | AAAAAAAAAAAAAAAA/ARCTAN(X) = ARCTAN(0.5) + ARCTAN( ... ) | |
3450 | ADD TWOPT0 /X := (2*X-1)/(X+2) | |
3451 | PUT EXTEMP | |
3452 | GET ATARG | |
3453 | SUB ONEPT0 | |
3454 | DIV EXTEMP | |
3455 | PUT ATARG /ARGUMENT RANGE NOW 0 < X < 0.5 | |
3456 | EEEEEEEEEEEEEEEE | |
3457 | L7777 | |
3458 | ATN05, DCA ADDFLAG | |
3459 | AAAAAAAAAAAAAAAA/COMPUTE ARCTAN(X) BY CONTINUED FRACTION | |
3460 | MUL ATARG | |
3461 | PUT FQU | |
3462 | ADD ATB3 | |
3463 | PUT EXTEMP | |
3464 | GET ATA3 | |
3465 | DIV EXTEMP | |
3466 | ADD ATB2 | |
3467 | ADD FQU | |
3468 | PUT EXTEMP | |
3469 | GET ATA2 | |
3470 | DIV EXTEMP | |
3471 | ADD ATB1 | |
3472 | ADD FQU | |
3473 | PUT EXTEMP | |
3474 | GET ATA1 | |
3475 | DIV EXTEMP | |
3476 | ADD ATB0 | |
3477 | ADD FQU | |
3478 | PUT EXTEMP | |
3479 | GET ATA0 | |
3480 | MUL ATARG | |
3481 | DIV EXTEMP | |
3482 | EEEEEEEEEEEEEEEE | |
3483 | ISZ ADDFLAG /CORRECT RESULT IF NECESSARY | |
3484 | JMP .+4 | |
3485 | AAAAAAAAAAAAAAAA | |
3486 | ADD ATN0P5 | |
3487 | EEEEEEEEEEEEEEEE | |
3488 | ISZ GT1FLAG /WAS X>1 ? | |
3489 | JMP .+6 | |
3490 | L4000 /YES | |
3491 | DCA ACS / -ARCTAN(X) | |
3492 | AAAAAAAAAAAAAAAA | |
3493 | ADD PIS2 / +PI/2 | |
3494 | EEEEEEEEEEEEEEEE | |
3495 | TAD ATNS | |
3496 | DCA ACS /INSERT SIGN | |
3497 | JMP I XATN | |
3498 | ATNS, 0 /TEMPORARY FOR SIGN | |
3499 | GT1FLAG,0 | |
3500 | ||
3501 | ATARG, 0 /ARGUMENT REGISTER | |
3502 | 0 | |
3503 | 0 | |
3504 | 0 | |
3505 | ATA0, 0004 /12.37469388 | |
3506 | 3057 | |
3507 | 7537 | |
3508 | 4017 | |
3509 | ||
3510 | ATA1, 0007 /-80.34270560 | |
3511 | 6405 | |
3512 | 3673 | |
3513 | 4343 | |
3514 | ||
3515 | ATA2, 0001 /-1.191447224 | |
3516 | 6304 | |
3517 | 0253 | |
3518 | 6665 | |
3519 | ||
3520 | ATA3, 7775 /-0.078335428 | |
3521 | 6403 | |
3522 | 3451 | |
3523 | 4461 | |
3524 | ||
3525 | ATB0, 0005 /26.27277525 | |
3526 | 3221 | |
3527 | 3522 | |
3528 | 3121 | |
3529 | ||
3530 | ATB1, 0003 /6.36441688 | |
3531 | 3135 | |
3532 | 1757 | |
3533 | 0565 | |
3534 | ||
3535 | ATB2, 0002 /2.104518952 | |
3536 | 2065 | |
3537 | 4070 | |
3538 | 1015 | |
3539 | ||
3540 | ATB3, 0001 /1.258464113 | |
3541 | 2410 | |
3542 | 5255 | |
3543 | 0370 | |
3544 | ||
3545 | ATN0P5, 7777 /ARCTAN(0.5) | |
3546 | 3553 | |
3547 | 0634 | |
3548 | 0530 | |
3549 | ||
3550 | TWOPT0, 0002 /2.0 | |
3551 | 2000 | |
3552 | 0000 | |
3553 | 0000 | |
3554 | ||
3555 | PAGE | |
3556 | \f/I N P U T - O U T P U T ROUTINES FOR STANDARD FILES | |
3557 | ||
3558 | GETC, 0 | |
3559 | CLA CLL | |
3560 | TAD LOOK | |
3561 | DCA CHAR | |
3562 | ISZ IC3 | |
3563 | JMP G12 | |
3564 | G3, L7775 | |
3565 | DCA IC3 | |
3566 | L7776 | |
3567 | TAD IBP | |
3568 | DCA IBP | |
3569 | TAD I IBP | |
3570 | ISZ IBP | |
3571 | K377, AND (7400 /FIRST LITERAL ON THIS PAGE ---> 0377 | |
3572 | CLL RTL | |
3573 | RTL | |
3574 | DCA CHECK | |
3575 | TAD I IBP | |
3576 | AND (7400 | |
3577 | TAD CHECK | |
3578 | RTL | |
3579 | RTL | |
3580 | RAL | |
3581 | JMP GEXIT | |
3582 | G12, TAD IBP | |
3583 | AND K377 | |
3584 | SZA CLA | |
3585 | JMP GEXIT-1 | |
3586 | TAD (IBUFFER | |
3587 | DCA IBP | |
3588 | JMS I IDEVH | |
3589 | 0200 | |
3590 | IBUFFER | |
3591 | IBLOCK, 0 | |
3592 | JMP RDERR | |
3593 | ISZ IBLOCK | |
3594 | L7776 | |
3595 | DCA IC3 | |
3596 | TAD I IBP | |
3597 | GEXIT, ISZ IBP | |
3598 | JMS CHECK | |
3599 | JMP GETC+4 | |
3600 | JMP I GETC | |
3601 | RDERR, SMA CLA | |
3602 | JMP GEXIT-3 | |
3603 | FATAL0, FATAL /FATAL READ ERROR! | |
3604 | ||
3605 | IC3, -3 | |
3606 | IBP, IBUFFER | |
3607 | ||
3608 | PUTC, 0 | |
3609 | SNA | |
3610 | TAD CHAR | |
3611 | DCA CHECK | |
3612 | TAD CHECK | |
3613 | ISZ OC3 | |
3614 | JMP PUT12 | |
3615 | DCA CC | |
3616 | L7776 | |
3617 | TAD OBP | |
3618 | DCA OBP | |
3619 | JMS PUT3L | |
3620 | JMS PUT3R | |
3621 | L7775 | |
3622 | DCA OC3 | |
3623 | TAD OBP | |
3624 | AND K377 | |
3625 | SZA CLA | |
3626 | JMP PUXIT | |
3627 | ISZ MBLOCKS | |
3628 | SKP | |
3629 | JMP ERRORD | |
3630 | JMS I ODEVH | |
3631 | 4200 | |
3632 | OBUFFER | |
3633 | OBLOCK, 0 | |
3634 | JMP ERRORD | |
3635 | ISZ OBLOCK | |
3636 | TAD [OBUFFER | |
3637 | DCA OBP | |
3638 | JMP PUXIT | |
3639 | PUT12, AND K377 | |
3640 | DCA I OBP | |
3641 | ISZ OBP | |
3642 | PUXIT, TAD CHECK | |
3643 | TAD [-215 | |
3644 | SZA CLA | |
3645 | JMP I PUTC | |
3646 | TAD [212 | |
3647 | JMP PUTC+1 | |
3648 | ||
3649 | PUT3L, | |
3650 | PUT3R, 0 | |
3651 | TAD CC | |
3652 | CLL RTL | |
3653 | RTL | |
3654 | DCA CC | |
3655 | TAD CC | |
3656 | AND (7400 | |
3657 | TAD I OBP | |
3658 | DCA I OBP | |
3659 | ISZ OBP | |
3660 | JMP I PUT3R | |
3661 | ||
3662 | /OC3, 0 /ON PAGE 0! | |
3663 | /OBP, 0 / - " - | |
3664 | CHECK, 0 | |
3665 | AND [177 | |
3666 | SNA | |
3667 | JMP I CHECK | |
3668 | TAD (-15 | |
3669 | SNA | |
3670 | JMP CR | |
3671 | TAD (15-32 | |
3672 | SNA | |
3673 | JMP CR-2 | |
3674 | TAD (-6 | |
3675 | CLL | |
3676 | TAD [240 | |
3677 | DCA LOOK | |
3678 | CHEXIT, DCA EOLN | |
3679 | SNL | |
3680 | ISZ CHECK | |
3681 | JMP I CHECK | |
3682 | ||
3683 | L0001 /END OF FILE | |
3684 | DCA EOF | |
3685 | CR, TAD [240 /END OF LINE | |
3686 | DCA LOOK | |
3687 | L0001 /LINK=0! | |
3688 | JMP CHEXIT | |
3689 | ||
3690 | PAGE | |
3691 | \f/THE ORGANIZATION OF THE FOLLOWING PAGES OF FIELD 0 | |
3692 | /DEMANDS SOME EXPLANATION: | |
3693 | ||
3694 | ||
3695 | ||
3696 | / AT COMPILE TIME / AT RUNTIME / | |
3697 | / / / | |
3698 | /06000--------------------------/-------------------------------/ | |
3699 | / STARTUP CODE, THEN / / | |
3700 | / / I N P U T / | |
3701 | /06200- I N P U T (SOURCE) -----/----- -----/ | |
3702 | / F I L E B U F F E R / F I L E B U F F E R / | |
3703 | / / / | |
3704 | /06400--------------------------/-------------------------------/ | |
3705 | / / INPUT / | |
3706 | / I N P U T (SOURCE) / DEVICE HANDLER / | |
3707 | /06600- -----/-------------------------------/ | |
3708 | / D E V I C E / OUTPUT / | |
3709 | / H A N D L E R / DEVICE HANDLER / | |
3710 | /07000--------------------------/-------------------------------/ | |
3711 | / / / | |
3712 | / COMPILER PROCEDURES: / O U T P U T / | |
3713 | /07200----- -----/----- -----/ | |
3714 | / I N S Y M B O L / F I L E B U F F E R / | |
3715 | / / / | |
3716 | /07400----- AND -----/-------------------------------/ | |
3717 | / / RUNTIME ERRORS / | |
3718 | / N E X T C H / / | |
3719 | /-------------------------------/-------------------------------/ | |
3720 | ||
3721 | ||
3722 | ||
3723 | /AT COMPILATION TIME FOUR PAGES OF FIELD 6 ARE USED AS FOLLOWS: | |
3724 | ||
3725 | /66400--- TEMPORARY STORAGE OF INPUT DEVICE HANDLER | |
3726 | / | |
3727 | /66600--- TEMPORARY STORAGE OF OUTPUT DEVICE HANDLER | |
3728 | / | |
3729 | /67400--- RUNTIME ERRORS | |
3730 | / | |
3731 | /67600--- INITIALIZATION OF RUNTIME SYSTEM | |
3732 | ||
3733 | ||
3734 | ||
3735 | /DURING INITIALIZATION OF THE RUNTIME SYSTEM | |
3736 | /THE FIRST THREE PAGES ARE SWAPPED INTO THEIR PLACE IN FIELD 0! | |
3737 | \f/#############################################################/ | |
3738 | /#############################################################/ | |
3739 | /##### #####/ | |
3740 | /##### S T A R T #####/ | |
3741 | /##### #####/ | |
3742 | /#############################################################/ | |
3743 | /#############################################################/ | |
3744 | ||
3745 | ||
3746 | ||
3747 | /IMPORTANT POINTS OF PROGRAM FLOW: | |
3748 | ||
3749 | ||
3750 | /S T A R T (06000) /STARTING ADDRESS OF ENTIRE SYSTEM, | |
3751 | /PROCESS I/O-SPECIFICATIONS | |
3752 | ||
3753 | /M A I N (40200) /START OF COMPILER PROGRAM | |
3754 | ||
3755 | ||
3756 | /E X P L A I N (60200) /COMPILATION REPORT | |
3757 | ||
3758 | ||
3759 | /I N I T (67600) /INITIALIZATION OF RUNTIME SYSTEM | |
3760 | ||
3761 | ||
3762 | /I S T A R T (00200) /START OF INTERPRETER | |
3763 | ||
3764 | ||
3765 | ||
3766 | ||
3767 | /ONCE ONLY CODE!!! | |
3768 | ||
3769 | USR=200 | |
3770 | ||
3771 | *IBUFFER | |
3772 | START, CLA CLL /S T A R T I N G A D D R E S S | |
3773 | CIF 10 | |
3774 | JMS I [7700 /LOCK USR IN MEMORY | |
3775 | 10 | |
3776 | TAD (1000 /RESET JOB STATUS WORD | |
3777 | DCA I (7746 | |
3778 | CD, CIF 10 | |
3779 | JMS I (USR /CALL THE COMMAND DECODER | |
3780 | 5 | |
3781 | 2023 /ASSUMED INPUT EXTENSION: .PS | |
3782 | 0 /PHPH KEEP TENTATIVE FILES (ZERO) | |
3783 | JMS HEADER | |
3784 | CDF 10 | |
3785 | CLA CLL /PHPH | |
3786 | TAD I (7600 /GET FIRST OUTPUT DEVICE AND LENGTH | |
3787 | AND (0017 /MASK OUT A SIZE (DEV:FILE.EX[SIZE]) | |
3788 | SNA /OUTPUT FILE SPECIFIED? | |
3789 | JMP NOOUT | |
3790 | DCA DEVNO /YES, SAVE DEVICE NUMBER | |
3791 | TAD (7600 | |
3792 | DCA XR10 | |
3793 | TAD I XR10 /TRANSFER THE FILENAME | |
3794 | DCA NAME | |
3795 | TAD I XR10 | |
3796 | DCA NAME+1 | |
3797 | TAD I XR10 | |
3798 | DCA NAME+2 | |
3799 | TAD I XR10 | |
3800 | DCA NAME+3 | |
3801 | CDF 0 | |
3802 | CIF 10 | |
3803 | TAD DEVNO /DEVICE NUMBER | |
3804 | JMS I (USR /FETCH OUTPUT DEVICE HANDLER | |
3805 | 1 /OPERATION: FETCH HANDLER | |
3806 | OHEP, ODEVBUF /1 PAGE ONLY! | |
3807 | JMP CDERR | |
3808 | CIF 10 | |
3809 | TAD DEVNO | |
3810 | JMS I (USR /OPEN OUTPUT FILE | |
3811 | 3 | |
3812 | SBNO, NAME | |
3813 | LEMP, 0 | |
3814 | JMP CDERR | |
3815 | TAD OHEP /GET ENTRY POINT | |
3816 | DCA ODEVH | |
3817 | TAD SBNO /GET STARTING BLOCK NUMBER | |
3818 | DCA I (OBLOCK | |
3819 | TAD LEMP /GET LENGTH OF EMPTY | |
3820 | DCA LEMPTY | |
3821 | TAD LEMPTY | |
3822 | SZA | |
3823 | TAD (-1 /SETUP BLOCK COUNTER | |
3824 | DCA MBLOCKS /(=0 IF NOT A FILE DEVICE) | |
3825 | SKP | |
3826 | NOOUT, ISZ IHEP /ALLOW 2-PAGE INPUT HANDLER | |
3827 | /IF NO OUTPUT FILE SPECIFIED! | |
3828 | CDF 10 | |
3829 | TAD I (7621 | |
3830 | SNA /INPUT FILE SPECIFIED? | |
3831 | JMP NOINP /NO, USE INTERN KEYBOARD HANDLER! | |
3832 | CDF 0 | |
3833 | CIF 10 | |
3834 | JMS I (USR /FETCH INPUT DEVICE HANDLER | |
3835 | 1 | |
3836 | IHEP, IDEVBUF | |
3837 | JMP CDERR | |
3838 | CDF 10 | |
3839 | TAD I (7622 /GET STARTING BLOCK NUMBER | |
3840 | CDF 60 | |
3841 | DCA I (IIBLOCK | |
3842 | TAD IHEP /GET ENTRY POINT | |
3843 | DCA I (IIDEVH | |
3844 | NOINP, CDF 0 /SAVE DEVICE HANDLERS | |
3845 | TAD I F0T6 /IN FIELD 6 TO MAKE ROOM | |
3846 | CDF 60 /FOR HANDLER OF SOURCE FILE | |
3847 | DCA I F0T6 | |
3848 | ISZ F0T6 | |
3849 | ISZ C400 | |
3850 | JMP .-6 | |
3851 | CDF 10 | |
3852 | TAD I (7617 | |
3853 | SNA /SOURCE FILE SPECIFIED? | |
3854 | JMP CDERR | |
3855 | CDF 0 | |
3856 | CIF 10 | |
3857 | JMS I (USR /FETCH HANDLER OF SOURCE FILE | |
3858 | 1 | |
3859 | SHEP, IDEVBUF+1 | |
3860 | JMP CDERR | |
3861 | TAD SHEP /GET ENTRY POINT | |
3862 | DCA IDEVH | |
3863 | CDF 10 | |
3864 | TAD I (7620 | |
3865 | CDF 0 | |
3866 | DCA I (IBLOCK | |
3867 | JMP STARTC | |
3868 | ||
3869 | F0T6, IDEVBUF | |
3870 | C400, -400 | |
3871 | ||
3872 | PAGE | |
3873 | \fSTARTC, CDF 10 /CHECK /S - OPTION | |
3874 | TAD I (7644 | |
3875 | CDF 0 | |
3876 | AND (40 | |
3877 | SNA CLA | |
3878 | JMP .+3 | |
3879 | TAD (SPRINT | |
3880 | DCA PTPRINT | |
3881 | CDF CIF COMPFIELD | |
3882 | JMP I (MAIN /START COMPILER | |
3883 | ||
3884 | CDERR, CLA CLL | |
3885 | CDF CIF 0 | |
3886 | CRLF | |
3887 | TAD I CTEXT | |
3888 | SNA | |
3889 | JMP .+7 | |
3890 | BSW | |
3891 | JMS ASCII | |
3892 | TAD I CTEXT | |
3893 | JMS ASCII | |
3894 | ISZ CTEXT | |
3895 | JMP CDERR+3 | |
3896 | CRLF | |
3897 | JMP I (7605 | |
3898 | CTEXT, .+1 | |
3899 | TEXT /DATEIANGABEN FEHLERHAFT BZW. UNVOLLSTAENDIG (EV. AUCH SYSTEMFEHLER)!/ | |
3900 | 0 | |
3901 | ||
3902 | PAGE | |
3903 | \f/K E Y B O A R D I N P U T H A N D L E R | |
3904 | ||
3905 | *IDEVBUF | |
3906 | XREAD, 0 | |
3907 | CLA CLL | |
3908 | TAD LOOK | |
3909 | DCA CHAR | |
3910 | TAD EOLN | |
3911 | SZA CLA | |
3912 | JMP XLINE | |
3913 | REXIT, TAD I BP | |
3914 | ISZ BP | |
3915 | JMS CHECK | |
3916 | JMP .-3 | |
3917 | JMP I XREAD | |
3918 | ERASE, TAD [215 | |
3919 | JMS I ZPRINT | |
3920 | XLINE, TAD (IBUFFER | |
3921 | DCA BP | |
3922 | TAD ("? | |
3923 | JMS I ZPRINT | |
3924 | TAD [240 | |
3925 | JMS I ZPRINT | |
3926 | XCHAR, JMS KEYBOARD | |
3927 | DCA I BP | |
3928 | TAD I BP | |
3929 | TAD (-377 | |
3930 | SNA CLA / 'RUBOUT'? | |
3931 | JMP RUBOUT | |
3932 | TAD I BP | |
3933 | TAD (-203 | |
3934 | SNA / 'CTRL-C'? | |
3935 | JMP I OS8 | |
3936 | TAD (203-212 | |
3937 | SNA / 'LINE FEED'? | |
3938 | JMP REPLAY | |
3939 | TAD (212-215 | |
3940 | SNA / 'RETURN'? | |
3941 | JMP RETURN | |
3942 | TAD (215-225 | |
3943 | SNA / 'CTRL-U'? | |
3944 | JMP ERASE | |
3945 | TAD (225-232 | |
3946 | SNA / 'CTRL-Z'? | |
3947 | JMP EOFILE | |
3948 | TAD (232-240 | |
3949 | SPA CLA | |
3950 | JMP XCHAR | |
3951 | TAD I BP | |
3952 | JMS I ZPRINT | |
3953 | ISZ BP | |
3954 | JMP XCHAR | |
3955 | ||
3956 | RUBOUT, TAD ("\ | |
3957 | JMS I ZPRINT | |
3958 | TAD BP | |
3959 | TAD (-IBUFFER | |
3960 | SNA CLA | |
3961 | JMP YCHAR | |
3962 | L7777 | |
3963 | TAD BP | |
3964 | DCA BP | |
3965 | TAD I BP | |
3966 | JMS I ZPRINT | |
3967 | YCHAR, JMS KEYBOARD | |
3968 | DCA I BP | |
3969 | TAD I BP | |
3970 | TAD (-377 | |
3971 | SNA CLA | |
3972 | JMP RUBOUT+2 | |
3973 | TAD ("\ | |
3974 | JMS I ZPRINT | |
3975 | JMP XCHAR+2 | |
3976 | ||
3977 | REPLAY, TAD BP | |
3978 | TAD (-IBUFFER | |
3979 | SNA | |
3980 | JMP XCHAR | |
3981 | CIA | |
3982 | DCA RC | |
3983 | TAD (IBUFFER | |
3984 | DCA BP | |
3985 | TAD [215 | |
3986 | JMS I ZPRINT | |
3987 | TAD ("? | |
3988 | JMS I ZPRINT | |
3989 | TAD [240 | |
3990 | JMS I ZPRINT | |
3991 | TAD I BP | |
3992 | JMS I ZPRINT | |
3993 | ISZ BP | |
3994 | ISZ RC | |
3995 | JMP .-4 | |
3996 | JMP XCHAR | |
3997 | ||
3998 | EOFILE, TAD [240 | |
3999 | JMS I ZPRINT | |
4000 | TAD ("E | |
4001 | JMS I ZPRINT | |
4002 | TAD ("O | |
4003 | JMS I ZPRINT | |
4004 | TAD ("F | |
4005 | JMS I ZPRINT | |
4006 | RETURN, TAD [215 | |
4007 | JMS I ZPRINT | |
4008 | TAD (IBUFFER | |
4009 | DCA BP | |
4010 | JMP REXIT | |
4011 | ||
4012 | KEYBOARD,0 | |
4013 | KSF | |
4014 | JMP .-1 | |
4015 | KRB | |
4016 | AND [177 | |
4017 | SNA | |
4018 | JMP KEYBOARD+1 | |
4019 | TAD (200 | |
4020 | JMP I KEYBOARD | |
4021 | ||
4022 | BP, IBUFFER | |
4023 | RC=KEYBOARD | |
4024 | ||
4025 | PAGE | |
4026 | \f/H E A D E R L I N E | |
4027 | ||
4028 | *ODEVBUF | |
4029 | HEADER, 0 /ONCE ONLY CODE! | |
4030 | CDF 10 | |
4031 | TAD I (7666 /GET DATE WORD FROM MONITOR | |
4032 | CDF 0 | |
4033 | SNA | |
4034 | JMP WHEAD-1 | |
4035 | MQL | |
4036 | TAD (HDATE | |
4037 | DCA XR10 | |
4038 | MQA /YEAR | |
4039 | AND (7 | |
4040 | TAD (116 /78 | |
4041 | JMS YYMMDD | |
4042 | MQA /MONTH | |
4043 | BSW | |
4044 | RTR | |
4045 | AND (17 | |
4046 | JMS YYMMDD | |
4047 | MQA /DAY | |
4048 | RTR | |
4049 | RAR | |
4050 | AND (37 | |
4051 | JMS YYMMDD | |
4052 | SKP | |
4053 | DCA HDATE | |
4054 | WHEAD, TAD (PASCAL-1 | |
4055 | DCA XR10 | |
4056 | TAD I XR10 | |
4057 | SNA | |
4058 | WHEND, JMP .+3 /BECOMES: JMP WHEXIT | |
4059 | PRINTC | |
4060 | JMP .-4 | |
4061 | TAD H240 | |
4062 | PRINTC | |
4063 | ISZ BLANKS | |
4064 | JMP .-3 | |
4065 | TAD (JMP WHEXIT | |
4066 | DCA WHEND | |
4067 | JMP WHEAD+2 | |
4068 | WHEXIT, CRLF | |
4069 | CRLF | |
4070 | JMP I HEADER | |
4071 | ||
4072 | YYMMDD, 0 | |
4073 | DCA DAT01 | |
4074 | DCA DAT10 | |
4075 | JMP .+3 | |
4076 | DCA DAT01 | |
4077 | ISZ DAT10 | |
4078 | TAD DAT01 | |
4079 | TAD (-12 | |
4080 | SMA | |
4081 | JMP .-5 | |
4082 | CLA | |
4083 | ISZ XR10 | |
4084 | TAD DAT10 | |
4085 | TAD H260 | |
4086 | DCA I XR10 | |
4087 | TAD DAT01 | |
4088 | TAD H260 | |
4089 | DCA I XR10 | |
4090 | JMP I YYMMDD | |
4091 | ||
4092 | H215=. | |
4093 | PASCAL, 215;"P;240;"A;240;"S;240;"C;240;"A;240;"L | |
4094 | 240;"-;240;"S;240;240;240 | |
4095 | "C;"O;"M;"P;"I;"L;"E;"R | |
4096 | H240, 240 | |
4097 | "V | |
4098 | H260, "0 | |
4099 | VERSION+"0 | |
4100 | 0000 | |
4101 | HTLMOE, "H;"T;"L;"-;"M;"O;"E;"D;"L;"I;"N;"G | |
4102 | HDATE, ", /BECOMES: 0000 IF NO DATE SPECIFIED | |
4103 | 240 | |
4104 | 0000 /YEAR | |
4105 | 0000 | |
4106 | "- | |
4107 | 0000 /MONTH | |
4108 | 0000 | |
4109 | "- | |
4110 | DAT10, 0000 /DAY | |
4111 | DAT01, 0000 | |
4112 | BLANKS, -30 /BECOMES 0000 | |
4113 | ||
4114 | PAGE | |
4115 | \f/BEGIN OF COMPILER PROGRAM: T H E S C A N N E R | |
4116 | ||
4117 | NEXTCH=READC | |
4118 | ||
4119 | SY0=H1 /FIELD 0 REPRESENTATIVE OF 'SY' | |
4120 | KSY=H2 | |
4121 | SPS=H3 | |
4122 | K=H4 | |
4123 | INTORINP=PC | |
4124 | ||
4125 | *7000 | |
4126 | INSY0, SKP CLA | |
4127 | NEXTCH | |
4128 | TAD CHAR | |
4129 | TAD [-240 | |
4130 | SNA CLA | |
4131 | JMP .-4 | |
4132 | SNALF | |
4133 | JMP WSYMBOL | |
4134 | SKDIG | |
4135 | JMP SPSYM | |
4136 | NUMBER, TAD (FRACTN | |
4137 | DCA INTORINP | |
4138 | DCA SY0 /0=INTCON | |
4139 | JMS IINP | |
4140 | TAD CHAR | |
4141 | TAD (-". | |
4142 | SZA CLA | |
4143 | JMP ECHAR | |
4144 | NEXTCH | |
4145 | TAD CHAR | |
4146 | TAD (-". | |
4147 | SNA CLA | |
4148 | JMP RETNUM-2 | |
4149 | REALGO, L0001 | |
4150 | DCA SY0 /1=REALCON | |
4151 | TAD OC | |
4152 | CIA | |
4153 | DCA DC | |
4154 | JMP I INTORINP | |
4155 | ECHAR, ISZ INTORINP | |
4156 | TAD CHAR | |
4157 | TAD (-"E | |
4158 | SNA CLA | |
4159 | JMP REALGO | |
4160 | JMP RETNUM | |
4161 | TAD (": | |
4162 | DCA CHAR | |
4163 | RETNUM, JMS PACK | |
4164 | TAD (NUM-1 | |
4165 | RETID, DCA XR10 | |
4166 | CDF COMPFIELD | |
4167 | TAD AC0 | |
4168 | DCA I XR10 | |
4169 | TAD AC1 | |
4170 | DCA I XR10 | |
4171 | TAD AC2 | |
4172 | DCA I XR10 | |
4173 | TAD AC3 | |
4174 | DCA I XR10 | |
4175 | RETSYM, TAD SY0 | |
4176 | CDF CIF COMPFIELD | |
4177 | JMP I (EXSY3 | |
4178 | WSYMBOL,DCA K /USE AC FOR ID IN FIELD 0 | |
4179 | CLEAR | |
4180 | AZ09, TAD K | |
4181 | TAD (-ALNG | |
4182 | SMA CLA | |
4183 | JMP .+4 | |
4184 | L0100 /=2*AC0, LINK=0 | |
4185 | JMS CPACK | |
4186 | ISZ K | |
4187 | NEXTCH | |
4188 | SKDIG | |
4189 | SNALF | |
4190 | JMP AZ09 | |
4191 | L0001 /BUILD HASH-CODE | |
4192 | TAD AC0 | |
4193 | BSW | |
4194 | RTL | |
4195 | CLA | |
4196 | TAD AC0 | |
4197 | BSW | |
4198 | TAD AC1 | |
4199 | AND [77 | |
4200 | RAL | |
4201 | MQL /IN MQ | |
4202 | MQA | |
4203 | TAD (KSYTABLE | |
4204 | DCA KSY | |
4205 | MQA | |
4206 | CLL RTL | |
4207 | TAD (HASHTABLE-1 | |
4208 | DCA XR10 | |
4209 | CDF NAMEFIELD | |
4210 | TAD I XR10 | |
4211 | CIA | |
4212 | TAD AC0 | |
4213 | SZA CLA | |
4214 | JMP XIDENT | |
4215 | TAD I XR10 | |
4216 | CIA | |
4217 | TAD AC1 | |
4218 | SZA CLA | |
4219 | JMP XIDENT | |
4220 | TAD I XR10 | |
4221 | CIA | |
4222 | TAD AC2 | |
4223 | SZA CLA | |
4224 | JMP XIDENT | |
4225 | TAD I XR10 | |
4226 | CIA | |
4227 | TAD AC3 | |
4228 | SZA CLA | |
4229 | JMP XIDENT | |
4230 | TAD I KSY | |
4231 | JMP RETSYM+1 | |
4232 | XIDENT, TAD (IDENT | |
4233 | DCA SY0 | |
4234 | TAD (ID-1 | |
4235 | JMP RETID | |
4236 | ||
4237 | PAGE | |
4238 | \fSPSYM, TAD CHAR | |
4239 | TAD (CHARTABLE-240 | |
4240 | DCA SPS | |
4241 | CDF NAMEFIELD | |
4242 | TAD I SPS | |
4243 | CDF 0 | |
4244 | SNA | |
4245 | JMP ILLCHAR | |
4246 | SPA | |
4247 | JMP DBLCHAR | |
4248 | RETSPS, DCA SY0 | |
4249 | NEXTCH | |
4250 | TAD SY0 | |
4251 | RETSNGL,CDF CIF COMPFIELD | |
4252 | JMP I (EXSY3 | |
4253 | ILLCHAR,ERROR;30 /24 | |
4254 | JMP I (INSY0+1 | |
4255 | DBLCHAR,DCA .+3 | |
4256 | NEXTCH | |
4257 | TAD CHAR | |
4258 | HLT /JMP X | |
4259 | ||
4260 | JMPCOL=JMP . | |
4261 | CCOL, TAD (-"= | |
4262 | SZA CLA | |
4263 | JMP .+3 | |
4264 | TAD (BECOMES | |
4265 | JMP RETSPS | |
4266 | TAD (COLON | |
4267 | JMP RETSNGL | |
4268 | ||
4269 | JMPLSS=JMP . | |
4270 | CLSS, TAD (-"= | |
4271 | SNA | |
4272 | JMP .+6 | |
4273 | TAD ("=-"> | |
4274 | SNA CLA | |
4275 | JMP .+4 | |
4276 | TAD (LSS | |
4277 | JMP RETSNGL | |
4278 | L0004 /LEQ=NEQ+4 | |
4279 | TAD (NEQ | |
4280 | JMP RETSPS | |
4281 | ||
4282 | JMPGTR=JMP . | |
4283 | CGTR, TAD (-"= | |
4284 | SNA CLA | |
4285 | JMP .+3 | |
4286 | TAD (GTR | |
4287 | JMP RETSNGL | |
4288 | TAD (GEQ | |
4289 | JMP RETSPS | |
4290 | ||
4291 | JMPPER=JMP . | |
4292 | CPER, TAD (-". | |
4293 | SNA CLA | |
4294 | JMP .+3 | |
4295 | TAD (PERIOD | |
4296 | JMP RETSNGL | |
4297 | TAD (COLON | |
4298 | JMP RETSPS | |
4299 | ||
4300 | JMPLPAR=JMP . | |
4301 | CLPAR, TAD (-"* | |
4302 | SNA CLA | |
4303 | JMP .+3 | |
4304 | TAD (LPARENT | |
4305 | JMP RETSNGL | |
4306 | NEXTCH | |
4307 | TAD CHAR | |
4308 | TAD (-"* | |
4309 | SZA CLA | |
4310 | JMP .-4 | |
4311 | NEXTCH | |
4312 | TAD CHAR | |
4313 | TAD (-") | |
4314 | SZA CLA | |
4315 | JMP .-10 | |
4316 | JMP I (INSY0+1 | |
4317 | ||
4318 | ||
4319 | JMPAPOS=JMP I . | |
4320 | CAPOS | |
4321 | ||
4322 | ||
4323 | CPACK, 0 | |
4324 | TAD K | |
4325 | RAR | |
4326 | DCA CPP | |
4327 | TAD CHAR | |
4328 | AND [77 | |
4329 | SZL | |
4330 | JMP .+3 | |
4331 | BSW | |
4332 | JMP .+5 | |
4333 | MQL | |
4334 | TAD I CPP | |
4335 | AND [7700 | |
4336 | MQA | |
4337 | DCA I CPP | |
4338 | CDF 0 | |
4339 | JMP I CPACK | |
4340 | CPP, 0 | |
4341 | ||
4342 | ||
4343 | XSNALF, 0 | |
4344 | TAD CHAR | |
4345 | TAD (-"Z-1 | |
4346 | CLL | |
4347 | TAD ("Z+1-"A | |
4348 | SNL CLA | |
4349 | ISZ XSNALF | |
4350 | JMP I XSNALF | |
4351 | ||
4352 | PAGE | |
4353 | \fDISPLAY=7400 | |
4354 | ||
4355 | /-------- D I S P L A Y --------/ | |
4356 | ||
4357 | /DISPLAY,ZBLOCK 20 /AT RUNTIME ONLY | |
4358 | ||
4359 | /---------------------------------/ | |
4360 | ||
4361 | ||
4362 | CAPOS, AND [77 | |
4363 | LOAD | |
4364 | DCA K | |
4365 | SKP | |
4366 | LBL2, NEXTCH | |
4367 | TAD CHAR | |
4368 | TAD (-"" | |
4369 | SZA CLA | |
4370 | JMP .+6 | |
4371 | NEXTCH | |
4372 | TAD CHAR | |
4373 | TAD (-"" | |
4374 | SZA CLA | |
4375 | JMP LBL3 | |
4376 | STL | |
4377 | CDF COMPFIELD | |
4378 | TAD I (SX | |
4379 | CDF TABLEFIELD | |
4380 | JMS CPACK | |
4381 | ISZ K | |
4382 | TAD EOLN | |
4383 | SNA CLA | |
4384 | JMP LBL2 | |
4385 | DCA K | |
4386 | LBL3, L0002 /2=CHARCON | |
4387 | DCA SY0 | |
4388 | L7777 | |
4389 | TAD K | |
4390 | SNA | |
4391 | JMP RETNUM | |
4392 | SPA CLA | |
4393 | JMP ERR38 | |
4394 | ISZ SY0 /3=STRING | |
4395 | CDF COMPFIELD | |
4396 | TAD I (SX | |
4397 | LOAD | |
4398 | TAD K | |
4399 | DCA I (SLENG | |
4400 | TAD I (SX | |
4401 | TAD K | |
4402 | DCA I (SX | |
4403 | TAD I (SX | |
4404 | STL RAR | |
4405 | CIA | |
4406 | TAD I (C | |
4407 | SPA CLA | |
4408 | FATAL7, FATAL | |
4409 | JMP RETNUM | |
4410 | ERR38, ERROR;46 /38 | |
4411 | JMP .+3 | |
4412 | ERR21, ERROR;25 /21 | |
4413 | CLEAR | |
4414 | JMP RETNUM | |
4415 | ||
4416 | ||
4417 | ZERROR, 0 | |
4418 | CLA CLL | |
4419 | TAD I ZERROR | |
4420 | CIF SETFIELD | |
4421 | JMS I (F3ERROR | |
4422 | JMP I ZERROR | |
4423 | ||
4424 | ZFATAL, 0 | |
4425 | TAD ZFATAL | |
4426 | CDF CIF SETFIELD | |
4427 | JMP I (F3FATAL | |
4428 | \fXNEXTCH,0 | |
4429 | BREAK | |
4430 | ISZ LL | |
4431 | JMP NCH | |
4432 | TAD ERRSW | |
4433 | SNA CLA | |
4434 | JMP NLN | |
4435 | TAD (ERRLINE-1 | |
4436 | DCA XR10 | |
4437 | CDF SETFIELD | |
4438 | TAD I XR10 | |
4439 | CDF 0 | |
4440 | TAD [240 | |
4441 | PRINTC | |
4442 | ISZ ERRSW | |
4443 | JMP .-6 | |
4444 | CRLF | |
4445 | NLN, TAD EOF | |
4446 | SZA CLA | |
4447 | FATAL9, FATAL /PROGRAM INCOMPLETE! | |
4448 | DCA CC | |
4449 | TAD (5 | |
4450 | DCA M | |
4451 | CDF COMPFIELD | |
4452 | TAD I (LC | |
4453 | CDF 0 | |
4454 | LOAD | |
4455 | JMS IOUT | |
4456 | PRINTC /CHAR = 240 ! | |
4457 | PRINTC | |
4458 | NCH, ISZ CC | |
4459 | TAD EOLN | |
4460 | SNA CLA | |
4461 | JMP .+6 | |
4462 | CRLF | |
4463 | L7777 | |
4464 | DCA LL | |
4465 | JMS GETC | |
4466 | JMP I XNEXTCH | |
4467 | JMS GETC | |
4468 | PRINTC | |
4469 | JMP I XNEXTCH | |
4470 | LL, 0 | |
4471 | ||
4472 | PAGE | |
4473 | \f FIELD 2 | |
4474 | ||
4475 | *TAB | |
4476 | ||
4477 | /ENTRIES FOR PREDEFINED SYMBOLS: | |
4478 | ||
4479 | -1; VARIABLE^100+NOTYP; 0040; 0 | |
4480 | 0; KONSTANT^100+BOOLS; 0040; 0 | |
4481 | 1; KONSTANT^100+BOOLS; 0040; 1 | |
4482 | 2; TYPE1^100+REALS; 0040; 1 | |
4483 | 3; TYPE1^100+CHARS; 0040; 1 | |
4484 | 4; TYPE1^100+BOOLS; 0040; 1 | |
4485 | 5; TYPE1^100+INTS; 0040; 1 | |
4486 | 6; FUNKTION^100+REALS; 0040; 0 | |
4487 | 7; FUNKTION^100+REALS; 0040; 2 | |
4488 | 10; FUNKTION^100+BOOLS; 0040; 4 | |
4489 | 11; FUNKTION^100+CHARS; 0040; 5 | |
4490 | 12; FUNKTION^100+INTS; 0040; 6 | |
4491 | 13; FUNKTION^100+CHARS; 0040; 7 | |
4492 | 14; FUNKTION^100+CHARS; 0040; 10 | |
4493 | 15; FUNKTION^100+INTS; 0040; 11 | |
4494 | 16; FUNKTION^100+INTS; 0040; 12 | |
4495 | 17; FUNKTION^100+REALS; 0040; 13 | |
4496 | 20; FUNKTION^100+REALS; 0040; 14 | |
4497 | 21; FUNKTION^100+REALS; 0040; 15 | |
4498 | 22; FUNKTION^100+REALS; 0040; 16 | |
4499 | 23; FUNKTION^100+REALS; 0040; 17 | |
4500 | 24; FUNKTION^100+REALS; 0040; 20 | |
4501 | 25; FUNKTION^100+BOOLS; 0040; 21 | |
4502 | 26; FUNKTION^100+BOOLS; 0040; 22 | |
4503 | 27; PROZEDURE^100+NOTYP; 0040; 1 | |
4504 | 30; PROZEDURE^100+NOTYP; 0040; 2 | |
4505 | 31; PROZEDURE^100+NOTYP; 0040; 3 | |
4506 | 32; PROZEDURE^100+NOTYP; 0040; 4 | |
4507 | 33; PROZEDURE^100+NOTYP; 0040; 5 | |
4508 | 34; PROZEDURE^100+NOTYP; 0040; 6 | |
4509 | 35; FUNKTION^100+REALS; 0040; 23 | |
4510 | 36; PROZEDURE^100+NOTYP; 0040; 0 | |
4511 | \f FIELD 3 | |
4512 | ||
4513 | /N A M E S OF S Y M B O L - T A B L E | |
4514 | ||
4515 | /THE FOLLOWING NAMES ARE PREDEFINED: | |
4516 | *0 | |
4517 | TEXT /@@@@@@@@/ | |
4518 | *.-1 | |
4519 | TEXT /FALSE@@@/ | |
4520 | *.-1 | |
4521 | TEXT /TRUE@@@@/ | |
4522 | *.-1 | |
4523 | TEXT /REAL@@@@/ | |
4524 | *.-1 | |
4525 | TEXT /CHAR@@@@/ | |
4526 | *.-1 | |
4527 | TEXT /BOOLEAN@/ | |
4528 | *.-1 | |
4529 | TEXT /INTEGER@/ | |
4530 | *.-1 | |
4531 | TEXT /ABS@@@@@/ | |
4532 | *.-1 | |
4533 | TEXT /SQR@@@@@/ | |
4534 | *.-1 | |
4535 | TEXT /ODD@@@@@/ | |
4536 | *.-1 | |
4537 | TEXT /CHR@@@@@/ | |
4538 | *.-1 | |
4539 | TEXT /ORD@@@@@/ | |
4540 | *.-1 | |
4541 | TEXT /SUCC@@@@/ | |
4542 | *.-1 | |
4543 | TEXT /PRED@@@@/ | |
4544 | *.-1 | |
4545 | TEXT /ROUND@@@/ | |
4546 | *.-1 | |
4547 | TEXT /TRUNC@@@/ | |
4548 | *.-1 | |
4549 | TEXT /SIN@@@@@/ | |
4550 | *.-1 | |
4551 | TEXT /COS@@@@@/ | |
4552 | *.-1 | |
4553 | TEXT /EXP@@@@@/ | |
4554 | *.-1 | |
4555 | TEXT /LN@@@@@@/ | |
4556 | *.-1 | |
4557 | TEXT /SQRT@@@@/ | |
4558 | *.-1 | |
4559 | TEXT /ARCTAN@@/ | |
4560 | *.-1 | |
4561 | TEXT /EOF@@@@@/ | |
4562 | *.-1 | |
4563 | TEXT /EOLN@@@@/ | |
4564 | *.-1 | |
4565 | TEXT /READ@@@@/ | |
4566 | *.-1 | |
4567 | TEXT /READLN@@/ | |
4568 | *.-1 | |
4569 | TEXT /WRITE@@@/ | |
4570 | *.-1 | |
4571 | TEXT /WRITELN@/ | |
4572 | *.-1 | |
4573 | TEXT /HALT@@@@/ | |
4574 | *.-1 | |
4575 | TEXT /ASCII@@@/ | |
4576 | *.-1 | |
4577 | TEXT /RANDOM@@/ | |
4578 | *.-1 | |
4579 | TEXT /@@@@@@@@/ | |
4580 | \f/F S Y S AND S E T - C O N S T A N T S | |
4581 | ||
4582 | *4000 | |
4583 | /---------------- | |
4584 | FSYS, ZBLOCK 5 / M U S T BE AT 4000!!! | |
4585 | /---------------- | |
4586 | ||
4587 | S1US2, ZBLOCK 5 | |
4588 | ||
4589 | SET0, 0;0;0;0;0 | |
4590 | SET1, | |
4591 | CONBGS, 7140;0000;0000;4000;0000 | |
4592 | SET2, | |
4593 | TYPBGS, 0000;0000;0006;4000;0000 | |
4594 | SET3, | |
4595 | BLOBGS, 0000;0000;0370;2000;0000 | |
4596 | SET4, | |
4597 | FACBGS, 7200;0020;0000;4000;0000 | |
4598 | SET5, | |
4599 | STATBGS,0000;0000;0000;3740;0000 | |
4600 | SET6, 0000;0001;1000;0000;0000 | |
4601 | SET7, 0000;0000;0370;6000;0000 | |
4602 | SET8, 0140;0000;0000;0000;0000 | |
4603 | SET9, 0000;0012;1000;0002;0000 | |
4604 | SET10, 0000;0013;0000;0002;0000 | |
4605 | SET11, 0000;0001;4000;4020;0000 | |
4606 | SET12, 0000;0000;4000;4020;0000 | |
4607 | SET13, 0000;0000;0040;4000;0000 | |
4608 | SET14, 0000;0010;0000;0000;0000 | |
4609 | SET15, 0000;0010;4000;0000;0000 | |
4610 | SET16, 0000;0001;0000;4000;0000 | |
4611 | SET17, 0000;0000;5000;0000;0000 | |
4612 | SET18, 0000;0000;0000;4000;0000 | |
4613 | SET19, 0000;0001;4000;4000;0000 | |
4614 | SET20, 0000;0000;4000;0000;0000 | |
4615 | SET21, 0000;0003;0000;0000;0000 | |
4616 | SET22, 0000;0024;2000;0000;0000 | |
4617 | SET23, 0000;0011;1000;0000;0000 | |
4618 | SET24, 0000;0011;0000;0000;0000 | |
4619 | SET25, 7000;0000;0000;0000;0000 | |
4620 | SET26, 0037;0000;0000;0000;0000 | |
4621 | SET27, 0140;4000;0000;0000;0000 | |
4622 | SET28, 0000;3740;0000;0000;0000 | |
4623 | SET29, 0000;2000;0400;0000;0000 | |
4624 | SET30, 0000;0000;4000;0020;0000 | |
4625 | SET31, 0000;0000;4000;3740;0000 | |
4626 | SET32, 0000;0000;0000;0001;1000 | |
4627 | SET33, 0000;0000;0000;0010;0000 | |
4628 | SET34, 0000;0001;1000;0002;0000 | |
4629 | SET35, 0000;0000;4000;0004;0000 | |
4630 | SET36, 0000;0000;0000;0001;0000 | |
4631 | SET37, 0000;0000;0400;0001;6000 | |
4632 | SET38, 0000;0000;0000;0001;6000 | |
4633 | SET39, 0000;0000;0000;0000;6000 | |
4634 | SET40, 0000;0000;0000;7740;0000 | |
4635 | SET41, 0000;0020;5000;0000;0000 | |
4636 | SET42, 0000;0000;0030;0000;0000 | |
4637 | SET43, 0000;0000;0000;2000;0000 | |
4638 | SET44, 0000;0000;0370;3740;0000 | |
4639 | SET45, 0000;0000;2000;0000;0000 | |
4640 | SET46, 0000;0001;4000;4000;0000 | |
4641 | \f/WORD- AND BIT-POSITION TABLE USED BY SET-ROUTINES: | |
4642 | ||
4643 | SETTABL,0;4000 | |
4644 | 0;2000 | |
4645 | 0;1000 | |
4646 | 0;0400 | |
4647 | 0;0200 | |
4648 | 0;0100 | |
4649 | 0;0040 | |
4650 | 0;0020 | |
4651 | 0;0010 | |
4652 | 0;0004 | |
4653 | 0;0002 | |
4654 | 0;0001 | |
4655 | ||
4656 | 1;4000 | |
4657 | 1;2000 | |
4658 | 1;1000 | |
4659 | 1;0400 | |
4660 | 1;0200 | |
4661 | 1;0100 | |
4662 | 1;0040 | |
4663 | 1;0020 | |
4664 | 1;0010 | |
4665 | 1;0004 | |
4666 | 1;0002 | |
4667 | 1;0001 | |
4668 | ||
4669 | 2;4000 | |
4670 | 2;2000 | |
4671 | 2;1000 | |
4672 | 2;0400 | |
4673 | 2;0200 | |
4674 | 2;0100 | |
4675 | 2;0040 | |
4676 | 2;0020 | |
4677 | 2;0010 | |
4678 | 2;0004 | |
4679 | 2;0002 | |
4680 | 2;0001 | |
4681 | ||
4682 | 3;4000 | |
4683 | 3;2000 | |
4684 | 3;1000 | |
4685 | 3;0400 | |
4686 | 3;0200 | |
4687 | 3;0100 | |
4688 | 3;0040 | |
4689 | 3;0020 | |
4690 | 3;0010 | |
4691 | 3;0004 | |
4692 | 3;0002 | |
4693 | 3;0001 | |
4694 | ||
4695 | 4;4000 | |
4696 | 4;2000 | |
4697 | 4;1000 | |
4698 | 4;0400 | |
4699 | 4;0200 | |
4700 | 4;0100 | |
4701 | 4;0040 | |
4702 | 4;0020 | |
4703 | 4;0010 | |
4704 | 4;0004 | |
4705 | 4;0002 | |
4706 | 4;0001 | |
4707 | \f/H A S H - T A B L E OF K E Y W O R D S | |
4708 | ||
4709 | HASHTABLE=. | |
4710 | ||
4711 | DECIMAL /ADDRESSES SPECIFIED IN DECIMAL! | |
4712 | ||
4713 | ZBLOCK 128^4 /CLEAR UNUSED LOCATIONS! | |
4714 | ||
4715 | KSYTABLE=. /REMEMBER END OF HASHTABLE | |
4716 | ||
4717 | *2^4+HASHTABLE | |
4718 | TEXT /AND/ | |
4719 | *5^4+HASHTABLE | |
4720 | TEXT /ARRAY/ | |
4721 | *8^4+HASHTABLE | |
4722 | TEXT /DIV/ | |
4723 | *9^4+HASHTABLE | |
4724 | TEXT /DO/ | |
4725 | *10^4+HASHTABLE | |
4726 | TEXT /END/ | |
4727 | *13^4+HASHTABLE | |
4728 | TEXT /FOR/ | |
4729 | *16^4+HASHTABLE | |
4730 | TEXT /CASE/ | |
4731 | *18^4+HASHTABLE | |
4732 | TEXT /IF/ | |
4733 | *19^4+HASHTABLE | |
4734 | TEXT /FUNCTION/ | |
4735 | *20^4+HASHTABLE | |
4736 | TEXT /ELSE/ | |
4737 | *22^4+HASHTABLE | |
4738 | TEXT /BEGIN/ | |
4739 | *27^4+HASHTABLE | |
4740 | TEXT /MOD/ | |
4741 | *29^4+HASHTABLE | |
4742 | TEXT /NOT/ | |
4743 | *30^4+HASHTABLE | |
4744 | TEXT /OF/ | |
4745 | *31^4+HASHTABLE | |
4746 | TEXT /OR/ | |
4747 | *37^4+HASHTABLE | |
4748 | TEXT /DOWNTO/ | |
4749 | *39^4+HASHTABLE | |
4750 | TEXT /PROCEDUR/ | |
4751 | *41^4+HASHTABLE | |
4752 | TEXT /TO/ | |
4753 | *44^4+HASHTABLE | |
4754 | TEXT /VAR/ | |
4755 | *45^4+HASHTABLE | |
4756 | TEXT /CONST/ | |
4757 | *46^4+HASHTABLE | |
4758 | TEXT /REPEAT/ | |
4759 | *47^4+HASHTABLE | |
4760 | TEXT /PROGRAM/ | |
4761 | *51^4+HASHTABLE | |
4762 | TEXT /TYPE/ | |
4763 | *60^4+HASHTABLE | |
4764 | TEXT /UNTIL/ | |
4765 | *66^4+HASHTABLE | |
4766 | TEXT /RECORD/ | |
4767 | *68^4+HASHTABLE | |
4768 | TEXT /THEN/ | |
4769 | *70^4+HASHTABLE | |
4770 | TEXT /WHILE/ | |
4771 | \f/S Y M B O L - V A L U E S OF K E Y W O R D S | |
4772 | ||
4773 | *KSYTABLE | |
4774 | ZBLOCK 128 /FOR SAFETY! | |
4775 | PUSHTABLE=. /REMEMBER END OF KSYTABLE | |
4776 | ||
4777 | *2+KSYTABLE | |
4778 | ANDSY | |
4779 | *5+KSYTABLE | |
4780 | ARRAYSY | |
4781 | *8+KSYTABLE | |
4782 | IDIVSY | |
4783 | *9+KSYTABLE | |
4784 | DOSY | |
4785 | *10+KSYTABLE | |
4786 | ENDSY | |
4787 | *13+KSYTABLE | |
4788 | FORSY | |
4789 | *16+KSYTABLE | |
4790 | CASESY | |
4791 | *18+KSYTABLE | |
4792 | IFSYM | |
4793 | *19+KSYTABLE | |
4794 | FUNCTIONSY | |
4795 | *20+KSYTABLE | |
4796 | ELSESY | |
4797 | *22+KSYTABLE | |
4798 | BEGINSY | |
4799 | *27+KSYTABLE | |
4800 | IMODSY | |
4801 | *29+KSYTABLE | |
4802 | NOTSY | |
4803 | *30+KSYTABLE | |
4804 | OFSY | |
4805 | *31+KSYTABLE | |
4806 | ORSY | |
4807 | *37+KSYTABLE | |
4808 | DOWNTOSY | |
4809 | *39+KSYTABLE | |
4810 | PROCEDURESY | |
4811 | *41+KSYTABLE | |
4812 | TOSY | |
4813 | *44+KSYTABLE | |
4814 | VARSY | |
4815 | *45+KSYTABLE | |
4816 | CONSTSY | |
4817 | *46+KSYTABLE | |
4818 | REPTSY | |
4819 | *47+KSYTABLE | |
4820 | PROGRAMSY | |
4821 | *51+KSYTABLE | |
4822 | TYPESY | |
4823 | *60+KSYTABLE | |
4824 | UNTILSY | |
4825 | *66+KSYTABLE | |
4826 | RECRDSY | |
4827 | *68+KSYTABLE | |
4828 | THENSY | |
4829 | *70+KSYTABLE | |
4830 | WHILSY | |
4831 | ||
4832 | ||
4833 | OCTAL | |
4834 | \f/P U S H T A B L E | |
4835 | ||
4836 | /CONTAINS THE NECESSARY INFORMATIONS (USED BY PUSHJUMP AND POPJUMP) | |
4837 | /TO CALL THE COMPILER PROCEDURES RECURSIVELY, | |
4838 | /TO SAVE THE LOCAL VARIABLES, TO PASS EVENTUAL PARAMETERS | |
4839 | /AND RETURN CONTROL TO MAINLINE. | |
4840 | / | |
4841 | /FOR EACH PROCEDURE THERE IS ONE ENTRY OF 4 WORDS: | |
4842 | /WORD 1: ADDRESS OF FIRST LOCAL VARIABLE (= 1ST PARAMETER) - 1 | |
4843 | /WORD 2: - NUMBER OF LOCAL VAR'S (LOCATIONS) TO SAVE | |
4844 | /WORD 3: NUMBER OF PARAMETERS ( + FSYS IF 1ST ONE IS A SET) | |
4845 | / ( + 100*NO. OF VAR-PARAMETERS) | |
4846 | /WORD 4: STARTING ADDRESS OF PROCEDURE | |
4847 | ||
4848 | *PUSHTABLE | |
4849 | ||
4850 | /BLOCK | |
4851 | ISFUN-1; -5; FSYS+2; XBLOCK | |
4852 | /STATEMENT | |
4853 | 0; 0; FSYS; XSTATEMENT | |
4854 | /ASSIGNMENT | |
4855 | LV-1; -6; 2; XASSIGNMENT | |
4856 | /COMPOUNDSTATEMENT | |
4857 | 0; 0; 0; XCOMPOUND | |
4858 | /IFSTATEMENT | |
4859 | IXTYP-1; -4; 0; XIFSTATEMENT | |
4860 | /CASESTATEMENT | |
4861 | CASETAB-1; -137; 0; XCASESTATEMENT | |
4862 | /REPEATSTATEMENT | |
4863 | RXTYP-1; -3; 0; XREPEAT | |
4864 | /WHILESTATEMENT | |
4865 | WXTYP-1; -4; 0; XWHILE | |
4866 | /FORSTATEMENT | |
4867 | FXTYP-1; -6; 0; XFORSTATEMENT | |
4868 | /STANDPROC | |
4869 | PRCN-1; -5; 1; XSTPROC | |
4870 | /SELECTOR | |
4871 | SELVAR-1; -5; FSYS+200+1; XSELECT | |
4872 | /CALL | |
4873 | CALI-1; -5; FSYS+1; XCALL | |
4874 | /STANDFCT | |
4875 | FCTN-1; -2; 1; XSTFUN | |
4876 | /FACTOR | |
4877 | FACVAR-1; -3; FSYS+200+1; XFACTOR | |
4878 | /TERM | |
4879 | TRMXTYP-1; -4; FSYS+1; XTERM | |
4880 | /SIMPLEEXPRESSION | |
4881 | SIMXTYP-1; -4; FSYS+1; XSIMPLE | |
4882 | /EXPRESSION | |
4883 | EXPRVAR-1; -6; FSYS+200+1; XEXPRESSION | |
4884 | /CONDECLARE | |
4885 | CONREC-1; 0; 0; XCONDECL | |
4886 | /TYPDECLARE | |
4887 | DECTP-1; 0; 0; XTYPDECL | |
4888 | /VARDECLARE | |
4889 | VARTP-1; 0; 0; XVARDECL | |
4890 | /PRODECLARE | |
4891 | PROFUN-1; -1; 0; XPRODECL | |
4892 | /CONSTANT | |
4893 | CCON-1; 0; FSYS+1; XCONSTANT | |
4894 | /ARRAYTYP | |
4895 | ARRVAR-1; -6; 200+1; XARRAYTYP | |
4896 | /TYPE | |
4897 | TYPVAR-1; -12; FSYS+300+1; XTYPE | |
4898 | /PARAMETERLIST | |
4899 | PARTP-1; 0; 0; XPARAM | |
4900 | /ONECASE | |
4901 | 0; 0; 0; XONECASE | |
4902 | \f/TABLE OF S P E C I A L S Y M B O L S | |
4903 | / | |
4904 | /ONE ENTRY FOR EACH ASCII CHARACTER: | |
4905 | / =0 ... FOR ILLEGAL CHAR'S | |
4906 | / >0 ... (=SYMBOL VALUE) FOR SINGLE SPECIAL CHAR'S | |
4907 | / <0 ... (=JMP TO ROUTINE) FOR DOUBLE CHAR'S, COMMENTS OR STRINGS | |
4908 | ||
4909 | CHARTABLE=. | |
4910 | ||
4911 | /SPACE ! " # $ % & ' ( ) * + , - . / | |
4912 | 0 | |
4913 | 0 | |
4914 | JMPAPOS | |
4915 | NEQ | |
4916 | 0 | |
4917 | 0 | |
4918 | ANDSY | |
4919 | 0 | |
4920 | JMPLPAR | |
4921 | RPARENT | |
4922 | TIMES | |
4923 | PLUS | |
4924 | COMMA | |
4925 | MINUS | |
4926 | JMPPER | |
4927 | RDIVSY | |
4928 | ||
4929 | ZBLOCK "9-"0+1 /DIGITS ARE PROCESSED SEPARATELY! | |
4930 | ||
4931 | /: ; < = > ? @ | |
4932 | JMPCOL | |
4933 | SEMICOLON | |
4934 | JMPLSS | |
4935 | EQL | |
4936 | JMPGTR | |
4937 | 0 | |
4938 | 0 | |
4939 | ||
4940 | ZBLOCK "Z-"A+1 /LETTERS ARE PROCESSED SEPARATELY! | |
4941 | ||
4942 | /[ \ ] ^ _ | |
4943 | LBRACK | |
4944 | 0 | |
4945 | RBRACK | |
4946 | 0 | |
4947 | 0 | |
4948 | \f/C O M P I L E R E R R O R S (NOT FATAL) | |
4949 | ||
4950 | /ERROR LINE BUFFER: | |
4951 | ||
4952 | ERRLINE,"#-240; "#-240; "#-240; "#-240; "#-240; 0; 0 | |
4953 | ZBLOCK LLNG | |
4954 | ||
4955 | ||
4956 | PAGE | |
4957 | ||
4958 | /ERROR ROUTINE: | |
4959 | ||
4960 | ERRNO, 0 /ERROR NUMBER | |
4961 | ERRN01, 0 /ERROR NUMBER - UNITS | |
4962 | ERRN10, 0 /ERROR NUMBER - TENS | |
4963 | ERRPOS, 0 /POSITION OF ERROR | |
4964 | ERRP, 0 | |
4965 | ERRC, 0 | |
4966 | /ERRSW, 0 /IN FIELD 0 | |
4967 | /ERRSUM,0 /IN FIELD 6 | |
4968 | ||
4969 | F3ERROR,0 | |
4970 | DCA ERRNO | |
4971 | RDF | |
4972 | TAD (CDF CIF | |
4973 | DCA ERRCDI | |
4974 | CDF 0 | |
4975 | TAD I (CC | |
4976 | TAD (ERRLINE+5 | |
4977 | DCA ERRPOS | |
4978 | TAD I (ERRSW | |
4979 | CDF SETFIELD | |
4980 | SZA CLA | |
4981 | JMP ERRENT | |
4982 | TAD (ERRLINE+5 | |
4983 | DCA ERRP | |
4984 | TAD (-LLNG | |
4985 | DCA ERRC | |
4986 | ISZ ERRP | |
4987 | DCA I ERRP | |
4988 | ISZ ERRC | |
4989 | JMP .-3 | |
4990 | ERRENT, TAD ERRNO | |
4991 | DCA ERRN01 | |
4992 | DCA ERRN10 | |
4993 | JMP .+3 | |
4994 | DCA ERRN01 | |
4995 | ISZ ERRN10 | |
4996 | TAD ERRN01 | |
4997 | TAD (-12 /-10 | |
4998 | SMA | |
4999 | JMP .-5 | |
5000 | CLA | |
5001 | TAD I ERRPOS | |
5002 | SZA CLA | |
5003 | JMP ERREXIT /NO ROOM! | |
5004 | TAD ("#-240 | |
5005 | DCA I ERRPOS | |
5006 | ISZ ERRPOS | |
5007 | TAD ERRN10 | |
5008 | SNA | |
5009 | JMP .+4 | |
5010 | TAD ("0-240 | |
5011 | DCA I ERRPOS | |
5012 | ISZ ERRPOS | |
5013 | TAD ERRN01 | |
5014 | TAD ("0-240 | |
5015 | DCA I ERRPOS | |
5016 | TAD ERRPOS | |
5017 | TAD (-ERRLINE | |
5018 | CMA | |
5019 | CDF 0 | |
5020 | DCA I (ERRSW | |
5021 | ERREXIT,CDF ERRFIELD | |
5022 | ISZ I ERRNO /REMEMBER THIS ERROR | |
5023 | ISZ I (ERRSUM /COUNT ERRORS | |
5024 | ERRCDI, CDF CIF 0 | |
5025 | JMP I F3ERROR | |
5026 | ||
5027 | PAGE | |
5028 | \f/C O M P I L E R E R R O R S (FATAL) | |
5029 | ||
5030 | FATADR, 0 | |
5031 | FATPOS, 0 | |
5032 | ||
5033 | F3FATAL,DCA FATADR | |
5034 | TAD FHEAD | |
5035 | DCA FTEXT | |
5036 | JMS FCRLF | |
5037 | JMS FCRLF | |
5038 | JMS FMESG | |
5039 | TAD FLIST | |
5040 | DCA FATPOS | |
5041 | ISZ FATPOS | |
5042 | TAD I FATPOS | |
5043 | TAD FATADR | |
5044 | SZA CLA | |
5045 | JMP .-4 | |
5046 | TAD FATPOS | |
5047 | TAD FMFL | |
5048 | DCA FATPOS | |
5049 | TAD I FATPOS | |
5050 | DCA FTEXT | |
5051 | JMS FMESG | |
5052 | JMS FCRLF | |
5053 | CDF CIF ERRFIELD | |
5054 | JMP I .+1 | |
5055 | FXPLAIN | |
5056 | ||
5057 | FPRINT, 0 | |
5058 | TLS | |
5059 | TSF | |
5060 | JMP .-1 | |
5061 | CLA CLL | |
5062 | JMP I FPRINT | |
5063 | ||
5064 | FCRLF, 0 | |
5065 | TAD F215 | |
5066 | JMS FPRINT | |
5067 | TAD F212 | |
5068 | JMS FPRINT | |
5069 | JMP I FCRLF | |
5070 | ||
5071 | FMESG, 0 | |
5072 | TAD I FTEXT | |
5073 | BSW | |
5074 | JMS FASCII | |
5075 | TAD I FTEXT | |
5076 | JMS FASCII | |
5077 | ISZ FTEXT | |
5078 | JMP FMESG+1 | |
5079 | ||
5080 | FASCII, 0 | |
5081 | AND F77 | |
5082 | SNA | |
5083 | JMP I FMESG | |
5084 | TAD F240 | |
5085 | AND F77 | |
5086 | TAD F240 | |
5087 | JMS FPRINT | |
5088 | JMP I FASCII | |
5089 | ||
5090 | FTEXT, 0 | |
5091 | ||
5092 | FLIST, FATLIST-1 | |
5093 | FMFL, FATMESG-FATLIST | |
5094 | FHEAD, FNN | |
5095 | F215, 215 | |
5096 | F212, 212 | |
5097 | F240, 240 | |
5098 | F77, 77 | |
5099 | ||
5100 | FATLIST,-FATAL0-1 | |
5101 | -FATAL1-1 | |
5102 | -FATAL2-1 | |
5103 | -FATAL3-1 | |
5104 | -FATAL4-1 | |
5105 | -FATAL5-1 | |
5106 | -FATAL6-1 | |
5107 | -FATAL7-1 | |
5108 | -FATAL8-1 | |
5109 | -FATAL9-1 | |
5110 | -FATALC-1 | |
5111 | ||
5112 | FATMESG,F00 | |
5113 | F01 | |
5114 | F02 | |
5115 | F03 | |
5116 | F04 | |
5117 | F05 | |
5118 | F06 | |
5119 | F07 | |
5120 | F08 | |
5121 | F09 | |
5122 | F0C | |
5123 | ||
5124 | FNN, TEXT /KOMPILATION ABGEBROCHEN - / | |
5125 | ||
5126 | F00, TEXT /MAGNETBAND-LESEFEHLER!/ | |
5127 | F01, TEXT /ZU VIELE NAMEN!/ | |
5128 | F02, TEXT /ZU VIELE PROZEDUREN UND\ODER RECORDS!/ | |
5129 | F03, TEXT /ZU VIELE KONSTANTE!/ | |
5130 | F04, TEXT /ZU VIELE ARRAYS!/ | |
5131 | F05, TEXT /ZU VIELE UNTERPROGRAMMEBENEN!/ | |
5132 | F06, TEXT /PROGRAMM ZU GROSS!/ | |
5133 | F07, TEXT /ZU VIEL TEXT!/ | |
5134 | F08, TEXT /PROGRAMM ZU KOMPLEX!/ | |
5135 | F09, TEXT /PROGRAMM UNVOLLSTAENDIG!/ | |
5136 | F0C, TEXT /ZU VIELE CASE-MARKEN!/ | |
5137 | ||
5138 | PAGE | |
5139 | \f FIELD 4 | |
5140 | ||
5141 | /P A G E Z E R O | |
5142 | ||
5143 | /LOC'S 1 - 7 USED FOR TEMPORARY STORAGE! | |
5144 | *7 | |
5145 | L, 0 | |
5146 | *10 | |
5147 | /XR10, /AUTOINDEX REGISTER (SEE FIELD 0!) | |
5148 | 0 | |
5149 | XR11, 0 / --- " --- | |
5150 | XR12, 0 | |
5151 | ||
5152 | *20 | |
5153 | LC, 0 /L O C A T I O N C O U N T E R | |
5154 | TEMP, 0 | |
5155 | /I N S T R U C T I O N - R E G I S T E R | |
5156 | /IRX, | |
5157 | 0 /LEVEL | |
5158 | /IRY, | |
5159 | 0 /ADDRESS OR VALUE | |
5160 | ||
5161 | /I N D I C E S T O T A B L E S | |
5162 | /B, /BLOCK TABLE | |
5163 | 0001 | |
5164 | /T, /SYMBOL TABLE | |
5165 | 0037 | |
5166 | A, /ARRAY TABLE | |
5167 | 0 | |
5168 | C, /CONSTANT TABLE | |
5169 | ATAB-1 | |
5170 | SX, /STRING TABLE | |
5171 | 0 | |
5172 | J, 0 /TEMPORARY FOR T | |
5173 | JA, 0 /TEMPORARY FOR A | |
5174 | JB, 0 /TEMPORARY FOR B | |
5175 | ||
5176 | LO, 0 /LOW BOUND OF ARRAY | |
5177 | HI, 0 /HIGH BOUND OF ARRAY | |
5178 | SLENG, 0 /LENGTH OF STRING | |
5179 | ||
5180 | SY, 0 /C U R R E N T S Y M B O L | |
5181 | ||
5182 | ID, 0;0;0;0 /C U R R E N T I D E N T I F I E R | |
5183 | NUM, 0;0;0;0 /C O N S T A N T N U M B E R | |
5184 | ||
5185 | *50 /U N P A C K E D E N T R Y OF SYMBOL TABLE | |
5186 | LINK0, 0 | |
5187 | OBJ0, 0 | |
5188 | TYP0, 0 | |
5189 | REF0, 0 | |
5190 | NORM0, 0 | |
5191 | LEV0, 0 | |
5192 | ADR0, 0 | |
5193 | ||
5194 | JW, 0 /ADDRESS OF ENTRY (REMEMBERED FOR 'WITHEND') | |
5195 | ||
5196 | *50 /U N P A C K E D E N T R Y OF ARRAY TABLE | |
5197 | INXTP0, 0 | |
5198 | ELTYP0, 0 | |
5199 | ELREF0, 0 | |
5200 | LOW0, 0 | |
5201 | HIGH0, 0 | |
5202 | ELSIZ0, 0 | |
5203 | SIZE0, 0 | |
5204 | ||
5205 | JAW, 0 /ADDRESS OF ENTRY (REMEMBERED FOR 'WITHAEND') | |
5206 | ||
5207 | /LOCAL VAR'S OF PROCEDURE B L O C K | |
5208 | ISFUN, 0 | |
5209 | LEVEL, 0 | |
5210 | DX, 0 | |
5211 | PRT, 0 | |
5212 | PRB, 0 | |
5213 | ||
5214 | /LOCAL VAR'S OF PROCEDURE F A C T O R | |
5215 | FACVAR, 0 | |
5216 | FACXTYP,0 | |
5217 | FACXREF,0 | |
5218 | ||
5219 | /LOCAL VAR'S OF PROCEDURE C A L L | |
5220 | CALI, 0 | |
5221 | CALXTYP,0 | |
5222 | CALXREF,0 | |
5223 | CALASTP,0 | |
5224 | CALCP, 0 | |
5225 | ||
5226 | /LOCAL VAR'S OF P U S H J U M P AND P O P J U M P | |
5227 | LOCAL, 0 | |
5228 | LENGTH, 0 | |
5229 | PARAM, 0 | |
5230 | ||
5231 | /M A C R O I N S T R U C T I O N S USED BY COMPILER | |
5232 | ||
5233 | *100 | |
5234 | /ERROR=JMS I . /PARALLEL DEFINED WITH FIELD 0! | |
5235 | XERROR | |
5236 | /FATAL=JMS I . / -"- | |
5237 | XFATAL | |
5238 | /OFTAB=JMS I . / -"- | |
5239 | XOFTAB | |
5240 | /OFATAB=JMS I . / -"- | |
5241 | XOFATAB | |
5242 | /OFBTAB=JMS I . / -"- | |
5243 | XOFBTAB | |
5244 | /OFDISPLAY=JMS I . / -"- | |
5245 | XOFDISP | |
5246 | /TODISPLAY=JMS I . / -"- | |
5247 | XTODISP | |
5248 | /GETCONSTANT=JMS I . / -"- | |
5249 | XOFCONST | |
5250 | TOTAB=JMS I . /PUT INFO INTO SYMBOL TABLE | |
5251 | XTOTAB | |
5252 | TOATAB=JMS I . /PUT INFO INTO ARRAY TABLE | |
5253 | XTOATAB | |
5254 | TOBTAB=JMS I . /PUT INFO INTO BLOCK TABLE | |
5255 | XTOBTAB | |
5256 | WITHTABDO=JMS I . /GET AND UNPACK ENTRY OF SYMBOL TABLE | |
5257 | XWITHTAB | |
5258 | ENDWITH=JMS I . /PACK AND STORE ENTRY OF SYMBOL TABLE | |
5259 | XENDWITH | |
5260 | WITHATABDO=JMS I . /GET AND UNPACK ENTRY OF ARRAY TABLE | |
5261 | XWITHATAB | |
5262 | ENDAWITH=JMS I . /PACK AND STORE ENTRY OF ARRAY TABLE | |
5263 | XENDAWITH | |
5264 | TOCODE=JMS I . /INSERT ADDRESS INTO CODE[LC].IRY | |
5265 | XTOCODE | |
5266 | EMIT=JMS I . /OUTPUT INSTRUCTION OF INTERMEDIATE CODE | |
5267 | XEMIT | |
5268 | ENTER=JMS I . /ENTER ITEM INTO SYMBOL TABLE | |
5269 | XENTER | |
5270 | ENTERVARIABLE=JMS I . /ENTER VARIABLE INTO SYMBOL TABLE | |
5271 | XENTVAR | |
5272 | ENTERARRAY=JMS I . /INTO ARRAY TABLE | |
5273 | XENTARR | |
5274 | ENTERBLOCK=JMS I . /INTO BLOCK TABLE | |
5275 | XENTBLO | |
5276 | ENTERCONSTANT=JMS I . /INTO CONSTANT TABLE | |
5277 | XENTCON | |
5278 | SIGNEDINTEGER=JMS I . /MAKE SIGNED 12-BIT INTEGER OF (NUM) | |
5279 | XSGNINT | |
5280 | TEST=JMS I . /CHECK AND SKIP TO LEGAL FOLLOW SYMBOL | |
5281 | XTEST | |
5282 | TESTSEMICOLON=JMS I . | |
5283 | XTSTSEM | |
5284 | SKIP=JMS I . /SKIP TO LEGAL FOLLOW SYMBOL | |
5285 | XSKIP | |
5286 | SKIPIFSYIN=JMS I . /SKIP NEXT INSTR. IF SY IN SETX | |
5287 | INSET | |
5288 | UNION=JMS I . /SET UNION | |
5289 | XUNION | |
5290 | IFSY=JMS I . /IF SY=SYMBOL THEN NEXT INSTR. ELSE SKIP | |
5291 | XIFSY | |
5292 | IFSYNOT=JMS I . /IF SY<>SYMBOL THEN NEXT INSTR. ELSE SKIP | |
5293 | XIFSYNOT | |
5294 | LOCATE=JMS I . /LOCATE IDENTIFIER IN SYMBOL TABLE | |
5295 | XLOCATE | |
5296 | PUSHJUMP=JMS I . /RECURSIVE PROCEDURE CALL | |
5297 | XPUSHJUMP | |
5298 | POPJUMP=JMS I . /RETURN FROM PROCEDURE | |
5299 | XPOPJUMP | |
5300 | RESULTTYPE=JMS I . | |
5301 | XRESULT | |
5302 | INSYMBOL=JMS I . /SCANNER | |
5303 | XINSYMBOL | |
5304 | ||
5305 | /LOCAL VAR'S OF PROCEDURE T Y P E | |
5306 | TYPVAR, 0 | |
5307 | TP, 0 | |
5308 | RF, 0 | |
5309 | SZ, 0 | |
5310 | ELTP, 0 | |
5311 | ELRF, 0 | |
5312 | ELSZ, 0 | |
5313 | OFFSET, 0 | |
5314 | TT0, 0 | |
5315 | TT1, 0 | |
5316 | ||
5317 | /LOCAL VAR'S OF PROCEDURE W H I L E - STATEMENT | |
5318 | WXTYP, 0 | |
5319 | WXREF, 0 | |
5320 | WLC1, 0 | |
5321 | WLC2, 0 | |
5322 | \f/M A I N P R O G R A M OF COMPILER | |
5323 | ||
5324 | *200 | |
5325 | MAIN, INSYMBOL | |
5326 | IFSYNOT;PROGRAMSY;JMP MAIN3 | |
5327 | INSYMBOL | |
5328 | IFSYNOT;IDENT;JMP MAIN2 | |
5329 | INSYMBOL | |
5330 | IFSY;LPARENT;JMP .+4 | |
5331 | ERROR;11 /9 | |
5332 | JMP ENDOFH | |
5333 | IOFILES,INSYMBOL | |
5334 | IFSY;IDENT;JMP .+4 | |
5335 | ERROR;2 /2 | |
5336 | SKP | |
5337 | INSYMBOL | |
5338 | IFSY;COMMA;JMP IOFILES | |
5339 | ENDOFH, IFSY;RPARENT;JMP .+4 | |
5340 | ERROR;4 /4 | |
5341 | SKP | |
5342 | INSYMBOL | |
5343 | MAINBL, TAD (BTAB+3 | |
5344 | DCA XR10 | |
5345 | CDF TABLEFIELD | |
5346 | TAD T | |
5347 | DCA I XR10 | |
5348 | L0001 | |
5349 | DCA I XR10 | |
5350 | DCA I XR10 | |
5351 | DCA I XR10 | |
5352 | CDF COMPFIELD | |
5353 | PUSHJUMP;BLOCK | |
5354 | SET44 | |
5355 | 0 /FALSE | |
5356 | 1 | |
5357 | ||
5358 | IFSYNOT;PERIOD;ERROR;26 /22 | |
5359 | EMIT;45 /(37) | |
5360 | CDF CIF ERRFIELD | |
5361 | JMP I (EXPLAIN /DO THE COMPILATION REPORT | |
5362 | ||
5363 | MAIN2, ERROR;2 /2 | |
5364 | JMP MAINBL | |
5365 | ||
5366 | MAIN3, ERROR;3 /3 | |
5367 | JMP MAINBL | |
5368 | \f/EXTENSION OF P U S H J U M P AND P O P J U M P ROUTINES | |
5369 | ||
5370 | VARIN, 0 | |
5371 | TAD PARAM | |
5372 | AND (700 | |
5373 | SNA | |
5374 | JMP I VARIN | |
5375 | BSW | |
5376 | CIA | |
5377 | DCA LENGTH | |
5378 | ISZ LOCAL | |
5379 | L7777 | |
5380 | TAD I LOCAL | |
5381 | DCA XR11 | |
5382 | TAD I XR11 | |
5383 | DCA I XR10 | |
5384 | ISZ LENGTH | |
5385 | JMP .-3 | |
5386 | JMP I VARIN | |
5387 | ||
5388 | VARTM, 0 | |
5389 | DCA VARVAR | |
5390 | TAD PARAM | |
5391 | AND (700 | |
5392 | SNA | |
5393 | JMP I VARTM | |
5394 | BSW | |
5395 | CIA | |
5396 | DCA VARIN | |
5397 | TAD VARIN | |
5398 | DCA VARVAR | |
5399 | TAD LOCAL | |
5400 | DCA XR10 | |
5401 | L7777 | |
5402 | TAD I XR10 | |
5403 | DCA XR11 | |
5404 | DCA XR12 /USE LOC'S 1 - 7 FOR TEMP. STORAGE | |
5405 | TAD I XR10 | |
5406 | DCA I XR12 | |
5407 | ISZ VARIN | |
5408 | JMP .-3 | |
5409 | JMP I VARTM | |
5410 | ||
5411 | VAREX, 0 | |
5412 | TAD VARVAR | |
5413 | SNA CLA | |
5414 | JMP I VAREX | |
5415 | DCA XR10 | |
5416 | TAD I XR10 | |
5417 | DCA I XR11 | |
5418 | ISZ VARVAR | |
5419 | JMP .-3 | |
5420 | JMP I VAREX | |
5421 | ||
5422 | VARVAR, 0 | |
5423 | ||
5424 | PAGE | |
5425 | \f/PROCEDURE C O N S T A N T | |
5426 | / --------------- | |
5427 | / | |
5428 | /CALL: PUSHJUMP;CONSTANT | |
5429 | / SETX | |
5430 | / C /ADDRESS | |
5431 | / | |
5432 | /LOCAL VAR'S: FSYS | |
5433 | CCON, 0 | |
5434 | SIGN, 0 | |
5435 | ||
5436 | XCONSTANT, DCA I CCON | |
5437 | TAD CCON | |
5438 | DCA XR10 | |
5439 | DCA I XR10 | |
5440 | DCA I XR10 | |
5441 | DCA I XR10 | |
5442 | DCA I XR10 | |
5443 | TEST;CONBGS;FSYS;62 /50 | |
5444 | SKIPIFSYIN;CONBGS | |
5445 | JMP CON6 | |
5446 | IFSYNOT;CHARCON;JMP .+4 | |
5447 | L0004 /4=CHARS | |
5448 | DCA I CCON | |
5449 | JMP CON4 | |
5450 | DCA SIGN /+ | |
5451 | SKIPIFSYIN;SET8 | |
5452 | JMP CON1 | |
5453 | IFSY;MINUS;L4000 | |
5454 | DCA SIGN | |
5455 | INSYMBOL | |
5456 | CON1, IFSYNOT;IDENT;JMP CON2 | |
5457 | LOCATE | |
5458 | SNA | |
5459 | JMP CON5-1 | |
5460 | DCA J | |
5461 | OFTAB;OBJ | |
5462 | MQL | |
5463 | MQA | |
5464 | BSW | |
5465 | AND [77 | |
5466 | TAD (-KONSTANT | |
5467 | SNA CLA | |
5468 | JMP .+4 | |
5469 | ERROR;31 /25 | |
5470 | JMP CON5-1 | |
5471 | MQA | |
5472 | AND [77 | |
5473 | DCA I CCON | |
5474 | OFTAB;ADR | |
5475 | DCA NUM+3 | |
5476 | DCA NUM+2 | |
5477 | DCA NUM+1 | |
5478 | DCA NUM | |
5479 | L7776 /2=REALS | |
5480 | TAD I CCON | |
5481 | SZA | |
5482 | IAC /1=INTS | |
5483 | SZA CLA | |
5484 | JMP CON3 | |
5485 | TAD NUM+3 | |
5486 | GETCONSTANT | |
5487 | JMP CON3 | |
5488 | CON2, IFSY;INTCON;JMP CON3-2 | |
5489 | IFSY;REALCON;JMP CON3-3 | |
5490 | SKIP;FSYS;62 /50 | |
5491 | JMP CON5 | |
5492 | ||
5493 | L0001 | |
5494 | IAC | |
5495 | DCA I CCON | |
5496 | CON3, TAD SIGN | |
5497 | TAD NUM+1 | |
5498 | DCA NUM+1 | |
5499 | CON4, TAD CCON | |
5500 | DCA XR10 | |
5501 | TAD NUM | |
5502 | DCA I XR10 | |
5503 | TAD NUM+1 | |
5504 | DCA I XR10 | |
5505 | TAD NUM+2 | |
5506 | DCA I XR10 | |
5507 | TAD NUM+3 | |
5508 | DCA I XR10 | |
5509 | ||
5510 | INSYMBOL | |
5511 | CON5, TEST;FSYS;SET0;6 /6 | |
5512 | CON6, POPJUMP;CONSTANT | |
5513 | ||
5514 | PAGE | |
5515 | \f/PROCEDURE A R R A Y T Y P | |
5516 | / --------------- | |
5517 | / | |
5518 | /CALL: PUSHJUMP;ARRAYTYP | |
5519 | / REF /ADDRESS | |
5520 | / SIZE /ADDRESS | |
5521 | / | |
5522 | /LOCAL VAR'S: | |
5523 | ARRVAR, 0 | |
5524 | AREF, 0 | |
5525 | ARSZ, 0 | |
5526 | ALTP, 0 | |
5527 | ALRF, 0 | |
5528 | ALSZ, 0 | |
5529 | ||
5530 | LOWB, ZBLOCK 5 | |
5531 | HIGHB, ZBLOCK 5 | |
5532 | MULT=HIGHB | |
5533 | ||
5534 | XARRAYTYP, | |
5535 | PUSHJUMP;CONSTANT | |
5536 | FSYS+SET9 | |
5537 | LOWB | |
5538 | L7776 /2=REALS | |
5539 | TAD LOWB | |
5540 | SZA CLA | |
5541 | JMP ARR1 | |
5542 | ERROR;33 /27 | |
5543 | L0001 /1=INTS | |
5544 | DCA LOWB | |
5545 | DCA LOWB+1 | |
5546 | DCA LOWB+2 | |
5547 | DCA LOWB+3 | |
5548 | DCA LOWB+4 | |
5549 | ARR1, IFSY;COLON;JMP .+4 | |
5550 | ERROR;15 /13 | |
5551 | SKP | |
5552 | INSYMBOL | |
5553 | PUSHJUMP;CONSTANT | |
5554 | FSYS+SET10 | |
5555 | HIGHB | |
5556 | TAD HIGHB | |
5557 | CIA | |
5558 | TAD LOWB | |
5559 | SNA CLA | |
5560 | JMP ARR2 | |
5561 | ERROR;33 /27 | |
5562 | TAD LOWB+1 | |
5563 | DCA HIGHB+1 | |
5564 | TAD LOWB+2 | |
5565 | DCA HIGHB+2 | |
5566 | TAD LOWB+3 | |
5567 | DCA HIGHB+3 | |
5568 | TAD LOWB+4 | |
5569 | DCA HIGHB+4 | |
5570 | ARR2, SIGNEDINTEGER;LOWB | |
5571 | DCA LO | |
5572 | SIGNEDINTEGER;HIGHB | |
5573 | DCA HI | |
5574 | TAD LOWB | |
5575 | ENTERARRAY | |
5576 | TAD A | |
5577 | DCA AREF | |
5578 | IFSYNOT;COMMA;JMP ARR3 | |
5579 | INSYMBOL | |
5580 | TAD [ARRAY | |
5581 | DCA ALTP | |
5582 | PUSHJUMP;ARRAYTYP | |
5583 | ALRF | |
5584 | /ALSZ | |
5585 | JMP ARR4 | |
5586 | ARR3, IFSY;RBRACK;JMP .+5 | |
5587 | ERROR;14 /12 | |
5588 | IFSY;RPARENT;INSYMBOL | |
5589 | IFSY;OFSY;JMP .+4 | |
5590 | ERROR;10 /8 | |
5591 | SKP | |
5592 | INSYMBOL | |
5593 | PUSHJUMP;TYPE | |
5594 | FSYS | |
5595 | ALTP | |
5596 | /ALRF | |
5597 | /ALSZ | |
5598 | ARR4, TAD AREF | |
5599 | DCA JA | |
5600 | WITHATABDO | |
5601 | TAD LOW0 | |
5602 | CIA | |
5603 | TAD HIGH0 | |
5604 | IAC | |
5605 | DCA TEMP | |
5606 | TAD ALSZ | |
5607 | CIA | |
5608 | DCA MULT | |
5609 | TAD TEMP | |
5610 | ISZ MULT | |
5611 | JMP .-2 | |
5612 | DCA ARSZ | |
5613 | TAD ARSZ | |
5614 | DCA SIZE0 | |
5615 | TAD ALTP | |
5616 | DCA ELTYP0 | |
5617 | TAD ALRF | |
5618 | DCA ELREF0 | |
5619 | TAD ALSZ | |
5620 | DCA ELSIZ0 | |
5621 | ENDAWITH | |
5622 | POPJUMP;ARRAYTYP | |
5623 | ||
5624 | PAGE | |
5625 | \f/PROCEDURE T Y P E | |
5626 | / ------- | |
5627 | / | |
5628 | /CALL: PUSHJUMP;TYPE | |
5629 | / SETX | |
5630 | / TYP /ADDRESS | |
5631 | / REF / --"-- | |
5632 | / SIZE / --"-- | |
5633 | / | |
5634 | /LOCAL VAR'S (ON PAGE ZERO!): | |
5635 | / FSYS | |
5636 | / TYPVAR, 0 | |
5637 | / TP, 0 | |
5638 | / RF, 0 | |
5639 | / SZ, 0 | |
5640 | / ELTP, 0 | |
5641 | / ELRF, 0 | |
5642 | / ELSZ, 0 | |
5643 | / OFFSET, 0 | |
5644 | / TT0, 0 | |
5645 | / TT1, 0 | |
5646 | ||
5647 | XTYPE, DCA TP /0=NOTYP | |
5648 | DCA RF | |
5649 | DCA SZ | |
5650 | TEST;TYPBGS;FSYS;12 /10 | |
5651 | SKIPIFSYIN;TYPBGS | |
5652 | POPJUMP;TYPE | |
5653 | IFSYNOT;IDENT;JMP TYP1 | |
5654 | LOCATE | |
5655 | SNA | |
5656 | JMP TYP1-2 | |
5657 | DCA J | |
5658 | WITHTABDO | |
5659 | TAD OBJ0 | |
5660 | TAD [-TYPE1 | |
5661 | SNA CLA | |
5662 | JMP .+4 | |
5663 | ERROR;35 /29 | |
5664 | JMP TYP1-2 | |
5665 | TAD TYP0 | |
5666 | DCA TP | |
5667 | TAD REF0 | |
5668 | DCA RF | |
5669 | TAD ADR0 | |
5670 | DCA SZ | |
5671 | TAD TYP0 | |
5672 | SNA CLA | |
5673 | ERROR;36 /30 | |
5674 | INSYMBOL | |
5675 | JMP TYP7 | |
5676 | TYP1, IFSYNOT;ARRAYSY;JMP TYP2 | |
5677 | INSYMBOL | |
5678 | IFSY;LBRACK;JMP .+5 | |
5679 | ERROR;13 /11 | |
5680 | IFSY;LPARENT;INSYMBOL | |
5681 | TAD [ARRAY | |
5682 | DCA TP | |
5683 | PUSHJUMP;ARRAYTYP | |
5684 | RF | |
5685 | /SZ | |
5686 | JMP TYP7 | |
5687 | TYP2, INSYMBOL | |
5688 | ENTERBLOCK | |
5689 | L0006 /6=RECORD | |
5690 | DCA TP | |
5691 | TAD B | |
5692 | DCA RF | |
5693 | TAD LEVEL | |
5694 | TAD [-LMAX | |
5695 | SNA CLA | |
5696 | FATAL5, FATAL | |
5697 | ISZ LEVEL | |
5698 | TAD B | |
5699 | TODISPLAY | |
5700 | DCA OFFSET | |
5701 | TYP3, SKIPIFSYIN;SET46;JMP TYP6 | |
5702 | IFSYNOT;IDENT;JMP TYP5 | |
5703 | TAD T | |
5704 | DCA TT0 | |
5705 | SKP | |
5706 | INSYMBOL | |
5707 | ENTERVARIABLE | |
5708 | IFSY;COMMA;JMP .-4 | |
5709 | IFSY;COLON;JMP .+4 | |
5710 | ERROR;5 /5 | |
5711 | SKP | |
5712 | INSYMBOL | |
5713 | TAD T | |
5714 | DCA TT1 | |
5715 | PUSHJUMP;TYPE | |
5716 | FSYS+SET11 | |
5717 | ELTP | |
5718 | /ELRF | |
5719 | /ELSZ | |
5720 | TYP4, TAD TT0 | |
5721 | CIA | |
5722 | TAD TT1 | |
5723 | SPA SNA CLA | |
5724 | JMP TYP5 | |
5725 | ISZ TT0 | |
5726 | TAD TT0 | |
5727 | WITHTABDO | |
5728 | TAD ELTP | |
5729 | DCA TYP0 | |
5730 | TAD ELRF | |
5731 | DCA REF0 | |
5732 | TAD [40 | |
5733 | DCA NORM0 | |
5734 | TAD OFFSET | |
5735 | DCA ADR0 | |
5736 | TAD OFFSET | |
5737 | TAD ELSZ | |
5738 | DCA OFFSET | |
5739 | ENDWITH | |
5740 | JMP TYP4 | |
5741 | ||
5742 | PAGE | |
5743 | ||
5744 | TYP5, IFSY;ENDSY;JMP TYP6 | |
5745 | IFSY;SEMICOLON;JMP .+5 | |
5746 | ERROR;16 /14 | |
5747 | IFSY;COMMA;INSYMBOL | |
5748 | TEST;SET12;FSYS;6 /6 | |
5749 | JMP TYP3 | |
5750 | TYP6, TAD RF | |
5751 | DCA JB | |
5752 | TAD OFFSET | |
5753 | TOBTAB;VSIZE | |
5754 | TAD OFFSET | |
5755 | DCA SZ | |
5756 | TOBTAB;PSIZE | |
5757 | INSYMBOL | |
5758 | L7777 | |
5759 | TAD LEVEL | |
5760 | DCA LEVEL | |
5761 | TYP7, TEST;FSYS;SET0;6 /6 | |
5762 | POPJUMP;TYPE | |
5763 | \f/PROCEDURE C O N D E C L | |
5764 | / ------------- | |
5765 | / | |
5766 | /CALL: PUSHJUMP;CONDECL /NO ARG'S! | |
5767 | / | |
5768 | /LOCAL VAR'S: | |
5769 | CONREC, ZBLOCK 5 | |
5770 | ||
5771 | XCONDECL, INSYMBOL | |
5772 | TEST;SET18;BLOBGS;2 /2 | |
5773 | CDEC1, IFSYNOT;IDENT;POPJUMP;CONDECL | |
5774 | ENTER;KONSTANT | |
5775 | INSYMBOL | |
5776 | IFSY;EQL;JMP .+5 | |
5777 | ERROR;20 /16 | |
5778 | IFSY;BECOMES;INSYMBOL | |
5779 | PUSHJUMP;CONSTANT | |
5780 | FSYS+SET19 | |
5781 | CONREC | |
5782 | ||
5783 | TAD T | |
5784 | WITHTABDO | |
5785 | TAD CONREC /TYP | |
5786 | DCA TYP0 | |
5787 | DCA REF0 | |
5788 | L7776 | |
5789 | TAD CONREC | |
5790 | SZA | |
5791 | IAC | |
5792 | SZA CLA | |
5793 | JMP .+4 | |
5794 | ENTERCONSTANT;CONREC | |
5795 | SKP | |
5796 | TAD CONREC+4 | |
5797 | DCA ADR0 | |
5798 | ENDWITH | |
5799 | TESTSEMICOLON | |
5800 | JMP CDEC1 | |
5801 | \f/PROCEDURE T Y P D E C L | |
5802 | / ------------- | |
5803 | / | |
5804 | /CALL: PUSHJUMP;TYPDECL /NO ARG'S! | |
5805 | / | |
5806 | /LOCAL VAR'S: | |
5807 | DECTP, 0 | |
5808 | DECRF, 0 | |
5809 | DECSZ, 0 | |
5810 | DT1, 0 | |
5811 | ||
5812 | XTYPDECL, INSYMBOL | |
5813 | TEST;SET18;BLOBGS;2 /2 | |
5814 | TDEC1, IFSYNOT;IDENT;POPJUMP;TYPDECL | |
5815 | ENTER;TYPE1 | |
5816 | TAD T | |
5817 | DCA DT1 | |
5818 | INSYMBOL | |
5819 | IFSY;EQL;JMP .+5 | |
5820 | ERROR;20 /16 | |
5821 | IFSY;BECOMES;INSYMBOL | |
5822 | PUSHJUMP;TYPE | |
5823 | FSYS+SET19 | |
5824 | DECTP | |
5825 | /DECRF | |
5826 | /DECSZ | |
5827 | ||
5828 | TAD DT1 | |
5829 | WITHTABDO | |
5830 | TAD DECTP | |
5831 | DCA TYP0 | |
5832 | TAD DECRF | |
5833 | DCA REF0 | |
5834 | TAD DECSZ | |
5835 | DCA ADR0 | |
5836 | ENDWITH | |
5837 | TESTSEMICOLON | |
5838 | JMP TDEC1 | |
5839 | ||
5840 | PAGE | |
5841 | \f/PROCEDURE P A R A M E T E R L I S T | |
5842 | / ------------------------- | |
5843 | / | |
5844 | /CALL: PUSHJUMP;PARAMETERLIST /NO ARG'S! | |
5845 | / | |
5846 | /LOCAL VAR'S: | |
5847 | PARTP, 0 | |
5848 | PARRF, 0 | |
5849 | PARSZ, 0 | |
5850 | PT0, 0 | |
5851 | VALPAR, 0 | |
5852 | ||
5853 | XPARAM, INSYMBOL | |
5854 | DCA PARTP | |
5855 | DCA PARRF | |
5856 | DCA PARSZ | |
5857 | TEST;SET13;FSYS+SET14;7 /7 | |
5858 | PAR1, SKIPIFSYIN;SET13 | |
5859 | JMP PAR5 | |
5860 | IFSYNOT;VARSY;JMP .+3 | |
5861 | INSYMBOL | |
5862 | SKP | |
5863 | TAD [40 | |
5864 | DCA VALPAR | |
5865 | TAD T | |
5866 | DCA PT0 | |
5867 | ENTERVARIABLE | |
5868 | IFSYNOT;COMMA;JMP .+4 | |
5869 | INSYMBOL | |
5870 | ENTERVARIABLE | |
5871 | JMP .-5 | |
5872 | IFSY;COLON;JMP .+4 | |
5873 | ERROR;5 /5 | |
5874 | JMP PAR3 | |
5875 | INSYMBOL | |
5876 | IFSY;IDENT;JMP .+4 | |
5877 | ERROR;2 /2 | |
5878 | JMP PAR2 | |
5879 | LOCATE | |
5880 | DCA J | |
5881 | INSYMBOL | |
5882 | TAD J | |
5883 | SNA CLA | |
5884 | JMP PAR2 | |
5885 | WITHTABDO | |
5886 | TAD OBJ0 | |
5887 | TAD [-TYPE1 | |
5888 | SNA CLA | |
5889 | JMP .+4 | |
5890 | ERROR;35 /29 | |
5891 | JMP PAR2 | |
5892 | TAD TYP0 | |
5893 | DCA PARTP | |
5894 | TAD REF0 | |
5895 | DCA PARRF | |
5896 | TAD VALPAR | |
5897 | SZA CLA | |
5898 | JMP .+3 | |
5899 | L0001 | |
5900 | SKP | |
5901 | TAD ADR0 | |
5902 | DCA PARSZ | |
5903 | PAR2, TEST;SET15;FSYS+SET16;16 /14 | |
5904 | PAR3, TAD PT0 | |
5905 | CIA | |
5906 | TAD T | |
5907 | SPA SNA CLA | |
5908 | JMP PAR4 | |
5909 | ISZ PT0 | |
5910 | TAD PT0 | |
5911 | WITHTABDO | |
5912 | TAD PARTP | |
5913 | DCA TYP0 | |
5914 | TAD PARRF | |
5915 | DCA REF0 | |
5916 | TAD VALPAR | |
5917 | DCA NORM0 | |
5918 | TAD DX | |
5919 | DCA ADR0 | |
5920 | TAD LEVEL | |
5921 | DCA LEV0 | |
5922 | ENDWITH | |
5923 | TAD DX | |
5924 | TAD PARSZ | |
5925 | DCA DX | |
5926 | JMP PAR3 | |
5927 | PAR4, IFSY;RPARENT;JMP PAR6 | |
5928 | IFSY;SEMICOLON;JMP .+5 | |
5929 | ERROR;16 /14 | |
5930 | IFSY;COMMA;INSYMBOL | |
5931 | TEST;SET13;FSYS+SET14;6 /6 | |
5932 | JMP PAR1 | |
5933 | PAR5, IFSY;RPARENT;JMP PAR6 | |
5934 | ERROR;4 /4 | |
5935 | JMP .+6 | |
5936 | PAR6, INSYMBOL | |
5937 | TEST;SET17;FSYS;6 /6 | |
5938 | POPJUMP;PARAMETERLIST | |
5939 | ||
5940 | PAGE | |
5941 | \f/PROCEDURE V A R D E C L | |
5942 | / ------------- | |
5943 | / | |
5944 | /CALL: PUSHJUMP;VARDECL /NO ARG'S! | |
5945 | / | |
5946 | /LOCAL VAR'S: | |
5947 | VARTP, 0 | |
5948 | VARRF, 0 | |
5949 | VARSZ, 0 | |
5950 | VT0, 0 | |
5951 | VT1, 0 | |
5952 | ||
5953 | XVARDECL, INSYMBOL | |
5954 | IFSYNOT;IDENT;POPJUMP;VARDECL | |
5955 | TAD T | |
5956 | DCA VT0 | |
5957 | ENTERVARIABLE | |
5958 | IFSYNOT;COMMA;JMP .+4 | |
5959 | INSYMBOL | |
5960 | ENTERVARIABLE | |
5961 | JMP .-5 | |
5962 | IFSY;COLON;JMP .+4 | |
5963 | ERROR;5 /5 | |
5964 | SKP | |
5965 | INSYMBOL | |
5966 | TAD T | |
5967 | DCA VT1 | |
5968 | PUSHJUMP;TYPE | |
5969 | FSYS+SET19 | |
5970 | VARTP | |
5971 | /VARRF | |
5972 | /VARSZ | |
5973 | ||
5974 | VAR1, TAD VT0 | |
5975 | CIA | |
5976 | TAD VT1 | |
5977 | SPA SNA CLA | |
5978 | JMP VAR2 | |
5979 | ISZ VT0 | |
5980 | TAD VT0 | |
5981 | WITHTABDO | |
5982 | TAD VARTP | |
5983 | DCA TYP0 | |
5984 | TAD VARRF | |
5985 | DCA REF0 | |
5986 | TAD LEVEL | |
5987 | DCA LEV0 | |
5988 | TAD DX | |
5989 | DCA ADR0 | |
5990 | TAD [40 | |
5991 | DCA NORM0 | |
5992 | ENDWITH | |
5993 | TAD VARSZ | |
5994 | TAD DX | |
5995 | DCA DX | |
5996 | JMP VAR1 | |
5997 | VAR2, TESTSEMICOLON | |
5998 | JMP XVARDECL+1 | |
5999 | \f/PROCEDURE P R O D E C L | |
6000 | / ------------- | |
6001 | / | |
6002 | /CALL: PUSHJUMP;PRODECL /NO ARG'S! | |
6003 | / | |
6004 | /LOCAL VAR'S: PROFUN, 0 /SEE BELOW! | |
6005 | ||
6006 | XPRODECL, IFSY;FUNCTIONSY;L0001 | |
6007 | DCA PROFUN | |
6008 | INSYMBOL | |
6009 | IFSY;IDENT;JMP .+7 | |
6010 | ERROR;2 /2 | |
6011 | DCA ID | |
6012 | DCA ID+1 | |
6013 | DCA ID+2 | |
6014 | DCA ID+3 | |
6015 | TAD (PROZEDURE | |
6016 | TAD PROFUN | |
6017 | DCA .+2 | |
6018 | ENTER;00 /FUNCTION OR PROCEDURE | |
6019 | TAD T | |
6020 | DCA J | |
6021 | OFTAB;NORMAL | |
6022 | AND (7737 | |
6023 | TAD [40 | |
6024 | TOTAB;NORMAL | |
6025 | INSYMBOL | |
6026 | L0001 | |
6027 | TAD LEVEL | |
6028 | DCA .+5 | |
6029 | PUSHJUMP;BLOCK | |
6030 | FSYS+SET20 | |
6031 | PROFUN, 0 | |
6032 | 0 | |
6033 | ||
6034 | IFSY;SEMICOLON;JMP .+4 | |
6035 | ERROR;16 /14 | |
6036 | SKP | |
6037 | INSYMBOL | |
6038 | TAD [40 | |
6039 | TAD PROFUN | |
6040 | DCA .+2 | |
6041 | EMIT;00 /*** (32) OR (33) ***/ | |
6042 | POPJUMP;PRODECL | |
6043 | ||
6044 | PAGE | |
6045 | \f/PROCEDURE S E L E C T O R | |
6046 | / --------------- | |
6047 | / | |
6048 | /CALL: PUSHJUMP;SELECTOR | |
6049 | / SETX | |
6050 | / V /ADDRESS | |
6051 | / | |
6052 | /LOCAL VAR'S: FSYS | |
6053 | SELVAR, 0 | |
6054 | SELVTYP,0 | |
6055 | SELVREF,0 | |
6056 | SELXTYP,0 | |
6057 | SELXREF,0 | |
6058 | ||
6059 | XSELECT, IFSYNOT;PERIOD;JMP SEL2 | |
6060 | INSYMBOL /FIELD SELECTOR | |
6061 | IFSY;IDENT;JMP .+4 | |
6062 | ERROR;2 /2 | |
6063 | JMP SEL5 | |
6064 | TAD SELVTYP | |
6065 | TAD [-RECORD | |
6066 | SNA CLA | |
6067 | JMP .+4 | |
6068 | ERROR;37 /31 | |
6069 | JMP SEL1 | |
6070 | TAD SELVREF | |
6071 | OFBTAB;LAST | |
6072 | DCA J | |
6073 | JMS ENTID | |
6074 | JMS CHKID | |
6075 | JMP .+5 | |
6076 | OFTAB;LINK | |
6077 | DCA J | |
6078 | JMP .-5 | |
6079 | TAD J | |
6080 | SNA CLA | |
6081 | ERROR;0 /0 | |
6082 | WITHTABDO | |
6083 | TAD TYP0 | |
6084 | DCA SELVTYP | |
6085 | TAD REF0 | |
6086 | DCA SELVREF | |
6087 | TAD ADR0 | |
6088 | SNA | |
6089 | JMP SEL1 | |
6090 | DCA IRY | |
6091 | EMIT;11 /*** (9) ***/ | |
6092 | SEL1, INSYMBOL | |
6093 | JMP SEL5 | |
6094 | SEL2, IFSYNOT;LBRACK;ERROR;13 /11 | |
6095 | SEL3, INSYMBOL | |
6096 | PUSHJUMP;EXPRESSION | |
6097 | FSYS+SET21 | |
6098 | SELXTYP | |
6099 | ||
6100 | TAD SELVTYP | |
6101 | TAD [-ARRAY | |
6102 | SNA CLA | |
6103 | JMP .+4 | |
6104 | ERROR;34 /28 | |
6105 | JMP SEL4 | |
6106 | TAD SELVREF /ARRAY INDEX | |
6107 | DCA JA | |
6108 | OFATAB;INXTYP | |
6109 | CIA | |
6110 | TAD SELXTYP | |
6111 | SNA CLA | |
6112 | JMP .+4 | |
6113 | ERROR;32 /26 | |
6114 | JMP SEL6 | |
6115 | TAD JA | |
6116 | DCA IRY | |
6117 | OFATAB;ELSIZE | |
6118 | CLL RAR /1 SCOMPARES! | |
6119 | SZA CLA | |
6120 | L0001 | |
6121 | TAD (24 | |
6122 | DCA .+2 | |
6123 | EMIT;00 /*** (20) OR (21) ***/ | |
6124 | SEL6, OFATAB;ELTYP | |
6125 | DCA SELVTYP | |
6126 | OFATAB;ELREF | |
6127 | DCA SELVREF | |
6128 | SEL4, IFSY;COMMA;JMP SEL3 | |
6129 | IFSY;RBRACK;JMP .+5 | |
6130 | ERROR;14 /12 | |
6131 | IFSY;RPARENT;INSYMBOL | |
6132 | SEL5, SKIPIFSYIN;SET22 | |
6133 | SKP | |
6134 | JMP XSELECT | |
6135 | TEST;FSYS;SET0;6 /6 | |
6136 | POPJUMP;SELECTOR | |
6137 | ||
6138 | PAGE | |
6139 | \f/FUNCTION R E S U L T T Y P E | |
6140 | / ------------------- | |
6141 | / | |
6142 | /CALL: TAD XTYP | |
6143 | / MQL | |
6144 | / TAD YTYP | |
6145 | / RESULTTYPE | |
6146 | / | |
6147 | /RETURNS RESULTTYPE IN ACCUMULATOR | |
6148 | ||
6149 | XRESULT,0 | |
6150 | SZA | |
6151 | SWP | |
6152 | SNA | |
6153 | JMP I XRESULT | |
6154 | TAD [-2 /HERE: XTYP<>0 AND YTYP<>0, XTYP IN AC | |
6155 | SMA SZA | |
6156 | JMP RES33 | |
6157 | SWP /YTYP IN AC | |
6158 | TAD [-2 | |
6159 | SMA SZA | |
6160 | JMP RES33 | |
6161 | SNA /HERE ONLY INTS OR REALS, YTYP IN AC | |
6162 | JMP .+5 /(7777 ... INTS, 0000 ... REALS) | |
6163 | SWP | |
6164 | SZA CLA | |
6165 | JMP RES1 /INTS - INTS | |
6166 | JMP .+5 /REALS - INTS | |
6167 | SWP | |
6168 | SNA CLA | |
6169 | JMP .+5 /REALS - REALS | |
6170 | L0001 /INTS - REALS | |
6171 | DCA IRY | |
6172 | EMIT;32 /*** (26,0) OR (26,1) ***/ | |
6173 | IAC | |
6174 | RES1, IAC | |
6175 | JMP I XRESULT | |
6176 | RES33, CLA CLL | |
6177 | ERROR;41 /33 | |
6178 | JMP I XRESULT | |
6179 | \f/PROCEDURE C A L L | |
6180 | / ------- | |
6181 | / | |
6182 | /CALL: PUSHJUMP;CALL | |
6183 | / SETX | |
6184 | / I /VALUE | |
6185 | / | |
6186 | /LOCAL VAR'S (ON PAGE ZERO!): | |
6187 | / FSYS | |
6188 | / CALI, 0 | |
6189 | / CALXTYP,0 | |
6190 | / CALXREF,0 | |
6191 | / CALASTP,0 | |
6192 | / CALCP, 0 | |
6193 | ||
6194 | XCALL, TAD CALI | |
6195 | DCA IRY | |
6196 | EMIT;22 /*** (18,I) ***/ | |
6197 | TAD CALI | |
6198 | OFTAB;REF | |
6199 | BSW | |
6200 | AND [77 | |
6201 | OFBTAB;LASTPAR | |
6202 | DCA CALASTP | |
6203 | TAD CALI | |
6204 | DCA CALCP | |
6205 | IFSYNOT;LPARENT;JMP CAL5 | |
6206 | CAL1, INSYMBOL | |
6207 | TAD CALASTP | |
6208 | CIA | |
6209 | TAD CALCP | |
6210 | SMA CLA | |
6211 | JMP CAL4-2 | |
6212 | ISZ CALCP | |
6213 | TAD CALCP | |
6214 | OFTAB;NORMAL | |
6215 | AND [40 | |
6216 | SNA CLA | |
6217 | JMP CAL3 | |
6218 | PUSHJUMP;EXPRESSION /VALUE PARAMETER | |
6219 | FSYS+SET23 | |
6220 | CALXTYP | |
6221 | ||
6222 | TAD CALCP | |
6223 | OFTAB;TYP | |
6224 | AND [77 | |
6225 | DCA TEMP | |
6226 | TAD TEMP | |
6227 | CIA | |
6228 | TAD CALXTYP | |
6229 | SZA CLA | |
6230 | JMP CAL2 | |
6231 | TAD CALCP | |
6232 | OFTAB;REF | |
6233 | BSW | |
6234 | AND [77 | |
6235 | CIA | |
6236 | TAD CALXREF | |
6237 | SZA CLA | |
6238 | JMP CAL36 | |
6239 | TAD CALXTYP | |
6240 | TAD [-ARRAY | |
6241 | SZA | |
6242 | JMP .+5 | |
6243 | TAD CALXREF | |
6244 | OFATAB;SIZE | |
6245 | JMP .+7 | |
6246 | CLL RAR /6=RECORD | |
6247 | SZA CLA | |
6248 | JMP CAL4 | |
6249 | TAD CALXREF | |
6250 | OFBTAB;VSIZE | |
6251 | DCA IRY | |
6252 | EMIT;26 /*** (22,SIZE) ***/ | |
6253 | JMP CAL4 | |
6254 | CAL2, L7777 /1=INTS | |
6255 | TAD CALXTYP | |
6256 | SZA CLA | |
6257 | JMP .+10 | |
6258 | L7776 /2=REALS | |
6259 | TAD TEMP | |
6260 | SZA CLA | |
6261 | JMP .+4 | |
6262 | EMIT;32 /*** (26,0) ***/ | |
6263 | JMP CAL4 | |
6264 | TAD CALXTYP | |
6265 | SZA CLA | |
6266 | JMP CAL36 | |
6267 | JMP CAL4 | |
6268 | ||
6269 | PAGE | |
6270 | ||
6271 | CAL3, IFSY;IDENT;JMP .+4 /VARIABLE PARAMETER | |
6272 | ERROR;2 /2 | |
6273 | JMP CAL4 | |
6274 | LOCATE | |
6275 | DCA J | |
6276 | INSYMBOL | |
6277 | TAD J | |
6278 | SNA CLA | |
6279 | JMP CAL4 | |
6280 | WITHTABDO | |
6281 | L7777 /1=VARIABLE | |
6282 | TAD OBJ0 | |
6283 | SZA CLA | |
6284 | ERROR;45 /37 | |
6285 | TAD TYP0 | |
6286 | DCA CALXTYP | |
6287 | TAD REF0 | |
6288 | DCA CALXREF | |
6289 | TAD LEV0 | |
6290 | DCA IRX | |
6291 | TAD ADR0 | |
6292 | DCA IRY | |
6293 | TAD NORM0 | |
6294 | SNA CLA | |
6295 | IAC | |
6296 | DCA .+2 | |
6297 | EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/ | |
6298 | SKIPIFSYIN;SET22 | |
6299 | JMP .+5 | |
6300 | PUSHJUMP;SELECTOR | |
6301 | FSYS+SET23 | |
6302 | CALXTYP | |
6303 | ||
6304 | TAD CALCP | |
6305 | OFTAB;TYP | |
6306 | AND [77 | |
6307 | CIA | |
6308 | TAD CALXTYP | |
6309 | SZA CLA | |
6310 | JMP CAL36 | |
6311 | TAD CALCP | |
6312 | OFTAB;REF | |
6313 | BSW | |
6314 | AND [77 | |
6315 | CIA | |
6316 | TAD CALXREF | |
6317 | SZA CLA | |
6318 | CAL36, ERROR;44 /36 | |
6319 | JMP CAL4 | |
6320 | ERROR;47 /39 | |
6321 | CAL4, TEST;SET24;FSYS;6 /6 | |
6322 | IFSY;COMMA;JMP CAL1 | |
6323 | IFSY;RPARENT;JMP .+4 | |
6324 | ERROR;4 /4 | |
6325 | SKP | |
6326 | INSYMBOL | |
6327 | CAL5, TAD CALASTP | |
6328 | CIA | |
6329 | TAD CALCP | |
6330 | SPA CLA | |
6331 | ERROR;47 /39 | |
6332 | TAD CALI | |
6333 | OFTAB;REF | |
6334 | DCA TEMP | |
6335 | TAD TEMP | |
6336 | BSW | |
6337 | AND [77 | |
6338 | OFTAB;PSIZE | |
6339 | TAD (-1 | |
6340 | DCA IRY | |
6341 | EMIT;23 /*** (19,PSIZE-1) ***/ | |
6342 | TAD TEMP | |
6343 | AND [17 | |
6344 | CIA | |
6345 | TAD LEVEL | |
6346 | SPA SNA CLA | |
6347 | JMP CAL6 | |
6348 | TAD LEVEL | |
6349 | DCA IRX /SWAPPED CONTENTS OF IRX AND IRY HERE! | |
6350 | TAD TEMP /(SEE INTERPRETER AT I03) | |
6351 | AND [17 | |
6352 | DCA IRY | |
6353 | EMIT;3 /*** (3,LEV1,LEV2) ***/ | |
6354 | CAL6, POPJUMP;CALL | |
6355 | ||
6356 | PAGE | |
6357 | \f/PROCEDURE S T A N D F C T | |
6358 | / --------------- | |
6359 | / | |
6360 | /CALL: PUSHJUMP;STANDFCT | |
6361 | / N /VALUE | |
6362 | / | |
6363 | /LOCAL VAR'S: | |
6364 | FCTN, 0 /NUMBER OF STANDARD FUNCTION | |
6365 | FCTJ, 0 | |
6366 | ||
6367 | XSTFUN, TAD FCTN | |
6368 | TAD (-20 /-16 | |
6369 | SMA SZA CLA | |
6370 | JMP STF17 | |
6371 | IFSY;LPARENT;JMP .+4 | |
6372 | ERROR;11 /9 | |
6373 | SKP | |
6374 | INSYMBOL | |
6375 | TAD J /J IS SET IN FACTOR | |
6376 | DCA FCTJ | |
6377 | PUSHJUMP;EXPRESSION | |
6378 | FSYS+SET14 | |
6379 | FACXTYP | |
6380 | ||
6381 | TAD FCTJ | |
6382 | DCA J | |
6383 | L7776 | |
6384 | TAD FCTN | |
6385 | SMA SZA CLA | |
6386 | JMP STF1 | |
6387 | /FCTN: 0,2 | |
6388 | L0004 /4=FUNKTION | |
6389 | BSW /(MUST INSERT OBJ | |
6390 | TAD FACXTYP /ALONG WITH TYP!) | |
6391 | TOTAB;TYP | |
6392 | L7776 /2=REALS | |
6393 | TAD FACXTYP | |
6394 | SNA CLA | |
6395 | ISZ FCTN | |
6396 | JMP STF2 | |
6397 | STF1, TAD FCTN | |
6398 | TAD (-10 | |
6399 | SPA SNA CLA | |
6400 | JMP STF2 /FCTN: 4,5,6,7,8 | |
6401 | L7777 /FCTN: 9,10,11, ... ,16 | |
6402 | TAD FACXTYP /1=INTS | |
6403 | SNA CLA | |
6404 | EMIT;32 /*** (26,0) ***/ | |
6405 | STF2, TAD (TSET | |
6406 | TAD FCTN | |
6407 | DCA TEMP | |
6408 | TAD FACXTYP | |
6409 | STL RAL | |
6410 | TAD (SETTABLE | |
6411 | DCA ARGXTYP | |
6412 | TAD I TEMP | |
6413 | CDF SETFIELD | |
6414 | AND I ARGXTYP | |
6415 | CDF COMPFIELD | |
6416 | SNA CLA | |
6417 | JMP STF3 | |
6418 | TAD FCTN | |
6419 | DCA IRY | |
6420 | EMIT;10 /*** (8,N) ***/ | |
6421 | JMP .+5 | |
6422 | STF3, TAD FACXTYP | |
6423 | SZA CLA | |
6424 | ERROR;60 /48 | |
6425 | IFSY;RPARENT;JMP .+4 | |
6426 | ERROR;4 /4 | |
6427 | SKP | |
6428 | INSYMBOL | |
6429 | STF4, OFTAB;TYP /(J STILL OKAY!?) | |
6430 | AND [77 | |
6431 | DCA FACXTYP | |
6432 | POPJUMP;STANDFCT | |
6433 | ||
6434 | STF17, TAD FCTN | |
6435 | DCA IRY | |
6436 | EMIT;10 /*** (8,17) OR (8,18) OR (8,19) ***/ | |
6437 | JMP STF4 | |
6438 | ||
6439 | ||
6440 | /TABLE OF LEGAL ARGUMENT TYPES: | |
6441 | TSET, 3000 /0 | |
6442 | 3000 | |
6443 | 3000 /2 | |
6444 | 3000 | |
6445 | 2000 /4 | |
6446 | 2000 /5 | |
6447 | 2600 /6 | |
6448 | 0200 /7 | |
6449 | 0200 /8 | |
6450 | 3000 /9 | |
6451 | 3000 | |
6452 | 3000 | |
6453 | 3000 | |
6454 | 3000 | |
6455 | 3000 | |
6456 | 3000 | |
6457 | 3000 /16 | |
6458 | ||
6459 | ARGXTYP,0 | |
6460 | ||
6461 | PAGE | |
6462 | \f/PROCEDURE F A C T O R | |
6463 | / ----------- | |
6464 | / | |
6465 | /CALL: PUSHJUMP;FACTOR | |
6466 | / SETX | |
6467 | / X /ADDRESS | |
6468 | / | |
6469 | /LOCAL VAR'S (ON PAGE ZERO!): | |
6470 | / FSYS | |
6471 | / FACVAR, 0 | |
6472 | / FACXTYP,0 | |
6473 | / FACXREF,0 | |
6474 | ||
6475 | XFACTOR,DCA FACXTYP /0=NOTYP | |
6476 | DCA FACXREF | |
6477 | TEST;FACBGS;FSYS;72 /58 | |
6478 | FAC1, SKIPIFSYIN;FACBGS | |
6479 | POPJUMP;FACTOR | |
6480 | IFSYNOT;IDENT;JMP FAC2 | |
6481 | LOCATE | |
6482 | DCA J | |
6483 | INSYMBOL | |
6484 | WITHTABDO | |
6485 | TAD OBJ0 | |
6486 | TAD (JMP I FACTABL | |
6487 | DCA .+1 | |
6488 | HLT | |
6489 | ||
6490 | FACTABL,FKON | |
6491 | FVAR | |
6492 | FTYP | |
6493 | FPRO | |
6494 | FFUN | |
6495 | ||
6496 | FKON, TAD TYP0 | |
6497 | DCA FACXTYP | |
6498 | DCA FACXREF | |
6499 | TAD ADR0 | |
6500 | DCA IRY | |
6501 | L7777 /1=INTS | |
6502 | TAD TYP0 | |
6503 | CLL RAR /2=REALS | |
6504 | SNA CLA | |
6505 | IAC | |
6506 | TAD (30 | |
6507 | DCA .+2 | |
6508 | EMIT;00 /*** (24,ADR) OR (25,ADR) ***/ | |
6509 | JMP FAC3 | |
6510 | ||
6511 | FVAR, TAD TYP0 | |
6512 | DCA FACXTYP | |
6513 | TAD REF0 | |
6514 | DCA FACXREF | |
6515 | TAD LEV0 | |
6516 | DCA IRX | |
6517 | TAD ADR0 | |
6518 | DCA IRY | |
6519 | SKIPIFSYIN;SET22 | |
6520 | JMP FVAR1 | |
6521 | TAD NORM0 | |
6522 | SNA CLA | |
6523 | IAC | |
6524 | DCA .+2 | |
6525 | EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/ | |
6526 | PUSHJUMP;SELECTOR | |
6527 | FSYS | |
6528 | FACXTYP | |
6529 | ||
6530 | TAD FACXTYP | |
6531 | TAD [-4 /STANTYPS = NOTYP(0) ... CHAR(4) | |
6532 | SPA SNA CLA | |
6533 | EMIT;42 /*** (34) ***/ | |
6534 | JMP FAC3 | |
6535 | FVAR1, DCA .+11 /F=0 | |
6536 | TAD FACXTYP | |
6537 | TAD [-4 | |
6538 | SPA SNA CLA | |
6539 | ISZ .+5 /F:=F+1 (IN STANTYPS!) | |
6540 | TAD NORM0 | |
6541 | SNA CLA | |
6542 | ISZ .+2 /F:=F+1 | |
6543 | EMIT;00 /*** (F,LEV,ADR) ***/ | |
6544 | JMP FAC3 | |
6545 | ||
6546 | FTYP, | |
6547 | FPRO, ERROR;54 /44 | |
6548 | JMP FAC3 | |
6549 | ||
6550 | FFUN, TAD TYP0 | |
6551 | DCA FACXTYP | |
6552 | TAD LEV0 | |
6553 | SNA CLA | |
6554 | JMP STFUN | |
6555 | TAD J | |
6556 | DCA .+4 | |
6557 | PUSHJUMP;CALL | |
6558 | FSYS | |
6559 | 0 | |
6560 | JMP FAC3 | |
6561 | STFUN, TAD ADR0 | |
6562 | DCA .+3 | |
6563 | PUSHJUMP;STANDFCT | |
6564 | 0 | |
6565 | JMP FAC3 | |
6566 | ||
6567 | PAGE | |
6568 | ||
6569 | FAC2, SKIPIFSYIN;SET25 | |
6570 | JMP FAC23 | |
6571 | L7776 /2=CHARCON | |
6572 | TAD SY | |
6573 | SNA CLA | |
6574 | JMP FAC21 | |
6575 | L0001 | |
6576 | TAD SY | |
6577 | DCA FACXTYP /INTS OR REALS | |
6578 | ENTERCONSTANT;NUM-1 | |
6579 | DCA IRY | |
6580 | EMIT;31 /*** (25,C) ***/ | |
6581 | JMP FAC22 | |
6582 | FAC21, L0004 /4=CHARS | |
6583 | DCA FACXTYP | |
6584 | TAD NUM+3 | |
6585 | DCA IRY | |
6586 | EMIT;30 /*** (24,NUM) ***/ | |
6587 | FAC22, DCA FACXREF | |
6588 | INSYMBOL | |
6589 | JMP FAC3 | |
6590 | FAC23, IFSYNOT;LPARENT;JMP FAC24 | |
6591 | INSYMBOL | |
6592 | PUSHJUMP;EXPRESSION | |
6593 | FSYS+SET14 | |
6594 | FACXTYP | |
6595 | ||
6596 | IFSY;RPARENT;JMP .+4 | |
6597 | ERROR;4 /4 | |
6598 | JMP FAC3 | |
6599 | INSYMBOL | |
6600 | JMP FAC3 | |
6601 | FAC24, IFSYNOT;NOTSY;JMP FAC3 | |
6602 | INSYMBOL | |
6603 | PUSHJUMP;FACTOR | |
6604 | FSYS | |
6605 | FACXTYP | |
6606 | ||
6607 | L7775 /3=BOOLS | |
6608 | TAD FACXTYP | |
6609 | SZA CLA | |
6610 | JMP .+4 | |
6611 | EMIT;43 /*** (35) ***/ | |
6612 | JMP FAC3 | |
6613 | TAD FACXTYP | |
6614 | SZA CLA | |
6615 | ERROR;40 /32 | |
6616 | FAC3, TEST;FSYS;FACBGS;6 /6 | |
6617 | JMP FAC1 | |
6618 | ||
6619 | PAGE | |
6620 | \f/PROCEDURE T E R M | |
6621 | / ------- | |
6622 | / | |
6623 | /CALL: PUSHJUMP;TERM | |
6624 | / SETX | |
6625 | / X /ADDRESS | |
6626 | / | |
6627 | /LOCAL VAR'S: FSYS | |
6628 | TRMXTYP,0 | |
6629 | TRMYTYP,0 | |
6630 | TRMYREF,0 | |
6631 | TRMOP, 0 | |
6632 | ||
6633 | XTERM, TAD TRMXTYP | |
6634 | DCA .+4 | |
6635 | PUSHJUMP;FACTOR | |
6636 | FSYS+SET26 | |
6637 | 0 | |
6638 | ||
6639 | TRM1, SKIPIFSYIN;SET26 | |
6640 | POPJUMP;TERM | |
6641 | TAD SY | |
6642 | DCA TRMOP | |
6643 | INSYMBOL | |
6644 | PUSHJUMP;FACTOR | |
6645 | FSYS+SET26 | |
6646 | TRMYTYP | |
6647 | ||
6648 | TAD TRMOP | |
6649 | TAD (JMP I OPTABL-TIMES | |
6650 | DCA .+1 | |
6651 | HLT | |
6652 | ||
6653 | OPTABL, XTIMES | |
6654 | XIDIV | |
6655 | XRDIV | |
6656 | XIMOD | |
6657 | XAND | |
6658 | ||
6659 | XTIMES, TAD I TRMXTYP | |
6660 | MQL | |
6661 | TAD TRMYTYP | |
6662 | RESULTTYPE | |
6663 | DCA I TRMXTYP | |
6664 | TAD I TRMXTYP | |
6665 | SNA | |
6666 | JMP TRM1 /NOTYP | |
6667 | TAD (-1 | |
6668 | SZA CLA | |
6669 | TAD (12-3 /REALS | |
6670 | TAD (3 /INTS | |
6671 | DCA IRY | |
6672 | EMIT;60 /*** (48,3) OR (48,12) ***/ | |
6673 | JMP TRM1 | |
6674 | ||
6675 | XRDIV, L0001 | |
6676 | DCA IRY | |
6677 | L7777 /1=INTS | |
6678 | TAD I TRMXTYP | |
6679 | SZA CLA | |
6680 | JMP .+5 | |
6681 | EMIT;32 /*** (26,1) ***/ | |
6682 | L0002 /2=REALS | |
6683 | DCA I TRMXTYP | |
6684 | DCA IRY | |
6685 | L7777 /1=INTS | |
6686 | TAD TRMYTYP | |
6687 | SZA CLA | |
6688 | JMP .+5 | |
6689 | EMIT;32 /*** (26,0) ***/ | |
6690 | L0002 /2=REALS | |
6691 | DCA TRMYTYP | |
6692 | L7776 /2=REALS | |
6693 | TAD I TRMXTYP | |
6694 | SZA CLA | |
6695 | JMP XNOTYP-1 | |
6696 | L7776 | |
6697 | TAD TRMYTYP | |
6698 | SZA CLA | |
6699 | JMP XNOTYP-1 | |
6700 | TAD (13 | |
6701 | DCA IRY | |
6702 | EMIT;60 /*** (48,13) ***/ | |
6703 | JMP TRM1 | |
6704 | ||
6705 | XIDIV, | |
6706 | XIMOD, L7777 /1=INTS | |
6707 | TAD I TRMXTYP | |
6708 | SZA CLA | |
6709 | JMP XNOTYP-2 | |
6710 | L7777 | |
6711 | TAD TRMYTYP | |
6712 | SZA CLA | |
6713 | JMP XNOTYP-2 | |
6714 | TAD TRMOP | |
6715 | CLL RAR | |
6716 | DCA IRY | |
6717 | EMIT;60 /*** (48,4) OR (48,5) ***/ | |
6718 | JMP TRM1 | |
6719 | ||
6720 | XAND, L7775 /3=BOOLS | |
6721 | TAD I TRMXTYP | |
6722 | SZA CLA | |
6723 | JMP XNOTYP | |
6724 | L7775 | |
6725 | TAD TRMYTYP | |
6726 | SZA CLA | |
6727 | JMP XNOTYP | |
6728 | EMIT;64 /*** (52) ***/ | |
6729 | JMP TRM1 | |
6730 | ||
6731 | CLA IAC | |
6732 | IAC | |
6733 | XNOTYP, TAD [40 | |
6734 | DCA ERRTYP | |
6735 | TAD I TRMXTYP | |
6736 | SZA CLA | |
6737 | TAD TRMYTYP | |
6738 | SZA CLA | |
6739 | ERROR | |
6740 | ERRTYP, 00 /32, 33 OR 34 | |
6741 | DCA I TRMXTYP /0=NOTYP | |
6742 | JMP TRM1 | |
6743 | ||
6744 | PAGE | |
6745 | \f/PROCEDURE S I M P L E E X P R E S S I O N | |
6746 | / ------------------------------- | |
6747 | / | |
6748 | /CALL: PUSHJUMP;SIMPLEEXPRESSION | |
6749 | / SETX | |
6750 | / X /ADDRESS | |
6751 | / | |
6752 | /LOCAL VAR'S: FSYS | |
6753 | SIMXTYP,0 | |
6754 | SIMYTYP,0 | |
6755 | SIMYREF,0 | |
6756 | SIMOP, 0 | |
6757 | ||
6758 | XSIMPLE,SKIPIFSYIN;SET8 | |
6759 | JMP SIM1 | |
6760 | TAD SY | |
6761 | DCA SIMOP | |
6762 | INSYMBOL | |
6763 | TAD SIMXTYP | |
6764 | DCA .+4 | |
6765 | PUSHJUMP;TERM | |
6766 | FSYS+SET8 | |
6767 | 0 | |
6768 | ||
6769 | L7776 /2=REALS | |
6770 | TAD I SIMXTYP | |
6771 | SPA SNA CLA | |
6772 | JMP .+4 | |
6773 | ERROR;41 /33 | |
6774 | JMP SIM2 | |
6775 | TAD SIMOP | |
6776 | TAD (-MINUS | |
6777 | SNA CLA | |
6778 | EMIT;44 /*** (36) ***/ | |
6779 | JMP SIM2 | |
6780 | SIM1, TAD SIMXTYP | |
6781 | DCA .+4 | |
6782 | PUSHJUMP;TERM | |
6783 | FSYS+SET27 | |
6784 | 0 | |
6785 | ||
6786 | SIM2, SKIPIFSYIN;SET27 | |
6787 | POPJUMP;SIMPLEEXPRESSION | |
6788 | TAD SY | |
6789 | DCA SIMOP | |
6790 | INSYMBOL | |
6791 | PUSHJUMP;TERM | |
6792 | FSYS+SET27 | |
6793 | SIMYTYP | |
6794 | ||
6795 | TAD SIMOP | |
6796 | TAD (-ORSY | |
6797 | SZA CLA | |
6798 | JMP SIM3 | |
6799 | L7775 /3=BOOLS | |
6800 | TAD I SIMXTYP | |
6801 | SZA CLA | |
6802 | JMP NOTBOOL | |
6803 | L7775 | |
6804 | TAD SIMYTYP | |
6805 | SZA CLA | |
6806 | JMP NOTBOOL | |
6807 | EMIT;63 /*** (51) ***/ | |
6808 | JMP SIM2 | |
6809 | NOTBOOL,TAD I SIMXTYP | |
6810 | SZA CLA | |
6811 | TAD SIMYTYP | |
6812 | SZA CLA | |
6813 | ERROR;40 /32 | |
6814 | DCA I SIMXTYP /0=NOTYP | |
6815 | JMP SIM2 | |
6816 | SIM3, TAD I SIMXTYP | |
6817 | MQL | |
6818 | TAD SIMYTYP | |
6819 | RESULTTYPE | |
6820 | DCA I SIMXTYP | |
6821 | TAD I SIMXTYP | |
6822 | SNA | |
6823 | JMP SIM2 | |
6824 | CLL RAR /NOW: 0...INTS, 1...REALS! | |
6825 | SZA CLA | |
6826 | TAD (7 | |
6827 | TAD [-4 | |
6828 | TAD SIMOP /+ ... 5, - ... 6 | |
6829 | DCA IRY | |
6830 | EMIT;60 /*** (48,1) OR (48,2) OR (48,10) OR (48,11) ***/ | |
6831 | JMP SIM2 | |
6832 | ||
6833 | PAGE | |
6834 | \f/PROCEDURE E X P R E S S I O N | |
6835 | / ------------------- | |
6836 | / | |
6837 | /CALL: PUSHJUMP;EXPRESSION | |
6838 | / SETX | |
6839 | / X /ADDRESS | |
6840 | / | |
6841 | /LOCAL VAR'S: FSYS | |
6842 | EXPRVAR,0 | |
6843 | XTYP, 0 | |
6844 | XREF, 0 | |
6845 | YTYP, 0 | |
6846 | YREF, 0 | |
6847 | OP, 0 | |
6848 | ||
6849 | XEXPRESSION, | |
6850 | PUSHJUMP;SIMPLEEXPRESSION | |
6851 | FSYS+SET28 | |
6852 | XTYP | |
6853 | ||
6854 | SKIPIFSYIN;SET28 | |
6855 | POPJUMP;EXPRESSION | |
6856 | TAD SY | |
6857 | DCA OP | |
6858 | INSYMBOL | |
6859 | PUSHJUMP;SIMPLEEXPRESSION | |
6860 | FSYS | |
6861 | YTYP | |
6862 | ||
6863 | L7776 /2=REALS | |
6864 | TAD XTYP | |
6865 | SNA | |
6866 | JMP EXPR1 | |
6867 | TAD [-2 /2+2=4=CHARS | |
6868 | SMA SZA CLA | |
6869 | JMP EXPR1 | |
6870 | TAD XTYP | |
6871 | CIA | |
6872 | TAD YTYP | |
6873 | SNA CLA | |
6874 | JMP IEXPR | |
6875 | EXPR1, L0001 | |
6876 | DCA IRY | |
6877 | L7777 /1=INTS | |
6878 | TAD XTYP | |
6879 | SZA CLA | |
6880 | JMP .+5 | |
6881 | EMIT;32 /*** (26,1) ***/ | |
6882 | L0002 /2=REALS | |
6883 | DCA XTYP | |
6884 | DCA IRY | |
6885 | L7777 /1=INTS | |
6886 | TAD YTYP | |
6887 | SZA CLA | |
6888 | JMP .+5 | |
6889 | EMIT;32 /*** (26,0) ***/ | |
6890 | L0002 /2=REALS | |
6891 | DCA YTYP | |
6892 | L7776 /2=REALS | |
6893 | TAD XTYP | |
6894 | SZA CLA | |
6895 | JMP ILLTYP | |
6896 | L7776 | |
6897 | TAD YTYP | |
6898 | SZA CLA | |
6899 | JMP ILLTYP | |
6900 | REXPR, L0001 | |
6901 | IEXPR, TAD (61 | |
6902 | DCA I61R62 | |
6903 | TAD OP | |
6904 | TAD (TAD RELTABL-EQL | |
6905 | DCA .+1 | |
6906 | 0000 /TAD RELTABL (MODIFIED INSTR.!) | |
6907 | DCA IRY | |
6908 | EMIT | |
6909 | I61R62, 00 /*** (49,OP) OR (50,OP) ***/ | |
6910 | EXPR3, L0003 /3=BOOLS | |
6911 | DCA XTYP | |
6912 | POPJUMP;EXPRESSION | |
6913 | ||
6914 | ILLTYP, ERROR;43 /35 | |
6915 | JMP EXPR3 | |
6916 | ||
6917 | RELTABL,SZA | |
6918 | SNA | |
6919 | SPA SNA | |
6920 | SPA | |
6921 | SMA | |
6922 | SMA SZA | |
6923 | ||
6924 | PAGE | |
6925 | \f/PROCEDURE A S S I G N M E N T | |
6926 | / ------------------- | |
6927 | / | |
6928 | /CALL: PUSHJUMP;ASSIGNMENT | |
6929 | / LEV /VALUE | |
6930 | / ADR /- " - | |
6931 | / | |
6932 | /LOCAL VAR'S: | |
6933 | LV, 0 | |
6934 | AD, 0 | |
6935 | AXTYP, 0 | |
6936 | AXREF, 0 | |
6937 | AYTYP, 0 | |
6938 | AYREF, 0 | |
6939 | ||
6940 | XASSIGNMENT, | |
6941 | OFTAB;TYP /J IS SET IN STATEMENT | |
6942 | AND [77 | |
6943 | DCA AXTYP | |
6944 | OFTAB;REF | |
6945 | BSW | |
6946 | AND [77 | |
6947 | DCA AXREF | |
6948 | TAD LV | |
6949 | DCA IRX | |
6950 | TAD AD | |
6951 | DCA IRY | |
6952 | OFTAB;NORMAL | |
6953 | AND [40 | |
6954 | SNA CLA | |
6955 | IAC | |
6956 | DCA .+2 | |
6957 | EMIT;00 /*** (0,LV,AD) OR (1,LV,AD) ***/ | |
6958 | SKIPIFSYIN;SET22 | |
6959 | JMP .+5 | |
6960 | PUSHJUMP;SELECTOR | |
6961 | FSYS+SET29 | |
6962 | AXTYP | |
6963 | ||
6964 | IFSY;BECOMES;JMP .+5 | |
6965 | ERROR;63 /51 | |
6966 | IFSY;EQL;INSYMBOL | |
6967 | PUSHJUMP;EXPRESSION | |
6968 | FSYS | |
6969 | AYTYP | |
6970 | ||
6971 | TAD AXTYP | |
6972 | CIA | |
6973 | TAD AYTYP | |
6974 | SZA CLA | |
6975 | JMP ASS1 | |
6976 | TAD AXTYP | |
6977 | TAD [-ARRAY | |
6978 | SPA CLA | |
6979 | JMP ASS2-2 | |
6980 | TAD AXREF /ARRAY- OR RECORD-VARIABLE | |
6981 | CIA | |
6982 | TAD AYREF | |
6983 | SZA CLA | |
6984 | JMP ASSERR | |
6985 | TAD AXTYP | |
6986 | TAD [-ARRAY | |
6987 | SZA CLA | |
6988 | JMP .+5 | |
6989 | TAD AXREF /ARRAY | |
6990 | OFATAB;SIZE | |
6991 | JMP .+4 | |
6992 | TAD AXREF /RECORD | |
6993 | OFBTAB;VSIZE | |
6994 | DCA IRY | |
6995 | EMIT;27 /*** (23,SIZE) ***/ | |
6996 | JMP ASS2 | |
6997 | ASS1, L7776 /2=REALS | |
6998 | TAD AXTYP | |
6999 | SZA CLA | |
7000 | JMP ASS3 | |
7001 | L7777 /1=INTS | |
7002 | TAD AYTYP | |
7003 | SZA CLA | |
7004 | JMP ASS3 | |
7005 | EMIT;32 /*** (26,0) ***/ | |
7006 | EMIT;46 /*** (38) ***/ | |
7007 | ASS2, POPJUMP;ASSIGNMENT | |
7008 | ||
7009 | ASS3, TAD AXTYP | |
7010 | SZA CLA | |
7011 | TAD AYTYP | |
7012 | SZA CLA | |
7013 | ASSERR, ERROR;56 /46 | |
7014 | JMP ASS2 | |
7015 | \f/PROCEDURE C O M P O U N D S T A T E M E N T | |
7016 | / --------------------------------- | |
7017 | / | |
7018 | /CALL: PUSHJUMP;COMPOUNDSTATEMENT /NO ARG'S! | |
7019 | / | |
7020 | /NO LOCAL VAR'S! | |
7021 | ||
7022 | XCOMPOUNDSTATEMENT, | |
7023 | INSYMBOL | |
7024 | PUSHJUMP;STATEMENT | |
7025 | FSYS+SET30 | |
7026 | ||
7027 | SKIPIFSYIN;SET31 | |
7028 | JMP CMP1 | |
7029 | IFSY;SEMICOLON;JMP XCOMPOUNDSTATEMENT | |
7030 | ERROR;16 /14 | |
7031 | JMP XCOMPOUNDSTATEMENT+1 | |
7032 | CMP1, IFSY;ENDSY;JMP .+4 | |
7033 | ERROR;71 /57 | |
7034 | SKP | |
7035 | INSYMBOL | |
7036 | POPJUMP;COMPOUNDSTATEMENT | |
7037 | ||
7038 | PAGE | |
7039 | \f/PROCEDURE C A S E L A B E L | |
7040 | / ----------------- | |
7041 | / | |
7042 | /CALL: JMS CASELABEL /NOT RECURSIVE! | |
7043 | / | |
7044 | /LOCAL VAR'S: | |
7045 | LAB, ZBLOCK 5 | |
7046 | ||
7047 | CASELABEL, 0 | |
7048 | PUSHJUMP;CONSTANT | |
7049 | FSYS+SET6 | |
7050 | LAB | |
7051 | ||
7052 | TAD LAB | |
7053 | CIA | |
7054 | TAD I CCXTYP | |
7055 | SZA CLA | |
7056 | JMP LABERR | |
7057 | TAD I CCI | |
7058 | DCA XR11 | |
7059 | TAD XR11 | |
7060 | TAD CLIMIT | |
7061 | SNA CLA | |
7062 | FATALC, FATAL /TOO MUCH CASE-LABELS! | |
7063 | SIGNEDINTEGER;LAB | |
7064 | DCA TEMP | |
7065 | TAD TEMP | |
7066 | DCA I XR11 | |
7067 | TAD LC | |
7068 | DCA I XR11 | |
7069 | TAD XR11 | |
7070 | DCA I CCI | |
7071 | TAD CTABM1 | |
7072 | DCA XR11 | |
7073 | TAD I XR11 | |
7074 | ISZ XR11 | |
7075 | CIA | |
7076 | TAD TEMP | |
7077 | SZA CLA | |
7078 | JMP .-5 | |
7079 | TAD XR11 | |
7080 | CIA | |
7081 | TAD I CCI | |
7082 | SZA CLA | |
7083 | ERROR;1 /1 | |
7084 | JMP I CASELABEL | |
7085 | LABERR, ERROR;57 /47 | |
7086 | JMP I CASELABEL | |
7087 | CCI, CI | |
7088 | CCXTYP, CXTYP | |
7089 | CLIMIT, -2^CSMAX-CASETAB+1 | |
7090 | CTABM1, CASETAB-1 | |
7091 | \f/PROCEDURE C A S E S T A T E M E N T | |
7092 | / ------------------------- | |
7093 | / | |
7094 | /CALL: PUSHJUMP;CASESTATEMENT /NO ARG'S! | |
7095 | / | |
7096 | /LOCAL VAR'S: | |
7097 | CASETAB, ZBLOCK CSMAX^2 | |
7098 | EXITTAB, ZBLOCK CSMAX | |
7099 | CXTYP, 0 | |
7100 | CXREF, 0 | |
7101 | CLC1, 0 | |
7102 | CI, 0 | |
7103 | CJ, 0 | |
7104 | ||
7105 | XCASESTATEMENT, INSYMBOL | |
7106 | TAD (CASETAB-1 | |
7107 | DCA CI | |
7108 | TAD (EXITTAB-1 | |
7109 | DCA CJ | |
7110 | PUSHJUMP;EXPRESSION | |
7111 | FSYS+SET34 | |
7112 | CXTYP | |
7113 | ||
7114 | L7776 /2=REALS | |
7115 | TAD CXTYP | |
7116 | SNA | |
7117 | JMP .+3 | |
7118 | TAD [-2 /2+2=4=CHARS (LAST STANTYP) | |
7119 | SMA SZA CLA | |
7120 | ERROR;27 /23 | |
7121 | TAD LC | |
7122 | DCA CLC1 | |
7123 | EMIT;14 /*** (12) ***/ | |
7124 | IFSY;OFSY;JMP CAS1 | |
7125 | ERROR;10 /8 | |
7126 | SKP | |
7127 | CAS1, INSYMBOL | |
7128 | PUSHJUMP;ONECASE | |
7129 | IFSY;SEMICOLON;JMP CAS1 | |
7130 | TAD CLC1 | |
7131 | TOCODE | |
7132 | TAD (CASETAB-1 | |
7133 | DCA XR11 | |
7134 | CAS2, TAD XR11 | |
7135 | CIA | |
7136 | TAD CI | |
7137 | SNA CLA | |
7138 | JMP CAS3 | |
7139 | TAD I XR11 | |
7140 | DCA IRY | |
7141 | EMIT;15 /*** (13) ***/ | |
7142 | JMP CAS2 | |
7143 | CAS3, EMIT;12 /*** (10) ***/ | |
7144 | TAD (EXITTAB-1 | |
7145 | DCA XR11 | |
7146 | CAS4, TAD XR11 | |
7147 | CIA | |
7148 | TAD CJ | |
7149 | SNA CLA | |
7150 | JMP CAS5 | |
7151 | TAD I XR11 | |
7152 | TOCODE | |
7153 | JMP CAS4 | |
7154 | CAS5, IFSY;ENDSY;JMP .+4 | |
7155 | ERROR;71 /57 | |
7156 | SKP | |
7157 | INSYMBOL | |
7158 | POPJUMP;CASESTATEMENT | |
7159 | \f/PROCEDURE O N E C A S E | |
7160 | / ------------- | |
7161 | / | |
7162 | /CALL: PUSHJUMP;ONECASE /NO ARG'S! | |
7163 | / | |
7164 | /NO LOCAL VAR'S! (USES SOME VAR'S OF 'CASESTATEMENT') | |
7165 | ||
7166 | XONECASE, SKIPIFSYIN;CONBGS | |
7167 | JMP ONE2 | |
7168 | SKP | |
7169 | ONE1, INSYMBOL | |
7170 | JMS CASELABEL | |
7171 | IFSY;COMMA;JMP ONE1 | |
7172 | IFSY;COLON;JMP .+4 | |
7173 | ERROR;5 /5 | |
7174 | SKP | |
7175 | INSYMBOL | |
7176 | PUSHJUMP;STATEMENT | |
7177 | FSYS+SET30 | |
7178 | ||
7179 | ISZ CJ | |
7180 | TAD LC | |
7181 | DCA I CJ | |
7182 | EMIT;12 /*** (10) ***/ | |
7183 | ONE2, POPJUMP;ONECASE | |
7184 | ||
7185 | PAGE | |
7186 | \f/PROCEDURE I F S T A T E M E N T | |
7187 | / --------------------- | |
7188 | / | |
7189 | /CALL: PUSHJUMP;IFSTATEMENT /NO ARG'S! | |
7190 | / | |
7191 | /LOCAL VAR'S: | |
7192 | IXTYP, 0 | |
7193 | IXREF, 0 | |
7194 | ILC1, 0 | |
7195 | ILC2, 0 | |
7196 | ||
7197 | XIFSTATEMENT, | |
7198 | INSYMBOL | |
7199 | PUSHJUMP;EXPRESSION | |
7200 | FSYS+SET32 | |
7201 | IXTYP | |
7202 | ||
7203 | TAD IXTYP | |
7204 | SNA | |
7205 | JMP .+5 | |
7206 | TAD [-BOOLS | |
7207 | SZA CLA | |
7208 | ERROR;21 /17 | |
7209 | TAD LC | |
7210 | DCA ILC1 | |
7211 | EMIT;13 /*** (11) ***/ | |
7212 | IFSY;THENSY;JMP .+5 | |
7213 | ERROR;64 /52 | |
7214 | IFSY;DOSY;INSYMBOL | |
7215 | PUSHJUMP;STATEMENT | |
7216 | FSYS+SET33 | |
7217 | ||
7218 | IFSYNOT;ELSESY;JMP IF1 | |
7219 | INSYMBOL | |
7220 | TAD LC | |
7221 | DCA ILC2 | |
7222 | EMIT;12 /*** (10) ***/ | |
7223 | TAD ILC1 | |
7224 | TOCODE /*** CODE[ILC1] := LC ***/ | |
7225 | PUSHJUMP;STATEMENT | |
7226 | FSYS | |
7227 | ||
7228 | TAD ILC2 | |
7229 | TOCODE /*** CODE[ILC2] := LC ***/ | |
7230 | POPJUMP;IFSTATEMENT | |
7231 | IF1, TAD ILC1 | |
7232 | JMP .-4 /*** CODE[ILC1] := LC ***/ | |
7233 | \f/PROCEDURE R E P E A T S T A T E M E N T | |
7234 | / ----------------------------- | |
7235 | / | |
7236 | /CALL: PUSHJUMP;REPEATSTATEMENT /NO ARG'S! | |
7237 | / | |
7238 | /LOCAL VAR'S: | |
7239 | RXTYP, 0 | |
7240 | RXREF, 0 | |
7241 | RLC1, 0 | |
7242 | ||
7243 | XREPEAT,TAD LC | |
7244 | DCA RLC1 | |
7245 | INSYMBOL | |
7246 | PUSHJUMP;STATEMENT | |
7247 | FSYS+SET35 | |
7248 | ||
7249 | SKIPIFSYIN;SET31 | |
7250 | JMP REP1 | |
7251 | IFSY;SEMICOLON;JMP XREPEAT+2 | |
7252 | ERROR;16 /14 | |
7253 | JMP XREPEAT+3 | |
7254 | REP1, IFSYNOT;UNTILSY;JMP REPERR | |
7255 | INSYMBOL | |
7256 | PUSHJUMP;EXPRESSION | |
7257 | FSYS | |
7258 | RXTYP | |
7259 | ||
7260 | TAD RXTYP | |
7261 | SNA | |
7262 | JMP .+5 | |
7263 | TAD [-BOOLS | |
7264 | SZA CLA | |
7265 | ERROR;21 /17 | |
7266 | TAD RLC1 | |
7267 | DCA IRY | |
7268 | EMIT;13 /*** (11,RLC1) ***/ | |
7269 | JMP .+3 | |
7270 | REPERR, ERROR;65 /53 | |
7271 | POPJUMP;REPEATSTATEMENT | |
7272 | \f/PROCEDURE W H I L E S T A T E M E N T | |
7273 | / --------------------------- | |
7274 | / | |
7275 | /CALL: PUSHJUMP;WHILESTATEMENT /NO ARG'S! | |
7276 | / | |
7277 | /LOCAL VAR'S (ON PAGE ZERO!): | |
7278 | / WXTYP, 0 | |
7279 | / WXREF, 0 | |
7280 | / WLC1, 0 | |
7281 | / WLC2, 0 | |
7282 | ||
7283 | XWHILESTATEMENT, | |
7284 | INSYMBOL | |
7285 | TAD LC | |
7286 | DCA WLC1 | |
7287 | PUSHJUMP;EXPRESSION | |
7288 | FSYS+SET36 | |
7289 | WXTYP | |
7290 | ||
7291 | TAD WXTYP | |
7292 | SNA | |
7293 | JMP .+5 | |
7294 | TAD [-BOOLS | |
7295 | SZA CLA | |
7296 | ERROR;21 /17 | |
7297 | TAD LC | |
7298 | DCA WLC2 | |
7299 | EMIT;13 /*** (11) ***/ | |
7300 | IFSY;DOSY;JMP .+4 | |
7301 | ERROR;66 /54 | |
7302 | SKP | |
7303 | INSYMBOL | |
7304 | PUSHJUMP;STATEMENT | |
7305 | FSYS | |
7306 | ||
7307 | TAD WLC1 | |
7308 | DCA IRY | |
7309 | EMIT;12 /*** (10,WLC1) ***/ | |
7310 | TAD WLC2 | |
7311 | TOCODE /*** CODE[WLC2] := LC ***/ | |
7312 | POPJUMP;WHILESTATEMENT | |
7313 | ||
7314 | PAGE | |
7315 | \f/PROCEDURE F O R S T A T E M E N T | |
7316 | / ----------------------- | |
7317 | / | |
7318 | /CALL: PUSHJUMP;FORSTATEMENT /NO ARG'S! | |
7319 | / | |
7320 | /LOCAL VAR'S: | |
7321 | FXTYP, 0 | |
7322 | FXREF, 0 | |
7323 | CVT, 0 | |
7324 | FLC1, 0 | |
7325 | FLC2, 0 | |
7326 | FF, 0 | |
7327 | ||
7328 | XFORSTATEMENT, | |
7329 | INSYMBOL | |
7330 | IFSYNOT;IDENT;JMP FOR2 | |
7331 | LOCATE | |
7332 | DCA J | |
7333 | INSYMBOL | |
7334 | TAD J | |
7335 | SNA CLA | |
7336 | JMP FOR1+2 | |
7337 | WITHTABDO | |
7338 | L7777 /1=VARIABLE | |
7339 | TAD OBJ0 | |
7340 | SZA CLA | |
7341 | JMP FOR1 | |
7342 | TAD TYP0 | |
7343 | DCA CVT | |
7344 | TAD LEV0 | |
7345 | DCA IRX | |
7346 | TAD ADR0 | |
7347 | DCA IRY | |
7348 | EMIT;0 /*** (0,LEV,ADR) ***/ | |
7349 | L7776 /2=REALS | |
7350 | TAD CVT | |
7351 | SNA | |
7352 | JMP .+3 | |
7353 | TAD [-2 /2+2=4=CHARS (LAST STANTYP) | |
7354 | SMA SZA CLA | |
7355 | ERROR;22 /18 | |
7356 | JMP FOR3 | |
7357 | FOR1, ERROR;45 /37 | |
7358 | L0001 /1=INTS | |
7359 | DCA CVT | |
7360 | JMP FOR3 | |
7361 | FOR2, SKIP;FSYS+SET37;2 /2 | |
7362 | FOR3, IFSYNOT;BECOMES;JMP FOR4 | |
7363 | INSYMBOL | |
7364 | PUSHJUMP;EXPRESSION | |
7365 | FSYS+SET38 | |
7366 | FXTYP | |
7367 | ||
7368 | TAD FXTYP | |
7369 | CIA | |
7370 | TAD CVT | |
7371 | SZA CLA | |
7372 | ERROR;23 /19 | |
7373 | JMP FOR5 | |
7374 | FOR4, SKIP;FSYS+SET38;63 /51 | |
7375 | FOR5, TAD (16 /14 | |
7376 | DCA FF | |
7377 | SKIPIFSYIN;SET39 | |
7378 | JMP FOR6 | |
7379 | IFSY;DOWNTOSY;L0002 | |
7380 | TAD (16 | |
7381 | DCA FF | |
7382 | INSYMBOL | |
7383 | PUSHJUMP;EXPRESSION | |
7384 | FSYS+SET36 | |
7385 | FXTYP | |
7386 | ||
7387 | TAD FXTYP | |
7388 | CIA | |
7389 | TAD CVT | |
7390 | SZA CLA | |
7391 | ERROR;23 /19 | |
7392 | JMP FOR7 | |
7393 | FOR6, SKIP;FSYS+SET36;67 /55 | |
7394 | FOR7, TAD LC | |
7395 | DCA FLC1 | |
7396 | TAD FF | |
7397 | DCA .+2 | |
7398 | EMIT;00 /*** (14) OR (16) ***/ | |
7399 | IFSY;DOSY;JMP .+4 | |
7400 | ERROR;66 /54 | |
7401 | SKP | |
7402 | INSYMBOL | |
7403 | TAD LC | |
7404 | DCA FLC2 | |
7405 | PUSHJUMP;STATEMENT | |
7406 | FSYS | |
7407 | ||
7408 | TAD FLC2 | |
7409 | DCA IRY | |
7410 | L0001 | |
7411 | TAD FF | |
7412 | DCA .+2 | |
7413 | EMIT;00 /*** (15,FLC2) OR (17,FLC2) ***/ | |
7414 | TAD FLC1 | |
7415 | TOCODE /*** CODE[FLC1] := LC ***/ | |
7416 | POPJUMP;FORSTATEMENT | |
7417 | ||
7418 | PAGE | |
7419 | \f/PROCEDURE S T A N D P R O C | |
7420 | / ----------------- | |
7421 | / | |
7422 | /CALL: PUSHJUMP;STANDPROC | |
7423 | / I /VALUE | |
7424 | / | |
7425 | /LOCAL VAR'S: | |
7426 | PRCN, 0 | |
7427 | SPXTYP, 0 | |
7428 | SPXREF, 0 | |
7429 | SPYTYP, 0 | |
7430 | SPYREF, 0 | |
7431 | ||
7432 | XSTPROC,TAD PRCN | |
7433 | TAD (JMP I STPRTAB-1 | |
7434 | DCA .+1 | |
7435 | HLT | |
7436 | ||
7437 | STPRTAB,SPREAD | |
7438 | SPREAD | |
7439 | SPWRITE | |
7440 | SPWRITE | |
7441 | SPHALT | |
7442 | SPASCII | |
7443 | ||
7444 | SPREAD, IFSYNOT;LPARENT;JMP SPR3 | |
7445 | SPR1, INSYMBOL | |
7446 | IFSY;IDENT;JMP .+4 | |
7447 | ERROR;2 /2 | |
7448 | JMP SPR2 | |
7449 | LOCATE | |
7450 | DCA J | |
7451 | INSYMBOL | |
7452 | TAD J | |
7453 | SNA CLA | |
7454 | JMP SPR2 | |
7455 | WITHTABDO | |
7456 | L7777 /1=VARIABLE | |
7457 | TAD OBJ0 | |
7458 | SNA CLA | |
7459 | JMP .+4 | |
7460 | ERROR;45 /37 | |
7461 | JMP SPR2 | |
7462 | TAD TYP0 | |
7463 | DCA SPXTYP | |
7464 | TAD REF0 | |
7465 | DCA SPXREF | |
7466 | TAD LEV0 | |
7467 | DCA IRX | |
7468 | TAD ADR0 | |
7469 | DCA IRY | |
7470 | TAD NORM0 | |
7471 | SNA CLA | |
7472 | IAC | |
7473 | DCA .+2 | |
7474 | EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/ | |
7475 | SKIPIFSYIN;SET22 | |
7476 | JMP .+5 | |
7477 | PUSHJUMP;SELECTOR | |
7478 | FSYS+SET24 | |
7479 | SPXTYP | |
7480 | ||
7481 | L7775 /3=BOOLS | |
7482 | TAD SPXTYP | |
7483 | SNA | |
7484 | JMP SPR2-2 | |
7485 | TAD (-1 /4=CHARS (LAST STANTYP) | |
7486 | SMA SZA CLA | |
7487 | JMP SPR2-2 | |
7488 | TAD SPXTYP | |
7489 | DCA IRY | |
7490 | EMIT;33 /*** (27,TYP) ***/ | |
7491 | JMP SPR2 | |
7492 | ERROR;50 /40 | |
7493 | SPR2, TEST;SET24;FSYS;6 /6 | |
7494 | IFSY;COMMA;JMP SPR1 | |
7495 | IFSY;RPARENT;JMP .+4 | |
7496 | ERROR;4 /4 | |
7497 | SKP | |
7498 | INSYMBOL | |
7499 | SPR3, L7776 /-2 | |
7500 | TAD PRCN | |
7501 | SNA CLA | |
7502 | EMIT;76 /*** (62) ***/ | |
7503 | POPJUMP;STANDPROC | |
7504 | \fSPASCII,IFSYNOT;LPARENT;JMP SPASC2 | |
7505 | SPASC1, INSYMBOL | |
7506 | PUSHJUMP;EXPRESSION | |
7507 | FSYS+SET24 | |
7508 | SPXTYP | |
7509 | ||
7510 | L7777 /1=INTS | |
7511 | TAD SPXTYP | |
7512 | SZA CLA | |
7513 | ERROR;53 /43 | |
7514 | EMIT;75 /*** (61) ***/ | |
7515 | IFSY;COMMA;JMP SPASC1 | |
7516 | IFSY;RPARENT;JMP .+4 | |
7517 | ERROR;4 /4 | |
7518 | SKP | |
7519 | INSYMBOL | |
7520 | SPASC2, POPJUMP;STANDPROC | |
7521 | ||
7522 | ||
7523 | SPHALT, EMIT;45 /*** (37) ***/ | |
7524 | POPJUMP;STANDPROC | |
7525 | ||
7526 | PAGE | |
7527 | \fSPWRITE,IFSYNOT;LPARENT;JMP SPW5 | |
7528 | SPW1, INSYMBOL | |
7529 | IFSYNOT;STRING;JMP SPW2 | |
7530 | TAD SLENG | |
7531 | DCA IRY | |
7532 | EMIT;30 /*** (24,SLENG) ***/ | |
7533 | TAD NUM+3 | |
7534 | DCA STRNUM | |
7535 | INSYMBOL | |
7536 | IFSYNOT;COLON;JMP SPW1A | |
7537 | INSYMBOL | |
7538 | PUSHJUMP;EXPRESSION | |
7539 | FSYS+SET24 | |
7540 | SPYTYP | |
7541 | ||
7542 | L7777 /1=INTS | |
7543 | TAD SPYTYP | |
7544 | SZA CLA | |
7545 | ERROR;53 /43 | |
7546 | JMP .+3 | |
7547 | SPW1A, EMIT;30 /*** (24,0) ***/ | |
7548 | TAD STRNUM | |
7549 | DCA IRY | |
7550 | EMIT;34 /*** (28,NUM) ***/ | |
7551 | JMP SPW4 | |
7552 | STRNUM, 0 | |
7553 | ||
7554 | SPW2, PUSHJUMP;EXPRESSION | |
7555 | FSYS+SET23 | |
7556 | SPXTYP | |
7557 | ||
7558 | TAD SPXTYP | |
7559 | TAD [-CHARS | |
7560 | SMA SZA CLA | |
7561 | ERROR;51 /41 | |
7562 | IFSYNOT;COLON;JMP SPW3+1 | |
7563 | INSYMBOL | |
7564 | PUSHJUMP;EXPRESSION | |
7565 | FSYS+SET23 | |
7566 | SPYTYP | |
7567 | ||
7568 | L7777 /1=INTS | |
7569 | TAD SPYTYP | |
7570 | SZA CLA | |
7571 | ERROR;53 /43 | |
7572 | IFSYNOT;COLON;JMP SPW3 | |
7573 | L7776 /2=REALS | |
7574 | TAD SPXTYP | |
7575 | SZA CLA | |
7576 | ERROR;52 /42 | |
7577 | INSYMBOL | |
7578 | PUSHJUMP;EXPRESSION | |
7579 | FSYS+SET24 | |
7580 | SPYTYP | |
7581 | ||
7582 | L7777 /1=INTS | |
7583 | TAD SPYTYP | |
7584 | SZA CLA | |
7585 | ERROR;53 /43 | |
7586 | EMIT;37 /*** (31) ***/ | |
7587 | JMP SPW4 | |
7588 | SPW3, L0001 | |
7589 | TAD (35 | |
7590 | DCA .+4 | |
7591 | TAD SPXTYP | |
7592 | DCA IRY | |
7593 | EMIT;00 /*** (29,TYP) OR (30,TYP) ***/ | |
7594 | SPW4, IFSY;COMMA;JMP SPW1 | |
7595 | IFSY;RPARENT;JMP .+4 | |
7596 | ERROR;4 /4 | |
7597 | SKP | |
7598 | INSYMBOL | |
7599 | SPW5, TAD PRCN | |
7600 | TAD [-4 | |
7601 | SNA CLA | |
7602 | EMIT;77 /*** (63) ***/ | |
7603 | POPJUMP;STANDPROC | |
7604 | ||
7605 | PAGE | |
7606 | \f/PROCEDURE S T A T E M E N T | |
7607 | / ----------------- | |
7608 | / | |
7609 | /CALL: PUSHJUMP;STATEMENT | |
7610 | / SETX | |
7611 | / | |
7612 | /NO LOCAL VAR'S! | |
7613 | XSTATEMENT, | |
7614 | SKIPIFSYIN;SET40 | |
7615 | JMP STAT2 | |
7616 | IFSYNOT;IDENT;JMP STAT1 | |
7617 | LOCATE | |
7618 | DCA J | |
7619 | INSYMBOL | |
7620 | TAD J | |
7621 | SNA CLA | |
7622 | JMP STAT2 | |
7623 | WITHTABDO | |
7624 | TAD OBJ0 | |
7625 | TAD JMPOBJ | |
7626 | DCA .+1 | |
7627 | HLT | |
7628 | ||
7629 | OBJTABL,IDCON | |
7630 | IDVAR | |
7631 | IDTYP | |
7632 | IDPRO | |
7633 | IDFUN | |
7634 | ||
7635 | JMPOBJ, JMP I OBJTABL | |
7636 | ||
7637 | IDCON, | |
7638 | IDTYP, ERROR;55 /45 | |
7639 | JMP STAT2 | |
7640 | ||
7641 | IDVAR, TAD LEV0 | |
7642 | DCA .+5 | |
7643 | TAD ADR0 | |
7644 | DCA .+4 | |
7645 | PUSHJUMP;ASSIGNMENT | |
7646 | 0 | |
7647 | 0 | |
7648 | JMP STAT2 | |
7649 | ||
7650 | IDPRO, TAD LEV0 | |
7651 | SNA CLA | |
7652 | JMP IDPRO1 | |
7653 | TAD J | |
7654 | DCA .+4 | |
7655 | PUSHJUMP;CALL | |
7656 | FSYS | |
7657 | 0 | |
7658 | JMP STAT2 | |
7659 | ||
7660 | IDPRO1, TAD ADR0 | |
7661 | DCA .+3 | |
7662 | PUSHJUMP;STANDPROC | |
7663 | 0 | |
7664 | JMP STAT2 | |
7665 | ||
7666 | IDFUN, OFDISPLAY | |
7667 | CIA | |
7668 | TAD REF0 | |
7669 | SZA CLA | |
7670 | JMP IDTYP | |
7671 | L0001 | |
7672 | TAD LEV0 | |
7673 | DCA .+3 | |
7674 | PUSHJUMP;ASSIGNMENT | |
7675 | 0 | |
7676 | 0000 /ALWAYS 0! | |
7677 | JMP STAT2 | |
7678 | ||
7679 | STAT1, TAD SY | |
7680 | TAD STATNO | |
7681 | DCA .+2 | |
7682 | PUSHJUMP;00 | |
7683 | STAT2, TEST;FSYS;SET0;16 /14 | |
7684 | POPJUMP;STATEMENT | |
7685 | ||
7686 | STATNO, COMPOUNDSTATEMENT-BEGINSY | |
7687 | \f/PROCEDURE B L O C K | |
7688 | / --------- | |
7689 | / | |
7690 | /CALL: PUSHJUMP;BLOCK | |
7691 | / SETX | |
7692 | / ISFUN /VALUE | |
7693 | / LEVEL /VALUE | |
7694 | / | |
7695 | /LOCAL VAR'S (ON PAGE ZERO!): | |
7696 | / FSYS | |
7697 | / ISFUN, 0 | |
7698 | / LEVEL, 0 | |
7699 | / DX, 0 | |
7700 | / PRT, 0 | |
7701 | / PRB, 0 | |
7702 | ||
7703 | MAXLEV, -LMAX /CONSTANT | |
7704 | TOFAT5, FATAL5 | |
7705 | C0005, 5 | |
7706 | BLK1, BLO1 | |
7707 | BLK2, BLO2 | |
7708 | BLK2M2, BLO2-2 | |
7709 | ||
7710 | XBLOCK, TAD C0005 | |
7711 | DCA DX | |
7712 | TAD T | |
7713 | DCA PRT | |
7714 | TAD LEVEL | |
7715 | TAD MAXLEV | |
7716 | SMA SZA CLA | |
7717 | JMP I TOFAT5 /TOO MUCH LEVELS! | |
7718 | TEST;SET41;FSYS;7 /7 | |
7719 | ENTERBLOCK | |
7720 | TAD B | |
7721 | TODISPLAY | |
7722 | TAD B | |
7723 | DCA PRB | |
7724 | TAD PRT | |
7725 | WITHTABDO | |
7726 | DCA TYP0 /0=NOTYP | |
7727 | TAD PRB | |
7728 | DCA REF0 | |
7729 | ENDWITH | |
7730 | IFSY;LPARENT;PUSHJUMP;PARAMETERLIST | |
7731 | TAD PRB | |
7732 | DCA JB | |
7733 | TAD T | |
7734 | TOBTAB;LASTPAR | |
7735 | TAD DX | |
7736 | TOBTAB;PSIZE | |
7737 | TAD ISFUN | |
7738 | SNA CLA | |
7739 | JMP I BLK2 | |
7740 | IFSYNOT;COLON;JMP I BLK2M2 | |
7741 | INSYMBOL | |
7742 | IFSYNOT;IDENT;JMP I BLK1 | |
7743 | LOCATE | |
7744 | DCA J | |
7745 | INSYMBOL | |
7746 | TAD J | |
7747 | SNA CLA | |
7748 | JMP BLO2 | |
7749 | OFTAB;OBJ | |
7750 | BSW | |
7751 | AND [77 | |
7752 | TAD [-2 /2=TYPE1 | |
7753 | SNA CLA | |
7754 | JMP .+4 | |
7755 | ERROR;35 /29 | |
7756 | JMP BLO2 | |
7757 | OFTAB;TYP | |
7758 | AND [77 | |
7759 | DCA TEMP | |
7760 | TAD TEMP | |
7761 | TAD [-4 | |
7762 | SPA SNA CLA | |
7763 | JMP .+4 | |
7764 | ERROR;17 /15 | |
7765 | JMP BLO2 | |
7766 | TAD PRT | |
7767 | DCA J | |
7768 | L0003 /3=PROZEDURE | |
7769 | TAD ISFUN | |
7770 | BSW | |
7771 | TAD TEMP | |
7772 | TOTAB;TYP | |
7773 | JMP BLO2 | |
7774 | BLO1, SKIP;FSYS+SET20;2 /2 | |
7775 | JMP BLO2 | |
7776 | ERROR;5 /5 | |
7777 | BLO2, IFSY;SEMICOLON;JMP .+4 | |
7778 | ERROR;16 /14 | |
7779 | SKP | |
7780 | INSYMBOL | |
7781 | BLO3, IFSY;CONSTSY;PUSHJUMP;CONDECL | |
7782 | IFSY;TYPESY;PUSHJUMP;TYPDECL | |
7783 | IFSY;VARSY;PUSHJUMP;VARDECL | |
7784 | TAD PRB | |
7785 | DCA JB | |
7786 | TAD DX | |
7787 | TOBTAB;VSIZE | |
7788 | BLO4, SKIPIFSYIN;SET42 | |
7789 | JMP .+4 | |
7790 | PUSHJUMP;PRODECL | |
7791 | JMP BLO4 | |
7792 | TEST;SET43;SET44;70 /56 | |
7793 | SKIPIFSYIN;STATBGS | |
7794 | JMP BLO3 | |
7795 | TAD PRT | |
7796 | DCA J | |
7797 | TAD LC | |
7798 | TOTAB;ADR | |
7799 | BLO5, INSYMBOL | |
7800 | PUSHJUMP;STATEMENT | |
7801 | FSYS+SET30 | |
7802 | SKIPIFSYIN;SET31 | |
7803 | JMP BLO6 | |
7804 | IFSY;SEMICOLON;JMP BLO5 | |
7805 | ERROR;16 /14 | |
7806 | JMP BLO5+1 | |
7807 | BLO6, IFSY;ENDSY;JMP .+4 | |
7808 | ERROR;71 /57 | |
7809 | SKP | |
7810 | INSYMBOL | |
7811 | TEST;FSYS+SET45;SET0;6 /6 | |
7812 | POPJUMP;BLOCK | |
7813 | ||
7814 | PAGE | |
7815 | \f/M A C R O - I N S T R U C T I O N S : | |
7816 | ||
7817 | ||
7818 | /P U S H J U M P /RECURSIVE CALL OF COMPILER PROCEDURES | |
7819 | /CALL: PUSHJUMP;NAME | |
7820 | /P O P J U M P /RETURN FROM PROCEDURE | |
7821 | /CALL: POPJUMP;NAME | |
7822 | ||
7823 | ||
7824 | /LOCAL, 0 /START OF LOCAL VARIABLES - 1 | |
7825 | /LENGTH, 0 / - NO. OF LOC'S TO PUSH (EXCL. FSYS) | |
7826 | /PARAM, 0 /NO. OF PARAMETERS + 4000 (IF 1ST ONE IS A SET) | |
7827 | PSTART, 0 /STARTING ADDRESS OF PROCEDURE | |
7828 | ||
7829 | PPP, 0 /STACK POINTER (POINTS ALWAYS TO 1ST FREE LOC.) | |
7830 | ||
7831 | ||
7832 | CONTROL,0 | |
7833 | CLL RTL | |
7834 | TAD (PUSHTABLE-1 | |
7835 | DCA XR10 | |
7836 | CDF SETFIELD | |
7837 | TAD I XR10 | |
7838 | DCA LOCAL | |
7839 | TAD I XR10 | |
7840 | DCA LENGTH | |
7841 | TAD I XR10 | |
7842 | DCA PARAM | |
7843 | TAD I XR10 | |
7844 | DCA PSTART | |
7845 | CDF COMPFIELD | |
7846 | JMP I CONTROL | |
7847 | ||
7848 | PUSH, 0 | |
7849 | CDF PUSHFIELD | |
7850 | DCA I PPP | |
7851 | CDF COMPFIELD | |
7852 | ISZ PPP | |
7853 | JMP I PUSH | |
7854 | FATAL8, FATAL /PROGRAMM TOO COMPLEX ---> STACK FULL! | |
7855 | ||
7856 | POP, 0 | |
7857 | L7777 | |
7858 | TAD PPP | |
7859 | DCA PPP | |
7860 | CDF PUSHFIELD | |
7861 | TAD I PPP | |
7862 | CDF COMPFIELD | |
7863 | JMP I POP | |
7864 | ||
7865 | XPUSHJ, 0 | |
7866 | TAD I XPUSHJ | |
7867 | ISZ XPUSHJ | |
7868 | JMS CONTROL | |
7869 | TAD LENGTH | |
7870 | SNA CLA | |
7871 | JMP PUFSYS | |
7872 | TAD LOCAL | |
7873 | DCA XR10 | |
7874 | TAD I XR10 | |
7875 | JMS PUSH /PUSH LOCAL VARIABLES (IF ANY) | |
7876 | ISZ LENGTH | |
7877 | JMP .-3 | |
7878 | PUFSYS, TAD PARAM | |
7879 | SMA CLA | |
7880 | JMP GETPAR | |
7881 | L3777 /FSYS-1 | |
7882 | DCA XR10 | |
7883 | TAD [-5 | |
7884 | DCA LENGTH | |
7885 | CDF SETFIELD | |
7886 | TAD I XR10 | |
7887 | JMS PUSH /PUSH FSYS (IF NECESSARY) | |
7888 | ISZ LENGTH | |
7889 | JMP .-4 | |
7890 | GEFSYS, L4000 /GET SET-ARGUMENT (IF PRESENT) | |
7891 | DCA SETA | |
7892 | TAD I XPUSHJ | |
7893 | SPA | |
7894 | DCA SETA /<0: FSYS OR SETX ONLY | |
7895 | TAD SETA />0: FSYS+SETX | |
7896 | DCA SETB | |
7897 | ISZ XPUSHJ | |
7898 | UNION | |
7899 | SETA, FSYS | |
7900 | SETB, SET0 | |
7901 | FSYS | |
7902 | GETPAR, TAD PARAM /GET PARAMETERS | |
7903 | AND [77 | |
7904 | SNA | |
7905 | JMP RECALL | |
7906 | CIA | |
7907 | DCA LENGTH | |
7908 | TAD LOCAL | |
7909 | DCA XR10 | |
7910 | TAD I XPUSHJ | |
7911 | ISZ XPUSHJ | |
7912 | DCA I XR10 | |
7913 | ISZ LENGTH | |
7914 | JMP .-4 | |
7915 | JMS VARIN /PASS VAR-PARAMETERS (IF ANY) | |
7916 | RECALL, TAD XPUSHJ | |
7917 | JMS PUSH /PUSH RETURN ADDRESS | |
7918 | JMP I PSTART /AND J U M P TO PROCEDURE | |
7919 | ||
7920 | XPOPJUMP,0 | |
7921 | TAD I XPOPJUMP | |
7922 | JMS CONTROL | |
7923 | JMS POP /GET RETURN ADDRESS | |
7924 | DCA PSTART | |
7925 | TAD PARAM | |
7926 | SMA CLA | |
7927 | JMP POVAR | |
7928 | TAD (FSYS+4 | |
7929 | DCA PUSH /(MIS)USE THIS FREE LOC. | |
7930 | TAD [-5 | |
7931 | DCA CONTROL | |
7932 | JMS POP /POP FSYS (IF IT WAS PUSHED) | |
7933 | CDF SETFIELD | |
7934 | DCA I PUSH | |
7935 | L7777 | |
7936 | TAD PUSH | |
7937 | DCA PUSH | |
7938 | ISZ CONTROL | |
7939 | JMP .-7 | |
7940 | CDF COMPFIELD | |
7941 | POVAR, JMS VARTM /TEMP. STORE VAR-PARAMETERS | |
7942 | TAD LENGTH | |
7943 | SNA | |
7944 | JMP I PSTART | |
7945 | CIA | |
7946 | TAD LOCAL | |
7947 | DCA PUSH | |
7948 | JMS POP /POP LOCAL VARIABLES (IF ANY) | |
7949 | DCA I PUSH | |
7950 | L7777 | |
7951 | TAD PUSH | |
7952 | DCA PUSH | |
7953 | ISZ LENGTH | |
7954 | JMP .-6 | |
7955 | JMS VAREX /PASS VAR-PARAMETERS (IF ANY) | |
7956 | JMP I PSTART /R E T U R N | |
7957 | ||
7958 | PAGE | |
7959 | \f/M A C R O - I N S T R U C T I O N S : | |
7960 | ||
7961 | ||
7962 | /O F D I S P L A Y /AC := DISPLAY[LEVEL] | |
7963 | ||
7964 | /T O D I S P L A Y /DISPLAY[LEVEL] := AC | |
7965 | ||
7966 | /O F T A B /AC := TAB[AC].SEL, IF AC=0 GET TAB[J].SEL | |
7967 | ||
7968 | /T O T A B /TAB[J].SEL := AC | |
7969 | ||
7970 | /O F A T A B /AC := ATAB[AC].SEL, IF AC=0 GET ATAB[JA].SEL | |
7971 | ||
7972 | /T O A T A B /ATAB[JA].SEL := AC | |
7973 | ||
7974 | /O F B T A B /AC := BTAB[AC].SEL, IF AC=0 GET BTAB[JB].SEL | |
7975 | ||
7976 | /T O B T A B /BTAB[JB].SEL := AC | |
7977 | ||
7978 | /W I T H T A B D O /GET AND UNPACK TAB[AC] OR TAB[J] | |
7979 | ||
7980 | /E N D W I T H /PACK AND STORE UNPACKED ENTRY OF TAB | |
7981 | ||
7982 | XOFDISP,0 | |
7983 | TAD (DISPLAY | |
7984 | TAD LEVEL | |
7985 | DCA QQ | |
7986 | TAD I QQ | |
7987 | JMP I XOFDISP | |
7988 | ||
7989 | XTODISP,0 | |
7990 | MQL | |
7991 | TAD (DISPLAY | |
7992 | TAD LEVEL | |
7993 | DCA QQ | |
7994 | MQA | |
7995 | DCA I QQ | |
7996 | JMP I XTODISP | |
7997 | ||
7998 | XOFTAB, 0 | |
7999 | SNA | |
8000 | TAD J | |
8001 | CLL RTL | |
8002 | TAD I XOFTAB | |
8003 | DCA QQ | |
8004 | ISZ XOFTAB | |
8005 | CDF TABLEFIELD | |
8006 | TAD I QQ | |
8007 | CDF COMPFIELD | |
8008 | JMP I XOFTAB | |
8009 | ||
8010 | XTOTAB, 0 | |
8011 | MQL | |
8012 | TAD J | |
8013 | CLL RTL | |
8014 | TAD I XTOTAB | |
8015 | DCA QQ | |
8016 | ISZ XTOTAB | |
8017 | CDF TABLEFIELD | |
8018 | MQA | |
8019 | DCA I QQ | |
8020 | CDF COMPFIELD | |
8021 | JMP I XTOTAB | |
8022 | ||
8023 | XOFATAB,0 | |
8024 | SNA | |
8025 | TAD JA | |
8026 | CLL RAL | |
8027 | CLL RTL | |
8028 | TAD I XOFATAB | |
8029 | DCA QQ | |
8030 | ISZ XOFATAB | |
8031 | CDF TABLEFIELD | |
8032 | TAD I QQ | |
8033 | CDF COMPFIELD | |
8034 | JMP I XOFATAB | |
8035 | ||
8036 | QQ=. | |
8037 | XTOATAB,0 | |
8038 | MQL | |
8039 | TAD XTOATAB | |
8040 | DCA XTOTAB | |
8041 | TAD JA | |
8042 | CLL RAL | |
8043 | JMP XTOTAB+3 | |
8044 | ||
8045 | XOFBTAB,0 | |
8046 | SNA | |
8047 | TAD JB | |
8048 | CLL RTL | |
8049 | TAD I XOFBTAB | |
8050 | DCA QQ | |
8051 | ISZ XOFBTAB | |
8052 | CDF TABLEFIELD | |
8053 | TAD I QQ | |
8054 | CDF COMPFIELD | |
8055 | JMP I XOFBTAB | |
8056 | ||
8057 | XTOBTAB,0 | |
8058 | MQL | |
8059 | TAD XTOBTAB | |
8060 | DCA XTOTAB | |
8061 | TAD JB | |
8062 | JMP XTOTAB+3 | |
8063 | ||
8064 | XWITHTAB,0 | |
8065 | SNA | |
8066 | TAD J | |
8067 | CLL RTL | |
8068 | DCA JW /SYMBOL TABLE STARTS AT 0000 ! | |
8069 | TAD JW | |
8070 | DCA XR10 | |
8071 | CDF TABLEFIELD | |
8072 | TAD I JW | |
8073 | DCA LINK0 | |
8074 | TAD I XR10 | |
8075 | MQL | |
8076 | MQA | |
8077 | BSW | |
8078 | AND [77 | |
8079 | DCA OBJ0 | |
8080 | MQA | |
8081 | AND [77 | |
8082 | DCA TYP0 | |
8083 | TAD I XR10 | |
8084 | MQL | |
8085 | MQA | |
8086 | BSW | |
8087 | AND [77 | |
8088 | DCA REF0 | |
8089 | MQA | |
8090 | AND [40 | |
8091 | DCA NORM0 | |
8092 | MQA | |
8093 | AND [17 | |
8094 | DCA LEV0 | |
8095 | TAD I XR10 | |
8096 | DCA ADR0 | |
8097 | CDF COMPFIELD | |
8098 | JMP I XWITHTAB | |
8099 | ||
8100 | XENDWITH,0 | |
8101 | TAD JW | |
8102 | DCA XR10 | |
8103 | CDF TABLEFIELD | |
8104 | TAD LINK0 | |
8105 | DCA I JW | |
8106 | TAD OBJ0 | |
8107 | BSW | |
8108 | TAD TYP0 | |
8109 | DCA I XR10 | |
8110 | TAD REF0 | |
8111 | BSW | |
8112 | TAD NORM0 | |
8113 | TAD LEV0 | |
8114 | DCA I XR10 | |
8115 | TAD ADR0 | |
8116 | DCA I XR10 | |
8117 | CDF COMPFIELD | |
8118 | JMP I XENDWITH | |
8119 | ||
8120 | PAGE | |
8121 | \f/M A C R O - I N S T R U C T I O N S : | |
8122 | ||
8123 | /W I T H A T A B D O /GET AND UNPACK ATAB[JA] | |
8124 | ||
8125 | /E N D A W I T H /PACK AND STORE UNPACKED ENTRY OF ATAB | |
8126 | ||
8127 | /E M I T /EMIT INTERMEDIATE CODE (F,IRX,IRY) | |
8128 | /CALL: EMIT;F | |
8129 | ||
8130 | /T O C O D E /CODE[AC].IRY := LC | |
8131 | ||
8132 | /E N T E R C O N S T A N T /ENTER REAL OR INTEGER INTO CONSTANT TABLE | |
8133 | /CALL: ENTERCONSTANT;ADDRESS-1 | |
8134 | ||
8135 | ||
8136 | XWITHATAB,0 | |
8137 | TAD JA | |
8138 | CLL RAL | |
8139 | CLL RTL | |
8140 | TAD (ATAB | |
8141 | DCA JAW | |
8142 | TAD JAW | |
8143 | DCA XR10 | |
8144 | TAD [-7 | |
8145 | DCA QR | |
8146 | TAD (DCA INXTP0 | |
8147 | DCA .+3 | |
8148 | CDF TABLEFIELD | |
8149 | TAD I XR10 | |
8150 | 0000 /DCA INXTP0 (MODIFIED INSTR.!) | |
8151 | ISZ .-1 | |
8152 | ISZ QR | |
8153 | JMP .-4 | |
8154 | CDF COMPFIELD | |
8155 | JMP I XWITHATAB | |
8156 | ||
8157 | XENDAW, 0 | |
8158 | TAD JAW | |
8159 | DCA XR10 | |
8160 | TAD [-7 | |
8161 | DCA QR | |
8162 | TAD (TAD INXTP0 | |
8163 | DCA .+2 | |
8164 | CDF TABLEFIELD | |
8165 | 0000 /TAD INXTP0 (MODIFIED INSTR.!) | |
8166 | DCA I XR10 | |
8167 | ISZ .-2 | |
8168 | ISZ QR | |
8169 | JMP .-4 | |
8170 | CDF COMPFIELD | |
8171 | JMP I XENDAW | |
8172 | ||
8173 | XEMIT, 0 | |
8174 | TAD LC | |
8175 | CLL RAL | |
8176 | DCA XTOCODE | |
8177 | TAD I XEMIT /GET OP-CODE | |
8178 | BSW | |
8179 | TAD IRX | |
8180 | CDF CODEFIELD | |
8181 | DCA I XTOCODE | |
8182 | ISZ XTOCODE | |
8183 | TAD IRY | |
8184 | DCA I XTOCODE | |
8185 | CDF COMPFIELD | |
8186 | ISZ LC | |
8187 | TAD LC | |
8188 | TAD (-CMAX | |
8189 | SMA SZA CLA | |
8190 | FATAL6, FATAL /PROGRAM TOO LONG! | |
8191 | DCA IRX | |
8192 | DCA IRY | |
8193 | JMP I XEMIT | |
8194 | ||
8195 | QR=. | |
8196 | XTOCODE,0 | |
8197 | STL RAL | |
8198 | DCA XEMIT | |
8199 | CDF CODEFIELD | |
8200 | TAD LC | |
8201 | DCA I XEMIT | |
8202 | CDF COMPFIELD | |
8203 | JMP I XTOCODE | |
8204 | ||
8205 | CENTRY=XWITHATAB | |
8206 | CTEMP=XENDAW | |
8207 | FOUR=XEMIT | |
8208 | ||
8209 | XENTCON,0 | |
8210 | TAD I XENTCON | |
8211 | DCA XR10 | |
8212 | ISZ XENTCON | |
8213 | TAD C | |
8214 | TAD [-4 | |
8215 | DCA CENTRY | |
8216 | TAD SX | |
8217 | STL RAR | |
8218 | CIA | |
8219 | TAD CENTRY | |
8220 | SPA CLA | |
8221 | FATAL3, FATAL /TOO MUCH CONSTANTS! | |
8222 | TAD [-4 | |
8223 | DCA FOUR | |
8224 | TAD CENTRY | |
8225 | DCA XR12 | |
8226 | TAD I XR10 | |
8227 | CDF TABLEFIELD | |
8228 | DCA I XR12 | |
8229 | CDF COMPFIELD | |
8230 | ISZ FOUR | |
8231 | JMP .-5 | |
8232 | TAD CENTRY | |
8233 | DCA CTEMP | |
8234 | CDF TABLEFIELD | |
8235 | SEARCH, L0004 | |
8236 | TAD CTEMP | |
8237 | DCA CTEMP | |
8238 | TAD CTEMP | |
8239 | TAD (-ATAB+1 | |
8240 | SMA CLA | |
8241 | JMP NOTFOUND | |
8242 | TAD [-4 | |
8243 | DCA FOUR | |
8244 | TAD CENTRY | |
8245 | DCA XR10 | |
8246 | TAD CTEMP | |
8247 | DCA XR12 | |
8248 | TAD I XR10 | |
8249 | CIA | |
8250 | TAD I XR12 | |
8251 | SZA CLA | |
8252 | JMP SEARCH | |
8253 | ISZ FOUR | |
8254 | JMP .-6 | |
8255 | TAD CTEMP /FOUND | |
8256 | JMP .+4 | |
8257 | NOTFOUND,TAD CENTRY | |
8258 | DCA C | |
8259 | TAD CENTRY | |
8260 | CDF COMPFIELD | |
8261 | JMP I XENTCON | |
8262 | ||
8263 | PAGE | |
8264 | \f/M A C R O - I N S T R U C T I O N S : | |
8265 | ||
8266 | ||
8267 | /E N T E R /ENTER OBJEJT INTO SYMBOL TABLE | |
8268 | /CALL: ENTER;OBJ | |
8269 | ||
8270 | /E N T E R V A R I A B L E | |
8271 | ||
8272 | /E N T E R B L O C K | |
8273 | ||
8274 | /E N T E R A R R A Y | |
8275 | ||
8276 | /S I G N E D I N T E G E R /MAKE 12-BIT SIGNED INTEGER OF CONSTANT | |
8277 | /CALL: SIGNEDINTEGER;ADDRESS-1 | |
8278 | ||
8279 | ||
8280 | XENTER, 0 | |
8281 | TAD T | |
8282 | TAD (-TMAX | |
8283 | SMA CLA | |
8284 | FATAL1, FATAL /SYMBOL TABLE FULL! | |
8285 | JMS ENTID | |
8286 | OFDISPLAY | |
8287 | OFBTAB;LAST | |
8288 | DCA J | |
8289 | TAD J | |
8290 | DCA L | |
8291 | JMS CHKID | |
8292 | JMP .+5 | |
8293 | OFTAB;LINK | |
8294 | DCA J | |
8295 | JMP .-5 | |
8296 | TAD J | |
8297 | SNA CLA | |
8298 | JMP .+4 | |
8299 | ERROR;1 /1 | |
8300 | JMP I XENTER | |
8301 | ISZ T | |
8302 | TAD T | |
8303 | JMS ENTID | |
8304 | TAD I XENTER | |
8305 | MQL | |
8306 | L3777 | |
8307 | TAD T | |
8308 | STL RTL /4*T - 1 | |
8309 | DCA XR10 | |
8310 | CDF TABLEFIELD | |
8311 | TAD L /LINK | |
8312 | DCA I XR10 | |
8313 | MQA | |
8314 | BSW /OBJ, TYP (0=NOTYP) | |
8315 | DCA I XR10 | |
8316 | TAD LEVEL /REF=0, NORMAL=0, LEVEL | |
8317 | DCA I XR10 | |
8318 | DCA I XR10 /ADR=0 | |
8319 | CDF COMPFIELD | |
8320 | OFDISPLAY | |
8321 | DCA JB | |
8322 | TAD T | |
8323 | TOBTAB;LAST | |
8324 | JMP I XENTER | |
8325 | ||
8326 | XENTVAR,0 | |
8327 | IFSY;IDENT;JMP .+4 | |
8328 | ERROR;2 /2 | |
8329 | JMP I XENTVAR | |
8330 | ENTER;VARIABLE | |
8331 | INSYMBOL | |
8332 | JMP I XENTVAR | |
8333 | ||
8334 | XENTBLO,0 | |
8335 | TAD B | |
8336 | TAD (-BMAX | |
8337 | SMA CLA | |
8338 | FATAL2, FATAL /TOO MUCH BLOCKS! | |
8339 | ISZ B | |
8340 | TAD B | |
8341 | DCA JB | |
8342 | TOBTAB;LAST | |
8343 | TOBTAB;LASTPAR | |
8344 | JMP I XENTBLO | |
8345 | ||
8346 | ATP=XENTBLO | |
8347 | XENTARR,0 | |
8348 | DCA ATP | |
8349 | TAD LO | |
8350 | CIA | |
8351 | TAD HI | |
8352 | SPA CLA | |
8353 | ERROR;33 /27 | |
8354 | TAD A | |
8355 | TAD (-AMAX | |
8356 | SMA CLA | |
8357 | FATAL4, FATAL | |
8358 | ISZ A | |
8359 | TAD A | |
8360 | DCA JA | |
8361 | TAD ATP | |
8362 | TOATAB;INXTYP | |
8363 | TAD LO | |
8364 | TOATAB;LOW | |
8365 | TAD HI | |
8366 | TOATAB;HIGH | |
8367 | JMP I XENTARR | |
8368 | ||
8369 | XSGNINT,0 | |
8370 | L0001 /LINK=0! | |
8371 | TAD I XSGNINT | |
8372 | ISZ XSGNINT | |
8373 | DCA XR10 | |
8374 | TAD I XR10 | |
8375 | SZA | |
8376 | TAD [4000 /LINK=1? ---> NEGATIVE | |
8377 | SZA CLA | |
8378 | JMP ERR49 | |
8379 | TAD I XR10 | |
8380 | SZA CLA | |
8381 | JMP ERR49 | |
8382 | TAD I XR10 | |
8383 | SPA | |
8384 | JMP ERR49 | |
8385 | SZL | |
8386 | CIA | |
8387 | JMP I XSGNINT | |
8388 | ERR49, ERROR;61 /49 | |
8389 | JMP I XSGNINT | |
8390 | ||
8391 | PAGE | |
8392 | \f/-------- D I S P L A Y --------/ | |
8393 | / | |
8394 | *7400 | |
8395 | IFNZRO DISPLAY-. <PARALLEL DEFINED IN FIELD 0 AND FIELD 4 !!!> | |
8396 | 1 /DISPLAY[0] := 1 | |
8397 | ZBLOCK 17 | |
8398 | ||
8399 | /---------------------------------/ | |
8400 | ||
8401 | ||
8402 | /M A C R O - I N S T R U C T I O N S : | |
8403 | ||
8404 | ||
8405 | /L O C A T E /LOCATE IDENTIFIER IN SYMBOL TABLE | |
8406 | /EXITS WITH TABLE INDEX IN AC | |
8407 | ||
8408 | /E N T I D /TAB[AC].NAME := ID | |
8409 | ||
8410 | /C H K I D /SKIP IF TAB[J].NAME <> ID | |
8411 | ||
8412 | /G E T C O N S T A N T /NUM := CTAB[AC] | |
8413 | ||
8414 | ||
8415 | XLOCATE,0 | |
8416 | TAD LEVEL | |
8417 | DCA L | |
8418 | JMS ENTID | |
8419 | NSCOPE, TAD L | |
8420 | TAD (TAD DISPLAY | |
8421 | DCA .+1 | |
8422 | 0000 /TAD DISPLAY (MODIFIED INSTR.!) | |
8423 | OFBTAB;LAST | |
8424 | DCA J | |
8425 | JMS CHKID | |
8426 | JMP .+5 | |
8427 | OFTAB;LINK | |
8428 | DCA J | |
8429 | JMP .-5 | |
8430 | L7777 | |
8431 | TAD L | |
8432 | DCA L | |
8433 | TAD J | |
8434 | SZA | |
8435 | JMP I XLOCATE | |
8436 | TAD L | |
8437 | SMA CLA | |
8438 | JMP NSCOPE | |
8439 | ERROR;0 0 | |
8440 | JMP I XLOCATE | |
8441 | ||
8442 | ENTID, 0 | |
8443 | CLL RTL | |
8444 | TAD (-1 | |
8445 | DCA XR10 | |
8446 | CDF NAMEFIELD | |
8447 | TAD ID | |
8448 | DCA I XR10 | |
8449 | TAD ID+1 | |
8450 | DCA I XR10 | |
8451 | TAD ID+2 | |
8452 | DCA I XR10 | |
8453 | TAD ID+3 | |
8454 | DCA I XR10 | |
8455 | CDF COMPFIELD | |
8456 | JMP I ENTID | |
8457 | ||
8458 | CHKID, 0 | |
8459 | TAD J | |
8460 | CLL RTL | |
8461 | TAD (-1 | |
8462 | DCA XR10 | |
8463 | CDF NAMEFIELD | |
8464 | TAD I XR10 | |
8465 | CIA | |
8466 | TAD ID | |
8467 | SZA CLA | |
8468 | JMP NOTEQL | |
8469 | TAD I XR10 | |
8470 | CIA | |
8471 | TAD ID+1 | |
8472 | SZA CLA | |
8473 | JMP NOTEQL | |
8474 | TAD I XR10 | |
8475 | CIA | |
8476 | TAD ID+2 | |
8477 | SZA CLA | |
8478 | JMP NOTEQL | |
8479 | TAD I XR10 | |
8480 | CIA | |
8481 | TAD ID+3 | |
8482 | SZA CLA | |
8483 | NOTEQL, ISZ CHKID | |
8484 | CDF COMPFIELD | |
8485 | JMP I CHKID | |
8486 | ||
8487 | XOFCONST,0 | |
8488 | DCA XR10 | |
8489 | CDF TABLEFIELD | |
8490 | TAD I XR10 | |
8491 | DCA NUM | |
8492 | TAD I XR10 | |
8493 | DCA NUM+1 | |
8494 | TAD I XR10 | |
8495 | DCA NUM+2 | |
8496 | TAD I XR10 | |
8497 | DCA NUM+3 | |
8498 | CDF COMPFIELD | |
8499 | JMP I XOFCONST | |
8500 | ||
8501 | XERROR, 0 | |
8502 | CLA CLL | |
8503 | TAD I XERROR | |
8504 | CIF SETFIELD | |
8505 | JMS I (F3ERROR | |
8506 | JMP I XERROR | |
8507 | ||
8508 | XFATAL, 0 | |
8509 | TAD XFATAL | |
8510 | CDF CIF SETFIELD | |
8511 | JMP I (F3FATAL | |
8512 | ||
8513 | XINSYMBOL,0 | |
8514 | CDF CIF 0 | |
8515 | JMP I (INSY0 | |
8516 | EXSY3, DCA SY | |
8517 | JMP I XINSYMBOL | |
8518 | ||
8519 | PAGE | |
8520 | \f/M A C R O - I N S T R U C T I O N S : | |
8521 | ||
8522 | ||
8523 | /T E S T S E M I C O L O N | |
8524 | ||
8525 | /S K I P /CALL: SKIP;SETX;N | |
8526 | ||
8527 | /T E S T /CALL: TEST;SETX;SETY;N | |
8528 | ||
8529 | /S K I P I F S Y I N /CALL: SKIPIFSYIN;SETX | |
8530 | ||
8531 | /I F S Y /CALL: IFSY;SYMBOL | |
8532 | ||
8533 | /I F S Y N O T /CALL: IFSYNOT;SYMBOL | |
8534 | ||
8535 | /U N I O N /CALL: UNION;SET1;SET2;S1US2 | |
8536 | ||
8537 | XTSTSEM,0 | |
8538 | IFSY;SEMICOLON;JMP .+6 | |
8539 | ERROR;16 /14 | |
8540 | SKIPIFSYIN;SET6 | |
8541 | SKP | |
8542 | INSYMBOL | |
8543 | TEST;SET7;FSYS;6 /6 | |
8544 | JMP I XTSTSEM | |
8545 | ||
8546 | XSKIP, 0 | |
8547 | TAD I XSKIP | |
8548 | JMS FSYSUSETX | |
8549 | DCA .+11 | |
8550 | ISZ XSKIP | |
8551 | TAD I XSKIP | |
8552 | DCA .+2 | |
8553 | ERROR;00 /N | |
8554 | SKP | |
8555 | INSYMBOL | |
8556 | SKIPIFSYIN;00 | |
8557 | JMP .-3 | |
8558 | JMP I XSKIP | |
8559 | ||
8560 | XTEST, 0 | |
8561 | TAD I XTEST | |
8562 | JMS FSYSUSETX | |
8563 | DCA .+3 | |
8564 | ISZ XTEST | |
8565 | SKIPIFSYIN;00 | |
8566 | SKP | |
8567 | JMP XTST1 | |
8568 | TAD .-3 | |
8569 | DCA S1 | |
8570 | TAD I XTEST | |
8571 | JMS FSYSUSETX | |
8572 | DCA S2 | |
8573 | ISZ XTEST | |
8574 | UNION | |
8575 | S1, 0 | |
8576 | S2, 0 | |
8577 | S1US2 | |
8578 | TAD I XTEST | |
8579 | DCA .+3 | |
8580 | SKIP;S1US2;00 /N | |
8581 | XTST1, ISZ XTEST | |
8582 | JMP I XTEST | |
8583 | ||
8584 | FSYSUSETX, 0 | |
8585 | SPA | |
8586 | JMP I FSYSUSETX | |
8587 | TAD [4000 | |
8588 | DCA .+3 | |
8589 | UNION | |
8590 | FSYS | |
8591 | 0 | |
8592 | S1US2 | |
8593 | TAD .-1 | |
8594 | JMP I FSYSUSETX | |
8595 | ||
8596 | INSET, 0 | |
8597 | TAD SY | |
8598 | CLL RAL | |
8599 | TAD (SETTABLE | |
8600 | DCA S2 | |
8601 | TAD I INSET | |
8602 | ISZ INSET | |
8603 | CDF SETFIELD | |
8604 | TAD I S2 | |
8605 | DCA S1 /ADDRESS OF RELATIVE SET WORD | |
8606 | ISZ S2 /ADDRESS OF BIT POS. REL. TO SY | |
8607 | TAD I S1 | |
8608 | AND I S2 | |
8609 | SZA CLA | |
8610 | ISZ INSET | |
8611 | CDF COMPFIELD | |
8612 | JMP I INSET | |
8613 | ||
8614 | XIFSY, 0 | |
8615 | TAD SY | |
8616 | CIA | |
8617 | TAD I XIFSY | |
8618 | SZA CLA | |
8619 | ISZ XIFSY | |
8620 | ISZ XIFSY | |
8621 | JMP I XIFSY | |
8622 | ||
8623 | XIFSYNOT,0 | |
8624 | TAD SY | |
8625 | CIA | |
8626 | TAD I XIFSYNOT | |
8627 | SNA CLA | |
8628 | ISZ XIFSYNOT | |
8629 | ISZ XIFSYNOT | |
8630 | JMP I XIFSYNOT | |
8631 | ||
8632 | XSA=XIFSY /NORMAL LOC. | |
8633 | XSB=XR10 /AUTO INDEX | |
8634 | XSU=XR12 / - " - | |
8635 | FIVE=XIFSYNOT | |
8636 | ||
8637 | XUNION, 0 | |
8638 | TAD I XUNION | |
8639 | DCA XSA | |
8640 | ISZ XUNION | |
8641 | L7777 | |
8642 | TAD I XUNION | |
8643 | DCA XSB | |
8644 | ISZ XUNION | |
8645 | L7777 | |
8646 | TAD I XUNION | |
8647 | DCA XSU | |
8648 | ISZ XUNION | |
8649 | TAD [-5 | |
8650 | DCA FIVE | |
8651 | CDF SETFIELD | |
8652 | TAD I XSA | |
8653 | CMA | |
8654 | AND I XSB | |
8655 | TAD I XSA | |
8656 | DCA I XSU | |
8657 | ISZ XSA | |
8658 | ISZ FIVE | |
8659 | JMP .-7 | |
8660 | CDF COMPFIELD | |
8661 | JMP I XUNION | |
8662 | ||
8663 | PAGE | |
8664 | \f/L O N G E R R O R M E S S A G E S | |
8665 | ||
8666 | FIELD 6 | |
8667 | *0 | |
8668 | ||
8669 | ZBLOCK 73 /ERROR COUNTERS | |
8670 | 7777 /GUARD | |
8671 | ERRSUM, 0 /NUMBER OF DETECTED ERRORS | |
8672 | ||
8673 | *100 /ADDRESS LIST OF ERROR MESSAGES | |
8674 | E00 | |
8675 | E01 | |
8676 | E02 | |
8677 | E03 | |
8678 | E04 | |
8679 | E05 | |
8680 | E06 | |
8681 | E07 | |
8682 | E08 | |
8683 | E09 | |
8684 | E10 | |
8685 | E11 | |
8686 | E12 | |
8687 | E13 | |
8688 | E14 | |
8689 | E15 | |
8690 | E16 | |
8691 | E17 | |
8692 | E18 | |
8693 | E19 | |
8694 | E20 | |
8695 | E21 | |
8696 | E22 | |
8697 | E23 | |
8698 | E24 | |
8699 | E25 | |
8700 | E26 | |
8701 | E27 | |
8702 | E28 | |
8703 | E29 | |
8704 | E30 | |
8705 | E31 | |
8706 | E32 | |
8707 | E33 | |
8708 | E34 | |
8709 | E35 | |
8710 | E36 | |
8711 | E37 | |
8712 | E38 | |
8713 | E39 | |
8714 | E40 | |
8715 | E41 | |
8716 | E42 | |
8717 | E43 | |
8718 | E44 | |
8719 | E45 | |
8720 | E46 | |
8721 | E47 | |
8722 | E48 | |
8723 | E49 | |
8724 | E50 | |
8725 | E51 | |
8726 | E52 | |
8727 | E53 | |
8728 | E54 | |
8729 | E55 | |
8730 | E56 | |
8731 | E57 | |
8732 | E58 | |
8733 | ||
8734 | *200 | |
8735 | EXPLAIN,CLA CLL | |
8736 | TAD ERRSUM | |
8737 | SNA CLA | |
8738 | JMP EXCOMP | |
8739 | JMS ECRLF | |
8740 | JMS ECRLF | |
8741 | TAD (EHEAD | |
8742 | DCA ETEXT | |
8743 | JMS EMESG | |
8744 | JMS ECRLF | |
8745 | JMS ECRLF | |
8746 | DCA ENN | |
8747 | SKP | |
8748 | ELINE, ISZ ENN | |
8749 | TAD I ENN | |
8750 | SPA | |
8751 | JMP EXOS8 | |
8752 | SNA CLA /SKP CLA ---> PRINT ALL! | |
8753 | JMP ELINE | |
8754 | CLA IAC BSW /L0100 | |
8755 | TAD ENN | |
8756 | DCA ETEXT | |
8757 | TAD I ETEXT | |
8758 | DCA ETEXT | |
8759 | JMS EMESG | |
8760 | JMS ECRLF | |
8761 | JMP ELINE | |
8762 | ||
8763 | FXPLAIN,CLA CLL | |
8764 | TAD ERRSUM | |
8765 | SZA CLA | |
8766 | JMP EXPLAIN+5 | |
8767 | EXOS8, CLA CLL | |
8768 | JMS ECRLF | |
8769 | CDF CIF 0 | |
8770 | JMP I (7605 | |
8771 | ENN, 0 | |
8772 | ||
8773 | EXCOMP, JMS ECRLF | |
8774 | JMS ECRLF | |
8775 | TAD (EOKAY | |
8776 | DCA ETEXT | |
8777 | JMS EMESG | |
8778 | JMS ECRLF | |
8779 | JMS ECRLF | |
8780 | CDF CIF 60 | |
8781 | JMP I (INIT /INITIALIZE RUNTIME SYSTEM | |
8782 | ||
8783 | EPRINT, 0 | |
8784 | TLS | |
8785 | TSF | |
8786 | JMP .-1 | |
8787 | CLA CLL | |
8788 | JMP I EPRINT | |
8789 | ||
8790 | ECRLF, 0 | |
8791 | TAD (215 | |
8792 | JMS EPRINT | |
8793 | TAD (212 | |
8794 | JMS EPRINT | |
8795 | JMP I ECRLF | |
8796 | ||
8797 | EMESG, 0 | |
8798 | TAD I ETEXT | |
8799 | BSW | |
8800 | JMS EASCII | |
8801 | TAD I ETEXT | |
8802 | JMS EASCII | |
8803 | ISZ ETEXT | |
8804 | JMP EMESG+1 | |
8805 | ||
8806 | EASCII, 0 | |
8807 | AND (77 | |
8808 | SNA | |
8809 | JMP I EMESG | |
8810 | TAD (240 | |
8811 | AND (77 | |
8812 | TAD (240 | |
8813 | JMS EPRINT | |
8814 | JMP I EASCII | |
8815 | ETEXT, 0 | |
8816 | ||
8817 | EOKAY, TEXT /KOMPILATION EINWANDFREI!/ | |
8818 | ||
8819 | EHEAD, TEXT /ERKLAERUNG DER FEHLER:/ | |
8820 | ||
8821 | PAGE | |
8822 | ||
8823 | \f/L O N G E R R O R M E S S A G E S | |
8824 | / | |
8825 | /(MADE INVISIBLE BY 'XLIST' TO SAVE PAPER IN ASSEMBLY LISTING!) | |
8826 | ||
8827 | XLIST | |
8828 | ||
8829 | E00,TEXT / 0 DIESER NAME WURDE NICHT VEREINBART./ | |
8830 | E01,TEXT / 1 NAME IM GUELTIGKEITSBEREICH MEHRFACH VEREINBART./ | |
8831 | E02,TEXT / 2 NAME FEHLT!/ | |
8832 | E03,TEXT / 3 JEDES PROGRAMM MUSS MIT DEM WORTSYMBOL 'PROGRAM' BEGINNE/ | |
8833 | *.-1 | |
8834 | TEXT /N./ | |
8835 | E04,TEXT / 4 RUNDE RECHTSKLAMMER FEHLT (ECKIGE KLAMMER HIER FALSCH)./ | |
8836 | E05,TEXT / 5 DOPPELPUNKT FEHLT. IN VEREINBARUNGEN FOLGT DEM : EIN TYP/ | |
8837 | *.-1 | |
8838 | TEXT /NAME./ | |
8839 | E06,TEXT / 6 SYNTAXFEHLER! ANGEZEIGTES SYMBOL HIER NICHT KORREKT./ | |
8840 | E07,TEXT / 7 LISTE DER FORMALPARAMETER FEHLERHAFT (NAME ODER WORTSYMB/ | |
8841 | *.-1 | |
8842 | TEXT /OL 'VAR')./ | |
8843 | E08,TEXT / 8 DAS WORTSYMBOL 'OF' FEHLT./ | |
8844 | E09,TEXT / 9 RUNDE LINKSKLAMMER FEHLT (ECKIGE KLAMMER HIER FALSCH)./ | |
8845 | E10,TEXT /10 TYPVEREINBARUNG FEHLERHAFT (NAME, 'ARRAY' ODER 'RECORD')./ | |
8846 | E11,TEXT /11 ECKIGE LINKSKLAMMER FEHLT (RUNDE KLAMMER HIER FALSCH)./ | |
8847 | E12,TEXT /12 ECKIGE RECHTSKLAMMER FEHLT (RUNDE KLAMMER HIER FALSCH)./ | |
8848 | E13,TEXT /13 SYMBOL .. FEHLT (LEERZEICHEN ZWISCHEN DEN PUNKTEN UNZULA/ | |
8849 | *.-1 | |
8850 | TEXT /ESSIG)./ | |
8851 | E14,TEXT /14 STRICHPUNKT FEHLT!/ | |
8852 | E15,TEXT /15 FUNKTIONSWERT KANN NUR VOM TYP INTEGER, REAL, BOOLEAN OD/ | |
8853 | *.-1 | |
8854 | TEXT /ER CHAR SEIN./ | |
8855 | E16,TEXT /16 SYMBOL = FEHLT (IN VEREINBARUNGEN IST := UNZULAESSIG)./ | |
8856 | E17,TEXT /17 NACH 'IF', 'WHILE' ODER 'UNTIL' MUSS EIN BOOL'SCHER AUSD/ | |
8857 | *.-1 | |
8858 | TEXT /RUCK STEHEN./ | |
8859 | E18,TEXT /18 ZAEHLVARIABLE BEI 'FOR'-ANWEISUNG MUSS VOM TYP INTEGER, / | |
8860 | *.-1 | |
8861 | TEXT /CHAR ODER BOOLEAN SEIN./ | |
8862 | E19,TEXT /19 ANFANGSWERT, ENDWERT UND ZAEHLVARIABLE MUESSEN VOM GLEIC/ | |
8863 | *.-1 | |
8864 | TEXT /HEN TYP SEIN./ | |
8865 | E20,TEXT /20 DER STANDARDNAME 'OUTPUT' MUSS IM PROGRAMMKOPF GESCHRIEB/ | |
8866 | *.-1 | |
8867 | TEXT /EN WERDEN./ | |
8868 | E21,TEXT /21 ZAHL IST ZU GROSS! (MAXINT=34359738367, REALS ABS. KLEIN/ | |
8869 | *.-1 | |
8870 | TEXT /ER ALS 1.0E+308)/ | |
8871 | E22,TEXT /22 PUNKT AM PROGRAMMENDE FEHLT! (WORTSYMBOLE 'BEGIN' UND 'E/ | |
8872 | *.-1 | |
8873 | TEXT /ND' NICHT PAARWEISE?)/ | |
8874 | E23,TEXT /23 AUSDRUCK NACH 'CASE' MUSS VOM TYP INTEGER, CHAR ODER BOO/ | |
8875 | *.-1 | |
8876 | TEXT /LEAN SEIN./ | |
8877 | E24,TEXT /24 ILLEGALES ZEICHEN!/ | |
8878 | E25,TEXT /25 BEI KONSTANTENVEREINBARUNG MUSS NACH = EINE KONSTANTE OD/ | |
8879 | *.-1 | |
8880 | TEXT /. EIN KONST.NAME STEHEN./ | |
8881 | E26,TEXT /26 DER AUSDRUCK FUER EINEN FELD-INDEX MUSS VOM VEREINBARTEN/ | |
8882 | *.-1 | |
8883 | TEXT / INDEX-TYP SEIN./ | |
8884 | E27,TEXT /27 BEREICHSGRENZEN BEI FELDVEREINBARUNG FEHLERHAFT (UG<=OG?/ | |
8885 | *.-1 | |
8886 | TEXT / GLEICHER TYP?)/ | |
8887 | E28,TEXT /28 JEDE INDIZIERTE VARIABLE MUSS ALS ARRAY VEREINBART WERDE/ | |
8888 | *.-1 | |
8889 | TEXT /N./ | |
8890 | E29,TEXT /29 TYPNAME FEHLT (IN PARAMETERLISTEN SIND ALLG. TYPVEREINBA/ | |
8891 | *.-1 | |
8892 | TEXT /RUNGEN VERBOTEN)./ | |
8893 | E30,TEXT /30 DIESER TYP WURDE NICHT VEREINBART./ | |
8894 | E31,TEXT /31 JEDE VARIABLE MIT KOMPONENTEN-SELEKTOR MUSS ALS RECORD V/ | |
8895 | *.-1 | |
8896 | TEXT /EREINBART WERDEN./ | |
8897 | E32,TEXT /32 'NOT', 'AND' UND 'OR' VERLANGEN OPERANDEN VOM TYP BOOLEA/ | |
8898 | *.-1 | |
8899 | TEXT /N./ | |
8900 | E33,TEXT /33 TYP DIESES AUSDRUCKS UNBESTIMMT (GANZES ARRAY IN ARITHM./ | |
8901 | *.-1 | |
8902 | TEXT /OPERATIONEN UNZULAESSIG)./ | |
8903 | E34,TEXT /34 'DIV' UND 'MOD' VERLANGEN OPERANDEN VOM TYP INTEGER./ | |
8904 | E35,TEXT /35 TYPEN DER VERGLEICHSOPERANDEN UNVERTRAEGLICH./ | |
8905 | E36,TEXT /36 AKTUAL- UND FORMALPARAMETER MUESSEN VOM GLEICHEN TYP SEI/ | |
8906 | *.-1 | |
8907 | TEXT /N./ | |
8908 | E37,TEXT /37 VARIABLE ERFORDERLICH!/ | |
8909 | E38,TEXT /38 EIN STRING MUSS MINDESTENS EIN ZEICHEN ENTHALTEN./ | |
8910 | E39,TEXT /39 ANZAHL DER AKTUAL- UND FORMALPARAMETER MUSS UEBEREINSTIM/ | |
8911 | *.-1 | |
8912 | TEXT /MEN./ | |
8913 | E40,TEXT /40 STANDARDPROZEDUR READ NUR FUER TYP INTEGER, REAL UND CHA/ | |
8914 | *.-1 | |
8915 | TEXT /R VORGESEHEN./ | |
8916 | E41,TEXT /41 BEI WRITE SIND NUR DIE TYPEN INTEGER, REAL, BOOLEAN UND / | |
8917 | *.-1 | |
8918 | TEXT /CHAR ZULAESSIG./ | |
8919 | E42,TEXT /42 WRITE(X:M:N) IST NUR FUER WERTE VOM TYP REAL ZULAESSIG./ | |
8920 | E43,TEXT /43 M UND N BEI WRITE(X:M:N) MUESSEN INTEGER-AUSDRUECKE SEIN./ | |
8921 | E44,TEXT /44 TYP- ODER PROZEDURNAMEN SIND IN AUSDRUECKEN UNZULAESSIG./ | |
8922 | E45,TEXT /45 EINE ANWEISUNG KANN NICHT MIT EINEM KONST-, TYP- ODER FU/ | |
8923 | *.-1 | |
8924 | TEXT /NKTIONSNAMEN BEGINNEN./ | |
8925 | E46,TEXT /46 TYPUNVERTRAEGLICHKEIT BEI WERTZUWEISUNG./ | |
8926 | E47,TEXT /47 'CASE'-MARKEN MUESSEN VOM GLEICHEN TYP WIE DER 'CASE'-AU/ | |
8927 | *.-1 | |
8928 | TEXT /SDRUCK SEIN./ | |
8929 | E48,TEXT /48 TYP DES ARGUMENTS BEI DIESER STANDARDFUNKTION UNZULAESSI/ | |
8930 | *.-1 | |
8931 | TEXT /G./ | |
8932 | E49,TEXT /49 ARRAY-INDIZES UND 'CASE'-MARKEN SIND AUF -2048 < X < 204/ | |
8933 | *.-1 | |
8934 | TEXT /8 BEGRENZT./ | |
8935 | E50,TEXT /50 EINE KONSTANTE KANN NICHT MIT DEM BEZEICHNETEN SYMBOL BE/ | |
8936 | *.-1 | |
8937 | TEXT /GINNEN./ | |
8938 | E51,TEXT /51 SYMBOL := FEHLT (LEERZEICHEN ZWISCHEN : UND = UNZULAESSI/ | |
8939 | *.-1 | |
8940 | TEXT /G)./ | |
8941 | E52,TEXT /52 DAS WORTSYMBOL 'THEN' FEHLT./ | |
8942 | E53,TEXT /53 DAS WORTSYMBOL 'UNTIL' FEHLT./ | |
8943 | E54,TEXT /54 DAS WORTSYMBOL 'DO' FEHLT./ | |
8944 | E55,TEXT /55 DAS WORTSYMBOL 'TO' ODER 'DOWNTO' FEHLT./ | |
8945 | E56,TEXT /56 DAS WORTSYMBOL 'BEGIN' FEHLT./ | |
8946 | E57,TEXT /57 DAS WORTSYMBOL 'END' FEHLT./ | |
8947 | E58,TEXT /58 EIN FAKTOR MUSS MIT NAME, KONSTANTE, 'NOT' ODER LINKSKLA/ | |
8948 | *.-1 | |
8949 | TEXT /MMER BEGINNEN./ | |
8950 | ||
8951 | XLIST | |
8952 | \f/R U N T I M E E R R O R S (ALWAYS FATAL!) | |
8953 | ||
8954 | *DISPLAY | |
8955 | /-------- D I S P L A Y --------/ | |
8956 | ZBLOCK 20 | |
8957 | /---------------------------------/ | |
8958 | ||
8959 | XHALT, 0 | |
8960 | CLA CLL | |
8961 | TAD ZPRINT | |
8962 | DCA PTPRINT /SWITCH TO TERMINAL OUTPUT! | |
8963 | TAD (HLTLIST-1 | |
8964 | DCA HTEXT | |
8965 | ISZ HTEXT | |
8966 | TAD I HTEXT | |
8967 | TAD XHALT | |
8968 | SZA CLA | |
8969 | JMP .-4 | |
8970 | ISZ HTEXT | |
8971 | TAD I HTEXT | |
8972 | DCA HTEXT | |
8973 | CRLF | |
8974 | CRLF | |
8975 | JMS HMESG | |
8976 | TAD (HLTAT | |
8977 | DCA HTEXT | |
8978 | JMS HMESG | |
8979 | L0001 | |
8980 | DCA M | |
8981 | L7777 | |
8982 | TAD PC | |
8983 | LOAD | |
8984 | JMS IOUT | |
8985 | CRLF | |
8986 | JMP I OS8 | |
8987 | ||
8988 | HMESG, 0 | |
8989 | TAD I HTEXT | |
8990 | SNA | |
8991 | JMP I HMESG | |
8992 | BSW | |
8993 | JMS ASCII | |
8994 | TAD I HTEXT | |
8995 | JMS ASCII | |
8996 | ISZ HTEXT | |
8997 | JMP HMESG+1 | |
8998 | HTEXT, 0 | |
8999 | ||
9000 | HLTLIST,-ERROR0-1; HLT0 | |
9001 | -ERROR1-1; HLT1 | |
9002 | -ERROR2-1; HLT2 | |
9003 | -ERROR3-1; HLT3 | |
9004 | -ERROR4-1; HLT4 | |
9005 | -ERRORA-1; HLTA | |
9006 | -ERRORB-1; HLTB | |
9007 | -ERRORC-1; HLTC | |
9008 | -ERRORD-1; HLTD | |
9009 | ||
9010 | HLT0, TEXT /DIVISION BY 0 / | |
9011 | HLT1, TEXT /UNDERFLOW / | |
9012 | HLT2, TEXT /OVERFLOW/ | |
9013 | HLT3, TEXT /SQRT/ | |
9014 | HLT4, TEXT /LN/ | |
9015 | HLTA, TEXT /MEMORY FULL / | |
9016 | HLTB, TEXT / INDEX/ | |
9017 | HLTC, TEXT /CASE/ | |
9018 | HLTD, TEXT /FILE/ | |
9019 | ||
9020 | HLTAT, TEXT / ERROR AT / | |
9021 | ||
9022 | PAGE | |
9023 | \f/I N I T I A L I Z A T I O N OF R U N T I M E - S Y S T E M | |
9024 | ||
9025 | INIT, CLA CLL | |
9026 | CDF 10 | |
9027 | TAD I (7621 | |
9028 | CDF 0 | |
9029 | SNA CLA /IF INPUT FILE SPECIFIED | |
9030 | JMP INITKB | |
9031 | TAD IIDEVH /THEN SETUP FILE INPUT | |
9032 | DCA I (IDEVH | |
9033 | TAD IIBLOCK | |
9034 | DCA I (IBLOCK | |
9035 | TAD (JMP ERRORD | |
9036 | DCA I (FATAL0 | |
9037 | TAD (IBUFFER | |
9038 | DCA I (IBP | |
9039 | L7775 | |
9040 | DCA I (IC3 | |
9041 | TAD (GETC | |
9042 | SKP | |
9043 | INITKB, TAD (XREAD /ELSE KEYBOARD INPUT | |
9044 | DCA I (PTREAD | |
9045 | CDF 10 | |
9046 | TAD I (7600 | |
9047 | CDF 0 | |
9048 | SNA CLA /IF OUTPUT FILE SPECIFIED | |
9049 | JMP INITPR | |
9050 | TAD (I37 /THEN SETUP FILE OUTPUT | |
9051 | DCA I (PTI37 | |
9052 | TAD (PUTC | |
9053 | SKP | |
9054 | INITPR, TAD (XPRINT /ELSE USE PRINTER | |
9055 | DCA I (PTPRINT | |
9056 | TAD (XHALT | |
9057 | DCA I (PTHALT /ACTIVATE RUNTIME ERRORS | |
9058 | INITDH, CDF 60 /TRANSFER DEVICE HANDLER(S) | |
9059 | TAD I F6T0 /AND RUNTIME ERROR ROUTINE | |
9060 | CDF 0 /TO THEIR PLACE IN FIELD 0 | |
9061 | DCA I F6T0 | |
9062 | ISZ F6T0 | |
9063 | ISZ C1200 | |
9064 | JMP .-6 | |
9065 | INITST, TAD (CDF CIF 0 /CHANGE STARTING ADDRESS | |
9066 | DCA I (7744 /TO START OF INTERPRETER | |
9067 | TAD (ISTART | |
9068 | DCA I (7745 | |
9069 | DCA I (7746 /CORRECT JOB STATUS WORD | |
9070 | CDF 10 /(MAKE IT RESTARTABLE) | |
9071 | TAD I (7643 | |
9072 | AND (20 /CHECK /H - OPTION | |
9073 | CDF CIF 0 | |
9074 | SZA CLA | |
9075 | JMP I (7600 /RETURN TO OS8 MONITOR | |
9076 | JMP I (ISTART /START INTERPRETER | |
9077 | ||
9078 | IIDEVH, 0 | |
9079 | IIBLOCK,0 | |
9080 | F6T0, IDEVBUF | |
9081 | C1200, -1200 | |
9082 | ||
9083 | PAGE | |
9084 | ||
9085 | END | |
9086 | $ |