| 1 | /FORTRAN IV RUNTIME SYSTEM, V5A |
| 2 | / |
| 3 | / |
| 4 | / |
| 5 | / |
| 6 | / |
| 7 | / |
| 8 | / |
| 9 | // |
| 10 | / |
| 11 | / |
| 12 | / |
| 13 | / |
| 14 | /COPYRIGHT (C) 1974,1975 |
| 15 | /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. |
| 16 | / |
| 17 | / |
| 18 | / |
| 19 | /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A |
| 20 | /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- |
| 21 | /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER |
| 22 | /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE |
| 23 | /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO |
| 24 | /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE |
| 25 | /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. |
| 26 | / |
| 27 | / |
| 28 | /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT |
| 29 | /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL |
| 30 | /EQUIPMRNT COROPATION. |
| 31 | / |
| 32 | /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS |
| 33 | /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. |
| 34 | / |
| 35 | / |
| 36 | / |
| 37 | / |
| 38 | / |
| 39 | / |
| 40 | \f/FORTRAN 4 RUNTIME SYSTEM - R.LARY |
| 41 | /AND NOW WITH DOUBLE PRECISION! - MKH |
| 42 | /RTS-8 SUPPORT ADDED 5/20/74 - RL |
| 43 | /LAST EDITED 5/19/74 |
| 44 | |
| 45 | XVERSN=5 /UPDATE WITH EVERY RELEASE! |
| 46 | XPATCH="A /PATCH LEVEL A |
| 47 | |
| 48 | /NOTES TO MAINTAINERS: |
| 49 | |
| 50 | /THIS PROGRAM IS DESIGNED TO SUPPORT MANY DIFFERENT HARDWARE |
| 51 | /CONFIGURATIONS IN A MINIMAL AMOUNT OF SPACE. IT ACHIEVES THIS GOAL |
| 52 | /BY "TAILORING" ITSELF AT INITIALIZATION TIME |
| 53 | /BASED ON A SURVEY OF ITS HARDWARE/SOFTWARE ENVIRONMENT. THIS MAKES |
| 54 | /THIS PROGRAM DIFFICULT TO MODIFY UNLESS THE MODIFYING PROGRAMMER |
| 55 | /KNOWS WHAT IS GOING ON. IT IS THEREFORE SUGGESTED THAT YOU READ THIS |
| 56 | /LISTING THOROUGHLY AND UNDERSTAND THE MAJOR ROUTINES BEFORE |
| 57 | /MAKING EVEN "TRIVIAL" CHANGES. |
| 58 | |
| 59 | /ALL SYMBOLS BEGINNING WITH THE LETTER "Q" ARE ENTRIES IN THE |
| 60 | /HEADER BLOCK OF THE LOADER-IMAGE (.LD) FILE. |
| 61 | |
| 62 | /ALL SYMBOLS BEGINNING WITH THE LETTER "Y" DENOTE THE BEGINNING OF |
| 63 | /A BLOCK OF CODE WHICH WILL BE REPLACED BY DIFFERENT CODE IF FRTS |
| 64 | /IS RUNNING IN THE BACKGROUND UNDER RTS-8. THE REPLACEMENT CODE |
| 65 | /CAN BE FOUND IN THE TABLE "BKRLST". |
| 66 | |
| 67 | /ALL SYMBOLS BEGINNING WITH THE LETTER "V" ARE DEFINED IN THE LOADER |
| 68 | /SYMBOL TABLE AND CANNOT BE MOVED WITHOUT CHANGING THE LOADER. ONLY |
| 69 | /A VERY FEW OF THESE SYMBOLS OCCUR IN PLACES OTHER THAN |
| 70 | /PAGE 200 OR THE FIRST LOCATION OF OTHER PAGES. |
| 71 | |
| 72 | /CODE WHICH CONTAINS THE CHARACTER SEQUENCE "*K*" IN THE COMMENT FIELD |
| 73 | /IS PARTICULARLY SUBTLE/OBSCURE (THE "K" IS FOR "KLUDGE"). THE REST OF THE |
| 74 | /COMMENT SHOULD INDICATE WHAT IS GOING ON. |
| 75 | / |
| 76 | / |
| 77 | / FIXES FOR V4 J.K. 1975 |
| 78 | / |
| 79 | / .SCALE FACTOR PRINTED BY P FORMAT OPERATOR |
| 80 | / .FRTS /P |
| 81 | / .RK8E HANDLER TO RUN WITH INTERRUPTS ON |
| 82 | / .SLASH AT END OF FORMAT STATEMENT |
| 83 | / |
| 84 | / |
| 85 | / CHANGES FOR OS/78 AND OS/8 V3D BY P.T. |
| 86 | / .CHANGED THE VERSION NUMBER TO 5A |
| 87 | / .FIXED THE FIELD OVERFLOW PROBLEM |
| 88 | / .FIXED THE "K=K+1" PROBLEM |
| 89 | \f/DEFINITIONS: |
| 90 | |
| 91 | AC7775= STA CLL RTL |
| 92 | AC7776= STA CLL RAL |
| 93 | AC4000= CLA STL RAR |
| 94 | AC3777= STA CLL RAR |
| 95 | AC2000= CLA STL RTR |
| 96 | AC0002= CLA STL RTL |
| 97 | |
| 98 | /DEFINITIONS OF KE-8/E INSTRUCTIONS |
| 99 | |
| 100 | MQL= 7421 |
| 101 | MQA= 7501 |
| 102 | CAM= CLA MQL |
| 103 | SWP= MQA MQL |
| 104 | SWAB= 7431 |
| 105 | SCA= 7441 |
| 106 | MUY= 7405 |
| 107 | DVI= 7407 |
| 108 | NMI= 7411 |
| 109 | SHL= 7413 |
| 110 | ASR= 7415 |
| 111 | LSR= 7417 |
| 112 | ACS= 7403 |
| 113 | SAM= 7457 |
| 114 | DAD= 7443 |
| 115 | DLD= 7663 |
| 116 | DST= 7445 |
| 117 | DPIC= 7573 |
| 118 | DCM= 7575 |
| 119 | DPSZ= 7451 |
| 120 | SGT= 6006 |
| 121 | |
| 122 | /DEFINITIONS OF FPP IOT'S |
| 123 | |
| 124 | FPINT= 6551 |
| 125 | FPICL= 6552 |
| 126 | FPCOM= 6553 |
| 127 | FPHLT= 6554 |
| 128 | FPST= 6555 |
| 129 | FPRST= 6556 |
| 130 | \f/FPP OPCODES: |
| 131 | |
| 132 | FLDA= 0000 |
| 133 | FADD= 1000 |
| 134 | FSUB= 2000 |
| 135 | FDIV= 3000 |
| 136 | FMUL= 4000 |
| 137 | FADDM= 5000 |
| 138 | FSTA= 6000 |
| 139 | FMULM= 7000 |
| 140 | LONG= 400 /TWO-WORD ADDRESSING |
| 141 | BASE= 200 /BASEPAGE ADDRESSING |
| 142 | IND= 600 /INDIRECT ADDRESSING |
| 143 | |
| 144 | FEXIT= 0000 |
| 145 | FNORM= 0004 |
| 146 | STARTF= 0005 |
| 147 | STARTD= 0006 |
| 148 | JAC= 0007 |
| 149 | XTA= 0030 |
| 150 | STARTE= 0050 |
| 151 | LDX= 0100 |
| 152 | |
| 153 | JA= 1030 |
| 154 | JNE= 1040 |
| 155 | TRAP3= 3000 |
| 156 | |
| 157 | /OS8 EQUIVALENCES: |
| 158 | |
| 159 | OS8SWS= 7643 |
| 160 | OSJSWD= 7746 |
| 161 | OS8DVT= 7647 |
| 162 | OS8DCB= 7760 |
| 163 | OS8DAT= 7666 |
| 164 | |
| 165 | /VARIOUS OTHER IOT'S: |
| 166 | |
| 167 | LSF= 6661 |
| 168 | LCF= 6662 |
| 169 | LSE= 6663 |
| 170 | LIE= 6665 |
| 171 | LLS= 6666 |
| 172 | LIF= 6667 |
| 173 | \f/PAGE ZERO FOR FORTRAN IV RTS |
| 174 | |
| 175 | *0 /INTERRUPT STUFF |
| 176 | 0 |
| 177 | JMP I .+1 |
| 178 | INTRPT |
| 179 | LPGET, LPBUFR /LINE PRINTER RING BUFFER FETCH POINTER |
| 180 | TOCHR, 0 /TELETYPE STATUS WORD |
| 181 | KBDCHR, 0 /KEYBOARD INPUT CHARACTER |
| 182 | POCHR, 0 /P.T. PUNCH COMPLETION FLAG |
| 183 | RDRCHR, 0 /P.T. READER STATUS |
| 184 | FMTPXR, 0 /XR USED TO INDEX FORMAT PARENTHESIS ARRAY |
| 185 | INXR, INBUFR-1 /XR USED TO GET CHARS FROM INPUT LINE |
| 186 | XR, 0 |
| 187 | XR1, 0 |
| 188 | |
| 189 | *16 |
| 190 | VEOFSW, 0 /USED BY "EOFCHK" TO STORE VARIABLE ADDRESS |
| 191 | 0 /*K* MUST BE IN AUTO - XR |
| 192 | T, 0 /TEMPORARY |
| 193 | DFLG, 0 /0 = F.P., 1 = D.P. |
| 194 | INST, 0 /CURRENT INSTRUCTION WORD |
| 195 | |
| 196 | /IOH PAGE ZERO LOCATIONS |
| 197 | |
| 198 | RWFLAG, 0 /READ/WRITE FLAG |
| 199 | FMTTYP, 0 /TYPE OF CONVERSION BEING DONE |
| 200 | EOLSW, 0 /EOL SW ON INPUT - CHAR POS ON OUTPUT |
| 201 | N, 0 /REPEAT FACTOR |
| 202 | W, 0 /FIELD WIDTH |
| 203 | D, 0 /NUMBER OF PLACES AFTER DECIMAL POINT |
| 204 | |
| 205 | DATCDF, 0 /SUBROUTINE TO CHANGE DATA FIELD |
| 206 | DATAF, 0 /CONTAINS VARIOUS CDF'S |
| 207 | JMP I DATCDF /RETURN |
| 208 | |
| 209 | ERR, ERROR /POINTER TO ERROR ROUTINE |
| 210 | FATAL, 0 /FATAL ERROR FLAG - 0=FATAL |
| 211 | MCDF, MAKCDF |
| 212 | |
| 213 | /FPP PARAMETER TABLE LOCATIONS: |
| 214 | |
| 215 | APT, 0 /VARIOUS FIELD BITS FOR FPP |
| 216 | PC, DPTEST /FPP PROGRAM COUNTER |
| 217 | XRBASE, 0 /FPP INDEX REGISTER ARRAY ADDRESS |
| 218 | BASADR, 0 /FPP BASE PAGE ADDRESS |
| 219 | ADR, 0 /ADDRESS TEMPORARY |
| 220 | ACX, 0 |
| 221 | ACH, 0 /*** FLOATING ACCUMULATOR *** |
| 222 | ACL, 0 |
| 223 | EAC1, 0 |
| 224 | EAC2, 0 /** FOR EXTENDED PRECISION OPTION ** |
| 225 | EAC3, 0 |
| 226 | \f/FLOATING POINT PACKAGE LOCATIONS |
| 227 | |
| 228 | AC0, 0 |
| 229 | AC1, 0 /FLOATING AC OVERFLOW WORD |
| 230 | AC2, 0 /OPERAND OVFLOW WORD |
| 231 | OPX, 0 |
| 232 | OPH, 0 /*** FLOATING OPERAND REGISTER *** |
| 233 | OPL, 0 |
| 234 | |
| 235 | /RTS I/O CONVERSION SYSTEM LOCATIONS |
| 236 | |
| 237 | FMTBYT, 0 /FORMAT BYTE POINTER |
| 238 | IFLG, 0 /I FOEMAT FLAG |
| 239 | GFLG, 0 /G FORMAT FLAG |
| 240 | EFLG, 0 /E FORMAT FLAG - SOMETIMES ON FOR G FMT |
| 241 | OD, 0 |
| 242 | SCALE, 0 |
| 243 | PFACT, 0 /P-SCALE FACTOR |
| 244 | PFACTX, 0 /TEMP FOR PFACT |
| 245 | ACI, 0 /INTEGERIZED FAC FROM "FFIX" SUBR |
| 246 | CHCH, 0 |
| 247 | FMTNUM, 0 /CONTAINS ACCUMULATED NUMERIC VALUE |
| 248 | CTCINH, 0 /^C INHIBIT FLAG |
| 249 | LOGUNT, 0 /DSRN POINTER - ONLY USED FROM ONE PAGE! |
| 250 | PTTY, TTY /POINTER TO TTY HANDLER - USED BY LDDSRN |
| 251 | 0 / SO FORMS CONTROL WILL WORK ON UNIT 0 |
| 252 | FPNXT, ICYCLE /USED AS INTERPRETER ADDRESS IF NO FPP |
| 253 | |
| 254 | /DSRN IMAGE |
| 255 | |
| 256 | HAND, 0 /HANDLER ENTRY POINT |
| 257 | HCODEW, 0 /HANDLER LOAD ADDR & FIELD + IOFFLG + FORMS CTL FLG |
| 258 | BADFLD, 0 /BUFFER ADDRESS AND FIELD |
| 259 | CHRPTR, 0 /ACTUALLY A WORD POINTER |
| 260 | CHRCTR, 0 /COUNTER - RANGES FROM -3 TO -1 |
| 261 | STBLK, 0 /STARTING BLOCK OF FILE |
| 262 | RELBLK, 0 /CURRENT RELATIVE BLOCK NUMBER |
| 263 | TOTBLK, 0 /LENGTH OF FILE |
| 264 | FFLAGS, 0 /FILE FLAGS: |
| 265 | /BIT 0 - "HAS BEEN WRITTEN" FLAG |
| 266 | /BITS 1-2 - FORMATTED/UNFORMATTED FLAGS |
| 267 | /BIT 11 - "END-FILED" FLAG |
| 268 | |
| 269 | BUFFLD, 0 /ROUTINE TO SET DF TO BUFFER FIELD |
| 270 | BUFCDF, HLT |
| 271 | JMP I BUFFLD |
| 272 | |
| 273 | FADD1, FADD+LONG /FPP CODE TO ADD 1.0 TO FAC |
| 274 | ONE /AND FALL INTO STORE CODE |
| 275 | FGPBF, 0 /THESE THREE WORDS ARE USED |
| 276 | BIOPTR, 0 /TO FETCH AND STORE FLOATING POINT NUMBERS |
| 277 | FEXIT /FROM RANDOM MEMORY |
| 278 | PAGE |
| 279 | \f/STARTUP CODE |
| 280 | |
| 281 | FTEMP2, ISZ .+3 /ALSO USED AS I/O F.P. TEMPORARY |
| 282 | CDF CIF 10 |
| 283 | JMP I .+1 |
| 284 | VDATE, RTSLDR /USED TO STORE OS/8 DATE |
| 285 | |
| 286 | /RTS ENTRY POINTS - "VERSION INDEPENDENT" |
| 287 | |
| 288 | VUERR, JMP I (USRERR /USER ERROR |
| 289 | /** LOADER MUST DEFINE #ARGER AS VARGER-1 ** |
| 290 | VARGER, JMS I ERR /LIBRARY ARGUMENT ERROR |
| 291 | VRENDO, ISZ RWFLAG /END OF I/O LIST |
| 292 | VRFSV, JMP I GETLMN /I/O LIST ARG ENTRY - COROUTINE WITH GETLMN |
| 293 | VBAK, JMP I (BKSPC /"BACKSPACE" ROUTINE |
| 294 | VENDF, JMP I (ENDFL /"END FILE" ROUTINE |
| 295 | VREW, JMP I (RWIND /"REWIND" ROUTINE |
| 296 | VDEF, JMP I (DFINE /"DEFINE FILE" ROUTINE |
| 297 | VWUO, AC4000 /UNFORMATTED WRITE |
| 298 | VRUO, JMP I (RWUNF /UNFORMATTED READ |
| 299 | VWDAO, AC4000 /DIRECT ACCESS WRITE |
| 300 | VRDAO, JMP I (RWDACC /DIRECT ACCESS READ |
| 301 | VWRITO, AC4000 /FORMATTED (ASCII) WRITE |
| 302 | VREADO, JMP I (RWASCI /FORMATTED (ASCII) READ |
| 303 | VSWAP, JMP I (SWAP /OVERLAY PROCESSOR |
| 304 | VEXIT, TRAP3; CALXIT /"STOP" ROUTINE - ENTERED IN FPP MODE |
| 305 | V8OR12, 0;0 /0;1 IF CPU IS A PDP-12 |
| 306 | VBACKG, JMP I (NULLJB /BACKGROUND JOB DISPATCHER |
| 307 | 0 |
| 308 | CDF CIF 0 /USED BY ROUTINE "ONQB" IN LIBRARY |
| 309 | JMS I .-2 |
| 310 | JMP VBACKG |
| 311 | |
| 312 | /IOH GET VARIABLE ROUTINE. |
| 313 | /THIS ROUTINE MAKES THE FORMATTED I/O PROCESSOR AND THE USER'S |
| 314 | /PROGRAM CO-ROUTINES (DEF(COROUTINE)= 2 ROUTINES EACH THINKING THE OTHER |
| 315 | / IS A SUBROUTINE). ON ENTRY FAC=INPUT NUMBER |
| 316 | /IF I/O IS A READ, ON RETURN FAC=OUTPUT NUMBER IF I/O IS A WRITE. |
| 317 | |
| 318 | GETLMN, 0 |
| 319 | VRETRN, JMP I [RETURN /SHORT ROUTINE FOR ALL THOSE COMMENTS, NO? |
| 320 | \f/INTERRUPT DRIVEN I/O HANDLERS |
| 321 | |
| 322 | LPT, 0 /RING-BUFFERED - LP08 OR LS8E |
| 323 | AND [377 /JUST IN CASE |
| 324 | LPTSNA, SNA |
| 325 | JMP I (IOERR /CANNOT BE USED FOR INPUT |
| 326 | YLPT, IOF |
| 327 | DCA I LPPUT |
| 328 | TAD LPGET |
| 329 | CIA |
| 330 | TAD LPPUT |
| 331 | SZA CLA /IS LPT QUIET? |
| 332 | JMP .+3 /NO |
| 333 | TAD I LPPUT |
| 334 | LLS /YES - START 'ER UP |
| 335 | CLA IAC |
| 336 | LIE /ENABLE LPT INTERRUPTS |
| 337 | TAD LPPUT /1 IN AC, REMEMBER? |
| 338 | DCA LPPUT |
| 339 | TAD I LPPUT |
| 340 | SPA |
| 341 | JMP .-3 /NEGATIVE NUMBERS ARE BUFFER LINKS |
| 342 | SZA CLA /ANY ROOM LEFT IN BUFFER? |
| 343 | JMS I (HANG |
| 344 | LPUHNG /WAIT FOR LINE PRINTER |
| 345 | ION /TURN INTERRUPTS BACK ON |
| 346 | JMP I LPT /RETURN |
| 347 | |
| 348 | LPPUT, LPBUFR |
| 349 | |
| 350 | PTP, 0 /PAPER TAPE PUNCH HANDLER |
| 351 | YPTP, SNA |
| 352 | JMP I (IOERR /INPUT IS ERROR |
| 353 | DCA LPT /SAVE CHAR |
| 354 | IOF |
| 355 | TAD POCHR /IF PUNCH IS NOT IDLE, |
| 356 | SZA CLA /WE DISMISS JOB |
| 357 | JMS I (HANG |
| 358 | PPUHNG /WAIT FOR PUNCH INTERRUPT |
| 359 | TAD LPT |
| 360 | PLS /OUTPUT CHAR |
| 361 | DCA POCHR /SET FLAG NON-ZERO |
| 362 | ION |
| 363 | JMP I PTP |
| 364 | |
| 365 | /*K* THE FOLLOWING ADDRESSES GET FALLEN INTO & MUST BE SMALL |
| 366 | |
| 367 | IFNZRO PPUHNG&7000 <__ERROR__> |
| 368 | IFNZRO TTUHNG&7000 <__ERROR__> |
| 369 | IFNZRO KBUHNG&7000 <__ERROR__> |
| 370 | IFNZRO RDUHNG&7000 <__ERROR__> |
| 371 | IFNZRO LPUHNG&7000 <__ERROR__> |
| 372 | \f/INTERRUPT-DRIVEN PTR AND TELETYPE HANDLER |
| 373 | |
| 374 | PTR, 0 /CRUDE READER HANDLER |
| 375 | YPTR, SZA CLA |
| 376 | JMP I (IOERR /OUTPUT ILLEGAL TO PTR |
| 377 | IOF |
| 378 | RFC /START READER |
| 379 | JMS I (HANG |
| 380 | RDUHNG /HANG UNTIL COMPLETE |
| 381 | TAD RDRCHR /GET CHARACTER |
| 382 | ION |
| 383 | JMP I PTR /RETURN |
| 384 | |
| 385 | TTY, 0 /BUFFERS 2 CHARS ON OUTPUT, 1 ON INPUT |
| 386 | YTTY, IOF /DELICATE CODE AHEAD |
| 387 | SNA /INPUT OR OUTPUT? |
| 388 | JMP KBD /INPUT |
| 389 | DCA LPT /OUTPUT - SAVE CHAR |
| 390 | TAD TOCHR /GET TTY STATUS |
| 391 | SMA SZA CLA /G.T. 0 MEANS A CHAR IS BACKED UP |
| 392 | JMS I (HANG |
| 393 | TTUHNG /WAIT FOR LOG JAM TO CLEAR |
| 394 | TAD TOCHR /NO CHAR BACKED UP - SEE IF TTY BUSY |
| 395 | CLL RAL /"BUSY" FLAG IN LINK - INTERRUPTS ARE OFF! |
| 396 | CLA CML RAR /COMPLEMENT OF BUSY IN SIGN |
| 397 | TAD LPT /GET CHAR |
| 398 | SPA /IF TTY NOT BUSY, |
| 399 | TLS /OUTPUT CHAR |
| 400 | DCA TOCHR /STORE POS OR NEG, BACKED UP OR BUSY |
| 401 | TTYRET, ION /TURN INTERRUPTS BACK ON |
| 402 | JMP I TTY /AND LEAVE |
| 403 | \fKBD, TAD KBDCHR /HAS A CHARACTER BEEN INPUT? |
| 404 | SNA CLA |
| 405 | JMS I (HANG |
| 406 | KBUHNG /NO - RUN BACKGROUND UNTIL ONE IS |
| 407 | TAD KBDCHR /GET CHARACTER |
| 408 | DCA LPT |
| 409 | DCA KBDCHR /CHEAR CHARACTER BUFFER |
| 410 | TAD LPT |
| 411 | JMP TTYRET /RETURN WITH INTERRUPTS ON |
| 412 | |
| 413 | KILFPP, FPHLT /BRING FPP TO A SCREECHING HALT |
| 414 | ISZ .-1 |
| 415 | JMP .-1 /WAIT FOR IT TO STOP |
| 416 | FPICL /CLEAN UP MESS HALT HAS MADE IN FPP |
| 417 | BEEORC, SZL /^C OR ^B? |
| 418 | JMP I (7600 /^C - HIYO SILVER, AWAY! |
| 419 | KCC /CLEAR KBD FLAG ON ^B |
| 420 | CTLBER, JMS I ERR /*** THIS MAY BE DANGEROUS! ** |
| 421 | PAGE |
| 422 | \f/INTERRUPT SERVICE ROUTINES |
| 423 | |
| 424 | INTRPT, DCA INTAC |
| 425 | RAR |
| 426 | DCA INTLNK |
| 427 | VINT, JMP .+4 /** MUST BE AT 403 ** |
| 428 | IFNZRO VINT-403 <___ CHANGE LOADER!!!> |
| 429 | 0 |
| 430 | CDF CIF 0 /USER INTERRUPT ROUTINE GOES HERE |
| 431 | JMS I .-2 |
| 432 | |
| 433 | FPINT /CHECK FOR FPP DONE |
| 434 | JMP LPTEST |
| 435 | FPUHNG, JMP DISMIS /ALWAYS GOES TO RESTRT |
| 436 | |
| 437 | VDISMS, JMP DISMIS /FOR USE BY USERS |
| 438 | JMP DISMIS |
| 439 | JMP DISMIS |
| 440 | |
| 441 | LPTEST, LSF |
| 442 | JMP NOTLPT |
| 443 | LPTLCF, LCF /CLEAR FLAG |
| 444 | TAD I LPGET |
| 445 | SNA CLA /CHECK FOR SPURIOUS INTERRUPT |
| 446 | JMPDIS, JMP DISMIS /GO AWAY IF SO |
| 447 | DCA I LPGET /ZERO CHAR JUST OUTPUT |
| 448 | ISZ LPGET |
| 449 | TAD I LPGET |
| 450 | SPA |
| 451 | DCA LPGET /TAKE CARE OF BUFFER LINKS |
| 452 | SNA |
| 453 | TAD I LPGET /MAKE SURE CHAR IS IN AC |
| 454 | SZA /IS THERE A CHARACTER? |
| 455 | LLS /YES - PRINT IT |
| 456 | CLA |
| 457 | LSF /CHECK FOR IMMEDIATE FLAG |
| 458 | LPUHNG, JMP DISMIS /NO - MAYBE RESTART PROGRAM |
| 459 | JMP LPTLCF /YES - LOOP |
| 460 | |
| 461 | NOTLPT, TSF /CHECK TTY |
| 462 | JMP NOTTTY |
| 463 | TCF /CLEAR FLAG |
| 464 | TAD TOCHR /GET TTY STATUS |
| 465 | SMA SZA /IF THERE IS A CHARACTER WAITING, |
| 466 | TLS /OUTPUT IT. |
| 467 | SMA SZA CLA /CHANGE "WAITING" TO "BUSY", |
| 468 | STL RAR /"BUSY" TO "IDLE". |
| 469 | DCA TOCHR |
| 470 | TTUHNG, JMP DISMIS |
| 471 | \f/KBD AND PTP INTERRUPTS |
| 472 | |
| 473 | NOTTTY, KSF |
| 474 | JMP NOTKBD |
| 475 | TAD [200 |
| 476 | KRS /USE KRS TO FORCE PARITY BIT |
| 477 | DCA KBDCHR /AND ALSO SO THAT ^C WILL STILL BE IN BUFFER IN OS/8 |
| 478 | TAD KBDCHR |
| 479 | TAD (-202 /CHECK FOR ^C OR ^B |
| 480 | CLL RAR |
| 481 | SNA CLA |
| 482 | JMP CTCCTB /YUP - TAKE SOME DRASTIC ACTION |
| 483 | KCC /DATA CHARACTER - CLEAR FLAG |
| 484 | KBUHNG, JMP DISMIS |
| 485 | |
| 486 | CTCCTB, TAD CTCINH |
| 487 | SNA CLA /ARE WE IN A HANDLER? |
| 488 | JMP NOTINH /NO |
| 489 | TAD INTLNK |
| 490 | CLL RAL /YES - RETURN WITH INTERRUPTS OFF |
| 491 | TAD INTAC /TRUST IN GOD AND RTS |
| 492 | RMF |
| 493 | JMP I 0 |
| 494 | |
| 495 | NOTKBD, PSF |
| 496 | JMP NOTPTP |
| 497 | PCF /P.T. PUNCH INTERRUPT - CLEAR FLAG |
| 498 | DCA POCHR /CLEAR SOFTWARE FLAG |
| 499 | PPUHNG, JMP DISMIS |
| 500 | |
| 501 | NOTPTP, RSF |
| 502 | JMP LPTERR |
| 503 | TAD [200 |
| 504 | RRB /GET RDR CHAR |
| 505 | DCA RDRCHR |
| 506 | RDUHNG, JMP DISMIS |
| 507 | |
| 508 | LPTERR, LSE /TEST FOR LP08 ERROR FLAG |
| 509 | SKP |
| 510 | LIF /DISABLE LP08 INTERRUPTS IF ERROR FLAG ON |
| 511 | DISMIS, TAD INTLNK |
| 512 | CLL RAL |
| 513 | TAD INTAC /RESTORE AC AND LINK |
| 514 | RMF |
| 515 | ION |
| 516 | JMP I 0 /RETURN FROM THE INTERRUPT |
| 517 | |
| 518 | INTAC, 0 |
| 519 | INTLNK, 0 |
| 520 | \f/BACKGROUND INITIATE/TERMINATE ROUTINE |
| 521 | |
| 522 | HANG, 0 /ALWAYS CALLED WITH INTERRUPTS OFF! |
| 523 | TAD I HANG /GET POINTER TO UNHANGING LOCATION |
| 524 | DCA UNHANG |
| 525 | RDF /GET FIELD CALLED FROM |
| 526 | TAD HCIDF0 |
| 527 | DCA HNGCDF /SAVE FOR RETURN |
| 528 | HCIDF0, CDF CIF 0 |
| 529 | TAD (JMP RESTRT /CHANGE THE "JMP DISMIS" AT THAT LOC |
| 530 | DCA I UNHANG /TO A "JMP RESTRT" |
| 531 | TAD BACKLK |
| 532 | CLL RAL |
| 533 | TAD BACKAC /SET UP BACKGROUND AC AND LINK |
| 534 | BAKCIF, CIF 0 |
| 535 | BAKCDF, CDF 0 |
| 536 | ION |
| 537 | JMP I BACKPC /INITIATE BACKGROUND |
| 538 | |
| 539 | / COME HERE WHEN THE HANG CONDITION HAS GONE AWAY |
| 540 | |
| 541 | RESTRT, TAD JMPDIS /RESTORE THE UNHANG LOCATION |
| 542 | DCA I UNHANG |
| 543 | TAD INTAC /SUSPEND THE BACKGROUND |
| 544 | DCA BACKAC |
| 545 | TAD INTLNK |
| 546 | DCA BACKLK |
| 547 | TAD 0 |
| 548 | DCA BACKPC |
| 549 | RIB |
| 550 | AND [70 |
| 551 | TAD HCIDF0 |
| 552 | DCA BAKCIF |
| 553 | RIB |
| 554 | JMS I MCDF /*K* OK SINCE BACKGROUND DOESN'T USE MAKCDF |
| 555 | DCA BAKCDF |
| 556 | ISZ HANG |
| 557 | HNGCDF, HLT |
| 558 | JMP I HANG /INTERRUPTS ARE OFF - RETURN |
| 559 | |
| 560 | NOTINH, TAD JMPDIS /IN CASE WE WERE HUNG, WE DON'T WANT |
| 561 | DCA I UNHANG /TO GET "UNHUNG" OUT OF THE ERROR ROUTINE! |
| 562 | JMP I (KILFPP /KILL FPP AND GO TO EXIT OR ERROR |
| 563 | |
| 564 | UNHANG, 0 |
| 565 | BACKAC, 0 |
| 566 | BACKLK, 0 |
| 567 | BACKPC, VBACKG |
| 568 | VHANG= HANG |
| 569 | IFNZRO VHANG-0524 <__ CHANGE LOADER!> |
| 570 | PAGE |
| 571 | \f/I-O CONVERSION ROUTINES - STARTUP CODE |
| 572 | |
| 573 | RWASCI, JMS I [RWINIT /"READ(N,FMT)" OR "WRITE(N,FMT)" |
| 574 | 2000 /"FORMATTED" BIT |
| 575 | JMS I [FETPC /GET ADDRESS OF FORMAT STMT |
| 576 | DCA FMTDF |
| 577 | JMS I [FETPC |
| 578 | DCA FMTADR |
| 579 | DCA FMTTYP |
| 580 | DCA PFACT /CLEAR SCALE FACTOR |
| 581 | JMS I [GETLMN /EXIT TO MAIN PROGRAM TO GET 1ST VARIABLE |
| 582 | |
| 583 | TAD (FMTPDL-1 |
| 584 | FMTSET, DCA FMTPXR /STORE NEW FORMAT PUSHDOWN POINTER |
| 585 | TAD I FMTPXR |
| 586 | DCA FMTBYT /GET NEW BYTE POINTER (NOTE-FMTPDL CONTAINS A 0) |
| 587 | \f/MAIN FORMAT DECODING LOOP |
| 588 | |
| 589 | FMTFLP, TAD FMTBYT |
| 590 | DCA FMPBYT /SAVE CURRENT BYTE PTR FOR PARENTHESES HACK |
| 591 | FMTDLP, DCA FMTNUM /ZERO ACCUMULATED NUMBER |
| 592 | FMTCLP, JMS FMTGCH /GET A CHARACTER |
| 593 | ISZ FMTBYT /BUMP BYTE POINTER |
| 594 | JMS I [CHTYPE /CLASSIFY CHAR |
| 595 | 1234; FMTDIG /DIGIT |
| 596 | -42; DBLQOT /" |
| 597 | -44; ABORTO /$ |
| 598 | -55; FMINUS /- |
| 599 | -56; FMTPER /. |
| 600 | -57; SLASH // |
| 601 | -54; COMMA /, |
| 602 | -50; LPAREN /( |
| 603 | -51; RPAREN /) |
| 604 | -47; KWOTE /' |
| 605 | -40; FMTCLP /SPACE |
| 606 | 0 /ANYTHING ELSE |
| 607 | |
| 608 | TAD FMTTYP |
| 609 | SZA CLA /CHECK THAT WE DO NOT HAVE A FIELD OUTSTANDING |
| 610 | JMP I (FMTERR /IF WE DO - ERROR |
| 611 | TAD CHCH /GET FIELD CHARACTER |
| 612 | DCA FMTTYP |
| 613 | TAD FMTNUM |
| 614 | SNA /IF REPEAT COUNT WAS MISSING OR ZERO |
| 615 | IAC /MAKE IT ONE |
| 616 | CMA |
| 617 | DCA N /STORE -(REPEAT COUNT +1) |
| 618 | DCA W /CLEAR WIDTH INITIALLY |
| 619 | ISZ FMTNUM /PRECLUDE "FORMAT ERROR" ON X,P, OR H FORMATS |
| 620 | TAD FMTTYP |
| 621 | AND [7 /IS THE CHARACTER P, X, OR H? |
| 622 | SNA CLA /IF SO, DON'T WAIT |
| 623 | COMMA, JMS I (DOFMT /EXECUTE THE STORED FIELD SPECIFICATION |
| 624 | JMP FMTFLP /BACK FOR MORE |
| 625 | |
| 626 | FMTADR, 0 /ADDRESS OF FORMAT |
| 627 | \fFMTGCH, 0 /GET CHARACTER FROM FORMAT |
| 628 | JMS FMTGAD /GET WORD CONTAINING CHAR AND L/R SWITCH |
| 629 | CDF 0 |
| 630 | JMS I (FMTGLR /EXTRACT CHARACTER |
| 631 | JMP I FMTGCH |
| 632 | |
| 633 | FMTGAD, 0 /SUBR TO GET A WORD FROM A CHARACTER OFFSET |
| 634 | TAD FMTBYT /GET OFFSET |
| 635 | CLL RAR |
| 636 | CLL |
| 637 | TAD FMTADR /COMPUTE BASE ADDR + [OFFSET/2] |
| 638 | DCA D |
| 639 | RAL |
| 640 | TAD FMTDF |
| 641 | JMS I MCDF /SET UP PROPER DATA FIELD |
| 642 | DCA .+1 |
| 643 | HLT |
| 644 | TAD FMTBYT |
| 645 | RAR |
| 646 | CLA /LEAVE L/R SWITCH IN LINK |
| 647 | TAD I D |
| 648 | JMP I FMTGAD /RETURN WITH WORD IN AC |
| 649 | |
| 650 | FMTDF, 0 /FIELD OF 1ST CHAR OF FORMAT IN BITS 9-11 |
| 651 | |
| 652 | FMTDIG, TAD FMTNUM /DIGIT PROCESSOR |
| 653 | CLL RTL |
| 654 | TAD FMTNUM |
| 655 | CLL RAL /MULTIPLY FMTNUM BY 10 |
| 656 | TAD CHCH /ADD IN THE DIGIT |
| 657 | JMP FMTDLP /STORE IT BACK AND CONTINUE |
| 658 | \f/PARENTHESIS AND DIGIT ROUTINES |
| 659 | |
| 660 | LPAREN, TAD FMTPXR |
| 661 | TAD (2-FMTPDL |
| 662 | SZA /ARE WE AT PARENTHESIS LEVEL 1? |
| 663 | JMP .+3 /NO |
| 664 | TAD FMPBYT /YES - STORE A POINTER TO THE FIRST DIGIT OF THE |
| 665 | DCA I (FMTPDL-2 /GROUP COUNT PRECEDING THIS PAREN |
| 666 | /AS THE LOOP POINTER FOR LEVEL 1 |
| 667 | TAD [7 |
| 668 | SPA CLA /PUSHDOWN OVERFLOW? |
| 669 | FPOERR, JMS I ERR /YES |
| 670 | AC7775 |
| 671 | TAD FMTPXR |
| 672 | DCA FMTPXR /BUMP PARENTHESIS PUSHDOWN POINTER |
| 673 | TAD FMTBYT |
| 674 | DCA I FMTPXR /SAVE BYTE POINTER |
| 675 | TAD FMTNUM |
| 676 | SNA |
| 677 | IAC /NO GROUP COUNT MEANS COUNT = 1 |
| 678 | CIA |
| 679 | DCA I FMTPXR /SAVE LOOP COUNT |
| 680 | DCA I (FMTPDL-1 /INITIAL GROUP COUNT IS INFINITE! |
| 681 | RPLOOP, AC7776 /COME HERE ON RIGHT PAREN ALSO |
| 682 | TAD FMTPXR /BACK UP FORMAT PDL POINTER |
| 683 | JMP FMTSET /RESTORE FMTBYT FROM TOP OF LIST |
| 684 | |
| 685 | FMPBYT, 0 |
| 686 | |
| 687 | RPAREN, JMS I (DOFMT /EXECUTE PREVIOUS SPEC IF ANY |
| 688 | TAD FMTPXR |
| 689 | TAD (2-FMTPDL /IS THIS THE FINAL RIGHT PAREN? |
| 690 | SNA CLA |
| 691 | JMS I [ENDREC /YES - CHECK FOR END OF FORMAT |
| 692 | ISZ I FMTPXR /BUMP COUNT |
| 693 | JMP RPLOOP /DIDN'T OVERFLOW - LOOP TO BYTE AFTER ( |
| 694 | ISZ FMTPXR /POP UP PARENTHESES STACK |
| 695 | JMP FMTFLP /CONTINUE PAST RIGHT PAREN |
| 696 | PAGE |
| 697 | \f/QUOTE AND HOLLERITH FORMAT PROCESSORS |
| 698 | |
| 699 | KWOTE, TAD MINUS5 /APOSTROPHE PROCESSOR |
| 700 | DBLQOT, TAD (-42 /QUOTE PROCESSOR |
| 701 | DCA KWODEL /SAVE TERMINATOR |
| 702 | JMS DOFMT /PROCESS PRECEDING FIELD , IF ANY |
| 703 | SKP |
| 704 | KWOTLP, JMS FMTHCV /PROCESS ONE CHARACTER |
| 705 | JMS I [FMTGCH /GET THE NEXT FORMAT CHAR |
| 706 | TAD KWODEL |
| 707 | SZA CLA /IS IT THE TERMINATOR? |
| 708 | JMP KWOTLP /NO - PROCESS IT AND CONTINUE |
| 709 | ISZ FMTBYT /BUMP OVER TERMINATOR |
| 710 | JMS I [FMTGCH |
| 711 | TAD KWODEL |
| 712 | SNA CLA /IS THIS ANOTHER TERMINATOR? |
| 713 | JMP KWOTLP /TWO TERMINATORS PRINT AS ONE |
| 714 | JMP I (FMTFLP /OTHERWISE GO BACK TO FORMAT LOOP |
| 715 | |
| 716 | HFMT, JMS MORE /MORE CHARACTERS? |
| 717 | JMS FMTHCV /YES - PROCESS ONE |
| 718 | JMP HFMT /AND LOOP |
| 719 | |
| 720 | FMTHCV, 0 /ROUTINE COMMON TO H AND QUOTED FORMATS |
| 721 | TAD RWFLAG /PROCESSES ONE CHAR IN OR OUT OF THE FORMAT |
| 722 | H7700, SMA CLA /IN OR OUT? |
| 723 | JMP FMTHIN /IN |
| 724 | JMS I [FMTGCH /OUT - GET THE CHAR |
| 725 | JMS I [FMTOUT /PRINT IT |
| 726 | JMP FMTHCR /RETURN |
| 727 | FMTHIN, JMS I [FMTIN /INPUT - GET THE CHAR FROM THE INPUT LINE |
| 728 | DCA W /SAVE IT |
| 729 | JMS I (FMTGAD |
| 730 | SZL /WHICH SIDE? |
| 731 | JMP FHRGHT /RIGHT SIDE |
| 732 | AND [77 /LEFT - KEEP RIGHT CHAR |
| 733 | DCA MORE |
| 734 | TAD W |
| 735 | CLL RTL |
| 736 | RTL |
| 737 | RTL |
| 738 | TAD MORE /ADD NEW CHAR IN ON THE LEFT |
| 739 | JMP .+3 |
| 740 | FHRGHT, AND H7700 /KEEP THE CHAR ON THE LEFT |
| 741 | TAD W /ADD NEW CHAR IN ON THE RIGHT |
| 742 | DCA I D /RESTORE ALTERED WORD |
| 743 | CDF 0 |
| 744 | FMTHCR, ISZ FMTBYT /BUMP BYTE POINTER |
| 745 | JMP I FMTHCV |
| 746 | |
| 747 | KWODEL, 0 /MUST BE UNIQUE! |
| 748 | \fMORE, 0 /SUBR TO BUMP REPEAT COUNT AND EXIT ON OVFLO |
| 749 | ISZ N |
| 750 | JMP I MORE |
| 751 | DOFRTN, DCA FMTTYP /INDICATE NO SPECIFICATION COLLECTED |
| 752 | JMP I DOFMT /RETURN FROM "DOFMT" |
| 753 | |
| 754 | DOFMT, 0 /ROUTINE TO PROCESS A FORMAT SPECIFICATION |
| 755 | TAD FMTNUM /GET THE CURRENT NUMBER |
| 756 | DCA D /STORE IT AS DECIMAL POINT SPEC |
| 757 | DCA IFLG |
| 758 | DCA EFLG |
| 759 | DCA GFLG /ZERO CONVERSION FLAGS |
| 760 | TAD FMTTYP |
| 761 | SNA CLA /ANY SPECIFICATION WAITING? |
| 762 | JMP I DOFMT /NO - JUST RETURN |
| 763 | TAD W |
| 764 | TAD D /IF THERE WAS NO W OR D SPECIFICATION, |
| 765 | SNA CLA |
| 766 | JMP FMTERR /ITS AN ERROR |
| 767 | TAD FMTTYP |
| 768 | JMS I [CHTYPE /YES - WHICH ONE? |
| 769 | -30; XFMT /X |
| 770 | -24; TFMT /T |
| 771 | -20; PFMT /P |
| 772 | -14; LFMT /L |
| 773 | -11; IFMT /I |
| 774 | -10; HFMT /H |
| 775 | -7; GFMT /G |
| 776 | -6; FFMT /F |
| 777 | MINUS5, -5; EFMT /E |
| 778 | -4;DF, EFMT /D - EQUIVALENT TO E IF NO D.P. FPP |
| 779 | -2;BF, FFMT /B - EQUIVALENT TO F IF NO D.P. FPP |
| 780 | -1; AFMT /A |
| 781 | 0 /NONE OF THE ABOVE - ERROR |
| 782 | FMTERR, JMS I ERR |
| 783 | \fENDREC, 0 /ROUTINE TO END A LINE AND MAYBE THE I/O |
| 784 | JMS I [EOLINE |
| 785 | CLA IAC |
| 786 | AND RWFLAG /LO BIT OF RWFLAG IS "I/O LIST EXHAUSTED" FLAG |
| 787 | SNA CLA /SKIP IF NO MORE ELEMENTS IN I/O LIST |
| 788 | JMP I ENDREC |
| 789 | JMP I [ENDIO /NOW FINISH UP AND LEAVE |
| 790 | |
| 791 | SLASH, JMS DOFMT /EXECUTE THE FIELD SPEC IF ANY |
| 792 | JMS I [EOLINE /TERMINATE CURRENT LINE |
| 793 | JMP I (FMTFLP |
| 794 | |
| 795 | PFMT, CLA CMA |
| 796 | TAD FMTNUM |
| 797 | ISZ MINFLG /P FORMAT - CHECK FOR NEGATIVE SCALE |
| 798 | CIA |
| 799 | DCA PFACT |
| 800 | STA /FALL INTO CODE TO CLEAR MINFLG |
| 801 | DCA MINFLG /SET FLAG ON MINUS |
| 802 | JMP DOFRTN |
| 803 | |
| 804 | FMINUS, JMS DOFMT /EXECUTE PRECEDING SPEC |
| 805 | DCA MINFLG /CLEAR MINUS FLAG |
| 806 | JMP I (FMTFLP |
| 807 | |
| 808 | MINFLG, -1 |
| 809 | |
| 810 | FMTPER, TAD FMTNUM /PERIOD PROCESSOR |
| 811 | DCA W /STORE WIDTH |
| 812 | JMP I (FMTFLP |
| 813 | |
| 814 | ABORTO, JMS DOFMT /$ - SPECIAL HACK TO ALLOW PROMPTS |
| 815 | DCA EOLSW /FAKE BEGINNING OF LINE |
| 816 | DCA I (TTYLF /INHIBIT LF BEFORE NEXT TTY INPUT |
| 817 | JMP I [ENDIO /GO AWAY |
| 818 | PAGE |
| 819 | \fCHTYPE, 0 /ROUTINE TO CLASSIFY CHARACTERS |
| 820 | DCA CHCH /SAVE CHAR |
| 821 | JMP CHLOOP+1 |
| 822 | CDIGIT, TAD CHCH /CHECK FOR DIGIT |
| 823 | TAD (-72 |
| 824 | CLL |
| 825 | TAD [12 |
| 826 | SZL /IS CHAR A DIGIT? |
| 827 | JMP JMPOUT /YES |
| 828 | CHLOOP, ISZ CHTYPE /SKIP OVER ADDRESS |
| 829 | CLA |
| 830 | TAD I CHTYPE |
| 831 | ISZ CHTYPE |
| 832 | SMA /END OF LIST? |
| 833 | JMP JMPOTX /MAYBE - JUMP WITH CODE IN AC |
| 834 | TAD CHCH |
| 835 | SZA CLA /DOES CHAR MATCH CHAR ON LIST? |
| 836 | JMP CHLOOP /NO - KEEP LOOKING |
| 837 | JMPOUT, DCA CHCH /ZERO CHAR |
| 838 | TAD I CHTYPE |
| 839 | DCA CHTYPE /SET UP TO RETURN INDIRECTLY |
| 840 | JMPOTX, SZA CLA /IS THIS THE END? |
| 841 | JMP CDIGIT /NO - GO CHECK FOR DIGIT |
| 842 | JMP I CHTYPE /GO TO SPECIFIED ADDRESS |
| 843 | |
| 844 | |
| 845 | SKPOUT, 0 /ROUTINE USED BY DATA-HANDLING SPECIFICATIONS |
| 846 | JMS I [MORE /CHECK FOR REPEAT COUNT EXHAUSTED |
| 847 | TAD RWFLAG |
| 848 | CLL RAR |
| 849 | SZA CLA /IF OUTPUT, |
| 850 | ISZ SKPOUT /SKIP RETURN |
| 851 | SZL CLA /IF END OF I/O LIST, |
| 852 | JMS I [ENDREC /DON'T RETURN AT ALL - GO AWAY |
| 853 | JMP I SKPOUT |
| 854 | \f/A FORMAT PROCESSOR |
| 855 | |
| 856 | AINPUT, TAD (4040 |
| 857 | DCA ACH |
| 858 | TAD (4040 |
| 859 | DCA ACL /INITIALIZE LOW-ORDER WORDS TO BLANKS |
| 860 | AINPTL, JMS GADR |
| 861 | SZL /LEFT OR RIGHT? |
| 862 | JMP AINPTR /RIGHT |
| 863 | JMS I [FMTIN |
| 864 | STL RTL /INPUT CHAR GOES IN HIGH-ORDER |
| 865 | RTL /WITH BLANK IN LOW-ORDER |
| 866 | RTL |
| 867 | JMP AINPTC |
| 868 | AINPTR, JMS I [FMTIN |
| 869 | TAD I FMTGLR /COMBINE INPUT CHAR AND OLD LEFT HALF |
| 870 | TAD [-40 /DELETE PREVIOUS RIGHT-HALF SPACE |
| 871 | AINPTC, DCA I FMTGLR /STORE WORD |
| 872 | ISZ W |
| 873 | JMP AINPTL /LOOP AROUND WIDTH |
| 874 | ANXT, JMS I [GETLMN /GET NEXT ELEMENT |
| 875 | AFMT, TAD D |
| 876 | CIA |
| 877 | DCA W /SAVE FIELD WODTH AS A COUNT |
| 878 | JMS I [SKPOUT /CHECK FOR REPEAT COUNT OVFLO AND I/O DIR |
| 879 | JMP AINPUT |
| 880 | AOTPUT, JMS GADR /OUTPUT - GET ADDRESS OF BYTE |
| 881 | TAD I FMTGLR |
| 882 | JMS FMTGLR /GET BYTE |
| 883 | JMS I [FMTOUT /PRINT IT |
| 884 | ISZ W |
| 885 | JMP AOTPUT /LOOP ON WIDTH |
| 886 | JMP ANXT |
| 887 | |
| 888 | FMTGLR, 0 /SUBR TO EXTRACT A CHAR FROM A WORD |
| 889 | SZL |
| 890 | JMP .+4 /RIGHT HALF |
| 891 | RTR |
| 892 | RTR |
| 893 | RTR /LEFT HALF - ROTATE INTO RIGHT HALF |
| 894 | AND [77 |
| 895 | JMP I FMTGLR |
| 896 | |
| 897 | GADR, 0 /BYTE ADDRESS ROUTINE FOR A FORMAT PROCESSOR |
| 898 | TAD D |
| 899 | TAD W /FORM BYTE OFFSET IN THE RANGE 0 THRU D-1 |
| 900 | CLL RAR |
| 901 | TAD (ACX |
| 902 | DCA FMTGLR |
| 903 | JMP I GADR /LEAVE WITH L/R FLAG IN LINK |
| 904 | \f/"STOP" ROUTINE - TERMINATES JOB |
| 905 | |
| 906 | CALXIT, TAD EXDVNO |
| 907 | CIA |
| 908 | DCA ACI /GO THROUGH THE FORTRAN UNIT NUMBERS. |
| 909 | DCA I (ENDFLS /*K* TURN "ENDFL" INTO A SUBROUTINE |
| 910 | JMS I (LDDSRN /IF WE FIND A UNIT WHICH IS BEING USED |
| 911 | SNA CLA /AND HAS NOT BEEN ENDFILED, |
| 912 | JMP XITISZ /WE WILL DUMP THE CURRENT BUFFER (IF IT |
| 913 | CLA IAC /IS A FORMATTED OUTPUT FILE) AND |
| 914 | AND FFLAGS /END-FILE IT |
| 915 | SNA CLA |
| 916 | JMS I (ENDFL |
| 917 | XITISZ, ISZ EXDVNO |
| 918 | JMP CALXIT |
| 919 | LPTTWT, TAD I LPGET /WAIT FOR LINE PRINTER AND TELETYPE TO |
| 920 | TAD TOCHR /GO QUIET. |
| 921 | SZA CLA |
| 922 | JMP LPTTWT |
| 923 | ISZ CLNADR /SET UP TO CLOSE OUTPUT FILES |
| 924 | PDPXIT, IOF /ENTER HERE FROM 7605 |
| 925 | CDF 0 /TO PROTECT CLODS WITH PDP 8/E'S |
| 926 | JMS I (7607 |
| 927 | 0210 |
| 928 | 7400 /READ IN CLEANUP ROUTINE |
| 929 | 37 /AND OS/8 PAGE 17600 |
| 930 | JMP .-5 /AYEEEE!! SYSTEM DEVICE GONZO! |
| 931 | CDF CIF 10 |
| 932 | JMP I CLNADR /CLOSE TENTATIVE FILES AND EXIT |
| 933 | CLNADR, CLNUP |
| 934 | EXDVNO, -11 |
| 935 | |
| 936 | ARGLD, 0 /ROUTINE TO GET VALUE OF AN ARG |
| 937 | JMS I [FETPC |
| 938 | AND [7 /THROW AWAY OPCODE (JA) |
| 939 | TAD FLDTM2 |
| 940 | DCA FGPBF |
| 941 | JMS I [FETPC /CONSTRUCT AN FPP INSTRUCTION |
| 942 | DCA BIOPTR |
| 943 | JMS I [FPGO |
| 944 | FGPBF |
| 945 | JMP I ARGLD |
| 946 | |
| 947 | FLDTM2, FLDA+LONG |
| 948 | FTEMP2 |
| 949 | FEXIT |
| 950 | PAGE |
| 951 | \f/SUBROUTINE TO OPEN A UNIT FOR I/O |
| 952 | |
| 953 | RWINIT, 0 |
| 954 | DCA RWFLAG /DIRECTION IN AC ON ENTRY |
| 955 | AC7776 |
| 956 | AND I RWINIT /IF CALLED FROM BACKSPACE, REWIND OR ENDFILE |
| 957 | SZA CLA /UNIT NUMBER IS IN FAC |
| 958 | JMS I [ARGLD /OTHERWISE, GET UNIT NUMBER |
| 959 | JMS I [FFIX |
| 960 | TAD ACI |
| 961 | CLL CMA |
| 962 | TAD [12 |
| 963 | SZL CLA /CHECK DEVICE NUMBER IN RANGE 0-9 |
| 964 | JMS LDDSRN /LOAD DSRN ENTRY INTO PAGE 0 |
| 965 | SNA CLA /IS UNIT INITIALIZED? |
| 966 | UNTERR, JMS I ERR /NO - ERROR |
| 967 | TAD RWFLAG |
| 968 | SPA /IF WE ARE WRITEING FOR THE FIRST TIME |
| 969 | TAD FFLAGS /ON A UNIT WHICH WAS BEING READ, |
| 970 | CMA RAL /WE MUST BUMP THE RELATIVE BLOCK NUMBER DOWN |
| 971 | SNL SMA CLA /ONE BECAUSE OF A PHILOSOPHICAL DIFFERENCE |
| 972 | JMS I (RD2WR /BETWEEN READ AND WRITE |
| 973 | TAD I RWINIT |
| 974 | TAD RWFLAG /OR THE I/O TYPE AND |
| 975 | CMA |
| 976 | AND FFLAGS /DIRECTION BITS INTO THE FLAG WORD |
| 977 | TAD I RWINIT |
| 978 | TAD RWFLAG |
| 979 | DCA FFLAGS |
| 980 | TAD FFLAGS |
| 981 | CMA RTL |
| 982 | SNL SMA CLA /IT IS ILLEGAL TO ACCESS A FILE IN |
| 983 | JMP UNTERR /FORMATTED AND UNFORMATTED MODES |
| 984 | ISZ RWINIT |
| 985 | TAD ACI |
| 986 | CLL RAL |
| 987 | TAD ACI |
| 988 | TAD (DATABL-4 |
| 989 | DCA XR /STORE POINTER INTO DIRECT-ACCESS TABLE |
| 990 | JMP I RWINIT |
| 991 | \f/REWIND AND END FILE |
| 992 | |
| 993 | RWIND, JMS RWINIT /GET THE DSRN ENTRY |
| 994 | 0 /DON'T PLAY WITH MODES |
| 995 | AC2000 |
| 996 | TAD FFLAGS |
| 997 | SNA CLA /IF FORMATTED OUTPUT FILE AND NOT EOF'D |
| 998 | JMS DMPBUF /DUMP LAST BUFFER AS A FAVOR |
| 999 | ATLDMK, CLA IAC |
| 1000 | AND FFLAGS /KILL ALL FLAG BITS |
| 1001 | DCA FFLAGS /EXCEPT "END-FILED" BIT |
| 1002 | TAD BADFLD |
| 1003 | AND [7400 |
| 1004 | DCA CHRPTR |
| 1005 | AC7775 |
| 1006 | DCA CHRCTR /INITIALIZE BUFFER POINTERS |
| 1007 | DCA RELBLK /AND RELATIVE BLOCK # |
| 1008 | JMP I [ENDIO /RESTORE DSRN AND EXIT |
| 1009 | |
| 1010 | ENDFL, JMS RWINIT /*K* USED AS A SUBROUTINE BY CALXIT |
| 1011 | 1 /GET DSRN, SET "END FILE" FLAG |
| 1012 | TAD FFLAGS /IF THE FILE IS UNFORMATTED, |
| 1013 | CMA RAL /OR WAS NOT OUTPUT ONTO, |
| 1014 | SNL SMA CLA /THEN ENDFILE DOES NOTHING. |
| 1015 | JMS DMPBUF /ELSE DUMP THE FINAL BUFFER |
| 1016 | AC3777 |
| 1017 | AND FFLAGS /CLEAR WRITE BIT SO WE WILL NOT TRY |
| 1018 | SETTOT, DCA FFLAGS /ANYTHING ON A SUBSEQUENT ENDFILE |
| 1019 | TAD RELBLK /SET NEW LENGTH OF FILE IN CASE ITS TENTATIVE, |
| 1020 | DCA TOTBLK /AND SO WE WON'T READ PAST EOF. |
| 1021 | ENDIO, JMS INITMV /SET UP DSRN POINTERS |
| 1022 | TAD I XR1 |
| 1023 | DCA I XR /STORE BACK THE DSRN ENTRY |
| 1024 | ISZ T /FOR THIS LOGICAL UNIT |
| 1025 | JMP .-3 |
| 1026 | DCA VEOFSW /CLEAR EOFSW AT END OF EVERY READ |
| 1027 | ENDFLS, JMP I [RETURN /RETURN TO THE CALLING PROGRAM |
| 1028 | JMP I ENDFL /*K* OR RETURN TO CALXIT |
| 1029 | |
| 1030 | INITMV, 0 /ROUTINE TO SET UP STUFF |
| 1031 | ICDF0, CDF 0 |
| 1032 | TAD LOGUNT |
| 1033 | DCA XR |
| 1034 | TAD (HAND-1 |
| 1035 | DCA XR1 |
| 1036 | TAD (-11 |
| 1037 | DCA T |
| 1038 | JMP I INITMV |
| 1039 | \f/ROUTINE TO DUMP CURRENT OUTPUT BUFFER WITH ^Z AT THE END |
| 1040 | |
| 1041 | DMPBUF, 0 |
| 1042 | ISZ EOLSW /FORCE COLUMN 1 SWITCH OFF |
| 1043 | TAD (7712 /OUTPUT A LINE FEED |
| 1044 | JMS I [FMTOUT |
| 1045 | TAD HAND /IF THE FILE IS BEING OUTPUT VIA |
| 1046 | SMA CLA /AN OS/8 HANDLER, |
| 1047 | JMP CLREOL /WE MUST TERMINATE THE BUFFER PROPERLY. |
| 1048 | TAD (32 |
| 1049 | CTZLP, TAD Z7700 /OUTPUT A ^Z AND FILL BUFFER WITH ZEROES. |
| 1050 | JMS I [FMTOUT /NEGATIVE NUMBERS TURN INTO CONTROL CHARS |
| 1051 | TAD CHRPTR |
| 1052 | AND [377 |
| 1053 | TAD CHRCTR /FILL THE BUFFER UNTIL CHRPTR POINTS TO |
| 1054 | IAC /A BLOCK BOUNDARY AND CHRCTR = -3 |
| 1055 | Z7700, SMA CLA /WE ARE THEN AT BUFFER-END |
| 1056 | JMP CTZLP |
| 1057 | CLREOL, DCA EOLSW /RESET TO BEGINNING OF LINE |
| 1058 | JMP I DMPBUF /RETURN |
| 1059 | |
| 1060 | /ROUTINE TO MOVE THE PROPER DSRN ENTRY INTO PAGE 0 |
| 1061 | |
| 1062 | LDDSRN, 0 |
| 1063 | TAD ACI / READ/WRITE INIT SINGS THIS SONG, |
| 1064 | CLL RTL / (DOO DAH, DOO DAH,) |
| 1065 | RAL / DSRN ENTRIES 9 WORDS LONG |
| 1066 | TAD ACI / (OH, DEE DOO DAH DAY). |
| 1067 | |
| 1068 | SNA /DEVICE NUMBER 0 IS SPECIAL - |
| 1069 | TAD (PTTY+11-DSRN /IT'S ALWAYS THE TELETYPE |
| 1070 | TAD (DSRN-12 |
| 1071 | DCA LOGUNT |
| 1072 | JMS INITMV /SET UP FOR MOVE |
| 1073 | TAD I XR |
| 1074 | DCA I XR1 /PUT DSRN ENTRY IN PAGE 0 |
| 1075 | ISZ T |
| 1076 | JMP .-3 |
| 1077 | TAD BADFLD |
| 1078 | AND [70 |
| 1079 | TAD ICDF0 |
| 1080 | DCA BUFCDF /SAVE BUFFER FIELD AS A CDF |
| 1081 | TAD HAND |
| 1082 | JMP I LDDSRN |
| 1083 | PAGE |
| 1084 | \f/BACKSPACE ROUTINE - WORKS ON BINARY OR ASCII FILES |
| 1085 | |
| 1086 | BKSPC, JMS I [RWINIT |
| 1087 | 0 /GET THE DSRN ENTRY WITHOUT ALTERING MODE |
| 1088 | TAD HAND |
| 1089 | SMA CLA |
| 1090 | JMP I [UNTERR /UNIT MUST BE BLOCK ORIENTED |
| 1091 | AC2000 |
| 1092 | AND FFLAGS |
| 1093 | SZA CLA /IS FILE FORMATTED? |
| 1094 | JMP BKASCI /YES - PAIN IN NECK |
| 1095 | JMS BMPBLK /UNFORMATTED FILE - REREAD LAST BLOCK |
| 1096 | TAD CHRPTR |
| 1097 | TAD [377 |
| 1098 | DCA T |
| 1099 | JMS BUFFLD /SET DATA FIELD TO FIELD OF BUFFER |
| 1100 | TAD I T /LOOK AT LAST WORD IN BUFFER |
| 1101 | CIA /REGARD IT AS THE NUMBER OF BLOCKS/RECORD |
| 1102 | TAD RELBLK |
| 1103 | DCA RELBLK /RELBLK POINTS TO FIRST BLOCK OF PREV. REC |
| 1104 | JMP I [ENDIO |
| 1105 | |
| 1106 | BMPBLK, 0 /SUBR TO BUMP BLOCK # BACK AND READ |
| 1107 | CMA CLL /AC MAY NOT BE 0 ON ENTRY |
| 1108 | TAD RELBLK |
| 1109 | DCA RELBLK /BUMP BLOCK BACK |
| 1110 | SNL |
| 1111 | JMP I (ATLDMK /BACKSPACED TOO FAR - CALL IT QUITS |
| 1112 | DCA CHRPTR /ZERO CHRPTR TO FORCE A READ FROM MASSIO |
| 1113 | JMS I [MASSIO /READ A BLOCK |
| 1114 | JMP I BMPBLK |
| 1115 | |
| 1116 | /**** NULL JOB GOES HERE FOR LACK OF A BETTER PLACE **** |
| 1117 | |
| 1118 | NULLJB, TAD N2525 |
| 1119 | NULLLP, ISZ N2525 /PUT THE FAMOUS "POLY BASIC PATTERN" |
| 1120 | JMP NULLLP /IN THE AC LIGHTS |
| 1121 | ISZ NUMISZ |
| 1122 | JMP NULLLP |
| 1123 | CML CMA RAR |
| 1124 | DCA N2525 |
| 1125 | TAD [-4 |
| 1126 | DCA NUMISZ |
| 1127 | JMP I (VBACKG /GOT SOMETHING MORE USEFUL TO DO? |
| 1128 | N2525, 2525 |
| 1129 | NUMISZ, -4 |
| 1130 | \f/BACKSPACE FOR FORMATTED FILES |
| 1131 | |
| 1132 | BKLORD, TAD I CHRPTR |
| 1133 | ISZ CHRPTR |
| 1134 | NOP |
| 1135 | AND [177 /GET 7 BITS |
| 1136 | TAD (-15 /COMPARE WITH C.R. - SINCE WE SKIPPED |
| 1137 | SNA CLA /THE FIRST ONE THIS WILL BELONG TO THE PREVIOUS |
| 1138 | JMP I [ENDIO /LINE AND WE WILL BE DONE (HAH!) |
| 1139 | BKASCI, JMS I (MASBMP /A COMPLICATED MESS - FIRST BUMP THE |
| 1140 | SKP /CHARACTER POINTER BACK TWO PLACES |
| 1141 | JMP BKGTCH /AND THEN FETCH A CHARACTER. THIS WILL IGNORE |
| 1142 | TAD BADFLD /THE LAST CHAR READ/WRITTEN (WHICH SHOULD |
| 1143 | AND [7400 /BE A CARRIAGE RETURN). |
| 1144 | CIA |
| 1145 | TAD CHRPTR |
| 1146 | CLL RAR |
| 1147 | SZA CLA /TEST WHETHER WE HAVE TO READ AN OLD BUFFER |
| 1148 | JMP BKNORD /NO |
| 1149 | TAD CHRCTR /SAVE POSITION IN CURRENT DOUBLEWORD |
| 1150 | DCA GETCH3 |
| 1151 | DCA CHRPTR |
| 1152 | AC4000 /IF WE ARE BACKSPACING AN OUTPUT FILE, |
| 1153 | TAD FFLAGS /WE MUST SAVE THE INFORMATION IN THE |
| 1154 | SPA /CURRENT BUFFER BY WRITING IT OUT. |
| 1155 | JMP .+4 |
| 1156 | DCA FFLAGS /ALSO CHANGE THE UNIT TO AN INPUT FILE |
| 1157 | AC4000 /(RWINIT TAKES CARE OF SWITCHING BACK TO OUTPUT) |
| 1158 | JMS I [MASSIO |
| 1159 | CLA IAC /WE DON'T WANT THE LAST BLOCK READ/WRITTEN, |
| 1160 | JMS BMPBLK /THAT'S IN CORE - WE WANT THE ONE |
| 1161 | TAD GETCH3 /BEFORE THAT. |
| 1162 | DCA CHRCTR |
| 1163 | TAD CHRCTR |
| 1164 | TAD (401 |
| 1165 | SKP /COMPUTE WORD POINTER FROM CHAR POINTER |
| 1166 | BKNORD, STA |
| 1167 | TAD CHRPTR |
| 1168 | DCA CHRPTR /BUMP WD PTR BACK 1 |
| 1169 | BKGTCH, JMS I (MASBMP /NOW GET A CHARACTER - THIS LOOKS A LOT |
| 1170 | JMP BKLORD /LIKE THE INPUT ROUTINE |
| 1171 | JMS GETCH3 |
| 1172 | JMP BKLORD+1 |
| 1173 | \fGETCH3, 0 /COMMON CODE BETWEEN BACKSPACE AND INPUT |
| 1174 | TAD I CHRPTR |
| 1175 | AND [7400 |
| 1176 | DCA BMPBLK /HANDY TEMPORARY |
| 1177 | ISZ CHRPTR |
| 1178 | TAD I CHRPTR |
| 1179 | AND [7400 |
| 1180 | CLL RTR |
| 1181 | RTR /COMBINE TWO 4-BIT QUANTITIES |
| 1182 | TAD BMPBLK /INTO A CHARACTER |
| 1183 | CLL RTR |
| 1184 | RTR |
| 1185 | JMP I GETCH3 |
| 1186 | |
| 1187 | DATABL, ZBLOCK 33 /DIRECT ACCESS TABLE |
| 1188 | PAGE |
| 1189 | \f/I,E,F,AND G FORMAT CONVERSIONS |
| 1190 | |
| 1191 | IFMT, TAD D |
| 1192 | DCA W /SET WIDTH PROPERLY |
| 1193 | DCA D /FOR SCALING PURPOSES |
| 1194 | STA |
| 1195 | DCA IFLG |
| 1196 | JMP FFMT |
| 1197 | |
| 1198 | GFMT, STA |
| 1199 | DCA GFLG /SET G AND E FLAGS |
| 1200 | |
| 1201 | EFMT, STA |
| 1202 | DCA EFLG /SET E FLAG |
| 1203 | JMP FFMT |
| 1204 | |
| 1205 | IGEF, JMS I [GETLMN /MAIN LOOP FOR CONVERSIONS - SKIPPED 1ST TIME |
| 1206 | FFMT, TAD D |
| 1207 | DCA OD /SAVE COUNT OF POST-D.P. DIGITS |
| 1208 | TAD IFLG |
| 1209 | SNA CLA /APPLY THE P-SCALE FACTOR |
| 1210 | TAD PFACT /ONLY IF THE FORMAT IS NOT I |
| 1211 | DCA PFACTX |
| 1212 | DCA SCALE /DON'T LOOK FOR TROUBLE |
| 1213 | JMS I [SKPOUT /CHECK IF MORE AND TEST DIRECTION |
| 1214 | JMP I (IGEFIN /INPUT |
| 1215 | STA |
| 1216 | DCA I [FFNEG /USE NEGATE ROUTINE HEADER AS SIGN FLAG |
| 1217 | TAD EFLG |
| 1218 | CLL RAL |
| 1219 | CLL RAL /0 IF NOT E, -4 IF E |
| 1220 | TAD W /THIS PROVIDES FOR THE EXP. FIELD (IF E FMT) |
| 1221 | DCA OW /OR THE 4 TRAILING SPACES (IF G FMT) |
| 1222 | TAD ACH |
| 1223 | SNA |
| 1224 | JMP SKPSHT /AC IS ZERO - SKP A LOT OF SHT |
| 1225 | SPA CLA |
| 1226 | JMS I [FFNEG /AC<0 - NEGATE IT AND SET FLAG (CLEVER) |
| 1227 | SCALUP, DCA SCALE |
| 1228 | TAD ACX |
| 1229 | SMA SZA CLA /AC<1.0? |
| 1230 | JMP GT1 /NO |
| 1231 | JMS I [FPGO /YES - MULTIPLY BY 10.0 |
| 1232 | FMUL10 |
| 1233 | STA |
| 1234 | TAD SCALE /BUMP POWER OF TEN |
| 1235 | JMP SCALUP |
| 1236 | \f/I,G,E,F, OUTPUT CONVERSIONS - NUMBER IS NOW =>1.0 |
| 1237 | |
| 1238 | GT1, JMS I (SCALDN /NOW DECREASE IT TO THE INTERVAL [0,1) |
| 1239 | JMS I [FPGO /SAVE IT AWAY |
| 1240 | FSTTMP |
| 1241 | TAD [7 |
| 1242 | JMS OSCALE |
| 1243 | JMS I [FPGO /USE IT TO ROUND THE NUMBER TO BE OUTPUT |
| 1244 | FADTMP |
| 1245 | JMS I (SCALDN /WE COULD HAVE ROUNDED FROM .999... TO 1.000... |
| 1246 | SKPSHT, TAD GFLG /ENTER HERE IF NUM WAS 0 - SCALE=0 |
| 1247 | SNA CLA |
| 1248 | JMP NOTG /NOT G FORMAT |
| 1249 | TAD SCALE /G FORMAT - TEST FOR OUT OF F FORMAT RANGE |
| 1250 | TAD PFACTX |
| 1251 | CIA CLL /F FORMAT RANGE IS [.1,10**(D VALUE)) |
| 1252 | TAD OD |
| 1253 | SNL |
| 1254 | JMP USEE /IF OUT OF BOUNDS USE E FORMAT (FLAG IS SET) |
| 1255 | DCA OD /REDUCE D VALUE BY SCALE FACTOR |
| 1256 | DCA EFLG /TO RETAIN CORRECT # OF SIG. DIGITS |
| 1257 | USEE, CLA |
| 1258 | JMP NOTG |
| 1259 | |
| 1260 | /SET UP TO PRINT DIGITS |
| 1261 | |
| 1262 | |
| 1263 | DIGCNT, 0 |
| 1264 | TAD PFACTX /COMPUTE EXPONENT JUST IN CASE E FORMAT |
| 1265 | CIA |
| 1266 | TAD SCALE |
| 1267 | DCA FMTNUM |
| 1268 | TAD EFLG |
| 1269 | SNA CLA /NOW COMPUTE THE NUMBER OF DIGITS BEFORE THE D.P. |
| 1270 | TAD SCALE /TAKE SCALE FACTOR INTO ACCOUNT IF NOT E FORMAT |
| 1271 | TAD PFACTX /TAKE P FACTOR INTO ACCOUNT IF NOT I OR F/G |
| 1272 | DCA SCALE /STORE THE NUMBER OF DIGITS BEFORE THE D.P. |
| 1273 | TAD I [FFNEG /INCREASE NUMBER OF LEADING BLANKS BY 1 |
| 1274 | SPA CLA /IF THE NUMBER IS POSITIVE. THIS DEPENDS ON |
| 1275 | ISZ OW /THIS LOCATION BEING BELOW 4000. |
| 1276 | TAD SCALE /GET THE NUMBER OF PRE-D.P. DIGITS (AS NEGATIVE #) |
| 1277 | SPA SNA |
| 1278 | CLA IAC /IF NONE, PRINT A 0 SO COUNT AS 1 |
| 1279 | TAD OD /REDUCE THE WIDTH BY THIS NUMBER |
| 1280 | CMA |
| 1281 | TAD OW /REDUCE IT AGAIN BY THE POST-D.P. DIGIT COUNT |
| 1282 | CIA |
| 1283 | TAD IFLG /AND AGAIN BY 1 FOR THE D.P. (IF NOT I FORMAT) |
| 1284 | JMP I DIGCNT |
| 1285 | OW, 0 |
| 1286 | \f/I,G,E,F FORMAT - ROUTINE TO SCALE ROUNDING FACTOR |
| 1287 | |
| 1288 | OSCALE, 0 /SUBR TO SCALE .5 THE CORRECT # OF TIMES |
| 1289 | DCA NPLCS /MAX IN AC ON ENTRY |
| 1290 | DCA ACX |
| 1291 | AC2000 /FORM A FLOATING 0.5 IN ORDER |
| 1292 | DCA ACH /TO ROUND THE NUMBER BEFORE PRINTING. |
| 1293 | DCA ACL |
| 1294 | TAD EFLG /FIGURE OUT HOW TO SCALE IT - |
| 1295 | SNA CLA /THE THEORY IS THAT IT SHOULD BE SCALED |
| 1296 | TAD SCALE /DOWN BY THE NUMBER OF SIGNIFICANT |
| 1297 | DCA T /PRINTING DIGITS. THIS CAN BE |
| 1298 | TAD SCALE /EXPRESSED AS: |
| 1299 | CIA CLL /(P FACTOR) * (NOT (G FMT PRINTING AS F)) |
| 1300 | TAD OD / + (SCALE FACTOR) * (NOT E FMT) + (D VALUE). |
| 1301 | SZL CLA /THE SCALE FACTOR IS < 0 FOR |
| 1302 | TAD GFLG /NUMBERS < .1, WHICH REDUCES |
| 1303 | SNA CLA /THE # OF SIG. DIGITS VIA LEADING ZEROS. |
| 1304 | TAD PFACTX /IF THERE ARE < 0 SIG. DIGITS |
| 1305 | TAD T /IT DOESN'T MATTER WHAT WE DO |
| 1306 | TAD OD /SINCE THE NUMBER WILL PRINT AS |
| 1307 | SMA /0.00000 ANYWAY. |
| 1308 | CMA /IF THERE ARE >NPLCS SIG. PRINTING DIGITS |
| 1309 | TAD NPLCS /THE ROUNDING GETS MEANINGLESS SO MAKE |
| 1310 | SPA /THE EXCESS DIVISIONS DIVIDES BY 2 INSTEAD |
| 1311 | DCA ACX / OF BY 10. THIS FUDGE WORKS QUITE WELL |
| 1312 | CIA /FOR NUMBERS OF UP TO NPLCS+2 |
| 1313 | TAD NPLCS /SIGNIFICANT DIGITS. |
| 1314 | CIA |
| 1315 | DCA T |
| 1316 | JMP .+3 |
| 1317 | FDIVLP, JMS I [FPGO /SCALE THE .5 DOWN THE CORRECT NUMBER OF TIMES |
| 1318 | FDIV10 |
| 1319 | ISZ T |
| 1320 | JMP FDIVLP |
| 1321 | JMP I OSCALE |
| 1322 | NPLCS, 0 |
| 1323 | ONE, 1;2000;0 |
| 1324 | PAGE |
| 1325 | \f/I,G,E,F OUTPUT CONVERSION - ACTUAL OUTPUT SECTION |
| 1326 | |
| 1327 | OUTNUM, SMA /CHECK FOR FIELD OVERFLOW |
| 1328 | JMP ASTSK1 /YES - PRINT ******* |
| 1329 | JMS OBLNKS /PRINT LEADING BLANKS - AC IS NOT 0! |
| 1330 | /***IMPORTANT - OBLNKS CLEARS AC1 *** |
| 1331 | AC7775 |
| 1332 | ISZ I [FFNEG /IF SIGN IS NEGATIVE, |
| 1333 | JMS DIGIT /OUTPUT A MINUS SIGN |
| 1334 | CLA /OTHERWISE OUTPUT NOTHING |
| 1335 | TAD ACX |
| 1336 | SNA /ALIGN THE FAC MANTISSA INTO A DOUBLEWORD |
| 1337 | JMS I [AL1 /FRACTION IN THE RANGE [.1,1) |
| 1338 | IAC /THIS INVOLVES SHIFTING THE MANTISSA |
| 1339 | CMA /RIGHT BY (-ACX-1) PLACES |
| 1340 | SMA /WHERE A NEGATIVE NUMBER MEANS A LEFT SHIFT. |
| 1341 | JMS I [ACSR |
| 1342 | CLA |
| 1343 | TAD ACL /NOW MOVE THE FAC DOWN A WORD SO THAT |
| 1344 | DCA AC1 /WHEN WE MULTIPLY BY 10 THE OVERFLOW APPEARS |
| 1345 | TAD ACH /IN THE HIGH-ORDER WORD |
| 1346 | DCA ACL |
| 1347 | TAD SCALE |
| 1348 | SPA SNA /DO WE HAVE DIGITS TO THE LEFT OF THE D.P.? |
| 1349 | JMP PRZERO /NO - PRINT A ZERO THERE |
| 1350 | JMS DIGITS /YES - PRINT THEM |
| 1351 | PRDCPT, TAD IFLG |
| 1352 | SZA CLA |
| 1353 | JMP I (IGEF /IF I FORMAT, WE'RE DONE NOW |
| 1354 | AC7776 |
| 1355 | JMS DIGIT /OTHERWISE PRINT DECIMAL POINT |
| 1356 | TAD SCALE |
| 1357 | SMA CLA /CHECK WHETHER WE NEED TO PRINT LEADING ZEROS |
| 1358 | JMP NOLZRO /NO |
| 1359 | TAD SCALE |
| 1360 | DCA T |
| 1361 | LZLOOP, STA CLL |
| 1362 | TAD OD /BUMP D VALUE DOWN BY ONE |
| 1363 | SNL /IF IT GOES NEGATIVE, |
| 1364 | JMP NOMOAC /WE'VE RUN OUT OF FIELD WIDTH |
| 1365 | DCA OD |
| 1366 | JMS DIGIT /PRINT A ZERO |
| 1367 | ISZ T /UNTIL THE COUNT (OR THE WIDTH) RUNS OUT |
| 1368 | JMP LZLOOP |
| 1369 | NOLZRO, TAD OD |
| 1370 | SZA /IF THERE ARE ANY DIGITS YET TO BE PRINTED, |
| 1371 | JMS DIGITS /PRINT THEM |
| 1372 | \f/I,G,E,F OUTPUT CONVERSION - FINISH UP |
| 1373 | |
| 1374 | NOMOAC, CLA |
| 1375 | TAD EFLG |
| 1376 | SNA CLA /E FORMAT? |
| 1377 | JMP CHKG /NO - CHECK FOR G FORMAT OUTPUT AS F |
| 1378 | JMS EXPFLD |
| 1379 | JMP I (IGEF |
| 1380 | EXPFLD, 0 |
| 1381 | TAD (5 |
| 1382 | JMS I [FMTOUT /OUTPUT "E" |
| 1383 | TAD FMTNUM /GET EXPONENT |
| 1384 | CLL |
| 1385 | SPA |
| 1386 | CML CIA /SEPARATE INTO MAGNITUDE AND SIGN |
| 1387 | DCA FMTNUM /SAVE MAGNITUDE |
| 1388 | RTL |
| 1389 | TAD (-5 /PRINT + OR - |
| 1390 | JMS DIGIT |
| 1391 | DCA T /INITIALIZE QUOTIENT OF DIVISION |
| 1392 | DVELP, TAD FMTNUM /SUBTRACT 10 FROM EXPONENT |
| 1393 | TAD [-12 |
| 1394 | SPA /DID IT GO NEGATIVE? |
| 1395 | JMP PRNTXP /YES - DONE |
| 1396 | DCA FMTNUM /NO - STORE IT BACK |
| 1397 | ISZ T /BUMP QUOTIENT |
| 1398 | JMP DVELP /LOOP |
| 1399 | PRNTXP, CLA |
| 1400 | TAD T |
| 1401 | TAD [-12 |
| 1402 | SMA CLA |
| 1403 | JMP ASTSK3 |
| 1404 | TAD T |
| 1405 | JMS DIGIT |
| 1406 | TAD FMTNUM |
| 1407 | JMS DIGIT /PRINT TWO DIGITS OF EXPONENT |
| 1408 | JMP I EXPFLD |
| 1409 | |
| 1410 | CHKG, TAD GFLG |
| 1411 | SNA /WAS IT G FORMAT? |
| 1412 | JMP I (IGEF /NO - F OR I - DONE |
| 1413 | DCA EFLG /RE-SET EFLG SINCE WE ZEROED IT BEFORE |
| 1414 | TAD (-5 |
| 1415 | JMS OBLNKS /OUTPUT 4 BLANKS |
| 1416 | JMP I (IGEF /DONE WITH G FORMAT OUTPUT |
| 1417 | |
| 1418 | PRZERO, CLA /COME HERE IF NO SIG. DIGITS LEFT OF D.P. |
| 1419 | JMS DIGIT /PRINT A ZERO |
| 1420 | JMP PRDCPT /CONTINUE |
| 1421 | |
| 1422 | ASTSK3, AC0002 |
| 1423 | JMP .+3 |
| 1424 | ASTSK1, CLA /CLEAR THE AC |
| 1425 | TAD W /GET THE FIELD WIDTH |
| 1426 | JMS I [ASTRSK |
| 1427 | JMP I (IGEF |
| 1428 | \f/I,G,E,F OUTPUT CONVERSION - OUTPUT SUBROUTINES |
| 1429 | |
| 1430 | OBLNKS, 0 /SUBROUTINE TO PRINT A STRING OF BLANKS |
| 1431 | DCA AC1 /MUST LEAVE AC1 ZERO ON EXIT SO THAT |
| 1432 | JMP .+3 /FAC LEFT SHIFT WON'T SHIFT IN GARBAGE LATER ON |
| 1433 | TAD [40 |
| 1434 | JMS I [FMTOUT /OUTPUT A BLANK |
| 1435 | ISZ AC1 |
| 1436 | JMP .-3 /LOOP |
| 1437 | JMP I OBLNKS /RETURN |
| 1438 | |
| 1439 | DIGITS, 0 /ROUTINE TO OUTPUT A STRING OF DECIMAL DIGITS |
| 1440 | CIA |
| 1441 | DCA T |
| 1442 | DGLOOP, TAD AC1 |
| 1443 | DCA AC2 /COPY AC INTO OPERAND FOR ADDITION LATER ON |
| 1444 | TAD ACL |
| 1445 | DCA OPL |
| 1446 | DCA ACH /CLEAR "OVERFLOW WORD" |
| 1447 | JMS I [AL1 |
| 1448 | JMS I [AL1 /FAC=FAC*4 |
| 1449 | DCA OPH |
| 1450 | JMS I [OADD |
| 1451 | JMS I [AL1 /FAC=ORIGINAL FAC*10 |
| 1452 | TAD ACH /GET OVERFLOW |
| 1453 | JMS DIGIT /PRINT IT |
| 1454 | ISZ T /LOOP FOR SPECIFIED NUMBER |
| 1455 | JMP DGLOOP |
| 1456 | JMP I DIGITS /RETURN |
| 1457 | |
| 1458 | DIGIT, 0 /ROUTINE TO OUTPUT A DIGIT |
| 1459 | TAD [60 |
| 1460 | JMS I [FMTOUT /TRIVIAL, ISN'T IT? |
| 1461 | JMP I DIGIT |
| 1462 | PAGE |
| 1463 | \f/I,G,E,F INPUT CONVERSION |
| 1464 | |
| 1465 | IGEFIN, STA /OD CONTAINS SCALING IF NO D.P. IN INPUT |
| 1466 | DCA DPSW /INITIALIZE D.P. SW |
| 1467 | STA |
| 1468 | DCA INESW /DITTO EXPONENT SWITCH |
| 1469 | TAD W |
| 1470 | CMA |
| 1471 | DCA FMTNUM /GET CHAR COUNT |
| 1472 | INERSM, DCA ACX /RE-ENTER HERE AFTER SEEING "E" |
| 1473 | DCA ACH /CLEAR FLOATING AC |
| 1474 | DCA ACL |
| 1475 | STA |
| 1476 | JMP INMINS /SET SIGN PLUS |
| 1477 | |
| 1478 | INGCH, JMS I [FMTIN /GET A CHAR |
| 1479 | JMS I [CHTYPE /CLASSIFY IT |
| 1480 | 1234; IDIGIT /DIGIT |
| 1481 | -56; INDCPT /. |
| 1482 | -53; INLOOP /+ |
| 1483 | -55; INMINS /- |
| 1484 | -5; INE /E |
| 1485 | -40; IBLDIG /BLANK - TREAT LIKE 0 IN FORTRAN STANDARD |
| 1486 | -54; INEONM /, |
| 1487 | 0 /OTHER - ERROR |
| 1488 | INER, JMS I ERR |
| 1489 | |
| 1490 | INDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER D.P. |
| 1491 | ISZ DPSW /TEST AND SET D.P. SWITCH |
| 1492 | JMP INER /WHOOPS - TWO D.P.S IN A NUMBER |
| 1493 | JMP INLOOP /KEEP GOING |
| 1494 | |
| 1495 | IBLDIG, TAD EOLSW /SINCE THE BLEEPING STANDARD DOESN'T COVER |
| 1496 | SZA CLA /TELETYPE I/O, WE KEEP SOME COOL BY IGNORING |
| 1497 | JMP INLOOP /BLANKS CREATED BY EARLY LINE TERMINATION. |
| 1498 | |
| 1499 | IDIGIT, TAD CHCH |
| 1500 | DCA DGT+1 /SAVE THE DIGIT |
| 1501 | JMS I [FPGO /FORM 10*FAC + DIGIT IN FAC |
| 1502 | ACMDGT |
| 1503 | TAD DPSW |
| 1504 | SNA CLA |
| 1505 | ISZ OD /BUMP DIGIT COUNT IF D.P. SEEN |
| 1506 | JMP INLOOP |
| 1507 | \fINMINS, DCA I [FFNEG /SET SIGN NEGATIVE |
| 1508 | |
| 1509 | INLOOP, ISZ FMTNUM |
| 1510 | JMP INGCH /LOOP UNTIL WIDTH EXHAUSTED |
| 1511 | INEONM, ISZ I [FFNEG /CHECK IF SIGN NEGATIVE |
| 1512 | JMS I [FFNEG /YES - NEGATE |
| 1513 | ISZ INESW /SEE IF "E" SEEN |
| 1514 | JMP FIXUPE /YES - WE HAVE EXPONENT, NOT NUMBER |
| 1515 | TAD PFACTX /NO "E" SEEN - SCALE USING P FACTOR |
| 1516 | |
| 1517 | SCALIN, TAD OD /GET SCALING FACTOR |
| 1518 | STL |
| 1519 | SNA |
| 1520 | JMP I (IGEF /NO SCALING NECESSARY |
| 1521 | SMA |
| 1522 | CIA CLL /AC CONTAINS MAGNITUDE, LINK CONTAINS SIGN |
| 1523 | DCA OD |
| 1524 | RTL |
| 1525 | RAL /AC CONTAINS 0 IF DIVIDE, 4 IF MULTIPLY |
| 1526 | TAD (FDIV10 |
| 1527 | DCA IGEFOP |
| 1528 | JMS I [FPGO /MULTIPLY OR DIVIDE BY 10.0 |
| 1529 | IGEFOP, 0 |
| 1530 | ISZ OD |
| 1531 | JMP IGEFOP-1/MULT OR DIV APPROPRIATE NUMBER OF TIMES |
| 1532 | JMP I (IGEF /RETURN FOR MORE |
| 1533 | |
| 1534 | INE, ISZ INESW /SEE IF THIS IS THE SECOND "E" |
| 1535 | JMP INER /YES - ERROR |
| 1536 | ISZ DPSW /FORCE DP SW ON (TO INHIBIT D.P. AFTER E) |
| 1537 | TAD OD /USE SCALE FACTOR ONLY IF D.P. SEEN |
| 1538 | DCA SCALE /SAVE SCALE FACTOR |
| 1539 | ISZ I [FFNEG |
| 1540 | JMS I [FFNEG /GET SIGN OF NUMBER CORRECT |
| 1541 | JMS I [FPGO /SAVE IT TEMPORARILY |
| 1542 | FSTTM2 |
| 1543 | JMP INERSM /GO COLLECT EXPONENT |
| 1544 | |
| 1545 | FIXUPE, JMS I [FFIX |
| 1546 | TAD ACI /GET EXPONENT |
| 1547 | CIA |
| 1548 | TAD SCALE /ADD IN EXPONENT TO D.P. SCALE FACTOR |
| 1549 | DCA OD |
| 1550 | JMS I [FPGO /GET NUMBER BACK IN FAC |
| 1551 | FLDTM2 |
| 1552 | JMP SCALIN |
| 1553 | |
| 1554 | DPSW, 0 |
| 1555 | DGT, 13;0;0;0;0;0 |
| 1556 | NOTG, JMS I (DIGCNT |
| 1557 | DCA SCALDN |
| 1558 | TAD IFLG |
| 1559 | SNA CLA |
| 1560 | JMP NOTI |
| 1561 | TAD SCALE |
| 1562 | TAD (-7 |
| 1563 | SPA CLA |
| 1564 | NOTI, TAD SCALDN |
| 1565 | JMP I (OUTNUM |
| 1566 | \fSCALDN, 0 /SUBROUTINE TO SCALE THE FAC LESS THAN 1.0 |
| 1567 | TAD ACX |
| 1568 | SPA SNA CLA /IS THE FAC => 1.0? |
| 1569 | JMP I SCALDN /NO - WE'RE DONE |
| 1570 | JMS I [FPGO /DIVIDE BY TEN |
| 1571 | FDIV10 |
| 1572 | ISZ SCALE /BUMP POWER OF TEN |
| 1573 | 0 /BACKUP FOR WIDTH |
| 1574 | JMP SCALDN+1 /LOOP |
| 1575 | |
| 1576 | ASTRSK, 0 |
| 1577 | CIA |
| 1578 | DCA T |
| 1579 | TAD (52 |
| 1580 | JMS I [FMTOUT |
| 1581 | ISZ T |
| 1582 | JMP .-3 |
| 1583 | JMP I ASTRSK /GET NEXT ELEMENT |
| 1584 | |
| 1585 | INESW, 0 /"E SEEN" SWITCH ON INPUT |
| 1586 | PAGE |
| 1587 | \f/L AND X FORMATS , T FORMAT INPUT |
| 1588 | |
| 1589 | TFMTIN, JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY |
| 1590 | CLA /BY FETCHING AND WASTING A CHARACTER |
| 1591 | TAD (INBUFR |
| 1592 | DCA INXR |
| 1593 | DCA EOLSW /SET TO BEGINNING OF LINE |
| 1594 | JMP XFMT |
| 1595 | XFMTIN, JMS I [FMTIN |
| 1596 | H7600, 7600 /WASTE AN INPUT CHAR |
| 1597 | XFMT, JMS I [MORE /ANY MORE CHARS? |
| 1598 | TAD RWFLAG /YES - IN OR OUT? |
| 1599 | SMA CLA |
| 1600 | JMP XFMTIN /IN |
| 1601 | TPPLBL, TAD [40 /HERE WITH AC=13 TO OVERPRINT ON T OUTPUT |
| 1602 | JMS I [FMTOUT /OUT |
| 1603 | JMP XFMT |
| 1604 | |
| 1605 | LINGCH, JMS I [FMTIN |
| 1606 | JMS I [CHTYPE /GET AND CLASSIFY CHARACTER |
| 1607 | -40; LINLP /BLANK |
| 1608 | -24; LINTRU /T |
| 1609 | -6; LINFLS /F |
| 1610 | 0 /OTHER - ERROR |
| 1611 | JMP I (INER |
| 1612 | |
| 1613 | LINTRU, TAD (4001 |
| 1614 | LINFLS, CLL RAR /PUT EITHER 0.0 OR 1.0 IN THE FAC |
| 1615 | DCA ACH |
| 1616 | DCA ACL |
| 1617 | RAL |
| 1618 | DCA ACX |
| 1619 | LINLP, ISZ W |
| 1620 | JMP LINGCH /LOOP ON FIELD WIDTH |
| 1621 | |
| 1622 | LNXT, JMS I [GETLMN /GET NEXT ELEMENT FOR I/O |
| 1623 | LFMT, TAD D |
| 1624 | CMA |
| 1625 | DCA W /SAVE WIDTH AS A COUNT |
| 1626 | JMS I [SKPOUT /IN OR OUT? |
| 1627 | JMP LINFLS /IN |
| 1628 | CLA IAC |
| 1629 | TAD W |
| 1630 | JMS I (OBLNKS /OUTPUT W-1 BLANKS |
| 1631 | TAD ACH |
| 1632 | SZA CLA |
| 1633 | TAD (16 |
| 1634 | TAD (6 /NON-ZERO IS TRUE, ZERO FALSE |
| 1635 | JMS I [FMTOUT /OUTPUT T OR F |
| 1636 | JMP LNXT /NEXT VICTIM |
| 1637 | \f/T FORMAT OUTPUT AND RANDOM SUBROUTINES |
| 1638 | |
| 1639 | TFMT, TAD D |
| 1640 | CIA |
| 1641 | DCA N /USE N TO FAKE OUT "X" FMT ROUTINE |
| 1642 | TAD RWFLAG |
| 1643 | SMA CLA |
| 1644 | JMP TFMTIN /INPUT |
| 1645 | TAD N |
| 1646 | TAD EOLSW /COMPARE DESIRED POSITION WITH CURRENT ONE |
| 1647 | SPA |
| 1648 | JMP TPBLNK /AFTER - SPACE TO IT |
| 1649 | JMS EOLINE /OUTPUT CR AND ZERO EOLSW |
| 1650 | JMS I [MORE /KLUDGE FOR "T1" FORMAT |
| 1651 | TAD (13 /FAKE X FORMAT INTO PRINTING |
| 1652 | JMP TPPLBL /A + AND (N-1) SPACES |
| 1653 | TPBLNK, DCA N /SAVE DIFFERENCE BETWEEN POSITIONS |
| 1654 | JMP XFMT /GO SPACE OUT |
| 1655 | |
| 1656 | EOLINE, 0 /SUBROUTINE TO TERMINATE I/O LINE |
| 1657 | TAD RWFLAG /CAUTION - AC LO-ORDER BITS MAY NOT BE 0 |
| 1658 | SPA CLA /INPUT OR OUTPUT? |
| 1659 | JMP EOOUTL /OUTPUT |
| 1660 | JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY |
| 1661 | CLA |
| 1662 | TAD (INBUFR-1 |
| 1663 | DCA INXR /SET XR TO NEGATIVE WORD AT THE |
| 1664 | JMP .+3 /BEGINNING OF THE INPUT BUFFER |
| 1665 | EOOUTL, TAD (7715 |
| 1666 | JMS I [FMTOUT /OUTPUT A CARRIAGE RETURN |
| 1667 | DCA EOLSW /CLEAR EOLSW FOR INPUT AND OUTPUT |
| 1668 | JMP I EOLINE |
| 1669 | \f/ROUTINE TO MOVE A HANDLER INTO FIELD 0 |
| 1670 | |
| 1671 | GETHND, 0 /HANDLER CODE WORD IN AC ON ENTRY |
| 1672 | DCA HCW /SAVE HANDLER CODE WORD |
| 1673 | TAD [7774 |
| 1674 | AND HCW /KNOCK OUT ION AND FORMS CTL BITS |
| 1675 | CIA |
| 1676 | SZA /IF HANDLER IS NOT RESIDENT, |
| 1677 | TAD HKEY /SEE IF THE HANDLER IS ALREADY |
| 1678 | SNA CLA /IN THE HANDLER AREA IN FIELD 0 |
| 1679 | JMP HINF0 /YES |
| 1680 | TAD HCW /NO - PUT IT THERE |
| 1681 | AND [70 |
| 1682 | TAD HCDF0 |
| 1683 | DCA HNDCDF /GET CDF TO FIELD IN WHICH HANDLER RESIDES |
| 1684 | TAD HCW |
| 1685 | AND H7600 |
| 1686 | TAD (-1 /GET POINTER TO HANDLER ADDRESS |
| 1687 | DCA XR1 /IN THAT FIELD |
| 1688 | TAD (HPLACE-1 |
| 1689 | DCA XR /ALSO TO HANDLER AREA IN FIELD 0 |
| 1690 | TAD [7400 /SET UP COUNT OF 7400 |
| 1691 | DCA HKEY /INDEPENDENT OF HANDLER SIZE |
| 1692 | HNDCDF, HLT |
| 1693 | TAD I XR1 |
| 1694 | HCDF0, CDF 0 |
| 1695 | DCA I XR /MOVE HANDLER INTO HANDLER AREA |
| 1696 | ISZ HKEY |
| 1697 | JMP HNDCDF |
| 1698 | TAD [7774 |
| 1699 | AND HCW |
| 1700 | DCA HKEY /SET NEW KEY CODE WORD |
| 1701 | HINF0, CLA IAC |
| 1702 | AND HCW |
| 1703 | SNA CLA /INTERRUPTS ALLOWED? |
| 1704 | YHIOF, IOF /NO - TOO BAD |
| 1705 | ISZ CTCINH /INHIBIT ^C DURING HANDLER CALL |
| 1706 | JMP I GETHND |
| 1707 | HKEY, 0 |
| 1708 | HCW, 0 |
| 1709 | PAGE |
| 1710 | \f/CHARACTER INPUT ROUTINE - LINE AT A TIME |
| 1711 | |
| 1712 | FMTIN, 0 |
| 1713 | TAD EOLSW |
| 1714 | SNA /END OF LINE ALREADY FOUND? |
| 1715 | TAD I INXR /NO - GET CHAR FROM LINE BUFFER |
| 1716 | SPA /TIME TO READ A NEW LINE? |
| 1717 | JMP READLN /YES |
| 1718 | SNA /END OF LINE? |
| 1719 | JMP INEOL /YES - SET INDICATOR |
| 1720 | AND [77 /CONVERT TO SIXBIT |
| 1721 | JMP I FMTIN /RETURN WITH IT |
| 1722 | INEOL, TAD [40 |
| 1723 | UNPKLN, DCA EOLSW /SET EOL INDICATOR TO A BLANK |
| 1724 | JMP FMTIN+1 /AND RETURN BLANKS FROM HERE ON IN |
| 1725 | READLN, DCA EOLSW /USE EOLSW AS A COUNT SO IT WINDS UP 0 |
| 1726 | TAD HAND |
| 1727 | TAD (-TTY |
| 1728 | SNA CLA /IS IT TELETYPE INPUT? |
| 1729 | STA /YES - SET TTY FLAG |
| 1730 | DCA TTYFLG |
| 1731 | JMS ECHO |
| 1732 | TTYLF, 12 /ECHO LF IF TTY INPUT |
| 1733 | TAD [12 /TTYLF IS ZEROED BY ABORTO |
| 1734 | DCA TTYLF |
| 1735 | |
| 1736 | READLP, CLA |
| 1737 | TAD HAND |
| 1738 | SPA CLA /CHARACTER ORIENTED DEVICE? |
| 1739 | JMP MASSIN /NO - UNPACK CHAR FROM BUFFER |
| 1740 | JMS I HAND /GET A CHARACTER |
| 1741 | GOTCHR, AND [177 /STRIP OFF PARITY |
| 1742 | JMS I [CHTYPE /CLASSIFY IT |
| 1743 | -15; INCRET /CARRIAGE RETURN |
| 1744 | -177; RUBOUT /RUBOUT |
| 1745 | -11; INTAB /TAB |
| 1746 | -25; CTRLU /^U |
| 1747 | -32; INEOF /^Z |
| 1748 | 0 /ANYTHING ELSE |
| 1749 | TAD CHCH |
| 1750 | TAD [-40 |
| 1751 | SMA /IF CHARACTER IS >37, |
| 1752 | JMS INPUTC /STORE IT AND ECHO IT IF TTY |
| 1753 | JMP READLP |
| 1754 | \f/CHARACTER INPUT ROUTINE - SPECIAL CHARACTER HANDLERS |
| 1755 | |
| 1756 | INTAB, JMS INPUTC /TAB - INSERT (AND ECHO) BLANKS |
| 1757 | TAD INXR |
| 1758 | AND [7 |
| 1759 | SZA CLA /UNTIL A COLUMN MULTIPLE OF 8 IS REACHED |
| 1760 | JMP INTAB |
| 1761 | JMP READLP |
| 1762 | |
| 1763 | RUBOUT, TAD EOLSW |
| 1764 | CIA |
| 1765 | TAD I (INBUFR /IGNORE RUBOUTS IF LINE EMPTY |
| 1766 | AND TTYFLG |
| 1767 | SNA CLA |
| 1768 | JMP READLP /OR IF NON-TTY INPUT |
| 1769 | JMS ECHO |
| 1770 | 134 /ECHO A BACKSLASH |
| 1771 | IBAKUP, STA |
| 1772 | TAD INXR |
| 1773 | DCA INXR /BACK UP LINE POINTER |
| 1774 | STA |
| 1775 | TAD EOLSW |
| 1776 | DCA EOLSW /AND CHAR COUNTER |
| 1777 | JMP READLP |
| 1778 | |
| 1779 | INEOF, TAD VEOFSW /CHECK SWITCH SET BY "CHKEOF" LIBRARY ROUTINE |
| 1780 | SNA /WAS HE EXPECTING AN EOF? |
| 1781 | EOFERR, JMS I ERR /NO |
| 1782 | JMS I MCDF |
| 1783 | DCA .+1 |
| 1784 | HLT /CDF TO FIELD OF INDICATOR VARIABLE |
| 1785 | AC2000 |
| 1786 | DCA I VEOFSW+1 /SET VARIABLE TO .5 |
| 1787 | CDF 0 /FALL INTO CARRIAGE RETURN CODE |
| 1788 | |
| 1789 | INCRET, DCA I INXR /CARRIAGE RETURN - ZERO OUT REST OF LINE |
| 1790 | SKP |
| 1791 | CTRLU, STA /SNEAKY, SNEAKY! |
| 1792 | TAD (INBUFR |
| 1793 | DCA INXR /RESET XR TO FETCH LINE CHARS |
| 1794 | JMS ECHO |
| 1795 | 15 /ECHO THE C.R. |
| 1796 | JMP UNPKLN /BACK TO FETCH FIRST CHAR |
| 1797 | |
| 1798 | INPUTC, 0 /ROUTINE TO STORE AND ECHO A CHAR |
| 1799 | TAD [40 |
| 1800 | DCA INTMP |
| 1801 | JMS ECHO |
| 1802 | INTMP, 0 /ECHO CHAR IF TTY INPUT |
| 1803 | TAD INTMP |
| 1804 | DCA I INXR /STORE CHAR IN LINE BUFFER |
| 1805 | ISZ EOLSW |
| 1806 | JMP I INPUTC /RETURN IF NO OVERFLOW |
| 1807 | JMP IBAKUP /IGNORE CHAR IF OVERFLOW |
| 1808 | \fECHO, 0 /ROUTINE TO ECHO CHAR IF TTY INPUT |
| 1809 | TAD I ECHO /GET CHAR |
| 1810 | AND TTYFLG |
| 1811 | SZA /SHOULD WE ECHO? |
| 1812 | JMS I HAND /YES |
| 1813 | JMP I ECHO /RETURN TO CHARACTER - ITS SMALL |
| 1814 | TTYFLG, 0 |
| 1815 | |
| 1816 | /CHARACTER INPUT ROUTINE - MASS STORAGE SECTION |
| 1817 | |
| 1818 | MASSIN, JMS MASBMP /GET BUFFER FIELD AND CHAR NUMBER |
| 1819 | JMP INLORD /CHAR 1 OR 2 - STRAIGHTFORWARD |
| 1820 | JMS I (GETCH3 /USE COMMON SUBROUTINE |
| 1821 | JMP MASICM /GO TO COMMON CODE |
| 1822 | |
| 1823 | INLORD, JMS I [MASSIO /CHECK IF WE SHOULD READ IN A BUFFERLOAD |
| 1824 | JMS BUFFLD /SET FIELD OF BUFFER |
| 1825 | TAD I CHRPTR |
| 1826 | MASICM, ISZ CHRPTR /GET THE CHAR (IN LOW 8 BITS) AND BUMP PTR |
| 1827 | NOP /WATCH END OF FIELD FUNNYBUSINESS! |
| 1828 | CDF 0 /RESET DATA FIELD |
| 1829 | JMP GOTCHR /GO EXTRACT SEVEN BIT CHARACTER |
| 1830 | |
| 1831 | MASBMP, 0 |
| 1832 | JMS BUFFLD /SET TO BUFFER'S DATA FIELD |
| 1833 | ISZ CHRCTR /BUMP CHAR COUNTER |
| 1834 | JMP I MASBMP /CHAR 1 OR 2 - NO SWEAT |
| 1835 | AC7775 |
| 1836 | DCA CHRCTR /CHAR 3 - RESET CHAR CTR |
| 1837 | AC7776 |
| 1838 | TAD CHRPTR /BUMP BACK CHAR PTR |
| 1839 | DCA CHRPTR |
| 1840 | ISZ MASBMP |
| 1841 | JMP I MASBMP /SKIP RETURN |
| 1842 | PAGE |
| 1843 | \f/CHARACTER OUTPUT ROUTINE |
| 1844 | |
| 1845 | FMTOUT, 0 |
| 1846 | TAD [40 /FIRST CONVERT SIXBIT TO ASCII |
| 1847 | SMA /CTL CHARS COME IN NEGATIVE |
| 1848 | AND [77 |
| 1849 | TAD (240 |
| 1850 | DCA OCHAR /SAVE ASCII CHAR (WITHOUT PARITY BIT) |
| 1851 | TAD EOLSW |
| 1852 | SZA CLA |
| 1853 | JMP NOT1ST /FIRST CHAR IS DECODED FOR FORMS CONTROL |
| 1854 | AC0002 /CHECK TO SEE IF THIS UNIT |
| 1855 | AND HCODEW /SHOULD RECEIVE FORMS CONTROL |
| 1856 | SZA CLA |
| 1857 | JMP LFPLCH /NO - JUST PRINT A LINE FEED AND THE CHAR |
| 1858 | TAD OCHAR |
| 1859 | JMS I [CHTYPE /CLASSIFY CONTROL CHAR |
| 1860 | -261; OUTFFX /1 - TOP OF FORM |
| 1861 | -260; OUT2LF /0 - DOUBLE SPACE |
| 1862 | -253; NOLF /+ - OVERPRINT |
| 1863 | 0 /ANYTHING ELSE - SINGLE SPACE |
| 1864 | JMP OUTLF |
| 1865 | |
| 1866 | OUTFFX, TAD HAND |
| 1867 | TAD (-TTY /IF HANDLER IS TTY OUTPUT TWO LINE FEEDS |
| 1868 | SZA CLA /INSTEAD OF A FORM FEED |
| 1869 | JMP OUTFF |
| 1870 | OUT2LF, TAD [12 |
| 1871 | DCA OCHAR /SET 2ND CHAR TO LINE FEED |
| 1872 | LFPLCH, STA |
| 1873 | DCA EOLSW /SET SWITCH FOR 2ND CHAR |
| 1874 | TAD OCHAR |
| 1875 | DCA CHCH /SAVE CHARACTER AWAY |
| 1876 | OUTLF, AC7776 |
| 1877 | OUTFF, TAD F214 /SUBSTITUTE THE APPROPRIATE FORM CONTROL |
| 1878 | DCA OCHAR /FOR THE CHARACTER |
| 1879 | NOT1ST, TAD HAND |
| 1880 | SPA CLA /CHARACTER ORIENTED DEVICE? |
| 1881 | JMP MASOUT /NO - PACK CHAR INTO BUFFER |
| 1882 | TAD OCHAR |
| 1883 | JMS I HAND /OUTPUT CHAR |
| 1884 | NOLF, ISZ EOLSW /BUMP CHAR CTR |
| 1885 | JMP I FMTOUT /NO - RETURN |
| 1886 | TAD CHCH /AHA - ANOTHER CHARACTER SHOULD BE OUTPUT |
| 1887 | JMP OUTFF+1 /GO TO IT |
| 1888 | \f/CHARACTER OUTPUT - MASS STORAGE OUTPUT |
| 1889 | |
| 1890 | MASOUT, JMS I (MASBMP /GET BUFFER FIELD AND CHAR NUMBER |
| 1891 | JMP OULORD /CHAR 1 OR 2 - STRAIGHTFORWARD |
| 1892 | JMS OSUBR /CHAR 3 - PACK FIRST HALFBYTE |
| 1893 | JMS OSUBR /PACK SECOND HALFBYTE |
| 1894 | AC4000 |
| 1895 | JMS MASSIO /CHECK IF WE SHOULD DUMP THE BUFFER |
| 1896 | MASOCM, CDF 0 |
| 1897 | JMP NOLF /GO RETURN OR REENTER |
| 1898 | |
| 1899 | OULORD, TAD OCHAR |
| 1900 | DCA I CHRPTR /STORE CHAR, ZAPPING HIGH-ORDER BITS |
| 1901 | ISZ CHRPTR /BUMP CHAR PTR |
| 1902 | F214, 214 /GUARD AGAINST OVFLO |
| 1903 | JMP MASOCM /RETURN |
| 1904 | |
| 1905 | OSUBR, 0 /ROUTINE TO PACK A HALFBYTE |
| 1906 | TAD OCHAR |
| 1907 | CLL RTL |
| 1908 | RTL /SHIFT CHAR 4 LEFT |
| 1909 | DCA OCHAR |
| 1910 | TAD I CHRPTR /CLEAR OUT ANY RESIDUE |
| 1911 | AND [377 /FROM HIGH-ORDER OF BUFFER WORD |
| 1912 | DCA I CHRPTR /IN CASE WE ARE WRITING AFTER A BACKSPACE. |
| 1913 | TAD OCHAR |
| 1914 | AND [7400 /GET 4 BITS |
| 1915 | TAD I CHRPTR |
| 1916 | DCA I CHRPTR /ADD INTO HIGH-ORDER OF BUFFER WORD |
| 1917 | ISZ CHRPTR /BUMP POINTER |
| 1918 | 200 /OVERFLOW! |
| 1919 | JMP I OSUBR |
| 1920 | |
| 1921 | MASSIO, 0 /SUBROUTINE TO READ/WRITE BUFFER IF NECESSARY |
| 1922 | CDF 0 |
| 1923 | TAD BUFCDF /ADD BUFFER CDF TO R/W BIT IN AC |
| 1924 | TAD (-6001 /TAKE AWAY CDF, LEAVE BIT 4 ON |
| 1925 | DCA IOCTL /STORE I/O CONTROL WORD |
| 1926 | TAD CHRPTR |
| 1927 | AND [377 |
| 1928 | SZA CLA /SEE IF POINTER IS AT BUFFER BOUNDARY |
| 1929 | JMP I MASSIO /YES - RETURN DOING NOTHING |
| 1930 | TAD RELBLK |
| 1931 | TAD STBLK /STORE BLOCK # IN HANDLER CALL |
| 1932 | DCA BLOCK |
| 1933 | TAD BADFLD |
| 1934 | AND [7400 |
| 1935 | DCA BUFFER /STORE BUFFER ADDRESS IN HANDLER CALL |
| 1936 | \f/CHARACTER OUTPUT - BUFFER I/O ROUTINE CONTINUED |
| 1937 | |
| 1938 | TAD TOTBLK |
| 1939 | CIA CLL |
| 1940 | TAD RELBLK |
| 1941 | SZL CLA /CHECK FOR FILE OVERFLOW |
| 1942 | IOVFLO, JMS I ERR /YES - ERROR |
| 1943 | TAD HCODEW |
| 1944 | JMS I (GETHND /GET HANDLER INTO FIELD 0 |
| 1945 | JMS I HAND /CALL HANDLER |
| 1946 | IOCTL, 0 |
| 1947 | BUFFER, 0 |
| 1948 | BLOCK, 0 |
| 1949 | SMA CLA /HANDLER ERROR - ABORT |
| 1950 | SKP /IF NOT EOF |
| 1951 | IOERR, JMS I ERR |
| 1952 | JMS I (RECOVR /CLEAR ANY FLAGS SET BY OS8 HANDLER |
| 1953 | ISZ RELBLK /BUMP RELATIVE BLOCK NUMBER |
| 1954 | TAD BUFFER |
| 1955 | DCA CHRPTR /RESET CHAR PTR |
| 1956 | JMP I MASSIO /RETURN |
| 1957 | /FPP CODE FOR I/O CONVERSION |
| 1958 | |
| 1959 | FDIV10, FDIV+LONG |
| 1960 | TEN |
| 1961 | FEXIT |
| 1962 | OCHAR, 0 /*** NEEDED FOR PADDING *** |
| 1963 | FMUL10, FMUL+LONG /FMUL10 MUST BE AT FDIV10+4 |
| 1964 | TEN |
| 1965 | FEXIT |
| 1966 | |
| 1967 | FWTOBL, FSUB+LONG |
| 1968 | ONE |
| 1969 | FDIV+LONG |
| 1970 | FLTG85 |
| 1971 | FEXIT |
| 1972 | PAGE |
| 1973 | \f/UNFORMATTED (BINARY) INPUT-OUTPUT |
| 1974 | |
| 1975 | RWUNF, JMS I [RWINIT /"READ(N)" OR "WRITE(N)" |
| 1976 | 1000 /"UNFORMATTED" BIT |
| 1977 | TAD SZLCLA /ENABLE SEQUENCE CHECKING |
| 1978 | UNFIO, DCA SEQCHK /*** SET SEQCHK TO "SZL CLA" OR "CLA" |
| 1979 | DCA RECCTR /ENTER HERE FROM DIRECT ACCESS |
| 1980 | TAD HAND |
| 1981 | SMA CLA /CHECK FOR MASS-STORAGE HANDLER |
| 1982 | JMP I [UNTERR /NO - ERROR |
| 1983 | JMS I [GETLMN /GET FIRST VARIABLE |
| 1984 | TAD RWFLAG |
| 1985 | SPA CLA |
| 1986 | RSETBP, TAD (125 /INITIALIZE COUNT TO -86 FOR WRITE, |
| 1987 | CMA /-1 FOR READ |
| 1988 | DCA CHRCTR |
| 1989 | TAD BADFLD |
| 1990 | AND [7400 |
| 1991 | DCA BIOPTR /INITIALIZE BUFFER POINTER |
| 1992 | TAD BADFLD |
| 1993 | AND [70 |
| 1994 | IAC |
| 1995 | CLL RTR /AC BIT 0 NOW ON |
| 1996 | TAD RWFLAG /AC BIT 0 CONTAINS COMP. OF R/W FLAG |
| 1997 | CLL RAR /AC=(.NOT.RW)*2000+BUFFER FIELD |
| 1998 | TAD (FSTA+LONG /AC=(FSTA OR FLDA) + BUFFLD |
| 1999 | DCA FGPBF |
| 2000 | JMP UIOVLP /SKIP FIRST VARIABLE FETCH/STORE |
| 2001 | BFINCR, JMS I [FPGO |
| 2002 | FGPBF /LOAD OR STORE A BUFFER ENTRY |
| 2003 | ISZ BIOPTR |
| 2004 | ISZ BIOPTR /INCREASE BUFFER POINTER |
| 2005 | ISZ BIOPTR |
| 2006 | JMS I [GETLMN /GET A VARIABLE FROM THE CALLING PROGRAM |
| 2007 | UIOVLP, TAD RWFLAG |
| 2008 | CLL RAR /LOWORDER BIT OF RWFLAG = END LIST FLAG |
| 2009 | SZL CLA |
| 2010 | JMP ENDUIO /NO MORE VARIABLES - TERMINATE |
| 2011 | ISZ CHRCTR /BUMP COUNTER |
| 2012 | JMP BFINCR /ROOM IN BUFFER - MOVE VARIABLE |
| 2013 | JMS UDOIO /GET A NEW BUFFER |
| 2014 | JMP RSETBP /RESET BUFFER POINTERS AND COUNTERS |
| 2015 | |
| 2016 | ENDUIO, TAD RWFLAG /COME HERE WHEN I/O LIST EXHAUSTED |
| 2017 | SPA CLA /WRITE? |
| 2018 | JMS UDOIO /YES - WRITE OUT THE LAST BUFFER |
| 2019 | JMP I [ENDIO /RESTORE DSRN ENTRY AND QUIT |
| 2020 | |
| 2021 | RECCTR, 0 |
| 2022 | \f/DIRECT-ACCESS I/O |
| 2023 | |
| 2024 | RWDACC, JMS I [RWINIT /"READ(N'R)" OR "WRITE(N'R)" |
| 2025 | 1000 /DIRECT ACCESS IS UNFORMATTED I/O |
| 2026 | TAD I XR |
| 2027 | DCA T /GET BLOCKS/RECORD FACTOR FROM D.A. TABLE |
| 2028 | JMS I [ARGLD /GET RECORD NUMBER |
| 2029 | JMS I [FFIX /CONVERT TO INTEGER |
| 2030 | TAD T |
| 2031 | TAD ACI |
| 2032 | ISZ T /MULTIPLY RECORD NUMBER BY BLOCKS/RECORD |
| 2033 | JMP .-2 /TO GET RELATIVE BLOCK NUMBER |
| 2034 | DCA RELBLK |
| 2035 | TAD I XR |
| 2036 | SNA /THIS LOC SHOULD NOT BE ZERO! |
| 2037 | DAERR, JMS I ERR |
| 2038 | DCA FGPBF /IT SHOULD BE AN FSTA + THE FIELD |
| 2039 | TAD I XR /IN WHICH THE CONTROL VARIABLE IS |
| 2040 | DCA BIOPTR /STORED. THE NEXT WORD IS THE ADDRESS |
| 2041 | JMS I [FPGO /OF THE CONTROL VARIABLE IN THAT FIELD |
| 2042 | FADD1 /ADD 1 TO RECORD # AND STORE IN CONTROL VAR |
| 2043 | TAD DUMPIT /*K* "DCA T" SAME AS "CLA" HERE |
| 2044 | JMP UNFIO /NOW GO DO A REGULAR BINARY READ/WRITE |
| 2045 | |
| 2046 | UDOIO, 0 |
| 2047 | ISZ RECCTR /BUMP NUMBER OF RECORDS TRANSFERRED |
| 2048 | TAD BADFLD |
| 2049 | AND [7400 |
| 2050 | TAD [377 /FORM POINTER TO LAST WORD IN BUFFER |
| 2051 | DCA BIOPTR |
| 2052 | TAD RECCTR |
| 2053 | JMS BUFFLD |
| 2054 | DCA I BIOPTR /FOR WRITE, PUT RECORD NUMBER IN 256TH WORD |
| 2055 | UDOIOL, DCA CHRPTR |
| 2056 | AC4000 |
| 2057 | AND RWFLAG |
| 2058 | JMS I [MASSIO /DO I/O (CHRPTR=0 TO FORCE I/O) |
| 2059 | JMS BUFFLD |
| 2060 | TAD RECCTR |
| 2061 | CMA STL /FOR READ, CHECK THE INPUT |
| 2062 | TAD I BIOPTR /SEQUENCE NUMBER TO MAKE SURE IT IS |
| 2063 | CDF 0 /NO LARGER THAN THE ONE WE EXPECT. |
| 2064 | SEQCHK, SZL CLA /*K* IF IT IS LARGER THIS IMPLIES THAT WE |
| 2065 | JMP I UDOIO /ARE STILL IN THE MIDDLE OF THE LAST |
| 2066 | JMP UDOIOL /RECORD AND SO WE READ AGAIN. |
| 2067 | \f/DEFINE FILE PROCESSOR |
| 2068 | |
| 2069 | DFINE, JMS I [RWINIT /SET UP A POINTER INTO THE D.A. TABLE |
| 2070 | 1000 /DIRECT ACCESS I/O IS UNFORMATTED |
| 2071 | JMS I [ARGLD /GET NUMBER OF RECORDS |
| 2072 | JMS I [FFIX |
| 2073 | TAD ACI |
| 2074 | CIA |
| 2075 | DUMPIT, DCA T /SAVE IT FOR MULTIPLY |
| 2076 | JMS I [ARGLD /GET THE NUMBER OF WORDS/RECORD |
| 2077 | JMS I [FPGO /CONVERT WORDS TO BLOCKS |
| 2078 | FWTOBL |
| 2079 | JMS I [FFIX /CONVERT TO INTEGER |
| 2080 | ISZ ACI |
| 2081 | TAD ACI /MULTIPLY THE NUMBER OF BLOCKS/RECORD |
| 2082 | ISZ T /BY THE NUMBER OF RECORDS |
| 2083 | JMP .-2 |
| 2084 | DCA RELBLK /TO GET THE FILE LENGTH IN BLOCKS |
| 2085 | TAD ACI |
| 2086 | CIA |
| 2087 | DCA I XR /STORE NUMBER OF BLOCKS/RECORD |
| 2088 | JMS I [ARGLD /GET POINTER TO CONTROL VARIABLE |
| 2089 | TAD FGPBF |
| 2090 | TAD (FSTA-FLDA /CHANGE A LOAD TO A STORE |
| 2091 | DCA I XR /SAVE "FSTA CONTROL-VARIABLE" |
| 2092 | TAD BIOPTR |
| 2093 | DCA I XR |
| 2094 | TAD TOTBLK |
| 2095 | CMA CLL |
| 2096 | TAD RELBLK /MAKE SURE WE HAVE ROOM FOR THE FILE |
| 2097 | SZLCLA, SZL CLA |
| 2098 | DFERR, JMS I ERR /WE DON'T |
| 2099 | AC7776 |
| 2100 | AND FFLAGS |
| 2101 | IAC /FORCE "END-FILED" BIT FOR CLOSE |
| 2102 | JMP I (SETTOT /SET LENGTH AND EXIT |
| 2103 | PAGE |
| 2104 | \f/SWAPPER AND ERROR ROUTINE |
| 2105 | |
| 2106 | SWAP, JMS I [FETPC /SWAPPER CALLING SEQUENCE: |
| 2107 | DCA T / TRAP3 SWAP |
| 2108 | TAD T / ADDR OVLY*4000000+LVL*100000+ENTRYADR |
| 2109 | AND [7 |
| 2110 | TAD (JA |
| 2111 | DCA STRTUP /STORE JA TO ENTRY POINT |
| 2112 | JMS I [FETPC |
| 2113 | DCA STRTUP+1 |
| 2114 | TAD T |
| 2115 | AND [70 |
| 2116 | CLL RAR /FORM 4*LVL |
| 2117 | TAD (OVLYTB /INDEX INTO LEVEL TABLE |
| 2118 | DCA ADR |
| 2119 | TAD T |
| 2120 | AND [7400 |
| 2121 | DCA T /T CONTAINS OVERLAY NUMBER IN BITS 0-3 |
| 2122 | CDF 0 /WATCH D.F.! |
| 2123 | TAD I ADR |
| 2124 | TAD T /SEE IF THIS OVERLAY IS IN CORE |
| 2125 | SNA CLA |
| 2126 | JMP ITSIN /YES - DON'T LOAD |
| 2127 | TAD T |
| 2128 | CIA |
| 2129 | DCA I ADR /MARK THIS OVERLAY IN CORE (OPTIMIST) |
| 2130 | ISZ ADR |
| 2131 | TAD I ADR |
| 2132 | AND [7400 |
| 2133 | DCA OVADR /SAVE INITIAL OVERLAY LOAD ADDRESS |
| 2134 | TAD I ADR |
| 2135 | AND [70 |
| 2136 | DCA OVIOW /AND FIELD |
| 2137 | ISZ ADR |
| 2138 | TAD I ADR /GET STARTING BLOCK OF THIS LEVEL |
| 2139 | DCA OVBLK |
| 2140 | ISZ ADR |
| 2141 | TAD I ADR |
| 2142 | DCA OVLEN /STORE LENGTH OF OVERLAY IN BLOCKS |
| 2143 | OVADLP, TAD T /LEVEL STARTING BLOCK + |
| 2144 | SNA /(OVERLAY #) * (OVERLAY LENGTH) |
| 2145 | JMP LOADOV /= OVERLAY STARTING BLOCK |
| 2146 | TAD [7400 |
| 2147 | DCA T |
| 2148 | TAD OVBLK |
| 2149 | TAD OVLEN |
| 2150 | DCA OVBLK |
| 2151 | JMP OVADLP |
| 2152 | \f/SWAPPER - CONTINUED |
| 2153 | |
| 2154 | LOADLP, DCA OVLEN /STORE UPDATED OVERLAY LENGTH |
| 2155 | TAD OVIOW /GET LAST READ CONTROL WORD |
| 2156 | RAL |
| 2157 | AND [7400 /CONVERT BLOCK COUNT TO WORD COUNT |
| 2158 | TAD OVADR /INCREMENT OVERLAY LOAD ADDRESS (LINK = 0) |
| 2159 | DCA OVADR |
| 2160 | RTL |
| 2161 | RTL /USE THE CARRY |
| 2162 | TAD OVIOW /TO INCREMENT THE LOAD FIELD IF NECESSARY |
| 2163 | AND [70 |
| 2164 | DCA OVIOW /OVIOW CONTAINS ONLY THE LOAD FIELD NOW |
| 2165 | |
| 2166 | LOADOV, TAD OVADR |
| 2167 | CIA /LOTSA CALCULATIONS HERE - OS/8 HANDLERS |
| 2168 | SNA /CAN'T READ MORE THAN 15 BLOCKS AT A TIME |
| 2169 | TAD [7400 /AND CANNOT READ OVER FIELD BOUNDARIES |
| 2170 | CLL RTL |
| 2171 | RTL /SO WE MUST BREAK UP THE OVERLAY READ |
| 2172 | CMA CML RAL /INTO SEVERAL SMALL READS OF MAXIMAL LENGTH. |
| 2173 | TAD OVLEN /THE NUMBER OF BLOCKS TO READ IS GIVEN BY: |
| 2174 | CMA /MINIMUM(B,L,15) |
| 2175 | SMA /WHERE B IS THE # OF BLOCKS LEFT IN THIS FIELD |
| 2176 | CLA /AND L IS THE # OF BLOCKS LEFT IN THE OVERLAY |
| 2177 | TAD OVLEN /AND 15 IS THE # OF BLOCKS A HANDLER CAN READ |
| 2178 | DCA T / ANSWER IN T |
| 2179 | TAD T |
| 2180 | CLL RTR |
| 2181 | RTR |
| 2182 | RTR /TURN NUMBER OF BLOCKS INTO 0S/8 BLOCK COUNT |
| 2183 | TAD OVIOW |
| 2184 | DCA OVIOW /ADD FIELD BITS AND STORE AS I/O CONTROL WD |
| 2185 | TAD OVHCDW /GET OVERLAY HANDLER CODE WORD |
| 2186 | JMS I (GETHND /LOAD HANDLER INTO FIELD 0 |
| 2187 | JMS I OVHND |
| 2188 | OVIOW, 0 |
| 2189 | OVADR, 0 |
| 2190 | OVBLK, 0 |
| 2191 | OVERR, JMS I ERR /WHOOPS - OVERLAY READ ERROR |
| 2192 | JMS RECOVR /CLEAR ANY NASTY FLAGS LEFT BY HANDLER |
| 2193 | TAD T |
| 2194 | TAD OVBLK |
| 2195 | DCA OVBLK /UPDATE BLOCK NUMBER |
| 2196 | TAD T |
| 2197 | CIA |
| 2198 | TAD OVLEN /BUMP DOWN RECORD COUNT |
| 2199 | SZA /SEE IF WE ARE DONE |
| 2200 | JMP LOADLP /NO - PREPARE FOR NEXT READ |
| 2201 | \f/OVERLAY IN CORE - EXECUTE IT |
| 2202 | |
| 2203 | ITSIN, JMS I [FPGO /START UP FPP |
| 2204 | STRTUP /AND JA TO ENTRY POINT |
| 2205 | |
| 2206 | TRAP5I, |
| 2207 | TRAP6I, |
| 2208 | TRAP7I, |
| 2209 | FPAUSE, |
| 2210 | FPPERR, JMS I ERR /SHOULD NEVER GET HERE |
| 2211 | |
| 2212 | STRTUP, 0;0 /JA ENTRY |
| 2213 | OVLEN, 0 |
| 2214 | OVHND, 0 /SET BY LOADER |
| 2215 | OVHCDW, 0 /SET BY LOADER |
| 2216 | |
| 2217 | RECOVR, 0 /ROUTINE TO CLEAN UP ANY FLAGS |
| 2218 | DCA CTCINH /LEFT ON BY SLOPPY OS/8 HANDLERS. |
| 2219 | YRCOVR, NOP |
| 2220 | NOP |
| 2221 | NOP |
| 2222 | NOP /RIGHT NOW I DON'T KNOW OF ANY. |
| 2223 | NOP |
| 2224 | NOP |
| 2225 | NOP |
| 2226 | NOP |
| 2227 | ION |
| 2228 | JMP I RECOVR |
| 2229 | |
| 2230 | FSTTMP, FSTA+LONG |
| 2231 | FTEMP |
| 2232 | FEXIT |
| 2233 | |
| 2234 | TEN, 4;2400;0;0;0;0 /10.0D0 |
| 2235 | FLTG85, 7;2520;0 /85.0 |
| 2236 | PAGE |
| 2237 | \f/INPUT BUFFER - CONTAINS STARTUP CODE |
| 2238 | |
| 2239 | INBUFR, -206 /LENGTH |
| 2240 | 0 /INPUT LINE BUFFER - FIRST A LITTLE PADDING, |
| 2241 | |
| 2242 | /RTS EXECUTION INITIALIZATION - IN INPUT BUFFER |
| 2243 | |
| 2244 | FPSTRT, 6601 /CLEAR DF32 FLAG |
| 2245 | PCF /HSP FLAG |
| 2246 | RRB /HSR FLAG |
| 2247 | PP7600, 7600 /CLEAR READER CHAR |
| 2248 | 6135 /CLEAR KW12 OR DK8-EP EVENT FLAGS |
| 2249 | CLA |
| 2250 | 6132 /STOP KW12 CLOCKS |
| 2251 | 6134 /DISABLE KW12 INTERRUPTS |
| 2252 | 6530 /CLEAR AD8-EA FLAGS |
| 2253 | 6050 /CLEAR VC8/E FLAG |
| 2254 | 6500 /DISABLE XY8/E INTERRUPTS |
| 2255 | STA |
| 2256 | 6130 /DISABLE DK8-EP INTERRUPTS |
| 2257 | CLA /LEAVE SPACE FOR ADDITIONAL CLEARS |
| 2258 | NOP |
| 2259 | NOP |
| 2260 | NOP |
| 2261 | NOP |
| 2262 | NOP |
| 2263 | NOP |
| 2264 | NOP |
| 2265 | NOP |
| 2266 | NOP |
| 2267 | NOP |
| 2268 | NOP |
| 2269 | DCA EOLSW |
| 2270 | LDPROG, JMS I [FPGO /START UP FPP OR PSEUDO-FPP |
| 2271 | STSWAP |
| 2272 | HLTNOP, NOP /SET TO HLT IF /H SPECIFIED, |
| 2273 | JMP PRTCR /SKP IF /P SPECIFIED |
| 2274 | TAD .-1 |
| 2275 | DCA LDPROG /BYPASS LOADING ON STARTUP |
| 2276 | TAD PCHWD /HLT |
| 2277 | DCA I (PDPXIT+1 |
| 2278 | \f/ROUTINE TO PUNCH RTS+PROGRAM ON FORTRAN UNIT 9 (UNCOMMENTED) |
| 2279 | |
| 2280 | PPTR, TAD P11 |
| 2281 | PCKSUM, DCA ACI |
| 2282 | JMS I (LDDSRN |
| 2283 | SMA CLA |
| 2284 | JMP I [UNTERR |
| 2285 | JMP LDRTLR |
| 2286 | FLDLP, DCA PPTR |
| 2287 | DCA PCKSUM |
| 2288 | TAD (100 |
| 2289 | JMS SIXOUT |
| 2290 | JMS SIXOUT |
| 2291 | TAD FLD |
| 2292 | AND [70 |
| 2293 | JFMOUT, JMS I [FMTOUT /*K* ONLY WORKS FOR FIELD 0-3 |
| 2294 | TAD (100 |
| 2295 | JMS SIXOUT |
| 2296 | JMS SIXOUT |
| 2297 | FLD, CDF 0 |
| 2298 | TAD I PPTR |
| 2299 | CDF 0 |
| 2300 | JMS PCHWD |
| 2301 | ISZ PPTR |
| 2302 | P11, 11 |
| 2303 | ISZ PCTR |
| 2304 | JMP FLD |
| 2305 | TAD PCKSUM |
| 2306 | JMS PCHWD |
| 2307 | TAD FLD |
| 2308 | TAD (10 |
| 2309 | DCA FLD |
| 2310 | LDRTLR, TAD PP7600 |
| 2311 | DCA ACH |
| 2312 | TAD [200 |
| 2313 | JMS SIXOUT |
| 2314 | ISZ ACH |
| 2315 | JMP .-3 |
| 2316 | ISZ FCNT |
| 2317 | JMP FLDLP |
| 2318 | TAD (6000 |
| 2319 | DCA FFLAGS |
| 2320 | DCA I (ENDFLS /*K* SAME KLUDGE AS CALXIT |
| 2321 | JMS I (ENDFL |
| 2322 | DCA I (PDPXIT+1 /WIPE HALT SO WE CAN RETURN TO OS/8 |
| 2323 | JMP I (PDPXIT-1 |
| 2324 | \fPCHWD, HLT |
| 2325 | DCA ACH |
| 2326 | TAD ACH |
| 2327 | RTR |
| 2328 | RTR |
| 2329 | RTR |
| 2330 | AND [77 |
| 2331 | JMS SIXOUT |
| 2332 | TAD ACH |
| 2333 | AND [77 |
| 2334 | JMS SIXOUT |
| 2335 | JMP I PCHWD |
| 2336 | |
| 2337 | SIXOUT, 0 |
| 2338 | DCA T |
| 2339 | CLA IAC |
| 2340 | DCA EOLSW |
| 2341 | TAD PCKSUM |
| 2342 | TAD T |
| 2343 | DCA PCKSUM |
| 2344 | TAD T |
| 2345 | TAD (-300 |
| 2346 | JMS I [FMTOUT |
| 2347 | JMP I SIXOUT |
| 2348 | |
| 2349 | PCTR, 200 /DON'T PUNCH 07600! |
| 2350 | FCNT, 0 |
| 2351 | \fPRTCR, TAD (215 |
| 2352 | JMS I PTTY /PRINT CARRIAGE RETURN |
| 2353 | TAD JFMOUT |
| 2354 | DCA I (ERRENB /ENABLE ERROR TRACEBACK |
| 2355 | JMS I [FPGO |
| 2356 | STJUMP /NOW JUMP TO THE NEWLY-LOADED CODE |
| 2357 | STSWAP, TRAP3 /TRAP3 |
| 2358 | SWAP |
| 2359 | 0 |
| 2360 | .+1 |
| 2361 | TRAP3 |
| 2362 | HLTNOP |
| 2363 | PAGE |
| 2364 | STJUMP, 0 |
| 2365 | 0 |
| 2366 | ZBLOCK INBUFR+210-. /PAD OUT TO END OF BUFFER |
| 2367 | \f/OVERLAY AND DSRN TABLES |
| 2368 | |
| 2369 | *.-4 /FIRST ENTRY IN OVLYTB ONLY NEEDED TO LOAD MAIN PGM |
| 2370 | |
| 2371 | OVLYTB, ZBLOCK 40 /OVERLAY TABLE |
| 2372 | |
| 2373 | DSRN, PTR; ZBLOCK 10 |
| 2374 | PTP; ZBLOCK 10 |
| 2375 | LPT; ZBLOCK 10 |
| 2376 | TTY; 0;0 |
| 2377 | 1234 /*K* PREVENT PROBLEM IN |
| 2378 | ZBLOCK 5 /RWINIT INVOLVING WRITE |
| 2379 | /AFTER READ ON TELETYPE |
| 2380 | ZBLOCK 55 |
| 2381 | |
| 2382 | ZBLOCK 12 /FORMAT PARENTHESIS PUSHDOWN LIST |
| 2383 | FMTPDL, 0 /GUARD WORD |
| 2384 | PAGE |
| 2385 | \f/SOFTWARE FLOATING POINT ROUTINES WHICH ARE USED |
| 2386 | /EVEN IF FLOATING HARDWARE IS PRESENT |
| 2387 | |
| 2388 | /** MUST NOT DESTROY FAC! ** |
| 2389 | |
| 2390 | FFIX, 0 /ROUTINE TO FIX FAC |
| 2391 | STA /ANSWER IS RETURNED IN ACI |
| 2392 | TADACX, TAD ACX /ABS(FAC) MUST BE LESS THAN 2048 |
| 2393 | CLL /DETERMINE IF FAC EXPONENT IS |
| 2394 | TAD (-13 /BETWEEN 1 AND 14 |
| 2395 | SNA |
| 2396 | JMP FIXBIG /14 IS A SPECIAL CASE |
| 2397 | EAEFIX, DCA ACI |
| 2398 | SZL |
| 2399 | JMP FIXDNE /EXP GT 14 OR LT 1 - RETURN 0 |
| 2400 | TAD ACH |
| 2401 | JMP FIXISZ |
| 2402 | FIXLP, CLL /0 IN LINK |
| 2403 | SPA /IS IT LESS THAN 0? |
| 2404 | CML /YES-PUT A 1 IN LINK |
| 2405 | RAR /SCALE RIGHT |
| 2406 | FIXISZ, ISZ ACI /DONE YET? |
| 2407 | JMP FIXLP /NO |
| 2408 | FIXDNE, DCA ACI /RETURN WITH ANSWER IN ACI |
| 2409 | JMP I FFIX /RETURN |
| 2410 | |
| 2411 | FIXBIG, TAD ACL /IF EXP IS 14 WE MUST SHIFT AC FRACTION |
| 2412 | RAL /LEFT ONE PLACE TO INTEGERIZE IT. |
| 2413 | CLA |
| 2414 | TAD ACH |
| 2415 | RAL |
| 2416 | JMP FIXDNE /STORE ANSWER AND RETURN |
| 2417 | |
| 2418 | SETB, TAD DATAF |
| 2419 | DCA I (BASCDF /SET BASE PAGE LOCATION |
| 2420 | TAD ADR |
| 2421 | DCA BASADR |
| 2422 | JMP I FPNXT |
| 2423 | \f/ |
| 2424 | /SHIFT FAC LEFT 1 BIT |
| 2425 | / |
| 2426 | AL1, 0 |
| 2427 | TAD AC1 /GET OVERFLOW BIT |
| 2428 | CLL RAL /SHIFT LEFT |
| 2429 | DCA AC1 /STORE BACK |
| 2430 | TAD ACL /GET LOW ORDER MANTISSA |
| 2431 | RAL /SHIFT LEFT |
| 2432 | DCA ACL /STORE BACK |
| 2433 | TAD ACH /GET HI ORDER |
| 2434 | RAL |
| 2435 | DCA ACH /STORE BACK |
| 2436 | JMP I AL1 /RETN. |
| 2437 | / |
| 2438 | /SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE) |
| 2439 | / |
| 2440 | ACSR, 0 |
| 2441 | CMA /AC CONTAINS COUNT-1 |
| 2442 | DCA AC0 /STORE COUNT |
| 2443 | LOP1, TAD ACH /GET HIGH ORDER MANTISSA |
| 2444 | CLL |
| 2445 | SPA /PROPAGATE SIGN |
| 2446 | CML |
| 2447 | RAR /SHIFT RIGHT 1, PROPAGATING SIGN |
| 2448 | DCA ACH /STORE BACK |
| 2449 | TAD ACL /GET LOW ORDER |
| 2450 | RAR /SHIFT IT |
| 2451 | DCA ACL /STORE BACK |
| 2452 | ISZ ACX /INCREMENT EXPONENT |
| 2453 | NOP |
| 2454 | ISZ AC0 /DONE? |
| 2455 | JMP LOP1 /NO-LOOP |
| 2456 | RAR |
| 2457 | DCA AC1 /SAVE 1 BIT OF OVERFLOW |
| 2458 | JMP I ACSR /YES-RETN-AC=L=0 |
| 2459 | / |
| 2460 | /FLOATING NEGATE |
| 2461 | / |
| 2462 | FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE) |
| 2463 | TAD ACL /GET LOW ORDER FAC |
| 2464 | CLL CMA IAC /NEGATE IT |
| 2465 | DCA ACL /STORE BACK |
| 2466 | CML RAL /ADJUST OVERFLOW BIT AND |
| 2467 | TAD ACH /PROPAGATE CARRY-GET HI ORD |
| 2468 | CLL CMA IAC /NEGATE IT |
| 2469 | DCA ACH /STORE BACK |
| 2470 | JMP I FFNEG |
| 2471 | \fOADD, 0 /ADD OPERAND TO FAC |
| 2472 | CLL |
| 2473 | TAD AC2 /ADD OVERFLOW WORDS |
| 2474 | TAD AC1 |
| 2475 | DCA AC1 |
| 2476 | RAL /ROTATE CARRY |
| 2477 | TAD OPL /ADD LOW ORDER MANTISSAS |
| 2478 | TAD ACL |
| 2479 | DCA ACL |
| 2480 | RAL |
| 2481 | TAD OPH /ADD HI ORDER MANTISSAS |
| 2482 | TAD ACH |
| 2483 | DCA ACH |
| 2484 | JMP I OADD /RETN. |
| 2485 | |
| 2486 | FETPC, 0 |
| 2487 | ISZ PC |
| 2488 | JMP PCCDF /NO FIELD BUMP |
| 2489 | ISZ APT /BUMP FIELD FOR FPP RESTART (IN CASE FPP EXISTS) |
| 2490 | FPC10, 10 /PROTECTION FOR ISZ |
| 2491 | TAD PCCDF |
| 2492 | TAD FPC10 |
| 2493 | DCA PCCDF |
| 2494 | PCCDF, HLT |
| 2495 | TAD I PC |
| 2496 | JMP I FETPC |
| 2497 | |
| 2498 | EEPUT, STL /EXTENDED PRECISION STORE |
| 2499 | EEGET, DCA ADR /EXTENDED PRCISION FETCH |
| 2500 | TAD [-6 |
| 2501 | DCA DATCDF |
| 2502 | SNL |
| 2503 | AC2000 /SET UP "TAD ACX" OR "DCA ACX" |
| 2504 | TAD TADACX |
| 2505 | DCA EEINST |
| 2506 | EELOOP, SNL /LINK=1 MEANS STORE |
| 2507 | TAD I ADR |
| 2508 | EEINST, HLT |
| 2509 | SZL |
| 2510 | DCA I ADR |
| 2511 | ISZ ADR |
| 2512 | SKP |
| 2513 | JMS I (DFBUMP |
| 2514 | ISZ EEINST |
| 2515 | ISZ DATCDF |
| 2516 | JMP EELOOP |
| 2517 | JMP I FPNXT |
| 2518 | |
| 2519 | FSTTM2, FSTA+LONG |
| 2520 | FTEMP2 |
| 2521 | FEXIT |
| 2522 | / |
| 2523 | FTEMP, ZBLOCK 6 |
| 2524 | / |
| 2525 | PAGE |
| 2526 | \f/RUN-TIME SYSTEM ERROR LIST |
| 2527 | |
| 2528 | ERRLST, VARGER; ARGMSG |
| 2529 | UERR; UMSG |
| 2530 | FPOERR; FPOMSG |
| 2531 | FMTERR; FMTMSG |
| 2532 | UNTERR; UNTMSG |
| 2533 | CTLBER; CTLBMS |
| 2534 | INER; INMSG |
| 2535 | IOVFLO; IOVMSG |
| 2536 | IOERR; IOMSG |
| 2537 | DAERR; DAMSG |
| 2538 | FPPERR; FPPMSG |
| 2539 | OVERR; OVMSG |
| 2540 | EOFERR; INEMSG |
| 2541 | FPOVER; OFLMSG |
| 2542 | DFERR; DFMSG |
| 2543 | -1; DV0MSG /BY ELIMINATION |
| 2544 | \f/RTS ERROR MESSAGES |
| 2545 | |
| 2546 | ARGMSG, TEXT /BAD ARG/ |
| 2547 | UMSG, TEXT /USER ERROR/ |
| 2548 | FPOMSG, TEXT /PARENS TOO DEEP/ |
| 2549 | FMTMSG, TEXT /FORMAT ERROR/ |
| 2550 | UNTMSG, TEXT /UNIT ERROR/ |
| 2551 | INMSG, TEXT /INPUT ERROR/ |
| 2552 | OVMSG, TEXT /OVERLAY / |
| 2553 | *.-1 |
| 2554 | IOMSG, TEXT %I/O ERROR% |
| 2555 | DAMSG, TEXT /NO DEFINE FILE/ |
| 2556 | FPPMSG, TEXT /FPP ERROR/ |
| 2557 | INEMSG, TEXT /EOF ERROR/ |
| 2558 | DV0MSG, TEXT /DIVIDE BY 0/ |
| 2559 | DFMSG, TEXT /D.F. TOO BIG/ |
| 2560 | IOVMSG, TEXT /FILE / |
| 2561 | *.-1 |
| 2562 | OFLMSG, TEXT /OVERFLOW/ |
| 2563 | CTLBMS, TEXT /^B/ |
| 2564 | |
| 2565 | USRERR, TAD ERRFLG /USER ERROR - OPTIONALLY NON-FATAL |
| 2566 | DCA FATAL |
| 2567 | UERR, JMS I ERR /PRINT MESSAGE |
| 2568 | JMP I [RETURN /IF NON-FATAL, CONTINUE PROCESSING |
| 2569 | ERRFLG, 0 /SET TO NON-ZERO IF /E SWITCH SPECIFIED |
| 2570 | |
| 2571 | TRPPRT, TRAP3 /CODE WHICH IS LOADED INTO PROGRAM PROLOGUES |
| 2572 | PRTNAM /BY THE ERROR TRACEBACK ROUTINE |
| 2573 | PAGE |
| 2574 | \fMAKCDF, 0 /ROUTINE TO MAKE A CDF FROM AC9-11 |
| 2575 | RTL |
| 2576 | RAL |
| 2577 | AND [70 |
| 2578 | TAD ERCDF /STRAIGHTFORWARD ENOUGH, ISN'T IT? |
| 2579 | JMP I MAKCDF |
| 2580 | |
| 2581 | RD2WR, 0 /ROUTINE CALLED WHEN SWITCHING |
| 2582 | STA /FROM READ TO WRITE. (CALLED ONLY ONCE!) |
| 2583 | TAD RELBLK /BUMP BLOCK # BACK FROM "NEXT BUFFER'S BLOCK #" |
| 2584 | DCA RELBLK /TO "THIS BUFFER'S BLOCK #". |
| 2585 | TAD CHRCTR /HOWEVER, IF WE ARE AT THE VERY END OF A |
| 2586 | IAC /BUFFER, WRITE ROUTINE EXPECTS US TO |
| 2587 | SZA CLA /BE AT THE BEGINNING OF THE NEXT BUFFER, |
| 2588 | JMS I [MASSIO /SO RE-READ THIS BUFFER AND SET POINTERS |
| 2589 | JMP I RD2WR |
| 2590 | |
| 2591 | /RUN-TIME-SYSTEM ERROR ROUTINE |
| 2592 | |
| 2593 | ERROR, 0 |
| 2594 | ERCDF, CDF 0 |
| 2595 | CLA |
| 2596 | TAD (ERRLST-2 |
| 2597 | DCA XR |
| 2598 | ERRLP, ISZ XR /SEARCH ERROR LIST FOR CALLING ADDRESS |
| 2599 | TAD I XR /ERROR LIST CONTAINS |
| 2600 | CMA |
| 2601 | SZA /CALLING ADDRESSES AND |
| 2602 | TAD ERROR /CORRESPONDING MESSAGES |
| 2603 | SZA CLA |
| 2604 | JMP ERRLP |
| 2605 | TAD I XR |
| 2606 | DCA I (FMTADR |
| 2607 | DCA I (FMTDF |
| 2608 | TAD PTTY |
| 2609 | DCA HAND /QUICK FUDGE FOR TTY OUTPUT |
| 2610 | DCA HCODEW /TO SET CARRIAGE CONTROL |
| 2611 | AC4000 |
| 2612 | DCA RWFLAG |
| 2613 | JMS I [EOLINE /TYPE CARRET AND SET EOLSW |
| 2614 | DCA FMTBYT /INITIALIZE MESSAGE PTR |
| 2615 | ERPTLP, JMS I [FMTOUT /OUTPUTS LF FIRST TIME |
| 2616 | JMS I [FMTGCH /GET CHAR USING FORMAT ROUTINES |
| 2617 | ISZ FMTBYT |
| 2618 | SZA |
| 2619 | JMP ERPTLP /LOOP UNTIL 0 CHAR |
| 2620 | \f/PRINT ROUTINE NAME AND LINE NUMBER |
| 2621 | |
| 2622 | PRTNAM, TAD [40 |
| 2623 | ERRENB, JMP I E7605 /*K* IN CASE INITIALIZATION OR /P GET ERRORS |
| 2624 | / PREVIOUS LINE REPLACED WITH: |
| 2625 | / JMS I [FMTOUT /OUTPUT A BLANK(LF ON EXTRA LINES) |
| 2626 | JMS I [FPGO /START UP FPP |
| 2627 | GTNMPT /GET POINTER TO NAME IN FAC |
| 2628 | TAD ACH |
| 2629 | DCA I (FMTDF /SET UP FORMAT GET CHARACTER ROUTINE |
| 2630 | TAD ACL /TO GET CHARACTERS OF ROUTINE NAME |
| 2631 | DCA I (FMTADR |
| 2632 | DCA FMTBYT |
| 2633 | TAD [-6 |
| 2634 | DCA ISN /6 CHARACTER NAME |
| 2635 | PRTNML, JMS I [FMTGCH |
| 2636 | SNA |
| 2637 | TAD [40 /AVOID PRINTING RANDOM @S |
| 2638 | JMS I [FMTOUT /GET AND PRINT A CHARACTER |
| 2639 | ISZ FMTBYT |
| 2640 | ISZ ISN |
| 2641 | JMP PRTNML |
| 2642 | TAD [40 |
| 2643 | JMS I [FMTOUT /SEPARATE THE NAME BY A SPACE |
| 2644 | TAD [-4 /FROM THE LINE NUMBER. |
| 2645 | DCA ISN |
| 2646 | PTLNLP, TAD ISN+1 |
| 2647 | CLL RTL |
| 2648 | RAL |
| 2649 | DCA ISN+1 /PRINT LINE NUMBER IN OCTAL |
| 2650 | TAD ISN+1 /BECAUSE THAT IS THE WAY IT APPEARS |
| 2651 | RAL /IN THE FORTRAN PROGRAM LISTING |
| 2652 | AND [7 |
| 2653 | JMS I (DIGIT |
| 2654 | ISZ ISN |
| 2655 | JMP PTLNLP |
| 2656 | |
| 2657 | JMS I [EOLINE /OUTPUT FINAL CR |
| 2658 | TAD FATAL |
| 2659 | SNA CLA /FATAL ERROR? |
| 2660 | JMP TRCBAK /YES - GIVE FULL TRACEBACK |
| 2661 | DCA FATAL /"NON-FATAL" FLAG MUST BE SET EACH TIME |
| 2662 | JMP I ERROR |
| 2663 | TRCBAK, JMS I [FPGO /START UP FPP |
| 2664 | UP1LEV /MOVE UP TO CALLING ROUTINE |
| 2665 | /FPP CODE DOES A "TRAP3 PRTNAM" |
| 2666 | ISN, 0;0 |
| 2667 | \f/FPP CODE FOR ERROR ROUTINE |
| 2668 | |
| 2669 | GTNMPT, STARTD |
| 2670 | XTA 0 /LOAD LINE NUMBER FROM XR 0 |
| 2671 | FSTA+LONG |
| 2672 | ISN /STORE AWAY |
| 2673 | FLDA+BASE 10 /LOAD POINTER TO PROLOGUE |
| 2674 | FSUB+LONG |
| 2675 | THREE /NAME IS 3 LOCATIONS BEFORE PROLOGUE |
| 2676 | STARTF /FOR NON-FPP VERSION |
| 2677 | THREE, FEXIT;3 /*K* DEPENDS ON FACT THAT FEXIT=0 |
| 2678 | |
| 2679 | UP1LEV, STARTD |
| 2680 | FLDA+BASE 11 /GET THE UPWARD POINTER |
| 2681 | JNE |
| 2682 | NOTMN /ZERO MEANS MAIN PROGRAM |
| 2683 | TRAP3 |
| 2684 | E7605, 7605 /GO AWAY IF MAIN PROGRAM |
| 2685 | NOTMN, FSTA+BASE 0 |
| 2686 | LDX 1 |
| 2687 | 2 /WE WILL STORE A "TRAP3 PRTNAM" |
| 2688 | FLDA+LONG /IN THE FIFTH LOCATION OF THE PROLOGUE, |
| 2689 | TRPPRT |
| 2690 | FSTA+IND 0+10 /WHERE THE FIRST 4 LOCS WERE A SETX AND SETB. |
| 2691 | FLDA+BASE 0 /GET THE PROLOGUE ADDRESS AGAIN |
| 2692 | JAC /JUMP TO IT. |
| 2693 | |
| 2694 | ACMDGT, FMUL+LONG |
| 2695 | TEN |
| 2696 | FSTA+LONG |
| 2697 | FTEMP |
| 2698 | FLDA+LONG |
| 2699 | DGT /GET UNNORMALIZED DIGIT INTO AC |
| 2700 | FNORM /NORMALIZE IT |
| 2701 | FADTMP, FADD+LONG |
| 2702 | FTEMP |
| 2703 | FEXIT |
| 2704 | LPBUFR, ZBLOCK 4 |
| 2705 | LPBUF2 |
| 2706 | PAGE |
| 2707 | \fHPLACE, /ZBLOCK 400 /HANDLER SWAP AREA |
| 2708 | |
| 2709 | /VARIOUS INITIALIZATION STUFF OVERLAYING THE RTS HANDLER AREA |
| 2710 | |
| 2711 | QLHDR, 0 /SHOULD BE A 2 FOR A LOADER IMAGE |
| 2712 | QRTSWP, ZBLOCK 2 /INITIAL SWAP ARGS TO LOAD USER MAIN |
| 2713 | QHGHAD, ZBLOCK 2 /HIGHEST ADDRESS USED |
| 2714 | QVERNO, 0 /LOADER VERSION # |
| 2715 | QDPFLG, 0 /"PROGRAM USES D.P." FLAG |
| 2716 | QUSRLV, ZBLOCK 40 /USER OVERLAY INFO |
| 2717 | |
| 2718 | /EAE OVERLAY TO FIX AND FLOAT |
| 2719 | |
| 2720 | EFXFLT, RELOC EAEFIX |
| 2721 | |
| 2722 | FIXEAE, CMA |
| 2723 | DCA FIXSH /SHIFT COUNT BETWEEN 0 AND 12 |
| 2724 | SZL |
| 2725 | JMP FIX0 /NOT INTEGERIZABLE |
| 2726 | TAD ACH |
| 2727 | ASR |
| 2728 | FIXSH, 0 |
| 2729 | FIX0, DCA ACI |
| 2730 | JMP I FFIX |
| 2731 | |
| 2732 | FXFLTC= .-FIXEAE |
| 2733 | RELOC |
| 2734 | \f/SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF |
| 2735 | /BANKS IN AC. |
| 2736 | /MUST RUN IN FIELD 0. |
| 2737 | |
| 2738 | CORE, 0 |
| 2739 | TAD C6203 |
| 2740 | RDF |
| 2741 | DCA CORRET |
| 2742 | CORELP, CDF 0 /NEEDED FOR PDP-8L |
| 2743 | TAD I C7777 |
| 2744 | AND COR70 /IF BITS 6-8 OF LOCATION 7777 ARE NOT ZERO, |
| 2745 | CLL RTR /THEY SPECIFY THE LAST FIELD OF CORE |
| 2746 | RAR /WHICH WE SHOULD USE. |
| 2747 | SZA |
| 2748 | JMP CORRET /SO RETURN THAT AMOUNT |
| 2749 | TAD TRYFLD /GET FLD TO TST |
| 2750 | CLL RTL |
| 2751 | RAL |
| 2752 | AND COR70 /MASK USEFUL BITS |
| 2753 | TAD CORELP |
| 2754 | DCA COR706 /SET UP CDF TO FLD |
| 2755 | COR706, 0 |
| 2756 | TAD I CORLOC /SAV CURRENT CONTENTS |
| 2757 | NOP /HACK FOR PDP-8 |
| 2758 | DCA .-3 |
| 2759 | TAD .-2 /7000 IS A GOOD PATTERN |
| 2760 | DCA I CORLOC |
| 2761 | COR70, 70 /HACK FOR PDP-8.,NO-OP |
| 2762 | TAD I CORLOC /TRY TO READ BK 7000 |
| 2763 | CO7400, 7400 /HACK FOR PDP-8,.NO-OP |
| 2764 | TAD CO7400 /GUARD AGAINST WRAP AROUND |
| 2765 | TAD CORLOC+1 /TAD 1400 |
| 2766 | SZA CLA |
| 2767 | JMP .+5 /NON EXISTENT FLD EXIT |
| 2768 | TAD COR706 /RESTORE CONTENS DESTROYED |
| 2769 | DCA I CORLOC |
| 2770 | ISZ TRYFLD /TRY NXT HIGHER FLD |
| 2771 | JMP CORELP |
| 2772 | STA |
| 2773 | TAD TRYFLD |
| 2774 | CORRET, 0 |
| 2775 | JMP I CORE |
| 2776 | CORLOC, CO7400 /ADR TO TST IN EACH FLD |
| 2777 | 1400 /7000+7400+1400=0 |
| 2778 | TRYFLD, 1 /CURRENT FLD TO TST |
| 2779 | C6203, 6203 |
| 2780 | C7777, 7777 |
| 2781 | |
| 2782 | DPTEST, STARTE /EXECUTED BY FPP DURING INITIALIZATION |
| 2783 | FEXIT /CHECK WHETHER DOUBLE PRECISION ENABLED |
| 2784 | \f/TABLE OF MODIFICATIONS TO MAKE TO FRTS FOR BACKGROUND OPERATION |
| 2785 | /UNDER RTS-8. FORMAT OF TABLE IS: POINTER TO FIRST WORD OF BLOCK - 1 |
| 2786 | / (0 TERMINATES) FOLLOWED BY LIST OF REPLACEMENT WORDS (0 TERMINATES). |
| 2787 | |
| 2788 | BKRLST, YLPT-1 /LINE PRINTER OUTPUT ROUTINE |
| 2789 | RELOC YLPT |
| 2790 | LLS |
| 2791 | CLA /DON'T DO RING-BUFFERING - JUST "OUTPUT" CHAR. |
| 2792 | JMS CTCBCK /CHECK FOR ^C OR ^B |
| 2793 | JMP I LPT |
| 2794 | FJCTCT, JMS CTCBCK /COME HERE FROM INTERPRETED FPP JUMPS |
| 2795 | JMP I FPNXT /CHECK FOR ^C,^B AND RETURN TO INTERPRETER |
| 2796 | RELOC |
| 2797 | 0 |
| 2798 | |
| 2799 | YPTP-1 /PAPER-TAPE PUNCH ROUTINE |
| 2800 | CLA /ALL PAPER-TAPE I/O ILLEGAL |
| 2801 | 0 |
| 2802 | YPTR-1 /PAPER TAPE READER ROUTINE |
| 2803 | CLA /ALL PAPER-TAPE I/O ILLEGAL |
| 2804 | 0 |
| 2805 | |
| 2806 | YTTY-1 /TELETYPE INPUT/OUTPUT ROUTINE |
| 2807 | RELOC YTTY |
| 2808 | SNA |
| 2809 | JMP KBDRTS /AC=0 MEANS INPUT |
| 2810 | TSF |
| 2811 | JMP .-1 /HANG UNTIL OUTPUT BUFFER NOT FULL |
| 2812 | TLS |
| 2813 | CLA |
| 2814 | JMS CTCBCK /CHECK FOR ^C OR ^B TYPED |
| 2815 | JMP I TTY |
| 2816 | KBDRTS, KSF |
| 2817 | JMP .-1 /HANG UNTIL CHAR RECEIVED |
| 2818 | JMS CTCBCK /CHECK FOR ^C OR ^B |
| 2819 | KRB |
| 2820 | AND KB177 /STRIP PARITY |
| 2821 | TAD KB177 |
| 2822 | IAC /NOW FORCE PARITY BIT ON (177+1=200) |
| 2823 | JMP I TTY |
| 2824 | |
| 2825 | CTCBCK, . /*K* CAN'T BE 0! |
| 2826 | KRS /PEEK AT NEXT CHAR IN BUFFER |
| 2827 | AND KB177 |
| 2828 | TAD KBM2 |
| 2829 | CLL RAR |
| 2830 | SNA CLA /IS IT ^C OR ^B? |
| 2831 | KSF /AND IS IT REALLY PENDING? |
| 2832 | JMP I CTCBCK /NO - JUST RETURN WITH AC=0 |
| 2833 | JMP BEEORC /TERMINATE JOB - LINK HAS ^C/^B FLAG |
| 2834 | KB177, 177 |
| 2835 | KBM2, -2 |
| 2836 | RELOC |
| 2837 | 0 |
| 2838 | \f/CONTINUATION OF TABLE OF RTS-8 OVERLAYS TO FRTS |
| 2839 | |
| 2840 | YHIOF-1 /"GET OS/8 HANDLER" ROUTINE |
| 2841 | NOP /ELIMINATE "IOF" INSTRUCTION |
| 2842 | 0 |
| 2843 | |
| 2844 | YRCOVR-1 /"RECOVER FROM OS/8 HANDLER" ROUTINE |
| 2845 | RELOC YRCOVR |
| 2846 | JMP I RECOVR /SHORT-CIRCUIT PORTION OF ROUTINE WHICH DOES |
| 2847 | RELOC /AN "ION" |
| 2848 | 0 |
| 2849 | |
| 2850 | YFJMP-1 /FPP INTERPRETER - SUCCESSFUL JUMP SECTION |
| 2851 | FJCTCT /TEST FOR ^C OR ^B TYPED BEFORE |
| 2852 | 0 /RETURNING TO THE INTERPRETER |
| 2853 | |
| 2854 | 0 /** LIST TERMINATOR ** |
| 2855 | \f/ERROR MESSAGES FOR RUN-TIME LOADER - IN HANDLER BUFFER |
| 2856 | /*K* CANNOT LOAD BELOW HPLACE+200 AS HPLACE-HPLACE+177 ARE DESTROYED BY HEADER! |
| 2857 | |
| 2858 | IFNZRO .-HPLACE-200&4000 <__ERROR__> |
| 2859 | |
| 2860 | NOLI, TEXT /NOT A LOADER IMAGE/ |
| 2861 | NONMSG, TEXT /NO NUMERIC SWITCH/ |
| 2862 | FILMSG, TEXT /FILE ERROR/ |
| 2863 | SYSMSG, TEXT /SYSTEM DEVICE ERROR/ |
| 2864 | TOOMCH, TEXT /MORE CORE REQUIRED/ |
| 2865 | TOMNYH, TEXT /TOO MANY HANDLERS/ |
| 2866 | LIOEMS, TEXT /CAN'T READ IT!/ |
| 2867 | NODPMS, TEXT /CAUTION - NO DP/ |
| 2868 | XVERMS, TEXT /FRTS V/ |
| 2869 | *.-1 |
| 2870 | XVERSN&70^7+XVERSN+4060 /VERSION NUMBER IN SIXBIT |
| 2871 | XPATCH&77^100+40 /PATCH LEVEL |
| 2872 | TEXT / / |
| 2873 | PAGE |
| 2874 | \f/FPP INTERPRETER STARTUP ROUTINE |
| 2875 | |
| 2876 | FPPINT= . /FOR FPP OVERLAY |
| 2877 | RETURN, JMP I FPNXT /RETURN DOES SOMETHING DIFFERENT IF FPP PRESENT |
| 2878 | |
| 2879 | FPGO, 0 |
| 2880 | FPGCDF, CDF 0 /NECESSARY? |
| 2881 | CLA |
| 2882 | TAD PC |
| 2883 | DCA SAVPC /ALLOW ONE LEVEL OF RECURSIVENESS |
| 2884 | TAD I (PCCDF |
| 2885 | DCA SPCCDF |
| 2886 | STA |
| 2887 | TAD I FPGO |
| 2888 | DCA PC |
| 2889 | ISZ FPGO |
| 2890 | TAD FPGCDF /FPGO STARTS UP THE FPP FROM FIELD 0 ONLY |
| 2891 | DCA I (PCCDF |
| 2892 | JMP I FPNXT |
| 2893 | |
| 2894 | EXIT, TAD SAVPC |
| 2895 | DCA PC |
| 2896 | TAD SPCCDF |
| 2897 | DCA I (PCCDF /RESTORE OLD PC |
| 2898 | JMP I FPGO /RETURN TO PDP-8 CODE |
| 2899 | SAVPC, 0 |
| 2900 | SPCCDF, 0 |
| 2901 | |
| 2902 | FPXTA, TAD [27 /XR TO AC - NORMALIZE IF FLOATING MODE |
| 2903 | DCA ACX |
| 2904 | JMS DATCDF |
| 2905 | TAD I ADR |
| 2906 | CLFAC, DCA ACL |
| 2907 | TAD ACL |
| 2908 | SPA CLA /SIGN-EXTEND 12-BIT WORD |
| 2909 | STA /INTO FAC FRACTION |
| 2910 | DCA ACH |
| 2911 | NRMFAC, DCA AC1 /CLEAR OVERFLOW WORD |
| 2912 | TAD DFLG |
| 2913 | SPA SNA CLA /UNLESS WE ARE IN D.P.I. MODE, |
| 2914 | JMS I NORMX /NORMALIZE THE FAC |
| 2915 | JMP I FPNXT |
| 2916 | \f/MISCELLANEOUS JUMP CLASS INSTRUCTIONS |
| 2917 | |
| 2918 | JSA, TAD ADR |
| 2919 | DCA PUTM |
| 2920 | TAD DATAF |
| 2921 | DCA JSCDF /SET UP LOC TO SAVE PC IN |
| 2922 | AC0002 |
| 2923 | TAD ADR |
| 2924 | DCA ADR /BUMP ADDRESS BY 2 |
| 2925 | RTL |
| 2926 | RTL |
| 2927 | TAD DATAF |
| 2928 | DCA DATAF /INCLUDING DATA FIELD |
| 2929 | JSAR, TAD I (PCCDF /JSA/JSR COMMON CODE |
| 2930 | CLL RTR |
| 2931 | RAR |
| 2932 | ISZ PC /BUMP PC BEFORE STORING |
| 2933 | SKP |
| 2934 | IAC /INCLUDING FIELD BITS |
| 2935 | TAD (JA-2620 /FORM "JA" INSTRUCTION |
| 2936 | JSCDF, HLT |
| 2937 | DCA I PUTM |
| 2938 | ISZ PUTM |
| 2939 | SKP |
| 2940 | JMS I (DFBUMP /BUMP TARGET ADDRESS |
| 2941 | TAD PC |
| 2942 | DCA I PUTM |
| 2943 | JMP I (DOJMP /NOW JUMP TO DESTINATION |
| 2944 | |
| 2945 | JSR, CLA CLL IAC |
| 2946 | TAD BASADR |
| 2947 | DCA PUTM |
| 2948 | RTL |
| 2949 | RTL |
| 2950 | TAD I (BASCDF /SET JSCDF&PUTM TO BASE PAGE LOC +1 |
| 2951 | DCA JSCDF |
| 2952 | JMP JSAR |
| 2953 | |
| 2954 | FPJAC, TAD ACL |
| 2955 | DCA ADR |
| 2956 | TAD ACH |
| 2957 | JMS I MCDF |
| 2958 | DCA DATAF |
| 2959 | JMP I (DOJMP |
| 2960 | |
| 2961 | SPCATX, TAD ACL |
| 2962 | SKP |
| 2963 | FPLDX, JMS I [FETPC |
| 2964 | JMS DATCDF |
| 2965 | DCA I ADR /SET XR TO NEXT INST WD |
| 2966 | JMP I FPNXT |
| 2967 | \f/MORE INDEX REGISTER & AC-TO-MEMORY INSTRUCTIONS |
| 2968 | |
| 2969 | ADDX, JMS I [FETPC |
| 2970 | JMS DATCDF |
| 2971 | TAD I ADR /ADD NEXT INST WD TO XR |
| 2972 | JMP FPLDX+1 |
| 2973 | |
| 2974 | ATX, TAD DFLG /ATX WORKS DIFFERENTLY IN D.P.I. MODE |
| 2975 | SMA SZA CLA |
| 2976 | JMP SPCATX |
| 2977 | JMS I NORMX /FAC MAY NOT BE NORMALIZED |
| 2978 | JMS I [FFIX |
| 2979 | TAD ACI |
| 2980 | JMP FPLDX+1 |
| 2981 | |
| 2982 | OPMEM, DCA AD1 /GENERAL AC-TO-MEMORY INTERPRETER |
| 2983 | TAD AD1 |
| 2984 | DCA AD2 |
| 2985 | RDF |
| 2986 | CLL RTR |
| 2987 | RAR |
| 2988 | TAD KLUDGM /FORM FSTA X INSTRUCTION |
| 2989 | DCA PUTM |
| 2990 | AC2000 |
| 2991 | AND INST /TURN OP 5 TO OP 1, |
| 2992 | SZA CLA |
| 2993 | TAD [3000 / OP 7 TO OP 4. |
| 2994 | TAD [3000 |
| 2995 | TAD PUTM /STICK IN FIELD BITS |
| 2996 | DCA OPM |
| 2997 | JMS I [FPGO |
| 2998 | KLUDGM |
| 2999 | JMP I FPNXT |
| 3000 | |
| 3001 | KLUDGM, FSTA+LONG |
| 3002 | FTEMP /SAVE AC |
| 3003 | OPM, 0 |
| 3004 | AD1, 0 /PERFORM OP |
| 3005 | PUTM, 0 |
| 3006 | AD2, 0 /STORE RESULT |
| 3007 | FLDA+LONG |
| 3008 | FTEMP /RESTORE AC |
| 3009 | FEXIT |
| 3010 | |
| 3011 | NORMX, FFNOR /*K* CHANGED TO EFFNOR IF EAE |
| 3012 | PAGE |
| 3013 | \f/MAIN INTERPRETER LOOP |
| 3014 | |
| 3015 | NEGFAC, JMS I [FFNEG |
| 3016 | |
| 3017 | ICYCLE, CLA |
| 3018 | JMS I [FETPC /GET INST |
| 3019 | DCA INST |
| 3020 | TAD INST |
| 3021 | CLL RTL |
| 3022 | RTL |
| 3023 | SMA /SKIP IF BASEPAGE ADDRESSING |
| 3024 | JMP LONGI |
| 3025 | AND [7 |
| 3026 | TAD BASJMP |
| 3027 | DCA OPJMP /SAVE OPCODE CALL ADDRESS |
| 3028 | TAD INST /DATA FIELD IS STILL SET UP |
| 3029 | SZL /SO IS LINK (WITH INSTRUCTION BIT 3) |
| 3030 | JMP BPAGEI /INDIRECT ADDRESSING |
| 3031 | CLL RAL |
| 3032 | TAD INST /MULTIPLY BASE OFFSET BY 3 |
| 3033 | TAD [200 /ELIMINATE ANY |
| 3034 | AND (777 /HIGH ORDER BITS |
| 3035 | IMFUDJ, CLL /CLL IAC IF D.P. INTEGER MODE |
| 3036 | TAD BASADR /ADD IN BASE PAGE ORIGIN |
| 3037 | BASCDF, HLT /CDF TO BASE PAGE FIELD |
| 3038 | SZL |
| 3039 | JMS DFBUMP /BUMP DF IF ADDITION OVERFLOWED |
| 3040 | OPJCLL, CLL |
| 3041 | OPJMP, HLT /JMP I EXECUTIONROUTINE |
| 3042 | |
| 3043 | BPAGEI, AND [7 |
| 3044 | DCA ADR |
| 3045 | TAD ADR |
| 3046 | CLL CML RAL |
| 3047 | TAD ADR /FORM 3*OFFSET+1 |
| 3048 | TAD BASADR |
| 3049 | DCA ADR |
| 3050 | RTL |
| 3051 | RTL |
| 3052 | TAD BASCDF /FORM PROPER CDF |
| 3053 | DCA ADDRLO |
| 3054 | ADDRLO, HLT /EXECUTE IT |
| 3055 | TAD I ADR /GET FIELD BITS OF REAL ADDRESS |
| 3056 | DCA ADDRHI /FROM 2D WORD OF BASE PAGE LOC |
| 3057 | ISZ ADR |
| 3058 | SKP |
| 3059 | JMS DFBUMP /WATCH FOR FIELD OVERFLOW |
| 3060 | TAD I ADR /GET LOW-ORDER ADDRESS FROM 3D WORD |
| 3061 | JMP INDEX /NOW GO DO INDEXING (IF ANY) |
| 3062 | \f/COME HERE IF BIT 4 OF INSTRUCTION IS OFF |
| 3063 | |
| 3064 | LONGI, AND [7 |
| 3065 | SNL /TEST BIT 3 OF INSTRUCTION |
| 3066 | JMP I (SPECAL /SPECIAL INSTRUCTION |
| 3067 | TAD BASJMP |
| 3068 | DCA OPJMP |
| 3069 | TAD INST |
| 3070 | DCA ADDRHI /HIGH-ORDER ADDRESS BITS IN INST WD |
| 3071 | JMS I [FETPC /NEXT INST WORD CONTAINS LOW-ORDER ADDRESS |
| 3072 | INDEX, DCA ADDRLO |
| 3073 | TAD INST |
| 3074 | AND [70 |
| 3075 | SNA /IS XR NUMBER 0? |
| 3076 | JMP NOINDX /YES - NO INDEXING |
| 3077 | JMS DCDIDX /GET XR VALUE (MAYBE INCREMENTED) |
| 3078 | AC7775 |
| 3079 | TAD DFLG /GET -3 IF F, -2 IF D, -6 IF E MODE |
| 3080 | DCA DCDIDX |
| 3081 | TAD ADDRLO |
| 3082 | XRADLP, CLL |
| 3083 | TAD I T |
| 3084 | SZL |
| 3085 | ISZ ADDRHI |
| 3086 | ISZ DCDIDX /ADD THE XR IN THE PROPER NUMBER OF TIMES |
| 3087 | JMP XRADLP |
| 3088 | DCA ADDRLO |
| 3089 | NOINDX, TAD ADDRHI |
| 3090 | JMS I MCDF |
| 3091 | DCA ADDRHI /TURN HIGH-ORDER ADDRESS INTO A CDF |
| 3092 | ADDRHI, HLT /AND EXECUTE IT |
| 3093 | TAD ADDRLO |
| 3094 | JMP OPJCLL /GO EXECUTE THE INSTRUCTION |
| 3095 | |
| 3096 | DFBUMP, 0 /BUMP DATA FIELD |
| 3097 | DCA DFTMP /SAVE AC |
| 3098 | RDF |
| 3099 | TAD (CDF 10 |
| 3100 | DCA .+1 |
| 3101 | HLT |
| 3102 | TAD DFTMP /RESTORE AC |
| 3103 | JMP I DFBUMP |
| 3104 | DFTMP, 0 |
| 3105 | \fDCDIDX, 0 |
| 3106 | CLL RTR |
| 3107 | RAR |
| 3108 | TAD XRBASE /ADD IN BASE ADDRESS OF XR ARRAY |
| 3109 | XRCDF, HLT /CDF TO XR ARRAY FIELD |
| 3110 | SZL |
| 3111 | JMS DFBUMP /OR MAYBE NEXT FIELD |
| 3112 | DCA T /SAVE POINTER TO XR |
| 3113 | TAD INST |
| 3114 | AND DCD100 |
| 3115 | SZA CLA /INCREMENT BIT ON? |
| 3116 | ISZ I T /YES - BUMP XR |
| 3117 | DCD100, 100 /** PROTECTION |
| 3118 | JMP I DCDIDX |
| 3119 | |
| 3120 | BASJMP, JMP I JMPTB1 /JMP I JMPTB2 FOR D.P. MODE |
| 3121 | |
| 3122 | JMPTB1, FFGET / F MODE (FLOATING POINT) |
| 3123 | FFADD |
| 3124 | FFSUB |
| 3125 | FFDIV |
| 3126 | FFMPY |
| 3127 | OPMEM /FADDM |
| 3128 | FFPUT |
| 3129 | OPMEM /FMULM |
| 3130 | |
| 3131 | DDGET / D MODE ( DOUBLE PRECISION INTEGER) |
| 3132 | DDADD |
| 3133 | DDSUB |
| 3134 | DDDIV |
| 3135 | DDMPY |
| 3136 | OPMEM /DADDM |
| 3137 | DDPUT |
| 3138 | OPMEM /DMULM |
| 3139 | |
| 3140 | EEGET / E MODE ( 6 WD FLOATING POINT) |
| 3141 | FFADD |
| 3142 | FFSUB |
| 3143 | FFDIV |
| 3144 | FFMPY |
| 3145 | OPMEM |
| 3146 | EEPUT |
| 3147 | OPMEM |
| 3148 | PAGE |
| 3149 | \f/MORE I CYCLE |
| 3150 | |
| 3151 | SPECAL, SNA |
| 3152 | JMP XRINST /OPCODE 0 HAS MANY MANSIONS |
| 3153 | TAD SPECOP |
| 3154 | DCA SPCJMP /GET OPCODE JUMP ADDRESS |
| 3155 | JMS I [FETPC |
| 3156 | DCA ADR |
| 3157 | TAD INST /ALL OF THESE ARE TWO-WORD INSTRUCTIONS |
| 3158 | JMS I MCDF /SO FORM THE ADDRESS NOW |
| 3159 | DCA DATAF |
| 3160 | CDF 0 |
| 3161 | TAD INST |
| 3162 | SPCJMP, HLT |
| 3163 | |
| 3164 | XRINST, TAD INST |
| 3165 | AND (7770 |
| 3166 | CDF 0 |
| 3167 | SNA CLA /IF SUB-OPCODE IS ZERO, |
| 3168 | JMP OPERAT /DECODE SUB-SUB-OPCODE |
| 3169 | TAD INST |
| 3170 | AND [7 |
| 3171 | CLL |
| 3172 | TAD XRBASE |
| 3173 | DCA ADR /COMPUTE INDEX REGISTER ADDRESS |
| 3174 | RTL |
| 3175 | RTL |
| 3176 | TAD I (XRCDF |
| 3177 | DCA DATAF |
| 3178 | XJCOMN, TAD INST |
| 3179 | CLL RTR |
| 3180 | RAR |
| 3181 | AND [77 /GET OPCODE - HIGH ORDER 2 BITS ARE 0 |
| 3182 | OXCOMN, TAD (JMP I SP2 |
| 3183 | DCA .+1 /EXECUTE APPROPRIATE JUMP |
| 3184 | HLT |
| 3185 | |
| 3186 | OPERAT, TAD INST |
| 3187 | CIA |
| 3188 | JMP OXCOMN |
| 3189 | |
| 3190 | SETX, TAD DATAF /SET XR0 LOC |
| 3191 | DCA I (XRCDF |
| 3192 | TAD ADR |
| 3193 | DCA XRBASE |
| 3194 | JMP I FPNXT |
| 3195 | \f/JUMP DECODER |
| 3196 | |
| 3197 | JUMPS, AND (100 /INSTRUCTION IN AC |
| 3198 | CLL RTR /20 IN AC IF NOT COND. JUMP |
| 3199 | SZA /IF NOT COND. JUMP, DECODE FURTHER |
| 3200 | JMP XJCOMN |
| 3201 | TAD INST |
| 3202 | AND [70 |
| 3203 | CLL RTR |
| 3204 | RAR |
| 3205 | TAD (CNDSKT |
| 3206 | DCA T /INDEX INTO CONDITIONAL SKIP TABLE |
| 3207 | TAD I T |
| 3208 | DCA CNDSKP |
| 3209 | TAD ACH |
| 3210 | SZA |
| 3211 | JMP CNDSKP |
| 3212 | TAD ACL |
| 3213 | SZA CLA /IF HIGH ORDER ZERO, AC MIGHT BE UNNORMALIZED. |
| 3214 | IAC /USE LOW ORDER ON 0/NOT 0 BASIS |
| 3215 | CNDSKP, HLT /TEST AC |
| 3216 | JMP I FPNXT /FAILED - DON'T JUMP |
| 3217 | |
| 3218 | DOJMP, STA CLL |
| 3219 | TAD ADR |
| 3220 | DCA PC |
| 3221 | SNL |
| 3222 | TAD (-10 |
| 3223 | TAD DATAF |
| 3224 | CDF 0 |
| 3225 | DCA I (PCCDF /ADDRESS-1 TO PC |
| 3226 | JMP I .+1 |
| 3227 | YFJMP, ICYCLE /** CHANGED IF RUNNING UNDER RTS-8 |
| 3228 | |
| 3229 | JXN, AND [70 /GET XR FIELD |
| 3230 | JMS I (DCDIDX /GET XR VALUE WITH INCREMENTING |
| 3231 | TAD I T |
| 3232 | SNA CLA /ZERO? |
| 3233 | JMP I FPNXT /YES |
| 3234 | JMP DOJMP /JUMP ON INDEX NON-ZERO, RIGHT? |
| 3235 | |
| 3236 | CNDSKT, SZA CLA /JEQ |
| 3237 | SPA CLA /JGE |
| 3238 | SMA SZA CLA /JLE |
| 3239 | SKP CLA /JA |
| 3240 | SNA CLA /JNE |
| 3241 | SMA CLA /JLT |
| 3242 | SPA SNA CLA /JGT |
| 3243 | JMP TSTALN /JAL |
| 3244 | |
| 3245 | TSTALN, CLA |
| 3246 | TAD ACX |
| 3247 | TAD (-27 |
| 3248 | SPA SNA CLA |
| 3249 | JMP I FPNXT |
| 3250 | JMP DOJMP |
| 3251 | \f/OPCODE TABLES |
| 3252 | |
| 3253 | SPECOP, JMP I SPECOP /SPECIAL OPCODE TABLE |
| 3254 | JUMPS |
| 3255 | JXN |
| 3256 | TRAP3I |
| 3257 | TRAP4I |
| 3258 | TRAP5I |
| 3259 | TRAP6I |
| 3260 | TRAP7I |
| 3261 | |
| 3262 | FPJAC |
| 3263 | STRTD |
| 3264 | STRTF |
| 3265 | NRMFAC |
| 3266 | NEGFAC |
| 3267 | CLFAC |
| 3268 | FPAUSE |
| 3269 | SP2, EXIT |
| 3270 | ALN |
| 3271 | ATX |
| 3272 | FPXTA |
| 3273 | ICYCLE /NOP |
| 3274 | STRTE |
| 3275 | ICYCLE /UNDEF OP |
| 3276 | ICYCLE /" |
| 3277 | FPLDX |
| 3278 | ADDX |
| 3279 | SETX |
| 3280 | SETB |
| 3281 | JSA |
| 3282 | JSR |
| 3283 | PAGE |
| 3284 | \f/MISCELLANEOUS OPCODE ROUTINES |
| 3285 | |
| 3286 | TRAP3I, |
| 3287 | TRAP4I, AC0002 |
| 3288 | TAD DATAF |
| 3289 | DCA .+1 /FORM CDF CIF N |
| 3290 | HLT /EXECUTE IT |
| 3291 | TAD INST |
| 3292 | SMA CLA /TRAP4 JMS'S TO ITS TARGET ADDRESS, |
| 3293 | JMP I ADR /TRAP3 JMP'S TO IT |
| 3294 | JMS I ADR |
| 3295 | JMP I FPNXT |
| 3296 | |
| 3297 | ALN, TAD ACX /ALIGN SIMULATOR |
| 3298 | DCA OPX /SAVE EXPONENT IN CASE WE'RE IN D.I. MODE |
| 3299 | TAD DFLG |
| 3300 | SMA SZA CLA |
| 3301 | DCA ACX /ZERO EXP IF D.I. MODE |
| 3302 | JMS DATCDF /SET TO XR FIELD |
| 3303 | TAD INST |
| 3304 | AND [7 |
| 3305 | TAD DFLG /IF WE'RE IN FLOATING POINT MODE, |
| 3306 | SNA CLA /AND DOING AN "ALN 0", |
| 3307 | TAD [27 /ALIGN UNTIL EXPONENT = 23 |
| 3308 | SNA |
| 3309 | TAD I ADR /OTHERWISE ALIGN UNTIL EXPONENT = XR VALUE |
| 3310 | CDF 0 |
| 3311 | CIA |
| 3312 | TAD ACX |
| 3313 | CMA /FORM DIFFERENCE - 1 |
| 3314 | SPA /IF EXPONENT IS LARGER THEN DESIRED EXPONENT, |
| 3315 | JMP ALNSHL /SHIFT LEFT |
| 3316 | JMS I [ACSR /OTHERWISE SHIFT RIGHT |
| 3317 | ALNXIT, TAD DFLG |
| 3318 | SPA SNA CLA /IF DOUBLE INTEGER MODE, |
| 3319 | JMP I FPNXT |
| 3320 | TAD OPX /ALIGNMENT LEAVES THE EXPONENT UNCHANGED |
| 3321 | DCA ACX |
| 3322 | JMP I FPNXT |
| 3323 | ALNSHL, DCA T /STORE SHIFT COUNT |
| 3324 | SKP /SHIFT LEFT ONE LESS THAN COUNT |
| 3325 | JMS I [AL1BMP |
| 3326 | ISZ T |
| 3327 | JMP .-2 |
| 3328 | JMP ALNXIT /GO TO COMMON CODE |
| 3329 | \f/ARG FETCH SUBROUTINES AND MODE CHANGE OPERATORS |
| 3330 | |
| 3331 | DARGET, 0 |
| 3332 | DCA ADR |
| 3333 | TAD DARGET |
| 3334 | DCA ARGET |
| 3335 | DCA ACX |
| 3336 | JMP ARGET2 /FAKE OUT FLOATING POINT ROUTINE |
| 3337 | |
| 3338 | ARGET, 0 /SUBROUTINE TO FETCH ARG FOR ADD, SUBT, ETC. |
| 3339 | DCA ADR /STORE ADDRESS OF OPERAND |
| 3340 | TAD I ADR /PICK UP EXPONENT |
| 3341 | ISZ ADR /MOVE POINTER TO HI MANTISSA WD |
| 3342 | SKP |
| 3343 | JMS I (DFBUMP |
| 3344 | ARGET2, DCA OPX |
| 3345 | TAD I ADR /PICK IT UP |
| 3346 | DCA OPH /STORE |
| 3347 | ISZ ADR /MOVE PTR. TO LO MANTISSA WD. |
| 3348 | SKP |
| 3349 | JMS I (DFBUMP /WATCH THOSE FIELD TRANSITIONS! |
| 3350 | TAD I ADR /PICK IT UP |
| 3351 | DCA OPL /STORE IT |
| 3352 | CDF 0 |
| 3353 | JMP I ARGET /RETURN |
| 3354 | |
| 3355 | STRTE, TAD DFLG /START EXTENDED PRECISION MODE |
| 3356 | SPA CLA |
| 3357 | JMP .+4 /CLEAR EXTENDED FAC |
| 3358 | DCA EAC1 /IF NOT ALREADY IN E MODE |
| 3359 | DCA EAC2 |
| 3360 | DCA EAC3 |
| 3361 | AC7775 |
| 3362 | DCA DFLG |
| 3363 | JMP DFECMN |
| 3364 | |
| 3365 | STRTD, CLA IAC /START DOUBLE PRECISION INTEGER MODE |
| 3366 | STRTF, DCA DFLG /START FLOATING POINT MODE |
| 3367 | TAD DFLG |
| 3368 | DFECMN, TAD (CLL |
| 3369 | DCA I (IMFUDJ /SET D.P.I FUDGE TO "CLL" OR "CLL IAC" |
| 3370 | TAD DFLG |
| 3371 | SPA |
| 3372 | CMA /CHANGE -3 FOR E MODE TO +2 |
| 3373 | CLL RTL |
| 3374 | RAL |
| 3375 | TAD (JMPTB1&177+5600 |
| 3376 | DCA I (BASJMP |
| 3377 | JMP I FPNXT |
| 3378 | \f/DOUBLE PRECISION INTEGER OPERATORS |
| 3379 | |
| 3380 | DDSUB, JMS DARGET |
| 3381 | JMS I (OPNEG |
| 3382 | SKP |
| 3383 | DDADD, JMS DARGET |
| 3384 | DCA AC1 /CLEAR OVERFLOW JUSTINCASE |
| 3385 | JMS I [OADD |
| 3386 | JMP I FPNXT |
| 3387 | |
| 3388 | FFGET, DCA ADR /GET A FLOATING POINT NUMBER |
| 3389 | TAD I ADR |
| 3390 | DCA ACX /SAVE EXPONENT |
| 3391 | ISZ ADR |
| 3392 | JMP .+3 /NO FIELD OVERFLOW |
| 3393 | JMS I (DFBUMP /BUMP DATA FIELD |
| 3394 | DDGET, DCA ADR /SUAVE - ENTRY POINT FOR D.P. INTEGER GET |
| 3395 | TAD I ADR |
| 3396 | DCA ACH |
| 3397 | ISZ ADR |
| 3398 | SKP |
| 3399 | JMS I (DFBUMP |
| 3400 | TAD I ADR |
| 3401 | DCA ACL |
| 3402 | JMP I FPNXT |
| 3403 | |
| 3404 | FFPUT, DCA ADR /STORE A FLOATING POINT NUMBER |
| 3405 | TAD ACX /GET FAC AND STORE IT |
| 3406 | DCA I ADR /AT SPECIFIED ADDRESS |
| 3407 | ISZ ADR |
| 3408 | JMP .+3 |
| 3409 | JMS I (DFBUMP |
| 3410 | DDPUT, DCA ADR /ENTRY FOR D.P. INTEGER PUT |
| 3411 | TAD ACH |
| 3412 | DCA I ADR |
| 3413 | ISZ ADR |
| 3414 | SKP |
| 3415 | JMS I (DFBUMP |
| 3416 | TAD ACL |
| 3417 | DCA I ADR |
| 3418 | JMP I FPNXT |
| 3419 | PAGE |
| 3420 | \fFPPKG= . /FOR EAE OVERLAY |
| 3421 | |
| 3422 | /23-BIT FLOATING PT INTERPRETER |
| 3423 | /W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN |
| 3424 | |
| 3425 | LPBUF2, ZBLOCK 16 |
| 3426 | LPBUF3 |
| 3427 | |
| 3428 | AL1BMP, 0 /*K* UTILITY SUBROUTINE - USED BY INTERPRETER |
| 3429 | STA |
| 3430 | TAD ACX |
| 3431 | DCA ACX |
| 3432 | JMS I [AL1 |
| 3433 | JMP I AL1BMP |
| 3434 | |
| 3435 | /FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES |
| 3436 | DDMPY, JMS I (DARGET |
| 3437 | SKP |
| 3438 | FFMPY, JMS I (ARGET /GET OPERAND |
| 3439 | JMS MDSET /SET UP FOR MPY-OPX IN AC ON RETN. |
| 3440 | TAD ACX /DO EXPONENT ADDITION |
| 3441 | DCA ACX /STORE FINAL EXPONENT |
| 3442 | DCA MDSET /ZERO TEM STORAGE FOR MPY ROUTINE |
| 3443 | DCA AC2 |
| 3444 | TAD ACH /IS FAC=0? |
| 3445 | SNA CLA |
| 3446 | DCA ACX /YES-ZERO EXPONENT |
| 3447 | JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR. |
| 3448 | TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER |
| 3449 | DCA OPL |
| 3450 | JMS MP24 |
| 3451 | TAD AC2 /STORE RESULT BACK IN FAC |
| 3452 | DCA ACL /LOW ORDER |
| 3453 | TAD MDSET /HIGH ORDER |
| 3454 | DCA ACH |
| 3455 | TAD ACH /DO WE NEED TO NORMALIZE? |
| 3456 | RAL |
| 3457 | SMA CLA |
| 3458 | JMS AL1BMP /YES-DO IT FAST |
| 3459 | TAD AC1 |
| 3460 | SPA CLA /CHECK OVERFLOW WORD |
| 3461 | ISZ ACL /HIGH BIT ON - ROUND RESULT |
| 3462 | JMP MDONE |
| 3463 | ISZ ACH /LOW ORDER OVERFLOWED - INCREMENT HIGH ORDER |
| 3464 | TAD ACH |
| 3465 | SPA /CHECK FOR OVERFLOW TO 4000 0000 |
| 3466 | JMP I (SHR1 /WE HANDLE A SIMILIAR CASE IN FLOATING DIVIDE |
| 3467 | CLA |
| 3468 | \fMDONE, DCA AC1 /ZERO OVERFLOW WD(DO I NEED THIS???) |
| 3469 | ISZ MSIGN /SHOULD RESULT BE NEGATIVE? |
| 3470 | SKP /NO |
| 3471 | JMS I [FFNEG /YES-NEGATE IT |
| 3472 | TAD ACH |
| 3473 | SNA CLA /A ZERO AC MEANS A ZERO EXPONENT |
| 3474 | DCA ACX |
| 3475 | TAD DFLG |
| 3476 | SMA SZA CLA /D.P. INTEGER MODE? |
| 3477 | TAD ACX /WITH ACX LESS THAN 0? |
| 3478 | SNA |
| 3479 | JMP I FPNXT /NO - RETURN |
| 3480 | CMA |
| 3481 | JMS I [ACSR /UN-NORMALIZE RESULT |
| 3482 | JMP I FPNXT /RETURN |
| 3483 | \f/MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE |
| 3484 | /ALSO SHIFTS OPERAND ONE BIT TO THE LEFT. |
| 3485 | /EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT |
| 3486 | /CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND |
| 3487 | /DATA FIELD SET PROPERLY FOR OPERAND. |
| 3488 | |
| 3489 | MDSET, 0 |
| 3490 | CLA CLL CMA RAL /SET SIGN CHECK TO -2 |
| 3491 | DCA MSIGN |
| 3492 | TAD OPH /IS OPERAND NEGATIVE? |
| 3493 | SMA CLA |
| 3494 | JMP .+3 /NO |
| 3495 | JMS I (OPNEG /YES-NEGATE IT |
| 3496 | ISZ MSIGN /BUMP SIGN CHECK |
| 3497 | TAD OPL /AND SHIFT OPERAND LEFT ONE BIT |
| 3498 | CLL RAL |
| 3499 | DCA OPL |
| 3500 | TAD OPH |
| 3501 | RAL |
| 3502 | DCA OPH |
| 3503 | DCA AC1 /CLR. OVERFLOW WORF OF FAC |
| 3504 | TAD ACH /IS FAC NEGATIVE |
| 3505 | SMA CLA |
| 3506 | JMP LEV /NO-GO ON |
| 3507 | JMS I [FFNEG /YES-NEGATE IT |
| 3508 | ISZ MSIGN /BUMP SIGN CHECK |
| 3509 | NOP /MAY SKIP |
| 3510 | LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC |
| 3511 | JMP I MDSET |
| 3512 | MSIGN, 0 |
| 3513 | \f/24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL |
| 3514 | /MULTIPLICAND IS IN ACH AND ACL |
| 3515 | /RESULT LEFT IN MDSET,AC2, AND AC1 |
| 3516 | |
| 3517 | MP24, 0 |
| 3518 | TAD (-14 /SET UP 12 BIT COUNTER |
| 3519 | DCA OPX |
| 3520 | TAD OPL /IS MULTIPLIER=0? |
| 3521 | SZA |
| 3522 | JMP MPLP1 /NO-GO ON |
| 3523 | DCA AC1 /YES-INSURE RESULT=0 |
| 3524 | JMP I MP24 /RETURN |
| 3525 | MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER |
| 3526 | MPLP1, RAR /OF MULTIPLIER AND INTO LINK |
| 3527 | DCA OPL |
| 3528 | SNL /WAS IT A 1? |
| 3529 | JMP MPLP2 /NO - 0 - JUST SHIFT PARTIAL PRODUCT |
| 3530 | TAD AC2 /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT |
| 3531 | TAD ACL /LOW ORDER |
| 3532 | DCA AC2 |
| 3533 | CML RAL /*K* NOTE THE "SNL" 5 WORDS BACK! |
| 3534 | TAD ACH /HI ORDER |
| 3535 | MPLP2, TAD MDSET |
| 3536 | RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT |
| 3537 | DCA MDSET |
| 3538 | TAD AC2 |
| 3539 | RAR |
| 3540 | DCA AC2 |
| 3541 | TAD AC1 |
| 3542 | RAR /OVERFLOW TO AC1 |
| 3543 | DCA AC1 |
| 3544 | ISZ OPX /DONE ALL 12 MULTIPLIER BITS? |
| 3545 | JMP MPLP /NO-GO ON |
| 3546 | JMP I MP24 /YES-RETURN |
| 3547 | PAGE |
| 3548 | \f/DIVIDE-BY-ZERO ROUTINE - MUST BE AT BEGINNING OF PAGE |
| 3549 | |
| 3550 | DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL |
| 3551 | JMS I ERR /GIVE ERROR MSG |
| 3552 | TAD DBAD |
| 3553 | DCA ACX /RETURN A VERY LARGE POSITIVE NUMBER |
| 3554 | AC2000 |
| 3555 | JMP FD |
| 3556 | |
| 3557 | /FLOATING DIVIDE - USES DIVIDE-AND-CORRECT METHOD |
| 3558 | |
| 3559 | DDDIV, JMS I (DARGET |
| 3560 | SKP |
| 3561 | FFDIV, JMS I (ARGET /GET OPERAND |
| 3562 | JMS I (MDSET /GO SET UP FOR DIVIDE-OPX IN AC ON RETN. |
| 3563 | CMA IAC /NEGATE EXP. OF OPERAND |
| 3564 | TAD ACX /ADD EXP OF FAC |
| 3565 | DCA ACX /STORE AS FINAL EXPONENT |
| 3566 | TAD OPH /NEGATE HI ORDER OP. FOR USE |
| 3567 | CLL CMA IAC /AS DIVISOR |
| 3568 | DCA OPH |
| 3569 | JMS DV24 /CALL DIV.--(ACH+ACL)/OPH |
| 3570 | TAD ACL /SAVE QUOT. FOR LATER |
| 3571 | DCA AC1 |
| 3572 | TAD OPL |
| 3573 | SNA CLA |
| 3574 | JMP DVL2 /AVOID MULTIPLYING BY 0 |
| 3575 | TAD (-15 /SET COUNTER FOR 12 BIT MULTIPLY |
| 3576 | DCA DV24 /TO MULTIPLY QUOT. OF DIV. BY |
| 3577 | JMP DVLP1 /LOW ORDER OF OPERAND (OPL) |
| 3578 | |
| 3579 | /DIVIDE ROUTINE - (ACH,ACL)/OPH = ACL REMAINDER REM (AC2=0) |
| 3580 | |
| 3581 | DV24, 0 |
| 3582 | TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND |
| 3583 | TAD OPH /DIVISOR IN OPH (NEGATIVE) |
| 3584 | SZL CLA /IS IT? |
| 3585 | JMP DBAD /NO-DIVIDE OVERFLOW |
| 3586 | TAD (-15 /YES-SET UP 12 BIT LOOP |
| 3587 | DCA AC2 |
| 3588 | JMP DV1 /GO BEGIN DIVIDE |
| 3589 | DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT |
| 3590 | RAL |
| 3591 | DCA ACH /RESTORE HI ORDER |
| 3592 | TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER |
| 3593 | TAD OPH /DIVIDEND |
| 3594 | SZL /GOOD SUBTRACT? |
| 3595 | DCA ACH /YES-RESTORE HI DIVIDEND |
| 3596 | CLA /NO-DON'T RESTORE--OPH.GT.ACH |
| 3597 | DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT |
| 3598 | RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL |
| 3599 | DCA ACL |
| 3600 | ISZ AC2 /DONE 12 BITS OF QUOT? |
| 3601 | JMP DV2 /NO-GO ON |
| 3602 | JMP I DV24 /YES-RETN W/AC2=0 |
| 3603 | \f/DIVIDE ROUTINE CONTINUED |
| 3604 | |
| 3605 | MP12L, DCA OPL /STORE BACK MULTIPLIET |
| 3606 | TAD AC2 /GET PRODUCT SO FAR |
| 3607 | SNL /WAS MULTIPLIER BIT A 1? |
| 3608 | JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT |
| 3609 | CLL /YES-CLEAR LINK AND ADD MULTIPLICAND |
| 3610 | TAD ACL /TO PARTIAL PRODUCT |
| 3611 | RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER |
| 3612 | DCA AC2 /RESULT-STORE BACK |
| 3613 | DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER |
| 3614 | RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.) |
| 3615 | ISZ DV24 /DONE ALL BITS? |
| 3616 | JMP MP12L /NO-LOOP BACK |
| 3617 | CLL CIA /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC |
| 3618 | DCA ACL /NEGATE AND STORE |
| 3619 | CML RAL /PROPAGATE CARRY |
| 3620 | TAD AC2 /NEGATE HI ORDER PRODUCT |
| 3621 | STL CIA |
| 3622 | TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV. |
| 3623 | SZL /WELL? |
| 3624 | JMP DVOPS /GREATER THAN REM.-ADJUST QUOT OF 1ST DIV. |
| 3625 | DCA ACH /OK - DO (REM - (Q*OPL)) / OPH |
| 3626 | DVL3, JMS DV24 /DIVIDE BY OPH (HI ORDER OPERAND) |
| 3627 | DVL1, TAD AC1 /GET QUOT. OF FIRST DIV. |
| 3628 | SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT |
| 3629 | JMP FD /NO-ITS NORMALIZED-DONE |
| 3630 | SHR1, CLL |
| 3631 | ISZ ACL /ROUND AND SHIFT RIGHT ONE |
| 3632 | SKP |
| 3633 | IAC /DOUBLE PRECISION INCREMENT |
| 3634 | RAR |
| 3635 | DCA ACH /STORE IN FAC |
| 3636 | TAD ACL /SHIFT LOW ORDER RIGHT |
| 3637 | RAR |
| 3638 | DCA ACL /STORE BACK |
| 3639 | ISZ ACX /BUMP EXPONENT |
| 3640 | NOP |
| 3641 | TAD ACH |
| 3642 | JMP DVL1+1 /IF FRACT WAS 77777777 WE MUST SHIFT AGAIN |
| 3643 | FD, DCA ACH /STORE HIGH ORDER RESULT |
| 3644 | JMP I (MDONE /GO LEAVE DIVIDE |
| 3645 | |
| 3646 | DVL2, DCA ACL /COME HERE IF LOW-ORDER QUO=0 |
| 3647 | JMP DVL3 /SAVE SOME TIME |
| 3648 | \f/ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE |
| 3649 | /REMAINDER OF THE FIRST DIVIDE IS LESS THAN QUOT*OPL |
| 3650 | |
| 3651 | DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER |
| 3652 | DCA ACH |
| 3653 | CLL |
| 3654 | TAD OPH |
| 3655 | TAD ACH /WATCH FOR OVERFLOW |
| 3656 | SNL |
| 3657 | JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV. |
| 3658 | DCA ACH /NO OVERFLOW-STORE NEW REM. |
| 3659 | CMA /SUBTRACT 1 FROM QUOT OF |
| 3660 | TAD AC1 /FIRST DIVIDE |
| 3661 | DCA AC1 |
| 3662 | DVOP1, CLA CLL |
| 3663 | TAD ACH /GET HI ORD OF REMAINDER |
| 3664 | SNA /IS IT ZERO? |
| 3665 | DVOP2, DCA ACL /YES-MAKE WHOLE THING ZERO |
| 3666 | DCA ACH |
| 3667 | JMS DV24 /DIVIDE EXTENDED REM. BY HI DIVISOR |
| 3668 | TAD ACL /NEGATE THE RESULT |
| 3669 | CLL CMA IAC |
| 3670 | DCA ACL |
| 3671 | SNL /IF QUOT. IS NON-ZERO, SUBTRACT |
| 3672 | CMA /ONE FROM HIGH ORDER QUOT. |
| 3673 | JMP DVL1 /GO TO IT |
| 3674 | |
| 3675 | LPBUF3, ZBLOCK 12 |
| 3676 | LPBUF4 |
| 3677 | PAGE |
| 3678 | \f/"OPNEG" MUST BE AT 0 ON PAGE |
| 3679 | |
| 3680 | OPNEG, 0 /ROUTINE TO NEGATE OPERAND |
| 3681 | TAD OPL /GET LOW ORDER |
| 3682 | CLL CIA /NEGATE AND STORE BACK |
| 3683 | DCA OPL |
| 3684 | CML RAL /PROPAGATE CARRY |
| 3685 | TAD OPH /GET HI ORDER |
| 3686 | CLL CIA /NEGATE AND STORE BACK |
| 3687 | DCA OPH |
| 3688 | JMP I OPNEG |
| 3689 | / |
| 3690 | /FLOATING SUBTRACT AND ADD |
| 3691 | / |
| 3692 | FFSUB, JMS I (ARGET /PICK UO THE OP. |
| 3693 | JMS OPNEG /NEGATE OPERAND |
| 3694 | SKP |
| 3695 | FFADD, JMS I (ARGET /PICK UP OPERAND |
| 3696 | TAD OPH /IS OPERAND = 0 |
| 3697 | SNA CLA |
| 3698 | JMP I FPNXT /YES-DONE |
| 3699 | TAD ACH /NO-IS FAC=0? |
| 3700 | SNA CLA |
| 3701 | JMP CLROFL /CLEAR OUT THE OVERFLOW BITS |
| 3702 | TAD ACX /NO-DO EXPONENT CALCULATION |
| 3703 | CLL CIA |
| 3704 | TAD OPX |
| 3705 | SMA SZA /WHICH EXP. GREATER? |
| 3706 | JMP FACR /OPERANDS-SHIFT FAC |
| 3707 | CIA /FAC'S-SHIFT OPERAND=DIFFRNCE+1 |
| 3708 | TAD (-30 |
| 3709 | SMA /TEST FOR INSIGNIFICANCE |
| 3710 | JMP OPINSG /YES - ANSWER IS FAC |
| 3711 | TAD (30 |
| 3712 | JMS OPSR |
| 3713 | JMS I [ACSR /SHIFT FAC ONE PLACE RIGHT |
| 3714 | DOADD, TAD OPX /SET EXPONENT OF RESULT |
| 3715 | DCA ACX |
| 3716 | JMS I [OADD /DO THE ADDITION |
| 3717 | JMS FFNOR /NORMALIZE RESULT |
| 3718 | JMP I FPNXT /RETURN |
| 3719 | FACR, TAD (-30 |
| 3720 | SMA /TEST FOR INSIGNIFICANCE |
| 3721 | JMP ACINSG /YES - ANSWER IS OPR |
| 3722 | TAD (30 |
| 3723 | JMS I [ACSR /SHIFT FAC = DIFF.+1 |
| 3724 | JMS OPSR /SHIFT OPR. 1 PLACE |
| 3725 | JMP DOADD /DO ADDITION |
| 3726 | |
| 3727 | OPINSG, CLA |
| 3728 | JMP I FPNXT |
| 3729 | \f/OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 IN AC |
| 3730 | |
| 3731 | OPSR, 0 |
| 3732 | CMA /- (COUNT+1) TO SHIFT COUNTER |
| 3733 | DCA AC0 |
| 3734 | LOP2, TAD OPH /GET SIGN BIT |
| 3735 | CLL /TO LINK |
| 3736 | SPA |
| 3737 | CML /WITH HI MANTISSA IN AC |
| 3738 | RAR /SHIFT IT RIGHT, PROPAGATING SIGN |
| 3739 | DCA OPH /STORE BACK |
| 3740 | TAD OPL |
| 3741 | RAR |
| 3742 | DCA OPL /STORE LO ORDER BACK |
| 3743 | ISZ OPX /INCREMENT EXPONENT |
| 3744 | NOP |
| 3745 | ISZ AC0 /DONE ALL SHIFTS? |
| 3746 | JMP LOP2 /NO-LOOP |
| 3747 | RAR /SAVE 1 BIT OF OVERFLOW |
| 3748 | DCA AC2 /IN AC2 |
| 3749 | JMP I OPSR /YES-RETN. |
| 3750 | |
| 3751 | FFNOR, 0 /ROUTINE TO NORMALIZE THE FAC |
| 3752 | TAD ACH /GET THE HI ORDER MANTISSA |
| 3753 | SNA /ZERO? |
| 3754 | TAD ACL /YES-HOW ABOUT LOW? |
| 3755 | SNA |
| 3756 | TAD AC1 /LOW=0, IS OVRFLO BIT ON? |
| 3757 | SNA CLA |
| 3758 | JMP ZEXP /#=0-ZERO EXPONENT |
| 3759 | NORMLP, CLA CLL CML RTR /NOT 0-MAKE A 2000 IN AC |
| 3760 | TAD ACH /ADD HI ORDER MANTISSA |
| 3761 | SZA /HI ORDER = 6000 |
| 3762 | JMP .+3 /NO-CHECK LEFT MOST DIGIT |
| 3763 | TAD ACL /YES-6000 OK IF LOW=0 |
| 3764 | SZA CLA |
| 3765 | SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS. |
| 3766 | JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7) |
| 3767 | JMS I [AL1BMP /SHIFT AC LEFT AND BUMP ACX DOWN |
| 3768 | JMP NORMLP /GO BACK AND SEE IF NORMALIZED |
| 3769 | ZEXP, DCA ACX |
| 3770 | FFNORR, DCA AC1 /DONE W/NORMALIZE - CLEAR AC1 |
| 3771 | JMP I FFNOR /RETURN |
| 3772 | |
| 3773 | ACINSG, CLA /COME HERE IF AC IS INSIGNIFICANT ON ADDITION |
| 3774 | DCA ACH |
| 3775 | DCA ACL |
| 3776 | JMP DOADD-1 /FAKE AN ADD WITH OPR=0 |
| 3777 | |
| 3778 | LPBUF4, ZBLOCK 40 |
| 3779 | LPBUFE |
| 3780 | CLROFL, DCA AC1 /CLEAR THE FLOATING AC OVERFLOW WORD |
| 3781 | DCA AC2 /CLEAR THE OPERAND OVERFLOW WORD |
| 3782 | JMP DOADD /FAC=0; DO THE ADD |
| 3783 | PAGE |
| 3784 | \f/PAGE 7400 UNUSED RIGHT NOW |
| 3785 | |
| 3786 | LPBUFE, ZBLOCK 177 |
| 3787 | LPBUFR |
| 3788 | FIELD 1 |
| 3789 | \f |