| 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 | \f/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<BRTS.PA/W |
| 75 | / .R ABSLDR |
| 76 | / *BRTS$ (THEN SAVE AS SHOWN BELOW) |
| 77 | / |
| 78 | |
| 79 | /WHEN ASSEMBLED AND LOADED VIA THE ABS. LOADER,THE |
| 80 | /CORE LAYOUT IS AS FOLLOWS: |
| 81 | / |
| 82 | /BRTS IS AT 0-6777 |
| 83 | /OVERLAY BASIC.AF IS AT 3400-4577 |
| 84 | /OVERLAY BASIC.SF IA AT 12000-13177 |
| 85 | /OVERLAY BASIC.FF IS AT 13400-14577 |
| 86 | / |
| 87 | /TO CREATE SAVE IMAGE FILES PRIOR TO RUNNING BASIC, |
| 88 | /ASSEMBLE THIS SOURCE IN A 12K OR MORE MACHINE,THEN |
| 89 | /PERFORM THE FOLLOWING SEQUENCE OF OS/8 COMMANDS |
| 90 | / |
| 91 | /.R ABSLDR |
| 92 | /*BRTS$ |
| 93 | /.SAVE SYS:BRTS 0-6777 |
| 94 | / |
| 95 | /.SAVE SYS:BASIC.AF 3400-4577 |
| 96 | / |
| 97 | /.SAVE SYS:BASIC.SF 12000-13177 |
| 98 | / |
| 99 | /.SAVE SYS:BASIC.FF 13400-14577 |
| 100 | / |
| 101 | /THE BASIC RUN-TIME SYSTEM IS CONDITIONALIZED TO TAKE ADVANTAGE |
| 102 | /OF THE PDP-8/E KE8/E EAE OPTION. |
| 103 | /NORMALLY,THE SYSTEM IS ASSEMBLED SUCH THAT IT WILL RUN ON ANY |
| 104 | /PDP-8 OR PDP-12. TO TAKE ADVANTAGE OF THE ADDITIONAL HARDWARE,SET |
| 105 | /THE SWITCH EAE=1 IF THE SYSTEM INCLUDES A KE8/E EAE. |
| 106 | /YOU MAY DO THIS BY CONCATENATING TTY: ONTO BRTS.PA AS FOLLOWS |
| 107 | /.PAL EABRTS<TTY:,SYS:BRTS.PA/W |
| 108 | /EAE=1 |
| 109 | /^Z |
| 110 | /^Z |
| 111 | /. BINARY IS CREATED... |
| 112 | /NOW EABRTS IS LOADED INSTEAD OF BRTS |
| 113 | /TO GET A LISTING, USE THE /J SWITCH TO INHIBIT THE FPP CODE YOU |
| 114 | /ARE NOT USING (EAE ON A NON EAE ASSEMBLY FOR EXAMPLE) |
| 115 | |
| 116 | /EAE=0 /USE STANDARD FLOATING POINT PACKAGE |
| 117 | /EAE=1 /USE EAE FLOATING POINT PACKAGE |
| 118 | / |
| 119 | /V4 FIXES |
| 120 | /.EAE ADD FOR NUMS <.00001 TO 0 |
| 121 | /.FILE INPUT FROM TTY |
| 122 | /.OUTPUT OF NUMS > 80,000 |
| 123 | /.STRING FETCH WHEN COUNT IS IN ONE FLD & |
| 124 | / TEXT IS IN THE NEXT |
| 125 | \f 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 <EAE=0> |
| 134 | |
| 135 | /PAGE 0 LOCATIONS |
| 136 | |
| 137 | *6 |
| 138 | USECON, 0 /USE CONSTANT GENERATED BY "USE" STATEMENT |
| 139 | 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 | SACXR, 15 /INDEX REGISTER FOR STRING ROUTINES |
| 145 | XR1, VCHECK |
| 146 | XR2, 0 |
| 147 | XR3, 0 |
| 148 | XR4, 4 /INDEX REGISTERS |
| 149 | XR5, 0 |
| 150 | DATAXR, 0 /POINTER FOR IN-CORE DATA LIST |
| 151 | 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 | CDFIO, 6211 /* CDF FOR I/O TABLE AND SYMBOL TABLES |
| 160 | SCSTRT, 0 /* POINTER TO START OF SCALAR SYMBOL TABLE |
| 161 | ARSTRT, 0 /* POINTER TO START OF ARRAY SYMBOL TABLE-1 |
| 162 | STSTRT, 0 /* POINTER TO START OF STRING SYMBOL TABLE-1 |
| 163 | SASTRT, 0 /* POINTER TO START OF STRING ARRAY TABLE-1 |
| 164 | CDFPS, 0 /* CDF FOR START OF PSEUDO-CODE |
| 165 | PSSTRT, 0 /* POINTER TO START OF PSEUDO CODE-1 |
| 166 | DLSTOP, 0 /* POINTER TO TOP OF DATA LIST |
| 167 | DLSTRT, 0 /* POINTER TO BOTTOM OF INCORE DATA LIST-1 |
| 168 | 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 | \f/SYSTEM REGISTERS |
| 175 | |
| 176 | SACLEN, 0 /LENGTH OF STRING IN SAC |
| 177 | S1, 0 /SUBSCRIPT 1 (MUST BE FOLLOWED BY S2!) |
| 178 | S2, 0 /SUBSCRIPT 2 (MUST BE PRECEEDED BY S1!) |
| 179 | DMAP, 0 /MAP OF DRIVER PAGES |
| 180 | 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 | FF, 0 /SPECIAL MODE FLIP-FLOP |
| 190 | TEMP1, |
| 191 | AC0, 0 |
| 192 | AC1, 0 |
| 193 | TEMP3, |
| 194 | AC2, 0 |
| 195 | TM, |
| 196 | TEMP4, 6201 |
| 197 | ACX, 0 /FAC-EXPONENT |
| 198 | ACH, 0 /FAC-HIGH ORDER MANTISSA |
| 199 | ACL, 0 /FAC-MANTISSA LOW |
| 200 | TEMP5, |
| 201 | OPX, 0 |
| 202 | TEMP6, |
| 203 | OPH, 0 |
| 204 | TEMP7, |
| 205 | OPL, 0 |
| 206 | DSWIT, 0 /SWITCH USED BY INPUT ROUTINE |
| 207 | CHAR, 215 /TERMINATOR OF LAST INPUT |
| 208 | TEMP10, 0 /LOC NEEDED BY FPP |
| 209 | |
| 210 | DECEXP= TEMP10 |
| 211 | |
| 212 | /SYSTEM REGISTERS USED OFTEN BY INTERPRETER CODE |
| 213 | |
| 214 | MODESW, 0 /0 FOR ARTHIMETIC MODE,1 FOR STRING MODE |
| 215 | INSAV, 0 /CURRENT PSEUDO-INSTRUCTION BEING EXECUTED |
| 216 | LINEHI, 0 /HI ORDER BITS OF LINE # CURRENTLY BEING EXECUTED |
| 217 | LINELO, 0 /LOW ORDER BITS OF CURRENT LINE NUMBER |
| 218 | STRMAX, 0 /MAXIMUM # OF CHARS ALLOWED IN CURRENT STRING |
| 219 | STRCNT, 0 /- # OF CHARACTERS IN CURRENT STRING |
| 220 | STRPTR, 0 /POINTER TO SIZE WORD OF CURRENT OPERAND STRING |
| 221 | TEMP2, 0 |
| 222 | |
| 223 | \f/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 | ENTNO, 0 /ENTRY NUMBER NOW IN AREA |
| 244 | IOTHDR, TTYF /HEADER WORD |
| 245 | IOTBUF, TTYF+1 /BUFFER ADDRESS |
| 246 | IOTBLK, TTYF+2 /CURRENT BLOCK IN BUFFER |
| 247 | IOTPTR, TTYF+3 /READ\WRITE POINTER |
| 248 | IOTHND, TTYF+4 /HANDLER ENTRY POINT |
| 249 | IOTLOC, TTYF+5 /FILE STARTING BLOCK # |
| 250 | IOTLEN, TTYF+6 /ACTUAL FILE LENGTH |
| 251 | IOTMAX, TTYF+7 / DEVICE / (FILE MAXIMUM LENGTH) |
| 252 | IOTPOS, TTYF+10 / NAME / (POSITION OF PRINT HEAD) |
| 253 | IOTFIL, TTYF+11 / |
| 254 | / TTYF+12 / FILE |
| 255 | / TTYF+13 / NAME |
| 256 | / TTYF+14 / .EX |
| 257 | |
| 258 | IOTDEV= IOTMAX |
| 259 | \f *200 |
| 260 | |
| 261 | /FETCH NEXT PSEUDO WORD |
| 262 | |
| 263 | PWFECH, JMP START1 /START ONCE ONLY CODE IN TTY BUFFER |
| 264 | ISZ INTPC /BUMP PSEUDO-CODE PROGRAM COUNTER |
| 265 | JMP CDFPSU /NO-SKIP;JUST GET NEXT PSEUDO-CODE WORD |
| 266 | TAD CDFPSU /SKIP MEANS WE HAVE TO INCREMENT PS-CODE FIELD |
| 267 | TAD [10 |
| 268 | DCA CDFPSU |
| 269 | CDFPSU, VCHECK /SET DF TO FIELD OF PSEUDO-CODE |
| 270 | TAD I INTPC /GET NEXT WORD OF CODE |
| 271 | CDF 0 /SET DATA FIELD BACK TO INTERPRETER FIELD |
| 272 | JMP I PWFECH /RETURN |
| 273 | O7770, 7770 |
| 274 | |
| 275 | SSMODE, IAC /SET INTERPRETER TO STRING MODE |
| 276 | AMODE, DCA MODESW /SET INTERPRETER TO ARITH MODE |
| 277 | /FALL BACK INTO I-LOOP |
| 278 | |
| 279 | /BRTS I-LOOP |
| 280 | |
| 281 | ILOOP, CLA CLL /FLUSH |
| 282 | DCA FF /PUT FPP IN SI MODE |
| 283 | JMS PWFECH /GET NEXT PSEUDO-INSTRUCTION |
| 284 | DCA INSAV /SAVE FOR LATER |
| 285 | JMS I [XPRINT /CALL TO TTY DRIVER |
| 286 | NOP |
| 287 | TAD INSAV |
| 288 | AND [7400 /STRIP TO OPCODE BITS |
| 289 | CLL RTL |
| 290 | RTL |
| 291 | RAL /OPCODE NOW IN BITS 8-11 |
| 292 | TAD O7770 /SUBTRACT 10 |
| 293 | SMA /IS OPCODE <10? |
| 294 | JMP SCASE /CALL TO INSTRUCTION COMMON TO SMODE AND AMODE |
| 295 | DCA TEMP1 /YES-SAVE THE OFFSET |
| 296 | TAD MODESW /WHICH MODE? |
| 297 | SZA CLA |
| 298 | JMP SMODE /STRING MODE |
| 299 | TAD TEMP1 /ARITHMETIC MODE-GET OFFSET |
| 300 | TAD JMSI /MAKE JMS TO FP PACKAGE ROUTINE |
| 301 | DCA .+2 /PUT IN LINE |
| 302 | JMS ARGPRE /SET UP ARGUMENT FROM SYMBOL TABLE |
| 303 | ILOOPF, . /JMS TO THE FLOATING POINT PACKAGE ROUTINE |
| 304 | NOP /FPP SOMETIMES RETURNS TO CALL+2 |
| 305 | JMP ILOOP /DONE |
| 306 | |
| 307 | SCASE, TAD JMPI /JUST DISPATCH TO ROUTINE CALLED FOR |
| 308 | DCA .+1 |
| 309 | . /JUMP TO APPROPRIATE ROUTINE |
| 310 | |
| 311 | JMSI, JMS I SEP1 /JMS USED FOR CALLS TO FPP BY AMODE INST |
| 312 | JMPI, JMP I SEP1 /JMP USED TO CALL ROUTINES COMMON TO AMODE AND SMODE |
| 313 | \f /JUMP TABLE FOR AMODE INSTRUCTIONS |
| 314 | |
| 315 | FFADD /FAC_C(A)+FAC OPCODE 0 |
| 316 | FFSUB /FAC_FAC-C(A) OPCODE 1 |
| 317 | FFMPY /FAC_FAC*C(A) OPCODE 2 |
| 318 | FFDIV /FAC_FAC/C(A) OPCODE 3 |
| 319 | FFGET /FAC_C(A) OPCODE 4 |
| 320 | FFPUT /C(A)_FAC OPCODE 5 |
| 321 | FFSUB1 /FAC_C(A)-FAC OPCODE 6 |
| 322 | FFDIV1 /FAC_C(A)/FAC OPCODE 7 |
| 323 | /ALL INSTRUCTIONS BEYOND THIS POINT ARE COMMON TO AMODE AND SMODE |
| 324 | SEP1, LS1I /S1_C(A) OPCODE 10 |
| 325 | LS2I /S2_C(A) OPCODE 11 |
| 326 | FJOCI /IF TRUE,PC_C(PC,PC+1) OPCODE 12 |
| 327 | JEOFI /IF EOF,PC_C(PC,PC+1) OPCODE 13 |
| 328 | LINEI /LINE NUMBER OPCODE 14 |
| 329 | ARRAYI /ARRAY INST OPCODE 15 |
| 330 | ILOOP /NOP OPCODE 16 |
| 331 | OPERI /OPERATE INST OPCODE 17 |
| 332 | |
| 333 | |
| 334 | SMODE, TAD TEMP1 /INST OFFSET |
| 335 | TAD JMSSI /BUILD JMP OFF STRING TABLE |
| 336 | DCA SDIS /PUT IN LINE |
| 337 | CLL /STRING SCALAR TABLE |
| 338 | JMS I STFINL /SET UP ARGUMENT ADDRESS |
| 339 | 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 | SCON1 /SAC_SAC&C(A$) |
| 347 | SCOMP /IF SAC .NE. C(A$),PC_PC+2 |
| 348 | SREAD /C(A$)_DEVICE |
| 349 | INTPC, . /* INTERPRETER PC |
| 350 | SLOAD /SAC_C(A$) |
| 351 | SSTORE /C(A$)_SAC |
| 352 | STFINL, STFIND /* LINK TO STRING FINDING ROUTINE |
| 353 | JMSSI, JMP I .+1 /* DISPATCH JUMP FOR SMODE INSTRUCTIONS |
| 354 | \f/ARGPRE-ROUTINE TO TRANSLATE OPERAND FIELD INTO 12 BIT POINTER |
| 355 | /INTO SCALAR TABLE FOR USE IN FPP CALLS. |
| 356 | |
| 357 | ARGPRE, 0 |
| 358 | TAD INSAV /GET INSTRUCTION |
| 359 | AND [377 /STRIP TO OPERAND FIELD |
| 360 | DCA TEMP1 /SAVE |
| 361 | TAD TEMP1 |
| 362 | CLL RAL /*2 |
| 363 | TAD TEMP1 /PTR*3 |
| 364 | TAD SCSTRT /MAKE 12 BIT ADDR |
| 365 | SCALDF, 1000 /DF TO SCALAR FIELD (CDF INITIALIZED BY LOADER) |
| 366 | JMP I ARGPRE /RETURN |
| 367 | |
| 368 | /ROUTINE TO ZERO FAC |
| 369 | |
| 370 | FACCLR, -4 |
| 371 | L7600, 7600 /CLA |
| 372 | DCA ACX /ZERO EXPONENT |
| 373 | DCA ACL /ZERO LOW MANTISSA |
| 374 | DCA ACH /ZERO HIGH MANTISSA |
| 375 | JMP I FACCLR |
| 376 | |
| 377 | /STRING ACCUMULATOR USED BY STRING OPCODES AND FUNCTIONS |
| 378 | /CONTAINS ONE 6BIT CHAR PER WORD |
| 379 | |
| 380 | START1, |
| 381 | SAC, OSR |
| 382 | SZA CLA |
| 383 | NOP /A HLT PLACED HERE WILL ALLOW YOU TO STOP |
| 384 | /MACHINE BEFORE RUNTIME SYSTEM STARTS BY |
| 385 | /SETTING SWITCH REGISTER |
| 386 | TLS /SET TTY FLAG |
| 387 | ISZ SPINNR /SPIN RANDOM NUMBER SEED |
| 388 | NOP /WHILE WAITING FOR INITIALIZING TLS |
| 389 | TSF /FLAG UP YET? |
| 390 | JMP .-3 /NO |
| 391 | TAD CDFIO |
| 392 | DCA I PS1L /SET UP CDFS IN PSWAP |
| 393 | TAD CDFIO |
| 394 | DCA I PS2L |
| 395 | JMS I PFUDSC /SWAP 17600 IN IF NOT ALREADY IN AND SAVE SCOPE FLAG |
| 396 | JMS I CDFPSU |
| 397 | TAD SCALDF /SET PROG NOT RESTARTABLE BIT |
| 398 | DCA I L7746 /TELL USR TO SAVE 1000-1777 |
| 399 | TAD PINFO /POINTER TO INFO TABLE IN 17600 |
| 400 | DCA XR1 |
| 401 | TAD POVTAB /POINTER TO BLOCK TABLE IN OVERLAY DRIVER |
| 402 | DCA XR2 |
| 403 | TAD FACCLR /WE HAVE TO GET 4 BLOCK NUMBERS |
| 404 | DCA TEMP1 |
| 405 | OVML, CDF 10 |
| 406 | TAD I XR1 /GET BLOCK NUMBER FOR THIS OVERLAY FROM INFO AREA |
| 407 | CDF |
| 408 | DCA I XR2 /PUT IN TABLE IN OVERLAY DRIVER |
| 409 | ISZ TEMP1 /DONE? |
| 410 | JMP OVML /NO |
| 411 | JMS I [PSWAP /SWAP 17600 BACK TO HIGH CORE NOW |
| 412 | JMP I .+1 |
| 413 | START3 /CONTINUE THE INITIALIZING CODE IN INTERMEDIATE BUFFER |
| 414 | L7746, 7746 |
| 415 | PINFO, 7607 |
| 416 | POVTAB, ARITHA-1 |
| 417 | PS1L, P1CDF |
| 418 | PS2L, P1CDF1 |
| 419 | PFUDSC, FUDSC |
| 420 | |
| 421 | PAGE |
| 422 | |
| 423 | FUDSC, 0 |
| 424 | TAD PSFLAG /TEST WHERE 17600 IS LOCATED |
| 425 | SMA CLA |
| 426 | TAD [200 /IF NOT TD8E USE 7600 |
| 427 | TAD [7400 /IF TD8E USE 7400 |
| 428 | DCA I PHICORE /STORE FOR SWAPPER |
| 429 | CLA IAC |
| 430 | AND PSFLAG |
| 431 | SNA CLA /SKP IF PAGE 17600 IS ALREADY IN |
| 432 | JMS I [PSWAP /ELSE BRING IT IN |
| 433 | CDF 10 |
| 434 | TAD I PSCOPW |
| 435 | CDF |
| 436 | AND [200 /GET SCOPE BIT FROM RES MONITOR |
| 437 | DCA I PSCOPF |
| 438 | TAD I PHEIGHT |
| 439 | DCA I PHCTR /NOW INITIALIZE THE SCREEN HEIGHT COUNTER |
| 440 | JMP I FUDSC /RETURN |
| 441 | PHEIGHT,HEIGHT |
| 442 | PHCTR, HCTR |
| 443 | PSCOPW, SCOPWD |
| 444 | PSCOPF, SCOPFG |
| 445 | PHICOR, HICORE |
| 446 | \f *SAC+SACLIM+1 /ORIGIN PAST SAC+ONE GUARD CHAR |
| 447 | |
| 448 | /JUMP ON CONDITION |
| 449 | |
| 450 | FJOCI, TAD INSAV /GET JUMP INSTRUCTION |
| 451 | AND [17 /MASK OFF JUMP CONDITION |
| 452 | SNA /IS IT GOSUB? |
| 453 | JMP I (GOSUB /YES-PUSH PC ON STACK THEN JUMP |
| 454 | TAD FSTOPI /BASE TAD FOR BUILD OF TAD INSTRUCTION |
| 455 | DCA .+1 /PUT IN LINE |
| 456 | . /GET PROPER SKIP |
| 457 | DCA .+2 /PUT IN LINE |
| 458 | TAD ACH /GET HIGH ORDER FAC |
| 459 | . /SKIP INSTRUCTION |
| 460 | JMP SUCJMP /CONDITION TRUE-JUMP |
| 461 | JFAIL, JMS I [PWFECH /CONDITION FALSE-DON'T JUMP,BUT BUMP PC |
| 462 | JMP I [ILOOP /DONE |
| 463 | |
| 464 | /JUMP ON END OF FILE |
| 465 | |
| 466 | JEOFI, JMS I [IDLE /SEE IF FILE OPEN |
| 467 | TAD I IOTHDR /1ST WORD OF I/O TABLE ENTRY |
| 468 | CLL RTR /GET EOF BIT IN LINK |
| 469 | SNL CLA /EOF? |
| 470 | JMP JFAIL /NO-DON'T JUMP |
| 471 | /YES, FALL INTO JUMP ROUTINE |
| 472 | |
| 473 | SUCJMP, JMS I [PWFECH /GET WORD FOLLOWING JUMP INS. |
| 474 | DCA I INTPCL /STORE AS NEW PC |
| 475 | TAD INSAV /GET JUMP INSTRUCTION |
| 476 | AND [340 /MASK OFF DESTINATION FIELD |
| 477 | CLL RTR /SLIDE OVER |
| 478 | TAD CDFINL /MAKE A CDF INSTRUCTION |
| 479 | DCA I [CDFPSU /AND SET NEW PC INSTRUCTION FIELD |
| 480 | JMP I [ILOOP /NEXT INSTUCTION |
| 481 | |
| 482 | K7554, 7554 /MUST PRECEDE SKIP TABLE |
| 483 | |
| 484 | /SKIP TABLE USED TO HOLD TESTS FOR VARIOUS CONDITIONS |
| 485 | |
| 486 | K7600, 7600 /UNCONDITIONAL (CLA) |
| 487 | SMA CLA /JPA |
| 488 | SZA CLA /JNA |
| 489 | SMA SZA CLA /JPA JNA |
| 490 | SPA CLA /JMA |
| 491 | SNA CLA /JZA |
| 492 | SPA SNA CLA /JMA JZA |
| 493 | JMP I JFORL /FORLOOP JUMP ROUTINE |
| 494 | |
| 495 | JFORL, JFOR |
| 496 | INTPCL, INTPC |
| 497 | 0000;0 /MARK BEGINNING OF GOSUB STACK |
| 498 | GSTCK, 6000;0 |
| 499 | 6000;0 |
| 500 | 6000;0 |
| 501 | 6000;0 |
| 502 | 6000;0 |
| 503 | 6000;0 |
| 504 | 6000;0 |
| 505 | 6000;0 |
| 506 | 6000;0 |
| 507 | 0 /MARK THE END OF THE GOSUB STACK |
| 508 | \f/CALL TO DEVICE DRIVER FOR FILE I/O. ASSUMES ARGS HAVE BEEN SET UP |
| 509 | |
| 510 | DRCALL, 0 |
| 511 | DCA DRARG1 /FUNCTION WORD INTO DRIVER CALL |
| 512 | CDFINL, CDF /DF TO CURRENT FIELD |
| 513 | TAD I IOTBUF /GET BUFFER ADDRE FROM I/O TABLE ENTRY |
| 514 | DCA DRARG2 /PUT IN DRIVER CALL |
| 515 | TAD I IOTBLK /GET BLOCK NUMBER FROM I/O TABLE |
| 516 | DCA DRARG3 /PUT IN DRIVER CALL |
| 517 | TAD I IOTHND /GET DRIVER ENTRY |
| 518 | DCA DRIVER /SAVE |
| 519 | JMS I DRIVER /CALL DRIVER |
| 520 | DRARG1, 0 /FUNCTION CONTROL WORD |
| 521 | DRARG2, 0 /BUFFER ADDRESS |
| 522 | DRARG3, 0 /BLOCK # |
| 523 | SMA CLA /DEVICE ERROR-IS IT FATAL? |
| 524 | JMP I DRCALL /ALLS WELL |
| 525 | DE, JMS I [ERROR /FATAL |
| 526 | DRIVER, 0 |
| 527 | |
| 528 | /CALL TO INTERPRETER EXITING ROUTINE |
| 529 | |
| 530 | FSTOPN, JMS I [XPRINT /ON NORMAL EXITS,WE MUST EMPTY RING BUFFER |
| 531 | JMP .-1 /FIRST |
| 532 | FSTOPI, TAD K7554 |
| 533 | DCA INSAV /FAKE A CALL TO BASIC.FF FUNCTION 6 |
| 534 | JMP I .+1 /CALL OVERLAY |
| 535 | 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 | USE, JMS I [PWFECH /GET NEXT WORD FROM PSEUDO-CODE STREAM |
| 541 | DCA USECON /STORE IN PAGE 0 SLOT |
| 542 | JMP I [ILOOP /RETURN |
| 543 | |
| 544 | PAGE |
| 545 | \f/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 | ARRAYI, TAD MODESW /WHICH MODE? |
| 550 | SZA CLA |
| 551 | JMP SARRAY /SMODE |
| 552 | TAD INSAV /GET ARRAY INSTRUCTION |
| 553 | AND K0037 /MASK OFF ARRAY OPERAND |
| 554 | CLL RTL /MULTIPLY BY 4 (ENTRY LENGTH) |
| 555 | TAD ARSTRT /MAKE POINTER INTO ARRAY TABLE |
| 556 | DCA XR1 /POINTS TO ARRAY FOR THIS OPERATION |
| 557 | ATABDF, . /CHANGE DF TO ARRAY TABLE FIELD (SET BY START) |
| 558 | TAD I XR1 /GET POINTER TO FIRST ARRAY ELEMENT |
| 559 | DCA TEMP2 /SAVE FOR LATER |
| 560 | TAD I XR1 /GET DF FOR VARIABLE |
| 561 | DCA ADFC /PUT IN LINE AT END OF ROUTINE |
| 562 | TAD I XR1 /GET ARRAY DIMENSION 1 |
| 563 | DCA TEMP3 /SAVE |
| 564 | TAD S1 /GET SUBSCRIPT 1 |
| 565 | CLL CMA /SET UP 12 BIT COMPARE |
| 566 | TAD TEMP3 /DIMENSION 1 +1 |
| 567 | SNL CLA /S1 TOO BIG? |
| 568 | SU, JMS I [ERROR /YES-SUBSCRIPT OUT OF BOUNDS ERROR |
| 569 | DCA TEMP6 /CLEAR TEMPORARY |
| 570 | TAD I XR1 /GET DIMENSION 2 |
| 571 | SNA /IS SECOND DIMENSION 0?(ARRAY UNIDIMENSIONAL) |
| 572 | JMP ADCALC /YES-DON'T CHECK S2 FOR OUT OF BOUNDS |
| 573 | DCA ARJMP /SAVE DIM2+1 |
| 574 | TAD S2 /GET SUBSCRIPT 2 |
| 575 | CLL CMA /SAVE 12 BIT COMPARE |
| 576 | TAD ARJMP |
| 577 | SNL CLA /S2 BIGGER THAN DIM2? |
| 578 | JMP SU /YES |
| 579 | TAD S2 /MULTIPLY DIM1+1 BY S2 |
| 580 | JMS I [MPY /12 BY 12 MULTIPLY ROUTINE |
| 581 | ADCALC, CLL |
| 582 | TAD S1 /LORD OF S1+(DIM1+1)*S2 |
| 583 | DCA TEMP5 /SAVE |
| 584 | RAL /CARRY TO BIT 11 |
| 585 | TAD TEMP6 /HORD OF S1+(DIM1+1)*S2 |
| 586 | DCA TEMP6 /SAVE |
| 587 | TAD TEMP5 /LORD OF S1+(DIM1+1)*S2 |
| 588 | CLL RAL /*2 |
| 589 | DCA TEMP7 /LORD OF [S1+(DIM1+1)*S2]*2 |
| 590 | TAD TEMP6 /HORD OF S1+(DIM1+1)*S2 |
| 591 | RAL /*2 |
| 592 | DCA TEMP3 /HORD OF [S1+(DIM1+1)*S2]*2 |
| 593 | CLL |
| 594 | TAD TEMP5 /LORD OF S1+(DIM1+1) |
| 595 | TAD TEMP7 /LORD OF [S1+(DIM1+1)*S2] |
| 596 | DCA TEMP7 /LORD OF 3*[S1+(DIM1+1)*S2] |
| 597 | RAL /CARRY TO BIT 11 |
| 598 | TAD TEMP6 /HORD OF [S1+(DIM1+1)*S2)*2 |
| 599 | TAD TEMP3 /HORD OF S1+(DIM1+1)*S2 |
| 600 | DCA TEMP6 /HORD OF 3*[S1+(DIM1+1)*S2] |
| 601 | CLL |
| 602 | TAD TEMP7 /INDEX TO ELEMENT |
| 603 | TAD TEMP2 /AC POINTS TO CORRECT ARRAY ELEMENT |
| 604 | DCA XR1 /SAVE POINTER |
| 605 | RAL /CARRY TO BIT 11 |
| 606 | TAD TEMP6 /COMBINE TO MAKE TOTAL # OF FIELD OVERLAPS |
| 607 | CLL RTL |
| 608 | RAL /SLIDE OVERLAPS TO FIELD BITS (6-8) |
| 609 | TAD ADFC /ADD ANY CHANGE IN DATA FIELD TO CDF |
| 610 | DCA ADFC /PUT ABSOLUTE CDF IN LINE |
| 611 | TAD INSAV /GET ARRAY INSTRUCTION AGAIN |
| 612 | AND [340 /MASK OFF ARRAY OPCODE |
| 613 | CLL RTR |
| 614 | RTR |
| 615 | RAR /SLIDE TO BITS 9-11 |
| 616 | TAD JMPI2 /AND USE AS INDEX INTO JUMP TABLE |
| 617 | DCA ARJMP /PUT JUMP IN LINE OF CODE |
| 618 | IAC |
| 619 | DCA FF /PUT FPP IN "SPECIAL MODE" |
| 620 | ADFC, . /CHANGE DF TO DF OF ARRAY ELEMNT |
| 621 | TAD XR1 /AC POINTS TO ARRAY ELEMENT |
| 622 | ARJMP, . /PERFORM THE REQUIRED OPERATION |
| 623 | NOP /FPP SOMETIMES RETURNS TO CALL+2 |
| 624 | JMP I [ILOOP /DONE |
| 625 | |
| 626 | /ARRAY JUMP TABLE |
| 627 | |
| 628 | AJT, FFSUB1 /FAC=A(S1,S2)-FAC OPCODE 0 |
| 629 | FFADD /FAC=FAC+A(S1,S2) OPCODE 1 |
| 630 | FFSUB /FAC=FAC-A(S1,S2) OPCODE 2 |
| 631 | FFMPY /FAC=FAC*A(S1,S2) OPCODE 3 |
| 632 | FFDIV /FAC=FAC/A(S1,S2) OPCODE 4 |
| 633 | FFGET /FAC=C(A(S1,S2) OPCODE 5 |
| 634 | FPUTLL, FFPUT /C(A(S1,S2)=FAC OPCODE 6 |
| 635 | FFDIV1 /FAC=A(S1,S2)/FAC OPCODE 7 |
| 636 | \f /STRING ARRAY DISPATCH |
| 637 | |
| 638 | SARRAY, TAD INSAV /GET INSTRUCTION |
| 639 | AND [340 /ISOLATE ARRAY OPCODE |
| 640 | CLL RTR |
| 641 | RTR /AND SLIDE IT OVER FOR AN OFFSET |
| 642 | RAR |
| 643 | TAD JMPISA /BUILD A JUMP TO STRING INSTRCUTION |
| 644 | DCA SAD /AND PUT IN LINE |
| 645 | STL /TELL SFIND TO USE ARRAY TABLE |
| 646 | JMS I STFILK /SET UP ARGUMENT ADDRESS |
| 647 | 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 | JMPISA, JMP I .+1 /DISPATCH JUMP FOR STRING ARRAY INSTRUCTIONS |
| 655 | |
| 656 | SCON1 /SAC_SAC&C(A$(S1)) |
| 657 | SCOMP /SKIP IF SAC=C(A$(S1)) |
| 658 | SREAD /A$(S1)_DEVICE |
| 659 | K0037, 37 /* |
| 660 | STFILK, STFIND /* LINK TO STRING FINDING ROUTINE |
| 661 | SLOAD /SAC_C(A$(S1)) |
| 662 | SSTORE /C(A$(S1))_SAC |
| 663 | JMPI2, JMS I AJT /* DISPATCH JUMP FOR ARRAY INST |
| 664 | \f/ROUTINE TO PUT ONE WORD IN FILE BUFFER IN FIELD 1 |
| 665 | |
| 666 | BCPUT, 0 |
| 667 | DCA TEMP6 /SAVE AC |
| 668 | JMS I [IDLE /CHECK IF FILE OPEN |
| 669 | TAD I IOTPTR /GET READ/WRITE POINTER |
| 670 | DCA TEMP7 /SAVE |
| 671 | TAD ENTNO /GET FILE # |
| 672 | SZA CLA /IF TTY,BUFFER FIELD IS 0 |
| 673 | CDF 10 |
| 674 | TAD TEMP6 /GET WORD TO STORE AGAIN |
| 675 | DCA I TEMP7 /STORE IT IN BUFFER |
| 676 | CDF0, CDF |
| 677 | TAD I IOTHDR /HEADER WORD |
| 678 | AND (7737 /TURN OFF BLOCK WRITTEN BIT |
| 679 | TAD (40 /TURN IT ON AGAIN |
| 680 | DCA I IOTHDR |
| 681 | JMP I BCPUT /RETURN |
| 682 | |
| 683 | PAGE |
| 684 | \f/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 | XPUTCH, 0 |
| 696 | DCA CHRSAV /SAVE THE CHARACTER |
| 697 | XPUT1, ISZ SPINNR /SPIN RANDOM # SEED |
| 698 | JMS XPRINT /START A CHAR IF POSSIBLE |
| 699 | NOP |
| 700 | TAD BCNT /GET THE NUMBER OF AVAILABLE SLOTS |
| 701 | SNA CLA /ARE THERE ANY? |
| 702 | JMP XPUT1 /NO-TRY TO RPINT 1 AND FREE UP A SPACE |
| 703 | PUTCHR, TAD CHRSAV /GET CHARACTER AGAIN |
| 704 | DCA I BUFIN /PUT CHARACTER IN RING BUFFER |
| 705 | ISZ BUFIN /BUMP BUFEER POINTER OF INPUT |
| 706 | CLA CLL CMA /-1 IN AC |
| 707 | TAD BCNT /DECREMENT AVAILABLE SLOT COUNT |
| 708 | DCA BCNT |
| 709 | TAD BUFIN /GET BUFFER INPUT POINTER |
| 710 | TAD MBEND /SUBTRACT ADDR OF END OF BUFFER |
| 711 | SPA SNA CLA /PAST EDN OF BUFFER? |
| 712 | JMP I XPUTCH /NO-RETURN |
| 713 | TAD BSTRTA /YES-RESET INPUT POINTER TO BEGINNING OF BUFFER |
| 714 | DCA BUFIN |
| 715 | JMP I XPUTCH /RETURN |
| 716 | |
| 717 | BUFIN, BSTRT /POINTER TO NEXT SLOT FOR BUFFER INPUT |
| 718 | BUFOUT, BSTRT /POINTER TO NEXT CHARACTER TO BE PRINTED |
| 719 | BSTRTA, BSTRT /ADDR OF START OF TTY BUFFER |
| 720 | BCNT, 30 /# OF AVAILABLE SLOTS IN BUFFER (40 INITIALLY) |
| 721 | CHRSAV=TEMP1 |
| 722 | MBEND, -BEND /-ADDR OF END OF RING BUFFER |
| 723 | MCTRLC, -3 |
| 724 | M50, -30 |
| 725 | MXON, -21+3 |
| 726 | MXOFF, -23+21 |
| 727 | XFLAG, 0 |
| 728 | |
| 729 | |
| 730 | XPRINT, 0 |
| 731 | KSF /IS KEYBOARD FLAG UP? |
| 732 | JMP NOCC /NO-NO CHANCE FOR A CTRL/C |
| 733 | KRB /YES-GET THE CHAR IN KEYBOARD BUFFER |
| 734 | AND [177 /GET RID OF PARAITY |
| 735 | TAD MCTRLC /IS IT CTRL/C |
| 736 | SNA |
| 737 | JMP I FSTOP1 /YES-ABORT TO EDITOR |
| 738 | TAD MXON |
| 739 | SZA |
| 740 | JMP .+3 |
| 741 | DCA XFLAG |
| 742 | JMP NOCC+3 |
| 743 | TAD MXOFF |
| 744 | SZA CLA |
| 745 | JMP NOCC |
| 746 | ISZ XFLAG |
| 747 | JMP XPRINT+1 |
| 748 | NOCC, TAD XFLAG |
| 749 | SZA CLA |
| 750 | JMP XPRINT+1 |
| 751 | TAD BCNT /# OF AVAILABLE SLOTS IN BUFFER |
| 752 | TAD M50 /IS BUFFER EMPTY? |
| 753 | SNA CLA |
| 754 | JMP RECP2 /YES-RETURN TO CALL+2 |
| 755 | TSF /NO-TTY FLAG UP YET? |
| 756 | JMP I XPRINT /NO-GO ABOUT YOUR BUSINESS |
| 757 | 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 | JMS I (PCH /TYPE THE CHAR |
| 763 | ISZ BUFOUT /BUMP BUFFER OUTPUT POINTER |
| 764 | TAD BUFOUT /GET OUTPUT POINTER |
| 765 | TAD MBEND /SUBTRACT END OF BUFFER |
| 766 | SPA SNA CLA /IS OUTPUT POINTER PAST END? |
| 767 | JMP BOUTRS /NO-FREE UP A SPOT |
| 768 | TAD BSTRTA /YES-RESET POINTER TO BEGINNING |
| 769 | DCA BUFOUT |
| 770 | BOUTRS, ISZ BCNT /INCREMENT # OF FREE SLOTS (WE JUST PRINTED ONE) |
| 771 | JMP I XPRINT /RETURN |
| 772 | |
| 773 | RECP2, ISZ XPRINT /BUMP RETURN |
| 774 | JMP I XPRINT /RETURN TO CALL+2 FOR EMPTY BUFFER |
| 775 | |
| 776 | |
| 777 | /TELETYPE RING BUFFER |
| 778 | |
| 779 | BSTRT, "B /START OF BUFFER |
| 780 | "R |
| 781 | "T |
| 782 | "S |
| 783 | " |
| 784 | "V |
| 785 | VERLOC, 260+VERSON |
| 786 | 300+SUBVER |
| 787 | 0215 |
| 788 | 0212 |
| 789 | VEREND, 0212 |
| 790 | VCHECK, 0 |
| 791 | CDF 10 |
| 792 | TAD I N7644 |
| 793 | CDF 0 |
| 794 | AND XR4 |
| 795 | SNA CLA |
| 796 | JMP I VCHECK |
| 797 | TAD XR1 |
| 798 | DCA BUFIN |
| 799 | TAD SACXR |
| 800 | DCA BCNT |
| 801 | JMP I VCHECK |
| 802 | BEND, |
| 803 | N7644, 7644 |
| 804 | |
| 805 | \f /LINE NUMBERS |
| 806 | |
| 807 | LINEI, TAD INSAV /GET INSTRUCTION |
| 808 | DCA LINEHI /SAVE |
| 809 | JMS I [PWFECH /GET WORD FOLLOWING LINE # INST |
| 810 | DCA LINELO /SAVE AS LOW ORDER LINE # |
| 811 | TRHOOK, JMP I [ILOOP /RETURN TO I-LOOP |
| 812 | TAD KC240 /IF TRACE IS ON,FAKE CALL |
| 813 | DCA INSAV /TO FUNC2,#12 |
| 814 | JMP I .+1 |
| 815 | 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 | KC240, 240 /STOPPER TO MARK BEGINNING OF BUFFER |
| 823 | INTERB, |
| 824 | START3, TAD CDFPS /CDF FOR PSEUDO-CODE |
| 825 | DCA I [CDFPSU /PUT IN-LINE TO ILOOP |
| 826 | TAD PSSTRT /START OF PSEUDO-CODE |
| 827 | DCA I INTPCK /PUT INTO PC |
| 828 | JMS I [FACCLR /ZERO FAC |
| 829 | TAD CDFIO /CDF FOR SYMBOL TABLE FIELD |
| 830 | DCA I STDFL /PUT IN LINE FOR STRING FUNCTIONS |
| 831 | FPPTM5, TAD CDFIO /CDF FOR SYMBOL TABLES |
| 832 | DCA I ATABDL /PUT IN LINE FOR ARRAY CALCULATIONS |
| 833 | TAD CDFIO /CDF FOR SCALAR TABLE |
| 834 | FPPTM4, DCA I SCALDL /PUT IN LINE FOR ARGPRE |
| 835 | TAD CDFIO |
| 836 | DCA I DLCDFL /DATA FIELD FOR DATA LIST |
| 837 | FPPTM3, TAD DLSTRT |
| 838 | DCA DATAXR /DO A RESTORE IN INCORE DATA LIST |
| 839 | JMP I .+1 /CONTINUE INITAILIZATION CODE IN TTY INPUT BUFFER |
| 840 | FPPTM2, START4 |
| 841 | ATABDL, ATABDF |
| 842 | STDFL, STDF |
| 843 | FPPTM1, /FLOATING POINT TEMPORARY |
| 844 | INTPCK, INTPC |
| 845 | DLCDFL, DLCDF |
| 846 | SCALDL, SCALDF |
| 847 | |
| 848 | PAGE |
| 849 | \f /VT52 DELAY PARAMETERS (MUST BE AT BEGINNING OF PAGE) |
| 850 | |
| 851 | HEIGHT, 0 /NEGATIVE SCREEN HEIGHT |
| 852 | DELAY, 0 /NEGATIVE DELAY VALUE |
| 853 | IFNZRO HEIGHT-1200 <__FIX SET COMMAND__> |
| 854 | HCTR, 0 /HEIGHT COUNTER INITIALIZED BY SET |
| 855 | DCTR, 0 /DELAY COUNTER INITIALIZED BY SET |
| 856 | |
| 857 | /LOW LEVEL ROUTINE TO TYPE A CHAR |
| 858 | |
| 859 | PCH, 0 |
| 860 | TSF /WAIT FOR PREV CHAR |
| 861 | JMP .-1 |
| 862 | TLS /TYPE THE CURRENT ONE |
| 863 | AND [177 /MASK TO 7BIT |
| 864 | TAD (-15 /TEST IF LINE FEED WILL BE SENT NEXT |
| 865 | SZA CLA |
| 866 | JMP I PCH /RETURN IF NOT |
| 867 | ISZ HCTR /TEST SCREEN HEIGHT IF LF |
| 868 | JMP I PCH /RETURN IF NOT AT BOTTOM OF SCREEN |
| 869 | TAD HEIGHT |
| 870 | DCA HCTR /RESET HEIGHT COUNTER NOW |
| 871 | TAD DELAY |
| 872 | SNA /TEST FOR ZERO DELAY |
| 873 | JMP I PCH /RETURN IF SO |
| 874 | DCA DCTR /ELSE SET DELAY COUNTER |
| 875 | DLOOP, ISZ PSWAP /NOW EXEC INNER LOOP 4096 TIMES (USUALLY) |
| 876 | JMP .-1 |
| 877 | KSF /TEST IF KEY STRUCK |
| 878 | SKP |
| 879 | JMP I PCH /RETURN AT ONCE IF YES |
| 880 | ISZ DCTR /TEST DELAY TIMER |
| 881 | JMP DLOOP /REITERATE |
| 882 | JMP I PCH /NOW ALLOW PRINTING TO CONTINUE |
| 883 | |
| 884 | /OPERATE CLASS INSTRUCTIONS |
| 885 | |
| 886 | OPERI, TAD INSAV /GET OPERATE INSTRUCTION |
| 887 | AND [17 /MASK OFF OPERATE OPCODE |
| 888 | TAD JMPI3 /BUILD JUMP OFF OPERATE JUMPTABLE |
| 889 | DCA .+1 /STORE THE JUMP IN LINE |
| 890 | . /DISPATCH TO PROPER OPERATE ROUTINE |
| 891 | |
| 892 | JMPI3, JMP I .+1 /JUMP TO OPERATE ROUTINE CALLED FOR |
| 893 | |
| 894 | /OPERATE JUMP TABLE |
| 895 | |
| 896 | FUNC3I /CALL RESIDENT FUNCTION OPCODE 0 |
| 897 | SPFUNC /SPECIAL FUNCTIONS OPCODE 1 |
| 898 | SFN /SET FILE NUMBER OPCODE 2 |
| 899 | FNEGI /NEGATE FAC OPCODE 3 |
| 900 | RETRNI /GOSUB RETURN OPCODE 4 |
| 901 | RESTOR /RESTORE DEVICE OPCODE 5 |
| 902 | LSUB1I /LOAD S1 FROM FAC OPCODE 6 |
| 903 | LSUB2I /LOAD S2 FROM FAC OPCODE 7 |
| 904 | MSPACE, 20 /THIS OPCODE NOT DEFINED,SO WE PUT A CONST HERE |
| 905 | READI /READ DEVICE OPCODE 11 |
| 906 | WRITEI /WRITE DEVICE OPCODE 12 |
| 907 | SWRITE /STRING WRITE OPCODE 13 |
| 908 | FUNC5I /CALL FILE FUNCTION OPCODE 14 |
| 909 | FUNC4I /CALL USER FUNCTION OPCODE 15 |
| 910 | FUNC1I /CALL FUNCTIONS 1 OPCODE 16 |
| 911 | FUNC2I /CALL FUNCTIONS 2 OPCODE 17 |
| 912 | \f/ROUTINE TO SWAP PG 17600 WITH N7400 OR N7600 (WHICHEVER THE CASE MAY BE) |
| 913 | /WHERE N IS THE HIGH CORE FIELD |
| 914 | |
| 915 | PSWAP, 0 |
| 916 | TAD KK7600 /POINTER TO 17600 AND COUNTER |
| 917 | DCA TEMP1 |
| 918 | TAD PSFLAG /GET SWAPPING FLAGS |
| 919 | RAR |
| 920 | CML RAL /TOGGLE THE INPLACE BIT |
| 921 | DCA PSFLAG /STORE IT BACK |
| 922 | TAD HICORE /PICK UP ADDR OF HIGH CORE |
| 923 | DCA TEMP2 /POINTER TO HIGH CORE |
| 924 | P1CDF, HLT /DF TO HI CORE |
| 925 | TAD I TEMP2 /GET WORD FROM HI CORE |
| 926 | DCA TEMP4 /SAVE IT |
| 927 | P2CDF, CDF 10 |
| 928 | TAD I TEMP1 /GET WORD FROM 17600 |
| 929 | P1CDF1, HLT /DF TO HI CORE AGAIN |
| 930 | DCA I TEMP2 /PUT 17600 WORD IN HI CORE |
| 931 | P2CDF1, CDF 10 |
| 932 | TAD TEMP4 /GET SAVED HI CORE WORD |
| 933 | DCA I TEMP1 /AND PUT IN 17600 |
| 934 | ISZ TEMP2 /BUMP HI CORE POINTER |
| 935 | KK7600, 7600 /CLA |
| 936 | ISZ TEMP1 /BUMP 17600 POINTER AND CHECK FOR DONE |
| 937 | JMP P1CDF /NO DONE-MOVE NEXT WORD |
| 938 | CDF |
| 939 | JMP I PSWAP /DONE-RETURN |
| 940 | 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 | PAGE |
| 978 | \f /LOAD SUBSCRIPT 1 OR 2 FROM FAC OR MEMORY |
| 979 | |
| 980 | LSUB2I, ISZ DCASUB |
| 981 | JMP LSUB1I |
| 982 | LS2I, ISZ DCASUB |
| 983 | LS1I, JMS I [FACSAV /PRESERVE FAC |
| 984 | JMS I ARGPRL /GET ARG POINTER INTO AC |
| 985 | JMS I [FFGET /LOAD ARG INTO FAC (SKIPS NEXT INST ON RETURN) |
| 986 | LSUB1I, JMS I [FACSAV /SAVE THE FAC |
| 987 | JMS I [UNSFIX /GET INT(FAC) |
| 988 | DCASUB, DCA S1 /SET RESULT AS SUBSCRIPT 1 |
| 989 | JMS I [FACRES /RESTORE FAC |
| 990 | TAD DCAS1 |
| 991 | DCA DCASUB /FUDGE INSTR BACK |
| 992 | JMP I [ILOOP /NEXT INSTRCUTION |
| 993 | DCAS1, DCA S1 |
| 994 | ARGPRL, ARGPRE |
| 995 | |
| 996 | /JMP DISPATCH FOR FUNC1 CALLS |
| 997 | |
| 998 | JMSI4, JMS I .+1 /CALL FOR CANNED FUNCTION SET 1 |
| 999 | |
| 1000 | /JUMP TABLE FOR FUNCTION CALL 1 |
| 1001 | |
| 1002 | ATAN /FUNCTION BITS= 0 |
| 1003 | COS / 1 |
| 1004 | EXPON1 / 2 |
| 1005 | EXPON / 3 |
| 1006 | INT / 4 |
| 1007 | LOG / 5 |
| 1008 | SGN / 6 |
| 1009 | SIN / 7 |
| 1010 | RND / 10 |
| 1011 | FROOT / 11 |
| 1012 | |
| 1013 | /JUMP FOR FUNC2 DISPATCH |
| 1014 | |
| 1015 | JMSI5, JMP I .+1 /JMP OFF THE SET 2 TABLE |
| 1016 | |
| 1017 | /JUMP TABLE FOR FUNCTION SET 2 |
| 1018 | |
| 1019 | ASC /FUNCTION BITS= 0 |
| 1020 | CHR / 1 |
| 1021 | DATE / 2 |
| 1022 | LEN / 3 |
| 1023 | POS / 4 |
| 1024 | SEG / 5 |
| 1025 | STR / 6 |
| 1026 | VAL / 7 |
| 1027 | ERRORR / 10 |
| 1028 | /ERRORR MUST BE FUNCTION #10,ELSE "ERROPC" MUST CHANGE |
| 1029 | TRACE / 11 |
| 1030 | TPRINT / 12 |
| 1031 | /TPRINT MUST BE #12 OR TRHOOK+1 MUST CHANGE |
| 1032 | |
| 1033 | /DISPATCH FOR FUNC5 CALLS |
| 1034 | |
| 1035 | JMPFIL, JMP I .+1 /CALL FORR FILE MANIPULATING FUNCTIONS |
| 1036 | |
| 1037 | /JUMP TABLE FOR FILE FUNCTIONS |
| 1038 | |
| 1039 | CHAIN /FUNCTION BITS= 0 |
| 1040 | CLOSE / 1 |
| 1041 | OPENAF / 2 |
| 1042 | OPENAV / 3 |
| 1043 | OPENNF / 4 |
| 1044 | OPENNV / 5 |
| 1045 | FSTOP /INT. EXIT 6 |
| 1046 | |
| 1047 | /ERROR CALL FOR USER FUNCTIONS-USER FUNCTION SHOULD "JMS I (IA" |
| 1048 | |
| 1049 | IA, JMS I [ERROR |
| 1050 | \f /FUNCTION OVERLAY DRIVER |
| 1051 | |
| 1052 | FUNC4I, JMS I [XPRINT /PURGE TTY RING BUFFER |
| 1053 | JMP .-1 /BEFORE CALLING USER FUNCTION |
| 1054 | IAC /LOOK FOR OVERLAY FLAG=3 |
| 1055 | FUNC5I, IAC /LOOK FOR OVERLAY FLAG=2 |
| 1056 | FUNC2I, IAC /LOOK FOR OVERLAY FLAG=1 |
| 1057 | FUNC1I, DCA TEMP1 /LOOK FOR OVERLAY FLAG=0 |
| 1058 | CDF /DF TO THIS FIELD |
| 1059 | TAD TEMP1 /GET OVERLAY # AGAIN |
| 1060 | CIA /NEGATE |
| 1061 | TAD OVRLAY /COMPARE AGAINST OVERLAY FLAG |
| 1062 | SNA CLA /IS THE ONE WE WANT ALREADY RESIDENT? |
| 1063 | JMP OVDNE /YES-JUST JUMP TO FUNCTION |
| 1064 | TAD TEMP1 /NO-GET NUMBER OF OVERALY DESIRED |
| 1065 | TAD OATADI /USE AS OFFSET TO BUILD STARTING BLOCK TAD |
| 1066 | DCA TEMP2 /POINTS TO PROPER STARING BLOCK # |
| 1067 | TAD I TEMP2 /GET STARTING BLOCK FOR THIS OVERLAY |
| 1068 | DCA OVADD /PUT IN DRIVER CALL |
| 1069 | JMS I L7607 /CALL SYSTEM HANDLER |
| 1070 | 0500 /OVERLAY 3400-4600 |
| 1071 | 3400 |
| 1072 | OVADD, . /STARTING BLOCK # OF OVERLAY |
| 1073 | OE, JMS I [ERROR /I/O ERROR |
| 1074 | TAD TEMP1 |
| 1075 | DCA OVRLAY /CHANGE RESIDENT FLAG |
| 1076 | OVDNE, TAD [SAC-1 /ENTER STRING FUNCTIONS WITH SACXR SET UP |
| 1077 | DCA SACXR |
| 1078 | TAD TEMP1 /FUNCTION # |
| 1079 | TAD JMSTAD /BUILD A TAD OF THE PROPER DISPATCH JMS |
| 1080 | DCA .+2 /PUT IN LINE |
| 1081 | JMS I [FBITGT /GET # OF FUNCTION DESIRED |
| 1082 | . /BUILD JUMP OFF JUMP TABLE |
| 1083 | FUJUMP, DCA .+1 /PUT JUMP IN LINE |
| 1084 | . /GO TO DESIRED FUNCTION |
| 1085 | JMP I [ILOOP /DONE |
| 1086 | |
| 1087 | OATADI, ARITHA |
| 1088 | L7607, 7607 |
| 1089 | 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 | ARITHA, . /STARTING BLOCK OF ARITHMETIC OVERLAY |
| 1096 | STRNGA, . /STARTING BLOCK OF STRING OVERLAY |
| 1097 | FILEFA, . /STARTING BLOCK OF FILE OVERLAY |
| 1098 | USRA, . /STARTING BLOCK OF USER FUNCTIONS |
| 1099 | |
| 1100 | JMSTAD, TAD I TADTAB |
| 1101 | |
| 1102 | TADTAB, JMSI4 |
| 1103 | JMSI5 |
| 1104 | JMPFIL |
| 1105 | JMSUSR |
| 1106 | |
| 1107 | \f/CALL FOR RESIDENT FUNCTION |
| 1108 | |
| 1109 | FUNC3I, JMS I [FBITGT /ISOLATE FUNCTION # |
| 1110 | TAD JMSI7 /MAKE A JUMP OFF JUMP TABLE |
| 1111 | JMP FUJUMP /PUT THE JUMP IN LINE AND EXECUTE IT |
| 1112 | |
| 1113 | JMSI7, JMP I .+1 |
| 1114 | |
| 1115 | /JUMP TABLE FOR RESIDENT FUNCTIONS |
| 1116 | |
| 1117 | XABSVL /FUNCTION BITS= 0 |
| 1118 | COMMA / 1 |
| 1119 | CRFUNC / 2 |
| 1120 | ILOOPF / 3 |
| 1121 | TAB / 4 |
| 1122 | PNT / 5 |
| 1123 | USE / 6 |
| 1124 | |
| 1125 | |
| 1126 | *1557 /****N.B.**** |
| 1127 | /THIS TABLE CANNOT BE MOVED!!!! |
| 1128 | |
| 1129 | /JUMP DISPATCH FOR USER ROUTINES |
| 1130 | JMSUSR, JMS I .+1 |
| 1131 | |
| 1132 | /JUMP TABLE FOR USER FUNCTIONS |
| 1133 | ILOOPF /USER FUNCTION 1 |
| 1134 | ILOOPF / 2 |
| 1135 | ILOOPF / 3 |
| 1136 | ILOOPF / 4 |
| 1137 | ILOOPF / 5 |
| 1138 | ILOOPF / 6 |
| 1139 | ILOOPF / 7 |
| 1140 | ILOOPF / 8 |
| 1141 | ILOOPF / 9 |
| 1142 | ILOOPF / 10 |
| 1143 | ILOOPF / 11 |
| 1144 | ILOOPF / 12 |
| 1145 | ILOOPF / 13 |
| 1146 | ILOOPF / 14 |
| 1147 | ILOOPF / 15 |
| 1148 | ILOOPF / 16 |
| 1149 | |
| 1150 | PAGE |
| 1151 | \f/SPECIAL FUNCTIONS |
| 1152 | |
| 1153 | SPFUNC, JMS I [FBITGT /ISOLATE FUNCTION BITS |
| 1154 | TAD JMPI6 /MAKE A JUMP OFF SPECIAL FUNCTION TABLE |
| 1155 | DCA .+1 /PUT IN LINE |
| 1156 | . |
| 1157 | |
| 1158 | JMPI6, JMP I .+1 /JUMP TO SPECIAL FUNCTION ROUTINE |
| 1159 | |
| 1160 | /SPECIAL FUNCTION JUMP TABLE |
| 1161 | |
| 1162 | SETF /SET FSWITCH 0 |
| 1163 | FRANDM /RANDOMIZE 1 |
| 1164 | FSTOPN /LEAVE INTERPRETER 2 |
| 1165 | SRLIST /STRING READ FROM DATA LIST 3 |
| 1166 | CSFN /SET FILE # TO TTY 4 |
| 1167 | RDLIST /READ DATA LIST 5 |
| 1168 | AMODE /SWITCH TO A MODE 6 |
| 1169 | SSMODE /SWITCH TO S MODE 7 |
| 1170 | \f/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 | UNSFIX, 0 |
| 1175 | CDF 0 |
| 1176 | TAD ACL /LOW MANTISSA |
| 1177 | CLL RAL /HI BIT OF LO MANTISSA TO LINK |
| 1178 | CLA |
| 1179 | TAD ACH /HIGH MANTISSA |
| 1180 | SPA /IS NUMBER POSITIVE? |
| 1181 | FM, JMS I [ERROR /NO-BOO!!! |
| 1182 | RAL /SHIFT THE SIGN BIT OUT AND THE MANTISSA OVER, |
| 1183 | DCA ACH /MAKING 12 BITS OF MANTISSA AND BINARY POINT BEFORE BIT 0 |
| 1184 | TAD ACX /GET EXPONENT |
| 1185 | SPA SNA CLA /IS X>1? |
| 1186 | JMP I UNSFIX /NO-FIX IT TO 0 |
| 1187 | TAD ACX /YES-GET EXPONENT |
| 1188 | TAD [-14 /SET BINARY POINT AT 12 |
| 1189 | SNA /DONE ALREADY? |
| 1190 | JMP UNSOUT /YES |
| 1191 | SMA /NO-IS # TOO BIG? |
| 1192 | FO, JMS I [ERROR /YES |
| 1193 | DCA ACX /NO-STORE COUNT |
| 1194 | TAD ACH /HI MANTISSA |
| 1195 | UNSLP, CLL RAR /SCALE RIGHT |
| 1196 | ISZ ACX /DONE? |
| 1197 | JMP UNSLP /NO |
| 1198 | JMP I UNSFIX /YES-RETURN |
| 1199 | |
| 1200 | UNSOUT, TAD ACH /ANSWER IN AC |
| 1201 | JMP I UNSFIX |
| 1202 | |
| 1203 | /RESTORE ROUTINE |
| 1204 | |
| 1205 | RESTOR, TAD ENTNO /GET CURRENT FILE # |
| 1206 | SNA CLA /IS IT 0? |
| 1207 | JMP RESDLS /YES-RESTORE DATA LIST |
| 1208 | JMS I (WRBLK /NO-WRITE CURRENT BUFFER |
| 1209 | STA /-1 |
| 1210 | TAD I IOTLOC /STARTING BLOCK-1 |
| 1211 | DCA I IOTBLK /SET CURRENT BLOCK # |
| 1212 | TAD I IOTBUF /GET BUFFER ADDRESS |
| 1213 | DCA I IOTPTR /USE IT TO RESET READ\WRITE POINTER |
| 1214 | TAD I IOTHDR /GET HEADER WORD |
| 1215 | AND (7435 /CLEAR EOF BIT,BUFFER WRITTEN BIT,AND CHAR # |
| 1216 | DCA I IOTHDR |
| 1217 | JMS I [NEXREC /READ FIRST BLOCK INTO BUFFER |
| 1218 | JMP I [ILOOP /DONE |
| 1219 | RESDLS, TAD DLSTRT /ADDRESS OF START OF INCORE DATA LIST |
| 1220 | DCA DATAXR /USE IT TO RESET DATA LIST POINTER |
| 1221 | JMP I [ILOOP /THATS ALL! |
| 1222 | \f/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 | STFIND, 0 |
| 1229 | SZL /IS THIS AN ARRAY INST? |
| 1230 | JMP SAFIND /YES-POINTER IS INTO ARRAY TABLE |
| 1231 | TAD INSAV /GET INST AGAIN |
| 1232 | AND [377 /ISOLATE OPERAND POINTER |
| 1233 | DCA TEMP1 /NO-SAVE OPERAND POINTER |
| 1234 | TAD TEMP1 /N |
| 1235 | CLL RAL /2N |
| 1236 | TAD TEMP1 /3N (3 WORDS/ENTRY) |
| 1237 | TAD STSTRT /ADD BASE ADR OF STRING TABLE |
| 1238 | STCOM, DCA XR2 /POINTER TO THIS ENTRY IN STRING TABLE |
| 1239 | STDF, . /DF TO THAT OF SYMBOL TABLES (SET BY START) |
| 1240 | TAD I XR2 /GET POINTER TO STRING |
| 1241 | DCA STRPTR |
| 1242 | TAD I XR2 /GET CDF FOR OPERAND STRING |
| 1243 | DCA STRCDF /SAVE |
| 1244 | TAD I XR2 /GET -(MAX LENGTH OF STRING) |
| 1245 | DCA STRMAX /SAVE |
| 1246 | SNL /ARRAY ELEMENT? |
| 1247 | JMP STRCDF /NO-SKIP THIS SUBSCRIPT CALCULATION |
| 1248 | TAD S1 /GET SUBSCRIPT |
| 1249 | CLL CMA /SET UP 12 BIT COMPARE |
| 1250 | TAD I XR2 /GET DIMENSION |
| 1251 | SNL CLA /IS S1>DIMENSION? |
| 1252 | JMP I (SU /YES |
| 1253 | TAD STRMAX /NO-GET ELEMENT LENGTH |
| 1254 | CIA /MAKE POSITIVE |
| 1255 | CLL IAC /ROUND OFF TO NEAREST MULTIPLE OF 2 |
| 1256 | CLL RAR / DIVIDE BY TWO (COUNT/2=WORD COUNT) |
| 1257 | CLL IAC /ADD A WORD FOR HEADER |
| 1258 | DCA TEMP3 /# OF WORDS IN EACH ARRAY ELEMENT |
| 1259 | TAD S1 /GET SUBSCRIPT |
| 1260 | JMS I [MPY /S1*ELEMENT LENGTH (ASSUMES LINK UNCHANGED ON RETURN) |
| 1261 | TAD STRPTR /ARRAY OFFSET+POINTER TO A(0) |
| 1262 | DCA STRPTR /FINAL STRING POINTER |
| 1263 | RAL /CARRY TO BIT 11 |
| 1264 | TAD TEMP6 /ADD TO ACCUMLATED OVERLAPS FROM MULTIPLY |
| 1265 | CLL RTL |
| 1266 | RAL /PUT OVERLAP # INTO BITS 6-8 |
| 1267 | TAD STRCDF /ADD TO CDF IF NECESSARY |
| 1268 | DCA STRCDF /SAVE AGAIN |
| 1269 | STRCDF, 0 /DF TO STRING FIELD |
| 1270 | TAD I STRPTR |
| 1271 | CDF |
| 1272 | DCA STRCNT /STORE -(CURRENT LENGTH OF STRING) |
| 1273 | TAD STRCDF /CDF TO OPERAND IN AC |
| 1274 | DCA I (SSTEX /SETUP STRING STORE EXIT DF HERE |
| 1275 | JMS I (BYTSET /ENTER FUNCTIONS WITH BYTE POINTERS SETUP |
| 1276 | JMP I STFIND /RETURN |
| 1277 | |
| 1278 | SAFIND, TAD INSAV /GET INST |
| 1279 | AND (37 /ISOLATE OPERAND POINTER |
| 1280 | CLL RTL /4N (4 WORDS/ENTRY) |
| 1281 | TAD SASTRT /USE STRING ARRAY TABLE |
| 1282 | STL /SET LINK FOR ARRAY INST |
| 1283 | JMP STCOM /RETURN TO SUBROUTINE MAINLINE |
| 1284 | |
| 1285 | /PNT(X) |
| 1286 | /SEND 7BIT CHAR TO THE CURRENT FILE |
| 1287 | |
| 1288 | PNT, JMS I [UNSFIX /FIX X |
| 1289 | AND [177 /STRIP TO 7 ASCII BITS |
| 1290 | TAD [200 /FORCE CHANNEL 8 |
| 1291 | JMS I [PUTCH /PUT IN FILE BUFFER |
| 1292 | JMP I [ILOOP /DONE |
| 1293 | |
| 1294 | PAGE |
| 1295 | \f/ROUTINE SFN-ROUTINE TO RESET POINTERS IN PAGE ZERO FILE POINTER |
| 1296 | /AREA TO REFLECT A CHANGE IN THE CURRENT FILE NUMBER |
| 1297 | |
| 1298 | SFN, JMS I [UNSFIX /FIX FAC TO GET FILE # |
| 1299 | CSFN, DCA ENTNO /IF ENTRY IS HERE,FILE #=0 (TTY) |
| 1300 | TAD ENTNO |
| 1301 | STL |
| 1302 | TAD (-4 /IS RESULT A LEGAL FILE #? |
| 1303 | SNL SZA CLA |
| 1304 | FN, JMS I [ERROR /NO-ERROR |
| 1305 | TAD ENTNO /PICK UP FILE NUMBER |
| 1306 | CLL RTL |
| 1307 | RTL |
| 1308 | CIA |
| 1309 | TAD ENTNO |
| 1310 | CIA /MULTIPLY BY SIZE OF IOTABLE |
| 1311 | IFNZRO IOTSIZ-15 <__ASSEMBLY ERROR__> |
| 1312 | TAD (TTYF /ADD TO BASE |
| 1313 | DCA XR1 /STORE IN TEMP |
| 1314 | TAD (IOTHDR-1 /NOW POINT AT PAGE 0 AREA |
| 1315 | DCA XR2 |
| 1316 | TAD (-IOTSIZ+3 /SETUP ALL BUT LAST 3 |
| 1317 | DCA TEMP2 |
| 1318 | TAD XR1 |
| 1319 | DCA I XR2 |
| 1320 | ISZ XR1 |
| 1321 | ISZ TEMP2 |
| 1322 | JMP .-4 /SET UP THE POINTERS NOW |
| 1323 | JMP I [ILOOP /--RETURN-- |
| 1324 | \f /GOSUB |
| 1325 | |
| 1326 | GOSUB, TAD I GSP |
| 1327 | SMA CLA |
| 1328 | GS, JMS I [ERROR /ERROR IF STACK OVERFLOW |
| 1329 | TAD I [CDFPSU /ELSE GET CDF INSTR |
| 1330 | DCA I GSP |
| 1331 | ISZ GSP |
| 1332 | TAD I (INTPC |
| 1333 | DCA I GSP /STORE INT PC |
| 1334 | ISZ GSP |
| 1335 | JMP I (SUCJMP /EXEC AS NORMAL GOTO NOW |
| 1336 | |
| 1337 | /GOSUB RETURN |
| 1338 | |
| 1339 | RETRNI, STA |
| 1340 | TAD GSP |
| 1341 | DCA GSP /POP STACK |
| 1342 | TAD I GSP /GET PC |
| 1343 | DCA I (INTPC |
| 1344 | STA |
| 1345 | TAD GSP /POP STACK |
| 1346 | DCA GSP |
| 1347 | TAD I GSP |
| 1348 | SMA |
| 1349 | GR, JMS I [ERROR /FATAL ERROR IF NO RETURN |
| 1350 | DCA I [CDFPSU |
| 1351 | JMP I (JFAIL /BUMP PC PAST ADDR WORD AND CONTINUE |
| 1352 | |
| 1353 | GSP, GSTCK /GOSUB STACK POINTER |
| 1354 | |
| 1355 | /FOR-LOOP JUMP ROUTINE |
| 1356 | /ENTER WITH AC = HORD |
| 1357 | |
| 1358 | JFOR, SNA /IS FAC=0? |
| 1359 | JMP I (JFAIL /YES-DO NOT JUMP |
| 1360 | TAD FSWITC /ADD FSWITCH |
| 1361 | SPA CLA /ARE SIGN BIT=FSWITCH? |
| 1362 | JMP I (JFAIL /NO-DO NOT JUMP |
| 1363 | JMP I (SUCJMP /YES-DO JUMP |
| 1364 | |
| 1365 | /ROUTINE TO INITIALIZE FSWITCH |
| 1366 | |
| 1367 | SETF, AC4000 |
| 1368 | AND ACH /ISOLATE SIGN OF MANTISSA |
| 1369 | DCA FSWITC /STORE IN FSWITCH |
| 1370 | JMP I [ILOOP /DONE |
| 1371 | FSWITC, 0 |
| 1372 | \f/ROUTINE TO RESET CHARACTER NUMBER TO 1 |
| 1373 | |
| 1374 | CNOCLR, 0 |
| 1375 | TAD I IOTHDR |
| 1376 | AND [7477 /SET CHAR BITS TO 0 |
| 1377 | DCA I IOTHDR |
| 1378 | JMP I CNOCLR /RETURN |
| 1379 | |
| 1380 | /ROUTINE TO ZERO THE CURRENT I/O BUFFER |
| 1381 | |
| 1382 | BLZERO, 0 |
| 1383 | STA |
| 1384 | TAD I IOTBUF |
| 1385 | DCA XR1 /POINT INTO THE BUFFER |
| 1386 | TAD [7400 |
| 1387 | DCA CNOBML /SET COUNT TO 400 WORDS |
| 1388 | TAD (232 /INSERT A ^Z IN THE BUFFER FIRST |
| 1389 | CDF 10 |
| 1390 | DCA I XR1 |
| 1391 | ISZ CNOBML |
| 1392 | JMP .-2 /LOOP FOR THE REST |
| 1393 | CDF |
| 1394 | JMP I BLZERO /--RETURN-- |
| 1395 | |
| 1396 | /BUMP 3 FOR 2 CHAR NUMBER FOR CURRENT FILE |
| 1397 | |
| 1398 | CNOBML, 0 |
| 1399 | TAD I IOTHDR /HEADER WORD |
| 1400 | TAD [100 /ADD 1 TO THE COUNT BITS |
| 1401 | DCA I IOTHDR |
| 1402 | JMP I CNOBML /DONE |
| 1403 | \f /STRING COMPARE |
| 1404 | /COMPARE SAC WITH MEMORY, BLANK EXTENDING THE |
| 1405 | /SHORTER STRING ON THE RIGHT |
| 1406 | |
| 1407 | SCOMP, DCA MODESW /SET INTERPRETER TO ARITH MODE NOW |
| 1408 | JMS I [FACCLR /TENTATIVELY ASSUME EQUAL (FAC = 0) |
| 1409 | SCOMLP, TAD STRCNT /IS THE MEMORY STRING EMPTY NOW? |
| 1410 | SNA CLA |
| 1411 | TAD L40 /PAD WITH SPACE IF YES |
| 1412 | SNA |
| 1413 | JMS I (LDB /LOAD NEXT BYTE IF NOT |
| 1414 | DCA TEMP2 |
| 1415 | TAD SACLEN /NOW IS THE SAC EMPTY |
| 1416 | SNA CLA |
| 1417 | TAD L40 /YES, PAD IT |
| 1418 | SNA |
| 1419 | TAD I SACXR /NO GET IT |
| 1420 | CLL CIA /COMPARE TO MEMORY |
| 1421 | TAD TEMP2 |
| 1422 | SZA CLA |
| 1423 | JMP SNEQ /JMP IF NOT EQUAL, L=SENSE OF COMPARE |
| 1424 | TAD STRCNT /IS MEMORY STRING DONE |
| 1425 | SZA CLA |
| 1426 | ISZ STRCNT /NO, BUMP COUNT |
| 1427 | L40, 40 /EFFECTIVE NOP |
| 1428 | TAD SACLEN /IS THE SAC EMPTY |
| 1429 | SZA CLA |
| 1430 | ISZ SACLEN /NO BUMP COUNT |
| 1431 | TAD SACLEN /GET SAC REMAINDER (SKP IF IS JUST ZERO) |
| 1432 | TAD STRCNT /ADD ARG REMAINDER |
| 1433 | SZA CLA |
| 1434 | JMP SCOMLP /LOOP IF BOTH NOT EMPTY |
| 1435 | JMP I [ILOOP /OTHERWISE EQUAL |
| 1436 | SNEQ, STA RAR |
| 1437 | DCA ACH /STORE SIGN BIT |
| 1438 | JMP I [ILOOP /--RETURN-- |
| 1439 | |
| 1440 | PAGE |
| 1441 | \f /STRING DATA LIST READ, STRING LOAD AND STRING CONCATENATE |
| 1442 | |
| 1443 | SRLIST, JMS I (DLREAD /FIRST READ NEG BYTE COUNT |
| 1444 | DCA STRCNT /STORE IT |
| 1445 | STL /SET LINK MEANS USE PHONY DATA LIST BYTE LOAD |
| 1446 | SKP /SKP INTO STRING LOAD ROUTINE |
| 1447 | SLOAD, CLL /CLEAR LINK TO USE NORMAL LOAD BYTE ROUTINE |
| 1448 | DCA SACLEN /CLEAR SAC LENGTH COUNTER |
| 1449 | SZL |
| 1450 | TAD (DRGCH-LDB /USE PHONY LOAD BYTE |
| 1451 | SCON1, TAD (LDB /USE REAL LDB FOR CONCATENATE |
| 1452 | DCA SCLDB |
| 1453 | TAD STRCNT |
| 1454 | SNA CLA |
| 1455 | JMP I [ILOOP /NOTHING TO DO IF NULL STRING |
| 1456 | TAD SACLEN /COMPUTE OFFSET INTO SAC |
| 1457 | CIA |
| 1458 | TAD [SAC-1 |
| 1459 | DCA SACXR /TO STORE AFTER END OF PREV STRING |
| 1460 | SEGCOM, JMS I SCLDB /GET A BYTE |
| 1461 | DCA I SACXR /STORE IT |
| 1462 | STA |
| 1463 | TAD SACLEN /NOW BUMP SIZE OF SAC |
| 1464 | DCA SACLEN |
| 1465 | TAD SACLEN /CHECK IF ROOM LEFT |
| 1466 | TAD (SACLIM |
| 1467 | SPA CLA |
| 1468 | SC, JMS I [ERROR /FATAL ERROR IF SAC OVERFLOW |
| 1469 | ISZ STRCNT |
| 1470 | JMP SEGCOM /ITERATE IF MORE |
| 1471 | JMP I [ILOOP /--RETURN-- |
| 1472 | |
| 1473 | SCLDB, 0 |
| 1474 | |
| 1475 | /ROUTINE TO GET A BYTE FROM THE DATA LIST |
| 1476 | |
| 1477 | DRGCH, 0 |
| 1478 | TAD SACLEN /TEST FOR EVEN OR ODD |
| 1479 | CLL RAR |
| 1480 | SZL CLA |
| 1481 | JMP CHR2 /SECOND CHAR |
| 1482 | JMS I (DLREAD /FIRST CHAR, READ ANOTHER WORD |
| 1483 | DCA DRCHR |
| 1484 | TAD DRCHR |
| 1485 | CLL RTR |
| 1486 | RTR |
| 1487 | RTR /SHIFT RIGHT |
| 1488 | SKP |
| 1489 | CHR2, TAD DRCHR /GET SECOND CHAR |
| 1490 | AND [77 /MASK TO 6BIT |
| 1491 | JMP I DRGCH /RETURN |
| 1492 | |
| 1493 | DRCHR, 0 |
| 1494 | \f |
| 1495 | /ROUTINE TO SET EOF BIT IN I/O ENTRY |
| 1496 | EOFSET, TAD I IOTHDR /HEADER |
| 1497 | CLL RTR /EOF BIT TO LINK |
| 1498 | STL RTL /SET LINK |
| 1499 | /PUT LINK IN EOF BIT |
| 1500 | DCA I IOTHDR /STORE IN I/O TABLE ENTRY |
| 1501 | 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 | MPY, 0 |
| 1508 | DCA TEMP10 |
| 1509 | DCA TEMP6 |
| 1510 | TAD [-14 |
| 1511 | DCA TEMP5 |
| 1512 | MP12LP, TAD TEMP3 |
| 1513 | RAR |
| 1514 | DCA TEMP3 |
| 1515 | TAD TEMP6 |
| 1516 | SNL |
| 1517 | JMP .+3 /12 BIT MULTIPLY USED TO FIND (DIM1+1)*S2 |
| 1518 | CLL |
| 1519 | TAD TEMP10 |
| 1520 | RAR |
| 1521 | DCA TEMP6 |
| 1522 | ISZ TEMP5 |
| 1523 | JMP MP12LP |
| 1524 | TAD TEMP3 /LORD OF (DIM1+1)*S2 IN AC |
| 1525 | RAR /HORD OF (DIM1+1)*S2 IN TEMP6 |
| 1526 | JMP I MPY /RETURN |
| 1527 | |
| 1528 | /ROUTINE TO CHECK IF FILE IDLE |
| 1529 | |
| 1530 | IDLE, 0 |
| 1531 | TAD I IOTHND /GET HANDLER ENTRY |
| 1532 | SNA CLA /IS IT EMPTY? |
| 1533 | FI, JMS I [ERROR /YES-USER TRIED TO DO SOMETHING TO AN UNOPEN FILE |
| 1534 | JMP I IDLE /NO-RETURN |
| 1535 | \f/ROUTINE TO READ NEXT WORD IN DATALIST INTO AC |
| 1536 | |
| 1537 | DLREAD, 0 |
| 1538 | TAD DATAXR /DATA LIST POINTER |
| 1539 | CLL CMA /SET UP 12 BIT COMPARE |
| 1540 | TAD DLSTOP /ADDR OF END OF DATA LIST |
| 1541 | SNL CLA /POINTER AT END OF LIST? |
| 1542 | DA, JMS I [ERROR /YES |
| 1543 | DLCDF, . /NO-DF TO DATA LIST |
| 1544 | TAD I DATAXR /FETCH WORD FROM DATA LIST |
| 1545 | CDF |
| 1546 | JMP I DLREAD /DONE |
| 1547 | |
| 1548 | /RANDOMIZE STATEMENT |
| 1549 | |
| 1550 | FRANDM, TAD SPINNR /USE SPINNR FOR NEW SEED FOR RND(X) |
| 1551 | STL RAL /MAKE SURE SEED IS ODD |
| 1552 | DCA RSEED |
| 1553 | JMP I [ILOOP /DONE |
| 1554 | RSEED, 2713 |
| 1555 | |
| 1556 | /SUBROUTINE CR,LF |
| 1557 | |
| 1558 | CRLFR, 0 |
| 1559 | TAD [215 |
| 1560 | JMS I [PUTCH |
| 1561 | TAD (212 |
| 1562 | JMS I [PUTCH /PRINT A CR,AND LF |
| 1563 | DCA I IOTPOS /ZERO NUMBER OF CHARS PRINTED SO FAR |
| 1564 | JMP I CRLFR |
| 1565 | |
| 1566 | /SUBROUTINE FOTYPE |
| 1567 | /RETURNS TO CALL+1 IF FILE FIXED LENGTH,CALL+2 IF VARIABLE |
| 1568 | |
| 1569 | FOTYPE, 0 |
| 1570 | TAD I IOTHDR /GET HEADER |
| 1571 | AND (4 /ISOLATE TYPE BIT |
| 1572 | SZA CLA /IS IT FIXED LENGTH? |
| 1573 | ISZ FOTYPE /NO-BUMP RETURN |
| 1574 | JMP I FOTYPE /RETURN |
| 1575 | |
| 1576 | /ABS(X) FUNCTION |
| 1577 | |
| 1578 | XABSVL, JMS ABSVAL /NEGATE FAC IF NEGATIVE |
| 1579 | JMP I [ILOOP /--RETURN-- |
| 1580 | |
| 1581 | /SUBROUTINE TO TAKE ABS VALUE OF FAC |
| 1582 | |
| 1583 | ABSVAL, 0 |
| 1584 | TAD ACH |
| 1585 | SPA CLA /IS FAC<0? |
| 1586 | JMS I [FFNEG /YES-NEGATE IT |
| 1587 | JMP I ABSVAL /RETURN |
| 1588 | |
| 1589 | /ROUTINE TO RESTORE THE FAC FROM FP TEMP |
| 1590 | |
| 1591 | FACRES, 0 |
| 1592 | JMS I [FFGET /GET FAC |
| 1593 | INTERB |
| 1594 | JMP I FACRES /RETURN |
| 1595 | |
| 1596 | PAGE |
| 1597 | \f /STRING STORE |
| 1598 | |
| 1599 | SSTORE, TAD SACLEN |
| 1600 | SNA |
| 1601 | JMP I (SSTEX /EXIT IF NULL STRING IN SAC |
| 1602 | DCA TEMP1 /SET COUNT |
| 1603 | TAD SACLEN /SEE IF WILL FIT |
| 1604 | CIA |
| 1605 | TAD STRMAX |
| 1606 | SMA SZA CLA /SKP IF LEN.LE.MAX LEN |
| 1607 | SL, JMS I [ERROR /ERROR IF TARGET STRING TOO SMALL |
| 1608 | TAD I SACXR /PICK UP SAC BYTE |
| 1609 | JMS I (DPB /STORE IT |
| 1610 | ISZ TEMP1 |
| 1611 | JMP .-3 |
| 1612 | JMP I (SSTEX /--RETURN-- |
| 1613 | |
| 1614 | /STRING READ FROM FILE TO MEMORY |
| 1615 | |
| 1616 | SREAD, JMS I [GETCH /GET CHAR FROM FILE |
| 1617 | TAD CHAR |
| 1618 | TAD [-215 /IS IS CR? |
| 1619 | SNA |
| 1620 | JMP I (SSTEX /YES, EXIT |
| 1621 | TAD (3 /IS IT LF? |
| 1622 | SNA CLA |
| 1623 | JMP SREAD /YES, IGNORE IT |
| 1624 | TAD I (BYTCNT /SEE IF THIS CHAR WILL FIT |
| 1625 | TAD STRMAX |
| 1626 | SMA CLA |
| 1627 | JMP ST /NO, SOFT ERROR |
| 1628 | TAD CHAR /YES, STORE IT |
| 1629 | JMS I (DPB |
| 1630 | JMP SREAD |
| 1631 | ST, JMS I [ERROR |
| 1632 | TAD [215 /FAKE OUT INPUT ROUTINE |
| 1633 | DCA CHAR |
| 1634 | JMP I (SSTEX /SET STRING SIZE AND EXIT |
| 1635 | \f /STRING WRITE FROM SAC TO DEVICE |
| 1636 | |
| 1637 | SWRITE, DCA COMMAS |
| 1638 | TAD SACLEN /SEE IF NULL STRING |
| 1639 | SNA |
| 1640 | JMP I [ILOOP /RETURN IF SO |
| 1641 | CIA |
| 1642 | TAD I IOTPOS /ADD TO NUMBER OF CHARS PRINTED SO FAR |
| 1643 | TAD (-WIDTH |
| 1644 | SMA SZA CLA /SKP IF LE WIDTH OF LINE |
| 1645 | JMS I [CRLFR /ELSE RESET CARRAIGE |
| 1646 | TAD SACLEN |
| 1647 | DCA STRCNT /SET LOOP COUNTER |
| 1648 | TAD [SAC-1 |
| 1649 | DCA SACXR /POINT AT SAC |
| 1650 | SWRLP, TAD I SACXR |
| 1651 | TAD (240 |
| 1652 | AND [77 |
| 1653 | TAD (240 /CONVERT TO 8BIT |
| 1654 | JMS I (PUTCH |
| 1655 | ISZ STRCNT |
| 1656 | JMP SWRLP /ITERATE IF MORE |
| 1657 | JMP I [ILOOP /--RETURN-- |
| 1658 | |
| 1659 | \f/COMMA FUNCTION (KNOWN ONLY TO COMPILER FOR FORMATTING PRINT |
| 1660 | /STATEMENTS) |
| 1661 | |
| 1662 | COMMA, JMS I [FTYPE /SKP IF FILE IS ASCII |
| 1663 | JMP I [ILOOP /NO-COMMA FUNCTION IS A NOP |
| 1664 | TAD COMMAS /GET COMMA SWITCH |
| 1665 | SNA CLA /WAS LAST THING PRINTED A COMMA? |
| 1666 | JMP .+3 /NO-WE ARE OK |
| 1667 | TAD (" /YES-PRINT A SPACE BEFORE DOING COMMA CALCULATION |
| 1668 | JMS I [PUTCH |
| 1669 | IAC |
| 1670 | DCA COMMAS /SET COMMA SWITCH |
| 1671 | TAD (-4 |
| 1672 | DCA TEMP2 |
| 1673 | TAD I IOTPOS /GET NUMBER OF CHARS PRINTED SO FAR |
| 1674 | COMLOP, TAD (-COLWID |
| 1675 | SPA /PAST THIS ONE? |
| 1676 | JMP SLOVER /YES-SLIDE PRINT HEAD TO START OF NEXT |
| 1677 | SNA /EXACTLY ON A COLUMN? |
| 1678 | JMP I [ILOOP /YES-DONE |
| 1679 | ISZ TEMP2 /ALL MARKERS CHECKED YET? |
| 1680 | JMP COMLOP /NO-DO NEXT |
| 1681 | 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 | CRFUNC, TAD I IOTHDR |
| 1687 | CLL RTR |
| 1688 | SNL CLA /SKP IF EOF IS SET |
| 1689 | JMS I [FTYPE /SKP IF FILE IS ASCII |
| 1690 | JMP I [ILOOP /WE DON'T WANT TO OUTPUT CLFR |
| 1691 | JMS I [CRLFR /DO AS WE ARE TOLD |
| 1692 | JMP I [ILOOP /NEXT INST |
| 1693 | |
| 1694 | /TAB FUNCTION |
| 1695 | |
| 1696 | TAB, JMS I [UNSFIX /FIX X TO INTEGER |
| 1697 | CIA /NEGATE |
| 1698 | TAD I IOTPOS /COMPARE DESIRED COLUMN TO REAL COLUMN |
| 1699 | IAC /BUMP BY 1 (WORD 7=COL #-1) |
| 1700 | SMA /IS X>=CURRENT COLUMN? |
| 1701 | JMP I [ILOOP /YES-THEN DO NOTHING |
| 1702 | /FALL INTO SPACE OUT ROUTINE |
| 1703 | |
| 1704 | SLOVER, DCA COLCNT /-# OF COLUMNS TO NEXT MARKER |
| 1705 | JMS I [FTYPE /IS FILE NUMERIC? |
| 1706 | JMP I [ILOOP /YES-THIS IS A NOP |
| 1707 | TAD (" /GET SPACE |
| 1708 | JMS I [PUTCH /PRINT IT |
| 1709 | ISZ COLCNT /THERE YET? |
| 1710 | JMP .-3 /NO-TYPE ANOTHER SPACE |
| 1711 | JMP I [ILOOP /YES-DONE |
| 1712 | |
| 1713 | COMMAS, 1 /SET TO 1 IF LAST PRINT WAS A COMMA MOVE |
| 1714 | COLCNT, 0 |
| 1715 | |
| 1716 | /ROUTINE TO CALL ERROR ROUTINE BY FAKING A FUNC2 CALL TO FUNCTION #10 |
| 1717 | |
| 1718 | ERROR, 0 |
| 1719 | CLA CLL IAC /ENTRY AC RANDOM |
| 1720 | AND PSFLAG /TEST IF OS/8 17600 RESIDENT |
| 1721 | SZA CLA /SKP IF NOT |
| 1722 | JMS I [PSWAP /ELSE FORCE IT OUT (THESE ERRORS ARE FATAL) |
| 1723 | TAD (7607 |
| 1724 | DCA INSAV /FAKE A FUNC CALL TO FUNC2 #10 |
| 1725 | JMP I (FUNC2I |
| 1726 | XERRRET,JMP I ERROR /RETURN TO CALLER IF NON FATAL ERROR |
| 1727 | |
| 1728 | /FLOATING NEGATE |
| 1729 | |
| 1730 | FNEGI, JMS I [FFNEG /CALL NEGATE ROUTINE |
| 1731 | JMP I [ILOOP /RETURN TO ILOOP |
| 1732 | |
| 1733 | NUMBUF, ZBLOCK 6 /6 DIGIT BUFFER USED BY FFOUT |
| 1734 | |
| 1735 | PAGE |
| 1736 | \f /INCREMENT AND LOAD 6BIT BYTE FROM MEMORY |
| 1737 | |
| 1738 | LDB, 0 |
| 1739 | JMS BUMP /INCREMENT POINTER AND SET DF |
| 1740 | TAD I BYTPTR /PICK UP BYTE |
| 1741 | CDF |
| 1742 | ISZ BYTSWT /TEST HALFWORD SWITCH |
| 1743 | JMP .+4 |
| 1744 | CLL RTR |
| 1745 | RTR |
| 1746 | RTR |
| 1747 | AND [77 /MASK TO 6BIT |
| 1748 | JMP I LDB /RETURN WITH CHAR IN AC |
| 1749 | |
| 1750 | /INCREMENT AND DEPOSIT BYTE IN MEMORY |
| 1751 | |
| 1752 | DPB, 0 |
| 1753 | AND [77 /MASK TO 6BIT NOW |
| 1754 | DCA BYTE |
| 1755 | JMS BUMP /INCREMENT POINTER AND SET DF |
| 1756 | TAD [77 /GET MASK |
| 1757 | ISZ BYTSWT /SKP IF PTR BUMPED |
| 1758 | CMA CML /ELSE PRESERVE LEFT HALF |
| 1759 | AND I BYTPTR /ZERO OUT TARGET BYTE |
| 1760 | DCA I BYTPTR |
| 1761 | TAD BYTE /GET BYTE |
| 1762 | SZL |
| 1763 | JMP .+4 /JMP IF NO SHIFT |
| 1764 | CLL RTL |
| 1765 | RTL |
| 1766 | RTL |
| 1767 | TAD I BYTPTR |
| 1768 | DCA I BYTPTR /STORE BYTE |
| 1769 | CDF |
| 1770 | ISZ BYTCNT /TALLY NUMBER OF BYTES STORED |
| 1771 | JMP I DPB /--RETURN-- |
| 1772 | |
| 1773 | /BUMP BYTE POINTER |
| 1774 | |
| 1775 | BUMP, 0 |
| 1776 | TAD BYTSWT /BUMP LOW ORDER BIT |
| 1777 | CLL CMA |
| 1778 | DCA BYTSWT |
| 1779 | ISZ BYTSWT /SKP IF NO CARRY |
| 1780 | ISZ BYTPTR /ELSE BUMP WORD PTR |
| 1781 | JMP BYTCDF /JMP OUT IF FIELD NOT CROSSED |
| 1782 | TAD [10 |
| 1783 | TAD BYTCDF |
| 1784 | DCA BYTCDF /PROPAGATE CARRY INTO CDF INSTR |
| 1785 | BYTCDF, 0 /GETS SET BY BYTSET TO TARGET FIELD |
| 1786 | JMP I BUMP /RETURN WITH A CLEAR LINK |
| 1787 | |
| 1788 | /BYTE LOAD/STORE INITIALIZE ROUTINE |
| 1789 | |
| 1790 | BYTSET, 0 |
| 1791 | TAD SSTEX /GET FIELD OF STRING |
| 1792 | DCA BYTCDF /STORE INLINE |
| 1793 | TAD STRPTR /NOW GET ADDR OF COUNT WORD |
| 1794 | DCA BYTPTR /STORE |
| 1795 | IAC |
| 1796 | DCA BYTSWT /SET LOW ORDER BIT TO CARRY NEXT TIME |
| 1797 | DCA BYTCNT /CLEAR DEPOSITED BYTE COUNT |
| 1798 | TAD [SAC-1 |
| 1799 | DCA SACXR /ALWAYS RETURN WITH SAC POINTER SET UP |
| 1800 | JMP I BYTSET /--RETURN-- |
| 1801 | |
| 1802 | /STRING STORE EXIT ROUTINE |
| 1803 | |
| 1804 | SSTEX, 0 /GETS SET BY STFIND TO DF OF STRING |
| 1805 | TAD BYTCNT /ENTER WITH POSITIVE LENGTH IN COUNT |
| 1806 | CIA |
| 1807 | DCA I STRPTR /STORE IN STRING |
| 1808 | JMP I [ILOOP /--RETURN-- (ILOOP RESETS DF) |
| 1809 | |
| 1810 | BYTCNT, 0 |
| 1811 | BYTPTR, 0 |
| 1812 | BYTSWT, 0 |
| 1813 | BYTE, 0 |
| 1814 | \f/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 | BUFCHK, 0 |
| 1822 | TAD ENTNO /GET DEVICE # |
| 1823 | SNA CLA /IS IT TTY? |
| 1824 | TAD (62-400 /YES-CHECK FOR A BUFFER 60 WORDS LONG |
| 1825 | TAD [400 /NO-CHECK FOR A BUFFER 400 WORDS LONG |
| 1826 | TAD I IOTBUF /ADD LENGTH TO BUFFER ADDRESS |
| 1827 | CIA /-ADDR OF END OF BUFFER |
| 1828 | TAD I IOTPTR /CHECK AGAINST CURRENT POINTER |
| 1829 | SNA /IS POINTER AT END OF BUFFER? |
| 1830 | JMP EBC /AT END-CHECK THE CHAR # |
| 1831 | ISZ BUFCHK |
| 1832 | ISZ BUFCHK /NO-BUMP RETURN |
| 1833 | IAC |
| 1834 | SNA CLA /WAS POINTER AT LAST WORD? |
| 1835 | JMP I BUFCHK /YES-RETURN TO CALL+3 |
| 1836 | ISZ BUFCHK /NO |
| 1837 | JMP I BUFCHK /RETURN TO CALL+4 |
| 1838 | |
| 1839 | EBC, JMS I [CHARNO /GET CHAR # |
| 1840 | JMP I BUFCHK /IT WAS 1-RETURN TO CALL+1 |
| 1841 | NOP /IT WAS 3-RETURN TO CALL+2 |
| 1842 | ISZ BUFCHK /IT WAS 2-RETURN TO CALL+2 |
| 1843 | JMP I BUFCHK |
| 1844 | \f |
| 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 | PACKCH, 0 |
| 1849 | DCA TEMP1 /SAVE |
| 1850 | JMS I [CHARNO /DETERMINE CHARACTER NUMBER |
| 1851 | SKP /1 |
| 1852 | JMP CHAR3P /3 |
| 1853 | TAD TEMP1 /1 OR 2-GET CHAR AGAIN |
| 1854 | JMS I [WRITFL /STORE IN BUFFER |
| 1855 | JMS I (CNOBML /BUMP CHARACTER NUMBER |
| 1856 | JMP I PACKCH /DONE |
| 1857 | |
| 1858 | CHAR3P, AC7776 |
| 1859 | TAD I IOTPTR /BACK BUFFER POINTER UP TO POINT TO CHAR 1 |
| 1860 | DCA I IOTPTR |
| 1861 | TAD TEMP1 /CHAR |
| 1862 | CLL RTL |
| 1863 | RTL /SLIDE LEFT HALF INTO BITS 0-3 |
| 1864 | DCA TEMP1 /SAVE |
| 1865 | TAD TEMP1 |
| 1866 | JMS COMBNE /ISOLATE LEFT HALF,COMBINE WITH CHAR1,AND PUT IN FILE |
| 1867 | TAD TEMP1 /CHAR AGAIN |
| 1868 | CLL RTL |
| 1869 | RTL /SLIDE RIGHT HALF INTO BITS 0-3 |
| 1870 | JMS COMBNE /ISOLATE RIGHT HALF,COMBINE WITH CHAR 2,AND PUT IN FILE |
| 1871 | JMS I [CNOCLR /CLEAR THE CHARACTER NUMBER (RESET IT TO 1) |
| 1872 | JMP I PACKCH /DONE |
| 1873 | |
| 1874 | COMBNE, 0 |
| 1875 | AND [7400 /ISOLATE HALF IN QUESTION |
| 1876 | DCA TEMP2 /SAVE |
| 1877 | JMS I (BCGET /GET A WORD FROM FILE BUFFER IN FIELD 1 |
| 1878 | AND [377 /FLUSH ANY SLUSH IN BITS 0-3 |
| 1879 | TAD TEMP2 /COMBINE |
| 1880 | JMS I [WRITFL /PUT IN BUFFER |
| 1881 | JMP I COMBNE /RETURN |
| 1882 | |
| 1883 | PAGE |
| 1884 | \f/ROUTINE TO READ WORD FROM FILE BUFFER AND BUMP POINTER |
| 1885 | |
| 1886 | READFL, 0 |
| 1887 | JMS I (FOTYPE /IS FILE VARIABLE LENGTH |
| 1888 | SKP |
| 1889 | VR, JMS I [ERROR /YES-IT IS AN ERROR TO TRY AND READ IT |
| 1890 | TAD I IOTHDR /CHECK IF MORE THERE |
| 1891 | CLL RTR /EOF BIT TO LINK |
| 1892 | SNL CLA /EOF? |
| 1893 | JMP .+3 /NO-CONTINUE |
| 1894 | RE, JMS I [ERROR /YES-ATTEMPT TO READ BEYOND EOF |
| 1895 | JMP I [ILOOP /NOT FATAL-RETURN TO I LOOP |
| 1896 | JMS BCGET /GET WORD FROM FILE BUFFER |
| 1897 | ISZ I IOTPTR /BUMP POINTER |
| 1898 | JMP I READFL /DONE |
| 1899 | |
| 1900 | /ROUTINE TO WRITE AC IN FILE BUFFER AND INCREMENT POINTER |
| 1901 | |
| 1902 | WRITFL, 0 |
| 1903 | JMS I (BCPUT /STORE AC IN FILE BUFFER |
| 1904 | ISZ I IOTPTR /BUMP POINTER |
| 1905 | TAD I IOTHDR /GET FILE HEADER WORD |
| 1906 | CLL RTR /EOF BIT TO LINK |
| 1907 | SNL CLA /WAS FILE PAST END? |
| 1908 | JMP I WRITFL /NO-RETURN |
| 1909 | WE, JMS I [ERROR /YES-ATTEMPT TO WRITE PAST END OF FILE |
| 1910 | JMP I [ILOOP /NON-FATAL RETURN TO ILOOP |
| 1911 | |
| 1912 | /ROUTINE TO GET ONE WORD FROM FILE BUFFER IN FIELD 1 |
| 1913 | |
| 1914 | BCGET, 0 |
| 1915 | JMS I [IDLE /CHECK IF FILE OPEN |
| 1916 | TAD I IOTPTR /GET READ WRITE POINTER |
| 1917 | DCA WRITFL /SAVE |
| 1918 | TAD ENTNO /GET FILE # |
| 1919 | SZA CLA /IF TTY,BUFFER FIELD IS 0 |
| 1920 | CDF 10 /DF TO BUFFER FIELD |
| 1921 | TAD I WRITFL /GET WORD FROM BUFFER |
| 1922 | CDF |
| 1923 | JMP I BCGET /RETURN |
| 1924 | \f/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 | UNPACK, 0 |
| 1928 | JMS I [CHARNO /GET CHAR # |
| 1929 | SKP /1 |
| 1930 | JMP CHAR3U /3 |
| 1931 | JMS I (CNOBML /BUMP CHAR NUMBER |
| 1932 | JMS READFL /GET CHAR AGAIN |
| 1933 | U123C, AND [177 /STRIP OFF 7 BITS |
| 1934 | SNA |
| 1935 | JMP UNPACK+1 /ZERO |
| 1936 | TAD [200 |
| 1937 | DCA CHAR /SAVE |
| 1938 | TAD CHAR |
| 1939 | TAD (-232 /IS IT CTRL/Z? |
| 1940 | SNA CLA |
| 1941 | JMP I [EOFSET /YES-SET EOF BIT |
| 1942 | JMP I UNPACK /RETURN |
| 1943 | |
| 1944 | CHAR3U, JMS I [CNOCLR /RESET CHAR # TO 1 |
| 1945 | AC7776 |
| 1946 | TAD I IOTPTR |
| 1947 | DCA I IOTPTR /BACK BUFFER POINTER UP 2 |
| 1948 | JMS READFL /GET LEFT HALF OF CHAR |
| 1949 | AND [7400 |
| 1950 | DCA XR5 /SAVE |
| 1951 | JMS READFL /GET NEXT WORD WITH RIGHT HALF |
| 1952 | AND [7400 /ISOLATE RIGHT HALF |
| 1953 | CLL RTR |
| 1954 | RTR /SLIDE RIGHT HALF OVER |
| 1955 | TAD XR5 /COMBINE WITH LEFT HALF |
| 1956 | CLL RTR |
| 1957 | RTR /MOVE TO BITS 4-11 |
| 1958 | JMP U123C /REJOIN MAINLINE |
| 1959 | \f/READ FUNCTION-GETS NUMBERS INTO VARIABLES |
| 1960 | |
| 1961 | READI, JMS I [FTYPE /SKP IF FILE IS ASCII |
| 1962 | JMP RIMAGE /READ NUMERIC IMAGE |
| 1963 | JMS I (FFIN /READ ASCII INTO NUMBER |
| 1964 | JMP I [ILOOP /--RETURN-- |
| 1965 | RIMAGE, JMS I [BUFCHK /YES-CHECK BUFFER POINTER |
| 1966 | NOP /PAST END-NEXT RECORD |
| 1967 | NOP /AT END-NEXT RECORD |
| 1968 | JMS I [NEXREC /ONLY 1 WORD LEFT-IT IS UNUSED IN NUMERIC FMT |
| 1969 | JMS READFL /GET WORD FROM FILE |
| 1970 | DCA ACX /STORE AS EXPONENT |
| 1971 | JMS READFL /GET WORD FROM FILE |
| 1972 | DCA ACH /STORE AS HIGH MANTISSA |
| 1973 | JMS READFL /GET WORD FROM FILE |
| 1974 | DCA ACL /STORE AS LOW MANTISSA |
| 1975 | JMP I [ILOOP /DONE |
| 1976 | |
| 1977 | /ROUTINE TO FETCH ASCII CHARACTERS FROM FILE BUFFER |
| 1978 | |
| 1979 | GETCH, 0 |
| 1980 | JMS I [FTYPE /IS FILE ASCII? |
| 1981 | SR, JMS I [ERROR /NO-ERROR |
| 1982 | TAD ENTNO |
| 1983 | SZA CLA |
| 1984 | JMP NTTY |
| 1985 | TAD TCHAR |
| 1986 | TAD [-215 |
| 1987 | SNA CLA |
| 1988 | JMS I [DRCALL |
| 1989 | NTTY, JMS I [BUFCHK /NO-CHECK STATUS OF BUFFER |
| 1990 | JMS I [NEXREC /LAST CHAR READ-NEXT RECORD |
| 1991 | NOP /CHAR 3 NOT USED YET |
| 1992 | TCHAR, 215 /NOP: CHAR 2 AND 3 LEFT |
| 1993 | JMS UNPACK /UNPACK CHAR FROM BUFFER |
| 1994 | TAD ENTNO |
| 1995 | SZA CLA |
| 1996 | JMP I GETCH /RETURN |
| 1997 | TAD CHAR |
| 1998 | DCA TCHAR |
| 1999 | 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 | CHARNO, 0 |
| 2005 | TAD I IOTHDR /HEADER |
| 2006 | AND (300 /ISOLATE CHAR # |
| 2007 | CLL RTL |
| 2008 | RTL /CHAR # TO BITS 0,1 |
| 2009 | SMA SZA /IS IT 2? |
| 2010 | ISZ CHARNO /YES-BUMP RETURN |
| 2011 | SZA CLA /IS IT 2 OR 3? |
| 2012 | ISZ CHARNO /YES-BUMP RETURN |
| 2013 | JMP I CHARNO /RETURN |
| 2014 | |
| 2015 | PAGE |
| 2016 | \f/WRITE FUNCTION-PUTS NUMBERS IN FILE BUFFERS |
| 2017 | |
| 2018 | WRITEI, JMS I [FTYPE /SKP IF FILE IS ASCII |
| 2019 | JMP WIMAGE /ELSE DO IMAGE WRITE |
| 2020 | JMS I (FFOUT /CONVERT INTERNAL TO ASCII |
| 2021 | TAD XR1 |
| 2022 | CIA |
| 2023 | TAD (INTERB-1 /CALCULATE NUMBER OF CHARS STORED IN BUFFER |
| 2024 | DCA TEMP10 /SAVE |
| 2025 | TAD (INTERB-1 |
| 2026 | DCA SACXR /NOW POINT SACXR INTO BUFFER |
| 2027 | TAD TEMP10 /GET COUNT OF CHARS TO BE PRINTED |
| 2028 | CIA |
| 2029 | TAD I IOTPOS /ADD TO PRINT HEAD POSITION |
| 2030 | TAD (-WIDTH /COMPARE AGAINST "72" |
| 2031 | SMA SZA CLA /WILL THE NUMBER FIT ON THIS LINE? |
| 2032 | JMS I [CRLFR /NO-ISSUE A CR,LF |
| 2033 | CPLOOP, TAD I SACXR /GET CHAR FROM INTERMEDIATE BUFFER |
| 2034 | JMS PUTCH /PUT ON DEVICE |
| 2035 | ISZ TEMP10 /BUMP COUNTER |
| 2036 | JMP CPLOOP /NEXT |
| 2037 | TAD O240 |
| 2038 | JMS PUTCH /SEND OUT A SPACE AFTER NUMBER |
| 2039 | JMP WDONE /TAKE COMMON EXIT |
| 2040 | WIMAGE, JMS I [BUFCHK /FILE IS NUMERIC-CHECK BUFFER STATUS |
| 2041 | O240, 240 /PAST END-NEW RECORD (AND INST SERVES AS NOP) |
| 2042 | O210, 0210 /AT END-NEW RECORD (AND SERVES AS NOP) |
| 2043 | JMS I [NEXREC /ONE WORD LEFT-DON'T USE IT |
| 2044 | TAD ACX /EXPONENT |
| 2045 | JMS I [WRITFL /WRITE IN BUFFER |
| 2046 | TAD ACH /HIGH MANTISSA |
| 2047 | JMS I [WRITFL /WRITE IN BUFFER |
| 2048 | TAD ACL /LOW MANTISSA |
| 2049 | JMS I [WRITFL /WRITE IN BUFFER |
| 2050 | WDONE, DCA I (COMMAS /CLEAR COMMA SWITCH |
| 2051 | JMP I [ILOOP /WRITE IS DONE |
| 2052 | \f/ROUTINE TO PUT ASCII CHARS IN FILE BUFFER. IGNORES RUBOUTS. |
| 2053 | |
| 2054 | PUTCH, 0 |
| 2055 | DCA TEMP1 /SAVE CHAR |
| 2056 | TAD TEMP1 /GET CHAR AGAIN |
| 2057 | TAD (-377 |
| 2058 | SNA CLA /IS IT A RUBOUT? |
| 2059 | JMP I PUTCH /YES-RETURN |
| 2060 | JMS I [FTYPE /IS FILE NUMERIC? |
| 2061 | SW, JMS I [ERROR /YES-ERROR |
| 2062 | ISZ I IOTPOS /BUMP COULMN NUMBER |
| 2063 | TAD ENTNO /GET ENTRY # |
| 2064 | SNA CLA /IS IT TTY? |
| 2065 | JMP TOUT /YES-JUST PUT CHARS IN RING BUFFER |
| 2066 | JMS I [BUFCHK /NO-IS BUFFER FULL? |
| 2067 | JMS I [NEXREC /YES-NEXT RECORD |
| 2068 | O40, 40 /THERE IS A CHAR 3 LEFT (AND IS A NOP) |
| 2069 | O20, 20 /THERE IS A CHAR 2 AND 3 LEFT (AND IS A NOP) |
| 2070 | TAD TEMP1 /GET CHAR AGAIN |
| 2071 | JMS I [PACKCH /PUT IN BUFFER |
| 2072 | JMP I PUTCH /RETURN |
| 2073 | |
| 2074 | TOUT, TAD TEMP1 /GET CHAR |
| 2075 | JMS I [XPUTCH /PUTCH CHAR IN OUTPUT BUFFER FOR TTY |
| 2076 | JMP I PUTCH /RETURN |
| 2077 | \f/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 | NEXREC, 0 |
| 2082 | TAD I IOTHDR /GET HEADER |
| 2083 | AND O20 /GET READ/WRITE ONLY BIT |
| 2084 | SNA CLA /IS IT ON? |
| 2085 | JMP FILSTR /NO-DEVICE IS FILE STRUCTURED |
| 2086 | JMS I (FOTYPE /YES-IS IT INPUT OR OUTPUT FILE? |
| 2087 | JMP RONLY |
| 2088 | JMS WRBLK |
| 2089 | RWONC, ISZ I IOTBLK |
| 2090 | JMS BLINIT /INIT FILE TABLE ENTRIES |
| 2091 | JMP I NEXREC /DONE |
| 2092 | |
| 2093 | RONLY, JMS BLREAD |
| 2094 | JMP RWONC |
| 2095 | |
| 2096 | FILSTR, JMS WRBLK /WRITE THE CURRENT BLOCK IF IT HAS BEEN CHANGED |
| 2097 | JMS BLINIT /INIT FILE TABLE ENTRIES |
| 2098 | ISZ I IOTBLK /BUMP BLOCK # |
| 2099 | TAD I IOTLOC /STARTING BLOCK |
| 2100 | CIA /NEGATE |
| 2101 | TAD I IOTBLK /SUBTRACT FROM CURRENT BLOCK FOR FILE LENGTH |
| 2102 | CLL CMA /SET UP CURRENT FILE LENGTH FOR 12 BIT COMPARE |
| 2103 | TAD I IOTLEN /COMPARE TO ACTUAL LENGTH |
| 2104 | SNL CLA /IS IT > CURRENT LENGTH? |
| 2105 | JMP LASTB /YES-EXTEND THE FILE IF IT IS OUTPUT |
| 2106 | JMS BLREAD /READ IN THE NEXT RECORD |
| 2107 | JMP I NEXREC /RETURN |
| 2108 | |
| 2109 | |
| 2110 | LASTB, JMS I (FOTYPE /IS FILE FIXED LENGTH? |
| 2111 | JMP I [EOFSET /YES-SET EOF FLAG |
| 2112 | TAD I IOTLEN /NO-GET ACTUAL LENGTH |
| 2113 | CLL CMA |
| 2114 | TAD I IOTMAX /MAXIMUM LENGTH |
| 2115 | SNL CLA /IS ACTUAL LENGTH >= MAXIMUM LENGTH? |
| 2116 | JMP I [EOFSET /YES-SET EOF BITS |
| 2117 | ISZ I IOTLEN /NO-BUMP ACTUAL LENGTH |
| 2118 | JMP I NEXREC /RETURN WITHOUT READING NEXT RECORD |
| 2119 | \f/ROUTINE TO READ 2 PAGES FROM DEVICE |
| 2120 | |
| 2121 | BLREAD, 0 |
| 2122 | JMS I (BLZERO |
| 2123 | TAD O210 /"READ 2 PAGES" |
| 2124 | JMS I [DRCALL /HANDLER CALL |
| 2125 | JMP I BLREAD |
| 2126 | |
| 2127 | /ROUTINE TO WRITE 2 PAGES ONTO DEVICE |
| 2128 | |
| 2129 | WRBLK, 0 |
| 2130 | TAD I IOTHDR /GET FILE HEADER |
| 2131 | AND O40 /GET FILE WRITTEN BIT |
| 2132 | SNA CLA /HAS THIS BLOCK BEEN CHANGED? |
| 2133 | JMP I WRBLK /NO-RETURN |
| 2134 | TAD (4210 /"WRITE 2 PAGES" |
| 2135 | JMS I [DRCALL /CALL TO DEVICE HANDLER |
| 2136 | JMS I (BLZERO |
| 2137 | JMP I WRBLK |
| 2138 | |
| 2139 | /ROUTINE TO INITIALIZE I/O TABLE ENTRIES AFTER READ OR WRITE |
| 2140 | |
| 2141 | BLINIT, 0 |
| 2142 | TAD I IOTBUF |
| 2143 | DCA I IOTPTR /INIT READ/WRITE POINTER |
| 2144 | TAD I IOTHDR |
| 2145 | AND (7437 /SET CHAR # TO 1 AND CLEAR BLOCK WRITTEN BIT |
| 2146 | DCA I IOTHDR |
| 2147 | JMP I BLINIT |
| 2148 | |
| 2149 | /ROUTINE TO SAVE THE FAC IN FP TEMP |
| 2150 | |
| 2151 | FACSAV, 0 |
| 2152 | JMS I [FFPUT /STORE FAC |
| 2153 | INTERB /USE INTERMEDIATE BUFFER FOR TEMP STORAGE |
| 2154 | JMP I FACSAV /RETURN |
| 2155 | |
| 2156 | PAGE |
| 2157 | \f |
| 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 | \f///////////////////////////////////////////////////////////// |
| 2173 | ///////////////////////////////////////////////////////////// |
| 2174 | ////////////// OVERLAY 1-ARITHMETIC FUNCTIONS /////////////// |
| 2175 | ///////////////////////////////////////////////////////////// |
| 2176 | ///////////////////////////////////////////////////////////// |
| 2177 | |
| 2178 | *OVERLAY |
| 2179 | |
| 2180 | |
| 2181 | |
| 2182 | /INTEGER FUNCTION |
| 2183 | /RANGE=ALL X |
| 2184 | |
| 2185 | INT, VERSON^100+SUBVAF+6000 /INITIALLY CONTAINS VERSION OF ARITH OVERLAY |
| 2186 | JMS I [FFPUT /SAVE X |
| 2187 | FPPTM1 |
| 2188 | TAD ACX /GET EXPONENT |
| 2189 | SMA SZA CLA /IS EXP<0? |
| 2190 | JMP INSC /NO-GO ON |
| 2191 | TAD ACH /YES |
| 2192 | SPA CLA /IS X<0? |
| 2193 | JMP M1R /YES-INT=-1 |
| 2194 | JMS I [FACCLR /YES-RETURN A 0 |
| 2195 | JMP I INT |
| 2196 | INSC, TAD ACH /GET HI MANTISSA |
| 2197 | SMA CLA /IS IT <0? |
| 2198 | JMP INTPOS /NO-USE FAC AS IS |
| 2199 | JMS I [FFNEG /YES-NEGATE FAC (MAKE IT POS) |
| 2200 | IAC /AND SET FLAG |
| 2201 | INTPOS, DCA TEMP3 /FLAG FOR NEGATIVE |
| 2202 | DCA TEMP5 /ZERO LORD MASK |
| 2203 | CLL CML RAR |
| 2204 | DCA TEMP4 /INITIALIZE HORD MASK TO 4000 |
| 2205 | TAD ACX |
| 2206 | CIA /- COUNT |
| 2207 | DCA TEMP2 |
| 2208 | MASKL, TAD TEMP4 |
| 2209 | CLL CML RAR /ROTATE 1'S THROUGH 3 WORD MASK |
| 2210 | DCA TEMP4 / |
| 2211 | TAD TEMP5 /UNTIL THERE IS A COUNT OF ZERO |
| 2212 | RAR |
| 2213 | DCA TEMP5 |
| 2214 | ISZ TEMP2 /DONE? |
| 2215 | JMP MASKL /NO |
| 2216 | TAD ACH /YES-MASK HORD |
| 2217 | AND TEMP4 |
| 2218 | DCA ACH |
| 2219 | TAD ACL /MASK LORD |
| 2220 | AND TEMP5 |
| 2221 | DCA ACL |
| 2222 | TAD TEMP3 /NEG FLAG |
| 2223 | SNA CLA /WAS ORIGINAL NUMER <0? |
| 2224 | JMP I INT /NO-DONE |
| 2225 | JMS I [FFPUT /SAVE INT(X) |
| 2226 | FPPTM2 |
| 2227 | JMS I (FFADD /-INT(X)+(X) |
| 2228 | FPPTM1 |
| 2229 | TAD ACH /SAVE HORD |
| 2230 | DCA TEMP3 |
| 2231 | JMS I [FACCLR /FLUSH FAC |
| 2232 | TAD TEMP3 /WAS INT(X)=X? |
| 2233 | SNA CLA |
| 2234 | JMP JUSNEG /YES-JUST NEGATE INT(X) |
| 2235 | JMS I (FFADD /NO-ADD 1 |
| 2236 | ONE |
| 2237 | JUSNEG, JMS I (FFADD /GET INT(X) |
| 2238 | FPPTM2 |
| 2239 | JNEG, JMS I [FFNEG /AND NEGATE (INT(5.3)=-6) |
| 2240 | JMP I INT /DONE |
| 2241 | |
| 2242 | M1R, JMS I [FFGET /LOAD FAC WITH 1 |
| 2243 | ONE |
| 2244 | JMP JNEG /JUST NEGATE AND RETURN |
| 2245 | |
| 2246 | ONE, 1 |
| 2247 | 2000 |
| 2248 | 0 |
| 2249 | |
| 2250 | \f/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 | EXPON, 0 |
| 2260 | JMS I [FFPUT /SAVE A |
| 2261 | FPPTM5 |
| 2262 | JMS I [FFPUT /SET UP RUNNING PRODUCT IN CASE OF |
| 2263 | FPPTM4 /MULTIPLIES |
| 2264 | TAD ACH /HI ORDER OF A |
| 2265 | DCA EXPON /SAVE IT |
| 2266 | DCA INSAV /POINTER TO B IN SYMBOL TABLE |
| 2267 | JMS I ARGPLL /FIND B |
| 2268 | JMS I [FFGET /GET B |
| 2269 | ARGPLL, ARGPRE /LOC SKIPPED BY FPP,SO WE USE IT FOR CONSTANT |
| 2270 | CDF |
| 2271 | TAD ACH /HI ORDER OF B |
| 2272 | SNA /IS B=0? |
| 2273 | JMP I (RETRN1 /YES A^B=1 |
| 2274 | SMA CLA /IS B<0? |
| 2275 | JMP .+4 /NO |
| 2276 | TAD EXPON /YES-GET HI ORDER A |
| 2277 | SNA CLA /IS A=0? |
| 2278 | JMP I (DV /YES-DIVIDE BY ZERO ERROR |
| 2279 | TAD EXPON /B>0. IS A=0? |
| 2280 | SNA CLA |
| 2281 | JMP RET0 /YES A^B=0 |
| 2282 | JMS I [FFPUT /SAVE B |
| 2283 | FPPTM3 |
| 2284 | JMS INT /GET INT(B) |
| 2285 | JMS I (MULLIM /TEST EXPONENT OF RESULT TO LIMIT LARGE MULTIPLY LOOPS |
| 2286 | JMS I (FFSUB /INT(B)-B |
| 2287 | FPPTM3 |
| 2288 | TAD ACH /IS INT(B)-B=0? |
| 2289 | SZA CLA |
| 2290 | JMP I (USELOG /NO-USE LOGS |
| 2291 | JMS I [FFGET /NO-USE REPETITIVE MULTIPLY |
| 2292 | FPPTM3 /GET B AGAIN |
| 2293 | TAD ACH |
| 2294 | DCA EXPON /SAVE SIGN OF B |
| 2295 | JMS I (ABSVAL /!B! |
| 2296 | JMS I [FFPUT /USE ABS(B) AS MULTIPLY COUNT |
| 2297 | FPPTM3 |
| 2298 | EMLOOP, JMS I [FFGET /GET B |
| 2299 | FPPTM3 |
| 2300 | JMS I (FFSUB /B-1 |
| 2301 | ONE |
| 2302 | JMS I [FFPUT /SAVE NEW COUNT |
| 2303 | FPPTM3 |
| 2304 | TAD ACH |
| 2305 | SNA CLA /IS COUNT ZERO YET |
| 2306 | JMP I (EMDONE /YES-MULTIPLIES ARE DONE |
| 2307 | JMS I [FFGET /NO-GET RUNNING PRODUCT |
| 2308 | FPPTM4 |
| 2309 | JMS I (FFMPY /MULTIPLY BY A |
| 2310 | FPPTM5 |
| 2311 | JMS I [FFPUT /SAVE NEW RUNNING PRODUCT |
| 2312 | FPPTM4 |
| 2313 | JMP EMLOOP |
| 2314 | |
| 2315 | RET0, JMS I [FACCLR /RETURN WITH 0 IN FAC |
| 2316 | JMP I [ILOOP |
| 2317 | |
| 2318 | PAGE |
| 2319 | \fEMDONE, JMS I [FFGET /GET RUNNING PRODUCT |
| 2320 | FPPTM4 |
| 2321 | TAD I EXPONK /GET SIGN OF B |
| 2322 | SMA CLA /WAS IT -? |
| 2323 | JMP I [ILOOP /NO-A^B=A*A*A*...*A |
| 2324 | JMS I FIDVP /YES-INVERT |
| 2325 | ONE |
| 2326 | JMP I [ILOOP /A^B=1/A:A*A*...*A |
| 2327 | |
| 2328 | RETRN1, JMS I [FFGET |
| 2329 | ONE /SET FAC TO 1 |
| 2330 | JMP I [ILOOP |
| 2331 | |
| 2332 | USELOG, TAD I EXPONK /SIGN OF A |
| 2333 | SPA CLA /A<0? |
| 2334 | EM, JMS I [ERROR /YES-PRINT A MESSAGE |
| 2335 | JMS I [FFGET /LOAD A |
| 2336 | FPPTM5 |
| 2337 | JMS I FFLOGL /LOG(A) |
| 2338 | JMS I FMPYLV /B*LOG(A) |
| 2339 | FPPTM3 |
| 2340 | JMS I FFEXPL /EXP(B*LOG(A)) |
| 2341 | JMP I [ILOOP /DONE |
| 2342 | |
| 2343 | |
| 2344 | FFEXPL, EXPON1 |
| 2345 | FFLOGL, LOG |
| 2346 | FMPYLV, FFMPY |
| 2347 | EXPONK, EXPON |
| 2348 | FIDVP, FFDIV1 |
| 2349 | |
| 2350 | /SGN FUNCTION |
| 2351 | |
| 2352 | SGN, 0 |
| 2353 | TAD ACH /GET HIGH MANTISSA |
| 2354 | SNA /IS X=ZERO? |
| 2355 | JMP I [ILOOP /YES-THEN LEAVE IT ALONE |
| 2356 | SPA CLA /IS X>0? |
| 2357 | JMP .+3 /NO |
| 2358 | IAC /YES-SET FAC=1 |
| 2359 | SKP |
| 2360 | CMA /NO-SET FAC=-1 |
| 2361 | DCA ACX /SET UP FLOAT |
| 2362 | JMS I [FFLOAT /FLOAT VALUE OF SGN FUNCTION |
| 2363 | JMP I [ILOOP /DONE |
| 2364 | \f 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 | FROOT, 0 |
| 2370 | CLA CLL CML RTR /SET RESULT TO 2000;0000 |
| 2371 | DCA AN1 |
| 2372 | DCA AN2 |
| 2373 | CDF /DF TO PACKAGE FIELD |
| 2374 | TAD KM22 /SET COUNTER FOR DEVELOPING 22 BITS OF RESULT |
| 2375 | DCA AC2 /ALREADY HAVE 1 |
| 2376 | TAD ACH |
| 2377 | SNA |
| 2378 | JMP I FROOT /ZERO FAC-NORMALIZED!-RETN. SAME |
| 2379 | SPA CLA |
| 2380 | JMS I [FFNEG /TAKE ROOT OF ABSOL VALUE |
| 2381 | TAD ACX /GET EXPONENT OF FAC |
| 2382 | SPA /IF NEGATIVE-MUST PROPAGATE SIGN |
| 2383 | CML |
| 2384 | RAR /DIVIDE EXP. BY 2 |
| 2385 | DCA ACX /STORE IT BACK |
| 2386 | SZL /INCREMENT EXP. IF ORIGINAL EXP |
| 2387 | ISZ ACX /WAS ODD |
| 2388 | NOP |
| 2389 | SNL /DO A PRE-SHIFT FOR EVEN EXPONENTS |
| 2390 | JMS I AL1K /SO FIRST BIT PAIR IS 10 NOT 01 |
| 2391 | CLA CLL CMA RAL /SET COUNTER FOR DETECTING A |
| 2392 | DCA ZCNT /ZERO REMAINDER |
| 2393 | CLA CLL CML RTR /SET UP POSITION OF TRIAL BIT |
| 2394 | RTR /FOR FIRST PASS THRU LOOP |
| 2395 | DCA OPH |
| 2396 | DCA OPL |
| 2397 | TAD K6000 /GET A FAST FIRST BIT-WE KNOW |
| 2398 | TAD ACH /THIS WILL WORK SINCE # IS NORMALIZED |
| 2399 | DCA ACH /IF # IS A POWER OF TWO, AND A PERFECT |
| 2400 | TAD ACH /SQUARE-WE ARE DONE HERE! |
| 2401 | SNA /WELL IS IT? |
| 2402 | TAD ACL /COULD BE-CHECK LOW ORDER |
| 2403 | SNA CLA |
| 2404 | JMP DONE /WHOOPPEE-WE WIN BIG. |
| 2405 | JMP LOP01 /NOPE-LOOP DON'T SHIFT FIRST TIME |
| 2406 | SLOOP, TAD OPH /SHIFT TRIAL BIT 1 PLACE |
| 2407 | CLL RAR /TO THE RIGHT |
| 2408 | DCA OPH /AND STORE BACK |
| 2409 | TAD OPL |
| 2410 | RAR |
| 2411 | DCA OPL |
| 2412 | JMS I AL1K /SHIFT FAC LEFT 1 PLACE |
| 2413 | LOP01, TAD OPL /ADD TRIAL BIT TO`ANSWER |
| 2414 | TAD AN2 /SO FAR |
| 2415 | CLL CMA IAC /NEGATE IT |
| 2416 | TAD ACL /AND ADD TO FAC (REMAINDER SO FAR) |
| 2417 | SNA /IS RESULT ZERO? |
| 2418 | ISZ ZCNT /YES-INCREMENT COUNTER |
| 2419 | DCA TM /STORE RESULT IN TEMPORARY |
| 2420 | \f CML RAL /ADD CARRY TO HIGH ORDER FOR SUBTRACT |
| 2421 | TAD OPH /ADD TRIAL BIT |
| 2422 | TAD AN1 /ADD RESULT SO FAR (HI ORDER) |
| 2423 | CLL CMA IAC /AND SUBTRACT FROM HI ORDER FAC |
| 2424 | TAD ACH |
| 2425 | SNL /RESULT NEGATIVE? |
| 2426 | JMP GON /YES-NEXT RESULT BIT IS 0 |
| 2427 | SZA /NO-IS HI ORDER RESULT=0? |
| 2428 | JMP LOP02 /NO-GO ON |
| 2429 | ISZ ZCNT /YES-WAS LOW ORDER =0? |
| 2430 | JMP .+3 /NO-GO ON |
| 2431 | CMA /YES-REM.=0-SET COUNTER SO |
| 2432 | DCA AC2 /LOOKS LIKE WE'RE DONE |
| 2433 | LOP02, DCA ACH /STORE HIGH ORDER REM. IN FAC |
| 2434 | TAD TM /STORE LO ORDER REM. IN FAC |
| 2435 | DCA ACL |
| 2436 | TAD OPL /TRIAL BIT SHIFTED LEFT 1 IS |
| 2437 | CLL RAL /RESULT BIT-ADD IT TO ROOT DEVELOPED |
| 2438 | TAD AN2 /SO FAR |
| 2439 | DCA AN2 |
| 2440 | TAD OPH |
| 2441 | RAL |
| 2442 | TAD AN1 |
| 2443 | DCA AN1 |
| 2444 | GON, CLA CLL CMA RAL /RESET COUNTER FOR ZERO REM. |
| 2445 | DCA ZCNT |
| 2446 | ISZ AC2 /DONE ALL 23 RESULT BITS? |
| 2447 | JMP SLOOP /NO-GO ON |
| 2448 | DONE, TAD AN1 /YES-STORE ANSWER IN FAC |
| 2449 | DCA ACH /ITS NORMALIZED ALREADY |
| 2450 | TAD AN2 |
| 2451 | DCA ACL |
| 2452 | JMP I FROOT /AND RETURN |
| 2453 | |
| 2454 | K6000, 6000 |
| 2455 | ZCNT, 0 |
| 2456 | AL1K, AL1 |
| 2457 | AN1, 0 |
| 2458 | AN2, 0 |
| 2459 | KM22, -26 |
| 2460 | |
| 2461 | PAGE |
| 2462 | > |
| 2463 | \f 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 | \f/23-BIT EXTENDED FUNCTIONS |
| 2556 | |
| 2557 | /1-31-72 R BEAN |
| 2558 | |
| 2559 | /******SINE****** |
| 2560 | |
| 2561 | SIN, 0 |
| 2562 | JMS NHNDLE /IF X<0,NEGATE X AND SET NFLAG |
| 2563 | JMS I (FFMPY /X*2/PI |
| 2564 | TOVPI |
| 2565 | JMS FRACT /SAVE X IN TEMP1,THE INTEGER PART OF X IN NUM,AND GET FRACTIONAL PART IN FAC |
| 2566 | TAD NUM /GET INTEGER PART OF (2/PI)*X |
| 2567 | AND (3 /ISOLATE BITS 10,11 |
| 2568 | TAD JMPISN |
| 2569 | DCA .+1 /MAKE JUMP TO ARGUMENT REDUCING ROUTINE |
| 2570 | JMP . /AND ADJUST ARG ACCORDING TO QUADRANT OF X |
| 2571 | JMPISN, JMP I .+1 |
| 2572 | POLYSN /X IN QUAD1,SIN(X)=SIN(X) |
| 2573 | QUAD2 /X IN QUAD2,SIN(X)=SIN(1-X) |
| 2574 | QUAD3 /X IN QUAD3,SIN(X)=SIN(-X) |
| 2575 | QUAD4 /X IN QUAD4,SIN(X)=SIN(X-1) |
| 2576 | |
| 2577 | QUAD2, JMS I (FFSUB1 /1-X |
| 2578 | ONE |
| 2579 | JMP POLYSN /CALCULATE SIN(1-X) |
| 2580 | QUAD3, JMS I [FFNEG /-X |
| 2581 | JMP POLYSN /CALCULATE SIN(-X) |
| 2582 | QUAD4, JMS I (FFSUB /X-1 |
| 2583 | ONE |
| 2584 | POLYSN, JMS I [FFPUT /SAVE X |
| 2585 | FPPTM1 |
| 2586 | JMS I (FFSQ /U=X**2 |
| 2587 | JMS I [FFPUT /SAVE U |
| 2588 | FPPTM2 |
| 2589 | JMS I (FFMPY /A7*U |
| 2590 | SINA7 |
| 2591 | JMS I (FFADD /A5+A7*U |
| 2592 | SINA5 |
| 2593 | JMS I (FFMPY /A5*U+A7*U**2 |
| 2594 | FPPTM2 |
| 2595 | JMS I (FFADD /A3+A5(U)+A7(U**2) |
| 2596 | SINA3 |
| 2597 | JMS I (FFMPY /A3(U)+A5(U**2)+A7(U**3) |
| 2598 | FPPTM2 |
| 2599 | JMS I (FFADD /A1+A3(U)+A5(U**2)+A7(U**3) |
| 2600 | SINA1 |
| 2601 | JMS I (FFMPY /A1(X)+A3(X**3)+A5(X**5)+A7(X**7) |
| 2602 | FPPTM1 |
| 2603 | JMS NCHK /IF NFLAG IS SET,SET SIN(X)=-SIN(X) |
| 2604 | JMP I SIN /FAC=SIN(X) |
| 2605 | |
| 2606 | |
| 2607 | /******COSINE****** |
| 2608 | /USES SIN ROUTINE TO CALCULATE COS(X) |
| 2609 | |
| 2610 | COS, 0 |
| 2611 | JMS I (FFADD /COS(X)=SIN(PI/2+X) |
| 2612 | PIOV2 |
| 2613 | JMS SIN |
| 2614 | JMP I COS /RETURN |
| 2615 | \f/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 | FRACT, 0 |
| 2620 | JMS I [FFPUT /SAVE X |
| 2621 | FPPTM1 |
| 2622 | JMS I (FFIX /INTEGER PORTION OF X |
| 2623 | TAD ACX |
| 2624 | DCA NUM /SAVE FIXED FORTION OF X |
| 2625 | JMS I [FFLOAT /FAC=FLOAT(FIX(X)) |
| 2626 | JMS I (FFSUB1 /FAC=X-INT(X)=FRACTION (X) |
| 2627 | FPPTM1 |
| 2628 | 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 | NHNDLE, 0 |
| 2634 | TAD ACH /FETCH HIGH ORDER MANTISSA |
| 2635 | SMA CLA /IS IT <0? |
| 2636 | JMP NFLGST /NO-CLEAR NFLAG |
| 2637 | JMS I [FFNEG /YES-NEGATE FAC |
| 2638 | IAC /AND SET NFLAG |
| 2639 | NFLGST, DCA NFLAG |
| 2640 | JMP I NHNDLE |
| 2641 | |
| 2642 | /ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0 |
| 2643 | |
| 2644 | NCHK, 0 /LOC ALSO USED FOR TEMP STORAGE |
| 2645 | TAD NFLAG |
| 2646 | SZA CLA /IS NFLAG=0? |
| 2647 | JMS I [FFNEG /NO-NEGATE FAC |
| 2648 | JMP I NCHK /YES-RETURN |
| 2649 | |
| 2650 | NUM=NCHK |
| 2651 | \f/******EXPONENTIAL****** |
| 2652 | |
| 2653 | EXPON1, 0 /LOC USED FOR TEMP STORAGE BY SIN,ARCTAN |
| 2654 | JMS I (FFMPY /Y=XLOG2(E) |
| 2655 | LOG2E |
| 2656 | JMS FRACT /GET FRACTIONAL PART OF Y |
| 2657 | JMS I (FFMPY /(FRACTION(Y))*(LN2/2) |
| 2658 | LN2OV2 |
| 2659 | JMS I [FFPUT /SAVE Y |
| 2660 | FPPTM1 |
| 2661 | JMS I (FFSQ /Y**2 |
| 2662 | JMS I (FFADD /B1+Y**2 |
| 2663 | EXPB1 |
| 2664 | JMS I (FFDIV1 /A1/(B1+Y**2) |
| 2665 | EXPA1 |
| 2666 | JMS I (FFADD /A0+A1/(B1+Y**2) |
| 2667 | EXPA0 |
| 2668 | JMS I (FFSUB /A0-Y+A1/(B1+Y**2) |
| 2669 | FPPTM1 |
| 2670 | JMS I [FFPUT /SAVE |
| 2671 | FPPTM2 |
| 2672 | JMS I [FFGET /GET Y |
| 2673 | FPPTM1 |
| 2674 | ISZ ACX /MULT. BY 2=2Y |
| 2675 | NOP |
| 2676 | JMS I (FFDIV /2Y/(A0-Y+A1/(B1+Y**2)) |
| 2677 | FPPTM2 |
| 2678 | JMS I (FFADD /1+2Y/(AO-Y+A1/(B1+Y**2)) |
| 2679 | ONE |
| 2680 | JMS I (FFSQ /[1+2Y/(A0-Y+A1/(B1+Y**2))]**2=EXP(Y) |
| 2681 | TAD NUM |
| 2682 | TAD ACX /EXP(X)=(2**N)(EXPY) |
| 2683 | DCA ACX |
| 2684 | JMP I EXPON1 /FAC=EXPON(X) |
| 2685 | |
| 2686 | NFLAG=EXPON1 |
| 2687 | |
| 2688 | /CONSTANT THAT WOULDN'T FIT ELSEWHERE |
| 2689 | TOVPI, 0 /.6366198 |
| 2690 | 2427 |
| 2691 | 6302 |
| 2692 | |
| 2693 | MULLIM, 0 |
| 2694 | TAD ACX /CHECK IF NUMBER OF MULTIPLIES IS TOO LARGE |
| 2695 | SPA |
| 2696 | CLA /RETURN IF EXPONENT IS NEGATIVE (WE'LL USE LOGS) |
| 2697 | TAD (-4 /ONLY A ROUGH ROUGH LIMIT ON THE EXPONENT |
| 2698 | SPA SNA CLA /SKP IF NUMBER GT 15 APPROX |
| 2699 | JMP I MULLIM /NO, CONTINUE |
| 2700 | JMP I (USELOG /YES, USE LOG INSTEAD |
| 2701 | |
| 2702 | PAGE |
| 2703 | \f/******ARC TANGENT****** |
| 2704 | |
| 2705 | ATAN, 0 |
| 2706 | JMS I NHNDLL /IF X<0,SET NFLAG AND NEGATE |
| 2707 | JMS I [FFPUT /SAVE X |
| 2708 | FPPTM1 |
| 2709 | JMS I FSUBM /X-1 |
| 2710 | ONE |
| 2711 | TAD ACH /GET HI MANTISSA |
| 2712 | SPA CLA /WAS X>1? |
| 2713 | JMP ARGPOL /NO-CLEAR GT1FLG |
| 2714 | JMS I [FFGET /YES-ATAN(X)=PI/2-ATAN(1/X) |
| 2715 | ONE |
| 2716 | JMS I FDIVM /1/X |
| 2717 | FPPTM1 |
| 2718 | JMS I [FFPUT |
| 2719 | FPPTM1 |
| 2720 | IAC /SET GT1FLG |
| 2721 | ARGPOL, DCA GT1FLG |
| 2722 | JMS I [FFGET /GET X OR 1/X |
| 2723 | FPPTM1 |
| 2724 | JMS I FSQRM /Y**2 |
| 2725 | JMS I [FFPUT /SAVE |
| 2726 | FPPTM2 |
| 2727 | JMS I FADDM /Y**2+B3 |
| 2728 | ATANB3 |
| 2729 | JMS I FDIV1M /A3/(Y**2+B3) |
| 2730 | ATANA3 |
| 2731 | JMS I FADDM /B2+A3/(Y**2+B3) |
| 2732 | ATANB2 |
| 2733 | JMS I FADDM /Y**2+B2+A3/(Y**2+B3) |
| 2734 | FPPTM2 |
| 2735 | JMS I FDIV1M /A2/(Y**2+B2+A3/(Y**2+B3)) |
| 2736 | ATANA2 |
| 2737 | JMS I FADDM /B1+A2/(Y**2+B2+A3/(Y**2+B3)) |
| 2738 | ATANB1 |
| 2739 | JMS I FADDM /Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)) |
| 2740 | FPPTM2 |
| 2741 | JMS I FDIV1M /A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) |
| 2742 | ATANA1 |
| 2743 | JMS I FADDM /B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) |
| 2744 | ATANB0 |
| 2745 | JMS I FMPYM /ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))) |
| 2746 | FPPTM1 |
| 2747 | TAD GT1FLG /WAS X>1? |
| 2748 | SNA CLA |
| 2749 | JMP NGT /NO-TEST IF X<0? |
| 2750 | JMS I FSUB1M /ATAN(X)=PI/2-ATAN(1/X) |
| 2751 | PIOV2 |
| 2752 | NGT, JMS I NCHKL /IF NFLAG SET,NEGATE FAC |
| 2753 | JMP I ATAN /FAC=ATAN(X) |
| 2754 | NHNDLL, NHNDLE |
| 2755 | NCHKL, NCHK |
| 2756 | \f/******NAPERIAN LOGARITHM****** |
| 2757 | |
| 2758 | GTFLG=ATAN |
| 2759 | |
| 2760 | LOG, 0 |
| 2761 | TAD ACH |
| 2762 | SPA SNA /X<0 OR X=0? |
| 2763 | JMP I ARTRAP /YES-TAKE ILLEGAL ARGUMENT TRAP |
| 2764 | CLL RTL |
| 2765 | SNA /NO-HORD=2000? |
| 2766 | TAD ACX /YES-EXP=1? |
| 2767 | CMA IAC |
| 2768 | IAC |
| 2769 | SNA |
| 2770 | TAD ACL /YES-LORD=0? |
| 2771 | SZA CLA |
| 2772 | JMP POLYNL /NO-ARG IS LEGAL AND NOT 1 |
| 2773 | DCA ACX |
| 2774 | DCA ACL |
| 2775 | LTRPRT, DCA ACH |
| 2776 | JMP I LOG /YES-LOG(1)=0 |
| 2777 | POLYNL, TAD ACX |
| 2778 | DCA GTFLG /SAVE EXPONENT FOR LATER |
| 2779 | DCA ACX /ISOLATE MANTISSA IN FAC |
| 2780 | JMS I [FFPUT /SAVE F |
| 2781 | FPPTM1 |
| 2782 | JMS I FADDM /F+SQR(.5) |
| 2783 | SQRP5 |
| 2784 | JMS I [FFPUT /SAVE |
| 2785 | FPPTM2 |
| 2786 | JMS I [FFGET |
| 2787 | FPPTM1 |
| 2788 | JMS I FSUBM /F-SQR(.5) |
| 2789 | SQRP5 |
| 2790 | JMS I FDIVM /Z=F+SQR(.5)/F-SQR(.5) |
| 2791 | FPPTM2 |
| 2792 | JMS I [FFPUT |
| 2793 | FPPTM1 |
| 2794 | JMS I FSQRM /Z**2 |
| 2795 | JMS I [FFPUT |
| 2796 | FPPTM2 |
| 2797 | JMS I FMPYM /C5(Z**2) |
| 2798 | LOGC5 |
| 2799 | JMS I FADDM /C3+C5(Z**2) |
| 2800 | LOGC3 |
| 2801 | JMS I FMPYM /C3(Z**2)+C5(Z**4) |
| 2802 | FPPTM2 |
| 2803 | JMS I FADDM /C1+C3(Z**2)+C5(Z**4) |
| 2804 | LOGC1 |
| 2805 | JMS I FMPYM /C1(Z)+C3(Z**3)+C5(Z**5) |
| 2806 | FPPTM1 |
| 2807 | JMS I FSUBM /C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F) |
| 2808 | ONEHAF |
| 2809 | JMS I [FFPUT /SAVE LOG2(F) |
| 2810 | FPPTM2 |
| 2811 | TAD GTFLG /I |
| 2812 | DCA ACX /SET UP FLOAT |
| 2813 | JMS I [FFLOAT |
| 2814 | JMS I FADDM /I+LOG2(F) |
| 2815 | FPPTM2 |
| 2816 | JMS I FMPYM /[I+LOG2(F)]*LOGE(2)=LOGE(X) |
| 2817 | LN2 |
| 2818 | JMP I LOG /FAC=LN(X) |
| 2819 | |
| 2820 | GT1FLG=LOG |
| 2821 | FMPYM, FFMPY |
| 2822 | FADDM, FFADD |
| 2823 | FDIVM, FFDIV |
| 2824 | FDIV1M, FFDIV1 |
| 2825 | FSUBM, FFSUB |
| 2826 | FSUB1M, FFSUB1 |
| 2827 | FSQRM, FFSQ |
| 2828 | ARTRAP, LM |
| 2829 | /CONSTANTS USED BY VARIOUS FUNCTIONS |
| 2830 | |
| 2831 | SINA1, 1 /1.5707949 |
| 2832 | 3110 |
| 2833 | 3747 |
| 2834 | SINA3, 0 /-.64592098 |
| 2835 | 5325 |
| 2836 | 1167 |
| 2837 | SINA5, 7775 /.07948766 |
| 2838 | 2426 |
| 2839 | 2466 |
| 2840 | SINA7, 7771 /-.004362476 |
| 2841 | 5610 |
| 2842 | 3164 |
| 2843 | PIOV2, 1 /1.5707963 |
| 2844 | 3110 |
| 2845 | 3756 |
| 2846 | LOG2E, 1 /1.442695 |
| 2847 | 2705 |
| 2848 | 2434 |
| 2849 | LN2OV2, 7777 /.34657359 |
| 2850 | 2613 |
| 2851 | 4415 |
| 2852 | EXPB1, 6 /60.090191 |
| 2853 | 3602 |
| 2854 | 7054 |
| 2855 | EXPA1, 12 /-601.80427 |
| 2856 | 5514 |
| 2857 | 3104 |
| 2858 | EXPA0, 4 /12.015017 |
| 2859 | 3001 |
| 2860 | 7301 |
| 2861 | ATANB0, 7776 /.17465544 |
| 2862 | 2626 |
| 2863 | 6157 |
| 2864 | ATANA1, 2 /3.7092563 |
| 2865 | 3553 |
| 2866 | 1071 |
| 2867 | ATANB1, 3 /6.762139 |
| 2868 | 3303 |
| 2869 | 670 |
| 2870 | ATANA2, 3 /-7.10676 |
| 2871 | 4344 |
| 2872 | 5267 |
| 2873 | ATANB2, 2 /3.3163354 |
| 2874 | 3241 |
| 2875 | 7554 |
| 2876 | ATANA3, 7777 /-.26476862 |
| 2877 | 5703 |
| 2878 | 4040 |
| 2879 | ATANB3, 1 /1.44863154 |
| 2880 | 2713 |
| 2881 | 3140 |
| 2882 | SQRP5, 0 /.7071068 |
| 2883 | 2650 |
| 2884 | 1170 |
| 2885 | LOGC1, 2 /2.8853913 |
| 2886 | 2705 |
| 2887 | 2440 |
| 2888 | LOGC3, 0 /.9614706 |
| 2889 | 3661 |
| 2890 | 566 |
| 2891 | LOGC5, 0 /.59897865 |
| 2892 | 2312 |
| 2893 | 5525 |
| 2894 | ONEHAF, 0 /.5 |
| 2895 | 2000 |
| 2896 | 0 |
| 2897 | LN2, 0 /.6931472 |
| 2898 | 2613 |
| 2899 | 4415 |
| 2900 | \f *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 | FFIX, 0 |
| 2907 | CLA |
| 2908 | TAD ACX /FETCH EXPONENT |
| 2909 | SZA SMA /IS NUMBER <1? |
| 2910 | JMP .+3 /NO-CONTINUE ON |
| 2911 | FTRPRT, CLA |
| 2912 | JMP FIXDNE+1 /YES-FIX IT TO ZERO |
| 2913 | TAD (-13 /SET BINARY POINT AT 11 |
| 2914 | SNA /PLACES TO RIGHT OF CURRENT POINT? |
| 2915 | JMP FIXDNE /NO-NUMBER IS ALREADY FIXED THEN. |
| 2916 | SMA /YES-IS NUMBER TOO LARGE TO FIX? |
| 2917 | JMP I (FO /YES-TAKE OVERFLOW TRAP |
| 2918 | DCA ACX /NO-SET SCALE COUNT |
| 2919 | FIXLP, CLL /0 IN LINK |
| 2920 | TAD ACH /GET HIGH MANTISSA |
| 2921 | SPA /IS IT <0? |
| 2922 | CML /YES-PUT A 1 IN LINK |
| 2923 | RAR /SCALE RIGHT |
| 2924 | DCA ACH /SAVE |
| 2925 | ISZ ACX /DONE YET? |
| 2926 | JMP FIXLP /NO |
| 2927 | FIXDNE, TAD ACH /YES-ANSWER IN AC |
| 2928 | DCA ACX /RETURN WITH ANSWER IN 44 |
| 2929 | JMP I FFIX /RETURN |
| 2930 | |
| 2931 | /******FLOAT****** |
| 2932 | /ROUTINE TO FLOAT ANY INTEGER IN EXP (LOC 44) INTO FAC |
| 2933 | |
| 2934 | FFLOAT, 0 |
| 2935 | TAD ACX |
| 2936 | DCA ACH /PUT NUMBER IN HI MANTISSA |
| 2937 | DCA ACL /CLEAR LOW MANTISSA |
| 2938 | TAD (13 /11(10) INTO EXPONENT |
| 2939 | DCA ACX |
| 2940 | JMS I [FFNOR /NORMALIZE |
| 2941 | JMP I FFLOAT /RETURN |
| 2942 | \f/RANDOM NUMBER GENERATOR |
| 2943 | |
| 2944 | RND, 0 |
| 2945 | TAD I (RSEED /GET SEED |
| 2946 | DCA TEMP3 /PUT IN MULTIPLY OPERAND |
| 2947 | TAD (73 |
| 2948 | JMS I [MPY /MULTIPLY SEED BY 73 |
| 2949 | DCA I (RSEED /USE LOW ORDER 12 BITS AS NEW SEED |
| 2950 | TAD I (RSEED /LOW ORDER OF PRODUCT ALSO SERVES |
| 2951 | CLL RAR /AS RANDOM NUMBER |
| 2952 | DCA ACH /SET SIGN TO 0 AND STORE AS HORD |
| 2953 | DCA ACX |
| 2954 | RAR |
| 2955 | DCA ACL /USE 12 BITS AS MANTISSA |
| 2956 | DCA AC1 /CLEAR FPP OVERFLOW |
| 2957 | JMS I [FFNOR /AND NORMALIZE |
| 2958 | JMP I [ILOOP /DONE |
| 2959 | |
| 2960 | PAGE |
| 2961 | \f /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 | FFOUT, 0 |
| 2967 | TAD (INTERB-1 |
| 2968 | DCA XR1 /SET POINTER TO ASCII BUFFER |
| 2969 | TAD ACH /SEE IF FAC NEGATIVE |
| 2970 | SMA CLA |
| 2971 | JMP OKPOS /JMP IF POSITIVE |
| 2972 | JMS I [FFNEG /TAKE ABS VALUE IF NEGATIVE |
| 2973 | TAD ("- /PRINT MINUS SIGN |
| 2974 | SKP |
| 2975 | OKPOS, TAD (240 /PRINT SPACE IF POSITIVE |
| 2976 | DCA I XR1 |
| 2977 | TAD ACH /SEE IF NUMBER IS ZERO |
| 2978 | SNA CLA |
| 2979 | JMP ZERXIT /SPECIAL CASE IF SO |
| 2980 | JMS I (CVTNUM /CALL ROUTINE TO UNPACK TO BASE 10 |
| 2981 | TAD (NUMBUF-1 |
| 2982 | DCA XR2 /POINT XR2 AT DIGIT BUFFER |
| 2983 | TAD (5 /TEST FORMAT TO USE |
| 2984 | TAD DECEXP |
| 2985 | CLL |
| 2986 | TAD (-4 |
| 2987 | SNL |
| 2988 | JMP SMLFMT /JMP IF .0NNNNNN TO .0000NNNNNN |
| 2989 | TAD (-7 |
| 2990 | SZL CLA |
| 2991 | JMP REGFMT /JMP IF .NNNNNN TO NNNNNN |
| 2992 | /OTHERWISE USE E FORMAT N.NNNNNE+NNN OR N.NNNNNE-NNN |
| 2993 | TAD I XR2 /GET DIGIT TO LEFT OF POINT |
| 2994 | JMS PUTD /PUT IT OUT |
| 2995 | TAD (". |
| 2996 | DCA I XR1 /NOW SEND OUT DECIMAL POINT |
| 2997 | TAD (-5 |
| 2998 | DCA AC2 /DO 5 MORE DIGITS |
| 2999 | TAD I XR2 /PICK UP DIGIT |
| 3000 | JMS PUTD /CONVERT TO ASCII AND STORE |
| 3001 | ISZ AC2 |
| 3002 | JMP .-3 /LOOP FOR MORE |
| 3003 | TAD ("E /PRINT E |
| 3004 | DCA I XR1 |
| 3005 | / CLL |
| 3006 | TAD DECEXP /TAKE ABS(DECEXP) |
| 3007 | SPA |
| 3008 | CML CIA |
| 3009 | DCA DECEXP |
| 3010 | RTL /CONVERT "+" TO "-" IF NEGATIVE |
| 3011 | TAD ("+ |
| 3012 | DCA I XR1 |
| 3013 | JMS IDIV /PRINT 3 DIGITS OF EXPONENT NOW |
| 3014 | -144 |
| 3015 | JMS IDIV |
| 3016 | -12 |
| 3017 | TAD DECEXP |
| 3018 | JMS PUTD |
| 3019 | JMP I FFOUT /ALL DONE --RETURN-- |
| 3020 | \f /HANDLE .0NNNNNN TO .0000NNNNNN |
| 3021 | |
| 3022 | SMLFMT, DCA AC0 /STORE NUMBER OF LEADING ZEROES |
| 3023 | TAD (". /PUT OUT DECIMAL POINT |
| 3024 | DCA I XR1 |
| 3025 | JMS PUTD /SEND A 0 |
| 3026 | ISZ AC0 |
| 3027 | JMP .-2 /LOOP FOR LEADING 0'S |
| 3028 | |
| 3029 | /GENERAL NON E FORMAT .NNNNNN TO NNNNNN |
| 3030 | |
| 3031 | REGFMT, TAD (-7 |
| 3032 | DCA AC1 /INIT COUNT OF NONZERO DIGITS |
| 3033 | TAD (NUMBUF+6 |
| 3034 | DCA AC2 /POINT AT END OF DIGIT BUFFER |
| 3035 | SHRINK, STA /DECREMENT DIGIT POINTER |
| 3036 | TAD AC2 |
| 3037 | DCA AC2 |
| 3038 | ISZ AC1 /REDUCE SIGNIFICANT DIGIT COUNT |
| 3039 | TAD DECEXP |
| 3040 | IAC |
| 3041 | TAD AC1 |
| 3042 | SMA CLA |
| 3043 | JMP PRTLP /JMP OUT IF NOT TO RIGHT OF DECIMAL POINT |
| 3044 | TAD I AC2 /ELSE LOOK AT DIGIT |
| 3045 | SNA CLA |
| 3046 | JMP SHRINK /DISCARD IT IF ZERO |
| 3047 | PRTLP, STA |
| 3048 | TAD DECEXP |
| 3049 | DCA DECEXP /SEE IF DIGIT TO BE PRINTED FOLLOWS DP |
| 3050 | AC0002 |
| 3051 | TAD DECEXP |
| 3052 | SZA CLA |
| 3053 | JMP NODP /NO |
| 3054 | TAD (". /YES, PRINT DP |
| 3055 | DCA I XR1 |
| 3056 | NODP, TAD I XR2 /PICK UP DECIMAL DIGIT |
| 3057 | JMS PUTD /PUT OUT |
| 3058 | ISZ AC1 |
| 3059 | JMP PRTLP /JMP IF MORE DIGITS TO PRINT |
| 3060 | JMP I FFOUT /--RETURN-- |
| 3061 | |
| 3062 | ZERXIT, JMS PUTD |
| 3063 | JMP I FFOUT /--RETURN-- |
| 3064 | |
| 3065 | /DIVIDE DECEXP BY -DIVISOR IN CALL+1 |
| 3066 | |
| 3067 | IDIV, 0 |
| 3068 | DCA AC1 /CLEAR QUOTIENT |
| 3069 | IDIVLP, TAD DECEXP |
| 3070 | TAD I IDIV |
| 3071 | SPA |
| 3072 | JMP IDVOUT /JMP OUT IF LESS THAN DIVISOR |
| 3073 | DCA DECEXP /ELSE UPDATE IT |
| 3074 | ISZ AC1 /TALLY QUOTIENT |
| 3075 | JMP IDIVLP /ITERATE |
| 3076 | IDVOUT, CLA |
| 3077 | TAD AC1 /GET QUOT AS NEXT DIGIT |
| 3078 | JMS PUTD /PUT OUT |
| 3079 | ISZ IDIV |
| 3080 | JMP I IDIV |
| 3081 | |
| 3082 | /CONVERT NUMBER IN AC TO ASCII DIGIT |
| 3083 | /MUST NOT TOUCH THE LINK |
| 3084 | |
| 3085 | PUTD, 0 |
| 3086 | TAD ("0 /ADD IN 0 |
| 3087 | DCA I XR1 /STORE IN BUFFER |
| 3088 | JMP I PUTD |
| 3089 | |
| 3090 | PAGE |
| 3091 | \f /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 | CVTNUM, 0 |
| 3101 | DCA AC1 /CLEAR OVERFLOW WORD |
| 3102 | SKP /SKP IN AND CLEAR DECIMAL EXPONENT |
| 3103 | ADJDEC, TAD DECEXP |
| 3104 | DCA DECEXP /STORE UPDATED DECIMAL EXPONENT |
| 3105 | NORML, TAD ACH /SEE IF FRACTION IS NORMALIZED |
| 3106 | RAL |
| 3107 | SPA CLA |
| 3108 | JMP NORMED /JMP IF YES |
| 3109 | JMS I (AL1 /SHIFT AC LEFT 1 BIT |
| 3110 | STA |
| 3111 | TAD ACX /COMPENSATE BINARY EXPONENT |
| 3112 | DCA ACX |
| 3113 | JMP NORML /TRY AGAIN |
| 3114 | NORMED, TAD ACX /RANGE CHECK BINARY EXPONENT NOW |
| 3115 | SMA SZA |
| 3116 | JMP DIVCHK /JMP IF NUMBER GE 1 |
| 3117 | TAD O4 |
| 3118 | DCA ACX /INCREASE BINARY EXP TOWARDS ZERO |
| 3119 | JMS AR1 /SHIFT 4 BITS RIGHT |
| 3120 | JMS AR1 /MAX RELATIVE ERROR WILL BE LT 15*2^-34 PER MULTIPLY |
| 3121 | JMS AR1 |
| 3122 | JMS AR1 |
| 3123 | JMS MPY10 /NOW MULTIPLY BY 10. |
| 3124 | STA /DECREASE DECIMAL EXPONENT |
| 3125 | JMP ADJDEC /RENORMALIZE AND TRY AGAIN |
| 3126 | |
| 3127 | DIVCHK, TAD (-5 /SEE IF EXP GT 4 |
| 3128 | SPA |
| 3129 | JMP INRANG /JMP IF NOT, NUMBER MAY BE IN RANGE |
| 3130 | DIVGO, CLA CLL |
| 3131 | TAD (-40 /SET 32. STAGE SUBTRACT-SHIFT DIVIDE (SLOW BUT ACCURATE) |
| 3132 | DCA AC2 /(THE LEN ELEKMAN TECHNIQUE) |
| 3133 | /MAX RELATIVE ERROR WILL BE LT 9*2^-34. PER DIVIDE |
| 3134 | DVLOOP, TAD ACH /SEE IF GE 10. |
| 3135 | TAD (5400 |
| 3136 | SMA |
| 3137 | DCA ACH /UPDATE IF YES |
| 3138 | CML STA RAL |
| 3139 | DCA AC0 /SAVE LOW ORDER BIT |
| 3140 | JMS I (AL1 /SHIFT MANTISSA NOW |
| 3141 | ISZ AC0 /STORE BIT NOW |
| 3142 | ISZ AC1 |
| 3143 | ISZ AC2 /BUMP COUNT |
| 3144 | JMP DVLOOP /ITERATE |
| 3145 | TAD ACH /NOW ZERO OUT REMAINDER |
| 3146 | AND [377 |
| 3147 | DCA ACH |
| 3148 | IAC /NOW INCREASE DECIMAL EXPONENT |
| 3149 | JMP ADJDEC |
| 3150 | |
| 3151 | INRANG, DCA AC2 /SET SHIFT COUNTER |
| 3152 | SKP |
| 3153 | JMS AR1 /SHIFT FAC RIGHT |
| 3154 | ISZ AC2 |
| 3155 | JMP .-2 /LEAVE EFFECTIVE BINARY POINT RIGHT OF ACH BIT 4 |
| 3156 | TAD ACH /ACH = 0DD DDF FFF FFF (D=DECIMAL DIGIT BITS) |
| 3157 | TAD (5400 /SEE IF DDDD GE 10 |
| 3158 | SMA CLA |
| 3159 | JMP DIVGO /DIVIDE AGAIN (NORMALIZATION WILL WORK) |
| 3160 | CLL |
| 3161 | TAD AC1 /NOW ROUND BY ADDING 0.000005 |
| 3162 | TAD (4761 |
| 3163 | DCA AC1 |
| 3164 | IAC /ADD 24761 TO LOW BITS |
| 3165 | RAL |
| 3166 | TAD ACL |
| 3167 | DCA ACL |
| 3168 | SZL |
| 3169 | ISZ ACH |
| 3170 | TAD ACH |
| 3171 | TAD (5400 /SEE IF CARRY INTO 9.XXX... |
| 3172 | SZA CLA |
| 3173 | JMP CVT10 /JMP IF NO |
| 3174 | TAD [200 /ELSE SET TO 1.00000 |
| 3175 | DCA ACH |
| 3176 | DCA ACL |
| 3177 | DCA AC1 |
| 3178 | ISZ DECEXP /AND BUMP DECIMAL EXPONENT |
| 3179 | O4, 4 /EFFECTIVE NOP |
| 3180 | |
| 3181 | /NOW CONVERT TO DECIMAL DIGITS |
| 3182 | |
| 3183 | CVT10, TAD (-6 /DO 6 DIGITS |
| 3184 | DCA AC0 |
| 3185 | TAD (NUMBUF-1 |
| 3186 | DCA XR3 |
| 3187 | JMP CVTGO /FIRST DIGIT IS ALREADY IN |
| 3188 | CVTLP, TAD ACH /ZERO OUT PREV DIGIT |
| 3189 | AND [177 |
| 3190 | DCA ACH |
| 3191 | JMS MPY10 /MULTIPLY BY 10. |
| 3192 | CVTGO, TAD ACH /GET DIGIT FROM 0DD DDF FFF FFF |
| 3193 | RTL |
| 3194 | RTL |
| 3195 | RTL |
| 3196 | AND [17 |
| 3197 | DCA I XR3 /STORE IT |
| 3198 | ISZ AC0 |
| 3199 | JMP CVTLP /LOOP IF MORE |
| 3200 | JMP I CVTNUM /--RETURN-- |
| 3201 | |
| 3202 | /MULTIPLY ACH,,ACL,,AC1 BY 10. |
| 3203 | |
| 3204 | MPY10, 0 |
| 3205 | TAD ACH |
| 3206 | DCA OPH /COPY AC TO OP |
| 3207 | TAD ACL |
| 3208 | DCA OPL |
| 3209 | TAD AC1 |
| 3210 | DCA AC2 |
| 3211 | JMS I (AL1 /N*2 |
| 3212 | JMS I (AL1 /N*4 |
| 3213 | JMS I (OADD /N*5 |
| 3214 | JMS I (AL1 /N*10. |
| 3215 | JMP I MPY10 |
| 3216 | |
| 3217 | /SHIFT FAC RIGHT 1 BIT |
| 3218 | |
| 3219 | AR1, 0 |
| 3220 | TAD ACH |
| 3221 | CLL RAR |
| 3222 | DCA ACH |
| 3223 | TAD ACL |
| 3224 | RAR |
| 3225 | DCA ACL |
| 3226 | TAD AC1 |
| 3227 | RAR |
| 3228 | DCA AC1 |
| 3229 | JMP I AR1 /DONE |
| 3230 | |
| 3231 | PAGE |
| 3232 | \f IFZERO EAE < |
| 3233 | |
| 3234 | /FLOATING POINT INPUT ROUTINE |
| 3235 | |
| 3236 | FFIN, 0 |
| 3237 | CLA CMA |
| 3238 | DCA I FDVPT /INITIALIZE PERIOD SWITCH TO -1 |
| 3239 | CMA /SET SIGN SWITCH TO -1 |
| 3240 | DCA SIGNF |
| 3241 | CDF /DF TO PACKAGE FIELD |
| 3242 | DCA DSWIT /ZERO CONVERSION SWITCH |
| 3243 | DECONV, DCA ACX /ZERO OUT THE FAC! |
| 3244 | DCA ACL |
| 3245 | P200, 200 |
| 3246 | DCA ACH |
| 3247 | DECNV, DCA DNUMBR /ZERO # OF DIGITS SINCE DEC. PT. |
| 3248 | DECON, JMS GCHR /GET A CHAR.FROM TTY. |
| 3249 | JMP FFIN1 /TERMINATOR- |
| 3250 | ISZ DSWIT /DIGIT-BUMP CONVERSION SWITCH |
| 3251 | ISZ DNUMBR /BUMP # OF DIGITS-# IS STORED IN |
| 3252 | JMS I FMPYLL /"FMPY TEN" |
| 3253 | TEN |
| 3254 | JMS I [FFPUT /"FPUT I TM3PT" |
| 3255 | FPPTM1 |
| 3256 | JMS I [FFGET /"FGET TP" |
| 3257 | TP |
| 3258 | JMS I [FFNOR /"FNOR" |
| 3259 | JMS I FADDLL /"FADD I TM3PT" |
| 3260 | FPPTM1 |
| 3261 | JMP DECON /GO ON |
| 3262 | FFIN1, ISZ I FDVPT /HAVE WE HAD A PERIOD YET? |
| 3263 | JMP FIGO2 /YES-GO ON |
| 3264 | ISZ TP1 /NO-IS THIS A PERIOD? |
| 3265 | ISZ TP1 |
| 3266 | SKP CLA |
| 3267 | JMP DECNV /YES-ZERO DIG. COUNT AFTER DEC. PT. |
| 3268 | /AND GO CONVERT REST |
| 3269 | DCA DNUMBR /NO-TERMINATOR-ZERO COUNT OF |
| 3270 | /DIGITS AFTER DECIMAL POINT. |
| 3271 | FIGO2, ISZ SIGNF /IS # NEGATIVE?(DID WE GET - SIGN?) |
| 3272 | JMS I FFNEGP /YES-NEGATE IT |
| 3273 | CLA CMA /RESET SIGN SWITCH FOR EXP. |
| 3274 | DCA SIGNF |
| 3275 | TAD CHAR /NO-WAS THE TERMINATOR AN 'E'? |
| 3276 | TAD KME |
| 3277 | SNA CLA |
| 3278 | GETE, JMS GCHR /YES-GET A CHAR. OF EXPONENT |
| 3279 | JMP EDON /END OF EXPONENT |
| 3280 | TAD TM /GOT DIG. OF EXP-STORED IN TP1 |
| 3281 | CLL RTL /MULT. ACCUMULATED EXP BY 10 |
| 3282 | TAD TM |
| 3283 | CLL RAL |
| 3284 | TAD TP1 /ADD DIGIT |
| 3285 | JMP GETE /CONTINUE |
| 3286 | \fEDON, TAD TM /GET EXPONENT |
| 3287 | ISZ SIGNF /WAS EXPONENT NEGATIVE? |
| 3288 | CMA IAC /YES-NEGATE IT |
| 3289 | CMA IAC /AND CALC. DNUMBR - EXPON. |
| 3290 | TAD DNUMBR /GET # TIMES TO DIV MANTISSA BY TEN |
| 3291 | CLL CMA IAC |
| 3292 | SPA /RESULT POSITIVE? |
| 3293 | CLL CMA CML IAC /NO-MAKE POS. AND SET LINK |
| 3294 | CMA /NEGATE FOR COUNTER |
| 3295 | DCA DNUMBR /AND STORE |
| 3296 | RAL /LINK=1-DIV;=0-MUL. # BY TEN |
| 3297 | TAD MDV /FORM CORRECT INSTRUCTION |
| 3298 | DCA SIGNF /AND STORE FOR EXECUTION |
| 3299 | FCNT, ISZ DNUMBR /DONE ALL OPERATIONS? |
| 3300 | JMP SIGNF /NO |
| 3301 | JMP I FFIN /YES-RETURN |
| 3302 | SIGNF, 0 /NO- MUL OR DIV. MANTISSA |
| 3303 | TEN /BY TEN |
| 3304 | JMP FCNT /GO ON |
| 3305 | FFNEGP, FFNEG |
| 3306 | DNUMBR, 0 |
| 3307 | KME, -305 |
| 3308 | MDV, JMS I .+1 /THESE 3 WDS. MUST BE IN THIS ORDER |
| 3309 | FMPYLL, FFMPY |
| 3310 | FDVPT, FFDIV /!!!!!!!!!!!!!!!!! |
| 3311 | FADDLL, FFADD |
| 3312 | |
| 3313 | KK12, 12 |
| 3314 | TP, 13 |
| 3315 | TP1, 0 |
| 3316 | 0 |
| 3317 | TEN, 4 |
| 3318 | 2400 |
| 3319 | 0 |
| 3320 | \f/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 | GCHR, 0 |
| 3325 | DCA TM /STORE ACCUMULATED EXPONENT (MAYBE) |
| 3326 | JMS INPUT /GET A CHAR FROM TTY. |
| 3327 | TAD CHAR /PICK IT UP |
| 3328 | TAD PLUS /WAS IT PLUS SIGN? |
| 3329 | SNA |
| 3330 | JMP DECON1 /YES-GET ANOTHER CHAR. |
| 3331 | TAD MINUS /NO WAS IT MINUS SIGN? |
| 3332 | SZA CLA |
| 3333 | JMP .+3 |
| 3334 | DCA SIGNF /YES-FLIP SWITCH |
| 3335 | DECON1, JMS INPUT /GET A CHAR. |
| 3336 | TAD CHAR |
| 3337 | TAD K7506 /SEE IF ITS A DIGIT |
| 3338 | CLL |
| 3339 | TAD KK12 |
| 3340 | DCA TP1 /STORE FOR LATER |
| 3341 | SZL /DIGIT? |
| 3342 | ISZ GCHR /YES-RETN. TO CALL+2 |
| 3343 | JMP I GCHR /NO-RETN. TO CALL+1 |
| 3344 | K7506, 7506 |
| 3345 | / |
| 3346 | /INPUT ROUTINE-IGNORES LEADING SPACES |
| 3347 | / |
| 3348 | INPUT, 0 |
| 3349 | JMS I IGETCH /USE OUR ROUTINE TO GET CHAR |
| 3350 | TAD DSWIT /GET TERMINATOR |
| 3351 | SZA CLA /VALID INPUT YET? |
| 3352 | JMP IOUT /YES-CONTINUE |
| 3353 | TAD CHAR /NO-GET CHAR |
| 3354 | TAD M240 /COMPARE AGAINST SPACE |
| 3355 | SZA /SKP IF SPACE |
| 3356 | TAD (240-212 /COMPARE TO LF |
| 3357 | SNA CLA /IS IT A SPACE OR LF? |
| 3358 | JMP INPUT+1 /YES-IGNORE IT |
| 3359 | IOUT, JMP I INPUT /RETURN |
| 3360 | IGETCH, GETCH /POINTER TO GET CHAR ROUTINE |
| 3361 | /ALTERED BY "VAL" FUNCTION TO PICK FROM SAC (BE CAREFULL) |
| 3362 | M240, -240 |
| 3363 | PLUS, -253 |
| 3364 | MINUS, 253-255 |
| 3365 | / |
| 3366 | /ROUTINE TO DECIDE CALLING MODE IN LIEU OF "SPECIAL MODE" PROBLEMS |
| 3367 | / |
| 3368 | PATCHF, 0 |
| 3369 | SZA /IS AC EMPTY |
| 3370 | JMP RTN2 /NO-THIS IS ALWAYS SI MODE WITH ADDR IN AC |
| 3371 | TAD FF /YES-GET SPECIAL MODE FLIP-FLOP |
| 3372 | SZA CLA /IF ON,THE ZERO AC MEANS ADDRESS OF 0 |
| 3373 | RTN2, ISZ PATCHF /USE AC AS ADDRESS OF OPERAND |
| 3374 | JMP I PATCHF /RETURN |
| 3375 | \f PAGE |
| 3376 | / |
| 3377 | /INVERSE FLOATING SUBTRACT-USES FLOATING ADD |
| 3378 | /!!FSW1!!-THIS IS OP-FAC |
| 3379 | / |
| 3380 | FFSUB1, 0 |
| 3381 | JMS I [PATCHF /WHICH MODE? |
| 3382 | TAD I FFSUB1 /CALLED BY USER-GET ADDR. OF OP. |
| 3383 | JMS I ARGETL /GO PICK UP OPERAND |
| 3384 | CDF |
| 3385 | JMS I FFNEGA /NEGATE FAC |
| 3386 | TAD FFSUB1 /AND GO ADD |
| 3387 | JMP I SUB0P |
| 3388 | FFNEGA, FFNEG |
| 3389 | SUB0P, SUB0 |
| 3390 | / |
| 3391 | /INVERSE FLOATING DIVIDE |
| 3392 | /FSWITCH=1 |
| 3393 | /THIS IS OP/FAC |
| 3394 | / |
| 3395 | FFDIV1, 0 |
| 3396 | JMS I [PATCHF /WHICH MODE OF CALL? |
| 3397 | TAD I FFDIV1 /CALLED BY USER-GET ADDR. |
| 3398 | JMS I ARGETL /PICK UP OPERAND |
| 3399 | TAD ACL /SWAP THE FAC AND OPERAND |
| 3400 | DCA OPL /THERE IS A POINTER TO OPL |
| 3401 | TAD I AC2 /IN AC2 LEFT FROM ARGET SUBR. |
| 3402 | DCA ACL |
| 3403 | TAD ACX /MIGHT AS WELL SUBTRACT THE |
| 3404 | CLL CMA IAC /EXPONENTS HERE (SAVES A WORD) |
| 3405 | TAD OPX /THEN ZERO OPX SO WILL NOT |
| 3406 | DCA ACX /MESS UP WHEN ITS DONE AGAIN |
| 3407 | DCA OPX /LATER (SEE DIV. ROUTINE) |
| 3408 | TAD ACH |
| 3409 | DCA AC2 /NOW SWAP HIGH ORDER MANTISSAS |
| 3410 | TAD OPH |
| 3411 | DCA ACH |
| 3412 | TAD AC2 |
| 3413 | DCA OPH |
| 3414 | CDF /DF TO PACKAGE FIELD |
| 3415 | TAD FFDIV1 /NOW KLUDGE UP A SUBROUTINE LINKAGE |
| 3416 | DCA I FFDP |
| 3417 | TAD KFD1 |
| 3418 | DCA I MDSETP |
| 3419 | JMP I MD1P /GO SET UP AND DIVIDE |
| 3420 | |
| 3421 | MD1P, MD1 |
| 3422 | ARGETL, ARGET |
| 3423 | MDSETP, MDSET |
| 3424 | FFDP, FFDIV |
| 3425 | KFD1, FFD1 |
| 3426 | \f/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 | MDSET, 0 |
| 3433 | JMS I ARGETK /GET ARGUMENT |
| 3434 | MD1, CDF /DF TO PACKAGE FIELD |
| 3435 | CLA CLL CMA RAL /SET SIGN CHECK TO -2 |
| 3436 | DCA TM |
| 3437 | TAD OPH /IS OPERAND NEGATIVE? |
| 3438 | SMA CLA |
| 3439 | JMP .+3 /NO |
| 3440 | JMS I OPNEGP /YES-NEGATE IT |
| 3441 | ISZ TM /BUMP SIGN CHECK |
| 3442 | TAD OPL /AND SHIFT OPERAND LEFT ONE BIT |
| 3443 | CLL RAL |
| 3444 | DCA OPL |
| 3445 | TAD OPH |
| 3446 | RAL |
| 3447 | DCA OPH |
| 3448 | DCA AC1 /CLR. OVERFLOW WORF OF FAC |
| 3449 | TAD ACH /IS FAC NEGATIVE |
| 3450 | SMA CLA |
| 3451 | JMP LEV /NO-GO ON |
| 3452 | JMS I FFNEGK /YES-NEGATE IT |
| 3453 | ISZ TM /BUMP SIGN CHECK |
| 3454 | NOP /MAY SKIP |
| 3455 | LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC |
| 3456 | JMP I MDSET |
| 3457 | |
| 3458 | FFNEGK, FFNEG |
| 3459 | OPNEGP, OPNEG |
| 3460 | ARGETK, ARGET |
| 3461 | |
| 3462 | / |
| 3463 | /CONTINUATION OF FLOATING DIVIDE ROUTINE |
| 3464 | / |
| 3465 | FD1, TAD AC2 /NEGATE HI ORDER PRODUCT |
| 3466 | CLL CMA IAC |
| 3467 | TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV. |
| 3468 | SNL /WELL? |
| 3469 | JMP I DVOPSP /GREATER THAN REM.-ADJUST QUOT OF 1ST DIV. |
| 3470 | CLL /OK-DO (REM-(Q*OPL))/OPH |
| 3471 | DCA ACH /FIRST STORE ADJUSTED PRODUCT |
| 3472 | JMS I DV24P /DIVIDE BY OPH (HI ORDER OPERAND) |
| 3473 | DVL1, TAD AC1 /GET QUOT. OF FIRST DIV. |
| 3474 | SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT |
| 3475 | JMP FD /NO-ITS NORMALIZED-DONE |
| 3476 | CLL |
| 3477 | ISZ ACL |
| 3478 | SKP |
| 3479 | IAC |
| 3480 | RAR |
| 3481 | DCA ACH /STORE IN FAC |
| 3482 | TAD ACL /P@ LOW ORDER RIGHT |
| 3483 | RAR |
| 3484 | DCA ACL /STORE BACK |
| 3485 | ISZ ACX /BUMP EXPONENT |
| 3486 | NOP |
| 3487 | TAD ACH |
| 3488 | JMP DVL1+1 |
| 3489 | FD, DCA ACH /STORE HIGH ORDER RESULT |
| 3490 | JMP I FDDONP /GO LEAVE DIVIDE |
| 3491 | |
| 3492 | FDDONP, FDDON /END OF FLTG. DIV. ROUTINE |
| 3493 | DV24P, DV24 /ROUTINE TO DO A 24X12BIT DIVIDE |
| 3494 | 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 | DBAD1, DCA ACX /DIVIDE OVERFLO-ZERO ALL |
| 3501 | DVOP2, SNA /IS IT ZERO? |
| 3502 | DCA ACL /YES-MAKE WHOLE THING ZERO |
| 3503 | DCA ACH |
| 3504 | JMS I DV24P /DIVIDE EXTENDED REM. BY HI DIVISOR |
| 3505 | TAD ACL /NEGATE THE RESULT |
| 3506 | CLL CMA IAC |
| 3507 | DCA ACL |
| 3508 | SNL /IF QUOT. IS NON-ZERO, SUBTRACT |
| 3509 | CMA /ONE FROM HIGH ORDER QUOT. |
| 3510 | JMP DVL1 /GO TO IT |
| 3511 | |
| 3512 | PAGE |
| 3513 | \f/FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES |
| 3514 | FFMPY, 0 |
| 3515 | JMS I [PATCHF /WHICH MODE OF CALL? |
| 3516 | TAD I FFMPY /CALLED BY USER-GET OPERAND ADDR. |
| 3517 | JMS I MDSETK /SET UP FOR MPY-OPX IN AC ON RETN. |
| 3518 | TAD ACX /DO EXPONENT ADDITION |
| 3519 | DCA ACX /STORE FINAL EXPONENT |
| 3520 | DCA DV24 /ZERO TEM STORAGE FOR MPY ROUTINE |
| 3521 | DCA AC2 |
| 3522 | TAD ACH /IS FAC=0? |
| 3523 | SNA CLA |
| 3524 | DCA ACX /YES-ZERO EXPONENT |
| 3525 | JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR. |
| 3526 | TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER |
| 3527 | DCA OPL |
| 3528 | JMS MP24 |
| 3529 | TAD AC2 /STORE RESULT BACK IN FAC |
| 3530 | RTZRO, DCA ACL /LOW ORDER |
| 3531 | TAD DV24 /HIGH ORDER |
| 3532 | DCA ACH |
| 3533 | TAD ACH /DO WE NEED TO NORMALIZE? |
| 3534 | RAL |
| 3535 | SMA CLA |
| 3536 | JMP SHLFT /YES-DO IT FAST |
| 3537 | MDONE, DCA AC1 /NO-ZERO OVERFLOW WD(DO I NEED THIS???) |
| 3538 | ISZ FFMPY /BUMP RETURN POINTER |
| 3539 | ISZ TM /SHOULD RESULT BE NEGATIVE? |
| 3540 | JMP I FFMPY /NOPE-RETN. |
| 3541 | JMS I FFNEGR /YES-NEGATE IT |
| 3542 | JMP I FFMPY /RETURN |
| 3543 | SHLFT, CMA /SUBTRACT 1 FROM EXP. |
| 3544 | TAD ACX |
| 3545 | DCA ACX |
| 3546 | JMS I AL1PTR /SHIFT FAC LEFT 1 BIT |
| 3547 | JMP MDONE+1 /DONE. |
| 3548 | 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 | MP24, 0 |
| 3554 | TAD KKM12 /SET UP 12 BIT COUNTER |
| 3555 | DCA OPX |
| 3556 | TAD OPL /IS MULTIPLIER=0? |
| 3557 | SZA |
| 3558 | JMP MPLP1 /NO-GO ON |
| 3559 | DCA AC1 /YES-INSURE RESULT=0 |
| 3560 | JMP I MP24 /RETURN |
| 3561 | MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER |
| 3562 | MPLP1, RAR /OF MULTIPLIER AND INTO LINK |
| 3563 | DCA OPL |
| 3564 | SNL /WAS IT A 1? |
| 3565 | JMP MPLP2 /NO-0-JUST SHIFT PARTIAL PRODUCT |
| 3566 | \f CLL /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT |
| 3567 | TAD AC2 |
| 3568 | TAD ACL /LOW ORDER |
| 3569 | DCA AC2 |
| 3570 | RAL /PROPAGATE CARRY |
| 3571 | TAD ACH /HI ORDER |
| 3572 | MPLP2, TAD DV24 |
| 3573 | RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT |
| 3574 | DCA DV24 |
| 3575 | TAD AC2 |
| 3576 | RAR |
| 3577 | DCA AC2 |
| 3578 | RAR /1 BIT OF OVERFLOW TO AC1 |
| 3579 | DCA AC1 |
| 3580 | ISZ OPX /DONE ALL 12 MULTIPLIER BITS? |
| 3581 | JMP MPLP /NO-GO ON |
| 3582 | JMP I MP24 /YES-RETURN |
| 3583 | / |
| 3584 | /PART OF DIVIDE ROUTINE-FFDIV MUST BE AT LOC. 6722 |
| 3585 | MP12L, DCA OPL /STORE BACK MULTIPLIET |
| 3586 | TAD AC2 /GET PRODUCT SO FAR |
| 3587 | SNL /WAS MULTIPLIER BIT A 1? |
| 3588 | JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT |
| 3589 | CLL /YES-CLEAR LINK AND ADD MULTIPLICAND |
| 3590 | TAD ACL /TO PARTIAL PRODUCT |
| 3591 | RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER |
| 3592 | DCA AC2 /RESULT-STORE BACK |
| 3593 | DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER |
| 3594 | RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.) |
| 3595 | ISZ FFMPY /DONE ALL BITS? |
| 3596 | JMP MP12L /NO-LOOP BACK |
| 3597 | CLL CMA IAC /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC |
| 3598 | DCA ACL /NEGATE AND STORE |
| 3599 | CML RAL /PROPAGATE CARRY |
| 3600 | JMP I FD1P /GO ON |
| 3601 | FD1P, FD1 /POINTER TO REST OF DIVIDE ROUTINE |
| 3602 | / |
| 3603 | /FLOATING DIVIDE ROUTINE |
| 3604 | /USES THE METHOD OF TRIAL DIVISION BY HI ORDER |
| 3605 | FFDIV, 0 /(USED AS A TEM. BY I/O ROUTINES) |
| 3606 | JMS I [PATCHF /WHICH MODE OF CALL? |
| 3607 | TAD I FFDIV /CALLED BY USER-GET ARG. ADDR. |
| 3608 | JMS I MDSETK /GO SET UP FOR DIVIDE-OPX IN AC ON RETN. |
| 3609 | FFD1, CMA IAC /NEGATE EXP. OF OPERAND |
| 3610 | TAD ACX /ADD EXP OF FAC |
| 3611 | DCA ACX /STORE AS FINAL EXPONENT |
| 3612 | TAD OPH /NEGATE HI ORDER OP. FOR USE |
| 3613 | CLL CMA IAC /AS DIVISOR |
| 3614 | DCA OPH |
| 3615 | JMS DV24 /CALL DIV.--(ACH+ACL)/OPH |
| 3616 | TAD ACL /SAVE QUOT. FOR LATER |
| 3617 | DCA AC1 |
| 3618 | TAD KM13 /SET COUNTER FOR 12 BIT MULTIPLY |
| 3619 | DCA FFMPY /TO MULTIPLY QUOT. OF DIV. BY |
| 3620 | JMP DVLP1 /LOW ORDER OF OPERAND (OPL) |
| 3621 | \f/ |
| 3622 | /END OF FLOATING DIVIDE-FUDGE SOME |
| 3623 | /STUFF THEN JUMP INTO MULTIPLY |
| 3624 | / |
| 3625 | FDDON, TAD FFDIV /STORE RETN. ADDR. IN MULT ROUTINE |
| 3626 | DCA FFMPY |
| 3627 | 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 | DV24, 0 |
| 3635 | TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND |
| 3636 | TAD OPH /DIVISOR IN OPH (NEGATIVE) |
| 3637 | SZL CLA /IS IT? |
| 3638 | JMP I DVOVR /NO-DIVIDE OVERFLOW |
| 3639 | TAD KM13 /YES-SET UP 12 BIT LOOP |
| 3640 | DCA AC2 |
| 3641 | JMP DV1 /GO BEGIN DIVIDE |
| 3642 | DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT |
| 3643 | RAL |
| 3644 | DCA ACH /RESTORE HI ORDER |
| 3645 | TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER |
| 3646 | TAD OPH /DIVIDEND |
| 3647 | SZL /GOOD SUBTRACT? |
| 3648 | DCA ACH /YES-RESTORE HI DIVIDEND |
| 3649 | CLA /NO-DON'T RESTORE--OPH.GT.ACH |
| 3650 | DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT |
| 3651 | RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL |
| 3652 | DCA ACL |
| 3653 | ISZ AC2 /DONE 12 BITS OF QUOT? |
| 3654 | JMP DV2 /NO-GO ON |
| 3655 | JMP I DV24 /YES-RETN W/AC2=0 |
| 3656 | FFNEGR, FFNEG |
| 3657 | MDSETK, MDSET |
| 3658 | KKM12, -14 |
| 3659 | KM13, -15 |
| 3660 | DVOVR, DV |
| 3661 | |
| 3662 | PAGE |
| 3663 | \f/ |
| 3664 | /FLOATING ADD |
| 3665 | / |
| 3666 | FFADD, 0 |
| 3667 | JMS I [PATCHF /WHICH MODE FO CALL? |
| 3668 | TAD I FFADD /CALLED BY USER-GET ADDR. OF OPR. |
| 3669 | JMS I ARGETP /PICK UP OPERAND |
| 3670 | FAD1, CDF /DF TO PACKAGE FIELD |
| 3671 | TAD OPH /IS OPERAND = 0 |
| 3672 | SNA CLA |
| 3673 | JMP DONA /YES-DONE |
| 3674 | TAD ACH /NO-IS FAC=0? |
| 3675 | SNA CLA |
| 3676 | JMP DOADD /YES-DO ADD |
| 3677 | TAD ACX /NO-DO EXPONENT CALCULATION |
| 3678 | CLL CMA IAC |
| 3679 | TAD OPX |
| 3680 | SMA SZA /WHICH EXP. GREATER? |
| 3681 | JMP FACR /OPERANDS-SHIFT FAC |
| 3682 | CMA IAC /FAC'S-SHIFT OPERAND=DIFFRNCE+1 |
| 3683 | JMS OPSR |
| 3684 | JMS ACSR /SHIFT FAC ONE PLACE RIGHT |
| 3685 | DOADD, TAD OPX /SET EXPONENT OF RESULT |
| 3686 | DCA ACX |
| 3687 | JMS OADD /DO THE ADDITION |
| 3688 | JMS I FNORP /NORMALIZE RESULT |
| 3689 | DONA, ISZ FFADD /BUMP RETURN |
| 3690 | JMP I FFADD /RETURN |
| 3691 | FACR, JMS ACSR /SHIFT FAC = DIFF.+1 |
| 3692 | JMS OPSR /SHIFT OPR. 1 PLACE |
| 3693 | JMP DOADD /DO ADDITION |
| 3694 | / |
| 3695 | /OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 |
| 3696 | /IN AC |
| 3697 | OPSR, 0 |
| 3698 | CMA /- (COUNT+1) TO SHIFT COUNTER |
| 3699 | DCA AC0 |
| 3700 | LOP2, TAD OPH /GET SIGN BIT |
| 3701 | RAL /TO LINK |
| 3702 | CLA |
| 3703 | TAD OPH /GET HI MANTISSA |
| 3704 | RAR /SHIFT IT RIGHT, PROPAGATING SIGN |
| 3705 | DCA OPH /STORE BACK |
| 3706 | TAD OPL |
| 3707 | RAR |
| 3708 | DCA OPL /STORE LO ORDER BACK |
| 3709 | RAR /SAVE 1 BIT OF OVERFLOW |
| 3710 | DCA AC2 /IN AC2 |
| 3711 | ISZ OPX /INCREMENT EXPONENT |
| 3712 | NOP2, NOP |
| 3713 | ISZ AC0 /DONE ALL SHIFTS? |
| 3714 | JMP LOP2 /NO-LOOP |
| 3715 | JMP I OPSR /YES-RETN. |
| 3716 | \f/ |
| 3717 | /SHIFT FAC LEFT 1 BIT |
| 3718 | / |
| 3719 | AL1, 0 |
| 3720 | TAD AC1 /GET OVERFLOW BIT |
| 3721 | CLL RAL /SHIFT LEFT |
| 3722 | DCA AC1 /STORE BACK |
| 3723 | TAD ACL /GET LOW ORDER MANTISSA |
| 3724 | RAL /SHIFT LEFT |
| 3725 | DCA ACL /STORE BACK |
| 3726 | TAD ACH /GET HI ORDER |
| 3727 | RAL |
| 3728 | DCA ACH /STORE BACK |
| 3729 | JMP I AL1 /RETN. |
| 3730 | / |
| 3731 | /SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE) |
| 3732 | / |
| 3733 | ACSR, 0 |
| 3734 | CMA /AC CONTAINS COUNT-1 |
| 3735 | DCA AC0 /STORE COUNT |
| 3736 | LOP1, TAD ACH /GET SIGN BIT OF MANTISSA |
| 3737 | RAL /SET UP SIGN PROPAGATION |
| 3738 | CLA |
| 3739 | TAD ACH /GET HIGH ORDER MANTISSA |
| 3740 | RAR /SHIFT RIGHT`1, PROPAGATING SIGN |
| 3741 | DCA ACH /STORE BACK |
| 3742 | TAD ACL /GET LOW ORDER |
| 3743 | RAR /SHIFT IT |
| 3744 | DCA ACL /STORE BACK |
| 3745 | RAR |
| 3746 | DCA AC1 /SAVE 1 BIT OF OVERFLOW |
| 3747 | ISZ ACX /INCREMENT EXPONENT |
| 3748 | NOP1, NOP |
| 3749 | ISZ AC0 /DONE? |
| 3750 | JMP LOP1 /NO-LOOP |
| 3751 | JMP I ACSR /YES-RETN-AC=L=0 |
| 3752 | / |
| 3753 | /DIVIDE OVERFLOW-ZERO ACX,ACH,ACL |
| 3754 | / |
| 3755 | DBAD, CLA CLL /NECESSARY SO WE DON'T GET OVRFLO AGAIN |
| 3756 | JMP I DBAD1P /GO ZERO ALL |
| 3757 | / |
| 3758 | /FLOATING SUBTRACT |
| 3759 | / |
| 3760 | FFSUB, 0 |
| 3761 | JMS I [PATCHF /WHICH MODE OF CALL? |
| 3762 | TAD I FFSUB /CALLED BY USER-GET ADDR. OF OP |
| 3763 | JMS I ARGETP /PICK UO THE OP. |
| 3764 | JMS OPNEG /NEGATE OPERAND |
| 3765 | TAD FFSUB /JMP INTO FLTG. ADD |
| 3766 | SUB0, DCA FFADD /AFTER SETTING UP RETURN |
| 3767 | JMP FAD1 |
| 3768 | ARGETP, ARGET |
| 3769 | \f *6135 |
| 3770 | / |
| 3771 | /FLOATING NEGATE |
| 3772 | / |
| 3773 | FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE) |
| 3774 | TAD ACL /GET LOW ORDER FAC |
| 3775 | CLL CMA IAC /NEGATE IT |
| 3776 | DCA ACL /STORE BACK |
| 3777 | CML RAL /ADJUST OVERFLOW BIT AND |
| 3778 | TAD ACH /PROPAGATE CARRY-GET HI ORD |
| 3779 | CLL CMA IAC /NEGATE IT |
| 3780 | DCA ACH /STORE BACK |
| 3781 | JMP I FFNEG |
| 3782 | / |
| 3783 | /NEGATE OPERAND |
| 3784 | / |
| 3785 | OPNEG, 0 |
| 3786 | TAD OPL /GET LOW ORDER |
| 3787 | CLL CMA IAC /NEGATE AND STORE BACK |
| 3788 | DCA OPL |
| 3789 | CML RAL /PROPAGATE CARRY |
| 3790 | TAD OPH /GET HI ORDER |
| 3791 | CLL CMA IAC /NEGATE AND STORE BACK |
| 3792 | DCA OPH |
| 3793 | JMP I OPNEG |
| 3794 | / |
| 3795 | /ADD OPERAND TO FAC |
| 3796 | / |
| 3797 | OADD, 0 |
| 3798 | CLL |
| 3799 | TAD AC2 /ADD OVERFLOW WORDS |
| 3800 | TAD AC1 |
| 3801 | DCA AC1 |
| 3802 | RAL /ROTATE CARRY |
| 3803 | TAD OPL /ADD LOW ORDER MANTISSAS |
| 3804 | TAD ACL |
| 3805 | DCA ACL |
| 3806 | RAL |
| 3807 | TAD OPH /ADD HI ORDER MANTISSAS |
| 3808 | TAD ACH |
| 3809 | DCA ACH |
| 3810 | JMP I OADD /RETN. |
| 3811 | DBAD1P, DBAD1 |
| 3812 | FNORP, FFNOR |
| 3813 | > |
| 3814 | \f 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 | \f/ |
| 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 | \fEDON, 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 | \f/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 | \f 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 | \f |
| 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 | \f/ |
| 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 | \f |
| 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 | \f |
| 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 | \f/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 | \f 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 | \f/ |
| 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 | \f 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 | ARGET, 0 |
| 4374 | DCA AC2 /STORE ADDRESS OF OPERAND |
| 4375 | TAD I AC2 /PICK UP EXPONENT |
| 4376 | DCA OPX |
| 4377 | JMS ISZAC2 /MOVE POINTER TO HORD,WATCH FOR FIELD OVERLAP |
| 4378 | TAD I AC2 /PICK IT UP |
| 4379 | IFZERO EAE < |
| 4380 | NOP |
| 4381 | NOP |
| 4382 | > |
| 4383 | |
| 4384 | IFNZRO EAE < |
| 4385 | SWAB /OPH INTO MQ BECAUSE EAE ROUTINES |
| 4386 | MQA /EXPECT TO FIND IT THERE |
| 4387 | > |
| 4388 | DCA OPH /STORE |
| 4389 | JMS ISZAC2 /MOVE POINTER TO LORD,WATCHING FOR OVERLAP |
| 4390 | TAD I AC2 /PICK IT UP |
| 4391 | DCA OPL /STORE IT |
| 4392 | JMP I ARGET /RETURN |
| 4393 | \f IFZERO EAE < |
| 4394 | / |
| 4395 | /ROUTINE TO NORMALIZE THE FAC |
| 4396 | / |
| 4397 | FFNOR, 0 |
| 4398 | TAD ACH /GET THE HI ORDER MANTISSA |
| 4399 | SNA /ZERO? |
| 4400 | TAD ACL /YES-HOW ABOUT LOW? |
| 4401 | SNA |
| 4402 | TAD AC1 /LOW=0, IS OVRFLO BIT ON? |
| 4403 | SNA CLA |
| 4404 | JMP ZEXP /#=0-ZERO EXPONENT |
| 4405 | NORMLP, AC2000 /NOT 0-MAKE A 2000 IN AC |
| 4406 | TAD ACH /ADD HI ORDER MANTISSA |
| 4407 | SZA /HI ORDER = 6000 |
| 4408 | JMP .+3 /NO-CHECK LEFT MOST DIGIT |
| 4409 | TAD ACL /YES-6000 OK IF LOW=0 |
| 4410 | SZA CLA |
| 4411 | SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS. |
| 4412 | JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7) |
| 4413 | JMP FNLP /JUMP SO FFGET AND PUT ARE ORGED RIGHT |
| 4414 | |
| 4415 | FFNORR, DCA AC1 /DONE W/NORMALIZE-CLEAR AC1 |
| 4416 | JMP I FFNOR /RETURN |
| 4417 | 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 | \f/FLOATING GET |
| 4444 | |
| 4445 | *6241 |
| 4446 | FFGET, 0 |
| 4447 | JMS I [PATCHF /WHICH MODE OF CALL |
| 4448 | TAD I FFGET /CALLED BY USER-GET ADDR. OF OP |
| 4449 | JMS ARGET /PICK UP OPERAND |
| 4450 | TAD OPX |
| 4451 | DCA ACX /LOAD THE OPERAND INTO FAC |
| 4452 | TAD OPL |
| 4453 | DCA ACL |
| 4454 | TAD OPH |
| 4455 | DCA ACH |
| 4456 | ISZ FFGET |
| 4457 | CDF |
| 4458 | JMP I FFGET /RETN. TO CALL +2 |
| 4459 | / |
| 4460 | /FLOATING PUT |
| 4461 | / |
| 4462 | FFPUT, 0 |
| 4463 | JMS I [PATCHF /WHICH MODE OF CALL? |
| 4464 | TAD I FFPUT /CALLED BY USER-GET OPR. ADDR |
| 4465 | DCA FFGET /STORE IN A TEMP |
| 4466 | TAD ACX /GET FAC AND STORE IT |
| 4467 | DCA I FFGET /AT SPECIFIED ADDRESS |
| 4468 | JMS ISZFGT /BUMP POINTER,WATCHING FOR FIELD OVERLAP |
| 4469 | TAD ACH |
| 4470 | DCA I FFGET |
| 4471 | JMS ISZFGT |
| 4472 | TAD ACL |
| 4473 | DCA I FFGET |
| 4474 | ISZ FFPUT /BUMP RETN. |
| 4475 | CDF |
| 4476 | 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 | ISZFGT, 0 |
| 4482 | ISZ FFGET /BUMP POINTER |
| 4483 | JMP I ISZFGT /NO SKIP MEANS JUST RETURN |
| 4484 | SKP /SKIP MEANS WE HAVE TO INCREMENT DATA FIELD |
| 4485 | NEWCDF, DCA ISZFGT /THIS INST EXECUTED ONLY BY ISZAC2 |
| 4486 | RDF /GET THE DATA FIELD |
| 4487 | TAD CDF10 /BUMP BY 1 AND MAKE A CDF |
| 4488 | DCA .+1 /PUT IN LINE |
| 4489 | . |
| 4490 | JMP I ISZFGT /RETURN |
| 4491 | |
| 4492 | CDF10, CDF 10 |
| 4493 | |
| 4494 | ISZAC2, 0 |
| 4495 | ISZ AC2 /BUMP POINTER |
| 4496 | JMP I ISZAC2 /NOTHING HAPPENED |
| 4497 | TAD ISZAC2 /NEED NEW DF. GET RETURN ADDR |
| 4498 | JMP NEWCDF /AND BUMP DF |
| 4499 | \f 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 | DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER |
| 4506 | DCA ACH |
| 4507 | CLL |
| 4508 | TAD OPH |
| 4509 | TAD ACH /WATCH FOR OVERFLOW |
| 4510 | SNL |
| 4511 | JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV. |
| 4512 | DCA ACH /NO OVERFLOW-STORE NEW REM. |
| 4513 | CMA /SUBTRACT 1 FROM QUOT OF |
| 4514 | TAD AC1 /FIRST DIVIDE |
| 4515 | DCA AC1 |
| 4516 | DVOP1, CLA CLL |
| 4517 | TAD ACH /GET HI ORD OF REMAINDER |
| 4518 | JMP I DVOP2P /GO ON |
| 4519 | DVOP2P, DVOP2 |
| 4520 | |
| 4521 | FNLP, CLL CML CMA /-1 |
| 4522 | TAD ACX /SUBTR. 1 FROM EXPONENT |
| 4523 | DCA ACX |
| 4524 | JMS I AL1P /SHIFT FAC LEFT 1 |
| 4525 | JMP NORMLP /GO BACK AND SEE IF NORMALIZED |
| 4526 | ZEXP, DCA ACX |
| 4527 | JMP FFNORR |
| 4528 | > |
| 4529 | \f/ |
| 4530 | /FSQUARE-SQUARE FAC-CALLS MULTIPLY TO MUL. FAC BY ITSELF |
| 4531 | / |
| 4532 | *6347 |
| 4533 | A, |
| 4534 | FFSQ, 0 |
| 4535 | JMS I TMPY /CALL MULTIPLY TO MULTIPLY |
| 4536 | ACX /FAC BY ITSELF |
| 4537 | JMP I FFSQ /DONE |
| 4538 | TMPY, FFMPY |
| 4539 | / |
| 4540 | / ERROR TRAPS |
| 4541 | O0, JMS I [ERROR /OVERFLOW |
| 4542 | DV, JMS I [ERROR /DIVISION ERROR |
| 4543 | JMS I [FACCLR /RETURN 0 IN FAC |
| 4544 | JMP I [ILOOP |
| 4545 | LM, JMS I [ERROR /ILLEGAL ARGUMENT |
| 4546 | |
| 4547 | PAGE |
| 4548 | |
| 4549 | \f *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 | TTYDRI, 0 |
| 4557 | JMP LFLUSH+1 |
| 4558 | IO, JMS I [ERROR |
| 4559 | LFLUSH, JMS I [CRLFR /PRINT A CR,LF |
| 4560 | TAD K277 /PRINT A ? SIGNIFYING WAIT FOR INPUT |
| 4561 | JMS I [XPUTCH |
| 4562 | TAD I IOTBUF /BUFFER ADDRESS |
| 4563 | DCA I IOTPTR /INITIALIZE POINTER TO START OF BUFFER |
| 4564 | JMS I [CNOCLR /INITIALIZE CHAR # TO 1 |
| 4565 | TTYIN, JMS I [XPRINT /EMPTY TTY BUFFER BEFORE AWAITING INPUT |
| 4566 | JMP .-1 |
| 4567 | TAD I (HEIGHT /ALWAYS RESET SCREEN HIEGHT ON INPUT |
| 4568 | DCA I (HCTR |
| 4569 | TAD K5252 /DESIGN INTO AC |
| 4570 | KSFA, KSF /CHAR READY? |
| 4571 | JMP SPIN /NO-DIDDLE WHILE WE WAIT |
| 4572 | CLA CLL /FLUSH SPINNER OUT OF AC |
| 4573 | TAD [200 /FORCE PARITY BIT |
| 4574 | KRS /GET CHAR |
| 4575 | DCA CHAR /SAVE |
| 4576 | TAD CHAR |
| 4577 | JMS I [XPUTCH /ECHO IT |
| 4578 | KCC /CLEAR KEYBOARD FLAG AND SET READER RUN |
| 4579 | TAD CHAR |
| 4580 | TAD MCTRLU /IS IT CTRL/U? |
| 4581 | SNA CLA |
| 4582 | JMP LFLUSH /YES-START AGAIN |
| 4583 | TAD CHAR /NO |
| 4584 | TAD CRUBOT /IS IT RUBOUT? |
| 4585 | SNA |
| 4586 | JMP BACKUP /YES-BACK UP BUFFER POINTER |
| 4587 | TAD MCR /NO-IS IT CR? |
| 4588 | SNA CLA |
| 4589 | JMP CR /YES-DONE |
| 4590 | TAD CHAR |
| 4591 | JMS I [PACKCH /PACK CHAR IN BUFFER |
| 4592 | JMS I [BUFCHK /BUFFER FULL? |
| 4593 | JMP IO /YES-ERROR |
| 4594 | NOP /NO-CHAR 3 LEFT |
| 4595 | NOP /NO-2 AND 3 LEFT |
| 4596 | JMP TTYIN /NO-NEXT CHAR |
| 4597 | MCTRLU, -225 |
| 4598 | MCR, 377-215 |
| 4599 | CRUBOT, -377 |
| 4600 | K5252, 5252 |
| 4601 | K277, 277 |
| 4602 | |
| 4603 | BACKUP, TAD I IOTPTR /BUFFER POINTER |
| 4604 | CIA /NEGATE |
| 4605 | TAD I IOTBUF /COMPARE AGAINST START OF BUFFER |
| 4606 | SNA CLA /BUFFER EMPTY? |
| 4607 | JMP TTYIN /YES-THERE IS NOTHING TO RUBOUT |
| 4608 | TAD SCOPFG /TEST IF CONSOLE IS A SCOPE |
| 4609 | SNA CLA |
| 4610 | JMP NOSCOP /JMP IF NOT |
| 4611 | TAD (10 |
| 4612 | JMS I [XPUTCH /PRINT BS,SP,BS TO RUBOUT IF SCOPE |
| 4613 | TAD (40 |
| 4614 | JMS I [XPUTCH |
| 4615 | TAD (10 |
| 4616 | SKP |
| 4617 | NOSCOP, TAD K334 |
| 4618 | JMS I [XPUTCH /ECHO "\" |
| 4619 | JMS I [CHARNO /GET CHAR # OF NEXT CHAR (LAST #+1) |
| 4620 | JMP C1B /1 |
| 4621 | JMP C3B /3 |
| 4622 | JMS I [CNOCLR /IT WAS 2-MAKE IT 1 |
| 4623 | PBACK, CLA CMA /-1 |
| 4624 | TAD I IOTPTR /BACK UP BUFFER POINTER |
| 4625 | DCA I IOTPTR |
| 4626 | JMP TTYIN /NEXT CHAR |
| 4627 | K334, 334 |
| 4628 | |
| 4629 | C1B, TAD I IOTHDR |
| 4630 | AND [7477 |
| 4631 | TAD [200 /IT WAS 1-MAKE IT 3 |
| 4632 | DCA I IOTHDR |
| 4633 | JMP TTYIN /NO NEED TO BACK UP POINTER |
| 4634 | |
| 4635 | C3B, TAD I IOTHDR |
| 4636 | AND [7477 |
| 4637 | TAD [100 /IT WAS 3,MAKE IT 2 |
| 4638 | DCA I IOTHDR |
| 4639 | JMP PBACK /BACK UP POINTER |
| 4640 | |
| 4641 | |
| 4642 | CR, JMS I [CRLFR /ECHO A CR,LF |
| 4643 | TAD K4 |
| 4644 | TAD TTYDRI /BUMP DRIVE RETURN TO NORMAL |
| 4645 | DCA TTYDRI |
| 4646 | TAD CHAR |
| 4647 | JMS I [PACKCH /PACK CHAR IN BUFFER |
| 4648 | TAD I IOTBUF |
| 4649 | DCA I IOTPTR /INITAILZE BUFFER POINTERS |
| 4650 | JMS I [CNOCLR |
| 4651 | JMP I TTYDRI /RETURN |
| 4652 | K4, 4 |
| 4653 | |
| 4654 | |
| 4655 | SPIN, ISZ SPINNR /SPIN RANDOM # SEED |
| 4656 | SKP |
| 4657 | CMA CML RAL /MARCH TO THE LEFT |
| 4658 | JMP KSFA /CHECK FOR CHAR YET |
| 4659 | SCOPFG, 0 /GETS SET TO SCOPE FLAG BY STARTUP CODE |
| 4660 | \f/SUBROUTINE FBITGT-ROUTINE TO PUT FUNCTION BITS FROM INSTRUCTION INTO AC |
| 4661 | |
| 4662 | FBITGT, 0 |
| 4663 | TAD INSAV |
| 4664 | CLL RTR |
| 4665 | RTR /PUT FUNCTION BITS IN BITS 8-11 |
| 4666 | AND [17 /MASK THEM OFF |
| 4667 | JMP I FBITGT /RETURN |
| 4668 | |
| 4669 | /DATA LIST READ (NUMERIC) |
| 4670 | |
| 4671 | RDLIST, JMS I (DLREAD /FETCH WORD FROM LIST |
| 4672 | DCA ACX /STORE AS EXPONENT |
| 4673 | JMS I (DLREAD |
| 4674 | DCA ACH /HIGH MANTISSA |
| 4675 | JMS I (DLREAD |
| 4676 | DCA ACL /LOW MANTISSA |
| 4677 | JMP I [ILOOP |
| 4678 | |
| 4679 | /SUBROUTINE FTYPE-RETURNS TO CALL+1 IF FILE NUMERIC,CALL+2 IF ASCII |
| 4680 | |
| 4681 | FTYPE, 0 |
| 4682 | TAD I IOTHDR /GET HEADER |
| 4683 | CLL RAR /TYPE TO LINK |
| 4684 | SZL CLA /IS IT NUMERIC? |
| 4685 | ISZ FTYPE /NO-BUMP RETURN |
| 4686 | JMP I FTYPE /RETURN |
| 4687 | |
| 4688 | PAGE |
| 4689 | \f/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 | START4, TAD CDFPS /DF FOR BOTTOM OF PSEUDO-CODE |
| 4696 | TAD MCDF1 /COMPARE TO A CDF 10 |
| 4697 | SZA CLA /DO THEY MATCH? |
| 4698 | JMP I [ILOOP /NO-ALL BUFFERS ARE FREE-START INTERPRETER |
| 4699 | TAD PSSTRT |
| 4700 | CLL CMA |
| 4701 | TAD [400 |
| 4702 | SNL CLA /IS START OF PSEUDO-CODE BELOW 400 |
| 4703 | JMP CHKB2 /NO-CHECK FOR 1000 |
| 4704 | TAD [17 /YES-SET ALL BUFFERS BUSY |
| 4705 | JMP BAS |
| 4706 | CHKB2, TAD PSSTRT |
| 4707 | CLL CMA |
| 4708 | TAD C1000 |
| 4709 | SNL CLA /IS START OF PSEUDO-CODE BELOW 1000 |
| 4710 | JMP CHKB3 /NO-CHECK 1400 |
| 4711 | TAD C16 /YES-ONLY BUFFER 1 IS AVAILABLE |
| 4712 | JMP BAS |
| 4713 | CHKB3, TAD PSSTRT |
| 4714 | CLL CMA |
| 4715 | TAD C1400 |
| 4716 | SNL CLA /IS START OF CODE BELOW 1400? |
| 4717 | JMP CHKB4 /YES-CHECK 2000 |
| 4718 | TAD C14 /YES-ONLY BUFFER 1 AND 2 AVAILABLE |
| 4719 | JMP BAS |
| 4720 | CHKB4, TAD PSSTRT |
| 4721 | CLL CMA |
| 4722 | TAD K2000 |
| 4723 | SNL CLA /IS CODE START BELOW 2000? |
| 4724 | JMP I [ILOOP /NO-START INTERPRETER-ALL BUFFER FREE |
| 4725 | TAD [10 /YES-BUFFERS 1,2, AND 3 AVAILABLE |
| 4726 | BAS, DCA BMAP |
| 4727 | JMP I [ILOOP /START INTERPRETER |
| 4728 | 0 |
| 4729 | MCDF1, -6211 |
| 4730 | K2000, 2000 |
| 4731 | C14, 14 |
| 4732 | C16, 16 |
| 4733 | C1000, 1000 |
| 4734 | C1400, 1400 |
| 4735 | ZBLOCK 10 |
| 4736 | TTYEND, 0 |
| 4737 | \f *OVERLAY+3277 |
| 4738 | |
| 4739 | //////////////////////////////////////////////////////////////// |
| 4740 | /////// I/O TABLE 5 13-WORD ENTRIES //////////////////////////// |
| 4741 | //////////////////////////////////////////////////////////////// |
| 4742 | |
| 4743 | TTYF, 1 /TELETYPE ENTRY-FILE IS ASCII |
| 4744 | TTYBUF /BUFFER ADDRESS |
| 4745 | 0 /CURRENT BLOCK IN BUFFER |
| 4746 | TTYBUF /READ WRITE POINTER |
| 4747 | TTYDRI /HANDLER ENTRY |
| 4748 | ZBLOCK 10 |
| 4749 | FILE1, ZBLOCK 15 /FILE #1 |
| 4750 | FILE2, ZBLOCK 15 /FILE #2 |
| 4751 | FILE3, ZBLOCK 15 /FILE #3 |
| 4752 | FILE4, ZBLOCK 15 /FILE #4 |
| 4753 | |
| 4754 | PAGE |
| 4755 | \f /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 | \f///////////////////////////////////////////////////////////// |
| 4784 | ///////////////////////////////////////////////////////////// |
| 4785 | ////////////// OVERLAY 2- STRING FUNCTIONS ///////////////// |
| 4786 | ///////////////////////////////////////////////////////////// |
| 4787 | ///////////////////////////////////////////////////////////// |
| 4788 | |
| 4789 | FIELD 1 |
| 4790 | *2000 |
| 4791 | RELOC OVERLAY |
| 4792 | |
| 4793 | /VERSION NUMBER WORD FOR STRING OVERLAY |
| 4794 | |
| 4795 | VERSON^100+SUBVSF+6000 |
| 4796 | |
| 4797 | /CHR$ FUNCTION |
| 4798 | /RETURNS 1 6BIT CHAR STRING FOR THE VALUE OF X |
| 4799 | |
| 4800 | CHR, JMS I PUNSFIX /FIX X TO 12 BIT INTEGER |
| 4801 | AND O77 /MASK TO 6BIT |
| 4802 | DCA I (SAC /AND PUT INTO SAC |
| 4803 | CMA |
| 4804 | DCA SACLEN /SET SAC LENGTH TO 1 |
| 4805 | JMP I (SSMODE /SET TO SMODE AND RETURN |
| 4806 | |
| 4807 | /ASC FUNCTION |
| 4808 | /RETURNS DECIMAL ASCII FOR 1 CHAR STRING IN FAC |
| 4809 | |
| 4810 | ASC, TAD I (SAC /GET FIRST CHAR OF STRING |
| 4811 | JMP FLOATS /FLOAT RESULT INTO FAC AND RETURN |
| 4812 | |
| 4813 | /LEN FUNCTION |
| 4814 | /RETURNS LENGTH OF SAC IN FAC |
| 4815 | |
| 4816 | LEN, TAD SACLEN /LENGTH OF STRING IN SAC |
| 4817 | CIA /MAKE POSITIVE |
| 4818 | |
| 4819 | /ROUTINE TO FLOAT FAC AND RETURN |
| 4820 | |
| 4821 | FLOATS, DCA ACH /NUMBER TO BE FLOATED IN HORD |
| 4822 | DCA ACL /CLEAR LORD |
| 4823 | DCA TEMP2 /CLEAR FPP OVERFLOW |
| 4824 | TAD (13 /SET EXP TO 11 |
| 4825 | DCA ACX |
| 4826 | JMS I PFFNOR /NORMALIZE |
| 4827 | JMP I PILOOP /RETURN |
| 4828 | \f |
| 4829 | |
| 4830 | |
| 4831 | /STR$ FUNCTION |
| 4832 | /RETURNS ASCII STRING FOR NUMBER IN FAC |
| 4833 | |
| 4834 | STR, JMS I (FFOUT /GET NUMBER INTO INTERMEDIATE BUFFER FIRST |
| 4835 | TAD XR1 |
| 4836 | CIA |
| 4837 | TAD (INTERB-1 |
| 4838 | DCA SACLEN |
| 4839 | TAD SACLEN /NOW SAVE COUNTER |
| 4840 | DCA TEMP2 |
| 4841 | TAD (INTERB-1 |
| 4842 | DCA XR1 /POINT AT BUFFER |
| 4843 | STRLUP, TAD I XR1 /GET A CHAR |
| 4844 | AND O77 /MASK TO 6BIT |
| 4845 | TAD (-40 /CROCK TO DELETE BLANKS |
| 4846 | SZA |
| 4847 | JMP .+3 |
| 4848 | ISZ SACLEN /IGNORE THE BLANK |
| 4849 | JMP .+3 |
| 4850 | TAD (40 |
| 4851 | DCA I SACXR /STORE IN SAC |
| 4852 | ISZ TEMP2 |
| 4853 | JMP STRLUP /LOOP FOR MORE |
| 4854 | JMP I (SSMODE /DONE-RETURN IN SMODE |
| 4855 | \f |
| 4856 | /VAL FUNCTION |
| 4857 | /RETURNS NUMBER IN FAC FOR STRING IN SAC |
| 4858 | |
| 4859 | VAL, TAD SACLEN |
| 4860 | DCA VALCNT /COUNT OF CHARS TO INPUT |
| 4861 | TAD (VALGET /ADDR OF PHONY INPUT ROUTINE |
| 4862 | DCA I (IGETCH /PUT IN INPUT ROUTINE IN PLACE OF KRB |
| 4863 | JMS I (FFIN /CALL FPP INPUT ROUTINE |
| 4864 | TAD PGETCH /NOW RESTORE REAL INPUT ADDR |
| 4865 | DCA I (IGETCH /RESTORE IN INPUT ROUTINE |
| 4866 | JMP I PILOOP /DONE |
| 4867 | |
| 4868 | VALGET, 0 |
| 4869 | TAD VALCNT /TEST NUMBER OF CHARS LEFT |
| 4870 | SNA CLA |
| 4871 | JMP EOVAL /NONE |
| 4872 | ISZ VALCNT /ELSE BUMP |
| 4873 | NOP |
| 4874 | TAD I SACXR /GET A BYTE |
| 4875 | TAD (240 |
| 4876 | AND O77 |
| 4877 | TAD (240 /CONVERT TO 8BIT |
| 4878 | SKP |
| 4879 | EOVAL, TAD O215 |
| 4880 | DCA CHAR |
| 4881 | JMP I VALGET /RETURN WITH CHAR IN 'CHAR' |
| 4882 | |
| 4883 | VALCNT, 0 |
| 4884 | |
| 4885 | PAGE |
| 4886 | \f/ 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 | DATE, TAD CDFIO /COPY CDF TO FIELD 17600 IN LINE |
| 4892 | DCA .+1 |
| 4893 | YEAREX, 0 |
| 4894 | TAD PSFLAG /GET TD8E BIT TO LINK |
| 4895 | CLL RAL |
| 4896 | SNL CLA |
| 4897 | TAD I (MDATE /IF ZERO LOOK AT MDATE IN N7600 |
| 4898 | SZL |
| 4899 | TAD I (MDATE-200 /ELSE LOOK AT N7400 |
| 4900 | DCA DATEWD /STORE (DATE IS NOT A CLOSED SUBROUTINE) |
| 4901 | CDF /DATE IS IN THE FORM MMM MDD DDD YYY |
| 4902 | TAD DATEWD /PICK UP DATE |
| 4903 | SZA CLA |
| 4904 | TAD (-10 /RETURN 8. BYTES IF NOT NULL DATE |
| 4905 | DCA SACLEN /SET SAC LENGTH |
| 4906 | TAD I (BIPCCL /NOW GET YEAR EXTENSION |
| 4907 | AND (600 /IT'S IN THE 600 BITS |
| 4908 | CLL RTR |
| 4909 | RTR /SHIFT INTO PLACE |
| 4910 | DCA YEAREX /HOLD YEAR EXTENSION |
| 4911 | TAD DATEWD /NOW ISOLATE MONTH |
| 4912 | AND O7400 |
| 4913 | CLL RTL |
| 4914 | RTL |
| 4915 | RAL |
| 4916 | JMS PUTN /PUT "MM/" INTO THE SAC |
| 4917 | TAD DATEWD /NOW GET DAY OF MONTH |
| 4918 | AND (370 |
| 4919 | CLL RTR |
| 4920 | RAR |
| 4921 | JMS PUTN /PUT "DD/" IN SAC |
| 4922 | TAD DATEWD /FINALLY GET YEAR |
| 4923 | AND (7 |
| 4924 | TAD YEAREX /ADD TO EXTENSION BITS |
| 4925 | TAD (106 /ADD 70. FOR BASE YEAR |
| 4926 | JMS PUTN /PUT OUT "YY/" (EXTRA SLASH WILL BE IGNORED) |
| 4927 | JMP I (SSMODE /RETURN IN STRING MODE |
| 4928 | |
| 4929 | PUTN, 0 |
| 4930 | ISZ NHIGH /BUMP HIGH ORDER DIGIT |
| 4931 | TAD (-12 /-10. |
| 4932 | SMA |
| 4933 | JMP .-3 /LOOP IF NOT REDUCED YET |
| 4934 | TAD (12+60 /CONVERT TO DECIMAL DIGIT |
| 4935 | DCA NLOW /HOLD MOMENTARILY |
| 4936 | TAD NHIGH /NOW GET HI ORDER DIGIT |
| 4937 | TAD (57 /MAKE 6BIT |
| 4938 | DCA I SACXR |
| 4939 | TAD NLOW /SEND OUT LOW DIGIT |
| 4940 | DCA I SACXR |
| 4941 | TAD (57 |
| 4942 | DCA I SACXR /SEND OUT "/" |
| 4943 | DCA NHIGH /CLEAR NHIGH FOR NEXT TIME (BE CAREFULL!!) |
| 4944 | JMP I PUTN |
| 4945 | NHIGH, 0 |
| 4946 | NLOW, 0 |
| 4947 | DATEWD, 0 |
| 4948 | \f/TRACE FUNCTION PRINTER. WHEN TRACE IS ENABLED,THIS ROUTINE |
| 4949 | /PRINTS THE LINE # EACH TIME IT IS STORED |
| 4950 | |
| 4951 | TPRINT, JMS I (LMAKE /MAKE LINE # INTO FIVE DIGITS |
| 4952 | TAD ("% |
| 4953 | JMS I PXPUTCH /PRINT "%" |
| 4954 | TAD (" |
| 4955 | JMS I PXPUTCH /PRINT A SPACE |
| 4956 | TAD (DIG1-1 /ADDR OF FIRST DIGIT-1 |
| 4957 | DCA XR5 /IN XR5 |
| 4958 | IGS, TAD I XR5 /GET DIGIT OF LINE NUMBER |
| 4959 | DCA TCHR /SAVE IT |
| 4960 | TAD (-"0 |
| 4961 | TAD TCHR /COMPARE IT TO 0 |
| 4962 | SNA CLA /IS IT A 0? |
| 4963 | JMP IGS /YES-IGNORE LEADING ZEROES |
| 4964 | PREST, TAD TCHR /NO-GET CHAR AGAIN |
| 4965 | TAD M215 |
| 4966 | SNA CLA /IS IT A CR? |
| 4967 | JMP TDONE /YES-LINE NUMBER IS PRINTED |
| 4968 | TAD TCHR /NO-GET CHAR A THIRD TIME |
| 4969 | JMS I PXPUTCH /TYPE IT |
| 4970 | TAD I XR5 /GET NEXT CHAR |
| 4971 | DCA TCHR |
| 4972 | JMP PREST /AND LOOP |
| 4973 | TDONE, TAD (" |
| 4974 | JMS I PXPUTCH /FOLLOW LINE # WITH A SPACE |
| 4975 | TAD ("% |
| 4976 | JMS I PXPUTCH /TYPE ANOTHER "%" |
| 4977 | TAD (215 |
| 4978 | JMS I PXPUTCH /TYPE,CR,LF |
| 4979 | TAD (212 |
| 4980 | JMS I PXPUTCH |
| 4981 | JMS I PXPRINT /EMPTY RING BUFFER OF TRACE NUMBER |
| 4982 | JMP .-1 |
| 4983 | JMP I PILOOP /DONE |
| 4984 | TCHR, 0 |
| 4985 | |
| 4986 | PAGE |
| 4987 | \f/TRACE FUNCTION-ROUTINE TO TURN TRACE ON AND OFF |
| 4988 | |
| 4989 | TRACE, TAD ACH /GET HI MANTISSA OF ARG |
| 4990 | SNA CLA /SKP TO TURN TRACE ON |
| 4991 | TAD TRREST /ELSE RESTORE TRACE BYPASS INSTR IN LINE NUMBER ROUTINE |
| 4992 | DCA I HOOKL /BY NOP ING INSTRUCTION AT TRHOOK |
| 4993 | TRREST, JMP I PILOOP |
| 4994 | |
| 4995 | HOOKL, TRHOOK |
| 4996 | |
| 4997 | /ERROR ROUTINE |
| 4998 | |
| 4999 | ERRORR, JMS I PXPRINT /PURGE TTY RING BUFFER |
| 5000 | JMP .-1 /BEFORE PRINTING ERROR |
| 5001 | TAD ETABA /ADDR OF ERROR TABLE |
| 5002 | DCA XR4 /POINTS INTO ERROR TABLE |
| 5003 | FERRLP, TAD I XR4 /GET 2 CHAR ERROR CODE |
| 5004 | DCA TEMP1 /SAVE |
| 5005 | TAD TEMP1 |
| 5006 | CLL RTR |
| 5007 | RTR |
| 5008 | RTR |
| 5009 | AND O77 /STRIP TO 6 BIT |
| 5010 | TAD K0300 /MAKE 8 BIT (LETTERS ONLY ALLOWED) |
| 5011 | DCA ESTRNG /PUT IN MESSAGE |
| 5012 | TAD TEMP1 /2 CHAR CODE AGAIN |
| 5013 | AND O77 /SECOND CHAR |
| 5014 | TAD K0300 /MAKE LETTER |
| 5015 | DCA ESTRNG+1 /PUT IN MESSAGE |
| 5016 | TAD I XR4 /GET ERROR CODE +1 |
| 5017 | TAD I PERROR /COMPARE AGAINST RETURN ADDR |
| 5018 | SZA CLA /MATCH? |
| 5019 | JMP FERRLP /NO-TRY NEXT ONE |
| 5020 | JMS LMAKE /MAKE THE LINE # INTO DECIMAL DIGITS |
| 5021 | TAD ESTRA /ADDR OF MESSAGE |
| 5022 | DCA XR5 |
| 5023 | ETLOP, TAD I XR5 /GET MESSAGE CHAR |
| 5024 | SPA /DONE? (MESSAGE ENDNS WITH - NUMBER |
| 5025 | JMP FATCHK /YES-DETERMINE ERROR TYPE |
| 5026 | JMS I PXPUTCH /NO-PUT CHAR IN RING BUFFER |
| 5027 | JMP ETLOP |
| 5028 | |
| 5029 | FATCHK, CLA |
| 5030 | TAD MFATAL /-ADDR OF FATAL ERRORS |
| 5031 | TAD XR4 /ADDR OF THIS ERROR |
| 5032 | SMA CLA /FATAL ERROR? |
| 5033 | JMP I ERRETN /NO-NEXT INST |
| 5034 | JMP I STOPI /YES-TERMINATE RUN |
| 5035 | |
| 5036 | ERRETN, XERRRET |
| 5037 | STOPI, FSTOPN |
| 5038 | |
| 5039 | MAKED, 0 |
| 5040 | AND O17 /ISOLATE BCD DIGIT |
| 5041 | TAD K260 /MAKE ASCII DIGIT |
| 5042 | JMP I MAKED |
| 5043 | |
| 5044 | K260, 260 |
| 5045 | K0300, 300 |
| 5046 | \f/SUBROUTINE LMAKE-MAKES THE CURRENT LINE NUMBER INTO FIVE DIGITS |
| 5047 | /STARTING AT DIG1 |
| 5048 | |
| 5049 | LMAKE, 0 |
| 5050 | TAD LINEHI /YES:GET HI LINE # |
| 5051 | JMS MAKED /GET DIGIT 2 |
| 5052 | DCA DIG2 /PUT IN MESSAGE |
| 5053 | TAD LINEHI |
| 5054 | CLL RTR |
| 5055 | RTR |
| 5056 | JMS MAKED /GET DIGIT 1 |
| 5057 | DCA DIG1 /AND PUT IN MESSAGE |
| 5058 | TAD LINELO /DOGOTS 3,4, AND 5 |
| 5059 | JMS MAKED /GET DIGIT 5 |
| 5060 | DCA DIG5 |
| 5061 | TAD LINELO |
| 5062 | CLL RTR |
| 5063 | RTR |
| 5064 | JMS MAKED /GET DIGIT 4 |
| 5065 | DCA DIG4 /AND PUT IN MESSAGE |
| 5066 | TAD LINELO |
| 5067 | CLL RAL |
| 5068 | RTL |
| 5069 | RTL |
| 5070 | JMS MAKED /GET DIGIT 3 |
| 5071 | DCA DIG3 /MESSAGE NOW COMPLETE |
| 5072 | JMP I LMAKE |
| 5073 | \f/ERROR MESSAGE |
| 5074 | |
| 5075 | EMESS, 215 |
| 5076 | 212 |
| 5077 | ESTRNG, 0000 |
| 5078 | 0000 |
| 5079 | " |
| 5080 | "A |
| 5081 | "T |
| 5082 | " |
| 5083 | "L |
| 5084 | "I |
| 5085 | "N |
| 5086 | "E |
| 5087 | " |
| 5088 | DIG1, 0 |
| 5089 | DIG2, 0 |
| 5090 | DIG3, 0 |
| 5091 | DIG4, 0 |
| 5092 | DIG5, 0 |
| 5093 | 215 |
| 5094 | 212 |
| 5095 | ESTRA, EMESS-1 /MINUS NUMBER TO END ABOVE MESSAGE |
| 5096 | \f/ERROR TABLE\r/ENTRY FORMAT- 2 CHAR 6-BIT ERROR CODE (LETTERS ONLY) |
| 5097 | / -(ADDR OF CALL)-1 |
| 5098 | |
| 5099 | ETABA, ETAB-1 |
| 5100 | MFATAL, -EFATAL |
| 5101 | ETAB, 0602 /FB |
| 5102 | -FB-1 /ATTEMPT TO OPEN AN ALREADY OPEN FILE |
| 5103 | 0722 /GR |
| 5104 | -GR-1 /RETURN WITHOUT A GOSUB |
| 5105 | 2622 /VR |
| 5106 | -VR-1 /ATTEMPT TO READ VARIABLE LENGTH FILE |
| 5107 | 2325 /SU |
| 5108 | -SU-1 /SUBSCRIPT ERROR |
| 5109 | 0405 /DE |
| 5110 | -DE-1 /DEVICE DRIVER ERROR |
| 5111 | 1705 /OE |
| 5112 | -OE-1 /DRIVER ERROR WHILE OVERLAYING |
| 5113 | 0615 /FM |
| 5114 | -FM-1 /ATTEMPT TO FIX MINUS NUMBER |
| 5115 | 0617 /FO |
| 5116 | -FO-1 /ATTEMPT TO FIX NUMBER >4095 |
| 5117 | 0616 /FN |
| 5118 | -FN-1 /ILLEGAL FILE # |
| 5119 | 2303 /SC |
| 5120 | -SC-1 /ATTEMPT TO OVERFLOW SAC ON CONCATENATE |
| 5121 | 0611 /FI |
| 5122 | -FI-1 /ATTEMPT TO CLOSE OR USE UNOPENED FILE |
| 5123 | 0401 /DA |
| 5124 | -DA-1 /ATTEMPT TO READ PAST END OF DATA LIST |
| 5125 | 0723 /GS |
| 5126 | -GS-1 /TOO MANY NESTED GOSUBS |
| 5127 | 2322 /SR |
| 5128 | -SR-1 /ATTEMPT TO READ STRING FROM NUMERIC FILE |
| 5129 | 2327 /SW |
| 5130 | -SW-1 /ATTEMPT TO WRITE STRING INTO NUMERIC FILE |
| 5131 | 2001 /PA |
| 5132 | -PA-1 /ILLEGAL ARG IN POS |
| 5133 | 0603 /FC |
| 5134 | -FC-1 /OS/8 ERROR WHILE CLOSING TENTATIVE FILE |
| 5135 | 0311 /CI |
| 5136 | -CI-1 /INQUIRE FAILURE IN CHAIN |
| 5137 | 0314 /CL |
| 5138 | -CL-1 /LOOKUP FAILURE IN CHAIN |
| 5139 | 1116 /IN |
| 5140 | -IN-1 /INQUIRE FAILURE IN OPEN |
| 5141 | 0417 /DO |
| 5142 | -DO-1 /NO MORE ROOM FOR DRIVERS |
| 5143 | 0605 /FE |
| 5144 | -FE-1 /FETCH ERROR IN OPEN |
| 5145 | 0217 /BO |
| 5146 | -BO-1 /NO MORE FILE BUFFERS AVAILABLE |
| 5147 | 0516 /EN |
| 5148 | -EN-1 /ENTER ERROR IN OPEN |
| 5149 | 1106 /IF |
| 5150 | -IF-1 /ILLEGAL DEV:FILENAME SPECIFICATION |
| 5151 | 2314 /SL |
| 5152 | -SL-1 /STRING TOO LONG OR UNDEFINED |
| 5153 | 1726 /OV |
| 5154 | -O0-1 /NUMERIC OR INPUT OVERFLOW |
| 5155 | 1415 /LM |
| 5156 | -LM-1 /ATTEMPT TO TAKE LOG OF NEG # OR 0 |
| 5157 | 0515 /EM |
| 5158 | -EM-1 /ATTEMPT TO EXPONENTIATE A NEG NUMBER TO A REAL ROWER |
| 5159 | 1101 /IA |
| 5160 | -IA-1 /ILLEGAL ARGUMENT IN USER FUNCTION |
| 5161 | 0330 /CX |
| 5162 | -CX-1 /ILLEGAL FILENAME EXTENSION IN A CHAIN STATEMENT |
| 5163 | /*********************************************************** |
| 5164 | EFATAL, /ERRORS BEFORE THIS LABEL ARE FATAL |
| 5165 | /******************************************************* |
| 5166 | 2205 /RE |
| 5167 | -RE-1 /ATTEMPT TO READ PAST EOF |
| 5168 | 2705 /WE |
| 5169 | -WE-1 /ATTEMPT TO WRITE PAST EOF |
| 5170 | 0426 /DV |
| 5171 | -DV-1 /ATTEMPT TO DIVIDE BY 0 |
| 5172 | 2324 /ST |
| 5173 | -ST-1 /STRING TRUNCATION ON INPUT |
| 5174 | 1117 /IO |
| 5175 | -IO-1 /TTY INPUT BUFFER OVERFLOW |
| 5176 | \f 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 Z<Y,NULL STRING IS RETURNED |
| 5186 | |
| 5187 | SEG, CLA IAC |
| 5188 | DCA MODESW /RETURN IN STRING MODE |
| 5189 | TAD ACH /IS Y>0? |
| 5190 | SMA SZA CLA |
| 5191 | JMS I PUNSFIX /FIX IF POSITIVE |
| 5192 | SNA |
| 5193 | IAC /SET Y TO 1 IF Y.LE.0 |
| 5194 | DCA YARG |
| 5195 | TAD SACLEN /COMPARE YARG TO SACLEN |
| 5196 | CIA |
| 5197 | STL CIA |
| 5198 | TAD YARG |
| 5199 | SNL SZA CLA /SKP IF YARG.LOS.LEN(X$) |
| 5200 | JMP NULLST /NO-RETURN THE NULL STRING |
| 5201 | DCA INSAV /FAKE POINTER TO SCALAR #0 |
| 5202 | JMS I ARGPLK /GET ADDR OF Z |
| 5203 | JMS I PFFGET /LOAD Z INTO FAC |
| 5204 | ARGPLK, ARGPRE /LOC SKIPPED BY FPP SO WE PUT CONST HERE |
| 5205 | TAD ACH /HI MANTISSA OF Z |
| 5206 | SPA SNA CLA /IS Z<0? |
| 5207 | JMP NULLST /YES-RETURN THE NULL STRING |
| 5208 | JMS I PUNSFIX /NO-FIX Z |
| 5209 | STL |
| 5210 | TAD SACLEN /CALC Z-LEN(SAC) |
| 5211 | SNL /SKP IF Z.LO.LEN(SAC) |
| 5212 | CLA /ELSE TAKE LEN(SAC) |
| 5213 | CMA |
| 5214 | TAD SACLEN |
| 5215 | TAD YARG /NUMBER OF BYTES TO USE |
| 5216 | SMA |
| 5217 | JMP NULLST /NONE, RETURN NULL STRING |
| 5218 | DCA STRCNT |
| 5219 | TAD YARG /INDEX INTO STRING FOR SOURCE BYTES |
| 5220 | TAD (SAC-2 |
| 5221 | DCA XR2 /SET SOURCE XR |
| 5222 | TAD STRCNT |
| 5223 | DCA SACLEN /SET NEW LENGTH OF SAC NOW |
| 5224 | TAD I XR2 /NOW MOVE THE BYTES |
| 5225 | DCA I SACXR |
| 5226 | ISZ STRCNT |
| 5227 | JMP .-3 |
| 5228 | JMP I PILOOP /--RETURN-- |
| 5229 | NULLST, CLA CLL |
| 5230 | DCA SACLEN /ZERO SAC |
| 5231 | JMP I PILOOP /--RETURN-- |
| 5232 | YARG, 0 |
| 5233 | |
| 5234 | PAGE |
| 5235 | \f /POS FUNCTION |
| 5236 | /RETURNS THE POSITION IN X$ OF Y$ STARTING AFTER Z |
| 5237 | |
| 5238 | POS, CLA CLL |
| 5239 | DCA INSAV /FAKE AS STRING CALL TO STRING 0 |
| 5240 | JMS I (STFIND /FIND Y$ |
| 5241 | TAD STRCNT /# OF CHARS IN Y$ |
| 5242 | SNA CLA /IS Y$ THE NULL STRING? |
| 5243 | JMP ONERET /YES-RETURN 1 AS POSITION |
| 5244 | TAD SACLEN /NO-# OF CHARS IN X$ |
| 5245 | SNA CLA /IS X$ THE NULL STRING? |
| 5246 | JMP ZRORET /YES-RETURN 0 |
| 5247 | TAD ACH /NO-GET HORD OF Z |
| 5248 | SPA SNA CLA /IS Z GT 0? |
| 5249 | PA, JMS I PERROR /NO-ILLEGAL ARGUMENT |
| 5250 | JMS I PUNSFIX /FIX Z |
| 5251 | DCA POSITN /USE IT AS POSITION TO START SEARCH |
| 5252 | TAD POSITN |
| 5253 | STL |
| 5254 | TAD SACLEN /COMPARE POSITION TO MAXIMUM LENGTH OF STRING |
| 5255 | SNL SZA CLA |
| 5256 | JMP PA /Z IS PAST END OF STRING-ERROR |
| 5257 | POSSET, TAD STRCNT |
| 5258 | CMA |
| 5259 | TAD POSITN /GET POSITION NOW CHECKING+SIZE IF Y$ |
| 5260 | TAD SACLEN /COMPARE AGAINST LENGTH OF STRING |
| 5261 | SMA SZA CLA /ANY MORE TO COME? |
| 5262 | JMP ZRORET /NO-SEARCH FAILS |
| 5263 | JMS I (BYTSET /SETUP BYTE LOAD ROUTINE |
| 5264 | TAD POSITN /SEARCH START POSITION IN X$ |
| 5265 | TAD (SAC-2 /ADD TO BASE OF SAC |
| 5266 | DCA SACXR |
| 5267 | TAD STRCNT /# OF CHARS IN Y$ |
| 5268 | DCA TEMP3 /COUNTER |
| 5269 | SRCLP, JMS I (LDB |
| 5270 | CIA |
| 5271 | TAD I SACXR /COMPARE CHARS |
| 5272 | SNA CLA /DO THEY MATCH? |
| 5273 | JMP SCONTU /YES-CONTINUE MATCH TO NEXT CHAR IN X$ AND Y$ |
| 5274 | ISZ POSITN /BUMP POSITION TO BE CHECKED |
| 5275 | JMP POSSET /ITERATE |
| 5276 | |
| 5277 | SCONTU, ISZ TEMP3 /MORE CHARS IN Y$? |
| 5278 | JMP SRCLP /YES, ITERATE |
| 5279 | TAD POSITN /NO FOUND A MATCH |
| 5280 | JMP I (FLOATS |
| 5281 | ZRORET, JMS I PFACCLR /SEARCH FAILS-RETURN 0 |
| 5282 | JMP I PILOOP |
| 5283 | |
| 5284 | ONERET, CLA IAC |
| 5285 | JMP I (FLOATS /RETURN 1 |
| 5286 | POSITN, 0 |
| 5287 | |
| 5288 | PAGE |
| 5289 | \f RELOC |
| 5290 | |
| 5291 | ////////////////////////////////////////////////// |
| 5292 | ////////////////////////////////////////////////// |
| 5293 | ///////// OVERLAY 3-FILE MANIPULATING //////////// |
| 5294 | ///////// FUNCTIONS //////////// |
| 5295 | ////////////////////////////////////////////////// |
| 5296 | ////////////////////////////////////////////////// |
| 5297 | |
| 5298 | *3400 |
| 5299 | |
| 5300 | /FILE CLOSING ROUTINE |
| 5301 | |
| 5302 | VERSON^100+SUBVFF+6000 /VERSION WORD FOR FILES OVERLAY |
| 5303 | |
| 5304 | ANDPTR, ANDLST |
| 5305 | ANDLST, 7776 /MASKS FOR CLEARING BUFFER AND HANDLER STATUS BITS |
| 5306 | 7775 |
| 5307 | 7773 |
| 5308 | 7767 |
| 5309 | |
| 5310 | CLOSE, TAD ENTNO /GET FILE # |
| 5311 | SNA CLA /IS IT TTY? |
| 5312 | JMP I PILOOP /YES-DON'T DO ANYTHING |
| 5313 | JMS I PIDLE /SEE IF FILE OPEN |
| 5314 | JMS I PFTYPE /IS FILE NUMERIC? |
| 5315 | JMP NOCZ /YES-DON'T OUTPUT ^Z |
| 5316 | JMS I (FOTYPE /NO-IS FILE VARIABLE LENGTH? |
| 5317 | JMP NOCZ /NO-DON'T OUTPUT ^Z |
| 5318 | TAD (232 /YES |
| 5319 | JMS I PPUTCH /WRITE A ^Z IN FILE |
| 5320 | NOCZ, JMS I (WRBLK /WRITE LAST BLOCK IF IT HAS CHANGED |
| 5321 | JMS I PPSWAP /RESTORE 17600 |
| 5322 | JMS I (FOTYPE /IS FILE FIXED LENGTH? |
| 5323 | JMP CLOSED /YES-NO NEED TO CLOSE THE FILE |
| 5324 | TAD I IOTLEN /NO-GET FILE LENGTH |
| 5325 | DCA CLENG /PUT IN CLOSE CALL |
| 5326 | TAD IOTFIL |
| 5327 | DCA FNAP /POINTER TO FILE NAME |
| 5328 | TAD I IOTHDR |
| 5329 | CLL RTL |
| 5330 | RTL |
| 5331 | RAL /GET DEVICE NUMBER INTO BITS 8-11 |
| 5332 | AND O17 /ISOLATE IT |
| 5333 | CIF 10 |
| 5334 | JMS I O7700 /CALL USR |
| 5335 | 4 /CLOSE |
| 5336 | FNAP, . /POINTER TO FILE NAME |
| 5337 | CLENG, . |
| 5338 | FC, JMS I PERROR /FILE CLOSING ERROR |
| 5339 | CLOSED, TAD I IOTBUF /GET BUFFER ADDRESS |
| 5340 | CLL RTL |
| 5341 | RTL /BUFFER NUMBER INTO AC |
| 5342 | RAL /BITS 10,11 |
| 5343 | AND (3 /STRIP |
| 5344 | TAD ANDPTR /USE AS INDEX INTO MASKS |
| 5345 | DCA TEMP1 |
| 5346 | TAD BMAP /BUFFER STATUS MAP |
| 5347 | AND I TEMP1 /CLEAR THE BIT FOR THIS BUFFER |
| 5348 | DCA BMAP |
| 5349 | \f TAD I IOTHDR /HEADER WORD |
| 5350 | AND O7400 /STRIP HEADER TO DEVICE # ONLY |
| 5351 | DCA I IOTHDR |
| 5352 | TAD MM4 /-4 |
| 5353 | DCA TEMP3 /USE AS COUNTER |
| 5354 | CHECKL, TAD TEMP3 /GET 3 OF FILE TO CHECK |
| 5355 | TAD (W0PTR /MAKE POINTER TO PROPER W0 HEADER |
| 5356 | DCA TEMP1 /SAVE POINTER |
| 5357 | TAD TEMP3 /-# OF FILE WERE CHECKING |
| 5358 | TAD ENTNO /COMPARE TO CURRENT NUMBER |
| 5359 | SNA CLA /IS IT THIS ONE? |
| 5360 | JMP PSTCHK /YES-DON'T CHECK DRIVER |
| 5361 | TAD I TEMP1 /GET HEADER WORD FOR THE FILE OF INTEREST |
| 5362 | AND O7400 /ISOLATE DEVICE # |
| 5363 | CIA /NEGATE |
| 5364 | TAD I IOTHDR /COMPARE TO CURRENT DEVICE # |
| 5365 | SNA CLA /SAME DEVICE? |
| 5366 | JMP CRETN /YES-LEAVE DRIVER IN CORE |
| 5367 | PSTCHK, ISZ TEMP3 /ALL 4 CHECKED? |
| 5368 | JMP CHECKL /NO-CHECK THE NEXT 1 |
| 5369 | TAD I IOTHDR |
| 5370 | AND O10 /GET HANDLER LENGTH BIT |
| 5371 | SZA CLA /TWO PAGES? |
| 5372 | JMP TPREL /YES-FREE BOTH PAGES |
| 5373 | TAD I IOTHND /THIS IS THE ONLY FILE USING HANDLER THEN |
| 5374 | CLL RTL |
| 5375 | RTL /SLIDE BITS 4,5 OF HANDLER PAGE TO AC BITS 10,11 |
| 5376 | RAL |
| 5377 | AND (3 /ISOLATE HANDLER BUFFER NUMBER |
| 5378 | TAD ANDPTR /MAKE POINTER TO PROPER AND MASK |
| 5379 | RELCOM, DCA TEMP1 |
| 5380 | TAD DMAP /DRIVER PAGE MAP |
| 5381 | AND I TEMP1 /CLEAR HANDLER PAGE BIT |
| 5382 | DCA DMAP |
| 5383 | CRETN, DCA I IOTHND /SET FILE AS IDLE |
| 5384 | JMS I PPSWAP /GET RID OF 17600 AGAIN |
| 5385 | JMP I PILOOP /DONE |
| 5386 | |
| 5387 | TPREL, TAD I IOTHND /ONLY FILE USING HANDLER |
| 5388 | CLL RTL |
| 5389 | RTL /ISOLATE HANDLER BUFFER NUMBER |
| 5390 | RAL |
| 5391 | AND (3 |
| 5392 | TAD (ANDLS2 /USE AS INDEX TO AND MASK |
| 5393 | JMP RELCOM |
| 5394 | |
| 5395 | W0PTR, FILE1 |
| 5396 | FILE2 /FILE TABLE ENTRIES |
| 5397 | FILE3 |
| 5398 | FILE4 |
| 5399 | |
| 5400 | MM4, |
| 5401 | ANDLS2, 7774 |
| 5402 | 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 | CREAD, CDF 10 |
| 5409 | CIF 0 |
| 5410 | 4613 /"JMS I L7607K" |
| 5411 | 3700 /31 PAGES |
| 5412 | 0 /0-7577 |
| 5413 | CBLK, 7617 /STARTING BLOCK OF COMPILER |
| 5414 | HLT /SYSTEM ERROR,AND SINCE WE ARE PROBABLY CLOBBERED,WE CAN'T REPORT IT |
| 5415 | CIF 0 |
| 5416 | 5612 /"JMP I .+1"-START THE COMPILER |
| 5417 | 7001 /STARTING ADDR OF COMPILER |
| 5418 | K7607K, 7607 |
| 5419 | /LESS THAN THE DESIRED VALUE |
| 5420 | |
| 5421 | EXTCHK, 0 /SKIP RETURN IF CURRENT |
| 5422 | AC0002 |
| 5423 | IAC |
| 5424 | TAD IOTFIL /IS .SV |
| 5425 | DCA EXTEMP /JUST A TEMP |
| 5426 | TAD I EXTEMP /GET EXTENSION |
| 5427 | TAD (-2326 |
| 5428 | SNA CLA /IS IT .SV? |
| 5429 | ISZ EXTCHK /YES: SKIP |
| 5430 | JMP I EXTCHK |
| 5431 | EXTEMP, 0 |
| 5432 | |
| 5433 | PAGE |
| 5434 | \f/CHAIN FUNCTION |
| 5435 | /SETS UP COMMAND DECODER AREA,THEN CHAINS TO BCOMP.SV |
| 5436 | |
| 5437 | CHAIN, JMS I PXPRINT /EMPTY TTY RING BUFFER |
| 5438 | JMP .-1 |
| 5439 | JMS I PPSWAP /RESTORE PG 17600 |
| 5440 | JMS I DNA2 /GET FILE NAME IN NAME AREA FROM CURRENT FILE |
| 5441 | CIF 10 |
| 5442 | JMS I O7700 /CALL USR |
| 5443 | 10 /LOCK IN CORE |
| 5444 | TAD I IOTDEV |
| 5445 | DCA DNA1 /FIRST TWO CHARS OF DEV NAME |
| 5446 | TAD I IOTDEV+1 /LAST TWO CHARS |
| 5447 | DCA DNA2 |
| 5448 | CIF 10 |
| 5449 | JMS I USR |
| 5450 | 12 /INQUIRE |
| 5451 | DNA1, 0 /DEVICE NAME |
| 5452 | DNA2, NAMEG |
| 5453 | CDIN, 0 |
| 5454 | CI, JMS I PERROR /ERROR |
| 5455 | TAD CDIN /GET ENTRY POINT OF DRIVER FOR CHAIN FILE |
| 5456 | SZA CLA /IS IT IN CORE? |
| 5457 | JMP DISIN /YES-NO NEED TO FETCH IT |
| 5458 | TAD DNA2 /NO-DEVICE # INTO AC |
| 5459 | CIF 10 |
| 5460 | JMS I USR |
| 5461 | 1 /FETCH HANDLER |
| 5462 | 7001 /INTO PAGE 7000 |
| 5463 | JMP CI /MAKE IT LOOK LIKE INQUIRE ERROR |
| 5464 | DISIN, TAD IOTFIL |
| 5465 | DCA STB /POINTER TO FILE NAME |
| 5466 | TAD DNA2 /GET DEVICE # |
| 5467 | CIF 10 |
| 5468 | JMS I USR |
| 5469 | 2 /LOOKUP |
| 5470 | STB, 0 /POINTER TO FILE NAME |
| 5471 | FLN, 0 |
| 5472 | CL, JMS I PERROR /LOOKUP ERROR |
| 5473 | TAD STB /GET STARTING BLOCK |
| 5474 | CDF 10 |
| 5475 | DCA I (7620 /STARTING BLOCK IN CD AREA |
| 5476 | TAD FLN /FILE LENGTH |
| 5477 | CLL RTL |
| 5478 | RTL |
| 5479 | AND (7760 /PUT IN BITS 0-7 |
| 5480 | TAD DNA2 /COMBINE WITH DEVICE # |
| 5481 | DCA I (7617 /PUT IN CD AREA |
| 5482 | TAD O100 /SET R SWITCH |
| 5483 | DCA I (7644 |
| 5484 | TAD I (7605 /STARTING BLOCK OF COMPILER |
| 5485 | SNA /(IS THIS A CORE IMAGE? |
| 5486 | JMP CICHAIN /YES: HANDLE SOMEWHAT DIFFERENTLY |
| 5487 | CDF |
| 5488 | DCA I (CBLK /INTO COMPILER READ CODE |
| 5489 | CDF |
| 5490 | JMS I (EXTCHK /SKP IF EXTENSION .SV |
| 5491 | SKP |
| 5492 | JMP CX /ERROR IF IT IS |
| 5493 | JMS I (PSWAP2 /NOW EXEC DESTRUCTIVE EXIT CODE |
| 5494 | CDF 10 |
| 5495 | JMP I (CSMOVE /MOVE THE COMPILER READ TO FIELD 1 AND EXECUTE IT |
| 5496 | |
| 5497 | CICHAIN,CDF |
| 5498 | JMS I (EXTCHK /SKP IF EXTENSION IS .SV |
| 5499 | CX, JMS I PERROR /ERROR IF NOT |
| 5500 | JMS I (PSWAP2 /NOW EXEC ONCE ONLY CLEAN UP ROUTINE |
| 5501 | TAD STB |
| 5502 | DCA CHNSTB |
| 5503 | CIF 10 /NOW DO A RESET AND DELETE TENTATIVE FILES |
| 5504 | JMS I USR |
| 5505 | 13 /RESET |
| 5506 | CIF 10 /FLAG TENTATIVE FILE CLEANUP |
| 5507 | JMS I USR |
| 5508 | 6 |
| 5509 | CHNSTB, HLT |
| 5510 | \f /FILE LOOKUP |
| 5511 | |
| 5512 | FLOOK, AC0002 |
| 5513 | JMS I (ENTLOK /LOOKUP |
| 5514 | DCA I IOTLEN /ACTUAL LENGTH |
| 5515 | TAD I IOTLEN |
| 5516 | DCA I IOTMAX /ALSO EQUALS MAXIMUM LENGTH |
| 5517 | CLEANP, DCA I IOTPOS /ZERO COLUMN POINTER |
| 5518 | CMA /-1 |
| 5519 | TAD I IOTLOC /STARTING BLOCK-1 |
| 5520 | DCA I IOTBLK /CURRENT BLOCK #=STARTING BLOCK-1 |
| 5521 | TAD I IOTBUF |
| 5522 | DCA I IOTPTR /READ/WRITE POINTER AT BEGINNING OF BUFFER |
| 5523 | CIF 10 |
| 5524 | JMS I USR /CALL TO USR |
| 5525 | 11 /USROUT |
| 5526 | JMS I PPSWAP /GET RID OF 17600 |
| 5527 | JMS I (BLZERO |
| 5528 | JMS I (NEXREC /DO A NEXREC TO READ IN FIRST FILE BLOCK |
| 5529 | JMP I PILOOP /DONE |
| 5530 | |
| 5531 | /ROUTINE FOR INTERPRETER EXIT |
| 5532 | |
| 5533 | FSTOP, KSF /IS THE KEYBOARD FLAG SET? |
| 5534 | JMP NOCTC /NO-THERE IS NO CHANGE ^C SENT US HERE |
| 5535 | TAD O200 /YES-FORCE PARITY BIT |
| 5536 | KRB /GET CHARACTER |
| 5537 | TAD (-203 /COMPARE AGAINST ^C |
| 5538 | SZA CLA /WAS IT ^C? |
| 5539 | JMP NOCTC /NO-THIS IS A NORMAL EXIT |
| 5540 | TSF |
| 5541 | JMP .-1 |
| 5542 | TAD ("^ /YES -ECHO ^ |
| 5543 | TLS |
| 5544 | CLA |
| 5545 | TSF |
| 5546 | JMP .-1 |
| 5547 | TAD ("C /ECHO "C" |
| 5548 | TLS |
| 5549 | NOCTC, TSF |
| 5550 | JMP .-1 |
| 5551 | JMP I (MEXIT |
| 5552 | |
| 5553 | PAGE |
| 5554 | \f /FILE OPENING ROUTINE |
| 5555 | |
| 5556 | OPENAV, TAD (4 /ALPHANUMERIC,VARIABLE LENGTH |
| 5557 | OPENAF, IAC /ALPHANUMERIC,FIXED LENGTH |
| 5558 | JMP OPENNF |
| 5559 | OPENNV, TAD (4 /NUMERIC,VARIABLE LENGTH |
| 5560 | OPENNF, DCA I IOTHDR /SET UP HEADER WORD |
| 5561 | TAD ENTNO /IS FILE TTY? |
| 5562 | SNA CLA |
| 5563 | JMP I PILOOP /YES-DON'T DO ANYTHING |
| 5564 | TAD I IOTHND /GET HANDLER ENTRY |
| 5565 | SZA CLA /IS FILE IDLE? |
| 5566 | FB, JMS I PERROR /ATTEMPT TO OPEN FILE ALREADY OPEN |
| 5567 | JMS I PPSWAP /RESTORE 17600 |
| 5568 | JMS I (NAMEG /GET FILE DEVICE NAME AND FILE NAME INTO WORDS 7-14 FROM SAC |
| 5569 | CIF 10 |
| 5570 | JMS I O7700 /CALL TO USR |
| 5571 | 10 /LOCK USR IN CORE |
| 5572 | TAD I IOTDEV |
| 5573 | DCA DEVNA1 /DEVICE NAME INTO INQUIRE CALL |
| 5574 | TAD I IOTDEV+1 |
| 5575 | DCA DEVNA2 |
| 5576 | CIF 10 |
| 5577 | JMS I USR /CALL TO USR |
| 5578 | 12 /INQUIRE |
| 5579 | DEVNA1, . /DEVICE NAME |
| 5580 | DEVNA2, . |
| 5581 | ENTRYN, 0 /ENTRY POINT |
| 5582 | IN, JMS I PERROR /INQUIRE ERROR |
| 5583 | TAD DEVNA2 /GET DEVICE # |
| 5584 | CLL RAR |
| 5585 | RTR /PUT INTO BITS 0-3 |
| 5586 | RTR |
| 5587 | TAD I IOTHDR |
| 5588 | DCA I IOTHDR /STORE IN HEADER WORD |
| 5589 | TAD ENTRYN /GET DRIVER ADDRESS |
| 5590 | SZA /IS IT IN CORE? |
| 5591 | JMP I (DRIVRN /YES-NO NEED TO FETCH IT |
| 5592 | TAD DMAP /NO-GET MAP OF DRIVER PAGES |
| 5593 | CLL RAR /PAGE 7000 BIT IN LINK |
| 5594 | SNL /IS PAGE 7000 FREE? |
| 5595 | JMP FREE70 /YES |
| 5596 | CLL RAR /NO-7200 BIT TO LINK |
| 5597 | SNL /IS PAGE 7200 FREE? |
| 5598 | JMP FREE72 /YES |
| 5599 | \f CLL RAR /NO-7400 BIT TO LINK |
| 5600 | SZL CLA /IS PAGE 7400 FREE? |
| 5601 | DO, JMS I PERROR /NO-NO MORE ROOM FOR DRIVERS |
| 5602 | TAD O7400 /YES-LOAD HANDLER INTO 7400 |
| 5603 | DCA FETPAG /SET UP IN FETCH CALL |
| 5604 | TAD (4 /SET BIT 9 TO SHOW PAGE 7400 OCCUPIED |
| 5605 | JMP DFETCH /FETCH DRIVER |
| 5606 | |
| 5607 | FREE70, CLL RAR /PAGE 7200 BIT TO LINK |
| 5608 | SNL CLA /IS 7200 FREE? |
| 5609 | IAC /YES-THERE IS ROOM FOR A TWO PAGE HANDLER |
| 5610 | TAD (7000 |
| 5611 | DCA FETPAG /SET UP FETCH TO USE PAGE 7000 |
| 5612 | CLL CLA CML RTL /TURN ON BIT 10 |
| 5613 | DCA TPH /SAVE IN TWO PAGE SET WORD |
| 5614 | IAC /SET BIT 11 TO SHOW PAGE 7000 OCCUPIED |
| 5615 | JMP DFETCH /FETCH HANDLER |
| 5616 | |
| 5617 | FREE72, CLL RAR /7400 BIT TO LINK |
| 5618 | SNL CLA /IS 7400 PAGE FREE? |
| 5619 | IAC /YES-THEN THERE IS ROOM FOR A 2 PAGE HANDLER |
| 5620 | TAD (7200 |
| 5621 | DCA FETPAG /SET ADDRESS IN FETCH CALL |
| 5622 | TAD (4 |
| 5623 | DCA TPH /IF TWO PAGE LOADED,SET BIT 9 ALSO |
| 5624 | AC0002 /TURN ON BIT 10 TO SHOW PAGE 7200 OCCUPIED |
| 5625 | DFETCH, TAD DMAP /TURN ON PAGE BIT FOR WHERE BUFFER WILL BE LOADED |
| 5626 | DCA DMAP |
| 5627 | TAD DEVNA2 /DEVICE # IN AC |
| 5628 | CIF 10 |
| 5629 | JMS I USR /CALL TO USR |
| 5630 | 1 /FETCH |
| 5631 | FETPAG, . /DRIVER ADDRESS |
| 5632 | FE, JMS I PERROR /FETCH ERROR |
| 5633 | CDF 10 |
| 5634 | CLA CMA |
| 5635 | TAD I (37 /GET ADDR OF HANDLER INFO TABLE |
| 5636 | TAD DEVNA2 /USE THE DEVICE # AS AN INDEX INTO THAT TABLE |
| 5637 | DCA TEMP1 /SAVE POINTER |
| 5638 | TAD I TEMP1 /GET THE INFO WORD FOR THE HANDLER JUST FETCHED |
| 5639 | CDF |
| 5640 | SMA CLA /IS HANDLER 2 PAGES LONG? |
| 5641 | JMP DRAP /NO MAP IS COMPLETE |
| 5642 | TAD TPH /YES-UPDATE DRIVER MAP TO INCLUDE |
| 5643 | TAD DMAP /SECOND PAGE OF TWO PAGE HANDLERS |
| 5644 | DCA DMAP |
| 5645 | TAD O10 |
| 5646 | TAD I IOTHDR /SET 2 PAGE BIT IN HEADER WORD |
| 5647 | DCA I IOTHDR |
| 5648 | DRAP, TAD FETPAG /HANDLER ENTRY ADDRESS |
| 5649 | JMP I (DRIVRN /PAGE ESCAPE |
| 5650 | |
| 5651 | TPH, 0 |
| 5652 | \f/ROUTINE TO MOVE THE COMPILER READER INTO FIELD 1 AND START IT |
| 5653 | |
| 5654 | CSMOVE, TAD (CREAD-1 |
| 5655 | DCA XR1 /POINTES TO COMPILER STARTING CODE |
| 5656 | TAD (-13 |
| 5657 | DCA TEMP1 /COUNTER |
| 5658 | TAD (2000 |
| 5659 | DCA XR2 /MOVE TO LOC 2001 IN FIELD 1 |
| 5660 | CDF |
| 5661 | TAD I XR1 /GET WORD OF CODE |
| 5662 | CDF 10 |
| 5663 | DCA I XR2 /MOVE IT |
| 5664 | ISZ TEMP1 /DONE? |
| 5665 | JMP .-5 /NO |
| 5666 | CIF 10 /YES-START IT |
| 5667 | JMS I (2000 |
| 5668 | |
| 5669 | PAGE |
| 5670 | \fDRIVRN, DCA I IOTHND /DRIVER ENTRY INTO I/O TABLE |
| 5671 | TAD BMAP /GET BUFFER MAP |
| 5672 | CLL RAR /BUFF1 BIT TO LINK |
| 5673 | SNL /IS IT FREE? |
| 5674 | JMP B1 /YES-ASSIGN BUFF1 |
| 5675 | RAR /BUFF2 BIT TO LINK |
| 5676 | SNL /IS IT FREE? |
| 5677 | JMP B2 /YES-ASSIGN BUFF2 |
| 5678 | RAR /BUFF3 BIT TO LINK |
| 5679 | SNL /IS IT FREE |
| 5680 | JMP B3 /YES-ASSIGN BUFF3 |
| 5681 | RAR /NO-BUFF4 BIT TO LINK |
| 5682 | SZL CLA /IS IT FREE? |
| 5683 | BO, JMS I PERROR /NO-NO MORE BUFFERS AVAILABLE |
| 5684 | TAD (1400 |
| 5685 | DCA I IOTBUF /SET BUFFER ADDRESS TO 1400 |
| 5686 | TAD O10 /SET BUFF4 BIR IN MAP |
| 5687 | JMP BUFASS |
| 5688 | |
| 5689 | B3, CLA |
| 5690 | TAD (1000 |
| 5691 | DCA I IOTBUF /SET BUFFER ADDRESS TO 1000 |
| 5692 | TAD (4 |
| 5693 | JMP BUFASS /SET BUFF3 BIT IN MAP |
| 5694 | |
| 5695 | B2, CLA |
| 5696 | TAD O400 |
| 5697 | DCA I IOTBUF /SET BUFF ADDRESS TO 400 |
| 5698 | CLL CML CLA RTL /SET BUFF2 BIT IN MAP |
| 5699 | JMP BUFASS |
| 5700 | |
| 5701 | B1, CLA |
| 5702 | DCA I IOTBUF /SET BUFF ADDRESS TO 0000 |
| 5703 | CLA IAC /TURN ON BUFF1 BIT IN MAP |
| 5704 | \fBUFASS, TAD BMAP |
| 5705 | DCA BMAP /UPDATE BUFFER ASSIGNMENT MAP |
| 5706 | TAD I IOTHDR /GET HEADER WORD |
| 5707 | CLL RTR |
| 5708 | RAR /FIXED,VARIABLE BIT TO LINK |
| 5709 | SNL CLA /IS IT FIXED? |
| 5710 | JMP I (FLOOK /YES-DO A LOOKUP |
| 5711 | TAD (3 /NO-DO AN ENTER |
| 5712 | JMS ENTLOK /ENTER |
| 5713 | DCA I IOTMAX /MAXIMUM LENGTH IN WORD 7 |
| 5714 | DCA I IOTLEN /ZERO ACTUAL LENGTH |
| 5715 | JMP I (CLEANP /FINALIZE I/O TABLE ENTRY |
| 5716 | |
| 5717 | MEXIT, CLA |
| 5718 | JMS I PPSWAP |
| 5719 | JMS I (PSWAP2 /RESTORE PG 27600 |
| 5720 | CDF 10 |
| 5721 | TAD I (EDBLK /GET BLOCK # FOR EDITOR |
| 5722 | CDF |
| 5723 | SNA /SHALL WE CALL THE EDITOR? |
| 5724 | JMP I (7600 /NOkJUST CALL OS/8 |
| 5725 | DCA EBLK /YES-PUT THE BLOCK # IN DRIVER CALL |
| 5726 | JMS I (7607 /CALL SYS DRIVER |
| 5727 | 2100 /READ 8 BLOCKS |
| 5728 | 0 /INTO 0-3377 |
| 5729 | EBLK, . /BLOCK # OF EDITOR |
| 5730 | HLT /SYS ERROR,AND SINCE WE ARE PROBABLY CLOBBERED,WE CAN'T REPORT IT |
| 5731 | JMP I .+1 /START THE EDITOR |
| 5732 | 3212 |
| 5733 | \fENTLOK, 0 |
| 5734 | DCA FNOM /FUNCTION NUMBER IN PLACE |
| 5735 | TAD IOTFIL /POINTER TO FILE NAME |
| 5736 | DCA STARTB /INTO CALL |
| 5737 | TAD I (DEVNA2 /DEVICE NUMBER |
| 5738 | CIF 10 |
| 5739 | JMS I USR /CALL TO USR |
| 5740 | FNOM, . /ENTER OR LOOKUP |
| 5741 | STARTB, . |
| 5742 | FLEN, . |
| 5743 | EN, JMS I PERROR /ENTER ERROR |
| 5744 | TAD STARTB /FILE STARTING BLOCK # |
| 5745 | SZA CLA /IS IT NON-ZERO? |
| 5746 | JMP FILSTU /YES-DEVICE IS FILE STRUCTURED |
| 5747 | TAD FLEN /NO-GET FILE LENGTH |
| 5748 | SZA CLA /IS IT EMPTY? |
| 5749 | JMP FILSTU /NO-DEVICE IS FILE STRUCTURED |
| 5750 | TAD (20 /NO-FILE IS READ/WRITE ONLY |
| 5751 | TAD I IOTHDR |
| 5752 | DCA I IOTHDR /SET READ/WRITE ONLY BIT |
| 5753 | TAD FNOM |
| 5754 | CLL RAR |
| 5755 | SNL CLA |
| 5756 | IAC |
| 5757 | FILSTU, TAD STARTB /GET STARTING BLOCK # OF FILE |
| 5758 | DCA I IOTLOC /PUT IN I/O TABLE |
| 5759 | TAD FLEN /FILE LENGTH |
| 5760 | CIA /MAKE FILE LENGTH POSITIVE |
| 5761 | JMP I ENTLOK /RETURN |
| 5762 | \f/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 | PSWAP2, 0 |
| 5771 | TAD (4207 |
| 5772 | DCA I (7600 /REMOVE CTRL/C HOOKS |
| 5773 | TAD (6213 |
| 5774 | DCA I (7605 |
| 5775 | TAD (7600 |
| 5776 | DCA I (HICORE /FUDGE POINTER IN SWAP ROUTINE (IN CASE IT WAS TD8E) |
| 5777 | TAD PSFLAG /GET RESIDENT STATUS FLAG |
| 5778 | SPA CLA /IS THIS TD8/E SYS? |
| 5779 | JMS I (PSWP2P /YES-RESTORE PAGE 27600 AND PAGE 07600 |
| 5780 | TAD CDFIO |
| 5781 | DCA .+3 /CDF TO HI CORE |
| 5782 | CDF 10 |
| 5783 | TAD I BOSPT1 /GET BATCH WORD |
| 5784 | CDF 10 |
| 5785 | DCA I BOSPT2 /BACK INTO LOFTY STATE |
| 5786 | ISZ BOSPT1 |
| 5787 | ISZ BOSPT2 |
| 5788 | JMP .-6 |
| 5789 | CDF |
| 5790 | JMP I PSWAP2 /YES-WE ARE FINISHED,SO RETURN |
| 5791 | BOSPT1, 7600 |
| 5792 | BOSPT2, 7774 |
| 5793 | |
| 5794 | PAGE |
| 5795 | \f /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 | NAMEG, 0 |
| 5806 | TAD SACLEN |
| 5807 | TAD (16 /COMPARE STRING LENGTH TO 16 |
| 5808 | SPA CLA |
| 5809 | IF, JMS I PERROR /TOO MANY CHARS IN "DEV:FILENM.EX" |
| 5810 | TAD SACLEN |
| 5811 | DCA TEMP2 /STRING LENGTH COUNTER |
| 5812 | TAD PSACM1 |
| 5813 | DCA SACXR |
| 5814 | TAD (DSK-1 /FIRST USE THE DEFAULT DEVICE |
| 5815 | JMS DEVFUD |
| 5816 | NCG, TAD I SACXR /GET CHAR FROM SAC |
| 5817 | DCA TEMP1 /SAVE |
| 5818 | TAD TEMP1 |
| 5819 | TAD (-72 /IS IT A COLON? |
| 5820 | SNA |
| 5821 | JMP CAD /YES-CHARS SO FAR=DEVICE NAME |
| 5822 | TAD (14 /NO-IS IT A PERIOD? |
| 5823 | SNA CLA |
| 5824 | JMP SSAD /YES-NEXT TWO CHARS=EXTENSION |
| 5825 | TAD TEMP1 /NO-GET CHAR AGAIN |
| 5826 | DCA I XR2 /STORE IN WORK AREA |
| 5827 | ISZ TEMP4 /BUMP COUNT FOR CURRENT SECTION |
| 5828 | NCGS, ISZ TEMP2 /END OF STRING YET? |
| 5829 | JMP NCG /NO-NEXT CHAR |
| 5830 | \f TAD TEMP4 /YES-GET CHAR COUNT FOR THIS SECTION (NAME) |
| 5831 | TAD (-6 |
| 5832 | SMA SZA CLA /IS IT >6? |
| 5833 | JMP IF /YES-TOO MANY CHARACTERS IN FILE NAME |
| 5834 | TAD (WKAREA-1 /NO-ADDRESS OF SCRATCH NAME BLOCK |
| 5835 | DCA XR1 |
| 5836 | STA /-1 |
| 5837 | TAD IOTDEV /ADDRESS OF FINAL NAME BLOCK-1 |
| 5838 | DCA XR2 |
| 5839 | TAD (-6 /MOVE 6 WORDS |
| 5840 | DCA TEMP2 |
| 5841 | MML, TAD I XR1 |
| 5842 | CLL RTL |
| 5843 | RTL |
| 5844 | RTL |
| 5845 | TAD I XR1 |
| 5846 | DCA I XR2 /MOVE NAME WORD FROM SCRATCH AREA TO FINAL DEST |
| 5847 | ISZ TEMP2 /DONE? |
| 5848 | JMP MML /NO |
| 5849 | JMP I NAMEG /YES-RETURN |
| 5850 | |
| 5851 | CAD, TAD TEMP4 /GET CHAR COUNT FOR THIS SECTION |
| 5852 | TAD (-4 /COMPARE AGAINST 4 |
| 5853 | SMA SZA CLA /TOO MANY CHARS? |
| 5854 | JMP IF /YES-DEVICE NAME TOO LONG |
| 5855 | TAD (WKAREA-1+4 |
| 5856 | JMS DEVFUD /CLEAR BUF AND GET NAME FROM FILE FIELD THIS TIME |
| 5857 | JMP NCGS |
| 5858 | |
| 5859 | SSAD, TAD TEMP4 /COUNT FOR THIS SECTION (FILE NAME) |
| 5860 | TAD (-6 |
| 5861 | SMA SZA CLA /TOO MANY? |
| 5862 | JMP IF /YES-FILE NAME TOO LONG |
| 5863 | DCA TEMP4 /NO-CLEAR COUNT |
| 5864 | TAD DSK |
| 5865 | TAD TEMP2 /COMPARE AGAINST # OF CHARS LEFT |
| 5866 | SPA SNA CLA |
| 5867 | JMP IF /TOO MANY CHARS IN EXTENSION |
| 5868 | TAD (WKAREA-1+12 |
| 5869 | DCA XR2 |
| 5870 | JMP NCGS |
| 5871 | |
| 5872 | DEVFUD, 0 |
| 5873 | DCA XR1 /POINT AT LOC OF DEV: |
| 5874 | TAD (WKAREA-1 |
| 5875 | DCA XR2 /POINT AT START OF WORK AREA |
| 5876 | TAD (-10 |
| 5877 | DCA TEMP4 |
| 5878 | TAD (-4 |
| 5879 | DCA TEMP3 |
| 5880 | TAD I XR1 /GET A DEVICE NAME BYTE |
| 5881 | DCA I XR2 /STORE IN WORK AREA DEVICE FIELD |
| 5882 | ISZ TEMP3 |
| 5883 | JMP .-3 /ITERATE |
| 5884 | DCA I XR2 /NOW CLEAR REST OF FILE NAME |
| 5885 | ISZ TEMP4 |
| 5886 | JMP .-2 /ITERATE |
| 5887 | TAD (WKAREA-1+4 /POINT XR2 AT FILENAME FIELD |
| 5888 | DCA XR2 |
| 5889 | JMP I DEVFUD /RETURN WITH TEMP4 CLEAR |
| 5890 | |
| 5891 | DSK, 4;23;13;0 /6BIT DEFAULT DEVICE NAME "DSK" |
| 5892 | \f/SUBROUTINE TO RESTORE PAGE 27600 OF TD8/E DRIVER |
| 5893 | /AND READJUST THE CDFS IN FIELD 0 |
| 5894 | |
| 5895 | PSWP2P, 0 |
| 5896 | TAD PSFLAG |
| 5897 | RTL |
| 5898 | SNL CLA /BIT 1 SET MEANS PHONEY TD8E |
| 5899 | JMP .+3 |
| 5900 | DCA PSFLAG |
| 5901 | JMP I PSWP2P |
| 5902 | DCA PSFLAG /CLEAR RESIDENT STATUS FLAG |
| 5903 | TAD (CDF 20 |
| 5904 | DCA I (P2CDF /PUT CDF 20 IN SWAP ROUTINE |
| 5905 | TAD (CDF 20 |
| 5906 | DCA I (P2CDF1 |
| 5907 | JMS I PPSWAP /MOVE DOWN PAGE 27600 |
| 5908 | TAD (6223 |
| 5909 | DCA I (7642 |
| 5910 | TAD (6222 |
| 5911 | DCA I (7721 |
| 5912 | TAD (6222 /RESTORE CDFS IN PAGE 07600 |
| 5913 | DCA I (7727 |
| 5914 | JMP I PSWP2P /RETURN |
| 5915 | |
| 5916 | PAGE |
| 5917 | \f |
| 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 | $ |
| 5942 | \f<:STTYF, 1\e+1"E0;' |
| 5943 | J<S\13PRINT\13\e;R-5DI[XPRINT\e> |
| 5944 | J<S\13SACPTR\13\e;R-6DI[SAC-1\e> |
| 5945 | J<S\13PUTCHL\13\e;R-6DI[PUTCH\e> |
| 5946 | J<S\13ILOOPL\13\e;R-6DI[ILOOP\e> |
| 5947 | J<S\13INTL\13\e;R-4DI[UNSFIX\e> |
| 5948 | J<S\13CDFPSL\13\e;R-6DI[CDFPSU\e> |
| 5949 | J<S\13ERROR\13\e;R-5DI[ERRDIS\e> |
| 5950 | J<S\13FBITS\13\e;R-5DI[FBITGT\e> |
| 5951 | J<S\13PWFECL\13\e;R-5DI[PWFECH\e> |
| 5952 | J<S\13MPYLNK\13\e;R-6DI[MPY\e> |
| 5953 | J<S\13XPUT\13\e;R-4DI[XPUTCH\e> |
| 5954 | J<S\13FIDLE\13\e;R-5DI[IDLE\e> |
| 5955 | J<S\13DEVCAL\13\e;R-6DI[DRCALL\e> |
| 5956 | J<S\13WRITFW\13\e;R-6DI[WRITFL\e> |
| 5957 | J<S\13STHINL\13\e;R-6DI[STHINI\e> |
| 5958 | J<S\13LDHINL\13\e;R-6DI[LDHINI\e> |
| 5959 | J<S\13STH\13\e;R-3DI[STHL\e> |
| 5960 | J<S\13LDH\13\e;R-3DI[LDHL\e> |
| 5961 | J<S\13FACSAL\13\e;R-6DI[FACSAV\e> |
| 5962 | J<S\13FACREL\13\e;R-6DI[FACRES\e> |
| 5963 | J<S\13FGETL\13\e;R-5DI[FFGET\e> |
| 5964 | J<S\13FPUTL\13\e;R-5DI[FFPUT\e> |
| 5965 | J<S\13FNORL\13\e;R-5DI[FFNOR\e> |
| 5966 | J<S\13FCLR\13\e;R-4DI[FACCLR\e> |
| 5967 | J<S\13FNEGL\13\e;R-5DI[FFNEG\e> |
| 5968 | J<S\13FLOATL\13\e;R-6DI[FFLOAT\e> |
| 5969 | J<S\13GETCHL\13\e;R-6DI[GETCH\e> |
| 5970 | J<S\13EOFSEL\13\e;R-6DI[EOFSET\e> |
| 5971 | J<S\13BSWL\13\e;R-4DI[BSWP\e> |
| 5972 | J<S\13PACKL\13\e;R-5DI[PACKCH\e> |
| 5973 | J<S\13CNOCLL\13\e;R-6DI[CNOCLR\e> |
| 5974 | J<S\13BUFCHL\13\e;R-6DI[BUFCHK\e> |
| 5975 | J<S\13FTYPL\13\e;R-5DI[FTYPE\e> |
| 5976 | J<S\13CHRNOL\13\e;R-6DI[CHARNO\e> |
| 5977 | J<S\13NEXREL\13\e;R-6DI[NEXREC\e> |
| 5978 | J<S\13CRLF\13\e;R-4DI[CRLFR\e> |
| 5979 | J<S\13VALLK\13\e;R-5DI[VALGET\e> |
| 5980 | J<S\13PATCHP\13\e;R-6DI[PATCHF\e> |
| 5981 | J<S\13P1SWAP\13\e;R-6DI[PSWAP\e> |
| 5982 | J<S\13LDHRST\13\e;R-6DI[LRESET\e> |
| 5983 | J<S\13STHRST\13\e;R-6DI[SRESET\e> |
| 5984 | P> |
| 5985 | \f |