1 /OS8 BASIC RUNTIME SYSTEM, V5A 2 / 3 / 4 / 5 / 6 / 7 / 8 / 9 / 10 / 11 / 12 / 13 /COPYRIGHT (C) 1972, 1973, 1974, 1975 14 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 15 / 16 / 17 / 18 /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A 19 /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- 20 /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER 21 /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE 22 /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO 23 /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE 24 /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. 25 / 26 / 27 /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT 28 /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL 29 /EQUIPMRNT COROPATION. 30 / 31 /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 32 /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. 33 / 34 / 35 / 36 / 37 / 38 / 39 /AUGUST 19, 1972 40 / 41 /R.G. BEAN, 1972 42 /SHAWN SPILMAN, 1973 43 / J.K.,1975 44 /JR 21-APR-77 ADDED EXTENDED DATE CODE, CLEANED UP LISTING 45 /JR 26-APR-77 TIGHTENED UP STRING ROUTINES 46 /JR 28-APR-77 ADD SOURCE FIX FOR SEVERAL KNOWN BUGS 47 /JR 4-MAY-77 REWROTE FLOATING POINT OUTPUT ROUTINE TO INCREASE ACCURACY 48 / 49 / 50 VERSON= 5 /VERSION OF BRTS 51 /VERSION LOCATED AT TAG "VERLOC" AND VERLOC+1 52 /VERLOC = 260+VERSON 53 /VERLOC+1 = 300+SUBVER (01 = A) 54 SUBVER= 01 /SUBVERSION OF BRTS 55 SUBVAF= 01 /SUBVERSION OF BASIC.AF OVERLAY 56 SUBVSF= 01 /SUBVERSION OF BASIC.SF OVERLAY 57 SUBVFF= 01 /SUBVERSION OF BASIC.FF OVERLAY 58 /FIRST WORD OF EACH OVERLAY CONTAINS 59 /60+VERSON IN LEFT HALF AND SUBVERSION OF OVERLAY 60 /IN RIGHT HALF. 61 MDATE= 7666 /CONTAINS OS/8 DATE IN FIELD 1 62 BIPCCL= 7777 /CONTAINS YEAR EXTENSION BITS 63 SCOPWD= 7726 /WORD CONTAINING SCOPE FLAG IN 200 BIT 64 EDBLK= 7604 /CONTAINS BLOCK NUMBER OF EDITOR 65 WIDTH= 120 /WIDTH OF PRINTER 66 COLWID= 16 /WIDTH OF ONE PRINT COLUMN 67 SACLIM= 120 /DEFINE WIDTH OF STRING ACCUMULATOR 68 OVERLAY=3400 /ADDRESS OF START OF 5 PAGE OVERLAY BUFFER 69 70 71 72 /ASSEMBLY INSTRUCTIONS 73 / .R PAL8 74 / *BRTS 80,000 123 /.STRING FETCH WHEN COUNT IS IN ONE FLD & 124 / TEXT IS IN THE NEXT 125 AC4000= CLA STL RAR 126 AC2000= CLA STL RTR 127 AC0002= CLA STL RTL 128 AC7775= CLL STA RTL 129 AC7776= CLL STA RAL 130 AC3777= CLL STA RAR 131 AC5777= CLL STA RTR 132 133 IFNDEF EAE 134 135 /PAGE 0 LOCATIONS 136 137 *6 138 000006 0000 USECON, 0 /USE CONSTANT GENERATED BY "USE" STATEMENT 139 000007 0567 FSTOP1, FSTOPI /POINTER TO RTS EXIT ROUTINE USED 140 /BY ^C HOOKS IN SYSTEM HANDLER. 141 /IF THIS IS MOVED, BLOAD MUST BE ALTERED 142 143 *10 144 000010 0015 SACXR, 15 /INDEX REGISTER FOR STRING ROUTINES 145 000011 1122 XR1, VCHECK 146 000012 0000 XR2, 0 147 000013 0000 XR3, 0 148 000014 0004 XR4, 4 /INDEX REGISTERS 149 000015 0000 XR5, 0 150 000016 0000 DATAXR, 0 /POINTER FOR IN-CORE DATA LIST 151 000017 2713 SPINNR, 2713 /AT RUNTIME,THIS LOCATION IS SPUN FOR RND SEED 152 153 *20 154 155 /COMPILER-INTERPRETER CONTROL BLOCK. LOCATIONS MARKED BY 156 /A /* ARE EXPECTED TO CONTAIN VALUES SUPPLIED BY THE COMPILER PRIOR 157 /TO THE BRTS LOAD 158 159 000020 6211 CDFIO, 6211 /* CDF FOR I/O TABLE AND SYMBOL TABLES 160 000021 0000 SCSTRT, 0 /* POINTER TO START OF SCALAR SYMBOL TABLE 161 000022 0000 ARSTRT, 0 /* POINTER TO START OF ARRAY SYMBOL TABLE-1 162 000023 0000 STSTRT, 0 /* POINTER TO START OF STRING SYMBOL TABLE-1 163 000024 0000 SASTRT, 0 /* POINTER TO START OF STRING ARRAY TABLE-1 164 000025 0000 CDFPS, 0 /* CDF FOR START OF PSEUDO-CODE 165 000026 0000 PSSTRT, 0 /* POINTER TO START OF PSEUDO CODE-1 166 000027 0000 DLSTOP, 0 /* POINTER TO TOP OF DATA LIST 167 000030 0000 DLSTRT, 0 /* POINTER TO BOTTOM OF INCORE DATA LIST-1 168 000031 0000 PSFLAG, 0 /* OS/8 SWAPPING FLAGS WORD 169 /BIT 0 SET IF OS/8 SAVED IN N7400 INSTEAD OF N7600 (TD8E) 170 /BIT 1 SET IF ROM TD8E HANDLER NOT NEEDING CDF CHANGES 171 /BIT 11 SET IF 17600 IS IN 17600. BIT 11 TOGGLED BY 172 /PSWAP ROUTINE 173 174 /SYSTEM REGISTERS 175 176 000032 0000 SACLEN, 0 /LENGTH OF STRING IN SAC 177 000033 0000 S1, 0 /SUBSCRIPT 1 (MUST BE FOLLOWED BY S2!) 178 000034 0000 S2, 0 /SUBSCRIPT 2 (MUST BE PRECEEDED BY S1!) 179 000035 0000 DMAP, 0 /MAP OF DRIVER PAGES 180 000036 0000 BMAP, 0 /MAP OF FILE BUFFERS 181 182 *37 183 /FLOATING POINT PACKAGE LOCATIONS. THE FOLLOWING 21 LOCATIONS ARE USED 184 /FOR VARIOUS PURPOSES BY THE FLOATING POINT PACKAGE. THOSE WITH DOUBLE 185 /LABELS ARE USED BY BRTS AS TEMPORARIES WHEN NOT CALLING THE PACKAGE. 186 /THE SECOND TAG IS THE ONE USED BY THE FLOATING POINT PACKAGE,THE FIRST 187 /IS USED BY BRTS. 188 189 000037 0000 FF, 0 /SPECIAL MODE FLIP-FLOP 190 TEMP1, 191 000040 0000 AC0, 0 192 000041 0000 AC1, 0 193 TEMP3, 194 000042 0000 AC2, 0 195 TM, 196 000043 6201 TEMP4, 6201 197 000044 0000 ACX, 0 /FAC-EXPONENT 198 000045 0000 ACH, 0 /FAC-HIGH ORDER MANTISSA 199 000046 0000 ACL, 0 /FAC-MANTISSA LOW 200 TEMP5, 201 000047 0000 OPX, 0 202 TEMP6, 203 000050 0000 OPH, 0 204 TEMP7, 205 000051 0000 OPL, 0 206 000052 0000 DSWIT, 0 /SWITCH USED BY INPUT ROUTINE 207 000053 0215 CHAR, 215 /TERMINATOR OF LAST INPUT 208 000054 0000 TEMP10, 0 /LOC NEEDED BY FPP 209 210 DECEXP= TEMP10 211 212 /SYSTEM REGISTERS USED OFTEN BY INTERPRETER CODE 213 214 000055 0000 MODESW, 0 /0 FOR ARTHIMETIC MODE,1 FOR STRING MODE 215 000056 0000 INSAV, 0 /CURRENT PSEUDO-INSTRUCTION BEING EXECUTED 216 000057 0000 LINEHI, 0 /HI ORDER BITS OF LINE # CURRENTLY BEING EXECUTED 217 000060 0000 LINELO, 0 /LOW ORDER BITS OF CURRENT LINE NUMBER 218 000061 0000 STRMAX, 0 /MAXIMUM # OF CHARS ALLOWED IN CURRENT STRING 219 000062 0000 STRCNT, 0 /- # OF CHARACTERS IN CURRENT STRING 220 000063 0000 STRPTR, 0 /POINTER TO SIZE WORD OF CURRENT OPERAND STRING 221 000064 0000 TEMP2, 0 222 223 /I/O TABLE POINTER AREA-THIS BLOCK HOLDS POINTERS TO THE I/O TABLE 224 /ENTRY FOR THE CURRENT FILE.THE POINTERS ARE CHANGED EVERY TIME AN 225 /SFN IS EXECUTED. A TAD I OFF ONE OF THE POINTERS WILL GET THE INFORMATION 226 /NOTED IN THE COMMENT FOR THE CURRENT I/O DEVICE 227 /THIS BLOCK IS INITIALIZED FOR TTY 228 229 IOTSIZ= 15 /CURRENT SIZE OF IO TABLE 230 231 /THE FORMAT OF THE HEADER WORD IS AS FOLLOWS 232 /BITS USAGE 233 /0-3 OS/8 DEVICE NUMBER 234 /4-5 3 FOR 2 CHARACTER UNPACKING COUNT 235 /6 SET IF BUFFER HAS BEEN MODIFIED AND NEEDS TO BE WRITTEN 236 /7 SET IF NOT FILE STRUCTURED DEVICE 237 /8 SET IF HANDLER IS 2 PAGES LONG 238 /9 SET IF VARIABLE LENGTH (OUTPUT) FILE 239 /10 SET IF EOF 240 /11 SET IF ASCII FILE, CLEAR IF NUMERIC IMAGE FILE 241 242 243 000065 0000 ENTNO, 0 /ENTRY NUMBER NOW IN AREA 244 000066 6677 IOTHDR, TTYF /HEADER WORD 245 000067 6700 IOTBUF, TTYF+1 /BUFFER ADDRESS 246 000070 6701 IOTBLK, TTYF+2 /CURRENT BLOCK IN BUFFER 247 000071 6702 IOTPTR, TTYF+3 /READ\WRITE POINTER 248 000072 6703 IOTHND, TTYF+4 /HANDLER ENTRY POINT 249 000073 6704 IOTLOC, TTYF+5 /FILE STARTING BLOCK # 250 000074 6705 IOTLEN, TTYF+6 /ACTUAL FILE LENGTH 251 000075 6706 IOTMAX, TTYF+7 / DEVICE / (FILE MAXIMUM LENGTH) 252 000076 6707 IOTPOS, TTYF+10 / NAME / (POSITION OF PRINT HEAD) 253 000077 6710 IOTFIL, TTYF+11 / 254 / TTYF+12 / FILE 255 / TTYF+13 / NAME 256 / TTYF+14 / .EX 257 258 IOTDEV= IOTMAX 259 *200 260 261 /FETCH NEXT PSEUDO WORD 262 263 000200 5331 PWFECH, JMP START1 /START ONCE ONLY CODE IN TTY BUFFER 264 000201 2304 ISZ INTPC /BUMP PSEUDO-CODE PROGRAM COUNTER 265 000202 5206 JMP CDFPSU /NO-SKIP;JUST GET NEXT PSEUDO-CODE WORD 266 000203 1206 TAD CDFPSU /SKIP MEANS WE HAVE TO INCREMENT PS-CODE FIELD 267 000204 1177 TAD [10 268 000205 3206 DCA CDFPSU 269 000206 1122 CDFPSU, VCHECK /SET DF TO FIELD OF PSEUDO-CODE 270 000207 1704 TAD I INTPC /GET NEXT WORD OF CODE 271 000210 6201 CDF 0 /SET DATA FIELD BACK TO INTERPRETER FIELD 272 000211 5600 JMP I PWFECH /RETURN 273 000212 7770 O7770, 7770 274 275 000213 7001 SSMODE, IAC /SET INTERPRETER TO STRING MODE 276 000214 3055 AMODE, DCA MODESW /SET INTERPRETER TO ARITH MODE 277 /FALL BACK INTO I-LOOP 278 279 /BRTS I-LOOP 280 281 000215 7300 ILOOP, CLA CLL /FLUSH 282 000216 3037 DCA FF /PUT FPP IN SI MODE 283 000217 4200 JMS PWFECH /GET NEXT PSEUDO-INSTRUCTION 284 000220 3056 DCA INSAV /SAVE FOR LATER 285 000221 4576 JMS I [XPRINT /CALL TO TTY DRIVER 286 000222 7000 NOP 287 000223 1056 TAD INSAV 288 000224 0175 AND [7400 /STRIP TO OPCODE BITS 289 000225 7106 CLL RTL 290 000226 7006 RTL 291 000227 7004 RAL /OPCODE NOW IN BITS 8-11 292 000230 1212 TAD O7770 /SUBTRACT 10 293 000231 7500 SMA /IS OPCODE <10? 294 000232 5246 JMP SCASE /CALL TO INSTRUCTION COMMON TO SMODE AND AMODE 295 000233 3040 DCA TEMP1 /YES-SAVE THE OFFSET 296 000234 1055 TAD MODESW /WHICH MODE? 297 000235 7640 SZA CLA 298 000236 5273 JMP SMODE /STRING MODE 299 000237 1040 TAD TEMP1 /ARITHMETIC MODE-GET OFFSET 300 000240 1251 TAD JMSI /MAKE JMS TO FP PACKAGE ROUTINE 301 000241 3243 DCA .+2 /PUT IN LINE 302 000242 4311 JMS ARGPRE /SET UP ARGUMENT FROM SYMBOL TABLE 303 000243 0243 ILOOPF, . /JMS TO THE FLOATING POINT PACKAGE ROUTINE 304 000244 7000 NOP /FPP SOMETIMES RETURNS TO CALL+2 305 000245 5215 JMP ILOOP /DONE 306 307 000246 1252 SCASE, TAD JMPI /JUST DISPATCH TO ROUTINE CALLED FOR 308 000247 3250 DCA .+1 309 000250 0250 . /JUMP TO APPROPRIATE ROUTINE 310 311 000251 4663 JMSI, JMS I SEP1 /JMS USED FOR CALLS TO FPP BY AMODE INST 312 000252 5663 JMPI, JMP I SEP1 /JMP USED TO CALL ROUTINES COMMON TO AMODE AND SMODE 313 /JUMP TABLE FOR AMODE INSTRUCTIONS 314 315 000253 6000 FFADD /FAC_C(A)+FAC OPCODE 0 316 000254 6117 FFSUB /FAC_FAC-C(A) OPCODE 1 317 000255 5600 FFMPY /FAC_FAC*C(A) OPCODE 2 318 000256 5722 FFDIV /FAC_FAC/C(A) OPCODE 3 319 000257 6241 FFGET /FAC_C(A) OPCODE 4 320 000260 6256 FFPUT /C(A)_FAC OPCODE 5 321 000261 5400 FFSUB1 /FAC_C(A)-FAC OPCODE 6 322 000262 5412 FFDIV1 /FAC_C(A)/FAC OPCODE 7 323 /ALL INSTRUCTIONS BEYOND THIS POINT ARE COMMON TO AMODE AND SMODE 324 000263 1403 SEP1, LS1I /S1_C(A) OPCODE 10 325 000264 1402 LS2I /S2_C(A) OPCODE 11 326 000265 0452 FJOCI /IF TRUE,PC_C(PC,PC+1) OPCODE 12 327 000266 0467 JEOFI /IF EOF,PC_C(PC,PC+1) OPCODE 13 328 000267 1137 LINEI /LINE NUMBER OPCODE 14 329 000270 0600 ARRAYI /ARRAY INST OPCODE 15 330 000271 0215 ILOOP /NOP OPCODE 16 331 000272 1234 OPERI /OPERATE INST OPCODE 17 332 333 334 000273 1040 SMODE, TAD TEMP1 /INST OFFSET 335 000274 1310 TAD JMSSI /BUILD JMP OFF STRING TABLE 336 000275 3300 DCA SDIS /PUT IN LINE 337 000276 7100 CLL /STRING SCALAR TABLE 338 000277 4707 JMS I STFINL /SET UP ARGUMENT ADDRESS 339 000300 0300 SDIS, . /CALL STRING ROUTINE REQUESTED 340 341 342 /JUMP TABLE FOR SMODE INSTRUCTIONS 343 / A "/*" IN THE COMMENT MEANS THAT THAT OPCODE IS NOT USED,SO WE 344 /USE THE SLOT FOR REGULAR STORAGE 345 346 000301 2210 SCON1 /SAC_SAC&C(A$) 347 000302 2123 SCOMP /IF SAC .NE. C(A$),PC_PC+2 348 000303 2416 SREAD /C(A$)_DEVICE 349 000304 0304 INTPC, . /* INTERPRETER PC 350 000305 2204 SLOAD /SAC_C(A$) 351 000306 2400 SSTORE /C(A$)_SAC 352 000307 1671 STFINL, STFIND /* LINK TO STRING FINDING ROUTINE 353 000310 5711 JMSSI, JMP I .+1 /* DISPATCH JUMP FOR SMODE INSTRUCTIONS 354 /ARGPRE-ROUTINE TO TRANSLATE OPERAND FIELD INTO 12 BIT POINTER 355 /INTO SCALAR TABLE FOR USE IN FPP CALLS. 356 357 000311 0000 ARGPRE, 0 358 000312 1056 TAD INSAV /GET INSTRUCTION 359 000313 0174 AND [377 /STRIP TO OPERAND FIELD 360 000314 3040 DCA TEMP1 /SAVE 361 000315 1040 TAD TEMP1 362 000316 7104 CLL RAL /*2 363 000317 1040 TAD TEMP1 /PTR*3 364 000320 1021 TAD SCSTRT /MAKE 12 BIT ADDR 365 000321 1000 SCALDF, 1000 /DF TO SCALAR FIELD (CDF INITIALIZED BY LOADER) 366 000322 5711 JMP I ARGPRE /RETURN 367 368 /ROUTINE TO ZERO FAC 369 370 000323 7774 FACCLR, -4 371 000324 7600 L7600, 7600 /CLA 372 000325 3044 DCA ACX /ZERO EXPONENT 373 000326 3046 DCA ACL /ZERO LOW MANTISSA 374 000327 3045 DCA ACH /ZERO HIGH MANTISSA 375 000330 5723 JMP I FACCLR 376 377 /STRING ACCUMULATOR USED BY STRING OPCODES AND FUNCTIONS 378 /CONTAINS ONE 6BIT CHAR PER WORD 379 380 START1, 381 000331 7404 SAC, OSR 382 000332 7640 SZA CLA 383 000333 7000 NOP /A HLT PLACED HERE WILL ALLOW YOU TO STOP 384 /MACHINE BEFORE RUNTIME SYSTEM STARTS BY 385 /SETTING SWITCH REGISTER 386 000334 6046 TLS /SET TTY FLAG 387 000335 2017 ISZ SPINNR /SPIN RANDOM NUMBER SEED 388 000336 7000 NOP /WHILE WAITING FOR INITIALIZING TLS 389 000337 6041 TSF /FLAG UP YET? 390 000340 5335 JMP .-3 /NO 391 000341 1020 TAD CDFIO 392 000342 3773 DCA I PS1L /SET UP CDFS IN PSWAP 393 000343 1020 TAD CDFIO 394 000344 3774 DCA I PS2L 395 000345 4775 JMS I PFUDSC /SWAP 17600 IN IF NOT ALREADY IN AND SAVE SCOPE FLAG 396 000346 4606 JMS I CDFPSU 397 000347 1321 TAD SCALDF /SET PROG NOT RESTARTABLE BIT 398 000350 3770 DCA I L7746 /TELL USR TO SAVE 1000-1777 399 000351 1371 TAD PINFO /POINTER TO INFO TABLE IN 17600 400 000352 3011 DCA XR1 401 000353 1372 TAD POVTAB /POINTER TO BLOCK TABLE IN OVERLAY DRIVER 402 000354 3012 DCA XR2 403 000355 1323 TAD FACCLR /WE HAVE TO GET 4 BLOCK NUMBERS 404 000356 3040 DCA TEMP1 405 000357 6211 OVML, CDF 10 406 000360 1411 TAD I XR1 /GET BLOCK NUMBER FOR THIS OVERLAY FROM INFO AREA 407 000361 6201 CDF 408 000362 3412 DCA I XR2 /PUT IN TABLE IN OVERLAY DRIVER 409 000363 2040 ISZ TEMP1 /DONE? 410 000364 5357 JMP OVML /NO 411 000365 4573 JMS I [PSWAP /SWAP 17600 BACK TO HIGH CORE NOW 412 000366 5767 JMP I .+1 413 000367 1151 START3 /CONTINUE THE INITIALIZING CODE IN INTERMEDIATE BUFFER 414 000370 7746 L7746, 7746 415 000371 7607 PINFO, 7607 416 000372 1523 POVTAB, ARITHA-1 417 000373 1273 PS1L, P1CDF 418 000374 1300 PS2L, P1CDF1 419 000375 0400 PFUDSC, FUDSC 420 421 PAGE 422 423 000400 0000 FUDSC, 0 424 000401 1031 TAD PSFLAG /TEST WHERE 17600 IS LOCATED 425 000402 7700 SMA CLA 426 000403 1172 TAD [200 /IF NOT TD8E USE 7600 427 000404 1175 TAD [7400 /IF TD8E USE 7400 428 000405 3626 DCA I PHICORE /STORE FOR SWAPPER 429 000406 7201 CLA IAC 430 000407 0031 AND PSFLAG 431 000410 7650 SNA CLA /SKP IF PAGE 17600 IS ALREADY IN 432 000411 4573 JMS I [PSWAP /ELSE BRING IT IN 433 000412 6211 CDF 10 434 000413 1624 TAD I PSCOPW 435 000414 6201 CDF 436 000415 0172 AND [200 /GET SCOPE BIT FROM RES MONITOR 437 000416 3625 DCA I PSCOPF 438 000417 1622 TAD I PHEIGHT 439 000420 3623 DCA I PHCTR /NOW INITIALIZE THE SCREEN HEIGHT COUNTER 440 000421 5600 JMP I FUDSC /RETURN 441 000422 1200 PHEIGHT,HEIGHT 442 000423 1202 PHCTR, HCTR 443 000424 7726 PSCOPW, SCOPWD 444 000425 6540 PSCOPF, SCOPFG 445 000426 1313 PHICOR, HICORE 446 *SAC+SACLIM+1 /ORIGIN PAST SAC+ONE GUARD CHAR 447 448 /JUMP ON CONDITION 449 450 000452 1056 FJOCI, TAD INSAV /GET JUMP INSTRUCTION 451 000453 0171 AND [17 /MASK OFF JUMP CONDITION 452 000454 7450 SNA /IS IT GOSUB? 453 000455 5777 JMP I (GOSUB /YES-PUSH PC ON STACK THEN JUMP 454 000456 1367 TAD FSTOPI /BASE TAD FOR BUILD OF TAD INSTRUCTION 455 000457 3260 DCA .+1 /PUT IN LINE 456 000460 0460 . /GET PROPER SKIP 457 000461 3263 DCA .+2 /PUT IN LINE 458 000462 1045 TAD ACH /GET HIGH ORDER FAC 459 000463 0463 . /SKIP INSTRUCTION 460 000464 5274 JMP SUCJMP /CONDITION TRUE-JUMP 461 000465 4572 JFAIL, JMS I [PWFECH /CONDITION FALSE-DON'T JUMP,BUT BUMP PC 462 000466 5570 JMP I [ILOOP /DONE 463 464 /JUMP ON END OF FILE 465 466 000467 4567 JEOFI, JMS I [IDLE /SEE IF FILE OPEN 467 000470 1466 TAD I IOTHDR /1ST WORD OF I/O TABLE ENTRY 468 000471 7112 CLL RTR /GET EOF BIT IN LINK 469 000472 7620 SNL CLA /EOF? 470 000473 5265 JMP JFAIL /NO-DON'T JUMP 471 /YES, FALL INTO JUMP ROUTINE 472 473 000474 4572 SUCJMP, JMS I [PWFECH /GET WORD FOLLOWING JUMP INS. 474 000475 3716 DCA I INTPCL /STORE AS NEW PC 475 000476 1056 TAD INSAV /GET JUMP INSTRUCTION 476 000477 0166 AND [340 /MASK OFF DESTINATION FIELD 477 000500 7112 CLL RTR /SLIDE OVER 478 000501 1346 TAD CDFINL /MAKE A CDF INSTRUCTION 479 000502 3565 DCA I [CDFPSU /AND SET NEW PC INSTRUCTION FIELD 480 000503 5570 JMP I [ILOOP /NEXT INSTUCTION 481 482 000504 7554 K7554, 7554 /MUST PRECEDE SKIP TABLE 483 484 /SKIP TABLE USED TO HOLD TESTS FOR VARIOUS CONDITIONS 485 486 000505 7600 K7600, 7600 /UNCONDITIONAL (CLA) 487 000506 7700 SMA CLA /JPA 488 000507 7640 SZA CLA /JNA 489 000510 7740 SMA SZA CLA /JPA JNA 490 000511 7710 SPA CLA /JMA 491 000512 7650 SNA CLA /JZA 492 000513 7750 SPA SNA CLA /JMA JZA 493 000514 5715 JMP I JFORL /FORLOOP JUMP ROUTINE 494 495 000515 2061 JFORL, JFOR 496 000516 0304 INTPCL, INTPC 497 000517 0000 0000;0 /MARK BEGINNING OF GOSUB STACK 000520 0000 498 000521 6000 GSTCK, 6000;0 000522 0000 499 000523 6000 6000;0 000524 0000 500 000525 6000 6000;0 000526 0000 501 000527 6000 6000;0 000530 0000 502 000531 6000 6000;0 000532 0000 503 000533 6000 6000;0 000534 0000 504 000535 6000 6000;0 000536 0000 505 000537 6000 6000;0 000540 0000 506 000541 6000 6000;0 000542 0000 507 000543 0000 0 /MARK THE END OF THE GOSUB STACK 508 /CALL TO DEVICE DRIVER FOR FILE I/O. ASSUMES ARGS HAVE BEEN SET UP 509 510 000544 0000 DRCALL, 0 511 000545 3356 DCA DRARG1 /FUNCTION WORD INTO DRIVER CALL 512 000546 6201 CDFINL, CDF /DF TO CURRENT FIELD 513 000547 1467 TAD I IOTBUF /GET BUFFER ADDRE FROM I/O TABLE ENTRY 514 000550 3357 DCA DRARG2 /PUT IN DRIVER CALL 515 000551 1470 TAD I IOTBLK /GET BLOCK NUMBER FROM I/O TABLE 516 000552 3360 DCA DRARG3 /PUT IN DRIVER CALL 517 000553 1472 TAD I IOTHND /GET DRIVER ENTRY 518 000554 3364 DCA DRIVER /SAVE 519 000555 4764 JMS I DRIVER /CALL DRIVER 520 000556 0000 DRARG1, 0 /FUNCTION CONTROL WORD 521 000557 0000 DRARG2, 0 /BUFFER ADDRESS 522 000560 0000 DRARG3, 0 /BLOCK # 523 000561 7700 SMA CLA /DEVICE ERROR-IS IT FATAL? 524 000562 5744 JMP I DRCALL /ALLS WELL 525 000563 4564 DE, JMS I [ERROR /FATAL 526 000564 0000 DRIVER, 0 527 528 /CALL TO INTERPRETER EXITING ROUTINE 529 530 000565 4576 FSTOPN, JMS I [XPRINT /ON NORMAL EXITS,WE MUST EMPTY RING BUFFER 531 000566 5365 JMP .-1 /FIRST 532 000567 1304 FSTOPI, TAD K7554 533 000570 3056 DCA INSAV /FAKE A CALL TO BASIC.FF FUNCTION 6 534 000571 5772 JMP I .+1 /CALL OVERLAY 535 000572 1462 FUNC5I 536 537 /USE FUNCTION-TAKES WORD FOLLOWING CALL AND STUFFS IT IN USECON FOR 538 /USE A BUFFER POINTER FOR USER SUBROUTINE 539 540 000573 4572 USE, JMS I [PWFECH /GET NEXT WORD FROM PSEUDO-CODE STREAM 541 000574 3006 DCA USECON /STORE IN PAGE 0 SLOT 542 000575 5570 JMP I [ILOOP /RETURN 543 544 000577 2031 PAGE 545 /ARRAY INSTRUCTIONS 546 /ARRAY INSTRUCTIONS WORK BY FINDING THE ADDRESS OF THE ARGUMENT FROM THE ARRAY SYMBOL 547 /TABLE,THEN CALLING THE APPROPRIATE FLOATING POIN PACKAGE ROUTINE. 548 549 000600 1055 ARRAYI, TAD MODESW /WHICH MODE? 550 000601 7640 SZA CLA 551 000602 5324 JMP SARRAY /SMODE 552 000603 1056 TAD INSAV /GET ARRAY INSTRUCTION 553 000604 0342 AND K0037 /MASK OFF ARRAY OPERAND 554 000605 7106 CLL RTL /MULTIPLY BY 4 (ENTRY LENGTH) 555 000606 1022 TAD ARSTRT /MAKE POINTER INTO ARRAY TABLE 556 000607 3011 DCA XR1 /POINTS TO ARRAY FOR THIS OPERATION 557 000610 0610 ATABDF, . /CHANGE DF TO ARRAY TABLE FIELD (SET BY START) 558 000611 1411 TAD I XR1 /GET POINTER TO FIRST ARRAY ELEMENT 559 000612 3064 DCA TEMP2 /SAVE FOR LATER 560 000613 1411 TAD I XR1 /GET DF FOR VARIABLE 561 000614 3307 DCA ADFC /PUT IN LINE AT END OF ROUTINE 562 000615 1411 TAD I XR1 /GET ARRAY DIMENSION 1 563 000616 3042 DCA TEMP3 /SAVE 564 000617 1033 TAD S1 /GET SUBSCRIPT 1 565 000620 7140 CLL CMA /SET UP 12 BIT COMPARE 566 000621 1042 TAD TEMP3 /DIMENSION 1 +1 567 000622 7620 SNL CLA /S1 TOO BIG? 568 000623 4564 SU, JMS I [ERROR /YES-SUBSCRIPT OUT OF BOUNDS ERROR 569 000624 3050 DCA TEMP6 /CLEAR TEMPORARY 570 000625 1411 TAD I XR1 /GET DIMENSION 2 571 000626 7450 SNA /IS SECOND DIMENSION 0?(ARRAY UNIDIMENSIONAL) 572 000627 5240 JMP ADCALC /YES-DON'T CHECK S2 FOR OUT OF BOUNDS 573 000630 3311 DCA ARJMP /SAVE DIM2+1 574 000631 1034 TAD S2 /GET SUBSCRIPT 2 575 000632 7140 CLL CMA /SAVE 12 BIT COMPARE 576 000633 1311 TAD ARJMP 577 000634 7620 SNL CLA /S2 BIGGER THAN DIM2? 578 000635 5223 JMP SU /YES 579 000636 1034 TAD S2 /MULTIPLY DIM1+1 BY S2 580 000637 4563 JMS I [MPY /12 BY 12 MULTIPLY ROUTINE 581 000640 7100 ADCALC, CLL 582 000641 1033 TAD S1 /LORD OF S1+(DIM1+1)*S2 583 000642 3047 DCA TEMP5 /SAVE 584 000643 7004 RAL /CARRY TO BIT 11 585 000644 1050 TAD TEMP6 /HORD OF S1+(DIM1+1)*S2 586 000645 3050 DCA TEMP6 /SAVE 587 000646 1047 TAD TEMP5 /LORD OF S1+(DIM1+1)*S2 588 000647 7104 CLL RAL /*2 589 000650 3051 DCA TEMP7 /LORD OF [S1+(DIM1+1)*S2]*2 590 000651 1050 TAD TEMP6 /HORD OF S1+(DIM1+1)*S2 591 000652 7004 RAL /*2 592 000653 3042 DCA TEMP3 /HORD OF [S1+(DIM1+1)*S2]*2 593 000654 7100 CLL 594 000655 1047 TAD TEMP5 /LORD OF S1+(DIM1+1) 595 000656 1051 TAD TEMP7 /LORD OF [S1+(DIM1+1)*S2] 596 000657 3051 DCA TEMP7 /LORD OF 3*[S1+(DIM1+1)*S2] 597 000660 7004 RAL /CARRY TO BIT 11 598 000661 1050 TAD TEMP6 /HORD OF [S1+(DIM1+1)*S2)*2 599 000662 1042 TAD TEMP3 /HORD OF S1+(DIM1+1)*S2 600 000663 3050 DCA TEMP6 /HORD OF 3*[S1+(DIM1+1)*S2] 601 000664 7100 CLL 602 000665 1051 TAD TEMP7 /INDEX TO ELEMENT 603 000666 1064 TAD TEMP2 /AC POINTS TO CORRECT ARRAY ELEMENT 604 000667 3011 DCA XR1 /SAVE POINTER 605 000670 7004 RAL /CARRY TO BIT 11 606 000671 1050 TAD TEMP6 /COMBINE TO MAKE TOTAL # OF FIELD OVERLAPS 607 000672 7106 CLL RTL 608 000673 7004 RAL /SLIDE OVERLAPS TO FIELD BITS (6-8) 609 000674 1307 TAD ADFC /ADD ANY CHANGE IN DATA FIELD TO CDF 610 000675 3307 DCA ADFC /PUT ABSOLUTE CDF IN LINE 611 000676 1056 TAD INSAV /GET ARRAY INSTRUCTION AGAIN 612 000677 0166 AND [340 /MASK OFF ARRAY OPCODE 613 000700 7112 CLL RTR 614 000701 7012 RTR 615 000702 7010 RAR /SLIDE TO BITS 9-11 616 000703 1346 TAD JMPI2 /AND USE AS INDEX INTO JUMP TABLE 617 000704 3311 DCA ARJMP /PUT JUMP IN LINE OF CODE 618 000705 7001 IAC 619 000706 3037 DCA FF /PUT FPP IN "SPECIAL MODE" 620 000707 0707 ADFC, . /CHANGE DF TO DF OF ARRAY ELEMNT 621 000710 1011 TAD XR1 /AC POINTS TO ARRAY ELEMENT 622 000711 0711 ARJMP, . /PERFORM THE REQUIRED OPERATION 623 000712 7000 NOP /FPP SOMETIMES RETURNS TO CALL+2 624 000713 5570 JMP I [ILOOP /DONE 625 626 /ARRAY JUMP TABLE 627 628 000714 5400 AJT, FFSUB1 /FAC=A(S1,S2)-FAC OPCODE 0 629 000715 6000 FFADD /FAC=FAC+A(S1,S2) OPCODE 1 630 000716 6117 FFSUB /FAC=FAC-A(S1,S2) OPCODE 2 631 000717 5600 FFMPY /FAC=FAC*A(S1,S2) OPCODE 3 632 000720 5722 FFDIV /FAC=FAC/A(S1,S2) OPCODE 4 633 000721 6241 FFGET /FAC=C(A(S1,S2) OPCODE 5 634 000722 6256 FPUTLL, FFPUT /C(A(S1,S2)=FAC OPCODE 6 635 000723 5412 FFDIV1 /FAC=A(S1,S2)/FAC OPCODE 7 636 /STRING ARRAY DISPATCH 637 638 000724 1056 SARRAY, TAD INSAV /GET INSTRUCTION 639 000725 0166 AND [340 /ISOLATE ARRAY OPCODE 640 000726 7112 CLL RTR 641 000727 7012 RTR /AND SLIDE IT OVER FOR AN OFFSET 642 000730 7010 RAR 643 000731 1336 TAD JMPISA /BUILD A JUMP TO STRING INSTRCUTION 644 000732 3335 DCA SAD /AND PUT IN LINE 645 000733 7120 STL /TELL SFIND TO USE ARRAY TABLE 646 000734 4743 JMS I STFILK /SET UP ARGUMENT ADDRESS 647 000735 0735 SAD, . /EXECUTE INSTRCUTION 648 649 /STRING ARRAY JUMP TABLE 650 /USED WHEN ARRAYI CALLED IN SMODE 651 / A "/*" IN THE COMMENT MEANS THAT OPCODE IS UNDEFINED AND THE SLOT 652 /IN THE TABLES IS USED FOR NORMAL STORAGE 653 654 000736 5737 JMPISA, JMP I .+1 /DISPATCH JUMP FOR STRING ARRAY INSTRUCTIONS 655 656 000737 2210 SCON1 /SAC_SAC&C(A$(S1)) 657 000740 2123 SCOMP /SKIP IF SAC=C(A$(S1)) 658 000741 2416 SREAD /A$(S1)_DEVICE 659 000742 0037 K0037, 37 /* 660 000743 1671 STFILK, STFIND /* LINK TO STRING FINDING ROUTINE 661 000744 2204 SLOAD /SAC_C(A$(S1)) 662 000745 2400 SSTORE /C(A$(S1))_SAC 663 000746 4714 JMPI2, JMS I AJT /* DISPATCH JUMP FOR ARRAY INST 664 /ROUTINE TO PUT ONE WORD IN FILE BUFFER IN FIELD 1 665 666 000747 0000 BCPUT, 0 667 000750 3050 DCA TEMP6 /SAVE AC 668 000751 4567 JMS I [IDLE /CHECK IF FILE OPEN 669 000752 1471 TAD I IOTPTR /GET READ/WRITE POINTER 670 000753 3051 DCA TEMP7 /SAVE 671 000754 1065 TAD ENTNO /GET FILE # 672 000755 7640 SZA CLA /IF TTY,BUFFER FIELD IS 0 673 000756 6211 CDF 10 674 000757 1050 TAD TEMP6 /GET WORD TO STORE AGAIN 675 000760 3451 DCA I TEMP7 /STORE IT IN BUFFER 676 000761 6201 CDF0, CDF 677 000762 1466 TAD I IOTHDR /HEADER WORD 678 000763 0377 AND (7737 /TURN OFF BLOCK WRITTEN BIT 679 000764 1376 TAD (40 /TURN IT ON AGAIN 680 000765 3466 DCA I IOTHDR 681 000766 5747 JMP I BCPUT /RETURN 682 683 000776 0040 PAGE 000777 7737 684 /TELETYPE DRIVING ROUTINE 685 /2 ENTRY POINTS-XPUTCH PUTS A CHARCTER IN THE RING BUFFER 686 / XPRINT TYPES A CHARACTER IF POSSIBLE 687 / AND RETURNS TO CALL+1 IF THERE 688 / ARE MORE CHARCTERS IN THE BUFFER,CALL+2 689 / IF THE BUFFER IS EMPTY 690 /THE IDEA IS THE PLACE CALLS TO XPRINT AT VARIOUS POINTS IN THE INTER- 691 /PRETER AND THUS KEEP THE TTY BUSY WITHOUT WASTING THE TIME WAITING FOR 692 /THE TTY FLAG. THE SUCCESS OF THIS SCHEME DEPENDS HEAVILY ON THE NUMBER 693 /AND PLACEMENT OF THE CALLS TO XPRINT. 694 695 001000 0000 XPUTCH, 0 696 001001 3040 DCA CHRSAV /SAVE THE CHARACTER 697 001002 2017 XPUT1, ISZ SPINNR /SPIN RANDOM # SEED 698 001003 4237 JMS XPRINT /START A CHAR IF POSSIBLE 699 001004 7000 NOP 700 001005 1230 TAD BCNT /GET THE NUMBER OF AVAILABLE SLOTS 701 001006 7650 SNA CLA /ARE THERE ANY? 702 001007 5202 JMP XPUT1 /NO-TRY TO RPINT 1 AND FREE UP A SPACE 703 001010 1040 PUTCHR, TAD CHRSAV /GET CHARACTER AGAIN 704 001011 3625 DCA I BUFIN /PUT CHARACTER IN RING BUFFER 705 001012 2225 ISZ BUFIN /BUMP BUFEER POINTER OF INPUT 706 001013 7340 CLA CLL CMA /-1 IN AC 707 001014 1230 TAD BCNT /DECREMENT AVAILABLE SLOT COUNT 708 001015 3230 DCA BCNT 709 001016 1225 TAD BUFIN /GET BUFFER INPUT POINTER 710 001017 1231 TAD MBEND /SUBTRACT ADDR OF END OF BUFFER 711 001020 7750 SPA SNA CLA /PAST EDN OF BUFFER? 712 001021 5600 JMP I XPUTCH /NO-RETURN 713 001022 1227 TAD BSTRTA /YES-RESET INPUT POINTER TO BEGINNING OF BUFFER 714 001023 3225 DCA BUFIN 715 001024 5600 JMP I XPUTCH /RETURN 716 717 001025 1107 BUFIN, BSTRT /POINTER TO NEXT SLOT FOR BUFFER INPUT 718 001026 1107 BUFOUT, BSTRT /POINTER TO NEXT CHARACTER TO BE PRINTED 719 001027 1107 BSTRTA, BSTRT /ADDR OF START OF TTY BUFFER 720 001030 0030 BCNT, 30 /# OF AVAILABLE SLOTS IN BUFFER (40 INITIALLY) 721 CHRSAV=TEMP1 722 001031 6642 MBEND, -BEND /-ADDR OF END OF RING BUFFER 723 001032 7775 MCTRLC, -3 724 001033 7750 M50, -30 725 001034 7762 MXON, -21+3 726 001035 7776 MXOFF, -23+21 727 001036 0000 XFLAG, 0 728 729 730 001037 0000 XPRINT, 0 731 001040 6031 KSF /IS KEYBOARD FLAG UP? 732 001041 5261 JMP NOCC /NO-NO CHANCE FOR A CTRL/C 733 001042 6036 KRB /YES-GET THE CHAR IN KEYBOARD BUFFER 734 001043 0162 AND [177 /GET RID OF PARAITY 735 001044 1232 TAD MCTRLC /IS IT CTRL/C 736 001045 7450 SNA 737 001046 5407 JMP I FSTOP1 /YES-ABORT TO EDITOR 738 001047 1234 TAD MXON 739 001050 7440 SZA 740 001051 5254 JMP .+3 741 001052 3236 DCA XFLAG 742 001053 5264 JMP NOCC+3 743 001054 1235 TAD MXOFF 744 001055 7640 SZA CLA 745 001056 5261 JMP NOCC 746 001057 2236 ISZ XFLAG 747 001060 5240 JMP XPRINT+1 748 001061 1236 NOCC, TAD XFLAG 749 001062 7640 SZA CLA 750 001063 5240 JMP XPRINT+1 751 001064 1230 TAD BCNT /# OF AVAILABLE SLOTS IN BUFFER 752 001065 1233 TAD M50 /IS BUFFER EMPTY? 753 001066 7650 SNA CLA 754 001067 5305 JMP RECP2 /YES-RETURN TO CALL+2 755 001070 6041 TSF /NO-TTY FLAG UP YET? 756 001071 5637 JMP I XPRINT /NO-GO ABOUT YOUR BUSINESS 757 001072 1626 TAD I BUFOUT /GET NEXT CHARACTER 758 /*****************************************************************: 759 /N.B. BECAUSE OF THE ABOVE INSTRUCTION,THE DF MUST BE SET TO THE 760 /INTERPRETER FIELD WHENEVER XPRINT IS CALLED. WATCH YOUR HOOK PLACEMENT! 761 /****************************************************************: 762 001073 4777 JMS I (PCH /TYPE THE CHAR 763 001074 2226 ISZ BUFOUT /BUMP BUFFER OUTPUT POINTER 764 001075 1226 TAD BUFOUT /GET OUTPUT POINTER 765 001076 1231 TAD MBEND /SUBTRACT END OF BUFFER 766 001077 7750 SPA SNA CLA /IS OUTPUT POINTER PAST END? 767 001100 5303 JMP BOUTRS /NO-FREE UP A SPOT 768 001101 1227 TAD BSTRTA /YES-RESET POINTER TO BEGINNING 769 001102 3226 DCA BUFOUT 770 001103 2230 BOUTRS, ISZ BCNT /INCREMENT # OF FREE SLOTS (WE JUST PRINTED ONE) 771 001104 5637 JMP I XPRINT /RETURN 772 773 001105 2237 RECP2, ISZ XPRINT /BUMP RETURN 774 001106 5637 JMP I XPRINT /RETURN TO CALL+2 FOR EMPTY BUFFER 775 776 777 /TELETYPE RING BUFFER 778 779 001107 0302 BSTRT, "B /START OF BUFFER 780 001110 0322 "R 781 001111 0324 "T 782 001112 0323 "S 783 001113 0240 " 784 001114 0326 "V 785 001115 0265 VERLOC, 260+VERSON 786 001116 0301 300+SUBVER 787 001117 0215 0215 788 001120 0212 0212 789 001121 0212 VEREND, 0212 790 001122 0000 VCHECK, 0 791 001123 6211 CDF 10 792 001124 1736 TAD I N7644 793 001125 6201 CDF 0 794 001126 0014 AND XR4 795 001127 7650 SNA CLA 796 001130 5722 JMP I VCHECK 797 001131 1011 TAD XR1 798 001132 3225 DCA BUFIN 799 001133 1010 TAD SACXR 800 001134 3230 DCA BCNT 801 001135 5722 JMP I VCHECK 802 BEND, 803 001136 7644 N7644, 7644 804 805 /LINE NUMBERS 806 807 001137 1056 LINEI, TAD INSAV /GET INSTRUCTION 808 001140 3057 DCA LINEHI /SAVE 809 001141 4572 JMS I [PWFECH /GET WORD FOLLOWING LINE # INST 810 001142 3060 DCA LINELO /SAVE AS LOW ORDER LINE # 811 001143 5570 TRHOOK, JMP I [ILOOP /RETURN TO I-LOOP 812 001144 1350 TAD KC240 /IF TRACE IS ON,FAKE CALL 813 001145 3056 DCA INSAV /TO FUNC2,#12 814 001146 5747 JMP I .+1 815 001147 1463 FUNC2I /DISPATCH TO TRACE FUNCTION 816 817 /INTERMEDIATE TTY BUFFER 818 /USED TO BUFFER OUTPUT FROM FPP BEFORE WE PUT IT 819 /IN BASIC FORMAT FOR TRANSPORTATION TO THE TTY RING 820 /BUFFER 821 822 001150 0240 KC240, 240 /STOPPER TO MARK BEGINNING OF BUFFER 823 INTERB, 824 001151 1025 START3, TAD CDFPS /CDF FOR PSEUDO-CODE 825 001152 3565 DCA I [CDFPSU /PUT IN-LINE TO ILOOP 826 001153 1026 TAD PSSTRT /START OF PSEUDO-CODE 827 001154 3774 DCA I INTPCK /PUT INTO PC 828 001155 4561 JMS I [FACCLR /ZERO FAC 829 001156 1020 TAD CDFIO /CDF FOR SYMBOL TABLE FIELD 830 001157 3773 DCA I STDFL /PUT IN LINE FOR STRING FUNCTIONS 831 001160 1020 FPPTM5, TAD CDFIO /CDF FOR SYMBOL TABLES 832 001161 3772 DCA I ATABDL /PUT IN LINE FOR ARRAY CALCULATIONS 833 001162 1020 TAD CDFIO /CDF FOR SCALAR TABLE 834 001163 3776 FPPTM4, DCA I SCALDL /PUT IN LINE FOR ARGPRE 835 001164 1020 TAD CDFIO 836 001165 3775 DCA I DLCDFL /DATA FIELD FOR DATA LIST 837 001166 1030 FPPTM3, TAD DLSTRT 838 001167 3016 DCA DATAXR /DO A RESTORE IN INCORE DATA LIST 839 001170 5771 JMP I .+1 /CONTINUE INITAILIZATION CODE IN TTY INPUT BUFFER 840 001171 6600 FPPTM2, START4 841 001172 0610 ATABDL, ATABDF 842 001173 1704 STDFL, STDF 843 FPPTM1, /FLOATING POINT TEMPORARY 844 001174 0304 INTPCK, INTPC 845 001175 2322 DLCDFL, DLCDF 846 001176 0321 SCALDL, SCALDF 847 848 001177 1204 PAGE 849 /VT52 DELAY PARAMETERS (MUST BE AT BEGINNING OF PAGE) 850 851 001200 0000 HEIGHT, 0 /NEGATIVE SCREEN HEIGHT 852 001201 0000 DELAY, 0 /NEGATIVE DELAY VALUE 853 IFNZRO HEIGHT-1200 <__FIX SET COMMAND__> 854 001202 0000 HCTR, 0 /HEIGHT COUNTER INITIALIZED BY SET 855 001203 0000 DCTR, 0 /DELAY COUNTER INITIALIZED BY SET 856 857 /LOW LEVEL ROUTINE TO TYPE A CHAR 858 859 001204 0000 PCH, 0 860 001205 6041 TSF /WAIT FOR PREV CHAR 861 001206 5205 JMP .-1 862 001207 6046 TLS /TYPE THE CURRENT ONE 863 001210 0162 AND [177 /MASK TO 7BIT 864 001211 1377 TAD (-15 /TEST IF LINE FEED WILL BE SENT NEXT 865 001212 7640 SZA CLA 866 001213 5604 JMP I PCH /RETURN IF NOT 867 001214 2202 ISZ HCTR /TEST SCREEN HEIGHT IF LF 868 001215 5604 JMP I PCH /RETURN IF NOT AT BOTTOM OF SCREEN 869 001216 1200 TAD HEIGHT 870 001217 3202 DCA HCTR /RESET HEIGHT COUNTER NOW 871 001220 1201 TAD DELAY 872 001221 7450 SNA /TEST FOR ZERO DELAY 873 001222 5604 JMP I PCH /RETURN IF SO 874 001223 3203 DCA DCTR /ELSE SET DELAY COUNTER 875 001224 2262 DLOOP, ISZ PSWAP /NOW EXEC INNER LOOP 4096 TIMES (USUALLY) 876 001225 5224 JMP .-1 877 001226 6031 KSF /TEST IF KEY STRUCK 878 001227 7410 SKP 879 001230 5604 JMP I PCH /RETURN AT ONCE IF YES 880 001231 2203 ISZ DCTR /TEST DELAY TIMER 881 001232 5224 JMP DLOOP /REITERATE 882 001233 5604 JMP I PCH /NOW ALLOW PRINTING TO CONTINUE 883 884 /OPERATE CLASS INSTRUCTIONS 885 886 001234 1056 OPERI, TAD INSAV /GET OPERATE INSTRUCTION 887 001235 0171 AND [17 /MASK OFF OPERATE OPCODE 888 001236 1241 TAD JMPI3 /BUILD JUMP OFF OPERATE JUMPTABLE 889 001237 3240 DCA .+1 /STORE THE JUMP IN LINE 890 001240 1240 . /DISPATCH TO PROPER OPERATE ROUTINE 891 892 001241 5642 JMPI3, JMP I .+1 /JUMP TO OPERATE ROUTINE CALLED FOR 893 894 /OPERATE JUMP TABLE 895 896 001242 1535 FUNC3I /CALL RESIDENT FUNCTION OPCODE 0 897 001243 1600 SPFUNC /SPECIAL FUNCTIONS OPCODE 1 898 001244 2000 SFN /SET FILE NUMBER OPCODE 2 899 001245 2552 FNEGI /NEGATE FAC OPCODE 3 900 001246 2043 RETRNI /GOSUB RETURN OPCODE 4 901 001247 1650 RESTOR /RESTORE DEVICE OPCODE 5 902 001250 1406 LSUB1I /LOAD S1 FROM FAC OPCODE 6 903 001251 1400 LSUB2I /LOAD S2 FROM FAC OPCODE 7 904 001252 0020 MSPACE, 20 /THIS OPCODE NOT DEFINED,SO WE PUT A CONST HERE 905 001253 3077 READI /READ DEVICE OPCODE 11 906 001254 3200 WRITEI /WRITE DEVICE OPCODE 12 907 001255 2441 SWRITE /STRING WRITE OPCODE 13 908 001256 1462 FUNC5I /CALL FILE FUNCTION OPCODE 14 909 001257 1457 FUNC4I /CALL USER FUNCTION OPCODE 15 910 001260 1464 FUNC1I /CALL FUNCTIONS 1 OPCODE 16 911 001261 1463 FUNC2I /CALL FUNCTIONS 2 OPCODE 17 912 /ROUTINE TO SWAP PG 17600 WITH N7400 OR N7600 (WHICHEVER THE CASE MAY BE) 913 /WHERE N IS THE HIGH CORE FIELD 914 915 001262 0000 PSWAP, 0 916 001263 1306 TAD KK7600 /POINTER TO 17600 AND COUNTER 917 001264 3040 DCA TEMP1 918 001265 1031 TAD PSFLAG /GET SWAPPING FLAGS 919 001266 7010 RAR 920 001267 7024 CML RAL /TOGGLE THE INPLACE BIT 921 001270 3031 DCA PSFLAG /STORE IT BACK 922 001271 1313 TAD HICORE /PICK UP ADDR OF HIGH CORE 923 001272 3064 DCA TEMP2 /POINTER TO HIGH CORE 924 001273 7402 P1CDF, HLT /DF TO HI CORE 925 001274 1464 TAD I TEMP2 /GET WORD FROM HI CORE 926 001275 3043 DCA TEMP4 /SAVE IT 927 001276 6211 P2CDF, CDF 10 928 001277 1440 TAD I TEMP1 /GET WORD FROM 17600 929 001300 7402 P1CDF1, HLT /DF TO HI CORE AGAIN 930 001301 3464 DCA I TEMP2 /PUT 17600 WORD IN HI CORE 931 001302 6211 P2CDF1, CDF 10 932 001303 1043 TAD TEMP4 /GET SAVED HI CORE WORD 933 001304 3440 DCA I TEMP1 /AND PUT IN 17600 934 001305 2064 ISZ TEMP2 /BUMP HI CORE POINTER 935 001306 7600 KK7600, 7600 /CLA 936 001307 2040 ISZ TEMP1 /BUMP 17600 POINTER AND CHECK FOR DONE 937 001310 5273 JMP P1CDF /NO DONE-MOVE NEXT WORD 938 001311 6201 CDF 939 001312 5662 JMP I PSWAP /DONE-RETURN 940 001313 0000 HICORE, 0 /POINTS TO LOCATION OF 17600 SAVE AREA 941 942 IFNZRO EAE < 943 944 /TEMPORARY INCLUSION FOR FFOUT 945 946 /ADD OP TO FAC 947 948 OADD, 0 949 CLL 950 TAD AC2 951 TAD AC1 952 DCA AC1 /ADD GUARD BITS 953 RAL 954 TAD OPL 955 TAD ACL 956 DCA ACL /ADD LOW ORDER BITS 957 RAL 958 TAD OPH 959 TAD ACH 960 DCA ACH /ADD HIGH ORDER BITS 961 JMP I OADD 962 963 /SHIFT FAC LEFT 1 BIT 964 965 AL1, 0 966 TAD AC1 967 CLL RAL 968 DCA AC1 969 TAD ACL 970 RAL 971 DCA ACL 972 TAD ACH 973 RAL 974 DCA ACH 975 JMP I AL1 976 > 977 001377 7763 PAGE 978 /LOAD SUBSCRIPT 1 OR 2 FROM FAC OR MEMORY 979 980 001400 2210 LSUB2I, ISZ DCASUB 981 001401 5206 JMP LSUB1I 982 001402 2210 LS2I, ISZ DCASUB 983 001403 4560 LS1I, JMS I [FACSAV /PRESERVE FAC 984 001404 4616 JMS I ARGPRL /GET ARG POINTER INTO AC 985 001405 4557 JMS I [FFGET /LOAD ARG INTO FAC (SKIPS NEXT INST ON RETURN) 986 001406 4560 LSUB1I, JMS I [FACSAV /SAVE THE FAC 987 001407 4556 JMS I [UNSFIX /GET INT(FAC) 988 001410 3033 DCASUB, DCA S1 /SET RESULT AS SUBSCRIPT 1 989 001411 4555 JMS I [FACRES /RESTORE FAC 990 001412 1215 TAD DCAS1 991 001413 3210 DCA DCASUB /FUDGE INSTR BACK 992 001414 5570 JMP I [ILOOP /NEXT INSTRCUTION 993 001415 3033 DCAS1, DCA S1 994 001416 0311 ARGPRL, ARGPRE 995 996 /JMP DISPATCH FOR FUNC1 CALLS 997 998 001417 4620 JMSI4, JMS I .+1 /CALL FOR CANNED FUNCTION SET 1 999 1000 /JUMP TABLE FOR FUNCTION CALL 1 1001 1002 001420 4200 ATAN /FUNCTION BITS= 0 1003 001421 4053 COS / 1 1004 001422 4107 EXPON1 / 2 1005 001423 3476 EXPON / 3 1006 001424 3400 INT / 4 1007 001425 4263 LOG / 5 1008 001426 3632 SGN / 6 1009 001427 4000 SIN / 7 1010 001430 4540 RND / 10 1011 001431 3646 FROOT / 11 1012 1013 /JUMP FOR FUNC2 DISPATCH 1014 1015 001432 5633 JMSI5, JMP I .+1 /JMP OFF THE SET 2 TABLE 1016 1017 /JUMP TABLE FOR FUNCTION SET 2 1018 1019 001433 3407 ASC /FUNCTION BITS= 0 1020 001434 3401 CHR / 1 1021 001435 3600 DATE / 2 1022 001436 3411 LEN / 3 1023 001437 4400 POS / 4 1024 001440 4250 SEG / 5 1025 001441 3422 STR / 6 1026 001442 3447 VAL / 7 1027 001443 4006 ERRORR / 10 1028 /ERRORR MUST BE FUNCTION #10,ELSE "ERROPC" MUST CHANGE 1029 001444 4000 TRACE / 11 1030 001445 3670 TPRINT / 12 1031 /TPRINT MUST BE #12 OR TRHOOK+1 MUST CHANGE 1032 1033 /DISPATCH FOR FUNC5 CALLS 1034 1035 001446 5647 JMPFIL, JMP I .+1 /CALL FORR FILE MANIPULATING FUNCTIONS 1036 1037 /JUMP TABLE FOR FILE FUNCTIONS 1038 1039 001447 3600 CHAIN /FUNCTION BITS= 0 1040 001450 3406 CLOSE / 1 1041 001451 4001 OPENAF / 2 1042 001452 4000 OPENAV / 3 1043 001453 4004 OPENNF / 4 1044 001454 4003 OPENNV / 5 1045 001455 3732 FSTOP /INT. EXIT 6 1046 1047 /ERROR CALL FOR USER FUNCTIONS-USER FUNCTION SHOULD "JMS I (IA" 1048 1049 001456 4564 IA, JMS I [ERROR 1050 /FUNCTION OVERLAY DRIVER 1051 1052 001457 4576 FUNC4I, JMS I [XPRINT /PURGE TTY RING BUFFER 1053 001460 5257 JMP .-1 /BEFORE CALLING USER FUNCTION 1054 001461 7001 IAC /LOOK FOR OVERLAY FLAG=3 1055 001462 7001 FUNC5I, IAC /LOOK FOR OVERLAY FLAG=2 1056 001463 7001 FUNC2I, IAC /LOOK FOR OVERLAY FLAG=1 1057 001464 3040 FUNC1I, DCA TEMP1 /LOOK FOR OVERLAY FLAG=0 1058 001465 6201 CDF /DF TO THIS FIELD 1059 001466 1040 TAD TEMP1 /GET OVERLAY # AGAIN 1060 001467 7041 CIA /NEGATE 1061 001470 1323 TAD OVRLAY /COMPARE AGAINST OVERLAY FLAG 1062 001471 7650 SNA CLA /IS THE ONE WE WANT ALREADY RESIDENT? 1063 001472 5307 JMP OVDNE /YES-JUST JUMP TO FUNCTION 1064 001473 1040 TAD TEMP1 /NO-GET NUMBER OF OVERALY DESIRED 1065 001474 1321 TAD OATADI /USE AS OFFSET TO BUILD STARTING BLOCK TAD 1066 001475 3064 DCA TEMP2 /POINTS TO PROPER STARING BLOCK # 1067 001476 1464 TAD I TEMP2 /GET STARTING BLOCK FOR THIS OVERLAY 1068 001477 3303 DCA OVADD /PUT IN DRIVER CALL 1069 001500 4722 JMS I L7607 /CALL SYSTEM HANDLER 1070 001501 0500 0500 /OVERLAY 3400-4600 1071 001502 3400 3400 1072 001503 1503 OVADD, . /STARTING BLOCK # OF OVERLAY 1073 001504 4564 OE, JMS I [ERROR /I/O ERROR 1074 001505 1040 TAD TEMP1 1075 001506 3323 DCA OVRLAY /CHANGE RESIDENT FLAG 1076 001507 1154 OVDNE, TAD [SAC-1 /ENTER STRING FUNCTIONS WITH SACXR SET UP 1077 001510 3010 DCA SACXR 1078 001511 1040 TAD TEMP1 /FUNCTION # 1079 001512 1330 TAD JMSTAD /BUILD A TAD OF THE PROPER DISPATCH JMS 1080 001513 3315 DCA .+2 /PUT IN LINE 1081 001514 4553 JMS I [FBITGT /GET # OF FUNCTION DESIRED 1082 001515 1515 . /BUILD JUMP OFF JUMP TABLE 1083 001516 3317 FUJUMP, DCA .+1 /PUT JUMP IN LINE 1084 001517 1517 . /GO TO DESIRED FUNCTION 1085 001520 5570 JMP I [ILOOP /DONE 1086 1087 001521 1524 OATADI, ARITHA 1088 001522 7607 L7607, 7607 1089 001523 0000 OVRLAY, 0 /# OF CURRENTLY RESIDENT OVERLAY 1090 /0=ARITHMETIC,1=STRING,2=FILE,3=USER 1091 1092 /OVERLAY TABLE-CONTAINS STARTING BLOCK # OF SYSTEM OVERLAYS 1093 /INITIALIZED BY LOADER 1094 1095 001524 1524 ARITHA, . /STARTING BLOCK OF ARITHMETIC OVERLAY 1096 001525 1525 STRNGA, . /STARTING BLOCK OF STRING OVERLAY 1097 001526 1526 FILEFA, . /STARTING BLOCK OF FILE OVERLAY 1098 001527 1527 USRA, . /STARTING BLOCK OF USER FUNCTIONS 1099 1100 001530 1731 JMSTAD, TAD I TADTAB 1101 1102 001531 1417 TADTAB, JMSI4 1103 001532 1432 JMSI5 1104 001533 1446 JMPFIL 1105 001534 1557 JMSUSR 1106 1107 /CALL FOR RESIDENT FUNCTION 1108 1109 001535 4553 FUNC3I, JMS I [FBITGT /ISOLATE FUNCTION # 1110 001536 1340 TAD JMSI7 /MAKE A JUMP OFF JUMP TABLE 1111 001537 5316 JMP FUJUMP /PUT THE JUMP IN LINE AND EXECUTE IT 1112 1113 001540 5741 JMSI7, JMP I .+1 1114 1115 /JUMP TABLE FOR RESIDENT FUNCTIONS 1116 1117 001541 2350 XABSVL /FUNCTION BITS= 0 1118 001542 2466 COMMA / 1 1119 001543 2512 CRFUNC / 2 1120 001544 0243 ILOOPF / 3 1121 001545 2521 TAB / 4 1122 001546 1760 PNT / 5 1123 001547 0573 USE / 6 1124 1125 1126 *1557 /****N.B.**** 1127 /THIS TABLE CANNOT BE MOVED!!!! 1128 1129 /JUMP DISPATCH FOR USER ROUTINES 1130 001557 4760 JMSUSR, JMS I .+1 1131 1132 /JUMP TABLE FOR USER FUNCTIONS 1133 001560 0243 ILOOPF /USER FUNCTION 1 1134 001561 0243 ILOOPF / 2 1135 001562 0243 ILOOPF / 3 1136 001563 0243 ILOOPF / 4 1137 001564 0243 ILOOPF / 5 1138 001565 0243 ILOOPF / 6 1139 001566 0243 ILOOPF / 7 1140 001567 0243 ILOOPF / 8 1141 001570 0243 ILOOPF / 9 1142 001571 0243 ILOOPF / 10 1143 001572 0243 ILOOPF / 11 1144 001573 0243 ILOOPF / 12 1145 001574 0243 ILOOPF / 13 1146 001575 0243 ILOOPF / 14 1147 001576 0243 ILOOPF / 15 1148 001577 0243 ILOOPF / 16 1149 1150 PAGE 1151 /SPECIAL FUNCTIONS 1152 1153 001600 4553 SPFUNC, JMS I [FBITGT /ISOLATE FUNCTION BITS 1154 001601 1204 TAD JMPI6 /MAKE A JUMP OFF SPECIAL FUNCTION TABLE 1155 001602 3203 DCA .+1 /PUT IN LINE 1156 001603 1603 . 1157 1158 001604 5605 JMPI6, JMP I .+1 /JUMP TO SPECIAL FUNCTION ROUTINE 1159 1160 /SPECIAL FUNCTION JUMP TABLE 1161 1162 001605 2067 SETF /SET FSWITCH 0 1163 001606 2326 FRANDM /RANDOMIZE 1 1164 001607 0565 FSTOPN /LEAVE INTERPRETER 2 1165 001610 2200 SRLIST /STRING READ FROM DATA LIST 3 1166 001611 2001 CSFN /SET FILE # TO TTY 4 1167 001612 6547 RDLIST /READ DATA LIST 5 1168 001613 0214 AMODE /SWITCH TO A MODE 6 1169 001614 0213 SSMODE /SWITCH TO S MODE 7 1170 /SUBROUTINE UNSFIX-UNSIGNED INTEGER FIX ROUTINE. FIXS A POSITIVE 12 BIT 1171 /NUMBER OUT OF FAC MANTISSA AND LEAVES RESULT IN AC.RESULT IS AN UNSIGNED, 1172 /12 BIT INTEGER 1173 1174 001615 0000 UNSFIX, 0 1175 001616 6201 CDF 0 1176 001617 1046 TAD ACL /LOW MANTISSA 1177 001620 7104 CLL RAL /HI BIT OF LO MANTISSA TO LINK 1178 001621 7200 CLA 1179 001622 1045 TAD ACH /HIGH MANTISSA 1180 001623 7510 SPA /IS NUMBER POSITIVE? 1181 001624 4564 FM, JMS I [ERROR /NO-BOO!!! 1182 001625 7004 RAL /SHIFT THE SIGN BIT OUT AND THE MANTISSA OVER, 1183 001626 3045 DCA ACH /MAKING 12 BITS OF MANTISSA AND BINARY POINT BEFORE BIT 0 1184 001627 1044 TAD ACX /GET EXPONENT 1185 001630 7750 SPA SNA CLA /IS X>1? 1186 001631 5615 JMP I UNSFIX /NO-FIX IT TO 0 1187 001632 1044 TAD ACX /YES-GET EXPONENT 1188 001633 1152 TAD [-14 /SET BINARY POINT AT 12 1189 001634 7450 SNA /DONE ALREADY? 1190 001635 5246 JMP UNSOUT /YES 1191 001636 7500 SMA /NO-IS # TOO BIG? 1192 001637 4564 FO, JMS I [ERROR /YES 1193 001640 3044 DCA ACX /NO-STORE COUNT 1194 001641 1045 TAD ACH /HI MANTISSA 1195 001642 7110 UNSLP, CLL RAR /SCALE RIGHT 1196 001643 2044 ISZ ACX /DONE? 1197 001644 5242 JMP UNSLP /NO 1198 001645 5615 JMP I UNSFIX /YES-RETURN 1199 1200 001646 1045 UNSOUT, TAD ACH /ANSWER IN AC 1201 001647 5615 JMP I UNSFIX 1202 1203 /RESTORE ROUTINE 1204 1205 001650 1065 RESTOR, TAD ENTNO /GET CURRENT FILE # 1206 001651 7650 SNA CLA /IS IT 0? 1207 001652 5266 JMP RESDLS /YES-RESTORE DATA LIST 1208 001653 4777 JMS I (WRBLK /NO-WRITE CURRENT BUFFER 1209 001654 7240 STA /-1 1210 001655 1473 TAD I IOTLOC /STARTING BLOCK-1 1211 001656 3470 DCA I IOTBLK /SET CURRENT BLOCK # 1212 001657 1467 TAD I IOTBUF /GET BUFFER ADDRESS 1213 001660 3471 DCA I IOTPTR /USE IT TO RESET READ\WRITE POINTER 1214 001661 1466 TAD I IOTHDR /GET HEADER WORD 1215 001662 0376 AND (7435 /CLEAR EOF BIT,BUFFER WRITTEN BIT,AND CHAR # 1216 001663 3466 DCA I IOTHDR 1217 001664 4551 JMS I [NEXREC /READ FIRST BLOCK INTO BUFFER 1218 001665 5570 JMP I [ILOOP /DONE 1219 001666 1030 RESDLS, TAD DLSTRT /ADDRESS OF START OF INCORE DATA LIST 1220 001667 3016 DCA DATAXR /USE IT TO RESET DATA LIST POINTER 1221 001670 5570 JMP I [ILOOP /THATS ALL! 1222 /SUBROUTINE STFIND-WHEN CALLED,IF LINK=1 STRING ARRAY TABLE IS 1223 /USED,IF LINK=0 STRING SYMBOL TABLE IS USED. RETURNS WITH AC SET 1224 /TO CDF OF OPERAND STRING,STRPTR POINTING TO THE FIRST WORD 1225 /IN THE STRING, AND THE MAX LENGTH OF THE STRING IS IN STRMAX. ALSO, 1226 /THE ACTUAL LENGTH OF THE STRING IS IN STRCNT 1227 1228 001671 0000 STFIND, 0 1229 001672 7430 SZL /IS THIS AN ARRAY INST? 1230 001673 5352 JMP SAFIND /YES-POINTER IS INTO ARRAY TABLE 1231 001674 1056 TAD INSAV /GET INST AGAIN 1232 001675 0174 AND [377 /ISOLATE OPERAND POINTER 1233 001676 3040 DCA TEMP1 /NO-SAVE OPERAND POINTER 1234 001677 1040 TAD TEMP1 /N 1235 001700 7104 CLL RAL /2N 1236 001701 1040 TAD TEMP1 /3N (3 WORDS/ENTRY) 1237 001702 1023 TAD STSTRT /ADD BASE ADR OF STRING TABLE 1238 001703 3012 STCOM, DCA XR2 /POINTER TO THIS ENTRY IN STRING TABLE 1239 001704 1704 STDF, . /DF TO THAT OF SYMBOL TABLES (SET BY START) 1240 001705 1412 TAD I XR2 /GET POINTER TO STRING 1241 001706 3063 DCA STRPTR 1242 001707 1412 TAD I XR2 /GET CDF FOR OPERAND STRING 1243 001710 3342 DCA STRCDF /SAVE 1244 001711 1412 TAD I XR2 /GET -(MAX LENGTH OF STRING) 1245 001712 3061 DCA STRMAX /SAVE 1246 001713 7420 SNL /ARRAY ELEMENT? 1247 001714 5342 JMP STRCDF /NO-SKIP THIS SUBSCRIPT CALCULATION 1248 001715 1033 TAD S1 /GET SUBSCRIPT 1249 001716 7140 CLL CMA /SET UP 12 BIT COMPARE 1250 001717 1412 TAD I XR2 /GET DIMENSION 1251 001720 7620 SNL CLA /IS S1>DIMENSION? 1252 001721 5775 JMP I (SU /YES 1253 001722 1061 TAD STRMAX /NO-GET ELEMENT LENGTH 1254 001723 7041 CIA /MAKE POSITIVE 1255 001724 7101 CLL IAC /ROUND OFF TO NEAREST MULTIPLE OF 2 1256 001725 7110 CLL RAR / DIVIDE BY TWO (COUNT/2=WORD COUNT) 1257 001726 7101 CLL IAC /ADD A WORD FOR HEADER 1258 001727 3042 DCA TEMP3 /# OF WORDS IN EACH ARRAY ELEMENT 1259 001730 1033 TAD S1 /GET SUBSCRIPT 1260 001731 4563 JMS I [MPY /S1*ELEMENT LENGTH (ASSUMES LINK UNCHANGED ON RETURN) 1261 001732 1063 TAD STRPTR /ARRAY OFFSET+POINTER TO A(0) 1262 001733 3063 DCA STRPTR /FINAL STRING POINTER 1263 001734 7004 RAL /CARRY TO BIT 11 1264 001735 1050 TAD TEMP6 /ADD TO ACCUMLATED OVERLAPS FROM MULTIPLY 1265 001736 7106 CLL RTL 1266 001737 7004 RAL /PUT OVERLAP # INTO BITS 6-8 1267 001740 1342 TAD STRCDF /ADD TO CDF IF NECESSARY 1268 001741 3342 DCA STRCDF /SAVE AGAIN 1269 001742 0000 STRCDF, 0 /DF TO STRING FIELD 1270 001743 1463 TAD I STRPTR 1271 001744 6201 CDF 1272 001745 3062 DCA STRCNT /STORE -(CURRENT LENGTH OF STRING) 1273 001746 1342 TAD STRCDF /CDF TO OPERAND IN AC 1274 001747 3774 DCA I (SSTEX /SETUP STRING STORE EXIT DF HERE 1275 001750 4773 JMS I (BYTSET /ENTER FUNCTIONS WITH BYTE POINTERS SETUP 1276 001751 5671 JMP I STFIND /RETURN 1277 1278 001752 1056 SAFIND, TAD INSAV /GET INST 1279 001753 0372 AND (37 /ISOLATE OPERAND POINTER 1280 001754 7106 CLL RTL /4N (4 WORDS/ENTRY) 1281 001755 1024 TAD SASTRT /USE STRING ARRAY TABLE 1282 001756 7120 STL /SET LINK FOR ARRAY INST 1283 001757 5303 JMP STCOM /RETURN TO SUBROUTINE MAINLINE 1284 1285 /PNT(X) 1286 /SEND 7BIT CHAR TO THE CURRENT FILE 1287 1288 001760 4556 PNT, JMS I [UNSFIX /FIX X 1289 001761 0162 AND [177 /STRIP TO 7 ASCII BITS 1290 001762 1172 TAD [200 /FORCE CHANNEL 8 1291 001763 4550 JMS I [PUTCH /PUT IN FILE BUFFER 1292 001764 5570 JMP I [ILOOP /DONE 1293 1294 001772 0037 PAGE 001773 2653 001774 2666 001775 0623 001776 7435 001777 3337 1295 /ROUTINE SFN-ROUTINE TO RESET POINTERS IN PAGE ZERO FILE POINTER 1296 /AREA TO REFLECT A CHANGE IN THE CURRENT FILE NUMBER 1297 1298 002000 4556 SFN, JMS I [UNSFIX /FIX FAC TO GET FILE # 1299 002001 3065 CSFN, DCA ENTNO /IF ENTRY IS HERE,FILE #=0 (TTY) 1300 002002 1065 TAD ENTNO 1301 002003 7120 STL 1302 002004 1377 TAD (-4 /IS RESULT A LEGAL FILE #? 1303 002005 7660 SNL SZA CLA 1304 002006 4564 FN, JMS I [ERROR /NO-ERROR 1305 002007 1065 TAD ENTNO /PICK UP FILE NUMBER 1306 002010 7106 CLL RTL 1307 002011 7006 RTL 1308 002012 7041 CIA 1309 002013 1065 TAD ENTNO 1310 002014 7041 CIA /MULTIPLY BY SIZE OF IOTABLE 1311 IFNZRO IOTSIZ-15 <__ASSEMBLY ERROR__> 1312 002015 1376 TAD (TTYF /ADD TO BASE 1313 002016 3011 DCA XR1 /STORE IN TEMP 1314 002017 1375 TAD (IOTHDR-1 /NOW POINT AT PAGE 0 AREA 1315 002020 3012 DCA XR2 1316 002021 1374 TAD (-IOTSIZ+3 /SETUP ALL BUT LAST 3 1317 002022 3064 DCA TEMP2 1318 002023 1011 TAD XR1 1319 002024 3412 DCA I XR2 1320 002025 2011 ISZ XR1 1321 002026 2064 ISZ TEMP2 1322 002027 5223 JMP .-4 /SET UP THE POINTERS NOW 1323 002030 5570 JMP I [ILOOP /--RETURN-- 1324 /GOSUB 1325 1326 002031 1660 GOSUB, TAD I GSP 1327 002032 7700 SMA CLA 1328 002033 4564 GS, JMS I [ERROR /ERROR IF STACK OVERFLOW 1329 002034 1565 TAD I [CDFPSU /ELSE GET CDF INSTR 1330 002035 3660 DCA I GSP 1331 002036 2260 ISZ GSP 1332 002037 1773 TAD I (INTPC 1333 002040 3660 DCA I GSP /STORE INT PC 1334 002041 2260 ISZ GSP 1335 002042 5772 JMP I (SUCJMP /EXEC AS NORMAL GOTO NOW 1336 1337 /GOSUB RETURN 1338 1339 002043 7240 RETRNI, STA 1340 002044 1260 TAD GSP 1341 002045 3260 DCA GSP /POP STACK 1342 002046 1660 TAD I GSP /GET PC 1343 002047 3773 DCA I (INTPC 1344 002050 7240 STA 1345 002051 1260 TAD GSP /POP STACK 1346 002052 3260 DCA GSP 1347 002053 1660 TAD I GSP 1348 002054 7500 SMA 1349 002055 4564 GR, JMS I [ERROR /FATAL ERROR IF NO RETURN 1350 002056 3565 DCA I [CDFPSU 1351 002057 5771 JMP I (JFAIL /BUMP PC PAST ADDR WORD AND CONTINUE 1352 1353 002060 0521 GSP, GSTCK /GOSUB STACK POINTER 1354 1355 /FOR-LOOP JUMP ROUTINE 1356 /ENTER WITH AC = HORD 1357 1358 002061 7450 JFOR, SNA /IS FAC=0? 1359 002062 5771 JMP I (JFAIL /YES-DO NOT JUMP 1360 002063 1273 TAD FSWITC /ADD FSWITCH 1361 002064 7710 SPA CLA /ARE SIGN BIT=FSWITCH? 1362 002065 5771 JMP I (JFAIL /NO-DO NOT JUMP 1363 002066 5772 JMP I (SUCJMP /YES-DO JUMP 1364 1365 /ROUTINE TO INITIALIZE FSWITCH 1366 1367 002067 7330 SETF, AC4000 1368 002070 0045 AND ACH /ISOLATE SIGN OF MANTISSA 1369 002071 3273 DCA FSWITC /STORE IN FSWITCH 1370 002072 5570 JMP I [ILOOP /DONE 1371 002073 0000 FSWITC, 0 1372 /ROUTINE TO RESET CHARACTER NUMBER TO 1 1373 1374 002074 0000 CNOCLR, 0 1375 002075 1466 TAD I IOTHDR 1376 002076 0147 AND [7477 /SET CHAR BITS TO 0 1377 002077 3466 DCA I IOTHDR 1378 002100 5674 JMP I CNOCLR /RETURN 1379 1380 /ROUTINE TO ZERO THE CURRENT I/O BUFFER 1381 1382 002101 0000 BLZERO, 0 1383 002102 7240 STA 1384 002103 1467 TAD I IOTBUF 1385 002104 3011 DCA XR1 /POINT INTO THE BUFFER 1386 002105 1175 TAD [7400 1387 002106 3316 DCA CNOBML /SET COUNT TO 400 WORDS 1388 002107 1370 TAD (232 /INSERT A ^Z IN THE BUFFER FIRST 1389 002110 6211 CDF 10 1390 002111 3411 DCA I XR1 1391 002112 2316 ISZ CNOBML 1392 002113 5311 JMP .-2 /LOOP FOR THE REST 1393 002114 6201 CDF 1394 002115 5701 JMP I BLZERO /--RETURN-- 1395 1396 /BUMP 3 FOR 2 CHAR NUMBER FOR CURRENT FILE 1397 1398 002116 0000 CNOBML, 0 1399 002117 1466 TAD I IOTHDR /HEADER WORD 1400 002120 1146 TAD [100 /ADD 1 TO THE COUNT BITS 1401 002121 3466 DCA I IOTHDR 1402 002122 5716 JMP I CNOBML /DONE 1403 /STRING COMPARE 1404 /COMPARE SAC WITH MEMORY, BLANK EXTENDING THE 1405 /SHORTER STRING ON THE RIGHT 1406 1407 002123 3055 SCOMP, DCA MODESW /SET INTERPRETER TO ARITH MODE NOW 1408 002124 4561 JMS I [FACCLR /TENTATIVELY ASSUME EQUAL (FAC = 0) 1409 002125 1062 SCOMLP, TAD STRCNT /IS THE MEMORY STRING EMPTY NOW? 1410 002126 7650 SNA CLA 1411 002127 1347 TAD L40 /PAD WITH SPACE IF YES 1412 002130 7450 SNA 1413 002131 4767 JMS I (LDB /LOAD NEXT BYTE IF NOT 1414 002132 3064 DCA TEMP2 1415 002133 1032 TAD SACLEN /NOW IS THE SAC EMPTY 1416 002134 7650 SNA CLA 1417 002135 1347 TAD L40 /YES, PAD IT 1418 002136 7450 SNA 1419 002137 1410 TAD I SACXR /NO GET IT 1420 002140 7141 CLL CIA /COMPARE TO MEMORY 1421 002141 1064 TAD TEMP2 1422 002142 7640 SZA CLA 1423 002143 5360 JMP SNEQ /JMP IF NOT EQUAL, L=SENSE OF COMPARE 1424 002144 1062 TAD STRCNT /IS MEMORY STRING DONE 1425 002145 7640 SZA CLA 1426 002146 2062 ISZ STRCNT /NO, BUMP COUNT 1427 002147 0040 L40, 40 /EFFECTIVE NOP 1428 002150 1032 TAD SACLEN /IS THE SAC EMPTY 1429 002151 7640 SZA CLA 1430 002152 2032 ISZ SACLEN /NO BUMP COUNT 1431 002153 1032 TAD SACLEN /GET SAC REMAINDER (SKP IF IS JUST ZERO) 1432 002154 1062 TAD STRCNT /ADD ARG REMAINDER 1433 002155 7640 SZA CLA 1434 002156 5325 JMP SCOMLP /LOOP IF BOTH NOT EMPTY 1435 002157 5570 JMP I [ILOOP /OTHERWISE EQUAL 1436 002160 7250 SNEQ, STA RAR 1437 002161 3045 DCA ACH /STORE SIGN BIT 1438 002162 5570 JMP I [ILOOP /--RETURN-- 1439 1440 002167 2600 PAGE 002170 0232 002171 0465 002172 0474 002173 0304 002174 7766 002175 0065 002176 6677 002177 7774 1441 /STRING DATA LIST READ, STRING LOAD AND STRING CONCATENATE 1442 1443 002200 4777 SRLIST, JMS I (DLREAD /FIRST READ NEG BYTE COUNT 1444 002201 3062 DCA STRCNT /STORE IT 1445 002202 7120 STL /SET LINK MEANS USE PHONY DATA LIST BYTE LOAD 1446 002203 7410 SKP /SKP INTO STRING LOAD ROUTINE 1447 002204 7100 SLOAD, CLL /CLEAR LINK TO USE NORMAL LOAD BYTE ROUTINE 1448 002205 3032 DCA SACLEN /CLEAR SAC LENGTH COUNTER 1449 002206 7430 SZL 1450 002207 1376 TAD (DRGCH-LDB /USE PHONY LOAD BYTE 1451 002210 1375 SCON1, TAD (LDB /USE REAL LDB FOR CONCATENATE 1452 002211 3235 DCA SCLDB 1453 002212 1062 TAD STRCNT 1454 002213 7650 SNA CLA 1455 002214 5570 JMP I [ILOOP /NOTHING TO DO IF NULL STRING 1456 002215 1032 TAD SACLEN /COMPUTE OFFSET INTO SAC 1457 002216 7041 CIA 1458 002217 1154 TAD [SAC-1 1459 002220 3010 DCA SACXR /TO STORE AFTER END OF PREV STRING 1460 002221 4635 SEGCOM, JMS I SCLDB /GET A BYTE 1461 002222 3410 DCA I SACXR /STORE IT 1462 002223 7240 STA 1463 002224 1032 TAD SACLEN /NOW BUMP SIZE OF SAC 1464 002225 3032 DCA SACLEN 1465 002226 1032 TAD SACLEN /CHECK IF ROOM LEFT 1466 002227 1374 TAD (SACLIM 1467 002230 7710 SPA CLA 1468 002231 4564 SC, JMS I [ERROR /FATAL ERROR IF SAC OVERFLOW 1469 002232 2062 ISZ STRCNT 1470 002233 5221 JMP SEGCOM /ITERATE IF MORE 1471 002234 5570 JMP I [ILOOP /--RETURN-- 1472 1473 002235 0000 SCLDB, 0 1474 1475 /ROUTINE TO GET A BYTE FROM THE DATA LIST 1476 1477 002236 0000 DRGCH, 0 1478 002237 1032 TAD SACLEN /TEST FOR EVEN OR ODD 1479 002240 7110 CLL RAR 1480 002241 7630 SZL CLA 1481 002242 5252 JMP CHR2 /SECOND CHAR 1482 002243 4777 JMS I (DLREAD /FIRST CHAR, READ ANOTHER WORD 1483 002244 3255 DCA DRCHR 1484 002245 1255 TAD DRCHR 1485 002246 7112 CLL RTR 1486 002247 7012 RTR 1487 002250 7012 RTR /SHIFT RIGHT 1488 002251 7410 SKP 1489 002252 1255 CHR2, TAD DRCHR /GET SECOND CHAR 1490 002253 0145 AND [77 /MASK TO 6BIT 1491 002254 5636 JMP I DRGCH /RETURN 1492 1493 002255 0000 DRCHR, 0 1494 1495 /ROUTINE TO SET EOF BIT IN I/O ENTRY 1496 002256 1466 EOFSET, TAD I IOTHDR /HEADER 1497 002257 7112 CLL RTR /EOF BIT TO LINK 1498 002260 7126 STL RTL /SET LINK 1499 /PUT LINK IN EOF BIT 1500 002261 3466 DCA I IOTHDR /STORE IN I/O TABLE ENTRY 1501 002262 5570 JMP I [ILOOP /EOF BIT SET-ABORT TO ILOOP 1502 1503 /SUBROUTINE MPY- 12 BIT BY 12 BIT MULTIPLY. MULTIPLIES THE CONTENTS 1504 /OF TEMP3 BY THE CONTENTS OF THE AC,LEAVING THE HI RESULT IN TEMP6 1505 /AND THE LOW RESULT IN THE AC 1506 1507 002263 0000 MPY, 0 1508 002264 3054 DCA TEMP10 1509 002265 3050 DCA TEMP6 1510 002266 1152 TAD [-14 1511 002267 3047 DCA TEMP5 1512 002270 1042 MP12LP, TAD TEMP3 1513 002271 7010 RAR 1514 002272 3042 DCA TEMP3 1515 002273 1050 TAD TEMP6 1516 002274 7420 SNL 1517 002275 5300 JMP .+3 /12 BIT MULTIPLY USED TO FIND (DIM1+1)*S2 1518 002276 7100 CLL 1519 002277 1054 TAD TEMP10 1520 002300 7010 RAR 1521 002301 3050 DCA TEMP6 1522 002302 2047 ISZ TEMP5 1523 002303 5270 JMP MP12LP 1524 002304 1042 TAD TEMP3 /LORD OF (DIM1+1)*S2 IN AC 1525 002305 7010 RAR /HORD OF (DIM1+1)*S2 IN TEMP6 1526 002306 5663 JMP I MPY /RETURN 1527 1528 /ROUTINE TO CHECK IF FILE IDLE 1529 1530 002307 0000 IDLE, 0 1531 002310 1472 TAD I IOTHND /GET HANDLER ENTRY 1532 002311 7650 SNA CLA /IS IT EMPTY? 1533 002312 4564 FI, JMS I [ERROR /YES-USER TRIED TO DO SOMETHING TO AN UNOPEN FILE 1534 002313 5707 JMP I IDLE /NO-RETURN 1535 /ROUTINE TO READ NEXT WORD IN DATALIST INTO AC 1536 1537 002314 0000 DLREAD, 0 1538 002315 1016 TAD DATAXR /DATA LIST POINTER 1539 002316 7140 CLL CMA /SET UP 12 BIT COMPARE 1540 002317 1027 TAD DLSTOP /ADDR OF END OF DATA LIST 1541 002320 7620 SNL CLA /POINTER AT END OF LIST? 1542 002321 4564 DA, JMS I [ERROR /YES 1543 002322 2322 DLCDF, . /NO-DF TO DATA LIST 1544 002323 1416 TAD I DATAXR /FETCH WORD FROM DATA LIST 1545 002324 6201 CDF 1546 002325 5714 JMP I DLREAD /DONE 1547 1548 /RANDOMIZE STATEMENT 1549 1550 002326 1017 FRANDM, TAD SPINNR /USE SPINNR FOR NEW SEED FOR RND(X) 1551 002327 7124 STL RAL /MAKE SURE SEED IS ODD 1552 002330 3332 DCA RSEED 1553 002331 5570 JMP I [ILOOP /DONE 1554 002332 2713 RSEED, 2713 1555 1556 /SUBROUTINE CR,LF 1557 1558 002333 0000 CRLFR, 0 1559 002334 1170 TAD [215 1560 002335 4550 JMS I [PUTCH 1561 002336 1373 TAD (212 1562 002337 4550 JMS I [PUTCH /PRINT A CR,AND LF 1563 002340 3476 DCA I IOTPOS /ZERO NUMBER OF CHARS PRINTED SO FAR 1564 002341 5733 JMP I CRLFR 1565 1566 /SUBROUTINE FOTYPE 1567 /RETURNS TO CALL+1 IF FILE FIXED LENGTH,CALL+2 IF VARIABLE 1568 1569 002342 0000 FOTYPE, 0 1570 002343 1466 TAD I IOTHDR /GET HEADER 1571 002344 0372 AND (4 /ISOLATE TYPE BIT 1572 002345 7640 SZA CLA /IS IT FIXED LENGTH? 1573 002346 2342 ISZ FOTYPE /NO-BUMP RETURN 1574 002347 5742 JMP I FOTYPE /RETURN 1575 1576 /ABS(X) FUNCTION 1577 1578 002350 4352 XABSVL, JMS ABSVAL /NEGATE FAC IF NEGATIVE 1579 002351 5570 JMP I [ILOOP /--RETURN-- 1580 1581 /SUBROUTINE TO TAKE ABS VALUE OF FAC 1582 1583 002352 0000 ABSVAL, 0 1584 002353 1045 TAD ACH 1585 002354 7710 SPA CLA /IS FAC<0? 1586 002355 4544 JMS I [FFNEG /YES-NEGATE IT 1587 002356 5752 JMP I ABSVAL /RETURN 1588 1589 /ROUTINE TO RESTORE THE FAC FROM FP TEMP 1590 1591 002357 0000 FACRES, 0 1592 002360 4557 JMS I [FFGET /GET FAC 1593 002361 1151 INTERB 1594 002362 5757 JMP I FACRES /RETURN 1595 1596 002372 0004 PAGE 002373 0212 002374 0120 002375 2600 002376 7436 002377 2314 1597 /STRING STORE 1598 1599 002400 1032 SSTORE, TAD SACLEN 1600 002401 7450 SNA 1601 002402 5777 JMP I (SSTEX /EXIT IF NULL STRING IN SAC 1602 002403 3040 DCA TEMP1 /SET COUNT 1603 002404 1032 TAD SACLEN /SEE IF WILL FIT 1604 002405 7041 CIA 1605 002406 1061 TAD STRMAX 1606 002407 7740 SMA SZA CLA /SKP IF LEN.LE.MAX LEN 1607 002410 4564 SL, JMS I [ERROR /ERROR IF TARGET STRING TOO SMALL 1608 002411 1410 TAD I SACXR /PICK UP SAC BYTE 1609 002412 4776 JMS I (DPB /STORE IT 1610 002413 2040 ISZ TEMP1 1611 002414 5211 JMP .-3 1612 002415 5777 JMP I (SSTEX /--RETURN-- 1613 1614 /STRING READ FROM FILE TO MEMORY 1615 1616 002416 4543 SREAD, JMS I [GETCH /GET CHAR FROM FILE 1617 002417 1053 TAD CHAR 1618 002420 1142 TAD [-215 /IS IS CR? 1619 002421 7450 SNA 1620 002422 5777 JMP I (SSTEX /YES, EXIT 1621 002423 1375 TAD (3 /IS IT LF? 1622 002424 7650 SNA CLA 1623 002425 5216 JMP SREAD /YES, IGNORE IT 1624 002426 1774 TAD I (BYTCNT /SEE IF THIS CHAR WILL FIT 1625 002427 1061 TAD STRMAX 1626 002430 7700 SMA CLA 1627 002431 5235 JMP ST /NO, SOFT ERROR 1628 002432 1053 TAD CHAR /YES, STORE IT 1629 002433 4776 JMS I (DPB 1630 002434 5216 JMP SREAD 1631 002435 4564 ST, JMS I [ERROR 1632 002436 1170 TAD [215 /FAKE OUT INPUT ROUTINE 1633 002437 3053 DCA CHAR 1634 002440 5777 JMP I (SSTEX /SET STRING SIZE AND EXIT 1635 /STRING WRITE FROM SAC TO DEVICE 1636 1637 002441 3337 SWRITE, DCA COMMAS 1638 002442 1032 TAD SACLEN /SEE IF NULL STRING 1639 002443 7450 SNA 1640 002444 5570 JMP I [ILOOP /RETURN IF SO 1641 002445 7041 CIA 1642 002446 1476 TAD I IOTPOS /ADD TO NUMBER OF CHARS PRINTED SO FAR 1643 002447 1373 TAD (-WIDTH 1644 002450 7740 SMA SZA CLA /SKP IF LE WIDTH OF LINE 1645 002451 4541 JMS I [CRLFR /ELSE RESET CARRAIGE 1646 002452 1032 TAD SACLEN 1647 002453 3062 DCA STRCNT /SET LOOP COUNTER 1648 002454 1154 TAD [SAC-1 1649 002455 3010 DCA SACXR /POINT AT SAC 1650 002456 1410 SWRLP, TAD I SACXR 1651 002457 1372 TAD (240 1652 002460 0145 AND [77 1653 002461 1372 TAD (240 /CONVERT TO 8BIT 1654 002462 4771 JMS I (PUTCH 1655 002463 2062 ISZ STRCNT 1656 002464 5256 JMP SWRLP /ITERATE IF MORE 1657 002465 5570 JMP I [ILOOP /--RETURN-- 1658 1659 /COMMA FUNCTION (KNOWN ONLY TO COMPILER FOR FORMATTING PRINT 1660 /STATEMENTS) 1661 1662 002466 4540 COMMA, JMS I [FTYPE /SKP IF FILE IS ASCII 1663 002467 5570 JMP I [ILOOP /NO-COMMA FUNCTION IS A NOP 1664 002470 1337 TAD COMMAS /GET COMMA SWITCH 1665 002471 7650 SNA CLA /WAS LAST THING PRINTED A COMMA? 1666 002472 5275 JMP .+3 /NO-WE ARE OK 1667 002473 1372 TAD (" /YES-PRINT A SPACE BEFORE DOING COMMA CALCULATION 1668 002474 4550 JMS I [PUTCH 1669 002475 7001 IAC 1670 002476 3337 DCA COMMAS /SET COMMA SWITCH 1671 002477 1370 TAD (-4 1672 002500 3064 DCA TEMP2 1673 002501 1476 TAD I IOTPOS /GET NUMBER OF CHARS PRINTED SO FAR 1674 002502 1367 COMLOP, TAD (-COLWID 1675 002503 7510 SPA /PAST THIS ONE? 1676 002504 5327 JMP SLOVER /YES-SLIDE PRINT HEAD TO START OF NEXT 1677 002505 7450 SNA /EXACTLY ON A COLUMN? 1678 002506 5570 JMP I [ILOOP /YES-DONE 1679 002507 2064 ISZ TEMP2 /ALL MARKERS CHECKED YET? 1680 002510 5302 JMP COMLOP /NO-DO NEXT 1681 002511 7200 CLA /FALL INTO CR ROUTINE TO RESET COL TO 0 1682 1683 /CARRIAGE RETURN FUNCTION (KNOWN ONLY TO COMPILER FOR TERMINATING 1684 /PRINT STATEMENTS) 1685 1686 002512 1466 CRFUNC, TAD I IOTHDR 1687 002513 7112 CLL RTR 1688 002514 7620 SNL CLA /SKP IF EOF IS SET 1689 002515 4540 JMS I [FTYPE /SKP IF FILE IS ASCII 1690 002516 5570 JMP I [ILOOP /WE DON'T WANT TO OUTPUT CLFR 1691 002517 4541 JMS I [CRLFR /DO AS WE ARE TOLD 1692 002520 5570 JMP I [ILOOP /NEXT INST 1693 1694 /TAB FUNCTION 1695 1696 002521 4556 TAB, JMS I [UNSFIX /FIX X TO INTEGER 1697 002522 7041 CIA /NEGATE 1698 002523 1476 TAD I IOTPOS /COMPARE DESIRED COLUMN TO REAL COLUMN 1699 002524 7001 IAC /BUMP BY 1 (WORD 7=COL #-1) 1700 002525 7500 SMA /IS X>=CURRENT COLUMN? 1701 002526 5570 JMP I [ILOOP /YES-THEN DO NOTHING 1702 /FALL INTO SPACE OUT ROUTINE 1703 1704 002527 3340 SLOVER, DCA COLCNT /-# OF COLUMNS TO NEXT MARKER 1705 002530 4540 JMS I [FTYPE /IS FILE NUMERIC? 1706 002531 5570 JMP I [ILOOP /YES-THIS IS A NOP 1707 002532 1372 TAD (" /GET SPACE 1708 002533 4550 JMS I [PUTCH /PRINT IT 1709 002534 2340 ISZ COLCNT /THERE YET? 1710 002535 5332 JMP .-3 /NO-TYPE ANOTHER SPACE 1711 002536 5570 JMP I [ILOOP /YES-DONE 1712 1713 002537 0001 COMMAS, 1 /SET TO 1 IF LAST PRINT WAS A COMMA MOVE 1714 002540 0000 COLCNT, 0 1715 1716 /ROUTINE TO CALL ERROR ROUTINE BY FAKING A FUNC2 CALL TO FUNCTION #10 1717 1718 002541 0000 ERROR, 0 1719 002542 7301 CLA CLL IAC /ENTRY AC RANDOM 1720 002543 0031 AND PSFLAG /TEST IF OS/8 17600 RESIDENT 1721 002544 7640 SZA CLA /SKP IF NOT 1722 002545 4573 JMS I [PSWAP /ELSE FORCE IT OUT (THESE ERRORS ARE FATAL) 1723 002546 1366 TAD (7607 1724 002547 3056 DCA INSAV /FAKE A FUNC CALL TO FUNC2 #10 1725 002550 5765 JMP I (FUNC2I 1726 002551 5741 XERRRET,JMP I ERROR /RETURN TO CALLER IF NON FATAL ERROR 1727 1728 /FLOATING NEGATE 1729 1730 002552 4544 FNEGI, JMS I [FFNEG /CALL NEGATE ROUTINE 1731 002553 5570 JMP I [ILOOP /RETURN TO ILOOP 1732 1733 002554 0000 NUMBUF, ZBLOCK 6 /6 DIGIT BUFFER USED BY FFOUT 002555 0000 002556 0000 002557 0000 002560 0000 002561 0000 1734 1735 002565 1463 PAGE 002566 7607 002567 7762 002570 7774 002571 3242 002572 0240 002573 7660 002574 2673 002575 0003 002576 2613 002577 2666 1736 /INCREMENT AND LOAD 6BIT BYTE FROM MEMORY 1737 1738 002600 0000 LDB, 0 1739 002601 4237 JMS BUMP /INCREMENT POINTER AND SET DF 1740 002602 1674 TAD I BYTPTR /PICK UP BYTE 1741 002603 6201 CDF 1742 002604 2275 ISZ BYTSWT /TEST HALFWORD SWITCH 1743 002605 5211 JMP .+4 1744 002606 7112 CLL RTR 1745 002607 7012 RTR 1746 002610 7012 RTR 1747 002611 0145 AND [77 /MASK TO 6BIT 1748 002612 5600 JMP I LDB /RETURN WITH CHAR IN AC 1749 1750 /INCREMENT AND DEPOSIT BYTE IN MEMORY 1751 1752 002613 0000 DPB, 0 1753 002614 0145 AND [77 /MASK TO 6BIT NOW 1754 002615 3276 DCA BYTE 1755 002616 4237 JMS BUMP /INCREMENT POINTER AND SET DF 1756 002617 1145 TAD [77 /GET MASK 1757 002620 2275 ISZ BYTSWT /SKP IF PTR BUMPED 1758 002621 7060 CMA CML /ELSE PRESERVE LEFT HALF 1759 002622 0674 AND I BYTPTR /ZERO OUT TARGET BYTE 1760 002623 3674 DCA I BYTPTR 1761 002624 1276 TAD BYTE /GET BYTE 1762 002625 7430 SZL 1763 002626 5232 JMP .+4 /JMP IF NO SHIFT 1764 002627 7106 CLL RTL 1765 002630 7006 RTL 1766 002631 7006 RTL 1767 002632 1674 TAD I BYTPTR 1768 002633 3674 DCA I BYTPTR /STORE BYTE 1769 002634 6201 CDF 1770 002635 2273 ISZ BYTCNT /TALLY NUMBER OF BYTES STORED 1771 002636 5613 JMP I DPB /--RETURN-- 1772 1773 /BUMP BYTE POINTER 1774 1775 002637 0000 BUMP, 0 1776 002640 1275 TAD BYTSWT /BUMP LOW ORDER BIT 1777 002641 7140 CLL CMA 1778 002642 3275 DCA BYTSWT 1779 002643 2275 ISZ BYTSWT /SKP IF NO CARRY 1780 002644 2274 ISZ BYTPTR /ELSE BUMP WORD PTR 1781 002645 5251 JMP BYTCDF /JMP OUT IF FIELD NOT CROSSED 1782 002646 1177 TAD [10 1783 002647 1251 TAD BYTCDF 1784 002650 3251 DCA BYTCDF /PROPAGATE CARRY INTO CDF INSTR 1785 002651 0000 BYTCDF, 0 /GETS SET BY BYTSET TO TARGET FIELD 1786 002652 5637 JMP I BUMP /RETURN WITH A CLEAR LINK 1787 1788 /BYTE LOAD/STORE INITIALIZE ROUTINE 1789 1790 002653 0000 BYTSET, 0 1791 002654 1266 TAD SSTEX /GET FIELD OF STRING 1792 002655 3251 DCA BYTCDF /STORE INLINE 1793 002656 1063 TAD STRPTR /NOW GET ADDR OF COUNT WORD 1794 002657 3274 DCA BYTPTR /STORE 1795 002660 7001 IAC 1796 002661 3275 DCA BYTSWT /SET LOW ORDER BIT TO CARRY NEXT TIME 1797 002662 3273 DCA BYTCNT /CLEAR DEPOSITED BYTE COUNT 1798 002663 1154 TAD [SAC-1 1799 002664 3010 DCA SACXR /ALWAYS RETURN WITH SAC POINTER SET UP 1800 002665 5653 JMP I BYTSET /--RETURN-- 1801 1802 /STRING STORE EXIT ROUTINE 1803 1804 002666 0000 SSTEX, 0 /GETS SET BY STFIND TO DF OF STRING 1805 002667 1273 TAD BYTCNT /ENTER WITH POSITIVE LENGTH IN COUNT 1806 002670 7041 CIA 1807 002671 3463 DCA I STRPTR /STORE IN STRING 1808 002672 5570 JMP I [ILOOP /--RETURN-- (ILOOP RESETS DF) 1809 1810 002673 0000 BYTCNT, 0 1811 002674 0000 BYTPTR, 0 1812 002675 0000 BYTSWT, 0 1813 002676 0000 BYTE, 0 1814 /SUBROUTINE BUFCHK-CHECKS THE POSITION OF THE BUFFER POINTER FOR 1815 /THE DEVICE WHOSE I/O TABLE ENTRY IS IN WORKING AREA. RETURNS TO CALL+1 1816 /IF THE POINTER IS AT THE END AND CHAR NUMBER IS 1 (LAST 1817 /AVAILABLE CHAR 3 HAS BEEN USED),CALL+2 IF THE POINTER IS AT THE 1818 /END BUT THE CHAR # IS NOT 1 (THERE IS 1 CHAR 3 LEFT), CALL+3 1819 /IF THERE IS 1 WORD LEFT IN BUFFER,CALL+4 IF MORE THAN 1 LEFT. 1820 1821 002677 0000 BUFCHK, 0 1822 002700 1065 TAD ENTNO /GET DEVICE # 1823 002701 7650 SNA CLA /IS IT TTY? 1824 002702 1377 TAD (62-400 /YES-CHECK FOR A BUFFER 60 WORDS LONG 1825 002703 1137 TAD [400 /NO-CHECK FOR A BUFFER 400 WORDS LONG 1826 002704 1467 TAD I IOTBUF /ADD LENGTH TO BUFFER ADDRESS 1827 002705 7041 CIA /-ADDR OF END OF BUFFER 1828 002706 1471 TAD I IOTPTR /CHECK AGAINST CURRENT POINTER 1829 002707 7450 SNA /IS POINTER AT END OF BUFFER? 1830 002710 5320 JMP EBC /AT END-CHECK THE CHAR # 1831 002711 2277 ISZ BUFCHK 1832 002712 2277 ISZ BUFCHK /NO-BUMP RETURN 1833 002713 7001 IAC 1834 002714 7650 SNA CLA /WAS POINTER AT LAST WORD? 1835 002715 5677 JMP I BUFCHK /YES-RETURN TO CALL+3 1836 002716 2277 ISZ BUFCHK /NO 1837 002717 5677 JMP I BUFCHK /RETURN TO CALL+4 1838 1839 002720 4536 EBC, JMS I [CHARNO /GET CHAR # 1840 002721 5677 JMP I BUFCHK /IT WAS 1-RETURN TO CALL+1 1841 002722 7000 NOP /IT WAS 3-RETURN TO CALL+2 1842 002723 2277 ISZ BUFCHK /IT WAS 2-RETURN TO CALL+2 1843 002724 5677 JMP I BUFCHK 1844 1845 /SUBROUTINE PACKCH-PACKS ASCII CHARS,3 FOR 2, INTO BUFFER FOR THE 1846 /DEVICE IN WORK AREA. CALL WITH THE CHARACTER IN THE AC 1847 1848 002725 0000 PACKCH, 0 1849 002726 3040 DCA TEMP1 /SAVE 1850 002727 4536 JMS I [CHARNO /DETERMINE CHARACTER NUMBER 1851 002730 7410 SKP /1 1852 002731 5336 JMP CHAR3P /3 1853 002732 1040 TAD TEMP1 /1 OR 2-GET CHAR AGAIN 1854 002733 4535 JMS I [WRITFL /STORE IN BUFFER 1855 002734 4776 JMS I (CNOBML /BUMP CHARACTER NUMBER 1856 002735 5725 JMP I PACKCH /DONE 1857 1858 002736 7344 CHAR3P, AC7776 1859 002737 1471 TAD I IOTPTR /BACK BUFFER POINTER UP TO POINT TO CHAR 1 1860 002740 3471 DCA I IOTPTR 1861 002741 1040 TAD TEMP1 /CHAR 1862 002742 7106 CLL RTL 1863 002743 7006 RTL /SLIDE LEFT HALF INTO BITS 0-3 1864 002744 3040 DCA TEMP1 /SAVE 1865 002745 1040 TAD TEMP1 1866 002746 4355 JMS COMBNE /ISOLATE LEFT HALF,COMBINE WITH CHAR1,AND PUT IN FILE 1867 002747 1040 TAD TEMP1 /CHAR AGAIN 1868 002750 7106 CLL RTL 1869 002751 7006 RTL /SLIDE RIGHT HALF INTO BITS 0-3 1870 002752 4355 JMS COMBNE /ISOLATE RIGHT HALF,COMBINE WITH CHAR 2,AND PUT IN FILE 1871 002753 4534 JMS I [CNOCLR /CLEAR THE CHARACTER NUMBER (RESET IT TO 1) 1872 002754 5725 JMP I PACKCH /DONE 1873 1874 002755 0000 COMBNE, 0 1875 002756 0175 AND [7400 /ISOLATE HALF IN QUESTION 1876 002757 3064 DCA TEMP2 /SAVE 1877 002760 4775 JMS I (BCGET /GET A WORD FROM FILE BUFFER IN FIELD 1 1878 002761 0174 AND [377 /FLUSH ANY SLUSH IN BITS 0-3 1879 002762 1064 TAD TEMP2 /COMBINE 1880 002763 4535 JMS I [WRITFL /PUT IN BUFFER 1881 002764 5755 JMP I COMBNE /RETURN 1882 1883 002775 3026 PAGE 002776 2116 002777 7462 1884 /ROUTINE TO READ WORD FROM FILE BUFFER AND BUMP POINTER 1885 1886 003000 0000 READFL, 0 1887 003001 4777 JMS I (FOTYPE /IS FILE VARIABLE LENGTH 1888 003002 7410 SKP 1889 003003 4564 VR, JMS I [ERROR /YES-IT IS AN ERROR TO TRY AND READ IT 1890 003004 1466 TAD I IOTHDR /CHECK IF MORE THERE 1891 003005 7112 CLL RTR /EOF BIT TO LINK 1892 003006 7620 SNL CLA /EOF? 1893 003007 5212 JMP .+3 /NO-CONTINUE 1894 003010 4564 RE, JMS I [ERROR /YES-ATTEMPT TO READ BEYOND EOF 1895 003011 5570 JMP I [ILOOP /NOT FATAL-RETURN TO I LOOP 1896 003012 4226 JMS BCGET /GET WORD FROM FILE BUFFER 1897 003013 2471 ISZ I IOTPTR /BUMP POINTER 1898 003014 5600 JMP I READFL /DONE 1899 1900 /ROUTINE TO WRITE AC IN FILE BUFFER AND INCREMENT POINTER 1901 1902 003015 0000 WRITFL, 0 1903 003016 4776 JMS I (BCPUT /STORE AC IN FILE BUFFER 1904 003017 2471 ISZ I IOTPTR /BUMP POINTER 1905 003020 1466 TAD I IOTHDR /GET FILE HEADER WORD 1906 003021 7112 CLL RTR /EOF BIT TO LINK 1907 003022 7620 SNL CLA /WAS FILE PAST END? 1908 003023 5615 JMP I WRITFL /NO-RETURN 1909 003024 4564 WE, JMS I [ERROR /YES-ATTEMPT TO WRITE PAST END OF FILE 1910 003025 5570 JMP I [ILOOP /NON-FATAL RETURN TO ILOOP 1911 1912 /ROUTINE TO GET ONE WORD FROM FILE BUFFER IN FIELD 1 1913 1914 003026 0000 BCGET, 0 1915 003027 4567 JMS I [IDLE /CHECK IF FILE OPEN 1916 003030 1471 TAD I IOTPTR /GET READ WRITE POINTER 1917 003031 3215 DCA WRITFL /SAVE 1918 003032 1065 TAD ENTNO /GET FILE # 1919 003033 7640 SZA CLA /IF TTY,BUFFER FIELD IS 0 1920 003034 6211 CDF 10 /DF TO BUFFER FIELD 1921 003035 1615 TAD I WRITFL /GET WORD FROM BUFFER 1922 003036 6201 CDF 1923 003037 5626 JMP I BCGET /RETURN 1924 /SUBROUTINE UNPACK-UNPACKS ASCII, 3 FOR 2 ,FROM THE FILE IN THE I/O 1925 /WORKING AREA. RETURNS WITH THE CHAR IN CHAR. 1926 1927 003040 0000 UNPACK, 0 1928 003041 4536 JMS I [CHARNO /GET CHAR # 1929 003042 7410 SKP /1 1930 003043 5260 JMP CHAR3U /3 1931 003044 4775 JMS I (CNOBML /BUMP CHAR NUMBER 1932 003045 4200 JMS READFL /GET CHAR AGAIN 1933 003046 0162 U123C, AND [177 /STRIP OFF 7 BITS 1934 003047 7450 SNA 1935 003050 5241 JMP UNPACK+1 /ZERO 1936 003051 1172 TAD [200 1937 003052 3053 DCA CHAR /SAVE 1938 003053 1053 TAD CHAR 1939 003054 1374 TAD (-232 /IS IT CTRL/Z? 1940 003055 7650 SNA CLA 1941 003056 5533 JMP I [EOFSET /YES-SET EOF BIT 1942 003057 5640 JMP I UNPACK /RETURN 1943 1944 003060 4534 CHAR3U, JMS I [CNOCLR /RESET CHAR # TO 1 1945 003061 7344 AC7776 1946 003062 1471 TAD I IOTPTR 1947 003063 3471 DCA I IOTPTR /BACK BUFFER POINTER UP 2 1948 003064 4200 JMS READFL /GET LEFT HALF OF CHAR 1949 003065 0175 AND [7400 1950 003066 3015 DCA XR5 /SAVE 1951 003067 4200 JMS READFL /GET NEXT WORD WITH RIGHT HALF 1952 003070 0175 AND [7400 /ISOLATE RIGHT HALF 1953 003071 7112 CLL RTR 1954 003072 7012 RTR /SLIDE RIGHT HALF OVER 1955 003073 1015 TAD XR5 /COMBINE WITH LEFT HALF 1956 003074 7112 CLL RTR 1957 003075 7012 RTR /MOVE TO BITS 4-11 1958 003076 5246 JMP U123C /REJOIN MAINLINE 1959 /READ FUNCTION-GETS NUMBERS INTO VARIABLES 1960 1961 003077 4540 READI, JMS I [FTYPE /SKP IF FILE IS ASCII 1962 003100 5303 JMP RIMAGE /READ NUMERIC IMAGE 1963 003101 4773 JMS I (FFIN /READ ASCII INTO NUMBER 1964 003102 5570 JMP I [ILOOP /--RETURN-- 1965 003103 4532 RIMAGE, JMS I [BUFCHK /YES-CHECK BUFFER POINTER 1966 003104 7000 NOP /PAST END-NEXT RECORD 1967 003105 7000 NOP /AT END-NEXT RECORD 1968 003106 4551 JMS I [NEXREC /ONLY 1 WORD LEFT-IT IS UNUSED IN NUMERIC FMT 1969 003107 4200 JMS READFL /GET WORD FROM FILE 1970 003110 3044 DCA ACX /STORE AS EXPONENT 1971 003111 4200 JMS READFL /GET WORD FROM FILE 1972 003112 3045 DCA ACH /STORE AS HIGH MANTISSA 1973 003113 4200 JMS READFL /GET WORD FROM FILE 1974 003114 3046 DCA ACL /STORE AS LOW MANTISSA 1975 003115 5570 JMP I [ILOOP /DONE 1976 1977 /ROUTINE TO FETCH ASCII CHARACTERS FROM FILE BUFFER 1978 1979 003116 0000 GETCH, 0 1980 003117 4540 JMS I [FTYPE /IS FILE ASCII? 1981 003120 4564 SR, JMS I [ERROR /NO-ERROR 1982 003121 1065 TAD ENTNO 1983 003122 7640 SZA CLA 1984 003123 5330 JMP NTTY 1985 003124 1333 TAD TCHAR 1986 003125 1142 TAD [-215 1987 003126 7650 SNA CLA 1988 003127 4531 JMS I [DRCALL 1989 003130 4532 NTTY, JMS I [BUFCHK /NO-CHECK STATUS OF BUFFER 1990 003131 4551 JMS I [NEXREC /LAST CHAR READ-NEXT RECORD 1991 003132 7000 NOP /CHAR 3 NOT USED YET 1992 003133 0215 TCHAR, 215 /NOP: CHAR 2 AND 3 LEFT 1993 003134 4240 JMS UNPACK /UNPACK CHAR FROM BUFFER 1994 003135 1065 TAD ENTNO 1995 003136 7640 SZA CLA 1996 003137 5716 JMP I GETCH /RETURN 1997 003140 1053 TAD CHAR 1998 003141 3333 DCA TCHAR 1999 003142 5716 JMP I GETCH 2000 2001 /SUBROUTINE CHARNO-RETURNS TO CALL+1 IF CHAR #=1,CALL+2 IF 3,CALL+3 2002 /IF 2 2003 2004 003143 0000 CHARNO, 0 2005 003144 1466 TAD I IOTHDR /HEADER 2006 003145 0372 AND (300 /ISOLATE CHAR # 2007 003146 7106 CLL RTL 2008 003147 7006 RTL /CHAR # TO BITS 0,1 2009 003150 7540 SMA SZA /IS IT 2? 2010 003151 2343 ISZ CHARNO /YES-BUMP RETURN 2011 003152 7640 SZA CLA /IS IT 2 OR 3? 2012 003153 2343 ISZ CHARNO /YES-BUMP RETURN 2013 003154 5743 JMP I CHARNO /RETURN 2014 2015 003172 0300 PAGE 003173 5200 003174 7546 003175 2116 003176 0747 003177 2342 2016 /WRITE FUNCTION-PUTS NUMBERS IN FILE BUFFERS 2017 2018 003200 4540 WRITEI, JMS I [FTYPE /SKP IF FILE IS ASCII 2019 003201 5226 JMP WIMAGE /ELSE DO IMAGE WRITE 2020 003202 4777 JMS I (FFOUT /CONVERT INTERNAL TO ASCII 2021 003203 1011 TAD XR1 2022 003204 7041 CIA 2023 003205 1376 TAD (INTERB-1 /CALCULATE NUMBER OF CHARS STORED IN BUFFER 2024 003206 3054 DCA TEMP10 /SAVE 2025 003207 1376 TAD (INTERB-1 2026 003210 3010 DCA SACXR /NOW POINT SACXR INTO BUFFER 2027 003211 1054 TAD TEMP10 /GET COUNT OF CHARS TO BE PRINTED 2028 003212 7041 CIA 2029 003213 1476 TAD I IOTPOS /ADD TO PRINT HEAD POSITION 2030 003214 1375 TAD (-WIDTH /COMPARE AGAINST "72" 2031 003215 7740 SMA SZA CLA /WILL THE NUMBER FIT ON THIS LINE? 2032 003216 4541 JMS I [CRLFR /NO-ISSUE A CR,LF 2033 003217 1410 CPLOOP, TAD I SACXR /GET CHAR FROM INTERMEDIATE BUFFER 2034 003220 4242 JMS PUTCH /PUT ON DEVICE 2035 003221 2054 ISZ TEMP10 /BUMP COUNTER 2036 003222 5217 JMP CPLOOP /NEXT 2037 003223 1227 TAD O240 2038 003224 4242 JMS PUTCH /SEND OUT A SPACE AFTER NUMBER 2039 003225 5240 JMP WDONE /TAKE COMMON EXIT 2040 003226 4532 WIMAGE, JMS I [BUFCHK /FILE IS NUMERIC-CHECK BUFFER STATUS 2041 003227 0240 O240, 240 /PAST END-NEW RECORD (AND INST SERVES AS NOP) 2042 003230 0210 O210, 0210 /AT END-NEW RECORD (AND SERVES AS NOP) 2043 003231 4551 JMS I [NEXREC /ONE WORD LEFT-DON'T USE IT 2044 003232 1044 TAD ACX /EXPONENT 2045 003233 4535 JMS I [WRITFL /WRITE IN BUFFER 2046 003234 1045 TAD ACH /HIGH MANTISSA 2047 003235 4535 JMS I [WRITFL /WRITE IN BUFFER 2048 003236 1046 TAD ACL /LOW MANTISSA 2049 003237 4535 JMS I [WRITFL /WRITE IN BUFFER 2050 003240 3774 WDONE, DCA I (COMMAS /CLEAR COMMA SWITCH 2051 003241 5570 JMP I [ILOOP /WRITE IS DONE 2052 /ROUTINE TO PUT ASCII CHARS IN FILE BUFFER. IGNORES RUBOUTS. 2053 2054 003242 0000 PUTCH, 0 2055 003243 3040 DCA TEMP1 /SAVE CHAR 2056 003244 1040 TAD TEMP1 /GET CHAR AGAIN 2057 003245 1373 TAD (-377 2058 003246 7650 SNA CLA /IS IT A RUBOUT? 2059 003247 5642 JMP I PUTCH /YES-RETURN 2060 003250 4540 JMS I [FTYPE /IS FILE NUMERIC? 2061 003251 4564 SW, JMS I [ERROR /YES-ERROR 2062 003252 2476 ISZ I IOTPOS /BUMP COULMN NUMBER 2063 003253 1065 TAD ENTNO /GET ENTRY # 2064 003254 7650 SNA CLA /IS IT TTY? 2065 003255 5265 JMP TOUT /YES-JUST PUT CHARS IN RING BUFFER 2066 003256 4532 JMS I [BUFCHK /NO-IS BUFFER FULL? 2067 003257 4551 JMS I [NEXREC /YES-NEXT RECORD 2068 003260 0040 O40, 40 /THERE IS A CHAR 3 LEFT (AND IS A NOP) 2069 003261 0020 O20, 20 /THERE IS A CHAR 2 AND 3 LEFT (AND IS A NOP) 2070 003262 1040 TAD TEMP1 /GET CHAR AGAIN 2071 003263 4530 JMS I [PACKCH /PUT IN BUFFER 2072 003264 5642 JMP I PUTCH /RETURN 2073 2074 003265 1040 TOUT, TAD TEMP1 /GET CHAR 2075 003266 4527 JMS I [XPUTCH /PUTCH CHAR IN OUTPUT BUFFER FOR TTY 2076 003267 5642 JMP I PUTCH /RETURN 2077 /SUBROUTINE NEXREC-WRITES THIS BUFFER IN FILE,THEN READS IN NEXT BUFFER 2078 /IF POSSIBLE,ELSE SETS EOF BIT. IF DEVICE IS READ OR WRITE ONLY 2079 /IT JUST READS OR WRITES A BLOCK,WHICHEVER IS APPROPRIATE 2080 2081 003270 0000 NEXREC, 0 2082 003271 1466 TAD I IOTHDR /GET HEADER 2083 003272 0261 AND O20 /GET READ/WRITE ONLY BIT 2084 003273 7650 SNA CLA /IS IT ON? 2085 003274 5305 JMP FILSTR /NO-DEVICE IS FILE STRUCTURED 2086 003275 4772 JMS I (FOTYPE /YES-IS IT INPUT OR OUTPUT FILE? 2087 003276 5303 JMP RONLY 2088 003277 4337 JMS WRBLK 2089 003300 2470 RWONC, ISZ I IOTBLK 2090 003301 4350 JMS BLINIT /INIT FILE TABLE ENTRIES 2091 003302 5670 JMP I NEXREC /DONE 2092 2093 003303 4332 RONLY, JMS BLREAD 2094 003304 5300 JMP RWONC 2095 2096 003305 4337 FILSTR, JMS WRBLK /WRITE THE CURRENT BLOCK IF IT HAS BEEN CHANGED 2097 003306 4350 JMS BLINIT /INIT FILE TABLE ENTRIES 2098 003307 2470 ISZ I IOTBLK /BUMP BLOCK # 2099 003310 1473 TAD I IOTLOC /STARTING BLOCK 2100 003311 7041 CIA /NEGATE 2101 003312 1470 TAD I IOTBLK /SUBTRACT FROM CURRENT BLOCK FOR FILE LENGTH 2102 003313 7140 CLL CMA /SET UP CURRENT FILE LENGTH FOR 12 BIT COMPARE 2103 003314 1474 TAD I IOTLEN /COMPARE TO ACTUAL LENGTH 2104 003315 7620 SNL CLA /IS IT > CURRENT LENGTH? 2105 003316 5321 JMP LASTB /YES-EXTEND THE FILE IF IT IS OUTPUT 2106 003317 4332 JMS BLREAD /READ IN THE NEXT RECORD 2107 003320 5670 JMP I NEXREC /RETURN 2108 2109 2110 003321 4772 LASTB, JMS I (FOTYPE /IS FILE FIXED LENGTH? 2111 003322 5533 JMP I [EOFSET /YES-SET EOF FLAG 2112 003323 1474 TAD I IOTLEN /NO-GET ACTUAL LENGTH 2113 003324 7140 CLL CMA 2114 003325 1475 TAD I IOTMAX /MAXIMUM LENGTH 2115 003326 7620 SNL CLA /IS ACTUAL LENGTH >= MAXIMUM LENGTH? 2116 003327 5533 JMP I [EOFSET /YES-SET EOF BITS 2117 003330 2474 ISZ I IOTLEN /NO-BUMP ACTUAL LENGTH 2118 003331 5670 JMP I NEXREC /RETURN WITHOUT READING NEXT RECORD 2119 /ROUTINE TO READ 2 PAGES FROM DEVICE 2120 2121 003332 0000 BLREAD, 0 2122 003333 4771 JMS I (BLZERO 2123 003334 1230 TAD O210 /"READ 2 PAGES" 2124 003335 4531 JMS I [DRCALL /HANDLER CALL 2125 003336 5732 JMP I BLREAD 2126 2127 /ROUTINE TO WRITE 2 PAGES ONTO DEVICE 2128 2129 003337 0000 WRBLK, 0 2130 003340 1466 TAD I IOTHDR /GET FILE HEADER 2131 003341 0260 AND O40 /GET FILE WRITTEN BIT 2132 003342 7650 SNA CLA /HAS THIS BLOCK BEEN CHANGED? 2133 003343 5737 JMP I WRBLK /NO-RETURN 2134 003344 1370 TAD (4210 /"WRITE 2 PAGES" 2135 003345 4531 JMS I [DRCALL /CALL TO DEVICE HANDLER 2136 003346 4771 JMS I (BLZERO 2137 003347 5737 JMP I WRBLK 2138 2139 /ROUTINE TO INITIALIZE I/O TABLE ENTRIES AFTER READ OR WRITE 2140 2141 003350 0000 BLINIT, 0 2142 003351 1467 TAD I IOTBUF 2143 003352 3471 DCA I IOTPTR /INIT READ/WRITE POINTER 2144 003353 1466 TAD I IOTHDR 2145 003354 0367 AND (7437 /SET CHAR # TO 1 AND CLEAR BLOCK WRITTEN BIT 2146 003355 3466 DCA I IOTHDR 2147 003356 5750 JMP I BLINIT 2148 2149 /ROUTINE TO SAVE THE FAC IN FP TEMP 2150 2151 003357 0000 FACSAV, 0 2152 003360 4526 JMS I [FFPUT /STORE FAC 2153 003361 1151 INTERB /USE INTERMEDIATE BUFFER FOR TEMP STORAGE 2154 003362 5757 JMP I FACSAV /RETURN 2155 2156 003367 7437 PAGE 003370 4210 003371 2101 003372 2342 003373 7401 003374 2537 003375 7660 003376 1150 003377 4600 2157 2158 2159 2160 2161 2162 2163 ///////////////////////////////////////////////////////////// 2164 ///////////////////////////////////////////////////////////// 2165 //////////// OVERLAY BUFFER 3400-4600 //////////////////// 2166 //////////// CONTAINS FUNCTION OVERLAYS //////////////////// 2167 //////////// AT RUN TIME //////////////////// 2168 ///////////////////////////////////////////////////////////// 2169 ///////////////////////////////////////////////////////////// 2170 2171 2172 ///////////////////////////////////////////////////////////// 2173 ///////////////////////////////////////////////////////////// 2174 ////////////// OVERLAY 1-ARITHMETIC FUNCTIONS /////////////// 2175 ///////////////////////////////////////////////////////////// 2176 ///////////////////////////////////////////////////////////// 2177 2178 *OVERLAY 2179 2180 2181 2182 /INTEGER FUNCTION 2183 /RANGE=ALL X 2184 2185 003400 6501 INT, VERSON^100+SUBVAF+6000 /INITIALLY CONTAINS VERSION OF ARITH OVERLAY 2186 003401 4526 JMS I [FFPUT /SAVE X 2187 003402 1174 FPPTM1 2188 003403 1044 TAD ACX /GET EXPONENT 2189 003404 7740 SMA SZA CLA /IS EXP<0? 2190 003405 5213 JMP INSC /NO-GO ON 2191 003406 1045 TAD ACH /YES 2192 003407 7710 SPA CLA /IS X<0? 2193 003410 5270 JMP M1R /YES-INT=-1 2194 003411 4561 JMS I [FACCLR /YES-RETURN A 0 2195 003412 5600 JMP I INT 2196 003413 1045 INSC, TAD ACH /GET HI MANTISSA 2197 003414 7700 SMA CLA /IS IT <0? 2198 003415 5220 JMP INTPOS /NO-USE FAC AS IS 2199 003416 4544 JMS I [FFNEG /YES-NEGATE FAC (MAKE IT POS) 2200 003417 7001 IAC /AND SET FLAG 2201 003420 3042 INTPOS, DCA TEMP3 /FLAG FOR NEGATIVE 2202 003421 3047 DCA TEMP5 /ZERO LORD MASK 2203 003422 7130 CLL CML RAR 2204 003423 3043 DCA TEMP4 /INITIALIZE HORD MASK TO 4000 2205 003424 1044 TAD ACX 2206 003425 7041 CIA /- COUNT 2207 003426 3064 DCA TEMP2 2208 003427 1043 MASKL, TAD TEMP4 2209 003430 7130 CLL CML RAR /ROTATE 1'S THROUGH 3 WORD MASK 2210 003431 3043 DCA TEMP4 / 2211 003432 1047 TAD TEMP5 /UNTIL THERE IS A COUNT OF ZERO 2212 003433 7010 RAR 2213 003434 3047 DCA TEMP5 2214 003435 2064 ISZ TEMP2 /DONE? 2215 003436 5227 JMP MASKL /NO 2216 003437 1045 TAD ACH /YES-MASK HORD 2217 003440 0043 AND TEMP4 2218 003441 3045 DCA ACH 2219 003442 1046 TAD ACL /MASK LORD 2220 003443 0047 AND TEMP5 2221 003444 3046 DCA ACL 2222 003445 1042 TAD TEMP3 /NEG FLAG 2223 003446 7650 SNA CLA /WAS ORIGINAL NUMER <0? 2224 003447 5600 JMP I INT /NO-DONE 2225 003450 4526 JMS I [FFPUT /SAVE INT(X) 2226 003451 1171 FPPTM2 2227 003452 4777 JMS I (FFADD /-INT(X)+(X) 2228 003453 1174 FPPTM1 2229 003454 1045 TAD ACH /SAVE HORD 2230 003455 3042 DCA TEMP3 2231 003456 4561 JMS I [FACCLR /FLUSH FAC 2232 003457 1042 TAD TEMP3 /WAS INT(X)=X? 2233 003460 7650 SNA CLA 2234 003461 5264 JMP JUSNEG /YES-JUST NEGATE INT(X) 2235 003462 4777 JMS I (FFADD /NO-ADD 1 2236 003463 3473 ONE 2237 003464 4777 JUSNEG, JMS I (FFADD /GET INT(X) 2238 003465 1171 FPPTM2 2239 003466 4544 JNEG, JMS I [FFNEG /AND NEGATE (INT(5.3)=-6) 2240 003467 5600 JMP I INT /DONE 2241 2242 003470 4557 M1R, JMS I [FFGET /LOAD FAC WITH 1 2243 003471 3473 ONE 2244 003472 5266 JMP JNEG /JUST NEGATE AND RETURN 2245 2246 003473 0001 ONE, 1 2247 003474 2000 2000 2248 003475 0000 0 2249 2250 /EXPONENTIATION FUNCTION 2251 /IF B=0,A^B=1 2252 /IF A=0 AND B>0,A^B=0 2253 /IF A=0 AND B<0,DIVIDE BY ZERO ERROR MESSAGE RESULTS AND A^B=0 2254 /IF B=INTEGER > 0, A^B=A*A*A*.......*A 2255 /IF B=INTEGER < 0, A^B=1/A*A*A*.......*A 2256 /IF B=REAL AND A>0, A^B=EXP(B*LOG(A)) 2257 /IF B=REAL AND A<0, A FATAL ERROR RESULTS 2258 2259 003476 0000 EXPON, 0 2260 003477 4526 JMS I [FFPUT /SAVE A 2261 003500 1160 FPPTM5 2262 003501 4526 JMS I [FFPUT /SET UP RUNNING PRODUCT IN CASE OF 2263 003502 1163 FPPTM4 /MULTIPLIES 2264 003503 1045 TAD ACH /HI ORDER OF A 2265 003504 3276 DCA EXPON /SAVE IT 2266 003505 3056 DCA INSAV /POINTER TO B IN SYMBOL TABLE 2267 003506 4710 JMS I ARGPLL /FIND B 2268 003507 4557 JMS I [FFGET /GET B 2269 003510 0311 ARGPLL, ARGPRE /LOC SKIPPED BY FPP,SO WE USE IT FOR CONSTANT 2270 003511 6201 CDF 2271 003512 1045 TAD ACH /HI ORDER OF B 2272 003513 7450 SNA /IS B=0? 2273 003514 5776 JMP I (RETRN1 /YES A^B=1 2274 003515 7700 SMA CLA /IS B<0? 2275 003516 5322 JMP .+4 /NO 2276 003517 1276 TAD EXPON /YES-GET HI ORDER A 2277 003520 7650 SNA CLA /IS A=0? 2278 003521 5775 JMP I (DV /YES-DIVIDE BY ZERO ERROR 2279 003522 1276 TAD EXPON /B>0. IS A=0? 2280 003523 7650 SNA CLA 2281 003524 5365 JMP RET0 /YES A^B=0 2282 003525 4526 JMS I [FFPUT /SAVE B 2283 003526 1166 FPPTM3 2284 003527 4200 JMS INT /GET INT(B) 2285 003530 4774 JMS I (MULLIM /TEST EXPONENT OF RESULT TO LIMIT LARGE MULTIPLY LOOPS 2286 003531 4773 JMS I (FFSUB /INT(B)-B 2287 003532 1166 FPPTM3 2288 003533 1045 TAD ACH /IS INT(B)-B=0? 2289 003534 7640 SZA CLA 2290 003535 5772 JMP I (USELOG /NO-USE LOGS 2291 003536 4557 JMS I [FFGET /NO-USE REPETITIVE MULTIPLY 2292 003537 1166 FPPTM3 /GET B AGAIN 2293 003540 1045 TAD ACH 2294 003541 3276 DCA EXPON /SAVE SIGN OF B 2295 003542 4771 JMS I (ABSVAL /!B! 2296 003543 4526 JMS I [FFPUT /USE ABS(B) AS MULTIPLY COUNT 2297 003544 1166 FPPTM3 2298 003545 4557 EMLOOP, JMS I [FFGET /GET B 2299 003546 1166 FPPTM3 2300 003547 4773 JMS I (FFSUB /B-1 2301 003550 3473 ONE 2302 003551 4526 JMS I [FFPUT /SAVE NEW COUNT 2303 003552 1166 FPPTM3 2304 003553 1045 TAD ACH 2305 003554 7650 SNA CLA /IS COUNT ZERO YET 2306 003555 5770 JMP I (EMDONE /YES-MULTIPLIES ARE DONE 2307 003556 4557 JMS I [FFGET /NO-GET RUNNING PRODUCT 2308 003557 1163 FPPTM4 2309 003560 4767 JMS I (FFMPY /MULTIPLY BY A 2310 003561 1160 FPPTM5 2311 003562 4526 JMS I [FFPUT /SAVE NEW RUNNING PRODUCT 2312 003563 1163 FPPTM4 2313 003564 5345 JMP EMLOOP 2314 2315 003565 4561 RET0, JMS I [FACCLR /RETURN WITH 0 IN FAC 2316 003566 5570 JMP I [ILOOP 2317 2318 003567 5600 PAGE 003570 3600 003571 2352 003572 3613 003573 6117 003574 4152 003575 6355 003576 3610 003577 6000 2319 003600 4557 EMDONE, JMS I [FFGET /GET RUNNING PRODUCT 2320 003601 1163 FPPTM4 2321 003602 1630 TAD I EXPONK /GET SIGN OF B 2322 003603 7700 SMA CLA /WAS IT -? 2323 003604 5570 JMP I [ILOOP /NO-A^B=A*A*A*...*A 2324 003605 4631 JMS I FIDVP /YES-INVERT 2325 003606 3473 ONE 2326 003607 5570 JMP I [ILOOP /A^B=1/A:A*A*...*A 2327 2328 003610 4557 RETRN1, JMS I [FFGET 2329 003611 3473 ONE /SET FAC TO 1 2330 003612 5570 JMP I [ILOOP 2331 2332 003613 1630 USELOG, TAD I EXPONK /SIGN OF A 2333 003614 7710 SPA CLA /A<0? 2334 003615 4564 EM, JMS I [ERROR /YES-PRINT A MESSAGE 2335 003616 4557 JMS I [FFGET /LOAD A 2336 003617 1160 FPPTM5 2337 003620 4626 JMS I FFLOGL /LOG(A) 2338 003621 4627 JMS I FMPYLV /B*LOG(A) 2339 003622 1166 FPPTM3 2340 003623 4625 JMS I FFEXPL /EXP(B*LOG(A)) 2341 003624 5570 JMP I [ILOOP /DONE 2342 2343 2344 003625 4107 FFEXPL, EXPON1 2345 003626 4263 FFLOGL, LOG 2346 003627 5600 FMPYLV, FFMPY 2347 003630 3476 EXPONK, EXPON 2348 003631 5412 FIDVP, FFDIV1 2349 2350 /SGN FUNCTION 2351 2352 003632 0000 SGN, 0 2353 003633 1045 TAD ACH /GET HIGH MANTISSA 2354 003634 7450 SNA /IS X=ZERO? 2355 003635 5570 JMP I [ILOOP /YES-THEN LEAVE IT ALONE 2356 003636 7710 SPA CLA /IS X>0? 2357 003637 5242 JMP .+3 /NO 2358 003640 7001 IAC /YES-SET FAC=1 2359 003641 7410 SKP 2360 003642 7040 CMA /NO-SET FAC=-1 2361 003643 3044 DCA ACX /SET UP FLOAT 2362 003644 4525 JMS I [FFLOAT /FLOAT VALUE OF SGN FUNCTION 2363 003645 5570 JMP I [ILOOP /DONE 2364 IFZERO EAE < 2365 /FLOATING SQUARE ROOT 2366 /USES A HARDWARE TYPE ALGORITHM FOR BINARY SQUARE ROOTS 2367 /REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES-P 409 2368 / 2369 003646 0000 FROOT, 0 2370 003647 7332 CLA CLL CML RTR /SET RESULT TO 2000;0000 2371 003650 3375 DCA AN1 2372 003651 3376 DCA AN2 2373 003652 6201 CDF /DF TO PACKAGE FIELD 2374 003653 1377 TAD KM22 /SET COUNTER FOR DEVELOPING 22 BITS OF RESULT 2375 003654 3042 DCA AC2 /ALREADY HAVE 1 2376 003655 1045 TAD ACH 2377 003656 7450 SNA 2378 003657 5646 JMP I FROOT /ZERO FAC-NORMALIZED!-RETN. SAME 2379 003660 7710 SPA CLA 2380 003661 4544 JMS I [FFNEG /TAKE ROOT OF ABSOL VALUE 2381 003662 1044 TAD ACX /GET EXPONENT OF FAC 2382 003663 7510 SPA /IF NEGATIVE-MUST PROPAGATE SIGN 2383 003664 7020 CML 2384 003665 7010 RAR /DIVIDE EXP. BY 2 2385 003666 3044 DCA ACX /STORE IT BACK 2386 003667 7430 SZL /INCREMENT EXP. IF ORIGINAL EXP 2387 003670 2044 ISZ ACX /WAS ODD 2388 003671 7000 NOP 2389 003672 7420 SNL /DO A PRE-SHIFT FOR EVEN EXPONENTS 2390 003673 4774 JMS I AL1K /SO FIRST BIT PAIR IS 10 NOT 01 2391 003674 7344 CLA CLL CMA RAL /SET COUNTER FOR DETECTING A 2392 003675 3373 DCA ZCNT /ZERO REMAINDER 2393 003676 7332 CLA CLL CML RTR /SET UP POSITION OF TRIAL BIT 2394 003677 7012 RTR /FOR FIRST PASS THRU LOOP 2395 003700 3050 DCA OPH 2396 003701 3051 DCA OPL 2397 003702 1372 TAD K6000 /GET A FAST FIRST BIT-WE KNOW 2398 003703 1045 TAD ACH /THIS WILL WORK SINCE # IS NORMALIZED 2399 003704 3045 DCA ACH /IF # IS A POWER OF TWO, AND A PERFECT 2400 003705 1045 TAD ACH /SQUARE-WE ARE DONE HERE! 2401 003706 7450 SNA /WELL IS IT? 2402 003707 1046 TAD ACL /COULD BE-CHECK LOW ORDER 2403 003710 7650 SNA CLA 2404 003711 5365 JMP DONE /WHOOPPEE-WE WIN BIG. 2405 003712 5322 JMP LOP01 /NOPE-LOOP DON'T SHIFT FIRST TIME 2406 003713 1050 SLOOP, TAD OPH /SHIFT TRIAL BIT 1 PLACE 2407 003714 7110 CLL RAR /TO THE RIGHT 2408 003715 3050 DCA OPH /AND STORE BACK 2409 003716 1051 TAD OPL 2410 003717 7010 RAR 2411 003720 3051 DCA OPL 2412 003721 4774 JMS I AL1K /SHIFT FAC LEFT 1 PLACE 2413 003722 1051 LOP01, TAD OPL /ADD TRIAL BIT TO`ANSWER 2414 003723 1376 TAD AN2 /SO FAR 2415 003724 7141 CLL CMA IAC /NEGATE IT 2416 003725 1046 TAD ACL /AND ADD TO FAC (REMAINDER SO FAR) 2417 003726 7450 SNA /IS RESULT ZERO? 2418 003727 2373 ISZ ZCNT /YES-INCREMENT COUNTER 2419 003730 3043 DCA TM /STORE RESULT IN TEMPORARY 2420 003731 7024 CML RAL /ADD CARRY TO HIGH ORDER FOR SUBTRACT 2421 003732 1050 TAD OPH /ADD TRIAL BIT 2422 003733 1375 TAD AN1 /ADD RESULT SO FAR (HI ORDER) 2423 003734 7141 CLL CMA IAC /AND SUBTRACT FROM HI ORDER FAC 2424 003735 1045 TAD ACH 2425 003736 7420 SNL /RESULT NEGATIVE? 2426 003737 5361 JMP GON /YES-NEXT RESULT BIT IS 0 2427 003740 7440 SZA /NO-IS HI ORDER RESULT=0? 2428 003741 5346 JMP LOP02 /NO-GO ON 2429 003742 2373 ISZ ZCNT /YES-WAS LOW ORDER =0? 2430 003743 5346 JMP .+3 /NO-GO ON 2431 003744 7040 CMA /YES-REM.=0-SET COUNTER SO 2432 003745 3042 DCA AC2 /LOOKS LIKE WE'RE DONE 2433 003746 3045 LOP02, DCA ACH /STORE HIGH ORDER REM. IN FAC 2434 003747 1043 TAD TM /STORE LO ORDER REM. IN FAC 2435 003750 3046 DCA ACL 2436 003751 1051 TAD OPL /TRIAL BIT SHIFTED LEFT 1 IS 2437 003752 7104 CLL RAL /RESULT BIT-ADD IT TO ROOT DEVELOPED 2438 003753 1376 TAD AN2 /SO FAR 2439 003754 3376 DCA AN2 2440 003755 1050 TAD OPH 2441 003756 7004 RAL 2442 003757 1375 TAD AN1 2443 003760 3375 DCA AN1 2444 003761 7344 GON, CLA CLL CMA RAL /RESET COUNTER FOR ZERO REM. 2445 003762 3373 DCA ZCNT 2446 003763 2042 ISZ AC2 /DONE ALL 23 RESULT BITS? 2447 003764 5313 JMP SLOOP /NO-GO ON 2448 003765 1375 DONE, TAD AN1 /YES-STORE ANSWER IN FAC 2449 003766 3045 DCA ACH /ITS NORMALIZED ALREADY 2450 003767 1376 TAD AN2 2451 003770 3046 DCA ACL 2452 003771 5646 JMP I FROOT /AND RETURN 2453 2454 003772 6000 K6000, 6000 2455 003773 0000 ZCNT, 0 2456 003774 6057 AL1K, AL1 2457 003775 0000 AN1, 0 2458 003776 0000 AN2, 0 2459 003777 7752 KM22, -26 2460 2461 PAGE 2462 > 2463 IFNZRO EAE < 2464 / 2465 /FLOATING SQUARE ROOT 2466 /USES MODIFIED HARDWARE ALGORITHM FOR BINARY SQUARE ROOTS 2467 /REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES; P-409 2468 *SGN+14 2469 FROOT, 0 2470 CLA CLL CML RTR /SET RESLT TO 2000,0000 2471 DCA OPL 2472 DCA OPH 2473 SWAB /MODE B OF EAE-ALSO DOES MQL 2474 CDF 2475 DCA RBCNT /CLR. SHIFT COUNTER 2476 TAD KM22 2477 DCA AC2 /SET COUNTER FOR 23 BITS OF RESULT 2478 TAD ACX /GET EXPONENT OF FAC 2479 ASR /DIVIDE BY 2 2480 1 2481 DCA ACX /STORE IT BACK 2482 DPSZ /INCREMENT EXP. IF ORIG. EXP 2483 ISZ ACX /WAS ODD 2484 NOP 2485 MQA /DETERMINE WHETHER TO DO A 2486 CLL RAL /PRE-SHIFT FOR EVEN EXPONENTS. 2487 CML RAL 2488 DCA RKNT /STORE BIT-0 OR 1 SHIFT CNT 2489 CLL CML RTR /SET UP FIRST TRIAL BIT 2490 RTR 2491 DCA AC1 2492 DCA AC0 /STORE AWAY 2493 DCA ACNT /ZERO COUNTER 2494 DLD /GET THE FAC 2495 ACH 2496 SWP /GET IN RIGHT ORDER 2497 SNA /IS IT ZERO? (HI ORD=0) 2498 JMP I FROOT /YES-ROOT = 0 2499 SPA /NEGATIVE? 2500 DCM /YES-TAKE ABSOL. VALUE 2501 SHL /SHIFT # 1 BIT IF EXP WAS EVEN 2502 RKNT, 0 /SO FIRST BIT PAIR IS 10 NOT 01 2503 TAD K6000 /SUBTRACT 2000-KNOW FIRST BIT 2504 DPSZ /IS 1(NORMALIZED)-DONE?? 2505 JMP LOP1 /NO-WE MUST LOOP 2506 JMP DONE /YES-AN EASY ONE!!! 2507 LOOP, DLD /GET THE FAC 2508 ACH 2509 SHL /SHIFT FAC APPROPRIATELY 2510 1 2511 LOP1, DST /MUST STOR BACK IN CASE RESLT 2512 ACH /BIT IS 0 2513 DLD /GET TRIAL BIT 2514 AC0 2515 2516 ASR /SHIFT THE BIT APPROPRIATELY 2517 ACNT, 0 2518 ISZ ACNT /SHIFT 1 MORE NEXT TIME 2519 DAD /ADD IN RESULT SO FAR 2520 OPH 2521 DCM /NEGATE IT 2522 ISZ RBCNT /BUMP COUNTER FOR RESLT BIT 2523 DAD /DO THE SUBTRACT 2524 ACH 2525 SNL /RESULT NEGATIVE? 2526 JMP GON /YES-NEXT RESULT BIT = 0 2527 2528 DPSZ /NO-DID WE GET A ZERO REMAINDER? 2529 JMP NOTZRO /NOPE 2530 ZREM, CMA /YES-SET SO LOOKS LIKE WE'RE DONE 2531 DCA AC2 2532 NOTZRO, DST /GOOD SUBTR.-MODIFY FAC 2533 ACH /ITS NOT CHANGED BY BAD SUBTRACT 2534 CAM /CLEAR EVERYTHING 2535 RTR 2536 ASR /SHIFT RESLT BIT TO RIGHT PLACE 2537 RBCNT, 0 2538 DAD /ADD IT TO THE RESULT SO FAR 2539 OPH /WE APPEND IT TO RIGHT OF LAST 2540 DST /BIT 2541 OPH /STORE IT BACK 2542 GON, ISZ AC2 /DONE 23 BITS? 2543 JMP LOOP /NO-GO ON 2544 DONE, DLD /YES-GET RESULT-ITS NORMALIZED 2545 OPH 2546 DCA ACH /STORE HIGH ORDER BACK 2547 SWP 2548 DCA ACL /STORE LOW ORDER BACK 2549 JMP I FROOT /RETURN 2550 KM22, -26 2551 K6000, 6000 2552 2553 PAGE 2554 > 2555 /23-BIT EXTENDED FUNCTIONS 2556 2557 /1-31-72 R BEAN 2558 2559 /******SINE****** 2560 2561 004000 0000 SIN, 0 2562 004001 4272 JMS NHNDLE /IF X<0,NEGATE X AND SET NFLAG 2563 004002 4777 JMS I (FFMPY /X*2/PI 2564 004003 4147 TOVPI 2565 004004 4260 JMS FRACT /SAVE X IN TEMP1,THE INTEGER PART OF X IN NUM,AND GET FRACTIONAL PART IN FAC 2566 004005 1302 TAD NUM /GET INTEGER PART OF (2/PI)*X 2567 004006 0376 AND (3 /ISOLATE BITS 10,11 2568 004007 1212 TAD JMPISN 2569 004010 3211 DCA .+1 /MAKE JUMP TO ARGUMENT REDUCING ROUTINE 2570 004011 5211 JMP . /AND ADJUST ARG ACCORDING TO QUADRANT OF X 2571 004012 5613 JMPISN, JMP I .+1 2572 004013 4026 POLYSN /X IN QUAD1,SIN(X)=SIN(X) 2573 004014 4017 QUAD2 /X IN QUAD2,SIN(X)=SIN(1-X) 2574 004015 4022 QUAD3 /X IN QUAD3,SIN(X)=SIN(-X) 2575 004016 4024 QUAD4 /X IN QUAD4,SIN(X)=SIN(X-1) 2576 2577 004017 4775 QUAD2, JMS I (FFSUB1 /1-X 2578 004020 3473 ONE 2579 004021 5226 JMP POLYSN /CALCULATE SIN(1-X) 2580 004022 4544 QUAD3, JMS I [FFNEG /-X 2581 004023 5226 JMP POLYSN /CALCULATE SIN(-X) 2582 004024 4774 QUAD4, JMS I (FFSUB /X-1 2583 004025 3473 ONE 2584 004026 4526 POLYSN, JMS I [FFPUT /SAVE X 2585 004027 1174 FPPTM1 2586 004030 4773 JMS I (FFSQ /U=X**2 2587 004031 4526 JMS I [FFPUT /SAVE U 2588 004032 1171 FPPTM2 2589 004033 4777 JMS I (FFMPY /A7*U 2590 004034 4377 SINA7 2591 004035 4772 JMS I (FFADD /A5+A7*U 2592 004036 4374 SINA5 2593 004037 4777 JMS I (FFMPY /A5*U+A7*U**2 2594 004040 1171 FPPTM2 2595 004041 4772 JMS I (FFADD /A3+A5(U)+A7(U**2) 2596 004042 4371 SINA3 2597 004043 4777 JMS I (FFMPY /A3(U)+A5(U**2)+A7(U**3) 2598 004044 1171 FPPTM2 2599 004045 4772 JMS I (FFADD /A1+A3(U)+A5(U**2)+A7(U**3) 2600 004046 4366 SINA1 2601 004047 4777 JMS I (FFMPY /A1(X)+A3(X**3)+A5(X**5)+A7(X**7) 2602 004050 1174 FPPTM1 2603 004051 4302 JMS NCHK /IF NFLAG IS SET,SET SIN(X)=-SIN(X) 2604 004052 5600 JMP I SIN /FAC=SIN(X) 2605 2606 2607 /******COSINE****** 2608 /USES SIN ROUTINE TO CALCULATE COS(X) 2609 2610 004053 0000 COS, 0 2611 004054 4772 JMS I (FFADD /COS(X)=SIN(PI/2+X) 2612 004055 4402 PIOV2 2613 004056 4200 JMS SIN 2614 004057 5653 JMP I COS /RETURN 2615 /ROUTINE TO SEPERATE THE INTEGER AND FRACTIONAL PARTS OF FAC 2616 /ORIGINAL FAC IS SAVED IN TEMP1,THE INTEGER PORTION OF FAC IS 2617 /SAVED AT NUM,AND THE FRACTIONAL FORTION OF THE FAC IS LEFT IN THE FAC 2618 2619 004060 0000 FRACT, 0 2620 004061 4526 JMS I [FFPUT /SAVE X 2621 004062 1174 FPPTM1 2622 004063 4771 JMS I (FFIX /INTEGER PORTION OF X 2623 004064 1044 TAD ACX 2624 004065 3302 DCA NUM /SAVE FIXED FORTION OF X 2625 004066 4525 JMS I [FFLOAT /FAC=FLOAT(FIX(X)) 2626 004067 4775 JMS I (FFSUB1 /FAC=X-INT(X)=FRACTION (X) 2627 004070 1174 FPPTM1 2628 004071 5660 JMP I FRACT /RETURN 2629 2630 /ROUTINE TO CHECK IF FAC<0; IF IT IS,FAC IS NEGATED AND NFLAG IS 2631 /SET TO 1 2632 2633 004072 0000 NHNDLE, 0 2634 004073 1045 TAD ACH /FETCH HIGH ORDER MANTISSA 2635 004074 7700 SMA CLA /IS IT <0? 2636 004075 5300 JMP NFLGST /NO-CLEAR NFLAG 2637 004076 4544 JMS I [FFNEG /YES-NEGATE FAC 2638 004077 7001 IAC /AND SET NFLAG 2639 004100 3307 NFLGST, DCA NFLAG 2640 004101 5672 JMP I NHNDLE 2641 2642 /ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0 2643 2644 004102 0000 NCHK, 0 /LOC ALSO USED FOR TEMP STORAGE 2645 004103 1307 TAD NFLAG 2646 004104 7640 SZA CLA /IS NFLAG=0? 2647 004105 4544 JMS I [FFNEG /NO-NEGATE FAC 2648 004106 5702 JMP I NCHK /YES-RETURN 2649 2650 NUM=NCHK 2651 /******EXPONENTIAL****** 2652 2653 004107 0000 EXPON1, 0 /LOC USED FOR TEMP STORAGE BY SIN,ARCTAN 2654 004110 4777 JMS I (FFMPY /Y=XLOG2(E) 2655 004111 4405 LOG2E 2656 004112 4260 JMS FRACT /GET FRACTIONAL PART OF Y 2657 004113 4777 JMS I (FFMPY /(FRACTION(Y))*(LN2/2) 2658 004114 4410 LN2OV2 2659 004115 4526 JMS I [FFPUT /SAVE Y 2660 004116 1174 FPPTM1 2661 004117 4773 JMS I (FFSQ /Y**2 2662 004120 4772 JMS I (FFADD /B1+Y**2 2663 004121 4413 EXPB1 2664 004122 4770 JMS I (FFDIV1 /A1/(B1+Y**2) 2665 004123 4416 EXPA1 2666 004124 4772 JMS I (FFADD /A0+A1/(B1+Y**2) 2667 004125 4421 EXPA0 2668 004126 4774 JMS I (FFSUB /A0-Y+A1/(B1+Y**2) 2669 004127 1174 FPPTM1 2670 004130 4526 JMS I [FFPUT /SAVE 2671 004131 1171 FPPTM2 2672 004132 4557 JMS I [FFGET /GET Y 2673 004133 1174 FPPTM1 2674 004134 2044 ISZ ACX /MULT. BY 2=2Y 2675 004135 7000 NOP 2676 004136 4767 JMS I (FFDIV /2Y/(A0-Y+A1/(B1+Y**2)) 2677 004137 1171 FPPTM2 2678 004140 4772 JMS I (FFADD /1+2Y/(AO-Y+A1/(B1+Y**2)) 2679 004141 3473 ONE 2680 004142 4773 JMS I (FFSQ /[1+2Y/(A0-Y+A1/(B1+Y**2))]**2=EXP(Y) 2681 004143 1302 TAD NUM 2682 004144 1044 TAD ACX /EXP(X)=(2**N)(EXPY) 2683 004145 3044 DCA ACX 2684 004146 5707 JMP I EXPON1 /FAC=EXPON(X) 2685 2686 NFLAG=EXPON1 2687 2688 /CONSTANT THAT WOULDN'T FIT ELSEWHERE 2689 004147 0000 TOVPI, 0 /.6366198 2690 004150 2427 2427 2691 004151 6302 6302 2692 2693 004152 0000 MULLIM, 0 2694 004153 1044 TAD ACX /CHECK IF NUMBER OF MULTIPLIES IS TOO LARGE 2695 004154 7510 SPA 2696 004155 7200 CLA /RETURN IF EXPONENT IS NEGATIVE (WE'LL USE LOGS) 2697 004156 1366 TAD (-4 /ONLY A ROUGH ROUGH LIMIT ON THE EXPONENT 2698 004157 7750 SPA SNA CLA /SKP IF NUMBER GT 15 APPROX 2699 004160 5752 JMP I MULLIM /NO, CONTINUE 2700 004161 5765 JMP I (USELOG /YES, USE LOG INSTEAD 2701 2702 004165 3613 PAGE 004166 7774 004167 5722 004170 5412 004171 4500 004172 6000 004173 6347 004174 6117 004175 5400 004176 0003 004177 5600 2703 /******ARC TANGENT****** 2704 2705 004200 0000 ATAN, 0 2706 004201 4661 JMS I NHNDLL /IF X<0,SET NFLAG AND NEGATE 2707 004202 4526 JMS I [FFPUT /SAVE X 2708 004203 1174 FPPTM1 2709 004204 4762 JMS I FSUBM /X-1 2710 004205 3473 ONE 2711 004206 1045 TAD ACH /GET HI MANTISSA 2712 004207 7710 SPA CLA /WAS X>1? 2713 004210 5220 JMP ARGPOL /NO-CLEAR GT1FLG 2714 004211 4557 JMS I [FFGET /YES-ATAN(X)=PI/2-ATAN(1/X) 2715 004212 3473 ONE 2716 004213 4760 JMS I FDIVM /1/X 2717 004214 1174 FPPTM1 2718 004215 4526 JMS I [FFPUT 2719 004216 1174 FPPTM1 2720 004217 7001 IAC /SET GT1FLG 2721 004220 3263 ARGPOL, DCA GT1FLG 2722 004221 4557 JMS I [FFGET /GET X OR 1/X 2723 004222 1174 FPPTM1 2724 004223 4764 JMS I FSQRM /Y**2 2725 004224 4526 JMS I [FFPUT /SAVE 2726 004225 1171 FPPTM2 2727 004226 4757 JMS I FADDM /Y**2+B3 2728 004227 4446 ATANB3 2729 004230 4761 JMS I FDIV1M /A3/(Y**2+B3) 2730 004231 4443 ATANA3 2731 004232 4757 JMS I FADDM /B2+A3/(Y**2+B3) 2732 004233 4440 ATANB2 2733 004234 4757 JMS I FADDM /Y**2+B2+A3/(Y**2+B3) 2734 004235 1171 FPPTM2 2735 004236 4761 JMS I FDIV1M /A2/(Y**2+B2+A3/(Y**2+B3)) 2736 004237 4435 ATANA2 2737 004240 4757 JMS I FADDM /B1+A2/(Y**2+B2+A3/(Y**2+B3)) 2738 004241 4432 ATANB1 2739 004242 4757 JMS I FADDM /Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)) 2740 004243 1171 FPPTM2 2741 004244 4761 JMS I FDIV1M /A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) 2742 004245 4427 ATANA1 2743 004246 4757 JMS I FADDM /B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) 2744 004247 4424 ATANB0 2745 004250 4756 JMS I FMPYM /ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))) 2746 004251 1174 FPPTM1 2747 004252 1263 TAD GT1FLG /WAS X>1? 2748 004253 7650 SNA CLA 2749 004254 5257 JMP NGT /NO-TEST IF X<0? 2750 004255 4763 JMS I FSUB1M /ATAN(X)=PI/2-ATAN(1/X) 2751 004256 4402 PIOV2 2752 004257 4662 NGT, JMS I NCHKL /IF NFLAG SET,NEGATE FAC 2753 004260 5600 JMP I ATAN /FAC=ATAN(X) 2754 004261 4072 NHNDLL, NHNDLE 2755 004262 4102 NCHKL, NCHK 2756 /******NAPERIAN LOGARITHM****** 2757 2758 GTFLG=ATAN 2759 2760 004263 0000 LOG, 0 2761 004264 1045 TAD ACH 2762 004265 7550 SPA SNA /X<0 OR X=0? 2763 004266 5765 JMP I ARTRAP /YES-TAKE ILLEGAL ARGUMENT TRAP 2764 004267 7106 CLL RTL 2765 004270 7450 SNA /NO-HORD=2000? 2766 004271 1044 TAD ACX /YES-EXP=1? 2767 004272 7041 CMA IAC 2768 004273 7001 IAC 2769 004274 7450 SNA 2770 004275 1046 TAD ACL /YES-LORD=0? 2771 004276 7640 SZA CLA 2772 004277 5304 JMP POLYNL /NO-ARG IS LEGAL AND NOT 1 2773 004300 3044 DCA ACX 2774 004301 3046 DCA ACL 2775 004302 3045 LTRPRT, DCA ACH 2776 004303 5663 JMP I LOG /YES-LOG(1)=0 2777 004304 1044 POLYNL, TAD ACX 2778 004305 3200 DCA GTFLG /SAVE EXPONENT FOR LATER 2779 004306 3044 DCA ACX /ISOLATE MANTISSA IN FAC 2780 004307 4526 JMS I [FFPUT /SAVE F 2781 004310 1174 FPPTM1 2782 004311 4757 JMS I FADDM /F+SQR(.5) 2783 004312 4451 SQRP5 2784 004313 4526 JMS I [FFPUT /SAVE 2785 004314 1171 FPPTM2 2786 004315 4557 JMS I [FFGET 2787 004316 1174 FPPTM1 2788 004317 4762 JMS I FSUBM /F-SQR(.5) 2789 004320 4451 SQRP5 2790 004321 4760 JMS I FDIVM /Z=F+SQR(.5)/F-SQR(.5) 2791 004322 1171 FPPTM2 2792 004323 4526 JMS I [FFPUT 2793 004324 1174 FPPTM1 2794 004325 4764 JMS I FSQRM /Z**2 2795 004326 4526 JMS I [FFPUT 2796 004327 1171 FPPTM2 2797 004330 4756 JMS I FMPYM /C5(Z**2) 2798 004331 4462 LOGC5 2799 004332 4757 JMS I FADDM /C3+C5(Z**2) 2800 004333 4457 LOGC3 2801 004334 4756 JMS I FMPYM /C3(Z**2)+C5(Z**4) 2802 004335 1171 FPPTM2 2803 004336 4757 JMS I FADDM /C1+C3(Z**2)+C5(Z**4) 2804 004337 4454 LOGC1 2805 004340 4756 JMS I FMPYM /C1(Z)+C3(Z**3)+C5(Z**5) 2806 004341 1174 FPPTM1 2807 004342 4762 JMS I FSUBM /C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F) 2808 004343 4465 ONEHAF 2809 004344 4526 JMS I [FFPUT /SAVE LOG2(F) 2810 004345 1171 FPPTM2 2811 004346 1200 TAD GTFLG /I 2812 004347 3044 DCA ACX /SET UP FLOAT 2813 004350 4525 JMS I [FFLOAT 2814 004351 4757 JMS I FADDM /I+LOG2(F) 2815 004352 1171 FPPTM2 2816 004353 4756 JMS I FMPYM /[I+LOG2(F)]*LOGE(2)=LOGE(X) 2817 004354 4470 LN2 2818 004355 5663 JMP I LOG /FAC=LN(X) 2819 2820 GT1FLG=LOG 2821 004356 5600 FMPYM, FFMPY 2822 004357 6000 FADDM, FFADD 2823 004360 5722 FDIVM, FFDIV 2824 004361 5412 FDIV1M, FFDIV1 2825 004362 6117 FSUBM, FFSUB 2826 004363 5400 FSUB1M, FFSUB1 2827 004364 6347 FSQRM, FFSQ 2828 004365 6360 ARTRAP, LM 2829 /CONSTANTS USED BY VARIOUS FUNCTIONS 2830 2831 004366 0001 SINA1, 1 /1.5707949 2832 004367 3110 3110 2833 004370 3747 3747 2834 004371 0000 SINA3, 0 /-.64592098 2835 004372 5325 5325 2836 004373 1167 1167 2837 004374 7775 SINA5, 7775 /.07948766 2838 004375 2426 2426 2839 004376 2466 2466 2840 004377 7771 SINA7, 7771 /-.004362476 2841 004400 5610 5610 2842 004401 3164 3164 2843 004402 0001 PIOV2, 1 /1.5707963 2844 004403 3110 3110 2845 004404 3756 3756 2846 004405 0001 LOG2E, 1 /1.442695 2847 004406 2705 2705 2848 004407 2434 2434 2849 004410 7777 LN2OV2, 7777 /.34657359 2850 004411 2613 2613 2851 004412 4415 4415 2852 004413 0006 EXPB1, 6 /60.090191 2853 004414 3602 3602 2854 004415 7054 7054 2855 004416 0012 EXPA1, 12 /-601.80427 2856 004417 5514 5514 2857 004420 3104 3104 2858 004421 0004 EXPA0, 4 /12.015017 2859 004422 3001 3001 2860 004423 7301 7301 2861 004424 7776 ATANB0, 7776 /.17465544 2862 004425 2626 2626 2863 004426 6157 6157 2864 004427 0002 ATANA1, 2 /3.7092563 2865 004430 3553 3553 2866 004431 1071 1071 2867 004432 0003 ATANB1, 3 /6.762139 2868 004433 3303 3303 2869 004434 0670 670 2870 004435 0003 ATANA2, 3 /-7.10676 2871 004436 4344 4344 2872 004437 5267 5267 2873 004440 0002 ATANB2, 2 /3.3163354 2874 004441 3241 3241 2875 004442 7554 7554 2876 004443 7777 ATANA3, 7777 /-.26476862 2877 004444 5703 5703 2878 004445 4040 4040 2879 004446 0001 ATANB3, 1 /1.44863154 2880 004447 2713 2713 2881 004450 3140 3140 2882 004451 0000 SQRP5, 0 /.7071068 2883 004452 2650 2650 2884 004453 1170 1170 2885 004454 0002 LOGC1, 2 /2.8853913 2886 004455 2705 2705 2887 004456 2440 2440 2888 004457 0000 LOGC3, 0 /.9614706 2889 004460 3661 3661 2890 004461 0566 566 2891 004462 0000 LOGC5, 0 /.59897865 2892 004463 2312 2312 2893 004464 5525 5525 2894 004465 0000 ONEHAF, 0 /.5 2895 004466 2000 2000 2896 004467 0000 0 2897 004470 0000 LN2, 0 /.6931472 2898 004471 2613 2613 2899 004472 4415 4415 2900 *4500 2901 2902 /******FIX****** 2903 /ROUTINE TO FIX ANY FLOATING NUMBER IN FAC BETWEEN -2047 AND +2047 TO 2904 /A TWELVE BIT INTEGER AND LEAVE RESULT IN EXP (LOC 44) 2905 2906 004500 0000 FFIX, 0 2907 004501 7200 CLA 2908 004502 1044 TAD ACX /FETCH EXPONENT 2909 004503 7540 SZA SMA /IS NUMBER <1? 2910 004504 5307 JMP .+3 /NO-CONTINUE ON 2911 004505 7200 FTRPRT, CLA 2912 004506 5326 JMP FIXDNE+1 /YES-FIX IT TO ZERO 2913 004507 1377 TAD (-13 /SET BINARY POINT AT 11 2914 004510 7450 SNA /PLACES TO RIGHT OF CURRENT POINT? 2915 004511 5325 JMP FIXDNE /NO-NUMBER IS ALREADY FIXED THEN. 2916 004512 7500 SMA /YES-IS NUMBER TOO LARGE TO FIX? 2917 004513 5776 JMP I (FO /YES-TAKE OVERFLOW TRAP 2918 004514 3044 DCA ACX /NO-SET SCALE COUNT 2919 004515 7100 FIXLP, CLL /0 IN LINK 2920 004516 1045 TAD ACH /GET HIGH MANTISSA 2921 004517 7510 SPA /IS IT <0? 2922 004520 7020 CML /YES-PUT A 1 IN LINK 2923 004521 7010 RAR /SCALE RIGHT 2924 004522 3045 DCA ACH /SAVE 2925 004523 2044 ISZ ACX /DONE YET? 2926 004524 5315 JMP FIXLP /NO 2927 004525 1045 FIXDNE, TAD ACH /YES-ANSWER IN AC 2928 004526 3044 DCA ACX /RETURN WITH ANSWER IN 44 2929 004527 5700 JMP I FFIX /RETURN 2930 2931 /******FLOAT****** 2932 /ROUTINE TO FLOAT ANY INTEGER IN EXP (LOC 44) INTO FAC 2933 2934 004530 0000 FFLOAT, 0 2935 004531 1044 TAD ACX 2936 004532 3045 DCA ACH /PUT NUMBER IN HI MANTISSA 2937 004533 3046 DCA ACL /CLEAR LOW MANTISSA 2938 004534 1375 TAD (13 /11(10) INTO EXPONENT 2939 004535 3044 DCA ACX 2940 004536 4524 JMS I [FFNOR /NORMALIZE 2941 004537 5730 JMP I FFLOAT /RETURN 2942 /RANDOM NUMBER GENERATOR 2943 2944 004540 0000 RND, 0 2945 004541 1774 TAD I (RSEED /GET SEED 2946 004542 3042 DCA TEMP3 /PUT IN MULTIPLY OPERAND 2947 004543 1373 TAD (73 2948 004544 4563 JMS I [MPY /MULTIPLY SEED BY 73 2949 004545 3774 DCA I (RSEED /USE LOW ORDER 12 BITS AS NEW SEED 2950 004546 1774 TAD I (RSEED /LOW ORDER OF PRODUCT ALSO SERVES 2951 004547 7110 CLL RAR /AS RANDOM NUMBER 2952 004550 3045 DCA ACH /SET SIGN TO 0 AND STORE AS HORD 2953 004551 3044 DCA ACX 2954 004552 7010 RAR 2955 004553 3046 DCA ACL /USE 12 BITS AS MANTISSA 2956 004554 3041 DCA AC1 /CLEAR FPP OVERFLOW 2957 004555 4524 JMS I [FFNOR /AND NORMALIZE 2958 004556 5570 JMP I [ILOOP /DONE 2959 2960 004573 0073 PAGE 004574 2332 004575 0013 004576 1637 004577 7765 2961 /FLOATING POINT OUTPUT ROUTINE 2962 /CONVERT INTERNAL NUMBER TO ASCII 2963 /EXIT WITH CHAR STRING IN 'INTERB' 2964 /XR1 = POINTER TO LAST CHAR STORED 2965 2966 004600 0000 FFOUT, 0 2967 004601 1377 TAD (INTERB-1 2968 004602 3011 DCA XR1 /SET POINTER TO ASCII BUFFER 2969 004603 1045 TAD ACH /SEE IF FAC NEGATIVE 2970 004604 7700 SMA CLA 2971 004605 5211 JMP OKPOS /JMP IF POSITIVE 2972 004606 4544 JMS I [FFNEG /TAKE ABS VALUE IF NEGATIVE 2973 004607 1376 TAD ("- /PRINT MINUS SIGN 2974 004610 7410 SKP 2975 004611 1375 OKPOS, TAD (240 /PRINT SPACE IF POSITIVE 2976 004612 3411 DCA I XR1 2977 004613 1045 TAD ACH /SEE IF NUMBER IS ZERO 2978 004614 7650 SNA CLA 2979 004615 5330 JMP ZERXIT /SPECIAL CASE IF SO 2980 004616 4774 JMS I (CVTNUM /CALL ROUTINE TO UNPACK TO BASE 10 2981 004617 1373 TAD (NUMBUF-1 2982 004620 3012 DCA XR2 /POINT XR2 AT DIGIT BUFFER 2983 004621 1372 TAD (5 /TEST FORMAT TO USE 2984 004622 1054 TAD DECEXP 2985 004623 7100 CLL 2986 004624 1371 TAD (-4 2987 004625 7420 SNL 2988 004626 5264 JMP SMLFMT /JMP IF .0NNNNNN TO .0000NNNNNN 2989 004627 1370 TAD (-7 2990 004630 7630 SZL CLA 2991 004631 5272 JMP REGFMT /JMP IF .NNNNNN TO NNNNNN 2992 /OTHERWISE USE E FORMAT N.NNNNNE+NNN OR N.NNNNNE-NNN 2993 004632 1412 TAD I XR2 /GET DIGIT TO LEFT OF POINT 2994 004633 4350 JMS PUTD /PUT IT OUT 2995 004634 1367 TAD (". 2996 004635 3411 DCA I XR1 /NOW SEND OUT DECIMAL POINT 2997 004636 1366 TAD (-5 2998 004637 3042 DCA AC2 /DO 5 MORE DIGITS 2999 004640 1412 TAD I XR2 /PICK UP DIGIT 3000 004641 4350 JMS PUTD /CONVERT TO ASCII AND STORE 3001 004642 2042 ISZ AC2 3002 004643 5240 JMP .-3 /LOOP FOR MORE 3003 004644 1365 TAD ("E /PRINT E 3004 004645 3411 DCA I XR1 3005 / CLL 3006 004646 1054 TAD DECEXP /TAKE ABS(DECEXP) 3007 004647 7510 SPA 3008 004650 7061 CML CIA 3009 004651 3054 DCA DECEXP 3010 004652 7006 RTL /CONVERT "+" TO "-" IF NEGATIVE 3011 004653 1364 TAD ("+ 3012 004654 3411 DCA I XR1 3013 004655 4332 JMS IDIV /PRINT 3 DIGITS OF EXPONENT NOW 3014 004656 7634 -144 3015 004657 4332 JMS IDIV 3016 004660 7766 -12 3017 004661 1054 TAD DECEXP 3018 004662 4350 JMS PUTD 3019 004663 5600 JMP I FFOUT /ALL DONE --RETURN-- 3020 /HANDLE .0NNNNNN TO .0000NNNNNN 3021 3022 004664 3040 SMLFMT, DCA AC0 /STORE NUMBER OF LEADING ZEROES 3023 004665 1367 TAD (". /PUT OUT DECIMAL POINT 3024 004666 3411 DCA I XR1 3025 004667 4350 JMS PUTD /SEND A 0 3026 004670 2040 ISZ AC0 3027 004671 5267 JMP .-2 /LOOP FOR LEADING 0'S 3028 3029 /GENERAL NON E FORMAT .NNNNNN TO NNNNNN 3030 3031 004672 1370 REGFMT, TAD (-7 3032 004673 3041 DCA AC1 /INIT COUNT OF NONZERO DIGITS 3033 004674 1363 TAD (NUMBUF+6 3034 004675 3042 DCA AC2 /POINT AT END OF DIGIT BUFFER 3035 004676 7240 SHRINK, STA /DECREMENT DIGIT POINTER 3036 004677 1042 TAD AC2 3037 004700 3042 DCA AC2 3038 004701 2041 ISZ AC1 /REDUCE SIGNIFICANT DIGIT COUNT 3039 004702 1054 TAD DECEXP 3040 004703 7001 IAC 3041 004704 1041 TAD AC1 3042 004705 7700 SMA CLA 3043 004706 5312 JMP PRTLP /JMP OUT IF NOT TO RIGHT OF DECIMAL POINT 3044 004707 1442 TAD I AC2 /ELSE LOOK AT DIGIT 3045 004710 7650 SNA CLA 3046 004711 5276 JMP SHRINK /DISCARD IT IF ZERO 3047 004712 7240 PRTLP, STA 3048 004713 1054 TAD DECEXP 3049 004714 3054 DCA DECEXP /SEE IF DIGIT TO BE PRINTED FOLLOWS DP 3050 004715 7326 AC0002 3051 004716 1054 TAD DECEXP 3052 004717 7640 SZA CLA 3053 004720 5323 JMP NODP /NO 3054 004721 1367 TAD (". /YES, PRINT DP 3055 004722 3411 DCA I XR1 3056 004723 1412 NODP, TAD I XR2 /PICK UP DECIMAL DIGIT 3057 004724 4350 JMS PUTD /PUT OUT 3058 004725 2041 ISZ AC1 3059 004726 5312 JMP PRTLP /JMP IF MORE DIGITS TO PRINT 3060 004727 5600 JMP I FFOUT /--RETURN-- 3061 3062 004730 4350 ZERXIT, JMS PUTD 3063 004731 5600 JMP I FFOUT /--RETURN-- 3064 3065 /DIVIDE DECEXP BY -DIVISOR IN CALL+1 3066 3067 004732 0000 IDIV, 0 3068 004733 3041 DCA AC1 /CLEAR QUOTIENT 3069 004734 1054 IDIVLP, TAD DECEXP 3070 004735 1732 TAD I IDIV 3071 004736 7510 SPA 3072 004737 5343 JMP IDVOUT /JMP OUT IF LESS THAN DIVISOR 3073 004740 3054 DCA DECEXP /ELSE UPDATE IT 3074 004741 2041 ISZ AC1 /TALLY QUOTIENT 3075 004742 5334 JMP IDIVLP /ITERATE 3076 004743 7200 IDVOUT, CLA 3077 004744 1041 TAD AC1 /GET QUOT AS NEXT DIGIT 3078 004745 4350 JMS PUTD /PUT OUT 3079 004746 2332 ISZ IDIV 3080 004747 5732 JMP I IDIV 3081 3082 /CONVERT NUMBER IN AC TO ASCII DIGIT 3083 /MUST NOT TOUCH THE LINK 3084 3085 004750 0000 PUTD, 0 3086 004751 1362 TAD ("0 /ADD IN 0 3087 004752 3411 DCA I XR1 /STORE IN BUFFER 3088 004753 5750 JMP I PUTD 3089 3090 004762 0260 PAGE 004763 2562 004764 0253 004765 0305 004766 7773 004767 0256 004770 7771 004771 7774 004772 0005 004773 2553 004774 5000 004775 0240 004776 0255 004777 1150 3091 /CONVERT NUMBER IN FAC TO FORMAT N.NNNNNE NNN 3092 /DECIMAL EXPONENT RETURNED AS SIGNED NUMBER IN DECEXP 3093 /6 DIGITS STORED IN NUMBUF AS BINARY 0-9 3094 /FIRST REDUCES MANTISSA TO FORM 0DD DDF FFF FFF... 3095 /BY SUCCESSIVE MULTIPLIES OR DIVIDES BY 10. FOLLOWED BY 3096 /RENORMALIZATIONS UNTIL INTIGER BITS 3097 /DDDD ARE LT 10. 3098 /DECIMAL DIGITS ARE ISOLATED BY REPEATED MULTIPLICATION BY 10. 3099 3100 005000 0000 CVTNUM, 0 3101 005001 3041 DCA AC1 /CLEAR OVERFLOW WORD 3102 005002 7410 SKP /SKP IN AND CLEAR DECIMAL EXPONENT 3103 005003 1054 ADJDEC, TAD DECEXP 3104 005004 3054 DCA DECEXP /STORE UPDATED DECIMAL EXPONENT 3105 005005 1045 NORML, TAD ACH /SEE IF FRACTION IS NORMALIZED 3106 005006 7004 RAL 3107 005007 7710 SPA CLA 3108 005010 5216 JMP NORMED /JMP IF YES 3109 005011 4777 JMS I (AL1 /SHIFT AC LEFT 1 BIT 3110 005012 7240 STA 3111 005013 1044 TAD ACX /COMPENSATE BINARY EXPONENT 3112 005014 3044 DCA ACX 3113 005015 5205 JMP NORML /TRY AGAIN 3114 005016 1044 NORMED, TAD ACX /RANGE CHECK BINARY EXPONENT NOW 3115 005017 7540 SMA SZA 3116 005020 5232 JMP DIVCHK /JMP IF NUMBER GE 1 3117 005021 1314 TAD O4 3118 005022 3044 DCA ACX /INCREASE BINARY EXP TOWARDS ZERO 3119 005023 4353 JMS AR1 /SHIFT 4 BITS RIGHT 3120 005024 4353 JMS AR1 /MAX RELATIVE ERROR WILL BE LT 15*2^-34 PER MULTIPLY 3121 005025 4353 JMS AR1 3122 005026 4353 JMS AR1 3123 005027 4337 JMS MPY10 /NOW MULTIPLY BY 10. 3124 005030 7240 STA /DECREASE DECIMAL EXPONENT 3125 005031 5203 JMP ADJDEC /RENORMALIZE AND TRY AGAIN 3126 3127 005032 1376 DIVCHK, TAD (-5 /SEE IF EXP GT 4 3128 005033 7510 SPA 3129 005034 5260 JMP INRANG /JMP IF NOT, NUMBER MAY BE IN RANGE 3130 005035 7300 DIVGO, CLA CLL 3131 005036 1375 TAD (-40 /SET 32. STAGE SUBTRACT-SHIFT DIVIDE (SLOW BUT ACCURATE) 3132 005037 3042 DCA AC2 /(THE LEN ELEKMAN TECHNIQUE) 3133 /MAX RELATIVE ERROR WILL BE LT 9*2^-34. PER DIVIDE 3134 005040 1045 DVLOOP, TAD ACH /SEE IF GE 10. 3135 005041 1374 TAD (5400 3136 005042 7500 SMA 3137 005043 3045 DCA ACH /UPDATE IF YES 3138 005044 7264 CML STA RAL 3139 005045 3040 DCA AC0 /SAVE LOW ORDER BIT 3140 005046 4777 JMS I (AL1 /SHIFT MANTISSA NOW 3141 005047 2040 ISZ AC0 /STORE BIT NOW 3142 005050 2041 ISZ AC1 3143 005051 2042 ISZ AC2 /BUMP COUNT 3144 005052 5240 JMP DVLOOP /ITERATE 3145 005053 1045 TAD ACH /NOW ZERO OUT REMAINDER 3146 005054 0174 AND [377 3147 005055 3045 DCA ACH 3148 005056 7001 IAC /NOW INCREASE DECIMAL EXPONENT 3149 005057 5203 JMP ADJDEC 3150 3151 005060 3042 INRANG, DCA AC2 /SET SHIFT COUNTER 3152 005061 7410 SKP 3153 005062 4353 JMS AR1 /SHIFT FAC RIGHT 3154 005063 2042 ISZ AC2 3155 005064 5262 JMP .-2 /LEAVE EFFECTIVE BINARY POINT RIGHT OF ACH BIT 4 3156 005065 1045 TAD ACH /ACH = 0DD DDF FFF FFF (D=DECIMAL DIGIT BITS) 3157 005066 1374 TAD (5400 /SEE IF DDDD GE 10 3158 005067 7700 SMA CLA 3159 005070 5235 JMP DIVGO /DIVIDE AGAIN (NORMALIZATION WILL WORK) 3160 005071 7100 CLL 3161 005072 1041 TAD AC1 /NOW ROUND BY ADDING 0.000005 3162 005073 1373 TAD (4761 3163 005074 3041 DCA AC1 3164 005075 7001 IAC /ADD 24761 TO LOW BITS 3165 005076 7004 RAL 3166 005077 1046 TAD ACL 3167 005100 3046 DCA ACL 3168 005101 7430 SZL 3169 005102 2045 ISZ ACH 3170 005103 1045 TAD ACH 3171 005104 1374 TAD (5400 /SEE IF CARRY INTO 9.XXX... 3172 005105 7640 SZA CLA 3173 005106 5315 JMP CVT10 /JMP IF NO 3174 005107 1172 TAD [200 /ELSE SET TO 1.00000 3175 005110 3045 DCA ACH 3176 005111 3046 DCA ACL 3177 005112 3041 DCA AC1 3178 005113 2054 ISZ DECEXP /AND BUMP DECIMAL EXPONENT 3179 005114 0004 O4, 4 /EFFECTIVE NOP 3180 3181 /NOW CONVERT TO DECIMAL DIGITS 3182 3183 005115 1372 CVT10, TAD (-6 /DO 6 DIGITS 3184 005116 3040 DCA AC0 3185 005117 1371 TAD (NUMBUF-1 3186 005120 3013 DCA XR3 3187 005121 5326 JMP CVTGO /FIRST DIGIT IS ALREADY IN 3188 005122 1045 CVTLP, TAD ACH /ZERO OUT PREV DIGIT 3189 005123 0162 AND [177 3190 005124 3045 DCA ACH 3191 005125 4337 JMS MPY10 /MULTIPLY BY 10. 3192 005126 1045 CVTGO, TAD ACH /GET DIGIT FROM 0DD DDF FFF FFF 3193 005127 7006 RTL 3194 005130 7006 RTL 3195 005131 7006 RTL 3196 005132 0171 AND [17 3197 005133 3413 DCA I XR3 /STORE IT 3198 005134 2040 ISZ AC0 3199 005135 5322 JMP CVTLP /LOOP IF MORE 3200 005136 5600 JMP I CVTNUM /--RETURN-- 3201 3202 /MULTIPLY ACH,,ACL,,AC1 BY 10. 3203 3204 005137 0000 MPY10, 0 3205 005140 1045 TAD ACH 3206 005141 3050 DCA OPH /COPY AC TO OP 3207 005142 1046 TAD ACL 3208 005143 3051 DCA OPL 3209 005144 1041 TAD AC1 3210 005145 3042 DCA AC2 3211 005146 4777 JMS I (AL1 /N*2 3212 005147 4777 JMS I (AL1 /N*4 3213 005150 4770 JMS I (OADD /N*5 3214 005151 4777 JMS I (AL1 /N*10. 3215 005152 5737 JMP I MPY10 3216 3217 /SHIFT FAC RIGHT 1 BIT 3218 3219 005153 0000 AR1, 0 3220 005154 1045 TAD ACH 3221 005155 7110 CLL RAR 3222 005156 3045 DCA ACH 3223 005157 1046 TAD ACL 3224 005160 7010 RAR 3225 005161 3046 DCA ACL 3226 005162 1041 TAD AC1 3227 005163 7010 RAR 3228 005164 3041 DCA AC1 3229 005165 5753 JMP I AR1 /DONE 3230 3231 005170 6157 PAGE 005171 2553 005172 7772 005173 4761 005174 5400 005175 7740 005176 7773 005177 6057 3232 IFZERO EAE < 3233 3234 /FLOATING POINT INPUT ROUTINE 3235 3236 005200 0000 FFIN, 0 3237 005201 7240 CLA CMA 3238 005202 3710 DCA I FDVPT /INITIALIZE PERIOD SWITCH TO -1 3239 005203 7040 CMA /SET SIGN SWITCH TO -1 3240 005204 3300 DCA SIGNF 3241 005205 6201 CDF /DF TO PACKAGE FIELD 3242 005206 3052 DCA DSWIT /ZERO CONVERSION SWITCH 3243 005207 3044 DECONV, DCA ACX /ZERO OUT THE FAC! 3244 005210 3046 DCA ACL 3245 005211 0200 P200, 200 3246 005212 3045 DCA ACH 3247 005213 3304 DECNV, DCA DNUMBR /ZERO # OF DIGITS SINCE DEC. PT. 3248 005214 4321 DECON, JMS GCHR /GET A CHAR.FROM TTY. 3249 005215 5232 JMP FFIN1 /TERMINATOR- 3250 005216 2052 ISZ DSWIT /DIGIT-BUMP CONVERSION SWITCH 3251 005217 2304 ISZ DNUMBR /BUMP # OF DIGITS-# IS STORED IN 3252 005220 4707 JMS I FMPYLL /"FMPY TEN" 3253 005221 5316 TEN 3254 005222 4526 JMS I [FFPUT /"FPUT I TM3PT" 3255 005223 1174 FPPTM1 3256 005224 4557 JMS I [FFGET /"FGET TP" 3257 005225 5313 TP 3258 005226 4524 JMS I [FFNOR /"FNOR" 3259 005227 4711 JMS I FADDLL /"FADD I TM3PT" 3260 005230 1174 FPPTM1 3261 005231 5214 JMP DECON /GO ON 3262 005232 2710 FFIN1, ISZ I FDVPT /HAVE WE HAD A PERIOD YET? 3263 005233 5241 JMP FIGO2 /YES-GO ON 3264 005234 2314 ISZ TP1 /NO-IS THIS A PERIOD? 3265 005235 2314 ISZ TP1 3266 005236 7610 SKP CLA 3267 005237 5213 JMP DECNV /YES-ZERO DIG. COUNT AFTER DEC. PT. 3268 /AND GO CONVERT REST 3269 005240 3304 DCA DNUMBR /NO-TERMINATOR-ZERO COUNT OF 3270 /DIGITS AFTER DECIMAL POINT. 3271 005241 2300 FIGO2, ISZ SIGNF /IS # NEGATIVE?(DID WE GET - SIGN?) 3272 005242 4703 JMS I FFNEGP /YES-NEGATE IT 3273 005243 7240 CLA CMA /RESET SIGN SWITCH FOR EXP. 3274 005244 3300 DCA SIGNF 3275 005245 1053 TAD CHAR /NO-WAS THE TERMINATOR AN 'E'? 3276 005246 1305 TAD KME 3277 005247 7650 SNA CLA 3278 005250 4321 GETE, JMS GCHR /YES-GET A CHAR. OF EXPONENT 3279 005251 5260 JMP EDON /END OF EXPONENT 3280 005252 1043 TAD TM /GOT DIG. OF EXP-STORED IN TP1 3281 005253 7106 CLL RTL /MULT. ACCUMULATED EXP BY 10 3282 005254 1043 TAD TM 3283 005255 7104 CLL RAL 3284 005256 1314 TAD TP1 /ADD DIGIT 3285 005257 5250 JMP GETE /CONTINUE 3286 005260 1043 EDON, TAD TM /GET EXPONENT 3287 005261 2300 ISZ SIGNF /WAS EXPONENT NEGATIVE? 3288 005262 7041 CMA IAC /YES-NEGATE IT 3289 005263 7041 CMA IAC /AND CALC. DNUMBR - EXPON. 3290 005264 1304 TAD DNUMBR /GET # TIMES TO DIV MANTISSA BY TEN 3291 005265 7141 CLL CMA IAC 3292 005266 7510 SPA /RESULT POSITIVE? 3293 005267 7161 CLL CMA CML IAC /NO-MAKE POS. AND SET LINK 3294 005270 7040 CMA /NEGATE FOR COUNTER 3295 005271 3304 DCA DNUMBR /AND STORE 3296 005272 7004 RAL /LINK=1-DIV;=0-MUL. # BY TEN 3297 005273 1306 TAD MDV /FORM CORRECT INSTRUCTION 3298 005274 3300 DCA SIGNF /AND STORE FOR EXECUTION 3299 005275 2304 FCNT, ISZ DNUMBR /DONE ALL OPERATIONS? 3300 005276 5300 JMP SIGNF /NO 3301 005277 5600 JMP I FFIN /YES-RETURN 3302 005300 0000 SIGNF, 0 /NO- MUL OR DIV. MANTISSA 3303 005301 5316 TEN /BY TEN 3304 005302 5275 JMP FCNT /GO ON 3305 005303 6135 FFNEGP, FFNEG 3306 005304 0000 DNUMBR, 0 3307 005305 7473 KME, -305 3308 005306 4707 MDV, JMS I .+1 /THESE 3 WDS. MUST BE IN THIS ORDER 3309 005307 5600 FMPYLL, FFMPY 3310 005310 5722 FDVPT, FFDIV /!!!!!!!!!!!!!!!!! 3311 005311 6000 FADDLL, FFADD 3312 3313 005312 0012 KK12, 12 3314 005313 0013 TP, 13 3315 005314 0000 TP1, 0 3316 005315 0000 0 3317 005316 0004 TEN, 4 3318 005317 2400 2400 3319 005320 0000 0 3320 /ROUTINE TO GET A CHAR FROM THE TTY AND SEE IF IT IS DIGIT 3321 /OR A TERMINATOR. 3322 /RETURN TO CALL + 1 IF TERMINATOR, TO CALL + 2 IF DIGIT 3323 /THIS ROUTINE MUST NOT MODIFY THE MQ!! 3324 005321 0000 GCHR, 0 3325 005322 3043 DCA TM /STORE ACCUMULATED EXPONENT (MAYBE) 3326 005323 4346 JMS INPUT /GET A CHAR FROM TTY. 3327 005324 1053 TAD CHAR /PICK IT UP 3328 005325 1364 TAD PLUS /WAS IT PLUS SIGN? 3329 005326 7450 SNA 3330 005327 5334 JMP DECON1 /YES-GET ANOTHER CHAR. 3331 005330 1365 TAD MINUS /NO WAS IT MINUS SIGN? 3332 005331 7640 SZA CLA 3333 005332 5335 JMP .+3 3334 005333 3300 DCA SIGNF /YES-FLIP SWITCH 3335 005334 4346 DECON1, JMS INPUT /GET A CHAR. 3336 005335 1053 TAD CHAR 3337 005336 1345 TAD K7506 /SEE IF ITS A DIGIT 3338 005337 7100 CLL 3339 005340 1312 TAD KK12 3340 005341 3314 DCA TP1 /STORE FOR LATER 3341 005342 7430 SZL /DIGIT? 3342 005343 2321 ISZ GCHR /YES-RETN. TO CALL+2 3343 005344 5721 JMP I GCHR /NO-RETN. TO CALL+1 3344 005345 7506 K7506, 7506 3345 / 3346 /INPUT ROUTINE-IGNORES LEADING SPACES 3347 / 3348 005346 0000 INPUT, 0 3349 005347 4762 JMS I IGETCH /USE OUR ROUTINE TO GET CHAR 3350 005350 1052 TAD DSWIT /GET TERMINATOR 3351 005351 7640 SZA CLA /VALID INPUT YET? 3352 005352 5361 JMP IOUT /YES-CONTINUE 3353 005353 1053 TAD CHAR /NO-GET CHAR 3354 005354 1363 TAD M240 /COMPARE AGAINST SPACE 3355 005355 7440 SZA /SKP IF SPACE 3356 005356 1377 TAD (240-212 /COMPARE TO LF 3357 005357 7650 SNA CLA /IS IT A SPACE OR LF? 3358 005360 5347 JMP INPUT+1 /YES-IGNORE IT 3359 005361 5746 IOUT, JMP I INPUT /RETURN 3360 005362 3116 IGETCH, GETCH /POINTER TO GET CHAR ROUTINE 3361 /ALTERED BY "VAL" FUNCTION TO PICK FROM SAC (BE CAREFULL) 3362 005363 7540 M240, -240 3363 005364 7525 PLUS, -253 3364 005365 7776 MINUS, 253-255 3365 / 3366 /ROUTINE TO DECIDE CALLING MODE IN LIEU OF "SPECIAL MODE" PROBLEMS 3367 / 3368 005366 0000 PATCHF, 0 3369 005367 7440 SZA /IS AC EMPTY 3370 005370 5373 JMP RTN2 /NO-THIS IS ALWAYS SI MODE WITH ADDR IN AC 3371 005371 1037 TAD FF /YES-GET SPECIAL MODE FLIP-FLOP 3372 005372 7640 SZA CLA /IF ON,THE ZERO AC MEANS ADDRESS OF 0 3373 005373 2366 RTN2, ISZ PATCHF /USE AC AS ADDRESS OF OPERAND 3374 005374 5766 JMP I PATCHF /RETURN 3375 005377 0026 PAGE 3376 / 3377 /INVERSE FLOATING SUBTRACT-USES FLOATING ADD 3378 /!!FSW1!!-THIS IS OP-FAC 3379 / 3380 005400 0000 FFSUB1, 0 3381 005401 4523 JMS I [PATCHF /WHICH MODE? 3382 005402 1600 TAD I FFSUB1 /CALLED BY USER-GET ADDR. OF OP. 3383 005403 4644 JMS I ARGETL /GO PICK UP OPERAND 3384 005404 6201 CDF 3385 005405 4610 JMS I FFNEGA /NEGATE FAC 3386 005406 1200 TAD FFSUB1 /AND GO ADD 3387 005407 5611 JMP I SUB0P 3388 005410 6135 FFNEGA, FFNEG 3389 005411 6125 SUB0P, SUB0 3390 / 3391 /INVERSE FLOATING DIVIDE 3392 /FSWITCH=1 3393 /THIS IS OP/FAC 3394 / 3395 005412 0000 FFDIV1, 0 3396 005413 4523 JMS I [PATCHF /WHICH MODE OF CALL? 3397 005414 1612 TAD I FFDIV1 /CALLED BY USER-GET ADDR. 3398 005415 4644 JMS I ARGETL /PICK UP OPERAND 3399 005416 1046 TAD ACL /SWAP THE FAC AND OPERAND 3400 005417 3051 DCA OPL /THERE IS A POINTER TO OPL 3401 005420 1442 TAD I AC2 /IN AC2 LEFT FROM ARGET SUBR. 3402 005421 3046 DCA ACL 3403 005422 1044 TAD ACX /MIGHT AS WELL SUBTRACT THE 3404 005423 7141 CLL CMA IAC /EXPONENTS HERE (SAVES A WORD) 3405 005424 1047 TAD OPX /THEN ZERO OPX SO WILL NOT 3406 005425 3044 DCA ACX /MESS UP WHEN ITS DONE AGAIN 3407 005426 3047 DCA OPX /LATER (SEE DIV. ROUTINE) 3408 005427 1045 TAD ACH 3409 005430 3042 DCA AC2 /NOW SWAP HIGH ORDER MANTISSAS 3410 005431 1050 TAD OPH 3411 005432 3045 DCA ACH 3412 005433 1042 TAD AC2 3413 005434 3050 DCA OPH 3414 005435 6201 CDF /DF TO PACKAGE FIELD 3415 005436 1212 TAD FFDIV1 /NOW KLUDGE UP A SUBROUTINE LINKAGE 3416 005437 3646 DCA I FFDP 3417 005440 1247 TAD KFD1 3418 005441 3645 DCA I MDSETP 3419 005442 5643 JMP I MD1P /GO SET UP AND DIVIDE 3420 3421 005443 5452 MD1P, MD1 3422 005444 6200 ARGETL, ARGET 3423 005445 5450 MDSETP, MDSET 3424 005446 5722 FFDP, FFDIV 3425 005447 5726 KFD1, FFD1 3426 /MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE 3427 /ALSO SHIFTS OPERAND ONE BIT TO THE LEFT. 3428 /EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT 3429 /CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND 3430 /DATA FIELD SET PROPERLY FOR OPERAND. 3431 / 3432 005450 0000 MDSET, 0 3433 005451 4703 JMS I ARGETK /GET ARGUMENT 3434 005452 6201 MD1, CDF /DF TO PACKAGE FIELD 3435 005453 7344 CLA CLL CMA RAL /SET SIGN CHECK TO -2 3436 005454 3043 DCA TM 3437 005455 1050 TAD OPH /IS OPERAND NEGATIVE? 3438 005456 7700 SMA CLA 3439 005457 5262 JMP .+3 /NO 3440 005460 4702 JMS I OPNEGP /YES-NEGATE IT 3441 005461 2043 ISZ TM /BUMP SIGN CHECK 3442 005462 1051 TAD OPL /AND SHIFT OPERAND LEFT ONE BIT 3443 005463 7104 CLL RAL 3444 005464 3051 DCA OPL 3445 005465 1050 TAD OPH 3446 005466 7004 RAL 3447 005467 3050 DCA OPH 3448 005470 3041 DCA AC1 /CLR. OVERFLOW WORF OF FAC 3449 005471 1045 TAD ACH /IS FAC NEGATIVE 3450 005472 7700 SMA CLA 3451 005473 5277 JMP LEV /NO-GO ON 3452 005474 4701 JMS I FFNEGK /YES-NEGATE IT 3453 005475 2043 ISZ TM /BUMP SIGN CHECK 3454 005476 7000 NOP /MAY SKIP 3455 005477 1047 LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC 3456 005500 5650 JMP I MDSET 3457 3458 005501 6135 FFNEGK, FFNEG 3459 005502 6146 OPNEGP, OPNEG 3460 005503 6200 ARGETK, ARGET 3461 3462 / 3463 /CONTINUATION OF FLOATING DIVIDE ROUTINE 3464 / 3465 005504 1042 FD1, TAD AC2 /NEGATE HI ORDER PRODUCT 3466 005505 7141 CLL CMA IAC 3467 005506 1045 TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV. 3468 005507 7420 SNL /WELL? 3469 005510 5740 JMP I DVOPSP /GREATER THAN REM.-ADJUST QUOT OF 1ST DIV. 3470 005511 7100 CLL /OK-DO (REM-(Q*OPL))/OPH 3471 005512 3045 DCA ACH /FIRST STORE ADJUSTED PRODUCT 3472 005513 4737 JMS I DV24P /DIVIDE BY OPH (HI ORDER OPERAND) 3473 005514 1041 DVL1, TAD AC1 /GET QUOT. OF FIRST DIV. 3474 005515 7500 SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT 3475 005516 5334 JMP FD /NO-ITS NORMALIZED-DONE 3476 005517 7100 CLL 3477 005520 2046 ISZ ACL 3478 005521 7410 SKP 3479 005522 7001 IAC 3480 005523 7010 RAR 3481 005524 3045 DCA ACH /STORE IN FAC 3482 005525 1046 TAD ACL /P@ LOW ORDER RIGHT 3483 005526 7010 RAR 3484 005527 3046 DCA ACL /STORE BACK 3485 005530 2044 ISZ ACX /BUMP EXPONENT 3486 005531 7000 NOP 3487 005532 1045 TAD ACH 3488 005533 5315 JMP DVL1+1 3489 005534 3045 FD, DCA ACH /STORE HIGH ORDER RESULT 3490 005535 5736 JMP I FDDONP /GO LEAVE DIVIDE 3491 3492 005536 5742 FDDONP, FDDON /END OF FLTG. DIV. ROUTINE 3493 005537 5745 DV24P, DV24 /ROUTINE TO DO A 24X12BIT DIVIDE 3494 005540 6315 DVOPSP, DVOPS /ROUTINE TO ADJUST QUOT OF FIRST DIV. 3495 / 3496 /CONTINUATION OF ROUTINE TO ADJUST QUOT. OF FIRST DIV. 3497 /DBAD1 IS ONLY EXECUTED ON DIVIDE OVERFLOW-OTHERWISE THE 3498 /ROUTINE STARTS AT DVOP2 3499 / 3500 005541 3044 DBAD1, DCA ACX /DIVIDE OVERFLO-ZERO ALL 3501 005542 7450 DVOP2, SNA /IS IT ZERO? 3502 005543 3046 DCA ACL /YES-MAKE WHOLE THING ZERO 3503 005544 3045 DCA ACH 3504 005545 4737 JMS I DV24P /DIVIDE EXTENDED REM. BY HI DIVISOR 3505 005546 1046 TAD ACL /NEGATE THE RESULT 3506 005547 7141 CLL CMA IAC 3507 005550 3046 DCA ACL 3508 005551 7420 SNL /IF QUOT. IS NON-ZERO, SUBTRACT 3509 005552 7040 CMA /ONE FROM HIGH ORDER QUOT. 3510 005553 5314 JMP DVL1 /GO TO IT 3511 3512 PAGE 3513 /FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES 3514 005600 0000 FFMPY, 0 3515 005601 4523 JMS I [PATCHF /WHICH MODE OF CALL? 3516 005602 1600 TAD I FFMPY /CALLED BY USER-GET OPERAND ADDR. 3517 005603 4774 JMS I MDSETK /SET UP FOR MPY-OPX IN AC ON RETN. 3518 005604 1044 TAD ACX /DO EXPONENT ADDITION 3519 005605 3044 DCA ACX /STORE FINAL EXPONENT 3520 005606 3345 DCA DV24 /ZERO TEM STORAGE FOR MPY ROUTINE 3521 005607 3042 DCA AC2 3522 005610 1045 TAD ACH /IS FAC=0? 3523 005611 7650 SNA CLA 3524 005612 3044 DCA ACX /YES-ZERO EXPONENT 3525 005613 4243 JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR. 3526 005614 1050 TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER 3527 005615 3051 DCA OPL 3528 005616 4243 JMS MP24 3529 005617 1042 TAD AC2 /STORE RESULT BACK IN FAC 3530 005620 3046 RTZRO, DCA ACL /LOW ORDER 3531 005621 1345 TAD DV24 /HIGH ORDER 3532 005622 3045 DCA ACH 3533 005623 1045 TAD ACH /DO WE NEED TO NORMALIZE? 3534 005624 7004 RAL 3535 005625 7700 SMA CLA 3536 005626 5235 JMP SHLFT /YES-DO IT FAST 3537 005627 3041 MDONE, DCA AC1 /NO-ZERO OVERFLOW WD(DO I NEED THIS???) 3538 005630 2200 ISZ FFMPY /BUMP RETURN POINTER 3539 005631 2043 ISZ TM /SHOULD RESULT BE NEGATIVE? 3540 005632 5600 JMP I FFMPY /NOPE-RETN. 3541 005633 4773 JMS I FFNEGR /YES-NEGATE IT 3542 005634 5600 JMP I FFMPY /RETURN 3543 005635 7040 SHLFT, CMA /SUBTRACT 1 FROM EXP. 3544 005636 1044 TAD ACX 3545 005637 3044 DCA ACX 3546 005640 4642 JMS I AL1PTR /SHIFT FAC LEFT 1 BIT 3547 005641 5230 JMP MDONE+1 /DONE. 3548 005642 6057 AL1PTR, AL1 3549 / 3550 /24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL 3551 /MULTIPLICAND IS IN ACH AND ACL 3552 /RESULT LEFT IN DV24,AC2, AND AC1 3553 005643 0000 MP24, 0 3554 005644 1375 TAD KKM12 /SET UP 12 BIT COUNTER 3555 005645 3047 DCA OPX 3556 005646 1051 TAD OPL /IS MULTIPLIER=0? 3557 005647 7440 SZA 3558 005650 5254 JMP MPLP1 /NO-GO ON 3559 005651 3041 DCA AC1 /YES-INSURE RESULT=0 3560 005652 5643 JMP I MP24 /RETURN 3561 005653 1051 MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER 3562 005654 7010 MPLP1, RAR /OF MULTIPLIER AND INTO LINK 3563 005655 3051 DCA OPL 3564 005656 7420 SNL /WAS IT A 1? 3565 005657 5266 JMP MPLP2 /NO-0-JUST SHIFT PARTIAL PRODUCT 3566 005660 7100 CLL /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT 3567 005661 1042 TAD AC2 3568 005662 1046 TAD ACL /LOW ORDER 3569 005663 3042 DCA AC2 3570 005664 7004 RAL /PROPAGATE CARRY 3571 005665 1045 TAD ACH /HI ORDER 3572 005666 1345 MPLP2, TAD DV24 3573 005667 7010 RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT 3574 005670 3345 DCA DV24 3575 005671 1042 TAD AC2 3576 005672 7010 RAR 3577 005673 3042 DCA AC2 3578 005674 7010 RAR /1 BIT OF OVERFLOW TO AC1 3579 005675 3041 DCA AC1 3580 005676 2047 ISZ OPX /DONE ALL 12 MULTIPLIER BITS? 3581 005677 5253 JMP MPLP /NO-GO ON 3582 005700 5643 JMP I MP24 /YES-RETURN 3583 / 3584 /PART OF DIVIDE ROUTINE-FFDIV MUST BE AT LOC. 6722 3585 005701 3051 MP12L, DCA OPL /STORE BACK MULTIPLIET 3586 005702 1042 TAD AC2 /GET PRODUCT SO FAR 3587 005703 7420 SNL /WAS MULTIPLIER BIT A 1? 3588 005704 5307 JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT 3589 005705 7100 CLL /YES-CLEAR LINK AND ADD MULTIPLICAND 3590 005706 1046 TAD ACL /TO PARTIAL PRODUCT 3591 005707 7010 RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER 3592 005710 3042 DCA AC2 /RESULT-STORE BACK 3593 005711 1051 DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER 3594 005712 7010 RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.) 3595 005713 2200 ISZ FFMPY /DONE ALL BITS? 3596 005714 5301 JMP MP12L /NO-LOOP BACK 3597 005715 7141 CLL CMA IAC /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC 3598 005716 3046 DCA ACL /NEGATE AND STORE 3599 005717 7024 CML RAL /PROPAGATE CARRY 3600 005720 5721 JMP I FD1P /GO ON 3601 005721 5504 FD1P, FD1 /POINTER TO REST OF DIVIDE ROUTINE 3602 / 3603 /FLOATING DIVIDE ROUTINE 3604 /USES THE METHOD OF TRIAL DIVISION BY HI ORDER 3605 005722 0000 FFDIV, 0 /(USED AS A TEM. BY I/O ROUTINES) 3606 005723 4523 JMS I [PATCHF /WHICH MODE OF CALL? 3607 005724 1722 TAD I FFDIV /CALLED BY USER-GET ARG. ADDR. 3608 005725 4774 JMS I MDSETK /GO SET UP FOR DIVIDE-OPX IN AC ON RETN. 3609 005726 7041 FFD1, CMA IAC /NEGATE EXP. OF OPERAND 3610 005727 1044 TAD ACX /ADD EXP OF FAC 3611 005730 3044 DCA ACX /STORE AS FINAL EXPONENT 3612 005731 1050 TAD OPH /NEGATE HI ORDER OP. FOR USE 3613 005732 7141 CLL CMA IAC /AS DIVISOR 3614 005733 3050 DCA OPH 3615 005734 4345 JMS DV24 /CALL DIV.--(ACH+ACL)/OPH 3616 005735 1046 TAD ACL /SAVE QUOT. FOR LATER 3617 005736 3041 DCA AC1 3618 005737 1376 TAD KM13 /SET COUNTER FOR 12 BIT MULTIPLY 3619 005740 3200 DCA FFMPY /TO MULTIPLY QUOT. OF DIV. BY 3620 005741 5311 JMP DVLP1 /LOW ORDER OF OPERAND (OPL) 3621 / 3622 /END OF FLOATING DIVIDE-FUDGE SOME 3623 /STUFF THEN JUMP INTO MULTIPLY 3624 / 3625 005742 1322 FDDON, TAD FFDIV /STORE RETN. ADDR. IN MULT ROUTINE 3626 005743 3200 DCA FFMPY 3627 005744 5227 JMP MDONE /GO CLEAN UP 3628 / 3629 /DIVIDE ROUTINE--24 BITS IN ACH,ACL ARE DIVIDED BY 12 BITS 3630 /IN OPH. OPH IS ASSUMED NEGATIVE AND .GT. ACH IN ABSOLUTE VALUE 3631 /ELSE-DIVIDE OVERFLOW--WE RETURN NORMALLY WITH QUOTIENT 3632 /IN ACL AND REM. IN ACH. (AC2=0 ON RETN.) 3633 / 3634 005745 0000 DV24, 0 3635 005746 1045 TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND 3636 005747 1050 TAD OPH /DIVISOR IN OPH (NEGATIVE) 3637 005750 7630 SZL CLA /IS IT? 3638 005751 5777 JMP I DVOVR /NO-DIVIDE OVERFLOW 3639 005752 1376 TAD KM13 /YES-SET UP 12 BIT LOOP 3640 005753 3042 DCA AC2 3641 005754 5365 JMP DV1 /GO BEGIN DIVIDE 3642 005755 1045 DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT 3643 005756 7004 RAL 3644 005757 3045 DCA ACH /RESTORE HI ORDER 3645 005760 1045 TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER 3646 005761 1050 TAD OPH /DIVIDEND 3647 005762 7430 SZL /GOOD SUBTRACT? 3648 005763 3045 DCA ACH /YES-RESTORE HI DIVIDEND 3649 005764 7200 CLA /NO-DON'T RESTORE--OPH.GT.ACH 3650 005765 1046 DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT 3651 005766 7004 RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL 3652 005767 3046 DCA ACL 3653 005770 2042 ISZ AC2 /DONE 12 BITS OF QUOT? 3654 005771 5355 JMP DV2 /NO-GO ON 3655 005772 5745 JMP I DV24 /YES-RETN W/AC2=0 3656 005773 6135 FFNEGR, FFNEG 3657 005774 5450 MDSETK, MDSET 3658 005775 7764 KKM12, -14 3659 005776 7763 KM13, -15 3660 005777 6355 DVOVR, DV 3661 3662 PAGE 3663 / 3664 /FLOATING ADD 3665 / 3666 006000 0000 FFADD, 0 3667 006001 4523 JMS I [PATCHF /WHICH MODE FO CALL? 3668 006002 1600 TAD I FFADD /CALLED BY USER-GET ADDR. OF OPR. 3669 006003 4727 JMS I ARGETP /PICK UP OPERAND 3670 006004 6201 FAD1, CDF /DF TO PACKAGE FIELD 3671 006005 1050 TAD OPH /IS OPERAND = 0 3672 006006 7650 SNA CLA 3673 006007 5227 JMP DONA /YES-DONE 3674 006010 1045 TAD ACH /NO-IS FAC=0? 3675 006011 7650 SNA CLA 3676 006012 5223 JMP DOADD /YES-DO ADD 3677 006013 1044 TAD ACX /NO-DO EXPONENT CALCULATION 3678 006014 7141 CLL CMA IAC 3679 006015 1047 TAD OPX 3680 006016 7540 SMA SZA /WHICH EXP. GREATER? 3681 006017 5231 JMP FACR /OPERANDS-SHIFT FAC 3682 006020 7041 CMA IAC /FAC'S-SHIFT OPERAND=DIFFRNCE+1 3683 006021 4234 JMS OPSR 3684 006022 4272 JMS ACSR /SHIFT FAC ONE PLACE RIGHT 3685 006023 1047 DOADD, TAD OPX /SET EXPONENT OF RESULT 3686 006024 3044 DCA ACX 3687 006025 4357 JMS OADD /DO THE ADDITION 3688 006026 4776 JMS I FNORP /NORMALIZE RESULT 3689 006027 2200 DONA, ISZ FFADD /BUMP RETURN 3690 006030 5600 JMP I FFADD /RETURN 3691 006031 4272 FACR, JMS ACSR /SHIFT FAC = DIFF.+1 3692 006032 4234 JMS OPSR /SHIFT OPR. 1 PLACE 3693 006033 5223 JMP DOADD /DO ADDITION 3694 / 3695 /OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 3696 /IN AC 3697 006034 0000 OPSR, 0 3698 006035 7040 CMA /- (COUNT+1) TO SHIFT COUNTER 3699 006036 3040 DCA AC0 3700 006037 1050 LOP2, TAD OPH /GET SIGN BIT 3701 006040 7004 RAL /TO LINK 3702 006041 7200 CLA 3703 006042 1050 TAD OPH /GET HI MANTISSA 3704 006043 7010 RAR /SHIFT IT RIGHT, PROPAGATING SIGN 3705 006044 3050 DCA OPH /STORE BACK 3706 006045 1051 TAD OPL 3707 006046 7010 RAR 3708 006047 3051 DCA OPL /STORE LO ORDER BACK 3709 006050 7010 RAR /SAVE 1 BIT OF OVERFLOW 3710 006051 3042 DCA AC2 /IN AC2 3711 006052 2047 ISZ OPX /INCREMENT EXPONENT 3712 006053 7000 NOP2, NOP 3713 006054 2040 ISZ AC0 /DONE ALL SHIFTS? 3714 006055 5237 JMP LOP2 /NO-LOOP 3715 006056 5634 JMP I OPSR /YES-RETN. 3716 / 3717 /SHIFT FAC LEFT 1 BIT 3718 / 3719 006057 0000 AL1, 0 3720 006060 1041 TAD AC1 /GET OVERFLOW BIT 3721 006061 7104 CLL RAL /SHIFT LEFT 3722 006062 3041 DCA AC1 /STORE BACK 3723 006063 1046 TAD ACL /GET LOW ORDER MANTISSA 3724 006064 7004 RAL /SHIFT LEFT 3725 006065 3046 DCA ACL /STORE BACK 3726 006066 1045 TAD ACH /GET HI ORDER 3727 006067 7004 RAL 3728 006070 3045 DCA ACH /STORE BACK 3729 006071 5657 JMP I AL1 /RETN. 3730 / 3731 /SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE) 3732 / 3733 006072 0000 ACSR, 0 3734 006073 7040 CMA /AC CONTAINS COUNT-1 3735 006074 3040 DCA AC0 /STORE COUNT 3736 006075 1045 LOP1, TAD ACH /GET SIGN BIT OF MANTISSA 3737 006076 7004 RAL /SET UP SIGN PROPAGATION 3738 006077 7200 CLA 3739 006100 1045 TAD ACH /GET HIGH ORDER MANTISSA 3740 006101 7010 RAR /SHIFT RIGHT`1, PROPAGATING SIGN 3741 006102 3045 DCA ACH /STORE BACK 3742 006103 1046 TAD ACL /GET LOW ORDER 3743 006104 7010 RAR /SHIFT IT 3744 006105 3046 DCA ACL /STORE BACK 3745 006106 7010 RAR 3746 006107 3041 DCA AC1 /SAVE 1 BIT OF OVERFLOW 3747 006110 2044 ISZ ACX /INCREMENT EXPONENT 3748 006111 7000 NOP1, NOP 3749 006112 2040 ISZ AC0 /DONE? 3750 006113 5275 JMP LOP1 /NO-LOOP 3751 006114 5672 JMP I ACSR /YES-RETN-AC=L=0 3752 / 3753 /DIVIDE OVERFLOW-ZERO ACX,ACH,ACL 3754 / 3755 006115 7300 DBAD, CLA CLL /NECESSARY SO WE DON'T GET OVRFLO AGAIN 3756 006116 5775 JMP I DBAD1P /GO ZERO ALL 3757 / 3758 /FLOATING SUBTRACT 3759 / 3760 006117 0000 FFSUB, 0 3761 006120 4523 JMS I [PATCHF /WHICH MODE OF CALL? 3762 006121 1717 TAD I FFSUB /CALLED BY USER-GET ADDR. OF OP 3763 006122 4727 JMS I ARGETP /PICK UO THE OP. 3764 006123 4346 JMS OPNEG /NEGATE OPERAND 3765 006124 1317 TAD FFSUB /JMP INTO FLTG. ADD 3766 006125 3200 SUB0, DCA FFADD /AFTER SETTING UP RETURN 3767 006126 5204 JMP FAD1 3768 006127 6200 ARGETP, ARGET 3769 *6135 3770 / 3771 /FLOATING NEGATE 3772 / 3773 006135 0000 FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE) 3774 006136 1046 TAD ACL /GET LOW ORDER FAC 3775 006137 7141 CLL CMA IAC /NEGATE IT 3776 006140 3046 DCA ACL /STORE BACK 3777 006141 7024 CML RAL /ADJUST OVERFLOW BIT AND 3778 006142 1045 TAD ACH /PROPAGATE CARRY-GET HI ORD 3779 006143 7141 CLL CMA IAC /NEGATE IT 3780 006144 3045 DCA ACH /STORE BACK 3781 006145 5735 JMP I FFNEG 3782 / 3783 /NEGATE OPERAND 3784 / 3785 006146 0000 OPNEG, 0 3786 006147 1051 TAD OPL /GET LOW ORDER 3787 006150 7141 CLL CMA IAC /NEGATE AND STORE BACK 3788 006151 3051 DCA OPL 3789 006152 7024 CML RAL /PROPAGATE CARRY 3790 006153 1050 TAD OPH /GET HI ORDER 3791 006154 7141 CLL CMA IAC /NEGATE AND STORE BACK 3792 006155 3050 DCA OPH 3793 006156 5746 JMP I OPNEG 3794 / 3795 /ADD OPERAND TO FAC 3796 / 3797 006157 0000 OADD, 0 3798 006160 7100 CLL 3799 006161 1042 TAD AC2 /ADD OVERFLOW WORDS 3800 006162 1041 TAD AC1 3801 006163 3041 DCA AC1 3802 006164 7004 RAL /ROTATE CARRY 3803 006165 1051 TAD OPL /ADD LOW ORDER MANTISSAS 3804 006166 1046 TAD ACL 3805 006167 3046 DCA ACL 3806 006170 7004 RAL 3807 006171 1050 TAD OPH /ADD HI ORDER MANTISSAS 3808 006172 1045 TAD ACH 3809 006173 3045 DCA ACH 3810 006174 5757 JMP I OADD /RETN. 3811 006175 5541 DBAD1P, DBAD1 3812 006176 6215 FNORP, FFNOR 3813 > 3814 IFNZRO EAE < 3815 /EAE FLOATING POINT PACKAGE 3816 /FOR PDP8/E WITH KE8-E EAE 3817 / 3818 /W.J. CLOGHER 3819 / 3820 /DEFINITIONS OF EAE INSTRUCTIONS 3821 SWP= 7521 3822 CAM= 7621 3823 MQA= 7501 3824 MQL= 7421 3825 SGT= 6006 3826 SWAB= 7431 3827 SWBA= 7447 3828 SCA= 7441 3829 MUY= 7405 3830 DVI= 7407 3831 NMI= 7411 3832 SHL= 7413 3833 ASR= 7415 3834 LSR= 7417 3835 ACS= 7403 3836 SAM= 7457 3837 DAD= 7443 3838 DLD= 7663 3839 DST= 7445 3840 DPIC= 7573 3841 DCM= 7575 3842 DPSZ= 7451 3843 / 3844 TM= TEMP4 3845 / 3846 /FLOATING POINT INPUT ROUTINE 3847 / 3848 PAGE 3849 FFIN, 0 3850 CLA CMA 3851 DCA PRSW /INITIALIZE PERIOD SWITCH TO -1 3852 CMA /SET SIGN SWITCH TO -1 3853 DCA SIGNF 3854 CDF /CHANGE TO DF OF PACKAGE 3855 DCA DSWIT /ZERO CONVERSION SWITCH 3856 DECONV, DCA ACX /ZERO OUT THE FAC! 3857 DCA ACL 3858 DCA ACH 3859 DECNV, DCA DNUMBR /ZERO # OF DIGITS SINCE DEC. PT. 3860 DECON, JMS GCHR /GET A CHAR.FROM TTY. 3861 JMP FFIN1 /TERMINATOR- 3862 ISZ DSWIT /DIGIT-BUMP CONVERSION SWITCH 3863 ISZ DNUMBR /BUMP # OF DIGITS 3864 DCA TP1 /STORE IT IN FORM EASILY FLOATIBLE 3865 JMS I FMPYLL /MULTIPLY # BY 10 3866 TEN 3867 JMS I [FFPUT /STORE IT AWAY 3868 FPPTM1 3869 JMS I [FFGET /GET NEW DIGIT 3870 TP 3871 JMS I [FFNOR /FLOAT IT 3872 JMS I FADDLL /ADD IT TO THE ACCUMULATED # 3873 FPPTM1 3874 JMP DECON /GO ON 3875 FFIN1, ISZ PRSW /HAVE WE HAD A PERIOD YET? 3876 JMP FIGO2 /YES-GO ON 3877 TAD K2 /NO-IS THIS A PERIOD? 3878 SNA CLA 3879 JMP DECNV /YES-ZERO DIG. COUNT AFTER DEC. PT. 3880 /AND GO CONVERT REST 3881 DCA DNUMBR /NO-TERMINATOR-ZERO COUNT OF 3882 /DIGITS AFTER DECIMAL POINT. 3883 FIGO2, CLA MQL /0 TO MQ FOR LATER MULTIPLY 3884 ISZ SIGNF /IS # NEGATIVE?(DID WE GET - SIGN?) 3885 JMS I FFNEGP /YES-NEGATE IT 3886 SWAB 3887 CMA /RESET SIGN SWITCH FOR EXP. 3888 DCA SIGNF 3889 TAD CHAR /NO-WAS THE TERMINATOR AN 'E'? 3890 TAD KME 3891 SNA CLA 3892 GETE, JMS GCHR /YES-GET A CHAR. OF EXPONENT 3893 JMP EDON /END OF EXPONENT 3894 MUY /GOT DIGIT OF EXP-MULT ACCUMULATED 3895 K12 /EXPONENT BY TEN AND ADD DIGIT 3896 JMP GETE /CONTINUE 3897 EDON, ISZ SIGNF /WAS EXPONENT NEGATIVE? 3898 DCM /YES-NEGATE IT 3899 CLA CLL /CLEAR AC AND LINK 3900 TAD DNUMBR /GET # TIMES TO DIV MANTISSA BY TEN 3901 SAM /SUBTRACT FROM EXPONENT 3902 CLL 3903 SPA /RESULT POSITIVE? 3904 CLL CMA CML IAC /NO-MAKE POS. AND SET LINK 3905 CMA /NEGATE FOR COUNTER 3906 DCA DNUMBR /AND STORE 3907 RAL /LINK=1-DIV;=0-MUL. # BY TEN 3908 TAD MDV /FORM CORRECT INSTRUCTION 3909 DCA FINST /AND STORE FOR EXECUTION 3910 FCNT, ISZ DNUMBR /DONE ALL OPERATIONS? 3911 JMP FINST /NO 3912 JMP I FFIN /YES-RETURN 3913 FINST, 0 /NO- MUL OR DIV. MANTISSA 3914 TEN /BY TEN 3915 JMP FCNT /GO ON 3916 FFNEGP, FFNEG 3917 PRSW, 0 3918 DNUMBR, 0 3919 SIGNF, 0 3920 K2, 2 3921 KME, -305 3922 MDV, JMS I .+1 /THESE 3 WDS. MUST BE IN THIS ORDER 3923 FMPYLL, FFMPY 3924 FFDIV /!!!!!!!!!!!!!!!!! 3925 FADDLL, FFADD 3926 3927 K12, 12 3928 TP, 13 3929 TP1, 0 3930 0 3931 TEN, 4 3932 2400 3933 0 3934 /ROUTINE TO GET A CHAR FROM THE TTY AND SEE IF IT IS DIGIT 3935 /OR A TERMINATOR. 3936 /RETURN TO CALL + 1 IF TERMINATOR, TO CALL + 2 IF DIGIT 3937 /THIS ROUTINE MUST NOT MODIFY THE MQ!! 3938 GCHR, 0 3939 JMS INPUT /GET A CHAR FROM TTY. 3940 TAD CHAR /PICK IT UP 3941 TAD PLUS /WAS IT PLUS SIGN? 3942 SNA 3943 JMP DECON1 /YES-GET ANOTHER CHAR. 3944 TAD MINUS /NO WAS IT MINUS SIGN? 3945 SZA CLA 3946 JMP .+3 3947 DCA SIGNF /YES-FLIP SWITCH 3948 DECON1, JMS INPUT /GET A CHAR. 3949 TAD CHAR 3950 TAD K7506 /SEE IF ITS A DIGIT 3951 CLL 3952 TAD K12 3953 SZL /DIGIT? 3954 ISZ GCHR /YES-RETN. TO CALL+2 3955 JMP I GCHR /NO-RETN. TO CALL+1 3956 K7506, 7506 3957 PLUS, -253 3958 MINUS, 253-255 3959 / 3960 / 3961 /INPUT ROUTINE-IGNORES LEADING SPACES 3962 / 3963 INPUT, 0 3964 JMS I IGETCH /USE OUR ROUTINE TO GET CHAR 3965 TAD DSWIT /GET TERMINATOR 3966 SZA CLA /VALID INPUT YET? 3967 JMP IOUT /YES-CONTINUE 3968 TAD CHAR /NO-GET CHAR 3969 TAD M240 /COMPARE AGAINST SPACE 3970 SZA 3971 TAD (240-212 /IS IT AN LF? 3972 SNA CLA /IS IT A SPACE OR LF? 3973 JMP INPUT+1 /YES-IGNORE IT 3974 IOUT, JMP I INPUT /RETURN 3975 M240, -240 3976 IGETCH, GETCH /ALTERED BY VAL FUNCITON TO PICK FROM SAC 3977 / 3978 /ROUTINE TO DECIDE CALLING MODE IN LIEU OF "SPECIAL MODE" PROBLEMS 3979 / 3980 PATCHF, 0 3981 SZA /IS AC EMPTY 3982 JMP RTN2 /NO-THIS IS ALWAYS SI MODE WITH ADDR IN AC 3983 TAD FF /YES-GET SPECIAL MODE FLIP-FLOP 3984 SZA CLA /IF ON,THE ZERO AC MEANS ADDRESS OF 0 3985 RTN2, ISZ PATCHF /USE AC AS ADDRESS OF OPERAND 3986 JMP I PATCHF /RETURN 3987 / 3988 PAGE 3989 / 3990 /FLOATING SUBTRACT-USES FLOATING ADD 3991 /FSW1!! 3992 FFSUB1, 0 3993 JMS I [PATCHF /WHICH MODE? 3994 TAD I FFSUB1 /CALLED BY USER-GET ADDR. OF OP 3995 JMS I ARGETL /PICK UP ARGUMENT 3996 CDF 3997 JMS I FFNEGA /NEGATE FAC! 3998 TAD FFSUB1 3999 JMP I SUB0P 4000 FFNEGA, FFNEG 4001 SUB0P, SUB0 4002 4003 4004 / 4005 /FLOATING DIVIDE 4006 /FSWITCH=1 4007 /THIS IS OP/FAC 4008 / 4009 FFDIV1, 0 4010 JMS I [PATCHF /WHICH MODE OF CALL? 4011 TAD I FFDIV1 /CALLED BY USER-GET ADDR. 4012 JMS I ARGETL /(INTERP.)-GET OPRND.-ADDR. IN AC 4013 CDF /CDF TO FIELD OF PACKAGE 4014 TAD ACH /SWAP FAC AND OPRND-OPH IN MQ! 4015 DCA OPH /STORE ACH IN OPH 4016 TAD ACX /GET EXP OF FAC 4017 SWP /OPH TO AC, ACX TO MQ 4018 DCA ACH /STORE OPH IN ACH 4019 TAD OPX /STORE OPX IN ACX 4020 DCA ACX 4021 TAD OPL /OPL TO MQ, ACX TO AC 4022 SWP 4023 DCA OPX /STORE ACX IN OPX 4024 TAD ACL 4025 DCA OPL /STORE ACL IN OPL 4026 TAD OPH /OPH TO MQ FOR LATER 4027 SWP 4028 DCA ACL /STORE OPL IN ACL 4029 TAD FFDIV1 /SET UP SO WE RETN TO 4030 DCA I FFDP /NORMAL DIVIDE ROUTINE 4031 TAD FD1 4032 DCA I MDSETP 4033 JMP I MD1P /GO ARRANGE OPERANDS 4034 4035 MD1P, MD1 4036 ARGETL, ARGET 4037 MDSETP, MDSET 4038 FFDP, FFDIV 4039 FD1, FFD1 4040 4041 4042 /PATCH TO EAE ADD ROUTINE 4043 4044 ADDPCH, 0 4045 TAD AC1 4046 TAD RB4000 4047 DPSZ 4048 JMP ADDP1 4049 CLL CML RTR 4050 ISZ ACX 4051 NOP 4052 ADDP1, TAD RB4000 4053 JMP I ADDPCH 4054 RB4000, 4000 4055 4056 4057 / 4058 PTCHAD, CDF 4059 TAD OPH 4060 SNA CLA /OPERAND ZERO 4061 JMP I JADON /YES 4062 TAD ACH /FAC ZERO 4063 SZA CLA 4064 JMP I JFAD1 /NO 4065 TAD OPX 4066 DCA ACX 4067 TAD OPH 4068 DCA ACH 4069 TAD OPL 4070 DCA ACL 4071 JMP I JADON 4072 JADON, ADON 4073 JFAD1, FAD1 4074 / 4075 /FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE 4076 /THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO 4077 /A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY. 4078 /(IN THE LOW ORDER, NATCHERLY) 4079 PAGE 4080 FFMPY, 0 4081 JMS I [PATCHF /WHICH MODE? 4082 TAD I FFMPY /CALLED BY USER-GET ADDRESS 4083 JMS MDSET /SET UP FOR MULT 4084 CLA MUY /MULTIPLY-LOW ORDER FAC STILL IN MQ 4085 OPH /THIS IS PRODUCT OF LOW ORDERS 4086 MQL /ZAP LOW ORDER RESULT-INSIGNIFICANT 4087 TAD ACH /GET LOW ORDER(!) OF FAC 4088 SWP MUY /TO MQ-HIGH ORD. RESLT OF LAST MPY 4089 OPL /TO AC-WILL BE ADDED TO RESLT-THIS 4090 DST /IS PRODUCT-LOW ORD FAC,HI ORD OP 4091 AC0 /STORE RESULT 4092 DLD /HIGH ORDER FAC TO MQ, OPX TO AC 4093 ACL 4094 TAD ACX /ADD FAC EXPONENT-GET SUM OF EXPS. 4095 DCA ACX /STORE RESULT 4096 MUY /MUL. HIGH ORDER FAC BY LOW ORD OP. 4097 OPH /HIGH ORDER FAC WAS IN MQ 4098 DAD /ADD IN RESULT OF SECOND MULTIPLY 4099 AC0 4100 DCA ACH /STORE HIGH ORDER RESULT 4101 TAD ACL /GET HIGH ORDER FAC 4102 SWP /SEND IT TO MQ AND LOW ORD. RESULT 4103 DCA AC0 /OF ADD TO AC-STORE IT 4104 RAL /ROTATE CARRY TO AC 4105 DCA ACL /STORE AWAY 4106 MUY /NOW DO PRODUCT OF HIGH ORDERS 4107 OPL /FAC HIGH IN MQ, OP HIGH IN OPL 4108 DAD /ADD IN THE ACCUMULATED # 4109 ACH 4110 SNA /ZERO? 4111 JMP RTZRO /YES-GO ZERO EXPONENT 4112 NMI /NO-NORMALIZE (1 SHIFT AT MOST!) 4113 DCA ACH /STORE HIGH ORDER RESULT 4114 CLA SCA /GET STEP CNTR-DID WE NEED A SHIFT? 4115 SNA CLA 4116 JMP SNCK /NO-JUST CHECK SIGN 4117 CLA CMA /YES-MUST DECREASE EXP. BY 1 4118 TAD ACX 4119 RTZRO, DCA ACX /STORE BACK 4120 4121 TAD AC0 4122 SPA CLA /IS HIGH ORDER OF OVERFLO WD. 1? 4123 DPIC /YES-ADD 1 TO LOW ORDER-STILL IN MQ 4124 SNCK, ISZ MSIGN /RESULT NEGATIVE? 4125 JMP MPOS /NO-GO ON 4126 TAD ACH /YES-GET HIGH ORDER BACK 4127 DCM /LOW ORDER STILL IN MQ-NEGATE 4128 DCA ACH /STORE HIGH ORDER BACK 4129 MPOS, SWP /LOW ORDER TO AC 4130 DCA ACL /STORE AWAY 4131 ISZ FFMPY /BUMP RETURN 4132 JMP I FFMPY /RETIRN 4133 MSIGN, 0 4134 ARGETK, ARGET 4135 DVOFL, DV 4136 4137 / 4138 /ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE 4139 / 4140 MDSET, 0 4141 JMS I ARGETK /GET OPERAND (ADDR. IN AC) 4142 CDF /CHANGE TO DATA FIELD OF PACKAGE 4143 MD1, CLA CLL CMA RAL /MAKE A MINUS TWO 4144 DCA MSIGN /AND STORE IN MSIGN. 4145 TAD OPL /GET LOW ORDER MANTISSA OF OP. 4146 SWP /GET INTO RIGHT ORDER ( OPH IN MQ) 4147 SMA /NEGATIVE? 4148 JMP .+3 /NO 4149 DCM /YES-NEGATE IT 4150 ISZ MSIGN /BUMP SIGN COUNTER 4151 SHL /SHIFT OPRND LEFT 1 TO AVOID OVRFLO 4152 1 4153 DST /STORE BACK-OPH CONTAINS LOW ORDER 4154 OPH / OPL CONTAINS HIGH ORDER 4155 DLD /GET THE MANTISSA OF THE FAC 4156 ACH 4157 SWP /MAKE IT CORRECT ORDER 4158 SMA /NEGATIVE? 4159 JMP FPOS /NO 4160 DCM /YES-NEGATE IT 4161 ISZ MSIGN /BUMP SIGN COUNTER (MAY SKIP) 4162 NOP 4163 FPOS, DST /STORE BACK-ACH CONTAINS LOW ORDER 4164 ACH / ACL CONTAINS HIGH ORDER 4165 JMP I MDSET /RETURN 4166 4167 4168 4169 / 4170 /FLOATING DIVIDE 4171 / 4172 *5722 4173 FFDIV, 0 4174 JMS I [PATCHF /WHICH MODE? 4175 TAD I FFDIV /CALLED BY USER-GET ARG. ADDRESS 4176 JMS MDSET /GET ARG. AND SET UP SIGNS 4177 FFD1, DVI /DIVIDE-ACH AND ACL IN AC,MQ 4178 OPL /THIS IS HI (!) ORDER DIVISOR 4179 DST /QUOT TO AC0,REM TO AC1 4180 AC0 4181 SZL CLA /DIVIDE ERROR? 4182 JMP I DVOFL /YES-HANDLE IT 4183 TAD OPX /DO EXPONENT CALCULATION 4184 CMA IAC /EXP. OF FAC - EXP. OF OP 4185 TAD ACX 4186 DCA ACX 4187 DPSZ /IS QUOT = 0? 4188 SKP /NO-GO ON 4189 DCA ACX /YES-ZERO EXPONENT 4190 DVLP, MUY /NO-THIS IS Q*OPL*2**-12 4191 OPH 4192 DCM /NEGATE IT 4193 TAD AC1 /SEE IF GREATER THAN REMAINDER 4194 SNL 4195 JMP I DVOPSP /YES-ADJUST FIRST DIVIDE 4196 DVI /NO-DO Q*OPL*2**-12/OPH 4197 OPL 4198 SZL CLA /DIV ERROR? 4199 JMP I DVOFL /YES 4200 DVLP1, TAD AC0 /NO-GET QUOT OF FIRST DIV. 4201 SMA /NEGATIVE? 4202 JMP .+5 /NO-REMEMBER-QUOT OF 2ND DIV. IN MQ 4203 LSR /YES-MUST SHIFT IT RIGHT 1 4204 1 4205 ISZ ACX /ADJUST EXPONENT 4206 NOP 4207 ISZ MSIGN /SHOULD SIGN BE MINUS? 4208 SKP /NO 4209 DCM /YES-DO IT 4210 DBAD1, DCA ACH /STORE IT BACK 4211 SWP 4212 DCA ACL 4213 ISZ FFDIV 4214 JMP I FFDIV /BUMP RETN. AND RETN. 4215 4216 DVOPSP, DVOPS 4217 DBAD, CAM 4218 DCA ACX /ZERO EXPONENT 4219 JMP DBAD1 /GO ZERO MANTISSA 4220 /FLOATING ADDITION-IN ORDER NOT TO LOSE BITS, WE DO NOT 4221 /SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD-ONLY SHIFTS DONE 4222 /ARE TO ALIGN EXPONENTS. 4223 / 4224 PAGE 4225 FFADD, 0 4226 JMS I [PATCHF /WHICH MODE OF CALLING 4227 TAD I FFADD /CALLED DIRECTLY BY USER 4228 JMS I ARGETP /PICK UP ARGUMENTS 4229 JMP I PATCHK /CHECK FOR ADDITION BY ZERO 4230 FAD1, TAD OPX /PICK UP EXPONENT OF OPERAND 4231 MQL /SEND IT TO MQ FOR SUBTRACT 4232 TAD ACX /GET EXPONENT OF FAC 4233 SAM /SUBTRACT-RESULT IN AC 4234 SPA /NEGATIVE RESULT? 4235 CMA IAC /YES-MAKE IT POSITIVE 4236 DCA CNT /STORE IT AS A SHIFT COUNT 4237 TAD CNT /COUNT TOO BIG?(CAN'T BE ALIGNED) 4238 TAD M27 4239 SPA SNA CLA 4240 CMA /NO-OK 4241 DCA AC0 /YES-MAKE IT A LOAD OF LARGEST # 4242 DLD /GET ADDRESSES TO SEE WHO'S SHIFTED 4243 ADDRS 4244 SGT /WHICH EXP GREATER(GT FLG SET 4245 /BY SUBTR. OF EXPS.) 4246 SWP /OPERAND'S-SHIFT THE FAC 4247 DCA SHFBG /STORE ADDRESS OF WHO GETS SHIFTED 4248 SWP /GET ADDRESS OF OTHER (0 TO MQ) 4249 DCA DADR /THIS ONE JUST GETS ADDED 4250 SGT /WHICH EXPONENT WAS GREATER? 4251 JMP .+3 /FAC'S - DO NOTHING 4252 TAD OPX /OPERAND'S-PUT FINAL EXP. IN ACX 4253 DCA ACX 4254 DLD /GET THE LARGER # TO AC,MQ 4255 DADR, 0 4256 SWP /PUT IN THE RIGHT ORDER 4257 ISZ AC0 /COULD EXPONENTS BE ALIGNED? 4258 JMP LOD /NO-JUST LEAVE LARGER IN AC,MQ 4259 DST /YES-STORE THIS TEMPORARILY 4260 AC0 /(IF ONLY FAC STORAGE WAS REVERSED) 4261 DLD /GET THE SMALLER # 4262 SHFBG, 0 4263 SWP /PUT IT IN RIGHT ORDER 4264 ASR /DO THE ALIGNMENT SHIFT 4265 CNT, 0 4266 DAD /ADD THE LARGER # 4267 AC0 4268 DST /STORE RESULT 4269 AC0 4270 SZL /OVERFLOW?(L NOT = SIGN BIT) 4271 CMA /NOTE-WE DIDN'T SHIFT BOTH RIGHT 1 4272 SMA CLA 4273 JMP NOOV /NOPE 4274 CLA CLL CML RAR /MAYBE-SEE IF 2 #S HAD SAME SIGN 4275 AND ACH 4276 TAD OPH 4277 SMA CLA /SIGNS ALIKE? 4278 JMP OVRFLO /YES-OVERFLOW 4279 NOOV, JMS I ADDPCL /JUMP TO PATCH FOR THIS ROUTINE 4280 LOD, NMI /NORMALIZE (LOW ORDER STILL IN MQ) 4281 DCA ACH /STORE FINAL RESULT 4282 SWP /GET AND STORE LOW ORDER 4283 DCA ACL 4284 SCA /GET SHIFT COUNTER(# OF NMI SHIFTS) 4285 CMA IAC /NEGATE IT 4286 TAD ACX /AND ADJUST FINAL EXPONENT 4287 DCA ACX 4288 ADON, ISZ FFADD /BUMP RETURN PAST ADDRESS 4289 JMP I FFADD /RETURN 4290 OVRFLO, TAD AC1 /OVERFLOW-GET HIGH ORDER RESLT BACK 4291 ASR /SHIFT IT RIGHT 1 4292 1 4293 TAD KK4000 /REVERSE SIGN BIT 4294 DCA ACH /AND STORE 4295 SWP 4296 DCA ACL /STORE LOW ORDER 4297 ISZ ACX /BUMP EXPONENT 4298 NOP 4299 JMP ADON /DONE 4300 KK4000, 4000 4301 M27, -27 4302 ADDRS, OPH 4303 ACH 4304 ARGETP, ARGET 4305 /FLOATING SUBTRACT-USES FLOATING ADD 4306 /FSW0!! 4307 FFSUB, 0 4308 JMS I [PATCHF /WHICH MODE? 4309 TAD I FFSUB /CALLED BY USER-GET ADDRESS OF OP. 4310 JMS I ARGETP 4311 CDF 4312 TAD OPL /OPH IS IN MQ! 4313 SWP /PUT IT IN RIGHT ORDER 4314 DCM /NEGATE IT 4315 DCA OPH /STORE BACK 4316 MQA 4317 DCA OPL 4318 TAD FFSUB /GO TO ADD 4319 SUB0, DCA FFADD 4320 JMP FAD1-1 4321 / 4322 /FLOATING NEGATE--NEGATE FLOATING AC 4323 / 4324 FFNEG, 0 4325 SWAB /MUST BE MODE B 4326 DLD /GET MANTISSA 4327 ACH 4328 SWP /CORRECT ORDER PLEASE! 4329 DCM /NEGATE IT 4330 DCA ACH /RESTORE 4331 SWP /SEND 0 TO MQ 4332 DCA ACL 4333 JMP I FFNEG 4334 4335 4336 / 4337 /CONTINUATION OF DIVIDE ROUTINE 4338 /WE ARE ADJUSTING THE RESULT OF THE 4339 /FIRST DIVIDE. 4340 / 4341 DVOPS, CMA IAC 4342 DCA AC1 /ADJUST REMAINDER 4343 TAD OPL /WATCH FOR OVERFLOW 4344 CLL CMA IAC 4345 TAD AC1 4346 SNL 4347 JMP DVOP1 /DON'T ADJUST QUOT. 4348 DCA AC1 4349 CMA 4350 TAD AC0 4351 DCA AC0 /REDUCE QUOT BY 1 4352 DVOP1, CLA CLL 4353 TAD AC1 /GET REMAINDER 4354 SNA /ZERO? 4355 CAM /YES-ZERO EVERYTHING 4356 DVI /NO 4357 OPL 4358 SZL CLA /DIV. OVERFLOW? 4359 JMP I DVOVR /YES 4360 DCM /NO-ADJUST HI QUOT (MAYBE) 4361 JMP I DVLP1P /GO BACK 4362 DVLP1P, DVLP1 4363 DVOVR, DV 4364 ADDPCL, ADDPCH 4365 PATCHK, PTCHAD 4366 > 4367 PAGE 4368 /ARGUMENT PICK UP ROUTINE-ENTER WITH DATA FIELD SET TO EITHER 4369 /FLTG. DATA FIELD OR FLTG. INSTR. FIELD. 4370 /ADDRESS OF OPERAND IS IN THE AC ON ENTRY. 4371 /ON RETURN, THE`AC IS CLEAR 4372 / 4373 006200 0000 ARGET, 0 4374 006201 3042 DCA AC2 /STORE ADDRESS OF OPERAND 4375 006202 1442 TAD I AC2 /PICK UP EXPONENT 4376 006203 3047 DCA OPX 4377 006204 4310 JMS ISZAC2 /MOVE POINTER TO HORD,WATCH FOR FIELD OVERLAP 4378 006205 1442 TAD I AC2 /PICK IT UP 4379 IFZERO EAE < 4380 006206 7000 NOP 4381 006207 7000 NOP 4382 > 4383 4384 IFNZRO EAE < 4385 SWAB /OPH INTO MQ BECAUSE EAE ROUTINES 4386 MQA /EXPECT TO FIND IT THERE 4387 > 4388 006210 3050 DCA OPH /STORE 4389 006211 4310 JMS ISZAC2 /MOVE POINTER TO LORD,WATCHING FOR OVERLAP 4390 006212 1442 TAD I AC2 /PICK IT UP 4391 006213 3051 DCA OPL /STORE IT 4392 006214 5600 JMP I ARGET /RETURN 4393 IFZERO EAE < 4394 / 4395 /ROUTINE TO NORMALIZE THE FAC 4396 / 4397 006215 0000 FFNOR, 0 4398 006216 1045 TAD ACH /GET THE HI ORDER MANTISSA 4399 006217 7450 SNA /ZERO? 4400 006220 1046 TAD ACL /YES-HOW ABOUT LOW? 4401 006221 7450 SNA 4402 006222 1041 TAD AC1 /LOW=0, IS OVRFLO BIT ON? 4403 006223 7650 SNA CLA 4404 006224 5341 JMP ZEXP /#=0-ZERO EXPONENT 4405 006225 7332 NORMLP, AC2000 /NOT 0-MAKE A 2000 IN AC 4406 006226 1045 TAD ACH /ADD HI ORDER MANTISSA 4407 006227 7440 SZA /HI ORDER = 6000 4408 006230 5233 JMP .+3 /NO-CHECK LEFT MOST DIGIT 4409 006231 1046 TAD ACL /YES-6000 OK IF LOW=0 4410 006232 7640 SZA CLA 4411 006233 7710 SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS. 4412 006234 5236 JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7) 4413 006235 5334 JMP FNLP /JUMP SO FFGET AND PUT ARE ORGED RIGHT 4414 4415 006236 3041 FFNORR, DCA AC1 /DONE W/NORMALIZE-CLEAR AC1 4416 006237 5615 JMP I FFNOR /RETURN 4417 006240 6057 AL1P, AL1 4418 > 4419 IFNZRO EAE < 4420 4421 / 4422 /ROUTINE TO NORMALIZE THE FAC 4423 / 4424 *6215 4425 FFNOR, 0 4426 CDF /CHANGE D.F. TO FIELD OF PACKAGE 4427 SWAB /FORCE MODE B 4428 DLD /PICK UP MANTISSA 4429 ACH 4430 SWP /PUT IT IN CORRECT ORDER 4431 NMI /NORMALIZE IT 4432 SNA /IS THE # ZERO? 4433 DCA ACX /YES-INSURE ZERO EXPONENT 4434 DCA ACH /STORE HIGH ORDER BACK 4435 SWP /STORE LOW ORDER BACK 4436 DCA ACL 4437 CLA SCA /STEP COUNTER TO AC 4438 CMA IAC /NEGATE IT 4439 TAD ACX /AND ADJUST EXPONENT 4440 DCA ACX 4441 JMP I FFNOR /RETURN 4442 > 4443 /FLOATING GET 4444 4445 *6241 4446 006241 0000 FFGET, 0 4447 006242 4523 JMS I [PATCHF /WHICH MODE OF CALL 4448 006243 1641 TAD I FFGET /CALLED BY USER-GET ADDR. OF OP 4449 006244 4200 JMS ARGET /PICK UP OPERAND 4450 006245 1047 TAD OPX 4451 006246 3044 DCA ACX /LOAD THE OPERAND INTO FAC 4452 006247 1051 TAD OPL 4453 006250 3046 DCA ACL 4454 006251 1050 TAD OPH 4455 006252 3045 DCA ACH 4456 006253 2241 ISZ FFGET 4457 006254 6201 CDF 4458 006255 5641 JMP I FFGET /RETN. TO CALL +2 4459 / 4460 /FLOATING PUT 4461 / 4462 006256 0000 FFPUT, 0 4463 006257 4523 JMS I [PATCHF /WHICH MODE OF CALL? 4464 006260 1656 TAD I FFPUT /CALLED BY USER-GET OPR. ADDR 4465 006261 3241 DCA FFGET /STORE IN A TEMP 4466 006262 1044 TAD ACX /GET FAC AND STORE IT 4467 006263 3641 DCA I FFGET /AT SPECIFIED ADDRESS 4468 006264 4275 JMS ISZFGT /BUMP POINTER,WATCHING FOR FIELD OVERLAP 4469 006265 1045 TAD ACH 4470 006266 3641 DCA I FFGET 4471 006267 4275 JMS ISZFGT 4472 006270 1046 TAD ACL 4473 006271 3641 DCA I FFGET 4474 006272 2256 ISZ FFPUT /BUMP RETN. 4475 006273 6201 CDF 4476 006274 5656 JMP I FFPUT /RETN. TO CALL+2 4477 4478 /ROUTINES TO BUMP ARGET AND FPUT POINTERS AND INCREMENT THE 4479 /DATA FIELD IF THE POINTER CROSSES A FIELD BOUNDARY 4480 4481 006275 0000 ISZFGT, 0 4482 006276 2241 ISZ FFGET /BUMP POINTER 4483 006277 5675 JMP I ISZFGT /NO SKIP MEANS JUST RETURN 4484 006300 7410 SKP /SKIP MEANS WE HAVE TO INCREMENT DATA FIELD 4485 006301 3275 NEWCDF, DCA ISZFGT /THIS INST EXECUTED ONLY BY ISZAC2 4486 006302 6214 RDF /GET THE DATA FIELD 4487 006303 1307 TAD CDF10 /BUMP BY 1 AND MAKE A CDF 4488 006304 3305 DCA .+1 /PUT IN LINE 4489 006305 6305 . 4490 006306 5675 JMP I ISZFGT /RETURN 4491 4492 006307 6211 CDF10, CDF 10 4493 4494 006310 0000 ISZAC2, 0 4495 006311 2042 ISZ AC2 /BUMP POINTER 4496 006312 5710 JMP I ISZAC2 /NOTHING HAPPENED 4497 006313 1310 TAD ISZAC2 /NEED NEW DF. GET RETURN ADDR 4498 006314 5301 JMP NEWCDF /AND BUMP DF 4499 IFZERO EAE < 4500 / 4501 /ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE 4502 /REMAINDER OF THE FIRST`DIVIDE IS LESS THAN QUOT*OPL 4503 /USED BY FLTG. DIVIDE ROUTINE 4504 / 4505 006315 7041 DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER 4506 006316 3045 DCA ACH 4507 006317 7100 CLL 4508 006320 1050 TAD OPH 4509 006321 1045 TAD ACH /WATCH FOR OVERFLOW 4510 006322 7420 SNL 4511 006323 5330 JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV. 4512 006324 3045 DCA ACH /NO OVERFLOW-STORE NEW REM. 4513 006325 7040 CMA /SUBTRACT 1 FROM QUOT OF 4514 006326 1041 TAD AC1 /FIRST DIVIDE 4515 006327 3041 DCA AC1 4516 006330 7300 DVOP1, CLA CLL 4517 006331 1045 TAD ACH /GET HI ORD OF REMAINDER 4518 006332 5733 JMP I DVOP2P /GO ON 4519 006333 5542 DVOP2P, DVOP2 4520 4521 006334 7160 FNLP, CLL CML CMA /-1 4522 006335 1044 TAD ACX /SUBTR. 1 FROM EXPONENT 4523 006336 3044 DCA ACX 4524 006337 4640 JMS I AL1P /SHIFT FAC LEFT 1 4525 006340 5225 JMP NORMLP /GO BACK AND SEE IF NORMALIZED 4526 006341 3044 ZEXP, DCA ACX 4527 006342 5236 JMP FFNORR 4528 > 4529 / 4530 /FSQUARE-SQUARE FAC-CALLS MULTIPLY TO MUL. FAC BY ITSELF 4531 / 4532 *6347 4533 A, 4534 006347 0000 FFSQ, 0 4535 006350 4753 JMS I TMPY /CALL MULTIPLY TO MULTIPLY 4536 006351 0044 ACX /FAC BY ITSELF 4537 006352 5747 JMP I FFSQ /DONE 4538 006353 5600 TMPY, FFMPY 4539 / 4540 / ERROR TRAPS 4541 006354 4564 O0, JMS I [ERROR /OVERFLOW 4542 006355 4564 DV, JMS I [ERROR /DIVISION ERROR 4543 006356 4561 JMS I [FACCLR /RETURN 0 IN FAC 4544 006357 5570 JMP I [ILOOP 4545 006360 4564 LM, JMS I [ERROR /ILLEGAL ARGUMENT 4546 4547 PAGE 4548 4549 *OVERLAY+3000 4550 4551 4552 /TELETYPE "DRIVER"-WHEN CALLED,GRABS CHARACTERS FROM THE 4553 /TELETYPE UNTIL A CR IS SENT OR THE BUFFER IS FULL. ASSUMES TTY ENTRY 4554 /IS IN I/O WORK AREA. 4555 4556 006400 0000 TTYDRI, 0 4557 006401 5204 JMP LFLUSH+1 4558 006402 4564 IO, JMS I [ERROR 4559 006403 4541 LFLUSH, JMS I [CRLFR /PRINT A CR,LF 4560 006404 1255 TAD K277 /PRINT A ? SIGNIFYING WAIT FOR INPUT 4561 006405 4527 JMS I [XPUTCH 4562 006406 1467 TAD I IOTBUF /BUFFER ADDRESS 4563 006407 3471 DCA I IOTPTR /INITIALIZE POINTER TO START OF BUFFER 4564 006410 4534 JMS I [CNOCLR /INITIALIZE CHAR # TO 1 4565 006411 4576 TTYIN, JMS I [XPRINT /EMPTY TTY BUFFER BEFORE AWAITING INPUT 4566 006412 5211 JMP .-1 4567 006413 1777 TAD I (HEIGHT /ALWAYS RESET SCREEN HIEGHT ON INPUT 4568 006414 3776 DCA I (HCTR 4569 006415 1254 TAD K5252 /DESIGN INTO AC 4570 006416 6031 KSFA, KSF /CHAR READY? 4571 006417 5334 JMP SPIN /NO-DIDDLE WHILE WE WAIT 4572 006420 7300 CLA CLL /FLUSH SPINNER OUT OF AC 4573 006421 1172 TAD [200 /FORCE PARITY BIT 4574 006422 6034 KRS /GET CHAR 4575 006423 3053 DCA CHAR /SAVE 4576 006424 1053 TAD CHAR 4577 006425 4527 JMS I [XPUTCH /ECHO IT 4578 006426 6032 KCC /CLEAR KEYBOARD FLAG AND SET READER RUN 4579 006427 1053 TAD CHAR 4580 006430 1251 TAD MCTRLU /IS IT CTRL/U? 4581 006431 7650 SNA CLA 4582 006432 5203 JMP LFLUSH /YES-START AGAIN 4583 006433 1053 TAD CHAR /NO 4584 006434 1253 TAD CRUBOT /IS IT RUBOUT? 4585 006435 7450 SNA 4586 006436 5256 JMP BACKUP /YES-BACK UP BUFFER POINTER 4587 006437 1252 TAD MCR /NO-IS IT CR? 4588 006440 7650 SNA CLA 4589 006441 5321 JMP CR /YES-DONE 4590 006442 1053 TAD CHAR 4591 006443 4530 JMS I [PACKCH /PACK CHAR IN BUFFER 4592 006444 4532 JMS I [BUFCHK /BUFFER FULL? 4593 006445 5202 JMP IO /YES-ERROR 4594 006446 7000 NOP /NO-CHAR 3 LEFT 4595 006447 7000 NOP /NO-2 AND 3 LEFT 4596 006450 5211 JMP TTYIN /NO-NEXT CHAR 4597 006451 7553 MCTRLU, -225 4598 006452 0162 MCR, 377-215 4599 006453 7401 CRUBOT, -377 4600 006454 5252 K5252, 5252 4601 006455 0277 K277, 277 4602 4603 006456 1471 BACKUP, TAD I IOTPTR /BUFFER POINTER 4604 006457 7041 CIA /NEGATE 4605 006460 1467 TAD I IOTBUF /COMPARE AGAINST START OF BUFFER 4606 006461 7650 SNA CLA /BUFFER EMPTY? 4607 006462 5211 JMP TTYIN /YES-THERE IS NOTHING TO RUBOUT 4608 006463 1340 TAD SCOPFG /TEST IF CONSOLE IS A SCOPE 4609 006464 7650 SNA CLA 4610 006465 5274 JMP NOSCOP /JMP IF NOT 4611 006466 1375 TAD (10 4612 006467 4527 JMS I [XPUTCH /PRINT BS,SP,BS TO RUBOUT IF SCOPE 4613 006470 1374 TAD (40 4614 006471 4527 JMS I [XPUTCH 4615 006472 1375 TAD (10 4616 006473 7410 SKP 4617 006474 1306 NOSCOP, TAD K334 4618 006475 4527 JMS I [XPUTCH /ECHO "\" 4619 006476 4536 JMS I [CHARNO /GET CHAR # OF NEXT CHAR (LAST #+1) 4620 006477 5307 JMP C1B /1 4621 006500 5314 JMP C3B /3 4622 006501 4534 JMS I [CNOCLR /IT WAS 2-MAKE IT 1 4623 006502 7240 PBACK, CLA CMA /-1 4624 006503 1471 TAD I IOTPTR /BACK UP BUFFER POINTER 4625 006504 3471 DCA I IOTPTR 4626 006505 5211 JMP TTYIN /NEXT CHAR 4627 006506 0334 K334, 334 4628 4629 006507 1466 C1B, TAD I IOTHDR 4630 006510 0147 AND [7477 4631 006511 1172 TAD [200 /IT WAS 1-MAKE IT 3 4632 006512 3466 DCA I IOTHDR 4633 006513 5211 JMP TTYIN /NO NEED TO BACK UP POINTER 4634 4635 006514 1466 C3B, TAD I IOTHDR 4636 006515 0147 AND [7477 4637 006516 1146 TAD [100 /IT WAS 3,MAKE IT 2 4638 006517 3466 DCA I IOTHDR 4639 006520 5302 JMP PBACK /BACK UP POINTER 4640 4641 4642 006521 4541 CR, JMS I [CRLFR /ECHO A CR,LF 4643 006522 1333 TAD K4 4644 006523 1200 TAD TTYDRI /BUMP DRIVE RETURN TO NORMAL 4645 006524 3200 DCA TTYDRI 4646 006525 1053 TAD CHAR 4647 006526 4530 JMS I [PACKCH /PACK CHAR IN BUFFER 4648 006527 1467 TAD I IOTBUF 4649 006530 3471 DCA I IOTPTR /INITAILZE BUFFER POINTERS 4650 006531 4534 JMS I [CNOCLR 4651 006532 5600 JMP I TTYDRI /RETURN 4652 006533 0004 K4, 4 4653 4654 4655 006534 2017 SPIN, ISZ SPINNR /SPIN RANDOM # SEED 4656 006535 7410 SKP 4657 006536 7064 CMA CML RAL /MARCH TO THE LEFT 4658 006537 5216 JMP KSFA /CHECK FOR CHAR YET 4659 006540 0000 SCOPFG, 0 /GETS SET TO SCOPE FLAG BY STARTUP CODE 4660 /SUBROUTINE FBITGT-ROUTINE TO PUT FUNCTION BITS FROM INSTRUCTION INTO AC 4661 4662 006541 0000 FBITGT, 0 4663 006542 1056 TAD INSAV 4664 006543 7112 CLL RTR 4665 006544 7012 RTR /PUT FUNCTION BITS IN BITS 8-11 4666 006545 0171 AND [17 /MASK THEM OFF 4667 006546 5741 JMP I FBITGT /RETURN 4668 4669 /DATA LIST READ (NUMERIC) 4670 4671 006547 4773 RDLIST, JMS I (DLREAD /FETCH WORD FROM LIST 4672 006550 3044 DCA ACX /STORE AS EXPONENT 4673 006551 4773 JMS I (DLREAD 4674 006552 3045 DCA ACH /HIGH MANTISSA 4675 006553 4773 JMS I (DLREAD 4676 006554 3046 DCA ACL /LOW MANTISSA 4677 006555 5570 JMP I [ILOOP 4678 4679 /SUBROUTINE FTYPE-RETURNS TO CALL+1 IF FILE NUMERIC,CALL+2 IF ASCII 4680 4681 006556 0000 FTYPE, 0 4682 006557 1466 TAD I IOTHDR /GET HEADER 4683 006560 7110 CLL RAR /TYPE TO LINK 4684 006561 7630 SZL CLA /IS IT NUMERIC? 4685 006562 2356 ISZ FTYPE /NO-BUMP RETURN 4686 006563 5756 JMP I FTYPE /RETURN 4687 4688 006573 2314 PAGE 006574 0040 006575 0010 006576 1202 006577 1200 4689 /LAST PAGE OF BRTS-CONTAINS SAC,I/O TABLE, AND SOME MISCELLANEOUS CODE 4690 4691 /TELETYPE INPUT BUFFER (74. CHARACTERS LONG) 4692 /THIS BUFFER CONTAINS ONCE ONLY START CODE WHEN LOADED 4693 4694 TTYBUF, 4695 006600 1025 START4, TAD CDFPS /DF FOR BOTTOM OF PSEUDO-CODE 4696 006601 1242 TAD MCDF1 /COMPARE TO A CDF 10 4697 006602 7640 SZA CLA /DO THEY MATCH? 4698 006603 5570 JMP I [ILOOP /NO-ALL BUFFERS ARE FREE-START INTERPRETER 4699 006604 1026 TAD PSSTRT 4700 006605 7140 CLL CMA 4701 006606 1137 TAD [400 4702 006607 7620 SNL CLA /IS START OF PSEUDO-CODE BELOW 400 4703 006610 5213 JMP CHKB2 /NO-CHECK FOR 1000 4704 006611 1171 TAD [17 /YES-SET ALL BUFFERS BUSY 4705 006612 5237 JMP BAS 4706 006613 1026 CHKB2, TAD PSSTRT 4707 006614 7140 CLL CMA 4708 006615 1246 TAD C1000 4709 006616 7620 SNL CLA /IS START OF PSEUDO-CODE BELOW 1000 4710 006617 5222 JMP CHKB3 /NO-CHECK 1400 4711 006620 1245 TAD C16 /YES-ONLY BUFFER 1 IS AVAILABLE 4712 006621 5237 JMP BAS 4713 006622 1026 CHKB3, TAD PSSTRT 4714 006623 7140 CLL CMA 4715 006624 1247 TAD C1400 4716 006625 7620 SNL CLA /IS START OF CODE BELOW 1400? 4717 006626 5231 JMP CHKB4 /YES-CHECK 2000 4718 006627 1244 TAD C14 /YES-ONLY BUFFER 1 AND 2 AVAILABLE 4719 006630 5237 JMP BAS 4720 006631 1026 CHKB4, TAD PSSTRT 4721 006632 7140 CLL CMA 4722 006633 1243 TAD K2000 4723 006634 7620 SNL CLA /IS CODE START BELOW 2000? 4724 006635 5570 JMP I [ILOOP /NO-START INTERPRETER-ALL BUFFER FREE 4725 006636 1177 TAD [10 /YES-BUFFERS 1,2, AND 3 AVAILABLE 4726 006637 3036 BAS, DCA BMAP 4727 006640 5570 JMP I [ILOOP /START INTERPRETER 4728 006641 0000 0 4729 006642 1567 MCDF1, -6211 4730 006643 2000 K2000, 2000 4731 006644 0014 C14, 14 4732 006645 0016 C16, 16 4733 006646 1000 C1000, 1000 4734 006647 1400 C1400, 1400 4735 006650 0000 ZBLOCK 10 006651 0000 006652 0000 006653 0000 006654 0000 006655 0000 006656 0000 006657 0000 4736 006660 0000 TTYEND, 0 4737 *OVERLAY+3277 4738 4739 //////////////////////////////////////////////////////////////// 4740 /////// I/O TABLE 5 13-WORD ENTRIES //////////////////////////// 4741 //////////////////////////////////////////////////////////////// 4742 4743 006677 0001 TTYF, 1 /TELETYPE ENTRY-FILE IS ASCII 4744 006700 6600 TTYBUF /BUFFER ADDRESS 4745 006701 0000 0 /CURRENT BLOCK IN BUFFER 4746 006702 6600 TTYBUF /READ WRITE POINTER 4747 006703 6400 TTYDRI /HANDLER ENTRY 4748 006704 0000 ZBLOCK 10 006705 0000 006706 0000 006707 0000 006710 0000 006711 0000 006712 0000 006713 0000 4749 006714 0000 FILE1, ZBLOCK 15 /FILE #1 006715 0000 006716 0000 006717 0000 006720 0000 006721 0000 006722 0000 006723 0000 006724 0000 006725 0000 006726 0000 006727 0000 006730 0000 4750 006731 0000 FILE2, ZBLOCK 15 /FILE #2 006732 0000 006733 0000 006734 0000 006735 0000 006736 0000 006737 0000 006740 0000 006741 0000 006742 0000 006743 0000 006744 0000 006745 0000 4751 006746 0000 FILE3, ZBLOCK 15 /FILE #3 006747 0000 006750 0000 006751 0000 006752 0000 006753 0000 006754 0000 006755 0000 006756 0000 006757 0000 006760 0000 006761 0000 006762 0000 4752 006763 0000 FILE4, ZBLOCK 15 /FILE #4 006764 0000 006765 0000 006766 0000 006767 0000 006770 0000 006771 0000 006772 0000 006773 0000 006774 0000 006775 0000 006776 0000 006777 0000 4753 4754 PAGE 4755 /CROSS FIELD LITERAL EQUATES 4756 4757 PGETCH= [GETCH 4758 PILOOP= [ILOOP 4759 PPUTCH= [PUTCH 4760 PSACM1= [SAC-1 4761 PXPUTCH= [XPUTCH 4762 PXPRINT= [XPRINT 4763 PFFNOR= [FFNOR 4764 PFFGET= [FFGET 4765 PFFPUT= [FFPUT 4766 PUNSFIX= [UNSFIX 4767 PERROR= [ERROR 4768 PFACCLR= [FACCLR 4769 PIDLE= [IDLE 4770 PPSWAP= [PSWAP 4771 PFTYPE= [FTYPE 4772 USR= [200 4773 O200= [200 4774 O400= [400 4775 O100= [100 4776 O10= [10 4777 O17= [17 4778 O7400= [7400 4779 O77= [77 4780 O215= [215 4781 O7700= [7700 4782 M215= [-215 4783 ///////////////////////////////////////////////////////////// 4784 ///////////////////////////////////////////////////////////// 4785 ////////////// OVERLAY 2- STRING FUNCTIONS ///////////////// 4786 ///////////////////////////////////////////////////////////// 4787 ///////////////////////////////////////////////////////////// 4788 4789 000122 7700 FIELD 1 000123 5366 000124 6215 000125 4530 000126 6256 000127 1000 000130 2725 000131 0544 000132 2677 000133 2256 000134 2074 000135 3015 000136 3143 000137 0400 000140 6556 000141 2333 000142 7563 000143 3116 000144 6135 000145 0077 000146 0100 000147 7477 000150 3242 000151 3270 000152 7764 000153 6541 000154 0330 000155 2357 000156 1615 000157 6241 000160 3357 000161 0323 000162 0177 000163 2263 000164 2541 000165 0206 000166 0340 000167 2307 000170 0215 000171 0017 000172 0200 000173 1262 000174 0377 000175 7400 000176 1037 000177 0010 4790 *2000 4791 RELOC OVERLAY 4792 4793 /VERSION NUMBER WORD FOR STRING OVERLAY 4794 4795 013400* 6501 VERSON^100+SUBVSF+6000 4796 4797 /CHR$ FUNCTION 4798 /RETURNS 1 6BIT CHAR STRING FOR THE VALUE OF X 4799 4800 013401* 4556 CHR, JMS I PUNSFIX /FIX X TO 12 BIT INTEGER 4801 013402* 0145 AND O77 /MASK TO 6BIT 4802 013403* 3777 DCA I (SAC /AND PUT INTO SAC 4803 013404* 7040 CMA 4804 013405* 3032 DCA SACLEN /SET SAC LENGTH TO 1 4805 013406* 5776 JMP I (SSMODE /SET TO SMODE AND RETURN 4806 4807 /ASC FUNCTION 4808 /RETURNS DECIMAL ASCII FOR 1 CHAR STRING IN FAC 4809 4810 013407* 1777 ASC, TAD I (SAC /GET FIRST CHAR OF STRING 4811 013410* 5213 JMP FLOATS /FLOAT RESULT INTO FAC AND RETURN 4812 4813 /LEN FUNCTION 4814 /RETURNS LENGTH OF SAC IN FAC 4815 4816 013411* 1032 LEN, TAD SACLEN /LENGTH OF STRING IN SAC 4817 013412* 7041 CIA /MAKE POSITIVE 4818 4819 /ROUTINE TO FLOAT FAC AND RETURN 4820 4821 013413* 3045 FLOATS, DCA ACH /NUMBER TO BE FLOATED IN HORD 4822 013414* 3046 DCA ACL /CLEAR LORD 4823 013415* 3064 DCA TEMP2 /CLEAR FPP OVERFLOW 4824 013416* 1375 TAD (13 /SET EXP TO 11 4825 013417* 3044 DCA ACX 4826 013420* 4524 JMS I PFFNOR /NORMALIZE 4827 013421* 5570 JMP I PILOOP /RETURN 4828 4829 4830 4831 /STR$ FUNCTION 4832 /RETURNS ASCII STRING FOR NUMBER IN FAC 4833 4834 013422* 4774 STR, JMS I (FFOUT /GET NUMBER INTO INTERMEDIATE BUFFER FIRST 4835 013423* 1011 TAD XR1 4836 013424* 7041 CIA 4837 013425* 1373 TAD (INTERB-1 4838 013426* 3032 DCA SACLEN 4839 013427* 1032 TAD SACLEN /NOW SAVE COUNTER 4840 013430* 3064 DCA TEMP2 4841 013431* 1373 TAD (INTERB-1 4842 013432* 3011 DCA XR1 /POINT AT BUFFER 4843 013433* 1411 STRLUP, TAD I XR1 /GET A CHAR 4844 013434* 0145 AND O77 /MASK TO 6BIT 4845 013435* 1372 TAD (-40 /CROCK TO DELETE BLANKS 4846 013436* 7440 SZA 4847 013437* 5242 JMP .+3 4848 013440* 2032 ISZ SACLEN /IGNORE THE BLANK 4849 013441* 5244 JMP .+3 4850 013442* 1371 TAD (40 4851 013443* 3410 DCA I SACXR /STORE IN SAC 4852 013444* 2064 ISZ TEMP2 4853 013445* 5233 JMP STRLUP /LOOP FOR MORE 4854 013446* 5776 JMP I (SSMODE /DONE-RETURN IN SMODE 4855 4856 /VAL FUNCTION 4857 /RETURNS NUMBER IN FAC FOR STRING IN SAC 4858 4859 013447* 1032 VAL, TAD SACLEN 4860 013450* 3275 DCA VALCNT /COUNT OF CHARS TO INPUT 4861 013451* 1370 TAD (VALGET /ADDR OF PHONY INPUT ROUTINE 4862 013452* 3767 DCA I (IGETCH /PUT IN INPUT ROUTINE IN PLACE OF KRB 4863 013453* 4766 JMS I (FFIN /CALL FPP INPUT ROUTINE 4864 013454* 1143 TAD PGETCH /NOW RESTORE REAL INPUT ADDR 4865 013455* 3767 DCA I (IGETCH /RESTORE IN INPUT ROUTINE 4866 013456* 5570 JMP I PILOOP /DONE 4867 4868 013457* 0000 VALGET, 0 4869 013460* 1275 TAD VALCNT /TEST NUMBER OF CHARS LEFT 4870 013461* 7650 SNA CLA 4871 013462* 5272 JMP EOVAL /NONE 4872 013463* 2275 ISZ VALCNT /ELSE BUMP 4873 013464* 7000 NOP 4874 013465* 1410 TAD I SACXR /GET A BYTE 4875 013466* 1365 TAD (240 4876 013467* 0145 AND O77 4877 013470* 1365 TAD (240 /CONVERT TO 8BIT 4878 013471* 7410 SKP 4879 013472* 1170 EOVAL, TAD O215 4880 013473* 3053 DCA CHAR 4881 013474* 5657 JMP I VALGET /RETURN WITH CHAR IN 'CHAR' 4882 4883 013475* 0000 VALCNT, 0 4884 4885 013565* 0240 PAGE 013566* 5200 013567* 5362 013570* 3457 013571* 0040 013572* 7740 013573* 1150 013574* 4600 013575* 0013 013576* 0213 013577* 0331 4886 / DATE FUNCTION 4887 / RETURNS STRING OF THE FORM "MM/DD/YY" IN SAC IF DATE IS PRESENT 4888 / RETURNS NULL STRING OTHERWISE 4889 4890 4891 013600* 1020 DATE, TAD CDFIO /COPY CDF TO FIELD 17600 IN LINE 4892 013601* 3202 DCA .+1 4893 013602* 0000 YEAREX, 0 4894 013603* 1031 TAD PSFLAG /GET TD8E BIT TO LINK 4895 013604* 7104 CLL RAL 4896 013605* 7620 SNL CLA 4897 013606* 1777 TAD I (MDATE /IF ZERO LOOK AT MDATE IN N7600 4898 013607* 7430 SZL 4899 013610* 1776 TAD I (MDATE-200 /ELSE LOOK AT N7400 4900 013611* 3267 DCA DATEWD /STORE (DATE IS NOT A CLOSED SUBROUTINE) 4901 013612* 6201 CDF /DATE IS IN THE FORM MMM MDD DDD YYY 4902 013613* 1267 TAD DATEWD /PICK UP DATE 4903 013614* 7640 SZA CLA 4904 013615* 1375 TAD (-10 /RETURN 8. BYTES IF NOT NULL DATE 4905 013616* 3032 DCA SACLEN /SET SAC LENGTH 4906 013617* 1774 TAD I (BIPCCL /NOW GET YEAR EXTENSION 4907 013620* 0373 AND (600 /IT'S IN THE 600 BITS 4908 013621* 7112 CLL RTR 4909 013622* 7012 RTR /SHIFT INTO PLACE 4910 013623* 3202 DCA YEAREX /HOLD YEAR EXTENSION 4911 013624* 1267 TAD DATEWD /NOW ISOLATE MONTH 4912 013625* 0175 AND O7400 4913 013626* 7106 CLL RTL 4914 013627* 7006 RTL 4915 013630* 7004 RAL 4916 013631* 4245 JMS PUTN /PUT "MM/" INTO THE SAC 4917 013632* 1267 TAD DATEWD /NOW GET DAY OF MONTH 4918 013633* 0372 AND (370 4919 013634* 7112 CLL RTR 4920 013635* 7010 RAR 4921 013636* 4245 JMS PUTN /PUT "DD/" IN SAC 4922 013637* 1267 TAD DATEWD /FINALLY GET YEAR 4923 013640* 0371 AND (7 4924 013641* 1202 TAD YEAREX /ADD TO EXTENSION BITS 4925 013642* 1370 TAD (106 /ADD 70. FOR BASE YEAR 4926 013643* 4245 JMS PUTN /PUT OUT "YY/" (EXTRA SLASH WILL BE IGNORED) 4927 013644* 5767 JMP I (SSMODE /RETURN IN STRING MODE 4928 4929 013645* 0000 PUTN, 0 4930 013646* 2265 ISZ NHIGH /BUMP HIGH ORDER DIGIT 4931 013647* 1366 TAD (-12 /-10. 4932 013650* 7500 SMA 4933 013651* 5246 JMP .-3 /LOOP IF NOT REDUCED YET 4934 013652* 1365 TAD (12+60 /CONVERT TO DECIMAL DIGIT 4935 013653* 3266 DCA NLOW /HOLD MOMENTARILY 4936 013654* 1265 TAD NHIGH /NOW GET HI ORDER DIGIT 4937 013655* 1364 TAD (57 /MAKE 6BIT 4938 013656* 3410 DCA I SACXR 4939 013657* 1266 TAD NLOW /SEND OUT LOW DIGIT 4940 013660* 3410 DCA I SACXR 4941 013661* 1364 TAD (57 4942 013662* 3410 DCA I SACXR /SEND OUT "/" 4943 013663* 3265 DCA NHIGH /CLEAR NHIGH FOR NEXT TIME (BE CAREFULL!!) 4944 013664* 5645 JMP I PUTN 4945 013665* 0000 NHIGH, 0 4946 013666* 0000 NLOW, 0 4947 013667* 0000 DATEWD, 0 4948 /TRACE FUNCTION PRINTER. WHEN TRACE IS ENABLED,THIS ROUTINE 4949 /PRINTS THE LINE # EACH TIME IT IS STORED 4950 4951 013670* 4763 TPRINT, JMS I (LMAKE /MAKE LINE # INTO FIVE DIGITS 4952 013671* 1362 TAD ("% 4953 013672* 4527 JMS I PXPUTCH /PRINT "%" 4954 013673* 1361 TAD (" 4955 013674* 4527 JMS I PXPUTCH /PRINT A SPACE 4956 013675* 1360 TAD (DIG1-1 /ADDR OF FIRST DIGIT-1 4957 013676* 3015 DCA XR5 /IN XR5 4958 013677* 1415 IGS, TAD I XR5 /GET DIGIT OF LINE NUMBER 4959 013700* 3331 DCA TCHR /SAVE IT 4960 013701* 1357 TAD (-"0 4961 013702* 1331 TAD TCHR /COMPARE IT TO 0 4962 013703* 7650 SNA CLA /IS IT A 0? 4963 013704* 5277 JMP IGS /YES-IGNORE LEADING ZEROES 4964 013705* 1331 PREST, TAD TCHR /NO-GET CHAR AGAIN 4965 013706* 1142 TAD M215 4966 013707* 7650 SNA CLA /IS IT A CR? 4967 013710* 5316 JMP TDONE /YES-LINE NUMBER IS PRINTED 4968 013711* 1331 TAD TCHR /NO-GET CHAR A THIRD TIME 4969 013712* 4527 JMS I PXPUTCH /TYPE IT 4970 013713* 1415 TAD I XR5 /GET NEXT CHAR 4971 013714* 3331 DCA TCHR 4972 013715* 5305 JMP PREST /AND LOOP 4973 013716* 1361 TDONE, TAD (" 4974 013717* 4527 JMS I PXPUTCH /FOLLOW LINE # WITH A SPACE 4975 013720* 1362 TAD ("% 4976 013721* 4527 JMS I PXPUTCH /TYPE ANOTHER "%" 4977 013722* 1356 TAD (215 4978 013723* 4527 JMS I PXPUTCH /TYPE,CR,LF 4979 013724* 1355 TAD (212 4980 013725* 4527 JMS I PXPUTCH 4981 013726* 4576 JMS I PXPRINT /EMPTY RING BUFFER OF TRACE NUMBER 4982 013727* 5326 JMP .-1 4983 013730* 5570 JMP I PILOOP /DONE 4984 013731* 0000 TCHR, 0 4985 4986 013755* 0212 PAGE 013756* 0215 013757* 7520 013760* 4125 013761* 0240 013762* 0245 013763* 4061 013764* 0057 013765* 0072 013766* 7766 013767* 0213 013770* 0106 013771* 0007 013772* 0370 013773* 0600 013774* 7777 013775* 7770 013776* 7466 013777* 7666 4987 /TRACE FUNCTION-ROUTINE TO TURN TRACE ON AND OFF 4988 4989 014000* 1045 TRACE, TAD ACH /GET HI MANTISSA OF ARG 4990 014001* 7650 SNA CLA /SKP TO TURN TRACE ON 4991 014002* 1204 TAD TRREST /ELSE RESTORE TRACE BYPASS INSTR IN LINE NUMBER ROUTINE 4992 014003* 3605 DCA I HOOKL /BY NOP ING INSTRUCTION AT TRHOOK 4993 014004* 5570 TRREST, JMP I PILOOP 4994 4995 014005* 1143 HOOKL, TRHOOK 4996 4997 /ERROR ROUTINE 4998 4999 014006* 4576 ERRORR, JMS I PXPRINT /PURGE TTY RING BUFFER 5000 014007* 5206 JMP .-1 /BEFORE PRINTING ERROR 5001 014010* 1336 TAD ETABA /ADDR OF ERROR TABLE 5002 014011* 3014 DCA XR4 /POINTS INTO ERROR TABLE 5003 014012* 1414 FERRLP, TAD I XR4 /GET 2 CHAR ERROR CODE 5004 014013* 3040 DCA TEMP1 /SAVE 5005 014014* 1040 TAD TEMP1 5006 014015* 7112 CLL RTR 5007 014016* 7012 RTR 5008 014017* 7012 RTR 5009 014020* 0145 AND O77 /STRIP TO 6 BIT 5010 014021* 1260 TAD K0300 /MAKE 8 BIT (LETTERS ONLY ALLOWED) 5011 014022* 3313 DCA ESTRNG /PUT IN MESSAGE 5012 014023* 1040 TAD TEMP1 /2 CHAR CODE AGAIN 5013 014024* 0145 AND O77 /SECOND CHAR 5014 014025* 1260 TAD K0300 /MAKE LETTER 5015 014026* 3314 DCA ESTRNG+1 /PUT IN MESSAGE 5016 014027* 1414 TAD I XR4 /GET ERROR CODE +1 5017 014030* 1564 TAD I PERROR /COMPARE AGAINST RETURN ADDR 5018 014031* 7640 SZA CLA /MATCH? 5019 014032* 5212 JMP FERRLP /NO-TRY NEXT ONE 5020 014033* 4261 JMS LMAKE /MAKE THE LINE # INTO DECIMAL DIGITS 5021 014034* 1335 TAD ESTRA /ADDR OF MESSAGE 5022 014035* 3015 DCA XR5 5023 014036* 1415 ETLOP, TAD I XR5 /GET MESSAGE CHAR 5024 014037* 7510 SPA /DONE? (MESSAGE ENDNS WITH - NUMBER 5025 014040* 5243 JMP FATCHK /YES-DETERMINE ERROR TYPE 5026 014041* 4527 JMS I PXPUTCH /NO-PUT CHAR IN RING BUFFER 5027 014042* 5236 JMP ETLOP 5028 5029 014043* 7200 FATCHK, CLA 5030 014044* 1337 TAD MFATAL /-ADDR OF FATAL ERRORS 5031 014045* 1014 TAD XR4 /ADDR OF THIS ERROR 5032 014046* 7700 SMA CLA /FATAL ERROR? 5033 014047* 5651 JMP I ERRETN /NO-NEXT INST 5034 014050* 5652 JMP I STOPI /YES-TERMINATE RUN 5035 5036 014051* 2551 ERRETN, XERRRET 5037 014052* 0565 STOPI, FSTOPN 5038 5039 014053* 0000 MAKED, 0 5040 014054* 0171 AND O17 /ISOLATE BCD DIGIT 5041 014055* 1257 TAD K260 /MAKE ASCII DIGIT 5042 014056* 5653 JMP I MAKED 5043 5044 014057* 0260 K260, 260 5045 014060* 0300 K0300, 300 5046 /SUBROUTINE LMAKE-MAKES THE CURRENT LINE NUMBER INTO FIVE DIGITS 5047 /STARTING AT DIG1 5048 5049 014061* 0000 LMAKE, 0 5050 014062* 1057 TAD LINEHI /YES:GET HI LINE # 5051 014063* 4253 JMS MAKED /GET DIGIT 2 5052 014064* 3327 DCA DIG2 /PUT IN MESSAGE 5053 014065* 1057 TAD LINEHI 5054 014066* 7112 CLL RTR 5055 014067* 7012 RTR 5056 014070* 4253 JMS MAKED /GET DIGIT 1 5057 014071* 3326 DCA DIG1 /AND PUT IN MESSAGE 5058 014072* 1060 TAD LINELO /DOGOTS 3,4, AND 5 5059 014073* 4253 JMS MAKED /GET DIGIT 5 5060 014074* 3332 DCA DIG5 5061 014075* 1060 TAD LINELO 5062 014076* 7112 CLL RTR 5063 014077* 7012 RTR 5064 014100* 4253 JMS MAKED /GET DIGIT 4 5065 014101* 3331 DCA DIG4 /AND PUT IN MESSAGE 5066 014102* 1060 TAD LINELO 5067 014103* 7104 CLL RAL 5068 014104* 7006 RTL 5069 014105* 7006 RTL 5070 014106* 4253 JMS MAKED /GET DIGIT 3 5071 014107* 3330 DCA DIG3 /MESSAGE NOW COMPLETE 5072 014110* 5661 JMP I LMAKE 5073 /ERROR MESSAGE 5074 5075 014111* 0215 EMESS, 215 5076 014112* 0212 212 5077 014113* 0000 ESTRNG, 0000 5078 014114* 0000 0000 5079 014115* 0240 " 5080 014116* 0301 "A 5081 014117* 0324 "T 5082 014120* 0240 " 5083 014121* 0314 "L 5084 014122* 0311 "I 5085 014123* 0316 "N 5086 014124* 0305 "E 5087 014125* 0240 " 5088 014126* 0000 DIG1, 0 5089 014127* 0000 DIG2, 0 5090 014130* 0000 DIG3, 0 5091 014131* 0000 DIG4, 0 5092 014132* 0000 DIG5, 0 5093 014133* 0215 215 5094 014134* 0212 212 5095 014135* 4110 ESTRA, EMESS-1 /MINUS NUMBER TO END ABOVE MESSAGE 5096 /ERROR TABLE /ENTRY FORMAT- 2 CHAR 6-BIT ERROR CODE (LETTERS ONLY) 5097 / -(ADDR OF CALL)-1 5098 5099 014136* 4137 ETABA, ETAB-1 5100 014137* 3542 MFATAL, -EFATAL 5101 014140* 0602 ETAB, 0602 /FB 5102 014141* 3765 -FB-1 /ATTEMPT TO OPEN AN ALREADY OPEN FILE 5103 014142* 0722 0722 /GR 5104 014143* 5722 -GR-1 /RETURN WITHOUT A GOSUB 5105 014144* 2622 2622 /VR 5106 014145* 4774 -VR-1 /ATTEMPT TO READ VARIABLE LENGTH FILE 5107 014146* 2325 2325 /SU 5108 014147* 7154 -SU-1 /SUBSCRIPT ERROR 5109 014150* 0405 0405 /DE 5110 014151* 7214 -DE-1 /DEVICE DRIVER ERROR 5111 014152* 1705 1705 /OE 5112 014153* 6273 -OE-1 /DRIVER ERROR WHILE OVERLAYING 5113 014154* 0615 0615 /FM 5114 014155* 6153 -FM-1 /ATTEMPT TO FIX MINUS NUMBER 5115 014156* 0617 0617 /FO 5116 014157* 6140 -FO-1 /ATTEMPT TO FIX NUMBER >4095 5117 014160* 0616 0616 /FN 5118 014161* 5771 -FN-1 /ILLEGAL FILE # 5119 014162* 2303 2303 /SC 5120 014163* 5546 -SC-1 /ATTEMPT TO OVERFLOW SAC ON CONCATENATE 5121 014164* 0611 0611 /FI 5122 014165* 5465 -FI-1 /ATTEMPT TO CLOSE OR USE UNOPENED FILE 5123 014166* 0401 0401 /DA 5124 014167* 5456 -DA-1 /ATTEMPT TO READ PAST END OF DATA LIST 5125 014170* 0723 0723 /GS 5126 014171* 5744 -GS-1 /TOO MANY NESTED GOSUBS 5127 014172* 2322 2322 /SR 5128 014173* 4657 -SR-1 /ATTEMPT TO READ STRING FROM NUMERIC FILE 5129 014174* 2327 2327 /SW 5130 014175* 4526 -SW-1 /ATTEMPT TO WRITE STRING INTO NUMERIC FILE 5131 014176* 2001 2001 /PA 5132 014177* 3364 -PA-1 /ILLEGAL ARG IN POS 5133 014200* 0603 0603 /FC 5134 014201* 4335 -FC-1 /OS/8 ERROR WHILE CLOSING TENTATIVE FILE 5135 014202* 0311 0311 /CI 5136 014203* 4156 -CI-1 /INQUIRE FAILURE IN CHAIN 5137 014204* 0314 0314 /CL 5138 014205* 4134 -CL-1 /LOOKUP FAILURE IN CHAIN 5139 014206* 1116 1116 /IN 5140 014207* 3745 -IN-1 /INQUIRE FAILURE IN OPEN 5141 014210* 0417 0417 /DO 5142 014211* 3722 -DO-1 /NO MORE ROOM FOR DRIVERS 5143 014212* 0605 0605 /FE 5144 014213* 3665 -FE-1 /FETCH ERROR IN OPEN 5145 014214* 0217 0217 /BO 5146 014215* 3562 -BO-1 /NO MORE FILE BUFFERS AVAILABLE 5147 014216* 0516 0516 /EN 5148 014217* 3472 -EN-1 /ENTER ERROR IN OPEN 5149 014220* 1106 1106 /IF 5150 014221* 3373 -IF-1 /ILLEGAL DEV:FILENAME SPECIFICATION 5151 014222* 2314 2314 /SL 5152 014223* 5367 -SL-1 /STRING TOO LONG OR UNDEFINED 5153 014224* 1726 1726 /OV 5154 014225* 1423 -O0-1 /NUMERIC OR INPUT OVERFLOW 5155 014226* 1415 1415 /LM 5156 014227* 1417 -LM-1 /ATTEMPT TO TAKE LOG OF NEG # OR 0 5157 014230* 0515 0515 /EM 5158 014231* 4162 -EM-1 /ATTEMPT TO EXPONENTIATE A NEG NUMBER TO A REAL ROWER 5159 014232* 1101 1101 /IA 5160 014233* 6321 -IA-1 /ILLEGAL ARGUMENT IN USER FUNCTION 5161 014234* 0330 0330 /CX 5162 014235* 4102 -CX-1 /ILLEGAL FILENAME EXTENSION IN A CHAIN STATEMENT 5163 /*********************************************************** 5164 EFATAL, /ERRORS BEFORE THIS LABEL ARE FATAL 5165 /******************************************************* 5166 014236* 2205 2205 /RE 5167 014237* 4767 -RE-1 /ATTEMPT TO READ PAST EOF 5168 014240* 2705 2705 /WE 5169 014241* 4753 -WE-1 /ATTEMPT TO WRITE PAST EOF 5170 014242* 0426 0426 /DV 5171 014243* 1422 -DV-1 /ATTEMPT TO DIVIDE BY 0 5172 014244* 2324 2324 /ST 5173 014245* 5342 -ST-1 /STRING TRUNCATION ON INPUT 5174 014246* 1117 1117 /IO 5175 014247* 1375 -IO-1 /TTY INPUT BUFFER OVERFLOW 5176 T= . 5177 *ETAB 5178 *T 5179 /SEG$ FUNCTION 5180 /RETURNS SEGMENT OF X$ BETWEEN Y AND Z 5181 /IF Y<=0,THEN Y TAKEN AS 1 5182 /IF Y>LEN(X$),NULL STRING RETURNED 5183 /IF Z<=0,NULL STRING RETURNED 5184 /IF Z>LEN(X$),Z IS SET=LEN(X$) 5185 /IF Z0? 5190 014253* 7740 SMA SZA CLA 5191 014254* 4556 JMS I PUNSFIX /FIX IF POSITIVE 5192 014255* 7450 SNA 5193 014256* 7001 IAC /SET Y TO 1 IF Y.LE.0 5194 014257* 3325 DCA YARG 5195 014260* 1032 TAD SACLEN /COMPARE YARG TO SACLEN 5196 014261* 7041 CIA 5197 014262* 7161 STL CIA 5198 014263* 1325 TAD YARG 5199 014264* 7660 SNL SZA CLA /SKP IF YARG.LOS.LEN(X$) 5200 014265* 5322 JMP NULLST /NO-RETURN THE NULL STRING 5201 014266* 3056 DCA INSAV /FAKE POINTER TO SCALAR #0 5202 014267* 4671 JMS I ARGPLK /GET ADDR OF Z 5203 014270* 4557 JMS I PFFGET /LOAD Z INTO FAC 5204 014271* 0311 ARGPLK, ARGPRE /LOC SKIPPED BY FPP SO WE PUT CONST HERE 5205 014272* 1045 TAD ACH /HI MANTISSA OF Z 5206 014273* 7750 SPA SNA CLA /IS Z<0? 5207 014274* 5322 JMP NULLST /YES-RETURN THE NULL STRING 5208 014275* 4556 JMS I PUNSFIX /NO-FIX Z 5209 014276* 7120 STL 5210 014277* 1032 TAD SACLEN /CALC Z-LEN(SAC) 5211 014300* 7420 SNL /SKP IF Z.LO.LEN(SAC) 5212 014301* 7200 CLA /ELSE TAKE LEN(SAC) 5213 014302* 7040 CMA 5214 014303* 1032 TAD SACLEN 5215 014304* 1325 TAD YARG /NUMBER OF BYTES TO USE 5216 014305* 7500 SMA 5217 014306* 5322 JMP NULLST /NONE, RETURN NULL STRING 5218 014307* 3062 DCA STRCNT 5219 014310* 1325 TAD YARG /INDEX INTO STRING FOR SOURCE BYTES 5220 014311* 1377 TAD (SAC-2 5221 014312* 3012 DCA XR2 /SET SOURCE XR 5222 014313* 1062 TAD STRCNT 5223 014314* 3032 DCA SACLEN /SET NEW LENGTH OF SAC NOW 5224 014315* 1412 TAD I XR2 /NOW MOVE THE BYTES 5225 014316* 3410 DCA I SACXR 5226 014317* 2062 ISZ STRCNT 5227 014320* 5315 JMP .-3 5228 014321* 5570 JMP I PILOOP /--RETURN-- 5229 014322* 7300 NULLST, CLA CLL 5230 014323* 3032 DCA SACLEN /ZERO SAC 5231 014324* 5570 JMP I PILOOP /--RETURN-- 5232 014325* 0000 YARG, 0 5233 5234 014377* 0327 PAGE 5235 /POS FUNCTION 5236 /RETURNS THE POSITION IN X$ OF Y$ STARTING AFTER Z 5237 5238 014400* 7300 POS, CLA CLL 5239 014401* 3056 DCA INSAV /FAKE AS STRING CALL TO STRING 0 5240 014402* 4777 JMS I (STFIND /FIND Y$ 5241 014403* 1062 TAD STRCNT /# OF CHARS IN Y$ 5242 014404* 7650 SNA CLA /IS Y$ THE NULL STRING? 5243 014405* 5254 JMP ONERET /YES-RETURN 1 AS POSITION 5244 014406* 1032 TAD SACLEN /NO-# OF CHARS IN X$ 5245 014407* 7650 SNA CLA /IS X$ THE NULL STRING? 5246 014410* 5252 JMP ZRORET /YES-RETURN 0 5247 014411* 1045 TAD ACH /NO-GET HORD OF Z 5248 014412* 7750 SPA SNA CLA /IS Z GT 0? 5249 014413* 4564 PA, JMS I PERROR /NO-ILLEGAL ARGUMENT 5250 014414* 4556 JMS I PUNSFIX /FIX Z 5251 014415* 3256 DCA POSITN /USE IT AS POSITION TO START SEARCH 5252 014416* 1256 TAD POSITN 5253 014417* 7120 STL 5254 014420* 1032 TAD SACLEN /COMPARE POSITION TO MAXIMUM LENGTH OF STRING 5255 014421* 7660 SNL SZA CLA 5256 014422* 5213 JMP PA /Z IS PAST END OF STRING-ERROR 5257 014423* 1062 POSSET, TAD STRCNT 5258 014424* 7040 CMA 5259 014425* 1256 TAD POSITN /GET POSITION NOW CHECKING+SIZE IF Y$ 5260 014426* 1032 TAD SACLEN /COMPARE AGAINST LENGTH OF STRING 5261 014427* 7740 SMA SZA CLA /ANY MORE TO COME? 5262 014430* 5252 JMP ZRORET /NO-SEARCH FAILS 5263 014431* 4776 JMS I (BYTSET /SETUP BYTE LOAD ROUTINE 5264 014432* 1256 TAD POSITN /SEARCH START POSITION IN X$ 5265 014433* 1375 TAD (SAC-2 /ADD TO BASE OF SAC 5266 014434* 3010 DCA SACXR 5267 014435* 1062 TAD STRCNT /# OF CHARS IN Y$ 5268 014436* 3042 DCA TEMP3 /COUNTER 5269 014437* 4774 SRCLP, JMS I (LDB 5270 014440* 7041 CIA 5271 014441* 1410 TAD I SACXR /COMPARE CHARS 5272 014442* 7650 SNA CLA /DO THEY MATCH? 5273 014443* 5246 JMP SCONTU /YES-CONTINUE MATCH TO NEXT CHAR IN X$ AND Y$ 5274 014444* 2256 ISZ POSITN /BUMP POSITION TO BE CHECKED 5275 014445* 5223 JMP POSSET /ITERATE 5276 5277 014446* 2042 SCONTU, ISZ TEMP3 /MORE CHARS IN Y$? 5278 014447* 5237 JMP SRCLP /YES, ITERATE 5279 014450* 1256 TAD POSITN /NO FOUND A MATCH 5280 014451* 5773 JMP I (FLOATS 5281 014452* 4561 ZRORET, JMS I PFACCLR /SEARCH FAILS-RETURN 0 5282 014453* 5570 JMP I PILOOP 5283 5284 014454* 7201 ONERET, CLA IAC 5285 014455* 5773 JMP I (FLOATS /RETURN 1 5286 014456* 0000 POSITN, 0 5287 5288 014573* 3413 PAGE 014574* 2600 014575* 0327 014576* 2653 014577* 1671 5289 RELOC 5290 5291 ////////////////////////////////////////////////// 5292 ////////////////////////////////////////////////// 5293 ///////// OVERLAY 3-FILE MANIPULATING //////////// 5294 ///////// FUNCTIONS //////////// 5295 ////////////////////////////////////////////////// 5296 ////////////////////////////////////////////////// 5297 5298 *3400 5299 5300 /FILE CLOSING ROUTINE 5301 5302 013400 6501 VERSON^100+SUBVFF+6000 /VERSION WORD FOR FILES OVERLAY 5303 5304 013401 3402 ANDPTR, ANDLST 5305 013402 7776 ANDLST, 7776 /MASKS FOR CLEARING BUFFER AND HANDLER STATUS BITS 5306 013403 7775 7775 5307 013404 7773 7773 5308 013405 7767 7767 5309 5310 013406 1065 CLOSE, TAD ENTNO /GET FILE # 5311 013407 7650 SNA CLA /IS IT TTY? 5312 013410 5570 JMP I PILOOP /YES-DON'T DO ANYTHING 5313 013411 4567 JMS I PIDLE /SEE IF FILE OPEN 5314 013412 4540 JMS I PFTYPE /IS FILE NUMERIC? 5315 013413 5220 JMP NOCZ /YES-DON'T OUTPUT ^Z 5316 013414 4777 JMS I (FOTYPE /NO-IS FILE VARIABLE LENGTH? 5317 013415 5220 JMP NOCZ /NO-DON'T OUTPUT ^Z 5318 013416 1376 TAD (232 /YES 5319 013417 4550 JMS I PPUTCH /WRITE A ^Z IN FILE 5320 013420 4775 NOCZ, JMS I (WRBLK /WRITE LAST BLOCK IF IT HAS CHANGED 5321 013421 4573 JMS I PPSWAP /RESTORE 17600 5322 013422 4777 JMS I (FOTYPE /IS FILE FIXED LENGTH? 5323 013423 5243 JMP CLOSED /YES-NO NEED TO CLOSE THE FILE 5324 013424 1474 TAD I IOTLEN /NO-GET FILE LENGTH 5325 013425 3241 DCA CLENG /PUT IN CLOSE CALL 5326 013426 1077 TAD IOTFIL 5327 013427 3240 DCA FNAP /POINTER TO FILE NAME 5328 013430 1466 TAD I IOTHDR 5329 013431 7106 CLL RTL 5330 013432 7006 RTL 5331 013433 7004 RAL /GET DEVICE NUMBER INTO BITS 8-11 5332 013434 0171 AND O17 /ISOLATE IT 5333 013435 6212 CIF 10 5334 013436 4522 JMS I O7700 /CALL USR 5335 013437 0004 4 /CLOSE 5336 013440 3440 FNAP, . /POINTER TO FILE NAME 5337 013441 3441 CLENG, . 5338 013442 4564 FC, JMS I PERROR /FILE CLOSING ERROR 5339 013443 1467 CLOSED, TAD I IOTBUF /GET BUFFER ADDRESS 5340 013444 7106 CLL RTL 5341 013445 7006 RTL /BUFFER NUMBER INTO AC 5342 013446 7004 RAL /BITS 10,11 5343 013447 0374 AND (3 /STRIP 5344 013450 1201 TAD ANDPTR /USE AS INDEX INTO MASKS 5345 013451 3040 DCA TEMP1 5346 013452 1036 TAD BMAP /BUFFER STATUS MAP 5347 013453 0440 AND I TEMP1 /CLEAR THE BIT FOR THIS BUFFER 5348 013454 3036 DCA BMAP 5349 013455 1466 TAD I IOTHDR /HEADER WORD 5350 013456 0175 AND O7400 /STRIP HEADER TO DEVICE # ONLY 5351 013457 3466 DCA I IOTHDR 5352 013460 1335 TAD MM4 /-4 5353 013461 3042 DCA TEMP3 /USE AS COUNTER 5354 013462 1042 CHECKL, TAD TEMP3 /GET 3 OF FILE TO CHECK 5355 013463 1373 TAD (W0PTR /MAKE POINTER TO PROPER W0 HEADER 5356 013464 3040 DCA TEMP1 /SAVE POINTER 5357 013465 1042 TAD TEMP3 /-# OF FILE WERE CHECKING 5358 013466 1065 TAD ENTNO /COMPARE TO CURRENT NUMBER 5359 013467 7650 SNA CLA /IS IT THIS ONE? 5360 013470 5277 JMP PSTCHK /YES-DON'T CHECK DRIVER 5361 013471 1440 TAD I TEMP1 /GET HEADER WORD FOR THE FILE OF INTEREST 5362 013472 0175 AND O7400 /ISOLATE DEVICE # 5363 013473 7041 CIA /NEGATE 5364 013474 1466 TAD I IOTHDR /COMPARE TO CURRENT DEVICE # 5365 013475 7650 SNA CLA /SAME DEVICE? 5366 013476 5317 JMP CRETN /YES-LEAVE DRIVER IN CORE 5367 013477 2042 PSTCHK, ISZ TEMP3 /ALL 4 CHECKED? 5368 013500 5262 JMP CHECKL /NO-CHECK THE NEXT 1 5369 013501 1466 TAD I IOTHDR 5370 013502 0177 AND O10 /GET HANDLER LENGTH BIT 5371 013503 7640 SZA CLA /TWO PAGES? 5372 013504 5322 JMP TPREL /YES-FREE BOTH PAGES 5373 013505 1472 TAD I IOTHND /THIS IS THE ONLY FILE USING HANDLER THEN 5374 013506 7106 CLL RTL 5375 013507 7006 RTL /SLIDE BITS 4,5 OF HANDLER PAGE TO AC BITS 10,11 5376 013510 7004 RAL 5377 013511 0374 AND (3 /ISOLATE HANDLER BUFFER NUMBER 5378 013512 1201 TAD ANDPTR /MAKE POINTER TO PROPER AND MASK 5379 013513 3040 RELCOM, DCA TEMP1 5380 013514 1035 TAD DMAP /DRIVER PAGE MAP 5381 013515 0440 AND I TEMP1 /CLEAR HANDLER PAGE BIT 5382 013516 3035 DCA DMAP 5383 013517 3472 CRETN, DCA I IOTHND /SET FILE AS IDLE 5384 013520 4573 JMS I PPSWAP /GET RID OF 17600 AGAIN 5385 013521 5570 JMP I PILOOP /DONE 5386 5387 013522 1472 TPREL, TAD I IOTHND /ONLY FILE USING HANDLER 5388 013523 7106 CLL RTL 5389 013524 7006 RTL /ISOLATE HANDLER BUFFER NUMBER 5390 013525 7004 RAL 5391 013526 0374 AND (3 5392 013527 1372 TAD (ANDLS2 /USE AS INDEX TO AND MASK 5393 013530 5313 JMP RELCOM 5394 5395 013531 6714 W0PTR, FILE1 5396 013532 6731 FILE2 /FILE TABLE ENTRIES 5397 013533 6746 FILE3 5398 013534 6763 FILE4 5399 5400 MM4, 5401 013535 7774 ANDLS2, 7774 5402 013536 7701 7701 5403 5404 /CODE TO READ IN COMPILER AND START IT 5405 /THIS CODE GETS MOVED TO FIELD 1 AND EXECUTED FROM 5406 /LOC 2001-2013 IN FIELD 1 5407 5408 013537 6211 CREAD, CDF 10 5409 013540 6202 CIF 0 5410 013541 4613 4613 /"JMS I L7607K" 5411 013542 3700 3700 /31 PAGES 5412 013543 0000 0 /0-7577 5413 013544 7617 CBLK, 7617 /STARTING BLOCK OF COMPILER 5414 013545 7402 HLT /SYSTEM ERROR,AND SINCE WE ARE PROBABLY CLOBBERED,WE CAN'T REPORT IT 5415 013546 6202 CIF 0 5416 013547 5612 5612 /"JMP I .+1"-START THE COMPILER 5417 013550 7001 7001 /STARTING ADDR OF COMPILER 5418 013551 7607 K7607K, 7607 5419 /LESS THAN THE DESIRED VALUE 5420 5421 013552 0000 EXTCHK, 0 /SKIP RETURN IF CURRENT 5422 013553 7326 AC0002 5423 013554 7001 IAC 5424 013555 1077 TAD IOTFIL /IS .SV 5425 013556 3364 DCA EXTEMP /JUST A TEMP 5426 013557 1764 TAD I EXTEMP /GET EXTENSION 5427 013560 1371 TAD (-2326 5428 013561 7650 SNA CLA /IS IT .SV? 5429 013562 2352 ISZ EXTCHK /YES: SKIP 5430 013563 5752 JMP I EXTCHK 5431 013564 0000 EXTEMP, 0 5432 5433 013571 5452 PAGE 013572 3535 013573 3531 013574 0003 013575 3337 013576 0232 013577 2342 5434 /CHAIN FUNCTION 5435 /SETS UP COMMAND DECODER AREA,THEN CHAINS TO BCOMP.SV 5436 5437 013600 4576 CHAIN, JMS I PXPRINT /EMPTY TTY RING BUFFER 5438 013601 5200 JMP .-1 5439 013602 4573 JMS I PPSWAP /RESTORE PG 17600 5440 013603 4617 JMS I DNA2 /GET FILE NAME IN NAME AREA FROM CURRENT FILE 5441 013604 6212 CIF 10 5442 013605 4522 JMS I O7700 /CALL USR 5443 013606 0010 10 /LOCK IN CORE 5444 013607 1475 TAD I IOTDEV 5445 013610 3216 DCA DNA1 /FIRST TWO CHARS OF DEV NAME 5446 013611 1476 TAD I IOTDEV+1 /LAST TWO CHARS 5447 013612 3217 DCA DNA2 5448 013613 6212 CIF 10 5449 013614 4572 JMS I USR 5450 013615 0012 12 /INQUIRE 5451 013616 0000 DNA1, 0 /DEVICE NAME 5452 013617 4400 DNA2, NAMEG 5453 013620 0000 CDIN, 0 5454 013621 4564 CI, JMS I PERROR /ERROR 5455 013622 1220 TAD CDIN /GET ENTRY POINT OF DRIVER FOR CHAIN FILE 5456 013623 7640 SZA CLA /IS IT IN CORE? 5457 013624 5233 JMP DISIN /YES-NO NEED TO FETCH IT 5458 013625 1217 TAD DNA2 /NO-DEVICE # INTO AC 5459 013626 6212 CIF 10 5460 013627 4572 JMS I USR 5461 013630 0001 1 /FETCH HANDLER 5462 013631 7001 7001 /INTO PAGE 7000 5463 013632 5221 JMP CI /MAKE IT LOOK LIKE INQUIRE ERROR 5464 013633 1077 DISIN, TAD IOTFIL 5465 013634 3241 DCA STB /POINTER TO FILE NAME 5466 013635 1217 TAD DNA2 /GET DEVICE # 5467 013636 6212 CIF 10 5468 013637 4572 JMS I USR 5469 013640 0002 2 /LOOKUP 5470 013641 0000 STB, 0 /POINTER TO FILE NAME 5471 013642 0000 FLN, 0 5472 013643 4564 CL, JMS I PERROR /LOOKUP ERROR 5473 013644 1241 TAD STB /GET STARTING BLOCK 5474 013645 6211 CDF 10 5475 013646 3777 DCA I (7620 /STARTING BLOCK IN CD AREA 5476 013647 1242 TAD FLN /FILE LENGTH 5477 013650 7106 CLL RTL 5478 013651 7006 RTL 5479 013652 0376 AND (7760 /PUT IN BITS 0-7 5480 013653 1217 TAD DNA2 /COMBINE WITH DEVICE # 5481 013654 3775 DCA I (7617 /PUT IN CD AREA 5482 013655 1146 TAD O100 /SET R SWITCH 5483 013656 3774 DCA I (7644 5484 013657 1773 TAD I (7605 /STARTING BLOCK OF COMPILER 5485 013660 7450 SNA /(IS THIS A CORE IMAGE? 5486 013661 5273 JMP CICHAIN /YES: HANDLE SOMEWHAT DIFFERENTLY 5487 013662 6201 CDF 5488 013663 3772 DCA I (CBLK /INTO COMPILER READ CODE 5489 013664 6201 CDF 5490 013665 4771 JMS I (EXTCHK /SKP IF EXTENSION .SV 5491 013666 7410 SKP 5492 013667 5275 JMP CX /ERROR IF IT IS 5493 013670 4770 JMS I (PSWAP2 /NOW EXEC DESTRUCTIVE EXIT CODE 5494 013671 6211 CDF 10 5495 013672 5767 JMP I (CSMOVE /MOVE THE COMPILER READ TO FIELD 1 AND EXECUTE IT 5496 5497 013673 6201 CICHAIN,CDF 5498 013674 4771 JMS I (EXTCHK /SKP IF EXTENSION IS .SV 5499 013675 4564 CX, JMS I PERROR /ERROR IF NOT 5500 013676 4770 JMS I (PSWAP2 /NOW EXEC ONCE ONLY CLEAN UP ROUTINE 5501 013677 1241 TAD STB 5502 013700 3307 DCA CHNSTB 5503 013701 6212 CIF 10 /NOW DO A RESET AND DELETE TENTATIVE FILES 5504 013702 4572 JMS I USR 5505 013703 0013 13 /RESET 5506 013704 6212 CIF 10 /FLAG TENTATIVE FILE CLEANUP 5507 013705 4572 JMS I USR 5508 013706 0006 6 5509 013707 7402 CHNSTB, HLT 5510 /FILE LOOKUP 5511 5512 013710 7326 FLOOK, AC0002 5513 013711 4766 JMS I (ENTLOK /LOOKUP 5514 013712 3474 DCA I IOTLEN /ACTUAL LENGTH 5515 013713 1474 TAD I IOTLEN 5516 013714 3475 DCA I IOTMAX /ALSO EQUALS MAXIMUM LENGTH 5517 013715 3476 CLEANP, DCA I IOTPOS /ZERO COLUMN POINTER 5518 013716 7040 CMA /-1 5519 013717 1473 TAD I IOTLOC /STARTING BLOCK-1 5520 013720 3470 DCA I IOTBLK /CURRENT BLOCK #=STARTING BLOCK-1 5521 013721 1467 TAD I IOTBUF 5522 013722 3471 DCA I IOTPTR /READ/WRITE POINTER AT BEGINNING OF BUFFER 5523 013723 6212 CIF 10 5524 013724 4572 JMS I USR /CALL TO USR 5525 013725 0011 11 /USROUT 5526 013726 4573 JMS I PPSWAP /GET RID OF 17600 5527 013727 4765 JMS I (BLZERO 5528 013730 4764 JMS I (NEXREC /DO A NEXREC TO READ IN FIRST FILE BLOCK 5529 013731 5570 JMP I PILOOP /DONE 5530 5531 /ROUTINE FOR INTERPRETER EXIT 5532 5533 013732 6031 FSTOP, KSF /IS THE KEYBOARD FLAG SET? 5534 013733 5352 JMP NOCTC /NO-THERE IS NO CHANGE ^C SENT US HERE 5535 013734 1172 TAD O200 /YES-FORCE PARITY BIT 5536 013735 6036 KRB /GET CHARACTER 5537 013736 1363 TAD (-203 /COMPARE AGAINST ^C 5538 013737 7640 SZA CLA /WAS IT ^C? 5539 013740 5352 JMP NOCTC /NO-THIS IS A NORMAL EXIT 5540 013741 6041 TSF 5541 013742 5341 JMP .-1 5542 013743 1362 TAD ("^ /YES -ECHO ^ 5543 013744 6046 TLS 5544 013745 7200 CLA 5545 013746 6041 TSF 5546 013747 5346 JMP .-1 5547 013750 1361 TAD ("C /ECHO "C" 5548 013751 6046 TLS 5549 013752 6041 NOCTC, TSF 5550 013753 5352 JMP .-1 5551 013754 5760 JMP I (MEXIT 5552 5553 013760 4253 PAGE 013761 0303 013762 0336 013763 7575 013764 3270 013765 2101 013766 4273 013767 4135 013770 4330 013771 3552 013772 3544 013773 7605 013774 7644 013775 7617 013776 7760 013777 7620 5554 /FILE OPENING ROUTINE 5555 5556 014000 1377 OPENAV, TAD (4 /ALPHANUMERIC,VARIABLE LENGTH 5557 014001 7001 OPENAF, IAC /ALPHANUMERIC,FIXED LENGTH 5558 014002 5204 JMP OPENNF 5559 014003 1377 OPENNV, TAD (4 /NUMERIC,VARIABLE LENGTH 5560 014004 3466 OPENNF, DCA I IOTHDR /SET UP HEADER WORD 5561 014005 1065 TAD ENTNO /IS FILE TTY? 5562 014006 7650 SNA CLA 5563 014007 5570 JMP I PILOOP /YES-DON'T DO ANYTHING 5564 014010 1472 TAD I IOTHND /GET HANDLER ENTRY 5565 014011 7640 SZA CLA /IS FILE IDLE? 5566 014012 4564 FB, JMS I PERROR /ATTEMPT TO OPEN FILE ALREADY OPEN 5567 014013 4573 JMS I PPSWAP /RESTORE 17600 5568 014014 4776 JMS I (NAMEG /GET FILE DEVICE NAME AND FILE NAME INTO WORDS 7-14 FROM SAC 5569 014015 6212 CIF 10 5570 014016 4522 JMS I O7700 /CALL TO USR 5571 014017 0010 10 /LOCK USR IN CORE 5572 014020 1475 TAD I IOTDEV 5573 014021 3227 DCA DEVNA1 /DEVICE NAME INTO INQUIRE CALL 5574 014022 1476 TAD I IOTDEV+1 5575 014023 3230 DCA DEVNA2 5576 014024 6212 CIF 10 5577 014025 4572 JMS I USR /CALL TO USR 5578 014026 0012 12 /INQUIRE 5579 014027 4027 DEVNA1, . /DEVICE NAME 5580 014030 4030 DEVNA2, . 5581 014031 0000 ENTRYN, 0 /ENTRY POINT 5582 014032 4564 IN, JMS I PERROR /INQUIRE ERROR 5583 014033 1230 TAD DEVNA2 /GET DEVICE # 5584 014034 7110 CLL RAR 5585 014035 7012 RTR /PUT INTO BITS 0-3 5586 014036 7012 RTR 5587 014037 1466 TAD I IOTHDR 5588 014040 3466 DCA I IOTHDR /STORE IN HEADER WORD 5589 014041 1231 TAD ENTRYN /GET DRIVER ADDRESS 5590 014042 7440 SZA /IS IT IN CORE? 5591 014043 5775 JMP I (DRIVRN /YES-NO NEED TO FETCH IT 5592 014044 1035 TAD DMAP /NO-GET MAP OF DRIVER PAGES 5593 014045 7110 CLL RAR /PAGE 7000 BIT IN LINK 5594 014046 7420 SNL /IS PAGE 7000 FREE? 5595 014047 5262 JMP FREE70 /YES 5596 014050 7110 CLL RAR /NO-7200 BIT TO LINK 5597 014051 7420 SNL /IS PAGE 7200 FREE? 5598 014052 5273 JMP FREE72 /YES 5599 014053 7110 CLL RAR /NO-7400 BIT TO LINK 5600 014054 7630 SZL CLA /IS PAGE 7400 FREE? 5601 014055 4564 DO, JMS I PERROR /NO-NO MORE ROOM FOR DRIVERS 5602 014056 1175 TAD O7400 /YES-LOAD HANDLER INTO 7400 5603 014057 3311 DCA FETPAG /SET UP IN FETCH CALL 5604 014060 1377 TAD (4 /SET BIT 9 TO SHOW PAGE 7400 OCCUPIED 5605 014061 5303 JMP DFETCH /FETCH DRIVER 5606 5607 014062 7110 FREE70, CLL RAR /PAGE 7200 BIT TO LINK 5608 014063 7620 SNL CLA /IS 7200 FREE? 5609 014064 7001 IAC /YES-THERE IS ROOM FOR A TWO PAGE HANDLER 5610 014065 1374 TAD (7000 5611 014066 3311 DCA FETPAG /SET UP FETCH TO USE PAGE 7000 5612 014067 7326 CLL CLA CML RTL /TURN ON BIT 10 5613 014070 3334 DCA TPH /SAVE IN TWO PAGE SET WORD 5614 014071 7001 IAC /SET BIT 11 TO SHOW PAGE 7000 OCCUPIED 5615 014072 5303 JMP DFETCH /FETCH HANDLER 5616 5617 014073 7110 FREE72, CLL RAR /7400 BIT TO LINK 5618 014074 7620 SNL CLA /IS 7400 PAGE FREE? 5619 014075 7001 IAC /YES-THEN THERE IS ROOM FOR A 2 PAGE HANDLER 5620 014076 1373 TAD (7200 5621 014077 3311 DCA FETPAG /SET ADDRESS IN FETCH CALL 5622 014100 1377 TAD (4 5623 014101 3334 DCA TPH /IF TWO PAGE LOADED,SET BIT 9 ALSO 5624 014102 7326 AC0002 /TURN ON BIT 10 TO SHOW PAGE 7200 OCCUPIED 5625 014103 1035 DFETCH, TAD DMAP /TURN ON PAGE BIT FOR WHERE BUFFER WILL BE LOADED 5626 014104 3035 DCA DMAP 5627 014105 1230 TAD DEVNA2 /DEVICE # IN AC 5628 014106 6212 CIF 10 5629 014107 4572 JMS I USR /CALL TO USR 5630 014110 0001 1 /FETCH 5631 014111 4111 FETPAG, . /DRIVER ADDRESS 5632 014112 4564 FE, JMS I PERROR /FETCH ERROR 5633 014113 6211 CDF 10 5634 014114 7240 CLA CMA 5635 014115 1772 TAD I (37 /GET ADDR OF HANDLER INFO TABLE 5636 014116 1230 TAD DEVNA2 /USE THE DEVICE # AS AN INDEX INTO THAT TABLE 5637 014117 3040 DCA TEMP1 /SAVE POINTER 5638 014120 1440 TAD I TEMP1 /GET THE INFO WORD FOR THE HANDLER JUST FETCHED 5639 014121 6201 CDF 5640 014122 7700 SMA CLA /IS HANDLER 2 PAGES LONG? 5641 014123 5332 JMP DRAP /NO MAP IS COMPLETE 5642 014124 1334 TAD TPH /YES-UPDATE DRIVER MAP TO INCLUDE 5643 014125 1035 TAD DMAP /SECOND PAGE OF TWO PAGE HANDLERS 5644 014126 3035 DCA DMAP 5645 014127 1177 TAD O10 5646 014130 1466 TAD I IOTHDR /SET 2 PAGE BIT IN HEADER WORD 5647 014131 3466 DCA I IOTHDR 5648 014132 1311 DRAP, TAD FETPAG /HANDLER ENTRY ADDRESS 5649 014133 5775 JMP I (DRIVRN /PAGE ESCAPE 5650 5651 014134 0000 TPH, 0 5652 /ROUTINE TO MOVE THE COMPILER READER INTO FIELD 1 AND START IT 5653 5654 014135 1371 CSMOVE, TAD (CREAD-1 5655 014136 3011 DCA XR1 /POINTES TO COMPILER STARTING CODE 5656 014137 1370 TAD (-13 5657 014140 3040 DCA TEMP1 /COUNTER 5658 014141 1367 TAD (2000 5659 014142 3012 DCA XR2 /MOVE TO LOC 2001 IN FIELD 1 5660 014143 6201 CDF 5661 014144 1411 TAD I XR1 /GET WORD OF CODE 5662 014145 6211 CDF 10 5663 014146 3412 DCA I XR2 /MOVE IT 5664 014147 2040 ISZ TEMP1 /DONE? 5665 014150 5343 JMP .-5 /NO 5666 014151 6212 CIF 10 /YES-START IT 5667 014152 4767 JMS I (2000 5668 5669 014167 2000 PAGE 014170 7765 014171 3536 014172 0037 014173 7200 014174 7000 014175 4200 014176 4400 014177 0004 5670 014200 3472 DRIVRN, DCA I IOTHND /DRIVER ENTRY INTO I/O TABLE 5671 014201 1036 TAD BMAP /GET BUFFER MAP 5672 014202 7110 CLL RAR /BUFF1 BIT TO LINK 5673 014203 7420 SNL /IS IT FREE? 5674 014204 5234 JMP B1 /YES-ASSIGN BUFF1 5675 014205 7010 RAR /BUFF2 BIT TO LINK 5676 014206 7420 SNL /IS IT FREE? 5677 014207 5227 JMP B2 /YES-ASSIGN BUFF2 5678 014210 7010 RAR /BUFF3 BIT TO LINK 5679 014211 7420 SNL /IS IT FREE 5680 014212 5222 JMP B3 /YES-ASSIGN BUFF3 5681 014213 7010 RAR /NO-BUFF4 BIT TO LINK 5682 014214 7630 SZL CLA /IS IT FREE? 5683 014215 4564 BO, JMS I PERROR /NO-NO MORE BUFFERS AVAILABLE 5684 014216 1377 TAD (1400 5685 014217 3467 DCA I IOTBUF /SET BUFFER ADDRESS TO 1400 5686 014220 1177 TAD O10 /SET BUFF4 BIR IN MAP 5687 014221 5237 JMP BUFASS 5688 5689 014222 7200 B3, CLA 5690 014223 1376 TAD (1000 5691 014224 3467 DCA I IOTBUF /SET BUFFER ADDRESS TO 1000 5692 014225 1375 TAD (4 5693 014226 5237 JMP BUFASS /SET BUFF3 BIT IN MAP 5694 5695 014227 7200 B2, CLA 5696 014230 1137 TAD O400 5697 014231 3467 DCA I IOTBUF /SET BUFF ADDRESS TO 400 5698 014232 7326 CLL CML CLA RTL /SET BUFF2 BIT IN MAP 5699 014233 5237 JMP BUFASS 5700 5701 014234 7200 B1, CLA 5702 014235 3467 DCA I IOTBUF /SET BUFF ADDRESS TO 0000 5703 014236 7201 CLA IAC /TURN ON BUFF1 BIT IN MAP 5704 014237 1036 BUFASS, TAD BMAP 5705 014240 3036 DCA BMAP /UPDATE BUFFER ASSIGNMENT MAP 5706 014241 1466 TAD I IOTHDR /GET HEADER WORD 5707 014242 7112 CLL RTR 5708 014243 7010 RAR /FIXED,VARIABLE BIT TO LINK 5709 014244 7620 SNL CLA /IS IT FIXED? 5710 014245 5774 JMP I (FLOOK /YES-DO A LOOKUP 5711 014246 1373 TAD (3 /NO-DO AN ENTER 5712 014247 4273 JMS ENTLOK /ENTER 5713 014250 3475 DCA I IOTMAX /MAXIMUM LENGTH IN WORD 7 5714 014251 3474 DCA I IOTLEN /ZERO ACTUAL LENGTH 5715 014252 5772 JMP I (CLEANP /FINALIZE I/O TABLE ENTRY 5716 5717 014253 7200 MEXIT, CLA 5718 014254 4573 JMS I PPSWAP 5719 014255 4771 JMS I (PSWAP2 /RESTORE PG 27600 5720 014256 6211 CDF 10 5721 014257 1770 TAD I (EDBLK /GET BLOCK # FOR EDITOR 5722 014260 6201 CDF 5723 014261 7450 SNA /SHALL WE CALL THE EDITOR? 5724 014262 5767 JMP I (7600 /NOkJUST CALL OS/8 5725 014263 3267 DCA EBLK /YES-PUT THE BLOCK # IN DRIVER CALL 5726 014264 4766 JMS I (7607 /CALL SYS DRIVER 5727 014265 2100 2100 /READ 8 BLOCKS 5728 014266 0000 0 /INTO 0-3377 5729 014267 4267 EBLK, . /BLOCK # OF EDITOR 5730 014270 7402 HLT /SYS ERROR,AND SINCE WE ARE PROBABLY CLOBBERED,WE CAN'T REPORT IT 5731 014271 5672 JMP I .+1 /START THE EDITOR 5732 014272 3212 3212 5733 014273 0000 ENTLOK, 0 5734 014274 3302 DCA FNOM /FUNCTION NUMBER IN PLACE 5735 014275 1077 TAD IOTFIL /POINTER TO FILE NAME 5736 014276 3303 DCA STARTB /INTO CALL 5737 014277 1765 TAD I (DEVNA2 /DEVICE NUMBER 5738 014300 6212 CIF 10 5739 014301 4572 JMS I USR /CALL TO USR 5740 014302 4302 FNOM, . /ENTER OR LOOKUP 5741 014303 4303 STARTB, . 5742 014304 4304 FLEN, . 5743 014305 4564 EN, JMS I PERROR /ENTER ERROR 5744 014306 1303 TAD STARTB /FILE STARTING BLOCK # 5745 014307 7640 SZA CLA /IS IT NON-ZERO? 5746 014310 5323 JMP FILSTU /YES-DEVICE IS FILE STRUCTURED 5747 014311 1304 TAD FLEN /NO-GET FILE LENGTH 5748 014312 7640 SZA CLA /IS IT EMPTY? 5749 014313 5323 JMP FILSTU /NO-DEVICE IS FILE STRUCTURED 5750 014314 1364 TAD (20 /NO-FILE IS READ/WRITE ONLY 5751 014315 1466 TAD I IOTHDR 5752 014316 3466 DCA I IOTHDR /SET READ/WRITE ONLY BIT 5753 014317 1302 TAD FNOM 5754 014320 7110 CLL RAR 5755 014321 7620 SNL CLA 5756 014322 7001 IAC 5757 014323 1303 FILSTU, TAD STARTB /GET STARTING BLOCK # OF FILE 5758 014324 3473 DCA I IOTLOC /PUT IN I/O TABLE 5759 014325 1304 TAD FLEN /FILE LENGTH 5760 014326 7041 CIA /MAKE FILE LENGTH POSITIVE 5761 014327 5673 JMP I ENTLOK /RETURN 5762 /SUBROUTINE P2SWAP-RESTORE OS/8 RESIDENT MONITOR PRIOR TO EXIT FROM INTERPRETERTER 5763 /THIS IS DESTRUCTIVE CODE,AND ONCE THIS ROUTINE HAS BEEN EXECUTED 5764 /THERE IS NO PLACE TO GO BUT OUT. 5765 /HAS 3 FUNCTIONS: 5766 / 1) REMOVES CTRL/C HOOKS FROM SYS DRIVER 5767 / 2) RESTORES BATCH CONTROL WORDS TO 27774-27777 5768 / 3) IF SYS=TD/8E,RESTORES PAGE 27600 AND RETURNS CDFS TO PAGE 07600 5769 5770 014330 0000 PSWAP2, 0 5771 014331 1363 TAD (4207 5772 014332 3767 DCA I (7600 /REMOVE CTRL/C HOOKS 5773 014333 1362 TAD (6213 5774 014334 3761 DCA I (7605 5775 014335 1367 TAD (7600 5776 014336 3760 DCA I (HICORE /FUDGE POINTER IN SWAP ROUTINE (IN CASE IT WAS TD8E) 5777 014337 1031 TAD PSFLAG /GET RESIDENT STATUS FLAG 5778 014340 7710 SPA CLA /IS THIS TD8/E SYS? 5779 014341 4757 JMS I (PSWP2P /YES-RESTORE PAGE 27600 AND PAGE 07600 5780 014342 1020 TAD CDFIO 5781 014343 3346 DCA .+3 /CDF TO HI CORE 5782 014344 6211 CDF 10 5783 014345 1755 TAD I BOSPT1 /GET BATCH WORD 5784 014346 6211 CDF 10 5785 014347 3756 DCA I BOSPT2 /BACK INTO LOFTY STATE 5786 014350 2355 ISZ BOSPT1 5787 014351 2356 ISZ BOSPT2 5788 014352 5344 JMP .-6 5789 014353 6201 CDF 5790 014354 5730 JMP I PSWAP2 /YES-WE ARE FINISHED,SO RETURN 5791 014355 7600 BOSPT1, 7600 5792 014356 7774 BOSPT2, 7774 5793 5794 014357 4526 PAGE 014360 1313 014361 7605 014362 6213 014363 4207 014364 0020 014365 4030 014366 7607 014367 7600 014370 7604 014371 4330 014372 3715 014373 0003 014374 3710 014375 0004 014376 1000 014377 1400 5795 /PARSE A FILENAME OF THE FORM "DEVN:FILENM.EX" IN THE SAC 5796 /DSK: AND A NULL EXTENSION ARE THE DEFAULTS 5797 /THE END OF THE SAC IS USED AS A WORK AREA 5798 /IF SYNTAX IS CORRECT, THE NAME IS PACKED INTO 5799 /THE FILENAME FIELD OF THE CURRENT FILE 5800 /OTHERWISE A FATAL ERROR IS RETURNED 5801 /ENTERED WITH OS/8 SWAPPED IN 5802 5803 WKAREA= SAC+16 /DEFINE SCRATCH AREA 5804 5805 014400 0000 NAMEG, 0 5806 014401 1032 TAD SACLEN 5807 014402 1377 TAD (16 /COMPARE STRING LENGTH TO 16 5808 014403 7710 SPA CLA 5809 014404 4564 IF, JMS I PERROR /TOO MANY CHARS IN "DEV:FILENM.EX" 5810 014405 1032 TAD SACLEN 5811 014406 3064 DCA TEMP2 /STRING LENGTH COUNTER 5812 014407 1154 TAD PSACM1 5813 014410 3010 DCA SACXR 5814 014411 1376 TAD (DSK-1 /FIRST USE THE DEFAULT DEVICE 5815 014412 4300 JMS DEVFUD 5816 014413 1410 NCG, TAD I SACXR /GET CHAR FROM SAC 5817 014414 3040 DCA TEMP1 /SAVE 5818 014415 1040 TAD TEMP1 5819 014416 1375 TAD (-72 /IS IT A COLON? 5820 014417 7450 SNA 5821 014420 5255 JMP CAD /YES-CHARS SO FAR=DEVICE NAME 5822 014421 1374 TAD (14 /NO-IS IT A PERIOD? 5823 014422 7650 SNA CLA 5824 014423 5264 JMP SSAD /YES-NEXT TWO CHARS=EXTENSION 5825 014424 1040 TAD TEMP1 /NO-GET CHAR AGAIN 5826 014425 3412 DCA I XR2 /STORE IN WORK AREA 5827 014426 2043 ISZ TEMP4 /BUMP COUNT FOR CURRENT SECTION 5828 014427 2064 NCGS, ISZ TEMP2 /END OF STRING YET? 5829 014430 5213 JMP NCG /NO-NEXT CHAR 5830 014431 1043 TAD TEMP4 /YES-GET CHAR COUNT FOR THIS SECTION (NAME) 5831 014432 1373 TAD (-6 5832 014433 7740 SMA SZA CLA /IS IT >6? 5833 014434 5204 JMP IF /YES-TOO MANY CHARACTERS IN FILE NAME 5834 014435 1372 TAD (WKAREA-1 /NO-ADDRESS OF SCRATCH NAME BLOCK 5835 014436 3011 DCA XR1 5836 014437 7240 STA /-1 5837 014440 1075 TAD IOTDEV /ADDRESS OF FINAL NAME BLOCK-1 5838 014441 3012 DCA XR2 5839 014442 1373 TAD (-6 /MOVE 6 WORDS 5840 014443 3064 DCA TEMP2 5841 014444 1411 MML, TAD I XR1 5842 014445 7106 CLL RTL 5843 014446 7006 RTL 5844 014447 7006 RTL 5845 014450 1411 TAD I XR1 5846 014451 3412 DCA I XR2 /MOVE NAME WORD FROM SCRATCH AREA TO FINAL DEST 5847 014452 2064 ISZ TEMP2 /DONE? 5848 014453 5244 JMP MML /NO 5849 014454 5600 JMP I NAMEG /YES-RETURN 5850 5851 014455 1043 CAD, TAD TEMP4 /GET CHAR COUNT FOR THIS SECTION 5852 014456 1371 TAD (-4 /COMPARE AGAINST 4 5853 014457 7740 SMA SZA CLA /TOO MANY CHARS? 5854 014460 5204 JMP IF /YES-DEVICE NAME TOO LONG 5855 014461 1370 TAD (WKAREA-1+4 5856 014462 4300 JMS DEVFUD /CLEAR BUF AND GET NAME FROM FILE FIELD THIS TIME 5857 014463 5227 JMP NCGS 5858 5859 014464 1043 SSAD, TAD TEMP4 /COUNT FOR THIS SECTION (FILE NAME) 5860 014465 1373 TAD (-6 5861 014466 7740 SMA SZA CLA /TOO MANY? 5862 014467 5204 JMP IF /YES-FILE NAME TOO LONG 5863 014470 3043 DCA TEMP4 /NO-CLEAR COUNT 5864 014471 1322 TAD DSK 5865 014472 1064 TAD TEMP2 /COMPARE AGAINST # OF CHARS LEFT 5866 014473 7750 SPA SNA CLA 5867 014474 5204 JMP IF /TOO MANY CHARS IN EXTENSION 5868 014475 1367 TAD (WKAREA-1+12 5869 014476 3012 DCA XR2 5870 014477 5227 JMP NCGS 5871 5872 014500 0000 DEVFUD, 0 5873 014501 3011 DCA XR1 /POINT AT LOC OF DEV: 5874 014502 1372 TAD (WKAREA-1 5875 014503 3012 DCA XR2 /POINT AT START OF WORK AREA 5876 014504 1366 TAD (-10 5877 014505 3043 DCA TEMP4 5878 014506 1371 TAD (-4 5879 014507 3042 DCA TEMP3 5880 014510 1411 TAD I XR1 /GET A DEVICE NAME BYTE 5881 014511 3412 DCA I XR2 /STORE IN WORK AREA DEVICE FIELD 5882 014512 2042 ISZ TEMP3 5883 014513 5310 JMP .-3 /ITERATE 5884 014514 3412 DCA I XR2 /NOW CLEAR REST OF FILE NAME 5885 014515 2043 ISZ TEMP4 5886 014516 5314 JMP .-2 /ITERATE 5887 014517 1370 TAD (WKAREA-1+4 /POINT XR2 AT FILENAME FIELD 5888 014520 3012 DCA XR2 5889 014521 5700 JMP I DEVFUD /RETURN WITH TEMP4 CLEAR 5890 5891 014522 0004 DSK, 4;23;13;0 /6BIT DEFAULT DEVICE NAME "DSK" 014523 0023 014524 0013 014525 0000 5892 /SUBROUTINE TO RESTORE PAGE 27600 OF TD8/E DRIVER 5893 /AND READJUST THE CDFS IN FIELD 0 5894 5895 014526 0000 PSWP2P, 0 5896 014527 1031 TAD PSFLAG 5897 014530 7006 RTL 5898 014531 7620 SNL CLA /BIT 1 SET MEANS PHONEY TD8E 5899 014532 5335 JMP .+3 5900 014533 3031 DCA PSFLAG 5901 014534 5726 JMP I PSWP2P 5902 014535 3031 DCA PSFLAG /CLEAR RESIDENT STATUS FLAG 5903 014536 1365 TAD (CDF 20 5904 014537 3764 DCA I (P2CDF /PUT CDF 20 IN SWAP ROUTINE 5905 014540 1365 TAD (CDF 20 5906 014541 3763 DCA I (P2CDF1 5907 014542 4573 JMS I PPSWAP /MOVE DOWN PAGE 27600 5908 014543 1362 TAD (6223 5909 014544 3761 DCA I (7642 5910 014545 1360 TAD (6222 5911 014546 3757 DCA I (7721 5912 014547 1360 TAD (6222 /RESTORE CDFS IN PAGE 07600 5913 014550 3756 DCA I (7727 5914 014551 5726 JMP I PSWP2P /RETURN 5915 5916 014556 7727 PAGE 014557 7721 014560 6222 014561 7642 014562 6223 014563 1302 014564 1276 014565 6221 014566 7770 014567 0360 014570 0352 014571 7774 014572 0346 014573 7772 014574 0014 014575 7706 014576 4521 014577 0016 5917 5918 5919 5920 FIELD 0 5921 5922 5923 5924 5925 5926 5927 5928 5929 5930 5931 5932 5933 5934 5935 ///////////////////////////////////////////////////////////////////// 5936 ///////////////////////////////////////////////////////////////////// 5937 /////////////// END OF OVERLAY AREA ///////////////////////////////// 5938 ///////////////////////////////////////////////////////////////////// 5939 ///////////////////////////////////////////////////////////////////// 5940 5941 $ A 6347 unreferenced ABSVAL 2352 AC0 0040 AC0002 7326 AC1 0041 AC2 0042 AC2000 7332 AC3777 7350 unreferenced AC4000 7330 AC5777 7352 unreferenced AC7775 7346 unreferenced AC7776 7344 ACH 0045 ACL 0046 ACSR 6072 ACX 0044 ADCALC 0640 ADFC 0707 ADJDEC 5003 AJT 0714 AL1 6057 AL1K 3774 AL1P 6240 AL1PTR 5642 AMODE 0214 AN1 3775 AN2 3776 ANDLS2 3535 ANDLST 3402 ANDPTR 3401 AR1 5153 ARGET 6200 ARGETK 5503 ARGETL 5444 ARGETP 6127 ARGPLK 4271 ARGPLL 3510 ARGPOL 4220 ARGPRE 0311 ARGPRL 1416 ARITHA 1524 ARJMP 0711 ARRAYI 0600 ARSTRT 0022 ARTRAP 4365 ASC 3407 ATABDF 0610 ATABDL 1172 ATAN 4200 ATANA1 4427 ATANA2 4435 ATANA3 4443 ATANB0 4424 ATANB1 4432 ATANB2 4440 ATANB3 4446 B1 4234 B2 4227 B3 4222 BACKUP 6456 BAS 6637 BCGET 3026 BCNT 1030 BCPUT 0747 BEND 1136 BIPCCL 7777 BLINIT 3350 BLREAD 3332 BLZERO 2101 BMAP 0036 BO 4215 BOSPT1 4355 BOSPT2 4356 BOUTRS 1103 BSTRT 1107 BSTRTA 1027 BUFASS 4237 BUFCHK 2677 BUFIN 1025 BUFOUT 1026 BUMP 2637 BYTCDF 2651 BYTCNT 2673 BYTE 2676 BYTPTR 2674 BYTSET 2653 BYTSWT 2675 C1000 6646 C14 6644 C1400 6647 C16 6645 C1B 6507 C3B 6514 CAD 4455 CBLK 3544 CDF0 0761 unreferenced CDF10 6307 CDFINL 0546 CDFIO 0020 CDFPS 0025 CDFPSU 0206 CDIN 3620 CHAIN 3600 CHAR 0053 CHAR3P 2736 CHAR3U 3060 CHARNO 3143 CHECKL 3462 CHKB2 6613 CHKB3 6622 CHKB4 6631 CHNSTB 3707 CHR 3401 CHR2 2252 CHRSAV 0040 CI 3621 CICHAI 3673 CL 3643 CLEANP 3715 CLENG 3441 CLOSE 3406 CLOSED 3443 CNOBML 2116 CNOCLR 2074 COLCNT 2540 COLWID 0016 COMBNE 2755 COMLOP 2502 COMMA 2466 COMMAS 2537 COS 4053 CPLOOP 3217 CR 6521 CREAD 3537 CRETN 3517 CRFUNC 2512 CRLFR 2333 CRUBOT 6453 CSFN 2001 CSMOVE 4135 CVT10 5115 CVTGO 5126 CVTLP 5122 CVTNUM 5000 CX 3675 DA 2321 DATAXR 0016 DATE 3600 DATEWD 3667 DBAD 6115 unreferenced DBAD1 5541 DBAD1P 6175 DCAS1 1415 DCASUB 1410 DCTR 1203 DE 0563 DECEXP 0054 DECNV 5213 DECON 5214 DECON1 5334 DECONV 5207 unreferenced DELAY 1201 DEVFUD 4500 DEVNA1 4027 DEVNA2 4030 DFETCH 4103 DIG1 4126 DIG2 4127 DIG3 4130 DIG4 4131 DIG5 4132 DISIN 3633 DIVCHK 5032 DIVGO 5035 DLCDF 2322 DLCDFL 1175 DLOOP 1224 DLREAD 2314 DLSTOP 0027 DLSTRT 0030 DMAP 0035 DNA1 3616 DNA2 3617 DNUMBR 5304 DO 4055 DOADD 6023 DONA 6027 DONE 3765 DPB 2613 DRAP 4132 DRARG1 0556 DRARG2 0557 DRARG3 0560 DRCALL 0544 DRCHR 2255 DRGCH 2236 DRIVER 0564 DRIVRN 4200 DSK 4522 DSWIT 0052 DV 6355 DV1 5765 DV2 5755 DV24 5745 DV24P 5537 DVL1 5514 DVLOOP 5040 DVLP1 5711 DVOP1 6330 DVOP2 5542 DVOP2P 6333 DVOPS 6315 DVOPSP 5540 DVOVR 5777 EAE 0000 EBC 2720 EBLK 4267 EDBLK 7604 EDON 5260 EFATAL 4236 EM 3615 EMDONE 3600 EMESS 4111 EMLOOP 3545 EN 4305 ENTLOK 4273 ENTNO 0065 ENTRYN 4031 EOFSET 2256 EOVAL 3472 ERRETN 4051 ERROR 2541 ERRORR 4006 ESTRA 4135 ESTRNG 4113 ETAB 4140 ETABA 4136 ETLOP 4036 EXPA0 4421 EXPA1 4416 EXPB1 4413 EXPON 3476 EXPON1 4107 EXPONK 3630 EXTCHK 3552 EXTEMP 3564 FACCLR 0323 FACR 6031 FACRES 2357 FACSAV 3357 FAD1 6004 FADDLL 5311 FADDM 4357 FATCHK 4043 FB 4012 FBITGT 6541 FC 3442 FCNT 5275 FD 5534 FD1 5504 FD1P 5721 FDDON 5742 FDDONP 5536 FDIV1M 4361 FDIVM 4360 FDVPT 5310 FE 4112 FERRLP 4012 FETPAG 4111 FF 0037 FFADD 6000 FFD1 5726 FFDIV 5722 FFDIV1 5412 FFDP 5446 FFEXPL 3625 FFGET 6241 FFIN 5200 FFIN1 5232 FFIX 4500 FFLOAT 4530 FFLOGL 3626 FFMPY 5600 FFNEG 6135 FFNEGA 5410 FFNEGK 5501 FFNEGP 5303 FFNEGR 5773 FFNOR 6215 FFNORR 6236 FFOUT 4600 FFPUT 6256 FFSQ 6347 FFSUB 6117 FFSUB1 5400 FI 2312 FIDVP 3631 FIGO2 5241 FILE1 6714 FILE2 6731 FILE3 6746 FILE4 6763 FILEFA 1526 unreferenced FILSTR 3305 FILSTU 4323 FIXDNE 4525 FIXLP 4515 FJOCI 0452 FLEN 4304 FLN 3642 FLOATS 3413 FLOOK 3710 FM 1624 FMPYLL 5307 FMPYLV 3627 FMPYM 4356 FN 2006 FNAP 3440 FNEGI 2552 FNLP 6334 FNOM 4302 FNORP 6176 FO 1637 FOTYPE 2342 FPPTM1 1174 FPPTM2 1171 FPPTM3 1166 FPPTM4 1163 FPPTM5 1160 FPUTLL 0722 unreferenced FRACT 4060 FRANDM 2326 FREE70 4062 FREE72 4073 FROOT 3646 FSQRM 4364 FSTOP 3732 FSTOP1 0007 FSTOPI 0567 FSTOPN 0565 FSUB1M 4363 FSUBM 4362 FSWITC 2073 FTRPRT 4505 unreferenced FTYPE 6556 FUDSC 0400 FUJUMP 1516 FUNC1I 1464 FUNC2I 1463 FUNC3I 1535 FUNC4I 1457 FUNC5I 1462 GCHR 5321 GETCH 3116 GETE 5250 GON 3761 GOSUB 2031 GR 2055 GS 2033 GSP 2060 GSTCK 0521 GT1FLG 4263 GTFLG 4200 HCTR 1202 HEIGHT 1200 HICORE 1313 HOOKL 4005 IA 1456 IDIV 4732 IDIVLP 4734 IDLE 2307 IDVOUT 4743 IF 4404 IGETCH 5362 IGS 3677 ILOOP 0215 ILOOPF 0243 IN 4032 INPUT 5346 INRANG 5060 INSAV 0056 INSC 3413 INT 3400 INTERB 1151 INTPC 0304 INTPCK 1174 INTPCL 0516 INTPOS 3420 IO 6402 IOTBLK 0070 IOTBUF 0067 IOTDEV 0075 IOTFIL 0077 IOTHDR 0066 IOTHND 0072 IOTLEN 0074 IOTLOC 0073 IOTMAX 0075 IOTPOS 0076 IOTPTR 0071 IOTSIZ 0015 IOUT 5361 ISZAC2 6310 ISZFGT 6275 JEOFI 0467 JFAIL 0465 JFOR 2061 JFORL 0515 JMPFIL 1446 JMPI 0252 JMPI2 0746 JMPI3 1241 JMPI6 1604 JMPISA 0736 JMPISN 4012 JMSI 0251 JMSI4 1417 JMSI5 1432 JMSI7 1540 JMSSI 0310 JMSTAD 1530 JMSUSR 1557 JNEG 3466 JUSNEG 3464 K0037 0742 K0300 4060 K2000 6643 K260 4057 K277 6455 K334 6506 K4 6533 K5252 6454 K6000 3772 K7506 5345 K7554 0504 K7600 0505 unreferenced K7607K 3551 unreferenced KC240 1150 KFD1 5447 KK12 5312 KK7600 1306 KKM12 5775 KM13 5776 KM22 3777 KME 5305 KSFA 6416 L40 2147 L7600 0324 unreferenced L7607 1522 L7746 0370 LASTB 3321 LDB 2600 LEN 3411 LEV 5477 LFLUSH 6403 LINEHI 0057 LINEI 1137 LINELO 0060 LM 6360 LMAKE 4061 LN2 4470 LN2OV2 4410 LOG 4263 LOG2E 4405 LOGC1 4454 LOGC3 4457 LOGC5 4462 LOP01 3722 LOP02 3746 LOP1 6075 LOP2 6037 LS1I 1403 LS2I 1402 LSUB1I 1406 LSUB2I 1400 LTRPRT 4302 unreferenced M1R 3470 M215 0142 M240 5363 M50 1033 MAKED 4053 MASKL 3427 MBEND 1031 MCDF1 6642 MCR 6452 MCTRLC 1032 MCTRLU 6451 MD1 5452 MD1P 5443 MDATE 7666 MDONE 5627 MDSET 5450 MDSETK 5774 MDSETP 5445 MDV 5306 MEXIT 4253 MFATAL 4137 MINUS 5365 MM4 3535 MML 4444 MODESW 0055 MP12L 5701 MP12LP 2270 MP24 5643 MPLP 5653 MPLP1 5654 MPLP2 5666 MPY 2263 MPY10 5137 MSPACE 1252 unreferenced MULLIM 4152 MXOFF 1035 MXON 1034 N7644 1136 NAMEG 4400 NCG 4413 NCGS 4427 NCHK 4102 NCHKL 4262 NEWCDF 6301 NEXREC 3270 NFLAG 4107 NFLGST 4100 NGT 4257 NHIGH 3665 NHNDLE 4072 NHNDLL 4261 NLOW 3666 NOCC 1061 NOCTC 3752 NOCZ 3420 NODP 4723 NOP1 6111 unreferenced NOP2 6053 unreferenced NORMED 5016 NORML 5005 NORMLP 6225 NOSCOP 6474 NTTY 3130 NULLST 4322 NUM 4102 NUMBUF 2554 O0 6354 O10 0177 O100 0146 O17 0171 O20 3261 O200 0172 O210 3230 O215 0170 O240 3227 O4 5114 O40 3260 O400 0137 O7400 0175 O77 0145 O7700 0122 O7770 0212 OADD 6157 OATADI 1521 OE 1504 OKPOS 4611 ONE 3473 ONEHAF 4465 ONERET 4454 OPENAF 4001 OPENAV 4000 OPENNF 4004 OPENNV 4003 OPERI 1234 OPH 0050 OPL 0051 OPNEG 6146 OPNEGP 5502 OPSR 6034 OPX 0047 OVADD 1503 OVDNE 1507 OVERLA 3400 OVML 0357 OVRLAY 1523 P1CDF 1273 P1CDF1 1300 P200 5211 unreferenced P2CDF 1276 P2CDF1 1302 PA 4413 PACKCH 2725 PATCHF 5366 PBACK 6502 PCH 1204 PERROR 0164 PFACCL 0161 PFFGET 0157 PFFNOR 0124 PFFPUT 0126 unreferenced PFTYPE 0140 PFUDSC 0375 PGETCH 0143 PHCTR 0423 PHEIGH 0422 PHICOR 0426 PIDLE 0167 PILOOP 0170 PINFO 0371 PIOV2 4402 PLUS 5364 PNT 1760 POLYNL 4304 POLYSN 4026 POS 4400 POSITN 4456 POSSET 4423 POVTAB 0372 PPSWAP 0173 PPUTCH 0150 PREST 3705 PRTLP 4712 PS1L 0373 PS2L 0374 PSACM1 0154 PSCOPF 0425 PSCOPW 0424 PSFLAG 0031 PSSTRT 0026 PSTCHK 3477 PSWAP 1262 PSWAP2 4330 PSWP2P 4526 PUNSFI 0156 PUTCH 3242 PUTCHR 1010 unreferenced PUTD 4750 PUTN 3645 PWFECH 0200 PXPRIN 0176 PXPUTC 0127 QUAD2 4017 QUAD3 4022 QUAD4 4024 RDLIST 6547 RE 3010 READFL 3000 READI 3077 RECP2 1105 REGFMT 4672 RELCOM 3513 RESDLS 1666 RESTOR 1650 RET0 3565 RETRN1 3610 RETRNI 2043 RIMAGE 3103 RND 4540 RONLY 3303 RSEED 2332 RTN2 5373 RTZRO 5620 unreferenced RWONC 3300 S1 0033 S2 0034 SAC 0331 SACLEN 0032 SACLIM 0120 SACXR 0010 SAD 0735 SAFIND 1752 SARRAY 0724 SASTRT 0024 SC 2231 SCALDF 0321 SCALDL 1176 SCASE 0246 SCLDB 2235 SCOMLP 2125 SCOMP 2123 SCON1 2210 SCONTU 4446 SCOPFG 6540 SCOPWD 7726 SCSTRT 0021 SDIS 0300 SEG 4250 SEGCOM 2221 SEP1 0263 SETF 2067 SFN 2000 SGN 3632 SHLFT 5635 SHRINK 4676 SIGNF 5300 SIN 4000 SINA1 4366 SINA3 4371 SINA5 4374 SINA7 4377 SL 2410 SLOAD 2204 SLOOP 3713 SLOVER 2527 SMLFMT 4664 SMODE 0273 SNEQ 2160 SPFUNC 1600 SPIN 6534 SPINNR 0017 SQRP5 4451 SR 3120 SRCLP 4437 SREAD 2416 SRLIST 2200 SSAD 4464 SSMODE 0213 SSTEX 2666 SSTORE 2400 ST 2435 START1 0331 START3 1151 START4 6600 STARTB 4303 STB 3641 STCOM 1703 STDF 1704 STDFL 1173 STFILK 0743 STFIND 1671 STFINL 0307 STOPI 4052 STR 3422 STRCDF 1742 STRCNT 0062 STRLUP 3433 STRMAX 0061 STRNGA 1525 unreferenced STRPTR 0063 STSTRT 0023 SU 0623 SUB0 6125 SUB0P 5411 SUBVAF 0001 SUBVER 0001 SUBVFF 0001 SUBVSF 0001 SUCJMP 0474 SW 3251 SWRITE 2441 SWRLP 2456 T 4250 TAB 2521 TADTAB 1531 TCHAR 3133 TCHR 3731 TDONE 3716 TEMP1 0040 TEMP10 0054 TEMP2 0064 TEMP3 0042 TEMP4 0043 TEMP5 0047 TEMP6 0050 TEMP7 0051 TEN 5316 TM 0043 TMPY 6353 TOUT 3265 TOVPI 4147 TP 5313 TP1 5314 TPH 4134 TPREL 3522 TPRINT 3670 TRACE 4000 TRHOOK 1143 TRREST 4004 TTYBUF 6600 TTYDRI 6400 TTYEND 6660 unreferenced TTYF 6677 TTYIN 6411 U123C 3046 UNPACK 3040 UNSFIX 1615 UNSLP 1642 UNSOUT 1646 USE 0573 USECON 0006 USELOG 3613 USR 0172 USRA 1527 unreferenced VAL 3447 VALCNT 3475 VALGET 3457 VCHECK 1122 VEREND 1121 unreferenced VERLOC 1115 unreferenced VERSON 0005 VR 3003 W0PTR 3531 WDONE 3240 WE 3024 WIDTH 0120 WIMAGE 3226 WKAREA 0347 WRBLK 3337 WRITEI 3200 WRITFL 3015 XABSVL 2350 XERRRE 2551 XFLAG 1036 XPRINT 1037 XPUT1 1002 XPUTCH 1000 XR1 0011 XR2 0012 XR3 0013 XR4 0014 XR5 0015 YARG 4325 YEAREX 3602 ZCNT 3773 ZERXIT 4730 ZEXP 6341 ZRORET 4452