1 /EDUCOMP EDU200 BASIC 2 /VERSION 2.0 AS OF 2/14/74 3 /THIS VERSION CONTAINS MINI CHARACTER STRINGS 4 5 /TC08 MNEMONICS : 6 DTSF= 6771 7 DTLB= 6774 8 DTXA= 6764 9 DTCA= 6762 10 DTRB= 6772 11 DTRA= 6761 12 13 14 /AN EDUCOMP SOFTWARE PRODUCT 15 /SOFTWARE PRODUCT MANAGER 16 /DOUGLAS BERGENGREN 17 18 /COPYRIGHT 1974 BY 19 /EDUCOMP CORPORATION 20 /298 PARK ROAD 21 /WEST HARTFORD, CONNECTICUT 06119 22 /EDU200 BASIC IS FOR THE PDP-8/E,-8/F, -8/I, -8/L WITH 23 /8K OR MORE MEMORY AND EITHER THE DC02 OR PT08(KL8E ON 8/E&F) OPTION 24 /THE POWER FAIL-AUTO RESTART OPTION ALSO IS SUPPORTED. 25 26 27 /SAVING EDU200 BASIC ON DIFFERENT MONITOR SYSTEMS: 28 / 29 /OS/8 MONITOR SYSTEM-- 30 / .R ABSLDR 31 / *PTR:=12001$ 32 / .SAVE SYS BASIC 33 / 34 / .R BASIC 35 / 36 /DISK MONITOR SYSTEM-- 37 / .SAVE BAS0!0-7577;40 38 / .SAVE BAS1!10000-10377,11000-13777,17000-17377;0 39 / 40 /TAPE MONITOR SYSTEM-- 41 / .SAVE BAS0!0-7577;30 42 / .SAVE BAS1!1009p/10377,11000-13777,17000-17377;0 43 / 44 / .BAS1 45 / .BAS0 46 47 48 49 /TO GET THE CONFIGURATOR ONLY (IT IS AN OVERLAY TAPE TO BASIC) 50 /DEFINE "CONFIG" AS 1 51 52 53 IFDEF CONFIG < 54 NOPUNCH 55 > 56 /DEFINITIONS 57 58 FIXMRI FJMP=0000 59 FIXMRI FADD=1000 60 FIXMRI FSUB=2000 61 FIXMRI FMPY=3000 62 FIXMRI FDIV=4000 63 FIXMRI FGET=5000 64 FIXMRI FPUT=6000 65 66 FINT=JMS I 7 67 FEXT=0000 68 FNOR=7000 69 70 CAF=6007 71 BSW=7002 72 73 SPL=6102 74 75 MTKF=6123 76 MTPF=6113 77 MTON=6117 78 MINT=6115 79 MINS=6125 80 MKSF=6111 81 MKRB=6116 82 MTSF=6121 83 MTCF=6122 84 MTLS=6126 85 86 RCRB=6634 87 RCRD=6674 88 RTF=6005 89 90 L0001=CLL CLA IAC 91 L0002=CLL CLA CML RTL 92 L0003=CLL CLA CML IAC RAL 93 L0004=CLL CLA IAC RTL 94 L0006=CLL CLA CML IAC RTL 95 L7777=CLL CLA CMA 96 L7776=CLL CLA CMA RAL 97 L7775=CLL CLA CMA RTL 98 L3777=CLL CLA CMA RAR 99 L5777=CLL CLA CMA RTR 100 L4000=CLL CLA CML RAR 101 L2000=CLL CLA CML RTR 102 103 SWAP=10 104 /PAGE ZERO 105 106 FIELD 0 107 108 PAGE 0 109 00000 0000 0 110 00001 6212 CIF 10 /INTERRUPT HANDLER 111 00002 5110 JMP INTR81 112 00003 0000 USER, 0 /INTERRUPT USER COUNTER 113 00004 0000 SIN, 0 /INTERRUPT TEMPORARY 114 00005 0000 TEMP1, 0 /INTERRUPT TEMP 115 00006 3747 TEMP2, USER0 /INTERRUPT TEMP 116 00007 6070 FPT /FLOATING POINT 117 00010 0000 XREG, 0 /INTERRUPT XREG 118 00011 0000 XREG2, 0 /INTERRUPT XREG 119 00012 0000 XREG3, 0 /GENERAL XREG 120 00013 0000 FLTXR, 0 /FLOATING XREG 121 00014 0000 FLTXR2, 0 /FLOATING XREG 122 STSWAP=. /START OF SWAP 123 00015 7776 PDLXR, TOP /PUSH-DOWN XREG 124 00016 0000 AXIN, 0 /PACKING XREG 125 TEXTP=. /TEXT POINTERS 126 00017 0000 AXOUT, 0 /UNPACK XREG 127 00020 0000 GTEM, 0 /UNPACK SWITCH 128 00021 0000 XCT, 0 /UNPACK SWITCH 129 00022 0440 PC, READY /PROGRAM RESTART 130 00023 0000 ADD, 0 /PACK TEMPORARY 131 00024 0000 XCTIN, 0 /PACK SWITCH 132 SUBS=XCTIN /SUBSCRIPT 133 00025 0000 PT1, 0 /FLOATING POINTER 134 00026 0000 CHAR, 0 /CHARACTER 135 00027 0000 LINEPC, 0 /LINE POINTER 136 00030 6213 LINENO, CIF CDF 10 /LINE NUMBER 137 00031 5432 LASTLN, JMP I .+1 /LAST LINE POINTER 138 MODE=LASTLN 139 00032 1662 SPACSW, TAPEM /0 IS IGNORE SPACES 140 00033 7777 DINPUT, -1 /-1 FOR BREAK ON CR ONLY 141 /0 FOR BREAK ON ANY AND NO ECHO 142 00034 0000 OUTPUT, 0 /0 IS ECHO 143 00035 6036 XIOT, KRB /INPUT IOT 144 00036 0000 XFIELD, 0 /USER FIELD 145 00037 0000 DATAPC, 0 /LINE NUMBER OF DATA STATEMENT 146 00040 6213 CIF CDF 10 /DATA POINTER 147 00041 5442 JMP I .+1 /DATA TEMPORARY 148 00042 1672 DISKM /DATA UNPACK SWITCH 149 00043 0000 0 /DATA CHARACTER 150 00044 1301 IPTRI, BUFFER /INPUT BUFFER FILL 151 00045 1301 IPTRO, BUFFER /INPUT BUFFER EMPTY 152 00046 1301 IPTR0, BUFFER /START OF BUFFER 153 00047 1241 OPTRI, BUFFER-40 /OUTPUT BUFFER FILL 154 00050 1241 OPTRO, BUFFER-40 /OUTPUT BUFFER EMPTY 155 00051 0000 TELSW, 0 /TTY BUSY SWITCH 156 00052 0000 PACKST, 0 /START OF PACKING 157 00053 0000 PACKND, 0 /POINTER TO END OF PACKING 158 00054 1425 BUFR, LINE1 /NEXT FREE SPACE 159 STARTV=BUFR /START OF VARIABLES 160 00055 1425 LASTV, LINE1 /LAST DEFINED VARIABLE 161 00056 7776 PDLST, TOP /START OF PUSH-DOWN 162 00057 1423 ALINE0, LINE0 /POINTER TO DUMMY LINE 163 00060 1341 COMBUF, BUFCOM /COMMAND BUFFER 164 00061 0000 PRNTC1, 0 /PRINT ZONE COUNT 165 00062 0000 ERLINE, 0 /ERROR LINE 166 00063 0001 FRNDX, 1 /3 WORD 167 00064 0203 203 /RANDOM INTEGER 168 00065 5555 5555 169 ENSWAP=.-1 170 DECK=XFIELD /USER ON DECK 171 00066 0000 AC0, 0 172 00067 0000 AC1, 0 173 00070 0000 AC2, 0 174 00071 0000 ACX, 0 /FAC (FLOATING POINT ACCUMULATOR) 175 00072 0000 ACH, 0 /HIGH ORDER 176 00073 0000 ACLO, 0 /LOW ORDER 177 00074 0000 OPX, 0 /EXPONENT OF OPERAND 178 00075 0000 OPH, 0 /HIGH ORDER OPERAND 179 00076 0000 OPL, 0 /LOW ORDER OPERAND 180 00077 0000 EVAL1, 0 /UNARY FLAG FOR EXPRESSION EVALUATOR 181 00100 3611 CPACK, XCPACK /POINTER TO PACK ROUTINE FOR STRING FUNCTIONS 182 TM=AC0 183 EXP=ACX 184 HORD=ACH 185 LORD=ACLO 186 00101 0000 SORTCN, 0 /SORT CONSTANT 187 00102 0000 T1, 0 /THREE TEMPS 188 00103 0000 T2, 0 189 00104 0000 T3, 0 190 00105 0000 CNTR, 0 /COUNTER 191 00106 0000 THISOP, 0 /CURRENT OP 192 00107 0000 LASTOP, 0 /LAST OP 193 EFOP=CNTR /FUNCTION OP 194 00110 7400 FLOUTP, FLOUT /FLOATING OUTPUT 195 00111 7200 FLINTP, FLIN /FLOATING INPUT 196 00112 3746 LOOK, USER0-1 /USER BEING RUN OR LOOKED AT 197 00113 3747 LOOKST, USER0 /TO RESET LOOKING 198 00114 0565 FLARGP, FLARG /POINTER TO TEMP FLAC 199 00115 6133 INTEGE, FFIX /FIX THE FLAC ROUTINE 200 00116 0000 FFLAG, 0 /-1 IF OP NOT 0 201 00117 0015 CCR, 15 /CR 202 00120 0007 C7, 7 /BELL 203 00121 0177 C177, 177 /RUBOUT 204 00122 0137 C137, 137 /BACK ARROW 205 00123 0521 LLSTMD, LSTMOD /POINTER TO LSTMOD IN FIELD 1 206 00124 0014 14 /FORM FEED 207 00125 0012 CLF, 12 /LINE FEED 208 00126 7700 M100, -100 /CHARACTOR TEST 209 00127 7740 M40, -40 /-BUFFER SIZE 210 00130 7766 M12, -12 /-10 DECIMAL 211 00131 7772 M6, -6 /-MESSAGE LENGTH 212 00132 7774 M4, -4 /CHARACTOR COUNT 213 00133 0040 C40, 40 /BUFFER SIZE 214 00134 0077 C77, 77 /RIGHT MASK 215 00135 2512 CCONT, CONT /POINTER TO EXECUTE NEXT STATEMENT 216 00136 2540 CJUMP, JUMP /POINTER TO JUMP TO LINE NO. IN AC 217 C7700=M100 218 /NEW INSTRUCTIONS 219 PRINTC=JMS I . /PRINT AC OR CHAR 220 00137 4144 XPRNTC 221 GETC=JMS I . /UNPACK A CHAR 222 00140 4036 XGETC 223 SORTJ=JMS I . /SORT JUMP 224 00141 4721 XSORTJ 225 SORTC=JMS I . /SORT 226 00142 7624 ASORTC, XSORTC 227 PUSHA=JMS I . /SAVE AC 228 00143 1704 XPUSHA 229 PUSHJ=JMS I . /PUSH JUMP 230 00144 1717 XPUSHJ 231 PUSHF=JMS I . /SAVE FLOATING DATA 232 00145 1737 XPUSHF 233 POPA=JMS I . /RESTORE AC 234 00146 1562 XPOPA 235 POPJ=JMP I . /POP JUMP 236 00147 4153 XPOPJ 237 POPF=JMS I . /RESTORE FLOATING DATA 238 00150 4000 XPOPF 239 FLGET=JMS I . /FLOATING GET 240 00151 5136 XFLGET 241 FLPUT=JMS I . /FLOATING PUT 242 00152 7601 XFLPUT 243 PRINTX=JMS I . /DO OUTPUT 244 00153 7654 XOUTL 245 ERROR=JMS I . /ERROR 246 00154 3522 XERROR 247 UDF=JMS I . /USER DATA FIELD 248 00155 3567 AUDF, XUDF 249 RTL6=JMS I . /SIX RAL*S 250 00156 4753 XRTL6 251 TESTN=JMS I . /TEST NUMERIC 252 00157 4016 XTESTN 253 TESTC=JMS I . /TEST CHAR 254 00160 4236 XTESTC 255 PACKC=JMS I . /PACK A CHAR 256 00161 3600 XPACKC 257 GETLN=JMS I . /GET A LINE NUMBER 258 00162 7333 XGETLN 259 TSTCCR=JMS I . /SKIP IF CR 260 00163 4206 CCRTST 261 TSTCOM=JMS I . /SKIP IF COMMA 262 00164 4200 COMTST 263 TSTALP=JMS I . /SKIP IF LETTER 264 00165 4224 ALPTST 265 COMMAN=JMS I . /DETERMINE COMMAND 266 00166 1761 F0CMAN 267 FIND=JMS I . /FIND A STATEMENT 268 00167 4124 XFIND 269 GETNXT=JMS I . /GET NEXT LINE 270 00170 4106 NXTGET 271 FINDLN=JMS I . /FIND A LINE 272 00171 3461 XFINDL 273 FREE13=JMS I . /FREE 14 OUTPUT SPACES 274 00172 1362 XFREE3 275 FREE2=JMS I . /FREE 3 OUTPUT SPACES 276 00173 1352 XFREE2 277 READC=JMS I . /READ A CHAR 278 00174 3704 XREADC 279 TSTEND=JMS I . /TEST FOR END OF LINE 280 00175 4213 ENDTST 281 TSTLPR=JMS I . /SKIP IF L-PAREN 282 00176 3735 LPRTST 283 GETSGN=TAD I FLARGP 284 /MAINLINE BASIC 285 286 /WHENEVER THERE IS NOTHING BETTER TO DO OR A JOB WANTS TO 287 /DISMISS ITSELF SO OTHERS CAN TRY THIS ROUTINE IS ENTERED 288 289 /IT KEEPS LOOKING FOR A JOB WITH BITS 0 AND 1 OFF WHICH 290 /SAYS THAT THE JOB IS NOT WAITING FOR INPUT OR OUTPUT 291 /RESPECTIVELY 292 *177 293 00177 6001 NULL, ION 294 00200 6201 CDF 295 00201 2764 ISZ I LINTCN /COUNT FOR RANDOMIZE 296 00202 0060 C60, 60 /PROTECT THE ISZ 297 00203 1112 TAD LOOK 298 00204 1230 TAD MLOOKE /CHECK POSITION OF POINTER 299 00205 7710 SPA CLA 300 00206 5212 JMP .+4 /O.K. TO LOOK AT NEXT 301 00207 1113 KL8JMP, TAD LOOKST 302 00210 3112 DCA LOOK /RESET POINTER 303 00211 7410 SKP 304 00212 2112 KL8LFL, ISZ LOOK /LOOK AT NEXT 305 00213 1512 TAD I LOOK /GET STATUS 306 00214 7104 CLL RAL 307 00215 7730 SZL SPA CLA 308 00216 5177 JMP NULL /NO GO 309 00217 1512 TAD I LOOK /GET STATUS 310 00220 6002 IOF /NO INTERRUPTS 311 00221 4272 JMS DECKON /PUT HIM ONDECK 312 00222 1022 TAD PC 313 00223 3000 DCA 0 /RESTART LOCATION 314 00224 7346 L7775 /NUMBER OF COMMANDS BEFORE RETURNING 315 00225 3022 DCA PC 316 00226 6001 ION 317 00227 5400 JMP I 0 /GO TO IT... 318 319 00230 4032 MLOOKE, -USER7+10 /LAST STATUS WORD : SUBTRACT NUMBER OF USERS 320 /NEW *PRNTIT* ROUTINE 321 /ENTER WITH A NUMBER BETWEEN 1 AND 2047 IN THE AC. 322 /IT IS PRINTED AS AN UNSIGNED DECIMAL INTEGER. 323 /THIS ROUTINE PRINTS NO SPACES, AND ITS ONLY 324 /ARGUMENT IS THE VALUE PASSED IN THE AC 325 00231 0000 ITPRNT, 0 326 00232 3102 DCA T1 /SAVE NUMBER 327 00233 3013 DCA FLTXR /SIGNIFICANT DIGITS 328 00234 1265 TAD LSTADR 329 00235 3103 DCA T2 /SUBTRACTION LIST POINTER 330 00236 1132 TAD M4 331 00237 3105 DCA CNTR /FOUR DIGITS 332 00240 3104 PRNT1, DCA T3 /SET DIGIT TO 0 333 00241 1102 PRNT2, TAD T1 /GET NUMBER 334 00242 1503 TAD I T2 /SUBTRACT POWER OF TEN 335 00243 7510 SPA /DID IT FIT? 336 00244 5250 JMP PRNT3 /NO, FOUND THIS DIGIT 337 00245 3102 DCA T1 /SAVE NEW NUMBER 338 00246 2104 ISZ T3 /BUMP DIGIT 339 00247 5241 JMP PRNT2 /STILL DOING THIS DIGIT 340 00250 7200 PRNT3, CLA 341 00251 1013 TAD FLTXR /GET SIGNIFIGANCE TESTER 342 00252 1104 TAD T3 /AND DIGIT 343 00253 7650 SNA CLA /BOTH ZERO? 344 00254 5261 JMP PRNT4 /YES: DO NOT PRINT THIS DIGIT 345 00255 1104 TAD T3 /GET DIGIT 346 00256 1202 TAD C60 /CONVERT TO ASCII 347 00257 4537 PRINTC /AND PRINT IT 348 00260 2013 ISZ FLTXR /ALL FURTHER DIGITS ARE SIGNIFICANT 349 00261 2103 PRNT4, ISZ T2 /NEXT POWER OF TEN 350 00262 2105 ISZ CNTR /MORE DIGITS? 351 00263 5240 JMP PRNT1 /YES 352 00264 5631 JMP I ITPRNT /EXIT 353 00265 0266 LSTADR, HERE 354 355 DECIMAL 356 00266 6030 HERE, -1000 357 00267 7634 -100 358 00270 7766 -10 359 00271 7777 -1 360 OCTAL 361 362 /*ONDECK* ROUTINE 363 /ROUTINE TO PUT A USER "ON DECK" 364 /ENTER WITH HIS NUMBER ON AC BITS 9-11 365 00272 0200 DECKON, NULL+1 366 00273 0120 AND C7 /USER NUMBER ONLY 367 00274 3004 DCA SIN /SAVE NEW 368 00275 1036 TAD DECK 369 00276 7041 CIA 370 00277 1004 TAD SIN 371 00300 7650 SNA CLA 372 00301 5672 JMP I DECKON /FAST EXIT 373 00302 1036 TAD DECK 374 00303 4342 JMS DFIND /LOCATE OLD 375 00304 1760 TAD I LXUDF1 376 00305 3036 DCA XFIELD 377 00306 6211 CDF SWAP 378 00307 1523 TAD I LLSTMD 379 00310 3033 DCA DINPUT 380 00311 6201 CDF 381 00312 1411 TAD I XREG2 382 00313 6211 CDF SWAP 383 00314 3410 DCA I XREG /SWAP OUT OLD 384 00315 2006 ISZ TEMP2 385 00316 5311 JMP .-5 386 00317 1004 TAD SIN 387 00320 4342 JMS DFIND /LOCATE NEW 388 00321 1410 ENTRY1, TAD I XREG 389 00322 6201 CDF 390 00323 3411 DCA I XREG2 /SWAP IN NEW 391 00324 6211 CDF SWAP 392 00325 2006 ISZ TEMP2 393 00326 5321 JMP .-5 394 00327 1033 TAD DINPUT 395 00330 3523 DCA I LLSTMD 396 00331 6201 CDF 397 00332 1036 TAD XFIELD 398 00333 3760 DCA I LXUDF1 399 00334 1004 TAD SIN 400 00335 3036 DCA DECK /NEW USER ONDECK 401 00336 1113 TAD LOOKST 402 00337 1036 TAD DECK 403 00340 3006 DCA TEMP2 /POINT TO STATUS 404 00341 5672 JMP I DECKON 405 406 00342 0321 DFIND, ENTRY1 407 00343 7040 ENTRY, CMA 408 00344 3006 DCA TEMP2 409 00345 1361 TAD LORG /START AT 414 (END OF FUNL2) IN FIELD 1 410 00346 1357 TAD STARTP /SPACE BETWEEN 411 00347 2006 ISZ TEMP2 412 00350 5346 JMP .-2 413 00351 3010 DCA XREG /POINT TO USER 414 00352 1362 TAD L1 415 00353 3011 DCA XREG2 /POINT TO SWAP AREA 416 00354 1363 TAD L2 417 00355 3006 DCA TEMP2 /SWAP COUNT 418 00356 5742 JMP I DFIND 419 420 00357 0051 STARTP, ENSWAP-STSWAP+1 /SPACE BETWEEN 421 00360 3570 LXUDF1, XUDF+1 422 00361 1116 LORG, ORG-1-ENSWAP+STSWAP-1 423 00362 0014 L1, STSWAP-1 424 00363 7727 L2, STSWAP-ENSWAP-1 425 00364 7751 LINTCN, INTCNT 426 427 /THIS ROUTINE IS USED BY THE INTERRUPT ROUTINE 428 /IN FIELD 1. 429 00365 1512 F0DCKN, TAD I LOOK /GET USER THAT WAS RUNNING BEFORE INTERRUPT 430 00366 4272 JMS DECKON /PUT HIM ON DECK 431 00367 6212 CIF 10 432 00370 5771 JMP I .+1 /GO BACK TO FINISH UP 433 00371 0270 INTRP6 434 435 /THIS ROUTINE CALLS *GETC* FROM FIELD 1 FOR *COMMAN* 436 00372 4540 F0GETC, GETC 437 00373 6213 CIF CDF 10 438 00374 5775 JMP I .+1 /CONTINUE WITH THE COMMAND DECODER 439 00375 0435 COM7 440 /ERROR ROUTINE 441 /HERE IS WHERE ERROR MESSAGES ARE PRINTED 442 /IT IS CALLED BY A DISMISSAL WITH THE PC SET TO 443 /ERRORX AND THE ERROR ADDRESS IN LSTMOD 444 00376 4572 ERRORX, FREE13 /GET ROOM 445 00377 1127 TAD M40 446 00400 3104 DCA T3 /BUFFER IS 40 LONG 447 00401 7340 L7777 448 00402 1046 TAD IPTR0 449 00403 3012 DCA XREG3 /POINT TO I BUFFER 450 00404 4555 UDF 451 00405 3412 DCA I XREG3 /CLEAR BUFFER 452 00406 2104 ISZ T3 453 00407 5205 JMP .-2 454 00410 6201 CDF 455 00411 1044 TAD IPTRI 456 00412 3045 DCA IPTRO /NO INPUT IN BUFFER 457 00413 3034 DCA OUTPUT /HAVE ECHO 458 00414 1025 TAD PT1 /GET ERROR CODE 459 00415 4542 SORTC 460 00416 1104 ERRLST-1 461 00417 1101 TAD SORTCN /GET ERROR NUMBER 462 00420 7640 SZA CLA /ERROR OR CONTROL-C? 463 00421 7146 CLL CMA RTL /ERROR: +2 464 00422 7040 CMA /CONTROL-C: -1 465 00423 2032 ISZ SPACSW /KEEP SPACES FOR MESSAGE 466 00424 4334 JMS READY1 /PRINT "CR,STOP" OR "CR,ERROR " 467 00425 1101 TAD SORTCN /GET ERROR NUMBER 468 00426 7440 SZA /PRINT NUMBER ONLY IF NEEDED 469 00427 4733 JMS I PITPNT 470 00430 1062 TAD ERLINE /WHAT LINE WERE WE IN? 471 00431 7750 SPA SNA CLA 472 00432 5240 JMP READY /NONE: IMMEDIATE MODE 473 00433 4572 FREE13 /GET ROOM FOR "IN ####" 474 00434 1125 TAD CLF /GET MESSAGE ADDRESS 475 00435 4334 JMS READY1 /PRINT " IN " 476 00436 1062 TAD ERLINE /LINE NUMBER 477 00437 4733 JMS I PITPNT /PRINT LINE NUMBER 478 /*READY* ROUTINE 479 /ROUTINE TO PRINT "READY" AND RESET POINTERS 480 /ENTER THE ROUTINE AT START TO OMIT READY MESSAGE 481 00440 4572 READY, FREE13 482 00441 7327 CLA CLL CML IAC RTL /GET A 6 483 00442 4334 JMS READY1 /PRINT "CR,READY,CR" 484 00443 1056 START, TAD PDLST 485 00444 3015 DCA PDLXR /RESET PUSH-DOWN 486 00445 7340 L7777 487 00446 6211 CDF 10 488 00447 3523 DCA I LLSTMD /SHORT LIST 489 00450 3062 DCA ERLINE /FOR THINGS LIKE ERROR 6 490 00451 1377 TAD (ERR330 491 00452 4543 PUSHA /TRAP TOO MANY *RETURN*S 492 00453 4544 PUSHJ 493 00454 1146 PAKLIN /GET COMMAND LINE 494 /INSERT LINE OR DO COMMAND 495 /AFTER A COMMAND OR LINE IS PACKED INTO THE COMMAND BUFFER 496 /THIS ROUTINE LOOKS AT IT AND EITHER STORES THE LINE OR 497 /GOES TO THE PROPER COMMAND 498 00455 4575 DECODE, TSTEND 499 00456 4557 TESTN 500 00457 5243 JMP START /IF LINE STARTS WITH CR, IGNORE LINE 501 00460 5731 JMP I PINPUTX /COMMAND 502 00461 4562 GETLN /GET LINE NUMBER 503 00462 1054 SRETN, TAD BUFR 504 00463 3016 DCA AXIN /SET TO REPACK 505 00464 3024 DCA XCTIN 506 00465 1030 TAD LINENO 507 00466 4555 UDF 508 00467 3416 DCA I AXIN /SET LINE NUMBER 509 00470 6201 CDF 510 00471 4563 TSTCCR /JUST LINE NUMBER 511 00472 5275 JMP .+3 /NO 512 00473 4732 JMS I PXDELET /DELETE THIS LINE 513 00474 5243 JMP START 514 515 00475 2032 ISZ SPACSW /KEEP SPACES 516 00476 7410 SKP 517 00477 4540 GETC 518 00500 4561 PACKC /REPACK LINE 519 00501 4563 TSTCCR 520 00502 5277 JMP .-3 521 00503 4732 JMS I PXDELET /DELETE OLD LINE 522 00504 4555 UDF 523 00505 6002 IOF 524 00506 1431 TAD I LASTLN /POINTER TO NEXT 525 00507 3454 DCA I BUFR /POINT TO NEXT 526 00510 1054 TAD BUFR 527 00511 3431 DCA I LASTLN /OLD POINTS TO NEW 528 00512 1023 TAD ADD 529 00513 7440 SZA 530 00514 3416 DCA I AXIN /FINISH PACKING TO AN EVEN BOUNDARY 531 00515 4571 FINDLN /FIND THE LINE 532 00516 0016 C16, 16 533 00517 4544 PUSHJ 534 00520 4347 ENDFND /GET LAST COMMAND ON LINE--IS IT *NEXT*? 535 00521 7650 SNA CLA 536 00522 1376 TAD (10 /8 EXTRA FOR *NEXT* 537 00523 7001 IAC 538 00524 1016 TAD AXIN 539 00525 3054 DCA BUFR /NEW FREE POSITION 540 00526 1054 TAD STARTV /RESET VARIABLES AFTER TEXT IS TOUCHED 541 00527 3055 DCA LASTV 542 00530 5243 JMP START /INTERRUPT WILL BE ON IN A LITTLE WHILE 543 00531 2547 PINPUTX, INPUTX 544 00532 1600 PXDELET, XDELET 545 00533 0231 PITPNT, ITPRNT 546 547 /SUBROUTINE TO WRITE OUT MESSAGES 548 00534 0000 READY1, 0 549 00535 3017 DCA AXOUT /POINT TO MESSAGE 550 00536 3021 DCA XCT 551 00537 4540 READY2, GETC /GET MESSAGE 552 00540 1026 TAD CHAR 553 00541 1130 TAD M12 554 00542 7710 SPA CLA 555 00543 5734 JMP I READY1 556 00544 4537 PRINTC 557 00545 5337 JMP READY2 558 559 00546 0000 FIX, 0 /*FIX* FUNCTION 560 00547 1346 TAD FIX 561 00550 3775 DCA I (FFADD /KLUDGE SUBROUTINE LINKAGE 562 00551 1374 TAD (27 /23 DECIMAL, THE MAGIC NUMBER FOR SHIFTING 563 00552 3074 DCA OPX /PUT IT IN THE OP 564 00553 3075 DCA OPH /AND MAKE THE WHOLE THING 565 00554 3076 DCA OPL /A RATHER LARGE ZERO 566 00555 5773 JMP I (FAD1+6 /JUMP INTO FLOATING ADD ROUTINE 567 568 00556 0000 INT, 0 /*INT* FUNCTION 569 00557 1072 TAD ACH /GET SIGN OF FAC 570 00560 7710 SPA CLA /POSITIVE OR NEGATIVE? 571 00561 4775 JMS I (FFADD /NEGATIVE:ADD -.9999999999 572 00562 0766 MAGICN /THIS LOC MUST BE < 1000 BECAUSE IT 573 /MUST BE A NOP! 574 00563 4346 JMS FIX /NOW TRUNCATE 575 00564 5756 JMP I INT /AND RETURN, FAC=INT(FAC0) 576 /*FLARG* (FLOATING POINT ARGUMENT TO MANY THINGS) 577 00565 0000 FLARG, 0 578 00566 0000 0 579 00567 0000 0 580 581 00570 0000 FRNDX0, 0 /EXPONENT OF RANDOM NUMBER 582 00571 0203 203 /2 WORD RANDOM INTEGER 583 00572 5555 5555 584 585 00573 6613 PAGE 00574 0027 00575 6600 00576 0010 00577 3572 586 00600 0000 KEY, 0 587 00601 1003 TAD USER 588 00602 4764 JMS I PDECKON /PUT HIM ONDECK 589 00603 1035 TAD XIOT 590 00604 3205 DCA .+1 /SET READ IOT 591 00605 7402 HLT 592 00606 0121 AND C177 /IGNORE PARITY 593 00607 7450 SNA 594 00610 5303 JMP KEYEND /IGNORE 0 AND 200 595 00611 3004 DCA SIN /SAVE INPUT 596 00612 7346 L7775 597 00613 1004 TAD SIN 598 00614 7640 SZA CLA 599 00615 5220 JMP KEY7 /NOT CTRL/C 600 00616 4765 ERR004, JMS I PIERROR /IMMEDIATE RECOVERY 601 00617 5303 JMP KEYEND 602 603 00620 6211 KEY7, CDF 10 604 00621 1523 TAD I LLSTMD 605 00622 6201 CDF 606 00623 7650 SNA CLA 607 00624 5275 JMP KEY6 608 00625 1004 TAD SIN 609 00626 4542 SORTC 610 00627 0511 ALT-1 611 00630 5266 JMP KEY5 612 00631 1004 TAD SIN 613 00632 1130 TAD M12 614 00633 7650 SNA CLA 615 00634 5303 JMP KEYEND /IGNORE LINE FEED IF NOT BREAK 616 00635 1004 TAD SIN 617 00636 0355 AND C140 618 00637 7450 SNA 619 00640 5277 JMP KEY3 /ILLEGAL CHAR 620 00641 1263 TAD M140 621 00642 7650 SNA CLA 622 00643 5277 JMP KEY3 /ILLEGAL CHAR 623 00644 1004 TAD SIN 624 00645 4553 PRINTX /ECHO THE CHAR 625 00646 4305 JMS KEY4 /STORE THE CHAR 626 00647 1045 TAD IPTRO 627 00650 7041 CIA 628 00651 1044 TAD IPTRI 629 00652 7550 SPA SNA 630 00653 1133 TAD C40 631 00654 1130 TAD M12 632 00655 7710 SPA CLA 633 00656 5303 JMP KEYEND 634 00657 7350 ANYINP, L3777 635 00660 0406 AND I TEMP2 /CLEAR I WAIT 636 00661 3406 DCA I TEMP2 637 00662 5303 JMP KEYEND 638 639 00663 7640 M140, -140 640 00664 3400 LXOUTL2, XOUTL2 641 00665 1323 PXFREE, XFREE 642 00666 7346 KEY5, L7775 643 00667 1101 TAD SORTCN 644 00670 7110 CLL RAR 645 00671 7640 SZA CLA 646 00672 5275 JMP .+3 /NO ECHO HERE 647 00673 1004 TAD SIN 648 00674 4553 PRINTX /ECHO BREAK CHAR - CR AND BELL 649 00675 4305 KEY6, JMS KEY4 /STORE CHAR 650 00676 5257 JMP ANYINP /BREAK HERE 651 652 00677 1120 KEY3, TAD C7 653 00700 4553 PRINTX /2 BELLS FOR ILLEGAL CHAR 654 00701 1120 TAD C7 655 00702 4553 PRINTX 656 00703 6212 KEYEND, CIF 10 657 00704 5600 JMP I KEY 658 659 00705 0000 KEY4, 0 660 00706 4555 UDF 661 00707 1444 TAD I IPTRI /ROOM? 662 00710 7640 SZA CLA 663 00711 4765 ERR070, JMS I PIERROR /NO ROOM 664 00712 4555 UDF 665 00713 1004 TAD SIN 666 00714 3444 DCA I IPTRI 667 00715 6201 CDF 668 00716 2044 ISZ IPTRI 669 00717 1044 TAD IPTRI 670 00720 7041 CIA 671 00721 1133 TAD C40 672 00722 1046 TAD IPTR0 673 00723 7640 SZA CLA 674 00724 5705 JMP I KEY4 /OK 675 00725 1046 TAD IPTR0 676 00726 3044 DCA IPTRI /RESET POINTER 677 00727 5705 JMP I KEY4 678 00730 0000 TTY, 0 679 00731 1003 TAD USER 680 00732 4764 JMS I PDECKON /PUT HIM ONDECK 681 00733 3051 DCA TELSW /CLEAR BUSY 682 00734 4555 UDF 683 00735 1450 TTY3, TAD I OPTRO /MORE 684 00736 7450 SNA 685 00737 5354 JMP TTY2 /NO 686 00740 4664 JMS I LXOUTL2 /OUTPUT IT 687 00741 4555 UDF 688 00742 3450 DCA I OPTRO /CLEAR BUFFER 689 00743 2050 ISZ OPTRO /BUMP BUFFER 690 00744 1050 TAD OPTRO 691 00745 7041 CIA 692 00746 1046 TAD IPTR0 693 00747 7640 SZA CLA 694 00750 5354 JMP TTY2 /OK 695 00751 1046 TAD IPTR0 696 00752 1127 TAD M40 697 00753 3050 DCA OPTRO /RESET BUFFER 698 00754 4665 TTY2, JMS I PXFREE /ROOM AVAILABLE 699 00755 0140 C140, 140 700 00756 5362 JMP TTYEND /NOT ENOUGH ROOM 701 00757 7352 L5777 702 00760 0406 AND I TEMP2 /CLEAR O WAIT 703 00761 3406 DCA I TEMP2 704 00762 6212 TTYEND, CIF 10 705 00763 5730 JMP I TTY 706 00764 0272 PDECKON, DECKON 707 00765 3541 PIERROR, IERROR 708 709 /THE GREAT 'MAGICN' IS ADDED TO NEGATIVE NUMBERS 710 /IN THE *INT* FUNCTION SO THAT THE *FIX* FUNCTION WILL WORK 711 /ON IT! 712 00766 0000 MAGICN, 0000 /-.99999999999 713 00767 4000 4000 714 00770 0003 0003 /KLUDGE! 715 PAGE 716 717 /*INPUT* STATEMENT 718 01000 4545 INPUT, PUSHF /SAVE POSITION OF DATA 719 01001 0040 DATAPC+1 720 01002 1043 TAD DATAPC+4 721 01003 4543 PUSHA 722 01004 1117 TAD CCR /FAKE END OF LINE 723 01005 3043 DCA DATAPC+4 /SO INREAD WILL BE FORCED TO GET MORE 724 01006 4242 INPSET, JMS INREAD /DO THE INPUT LIST 725 01007 5221 JMP INPEND /DONE 726 01010 4572 FREE13 /NEED MORE DATA 727 01011 1134 TAD C77 /ASCII FOR "?" 728 01012 4537 PRINTC /PRINT A QUESTION MARK 729 01013 1133 TAD C40 730 01014 4537 PRINTC /PRINT THE SPACE AFTER 731 01015 4544 PUSHJ /GET A LINE OF INPUT 732 01016 1146 PAKLIN 733 01017 7340 L7777 /INDICATE REENTRY 734 01020 5206 JMP INPSET /USE NEW DATA 735 01021 4546 INPEND, POPA /RESTORE THE DATA POINTERS 736 01022 3043 DCA DATAPC+4 737 01023 4550 POPF 738 01024 0040 DATAPC+1 739 01025 5535 JMP I CCONT /DO NEXT STATEMENT 740 741 /*READ* STATEMENT 742 01026 4242 READ, JMS INREAD /DO THE READ LIST 743 01027 5237 JMP REAEND /END OF LIST; DONE 744 01030 1037 TAD DATAPC /GET LINE NUMBER OF DATA LIST 745 01031 4567 FIND /FIND ANOTHER DATA STATEMENT 746 01032 0027 27 /-DATA CODE 747 01033 4554 ERR510, ERROR /OUT OF DATA 748 01034 3037 DCA DATAPC /SAVE NEW LINE NUMBER 749 01035 7340 L7777 /INDICATE REENTRY 750 01036 5226 JMP READ /USE NEW DATA 751 01037 1062 REAEND, TAD ERLINE /RESTORE PROPER LINE NUMBER 752 01040 3030 DCA LINENO 753 01041 5535 JMP I CCONT /DO NEXT STATEMENT 754 755 /THIS ROUTINE PROCESSES THE VARIABLE LIST OF THE INPUT AND READ 756 /STATEMENTS. 757 01042 0000 INREAD, 0 758 01043 7640 SZA CLA /REENTRY? 759 01044 5272 JMP INRMOD /YES: GO PROCESS THE DATA 760 01045 4544 INRVAR, PUSHJ /GET A VARIABLE FROM LIST 761 01046 4400 GETVAR 762 01047 4545 PUSHF /SAVE PT1;CHAR;LINEPC 763 01050 0025 PT1 764 01051 4545 PUSHF /SAVE THE TEXT POINTERS 765 01052 0017 TEXTP 766 01053 4545 PUSHF /TRANSFER DATAPC+1 TO THE TEXT POINTERS 767 01054 0040 DATAPC+1 768 01055 4550 POPF 769 01056 0017 TEXTP 770 01057 1043 TAD DATAPC+4 771 01060 3026 DCA CHAR 772 01061 1031 TAD MODE /SAVE MODE WHERE IT WON'T BE DESTROYED BY A *FIND* 773 01062 3025 DCA PT1 774 01063 4575 TSTEND /MORE DATA AVAILABLE? 775 01064 5267 JMP INRDAT /YES: USE IT 776 01065 2242 ISZ INREAD /SET UP SKIP RETURN 777 01066 5642 JMP I INREAD /EXIT 778 01067 4564 INRDAT, TSTCOM /COMMA SEPARATOR? 779 01070 4554 ERR490, ERROR /NO: DATA TO INPUT OR READ IN IMPROPER FORM 780 01071 4540 GETC /SKIP OVER THE COMMA 781 01072 2025 INRMOD, ISZ PT1 /STRING OR NUMERIC DATA ITEM? 782 01073 5277 JMP INRNUM /NUMERIC 783 01074 4544 PUSHJ /STRING 784 01075 5206 QINP 785 01076 5301 JMP .+3 786 01077 4544 INRNUM, PUSHJ 787 01100 2612 EVAL 788 01101 1026 TAD CHAR /SAVE DATA TEXT POINTERS AT DATAPC+1 789 01102 3043 DCA DATAPC+4 790 01103 4545 PUSHF 791 01104 0017 TEXTP 792 01105 4550 POPF 793 01106 0040 DATAPC+1 794 01107 4550 POPF /RESTORE STUFF PERTAINING TO VARIABLE LIST 795 01110 0017 TEXTP 796 01111 4550 POPF 797 01112 0025 PT1 798 01113 4552 FLPUT /SET THE VARIABLE 799 01114 0071 ACX 800 01115 4575 TSTEND /END OF VARIABLE LIST? 801 01116 7410 SKP 802 01117 5642 JMP I INREAD /YES: DONE 803 01120 4564 TSTCOM /COMMA SEPARATOR? 804 01121 4554 ERR500, ERROR /NO: ILLEGAL SYNTAX IN INPUT OR READ 805 01122 4540 GETC /SKIP OVER THE COMMA 806 01123 5245 JMP INRVAR /GO DO THIS VARIABLE 807 /TEXT INITIALIZATION ROUTINES 808 01124 0000 INPACK, 0 809 01125 1060 TAD COMBUF 810 01126 3016 DCA AXIN 811 01127 3024 DCA XCTIN 812 01130 1060 TAD COMBUF 813 01131 3052 DCA PACKST 814 01132 1373 TAD LALINE0 815 01133 3053 DCA PACKND 816 01134 5724 JMP I INPACK 817 01135 0000 OTPACK, 0 818 01136 1060 TAD COMBUF 819 01137 3017 DCA AXOUT 820 01140 3021 DCA XCT 821 01141 3032 DCA SPACSW 822 01142 1374 TAD LPDLXR 823 01143 3053 DCA PACKND 824 01144 4540 GETC 825 01145 5735 JMP I OTPACK 826 01146 4324 PAKLIN, JMS INPACK 827 01147 4574 READC 828 01150 4561 PACKC 829 01151 4563 TSTCCR 830 01152 5347 JMP .-3 831 01153 4561 PACKC /FINISH PACKING CR 832 01154 4335 JMS OTPACK 833 01155 5547 POPJ 834 835 01156 0000 GETMOR, 0 836 01157 7410 SKP 837 01160 4540 GETC 838 01161 4575 TSTEND 839 01162 5360 JMP .-2 /GO TO TERMINATOR 840 01163 1026 TAD CHAR 841 01164 1375 TAD LM72 /COLON 842 01165 7650 SNA CLA 843 01166 5371 JMP .+3 /MORE TO COME ON THIS LINE 844 01167 4570 GETNXT /THIS LINE FINISHED;FIND ANOTHER 845 01170 5756 JMP I GETMOR /OUT OF TEXT 846 01171 2356 ISZ GETMOR 847 01172 5756 JMP I GETMOR 848 849 01173 0057 LALINE0, ALINE0 850 01174 0015 LPDLXR, PDLXR 851 01175 7706 LM72, -72 852 PAGE 853 854 /NEW EXTENDED *IF* COMMAND 855 856 01200 3031 IF, DCA MODE /INITIALIZE MODE 857 01201 4544 PUSHJ 858 01202 2612 EVAL 859 01203 4545 PUSHF 860 01204 0565 FLARG 861 01205 1101 TAD SORTCN 862 01206 1130 TAD M12 863 01207 7510 SPA 864 01210 4554 ERR390, ERROR 865 01211 7126 CLL CML RTL 866 01212 3301 DCA IF6 867 01213 4540 GETC 868 01214 7340 L7777 869 01215 3101 DCA SORTCN 870 01216 4542 SORTC 871 01217 1023 TERMS+11 872 01220 4540 GETC 873 01221 1101 TAD SORTCN 874 01222 1301 TAD IF6 875 01223 4542 SORTC 876 01224 1075 IF4-1 877 01225 7410 SKP 878 01226 5210 JMP ERR390 879 01227 1101 TAD SORTCN 880 01230 1315 TAD KIF5 881 01231 3301 DCA IF6 882 01232 1701 TAD I IF6 883 01233 3301 DCA IF6 884 01234 4544 PUSHJ 885 01235 2612 EVAL 886 01236 4550 POPF 887 01237 0565 FLARG 888 01240 4566 COMMAN 889 01241 0035 35 /-THEN CODE 890 01242 7440 SZA 891 01243 4554 ERR400, ERROR 892 01244 2031 ISZ MODE /STRING OR NUMERIC COMPARE? 893 01245 5317 JMP IF8 /NUMERIC 894 01246 1355 TAD LACX /DO STRING COMPARE 895 01247 3102 DCA T1 /POINT TO FAC 896 01250 1114 TAD FLARGP 897 01251 3103 DCA T2 /POINT TO FLARG 898 01252 7346 L7775 899 01253 3031 DCA MODE /COUNT FOR 3 WORDS 900 01254 1503 IFS1, TAD I T2 /THE FOLLOWING GARBAGE CONVERTS CR'S 901 01255 7040 CMA /TO 0, SPACES TO 1, ... ,^ TO 77 902 01256 0134 AND C77 /SO THAT "A"<"AA". 903 01257 7640 SZA CLA 904 01260 1126 TAD C7700 905 01261 3104 DCA T3 906 01262 1502 TAD I T1 907 01263 7040 CMA 908 01264 0134 AND C77 909 01265 7640 SZA CLA 910 01266 1126 TAD C7700 911 01267 1503 TAD I T2 912 01270 7041 CIA 913 01271 1502 TAD I T1 914 01272 1104 TAD T3 915 01273 7440 SZA /THESE TWO CHARS THE SAME? 916 01274 5301 JMP IF6 /NO: THIS IS THE NUMBER 917 01275 2102 ISZ T1 /YES: COMPARE NEXT TWO CHARS 918 01276 2103 ISZ T2 919 01277 2031 ISZ MODE /COMPARED 6 CHARS YET? 920 01300 5254 JMP IFS1 /NOPE, THEN DO COMPARE 921 01301 7402 IF6, HLT 922 01302 4557 TESTN 923 01303 5306 JMP IF7 924 01304 5712 JMP I KEX2 925 01305 5713 JMP I KGOTO 926 01306 4570 IF7, GETNXT 927 01307 5714 JMP I KREADY 928 01310 5711 JMP I KEX1 929 01311 2514 KEX1, RUN4 930 01312 2515 KEX2, RUN4+1 931 01313 2535 KGOTO, GOTO 932 01314 0440 KREADY, READY 933 01315 7743 KIF5, IF5 934 01316 6734 LFFSUB, FFSUB 935 936 01317 4716 IF8, JMS I LFFSUB /NUMERIC COMPARE: FLOATING POINT SUBTRACTION 937 01320 0565 FLARG 938 01321 1072 TAD ACH /GET SIGN OF DIFFERENCE IN AC 939 01322 5301 JMP IF6 /GO TEST IT 940 /*FREE* ROUTINE 941 01323 0000 XFREE, 0 942 01324 4555 UDF 943 01325 1447 TAD I OPTRI /ANY ROOM 944 01326 6201 CDF 945 01327 7640 SZA CLA 946 01330 5723 JMP I XFREE /NO 947 01331 1047 TAD OPTRI 948 01332 7041 CIA 949 01333 1050 TAD OPTRO 950 01334 7550 SPA SNA 951 01335 1133 TAD C40 952 01336 7041 CIA /-COUNT 953 01337 7001 IAC 954 01340 7450 SNA 955 01341 5723 JMP I XFREE /ONLY 1 FREE 956 01342 7001 IAC 957 01343 7450 SNA 958 01344 5723 JMP I XFREE /ONLY 2 FREE 959 01345 2323 ISZ XFREE 960 01346 1364 TAD FREEC 961 01347 7750 SPA SNA CLA 962 01350 2323 ISZ XFREE /14 OR MORE FREE 963 01351 5723 JMP I XFREE 964 /*FREE2* AND *FREE13* ROUTINES 965 01352 0000 XFREE2, 0 966 01353 4323 JMS XFREE /ROOM 967 01354 5357 JMP .+3 /WE MUST WAIT 968 01355 0071 LACX, ACX /A HARMLESS CONSTANT IF ACX<1000 969 01356 5752 JMP I XFREE2 970 971 01357 1352 TAD XFREE2 972 01360 5370 JMP FREEWT /GET ROOM 973 974 01361 4162 PXOR, XOR 975 01362 0000 XFREE3, 0 976 01363 4323 JMS XFREE /ROOM 977 01364 0014 FREEC, 14 978 01365 7410 SKP /MUST WAIT 979 01366 5762 JMP I XFREE3 980 981 01367 1362 TAD XFREE3 982 01370 3022 FREEWT, DCA PC /SET RESTART 983 01371 1512 TAD I LOOK 984 01372 4761 JMS I PXOR /SET O WAIT AND DISMISS 985 01373 2000 2000 986 PAGE 987 /*LET* AND *FOR* COMMANDS 988 01400 7340 FOR, L7777 989 01401 3345 LET, DCA FOR1 /SAVE DETERMINATOR 990 01402 4544 PUSHJ /GET VARIABLE 991 01403 4400 GETVAR 992 01404 7650 SNA CLA /WAS FUNCTION!?! 993 01405 1026 TAD CHAR 994 01406 1350 TAD MEQL 995 01407 7640 SZA CLA 996 01410 4554 ERR410, ERROR /NO "=" 997 01411 1030 LET2, TAD LINENO 998 01412 3347 DCA FOR6 /SAVE LINE NUMBER OF LET STMNT 999 01413 4545 PUSHF /SAVE ADD,XCTIN,PT1 1000 01414 0023 ADD 1001 01415 4544 PUSHJ /GET VALUE 1002 01416 2611 EVAL-1 1003 01417 4550 POPF 1004 01420 0023 ADD 1005 01421 4552 FLPUT /SET VARIABLE 1006 01422 0565 FLARG 1007 01423 7340 L7777 /COUNT BACK FOR SAFETY 1008 01424 1017 TAD AXOUT 1009 01425 3346 DCA FOR5 1010 01426 2345 ISZ FOR1 /WHICH COMMAND? 1011 01427 5316 JMP LET1 /LET COMMAND 1012 01430 1023 TAD ADD 1013 01431 7710 SPA CLA 1014 01432 4554 ERR420, ERROR /SUBSCRIPTED 1015 01433 4566 COMMAN /GET WORD 1016 01434 0033 33 /-TO 1017 01435 7640 SZA CLA 1018 01436 5335 JMP FOR2+3 /NOT *TO* 1019 01437 1025 TAD PT1 1020 01440 7041 CIA 1021 01441 3345 DCA FOR1 /SAVE POINTER 1022 01442 4544 PUSHJ /GET LIMIT 1023 01443 2612 EVAL 1024 01444 4545 PUSHF /SAVE LIMIT 1025 01445 0565 FLARG 1026 01446 4575 TSTEND 1027 01447 5332 JMP FOR2 /GET INCREMENT 1028 01450 4545 PUSHF /INCREMENT IS ONE 1029 01451 5500 ONE 1030 01452 1030 FOR3, TAD LINENO /START LOOKING FROM HERE DOWN 1031 01453 7410 SKP 1032 01454 4546 FOR4, POPA 1033 01455 4567 FIND /FIND A *NEXT* STATEMENT 1034 01456 0031 31 /-NEXT CODE 1035 01457 4554 ERR440, ERROR /OUT OF TEXT 1036 01460 4543 PUSHA /SAVE FOR RESTART 1037 01461 4565 TSTALP 1038 01462 5254 JMP FOR4 1039 01463 4544 PUSHJ /GET VARIABLE 1040 01464 4400 GETVAR 1041 01465 7650 SNA CLA /NO SECOND CHANCE ON FUNCTION 1042 01466 1025 TAD PT1 1043 01467 1345 TAD FOR1 1044 01470 7640 SZA CLA 1045 01471 5254 JMP FOR4 /LOOP 1046 01472 2015 ISZ PDLXR /DUMP RESTART ADDRESS 1047 1048 01473 4563 TSTCCR 1049 01474 5731 JMP I FOR2-1 /WE MUST CHECK NOW, BEFORE INITIALIZATION, OR WE MIGHT 1050 /WIPE OUT HIS PROGRAM [AND THE SYSTEM?] 1051 1052 01475 1347 TAD FOR6 1053 01476 4555 UDF 1054 01477 3417 DCA I AXOUT /SET TEXT AND LINE POINTERS 1055 01500 1346 TAD FOR5 1056 01501 3417 DCA I AXOUT /SET POINTER 1057 01502 6201 CDF 1058 01503 4550 POPF /GET INCREMENT 1059 01504 0565 FLARG 1060 01505 1017 TAD AXOUT 1061 01506 4552 FLPUT /PUT INCREMENT 1062 01507 0565 FLARG 1063 01510 4550 POPF /GET LIMIT 1064 01511 0565 FLARG 1065 01512 7325 L0003 1066 01513 1017 TAD AXOUT 1067 01514 4552 FLPUT /SET LIMIT 1068 01515 0565 FLARG 1069 01516 1347 LET1, TAD FOR6 1070 01517 3030 DCA LINENO /SET LINE POINTER 1071 01520 4575 TSTEND 1072 01521 4554 ERR450, ERROR /JUNK 1073 01522 4571 FINDLN /FIND US AGAIN 1074 01523 0000 0 1075 01524 1346 TAD FOR5 1076 01525 3017 DCA AXOUT /BACK WHERE WE WERE 1077 01526 3026 DCA CHAR /GETMOR WILL TAKE CARE OF THIS 1078 01527 3021 DCA XCT 1079 01530 5535 JMP I CCONT 1080 01531 2401 ERR460 /POINTER TO *NEXT* ERROR 1081 1082 01532 4566 FOR2, COMMAN 1083 01533 0032 32 /-STEP CODE 1084 01534 7440 SZA 1085 01535 4554 ERR430, ERROR /NOT STEP 1086 01536 4544 PUSHJ /GET INCREMENT 1087 01537 2612 EVAL 1088 01540 4545 PUSHF /SAVE INCREMENT 1089 01541 0565 FLARG 1090 01542 4575 TSTEND 1091 01543 5335 JMP FOR2+3 /JUNK 1092 01544 5252 JMP FOR3 1093 1094 01545 0000 FOR1, 0 1095 01546 0000 FOR5, 0 /AXOUT SAVE REG 1096 01547 0000 FOR6, 0 /LINEPC SAVE REG 1097 1098 1099 01550 7703 MEQL, -75 /-EQUALS 1100 / 1101 /NEGATE OPERAND 1102 / 1103 01551 0000 OPNEG, 0 1104 01552 1076 TAD OPL /GET LOW ORDER 1105 01553 7141 CLL CMA IAC /NEGATE AND STORE BACK 1106 01554 3076 DCA OPL 1107 01555 7024 CML RAL /PROPAGATE CARRY 1108 01556 1075 TAD OPH /GET HI ORDER 1109 01557 7141 CLL CMA IAC /NEGATE AND STORE BACK 1110 01560 3075 DCA OPH 1111 01561 5751 JMP I OPNEG 1112 1113 /*POPA* ROUTINE 1114 01562 0000 XPOPA, 0 1115 01563 4555 UDF 1116 01564 1415 TAD I PDLXR 1117 01565 6201 CDF 1118 01566 5762 JMP I XPOPA 1119 PAGE 1120 /*DELETE* ROUTINE 1121 01600 0000 XDELET, 0 1122 01601 4571 FINDLN /FIND THE LINE 1123 01602 5600 JMP I XDELET /NOT THERE - EXIT 1124 01603 2032 ISZ SPACSW 1125 01604 4540 GETC 1126 01605 4563 TSTCCR /GO TO END OF LINE 1127 01606 5204 JMP .-2 1128 01607 1017 TAD AXOUT 1129 01610 7040 CMA 1130 01611 1027 TAD LINEPC 1131 01612 4543 PUSHA /SAVE COUNT 1132 01613 1027 TAD LINEPC 1133 01614 7001 IAC 1134 01615 3017 DCA AXOUT /TO UNPACK 1135 01616 3021 DCA XCT 1136 01617 4544 PUSHJ 1137 01620 4347 ENDFND /GET LAST COMMAND HERE 1138 01621 7650 SNA CLA 1139 01622 1254 TAD MN10 1140 01623 4546 POPA 1141 01624 3104 DCA T3 /CORRECTED COUNT 1142 01625 1027 TAD LINEPC 1143 01626 7041 CIA 1144 01627 1057 TAD ALINE0 1145 01630 7650 SNA CLA 1146 01631 5600 JMP I XDELET /NOT LINE0 1147 01632 4555 UDF 1148 01633 1427 TAD I LINEPC /GET POINTER 1149 01634 3431 DCA I LASTLN /REMOVE LINE 1150 01635 1057 TAD ALINE0 1151 01636 3103 XDEL3, DCA T2 /CURRENT LINE 1152 01637 1503 TAD I T2 1153 01640 7450 SNA 1154 01641 5256 JMP XDEL2 /OUT OF TEXT 1155 01642 3102 DCA T1 1156 01643 1027 TAD LINEPC 1157 01644 7141 CLL CIA 1158 01645 1102 TAD T1 1159 01646 7630 SZL CLA 1160 01647 1104 TAD T3 /CORRECT LINE 1161 01650 1102 TAD T1 1162 01651 3503 DCA I T2 1163 01652 1102 TAD T1 1164 01653 5236 JMP XDEL3 1165 1166 01654 7770 MN10, -10 1167 01655 4476 PERR, ERR100-2 1168 01656 7340 XDEL2, L7777 1169 01657 1027 TAD LINEPC 1170 01660 3012 DCA XREG3 1171 01661 1104 TAD T3 1172 01662 7040 CMA 1173 01663 1027 TAD LINEPC 1174 01664 3017 DCA AXOUT 1175 01665 1104 TAD T3 1176 01666 1054 TAD BUFR 1177 01667 3054 DCA BUFR 1178 01670 1016 TAD AXIN 1179 01671 7040 CMA 1180 01672 1017 TAD AXOUT 1181 01673 3102 DCA T1 1182 01674 1104 TAD T3 1183 01675 1016 TAD AXIN 1184 01676 3016 DCA AXIN 1185 01677 1417 TAD I AXOUT 1186 01700 3412 DCA I XREG3 /MOVE TEXT 1187 01701 2102 ISZ T1 1188 01702 5277 JMP .-3 1189 01703 5201 JMP XDELET+1 1190 /PUSH ROUTINES 1191 01704 0000 XPUSHA, 0 1192 01705 3104 DCA T3 1193 01706 7340 L7777 /BACK 1 1194 01707 4325 JMS PCHK 1195 01710 1104 TAD T3 1196 01711 4555 UDF 1197 01712 3415 DCA I PDLXR /PUSH IT 1198 01713 6201 CDF 1199 01714 7340 L7777 1200 01715 4325 JMS PCHK /BACK AGAIN 1201 01716 5704 JMP I XPUSHA 1202 1203 01717 0000 XPUSHJ, 0 1204 01720 1717 TAD I XPUSHJ /GET SEND ADDRESS 1205 01721 3304 DCA XPUSHA 1206 01722 1317 TAD XPUSHJ /GET RETURN ADDRESS 1207 01723 7001 IAC 1208 01724 5305 JMP XPUSHA+1 1209 1210 01725 0000 PCHK, 0 1211 01726 1015 TAD PDLXR 1212 01727 3015 DCA PDLXR 1213 01730 7326 L0002 1214 01731 1055 TAD LASTV 1215 01732 7141 CLL CIA 1216 01733 1015 TAD PDLXR 1217 01734 7620 SNL CLA 1218 01735 5655 JMP I PERR 1219 01736 5725 JMP I PCHK 1220 1221 /*PUSHF* ROUTINE 1222 01737 0000 XPUSHF, 0 1223 01740 7340 L7777 1224 01741 1737 TAD I XPUSHF 1225 01742 3012 DCA XREG3 /POINT TO DATA 1226 01743 7346 L7775 1227 01744 4325 JMS PCHK /BACK 3 1228 01745 7346 L7775 1229 01746 3104 DCA T3 1230 01747 1412 TAD I XREG3 1231 01750 4555 UDF 1232 01751 3415 DCA I PDLXR /PUSH DATA 1233 01752 6201 CDF 1234 01753 2104 ISZ T3 1235 01754 5347 JMP .-5 1236 01755 7346 L7775 1237 01756 4325 JMS PCHK /BACK 3 AGAIN 1238 01757 2337 ISZ XPUSHF 1239 01760 5737 JMP I XPUSHF 1240 1241 /HERE WE TRANSFER CONTROL TO *MANCOM* IN FIELD 1 1242 01761 0000 F0CMAN, 0 1243 01762 6212 CIF 10 1244 01763 5767 JMP I F0CMNP 1245 01764 1761 F0CMN1, TAD I F0CMAN 1246 01765 2361 ISZ F0CMAN 1247 01766 5761 JMP I F0CMAN 1248 01767 0400 F0CMNP, MANCOM 1249 /*RANDOMIZE* STATEMENT 1250 01770 7751 PINTCN, INTCNT 1251 01771 1064 RANDOM, TAD FRNDX+1 1252 01772 1770 TAD I PINTCN /RANDOMIZE FRNDX 1253 01773 3064 DCA FRNDX+1 /REPLACE 1254 01774 5535 JMP I CCONT 1255 PAGE 1256 /STRING FUNCTIONS!!! 1257 /MID FUNCTION: MID(A$,P,L) 1258 02000 0000 MID, 0 1259 02001 4247 JMS SSR1 /TAKE CARE OF 1ST ARG & TEST FOR 2ND 1260 02002 4544 PUSHJ /GET SECOND ARG 1261 02003 2611 EVAL-1 1262 02004 4515 JMS I INTEGE /CONVERT TO 1 WORD INTEGER IN AC 1263 02005 7041 CIA /AC=-AC 1264 02006 4543 PUSHA /SAVE SECOND ARGUMENT 1265 02007 4564 TSTCOM /IS THIRD ARGUMENT THERE? 1266 02010 5255 JMP ERRSAR /NO: MISSING ARG TO STRING FUNCTION 1267 02011 4544 PUSHJ /GET 3RD ARG 1268 02012 2611 EVAL-1 1269 02013 4515 JMS I INTEGE /AND CONVERT TO 1 WORD INTEGER 1270 02014 7040 CMA /AC=-AC-1 1271 02015 3102 DCA T1 /SAVE IN T1 1272 02016 4546 POPA /GET SECOND ARG 1273 02017 3103 DCA T2 /STORE IN T2 1274 02020 4257 JMS SSR2 /SET UP PACKING AND UNPACKING ON STACK 1275 02021 4540 MID2, GETC /GET NEXT CHAR OF STRING ARG 1276 02022 2103 ISZ T2 /SHOULD WE WASTE A CHAR? 1277 02023 5244 JMP MID1 /YES 1278 02024 2102 MID5, ISZ T1 /END OF RESULT STRING? 1279 02025 5236 JMP MID3 /NOT YET 1280 02026 1117 MID4, TAD CCR /SET UP TO PACK A CR 1281 02027 3026 DCA CHAR 1282 02030 4500 MID6, JMS I CPACK /INDICATE END OF RESULT STRING 1283 02031 4274 JMS SSR3 /RESTORE TEXT POINTERS & OTHER GARBAGE 1284 02032 4777 SFNEND, JMS I (PARTST /CHECK PARENTHESIS MATCH & CLEAN UP STACK 1285 02033 2015 ISZ PDLXR /SKIP PAST SAVED MODE 1286 02034 7340 L7777 /AC INDICATES STRING MODE 1287 02035 5776 JMP I (ENDFUN+2 /GO SET MODE AND FINISH FUNCTION PROCESSING 1288 02036 4563 MID3, TSTCCR /END OF RESULT STRING? 1289 02037 7410 SKP 1290 02040 5230 JMP MID6 /YES, SO END IT 1291 02041 4500 JMS I CPACK /PACK CHAR INTO RESULT STRING 1292 02042 4540 GETC /GET NEXT CHAR OF ARGUMENT 1293 02043 5224 JMP MID5 /GO DECIDE WHAT TO DO WITH IT 1294 02044 4563 MID1, TSTCCR /END OF ARG WHILE STILL WASTING CHARS? 1295 02045 5221 JMP MID2 /NO, CONTINUE... 1296 02046 4554 ERRSOV, ERROR /YES: STRING OVERFLOW 1297 1298 /STRING SUBROUTINE 1 1299 02047 0000 SSR1, 0 1300 02050 7340 L7777 1301 02051 4543 PUSHA /END OF STRING MARKER FOR 6 CHAR STRINGS 1302 02052 4545 PUSHF /SAVE FIRST ARG ON STACK 1303 02053 0071 ACX 1304 02054 4564 TSTCOM /IS 2ND ARG THERE? 1305 02055 4554 ERRSAR, ERROR /NO: MISSING ARG TO STRING FUNCTION 1306 02056 5647 JMP I SSR1 /EXIT 1307 1308 /STRING SUBROUTINE 2 1309 02057 0000 SSR2, 0 1310 02060 1015 TAD PDLXR 1311 02061 3016 DCA AXIN /SET UP TO PACK ONTO STACK 1312 02062 3024 DCA XCTIN /HOUSEKEEPING 1313 02063 4545 PUSHF /SAVE TEXT POINTERS 1314 02064 0017 TEXTP 1315 02065 1026 TAD CHAR 1316 02066 4543 PUSHA 1317 02067 1016 TAD AXIN /STILL POINTER TO STRING ARG 1318 02070 3017 DCA AXOUT /SET UP TO UNPACK FROM STACK 1319 02071 3021 DCA XCT /HOUSEKEEPING 1320 02072 2032 ISZ SPACSW /KEEP SPACES 1321 02073 5657 JMP I SSR2 /EXIT 1322 1323 /STRING SUBROUTINE 3 1324 02074 0000 SSR3, 0 1325 02075 4500 JMS I CPACK /PACK AN EXTRA CR JUST TO BE SURE 1326 02076 4546 POPA /RESTORE TEXT POINTERS 1327 02077 3026 DCA CHAR 1328 02100 4550 POPF 1329 02101 0017 TEXTP 1330 02102 4550 POPF /PUT RESULT OF FUNCTION IN FAC 1331 02103 0071 ACX 1332 02104 2015 ISZ PDLXR /GET RID OF THE 2 CR'S 1333 02105 3032 DCA SPACSW /IGNORE SPACES 1334 02106 5674 JMP I SSR3 /EXIT 1335 1336 /CONCATENATE FUNCTION: CAT(A$,B$) 1337 02107 0000 CAT, 0 1338 02110 4247 JMS SSR1 /TAKE CARE OF STRING ARG 1339 02111 4544 PUSHJ /GET 2ND STRING ARG 1340 02112 2611 EVAL-1 1341 02113 4550 POPF /CLEAR STACK 1342 02114 0565 FLARG 1343 02115 4545 PUSHF /PUSH STUFF ONTO STACK 1344 02116 0071 ACX 1345 02117 7340 L7777 /2 CR'S 1346 02120 4543 PUSHA /ON STACK 1347 02121 4545 PUSHF /STACK CONTAINS: ARG1,CR CR,ARG2,CR CR 1348 02122 0565 FLARG 1349 02123 4257 JMS SSR2 /SAVE TEXT, SET UP PACKING & UNPACKING 1350 02124 7410 SKP /NO PACKC FIRST TIME THRU 1351 02125 4500 JMS I CPACK /PACK CHAR INTO RESULT STRING 1352 02126 4540 GETC /GET NEXT CHAR OF FIRST STRING ARG 1353 02127 4563 TSTCCR /END OF 1ST ARG? 1354 02130 5325 JMP .-3 /GO PACK & CONTINUE 1355 02131 1015 TAD PDLXR 1356 02132 1375 TAD (10 /CALCULATE ADDR OF 2ND STRING ARG 1357 02133 3017 DCA AXOUT /SET UP TO UNPACK IT 1358 02134 3021 DCA XCT 1359 02135 4540 GETC /GET NEXT CHAR OF 2ND STRING ARG 1360 02136 4500 JMS I CPACK /PACK CHAR INTO RESULT STRING 1361 02137 4563 TSTCCR /END OF 2ND ARG? 1362 02140 5335 JMP .-3 /NO: CONTINUE TRANSFERRING 2ND ARG 1363 02141 4274 JMS SSR3 /RESTORE TEXT 1364 02142 7307 L0004 /CLEAN UP STACK 1365 02143 1015 TAD PDLXR 1366 02144 3015 DCA PDLXR 1367 02145 5232 JMP SFNEND /GO DO SPECIAL STRING FUNCTION END 1368 1369 /LENGTH FUNCTION: LEN(A$) 1370 02146 0000 LEN, 0 1371 02147 1374 TAD (ACX-1 1372 02150 3013 DCA FLTXR /POINTER TO ARGUMENT 1373 02151 1131 TAD M6 1374 02152 3031 DCA MODE /MULTIPURPOSE COUNTER 1375 02153 7101 LEN1, CLL IAC 1376 02154 1134 TAD C77 /L & AC = 00100 1377 02155 1413 TAD I FLTXR 1378 02156 7430 SZL /LINK=1 IF LEFT HALF WAS 77 (A CR) 1379 02157 5367 JMP LEN2 /END OF STRING, DONE COUNTING 1380 02160 2031 ISZ MODE /COUNT CHARACTOR 1381 02161 7001 IAC /IF RIGHT HALF OF AC WAS 77, IS NOW 00. 1382 02162 0134 AND C77 /LOOK AT RIGHT HALF OF AC ONLY 1383 02163 7650 SNA CLA /WAS CHAR A CR? 1384 02164 5367 JMP LEN2 /YES 1385 02165 2031 ISZ MODE /NO: COUNT THE CHARACTOR 1386 02166 5353 JMP LEN1 /NOT YET AT MAXIMUM, CONTINUE 1387 02167 7327 LEN2, L0006 /OFFSET TO PROPERLY ADJUST CHAR COUNT 1388 02170 1031 TAD MODE /AC=LENGTH OF STRING ARGUMENT 1389 02171 4773 JMS I (FFLOAT /CONVERT TO FLOATING POINT 1390 02172 5746 JMP I LEN /EXIT 1391 02173 6164 PAGE 02174 0070 02175 0010 02176 4764 02177 5000 1392 1393 /*EDIT* COMMAND 1394 02200 4562 EDIT, GETLN /GET LINE NUMBER 1395 02201 4563 TSTCCR 1396 02202 7410 SKP /JUNK 1397 02203 4571 FINDLN /FIND THE LINE 1398 02204 4554 ERR001, ERROR /NOT THERE 1399 02205 2032 ISZ SPACSW 1400 02206 4772 JMS I CINPACK /SET TO PACK IT 1401 02207 6211 MODF2, CDF 10 1402 02210 3523 DCA I LLSTMD /READ SILENTLY 1403 02211 4574 READC 1404 02212 1026 MODF3, TAD CHAR 1405 02213 6211 CDF 10 1406 02214 3523 DCA I LLSTMD /SET SEARCH CHARACTOR 1407 02215 4573 MODF1, FREE2 1408 02216 4540 GETC 1409 02217 4537 PRINTC /PRINT LINE UNTIL... 1410 02220 4541 SORTJ 1411 02221 0514 F1CCR-1 1412 02222 0253 MODL1-F1CCR 1413 02223 4561 PACKC /KEEP PACKING 1414 02224 5215 JMP MODF1 1415 1416 02225 4561 MODF4, PACKC /PACK IT 1417 02226 4574 READC /GET CHARS 1418 02227 4541 SORTJ /CHECK THEM 1419 02230 0514 F1CCR-1 1420 02231 7766 MODL2-F1CCR 1421 02232 5225 JMP MODF4 1422 1423 02233 4561 MODF5, PACKC /PACK THE CR 1424 02234 4561 PACKC 1425 02235 4773 JMS I COTPACK /SET TO UNPACK IT 1426 02236 5774 JMP I CSRETN 1427 /*DELETE* COMMAND 1428 02237 4335 DELET, JMS GETLIM /GET LIMITS 1429 02240 1054 TAD BUFR 1430 02241 3016 DCA AXIN /PROTECT TEXT 1431 02242 4320 JMS GETLIN /GET A LINE 1432 02243 5767 JMP I CREADY /WE ARE DONE 1433 02244 4770 JMS I CXDELET /DELETE IT 1434 02245 1031 TAD LASTLN 1435 02246 3027 DCA LINEPC /RESTORE POINTERS 1436 02247 5242 JMP .-5 /LOOP 1437 1438 /*LIST* COMMAND 1439 02250 4335 LIST, JMS GETLIM /GET LIMITS 1440 02251 2032 ISZ SPACSW /KEEP SPACES 1441 02252 1126 TAD M100 1442 02253 3025 DCA PT1 1443 02254 1034 TAD OUTPUT 1444 02255 7650 SNA CLA 1445 02256 5265 JMP LLIST3-3 /NORMAL MODE 1446 02257 3034 DCA OUTPUT /WE WILL OUTPUT FOR A WHILE 1447 02260 4573 LLIST5, FREE2 1448 02261 7330 CLA CLL CML RAR 1449 02262 4537 PRINTC /DO L/T 1450 02263 2025 ISZ PT1 1451 02264 5260 JMP LLIST5 1452 02265 4573 FREE2 1453 02266 1117 TAD CCR 1454 02267 4537 PRINTC 1455 02270 4320 LLIST3, JMS GETLIN /GET A LINE 1456 02271 5305 JMP LLIST4 /WE ARE DONE 1457 02272 4572 FREE13 1458 02273 1030 TAD LINENO 1459 02274 4761 JMS I CITPRNT /PRINT THE NUMBER 1460 02275 1133 TAD C40 1461 02276 4537 PRINTC 1462 02277 4540 GETC 1463 02300 4573 FREE2 1464 02301 4537 PRINTC /PRINT THE LINE 1465 02302 4563 TSTCCR 1466 02303 5277 JMP .-4 /UNTIL A CR 1467 02304 5270 JMP LLIST3 /LOOP 1468 1469 02305 1025 LLIST4, TAD PT1 /DID WE PUNCH TRAILER?? 1470 02306 7640 SZA CLA 1471 02307 5767 JMP I CREADY /NORMAL SO EXIT 1472 02310 1126 TAD M100 1473 02311 3025 DCA PT1 /DO IT AGAIN, TURN ECHO OFF 1474 02312 4573 LLIST6, FREE2 1475 02313 7330 CLA CLL CML RAR 1476 02314 4537 PRINTC 1477 02315 2025 ISZ PT1 1478 02316 5312 JMP LLIST6 1479 02317 5771 JMP I CTAPE 1480 1481 02320 0000 GETLIN, 0 1482 02321 4570 GETNXT /GET NEXT LINE 1483 02322 5720 JMP I GETLIN /OUT OF TEXT 1484 02323 4546 POPA 1485 02324 3104 DCA T3 /GET LIMIT 1486 02325 1104 TAD T3 1487 02326 4543 PUSHA /SAVE LIMIT 1488 02327 1030 TAD LINENO 1489 02330 7041 CIA 1490 02331 1104 TAD T3 1491 02332 7700 SMA CLA 1492 02333 2320 ISZ GETLIN /OK 1493 02334 5720 JMP I GETLIN 1494 1495 02335 0000 GETLIM, 0 1496 02336 4563 TSTCCR 1497 02337 5343 JMP LIMGT1 /NOT ALL 1498 02340 3031 DCA LASTLN /START AT 0 1499 02341 7350 L3777 1500 02342 5353 JMP LIMGT3 1501 1502 1503 02343 4562 LIMGT1, GETLN /GET A LINE NUMBER 1504 02344 1030 TAD LINENO 1505 02345 3031 DCA LASTLN /AND SAVE IT 1506 02346 4564 TSTCOM 1507 02347 5365 JMP LIMGT2 /ONLY ONE LINE 1508 02350 4540 GETC 1509 02351 4562 GETLN /GET LINE NUMBER 1510 02352 1030 TAD LINENO 1511 02353 4543 LIMGT3, PUSHA /UPPER LIMIT 1512 02354 1031 TAD LASTLN 1513 02355 3030 DCA LINENO /LOWER LIMIT 1514 02356 4563 TSTCCR 1515 02357 5204 JMP ERR001 /JUNK 1516 02360 4571 LIMGT4, FINDLN /FIND THE LINE 1517 02361 0231 CITPRNT, ITPRNT /OK NOT TO FIND IT 1518 02362 1031 TAD LASTLN 1519 02363 3027 DCA LINEPC /AND GO BACK ONE 1520 02364 5735 JMP I GETLIM 1521 1522 02365 1031 LIMGT2, TAD LASTLN /1ST = 2ND 1523 02366 5353 JMP LIMGT3 1524 02367 0440 CREADY, READY 1525 02370 1600 CXDELET, XDELET 1526 02371 5101 CTAPE, TAPE 1527 02372 1124 CINPACK, INPACK 1528 02373 1135 COTPACK, OTPACK 1529 02374 0462 CSRETN,SRETN 1530 /*NEXT* COMMAND 1531 02375 4544 NEXT, PUSHJ /GET VARIABLE 1532 02376 4400 GETVAR 1533 02377 7650 SNA CLA /WAS FUNCTION? 1534 02400 4563 TSTCCR /*NEXT* !MUST! BE LAST ON LINE 1535 02401 4554 ERR460, ERROR 1536 02402 4777 JMS I (FFGET 1537 02403 0565 FLARG 1538 02404 4555 UDF 1539 02405 1417 TAD I AXOUT 1540 02406 7450 SNA 1541 02407 4554 ERR470, ERROR /NEXT NOT INITIALIZED 1542 02410 3103 DCA T2 1543 02411 1417 TAD I AXOUT 1544 02412 6201 CDF 1545 02413 3343 DCA RUN9 /SAVE TEXT POINTER TO FOR STMNT 1546 02414 1017 TAD AXOUT 1547 02415 4551 FLGET /GET INCREMENT 1548 02416 0074 OPX 1549 02417 1075 TAD OPH 1550 02420 7700 NEXT3, SMA CLA 1551 02421 1253 TAD C50 /POSITIVE INCREMENT 1552 02422 1220 TAD NEXT3 /NEGATIVE INCREMENT 1553 02423 3237 DCA NEXT1 /SET LIMIT TEST INSTRUCTION 1554 02424 4776 JMS I (FFADD 1555 02425 0074 OPX 1556 02426 4552 FLPUT /SET VARIABLE 1557 02427 0071 ACX 1558 02430 7325 L0003 1559 02431 1017 TAD AXOUT 1560 02432 4551 FLGET /GET LIMIT 1561 02433 0565 FLARG 1562 02434 4775 JMS I (FFSUB 1563 02435 0565 FLARG 1564 02436 1072 TAD ACH 1565 02437 7402 NEXT1, HLT /SKIP IF DONE 1566 02440 5250 JMP NEXT2 /NOT DONE 1567 02441 7340 L7777 1568 02442 1017 TAD AXOUT 1569 02443 3102 DCA T1 1570 02444 4555 UDF 1571 02445 3502 DCA I T1 /NOT INITIALIZED NOW 1572 02446 6201 CDF 1573 02447 5312 JMP CONT 1574 1575 02450 1103 NEXT2, TAD T2 1576 02451 3030 DCA LINENO 1577 02452 4571 FINDLN 1578 02453 0050 C50, 50 1579 02454 1343 TAD RUN9 /GET TEXT POINTER TO FOR STMNT 1580 02455 3017 DCA AXOUT 1581 02456 3021 DCA XCT 1582 02457 3026 DCA CHAR 1583 02460 5312 JMP CONT 1584 /NEW *RUN* COMMAND 1585 02461 1054 RUN, TAD STARTV 1586 02462 3055 DCA LASTV /RESET VARIABLES 1587 02463 4545 PUSHF /INITIALIZE RANDOM NUMBER 1588 02464 0570 FRNDX0 1589 02465 4550 POPF 1590 02466 0063 FRNDX 1591 02467 4567 RUN1, FIND /FIND A NEXT TO UNINITIALIZE 1592 02470 0031 31 /-NEXT CODE 1593 02471 5305 JMP RUN3 /NO MORE NEXT'S 1594 02472 4543 PUSHA /SAVE FOR NEXT FIND 1595 02473 4343 JMS RUN9 /DISMISS NOW SO AS TO NOT HOG THE CPU 1596 02474 4544 RUN2, PUSHJ 1597 02475 4400 GETVAR /THIS IS THE VARIABLE AFTER THE NEXT 1598 02476 7650 SNA CLA /FUNCTION? 1599 02477 4563 TSTCCR /ANYTHING AFTER NEXT STATEMENT? 1600 02500 5201 JMP ERR460 /MUST BE VARIABLE AND END OF LINE 1601 02501 4555 UDF /USER'S DATA FIELD 1602 02502 3417 DCA I AXOUT /UNINITIALIZE NEXT STATEMENT 1603 02503 4546 POPA /FOR FIND: SEARCH FROM THIS PLACE 1604 02504 5267 JMP RUN1 1605 02505 1057 RUN3, TAD ALINE0 1606 02506 3027 DCA LINEPC /BEGIN AT THE BEGINNING 1607 02507 3037 RESTOR, DCA DATAPC 1608 02510 1117 TAD CCR 1609 02511 3043 DCA DATAPC+4 1610 02512 4774 CONT, JMS I (GETMOR /GET NEXT STMNT ON LINE 1611 02513 5773 JMP I (READY /WHOOPS-OUT OF TEXT 1612 02514 4540 RUN4, GETC 1613 02515 4566 COMMAN /GET KEYWORD CODE 1614 02516 0011 11 /-BOUNDARY BETWEEN COOMANDS AND STATEMENTS 1615 02517 7500 SMA /COMMAND OR STATEMENT? 1616 02520 4554 ERR520, ERROR /COMMAND: NOT ALLOWED IN DEFERRED MODE 1617 02521 1372 TAD (COMGOL+41-11 /CALCULATE ADDRESS OF ADDRESS ... 1618 02522 3102 RUN5, DCA T1 /SAVE ADDRESS 1619 02523 6211 CDF SWAP /CHANGE TO DATA FIELD OF DISPATCH LIST 1620 02524 1502 TAD I T1 /GET ADDRESS OF CORRECT ROUTINE 1621 02525 6201 CDF /CHANGE DATA FIELD BACK 1622 02526 3025 DCA PT1 /SAVE ADDRESS 1623 02527 1030 TAD LINENO 1624 02530 3062 DCA ERLINE /SAVE CURRENT LINE NUMBER IN CASE IT CHANGES 1625 02531 2022 ISZ PC /HAVE WE DONE TWO COMMANDS WITHOUT DISMISSING? 1626 02532 5425 JMP I PT1 /NO: GO TO IT! 1627 02533 4343 JMS RUN9 /YES: DISMISS SO OTHERS CAN RUN 1628 02534 5425 JMP I PT1 /NOW GO TO IT. 1629 1630 /*GOTO* COMMAND 1631 02535 4562 GOTO, GETLN /GET THE LINE NUMBER 1632 02536 4575 TSTEND /END OF THE STATEMENT? 1633 02537 4554 ERR270, ERROR /NO: JUNK 1634 /GO TO HERE IF PROGRAM IS SUPPOSED TO JUMP 1635 /LINE NUMBER TO TRANSFER TO IS IN LINENO. 1636 02540 4571 JUMP, FINDLN /FIND THE LINE TO GO TO 1637 02541 4554 ERR380, ERROR /NOT THERE: ERROR 1638 02542 5314 JMP RUN4 /THERE, SO GO DO IT 1639 02543 0000 RUN9, 0 /SUBROUTINE TO DISMISS 1640 02544 1343 TAD RUN9 /GET RETURN ADDRESS 1641 02545 3022 DCA PC /SAVE FOR RESTART 1642 02546 5177 JMP NULL /DISMISS 1643 02547 1060 INPUTX, TAD COMBUF /GET ADDRESS OF A ZERO WORD IN AC 1644 02550 3027 DCA LINEPC /STICK IN LINEPC SO IMMEDIATE MODE WILL STOP 1645 /WHEN DONE 1646 02551 7040 CMA /GET A -1 IN THE AC 1647 02552 3030 DCA LINENO /ALSO MAKE LINENO ILLEGAL 1648 02553 4566 COMMAN /GET KEYWORD CODE 1649 02554 0064 COMGOL+41 /ALL IS LEGAL IN IMMEDIATE MODE, SO MAY 1650 /AS WELL FIGURE ADDRESS NOW. 1651 02555 5322 JMP RUN5 /GO DO IT 1652 / 1653 /NEGATE FAC 1654 / 1655 02556 0000 FFNEG, 0 1656 02557 1073 TAD ACLO /GET LOW ORDER FAC 1657 02560 7141 CLL CMA IAC /NEGATE IT 1658 02561 3073 DCA ACLO /STORE BACK 1659 02562 7024 CML RAL /ADJUST OVERFLOW BIT AND 1660 02563 1072 TAD ACH /PROPAGATE CARRY-GET HI ORD 1661 02564 7141 CLL CMA IAC /NEGATE IT 1662 02565 3072 DCA ACH /STORE BACK 1663 02566 5756 JMP I FFNEG 1664 02572 0053 PAGE 02573 0440 02574 1156 02575 6734 02576 6600 02577 7127 1665 /EXPRESSION EVALUATOR 1666 02600 0000 ECALL, 0 1667 02601 1101 TAD SORTCN 1668 02602 4543 PUSHA 1669 02603 1107 TAD LASTOP 1670 02604 4543 PUSHA 1671 02605 1105 TAD EFOP 1672 02606 4543 PUSHA 1673 02607 1200 TAD ECALL 1674 02610 4543 PUSHA /RETURN ADDRESS 1675 02611 4540 GETC 1676 02612 3107 EVAL, DCA LASTOP /0 IS END 1677 02613 1077 TAD EVAL1 1678 02614 4543 PUSHA /SAVE EVAL1 1679 02615 3077 DCA EVAL1 /0 EVAL1 1680 02616 4560 TESTC 1681 02617 5223 JMP ETERM1 /INITIAL TERMINATOR 1682 02620 5241 JMP ENUM /NUMBER 1683 02621 5346 JMP EVAR /VARIABLE 1684 02622 5777 JMP I (EVALQ /CHECK FOR STRING CONSTANT 1685 1686 02623 1376 ETERM1, TAD (FLZERO 1687 02624 3025 DCA PT1 /0 DATA 1688 02625 7344 L7776 1689 02626 1101 TAD SORTCN 1690 02627 7450 SNA 1691 02630 5264 JMP ETERM /MINUS 1692 02631 7001 IAC 1693 02632 7650 SNA CLA 1694 02633 5340 JMP ARGNXT /PLUS 1695 02634 4576 ELPAR, TSTLPR 1696 02635 5355 JMP EVAL2 /CHECK UNARY 1697 02636 4200 EPAR2, JMS ECALL /RECURSIVE CALL 1698 02637 2015 ISZ PDLXR 1699 02640 5775 JMP I (ENDFUN-2 /END AS FUNCTION 1700 1701 02641 1114 ENUM, TAD FLARGP 1702 02642 3025 DCA PT1 /DATA TO FLARG 1703 02643 4511 JMS I FLINTP /GET VALUE 1704 02644 2077 OPNEXT, ISZ EVAL1 1705 02645 5253 JMP .+6 /NO UNARY 1706 02646 4407 FINT 1707 02647 5776 FGET I (FLZERO 1708 02650 2425 FSUB I PT1 1709 02651 6425 FPUT I PT1 1710 02652 0000 FEXT 1711 02653 3077 DCA EVAL1 1712 02654 4560 TESTC 1713 02655 5261 JMP ETERMN /TERMINATOR 1714 02656 7770 CM10, -10 /CONSTANT 1715 02657 0000 0 1716 02660 3101 DCA SORTCN /ALL ELSE IS END 1717 02661 4576 ETERMN, TSTLPR 1718 02662 7410 SKP 1719 02663 4554 ERR120, ERROR /EXCESS L-PARENS 1720 02664 1101 ETERM, TAD SORTCN 1721 02665 3106 DCA THISOP /SET OP 1722 02666 1106 TAD THISOP 1723 02667 1256 TAD CM10 1724 02670 7700 SMA CLA 1725 02671 3106 DCA THISOP /END 1726 02672 1106 ETERM2, TAD THISOP 1727 02673 7041 CIA 1728 02674 1107 TAD LASTOP /PRIORITIES 1729 02675 7710 SPA CLA 1730 02676 5325 JMP EPAR /NO GO YET 1731 02677 1107 TAD LASTOP 1732 02700 1374 TAD (OPTABL 1733 02701 3105 DCA CNTR 1734 02702 1505 TAD I CNTR 1735 02703 3311 DCA FLOP /SET OP 1736 02704 1107 TAD LASTOP 1737 02705 7640 SZA CLA 1738 02706 4550 POPF /GET DATA 1739 02707 0071 ACX 1740 02710 4407 FINT 1741 02711 0773 FLOP, FJMP I (FUPARR /FLOATING OP 1742 02712 6514 FPUT I FLARGP /SAVE DATA 1743 02713 0000 FEXT 1744 02714 1114 TAD FLARGP 1745 02715 3025 DCA PT1 /POINT TO DATA 1746 02716 1106 TAD THISOP 1747 02717 1107 TAD LASTOP 1748 02720 7650 SNA CLA 1749 02721 5367 JMP EVAL3 /DONE 1750 02722 4546 POPA 1751 02723 3107 DCA LASTOP /NEW OP 1752 02724 5272 JMP ETERM2 1753 1754 02725 4576 EPAR, TSTLPR 1755 02726 7410 SKP 1756 02727 5236 JMP EPAR2 /DO RECURSIVE 1757 02730 1107 TAD LASTOP 1758 02731 4543 PUSHA 1759 02732 1025 TAD PT1 1760 02733 3335 DCA .+2 1761 02734 4545 PUSHF /SAVE DATA 1762 02735 0000 0 1763 02736 1106 TAD THISOP 1764 02737 3107 DCA LASTOP 1765 02740 4540 ARGNXT, GETC 1766 02741 4560 TESTC 1767 02742 5234 JMP ELPAR /T 1768 02743 5241 JMP ENUM /N 1769 02744 5346 JMP EVAR /V 1770 02745 5777 JMP I (EVALQ /OTHER-MIGHT BE STRING CONSTANT 1771 1772 02746 4544 EVAR, PUSHJ /GET VARIABLE 1773 02747 4400 GETVAR 1774 02750 7440 SZA 1775 02751 5772 JMP I (FUNCT3 /FUNCTION 1776 02752 1114 TAD FLARGP 1777 02753 3025 DCA PT1 /POINT TO DATA 1778 02754 5244 JMP OPNEXT 1779 1780 1781 02755 7344 EVAL2, L7776 1782 02756 1101 TAD SORTCN /IS IT + OR -? 1783 02757 7540 SMA SZA 1784 02760 4554 ERR110, ERROR /NO - DOUBLE OPS OR EX L-PARENS 1785 02761 7640 SZA CLA 1786 02762 5340 JMP ARGNXT /WAS + 1787 02763 1077 TAD EVAL1 1788 02764 7040 CMA 1789 02765 3077 DCA EVAL1 /FLIP EVAL1 1790 02766 5340 JMP ARGNXT 1791 1792 02767 4546 EVAL3, POPA 1793 02770 3077 DCA EVAL1 /RESTORE EVAL1 1794 02771 5547 POPJ /EXIT 1795 02772 7705 PAGE 02773 5027 02774 4337 02775 4760 02776 6063 02777 5200 1796 /USER FUNCTION PROCESSING 1797 03000 4543 FUNCT6, PUSHA /SAVE CHARACTER 1798 03001 3105 DCA EFOP 1799 03002 2105 ISZ EFOP 1800 03003 4545 PUSHF /SAVE ARGS 1801 03004 0565 FLARG 1802 03005 4564 TSTCOM 1803 03006 5214 JMP .+6 /NO MORE ARGS 1804 03007 4777 JMS I (ECALL /GET NEXT 1805 03010 4546 POPA 1806 03011 2015 ISZ PDLXR 1807 03012 2015 ISZ PDLXR 1808 03013 5201 JMP .-12 1809 1810 03014 1055 TAD LASTV 1811 03015 3024 DCA SUBS /SAVE END OF VARIABLES 1812 03016 1105 TAD EFOP 1813 03017 3103 FUNC10, DCA T2 1814 03020 7332 L2000 1815 03021 1103 TAD T2 1816 03022 3023 DCA ADD /CREATE ILLEGAL NAME 1817 03023 4544 PUSHJ /LOOK IT UP - WILL DEFINE 1818 03024 4440 LOOKUP 1819 03025 4550 POPF 1820 03026 0565 FLARG 1821 03027 4552 FLPUT /SET ARGUMENT 1822 03030 0565 FLARG 1823 03031 7340 L7777 1824 03032 1103 TAD T2 1825 03033 7440 SZA 1826 03034 5217 JMP FUNC10 /MORE ARGUMENTS 1827 03035 7330 L4000 1828 03036 4546 POPA 1829 03037 7041 CIA 1830 03040 3116 DCA FUNC17 /-CHAR OF FUNCTION 1831 03041 4545 PUSHF 1832 03042 0017 TEXTP 1833 03043 1101 TAD SORTCN 1834 03044 4543 PUSHA 1835 03045 5776 JMP I (FUNC18 /GO SAVE REST 1836 1837 03046 4546 FUNC11, POPA 1838 03047 4567 FIND /FIND A *DEF* 1839 03050 0023 23 /-DEF CODE 1840 03051 4554 ERR170, ERROR /OUT OF TEXT 1841 03052 4543 PUSHA /FOR RESTART 1842 03053 4566 COMMAN /GET WORD 1843 03054 0022 22 /-FN CODE 1844 03055 7640 SZA CLA 1845 03056 5246 JMP FUNC11 1846 03057 1026 TAD CHAR 1847 03060 1116 TAD FUNC17 1848 03061 7640 SZA CLA 1849 03062 5246 JMP FUNC11 /NOT PROPER FUNCTION 1850 03063 2015 ISZ PDLXR 1851 03064 4546 POPA 1852 03065 3027 DCA LINEPC 1853 03066 1062 TAD ERLINE 1854 03067 4543 PUSHA /SAVE CALLING LINE 1855 03070 1030 TAD LINENO 1856 03071 3062 DCA ERLINE /CALL THIS OUT LINE 1857 03072 4540 GETC 1858 03073 4542 SORTC 1859 03074 1011 TERMS-1 1860 03075 7410 SKP 1861 03076 4554 ERR180, ERROR /NO L-PAREN 1862 03077 4576 TSTLPR 1863 03100 5276 JMP .-2 1864 03101 1101 TAD SORTCN 1865 03102 4543 PUSHA 1866 03103 4540 GETC 1867 03104 7332 L2000 1868 03105 3102 DCA T1 1869 03106 1055 TAD LASTV 1870 03107 3025 DCA PT1 /POINT TO ARGUMENTS 1871 03110 4565 FUNC14, TSTALP 1872 03111 5276 JMP .-13 /ILLEGAL VARIABLE 1873 03112 1026 TAD CHAR 1874 03113 0321 AND C37 1875 03114 4556 RTL6 1876 03115 7010 RAR 1877 03116 3103 DCA T2 /SAVE NAME 1878 03117 4540 GETC 1879 03120 4557 TESTN 1880 03121 0037 C37, 37 1881 03122 5330 JMP FUNC13 /NOT NUMBER 1882 03123 1101 TAD SORTCN 1883 03124 7105 CLL IAC RAL 1884 03125 1103 TAD T2 1885 03126 3103 DCA T2 1886 03127 4540 GETC 1887 03130 2102 FUNC13, ISZ T1 /SET ILLEGAL NAME 1888 03131 4555 UDF 1889 03132 1425 TAD I PT1 1890 03133 7041 CIA 1891 03134 1102 TAD T1 1892 03135 7640 SZA CLA 1893 03136 4554 ERR200, ERROR /WRONG NUMBER OF ARGUMENTS 1894 03137 1103 TAD T2 1895 03140 3425 DCA I PT1 /SET TEMPORARY NAME 1896 03141 6201 CDF 1897 03142 1132 TAD M4 1898 03143 1025 TAD PT1 1899 03144 3025 DCA PT1 /POINT TO NEXT 1900 03145 4564 TSTCOM 1901 03146 5351 JMP FUNC12 /NO MORE 1902 03147 4540 GETC 1903 03150 5310 JMP FUNC14 1904 1905 FUNC17=FFLAG 1906 1907 03151 2102 FUNC12, ISZ T1 1908 03152 4555 UDF 1909 03153 1425 TAD I PT1 1910 03154 6201 CDF 1911 03155 7041 CIA 1912 03156 1102 TAD T1 1913 03157 7650 SNA CLA 1914 03160 5336 JMP FUNC13+6 /SHOULD NOT AGREE 1915 03161 4542 SORTC 1916 03162 1011 TERMS-1 1917 03163 7410 SKP 1918 03164 5276 JMP FUNC14-12 /NO PAREN 1919 03165 7344 L7776 1920 03166 1101 TAD SORTCN 1921 03167 7041 CIA 1922 03170 4546 POPA 1923 03171 7640 SZA CLA 1924 03172 5276 JMP FUNC14-12 /NO MATCH 1925 03173 5775 JMP I (FUNC16 1926 03175 5114 PAGE 03176 3757 03177 2600 1927 /*PRINT* COMMAND 1928 03200 4540 PRINT5, GETC /SKIP OVER THE ";" OR "," 1929 03201 7040 CMA /AC=-1, INDICATING ";" OR "," 1930 03202 3025 PRINT, DCA PT1 /SET FLAG PT1 WITH AC 1931 03203 4541 SORTJ /CHECK ; , ' : CR " 1932 03204 0774 PRINL-1 1933 03205 0007 PRINL1-PRINL 1934 03206 1025 TAD PT1 /TAB,CHR$,OR EXPRESSION 1935 03207 7740 SMA SZA CLA /CHECK 3-WAY FLAG 1936 03210 4554 ERR350, ERROR /SYNTAX ERROR 1937 03211 4572 FREE13 /FREE 13 SPACES IN OUTPUT BUFFER 1938 03212 1377 TAD (LISTCH-LIST43 /SET UP TO SEARCH SPECIAL LIST 1939 03213 4566 COMMAN /TEST IF CHR$ OR TAB 1940 03214 0040 40 /-TAB CODE 1941 03215 7440 SZA /TAB? 1942 03216 5252 JMP PRINT2 /NO: GO CHECK OTHER POSSIBILITIES 1943 03217 4353 JMS PRINT8 /EVALUATE ARGUMENT 1944 03220 3025 DCA PT1 /SAVE ARGUMENT 1945 03221 1025 PRIN11, TAD PT1 /GET ARG 1946 03222 1376 TAD (-110 /TAKE ARG MOD 72 DECIMAL 1947 03223 7500 SMA /REDUCED ENOUGH YET? 1948 03224 5222 JMP .-2 /NO 1949 03225 7141 CLL CMA IAC 1950 03226 1061 TAD PRNTC1 /COMPARE WITH CURRENT POSITION 1951 03227 7450 SNA /THERE ALREADY? 1952 03230 5250 JMP PRIN12 /YES: ALL DONE SO GO 1953 03231 3023 DCA ADD /SAVE COUNT 1954 03232 7420 SNL /GONE PAST ALREADY? 1955 03233 5243 JMP PRIN13 /NO: GO SPACE AHEAD 1956 03234 1117 TAD CCR /ASCII FOR A CARRIAGE RETURN 1957 03235 6002 IOF /AN INTERRUPT WOULD MESS THINGS UP 1958 03236 4775 JMS I (XOUTL2 /GO PRINT CR WITH NO LINE FEED 1959 03237 6001 ION /OK TO INTERRUPT NOW 1960 03240 1376 TAD (-110 /-72 DECIMAL 1961 03241 3061 DCA PRNTC1 /INDICATE BEGINNING OF LINE 1962 03242 5221 JMP PRIN11 /DO TAB AGAIN 1963 03243 4573 PRIN13, FREE2 /TO AVOID OUTPUT OVERFLOW 1964 03244 1133 TAD C40 /ASCII FOR SPACE 1965 03245 4537 PRINTC /PRINT THE SPACE 1966 03246 2023 ISZ ADD /PRINT ANOTHER? 1967 03247 5243 JMP .-4 /YES 1968 03250 7001 PRIN12, IAC /AC INDICATES WE JUST DID EXPRESSION 1969 03251 5202 JMP PRINT /GO PROCESS REST OF STATEMENT 1970 1971 03252 7700 PRINT2, SMA CLA /CHR$? 1972 03253 5261 JMP PRINT3 /NO: MUST BE EXPRESSION 1973 03254 4353 JMS PRINT8 /EVALUATE ARG TO CHR$ 1974 03255 6002 IOF /CAN'T HANDLE INTERRUPTS NOW 1975 03256 4775 JMS I (XOUTL2 /SNEAK IN THE CHARACTOR 1976 03257 6001 ION /INTERRUPTS OK 1977 03260 5250 JMP PRIN12 /DONE 1978 1979 03261 3031 PRINT3, DCA MODE /CLEAR STRING MODE FLAG 1980 03262 4544 PUSHJ /GET EXPRESSION 1981 03263 2612 EVAL 1982 03264 2031 ISZ MODE /STRING OR NUMERIC? 1983 03265 5302 JMP PRIN33 /NUMERIC 1984 03266 7340 L7777 /AC CONTAINS 2 CR'S IN PACKED FORMAT 1985 03267 4543 PUSHA /PUT END OF STRING MARK ON STACK 1986 03270 4545 PUSHF /PUT STRING ON STACK 1987 03271 0071 ACX 1988 03272 4774 JMS I (SSR2 /SAVE TEXT POINTERS, UNPACK FROM STACK 1989 03273 7410 SKP 1990 03274 4537 PRINTC /PRINT STRING CHARACTOR 1991 03275 4540 GETC /GET STRING CHARACTOR 1992 03276 4563 TSTCCR /END OF STRING? 1993 03277 5274 JMP .-3 /NO: CONTINUE PRINTING IT 1994 03300 4773 JMS I (SSR3 /RESTORE TEXT, CLEAN UP STACK 1995 03301 5250 JMP PRIN12 /DONE WITH STRING EXPRESSION 1996 1997 03302 1061 PRIN33, TAD PRNTC1 /GET LOCATION ON TTY LINE 1998 03303 1372 TAD (16 /CHECK SPACES LEFT 1999 03304 7750 SPA SNA CLA /WILL IT FIT? 2000 03305 5310 JMP PRIN34 /YES 2001 03306 1117 TAD CCR /NO: MAKE IT FIT 2002 03307 4537 PRINTC /PRINT CR 2003 03310 4510 PRIN34, JMS I FLOUTP /GO PRINT THE FLOATING POINT NUMBER 2004 03311 4573 FREE2 /MAKE ROOM IN OUTPUT BUFFER 2005 03312 1133 TAD C40 /ASCII FOR SPACE 2006 03313 4537 PRINTC /PRINT THE SPACE AFTER THE NUMBER 2007 03314 4564 TSTCOM /A FOOLISH TEST IN CASE NUMBER WAS VERY LONG 2008 03315 5250 JMP PRIN12 /WASN'T COMMA ANYWAY 2009 2010 03316 7326 PRIN41, L0002 /JUST A CUTE OFFSET 2011 03317 1061 TAD PRNTC1 /TTY LOC 2012 03320 1372 TAD (16 2013 03321 7510 SPA 2014 03322 5320 JMP .-2 2015 03323 7650 SNA CLA /AT START OF PRINT ZONE? 2016 03324 5200 JMP PRINT5 /YES: NOW PROCEED AS IF SEMICOLON 2017 03325 4573 PRINT4, FREE2 2018 03326 1133 TAD C40 2019 03327 4537 PRINTC /PRINT SPACE 2020 03330 5316 JMP PRIN41 /NOW CHECK FOR START OF PRINT ZONE 2021 2022 03331 2032 PRINT6, ISZ SPACSW /KEEP SPACES 2023 03332 4540 GETC /GET NEXT CHARACTOR 2024 03333 3032 DCA SPACSW /IGNORE SPACES 2025 03334 4541 SORTJ /CHECK CR " 2026 03335 1000 PRINLB-1 2027 03336 7771 PRINL2-PRINLB 2028 03337 4573 FREE2 /GET SPACE 2029 03340 4537 PRINTC /PRINT THE LITERAL 2030 03341 5331 JMP PRINT6 /GO DO NEXT CHARACTOR 2031 03342 4540 PRIN61, GETC /SKIP OVER THE " 2032 03343 5202 JMP PRINT /DONE WITH LITERAL 2033 2034 03344 1025 PRINT7, TAD PT1 /GET THE FLAG 2035 03345 7710 SPA CLA /GO TO NEW LINE BEFORE EXITING? 2036 03346 5535 JMP I CCONT /NO: DONE WITH PRINT STATEMENT 2037 03347 4573 PRIN71, FREE2 /GET ROOM 2038 03350 1117 TAD CCR /ASCII FOR CR 2039 03351 4537 PRINTC /PRINT THE CR 2040 03352 5535 JMP I CCONT /DONE WITH PRINT STATEMENT 2041 2042 03353 0000 PRINT8, 0 /SUBROUTINE TO EVALUATE TAB AND CHR$ ARGS 2043 03354 4542 SORTC /SET UP SORTCN FOR TSTLPR 2044 03355 1011 TERMS-1 2045 03356 4576 TSTLPR 2046 03357 4554 ERR340, ERROR /NO LEFT PARENTHESIS FOR TAB OR CHR$ 2047 03360 4771 JMS I (ECALL /EVALUATE EXPRESSION RECURSIVELY 2048 03361 2015 ISZ PDLXR /DUMP EFOP 2049 03362 4770 JMS I (PARTST /CHECK PARENTHESIS MATCH, CLEAN UP STACK 2050 03363 4515 JMS I INTEGE /CONVERT FAC TO 1 WORD INTEGER 2051 03364 5753 JMP I PRINT8 /EXIT, AC=ARG 2052 03370 5000 PAGE 03371 2600 03372 0016 03373 2074 03374 2057 03375 3400 03376 7670 03377 7747 2053 03400 0000 XOUTL2, 0 2054 03401 6211 CDF 10 2055 03402 3012 DCA XREG3 /SAVE CHAR 2056 03403 1034 TAD OUTPUT 2057 03404 7640 SZA CLA 2058 03405 5257 JMP XOUTL4 /NO ECHO 2059 03406 1051 TAD TELSW /BUSY 2060 03407 7640 SZA CLA 2061 03410 5237 JMP XOUTL5 /YES 2062 03411 1377 TAD (10 2063 03412 1035 TAD XIOT 2064 03413 3227 DCA XOUTL6 /SET OUTPUT IOT 2065 03414 1036 TAD DECK 2066 03415 7160 CLL CML CMA 2067 03416 3104 DCA T3 2068 03417 7410 SKP 2069 03420 7010 RAR 2070 03421 2104 ISZ T3 2071 03422 5220 JMP .-2 2072 03423 6117 MTON /TURN ON PROPER USER 2073 03424 7200 CLA 2074 03425 1012 TAD XREG3 2075 03426 1376 TAD (200 /TURN THE @?#$%&' 8TH BIT ON!! 2076 03427 7402 XOUTL6, HLT 2077 03430 3051 DCA TELSW /SET BUSY 2078 03431 1775 TAD I (AUSER 2079 03432 6117 MTON /ALL ON AGAIN 2080 03433 7301 L0001 2081 03434 6115 MINT /WITH INTERRUPTS 2082 03435 7200 CLA 2083 03436 5257 JMP XOUTL4 2084 2085 03437 4555 XOUTL5, UDF 2086 03440 1447 TAD I OPTRI /ROOM 2087 03441 7640 SZA CLA 2088 03442 4341 ERR080, JMS IERROR /NO ROOM 2089 03443 4555 UDF 2090 03444 1012 TAD XREG3 2091 03445 3447 DCA I OPTRI /FILL BUFFER 2092 03446 2047 ISZ OPTRI /BUMP BUFFER 2093 03447 1047 TAD OPTRI 2094 03450 7041 CIA 2095 03451 1046 TAD IPTR0 2096 03452 7640 SZA CLA 2097 03453 5257 JMP XOUTL4 /OK 2098 03454 1046 TAD IPTR0 2099 03455 1127 TAD M40 2100 03456 3047 DCA OPTRI /RESET BUFFER 2101 03457 6201 XOUTL4, CDF 2102 03460 5600 JMP I XOUTL2 2103 /*FINDLN* ROUTINE 2104 03461 0000 XFINDL, 0 2105 03462 1030 TAD LINENO 2106 03463 7710 SPA CLA 2107 03464 5320 JMP XFNDL3 2108 03465 4555 UDF 2109 03466 1057 TAD ALINE0 2110 03467 3031 DCA LASTLN 2111 03470 1057 TAD ALINE0 2112 03471 3027 XFNDL1, DCA LINEPC /CURRENT LINE 2113 03472 1027 TAD LINEPC 2114 03473 3012 DCA XREG3 2115 03474 1030 TAD LINENO 2116 03475 7041 CIA 2117 03476 1412 TAD I XREG3 2118 03477 7450 SNA 2119 03500 5311 JMP XFNDL2-1 /FOUND LINE 2120 03501 7700 SMA CLA 2121 03502 5312 JMP XFNDL2 /WENT BEYOND 2122 03503 1027 TAD LINEPC 2123 03504 3031 DCA LASTLN 2124 03505 1427 TAD I LINEPC 2125 03506 7440 SZA 2126 03507 5271 JMP XFNDL1 /LOOP 2127 03510 7410 SKP /OUT OF TEXT 2128 03511 2261 ISZ XFINDL /FOUND LINE 2129 03512 1027 XFNDL2, TAD LINEPC 2130 03513 7001 IAC 2131 03514 3017 DCA AXOUT /SET TO UNPACK 2132 03515 3021 DCA XCT 2133 03516 6201 CDF 2134 03517 5661 JMP I XFINDL 2135 03520 2261 XFNDL3, ISZ XFINDL 2136 03521 5316 JMP .-3 2137 /ERROR ENTERING ROUTINES 2138 03522 0000 XERROR, 0 2139 03523 6002 IOF 2140 03524 7200 CLA 2141 03525 6201 IERRO1, CDF 2142 03526 1374 TAD (NULL 2143 03527 3341 DCA IERROR 2144 03530 1322 IERRO2, TAD XERROR 2145 03531 7110 CLL RAR /FORM ERROR CODE 2146 03532 3025 DCA PT1 2147 03533 7350 L3777 2148 03534 0406 AND I TEMP2 /CLEAR I WAIT 2149 03535 3406 DCA I TEMP2 2150 03536 1373 TAD (ERRORX 2151 03537 3022 DCA PC /SET FOR RESTART 2152 03540 5741 JMP I IERROR 2153 2154 03541 0000 IERROR, 0 2155 03542 7340 L7777 2156 03543 1127 TAD M40 2157 03544 1046 TAD IPTR0 2158 03545 3012 DCA XREG3 2159 03546 1127 TAD M40 2160 03547 3104 DCA T3 /BUFFER COUNT 2161 03550 4555 UDF 2162 03551 3412 DCA I XREG3 /CLEAR BUFFER 2163 03552 2104 ISZ T3 2164 03553 5351 JMP .-2 2165 03554 6201 CDF 2166 03555 1047 TAD OPTRI 2167 03556 3050 DCA OPTRO 2168 03557 1341 TAD IERROR 2169 03560 3322 DCA XERROR 2170 03561 1112 TAD LOOK 2171 03562 7041 CIA 2172 03563 1006 TAD TEMP2 2173 03564 7650 SNA CLA 2174 03565 5325 JMP IERRO1 /RUNNING 2175 03566 5330 JMP IERRO2 /NOT RUNNING 2176 2177 /*UDF* ROUTINE 2178 03567 0000 XUDF, 0 2179 03570 6211 CDF 10 /BECOMES CDF TO USER'S FIELD 2180 03571 5767 JMP I XUDF 2181 2182 2183 03572 4554 ERR330, ERROR /TOO MANY *RETURN*S 2184 03573 0376 PAGE 03574 0177 03575 0064 03576 0200 03577 0010 2185 /*PACKC* ROUTINE 2186 03600 0000 XPACKC, 0 2187 03601 4211 JMS XCPACK /PACK THE CHARACTOR 2188 03602 1453 TAD I PACKND 2189 03603 1130 TAD M12 2190 03604 7141 CLL CIA 2191 03605 1016 TAD AXIN 2192 03606 7630 SZL CLA 2193 03607 4554 ERR060, ERROR /TOO FAR 2194 03610 5600 XPACK5, JMP I XPACKC 2195 2196 03611 0000 XCPACK, 0 /BASIC UNCOMPLICATED PACK ROUTINE 2197 03612 4541 SORTJ /CHECK FOR CR,BELL,RUBOUT,_,ALTMODE,@ 2198 03613 1033 XPAKL1-1 2199 03614 0011 XPAKL2-XPAKL1 2200 03615 1026 TAD CHAR /CONVERT TO SIXBIT 2201 03616 1127 TAD M40 2202 03617 2024 XPACK4, ISZ XCTIN 2203 03620 5232 JMP XPACK1 /NO PARTIAL 2204 03621 1023 TAD ADD /FORM WORD 2205 03622 4555 UDF 2206 03623 3416 DCA I AXIN /PACK IT 2207 03624 6201 CDF 2208 03625 3023 DCA ADD /RESET PARTIAL JUST TO BE SAFE 2209 03626 5611 JMP I XCPACK 2210 2211 03627 1377 XPACK2, TAD (37 2212 03630 1133 XPACK3, TAD C40 2213 03631 5217 JMP XPACK4 2214 2215 03632 4556 XPACK1, RTL6 2216 03633 3023 DCA ADD /SAVE PARTIAL 2217 03634 7340 L7777 2218 03635 3024 DCA XCTIN /INDICATE PARTIAL 2219 03636 5611 JMP I XCPACK 2220 2221 03637 2024 XPACK7, ISZ XCTIN /PARTIAL HERE 2222 03640 5245 JMP XPACK8 /NO 2223 03641 3023 XPACK9, DCA ADD 2224 03642 1122 TAD C137 2225 03643 4537 PRINTC /PRINT BACK ARROW 2226 03644 5600 JMP I XPACKC 2227 2228 03645 1052 XPACK8, TAD PACKST 2229 03646 7041 CIA 2230 03647 1016 TAD AXIN 2231 03650 7650 SNA CLA 2232 03651 5600 JMP I XPACKC /ALL GONE ANY HOW 2233 03652 1016 TAD AXIN 2234 03653 3104 DCA T3 2235 03654 7340 L7777 2236 03655 3024 DCA XCTIN /INDICATE PARTIAL 2237 03656 7340 L7777 2238 03657 1016 TAD AXIN 2239 03660 3016 DCA AXIN /PUT IT BACK ONE 2240 03661 4555 UDF 2241 03662 1504 TAD I T3 /GET OLD 2242 03663 0126 AND C7700 2243 03664 5241 JMP XPACK9 2244 2245 03665 4545 XPPCK1, PUSHF /SAVE TEXT POINTERS 2246 03666 0017 TEXTP 2247 03667 1200 TAD XPACKC 2248 03670 4543 PUSHA /SAVE ADDRESS IF DISMISSED 2249 03671 4572 FREE13 2250 03672 1117 TAD CCR 2251 03673 4776 JMS I (READY1 /PRINT "$ DELETED,CR" 2252 03674 4546 POPA 2253 03675 3200 DCA XPACKC /RESTORE ADDRESS 2254 03676 1052 TAD PACKST 2255 03677 3016 DCA AXIN 2256 03700 4550 POPF 2257 03701 0017 TEXTP 2258 03702 3026 DCA CHAR 2259 03703 5235 JMP XPACK1+3 2260 /*READC* ROUTINE 2261 03704 0000 XREADC, 0 2262 03705 4555 UDF 2263 03706 1445 TAD I IPTRO /GET CHAR 2264 03707 3026 DCA CHAR /SET CHARACTER 2265 03710 3445 DCA I IPTRO /CLEAR BUFFER 2266 03711 6201 CDF 2267 03712 1026 TAD CHAR 2268 03713 7650 SNA CLA /WAS THERE A CHARACTER 2269 03714 5327 JMP XREAD1 /NO - WAIT 2270 03715 2045 ISZ IPTRO /BUMP BUFFER 2271 03716 1045 TAD IPTRO 2272 03717 7041 CIA 2273 03720 1133 TAD C40 2274 03721 1046 TAD IPTR0 2275 03722 7640 SZA CLA 2276 03723 5326 JMP .+3 /OK 2277 03724 1046 TAD IPTR0 2278 03725 3045 DCA IPTRO /RESET BUFFER 2279 03726 5704 JMP I XREADC 2280 2281 2282 03727 7340 XREAD1, L7777 2283 03730 1304 TAD XREADC 2284 03731 3022 DCA PC /SET TO REDO ROUTINE 2285 03732 1512 TAD I LOOK 2286 03733 4775 JMS I (XOR 2287 03734 4000 4000 /I WAIT AND DISMISS 2288 /*TSTLPR* ROUTINE 2289 03735 0000 LPRTST, 0 2290 03736 1101 TAD SORTCN 2291 03737 1131 TAD M6 2292 03740 7710 SPA CLA 2293 03741 5735 JMP I LPRTST /NOT L-PAREN 2294 03742 1101 TAD SORTCN 2295 03743 1374 TAD (-10 2296 03744 7710 SPA CLA 2297 03745 2335 ISZ LPRTST /L-PAREN 2298 03746 5735 JMP I LPRTST 2299 03747 0000 USER0, 0 2300 03750 0001 USER1, 1 2301 03751 0002 USER2, 2 2302 03752 0003 USER3, 3 2303 03753 0004 USER4, 4 2304 03754 0005 USER5, 5 2305 03755 0006 USER6, 6 2306 03756 0007 USER7, 7 2307 2308 /CONTINUATION OF USER FUNCTION PROCCESSING 2309 03757 1024 FUNC18, TAD SUBS 2310 03760 4543 PUSHA 2311 03761 1027 TAD LINEPC 2312 03762 4543 PUSHA 2313 03763 5764 JMP I .+1 2314 03764 3047 FUNC11+1 2315 03774 7770 PAGE 03775 4162 03776 0534 03777 0037 2316 /*POPF* ROUTINE 2317 04000 0000 XPOPF, 0 2318 04001 7340 L7777 2319 04002 1600 TAD I XPOPF 2320 04003 3012 DCA XREG3 /POINT TO DATA AREA 2321 04004 7346 L7775 2322 04005 3104 DCA T3 2323 04006 4555 UDF 2324 04007 1415 TAD I PDLXR 2325 04010 6201 CDF 2326 04011 3412 DCA I XREG3 /MOVE DATA 2327 04012 2104 ISZ T3 2328 04013 5206 JMP .-5 2329 04014 2200 ISZ XPOPF 2330 04015 5600 JMP I XPOPF 2331 /*TESTN* ROUTINE 2332 04016 0000 XTESTN, 0 2333 04017 1026 TAD CHAR 2334 04020 1377 TAD (-60 2335 04021 3101 DCA SORTCN /SAVE BINARY DIGIT 2336 04022 7326 L0002 2337 04023 1101 TAD SORTCN 2338 04024 7450 SNA 2339 04025 5616 JMP I XTESTN /PERIOD 2340 04026 2216 ISZ XTESTN 2341 04027 1376 TAD (-13 2342 04030 7740 SMA SZA CLA 2343 04031 5616 JMP I XTESTN /GREATER THAN 71 2344 04032 1101 TAD SORTCN 2345 04033 7700 SMA CLA 2346 04034 2216 ISZ XTESTN /DIGIT 2347 04035 5616 JMP I XTESTN 2348 /*GETC* ROUTINE 2349 04036 0000 XGETC, 0 2350 04037 2021 ISZ XCT 2351 04040 5251 JMP XGET1 /NO PARTIAL 2352 04041 1020 TAD GTEM /GET PARTIAL 2353 04042 0134 XGET2, AND C77 /AND OFF JUNK 2354 04043 1133 TAD C40 /CORRECT TO ASCII 2355 04044 3026 DCA CHAR 2356 04045 4541 SORTJ /CHECK SPECIALS 2357 04046 1027 XGETL1-1 2358 04047 7450 XGETL2-XGETL1 2359 04050 5636 JMP I XGETC 2360 2361 2362 04051 4555 XGET1, UDF 2363 04052 1417 TAD I AXOUT /GET NEXT 2364 04053 6201 CDF 2365 04054 3020 DCA GTEM /SAVE PARTIAL 2366 04055 7340 L7777 2367 04056 3021 DCA XCT /INDICATE PARTIAL 2368 04057 1020 TAD GTEM 2369 04060 4556 RTL6 2370 04061 7004 RAL 2371 04062 5242 JMP XGET2 2372 2373 04063 1032 XGET3, TAD SPACSW /SPACE TEST 2374 04064 7640 SZA CLA 2375 04065 5636 JMP I XGETC /KEEP SPACES 2376 04066 5237 JMP XGETC+1 /IGNORE SPACES 2377 2378 04067 1120 XGET4, TAD C7 /BELL 2379 04070 3026 XGET6, DCA CHAR 2380 04071 5636 JMP I XGETC 2381 2382 04072 1117 XGET5, TAD CCR /CR 2383 04073 5270 JMP XGET6 2384 2385 /CONTINUATION OF RANDOM NUMBER GENERATOR 2386 04074 1064 RND1, TAD FRNDX+1 2387 04075 3063 DCA FRNDX 2388 04076 7350 L3777 2389 04077 0063 AND FRNDX 2390 04100 3072 DCA ACH 2391 04101 1071 TAD ACX 2392 04102 3065 DCA FRNDX+2 2393 04103 3071 DCA ACX 2394 04104 4775 JMS I (FFNOR 2395 04105 5774 JMP I (RND2 /GO BACK TO EXIT 2396 /*GETNXT* ROUTINE 2397 04106 0000 NXTGET, 0 2398 04107 4555 UDF 2399 04110 1427 TAD I LINEPC /POINTER TO NEXT 2400 04111 7450 SNA 2401 04112 5322 JMP .+10 /OUT OF TEXT 2402 04113 3027 DCA LINEPC /NEW POINTER 2403 04114 1027 TAD LINEPC 2404 04115 3017 DCA AXOUT 2405 04116 3021 DCA XCT /SET TO UNPACK 2406 04117 1417 TAD I AXOUT /GET LINE NUMBER 2407 04120 3030 DCA LINENO 2408 04121 2306 ISZ NXTGET 2409 04122 6201 CDF 2410 04123 5706 JMP I NXTGET 2411 /*FIND* ROUTINE 2412 04124 0000 XFIND, 0 2413 04125 3030 DCA LINENO 2414 04126 4571 FINDLN 2415 04127 7410 SKP /NO TEXT 2416 04130 4773 XFIND1, JMS I (GETMOR /GET THE NEXT STATEMENT 2417 04131 5342 JMP XFIND2 /OUT OF TEXT 2418 04132 4540 GETC 2419 04133 4566 COMMAN 2420 04134 0000 0000 2421 04135 1724 TAD I XFIND /CORRECT COMMAND 2422 04136 7640 SZA CLA 2423 04137 5330 JMP XFIND1 /NO - LOOP 2424 04140 2324 ISZ XFIND 2425 04141 1030 TAD LINENO /FOR RESTART 2426 04142 2324 XFIND2, ISZ XFIND 2427 04143 5724 JMP I XFIND 2428 04144 0000 XPRNTC, 0 2429 04145 6002 IOF 2430 04146 4553 PRINTX 2431 04147 6001 ION 2432 04150 5744 JMP I XPRNTC 2433 /*RETURN* AND *POPJ* 2434 04151 4575 RETURN, TSTEND 2435 04152 4554 ERR320, ERROR 2436 04153 3012 XPOPJ, DCA XREG3 /SAVE AC 2437 04154 4555 UDF 2438 04155 1415 TAD I PDLXR 2439 04156 6201 CDF 2440 04157 3104 DCA T3 /RETURN ADDRESS 2441 04160 1012 TAD XREG3 /GET AC 2442 04161 5504 JMP I T3 2443 /*OR* ROUTINE 2444 04162 0000 XOR, 0 2445 04163 3104 DCA T3 2446 04164 1762 TAD I XOR 2447 04165 7040 CMA 2448 04166 0104 AND T3 2449 04167 1762 TAD I XOR 2450 04170 3512 DCA I LOOK 2451 04171 5177 JMP NULL 2452 04173 1156 PAGE 04174 5373 04175 7076 04176 7765 04177 7720 2453 /CHARACTER TEST ROUTINES 2454 04200 0000 COMTST, 0 2455 04201 1377 TAD (-54 /-COMMA 2456 04202 1026 TAD CHAR 2457 04203 7650 SNA CLA 2458 04204 2200 ISZ COMTST /FOUND IT 2459 04205 5600 JMP I COMTST 2460 2461 04206 0000 CCRTST, 0 2462 04207 1206 TAD CCRTST 2463 04210 3200 DCA COMTST 2464 04211 1376 TAD (-15 /-CR 2465 04212 5202 JMP COMTST+2 2466 2467 04213 0000 ENDTST, 0 2468 04214 1375 TAD (-72 /-COLON 2469 04215 1026 TAD CHAR 2470 04216 7440 SZA 2471 04217 1374 TAD (-47+72 /TEST FOR APOSTROPHE 2472 04220 7650 SNA CLA 2473 04221 7001 IAC 2474 04222 1213 TAD ENDTST 2475 04223 5210 JMP CCRTST+2 2476 04224 0000 ALPTST, 0 2477 04225 1026 TAD CHAR 2478 04226 1126 TAD M100 2479 04227 7750 SPA SNA CLA 2480 04230 5624 JMP I ALPTST /LESS THAN *A* 2481 04231 1026 TAD CHAR 2482 04232 1373 TAD (-132 2483 04233 7750 SPA SNA CLA 2484 04234 2224 ISZ ALPTST /LETTER 2485 04235 5624 JMP I ALPTST 2486 /*TESTC* ROUTINE 2487 04236 0000 XTESTC, 0 2488 04237 4542 SORTC 2489 04240 1011 TERMS-1 2490 04241 5636 JMP I XTESTC /TERMINATOR 2491 04242 2236 ISZ XTESTC 2492 04243 4557 TESTN 2493 04244 5636 JMP I XTESTC 2494 04245 7410 SKP 2495 04246 5636 JMP I XTESTC 2496 04247 2236 ISZ XTESTC 2497 04250 4565 TSTALP 2498 04251 2236 ISZ XTESTC /OTHER 2499 04252 5636 JMP I XTESTC /LETTER 2500 /NEW *GOSUB* STATEMENT 2501 /IT IS NOW LEGAL TO HAVE STATEMENTS ON THE LINE AFTER GOSUB 2502 04253 1017 GOSUB, TAD AXOUT /LOCATION IN THE LINE 2503 04254 4543 PUSHA 2504 04255 1030 TAD LINENO /CURRENT LINE NUMBER 2505 04256 4543 PUSHA 2506 04257 1265 TAD CGOSB1 /POINTER TO GOSUB1 2507 04260 4543 PUSHA 2508 04261 5772 JMP I (GOTO /NOW JUMP TO *GOTO* STATEMENT TO TRANSFER CONTROL 2509 2510 /THE FOLLOWING ROUTINE DOES THE RETURN FROM A BASIC SUBROUTINE 2511 04262 4546 GOSUB1, POPA /GET LINE NUMBER OF CALLING *GOSUB* STATEMENT 2512 04263 3030 DCA LINENO /STORE FOR *FINDLN* 2513 04264 4571 FINDLN /FIND THE LINE 2514 04265 4262 CGOSB1, GOSUB1 /SHOULD NEVER RETURN TO HERE 2515 04266 4546 POPA /GET LOC. OF GOSUB IN LINE 2516 04267 3017 DCA AXOUT /STORE FOR THE TEXT UNPACKING ROUTINE 2517 04270 4540 GETC 2518 04271 5535 JMP I CCONT /GO EXECUTE STATEMENT AFTER GOSUB 2519 /*NEW* AND *BYE* AND *SCRATCH* COMMANDS 2520 04272 4563 BYE, TSTCCR 2521 04273 4554 ERR002, ERROR /JUNK 2522 04274 4555 UDF 2523 04275 3457 DCA I ALINE0 /NO TEXT 2524 04276 6201 CDF 2525 04277 7326 L0002 2526 04300 1057 TAD ALINE0 2527 04301 3054 DCA BUFR /FREE UP TEXT SPACE 2528 04302 1054 END, TAD STARTV 2529 04303 3055 DCA LASTV 2530 04304 5771 JMP I (READY 2531 /*ON* COMMAND 2532 04305 4544 ON, PUSHJ /GET VALUE 2533 04306 2612 EVAL 2534 04307 4566 COMMAN 2535 04310 0037 37 /-GOTO 2536 04311 7640 SZA CLA 2537 04312 4554 ERR300, ERROR /NOT GOTO 2538 04313 4515 JMS I INTEGE 2539 04314 7041 CIA 2540 04315 3102 DCA T1 2541 04316 3103 DCA T2 2542 04317 4562 ON1, GETLN /GET A LINE NUMBER 2543 04320 2102 ISZ T1 2544 04321 5324 JMP .+3 /NOT THIS ONE 2545 04322 1030 TAD LINENO 2546 04323 3103 DCA T2 2547 04324 4564 TSTCOM 2548 04325 5330 JMP .+3 /TRY FOR CR 2549 04326 4540 GETC 2550 04327 5317 JMP ON1 2551 2552 04330 4575 TSTEND 2553 04331 5312 JMP ERR300 /JUNK 2554 04332 1103 TAD T2 2555 04333 7450 SNA 2556 04334 5535 JMP I CCONT 2557 04335 3030 DCA LINENO 2558 04336 5536 JMP I CJUMP 2559 04337 5425 OPTABL, FGET I PT1 2560 04340 1425 FADD I PT1 2561 04341 2425 FSUB I PT1 2562 04342 3425 FMPY I PT1 2563 04343 4425 FDIV I PT1 2564 04344 0000 FJMP 0 2565 2566 2567 2568 /THIS WAS NECESSARY TO ALLOW *NEXT* ON THE SAME LINE WITH OTHER 2569 /THINGS (IT FINDS THE BEGINNING OF THE LAST STAEMENT ON A LINE) 2570 04345 4550 POPF 2571 04346 0565 FLARG 2572 04347 3032 ENDFND, DCA SPACSW 2573 04350 4545 PUSHF 2574 04351 0017 TEXTP 2575 04352 4540 GETC 2576 04353 4575 TSTEND 2577 04354 5352 JMP .-2 2578 04355 4563 TSTCCR 2579 04356 5345 JMP ENDFND-2 /NOT LAST STATEMENT--TRY THE NEXT ONE 2580 04357 4550 POPF 2581 04360 0017 TEXTP 2582 04361 4540 GETC 2583 04362 4566 COMMAN 2584 04363 0031 31 /-NEXT CODE 2585 04364 5547 POPJ 2586 2587 2588 04371 0440 PAGE 04372 2535 04373 7646 04374 0023 04375 7706 04376 7763 04377 7724 2589 /GET A VARIABLE OR FUNCTION ROUTINE 2590 /EXIT WITH AC NON-ZERO IF FUNCTION 2591 /AC IS LIST POINTER UNLESS 2592 /AC IS NEGATIVE, THEN AC IS CHAR FOR USER FUNCTION 2593 04400 4565 GETVAR, TSTALP 2594 04401 4554 ERR220, ERROR /MUST BE LETTER 2595 04402 1026 TAD CHAR 2596 04403 1126 TAD M100 2597 04404 4556 RTL6 2598 04405 7010 RAR 2599 04406 3023 DCA ADD /SAVE FOR NAME 2600 04407 4540 GETC 2601 04410 4560 TESTC 2602 04411 5343 JMP SUBT /T - TEST FOR SUBSCRIPT 2603 04412 5215 JMP .+3 /N - ADD TO NAME 2604 04413 5741 JMP I FUNCTI /TRY FOR FUNCTION 2605 04414 5225 JMP GVS1 /O - TEST FOR STRING 2606 04415 4557 TESTN 2607 04416 5240 JMP LOOKUP /WAS A "." 2608 04417 7734 MDOLR, 200-"$ /SHOULD NEVER RETURN HERE 2609 04420 1101 TAD SORTCN /GET BINARY DIGIT VALUE 2610 04421 7105 CLL IAC RAL /MAKE NONZERO AND SHIFT INTO FIELD 2611 04422 1023 TAD ADD /FORM NEW NAME 2612 04423 3023 DCA ADD /STORE BACK 2613 04424 4540 GETC /SKIP OVER THE DIGIT 2614 04425 1026 GVS1, TAD CHAR 2615 04426 1217 TAD MDOLR /CHECK FOR STRING 2616 04427 7640 SZA CLA /STRING? 2617 04430 5235 JMP GVS2 /NO: CHECK FOR SUBSCRIPT 2618 04431 7340 L7777 /YES 2619 04432 3031 DCA MODE /SET STRING MODE 2620 04433 2023 ISZ ADD /ALSO INDICATE STRING IN ADD 2621 04434 4540 GETC /SKIP OVER THE "$" 2622 04435 4542 GVS2, SORTC 2623 04436 1011 TERMS-1 2624 04437 5343 JMP SUBT 2625 04440 4555 LOOKUP, UDF 2626 04441 1055 TAD LASTV 2627 04442 3025 GS1, DCA PT1 /POINT TO VARIABLES 2628 04443 1054 TAD STARTV 2629 04444 7041 CIA 2630 04445 1025 TAD PT1 2631 04446 7650 SNA CLA 2632 04447 5270 JMP GS2 /NOT FOUND AT ALL 2633 04450 1425 TAD I PT1 /GET NAME 2634 04451 7141 CLL CIA 2635 04452 1023 TAD ADD 2636 04453 7450 SNA 2637 04454 5735 JMP I GFND1I /FOUND NAME 2638 04455 7420 SNL 2639 04456 7041 CIA /POSITIVE DIFFERENCE 2640 04457 7106 CLL RTL /AC WILL BE 0 IF DIFFERENCE WAS 2000 2641 04460 7650 SNA CLA 2642 04461 4554 ERR130, ERROR /ERROR - A(I) AND A(I,I) CANNOT EXIST TOGETHER 2643 04462 1425 TAD I PT1 2644 04463 7710 SPA CLA 2645 04464 7340 L7777 /BACK 1 FOR SUBSCRIPT 2646 04465 1132 GS4, TAD M4 2647 04466 1025 TAD PT1 2648 04467 5242 JMP GS1 /LOOP 2649 2650 04470 1120 GS2, TAD C7 2651 04471 1055 TAD LASTV /ROOM LEFT 2652 04472 7141 CLL CIA 2653 04473 1015 TAD PDLXR 2654 04474 7630 SZL CLA 2655 04475 5301 JMP .+4 2656 04476 1054 TAD STARTV 2657 04477 3055 DCA LASTV /KILL EM-OVFLOW 2658 04500 4554 ERR100, ERROR /NO ROOM 2659 04501 7307 L0004 2660 04502 1055 TAD LASTV 2661 04503 3025 DCA PT1 /POINT TO NEW SPACE 2662 04504 1023 TAD ADD 2663 04505 7700 SMA CLA 2664 04506 5312 JMP GPUT1 2665 04507 1024 TAD SUBS 2666 04510 3425 DCA I PT1 /SET SUBSCRIPT 2667 04511 2025 ISZ PT1 2668 04512 1023 GPUT1, TAD ADD 2669 04513 3425 DCA I PT1 /SET NAME 2670 04514 6201 CDF 2671 04515 1025 TAD PT1 2672 04516 4543 PUSHA 2673 04517 7301 L0001 2674 04520 1055 TAD LASTV 2675 04521 3025 DCA PT1 /POINT TO NEW DATA SPACE 2676 04522 4546 POPA 2677 04523 3055 DCA LASTV /NEW LIMIT 2678 04524 7301 L0001 /SET UP FOR 0.0 OR NULL STRING 2679 04525 0023 AND ADD 2680 04526 7041 CIA 2681 04527 1334 TAD FLZROI 2682 04530 3332 DCA GPUT2 2683 04531 4552 FLPUT /INITIALIZE 2684 04532 6063 GPUT2, FLZERO /BECOMES FLZERO OR FLZERO-1 2685 04533 5737 JMP I GS5I 2686 04534 6063 FLZROI, FLZERO 2687 04535 4615 GFND1I, GFND1 2688 04536 4610 SUB2I, SUB2 2689 04537 4634 GS5I, GS5 2690 04540 5000 PARTSI, PARTST 2691 04541 4637 FUNCTI, FUNCT 2692 04542 2600 ECALLI, ECALL 2693 2694 04543 4576 SUBT, TSTLPR 2695 04544 5240 JMP LOOKUP /NOT SUBSCRIPTED 2696 04545 1023 TAD ADD 2697 04546 3105 DCA EFOP 2698 04547 4742 JMS I ECALLI /GET SUBSCRIPT 2699 04550 7330 L4000 2700 04551 4546 POPA 2701 04552 3023 DCA ADD /SAVE NAME 2702 04553 4515 JMS I INTEGE 2703 04554 7510 SPA 2704 04555 4554 SUB1, ERROR /TOO BIG OR NEGATIVE 2705 ERR230=SUB1 2706 04556 3024 DCA SUBS /SET SUBSCRIPT 2707 04557 4564 TSTCOM 2708 04560 5736 JMP I SUB2I /ONLY ONE SUBSCRIPT 2709 04561 4545 PUSHF /SAVE ADD,SUBS 2710 04562 0023 ADD 2711 04563 4544 PUSHJ /GET SECOND SUBSCRIPT 2712 04564 2611 EVAL-1 2713 04565 4550 POPF 2714 04566 0023 ADD 2715 04567 4515 JMS I INTEGE 2716 04570 3070 DCA AC2 2717 04571 1070 TAD AC2 2718 04572 0126 AND C7700 2719 04573 7640 SZA CLA 2720 04574 5355 JMP SUB1 /TOO BIG 2721 04575 1024 TAD SUBS 2722 04576 0126 AND C7700 2723 04577 7640 SZA CLA 2724 04600 5613 JMP I SUB1I /TOO BIG 2725 04601 1024 TAD SUBS 2726 04602 4556 RTL6 2727 04603 1070 TAD AC2 /FORM DOUBLE SUBSCRIPT 2728 04604 3024 DCA SUBS 2729 04605 7332 L2000 2730 04606 1023 TAD ADD 2731 04607 3023 DCA ADD /INDICATE 2 SUBSCRIPTS 2732 04610 4770 SUB2, JMS I LITS 2733 04611 5612 JMP I LKUPI 2734 2735 04612 4440 LKUPI, LOOKUP 2736 04613 4555 SUB1I, SUB1 2737 04614 4465 PGS4, GS4 2738 2739 04615 1023 GFND1, TAD ADD 2740 04616 7700 SMA CLA 2741 04617 5230 JMP GFND2 /NO SUBSCRIPT 2742 04620 7340 L7777 2743 04621 1025 TAD PT1 2744 04622 3025 DCA PT1 2745 04623 1425 TAD I PT1 /GET SUBSCRIPT 2746 04624 7041 CIA 2747 04625 1024 TAD SUBS 2748 04626 7640 SZA CLA 2749 04627 5614 JMP I PGS4 /WRONG SUBSCRIPT 2750 04630 6201 GFND2, CDF 2751 04631 7346 L7775 2752 04632 1025 TAD PT1 2753 04633 3025 DCA PT1 /POINT TO DATA 2754 04634 4551 GS5, FLGET /GET VARIABLE 2755 04635 0565 FLARG 2756 04636 5547 POPJ 2757 2758 04637 1026 FUNCT, TAD CHAR 2759 04640 0303 AND F37 2760 04641 1023 TAD ADD 2761 04642 4542 SORTC 2762 04643 1054 FUNL1-1 2763 04644 7410 SKP 2764 04645 5612 JMP I LKUPI /NOT A FUNCTION 2765 04646 1101 TAD SORTCN 2766 04647 7650 SNA CLA 2767 04650 5312 JMP FUNCT4 /USER FUNCTION 2768 04651 4545 PUSHF 2769 04652 0017 TEXTP 2770 04653 1026 TAD CHAR 2771 04654 4543 PUSHA 2772 04655 4540 GETC 2773 04656 1026 TAD CHAR 2774 04657 3025 DCA PT1 2775 04660 4546 POPA 2776 04661 3026 DCA CHAR 2777 04662 4550 POPF 2778 04663 0017 TEXTP 2779 04664 1101 TAD SORTCN 2780 04665 1311 TAD LFUNL2 2781 04666 3104 DCA T3 2782 04667 6211 CDF SWAP 2783 04670 1504 TAD I T3 /GET CORRECT CODE 2784 04671 6201 CDF 2785 04672 1025 TAD PT1 2786 04673 7640 SZA CLA 2787 04674 5612 JMP I LKUPI /WAS NOT A FUNCTION 2788 04675 1101 TAD SORTCN 2789 04676 4543 PUSHA /SAVE CONSTANT 2790 04677 4540 GETC 2791 04700 4540 FUNCT5, GETC 2792 04701 4542 SORTC 2793 04702 1011 TERMS-1 2794 04703 0037 F37, 37 2795 04704 4576 TSTLPR 2796 04705 4554 ERR240, ERROR /NO L-PAREN 2797 04706 4546 POPA 2798 04707 7001 IAC /FUNCTION CODE 2799 04710 5547 POPJ 2800 2801 04711 0523 LFUNL2, FUNL2-1 2802 04712 4540 FUNCT4, GETC 2803 04713 4565 TSTALP 2804 04714 4554 ERR250, ERROR /NOT LETTER 2805 04715 7350 L3777 2806 04716 1026 TAD CHAR 2807 04717 4543 PUSHA /SAVE CHAR OF USER FUNCTION 2808 04720 5300 JMP FUNCT5 2809 /*SORTJ* ROUTINE 2810 04721 0000 XSORTJ, 0 2811 04722 7450 SNA 2812 04723 1026 TAD CHAR /USE CHAR IF AC IS 0 2813 04724 7041 CIA 2814 04725 3104 DCA T3 2815 04726 1721 TAD I XSORTJ 2816 04727 3012 DCA XREG3 /SET TO LIST 2817 04730 2321 ISZ XSORTJ 2818 04731 6211 CDF 10 2819 04732 1412 TAD I XREG3 2820 04733 7510 SPA 2821 04734 5347 JMP XSORT1 /END OF LIST 2822 04735 1104 TAD T3 2823 04736 7640 SZA CLA 2824 04737 5332 JMP .-5 /NO GO - LOOP 2825 04740 1012 TAD XREG3 2826 04741 6201 CDF 2827 04742 1721 TAD I XSORTJ 2828 04743 3321 DCA XSORTJ 2829 04744 6211 CDF 10 2830 04745 1721 TAD I XSORTJ /GET ADDRESS 2831 04746 3321 DCA XSORTJ 2832 04747 7300 XSORT1, CLL CLA 2833 04750 2321 ISZ XSORTJ 2834 04751 6201 CDF 2835 04752 5721 JMP I XSORTJ 2836 /*RTL6* ROUTINE 2837 04753 0000 XRTL6, 0 2838 04754 7106 CLL RTL 2839 04755 7006 RTL 2840 04756 7006 RTL 2841 04757 5753 JMP I XRTL6 2842 /END OF A FUNCTION 2843 04760 4770 JMS I LITS 2844 04761 5365 JMP .+4 2845 04762 4770 ENDFUN, JMS I LITS 2846 04763 4546 POPA 2847 04764 3031 DCA MODE 2848 04765 4771 JMS I LITS+1 2849 04766 0565 FLARG 2850 04767 5772 JMP I LITS+2 2851 04770 5000 LITS, PARTST 2852 04771 7143 FFPUT 2853 04772 2752 EVAR+4 2854 PAGE 2855 /PAREN TEST ROUTINE 2856 05000 0000 PARTST, 0 2857 05001 4546 POPA 2858 05002 3107 DCA LASTOP /SAVED BY *ECALL* 2859 05003 7344 L7776 2860 05004 1101 TAD SORTCN 2861 05005 7041 CIA 2862 05006 4546 POPA /CHECK MATCH 2863 05007 7640 SZA CLA 2864 05010 4554 ERR260, ERROR /NO MATCH 2865 05011 4540 GETC 2866 05012 5600 JMP I PARTST 2867 /NEW *SGN* FUNCTION 2868 05013 0000 SGN, 0 2869 05014 1072 TAD ACH 2870 05015 7450 SNA /NON ZERO? 2871 05016 5613 JMP I SGN /NO: ANSWER ALREADY IN FAC SO EXIT NOW 2872 05017 7710 SPA CLA /POSITIVE? 2873 05020 7001 IAC /NO: TURN SIGN BIT ON 2874 05021 7132 CLL CML RTR /TURN FIRST MANTISSA BIT ON 2875 05022 3072 DCA ACH /SET HIGH ORDER FAC 2876 05023 3073 DCA ACLO /CLEAR LOW ORDER FAC 2877 05024 7001 IAC 2878 05025 3071 DCA ACX /SET EXPONENT TO 1 2879 05026 5613 JMP I SGN /FAC=SGN(FAC0) 2880 2881 /NEW FUPARR ROUTINE 2882 /THIS ROUTINE IS WHAT DOES EXPONENTIALS (X^Y) IN EXPRESSIONS. 2883 /IF ABS(Y)<=16 AND FRACTION(Y)=0, THE POWER IS RAISED BY 2884 /REPEATED MULTIPLICATIONS OR DIVISION. 2885 /OTHERWISE, FAC=X^Y=EXP(LOG(X)*Y) 2886 05027 0000 FUPARR, FEXT /EXIT FROM THE @!?!#% INTERPRETER 2887 05030 1425 TAD I PT1 /GET BINARY EXPONENT OF POWER 2888 05031 7160 CLL CML CMA /LINK=1 AND AC=-AC-1 2889 05032 1120 TAD C7 2890 05033 7770 SPA SNA SZL CLA /IN RANGE 1<=AC<=5? 2891 05034 5272 JMP POWF+2 /NO: RAISE POWER BY LOGS 2892 05035 4641 JMS I FUPPUT /SAVE OLD FAC IN FTEMP1 2893 05036 5472 FTEMP1 2894 05037 1025 TAD PT1 /GET ADDRESS OF EXPONENT 2895 05040 4777 JMS I (FFGET /GET EXPONENT IN FAC 2896 05041 7143 FUPPUT, FFPUT /A HARMLESS POINTER 2897 05042 4776 JMS I (FRACT /NUM=FIX(FAC0); FAC=FRACTION(FAC0) 2898 05043 1072 TAD ACH 2899 05044 7640 SZA CLA /IS POWER INTEGRAL? 2900 05045 5270 JMP POWF /NO: RAISE POWER BY LOGS 2901 05046 4777 JMS I (FFGET /SET FAC=1 2902 05047 5500 ONE 2903 05050 1775 TAD I (NUM /GET POWER 2904 05051 7450 SNA /ZERO? 2905 05052 5277 JMP POWEXI /YES: ANSWER ALREADY IN FAC 2906 05053 7500 SMA 2907 05054 7041 CIA 2908 05055 3102 DCA T1 2909 05056 1775 TAD I (NUM 2910 05057 7710 SPA CLA /MULTIPLY OR DIVIDE? 2911 05060 1275 TAD FUPDIV /DIVIDE 2912 05061 1374 TAD (FFMPY 2913 05062 3103 DCA T2 /STORE ADDRESS OF APPROPRIATE ROUTINE 2914 05063 4503 JMS I T2 /MULTIPLY OR DIVIDE BY BASE 2915 05064 5472 FTEMP1 2916 05065 2102 ISZ T1 /DONE YET? 2917 05066 5263 JMP .-3 /NO 2918 05067 5277 JMP POWEXI 2919 05070 4777 POWF, JMS I (FFGET /GET THE BASE INTO THE FAC 2920 05071 5472 FTEMP1 2921 05072 4773 JMS I (LOG /HERE IS WHERE WE RAISE POWERS BY LOGS 2922 05073 1025 TAD PT1 2923 05074 4774 JMS I (FFMPY 2924 05075 0122 FUPDIV, FFDIV-FFMPY /A HARMLESS CONSTANT 2925 05076 4772 JMS I (EXPON /FAC=FAC0^PT1=EXP(LOG(FAC0)*PT1) 2926 05077 4407 POWEXI, FINT /ENTER INTERPRETER 2927 05100 0771 FJMP I (FLOP+1 /REENTER EXPRESSION EVALUATOR 2928 05101 7301 TAPE, L0001 2929 05102 3025 KKEY, DCA PT1 /SAVE CONSTANT FOR OUTPUT 2930 05103 4563 TSTCCR 2931 05104 4554 ERR003, ERROR /JUNK 2932 05105 4770 JMS I (RUN9 /DISMISS US NOW 2933 05106 1051 TAD TELSW 2934 05107 7640 SZA CLA 2935 05110 5305 JMP .-3 /STILL BUSY - WAIT 2936 05111 1025 TAD PT1 2937 05112 3034 DCA OUTPUT /SET OUTPUT 2938 05113 5767 JMP I (READY 2939 05114 4540 FUNC16, GETC 2940 05115 1026 TAD CHAR 2941 05116 1366 TAD (-75 /-EQUALS 2942 05117 7640 SZA CLA 2943 05120 4554 ERR210, ERROR 2944 05121 4544 PUSHJ 2945 05122 2611 EVAL-1 2946 05123 4575 TSTEND 2947 05124 5320 JMP .-4 2948 05125 4546 POPA 2949 05126 3062 DCA ERLINE 2950 05127 4546 POPA 2951 05130 3055 DCA LASTV 2952 05131 4546 POPA 2953 05132 3101 DCA SORTCN 2954 05133 4550 POPF 2955 05134 0017 TEXTP 2956 05135 5765 JMP I (ENDFUN 2957 05136 0000 XFLGET, 0 2958 05137 7440 SZA 2959 05140 5343 JMP XFLGT2 2960 05141 7340 L7777 2961 05142 1025 TAD PT1 2962 05143 3013 XFLGT2, DCA FLTXR 2963 05144 7340 L7777 2964 05145 1736 TAD I XFLGET 2965 05146 3014 DCA FLTXR2 2966 05147 7346 L7775 2967 05150 3104 DCA T3 2968 05151 4555 UDF 2969 05152 1413 TAD I FLTXR /MOVE FLOATING DATUM DOWN 2970 05153 6201 CDF 2971 05154 3414 DCA I FLTXR2 2972 05155 2104 ISZ T3 2973 05156 5351 JMP .-5 2974 05157 2336 ISZ XFLGET 2975 05160 5736 JMP I XFLGET 2976 2977 05165 4762 PAGE 05166 7703 05167 0440 05170 2543 05171 2712 05172 5533 05173 5665 05174 6401 05175 5526 05176 5503 05177 7127 2978 05200 1026 EVALQ, TAD CHAR 2979 05201 1377 TAD (200-"" 2980 05202 7640 SZA CLA 2981 05203 4554 ERRBEX, ERROR 2982 05204 1376 TAD (ENDFUN+3 2983 05205 4543 PUSHA 2984 05206 4545 QINP, PUSHF 2985 05207 6062 FLZERO-1 2986 05210 1015 TAD PDLXR 2987 05211 3016 DCA AXIN 2988 05212 3024 DCA XCTIN 2989 05213 3023 DCA ADD 2990 05214 2032 ISZ SPACSW 2991 05215 7340 L7777 2992 05216 3031 DCA MODE 2993 05217 7327 L0006 2994 05220 7040 QINP6, CMA 2995 05221 3102 DCA T1 2996 05222 1026 QINP1, TAD CHAR 2997 05223 1377 TAD (200-"" 2998 05224 7640 SZA CLA 2999 05225 5234 JMP QINP2 3000 05226 1031 TAD MODE 3001 05227 3032 DCA SPACSW 3002 05230 4540 GETC 3003 05231 2031 ISZ MODE 3004 05232 5243 JMP QINPT 3005 05233 5222 JMP QINP1 3006 05234 4564 QINP2, TSTCOM 3007 05235 5241 JMP QINP3 3008 05236 1031 TAD MODE 3009 05237 7640 SZA CLA 3010 05240 5243 JMP QINPT 3011 05241 4563 QINP3, TSTCCR 3012 05242 5261 JMP QINP4 3013 05243 1023 QINPT, TAD ADD 3014 05244 2024 ISZ XCTIN 3015 05245 1126 TAD C7700 3016 05246 1134 TAD C77 3017 05247 4555 UDF 3018 05250 2102 ISZ T1 3019 05251 3416 DCA I AXIN 3020 05252 6201 CDF 3021 05253 7340 L7777 3022 05254 3031 DCA MODE 3023 05255 3032 DCA SPACSW 3024 05256 4550 POPF 3025 05257 0071 ACX 3026 05260 5547 POPJ 3027 05261 2102 QINP4, ISZ T1 3028 05262 5265 JMP QINP5 3029 05263 4540 GETC 3030 05264 5220 JMP QINP6 3031 05265 4500 QINP5, JMS I CPACK 3032 05266 4540 GETC 3033 05267 5222 JMP QINP1 3034 3035 05270 4544 LINPUT, PUSHJ 3036 05271 4400 GETVAR 3037 05272 7650 SNA CLA 3038 05273 4575 TSTEND 3039 05274 4554 ERR280, ERROR /SYNTAX, I GUESS, IN LINPUT 3040 05275 4545 PUSHF 3041 05276 0017 TEXTP 3042 05277 1026 TAD CHAR 3043 05300 4543 PUSHA 3044 05301 1023 TAD ADD 3045 05302 7004 RAL 3046 05303 7130 STL RAR 3047 05304 4543 PUSHA 3048 05305 4544 PUSHJ 3049 05306 1146 PAKLIN 3050 05307 1016 TAD AXIN 3051 05310 7041 CIA 3052 05311 1060 TAD COMBUF 3053 05312 3102 DCA T1 3054 05313 1102 TAD T1 3055 05314 7124 STL RAL 3056 05315 1024 TAD XCTIN 3057 05316 7040 CMA 3058 05317 4775 JMS I (FFLOAT 3059 05320 4546 POPA 3060 05321 3023 DCA ADD 3061 05322 3024 DCA SUBS 3062 05323 4544 PUSHJ 3063 05324 4440 LOOKUP 3064 05325 4552 FLPUT 3065 05326 0071 ACX 3066 05327 1060 TAD COMBUF 3067 05330 3016 DCA AXIN 3068 05331 2024 LNP1, ISZ SUBS 3069 05332 4544 PUSHJ 3070 05333 4440 LOOKUP 3071 05334 7346 L7775 3072 05335 3103 DCA T2 3073 05336 4555 UDF 3074 05337 1416 LNP3, TAD I AXIN 3075 05340 3425 DCA I PT1 3076 05341 2102 ISZ T1 3077 05342 5350 JMP LNP2 3078 05343 4546 POPA 3079 05344 3026 DCA CHAR 3080 05345 4550 POPF 3081 05346 0017 TEXTP 3082 05347 5535 JMP I CCONT 3083 05350 2025 LNP2, ISZ PT1 3084 05351 2103 ISZ T2 3085 05352 5337 JMP LNP3 3086 05353 6201 CDF 3087 05354 5331 JMP LNP1 3088 3089 /RANDOM NUMBER GENERATOR 3090 /NOTE: THIS "RANDOM NUMBER GENERATOR" WAS WRITTEN 3091 /WITHOUT AN ALGORITHM, SO IT IS NOTHING VERY 3092 /SPECIAL. IF ANYONE FEELS LIKE CHANGING IT, BE MY GUEST. 3093 05355 0000 RND, 0 3094 05356 1064 TAD FRNDX+1 3095 05357 7104 CLL RAL 3096 05360 1065 TAD FRNDX+2 3097 05361 3071 DCA ACX 3098 05362 1064 TAD FRNDX+1 3099 05363 7004 RAL 3100 05364 1064 TAD FRNDX+1 3101 05365 1065 TAD FRNDX+2 3102 05366 3073 DCA ACLO 3103 05367 1063 TAD FRNDX 3104 05370 7004 RAL 3105 05371 1063 TAD FRNDX 3106 05372 5774 JMP I (RND1 /JUMP TO REST OF FUNCTION 3107 05373 5755 RND2, JMP I RND /RETURN HERE TO EXIT 3108 05374 4074 PAGE 05375 6164 05376 4765 05377 7736 3109 3110 /23-BIT EXTENDED FUNCTIONS 3111 3112 3113 /******SINE****** 3114 3115 05400 0000 FSIN, 0 3116 05401 4316 JMS NHNDLE /IF X<0,NEGATE X AND SET NFLAG 3117 05402 4662 JMS I FMPYL /X*2/PI 3118 05403 5575 TOVPI 3119 05404 4303 JMS FRACT /SAVE X IN TEMP1,THE INTEGER PART OF X IN NUM,AND GET FRACTIONAL PART IN FAC 3120 05405 7325 L0003 /GET INTEGER PART OF (2/PI)*X 3121 05406 0326 AND NUM /ISOLATE BITS 10,11 3122 05407 1212 TAD JMPI 3123 05410 3211 DCA .+1 /MAKE JUMP TO ARGUMENT REDUCING ROUTINE 3124 05411 5211 JMP . /AND ADJUST ARG ACCORDING TO QUADRANT OF X 3125 05412 5613 JMPI, JMP I .+1 3126 05413 5425 POLYSN /X IN QUAD1,SIN(X)=SIN(X) 3127 05414 5417 QUAD2 /X IN QUAD2,SIN(X)=SIN(1-X) 3128 05415 5421 QUAD3 /X IN QUAD3,SIN(X)=SIN(-X) 3129 05416 5423 QUAD4 /X IN QUAD4,SIN(X)=SIN(X-1) 3130 3131 05417 4666 QUAD2, JMS I FSUBL /X-1 3132 05420 5500 ONE 3133 05421 4665 QUAD3, JMS I FNEGL /1-X OR -X 3134 05422 5225 JMP POLYSN 3135 05423 4666 QUAD4, JMS I FSUBL /X-1 3136 05424 5500 ONE 3137 05425 4663 POLYSN, JMS I FPUTL /SAVE X 3138 05426 5472 FTEMP1 3139 05427 4662 JMS I FMPYL /U=X**2 3140 05430 0071 ACX 3141 05431 4663 JMS I FPUTL /SAVE U 3142 05432 5475 FTEMP2 3143 05433 4662 JMS I FMPYL /A7*U 3144 05434 6002 SINA7 3145 05435 4661 JMS I FADDL /A5+A7*U 3146 05436 5777 SINA5 3147 05437 4662 JMS I FMPYL /A5*U+A7*U**2 3148 05440 5475 FTEMP2 3149 05441 4661 JMS I FADDL /A3+A5(U)+A7(U**2) 3150 05442 5774 SINA3 3151 05443 4662 JMS I FMPYL /A3(U)+A5(U**2)+A7(U**3) 3152 05444 5475 FTEMP2 3153 05445 4661 JMS I FADDL /A1+A3(U)+A5(U**2)+A7(U**3) 3154 05446 5771 SINA1 3155 05447 4662 JMS I FMPYL /A1(X)+A3(X**3)+A5(X**5)+A7(X**7) 3156 05450 5472 FTEMP1 3157 05451 4326 JMS NCHK /IF NFLAG IS SET,SET SIN(X)=-SIN(X) 3158 05452 5600 JMP I FSIN /FAC=SIN(X) 3159 3160 3161 /******COSINE****** 3162 /USES SIN ROUTINE TO CALCULATE COS(X) 3163 3164 05453 0000 COS, 0 3165 05454 4661 JMS I FADDL /COS(X)=SIN(PI/2+X) 3166 05455 6005 PIOV2 3167 05456 4200 JMS FSIN 3168 05457 5653 JMP I COS /RETURN 3169 3170 05460 7127 FGETL, FFGET 3171 05461 6600 FADDL, FFADD 3172 05462 6401 FMPYL, FFMPY 3173 05463 7143 FPUTL, FFPUT 3174 05464 6523 FDIVL, FFDIV 3175 05465 2556 FNEGL, FFNEG 3176 05466 6734 FSUBL, FFSUB 3177 05467 6133 FIXL, FFIX 3178 05470 6164 FLOATL, FFLOAT 3179 05471 6212 FDIV1L, FFDIV1 3180 05472 0000 FTEMP1, 0 3181 05473 0000 0 3182 05474 0000 0 3183 05475 0000 FTEMP2, 0 /TWO TEMP STORAGE BLOCKS FOR FUNCTIONS 3184 05476 0000 0 3185 05477 0000 0 3186 05500 0001 ONE, 1 /1 3187 05501 2000 2000 3188 05502 0000 0 3189 3190 /ROUTINE TO SEPERATE THE INTEGER AND FRACTIONAL PARTS OF FAC 3191 /ORIGINAL FAC IS SAVED IN FTEMP1,THE INTEGER PORTION OF FAC IS 3192 /SAVED AT NUM,AND THE FRACTIONAL FORTION OF THE FAC IS LEFT IN THE FAC 3193 3194 05503 0000 FRACT, 0 3195 05504 4663 JMS I FPUTL /SAVE X 3196 05505 0074 OPX 3197 05506 4667 JMS I FIXL /INTEGER PORTION OF X 3198 05507 3326 DCA NUM /SAVE FIXED PORTION OF X 3199 05510 1326 TAD NUM /GET IT BACK 3200 05511 4670 JMS I FLOATL /FAC=FLOAT(FIX(X)) 3201 05512 4665 JMS I FNEGL /FAC=X-INT(X)=FRACTION (X) 3202 05513 4661 JMS I FADDL 3203 05514 0074 OPX 3204 05515 5703 JMP I FRACT /RETURN 3205 3206 /ROUTINE TO CHECK IF FAC<0; IF IT IS,FAC IS NEGATED AND NFLAG IS 3207 /SET TO 1 3208 3209 05516 0000 NHNDLE, 0 3210 05517 1072 TAD HORD /FETCH HIGH ORDER MANTISSA 3211 05520 7700 SMA CLA /IS IT <0? 3212 05521 5324 JMP NFLGST /NO-CLEAR NFLAG 3213 05522 4665 JMS I FNEGL /YES-NEGATE FAC 3214 05523 7001 IAC /AND SET NFLAG 3215 05524 3333 NFLGST, DCA NFLAG 3216 05525 5716 JMP I NHNDLE 3217 3218 /ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0 3219 3220 05526 0000 NCHK, 0 /LOC ALSO USED FOR TEMP STORAGE 3221 05527 1333 TAD NFLAG 3222 05530 7640 SZA CLA /IS NFLAG=0? 3223 05531 4665 JMS I FNEGL /NO-NEGATE FAC 3224 05532 5726 JMP I NCHK /YES-RETURN 3225 3226 NUM=NCHK 3227 3228 /******EXPONENTIAL****** 3229 3230 05533 0000 EXPON, 0 /LOC USED FOR TEMP STORAGE BY SIN,ARCTAN 3231 05534 4662 JMS I FMPYL /Y=XLOG2(E) 3232 05535 6010 LOG2E 3233 05536 4303 JMS FRACT /GET FRACTIONAL PART OF Y 3234 05537 4662 JMS I FMPYL /(FRACTION(Y))*(LN2/2) 3235 05540 6013 LN2OV2 3236 05541 4663 JMS I FPUTL /SAVE Y 3237 05542 5472 FTEMP1 3238 05543 4662 JMS I FMPYL /Y**2 3239 05544 0071 ACX 3240 05545 4661 JMS I FADDL /B1+Y**2 3241 05546 6016 EXPB1 3242 05547 4671 JMS I FDIV1L /A1/(B1+Y**2) 3243 05550 6021 EXPA1 3244 05551 4661 JMS I FADDL /A0+A1/(B1+Y**2) 3245 05552 6024 EXPA0 3246 05553 4666 JMS I FSUBL /A0-Y+A1/(B1+Y**2) 3247 05554 5472 FTEMP1 3248 05555 4663 JMS I FPUTL /SAVE 3249 05556 5475 FTEMP2 3250 05557 4660 JMS I FGETL /GET Y 3251 05560 5472 FTEMP1 3252 05561 2071 ISZ EXP /MULT. BY 2=2Y 3253 05562 7000 NOP 3254 05563 4664 JMS I FDIVL /2Y/(A0-Y+A1/(B1+Y**2)) 3255 05564 5475 FTEMP2 3256 05565 4661 JMS I FADDL /1+2Y/(AO-Y+A1/(B1+Y**2)) 3257 05566 5500 ONE 3258 05567 4662 JMS I FMPYL /[1+2Y/(A0-Y+A1/(B1+Y**2))]**2=EXP(Y) 3259 05570 0071 ACX 3260 05571 1326 TAD NUM 3261 05572 1071 TAD EXP /EXP(X)=(2**N)(EXPY) 3262 05573 3071 DCA EXP 3263 05574 5733 JMP I EXPON /FAC=EXPON(X) 3264 3265 NFLAG=EXPON 3266 3267 /CONSTANT THAT WOULDN'T FIT ELSEWHERE 3268 05575 0000 TOVPI, 0 /.6366198 3269 05576 2427 2427 3270 05577 6302 6302 3271 PAGE 3272 3273 /******ARC TANGENT****** 3274 3275 05600 0000 ATN, 0 3276 05601 4663 JMS I NHNDLL /IF X<0,SET NFLAG AND NEGATE 3277 05602 4760 JMS I FPUTM /SAVE X 3278 05603 5472 FTEMP1 3279 05604 4765 JMS I FSUBM /X-1 3280 05605 5500 ONE 3281 05606 1072 TAD HORD /GET HI MANTISSA 3282 05607 7710 SPA CLA /WAS X>1? 3283 05610 5220 JMP ARGPOL /NO-CLEAR GT1FLG 3284 05611 4770 JMS I FGETM /YES-ATAN(X)=PI/2-ATAN(1/X) 3285 05612 5500 ONE 3286 05613 4763 JMS I FDIVM /1/X 3287 05614 5472 FTEMP1 3288 05615 4760 JMS I FPUTM 3289 05616 5472 FTEMP1 3290 05617 7001 IAC /SET GT1FLG 3291 05620 3265 ARGPOL, DCA GT1FLG 3292 05621 4770 JMS I FGETM /GET X OR 1/X 3293 05622 5472 FTEMP1 3294 05623 4761 JMS I FMPYM /Y**2 3295 05624 0071 ACX 3296 05625 4760 JMS I FPUTM /SAVE 3297 05626 5475 FTEMP2 3298 05627 4762 JMS I FADDM /Y**2+B3 3299 05630 6051 ATANB3 3300 05631 4764 JMS I FDIV1M /A3/(Y**2+B3) 3301 05632 6046 ATANA3 3302 05633 4762 JMS I FADDM /B2+A3/(Y**2+B3) 3303 05634 6043 ATANB2 3304 05635 4762 JMS I FADDM /Y**2+B2+A3/(Y**2+B3) 3305 05636 5475 FTEMP2 3306 05637 4764 JMS I FDIV1M /A2/(Y**2+B2+A3/(Y**2+B3)) 3307 05640 6040 ATANA2 3308 05641 4762 JMS I FADDM /B1+A2/(Y**2+B2+A3/(Y**2+B3)) 3309 05642 6035 ATANB1 3310 05643 4762 JMS I FADDM /Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)) 3311 05644 5475 FTEMP2 3312 05645 4764 JMS I FDIV1M /A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) 3313 05646 6032 ATANA1 3314 05647 4762 JMS I FADDM /B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) 3315 05650 6027 ATANB0 3316 05651 4761 JMS I FMPYM /ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))) 3317 05652 5472 FTEMP1 3318 05653 1265 TAD GT1FLG /WAS X>1? 3319 05654 7650 SNA CLA 3320 05655 5261 JMP NGT /NO-TEST IF X<0? 3321 05656 4766 JMS I FNEGM /ATAN(X)=PI/2-ATAN(1/X) 3322 05657 4762 JMS I FADDM 3323 05660 6005 PIOV2 3324 05661 4664 NGT, JMS I NCHKL /IF NFLAG SET,NEGATE FAC 3325 05662 5600 JMP I ATN /FAC=ATAN(X) 3326 05663 5516 NHNDLL, NHNDLE 3327 05664 5526 NCHKL, NCHK 3328 3329 /******NAPERIAN LOGARITHM****** 3330 3331 GTFLG=ATN 3332 3333 05665 0000 LOG, 0 3334 05666 1072 TAD HORD 3335 05667 7550 SPA SNA /X<0 OR X=0? 3336 05670 4554 ERR010, ERROR /LOG OF A NEGATIVE NUMBER 3337 05671 7106 CLL RTL 3338 05672 7450 SNA /NO-HORD=2000? 3339 05673 1071 TAD EXP /YES-EXP=1? 3340 05674 7041 CMA IAC 3341 05675 7001 IAC 3342 05676 7450 SNA 3343 05677 1073 TAD LORD /YES-LORD=0? 3344 05700 7640 SZA CLA 3345 05701 5306 JMP POLYNL /NO-ARG IS LEGAL AND NOT 1 3346 05702 3071 DCA EXP 3347 05703 3073 DCA LORD 3348 05704 3072 LTRPRT, DCA HORD 3349 05705 5665 JMP I LOG /YES-LOG(1)=0 3350 05706 1071 POLYNL, TAD EXP 3351 05707 3200 DCA GTFLG /SAVE EXPONENT FOR LATER 3352 05710 3071 DCA EXP /ISOLATE MANTISSA IN FAC 3353 05711 4760 JMS I FPUTM /SAVE F 3354 05712 5472 FTEMP1 3355 05713 4762 JMS I FADDM /F+SQR(.5) 3356 05714 6054 SQRP5 3357 05715 4760 JMS I FPUTM /SAVE 3358 05716 5475 FTEMP2 3359 05717 4770 JMS I FGETM 3360 05720 5472 FTEMP1 3361 05721 4765 JMS I FSUBM /F-SQR(.5) 3362 05722 6054 SQRP5 3363 05723 4763 JMS I FDIVM /Z=F+SQR(.5)/F-SQR(.5) 3364 05724 5475 FTEMP2 3365 05725 4760 JMS I FPUTM 3366 05726 5472 FTEMP1 3367 05727 4761 JMS I FMPYM /Z**2 3368 05730 0071 ACX 3369 05731 4760 JMS I FPUTM 3370 05732 5475 FTEMP2 3371 05733 4761 JMS I FMPYM /C5(Z**2) 3372 05734 6065 LOGC5 3373 05735 4762 JMS I FADDM /C3+C5(Z**2) 3374 05736 6174 LOGC3 3375 05737 4761 JMS I FMPYM /C3(Z**2)+C5(Z**4) 3376 05740 5475 FTEMP2 3377 05741 4762 JMS I FADDM /C1+C3(Z**2)+C5(Z**4) 3378 05742 6376 LOGC1 3379 05743 4761 JMS I FMPYM /C1(Z)+C3(Z**3)+C5(Z**5) 3380 05744 5472 FTEMP1 3381 05745 4765 JMS I FSUBM /C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F) 3382 05746 6057 ONEHAF 3383 05747 4760 JMS I FPUTM /SAVE LOG2(F) 3384 05750 5475 FTEMP2 3385 05751 1200 TAD GTFLG /I 3386 05752 4767 JMS I FLOATM 3387 05753 4762 JMS I FADDM /I+LOG2(F) 3388 05754 5475 FTEMP2 3389 05755 4761 JMS I FMPYM /[I+LOG2(F)]*LOGE(2)=LOGE(X) 3390 05756 6207 LN2 3391 05757 5665 JMP I LOG /FAC=LN(X) 3392 3393 GT1FLG=LOG 3394 05760 7143 FPUTM, FFPUT 3395 05761 6401 FMPYM, FFMPY 3396 05762 6600 FADDM, FFADD 3397 05763 6523 FDIVM, FFDIV 3398 05764 6212 FDIV1M, FFDIV1 3399 05765 6734 FSUBM, FFSUB 3400 05766 2556 FNEGM, FFNEG 3401 05767 6164 FLOATM, FFLOAT 3402 05770 7127 FGETM, FFGET 3403 3404 /CONSTANTS USED BY VARIOUS FUNCTIONS 3405 3406 05771 0001 SINA1, 1 /1.5707949 3407 05772 3110 3110 3408 05773 3747 3747 3409 05774 0000 SINA3, 0 /-.64592098 3410 05775 5325 5325 3411 05776 1167 1167 3412 05777 7775 SINA5, 7775 /.07948766 3413 06000 2426 2426 3414 06001 2466 2466 3415 06002 7771 SINA7, 7771 /-.004362476 3416 06003 5610 5610 3417 06004 3164 3164 3418 06005 0001 PIOV2, 1 /1.5707963 3419 06006 3110 3110 3420 06007 3756 3756 3421 06010 0001 LOG2E, 1 /1.442695 3422 06011 2705 2705 3423 06012 2434 2434 3424 06013 7777 LN2OV2, 7777 /.34657359 3425 06014 2613 2613 3426 06015 4415 4415 3427 06016 0006 EXPB1, 6 /60.090191 3428 06017 3602 3602 3429 06020 7054 7054 3430 06021 0012 EXPA1, 12 /-601.80427 3431 06022 5514 5514 3432 06023 3104 3104 3433 06024 0004 EXPA0, 4 /12.015017 3434 06025 3001 3001 3435 06026 7301 7301 3436 06027 7776 ATANB0, 7776 /.17465544 3437 06030 2626 2626 3438 06031 6157 6157 3439 06032 0002 ATANA1, 2 /3.7092563 3440 06033 3553 3553 3441 06034 1071 1071 3442 06035 0003 ATANB1, 3 /6.762139 3443 06036 3303 3303 3444 06037 0670 670 3445 06040 0003 ATANA2, 3 /-7.10676 3446 06041 4344 4344 3447 06042 5267 5267 3448 06043 0002 ATANB2, 2 /3.3163354 3449 06044 3241 3241 3450 06045 7554 7554 3451 06046 7777 ATANA3, 7777 /-.26476862 3452 06047 5703 5703 3453 06050 4040 4040 3454 06051 0001 ATANB3, 1 /1.44863154 3455 06052 2713 2713 3456 06053 3140 3140 3457 06054 0000 SQRP5, 0 /.7071068 3458 06055 2650 2650 3459 06056 1170 1170 3460 06057 0000 ONEHAF, 0 /.5 3461 06060 2000 2000 3462 06061 0000 0 3463 06062 7777 7777 /"" (NULL STRING) 3464 06063 0000 FLZERO, 0 /0.0 3465 06064 0000 0 3466 06065 0000 LOGC5, 0 /.59897865 3467 06066 2312 2312 3468 06067 5525 5525 3469 3470 /******FLOATING POINT INTERPRETER****** 3471 06070 0000 FPT, 0 3472 06071 1670 FPNEXT, TAD I FPT /GET NEXT FLTG. PT. INSTR. 3473 06072 3074 DCA OPX /STORE IN A TEMPORARY 3474 06073 1074 TAD OPX /GET IT BACK AND PICK OFF 3475 06074 0121 AND C177 /THE ADDRESS 3476 06075 3075 DCA OPH /STORE THAT AWAY 3477 06076 1074 TAD OPX /PICK OFF THE PAGE BIT 3478 06077 0325 AND K200 /AND MAKE A 7600 IF CURRENT PAGE 3479 06100 7041 CMA IAC /OR 0 IF PAGE 0 3480 06101 0270 AND FPT /THIS SETS UP HI ORDER 5 BITS OF ADDR 3481 06102 2270 ISZ FPT /INCREMENT FLTG. P.C. 3482 06103 1075 TAD OPH /ADD IN LOW ORDER 7 BITS OF ADDR 3483 06104 3075 DCA OPH /THIS IS FINAL ADDR. UNLESS INDIRECT 3484 06105 1074 TAD OPX /NOE DECODE THE OP CODE 3485 06106 7106 CLL RTL 3486 06107 7006 RTL 3487 06110 0120 AND C7 /PICK OFF THE OP CODE 3488 06111 1324 TAD CTABLE /CALCULATE SUBROUTINE ADDRESS 3489 06112 3074 DCA OPX 3490 06113 1474 TAD I OPX 3491 06114 3074 DCA OPX /AND STORE IN A TEMPORARY 3492 06115 7420 SNL /LINK HOLDS INDIRECT BIT 3493 06116 1075 TAD OPH /DIRECT ADDRESSING 3494 06117 7430 SZL 3495 06120 1475 TAD I OPH /INDIRECT ADDRESSING 3496 06121 4474 JMS I OPX /DO OPERATION 3497 06122 5271 JMP FPNEXT /ONLY FFNOR RETURNS TO HERE 3498 06123 5271 JMP FPNEXT /GO DO NEXT INSTRUCTION 3499 06124 6177 CTABLE, TABLE 3500 06125 0200 K200, 200 3501 3502 06126 0000 FFJMP, 0 /FLOATING JUMP ROUTINE 3503 06127 7450 SNA /EXIT INTERPRETER? 3504 06130 5670 JMP I FPT /YES-EXIT 3505 06131 3270 DCA FPT /CHANGE FLTG. P.C. 3506 06132 5271 JMP FPNEXT /EXECUTE THAT INSTRUCTION 3507 3508 /******FIX****** 3509 /ROUTINE TO FIX ANY FLOATING NUMBER IN FAC BETWEEN -2047 AND +2047 TO 3510 /A TWELVE BIT INTEGER AND LEAVE RESULT IN AC 3511 3512 06133 0000 FFIX, 0 3513 06134 7200 CLA 3514 06135 1071 TAD EXP /FETCH EXPONENT 3515 06136 7540 SZA SMA /IS NUMBER <1? 3516 06137 5342 JMP .+3 /NO-CONTINUE ON 3517 06140 7200 FTRPRT, CLA 3518 06141 5733 JMP I FFIX /YES-EXIT WITH 0 IN AC 3519 06142 1362 TAD M13 /SET BINARY POINT AT 11 3520 06143 7450 SNA /PLACES TO RIGHT OF CURRENT POINT? 3521 06144 5360 JMP FIXDNE /NO-NUMBER IS ALREADY FIXED THEN 3522 06145 7500 SMA /YES-IS NUMBER TOO LARGE TO FIX? 3523 06146 4554 ERR040, ERROR /YES-OVERFLOW ERROR 3524 06147 3071 DCA EXP /NO-SET SCALE COUNT 3525 06150 7100 FIXLP, CLL /0 IN LINK 3526 06151 1072 TAD HORD /GET HIGH MANTISSA 3527 06152 7510 SPA /IS IT <0? 3528 06153 7020 CML /YES-PUT A 1 IN LINK 3529 06154 7010 RAR /SCALE RIGHT 3530 06155 3072 DCA HORD /SAVE 3531 06156 2071 ISZ EXP /DONE YET? 3532 06157 5350 JMP FIXLP /NO 3533 06160 1072 FIXDNE, TAD HORD /YES-ANSWER IN AC 3534 06161 5733 JMP I FFIX /RETURN 3535 3536 06162 7765 M13, -13 /-11 DECIMAL 3537 06163 0013 C13, 13 /11 DECIMAL 3538 3539 /******FLOAT****** 3540 /ROUTINE TO FLOAT ANY INTEGER IN AC INTO FAC 3541 3542 06164 0000 FFLOAT, 0 3543 06165 3072 DCA HORD /SAVE # TO BE FLOATED 3544 06166 3073 DCA LORD /CLEAR LOW MANTISSA 3545 06167 1363 TAD C13 /11(10) INTO EXPONENT 3546 06170 3071 DCA EXP 3547 06171 4773 JMS I FNORL /NORMALIZE 3548 06172 5764 JMP I FFLOAT /RETURN 3549 06173 7076 FNORL, FFNOR /LINK TO NORMALIZE ROUTINE 3550 06174 0000 LOGC3, 0 /.9614706 3551 06175 3661 3661 3552 06176 0566 566 3553 3554 /******FLOATING POINT INTERPRETER DISPATCH TABLE****** 3555 06177 6126 TABLE, FFJMP /0 3556 06200 6600 FFADD /1 3557 06201 6734 FFSUB /2 3558 06202 6401 FFMPY /3 3559 06203 6523 FFDIV /4 3560 06204 7127 FFGET /5 3561 06205 7143 FFPUT /6 3562 06206 7076 FFNOR /7 3563 3564 06207 0000 LN2, 0 /.6931472 3565 06210 2613 2613 3566 06211 4415 4415 3567 3568 / 3569 /INVERSE FLOATING DIVIDE 3570 /FSWITCH=1 3571 /THIS IS OP/FAC 3572 / 3573 06212 0000 FFDIV1, 0 3574 06213 7450 SNA /WHICH MODE OF CALL? 3575 06214 1612 TAD I FFDIV1 /CALLED BY USER-GET ADDR. 3576 06215 4643 JMS I ARGETL /PICK UP OPERAND 3577 06216 1073 TAD ACLO /SWAP THE FAC AND OPERAND 3578 06217 3076 DCA OPL /THERE IS A POINTER TO OPL 3579 06220 1470 TAD I AC2 /IN AC2 LEFT FROM ARGET SUBR. 3580 06221 3073 DCA ACLO 3581 06222 1071 TAD ACX /MIGHT AS WELL SUBTRACT THE 3582 06223 7141 CLL CMA IAC /EXPONENTS HERE (SAVES A WORD) 3583 06224 1074 TAD OPX /THEN ZERO OPX SO WILL NOT 3584 06225 3071 DCA ACX /MESS UP WHEN ITS DONE AGAIN 3585 06226 3074 DCA OPX /LATER (SEE DIV. ROUTINE) 3586 06227 1072 TAD ACH 3587 06230 3070 DCA AC2 /NOW SWAP HIGH ORDER MANTISSAS 3588 06231 1075 TAD OPH 3589 06232 3072 DCA ACH 3590 06233 1070 TAD AC2 3591 06234 3075 DCA OPH 3592 06235 1212 TAD FFDIV1 /NOW KLUDGE UP SUBROUTINE LINKAGE 3593 06236 3645 DCA I FFDP 3594 06237 1246 TAD KFD1 3595 06240 3644 DCA I MDSETP 3596 06241 5642 JMP I MD1P /GO SET UP AND DIVIDE 3597 3598 06242 7032 MD1P, MD1 3599 06243 7062 ARGETL, ARGET 3600 06244 7030 MDSETP, MDSET 3601 06245 6523 FFDP, FFDIV 3602 06246 6527 KFD1, FFD1 3603 AN1=T1 3604 AN2=FFDIV1 3605 3606 /FLOATING SQUARE ROOT 3607 /USES A HARDWARE TYPE ALGORITHM FOR BINARY SQUARE ROOTS 3608 /REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES-P 409 3609 / 3610 06247 0000 FROOT, 0 3611 06250 7332 CLA CLL CML RTR /SET RESULT TO 2000;0000 3612 06251 3102 DCA AN1 3613 06252 3212 DCA AN2 3614 06253 1375 TAD KM22 /SET COUNTER FOR DEVELOPING 22 BITS OF ERESULT 3615 06254 3070 DCA AC2 /ALREADY HAVE 1 3616 06255 1072 TAD ACH 3617 06256 7450 SNA 3618 06257 5647 JMP I FROOT /ZERO FAC-NORMALIZED!-RETN. SAME 3619 06260 7710 SPA CLA 3620 06261 4554 ERR020, ERROR /ATTEMPT TO TAKE SQUARE ROOT OF A NEGATIVE NUMBER 3621 06262 1071 TAD ACX /GET EXPONENT OF FAC 3622 06263 7510 SPA /IF NEGATIVE-MUST PROPAGATE SIGN 3623 06264 7020 CML 3624 06265 7010 RAR /DIVIDE EXP. BY 2 3625 06266 3071 DCA ACX /STORE IT BACK 3626 06267 7430 SZL /INCREMENT EXP. IF ORIGINAL EXP 3627 06270 2071 ISZ ACX /WAS ODD 3628 06271 7000 NOP 3629 06272 7420 SNL /DO A PRE-SHIFT FOR EVEN EXPONENTS 3630 06273 4774 JMS I AL1K /SO FIRST BIT PAIR IS 10 NOT 01 3631 06274 7344 CLA CLL CMA RAL /SET COUNTER FOR DETECTING A 3632 06275 3373 DCA ZCNT /ZERO REMAINDER 3633 06276 7332 CLA CLL CML RTR /SET UP POSITION OF TRIAL BIT 3634 06277 7012 RTR /FOR FIRST PASS THRU LOOP 3635 06300 3075 DCA OPH 3636 06301 3076 DCA OPL 3637 06302 1372 TAD K6000 /GET A FAST FIRST BIT-WE KNOW 3638 06303 1072 TAD ACH /THIS WILL WORK SINCE # IS NORMALIZED 3639 06304 3072 DCA ACH /IF # IS A POWER OF TWO, AND A PERFECT 3640 06305 1072 TAD ACH /SQUARE-WE ARE DONE HERE! 3641 06306 7450 SNA /WELL IS IT? 3642 06307 1073 TAD ACLO /COULD BE-CHECK LOW ORDER 3643 06310 7650 SNA CLA 3644 06311 5365 JMP DONE /WHOOPPEE-WE WIN BIG. 3645 06312 5322 JMP LOP01 /NOPE-LOOP DON'T SHIFT FIRST TIME 3646 06313 1075 SLOOP, TAD OPH /SHIFT TRIAL BIT 1 PLACE 3647 06314 7110 CLL RAR /TO THE RIGHT 3648 06315 3075 DCA OPH /AND STORE BACK 3649 06316 1076 TAD OPL 3650 06317 7010 RAR 3651 06320 3076 DCA OPL 3652 06321 4774 JMS I AL1K /SHIFT FAC LEFT 1 PLACE 3653 06322 1076 LOP01, TAD OPL /ADD TRIAL BIT TO`ANSWER 3654 06323 1212 TAD AN2 /SO FAR 3655 06324 7141 CLL CMA IAC /NEGATE IT 3656 06325 1073 TAD ACLO /AND ADD TO FAC (REMAINDER SO FAR) 3657 06326 7450 SNA /IS RESULT ZERO? 3658 06327 2373 ISZ ZCNT /YES-INCREMENT COUNTER 3659 06330 3066 DCA TM /STORE RESULT IN TEMPORARY 3660 3661 06331 7024 CML RAL /ADD CARRY TO HIGH ORDER FOR SUBTRACT 3662 06332 1075 TAD OPH /ADD TRIAL BIT 3663 06333 1102 TAD AN1 /ADD RESULT SO FAR (HI ORDER) 3664 06334 7141 CLL CMA IAC /AND SUBTRACT FROM HI ORDER FAC 3665 06335 1072 TAD ACH 3666 06336 7420 SNL /RESULT NEGATIVE? 3667 06337 5361 JMP GON /YES-NEXT RESULT BIT IS 0 3668 06340 7440 SZA /NO-IS HI ORDER RESULT=0? 3669 06341 5346 JMP LOP02 /NO-GO ON 3670 06342 2373 ISZ ZCNT /YES-WAS LOW ORDER =0? 3671 06343 5346 JMP .+3 /NO-GO ON 3672 06344 7040 CMA /YES-REM.=0-SET COUNTER SO 3673 06345 3070 DCA AC2 /LOOKS LIKE WE'RE DONE 3674 06346 3072 LOP02, DCA ACH /STORE HIGH ORDER REM. IN FAC 3675 06347 1066 TAD TM /STORE LO ORDER REM. IN FAC 3676 06350 3073 DCA ACLO 3677 06351 1076 TAD OPL /TRIAL BIT SHIFTED LEFT 1 IS 3678 06352 7104 CLL RAL /RESULT BIT-ADD IT TO ROOT DEVELOPED 3679 06353 1212 TAD AN2 /SO FAR 3680 06354 3212 DCA AN2 3681 06355 1075 TAD OPH 3682 06356 7004 RAL 3683 06357 1102 TAD AN1 3684 06360 3102 DCA AN1 3685 06361 7344 GON, CLA CLL CMA RAL /RESET COUNTER FOR ZERO REM. 3686 06362 3373 DCA ZCNT 3687 06363 2070 ISZ AC2 /DONE ALL 23 RESULT BITS? 3688 06364 5313 JMP SLOOP /NO-GO ON 3689 06365 1102 DONE, TAD AN1 /YES-STORE ANSWER IN FAC 3690 06366 3072 DCA ACH /ITS NORMALIZED ALREADY 3691 06367 1212 TAD AN2 3692 06370 3073 DCA ACLO 3693 06371 5647 JMP I FROOT /AND RETURN 3694 3695 06372 6000 K6000, 6000 3696 06373 0000 ZCNT, 0 3697 06374 6667 AL1K, AL1 3698 06375 7756 KM22, -22 3699 06376 0002 LOGC1, 2 /2.8853913 3700 06377 2705 2705 3701 06400 2440 2440 3702 /FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES 3703 06401 0000 FFMPY, 0 3704 06402 7450 SNA /WHICH MODE OF CALL? 3705 06403 1601 TAD I FFMPY /CALLED BY USER-GET OPERAND ADDR. 3706 06404 4775 JMS I MDSETK /SET UP FOR MPY-OPX IN AC ON RETN. 3707 06405 1071 TAD ACX /DO EXPONENT ADDITION 3708 06406 3071 DCA ACX /STORE FINAL EXPONENT 3709 06407 3346 DCA DV24 /ZERO TEM STORAGE FOR MPY ROUTINE 3710 06410 3070 DCA AC2 3711 06411 1072 TAD ACH /IS FAC=0? 3712 06412 7650 SNA CLA 3713 06413 3071 DCA ACX /YES-ZERO EXPONENT 3714 06414 4244 JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR. 3715 06415 1075 TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER 3716 06416 3076 DCA OPL 3717 06417 4244 JMS MP24 3718 06420 1070 TAD AC2 /STORE RESULT BACK IN FAC 3719 06421 3073 RTZRO, DCA ACLO /LOW ORDER 3720 06422 1346 TAD DV24 /HIGH ORDER 3721 06423 3072 DCA ACH 3722 06424 1072 TAD ACH /DO WE NEED TO NORMALIZE? 3723 06425 7004 RAL 3724 06426 7700 SMA CLA 3725 06427 5236 JMP SHLFT /YES-DO IT FAST 3726 06430 3067 MDONE, DCA AC1 /NO-ZERO OVERFLOW WD(DO I NEED THIS???) 3727 06431 2201 ISZ FFMPY /BUMP RETURN POINTER 3728 06432 2066 ISZ TM /SHOULD RESULT BE NEGATIVE? 3729 06433 5601 JMP I FFMPY /NOPE-RETN. 3730 06434 4774 JMS I FFNEGR /YES-NEGATE IT 3731 06435 5601 JMP I FFMPY /RETURN 3732 06436 7040 SHLFT, CMA /SUBTRACT 1 FROM EXP. 3733 06437 1071 TAD ACX 3734 06440 3071 DCA ACX 3735 06441 4643 JMS I AL1PTR /SHIFT FAC LEFT 1 BIT 3736 06442 5231 JMP MDONE+1 /DONE. 3737 06443 6667 AL1PTR, AL1 3738 / 3739 /24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL 3740 /MULTIPLICAND IS IN ACH AND ACLO 3741 /RESULT LEFT IN DV24,AC2, AND AC1 3742 06444 0000 MP24, 0 3743 06445 1376 TAD KKM12 /SET UP 12 BIT COUNTER 3744 06446 3074 DCA OPX 3745 06447 1076 TAD OPL /IS MULTIPLIER=0? 3746 06450 7440 SZA 3747 06451 5255 JMP MPLP1 /NO-GO ON 3748 06452 3067 DCA AC1 /YES-INSURE RESULT=0 3749 06453 5644 JMP I MP24 /RETURN 3750 06454 1076 MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER 3751 06455 7010 MPLP1, RAR /OF MULTIPLIER AND INTO LINK 3752 06456 3076 DCA OPL 3753 06457 7420 SNL /WAS IT A 1? 3754 06460 5267 JMP MPLP2 /NO-0-JUST SHIFT PARTIAL PRODUCT 3755 06461 7100 CLL /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT 3756 06462 1070 TAD AC2 3757 06463 1073 TAD ACLO /LOW ORDER 3758 06464 3070 DCA AC2 3759 06465 7004 RAL /PROPAGATE CARRY 3760 06466 1072 TAD ACH /HI ORDER 3761 06467 1346 MPLP2, TAD DV24 3762 06470 7010 RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT 3763 06471 3346 DCA DV24 3764 06472 1070 TAD AC2 3765 06473 7010 RAR 3766 06474 3070 DCA AC2 3767 06475 7010 RAR /1 BIT OF OVERFLOW TO AC1 3768 06476 3067 DCA AC1 3769 06477 2074 ISZ OPX /DONE ALL 12 MULTIPLIER BITS? 3770 06500 5254 JMP MPLP /NO-GO ON 3771 06501 5644 JMP I MP24 /YES-RETURN 3772 / 3773 /PART OF DIVIDE ROUTINE-FFDIV MUST BE AT LOC. 6722 3774 06502 3076 MP12L, DCA OPL /STORE BACK MULTIPLIET 3775 06503 1070 TAD AC2 /GET PRODUCT SO FAR 3776 06504 7420 SNL /WAS MULTIPLIER BIT A 1? 3777 06505 5310 JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT 3778 06506 7100 CLL /YES-CLEAR LINK AND ADD MULTIPLICAND 3779 06507 1073 TAD ACLO /TO PARTIAL PRODUCT 3780 06510 7010 RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER 3781 06511 3070 DCA AC2 /RESULT-STORE BACK 3782 06512 1076 DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER 3783 06513 7010 RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.) 3784 06514 2201 ISZ FFMPY /DONE ALL BITS? 3785 06515 5302 JMP MP12L /NO-LOOP BACK 3786 06516 7141 CLL CMA IAC /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC 3787 06517 3073 DCA ACLO /NEGATE AND STORE 3788 06520 7024 CML RAL /PROPAGATE CARRY 3789 06521 5722 JMP I FD1P /GO ON 3790 06522 7001 FD1P, FD1 /POINTER TO REST OF DIVIDE ROUTINE 3791 / 3792 /FLOATING DIVIDE ROUTINE 3793 /USES THE METHOD OF TRIAL DIVISION BY HI ORDER 3794 06523 0000 FFDIV, 0 /(USED AS A TEM. BY I/O ROUTINES) 3795 06524 7450 SNA /WHICH MODE OF CALL? 3796 06525 1723 TAD I FFDIV /CALLED BY USER-GET ARG. ADDR. 3797 06526 4775 JMS I MDSETK /GO SET UP FOR DIVIDE-OPX IN AC ON RETN. 3798 06527 7041 FFD1, CMA IAC /NEGATE EXP. OF OPERAND 3799 06530 1071 TAD ACX /ADD EXP OF FAC 3800 06531 3071 DCA ACX /STORE AS FINAL EXPONENT 3801 06532 1075 TAD OPH /NEGATE HI ORDER OP. FOR USE 3802 06533 7141 CLL CMA IAC /AS DIVISOR 3803 06534 3075 DCA OPH 3804 06535 4346 JMS DV24 /CALL DIV.--(ACH+ACLO)/OPH 3805 06536 1073 TAD ACLO /SAVE QUOT. FOR LATER 3806 06537 3067 DCA AC1 3807 06540 1377 TAD KM13 /SET COUNTER FOR 12 BIT MULTIPLY 3808 06541 3201 DCA FFMPY /TO MULTIPLY QUOT. OF DIV. BY 3809 06542 5312 JMP DVLP1 /LOW ORDER OF OPERAND (OPL) 3810 / 3811 /END OF FLOATING DIVIDE-FUDGE SOME 3812 /STUFF THEN JUMP INTO MULTIPLY 3813 / 3814 06543 1323 FDDON, TAD FFDIV /STORE RETN. ADDR. IN MULT ROUTINE 3815 06544 3201 DCA FFMPY 3816 06545 5230 JMP MDONE /GO CLEAN UP 3817 / 3818 /DIVIDE ROUTINE--24 BITS IN ACH,ACLO ARE DIVIDED BY 12 BITS 3819 /IN OPH. OPH IS ASSUMEN NEGATIVE AND .GT. ACH IN ABSOLUTE VALUE 3820 /ELSE-DIVIDE OVERFLOW--WE RETURN NORMALLY WITH QUOTIENT 3821 /IN ACLO AND REM. IN ACH. (AC2=0 ON RETN.) 3822 / 3823 06546 0000 DV24, 0 3824 06547 1072 TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND 3825 06550 1075 TAD OPH /DIVISOR IN OPH (NEGATIVE) 3826 06551 7630 SZL CLA /IS IT? 3827 06552 4554 ERR030, ERROR /NO-DIVIDE OVERFLOW 3828 06553 1377 TAD KM13 /YES-SET UP 12 BIT LOOP 3829 06554 3070 DCA AC2 3830 06555 5366 JMP DV1 /GO BEGIN DIVIDE 3831 06556 1072 DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT 3832 06557 7004 RAL 3833 06560 3072 DCA ACH /RESTORE HI ORDER 3834 06561 1072 TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER 3835 06562 1075 TAD OPH /DIVIDEND 3836 06563 7430 SZL /GOOD SUBTRACT? 3837 06564 3072 DCA ACH /YES-RESTORE HI DIVIDEND 3838 06565 7200 CLA /NO-DON'T RESTORE--OPH.GT.ACH 3839 06566 1073 DV1, TAD ACLO /SHIFT FAC LEFT 1 BIT-ALSO SHIFT 3840 06567 7004 RAL /1 BIT OF QUOT. INTO LOW ORD OF ACLO 3841 06570 3073 DCA ACLO 3842 06571 2070 ISZ AC2 /DONE 12 BITS OF QUOT? 3843 06572 5356 JMP DV2 /NO-GO ON 3844 06573 5746 JMP I DV24 /YES-RETN W/AC2=0 3845 06574 2556 FFNEGR, FFNEG 3846 06575 7030 MDSETK, MDSET 3847 06576 7764 KKM12, -14 3848 06577 7763 KM13, -15 3849 3850 PAGE 3851 / 3852 /FLOATING ADD 3853 / 3854 06600 0000 FFADD, 0 3855 06601 7450 SNA /WHICH MODE FO CALL? 3856 06602 1600 TAD I FFADD /CALLED BY USER-GET ADDR. OF OPR. 3857 06603 4744 JMS I ARGETP /PICK UP OPERAND 3858 06604 2200 ISZ FFADD /BUMP RETURN 3859 06605 1075 FAD1, TAD OPH /IS OPERAND = 0 3860 06606 7650 SNA CLA 3861 06607 5600 JMP I FFADD /YES-DONE 3862 06610 1072 TAD ACH /NO-IS FAC=0? 3863 06611 7650 SNA CLA 3864 06612 5223 JMP DOADD /YES-DO ADD 3865 06613 1071 TAD ACX /NO-DO EXPONENT CALCULATION 3866 06614 7141 CLL CMA IAC 3867 06615 1074 TAD OPX 3868 06616 7540 SMA SZA /WHICH EXP. GREATER? 3869 06617 5230 JMP FACR /OPERANDS-SHIFT FAC 3870 06620 7041 CMA IAC /FAC'S-SHIFT OPERAND=DIFFRNCE+1 3871 06621 4233 JMS OPSR 3872 06622 4302 JMS ACSR /SHIFT FAC ONE PLACE RIGHT 3873 06623 1074 DOADD, TAD OPX /TRANSFER OPX TO ACX 3874 06624 3071 DCA ACX /(CONVENIANT MAINLY IF FAC=0) 3875 06625 4347 JMS OADD /DO THE ADDITION 3876 06626 4765 JMS I FNORP /NORMALIZE RESULT 3877 06627 5600 JMP I FFADD /RETURN 3878 06630 4302 FACR, JMS ACSR /SHIFT FAC = DIFF.+1 3879 06631 4233 JMS OPSR /SHIFT OPR. 1 PLACE 3880 06632 5223 JMP DOADD /DO ADDITION 3881 / 3882 /OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 3883 /IN AC 3884 06633 0000 OPSR, 0 3885 06634 7140 CLL CMA /- (COUNT+1) TO SHIFT COUNTER 3886 06635 3066 DCA AC0 3887 06636 3070 DCA AC2 /ZERO OVERFLOW BIT 3888 06637 1075 LOP2, TAD OPH /GET THE HIGH ORDER OPERAND 3889 06640 7500 SMA /IS THE OPERAND NEGATIVE? 3890 06641 5253 JMP OPSR1 /NO: NO SPECIAL PROCESSING 3891 /IN ORDER TO CORRECTLY SHIFT A NEGATIVE NUMBER RIGHT 3892 /ONE MUST BE ADDED TO IT AND THEN THE LOGICAL SHIFT 3893 /PROPAGATING THE SIGN BIT WILL WORK 3894 06642 7230 CLA CML RAR /MAKE 4000, LINK WAS ASSUMED TO BE 0! 3895 06643 1070 TAD AC2 /ADD OVERFLOW BIT 3896 06644 3070 DCA AC2 /AND STORE BACK 3897 06645 7004 RAL /APPROPRIATELY POSITION CARRY 3898 06646 1076 TAD OPL /AND ADD THE LOW ORDER OPERAND 3899 06647 3076 DCA OPL /STORE BACK 3900 06650 7004 RAL /AGAIN POSITION CARRY 3901 06651 1075 TAD OPH /ADD HIGH ORDER 3902 06652 7020 CML /LINK WAS COMPLEMENT OF SIGN BIT 3903 06653 7010 OPSR1, RAR /SHIFT IT RIGHT, PROPAGATING SIGN 3904 06654 3075 DCA OPH /STORE BACK 3905 06655 1076 TAD OPL 3906 06656 7010 RAR 3907 06657 3076 DCA OPL /STORE LO ORDER BACK 3908 06660 7010 RAR /SAVE 1 BIT OF OVERFLOW 3909 06661 3070 DCA AC2 /IN AC2 3910 06662 2074 ISZ OPX /INCREMENT EXPONENT 3911 06663 7000 NOP /ISZ MAY SKIP, SO THIS BUFFERS IT 3912 06664 2066 ISZ AC0 /DONE ALL SHIFTS? 3913 06665 5237 JMP LOP2 /NO-LOOP 3914 06666 5633 JMP I OPSR /YES-RETN. 3915 / 3916 /SHIFT FAC LEFT 1 BIT 3917 / 3918 06667 0000 AL1, 0 3919 06670 1067 TAD AC1 /GET OVERFLOW BIT 3920 06671 7104 CLL RAL /SHIFT LEFT 3921 06672 3067 DCA AC1 /STORE BACK 3922 06673 1073 TAD ACLO /GET LOW ORDER MANTISSA 3923 06674 7004 RAL /SHIFT LEFT 3924 06675 3073 DCA ACLO /STORE BACK 3925 06676 1072 TAD ACH /GET HI ORDER 3926 06677 7004 RAL 3927 06700 3072 DCA ACH /STORE BACK 3928 06701 5667 JMP I AL1 /RETN. 3929 / 3930 /SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE) 3931 / 3932 06702 0000 ACSR, 0 3933 06703 7140 CLL CMA /AC CONTAINS COUNT-1 3934 06704 3066 DCA AC0 /STORE COUNT 3935 06705 3067 DCA AC1 /CLEAR FAC'S OVERFLOW BIT 3936 06706 1072 LOP1, TAD ACH 3937 06707 7500 SMA 3938 06710 5322 JMP ACSR1 3939 06711 7230 CLA CML RAR /IF FAC<0, 3940 06712 1067 TAD AC1 /ADD 1 TO FAC 3941 06713 3067 DCA AC1 3942 06714 7004 RAL 3943 06715 1073 TAD ACLO 3944 06716 3073 DCA ACLO 3945 06717 7004 RAL 3946 06720 1072 TAD ACH 3947 06721 7020 CML /PROPAGATE SIGN BIT CORRECTLY 3948 06722 7010 ACSR1, RAR /SHIFT RIGHT 1, PROPAGATING SIGN 3949 06723 3072 DCA ACH /STORE BACK 3950 06724 1073 TAD ACLO /GET LOW ORDER 3951 06725 7010 RAR /SHIFT IT 3952 06726 3073 DCA ACLO /STORE BACK 3953 06727 7010 RAR 3954 06730 3067 DCA AC1 /SAVE 1 BIT OF OVERFLOW 3955 06731 2066 ISZ AC0 /DONE? 3956 06732 5306 JMP LOP1 /NO-LOOP 3957 06733 5702 JMP I ACSR /YES-RETN-AC=L=0 3958 / 3959 /FLOATING SUBTRACT 3960 / 3961 06734 0000 FFSUB, 0 3962 06735 7450 SNA /WHICH MODE OF CALL? 3963 06736 1734 TAD I FFSUB /CALLED BY USER-GET ADDR. OF OP 3964 06737 4744 JMS I ARGETP /PICK UO THE OP. 3965 06740 4745 JMS I POPNEG /NEGATE OPERAND 3966 06741 1334 TAD FFSUB /JMP INTO FLTG. ADD 3967 06742 3200 SUB0, DCA FFADD /AFTER SETTING UP RETURN 3968 06743 5204 JMP FAD1-1 3969 06744 7062 ARGETP, ARGET 3970 06745 1551 POPNEG, OPNEG 3971 *.+1 /SO PAGE BOUNDARY WILL FALL IN THE RIGHT PLACE. 3972 / 3973 /ADD OPERAND TO FAC 3974 / 3975 06747 0000 OADD, 0 3976 06750 7100 CLL 3977 06751 1070 TAD AC2 /ADD OVERFLOW WORDS 3978 06752 1067 TAD AC1 3979 06753 3067 DCA AC1 3980 06754 7004 RAL /ROTATE CARRY 3981 06755 1076 TAD OPL /ADD LOW ORDER MANTISSAS 3982 06756 1073 TAD ACLO 3983 06757 3073 DCA ACLO 3984 06760 7004 RAL 3985 06761 1075 TAD OPH /ADD HI ORDER MANTISSAS 3986 06762 1072 TAD ACH 3987 06763 3072 DCA ACH 3988 06764 5747 JMP I OADD /RETN. 3989 06765 7076 FNORP, FFNOR 3990 / 3991 /CONTINUATION OF ROUTINE TO ADJUST QUOT. OF FIRST DIV. 3992 /ROUTINE STARTS AT DVOP2. 3993 / 3994 06766 6546 DV24L, DV24 /ROUTINE TO DO A 24X12 BIT DIVIDE 3995 06767 7450 DVOP2, SNA /IS IT ZERO? 3996 06770 3073 DCA ACLO /YES-MAKE WHOLE THING ZERO 3997 06771 3072 DCA ACH 3998 06772 4766 JMS I DV24L /DIVIDE EXTENDED REM. BY HI DIVISOR 3999 06773 1073 TAD ACLO /NEGATE THE RESULT 4000 06774 7141 CLL CMA IAC 4001 06775 3073 DCA ACLO 4002 06776 7420 SNL /IF QUOT. IS NON-ZERO, SUBTRACT 4003 06777 7040 CMA /ONE FROM HIGH ORDER QUOT. 4004 /******FALL THROUGH PAGE BOUNDARY****** 4005 /******'CMA' HAD BETTER BE LAST ON PAGE!****** 4006 07000 5211 JMP DVL1 /GO TO IT 4007 / 4008 /CONTINUATION OF FLOATING DIVIDE ROUTINE 4009 / 4010 07001 1070 FD1, TAD AC2 /NEGATE HI ORDER PRODUCT 4011 07002 7141 CLL CMA IAC 4012 07003 1072 TAD ACH /COMPARE WITH REMAINDER OF FIRST DIVIDE 4013 07004 7420 SNL 4014 07005 5361 JMP DVOPS /GREATER THAN REM.-ADJUST QUOT. OF 1ST DIV. 4015 07006 7100 CLL /OK-DO (REM-(Q*OPL))/OPH 4016 07007 3072 DCA ACH /FIRST STORE ADJUSTED PRODUCT 4017 07010 4627 JMS I DV24P /DIVIDE BY OPH (HIGH ORDER OPERAND) 4018 07011 1067 DVL1, TAD AC1 /GET QUOT. OF FIRST DIV. 4019 07012 7500 SMA /IF HIGH ORDER BIT SET-MUST SHIFT 1 RIGHT 4020 07013 5224 JMP FD /NO-IT'S NORMALIZED-DONE 4021 07014 7110 CLL RAR /MUST SHIFT RIGHT 1 4022 07015 3072 DCA ACH /STORE IN FAC 4023 07016 1073 TAD ACLO /SHIFT LOW ORDER RIGHT 4024 07017 7010 RAR 4025 07020 3073 DCA ACLO /STORE BACK 4026 07021 2071 ISZ ACX /BUMP EXPONENT 4027 07022 7000 NOP 4028 07023 1072 TAD ACH 4029 07024 3072 FD, DCA ACH /STORE HIGH ORDER RESULT 4030 07025 5626 JMP I FDDONP /GO LEAVE DIVIDE 4031 4032 07026 6543 FDDONP, FDDON /END OF FLTG. DIV. ROUTINE 4033 07027 6546 DV24P, DV24 /ROUTINE TO DO A 24X12 BIT DIVIDE 4034 4035 / 4036 /MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE 4037 /ALSO SHIFTS OPERAND ONE BIT TO THE LEFT. 4038 /EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT 4039 /CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC. 4040 / 4041 07030 0000 MDSET, 0 4042 07031 4262 JMS ARGET /GET ARGUMENT 4043 07032 7344 MD1, CLA CLL CMA RAL /SET SIGN CHECK TO -2 4044 07033 3066 DCA TM 4045 07034 1075 TAD OPH /IS OPERAND NEGATIVE? 4046 07035 7700 SMA CLA 4047 07036 5241 JMP .+3 /NO 4048 07037 4661 JMS I OPNEGP /YES-NEGATE IT 4049 07040 2066 ISZ TM /BUMP SIGN CHECK 4050 07041 1076 TAD OPL /AND SHIFT LEFT ONE BIT 4051 07042 7104 CLL RAL 4052 07043 3076 DCA OPL 4053 07044 1075 TAD OPH 4054 07045 7004 RAL 4055 07046 3075 DCA OPH 4056 07047 3067 DCA AC1 /CLR. OVERFLOW WORD OF FAC 4057 07050 1072 TAD ACH /IS FAC NEGATIVE 4058 07051 7700 SMA CLA 4059 07052 5256 JMP LEV /NO-GO ON 4060 07053 4660 JMS I FFNEGK /YES-NEGATE IT 4061 07054 2066 ISZ TM /BUMP SIGN CHECK 4062 07055 7000 NOP /MAY SKIP 4063 07056 1074 LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC 4064 07057 5630 JMP I MDSET 4065 4066 07060 2556 FFNEGK, FFNEG 4067 07061 1551 OPNEGP, OPNEG 4068 4069 / 4070 /ARGUMENT PICK UP ROUTINE-ENTER WITH DATA FIELD SET TO EITHER 4071 /FLTG. DATA FIELD OR FLTG. INSTR. FIELD. 4072 /ADDRESS OF OPERAND IS IN THE AC ON ENTRY. 4073 /ON RETURN, THE`AC IS CLEAR 4074 / 4075 07062 0000 ARGET, 0 4076 07063 3070 DCA AC2 /STORE ADDRESS OF OPERAND 4077 07064 1470 TAD I AC2 /PICK UP EXPONENT 4078 07065 3074 DCA OPX 4079 07066 2070 ISZ AC2 /MOVE POINTER TO HI MANTISSA WD 4080 07067 1470 TAD I AC2 /PICK IT UP 4081 07070 3075 DCA OPH /STORE 4082 07071 2070 ISZ AC2 /MOVE PTR. TO LO MANTISSA WD. 4083 07072 1470 TAD I AC2 /PICK IT UP 4084 07073 3076 DCA OPL /STORE IT 4085 07074 5662 JMP I ARGET /RETURN 4086 07075 6767 DVOP2P, DVOP2 4087 / 4088 /ROUTINE TO NORMALIZE THE FAC 4089 / 4090 07076 0000 FFNOR, 0 4091 07077 1072 TAD ACH /GET THE HI ORDER MANTISSA 4092 07100 7450 SNA /ZERO? 4093 07101 1073 TAD ACLO /YES-HOW ABOUT LOW? 4094 07102 7450 SNA 4095 07103 1067 TAD AC1 /LOW=0, IS OVRFLO BIT ON? 4096 07104 7650 SNA CLA 4097 07105 5323 JMP ZEXP /#=0-ZERO EXPONENT 4098 07106 7332 NORMLP, CLA CLL CML RTR /NOT 0-MAKE A 2000 IN AC 4099 07107 1072 TAD ACH /ADD HI ORDER MANTISSA 4100 07110 7440 SZA /HI ORDER = 6000 4101 07111 5314 JMP .+3 /NO-CHECK LEFT MOST DIGIT 4102 07112 1073 TAD ACLO /YES-6000 OK IF LOW=0 4103 07113 7640 SZA CLA 4104 07114 7710 SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS. 4105 07115 5324 JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7) 4106 07116 7160 CLL CML CMA /-1 4107 07117 1071 TAD ACX /SUBTR. 1 FROM EXPONENT 4108 07120 3071 DCA ACX 4109 07121 4726 JMS I AL1P /SHIFT FAC LEFT ONE 4110 07122 5306 JMP NORMLP /GO BACK AND SEE IF NORMALIZED 4111 07123 3071 ZEXP, DCA ACX 4112 07124 3067 FFNORR, DCA AC1 /DONE W/NORMALIZE-CLEAR AC1 4113 07125 5676 JMP I FFNOR /RETURN 4114 07126 6667 AL1P, AL1 4115 / 4116 /FLOATING GET 4117 / 4118 07127 0000 FFGET, 0 4119 07130 7450 SNA /WHICH MODE OF CALL 4120 07131 1727 TAD I FFGET /CALLED BY USER-GET ADDR. OF OP 4121 07132 4262 JMS ARGET /PICK UP OPERAND 4122 07133 1074 TAD OPX 4123 07134 3071 DCA ACX /LOAD THE OPERAND INTO FAC 4124 07135 1076 TAD OPL 4125 07136 3073 DCA ACLO 4126 07137 1075 TAD OPH 4127 07140 3072 DCA ACH 4128 07141 2327 ISZ FFGET 4129 07142 5727 JMP I FFGET /RETN. TO CALL +2 4130 / 4131 /FLOATING PUT 4132 / 4133 07143 0000 FFPUT, 0 4134 07144 7450 SNA /WHICH MODE OF CALL? 4135 07145 1743 TAD I FFPUT /CALLED BY USER-GET OPR. ADDR 4136 07146 3327 DCA FFGET /STORE IN A TEMP 4137 07147 1071 TAD ACX /GET FAC AND STORE IT 4138 07150 3727 DCA I FFGET /AT SPECIFI{qD ADDRESS 4139 07151 2327 ISZ FFGET 4140 07152 1072 TAD ACH 4141 07153 3727 DCA I FFGET 4142 07154 2327 ISZ FFGET 4143 07155 1073 TAD ACLO 4144 07156 3727 DCA I FFGET 4145 07157 2343 ISZ FFPUT /BUMP RETN. 4146 07160 5743 JMP I FFPUT /RETN. TO CALL+2 4147 / 4148 /ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE 4149 /REMAINDER OF THE FIRST DIVIDE IS LESS THAN QUOT*OPL 4150 /USED BY FLTG. DIVIDE ROUTINE 4151 / 4152 07161 7041 DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER 4153 07162 3072 DCA ACH 4154 07163 7100 CLL 4155 07164 1075 TAD OPH 4156 07165 1072 TAD ACH /WATCH FOR OVERFLOW 4157 07166 7420 SNL 4158 07167 5374 JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV. 4159 07170 3072 DCA ACH /NO OVERFLOW-STORE NEW REM. 4160 07171 7040 CMA /SUBTRACT 1 FROM QUOT OF 4161 07172 1067 TAD AC1 /FIRST DIVIDE 4162 07173 3067 DCA AC1 4163 07174 7300 DVOP1, CLA CLL 4164 07175 1072 TAD ACH /GET HI ORD OF REMAINDER 4165 07176 5675 JMP I DVOP2P /GO ON 4166 4167 PAGE 4168 /*FLIN* (FLOATING POINT INPUT) ROUTINE 4169 /THIS ROUTINE ASSEMBLES A FLOATING POINT NUMBER IN THE FAC. 4170 /THE NUMBER IS READ AS ASCII TEXT BY THE UNPACK ROUTINE. 4171 07200 0000 FLIN, 0 4172 07201 7240 CLA CMA 4173 07202 3345 DCA FLAG 4174 07203 3302 DCA E 4175 07204 3303 DCA DFLG 4176 07205 3071 DCA ACX 4177 07206 3072 DCA ACH 4178 07207 3073 DCA ACLO 4179 07210 4557 FLIN1, TESTN 4180 07211 5230 JMP FLIN3 4181 07212 5234 JMP FLIN4 4182 07213 4777 JMS I (FFMPY /DIGIT 4183 07214 7342 TEN 4184 07215 4700 JMS I KFFPUT 4185 07216 5472 FTEMP1 4186 07217 1101 TAD SORTCN 4187 07220 4776 JMS I (FFLOAT 4188 07221 4775 JMS I (FFADD 4189 07222 5472 FTEMP1 4190 07223 2302 ISZ E 4191 07224 7040 CMA 4192 07225 3303 DCA DFLG 4193 07226 4540 FLIN2, GETC 4194 07227 5210 JMP FLIN1 4195 07230 2345 FLIN3, ISZ FLAG 4196 07231 5234 JMP FLIN4 4197 07232 3302 DCA E 4198 07233 5226 JMP FLIN2 4199 07234 2303 FLIN4, ISZ DFLG 4200 07235 4554 ERR150, ERROR 4201 07236 1026 TAD CHAR 4202 07237 1374 TAD (-105 4203 07240 7640 SZA CLA 4204 07241 5256 JMP SHIFT 4205 07242 4540 GETC 4206 07243 1026 TAD CHAR 4207 07244 1373 TAD (-56 4208 07245 3303 DCA DFLG 4209 07246 1303 TAD DFLG 4210 07247 7152 CLL CMA RTR 4211 07250 7650 SNA CLA 4212 07251 4540 GETC 4213 07252 4304 JMS GETNUM 4214 07253 1074 TAD OPX 4215 07254 2303 ISZ DFLG 4216 07255 7041 CIA 4217 07256 2345 SHIFT, ISZ FLAG 4218 07257 1302 TAD E 4219 07260 7450 SNA 4220 07261 5276 JMP GIVE 4221 07262 7100 CLL 4222 07263 7500 SMA 4223 07264 7061 CML CIA 4224 07265 3302 DCA E 4225 07266 7430 SZL 4226 07267 1372 TAD (FFDIV-FFMPY 4227 07270 1377 TAD (FFMPY 4228 07271 3303 DCA DFLG 4229 07272 4703 FLIN5, JMS I DFLG 4230 07273 7342 TEN 4231 07274 2302 ISZ E 4232 07275 5272 JMP FLIN5 4233 07276 1025 GIVE, TAD PT1 4234 07277 4700 JMS I KFFPUT 4235 07300 7143 KFFPUT, FFPUT 4236 07301 5600 JMP I FLIN 4237 4238 07302 0000 E, 0 /NEXT 3 LOCS USED AS TEMPS 4239 07303 0000 DFLG, 0 /BY *TAN* FUNCTION 4240 4241 07304 0000 GETNUM, 0 4242 07305 3074 DCA OPX 4243 07306 4557 TESTN 4244 07307 7000 NOP 4245 07310 4554 ERR370, ERROR 4246 07311 1074 GETN1, TAD OPX 4247 07312 7104 CLL RAL 4248 07313 7530 SPA SZL 4249 07314 5310 JMP ERR370 4250 07315 7004 RAL 4251 07316 1074 TAD OPX 4252 07317 7530 SPA SZL 4253 07320 5310 JMP ERR370 4254 07321 7004 RAL 4255 07322 1101 TAD SORTCN 4256 07323 7530 SPA SZL 4257 07324 5310 JMP ERR370 4258 07325 3074 DCA OPX 4259 07326 4540 GETC 4260 07327 4557 TESTN 4261 07330 7000 NOP 4262 07331 5704 JMP I GETNUM 4263 07332 5311 JMP GETN1 4264 4265 /*GETLN* ROUTINE 4266 /READS A DECIMAL LINE NUMBER INTO LINENO THROUGH THE 4267 /TEXT UNPACKING ROUTINES 4268 07333 0000 XGETLN, 0 4269 07334 4304 JMS GETNUM 4270 07335 1074 TAD OPX 4271 07336 7450 SNA 4272 07337 5310 JMP ERR370 4273 07340 3030 DCA LINENO 4274 07341 5733 JMP I XGETLN 4275 4276 07342 0004 TEN, 4 /10.0 4277 07343 2400 2400 4278 07344 0000 0 4279 4280 /*TAN* FUNCTION 4281 07345 0000 TAN, 0 /ALSO USED AS TEMP BY *FLIN* 4282 07346 4700 JMS I KFFPUT /SAVE AWAY THE ARG 4283 07347 0565 FLARG 4284 07350 4771 JMS I (COS /FAC=COS(ARG) 4285 07351 4700 JMS I KFFPUT /SAVE THAT TOO 4286 07352 7302 E /IN TEMP STORAGE 4287 07353 4770 JMS I (FFGET /GET BACK ORIGINAL ARG 4288 07354 0565 FLARG 4289 07355 4767 JMS I (FSIN /AND TAKE ITS SINE 4290 07356 4766 JMS I (FFDIV /FAC=SIN(ARG)/COS(ARG) 4291 07357 7302 E 4292 07360 5745 JMP I TAN /EXIT WITH FAC=TAN(ARG) 4293 FLAG=TAN 4294 07366 6523 PAGE 07367 5400 07370 7127 07371 5453 07372 0122 07373 7722 07374 7673 07375 6600 07376 6164 07377 6401 4295 /*FLOUT* (FLOATING POINT OUTPUT) ROUTINE 4296 /PRINTS THE NUMBER IN THE FAC AS WELL AS IT CAN. 4297 DEXP=T1 /3 ASSIGNMENTS 4298 SIG=T2 4299 4300 07400 0000 FLOUT, 0 4301 07401 1072 TAD ACH 4302 07402 7710 SPA CLA 4303 07403 1117 TAD CCR 4304 07404 1133 TAD C40 4305 07405 4537 PRINTC 4306 07406 1072 TAD ACH 4307 07407 7640 SZA CLA 4308 07410 5214 JMP .+4 4309 07411 1352 TAD K60 4310 07412 4537 PRINTC 4311 07413 5600 JMP I FLOUT 4312 07414 4777 JMS I (ABS 4313 07415 1071 TAD ACX /ROUNDING 4314 07416 3074 DCA OPX 4315 07417 3075 DCA OPH 4316 07420 1071 TAD ACX 4317 07421 7510 SPA 4318 07422 7041 CIA 4319 07423 7110 CLL RAR 4320 07424 7110 CLL RAR 4321 07425 1376 TAD (3 4322 07426 3076 DCA OPL 4323 07427 1375 TAD (.+3 4324 07430 3774 DCA I (FFADD 4325 07431 5773 JMP I (DOADD-2 4326 07432 3102 DCA DEXP 4327 07433 7346 FLOUT1, CLA CLL CMA RTL 4328 07434 1071 TAD ACX 4329 07435 7750 SPA SNA CLA 4330 07436 5250 JMP FLOUT2 4331 07437 4772 JMS I (FFDIV 4332 07440 7342 TEN 4333 07441 2102 ISZ DEXP 4334 07442 5233 JMP FLOUT1 4335 07443 4771 FLOT2A, JMS I (FFMPY 4336 07444 7342 TEN 4337 07445 7040 CMA 4338 07446 1102 TAD DEXP 4339 07447 3102 DCA DEXP 4340 07450 1071 FLOUT2, TAD ACX 4341 07451 7750 SPA SNA CLA 4342 07452 5243 JMP FLOT2A 4343 07453 4770 JMS I (FFPUT 4344 07454 5472 FTEMP1 4345 07455 1131 TAD M6 4346 07456 3354 DCA RONDUP 4347 07457 4767 SIGNIF, JMS I (FRACT 4348 07460 4771 JMS I (FFMPY 4349 07461 7342 TEN 4350 07462 1766 TAD I (NUM 4351 07463 7640 SZA CLA 4352 07464 3103 DCA SIG 4353 07465 2103 ISZ SIG 4354 07466 2354 ISZ RONDUP 4355 07467 5257 JMP SIGNIF 4356 07470 4765 JMS I (FFGET 4357 07471 5472 FTEMP1 4358 07472 1102 TAD DEXP 4359 07473 7001 IAC 4360 07474 7160 CLL CMA CML 4361 07475 1120 TAD C7 4362 07476 7760 SMA SZA SNL CLA 4363 07477 5305 JMP BIG 4364 07500 1102 TAD DEXP 4365 07501 3354 DCA RONDUP 4366 07502 3102 BIG1, DCA DEXP 4367 07503 4342 JMS PICKC 4368 07504 7140 CLL CMA 4369 07505 1102 BIG, TAD DEXP 4370 07506 7500 SMA 4371 07507 5302 JMP BIG1 4372 07510 1131 LITTLE, TAD M6 4373 07511 1103 TAD SIG 4374 07512 3103 DCA SIG 4375 07513 7420 SNL 4376 07514 5323 JMP PREXP 4377 07515 1364 TAD (56 4378 07516 4537 PRINTC 4379 07517 4342 LITL2, JMS PICKC 4380 07520 1103 TAD SIG 4381 07521 7710 SPA CLA 4382 07522 5317 JMP LITL2 4383 07523 1354 PREXP, TAD RONDUP 4384 07524 7650 SNA CLA 4385 07525 5600 JMP I FLOUT 4386 07526 1363 TAD (105 4387 07527 4537 PRINTC 4388 07530 1354 TAD RONDUP 4389 07531 7500 SMA 4390 07532 5340 JMP PRXP1 4391 07533 7041 CIA 4392 07534 3354 DCA RONDUP 4393 07535 1362 TAD (55 4394 07536 4537 PRINTC 4395 07537 1354 TAD RONDUP 4396 07540 4761 PRXP1, JMS I (ITPRNT 4397 07541 5600 JMP I FLOUT 4398 4399 07542 0000 PICKC, 0 4400 07543 4767 JMS I (FRACT 4401 07544 1766 TAD I (NUM 4402 07545 1352 TAD K60 4403 07546 4537 PRINTC 4404 07547 4771 JMS I (FFMPY 4405 07550 7342 TEN 4406 07551 2103 ISZ SIG 4407 07552 0060 K60, 60 /A HARMLESS CONSTANT THAT ALSO BUFFERS THE ISZ 4408 07553 5742 JMP I PICKC 4409 4410 07554 0000 RONDUP, 0 4411 IFDEF CONFIG < 4412 PAGE 4413 4414 ENPUNCH 4415 > 4416 07561 0231 FIELD 1 07562 0055 07563 0105 07564 0056 07565 7127 07566 5526 07567 5503 07570 7143 07571 6401 07572 6523 07573 6621 07574 6600 07575 7432 07576 0003 07577 5516 4417 4418 *6000 4419 F0P37, 4420 NOPUNCH 4421 *7600 /THIS WILL BE MOVED LATER 4422 ENPUNCH 4423 4424 17600 5356 JMP 7756 /FOR A MONITOR SYSTEM 4425 4426 /*FLPUT* ROUTINE 4427 17601 0000 XFLPUT, 0 4428 17602 7440 SZA 4429 17603 5206 JMP XFLPT2 4430 17604 7340 XFLPT1, L7777 4431 17605 1025 TAD PT1 4432 17606 3013 XFLPT2, DCA FLTXR 4433 17607 7340 L7777 4434 17610 1601 TAD I XFLPUT 4435 17611 3014 DCA FLTXR2 4436 17612 7346 L7775 4437 17613 3104 DCA T3 4438 17614 1414 TAD I FLTXR2 4439 17615 4555 UDF 4440 17616 3413 DCA I FLTXR 4441 17617 6201 CDF 4442 17620 2104 ISZ T3 4443 17621 5214 JMP .-5 4444 17622 2201 ISZ XFLPUT 4445 17623 5601 JMP I XFLPUT 4446 4447 /*SORTC* ROUTINE 4448 17624 0000 XSORTC, 0 4449 17625 7450 SNA 4450 17626 1026 TAD CHAR 4451 17627 7041 CIA 4452 17630 3104 DCA T3 4453 17631 1624 TAD I XSORTC 4454 17632 3012 DCA XREG3 4455 17633 6211 CDF 10 4456 17634 1412 TAD I XREG3 4457 17635 6201 CDF 4458 17636 7510 SPA 4459 17637 5250 JMP XSORT3 4460 17640 1104 TAD T3 4461 17641 7640 SZA CLA 4462 17642 5233 JMP .-7 4463 17643 1624 TAD I XSORTC 4464 17644 7040 CMA 4465 17645 1012 TAD XREG3 4466 17646 3101 DCA SORTCN 4467 17647 7410 SKP 4468 17650 2224 XSORT3, ISZ XSORTC 4469 17651 2224 ISZ XSORTC 4470 17652 7300 CLL CLA 4471 17653 5624 JMP I XSORTC 4472 4473 /*PRINTX* ROUTINE 4474 17654 0000 XOUTL, 0 4475 17655 7450 SNA 4476 17656 1026 TAD CHAR 4477 17657 4701 JMS I KKR 4478 17660 1012 TAD XREG3 4479 17661 1302 TAD KK1 4480 17662 7450 SNA 4481 17663 5274 JMP XOUTL1 4482 17664 1303 TAD KK2 4483 17665 7121 CLL CML IAC 4484 17666 1134 TAD C77 4485 17667 7720 SMA SNL CLA 4486 17670 2061 ISZ PRNTC1 4487 17671 5654 JMP I XOUTL 4488 17672 1117 TAD CCR 4489 17673 4701 JMS I KKR 4490 17674 1125 XOUTL1, TAD CLF 4491 17675 4701 JMS I KKR 4492 17676 1304 TAD KK3 4493 17677 3061 DCA PRNTC1 4494 17700 5654 JMP I XOUTL 4495 17701 3400 KKR, XOUTL2 4496 17702 7763 KK1, -15 4497 17703 7655 KK2, 15-140 4498 17704 7670 KK3, -110 4499 17705 3105 FUNCT3, DCA EFOP 4500 17706 1031 TAD MODE 4501 17707 4543 PUSHA 4502 17710 4721 JMS I IECALL 4503 17711 4546 POPA 4504 17712 7510 SPA 4505 17713 5722 JMP I FUNC6I 4506 17714 1323 TAD FUNJMS 4507 17715 3316 DCA .+1 4508 17716 0000 0 4509 17717 5720 JMP I ENDFNI 4510 4511 17720 4762 ENDFNI, ENDFUN 4512 17721 2600 IECALL, ECALL 4513 17722 3000 FUNC6I, FUNCT6 4514 17723 4722 FUNJMS, JMS I FUNL3-2 4515 4516 17724 5400 FUNL3, FSIN 4517 17725 5453 COS 4518 17726 5600 ATN 4519 17727 5533 EXPON 4520 17730 5665 LOG 4521 17731 5516 ABS 4522 17732 6247 FROOT 4523 17733 5013 SGN 4524 17734 0556 INT 4525 17735 5355 RND 4526 17736 0546 FIX 4527 17737 7345 TAN 4528 17740 2146 LEN 4529 17741 2000 MID 4530 17742 2107 CAT 4531 ABS=NHNDLE 4532 4533 4534 17743 7740 IF5, SMA SZA CLA 4535 17744 7710 SPA CLA 4536 17745 7650 SNA CLA 4537 17746 7700 SMA CLA 4538 17747 7750 SPA SNA CLA 4539 17750 7640 SZA CLA 4540 4541 17751 0000 INTCNT, 0 4542 *6377-24 4543 KL8LOD, 4544 NOPUNCH 4545 *7777-24 4546 ENPUNCH 4547 4548 /THE KL8FIX ROUTINE TURNS ON THE KEYBOARD INTERRUPT FOR 4549 /THE KL8-E TTYS IN CASE STATIC ELECTRICITY TURNED IT OFF. 4550 /IF THE COMPUTER IS A PDP-8/L, THIS ROUTINE 4551 /IS NOT USED. OTHERWISE, THE INITIALIZER LOADS IT INTO THE 4552 /END OF FIELD 1. 4553 17753 1374 KL8FIX, TAD KL8TAD /GET TAD INSTRUCTION 4554 17754 3362 DCA KL8TLS /STICK IT INTO THE PROGRAM 4555 17755 1065 TAD MUSER /GET THE MINUS NUMBER OF USERS 4556 17756 3373 DCA KL8CTR /SET UP COUNTER 4557 17757 7346 KL8LP, CLL CLA CMA RTL /AC & L = 17775 4558 17760 6035 KL8KIE, 6035 /KIE-ENABLE KEYBOARD INTERRUPT (AC11=1) 4559 17761 7006 RTL /AC=-11 4560 17762 7402 KL8TLS, HLT /ADD TLS; AC=TLS-11=KIE 4561 17763 3360 DCA KL8KIE /SET NEW KIE INSTRUCTION 4562 17764 2362 ISZ KL8TLS /SET UP TO ADD NEXT USER'S TLS INSTR. 4563 17765 2373 ISZ KL8CTR /MORE KEYBOARDS TO TURN ON? 4564 17766 5357 JMP KL8LP /YES: GO DO IT 4565 17767 1375 TAD KL8US0 /NO 4566 17770 3776 DCA I KL8LK /RESET USER STATUS POINTER IN FLD 0 4567 17771 6202 CIF 4568 17772 5777 JMP I KL8RET /CONTINUE WITH THE SCHEDULER IN FLD 0 4569 17773 0000 KL8CTR, 0 /COUNT # OF USERS TO BE TURNED ON 4570 17774 1077 KL8TAD, TAD INTRPL /TAD INSTRUCTION TO REFERENCE TLS LIST 4571 17775 3747 KL8US0, USER0 /POINTER TO USER STATUS LIST 4572 17776 0112 KL8LK, LOOK /POINTER TO POINTER TO USER STATUS 4573 17777 0213 KL8RET, KL8LFL+1 /PLACE IN SCHEDULER TO RETURN TO 4574 PAGE 0 4575 4576 /USER FIELD DEFINITIONS 4577 4578 10000 7763 7763 /CR,S -1 4579 10001 6457 6457 /TO 4580 10002 6040 6040 /P@ 4581 10003 7745 7745 /CR,E 2 4582 10004 6262 6262 /RR 4583 10005 5762 5762 /OR 4584 10006 0040 0040 /SPACE,@ 4585 10007 7762 7762 /CR,R 6 4586 10010 4541 4541 /EA 4587 10011 4471 4471 /DY 4588 10012 7740 7740 /CR,@ 4589 10013 0051 0051 /SPACE,I 12 4590 10014 5600 5600 /N,SPACE 4591 10015 4000 4000 /@ 4592 10016 0444 0444 /$D 4593 10017 4554 4554 /EL 4594 10020 4564 4564 /ET 4595 10021 4544 4544 /ED 4596 10022 7740 7740 /CR,@ 4597 CONEND=. 4598 10023 1401 COMGOL, LET /LET OR UNKNOWN -41 4599 10024 3202 PRINT /PRINT -40 4600 10025 2535 GOTO /GO TO -37 4601 10026 1200 IF /IF -36 4602 10027 2535 GOTO /THEN -35 4603 10030 1400 FOR /FOR -34 4604 10031 2520 ERR520 /TO -33 4605 10032 2520 ERR520 /STEP -32 4606 10033 2375 NEXT /NEXT -31 4607 10034 1000 INPUT /INPUT -30 4608 10035 2512 CONT /DATA -27 4609 10036 1026 READ /READ -26 4610 10037 4253 GOSUB /GOSUB -25 4611 10040 4151 RETURN /RETURN -24 4612 10041 2512 CONT /DEF -23 4613 10042 2520 ERR520 /FN -22 4614 10043 4305 ON /ON -21 4615 10044 2512 CONT /REM -20 4616 10045 5270 LINPUT /LINPUT -17 4617 10046 2507 RESTOR /RESTORE -16 4618 10047 2512 CONT /DIM -15 4619 10050 1771 RANDOM /RANDOM -14 4620 10051 0440 READY /STOP -13 4621 10052 4302 END /END -12 4622 10053 2250 COMGO1, LIST /LIST -11 4623 10054 2461 RUN /RUN -10 4624 10055 2200 EDIT /EDIT -7 4625 10056 2237 DELET /DELETE -6 4626 10057 4272 BYE /SCRATCH -5 4627 10060 4272 BYE /NEW -4 4628 10061 4272 BYE /BYE -3 4629 10062 5102 KKEY /KEY -2 4630 10063 5101 TAPE /TAPE -1 4631 4632 10064 0000 AUSER, 0 /0 FOR 1 USER,4000 FOR 2,6000 FOR 3,ECT. 4633 10065 7777 MUSER, -1 /- NUMBER OF USERS 4634 4635 /TEMPORARY STORAGE DURING INTERRURPS 4636 10066 5000 SAVAC, USRLST /SAVED AC 4637 10067 0000 SAVF, 0 /SAVED FLAGS 4638 10070 0000 SAVRES, 0 /SAVED RESTART LOCATION 4639 10071 0000 SAVT3, 0 /SAVED T3 4640 10072 0000 SXREG3, 0 /SAVED XREG3 4641 10073 0000 SSRTCN, 0 /SAVED SORTCN 4642 10074 0000 SAXUDF, 0 /SAVED UDF ADDRESS 4643 10075 0000 SSORTC, 0 /SAVED SORTC ADDRESS 4644 10076 0000 SXFREE, 0 /SAVED XFREE ADDRESS AND SUBROUTINE HEAD 4645 4646 10077 6046 INTRPL, TLS /USER 0 TLS IOT 4647 10100 6126 MTLS /USER 1 TLS IOT 4648 10101 6126 MTLS /USER 2 TLS IOT 4649 10102 6126 MTLS /USER 3 TLS IOT 4650 10103 6126 MTLS /USER 4 TLS IOT 4651 10104 6126 MTLS /USER 5 TLS IOT 4652 10105 6126 MTLS /USER 6 TLS IOT 4653 10106 6126 MTLS /USER 7 TLS IOT 4654 4655 10107 5476 JMP I INTRPL-1 /EXIT FROM SUBR. OF USER TLS'S 4656 4657 /THESE DEFS ARE SO THE INITIALIZER CAN USE SOME HANDY 4658 /PAGE ZERO LOCATIONS 4659 USRPTR=SAVAC 4660 CORPTR=SAVF 4661 USRPT2=SAVRES 4662 CORPT2=SAVT3 4663 BEGUSR=MUSER 4664 CURFLD=AUSER 4665 BEGDEV=SXREG3 4666 USRCTR=SSRTCN 4667 SS=SAXUDF 4668 BEGCOR=SSORTC 4669 KLTOP=SXFREE 4670 4671 /INTERRUPT HANDLER 4672 10110 3066 INTR81, DCA SAVAC /SAVE AC 4673 /JUST IN CASE THERE IS A CARD READER, 4674 10111 6634 RCRB /(6634) READ CARD READER TO CLEAR FLAG 4675 10112 6674 RCRD /(6674) ALSO CLEAR CARD DONE FLAG 4676 10113 7210 CLA RAR /WIPE OUT GARBAGE IN AC AND GET LINK INTO AC0 4677 10114 6234 RIB /GET USER FIELD INFO INTO AC 4678 10115 3067 DCA SAVF /SAVE AS FLAGS 4679 10116 1577 TAD I [0 /GET RESTART LOC 4680 10117 3070 DCA SAVRES /AND SAVE 4681 10120 6102 SPL /POWER FAILURE INTERRUPT? 4682 10121 5576 JMP I [INTR82 /NO: CHECK USER TTY'S 4683 10122 3577 DCA I [0 /YES: SET UP RESTART SEQUENCE 4684 10123 1175 TAD [JMP INTRRV 4685 10124 3574 DCA I [2 /FIELD 0;*0;AND 0;CIF 10;JMP INTRRV 4686 10125 7402 HLT /NOW JUST STOP AND WAIT FOR THE END 4687 4688 /POWER UP RECOVERY SEQUENCE 4689 10126 6007 INTRRV, CAF /CLEAR ALL ON RECOVERY 4690 10127 1064 TAD AUSER 4691 10130 6117 MTON /PDP-8/L: TURN ON ALL USERS 4692 10131 7301 L0001 4693 10132 6115 MINT /PDP-8/L: ENABLE INTERRUPTS 4694 10133 7200 CLA /WIPE OUT GARBAGE IN AC 4695 10134 1173 TAD [212 /ASCII FOR LINE FEED 4696 10135 7000 NOP /BECOMES TLS IF PDP-8/L 4697 10136 4076 JMS INTRPL-1 /SEND LF TO ALL (BECOMES MTLS IF PDP-8/L) 4698 10137 7200 CLA /WIPE OUT THE 212 4699 10140 6041 INTRV2, TSF /DELAY UNTIL CONSOLE TTY IS FINISHED 4700 10141 5151 JMP INTRV1 /BUT WE MUST BE READY FOR ANOTHER FAILURE 4701 10142 1172 TAD [JMP INTR81 /INTR81 IS NORMAL INTERRUPT PROCESSOR 4702 10143 3574 DCA I [2 /RESTORE NORMAL INTERRUPT SEQUENCE 4703 10144 1067 TAD SAVF /PREPARE TO RESUME EDU200 4704 10145 6005 RTF /RESTORE LINK,CORE FIELD INFORMATION 4705 10146 7200 CLA 4706 10147 1066 TAD SAVAC /RESTORE AC 4707 10150 5470 JMP I SAVRES /RESUME TIMESHARING 4708 10151 6102 INTRV1, SPL /ANOTHER POWER FAILURE? 4709 10152 5140 JMP INTRV2 /NO: CONTINUE DELAYING 4710 10153 7402 HLT /YES: JUST GIVE UP AGAIN NOW 4711 PAGE 4712 /USER TTY INTERRUPT HANDLER 4713 10200 1777 INTR82, TAD I (T3 /SAVE ANYTHING INTERRUPT ROUTINE CHANGES 4714 10201 3071 DCA SAVT3 /SAVE T3 4715 10202 1776 TAD I (XREG3 4716 10203 3072 DCA SXREG3 /SAVE XREG3 4717 10204 1775 TAD I (SORTCN 4718 10205 3073 DCA SSRTCN /SAVE SORTCN 4719 10206 1774 TAD I (XUDF 4720 10207 3074 DCA SAXUDF /SAVE UDF ADDRESS 4721 10210 1773 TAD I (XSORTC 4722 10211 3075 DCA SSORTC /SAVE SORTC ADDRESS 4723 10212 1772 TAD I (XFREE 4724 10213 3076 DCA SXFREE /SAVE XFREE ADDRESS 4725 10214 3771 DCA I (USER /START AT USER 0 4726 10215 3770 DCA I (TEMP1 /NO TTY'S TO TURN ON AT FIRST 4727 10216 1367 TAD (TAD INTRPL 4728 10217 3220 DCA INTRP1 /SET LIST REFERENCE INSTRUCTION 4729 10220 7402 INTRP1, HLT /GET TLS IOT 4730 10221 1366 TAD (-15 4731 10222 3234 DCA INTRP2 /SET KSF IOT 4732 10223 1234 TAD INTRP2 4733 10224 1305 TAD C10 4734 10225 3246 DCA INTRP3 /KSF IOT +10 = TSF IOT 4735 10226 1246 TAD INTRP3 4736 10227 7001 IAC 4737 10230 3250 DCA INTRP4 /TSF IOT + 1 = TCF IOT 4738 10231 1770 TAD I (TEMP1 4739 10232 6117 MTON /IF PDP-8/L, TURN ON PROPER USER 4740 10233 7200 CLA /CLEAR GARBAGE 4741 10234 7402 INTRP2, HLT /KEYBOARD INTERRUPT? 4742 10235 5240 JMP .+3 /NO 4743 10236 6202 CIF /KEY ROUTINE IS IN FIELD 0 4744 10237 4765 JMS I (KEY /READ TTY 4745 10240 1770 TAD I (TEMP1 4746 10241 6117 MTON /TURN THE USER ON AGAIN 4747 10242 7110 CLL RAR /SHIFT FOR NEXT USER 4748 10243 7450 SNA /FIRST TIME THROUGH? 4749 10244 7330 L4000 /YES: GET TTY #1 BIT 4750 10245 3770 DCA I (TEMP1 4751 10246 7402 INTRP3, HLT /TELEPRINTER INTERRUPT? 4752 10247 5253 JMP .+4 /NO 4753 10250 7402 INTRP4, HLT /CLEAR ITS FLAG 4754 10251 6202 CIF /SERVICE ROUTINE IS IN FIELD 0 4755 10252 4764 JMS I (TTY /DO TTY OUTPUT 4756 10253 2771 ISZ I (USER /NEXT USER 4757 10254 2220 ISZ INTRP1 /SET TO GET NEXT USER'S TLS IOT 4758 10255 1771 TAD I (USER 4759 10256 1065 TAD MUSER /MINUS THE NUMBER OF USERS 4760 10257 7640 SZA CLA /ARE WE DONE? 4761 10260 5220 JMP INTRP1 /NO 4762 10261 1064 INTRP5, TAD AUSER /BIT PATTERN FOR ALL USERS 4763 10262 6117 MTON /TURN ALL USERS ON AGAIN 4764 10263 7301 L0001 4765 10264 6115 MINT /WITH INTERRUPTS 4766 10265 7200 CLA 4767 10266 6203 CIF CDF /PUT RUNNING USER "ON DECK" 4768 10267 5763 JMP I (F0DCKN 4769 10270 1071 INTRP6, TAD SAVT3 /RESTORE ALL THOSE SAVED THINGS 4770 10271 3777 DCA I (T3 4771 10272 1072 TAD SXREG3 4772 10273 3776 DCA I (XREG3 4773 10274 1073 TAD SSRTCN 4774 10275 3775 DCA I (SORTCN 4775 10276 1074 TAD SAXUDF 4776 10277 3774 DCA I (XUDF 4777 10300 1075 TAD SSORTC 4778 10301 3773 DCA I (XSORTC 4779 10302 1076 TAD SXFREE 4780 10303 3772 DCA I (XFREE 4781 10304 2762 ISZ I (INTCNT /COUNT INTERRUPTS FOR RANDOMIZE STATEMENT 4782 10305 0010 C10, 10 /A HARMLESS CONSTANT THAT BUFFERS THE ISZ 4783 10306 1067 TAD SAVF 4784 10307 6005 RTF /RESTORE LINK, CORE FIELD INFORMATION 4785 10310 7200 CLA 4786 10311 1066 TAD SAVAC 4787 10312 5470 JMP I SAVRES /RESUME EDU200 4788 10362 7751 PAGE 10363 0365 10364 0730 10365 0600 10366 7763 10367 1077 10370 0005 10371 0003 10372 1323 10373 7624 10374 3567 10375 0101 10376 0012 10377 0104 4789 /KEYWORD DECODER (*COMMAN* ROUTINE) 4790 10400 1343 MANCOM, TAD LIST1 /START OF KEYWORD LIST 4791 10401 3275 DCA KLU6 /POINTER TO KEYWORD LIST 4792 10402 1377 TAD (-41 /-NUMBER OF KEYWORDS 4793 10403 3270 DCA KLU1 /KEYWORD NUMBER COUNTER 4794 10404 1776 TAD I (AXOUT /SAVE TEXT POINTERS QUICKLY 4795 10405 3271 DCA KLU2 /SAVED AXOUT 4796 10406 1775 TAD I (GTEM 4797 10407 3272 DCA KLU3 /SAVED GTEM 4798 10410 1774 TAD I (XCT 4799 10411 3273 DCA KLU4 /SAVE XCT 4800 10412 1773 TAD I (CHAR 4801 10413 3274 DCA KLU5 /SAVED CHAR 4802 10414 1275 COM1, TAD KLU6 /GET KEYWORD LIST POINTER 4803 10415 3267 DCA KLU /POINT TO KEYWORD TEXT 4804 10416 6211 CDF 10 /THE KEYWORD LIST IS IN FIELD 1 4805 10417 1675 TAD I KLU6 /GET POINTER TO NEXT KEYWORD 4806 10420 3275 DCA KLU6 /SAVE IN KEYWORD POINTER 4807 10421 2267 COM5, ISZ KLU /POINT TO NEXT 2 CHARS 4808 10422 1667 TAD I KLU /GET THE 2 CHARS 4809 10423 3277 DCA KLU8 /SAVE THEM 4810 10424 7340 L7777 4811 10425 3276 DCA KLU7 /INDICATE PARTIAL CHAR IN KLU8 4812 10426 1277 TAD KLU8 /GET THE 2 CHARS 4813 10427 7012 RTR /SHIFT THE LEFT HAND ONE INTO POSITION 4814 10430 7012 RTR 4815 10431 7012 RTR 4816 10432 5240 JMP COM6 /GO USE IT 4817 10433 6203 COM2, CIF CDF 0 /GETC ROUTINE IS IN FIELD 0 4818 10434 5772 JMP I (F0GETC /JMP TO FLD0 ROUTINE THAT CALLS GETC 4819 10435 2276 COM7, ISZ KLU7 /IS THERE A PARTIAL CHAR IN KLU8? 4820 10436 5221 JMP COM5 /NO: GET ONE, THEN 4821 10437 1277 TAD KLU8 /YES: GET IT 4822 10440 0371 COM6, AND (77 /CHOP OFF THE LEFT HAND GARBAGE 4823 10441 7450 SNA /END OF KEYWORD? 4824 10442 5264 JMP COM4 /YES: KEYWORD FOUND 4825 10443 1370 TAD (40 /ADJUST TO ASCII 4826 10444 7041 CIA 4827 10445 6201 CDF 0 4828 10446 1773 TAD I (CHAR /CHARACTOR FROM PROGRAM TEXT 4829 10447 7650 SNA CLA /MATCH? 4830 10450 5233 JMP COM2 /YES: TEST NEXT TWO CHARACTORS 4831 10451 1271 TAD KLU2 /NO: RESTORE TEXT POINTERS TO INITIAL STATE 4832 10452 3776 DCA I (AXOUT 4833 10453 1272 TAD KLU3 4834 10454 3775 DCA I (GTEM 4835 10455 1273 TAD KLU4 4836 10456 3774 DCA I (XCT 4837 10457 1274 TAD KLU5 4838 10460 3773 DCA I (CHAR 4839 10461 2270 ISZ KLU1 /INCREMENT KEYWORD COUNTER 4840 10462 5214 JMP COM1 /THERE ARE MORE KEYWORDS TO TRY 4841 10463 1377 TAD (-41 /NUMBER FOR UNKNOWN KEYWORD 4842 10464 1270 COM4, TAD KLU1 /GET KEYWORD NUMBER 4843 10465 6203 CIF CDF 0 /FOR RETURN TO FIELD 0 4844 10466 5767 JMP I (F0CMN1 /RETURN TO FIELD 0 4845 4846 10467 0000 KLU, 0 /KEYWORD TEXT UNPACK POINTER 4847 10470 0000 KLU1, 0 /KEYWORD NUMBER CONTER 4848 10471 0000 KLU2, 0 /SAVED AXOUT 4849 10472 0000 KLU3, 0 /SAVED GTEM 4850 10473 0000 KLU4, 0 /SAVED XCT 4851 10474 0000 KLU5, 0 /SAVED CHAR 4852 10475 0000 KLU6, 0 /POINTER TO NEXT KEYWORD 4853 10476 0000 KLU7, 0 /KEYWORD TEXT UNPACK FLAG 4854 10477 0000 KLU8, 0 /KEYWORD TEXT UNPACK PARTIAL CHARACTOR 4855 4856 4857 4858 /USED BY THE GETC ROUTINE 4859 10500 4071 XGETL2, XGET5-1 /CR 4860 10501 4066 XGET4-1 /BELL 4861 10502 4062 XGET3-1 /SPACE 4862 4863 /USED BY THE EDIT COMMAND 4864 10503 2232 MODL2, MODF5-1 /CR 4865 10504 2206 MODF2-1 /BELL 4866 10505 2224 MODF4-1 /RUBOUT 4867 10506 2224 MODF4-1 /BACK ARROW 4868 10507 2216 MODF1+2-1 /SEARCH CHARACTOR 4869 10510 2214 MODF1-1 /FORM FEED 4870 10511 2211 MODF3-1 /LINE FEED 4871 4872 10512 0176 ALT, 176 /3 CODES FOR ALTMODE 4873 10513 0175 175 4874 10514 0033 33 4875 10515 0015 F1CCR, 15 /CR 4876 10516 0007 7 /BELL 4877 10517 0177 177 /RUBOUT 4878 10520 0137 137 /BACK ARROW 4879 10521 7777 LSTMOD, -1 /LIST TERMINATOR OR SEARCH CHAR FOR EDIT 4880 10522 0014 14 /FORM FEED 4881 10523 0012 12 /LINE FEED 4882 4883 /LIST OF THIRD LETTERS OF THE FUNCTION NAMES 4884 10524 7662 FUNL2, -116 /SIN 4885 10525 7655 -123 /COS 4886 10526 7662 -116 /ATN 4887 10527 7660 -120 /EXP 4888 10530 7671 -107 /LOG 4889 10531 7655 -123 /ABS 4890 10532 7656 -122 /SQR 4891 10533 7662 -116 /SGN 4892 10534 7654 -124 /INT 4893 10535 7674 -104 /RND 4894 10536 7650 -130 /FIX 4895 10537 7662 -116 /TAN 4896 10540 7662 -116 /LEN 4897 10541 7674 -104 /MID 4898 10542 7654 -124 /CAT 4899 4900 /PART OF THE KEYWORD LIST 4901 10543 0600 LIST1, LIST43 /POINTER TO START OF LIST 4902 10544 6441 6441 /TA 4903 10545 6045 6045 /PE 4904 10546 0000 0000 /SPACE,SPACE 4905 4906 /SPECIAL KEYWORD LIST 4907 10547 0553 LISTCH, LISTTA 4908 10550 4350 4350 /CH 4909 10551 6204 LIST0, 6204 /R$ 4910 10552 0000 0000 /SPACE,SPACE 4911 10553 0551 LISTTA, LIST0 4912 10554 6441 6441 /TA 4913 10555 4200 4200 /B,SPACE 4914 10567 1764 PAGE 10570 0040 10571 0077 10572 0372 10573 0026 10574 0021 10575 0020 10576 0017 10577 7737 4915 /KEYWORD LIST 4916 10600 0603 LIST43, LIST40 /LINK TO NEXT KEYWORD 4917 10601 5445 5445 /LE 4918 10602 6400 6400 /T,SPACE 4919 10603 0607 LIST40, LIST37 4920 10604 6062 6062 /PR 4921 10605 5156 5156 /IN 4922 10606 6400 6400 /T,SPACE 4923 10607 0613 LIST37, LIST36 4924 10610 4757 4757 /GO 4925 10611 6457 6457 /TO 4926 10612 0000 0000 /SPACE,SPACE 4927 10613 0616 LIST36, LIST35 4928 10614 5146 5146 /IF 4929 10615 0000 0000 /SPACE,SPACE 4930 10616 0622 LIST35, LIST34 4931 10617 6450 6450 /TH 4932 10620 4556 4556 /EN 4933 10621 0000 0000 /SPACE,SPACE 4934 10622 0625 LIST34, LIST33 4935 10623 4657 4657 /FO 4936 10624 6200 6200 /R,SPACE 4937 10625 0630 LIST33, LIST32 4938 10626 6457 6457 /TO 4939 10627 0000 0000 /SPACE,SPACE 4940 10630 0634 LIST32, LIST31 4941 10631 6364 6364 /ST 4942 10632 4560 4560 /EP 4943 10633 0000 0000 /SPACE,SPACE 4944 10634 0640 LIST31, LIST30 4945 10635 5645 5645 /NE 4946 10636 7064 7064 /XT 4947 10637 0000 0000 /SPACE,SPACE 4948 10640 0644 LIST30, LIST27 4949 10641 5156 5156 /IN 4950 10642 6065 6065 /PU 4951 10643 6400 6400 /T,SPACE 4952 10644 0650 LIST27, LIST26 4953 10645 4441 4441 /DA 4954 10646 6441 6441 /TA 4955 10647 0000 0000 /SPACE,SPACE 4956 10650 0654 LIST26, LIST25 4957 10651 6245 6245 /RE 4958 10652 4144 4144 /AD 4959 10653 0000 0000 /SPACE,SPACE 4960 10654 0660 LIST25, LIST24 4961 10655 4757 4757 /GO 4962 10656 6365 6365 /SU 4963 10657 4200 4200 /B,SPACE 4964 10660 0665 LIST24, LIST23 4965 10661 6245 6245 /RE 4966 10662 6465 6465 /TU 4967 10663 6256 6256 /RN 4968 10664 0000 0000 /SPACE,SPACE 4969 10665 0670 LIST23, LIST22 4970 10666 4445 4445 /DE 4971 10667 4600 4600 /F,SPACE 4972 10670 0673 LIST22, LIST21 4973 10671 4656 4656 /FN 4974 10672 0000 0000 /SPACE,SPACE 4975 10673 0676 LIST21, LIST20 4976 10674 5756 5756 /ON 4977 10675 0000 0000 /SPACE,SPACE 4978 10676 0701 LIST20, LIST17 4979 10677 6245 6245 /RE 4980 10700 5500 5500 /M,SPACE 4981 10701 0706 LIST17, LIST16 4982 10702 5451 5451 /LI 4983 10703 5660 5660 /NP 4984 10704 6564 6564 /UT 4985 10705 0000 0000 /SPACE,SPACE 4986 10706 0713 LIST16, LIST15 4987 10707 6245 6245 /RE 4988 10710 6364 6364 /ST 4989 10711 5762 5762 /OR 4990 10712 4500 4500 /E,SPACE 4991 10713 0716 LIST15, LIST14 4992 10714 4451 4451 /DI 4993 10715 5500 5500 /M,SPACE 4994 10716 0723 LIST14, LIST13 4995 10717 6241 6241 /RA 4996 10720 5644 5644 /ND 4997 10721 5755 5755 /OM 4998 10722 0000 0000 /SPACE,SPACE 4999 10723 0727 LIST13, LIST12 5000 10724 6364 6364 /ST 5001 10725 5760 5760 /OP 5002 10726 0000 0000 /SPACE,SPACE 5003 10727 0732 LIST12, LIST11 5004 10730 4556 4556 /EN 5005 10731 4400 4400 /D,SPACE 5006 10732 0736 LIST11, LIST10 5007 10733 5451 5451 /LI 5008 10734 6364 6364 /ST 5009 10735 0000 0000 /SPACE,SPACE 5010 10736 0741 LIST10, LIST7 5011 10737 6265 6265 /RU 5012 10740 5600 5600 /N,SPACE 5013 10741 0745 LIST7, LIST6 5014 10742 4544 4544 /ED 5015 10743 5164 5164 /IT 5016 10744 0000 0000 /SPACE,SPACE 5017 10745 0752 LIST6, LIST5 5018 10746 4445 4445 /DE 5019 10747 5445 5445 /LE 5020 10750 6445 6445 /TE 5021 10751 0000 0000 /SPACE,SPACE 5022 10752 0757 LIST5, LIST4 5023 10753 6343 6343 /SC 5024 10754 6241 6241 /RA 5025 10755 6443 6443 /TC 5026 10756 5000 5000 /H,SPACE 5027 10757 0762 LIST4, LIST3 5028 10760 5645 5645 /NE 5029 10761 6700 6700 /W,SPACE 5030 10762 0765 LIST3, LIST2 5031 10763 4271 4271 /BY 5032 10764 4500 4500 /E,SPACE 5033 10765 0543 LIST2, LIST1 5034 10766 5345 5345 /KE 5035 10767 7100 7100 /Y,SPACE 5036 /A WHOLE BUNCH OF SORTC AND SORTJ LISTS 5037 5038 /USED BY THE EDIT COMMAND 5039 10770 2232 MODL1, MODF5-1 /CR 5040 10771 2222 MODF1+5 /BELL 5041 /USED BY THE PRINT STATEMENT 5042 10772 3346 PRINL2, PRIN71-1 /CR 5043 10773 3341 PRIN61-1 /" 5044 /CONTINUATION OF MODL1 5045 10774 2224 MODF4-1 /SEARCH CHARACTOR 5046 5047 /USED BY THE PRINT STATEMENT 5048 10775 0073 PRINL, 73 /; 5049 10776 0054 54 /, 5050 10777 0047 47 /' 5051 11000 0072 72 /: 5052 11001 0015 PRINLB, 15 /CR 5053 11002 0042 42 /" 5054 11003 7777 7777 5055 5056 11004 3177 PRINL1, PRINT5-1 /; 5057 11005 3324 PRINT4-1 /, 5058 11006 3343 PRINT7-1 /' 5059 11007 3343 PRINT7-1 /: 5060 11010 3343 PRINT7-1 /CR 5061 11011 3330 PRINT6-1 /" 5062 5063 /LIST OF STANDARD EDU200 BASIC TERMINATORS 5064 11012 0040 TERMS, 40 /SPACE 0 5065 11013 0053 53 /+ 1 5066 11014 0055 55 /- 2 5067 11015 0052 52 /* 3 5068 11016 0057 57 // 4 5069 11017 0136 136 /^ 5 5070 11020 0050 50 /( 6 5071 11021 0133 133 /[ 7 5072 11022 0051 51 /) 10 5073 11023 0135 135 /] 11 5074 11024 0074 74 /< 12 5075 11025 0076 76 /> 13 5076 11026 0075 75 /= 14 5077 11027 7777 7777 5078 5079 /USED BY THE GETC ROUTINE 5080 11030 0137 XGETL1, 137 /CR 5081 11031 0100 100 /BELL 5082 11032 0040 40 /SPACE 5083 11033 7777 7777 5084 5085 /USED BY THE PACKC ROUTINE 5086 11034 0015 XPAKL1, 15 /CR 5087 11035 0007 7 /BELL 5088 11036 0177 177 /RUBOUT 5089 11037 0137 137 /BACK ARROW 5090 11040 0176 176 /3 CODES FOR ALTMODE 5091 11041 0175 175 5092 11042 0033 33 5093 11043 0100 100 /@ 5094 11044 7777 7777 5095 5096 11045 3626 XPAKL2, XPACK2-1 /CR 5097 11046 3627 XPACK3-1 /BELL 5098 11047 3636 XPACK7-1 /RUBOUT 5099 11050 3636 XPACK7-1 /BACK ARROW 5100 11051 3664 XPPCK1-1 /3 ALTMODES 5101 11052 3664 XPPCK1-1 5102 11053 3664 XPPCK1-1 5103 11054 3607 XPACK5-1 /@ 5104 5105 /FIRST 2 CHARACTORS OF THE FUNCTION NAMES (USED BY GETVAR) 5106 11055 0316 FUNL1, 316 /FN 5107 11056 1151 1151 /SI 5108 11057 0157 157 /CO 5109 11060 0064 64 /AT 5110 11061 0270 270 /EX 5111 11062 0617 617 /LO 5112 11063 0042 42 /AB 5113 11064 1161 1161 /SQ 5114 11065 1147 1147 /SG 5115 11066 0456 456 /IN 5116 11067 1116 1116 /RN 5117 11070 0311 311 /FI 5118 11071 1201 1201 /TA 5119 11072 0605 14^40+5 /LE 5120 11073 0651 15^40+11 /MI 5121 11074 0141 3^40+1 /CA 5122 11075 7777 7777 5123 5124 /USED BY THE IF STATEMENT 5125 11076 0001 IF4, 1 /< 5126 11077 0005 5 /> 5127 11100 0011 11 /= 5128 11101 0004 4 /<= 5129 11102 0010 10 />= 5130 11103 0003 3 /<> 5131 11104 7777 7777 5132 5133 /LIST OF ERROR ADDRESSES (USED BY THE ERROR ROUTINE) 5134 11105 0616 ERRLST, ERR004 /STOP (CONTROL-C) 5135 11106 5670 ERR010 /ERROR 1 5136 11107 6261 ERR020 /ERROR 2 5137 11110 6552 ERR030 5138 11111 6146 ERR040 5139 11112 3607 ERR060 5140 11113 0711 ERR070 5141 11114 3442 ERR080 5142 11115 4500 ERR100 5143 11116 7235 ERR150 5144 11117 2760 ERR110 5145 11120 2663 ERR120 5146 11121 5010 ERR260 5147 11122 4401 ERR220 5148 11123 4461 ERR130 5149 11124 4555 ERR230 5150 11125 3051 ERR170 5151 11126 4714 ERR250 5152 11127 5120 ERR210 5153 11130 3136 ERR200 5154 11131 3076 ERR180 5155 11132 4705 ERR240 5156 11133 1410 ERR410 5157 11134 1521 ERR450 5158 11135 1535 ERR430 5159 11136 1432 ERR420 5160 11137 1457 ERR440 5161 11140 2401 ERR460 5162 11141 2407 ERR470 5163 11142 3210 ERR350 5164 11143 3357 ERR340 5165 11144 2537 ERR270 5166 11145 7310 ERR370 5167 11146 2541 ERR380 5168 11147 1210 ERR390 5169 11150 1243 ERR400 5170 11151 1121 ERR500 5171 11152 1070 ERR490 5172 11153 1033 ERR510 5173 11154 4152 ERR320 5174 11155 3572 ERR330 5175 11156 4312 ERR300 5176 11157 5274 ERR280 5177 11160 2520 ERR520 5178 11161 2204 ERR001 5179 11162 4273 ERR002 5180 11163 5104 ERR003 5181 11164 5203 ERRBEX /SYNTAX ERROR IN AN EXPRESSION 5182 11165 2055 ERRSAR /MISSING ARGUMENT TO MID OR CAT FUNCTION 5183 11166 2046 ERRSOV /STRING OVERFLOW IN MID FUNCTION 5184 ERREND=. 5185 11167 7777 7777 5186 5187 ORG=. 5188 5189 IFDEF CONFIG < 5190 ENPUNCH 5191 FIELD 0 5192 5193 *SIN 5194 0 5195 *LOOK 5196 USER0-1 5197 *KL8JMP 5198 TAD LOOKST 5199 DCA LOOK 5200 SKP 5201 *MLOOKE 5202 -USER7+10 5203 *XOUTL6-3 5204 MTON 5205 *XOUTL6+3 5206 MTON 5207 *XOUTL6+5 5208 MINT 5209 *USER0 5210 0 5211 1 5212 2 5213 3 5214 4 5215 5 5216 6 5217 7 5218 *DECKON 5219 NULL+1 5220 *DFIND 5221 ENTRY1 5222 NOPUNCH 5223 > 5224 /USER DEFINITIONS 5225 5226 LIMIT=7776 /HIGHEST CORE POSITION 5227 SWAPR=ENSWAP-STSWAP+1 /SWAP LENGTH 5228 5229 BUFFER=ORG+SWAPR+40 5230 BUFCOM=ORG+SWAPR+100 5231 LINE0=ORG+SWAPR+162 5232 LINE1=ORG+SWAPR+164 5233 TOP=LIMIT 5234 10172 5110 FIELD 1 10173 0212 10174 0002 10175 5126 10176 0200 10177 0000 5235 5236 *1200 5237 5238 11200 1773 MONDSK, 1773 5239 11201 3772 3772 5240 11202 2372 2372 5241 11203 2373 2373 5242 11204 5356 5356 5243 11205 1371 1371 5244 11206 3350 3350 5245 11207 1371 1371 5246 11210 3351 3351 5247 11211 5770 5770 5248 11212 7573 7573 5249 11213 7576 7576 5250 11214 7573 7573 5251 11215 7774 7774 5252 11216 6603 6603 5253 11217 6622 6622 5254 11220 5374 5374 5255 11221 7610 7610 5256 5257 11222 1774 MONTAP, 1774 5258 11223 3773 3773 5259 11224 2373 2373 5260 11225 2374 2374 5261 11226 5356 5356 5262 11227 3354 3354 5263 11230 1372 1372 5264 11231 3355 3355 5265 11232 1371 1371 5266 11233 5770 5770 5267 11234 7575 7575 5268 11235 0220 0220 5269 11236 7577 7577 5270 11237 7575 7575 5271 11240 7775 7775 5272 11241 6766 6766 5273 11242 6771 6771 5274 11243 5376 5376 5275 5276 11244 1377 OSDRK8, 1377 5277 11245 3030 3030 5278 11246 1376 1376 5279 11247 3031 3031 5280 11250 5030 5030 5281 11251 0000 0 5282 11252 0000 0 5283 11253 0000 0 5284 11254 0000 0 5285 11255 0000 0 5286 11256 0000 0 5287 11257 0000 0 5288 11260 0000 0 5289 11261 0000 0 5290 11262 0000 0 5291 11263 0000 0 5292 11264 5031 5031 5293 11265 6733 6733 5294 5295 11266 1772 OSDDSK, 1772 5296 11267 3771 3771 5297 11270 2371 2371 5298 11271 2372 2372 5299 11272 5356 5356 5300 11273 5350 5350 5301 11274 0000 0 5302 11275 0000 0 5303 11276 0000 0 5304 11277 0000 0 5305 11300 0000 0 5306 11301 7750 7750 5307 11302 7773 7773 5308 11303 7600 7600 5309 11304 6603 6603 5310 11305 6622 6622 5311 11306 5352 5352 5312 11307 5752 5752 5313 5314 11310 6774 OSDDTA, 6774 5315 11311 1377 1377 5316 11312 3354 3354 5317 11313 1376 1376 5318 11314 3355 3355 5319 11315 1375 1375 5320 11316 6766 6766 5321 11317 6771 6771 5322 11320 5365 5365 5323 11321 1374 1374 5324 11322 6766 6766 5325 11323 6771 6771 5326 11324 5371 5371 5327 11325 5200 5200 5328 11326 0220 220 5329 11327 0600 600 5330 11330 7577 7577 5331 11331 7700 7700 5332 5333 11332 1114 OS8ERM, TEXT %ILLEGAL OS/8 DEVICE FOUND_CAN'T SAVE BOOTSTRAP__% 11333 1405 11334 0701 11335 1440 11336 1723 11337 5770 11340 4004 11341 0526 11342 1103 11343 0540 11344 0617 11345 2516 11346 0437 11347 0301 11350 1647 11351 2440 11352 2301 11353 2605 11354 4002 11355 1717 11356 2423 11357 2422 11360 0120 11361 3737 11362 0000 5334 11363 3737 OS8MSG, TEXT %__TO BOOTSTRAP BACK % 11364 2417 11365 4002 11366 1717 11367 2423 11370 2422 11371 0120 11372 4002 11373 0103 11374 1340 11375 0000 5335 11376 1723 OS8M1, TEXT %OS/8% 11377 5770 11400 0000 5336 11401 4015 OS8M2, TEXT % MONITOR:_ LOAD ADDRESS 07600_ AND START__% 11402 1716 11403 1124 11404 1722 11405 7237 11406 4040 11407 1417 11410 0104 11411 4001 11412 0404 11413 2205 11414 2323 11415 4060 11416 6766 11417 6060 11420 3740 11421 4001 11422 1604 11423 4023 11424 2401 11425 2224 11426 3737 11427 0000 5337 11430 0411 DISKMM, TEXT %DISK% 11431 2313 11432 0000 5338 11433 2401 TAPMM, TEXT %TAPE% 11434 2005 11435 0000 5339 *1600 5340 5341 11600 6211 BEGOS8, CDF 10 5342 11601 1777 TAD I (7760 /GET DCB OF SYS: 5343 11602 0376 AND (770 5344 11603 1375 TAD (-050 /5 IS RK8 5345 11604 7510 SPA 5346 11605 5215 JMP OS8ERR /<5 IS ERROR 5347 11606 7450 SNA 5348 11607 5227 JMP OS8RK8 /5 = RK8 5349 11610 1374 TAD (050-160 /16 IS DECTAPE 5350 11611 7510 SPA 5351 11612 5221 JMP OS8KSK /6 TO 15 = DSK 5352 11613 7650 SNA CLA 5353 11614 5226 JMP OS8DTA /16 = DTA: 5354 11615 7200 OS8ERR, CLA 5355 11616 4773 JMS I (BEG003 5356 11617 1332 OS8ERM /BAD OS8 DEVICE 5357 11620 5772 JMP I (BEGMV4 /DO NOT SET UP ANYTHING 5358 5359 11621 7200 OS8KSK, CLA 5360 11622 5225 JMP OS8DSK 5361 5362 11623 7001 IAC 5363 11624 7001 IAC 5364 11625 7001 OS8DSK, IAC 5365 11626 7001 OS8DTA, IAC 5366 11627 7001 OS8RK8, IAC 5367 11630 1371 TAD (OS8LST-1 5368 11631 3253 DCA OS8PTR 5369 11632 1653 TAD I OS8PTR 5370 11633 3253 DCA OS8PTR /POINT TO BOOTSTRAP 5371 11634 6211 OS8LP1, CDF 10 5372 11635 1653 TAD I OS8PTR 5373 11636 2253 ISZ OS8PTR 5374 11637 6201 CDF 5375 11640 3654 DCA I OS8PT2 5376 11641 2254 ISZ OS8PT2 5377 11642 5234 JMP OS8LP1 5378 11643 6211 CDF 10 5379 11644 4773 JMS I (BEG003 5380 11645 1363 OS8MSG /OS8 MESSAGE 5381 11646 4773 JMS I (BEG003 5382 11647 1376 OS8AB, OS8M1 5383 11650 4773 JMS I (BEG003 5384 11651 1401 OS8M2 5385 11652 5772 JMP I (BEGMV4 5386 5387 11653 0000 OS8PTR, 0 5388 11654 7756 OS8PT2, 7756 /INTO RIM LOCATIONS 5389 5390 11655 1244 OS8LST, OSDRK8 5391 11656 1310 OSDDTA 5392 11657 1266 OSDDSK 5393 11660 1200 MONDSK 5394 11661 1222 MONTAP 5395 5396 11662 6211 TAPEM, CDF 10 5397 11663 1370 TAD (600 5398 11664 6766 DTXA DTCA /REWIND TAPE 5399 11665 6771 DTSF 5400 11666 5265 JMP .-1 5401 11667 1367 TAD (TAPMM 5402 11670 3247 DCA OS8AB 5403 11671 5223 JMP OS8DSK-2 5404 5405 11672 6211 DISKM, CDF 10 5406 11673 1366 TAD (DISKMM 5407 11674 3247 DCA OS8AB 5408 11675 5224 JMP OS8DSK-1 5409 IFDEF CONFIG < 5410 PAGE 5411 5412 ENPUNCH 5413 FIELD 1 5414 > 5415 5416 11766 1430 *2000 11767 1433 11770 0600 11771 1654 11772 2003 11773 2425 11774 7670 11775 7730 11776 0770 11777 7760 5417 5418 12000 5203 BEGIN, JMP .+3 /NORMAL ENTRY 5419 12001 7000 NOP /SO YOU CAN CHAIN TO US 5420 IFDEF CONFIG < 5421 HLT /NO CONFIG FOR OS/8 5422 > 5423 IFNDEF CONFIG < 5424 12002 5777 JMP I (BEGOS8 /OS8 ENTRY POINT 5425 > 5426 12003 6211 BEGMV4, CDF 10 5427 12004 1731 TAD I BEGMV1 /MOVE PAGE 7600 FIELD 0 INTO ITS SPOT 5428 12005 6201 CDF 5429 12006 3732 DCA I BEGMV2 5430 12007 2331 ISZ BEGMV1 5431 12010 2332 ISZ BEGMV2 5432 12011 2333 ISZ BEGMV3 5433 12012 5203 JMP BEGMV4 5434 IFNDEF CONFIG < 5435 12013 1776 TAD I (FLOP 5436 12014 3775 DCA I (OPTABL+5 5437 > 5438 12015 6211 CDF 10 5439 12016 1727 TAD I BEGIN1 /MAKE SURE THAT NO ERRORS ARE NEG. SO THAT 5440 /THEY DON'T TERMINATE TABLE 5441 5442 12017 7001 IAC 5443 12020 7110 CLL RAR 5444 12021 3727 DCA I BEGIN1 5445 12022 2327 ISZ BEGIN1 5446 12023 2330 ISZ BEGIN2 5447 12024 5216 JMP .-6 5448 12025 6211 BEG002, CDF 10 5449 12026 6032 KCC 5450 12027 1374 TAD (BEGIOT 5451 12030 3325 DCA BEG012 5452 12031 1373 TAD (-4 5453 12032 3326 DCA BEG013 5454 12033 1372 TAD (120 5455 12034 3725 DCA I BEG012 5456 12035 2325 ISZ BEG012 5457 12036 2326 ISZ BEG013 5458 12037 5233 JMP .-4 5459 12040 4771 JMS I (BEG003 5460 12041 2506 BEGM1 /INIT MESSAGE 5461 12042 4771 BEG006, JMS I (BEG003 5462 12043 2516 BEGM2 /# USER MESSAGE 5463 12044 4770 JMS I (BEG001 5464 12045 1367 TAD (-"8 5465 12046 7540 SMA SZA 5466 12047 5766 JMP I (BEG005 5467 12050 1365 TAD (10 5468 12051 7550 SPA SNA 5469 12052 5766 JMP I (BEG005 5470 12053 7041 CIA 5471 12054 3065 DCA BEGUSR 5472 12055 5764 BEG008, JMP I (BEGX08 5473 12056 6211 CORDON, CDF 10 5474 12057 1065 TAD BEGUSR 5475 12060 7001 IAC 5476 12061 7650 SNA CLA 5477 12062 5277 JMP BEG010 5478 12063 4771 BEG009, JMS I (BEG003 5479 12064 2600 BEGM4 /DC02? 5480 12065 4770 JMS I (BEG001 5481 12066 1363 TAD (-"Y 5482 12067 7450 SNA 5483 12070 5300 JMP BEG010+1 5484 12071 1362 TAD (331-316 5485 12072 7650 SNA CLA 5486 12073 5277 JMP BEG010 5487 12074 4771 JMS I (BEG003 5488 12075 2474 BEGME 5489 12076 5263 JMP BEG009 5490 5491 12077 7340 BEG010, L7777 5492 12100 3072 DCA BEGDEV 5493 12101 1072 TAD BEGDEV 5494 12102 7650 SNA CLA 5495 12103 5761 JMP I (BEG011 5496 12104 1374 TAD (BEGIOT 5497 12105 3325 DCA BEG012 5498 12106 1065 TAD BEGUSR 5499 12107 3326 DCA BEG013 5500 12110 1360 TAD (410 5501 12111 3324 DCA BEG12A 5502 12112 2326 BEG14B, ISZ BEG013 5503 12113 5315 JMP BEG14A 5504 12114 5757 JMP I (BEG015 5505 5506 12115 1324 BEG14A, TAD BEG12A 5507 12116 3725 DCA I BEG012 5508 12117 2325 ISZ BEG012 5509 12120 1324 TAD BEG12A 5510 12121 1356 TAD (20 5511 12122 3324 DCA BEG12A 5512 12123 5312 JMP BEG14B 5513 5514 12124 0400 BEG12A, 400 5515 12125 0000 BEG012, 0 5516 12126 0000 BEG013, 0 5517 12127 1105 BEGIN1, ERRLST 5518 12130 7716 BEGIN2, ERRLST-ERREND 5519 12131 6000 BEGMV1, F0P37 5520 12132 7600 BEGMV2, 7600 5521 12133 7622 BEGMV3, -156 5522 12156 0020 PAGE 12157 2200 12160 0410 12161 3200 12162 0013 12163 7447 12164 2267 12165 0010 12166 2403 12167 7510 12170 2411 12171 2425 12172 0120 12173 7774 12174 7401 12175 4344 12176 2711 12177 1600 5523 5524 12200 1065 BEG015, TAD BEGUSR 5525 12201 7001 IAC 5526 12202 7650 SNA CLA 5527 12203 5777 JMP I (BEG011 5528 12204 4776 BEG15E, JMS I (BEG003 5529 12205 2633 BEGM7 /STANDARD? 5530 12206 4775 JMS I (BEG001 5531 12207 1374 TAD (-"Y 5532 12210 7450 SNA 5533 12211 5777 JMP I (BEG011 5534 12212 1373 TAD (331-316 5535 12213 7650 SNA CLA 5536 12214 5220 JMP BEG15A 5537 12215 4776 JMS I (BEG003 5538 12216 2474 BEGME 5539 12217 5204 JMP BEG15E 5540 5541 12220 1065 BEG15A, TAD BEGUSR 5542 12221 3232 DCA BEG15B 5543 12222 1372 TAD (BEGIOT 5544 12223 3231 DCA BEG15C 5545 12224 1371 TAD (4361 /TEXT "#1" 5546 12225 3770 DCA I (BEGM5A 5547 12226 2232 BEG15D, ISZ BEG15B 5548 12227 5233 JMP BEG014 5549 12230 5777 JMP I (BEG011 5550 5551 12231 0000 BEG15C, 0 5552 12232 0000 BEG15B, 0 5553 5554 12233 4776 BEG014, JMS I (BEG003 5555 12234 2616 BEGM5 /DEVICE CODE 5556 12235 4775 JMS I (BEG001 5557 12236 1367 TAD (-"7 5558 12237 7540 SMA SZA 5559 12240 5766 JMP I (BEG016 5560 12241 1365 TAD (7 5561 12242 7510 SPA 5562 12243 5766 JMP I (BEG016 5563 12244 7106 CLL RTL 5564 12245 7006 RTL 5565 12246 7006 RTL 5566 12247 3631 DCA I BEG15C 5567 12250 4775 JMS I (BEG001 5568 12251 1367 TAD (-"7 5569 12252 7540 SMA SZA 5570 12253 5766 JMP I (BEG016 5571 12254 1365 TAD (7 5572 12255 7510 SPA 5573 12256 5766 JMP I (BEG016 5574 12257 7001 IAC 5575 12260 7106 CLL RTL 5576 12261 7004 RAL 5577 12262 1631 TAD I BEG15C 5578 12263 3631 DCA I BEG15C 5579 12264 2231 ISZ BEG15C 5580 12265 2770 ISZ I (BEGM5A 5581 12266 5226 JMP BEG15D 5582 /FIGURE OUT HIGHEST CORE FIELD FOR HIM 5583 12267 7301 BEGX08, L0001 5584 12270 3075 DCA BEGCOR /FIELD 1 TOP TO START WITH 5585 12271 1364 TAD (6221 5586 12272 3301 DCA BEGCHK 5587 12273 1304 TAD CNOP 5588 12274 6201 CDF 5589 12275 3763 DCA I (0 5590 12276 6211 CDF 10 5591 12277 1304 TAD CNOP 5592 12300 3763 DCA I (0 5593 12301 0000 BEGCHK, 0 5594 12302 1362 TAD (1000 5595 12303 3763 DCA I (0 5596 12304 7000 CNOP, NOP 5597 12305 1763 TAD I (0 5598 12306 7410 SKP /PDP-8 NXM BUG 5599 12307 7402 HLT /THIS SHOULD HAUL DOWN A PDP-8 5600 12310 6211 CDF 10 /DOUBLE CHECK FOR PDP8/L 5601 12311 1763 TAD I (0 5602 12312 7640 SZA CLA 5603 12313 5761 JMP I (CORDON /NO MORE CORE 5604 12314 1362 TAD (1000 5605 12315 6201 CDF 5606 12316 1763 TAD I (0 5607 12317 7640 SZA CLA 5608 12320 5761 JMP I (CORDON /NO MORE CORE-PROBABLY A PDP-8/L 5609 12321 2075 ISZ BEGCOR /THIS FIELD WAS SUCCESSFUL 5610 12322 1301 TAD BEGCHK 5611 12323 1360 TAD (10 5612 12324 3301 DCA BEGCHK 5613 12325 5301 JMP BEGCHK 5614 12360 0010 PAGE 12361 2056 12362 1000 12363 0000 12364 6221 12365 0007 12366 2400 12367 7511 12370 2623 12371 4361 12372 7401 12373 0013 12374 7447 12375 2411 12376 2425 12377 3200 5615 5616 5617 12400 4225 BEG016, JMS BEG003 5618 12401 2474 BEGME 5619 12402 5777 JMP I (BEG014 5620 5621 12403 4225 BEG005, JMS BEG003 5622 12404 2474 BEGME 5623 12405 5776 JMP I (BEG006 5624 5625 12406 4225 BEG007, JMS BEG003 5626 12407 2474 BEGME 5627 12410 5775 JMP I (BEG008 5628 5629 12411 0000 BEG001, 0 5630 12412 6031 KSF 5631 12413 5212 JMP .-1 5632 12414 6036 KRB 5633 12415 1374 TAD (-203 5634 12416 7450 SNA 5635 12417 5773 JMP I (BEG002 5636 12420 1372 TAD (203 5637 12421 6046 TLS 5638 12422 6041 TSF 5639 12423 5222 JMP .-1 5640 12424 5611 JMP I BEG001 5641 5642 12425 0000 BEG003, 0 5643 12426 7200 CLA 5644 12427 1625 TAD I BEG003 5645 12430 3273 DCA BEG004 5646 12431 2225 ISZ BEG003 5647 12432 1673 TAD I BEG004 5648 12433 7112 CLL RTR 5649 12434 7012 RTR 5650 12435 7012 RTR 5651 12436 4243 JMS BEG03X 5652 12437 1673 TAD I BEG004 5653 12440 4243 JMS BEG03X 5654 12441 2273 ISZ BEG004 5655 12442 5232 JMP BEG003+5 5656 5657 12443 0000 BEG03X, 0 5658 12444 0371 AND (77 5659 12445 7450 SNA 5660 12446 5625 JMP I BEG003 5661 12447 1370 TAD (-37 5662 12450 7450 SNA 5663 12451 5267 JMP CRLF 5664 12452 7510 SPA 5665 12453 1367 TAD (100 5666 12454 1366 TAD (237 5667 12455 4257 JMS TTCHAR 5668 12456 5643 JMP I BEG03X 5669 5670 12457 0000 TTCHAR, 0 5671 12460 6046 TLS 5672 12461 7200 CLA 5673 12462 6041 TSF 5674 12463 5262 JMP .-1 5675 12464 6031 KSF 5676 12465 5657 JMP I TTCHAR 5677 12466 5625 JMP I BEG003 /EXIT ON CHAR. 5678 12467 1365 CRLF, TAD (215 5679 12470 4257 JMS TTCHAR 5680 12471 1364 TAD (212 5681 12472 5255 JMP TTCHAR-2 5682 12473 0000 BEG004, 0 5683 12474 3711 BEGME, TEXT %_INVALID RESPONSE_% 12475 1626 12476 0114 12477 1104 12500 4022 12501 0523 12502 2017 12503 1623 12504 0537 12505 0000 5684 12506 3737 BEGM1, TEXT "__EDU200 BASIC_" 12507 0504 12510 2562 12511 6060 12512 4002 12513 0123 12514 1103 12515 3700 5685 12516 3716 BEGM2, TEXT %_NUMBER OF USERS (1 TO 8)?% 12517 2515 12520 0205 12521 2240 12522 1706 12523 4025 12524 2305 12525 2223 12526 4050 12527 6140 12530 2417 12531 4070 12532 5177 12533 0000 5686 12564 0212 PAGE 12565 0215 12566 0237 12567 0100 12570 7741 12571 0077 12572 0203 12573 2025 12574 7575 12575 2055 12576 2042 12577 2233 5687 12600 3720 BEGM4, TEXT %_PDP-8/L COMPUTER (Y OR N)?% 12601 0420 12602 5570 12603 5714 12604 4003 12605 1715 12606 2025 12607 2405 12610 2240 12611 5031 12612 4017 12613 2240 12614 1651 12615 7700 5688 12616 3724 BEGM5, TEXT %_TELETYPE #1 DEVICE CODE?% 12617 0514 12620 0524 12621 3120 12622 0540 12623 4361 12624 4004 12625 0526 12626 1103 12627 0540 12630 0317 12631 0405 12632 7700 5689 BEGM5A=BEGM5+5 5690 12633 3723 BEGM7, TEXT %_STANDARD REMOTE TELETYPE CODES (Y OR N)?% 12634 2401 12635 1604 12636 0122 12637 0440 12640 2205 12641 1517 12642 2405 12643 4024 12644 0514 12645 0524 12646 3120 12647 0540 12650 0317 12651 0405 12652 2340 12653 5031 12654 4017 12655 2240 12656 1651 12657 7700 5691 12660 3706 BEGMFL, TEXT %_FIELD % 12661 1105 12662 1404 12663 4000 5692 12664 3724 BEGMXX, TEXT %_THERE ARE % 12665 1005 12666 2205 12667 4001 12670 2205 12671 4000 5693 12672 4002 BEGMX1, TEXT % BLOCKS LEFT IN THIS FIELD._ YOUR ALLOCATION FOR USER #% 12673 1417 12674 0313 12675 2340 12676 1405 12677 0624 12700 4011 12701 1640 12702 2410 12703 1123 12704 4006 12705 1105 12706 1404 12707 5637 12710 4031 12711 1725 12712 2240 12713 0114 12714 1417 12715 0301 12716 2411 12717 1716 12720 4006 12721 1722 12722 4025 12723 2305 12724 2240 12725 4300 5694 12726 4027 BEGTTI, TEXT % WILL BE HOW MANY BLOCKS?% 12727 1114 12730 1440 12731 0205 12732 4010 12733 1727 12734 4015 12735 0116 12736 3140 12737 0214 12740 1703 12741 1323 12742 7700 5695 12743 3737 BEGM6, TEXT %__END OF DIALOGUE_% 12744 0516 12745 0440 12746 1706 12747 4004 12750 1101 12751 1417 12752 0725 12753 0537 12754 0000 5696 12755 3702 WNGDM, TEXT %_BLOCK SIZES DON'T WORK--HAVE TO START AGAIN__% 12756 1417 12757 0313 12760 4023 12761 1132 12762 0523 12763 4004 12764 1716 12765 4724 12766 4027 12767 1722 12770 1355 12771 5510 12772 0126 12773 0540 12774 2417 12775 4023 12776 2401 12777 2224 13000 4001 13001 0701 13002 1116 13003 3737 13004 0000 5697 13005 3723 BEGMQ, TEXT %_SAME AMOUNT OF STORAGE FOR ALL USERS?% 13006 0115 13007 0540 13010 0115 13011 1725 13012 1624 13013 4017 13014 0640 13015 2324 13016 1722 13017 0107 13020 0540 13021 0617 13022 2240 13023 0114 13024 1440 13025 2523 13026 0522 13027 2377 13030 0000 5698 13031 3711 BEGM6A, TEXT %_IS THE ABOVE CORRECT (Y OR N)?% 13032 2340 13033 2410 13034 0540 13035 0102 13036 1726 13037 0540 13040 0317 13041 2222 13042 0503 13043 2440 13044 5031 13045 4017 13046 2240 13047 1651 13050 7700 5699 5700 PAGE 5701 13200 1065 BEG011, TAD BEGUSR 5702 13201 7001 IAC 5703 13202 7650 SNA CLA 5704 13203 5777 JMP I (BEGOLD /ONLY 1 USER, ASSUME ANSWER! 5705 13204 4776 JMS I (BEG003 5706 13205 3005 BEGMQ 5707 13206 4775 JMS I (BEG001 5708 13207 1374 TAD (-"N 5709 13210 7450 SNA 5710 13211 5773 JMP I (BEG500 /GO ASK FOR IT 5711 13212 1372 TAD (-"Y+"N 5712 13213 7650 SNA CLA 5713 13214 5777 JMP I (BEGOLD /THIS WAS AN AFTERTHOUGHT, QUITE FRANKLY 5714 13215 4776 JMS I (BEG003 5715 13216 2474 BEGME 5716 13217 5200 JMP BEG011 /ASK HIM AGIN 5717 5718 13372 7765 PAGE 13373 3403 13374 7462 13375 2411 13376 2425 13377 5200 5719 LBLK=SS 5720 5721 OLNUM=USRPT2 5722 NUNUM=CORPT2 5723 13400 6211 BEGER0, CDF 10 5724 13401 4777 JMS I (BEG003 5725 13402 2755 WNGDM 5726 13403 6211 BEG500, CDF 10 5727 13404 1065 TAD BEGUSR 5728 13405 3073 DCA USRCTR 5729 13406 1376 TAD (USRLST 5730 13407 3066 DCA USRPTR 5731 13410 1075 TAD BEGCOR 5732 13411 7001 IAC 5733 13412 3064 DCA CURFLD 5734 13413 7340 BEGFLD, L7777 5735 13414 1064 TAD CURFLD 5736 13415 7550 SPA SNA 5737 13416 5200 JMP BEGER0 /EH? 5738 13417 3064 DCA CURFLD 5739 13420 4777 JMS I (BEG003 5740 13421 2660 BEGMFL 5741 13422 1375 TAD (60 5742 13423 1064 TAD CURFLD 5743 13424 6046 TLS 5744 13425 6041 TSF 5745 13426 5225 JMP .-1 5746 13427 7340 L7777 5747 13430 1064 TAD CURFLD 5748 13431 7650 SNA CLA 5749 13432 7346 L7775 /3 'BLOCKS' LESS IN FLD 1 5750 13433 1374 TAD (20 /20 LOGICAL BLOCKS IN OTHERS 5751 13434 3074 DCA LBLK 5752 13435 4777 BEGXXX, JMS I (BEG003 5753 13436 2664 BEGMXX 5754 13437 1074 TAD LBLK 5755 13440 4773 JMS I (BEGPRNT 5756 13441 4777 JMS I (BEG003 5757 13442 2672 BEGMX1 5758 13443 4772 JMS I (BEG001 5759 13444 1371 TAD (-"8 5760 13445 7540 SMA SZA 5761 13446 5342 JMP BEGER1 5762 13447 1370 TAD (10 5763 13450 7550 SPA SNA 5764 13451 5342 JMP BEGER1 /BAD USERNO 5765 13452 3466 DCA I USRPTR 5766 13453 1065 TAD BEGUSR 5767 13454 1466 TAD I USRPTR 5768 13455 7740 SMA SZA CLA 5769 13456 5342 JMP BEGER1 /NONEXISTENT USER DUMMY 5770 13457 2066 ISZ USRPTR 5771 13460 1064 TAD CURFLD 5772 13461 3466 DCA I USRPTR 5773 13462 2066 ISZ USRPTR /AND HIS NO. 5774 13463 4777 BEGRE, JMS I (BEG003 5775 13464 2726 BEGTTI 5776 13465 3070 DCA OLNUM /DOUBLE CHECK! 5777 13466 4772 BEGINP, JMS I (BEG001 5778 13467 1367 TAD (-215 5779 13470 7450 SNA 5780 13471 5311 JMP DN 5781 13472 1366 TAD (215-"9 5782 13473 7540 SMA SZA 5783 13474 5337 JMP BEGER2 /UNGOOD NO 5784 13475 1365 TAD (11 5785 13476 7510 SPA 5786 13477 5337 JMP BEGER2 /LIKEWISE 5787 13500 3071 DCA NUNUM 5788 13501 1070 TAD OLNUM /MULT BY 10 DECIM 5789 13502 7104 CLL RAL 5790 13503 7006 RTL 5791 13504 1070 TAD OLNUM 5792 13505 1070 TAD OLNUM 5793 13506 1071 TAD NUNUM /PLUS NEW DIGIT 5794 13507 3070 DCA OLNUM /MAKES NEW NO 5795 13510 5266 JMP BEGINP 5796 13511 1070 DN, TAD OLNUM 5797 13512 7570 SNA SPA SZL 5798 13513 5337 JMP BEGER2 /JUNKY NO 5799 13514 7041 CIA 5800 13515 1074 TAD LBLK 5801 13516 7510 SPA 5802 13517 5200 JMP BEGER0 /TOO MUCH ASKED FOR 5803 13520 3074 DCA LBLK /NEW AMOUNT REMAINING 5804 13521 1070 TAD OLNUM 5805 13522 2073 ISZ USRCTR 5806 13523 7410 SKP 5807 13524 5345 JMP BEGR2 5808 13525 3466 DCA I USRPTR 5809 13526 2066 ISZ USRPTR 5810 13527 1074 TAD LBLK 5811 13530 7640 SZA CLA /MORE TO COME IN THIS FIELD? 5812 13531 5235 JMP BEGXXX /SURE IS 5813 13532 7340 L7777 5814 13533 1064 TAD CURFLD 5815 13534 7710 SPA CLA 5816 13535 5200 JMP BEGER0 5817 13536 5213 JMP BEGFLD /MORE FIELDS TO COME 5818 13537 4777 BEGER2, JMS I (BEG003 5819 13540 2474 BEGME 5820 13541 5263 JMP BEGRE 5821 13542 4777 BEGER1, JMS I (BEG003 5822 13543 2474 BEGME 5823 13544 5235 JMP BEGXXX 5824 13545 1074 BEGR2, TAD LBLK /EXPAND HIM TO FINISH FIELD 5825 13546 3466 DCA I USRPTR /THERE'S NO REASON TO WASTE CORE 5826 13547 2066 ISZ USRPTR /JUST THINK OF ALL THE PEOPLE WHO GO TO BED HUNGRY FOR IT EVERY NIGHT! 5827 13550 5764 JMP I (BEG540 5828 5829 13564 3600 PAGE 13565 0011 13566 7724 13567 7563 13570 0010 13571 7510 13572 2411 13573 4304 13574 0020 13575 0060 13576 5000 13577 2425 5830 13600 7303 BEG540, CLA CLL IAC BSW 5831 13601 1377 TAD (-100 5832 13602 7640 SZA CLA 5833 13603 5240 JMP BEG550-2 /NOT AN 8/E 5834 13604 1236 TAD KL8FRST 5835 13605 7640 SZA CLA /FIRST TIME THROUGH 5836 13606 5242 JMP BEG550 /NO 5837 13607 2236 ISZ KL8FRST /SIGNIFY DONE 5838 13610 1072 TAD BEGDEV 5839 13611 7650 SNA CLA 5840 13612 5241 JMP BEG550-1 /THE FOOL HAS AN 8/E WITH DC02 5841 13613 1634 TAD I BEGKL1 5842 13614 3635 DCA I BEGKL2 5843 13615 2234 ISZ BEGKL1 5844 13616 2235 ISZ BEGKL2 /MOVE PATCH TO PROPER POSITION 5845 13617 5213 JMP .-4 5846 13620 6201 CDF 5847 13621 1376 TAD (CIF 10 5848 13622 3637 DCA I BEGKL3 5849 13623 2237 ISZ BEGKL3 5850 13624 1375 TAD (KL8JMP+2&177+5600 5851 13625 3637 DCA I BEGKL3 5852 13626 2237 ISZ BEGKL3 5853 13627 1374 TAD (KL8FIX 5854 13630 3637 DCA I BEGKL3 5855 13631 6211 CDF 10 5856 13632 1374 TAD (KL8FIX 5857 13633 5241 JMP BEG550-1 /SET TOP OF FIELD 1 5858 13634 6353 BEGKL1, KL8LOD 5859 13635 7753 BEGKL2, KL8FIX 5860 13636 0000 KL8FRST, 0 5861 13637 0207 BEGKL3, KL8JMP 5862 13640 3773 DCA I (INTRRV 5863 13641 3076 DCA KLTOP 5864 13642 1372 BEG550, TAD (USRLST /NOW WE SORT FOR FIELDS TO MAKE IT EASY 5865 13643 3066 DCA USRPTR 5866 13644 7325 L0003 5867 13645 1372 TAD (USRLST 5868 13646 3067 DCA CORPTR 5869 13647 1065 TAD BEGUSR 5870 13650 3073 DCA USRCTR 5871 13651 3074 DCA SS /SORT SWITCH FOR MODIFIED BUBBLE SORT 5872 13652 1066 BEG551, TAD USRPTR 5873 13653 7001 IAC 5874 13654 3070 DCA USRPT2 5875 13655 1067 TAD CORPTR 5876 13656 7001 IAC 5877 13657 3071 DCA CORPT2 5878 13660 2073 ISZ USRCTR 5879 13661 7410 SKP 5880 13662 5314 JMP BEG553 5881 13663 1470 TAD I USRPT2 5882 13664 7041 CIA 5883 13665 1471 TAD I CORPT2 5884 13666 7750 SNA SPA CLA 5885 13667 5305 JMP BEG552 5886 13670 7346 L7775 5887 13671 3074 DCA SS /3 SWAPS 5888 13672 1466 TAD I USRPTR 5889 13673 3000 DCA 0 5890 13674 1467 TAD I CORPTR 5891 13675 3466 DCA I USRPTR 5892 13676 1000 TAD 0 5893 13677 3467 DCA I CORPTR 5894 13700 2066 ISZ USRPTR 5895 13701 2067 ISZ CORPTR 5896 13702 2074 ISZ SS 5897 13703 5272 JMP .-11 5898 13704 2074 ISZ SS /SET TO INDICATE 5899 13705 7326 BEG552, L0002 5900 13706 1070 TAD USRPT2 5901 13707 3066 DCA USRPTR 5902 13710 7326 L0002 5903 13711 1071 TAD CORPT2 5904 13712 3067 DCA CORPTR 5905 13713 5252 JMP BEG551 5906 5907 13714 1074 BEG553, TAD SS 5908 13715 7640 SZA CLA 5909 13716 5242 JMP BEG550 5910 13717 5771 JMP I (BEG600 5911 13771 4000 PAGE 13772 5000 13773 0126 13774 7753 13775 5611 13776 6212 13777 7700 5912 14000 1377 BEG600, TAD (BEGLST 5913 14001 3070 DCA USRPT2 5914 14002 1376 TAD (USRLST 5915 14003 3066 DCA USRPTR 5916 14004 1065 TAD BEGUSR 5917 14005 3073 DCA USRCTR 5918 14006 1065 TAD BEGUSR 5919 14007 3775 DCA I (BEGUS1 5920 14010 1774 TAD I (USRLST+1 5921 14011 3064 BEG610, DCA CURFLD 5922 14012 7340 L7777 5923 14013 1064 TAD CURFLD 5924 14014 7640 SZA CLA 5925 14015 5227 JMP .+12 5926 14016 1076 TAD KLTOP 5927 14017 3314 DCA BEG602 5928 14020 1065 TAD BEGUSR 5929 14021 3074 DCA SS 5930 14022 1373 TAD (ENSWAP-STSWAP+1 5931 14023 2074 ISZ SS 5932 14024 5222 JMP .-2 5933 14025 1372 TAD (ORG 5934 14026 5231 JMP .+3 5935 14027 3314 DCA BEG602 5936 14030 1371 TAD (CONEND 5937 14031 3313 DCA BEG601 5938 14032 1466 NXUSR, TAD I USRPTR 5939 14033 2066 ISZ USRPTR 5940 14034 3470 DCA I USRPT2 5941 14035 2070 ISZ USRPT2 5942 14036 1466 TAD I USRPTR 5943 14037 7041 CIA 5944 14040 1064 TAD CURFLD 5945 14041 7640 SZA CLA 5946 14042 5315 JMP BEG609 /HE WANTS A NEW FIELD 5947 14043 2066 ISZ USRPTR 5948 14044 1064 TAD CURFLD 5949 14045 7104 CLL RAL 5950 14046 7006 RTL 5951 14047 1370 TAD (6201 /MAKE UP XFIELD OP 5952 14050 3470 DCA I USRPT2 /INTO OUR QUICKIE LIST 5953 14051 2070 ISZ USRPT2 5954 14052 1466 TAD I USRPTR 5955 14053 2066 ISZ USRPTR 5956 14054 7041 CIA 5957 14055 3074 DCA SS 5958 14056 1367 TAD (400 5959 14057 2074 ISZ SS 5960 14060 5256 JMP .-2 /MULT. HIS BLOCKSIZE BY 400 OCTAL FOR CORE SIZE 5961 14061 3074 DCA SS 5962 14062 7344 L7776 5963 14063 1314 TAD BEG602 5964 14064 3470 DCA I USRPT2 5965 14065 2070 ISZ USRPT2 5966 14066 1074 TAD SS 5967 14067 7041 CIA 5968 14070 1314 TAD BEG602 5969 14071 3314 DCA BEG602 5970 14072 7307 L0004 5971 14073 1314 TAD BEG602 5972 14074 7710 SPA CLA 5973 14075 5305 JMP BEG608-1 5974 14076 1314 TAD BEG602 5975 14077 7510 SPA 5976 14100 5327 JMP BEG607 5977 14101 7041 CIA 5978 14102 1313 TAD BEG601 5979 14103 7700 SMA CLA 5980 14104 5327 JMP BEG607 5981 14105 1314 TAD BEG602 5982 14106 3470 BEG608, DCA I USRPT2 5983 14107 2070 ISZ USRPT2 5984 14110 2073 ISZ USRCTR 5985 14111 5232 JMP NXUSR 5986 14112 5766 JMP I (BEG700 /WHEW..THAT WENT QUICKLY ANYWAY 5987 14113 0000 BEG601, 0 /BOTTOM 5988 14114 0000 BEG602, 0 /TOP 5989 14115 1066 BEG609, TAD USRPTR 5990 14116 3064 DCA CURFLD /SAVE IT 5991 14117 7340 L7777 5992 14120 1066 TAD USRPTR 5993 14121 3066 DCA USRPTR /TAKE OUT ENTRIES 5994 14122 7340 L7777 5995 14123 1070 TAD USRPT2 5996 14124 3070 DCA USRPT2 5997 14125 1464 TAD I CURFLD /COUNT DOWN FIELD 5998 14126 5211 JMP BEG610 5999 14127 7200 BEG607, CLA 6000 14130 1313 TAD BEG601 6001 14131 5306 JMP BEG608 6002 14166 4200 PAGE 14167 0400 14170 6201 14171 0023 14172 1170 14173 0051 14174 5001 14175 7532 14176 5000 14177 7600 6003 6004 14200 1377 BEG700, TAD (BEGLST 6005 14201 3066 DCA USRPTR 6006 14202 3074 DCA SS 6007 14203 1065 TAD BEGUSR 6008 14204 3073 DCA USRCTR 6009 14205 7307 L0004 6010 14206 1377 TAD (BEGLST 6011 14207 3070 DCA USRPT2 6012 14210 2073 BEG7X1, ISZ USRCTR 6013 14211 7410 SKP 6014 14212 5246 JMP BEG703 6015 14213 1466 TAD I USRPTR 6016 14214 7041 CIA 6017 14215 1470 TAD I USRPT2 6018 14216 7450 SNA 6019 14217 5776 JMP I (BEGER0 /MULTIPLE ASSIGNMENTS FOR ONE USER 6020 14220 7700 SMA CLA 6021 14221 5240 JMP BEG702 6022 14222 1375 TAD (-4 6023 14223 3074 DCA SS 6024 14224 1466 BEG701, TAD I USRPTR 6025 14225 3067 DCA CORPTR 6026 14226 1470 TAD I USRPT2 6027 14227 3466 DCA I USRPTR 6028 14230 1067 TAD CORPTR 6029 14231 3470 DCA I USRPT2 6030 14232 2066 ISZ USRPTR 6031 14233 2070 ISZ USRPT2 6032 14234 2074 ISZ SS 6033 14235 5224 JMP BEG701 6034 14236 2074 ISZ SS 6035 14237 1375 TAD (-4 6036 14240 1070 BEG702, TAD USRPT2 6037 14241 3066 DCA USRPTR 6038 14242 7307 L0004 6039 14243 1066 TAD USRPTR 6040 14244 3070 DCA USRPT2 6041 14245 5210 JMP BEG7X1 6042 6043 14246 1074 BEG703, TAD SS 6044 14247 7640 SZA CLA 6045 14250 5200 JMP BEG700 /MORE TO COME 6046 14251 1377 TAD (BEGLST 6047 14252 3066 DCA USRPTR /NOW TAKE OUT USER NOS. 6048 14253 1065 TAD BEGUSR 6049 14254 3073 DCA USRCTR 6050 14255 7001 IAC 6051 14256 1377 TAD (BEGLST 6052 14257 3070 DCA USRPT2 6053 14260 7346 BEG704, L7775 6054 14261 3074 DCA SS 6055 14262 1470 TAD I USRPT2 6056 14263 3466 DCA I USRPTR 6057 14264 2066 ISZ USRPTR 6058 14265 2070 ISZ USRPT2 6059 14266 2074 ISZ SS 6060 14267 5262 JMP .-5 6061 14270 2070 ISZ USRPT2 /SKIP OVER USER NO. 6062 14271 2073 ISZ USRCTR 6063 14272 5260 JMP BEG704 6064 14273 4774 JMS I (BEG003 6065 14274 3031 BEGM6A 6066 14275 4773 JMS I (BEG001 6067 14276 1372 TAD (-"Y 6068 14277 7640 SZA CLA 6069 14300 5771 JMP I (BEG002 /OH NO--ALL THIS JUNK FOR NOTHING! 6070 14301 4774 JMS I (BEG003 6071 14302 2743 BEGM6 6072 14303 5770 JMP I (BEG750 6073 6074 14304 0000 BEGPRNT,0 6075 14305 3340 DCA BEG705 6076 14306 1367 TAD (-12 6077 14307 3336 DCA BEG706 6078 14310 3337 DCA BEG707 6079 14311 5314 JMP .+3 6080 14312 2337 ISZ BEG707 6081 14313 3340 DCA BEG705 6082 14314 1340 BEGPR1, TAD BEG705 6083 14315 1336 TAD BEG706 6084 14316 7500 SMA 6085 14317 5312 JMP .-5 6086 14320 7200 CLA 6087 14321 1366 TAD (60 6088 14322 1337 TAD BEG707 6089 14323 6046 TLS 6090 14324 6041 TSF 6091 14325 5324 JMP .-1 6092 14326 6032 KCC 6093 14327 2336 ISZ BEG706 6094 14330 7410 SKP 6095 14331 5704 JMP I BEGPRNT /WAS SECOND TIME THROUGH 6096 14332 7340 L7777 6097 14333 3336 DCA BEG706 6098 14334 3337 DCA BEG707 6099 14335 5314 JMP BEGPR1 6100 14336 0000 BEG706, 0 6101 14337 0000 BEG707, 0 6102 14340 0000 BEG705, 0 6103 BEG604=SS 6104 BEG605=USRPTR 6105 14366 0060 PAGE 14367 7766 14370 4400 14371 2025 14372 7447 14373 2411 14374 2425 14375 7774 14376 3400 14377 7600 6106 6107 14400 1377 BEG750, TAD (7763 /CR,S 6108 14401 3000 DCA 0 /THIS WAS WIPED OUT BY INITIALIZER 6109 14402 6201 CDF 6110 14403 1776 TAD I (MLOOKE 6111 14404 1065 TAD BEGUSR 6112 14405 3776 DCA I (MLOOKE /CORRECT FOR NO. OF USERS 6113 14406 1776 TAD I (MLOOKE 6114 14407 7041 CIA 6115 14410 3775 DCA I (LOOK 6116 14411 1374 TAD (BEGIOT-1 6117 14412 3074 DCA BEG604 6118 14413 1373 TAD (INTRPL 6119 14414 3066 DCA BEG605 6120 14415 7340 L7777 6121 14416 1065 TAD BEGUSR 6122 14417 3301 DCA BEG60X 6123 14420 1372 TAD (-10 6124 14421 3073 DCA USRCTR 6125 14422 6211 BEG75Q, CDF 10 6126 14423 1474 TAD I BEG604 6127 14424 2074 ISZ BEG604 6128 14425 2301 ISZ BEG60X 6129 14426 5232 JMP .+4 6130 14427 7240 CLA CMA 6131 14430 3301 DCA BEG60X 6132 14431 1371 TAD (CLA-6006 6133 14432 1370 TAD (6006 6134 14433 3466 DCA I BEG605 6135 14434 2066 ISZ BEG605 6136 14435 2073 ISZ USRCTR 6137 14436 5222 JMP BEG75Q 6138 14437 1065 TAD BEGUSR 6139 14440 3074 DCA SS 6140 14441 7610 SKP CLA 6141 14442 7130 CLL CML RAR 6142 14443 2074 ISZ SS 6143 14444 5242 JMP .-2 6144 14445 7001 IAC 6145 14446 3064 DCA AUSER 6146 14447 1075 BEG75X, TAD BEGCOR 6147 14450 7106 CLL RTL 6148 14451 7004 RAL 6149 14452 1367 TAD (CDF 6150 14453 3265 DCA BEG756 6151 14454 1265 TAD BEG756 6152 14455 1366 TAD (-6211 6153 14456 7650 SNA CLA 6154 14457 5304 JMP BEG760 6155 14460 1365 TAD (-CONEND 6156 14461 3303 DCA BEG753 6157 14462 3302 DCA BEG752 6158 14463 6211 BEG755, CDF 10 6159 14464 1702 TAD I BEG752 6160 14465 6221 BEG756, CDF 20 6161 14466 3702 DCA I BEG752 6162 14467 2302 ISZ BEG752 6163 14470 2303 ISZ BEG753 6164 14471 5263 JMP BEG755 6165 14472 3702 DCA I BEG752 6166 14473 2302 ISZ BEG752 6167 14474 5272 JMP .-2 6168 14475 7340 L7777 6169 14476 1075 TAD BEGCOR 6170 14477 3075 DCA BEGCOR 6171 14500 5247 JMP BEG75X 6172 6173 14501 0000 BEG60X, 0 6174 14502 0000 BEG752, 0 6175 14503 0000 BEG753, 0 6176 14504 1072 BEG760, TAD BEGDEV 6177 14505 7650 SNA CLA 6178 14506 5764 JMP I (BEG76X 6179 14507 6201 CDF 6180 14510 3763 DCA I (XOUTL6-3 6181 14511 3762 DCA I (XOUTL6+3 6182 14512 3761 DCA I (XOUTL6+5 6183 14513 6211 CDF 10 6184 14514 3760 DCA I (INTRP2-2 6185 14515 3757 DCA I (INTRP3-5 6186 14516 3756 DCA I (INTRP5+1 6187 14517 3755 DCA I (INTRP5+3 6188 14520 3754 DCA I (INTRRV+2 6189 14521 3753 DCA I (INTRRV+4 6190 14522 5752 JMP I (BEG800 6191 6192 14552 7410 PAGE 14553 0132 14554 0130 14555 0264 14556 0262 14557 0241 14560 0232 14561 3434 14562 3432 14563 3424 14564 4600 14565 7755 14566 1567 14567 6201 14570 6006 14571 1172 14572 7770 14573 0077 14574 7400 14575 0112 14576 0230 14577 7763 6193 14600 6211 BEG76X, CDF 10 6194 14601 1377 TAD (TLS 6195 14602 3776 DCA I (INTRV2-3 6196 14603 1375 TAD (MTLS 6197 14604 3774 DCA I (INTRV2-2 6198 14605 5773 JMP I (BEG800 6199 6200 14773 7410 PAGE 14774 0136 14775 6126 14776 0135 14777 6046 6201 15000 0000 USRLST, 0 6202 PAGE 6203 /THIS ROUTINE DOES ALLOCATION THE OLD WAY IF YOU ASK FOR THE SAME AMOUNT 6204 /OF CORE FOR ALL USERS. IT DOES A TABLE LOOKUP ON BEGCOR&BEGUSR AND 6205 /ENTERS THINGS IN USRLST THE WAY YOU WOULD IF YOU ANSWERED QUESTIONS 6206 15200 1075 BEGOLD, TAD BEGCOR 6207 15201 7106 CLL RTL 6208 15202 7004 RAL 6209 15203 1065 TAD BEGUSR /GET ADDR. OF ADDR. OF LIST 6210 15204 1377 TAD (BGLD1 6211 15205 3074 DCA SS 6212 15206 1474 TAD I SS 6213 15207 3074 DCA SS 6214 15210 1376 TAD (USRLST 6215 15211 3066 DCA USRPTR /SETUP TO SLIDE 6216 15212 1065 TAD BEGUSR 6217 15213 3073 DCA USRCTR /NO. OF SLIDES 6218 15214 1474 BEGOL1, TAD I SS 6219 15215 7106 CLL RTL 6220 15216 7006 RTL 6221 15217 0375 AND (7 6222 15220 7001 IAC /CORRECT USERNO. 6223 15221 3466 DCA I USRPTR 6224 15222 2066 ISZ USRPTR 6225 15223 1474 TAD I SS 6226 15224 7112 CLL RTR 6227 15225 7012 RTR 6228 15226 7012 RTR 6229 15227 0375 AND (7 /SET FIELD 6230 15230 3466 DCA I USRPTR 6231 15231 2066 ISZ USRPTR 6232 15232 1474 TAD I SS 6233 15233 0374 AND (37 6234 15234 3466 DCA I USRPTR 6235 15235 2074 ISZ SS 6236 15236 2066 ISZ USRPTR 6237 15237 2073 ISZ USRCTR 6238 15240 5214 JMP BEGOL1 6239 15241 5773 JMP I (BEG540 /CONTINUE ON...WE'VE ANSWERED QUESTIONS FOR HIM NOW. 6240 15373 3600 PAGE 15374 0037 15375 0007 15376 5000 15377 5674 6241 /THE FORMAT OF THE FOLLOWING LIST OF ANSWERS IS THE FOLLOWING: 6242 /(USER NO. [0 TO 7] +FIELD)TIMES 100 PLUS BLOCKSIZE. 6243 /THIS GETS ALL THREE DATA ABOUT EACH USER INTO ONE WORD. 6244 /THE USER NO. IS INTERNAL USER NO. OR EXTERNAL USER NO.-1 6245 X=100 6246 15400 0115 BGL11, 1^X+15 6247 15401 0106 BGL12, 1^X+6 6248 15402 1107 11^X+7 6249 15403 0105 BGL13, 01^X+5 6250 15404 1104 11^X+4 6251 15405 2104 21^X+4 6252 15406 0104 BGL14, 01^X+4 6253 15407 1103 11^X+3 6254 15410 2103 21^X+3 6255 15411 3103 31^X+3 6256 15412 0103 BGL15, 01^X+3 6257 15413 1103 11^X+3 6258 15414 2103 21^X+3 6259 15415 3102 31^X+2 6260 15416 4102 41^X+2 6261 15417 0103 BGL16, 01^X+3 6262 15420 1102 11^X+2 6263 15421 2102 21^X+2 6264 15422 3102 31^X+2 6265 15423 4102 41^X+2 6266 15424 5102 51^X+2 6267 15425 0102 BGL17, 01^X+2 6268 15426 1102 11^X+2 6269 15427 2102 21^X+2 6270 15430 3102 31^X+2 6271 15431 4102 41^X+2 6272 15432 5102 51^X+2 6273 15433 6101 61^X+1 6274 15434 0102 BGL18, 01^X+2 6275 15435 1102 11^X+2 6276 15436 2102 21^X+2 6277 15437 3102 31^X+2 6278 15440 4102 41^X+2 6279 15441 5101 51^X+1 6280 15442 6101 61^X+1 6281 15443 7101 71^X+1 6282 15444 1115 BGL22, 11^X+15 6283 15445 0220 BGL21, 02^X+20 6284 BGL31=BGL21 6285 BGL41=BGL21 6286 BGL51=BGL21 6287 BGL61=BGL21 6288 BGL71=BGL21 6289 15446 0115 BGL23, 01^X+15 6290 15447 1210 12^X+10 6291 15450 2210 22^X+10 6292 15451 0210 BGL24, 02^X+10 6293 15452 1210 12^X+10 6294 15453 2107 21^X+7 6295 15454 3106 31^X+6 6296 15455 0107 BGL25, 01^X+7 6297 15456 1106 11^X+6 6298 15457 2206 22^X+6 6299 15460 3205 32^X+5 6300 15461 4205 42^X+5 6301 15462 0206 BGL26, 02^X+6 6302 15463 1205 12^X+5 6303 15464 2205 22^X+5 6304 15465 3105 31^X+5 6305 15466 4104 41^X+4 6306 15467 5104 51^X+4 6307 15470 0105 BGL27, 01^X+5 6308 15471 1104 11^X+4 6309 15472 2104 21^X+4 6310 15473 3204 32^X+4 6311 15474 4204 42^X+4 6312 15475 5204 52^X+4 6313 15476 6204 62^X+4 6314 15477 0204 BGL28, 02^X+4 6315 15500 1204 12^X+4 6316 15501 2204 22^X+4 6317 15502 3204 32^X+4 6318 15503 4104 41^X+4 6319 15504 5103 51^X+3 6320 15505 6103 61^X+3 6321 15506 7103 71^X+3 6322 15507 2115 BGL33, 21^X+15 6323 15510 0220 BGL32, 02^X+20 6324 15511 1320 13^X+20 6325 BGL42=BGL32 6326 BGL52=BGL32 6327 BGL62=BGL32 6328 BGL72=BGL32 6329 15512 0220 BGL34, 02^X+20 6330 15513 1115 11^X+15 6331 15514 2310 23^X+10 6332 15515 3310 33^X+10 6333 15516 0115 BGL35, 01^X+15 6334 15517 1210 12^X+10 6335 15520 2210 22^X+10 6336 15521 3310 33^X+10 6337 15522 4310 43^X+10 6338 15523 0210 BGL36, 02^X+10 6339 15524 1210 12^X+10 6340 15525 2310 23^X+10 6341 15526 3310 33^X+10 6342 15527 4107 41^X+7 6343 15530 5106 51^X+6 6344 15531 0210 BGL37, 02^X+10 6345 15532 1210 12^X+10 6346 15533 2107 21^X+7 6347 15534 3106 31^X+6 6348 15535 4306 43^X+6 6349 15536 5305 53^X+5 6350 15537 6305 63^X+5 6351 15540 0107 BGL38, 01^X+7 6352 15541 1106 11^X+6 6353 15542 2206 22^X+6 6354 15543 3306 33^X+6 6355 15544 4205 42^X+5 6356 15545 5205 52^X+5 6357 15546 6305 63^X+5 6358 15547 7305 73^X+5 6359 6360 6361 6362 15550 3115 BGL44, 31^X+15 6363 15551 0220 BGL43, 02^X+20 6364 15552 1320 13^X+20 6365 15553 2420 24^X+20 6366 BGL53=BGL43 6367 BGL63=BGL43 6368 BGL73=BGL43 6369 15554 0220 BGL45, 02^X+20 6370 15555 1320 13^X+20 6371 15556 2115 21^X+15 6372 15557 3410 34^X+10 6373 15560 4410 44^X+10 6374 15561 0220 BGL46, 02^X+20 6375 15562 1115 11^X+15 6376 15563 2310 23^X+10 6377 15564 3310 33^X+10 6378 15565 4410 44^X+10 6379 15566 5410 54^X+10 6380 15567 0115 BGL47, 01^X+15 6381 15570 1210 12^X+10 6382 15571 2210 22^X+10 6383 15572 3310 33^X+10 6384 15573 4310 43^X+10 6385 15574 5410 54^X+10 6386 15575 6410 64^X+10 6387 15576 6107 BGL48, 61^X+7 6388 15577 7106 71^X+6 6389 15600 0210 02^X+10 6390 15601 1210 12^X+10 6391 15602 2310 23^X+10 6392 15603 3310 33^X+10 6393 15604 4410 44^X+10 6394 15605 5410 54^X+10 6395 15606 4115 BGL55, 41^X+15 6396 15607 0220 BGL54, 02^X+20 6397 15610 1320 13^X+20 6398 15611 2420 24^X+20 6399 15612 3520 35^X+20 6400 BGL64=BGL54 6401 BGL74=BGL54 6402 6403 15613 0220 BGL56, 02^X+20 6404 15614 1320 13^X+20 6405 15615 2420 24^X+20 6406 15616 3115 31^X+15 6407 15617 4510 45^X+10 6408 15620 5510 55^X+10 6409 15621 0220 BGL57, 02^X+20 6410 15622 1320 13^X+20 6411 15623 2115 21^X+15 6412 15624 3410 34^X+10 6413 15625 4410 44^X+10 6414 15626 5510 55^X+10 6415 15627 6510 65^X+10 6416 15630 0220 BGL58, 02^X+20 6417 15631 1115 11^X+15 6418 15632 2310 23^X+10 6419 15633 3310 33^X+10 6420 15634 4410 44^X+10 6421 15635 5410 54^X+10 6422 15636 6510 65^X+10 6423 15637 7510 75^X+10 6424 15640 5115 BGL66, 51^X+15 6425 15641 0220 BGL65, 02^X+20 6426 15642 1320 13^X+20 6427 15643 2420 24^X+20 6428 15644 3520 35^X+20 6429 15645 4620 46^X+20 6430 BGL75=BGL65 6431 15646 4115 BGL67, 41^X+15 6432 15647 0220 02^X+20 6433 15650 1320 13^X+20 6434 15651 2420 24^X+20 6435 15652 3520 35^X+20 6436 15653 5610 56^X+10 6437 15654 6610 66^X+10 6438 15655 0220 BGL68, 02^X+20 6439 15656 1320 13^X+20 6440 15657 2420 24^X+20 6441 15660 3115 31^X+15 6442 15661 4510 45^X+10 6443 15662 5510 55^X+10 6444 15663 6610 66^X+10 6445 15664 7610 76^X+10 6446 15665 7115 BGL78, 71^X+15 6447 15666 6720 BGL77, 67^X+20 6448 15667 0220 BGL76, 02^X+20 6449 15670 1320 13^X+20 6450 15671 2420 24^X+20 6451 15672 4620 46^X+20 6452 15673 3520 35^X+20 6453 15674 5434 BGLD1, BGL18 6454 15675 5425 BGL17 6455 15676 5417 BGL16 6456 15677 5412 BGL15 6457 15700 5406 BGL14 6458 15701 5403 BGL13 6459 15702 5401 BGL12 6460 15703 5400 BGL11 6461 15704 5477 BGL28 6462 15705 5470 BGL27 6463 15706 5462 BGL26 6464 15707 5455 BGL25 6465 15710 5451 BGL24 6466 15711 5446 BGL23 6467 15712 5444 BGL22 6468 15713 5445 BGL21 6469 15714 5540 BGL38 6470 15715 5531 BGL37 6471 15716 5523 BGL36 6472 15717 5516 BGL35 6473 15720 5512 BGL34 6474 15721 5507 BGL33 6475 15722 5510 BGL32 6476 15723 5445 BGL31 6477 15724 5576 BGL48 6478 15725 5567 BGL47 6479 15726 5561 BGL46 6480 15727 5554 BGL45 6481 15730 5550 BGL44 6482 15731 5551 BGL43 6483 15732 5510 BGL42 6484 15733 5445 BGL41 6485 15734 5630 BGL58 6486 15735 5621 BGL57 6487 15736 5613 BGL56 6488 15737 5606 BGL55 6489 15740 5607 BGL54 6490 15741 5551 BGL53 6491 15742 5510 BGL52 6492 15743 5445 BGL51 6493 15744 5655 BGL68 6494 15745 5646 BGL67 6495 15746 5640 BGL66 6496 15747 5641 BGL65 6497 15750 5607 BGL64 6498 15751 5551 BGL63 6499 15752 5510 BGL62 6500 15753 5445 BGL61 6501 15754 5665 BGL78 6502 15755 5666 BGL77 6503 15756 5667 BGL76 6504 15757 5641 BGL75 6505 15760 5607 BGL74 6506 15761 5551 BGL73 6507 15762 5510 BGL72 6508 15763 5445 BGL71 6509 6510 6511 6512 6513 6514 6515 6516 6517 6518 6519 6520 6521 6522 6523 6524 6525 6526 6527 6528 6529 6530 6531 *7400 6532 6533 17400 0040 40 6534 17401 0120 BEGIOT, 120 6535 17402 0120 120 6536 17403 0120 120 6537 17404 0120 120 6538 17405 0040 40 6539 17406 0040 40 6540 17407 0040 40 6541 17410 1377 BEG800, TAD (ORG 6542 17411 3333 DCA BEG801 6543 17412 6211 CDF 10 6544 17413 3733 DCA I BEG801 6545 17414 2333 ISZ BEG801 6546 17415 1333 TAD BEG801 6547 17416 1376 TAD (-7400 6548 17417 7640 SZA CLA 6549 17420 5213 JMP .-5 6550 17421 1377 TAD (ORG 6551 17422 3333 DCA BEG801 6552 17423 1375 TAD (BEGLST 6553 17424 3334 BEG8111, DCA BEG802 6554 17425 1374 TAD (BEGLST+1 6555 17426 3336 DCA BEG804 6556 17427 1373 TAD (BEGLST+2 6557 17430 3335 DCA BEG803 6558 17431 1372 TAD (BEGIOT-1 6559 17432 3337 DCA BEG805 6560 17433 1736 BEG810, TAD I BEG804 6561 17434 4347 JMS BEG900 /SETUP PDLXR 6562 17435 7307 L0004 6563 17436 4340 JMS BEGZER 6564 17437 1371 TAD (READY /PC GETS READY FOR STARTUP 6565 17440 4347 JMS BEG900 6566 17441 1370 TAD (10 6567 17442 4340 JMS BEGZER 6568 17443 7340 L7777 /DINPUT SET TO INPUT MODE 6569 17444 4347 JMS BEG900 6570 17445 4347 JMS BEG900 /OUTPUT GETS ZEROED FOR ECHO 6571 17446 1737 TAD I BEG805 /MAKE UP XIOT 6572 17447 1367 TAD (6006-10 6573 17450 4347 JMS BEG900 6574 17451 1734 TAD I BEG802 /MAKE UP XFIELD 6575 17452 4347 JMS BEG900 6576 17453 1366 TAD (5 6577 17454 4340 JMS BEGZER 6578 17455 1365 TAD (40 /NOW BUILD BUFFERS 6579 17456 1735 TAD I BEG803 /THIS IS IPTRI 6580 17457 4347 JMS BEG900 6581 17460 1365 TAD (40 /AND IPTRO 6582 17461 1735 TAD I BEG803 6583 17462 4347 JMS BEG900 6584 17463 1365 TAD (40 /IPTR0 6585 17464 1735 TAD I BEG803 6586 17465 4347 JMS BEG900 6587 17466 1735 TAD I BEG803 /OPTRI 6588 17467 4347 JMS BEG900 6589 17470 1735 TAD I BEG803 /OPTRO 6590 17471 4347 JMS BEG900 6591 17472 7325 L0003 6592 17473 4340 JMS BEGZER 6593 17474 1364 TAD (164 /BUFR 6594 17475 1735 TAD I BEG803 6595 17476 4347 JMS BEG900 6596 17477 1364 TAD (164 /LASTV 6597 17500 1735 TAD I BEG803 6598 17501 4347 JMS BEG900 6599 17502 1736 TAD I BEG804 /PDLST 6600 17503 4347 JMS BEG900 6601 17504 1363 TAD (162 /ALINE0 6602 17505 1735 TAD I BEG803 6603 17506 4347 JMS BEG900 6604 17507 1362 TAD (100 /COMBUF 6605 17510 1735 TAD I BEG803 6606 17511 4347 JMS BEG900 6607 17512 1366 TAD (5 6608 17513 4340 JMS BEGZER 6609 17514 2334 ISZ BEG802 6610 17515 2334 ISZ BEG802 6611 17516 2334 ISZ BEG802 6612 17517 2335 ISZ BEG803 6613 17520 2335 ISZ BEG803 6614 17521 2335 ISZ BEG803 6615 17522 2336 ISZ BEG804 6616 17523 2336 ISZ BEG804 6617 17524 2336 ISZ BEG804 6618 17525 2337 ISZ BEG805 6619 17526 2332 ISZ BEGUS1 6620 17527 5233 JMP BEG810 6621 17530 6202 CIF 6622 17531 5761 JMP I (ENTRY 6623 6624 17532 0000 BEGUS1, 0 6625 17533 0000 BEG801, 0 6626 17534 0000 BEG802, 0 6627 17535 0000 BEG803, 0 6628 17536 0000 BEG804, 0 6629 17537 0000 BEG805, 0 6630 6631 17540 0000 BEGZER, 0 6632 17541 7041 CIA 6633 17542 3224 DCA BEG8111 6634 17543 4347 JMS BEG900 6635 17544 2224 ISZ BEG8111 6636 17545 5343 JMP .-2 6637 17546 5740 JMP I BEGZER 6638 17547 0000 BEG900, 0 6639 17550 3733 DCA I BEG801 6640 17551 2333 ISZ BEG801 6641 17552 5747 JMP I BEG900 6642 6643 17561 0343 PAGE 17562 0100 17563 0162 17564 0164 17565 0040 17566 0005 17567 5776 17570 0010 17571 0440 17572 7400 17573 7602 17574 7601 17575 7600 17576 0400 17577 1170 6644 BEGLST=. 6645 6646 6647 $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$