Commit | Line | Data |
---|---|---|
81e70d48 PH |
1 | /OS8 BASIC COMPILER, V5 |
2 | / | |
3 | / | |
4 | / | |
5 | / | |
6 | / | |
7 | / | |
8 | / | |
9 | // | |
10 | / | |
11 | / | |
12 | / | |
13 | / | |
14 | /COPYRIGHT (C) 1972, 1973, 1974, 1975 | |
15 | /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. | |
16 | / | |
17 | / | |
18 | / | |
19 | /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A | |
20 | /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- | |
21 | /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER | |
22 | /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE | |
23 | /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO | |
24 | /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE | |
25 | /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. | |
26 | / | |
27 | / | |
28 | /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT | |
29 | /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL | |
30 | /EQUIPMRNT COROPATION. | |
31 | / | |
32 | /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS | |
33 | /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. | |
34 | / | |
35 | / | |
36 | / | |
37 | / | |
38 | / | |
39 | / | |
40 | \f/DEC-S8-LBASA-B-LA | |
41 | / | |
42 | /COPYRIGHT C 1972, 1973, 1974 | |
43 | / | |
44 | /DIGITAL EQUIPMENT CORPORATION | |
45 | /MAYNARD,MASSACHUSETTS 01754 | |
46 | / | |
47 | /AUGUST 19, 1972 | |
48 | / | |
49 | /HANK MAURER, 1972 | |
50 | /SHAWN SPILMAN, 1973 | |
51 | / | |
52 | / | |
53 | /ASSEMBLE AND LOAD AS FOLLOWS: | |
54 | / | |
55 | / .R PAL8 | |
56 | / *BCOMP,BCOMP<BCOMP.03 | |
57 | / .R ABSLDR | |
58 | / *BCOMP$ | |
59 | / .SA SYS BCOMP;7000 | |
60 | / | |
61 | /NOTE DIFFERENCES FROM VERSION 1 AS FOLLOWS: | |
62 | / | |
63 | / .R SRCCOM | |
64 | / *LPT:<BCOMP.01,BCOMP.03 | |
65 | / * | |
66 | / | |
67 | / | |
68 | VERSON=5 /VERSION LOCATED IN CORE AT TAG "VERLOC" | |
69 | /LEFT HALF OF VERLOC = 60+VERSON | |
70 | /RIGHT HALF OF VERLOC = PATCH LEVEL (01=A) | |
71 | ||
72 | / | |
73 | /CORRECTION & ADDITION MADE FOR V4 J.K. 1975 | |
74 | / | |
75 | / ./V FOR VERSION NUMBER | |
76 | / . ABILITY TO INPUT FROM PTR | |
77 | / .CORRECT TEST FOR BATCH RUNNIG | |
78 | / .IGNORE MORE THAN 10 SIGNIFICANT DIGITS | |
79 | / OF NUMERIC CONSTANTS | |
80 | /JR 30-APR-77 UPDATE VERSION | |
81 | \f *5 | |
82 | TEMP3, 0 | |
83 | XABORT, ABORT /ADDR OF ABORT ROUTINE | |
84 | 0 | |
85 | X10, INFO-5 /AUTO INDEX REGISTERS | |
86 | X11, NAMLST-1 | |
87 | X12, INFO-5 | |
88 | X13, BOSINFO-1 | |
89 | OSTACK, STACKO-1 /OPERAND STACK POINTER | |
90 | STACK, STACKA-1 /GENERAL STACK POINTER | |
91 | NEXT, FREE-1 /NEXT FREE LOCATION | |
92 | CHRPTR, 0 /INPUT BUFFER POINTER | |
93 | NCHARS, 0 /SIZE OF INPUT LINE | |
94 | TEMP, -4 | |
95 | TEMP2, 0 | |
96 | DECPT, 0 /SET 1 IF . | |
97 | NDIGIT, 0 /NUM DIGITS RIGHT OF . | |
98 | EXPON, 0 /EXPONENT FOR NUM CONV | |
99 | TYPE, 0 /TYPE OF CURRENT OPERAND | |
100 | SYMBOL, 0 /SYMBOL NUMBER OF CUR. OPERAND | |
101 | LEFT, 0 /LEFT SIDE SWITCH | |
102 | OLDOP, 0 /OLD OPERATOR | |
103 | NEWOP, 0 /NEW OPERATOR | |
104 | TMPCNT, 0 /TEMP COUNTER | |
105 | TMPLVL, 3 /TEMP LEVEL | |
106 | STMPCT, 0 /TEMP COUNT (STRINGS) | |
107 | STMPLV, 1 /TEMP LEVEL (STRINGS) | |
108 | STPTR, 0 /POINTER TO S.T. ENTRY | |
109 | VARCNT, -401 /NUMBER OF POSSIBLE NUMERIC | |
110 | /VARIABLES, LITERALS, AND TEMPS | |
111 | SVCNT, -401 /SAME FOR STRING VARS | |
112 | ACNT, -41 /ARRAY COUNTER | |
113 | SACNT, -41 /STRING ARRAY COUNTER | |
114 | LOCTRH, 0 /HIGH ORDER LOCATION COUNTER | |
115 | LOCTRL, 0 /LOW ORDER " " | |
116 | BLOCK, 0 /START BLOCK OF TEMP FILE | |
117 | HIFLD, 0 /HIGHEST CORE FIELD | |
118 | BRTS, 0 /START OF BRTS.SV | |
119 | DLSIZE, 0 /NEG. SIZE OF DATA LIST | |
120 | ABORTX, 0 /START OF EDITOR | |
121 | LINEH, 0 /LINE NUMBER (HIGH) | |
122 | LINEL, 0 /LINE NUMBER (LOW) | |
123 | MODE, 0 /INTERPRETER MODE | |
124 | TYPE1, 0 /TYPE AFTER JMS GETA1 | |
125 | SYMBL1, 0 /SYM # AFTER JMS GETA1 | |
126 | OLDSTK, 0 /STACK SAVER FOR DEF | |
127 | ARGCNT, 0 /ARG COUNTER FOR DEF | |
128 | PCRLF, /CR SWITCH FOR PRINT STMT | |
129 | DACNT, /ARG COUNT FOR UDEF STMT | |
130 | FORJMP, /FOR LOOP JUMP INSTR | |
131 | NOSN, /STMT NUMBER PRESENT SWITCH | |
132 | COLON, /: SWITCH FOR GETFN ROUTINE | |
133 | JAROND, 0 /END OF DEF ADDR GOES HERE (INDIRECTLY) | |
134 | IFNREG, 0 /CONTENTS OF IFN REG | |
135 | SSREG1, 0 /EXECUTION TIME CONTENTS | |
136 | SSREG2, 0 /OF THE SS REGISTORS | |
137 | STKLVL, STACKA-1 /STACK BASE LEVEL | |
138 | FINDEX, 0 /FOR LOOP INDEX | |
139 | SETFLD, 0 /FIELD CHANGE RTNE FOR LUKUP2 | |
140 | LUFLD, CDF 10 /FIELD OF ENTRY FOR LUKUP2 | |
141 | JMP I SETFLD | |
142 | QERMSG, ERMSG /SUBROUTINE POINTERS | |
143 | QLODSN, LODSN | |
144 | QCHKWD, CHKWD | |
145 | QMODSET,MODSET | |
146 | QSNUM, SNUM | |
147 | QOUTWRD,OUTWRD | |
148 | QSAVECP,SAVECP | |
149 | QGETC, GETC | |
150 | QGETCWB,GETCWB | |
151 | QRESTCP,RESTCP | |
152 | QEXPR, EXPR | |
153 | QOUTOPR,OUTOPR | |
154 | QNEWLIN,NEWLIN | |
155 | QREMARK,REMARK | |
156 | QGETA1, GETA1 | |
157 | QLOADSS,LOADSS | |
158 | QCHECKC,CHECKC | |
159 | QGETNAM,GETNAM | |
160 | QCOMARP,COMARP | |
161 | QLOOKUP,LOOKUP | |
162 | QLUKUP2,LUKUP2 | |
163 | QLOAD, LOAD | |
164 | QPUSH, PUSH | |
165 | QPOP, POP | |
166 | QPUSHO, PUSHO | |
167 | QSAVAC, SAVAC | |
168 | QBACK1, BACK1 | |
169 | QNUMBER,NUMBER | |
170 | QSTRING,STRING | |
171 | QLETTER,LETTER | |
172 | QDIGIT, DIGIT | |
173 | QNOREGS,NOREGS | |
174 | Q400, 400 | |
175 | NAME1, /VARIABLE OR FUNCT NAME | |
176 | WORD1, 0 /3 WORD LITERAL BUFFER | |
177 | NAME2, | |
178 | WORD2, 0 | |
179 | NAME3, | |
180 | WORD3, 0 | |
181 | ACO, 0 /FAC OVERFLOW WD | |
182 | OP1, 0 /4 WORD ARG FOR "NUMBER" | |
183 | OP2, 0 | |
184 | OP3, 0 | |
185 | OPO, 0 | |
186 | NUMDIG, -13 | |
187 | SIGDIG, 0 | |
188 | \f INFO= 7604 /INFORMATION AREA | |
189 | /INFO STARTING BLOCK +1 OF BASIC.SV | |
190 | /INFO+1 STARTING BLOCK +1 OF BCOMP.SV | |
191 | /INFO+2 STARTING BLOCK +1 OF BLOAD.SV | |
192 | /INFO+3 STARTING BLOCK +1 OF BRTS.SV | |
193 | /INFO+4 STARTING BLOCK +1 OF BASIC.AF | |
194 | /INFO+5 STARTING BLOCK +1 OF BASIC.SF | |
195 | /INFO+6 STARTING BLOCK +1 OF BASIC.FF | |
196 | /INFO+7 STARTING BLOCK +1 OF BASIC.UF | |
197 | /INFO+10 STARTING BLOCK OF BASIC.TM | |
198 | /INFO+11 SIZE IN BLOCKS OF BASIC.TM | |
199 | /INFO+12 INPUT HANDLER ENTRY ADDRESS | |
200 | /INFO+13 SIZE AND DEVICE NUMBER OF INPUT FILE | |
201 | /INFO+14 STARTING BLOCK OF INPUT FILE | |
202 | /INFO+15 THROUGH | |
203 | /INFO+20 NAME OF WORKSPACE | |
204 | / | |
205 | / | |
206 | BOSINFO= 7774 /BOS PARAMETER AREA | |
207 | EDTSIZ= 2100 /SIZE OF BASIC.SV | |
208 | EDTBGN= 3212 /RESTART FOR EDITOR | |
209 | ERMSG2= 1712 /POST PROCESSOR ERROR SWITCH | |
210 | EOST= 7570 /UPPER LIMIT FOR SYMBOL TABLE | |
211 | INDEVH= 4600 /INPUT DEVICE HANDLER | |
212 | LINE= 7000 /LINE BUFFER | |
213 | LINMAX= 121 /MAXIMUM BASIC STMT | |
214 | STACKA= 7120 /MAIN STACK | |
215 | STAKSZ= 60 /SIZE OF MAIN STACK | |
216 | /OPERAND STACK DEFINED IN-LINE | |
217 | STRLIM= 120 /MAXIMUM STRING SIZE | |
218 | INBUF= 7200 /INPUT BUFFER | |
219 | / | |
220 | / | |
221 | /FIELD ONE STUFF | |
222 | / | |
223 | / | |
224 | OUBUF= 0 /OUTPUT BUFFER | |
225 | VARST= 400 /VARIABLE SYMBOL TABLE | |
226 | SVARST= VARST+436/STRING VAR SYMBOL TABLE | |
227 | ARAYST= SVARST+1074/ARRAY SYMBOL TABLE | |
228 | SARYST= ARAYST+200/STRING ARRAY SYMBOL TABLE | |
229 | SNUMS= SARYST+200/STMT NUMBER BUCKETS | |
230 | TEMPS= SNUMS+24 /NUMERIC TEMP BUCKET | |
231 | STEMPS= TEMPS+2 /STRING TEMP BUCKET | |
232 | LITRL= STEMPS+2 /NUMERIC LITERAL BUCKET | |
233 | SLITRL= LITRL+2 /STRING LITERAL BUCKET | |
234 | DATLST= SLITRL+2 /DATA LIST | |
235 | FUNCTN= DATLST+2 /FUNCTION LIST | |
236 | FREE= FUNCTN+2 /START OF FREE CORE | |
237 | \f/ INTERPRETER OPCODES | |
238 | / | |
239 | / MEMORY REFERENCE SET | |
240 | FADD= 0000 | |
241 | FSUB= 0400 | |
242 | FMPY= 1000 | |
243 | FDIV= 1400 | |
244 | FLDA= 2000 | |
245 | FSTA= 2400 | |
246 | FISUB= 3000 | |
247 | FIDIV= 3400 | |
248 | LSS1= 4000 | |
249 | LSS2= 4400 | |
250 | JEOF= 5400 | |
251 | LOADSN= 6000 | |
252 | / | |
253 | / JOC CLASS | |
254 | JSUB= 5000 | |
255 | JUMP= 5001 | |
256 | JGE= 5002 | |
257 | JNE= 5003 | |
258 | JGT= 5004 | |
259 | JLT= 5005 | |
260 | JEQ= 5006 | |
261 | JLE= 5007 | |
262 | JFOR= 5010 | |
263 | / | |
264 | / ARRAY CLASS | |
265 | AISUB= 6400 | |
266 | AFADD= 6440 | |
267 | AFSUB= 6500 | |
268 | AFMPY= 6540 | |
269 | AFDIV= 6600 | |
270 | AFLDA= 6640 | |
271 | AFSTA= 6700 | |
272 | AIDIV= 6740 | |
273 | / | |
274 | / STRING CLASS | |
275 | SCON= FADD | |
276 | SCOMP= FSUB | |
277 | SREAD= FMPY | |
278 | SLOAD= FLDA | |
279 | SSTORE= FSTA | |
280 | SACON= AISUB | |
281 | SACOMP= AFADD | |
282 | SAREAD= AFSUB | |
283 | SALOAD= AFLDA | |
284 | SASTOR= AFSTA | |
285 | / | |
286 | / OPERATE CLASS | |
287 | SETJF= 7401 | |
288 | RNDO= 7421 | |
289 | STOP= 7441 | |
290 | SRDL= 7461 | |
291 | CHN= 7414 | |
292 | NRDL= 7521 | |
293 | CLOSEF= 7434 | |
294 | OPENAV= 7474 | |
295 | OPENAF= 7454 | |
296 | OPENNV= 7534 | |
297 | OPENNF= 7514 | |
298 | CLRFN= 7501 | |
299 | FILENO= 7402 | |
300 | FNEG= 7403 | |
301 | RET= 7404 | |
302 | REST= 7405 | |
303 | LSS1AC= 7406 | |
304 | LSS2AC= 7407 | |
305 | FESC= 7410 | |
306 | READ= 7411 | |
307 | WRITE= 7412 | |
308 | SWRITE= 7413 | |
309 | SMODE= 7561 | |
310 | NMODE= 7541 | |
311 | FUNC1= 7416 | |
312 | FUNC2= 7417 | |
313 | FUNC3= 7400 | |
314 | FUNC4= 7415 | |
315 | USE= 7540 | |
316 | \f/ ASSEMBLE LINE | |
317 | *STRLIM%2+1+WORD1 /ORG PAST BIGGEST STRING LIT | |
318 | NEWLIN, JMS I QGETC /ANY CHARS LEFT ? | |
319 | JMP REMARK /NO, LINE ENDED OK | |
320 | JMS I QERMSG /EXTRA CHARACTERS | |
321 | 3003 | |
322 | REMARK, DCA NOSN /CLEAR STMT NUMBER SWITCH | |
323 | TAD TMPLVL /RESET TEMP LEVELS | |
324 | DCA TMPCNT /FOR NUMERIC | |
325 | TAD STMPLV /AND STRING | |
326 | DCA STMPCT /TEMPORARIES | |
327 | TAD (STACKO-1 | |
328 | DCA OSTACK /RESET STACK POINTERS | |
329 | TAD STKLVL /(CHANGED BY FOR LOOPS) | |
330 | DCA STACK | |
331 | TAD (LINE-1 /GET THE NEXT LINE | |
332 | DCA X10 | |
333 | TAD (-LINMAX/MAX SIZE | |
334 | DCA TEMP3 | |
335 | GETLIN, JMS ICHAR /GET NEXT CHAR | |
336 | JMP GOTCR /CR | |
337 | DCA I X10 /PUT INTO LINE BUFFER | |
338 | ISZ TEMP3 /BUMP MAX COUNTER | |
339 | JMP GETLIN | |
340 | JMP GOTCR | |
341 | ERLTL, JMS I QERMSG /LINE TOO LONG | |
342 | 1424 | |
343 | JMS ICHAR /SKIP REST OF LINE | |
344 | JMP NOSNUM+3 | |
345 | CLA | |
346 | JMP .-3 | |
347 | GOTCR, TAD X10 /COMPUTE SIZE | |
348 | CMA | |
349 | TAD (LINE-1 /OF LINE | |
350 | DCA NCHARS | |
351 | TAD (LINE-1 /SETUP LINE POINTER | |
352 | DCA CHRPTR | |
353 | / TAD LOCTRL /PUT LOCATION COUNTER | |
354 | / 7421 /INTO MQ | |
355 | CLA CLL CML RAR /ALLOW DEFINITION | |
356 | JMS I QSNUM /GET THE STATEMENT NUMBER | |
357 | JMP NOSNUM /NO STMT NUMBER ON THIS LINE | |
358 | ISZ NOSN /SET STMT NUMBER PRESENT | |
359 | JMS I QMODSET /IN N MODE AT ALL LABELS | |
360 | JMS I QNOREGS /FORGET REG CONTENTS | |
361 | TAD WORD1 /SAVE NEW LINE NUMBER | |
362 | DCA LINEH | |
363 | TAD WORD2 | |
364 | DCA LINEL | |
365 | JMS SETFLD /GET TO FIELD OF ENTRY | |
366 | TAD I TEMP2 /GET DEFINED/REFNCED BITS | |
367 | TAD LOCTRH /ADD IN HIGH ORDER LOCATION CTR | |
368 | DCA I TEMP2 /PUT IT AWAY | |
369 | ISZ TEMP2 | |
370 | TAD LOCTRL /NOW PUT IN LOW ORDER LOCATION | |
371 | DCA I TEMP2 | |
372 | CDF | |
373 | NOSNUM, TAD TEMP3 | |
374 | SNA CLA | |
375 | JMP ERLTL | |
376 | JMS KBDCHK /CHECK FOR ^C OR ^O | |
377 | TAD (KEYWRD-1 | |
378 | DCA X10 /SET UP FOR KEYWORD SEARCH | |
379 | JMS I QSAVECP /SAVE CHAR POS | |
380 | KWLOOP, TAD I X10 /GET NEXT CHAR OF KEYWORD | |
381 | SMA | |
382 | JMP GOTKW /OK, THIS IS THE KW | |
383 | DCA TEMP | |
384 | JMS I QGETC /GET NEXT CHAR FROM STMT | |
385 | JMP NOGOOD /THIS ISN'T IT | |
386 | TAD TEMP /IS THIS CHAR OK ? | |
387 | SNA CLA | |
388 | JMP KWLOOP /YES, CONTINUE LOOKING | |
389 | NOGOOD, JMS I QRESTCP /BACK TO START OF STMT | |
390 | TAD I X10 /SKIP OVER REST OF KEYWORD | |
391 | SPA CLA | |
392 | JMP .-2 | |
393 | TAD I X10 /IS THIS END OF LIST ? | |
394 | SZA | |
395 | JMP KWLOOP+3/NO, KEEP LOOKING | |
396 | JMP LET /TREAT AS LET STMT | |
397 | GOTKW, DCA TEMP /SAVE ADDR OF ROUTINE | |
398 | JMP I TEMP /GO PROCESS THE STMT | |
399 | \f/ LET STATEMENT PROCESSOR | |
400 | LET, JMS I QLODSN /LOAD THE STMT NUMBER | |
401 | CLL CML RAR /COMPILE LEFT SIDE | |
402 | JMS I QEXPR /GET EXPRESSION | |
403 | JMP REMARK | |
404 | JMS I QCHECKC /LOOK FOR = | |
405 | -75 | |
406 | JMP BADLET /BAD IF MISSING | |
407 | JMS I QEXPR /GET RIGHT SIDE | |
408 | JMP REMARK | |
409 | CLA CMA /GET TYPE OF | |
410 | TAD OSTACK /RIGHT SIDE | |
411 | DCA TEMP /OF EQUAL SIGN | |
412 | TAD I TEMP /SO THAT WE GENERATE | |
413 | SPA CLA | |
414 | CLL CMA RAL /THE CORRECT STORE | |
415 | TAD (ASSIGN-1 | |
416 | JMS I QOUTOPR /GENERATE STORE | |
417 | JMP NEWLIN | |
418 | BADLET, JMS I QERMSG /BAD LET STMT | |
419 | 1423 | |
420 | JMP REMARK | |
421 | END, TAD (STOP /OUTPUT STOP OPCODE | |
422 | JMS I QOUTWRD | |
423 | JMS OUDUMP /DUMP BUFFER | |
424 | JMS I (7607 /READ IN POST PROCESSOR | |
425 | 1300 /ELEVEN PAGES | |
426 | POSTX, 400 /FROM 400 | |
427 | LDRBLK, 0 /FROM THIS BLOCK | |
428 | IFNZRO LDRBLK-357 <__FIX BLOAD__> | |
429 | JMP I XABORT | |
430 | TAD I QERMSG /SET POST PROCESSOR ERROR SWITCH | |
431 | DCA ERMSG2 | |
432 | JMP I POSTX /START IT UP | |
433 | \f/ RESTORE, PRINT, AND INPUT PROCESSORS | |
434 | PAGE | |
435 | INPUT, JMS I QLODSN /OUTPUT STMT NUM | |
436 | JMS GETFN /LOOK FOR #<FILE NUM EXPR>: | |
437 | INPUTL, CLL CML RAR /PROCESS INPUT STMT | |
438 | JMS I QEXPR /GET EXPR | |
439 | JMP I QREMARK | |
440 | JMS I QGETA1 /GET TOP OF STACK | |
441 | TAD TYPE1 /LOOK AT THE TYPE | |
442 | SPA CLA | |
443 | JMP RSTRNG /READ STRING | |
444 | JMS I QMODSET /SET MODE | |
445 | CLL CML RTR /IS IT DIMENSIONED ? | |
446 | AND TYPE1 | |
447 | SZA CLA | |
448 | JMP I (DIMREAD/YES | |
449 | TAD (READ /OUTPUT READ COMMAND | |
450 | JMS I QOUTWRD | |
451 | TAD (FSTA /USE SCALAR STORE | |
452 | FININP, TAD SYMBL1 /PLUS SYMBOL NUMBER | |
453 | JMS I QOUTWRD /OUTPUT INSTR | |
454 | JMS I QCHECKC /LOOK FOR , | |
455 | -54 | |
456 | JMP I QNEWLIN /END OF INPUT | |
457 | JMP INPUTL /YES, LOOP | |
458 | RSTRNG, CLL CML RAR /SET MODE | |
459 | JMS I QMODSET /TO STRING | |
460 | CLL CML RTR /SUBSCRIPTED ? | |
461 | AND TYPE1 | |
462 | SNA CLA | |
463 | JMP .+3 /NO | |
464 | JMS I QLOADSS /LOAD SS REG | |
465 | TAD (SAREAD-SREAD | |
466 | TAD (SREAD /STRING READ | |
467 | JMP FININP /USE SOME COMMON CODE | |
468 | PRINT, JMS I QLODSN /OUTPUT STMT NUM | |
469 | JMS GETFN /GET FILE NUMBER | |
470 | DCA I QEXPR /USE ENTRY AS SWITCH | |
471 | PRINTL, DCA PCRLF /CLEAR THE FLAG | |
472 | JMS I QGETC /LOOK FOR A CHAR | |
473 | JMP PRTEND /NONE LEFT, END PRINT | |
474 | TAD (-73 /; ? | |
475 | SNA | |
476 | JMP NOCR /YES, DON'T SPACE OUTPUT | |
477 | TAD (73-54 /, ? | |
478 | SZA CLA | |
479 | JMP TABPNT /LOOK FOR TAB OR PNT | |
480 | TAD (FUNC3+20 | |
481 | JMS I QOUTWRD /OUTPUT FUNC3+20 (COMMA) | |
482 | NOCR, DCA I QEXPR /CLEAR THE SWITCH | |
483 | CLA IAC /SET NO CRLF FLAG | |
484 | JMP PRINTL | |
485 | TABPNT, TAD I QEXPR /WAS LAST THING AN EXPR ? | |
486 | SZA CLA | |
487 | JMP I QNEWLIN /YES, CAN'T HAVE TWO IN A ROW | |
488 | JMS I QBACK1 /PUT THAT CHAR BACK | |
489 | JMS I QSAVECP /SAVE CHAR POS | |
490 | JMS I QCHKWD /LOOK FOR "TAB(" | |
491 | WTAB | |
492 | JMP TRYPNT /NO TAB | |
493 | TAD (FUNC3+100 | |
494 | PFCALL, DCA PRFUN /SAVE PRINT FUNCTION | |
495 | JMS I QEXPR /GET ARG | |
496 | JMP I QREMARK | |
497 | JMS I QLOAD /LOAD ARG | |
498 | TAD TYPE1 /MUST BE NUMERIC | |
499 | SMA CLA | |
500 | JMP .+4 /OK, IT IS | |
501 | BADPF, JMS I QERMSG /PRINT ERROR | |
502 | 0622 /BAD FUNCTION REFERENCE | |
503 | JMP I QREMARK | |
504 | JMS I QCHECKC /LOOK FOR ) | |
505 | -51 | |
506 | JMP BADPF /BAD FUN REFERENCE | |
507 | TAD PRFUN /OUTPUT FUNCTION CALL | |
508 | JMP PUT1 | |
509 | TRYPNT, JMS I QRESTCP /RESTORE CHAR POS | |
510 | JMS I QCHKWD /LOOK FOR PNT( | |
511 | WPNT | |
512 | JMP PEXP /NO | |
513 | TAD (FUNC3+120 | |
514 | JMP PFCALL /GO DO FUN CALL | |
515 | PEXP, JMS I QRESTCP /RESTORE CHAR POS | |
516 | JMS I QEXPR /GET EXPR TO BE PRINTED | |
517 | JMP I QREMARK | |
518 | JMS I QLOAD /PUT THING INTO FAC (OR SAC) | |
519 | CLL CML RAR | |
520 | AND TYPE1 /GET TYPE BIT | |
521 | CLL RTL /INTO AC 11 | |
522 | TAD (WRITE /SWRITE=WRITE+1 | |
523 | PUT1, JMS I QOUTWRD | |
524 | JMP PRINTL | |
525 | PRTEND, TAD PCRLF /DID PRINT END WITH | |
526 | SZA CLA /, OR ; | |
527 | JMP I QNEWLIN /YES, NO CR LF | |
528 | TAD (FUNC3+40 | |
529 | PUT2, JMS I QOUTWRD /CALL TO CRLF ROUTINE | |
530 | JMP I QNEWLIN /END OF PRINT | |
531 | RESTOR, JMS I QLODSN /OUTPUT LOAD STMT NUMBER | |
532 | CLA IAC /NO COLON NEEDED | |
533 | JMS GETFN /LOAD FILE REG | |
534 | TAD (REST /OUTPUT RESTORE OP | |
535 | JMP PUT2 | |
536 | PRFUN, | |
537 | LODSN, 0 /OUTPUT STMT NUMBER INTO CODE | |
538 | TAD NOSN /ANY STMT NUMBER ? | |
539 | SNA CLA | |
540 | JMP I LODSN /NO, JUST RETURN | |
541 | TAD WORD1 /NOW OUTPUT "LOAD STMT NUM REG" | |
542 | TAD (LOADSN | |
543 | JMS I QOUTWRD | |
544 | TAD WORD2 | |
545 | JMS I QOUTWRD | |
546 | JMP I LODSN | |
547 | ||
548 | XADD, FADD;AFADD | |
549 | \f/ DIM PROCESSOR | |
550 | PAGE | |
551 | DIM, JMS I QGETNAM /GET VAR NAME | |
552 | JMP DIMERR | |
553 | TAD TYPE /CHECK TYPE | |
554 | RTL /MOVE BITS TO BE TESTED | |
555 | SMA CLA /IF FUNC BIT SET THEN ERROR | |
556 | SNL /IF DIM BIT NOT SET THEN ERROR | |
557 | JMP DIMERR /NO DIMENSIONS | |
558 | JMS SMLNUM /GET DIMENSION | |
559 | TAD EXPON /SAVE IT | |
560 | DCA DIM1 | |
561 | JMS I QCOMARP /, OR ) ?? | |
562 | JMP DIMERR /NEITHER IS BAD | |
563 | JMP TWODIM /, THERE'S ANOTHER DIMENSION | |
564 | JMS CHKSDM /CHECK SIZE IF STRING | |
565 | JMP CHKDIM /NUMERIC VECTOR, CHECK PREV REF | |
566 | CLL CML RAR /THIS WAS A STRING SIZE DIM | |
567 | DCA TYPE /PERFORM THE SPECIAL CASE | |
568 | JMS I QLOOKUP | |
569 | CDF 10 /OF NOT CHECKING PREVIOUS REFS | |
570 | JMP FINDIM | |
571 | TWODIM, JMS SMLNUM /GET SECOND | |
572 | JMS I QCHECKC /LOOK FOR ) | |
573 | -51 | |
574 | JMP DIMERR | |
575 | JMS CHKSDM /CHECK SIZE IF STRING ARRAY | |
576 | TAD (7000 /NUMERIC ARRAY | |
577 | CHKDIM, TAD (7000 /GET NUMBER OF DIMS | |
578 | DCA TEMP | |
579 | JMS I QLOOKUP /FIND ST ENTRY | |
580 | CDF 10 | |
581 | TAD I STPTR /LOOK AT DIM BITS | |
582 | AND (7000 /PREVIOUSLY REFERENCED ? | |
583 | SNA | |
584 | JMP UNREFD /NO | |
585 | SMA /IF MINUS, CAUSE ERROR | |
586 | TAD TEMP /COMPARE NUMBER | |
587 | SZA CLA | |
588 | JMP DIMERR /NUMBER OF DIMS DON'T MATCH | |
589 | DCA TEMP /ZERO TEMP | |
590 | UNREFD, CLL CML RAR /PUT IN DIMENSIONED BIT | |
591 | TAD TEMP /AND NUMBER OF DIMENSIONS | |
592 | CIA /NEGATE WHOLE MESS (4000=-4000) | |
593 | TAD I STPTR /TOGETHER WITH SYM NUMBER | |
594 | DCA I STPTR | |
595 | ISZ STPTR | |
596 | TAD DIM1 /NOW FIRST DIMENSION (IF 2) | |
597 | DCA I STPTR | |
598 | FINDIM, ISZ STPTR | |
599 | TAD EXPON /NOW SECOND (IF 2, OTHERWISE FIRST) | |
600 | DCA I STPTR | |
601 | CDF | |
602 | JMS I QCHECKC /LOOK FOR , | |
603 | -54 | |
604 | JMP I QNEWLIN /NONE, ASSUME END OF DIM | |
605 | JMP DIM /GET NEXT ELEMENT | |
606 | CHKSDM, 0 /CHECK SIZE OF STRINGS | |
607 | TAD TYPE /WAS THIS A STRING DIM ? | |
608 | SMA CLA | |
609 | JMP I CHKSDM /NO, RETURN IMMEDIATE | |
610 | ISZ CHKSDM /YES, SKIP ON RETURN | |
611 | TAD EXPON /SIZE MUST BE < 73 | |
612 | CLL | |
613 | TAD (-STRLIM-1 | |
614 | SNL CLA | |
615 | JMP I CHKSDM /OK, SIZE < 73 | |
616 | DIMERR, JMS I QERMSG /GIVE ERROR | |
617 | 0411 | |
618 | JMP I QREMARK /ABORT STMT | |
619 | \f/ NEXT PROCESSOR | |
620 | NEXTX, JMS I QGETNAM /GET INDEX VARIABLE | |
621 | JMP BADNXT | |
622 | JMS I QLOOKUP | |
623 | TAD TYPE /MUST BE NUMERIC | |
624 | SPA CLA | |
625 | JMP BADNXT /IT ISN'T | |
626 | JMS I QMODSET /N MODE | |
627 | NEXTL, TAD (-STACKA-3 | |
628 | TAD STACK /ANY FOR'S LEFT ? | |
629 | SPA CLA /(OK IF STACKA ABOVE 4000) | |
630 | JMP BADNXT /NO | |
631 | JMS I QPOP /GET LABEL ADDR | |
632 | DCA TEMP | |
633 | JMS I QPOP /GET LABEL FIELD | |
634 | DCA LUPFLD | |
635 | JMS I QPOP /GET STEP VAR | |
636 | TAD XLOAD /LOAD IT | |
637 | JMS I QOUTWRD | |
638 | JMS I (PSETJF /PATCH! | |
639 | TAD FINDEX /ADD IT TO STEP (FADD=0) | |
640 | JMS I QOUTWRD | |
641 | TAD LUPFLD /CREATE JUMP TO LOOP | |
642 | AND (70 | |
643 | CLL RTL | |
644 | TAD (JUMP | |
645 | JMS I QOUTWRD | |
646 | CLL CMA RAL /GET LABEL DEFINITION ADDR | |
647 | TAD TEMP | |
648 | JMS I QOUTWRD /OUTPUT IT AS LOW PART OF JUMP | |
649 | DIM1, | |
650 | LUPFLD, HLT | |
651 | CLL CML RAR /SET LABEL DEFINED BIT | |
652 | TAD LOCTRH /DEFINE END OF LOOP LABEL | |
653 | DCA I TEMP | |
654 | ISZ TEMP | |
655 | TAD LOCTRL | |
656 | DCA I TEMP | |
657 | CDF | |
658 | TAD STACK /BACK OFF STACK LEVEL | |
659 | DCA STKLVL | |
660 | JMS I QNOREGS /FORGET REGS | |
661 | TAD SYMBOL /IS THIS THE RIGHT NEXT ? | |
662 | CIA | |
663 | TAD FINDEX | |
664 | SNA CLA | |
665 | JMP I QNEWLIN /YES, FINISHED | |
666 | BADNXT, JMS I QERMSG /NEXT WITHOUT FOR | |
667 | 1606 | |
668 | JMP I QREMARK | |
669 | UMOPR, 40;1;UMRTNE-1 | |
670 | XLOAD, FLDA;AFLDA | |
671 | \f/ UDEF PROCESSOR (DEFINE USER FUNCTION) | |
672 | PAGE | |
673 | UDEF, ISZ NFUNS /ROOM FOR ANOTHER FUN ? | |
674 | JMS I QLETTER /GET FIRST LETTER | |
675 | JMP DEFBAD /ERROR IN DEFINE | |
676 | CLL RTL /PUT INTO HIGH ORDER | |
677 | RTL | |
678 | RTL | |
679 | DCA NAME1 /SAVE CHAR 1 | |
680 | JMS I QLETTER /GET SECOND LETTER | |
681 | JMP DEFBAD /ERROR | |
682 | TAD NAME1 /COMBINE THE TWO CHARS | |
683 | CIA | |
684 | DCA I FUNPTR /SAVE IN FUN TABLE | |
685 | ISZ FUNPTR | |
686 | JMS I QLETTER /GET THIRD LETTER | |
687 | JMP DEFBAD | |
688 | CIA /SAVE NEG OF THIRD LETTER | |
689 | DCA I FUNPTR | |
690 | ISZ FUNPTR /BUMP POINTER | |
691 | TAD M5 /NUMERIC ARG COUNT | |
692 | DCA TEMP / (MAX OF 4 ARGS) | |
693 | CLL CMA RTL /STRING ARG COUNT | |
694 | DCA TEMP2 / (MAX OF 2 ARGS) | |
695 | JMS I QCHECKC /IS IT A STRING FUN ? | |
696 | -44 | |
697 | SKP CLA | |
698 | CLL CML RAR /YES, SET TYPE OF FUNCTION | |
699 | DCA TYPE1 | |
700 | JMS I QCHECKC /LOOK FOR ( | |
701 | -50 | |
702 | JMP DEFBAD /ERROR IF MISSING | |
703 | DALOOP, JMS I QGETNAM /GET AN ARG | |
704 | JMP DEFBAD | |
705 | TAD TYPE /LOOK AT ITS TYPE | |
706 | CLL RAL /SHIFT TYPE BIT INTO LINK | |
707 | SZA CLA | |
708 | JMP DEFBAD /OTHER BITS MUST BE OFF | |
709 | SZL | |
710 | JMP STRARG /STRING ARG | |
711 | TAD TEMP /GET ARG NUMBER | |
712 | ISZ TEMP /INCREMENT IT | |
713 | JMP DAPUSH /GO SAVE IT | |
714 | DEFBAD, JMS I QERMSG /BAD USER DEF | |
715 | 2504 | |
716 | JMP I QREMARK | |
717 | STRARG, TAD TEMP2 /GET ARG NUMBER | |
718 | ISZ TEMP2 /AND INCREMENT IT | |
719 | JMP DAPUSH+1 | |
720 | JMP DEFBAD /TOO MANY STRING ARGS | |
721 | DAPUSH, TAD Q2 /ADJUST ARG NUMBER | |
722 | TAD Q2 /ADD 4 FOR NUM, 2 FOR STRING | |
723 | SPA | |
724 | CLA CLL CML RTR /FIRST ARG STAYS IN AC | |
725 | TAD TYPE /ADD IN TYPE BIT | |
726 | JMS I QPUSH /SAVE IT ON STACK | |
727 | JMS I QCOMARP /LOOK FOR , OR ) | |
728 | JMP DEFBAD /ERROR IF NEITHER | |
729 | JMP DALOOP /, GET NEXT ARG | |
730 | TAD TEMP2 /GET TOTAL NUMBER OF ARGS | |
731 | TAD TEMP | |
732 | TAD Q10 /ADJUST COUNT | |
733 | CIA /NEGATED | |
734 | DCA DACNT | |
735 | TAD I FUNPTR /GET FUNCTION CODE | |
736 | ISZ FUNPTR /BUMP POINTER | |
737 | DCA WORD1 /MAKE IT THE SEARCH OBJECT | |
738 | JMS I XSTCHEK /MAKE SURE THERE'S ROOM | |
739 | EOST-10 | |
740 | JMS I QLUKUP2 /ENTER NEW FUNCTION | |
741 | FUNCTN | |
742 | -1 | |
743 | TAD DACNT /PUT IN ARG COUNT | |
744 | JMS SETFLD /(FIRST SET THE FIELD) | |
745 | DCA I NEXT | |
746 | DAPUT, CDF | |
747 | JMS I QPOP /GET ARG TYPE (LAST TO FIRST) | |
748 | JMS SETFLD /SET THE FIELD | |
749 | DCA I NEXT /SAVE IT | |
750 | ISZ DACNT /ANY MORE ? | |
751 | JMP DAPUT /YES | |
752 | TAD TYPE1 /PUT IN TYPE OF FUNCTION | |
753 | DCA I NEXT | |
754 | CDF | |
755 | JMS I QCHECKC /LOOK FOR A COMMA | |
756 | -54 | |
757 | JMP I QNEWLIN /NO COMMA, END OF LINE | |
758 | JMP UDEF /GET NEXT DEFINITION | |
759 | XSTCHEK,STCHEK | |
760 | FUNPTR, ENDFNS | |
761 | Q2, 2 /THESE FOUR WORDS | |
762 | M5, -5 /PREVENT ERRONEOUS "SAVES" | |
763 | Q10, 10 /BY THE ROUTINE SAVAC | |
764 | NFUNS, -21 /WHEN THE OP STACK IS EMPTY | |
765 | STACKO, /OPERAND STACK | |
766 | STOKSZ=UDEF+200-STACKO | |
767 | \f/ DEF PROCESSOR | |
768 | PAGE | |
769 | DEF, JMS I QNOREGS /FORGET REGS | |
770 | JMS I QGETNAM /GET FUN NAME | |
771 | JMP BADDEF /NO GOOD | |
772 | TAD TYPE /SAVE ITS TYPE | |
773 | DCA TEMP2 | |
774 | DCA ARGCNT /ZERO ARG COUNT | |
775 | TAD TYPE /TYPE MUST BE 3000 OR 7000 | |
776 | RTL /MOVE BITS TO BE TESTED | |
777 | SPA CLA /FUN BIT OFF IS AN ERROR | |
778 | SNL /DIM BIT OFF IS AN ERROR | |
779 | JMP BADDEF | |
780 | JMS I QMODSET /ENTER N MODE | |
781 | TAD SYMBOL /SAVE FUNCTION NAME | |
782 | DCA FUNNAM | |
783 | ARGLUP, JMS I QGETNAM /GET ARG NAME | |
784 | JMP BADDEF | |
785 | CLL CMA RAR /LOOK AT TYPE | |
786 | AND TYPE | |
787 | SZA CLA | |
788 | JMP BADDEF /ARG WAS AN ARRAY OR FUNC | |
789 | JMS I QLOOKUP /ENTER INTO S.T. | |
790 | TAD STPTR /SAVE ST ADDRESS | |
791 | JMS I QPUSH | |
792 | TAD SYMBOL /AND SYMBOL NUMBER | |
793 | JMS I QPUSH | |
794 | TAD TYPE /AND ARG TYPE | |
795 | JMS I QPUSH | |
796 | ISZ ARGCNT /BUMP ARG COUNT | |
797 | JMS I QCOMARP /LOOK FOR , OR ) | |
798 | JMP BADDEF | |
799 | JMP ARGLUP /, GET NEXT ARG | |
800 | TAD FUNNAM /ENTER FUNCTION | |
801 | DCA WORD1 | |
802 | TAD ARGCNT /FIRST GET ENOUGH ROOM | |
803 | CIA | |
804 | TAD (EOST-3 | |
805 | DCA FUNNAM | |
806 | JMS STCHEK /CHECK IT | |
807 | FUNNAM, 0 | |
808 | JMS I QLUKUP2 /LOOK UP FUNCTION | |
809 | FUNCTN | |
810 | -1 | |
811 | JMP OKFUN /OK, NOT MULTIPLY DEFINED | |
812 | BADDEF, JMS I QERMSG /BAD DEFINE | |
813 | 0405 | |
814 | JMP I QREMARK | |
815 | OKFUN, TAD NEXT /SAVE "NEXT" | |
816 | DCA X12 | |
817 | TAD NEXT /INCREMENT NEXT BY | |
818 | TAD ARGCNT /NUMBER OF ARGS | |
819 | TAD (4 /PLUS 4 | |
820 | DCA NEXT | |
821 | JMS SETFLD /GET ROOM FOR LABEL | |
822 | CLL CML RAR /FOR JUMP AROUND | |
823 | DCA I NEXT /SET DEFINED BIT | |
824 | TAD NEXT /SAVE ADDR | |
825 | DCA JAROND /FOR LATER | |
826 | ISZ NEXT | |
827 | CDF | |
828 | TAD LUFLD /SAVE FIELD OF FUN BLOCK | |
829 | DCA FUNFLD | |
830 | TAD LUFLD /ALSO FIELD OF LABEL | |
831 | DCA JARFLD | |
832 | TAD LUFLD /GET FIELD | |
833 | AND (70 /ISOLATE BITS | |
834 | CLL RTL /INTO JUMP INSTR | |
835 | TAD (JUMP | |
836 | JMS I QOUTWRD /OUTPUT IT | |
837 | TAD JAROND /OUTPUT LOW PART | |
838 | JMS I QOUTWRD /OF JUMP ADDR | |
839 | TAD STACK /SAVE STACK | |
840 | DCA OLDSTK | |
841 | TAD ARGCNT /GET COUNT | |
842 | CMA | |
843 | DCA TEMP | |
844 | TAD ARGCNT /TWICE | |
845 | CIA | |
846 | DCA ARGCNT | |
847 | TAD ARGCNT /STORE COUNT FIRST | |
848 | JMP FUNFLD | |
849 | CHGARG, CDF | |
850 | JMS I QPOP /GET ARG TYPE | |
851 | DCA TYPE | |
852 | TAD TYPE | |
853 | JMS GENTMP /GENERATE A TEMPORARY | |
854 | SWTARG, JMS I QPOP /PURGE SYMBOL NUMBER | |
855 | CLA | |
856 | JMS I QPOP /GET ST ADDR OF | |
857 | DCA STPTR /OF DUMMY ARG | |
858 | CDF 10 | |
859 | TAD SYMBOL /PUT IN TEMP SYMBOL NUMBER | |
860 | DCA I STPTR /TO FAKE EXPR | |
861 | TAD TYPE /CREATE ARG DESCRIPTOR | |
862 | TAD SYMBOL /FOR FUNC BLOCK | |
863 | FUNFLD, HLT | |
864 | DCA I X12 /AND PUT IT INTO F.B. | |
865 | ISZ TEMP /MORE ARGS? | |
866 | JMP CHGARG /YUP | |
867 | CLL CML RAR | |
868 | AND TEMP2 /SAVE TYPE OF FUNCTION | |
869 | DCA I X12 | |
870 | CLL CML RAR /SET DEFINED BIT | |
871 | TAD LOCTRH /AND LOCATION COUNTER | |
872 | DCA I X12 /AT START OF FUNCTION | |
873 | TAD LOCTRL | |
874 | DCA I X12 | |
875 | CDF | |
876 | TAD STACK /SAVE BOTTOM OF STACK | |
877 | DCA X13 | |
878 | TAD OLDSTK /RESTORE TO TOP | |
879 | DCA STACK | |
880 | JMS I QCHECKC /FIND = | |
881 | -75 | |
882 | JMP BADDEF | |
883 | JMS I QEXPR /COMPILE FUNCTION | |
884 | JMP I QREMARK | |
885 | JMS I QLOAD /GET IT INTO AC | |
886 | TAD X13 /RESTORE STACK | |
887 | DCA STACK /TO BOTTOM | |
888 | JMP RESARG /FINISH DEF | |
889 | \f/ DEF PROCESSOR (FINALE) | |
890 | PAGE | |
891 | RESARG, TAD I X13 /GET ST ADDR | |
892 | DCA STPTR | |
893 | TAD I X13 /PUT BACK CORRECT SYM # | |
894 | CDF 10 | |
895 | DCA I STPTR | |
896 | CDF | |
897 | ISZ X13 /SKIP OTHER STUFF | |
898 | ISZ ARGCNT | |
899 | JMP RESARG /RESTORE NEXT | |
900 | TAD (RET /OUTPUT RETURN CODE | |
901 | JMS I QOUTWRD | |
902 | JARFLD, HLT | |
903 | CLL CML RAR /SET LABEL DEFINED BIT | |
904 | TAD LOCTRH /STICK IN ADDR | |
905 | DCA I JAROND /OF END OF FUNCT | |
906 | ISZ JAROND /PLUS ONE | |
907 | TAD LOCTRL /STORE LOW ADDR | |
908 | DCA I JAROND | |
909 | CDF | |
910 | TAD TMPCNT /SAVE NEW TEMP LEVELS | |
911 | DCA TMPLVL | |
912 | TAD STMPCT | |
913 | DCA STMPLV | |
914 | JMS I QNOREGS /FORGET REGS | |
915 | JMP I QNEWLIN /END OF DEF | |
916 | \f/ DATA STATEMENT PROCESSOR | |
917 | DATA, JMS I QNUMBER /LOOK FOR NUMBER | |
918 | JMP DSTRNG /MUST BE A STRING | |
919 | JMS DENTRY /MAKE AN ENTRY | |
920 | -3 /3 WORDS LONG | |
921 | MORDAT, JMS I QCHECKC /LOOK FOR , | |
922 | -54 | |
923 | JMP I QNEWLIN /END OF DATA | |
924 | JMP DATA /DO NEXT ELEMENT | |
925 | DSTRNG, JMS I QSTRING /LOOK FOR STRING | |
926 | JMP I QNEWLIN /BAD | |
927 | TAD WORD1 /COMPUTE SIZE | |
928 | IAC | |
929 | CLL CML CMA RAR | |
930 | DCA DSSIZE /INCLUDING CHAR COUNT | |
931 | TAD WORD1 /NEGATE COUNT | |
932 | CIA | |
933 | DCA WORD1 | |
934 | JMS DENTRY /CREATE ENTRY | |
935 | DSSIZE, 0 | |
936 | JMP MORDAT /GO DO MORE | |
937 | DENTRY, 0 /MAKE AN ENTRY IN DATA LIST | |
938 | TAD I DENTRY /GET SIZE | |
939 | DCA TEMP | |
940 | ISZ DENTRY | |
941 | TAD TEMP /INCREMENT SIZE COUNT | |
942 | TAD DLSIZE | |
943 | DCA DLSIZE | |
944 | TAD (EOST /HOW MUCH DO WE NEED ? | |
945 | TAD TEMP | |
946 | DCA .+2 | |
947 | JMS STCHEK /ASK FOR IT | |
948 | 0 | |
949 | TAD FREFLD /GET FIELD OF FREE SPACE | |
950 | DCA LUFLD /SAVE IT IN SETFLD SUBROUTINE | |
951 | DATFLD, CDF 10 | |
952 | TAD NEXT /HOOK IN NEW ENTRY | |
953 | IAC | |
954 | DCA I DATPTR | |
955 | PATCH3, ISZ DATPTR /POINTER THEN FIELD | |
956 | TAD LUFLD | |
957 | DCA I DATPTR | |
958 | JMS SETFLD | |
959 | TAD TEMP /SAVE SIZE OF ENTRY | |
960 | DCA I NEXT | |
961 | TAD (WORD1-1/MAKE READY TO MOVE | |
962 | DCA X10 | |
963 | DELOOP, CDF | |
964 | TAD I X10 /GET WORD | |
965 | JMS SETFLD | |
966 | DCA I NEXT /SAVE IT | |
967 | ISZ TEMP /MORE ? | |
968 | JMP DELOOP | |
969 | DCA I NEXT /SAVE ROOM FOR POINTER&CDF | |
970 | TAD NEXT /THIS IS NOW LAST ENTRY | |
971 | DCA DATPTR | |
972 | PATCH4, TAD LUFLD | |
973 | DCA DATFLD /AND THIS IS ITS FIELD | |
974 | DCA I NEXT | |
975 | CDF | |
976 | JMP I DENTRY | |
977 | DATPTR, DATLST | |
978 | \f/ READ PROCESSOR | |
979 | READX, JMS I QLODSN /OUTPUT STMT NUMBER | |
980 | CLL CML RAR /GET VAR TO READ | |
981 | JMS I QEXPR /SAME AS LEFT SIDE OF LET | |
982 | JMP I QREMARK | |
983 | JMS I QGETA1 /GET VAR INFO FROM STACK | |
984 | TAD TYPE1 /SET MODE | |
985 | JMS I QMODSET | |
986 | TAD TYPE1 /WHAT TYPE ? | |
987 | SPA CLA | |
988 | TAD (SRDL-NRDL | |
989 | TAD (NRDL /STRING OR NUMERIC | |
990 | JMS I QOUTWRD | |
991 | CLL CML RTR /SUBSCRIPTS ? | |
992 | AND TYPE1 | |
993 | SNA CLA | |
994 | JMP .+3 /NO | |
995 | JMS I QLOADSS /YES, LOAD SS REGS | |
996 | TAD (AFSTA-FSTA | |
997 | TAD (FSTA /ARRAY OR SCALAR STORE | |
998 | TAD SYMBL1 | |
999 | JMS I QOUTWRD | |
1000 | JMS I QCHECKC /ANY MORE ? | |
1001 | -54 /CHECK FOR COMMA | |
1002 | JMP I QNEWLIN /NO | |
1003 | JMP READX+1 /YUP | |
1004 | AMPSND, 40;1;AMPRTN-1;4000;SCONTS;SCONTS | |
1005 | SCONTS, FADD;AISUB | |
1006 | \f/ FOR PROCESSOR | |
1007 | PAGE | |
1008 | FOR, JMS I QLODSN /OUTPUT STMT NUMBER | |
1009 | JMS I QGETNAM /GET INDEX VARIABLE | |
1010 | JMP BADFOR /BAD | |
1011 | TAD TYPE /MUST BE NUMBER | |
1012 | SZA CLA | |
1013 | JMP BADFOR /ITS NOT | |
1014 | JMS I QLOOKUP /ST SEARCH | |
1015 | TAD SYMBOL /SAVE INDEX VAR | |
1016 | DCA FINDEX /FOR LATER | |
1017 | JMS I QCHECKC /FIND = | |
1018 | -75 | |
1019 | JMP BADFOR | |
1020 | TAD CHRPTR /SAVE CHAR POSITION | |
1021 | DCA FORCP /IN A SPECIAL PLACE | |
1022 | TAD NCHARS | |
1023 | DCA FORNC | |
1024 | SKP | |
1025 | FINDTO, JMS I QRESTCP /RESTORE CHAR POS | |
1026 | JMS I QGETC /SKIP A CHAR | |
1027 | JMP BADFOR | |
1028 | CLA | |
1029 | JMS I QSAVECP /SAVE THIS POSITION | |
1030 | JMS I QCHKWD /LOOK FOR "TO" | |
1031 | WTO | |
1032 | JMP FINDTO /KEEP GOING | |
1033 | JMS FSUB2 /LOAD LIMIT AND SAVE IN TEMP | |
1034 | DCA FLIMIT /SAVE LIMIT VAR | |
1035 | JMS I QCHKWD /LOOK FOR "STEP" | |
1036 | WSTEP | |
1037 | JMP STEP1 /USE 1.0 FOR THE STEP | |
1038 | JMS FSUB2 /LOAD STEP AND SAVE IN TEMP | |
1039 | DCA FSTEP /SAVE STEP VAR | |
1040 | TAD (SETJF /OUTPUT SETJF | |
1041 | JMS I QOUTWRD | |
1042 | TAD (JFOR /STEP IS VARIABLE, USE JFOR | |
1043 | SAVEJF, DCA FORJMP /SAVE CORRECT JUMP | |
1044 | JMS I QGETC /ANY MORE CHARS ? | |
1045 | SKP | |
1046 | JMP BADFOR /YES, ERROR | |
1047 | TAD FORNC /RESTORE CHAR POSITION | |
1048 | DCA NCHARS /FROM SPECIAL PLACE | |
1049 | TAD FORCP | |
1050 | DCA CHRPTR | |
1051 | JMS FSUB1 /COMPILE INITIAL VALUE INTO FAC | |
1052 | JMS STCHEK /CHECK FOR ROOM | |
1053 | EOST | |
1054 | TAD FREFLD /SAVE FIELD OF LABELS | |
1055 | DCA FORFLD | |
1056 | FORFLD, HLT | |
1057 | CLL CML RAR /SET LABEL DEFINED BIT | |
1058 | TAD LOCTRH /DEFINE THE LOOP LABEL | |
1059 | DCA I NEXT | |
1060 | TAD LOCTRL | |
1061 | DCA I NEXT | |
1062 | CLL CML RAR /SET LABEL DEFINED BIT | |
1063 | DCA I NEXT /FOR END OF LOOP LABEL | |
1064 | CDF | |
1065 | TAD FLIMIT /TEST FOR DONE | |
1066 | TAD XSUB /BY SUBTRACTING THE LIMIT | |
1067 | JMS I QOUTWRD | |
1068 | TAD FORFLD /OUTPUT JUMP TO DONE | |
1069 | AND (70 | |
1070 | CLL RTL /SHIFT FIELD BITS | |
1071 | TAD FORJMP /USE PROPER JUMP INS | |
1072 | JMS I QOUTWRD | |
1073 | TAD NEXT /OUTPUT LOW PART OF JMP | |
1074 | JMS I QOUTWRD | |
1075 | TAD FLIMIT /FADD FLIMIT (FADD=0) | |
1076 | JMS I QOUTWRD | |
1077 | TAD FINDEX /FSTA INDEX | |
1078 | TAD (FSTA | |
1079 | JMS I QOUTWRD | |
1080 | TAD FINDEX /PUT STUFF ONTO STACK | |
1081 | JMS I QPUSH | |
1082 | TAD FSTEP | |
1083 | JMS I QPUSH | |
1084 | TAD FORFLD | |
1085 | JMS I QPUSH | |
1086 | TAD NEXT | |
1087 | JMS I QPUSH | |
1088 | ISZ NEXT /BUMP NEXT AGAIN | |
1089 | TAD TMPCNT /RESERVE THESE TEMPS | |
1090 | DCA TMPLVL | |
1091 | JMS I QNOREGS /FORGET REGISTORS | |
1092 | TAD STACK /SET NEW STACK LEVEL | |
1093 | DCA STKLVL | |
1094 | JMP I QREMARK | |
1095 | STEP1, TAD (3 /1.0 IS SLOT #3 | |
1096 | DCA FSTEP | |
1097 | TAD (JGT /USE JGT | |
1098 | JMP SAVEJF /GO DO THE REST | |
1099 | FLIMIT, 0 /FOR LOOP UPPER LIMIT | |
1100 | FSTEP, 0 /FOR LOOP STEP | |
1101 | FORNC, 0 /FOR STMT CHAR POSITION | |
1102 | FORCP, 0 | |
1103 | WTHEN, -124;-110;-105;-116 | |
1104 | XSUB, FSUB;AFSUB | |
1105 | \f/ USE PROCESSOR | |
1106 | USEX, TAD (USE /OUTPUT USE OPERATOR | |
1107 | JMS I QOUTWRD | |
1108 | JMS I QGETNAM /GET ARRAY NAME | |
1109 | JMP USEERR /ERROR | |
1110 | TAD TYPE /CHECK TYPE | |
1111 | SMA CLA /(MUST BE NUMERIC) | |
1112 | JMP .+3 /IT WAS | |
1113 | USEERR, JMS I QERMSG /ERROR IN USE STMT | |
1114 | 2525 | |
1115 | CLL CML RTR /SET DIM BIT | |
1116 | DCA TYPE | |
1117 | JMS I QLOOKUP /LOOKUP SYMBOL | |
1118 | TAD SYMBOL /OUTPUT ARRAY NUMBER | |
1119 | JMS I QOUTWRD | |
1120 | JMP I QREMARK | |
1121 | \f/ IF AND IFEND PROCESSORS | |
1122 | PAGE | |
1123 | IF, JMS I QLODSN /OUTPUT STMT NUMBER | |
1124 | JMS I QEXPR /GET LEFT EXPRESSION | |
1125 | JMP I QREMARK | |
1126 | JMS I QGETC /GET RELATIONAL OPERATOR | |
1127 | JMP BADIF /ERROR IF NONE | |
1128 | CLL RTL | |
1129 | RTL /MOVE TO LEFT HALF | |
1130 | RTL | |
1131 | DCA TEMP /AND SAVE IT | |
1132 | JMS I QGETC /GET 2 CHAR RELATIONALS | |
1133 | JMP BADIF | |
1134 | TAD TEMP /COMBINE THE 2 | |
1135 | DCA TEMP2 | |
1136 | TAD (IFOPS-1/SETUP POINTER | |
1137 | DCA X10 | |
1138 | IFLUP1, TAD I X10 /GET JUMP OPCODE | |
1139 | SNA | |
1140 | JMP IFLUP2-1/NOT A 2 CHAR RELATIONAL | |
1141 | DCA RELOPR /SAVE IT | |
1142 | TAD I X10 /COMPARE CHARS | |
1143 | TAD TEMP2 | |
1144 | SZA CLA | |
1145 | JMP IFLUP1 /NOT THIS OOE | |
1146 | GOTREL, JMS I QEXPR /GET RIGHT HALF | |
1147 | JMP I QREMARK | |
1148 | CLA CMA /GET TYPE OF RIGHT SIDE | |
1149 | TAD OSTACK | |
1150 | DCA TEMP | |
1151 | TAD I TEMP | |
1152 | SPA CLA | |
1153 | JMP STRCMP /STRING, DO STRING COMPARE | |
1154 | TAD (MINUS /NUMERIC, DO A SUBTRACT | |
1155 | JMS I QOUTOPR | |
1156 | NUMCMP, JMS I QSAVECP /SAVE CHAR POSITION | |
1157 | JMS I QCHKWD /LOOK FOR "THEN" | |
1158 | WTHEN | |
1159 | JMP NOTHEN /NOT THEN | |
1160 | GETIFN, JMS I QSNUM /GET STATEMENT NUMBER | |
1161 | JMP BADGO2 | |
1162 | TAD TEMP /OUTPUT JUMP | |
1163 | TAD RELOPR | |
1164 | JMS I QOUTWRD | |
1165 | TAD TEMP2 /TWO WORDS | |
1166 | JMS I QOUTWRD | |
1167 | JMP I QNEWLIN | |
1168 | NOTHEN, JMS I QRESTCP /BACKUP CHAR POS | |
1169 | JMS I QCHKWD /LOOK FOR "GOTO" | |
1170 | WGOTO | |
1171 | SKP | |
1172 | JMP GETIFN /OK, GO GET STMT NUMBER | |
1173 | BADIF, JMS I QERMSG /BAD IF STMT | |
1174 | 1106 | |
1175 | JMP I QREMARK | |
1176 | STRCMP, TAD (SCOMPR-1 | |
1177 | JMS I QOUTOPR /OUTPUT STRING COMPARE | |
1178 | JMS I QMODSET /BACK TO N MODE | |
1179 | JMP NUMCMP /REST IS LIKE NUMERIC COMPARES | |
1180 | JMS I QBACK1 /PUT BACK NON OPERATOR | |
1181 | IFLUP2, TAD I X10 /GET CONDITIONAL JUMP | |
1182 | SNA | |
1183 | JMP BADIF /RELATIONAL INCORRECT | |
1184 | DCA RELOPR | |
1185 | TAD I X10 /COMPARE OPERATORS | |
1186 | TAD TEMP | |
1187 | SNA CLA | |
1188 | JMP GOTREL /GOTIT | |
1189 | JMP IFLUP2 | |
1190 | IFEND, JMS I QLODSN /OUTPUT STMT NUMBER | |
1191 | CLA IAC /(NO COLON) | |
1192 | JMS GETFN /GET FILE NUMBER | |
1193 | TAD (JEOF /SETUP CORRECT JUMP | |
1194 | DCA RELOPR | |
1195 | JMP NUMCMP /GO FIND "THEN" OR "GOTO" | |
1196 | RELOPR, | |
1197 | GETFN, 0 /GET FILE NUMBER | |
1198 | DCA COLON /SAVE COLON SWITCH | |
1199 | JMS I QCHECKC /LOOK FOR # | |
1200 | -43 | |
1201 | JMP TTYFIL /NONE, MUST BE TTY | |
1202 | JMS I QEXPR /GET FILE EXPR | |
1203 | JMP I QREMARK /ERROR | |
1204 | TAD COLON /DO WE NEED A COLON ? | |
1205 | SZA CLA | |
1206 | JMP .+4 /NO, SKIP THIS TEST | |
1207 | JMS I QCHECKC /YES, LOOK FOR IT | |
1208 | -72 | |
1209 | JMP BADFN /NOT THERE, BAD | |
1210 | JMS I QLOAD /LOAD IT | |
1211 | TAD TYPE1 /TYPE MUST BE NUMERIC | |
1212 | SPA CLA | |
1213 | BADFN, JMS I QERMSG /NOPE, IT ISN'T | |
1214 | 0616 | |
1215 | CLA IAC /SET IFNREG TO "NOT TTY" | |
1216 | DCA IFNREG /SAVE NEW IFNREG | |
1217 | TAD (FILENO /OUTPUT SET IFN COMMAND | |
1218 | JMS I QOUTWRD | |
1219 | JMP I GETFN | |
1220 | TTYFIL, TAD IFNREG /IS IFNREG 0 ? | |
1221 | SNA CLA | |
1222 | JMP I GETFN /IF YES, QUIT | |
1223 | TAD (CLRFN /OTHERWISE ZERO AC | |
1224 | JMS I QOUTWRD | |
1225 | DCA IFNREG /SET IFNREG TO TTY | |
1226 | JMP I GETFN /RETURN | |
1227 | \f/ GOTO AND GOSUB | |
1228 | GOTO, JMS I QSNUM /GET NUMBER | |
1229 | JMP BADGO2 | |
1230 | JMS I QMODSET /ALL GOTO'S IN NMODE | |
1231 | CLA IAC /JUMP=JSUB+1 | |
1232 | JMP .+5 | |
1233 | GOSUB, JMS I QLODSN /OUTPUT STMT NUM LOAD | |
1234 | JMS I QSNUM /GET NUMBER | |
1235 | JMP BADGO2 | |
1236 | JMS I QMODSET /ALL GOTO'S IN NMODE | |
1237 | TAD (JSUB /GET GOSUB OPCODE | |
1238 | TAD TEMP /PLUS ADDRESS | |
1239 | JMS I QOUTWRD /OUTPUT IT | |
1240 | TAD TEMP2 /BOTH WORDS | |
1241 | JMS I QOUTWRD | |
1242 | JMP I QNEWLIN | |
1243 | BADGO2, JMS I QERMSG /BAD GOTO OR GOSUB | |
1244 | 1615 /NUMBER MISSING | |
1245 | JMP I QREMARK | |
1246 | \f/ TABLE SEARCH FOR LITERALS, STMT NUMBERS, TEMPS, ETC. | |
1247 | PAGE | |
1248 | LUKUP2, 0 | |
1249 | TAD I LUKUP2 /GET THE BUCKET START | |
1250 | DCA OLDN3 /SAVE IT AS THE PREVIOUS ENTRY | |
1251 | ISZ LUKUP2 | |
1252 | TAD I LUKUP2 /GET THE ENTRY SIZE | |
1253 | ISZ LUKUP2 | |
1254 | DCA N3SIZE | |
1255 | TAD (6211 /PRIME THE FIELD SETTER | |
1256 | DCA LUFLD | |
1257 | JMS SETFLD /NOW SET THE FIELD | |
1258 | LOOK2, TAD I OLDN3 /GET ADDR OF NEXT ENTRY | |
1259 | DCA NEWN3 /SAVE IT | |
1260 | PATCH1, ISZ OLDN3 /GET TO FIELD OF NEW ENTRY | |
1261 | TAD I OLDN3 /GET INTO AC | |
1262 | DCA NEWFLD /AND SAVE IT | |
1263 | TAD NEWN3 | |
1264 | SNA | |
1265 | JMP HOOKIN /IF 0 ITS END OF LIST | |
1266 | PATCH5, IAC | |
1267 | DCA X10 /START OF VALUE INFO | |
1268 | TAD (WORD1-1/SETUP POINTER TO VALUE | |
1269 | DCA X11 | |
1270 | TAD N3SIZE /AND TEMP OF ENTRY SIZE | |
1271 | DCA LTEMP | |
1272 | CHKVAL, CDF | |
1273 | TAD I X11 | |
1274 | CIA CLL /COMPARE THIS WORD | |
1275 | NEWFLD, CDF 10 /FIELD OF NEW ENTRY | |
1276 | TAD I X10 | |
1277 | SZA CLA | |
1278 | JMP NOTSAM /NOT THIS ONE | |
1279 | ISZ LTEMP /INCR SIZE COUNT | |
1280 | JMP CHKVAL /MORE STUFF | |
1281 | TAD I X10 /GET SYMBOL NUMBER | |
1282 | L6201, CDF | |
1283 | DCA SYMBOL | |
1284 | TAD NEWFLD /MAKE ENTRY ADDRESSABLE | |
1285 | DCA LUFLD /THROUGH SETFLD | |
1286 | ISZ LUKUP2 /BUMP RETURN | |
1287 | JMP I LUKUP2 | |
1288 | NOTSAM, SZL | |
1289 | JMP HOOKIN /NEW SYMBOL < CURRENT | |
1290 | TAD NEWN3 /GO TO NEXT ENTRY | |
1291 | DCA OLDN3 /(MOVE POINTER) | |
1292 | TAD NEWFLD /(AND FIELD) | |
1293 | DCA LUFLD | |
1294 | JMP LOOK2 | |
1295 | HOOKIN, CLL CMA RAL /HOW MANY WORDS NEEDED ? | |
1296 | TAD N3SIZE | |
1297 | TAD (EOST | |
1298 | DCA .+2 | |
1299 | JMS STCHEK /MAKE SURE | |
1300 | 0 /WE GOT ENOUGH | |
1301 | TAD NEWN3 /HOOK IN NEW ENTRY | |
1302 | FREFLD, CDF 10 /CHANGE TO FREE FIELD | |
1303 | DCA I NEXT | |
1304 | PATCH2, TAD NEWFLD /HOOK IN FIELD | |
1305 | DCA I NEXT | |
1306 | JMS SETFLD /BACK TO FIELD OF OLD | |
1307 | TAD FREFLD /PUT FIELD OF NEW | |
1308 | DCA I OLDN3 | |
1309 | CLA CMA /BACK UP OLDN3 | |
1310 | TAD OLDN3 /SO THAT IT POINTS TO POINTER | |
1311 | DCA OLDN3 | |
1312 | CLA CMA | |
1313 | TAD NEXT /PUT POINTER TO NEW ENTRY | |
1314 | DCA I OLDN3 /INTO OLD | |
1315 | TAD FREFLD /SAVE ENTRY FIELD | |
1316 | DCA LUFLD /FOR POSSIBLE POST PROCESSING | |
1317 | TAD (WORD1-1/PREPARE TO STICK IN THE VALUE | |
1318 | DCA X11 | |
1319 | ENTERV, CDF | |
1320 | TAD I X11 /MOVE IN THE VALUE | |
1321 | FFLD2, CDF 10 | |
1322 | DCA I NEXT | |
1323 | ISZ N3SIZE /INCR SIZE COUNT | |
1324 | JMP ENTERV | |
1325 | CDF | |
1326 | JMP I LUKUP2 | |
1327 | STCHEK, 0 /CHECK FOR ENOUGH ROOM | |
1328 | TAD NEXT /CHECK FOR OVERFLOW | |
1329 | CIA CLL | |
1330 | CDF | |
1331 | TAD I STCHEK /THIS IS LIMIT | |
1332 | ISZ STCHEK | |
1333 | SZL CLA | |
1334 | JMP I STCHEK | |
1335 | TAD FREFLD /BUMP FREE FIELD | |
1336 | TAD (10 | |
1337 | DCA FREFLD | |
1338 | TAD FREFLD /PUT IN TWO PLACES | |
1339 | DCA FFLD2 | |
1340 | DCA NEXT /START POINTER AT 0 | |
1341 | ISZ NFLDS /GONE TOO FAR ? | |
1342 | JMP I STCHEK /NO | |
1343 | STOVER, JMS I QERMSG /S.T. FULL | |
1344 | 2324 | |
1345 | JMP I XABORT /ABORT COMPILATION | |
1346 | OLDN3, 0 /ADDR OF PREVIOUS ENTRY | |
1347 | NEWN3, 0 /ADDR OF NEW ENTRY | |
1348 | LTEMP, 0 | |
1349 | NFLDS, 0 /- COUNT OF AVAILABLE FIELDS | |
1350 | N3SIZE, /SIZE OF ENTRY | |
1351 | KBDCHK, 0 /CHECK FOR ^C OR ^O | |
1352 | KSF | |
1353 | JMP I KBDCHK /NO CHAR | |
1354 | KRB | |
1355 | AND (177 /REMOVE PARITY BIT | |
1356 | TAD (-3 /^C ?? | |
1357 | SNA | |
1358 | JMP I XABORT /YES, EXIT TO OS8 | |
1359 | TAD (3-17 /^O ?? | |
1360 | SZA CLA | |
1361 | JMP I KBDCHK /NO, RETURN | |
1362 | DCA TTX+1 /NOP TTY OUTPUT ROUTINE | |
1363 | JMP I KBDCHK | |
1364 | / | |
1365 | WSTEP, -123;-124;-105;-120;0 | |
1366 | \f/ SYMBOL TABLE LOOKUP | |
1367 | PAGE | |
1368 | LOOKUP, 0 /LOOK UP SYMBOL | |
1369 | TAD NAME1 /GET NAME1*11+NAME2 | |
1370 | CLL RTL | |
1371 | TAD NAME1 | |
1372 | CLL RAL | |
1373 | TAD NAME1 | |
1374 | TAD NAME2 | |
1375 | DCA NAME1 /THIS IS IT | |
1376 | TAD TYPE /WHAT KIND SYMBOL ? | |
1377 | CLL RTL /MOVE TYPE BITS | |
1378 | RTL /INTO AC 9,10,11 | |
1379 | TAD JTABLE | |
1380 | DCA .+1 | |
1381 | VCPTR, 0 /GO THERE | |
1382 | JTABLE, JMP I .+1 | |
1383 | LUVAR | |
1384 | LURETN | |
1385 | LUARAY | |
1386 | LURETN | |
1387 | LUSTRG | |
1388 | LURETN | |
1389 | LUSARY | |
1390 | LURETN | |
1391 | LUVAR, TAD (VARCNT /POINTER TO VAR COUNT | |
1392 | DCA VCPTR | |
1393 | TAD (VARST-13 | |
1394 | DOLU, TAD NAME1 | |
1395 | DCA STPTR /ST POINTER | |
1396 | CDF 10 /THATS WHERE ST IS | |
1397 | TAD I STPTR /IS THIS VAR DEFINED YET ? | |
1398 | SMA | |
1399 | JMP GOTSYM /YES | |
1400 | TAD (4401 /GET 401 INTO AC | |
1401 | CHEKST, CDF | |
1402 | TAD I VCPTR /PLUS VAR COUNT | |
1403 | CDF 10 | |
1404 | DCA SYMBOL /THATS THE NEW SYMBOL NUMBER | |
1405 | TAD SYMBOL /PUT SYMBOL NUMBER | |
1406 | DCA I STPTR /INTO S.T. ENTRY | |
1407 | CDF | |
1408 | ISZ I VCPTR /BUMP SYMBOL NUMBER | |
1409 | LURETN, JMP I LOOKUP | |
1410 | JMP STOVER /S.T. OVERFLOW | |
1411 | GOTSYM, DCA SYMBOL /PUT NUMBER INTO SYMBOL | |
1412 | CDF | |
1413 | JMP I LOOKUP | |
1414 | LUSTRG, TAD (SVCNT /POINTER TO STRING VAR COUNT | |
1415 | DCA VCPTR | |
1416 | TAD (SVARST-26 | |
1417 | TAD NAME1 /TWO WORDS PER ENTRY | |
1418 | JMP DOLU | |
1419 | LUARAY, TAD (ACNT /ARRAY VAR COUNT | |
1420 | DCA VCPTR | |
1421 | TAD (ARAYST /ARRAY SYMBOL TABLE | |
1422 | DCA STPTR | |
1423 | CDF 10 | |
1424 | FINDA, TAD I STPTR /SEARCH TABLE | |
1425 | SNA | |
1426 | JMP NEWARY /NEW ENTRY | |
1427 | CIA | |
1428 | TAD NAME1 /IS THIS IT ? | |
1429 | ISZ STPTR | |
1430 | SNA CLA | |
1431 | JMP GOTARY /YES | |
1432 | ISZ STPTR | |
1433 | ISZ STPTR | |
1434 | ISZ STPTR /GO TO NEXT ENTRY | |
1435 | JMP FINDA | |
1436 | GOTARY, TAD (37 /GET NUMBER | |
1437 | AND I STPTR | |
1438 | DCA SYMBOL /INTO SYMBOL | |
1439 | CDF | |
1440 | JMP I LOOKUP | |
1441 | NEWARY, TAD NAME1 /PUT IN NEW ENTRY | |
1442 | DCA I STPTR | |
1443 | ISZ STPTR | |
1444 | TAD (41 /PUT IN NUMBER | |
1445 | JMP CHEKST /GO DO THE REST | |
1446 | LUSARY, TAD (SACNT /STRING ARRAY COUNT | |
1447 | DCA VCPTR | |
1448 | TAD (SARYST /USE STRING ARRAY TABLE | |
1449 | JMP FINDA-2 /GO DO SEARCH | |
1450 | \f/ FILE AND CLOSE PROCESSORS | |
1451 | FILE, JMS I QLODSN /OUTPUT STMT NUMBER | |
1452 | TAD (FOPENS /POINTER TO FILE OPENS | |
1453 | DCA FILESW | |
1454 | JMS I QCHECKC /LOOK FOR "V" | |
1455 | -126 | |
1456 | SKP /NOT V | |
1457 | ISZ FILESW /YUP, INCR FILESW | |
1458 | JMS I QCHECKC /LOOK FOR "N" | |
1459 | -116 | |
1460 | JMP .+3 | |
1461 | ISZ FILESW /INCR FILESW BY TWO IF "N" | |
1462 | ISZ FILESW | |
1463 | JMS GETFN /GET FILE NUMBER | |
1464 | JMS I QEXPR /GET DEVICE/FILE DESCRIPTOR | |
1465 | JMP I QREMARK | |
1466 | JMS I QLOAD /LOAD INTO SAC | |
1467 | TAD TYPE1 /TYPE MUST BE STRING | |
1468 | SPA CLA | |
1469 | JMP .+3 /IT WERE | |
1470 | JMS I QERMSG /IT WEREN'T | |
1471 | 0616 | |
1472 | TAD I FILESW /GET CORRECT OPEN | |
1473 | JMS I QOUTWRD | |
1474 | JMP I QNEWLIN | |
1475 | FOPENS, OPENAF;OPENAV;OPENNF;OPENNV | |
1476 | FILESW, 0 | |
1477 | PLUS, 40;0;XADD;XADD | |
1478 | \f/ EXPRESSION ANALYZER | |
1479 | PAGE | |
1480 | EXPR, 0 /POLISHIZE EXPRESSION | |
1481 | DCA TEMP /SAVE LEFT | |
1482 | TAD LEFT /SO WE CAN PUSH OLD VALUE | |
1483 | JMS I QPUSH /OF IT | |
1484 | TAD TEMP /NOW SET NEW VALUE | |
1485 | DCA LEFT /OF THAT SWITCH | |
1486 | TAD EXPR | |
1487 | JMS I QPUSH /SAVE RETURN ADDR | |
1488 | JMS I QPUSH /MARK STACK | |
1489 | TAD LEFT /IS THIS LEFT SIDE ? | |
1490 | SPA CLA | |
1491 | JMP OPRAND+1/YES, NO UNARY MINUS | |
1492 | UNOPR, JMS I QGETC /LOOK FOR UNARY OPERATOR | |
1493 | JMP MISARG /THERE HAS TO BE AN OPERAND | |
1494 | TAD (-53 /UNARY+(NOP) | |
1495 | SNA | |
1496 | JMP UNOPR | |
1497 | TAD (53-55 /UNARY - | |
1498 | SZA | |
1499 | JMP NOTMIN /NOT UNARY MINUS | |
1500 | TAD (UMOPR /PUSH UNARY MINUS | |
1501 | JMS I QPUSH | |
1502 | JMP UNOPR | |
1503 | NOTMIN, TAD (55-50 /LOOK FOR ( | |
1504 | SZA CLA | |
1505 | JMP OPRAND /NOT A SUB EXPRESSION | |
1506 | JMS I QEXPR /COMPILE SUB EXPRESSION | |
1507 | JMP BADEXP /BAD SUB EXPRESSION | |
1508 | JMS I QCHECKC /LOOK FOR ) | |
1509 | -51 | |
1510 | SKP /ERROR | |
1511 | JMP OPR8R /GOTIT | |
1512 | JMS I QERMSG /PARENTHESIS MIS MATCH | |
1513 | 1520 | |
1514 | JMP BADEXP | |
1515 | OPRAND, JMS I QBACK1 /PUT BACK NON UNARY OP | |
1516 | JMS I QGETNAM /LOOK FOR VARIABLE REF | |
1517 | JMP NOTVAR /NOPE. | |
1518 | JMS I QLOOKUP /SYMBOL TABLE SEARCH | |
1519 | TAD SYMBOL /SAVE SYMBOL NUMBER | |
1520 | DCA TEMP2 /BECAUSE SAVAC MIGHT KILL IT | |
1521 | JMS I QSAVAC /GENERATE FSTA (MAYBE) | |
1522 | -3 | |
1523 | TAD TYPE /WAS THIS A FUNCTION OR ARRAY ? | |
1524 | AND (3000 | |
1525 | SZA | |
1526 | JMP FUNSS /YES, GO PROCESS IT | |
1527 | TAD TYPE /MAKE OPERAND STACK ENTRY | |
1528 | JMS I QPUSHO | |
1529 | TAD TEMP2 /FIRST TYPE THEN SYMBOL # | |
1530 | JMS I QPUSHO | |
1531 | OPR8R, TAD LEFT /LEFT SIDE ? | |
1532 | SMA CLA /YES, NO OPERATORS LEGAL | |
1533 | JMS I QGETC /LOOK FOR OPERATOR | |
1534 | JMP ENDEXP /END OF EXPR | |
1535 | TAD (-52 /** IS SPECIAL CASE | |
1536 | SZA | |
1537 | JMP NOSTAR /NOT * | |
1538 | JMS I QGETC /LOOK FOR SECOND * | |
1539 | JMP NOSTAR | |
1540 | TAD (-52 | |
1541 | SNA CLA | |
1542 | TAD (136-52 /** -> ^ | |
1543 | SNA | |
1544 | JMS I QBACK1 /PUT IT BACK | |
1545 | NOSTAR, TAD (52 /RESTORE CHAR | |
1546 | DCA TEMP | |
1547 | TAD (OPR8RS-1 | |
1548 | DCA X10 /PTR TO LIST | |
1549 | OPRLUP, TAD I X10 /GET OPERATOR PTR | |
1550 | SNA | |
1551 | JMP ENDEXP-3/END OF LIST | |
1552 | DCA NEWOP /SAVE IT IN CASE | |
1553 | TAD I X10 /COMPARE | |
1554 | TAD TEMP | |
1555 | SZA CLA | |
1556 | JMP OPRLUP /KEEP LOOKING | |
1557 | GOTOPR, JMS I QPOP /GET STACK TOP | |
1558 | SNA | |
1559 | JMP PUSH2 /EMPTY | |
1560 | DCA OLDOP | |
1561 | TAD I OLDOP /COMPARE PREC. | |
1562 | CIA | |
1563 | TAD I NEWOP /NEW-OLD | |
1564 | SPA SNA CLA | |
1565 | JMP OUTOLD /OLD>NEW | |
1566 | TAD OLDOP | |
1567 | PUSH2, JMS I QPUSH /OLD < NEW | |
1568 | TAD NEWOP /GO PUSH BOTH | |
1569 | JMS I QPUSH | |
1570 | JMP UNOPR /GO LOOK FOR NEXT OPERAND | |
1571 | OUTOLD, TAD OLDOP /OUTPUT CODE FOR OLD OPR8R | |
1572 | JMS I QOUTOPR | |
1573 | JMP GOTOPR /LOOK AT NEXT TOP OF STACK | |
1574 | JMS I QBACK1 /PUT BACK NON OPERATOR | |
1575 | SKP | |
1576 | JMS I QOUTOPR /OUTPUT OPERATOR | |
1577 | ENDEXP, JMS I QPOP /LOOK FOR STACK MARK | |
1578 | SZA | |
1579 | JMP ENDEXP-1/NOT THIS | |
1580 | JMS I QPOP /GET RETURN ADDR | |
1581 | IAC | |
1582 | DCA TEMP | |
1583 | JMS I QPOP /GET LEFT SIDE SWITCH | |
1584 | DCA LEFT | |
1585 | JMP I TEMP /RETURN | |
1586 | MISARG, JMS I QERMSG /MISSING OPERAND | |
1587 | 1517 | |
1588 | JMP BADEXP | |
1589 | MINUS, 40;0;XISUB;XSUB | |
1590 | SLASH, 50;0;XIDIV;XDIV | |
1591 | \f/ EXPRESSION ANALYZER (HANDLE SUBSCRIPTS) | |
1592 | PAGE | |
1593 | FUNSS, AND (1000 /IS IT FUN CALL ? | |
1594 | SNA CLA | |
1595 | JMP .+3 /NO | |
1596 | JMS I QSAVAC /YES, SAVE AC | |
1597 | -1 | |
1598 | TAD TYPE /SAVE TYPE | |
1599 | JMS I QPUSH | |
1600 | TAD TEMP2 /AND SYMBOL NUMBER | |
1601 | JMS I QPUSH | |
1602 | TAD STPTR /AND SYMBOL TABLE PTR | |
1603 | JMS I QPUSH | |
1604 | SKP | |
1605 | SSLOOP, JMS I QPOP /GET ARG/SS COUNT | |
1606 | IAC | |
1607 | JMS I QPUSH /INCREMENT IT | |
1608 | JMS I QEXPR /GET NEXT ARG/SS | |
1609 | JMP BADFSS | |
1610 | JMS I QGETA1 /IS THIS ARG(SS) AN ARRAY REF ? | |
1611 | CLL CML RTR | |
1612 | AND TYPE1 /CHECK THE TYPE | |
1613 | SNA CLA | |
1614 | JMP NOTSSD /NOT AN ARRAY REFERENCE | |
1615 | JMS I QLOADSS /LOAD THE SS REGS | |
1616 | JMS I QSAVAC /SAVE AC IF NEEDED | |
1617 | -1 | |
1618 | TAD TYPE1 /SET THE MODE | |
1619 | JMS I QMODSET | |
1620 | TAD (AFLDA /LOAD THIS ARG/SS | |
1621 | TAD SYMBL1 | |
1622 | JMS I QOUTWRD | |
1623 | TAD Q400 /SET THE IN-AC BIT | |
1624 | TAD MODE /WE JUST CALLED MODSET | |
1625 | DCA I OSTACK /CHANGE THIS STACK ENTRY | |
1626 | SKP | |
1627 | NOTSSD, ISZ OSTACK /FIX UP OSTACK | |
1628 | ISZ OSTACK | |
1629 | JMS I QCOMARP /LOOK FOR , OR ) | |
1630 | JMP BADFSS /NEITHER IS BAD | |
1631 | JMP SSLOOP /, MEANS MORE ARGS/SS | |
1632 | JMS I QPOP /GET # OF ARG/SS | |
1633 | DCA TEMP /GET ARG/SS COUNT | |
1634 | JMS I QPOP /RESTORE S.T. ADDR | |
1635 | DCA STPTR | |
1636 | JMS I QPOP | |
1637 | DCA SYMBOL /GET BACK THE SYMBOL # | |
1638 | JMS I QPOP | |
1639 | DCA TYPE /GET BACK THE TYPE | |
1640 | TAD TYPE /IS IT AN ARRAY OR FUN REF ? | |
1641 | AND (1000 | |
1642 | SZA CLA | |
1643 | JMP DOCALL /FUNCTION REFERENCE | |
1644 | TAD TEMP /MOVE SS COUNT | |
1645 | CLL RTR /INTO THE CORRECT | |
1646 | RTR /FIELD | |
1647 | DCA TEMP2 /AND SAVE IT | |
1648 | CDF 10 | |
1649 | TAD I STPTR /ANY PREV REFERENCE ? | |
1650 | AND (3000 | |
1651 | SZA | |
1652 | JMP NOTNEW /YES, GO CHECK NUMBERS | |
1653 | TAD TEMP2 /IF NONE, PUT IN NUMBER | |
1654 | TAD I STPTR | |
1655 | DCA I STPTR | |
1656 | JMP NDOK /THATS ALL | |
1657 | NOTNEW, CIA /COMPARE NUMBER OF SS | |
1658 | TAD TEMP2 /WITH ANY PREVIOUS | |
1659 | SZA CLA | |
1660 | JMP BADFSS+3/THEY DON'T MATCH | |
1661 | NDOK, CDF | |
1662 | TAD TYPE /PUT TYPE | |
1663 | TAD TEMP /AND DIM COUNT | |
1664 | ONSTAK, JMS I QPUSHO /ONTO ARGUMENT STACK | |
1665 | TAD SYMBOL | |
1666 | JMS I QPUSHO /AND SYMBOL NUMBER | |
1667 | JMS I QSAVAC /SAVE FIRST SS IF LEFT IN AC | |
1668 | -5 | |
1669 | JMP OPR8R /GO GET AN OPERATOR | |
1670 | BADFSS, TAD (-4 /PURGE STACK JUNK | |
1671 | TAD STACK | |
1672 | DCA STACK | |
1673 | JMS I QERMSG /PUT ERROR MESSAGE | |
1674 | 2323 | |
1675 | BADEXP, JMS I QPOP /LOOK FOR STACK MARK | |
1676 | SZA CLA | |
1677 | JMP BADEXP /NOT YET | |
1678 | JMS I QPOP /RETURN ADDR | |
1679 | DCA TEMP | |
1680 | JMS I QPOP /SS LOAD SWITCH | |
1681 | DCA LEFT | |
1682 | JMP I TEMP /TAKE ERROR EXIT | |
1683 | WTAB, -124;-101;-102;-50 | |
1684 | NOTVAR, TAD LEFT /LEFT SIDE ? | |
1685 | SPA CLA | |
1686 | JMP MISARG /YES, NO LITERALS LEGAL | |
1687 | JMS I QNUMBER /LOOK FOR LITERAL | |
1688 | JMP NOTNUM /NOT A NUMBER | |
1689 | JMS I QLUKUP2 /SEARCH LITERAL TABLE | |
1690 | LITRL | |
1691 | -3 | |
1692 | JMS NEWVAR /IF NEW, GIVE IT NUMBER | |
1693 | JMP ONSTAK /GO PUT IT ONTO THE STACK | |
1694 | NOTNUM, JMS I QSTRING /LOOK FOR STRING LITERAL | |
1695 | JMP MISARG /NO, MISSING ARG | |
1696 | TAD WORD1 /GET -NUMBER WORDS - 1 | |
1697 | IAC | |
1698 | CLL CML CMA RAR | |
1699 | DCA .+3 /FOR LOOKUP | |
1700 | JMS I QLUKUP2 /LOOK UP LITERAL | |
1701 | SLITRL | |
1702 | 0 | |
1703 | JMS NWSVAR /IF NEW, GIVE IT NUMBER | |
1704 | CLL CML RAR /SET TYPE BIT FOR STRING | |
1705 | JMP ONSTAK /PUT INFO ONTO STACK | |
1706 | ||
1707 | UPAROW, 60;1;EXPRTN-1 | |
1708 | \f/ EXPRESSION ANALYZER (HANDLE FUNCTION CALLS) | |
1709 | PAGE | |
1710 | DOCALL, TAD LEFT /IS THIS LEFT SIDE ? | |
1711 | SMA CLA /IF YES, FUN ILLEGAL | |
1712 | JMS OUTCAL /GENERATE CALL | |
1713 | SKP /SKIP IF ERROR | |
1714 | JMP OPR8R /GO LOOK FOR OPERATOR | |
1715 | JMS I QERMSG /BAD FUNCTION REFERENCE | |
1716 | 0622 | |
1717 | JMP BADEXP | |
1718 | OUTCAL, 0 /GENERATE FUN CALL; TYPE, | |
1719 | /SYMBOL AND TEMP ARE INPUTS | |
1720 | TAD SYMBOL /SAVE FUNCTION NUMBER AROUND SAVAC | |
1721 | DCA FUNNUM | |
1722 | JMS I QSAVAC /SAVE SECOND FROM TOP | |
1723 | -3 | |
1724 | TAD FUNNUM /SETUP FOR FINDING FUNCTION | |
1725 | DCA WORD1 /INFO BLOCK | |
1726 | JMS I QLUKUP2 /ON THE FUNCTION LIST | |
1727 | FUNCTN | |
1728 | -1 | |
1729 | JMP I OUTCAL /UNDEFINED FUNCTION | |
1730 | TAD SYMBOL /CHECK NUMBER OF ARGS | |
1731 | TAD TEMP | |
1732 | SZA CLA | |
1733 | JMP I OUTCAL | |
1734 | MOVARG, JMS I QLOAD /GET TOP OF STACK INTO AC | |
1735 | JMS SETFLD /GET FIELD OF FORMAL-PARAMS | |
1736 | TAD I X10 /GET FIRST ONE | |
1737 | CDF | |
1738 | DCA TEMP | |
1739 | CLL CML RAR /COMPARE TYPE OF ARG | |
1740 | AND TYPE1 /WITH THAT OF FORMAL PARAMETER | |
1741 | TAD TEMP | |
1742 | SPA CLA /THEY MUST MATCH | |
1743 | JMP I OUTCAL /(THEY DON'T) | |
1744 | CLL CML RTR /SHOULD WE LEAVE IT IN THE AC ? | |
1745 | AND TEMP | |
1746 | SZA CLA | |
1747 | JMP OKINAC /YES, SAVES AN INSTRUCTION | |
1748 | TAD TYPE1 /SET MODE | |
1749 | JMS I QMODSET /APPROPRIATELY | |
1750 | CLL CMA RAR /3777 | |
1751 | AND TEMP /GET SYM NUMBER | |
1752 | TAD (FSTA /STORE VALUE IN FORM PARAM | |
1753 | JMS I QOUTWRD | |
1754 | OKINAC, ISZ SYMBOL /MORE ARGS ? | |
1755 | JMP MOVARG | |
1756 | JMS SETFLD | |
1757 | TAD I X10 /GET TYPE OF FUNCTION | |
1758 | DCA TYPE1 /(ITS RESULT THAT IS) | |
1759 | CDF | |
1760 | TAD TYPE /IS TYPE OF FUNCTION | |
1761 | TAD TYPE1 /SAME AS TYPE OF CALL | |
1762 | SPA CLA | |
1763 | JMP I OUTCAL /NO, ERROR | |
1764 | JMS I QMODSET /ALL CALLS IN N MODE | |
1765 | TAD WORD1 /CHECK FOR USER FUNCTION | |
1766 | SMA | |
1767 | JMP CALLUF /YES, DO SPECIAL CALL | |
1768 | FINCAL, ISZ OUTCAL /FIX RETURN | |
1769 | JMS I QOUTWRD /OUTPUT CODE | |
1770 | TAD Q400 /SET TOP OF STACK | |
1771 | TAD TYPE1 | |
1772 | DCA I OSTACK /TO AC | |
1773 | DCA I OSTACK /SYMBOL NUMBER IS MEANINGLESS | |
1774 | CLL CML RAR | |
1775 | AND TYPE1 /INTERPRETER MODE SAME | |
1776 | DCA MODE /AS FUNCTION TYPE | |
1777 | JMP I OUTCAL /ON RETURN | |
1778 | CALLUF, JMS I QNOREGS /FORGET REGS ON USER FUNC | |
1779 | TAD LUFLD /OUTPUT JSUB | |
1780 | AND (70 /WITH POINTER TO | |
1781 | CLL RTL /DOUBLE WORD | |
1782 | TAD (JSUB /VALUE OF LOCATION | |
1783 | JMS I QOUTWRD /COUNTER FOR THE | |
1784 | TAD X10 /START OF THE | |
1785 | IAC /USER "DEF"INED FUNC | |
1786 | JMP FINCAL | |
1787 | FSUB1, 0 /FOR SUBROUTINE #1 | |
1788 | JMS I QEXPR /GET AN EXPRESSION | |
1789 | JMP BADFOR | |
1790 | JMS I QLOAD /LOAD VALUE | |
1791 | TAD TYPE1 /MUST BE NUMERIC | |
1792 | SMA CLA | |
1793 | JMP I FSUB1 /OK | |
1794 | BADFOR, JMS I QERMSG /BAD FOR LOOP PARAMETERS | |
1795 | 0620 | |
1796 | JMP I QREMARK | |
1797 | FSUB2, 0 /FOR SUBROUTINE #2 | |
1798 | JMS FSUB1 /GET EXPR AND LOAD IT | |
1799 | JMS GENTMP /MAKE A TEMP FOR IT | |
1800 | TAD SYMBOL /STORE EXPR IN TEMP | |
1801 | TAD (FSTA | |
1802 | JMS I QOUTWRD | |
1803 | TAD SYMBOL /RETURN SLOT # | |
1804 | JMP I FSUB2 | |
1805 | FUNNUM, | |
1806 | NOREGS, 0 /FORGET REGISTORS | |
1807 | CLA IAC /FILE NUMBER REG | |
1808 | DCA IFNREG | |
1809 | / CMA /SUBSCRIPT REG #1 | |
1810 | / DCA SSREG1 | |
1811 | / CMA /SUBSCRIPT REG #2 | |
1812 | / DCA SSREG2 | |
1813 | JMP I NOREGS | |
1814 | CLOSE, JMS I QLODSN /OUTPUT STMT NUMBER | |
1815 | CLA IAC /NO COLON NEEDED AFTER FILE NUM | |
1816 | JMS GETFN /GET FILE NUM | |
1817 | TAD (CLOSEF /OUTPUT CLOSE | |
1818 | JMS I QOUTWRD | |
1819 | JMP I QNEWLIN | |
1820 | PSETJF, 0 | |
1821 | TAD (SETJF | |
1822 | JMS I QOUTWRD | |
1823 | JMS I QPOP /GET INDEX VAR | |
1824 | DCA FINDEX | |
1825 | JMP I PSETJF | |
1826 | DIMREAD,JMS I QLOADSS /PATCH TO INPUT PROC. SET UP SS REG | |
1827 | TAD (READ /OUTPUT INSTR | |
1828 | JMS I QOUTWRD | |
1829 | TAD (AFSTA | |
1830 | JMP I (FININP /RESUME IN LINE | |
1831 | \f/ CODE GENERATOR | |
1832 | PAGE | |
1833 | OUTOPR, 0 /OUTPUT CODE FOR OPERATOR | |
1834 | DCA X10 /SAVE POINTER TO SKELETON | |
1835 | TAD I X10 /GET CONTROL WORD | |
1836 | SMA SZA | |
1837 | JMP SPCIAL /TREAT AS SPECIAL CASE | |
1838 | DCA TYPE /ITS THE TYPE ALLOWANCE | |
1839 | TAD (XLOAD /GET SKEL ADDRS | |
1840 | DCA CASEMM /FOR THE THREE CASES | |
1841 | TAD I X10 | |
1842 | DCA CASEMA | |
1843 | TAD I X10 | |
1844 | DCA CASEAM | |
1845 | TAD TYPE /ENTER CORRECT MODE | |
1846 | JMS I QMODSET | |
1847 | CLL CMA RAL /GET THE SECOND OPERAND | |
1848 | TAD OSTACK | |
1849 | DCA OSTACK | |
1850 | TAD OSTACK | |
1851 | DCA X10 /BY BACKING UP THE STACK | |
1852 | TAD I X10 /TYPE | |
1853 | DCA TYPE2 | |
1854 | TAD I X10 | |
1855 | DCA SYMBL2 /SYMBOL NUMBER | |
1856 | TAD TYPE2 | |
1857 | AND (3 | |
1858 | DCA TEMP /SS COUNT | |
1859 | TAD TYPE2 /LOOK AT OPERAND 2 | |
1860 | AND Q400 | |
1861 | SZA CLA | |
1862 | JMP MAC /MUST BE CASE M,AC | |
1863 | CLL CML RTR /ITS IN MEMORY, IS IT SS'D | |
1864 | AND TYPE2 | |
1865 | SNA CLA | |
1866 | JMP A2OK /NO, ITS SCALAR | |
1867 | JMS I QLOADSS /LOAD NECESSARY SS REGS | |
1868 | ISZ CASEMM /FIXUP THE SKELETON POINTERS | |
1869 | ISZ CASEAM | |
1870 | A2OK, JMS GETA1 /GET STUF FOR ARG1 | |
1871 | TAD TYPE1 /LOOK AT IT | |
1872 | AND Q400 | |
1873 | SZA CLA | |
1874 | JMP ACM /ITS CASE AC,M | |
1875 | MM, TAD I CASEMM /ITS CASE M,M LOAD OPERAND 2 | |
1876 | TAD SYMBL2 | |
1877 | JMS I QOUTWRD | |
1878 | SKP | |
1879 | MAC, JMS GETA1 /GET STUF FRO ARG1 | |
1880 | CLL CML RTR /IS IT SS'D ? | |
1881 | AND TYPE1 | |
1882 | SNA CLA | |
1883 | JMP A1OK /NO, ITS SCALAR | |
1884 | JMS I QLOADSS /LOAD THE SS REGS | |
1885 | ISZ CASEMA /BUMP SKELETON ADDR | |
1886 | A1OK, TAD I CASEMA /GET CORRECT INSTRUCTION | |
1887 | TAD SYMBL1 /PLUS SYMBOL NUMBER | |
1888 | TYPCHK, JMS I QOUTWRD /OUTPUT IT | |
1889 | CLL CML RAR /TYPES OF OPERANDS MUST MATCH | |
1890 | AND TYPE1 | |
1891 | TAD TYPE2 | |
1892 | SPA CLA | |
1893 | JMP MIXED /THEY DON'T | |
1894 | TAD TYPE /TYPE OF OPERATOR | |
1895 | TAD TYPE1 /MUST MATCH | |
1896 | SPA CLA /THAT OF OPERANDS | |
1897 | JMP MIXED /THEY DON'T | |
1898 | TAD Q400 /GENERATE STACK ENTRY | |
1899 | TAD TYPE | |
1900 | DCA I OSTACK | |
1901 | DCA I OSTACK /THIS IS SAFE | |
1902 | JMP I OUTOPR | |
1903 | ACM, TAD I CASEAM /ITS CASE AC,M | |
1904 | TAD SYMBL2 /GEN OPERATION FOR OPERAND 2 | |
1905 | JMP TYPCHK /GO FINISH IT UP | |
1906 | MIXED, JMS I QERMSG /MIXED TYPES | |
1907 | 1524 | |
1908 | JMP I OUTOPR | |
1909 | SPCIAL, TAD I X10 /GET ADDR OF SPECIAL RTNE | |
1910 | DCA TEMP /(PLUS 1 FROM THE TYPE WORD) | |
1911 | JMP I TEMP /HANDLE SPECIAL CASE | |
1912 | GETA1, 0 /GET STUFF FOR ARG 1 | |
1913 | CLL CMA RAL /BACK UP STACK | |
1914 | TAD OSTACK | |
1915 | DCA OSTACK | |
1916 | TAD OSTACK | |
1917 | DCA X11 | |
1918 | TAD I X11 /GET TYPE1 | |
1919 | DCA TYPE1 | |
1920 | TAD I X11 /GET SYMBL1 | |
1921 | DCA SYMBL1 | |
1922 | TAD TYPE1 /GET SS COUNT | |
1923 | AND (3 | |
1924 | DCA TEMP | |
1925 | JMP I GETA1 | |
1926 | UMRTNE, JMS I QSAVAC /SAVE CURRENT AC IF NEEDED | |
1927 | -3 | |
1928 | JMS I QLOAD /GET ARG IN AC | |
1929 | DCA TYPE /TYPE MUST BE NUMERIC | |
1930 | DCA TYPE2 | |
1931 | TAD (FNEG /DO NEGATE | |
1932 | JMP TYPCHK | |
1933 | EXPRTN, DCA TYPE /SET FUNC TYPE | |
1934 | CLL CML RTL /SET NUMBER OF ARGS | |
1935 | DCA TEMP | |
1936 | TAD (FUNC1+60 | |
1937 | DCA SYMBOL /EXP2 | |
1938 | JMS OUTCAL /OUTPUT FUNCTION CALL | |
1939 | JMP MIXED /ERROR | |
1940 | JMP I OUTOPR /DONE | |
1941 | CASEMA, 0 | |
1942 | CASEMM, 0 | |
1943 | CASEAM, 0 | |
1944 | TYPE2, 0 | |
1945 | SYMBL2, 0 | |
1946 | RETURN, JMS I QLODSN /OUTPUT STMT NUM LOAD | |
1947 | JMS I QMODSET /ALWAYS RETURN IN N MODE | |
1948 | TAD (RET-RNDO | |
1949 | RANDOM, TAD (RNDO-STOP | |
1950 | STOPX, TAD (STOP /RETURN, RANDOMIZE, OR STOP | |
1951 | JMS I QOUTWRD | |
1952 | JMP I QNEWLIN | |
1953 | \f/ LETTER AND DIGIT SCANNERS | |
1954 | PAGE | |
1955 | LETTER, 0 /SKIP ON LETTER | |
1956 | JMS I QGETC | |
1957 | JMP I LETTER /NO LETTER | |
1958 | TAD (-133 /MUST BE .LT. 133 | |
1959 | SMA | |
1960 | JMP NOLETR | |
1961 | TAD (133-100/MUST BE .GT. 100 | |
1962 | SPA | |
1963 | JMP NOLETR | |
1964 | AND (77 /RESTORE 6 BITS | |
1965 | ISZ LETTER /BUMP RETURN ADDR | |
1966 | JMP I LETTER | |
1967 | NOLETR, JMS I QBACK1 /PUT CHAR BACK | |
1968 | JMP I LETTER | |
1969 | DIGIT, 0 /SKIP ON DIGIT | |
1970 | JMS I QGETC | |
1971 | JMP I DIGIT /NO DIGIT | |
1972 | TAD (-72 /MUST BE .LT. 72 | |
1973 | O7100, CLL /(USED AS LITERAL BY "TTY") | |
1974 | TAD (72-60 /MUST BE .GE. 60 | |
1975 | SNL | |
1976 | JMP NODIGT /NOPE | |
1977 | ISZ DIGIT /RETURN DIGIT MINUS 60 | |
1978 | JMP I DIGIT | |
1979 | NODIGT, JMS I QBACK1 /PUT IT BACK | |
1980 | JMP I DIGIT | |
1981 | \f/ STATEMENT NUMBER GETTER | |
1982 | SNUM, 0 /GET A STATEMENT NUMBER | |
1983 | DCA TEMP /SAVE DEFINED SWITCH | |
1984 | JMS I QDIGIT /GET FIRST DIGIT | |
1985 | JMP I SNUM /NO STATEMENT NUMBER | |
1986 | DCA WORD2 /THIS WILL BE THE BUCKET | |
1987 | TAD WORD2 | |
1988 | CLL RAL /TWO WORDS PER BUCKET | |
1989 | TAD (SNUMS | |
1990 | DCA BUCKET | |
1991 | ISZ SNUM /OK, ITS A STMT NUMBER | |
1992 | TAD (-4 /FIVE DIGITS MAX | |
1993 | DCA TEMP2 | |
1994 | DCA WORD1 /CLEAR TOP WORD | |
1995 | SNLOOP, JMS I QDIGIT /GET NEXT DIGIT | |
1996 | JMP GOTSN /END OF NUMBER | |
1997 | DCA WORD3 /SAVE IT | |
1998 | TAD (-4 /SET SHIFT COUNT | |
1999 | DCA ACO | |
2000 | SHIFT, TAD WORD2 /SHIFT LEFT ONE BIT | |
2001 | CLL RAL | |
2002 | DCA WORD2 | |
2003 | TAD WORD1 | |
2004 | RAL | |
2005 | DCA WORD1 | |
2006 | ISZ ACO /BUMP SHIFT COUNTER | |
2007 | JMP SHIFT | |
2008 | TAD WORD2 /PUT IN NEW DIGIT | |
2009 | TAD WORD3 | |
2010 | DCA WORD2 | |
2011 | ISZ TEMP2 /BUMP DIGIT COUNT | |
2012 | JMP SNLOOP | |
2013 | GOTSN, JMS I QLUKUP2 /FIND STMT NUMBER | |
2014 | BUCKET, 0 | |
2015 | -2 | |
2016 | JMP NEWSN /ITS A NEW STMT NUM | |
2017 | CLL CML RAR /CHECK FOR MULTIPLY DEFINED | |
2018 | AND SYMBOL | |
2019 | AND TEMP | |
2020 | SZA CLA | |
2021 | JMP MDLABL /YES, IT IS | |
2022 | TAD X10 /GET ADDR OF LABEL VALUE | |
2023 | DCA TEMP2 | |
2024 | JMS SETFLD /GET TO FIELD OF ENTRY | |
2025 | TAD TEMP /OR IN THESE BITS | |
2026 | TAD SYMBOL | |
2027 | DCA I TEMP2 | |
2028 | FINSN, CDF | |
2029 | TAD LUFLD /GET FIELD BITS | |
2030 | AND (70 | |
2031 | CLL RTL | |
2032 | DCA TEMP /INTO A CONVIENIENT | |
2033 | JMP I SNUM /PLACE | |
2034 | NEWSN, JMS SETFLD /GET FIELD | |
2035 | TAD TEMP /PUT IN BITS | |
2036 | DCA I NEXT | |
2037 | TAD NEXT /SAVE N3 ADDR | |
2038 | DCA TEMP2 | |
2039 | DCA I NEXT /1 EXTRA WORD | |
2040 | JMP FINSN | |
2041 | MDLABL, JMS I QERMSG /MULTIPLY DEFINED | |
2042 | 1504 /LABEL | |
2043 | JMP I SNUM | |
2044 | TTY, 0 /CONVERT TO ASCII AND PRINT | |
2045 | AND (77 /SIX BITS ONLY | |
2046 | TAD (-40 /WHAT SIDE OF FORTY ? | |
2047 | SPA | |
2048 | TAD O7100 /LOW SIDE | |
2049 | TAD (240 /HIGH SIDE | |
2050 | JMS TTX /PRINT CHAR | |
2051 | JMP I TTY /RETURN | |
2052 | TTX, 0 /PRINT CHAR ON TTY | |
2053 | SKP /(CONTROL O ZEROES THIS WORD) | |
2054 | JMP .+4 /(THUS KILLING ERROR REPORTING) | |
2055 | TSF | |
2056 | JMP .-1 | |
2057 | TLS | |
2058 | CLA | |
2059 | JMP I TTX | |
2060 | \f/ CHAIN PROCESSOR | |
2061 | CHAIN, JMS I QLODSN /OUTPUT STMT NUMBER | |
2062 | JMS I QEXPR /GET CHAIN STRING | |
2063 | JMP I QREMARK | |
2064 | JMS I QLOAD /INTO SAC | |
2065 | TAD TYPE1 /TYPE MUST BE STRING | |
2066 | SMA CLA | |
2067 | JMS I QERMSG /IT WASN'T | |
2068 | 0616 /(OK IF ERROR CODE IS NOP) | |
2069 | TAD (CHN /OUTPUT CHAIN OPCODE | |
2070 | JMS I QOUTWRD | |
2071 | JMP I QNEWLIN | |
2072 | XISUB, FISUB;AISUB | |
2073 | \f/ SEVERAL SHORT UTILITY ROUTINES | |
2074 | PAGE | |
2075 | BACK1, 0 /BACK UP ONE CHAR | |
2076 | CLA CMA | |
2077 | TAD NCHARS | |
2078 | DCA NCHARS | |
2079 | CLA CMA | |
2080 | TAD CHRPTR | |
2081 | DCA CHRPTR | |
2082 | JMP I BACK1 | |
2083 | GETCWB, 0 /GET A CHARACTER (PRESERVE BLANKS) | |
2084 | ISZ NCHARS | |
2085 | JMP .+4 | |
2086 | CLA CMA | |
2087 | DCA NCHARS /RESET NCHARS | |
2088 | JMP I GETCWB | |
2089 | ISZ GETCWB | |
2090 | TAD I CHRPTR /GET THE CHAR | |
2091 | JMP I GETCWB | |
2092 | SAVECP, 0 /SAVE CHAR POSITION | |
2093 | TAD NCHARS | |
2094 | DCA NCSAVE | |
2095 | TAD CHRPTR | |
2096 | DCA CPSAVE | |
2097 | JMP I SAVECP | |
2098 | RESTCP, 0 /RESTORE CHAR POS | |
2099 | TAD CPSAVE | |
2100 | DCA CHRPTR | |
2101 | TAD NCSAVE | |
2102 | DCA NCHARS | |
2103 | JMP I RESTCP | |
2104 | GETC, 0 /GET A CHARACTER (IGNORING BLANKS) | |
2105 | ISZ NCHARS | |
2106 | JMP .+4 | |
2107 | CLA CMA | |
2108 | DCA NCHARS | |
2109 | JMP I GETC | |
2110 | TAD I CHRPTR | |
2111 | TAD (-40 /IS IT A BLANK | |
2112 | SNA | |
2113 | JMP GETC+1 /YES IGNORE IT | |
2114 | TAD (40 /FIX CHAR | |
2115 | ISZ GETC | |
2116 | JMP I GETC | |
2117 | POP, 0 /GET TOP OF STACK | |
2118 | TAD STACK | |
2119 | DCA PUSH | |
2120 | CLA CMA | |
2121 | TAD STACK | |
2122 | DCA STACK /DECREMENT STACK POINTER | |
2123 | TAD I PUSH | |
2124 | JMP I POP | |
2125 | PUSH, 0 /PUT AC ONTO STACK | |
2126 | DCA I STACK /STORE | |
2127 | TAD (-STACKA-STAKSZ+1 | |
2128 | TAD STACK /CHECK FOR OVERFLOW | |
2129 | SPA CLA | |
2130 | JMP I PUSH /OK, RETURN | |
2131 | STKOVR, JMS I QERMSG | |
2132 | 2004 | |
2133 | JMP I XABORT /ABORT COMPILATION | |
2134 | PUSHO, 0 /PUSH OPERAND STACK | |
2135 | DCA I OSTACK /PUSHIT | |
2136 | TAD (-STACKO-STOKSZ+1 | |
2137 | TAD OSTACK /CHECK FOR STACK OVERFLOW | |
2138 | SPA CLA | |
2139 | JMP I PUSHO | |
2140 | JMP STKOVR /TOO FULL | |
2141 | COMARP, 0 /SKIP ON COMA OR RITE PAREN | |
2142 | JMS I QGETC /GET CHAR | |
2143 | JMP I COMARP | |
2144 | TAD (-51 | |
2145 | SNA | |
2146 | ISZ COMARP /RITE PAREN, SKIP 2 | |
2147 | SZA | |
2148 | TAD (51-54 /CHECK FOR , | |
2149 | SNA | |
2150 | ISZ COMARP /, SKIP 1 | |
2151 | SZA CLA | |
2152 | JMS I QBACK1 /NEITHER PUT BACK | |
2153 | JMP I COMARP | |
2154 | LOAD, 0 /LOAD SAC OR FAC | |
2155 | JMS I QGETA1 /GET TOP OF STACK | |
2156 | TAD TYPE1 /SET MODE | |
2157 | JMS I QMODSET | |
2158 | TAD TYPE1 /IS IT IN THE AC? | |
2159 | AND Q400 | |
2160 | SZA CLA | |
2161 | JMP I LOAD /YUP | |
2162 | CLL CML RTR /SUBSCRIPTED ? | |
2163 | AND TYPE1 | |
2164 | SNA CLA | |
2165 | JMP .+3 /NO | |
2166 | JMS I QLOADSS /FILL SS REGS | |
2167 | TAD (AFLDA-FLDA | |
2168 | TAD (FLDA /ARRAY OR SCALAR LOAD | |
2169 | TAD SYMBL1 /PLUS SYMBOL NUMBER | |
2170 | JMS I QOUTWRD | |
2171 | JMP I LOAD | |
2172 | IFOPS, JNE;-7476 /<> | |
2173 | JNE;-7674 />< | |
2174 | JGE;-7576 /=> | |
2175 | JGE;-7675 />= | |
2176 | JLE;-7574 /=< | |
2177 | JLE;-7475 /<= | |
2178 | 0 | |
2179 | JEQ;-7500 /= | |
2180 | JGT;-7600 /> | |
2181 | JLT;-7400 /< | |
2182 | 0 | |
2183 | NCSAVE, 0 | |
2184 | CPSAVE, 0 | |
2185 | \f/ TEMP GENERATORS AND AC SAVING ROUTINES | |
2186 | PAGE | |
2187 | GENTMP, 0 /GENERATE A TEMP | |
2188 | SZA CLA | |
2189 | JMP STRTMP /ITS A STRING TEMP | |
2190 | TAD TMPCNT | |
2191 | ISZ TMPCNT /BUMP COUNT | |
2192 | DCA NAME1 | |
2193 | JMS I QLUKUP2 /LOOK UP THIS TEMP | |
2194 | TEMPS | |
2195 | -1 | |
2196 | JMS NEWVAR /NEW ONE ON ME | |
2197 | JMP I GENTMP | |
2198 | STRTMP, TAD STMPCT | |
2199 | ISZ STMPCT /BUMP COUNT | |
2200 | DCA NAME1 | |
2201 | JMS I QLUKUP2 /LOOK UP THIS TEMP | |
2202 | STEMPS | |
2203 | -1 | |
2204 | JMS NWSVAR /NEW STRING TEMP | |
2205 | JMP I GENTMP | |
2206 | NEWVAR, 0 /MAKE SYM NUM FOR VAR | |
2207 | TAD VARCNT /PUT SYM NUM | |
2208 | TAD (401 | |
2209 | DCA SYMBOL /INTO SYMBOL | |
2210 | TAD SYMBOL /AND INTO ST ENTRY | |
2211 | JMS SETFLD | |
2212 | DCA I NEXT | |
2213 | CDF | |
2214 | ISZ VARCNT /BUMP COUNT | |
2215 | JMP I NEWVAR /RETURN WITH SYM NUM | |
2216 | JMP STOVER /S.T. OVERFLOW | |
2217 | NWSVAR, 0 /MAKE SYM NUM FOR VAR$ | |
2218 | TAD SVCNT /PUT SYM NUM | |
2219 | TAD (401 | |
2220 | DCA SYMBOL | |
2221 | TAD SYMBOL /INTO SYMBOL AND | |
2222 | JMS SETFLD | |
2223 | DCA I NEXT /S.T. ENTRY | |
2224 | CDF | |
2225 | ISZ SVCNT /OVERFLOW ? | |
2226 | JMP I NWSVAR /NO, WE'RE OK | |
2227 | JMP STOVER | |
2228 | SAVAC, 0 /SAVE FAC (OR SAC) IF NECESSARY | |
2229 | TAD I SAVAC /GET ENTRY POINTER | |
2230 | TAD OSTACK | |
2231 | ISZ SAVAC | |
2232 | DCA SVTEMP /ADDR OF TYPE WORD | |
2233 | TAD I SVTEMP /LOOK AT IT | |
2234 | AND Q400 | |
2235 | SNA CLA | |
2236 | JMP I SAVAC /NOT IN AC | |
2237 | CLL CML RAR /SAVE STRING BIT ONLY | |
2238 | AND I SVTEMP /OF TYPE WORD | |
2239 | DCA I SVTEMP | |
2240 | TAD I SVTEMP | |
2241 | JMS GENTMP /GENERATE TEMP | |
2242 | TAD I SVTEMP | |
2243 | JMS I QMODSET /SET MODE | |
2244 | TAD XSTOR | |
2245 | TAD SYMBOL /GENERATE STORE | |
2246 | JMS I QOUTWRD | |
2247 | TAD SYMBOL /RETURN S.T. NUMBER | |
2248 | ISZ SVTEMP /MOVE TO SYMBOL NUM WORD | |
2249 | DCA I SVTEMP /SAVE THE TEMP NUM THERE | |
2250 | JMP I SAVAC /RETURN WITH SAVE MADE | |
2251 | SVTEMP, 0 | |
2252 | XSTOR, FSTA;AFSTA | |
2253 | \f/ SUBSCRIPT REGISTER LOADING ROUTINE | |
2254 | LOADSS, 0 /LOAD SS REGS | |
2255 | CLL CMA RAL /LOOK AT NUMBER OF SS | |
2256 | TAD TEMP | |
2257 | SNA CLA | |
2258 | JMP LODSS2 /2 SS | |
2259 | SNL | |
2260 | JMP TOOMNY /MORE THAN 2 | |
2261 | JMS SSLOAD /LOAD SS REG 1 | |
2262 | JMP I LOADSS | |
2263 | LODSS2, CLA IAC | |
2264 | JMS SSLOAD /LOAD SS REG 2 | |
2265 | JMS SSLOAD /NOW SS REG 1 | |
2266 | JMP I LOADSS | |
2267 | SSTYPE, | |
2268 | TOOMNY, JMS I QERMSG /SUBSCRIPTING ERROR | |
2269 | 2323 | |
2270 | JMP I LOADSS | |
2271 | SSLOAD, 0 /LOAD A SS REG FROM TOP OF STACK | |
2272 | DCA TEMP2 /SS REG 1 OR 2 SWITCH | |
2273 | CLL CMA RAL /BACK UP ONE ENTRY | |
2274 | TAD OSTACK /ON THE OPERAND STACK | |
2275 | DCA OSTACK | |
2276 | TAD OSTACK | |
2277 | DCA X11 /USE X11 TO GET STUFF | |
2278 | TAD I X11 /GET TYPE WORD | |
2279 | SPA | |
2280 | JMP SSTYPE /SS MUST BE A NUMBER | |
2281 | AND Q400 /GET AC BIT | |
2282 | SZA CLA | |
2283 | JMP SSINAC /ITS IN THE AC | |
2284 | TAD TEMP2 | |
2285 | SZA CLA | |
2286 | TAD (LSS2-LSS1 | |
2287 | TAD (LSS1 /LOAD REG 1 OR 2 ?? | |
2288 | TAD I X11 /ANYHOW, THIS IS THE SOURCE | |
2289 | JMS I QOUTWRD /OUTPUT THE CODE | |
2290 | JMP I SSLOAD | |
2291 | SSINAC, TAD TEMP2 | |
2292 | TAD (LSS1AC /NOTE: LSS2AC=LSS1AC+1 | |
2293 | JMS I QOUTWRD /SO OUTPUT ONE OF THEM | |
2294 | JMP I SSLOAD | |
2295 | / | |
2296 | XSCOMP, SCOMP;SACOMP | |
2297 | XDIV, FDIV;AFDIV | |
2298 | / | |
2299 | PATCH6, 0 | |
2300 | ISZ SIGDIG | |
2301 | JMP I PATCH6 | |
2302 | CMA | |
2303 | DCA SIGDIG | |
2304 | JMP CONVLP | |
2305 | / | |
2306 | STAR, 50;0;XMUL;XMUL | |
2307 | \f/ NUMERIC CONVERSION ROUTINE (PART ONE) | |
2308 | PAGE | |
2309 | NUMBER, 0 /GENERAL NUMBER CONVERSION ROUTINE | |
2310 | DCA DECPT /ZERO DECIMAL POINT SWITCH | |
2311 | DCA WORD1 /ZERO FAC | |
2312 | DCA WORD2 | |
2313 | DCA WORD3 | |
2314 | DCA ACO | |
2315 | DCA SIGN /CLEAR SIGN SWITCH | |
2316 | TAD NUMDIG | |
2317 | DCA SIGDIG | |
2318 | JMS I QGETC /GET A CHAR | |
2319 | JMP I NUMBER /NO CHAR IS NO NUMBER | |
2320 | JMS CHKSGN /CHECK FOR SIGN | |
2321 | SIGN, 0 /THIS SWITCH GETS SET | |
2322 | DCA NDIGIT /ZERO DIGIT COUNT | |
2323 | CONVLP, JMS I QDIGIT /GET A DIGIT | |
2324 | JMP TRYDEC /IS THERE A DECIMAL POINT ? | |
2325 | DCA NXTDGT /SAVE THE DIGIT | |
2326 | JMS PATCH6 | |
2327 | ISZ NDIGIT /INCR NUMBER OF DIGITS | |
2328 | TAD WORD2 /PREPARE TO MULT BY 10 | |
2329 | DCA OP2 | |
2330 | TAD WORD3 | |
2331 | DCA OP3 | |
2332 | TAD ACO | |
2333 | DCA OPO | |
2334 | JMS I (AL1 /DOUBLE FAC | |
2335 | JMS I (AL1 /DOUBLE AGAIN | |
2336 | JMS I (OADD /TIMES FIVE | |
2337 | JMS I (AL1 /ONE MORE DOUBLING IS TIMES 10 | |
2338 | DCA OP2 | |
2339 | DCA OP3 /PUT NEWEST DIGIT INTO OPERAND | |
2340 | TAD NXTDGT | |
2341 | DCA OPO | |
2342 | JMS I (OADD /ADD IN NEWEST DIGIT | |
2343 | JMP CONVLP | |
2344 | TRYDEC, TAD DECPT /DECIMAL ALREADY ? | |
2345 | SZA CLA | |
2346 | JMP TRYE2 /YES, LOOK FOR EXPONENT | |
2347 | JMS I QGETC /LOOK FOR . | |
2348 | JMP DIGTST /SEE IF THERE WAS ANYTHING | |
2349 | TAD (-56 | |
2350 | SZA CLA | |
2351 | JMP TRYE1 /TRY FOR E | |
2352 | ISZ DECPT /SET DECIMAL POINT SW | |
2353 | JMP CONVLP-1/LOOP FOR OTHER DIGITS | |
2354 | TRYE1, JMS I QBACK1 /PUT BACK NON . | |
2355 | DIGTST, TAD NDIGIT /ANY DIGITS YET ? | |
2356 | SNA CLA | |
2357 | JMP I NUMBER /NO, NO NUMBER | |
2358 | TRYE2, JMS I QGETC /LOOK FOR E | |
2359 | JMP NOEXP+1 /GO HANDLE EXPONENT | |
2360 | TAD WSTEP+2 /USE PART OF "STEP" LITERAL | |
2361 | SZA CLA | |
2362 | JMP NOEXP /NO EXPONENT | |
2363 | GETEXP, DCA ESIGN /ZERO EXPONENT SIGN SWITCH | |
2364 | JMS I QGETC /GET A CHAR | |
2365 | JMP NOEXP /TREAT AS NO EXPONENT | |
2366 | JMS CHKSGN /IS IT A SIGN | |
2367 | FPRTNE, | |
2368 | ESIGN, 0 /THIS IS THE SWITCH TO SET | |
2369 | JMS SMLNUM /GO GET THE EXPONENT | |
2370 | FIXEXP, TAD ESIGN /CHECK EXPONENT SIGN | |
2371 | SNA CLA | |
2372 | JMP NOEXP+2 | |
2373 | TAD EXPON /COMPLEMENT EXPONENT | |
2374 | CIA | |
2375 | SKP | |
2376 | NOEXP, JMS I QBACK1 /PUT BACK NON E | |
2377 | DCA EXPON /ZERO EXPONENT | |
2378 | TAD (43 /NORMALIZE THE NUMBER | |
2379 | DCA WORD1 | |
2380 | JMS I (ANORM | |
2381 | TAD DECPT /WAS THERE A DECIMAL POINT ? | |
2382 | SZA CLA | |
2383 | TAD NDIGIT /HOW MANY DIGITS TO THE RIGHT ? | |
2384 | CIA | |
2385 | TAD EXPON /SUBTRACT THAT NUMBER FROM EXP | |
2386 | SMA | |
2387 | JMP POSEXP /EXPONENT IS POSITIVE | |
2388 | CIA | |
2389 | DCA EXPON /ONLY NEED ABS VALUE | |
2390 | TAD (FPDIV /DO DIVIDES | |
2391 | JMP .+3 | |
2392 | POSEXP, DCA EXPON | |
2393 | TAD (FPMUL /DO MULTIPLIES | |
2394 | DCA FPRTNE /MULTIPLY/DIVIDE ROUTINE | |
2395 | TAD (PETABL-1 | |
2396 | DCA X11 /POWERS OF TEN TABLE | |
2397 | EXPMUL, TAD EXPON /LOOK AT THE EXPONENT | |
2398 | SNA | |
2399 | JMP DOSIGN /IF 0 ITS THRU | |
2400 | CLL RAR | |
2401 | DCA EXPON /PUT LOWEST BIT INTO LINK | |
2402 | SNL | |
2403 | JMP SKPEXP /THIS ONE DOESN'T COUNT | |
2404 | TAD I X11 /MOVE FACTOR INTO OPERAND | |
2405 | DCA OP1 | |
2406 | TAD I X11 | |
2407 | DCA OP2 | |
2408 | TAD I X11 | |
2409 | DCA OP3 | |
2410 | TAD I X11 | |
2411 | DCA OPO | |
2412 | JMS I FPRTNE /MULTIPLY OR DIVIDE BY THIS FACTOR | |
2413 | JMP EXPMUL /CHECK NEXT BIT | |
2414 | SKPEXP, TAD X11 /SKIP OVER THIS FACTOR | |
2415 | TAD (4 | |
2416 | JMP EXPMUL-1 | |
2417 | DOSIGN, TAD SIGN /CHECK THE SIGN | |
2418 | SZA CLA | |
2419 | JMS I (NEGFAC /NEGATE IF NEGATIVE | |
2420 | ISZ NUMBER /BUMP RETURN | |
2421 | JMP I NUMBER /RETURN | |
2422 | NXTDGT, 0 | |
2423 | \f | |
2424 | /INPUT DEVICE HANDLER | |
2425 | *INDEVH | |
2426 | 0 | |
2427 | \f/INITIALIZATION CODE FOR RUN CASE | |
2428 | PAGE | |
2429 | RUNNED, CIF 10 /COME HERE IF .R BCOMP | |
2430 | JMS I (200 /CALL COMMAND DECODER | |
2431 | 5 | |
2432 | 0201 /ASSUMED EXTENSION "BA" | |
2433 | CDF 10 | |
2434 | TAD I (7644 /TEST FOR /V | |
2435 | CDF | |
2436 | AND (4 | |
2437 | SZA CLA | |
2438 | JMS VERNUM | |
2439 | TAD (INFO-1 | |
2440 | DCA X10 | |
2441 | CDF 10 | |
2442 | TAD 7617 | |
2443 | CDF | |
2444 | SNA CLA /NULL INPUT? | |
2445 | JMP RUNNED /YES: NAUGHTY | |
2446 | TAD 7777 | |
2447 | CLL RAL /BATCH RUNNING | |
2448 | SPA CLA | |
2449 | JMP SAVBOS /YES | |
2450 | CDF 10 | |
2451 | JMP FINDSV-2 | |
2452 | SAVBOS, TAD (INFO-5 | |
2453 | DCA X10 | |
2454 | TAD 7777 | |
2455 | AND (70 | |
2456 | TAD CDFZRO | |
2457 | DCA .+1 /CDF TO BATCH FIELD | |
2458 | CDF 10 | |
2459 | TAD I BOSCTR | |
2460 | CDF 10 | |
2461 | DCA I X10 /SAVE BOS WRDS IN INFO AREA | |
2462 | ISZ BOSCTR | |
2463 | JMP .-5 | |
2464 | DCA I X10 /ZERO EDITOR BLOCK NUMBER | |
2465 | CDF | |
2466 | FINDSV, TAD I X11 /LOOKUP SOME SAVE FILES | |
2467 | SNA | |
2468 | JMP LUBUF /GO LOOK FOR BASIC.UF | |
2469 | DCA XXXXSV /SAVE POINTER TO NAME | |
2470 | CLA IAC /THEY'RE ON SYS | |
2471 | CIF 10 | |
2472 | JMS I (200 | |
2473 | 2 | |
2474 | XXXXSV, 0 | |
2475 | 0 | |
2476 | JMP NG /ERROR | |
2477 | TAD XXXXSV /GET STARTING BLOCK | |
2478 | IAC /PLUS 1 | |
2479 | CDF 10 | |
2480 | DCA I X10 /INTO INFO AREA | |
2481 | CDFZRO, CDF | |
2482 | JMP FINDSV /LOOP | |
2483 | LUBUF, CLA IAC | |
2484 | CIF 10 | |
2485 | JMS I (200 /LOOKUP BASIC.UF | |
2486 | 2 | |
2487 | BUFN /(USER DEFINED FUNCTIONS) | |
2488 | 0 | |
2489 | JMP .+3 /OK IF NOT THERE | |
2490 | TAD .-3 /GET STARTING BLOCK +1 | |
2491 | IAC | |
2492 | CDF 10 | |
2493 | DCA I X10 /INTO INFO BLOCK | |
2494 | STRT3, CDF | |
2495 | CLA IAC /ENTER TEMPORARY FILE | |
2496 | CIF 10 | |
2497 | JMS I (200 | |
2498 | 3 | |
2499 | TMPBLK, TMPFIL | |
2500 | 0 | |
2501 | JMP NG | |
2502 | TAD TMPBLK /SAVE START OF TEMP FILE | |
2503 | DCA OUBLOK | |
2504 | TAD TMPBLK /IN A COUPLE PLACES | |
2505 | DCA BLOCK | |
2506 | TAD TMPBLK+1/ALSO THE SIZE | |
2507 | DCA OUSIZE | |
2508 | JMP GETDEV /GO FETCH DEVICE HANDLER | |
2509 | BOSCTR, 7774 | |
2510 | VERNUM, 0 | |
2511 | TAD (VTEXT | |
2512 | DCA TEMP | |
2513 | TAD (-5 | |
2514 | DCA TEMP2 | |
2515 | TLS | |
2516 | MOREV, TAD I TEMP | |
2517 | CLL RTR | |
2518 | RTR | |
2519 | RTR | |
2520 | JMS TTY | |
2521 | TAD I TEMP | |
2522 | JMS TTY | |
2523 | ISZ TEMP | |
2524 | ISZ TEMP2 | |
2525 | JMP MOREV | |
2526 | TAD (215 | |
2527 | JMS TTX | |
2528 | TAD (212 | |
2529 | JMS TTX | |
2530 | TSF /WAIT FOR TTY TO GET DONE | |
2531 | JMP .-1 /BEFORE RETURNING | |
2532 | JMP I VERNUM | |
2533 | / | |
2534 | VTEXT, TEXT /BCOMP V/ | |
2535 | *.-1 | |
2536 | VERLOC, VERSON^100+6001 | |
2537 | 0 | |
2538 | \f/ NUMERIC CONVERSION ROUTINE (PART TWO) | |
2539 | PAGE | |
2540 | FPMUL, 0 /FLOATING MULTIPLY ROUTINE | |
2541 | TAD WORD1 /COMPUTE NEW EXPONENT | |
2542 | TAD OP1 | |
2543 | DCA OP1 | |
2544 | TAD WORD2 /SAVE AC MANTISSA | |
2545 | DCA TW2 | |
2546 | TAD WORD3 | |
2547 | DCA TW3 | |
2548 | TAD (-30 /SET ITERATION COUNTER | |
2549 | DCA ITRCNT | |
2550 | DCA WORD2 /ZERO FAC MANTISSA | |
2551 | DCA WORD3 | |
2552 | DCA ACO | |
2553 | MULLUP, JMS I (AR1 /SHIFT FAC RIGHT ONE | |
2554 | TAD TW2 /SHIFT MULTIPLIER RIGHT | |
2555 | CLL RAR | |
2556 | DCA TW2 | |
2557 | TAD TW3 | |
2558 | RAR | |
2559 | DCA TW3 | |
2560 | SZL | |
2561 | JMS OADD /ADD IF LINK IS ONE | |
2562 | ISZ ITRCNT /BUMP COUNT | |
2563 | JMP MULLUP /LOOP | |
2564 | TAD OP1 /PUT IN CORRECT EXPONENT | |
2565 | DCA WORD1 | |
2566 | JMS ANORM /NORMALIZE THE RESULT | |
2567 | JMP I FPMUL | |
2568 | D2, | |
2569 | TW2, 0 | |
2570 | D3, | |
2571 | TW3, 0 | |
2572 | NFCNT, | |
2573 | ANORM, 0 /NORMALIZE FAC | |
2574 | TAD WORD2 /IS MANTISSA 0 ? | |
2575 | SNA | |
2576 | TAD WORD3 | |
2577 | SNA | |
2578 | TAD ACO | |
2579 | SNA CLA | |
2580 | JMP ZEXP /YES, ZERO EXPONENT | |
2581 | NORMLP, CLA CLL CML RTR /IS HIGH ORDER MANTISSA = 6000 | |
2582 | TAD WORD2 | |
2583 | SZA | |
2584 | JMP NO6000 /NO, SKIP THIS CRAP | |
2585 | TAD WORD3 /YES, IS THE REST 0 ? | |
2586 | SNA | |
2587 | TAD ACO | |
2588 | SZA CLA /SKIP IF 600000 ... 0000 | |
2589 | NO6000, SPA CLA | |
2590 | JMP I ANORM /NORM IS DONE WHEN BITS DIFFER | |
2591 | JMS I (AL1 /SHIFT LEFT ONE | |
2592 | CLA CMA /DECREMENT EXPONENT | |
2593 | TAD WORD1 | |
2594 | DCA WORD1 | |
2595 | JMP NORMLP /LOOP | |
2596 | ZEXP, DCA WORD1 | |
2597 | JMP I ANORM | |
2598 | NEGFAC, 0 /NEGATE FAC | |
2599 | TAD (ACO /GET POINTER TO OPERAND | |
2600 | DCA NFPTR | |
2601 | CLL CMA RTL /THREE WORD NEGATE | |
2602 | DCA NFCNT | |
2603 | CLL | |
2604 | NFLOOP, RAL | |
2605 | TAD I NFPTR /GET NEXT WORD | |
2606 | CLL CML CIA | |
2607 | DCA I NFPTR /RESTORE AFTER COMPLEMENTING | |
2608 | CML CLA CMA /LINK GETS COMPLEMENTED ONCE HERE | |
2609 | TAD NFPTR /AND ONCE AGAIN HERE | |
2610 | DCA NFPTR /RESTORE DECREMENTED POINTER | |
2611 | ISZ NFCNT | |
2612 | JMP NFLOOP | |
2613 | JMP I NEGFAC | |
2614 | NFPTR, 0 | |
2615 | FPDIV, 0 | |
2616 | JMS I (AR1 /UNNORMALIZE AC BY ONE | |
2617 | TAD OP1 /COMPUTE FINAL EXPONENT | |
2618 | CIA | |
2619 | TAD WORD1 | |
2620 | DCA OP1 /AND SAVE IT | |
2621 | TAD (-30 /SET ITERATION COUNTER | |
2622 | DCA ITRCNT | |
2623 | TAD WORD2 | |
2624 | RAL /INITIALIZE LINK | |
2625 | FPDVLP, CLA RAR /COMPARE SIGNS | |
2626 | TAD OP2 | |
2627 | SPA CLA | |
2628 | JMP .+3 | |
2629 | TAD (OPO-ACO/NEGATE OPERAND | |
2630 | JMS NEGFAC | |
2631 | JMS OADD /ADD OPERAND AND FAC | |
2632 | TAD D3 | |
2633 | RAL | |
2634 | DCA D3 | |
2635 | TAD D2 | |
2636 | RAL | |
2637 | DCA D2 | |
2638 | JMS I (AL1 /LEFT SHIFT FAC ONE | |
2639 | ISZ ITRCNT /TEST ITERATION COUNT | |
2640 | JMP FPDVLP | |
2641 | TAD OP1 /PUT QUOTIENT INTO FAC | |
2642 | DCA WORD1 | |
2643 | TAD D2 | |
2644 | DCA WORD2 | |
2645 | TAD D3 | |
2646 | DCA WORD3 | |
2647 | DCA ACO | |
2648 | JMS ANORM /NORMALIZE | |
2649 | JMP I FPDIV | |
2650 | OADD, 0 /ADD OPERAND TO FAC | |
2651 | CLL | |
2652 | TAD OPO | |
2653 | TAD ACO | |
2654 | DCA ACO | |
2655 | RAL | |
2656 | TAD OP3 | |
2657 | TAD WORD3 | |
2658 | DCA WORD3 | |
2659 | RAL | |
2660 | TAD OP2 | |
2661 | TAD WORD2 | |
2662 | DCA WORD2 | |
2663 | JMP I OADD | |
2664 | ITRCNT, 0 | |
2665 | \f/ NUMERIC CONVERSION ROUTINE (FINALE) | |
2666 | PAGE | |
2667 | SMLNUM, 0 /INPUT A NUMBER <= 4095 | |
2668 | EXPLUP, DCA EXPON /ZERO THE EXPONENT | |
2669 | JMS I QDIGIT /GET THE NEXT DIGIT | |
2670 | JMP I SMLNUM /NUMBER DONE | |
2671 | DCA OPO /SAVE THE DIGIT | |
2672 | TAD EXPON /MULT BY 10 | |
2673 | CLL RAL | |
2674 | CLL RAL | |
2675 | TAD EXPON | |
2676 | CLL RAL | |
2677 | TAD OPO /ADD IN DIGIT | |
2678 | JMP EXPLUP /STORE BACK INTO EXPONENT | |
2679 | AR1, 0 /SHIFT FAC RIGHT 1 BIT | |
2680 | TAD WORD2 | |
2681 | CLL RAR | |
2682 | DCA WORD2 | |
2683 | TAD WORD3 | |
2684 | RAR | |
2685 | DCA WORD3 | |
2686 | TAD ACO | |
2687 | RAR | |
2688 | DCA ACO | |
2689 | ISZ WORD1 | |
2690 | JMP I AR1 | |
2691 | JMP I AR1 | |
2692 | AL1, 0 /SHIFT FAC LEFT ONE | |
2693 | TAD ACO | |
2694 | CLL RAL | |
2695 | DCA ACO | |
2696 | TAD WORD3 | |
2697 | RAL | |
2698 | DCA WORD3 | |
2699 | TAD WORD2 | |
2700 | RAL | |
2701 | DCA WORD2 | |
2702 | JMP I AL1 | |
2703 | CHKSGN, 0 /CHECK FOR SIGN | |
2704 | TAD (-55 /IS IT - ? | |
2705 | SNA | |
2706 | ISZ I CHKSGN /YES, SET SWITCH | |
2707 | SZA | |
2708 | TAD (55-53 /IS IT + ? | |
2709 | SZA CLA | |
2710 | JMS I QBACK1 /RETURN CHAR OTHERWISE | |
2711 | JMP I CHKSGN | |
2712 | \f/ STRING LITERAL SCANNER | |
2713 | STRING, 0 /LOOK FOR A STRING | |
2714 | JMS I QCHECKC /LOOK FOR " | |
2715 | M42, -42 | |
2716 | JMP I STRING /NONE MEANS NO STRING | |
2717 | ISZ STRING | |
2718 | DCA WORD1 /ZERO CHAR COUNT | |
2719 | TAD (WORD2 /SETUP POINTER | |
2720 | DCA TEMP | |
2721 | TAD (-STRLIM%2 /AND MAX SIZE | |
2722 | DCA TEMP2 | |
2723 | SLOOP, JMS GCS /GET HIGH ORDER CHAR | |
2724 | JMP I STRING /END OF STRING | |
2725 | CLL RTL | |
2726 | RTL | |
2727 | RTL | |
2728 | DCA I TEMP /PUT INTO UPPER HALF OF WORD | |
2729 | JMS GCS /GET LOWER CHAR | |
2730 | JMP PUT40 /FILL LAST WORD WITH BLANK | |
2731 | TAD I TEMP /COMBINE THEM | |
2732 | DCA I TEMP | |
2733 | ISZ TEMP /BUMP POINTER | |
2734 | ISZ TEMP2 /TOO BIG YET ? | |
2735 | JMP SLOOP /NO, LOOP | |
2736 | JMS I QGETC /MAX SIZE STRING, MUST FIND " | |
2737 | JMP STRGER /BAD STRING LITERAL | |
2738 | TAD M42 | |
2739 | SNA CLA | |
2740 | JMP I STRING /OK | |
2741 | STRGER, JMS I QERMSG /STRING ERROR | |
2742 | 2123 | |
2743 | JMP I STRING | |
2744 | PUT40, TAD I TEMP /GET LAST WORD | |
2745 | TAD (40 /PUT BLANK IN LOW CHAR | |
2746 | DCA I TEMP /STORE NEW WORD | |
2747 | JMP I STRING /RETURN | |
2748 | GCS, 0 /GET A CHAR FOR STRING | |
2749 | JMS I QGETCWB /GET A CHAR (INCLUDE BLANKS) | |
2750 | JMP STRGER /BAD | |
2751 | TAD M42 /IS IT " | |
2752 | SZA | |
2753 | JMP NOTQOT /NO | |
2754 | JMS I QGETCWB /IS IT "" | |
2755 | JMP I GCS /NO, THAT WAS IT | |
2756 | TAD M42 /LOOK FOR SECOND " | |
2757 | SNA CLA | |
2758 | JMP NOTQOT /"" BECOMES " | |
2759 | JMS I QBACK1 /PUT IT BACK | |
2760 | JMP I GCS /LITERAL IS DONE | |
2761 | NOTQOT, TAD (42 /RECREATE CHAR | |
2762 | AND (77 /ELIMINATE EXTRA BITS | |
2763 | ISZ WORD1 /BUMP STRING COUNT | |
2764 | ISZ GCS /FIX RETURN | |
2765 | JMP I GCS | |
2766 | MODSET, 0 /SET INTERPRETER MODE | |
2767 | TAD MODE /SUM OF DESIRED AND CURRENT | |
2768 | SMA CLA | |
2769 | JMP I MODSET /THEY WERE THE SAME | |
2770 | TAD MODE /OTHERWISE SWITCH MODES | |
2771 | SZA CLA | |
2772 | TAD (NMODE-SMODE | |
2773 | TAD (SMODE /ENTER NMODE OR MAYBE SMODE | |
2774 | JMS I QOUTWRD | |
2775 | CLL CML RAR | |
2776 | TAD MODE /CHANGE THE SWITCH | |
2777 | DCA MODE | |
2778 | JMP I MODSET /AND RETURN | |
2779 | XIDIV, FIDIV;AIDIV | |
2780 | WPNT, -120;-116;-124;-50;0 | |
2781 | \f/ VARIABLE OR FUNCTION REFERENCE SCANNER | |
2782 | PAGE | |
2783 | GETNAM, 0 /LOOK FOR VARIABLE OR FUNCT REFNCE | |
2784 | DCA TYPE /ZERO TYPE | |
2785 | JMS I QLETTER /MUST START WITH LETTER | |
2786 | JMP I GETNAM /NO NAME | |
2787 | DCA NAME1 | |
2788 | JMS I QDIGIT /<LETTER><DIGIT> ? | |
2789 | JMP TRYFUN /NO, LOOK FOR FUN REF | |
2790 | IAC /INCREMENT DIGIT | |
2791 | LFDOLR, DCA NAME2 /STORE AS NAME2 | |
2792 | JMS I QGETC /LOOK FOR $ (STRING) | |
2793 | JMP GOTNAM+2/NOT THERE | |
2794 | TAD (-44 | |
2795 | SZA | |
2796 | JMP NOSTRG /NO $ MEANS NO STRING | |
2797 | CLL CML RAR /SET STRING BIT | |
2798 | TAD TYPE | |
2799 | DCA TYPE | |
2800 | JMS I QGETC /LOOK FOR ( (ARRAY) | |
2801 | JMP GOTNAM+2/NAME FINI | |
2802 | TAD (-44 /PRIME THE CHAR | |
2803 | NOSTRG, TAD (44-50 /LOOK FOR ( (ARRAY) | |
2804 | SNA CLA | |
2805 | CLL CML RTR /YES, SET ARRAY BIT | |
2806 | SNA | |
2807 | JMS I QBACK1 /NO, BACKUP 1 CHAR | |
2808 | GOTNAM, TAD TYPE /MODIFY TYPE | |
2809 | DCA TYPE | |
2810 | ISZ GETNAM /BUMP RETURN | |
2811 | JMP I GETNAM | |
2812 | TRYFUN, JMS I QSAVECP /SAVE CHAR POSITION | |
2813 | TAD NAME1 /MOVE FIRST CHAR OVER | |
2814 | CLL RTL | |
2815 | RTL | |
2816 | RTL | |
2817 | DCA NAME2 | |
2818 | JMS I QLETTER /LOOK FOR SECOND LETTER | |
2819 | JMP LFDOLR /NONE THERE, LOOK FOR $ | |
2820 | TAD NAME2 /COMBINE WITH FIRST LETTER | |
2821 | DCA NAME2 | |
2822 | JMS I QLETTER /LOOK FOR THIRD LETTER | |
2823 | JMP NOFNAM /NOT A FUNCTION NAME | |
2824 | DCA NAME3 /PUT INTO NAME | |
2825 | TAD NAME2 /IS IT A USER FUNCT ? | |
2826 | TAD (-616 /FN | |
2827 | SNA CLA | |
2828 | JMP USRFUN /YES | |
2829 | TAD (FUNS-1 /NO, CHECK VALIDITY OF NAME | |
2830 | DCA X10 | |
2831 | FUNSRC, TAD I X10 /GET NEXT FUN NAME | |
2832 | SNA | |
2833 | JMP NOFNAM /END OF LIST, INVALID NAME | |
2834 | TAD NAME2 /COMPARE FIRST 2 CHARS | |
2835 | SZA CLA | |
2836 | JMP NOMATC /THEY DON'T MATCH | |
2837 | TAD I X10 /COMPARE 3RD CHAR | |
2838 | TAD NAME3 | |
2839 | SZA CLA | |
2840 | JMP NOMATC+1/DON'T MATCH | |
2841 | TAD I X10 /GET FUNCTION CODE | |
2842 | FUNOK, DCA SYMBOL /SAVE IT AS SYMBOL VALU | |
2843 | TAD (1000 /SET FUNCTION BIT | |
2844 | DCA TYPE | |
2845 | JMP LFDOLR /LOOK FOR Q$] Q(] | |
2846 | NOMATC, ISZ X10 /SKIP THIRD CHAR | |
2847 | ISZ X10 /SKIP FUNCTION NUMBER | |
2848 | JMP FUNSRC /KEEP LOOKING | |
2849 | NOFNAM, JMS I QRESTCP /RESTORE CHAR POS | |
2850 | JMP LFDOLR /LOOK FOR Q$] Q(] | |
2851 | USRFUN, TAD NAME3 /GENERATE FUN NUMBER | |
2852 | JMP FUNOK | |
2853 | \f/ ERROR MESSAGE REPORTER | |
2854 | ERMSG, 0 /PRINT ERROR MESSAGE | |
2855 | CLA | |
2856 | CDF | |
2857 | TAD I ERMSG /GET CODE | |
2858 | CLL RTR /PRINT FIRST CHAR | |
2859 | RTR | |
2860 | RTR | |
2861 | JMS TTY | |
2862 | TAD I ERMSG /PRINT SECOND CHAR | |
2863 | JMS TTY | |
2864 | ISZ ERMSG /FIX RETURN ADDR | |
2865 | TAD SPACE /PRINT SPACE | |
2866 | JMS TTY | |
2867 | DCA TTY /USE TTY AS A SWITCH | |
2868 | TAD LINEH /PRINT HIGH ORDER | |
2869 | JMS PSN | |
2870 | TAD LINEL /THEN LOW ORDER | |
2871 | JMS PSN /(LINE NUMBER NATCH !) | |
2872 | TAD (215 /PRINT CARRIAGE RETURN | |
2873 | JMS TTX | |
2874 | TAD (212 /PRINT LINE FEED | |
2875 | JMS TTX | |
2876 | JMP I ERMSG /RETURN | |
2877 | PSN, 0 /PRINT 3 DIGITS DECIMAL | |
2878 | DCA WORD2 | |
2879 | CLL CMA RTL /-3 | |
2880 | DCA TEMP | |
2881 | PRNTSN, TAD WORD2 /GET NEXT DIGIT | |
2882 | CLL RTL /INTO THE LOW ORDER | |
2883 | RTL /THREE BITS AND THE LINK | |
2884 | DCA WORD2 /SAVE SHIFTED NUMBER | |
2885 | TAD WORD2 /NOW DO LAST SHIFT | |
2886 | RAL | |
2887 | AND (17 /ONLY FOUR BITS | |
2888 | SPACE, SZA | |
2889 | JMP NOZERO /NOT A ZERO | |
2890 | TAD TTY /ANY DIGITS YET ? | |
2891 | SNA CLA | |
2892 | JMP LEAD0 /NO, ITS A LEADING ZERO | |
2893 | NOZERO, TAD (60 /MAKE IT ASCII | |
2894 | JMS TTY /PRINT DIGIT | |
2895 | LEAD0, ISZ TEMP /BUMP COUNT | |
2896 | JMP PRNTSN /MORE DIGIT(S) | |
2897 | JMP I PSN | |
2898 | XMUL, FMPY;AFMPY | |
2899 | \f/ EXPONENT TABLE | |
2900 | PAGE | |
2901 | PETABL, 0004;2400;0000;0000 | |
2902 | 0007;3100;0000;0000 | |
2903 | 0016;2342;0000;0000 | |
2904 | 0033;2765;7020;0000 | |
2905 | 0066;2160;6744;6770 | |
2906 | 0153;2356;1326;6501 | |
2907 | 0325;3023;6017;5120 | |
2908 | 0652;2235;6443;7114 | |
2909 | 1523;2523;7565;7735 | |
2910 | 3245;3430;6320;2565 | |
2911 | \f/ OPERATOR TABLE | |
2912 | OPR8RS, PLUS;-53 | |
2913 | MINUS;-55 | |
2914 | STAR;-52 | |
2915 | SLASH;-57 | |
2916 | UPAROW;-136 | |
2917 | AMPSND;-46 | |
2918 | 0 | |
2919 | SASIGN, 4000;XSTOR | |
2920 | ASSIGN, 0;XSTOR | |
2921 | \f/ FUNCTION NAME TABLE (INTERNAL FUNCTIONS) | |
2922 | FUNS, -0102;-23;FUNC3 | |
2923 | -0123;-03;FUNC2 | |
2924 | -0124;-16;FUNC1 | |
2925 | -0310;-22;FUNC2+20 | |
2926 | -0317;-23;FUNC1+20 | |
2927 | -0401;-24;FUNC2+40 | |
2928 | -0530;-20;FUNC1+40 | |
2929 | -1116;-24;FUNC1+100 | |
2930 | -1405;-16;FUNC2+60 | |
2931 | -1417;-07;FUNC1+120 | |
2932 | -2017;-23;FUNC2+100 | |
2933 | -2216;-04;FUNC1+200 | |
2934 | -2305;-07;FUNC2+120 | |
2935 | -2307;-16;FUNC1+140 | |
2936 | -2311;-16;FUNC1+160 | |
2937 | -2321;-22;FUNC1+220 | |
2938 | -2324;-22;FUNC2+140 | |
2939 | -2601;-14;FUNC2+160 | |
2940 | -2422;-03;FUNC2+220 | |
2941 | ENDFNS, 0;0;FUNC4 /SPACE FOR NEW FUNCTIONS | |
2942 | 0;0;FUNC4+20 | |
2943 | 0;0;FUNC4+40 | |
2944 | 0;0;FUNC4+60 | |
2945 | 0;0;FUNC4+100 | |
2946 | 0;0;FUNC4+120 | |
2947 | 0;0;FUNC4+140 | |
2948 | 0;0;FUNC4+160 | |
2949 | 0;0;FUNC4+200 | |
2950 | 0;0;FUNC4+220 | |
2951 | 0;0;FUNC4+240 | |
2952 | 0;0;FUNC4+260 | |
2953 | 0;0;FUNC4+300 | |
2954 | 0;0;FUNC4+320 | |
2955 | 0;0;FUNC4+340 | |
2956 | 0;0;FUNC4+360 /SIXTEEN OF THEM | |
2957 | 0 | |
2958 | \f/ KEYWORD LIST | |
2959 | KEYWRD, -114;-105;-124;LET | |
2960 | -111;-106;-105;-116;-104;IFEND | |
2961 | -111;-106;IF | |
2962 | -106;-117;-122;FOR | |
2963 | -116;-105;-130;-124;NEXTX | |
2964 | WGOTO, -107;-117 | |
2965 | WTO, -124;-117;GOTO | |
2966 | -107;-117;-123;-125;-102;GOSUB | |
2967 | -111;-116;-120;-125;-124;INPUT | |
2968 | -120;-122;-111;-116;-124;PRINT | |
2969 | -104;-111;-115;DIM | |
2970 | -104;-101;-124;-101;DATA | |
2971 | -104;-105;-106;DEF | |
2972 | -106;-111;-114;-105;FILE | |
2973 | -122;-105;-101;-104;READX | |
2974 | -122;-105;-115;REMARK | |
2975 | -122;-105;-123;-124;-117;-122;-105;RESTOR | |
2976 | -122;-105;-124;-125;-122;-116;RETURN | |
2977 | -123;-124;-117;-120;STOPX | |
2978 | -122;-101;-116;-104;-117;-115;-111;-132;-105;RANDOM | |
2979 | -103;-114;-117;-123;-105;CLOSE | |
2980 | -103;-110;-101;-111;-116;CHAIN | |
2981 | -125;-104;-105;-106;UDEF | |
2982 | -125;-123;-105;USEX | |
2983 | -105;-116;-104;END | |
2984 | 0 | |
2985 | \f/ OS-8 OUTPUT ROUTINE | |
2986 | OWTEMP, 0 | |
2987 | OUPTR, OUBUF | |
2988 | OCOUNT, -401 | |
2989 | OUTWRD, 0 /OUTPUT ROUTINE | |
2990 | DCA OWTEMP /SAVE WORD | |
2991 | ISZ LOCTRL /INCREMENT PSEUDO CODE | |
2992 | SKP /LOCATION COUNTER | |
2993 | ISZ LOCTRH /BOTH HALVES | |
2994 | NOP /IT'LL NEVER HAPPEN | |
2995 | ISZ OCOUNT /TEST FOR BUFFER FULL | |
2996 | JMP NOWRIT /STILL SOME ROOM | |
2997 | JMS OUDUMP /DUMP THE BUFFER | |
2998 | TAD OUBLOK-1/RESET BUFFER PARAMETERS | |
2999 | DCA OUPTR | |
3000 | TAD (-400 | |
3001 | DCA OCOUNT | |
3002 | NOWRIT, TAD OWTEMP /PUT WORD | |
3003 | CDF 10 | |
3004 | DCA I OUPTR /INTO BUFFER | |
3005 | CDF | |
3006 | ISZ OUPTR /MOVE POINTER | |
3007 | JMP I OUTWRD | |
3008 | OUDUMP, 0 /DUMP OUT BUFFER | |
3009 | JMS I (7607 /CALL OUTPUT HANDLER | |
3010 | 4210 | |
3011 | OUBUF | |
3012 | OUBLOK, 0 | |
3013 | JMP OUERR | |
3014 | ISZ OUBLOK /INCREMENT BLOCK NUMBER | |
3015 | ISZ OUSIZE /CHECK FOR HOLE FULL | |
3016 | JMP I OUDUMP | |
3017 | OUERR, JMS I QERMSG /OUTPUT FILE ERROR | |
3018 | 1706 | |
3019 | JMP I XABORT /ABORT COMPILATION | |
3020 | ODEVH, 0 | |
3021 | OUSIZE, 0 | |
3022 | AMPRTN, JMS LOD1ST /LOAD OP1$ | |
3023 | AMPSND+2 /CONC OP2$ | |
3024 | SCRTN, JMS LOD1ST /LOAD OP1$ | |
3025 | SCOMPR+1 /COMP OP2$ | |
3026 | LOD1ST, 0 /HANDLE ONE WAY INSTRUCTIONS | |
3027 | JMS I QSAVAC /STORE 2ND ARG IF IN SAC | |
3028 | -1 | |
3029 | CLA CMA /GET TYPE OF 2ND ARG | |
3030 | TAD OSTACK | |
3031 | DCA TEMP | |
3032 | CLL CML RTR /IS IT SUBSCRIPTED ? | |
3033 | AND I TEMP | |
3034 | SNA CLA | |
3035 | JMP SKIP2 /NO, ENTRY IS ONLY 2 WORDS | |
3036 | TAD I TEMP /GET NUMBER OF DIMS | |
3037 | AND SCOMPR /LITERAL 3 | |
3038 | CLL RAL /DOUBLE IT | |
3039 | CIA | |
3040 | SKIP2, TAD (-2 /FIND SIZE OF 2ND ARG | |
3041 | DCA OP2SIZ /AND SAVE IT | |
3042 | TAD OSTACK /BACK UP STACK | |
3043 | TAD OP2SIZ | |
3044 | DCA OSTACK | |
3045 | TAD OSTACK /AND SAVE THIS ADDR | |
3046 | DCA X12 | |
3047 | JMS I QLOAD /LOAD ARG 1 | |
3048 | CLL CML RAR /GET TYPE BIT | |
3049 | AND TYPE1 /PUT BACK ARG1 | |
3050 | TAD Q400 | |
3051 | DCA I OSTACK | |
3052 | DCA I OSTACK | |
3053 | TAD I X12 /PUT BACK ARG 2 | |
3054 | DCA I OSTACK | |
3055 | ISZ OP2SIZ | |
3056 | JMP .-3 | |
3057 | TAD I LOD1ST /GET OPERATOR FINISH | |
3058 | JMP OUTOPR+1/GO FINISH CODE | |
3059 | OP2SIZ, 0 /SACRED COUNT WORD | |
3060 | CHECKC, 0 /CHAR CHECKER | |
3061 | JMS I QGETC /GET A CHARACTER | |
3062 | JMP .+6 /FAILED | |
3063 | TAD I CHECKC /COMPARE | |
3064 | SNA | |
3065 | ISZ CHECKC /MATCHES, SKIP TWO | |
3066 | SZA CLA | |
3067 | JMS I QBACK1 /NO MATCH, REPLACE | |
3068 | ISZ CHECKC /ALWAYS SKIP AT LEAST 1 | |
3069 | JMP I CHECKC | |
3070 | SCOMPR, 3;SCRTN-3;4000;XSCOMP;XSCOMP | |
3071 | \f/ OS-8 FILE INPUT ROUTINE | |
3072 | PAGE | |
3073 | ICHAR, 0 /READ CHAR FROM INPUT FILE | |
3074 | ISZ INJMP /BUMP THREE WAY UNPACK SWITCH | |
3075 | ISZ INCHCT | |
3076 | INJMPP, JMP INJMP | |
3077 | TAD INEOF /LAST READ YEILD END OF FILE ? | |
3078 | SZA CLA | |
3079 | JMP ENDFIL /YES | |
3080 | INGBUF, TAD INCTR /BUMP RECORD COUNTER | |
3081 | CLL IAC | |
3082 | SNL | |
3083 | DCA INCTR /RESTORE IF IT HASN'T OVERFLOWED | |
3084 | SZL | |
3085 | ISZ INEOF /SET END OF FILE SWITCH | |
3086 | JMS I INHNDL /DO THE READ | |
3087 | 0200 /ONE BLOCK TO FIELD 0 | |
3088 | INBUFP, INBUF | |
3089 | INREC, 0 | |
3090 | JMP INERR /HANDLER ERROR | |
3091 | INBREC, ISZ INREC /BUMP RECORD NUMBER | |
3092 | TAD (-601 /SET CHAR COUNT | |
3093 | DCA INCHCT | |
3094 | TAD INJMPP /RESET THREE WAY JUMP SWITCH | |
3095 | DCA INJMP | |
3096 | TAD INBUFP /RESET BUFFER POINTER | |
3097 | DCA INPTR | |
3098 | JMP ICHAR+1 /GO AGAIN | |
3099 | INERR, SMA CLA | |
3100 | JMP INBREC | |
3101 | ENDFIL, JMS I QERMSG /INPUT FILE ERROR | |
3102 | 1505 | |
3103 | ABORT, TAD (4207 /RESTORE ^C LOCZTIONS | |
3104 | DCA 7600 | |
3105 | TAD (6213 | |
3106 | DCA 7605 | |
3107 | CDF 10 | |
3108 | TAD INFO /GET START OF BASIC.SV | |
3109 | CDF | |
3110 | SNA | |
3111 | JMP 7605 /T'WERE RUNNED | |
3112 | DCA EDTBLK /SAVE MAGICAL BLOCK NUMBER | |
3113 | JMS 7607 /USE SYS HANDLER | |
3114 | EDTSIZ /TO READ IN THIS MUCH | |
3115 | 0 /INTO ZERO | |
3116 | EDTBLK, 0 /FROM HERE | |
3117 | HLT /HALT IF BAD READ | |
3118 | JMP EDTBGN /GO RESTART EDITOR | |
3119 | INJMP, HLT /3 WAY CHAR UNPACK JUMP | |
3120 | JMP ICHAR1 | |
3121 | JMP ICHAR2 | |
3122 | ICHAR3, TAD INJMPP /RESET JUMP SWITCH | |
3123 | DCA INJMP | |
3124 | TAD I INPTR | |
3125 | AND (7400 /COMBINE THE HIGH ORDER BITS | |
3126 | CLL RTR /OF THE TWO WORDS | |
3127 | RTR | |
3128 | TAD INTMP /TO FORM THE THIRD CHAR | |
3129 | RTR | |
3130 | RTR | |
3131 | ISZ INPTR /BUMP WORD POINTER | |
3132 | JMP ICHAR1+1/DO SOME COMMON STUFF | |
3133 | ICHAR2, TAD I INPTR /SAVE THE HIGH ORDER BITS | |
3134 | AND (7400 | |
3135 | DCA INTMP /FOR THE THIRD CHAR | |
3136 | ISZ INPTR /GO TO THE SECOND WORD | |
3137 | ICHAR1, TAD I INPTR /GET THE LOW 7 BITS | |
3138 | AND (177 /AND I MEAN ONLY 7 !! | |
3139 | SNA /IGNOR LEADER-TRAILER | |
3140 | JMP ICHAR+1 | |
3141 | TAD (-134 /CHECK FOR \ (STMT SEPARATOR) | |
3142 | SNA | |
3143 | JMP I ICHAR /TREAT LIKE CR | |
3144 | TAD (134-32 /IS IT ^Z (END OF FILE) | |
3145 | SNA | |
3146 | JMP ENDFIL /YES, ITS END OF FILE | |
3147 | TAD (32-12 | |
3148 | SNA | |
3149 | JMP ICHAR+1 /IGNORE LINE FEEDS | |
3150 | IAC /TABS -> BLANKS | |
3151 | SNA | |
3152 | TAD (40-11 | |
3153 | TAD (11-15 | |
3154 | SNA | |
3155 | JMP I ICHAR /RETURN ON CARRIAGE RETURN | |
3156 | IAC | |
3157 | SNA | |
3158 | JMP ICHAR+1 /IGNORE FORM FEEDS | |
3159 | TAD (14 /FIX CHAR | |
3160 | ISZ ICHAR | |
3161 | JMP I ICHAR /RETURN TO THE CALLING WORLD | |
3162 | INTMP, 0 | |
3163 | INEOF, 0 | |
3164 | INCHCT, -1 | |
3165 | INHNDL, 0 /ENTRY ADDR GOES HERE | |
3166 | INCTR, 0 | |
3167 | INPTR, 0 | |
3168 | CHKWD, 0 /WORD CHECKER | |
3169 | TAD I CHKWD /GET POINTER | |
3170 | ISZ CHKWD | |
3171 | DCA CWTEMP /SAVE POINTER | |
3172 | WDLOOP, TAD I CWTEMP /GET NEXT CHAR | |
3173 | SMA | |
3174 | ISZ CHKWD /IF NON NEG, FIX RETURN | |
3175 | SPA CLA | |
3176 | JMS I QGETC /GET CHAR | |
3177 | JMP I CHKWD /RETURN | |
3178 | TAD I CWTEMP /COMPARE | |
3179 | ISZ CWTEMP /INCR POINTER | |
3180 | SNA CLA | |
3181 | JMP WDLOOP /MORE | |
3182 | JMP I CHKWD /FAILED | |
3183 | CWTEMP, 0 | |
3184 | \f/ INITIALIZATION CODE | |
3185 | *LINE | |
3186 | START, JMP RUNNED /DO LOOKUPS, AND FIND TEMPFILE | |
3187 | CHAINED,CDF 10 | |
3188 | TAD I (7644 /WAS IT A CHAIN FROM BRTS ? | |
3189 | CDF | |
3190 | AND (100 | |
3191 | SNA CLA | |
3192 | JMP CHEDIT /NO, FROM THE EDITOR | |
3193 | CIF 10 /CHAIN FROM BRTS, RESET | |
3194 | JMS I (200 /TO FORGET DSK: HANDLER | |
3195 | 13 | |
3196 | JMP STRT3 /NOW GO OPEN TEMP FILE | |
3197 | CHEDIT, TAD (INFO+7 /PICK UP SOME STUFF | |
3198 | DCA X10 | |
3199 | CDF 10 /FROM THE INFO BLOCK | |
3200 | TAD I X10 /START OF TEMP FILE | |
3201 | SNA | |
3202 | JMP I (RUNNED+4 /MUST BE CHAIN FROM CCL | |
3203 | DCA BLOCK | |
3204 | TAD I X10 /SIZE OF HOLE | |
3205 | CDF | |
3206 | DCA OUSIZE | |
3207 | TAD BLOCK | |
3208 | DCA OUBLOK | |
3209 | CDF 10 | |
3210 | TAD I X10 /ENTRY ADDR OF HANDLER | |
3211 | CDF | |
3212 | DCA INHNDL | |
3213 | JMP STRT2 | |
3214 | GETDEV, CDF 10 | |
3215 | TAD 7617 /GET DEVICE NUM FOR INPUT FILE | |
3216 | CDF | |
3217 | CIF 10 | |
3218 | JMS I (200 /GO FETCH THE DEVICE | |
3219 | 1 | |
3220 | INDEVH+1 /2 PAGE HANDLER IS OK | |
3221 | JMP NG /ERROR | |
3222 | TAD .-2 /GET HANDLER ADDRESS | |
3223 | DCA INHNDL /SAVE IT | |
3224 | CIF 10 | |
3225 | JMS I (200 /RESET SYSTEM TABLES | |
3226 | 13 /DELETING TENTATIVE FILES | |
3227 | STRT2, CDF 10 | |
3228 | TAD 7617 /SET UP INPUT FILE PARAMS | |
3229 | CDF | |
3230 | AND (7760 /GET SIZE | |
3231 | TAD (17 | |
3232 | CLL CML RTR | |
3233 | RTR | |
3234 | DCA INCTR | |
3235 | CDF 10 | |
3236 | TAD 7620 /GET BLOCK NUMBER | |
3237 | CDF | |
3238 | DCA INREC | |
3239 | CDF 10 | |
3240 | TAD INFO+3 /GET START OF BRTS.SV (+1) | |
3241 | DCA BRTS | |
3242 | TAD INFO /GET START OF BASIC.SV (+1) | |
3243 | DCA ABORTX /BOTH FOR BLOAD | |
3244 | TAD INFO+2 /GET START OF BLOAD.SV | |
3245 | CDF | |
3246 | DCA LDRBLK /FOR CHAIN TO BLOAD | |
3247 | TLS /SET TTY FLAG | |
3248 | ISZ WASTE | |
3249 | JMP .-1 | |
3250 | ISZ TIME | |
3251 | JMP .-1 | |
3252 | INITST, TAD (VARST-1/INITIALIZE ST AREA | |
3253 | DCA X12 | |
3254 | TAD (-436-436-436 | |
3255 | DCA X11 /SIZE OF NUM AND STRING TABLES | |
3256 | CDF 10 | |
3257 | CLL CML RAR /SET TO 4000 | |
3258 | DCA I X12 | |
3259 | ISZ X11 | |
3260 | JMP .-3 | |
3261 | TAD (-440 /NOW ARRAY TABLES | |
3262 | DCA X11 /AND BUCKETS | |
3263 | DCA I X12 | |
3264 | ISZ X11 /SET THEM TO ZERO | |
3265 | JMP .-2 | |
3266 | CDF | |
3267 | TAD JABORT /MODIFY ^C LOCATIONS | |
3268 | DCA 7600 | |
3269 | TAD JABORT | |
3270 | DCA 7605 | |
3271 | JMP CORE /GET CORE SIZE | |
3272 | NG, TLS | |
3273 | JMS I QERMSG /SUPER ERROR | |
3274 | 2331 | |
3275 | TSF | |
3276 | JMP .-1 | |
3277 | JABORT, JMP I XABORT /ABORT COMPILATION | |
3278 | WASTE, 0 | |
3279 | TIME, 200 | |
3280 | \f *INBUF | |
3281 | CORE, TAD 7777 /MODIFIED CORE SIZE ROUTINE FROM | |
3282 | AND (70 | |
3283 | SNA | |
3284 | JMP COR0 | |
3285 | CLL RAR | |
3286 | RTR | |
3287 | IAC | |
3288 | DCA CORSIZ | |
3289 | JMP COREX /OS8 SOFTWARE SUPPORT MANUAL | |
3290 | COR0, CDF | |
3291 | TAD CORSIZ | |
3292 | RTL | |
3293 | RAL | |
3294 | AND COR70 | |
3295 | TAD COREX | |
3296 | DCA .+1 | |
3297 | COR1, CDF | |
3298 | TAD I CORLOC | |
3299 | COR2, NOP | |
3300 | DCA COR1 | |
3301 | TAD COR2 | |
3302 | DCA I CORLOC | |
3303 | COR70, 70 | |
3304 | TAD I CORLOC | |
3305 | CORX, 7400 | |
3306 | TAD CORX | |
3307 | TAD CORV | |
3308 | SZA CLA | |
3309 | JMP COREX | |
3310 | TAD COR1 | |
3311 | DCA I CORLOC | |
3312 | ISZ CORSIZ | |
3313 | JMP COR0 | |
3314 | COREX, CDF | |
3315 | CLA CMA /HI FIELD IS #FIELDS-1 | |
3316 | TAD CORSIZ | |
3317 | DCA HIFLD | |
3318 | TAD HIFLD | |
3319 | CIA | |
3320 | DCA NFLDS | |
3321 | CMA /HOW MANY FIELDS ? | |
3322 | TAD HIFLD /MUST THIS BASIC USE ? | |
3323 | SZA CLA /(SOUNDS LIKE A LINE BY DYLAN) | |
3324 | JMP GENER | |
3325 | TAD (PATCH1+3&177+5200 | |
3326 | DCA PATCH1 /ONLY 8K, DON'T USE CDF'S | |
3327 | TAD (PATCH2+11&177+5200 | |
3328 | DCA PATCH2 | |
3329 | TAD (PATCH3+4&177+5200 | |
3330 | DCA PATCH3 | |
3331 | TAD (PATCH4+3&177+5200 | |
3332 | DCA PATCH4 | |
3333 | TAD (7000 | |
3334 | DCA PATCH5 | |
3335 | GENER, JMS GENTMP /GENERATE TEMP 0 | |
3336 | JMS GENTMP /GENERATE TEMP 1 | |
3337 | JMS GENTMP /GENERATE TEMP 2 | |
3338 | CLA IAC /GENERATE STRING TEMP 0 | |
3339 | JMS GENTMP | |
3340 | CLA IAC | |
3341 | DCA WORD1 /GENERATE LITERAL 1.0 | |
3342 | CLL CML RTR | |
3343 | DCA WORD2 | |
3344 | JMS I QLUKUP2 /ENTER INTO ST | |
3345 | LITRL | |
3346 | -3 | |
3347 | JMS NEWVAR | |
3348 | TAD (FNINIT /SET UP FUNCTIONS | |
3349 | DCA FDPTR | |
3350 | FDLOOP, TAD (WORD1-1 | |
3351 | DCA X12 | |
3352 | TAD I FDPTR /GET FIRST WORD | |
3353 | ISZ FDPTR | |
3354 | SNA | |
3355 | JMP I QREMARK /DONE, START COMPILER | |
3356 | DCA I X12 /SAVE IN WORD1 | |
3357 | CLL CMA RTL /GET LOOKUP COUNT | |
3358 | TAD I FDPTR | |
3359 | DCA FUNSIZ | |
3360 | TAD FUNSIZ /GET SIZE OF MOVE | |
3361 | IAC | |
3362 | DCA TEMP | |
3363 | TAD I FDPTR /GET A WORD | |
3364 | ISZ FDPTR | |
3365 | DCA I X12 /PUT INTO WORDN | |
3366 | ISZ TEMP | |
3367 | JMP .-4 | |
3368 | JMS I QLUKUP2 /ENTER INTO S.T. | |
3369 | FUNCTN | |
3370 | FUNSIZ, 0 | |
3371 | JMP FDLOOP /LOOP | |
3372 | FDPTR, 0 | |
3373 | CORLOC, CORX | |
3374 | CORV, 1400 | |
3375 | CORSIZ, 1 | |
3376 | NAMLST, BCOMPN /SAVE FILE NAME-POINTER LIST | |
3377 | BLOADN | |
3378 | BRTSN | |
3379 | BAFN | |
3380 | BSFN | |
3381 | BFFN | |
3382 | 0 | |
3383 | \f PAGE | |
3384 | FNINIT, FUNC3;-1;2000;0 /ABS | |
3385 | FUNC1;-1;2000;0 /ATN | |
3386 | FUNC2;-1;6000;0 /ASC | |
3387 | FUNC1+20;-1;2000;0 /COS | |
3388 | FUNC2+20;-1;2000;4000 /CHR | |
3389 | FUNC1+40;-1;2000;0 /EXP | |
3390 | FUNC2+40;-1;2000;4000 /DAT | |
3391 | FUNC1+220;-1;2000;0 /SQR | |
3392 | FUNC1+60;-2;0;2000;0 /EXP2 | |
3393 | FUNC2+60;-1;6000;0 /LEN | |
3394 | FUNC1+100;-1;2000;0 /INT | |
3395 | FUNC2+100;-3;2000;4000;6000;0 /POS | |
3396 | FUNC1+120;-1;2000;0 /LOG | |
3397 | FUNC2+120;-3;0;2000;6000;4000 /SEG | |
3398 | FUNC1+140;-1;2000;0 /SGN | |
3399 | FUNC2+140;-1;2000;4000 /STR | |
3400 | FUNC1+160;-1;2000;0 /SIN | |
3401 | FUNC2+160;-1;6000;0 /VAL | |
3402 | FUNC1+200;-1;2000;0 /RND | |
3403 | FUNC2+220;-1;2000;0 /TRC | |
3404 | 0 | |
3405 | BASICN, FILENAME BASIC.SV /FILE NAMES | |
3406 | BCOMPN, FILENAME BCOMP.SV /FOR LOOKUPS | |
3407 | BLOADN, FILENAME BLOAD.SV | |
3408 | BRTSN, FILENAME BRTS.SV | |
3409 | BAFN, FILENAME BASIC.AF | |
3410 | BSFN, FILENAME BASIC.SF | |
3411 | BFFN, FILENAME BASIC.FF | |
3412 | BUFN, FILENAME BASIC.UF | |
3413 | TMPFIL, FILENAME BASIC.TM | |
3414 | $ | |
3415 | \f\f |