1 /FOCL12.37 2 /COPYRIGHT 1970, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 3 PMODE /******** 4 FIXMRI FPOW=5000/PSEUDO-FLOATING POINT INSTRUCTIONS. 5 FIXMRI FADD=1000 6 FIXMRI FSUB=2000 7 FIXMRI FMUL=4000 8 FIXMRI FDIV=3000 9 FIXMRI FGET=0000 10 FIXMRI FPUT=6000 11 FNOR=7000 12 FEXT=0 13 FXIT=0 14 FINT=JMS I 7 15 SMP=6101 16 /MISCELLANEOUS ITEMS 17 *1 18 000001 5403 JMP I .+2 /INTERRUPT PROCESSOR ENTRY 19 000002 0000 LWETMP, 0 /******** 20 000003 2603 INTRPT 21 000004 0004 DDTJR, DDTJR /USED FOR DEBUGGING 22 000005 0013 P13, 13 /CONSTANT 23 000006 0100 C100, 100 /CONSTANT 24 T=00 /TEXT FIELD NO. 25 P=00 /DATA FIELD NO. 26 CDF=7000 /(X-MEM) - OPR 27 000007 6400 FPNT /ADDRESS OF FLOATING POINT INTERPRETER. (LOC *7) 28 /AUTO-INDEX REGISTERS - (START OF SAVE BY QUAD) 29 000010 0000 AXIN, 0 /STORAGE INDEX (LOC *10) 30 000011 0000 XRT, 0 /EXTRA XR 31 000012 0000 XRT2, 0 /EXTRA XR 32 000013 4400 PDLXR, BEGIN-1 /PUSHDOWN LIST INDEX REGISTER. 33 000014 3117 FLTXR, IOBUF-1 /XR FOR FLOATING POINT 34 000015 0000 FLTXR2, 0 /EXTRA FOR F.P. 35 000016 7402 TELSW, HLT /TELETYPE IN PROGRESS LOSS 36 TEXTP=. /TEXT POINTER (LOC *17) 37 000017 3214 AXOUT, FRSTX /OUTPUT INDEX 38 000020 0000 XCT, 0 /UNPACK SWITCH 39 000021 0000 GTEM, 0 /UNPACK STORAGE 40 000022 2407 PC, FLTZER /PROGRAM COUNTER 41 000023 0000 THISLN, 0 /LINE POINTER FROM FINDLN 42 000024 0000 THISOP, 0 /CURRENT 'EVAL' OPERATION 43 000025 0000 LASTLN, 0 /BACK POINTER FROM 'FINDLN' 44 000026 0001 DEBGSW, 1 /DEBUG SWITCH: NON-ZERO FOR LITERAL. 45 000027 0000 PACKST, 0 /RUBOUT PROTECTION 46 000030 0000 PT1, 0 /VARIABLE POINTER 47 000031 3216 LASTV, BUFBEG /ADDRESS OF LAST VARIABLE 48 000032 0000 T1, 0 /TEMPORARY REGISTER - MAIN 49 000033 0000 T3, 0 /TEMP REGISTER FOR OUTPUT 50 000034 0000 INBUF, 0 /KEYBOARD INPUT BUFFER 51 000035 4617 BOTTOM, FEXP-1 /******** LAST LOCATION CURRENTLY AVAILABLE 52 000036 0000 INSUB, 0 /0 = GETC; #0 = READC 53 000037 0000 HINBUF, 0 /HIGH SPEED INPUT BUFFER 54 /PAGE ZERO OF THE 55 /FLOATING POINT ARITHMETIC INTERPRETER FOR FOCAL 56 *40 57 000040 0000 EX1, 0 /OPERAND STORAGE 58 000041 0000 AC1H, 0 59 000042 0000 AC1L, 0 60 000043 0000 OVER1, 0 61 FLAC=. /FLOATING ACCUMULATOR 62 000044 0000 EXP, 0 /F.A. 63 000045 0000 HORD, 0 64 000046 0000 LORD, 0 65 000047 0000 OVER2, 0 66 000050 0000 SIGNF, 0 /FLOATING SIGN 67 000051 6605 MINSKI, ACMINS /NEGATE FLAC SUBROUTINE 68 000052 2004 FISW, 2004 /OUTPUT FORMAT 69 000053 6724 INTEGER,FIX /FIX FLAC 70 GETSGN=TAD FLAC+1 71 RETURN=JMP I EFUN3I 72 *54 73 /VARIABLES - INITIALIZED FOR THE DIALOGUE 74 000054 0000 SORTCN, 0 /NUMBER IN TABLE FROM SORTC 75 000055 0000 LASTOP, 0 /LAST OPERATION FOR EVAL 76 EFOP=. /FUNCTION CODE 77 000056 0000 ATSW, 0 /ASK-TYPE SWITCH 78 000057 7760 CNTR, -20 /DELETE AND ERROR COUNTER (USED BY F.P. ALSO) 79 STARTV=. /=END FOR 8K 80 000060 3216 BUFR, BUFBEG /NEXT LOCATION IN BUFFER = LAST LOCATION OF TEXT. 81 000061 0000 QADD, 0 /******** 82 000062 2414 XCTIN, I33 /PACK SWITCH 83 000063 2676 OUTDEV, XOUTL /POINTER TO OUT. SUB. (OUTL)-FOR DEBUGGING 84 000064 2666 INDEV, XI33 /POINTER TO IN. SUB. (I33)-FOR DEBUGGING 85 000065 0001 NAGSW, 0001 /NOT ALL AND/OR GROUP LOSS(4000=ONE;1=ALL;0=GROUP);(0000)-FOR TSS-8 86 000066 0215 CHAR, 215 /THE MOST IMPORTANT REGISTER 87 000067 0000 LINENO, 0000 /LINE NUMBER READ BY GETLN;(0400)-FOR TSS-8 88 000070 0005 GINC, WORDS+2 /=6 FOR 4-WORD - CONSTANT 89 000071 0000 T2, 0 /TEMP REGISTER - FOR NEW INST. ROUTINES 90 /FOR DEBUGGING, SET OUTL AND I33 TO OUTDEV AND INDEV; 91 /ALSO PATCH THE ERROR ROUTINE - FOUR 92 /PATCHES PLUS TWO FOR THE HIGH SPEED READER. 93 LIST6=. /INPUT LIST FOR "SFOUND". 94 000072 0214 214 /F.F. 95 000073 0207 207 /BELL 96 LIST7=. 97 000074 0203 203 /CONTROL-C FOR DEBUGGING AND TSS-8 98 000075 0337 P337, 337 /LEFT ARR 99 000076 0212 CLF, 212 /L.F. 100 LIST3=. /EXCRETION LIST 101 000077 0215 CCR, 215 /LIST BRANCHER. 102 000100 7402 DMPSW, HLT /(SEARCH CHARACTER) - VARIABLE 103 /=0000 FOR TRACE ON 104 /THE REST OF PAGE ZERO IS PURE TO THE MULTI-USER SYSTEM 105 M100=. 106 000101 7700 P7700, 7700 /LEFT MASK 107 000102 0256 PER, 256 /PERIOD 108 000103 7701 M77, -77 /EXTEND CODE TEST 109 000104 7600 P7600, 7600 /GROUP MASK 110 000105 7760 M20, -20 /CONSTANT 111 000106 0177 P177, 177 /STEP MASK 112 000107 0017 P17, 17 /BCD MASK 113 000110 0277 P277, 277 /"?" 114 000111 7776 M2, -2 /CONSTANT 115 000112 7477 MINUSA, -301 /CONSTANT 116 000113 0260 C260, 260 /ASCII FOR ZERO 117 000114 7540 M240, -240 /SPACE TEST 118 000115 7522 MPER, -256 /PERIOD TEST 119 000116 7563 MCR, -215 /C.R. TEST 120 000117 7775 MFLT, -WORDS /= -4 FOR 4-WORD 121 000120 7773 M5, -5 /PAREN TEST 122 000121 7767 M11, -11 /PAREN TEST 123 000122 0077 P77, 77 /RIGHT MASK 124 000123 0200 C200, 200 /CONSTANT 125 000124 4000 P4000, 4000 /NAGSW TEST CONSTANT (FOR PDP-5) 126 000125 2032 FLARGP, FLARG /DATA ADDRESS 127 000126 2157 PTCH, CHIN /GENERAL CHARACTER INPUT ROUTINE. 128 000127 5715 DOUBLE, MULT2 /MULTIPLY FLAC BY 2 129 000130 6000 FOUTPUT,FLOUTP /FLOATING OUTPUT 130 000131 6200 FINPUT, FLINTP /FLOATING INPUT 131 000132 3140 COMBUF, COMEIN /COMMAND BUFFER START 132 000133 3206 CFRS, FRST /ADDRESS OF DUMMY LINE 133 000134 3140 END, COMEIN /FIRST LOCATION USED IN 8K. 134 000135 3216 ENDT, BUFBEG /START OF STORAGE AREA ** 135 000136 2021 EFUN3I, EFUN3 /FUNCTION RETURN 136 000137 2407 CFRSX, FLTZER /POINTER TO ZERO DATA 137 138 139 /'FINPUT' USES CHAR AND GETC OR READC TO DEVELOP 140 /A NUMBER WHICH IS THEN STORED VIA PT1. 141 WORDS=3 /OR 4 142 /NEW INSTRUCTIONS: 143 PUSHJ=JMS I . /RECURSIVE SUBROUTINE CALL 144 000140 0521 XPUSHJ 145 POPA=TAD I PDLXR /RESTORE AC 146 POPJ=JMP I . /SUBROUTINE ERETURN 147 000141 1565 XPOPJ 148 PUSHA=JMS I . /SAVE AC 149 000142 0477 XPUSHA 150 PUSHF=JMS I . /SAVE GROUP OF DATA 151 000143 0534 PD2 152 POPF=JMS I . /SAVE GROUP 153 000144 0554 PD3 154 GETC=JMS I . /UNPACK A CHARACTER 155 000145 2274 UTRA 156 PACKC=JMS I . /PACK A CHARACTER 157 000146 2502 PACBUF 158 SORTJ=JMS I . /SORT AND BRANCH ON AC OR CHAR 159 000147 1312 SORTB 160 SORTC=JMS I . /SORT CHAR 161 000150 0721 XSORTC 162 PRINTC=JMS I . /PRINT AC OR CHAR 163 000151 2465 OUT 164 READC=JMS I . /READ DATA INTO CHAR AND PRINT IT 165 000152 2157 RDIV, CHIN 166 PRNTLN=JMS I . /PRINT C(LINENO) 167 000153 2425 XPRNT 168 GETLN=JMS I . /UNPACK AND FORM A LINE NUMBER 169 000154 0302 XGETLN 170 FINDLN=JMS I . /SEARCH FOR A GIVEN LINE 171 000155 2244 XFIND 172 ENDLN=JMS I . /INSERT LINE POINTERS 173 000156 2360 XENDLN 174 RTL6=JMS I . /ROTATE LEFT SIX 175 000157 0413 XRTL6 176 SPNOR=JMS I . /IGNORE SPACES AND LEADING ZEROS 177 000160 1535 XSPNOR 178 TESTN=JMS I . /PERIOD; OTHER; NUMBER 179 000161 1546 XTESTN 180 TSTLPR=JMS I . /SKIP IF 5 0 206 000202 3022 DCA PC /FOR COMMAND MODE 207 000203 7001 IAC /USE ONE IN THE AC TO 208 000204 3100 DCA PSUBS /INIT UNPACK AND TRACE SWITCH. 209 000205 3026 DCA DEBGSW /ENABLE TRACE FOR INPUT OF (?), 210 000206 1226 TAD COMBOT /PROTECT COMMAND BUFFER. 211 000207 3013 DCA PDLXR /NO PATCH TEST. 212 000210 1225 TAD CSTAR /ANNOUNCE PRESENCE 213 000211 4551 PRINTC /BY TYPING THE LEAD-IN CHARACTER 214 000212 1132 IBAR, TAD COMBUF /INITIALIZE COMMAND BUFFER 215 000213 3010 DCA AXIN /FOR UNPACKING. 216 000214 3062 DCA XCTIN 217 000215 1132 TAD COMBUF /RUBOUT PROTECTION 218 000216 3027 DCA PACKST 219 000217 4552 IGNOR, READC /READ COMMAND STRING 220 000220 4547 SORTJ 221 000221 0073 LIST7-1 222 000222 0474 INLIST-LIST7 223 000223 4546 PACKC /SAVE STRING CHARACTER. 224 000224 5217 JMP IGNOR 225 000225 0252 CSTAR, 252 /ACKNOWLEDGE CHARACTER 226 000226 3220 COMBOT, COMEOUT+12 /END OF COMMAND BUFFER, LESS PROTECTION COUNT. 227 /COMMAND/INPUT PROCESSOR 228 000227 4546 IRETN, PACKC /START TO PACK C.R. 229 000230 4546 PACKC /FINISH C.R. 230 000231 1132 TAD COMBUF /INITIALIZE "TEXTP" 231 000232 3017 GONE, DCA AXOUT /SETUP CURRENT LINE 232 000233 3020 DCA XCT 233 000234 4545 GETC /READ FIRST CHARACTER. 234 000235 1035 TAD BOTTOM /INIT PUSH-DOWN LIST 235 000236 3013 DCA PDLXR 236 000237 4560 SPNOR /IGNORE LEADING BLANKS 237 000240 4561 TESTN /DOES THE LINE BEGIN WITH 1-9? 238 000241 5362 JMP GZERR /PERIOD = ILLEGAL GROUP ZERO USAGE 239 000242 5271 JMP INPUTX /NO 240 000243 2026 ISZ DEBGSW /YES, DISABLE TRACE FOR REPACKING 241 000244 4554 GETLN /READ THIS LINE NUMBER 242 000245 1124 TAD P4000 /TEST FOR SINGLE LINE. 243 000246 1065 TAD NAGSW 244 000247 7640 SZA CLA 245 000250 4566 ERROR3 /ILLEGAL LINE NUMBER ON INPUT 246 000251 1060 TAD STARTV /SET POINTERS 247 000252 3010 DCA AXIN 248 000253 3062 DCA XCTIN 249 000254 1067 TAD LINENO /SAVE LINE # 250 000255 3410 DCA I AXIN /(X-MEM) 251 000256 4560 SPNOR /IGNORE SPACES AFTER LINE NUMBER 252 000257 7410 SKP 253 000260 4545 GETC /READ 1ST AFTER LINENO TERMINATOR. 254 000261 4546 SRETN, PACKC /SAVE TEXT AND RESTORE DATA FIELD 255 000262 1066 TAD CHAR /TEST FOR END OF INPUT STRING 256 000263 1116 TAD MCR 257 000264 7640 SZA CLA 258 000265 5260 JMP .-5 259 000266 4565 DELETE /REMOVE OLD LINE, IF ANY. 260 000267 4556 ENDLN /INSERT NEW LINE 261 000270 5177 JMP START /POINTERS MUST BE REINITIALIZED 262 000271 4540 INPUTX, PUSHJ /PROCESS IMMEDIATE COMMAND. 263 000272 0611 PROC 264 000273 1422 TAD I PC /CHECK NEXT LINE (X-MEM) 265 000274 7450 SNA /END OF PROGRAM? 266 000275 5177 JMP START /YES 267 000276 3022 DCA PC /SAVE NEW LINE NO. 268 000277 1022 TAD PC /START NEW LINE 269 000300 7001 IAC 270 000301 5232 JMP GONE /PROCESS OTHER COMMANDS 271 /TEXT LINE BUFFER FORMAT* 272 /#1 : POINTER (OR ZERO IN LAST) 273 /#2 : LINENO 274 /#3 - #N-1 : TEXT 275 /#N : C.R. 276 /LINE NUMBER FORMATION 277 000302 0000 XGETLN, 0 /DEVELOP I.D. - "GETLN" 278 000303 4560 SPNOR /IGNORE LEADING SPACES 279 000304 1066 TAD CHAR /"ALL" IS A SPECIAL ARGUMENT. 280 000305 1112 TAD MINUSA 281 000306 7650 SNA CLA 282 000307 5322 JMP TESTA 283 000310 3036 DCA INSUB /CALL 'GETC' FROM INPUT VIA 'DECON' 284 000311 4771 JMS I LCON /(DECONV - IN FLOAT.) 285 000312 1047 TAD FLAC+3 /GROUP TOO LARGE? 286 000313 0372 AND P7740 287 000314 1046 TAD FLAC+2 288 000315 7640 SZA CLA 289 000316 4566 ERROR2 /GROUP NUMBER TOO LARGE 290 000317 1047 TAD FLAC+3 291 000320 4557 RTL6 292 000321 7004 RAL 293 000322 3067 TESTA, DCA LINENO 294 000323 4561 TESTN /TEST3 295 000324 4545 GETC /READ STEP NUMBER. 296 000325 4561 TESTN /TEST4, OTHER 297 000326 5340 JMP GERR /DOUBLE PERIODS 298 000327 5352 JMP GEXIT /OTHER 299 000330 1054 TAD SORTCN /NUMBER 300 000331 7106 CLL RTL 301 000332 1054 TAD SORTCN 302 000333 7004 RAL 303 000334 1067 TAD LINENO 304 000335 3067 DCA LINENO 305 000336 4545 GETC /READ SECOND STEP NUMBER. 306 000337 4561 TESTN /TEST4, OTHER 307 000340 4566 GERR, ERROR4 /DOUBLE PERIODS 308 000341 5352 JMP GEXIT /OTHER 309 000342 1054 TAD SORTCN /NUMBER 310 000343 1067 TAD LINENO 311 000344 3067 DCA LINENO 312 000345 4545 GETC /TEST FOR CORRECT TERMINATOR 313 000346 4561 TESTN /CHECK SIZE 314 000347 5340 JMP GERR /. 315 000350 7410 SKP 316 000351 4566 ERROR2 /TOO LARGE FOR A LINE NUMBER. 317 000352 7100 GEXIT, CLL /CLEAR LINK BIT 318 000353 1067 TAD LINENO /TEST FOR GROUP NUMBER 319 000354 0104 AND P7600 320 000355 7640 SZA CLA 321 000356 7020 CML 322 000357 1067 TAD LINENO 323 000360 0106 AND P177 /PREPARE "NAGSW" 324 000361 7460 SZA SNL 325 000362 4566 GZERR, ERROR2 /0.X = ERROR: ILLEGAL LINE NUMBER 326 000363 7640 SZA CLA 327 000364 1373 TAD P2000 328 000365 7020 CML 329 000366 7004 RAL 330 000367 3065 DCA NAGSW 331 000370 5702 JMP I XGETLN 332 000371 5600 LCON, DECONV 333 000372 7740 P7740, 7740 334 000373 2000 P2000, 2000 335 /RANGE OF ACCEPTABLE LINE NUMBERS = 1.01 TO 31.99 336 /NAGSW: 337 /GROUP=0000 338 /LINE=4000 339 /ALL=0001 340 /LIST OF FUNCTION ADDRESSES. (NAMES ARE IN "FNTABL") 341 FNTABF=. 342 000374 2016 XABS /ABS -ABSOLUTE VALUE 343 000375 2012 XSGN /SGN -SIGN PART 344 000376 1156 XINT /INT -INTEGER PART 345 000377 7602 XDISP /DIS /******** 346 000400 1145 XRAN /RAN -RANDOM NUMBER 347 000401 1341 XADC /ADC -READ ANALOG TO DIGITAL CONVERTER 348 000402 5000 ARTN /ATN -ARCTANGENT 349 000403 4620 FEXP /EXP -EXPONENTIAL 350 000404 5040 FLOG /LOG -LOGARITHM 351 000405 5204 FSIN /SIN -TRIG FUNCTIONS 352 000406 5177 FCOS /COS - 353 000407 7400 XSQRT /SQT -SQUARE ROOT 354 000410 2725 PFNEW, ERROR5 /NEW -USER DEFINED FUNCTIONS 355 000411 2725 PFX, ERROR5 /FX /******** 356 000412 2725 PFZ, ERROR5 /FZ /******** 357 000413 0000 XRTL6, 0 /ROTATE AC LEFT SIX - "RTL6" 358 000414 7106 CLL RTL 359 000415 7006 RTL 360 000416 7006 RTL 361 000417 5613 JMP I XRTL6 362 /RECURSIVE OPERATE, EXECUTE, OR CALL 363 000420 4554 DO, GETLN /EXECUTE ONE LINE, A GROUP, OR ALL 364 000421 1022 TAD PC /SAVE ADDRESS 365 000422 4542 PUSHA /OF CURRENT LINE 366 000423 4543 PUSHF /SAVE REST OF THIS LINE 367 000424 0017 TEXTP /ADDRESS OF TEXT POINTERS 368 000425 4543 DGRP, PUSHF /SAVE NAGSW; CHAR; AND LINENO. 369 000426 0065 NAGSW 370 000427 1065 TAD NAGSW /CHECK DATA FROM GETLN. 371 000430 7710 SPA CLA /SKIP IF GROUP OR ALL 372 000431 5263 JMP DOONE /DO ONE LINE 373 000432 4555 FINDLN /INIT FOR GROUP AND SET THISLN 374 000433 7000 NOP 375 000434 1023 TAD THISLN /TEST FOR GOOD GROUP NUMBER. 376 000435 3011 DCA XRT 377 000436 1411 TAD I XRT /(X-MEM) 378 000437 4563 TSTGRP 379 000440 4566 ERROR2 /NO SUCH GROUP NUMBER 380 000441 4540 DGRP1, PUSHJ /EXECUTE OBJECT LINE AND SET PC. 381 000442 0606 PROCESS-2 382 000443 4544 POPF /RESTORE THE DATA 383 000444 0065 NAGSW 384 000445 1422 TAD I PC /CHECK FOR END OF TEXT (X-MEM) 385 000446 7450 SNA 386 000447 5271 JMP DCONT /ALL DONE 387 000450 7001 IAC 388 000451 3030 DCA PT1 /SAVE POINTER TO LINENO 389 000452 1065 TAD NAGSW /CHECK FOR GROUP 390 000453 7740 SMA SZA CLA 391 000454 5260 JMP .+4 /DO ALL 392 000455 1430 TAD I PT1 /TEST GROUP (X-MEM) 393 000456 4563 TSTGRP 394 000457 5271 JMP DCONT /NOT IN GROUP 395 000460 1430 TAD I PT1 /READ NEXT LINE NO. (X-MEM) 396 000461 3067 DCA LINENO 397 000462 5225 JMP DGRP /CONTINUE THE SUBROUTINE 398 000463 4555 DOONE, FINDLN /FIND THE LINE 399 000464 4566 ERROR2 /NO SUCH LINE NUMBER 400 000465 4540 PUSHJ /EXECUTE IT 401 000466 0610 PROCESS 402 000467 4544 POPF /RESTORE CHAR 403 000470 0065 NAGSW 404 000471 4544 DCONT, POPF /RESTORE TEXT POINTERS 405 000472 0017 TEXTP 406 000473 1413 POPA /RESTORE ADDRESS OF CURRENT LINE. 407 000474 3022 DCA PC 408 000475 5676 JMP I .+1 /CONTINUE PROCESSING THIS LINE. 409 000476 0611 PROC 410 /PUSHDOWN LIST CONTROLS 411 000477 0000 XPUSHA, 0 /PUSHDOWN THE AC - "PUSHA" 412 000500 3071 DCA T2 /BACKUP POINTER 413 000501 7040 CMA /AND THEN 414 000502 4310 JMS PCHK /CHECK CORE USAGE 415 000503 1071 TAD T2 /OK 416 000504 3413 DCA I PDLXR /PUSH DOWN LIST POINTER 417 000505 7040 CMA /BACKUP AGAIN 418 000506 4310 JMS PCHK 419 000507 5677 JMP I XPUSHA 420 000510 0000 PCHK, 0 421 000511 1013 TAD PDLXR /INC IN AC 422 000512 3013 DCA PDLXR 423 000513 1013 TAD PDLXR 424 000514 7141 CLL CIA 425 000515 1031 TAD LASTV 426 000516 7630 SZL CLA 427 000517 4566 ERROR3 /STORAGE FILLED BY PUSH-DOWN LIST 428 000520 5710 JMP I PCHK 429 000521 0000 XPUSHJ, 0 /RECURSIVE SUBROUTINE CALL - "PUSHJ" 430 000522 1721 TAD I XPUSHJ 431 000523 3071 DCA T2 /SAVE SUBROUTINE ADDR. 432 000524 7040 CMA 433 000525 4310 JMS PCHK 434 000526 1321 TAD XPUSHJ 435 000527 7001 IAC 436 000530 3413 DCA I PDLXR /SAVE RETURN 437 000531 7040 CMA 438 000532 4310 JMS PCHK 439 000533 5471 JMP I T2 /TRANSFER CONTROL 440 000534 0000 PD2, 0 /SAVE A FLOATING POINT NUMBER - "PUSHF" 441 000535 7240 CLA CMA /COMPUTE VARIABLE ADDR 442 000536 1734 TAD I PD2 443 000537 3011 DCA XRT 444 000540 2334 ISZ PD2 /FIX RETURN 445 000541 1117 TAD MFLT /COMPUTE PUSH POINTER 446 000542 4310 JMS PCHK 447 000543 1117 TAD MFLT 448 000544 3071 DCA T2 449 000545 1411 TAD I XRT 450 000546 3413 DCA I PDLXR 451 000547 2071 ISZ T2 452 000550 5345 JMP .-3 453 000551 1117 TAD MFLT /RESET POINTER 454 000552 4310 JMS PCHK 455 000553 5734 JMP I PD2 456 457 458 000554 0000 PD3, 0 / RESTORE A FLOATING POINT NUMBER - "POPF" 459 000555 7240 CLA CMA /GET VAR. ADDR. 460 000556 1754 TAD I PD3 461 000557 2354 ISZ PD3 462 000560 3011 DCA XRT 463 000561 1117 TAD MFLT 464 000562 3071 DCA T2 465 000563 1413 TAD I PDLXR /MOVE 466 000564 3411 DCA I XRT 467 000565 2071 ISZ T2 468 000566 5363 JMP .-3 469 000567 5754 JMP I PD3 /EXIT 470 INLIST=. /INPUT CONTROL CHARACTERS 471 000570 2740 RECOVR /C.C. - BREAK 472 000571 0212 IBAR /B.A. - RESTART 473 000572 0217 IGNOR /L.F. - IGNORE 474 000573 0227 IRETN /C.R. - TERMINATE STRING 475 000574 1075 FLIST2, FLIMIT /,=STANDARD 476 000575 1137 FINFIN /;=SHORT 477 000576 2725 ERROR5 /CR=DUMB 478 000577 1065 FLIST1, FINCR /,=STANDARD FORMAT 479 000600 0610 PROCESS /;=SET;PLUS ... 480 000601 0614 PC1 /C.R.=SET COMMAND 481 000602 7472 MF, -306 /USED BY TESTC 482 /PRINARY CONTROL AND TRANSFER 483 000603 4554 GOTO, GETLN /READ THE LINE NUMBER REQUESTED 484 000604 4555 FINDLN /LOCATE IT AND RESET TEXTP 485 000605 4566 ERROR2 /NOT THERE 486 000606 1023 TAD THISLN /SET PC 487 000607 3022 DCA PC 488 000610 4545 PROCES, GETC /TEST FOR END OF LINE 489 000611 1066 PROC, TAD CHAR /FIRST CHARACTER READY = USE PROC 490 000612 1116 TAD MCR 491 000613 7650 SNA CLA 492 000614 5541 PC1, POPJ /EXIT "PROCESS" 493 000615 4550 SORTC /IGNORE "SPACE", ",", AND ";". 494 000616 1374 GLIST-1 495 000617 5210 JMP PROCES 496 000620 1066 TAD CHAR /SAVE COMMAND CHARACTER 497 000621 0075 AND P337 /EXECUTE LOWER CASE ALSO 498 000622 4542 PUSHA 499 000623 4545 GETC /GO TO GERMINATOR 500 000624 4550 SORTC 501 000625 1374 GLIST-1 502 000626 7410 SKP 503 000627 5223 JMP .-4 504 000630 1413 POPA 505 000631 4547 SORTJ /GO DO COMMAND 506 000632 0773 COMLST-1 507 000633 0165 COMGO-COMLST 508 000634 4566 ERROR2 /ILLEGAL COMMAND 509 COMMENTS=PC1 /ALSO IS CONTINUE 510 511 512 /OUTPUT COMMAND TEXT 513 000635 4554 WRITE, GETLN /SET LINENO 514 000636 2026 ISZ DEBGSW /DISABLE TRACE 515 000637 4555 FINDLN /SEARCH FOR LINE NUMBER 516 000640 5267 JMP WTESTG /NOT THERE OR GROUP 517 000641 1067 TAD LINENO 518 000642 7640 SZA CLA 519 000643 4553 PRNTLN /PRINT LINE NUMBER AND A SPACE. 520 000644 4545 GETC 521 000645 4551 PRINTC /PRINT TEXT OF A LINE. 522 000646 1066 TAD CHAR 523 000647 1116 TAD MCR 524 000650 7640 SZA CLA /SKIP IF END OF LINE 525 000651 5244 JMP .-5 526 000652 1423 TAD I THISLN /TEST FOR END OF TEXT (X-MEM) 527 000653 7450 WTEST2, SNA 528 000654 5271 JMP WX-2 /EXIT; DO NEXT INDIRECT LINE. 529 000655 7001 IAC 530 000656 3030 DCA PT1 /SAVE POINTER TO LINENO IF NEXT 531 000657 1065 TAD NAGSW 532 000660 7700 SMA CLA 533 000661 1430 TAD I PT1 /(X-MEM) 534 000662 4563 TSTGRP /TRY NEXT LINENO FOR GROUP. 535 000663 5273 JMP WX 536 000664 1430 WALL, TAD I PT1 /SET LINENO (X-MEM) 537 000665 3067 DCA LINENO 538 000666 5237 JMP WRITE+2 539 000667 1023 WTESTG, TAD THISLN /INIT GROUP PRINTOUT 540 000670 5253 JMP WTEST2 541 000671 3026 DCA DEBGSW 542 000672 5541 POPJ 543 000673 1065 WX, FINCR 544 000674 7750 SNA SPA CLA /SKIP IF ALL 545 000675 5271 JMP WX-2 546 000676 4551 PRINTC /PRINT C.R. AGAIN 547 000677 5264 JMP WALL 548 000700 0000 XTESTC, 0 /TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC" 549 000701 4560 SPNOR /IGNORE SPACES 550 000702 4550 SORTC /TEST THE VARIABLE TERMINATORS 551 000703 1771 TERMS-1 552 000704 5700 JMP I XTESTC /YES - SORTC IS SET 553 000705 1066 TAD CHAR /NO 554 000706 2300 ISZ XTESTC 555 000707 1202 TAD MF 556 000710 7650 SNA CLA /TEST FOR "F" 557 000711 5317 JMP XT3 558 000712 4561 TESTN 559 000713 5700 JMP I XTESTC /, 560 000714 7410 SKP /OTHER 561 000715 5700 JMP I XTESTC /NUMBER 562 000716 2300 ISZ XTESTC 563 000717 2300 XT3, ISZ XTESTC /RETURNS:T;N;F;A 564 000720 5700 JMP I XTESTC 565 000721 0000 XSORTC, 0 /SORT CHAR AGAINST TABLE - "SORTC" 566 000722 1721 TAD I XSORTC 567 000723 3012 DCA XRT2 /1ST ARG IS LIST-1 568 000724 1412 TAD I XRT2 569 000725 7510 SPA /LIST IS ENDED BY A NEGATIVE NUMBER 570 000726 5340 JMP SEXC /2ND EXIT = NOT IN LIST 571 000727 7041 CIA 572 000730 1066 TAD CHAR 573 000731 7640 SZA CLA /COMPARE 574 000732 5324 JMP .-6 575 000733 1721 TAD I XSORTC /COMPUTE INCREMENT: 0-N 576 000734 7040 CMA 577 000735 1012 TAD XRT2 578 000736 3054 DCA SORTCN 579 000737 7410 SKP /!ST EXIT = YES 580 000740 2321 SEXC, ISZ XSORTC 581 000741 2321 ISZ XSORTC 582 000742 7300 CLA CLL 583 000743 5721 JMP I XSORTC 584 000744 0000 GRPTST, 0 /AC VS LINENO - "TSTGRP" 585 000745 0104 AND P7600 586 000746 7041 CIA 587 000747 3071 DCA T2 588 000750 1067 TAD LINENO 589 000751 0104 AND P7600 590 000752 1071 TAD T2 591 000753 7650 SNA CLA 592 000754 2344 ISZ GRPTST 593 000755 5744 JMP I GRPTST 594 /INPUT FROM TEXT OR KEYBOARD; 595 /IF BACK-ARROW, RESTART INPUT 596 000756 0000 INPUT, 0 /INPUT A CHARACTER 597 000757 1036 TAD INSUB /NON-ZERO FOR KEYBOARD 598 000760 7640 SZA CLA 599 000761 5364 JMP .+3 600 000762 4545 GETC 601 000763 5756 JMP I INPUT 602 000764 4552 JMS I RDIV 603 000765 4547 SORTJ 604 000766 6776 SPECIAL-1 605 000767 3402 INFIX-SPECIAL 606 000770 5756 JMP I INPUT 607 000771 1035 ILIST, IF1 /, 608 000772 0610 PROCESS /; 609 000773 0614 PC1 /CR 610 /ENGLISH-FRENCH 611 COMLST=. /COMMAND DECODING LIST 612 000774 0323 323 /SET - ORGANIZE 613 000775 0306 306 /FOR - QUAND 614 000776 0311 311 /IF - SI 615 000777 0304 304 /DO - FAIZ 616 001000 0307 307 /GOTO - VA 617 001001 0303 303 /COMMENT- COMMENTE 618 001002 0301 301 /ASK - DEMANDE 619 001003 0324 324 /TYPE - TAPE 620 001004 0317 317 /OUTPUT /******** 621 001005 0305 305 /ERASE - BIFFE 622 001006 0327 327 /WRITE - INSCRIS 623 001007 0315 315 /MODIFY - MODIFIE 624 001010 0321 321 /QUIT - ARRETE 625 001011 0322 322 /RETURN - RETOURNE 626 001012 0314 314 /LIBR /******** 627 /THIS COMMAND LIST IS SPEED OPTIMIZED. 628 629 630 /CONDITIONAL TRANSFER PROCESS. 631 001013 4564 IF, TESTC /IGNORE SPACES AND TEST 632 001014 4637 JMS I IECALL /T 633 001015 2013 ISZ PDLXR /N-DUMP THE (EFOP) 634 001016 4640 JMS I IPART /F-CHECK FOR PAREN MATCH 635 001017 1111 TAD M2 /A 636 001020 3032 DCA T1 637 001021 1045 TAD FLAC+1 /TEST -,0,+ 638 001022 7510 SPA 639 001023 2032 ISZ T1 /N-TO -1,-2,-3 640 001024 7750 SPA SNA CLA 641 001025 2032 IF3, ISZ T1 /COUNT COMMAS 642 001026 7410 SKP 643 001027 5765 JMP I COMGO+4 /TRANSFER 644 001030 4547 SORTJ /SEARCH TEXT UNTIL ,;C.R. 645 001031 1375 TLIST-1 646 001032 7373 ILIST-TLIST 647 001033 4545 GETC 648 001034 5230 JMP .-4 649 001035 4545 IF1, GETC /MOVE PAST COMMA 650 001036 5225 JMP IF3 651 001037 1601 IECALL, ECALL 652 001040 2051 IPART, PARTEST 653 /LOOP CONTROL STATEMENT 654 SETT=. /SUBSET OF "FOR" 655 001041 4540 FOR, PUSHJ /LOOPS, ETC. 656 001042 1401 GETARG /LOOK FOR "=" NEXT 657 001043 4560 SPNOR /IGNORE SPACES 658 001044 1066 TAD CHAR 659 001045 1335 TAD MEQ 660 001046 7440 SZA 661 001047 4566 ERROR4 /LEFT OF "=" IN ERROR; 'FOR' OR 'SET' 662 001050 1030 TAD PT1 663 001051 4542 PUSHA /SAVE POINTER TO VARIABLE 664 001052 4540 PUSHJ 665 001053 1612 EVAL-1 /GET INITIAL VALUE EXPRESSION 666 001054 1413 POPA 667 001055 3030 DCA PT1 668 001056 4407 FINT /INITIALIZE NOW. 669 001057 6430 FPUT I PT1 670 001060 0000 FEXT 671 001061 4547 SORTJ /TEST LAST CHAR FROM "EVAL" 672 001062 1375 TLIST-1 673 001063 7201 FLIST1-TLIST 674 001064 4566 ERROR4 /EXCESS R-PAR 675 001065 1030 FINCR, TAD PT1 /SAVE VARIABLE ADDRESS * 676 001066 4542 PUSHA 677 001067 4540 PUSHJ /EVALUATE THE INCREMENT, IF ANY. 678 001070 1612 EVAL-1 679 001071 4547 SORTJ /TEST TERMINATORS 680 001072 1375 TLIST-1 681 001073 7176 FLIST2-TLIST 682 001074 4566 ERROR4 /ILLEGAL TERMINATOR IN 'FOR' 683 001075 4543 FLIMIT, PUSHF /SAVE THE INCREMENT. * 684 001076 2032 FLARG 685 001077 4540 PUSHJ /GET THE LIMIT (NO ERROR DETECTION AFTER LIMIT) 686 001100 1612 EVAL-1 687 001101 4543 FCONT, PUSHF /SAVE THE LIMIT * 688 001102 2032 FLARG 689 001103 4543 PUSHF /SAVE THE TEXT OF OBJECT STATEMENTS 690 001104 0017 TEXTP 691 001105 4540 PUSHJ /DO THE OBJECT STATEMENTS 692 001106 0610 PROCESS 693 001107 4544 POPF /RESTORE REMAINING TEXT. 694 001110 0017 TEXTP 695 001111 4544 POPF /GET LIMIT 696 001112 2032 FLARG 697 001113 4544 POPF /GET INCREMENT 698 001114 7470 ITER1 699 001115 1413 POPA /GET VARIABLE ADDRESS 700 001116 3030 DCA PT1 701 001117 4407 FINT /INCREMENT AND TEST 702 001120 0430 FGET I PT1 /LOAD THE VARIABLE 703 001121 1733 FADD I FINKP /INCREMENT IT 704 001122 6430 FPUT I PT1 /CHANGE IT 705 001123 2525 FSUB I FLARGP /TEST IT 706 001124 0000 FEXT 707 001125 1045 GETSGN 708 001126 7740 SMA SZA CLA 709 001127 5541 POPJ /END OF LOOP 710 001130 1030 TAD PT1 711 001131 4542 PUSHA /SAVE ADDRESS * 712 001132 4543 PUSHF /SAVE INCREMENT AGAIN * 713 001133 7470 FINKP, ITER1 714 001134 5301 JMP FCONT 715 001135 7503 MEQ, -275 716 001136 7524 MCOM, -254 717 001137 4543 FINFIN, PUSHF /SET INCREMENT TO ONE. 718 001140 2405 FLTONE 719 001141 5301 JMP FCONT 720 / 721 /SAME FRAN - JUST MOVED 722 / 723 001142 0000 RANO, 0000 /******** 724 001143 2000 2000 /******** 725 001144 0000 0000 /******** 726 001145 4407 XRAN, FINT /******** 727 001146 1342 FADD RANO /******** 728 001147 4755 FMUL I CRUDDY /******** 729 001150 6342 FPUT RANO /******** 730 001151 0000 FEXT /******** 731 001152 3342 DCA RANO /******** 732 001153 3044 DCA FLAC /******** 733 001154 5536 JMP I EFUN3I /******** 734 001155 6160 CRUDDY, RANMUL /******** 735 /TAKE THE INTEGER PART 736 001156 4453 XINT, JMS I INTEGER /(FIX) 737 001157 7200 CLA 738 001160 5536 JMP I EFUN3I 739 COMGO=. /COMMAND ROUTINE ADDRESSES 740 001161 1041 SETT 741 001162 1041 FOR 742 001163 1013 IF 743 001164 0420 DO 744 001165 0603 GOTO /(REFERENCED) 745 001166 0614 COMMENT 746 001167 1200 ASK/TAD GETRHS 747 001170 1201 TYPE 748 001171 7707 OUTPUT /******** 749 001172 2206 ERASE 750 001173 0635 WRITE 751 001174 1254 MODIFY 752 001175 0177 START /RETURN TO COMMAND MODE VIA 'QUIT' 753 001176 1563 RETRN 754 001177 6346 LTAPE /******** 755 /INPUT-OUTPUT STATEMENTS 756 001200 7240 ASK, CLA CMA /REMEMBER WHICH CALL. 757 001201 3056 TYPE, DCA ATSW 758 001202 3026 TASK, DCA DEBGSW 759 001203 4547 SORTJ /SPECIAL CHARD ***** 760 001204 1367 ALIST-1 761 001205 0200 ATLIST-ALIST 762 001206 2056 ISZ ATSW /TEST QUOTE SWITCH 763 001207 5224 JMP TYPE2 764 001210 4540 PUSHJ /DO ASK; SETUP PT1 765 001211 1401 GETARG 766 001212 1066 TAD CHAR /SAVE IN-LINE CHARACTER. 767 001213 4542 PUSHA 768 001214 1253 TAD COL /TYPE COLON 769 001215 4551 PRINTC /(CLA)= TO SUPRESS ":" 770 001216 2036 ISZ INSUB /INDICATE 'READC' 771 001217 7001 IAC /POINT PAST CHAR 772 001220 4531 JMS I FINPUT /READ DATA AND SAVE 773 001221 1413 POPA /RE-TEST LAST TERMINATOR 774 001222 3066 DCA CHAR 775 001223 5200 JMP ASK 776 001224 4540 TYPE2, PUSHJ /DO TYPE 777 001225 1613 EVAL 778 001226 4530 JMS I FOUTPUT /PRINT 779 001227 5201 JMP TYPE 780 001230 2026 TQUOT, ISZ DEBGSW /DISABLE TRACE 781 001231 4545 GETC /TYPE LITERALS 782 001232 4547 SORTJ 783 001233 1531 TLIST2-1 784 001234 0645 TLIST3-TLIST2 785 001235 4551 PRINTC 786 001236 5231 JMP TQUOT+1 787 001237 4545 TINTR, GETC /PASS PERCENT SIGN 788 001240 4554 GETLN /READ FORMAT CONTROL; "%7.03" 789 001241 1067 TAD LINENO 790 001242 3052 DCA FISW /SAVE FORMAT CODE 791 001243 5202 JMP TASK 792 001244 1077 TCRLF2, TAD CCR /SPLAT=CR ALONE 793 001245 4463 JMS I OUTDEV 794 001246 7040 CMA /NON-PRINTING DELAY FOR C.R. * 795 001247 1077 TCRLF, TAD CCR /EXCLAMATION POINT=CR, LF. 796 001250 4551 PRINTC 797 001251 4545 TASK4, GETC /* 798 001252 5202 JMP TASK 799 001253 0272 COL, 272 /":" 800 /IF DEBGSW=0 ; ENABLE FLIP-FLOP "DMPSW" 801 / #0; DISABLE AND RETURN ALL "?"'S. 802 /IF DMPSW =0 ; TRACE ON, IF ENABLED 803 / #0; TRACE OFF 804 /IF BOTH = 0 ; PRINT TRACE. 805 /SEARCH ROUTINES 806 001254 4554 MODIFY, GETLN /READ LINE NO. 807 001255 4555 FINDLN /LOOK IT UP NOW. 808 001256 4566 ERROR2 /NOT THERE - BAD COMMAND UNLESS ZERO. 809 001257 1060 TAD BUFR /SET POINTERS 810 001260 3010 DCA AXIN /FOR INPUT 811 001261 3062 DCA XCTIN 812 001262 1067 TAD LINENO /COPY THE SAME LINE NUMBER. 813 001263 3410 DCA I AXIN /(X-MEM) 814 001264 1010 TAD AXIN /SAVE START OF NEW LINE 815 001265 3027 DCA PACKST 816 001266 4464 SCONT, JMS I INDEV /READ THE TELETYPE INPUT SILENTLY. 817 001267 3100 DCA LIST3+1 /SAVE SEARCH CHARACTER 818 001270 2026 ISZ DEBGSW /NO BREAKS. 819 001271 4545 SCHAR, GETC /TYPE+TEST-F.F. 820 001272 4551 PRINTC /PLAYBACK THE TEXT 821 001273 4547 SORTJ /LOOK FOR MATCH 822 001274 0076 LIST3-1 823 001275 1267 LISTGO-LIST3 824 001276 4546 PACKC /SAVE NEW LINE 825 001277 5271 JMP SCHAR 826 001300 1060 SBAR, TAD BUFR /RESTART-B.A. 827 001301 7001 IAC 828 001302 3010 DCA AXIN /SET POINTERS 829 001303 3062 DCA XCTIN 830 001304 4552 SFOUND, READC /READ FROM KEYBOARD 831 001305 4547 SORTJ /TEST 832 001306 0071 LIST6-1 833 001307 1267 SRNLST-LIST6 834 001310 4546 SGOT, PACKC /PACK CHAR 835 001311 5304 JMP SFOUND /MORE 836 001312 0000 SORTB, 0 /CORT AND BRANCH ROUTINE - "SORTJ" 837 001313 7450 SNA 838 001314 1066 TAD CHAR /ASSUME CHAR IF AC=0 839 001315 7041 CIA 840 001316 3071 DCA T2 /SAVE SORT ITEM 841 001317 1712 TAD I SORTB /FIRST ARG IS LIST LESS ONE 842 001320 2312 ISZ SORTB /2ND IS INTRA-LIST LENGTH 843 001321 3012 DCA XRT2 844 001322 1412 TAD I XRT2 845 001323 7510 SPA /**LISTS ENDED BY NEGATIVE NUMBERS** 846 001324 5336 JMP SEX /READ EXIT 847 001325 1071 TAD T2 /FIND ADDRESS 848 001326 7640 SZA CLA 849 001327 5322 JMP .-5 850 001330 1012 TAD XRT2 /MATCH FOUND. 851 001331 1712 TAD I SORTB 852 001332 3071 DCA T2 853 001333 1471 TAD I T2 854 001334 3071 DCA T2 /DEBUG : AC = ADDRESS 855 001335 5471 JMP I T2 856 001336 2312 SEX, ISZ SORTB /MATCH NOT FOUND. 857 001337 7300 CLA CLL 858 001340 5712 JMP I SORTB /RETURN TO CALLING SEQUENCE. 859 /ANALOGUE TO DIGITAL CONVERSION FOR PDP-12 860 001341 4453 XADC, JMS I INTEGER 861 001342 0360 AND O37 /******** 862 001343 1357 TAD OSAMP /******** 863 001344 3347 DCA .+3 /******** 864 001345 6002 IOF /******** 865 001346 6141 6141 /LINC /******** 866 001347 0100 0100 /SAM ? /******** 867 001350 0002 0002 /PDP /******** 868 001351 6001 ION /******** 869 001352 3045 DCA FLAC+1 /******** 870 001353 3046 DCA FLAC+2 /******** 871 001354 7326 CLA CLL CML RTL /******** 872 001355 3044 DCA FLAC /******** 873 001356 5536 JMP I EFUN3I /******** 874 001357 0100 OSAMP, 0100 /SAM 0 /******** 875 001360 0037 O37, 37 /******** 876 SRNLST=. /'MODIFY' CONTROL CHARACTER TABLE 877 001361 1271 SCHAR /F.F. = CONTINUE 878 001362 1266 SCONT /BELL = CHANGE SEARCH CHARACTER 879 001363 2740 RECOVR /C.C. = BREAK 880 001364 1300 SBAR /B.A. = RESTART 881 001365 1267 SCONT+1 /L.F. = FINISH THE LINE AS BEFORE. 882 LISTGO=. 883 001366 0261 SRETN /C.R. = END THE LINE HERE AS IS. 884 001367 1310 SGOT /CHAR = SEARCH CHARACTER 885 ALIST=. / ASK/TYPE LIST OF CONTROLS. 886 001370 0245 245 /% 887 001371 0242 242 /" 888 001372 0241 241 /! 889 001373 0243 243 /# 890 001374 0244 244 /$/// 891 GLIST=. 892 001375 0240 240 /SPACE 893 TLIST=. 894 001376 0254 254 /, 895 001377 0273 273 /; 896 001400 0215 215 /C.R. 897 /THIS LIST IS ENDED BY 'TESTC'. 898 /FIND OR ENTHER A VARIABLE IN THE LIST. 899 001401 4564 GETARG, TESTC /FIRST LETTER OF ARG 900 001402 7200 P7200, 7200 /CLA /******** LETS F THRU 901 001403 4566 ERROR4 /******** 902 001404 7000 NOP /******** 903 001405 3062 GETVAR, DCA XCTIN /PACK INTO ADD. 904 001406 4546 PACKC 905 001407 4545 GETC /SECOND LETTER 906 001410 4550 SORTC /TERMINATOR? 907 001411 1771 TERMS-1 908 001412 5224 JMP GSERCH /YES 909 001413 1066 TAD CHAR /NO 910 001414 0122 AND P77 /SAVE 2ND LETTER OF NAME 911 001415 1061 TAD QADD 912 001416 3061 DCA QADD 913 001417 4545 GETC /IGNORE THE REST 914 001420 4550 SORTC 915 001421 1771 TERMS-1 916 001422 5224 JMP GSERCH 917 001423 5217 JMP .-4 918 001424 4562 GSERCH, TSTLPR /LOOK FOR SUBSCRIPT VIA SORTCN 919 001425 5235 JMP GS1 /NOT SUBSCRIPTED BY L-PAR. 920 001426 1061 TAD QADD /SAVE NAME 921 001427 3056 DCA EFOP /FOR RECURSIVE AND ERROR CHECK 922 001430 4663 JMS I GECALL /TO EVAL 923 001431 1413 POPA 924 001432 3061 DCA QADD /RESTORE NAME 925 001433 4662 JMS I PTEST /TEST PAREN MATCH 926 001434 4453 JMS I INTEGER /CONVERT TO 12 BIT NUMBER. 927 001435 3171 GS1, DCA SUBS /SAVE SUBSCRIPT 928 001436 1061 TAD QADD /******** LETS F THRU 929 001437 0101 AND P7700 /******** 930 001440 1202 TAD P7200 /******** 931 001441 7650 SNA CLA /******** 932 001442 5322 JMP FFF /******** 933 001443 1060 TAD STARTV /SEARCH FOR VARIABLE(CHANGE FOR X-MEM) 934 001444 3030 GS3, DCA PT1 935 001445 1030 TAD PT1 936 001446 7041 CIA 937 001447 1031 TAD LASTV /TEST FOR END OF LIST 938 001450 7750 SPA SNA CLA 939 001451 5264 JMP GS2 /END SEARCH 940 001452 1430 TAD I PT1 /GET TABLE ENTRY 941 001453 7041 CIA 942 001454 1061 TAD QADD 943 001455 7650 SNA CLA 944 001456 5310 JMP GFND1 /FOUND XX 945 001457 1030 GS4, TAD PT1 /TRY NEXT ONE 946 001460 1070 TAD GINC 947 001461 5244 JMP GS3 948 001462 2051 PTEST, PARTEST 949 001463 1601 GECALL, ECALL 950 001464 1031 GS2, TAD LASTV /ADD THE VARIABLE 951 001465 1005 TAD P13 /TEST STORAGE LIMITS 952 001466 7141 CLL CIA 953 001467 1013 TAD PDLXR 954 001470 7620 SNL CLA 955 001471 4566 ERROR3 956 001472 1031 TAD LASTV /UPDATE THE LIST. 957 001473 1070 TAD GINC 958 001474 3031 DCA LASTV 959 001475 1061 TAD QADD /SAVE NAME 960 001476 3430 DCA I PT1 961 001477 2030 ISZ PT1 /SAVE SUBSCRIPT 962 001500 1171 TAD SUBS 963 001501 3430 DCA I PT1 964 001502 2030 ISZ PT1 /SET PT1 965 001503 4407 FINT 966 001504 0537 FGET I CFRSX 967 001505 6430 FPUT I PT1 968 001506 0000 FEXT 969 001507 5541 POPJ /EXIT 970 001510 1030 GFND1, TAD PT1 /FOUND SAME 971 001511 3011 DCA XRT /TEST SUBSCRIPTS 972 001512 1411 TAD I XRT 973 001513 7041 CIA 974 001514 1171 TAD SUBS 975 001515 7640 SZA CLA 976 001516 5257 JMP GS4 /WRONG SUBSCRIPT 977 001517 2030 ISZ PT1 /SET POINTER TO DATA 978 001520 2030 ISZ PT1 979 001521 5541 POPJ 980 001522 3030 FFF, DCA PT1 /******** SAVES SUBSCRIPT ON F 981 001523 1061 TAD QADD /******** 982 001524 3002 DCA LWETMP /******** 983 001525 1045 TAD HORD /******** 984 001526 3170 DCA LESUB2 /******** 985 001527 1171 TAD SUBS /******** 986 001530 3167 DCA SUBS2 /******** 987 001531 5541 POPJ /******** 988 001532 0242 TLIST2, 242 /******** 989 001533 0215 215 /******** 990 001534 7520 M260, -260 /******** 991 /******** 992 001535 0000 XSPNOR, 0 /IGNORE LEADING SPACES - "SPNOR" 993 001536 1066 TAD CHAR 994 001537 1114 TAD M240 995 001540 7640 SZA CLA 996 001541 5735 JMP I XSPNOR 997 001542 4545 GETC 998 001543 5336 JMP XSPNOR+1 999 /******** RECODING FOR SPACE 1000 001544 7506 M272, -272 /******** 1001 001545 0012 O12, 12 /******** 1002 /******** 1003 /******** 1004 001546 0000 XTESTN, 0 /RETURNS .; OTHER; NUMBER - "TESTN" 1005 001547 1066 TAD CHAR 1006 001550 1115 TAD MPER 1007 001551 7640 SZA CLA 1008 001552 2346 ISZ XTESTN 1009 001553 1066 TAD CHAR /******** RECODING FOR SPACE 1010 001554 1344 TAD M272 /******** 1011 001555 7100 CLL /******** 1012 001556 1345 TAD O12 /******** 1013 001557 3054 DCA SORTCN /******** 1014 001560 7430 SZL /******** 1015 001561 2346 ISZ XTESTN /******** 1016 001562 5746 JMP I XTESTN /******** 1017 /******** 1018 /EXIT FROM A "DO" SUBROUTINE 1019 001563 1137 RETRN, TAD CFRSX /(PC) => 0 1020 001564 3022 DCA PC 1021 001565 1413 XPOPJ, TAD I PDLXR /RECURSIVE EXIT - "POPJ" 1022 001566 3071 DCA T2 1023 001567 5471 JMP I T2 1024 ATLIST=. /ASK-TYPE CONTROL CHARACTER TABLE 1025 001570 1237 TINTR /% - FORMAT DELIMITER 1026 001571 1230 TQUOT /" - LITERAL DELIMITER 1027 001572 1247 TCRLF /! - CARRIAGE RETURN AND LINE FEED 1028 001573 1244 TCRLF2 /# - CARRIAGE RETURN ONLY 1029 001574 3052 TDUMP /$ - DUMP THE SYMBOL TABLE CONTENTS 1030 001575 1251 TASK4 /SP- TERMINATOR FOR NAMES 1031 001576 1251 TASK4 /, - TERMINATOR FOR EXPRESSIONS 1032 001577 0610 PROCESS /; - TERMINATOR FOR COMMANDS 1033 001600 0614 PC1 /C.R. - TERMINATOR FOR STRINGS 1034 /$ - FOR 'TDUMP' TERMINATES THE COMMAND. 1035 /EVALUATE AN EXPRESSION WHICH 1036 /TERMINATES WITH AN R-PAR,; OR C.R. AND 1037 /LEAVE THE RESULT IN FLAC AND IN FLARG. 1038 001601 0000 ECALL, 0 /RECURSIVE CALL TO "EVAL" 1039 001602 1054 TAD SORTCN /SAVE 'SORTCN', 'LASTOP', AND 'EFOP' 1040 001603 4542 PUSHA 1041 001604 1055 TAD LASTOP 1042 001605 4542 PUSHA 1043 001606 1056 TAD EFOP /SAVE FUNCTION CODE. 1044 001607 4542 PUSHA 1045 001610 1201 TAD ECALL /RETURN TO CALLING 1046 001611 4542 PUSHA /ADDRESS AFTER NEXT POPJ 1047 001612 4545 GETC /MOVE PAST EXTRA CHARACTER 1048 001613 3055 EVAL, DCA LASTOP /EVALUATION CONTROLLER (CHECKPOINT ?) 1049 001614 4564 TESTC /TEST CHARACTER AND IGNORE SPACES 1050 001615 5227 JMP ETERM1 /TERMINATOR 1051 001616 5332 JMP ENUM /NUMBER 1052 001617 5343 JMP EFUN /FUNCTION 1053 001620 4540 PUSHJ /LETTER OF VARIABLE 1054 001621 1405 GETVAR /FIND OR CREATE VARIABLE; ALSO SET PT1. 1055 001622 4564 OPNEXT, TESTC /PT1 => ARG 1056 001623 5244 JMP ETERMN /T 1057 001624 0212 ECHOLST,0212 /N - ERROR IN FORMAT 1058 001625 0377 0377 /F 1059 001626 4566 ERROR4 1060 001627 1137 ETERM1, TAD CFRSX /SET PT1 1061 001630 3030 DCA PT1 /TO POINT TO ZERO 1062 001631 1111 TAD M2 /TEST FOR UNARY OPERATIONS 1063 001632 1054 TAD SORTCN 1064 001633 7450 SNA 1065 001634 5247 JMP ETERM /CREATE DUMMY FOR UNARY MINUS 1066 001635 7001 IAC 1067 001636 7650 SNA CLA 1068 001637 5323 JMP ARGNXT /IGNORE UNARY PLUS 1069 001640 1054 TAD SORTCN /TEST FOR NULL PARENS. 1070 001641 1121 TAD M11 1071 001642 7710 SPA CLA 1072 001643 5364 JMP ELPAR /MIGHT BE AN L-PAR. 1073 001644 4562 ETERMN, TSTLPR 1074 001645 7410 SKP 1075 001646 4566 ERROR4 /OPERATOR MISSING BEFORE PAREN 1076 001647 1054 ETERM, TAD SORTCN /SET FROM "TESTC"-"SORTC" 1077 001650 3024 DCA THISOP 1078 001651 1024 TAD THISOP 1079 001652 1121 TAD M11 1080 001653 7700 SMA CLA /END? 1081 001654 3024 DCA THISOP /"THISOP" EQUIV. END OF EXP. 1082 001655 1024 ETERM2, TAD THISOP /COMPARE PRIORITIES 1083 001656 7041 CIA 1084 001657 1055 1055 1085 001660 7710 SPA CLA 1086 001661 5310 JMP EPAR /CONTINUE 1087 001662 1055 TAD LASTOP /FIND OPERATION 1088 001663 7112 CLL RTR 1089 001664 7012 RTR 1090 001665 1331 TAD OPTABL 1091 001666 3274 DCA FLOP 1092 001667 1055 TAD LASTOP 1093 001670 7640 SZA CLA /TEST FOR END OF DATA INTO FLOATING AC. 1094 001671 4544 POPF /GET LAST DATA 1095 001672 0044 AND FLAC 1096 001673 4407 FINT 1097 001674 0000 FLOP, 00 /(FLOPR I PT1)***/ 1098 001675 6525 FPUT I FLARGP /SAVE RESULT 1099 001676 0000 FEXT 1100 001677 1125 TAD FLARGP 1101 001700 3030 DCA PT1 1102 001701 1024 TAD THISOP 1103 001702 1055 TAD LASTOP /=0? 1104 001703 7650 SNA CLA 1105 001704 5541 POPJ /EXIT "EVAL" 1106 001705 1413 POPA /GET PRIOR OP 1107 001706 3055 DCA LASTOP 1108 001707 5255 JMP ETERM2 /COMPARE THIS OP 1109 001710 4562 EPAR, TSTLPR /TEST FOR SUB-EXPRESSION 1110 001711 7410 SKP 1111 001712 5366 JMP EPAR2 /GO EVALUATE EXPRESSION 1112 001713 1055 TAD LASTOP /CONTINUE READING THE EXPRESSION 1113 001714 4542 PUSHA /SAVE "LASTOP". 1114 001715 1030 TAD PT1 1115 001716 3320 DCA .+2 1116 001717 4543 PUSHF /SAVE LAST ARGUMENT 1117 001720 0000 00 1118 001721 1024 TAD THISOP /MORE TO COME 1119 001722 3055 DCA LASTOP 1120 001723 4545 ARGNXT, GETC /READ 1ST CHAAR OF AN ARG. 1121 001724 4564 TESTC /DO SPECIAL CHECK 1122 001725 5364 JMP ELPAR /COULD BE LEFT PAREN 1123 001726 5332 JMP ENUM /N 1124 001727 5343 JMP EFUN /F 1125 001730 5220 JMP OPNEXT-2 /L 1126 001731 0430 OPTABL, FGET I PT1 /BASE FOR OPERATION COMPUTATION 1127 001732 4543 ENUM, PUSHF /TO PROCESS A NUMBER, SAVE AC 1128 001733 0044 FLAC 1129 001734 1125 TAD FLARGP /SET POINTER AS FOR A VARIABLE. 1130 001735 3030 DCA PT1 1131 001736 3036 DCA INSUB /POINT TO 'GETC' AND USE CHAR 1132 001737 4531 JMS I FINPUT /READ TEXT NUMBER => (PT1) 1133 001740 4544 POPF /RESTORE THE AC 1134 001741 0044 FLAC 1135 001742 5222 JMP OPNEXT /CONTINUE 1136 001743 3056 EFUN, DCA EFOP /SET CODE 1137 001744 4545 GETC /READ FUNCTION NAME. (1,2, OR 3 LETTERS) 1138 001745 4564 TESTC /******** SEPARATES FILE BECAUSE F DIGIT 1139 001746 5355 JMP EFUN2 /******** 1140 001747 5771 JMP I PFNUM /******** 1141 001750 7000 NOP /******** 1142 001751 1056 TAD EFOP /******** 1143 001752 7104 CLL RAL /MISH-MASH HASH CODE 1144 001753 1066 TAD CHAR 1145 001754 5343 JMP EFUN 1146 001755 4562 EFUN2, TSTLPR 1147 001756 4566 ERROR4 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT 1148 001757 4201 JMS ECALL /CALL "EVAL" TO COMPUTE ARGUMENT 1149 001760 1413 POPA /BRANCH ON FUNCTION CODE; RETURN VIA EFUN3I. 1150 001761 4547 SORTJ 1151 001762 2166 FNTABL-1 1152 001763 6205 FNTABF-FNTABL 1153 001764 4562 ELPAR, TSTLPR /LEFT PAREN OR FELL THROUGH FUNCTION TABLE 1154 001765 4566 ERROR4 /DOUBLE OPERATORS OR ILLEGAL FUNCTION NAME. 1155 001766 4201 EPAR2, JMS ECALL /EVALUATE NEEDED EXPRESSION 1156 001767 2013 ISZ PDLXR /DUMP EXTRA ARG. 1157 001770 5536 JMP I EFUN3I 1158 001771 6311 PFNUM, FNUM /******** 1159 TERMS=. /TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR' 1160 001772 0240 240 /SPACE 0 1161 001773 0253 253 /+ 1 1162 001774 0255 255 /- 2 1163 001775 0257 257 // 3 1164 001776 0252 252 /* 4 1165 001777 0336 336 /UP ARR 5 1166 002000 0250 250 /( 6 1167 002001 0333 333 /[ 7 1168 002002 0274 274 /< 10 1169 002003 0251 251 /) 11 1170 002004 0335 335 /] 12 1171 002005 0276 276 /> 13 1172 002006 0254 254 /, 14 1173 002007 0273 273 /; 15 1174 002010 0215 215 /C.R. 16 1175 002011 0275 275 /= TO END GETARG FROM 'SET' 1176 /TWO MINOR FUNCTIONS 1177 002012 4543 XSGN, PUSHF /TAKE SIGN*1 OF FLARG 1178 002013 2405 FLTONE 1179 002014 4544 POPF 1180 002015 0044 FLAC 1181 002016 1233 XABS, TAD FLARG+1 /TAKE ABSOLUTE VALUE OF FLAC 1182 002017 7710 SPA CLA 1183 002020 4451 JMS I MINSKI /NEGATE THE FLOATING AC 1184 /CONTINUATION OF FUNCTION CALLS. 1185 002021 4407 EFUN3, FINT 1186 002022 7000 FNOR /NORMALIZE FUNCTION RETURN 1187 002023 6232 FPUT FLARG /SAVE FUNCTION VALUE 1188 002024 0000 FXIT 1189 002025 1125 TAD FLARGP /SET POINTER 1190 002026 3030 DCA PT1 1191 002027 4251 JMS PARTEST 1192 002030 5631 JMP I .+1 /FUNCTION RETURN IS OK 1193 002031 1622 OPNEXT 1194 1195 002032 0000 FLARG, 0 /DATA TEMPORARY STORAGE 1196 002033 0000 0 1197 002034 0000 0 1198 002035 0000 0 1199 002036 0003 P3, 3 1200 002037 0000 LPRTST, 0 /SKIP IF LEFT PAREN. - 'TSTLPR' 1201 002040 1054 TAD SORTCN 1202 002041 1121 TAD M11 1203 002042 7700 SMA CLA 1204 002043 5637 JMP I LPRTST 1205 002044 1054 TAD SORTCN 1206 002045 1120 TAD M5 1207 002046 7740 SZA SMA CLA 1208 002047 2237 ISZ LPRTST 1209 002050 5637 JMP I LPRTST 1210 002051 0000 PARTEST,0 /TEST THE PAREN MATCHINGS 1211 002052 1413 POPA /RESTORE LAST OPERATION 1212 002053 3055 DCA LASTOP 1213 002054 1236 TAD P3 /+3 TO COMPARE CODES 1214 002055 1413 POPA /GET LAST PAREN CODE. 1215 002056 7041 CIA /CHECK FOR PAREN MATCH. 1216 002057 1054 TAD SORTCN /(STIL SET FROM THE LAST "EVAL") 1217 002060 7640 SZA CLA /SKIP IF MATCH 1218 002061 4566 ERROR4 /PAREN ERROR 1219 002062 4545 GETC /MOVE PAST R-PAR 1220 002063 5651 JMP I PARTEST 1221 /THE DELETE A LINE ROUTINE 1222 002064 0000 XDELETE,0 /UNCHAIN A LINE AND RECOVER THE SPACE. 1223 002065 6002 IOF /PROTECT POINTER CHANGES FROM INTERRUPTIONS 1224 002066 4555 FINDLN /SETS "THISLN" AND "LASTLN". 1225 002067 5664 JMP I XDELET /ALREADY GONE 1226 002070 2026 ISZ DEBGSW /DISABLE TRACE 1227 002071 4545 GETC /MEASURE LENGTH 1228 002072 1066 TAD CHAR 1229 002073 1116 TAD MCR 1230 002074 7640 SZA CLA 1231 002075 5271 JMP .-4 1232 002076 1017 TAD AXOUT /SAVE LAST ADDRESS 1233 002077 7040 CMA 1234 002100 1023 TAD THISLN 1235 002101 3057 DCA CNTR /LENGTH < 0 1236 002102 1133 TAD CFRS /IT IS ILLEGAL TO DELETE THE FIRST LINE 1237 002103 7041 CIA 1238 002104 1023 TAD THISLN 1239 002105 7650 SNA CLA 1240 002106 5177 JMP START /JUST IGNORE SUCH COMMANDS 1241 002107 7000 CDF T /CHANGE DATA FIELD TO TEXT. (X-MEM) 1242 002110 1423 TAD I THISLN /DISCONNECT 1243 002111 3425 DCA I LASTLN 1244 002112 1133 TAD CFRS /START LIST AT TOP 1245 002113 3071 DOK, DCA T2 /EXAMINATION ADDRESS 1246 002114 1471 TAD I T2 /GET THE NEXT ADDR. 1247 002115 7450 SNA /TEST FOR END 1248 002116 5331 JMP DONE /YES - WRAP UP ALL. 1249 002117 3032 DCA T1 /SAVE NEXT ADDRESS 1250 002120 1023 TAD THISLN /COMPARE LINE POSITIONS 1251 002121 7141 CIA CLL 1252 002122 1032 TAD T1 1253 002123 7630 SZL CLA /SKIP IF THISLN > X 1254 002124 1057 TAD CNTR /CHANGE (X) TO ACCOUNT FOR 1255 002125 1032 TAD T1 /GARBAGE COLLECTION. 1256 002126 3471 DCA I T2 1257 002127 1032 TAD T1 /GET NEXT 1258 002130 5313 JMP DOK 1259 /GARBAGE COLLECTION 1260 002131 7040 DONE, CMA /BACKUP L FOR XR 1261 002132 1023 TAD THISLN 1262 002133 3011 DCA XRT 1263 002134 1057 TAD CNTR /SETUP END OF HOSE 1264 002135 7040 CMA 1265 002136 1023 TAD THISLN 1266 002137 3012 DCA XRT2 1267 002140 1057 TAD CNTR /CORRECT END OF BUFFER POINTER. 1268 002141 1060 TAD BUFR 1269 002142 3060 DCA BUFR 1270 002143 1010 TAD AXIN /COMPUTE COUNT 1271 002144 7040 CMA 1272 002145 1012 TAD XRT2 1273 002146 3032 DCA T1 1274 002147 1010 TAD AXIN 1275 002150 1057 TAD CNTR 1276 002151 3010 DCA AXIN 1277 002152 1412 TAD I XRT2 /SIPHON LOWER PART 1278 002153 3411 DCA I XRT 1279 002154 2032 ISZ VAL 1280 002155 5352 JMP .-3 1281 002156 5265 JMP XDELETE+1 /RESET 'LASTN', 'THISLN', AND DATA FIELD. 1282 002157 0000 CHIN, 0 /READ IN A CHARACTER SUBR. - "READC" 1283 002160 4464 JMS I INDEV 1284 002161 3066 DCA CHAR 1285 002162 4550 SORTC /LINEFEED OR RUBOUT? 1286 002163 1623 ECHOLST-1 1287 002164 5757 JMP I CHIN /YES 1288 002165 4551 PRINTC /ECHO THE INPUT 1289 002166 5757 JMP I CHIN 1290 FNTABL=. 1291 002167 2533 2533 /ABS 1292 002170 2650 2650 /SGN 1293 002171 2636 2636 /ITR 1294 002172 2565 2565 /DIS 1295 002173 2630 2630 /RAN 1296 002174 2517 2517 /ADC 1297 002175 2572 2572 /ATN 1298 002176 2624 2624 /EXP 1299 002177 2625 2625 /LOG 1300 002200 2654 2654 /SIN /LIST OF CODED FUNCTION NAMES 1301 002201 2575 2575 /COS 1302 002202 2702 2702 /SQT 1303 002203 2631 2631 /NEW 1304 002204 0330 0330 /FX /******** 1305 002205 0332 0332 /FZ /******** 1306 /ERASE SINGLE LINES, GROUPS, OR VARIABLES 1307 002206 4564 ERASE, TESTC /TEST THE SECOND WORD, IF ANY. 1308 002207 5241 JMP ERVX /ERASE VARIABLES 1309 002210 5224 JMP ERL /LINES OR GROUPS 1310 002211 5215 JMP .+4 /ERROR 1311 002212 1066 TAD CHAR /ALL TEXT 1312 002213 1112 TAD MINUSA 1313 002214 7440 SZA 1314 002215 4566 ERROR3 /BAD ARG FOR ERASE 1315 002216 1135 ERT, TAD ENDT /ERASE ALL TEXT ** 1316 002217 3060 DCA BUFR 1317 002220 3533 DCA I CFRS /(X-MEM) 1318 002221 1060 ERV, TAD STARTV /ERASE VARIABLES ** 1319 002222 3031 DCA LASTV 1320 002223 5177 JMP START /POINTERS MAY BE DIFFERENT NOW. 1321 002224 4554 ERL, GETLN /ERASE LINES. 1322 002225 1060 TAD BUFR /PROTECT REST OF TEXT. 1323 002226 3010 DCA AXIN 1324 002227 4565 ERG, DELETE /EXTRACT ONE LINE 1325 002230 2023 ISZ THISLN 1326 002231 1065 TAD NAGSW 1327 002232 7700 SMA CLA 1328 002233 1423 TAD I THISLN /(X-MEM) 1329 002234 4563 TSTGRP /SKIP IF G(AC) = G(LINENO) 1330 002235 5221 JMP ERV 1331 002236 1423 TAD I THISLN /(X-MEM) 1332 002237 3067 DCA LINENO 1333 002240 5227 JMP ERG 1334 002241 1060 ERVX, TAD STARTV /INIT VARIABLES MAY BE INDIRECT 1335 002242 3031 DCA LASTV 1336 002243 5541 POPJ 1337 /ROUTINE CALLED VIA "FINDLN": 1338 /SEARCH FOR A GIVEN LINE I.D. = [ "LINENO" ] 1339 /1ST RETURN IF NOT FOUND. 1340 /2ND RETURN IF FOUND. 1341 /"THISLN" = FOUND LINE OR NEXT LARGER. 1342 /"LASTLN" = LESSER AND/OR LAST. 1343 /"TEXTP" IS SET. 1344 002244 0000 XFIND, 0 1345 002245 1133 TAD CFRS /INITIALIZE POINTERS TO FIRST LINE 1346 002246 3025 DCA LASTLN 1347 002247 1133 TAD CFRS 1348 002250 3023 FINDN, DCA THISLN /SAVE THIS ONE 1349 002251 1023 TAD THISLN 1350 002252 3011 DCA XRT 1351 002253 1067 TAD LINENO 1352 002254 7141 CLL CMA IAC /CLEAR LINK AND NEGATE LINENO. 1353 002255 1411 TAD I XRT /LINENO=0 WILL ALSO BE FOUND (X-MEM) 1354 002256 7450 SNA 1355 002257 2244 ISZ XFIND /******** 1356 002260 7630 SZL CLA 1357 002261 5267 JMP FEND3 /PAST IT. 1358 002262 1023 TAD THISLN /MOVE POINTERS 1359 002263 3025 DCA LASTLN 1360 002264 1423 TAD I THISLN /END OF TEST? (X-MEM) 1361 002265 7440 SZA 1362 002266 5250 JMP FINDN /NOT YET 1363 /******** 1364 /******** 1365 002267 1023 FEND3, TAD THISLN /1ST RETURN = NOT FOUND 1366 002270 7001 IAC 1367 002271 3017 DCA TEXTP /SET "TEXTP". 1368 002272 3020 DCA XCT 1369 002273 5644 JMP I XFIND 1370 002274 0000 UTRA, 0 /UNPACK CHARACTER. - "GETC" 1371 002275 4330 JMS GET1 1372 002276 7710 UTE, SPA CLA /NORM & EXTEND 1373 002277 1006 TAD C100 /300-337 & 340-376 1374 002300 1357 TAD M137 /240-276 & 200-236 1375 002301 1066 TAD CHAR 1376 002302 7450 SNA 1377 002303 5316 JMP UTX /"?" FOUND 1378 002304 1075 TAD P337 1379 002305 3066 UTO, DCA CHAR 1380 002306 1026 TAD DEBGSW 1381 002307 1100 TAD DMPSW 1382 002310 7650 SNA CLA 1383 002311 4551 PRINTC /PRINT ONLY IF BOTH ARE ZERO. 1384 002312 5674 JMP I UTRA 1385 002313 4330 EXTR, JMS GET1 1386 002314 7040 CMA 1387 002315 5276 JMP UTE 1388 002316 1026 UTX, TAD DEBGSW /TEST FOR TRACE ENABLED 1389 002317 7640 SZA CLA 1390 002320 5326 JMP .+6 1391 002321 1100 TAD DMPSW /FLIP THE TRACE FLOP 1392 002322 7650 SNA CLA 1393 002323 7001 IAC 1394 002324 3100 DCA DMPSW 1395 002325 5275 JMP UTRA+1 /GET NEXT CHARACTER INSTEAD. 1396 002326 1110 TAD P277 /TRACE DISABLED = RETURN "?" 1397 002327 5305 JMP UTO 1398 002330 0000 GET1, 0 /UNPACK 6-BIT 1399 002331 2020 ISZ XCT /STARTS=0 1400 002332 5345 JMP GET3 1401 002333 1021 TAD GTEM 1402 002334 0122 GEND, AND P77 1403 002335 3066 DCA CHAR /SAVE 1404 002336 1066 TAD CHAR 1405 002337 1103 TAD M77 1406 002340 7650 SNA CLA 1407 002341 5313 JMP EXTR /EXTENDED 1408 002342 1066 TAD CHAR 1409 002343 1356 TAD M40 1410 002344 5730 JMP I GET1 1411 002345 1417 GET3, TAD I AXOUT /(X-MEM) 1412 002346 3021 DCA GTEM 1413 002347 7040 CMA 1414 002350 3020 DCA XCT 1415 002351 1021 TAD GTEM 1416 002352 7112 CLL RTR 1417 002353 7012 RTR 1418 002354 7012 RTR 1419 002355 5334 JMP GEND 1420 002356 7740 M40, -40 1421 002357 7641 M137, -137 1422 002360 0000 XENDLN, 0 /TERMINATE THE BUFFERED LINE - "ENDLN" 1423 002361 7000 CDF T /(X-MEM) 1424 002362 1425 TAD I LASTLN /SAVE OLD POINTER 1425 002363 3460 DCA I BUFR 1426 002364 1060 TAD BUFR /POINT TO NEW LAST LINE 1427 002365 3425 DCA I LASTLN 1428 002366 1061 TAD QADD /CHECK FOR EXTRA INFO 1429 002367 7440 SZA 1430 002370 3410 DCA I AXIN 1431 002371 1010 TAD AXIN /COMPUTE NEW END OF BUFFER 1432 002372 7001 IAC 1433 002373 3060 DCA BUFR 1434 002374 1060 TAD STARTV /RESET VARIABLE LIST (X-MEM) 1435 002375 3031 DCA LASTV 1436 002376 5760 JMP I XENDLN 1437 TLIST3=. /LITERAL TERMINATORS 1438 002377 1251 TASK4 /" 1439 002400 0614 PC1 /C.R. = AUTOMATIC QUOTE MATCH 1440 INFIX=. /DATA CONTROL CHARACTERS 1441 002401 6202 FLINTP+2 /LEFT ARROW = KILL 1442 002402 0757 INPUT+1 /RUBOUT = IGNORE 1443 002403 0757 INPUT+1 /L.F. = IGNORE 1444 002404 6250 ENDFI+5 /ALT MODE = EXIT 1445 002405 0001 FLTONE, 0001 /(NO RELATIVE REFERENCES) 1446 002406 2000 2000 1447 002407 0000 FLTZER, 0000 1448 002410 0000 0000 1449 002411 0000 0000 1450 002412 0000 0000 1451 002413 7766 M12, -12 /DECIMAL CONVERSION FACTOR FOR "PRNT" 1452 002414 0000 I33, 0 /NO-INTERRUPT INPUT ROUTINE 1453 002415 6031 KSF 1454 002416 5215 JMP .-1 1455 002417 6036 KRB 1456 002420 0106 AND P177 /IGNORE PARITY BIT 1457 002421 7450 SNA 1458 002422 5215 JMP .-5 1459 002423 1123 TAD C200 1460 002424 5614 JMP I I33 1461 002425 0000 XPRNT, 0 /PRINT A LINE NUMBER - "PRNTLN" 1462 002426 1067 TAD LINENO 1463 002427 4557 RTL6 1464 002430 0122 AND P77 1465 002431 4242 JMS PRNT /TWO DIGIT "PART" NUMBER 1466 002432 1102 TAD PER 1467 002433 4551 PRINTC /PERIOD FOR SEPARATION 1468 002434 1067 TAD LINENO 1469 002435 4242 JMS PRNT /TWO DIGIT "STEP" NUMBER 1470 002436 1356 TAD M140 1471 002437 3066 DCA CHAR /SAVE SPACE IN CHAR. 1472 002440 4551 PRINTC /PRINT TRAILING SPACE 1473 002441 5625 JMP I XPRNT 1474 VAL=T1 1475 002442 0000 PRNT, 0 /PRINT TWO DECIMAL DIGITS 1476 002443 0106 AND P177 1477 002444 3032 DCA VAL 1478 002445 1113 TAD C260 1479 002446 3033 DCA T3 1480 002447 5252 JMP .+3 1481 002450 2033 ISZ T3 1482 002451 3032 XYZ, DCA VAL 1483 002452 1032 TAD VAL 1484 002453 1213 TAD M12 1485 002454 7500 SMA 1486 002455 5250 JMP XYZ-1 1487 002456 7200 CLA 1488 002457 1033 TAD T3 1489 002460 4551 PRINTC 1490 002461 1032 TAD VAL 1491 002462 1113 TAD C260 1492 002463 4551 PRINTC 1493 002464 5642 JMP I PRNT 1494 002465 0000 OUT, 0 /OUTPUT A CHARACTER - "PRINTC" 1495 002466 7450 SNA /USE (AC) OR (CHAR) 1496 002467 1066 TAD CHAR 1497 002470 1116 TAD MCR 1498 002471 7450 SNA 1499 002472 5276 JMP OUTCR 1500 002473 1077 TAD CCR 1501 002474 4463 JMS I OUTDEV 1502 002475 5665 OUTX, JMP I OUT 1503 002476 1077 OUTCR, TAD CCR 1504 002477 4463 JMS I OUTDEV 1505 002500 1076 TAD CLF 1506 002501 5274 JMP OUTX-1 1507 002502 0000 PACBUF, 0 /PACK A CHARACTER - "PACKC" 1508 002503 1110 TAD P277 1509 002504 7041 CIA 1510 002505 1066 TAD CHAR 1511 002506 7450 SNA /CHANGE 277 TO 337 1512 002507 1352 TAD P40 1513 002510 1101 TAD PLESUB 1514 002511 7450 SNA /TEST FOR RUBOUT. 1515 002512 5755 JMP I RUBIT 1516 002513 1353 TAD P377 1517 002514 3071 DCA T2 /SAVE INPUT ITEM 1518 002515 1071 TAD T2 /SO THAT QUESTION DOESN'T MAKE 1519 002516 0354 AND C140 /CHAR LOOK LIKE A LEFT-ARROW 1520 002517 1356 TAD M140 1521 002520 7440 SZA /DATA WORD. 1522 002521 1354 TAD C140 1523 002522 7650 SNA CLA 1524 002523 5332 JMP ESCA /340-377 AND 200-237 1525 002524 1071 PA1, TAD T2 /240-337 1526 002525 0122 AND P77 1527 002526 7440 SZA /IGNORE 300 1528 002527 4335 JMS PCK1 1529 002530 7000 PACX, CDF P /(X-MEM) 1530 002531 5702 JMP I PACBUF 1531 002532 1122 ESCA, TAD P77 1532 002533 4335 JMS PCK1 1533 002534 5324 JMP PA1 1534 002535 0000 PCK1, 0 1535 002536 2062 ISZ XCTIN /=0 TO START 1536 002537 5357 JMP ROT 1537 002540 1061 TAD QADD 1538 002541 3410 DCA I AXIN /(X-MEM) 1539 002542 3061 DCA QADD /CLEAR PACKING WORD 1540 002543 1013 TAD PDLXR /CHECK FOR OVERFLOW 1541 002544 7141 CMA IAC CLL 1542 002545 1005 TAD P13 /RESERVATIONS FOR PUSH-DOWN LIST 1543 002546 1010 TAD AXIN 1544 002547 7620 SNL CLA 1545 002550 5735 JMP I PCK1 1546 002551 4566 ERROR2 /FULL BUFFER 1547 002552 0040 P40, 40 1548 002553 0377 P377, 377 1549 002554 0140 C140, 140 1550 002555 3004 RUBIT, RUB1 1551 002556 7640 M140, -140 1552 002557 4557 ROT, RTL6 /(EAE) 1553 002560 3061 DCA QADD 1554 002561 7040 CMA 1555 002562 3062 DCA XCTIN 1556 002563 5735 JMP I PCK1 1557 / 1558 /PART OF INTERFACE TO FLD1 TO ALLOW 1559 /GETTING OF CHARS FROM TEXT 1560 / 1561 002564 4545 CGETX, GETC /******** 1562 002565 1066 TAD CHAR /******** 1563 002566 6213 6213/CIF CDF 10 /******** 1564 002567 5770 JMP I .+1 /******** 1565 002570 1137 CGETRET /******** 1566 002571 4566 ERRFIL, ERROR4 /******** 1567 /USED BY 8K 1568 *2600 1569 /INTERRUPT PROCESSOR. 1570 002600 0000 SAVAC, 0 /CONTENTS OF AC 1571 002601 0000 SAVLK, 0 /CONTENTS OF LINK 1572 002602 7575 MBREAK, -203 /CONTROL-C 1573 002603 3200 INTRPT, DCA SAVAC /SAVE WORKING DATA 1574 002604 7010 RAR 1575 002605 3201 DCA SAVLK 1576 002606 6041 TSF /GIVE OUTPUT PRIORITY 1577 002607 5225 JMP KINT 1578 002610 6042 TCF 1579 002611 3016 DCA TELSW /TURN OF IN-PROGRESS FLAG. 1580 002612 1665 TAD I OPTRI 1581 002613 7450 SNA 1582 002614 5225 JMP KINT /DONE 1583 002615 6044 TPC /TYPE NEXT. 1584 002616 3016 DCA TELSW /CLEAR AC, SET IN-PROGRESS. 1585 002617 3665 DCA I OPTRI /ZERO OUT THE DATA AREA 1586 002620 1265 TAD OPTRI 1587 002621 7001 IAC 1588 002622 0107 AND P17 1589 002623 1263 TAD OPTR0 1590 002624 3265 DCA OPTRI 1591 002625 6031 KINT, KSF /CHECK FOR KEYBOARD FIRST 1592 002626 5246 JMP EXIT 1593 002627 6036 KRB /READ BUFFER AND CLEAR FLAG TO FETCH NEXT 1594 002630 0106 AND P177 /IGNORE BLANK AND L-T AND PARITY BIT. 1595 002631 7450 SNA 1596 002632 5246 JMP EXIT 1597 002633 1123 TAD C200 1598 002634 3262 DCA SIN 1599 002635 1262 TAD SIN 1600 002636 1202 TAD MBREAK /MANUAL STOP? 1601 002637 7650 SNA CLA 1602 002640 5340 JMP RECOVR 1603 002641 1034 TAD INBUF /ANY SPACE 1604 002642 7640 SZA CLA 1605 002643 4566 ERROR2 /WILL WAIT FOR OUTPUT BUFFER 1606 002644 1262 TAD SIN 1607 002645 3034 DCA INBUF /SAVE INPUT 1608 002646 6131 EXIT, CLSK /******** 1609 002647 5253 JMP NOCLK /******** 1610 002650 6135 CLSA /******** 1611 002651 7200 CLA /******** 1612 002652 3261 DCA CLKFLG /******** 1613 / 1614 /KW12 CLOCK INTERRUPT ROUTINE 1615 / 1616 002653 6244 NOCLK, RMF 1617 002654 1201 TAD SAVLK 1618 002655 7104 CLL RAL 1619 002656 1200 TAD SAVAC 1620 002657 6001 ION 1621 002660 5400 EXITJ, JMP I 0 /MODIFIED FOR PDP-5 1622 002661 0000 CLKFLG, 0 /******** SET TO 0 EVERY CLOCK INTERRUPT 1623 002662 0000 SIN, 0 1624 002663 3120 OPTR0, IOBUF /OUTPUT POINTERS 1625 002664 3120 OPTRO, IOBUF /VARS 1626 002665 3120 OPTRI, IOBUF 1627 002666 0000 XI33, 0 /VIA (INDEV) 1628 002667 1034 TAD INBUF /ANY INPUT? 1629 002670 7450 SNA /********* REFRESH SCOPE WHILE WAITING 1630 002671 4574 JMS I PWAIT /********* FOR INPUT 1631 002672 3276 DCA XOUTL 1632 002673 3034 DCA INBUF /CLEAR INPUT BUFFER 1633 002674 1276 TAD XOUTL 1634 002675 5666 JMP I XI33 1635 002676 0000 XOUTL, 0 /VIA (OUTDEV) 1636 002677 3266 DCA XI33 /SAVE CURRENT CHARACTER 1637 002700 6001 ION /BE SURE INTERRUPT IS ON. 1638 002701 1664 TAD I OPTRO /ANY ROOM? 1639 002702 7640 SZA CLA /A CHARACTER IS NON-ZERO 1640 002703 4574 JMS I PWAIT /******** REFRESH SCOPE 1641 002704 6002 IOF 1642 002705 1016 TAD TELSW /IN PROGRESS? 1643 002706 7640 SZA CLA 1644 002707 5314 JMP .+5 1645 002710 1266 TAD XI33 /NO 1646 002711 6046 TLS /TYPE CHARACTER 1647 002712 3016 DCA TELSW /SET IN-PROGRESS FLAG. 1648 002713 5323 JMP .+10 /RETURN 1649 002714 1266 TAD XI33 /SEND DATA 1650 002715 3664 DCA I OPTRO 1651 002716 1264 TAD OPTRO /SET POINTERS 1652 002717 7001 IAC 1653 002720 0107 AND P17 1654 002721 1263 TAD OPTR0 1655 002722 3264 DCA OPTRO 1656 002723 6001 ION 1657 002724 5676 JMP I XOUTL 1658 /ERROR RECOVERY PROCEDURE 1659 002725 3326 ERROR5, DCA .+1 /ERROR CALLED FROM A TABLE 1660 002726 0000 ERR2, 0 /LIMIT EXCEEDED 1661 002727 7240 CLA CMA /COMPUTE CALLING ADDRESS (ALSO "SPACE") 1662 002730 1326 TAD ERR2 /AND USE IT AS ERROR NUMBER 1663 002731 3067 DCA LINENO /SAVE ERROR CODE 1664 002732 6001 ION / (JMP .+4) - FOR DEBUGGING 1665 002733 1016 TAD TELSW /WAIT FOR OUTPUT TO FINISH 1666 002734 7640 SZA CLA 1667 002735 5333 JMP .-2 1668 002736 6002 IOF /DISABLE INTERRUPT FOR INITIALIZATIONS 1669 002737 5342 JMP .+3 1670 002740 1123 RECOVR, TAD C200 1671 002741 3067 DCA LINENO /SAVE ERROR NUMBER 1672 002742 2016 ISZ TELSW /* 1673 002743 1105 TAD M20 /SETUP INIT COUNT 1674 002744 3057 DCA CNTR 1675 002745 7040 CMA 1676 002746 1263 TAD OPTR0 1677 002747 3010 DCA AXIN /INIT I/O BUFFERS. 1678 /**** 1679 002750 7000 CDF /(X-MEM RESET) 1680 002751 3410 DCA I AXIN 1681 002752 2057 ISZ CNTR 1682 002753 5351 JMP .-2 1683 002754 3034 DCA INBUF /INIT KEY-BUFR. 1684 002755 1263 TAD OPTR0 /INIT TTY POINTERS. 1685 002756 3265 DCA OPTRI 1686 002757 1263 TAD OPTR0 1687 002760 3264 DCA OPTRO 1688 002761 7040 RECOVX, CMA /PREPARE A STOP BIT FOR TTY 1689 002762 6046 TLS /AND RAISE FLAG. (NOP) - FOR DEBUGGING 1690 002763 1101 TAD P7700 /MAKE A "?". 1691 002764 4551 PRINTC /AND TURN ON THE INTERRUPT 1692 002765 4553 PRNTLN /PRINT ERROR NUMBER AND SPACE 1693 002766 2022 ISZ PC 1694 002767 1422 TAD I PC /UNLESS IT IS ZERO. (X-MEM) 1695 002770 7450 SNA 1696 002771 5377 JMP .+6 1697 002772 3067 DCA LINENO 1698 002773 1101 TAD P7700 /PRINT ATSIGN 1699 002774 4551 PRINTC 1700 002775 4551 PRINTC /PRINT SPACE ?IN AND 1701 002776 4553 PRNTLN /PRINT LINE OF ERROR. 1702 002777 1077 TAD CCR 1703 003000 4551 PRINTC 1704 003001 1126 TAD PTCH /RESET "READC" 1705 003002 3152 DCA RDIV /IF AN ERROR OCCURS. 1706 003003 5177 JMP START /INTERRUPT WILL BE RE-ENABLED. 1707 /CHARACTER REMOVAL ROUTINE 1708 003004 1062 RUB1, TAD XCTIN /RUBOUT ONE LETTER 1709 003005 7640 SZA CLA 1710 003006 5214 JMP .+6 1711 003007 1010 TAD AXIN 1712 003010 7041 CIA 1713 003011 1027 TAD PACKST 1714 003012 7700 SMA CLA /TEST NULL LINE 1715 003013 5641 JMP I RUB5 1716 003014 1251 TAD SPLAT /FOR A RUBOUT ACKNOWLEDGEMENT 1717 003015 4551 PRINTC 1718 003016 1010 TAD AXIN 1719 003017 3071 DCA T2 1720 003020 7000 CDF T /(X-MEM) 1721 003021 2062 ISZ XCTIN /TEST HALF 1722 003022 5242 JMP RUB2 1723 003023 1471 TAD I T2 /"ADD" IS FULL. 1724 003024 0122 AND P77 1725 003025 1103 TAD M77 1726 003026 7640 SZA CLA /TEST FOR EXTEND 1727 003027 5237 JMP RUB4 1728 003030 7040 RUB3, CMA /SET SWITCH 1729 003031 3062 DCA XCTIN 1730 003032 7040 CMA /BACKUP POINTER 1731 003033 1010 TAD AXIN 1732 003034 3010 DCA AXIN 1733 003035 1471 TAD I T2 /RESET ADD 1734 003036 0101 AND P7700 1735 003037 3061 RUB4, DCA QADD 1736 003040 5641 JMP I RUB5 1737 003041 2530 RUB5, PACX 1738 003042 1471 RUB2, TAD I T2 /CHECK FOR EXTENDED 1739 003043 0101 AND P7700 1740 003044 1006 TAD C100 1741 003045 7640 SZA CLA 1742 003046 5230 JMP RUB3 1743 003047 3471 DCA I T2 /SAVE CORRECTION 1744 003050 5231 JMP RUB3+1 1745 003051 0334 SPLAT, 334 1746 /SYMBOL TABLE TYPEOUT ROUTINE 1747 003052 1060 TDUMP, TAD STARTV /INIT POINTER FOR SYMBOL DUMP. (X-MEM) 1748 003053 3030 DCA PT1 1749 003054 1031 TAD LASTV 1750 003055 7041 CIA 1751 003056 1030 TAD PT1 1752 003057 7650 SNA CLA 1753 003060 5541 POPJ 1754 003061 1430 TAD I PT1 /GET THE VARIABLE 1755 003062 3316 DCA OP+1 /(DCA I (4) - FOR (X-MEM)); SAVE NAME 1756 003063 1315 TAD OP /SETUP UNPACK POINTER 1757 003064 3017 DCA AXOUT 1758 003065 3020 DCA XCT 1759 003066 4545 GETC /READ AND PRINT "XX(" 1760 003067 4551 PRINTC 1761 003070 4545 GETC 1762 003071 4551 PRINTC 1763 003072 4545 GETC 1764 003073 4551 PRINTC 1765 003074 2030 ISZ PT1 1766 003075 1430 TAD I PT1 /PRINT SUBSCRIPT TO 99 1767 003076 4714 JMS I PRNT2 1768 003077 4545 GETC /PRINT ")" 1769 003100 4551 PRINTC 1770 003101 2030 ISZ PT1 1771 003102 4407 FINT /PICK UP VARIABLE 1772 003103 0430 FGET I PT1 1773 003104 0000 FXIT 1774 003105 4530 JMS I FOUTPUT /PRINT VALUE 1775 003106 1077 TAD Y 1776 003107 4551 PRINTC 1777 003110 1070 TAD GINC 1778 003111 1111 TAD M2 1779 003112 1030 TAD PT1 1780 003113 5253 JMP TDUMP+1 1781 003114 2442 PRNT2, PRNT 1782 003115 3115 OP, . / (X-MEM) 1783 003116 0000 0000 / (X-MEM) 1784 003117 5051 5051 /(THESE GO IN 10005 FOR X-MEM) 1785 /OUTPUT CHARACTER BUFFER (ADDRESS IS A MULTIPLE OF 20) 1786 IOBUF=3120 1787 COMEIN=IOBUF+20 /COMMAND - INPUT BUFFER 1788 COMEOUT=COMEIN+46 1789 *COMEOUT 1790 003206 0000 FRST, 0 /TEXT POINTER 1791 003207 0000 0000 /DUMMY LINE NUMBER 1792 003210 0340 0340 /"C " /******** 1793 003211 0617 0617 /"FO" 1794 003212 0301 0301 /"CA" 1795 003213 1455 1455 /"L-" /******** 1796 003214 6162 FRSTX, 6162 /"12" /******** 1797 003215 7715 7715 /C.R. 1798 /TO SAVE TEXT, SAVE C(BUFR), C(LASTV), AND (C(FRST) TO C(BUFR)) 1799 /WITH ODT-JR. THE TAPES MAY BE TOGETHER WITH 1800 /THE SYMBOLIC DUMP LAST: FOCAL + FLOAT + DIALOG. 1801 /LOADING THE LAST SECTION MAY BE CONSIDERED OPTIONAL. 1802 BUFBEG=. /TEXT BUFFER STARTS HERE. 1803 /*3600 1804 *4400 1805 004400 2741 O1, RECOVR+1/STARTING ADDRESS 1806 004401 1200 BEGIN, TAD O1 /INITIALIZE ANY 8-FAMILY COMPUTER. 1807 004402 3176 DCA START-1 1808 004403 7000 NOP/(IOPRESET) /******** 1809 004404 4575 JMS I PCLEAR /******** INITIALIZE THE POINT DISPLAY 1810 004405 7300 CLA CLL 1811 004406 3414 DCA I FLTXR 1812 004407 2057 ISZ CNTR/INITIALIZED BY LOAD. 1813 004410 5206 JMP .-2 /CLEAR INPUT BUFFER 1814 004411 7200 T12, CLA /******** FIX UP DIAL I/O ROUTINES 1815 004412 6213 6213/CIF CDF 10 /******** 1816 004413 3667 DCA I G7775 /******** 1817 004414 1262 TAD G5772 /******** 1818 004415 3670 DCA I G7776 /******** 1819 004416 1263 TAD G5773 /******** 1820 004417 3671 DCA I G7777 /******** 1821 004420 6201 6201 /******** 1822 004421 4666 JMS I G7774 /******** 1823 004422 4455 GBLOK /******** 1824 004423 6212 6212/CIF 10 /******** 1825 004424 4664 JMS I G7200 /******** 1826 004425 6211 6211 /******** 1827 004426 2400 2400 /******** 1828 004427 6211 6211 /******** 1829 004430 7400 7400 /******** 1830 004431 0400 400 /******** 1831 004432 6212 6212/CIF 10 /******** 1832 004433 4667 JMS I G7775 /******** WRITE MILDRED INTO UPPER 1833 004434 4451 RITEOU /******** SOURCE WORKING AREA 1834 004435 6132 CLLR /******** INITIALIZE CLOCK 1835 004436 6134 CLEN /******** 1836 004437 7240 CLA CMA /******** 1837 004440 6133 CLAB /******** 1838 004441 1261 TAD G101 /******** 1839 004442 6132 CLLR /******** 1840 004443 6135 CLSA /******** 1841 004444 7200 CLA /******** 1842 004445 6046 TLS /******** 1843 004446 6001 ION /******** 1844 004447 5650 JMP I .+1 /******** ERASE ALL 1845 004450 2216 ERT /******** 1846 004451 0110 RITEOU, 110 /******** 1847 004452 0030 30 /******** 1848 004453 0076 76 /******** 1849 004454 0002 2 /******** 1850 004455 0100 GBLOK, 100 /******** 1851 004456 0025 25 /******** 1852 004457 0023 23 /******** 1853 004460 0001 1 /******** 1854 004461 0101 G101, 101 /******** 1855 004462 5772 G5772, 5772 /******** 1856 004463 5773 G5773, 5773 /******** 1857 004464 7200 G7200, 7200 /******** 1858 004465 7773 G7773, 7773 /******** 1859 004466 7774 G7774, 7774 /******** 1860 004467 7775 G7775, 7775 /******** 1861 004470 7776 G7776, 7776 /******** 1862 004471 7777 G7777, 7777 /******** 1863 *4600+20 1864 004620 1045 FEXP, GETSGN /TAKE ABSOLUTE VALUE 1865 004621 7710 SPA CLA 1866 004622 4724 JMS I NEGP 1867 004623 3033 DCA T3 /C(SIGN)=-1 IF X2 < 0 1868 004624 4407 FINT 1869 004625 4313 FMUL LG2E 1870 004626 6675 FPUT I X2 1871 004627 0000 FEXT 1872 004630 4453 JMS I INTEGER /TAKE INTEGER PART 1873 004631 3325 DCA FLAG2 /SAVE LOW ORDER DATA 1874 004632 4407 FINT 1875 004633 7000 FNOR 1876 004634 6676 FPUT I XSQ2 1877 004635 0675 0675 1878 004636 2676 FSUB I XSQ2 1879 004637 6675 FPUT I X2 1880 004640 4675 FMUL I X2 1881 004641 6676 6676 1882 004642 1310 FADD DF 1883 004643 6326 FPUT TEMP 1884 004644 0305 FGET CF 1885 004645 3326 FDIV TEMP 1886 004646 2675 FSUB I X2 1887 004647 1277 FADD AF 1888 004650 6326 FPUT TEMP 1889 004651 0302 FGET BF 1890 004652 4676 FMUL I XSQ2 1891 004653 1326 FADD TEMP 1892 004654 6326 FPUT TEMP 1893 004655 0675 FGET I X2 1894 004656 3326 FDIV TEMP 1895 004657 4321 FMUL TWO 1896 004660 1316 FADD ONE 1897 004661 0000 FEXT 1898 004662 1325 TAD FLAG2 1899 004663 1044 TAD FLAC 1900 004664 3044 DCA FLAC 1901 004665 2033 ISZ T3 1902 004666 5536 RETURN 1903 004667 4407 FINT 1904 004670 6675 FPUT I X2 1905 004671 0316 0316 1906 004672 3675 FDIV I X2 1907 004673 0000 FEXT 1908 004674 5536 RETURN 1909 /CONSTANTS FOR FEXP 1910 004675 5321 X2, X 1911 004676 5325 XSQ2, XSQR 1912 004677 0004 AF, 0004 1913 004700 2372 2372 1914 004701 1402 1402 1915 004702 7774 BF, 7774 1916 004703 2157 2157 1917 004704 5157 5157 1918 004705 0012 CF, 0012 1919 004706 5454 5454 1920 004707 0343 0343 1921 004710 0007 DF, 0007 1922 004711 2566 2566 1923 004712 5341 5341 1924 004713 0001 LG2E, 0001 1925 004714 2705 2705 1926 004715 2435 2435 1927 004716 0001 ONE, 0001 1928 004717 2000 2000 1929 004720 0000 0000 1930 004721 0002 TWO, 0002 1931 004722 2000 2000 1932 004723 0000 0000 1933 004724 5163 NEGP, FNEG 1934 004725 0000 FLAG2, 0 1935 004726 0000 TEMP, 0 1936 004727 0000 0 1937 004730 0000 0 1938 004731 0000 0 1939 /MAIN ALGORITHM FOR ARCTANGENT 1940 004732 4407 ARCALG, FINT 1941 004733 0675 FGET I X2 1942 004734 4675 FMUL I X2 1943 004735 6676 FPUT I XSQ2 1944 004736 4374 FMUL BET2 1945 004737 1371 FADD BET1 1946 004740 4676 FMUL I XSQ2 1947 004741 1366 FADD BETZ 1948 004742 6326 FPUT TEMP 1949 004743 0363 FGET ALF2 1950 004744 4676 FMUL I XSQ2 1951 004745 1360 FADD ALF1 1952 004746 4676 FMUL I XSQ2 1953 004747 1355 FADD ALFZ 1954 004750 4675 FMUL I X2 1955 004751 3326 FDIV TEMP 1956 004752 0000 FEXT 1957 004753 5754 JMP I .+1 1958 004754 5024 ARCRTN 1959 /CONSTANTS - FLOATING ARC TANGENT 1960 004755 0000 ALFZ, 0 1961 004756 2437 2437 1962 004757 1643 1643 1963 004760 7777 ALF1, 7777 1964 004761 3304 3304 1965 004762 4434 4434 1966 004763 7773 ALF2, 7773 1967 004764 3306 3306 1968 004765 5454 5454 1969 004766 0000 BETZ, 0000 1970 004767 2437 2437 1971 004770 1646 1646 1972 004771 0000 BET1, 0000 1973 004772 2427 2427 1974 004773 2323 2323 1975 004774 7775 BET2, 7775 1976 004775 3427 3427 1977 004776 7052 7052 1978 /FLOATING POINT ARC TANGENT 1979 *5000 1980 005000 1045 ARTN, GETSGN /TAKE ABSOLUTE VALUE 1981 005001 7710 SPA CLA 1982 005002 4363 FMUL FNEG 1983 005003 3033 FDIV T3 1984 005004 4407 FMUL I O360 1985 005005 6635 FPUT I X1 1986 005006 2637 FSUB I CON1 1987 005007 0000 FEXT 1988 005010 1045 TAD HORD 1989 005011 7710 SPA CLA 1990 005012 5221 JMP GO /LESS THAN ONE 1991 005013 4407 FINT 1992 005014 0637 FGET I CON1 1993 005015 3635 FDIV I X1 1994 005016 6635 FPUT I X1 1995 005017 0000 FEXT 1996 005020 7240 CLA CMA 1997 005021 3362 GO, DCA FLAG1 /SIGN FLAG OF RESULT 1998 005022 5623 JMP I .+1 /CALL ALGORITHM 1999 005023 4732 ARCALG 2000 005024 2362 ARCRTN, ISZ FLAG1 /RETURN HERE 2001 005025 5634 JMP I EXIT1 2002 005026 4407 FINT 2003 005027 6635 FPUT I X1 2004 005030 0636 FGET I PI2 2005 005031 2635 FSUB I X1 2006 005032 0000 FEXT 2007 005033 5634 JMP I .+1 2008 005034 5301 EXIT1, EXIT2 2009 /CONSTANTS FOR ARCTANGENT 2010 005035 5321 X1, X 2011 005036 5315 PI2, PIOT 2012 005037 4716 CON1, ONE 2013 005040 1045 FLOG, GETSGN /FLOATING LOGARITHM 2014 005041 7450 SNA 2015 005042 4566 ERROR3 /ZERO ARGUMENT FOR LOG 2016 005043 7710 SPA CLA 2017 005044 4451 JMS I MINSKI 2018 005045 4407 FINT 2019 005046 6756 FPUT I TEM 2020 005047 2637 FSUB I CON1 2021 005050 0000 FEXT 2022 005051 1045 GETSGN 2023 005052 7450 SNA 2024 005053 5536 RETURN 2025 005054 7700 SMA CLA 2026 005055 5264 JMP STARTL 2027 005056 4407 FINT 2028 005057 0637 FGET I CON1 2029 005060 3756 FDIV I TEM 2030 005061 6756 FPUT I TEM 2031 005062 0000 FEXT 2032 005063 7240 CLA CMA 2033 005064 3033 STARTL, DCA T3 2034 005065 1005 TAD P13 2035 005066 3044 DCA FLAC 2036 005067 7040 CMA 2037 005070 1756 TAD I TEM 2038 005071 3045 DCA FLAC+1 2039 005072 3046 DCA FLAC+2 2040 005073 3047 DCA FLAC+3 2041 005074 7001 IAC 2042 005075 3756 DCA I TEM 2043 005076 4407 FINT 2044 005077 4357 FMUL LOG2 2045 005100 6635 FPUT I X1 2046 005101 0756 FGET I TEM 2047 005102 2637 FSUB I CON1 2048 005103 6756 FPUT I TEM 2049 005104 4353 FMUL LOG8 2050 005105 1350 FADD LOG7 2051 005106 4756 FMUL I TEM 2052 005107 1345 FADD LOG6 2053 005110 4756 FMUL I TEM 2054 005111 1342 FADD LOG5 2055 005112 4756 FMUL I TEM 2056 005113 1337 FADD L4 2057 005114 4756 FMUL I TEM 2058 005115 1334 FADD L3 2059 005116 4756 FMUL I TEM 2060 005117 1331 FADD L2 2061 005120 4756 FMUL I TEM 2062 005121 1326 FADD L1 2063 005122 4756 FMUL I TEM 2064 005123 1635 FADD I X1 2065 005124 0000 FEXT 2066 005125 5634 JMP I EXIT1 2067 005126 0000 L1, 0 2068 005127 3777 3777 2069 005130 7742 7742 2070 005131 7777 L2, 7777 2071 005132 4000 4000 2072 005133 4100 4100 2073 005134 7777 L3, 7777 2074 005135 2517 2517 2075 005136 0307 0307 2076 005137 7776 L4, 7776 2077 005140 4113 4113 2078 005141 7211 7211 2079 /LOGARITHM CONSTANTS 2080 005142 7776 LOG5, 7776 2081 005143 2535 2535 2082 005144 3301 3301 2083 005145 7775 LOG6, 7775 2084 005146 4746 4746 2085 005147 0771 0771 2086 005150 7774 LOG7, 7774 2087 005151 2236 2236 2088 005152 4304 4304 2089 005153 7771 LOG8, 7771 2090 005154 4544 4544 2091 005155 1735 1735 2092 005156 4726 TEM, TEMP 2093 005157 0000 LOG2, 0 2094 005160 2613 2613 2095 005161 4414 4414 2096 005162 0000 FLAG1, 0 2097 005163 0000 FNEG, 0 2098 005164 4451 JMS I MINSKI 2099 005165 7240 CLA CMA 2100 005166 5763 JMP I FNEG 2101 005167 6213 LO, 6213/CIF CDF 10 /******** 2102 005170 5126 JMP XLO /******** 2103 005171 6213 LC, 6213/CIF CDF 10 /******** 2104 005172 5130 JMP XLC /******** 2105 005173 6213 LM, 6213/CIF CDF 10 /******** 2106 005174 5132 JMP XLM /******** 2107 005175 6213 LL, 6213/CIF CDF 10 /******** 2108 005176 5134 JMP XLL /******** 2109 /FLOATING POINT SINE AND COSINE 2110 2111 2112 2113 *5177 2114 005177 4407 FCOS, FINT /COS(X)=SIN(/PI/2-X) 2115 005200 6321 FPUT X 2116 005201 0315 FGET PIOT 2117 005202 2321 FSUB X 2118 005203 0000 FEXT 2119 005204 1045 FSIN, GETSGN 2120 005205 7740 SMA SZA CLA 2121 005206 5214 JMP MOD 2122 005207 1045 GETSGN 2123 005210 7700 SMA CLA 2124 005211 5536 RETURN /YES SIN(0) = 0 2125 005212 4451 JMS I MINSKI 2126 005213 7040 CMA /NO: SIN(-X)=-SIN(X) 2127 005214 3033 MOD, DCA T3 2128 /REDUCE X MODULO 2 PI 2129 005215 4407 FINT 2130 005216 3305 FDIV TWOPI 2131 005217 6325 FPUT XSQR 2132 005220 0000 FEXT 2133 005221 4453 JMS I INTEGER 2134 005222 4407 FINT 2135 005223 7000 FNOR 2136 005224 6321 FPUT X 2137 005225 0325 FGET XSQR 2138 005226 2321 FSUB X 2139 005227 4305 FMUL TWOPI 2140 005230 6321 FPUT X 2141 005231 2311 FSUB PI /X < PI ? 2142 005232 0000 FEXT 2143 005233 1045 GETSGN 2144 005234 7710 SPA CLA 2145 005235 5244 JMP PCHECK /YES 2146 005236 4407 FINT /NO, SIN(X-PI) = -SIN(X) 2147 005237 6321 FPUT X 2148 005240 0000 FEXT 2149 005241 1033 TAD T3 /INVERT THE SIGN 2150 005242 7040 CMA 2151 005243 3033 DCA T3 2152 005244 4407 PCHECK, FINT /X < PI/2 ? 2153 005245 0321 FGET X 2154 005246 2315 FSUB PIOT 2155 005247 0000 FEXT 2156 005250 1045 GETSGN 2157 005251 7710 SPA CLA 2158 005252 5260 JMP PALG /YES 2159 005253 4407 FINT /NO 2160 005254 0311 FGET PI /SIN(X) = SIN(PI-X) 2161 005255 2321 FSUB X 2162 005256 6321 FPUT X 2163 005257 0000 FEXT 2164 005260 4407 PALG, FINT 2165 005261 0321 FGET X 2166 005262 3315 FDIV PIOT 2167 005263 6321 FPUT X 2168 005264 4321 FMUL X 2169 005265 6325 FPUT XSQR 2170 005266 0331 FGET C9 2171 005267 4325 FMUL XSQR 2172 005270 1335 FADD C7 2173 005271 4325 FMUL XSQR 2174 005272 1341 FADD C5 2175 005273 4325 FMUL XSQR 2176 005274 1345 FADD C3 2177 005275 4325 FMUL XSQR 2178 005276 1315 FADD PIOT 2179 005277 4321 FMUL X 2180 005300 0000 FEXT 2181 005301 2033 EXIT2, ISZ T3 2182 005302 5536 RETURN 2183 005303 4451 JMS I MINSKI 2184 005304 5536 RETURN 2185 /CONSTANTS AND POINTERS 2186 005305 0003 TWOPI, 0003 2187 005306 3110 3110 2188 005307 3756 3756 2189 005310 3235 3235 2190 005311 0002 PI, 0002 2191 005312 3110 3110 2192 005313 3756 3756 2193 005314 3235 3235 2194 005315 0001 PIOT, 0001 2195 005316 3110 3110 2196 005317 3756 3756 2197 005320 3235 3235 2198 005321 0000 X, 0000 2199 005322 0000 0000 2200 005323 0000 0000 2201 005324 0000 0000 2202 005325 0000 XSQR, 0000 2203 005326 0000 0000 2204 005327 0000 0000 2205 005330 0000 0000 2206 /SINE CONSTANTS 2207 005331 7764 C9, 7764 2208 005332 2401 2401 2209 005333 7015 7015 2210 005334 1042 1042 2211 005335 7771 C7, 7771 2212 005336 5464 5464 2213 005337 5514 5514 2214 005340 6150 6150 2215 005341 7775 C5, 7775 2216 005342 2431 2431 2217 005343 5361 5361 2218 005344 4736 4736 2219 005345 0000 C3, 0000 2220 005346 5325 5325 2221 005347 0414 0414 2222 005350 3167 3167 2223 /END OF EXTENDED FUNCTIONS 2224 / 2225 /HANDLES O I, EXPRESSION 2226 /SETS CLOCK ACCORDING TO EXPRESSION 2227 / 2228 005351 4540 SETCLK, PUSHJ /******** 2229 005352 1612 EVAL-1 /******** 2230 005353 4407 FINT /******** 2231 005354 4375 FMUL MHUNDRD /******** 2232 005355 0000 FEXT /******** 2233 005356 6132 CLLR /******** 2234 005357 6134 CLEN /******** 2235 005360 4453 JMS I INTEGER /******** 2236 005361 6133 CLAB /******** 2237 005362 7200 CLA /******** 2238 005363 1006 TAD C100 /******** 2239 005364 6132 CLLR /******** 2240 005365 1123 TAD C200 /******** 2241 005366 6134 CLEN /******** 2242 005367 1374 TAD O4600 /******** 2243 005370 6132 CLLR /******** 2244 005371 7200 CLA /******** 2245 005372 5773 JMP I .+1 /******** 2246 005373 0611 PROC /******** 2247 005374 4600 O4600, 4600 /******** 2248 005375 0007 MHUNDRD,7;4700;0 /******** 005376 4700 005377 0000 2249 /PAGE 1 - INPUT/OUTPUT ROUTINES FOR THE FOCAL 2250 /FLOATING POINT PACKAGE. 2251 /IN THE COMMENTS BELOW: 2252 / F = NUMBER OF DIGITS TO BE OUTPUT = FISW 2253 / D = NUMBER OF DECIMAL PLACES = DECP 2254 / E = DECIMAL EXPONENT = BEXP 2255 / P = NUMBER OF PLACES REMAINING TO BE 2256 / PRINTED BEFORE DECIMAL POINT 2257 *5400 2258 DIGITS=6 /NUMBER OF DECIMAL DIGITS OUT 2259 005400 0000 TGO, 0 2260 005401 3334 DCA SCOUNT /SAVE MAX. NUMBER OF DIGITS AVAILABLE - *SET COUNTS* 2261 005402 1052 TAD FISW 2262 005403 4557 RTL6 2263 005404 0122 AND P77 2264 005405 3032 DCA T1 2265 005406 1032 TAD T1 2266 005407 7041 CIA /NO, COMPUTE FIELD SIZES 2267 005410 7450 SNA 2268 005411 1326 TAD MD 2269 005412 3335 DCA FCOUNT 2270 005413 1052 TAD FISW /(JMP FPRNT) = FOR NO ROUNDING. 2271 005414 7450 SNA /FLOATING OUTPUT? 2272 005415 5241 JMP R6 /YES, ROUND OFF TO MAX. NO. OF PLACES 2273 005416 0122 AND P77 2274 005417 3333 DCA DECP 2275 005420 1335 TAD FCOUNT 2276 005421 1333 TAD DECP 2277 005422 7510 SPA / F-D > 0 ? 2278 005423 5230 JMP .+5 /YES 2279 005424 7240 CLA CMA /NO. 2280 005425 1032 TAD T1 2281 005426 3333 DCA DECP /MAKE D = F-1 2282 005427 7040 CMA 2283 005430 1033 TAD T3 /COMPARE DECIMAL EXPONENT 2284 005431 7500 SMA / F-D > E ? 2285 005432 7200 CLA /NO, ROUND OFF TO .F PLACES 2286 005433 1032 TAD T1 /YES 2287 005434 7510 SPA / D+E < 0 ? 2288 005435 5263 JMP FPRNT-2 /YES, NO ROUNDING NEEDED. GO TO PRINT 2289 005436 1326 TAD MD /NO, ROUND TO D+E PLACES, 2290 005437 7500 SMA /TO A MAXIMUM OF D PLACES 2291 005440 7200 CLA 2292 005441 1327 R6, TAD RND2 / *ROUND UP* 2293 005442 3071 DCA T2 /SAVE NUMBER+1 OF PLACES TO ROUND TO. 2294 005443 1731 TAD I BUFST 2295 005444 1071 TAD T2 /SET UP BUFFER ADDRESS AT WHICH 2296 005445 3336 DCA PLCE /ROUNDING SHOULD START 2297 005446 1071 TAD T2 2298 005447 7041 CIA /SET UP COUNT OF MAXIMUM NUMBER 2299 005450 3071 DCA T2 /OF CARRIES ALLOWABLE 2300 005451 1325 TAD K5 /LITTLE EXTRA ON FIRST DIGIT. 2301 005452 2736 RET, ISZ I PLCE /ADD ONE TO DIGIT AT CURRENT POSITION 2302 005453 1736 TAD I PLCE 2303 005454 1330 TAD OM12 2304 005455 7710 SPA CLA /CARRY REQUIRED? 2305 005456 5265 JMP FPRNT /NO, GO TO OUTPUT 2306 005457 3736 DCA I PLCE /YES, MAKE CURRENT DIGIT ZERO 2307 005460 2071 ISZ T2 /BEGINNING OF BUFFER REACHED? 2308 005461 5321 JMP DECR /NO, DECREMENT BUFFER ADDRESS AND REPEAT 2309 005462 2736 ISZ I PLCE /YES, SET MANTISSA TO 0.1 2310 005463 2033 ISZ T3 /COMPENSATE BY INCREMENTING EXPONENT 2311 005464 7200 CLA 2312 005465 1052 FPRNT, TAD FISW /AUTO-INDEX REGISTER ALREADY SET. - *PRINT* 2313 005466 7650 SNA CLA / F = 0 ? 2314 005467 5356 JMP FLOUT /YES, OUTPUT AS FLOATING NUMBER 2315 005470 1335 TAD FCOUNT 2316 005471 1033 TAD T3 2317 005472 7540 SMA SZA / E > F ? 2318 005473 5355 JMP FLOUT-1 /YES, CONVERT TO E FORMAT 2319 005474 1333 TAD DECP 2320 005475 7500 SMA / E < F-D ? 2321 005476 7200 CLA /NO, TAKE P = E 2322 005477 7041 CIA /YES, TAKE P = F-D 2323 005500 1033 TAD T3 2324 005501 7041 CIA 2325 005502 3032 DCA T1 /SET UP MINUS P 2326 005503 1033 BACK, TAD T3 /PRINT DD.DDD 2327 005504 1032 TAD T1 2328 005505 7650 SNA CLA / P = E ? 2329 005506 5343 JMP DIG /YES, PRINT DIGIT 2330 005507 1032 TAD T1 /NO. 2331 005510 7001 IAC 2332 005511 7710 SPA CLA / P > 1 ? 2333 005512 1105 TAD M20 /YES, TAKE SPACE (240-260); OTHERWIZE ZERO 2334 005513 4336 IN, JMS OUTA /PRINT CHARACTER 2335 005514 2032 ISZ T1 /P CHARACTERS PRINTED? 2336 005515 5303 JMP BACK /NO 2337 005516 1102 TAD PER /YES. 2338 005517 4551 PRINTC /PRINT DECIMAL POINT 2339 005520 5303 JMP BACK 2340 005521 7040 DECR, CMA /BACKUP TO TOP OF BUFFER. 2341 005522 1336 TAD PLCE 2342 005523 3336 DCA PLCE 2343 005524 5252 JMP RET 2344 005525 0005 K5, 5 2345 005526 7772 MD, -DIGITS 2346 005527 0007 RND2, DIGITS+1 2347 005530 7766 OM12, -12 2348 005531 6150 BUFST, SADR 2349 005532 6154 OPUT, OUTDG 2350 005533 0000 DECP, 0 /MODIFIABLE LOCATIONS 2351 005534 0000 SCOUNT, 0 2352 005535 0000 FCOUNT, 0 2353 PLCE=. 2354 005536 0000 OUTA, 0 /MODIFIED REGISTERS. 2355 005537 4732 JMS I OPUT /PRINT CHARACTER 2356 005540 2335 ISZ FCOUNT /F CHARACTERS PRINTED? 2357 005541 5736 JMP I OUTA /NO, RETURN 2358 005542 5600 JMP I TGO /YES, NUMBER FINISHED 2359 005543 7040 DIG, CMA 2360 005544 1033 TAD T3 /REDUCE E, BY 1 2361 005545 3033 DCA T3 2362 005546 2334 ISZ SCOUNT /ARE ALL SIG. FIGS. USED? 2363 005547 5353 JMP .+4 /NO 2364 005550 7040 CMA /YES. 2365 005551 3334 DCA SCOUNT /RESET COUNT TO -1 2366 005552 5313 JMP IN /AND LEAVE C(AC) = 0 2367 005553 1414 TAD I FLTXR /TAKE NEXT DIGIT FROM BUFFER 2368 005554 5313 JMP IN 2369 /DO FLOATING OUTPUT 2370 005555 7200 CLA /IF OUTPUT TOO LARGE. 2371 005556 4732 FLOUT, JMS I OPUT /PRINT "0" 2372 005557 1102 TAD PER 2373 005560 4551 PRINTC /PRINT "." 2374 005561 2200 ISZ TGO /SECOND RETURN 2375 005562 1414 TAD I FLTXR /TAKE NEXT DIGIT FROM BUFFER 2376 005563 4336 JMS OUTA /PRINT IT 2377 005564 2334 ISZ SCOUNT /TEST FOR END OF INPUT 2378 005565 5362 JMP .-3 /AND REPEAT 2379 005566 7040 CMA 2380 005567 3334 DCA SCOUNT /OUTPUT EXTRA ZEROS. 2381 005570 5363 JMP .-5 2382 005571 0000 ABSOLV, 0 2383 005572 1045 TAD HORD 2384 005573 3050 DCA SIGNF 2385 005574 1045 TAD HORD 2386 005575 7710 SPA CLA 2387 005576 4451 JMS I MINSKI 2388 005577 5771 JMP I ABSOLV 2389 /DOUBLE PRECISION DECIMAL-BINARY 2390 /INPUT AND CONVERSION FOR + OR - XXX... 2391 *5600 2392 005600 0000 DECONV, 0 2393 005601 3046 DCA LORD 2394 005602 3044 DCA EXP /ZERO THE EXPONENT AND 2395 005603 3045 DCA HORD /INITIALIZE FLOATING AC. 2396 005604 3047 DCA OVER2 2397 005605 3314 DCA DNUMBR 2398 005606 3050 DCA SIGNF 2399 005607 1066 TAD CHAR /ALLOW KEYBOARD SIGN CHECKS. 2400 005610 1264 TAD MPLUS 2401 005611 7450 SNA 2402 005612 5220 JMP .+6 /+SIGN; GET NEXT 2403 005613 1111 TAD M2 /CHECK - SIGN 2404 005614 7640 SZA CLA 2405 005615 5221 JMP .+4 2406 005616 7040 CMA /INIT SIGN CHECK TO POS. 2407 005617 3050 DCA SIGNF 2408 005620 4666 JMS I XINPUT /GET NEXT 2409 005621 1066 TAD CHAR /A SPACE PERHAPS? 2410 005622 1265 TAD MSPACE 2411 005623 7650 SNA CLA 2412 005624 5220 JMP .-4 2413 005625 4227 JMS DECON 2414 005626 5600 JMP I DECONV 2415 005627 0000 DECON, 0 2416 005630 1066 TAD CHAR /TEST LEAD CHARACTER FOR TERMINATOR 2417 005631 1262 TAD MINE 2418 005632 7650 SNA CLA 2419 005633 5627 JMP I DECON /E 2420 005634 4561 TESTN 2421 005635 5627 JMP I DECON /. 2422 005636 5247 JMP DTST /OTHER 2423 005637 1054 TAD SORTCN /N 2424 005640 3313 DSAVE, DCA DIGIT /YES 2425 005641 4267 JMS MULT10 /REMAIN MUST =0 SINCE OVERFLOW IS CHECKED 2426 005642 2314 ISZ DNUMBR /COUNT DIGITS 2427 005643 7640 SZA CLA 2428 005644 4566 ERROR2 /INPUT-OVERFLOW ERROR 2429 005645 4666 JMS I XINPUT 2430 005646 5230 JMP DECON+1 /CONTINUE 2431 005647 1066 DTST, TAD CHAR /ALLOW A-Z 2432 005650 1112 TAD MINUSA 2433 005651 7710 SPA CLA 2434 005652 5627 JMP I DECON 2435 005653 1066 TAD CHAR 2436 005654 1263 TAD MINUSZ 2437 005655 7740 SZA SMA CLA 2438 005656 5627 JMP I DECON /USE SIX BITS OF ASCII 2439 005657 1066 TAD CHAR 2440 005660 0122 AND P77 2441 005661 5240 JMP DSAVE 2442 005662 7473 MINE, -305 /(7532) - FOR AMPERSAND 2443 005663 7446 MINUSZ, -332 2444 005664 7525 MPLUS, -253 2445 005665 7540 MSPACE, -240 2446 005666 0756 XINPUT, INPUT 2447 005667 0000 MULT10, 0 /ROUTINE TO MULTIPLY FLAC BY TEN (10) 2448 005670 1047 TAD OVER2 2449 005671 3043 DCA OVER1 2450 005672 1046 TAD LORD /DOUBLE PRECISION WORD 2451 005673 3042 DCA AC1L /BY TEN (DECIMAL) 2452 005674 1045 TAD HORD /REMAIN=REMAINDER 2453 005675 3041 DCA AC1H 2454 005676 3312 DCA REMAIN /CLEAR OVERFLOW WORD 2455 005677 4315 JMS MULT2 /CALL SUBROUTINE TO 2456 005700 4315 JMS MULT2 /MULTIPLY BY TWO 2457 005701 4333 JMS DUBLAD /CALL DOUBLE ADD 2458 005702 4315 JMS MULT2 2459 005703 1313 TAD DIGIT /ADD LAST DIGIT RECEIVED 2460 005704 3043 DCA OVER1 2461 005705 3042 DCA AC1L 2462 005706 3041 DCA AC1H 2463 005707 4333 JMS DUBLAD 2464 005710 1312 TAD REMAIN /EXIT WITH REMAINDER 2465 005711 5667 JMP I MULT10 /IN AC 2466 005712 0000 REMAIN, 0 2467 005713 0000 DIGIT, 0 /STORAGE FOR DIGIT 2468 005714 0000 DNUMBR, 0 /=NUMBER OF DIGITS 2469 005715 0000 MULT2, 0 /MULTIPLY OVER2, LORD, HORD BY 2 2470 005716 1047 TAD OVER2 2471 005717 7104 CLL RAL /CARRY INSERT BIT IS IN LINK 2472 005720 3047 DCA OVER2 2473 005721 1046 TAD LORD 2474 005722 7004 RAL 2475 005723 3046 DCA LORD 2476 005724 1045 TAD HORD 2477 005725 7004 RAL 2478 005726 3045 DCA HORD 2479 005727 1312 TAD REMAIN 2480 005730 7004 RAL 2481 005731 3312 DCA REMAIN 2482 005732 5715 JMP I MULT2 2483 005733 0000 DUBLAD, 0 /TRIPLE PRECISION ADDITION 2484 005734 7300 CLA CLL 2485 005735 1047 TAD OVER2 2486 005736 1043 TAD OVER1 2487 005737 3047 DCA OVER2 2488 005740 7004 RAL 2489 005741 1046 TAD LORD 2490 005742 1042 TAD AC1L 2491 005743 3046 DCA LORD 2492 005744 7004 RAL 2493 005745 1045 TAD HORD 2494 005746 1041 TAD AC1H 2495 005747 3045 DCA HORD 2496 005750 7004 RAL 2497 005751 1312 TAD REMAIN /WITH OVERFLOW 2498 005752 3312 DCA REMAIN 2499 005753 5733 JMP I DUBLAD 2500 005754 0000 DIV1, 0 /SHIFT OPERAND RIGHT 2501 005755 7300 CLA CLL /TRIPLE PRECISION 2502 005756 1041 TAD AC1H 2503 005757 7510 SPA 2504 005760 7120 CLL CML 2505 005761 7010 RAR 2506 005762 3041 DCA AC1H 2507 005763 1042 TAD AC1L 2508 005764 7010 RAR 2509 005765 3042 DCA AC1L 2510 005766 1043 TAD OVER1 2511 005767 7010 RAR 2512 005770 3043 DCA OVER1 2513 005771 2040 ISZ EX1 2514 005772 5754 JMP I DIV1 2515 005773 5754 JMP I DIV1 2516 005774 4566 FSSERR, ERROR4 /********( SUBSCRIPT ERROR FOR FILE VARIABLE-OR NOT DEFINED) 2517 *6000 2518 /FLOATING OUTPUT CONVERSION ROUTINE 2519 006000 0000 FLOUTP, 0 2520 006001 7610 SKP CLA /******** GETS RID OF = IN PRINTOUT 2521 LMODE 2522 006002 6377 OPTR, 6377 /******** 2523 PMODE 2524 006003 1045 TAD HORD /NUMBER > 0 ? 2525 006004 7700 SMA CLA 2526 006005 1334 TAD SMSP /PRINT "-" OR A SPACE 2527 006006 1336 TAD SMIN 2528 006007 4551 PRINTC 2529 006010 4753 JMS I ABSOL2 2530 006011 3033 FGO2, DCA T3 /INITIALIZE DECIMAL EXPONENT 2531 006012 1044 TAD EXP /IS EXP 0 TO 4? 2532 006013 7510 SPA 2533 006014 5227 JMP FGO3 /TOO LARGE; MULTIPLY BY 1/10 2534 006015 7440 SZA 2535 006016 1341 TAD M4 2536 006017 7750 SNA SPA CLA 2537 006020 5234 JMP FGO4 2538 006021 4407 FINT 2539 006022 4744 FMUL I PPTEN 2540 006023 0000 FEXT 2541 006024 7001 IAC 2542 006025 1033 TAD T3 2543 006026 5211 JMP FGO2 2544 006027 4407 FGO3, FINT 2545 006030 4752 FMUL I TENPT 2546 006031 0000 FEXT 2547 006032 7040 CMA 2548 006033 5225 JMP .-6 2549 006034 3745 FGO4, DCA I DPT /MULTIPLY BY TWO TO POSITION BIT 0 2550 006035 3746 DCA I REPT /CLEAR OVERFLOW WORD 2551 006036 1350 TAD SADR /INIT BUFFER POINTER 2552 006037 3014 DCA FLTXR 2553 006040 1044 TAD EXP /COMPUT BITS IN 1ST DIGIT 2554 006041 7140 CMA CLL 2555 006042 3354 DCA OUTDG /TEMP COUNT 2556 006043 1343 TAD DCOUNT /SETUP COUNT OF TOTAL OUTPUT 2557 006044 3044 DCA EXP 2558 006045 4527 JMS I DOUBLE /ROTATE OUT THE 1ST 4 BITS 2559 006046 2354 ISZ OUTDG 2560 006047 5245 JMP .-2 2561 006050 1746 TAD I REPT /TEST FOR 10-15, 0, 1-9 2562 006051 7450 SNA 2563 006052 5270 JMP FGO5 /IGNORE FIRST ZERO 2564 006053 1342 TAD FM12 2565 006054 7710 SPA CLA 2566 006055 5264 JMP .+7 /0-9 2567 006056 7001 IAC 2568 006057 3414 DCA I FLTXR /OUTPUT A 1 2569 006060 2044 ISZ EXP /COUNT THE DIGIT 2570 006061 1342 TAD FM12 /CORRECT REMAINDER 2571 006062 2033 ISZ T3 /BUMP DECIMAL EXPONENT 2572 006063 7000 NOP 2573 006064 1746 TAD I REPT /COMPUT RESULTANT OR SECOND DIGIT 2574 006065 2033 ISZ T3 2575 006066 7000 NOP 2576 006067 7410 SKP 2577 006070 4747 FGO5, JMS I M10PT /IE. .672X10 = 6 + .72, ETC. 2578 006071 3414 DCA I FLTXR 2579 006072 2044 ISZ EXP /ALL DIGITS OUTPUT? 2580 006073 5270 JMP .-3 /NO; CONTINUE 2581 006074 1350 TAD SADR /INIT BUFFER POINTER 2582 006075 3014 DCA FLTXR 2583 006076 1343 TAD DCOUNT 2584 006077 4751 JMS I ROUND /OUTPUT MANTISSA 2585 006100 5600 JMP I FLOUTP /FIXED POINT DONE 2586 006101 1333 TAD CHRT /PRINT "E" 2587 006102 4551 PRINTC 2588 /OUTPUT THE EXPONENT 2589 006103 1033 TAD T3 /TAKE ABSOLUTE VALUE OF EXPONENT 2590 006104 7510 SPA 2591 006105 7041 CIA 2592 006106 3045 DCA HORD /SAVE * POWER 2593 006107 1033 TAD T3 /PRINT SIGN 2594 006110 7700 SMA CLA 2595 006111 1111 TAD M2 2596 006112 1336 TAD SMIN 2597 006113 4551 PRINTC 2598 006114 1045 TAD HORD 2599 006115 2044 ISZ EXP 2600 006116 1337 TAD M144 2601 006117 7500 SMA 2602 006120 5315 JMP .-3 2603 006121 1340 TAD C144 2604 006122 3045 DCA HORD /SAVE TENS AND UNITS 2605 006123 7040 CMA /OUTPUT HUNDREDS 2606 006124 1044 TAD EXP 2607 006125 7440 SZA /UNLESS ZERO 2608 006126 4354 JMS OUTDG 2609 006127 1045 TAD HORD /PRINT TWO DIGITS 2610 006130 4732 JMS I PRNTI 2611 006131 5600 JMP I FLOUTP 2612 006132 2442 PRNTI, PRNT 2613 006133 0305 CHRT, 305 /E (0246) - FOR AMPERSAND 2614 006134 7763 SMSP, 240-255 / 2615 006135 0275 PEQ, 275 2616 006136 0255 SMIN, 255 2617 006137 7634 M144, -144 /-100 2618 006140 0144 C144, 0144 /+100 2619 006141 7774 M4, -4 2620 006142 7766 FM12, -12 2621 006143 7771 DCOUNT, -DIGITS-1 /NUMBER OF DIGITS OUTPUT 2622 006144 6275 PPTEN, PTEN /1E1 2623 006145 5713 DPT, DIGIT 2624 006146 5712 REPT, REMAIN /OVERFLOW FROM INTEGER MULTIPLY 2625 006147 5667 M10PT, MULT10 2626 006150 7467 SADR, BUFFER-1 2627 006151 5400 ROUND, TGO /ACTUAL OUTPUT ROUTINE 2628 006152 6271 TENPT, TEN 2629 006153 5571 ABSOL2, ABSOLV 2630 006154 0000 OUTDG, 0 /OUTPUT ONE DIGIT 2631 006155 1113 TAD C260 2632 006156 4551 PRINTC 2633 006157 5754 JMP I OUTDG 2634 006160 7750 RANMUL, 7750;2333;5733 /******** 006161 2333 006162 5733 2635 006163 1167 LEPUT, TAD SUBS2 /******** CALLS STORING ROUTINE FOR 2636 006164 3171 DCA SUBS /******** S FN(X)= 2637 006165 1170 TAD LESUB2 /******** 2638 006166 3173 DCA LESUBS /******** 2639 006167 1002 TAD LWETMP /******** 2640 006170 6212 6212/CIF 10 /******** 2641 006171 4775 JMS I STORIT /******** 2642 006172 2407 ISZ I 7 /******** 2643 006173 5774 JMP I .+1 /******** 2644 006174 6401 FPNT+1 /******** 2645 006175 2000 STORIT, ITSTOR /******** 2646 006176 6213 LS, 6213/CIF CDF 10 /******** LIBRARY SAVE 2647 006177 5136 JMP XLS /******** 2648 /USED BY 8K 2649 /FLOATING POINT INPUT 2650 *6200 2651 006200 0000 FLINTP, 0 /IF C(AC) = 0, USE CHAR 2652 006201 7640 SZA CLA /IF C(AC) NON-ZERO, GET NEXT 2653 006202 4706 JMS I XIN /GET FIRST CHAR 2654 006203 1066 TAD CHAR /IGNORE LEADING SPACES 2655 006204 1114 TAD M240 2656 006205 7650 SNA CLA 2657 006206 5202 JMP .-4 2658 006207 4702 JMS I DPCVPT /READ FIRST DIGIT GROUP 2659 006210 1066 TAD CHAR /AND SET "SIGNF" 2660 006211 1115 TAD MPER 2661 006212 7640 SZA CLA /ENDED BY PERIOD? 2662 006213 5221 JMP FIG01 2663 006214 4706 JMS I XIN /READ 2ND GROUP 2664 006215 3705 DCA I DPN 2665 006216 4703 JMS I DCONP 2666 006217 1705 TAD I DPN /SAVE NUMBER OF DIGITS IN T3 2667 006220 7041 CMA IAC 2668 006221 3033 FIG01, DCA T3 /NO. 2669 006222 1310 TAD P43 2670 006223 3044 DCA FLAC 2671 006224 4704 JMS I RESOL5 2672 006225 4707 JMS I INORM /NORMALIZE FIRST. THEN 2673 006226 4407 FINT 2674 006227 6430 FPUT I PT1 /SAVE NUMBER 2675 006230 0000 FEXT 2676 006231 1066 TAD CHAR 2677 006232 1301 TAD MINUSE 2678 006233 7640 SZA CLA /"E" READ IN? 2679 006234 5246 JMP ENDFI+3 /NO 2680 006235 4706 JMS I XIN /YES. READ 3RD DIGIT GROUP 2681 006236 4702 JMS I DPCVPT /I.E. CONVERT DECIMAL EXPONENT 2682 006237 4704 JMS I RESOL5 2683 006240 1047 TAD OVER2 2684 006241 1033 TAD T3 /C(SEXP) PLACES TO RIGHT 2685 006242 3033 DCA T3 2686 /COMPENSATE FOR DECIMAL EXPONENTS 2687 006243 4407 ENDFI, FINT /RESTORE MANTISSA 2688 006244 0430 FGET I PT1 2689 006245 0000 FEXT 2690 006246 1033 TAD T3 /TEST DECIMAL EXPONENT 2691 006247 7450 SNA 2692 006250 5600 JMP I FLINTP /FINISHED 2693 006251 7700 SMA CLA 2694 006252 5261 JMP FIG04 2695 006253 4407 FINT /. IS TO THE LEFT 2696 006254 4275 FMUL PTEN /TIMES .1000 2697 006255 6430 FPUT I PT1 2698 006256 0000 FEXT 2699 006257 7001 IAC 2700 006260 5266 JMP .+6 2701 006261 4407 FIG04, FINT /. IS TO THE RIGHT 2702 006262 4271 FMUL TEN /MULTIPLY BY 10 2703 006263 6430 FPUT I PT1 2704 006264 0000 FEXT 2705 006265 7040 CMA 2706 006266 1033 TAD T3 2707 006267 3033 DCA T3 2708 006270 5246 JMP ENDFI+3 2709 006271 0004 TEN, 0004 2710 006272 2400 2400 2711 006273 0000 0000 2712 006274 0000 0000 2713 006275 7775 PTEN, 7775 2714 006276 3146 3146 2715 006277 3147 3147 /(3146) - FOR 4-WORD 2716 006300 3150 3150 2717 006301 7473 MINUSE, -305 /(7532) - FOR AMPERSAND 2718 006302 5600 DPCVPT, DECONV 2719 006303 5627 DCONP, DECON 2720 006304 7173 RESOL5, RESOLV 2721 006305 5714 DPN, DNUMBR 2722 006306 0756 XIN, INPUT 2723 006307 7335 INORM, DNORM 2724 006310 0043 P43, 43 2725 /END OF FLOATING POINT INPUT 2726 /7 FREE 2727 /USED BY H.S. READER 2728 2729 2730 2731 / 2732 /CALLS LOADING ROUTINE FOR FILE 2733 /VARIABLES IN EXPRESSIONS; CALLED BY EFUN3I 2734 / 2735 *6311 /******** 2736 006311 1066 FNUM, TAD CHAR /******** 2737 006312 3056 DCA EFOP /******** 2738 006313 4545 GETC /******** 2739 006314 4550 SORTC /******** 2740 006315 1771 TERMS-1 /******** 2741 006316 7410 SKP /******** 2742 006317 5313 JMP .-4 /******** 2743 006320 4562 TSTLPR /******** 2744 006321 4566 ERROR4 /******** 2745 006322 4734 JMS I PECALL /******** 2746 006323 4453 JMS I INTEGER /******** 2747 006324 3171 DCA SUBS /******** 2748 006325 1045 TAD HORD /******** 2749 006326 3173 DCA LESUBS /******** 2750 006327 1413 POPA /******** 2751 006330 6212 6212/CIF 10 /******** FILE NO. 2752 006331 4733 JMS I LOADIT /******** 2753 006332 5536 JMP I EFUN3I /******** 2754 006333 1542 LOADIT, ITLOAD /******** 2755 006334 1601 PECALL, ECALL /******** 2756 006335 0000 PASS, 0 2757 006336 4545 GETC 2758 006337 1066 TAD CHAR 2759 006340 4542 PUSHA 2760 006341 4545 GETC 2761 006342 4550 SORTC 2762 006343 1374 GLIST-1 2763 006344 5735 JMP I PASS 2764 006345 5341 JMP .-4 2765 006346 4335 LTAPE, JMS PASS 2766 006347 1066 TAD CHAR /******** 2767 006350 1374 TAD MINCOM /******** 2768 006351 7640 SZA CLA /******** 2769 006352 5357 JMP LERR /******** 2770 006353 1413 POPA /******** 2771 006354 4547 SORTJ /******** JMPS ON SUBCOMMAND OF LIBR XXXX 2772 006355 6365 LLIST-1 /******** 2773 006356 7772 LGO-LLIST /******** 2774 006357 4566 LERR, ERROR4 /******** 2775 006360 5167 LGO, LO /******** 2776 006361 5171 LC /******** 2777 006362 5173 LM /******** 2778 006363 5175 LL /******** 2779 006364 6176 LS /******** 2780 006365 6375 LG /******** 2781 006366 0317 LLIST, 317 /******** 2782 006367 0303 303 /******** 2783 006370 0315 315 /******** 2784 006371 0314 314 /******** 2785 006372 0323 323 /******** 2786 006373 0307 307 /******** 2787 006374 7524 MINCOM, -254 /******** 2788 006375 6213 LG, 6213 /******** 2789 006376 5140 JMP XLG 2790 *6400 2791 / FLOATING POINT INTERPRETER FOR FOCAL. 2792 006400 0000 FPNT, 0 2793 006401 7300 CLA CLL 2794 006402 3047 DCA OVER2 /(NOP) - FOR 4-WORD 2795 006403 3043 DCA OVER1 /(NOP) - FOR 4-WORD 2796 006404 1600 TAD I FPNT /GET NEXT INSTRUCTION 2797 006405 7450 SNA 2798 006406 5600 JMP I FPNT /FAST EXIT 2799 006407 3264 DCA JUMP 2800 006410 1264 TAD JUMP 2801 006411 0123 AND C200 /GET PAGE BIT 2802 006412 7650 SNA CLA /PAGE ZERO? 2803 006413 5216 JMP .+3 /YES 2804 006414 1104 TAD P7600 /NO 2805 006415 0200 AND FPNT /C(FPNT)0-4 CONTAINS PAGE BITS 2806 006416 3040 DCA ADDR 2807 006417 1106 TAD P177 /GET 7 BIT ADDRESS 2808 006420 0264 AND JUMP 2809 006421 1040 TAD ADDR 2810 006422 3040 DCA ADDR 2811 006423 1265 TAD INDRCT /INDIRECT BIT=1? 2812 006424 0264 AND JUMP 2813 006425 7650 SNA CLA 2814 006426 5233 JMP LOOP01 /NO - GO ON 2815 006427 1440 TAD I ADDR /YES; DEFER, W/O AUTO-INDEX 2816 006430 7450 SNA /******** IF PT1 WAS ZERO, IT IS A 2817 006431 5572 JMP I LEFPUT /******** FILE VARIABLE 2818 006432 3040 DCA ADDR 2819 006433 2200 LOOP01, ISZ FPNT 2820 006434 7040 CMA 2821 006435 1040 TAD ADDR 2822 006436 3015 DCA FLTXR2 2823 006437 1264 TAD JUMP /GET COMMAND 2824 006440 7106 CLL RTL 2825 006441 7006 RTL 2826 006442 0107 AND P17 /GET BITS 0-2: IE OPCODE 2827 006443 7450 SNA 2828 006444 5271 JMP FLGT 2829 006445 1266 TAD TABLE /LOOKUP IN TABLE 2830 006446 3264 DCA JUMP 2831 006447 1664 TAD I JUMP 2832 006450 7450 SNA 2833 006451 5267 JMP FLPT 2834 006452 3264 DCA JUMP 2835 006453 1306 TAD CEX1 /SAVE FLOATING ARGUMENT, UNLESS 'GET' OR 'PUT' 2836 006454 3014 DCA FLTXR 2837 006455 1117 TAD MFLT 2838 006456 3057 DCA CNTR 2839 006457 1415 TAD I FLTXR2 2840 006460 3414 DCA I FLTXR 2841 006461 2057 ISZ CNTR 2842 006462 5257 JMP .-3 2843 006463 5664 JMP I JUMP /GO THERE 2844 006464 0000 JUMP, 0 2845 ADDR=EX1 2846 006465 0400 INDRCT, 0400 2847 006466 6575 TABLE, ITABLE 2848 006467 1305 FLPT, TAD CEXP /EXP TO (ADDR) 2849 006470 5275 JMP .+5 2850 006471 1305 FLGT, TAD CEXP /(ADDR) TO EXP 2851 006472 3015 DCA FLTXR2 2852 006473 7040 CMA 2853 006474 1040 TAD ADDR 2854 006475 3014 DCA FLTXR /SAVE 'FROM' ADDRESS 2855 006476 1117 TAD MFLT /3 OR 4 WORDS 2856 006477 3057 DCA CNTR 2857 006500 1414 TAD I FLTXR 2858 006501 3415 DCA I FLTXR2 2859 006502 2057 ISZ CNTR 2860 006503 5300 JMP .-3 2861 006504 5201 JMP FPNT+1 2862 006505 0043 CEXP, EXP-1 2863 006506 0037 CEX1, EX1-1 2864 006507 4767 FLSU, JMS I OPMINS /FSUB=2 - NEGATE THE OPERAND 2865 006510 4772 FLAD, JMS I ALGN /FADD=1 - FIRST ALIGN EXPONENTS 2866 006511 5201 JMP FPNT+1 /RETURN IF NO ALIGNMENT IS POSSIBLE 2867 006512 4774 JMS I RAR2 /TRIPLE PRECISION ADDITION 2868 006513 4773 JMS I RAR1 /SINCE BITS ARE SHIFTED 2869 006514 4775 JMS I TRAD /RIGHT 2870 006515 4771 NORF, JMS I NORM /NORMALIZE THE RESULT 2871 006516 5201 JMP FPNT+1 /HINT; USE 700X FOR FUNCTIONS. 2872 /INTERPRETIVE POWER 2873 006517 1045 FLEX, TAD HORD /ZERO? 2874 006520 7640 SZA CLA 2875 006521 5327 JMP .+6 2876 006522 3044 ZERO, DCA EXP /YES 2877 006523 3045 DCA HORD 2878 006524 3046 DCA LORD 2879 006525 3047 DCA OVER2 2880 006526 5201 JMP FPNT+1 2881 006527 4543 PUSHF /AC TO A + POWER 2882 006530 0044 FLAC 2883 006531 4543 PUSHF /SETUP ARGUMENT (THE EXPONENT) 2884 006532 0040 EX1 2885 006533 4544 POPF 2886 006534 0044 FLAC 2887 006535 4453 JMS I INTEGER /ONLY POSITIVE INTEGER EXPONENTS 2888 006536 7510 SPA 2889 006537 5344 JMP .+5 /(COULD DIVIDE) 2890 006540 7040 CMA 2891 006541 3264 DCA JUMP /TEMP STORAGE 2892 006542 3043 DCA OVER1 /(NOP) FOR 4-WORD 2893 006543 1045 TAD HORD 2894 006544 7640 SZA CLA 2895 006545 4566 ERROR2 /TOO LARGE OR NEGATIVE EXPONENT 2896 006546 4543 PUSHF /INITIALIZE TO ONE. 2897 006547 2405 FLTONE 2898 006550 4544 POPF 2899 006551 0044 FLAC 2900 006552 4544 POPF 2901 006553 7470 ITER1 2902 006554 5362 JMP .+6 2903 006555 4543 PUSHF 2904 006556 7470 ITER1 2905 006557 4544 POPF 2906 006560 0040 EX1 2907 006561 4770 JMS I MULT /"MULT" 2908 006562 2264 ISZ JUMP 2909 006563 5355 JMP .-6 2910 006564 5201 JMP FPNT+1 2911 006565 4770 FLMY, JMS I MULT /"MULTIPLY" 2912 006566 5201 JMP FPNT+1 2913 006567 7153 OPMINS, MINUS2 2914 006570 7004 MULT, DMULT 2915 006571 7335 NORM, DNORM 2916 006572 6623 ALGN, ALIGN 2917 006573 5754 RAR1, DIV1 2918 006574 6757 RAR2, DIV2 2919 006575 5733 TRAD, DUBLAD 2920 ITABLE=.-1 2921 006576 6510 FLAD 2922 006577 6507 FLSU 2923 006600 7107 FLDV 2924 006601 6565 FLMY 2925 006602 6517 FLEX 2926 006603 0000 0000 2927 006604 6515 NORF 2928 006605 0000 ACMINS, 0 /ROUTINE TO COMPLEMENT FLAC - VIA "MINSKI" 2929 006606 7200 CLA /********(IS THIS CLA NECESSARY?) 2930 006607 1047 TAD OVER2 /******** RECODING FOR SPACE 2931 006610 7161 CLL CML CIA /******** 2932 006611 3047 DCA OVER2 /******** 2933 006612 7004 RAL /******** 2934 006613 1046 TAD LORD /******** 2935 006614 7061 CML CIA /******** 2936 006615 3046 DCA LORD /******** 2937 006616 7004 RAL /******** 2938 006617 1045 TAD HORD /******** 2939 006620 7061 CML CIA /******** 2940 006621 3045 DCA HORD /******** 2941 006622 5605 JMP I ACMINS 2942 006623 0000 ALIGN, 0 /SUBROUTINE TO ALIGN 2943 006624 1045 TAD HORD /BINARY POINTS 2944 006625 7450 SNA 2945 006626 1046 TAD LORD /IS MANTISSA ZERO? 2946 006627 7650 SNA CLA 2947 006630 5311 JMP NOX1 /YES. RESULT=OPERAND 2948 006631 1041 TAD AC1H /NO, IS OPERAND ZERO? 2949 006632 7450 SNA 2950 006633 1042 TAD AC1L 2951 006634 7450 SNA 2952 006635 1043 TAD OVER1 2953 006636 7650 SNA CLA 2954 006637 5623 JMP I ALIGN /YES. EXIT. 2955 006640 1040 TAD EX1 2956 006641 7041 CMA IAC 2957 006642 1044 TAD EXP 2958 006643 7450 SNA /ARE EXPONENTS EQUAL? 2959 006644 5273 JMP ADONE /YES 2960 006645 3205 DCA ACMINS 2961 006646 1205 TAD ACMINS 2962 006647 7500 SMA /NO 2963 006650 7041 CIA /NEGATE AND 2964 006651 3322 DCA AMOUNT /SAVE THE DIFFERENCE 2965 006652 1322 TAD AMOUNT 2966 006653 1336 TAD TEST2 2967 006654 7710 SPA CLA /CAN EXPONENTS BE ALIGNED? 2968 006655 5275 JMP NOX /NO. USE LARGER OF THE TWO. 2969 006656 1205 TAD ACMINS /YES, SHIFT THE SMALLER 2970 006657 7700 SMA CLA 2971 006660 5265 JMP ASHFT 2972 006661 4357 JMS DIV2 2973 006662 2322 ISZ AMOUNT 2974 006663 5261 JMP .-2 2975 006664 5273 JMP ADONE 2976 006665 7040 ASHFT, CMA 2977 006666 1040 TAD EX1 2978 006667 3040 DCA EX1 2979 006670 4723 JMS I TAG1 2980 006671 2322 ISZ AMOUNT 2981 006672 5270 JMP .-2 2982 006673 2223 ADONE, ISZ ALIGN 2983 006674 5623 JMP I ALIGN 2984 006675 1040 NOX, TAD EX1 /MISSION IMPOSSIBLE! 2985 006676 7700 SMA CLA /CHECK FOR SIGN DIFFERENCE 2986 006677 5304 JMP NOX2 2987 006700 1044 TAD EXP 2988 006701 7700 SMA CLA 2989 006702 5623 JMP I ALIGN /-+ 2990 006703 5306 JMP .+3 /-- 2991 006704 1044 NOX2, TAD EXP 2992 006705 7700 SMA CLA 2993 006706 1205 TAD ACMINS /TEMP STORAGE OF DIFFERENCE. BOTH POS EXP OR BOTH NEG. 2994 006707 7740 SMA SZA CLA 2995 006710 5623 JMP I ALIGN /OK (+-) 2996 006711 1040 NOX1, TAD EX1 /USE LARGER 2997 006712 3044 DCA EXP 2998 006713 1041 TAD AC1H 2999 006714 3045 DCA HORD 3000 006715 1042 TAD AC1L 3001 006716 3046 DCA LORD 3002 006717 1043 TAD OVER1 3003 006720 3047 DCA OVER2 3004 006721 5623 JMP I ALIGN 3005 006722 0000 AMOUNT, 0 3006 006723 5754 TAG1, DIV1 3007 /LEAVE 12 BIT ANSWER IN AC UPON RETURN 3008 /LEAVE FLAC AS AN INTEGER. 3009 006724 0000 FIX, 0 /VIA (INTEGER) 3010 006725 4751 JMS I ABSOL 3011 006726 1044 TAD EXP /TEST FOR FRACTION 3012 006727 7750 SPA SNA CLA 3013 006730 5353 JMP FIXM /DOUBLE CHECK FOR MINUS ONE. 3014 006731 7001 IAC 3015 006732 3043 DCA OVER1 3016 006733 1350 TAD P27 /INIT ALIGNMENT 3017 006734 3040 DCA EX1 3018 006735 4223 JMS ALIGN /DO THE ALIGNMENT TO AN INTEGER 3019 006736 0027 TEST2, 0027 /ALREAD DONE; (43) - FOR 4-WORD 3020 006737 2047 ISZ OVER2 3021 006740 5344 JMP .+4 3022 006741 2046 ISZ LORD 3023 006742 7410 SKP 3024 006743 2045 ISZ HORD 3025 006744 3047 DCA OVER2 /CLEAR THE FRACTION 3026 006745 4752 JMS I RESOL 3027 006746 1046 TAD LORD /EXIT WITH LOW ORDER RESULT IN AC 3028 006747 5724 JMP I FIX 3029 006750 0027 P27, 27 3030 006751 5571 ABSOL, ABSOLV 3031 006752 7173 RESOL, RESOLV 3032 006753 3044 FIXM, DCA EXP /CLEAR EXPONENT 3033 006754 3045 DCA HORD 3034 006755 3046 DCA LORD 3035 006756 5344 JMP TEST2+6 3036 006757 0000 DIV2, 0 /SHIFT FLAC RIGHT 3037 006760 7300 CLA CLL 3038 006761 1045 TAD HORD 3039 006762 7510 SPA 3040 006763 7020 CML 3041 006764 7010 RAR 3042 006765 3045 DCA HORD 3043 006766 1046 TAD LORD 3044 006767 7010 RAR 3045 006770 3046 DCA LORD 3046 006771 1047 TAD OVER2 3047 006772 7010 RAR 3048 006773 3047 DCA OVER2 3049 006774 2044 ISZ EXP 3050 006775 5757 JMP I DIV2 3051 006776 5757 JMP I DIV2 3052 SPECIAL=. /INPUT CHARACTERS 3053 006777 0337 337 /LEFT ARROW 3054 007000 0377 377 /RUBOUT 3055 007001 0212 212 /L.F. 3056 007002 0375 375 /ALT MODE 3057 007003 7777 -1 3058 /(A+B+C)*(D+E+F) = A*D, A*E, B*D, E*E 3059 007004 0000 DMULT, 0 /N-PRECISION MULTIPLY WITH 3060 007005 7001 IAC /PRODUCT IN TRIPLE PRECISION 3061 007006 1040 TAD EX1 /ADD EXPONENTS+1 3062 007007 4324 JMS SIGN /AND DETERMINE SIGN OF RESULT 3063 007010 7710 SPA CLA 3064 007011 4353 JMS MINUS2 3065 007012 3301 DCA DATUM-1 /INITIALIZE RESULT 3066 007013 3300 DCA DATUM-2 3067 007014 3277 DCA DATUM-3 3068 007015 3276 DCA DATUM-4 3069 007016 1045 TAD A /A*D 3070 007017 3751 SAVE /STORE IN MP2 3071 007020 1041 TAD D /SIGNLE PRECISION MULTIPLY 3072 007021 4752 MULTY 3073 007022 0002 2 /ACCUMULATE STARTING IN #2 DATA WORD 3074 007023 1042 TAD E /A*E 3075 007024 4752 MULTY 3076 007025 0003 3 3077 007026 1046 TAD B /B*D 3078 007027 3751 SAVE 3079 007030 1041 TAD D 3080 007031 4752 MULTY 3081 007032 0003 3 3082 007033 1042 TAD E /B*E 3083 007034 4752 MULTY 3084 007035 0004 4 3085 007036 5263 DMULT4, JMP DMDONE /(DCA DATUM+5) FOR 4-WORD 3086 007037 3274 DCA DATUM-6 3087 007040 1043 TAD F /A*F 3088 007041 3751 SAVE 3089 007042 1045 TAD A 3090 007043 4752 MULTY 3091 007044 0004 4 3092 007045 1046 TAD B /B*F 3093 007046 4752 MULTY 3094 007047 0005 5 3095 007050 1047 TAD C /C*D 3096 007051 3751 SAVE 3097 007052 1041 TAD D 3098 007053 4752 MULTY 3099 007054 0004 4 3100 007055 1042 TAD E /C*E 3101 007056 4752 MULTY 3102 007057 0005 5 3103 007060 1043 TAD F /C*F 3104 007061 4752 MULTY 3105 007062 0006 6 3106 007063 1301 DMDONE, TAD DATUM-1 /COPY RESULT 3107 007064 3045 DCA HORD 3108 007065 1300 TAD DATUM-2 3109 007066 3046 DCA LORD 3110 007067 1277 TAD DATUM-3 3111 007070 3047 DCA OVER2 3112 007071 4301 JMS MULDIV 3113 007072 3047 DCA OVER2 /(NOP) FOR 4-WORD 3114 007073 5604 JMP I DMULT 3115 DATUM=.+6 /INTERMEDIATE STORAGE 3116 007074 0000 0/#6 - LOW ORDER RESULT 3117 007075 0000 0/#5 3118 007076 0000 0/#4 3119 007077 0000 0/#3 3120 007100 0000 0/#2 3121 /#1 - HIGH ORDER RESULT 3122 007101 0000 MULDIV, 0 /TERMINATE MULTIPLY AND DIVIDE. 3123 007102 2050 ISZ SIGNF /CORRECT FOR SIGN 3124 007103 4451 JMS I MINSKI 3125 007104 4747 JMS I NORMF /SHIFT LEFT 3126 007105 2047 ISZ OVER2/NOP /* 3127 007106 5701 JMP I MULDIV 3128 007107 1041 FLDV, TAD AC1H /4:DIVIDE 3129 007110 7650 SNA CLA 3130 007111 4566 ERROR2 /DIVISION BY ZERO 3131 007112 1040 TAD EX1 /SUBTRACT EXPONENTS+1 3132 007113 7041 CMA IAC 3133 007114 7001 IAC 3134 007115 4324 JMS SIGN /SET UP SIGNS 3135 007116 7700 SMA CLA 3136 007117 4353 JMS MINUS2 /NEGATE DIVISOR 3137 007120 4750 JMS I DIVIDE /DIVIDE 3138 007121 4301 JMS MULDIV 3139 007122 5723 JMP I .+1 3140 007123 6401 FPNT+1 3141 /THIS SUBROUTINE PREPARES MULTIPLY AND DIVIDE 3142 /FOR ANY COMBINATION OF SIGNED ARGUMENTS AND FOR ZERO. 3143 /THE RESULT OF EITHER IS ZERO IF FLAC = 0. 3144 /RESULT OF MULTIPLY IS ZERO IF EITHER IS ZERO; 3145 /DIVISION BY ZERO IS CHECKED BEFORE THIS 3146 /ROUTINE IS CALLED. 3147 /THE CALLING AC CONTAINS AN UPDATE VALUE FOR THE 3148 /EXPONENT. THE RETURNING AC CONTAINS THE SIGN OF 3149 /THE ARGUMENT FOR FURTHER TESTING BY EACH ROUTINE. 3150 007124 0000 SIGN, 0 /TEST AND SAVE SIGN OF RESULT 3151 007125 1044 TAD EXP /COMPUT NEW EXPONENT FOR MUL-DIV. 3152 007126 3044 DCA EXP 3153 007127 1124 TAD P4000 /LOAD 4000 TO XOR THE SIGN BITS 3154 007130 0045 AND HORD 3155 007131 1041 TAD AC1H 3156 007132 7700 SMA CLA /RESULT MAY BE ZERO 3157 007133 7040 CMA 3158 007134 3050 DCA SIGNF 3159 007135 1045 TAD HORD 3160 007136 7450 SNA 3161 007137 5746 JMP I REVIT /ANSWER IS ZERO. 3162 007140 7710 SPA CLA /TAKE ABSOLUTE VALUE OF FLAC 3163 007141 4451 JMS I MINSKI 3164 007142 1041 TAD AC1H 3165 007143 7450 SNA /RESULT EITHER WAY MAY BE ZERO 3166 007144 5746 JMP I REVIT 3167 007145 5724 JMP I SIGN 3168 /SIGN OF RESULT - SIGNF 3169 /+=-1 3170 /-=0 3171 007146 6522 REVIT, ZERO 3172 007147 7335 NORMF, DNORM 3173 007150 7261 DIVIDE, DUBDIV 3174 SAVE=DCA I . 3175 007151 7256 MP2 3176 MULTY=JMS I . 3177 007152 7200 MP4 3178 A=FLAC+1 3179 B=FLAC+2 3180 C=FLAC+3 3181 D=AC1H 3182 E=AC1L 3183 F=OVER1 3184 007153 0000 MINUS2, 0 /NEGATE OPERAND 3185 007154 7300 CLA CLL /TRIPLE PRECISION 3186 007155 1043 TAD OVER1 3187 007156 7041 CMA IAC 3188 007157 3043 DCA OVER1 3189 007160 1042 TAD AC1L 3190 007161 7040 CMA 3191 007162 7430 SZL 3192 007163 7101 IAC CLL 3193 007164 3042 DCA AC1L 3194 007165 1041 TAD AC1H 3195 007166 7040 CMA 3196 007167 7430 SZL 3197 007170 7101 IAC CLL 3198 007171 3041 DCA AC1H 3199 007172 5753 JMP I MINUS2 3200 007173 0000 RESOLV, 0 3201 007174 1050 TAD SIGNF 3202 007175 7710 SPA CLA 3203 007176 4451 JMS I MINSKI 3204 007177 5773 JMP I RESOLV 3205 *7200 3206 007200 0000 MP4, 0 /SINGLE PRECISION. UNSIGNED MULTIPLY - "MULTY" 3207 007201 7450 SNA /NO RESULT ADDED IF ZERO 3208 007202 5600 JMP I MP4 3209 /FOR EAE INSERT THE FOLLOWING: 3210 /7203 3206 DCA .*3 3211 /7204 1256 TAD MP2 3212 /7205 7425 MQL MUY 3213 /7206 0000 0 3214 /7207 3253 DCA MP5 3215 /7210 7501 MOA 3216 /7211 3255 DCA MP3 3217 /7212 5227 JMP ,*15 3218 007203 3254 DCA MP1 /12 BITS BY 12 BITS 3219 007204 3253 DCA MP5 3220 007205 1257 TAD THIR 3221 007206 3255 DCA MP3 3222 007207 7100 CLL 3223 007210 1254 MP6, TAD MP1 3224 007211 7010 RAR 3225 007212 3254 DCA MP1 3226 007213 1253 TAD MP5 3227 007214 7420 SNL 3228 007215 5220 JMP .+3 3229 007216 7100 CLL 3230 007217 1256 TAD MP2 3231 007220 7010 RAR 3232 007221 3253 DCA MP5 /SAVE HIGH ORDER RESULT 3233 007222 2255 ISZ MP3 3234 007223 5210 JMP MP6 3235 007224 1254 TAD MP1 /CORRECT LOW ORDER RESULT 3236 007225 7010 RAR 3237 007226 3255 DCA MP3 3238 007227 1600 TAD I MP4 /PICK UP SCALE FACTOR 3239 007230 7041 CIA 3240 007231 1252 TAD DATUMA /COMPUTE ADDRESS 3241 007232 3254 DCA MP1 /TEMP 3242 007233 1255 TAD MP3 /LOW ORDER PART 3243 007234 7100 CLL 3244 007235 1654 TAD I MP1 /ACCUMULATE 3245 007236 3654 DCA I MP1 3246 007237 2254 ISZ MP1 3247 007240 7004 RAL 3248 007241 1253 TAD MP5 3249 007242 1654 TAD I MP1 3250 007243 3654 DCA I MP1 3251 007244 7420 SNL 3252 007245 5600 JMP I MP4 /NO CARRY 3253 007246 2254 ISZ MP1 3254 007247 2654 ISZ I MP1 3255 007250 5600 JMP I MP4 /EXIT 3256 007251 5246 JMP .-3 /CARRY AGAIN 3257 ///// 3258 007252 7102 DATUMA, DATUM 3259 007253 0000 MP5, 0 /PRODUCT 3260 007254 0000 MP1, 0 /MULTIPLIER 3261 007255 0000 MP3, 0 3262 007256 0000 MP2, 0 /MULTIPLICAND 3263 007257 7764 THIR, -14 /12 BITS 3264 007260 7751 MIF, -27 /(-43) FOR 4-WORD (=7735) 3265 007261 0000 DUBDIV, 0 /2 OR 3 PRECISION DIVIDE 3266 007262 3200 DCA MP4 3267 007263 3254 DCA MP1 3268 007264 1260 TAD MIF /INIT BIT COUNTER 3269 007265 3255 DCA MP3 3270 007266 7410 SKP 3271 007267 4527 DV3, JMS I DOUBLE /SHIFT FLAC LEFT 3272 007270 7100 CLL 3273 007271 1042 TAD AC1L /COMBINE ONE POSITION AND (4-WORD) 3274 007272 1046 TAD LORD 3275 007273 3256 DCA MP2 /SAVE RESULT 3276 007274 7004 RAL 3277 007275 1045 TAD HORD /ADD OVERFLOW 3278 007276 1041 TAD AC1H 3279 007277 7420 SNL /SKIP IFOVERFLOW 3280 007300 5304 JMP .+4 3281 007301 3045 DCA HORD /UPDATE FLAC 3282 007302 1256 TAD MP2 3283 007303 3046 DCA LORD 3284 007304 7200 CLA /CLEAR ACCUMULATOR 3285 007305 1254 TAD MP1 /SAVE OVERFLOW BITS CIRCULARLY 3286 007306 7004 RAL 3287 007307 3254 DCA MP1 3288 007310 1200 TAD MP4 3289 007311 7004 RAL 3290 007312 3200 DCA MP4 3291 007313 2255 ISZ MP3 /TEST FOR END OF DIVIDE 3292 007314 5267 JMP DV3 3293 007315 1254 TAD MP1 /LOAD RESULTS 3294 007316 3046 DCA LORD 3295 007317 1200 TAD MP4 3296 007320 3045 DCA HORD 3297 007321 5661 JMP I DUBDIV /(NOP) FOR 4-WORD 3298 007322 7004 RAL /EXTRA FOR 4-WORD 3299 007323 3335 DCA DNORM 3300 007324 2255 ISZ MP3 /TEST FOR END OF DIVIDE 3301 007325 5267 JMP DV3 3302 007326 1335 TAD DNORM 3303 007327 3045 DCA HORD 3304 007330 1200 TAD MP4 3305 007331 3046 DCA LORD 3306 007332 1254 TAD MP1 3307 007333 3047 DCA OVER2 3308 007334 5661 JMP I DUBDIV 3309 007335 0000 DNORM, 0 /SUBROUTINE TO NORNALIZE FLAC 3310 007336 4775 JMS I ABSOL3 3311 007337 4366 JMS TEST4 3312 007340 1045 TAD HORD 3313 007341 7450 SNA /IS MANTISSA = 0? 3314 007342 1047 TAD OVER2 3315 007343 7450 SNA 3316 007344 1046 TAD LORD 3317 007345 7650 SNA CLA 3318 007346 5363 JMP EXIT3 /YES 3319 007347 1045 TAD HORD 3320 007350 7104 CLL RAL 3321 007351 7710 SPA CLA /WILL SHIFT BE TOO FAR? 3322 007352 5360 JMP .+6 3323 007353 4527 JMS I DOUBLE 3324 007354 7140 CMA CLL 3325 007355 1044 TAD EXP 3326 007356 3044 DCA EXP 3327 007357 5347 JMP .-10 3328 007360 4776 JMS I RESOL3 3329 007361 4366 JMS TEST4 /DON'T LEAVE 4000 3330 007362 5735 JMP I DNORM 3331 007363 3044 EXIT3, DCA EXP /SET TO ZERO 3332 007364 5735 JMP I DNORM 3333 007365 6757 XRAR2, DIV2 3334 007366 0000 TEST4, 0 3335 007367 1045 TAD HORD /TEST FOR 4000 3336 007370 7510 SPA 3337 007371 7041 CIA 3338 007372 7710 SPA CLA 3339 007373 4765 JMS I XRAR2 /SHIFT BACK 3340 007374 5766 JMP I TEST4 3341 007375 5571 ABSOL3, ABSOLV 3342 007376 7173 RESOL3, RESOLV 3343 *7400 3344 /PAGE 18 3345 /FLOATING SQUARE ROOT FUNCTION 3346 007400 4407 XSQRT, FINT 3347 007401 6274 FPUT FPAC1 /VALUE 3348 007402 0000 FEXT /NEWTON'S METHOD IS USED 3349 007403 1045 GETSGN 3350 007404 7710 SPA CLA 3351 007405 4566 ERROR2 /NUMBER IS NEGATIVE=IMAGINARY ROOTS 3352 007406 1044 TAD EXP /LINK IS =0 FROM FINT 3353 007407 7510 SPA /MATCH THE SIGN WITH LINK BIT 3354 007410 7020 CML 3355 007411 7010 RAR 3356 007412 3270 DCA ITER1 /MAKE FIRST APPROXIMATION 3357 007413 7430 SZL /TEST LSB OF EXP 3358 007414 2270 ISZ ITER1 3359 007415 7000 O7000, NOP /******** 3360 007416 1267 TAD SQCON1 3361 007417 3271 DCA ITER1+1 3362 007420 3272 DCA ITER1+2 3363 007421 3273 DCA ITER1+3 3364 007422 1275 TAD FPAC1+1 3365 007423 7450 SNA 3366 007424 1276 TAD FPAC1+2 3367 007425 7650 SNA CLA 3368 007426 5265 JMP SQEND /NUMBER=0 3369 007427 4407 CLCU, FINT 3370 007430 0274 FGET FPAC1 3371 007431 3270 FDIV ITER1 3372 007432 1270 FADD ITER1 3373 007433 0000 FEXT 3374 007434 7240 CLA CMA 3375 007435 1044 TAD EXP 3376 007436 3044 DCA EXP 3377 007437 1044 TAD EXP 3378 007440 7041 CMA IAC 3379 007441 1270 TAD ITER1 3380 007442 7640 SZA CLA /ARE EXPONENTS EQUAL? 3381 007443 5261 JMP ROOTGO /NO 3382 007444 1045 TAD HORD /ARE HIGH-ORDER MANTISSAS EQUAL? 3383 007445 7041 CMA IAC 3384 007446 1271 TAD ITER1+1 3385 007447 7640 SZA CLA 3386 007450 5261 JMP ROOTGO /NO 3387 007451 1046 TAD LORD 3388 007452 7041 CMA IAC 3389 007453 1272 TAD ITER1+2 /DO LOW-ORDER MANTISSAS AGREE 3390 007454 7500 SMA 3391 007455 7041 CMA IAC /WITHIN ONE BIT? 3392 007456 7001 IAC 3393 007457 7700 SMA CLA 3394 007460 5536 RETURN 3395 007461 4407 ROOTGO, FINT 3396 007462 6270 FPUT ITER1 3397 007463 0000 FEXT 3398 007464 5227 JMP CLCU 3399 007465 3044 SQEND, DCA EXP 3400 007466 5536 RETURN 3401 007467 3015 SQCON1, 3015 3402 BUFFER=. 3403 007470 0000 ITER1, 0 3404 007471 0000 0 3405 007472 0000 0 3406 007473 0000 0 3407 007474 0000 FPAC1, 0 3408 007475 0000 0 3409 007476 0000 0 3410 007477 7503 BUFFER+13 /ADDRESS OF NEXT FREE LOCATION IN 10-DIGIT VERSION. 3411 /*7530 /******** 3412 007500 0000 SCOPOU, 0 /******** OUTPUT ROUTINE FOR SCOPE 3413 007501 0106 AND P177 /******** STORES CHARS IN FLD1, LOCS 400-777 3414 007502 1367 TAD O7763 /******** 3415 007503 7440 SZA /******** 3416 007504 5310 JMP NOCRLF /******** 3417 007505 3364 CRLF, DCA NCOLS /******** 3418 007506 2365 ISZ NFEEDS /******** 3419 007507 5321 JMP ITSOK /******** 3420 007510 1371 NOCRLF, TAD O7655 /******** 3421 007511 7100 CLL /******** 3422 007512 1006 TAD C100 /******** 3423 007513 7420 SNL /******** 3424 007514 7610 SKP CLA /******** 3425 007515 1361 TAD NLINES /******** 3426 007516 7450 SNA /******** 3427 007517 5700 JMP I SCOPOU /******** 3428 007520 2364 ISZ NCOLS /******** 3429 007521 6002 ITSOK, IOF /******** 3430 007522 6141 LINC /******** 3431 LMODE /******** 3432 007523 0644 LDF 4 /******** 3433 007524 1362 STH I OPTR /******** 3434 007525 0011 CLR /******** 3435 007526 0002 PDP /******** 3436 PMODE /******** 3437 007527 6201 6201 /******** 3438 007530 2366 ISZ NCHARS /******** 3439 007531 1366 TAD NCHARS /******** 3440 007532 1215 TAD O7000 /******** 3441 007533 7710 SPA CLA /******** 3442 007534 1361 TAD NLINES /******** 3443 007535 1365 TAD NFEEDS /******** 3444 007536 7710 SPA CLA /******** 3445 007537 5356 JMP NOHANG /******** 3446 007540 1366 TAD NCHARS /******** 3447 007541 6213 6213 /******** TOO MANY LINES/CHARS DISPLAYED 3448 007542 4020 JMS WAITER /******** HANG ON DISPLAY UNTIL SOMETHING IS TYPED 3449 007543 6031 KSF /******** 3450 007544 5340 JMP .-4 /******** 3451 007545 6034 KRS /******** 3452 007546 1372 TAD O7575 /******** 3453 007547 7640 SZA CLA /******** 3454 007550 6032 KCC /******** IGNORE LINE FEED 3455 007551 1370 TAD O6377 /******** 3456 007552 3774 DCA I PPTR /******** CLEAR 3457 007553 3366 DCA NCHARS /******** THE 3458 007554 3365 DCA NFEEDS /******** CHARACTER 3459 007555 3364 DCA NCOLS /******** DISPLAY 3460 007556 6001 NOHANG, ION /******** 3461 007557 1364 TAD NCOLS /******** 3462 007560 1373 TAD O7716 /******** 3463 007561 7740 NLINES, SMA SZA CLA /******** 3464 007562 5305 JMP CRLF /******** 3465 007563 5700 JMP I SCOPOU /******** 3466 007564 0000 NCOLS, 0 /******** 3467 007565 0000 NFEEDS, 0 /******** 3468 007566 0000 NCHARS, 0 /******** 3469 007567 7763 O7763, 7763 3470 007570 6377 O6377, 6377 3471 007571 7655 O7655, 7655 /******** 3472 007572 7575 O7575, 7575 /******** 3473 007573 7716 O7716, 7716 /******** 3474 007574 6002 PPTR, OPTR /******** 3475 *7576 /******** 3476 / 3477 /FDIS FUNCTION: STORES 2 WORDS 3478 /PER CALL IN 2200 THRU 5777 IN FLD1 3479 / 3480 007576 4453 CALLIN, JMS I INTEGER /******** 3481 007577 6213 6213 /******** 3482 007600 5601 JMP I .+1 /******** 3483 007601 2071 INCALL /******** 3484 007602 4407 XDISP, FINT /******** 3485 007603 4252 FMUL FORHUN /******** 3486 007604 0000 FEXT /******** 3487 007605 4453 JMS I INTEGER /******** 3488 007606 7510 SPA /******** 3489 007607 7041 CIA /******** 3490 007610 3350 DCA STEMP /******** 3491 007611 1066 TAD CHAR /******** 3492 007612 1257 TAD MMCOM /******** 3493 007613 7640 SZA CLA /******** 3494 007614 4566 ERROR3 /******** 3495 007615 4540 PUSHJ /******** 3496 007616 1612 EVAL-1 /******** 3497 007617 4407 FINT /******** 3498 007620 4254 FMUL FIVHUN /******** 3499 007621 0000 FEXT /******** 3500 007622 4453 JMS I INTEGER /******** 3501 007623 3351 DCA STEMP2 /******** 3502 007624 6002 IOF /******** 3503 007625 6211 6211 /******** 3504 007626 1350 TAD STEMP /******** 3505 007627 3672 DCA I SPTR /******** 3506 007630 2272 ISZ SPTR /******** 3507 007631 1351 TAD STEMP2 /******** 3508 007632 1251 TAD O7400 /******** 3509 007633 3672 DCA I SPTR /******** 3510 007634 2272 ISZ SPTR /******** 3511 007635 1272 TAD SPTR /******** 3512 007636 1250 TAD MLIMIT /******** 3513 007637 7650 SNA CLA /******** 3514 007640 7344 CLA CLL CMA RAL /******** 3515 007641 1272 TAD SPTR /******** 3516 007642 3272 DCA SPTR /******** 3517 007643 7240 CLA CMA /******** 3518 007644 3672 DCA I SPTR /******** 3519 007645 6201 6201/CDF 0 /******** 3520 007646 6001 ION /******** 3521 007647 5536 JMP I EFUN3I /******** 3522 007650 2000 MLIMIT, -6000 /******** LAST LOC OF DISP POINTS-1 3523 007651 7400 O7400, 7400 /******** 3524 007652 0011 FORHUN, 11;2700 /******** 007653 2700 3525 007654 0011 FIVHUN, 11;3770;0 /******** 007655 3770 007656 0000 3526 007657 7524 MMCOM, -254 /******** 3527 / 3528 /JMS WAIT IS EQUIVALENT 3529 /TO JMP .-2 WITH A REFRESH OF 3530 /THE DISPLAY ON THE WAY 3531 / 3532 007660 0000 WAIT, 0 /******** 3533 007661 7346 CLA CLL CMA RTL /******** 3534 007662 1260 TAD WAIT /******** 3535 007663 3260 DCA WAIT /******** 3536 007664 6002 IOF /******** 3537 007665 1733 TAD I PNCHARS /******** 3538 007666 6213 6213/CIF CDF 10 /******** 3539 007667 4020 JMS WAITER /******** 3540 007670 6001 ION /******** 3541 007671 5660 JMP I WAIT /******** 3542 007672 1000 SPTR, 1000 /******** 3543 007673 0000 CLEAR, 0 /******** CLEAR POINTS FROM THE SCOPE 3544 007674 1305 TAD ODISSP /******** 3545 007675 3272 DCA SPTR /******** 3546 007676 6002 IOF /******** 3547 007677 6211 6211/CDF 10 /******** 3548 007700 7240 CLA CMA /******** 3549 007701 3672 DCA I SPTR /******** 3550 007702 6201 6201/CDF 0 /******** 3551 007703 6001 ION /******** 3552 007704 5673 JMP I CLEAR /******** 3553 007705 2200 ODISSP, 2200 /******** FIRST LOC OF DISP POINTS 3554 007706 6335 PPASS, PASS /******** 3555 007707 4706 OUTPUT, JMS I PPASS /******** 3556 007710 1413 POPA /******** JUMPS ON SUBCOMMAND OF OUTPUT XXX 3557 007711 4547 SORTJ /******** 3558 007712 7722 OLIST-1 /******** 3559 007713 7772 OGO-OLIST /******** 3560 007714 4566 OERROR, ERROR3 /******** 3561 007715 7752 OGO, OC /******** 3562 007716 7761 OD /******** 3563 007717 7753 OE /******** 3564 007720 7763 OS /******** 3565 007721 7771 OT /******** 3566 007722 7735 OI /******** 3567 007723 0303 OLIST, 303 /******** 3568 007724 0304 304 /******** 3569 007725 0305 305 /******** 3570 007726 0323 323 /******** 3571 007727 0324 324 /******** 3572 007730 0311 311 /******** 3573 007731 6377 OO6377, 6377 /******** 3574 007732 0611 OEXIT, PROC /******** 3575 007733 7566 PNCHARS,NCHARS /******** 3576 007734 6002 POPTR, OPTR /******** 3577 007735 1066 OI, TAD CHAR /******** 3578 007736 1257 TAD MMCOM /******** 3579 007737 7650 SNA CLA /******** 3580 007740 5747 JMP I PSETCLK /******** O I, EXPRESSION 3581 007741 2746 ISZ I PCLKFLG /******** 3582 007742 1746 TAD I PCLKFLG /******** 3583 007743 7640 SZA CLA /******** 3584 007744 4260 JMS WAIT /******** 3585 007745 5732 JMP I OEXIT /******** 3586 007746 2661 PCLKFLF,CLKFLG /******** 3587 007747 5351 PSETCLK,SETCLK /******** 3588 *7750 /******** 3589 007750 0000 STEMP, 0 /******** 3590 007751 0000 STEMP2, 0 /******** 3591 007752 4575 OC, JMS I PCLEAR /******** 3592 007753 3733 OE, DCA I PNCHARS /******** 3593 007754 1331 TAD OO6377 /******** 3594 007755 3734 DCA I POPTR /******** 3595 007756 3777 DCA I PNFEED /******** 3596 007757 3776 DCA I PNCOLS /******** 3597 007760 5732 JMP I OEXIT /******** 3598 007761 7000 OD, NOP /******** 3599 007762 4260 JMS WAIT /******** 3600 007763 6002 OS, IOF /******** 3601 007764 6141 6141/LINC /******** 3602 007765 0004 0004/ESF /******** 3603 007766 0002 0002/PDP /******** 3604 007767 6001 ION /******** 3605 007770 1375 TAD PSCOPOU /******** SET OUTDEV TO SCOPOU 3606 007771 1374 OT, TAD PXOUTL /******** SET OUTDEV TO XOUTL 3607 007772 3063 DCA OUTDEV /******** 3608 007773 5732 JMP I OEXIT /******** 3609 007774 2676 PXOUTL, XOUTL /******** 3610 007775 4602 PSCOPO, SCOPOU-XOUTL /******** 3611 007776 7564 PNCOLS, NCOLS /******** 3612 007777 7565 PNFEED, NFEEDS /******** 3613 FIELD 1 /******** 3614 *1 /******** 3615 010001 0000 XQ, 0 /******** 3616 010002 0400 D256, 400 /(REFERENCED AS LOC 2) 3617 010003 0200 O200, 200 /(REFERENCED AS LOC 3) 3618 010004 0125 D85, 125 /(REFERENCED AS LOC 4) 3619 010005 0000 GAMMA, 0 /******** 3620 010006 0000 CHRCNT, 0 /******** 3621 010007 0360 O360, 360 /******** 3622 *10 /******** 3623 010010 0000 XR1, 0 /******** 3624 010011 0000 BLK2, 0 /UNIT 3625 010012 0000 0 /ADDRESS 3626 010013 0000 0 /BLOCK NUNBER 3627 010014 0001 1 /NUMBER OF BLOCKS 3628 010015 0760 O760, 760 /******** 3629 010016 0000 ALPHA, 0 /******** 3630 010017 0000 BETA, 0 /******** 3631 *20 /******** 3632 / 3633 /ENTERED WITH NO. CHARS IN AC; REFRESH 3634 /FOR CHARS AND POINTS 3635 / 3636 010020 0000 WAITER, 0 /******** 3637 010021 7450 SNA /******** 3638 010022 5061 JMP NOASCII /******** 3639 010023 7040 CMA /******** 3640 010024 3006 DCA CHRCNT /******** 3641 010025 1076 TAD O4377 /******** 3642 010026 3005 DCA GAMMA /******** 3643 010027 1007 TAD O360 /******** 3644 010030 3077 DCA Y /******** 3645 010031 3001 DCA XQ /******** 3646 010032 6141 LINC /******** 3647 LMODE /******** 3648 010033 1325 CHRLUP, LDH I GAMMA /******** 3649 010034 0450 AZE /******** 3650 010035 6045 JMP GOODY /******** 3651 010036 2077 ADD Y /******** 3652 010037 2015 ADD O760 /******** 3653 010040 1560 BCL I /******** 3654 010041 7000 7000 /******** 3655 010042 4077 STC Y /******** 3656 010043 4001 STC XQ /******** 3657 010044 6056 JMP CHREND /******** 3658 010045 0241 GOODY, ROL 1 /******** 3659 010046 2003 ADD O200 /******** 3660 010047 4016 STC ALPHA /******** 3661 010050 2077 ADD Y /******** 3662 010051 1756 DSC ALPHA /******** 3663 010052 1776 DSC I ALPHA /******** 3664 010053 0221 XSK I XQ /******** 3665 010054 0221 XSK I XQ /******** 3666 010055 0011 CLR /******** 3667 010056 0226 CHREND, XSK I CHRCNT /******** 3668 010057 6033 JMP CHRLUP /******** ONE TIME PER CHAR 3669 010060 0467 SKP /******** 3670 010061 6141 NOASCII,LINC /******** 3671 010062 0077 SET I BETA /******** 3672 010063 2200 2200 /******** 3673 010064 0645 LDF 5 /******** 3674 010065 6102 JMP SUBR /******** 3675 010066 0077 SET I BETA /******** 3676 010067 2000 2000 /******** 3677 010070 0646 LDF 6 /******** 3678 010071 6102 JMP SUBR /******** 3679 010072 0002 WEXIT, PDP /******** 3680 PMODE /******** 3681 010073 6203 6203/CIF CDF 0 /******** 3682 010074 7200 CLA /******** 3683 010075 5420 JMP I WAITER /******** 3684 010076 4377 O4377, 4377 /******** 3685 010077 0000 Y, 0 /******** 3686 010100 0171 PSUBS, SUBS /******** 3687 010101 0173 PLESUB, LESUBS /******** 3688 LMODE /******** 3689 010102 0056 SUBR, SET ALPHA /******** DISPLAYS POINTS 3690 010103 0000 0000 /******** 3691 010104 0415 KST /******** 3692 010105 0467 SKP /******** 3693 010106 6072 JMP WEXIT /******** 3694 010107 0500 IOB /******** 3695 010110 6041 TSF /******** 3696 010111 0467 SKP /******** 3697 010112 6072 JMP WEXIT /******** 3698 010113 1017 LDA BETA /******** 3699 010114 0467 SKP /******** 3700 010115 1037 WAITLP, LDA I BETA /******** 3701 010116 0451 APO /******** 3702 010117 6072 JMP WEXIT /******** 3703 010120 4005 STC GAMMA /******** 3704 010121 1037 LDA I BETA /******** 3705 010122 0145 DIS GAMMA /******** 3706 010123 0217 XSK BETA /******** 3707 010124 6115 JMP WAITLP /******** 3708 010125 6016 JMP ALPHA /******** 3709 PMODE /******** 3710 010126 5527 XLO, JMP I .+1 /******** 3711 010127 1440 LOPEN /******** 3712 010130 5531 XLC, JMP I .+1 /******** 3713 010131 1527 LCLOSE /******** 3714 010132 5533 XLM, JMP I .+1 /******** 3715 010133 1400 LMAKE /******** 3716 010134 5535 XLL, JMP I .+1 /******** 3717 010135 1203 LLOAD /******** 3718 010136 5537 XLS, JMP I .+1 /******** 3719 010137 1276 LSAVE /******** 3720 010140 5541 XLG, JMP I .+1 /******** 3721 010141 1202 LCHAIN /******** 3722 010142 7774 X7774, 7774 3723 010143 7775 X7775, 7775 3724 010144 1171 PLNUM, LNUM 3725 010145 1000 PGETRHS,GETRHS 3726 010146 1160 PLDMILD,LDMILD 3727 010147 1177 P5LNAM, LNAME+5 3728 010150 1200 P6LNAM, LNAME+6 3729 010151 0000 CHFLAG, 0 3730 010152 0000 HISS, 0 3731 010153 0000 LOSS, 0 3732 010154 2135 PFILTAB,FILTAB 3733 010155 1342 PLOOKUP,LUKUP 3734 010156 1600 PCOMMON,COMMON 3735 010157 1361 PREPLAC,REPLACE 3736 010160 0000 MYTEMP, 0 3737 010161 0000 MYTMP2, 0 3738 010162 2076 PFINISH,FINISH 3739 010163 0000 SWITCH, 0 3740 010164 0000 SWTMP, 0 3741 010165 2124 PB1FLG, B1FLG-1 3742 010166 0000 MYAC1, 0 3743 010167 0000 MYAC2, 0 3744 010170 0000 MYAC3, 0 3745 010171 0044 P1FLAC, FLAC 3746 010172 0045 P2FLAC, FLAC+1 3747 010173 0046 P3FLAC, FLAC+2 3748 010174 7764 O7764, 7764 3749 010175 6000 O6000, 6000 3750 010176 0000 0 3751 *177 3752 010177 6203 FERROR, 6203 3753 010200 5601 JMP I .+1 3754 010201 5774 FSSERR 3755 *202 3756 CHARTAB=.-2 3757 010202 4477 4477;7744 / A 010203 7744 3758 010204 5177 5177;2651 / B 010205 2651 3759 010206 4136 4136;2241 / C 010207 2241 3760 010210 4177 4177;3641 / D 010211 3641 3761 010212 4577 4577;4145 / E 010213 4145 3762 010214 4477 4477;4044 / F 010215 4044 3763 010216 4136 4136;2645 / G 010217 2645 3764 010220 1077 1077;7710 / H 010221 7710 3765 010222 7741 7741;0041 / I 010223 0041 3766 010224 4142 4142;4076 / J 010225 4076 3767 010226 1077 1077;4324 / K 010227 4324 3768 010230 0177 0177;0301 / L 010231 0301 3769 010232 3077 3077;7730 / M 010233 7730 3770 010234 3077 3077;7706 / N 010235 7706 3771 010236 4177 4177;7741 / O 010237 7741 3772 010240 4477 4477;3044 / P 010241 3044 3773 010242 4276 4276;0376 / Q 010243 0376 3774 010244 4477 4477;3146 / R 010245 3146 3775 010246 5121 5121;4651 / S 010247 4651 3776 010250 4040 4040;4077 / T 010251 4077 3777 010252 0177 0177;7701 / U 010253 7701 3778 010254 0176 0176;7402 / V 010255 7402 3779 010256 0677 0677;7701 / W 010257 7701 3780 010260 1463 1463;6314 / X 010261 6314 3781 010262 0770 0770;7007 / Y 010263 7007 3782 010264 4543 4543;6151 / Z 010265 6151 3783 010266 4177 4177;0000 / [ 010267 0000 3784 010270 1020 1020;0204 / \ 010271 0204 3785 010272 0000 0000;7741 / ] 010273 7741 3786 010274 2000 2000;2076 / ^ 010275 2076 3787 010276 1604 1604;0404 / _ 010277 0404 3788 010300 0000 0000;0000 / SPACE 010301 0000 3789 010302 7500 7500;0000 / ! 010303 0000 3790 010304 7000 7000;0070 / " 010305 0070 3791 010306 7624 7624;2476 / # 010307 2476 3792 010310 5721 5721;4671 / $ 010311 4671 3793 010312 6661 6661;4333 / % CR 010313 4333 3794 010314 5166 5166;0526 / & 010315 0526 3795 010316 7000 7000;0000 / ' 010317 0000 3796 010320 3600 3600;0041 / ( 010321 0041 3797 010322 4100 4100;0036 / ) 010323 0036 3798 010324 2050 2050;0050 / * 010325 0050 3799 010326 0404 0404;0437 / + 010327 0437 3800 010330 0500 0500;0006 / , 010331 0006 3801 010332 0404 0404;0404 / - 010333 0404 3802 010334 0001 0001;0000 / . 010335 0000 3803 010336 0601 0601;4030 / / 010337 4030 3804 010340 4536 4536;3651 / 0 010341 3651 3805 010342 2101 2101;0177 / 1 010343 0177 3806 010344 4523 4523;2151 / 2 010345 2151 3807 010346 4122 4122;2651 / 3 010347 2651 3808 010350 2414 2414;0477 / 4 010351 0477 3809 010352 5172 5172;0651 / 5 010353 0651 3810 010354 1506 1506;4225 / 6 010355 4225 3811 010356 4443 4443;6050 / 7 010357 6050 3812 010360 5126 5126;2651 / 8 010361 2651 3813 010362 5122 5122;3651 / 9 010363 3651 3814 010364 2200 2200;0000 / : 010365 0000 3815 010366 4601 4601;0000 / ; 010367 0000 3816 010370 1000 1000;4224 / < 010371 4224 3817 010372 1212 1212;1212 / = 010373 1212 3818 010374 2442 2442;0010 / > 010375 0010 3819 010376 4020 4020;2055 / ? 010377 2055 3820 /403-777 ARE CHARACTER DISPLAY AREA 3821 *1000 3822 / 3823 /GET RIGHT HAND SIDE - USED IN 3824 /PROCESSING OF COMMANDS (LIBR) WHICH NEED 3825 /A FILE NAME; EXPECTS THE FORM FILE, UNIT 3826 / 3827 011000 0000 GETRHS, 0 3828 011001 3675 DCA I PLEFLAG 3829 011002 1322 TAD PLNAME 3830 011003 3011 DCA BLK2 3831 011004 1326 TAD O7770 3832 011005 3012 DCA BLK2+1 3833 011006 1324 PLLP1, TAD O77 3834 011007 3411 DCA I BLK2 3835 011010 2012 ISZ BLK2+1 3836 011011 5206 JMP PLLP1 3837 011012 1322 TAD PLNAME 3838 011013 3011 DCA BLK2 3839 011014 1326 TAD O7770 3840 011015 3012 DCA BLK2+1 3841 011016 4333 PLLP2, JMS CGET 3842 011017 5236 JMP IGOTIT 3843 011020 5330 JMP RHSERR 3844 011021 0324 AND O77 3845 011022 1277 TAD M43 3846 011023 7450 SNA 3847 011024 5261 JMP NUMSGN 3848 011025 1300 TAD PP43 3849 011026 3411 DCA I BLK2 3850 011027 2012 ISZ BLK2+1 3851 011030 5216 JMP PLLP2 3852 011031 4333 JMS CGET 3853 011032 5236 JMP IGOTIT 3854 011033 5330 JMP RHSERR 3855 011034 7200 CLA 3856 011035 5231 JMP .-4 3857 011036 1322 IGOTIT, TAD PLNAME 3858 011037 3011 DCA BLK2 3859 011040 1327 TAD O7774 3860 011041 3012 DCA BLK2+1 3861 011042 1322 TAD PLNAME 3862 011043 3013 DCA BLK2+2 3863 011044 1411 PLLP3, TAD I BLK2 3864 011045 7106 CLL RTL 3865 011046 7006 RTL 3866 011047 7006 RTL 3867 011050 1411 TAD I BLK2 3868 011051 3413 DCA I BLK2+2 3869 011052 2012 ISZ BLK2+1 3870 011053 5244 JMP PLLP3 3871 011054 7326 CLA CLL CML RTL 3872 011055 3376 DCA LNAME+4 3873 011056 4301 MORNUM, JMS OCTNUM 3874 011057 5600 JMP I GETRHS 3875 011060 5330 JMP RHSERR 3876 / 3877 /SCAN OFF THE NUMBER - SET THE FLAG 3878 /WHICH SAYS IT WAS A NUMBER 3879 / 3880 011061 1012 NUMSGN, TAD BLK2+1 3881 011062 1323 TAD O10 3882 011063 7650 SNA CLA 3883 011064 4301 JMS OCTNUM 3884 011065 5330 JMP RHSERR 3885 011066 1371 TAD LNUM 3886 011067 3547 DCA I P5LNAM 3887 011070 1276 TAD FLAGJ 3888 011071 3675 DCA I PLEFLAG 3889 011072 7240 CLA CMA 3890 011073 3550 DCA I P6LNAM 3891 011074 5256 JMP MORNUM 3892 011075 1471 PLEFLAG,LEFLAG 3893 011076 5274 FLAGJ, LEFLAG+3&177+5200 3894 011077 7735 M43, -43 3895 011100 0043 PP43, 43 3896 011101 0000 OCTNUM, 0 3897 / 3898 /SUBR TO GEN AN OCTAL NUMBER 3899 / 3900 011102 3371 PLLP4, DCA LNUM 3901 011103 4333 JMS CGET 3902 011104 2301 ISZ OCTNUM 3903 011105 5701 JMP I OCTNUM 3904 011106 0324 AND O77 3905 011107 1325 TAD O7710 3906 011110 7100 CLL 3907 011111 1323 TAD O10 3908 011112 3333 DCA CGET 3909 011113 7420 SNL 3910 011114 5330 JMP RHSERR 3911 011115 1371 TAD LNUM 3912 011116 7106 CLL RTL 3913 011117 7104 CLL RAL 3914 011120 1333 TAD CGET 3915 011121 5302 JMP PLLP4 3916 011122 1171 PLNAME, LNAME-1 3917 011123 0010 O10, 10 3918 011124 0077 O77, 77 3919 011125 7710 O7710, 7710 3920 011126 7770 O7770, 7770 3921 011127 7774 O7774, 7774 3922 011130 6203 RHSERR, 6203 /RIGHT HAND SIDE ERROR 3923 011131 5732 JMP I .+1 3924 011132 6357 LERR 3925 011133 0000 CGET, 0 /INTERFACE WITH FIELD 0 3926 011134 6203 6203 / JMS CGET 3927 011135 5736 JMP I .+1 / JMP 3928 011136 2564 CGETX / JMP 3929 011137 1354 CGETRET,TAD O7524 / JMP 3930 011140 7450 SNA 3931 011141 5733 JMP I CGET 3932 011142 2333 ISZ CGET 3933 011143 1355 TAD O7761 3934 011144 7450 SNA 3935 011145 5733 JMP I CGET 3936 011146 1356 TAD O56 3937 011147 7450 SNA 3938 011150 5733 JMP I CGET 3939 011151 1357 TAD O215 3940 011152 2333 ISZ CGET 3941 011153 5733 JMP I CGET 3942 011154 7524 O7524, 7524 3943 011155 7761 O7761, 7761 3944 011156 0056 O56, 56 3945 011157 0215 O215, 215 3946 / 3947 /BRING MILDRED INTO CORE 3948 / 3949 011160 0000 LDMILD, 0 3950 011161 6002 IOF 3951 011162 4542 JMS I X7774 3952 011163 1165 MLDBLK 3953 011164 5760 JMP I LDMILD 3954 011165 0110 MLDBLK, 110 3955 011166 0030 30 3956 011167 0076 76 3957 011170 0002 2 3958 *1171 3959 011171 0000 LNUM, 0 /-------- 3960 011172 0000 LNAME, 0;0;0;0;0;0 011173 0000 011174 0000 011175 0000 011176 0000 011177 0000 3961 011200 0000 MVCTR, 0 3962 011201 0000 MVPTR, 0 /--------(REFERENCED AS A BLOCK) 3963 011202 7240 LCHAIN, CLA CMA 3964 / 3965 /LIBRARY LOAD 3966 / 3967 011203 3151 LLOAD, DCA CHFLAG 3968 011204 4545 JMS I PGETRHS 3969 011205 4546 JMS I PLDMILD 3970 011206 4342 JMS LUKUP 3971 011207 1550 TAD I P6LNAM 3972 011210 7041 CIA 3973 011211 1275 TAD LLENGTH 3974 011212 7640 SZA CLA 3975 011213 5356 JMP FILERR+2 3976 011214 1544 TAD I PLNUM 3977 011215 3272 DCA LSBLK 3978 011216 1547 TAD I P5LNAM 3979 011217 3274 DCA FILSTRT 3980 011220 4542 JMS I X7774 3981 011221 1272 LSBLK 3982 011222 1267 TAD O3777 3983 011223 3010 DCA XR1 3984 011224 1410 TAD I XR1 3985 011225 1260 TAD M5252 3986 011226 7640 SZA CLA 3987 011227 5356 JMP FILERR+2 3988 011230 1410 TAD I XR1 3989 011231 6201 6201 3990 011232 3670 DCA I PBUFR 3991 011233 6211 6211 3992 011234 1410 TAD I XR1 3993 011235 6201 6201 3994 011236 3671 DCA I PLASTV 3995 011237 1266 TAD PLLIST 3996 011240 3265 DCA LLCNT 3997 011241 1262 TAD PFRST 3998 011242 3264 DCA LLPTR 3999 011243 6211 6211 4000 011244 1410 TAD I XR1 4001 011245 6201 6201 4002 011246 3664 DCA I LLPTR 4003 011247 2264 ISZ LLPTR 4004 011250 2265 ISZ LLCNT 4005 011251 5243 JMP .-6 4006 011252 6203 LLEXIT, 6203 4007 011253 6001 ION 4008 011254 2151 ISZ CHFLAG 4009 011255 5663 JMP I LLPROC 4010 011256 5657 JMP I .+1 4011 011257 0603 GOTO 4012 011260 2526 M5252, -5252 4013 011261 5252 O5252, 5252 4014 011262 3206 PFRST, FRST 4015 011263 0611 LLPROC, PROC 4016 011264 0000 LLPTR, 0 4017 011265 0000 LLCNT, 0 4018 011266 6366 PLLIST, LLIST 4019 011267 3777 O3777, 3777 4020 011270 0060 PBUFR, BUFR 4021 011271 0031 PLASTV, LASTV 4022 011272 0000 LSBLK, 0 4023 011273 0030 30 4024 011274 0000 FILSTRT,0 4025 011275 0004 LLENGTH,4 4026 011276 3151 LSAVE, DCA CHFLAG 4027 011277 4545 JMS I PGETRHS 4028 011300 4546 JMS I PLDMILD 4029 011301 1275 TAD LLENGTH 4030 011302 3550 DCA I P6LNAM 4031 011303 4361 JMS REPLACE 4032 011304 1544 TAD I PLNUM 4033 011305 3272 DCA LSBLK 4034 011306 1547 TAD I P5LNAM 4035 011307 3274 DCA FILSTRT 4036 011310 1267 TAD O3777 4037 011311 3010 DCA XR1 4038 011312 1261 TAD O5252 4039 011313 3410 DCA I XR1 4040 011314 6201 6201 4041 011315 1670 TAD I PBUFR 4042 011316 6211 6211 4043 011317 3410 DCA I XR1 4044 011320 6201 6201 4045 011321 1671 TAD I PLASTV 4046 011322 6211 6211 4047 011323 3410 DCA I XR1 4048 011324 1266 TAD PLLIST 4049 011325 3265 DCA LLCNT 4050 011326 1262 TAD PFRST 4051 011327 3264 DCA LLPTR 4052 011330 6201 6201 4053 011331 1664 TAD I LLPTR 4054 011332 2264 ISZ LLPTR 4055 011333 6211 6211 4056 011334 3410 DCA I XR1 4057 011335 2265 ISZ LLCNT 4058 011336 5330 JMP .-6 4059 011337 4543 JMS I X7775 4060 011340 1272 TAD LSBLK 4061 011341 5252 JMP LLEXIT 4062 / 4063 /USES MILDREDS LOOKUP 4064 / 4065 011342 0000 LUKUP, 0 4066 011343 6141 6141 /LINC 4067 011344 0606 0606 /LIF 6 4068 011345 1020 1020 /LDA I 4069 011346 1171 LNUM 4070 011347 6020 6020 /JMP 20 4071 011350 7354 FILERR&1777+6000 4072 011351 0002 0002 /PDP 4073 011352 7200 CLA 4074 011353 5742 JMP I LUKUP 4075 011354 0002 FILERR, 0002 /PDP 4076 011355 7200 CLA 4077 011356 6203 6203/CIF CDF 0 4078 011357 5760 JMP I .+1 4079 011360 2571 ERRFIL 4080 / 4081 /USES MILDREDS REPLACE 4082 / 4083 011361 0000 REPLACE,0 4084 011362 6141 LINC 4085 LMODE 4086 011363 0606 LIF 6 4087 011364 1020 LDA I 4088 011365 1171 LNUM 4089 011366 6022 JMP 22 4090 011367 7372 JMP SAMEN /ALREADY THERE 4091 011370 7354 JMP FILERR /NOT ENUF ROOM 4092 011371 7375 JMP ENREPL 4093 011372 0606 SAMEN, LIF 6 4094 011373 6024 JMP 24 4095 011374 7354 JMP FILERR /NOT ENUF ROOM; SHOULD NOT HAPPEN 4096 011375 0002 ENREPL, PDP 4097 PMODE 4098 011376 7200 CLA 4099 011377 5761 JMP I REPLACE 4100 *1400 4101 011400 3160 LMAKE, DCA MYTEMP /LIBRARY MAKE 4102 011401 4631 JMS I PGETC 4103 011402 5220 JMP LMAKE1 4104 011403 5632 JMP I PRHSERR 4105 011404 1236 TAD C7506 4106 011405 7100 CLL 4107 011406 1237 TAD CSMCI 4108 011407 3161 DCA MYTMP2 4109 011410 7420 SNL 4110 011411 5632 JMP I PRHSERR 4111 011412 1160 TAD MYTEMP 4112 011413 7106 CLL RTL 4113 011414 1160 TAD MYTEMP 4114 011415 7104 CLL RAL 4115 011416 1161 TAD MYTMP2 4116 011417 5200 JMP LMAKE 4117 011420 4545 LMAKE1, JMS I PGETRHS 4118 011421 1160 TAD MYTEMP 4119 011422 3550 DCA I P6LNAM 4120 011423 4546 JMS I PLDMILD 4121 011424 4557 JMS I PREPLAC 4122 011425 6203 LXIT, 6203 4123 011426 6001 ION 4124 011427 5630 JMP I PPROC 4125 011430 0611 PPROC, PROC 4126 011431 1133 PGETC, CGET 4127 011432 1130 PRHSERR,RHSERR 4128 011433 7510 O7510, 7510 4129 011434 0010 OO10, 10 4130 011435 7453 MCU, -325 4131 011436 7506 C7506, 7506 4132 011437 0012 CSMCI, 323-311 4133 /FILTAB ENTRY = TYPE 4134 / LENGTH 4135 / UNIT 4136 / FIRST BLOCK 4137 /WHERE TYPE 0 = UNDEFINED 4138 / 1 = UNSIGNED (1 WD) 4139 / 2 = SIGNED (2 WD) 4140 / 3 = FLOATING POINT (3 WD) 4141 011440 4311 LOPEN, JMS COMSUB 4142 011441 4631 JMS I PGETC 4143 011442 5245 JMP .+3 4144 011443 0015 O15, 15 4145 011444 5266 JMP ERXIT 4146 011445 4372 JMS GETCX 4147 011446 1235 TAD MCU 4148 011447 7450 SNA 4149 011450 5261 JMP ITSII 4150 011451 1265 TAD O2 4151 011452 7450 SNA 4152 011453 5260 JMP ITSSS 4153 011454 1243 TAD O15 4154 011455 7640 SZA CLA 4155 011456 5632 JMP I PRHSERR 4156 011457 7001 ITSFF, IAC 4157 011460 7001 ITSSS, IAC 4158 011461 7001 ITSII, IAC 4159 011462 3161 DCA MYTMP2 4160 011463 4631 JMS I PGETC 4161 011464 5270 JMP .+4 4162 011465 0002 O2, 2 4163 011466 7200 ERXIT, CLA 4164 011467 5632 JMP I PRHSERR 4165 011470 4545 JMS I PGETRHS 4166 011471 0000 LEFLAG, 0 /(OR JMP .+3 IF GETRHS GOT A #) 4167 011472 4546 JMS I PLDMILD 4168 011473 4555 JMS I PLOOKUP 4169 011474 1161 TAD MYTMP2 4170 011475 3560 DCA I MYTEMP 4171 011476 2160 ISZ MYTEMP 4172 011477 1550 TAD I P6LNAM 4173 011500 3560 DCA I MYTEMP 4174 011501 2160 ISZ MYTEMP 4175 011502 1544 TAD I PLNUM 4176 011503 3560 DCA I MYTEMP 4177 011504 2160 ISZ MYTEMP 4178 011505 1547 TAD I P5LNAM 4179 011506 3560 DCA I MYTEMP 4180 011507 5225 JMP LXIT 4181 011510 7472 O7472, 7472 4182 / 4183 /SCANS OFF FN AND LEAVES POINTER IN MYTEMP 4184 / 4185 011511 0000 COMSUB, 0 4186 011512 4372 JMS GETCX 4187 011513 1310 TAD O7472 4188 011514 7650 SNA CLA /F 4189 011515 4372 JMS GETCX 4190 011516 1233 TAD O7510 4191 011517 7100 CLL 4192 011520 1234 TAD OO10 4193 011521 7420 SNL 4194 011522 5266 JMP ERXIT 4195 011523 7106 CLL RTL 4196 011524 1154 TAD PFILTAB 4197 011525 3160 DCA MYTEMP 4198 011526 5711 JMP I COMSUB 4199 / 4200 /LIBRARY CLOSE 4201 / 4202 011527 4311 LCLOSE, JMS COMSUB 4203 011530 4631 JMS I PGETC 4204 011531 5632 JMP I PRHSERR 4205 011532 7410 SKP 4206 011533 5266 JMP ERXIT 4207 011534 3560 DCA I MYTEMP 4208 011535 6002 IOF 4209 011536 4562 JMS I PFINISH 4210 011537 7307 CLA CLL IAC RTL 4211 011540 4562 JMS I PFINISH 4212 011541 5225 JMP LXIT 4213 / 4214 /FILE VARIABLE LOADER 4215 / 4216 011542 0000 ITLOAD, 0 4217 011543 4556 JMS I PCOMMON 4218 / 4219 /VARIABLE IS NOW IN MEMORY; LOSS 4220 /POINT AT IT; ONE OF THE FOLLOWING 3 CHOICES WILL BE TAKEN, ACCORDING 4221 /TO TYPE 4222 / 4223 011544 5355 JMP IRETLD 4224 011545 5350 JMP SRETLD 4225 011546 1553 FRETLD, TAD I LOSS 4226 011547 2153 ISZ LOSS 4227 011550 3166 SRETLD, DCA MYAC1 4228 011551 1553 TAD I LOSS 4229 011552 3167 DCA MYAC2 4230 011553 2153 ISZ LOSS 4231 011554 5360 JMP CRETLD 4232 011555 1374 IRETLD, TAD O27 4233 011556 3166 DCA MYAC1 4234 011557 3167 DCA MYAC2 4235 011560 1553 CRETLD, TAD I LOSS 4236 011561 3170 DCA MYAC3 4237 011562 6203 6203 4238 011563 1166 TAD MYAC1 4239 011564 3571 DCA I P1FLAC 4240 011565 1167 TAD MYAC2 4241 011566 3572 DCA I P2FLAC 4242 011567 1170 TAD MYAC3 4243 011570 3573 DCA I P3FLAC 4244 011571 5742 JMP I ITLOAD 4245 011572 0000 GETCX, 0 4246 011573 4631 JMS I PGETC 4247 011574 0027 O27, 27 4248 011575 5632 JMP I PRHSERR 4249 011576 5772 JMP I GETCX 4250 *1600 4251 / 4252 /SUBSCRIPTING FOR FILE VARIABLES 4253 /ENTER WITH A FILE NO. IN AC 4254 011600 0000 COMMON, 0 4255 011601 0376 AND O7 4256 011602 7106 CLL RTL 4257 011603 1154 TAD PFILTAB 4258 011604 3160 DCA MYTEMP 4259 011605 1501 TAD I PLESUB 4260 011606 3152 DCA HISS 4261 011607 1500 TAD I PSUBS /SUBSCRIPTS 4262 011610 3153 DCA LOSS 4263 011611 6211 6211 4264 011612 1560 TAD I MYTEMP 4265 011613 7650 SNA CLA 4266 011614 5177 JMP FERROR 4267 011615 1560 TAD I MYTEMP 4268 011616 3011 DCA BLK2 4269 011617 1411 TAD I BLK2 /(REFERENCES LOCS 2, 3, 4) 4270 011620 3011 DCA BLK2 4271 011621 3013 DCA BLK2+2 4272 011622 1011 PREDIV, TAD BLK2 /DIVIDES BY NO. ENTRIES/BLOCK 4273 011623 7141 CLL CIA 4274 011624 1152 TAD HISS 4275 011625 7420 SNL 4276 011626 5232 JMP DIVDIV 4277 011627 3152 DCA HISS 4278 011630 2013 ISZ BLK2+2 4279 011631 5222 JMP PREDIV 4280 011632 7200 DIVDIV, CLA 4281 011633 1174 TAD O7764 4282 011634 3012 DCA BLK2+1 /LOW ORDER SUBSCRIPT, THEN POINTER 4283 011635 1153 DIVLUP, TAD LOSS 4284 011636 7104 CLL RAL 4285 011637 3153 DCA LOSS 4286 011640 1152 TAD HISS 4287 011641 7004 RAL 4288 011642 3152 DCA HISS 4289 011643 1011 TAD BLK2 4290 011644 7141 CLL CIA 4291 011645 1152 TAD HISS 4292 011646 7430 SZL 4293 011647 3152 DCA HISS 4294 011650 7200 CLA 4295 011651 1013 TAD BLK2+2 4296 011652 7004 RAL 4297 011653 3013 DCA BLK2+2 4298 011654 7430 SZL 4299 011655 5177 JMP FERROR 4300 011656 2012 ISZ BLK2+1 4301 011657 5235 JMP DIVLUP 4302 011660 1560 TAD I MYTEMP 4303 011661 2160 ISZ MYTEMP 4304 011662 7041 CIA 4305 011663 3012 DCA BLK2+1 4306 011664 7410 SKP 4307 011665 2200 ISZ COMMON /SETS UP COMMON XIT ACCORDING TO FILE TYPE 4308 011666 1152 TAD HISS 4309 011667 2012 ISZ BLK2+1 /TBLK (RELATIVE) IS IN BLK2+2 4310 011670 5265 JMP .-3 4311 011671 3153 DCA LOSS 4312 011672 1013 TAD BLK2+2 4313 011673 7140 CLL CMA 4314 011674 1560 TAD I MYTEMP /(THE LENGTH) 4315 011675 7620 SNL CLA /SUBSCRIPT IS TOO LONG 4316 011676 5177 JMP FERROR 4317 011677 2160 ISZ MYTEMP 4318 011700 1560 TAD I MYTEMP 4319 011701 3011 DCA BLK2 4320 011702 2160 ISZ MYTEMP 4321 011703 1560 TAD I MYTEMP /STARTING TBLK 4322 011704 1013 TAD BLK2+2 4323 011705 3013 DCA BLK2+2 /ABSOLUTE TBLK 4324 011706 4351 JMS CHECK 4325 011707 7307 CLA CLL RTL IAC 4326 011710 4351 JMS CHECK 4327 011711 1163 TAD SWITCH /ALTERNATE THE BUFFERS 4328 011712 7650 SNA CLA 4329 011713 7307 CLA CLL IAC RTL 4330 011714 3163 DCA SWITCH 4331 011715 6002 IOF 4332 011716 1163 TAD SWITCH 4333 011717 4562 JMS I PFINISH 4334 011720 1163 TAD SWITCH 4335 011721 1165 TAD PB1FLG 4336 011722 3010 DCA XR1 4337 011723 7201 CLA IAC 4338 011724 3410 DCA I XR1 4339 011725 1011 TAD BLK2 4340 011726 3410 DCA I XR1 4341 011727 1410 TAD I XR1 4342 011730 3012 DCA BLK2+1 4343 011731 1013 TAD BLK2+2 4344 011732 3410 DCA I XR1 4345 011733 4542 JMS I X7774 /READ IT IN 4346 011734 0011 BLK2 4347 011735 1163 TAD SWITCH /THE VARIABLE IS IN MEMORY 4348 011736 7106 ITSAGO, CLL RTL 4349 011737 7006 RTL 4350 011740 7006 RTL 4351 011741 1175 TAD O6000 4352 011742 1153 TAD LOSS 4353 011743 3153 DCA LOSS 4354 011744 7346 CLA CLL CMA RTL 4355 011745 1010 TAD XR1 4356 011746 3152 DCA HISS 4357 011747 6001 ION 4358 011750 5600 JMP I COMMON 4359 011751 0000 CHECK, 0 4360 011752 3164 DCA SWTMP 4361 011753 1164 TAD SWTMP 4362 011754 1165 TAD PB1FLG 4363 011755 3010 DCA XR1 4364 011756 1410 TAD I XR1 4365 011757 7650 SNA CLA 4366 011760 5751 JMP I CHECK 4367 011761 1410 TAD I XR1 4368 011762 7041 CIA 4369 011763 1011 TAD BLK2 4370 011764 7640 SZA CLA 4371 011765 5751 JMP I CHECK 4372 011766 2010 ISZ XR1 4373 011767 1410 TAD I XR1 4374 011770 7041 CIA 4375 011771 1013 TAD BLK2+2 4376 011772 7640 SZA CLA 4377 011773 5751 JMP I CHECK 4378 011774 1164 TAD SWTMP 4379 011775 5336 JMP ITSAGO /BLK IS IN MEMORY ALREADY 4380 011776 0007 O7, 7 4381 *2000 4382 / 4383 /FILE VARIABLE STORER 4384 / 4385 012000 0000 ITSTOR, 0 4386 012001 3010 DCA XR1 4387 012002 1571 TAD I P1FLAC 4388 012003 3166 DCA MYAC1 4389 012004 1572 TAD I P2FLAC 4390 012005 3167 DCA MYAC2 4391 012006 1573 TAD I P3FLAC 4392 012007 3170 DCA MYAC3 4393 012010 1010 TAD XR1 4394 012011 4556 JMS I PCOMMON /BLK IS IN MEMORY; LOSS POINTS AT IT 4395 012012 5266 JMP URETST 4396 012013 5224 JMP SRETST 4397 012014 1166 FRETST, TAD MYAC1 4398 012015 3553 DCA I LOSS 4399 012016 2153 ISZ LOSS 4400 012017 1167 TAD MYAC2 4401 012020 3553 DCA I LOSS 4402 012021 2153 ISZ LOSS 4403 012022 1170 TAD MYAC3 4404 012023 5271 JMP INCALL 4405 012024 1166 SRETST, TAD MYAC1 4406 012025 7450 SNA 4407 012026 5244 JMP STOKOK 4408 012027 7700 SMA CLA 4409 012030 5251 JMP STOOBG /MUST BE LESS THAN MAGN. 1 4410 012031 7100 NORMLE, CLL 4411 012032 1167 TAD MYAC2 4412 012033 7510 SPA 4413 012034 7020 CML 4414 012035 7010 RAR 4415 012036 3167 DCA MYAC2 4416 012037 1170 TAD MYAC3 4417 012040 7010 RAR 4418 012041 3170 DCA MYAC3 4419 012042 2166 ISZ MYAC1 4420 012043 5231 JMP NORMLE 4421 012044 1167 STOKOK, TAD MYAC2 4422 012045 3553 DCA I LOSS 4423 012046 2153 ISZ LOSS 4424 012047 1170 TAD MYAC3 4425 012050 5271 JMP INCALL 4426 012051 1167 STOOBG, TAD MYAC2 4427 012052 7120 CLL CML 4428 012053 7700 SMA CLA 4429 012054 7060 CMA CML 4430 012055 7010 RAR 4431 012056 3553 DCA I LOSS 4432 012057 2153 ISZ LOSS 4433 012060 1167 TAD MYAC2 4434 012061 7700 SMA CLA 4435 012062 7344 CLA CLL CMA RAL 4436 012063 7001 IAC 4437 012064 3553 UZERST, DCA I LOSS 4438 012065 5272 JMP CRETST 4439 012066 6203 URETST, 6203 4440 012067 5670 JMP I .+1 4441 012070 7576 CALLIN 4442 012071 3553 INCALL, DCA I LOSS 4443 012072 7240 CRETST, CLA CMA 4444 012073 3552 DCA I HISS 4445 012074 6203 6203 4446 012075 5600 JMP I ITSTOR 4447 012076 0000 FINISH, 0 4448 012077 1165 TAD PB1FLG 4449 012100 3010 DCA XR1 4450 012101 1410 TAD I XR1 4451 012102 7700 SMA CLA 4452 012103 5676 JMP I FINISH 4453 012104 1010 TAD XR1 4454 012105 3321 DCA BLOCK 4455 012106 7201 CLA IAC 4456 012107 3721 DCA I BLOCK 4457 012110 1410 TAD I XR1 4458 012111 3321 DCA BLOCK 4459 012112 1410 TAD I XR1 4460 012113 3322 DCA BLOCK+1 4461 012114 1410 TAD I XR1 4462 012115 3323 DCA BLOCK+2 4463 012116 4543 JMS I X7775 4464 012117 2121 BLOCK 4465 012120 5676 JMP I FINISH 4466 012121 0000 BLOCK, 0 /UNIT 4467 012122 0000 0 /ADDRESS/256 4468 012123 0000 0 /BLOCKNUM 4469 012124 0001 1 /BLOCKCOUNT 4470 / 4471 /BXFLG=0 IF THE BUFFER IS FREE 4472 / =+ IF THE BUFFER IS OCCUPIED 4473 / =- IF OCCUPIED AND SOMETHING HAS 4474 / CHANGED; IE MUST BE WRITTEN OUT 4475 /BXBLK CONTAINS THE TBLK WHICH IS IN THE BUFFER 4476 /PB1FLG POINTS TO B1FLG; ADDING SWITCH MAKES 4477 /IT POINT AT B2FLG 4478 / 4479 012125 0000 B1FLG, 0 4480 012126 0000 B1UNIT, 0 4481 012127 0034 34 4482 012130 0000 B1BLK, 0 4483 012131 0000 B2FLG, 0 4484 012132 0000 B2UNIT, 0 4485 012133 0035 35 4486 012134 0000 B2BLK, 0 4487 / 4488 /FILE DEFINITIONS - 4 WORDS APIECE 4489 /-TYPE (1,2,3=U,S,F) 0 FOR UNDEFINED 4490 /-LENGTH (7777 IF #) 4491 /-UNIT 4492 /-FIRST BLOCK 4493 / 4494 4495 012135 0000 FILTAB, 0;0;0;0;0;0;0;0 012136 0000 012137 0000 012140 0000 012141 0000 012142 0000 012143 0000 012144 0000 4496 012145 0000 0;0;0;0;0;0;0;0 012146 0000 012147 0000 012150 0000 012151 0000 012152 0000 012153 0000 012154 0000 4497 012155 0000 0;0;0;0;0;0;0;0 012156 0000 012157 0000 012160 0000 012161 0000 012162 0000 012163 0000 012164 0000 4498 012165 0000 0;0;0;0;0;0;0;0 012166 0000 012167 0000 012170 0000 012171 0000 012172 0000 012173 0000 012174 0000 4499 /$ 4500 4501 CRUFT=1 4502 IFDEF CRUFT < 4503 / 4504 / THIS MATERIAL IS IN THE EXECUTABLE, BUT NOT IN THE LISTING. 4505 / SOME OF THAT IS BECAUSE OF THE SAVE COMMAND GRANULARITY, BUT 4506 / SOME OF IT IS NOT. 4507 / 4508 FIELD 0 4509 *0 4510 000000 0000 0 4511 *2572 4512 002572 0000 0;0;0;0;0;0 002573 0000 002574 0000 002575 0000 002576 0000 002577 0000 4513 *IOBUF 4514 003120 0000 0;0;0;0;0;0;0;0 003121 0000 003122 0000 003123 0000 003124 0000 003125 0000 003126 0000 003127 0000 4515 003130 0000 0;0;0;0;0;0;0;0 003131 0000 003132 0000 003133 0000 003134 0000 003135 0000 003136 0000 003137 0000 4516 003140 0000 0;0;0;0;0;0;0;0 003141 0000 003142 0000 003143 0000 003144 0000 003145 0000 003146 0000 003147 0000 4517 003150 0000 0;0;0;0;0;0;0;0 003151 0000 003152 0000 003153 0000 003154 0000 003155 0000 003156 0000 003157 0000 4518 003160 0000 0;0;0;0;0;0;0;0 003161 0000 003162 0000 003163 0000 003164 0000 003165 0000 003166 0000 003167 0000 4519 003170 0000 0;0;0;0;0;0;0;0 003171 0000 003172 0000 003173 0000 003174 0000 003175 0000 003176 0000 003177 0000 4520 003200 0000 0;0;0;0;0;0 003201 0000 003202 0000 003203 0000 003204 0000 003205 0000 4521 *3216 4522 003216 0000 0;0 003217 0000 4523 003220 0000 0;0;0;0;0;0;0;0 003221 0000 003222 0000 003223 0000 003224 0000 003225 0000 003226 0000 003227 0000 4524 003230 0000 0;0;0;0;0;0;0;0 003231 0000 003232 0000 003233 0000 003234 0000 003235 0000 003236 0000 003237 0000 4525 003240 0000 0;0;0;0;0;0;0;0 003241 0000 003242 0000 003243 0000 003244 0000 003245 0000 003246 0000 003247 0000 4526 003250 0000 0;0;0;0;0;0;0;0 003251 0000 003252 0000 003253 0000 003254 0000 003255 0000 003256 0000 003257 0000 4527 003260 0000 0;0;0;0;0;0;0;0 003261 0000 003262 0000 003263 0000 003264 0000 003265 0000 003266 0000 003267 0000 4528 003270 0000 0;0;0;0;0;0;0;0 003271 0000 003272 0000 003273 0000 003274 0000 003275 0000 003276 0000 003277 0000 4529 4530 003300 0000 0;0;0;0;0;0;0;0 003301 0000 003302 0000 003303 0000 003304 0000 003305 0000 003306 0000 003307 0000 4531 003310 0000 0;0;0;0;0;0;0;0 003311 0000 003312 0000 003313 0000 003314 0000 003315 0000 003316 0000 003317 0000 4532 003320 0000 0;0;0;0;0;0;0;0 003321 0000 003322 0000 003323 0000 003324 0000 003325 0000 003326 0000 003327 0000 4533 003330 0000 0;0;0;0;0;0;0;0 003331 0000 003332 0000 003333 0000 003334 0000 003335 0000 003336 0000 003337 0000 4534 003340 0000 0;0;0;0;0;0;0;0 003341 0000 003342 0000 003343 0000 003344 0000 003345 0000 003346 0000 003347 0000 4535 003350 0000 0;0;0;0;0;0;0;0 003351 0000 003352 0000 003353 0000 003354 0000 003355 0000 003356 0000 003357 0000 4536 003360 0000 0;0;0;0;0;0;0;0 003361 0000 003362 0000 003363 0000 003364 0000 003365 0000 003366 0000 003367 0000 4537 003370 0000 0;0;0;0;0;0;0;0 003371 0000 003372 0000 003373 0000 003374 0000 003375 0000 003376 0000 003377 0000 4538 *4472 4539 004472 0000 0000; 0000; 0000; 0000; 0000; 0000 004473 0000 004474 0000 004475 0000 004476 0000 004477 0000 4540 004500 0000 0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000 004501 0000 004502 0000 004503 0000 004504 0000 004505 0000 004506 0000 004507 0000 4541 004510 0000 0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000 004511 0000 004512 0000 004513 0000 004514 0000 004515 0000 004516 0000 004517 0000 4542 004520 0000 0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000 004521 0000 004522 0000 004523 0000 004524 0000 004525 0000 004526 0000 004527 0000 4543 004530 0000 0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000 004531 0000 004532 0000 004533 0000 004534 0000 004535 0000 004536 0000 004537 0000 4544 004540 0000 0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000 004541 0000 004542 0000 004543 0000 004544 0000 004545 0000 004546 0000 004547 0000 4545 004550 0000 0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000 004551 0000 004552 0000 004553 0000 004554 0000 004555 0000 004556 0000 004557 0000 4546 004560 0000 0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000 004561 0000 004562 0000 004563 0000 004564 0000 004565 0000 004566 0000 004567 0000 4547 004570 0000 0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000 004571 0000 004572 0000 004573 0000 004574 0000 004575 0000 004576 0000 004577 0000 4548 004600 0000 0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000 004601 0000 004602 0000 004603 0000 004604 0000 004605 0000 004606 0000 004607 0000 4549 004610 0000 0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000 004611 0000 004612 0000 004613 0000 004614 0000 004615 0000 004616 0000 004617 0000 4550 *4777 4551 004777 0000 0000 4552 *5775 4553 005775 0000 0 4554 005776 0000 0 4555 005777 0000 0 4556 *6377 4557 006377 0000 0 4558 *7377 4559 007377 0000 0 4560 *7575 4561 007575 0000 0 4562 *7750 4563 FIELD 1 4564 *0 4565 010000 0000 0 4566 *1577 4567 011577 0000 0 4568 *1777 4569 011777 0000 0 4570 *2175 4571 012175 0000 0;0;0 012176 0000 012177 0000 4572 4573 / NOTHING BELOW HERE IS IN THE LISTING! 4574 *2200 4575 012200 0000 0;0;0;0;0;0;0;0 012201 0000 012202 0000 012203 0000 012204 0000 012205 0000 012206 0000 012207 0000 4576 012210 0000 0;0;0;0;0;0;0;0 012211 0000 012212 0000 012213 0000 012214 0000 012215 0000 012216 0000 012217 0000 4577 012220 0000 0;0;0;0;0;0;0;0 012221 0000 012222 0000 012223 0000 012224 0000 012225 0000 012226 0000 012227 0000 4578 012230 0000 0;0;0;0;0;0;0;0 012231 0000 012232 0000 012233 0000 012234 0000 012235 0000 012236 0000 012237 0000 4579 012240 0000 0;0;0;0;0;0;0;0 012241 0000 012242 0000 012243 0000 012244 0000 012245 0000 012246 0000 012247 0000 4580 012250 0000 0;0;0;0;0;0;0;0 012251 0000 012252 0000 012253 0000 012254 0000 012255 0000 012256 0000 012257 0000 4581 012260 0000 0;0;0;0;0;0;0;0 012261 0000 012262 0000 012263 0000 012264 0000 012265 0000 012266 0000 012267 0000 4582 012270 0000 0;0;0;0;0;0;0;0 012271 0000 012272 0000 012273 0000 012274 0000 012275 0000 012276 0000 012277 0000 4583 4584 012300 0000 0;0;0;0;0;0;0;0 012301 0000 012302 0000 012303 0000 012304 0000 012305 0000 012306 0000 012307 0000 4585 012310 0000 0;0;0;0;0;0;0;0 012311 0000 012312 0000 012313 0000 012314 0000 012315 0000 012316 0000 012317 0000 4586 012320 0000 0;0;0;0;0;0;0;0 012321 0000 012322 0000 012323 0000 012324 0000 012325 0000 012326 0000 012327 0000 4587 012330 0000 0;0;0;0;0;0;0;0 012331 0000 012332 0000 012333 0000 012334 0000 012335 0000 012336 0000 012337 0000 4588 012340 0000 0;0;0;0;0;0;0;0 012341 0000 012342 0000 012343 0000 012344 0000 012345 0000 012346 0000 012347 0000 4589 012350 0000 0;0;0;0;0;0;0;0 012351 0000 012352 0000 012353 0000 012354 0000 012355 0000 012356 0000 012357 0000 4590 012360 0000 0;0;0;0;0;0;0;0 012361 0000 012362 0000 012363 0000 012364 0000 012365 0000 012366 0000 012367 0000 4591 012370 0000 0;0;0;0;0;0;0;0 012371 0000 012372 0000 012373 0000 012374 0000 012375 0000 012376 0000 012377 0000 4592 4593 *4000 4594 014000 0000 0 4595 014001 0000 0 4596 014002 0000 0 4597 014003 0000 0 4598 014004 0000 0 4599 014005 0000 0 4600 014006 0000 0 4601 014007 0000 0 4602 014010 0000 0 4603 014011 0000 0 4604 014012 0000 0 4605 014013 0000 0 4606 014014 0000 0 4607 014015 0000 0 4608 014016 0000 0 4609 014017 0000 0 4610 014020 0006 DIGITS 4611 014021 6030 6030 4612 014022 0006 AND CHRCNT 4613 014023 6265 6265 4614 014024 0006 0006 4615 014025 6252 CIF 50 4616 014026 0006 AND CHRCNT 4617 014027 6604 6604 4618 014030 0075 AND 75 4619 014031 7777 7777 4620 014032 0056 AND CHREND 4621 014033 0000 0 4622 014034 1620 TAD I 4020 4623 014035 4000 4000 4624 014036 0262 AND 4062 4625 014037 0302 AND 4102 4626 014040 1560 1560 4627 014041 4000 4000 4628 014042 4001 4001 4629 014043 4011 4011 4630 014044 0500 AND I PSUBS 4631 014045 6234 6234 4632 014046 1060 TAD 60 4633 014047 0000 0000 4634 014050 0303 AND 4103 4635 014051 1560 TAD I 160 4636 014052 7740 SZA SMA CLA 4637 014053 1620 TAD I 4020 4638 014054 0600 AND I 4000 4639 014055 4221 JMS 4021 4640 014056 2047 ISZ 47 4641 014057 0242 AND 4042 4642 014060 1560 TAD I 160 4643 014061 7740 SZA SMA CLA 4644 014062 1620 1620 4645 014063 0640 AND I 4040 4646 014064 4220 JMS 4020 4647 014065 0452 AND I 52 4648 014066 2220 ISZ 4020 4649 014067 0472 AND I WEXIT 4650 014070 2221 ISZ 4021 4651 014071 1620 TAD I 4020 4652 014072 0640 AND I 4040 4653 014073 4241 JMS 4041 4654 014074 1020 TAD WAITER 4655 014075 0001 AND XQ 4656 014076 0500 AND I PSUBS 4657 014077 6224 6224 4658 014100 0241 AND 4041 4659 014101 1040 TAD 40 4660 014102 0247 0247 4661 014103 0302 0302 4662 014104 1560 TAD I 160 4663 014105 7740 SZA SMA CLA 4664 014106 1620 TAD I 4020 4665 014107 0640 AND I 4040 4666 014110 1040 TAD 40 4667 014111 0243 AND 4043 4668 014112 1560 TAD I 160 4669 014113 7774 SNA SPA SZL CLA OSR 4670 014114 0302 AND 4102 4671 014115 2245 ISZ 4045 4672 014116 1040 TAD 40 4673 014117 4132 JMS 0132 4674 014120 4504 JMS I 104 4675 014121 6241 6241 4676 014122 1001 TAD XQ 4677 014123 1560 TAD I 160 4678 014124 7700 SMA CLA 4679 014125 4246 JMS 4046 4680 014126 6243 6243 4681 014127 0002 AND D256 4682 014130 6212 CIF 10 4683 014131 4754 JMS I 4154 4684 014132 4246 JMS 4046 4685 014133 6141 6141 4686 014134 6241 6241 4687 014135 0064 AND 64 4688 014136 1000 1000 4689 014137 1004 TAD D85 4690 014140 1460 TAD I 60 4691 014141 5757 JMP I 4157 4692 014142 0456 AND I CHREND 4693 014143 6155 6155 4694 014144 1020 TAD WAITER 4695 014145 5757 JMP I 4157 4696 014146 1044 TAD 44 4697 014147 0224 AND 4024 4698 014150 6146 6146 4699 014151 0221 AND 4021 4700 014152 1044 TAD 44 4701 014153 6214 6214 4702 014154 7774 PXOUTL 4703 014155 1021 TAD 0021 4704 014156 4170 JMS 170 4705 014157 1020 1020 4706 014160 0007 AND O360 4707 014161 1140 TAD 140 4708 014162 0004 AND D85 4709 014163 0204 AND 4004 4710 014164 0456 AND I CHREND 4711 014165 6214 6214 4712 014166 1024 TAD 24 4713 014167 1460 TAD I 60 4714 014170 0000 0 4715 014171 6157 6157 4716 014172 0045 AND GOODY 4717 014173 0004 AND D85 4718 014174 0042 AND 42 4719 014175 0001 AND XQ 4720 014176 0067 AND 67 4721 014177 7774 SNA SPA SZL CLA OSR 4722 4723 *4200 4724 014200 1022 1022 4725 014201 1465 1465 4726 014202 6157 6157 4727 014203 0227 IRETN 4728 014204 6200 6200 4729 014205 1022 TAD 22 4730 014206 1420 TAD I WAITER 4731 014207 2300 ISZ 4300 4732 014210 6225 6225 4733 014211 1420 1420 4734 014212 0200 AND 4200 4735 014213 6223 6223 4736 014214 0215 AND 4215 4737 014215 6016 6016 4738 014216 0040 AND 40 4739 014217 0016 AND ALPHA 4740 014220 0640 AND I 4240 4741 014221 0600 AND I 4200 4742 014222 6000 IOT 4743 014223 0225 AND 4225 4744 014224 0225 AND 4225 4745 014225 0215 0215 4746 014226 0236 AND 4236 4747 014227 1025 1025 4748 014230 1062 TAD 62 4749 014231 1025 TAD 25 4750 014232 0451 AND I 51 4751 014233 6214 6214 4752 014234 0215 AND 4215 4753 014235 0456 0456 4754 014236 1062 TAD XCTIN 4755 014237 0236 AND 4236 4756 014240 6214 6214 4757 014241 0640 AND I 4240 4758 014242 6000 IOT 4759 014243 0640 AND I 4240 4760 014244 6000 IOT 4761 014245 0246 AND 4246 4762 014246 0000 0000 4763 014247 0000 0 4764 014250 0346 AND 4346 4765 014251 0002 AND D256 4766 014252 0055 AND 55 4767 014253 0000 0 4768 014254 0231 231 4769 014255 0000 0 4770 014256 0211 AND 4211 4771 014257 6255 6255 4772 014260 6241 6241 4773 014261 1020 TAD WAITER 4774 014262 5757 JMP I 4357 4775 014263 1045 TAD GOODY 4776 014264 6311 6311 4777 014265 0055 AND 55 4778 014266 0000 0 4779 014267 6032 KCC 4780 014270 6306 6306 4781 014271 6301 6301 4782 014272 1020 TAD WAITER 4783 014273 7775 7775 4784 014274 2005 ISZ GAMMA 4785 014275 4010 JMS XR1 4786 014276 0071 AND 71 4787 014277 1776 TAD I 4376 4788 014300 6506 6506 4789 014301 1020 TAD WAITER 4790 014302 7775 7775 4791 014303 2005 ISZ GAMMA 4792 014304 4010 JMS XR1 4793 014305 6310 6310 4794 014306 0070 AND 70 4795 014307 7777 7777 4796 014310 0235 AND 4235 4797 014311 1020 TAD WAITER 4798 014312 0471 AND I 71 4799 014313 4550 JMS I 150 4800 014314 1020 TAD WAITER 4801 014315 0005 AND GAMMA 4802 014316 2001 ISZ XQ 4803 014317 1040 TAD 40 4804 014320 0006 AND CHRCNT 4805 014321 4007 JMS O360 4806 014322 1027 TAD 0027 4807 014323 0451 AND I 51 4808 014324 6506 6506 4809 014325 0470 AND I 70 4810 014326 6506 6506 4811 014327 1040 TAD 40 4812 014330 0601 AND I 4201 4813 014331 0017 AND BETA 4814 014332 1120 TAD 120 4815 014333 0270 AND 4270 4816 014334 0470 AND I 70 4817 014335 0011 AND BLK2 4818 014336 0451 AND I 51 4819 014337 6350 6350 4820 014340 4600 JMS I 4200 4821 014341 6513 6513 4822 014342 6357 6357 4823 014343 1000 1000 4824 014344 0601 AND I 4201 4825 014345 0017 AND BETA 4826 014346 1104 1104 4827 014347 6334 6334 4828 014350 0072 AND WEXIT 4829 014351 0000 0 4830 014352 1020 TAD WAITER 4831 014353 6777 6777 4832 014354 2601 ISZ I 4201 4833 014355 4603 JMS I 4203 4834 014356 6371 6371 4835 014357 0072 WEXIT 4836 014360 7777 7777 4837 014361 1000 1000 4838 014362 0600 AND I 4200 4839 014363 1040 TAD 40 4840 014364 0602 AND I 4202 4841 014365 2601 ISZ I 4201 4842 014366 1120 TAD 120 4843 014367 7061 CML CIA 4844 014370 4603 JMS I 4203 4845 014371 1020 TAD WAITER 4846 014372 0451 AND I 51 4847 014373 4550 JMS I 150 4848 014374 1020 TAD WAITER 4849 014375 0470 AND I 70 4850 014376 1040 IPART 4851 014377 0600 AND I 4200 4852 4853 *4400 4854 014400 2603 INTRPT 4855 014401 0471 DCONT 4856 014402 6410 6410 4857 014403 6513 6513 4858 014404 6415 6415 4859 014405 1004 TAD D85 4860 014406 1105 TAD 105 4861 014407 6376 6376 4862 014410 0212 0212 4863 014411 6506 6506 4864 014412 1000 1000 4865 014413 0602 AND I 4402 4866 014414 4600 JMS I 4400 4867 014415 0210 AND 4410 4868 014416 6471 6471 4869 014417 0070 AND 70 4870 014420 1000 1000 4871 014421 1020 TAD WAITER 4872 014422 0007 AND O360 4873 014423 1140 TAD 140 4874 014424 0010 0010 4875 014425 0210 AND 4410 4876 014426 0456 AND I CHREND 4877 014427 6506 6506 4878 014430 1030 TAD 0030 4879 014431 1460 TAD I 60 4880 014432 5757 JMP I 4557 4881 014433 6421 6421 4882 014434 1001 TAD XQ 4883 014435 1050 1050 4884 014436 1021 1021 4885 014437 1070 TAD 70 4886 014440 1021 TAD 0021 4887 014441 1070 TAD 70 4888 014442 1021 TAD 0021 4889 014443 1070 TAD 70 4890 014444 1021 TAD 0021 4891 014445 1420 TAD I WAITER 4892 014446 2300 ISZ 4500 4893 014447 6454 6454 4894 014450 1420 TAD I WAITER 4895 014451 0200 AND 4400 4896 014452 6465 6465 4897 014453 6506 6506 4898 014454 0047 AND 47 4899 014455 0010 AND XR1 4900 014456 0227 AND 4427 4901 014457 0227 AND 4427 4902 014460 1020 TAD WAITER 4903 014461 5757 JMP I 4557 4904 014462 1067 TAD 67 4905 014463 1067 TAD 67 4906 014464 6471 6471 4907 014465 1020 TAD WAITER 4908 014466 5757 JMP I 4557 4909 014467 1070 TAD 70 4910 014470 1070 TAD 70 4911 014471 1000 1000 4912 014472 0600 AND I 4400 4913 014473 1070 TAD 70 4914 014474 1046 TAD 46 4915 014475 1026 TAD 26 4916 014476 1070 TAD 70 4917 014477 0235 AND 4435 4918 014500 6243 6243 4919 014501 0002 AND D256 4920 014502 6212 CIF 10 4921 014503 4712 JMS I 4512 4922 014504 4246 JMS 4446 4923 014505 6141 6141 4924 014506 0040 AND 40 4925 014507 0015 AND O760 4926 014510 0006 AND CHRCNT 4927 014511 6220 6220 4928 014512 7775 PSCOPO 4929 014513 0056 AND CHREND 4930 014514 0000 0 4931 014515 0064 AND 64 4932 014516 1006 TAD CHRCNT 4933 014517 0224 AND 4424 4934 014520 0456 AND I CHREND 4935 014521 6016 RRB RFC 4936 014522 0224 AND 4424 4937 014523 1000 1000 4938 014524 0004 AND D85 4939 014525 0323 AND 4523 4940 014526 0452 AND I 52 4941 014527 6545 6545 4942 014530 1004 TAD D85 4943 014531 1460 TAD I 60 4944 014532 5757 JMP I 4557 4945 014533 6541 6541 4946 014534 1020 TAD WAITER 4947 014535 0006 AND CHRCNT 4948 014536 1140 TAD 140 4949 014537 0004 AND D85 4950 014540 6517 6517 4951 014541 1020 TAD WAITER 4952 014542 0004 AND D85 4953 014543 1140 TAD 140 4954 014544 0004 AND D85 4955 014545 1004 TAD D85 4956 014546 1120 TAD 120 4957 014547 7430 SZL 4958 014550 0451 AND I 51 4959 014551 6517 6517 4960 014552 0045 AND GOODY 4961 014553 0004 AND D85 4962 014554 1025 TAD 25 4963 014555 0451 AND I 51 4964 014556 6517 6517 4965 014557 1004 1004 4966 014560 1560 TAD I 160 4967 014561 7000 NOP 4968 014562 0017 AND BETA 4969 014563 2600 ISZ I 4400 4970 014564 0451 AND I 51 4971 014565 6573 6573 4972 014566 0017 AND BETA 4973 014567 1105 TAD 105 4974 014570 0451 AND I 51 4975 014571 6517 6517 4976 014572 6576 6576 4977 014573 2601 ISZ I 4401 4978 014574 0451 AND I 51 4979 014575 6517 6517 4980 014576 0236 AND 4436 4981 014577 6016 RRB RFC 4982 *4600 4983 014600 0000 0;0;0;0;55;0;6032;6506 014601 0000 014602 0000 014603 0000 014604 0055 014605 0000 014606 6032 014607 6506 4984 014610 6506 6506 4985 014611 1020 1020 4986 014612 7776 7776 4987 014613 1140 1140 4988 014614 0005 0005 4989 014615 1020 1020 4990 014616 5757 5757 4991 014617 1045 1045 4992 014620 1065 1065 4993 014621 1000 1000 4994 014622 0005 0005 4995 014623 1660 1660 4996 014624 0002 0002 4997 014625 4005 4005 4998 014626 1005 1005 4999 014627 0471 0471 5000 014630 6500 6500 5001 014631 1020 1020 5002 014632 5757 5757 5003 014633 1044 1044 5004 014634 1064 1064 5005 014635 1064 1064 5006 014636 1064 1064 5007 014637 0064 0064 5008 014640 0777 0777 5009 014641 1464 1464 5010 014642 6500 6500 5011 014643 0204 0204 5012 014644 6641 6641 5013 014645 0011 0011 5014 014646 0064 0064 5015 014647 0777 0777 5016 014650 1064 1064 5017 014651 0204 0204 5018 014652 6650 6650 5019 014653 6500 6500 5020 014654 0000 0;0;0;0;0;0;0;0 014655 0000 014656 0000 014657 0000 014660 0000 014661 0000 014662 0000 014663 0000 5021 014664 0000 0;0;0;0;0;0;0;0 014665 0000 014666 0000 014667 0000 014670 0000 014671 0000 014672 0000 014673 0000 5022 014674 0000 0;0;0;0 014675 0000 014676 0000 014677 0000 5023 5024 014700 0000 0;0;0;0;0;0;0;0 014701 0000 014702 0000 014703 0000 014704 0000 014705 0000 014706 0000 014707 0000 5025 014710 0000 0;0;0;0;0;0;0;0 014711 0000 014712 0000 014713 0000 014714 0000 014715 0000 014716 0000 014717 0000 5026 014720 0000 0;0;0;0;0;0;0;0 014721 0000 014722 0000 014723 0000 014724 0000 014725 0000 014726 0000 014727 0000 5027 014730 0000 0;0;0;0;0;0;0;0 014731 0000 014732 0000 014733 0000 014734 0000 014735 0000 014736 0000 014737 0000 5028 014740 0000 0;0;0;0;0;0;0;0 014741 0000 014742 0000 014743 0000 014744 0000 014745 0000 014746 0000 014747 0000 5029 014750 0000 0;0;0;0;0;0;0;0 014751 0000 014752 0000 014753 0000 014754 0000 014755 0000 014756 0000 014757 0000 5030 014760 0000 0;0;0;0;0;0;0;0 014761 0000 014762 0000 014763 0000 014764 0000 014765 0000 014766 0000 014767 0000 5031 014770 0000 0;0;0;0;0;0;0;0 014771 0000 014772 0000 014773 0000 014774 0000 014775 0000 014776 0000 014777 0000 5032 > 5033 $ A 0045 ABSOL 6751 ABSOL2 6153 ABSOL3 7375 ABSOLV 5571 AC1H 0041 AC1L 0042 ACMINS 6605 ADDR 0040 ADONE 6673 AF 4677 ALF1 4760 ALF2 4763 ALFZ 4755 ALGN 6572 ALIGN 6623 ALIST 1370 ALPHA 0016 AMOUNT 6722 ARCALG 4732 ARCRTN 5024 ARGNXT 1723 ARTN 5000 ASHFT 6665 ASK 1200 ATLIST 1570 ATSW 0056 AXIN 0010 AXOUT 0017 B 0046 B1BLK 2130 unreferenced B1FLG 2125 B1UNIT 2126 unreferenced B2BLK 2134 unreferenced B2FLG 2131 unreferenced B2UNIT 2132 unreferenced BACK 5503 BEGIN 4401 BET1 4771 BET2 4774 BETA 0017 BETZ 4766 BF 4702 BLK2 0011 BLOCK 2121 BOTTOM 0035 BUFBEG 3216 BUFFER 7470 BUFR 0060 BUFST 5531 C 0047 C100 0006 C140 2554 C144 6140 C200 0123 C260 0113 C3 5345 C5 5341 C7 5335 C7506 1436 C9 5331 CALLIN 7576 CCR 0077 CDF 7000 CEX1 6506 CEXP 6505 CF 4705 CFRS 0133 CFRSX 0137 CGET 1133 CGETRE 1137 CGETX 2564 CHAR 0066 CHARTA 0200 unreferenced CHECK 1751 CHFLAG 0151 CHIN 2157 CHRCNT 0006 CHREND 0056 CHRLUP 0033 CHRT 6133 CLCU 7427 CLEAR 7673 CLF 0076 CLKFLG 2661 CNTR 0057 COL 1253 COMBOT 0226 COMBUF 0132 COMEIN 3140 COMEOU 3206 COMGO 1161 COMLST 0774 COMMEN 0614 COMMON 1600 COMSUB 1511 CON1 5037 CRETLD 1560 CRETST 2072 CRLF 7505 CRUDDY 1155 CRUFT 0001 CSMCI 1437 CSTAR 0225 D 0041 D256 0002 D85 0004 DATUM 7102 DATUMA 7252 DCONP 6303 DCONT 0471 DCOUNT 6143 DDTJR 0004 DEBGSW 0026 DECON 5627 DECONV 5600 DECP 5533 DECR 5521 DELETE 4565 DF 4710 DGRP 0425 DGRP1 0441 unreferenced DIG 5543 DIGIT 5713 DIGITS 0006 DIV1 5754 DIV2 6757 DIVDIV 1632 DIVIDE 7150 DIVLUP 1635 DMDONE 7063 DMPSW 0100 DMULT 7004 DMULT4 7036 unreferenced DNORM 7335 DNUMBR 5714 DO 0420 DOK 2113 DONE 2131 DOONE 0463 DOUBLE 0127 DPCVPT 6302 DPN 6305 DPT 6145 DSAVE 5640 DTST 5647 DUBDIV 7261 DUBLAD 5733 DV3 7267 E 0042 ECALL 1601 ECHOLS 1624 EFOP 0056 EFUN 1743 EFUN2 1755 EFUN3 2021 EFUN3I 0136 ELPAR 1764 END 0134 unreferenced ENDFI 6243 ENDLN 4556 ENDT 0135 ENREPL 1375 ENUM 1732 EPAR 1710 EPAR2 1766 ERASE 2206 ERG 2227 ERL 2224 ERR2 2726 ERRFIL 2571 ERROR2 4566 ERROR3 4566 ERROR4 4566 ERROR5 2725 ERT 2216 ERV 2221 ERVX 2241 ERXIT 1466 ESCA 2532 ETERM 1647 ETERM1 1627 ETERM2 1655 ETERMN 1644 EVAL 1613 EX1 0040 EXIT 2646 EXIT1 5034 EXIT2 5301 EXIT3 7363 EXITJ 2660 unreferenced EXP 0044 EXTR 2313 F 0043 FADD 1000 FCONT 1101 FCOS 5177 FCOUNT 5535 FDIV 3000 FEND3 2267 FERROR 0177 FEXP 4620 FEXT 0000 FFF 1522 FGET 0000 FGO2 6011 FGO3 6027 FGO4 6034 FGO5 6070 FIG01 6221 FIG04 6261 FILERR 1354 FILSTR 1274 FILTAB 2135 FINCR 1065 FINDLN 4555 FINDN 2250 FINFIN 1137 FINISH 2076 FINKP 1133 FINPUT 0131 FINT 4407 FISW 0052 FIVHUN 7654 FIX 6724 FIXM 6753 FLAC 0044 FLAD 6510 FLAG1 5162 FLAG2 4725 FLAGJ 1076 FLARG 2032 FLARGP 0125 FLDV 7107 FLEX 6517 FLGT 6471 FLIMIT 1075 FLINTP 6200 FLIST1 0577 FLIST2 0574 FLMY 6565 FLOG 5040 FLOP 1674 FLOUT 5556 FLOUTP 6000 FLPT 6467 FLSU 6507 FLTONE 2405 FLTXR 0014 FLTXR2 0015 FLTZER 2407 FM12 6142 FMUL 4000 FNEG 5163 FNOR 7000 FNTABF 0374 FNTABL 2167 FNUM 6311 FOR 1041 FORHUN 7652 FOUTPU 0130 FPAC1 7474 FPNT 6400 FPOW 5000 unreferenced FPRNT 5465 FPUT 6000 FRETLD 1546 unreferenced FRETST 2014 unreferenced FRST 3206 FRSTX 3214 FSIN 5204 FSSERR 5774 FSUB 2000 FXIT 0000 G101 4461 G5772 4462 G5773 4463 G7200 4464 G7773 4465 unreferenced G7774 4466 G7775 4467 G7776 4470 G7777 4471 GAMMA 0005 GBLOK 4455 GECALL 1463 GEND 2334 GERR 0340 GET1 2330 GET3 2345 GETARG 1401 GETC 4545 GETCX 1572 GETLN 4554 GETRHS 1000 GETSGN 1045 GETVAR 1405 GEXIT 0352 GFND1 1510 GINC 0070 GLIST 1375 GO 5021 GONE 0232 GOODY 0045 GOTO 0603 GRPTST 0744 GS1 1435 GS2 1464 GS3 1444 GS4 1457 GSERCH 1424 GTEM 0021 GZERR 0362 HINBUF 0037 unreferenced HISS 0152 HORD 0045 I33 2414 IBAR 0212 IECALL 1037 IF 1013 IF1 1035 IF3 1025 IGNOR 0217 IGOTIT 1036 ILIST 0771 IN 5513 INBUF 0034 INCALL 2071 INDEV 0064 INDRCT 6465 INFIX 2401 INLIST 0570 INORM 6307 INPUT 0756 INPUTX 0271 INSUB 0036 INTEGE 0053 INTRPT 2603 IOBUF 3120 IPART 1040 IRETLD 1555 IRETN 0227 ITABLE 6575 ITER1 7470 ITLOAD 1542 ITSAGO 1736 ITSFF 1457 unreferenced ITSII 1461 ITSOK 7521 ITSSS 1460 ITSTOR 2000 JUMP 6464 K5 5525 KINT 2625 L1 5126 L2 5131 L3 5134 L4 5137 LASTLN 0025 LASTOP 0055 LASTV 0031 LC 5171 LCHAIN 1202 LCLOSE 1527 LCON 0371 LDMILD 1160 LEFLAG 1471 LEFPUT 0172 LEPUT 6163 LERR 6357 LESUB2 0170 LESUBS 0173 LG 6375 LG2E 4713 LGO 6360 LINENO 0067 LIST3 0077 LIST6 0072 LIST7 0074 LISTGO 1366 LL 5175 LLCNT 1265 LLENGT 1275 LLEXIT 1252 LLIST 6366 LLOAD 1203 LLPROC 1263 LLPTR 1264 LM 5173 LMAKE 1400 LMAKE1 1420 LNAME 1172 LNUM 1171 LO 5167 LOADIT 6333 LOG2 5157 LOG5 5142 LOG6 5145 LOG7 5150 LOG8 5153 LOOP01 6433 LOPEN 1440 LORD 0046 LOSS 0153 LPRTST 2037 LS 6176 LSAVE 1276 LSBLK 1272 LTAPE 6346 LUKUP 1342 LWETMP 0002 LXIT 1425 M100 0101 unreferenced M10PT 6147 M11 0121 M12 2413 M137 2357 M140 2556 M144 6137 M2 0111 M20 0105 M240 0114 M260 1534 unreferenced M272 1544 M4 6141 M40 2356 M43 1077 M5 0120 M5252 1260 M77 0103 MBREAK 2602 MCOM 1136 unreferenced MCR 0116 MCU 1435 MD 5526 MEQ 1135 MF 0602 MFLT 0117 MHUNDR 5375 MIF 7260 MINCOM 6374 MINE 5662 MINSKI 0051 MINUS2 7153 MINUSA 0112 MINUSE 6301 MINUSZ 5663 MLDBLK 1165 MLIMIT 7650 MMCOM 7657 MOD 5214 MODIFY 1254 MORNUM 1056 MP1 7254 MP2 7256 MP3 7255 MP4 7200 MP5 7253 MP6 7210 MPER 0115 MPLUS 5664 MSPACE 5665 MULDIV 7101 MULT 6570 MULT10 5667 MULT2 5715 MULTY 4752 MVCTR 1200 unreferenced MVPTR 1201 unreferenced MYAC1 0166 MYAC2 0167 MYAC3 0170 MYTEMP 0160 MYTMP2 0161 NAGSW 0065 NCHARS 7566 NCOLS 7564 NEGP 4724 NFEEDS 7565 NLINES 7561 NOASCI 0061 NOCLK 2653 NOCRLF 7510 NOHANG 7556 NORF 6515 NORM 6571 NORMF 7147 NORMLE 2031 NOX 6675 NOX1 6711 NOX2 6704 NUMSGN 1061 O1 4400 O10 1123 O12 1545 O15 1443 O2 1465 O200 0003 O215 1157 O27 1574 O360 0007 O37 1360 O3777 1267 O4377 0076 O4600 5374 O5252 1261 O56 1156 O6000 0175 O6377 7570 O7 1776 O7000 7415 O7400 7651 O7472 1510 O7510 1433 O7524 1154 O7575 7572 O760 0015 O7655 7571 O77 1124 O7710 1125 O7716 7573 O7761 1155 O7763 7567 O7764 0174 O7770 1126 O7774 1127 OC 7752 OCTNUM 1101 OD 7761 ODISSP 7705 OE 7753 OERROR 7714 unreferenced OEXIT 7732 OGO 7715 OI 7735 OLIST 7723 OM12 5530 ONE 4716 OO10 1434 OO6377 7731 OP 3115 OPMINS 6567 OPNEXT 1622 OPTABL 1731 OPTR 6002 OPTR0 2663 OPTRI 2665 OPTRO 2664 OPUT 5532 OS 7763 OSAMP 1357 OT 7771 OUT 2465 OUTA 5536 OUTCR 2476 OUTDEV 0063 OUTDG 6154 OUTPUT 7707 OUTX 2475 OVER1 0043 OVER2 0047 P 0000 P13 0005 P17 0107 P177 0106 P1FLAC 0171 P2000 0373 P27 6750 P277 0110 P2FLAC 0172 P3 2036 P337 0075 P377 2553 P3FLAC 0173 P40 2552 P4000 0124 P43 6310 P5LNAM 0147 P6LNAM 0150 P7200 1402 P7600 0104 P77 0122 P7700 0101 P7740 0372 PA1 2524 PACBUF 2502 PACKC 4546 PACKST 0027 PACX 2530 PALG 5260 PARTES 2051 PASS 6335 PB1FLG 0165 PBUFR 1270 PC 0022 PC1 0614 PCHECK 5244 PCHK 0510 PCK1 2535 PCLEAR 0175 PCLKFL 7746 PCOMMO 0156 PD2 0534 PD3 0554 PDLXR 0013 PECALL 6334 PEQ 6135 unreferenced PER 0102 PFILTA 0154 PFINIS 0162 PFNEW 0410 unreferenced PFNUM 1771 PFRST 1262 PFX 0411 unreferenced PFZ 0412 unreferenced PGETC 1431 PGETRH 0145 PI 5311 PI2 5036 PIOT 5315 PLASTV 1271 PLCE 5536 PLDMIL 0146 PLEFLA 1075 PLESUB 0101 PLLIST 1266 PLLP1 1006 PLLP2 1016 PLLP3 1044 PLLP4 1102 PLNAME 1122 PLNUM 0144 PLOOKU 0155 PNCHAR 7733 PNCOLS 7776 PNFEED 7777 POPA 1413 POPF 4544 POPJ 5541 POPTR 7734 PP43 1100 PPASS 7706 PPROC 1430 PPTEN 6144 PPTR 7574 PREDIV 1622 PREPLA 0157 PRHSER 1432 PRINTC 4551 PRNT 2442 PRNT2 3114 PRNTI 6132 PRNTLN 4553 PROC 0611 PROCES 0610 PSCOPO 7775 PSETCL 7747 PSIN 0165 unreferenced PSUBS 0100 PT1 0030 PTCH 0126 PTEN 6275 PTEST 1462 PUSHA 4542 PUSHF 4543 PUSHJ 4540 PWAIT 0174 PXOUTL 7774 QADD 0061 R6 5441 RANMUL 6160 RANO 1142 RAR1 6573 RAR2 6574 RDIV 0152 READC 4552 RECOVR 2740 RECOVX 2761 unreferenced REMAIN 5712 REPLAC 1361 REPT 6146 RESOL 6752 RESOL3 7376 RESOL5 6304 RESOLV 7173 RET 5452 RETRN 1563 RETURN 5536 REVIT 7146 RHSERR 1130 RITEOU 4451 RND2 5527 ROOTGO 7461 ROT 2557 ROUND 6151 RTL6 4557 RUB1 3004 RUB2 3042 RUB3 3030 RUB4 3037 RUB5 3041 RUBIT 2555 SADR 6150 SAMEN 1372 SAVAC 2600 SAVE 3751 SAVLK 2601 SBAR 1300 SCHAR 1271 SCONT 1266 SCOPOU 7500 SCOUNT 5534 SETCLK 5351 SETT 1041 SEX 1336 SEXC 0740 SFOUND 1304 SGOT 1310 SIGN 7124 SIGNF 0050 SIN 2662 SMIN 6136 SMP 6101 unreferenced SMSP 6134 SORTB 1312 SORTC 4550 SORTCN 0054 SORTJ 4547 SPECIA 6777 SPLAT 3051 SPNOR 4560 SPTR 7672 SQCON1 7467 SQEND 7465 SRETLD 1550 SRETN 0261 SRETST 2024 SRNLST 1361 START 0177 STARTL 5064 STARTV 0060 STEMP 7750 STEMP2 7751 STOKOK 2044 STOOBG 2051 STORIT 6175 SUBR 0102 SUBS 0171 SUBS2 0167 SWITCH 0163 SWTMP 0164 T 0000 T1 0032 T12 4411 unreferenced T2 0071 T3 0033 TABLE 6466 TAG1 6723 TASK 1202 TASK4 1251 TCRLF 1247 TCRLF2 1244 TDUMP 3052 TELSW 0016 TEM 5156 TEMP 4726 TEN 6271 TENPT 6152 TERMS 1772 TEST2 6736 TEST4 7366 TESTA 0322 TESTC 4564 TESTN 4561 TEXTP 0017 TGO 5400 THIR 7257 THISLN 0023 THISOP 0024 TINTR 1237 TLIST 1376 TLIST2 1532 TLIST3 2377 TQUOT 1230 TRAD 6575 TSTGRP 4563 TSTLPR 4562 TWO 4721 TWOPI 5305 TYPE 1201 TYPE2 1224 URETST 2066 UTE 2276 UTO 2305 UTRA 2274 UTX 2316 UZERST 2064 unreferenced VAL 0032 WAIT 7660 WAITER 0020 WAITLP 0115 WALL 0664 WEXIT 0072 WORDS 0003 WRITE 0635 WTEST2 0653 WTESTG 0667 WX 0673 X 5321 X1 5035 X2 4675 X7774 0142 X7775 0143 XABS 2016 XADC 1341 XCT 0020 XCTIN 0062 XDELET 2064 XDISP 7602 XENDLN 2360 XFIND 2244 XGETLN 0302 XI33 2666 XIN 6306 XINPUT 5666 XINT 1156 XLC 0130 XLG 0140 XLL 0134 XLM 0132 XLO 0126 XLS 0136 XOUTL 2676 XPOPJ 1565 XPRNT 2425 XPUSHA 0477 XPUSHJ 0521 XQ 0001 XR1 0010 XRAN 1145 XRAR2 7365 XRT 0011 XRT2 0012 XRTL6 0413 XSGN 2012 XSORTC 0721 XSPNOR 1535 XSQ2 4676 XSQR 5325 XSQRT 7400 XT3 0717 XTESTC 0700 XTESTN 1546 XYZ 2451 Y 0077 ZERO 6522