From 0adc80d5fd6ebf8f262ed02c473ffd4ec73dce6a Mon Sep 17 00:00:00 2001 From: brad Date: Wed, 3 Jan 2007 12:30:31 +0000 Subject: [PATCH] basic images for focal --- images/bintotxt.c | 69 + images/focal.lst | 3618 ++++++++++++++++++++++++++++++++++++++++++ images/focal.pal | 3647 +++++++++++++++++++++++++++++++++++++++++++ images/focal569.bin | Bin 0 -> 6508 bytes 4 files changed, 7334 insertions(+) create mode 100644 images/bintotxt.c create mode 100644 images/focal.lst create mode 100644 images/focal.pal create mode 100644 images/focal569.bin diff --git a/images/bintotxt.c b/images/bintotxt.c new file mode 100644 index 0000000..79a4c6f --- /dev/null +++ b/images/bintotxt.c @@ -0,0 +1,69 @@ +#include + +#define MEMSIZE 32*1024 +int M[32*1024]; + +main() +{ + int i; + int rubout, newf, state, high, low, word, csum; + int field, origin; + + rubout = 0; + newf = 0; + state = 0; + csum = 0; + + while ((i = getchar()) != EOF) { /* BIN format */ + if (rubout) { + rubout = 0; + continue; } + if (i == 0377) { + rubout = 1; + continue; } + if (i > 0200) { + newf = (i & 070) << 9; + continue; } + switch (state) { + case 0: /* leader */ + if ((i != 0) && (i != 0200)) state = 1; + high = i; /* save as high */ + break; + case 1: /* low byte */ + low = i; + state = 2; + break; + case 2: /* high with test */ + word = (high << 6) | low; + if (i == 0200) { /* end of tape? */ + if ((csum - word) & 07777) { + printf("checksum bad\n"); + goto done; + } + + printf("checksum ok\n"); + goto done; + } + csum = csum + low + high; + if (word >= 010000) origin = word & 07777; + else { + if ((field | origin) >= MEMSIZE) { + printf("SCPE_NXM\n"); + } + + M[field | origin] = word & 07777; + printf("ram[12'o%o] = 12'o%o;\n", + field | origin, word & 07777); + + origin = (origin + 1) & 07777; + } + field = newf; + high = i; + state = 1; + break; + } /* end switch */ + } /* end while */ + + done: + exit(0); +} diff --git a/images/focal.lst b/images/focal.lst new file mode 100644 index 0000000..ccaf2a9 --- /dev/null +++ b/images/focal.lst @@ -0,0 +1,3618 @@ + 1 /**** FOCAL 5/69 **** + 2 /E.A.TAFT - REVISION OF FOCALW 8/68 /EAT/ 25-JUL-72 + 3 + 4 + 5 + 6 + 7 + 8 /ASSEMBLY INSTRUCTIONS FOR DECUS VERSION: + 9 + 10 /INPUT FILES: + 11 / FOCAL.569 FOCAL LANGUAGE PROCESSOR + 12 / FLOAT.569 FLOATING POINT PACKAGE + 13 / EXTEND.569 EXTENDED FUNCTION PACKAGE + 14 / 2USER.569 2-USER OVERLAY + 15 + 16 /ASSEMBLY USING PAL10 V.141 + 17 / .R PAL10 + 18 / *FOCAL.BIN_FOCAL.569,FLOAT.569 + 19 / *EXTEND.BIN_EXTEND.569 + 20 / *2USER.BIN_2USER.569 + 21 / *^C + 22 / .R PIP + 23 / *FOCAL.BIN/B_FOCCAL.BIN,EXTEND.BIN,2USER.BIN + 24 / *PTP:/I_FOCAL.BIN + 25 + 26 /WHEN READ-IN ON A PDP-8, THE LOADER WILL STOP 3 TIMES. THE FIRST + 27 / SECTION CONTAINS THE BASIC PROCESSOR AND FLOATING POINT PACKAGE. + 28 / THE SECOND SECTION CONTAINS THE EXTENDED FUNCTIONS. THE LAST + 29 / SECTION CONTAINS THE 2-USER OVERLAY (REQUIRES 2 TERMINALS AND 8K). + 30 + 31 /PROCESSOR INSTRUCTIONS + 32 /FIXMRI AND=0000 + 33 /FIXMRI TAD=1000 + 34 /FIXMRI ISZ=2000 + 35 /FIXMRI DCA=3000 + 36 /FIXMRI JMS=4000 + 37 /FIXMRI JMP=5000 + 38 /FLOATING POINT INSTRUCTIONS + 39 FIXMRI FPW=0000 + 40 FIXMRI FAD=1000 + 41 FIXMRI FSB=2000 + 42 FIXMRI FMY=3000 + 43 FIXMRI FDV=4000 + 44 FIXMRI FGT=5000 + 45 FIXMRI FPT=6000 + 46 + 47 FNR=7000 + 48 FEXT=0 + 49 FENT=JMS I 7 + 50 NOP=7000 + 51 CLA=7200 + 52 CLL=7100 + 53 CMA=7040 + 54 RAL=7004 + 55 CML=7020 + 56 RAR=7010 + 57 RTR=7012 + 58 RTL=7006 + 59 IAC=7001 + 60 SMA=7500 + 61 SZA=7440 + 62 SPA=7510 + 63 SNA=7450 + 64 SNL=7420 + 65 SZL=7430 + 66 SKP=7410 + 67 CIA=7041 + 68 ION=6001 + 69 IOF=6002 + 70 KSF=6031 + 71 KRB=6036 + 72 TSF=6041 + 73 TCF=6042 + 74 TPC=6044 + 75 TLS=6046 + 76 RSF=6011 + 77 RRB=6012 + 78 RFC=6014 + 79 + 80 / * FOCAL * - BY RICK MERRILL - FOR THE FAMILY OF 8. + 81 /REVISED BY EDWARD TAFT 5/69 + 82 + 83 /MISCELLANEOUS ITEMS + 84 *1 + 85 00001 5402 JMP I .+1 /INTERRUPT PROCESSOR ENTRY + 86 00002 2603 INTRPT + 87 00003 7477 MINUSA, -301 /CONSTANT + 88 00004 0000 FNEGSW, 0 /USED FOR CALCULATING SIGNS + 89 00005 0013 P13, 13 /CONSTANT + 90 00006 0100 C100, 100 /CONSTANT + 91 00007 6600 FPNT /ADDRESS OF FLOATING POINT INTERPRETER. + 92 + 93 /AUTO-INDEX REGISTERS + 94 + 95 00010 0000 AXIN, 0 /STORAGE INDEX + 96 00011 0000 XRT, 0 /EXTRA XR + 97 00012 0000 XRT2, 0 /EXTRA XR + 98 00013 0000 PDLXR, 0 /PUSHDOWN LIST INDEX REGISTER. + 99 00014 3377 FLTXR, IOBUF-1 /XR15 FOR FLOATING POINT + 100 00015 0200 C200, 200 /CONSTANT + 101 00016 0000 XRT3, 0 /USED BY PUSHDOWN LIST CONTROLS + 102 + 103 + 104 TEXTP=. /TEXT POINTERS + 105 00017 3430 AXOUT, FRSTX /OUTPUT INDEX + 106 00020 0000 XCT, 0 /UNPACK SWITCH + 107 00021 0000 GTEM, 0 /UNPACK STORAGE + 108 + 109 /NUMBERS + 110 + 111 00022 0256 PER, 256 /PERIOD + 112 00023 7701 M77, -77 /RIGHT MASK + 113 00024 7600 P7600, 7600 /GROUP MASK + 114 00025 7760 M20, -20 /CONSTANT + 115 00026 0177 P177, 177 /STEP MASK + 116 00027 5577 BOTTOM, DBCONV-1/END OF TEXT BUFFER + 117 FLOAT= JMS I . /FLOAT C(AC) SUBROUTINE + 118 00030 7332 XFLOAT + 119 00031 0017 P17, 17 /BCD MASK + 120 00032 0277 P277, 277 /"?" + 121 00033 0240 C240, 240 /SPACE + 122 00034 7776 M2, -2 /CONSTANT + 123 00035 0002 P2, 2 /CONSTANT + 124 00036 0260 C260, 260 /ASCII FOR ZERO + 125 00037 0000 HINBUF, 0 /HIGH SPEED INPUT BUFFER + 126 + 127 FLOP=. /FLOATING OPERAND STORAGE + 128 00040 0000 FLOP0, 0 + 129 00041 0000 FLOP1, 0 + 130 00042 0000 FLOP2, 0 + 131 00043 0000 FLOP3, 0 + 132 FLAC=. /FLOATING POINT ACCUMULATOR + 133 00044 0000 FLAC0, 0 + 134 00045 0000 FLAC1, 0 + 135 00046 0000 FLAC2, 0 + 136 00047 0000 FLAC3, 0 + 137 NEGATE= JMS I . /NEGATE FLAC ROUTINE + 138 00050 6676 NEGAC + 139 00051 0010 TOTDIG, 10 /TOTAL DIGITS IN OUTPUT FIELD + 140 FIX= JMS I . /FIX FLAC ROUTINE + 141 00052 7311 XFIX + 142 00053 0000 TABCTR, 0 /CARRIAGE INDEX + 143 + 144 /CONSTANTS + 145 + 146 + 147 LIST6=. /INPUT LIST FOR "SFOUND". + 148 00054 0337 P337, 337 /LEFT ARR + 149 00055 0214 214 /F.F. + 150 00056 0207 207 /BELL + 151 00057 0212 CLF, 212 /L.F. + 152 LIST3=. /EXCRETION LIST + 153 00060 0215 CCR, 215 /LIST BRANCHER. + 154 00061 0000 0 /SEARCH CHARACTER (VARIABLE) + 155 + 156 M100=. + 157 00062 7700 P7700, 7700 /LEFT MASK + 158 00063 7540 M240, -240 /SPACE TEST + 159 00064 7522 MPER, -256 /PERIOD TEST + 160 00065 7563 MCR, -215 /C.R. TEST + 161 MFLT=. /3-WORD FLOATING POINT + 162 00066 7775 M3, -3 + 163 00067 7773 M5, -5 /PAREN TEST + 164 00070 7767 M11, -11 /PAREN TEST + 165 00071 0077 P77, 77 /RIGHT MASK + 166 + 167 00072 6170 FOUTPUT,BDCONV /FLOATING OUTPUT + 168 00073 5600 FINPUT, DBCONV /FLOATING INPUT + 169 00074 2527 COMBUF, COMEIN /COMMAND BUFFER`START + 170 00075 3420 CFRS, FRST /ADDRESS OF DUMMY LINE. + 171 00076 3432 END, BUFBEG /FIRST LOCATION USED. + 172 00077 3432 ENDT, BUFBEG /START OF STORAGE AREA ** + 173 RETURN= JMP I . /FUNCTION RETURN + 174 00100 2056 EFUN3I, EFUN3 + 175 + 176 /NEW INSTRUCTIONS: + 177 + 178 PUSHJ=JMS I . /RECURSIVE SUBROUTINE CALL + 179 00101 0523 XPUSHJ + 180 POPA=TAD I PDLXR/RESTORE AC + 181 POPJ=JMP I . /SUBROUTINE RETURN + 182 00102 1556 XPOPJ + 183 PUSHA=JMS I . /SAVE AC + 184 00103 0501 XPUSHA + 185 PUSHF=JMS I . /SAVE GROUP OF DATA + 186 00104 0532 PD2 + 187 POPF=JMS I . /RESTORE GROUP + 188 00105 0550 PD3 + 189 GETC=JMS I . /UNPACK A CHARACTER + 190 00106 2315 UTRA + 191 PACKC=JMS I . /PACK A CHARACTER + 192 00107 3023 PACBUF + 193 SORTJ=JMS I . /SORT AND BRANCH ON AC OR CHAR + 194 00110 1333 SORTB + 195 SORTC=JMS I . /SORT CHAR + 196 00111 0733 XSORTC + 197 PRINTC=JMS I . /PRINT AC OR CHAR + 198 00112 2477 OUT + 199 READC=JMS I . /READ ASR-33 INTO CHAR AND PRINT IT + 200 00113 2463 CHIN + 201 PRNTLN=JMS I . /PRINT C(LINENO) + 202 00114 6151 XPRNTL + 203 GETLN=JMS I . /UNPACK AND FORM A LINENUMBER + 204 00115 0312 XGETLN + 205 FINDLN=JMS I . /SEARCH FOR A GIVEN LINE + 206 00116 2265 XFIND + 207 ENDLN=JMS I . /INSERT LINE POINTERS + 208 00117 2417 XENDLN + 209 RTL6=JMS I . /ROTATE LEFT SIX + 210 00120 0305 XRTL6 + 211 SPNOR=JMS I . /IGNORE SPACES AND LEADING ZEROS + 212 00121 1524 XSPNOR + 213 TESTN=JMS I . /PERIOD; OTHER; NUMBER + 214 00122 1533 XTESTN + 215 TSTLPR=JMS I . /SKIP IF 5 0 + 274 00202 3145 DCA PC /FOR COMMAND MODE + 275 00203 3151 DCA DEBGSW /ENABLE TRACE FOR INPUT OF (?). + 276 00204 1226 TAD COMBOT /PROTECT COMMAND BUFFER. + 277 00205 3013 DCA PDLXR /NO PATCH TEST. + 278 00206 2152 ISZ DMPSW /INIT UNPACK AND TRACE SWITCH. + 279 00207 3061 DCA LIST3+1 /CLEAR SEARCH CHARACTER FOR INPUT. + 280 00210 1054 TAD P337 /ANNOUNCE PRESENCE + 281 00211 4512 PRINTC /BY TYPING THE LEAD-IN CHARACTER + 282 00212 1074 IBAR, TAD COMBUF /INITIALIZE COMMAND BUFFER + 283 00213 3010 DCA AXIN /FOR UNPACKING. + 284 00214 3136 DCA XCTIN + 285 00215 1074 TAD COMBUF /RUBOUT PROTECTION + 286 00216 3153 DCA PACKST + 287 00217 4513 IGNOR, READC /READ COMMAND STRING + 288 00220 4510 SORTJ + 289 00221 0053 LIST6-1 + 290 00222 0510 INLIST-LIST6 + 291 00223 4507 PACKC /SAVE STRING CHARACTER. + 292 00224 5217 JMP IGNOR + 293 ///// + 294 00225 4000 P4000, 4000 /LINE NUMBER TEST + 295 00226 2612 COMBOT, COMOUT+12 /END OF COMMAND BUFFER,LESS PROTECTION COUNT. + 296 00227 1575 CFRSX, FLTZER /POINTER FOR PC=COMMAND OR INPUT + 297 ///// + 298 /COMMAND/INPUT PROCESSOR + 299 + 300 00230 4507 IRETN, PACKC /START TO PACK C.R. + 301 00231 4507 PACKC /FINISH C.R. + 302 00232 1074 TAD COMBUF /INITIALIZE "TEXTP" + 303 00233 3017 GONE, DCA AXOUT /SETUP CURRENT LINE + 304 00234 3020 DCA XCT + 305 00235 4506 GETC /READ FIRST CHARACTER. + 306 00236 1027 TAD BOTTOM /INIT PUSH-DOWN-LIST + 307 00237 3013 DCA PDLXR + 308 00240 4521 SPNOR /IGNORE LEADING BLANKS + 309 00241 4522 TESTN /DOES THE LINE BEGIN WITH 1-9? + 310 00242 4526 ERROR4 /ILLEGAL GROUP ZERO USAGE + 311 00243 5274 JMP INPUTX /NO + 312 00244 6002 IOF /YES,STOP INPUT MOMENTARILY. + 313 00245 2151 ISZ DEBGSW /DISABLE TRACE FOR REPACKING + 314 00246 4515 GETLN /READ THIS LINE NUMBER + 315 00247 1141 TAD NAGSW + 316 00250 1225 TAD P4000 /TEST FOR SINGLE LINE + 317 00251 7640 SZA CLA + 318 00252 4526 ERROR3 /ILLEGAL LINE NUMBER ON INPUT + 319 00253 1134 TAD BUFR /SET POINTERS + 320 00254 3010 DCA AXIN + 321 00255 3136 DCA XCTIN + 322 00256 1143 TAD LINENO /SAVE LINE # + 323 00257 3410 DCA I AXIN /(X-MEM) + 324 00260 4521 SPNOR /IGNORE SPACES AFTER LINE NUMBER + 325 00261 7410 SKP + 326 00262 4506 GETC /READ 1ST AFTER LINENO TERMINATOR. + 327 00263 4507 PACKC /SAVE TEXT AND RESTORE DATA FIELD + 328 00264 1142 TAD CHAR /TEST FOR END OF INPUT STRING + 329 00265 1065 TAD MCR + 330 00266 7640 SZA CLA + 331 00267 5262 JMP .-5 + 332 00270 4501 PUSHJ /REMOVE OLD LINE, IF ANY. + 333 00271 2111 DELETE + 334 00272 4517 ENDLN /INSERT NEW LINE + 335 00273 5177 JMP START + 336 ///// + 337 00274 4501 INPUTX, PUSHJ /PROCESS IMMEDIATE COMMAND. + 338 00275 0616 PROC + 339 00276 1545 TAD I PC /CHECK NEXT LINE (X-MEM) + 340 00277 7450 SNA /END OF PROGRAM? + 341 00300 5177 JMP START /YES + 342 00301 3145 DCA PC /SAVE NEW LINE NO. + 343 00302 1145 TAD PC /START NEW LINE + 344 00303 7001 IAC + 345 00304 5233 JMP GONE /PROCESS OTHER COMMANDS + 346 /TEXT LINE BUFFER FORMAT* + 347 /#1 : POINTER OR ZERO IN LAST + 348 /#2 : LINENO + 349 /#3 - #N+1 : TEXT + 350 /#N : C.R. + 351 + 352 00305 0000 XRTL6, 0 /ROTATE AC LEFT 6 + 353 00306 7106 CLL RTL + 354 00307 7006 RTL + 355 00310 7006 RTL + 356 00311 5705 JMP I XRTL6 + 357 / + 358 /PROCESS A LINE NUMBER - "GETLN" + 359 00312 0000 XGETLN, 0 + 360 00313 4521 SPNOR + 361 00314 1225 TAD P4000 /INITIALIZE TO SINGLE LINE + 362 00315 3141 DCA NAGSW + 363 00316 4511 SORTC /TEST FOR A SIGN + 364 00317 6114 SNLIST-1 + 365 00320 5370 JMP EVLN /EVALUATE IN FLOATING POINT + 366 00321 4766 JMS I INPINT /FIXED POINT: GET GROUP + 367 00322 4522 TESTN + 368 00323 4506 GETC /GO PAST . IF THERE + 369 00324 4356 JMS GEG /GET 1ST STEP DIGIT + 370 00325 7106 CLL RTL /MULTIPLY BY TEN + 371 00326 1127 TAD SORTCN + 372 00327 7004 RAL + 373 00330 4356 JMS GEG /GET 2ND STEP DIGIT + 374 00331 1143 TAD LINENO /COMBINE + 375 00332 7450 GEXIT, SNA + 376 00333 3141 DCA NAGSW /MUST BE GROUP + 377 00334 3143 DCA LINENO /SAVE STEP NUMBER + 378 00335 1164 TAD DECNUM /GROUP + 379 00336 7450 SNA + 380 00337 5347 JMP GTESTA /GROUP 0: MUST BE "ALL" + 381 00340 4520 RTL6 /CONSTRUCT LINE NUMBER + 382 00341 7004 RAL + 383 00342 1143 TAD LINENO + 384 00343 3143 DCA LINENO + 385 00344 1164 TAD DECNUM /TEST FOR LEGAL GROUP + 386 00345 0367 AND C7760 + 387 00346 5351 JMP .+3 + 388 00347 2141 GTESTA, ISZ NAGSW /SET TO "ALL" + 389 00350 1143 TAD LINENO /MAKE SURE LINE # IS ZERO + 390 00351 7650 SNA CLA + 391 00352 4522 TESTN /OK, TEST FOR EXTRA DIGITS + 392 00353 5361 JMP LNERR /DOUBLE ., ILLEGAL G. 0, OR G.>15 + 393 00354 5712 JMP I XGETLN /OK + 394 00355 5361 JMP LNERR /TOO MANY DIGITS + 395 + 396 00356 0000 GEG, 0 /GET A STEP DIGIT + 397 00357 3143 DCA LINENO + 398 00360 4522 TESTN + 399 00361 4526 LNERR, ERROR /DOUBLE PERIODS + 400 00362 5331 JMP GEXIT-1 /NO DIGIT + 401 00363 4506 GETC /DIGIT, PASS IT + 402 00364 1127 TAD SORTCN /EXIT WITH VALUE + 403 00365 5756 JMP I GEG + 404 ///// + 405 00366 6010 INPINT, DECINT + 406 00367 7760 C7760, 7760 + 407 ///// + 408 /EVALUATE A LINE NUMBER IN FLOATING POINT + 409 00370 4501 EVLN, PUSHJ /GET VALUE + 410 00371 1601 EVAL + 411 00372 4452 FIX /GET GROUP # + 412 00373 4503 PUSHA + 413 00374 1045 TAD FLAC1 + 414 00375 7640 SZA CLA + 415 00376 5361 JMP LNERR /TOO BIG + 416 00377 4407 FENT /GET STEP # + 417 00400 7000 FNR + 418 00401 2560 FSB I FLARGP /THIS GIVES -(FRACTIONAL PART) + 419 00402 3614 FMY I F10P + 420 00403 3614 FMY I F10P + 421 00404 2615 FSB I FP10P /KILL ANY ROUNDOFF ERROR + 422 00405 0000 FEXT + 423 00406 4450 NEGATE + 424 00407 1413 POPA /RESTORE GROUP + 425 00410 3164 DCA DECNUM + 426 00411 4452 FIX + 427 00412 5613 JMP I .+1 + 428 00413 0332 GEXIT + 429 ///// + 430 00414 5770 F10P, FLTEN + 431 00415 5773 FP10P, FLPTEN + 432 + 433 /RANGE OF ACCEPTIBLE LINE NUMBERS = 1.01 TO 15.99 + 434 + 435 /NAGSW: + 436 /GROUP=0000 + 437 /LINE=4000 + 438 /ALL=0001 + 439 /RECURSIVE OPERATE, EXECUTE, OR CALL + 440 + 441 00416 4515 DO, GETLN /EXECUTE ONE LINE, A GROUP,OR ALL + 442 00417 1145 TAD PC /SAVE ADDRESS + 443 00420 4503 PUSHA /OF CURRENT LINE + 444 00421 4504 PUSHF /SAVE REST OF THIS LINE + 445 00422 0017 TEXTP /ADDRESS OF TEXT POINTERS + 446 00423 4504 DGRP, PUSHF /SAVE NAGSW; CHAR; AND LINENO. + 447 00424 0141 NAGSW + 448 00425 1141 TAD NAGSW /CHECK DATA FROM GETLN. + 449 00426 7710 SPA CLA /SKIP IF GROUP OR ALL + 450 00427 5254 JMP DOONE /DO ONE LINE + 451 00430 4516 FINDLN /INIT FOR GROUP AND SET THISLN + 452 00431 5273 JMP TGRP2 + 453 00432 4501 DGRP1, PUSHJ /EXECUTE OBJECT LINE AND SET PC. + 454 00433 0613 PROCESS-2 + 455 00434 4505 POPF /RESTORE THE DATA + 456 00435 0141 NAGSW + 457 00436 1545 TAD I PC /CHECK FOR END OF TEXT (X-MEM) + 458 00437 7450 SNA + 459 00440 5262 JMP DCONT /ALL DONE + 460 00441 7001 IAC + 461 00442 3154 DCA PT1 /SAVE POINTER TO LINENO + 462 00443 1141 TAD NAGSW /CHECK FOR GROUP + 463 00444 7740 SMA SZA CLA + 464 00445 5251 JMP .+4 /DO ALL + 465 00446 1554 TAD I PT1 /TEST GROUP (X-MEM) + 466 00447 4524 TSTGRP + 467 00450 5262 JMP DCONT /NOT IN GROUP + 468 00451 1554 TAD I PT1 /READ NEXT LINE NO. (X-MEM) + 469 00452 3143 DCA LINENO + 470 00453 5223 JMP DGRP /CONTINUE THE SUBROUTINE + 471 ///// + 472 00454 4516 DOONE, FINDLN /FIND THE LINE + 473 00455 4526 ERROR2 /NO SUCH LINE NUMBER + 474 00456 4501 PUSHJ /EXECUTE IT + 475 00457 0615 PROCESS + 476 00460 4505 POPF /RESTORE CHAR + 477 00461 0141 NAGSW + 478 00462 4505 DCONT, POPF /RESTORE TEXT POINTERS + 479 00463 0017 TEXTP + 480 00464 1413 POPA /RESTORE ADDRESS OF CURRENT LINE. + 481 00465 3145 DCA PC + 482 00466 4565 TSTERM /GO TO TERMINATOR + 483 00467 5266 JMP .-1 + 484 00470 5672 JMP I .+2 /END OF DO, CONTINUE PROCESSING + 485 00471 5216 JMP DO /COMMA, DO ANOTHER + 486 00472 0616 PROC + 487 + 488 00473 1146 TGRP2, TAD THISLN /TEST FOR GOOD GROUP NUMBER. + 489 00474 3011 DCA XRT + 490 00475 1411 TAD I XRT + 491 00476 4524 TSTGRP + 492 00477 4526 ERROR2 /NO SUCH GROUP NUMBER + 493 00500 5232 JMP DGRP1 + 494 /PUSHDOWN LIST CONTROLS + 495 / + 496 00501 0000 XPUSHA, 0 /PUSHDOWN THE AC - "PUSHA" + 497 00502 3332 DCA PD2 /SAVE AC + 498 00503 7040 CMA /BACK UP POINTER + 499 00504 4310 JMS PCHK /CHECK CORE USAGE + 500 00505 1332 TAD PD2 + 501 00506 3416 DCA I XRT3 /SAVE + 502 00507 5701 JMP I XPUSHA + 503 ///// + 504 00510 0000 PCHK, 0 + 505 00511 1013 TAD PDLXR /INC IN AC + 506 00512 3013 DCA PDLXR + 507 00513 1013 TAD PDLXR + 508 00514 3016 DCA XRT3 /DUPLICATE POINTER + 509 00515 1013 TAD PDLXR + 510 00516 7141 CLL CIA + 511 00517 1155 TAD LASTV + 512 00520 7630 SZL CLA + 513 00521 4526 ERROR /STORAGE FILLED BY PUSHDOWN LIST + 514 00522 5710 JMP I PCHK + 515 ///// + 516 00523 0000 XPUSHJ, 0 /RECURSIVE SUBROUTINE CALL - "PUSHJ" + 517 00524 7201 CLA IAC + 518 00525 1323 TAD XPUSHJ /SAVE RETURN + 519 00526 4301 JMS XPUSHA /(PUSHA) + 520 00527 1723 TAD I XPUSHJ /TO NEW ROUTINE + 521 00530 3323 DCA XPUSHJ + 522 00531 5723 JMP I XPUSHJ + 523 ///// + 524 00532 0000 PD2, 0 /SAVE A FLOATING PT NUMBER - "PUSHF" + 525 00533 7240 CLA CMA /COMPUTE ADDRESS + 526 00534 1732 TAD I PD2 + 527 00535 3011 DCA XRT + 528 00536 2332 ISZ PD2 + 529 00537 1066 TAD M3 /BACKUP THREE + 530 00540 4310 JMS PCHK + 531 00541 1411 TAD I XRT /SAVE 3 WORDS + 532 00542 3416 DCA I XRT3 + 533 00543 1411 TAD I XRT + 534 00544 3416 DCA I XRT3 + 535 00545 1411 TAD I XRT + 536 00546 3416 DCA I XRT3 + 537 00547 5732 JMP I PD2 + 538 + 539 00550 0000 PD3, 0 /RESTORE A FLOATING PT # - "POPF" + 540 00551 7240 CLA CMA + 541 00552 1750 TAD I PD3 + 542 00553 2350 ISZ PD3 + 543 00554 3011 DCA XRT + 544 00555 1413 TAD I PDLXR + 545 00556 3411 DCA I XRT + 546 00557 1413 TAD I PDLXR + 547 00560 3411 DCA I XRT + 548 00561 1413 TAD I PDLXR + 549 00562 3411 DCA I XRT + 550 00563 5750 JMP I PD3 + 551 / + 552 /INPUT CONTROL CHARACTERS + 553 00564 0212 INLIST, IBAR /B.A.=RESTART + 554 00565 0223 IGNOR+4 /F.F. + 555 00566 0223 IGNOR+4 /BELL + 556 00567 0217 IGNOR /L.F.=IGNORED + 557 00570 0230 IRETN /C.R.=TERMINATE INPUT + 558 / + 559 /LIST OF FUNCTION ADDRESSES + 560 00571 2053 FNTABF, XABS /ABSOLUTE VALUE + 561 00572 7535 FSGN /SIGN PART + 562 00573 1156 XINT /INTEGER PART + 563 00574 1145 XDYS /FDIS- DISPLAY Y AND INTENSIFY + 564 00575 7351 FRAN /RANDOM NUMBER + 565 00576 1153 XDXS /SET X-COORDINATE FOR DISPLAY + 566 00577 2414 XADC /READ ANALOG-DIGITAL CONVERTER + 567 00600 2735 ERROR5 /ATN THESE ROUTINES NOT IN PACKAGE + 568 00601 2735 ERROR5 /EXP + 569 00602 2735 ERROR5 /LOG + 570 00603 2735 ERROR5 /SIN + 571 00604 2735 ERROR5 /COS + 572 00605 7462 FSQT /SQUARE ROOT + 573 00606 2735 ERROR5 /NEW- USER-DEFINED FUNCTION + 574 / + 575 00607 7472 MF, -306 /USED BY TESTC + 576 /PRIMARY CONTROL AND TRANSFER + 577 + 578 00610 4515 GOTO, GETLN /READ THE LINE NUMBER REQUESTED + 579 00611 4516 FINDLN /LOCATE IT AND RESET TEXTP + 580 00612 4526 ERROR2 /NOT THERE OR A TIGHT LOOP. + 581 00613 1146 TAD THISLN /SET PC + 582 00614 3145 DCA PC + 583 00615 4506 PROCESS,GETC /TEST FOR END OF LINE + 584 00616 4511 PROC, SORTC /FIRST CHARACTER READY = USE PROC + 585 00617 0057 CCR-1 + 586 00620 5502 PC1, POPJ /EXIT "PROCESS" + 587 00621 4511 SORTC /IGNORE SPACE ; , + 588 00622 1140 GLIST-1 + 589 00623 5215 JMP PROCESS + 590 00624 1142 TAD CHAR /SAVE COMMAND CHARACTER + 591 00625 4503 PUSHA + 592 00626 4506 GETC /GO TO TERMINATOR + 593 00627 4511 SORTC + 594 00630 2002 TERMS-4 + 595 00631 7410 SKP + 596 00632 5226 JMP .-4 + 597 00633 4521 SPNOR + 598 00634 1413 POPA + 599 00635 4510 SORTJ /GO DO COMMAND + 600 00636 0755 COMLST-1 + 601 00637 0206 COMGO-COMLST + 602 00640 4526 ERROR2 /ILLEGAL COMMAND + 603 ///// + 604 + 605 COMMENTS=PC1 /ALSO IS CONTINUE + 606 + 607 /OUTPUT COMMAND TEXT + 608 + 609 00641 4711 WRITE, JMS I WTXS /SAVE CHAR AND TEXT POINTERS + 610 00642 4515 GETLN /SET LINENO + 611 00643 2151 ISZ DEBGSW /DISABLE TRACE + 612 00644 4516 FINDLN /SEARCH FOR LINE NUMBER + 613 00645 5274 JMP WTESTG /NOT THERE OR GROUP + 614 00646 1143 TAD LINENO + 615 00647 7640 SZA CLA + 616 00650 4514 PRNTLN /PRINT LINE NUMBER AND A SPACE. + 617 00651 4506 GETC + 618 00652 4512 PRINTC /PRINT TEXT OF A LINE. + 619 00653 1142 TAD CHAR + 620 00654 1065 TAD MCR + 621 00655 7640 SZA CLA /SKIP IF END OF LINE + 622 00656 5251 JMP .-5 + 623 00657 1546 TAD I THISLN /TEST FOR END OF TEXT (X-MEM) + 624 00660 7450 WTEST2, SNA + 625 00661 5303 JMP WEXIT /WRITE FINISHED + 626 00662 7001 IAC + 627 00663 3154 DCA PT1 /SAVE POINTER TO LINENO OF`NEXT (X-MEM) + 628 00664 1141 TAD NAGSW + 629 00665 7700 SMA CLA + 630 00666 1554 TAD I PT1 /(X-MEM) + 631 00667 4524 TSTGRP /TRY NEXT LINENO FOR GROUP. + 632 00670 5276 JMP WX + 633 00671 1554 WALL, TAD I PT1 /SET LINENO (X-MEM) + 634 00672 3143 DCA LINENO + 635 00673 5244 JMP WRITE+3 + 636 /// + 637 00674 1146 WTESTG, TAD THISLN /INIT GROUP PRINTOUT + 638 00675 5260 JMP WTEST2 + 639 ///// + 640 00676 1141 WX, TAD NAGSW + 641 00677 7750 SPA SNA CLA /SKIP IF ALL + 642 00700 5303 JMP WEXIT + 643 00701 4512 PRINTC /PRINT C.R. AGAIN + 644 00702 5271 JMP WALL + 645 ///// + 646 00703 4712 WEXIT, JMS I WTXR /RESTORE CURRENT LINE + 647 00704 3151 DCA DEBGSW /RESTORE TRACE + 648 00705 4565 TSTERM + 649 00706 5305 JMP .-1 + 650 00707 5216 JMP PROC /END OF WRITE + 651 00710 5241 JMP WRITE /COMMA, MORE TO WRITE + 652 ///// + 653 00711 2435 WTXS, TXTSAV + 654 00712 2443 WTXR, TXTRES + 655 + 656 00713 0000 XTESTC, 0 /TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC" + 657 00714 4521 SPNOR /IGNORE SPACES + 658 00715 4511 SORTC /TEST THE VARIABLE TERMINATORS + 659 00716 2005 TERMS-1 + 660 00717 5713 JMP I XTESTC /YES - SORTCN IS SET + 661 00720 2313 ISZ XTESTC + 662 00721 4522 TESTN + 663 00722 5713 JMP I XTESTC /. (PART OF NUMBER) + 664 00723 7410 SKP /OTHER + 665 00724 5713 JMP I XTESTC /NUMBER + 666 00725 1142 TAD CHAR /TEST FOR "F" + 667 00726 1207 TAD MF + 668 00727 7640 SZA CLA + 669 00730 2313 ISZ XTESTC /NO + 670 00731 2313 ISZ XTESTC /RETURNS: + 671 00732 5713 JMP I XTESTC /TERMINATOR;NUMBER;FUNCTION;OTHER + 672 ///// + 673 00733 0000 XSORTC, 0 /SORT CHAR AGAINST TABLE - "SORTC" + 674 00734 1733 TAD I XSORTC + 675 00735 3012 DCA XRT2 /1ST ARG IS LIST-1 + 676 00736 1412 TAD I XRT2 + 677 00737 7510 SPA /LIST IS ENDED BY A NEGATIVE NUMBER + 678 00740 5352 JMP SEXC /2AND EXIT = NOT IN LIST + 679 00741 7041 CIA + 680 00742 1142 TAD CHAR + 681 00743 7640 SZA CLA /COMPARE + 682 00744 5336 JMP .-6 + 683 00745 1733 TAD I XSORTC /COMPUTE INCREMENT : 0 - N + 684 00746 7040 CMA + 685 00747 1012 TAD XRT2 + 686 00750 3127 DCA SORTCN + 687 00751 7410 SKP /1ST EXIT = YES + 688 00752 2333 SEXC, ISZ XSORTC + 689 00753 2333 ISZ XSORTC + 690 00754 7300 CLA CLL + 691 00755 5733 JMP I XSORTC + 692 + 693 /COMMAND DECODING LIST + 694 00756 0323 COMLST, 323 /SET + 695 00757 0306 306 /FOR + 696 00760 0311 311 /IF + 697 00761 0304 304 /DO + 698 00762 0307 307 /GOTO + 699 00763 0303 303 /COMMENT OR CONTINUE + 700 00764 0301 301 /ASK + 701 00765 0324 324 /TYPE + 702 00766 0314 314 /LIBRARY + 703 00767 0305 305 /ERASE + 704 00770 0327 327 /WRITE + 705 00771 0315 315 /MODIFY + 706 00772 0321 321 /QUIT + 707 00773 0322 322 /RETURN + 708 00774 0317 317 /OPTION + 709 00775 0310 310 /HELLO + 710 /CONDITIONAL TRANSFER PROCESS + 711 / IF (EXP) A,B,C + 712 00776 4511 IF, SORTC /LOOK FOR L-PAR + 713 00777 1022 PLPR-1 + 714 01000 7410 SKP + 715 01001 4526 ERROR /NO ( AFTER IF + 716 01002 4501 PUSHJ /EVALUATE EXPRESSION + 717 01003 1600 EVAL-1 + 718 01004 4506 GETC /PASS ) + 719 01005 1045 TAD FLAC1 /TEST FOR -,0,+ + 720 01006 7710 SPA CLA + 721 01007 5622 JMP I PGOTO /NEGATIVE, USE 1ST REF + 722 01010 4565 TSTERM /0 OR POS, GET TO NEXT + 723 01011 5210 JMP .-1 + 724 01012 5703 JMP I PRCP /; OR CR, CONTINUE SAME LINE + 725 01013 1045 TAD FLAC1 /COMMA, SEE IF 0 OR POS + 726 01014 7650 SNA CLA + 727 01015 5622 JMP I PGOTO /ZERO, USE 2ND REF + 728 01016 4565 TSTERM /POSITIVE, GET TO NEXT + 729 01017 5216 JMP .-1 + 730 01020 5703 JMP I PRCP /; OR CR + 731 01021 5622 JMP I PGOTO /COMMA, USE 3RD REF + 732 01022 0610 PGOTO, GOTO + 733 01023 0250 PLPR, 250 + 734 /ASSIGNMENT AND LOOP CONTROL + 735 SET=. + 736 01024 4501 FOR, PUSHJ /GET POINTER TO VAR. + 737 01025 1404 GETARG + 738 01026 4521 SPNOR + 739 01027 4511 SORTC /SEARCH FOR = + 740 01030 2024 TERMS+17-1 + 741 01031 7410 SKP + 742 01032 4526 ERROR /LEFT OF = IN ERROR: "FOR" OR "SET" + 743 01033 1154 TAD PT1 /SAVE VARIABLE POINTER + 744 01034 3332 DCA PT2 + 745 01035 4501 PUSHJ /EVALUATE INITIAL EXPRESSION + 746 01036 1600 EVAL-1 + 747 01037 4407 FENT /SAVE INITIAL VALUE + 748 01040 6732 FPT I PT2 + 749 01041 0000 FEXT + 750 01042 4565 TSTERM /CHECK TERMINATOR + 751 01043 4526 ERROR /PROBABLY EXCESS R-PAR + 752 01044 5703 JMP I PRCP /; OR CR: THIS IS A SET; CONTINUE + 753 01045 1332 TAD PT2 /COMMA, SAVE LOOP VAR POINTER + 754 01046 4503 PUSHA + 755 01047 4501 PUSHJ /EVALUATE SECOND EXPRESSION + 756 01050 1601 EVAL + 757 01051 4565 TSTERM /CHECK TERMINATOR + 758 01052 4526 ERROR /EXCESS R-PAR OR BAD TERMINATOR + 759 01053 5317 JMP ONEINC /; OR CR, THAT'S ALL (INC=1) + 760 01054 4504 PUSHF /COMMA, SAVE INCREMENT + 761 01055 2034 FLARG + 762 01056 4501 PUSHJ /EVALUATE FINAL EXPRESSION + 763 01057 1601 EVAL + 764 01060 4504 SFINAL, PUSHF /SAVE FINAL VALUE + 765 01061 2034 FLARG + 766 01062 4724 JMS I FTXS /SAVE CHAR AND TEXT POINTERS + 767 01063 4430 FLOAT /FLOAT A ZERO TO START + 768 01064 4407 FCONT, FENT /COMPARE LOOP VAR TO FINAL + 769 01065 1732 FAD I PT2 /LOOP VAR + 770 01066 6732 FPT I PT2 + 771 01067 2560 FSB I FLARGP /FINAL + 772 01070 0000 FEXT + 773 01071 1013 TAD PDLXR /CHECK SIGN OF INCREMENT + 774 01072 1322 TAD PINC + 775 01073 3332 DCA PT2 + 776 01074 1732 TAD I PT2 + 777 01075 7710 SPA CLA + 778 01076 4450 NEGATE /BACKWARD COUNTING + 779 01077 1045 TAD FLAC1 + 780 01100 7740 SMA SZA CLA + 781 01101 5326 JMP FEND /LIMIT REACHED OR EXCEEDED + 782 + 783 01102 4501 PUSHJ /NOT YET, DO OBJECT STATEMENTS + 784 01103 0616 PRCP, PROC + 785 01104 4725 JMS I FTXR /RESET TO BEGINNING OF OBJ. STMT. + 786 01105 4505 POPF /RESTORE LIMIT + 787 01106 2034 FLARG + 788 01107 4505 POPF /RESTORE INC + 789 01110 0044 FLAC + 790 01111 1413 POPA /RESTORE LOOP VAR POINTER + 791 01112 3332 DCA PT2 + 792 01113 1323 TAD M13 /PUSH DOWN ALL OF ABOVE + 793 01114 1013 TAD PDLXR + 794 01115 3013 DCA PDLXR + 795 01116 5264 JMP FCONT + 796 ///// + 797 01117 4504 ONEINC, PUSHF /NO INCREMENT GIVEN, SET TO 1 + 798 01120 1573 FLTONE + 799 01121 5260 JMP SFINAL + 800 ///// + 801 01122 0011 PINC, 11 + 802 01123 7765 M13, -13 + 803 01124 2435 FTXS, TXTSAV + 804 01125 2443 FTXR, TXTRES + 805 01126 1005 FEND, TAD P13 /END OF LOOP + 806 01127 1013 TAD PDLXR /REMOVE VALUES!FROM PUSHDOWN LIST + 807 01130 3013 DCA PDLXR + 808 01131 5502 POPJ + 809 01132 0000 PT2, 0 + 810 ///// + 811 /ASK/TYPE SPECIAL CHARACTERS + 812 01133 0246 ALIST, 246 /& + 813 01134 0245 245 /% + 814 01135 0242 242 /" + 815 01136 0241 241 /! + 816 01137 0243 243 /# + 817 01140 0244 244 /$ + 818 01141 0240 GLIST, 240 /SPACE + 819 01142 0254 TLIST, 254 /, + 820 01143 0273 273 /; + 821 01144 0215 215 /C.R. + 822 /SET Y AND INTENSIFY THE POINT + 823 01145 4452 XDYS, FIX + 824 01146 6063 6063 /DYL + 825 01147 7200 CLA + 826 01150 1361 TAD X0 + 827 01151 6053 6053 /DXL DIX + 828 01152 7410 SKP + 829 / + 830 /SET X + 831 01153 4452 XDXS, FIX + 832 01154 3361 DCA X0 /(DXL) + 833 01155 5500 RETURN + 834 / + 835 /TAKE THE INTEGER PART + 836 01156 4452 XINT, FIX + 837 01157 7200 CLA + 838 01160 5500 RETURN + 839 01161 0000 X0, 0 + 840 ///// + 841 01162 1252 TLIST3, TASK4 /" + 842 01163 1210 TASK /C.R. - AUTOMATIC QUOTE MATCH + 843 /COMMAND POINTERS + 844 01164 1024 COMGO, SET + 845 01165 1024 FOR + 846 01166 0776 IF + 847 01167 0416 DO + 848 01170 0610 GOTO + 849 01171 0620 COMMENTS + 850 01172 1206 ASK + 851 01173 1207 TYPE + 852 01174 6556 LIBRARY + 853 01175 2226 ERASE + 854 01176 0641 WRITE + 855 01177 1273 MODIFY + 856 01200 0177 START + 857 01201 1554 RETRN + 858 01202 6446 OPTION + 859 01203 3274 HELLO + 860 ///// + 861 01204 3040 PACLS2, PQUES + 862 01205 3065 RUB1 + 863 /INPUT-OUTPUT STATEMENTS + 864 + 865 01206 7240 ASK, CLA CMA /REMEMBER WHICH CALL. + 866 01207 3131 TYPE, DCA ATSW + 867 01210 3151 TASK, DCA DEBGSW /RE-ENABLE THE TRACE + 868 01211 4510 SORTJ /SPECIAL CHARACTER? + 869 01212 1132 ALIST-1 + 870 01213 0426 ATLIST-ALIST + 871 01214 2131 ISZ ATSW /TEST QUOTE SWITCH + 872 01215 5227 JMP TYPE2 + 873 01216 4501 PUSHJ /DO ASK; SETUP PT1 + 874 01217 1404 GETARG + 875 01220 4636 JMS I TTXTS /PROTECT TEXT + 876 01221 1233 TAD COL /TYPE COLON + 877 01222 4512 TASKCL, PRINTC /(CLA) TO SUPPRESS ":" + 878 01223 4626 JMS I INTERP /CALL INPUT CONVERSION ROUTINE + 879 01224 4637 JMS I TTXTR /RESTORE TEXT + 880 01225 5206 JMP ASK /CONTINUE PROCESSING + 881 01226 3306 INTERP, INTASK + 882 //// + 883 01227 4501 TYPE2, PUSHJ /DO TYPE + 884 01230 1601 EVAL + 885 01231 4565 TSTERM + 886 01232 4526 ERROR /BAD TERMINATOR IN "TYPE" + 887 01233 0272 COL, 272 + 888 01234 4640 JMS I OUTS /PRINT + 889 01235 5207 JMP TYPE + 890 ///// + 891 01236 2435 TTXTS, TXTSAV + 892 01237 2443 TTXTR, TXTRES + 893 01240 3365 OUTS, OUTPT + 894 + 895 01241 2151 TQUOT, ISZ DEBGSW /DISABLE TRACE + 896 01242 4506 GETC /TYPE LITERALS + 897 01243 4510 SORTJ + 898 01244 1404 TLIST2-1 + 899 01245 7555 TLIST3-TLIST2 + 900 01246 4512 PRINTC + 901 01247 5242 JMP TQUOT+1 + 902 ////// + 903 01250 1060 TCRLF, TAD CCR /SLASH=CR,LF. + 904 01251 4512 PRINTC + 905 01252 4506 TASK4, GETC /MOVE TO NEXT CHARACTER + 906 01253 5210 JMP TASK + 907 //// + 908 01254 1060 TCRLF2, TAD CCR /SPLAT=CR + 909 01255 4537 JMS I OUTDEV + 910 01256 1015 TAD C200 /DELAY FOR C.R. + 911 01257 5251 JMP TCRLF+1 + 912 + 913 /IF DEBGSW=0 : ENABLE FLIP-FLOP "DMPSW" + 914 / #0: DISABLE AND RETURN ALL"?" ' S. + 915 /IF DMPSW = 0: TRACE ON, IF ENABLED + 916 / #0: TRACE OFF + 917 /IF BOTH = 0 : PRINT TRACE. + 918 + 919 + 920 01260 4506 TINTR, GETC /PASS PERCENT SIGN + 921 01261 4672 JMS I INTG /READ FORMAT CONTROL: "%7.3" + 922 01262 1164 TAD DECNUM /INTEGER PART (TOTAL DIGITS) + 923 01263 3051 DCA TOTDIG + 924 01264 4522 TESTN /GET PAST . IF ANY + 925 01265 4506 GETC + 926 01266 4672 JMS I INTG /RIGHT-HAND PART (DECIMAL PLACES) + 927 01267 1164 TAD DECNUM + 928 01270 3133 DCA DECP + 929 01271 5210 JMP TASK + 930 01272 6010 INTG, DECINT + 931 /SEARCH ROUTINES + 932 + 933 01273 4515 MODIFY, GETLN /READ LINE NO. + 934 01274 4516 FINDLN /LOOK IT UP NOW. + 935 01275 4526 ERROR2 /NOT THERE = BAD COMMAND UNLESS ZERO. + 936 01276 1134 TAD BUFR /SET POINTERS + 937 01277 3010 DCA AXIN /FOR INPUT + 938 01300 3136 DCA XCTIN + 939 01301 1143 TAD LINENO /COPY THE SAME LINE NUMBER. + 940 01302 7450 SNA /CHECK FOR ALL + 941 01303 5275 JMP MODIFY+2 /ERROR IN ARG + 942 01304 3410 DCA I AXIN /(X-MEM) + 943 01305 1010 TAD AXIN /SAVE START OF NEW LINE + 944 01306 3153 DCA PACKST + 945 01307 4540 SCONT, JMS I INDEV /READ THE TELETYPE INPUT SILENTLY. + 946 01310 3061 DCA LIST3+1 /SAVE SEARCH CHARACTER + 947 01311 2151 ISZ DEBGSW /NO BREAKS. + 948 01312 4506 SCHAR, GETC /TYPE+TEST-F.F. + 949 01313 4512 PRINTC + 950 01314 4510 SORTJ /LOOK FOR MATCH + 951 01315 0057 LIST3-1 + 952 01316 1322 LISTGO-LIST3 + 953 01317 4507 PACKC /SAVE NEW LINE. + 954 01320 5312 JMP SCHAR + 955 ///// + 956 01321 1134 SBAR, TAD BUFR /RESTART-B.A. + 957 01322 7001 IAC + 958 01323 3010 DCA AXIN /SET POINTERS + 959 01324 3136 DCA XCTIN + 960 01325 4513 SFOUND, READC /READ FROM KEYBOARD + 961 01326 4510 SORTJ /TEST + 962 01327 0053 LIST6-1 + 963 01330 1322 SRNLST-LIST6 + 964 01331 4507 SGOT, PACKC /PACK CHAR. + 965 01332 5325 JMP SFOUND /MORE + 966 + 967 01333 0000 SORTB, 0 /SORT AND BRANCH ROUTINE. - "SORTJ" + 968 01334 7450 SNA + 969 01335 1142 TAD CHAR /ASSUME CHAR IF AC=0 + 970 01336 7041 CIA + 971 01337 3157 DCA T2 /SAVE SORT ITEM + 972 01340 1733 TAD I SORTB /FIRST ARG IS LIST LESS ONE + 973 01341 2333 ISZ SORTB /2AND IS INTRA-LIST LENGTH + 974 01342 3012 DCA XRT2 + 975 01343 1412 TAD I XRT2 + 976 01344 7510 SPA /**LISTS ENDED BY NEGATIVE NUMBERS** + 977 01345 5357 JMP SEX /READ EXIT + 978 01346 1157 TAD T2 /FIND ADDRESS + 979 01347 7640 SZA CLA + 980 01350 5343 JMP .-5 + 981 01351 1012 TAD XRT2 /MATCH FOUND. + 982 01352 1733 TAD I SORTB + 983 01353 3333 DCA SORTB /SETUP RETURN + 984 01354 1733 TAD I SORTB + 985 01355 3333 DCA SORTB + 986 01356 7410 SKP + 987 01357 2333 SEX, ISZ SORTB /MATCH NOT FOUND. + 988 01360 7300 CLA CLL + 989 01361 5733 JMP I SORTB /RETURN TO CALLING SEQUENCE. + 990 + 991 01362 4501 TAB, PUSHJ /TABULATE TO A PARTICULAR COLUMN + 992 01363 1600 EVAL-1 + 993 01364 4452 FIX /GET COLUMN NUMBER + 994 01365 7141 CLL CIA + 995 01366 7001 IAC + 996 01367 1053 TAD TABCTR + 997 01370 7630 SZL CLA + 998 01371 5210 JMP TASK /ALREADY THERE OR PAST IT + 999 01372 1033 TAD C240 +1000 01373 4512 PRINTC +1001 01374 1046 TAD FLAC2 /TEST AGAIN +1002 01375 5365 JMP TAB+3 +1003 SRNLST=. /'MODIFY' CONTROL CHARACTER TABLE +1004 01376 1321 SBAR /B.A. = RESTART +1005 01377 1312 SCHAR /F.F. = CONTINUE +1006 01400 1307 SCONT /BELL = CHANGE SEARCH CHARACTER +1007 01401 1310 SCONT+1 /L.F. = FINISH THE LINE AS BEFORE. +1008 ///// +1009 01402 0263 LISTGO, INPUTX-11 /C.R. - END THE MODIFIED LINE HERE +1010 01403 1331 SGOT /FOUND SEARCH CHARACTER +1011 /FIND OR ENTER A VARIABLE IN THE LIST. +1012 +1013 01404 4525 GETARG, TESTC /FIRST LETTER OF ARG +1014 01405 0242 TLIST2, 0242 /" +1015 01406 0215 0215 /C.R. - FUNCTION OR NUMBER IS NOT AN ARG. +1016 01407 4526 ERROR4 /BAD ARGUEMENT IN 'FOR' 'SET', OR 'ASK' +1017 01410 7240 CLA CMA /"GETARG" CAN CREATE NEW VAR. +1018 01411 4503 GETVAR, PUSHA /"GETVAR" WILL NOT +1019 01412 3136 DCA XCTIN /PACK INTO ADD. +1020 01413 4507 PACKC +1021 01414 4506 GETC /SECOND LETTER +1022 01415 4511 SORTC /TERMINATOR? +1023 01416 2005 TERMS-1 +1024 01417 5222 JMP .+3 /YES +1025 01420 1142 TAD CHAR /NO +1026 01421 0071 AND P77 /SAVE 2AND LETTER OF NAME +1027 01422 1135 TAD ADD +1028 01423 4503 PUSHA +1029 01424 4511 SORTC /IGNORE THE REST +1030 01425 2005 TERMS-1 +1031 01426 5231 JMP .+3 +1032 01427 4506 GETC +1033 01430 5224 JMP .-4 +1034 01431 4523 TSTLPR /LOOK FOR SUBSCRIPT VIA SORTCN +1035 01432 5243 JMP GS1 /NOT SUBSCRIPTED BY L-PAR. +1036 01433 1130 TAD LASTOP /SAVE LAST OPERATION +1037 01434 4503 PUSHA +1038 01435 4501 PUSHJ /MOVE PAST L-PAR AND +1039 01436 1600 EVAL-1 /EVALUATE THE SUBSCRIPT. +1040 01437 4506 GETC /MOVE PAST R-PAR +1041 01440 1413 POPA +1042 01441 3130 DCA LASTOP /RECALL LAST OPERATION +1043 01442 4452 FIX +1044 01443 3324 GS1, DCA SUBS /SAVE SUBSCRIPT +1045 01444 1413 POPA +1046 01445 3135 DCA ADD /RESTORE NAME +1047 01446 1134 TAD STARTV /SEARCH FOR VARIABLE +1048 01447 3154 GS3, DCA PT1 +1049 01450 1154 TAD PT1 +1050 01451 3011 DCA XRT +1051 01452 1154 TAD PT1 +1052 01453 7041 CIA +1053 01454 1155 TAD LASTV /TEST FOR END OF LIST +1054 01455 7750 SPA SNA CLA +1055 01456 5267 JMP GS2 /END SEARCH +1056 01457 1554 TAD I PT1 /GET TABLE ENTRY +1057 01460 7041 CIA +1058 01461 1135 TAD ADD +1059 01462 7650 SNA CLA +1060 01463 5312 JMP GFND1 /FOUND XX +1061 +1062 01464 1154 GS4, TAD PT1 /TRY NEXT ONE +1063 01465 1144 TAD GINC +1064 01466 5247 JMP GS3 +1065 01467 2413 GS2, ISZ I PDLXR /VAR. NOT FOUND, CAN I MAKE ONE? +1066 01470 4526 ERROR /UNDEFINED VAR. USED IN EXPRESSION +1067 01471 1155 TAD LASTV /OK, ADD THE VARIABLE +1068 01472 1005 TAD P13 /TEST STORAGE LIMITS +1069 01473 7141 CIA CLL +1070 01474 1013 TAD PDLXR +1071 01475 7620 SNL CLA +1072 01476 4526 ERROR3 +1073 01477 1155 TAD LASTV /UPDATE THE LIST. +1074 01500 1144 TAD GINC +1075 01501 3155 DCA LASTV +1076 01502 1135 TAD ADD /SAVE NAME +1077 01503 3554 DCA I PT1 +1078 01504 1324 TAD SUBS /SAVE SUBSCRIPT +1079 01505 3411 DCA I XRT +1080 01506 3411 DCA I XRT /INITIALIZE VAR. TO ZERO +1081 01507 3411 DCA I XRT +1082 01510 3411 DCA I XRT +1083 01511 5320 JMP GS5 /EXIT +1084 ///// +1085 01512 1411 GFND1, TAD I XRT /FOUND NAME, TEST SUBSCRIPT +1086 01513 7041 CIA +1087 01514 1324 TAD SUBS +1088 01515 7640 SZA CLA +1089 01516 5264 JMP GS4 /WRONG SUBSCRIPT +1090 01517 2013 ISZ PDLXR +1091 01520 2154 GS5, ISZ PT1 /SET POINTER TO DATA +1092 01521 2154 ISZ PT1 +1093 01522 5502 POPJ +1094 //// +1095 01523 1575 P0, FLTZER +1096 +1097 /IGNORE LEADING SPACES - "SPNOR" +1098 +1099 SUBS=. +1100 01524 0000 XSPNOR, 0 +1101 01525 1142 TAD CHAR +1102 01526 1063 TAD M240 +1103 01527 7640 SZA CLA +1104 01530 5724 JMP I XSPNOR +1105 01531 4506 GETC +1106 01532 5325 JMP XSPNOR+1 +1107 ///// +1108 /SEE IF NEXT CHARACTER IS A NUMBER +1109 01533 0000 XTESTN, 0 /RETURNS: .; OTHER; NUMBER - "TESTN" +1110 01534 1142 TAD CHAR +1111 01535 1064 TAD MPER /TEST FOR . +1112 01536 7440 SZA +1113 01537 2333 ISZ XTESTN /NOT A . +1114 01540 1352 TAD NTST1 /COMPARE TO "9" +1115 01541 7500 SMA +1116 01542 5350 JMP NTEXIT /TOO LARGE +1117 01543 1353 TAD NTST2 /COMPARE TO "0" +1118 01544 7510 SPA +1119 01545 5350 JMP NTEXIT /TOO SMALL +1120 01546 3127 DCA SORTCN /FOUND DIGIT, SAVE IT +1121 01547 2333 ISZ XTESTN +1122 01550 7300 NTEXIT, CLA CLL +1123 01551 5733 JMP I XTESTN +1124 ///// +1125 01552 7764 NTST1, 256-272 +1126 01553 0012 NTST2, 272-260 +1127 /EXIT FROM A "DO" SUBROUTINE +1128 +1129 +1130 01554 1323 RETRN, TAD P0 /(PC) => 0 +1131 01555 3145 DCA PC +1132 01556 1413 XPOPJ, TAD I PDLXR /RECURSIVE EXIT - "POPJ" +1133 01557 3157 DCA T2 +1134 01560 5557 JMP I T2 +1135 +1136 +1137 /ASK-TYPE CONTROL CHARACTER TABLE +1138 01561 1362 ATLIST, TAB /& - TABULATION DELIMITER +1139 01562 1260 TINTR /% - FORMAT DELIMITER +1140 01563 1241 TQUOT /" - LITERAL DELIMITER +1141 01564 1250 TCRLF /! - CARRIAGE RETURN AND LINE FEED +1142 01565 1254 TCRLF2 /# - CARRIAGE RETURN ONLY +1143 01566 3125 TDUMP /$/- DUMP THE SYMBOL TABLE CONTENTS +1144 01567 1252 TASK4 /SP- TERMINATOR FOR NAMES +1145 01570 1252 TASK4 /, - TERMINATOR FOR EXPRESSIONS +1146 01571 0615 PROCESS /; - TERMINATOR FOR COMMANDS +1147 01572 0620 PC1 /C.R. - TERMINATOR FOR STRINGS +1148 ///// +1149 01573 0001 FLTONE, 0001 +1150 01574 2000 2000 +1151 01575 0000 FLTZER, 0000 +1152 01576 0000 0000 +1153 01577 0000 0000 +1154 /EVALUATE AN EXPRESSION WHICH +1155 /TERMINATES WITH AN R-PAR,; OR C.R. AND +1156 /LEAVE THE RESULT IN FLAC AND IN FLARG. +1157 +1158 +1159 +1160 +1161 01600 4506 GETC /MOVE PAST EXTRA CHARACTER +1162 01601 3130 EVAL, DCA LASTOP /EVAUATION CONTROLLER (CHECKPOINT ?) +1163 01602 4525 TESTC /TEST CHARACTER AND IGNORE SPACES +1164 01603 5215 JMP ETERM1 /TERMIOATION +1165 01604 5332 JMP ENUM /NUMBER +1166 01605 5342 JMP EFUN /FUNCTION +1167 01606 4501 PUSHJ /LETTER OF VARIABLE +1168 01607 1411 GETVAR /FIND OR CREATE VARIABLE;ALSO SET PT1. +1169 01610 4525 OPNEXT, TESTC /PT1=>ARG +1170 01611 5236 JMP ETERMN /T +1171 01612 0212 ECHOLST,0212 /N-ERROR IN FORMAT +1172 01613 0377 0377 /F +1173 01614 4526 ERROR4 /L - MISSING OPERATOR +1174 ///// +1175 01615 4504 ETERM1, PUSHF /INITIALIZE RESULT TO ZERO. +1176 01616 1575 FLTZER +1177 01617 4505 POPF +1178 01620 2034 FLARG +1179 01621 1160 TAD FLARGP /SET PT1. +1180 01622 3154 DCA PT1 +1181 01623 1034 TAD M2 /TEST FOR UNARY OPERATIONS +1182 01624 1127 TAD SORTCN +1183 01625 7450 SNA +1184 01626 5241 JMP ETERM /CREATE DUMMY FOR UNARY MINUS +1185 01627 7001 IAC +1186 01630 7650 SNA CLA +1187 01631 5323 JMP ARGNXT /IGNORE UNARY PLUS +1188 01632 1127 TAD SORTCN /TEST FOR NULL PARENS. +1189 01633 1070 TAD M11 +1190 01634 7710 SPA CLA +1191 01635 5353 JMP ELPAR /MIGHT BE AN L-PAR. +1192 01636 4523 ETERMN, TSTLPR +1193 01637 7410 SKP +1194 01640 4526 ERROR4 /OPERATOR MISSING BEFORE PAREN +1195 01641 1127 ETERM, TAD SORTCN /SET FROM "TESTC"-"SORTC" +1196 01642 3147 DCA THISOP +1197 01643 1147 TAD THISOP +1198 01644 1070 TAD M11 +1199 01645 7700 SMA CLA /END? +1200 01646 3147 DCA THISOP /"THISOP" EQUIV. TO END OF EXP. +1201 +1202 01647 7201 ETERM2, CLA IAC /COMPARE PRIORITIES +1203 01650 0147 AND THISOP /PRIORITIES ARE: (^),(*/),(+-),PUT +1204 01651 1147 TAD THISOP +1205 01652 7041 CIA +1206 01653 3274 DCA FLOPR +1207 01654 7001 IAC +1208 01655 0130 AND LASTOP +1209 01656 1130 TAD LASTOP +1210 01657 1274 TAD FLOPR +1211 01660 7710 SPA CLA +1212 01661 5310 JMP EPAR /CONTINUE +1213 01662 1130 TAD LASTOP /FIND OPERATION FROM TABLE +1214 01663 1331 TAD OPTABL +1215 01664 3274 DCA FLOPR +1216 01665 1674 TAD I FLOPR +1217 01666 3274 DCA FLOPR +1218 01667 1130 TAD LASTOP +1219 01670 7640 SZA CLA /TEST FOR END OF DATA INTO FLOATING AC. +1220 01671 4505 POPF /GET LAST DATA +1221 01672 0044 FLAC +1222 01673 4407 FENT +1223 01674 0000 FLOPR, 00 /(FLOPR I PT1) +-*/^ +1224 01675 6560 FPT I FLARGP /SAVE RESULT +1225 01676 0000 FEXT +1226 01677 1160 TAD FLARGP +1227 01700 3154 DCA PT1 +1228 01701 1147 TAD THISOP +1229 01702 1130 TAD LASTOP /=0? +1230 01703 7650 SNA CLA +1231 01704 5502 POPJ /EXIT "EVAL" +1232 01705 1413 POPA /GET PRIOR OP +1233 01706 3130 DCA LASTOP +1234 01707 5247 JMP ETERM2 /COMPARE THIS OP +1235 ///// +1236 01710 4523 EPAR, TSTLPR /TEST FOR SUB-EXPRESSION +1237 01711 7410 SKP +1238 01712 5355 JMP EPAR2 /GO EVALUATE EXPRESSION +1239 01713 1130 TAD LASTOP /CONTINUE READING THE EXPRESSION +1240 01714 4503 PUSHA /SAVE "LASTOP". +1241 01715 1154 TAD PT1 +1242 01716 3320 DCA .+2 +1243 01717 4504 PUSHF /SAVE LAST ARGUMENT +1244 01720 0000 00 +1245 01721 1147 TAD THISOP /MORE TO COME +1246 01722 3130 DCA LASTOP +1247 01723 4506 ARGNXT, GETC /READ 1ST CHAR OF AN ARG. +1248 01724 4525 TESTC /DO SPECIAL CHECK +1249 01725 5353 JMP ELPAR /COULD BE LEFT PAREN +1250 01726 5332 JMP ENUM /N +1251 01727 5342 JMP EFUN /F +1252 01730 5206 JMP OPNEXT-2 /L +1253 01731 2026 OPTABL, OPTABS +1254 ///// +1255 +1256 01732 4504 ENUM, PUSHF /TO PROCESS A NUMBER,SAVE AC +1257 01733 0044 FLAC +1258 01734 1160 TAD FLARGP /SET POINTER AS FOR A VARIABLE. +1259 01735 3154 DCA PT1 +1260 01736 4473 JMS I FINPUT /READ TEXT NUMBER => (PT1) +1261 01737 4505 POPF /RESTORE THE AC +1262 01740 0044 FLAC +1263 01741 5210 JMP OPNEXT /CONTINUE +1264 ///// +1265 01742 3274 EFUN, DCA FLOPR /SET CODE +1266 01743 4506 GETC /READ FUNCTION NAME.(1,2,OR 3 LETTERS) +1267 01744 4511 SORTC /LOOK FOR TERMINATION CHARACTER. +1268 01745 2005 TERMS-1 +1269 01746 5364 JMP EFUN2 /YES +1270 01747 1274 TAD FLOPR /NO +1271 01750 7104 CLL RAL /MISH-MASH HASH CODE +1272 01751 1142 TAD CHAR +1273 01752 5342 JMP EFUN +1274 01753 4523 ELPAR, TSTLPR +1275 01754 4526 ERROR4 /DOUBLE OPERATORS +1276 01755 1127 EPAR2, TAD SORTCN /LEFT PARENS FOUND. +1277 01756 4503 PUSHA +1278 01757 1130 TAD LASTOP /SAVE DATA +1279 01760 4503 PUSHA +1280 01761 4501 PUSHJ /EVALUATE THE EXPRESSION +1281 01762 1600 EVAL-1 +1282 01763 5500 JMP I EFUN3I +1283 /// +1284 01764 1127 EFUN2, TAD SORTCN /SAVE 'SORTCN','LASTOP',AND FUNC CODE +1285 01765 4503 PUSHA +1286 01766 1130 TAD LASTOP +1287 01767 4503 PUSHA +1288 01770 1274 TAD FLOPR /SAVE FUNCTION CODE. +1289 01771 4503 PUSHA +1290 01772 4523 TSTLPR +1291 01773 4526 ERROR4 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT +1292 01774 4501 PUSHJ /YES +1293 01775 1600 EVAL-1 +1294 01776 1413 POPA /BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I. +1295 01777 4510 SORTJ +1296 02000 2207 FNTABL-1 +1297 02001 6361 FNTABF-FNTABL +1298 02002 4526 ERROR2 /ILLEGAL FUNCTION NAME. +1299 ///// +1300 +1301 02003 0241 241 /! +1302 02004 0242 242 /" +1303 02005 0256 256 /. -FOR INPUT NUMBERS +1304 TERMS=. /TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR' +1305 02006 0240 240 /SPACE 0 +1306 02007 0253 253 /+ 1 +1307 02010 0255 255 /- 2 +1308 02011 0257 257 // 3 +1309 02012 0252 252 /* 4 +1310 02013 0336 336 /UP ARR 5 +1311 02014 0250 250 /( 6 L-PARS +1312 02015 0333 333 /[ 7 +1313 02016 0274 274 /< 10 +1314 02017 0251 251 /) 11 R-PARS +1315 02020 0335 335 /] 12 +1316 02021 0276 276 /> 13 +1317 02022 0254 254 /, 14 +1318 02023 0273 273 /; 15 +1319 02024 0215 215 /C.R. 16 +1320 02025 0275 275 /= TO END GETARG FROM 'SET' +1321 02026 5554 OPTABS, FGT I PT1 +1322 02027 1554 FAD I PT1 +1323 02030 2554 FSB I PT1 +1324 02031 4554 FDV I PT1 +1325 02032 3554 FMY I PT1 +1326 02033 0554 FPW I PT1 +1327 ///// +1328 02034 0000 FLARG, 0 /DATA TEMPORARY STORAGE +1329 02035 0000 0 +1330 02036 0000 0 +1331 ///// +1332 /FOCAL TEXT FOR "HELLO" COMMAND +1333 02037 7056 HPT, 7056 /[T %] 8.4; +1334 02040 6473 6473 +1335 02041 1740 1740 /OPTION K,T,I,E,:,S; +1336 02042 1354 1354 +1337 02043 2454 2454 +1338 02044 1154 1154 +1339 02045 0554 0554 +1340 02046 7254 7254 +1341 02047 2373 2373 +1342 02050 0540 0540 /ERASE ALL +1343 02051 0177 0177 +1344 02052 1500 1500 +1345 ///// +1346 /ABSOLUTE VALUE FUNCTION +1347 02053 1045 XABS, TAD FLAC1 +1348 02054 7710 SPA CLA +1349 02055 4450 NEGATE +1350 /CONTINUATION OF FUNCTION CALLS. +1351 +1352 02056 1413 EFUN3, POPA /RESTORE LAST OPERATION +1353 02057 3130 DCA LASTOP +1354 02060 4407 FENT +1355 02061 7000 FNR /NORMALIZE FUNCTION RETURN +1356 02062 6034 FPT FLARG +1357 02063 0000 FEXT +1358 02064 1160 TAD FLARGP /SET POINTER +1359 02065 3154 DCA PT1 +1360 02066 1413 POPA /GET LAST PAREN CODE. +1361 02067 7041 CIA /CHECK FOR PAREN MATCH. +1362 02070 1066 TAD M3 +1363 02071 1127 TAD SORTCN /(STILL SET FROM THE LAST "EVAL") +1364 02072 7640 SZA CLA /SKIP IF MATCH +1365 02073 4526 ERROR4 /PAREN ERROR +1366 02074 4506 GETC /MOVE PAST R-PAR, AND RETURN TO OPNEX. +1367 02075 5676 JMP I .+1 /FUNCTION RETURN IS OK +1368 02076 1610 OPNEXT +1369 //// +1370 +1371 02077 0000 LPRTST, 0 /SKIP IF LEFT PAREN. - 'TSTLPR' +1372 02100 1127 TAD SORTCN +1373 02101 1070 TAD M11 +1374 02102 7700 SMA CLA +1375 02103 5677 JMP I LPRTST +1376 02104 1127 TAD SORTCN +1377 02105 1067 TAD M5 +1378 02106 7740 SMA SZA CLA +1379 02107 2277 ISZ LPRTST +1380 02110 5677 JMP I LPRTST +1381 +1382 /THE DELETE A LINE ROUTINE +1383 +1384 02111 4516 DELETE, FINDLN /SETS "THISLN" AND "LASTLN". +1385 02112 5502 POPJ /ALREADY GONE +1386 02113 2151 ISZ DEBGSW /DISABLE TRACE +1387 02114 4506 GETC /MEASURE LENGTH +1388 02115 1142 TAD CHAR +1389 02116 1065 TAD MCR +1390 02117 7640 SZA CLA +1391 02120 5314 JMP .-4 +1392 02121 1017 TAD AXOUT /SAVE LAST ADDRESS +1393 02122 7040 CMA +1394 02123 1146 TAD THISLN +1395 02124 3132 DCA CNTR /LENGTH < 0 +1396 02125 1546 TAD I THISLN /DISCONNECT +1397 02126 3550 DCA I LASTLN +1398 02127 1075 TAD CFRS /START LIST AT TOP +1399 02130 3157 DOK, DCA T2 /EXAMINATION ADDRESS +1400 02131 1557 TAD I T2 /GET THE NEXT ADDR. +1401 02132 7450 SNA /TEST FOR END +1402 02133 5346 JMP DONE /YES-WRAP UP ALL. +1403 02134 3156 DCA T1 /SAVE NEXT ADDRESS. +1404 02135 1146 TAD THISLN /COMPARE LINE POSITIONS +1405 02136 7141 CIA CLL +1406 02137 1156 TAD T1 +1407 02140 7630 SZL CLA /SKIP IF THISLN > X +1408 02141 1132 TAD CNTR /CHANGE (X) TO ACCOUNT FOR +1409 02142 1156 TAD T1 /GARBAGE COLLECTION. +1410 02143 3557 DCA I T2 +1411 02144 1156 TAD T1 /GET NEXT +1412 02145 5330 JMP DOK +1413 ///// +1414 /GARBAGE COLLECTION +1415 +1416 02146 7040 DONE, CMA /BACKUP L FOR XR +1417 02147 1146 TAD THISLN +1418 02150 3011 DCA XRT +1419 02151 1132 TAD CNTR /SETUP END OF HOSE +1420 02152 7040 CMA +1421 02153 1146 TAD THISLN +1422 02154 3012 DCA XRT2 +1423 02155 1132 TAD CNTR /CORRECT END OF BUFFER POINTER. +1424 02156 1134 TAD BUFR +1425 02157 3134 DCA BUFR +1426 02160 1010 TAD AXIN /COMPUTE COUNT +1427 02161 7040 CMA +1428 02162 1012 TAD XRT2 +1429 02163 3156 DCA T1 +1430 02164 1010 TAD AXIN +1431 02165 1132 TAD CNTR +1432 02166 3010 DCA AXIN +1433 02167 1412 TAD I XRT2 /SIPHON LOWER PART. +1434 02170 3411 DCA I XRT +1435 02171 2156 ISZ T1 +1436 02172 5367 JMP .-3 +1437 02173 5311 JMP DELETE /RESET 'LASTLN','THISLN', AND DATA`FIELD. +1438 ///// +1439 /OPTION TABLE +1440 02174 6457 OPTTBL, OPTK /SWITCH TO KEYBOARD INPUT +1441 02175 6453 OPTR /READER INPUT +1442 02176 3237 OPTT /TTY OUTPUT +1443 02177 3234 OPTP /PUNCH OUTPUT +1444 02200 3303 OPTI /INTERPRETIVE/NUMERIC I/O +1445 02201 3302 OPTC /SINGLE CHARACTER I/O +1446 02202 3244 OPTCOL /PRINT ":" AT "ASK" +1447 02203 3243 OPTX /SUPPRESS ":" +1448 02204 3252 OPTE /ECHO KEYBOARD INPUT +1449 02205 3253 OPTN /NO ECHO +1450 02206 3256 OPTS /SET VARIABLE TERMINATOR +1451 02207 3271 OPTM /START DISK MONITOR +1452 +1453 FNTABL=. +1454 02210 2533 2533 /ABS +1455 02211 2650 2650 /SGN +1456 02212 2636 2636 /ITR +1457 02213 2565 2565 /DIS +1458 02214 2630 2630 /RAN +1459 02215 2623 2623 /DXS +1460 02216 2517 2517 /ADC +1461 02217 2572 2572 /ATN +1462 02220 2624 2624 /EXP +1463 02221 2625 2625 /LOG +1464 02222 2654 2654 /SIN /LIST OF CODED FUNCTION NAMES +1465 02223 2575 2575 /COS +1466 02224 2702 2702 /SQT +1467 02225 2631 2631 /NEW +1468 /ERASE SINGLE LINES, GROUPS, OR VARIABLES +1469 02226 1142 ERASE, TAD CHAR /SEE IF "ALL" +1470 02227 1003 TAD MINUSA +1471 02230 7640 SZA CLA +1472 02231 5240 JMP ERVX +1473 02232 1077 TAD ENDT /YES, ERASE ALL TEXT +1474 02233 3134 DCA BUFR +1475 02234 3475 DCA I CFRS +1476 02235 1134 ERV, TAD STARTV /ERASE VARIABLES +1477 02236 3155 DCA LASTV +1478 02237 5177 JMP START /PROGRAM EXECUTION ENDS +1479 ///// +1480 02240 4515 ERVX, GETLN /GET LINE NUMBER +1481 02241 1143 TAD LINENO /SEE OF ZERO OR NONE +1482 02242 7640 SZA CLA +1483 02243 5250 JMP ERL /NO, ERASE LINES +1484 02244 1134 TAD STARTV /YES, ERASE VARIABLES +1485 02245 3155 DCA LASTV +1486 02246 5647 JMP I .+1 /CONTINUE PROCESSING +1487 02247 0616 PROC +1488 ///// +1489 02250 1134 ERL, TAD BUFR /ERASE LINES +1490 02251 3010 DCA AXIN +1491 02252 4501 ERG, PUSHJ /EXTRACT ONE LINE +1492 02253 2111 DELETE +1493 02254 2146 ISZ THISLN +1494 02255 1141 TAD NAGSW +1495 02256 7700 SMA CLA +1496 02257 1546 TAD I THISLN +1497 02260 4524 TSTGRP /IF GROUP, SEE IF END OF GROUP +1498 02261 5235 JMP ERV /YES +1499 02262 1546 TAD I THISLN /NO, CONTINUE ERASING GROUP +1500 02263 3143 DCA LINENO +1501 02264 5252 JMP ERG +1502 /ROUTINE CALLED VIA "FINDLN": +1503 +1504 /SEARCH FOR A GIVEN LINE I.D. =[ "LINENO" ] +1505 /1ST RETURN IF NOT FOUND, +1506 /2AND IF FOUND. +1507 /"THISLN" = FOUND LINE OR NEXT LARGER. +1508 /"LASTLN" = LESSER AND/OR LAST. +1509 /"TEXTP" IS SET +1510 +1511 02265 0000 XFIND, 0 +1512 02266 1075 TAD CFRS /INITIALIZE POINTERS TO FIRST LINE +1513 02267 3150 DCA LASTLN +1514 02270 1075 TAD CFRS +1515 02271 3146 FINDN, DCA THISLN /SAVE THIS ONE +1516 02272 1146 TAD THISLN +1517 02273 3012 DCA XRT2 +1518 02274 1143 TAD LINENO +1519 02275 7041 CIA +1520 02276 1412 TAD I XRT2 /LINENO=0 WILL ALSO BE FOUND +1521 02277 7450 SNA +1522 02300 2265 ISZ XFIND /FOUND IT (2ND EXIT) +1523 02301 7700 SMA CLA +1524 02302 5310 JMP FEND3 /PAST IT. +1525 02303 1146 TAD THISLN /MOVE POINTERS +1526 02304 3150 DCA LASTLN +1527 02305 1546 TAD I THISLN +1528 02306 7440 SZA /SKIP IF END OF TEST +1529 02307 5271 JMP FINDN +1530 02310 1146 FEND3, TAD THISLN +1531 02311 7001 IAC +1532 02312 3017 DCA AXOUT /SET "TEXTP". +1533 02313 3020 DCA XCT +1534 02314 5665 JMP I XFIND +1535 +1536 02315 0000 UTRA, 0 /UNPACK CHARACTER. - "GETC" +1537 02316 4351 JMS GET1 +1538 02317 7710 UTE, SPA CLA /NORM & EXTEND +1539 02320 1006 TAD C100 /300-337 & 340-376 +1540 02321 1377 TAD M137 /240-276 & 200-236 +1541 02322 1142 TAD CHAR +1542 02323 7450 SNA +1543 02324 5337 JMP UTX /"?" FOUND +1544 02325 1054 TAD P337 +1545 02326 3142 UTQ, DCA CHAR +1546 02327 1151 TAD DEBGSW +1547 02330 1152 TAD DMPSW +1548 02331 7650 SNA CLA /PRINT ONLY IF BOTH ARE ZERO. +1549 02332 4512 PRINTC +1550 02333 5715 JMP I UTRA +1551 ////// +1552 02334 4351 EXTR, JMS GET1 +1553 02335 7040 CMA +1554 02336 5317 JMP UTE +1555 /// +1556 02337 1151 UTX, TAD DEBGSW /TEST FOR TRACE-ENABLED +1557 02340 7640 SZA CLA +1558 02341 5347 JMP .+6 +1559 02342 1152 TAD DMPSW /FLIP THE TRACE FLOP +1560 02343 7650 SNA CLA +1561 02344 7001 IAC +1562 02345 3152 DCA DMPSW +1563 02346 5316 JMP UTRA+1 /GET NEXT CHARACTER INSTEAD. +1564 02347 1032 TAD P277 /TRACE DISABLED = RETURN "?" +1565 02350 5326 JMP UTQ +1566 +1567 02351 0000 GET1, 0 /UNPACK 6-BITS +1568 02352 2020 ISZ XCT /STARTS=0 +1569 02353 5366 JMP GET3 +1570 02354 1021 TAD GTEM +1571 02355 0071 GEND, AND P77 +1572 02356 3142 DCA CHAR /SAVE +1573 02357 1142 TAD CHAR +1574 02360 1023 TAD M77 +1575 02361 7650 SNA CLA +1576 02362 5334 JMP EXTR /EXTENDED +1577 02363 1142 TAD CHAR +1578 02364 1376 TAD M40 +1579 02365 5751 JMP I GET1 +1580 ///// +1581 +1582 02366 1417 GET3, TAD I AXOUT /(X-MEM) +1583 02367 3021 DCA GTEM +1584 02370 7040 CMA +1585 02371 3020 DCA XCT +1586 02372 1021 TAD GTEM +1587 02373 4520 RTL6 +1588 02374 7004 RAL +1589 02375 5355 JMP GEND +1590 02376 7740 M40, -40 +1591 02377 7641 M137, -137 +1592 ///// +1593 /OPTION LIST +1594 02400 0313 OPTLST, "K +1595 02401 0322 "R +1596 02402 0324 "T +1597 02403 0320 "P +1598 02404 0311 "I +1599 02405 0303 "C +1600 02406 0272 ": +1601 02407 0330 "X +1602 02410 0305 "E +1603 02411 0316 "N +1604 02412 0323 "S +1605 02413 0315 "M +1606 ///// +1607 /ANALOG-DIGITAL CONVERSION +1608 02414 6004 XADC, 6004 +1609 02415 3045 DCA FLAC1 /ARG MUST BE 0 +1610 02416 5500 RETURN +1611 +1612 02417 0000 XENDLN, 0 /TERMINATE THE BUFFERED LINE - "ENDLN" +1613 02420 1550 TAD I LASTLN /SAVE OLD POINTER +1614 02421 3534 DCA I BUFR +1615 02422 1134 TAD BUFR /POINT TO NEW LAST LINE +1616 02423 3550 DCA I LASTLN +1617 02424 1135 TAD ADD /CHECK FOR EXTRA INFO +1618 02425 7440 SZA +1619 02426 3410 DCA I AXIN +1620 02427 1010 TAD AXIN /COMPUTE NEW`END OF BUFFER +1621 02430 7001 IAC +1622 02431 3134 DCA BUFR +1623 02432 1134 TAD STARTV /RESET VARIABLE LIST +1624 02433 3155 DCA LASTV +1625 02434 5617 JMP I XENDLN +1626 ///// +1627 02435 0000 TXTSAV, 0 /SAVE CHAR AND TEXT POINTERS +1628 02436 4504 PUSHF +1629 02437 0017 TEXTP +1630 02440 1142 TAD CHAR +1631 02441 4503 PUSHA +1632 02442 5635 JMP I TXTSAV +1633 / +1634 02443 0000 TXTRES, 0 /RESTORE SAME +1635 02444 1413 POPA +1636 02445 3142 DCA CHAR +1637 02446 4505 POPF +1638 02447 0017 TEXTP +1639 02450 5643 JMP I TXTRES +1640 ///// +1641 02451 0000 GRPTST, 0 /AC VS LINENO - "TSTGRP" +1642 02452 0024 AND P7600 +1643 02453 7041 CIA +1644 02454 3157 DCA T2 +1645 02455 1143 TAD LINENO +1646 02456 0024 AND P7600 +1647 02457 1157 TAD T2 +1648 02460 7650 SNA CLA +1649 02461 2251 ISZ GRPTST +1650 02462 5651 JMP I GRPTST +1651 /I-O SUBROUTINES +1652 +1653 VAL=. +1654 02463 0000 CHIN, 0 /READ IN A CHARACTER SUBR. - "READC" +1655 02464 4540 JMS I INDEV +1656 02465 3142 DCA CHAR +1657 02466 4511 SORTC /LINEFEED OR RUBOUT? +1658 02467 1611 ECHOLST-1 +1659 02470 5663 JMP I CHIN /YES +1660 02471 4512 ECHO, PRINTC +1661 02472 1142 TAD CHAR /SEE IF 200 (L/T) +1662 02473 1024 TAD P7600 +1663 02474 7640 SZA CLA +1664 02475 5663 JMP I CHIN /NO, EXIT +1665 02476 5264 JMP CHIN+1 /YES, GET ANOTHER +1666 ///// +1667 02477 0000 OUT, 0 /OUTPUT A CHARACTER - "PRINTC" +1668 02500 7450 SNA /USE (AC) OR (CHAR) +1669 02501 1142 TAD CHAR +1670 02502 1065 TAD MCR +1671 02503 7450 SNA +1672 02504 5310 JMP OUTCR +1673 02505 1060 TAD CCR +1674 02506 4537 JMS I OUTDEV +1675 02507 5677 OUTX, JMP I OUT +1676 ///// +1677 02510 1060 OUTCR, TAD CCR +1678 02511 4537 JMS I OUTDEV +1679 02512 1057 TAD CLF +1680 02513 5306 JMP OUTX-1 +1681 ///// +1682 /TEST FOR A COMMA, SEMICOLON, OR CR - "TSTERM" +1683 /RETURNS: OTHER, ; OR CR, COMMA +1684 /GETS NEXT CHARACTER AFTER COMMA OR OTHER +1685 02514 0000 XTSTER, 0 +1686 02515 4511 SORTC /LOOK FOR ,;CR +1687 02516 1141 TLIST-1 +1688 02517 7410 SKP +1689 02520 5326 JMP .+6 /OTHER, GO PAST IT +1690 02521 1127 TAD SORTCN /FOUND ONE, SEE WHAT IT IS +1691 02522 2314 ISZ XTSTER +1692 02523 7640 SZA CLA +1693 02524 5714 JMP I XTSTER /; OR CR: 2ND EXIT +1694 02525 2314 ISZ XTSTER /COMMA, 3RD EXIT +1695 02526 4506 GETC +1696 02527 5714 JMP I XTSTER +1697 ///// +1698 +1699 COMEIN=.-1 /COMMAND-INPUT BUFFER LIVES HERE. +1700 +1701 COMOUT=2600 +1702 *COMOUT +1703 +1704 /INTERRUPT PROCESSOR. +1705 +1706 02600 0000 SAVAC, 0 /CONTENTS OF AC +1707 02601 0000 SAVLK, 0 /CONTENTS OF LINK +1708 02602 7575 MBREAK, -203 /CONTROL-C +1709 02603 3200 INTRPT, DCA SAVAC /SAVE WORKING DATA +1710 02604 7010 RAR +1711 02605 3201 DCA SAVLK +1712 02606 6031 KSF /CHECK FOR KEYBOARD FIRST +1713 02607 5225 JMP TINT +1714 02610 6036 KRB /READ BUFFER AND CLEAR FLAG TO FETCH NEXT +1715 02611 0026 AND P177 /IGNORE PARITY BIT +1716 02612 1015 TAD C200 +1717 02613 3306 DCA SIN +1718 02614 1306 TAD SIN +1719 02615 1202 TAD MBREAK /MANUAL STOP? +1720 02616 7650 SNA CLA +1721 02617 5345 JMP RECOVR +1722 02620 1264 TAD INBUF /ANY SPACE? +1723 02621 7640 SZA CLA +1724 02622 4526 ERROR2 /WILL WAIT FOR OUTPUT BUFFER +1725 02623 1306 TAD SIN +1726 02624 3264 DCA INBUF /SAVE INPUT +1727 02625 6041 TINT, TSF +1728 02626 5244 JMP EXIT +1729 02627 6042 TCF +1730 02630 3260 DCA TELSW /TURN OFF THE IN-PROGRESS FLAG. +1731 02631 1663 TAD I OPTRI +1732 02632 7450 SNA +1733 02633 5244 JMP EXIT /DONE +1734 02634 6044 TPC /TYPE NEXT. +1735 02635 3260 DCA TELSW /CLEAR AC AND TURN ON THE FLAG. +1736 02636 3663 DCA I OPTRI /ZERO OUT THE DATA AREA +1737 02637 1263 TAD OPTRI +1738 02640 7001 IAC +1739 02641 0031 AND P17 +1740 02642 1261 TAD OPTR0 +1741 02643 3263 DCA OPTRI +1742 02644 6244 EXIT, 6244 /RESTORE MEMORY FIELD +1743 02645 6101 6101 /SMP +1744 02646 7000 NOP /(HLT)-IF YOU HAVE MEMORY PARITY +1745 02647 6011 RSF /TEST H.S. READER FLAG +1746 02650 5253 JMP .+3 +1747 02651 6012 RRB /READ BUFFER AND CLEAR FLAG +1748 02652 3037 DCA HINBUF /SAVE CHARACTER +1749 02653 1201 TAD SAVLK +1750 02654 7104 RAL CLL +1751 02655 1200 TAD SAVAC +1752 02656 6001 ION +1753 02657 5400 EXITJ, JMP I 0 +1754 +1755 02660 0001 TELSW, 1 /INPUT SWITCH +1756 02661 3400 OPTR0, IOBUF /OUTPUT POINTERS +1757 02662 3400 OPTRO, IOBUF /VARS +1758 02663 3400 OPTRI, IOBUF +1759 02664 0000 INBUF, 0 /KEYBOARD BUFFER. +1760 ///// +1761 02665 0000 XI33, 0 /VIA (INDEV) +1762 02666 1264 TAD INBUF /ANY INPUT? +1763 02667 7550 SPA SNA +1764 02670 5266 JMP .-2 /NO = WAIT +1765 02671 3275 DCA XOUTL +1766 02672 3264 DCA INBUF /CLEAR INPUT BUFFER +1767 02673 1275 TAD XOUTL +1768 02674 5665 JMP I XI33 +1769 ///// +1770 02675 0000 XOUTL, 0 /VIA (OUTDEV) +1771 02676 3265 DCA XI33 /SAVE CURRENT CHARACTER. +1772 02677 1265 TAD XI33 /IS IT A CR? +1773 02700 1065 TAD MCR +1774 02701 7650 SNA CLA +1775 02702 3053 DCA TABCTR /YES, RESET CARRIAGE INDEX +1776 02703 1265 TAD XI33 +1777 02704 4732 JMS I SKPNP /SKIP IF A NON-PRINTING CHARACTER +1778 02705 2053 ISZ TABCTR /PRINTING: INCREMENT INDEX +1779 02706 0000 SIN, 0 +1780 02707 6001 ION /BE SURE INTERRUPT IS ON. +1781 02710 1662 TAD I OPTRO /ANY ROOM? +1782 02711 7640 SZA CLA /A CHARACTER IS NON-ZERO +1783 02712 5310 JMP .-2 /NO = WAIT. +1784 02713 1260 TAD TELSW /IN PROGRESS? +1785 02714 7640 SZA CLA +1786 02715 5322 JMP .+5 +1787 02716 1265 TAD XI33 /NO +1788 02717 6046 TLS /TYPE CHARACTER. +1789 02720 3260 DCA TELSW /SET IN-PROGRESS FLAG. +1790 02721 5675 JMP I XOUTL /RETURN +1791 02722 1265 TAD XI33 /SEND DATA +1792 02723 3662 DCA I OPTRO +1793 02724 1262 TAD OPTRO /SET POINTERS +1794 02725 7001 IAC +1795 02726 0031 AND P17 +1796 02727 1261 TAD OPTR0 +1797 02730 3262 DCA OPTRO +1798 02731 5675 JMP I XOUTL +1799 /////// +1800 02732 3014 SKPNP, SKIPNP +1801 ERROR2=ERROR; ERROR3=ERROR; ERROR4=ERROR +1802 02733 3225 WAITP, OWAIT +1803 02734 3203 OPTDOP, OPTTDO +1804 02735 3336 ERROR5, DCA .+1 /ERROR CALLED FROM A TABLE +1805 02736 0000 ERR2, 0 /LIMIT EXCEEDED +1806 02737 7240 CLA CMA /COMPUTE CALLING ADDRESS (ALSO "SPACE") +1807 02740 1336 TAD ERR2 /AND USE IT AS ERROR NUMBER. +1808 02741 3143 DCA LINENO /SAVE ERROR CODE. +1809 02742 4733 JMS I WAITP /WAIT FOR OUTPUT TO FINISH +1810 02743 6002 IOF /DISABLE INTERRUPT FOR INITIALIZATIONS +1811 02744 5347 JMP .+3 +1812 02745 1015 RECOVR, TAD C200 +1813 02746 3143 DCA LINENO /SAVE ERROR NUMBER +1814 02747 2260 ISZ TELSW /TURN ON IN-PROGRESS SWITCH +1815 02750 1025 TAD M20 /SETUP INIT COUNT +1816 02751 3132 DCA CNTR +1817 02752 7040 CMA +1818 02753 1261 TAD OPTR0 +1819 02754 3011 DCA XRT /INIT I/O BUFFERS. +1820 02755 3411 DCA I XRT +1821 02756 2132 ISZ CNTR +1822 02757 5355 JMP .-2 +1823 02760 3264 DCA INBUF /INIT KEY-BUFR. +1824 02761 1261 TAD OPTR0 /INIT TTY POINTERS. +1825 02762 3263 DCA OPTRI +1826 02763 1261 TAD OPTR0 +1827 02764 3262 DCA OPTRO +1828 02765 4734 JMS I OPTDOP /SET TO TTY OUTPUT +1829 02766 1161 TAD PTCH /RESET "READC" +1830 02767 3113 DCA 113 /IF AN ERROR OCCURS. +1831 02770 7040 CMA /PREPARE A STOP BIT FOR TTY +1832 02771 6046 TLS /AND RAISE FLAG +1833 02772 7200 CLA +1834 02773 1060 TAD CCR /PRINT A CR +1835 02774 4512 PRINTC +1836 02775 1032 TAD P277 /MAKE A ? +1837 02776 4512 PRINTC /AND TURN ON THE INTERRUPT +1838 02777 4514 PRNTLN /PRINT ERROR NUMBER AND, +1839 03000 2145 ISZ PC +1840 03001 1545 TAD I PC /UNLESS IT IS ZERO, (X-MEM) +1841 03002 7450 SNA +1842 03003 5211 JMP .+6 +1843 03004 3143 DCA LINENO +1844 03005 1062 TAD P7700 +1845 03006 4512 PRINTC +1846 03007 4512 PRINTC /PRINT SPACE AGAIN AND +1847 03010 4514 PRNTLN /PRINT LINE OF ERROR. +1848 03011 1060 TAD CCR +1849 03012 4512 PRINTC +1850 03013 5177 JMP START /INTERRUPT WILL BE RE-ENABLED SOON. +1851 ///// +1852 /SKIP IF (AC) IS A NON-PRINTING CHARACTER +1853 03014 0000 SKIPNP, 0 +1854 03015 4520 RTL6 /PRINTING CHARACTERS ARE 240-337 +1855 03016 7710 SPA CLA +1856 03017 7020 CML +1857 03020 7420 SNL +1858 03021 2214 ISZ SKIPNP +1859 03022 5614 JMP I SKIPNP +1860 ///// +1861 /PACK A CHARACTER INTO THE BUFFER - "PACKC" +1862 03023 0000 PACBUF, 0 +1863 03024 4510 SORTJ /LOOK FOR ? OR RUBOUT +1864 03025 3055 PACLST-1 +1865 03026 6126 PACLS2-PACLST +1866 03027 1142 TAD CHAR +1867 03030 4214 JMS SKIPNP /PRINTING CHARACTER? +1868 03031 5234 JMP .+3 /YES +1869 03032 1071 TAD P77 /NO, PACK 77 FIRST +1870 03033 4242 JMS PCK1 +1871 03034 1142 TAD CHAR /PACK 6-BIT CHARACTER +1872 03035 0071 AND P77 +1873 03036 4242 JMS PCK1 +1874 03037 5623 JMP I PACBUF +1875 ///// +1876 03040 1054 PQUES, TAD P337 /USE 337 FOR ? +1877 03041 5235 JMP .-4 +1878 ///// +1879 /PACK ONE 6-BIT WORD +1880 03042 0000 PCK1, 0 +1881 03043 2136 ISZ XCTIN +1882 03044 5260 JMP ROT /PACK LEFT HALF +1883 03045 1135 TAD ADD /PACK RIGHT HALF AND STORE +1884 03046 3410 DCA I AXIN +1885 03047 1013 TAD PDLXR /CHECK FOR SPACE +1886 03050 7141 CLL CIA +1887 03051 1005 TAD P13 +1888 03052 1010 TAD AXIN +1889 03053 7630 SZL CLA +1890 03054 4526 ERROR /BUFFER OR STORAGE OVERFLOW +1891 03055 5642 JMP I PCK1 +1892 ///// +1893 03056 0277 PACLST, 277 /? +1894 03057 0377 377 /RUBOUT +1895 ///// +1896 03060 4520 ROT, RTL6 /SAVE LEFT HALF +1897 03061 3135 DCA ADD +1898 03062 7040 CMA +1899 03063 3136 DCA XCTIN +1900 03064 5642 JMP I PCK1 +1901 /RUBOUT ONE CHARACTER +1902 03065 1010 RUB1, TAD AXIN /SAVE POINTER +1903 03066 3242 DCA PCK1 +1904 03067 1136 TAD XCTIN /CHARACTER IN ADD? +1905 03070 7640 SZA CLA +1906 03071 5277 JMP RUB2 /YES +1907 03072 1010 TAD AXIN /NO, BEGINNING OF BUFFER? +1908 03073 7041 CIA +1909 03074 1153 TAD PACKST +1910 03075 7700 SMA CLA +1911 03076 5322 JMP PKZERO /YES, IGNORE +1912 03077 1324 RUB2, TAD SPLAT /ECHO A BACKSLASH +1913 03100 4512 PRINTC +1914 03101 2136 ISZ XCTIN +1915 03102 5310 JMP RUB3 /BACKUP STORAGE +1916 03103 1642 TAD I PCK1 /KILL ADD AND CHECK FOR 77 +1917 03104 0071 AND P77 /IN 2ND HALF OF LAST STORED WORD +1918 03105 1023 TAD M77 +1919 03106 7640 SZA CLA +1920 03107 5322 JMP PKZERO /NO, DONE +1921 03110 1642 RUB3, TAD I PCK1 /KILL 2ND HALF OF LAST STORED WORD +1922 03111 0062 AND P7700 +1923 03112 3135 DCA ADD +1924 03113 7040 CMA /BACKUP POINTER +1925 03114 1010 TAD AXIN +1926 03115 3010 DCA AXIN +1927 03116 1135 TAD ADD /TEST FOR 77 IN ADD +1928 03117 1006 TAD C100 +1929 03120 7640 SZA CLA +1930 03121 7040 CMA +1931 03122 3136 PKZERO, DCA XCTIN +1932 03123 5623 JMP I PACBUF +1933 03124 0334 SPLAT, 334 +1934 /DUMP THE SYMBOL TABLE CONTENTS +1935 03125 4504 TDUMP, PUSHF /SAVE TEXT POINTERS +1936 03126 0017 TEXTP +1937 03127 7040 CMA +1938 03130 1134 TAD STARTV /START VARIABLE LIST +1939 03131 3014 TDLOOP, DCA FLTXR +1940 03132 1014 TAD FLTXR /TEST FOR END OF LIST +1941 03133 7040 CMA +1942 03134 1155 TAD LASTV +1943 03135 7650 SNA CLA +1944 03136 5370 JMP TDEND /END FOUND +1945 03137 1375 TAD TDTEXT /NO, SET UP POINTERS +1946 03140 3017 DCA AXOUT +1947 03141 3020 DCA XCT +1948 03142 1414 TAD I FLTXR /2 LETTERS OF VAR. NAME +1949 03143 3376 DCA TDTEXT+1 +1950 03144 4501 PUSHJ /PRINT NAME AND "(" +1951 03145 1241 TQUOT +1952 03146 1414 TAD I FLTXR /GET AND PRINT SUBSCRIPT +1953 03147 4774 JMS I TDOUTP +1954 03150 4501 PUSHJ /PRINT ")=" +1955 03151 1241 TQUOT +1956 03152 1005 TAD P13 /SPACE TO 11TH COLUMN +1957 03153 3046 DCA FLAC2 +1958 03154 4501 PUSHJ +1959 03155 1374 TAB+12 +1960 03156 2014 ISZ FLTXR +1961 03157 4407 FENT /PICK UP VALUE +1962 03160 5414 FGT I FLTXR /(DOES NOT AUTOINDEX) +1963 03161 0000 FEXT +1964 03162 4472 JMS I FOUTPUT /PRINT VALUE +1965 03163 1060 TAD CCR /AND A C.R. +1966 03164 4512 PRINTC +1967 03165 1014 TAD FLTXR /INCREMENT FOR NEXT VAR. +1968 03166 1035 TAD P2 +1969 03167 5331 JMP TDLOOP +1970 03170 4505 TDEND, POPF /RESTORE TEXT POINTERS +1971 03171 0017 TEXTP +1972 03172 5773 JMP I .+1 +1973 03173 1252 TASK4 +1974 03174 6100 TDOUTP, SIGOUT +1975 03175 3175 TDTEXT, . /THE FOLLOWING IS FOCAL TEXT +1976 03176 0000 0 /VAR. NAME GOES HERE +1977 03177 5077 5077 /"(" AND C.R. +1978 03200 1551 1551 /")=" AND C.R. +1979 03201 7577 7577 +1980 03202 1500 1500 +1981 /OPTION ROUTINES +1982 / +1983 /ROUTINE TO SET UP OUTPUT +1984 03203 0000 OPTTDO, 0 +1985 03204 1220 TAD CTSF +1986 03205 3621 DCA I OPTTL /TSF +1987 03206 1621 TAD I OPTTL +1988 03207 7001 IAC +1989 03210 3622 DCA I OPTTL+1 /TCF +1990 03211 1622 TAD I OPTTL+1 +1991 03212 1035 TAD P2 +1992 03213 3623 DCA I OPTTL+2 /TPC +1993 03214 1623 TAD I OPTTL+2 +1994 03215 1035 TAD P2 +1995 03216 3624 DCA I OPTTL+3 /TLS +1996 03217 5603 JMP I OPTTDO +1997 03220 6041 CTSF, TSF +1998 03221 2625 OPTTL, TINT +1999 03222 2627 TINT+2 +2000 03223 2634 TINT+7 +2001 03224 2717 SIN+11 +2002 ///// +2003 /ROUTINE TO WAIT UNTIL OUTPUT FINISHES +2004 03225 0000 OWAIT, 0 +2005 03226 6001 ION /(SWAP) - FOR 2-USER +2006 03227 1633 TAD I TSWP /LOOK AT TELSW +2007 03230 7640 SZA CLA +2008 03231 5226 JMP .-3 +2009 03232 5625 JMP I OWAIT +2010 03233 2660 TSWP, TELSW +2011 ///// +2012 03234 4225 OPTP, JMS OWAIT /SET UP FOR PUNCH OUTPUT +2013 03235 1025 TAD M20 /CONVERT TO PSF, ETC. +2014 03236 7410 SKP +2015 03237 4225 OPTT, JMS OWAIT /SET UP FOR TTY OUTPUT +2016 03240 4203 JMS OPTTDO +2017 03241 5642 OPTXIT, JMP I .+1 /EXIT OPTIONS +2018 03242 6461 OPTRET +2019 +2020 03243 1250 OPTX, TAD OPTC1 /SUPPRESS ":" ON ASK +2021 03244 1247 OPTCOL, TAD CPRINT /RESTORE ":" +2022 03245 3651 DCA I COLP +2023 03246 5241 JMP OPTXIT +2024 03247 4512 CPRINT, PRINTC +2025 03250 2466 OPTC1, CLA-PRINTC +2026 03251 1222 COLP, TASKCL +2027 ///// +2028 03252 1247 OPTE, TAD CPRINT /SET UP FOR KEYBOARD ECHO +2029 03253 3655 OPTN, DCA I ECHP /SUPPRESS ECHO +2030 03254 5241 JMP OPTXIT +2031 03255 2471 ECHP, ECHO +2032 ///// +2033 03256 4506 OPTS, GETC /SET UP USER TERMINATOR FOR "ASK" +2034 03257 4511 SORTC +2035 03260 2003 TERMS-3 +2036 03261 7410 SKP +2037 03262 5256 JMP .-4 +2038 03263 4501 PUSHJ /GET CHARACTER +2039 03264 1601 EVAL +2040 03265 4452 FIX +2041 03266 3670 DCA I USERTP +2042 03267 5241 JMP OPTXIT +2043 03270 6002 USERTP, USERT +2044 ///// +2045 03271 4225 OPTM, JMS OWAIT /EXIT TO DISK MONITOR +2046 03272 6002 IOF +2047 03273 5424 JMP I P7600 +2048 ///// +2049 /THIS IS THE INITIALIZATION COMMAND +2050 03274 1301 HELLO, TAD HP +2051 03275 3017 DCA AXOUT +2052 03276 3020 DCA XCT +2053 03277 4501 PUSHJ /START BY SETTING FORMAT +2054 03300 1260 TINTR +2055 ///// +2056 03301 2036 HP, HPT-1 /FOCAL TEXT "%8.4;O K,T,I,E,:,S;E A" +2057 / I/O MODE OPTIONS +2058 03302 7240 OPTC, CLA CMA +2059 03303 3305 OPTI, DCA IOSW +2060 03304 5241 JMP OPTXIT +2061 ///// +2062 03305 0000 IOSW, 0 +2063 / I/O MODE: "I" = 0000 = INTERPRETIVE INPUT, NUMERIC OUTPUT +2064 / "C" = 7777 = SINGLE CHARACTER I/O +2065 ///// +2066 /"ASK" MASTER ROUTINE +2067 03306 0000 INTASK, 0 +2068 03307 1154 TAD PT1 /SAVE VAR. POINTER +2069 03310 3225 DCA OWAIT +2070 03311 1305 TAD IOSW /WHAT MODE OF INPUT? +2071 03312 7650 SNA CLA +2072 03313 5323 JMP STRING /INTERPRETIVE +2073 03314 4513 READC /SINGLE CHARACTER +2074 03315 1142 TAD CHAR /CONVERT CHARACTER CODE TO FLOATING +2075 03316 4430 FLOAT /POINT NUMBER +2076 03317 4407 ASKEND, FENT /SAVE VALUE +2077 03320 6625 FPT I OWAIT +2078 03321 0000 FEXT +2079 03322 5706 JMP I INTASK +2080 /INTERPRETIVE BUFFERED INPUT +2081 03323 1013 STRING, TAD PDLXR /SAVE PUSHDOWN LIST POINTER +2082 03324 3203 DCA OPTTDO +2083 03325 1364 TAD BUFTOP /PROTECT TOP OF ASKBUF +2084 03326 3013 DCA PDLXR +2085 03327 2151 ISZ DEBGSW /DISABLE TRACE +2086 03330 1363 INBARR, TAD BUFBOT /INITIALIZE ASKBUF +2087 03331 3010 DCA AXIN +2088 03332 3136 DCA XCTIN +2089 03333 1363 TAD BUFBOT +2090 03334 3153 DCA PACKST +2091 03335 4513 READC /IGNORE SPACES +2092 03336 4511 SORTC +2093 03337 0032 C240-1 +2094 03340 5335 JMP .-3 +2095 03341 4510 SORTJ /SEARCH FOR TERMINATOR +2096 03342 5775 ASKLST-1 +2097 03343 0774 ASKLS2-ASKLST +2098 03344 4507 PACKC /PACK INTO BUFFER +2099 03345 4513 INGT, READC +2100 03346 5341 JMP .-5 +2101 /TERMINATOR FOUND, PROCESS INPUT +2102 03347 1060 INTERM, TAD CCR /PACK A C.R. +2103 03350 3142 DCA CHAR +2104 03351 4507 PACKC +2105 03352 4507 PACKC +2106 03353 1203 TAD OPTTDO /RESTORE PDLXR +2107 03354 3013 DCA PDLXR +2108 03355 1363 TAD BUFBOT /INITIALIZE UNPACKING +2109 03356 3017 DCA AXOUT +2110 03357 3020 DCA XCT +2111 03360 4501 PUSHJ /EVALUATE EXPRESSION +2112 03361 1600 EVAL-1 +2113 03362 5317 JMP ASKEND +2114 ///// +2115 03363 7550 BUFBOT, ASKBUF /BOTTOM OF BUFFER +2116 03364 7612 BUFTOP, ASKBND /TOP+12 OF BUFFER +2117 ///// +2118 /"TYPE" OUTPUT +2119 03365 0000 OUTPT, 0 +2120 03366 1305 TAD IOSW /WHAT KIND OF OUTPUT +2121 03367 7640 SZA CLA +2122 03370 5373 JMP COUTPT /SINGLE CHARACTER +2123 03371 4472 JMS I FOUTPUT /NUMERIC OUTPUT, PRINT VALUE +2124 03372 5765 JMP I OUTPT +2125 ///// +2126 03373 4452 COUTPT, FIX /GET CODE FOR CHARACTER +2127 03374 7450 SNA /MODULO 256 +2128 03375 7130 CLL CML RAR /TO ALLOW ZERO CODE TO BE PRINTED +2129 03376 4537 JMS I OUTDEV +2130 03377 5765 JMP I OUTPT +2131 /NOTE: "TDUMP" PRINTS ONLY IN NUMERIC MODE +2132 IOBUF=3400 +2133 / +2134 *IOBUF+20 +2135 03420 0000 FRST, 0 /TEXT POINTER +2136 03421 0000 0000 /DUMMY LINE NO +2137 03422 0355 0355 / C- +2138 03423 0617 0617 / FO +2139 03424 0301 0301 / CA +2140 03425 1454 1454 / L, +2141 03426 4040 4040 +2142 03427 6557 6557 / 5/ +2143 03430 6671 FRSTX, 6671 / 69 +2144 03431 7715 7715 +2145 BUFBEG=. +2146 ///// +2147 /FOCAL INITIALIZATION ROUTINE +2148 *BUFBEG +2149 03432 7300 BEGIN, CLA CLL +2150 03433 1377 TAD (RECOVR+1 /RESTORE RESTART +2151 03434 3176 DCA START-1 +2152 03435 6002 IOF /CLEAR FLAGS TO PREVENT INTERRUPT +2153 03436 6022 6022 /PCF +2154 03437 6032 6032 /KCC +2155 03440 6203 6203 /CDF CIF 00 +2156 03441 6402 6402 /CLEAR PT08'S +2157 03442 6412 6412 +2158 03443 6422 6422 +2159 03444 6432 6432 +2160 03445 6442 6442 +2161 03446 6452 6452 +2162 03447 6462 6462 +2163 03450 6472 6472 +2164 03451 6764 6764 /CLEAR DECTAPE +2165 03452 6772 6772 +2166 03453 7200 CLA +2167 03454 6046 TLS /START LOW SPEED OUTPUT +2168 03455 3414 DCA I FLTXR /CLEAR OUTPUT BUFFER +2169 03456 2376 ISZ (-20 +2170 03457 5255 JMP .-2 +2171 03460 1027 TAD BOTTOM /INITIALIZE PUSHDOWN LIST +2172 03461 3013 DCA PDLXR +2173 03462 6001 ION +2174 03463 4512 PRINTC /CHAR IS A C.R +2175 03464 4512 PRINTC +2176 03465 4512 PRINTC +2177 03466 4501 PUSHJ /TYPE FOCAL HEADING +2178 03467 0641 WRITE +2179 03470 5671 JMP I .+1 +2180 03471 2232 ERV-3 /ERASE ALL +2181 +2182 /EXTENDED FUNCTION PACKAGE FOR FOCAL 5/69 +2183 /E.A.TAFT, 6/10/69 +2184 / +2185 /FSIN: SIN(X) X IN RADIANS +2186 /FCOS: COS(X) X IN RADIANS +2187 /FATN: ARC TAN(X) RESULT IN RADIANS +2188 /FEXP: EXP(X) +2189 /FLOG: LN(X) +2190 ///// +2191 /DEFINITIONS +2192 FIXMRI FAD=1000 +2193 FIXMRI FSB=2000 +2194 FIXMRI FMY=3000 +2195 FIXMRI FDV=4000 +2196 FIXMRI FGT=5000 +2197 FIXMRI FPT=6000 +2198 FNR=7000 +2199 FENT=4407 +2200 FEXT=0 +2201 ///// +2202 NEGATE= 4450 +2203 GETSGN= 1045 +2204 RETURN= 5500 +2205 SN= 10 +2206 FIX= 4452 +2207 PUSHA= 4503 +2208 POPA= 1413 +2209 FLAC= 44 +2210 FLTEMP= 7545 +2211 FLTONE= 1573 +2212 PDLXR= 13 +2213 ERROR= 4526 +2214 FLOAT= 4430 +2215 FNTABF= 571 +2216 BOTTOM= 27 +2217 COMGO= 1164 +2218 SORTJ= 4510 +2219 M5= 67 +2220 CNTR= 132 +2221 AXIN= 10 +2222 TSTERM= 4565 +2223 PROC= 616 +2224 ERROR5= 2735 +2225 DBCONV= 5600 +2226 03576 7760 *BOTTOM + 03577 2746 +2227 00027 5112 FCOS-1 /TOP OF TEXT +2228 *FNTABF+7 +2229 00600 5335 FATN /POINTERS TO EXTENDED FUNCTIONS +2230 00601 5202 FEXP +2231 00602 5454 FLOG +2232 00603 5117 FSIN +2233 00604 5113 FCOS +2234 ///// +2235 /ENABLE A "LIBRARY DELETE" COMMAND +2236 /WHICH WILL DELETE THE EXTENDED FUNCTIONS AND +2237 /FREE MORE FOR USER AREA. +2238 *COMGO+10 +2239 01174 6556 LIBRARY +2240 *6555 +2241 06555 0304 LIBLST, "D +2242 ///// +2243 06556 4510 LIBRARY,SORTJ /"LIBRARY" - EXPANDABLE COMMAND +2244 06557 6554 LIBLST-1 +2245 06560 0022 LIBGO-LIBLST +2246 06561 4526 ERROR /ILLEGAL LIBRARY COMMAND +2247 ///// +2248 06562 1067 LIBD, TAD M5 /DELETE THE EXTENDED FUNCTIONS +2249 06563 3132 DCA CNTR +2250 06564 1375 TAD EXTAB +2251 06565 3010 DCA AXIN +2252 06566 1175 TAD PERROR +2253 06567 3410 DCA I AXIN /SET ERROR5 POINTERS +2254 06570 2132 ISZ CNTR +2255 06571 5366 JMP .-3 +2256 06572 1376 TAD DTOP +2257 06573 3027 DCA BOTTOM /MOVE TOP POINTER UP +2258 06574 5261 JMP 6461 /OPTRET (TO REACH END OF COMMAND) +2259 ///// +2260 06575 0577 EXTAB, FNTABF+6 +2261 06576 5577 DTOP, DBCONV-1 +2262 06577 6562 LIBGO, LIBD +2263 *175 +2264 00175 2735 PERROR, ERROR5 +2265 /FOCAL EXTENDED FUNCTIONS +2266 *5113 +2267 / COSINE +2268 05113 4450 FCOS, NEGATE /COS(X)=SIN(PI/2-X) +2269 05114 4407 FENT +2270 05115 1772 FAD I PI2 +2271 05116 0000 FEXT +2272 ///// +2273 / SINE +2274 05117 1045 FSIN, GETSGN +2275 05120 7450 SNA +2276 05121 5500 RETURN /SIN(0)=0 +2277 05122 7710 SPA CLA +2278 05123 4771 JMS I NEG2 /SIN(-X)=-SIN(X) +2279 05124 3010 DCA SN +2280 05125 4407 FENT +2281 05126 5174 FDV TWOPI /REDUCE MODULO 2 PI +2282 05127 6773 FPT I X2 +2283 05130 0000 FEXT +2284 05131 4452 FIX +2285 05132 4450 NEGATE +2286 05133 4407 FENT +2287 05134 7000 FNR +2288 05135 1773 FAD I X2 +2289 05136 7174 FMY TWOPI +2290 05137 6773 FPT I X2 +2291 05140 7177 FSB PI +2292 05141 0000 FEXT +2293 05142 1045 GETSGN /XFLOP +2697 05744 0045 FLAC1 +2698 05745 4505 POPF +2699 05746 0041 FLOP1 +2700 05747 3162 DCA REMAIN /CLEAR OVERFLOW +2701 05750 4334 JMS MULT2 /FLAC*10 = (FLAC*2*2+FLAC)*2 +2702 05751 4334 JMS MULT2 +2703 05752 4313 JMS TRPLAD +2704 05753 4334 JMS MULT2 +2705 05754 5742 JMP I MULT10 +2706 05755 6030 SGNTST, TSTSGN +2707 05756 7037 MULT2I, RALAC +2708 05757 6010 DECIN1, DECINT +2709 05760 7251 IRARAC, RARAC +2710 05761 5633 IOVRL, OVCHEK +2711 05762 7256 ROTRAC, RARAC+5 +2712 05763 0043 C43, 43 +2713 05764 0000 DECEXP, 0 /IMPLICIT DECIMAL EXPONENT +2714 05765 0000 INSIGN, 0 /SIGN OF MANTISSA +2715 05766 7000 CFNR, FNR +2716 05767 7773 FLINST, FMY .+4 +2717 05770 0004 FLTEN, 0004 /10(10) FLOATING +2718 05771 2400 2400 +2719 05772 0000 0000 +2720 05773 7775 FLPTEN, 7775 /.10(10) FLOATING +2721 05774 3146 3146 +2722 05775 3147 3147 +2723 REMAIN=TEMP1 +2724 /CHARACTER LIST FOR "ASK" +2725 05776 0215 ASKLST, 215 /CR +2726 05777 0214 214 /FF +2727 06000 0337 337 /BA +2728 06001 0254 254 /COMMA +2729 06002 0000 USERT, 0 /USER-SELECTED CHARACTER +2730 06003 0212 212 /LF +2731 /POWER OF 10 TABLE +2732 06004 6030 INTABL, -1750 /1000 +2733 06005 7634 -144 /100 +2734 06006 7766 -12 /10 +2735 06007 7777 -1 /1 +2736 /INPUT A DECIMAL INTEGER <2048 +2737 06010 0000 DECINT, 0 +2738 06011 3164 DCA DECNUM +2739 06012 4522 TESTN /GET A DIGIT +2740 06013 7000 NOP +2741 06014 5610 JMP I DECINT /NONE FOUND +2742 06015 4506 GETC +2743 06016 1164 TAD DECNUM /MULTIPLY PREV. # BY 10 +2744 06017 7106 CLL RTL +2745 06020 7530 SPA SZL +2746 06021 5226 JMP .+5 /OVERFLOW (>2047) +2747 06022 1164 TAD DECNUM +2748 06023 7004 RAL +2749 06024 1127 TAD SORTCN /ADD NEW DIGIT +2750 06025 7530 SPA SZL +2751 06026 4526 ERROR +2752 06027 5211 JMP DECINT+1 +2753 DECNUM=TEMP3 +2754 /TEST FOR A SIGN +2755 06030 0000 TSTSGN, 0 +2756 06031 4521 SPNOR +2757 06032 3127 DCA SORTCN +2758 06033 4511 SORTC /LOOK FOR + OR - +2759 06034 6114 SNLIST-1 +2760 06035 4506 GETC /SIGN FOUND +2761 06036 4521 SPNOR /NOT FOUND +2762 06037 7240 CLA CMA +2763 06040 1127 TAD SORTCN /SORTCN: 0=+, 1=- +2764 06041 5630 JMP I TSTSGN /AC: 7777=+, 0=- +2765 DIGIT=TEMP2 +2766 /PRINT A 2-4 DIGIT UNSIGNED DECIMAL INTEGER +2767 /FIRST 2 LEADING ZEROES NOT PRINTED +2768 06042 0000 INTOUT, 0 +2769 06043 3164 DCA DECNUM +2770 06044 1314 TAD INTPTR /POWER OF 10 POINTER +2771 06045 3260 DCA INTSUB +2772 06046 3210 DCA DECINT /DECINT=0 MEANS SKIP 0 OUTPUT +2773 06047 4255 JMS INTDO /1ST DIGIT (1000S) +2774 06050 4255 JMS INTDO /2ND DIGIT (100S) +2775 06051 2210 ISZ DECINT /DECINT>0 MEANS PRINT 0S +2776 06052 4255 JMS INTDO /3RD DIGIT (10S) +2777 06053 4255 JMS INTDO /4TH DIGIT (UNITS) +2778 06054 5642 JMP I INTOUT +2779 06055 0000 INTDO, 0 +2780 06056 3163 DCA DIGIT /INITIALIZE +2781 06057 1164 TAD DECNUM +2782 06060 1204 INTSUB, TAD INTABL /SUBTRACT A POWER OF 10 +2783 06061 7510 SPA +2784 06062 5267 JMP INTNEG +2785 06063 3164 DCA DECNUM /POSITIVE RESULT +2786 06064 2163 ISZ DIGIT /NONZERO DIGIT, SO IGNORE NO +2787 06065 2210 ISZ DECINT /FURTHER ZEROES +2788 06066 5257 JMP INTSUB-1 +2789 06067 7300 INTNEG, CLA CLL /NEGATIVE RESULT +2790 06070 2260 ISZ INTSUB /SET UP NEXT POWER OF 10 +2791 06071 1210 TAD DECINT /IS IT A LEADING 0? +2792 06072 7650 SNA CLA +2793 06073 5655 JMP I INTDO /YES, SKIP IT +2794 06074 1163 TAD DIGIT /NO, PRINT DIGIT +2795 06075 1036 TAD C260 +2796 06076 4512 PRINTC +2797 06077 5655 JMP I INTDO +2798 /OUTPUT A SIGNED INTEGER IN AC +2799 06100 0000 SIGOUT, 0 +2800 06101 3164 DCA DECNUM /SAVE NUMBER +2801 06102 1164 TAD DECNUM +2802 06103 7710 SPA CLA +2803 06104 1035 TAD P2 /MAKE A - +2804 06105 1315 TAD C253 /MAKE A + +2805 06106 4512 PRINTC +2806 06107 1164 TAD DECNUM /OUTPUT ABSOLUTE VALUE +2807 06110 7510 SPA +2808 06111 7041 CIA +2809 06112 4242 JMS INTOUT /OUTPUT THE NUMBER +2810 06113 5700 JMP I SIGOUT +2811 06114 1204 INTPTR, TAD INTABL +2812 SNLIST=. /FOR SIGN TESTING +2813 06115 0253 C253, 253 /+ +2814 06116 0255 255 /- +2815 /E FORMAT OUTPUT ROUTINE +2816 06117 7200 XXX, CLA /CONVERT TO E FORMAT ON OVERFLOW +2817 06120 1051 TAD TOTDIG +2818 06121 7410 SKP +2819 06122 1133 FLOUT, TAD DECP /E FORMAT (%0) FLOATING OUTPUT +2820 06123 7041 CIA +2821 06124 7450 SNA +2822 06125 1347 TAD MDIG /6 DIGITS IF 0 GIVEN +2823 06126 3164 DCA DECNUM /DIGIT COUNTER +2824 06127 1022 TAD PER /PERIOD +2825 06130 4512 PRINTC +2826 06131 1412 FLDIG, TAD I XRT2 /NEXT DIGIT +2827 06132 2157 ISZ T2 /OUT OF SIG DIGITS? +2828 06133 5336 JMP .+3 /NO, PRINT DIGIT +2829 06134 7240 CLA CMA /YES, RESET POINTER AND PRINT 0 +2830 06135 3157 DCA T2 +2831 06136 4750 JMS I OUTP +2832 06137 7410 SKP /FIELD NOW FILLED, PRINT EXPONENT +2833 06140 5331 JMP FLDIG +2834 /B-D CONV EXPONENT OUTPUT +2835 06141 1346 TAD C305 /PRINT LETTER E +2836 06142 4512 PRINTC +2837 06143 1156 TAD T1 /OUTPUT THE EXPONENT +2838 06144 4300 JMS SIGOUT +2839 06145 5770 BDEND, JMP I BDCONV /DONE +2840 06146 0305 C305, 305 /E +2841 06147 7772 MDIG, -DIGITS +2842 06150 6437 OUTP, OUTA +2843 /PRINT A LINE NUMBER - "PRNTLN" +2844 06151 0000 XPRNTL, 0 +2845 06152 1143 TAD LINENO +2846 06153 4520 RTL6 +2847 06154 0071 AND P77 +2848 06155 4242 JMS INTOUT /2-DIGIT PART NUMBER +2849 06156 1022 TAD PER +2850 06157 4512 PRINTC /DECIMAL POINT +2851 06160 1143 TAD LINENO +2852 06161 0026 AND P177 /2-DIGIT STEP NUMBER +2853 06162 4242 JMS INTOUT +2854 06163 1033 TAD C240 /SPACE +2855 06164 3142 DCA CHAR +2856 06165 4512 PRINTC +2857 06166 5751 JMP I XPRNTL +2858 +2859 06167 0015 NEGSGN, 255-240 +2860 /BINARY TO DECIMAL CONVERSION AND OUTPUT +2861 06170 0000 BDCONV, 0 +2862 06171 1045 TAD FLAC1 /CHECK SIGN +2863 06172 7700 SMA CLA +2864 06173 5376 JMP .+3 +2865 06174 4450 NEGATE /NEGATIVE, TAKE ABSOLUTE VALUE +2866 06175 1367 TAD NEGSGN /MAKE A - +2867 06176 1033 TAD C240 /MAKE A SPACE +2868 06177 4512 PRINTC +2869 06200 7240 CLA CMA /DECREMENT BINARY EXPONENT +2870 06201 1044 TAD FLAC0 +2871 06202 3044 DCA FLAC0 +2872 06203 3156 BDSCAL, DCA T1 /INITIALIZE DECIMAL EXPONENT +2873 06204 1044 TAD FLAC0 /START SCALING: -4= EXPONENT +2963 06332 1051 TAD TOTDIG +2964 06333 7510 SPA +2965 06334 5362 JMP FPRNT-2 /NO ROUNDING NEEDED +2966 06335 1226 TAD MDIGIT /ROUND TO DECP+EXP PLACES +2967 06336 7500 SMA +2968 06337 7200 CLA +2969 06340 1227 R6, TAD RND2 /START ROUNDING +2970 06341 3004 DCA FNEGSW /PLACES TO ROUND TO +2971 06342 1235 TAD BUFST /ROUNDING START ADDRESS +2972 06343 1004 TAD FNEGSW /SET UP ROUND COUNT +2973 06344 3040 DCA FLOP0 +2974 06345 1004 TAD FNEGSW +2975 06346 7041 CIA +2976 06347 3004 DCA FNEGSW /START ROUNDING PROCESS BY +2977 06350 1631 TAD I TENPT /ADDING 4 TO FIRST DIGIT +2978 06351 2440 RET, ISZ I FLOP0 /INCREMENT CURRENT DIGIT +2979 06352 1440 TAD I FLOP0 +2980 06353 1230 TAD M12 +2981 06354 7710 SPA CLA /DIGIT>9? +2982 06355 5364 JMP FPRNT /NO, END ROUNDING +2983 06356 3440 DCA I FLOP0 /YES, SET DIGIT TO 0 AND CARRY +2984 06357 2004 ISZ FNEGSW /BEGINNING OF BUFFER? +2985 06360 5240 JMP DECR /NO DECREMENT BUFFER ADDRESS +2986 06361 2440 ISZ I FLOP0 /YES, FAKE CARRY FROM FIRST DIGIT +2987 06362 2156 ISZ T1 +2988 06363 7200 CLA +2989 +2990 06364 1051 FPRNT, TAD TOTDIG /SET UP FIELD SIZES +2991 06365 7450 SNA +2992 06366 5636 JMP I FLOUTP /E FORMAT OUTPUT +2993 06367 7041 CIA +2994 06370 3164 DCA DECNUM /NUMBER OF PLACES TO PRINT +2995 06371 1164 TAD DECNUM +2996 06372 1156 TAD T1 +2997 06373 7540 SMA SZA +2998 06374 5637 JMP I XXXP /TOO BIG, PRINT E FORMAT +2999 06375 1133 TAD DECP /OK, TEST DECIMAL PLACES +3000 06376 7500 SMA +3001 06377 7200 CLA /ADJUST DECIMAL POINT +3002 06400 7041 CIA +3003 06401 1156 TAD T1 +3004 06402 7141 CLL CIA +3005 06403 3004 DCA FNEGSW /NUMBER OF INTEGER PLACES +3006 06404 7430 SZL +3007 06405 5222 JMP IN+4 /NO INTEGER PLACES +3008 /START PRINTING +3009 06406 1156 BACK, TAD T1 +3010 06407 1004 TAD FNEGSW +3011 06410 7650 SNA CLA +3012 06411 5225 JMP DIG /PRINT A DIGIT +3013 06412 1004 TAD FNEGSW +3014 06413 7001 IAC +3015 06414 7710 SPA CLA /PRINT 0 IF ONE INTEGER PLACE LEFT +3016 06415 1025 TAD M20 /OTHERWISE A SPACE +3017 06416 4237 IN, JMS OUTA /PRINT A CHARACTER +3018 06417 5645 JMP I BDENDP /FIELD FILLED, EXIT +3019 06420 2004 ISZ FNEGSW +3020 06421 5206 JMP BACK /CONTINUE +3021 06422 1022 TAD PER /DECIMAL POINT +3022 06423 4512 PRINTC +3023 06424 5206 JMP BACK +3024 06425 7040 DIG, CMA +3025 06426 1156 TAD T1 /DECREMENT DECIMAL EXPONENT +3026 06427 3156 DCA T1 +3027 06430 2157 ISZ T2 /CHECK SIG DIGIT COUNT +3028 06431 5235 JMP .+4 /SOME LEFT +3029 06432 7040 CMA /ALL USED UP +3030 06433 3157 DCA T2 +3031 06434 5216 JMP IN /PRINT A 0 +3032 06435 1412 TAD I XRT2 /PRINT A SIG DIGIT +3033 06436 5216 JMP IN +3034 /DIGIT PRINT ROUTINE FOR BDCONV +3035 06437 0000 OUTA, 0 +3036 06440 1036 TAD C260 /CONVERT TO ASCII +3037 06441 4512 PRINTC +3038 06442 2164 ISZ DECNUM /FIELD FILLED? +3039 06443 2237 ISZ OUTA /NO, GO TO SECOND RETURN +3040 06444 5637 JMP I OUTA +3041 06445 6145 BDENDP, BDEND +3042 / "OPTION" PROCESSOR +3043 06446 4521 OPTION, SPNOR /GET OPTION LETTER +3044 06447 4510 SORTJ +3045 06450 2377 OPTLST-1 +3046 06451 7574 OPTTBL-OPTLST +3047 06452 4526 ERROR /ILLEGAL OPTION NAME +3048 ///// +3049 06453 7240 OPTR, CLA CMA /SWAP INPUT TO HIGH SPEED READER +3050 06454 3037 DCA HINBUF +3051 06455 6014 RFC /START READER +3052 06456 1317 TAD RESTR /POINT TO "HREAD" +3053 06457 1161 OPTK, TAD PTCH /SWAP TO KEYBOARD IF CALLED HERE +3054 06460 3113 DCA 113 +3055 ///// +3056 06461 4565 OPTRET, TSTERM /MOVE TO ,;CR +3057 06462 5261 JMP .-1 +3058 06463 5665 JMP I .+2 /END OF OPTIONS +3059 06464 5246 JMP OPTION /CONTINUE PROCESSING OPTIONS +3060 06465 0616 PROC +3061 ///// +3062 /HIGH SPEED INPUT ROUTINE +3063 06466 0000 HREAD, 0 +3064 06467 1067 TAD M5 +3065 06470 3156 DCA T1 +3066 06471 3157 DCA T2 +3067 06472 6001 HREAD2, ION /(SWAP) - FOR 2-USER +3068 06473 1037 TAD HINBUF /WAIT FOR INPUT +3069 06474 7700 SMA CLA +3070 06475 5306 JMP HSGO+1 +3071 06476 2157 ISZ T2 +3072 06477 5272 JMP HREAD2 +3073 06500 2156 ISZ T1 +3074 06501 5272 JMP HREAD2 +3075 06502 1161 TAD PTCH /ALL DONE READING TAPE +3076 06503 3113 DCA 113 /SWAP TO KEYBOARD INPUT +3077 06504 1054 TAD P337 /RETURN A B.A. TO KILL UNENDED LINE OR GARBAGE +3078 /CHARACTER +3079 06505 5315 HSGO, JMP RESTR-2 +3080 06506 7040 CMA +3081 06507 3037 DCA HINBUF /SET TO READ NEXT +3082 06510 6016 RRB RFC +3083 06511 0026 AND P177 /IGNORE PARITY AND BLANK +3084 06512 7450 SNA +3085 06513 5267 JMP HREAD+1 +3086 06514 1015 TAD C200 +3087 06515 3142 DCA CHAR +3088 06516 5666 JMP I HREAD +3089 ///// +3090 06517 4003 RESTR, HREAD-CHIN +3091 +3092 PAGE +3093 /FLOATING POINT PACKAGE +3094 /ARITHMETIC INTERPRETER +3095 06600 0000 FPNT, 0 +3096 06601 7300 CLA CLL +3097 06602 1600 TAD I FPNT /FLOATING INSTRUCTION +3098 06603 7450 SNA +3099 06604 5600 JMP I FPNT /FEXT +3100 06605 0015 AND C200 /GET PAGE BIT +3101 06606 7640 SZA CLA +3102 06607 1200 TAD FPNT /CURRENT PAGE +3103 06610 0024 AND P7600 +3104 06611 3231 DCA FLADDR /START ADDRESS OF ADDRESSED PAGE +3105 06612 1600 TAD I FPNT /GET ADDRESS BITS +3106 06613 0026 AND P177 +3107 06614 1231 TAD FLADDR +3108 06615 3231 DCA FLADDR /FULL 12-BIT ADDRESS +3109 06616 1600 TAD I FPNT +3110 06617 2200 ISZ FPNT +3111 06620 7106 CLL RTL /OP BITS =>AC9-11 +3112 06621 7006 RTL /INDIRECT BIT =>LINK +3113 06622 0031 AND P17 +3114 06623 1236 TAD DRECTR /SET UP OP POINTER +3115 06624 3235 DCA DIRECT +3116 06625 1631 TAD I FLADDR /INDIRECT? +3117 06626 7430 SZL +3118 06627 3231 DCA FLADDR /YES +3119 06630 4504 PUSHF /NO, GET OPERAND +3120 06631 0000 FLADDR, 0 +3121 06632 4505 POPF +3122 06633 0040 FLOP +3123 06634 3043 DCA FLOP3 /CLEAR LOW ORDER OPERAND +3124 06635 5637 DIRECT, JMP I .+2 /OP DIRECT INSTRUCTION +3125 06636 5637 DRECTR, JMP I .+1 /OP TABLE +3126 06637 7406 FLPOW +3127 06640 6720 FLADD +3128 06641 6717 FLSUB +3129 06642 7077 FLMUL +3130 06643 7171 FLDIV +3131 06644 6647 FLGET +3132 06645 6653 FLPUT +3133 06646 6762 FLNOR +3134 +3135 06647 4504 FLGET, PUSHF /OP 5: GET FLAC FROM STORAGE +3136 06650 0040 FLOP +3137 06651 1254 TAD .+3 /SET UP POINTER TO FLAC +3138 06652 5256 JMP .+4 +3139 06653 4504 FLPUT, PUSHF /OP 6: PUT FLAC IN STORAGE +3140 06654 0044 FLAC +3141 06655 1231 TAD FLADDR /SET UP POINTER TO STORAGE +3142 06656 3260 DCA .+2 +3143 06657 4505 POPF +3144 06660 0000 0 /ADDRESS OF STORAGE LOCATION +3145 06661 5201 JMP FPNT+1 +3146 06662 0000 NEGOP, 0 /ROUTINE TO NEGATE FLOP +3147 06663 1042 TAD FLOP2 +3148 06664 7141 CLL CIA +3149 06665 3042 DCA FLOP2 +3150 06666 7024 CML RAL +3151 06667 1041 TAD FLOP1 +3152 06670 7041 CIA +3153 06671 3041 DCA FLOP1 +3154 06672 1004 TAD FNEGSW /FNEGSW IS COMPLEMENTED WHEN +3155 06673 7140 CLL CMA /FLOP OR FLAC IS NEGATED +3156 06674 3004 DCA FNEGSW +3157 06675 5662 JMP I NEGOP +3158 06676 0000 NEGAC, 0 /ROUTINE TO NEGATE FLAC - "NEGATE" +3159 06677 7300 CLA CLL /TRIPLE PRECISION +3160 06700 1047 TAD FLAC3 +3161 06701 7041 CIA +3162 06702 3047 DCA FLAC3 +3163 06703 7024 CML RAL +3164 06704 1046 TAD FLAC2 +3165 06705 7041 CIA +3166 06706 3046 DCA FLAC2 +3167 06707 7024 CML RAL +3168 06710 1045 TAD FLAC1 +3169 06711 7041 CIA +3170 06712 3045 DCA FLAC1 +3171 06713 1004 TAD FNEGSW +3172 06714 7140 CLL CMA +3173 06715 3004 DCA FNEGSW +3174 06716 5676 JMP I NEGAC +3175 /ARITHMETIC OPERATIONS +3176 /BOTH FLAC AND FLOP MUST BE NORMALIZED FOR +3177 /+-*/^ (FAD,FSU,FMY,FDV,FXP) +3178 06717 4262 FLSUB, JMS NEGOP /OP 2: SUBTRACT OP (NEGATE AND ADD) +3179 06720 1045 FLADD, TAD FLAC1 /OP 1: ADD OP +3180 06721 7650 SNA CLA +3181 06722 5247 JMP FLGET /RESULT=OPERAND IF FLAC=0 +3182 06723 1041 TAD FLOP1 +3183 06724 7650 SNA CLA +3184 06725 5201 JMP FPNT+1 /RESULT=FLAC IF FLOP=0 +3185 06726 1040 TAD FLOP0 /COMPARE EXPONENTS +3186 06727 7041 CIA +3187 06730 1044 TAD FLAC0 +3188 06731 7450 SNA +3189 06732 5357 JMP CMBINE /EQUAL, GO ADD TOGETHER +3190 06733 7500 SMA /NOT EQUAL, NEED SHIFTING +3191 06734 5346 JMP SHFLOP /FLAC>FLOP, SHIFT FLOP +3192 06735 1365 TAD P27 /FLAC 0 + DCA PC /FOR COMMAND MODE + DCA DEBGSW /ENABLE TRACE FOR INPUT OF (?). + TAD COMBOT /PROTECT COMMAND BUFFER. + DCA PDLXR /NO PATCH TEST. + ISZ DMPSW /INIT UNPACK AND TRACE SWITCH. + DCA LIST3+1 /CLEAR SEARCH CHARACTER FOR INPUT. + TAD P337 /ANNOUNCE PRESENCE + PRINTC /BY TYPING THE LEAD-IN CHARACTER +IBAR, TAD COMBUF /INITIALIZE COMMAND BUFFER + DCA AXIN /FOR UNPACKING. + DCA XCTIN + TAD COMBUF /RUBOUT PROTECTION + DCA PACKST +IGNOR, READC /READ COMMAND STRING + SORTJ + LIST6-1 + INLIST-LIST6 + PACKC /SAVE STRING CHARACTER. + JMP IGNOR +///// +P4000, 4000 /LINE NUMBER TEST +COMBOT, COMOUT+12 /END OF COMMAND BUFFER,LESS PROTECTION COUNT. +CFRSX, FLTZER /POINTER FOR PC=COMMAND OR INPUT +///// + /COMMAND/INPUT PROCESSOR + +IRETN, PACKC /START TO PACK C.R. + PACKC /FINISH C.R. + TAD COMBUF /INITIALIZE "TEXTP" +GONE, DCA AXOUT /SETUP CURRENT LINE + DCA XCT + GETC /READ FIRST CHARACTER. + TAD BOTTOM /INIT PUSH-DOWN-LIST + DCA PDLXR + SPNOR /IGNORE LEADING BLANKS + TESTN /DOES THE LINE BEGIN WITH 1-9? + ERROR4 /ILLEGAL GROUP ZERO USAGE + JMP INPUTX /NO + IOF /YES,STOP INPUT MOMENTARILY. + ISZ DEBGSW /DISABLE TRACE FOR REPACKING + GETLN /READ THIS LINE NUMBER + TAD NAGSW + TAD P4000 /TEST FOR SINGLE LINE + SZA CLA + ERROR3 /ILLEGAL LINE NUMBER ON INPUT + TAD BUFR /SET POINTERS + DCA AXIN + DCA XCTIN + TAD LINENO /SAVE LINE # + DCA I AXIN /(X-MEM) + SPNOR /IGNORE SPACES AFTER LINE NUMBER + SKP + GETC /READ 1ST AFTER LINENO TERMINATOR. + PACKC /SAVE TEXT AND RESTORE DATA FIELD + TAD CHAR /TEST FOR END OF INPUT STRING + TAD MCR + SZA CLA + JMP .-5 + PUSHJ /REMOVE OLD LINE, IF ANY. + DELETE + ENDLN /INSERT NEW LINE + JMP START +///// +INPUTX, PUSHJ /PROCESS IMMEDIATE COMMAND. + PROC + TAD I PC /CHECK NEXT LINE (X-MEM) + SNA /END OF PROGRAM? + JMP START /YES + DCA PC /SAVE NEW LINE NO. + TAD PC /START NEW LINE + IAC + JMP GONE /PROCESS OTHER COMMANDS +/TEXT LINE BUFFER FORMAT* +/#1 : POINTER OR ZERO IN LAST +/#2 : LINENO +/#3 - #N+1 : TEXT +/#N : C.R. + +XRTL6, 0 /ROTATE AC LEFT 6 + CLL RTL + RTL + RTL + JMP I XRTL6 +/ +/PROCESS A LINE NUMBER - "GETLN" +XGETLN, 0 + SPNOR + TAD P4000 /INITIALIZE TO SINGLE LINE + DCA NAGSW + SORTC /TEST FOR A SIGN + SNLIST-1 + JMP EVLN /EVALUATE IN FLOATING POINT + JMS I INPINT /FIXED POINT: GET GROUP + TESTN + GETC /GO PAST . IF THERE + JMS GEG /GET 1ST STEP DIGIT + CLL RTL /MULTIPLY BY TEN + TAD SORTCN + RAL + JMS GEG /GET 2ND STEP DIGIT + TAD LINENO /COMBINE +GEXIT, SNA + DCA NAGSW /MUST BE GROUP + DCA LINENO /SAVE STEP NUMBER + TAD DECNUM /GROUP + SNA + JMP GTESTA /GROUP 0: MUST BE "ALL" + RTL6 /CONSTRUCT LINE NUMBER + RAL + TAD LINENO + DCA LINENO + TAD DECNUM /TEST FOR LEGAL GROUP + AND C7760 + JMP .+3 +GTESTA, ISZ NAGSW /SET TO "ALL" + TAD LINENO /MAKE SURE LINE # IS ZERO + SNA CLA + TESTN /OK, TEST FOR EXTRA DIGITS + JMP LNERR /DOUBLE ., ILLEGAL G. 0, OR G.>15 + JMP I XGETLN /OK + JMP LNERR /TOO MANY DIGITS + +GEG, 0 /GET A STEP DIGIT + DCA LINENO + TESTN +LNERR, ERROR /DOUBLE PERIODS + JMP GEXIT-1 /NO DIGIT + GETC /DIGIT, PASS IT + TAD SORTCN /EXIT WITH VALUE + JMP I GEG +///// +INPINT, DECINT +C7760, 7760 +///// +/EVALUATE A LINE NUMBER IN FLOATING POINT +EVLN, PUSHJ /GET VALUE + EVAL + FIX /GET GROUP # + PUSHA + TAD FLAC1 + SZA CLA + JMP LNERR /TOO BIG + FENT /GET STEP # + FNR + FSB I FLARGP /THIS GIVES -(FRACTIONAL PART) + FMY I F10P + FMY I F10P + FSB I FP10P /KILL ANY ROUNDOFF ERROR + FEXT + NEGATE + POPA /RESTORE GROUP + DCA DECNUM + FIX + JMP I .+1 + GEXIT +///// +F10P, FLTEN +FP10P, FLPTEN + +/RANGE OF ACCEPTIBLE LINE NUMBERS = 1.01 TO 15.99 + +/NAGSW: +/GROUP=0000 +/LINE=4000 +/ALL=0001 + /RECURSIVE OPERATE, EXECUTE, OR CALL + +DO, GETLN /EXECUTE ONE LINE, A GROUP,OR ALL + TAD PC /SAVE ADDRESS + PUSHA /OF CURRENT LINE + PUSHF /SAVE REST OF THIS LINE + TEXTP /ADDRESS OF TEXT POINTERS +DGRP, PUSHF /SAVE NAGSW; CHAR; AND LINENO. + NAGSW + TAD NAGSW /CHECK DATA FROM GETLN. + SPA CLA /SKIP IF GROUP OR ALL + JMP DOONE /DO ONE LINE + FINDLN /INIT FOR GROUP AND SET THISLN + JMP TGRP2 +DGRP1, PUSHJ /EXECUTE OBJECT LINE AND SET PC. + PROCESS-2 + POPF /RESTORE THE DATA + NAGSW + TAD I PC /CHECK FOR END OF TEXT (X-MEM) + SNA + JMP DCONT /ALL DONE + IAC + DCA PT1 /SAVE POINTER TO LINENO + TAD NAGSW /CHECK FOR GROUP + SMA SZA CLA + JMP .+4 /DO ALL + TAD I PT1 /TEST GROUP (X-MEM) + TSTGRP + JMP DCONT /NOT IN GROUP + TAD I PT1 /READ NEXT LINE NO. (X-MEM) + DCA LINENO + JMP DGRP /CONTINUE THE SUBROUTINE +///// +DOONE, FINDLN /FIND THE LINE + ERROR2 /NO SUCH LINE NUMBER + PUSHJ /EXECUTE IT + PROCESS + POPF /RESTORE CHAR + NAGSW +DCONT, POPF /RESTORE TEXT POINTERS + TEXTP + POPA /RESTORE ADDRESS OF CURRENT LINE. + DCA PC + TSTERM /GO TO TERMINATOR + JMP .-1 + JMP I .+2 /END OF DO, CONTINUE PROCESSING + JMP DO /COMMA, DO ANOTHER + PROC + +TGRP2, TAD THISLN /TEST FOR GOOD GROUP NUMBER. + DCA XRT + TAD I XRT + TSTGRP + ERROR2 /NO SUCH GROUP NUMBER + JMP DGRP1 + /PUSHDOWN LIST CONTROLS +/ +XPUSHA, 0 /PUSHDOWN THE AC - "PUSHA" + DCA PD2 /SAVE AC + CMA /BACK UP POINTER + JMS PCHK /CHECK CORE USAGE + TAD PD2 + DCA I XRT3 /SAVE + JMP I XPUSHA +///// +PCHK, 0 + TAD PDLXR /INC IN AC + DCA PDLXR + TAD PDLXR + DCA XRT3 /DUPLICATE POINTER + TAD PDLXR + CLL CIA + TAD LASTV + SZL CLA + ERROR /STORAGE FILLED BY PUSHDOWN LIST + JMP I PCHK +///// +XPUSHJ, 0 /RECURSIVE SUBROUTINE CALL - "PUSHJ" + CLA IAC + TAD XPUSHJ /SAVE RETURN + JMS XPUSHA /(PUSHA) + TAD I XPUSHJ /TO NEW ROUTINE + DCA XPUSHJ + JMP I XPUSHJ +///// +PD2, 0 /SAVE A FLOATING PT NUMBER - "PUSHF" + CLA CMA /COMPUTE ADDRESS + TAD I PD2 + DCA XRT + ISZ PD2 + TAD M3 /BACKUP THREE + JMS PCHK + TAD I XRT /SAVE 3 WORDS + DCA I XRT3 + TAD I XRT + DCA I XRT3 + TAD I XRT + DCA I XRT3 + JMP I PD2 + +PD3, 0 /RESTORE A FLOATING PT # - "POPF" + CLA CMA + TAD I PD3 + ISZ PD3 + DCA XRT + TAD I PDLXR + DCA I XRT + TAD I PDLXR + DCA I XRT + TAD I PDLXR + DCA I XRT + JMP I PD3 +/ +/INPUT CONTROL CHARACTERS +INLIST, IBAR /B.A.=RESTART + IGNOR+4 /F.F. + IGNOR+4 /BELL + IGNOR /L.F.=IGNORED + IRETN /C.R.=TERMINATE INPUT +/ +/LIST OF FUNCTION ADDRESSES +FNTABF, XABS /ABSOLUTE VALUE + FSGN /SIGN PART + XINT /INTEGER PART + XDYS /FDIS- DISPLAY Y AND INTENSIFY + FRAN /RANDOM NUMBER + XDXS /SET X-COORDINATE FOR DISPLAY + XADC /READ ANALOG-DIGITAL CONVERTER + ERROR5 /ATN THESE ROUTINES NOT IN PACKAGE + ERROR5 /EXP + ERROR5 /LOG + ERROR5 /SIN + ERROR5 /COS + FSQT /SQUARE ROOT + ERROR5 /NEW- USER-DEFINED FUNCTION +/ +MF, -306 /USED BY TESTC + /PRIMARY CONTROL AND TRANSFER + +GOTO, GETLN /READ THE LINE NUMBER REQUESTED + FINDLN /LOCATE IT AND RESET TEXTP + ERROR2 /NOT THERE OR A TIGHT LOOP. + TAD THISLN /SET PC + DCA PC +PROCESS,GETC /TEST FOR END OF LINE +PROC, SORTC /FIRST CHARACTER READY = USE PROC + CCR-1 +PC1, POPJ /EXIT "PROCESS" + SORTC /IGNORE SPACE ; , + GLIST-1 + JMP PROCESS + TAD CHAR /SAVE COMMAND CHARACTER + PUSHA + GETC /GO TO TERMINATOR + SORTC + TERMS-4 + SKP + JMP .-4 + SPNOR + POPA + SORTJ /GO DO COMMAND + COMLST-1 + COMGO-COMLST + ERROR2 /ILLEGAL COMMAND +///// + +COMMENTS=PC1 /ALSO IS CONTINUE + + /OUTPUT COMMAND TEXT + +WRITE, JMS I WTXS /SAVE CHAR AND TEXT POINTERS + GETLN /SET LINENO + ISZ DEBGSW /DISABLE TRACE + FINDLN /SEARCH FOR LINE NUMBER + JMP WTESTG /NOT THERE OR GROUP + TAD LINENO + SZA CLA + PRNTLN /PRINT LINE NUMBER AND A SPACE. + GETC + PRINTC /PRINT TEXT OF A LINE. + TAD CHAR + TAD MCR + SZA CLA /SKIP IF END OF LINE + JMP .-5 + TAD I THISLN /TEST FOR END OF TEXT (X-MEM) +WTEST2, SNA + JMP WEXIT /WRITE FINISHED + IAC + DCA PT1 /SAVE POINTER TO LINENO OF`NEXT (X-MEM) + TAD NAGSW + SMA CLA + TAD I PT1 /(X-MEM) + TSTGRP /TRY NEXT LINENO FOR GROUP. + JMP WX +WALL, TAD I PT1 /SET LINENO (X-MEM) + DCA LINENO + JMP WRITE+3 +/// +WTESTG, TAD THISLN /INIT GROUP PRINTOUT + JMP WTEST2 +///// +WX, TAD NAGSW + SPA SNA CLA /SKIP IF ALL + JMP WEXIT + PRINTC /PRINT C.R. AGAIN + JMP WALL +///// +WEXIT, JMS I WTXR /RESTORE CURRENT LINE + DCA DEBGSW /RESTORE TRACE + TSTERM + JMP .-1 + JMP PROC /END OF WRITE + JMP WRITE /COMMA, MORE TO WRITE +///// +WTXS, TXTSAV +WTXR, TXTRES + +XTESTC, 0 /TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC" + SPNOR /IGNORE SPACES + SORTC /TEST THE VARIABLE TERMINATORS + TERMS-1 + JMP I XTESTC /YES - SORTCN IS SET + ISZ XTESTC + TESTN + JMP I XTESTC /. (PART OF NUMBER) + SKP /OTHER + JMP I XTESTC /NUMBER + TAD CHAR /TEST FOR "F" + TAD MF + SZA CLA + ISZ XTESTC /NO + ISZ XTESTC /RETURNS: + JMP I XTESTC /TERMINATOR;NUMBER;FUNCTION;OTHER +///// +XSORTC, 0 /SORT CHAR AGAINST TABLE - "SORTC" + TAD I XSORTC + DCA XRT2 /1ST ARG IS LIST-1 + TAD I XRT2 + SPA /LIST IS ENDED BY A NEGATIVE NUMBER + JMP SEXC /2AND EXIT = NOT IN LIST + CIA + TAD CHAR + SZA CLA /COMPARE + JMP .-6 + TAD I XSORTC /COMPUTE INCREMENT : 0 - N + CMA + TAD XRT2 + DCA SORTCN + SKP /1ST EXIT = YES +SEXC, ISZ XSORTC + ISZ XSORTC + CLA CLL + JMP I XSORTC + + /COMMAND DECODING LIST +COMLST, 323 /SET + 306 /FOR + 311 /IF + 304 /DO + 307 /GOTO + 303 /COMMENT OR CONTINUE + 301 /ASK + 324 /TYPE + 314 /LIBRARY + 305 /ERASE + 327 /WRITE + 315 /MODIFY + 321 /QUIT + 322 /RETURN + 317 /OPTION + 310 /HELLO + /CONDITIONAL TRANSFER PROCESS +/ IF (EXP) A,B,C +IF, SORTC /LOOK FOR L-PAR + PLPR-1 + SKP + ERROR /NO ( AFTER IF + PUSHJ /EVALUATE EXPRESSION + EVAL-1 + GETC /PASS ) + TAD FLAC1 /TEST FOR -,0,+ + SPA CLA + JMP I PGOTO /NEGATIVE, USE 1ST REF + TSTERM /0 OR POS, GET TO NEXT + JMP .-1 + JMP I PRCP /; OR CR, CONTINUE SAME LINE + TAD FLAC1 /COMMA, SEE IF 0 OR POS + SNA CLA + JMP I PGOTO /ZERO, USE 2ND REF + TSTERM /POSITIVE, GET TO NEXT + JMP .-1 + JMP I PRCP /; OR CR + JMP I PGOTO /COMMA, USE 3RD REF +PGOTO, GOTO +PLPR, 250 + /ASSIGNMENT AND LOOP CONTROL +SET=. +FOR, PUSHJ /GET POINTER TO VAR. + GETARG + SPNOR + SORTC /SEARCH FOR = + TERMS+17-1 + SKP + ERROR /LEFT OF = IN ERROR: "FOR" OR "SET" + TAD PT1 /SAVE VARIABLE POINTER + DCA PT2 + PUSHJ /EVALUATE INITIAL EXPRESSION + EVAL-1 + FENT /SAVE INITIAL VALUE + FPT I PT2 + FEXT + TSTERM /CHECK TERMINATOR + ERROR /PROBABLY EXCESS R-PAR + JMP I PRCP /; OR CR: THIS IS A SET; CONTINUE + TAD PT2 /COMMA, SAVE LOOP VAR POINTER + PUSHA + PUSHJ /EVALUATE SECOND EXPRESSION + EVAL + TSTERM /CHECK TERMINATOR + ERROR /EXCESS R-PAR OR BAD TERMINATOR + JMP ONEINC /; OR CR, THAT'S ALL (INC=1) + PUSHF /COMMA, SAVE INCREMENT + FLARG + PUSHJ /EVALUATE FINAL EXPRESSION + EVAL +SFINAL, PUSHF /SAVE FINAL VALUE + FLARG + JMS I FTXS /SAVE CHAR AND TEXT POINTERS + FLOAT /FLOAT A ZERO TO START +FCONT, FENT /COMPARE LOOP VAR TO FINAL + FAD I PT2 /LOOP VAR + FPT I PT2 + FSB I FLARGP /FINAL + FEXT + TAD PDLXR /CHECK SIGN OF INCREMENT + TAD PINC + DCA PT2 + TAD I PT2 + SPA CLA + NEGATE /BACKWARD COUNTING + TAD FLAC1 + SMA SZA CLA + JMP FEND /LIMIT REACHED OR EXCEEDED + + PUSHJ /NOT YET, DO OBJECT STATEMENTS +PRCP, PROC + JMS I FTXR /RESET TO BEGINNING OF OBJ. STMT. + POPF /RESTORE LIMIT + FLARG + POPF /RESTORE INC + FLAC + POPA /RESTORE LOOP VAR POINTER + DCA PT2 + TAD M13 /PUSH DOWN ALL OF ABOVE + TAD PDLXR + DCA PDLXR + JMP FCONT +///// +ONEINC, PUSHF /NO INCREMENT GIVEN, SET TO 1 + FLTONE + JMP SFINAL +///// +PINC, 11 +M13, -13 +FTXS, TXTSAV +FTXR, TXTRES +FEND, TAD P13 /END OF LOOP + TAD PDLXR /REMOVE VALUES!FROM PUSHDOWN LIST + DCA PDLXR + POPJ +PT2, 0 +///// +/ASK/TYPE SPECIAL CHARACTERS +ALIST, 246 /& + 245 /% + 242 /" + 241 /! + 243 /# + 244 /$ +GLIST, 240 /SPACE +TLIST, 254 /, + 273 /; + 215 /C.R. + /SET Y AND INTENSIFY THE POINT +XDYS, FIX + 6063 /DYL + CLA + TAD X0 + 6053 /DXL DIX + SKP +/ +/SET X +XDXS, FIX + DCA X0 /(DXL) + RETURN +/ +/TAKE THE INTEGER PART +XINT, FIX + CLA + RETURN +X0, 0 +///// +TLIST3, TASK4 /" + TASK /C.R. - AUTOMATIC QUOTE MATCH +/COMMAND POINTERS +COMGO, SET + FOR + IF + DO + GOTO + COMMENTS + ASK + TYPE + LIBRARY + ERASE + WRITE + MODIFY + START + RETRN + OPTION + HELLO +///// +PACLS2, PQUES + RUB1 + /INPUT-OUTPUT STATEMENTS + +ASK, CLA CMA /REMEMBER WHICH CALL. +TYPE, DCA ATSW +TASK, DCA DEBGSW /RE-ENABLE THE TRACE + SORTJ /SPECIAL CHARACTER? + ALIST-1 + ATLIST-ALIST + ISZ ATSW /TEST QUOTE SWITCH + JMP TYPE2 + PUSHJ /DO ASK; SETUP PT1 + GETARG + JMS I TTXTS /PROTECT TEXT + TAD COL /TYPE COLON +TASKCL, PRINTC /(CLA) TO SUPPRESS ":" + JMS I INTERP /CALL INPUT CONVERSION ROUTINE + JMS I TTXTR /RESTORE TEXT + JMP ASK /CONTINUE PROCESSING +INTERP, INTASK +//// +TYPE2, PUSHJ /DO TYPE + EVAL + TSTERM + ERROR /BAD TERMINATOR IN "TYPE" +COL, 272 + JMS I OUTS /PRINT + JMP TYPE +///// +TTXTS, TXTSAV +TTXTR, TXTRES +OUTS, OUTPT + +TQUOT, ISZ DEBGSW /DISABLE TRACE + GETC /TYPE LITERALS + SORTJ + TLIST2-1 + TLIST3-TLIST2 + PRINTC + JMP TQUOT+1 +////// +TCRLF, TAD CCR /SLASH=CR,LF. + PRINTC +TASK4, GETC /MOVE TO NEXT CHARACTER + JMP TASK +//// +TCRLF2, TAD CCR /SPLAT=CR + JMS I OUTDEV + TAD C200 /DELAY FOR C.R. + JMP TCRLF+1 + +/IF DEBGSW=0 : ENABLE FLIP-FLOP "DMPSW" +/ #0: DISABLE AND RETURN ALL"?" ' S. +/IF DMPSW = 0: TRACE ON, IF ENABLED +/ #0: TRACE OFF +/IF BOTH = 0 : PRINT TRACE. + + +TINTR, GETC /PASS PERCENT SIGN + JMS I INTG /READ FORMAT CONTROL: "%7.3" + TAD DECNUM /INTEGER PART (TOTAL DIGITS) + DCA TOTDIG + TESTN /GET PAST . IF ANY + GETC + JMS I INTG /RIGHT-HAND PART (DECIMAL PLACES) + TAD DECNUM + DCA DECP + JMP TASK +INTG, DECINT + /SEARCH ROUTINES + +MODIFY, GETLN /READ LINE NO. + FINDLN /LOOK IT UP NOW. + ERROR2 /NOT THERE = BAD COMMAND UNLESS ZERO. + TAD BUFR /SET POINTERS + DCA AXIN /FOR INPUT + DCA XCTIN + TAD LINENO /COPY THE SAME LINE NUMBER. + SNA /CHECK FOR ALL + JMP MODIFY+2 /ERROR IN ARG + DCA I AXIN /(X-MEM) + TAD AXIN /SAVE START OF NEW LINE + DCA PACKST +SCONT, JMS I INDEV /READ THE TELETYPE INPUT SILENTLY. + DCA LIST3+1 /SAVE SEARCH CHARACTER + ISZ DEBGSW /NO BREAKS. +SCHAR, GETC /TYPE+TEST-F.F. + PRINTC + SORTJ /LOOK FOR MATCH + LIST3-1 + LISTGO-LIST3 + PACKC /SAVE NEW LINE. + JMP SCHAR +///// +SBAR, TAD BUFR /RESTART-B.A. + IAC + DCA AXIN /SET POINTERS + DCA XCTIN +SFOUND, READC /READ FROM KEYBOARD + SORTJ /TEST + LIST6-1 + SRNLST-LIST6 +SGOT, PACKC /PACK CHAR. + JMP SFOUND /MORE + +SORTB, 0 /SORT AND BRANCH ROUTINE. - "SORTJ" + SNA + TAD CHAR /ASSUME CHAR IF AC=0 + CIA + DCA T2 /SAVE SORT ITEM + TAD I SORTB /FIRST ARG IS LIST LESS ONE + ISZ SORTB /2AND IS INTRA-LIST LENGTH + DCA XRT2 + TAD I XRT2 + SPA /**LISTS ENDED BY NEGATIVE NUMBERS** + JMP SEX /READ EXIT + TAD T2 /FIND ADDRESS + SZA CLA + JMP .-5 + TAD XRT2 /MATCH FOUND. + TAD I SORTB + DCA SORTB /SETUP RETURN + TAD I SORTB + DCA SORTB + SKP +SEX, ISZ SORTB /MATCH NOT FOUND. + CLA CLL + JMP I SORTB /RETURN TO CALLING SEQUENCE. + +TAB, PUSHJ /TABULATE TO A PARTICULAR COLUMN + EVAL-1 + FIX /GET COLUMN NUMBER + CLL CIA + IAC + TAD TABCTR + SZL CLA + JMP TASK /ALREADY THERE OR PAST IT + TAD C240 + PRINTC + TAD FLAC2 /TEST AGAIN + JMP TAB+3 +SRNLST=. /'MODIFY' CONTROL CHARACTER TABLE + SBAR /B.A. = RESTART + SCHAR /F.F. = CONTINUE + SCONT /BELL = CHANGE SEARCH CHARACTER + SCONT+1 /L.F. = FINISH THE LINE AS BEFORE. +///// +LISTGO, INPUTX-11 /C.R. - END THE MODIFIED LINE HERE + SGOT /FOUND SEARCH CHARACTER + /FIND OR ENTER A VARIABLE IN THE LIST. + +GETARG, TESTC /FIRST LETTER OF ARG +TLIST2, 0242 /" + 0215 /C.R. - FUNCTION OR NUMBER IS NOT AN ARG. + ERROR4 /BAD ARGUEMENT IN 'FOR' 'SET', OR 'ASK' + CLA CMA /"GETARG" CAN CREATE NEW VAR. +GETVAR, PUSHA /"GETVAR" WILL NOT + DCA XCTIN /PACK INTO ADD. + PACKC + GETC /SECOND LETTER + SORTC /TERMINATOR? + TERMS-1 + JMP .+3 /YES + TAD CHAR /NO + AND P77 /SAVE 2AND LETTER OF NAME + TAD ADD + PUSHA + SORTC /IGNORE THE REST + TERMS-1 + JMP .+3 + GETC + JMP .-4 + TSTLPR /LOOK FOR SUBSCRIPT VIA SORTCN + JMP GS1 /NOT SUBSCRIPTED BY L-PAR. + TAD LASTOP /SAVE LAST OPERATION + PUSHA + PUSHJ /MOVE PAST L-PAR AND + EVAL-1 /EVALUATE THE SUBSCRIPT. + GETC /MOVE PAST R-PAR + POPA + DCA LASTOP /RECALL LAST OPERATION + FIX +GS1, DCA SUBS /SAVE SUBSCRIPT + POPA + DCA ADD /RESTORE NAME + TAD STARTV /SEARCH FOR VARIABLE +GS3, DCA PT1 + TAD PT1 + DCA XRT + TAD PT1 + CIA + TAD LASTV /TEST FOR END OF LIST + SPA SNA CLA + JMP GS2 /END SEARCH + TAD I PT1 /GET TABLE ENTRY + CIA + TAD ADD + SNA CLA + JMP GFND1 /FOUND XX + +GS4, TAD PT1 /TRY NEXT ONE + TAD GINC + JMP GS3 +GS2, ISZ I PDLXR /VAR. NOT FOUND, CAN I MAKE ONE? + ERROR /UNDEFINED VAR. USED IN EXPRESSION + TAD LASTV /OK, ADD THE VARIABLE + TAD P13 /TEST STORAGE LIMITS + CIA CLL + TAD PDLXR + SNL CLA + ERROR3 + TAD LASTV /UPDATE THE LIST. + TAD GINC + DCA LASTV + TAD ADD /SAVE NAME + DCA I PT1 + TAD SUBS /SAVE SUBSCRIPT + DCA I XRT + DCA I XRT /INITIALIZE VAR. TO ZERO + DCA I XRT + DCA I XRT + JMP GS5 /EXIT +///// +GFND1, TAD I XRT /FOUND NAME, TEST SUBSCRIPT + CIA + TAD SUBS + SZA CLA + JMP GS4 /WRONG SUBSCRIPT + ISZ PDLXR +GS5, ISZ PT1 /SET POINTER TO DATA + ISZ PT1 + POPJ +//// +P0, FLTZER + + /IGNORE LEADING SPACES - "SPNOR" + +SUBS=. +XSPNOR, 0 + TAD CHAR + TAD M240 + SZA CLA + JMP I XSPNOR + GETC + JMP XSPNOR+1 +///// +/SEE IF NEXT CHARACTER IS A NUMBER +XTESTN, 0 /RETURNS: .; OTHER; NUMBER - "TESTN" + TAD CHAR + TAD MPER /TEST FOR . + SZA + ISZ XTESTN /NOT A . + TAD NTST1 /COMPARE TO "9" + SMA + JMP NTEXIT /TOO LARGE + TAD NTST2 /COMPARE TO "0" + SPA + JMP NTEXIT /TOO SMALL + DCA SORTCN /FOUND DIGIT, SAVE IT + ISZ XTESTN +NTEXIT, CLA CLL + JMP I XTESTN +///// +NTST1, 256-272 +NTST2, 272-260 + /EXIT FROM A "DO" SUBROUTINE + + +RETRN, TAD P0 /(PC) => 0 + DCA PC +XPOPJ, TAD I PDLXR /RECURSIVE EXIT - "POPJ" + DCA T2 + JMP I T2 + + +/ASK-TYPE CONTROL CHARACTER TABLE +ATLIST, TAB /& - TABULATION DELIMITER + TINTR /% - FORMAT DELIMITER + TQUOT /" - LITERAL DELIMITER + TCRLF /! - CARRIAGE RETURN AND LINE FEED + TCRLF2 /# - CARRIAGE RETURN ONLY + TDUMP /$/- DUMP THE SYMBOL TABLE CONTENTS + TASK4 /SP- TERMINATOR FOR NAMES + TASK4 /, - TERMINATOR FOR EXPRESSIONS + PROCESS /; - TERMINATOR FOR COMMANDS + PC1 /C.R. - TERMINATOR FOR STRINGS +///// +FLTONE, 0001 + 2000 +FLTZER, 0000 + 0000 + 0000 + /EVALUATE AN EXPRESSION WHICH +/TERMINATES WITH AN R-PAR,; OR C.R. AND +/LEAVE THE RESULT IN FLAC AND IN FLARG. + + + + + GETC /MOVE PAST EXTRA CHARACTER +EVAL, DCA LASTOP /EVAUATION CONTROLLER (CHECKPOINT ?) + TESTC /TEST CHARACTER AND IGNORE SPACES + JMP ETERM1 /TERMIOATION + JMP ENUM /NUMBER + JMP EFUN /FUNCTION + PUSHJ /LETTER OF VARIABLE + GETVAR /FIND OR CREATE VARIABLE;ALSO SET PT1. +OPNEXT, TESTC /PT1=>ARG + JMP ETERMN /T +ECHOLST,0212 /N-ERROR IN FORMAT + 0377 /F + ERROR4 /L - MISSING OPERATOR +///// +ETERM1, PUSHF /INITIALIZE RESULT TO ZERO. + FLTZER + POPF + FLARG + TAD FLARGP /SET PT1. + DCA PT1 + TAD M2 /TEST FOR UNARY OPERATIONS + TAD SORTCN + SNA + JMP ETERM /CREATE DUMMY FOR UNARY MINUS + IAC + SNA CLA + JMP ARGNXT /IGNORE UNARY PLUS + TAD SORTCN /TEST FOR NULL PARENS. + TAD M11 + SPA CLA + JMP ELPAR /MIGHT BE AN L-PAR. +ETERMN, TSTLPR + SKP + ERROR4 /OPERATOR MISSING BEFORE PAREN +ETERM, TAD SORTCN /SET FROM "TESTC"-"SORTC" + DCA THISOP + TAD THISOP + TAD M11 + SMA CLA /END? + DCA THISOP /"THISOP" EQUIV. TO END OF EXP. + +ETERM2, CLA IAC /COMPARE PRIORITIES + AND THISOP /PRIORITIES ARE: (^),(*/),(+-),PUT + TAD THISOP + CIA + DCA FLOPR + IAC + AND LASTOP + TAD LASTOP + TAD FLOPR + SPA CLA + JMP EPAR /CONTINUE + TAD LASTOP /FIND OPERATION FROM TABLE + TAD OPTABL + DCA FLOPR + TAD I FLOPR + DCA FLOPR + TAD LASTOP + SZA CLA /TEST FOR END OF DATA INTO FLOATING AC. + POPF /GET LAST DATA + FLAC + FENT +FLOPR, 00 /(FLOPR I PT1) +-*/^ + FPT I FLARGP /SAVE RESULT + FEXT + TAD FLARGP + DCA PT1 + TAD THISOP + TAD LASTOP /=0? + SNA CLA + POPJ /EXIT "EVAL" + POPA /GET PRIOR OP + DCA LASTOP + JMP ETERM2 /COMPARE THIS OP +///// +EPAR, TSTLPR /TEST FOR SUB-EXPRESSION + SKP + JMP EPAR2 /GO EVALUATE EXPRESSION + TAD LASTOP /CONTINUE READING THE EXPRESSION + PUSHA /SAVE "LASTOP". + TAD PT1 + DCA .+2 + PUSHF /SAVE LAST ARGUMENT + 00 + TAD THISOP /MORE TO COME + DCA LASTOP +ARGNXT, GETC /READ 1ST CHAR OF AN ARG. + TESTC /DO SPECIAL CHECK + JMP ELPAR /COULD BE LEFT PAREN + JMP ENUM /N + JMP EFUN /F + JMP OPNEXT-2 /L +OPTABL, OPTABS +///// + +ENUM, PUSHF /TO PROCESS A NUMBER,SAVE AC + FLAC + TAD FLARGP /SET POINTER AS FOR A VARIABLE. + DCA PT1 + JMS I FINPUT /READ TEXT NUMBER => (PT1) + POPF /RESTORE THE AC + FLAC + JMP OPNEXT /CONTINUE +///// +EFUN, DCA FLOPR /SET CODE + GETC /READ FUNCTION NAME.(1,2,OR 3 LETTERS) + SORTC /LOOK FOR TERMINATION CHARACTER. + TERMS-1 + JMP EFUN2 /YES + TAD FLOPR /NO + CLL RAL /MISH-MASH HASH CODE + TAD CHAR + JMP EFUN +ELPAR, TSTLPR + ERROR4 /DOUBLE OPERATORS +EPAR2, TAD SORTCN /LEFT PARENS FOUND. + PUSHA + TAD LASTOP /SAVE DATA + PUSHA + PUSHJ /EVALUATE THE EXPRESSION + EVAL-1 + JMP I EFUN3I +/// +EFUN2, TAD SORTCN /SAVE 'SORTCN','LASTOP',AND FUNC CODE + PUSHA + TAD LASTOP + PUSHA + TAD FLOPR /SAVE FUNCTION CODE. + PUSHA + TSTLPR + ERROR4 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT + PUSHJ /YES + EVAL-1 + POPA /BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I. + SORTJ + FNTABL-1 + FNTABF-FNTABL + ERROR2 /ILLEGAL FUNCTION NAME. +///// + + 241 /! + 242 /" + 256 /. -FOR INPUT NUMBERS +TERMS=. /TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR' + 240 /SPACE 0 + 253 /+ 1 + 255 /- 2 + 257 // 3 + 252 /* 4 + 336 /UP ARR 5 + 250 /( 6 L-PARS + 333 /[ 7 + 274 /< 10 + 251 /) 11 R-PARS + 335 /] 12 + 276 /> 13 + 254 /, 14 + 273 /; 15 + 215 /C.R. 16 + 275 /= TO END GETARG FROM 'SET' +OPTABS, FGT I PT1 + FAD I PT1 + FSB I PT1 + FDV I PT1 + FMY I PT1 + FPW I PT1 +///// +FLARG, 0 /DATA TEMPORARY STORAGE + 0 + 0 +///// +/FOCAL TEXT FOR "HELLO" COMMAND +HPT, 7056 /[T %] 8.4; + 6473 + 1740 /OPTION K,T,I,E,:,S; + 1354 + 2454 + 1154 + 0554 + 7254 + 2373 + 0540 /ERASE ALL + 0177 + 1500 +///// +/ABSOLUTE VALUE FUNCTION +XABS, TAD FLAC1 + SPA CLA + NEGATE + /CONTINUATION OF FUNCTION CALLS. + +EFUN3, POPA /RESTORE LAST OPERATION + DCA LASTOP + FENT + FNR /NORMALIZE FUNCTION RETURN + FPT FLARG + FEXT + TAD FLARGP /SET POINTER + DCA PT1 + POPA /GET LAST PAREN CODE. + CIA /CHECK FOR PAREN MATCH. + TAD M3 + TAD SORTCN /(STILL SET FROM THE LAST "EVAL") + SZA CLA /SKIP IF MATCH + ERROR4 /PAREN ERROR + GETC /MOVE PAST R-PAR, AND RETURN TO OPNEX. + JMP I .+1 /FUNCTION RETURN IS OK + OPNEXT +//// + +LPRTST, 0 /SKIP IF LEFT PAREN. - 'TSTLPR' + TAD SORTCN + TAD M11 + SMA CLA + JMP I LPRTST + TAD SORTCN + TAD M5 + SMA SZA CLA + ISZ LPRTST + JMP I LPRTST + + /THE DELETE A LINE ROUTINE + +DELETE, FINDLN /SETS "THISLN" AND "LASTLN". + POPJ /ALREADY GONE + ISZ DEBGSW /DISABLE TRACE + GETC /MEASURE LENGTH + TAD CHAR + TAD MCR + SZA CLA + JMP .-4 + TAD AXOUT /SAVE LAST ADDRESS + CMA + TAD THISLN + DCA CNTR /LENGTH < 0 + TAD I THISLN /DISCONNECT + DCA I LASTLN + TAD CFRS /START LIST AT TOP +DOK, DCA T2 /EXAMINATION ADDRESS + TAD I T2 /GET THE NEXT ADDR. + SNA /TEST FOR END + JMP DONE /YES-WRAP UP ALL. + DCA T1 /SAVE NEXT ADDRESS. + TAD THISLN /COMPARE LINE POSITIONS + CIA CLL + TAD T1 + SZL CLA /SKIP IF THISLN > X + TAD CNTR /CHANGE (X) TO ACCOUNT FOR + TAD T1 /GARBAGE COLLECTION. + DCA I T2 + TAD T1 /GET NEXT + JMP DOK +///// + /GARBAGE COLLECTION + +DONE, CMA /BACKUP L FOR XR + TAD THISLN + DCA XRT + TAD CNTR /SETUP END OF HOSE + CMA + TAD THISLN + DCA XRT2 + TAD CNTR /CORRECT END OF BUFFER POINTER. + TAD BUFR + DCA BUFR + TAD AXIN /COMPUTE COUNT + CMA + TAD XRT2 + DCA T1 + TAD AXIN + TAD CNTR + DCA AXIN + TAD I XRT2 /SIPHON LOWER PART. + DCA I XRT + ISZ T1 + JMP .-3 + JMP DELETE /RESET 'LASTLN','THISLN', AND DATA`FIELD. +///// +/OPTION TABLE +OPTTBL, OPTK /SWITCH TO KEYBOARD INPUT + OPTR /READER INPUT + OPTT /TTY OUTPUT + OPTP /PUNCH OUTPUT + OPTI /INTERPRETIVE/NUMERIC I/O + OPTC /SINGLE CHARACTER I/O + OPTCOL /PRINT ":" AT "ASK" + OPTX /SUPPRESS ":" + OPTE /ECHO KEYBOARD INPUT + OPTN /NO ECHO + OPTS /SET VARIABLE TERMINATOR + OPTM /START DISK MONITOR + +FNTABL=. + 2533 /ABS + 2650 /SGN + 2636 /ITR + 2565 /DIS + 2630 /RAN + 2623 /DXS + 2517 /ADC + 2572 /ATN + 2624 /EXP + 2625 /LOG + 2654 /SIN /LIST OF CODED FUNCTION NAMES + 2575 /COS + 2702 /SQT + 2631 /NEW + /ERASE SINGLE LINES, GROUPS, OR VARIABLES +ERASE, TAD CHAR /SEE IF "ALL" + TAD MINUSA + SZA CLA + JMP ERVX + TAD ENDT /YES, ERASE ALL TEXT + DCA BUFR + DCA I CFRS +ERV, TAD STARTV /ERASE VARIABLES + DCA LASTV + JMP START /PROGRAM EXECUTION ENDS +///// +ERVX, GETLN /GET LINE NUMBER + TAD LINENO /SEE OF ZERO OR NONE + SZA CLA + JMP ERL /NO, ERASE LINES + TAD STARTV /YES, ERASE VARIABLES + DCA LASTV + JMP I .+1 /CONTINUE PROCESSING + PROC +///// +ERL, TAD BUFR /ERASE LINES + DCA AXIN +ERG, PUSHJ /EXTRACT ONE LINE + DELETE + ISZ THISLN + TAD NAGSW + SMA CLA + TAD I THISLN + TSTGRP /IF GROUP, SEE IF END OF GROUP + JMP ERV /YES + TAD I THISLN /NO, CONTINUE ERASING GROUP + DCA LINENO + JMP ERG + /ROUTINE CALLED VIA "FINDLN": + +/SEARCH FOR A GIVEN LINE I.D. =[ "LINENO" ] +/1ST RETURN IF NOT FOUND, +/2AND IF FOUND. +/"THISLN" = FOUND LINE OR NEXT LARGER. +/"LASTLN" = LESSER AND/OR LAST. +/"TEXTP" IS SET + +XFIND, 0 + TAD CFRS /INITIALIZE POINTERS TO FIRST LINE + DCA LASTLN + TAD CFRS +FINDN, DCA THISLN /SAVE THIS ONE + TAD THISLN + DCA XRT2 + TAD LINENO + CIA + TAD I XRT2 /LINENO=0 WILL ALSO BE FOUND + SNA + ISZ XFIND /FOUND IT (2ND EXIT) + SMA CLA + JMP FEND3 /PAST IT. + TAD THISLN /MOVE POINTERS + DCA LASTLN + TAD I THISLN + SZA /SKIP IF END OF TEST + JMP FINDN +FEND3, TAD THISLN + IAC + DCA AXOUT /SET "TEXTP". + DCA XCT + JMP I XFIND + +UTRA, 0 /UNPACK CHARACTER. - "GETC" + JMS GET1 +UTE, SPA CLA /NORM & EXTEND + TAD C100 /300-337 & 340-376 + TAD M137 /240-276 & 200-236 + TAD CHAR + SNA + JMP UTX /"?" FOUND + TAD P337 +UTQ, DCA CHAR + TAD DEBGSW + TAD DMPSW + SNA CLA /PRINT ONLY IF BOTH ARE ZERO. + PRINTC + JMP I UTRA +////// +EXTR, JMS GET1 + CMA + JMP UTE +/// +UTX, TAD DEBGSW /TEST FOR TRACE-ENABLED + SZA CLA + JMP .+6 + TAD DMPSW /FLIP THE TRACE FLOP + SNA CLA + IAC + DCA DMPSW + JMP UTRA+1 /GET NEXT CHARACTER INSTEAD. + TAD P277 /TRACE DISABLED = RETURN "?" + JMP UTQ + +GET1, 0 /UNPACK 6-BITS + ISZ XCT /STARTS=0 + JMP GET3 + TAD GTEM +GEND, AND P77 + DCA CHAR /SAVE + TAD CHAR + TAD M77 + SNA CLA + JMP EXTR /EXTENDED + TAD CHAR + TAD M40 + JMP I GET1 +///// + +GET3, TAD I AXOUT /(X-MEM) + DCA GTEM + CMA + DCA XCT + TAD GTEM + RTL6 + RAL + JMP GEND +M40, -40 +M137, -137 +///// +/OPTION LIST +OPTLST, "K + "R + "T + "P + "I + "C + ": + "X + "E + "N + "S + "M +///// +/ANALOG-DIGITAL CONVERSION +XADC, 6004 + DCA FLAC1 /ARG MUST BE 0 + RETURN + +XENDLN, 0 /TERMINATE THE BUFFERED LINE - "ENDLN" + TAD I LASTLN /SAVE OLD POINTER + DCA I BUFR + TAD BUFR /POINT TO NEW LAST LINE + DCA I LASTLN + TAD ADD /CHECK FOR EXTRA INFO + SZA + DCA I AXIN + TAD AXIN /COMPUTE NEW`END OF BUFFER + IAC + DCA BUFR + TAD STARTV /RESET VARIABLE LIST + DCA LASTV + JMP I XENDLN +///// +TXTSAV, 0 /SAVE CHAR AND TEXT POINTERS + PUSHF + TEXTP + TAD CHAR + PUSHA + JMP I TXTSAV +/ +TXTRES, 0 /RESTORE SAME + POPA + DCA CHAR + POPF + TEXTP + JMP I TXTRES +///// +GRPTST, 0 /AC VS LINENO - "TSTGRP" + AND P7600 + CIA + DCA T2 + TAD LINENO + AND P7600 + TAD T2 + SNA CLA + ISZ GRPTST + JMP I GRPTST + /I-O SUBROUTINES + +VAL=. +CHIN, 0 /READ IN A CHARACTER SUBR. - "READC" + JMS I INDEV + DCA CHAR + SORTC /LINEFEED OR RUBOUT? + ECHOLST-1 + JMP I CHIN /YES +ECHO, PRINTC + TAD CHAR /SEE IF 200 (L/T) + TAD P7600 + SZA CLA + JMP I CHIN /NO, EXIT + JMP CHIN+1 /YES, GET ANOTHER +///// +OUT, 0 /OUTPUT A CHARACTER - "PRINTC" + SNA /USE (AC) OR (CHAR) + TAD CHAR + TAD MCR + SNA + JMP OUTCR + TAD CCR + JMS I OUTDEV +OUTX, JMP I OUT +///// +OUTCR, TAD CCR + JMS I OUTDEV + TAD CLF + JMP OUTX-1 +///// +/TEST FOR A COMMA, SEMICOLON, OR CR - "TSTERM" +/RETURNS: OTHER, ; OR CR, COMMA +/GETS NEXT CHARACTER AFTER COMMA OR OTHER +XTSTER, 0 + SORTC /LOOK FOR ,;CR + TLIST-1 + SKP + JMP .+6 /OTHER, GO PAST IT + TAD SORTCN /FOUND ONE, SEE WHAT IT IS + ISZ XTSTER + SZA CLA + JMP I XTSTER /; OR CR: 2ND EXIT + ISZ XTSTER /COMMA, 3RD EXIT + GETC + JMP I XTSTER +///// + +COMEIN=.-1 /COMMAND-INPUT BUFFER LIVES HERE. + +COMOUT=2600 + *COMOUT + +/INTERRUPT PROCESSOR. + +SAVAC, 0 /CONTENTS OF AC +SAVLK, 0 /CONTENTS OF LINK +MBREAK, -203 /CONTROL-C +INTRPT, DCA SAVAC /SAVE WORKING DATA + RAR + DCA SAVLK + KSF /CHECK FOR KEYBOARD FIRST + JMP TINT + KRB /READ BUFFER AND CLEAR FLAG TO FETCH NEXT + AND P177 /IGNORE PARITY BIT + TAD C200 + DCA SIN + TAD SIN + TAD MBREAK /MANUAL STOP? + SNA CLA + JMP RECOVR + TAD INBUF /ANY SPACE? + SZA CLA + ERROR2 /WILL WAIT FOR OUTPUT BUFFER + TAD SIN + DCA INBUF /SAVE INPUT +TINT, TSF + JMP EXIT + TCF + DCA TELSW /TURN OFF THE IN-PROGRESS FLAG. + TAD I OPTRI + SNA + JMP EXIT /DONE + TPC /TYPE NEXT. + DCA TELSW /CLEAR AC AND TURN ON THE FLAG. + DCA I OPTRI /ZERO OUT THE DATA AREA + TAD OPTRI + IAC + AND P17 + TAD OPTR0 + DCA OPTRI +EXIT, 6244 /RESTORE MEMORY FIELD + 6101 /SMP + NOP /(HLT)-IF YOU HAVE MEMORY PARITY + RSF /TEST H.S. READER FLAG + JMP .+3 + RRB /READ BUFFER AND CLEAR FLAG + DCA HINBUF /SAVE CHARACTER + TAD SAVLK + RAL CLL + TAD SAVAC + ION +EXITJ, JMP I 0 + +TELSW, 1 /INPUT SWITCH +OPTR0, IOBUF /OUTPUT POINTERS +OPTRO, IOBUF /VARS +OPTRI, IOBUF +INBUF, 0 /KEYBOARD BUFFER. +///// +XI33, 0 /VIA (INDEV) + TAD INBUF /ANY INPUT? + SPA SNA + JMP .-2 /NO = WAIT + DCA XOUTL + DCA INBUF /CLEAR INPUT BUFFER + TAD XOUTL + JMP I XI33 +///// +XOUTL, 0 /VIA (OUTDEV) + DCA XI33 /SAVE CURRENT CHARACTER. + TAD XI33 /IS IT A CR? + TAD MCR + SNA CLA + DCA TABCTR /YES, RESET CARRIAGE INDEX + TAD XI33 + JMS I SKPNP /SKIP IF A NON-PRINTING CHARACTER + ISZ TABCTR /PRINTING: INCREMENT INDEX +SIN, 0 + ION /BE SURE INTERRUPT IS ON. + TAD I OPTRO /ANY ROOM? + SZA CLA /A CHARACTER IS NON-ZERO + JMP .-2 /NO = WAIT. + TAD TELSW /IN PROGRESS? + SZA CLA + JMP .+5 + TAD XI33 /NO + TLS /TYPE CHARACTER. + DCA TELSW /SET IN-PROGRESS FLAG. + JMP I XOUTL /RETURN + TAD XI33 /SEND DATA + DCA I OPTRO + TAD OPTRO /SET POINTERS + IAC + AND P17 + TAD OPTR0 + DCA OPTRO + JMP I XOUTL +/////// +SKPNP, SKIPNP + ERROR2=ERROR; ERROR3=ERROR; ERROR4=ERROR +WAITP, OWAIT +OPTDOP, OPTTDO +ERROR5, DCA .+1 /ERROR CALLED FROM A TABLE +ERR2, 0 /LIMIT EXCEEDED + CLA CMA /COMPUTE CALLING ADDRESS (ALSO "SPACE") + TAD ERR2 /AND USE IT AS ERROR NUMBER. + DCA LINENO /SAVE ERROR CODE. + JMS I WAITP /WAIT FOR OUTPUT TO FINISH + IOF /DISABLE INTERRUPT FOR INITIALIZATIONS + JMP .+3 +RECOVR, TAD C200 + DCA LINENO /SAVE ERROR NUMBER + ISZ TELSW /TURN ON IN-PROGRESS SWITCH + TAD M20 /SETUP INIT COUNT + DCA CNTR + CMA + TAD OPTR0 + DCA XRT /INIT I/O BUFFERS. + DCA I XRT + ISZ CNTR + JMP .-2 + DCA INBUF /INIT KEY-BUFR. + TAD OPTR0 /INIT TTY POINTERS. + DCA OPTRI + TAD OPTR0 + DCA OPTRO + JMS I OPTDOP /SET TO TTY OUTPUT + TAD PTCH /RESET "READC" + DCA 113 /IF AN ERROR OCCURS. + CMA /PREPARE A STOP BIT FOR TTY + TLS /AND RAISE FLAG + CLA + TAD CCR /PRINT A CR + PRINTC + TAD P277 /MAKE A ? + PRINTC /AND TURN ON THE INTERRUPT + PRNTLN /PRINT ERROR NUMBER AND, + ISZ PC + TAD I PC /UNLESS IT IS ZERO, (X-MEM) + SNA + JMP .+6 + DCA LINENO + TAD P7700 + PRINTC + PRINTC /PRINT SPACE AGAIN AND + PRNTLN /PRINT LINE OF ERROR. + TAD CCR + PRINTC + JMP START /INTERRUPT WILL BE RE-ENABLED SOON. +///// + /SKIP IF (AC) IS A NON-PRINTING CHARACTER +SKIPNP, 0 + RTL6 /PRINTING CHARACTERS ARE 240-337 + SPA CLA + CML + SNL + ISZ SKIPNP + JMP I SKIPNP +///// +/PACK A CHARACTER INTO THE BUFFER - "PACKC" +PACBUF, 0 + SORTJ /LOOK FOR ? OR RUBOUT + PACLST-1 + PACLS2-PACLST + TAD CHAR + JMS SKIPNP /PRINTING CHARACTER? + JMP .+3 /YES + TAD P77 /NO, PACK 77 FIRST + JMS PCK1 + TAD CHAR /PACK 6-BIT CHARACTER + AND P77 + JMS PCK1 + JMP I PACBUF +///// +PQUES, TAD P337 /USE 337 FOR ? + JMP .-4 +///// +/PACK ONE 6-BIT WORD +PCK1, 0 + ISZ XCTIN + JMP ROT /PACK LEFT HALF + TAD ADD /PACK RIGHT HALF AND STORE + DCA I AXIN + TAD PDLXR /CHECK FOR SPACE + CLL CIA + TAD P13 + TAD AXIN + SZL CLA + ERROR /BUFFER OR STORAGE OVERFLOW + JMP I PCK1 +///// +PACLST, 277 /? + 377 /RUBOUT +///// +ROT, RTL6 /SAVE LEFT HALF + DCA ADD + CMA + DCA XCTIN + JMP I PCK1 + /RUBOUT ONE CHARACTER +RUB1, TAD AXIN /SAVE POINTER + DCA PCK1 + TAD XCTIN /CHARACTER IN ADD? + SZA CLA + JMP RUB2 /YES + TAD AXIN /NO, BEGINNING OF BUFFER? + CIA + TAD PACKST + SMA CLA + JMP PKZERO /YES, IGNORE +RUB2, TAD SPLAT /ECHO A BACKSLASH + PRINTC + ISZ XCTIN + JMP RUB3 /BACKUP STORAGE + TAD I PCK1 /KILL ADD AND CHECK FOR 77 + AND P77 /IN 2ND HALF OF LAST STORED WORD + TAD M77 + SZA CLA + JMP PKZERO /NO, DONE +RUB3, TAD I PCK1 /KILL 2ND HALF OF LAST STORED WORD + AND P7700 + DCA ADD + CMA /BACKUP POINTER + TAD AXIN + DCA AXIN + TAD ADD /TEST FOR 77 IN ADD + TAD C100 + SZA CLA + CMA +PKZERO, DCA XCTIN + JMP I PACBUF +SPLAT, 334 + /DUMP THE SYMBOL TABLE CONTENTS +TDUMP, PUSHF /SAVE TEXT POINTERS + TEXTP + CMA + TAD STARTV /START VARIABLE LIST +TDLOOP, DCA FLTXR + TAD FLTXR /TEST FOR END OF LIST + CMA + TAD LASTV + SNA CLA + JMP TDEND /END FOUND + TAD TDTEXT /NO, SET UP POINTERS + DCA AXOUT + DCA XCT + TAD I FLTXR /2 LETTERS OF VAR. NAME + DCA TDTEXT+1 + PUSHJ /PRINT NAME AND "(" + TQUOT + TAD I FLTXR /GET AND PRINT SUBSCRIPT + JMS I TDOUTP + PUSHJ /PRINT ")=" + TQUOT + TAD P13 /SPACE TO 11TH COLUMN + DCA FLAC2 + PUSHJ + TAB+12 + ISZ FLTXR + FENT /PICK UP VALUE + FGT I FLTXR /(DOES NOT AUTOINDEX) + FEXT + JMS I FOUTPUT /PRINT VALUE + TAD CCR /AND A C.R. + PRINTC + TAD FLTXR /INCREMENT FOR NEXT VAR. + TAD P2 + JMP TDLOOP +TDEND, POPF /RESTORE TEXT POINTERS + TEXTP + JMP I .+1 + TASK4 +TDOUTP, SIGOUT +TDTEXT, . /THE FOLLOWING IS FOCAL TEXT + 0 /VAR. NAME GOES HERE + 5077 /"(" AND C.R. + 1551 /")=" AND C.R. + 7577 + 1500 + /OPTION ROUTINES +/ +/ROUTINE TO SET UP OUTPUT +OPTTDO, 0 + TAD CTSF + DCA I OPTTL /TSF + TAD I OPTTL + IAC + DCA I OPTTL+1 /TCF + TAD I OPTTL+1 + TAD P2 + DCA I OPTTL+2 /TPC + TAD I OPTTL+2 + TAD P2 + DCA I OPTTL+3 /TLS + JMP I OPTTDO +CTSF, TSF +OPTTL, TINT + TINT+2 + TINT+7 + SIN+11 +///// +/ROUTINE TO WAIT UNTIL OUTPUT FINISHES +OWAIT, 0 + ION /(SWAP) - FOR 2-USER + TAD I TSWP /LOOK AT TELSW + SZA CLA + JMP .-3 + JMP I OWAIT +TSWP, TELSW +///// +OPTP, JMS OWAIT /SET UP FOR PUNCH OUTPUT + TAD M20 /CONVERT TO PSF, ETC. + SKP +OPTT, JMS OWAIT /SET UP FOR TTY OUTPUT + JMS OPTTDO +OPTXIT, JMP I .+1 /EXIT OPTIONS + OPTRET + +OPTX, TAD OPTC1 /SUPPRESS ":" ON ASK +OPTCOL, TAD CPRINT /RESTORE ":" + DCA I COLP + JMP OPTXIT +CPRINT, PRINTC +OPTC1, CLA-PRINTC +COLP, TASKCL +///// +OPTE, TAD CPRINT /SET UP FOR KEYBOARD ECHO +OPTN, DCA I ECHP /SUPPRESS ECHO + JMP OPTXIT +ECHP, ECHO +///// +OPTS, GETC /SET UP USER TERMINATOR FOR "ASK" + SORTC + TERMS-3 + SKP + JMP .-4 + PUSHJ /GET CHARACTER + EVAL + FIX + DCA I USERTP + JMP OPTXIT +USERTP, USERT +///// +OPTM, JMS OWAIT /EXIT TO DISK MONITOR + IOF + JMP I P7600 +///// +/THIS IS THE INITIALIZATION COMMAND +HELLO, TAD HP + DCA AXOUT + DCA XCT + PUSHJ /START BY SETTING FORMAT + TINTR +///// +HP, HPT-1 /FOCAL TEXT "%8.4;O K,T,I,E,:,S;E A" + / I/O MODE OPTIONS +OPTC, CLA CMA +OPTI, DCA IOSW + JMP OPTXIT +///// +IOSW, 0 +/ I/O MODE: "I" = 0000 = INTERPRETIVE INPUT, NUMERIC OUTPUT +/ "C" = 7777 = SINGLE CHARACTER I/O +///// +/"ASK" MASTER ROUTINE +INTASK, 0 + TAD PT1 /SAVE VAR. POINTER + DCA OWAIT + TAD IOSW /WHAT MODE OF INPUT? + SNA CLA + JMP STRING /INTERPRETIVE + READC /SINGLE CHARACTER + TAD CHAR /CONVERT CHARACTER CODE TO FLOATING + FLOAT /POINT NUMBER +ASKEND, FENT /SAVE VALUE + FPT I OWAIT + FEXT + JMP I INTASK +/INTERPRETIVE BUFFERED INPUT +STRING, TAD PDLXR /SAVE PUSHDOWN LIST POINTER + DCA OPTTDO + TAD BUFTOP /PROTECT TOP OF ASKBUF + DCA PDLXR + ISZ DEBGSW /DISABLE TRACE +INBARR, TAD BUFBOT /INITIALIZE ASKBUF + DCA AXIN + DCA XCTIN + TAD BUFBOT + DCA PACKST + READC /IGNORE SPACES + SORTC + C240-1 + JMP .-3 + SORTJ /SEARCH FOR TERMINATOR + ASKLST-1 + ASKLS2-ASKLST + PACKC /PACK INTO BUFFER +INGT, READC + JMP .-5 + /TERMINATOR FOUND, PROCESS INPUT +INTERM, TAD CCR /PACK A C.R. + DCA CHAR + PACKC + PACKC + TAD OPTTDO /RESTORE PDLXR + DCA PDLXR + TAD BUFBOT /INITIALIZE UNPACKING + DCA AXOUT + DCA XCT + PUSHJ /EVALUATE EXPRESSION + EVAL-1 + JMP ASKEND +///// +BUFBOT, ASKBUF /BOTTOM OF BUFFER +BUFTOP, ASKBND /TOP+12 OF BUFFER +///// +/"TYPE" OUTPUT +OUTPT, 0 + TAD IOSW /WHAT KIND OF OUTPUT + SZA CLA + JMP COUTPT /SINGLE CHARACTER + JMS I FOUTPUT /NUMERIC OUTPUT, PRINT VALUE + JMP I OUTPT +///// +COUTPT, FIX /GET CODE FOR CHARACTER + SNA /MODULO 256 + CLL CML RAR /TO ALLOW ZERO CODE TO BE PRINTED + JMS I OUTDEV + JMP I OUTPT +/NOTE: "TDUMP" PRINTS ONLY IN NUMERIC MODE + IOBUF=3400 +/ +*IOBUF+20 +FRST, 0 /TEXT POINTER + 0000 /DUMMY LINE NO + 0355 / C- + 0617 / FO + 0301 / CA + 1454 / L, + 4040 + 6557 / 5/ +FRSTX, 6671 / 69 + 7715 +BUFBEG=. +///// + /FOCAL INITIALIZATION ROUTINE +*BUFBEG +BEGIN, CLA CLL + TAD (RECOVR+1 /RESTORE RESTART + DCA START-1 + IOF /CLEAR FLAGS TO PREVENT INTERRUPT + 6022 /PCF + 6032 /KCC + 6203 /CDF CIF 00 + 6402 /CLEAR PT08'S + 6412 + 6422 + 6432 + 6442 + 6452 + 6462 + 6472 + 6764 /CLEAR DECTAPE + 6772 + CLA + TLS /START LOW SPEED OUTPUT + DCA I FLTXR /CLEAR OUTPUT BUFFER + ISZ (-20 + JMP .-2 + TAD BOTTOM /INITIALIZE PUSHDOWN LIST + DCA PDLXR + ION + PRINTC /CHAR IS A C.R + PRINTC + PRINTC + PUSHJ /TYPE FOCAL HEADING + WRITE + JMP I .+1 + ERV-3 /ERASE ALL + +/EXTENDED FUNCTION PACKAGE FOR FOCAL 5/69 +/E.A.TAFT, 6/10/69 +/ +/FSIN: SIN(X) X IN RADIANS +/FCOS: COS(X) X IN RADIANS +/FATN: ARC TAN(X) RESULT IN RADIANS +/FEXP: EXP(X) +/FLOG: LN(X) +///// +/DEFINITIONS +FIXMRI FAD=1000 +FIXMRI FSB=2000 +FIXMRI FMY=3000 +FIXMRI FDV=4000 +FIXMRI FGT=5000 +FIXMRI FPT=6000 +FNR=7000 +FENT=4407 +FEXT=0 +///// +NEGATE= 4450 +GETSGN= 1045 +RETURN= 5500 +SN= 10 +FIX= 4452 +PUSHA= 4503 +POPA= 1413 +FLAC= 44 +FLTEMP= 7545 +FLTONE= 1573 +PDLXR= 13 +ERROR= 4526 +FLOAT= 4430 +FNTABF= 571 +BOTTOM= 27 +COMGO= 1164 +SORTJ= 4510 +M5= 67 +CNTR= 132 +AXIN= 10 +TSTERM= 4565 +PROC= 616 +ERROR5= 2735 +DBCONV= 5600 + *BOTTOM + FCOS-1 /TOP OF TEXT +*FNTABF+7 + FATN /POINTERS TO EXTENDED FUNCTIONS + FEXP + FLOG + FSIN + FCOS +///// +/ENABLE A "LIBRARY DELETE" COMMAND +/WHICH WILL DELETE THE EXTENDED FUNCTIONS AND +/FREE MORE FOR USER AREA. +*COMGO+10 + LIBRARY +*6555 +LIBLST, "D +///// +LIBRARY,SORTJ /"LIBRARY" - EXPANDABLE COMMAND + LIBLST-1 + LIBGO-LIBLST + ERROR /ILLEGAL LIBRARY COMMAND +///// +LIBD, TAD M5 /DELETE THE EXTENDED FUNCTIONS + DCA CNTR + TAD EXTAB + DCA AXIN + TAD PERROR + DCA I AXIN /SET ERROR5 POINTERS + ISZ CNTR + JMP .-3 + TAD DTOP + DCA BOTTOM /MOVE TOP POINTER UP + JMP 6461 /OPTRET (TO REACH END OF COMMAND) +///// +EXTAB, FNTABF+6 +DTOP, DBCONV-1 +LIBGO, LIBD +*175 +PERROR, ERROR5 + /FOCAL EXTENDED FUNCTIONS +*5113 +/ COSINE +FCOS, NEGATE /COS(X)=SIN(PI/2-X) + FENT + FAD I PI2 + FEXT +///// +/ SINE +FSIN, GETSGN + SNA + RETURN /SIN(0)=0 + SPA CLA + JMS I NEG2 /SIN(-X)=-SIN(X) + DCA SN + FENT + FDV TWOPI /REDUCE MODULO 2 PI + FPT I X2 + FEXT + FIX + NEGATE + FENT + FNR + FAD I X2 + FMY TWOPI + FPT I X2 + FSB PI + FEXT + GETSGN /XFLOP + FLAC1 + POPF + FLOP1 + DCA REMAIN /CLEAR OVERFLOW + JMS MULT2 /FLAC*10 = (FLAC*2*2+FLAC)*2 + JMS MULT2 + JMS TRPLAD + JMS MULT2 + JMP I MULT10 +SGNTST, TSTSGN +MULT2I, RALAC +DECIN1, DECINT +IRARAC, RARAC +IOVRL, OVCHEK +ROTRAC, RARAC+5 +C43, 43 +DECEXP, 0 /IMPLICIT DECIMAL EXPONENT +INSIGN, 0 /SIGN OF MANTISSA +CFNR, FNR +FLINST, FMY .+4 +FLTEN, 0004 /10(10) FLOATING + 2400 + 0000 +FLPTEN, 7775 /.10(10) FLOATING + 3146 + 3147 +REMAIN=TEMP1 +/CHARACTER LIST FOR "ASK" +ASKLST, 215 /CR + 214 /FF + 337 /BA + 254 /COMMA +USERT, 0 /USER-SELECTED CHARACTER + 212 /LF + /POWER OF 10 TABLE +INTABL, -1750 /1000 + -144 /100 + -12 /10 + -1 /1 +/INPUT A DECIMAL INTEGER <2048 +DECINT, 0 + DCA DECNUM + TESTN /GET A DIGIT + NOP + JMP I DECINT /NONE FOUND + GETC + TAD DECNUM /MULTIPLY PREV. # BY 10 + CLL RTL + SPA SZL + JMP .+5 /OVERFLOW (>2047) + TAD DECNUM + RAL + TAD SORTCN /ADD NEW DIGIT + SPA SZL + ERROR + JMP DECINT+1 +DECNUM=TEMP3 +/TEST FOR A SIGN +TSTSGN, 0 + SPNOR + DCA SORTCN + SORTC /LOOK FOR + OR - + SNLIST-1 + GETC /SIGN FOUND + SPNOR /NOT FOUND + CLA CMA + TAD SORTCN /SORTCN: 0=+, 1=- + JMP I TSTSGN /AC: 7777=+, 0=- +DIGIT=TEMP2 + /PRINT A 2-4 DIGIT UNSIGNED DECIMAL INTEGER +/FIRST 2 LEADING ZEROES NOT PRINTED +INTOUT, 0 + DCA DECNUM + TAD INTPTR /POWER OF 10 POINTER + DCA INTSUB + DCA DECINT /DECINT=0 MEANS SKIP 0 OUTPUT + JMS INTDO /1ST DIGIT (1000S) + JMS INTDO /2ND DIGIT (100S) + ISZ DECINT /DECINT>0 MEANS PRINT 0S + JMS INTDO /3RD DIGIT (10S) + JMS INTDO /4TH DIGIT (UNITS) + JMP I INTOUT +INTDO, 0 + DCA DIGIT /INITIALIZE + TAD DECNUM +INTSUB, TAD INTABL /SUBTRACT A POWER OF 10 + SPA + JMP INTNEG + DCA DECNUM /POSITIVE RESULT + ISZ DIGIT /NONZERO DIGIT, SO IGNORE NO + ISZ DECINT /FURTHER ZEROES + JMP INTSUB-1 +INTNEG, CLA CLL /NEGATIVE RESULT + ISZ INTSUB /SET UP NEXT POWER OF 10 + TAD DECINT /IS IT A LEADING 0? + SNA CLA + JMP I INTDO /YES, SKIP IT + TAD DIGIT /NO, PRINT DIGIT + TAD C260 + PRINTC + JMP I INTDO +/OUTPUT A SIGNED INTEGER IN AC +SIGOUT, 0 + DCA DECNUM /SAVE NUMBER + TAD DECNUM + SPA CLA + TAD P2 /MAKE A - + TAD C253 /MAKE A + + PRINTC + TAD DECNUM /OUTPUT ABSOLUTE VALUE + SPA + CIA + JMS INTOUT /OUTPUT THE NUMBER + JMP I SIGOUT +INTPTR, TAD INTABL +SNLIST=. /FOR SIGN TESTING +C253, 253 /+ + 255 /- + /E FORMAT OUTPUT ROUTINE +XXX, CLA /CONVERT TO E FORMAT ON OVERFLOW + TAD TOTDIG + SKP +FLOUT, TAD DECP /E FORMAT (%0) FLOATING OUTPUT + CIA + SNA + TAD MDIG /6 DIGITS IF 0 GIVEN + DCA DECNUM /DIGIT COUNTER + TAD PER /PERIOD + PRINTC +FLDIG, TAD I XRT2 /NEXT DIGIT + ISZ T2 /OUT OF SIG DIGITS? + JMP .+3 /NO, PRINT DIGIT + CLA CMA /YES, RESET POINTER AND PRINT 0 + DCA T2 + JMS I OUTP + SKP /FIELD NOW FILLED, PRINT EXPONENT + JMP FLDIG +/B-D CONV EXPONENT OUTPUT + TAD C305 /PRINT LETTER E + PRINTC + TAD T1 /OUTPUT THE EXPONENT + JMS SIGOUT +BDEND, JMP I BDCONV /DONE +C305, 305 /E +MDIG, -DIGITS +OUTP, OUTA +/PRINT A LINE NUMBER - "PRNTLN" +XPRNTL, 0 + TAD LINENO + RTL6 + AND P77 + JMS INTOUT /2-DIGIT PART NUMBER + TAD PER + PRINTC /DECIMAL POINT + TAD LINENO + AND P177 /2-DIGIT STEP NUMBER + JMS INTOUT + TAD C240 /SPACE + DCA CHAR + PRINTC + JMP I XPRNTL + +NEGSGN, 255-240 +/BINARY TO DECIMAL CONVERSION AND OUTPUT +BDCONV, 0 + TAD FLAC1 /CHECK SIGN + SMA CLA + JMP .+3 + NEGATE /NEGATIVE, TAKE ABSOLUTE VALUE + TAD NEGSGN /MAKE A - + TAD C240 /MAKE A SPACE + PRINTC + CLA CMA /DECREMENT BINARY EXPONENT + TAD FLAC0 + DCA FLAC0 +BDSCAL, DCA T1 /INITIALIZE DECIMAL EXPONENT + TAD FLAC0 /START SCALING: -4= EXPONENT + TAD TOTDIG + SPA + JMP FPRNT-2 /NO ROUNDING NEEDED + TAD MDIGIT /ROUND TO DECP+EXP PLACES + SMA + CLA +R6, TAD RND2 /START ROUNDING + DCA FNEGSW /PLACES TO ROUND TO + TAD BUFST /ROUNDING START ADDRESS + TAD FNEGSW /SET UP ROUND COUNT + DCA FLOP0 + TAD FNEGSW + CIA + DCA FNEGSW /START ROUNDING PROCESS BY + TAD I TENPT /ADDING 4 TO FIRST DIGIT +RET, ISZ I FLOP0 /INCREMENT CURRENT DIGIT + TAD I FLOP0 + TAD M12 + SPA CLA /DIGIT>9? + JMP FPRNT /NO, END ROUNDING + DCA I FLOP0 /YES, SET DIGIT TO 0 AND CARRY + ISZ FNEGSW /BEGINNING OF BUFFER? + JMP DECR /NO DECREMENT BUFFER ADDRESS + ISZ I FLOP0 /YES, FAKE CARRY FROM FIRST DIGIT + ISZ T1 + CLA + +FPRNT, TAD TOTDIG /SET UP FIELD SIZES + SNA + JMP I FLOUTP /E FORMAT OUTPUT + CIA + DCA DECNUM /NUMBER OF PLACES TO PRINT + TAD DECNUM + TAD T1 + SMA SZA + JMP I XXXP /TOO BIG, PRINT E FORMAT + TAD DECP /OK, TEST DECIMAL PLACES + SMA + CLA /ADJUST DECIMAL POINT + CIA + TAD T1 + CLL CIA + DCA FNEGSW /NUMBER OF INTEGER PLACES + SZL + JMP IN+4 /NO INTEGER PLACES + /START PRINTING +BACK, TAD T1 + TAD FNEGSW + SNA CLA + JMP DIG /PRINT A DIGIT + TAD FNEGSW + IAC + SPA CLA /PRINT 0 IF ONE INTEGER PLACE LEFT + TAD M20 /OTHERWISE A SPACE +IN, JMS OUTA /PRINT A CHARACTER + JMP I BDENDP /FIELD FILLED, EXIT + ISZ FNEGSW + JMP BACK /CONTINUE + TAD PER /DECIMAL POINT + PRINTC + JMP BACK +DIG, CMA + TAD T1 /DECREMENT DECIMAL EXPONENT + DCA T1 + ISZ T2 /CHECK SIG DIGIT COUNT + JMP .+4 /SOME LEFT + CMA /ALL USED UP + DCA T2 + JMP IN /PRINT A 0 + TAD I XRT2 /PRINT A SIG DIGIT + JMP IN +/DIGIT PRINT ROUTINE FOR BDCONV +OUTA, 0 + TAD C260 /CONVERT TO ASCII + PRINTC + ISZ DECNUM /FIELD FILLED? + ISZ OUTA /NO, GO TO SECOND RETURN + JMP I OUTA +BDENDP, BDEND + / "OPTION" PROCESSOR +OPTION, SPNOR /GET OPTION LETTER + SORTJ + OPTLST-1 + OPTTBL-OPTLST + ERROR /ILLEGAL OPTION NAME +///// +OPTR, CLA CMA /SWAP INPUT TO HIGH SPEED READER + DCA HINBUF + RFC /START READER + TAD RESTR /POINT TO "HREAD" +OPTK, TAD PTCH /SWAP TO KEYBOARD IF CALLED HERE + DCA 113 +///// +OPTRET, TSTERM /MOVE TO ,;CR + JMP .-1 + JMP I .+2 /END OF OPTIONS + JMP OPTION /CONTINUE PROCESSING OPTIONS + PROC +///// +/HIGH SPEED INPUT ROUTINE +HREAD, 0 +#ifdef NEWWAY + CLA CLL + NOP /PLACE KEEPERS FOR COMPATIBILITY + NOP /WITH THE OLD HREAD ROUTINE +#else + TAD M5 + DCA T1 + DCA T2 +#endif +HREAD2, ION /(SWAP) - FOR 2-USER + TAD HINBUF /WAIT FOR INPUT +#ifdef NEWWAY + SMA + JMP .+3 + CLA +#else + SMA CLA + JMP HSGO+1 + ISZ T2 +#endif + JMP HREAD2 +#ifdef NEWWAY + SZA /SWAPS BACK TO ADDS INPUT ON TRAILER CODE + JMP HSGO / LEGIT CHAR +#else + ISZ T1 + JMP HREAD2 +#endif + TAD PTCH /ALL DONE READING TAPE + DCA 113 /SWAP TO KEYBOARD INPUT + TAD P337 /RETURN A B.A. TO KILL UNENDED LINE OR GARBAGE + /CHARACTER +#ifdef NEWWAY +HSGO, DCA CHAR /FOUND CHAR +#else +HSGO, JMP RESTR-2 +#endif + CMA + DCA HINBUF /SET TO READ NEXT +#ifdef NEWWAY + TAD CHAR +#else + RRB RFC +#endif + AND P177 /IGNORE PARITY AND BLANK + SNA + JMP HREAD+1 + TAD C200 + DCA CHAR + JMP I HREAD +///// +RESTR, HREAD-CHIN + +PAGE +/FLOATING POINT PACKAGE +/ARITHMETIC INTERPRETER +FPNT, 0 + CLA CLL + TAD I FPNT /FLOATING INSTRUCTION + SNA + JMP I FPNT /FEXT + AND C200 /GET PAGE BIT + SZA CLA + TAD FPNT /CURRENT PAGE + AND P7600 + DCA FLADDR /START ADDRESS OF ADDRESSED PAGE + TAD I FPNT /GET ADDRESS BITS + AND P177 + TAD FLADDR + DCA FLADDR /FULL 12-BIT ADDRESS + TAD I FPNT + ISZ FPNT + CLL RTL /OP BITS =>AC9-11 + RTL /INDIRECT BIT =>LINK + AND P17 + TAD DRECTR /SET UP OP POINTER + DCA DIRECT + TAD I FLADDR /INDIRECT? + SZL + DCA FLADDR /YES + PUSHF /NO, GET OPERAND +FLADDR, 0 + POPF + FLOP + DCA FLOP3 /CLEAR LOW ORDER OPERAND +DIRECT, JMP I .+2 /OP DIRECT INSTRUCTION +DRECTR, JMP I .+1 /OP TABLE + FLPOW + FLADD + FLSUB + FLMUL + FLDIV + FLGET + FLPUT + FLNOR + +FLGET, PUSHF /OP 5: GET FLAC FROM STORAGE + FLOP + TAD .+3 /SET UP POINTER TO FLAC + JMP .+4 +FLPUT, PUSHF /OP 6: PUT FLAC IN STORAGE + FLAC + TAD FLADDR /SET UP POINTER TO STORAGE + DCA .+2 + POPF + 0 /ADDRESS OF STORAGE LOCATION + JMP FPNT+1 +NEGOP, 0 /ROUTINE TO NEGATE FLOP + TAD FLOP2 + CLL CIA + DCA FLOP2 + CML RAL + TAD FLOP1 + CIA + DCA FLOP1 + TAD FNEGSW /FNEGSW IS COMPLEMENTED WHEN + CLL CMA /FLOP OR FLAC IS NEGATED + DCA FNEGSW + JMP I NEGOP +NEGAC, 0 /ROUTINE TO NEGATE FLAC - "NEGATE" + CLA CLL /TRIPLE PRECISION + TAD FLAC3 + CIA + DCA FLAC3 + CML RAL + TAD FLAC2 + CIA + DCA FLAC2 + CML RAL + TAD FLAC1 + CIA + DCA FLAC1 + TAD FNEGSW + CLL CMA + DCA FNEGSW + JMP I NEGAC + /ARITHMETIC OPERATIONS +/BOTH FLAC AND FLOP MUST BE NORMALIZED FOR +/+-*/^ (FAD,FSU,FMY,FDV,FXP) +FLSUB, JMS NEGOP /OP 2: SUBTRACT OP (NEGATE AND ADD) +FLADD, TAD FLAC1 /OP 1: ADD OP + SNA CLA + JMP FLGET /RESULT=OPERAND IF FLAC=0 + TAD FLOP1 + SNA CLA + JMP FPNT+1 /RESULT=FLAC IF FLOP=0 + TAD FLOP0 /COMPARE EXPONENTS + CIA + TAD FLAC0 + SNA + JMP CMBINE /EQUAL, GO ADD TOGETHER + SMA /NOT EQUAL, NEED SHIFTING + JMP SHFLOP /FLAC>FLOP, SHIFT FLOP + TAD P27 /FLAC#7xhD=01E|FR8*8s4|=VBfsB#|=t<9#aUP=|w|D9PXJuuW zL39B{-Rqov_Bn^Y{q0}){U`YkZLiObx*>#^8oA=}{dtX!!qQf6de&%f(iB>AXr3+^ z=#B0-Z=&nPx9>mRuWv%1j1c2TxAd;g^&TM&dHJvL>)gDWXLBRXvC7D7u^cYlr8~^p zlU~-=+HO0U^z4c0b-igbJs)=lA77>equrbKykRrlbksdx`=*CCUpT_q@wsh|q#hfkG3~alkVpLPn5nUG0%iEVH zp^car>>8nU`aMx6yT%brRGRb%xpyl3^EM%3#AnV%u%ne$@f9m{w%NVI7FBDTv2C3= z8)wVPI!R+OtXgcV-i%wi8*SM3orrOI%z1hw#M!FdrH;VZJS%8Z2(7P$QW#Xc{qz`i zD>5tA*4mmwYGGoTP8rI~G~B$(pE!>YhG>z2XlWa^X{g+bzIy}z<+5dgzmUn`a|@!YX=YAsg3|Mh9Hsvn}KcFrQ~wj&tH54vE?mpv9h5~vyKHI;KQ zvVe^4LGOrp%tQ~m@5>sp_l1RC{FkCuET zQvD3$oI##FF@N~Nz*^l8*4uK-0&-_7XclOc;1M|$6S-yfN7q0N?AnI3r+BW|5=^kS z8QTMshbED?o+_>02~M$Rp^T>{uydg8`-YnDp(?Y`Ik44gZ%&u&`%i}!t2X8oY*`M? z(SEc)=!(r@Q|GszPemui`SDiP{=_roi=>H}!V(f^@jY)-5^hc$fj#Ai+&uAuZ+OD@ z&J0M9onB{1wBgqc-~^5>X0n&MX#jmQl-D{p8dyaOY!6Jb!r9X$TR=;YAkH#j3tBZa zO~vG63kxS^F=~htKQs;HYU9?GrrFHqHTqFzn~q!eYqw@L7y=j%yM$a|3ul?qYA#9L`m3$9AmUb7)nVP#iYyo{wSehR&}_mBPL+4f;kL~+T-o51cXa$0^*YMIrBUfDuQ{c)Ebj_HQ()|GDRX6}9F&6D|hcA4Ar z$!sut%%}6&d_Q|F^tpo_89=2^8)vzEVfF+3cu%puOw?Nz!?VGrm5(1qV0Y4s;1O57 z2p&;_`Cg7XLG;<(w%S;{PR5sp03nf+z*qS4&LUVlqKoW8$adFI+A$jz;KV<4?*wee zB>X$id)r;*rvtWw#mA}+K1QZ}>ZWr-hQstqN92zF0i6J`OBR^#d}j^pQRUl1I#N+X zdT9Lj#xUUvrp6F{!q6Xv4G+xc_E;3cj#I|G#MoPxJY=^!++F74v=Z|-Ub!TT;etC>uaJ~;?X3d8;^R$Bz zjBQ{G!12U_-CGlQ*4+Bz2Y9cSODgJWg(DHZkU8yn9kauAoK^5r;mho}WwDWA5x7PF z4BHKh&@I+yey%j)@S}S^g-5L-1(RvP?H{h)TbvXcfUPZw`l}x=Ux~cBFSq0`r4jeS zFNot3JLQ+y9i{{$`X}gs@&flUzZ8*MWG{YMpEx3;&q}B4Wn1pdH9SPD58qrn+t@4g zG^RagJ1*$V0b=>l2LFxR^nkUnJ6xxD$&QX$`9<^~%CArtzQr2BdEh+E+0qlota@B&HG z+r7Xr(9Li?>W?aIJ?@X`YCY*saGz#Iv4O=d=F0^T3hj8<|2&(`i(p1)H4SEgkp<-u z{vclOI(MbVCc+1#${**d}_a zyaLRe4qnNdBMECm!q4!LUqV?YcU%1Amp^@6mvQI}49(j6{w2TOo8F(?Covo6UFgNQ za8E|5m%JR8ZW)xaJe7}Id3!ua5iPCBTOL&AQfMFaa7165>^^q?{BDXx^uIV$XnSSl zy9M?W#s}{rd*ebewiv^GCcJ1!<(s8fZUeTkw{~D}wkCrW$PIX(NXtC_6zp`T&WVcr zge*p++T;=@=G85fKe)iiOk^(^c@g=nG_RBm>;f~=t9gU$JMqEx)8VN&&fHdm^jYZscNAN;|2Bvkh5`4+a> z-HMU3P`Mf;GV>)Jp zaUkNnGTP0f`~gb0VyLWN^#(7`QSyL0p6>`uNog&8Lq9ha89sap7&{pap`BshfkqLp ztR2N&ERzPxi20GR_M3b2Al>Gwa>X3-eTB#I5f)E<+fR3q$5%Fwmh2?2cWSq&sHiPy zgnL9|++*4rhEmpks;QZ=BC-xAtLc*SnH{Q;OFj(KmYN6oaE_BFDGnx6PvmHEQP2->oJ+Nw5otM5#G%jb4O({kw#ThgEUqwFKcBwNE%LE4zb&wem3 z#$*2Mj&Ze(=r^OScOqw)NrOga!A~YILr2L`cED-a^(dE$FLT+qxa>ok(Bh~Z|71T$ zfsBbxnpdsjYWt_K%zP7cy58nEx=#x44 z{swOmWLMw#E71BRePjR`-1FN9O-x+}Q_Z=fp5xDV1bCjcyXrf&?K-dp0$cFyZH8Ud zo!js>sG9rz8eh}f39UZg!|D)KVuk`eiBx%b04W63lx`r!4Q<_hyOo_jc8CZUb~uGD zH?YGgG`oRjzdhaotR6Cp=>~U=LSHn5-g3n0k$D03W3zNu@ol_HgEWVIt2*sdcSYSk zzQxzLitkcuc4YCmKX$nZJB{(TKX-vWU@sJ2kRrdPG1hUv5vO~g;@)bggr>#^*&nvT zgdfxn?9h%ga@DRl0gdl1I}St!%fK00z#~}17TG_{oUOk3DL5>0&J^E1qBU(fd3NAu z_YoXuu=SoA4T1HLKkS(QV3y6+`!W=Nd>IP0A|RtYOjL~I5=5L2vvLo2!d3i2>S2m9 zJM)M8P&~$eQ2WClxIe~+G*G>AuPK!*#hji#D}N-4C^58!9f4);a$XN*-#H<>Lf4T4uJ+iX{zM>m;8s8;*!1AJGlxGok6=VC%eK)__ zH#9)6fNpW$4*l$&-9M-Zo5T)jh+OAh+c^t%<9j-Rl}9;)CW+cD-r9B;?4l%htDoF# z>TqQHL<_rVq&WK-Db6;9lf_%a>8Ci1w{iI8@+U@PesI-+45OM3MVK6j)kQu7D?2cwPYIS`#x+L2z$YqeJP`S| zdkVAZ7EFSiKD1SQ{r%m>|H9|mf9nu@8(!@Af01-0_5FS~*qQ%bU$Va(jFzDA=lIG9 zCUX(pQHF0Bh-0tj+g`|H8()bpr$4+FtN$@WNP6&q%|QwW(!dOD3SHEne**Q+#1UtIFb3-~0*M|F+zKnP%}+t$B6u)6w3FMSI_Sn=IlK4W@nqN!@g{*J-(~p{`*V*rz#%qO` z7d41J!ld%^(QgE(=SwKu{oeI?mg2McuhZr@JJwg{sPKgbXaAhQ(|P0BW*fVvc$&ES z9`=tlOxabZ<%o+uCxFC>rsUGxML1YB^?1E)HLp18-kbMq z+n=UE)G{|iOYJS4!79K*h;eswmCq_PuMr=-VPP`bU18-)PnF-_L2z9+x*~2vguX*N zMqGDpAIZaxPjM}9xwuxid|cc0u8-c>HS7ZY)4;r@>-4(wj%K;unKxVy^fT9=UQIc< d=Bwtuzn%xpYw9GZO=qoPsr_5c0*n3M{{w2nK9>Lh literal 0 HcmV?d00001