File: FRTS.LS of Disk: V50/Source/Source-Listing-PAL-3
(Source file text)
/FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 1 /FORTRAN IV FRTS SYSTEM, V50A / / / /COPYRIGHT (C) 1974,1975,1980 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. /AND WVDMARK, ZURICH / /FORTRAN 4 RUNTIME SYSTEM - R.LARY /AND NOW WITH DOUBLE PRECISION! - MKH /RTS-8 SUPPORT ADDED 5/20/74 - RL DECIMAL 0062 XVERSN=50 /UPDATE WITH EVERY RELEASE! 0301 XPATCH="A /PATCH LEVEL B 0301 XPUSER="A /USER PATCH LEVEL OCTAL /NOTES TO MAINTAINERS: /THIS PROGRAM IS DESIGNED TO SUPPORT MANY DIFFERENT HARDWARE /CONFIGURATIONS IN A MINIMAL AMOUNT OF SPACE. IT ACHIEVES THIS GOAL /BY "TAILORING" ITSELF AT INITIALIZATION TIME /BASED ON A SURVEY OF ITS HARDWARE/SOFTWARE ENVIRONMENT. THIS MAKES /THIS PROGRAM DIFFICULT TO MODIFY UNLESS THE MODIFYING PROGRAMMER /KNOWS WHAT IS GOING ON. IT IS THEREFORE SUGGESTED THAT YOU READ THIS /LISTING THOROUGHLY AND UNDERSTAND THE MAJOR ROUTINES BEFORE /MAKING EVEN "TRIVIAL" CHANGES. /ALL SYMBOLS BEGINNING WITH THE LETTER "Q" ARE ENTRIES IN THE /HEADER BLOCK OF THE LOADER-IMAGE (.LD) FILE. /ALL SYMBOLS BEGINNING WITH THE LETTER "Y" DENOTE THE BEGINNING OF /A BLOCK OF CODE WHICH WILL BE REPLACED BY DIFFERENT CODE IF FRTS /IS RUNNING IN THE BACKGROUND UNDER RTS-8. THE REPLACEMENT CODE /CAN BE FOUND IN THE TABLE "BKRLST". /ALL SYMBOLS BEGINNING WITH THE LETTER "V" ARE DEFINED IN THE LOADER /SYMBOL TABLE AND CANNOT BE MOVED WITHOUT CHANGING THE LOADER. ONLY /A VERY FEW OF THESE SYMBOLS OCCUR IN PLACES OTHER THAN /PAGE 200 OR THE FIRST LOCATION OF OTHER PAGES. /CODE WHICH CONTAINS THE CHARACTER SEQUENCE "*K*" IN THE COMMENT FIELD /IS PARTICULARLY SUBTLE/OBSCURE (THE "K" IS FOR "KLUDGE"). THE REST OF THE /COMMENT SHOULD INDICATE WHAT IS GOING ON. /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 2 / FIXES FOR V4 J.K. 1975 / / .SCALE FACTOR PRINTED BY P FORMAT OPERATOR / .FRTS /P / .RK8E HANDLER TO RUN WITH INTERRUPTS ON / .SLASH AT END OF FORMAT STATEMENT / / / CHANGES FOR OS/78 AND OS/8 V3D BY P.T. / .CHANGED THE VERSION NUMBER TO 5A / .FIXED THE FIELD OVERFLOW PROBLEM / .FIXED THE "K=K+1" PROBLEM / / CHANGES WVDM / ADAPTED FOR MULTI8 14-NOV-78 / PATCHES AND FPP SUPPORT 4-JUN-80 / PTR,PTP OUT. DKC8AA PRINTER IN / XON, XOFF SUPPORT (VT100) 25-JUN-80 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 3 /DEFINITIONS: 7340 AC7777= CLA CLL CMA 7344 AC7776= CLA CLL CMA RAL 7346 AC7775= CLA CLL CMA RTL 7333 AC6000= CLA CLL CML IAC RTR 7330 AC4000= CLA CLL CML RAR 7350 AC3777= CLA CLL CMA RAR 7332 AC2000= CLA CLL CML RTR 7307 AC0004= CLA CLL IAC RTL 7325 AC0003= CLA CLL CML IAC RAL 7326 AC0002= CLA CLL CML RTL 7324 AC0001= CLA CLL CML RAL /DEFINITIONS OF KE-8/E INSTRUCTIONS 7421 MQL= 7421 7501 MQA= 7501 7621 CAM= CLA MQL 7521 SWP= MQA MQL 7431 SWAB= 7431 7441 SCA= 7441 7405 MUY= 7405 7407 DVI= 7407 7411 NMI= 7411 7413 SHL= 7413 7415 ASR= 7415 7417 LSR= 7417 7403 ACS= 7403 7457 SAM= 7457 7443 DAD= 7443 7663 DLD= 7663 7445 DST= 7445 7573 DPIC= 7573 7575 DCM= 7575 7451 DPSZ= 7451 6006 SGT= 6006 6254 SINT= 6254 /DEFINITIONS OF FPP IOT'S 6551 FPINT= 6551 6552 FPICL= 6552 6553 FPCOM= 6553 6554 FPHLT= 6554 6555 FPST= 6555 6556 FPRST= 6556 6567 FPEP= 6567 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 4 /FPP OPCODES: 0000 FLDA= 0000 1000 FADD= 1000 2000 FSUB= 2000 3000 FDIV= 3000 4000 FMUL= 4000 5000 FADDM= 5000 6000 FSTA= 6000 7000 FMULM= 7000 0400 LONG= 400 /TWO-WORD ADDRESSING 0200 BASE= 200 /BASEPAGE ADDRESSING 0600 IND= 600 /INDIRECT ADDRESSING 0000 FEXIT= 0000 0004 FNORM= 0004 0005 STARTF= 0005 0006 STARTD= 0006 0007 JAC= 0007 0030 XTA= 0030 0050 STARTE= 0050 0100 LDX= 0100 1030 JA= 1030 1040 JNE= 1040 3000 TRAP3= 3000 /OS8 EQUIVALENCES: 7643 OS8SWS= 7643 7746 OSJSWD= 7746 7647 OS8DVT= 7647 7760 OS8DCB= 7760 7666 OS8DAT= 7666 /VARIOUS OTHER IOT'S: 6661 LSF= 6661 6662 LCF= 6662 6663 LSE= 6663 6665 LIE= 6665 6666 LLS= 6666 6667 LIF= 6667 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 5 /PAGE ZERO FOR FORTRAN IV RTS 0000 *0 /INTERRUPT STUFF 000000 0000 0 000001 5402 JMP I .+1 000002 0400 INTRPT 000003 6600 LPGET, LPBUFR /LINE PRINTER RING BUFFER FETCH POINTER 000004 0000 TOCHR, 0 /TELETYPE STATUS WORD 000005 0000 KBDCHR, 0 /KEYBOARD INPUT CHARACTER 000006 7761 TTM17, -17 /CONSTANT 000007 0000 QSINH, 0 /XON,XOFF FLAG 000010 0000 FMTPXR, 0 /XR USED TO INDEX FORMAT PARENTHESIS ARRAY 000011 3777 INXR, INBUFR-1 /XR USED TO GET CHARS FROM INPUT LINE 000012 0000 XR, 0 000013 0000 XR1, 0 0015 *15 000015 0062 VVERS, XVERSN /VERSION FLAG 000016 0000 VEOFSW, 0 /USED BY "EOFCHK" TO STORE VARIABLE ADDRESS 000017 0000 0 /*K* MUST BE IN AUTO - XR 000020 0000 T, 0 /TEMPORARY 000021 0000 DFLG, 0 /0 = F.P., 1 = D.P. 000022 0000 INST, 0 /CURRENT INSTRUCTION WORD /IOH PAGE ZERO LOCATIONS 000023 0000 RWFLAG, 0 /READ/WRITE FLAG 000024 0000 FMTTYP, 0 /TYPE OF CONVERSION BEING DONE 000025 0000 EOLSW, 0 /EOL SW ON INPUT - CHAR POS ON OUTPUT 000026 0000 N, 0 /REPEAT FACTOR 000027 0000 W, 0 /FIELD WIDTH 000030 0000 D, 0 /NUMBER OF PLACES AFTER DECIMAL POINT 000031 0000 DATCDF, 0 /SUBROUTINE TO CHANGE DATA FIELD 000032 0000 DATAF, 0 /CONTAINS VARIOUS CDF'S 000033 5431 JMP I DATCDF /RETURN 000034 5011 ERR, ERROR /POINTER TO ERROR ROUTINE 000035 0000 FATAL, 0 /FATAL ERROR FLAG - 0=FATAL 000036 4755 MCDF, MAKCDF /FPP PARAMETER TABLE LOCATIONS: 000037 0000 APT, 0 /VARIOUS FIELD BITS FOR FPP 000040 5333 PC, DPTEST /FPP PROGRAM COUNTER 000041 0000 XRBASE, 0 /FPP INDEX REGISTER ARRAY ADDRESS 000042 0000 BASADR, 0 /FPP BASE PAGE ADDRESS 000043 0000 ADR, 0 /ADDRESS TEMPORARY 000044 0000 ACX, 0 000045 0000 ACH, 0 /*** FLOATING ACCUMULATOR *** 000046 0000 ACL, 0 000047 0000 EAC1, 0 000050 0000 EAC2, 0 /** FOR EXTENDED PRECISION OPTION ** /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 5-1 000051 0000 EAC3, 0 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 6 /FLOATING POINT PACKAGE LOCATIONS 000052 0000 AC0, 0 000053 0000 AC1, 0 /FLOATING AC OVERFLOW WORD 000054 0000 AC2, 0 /OPERAND OVFLOW WORD 000055 0000 OPX, 0 000056 0000 OPH, 0 /*** FLOATING OPERAND REGISTER *** 000057 0000 OPL, 0 /RTS I/O CONVERSION SYSTEM LOCATIONS 000060 0000 FMTBYT, 0 /FORMAT BYTE POINTER 000061 0000 IFLG, 0 /I FOEMAT FLAG 000062 0000 GFLG, 0 /G FORMAT FLAG 000063 0000 EFLG, 0 /E FORMAT FLAG - SOMETIMES ON FOR G FMT 000064 0000 OD, 0 000065 0000 SCALE, 0 000066 0000 PFACT, 0 /P-SCALE FACTOR 000067 0000 PFACTX, 0 /TEMP FOR PFACT 000070 0000 ACI, 0 /INTEGERIZED FAC FROM "FFIX" SUBR 000071 0000 CHCH, 0 000072 0000 FMTNUM, 0 /CONTAINS ACCUMULATED NUMERIC VALUE 000073 0000 CTCINH, 0 /^C INHIBIT FLAG 000074 0000 LOGUNT, 0 /DSRN POINTER - ONLY USED FROM ONE PAGE! 000075 0271 PTTY, TTY /POINTER TO TTY HANDLER - USED BY LDDSRN 000076 0000 0 / SO FORMS CONTROL WILL WORK ON UNIT 0 000077 6001 FPNXT, ICYCLE /USED AS INTERPRETER ADDRESS IF NO FPP /DSRN IMAGE 000100 0000 HAND, 0 /HANDLER ENTRY POINT 000101 0000 HCODEW, 0 /HANDLER LOAD ADDR & FIELD + IOFFLG + FORMS CTL FLG 000102 0000 BADFLD, 0 /BUFFER ADDRESS AND FIELD 000103 0000 CHRPTR, 0 /ACTUALLY A WORD POINTER 000104 0000 CHRCTR, 0 /COUNTER - RANGES FROM -3 TO -1 000105 0000 STBLK, 0 /STARTING BLOCK OF FILE 000106 0000 RELBLK, 0 /CURRENT RELATIVE BLOCK NUMBER 000107 0000 TOTBLK, 0 /LENGTH OF FILE 000110 0000 FFLAGS, 0 /FILE FLAGS: /BIT 0 - "HAS BEEN WRITTEN" FLAG /BITS 1-2 - FORMATTED/UNFORMATTED FLAGS /BIT 11 - "END-FILED" FLAG 000111 0000 BUFFLD, 0 /ROUTINE TO SET DF TO BUFFER FIELD 000112 7402 BUFCDF, HLT 000113 5511 JMP I BUFFLD 000114 1400 FADD1, FADD+LONG /FPP CODE TO ADD 1.0 TO FAC 000115 2171 ONE /AND FALL INTO STORE CODE 000116 0000 FGPBF, 0 /THESE THREE WORDS ARE USED 000117 0000 BIOPTR, 0 /TO FETCH AND STORE FLOATING POINT NUMBERS 000120 0000 FEXIT /FROM RANDOM MEMORY /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 7 IFNZRO .-121 < MXERR, _ /'USR' NEEDS NEXT 5 > 000121 0000 VMAXCR, 0 /USED BY *USR* 000122 0000 VBOTHN, 0 000123 0000 0 /15 BIT BOTTOM OF HANDLERS 000124 0000 VTOPBF, 0 000125 0000 0 /15 BIT TOP OF BUFFERS 0200 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 8 /STARTUP CODE 000200 2203 FTEMP2, ISZ .+3 /ALSO USED AS I/O F.P. TEMPORARY 000201 6213 CDF CIF 10 000202 5603 JMP I .+1 000203 2200 VDATE, RTSLDR /USED TO STORE OS/8 DATE /RTS ENTRY POINTS - "VERSION INDEPENDENT" 000204 5777 VUERR, JMP I (USRERR /USER ERROR /** LOADER MUST DEFINE #ARGER AS VARGER-1 ** 000205 5776 VARGER, JMP I (LARGER /LIBRARY ARGUMENT ERROR 000206 2023 VRENDO, ISZ RWFLAG /END OF I/O LIST 000207 5634 VRFSV, JMP I GETLMN /I/O LIST ARG ENTRY - COROUTINE WITH GETLMN 000210 5775 VBAK, JMP I (BKSPC /"BACKSPACE" ROUTINE 000211 5774 VENDF, JMP I (ENDFL /"END FILE" ROUTINE 000212 5773 VREW, JMP I (RWIND /"REWIND" ROUTINE 000213 5772 VDEF, JMP I (DFINE /"DEFINE FILE" ROUTINE 000214 7330 VWUO, AC4000 /UNFORMATTED WRITE 000215 5771 VRUO, JMP I (RWUNF /UNFORMATTED READ 000216 7330 VWDAO, AC4000 /DIRECT ACCESS WRITE 000217 5770 VRDAO, JMP I (RWDACC /DIRECT ACCESS READ 000220 7330 VWRITO, AC4000 /FORMATTED (ASCII) WRITE 000221 5767 VREADO, JMP I (RWASCI /FORMATTED (ASCII) READ 000222 5766 VSWAP, JMP I (SWAP /OVERLAY PROCESSOR 000223 3000 VEXIT, TRAP3; CALXIT /"STOP" ROUTINE - ENTERED IN FPP MODE 000224 1312 000225 0000 V8OR12, 0;0 /0;1 IF CPU IS A PDP-12 000226 0000 000227 5227 VBACKG, JMP . /BACKGROUND JOB DISPATCHER ?HUH? 000230 0000 0 000231 6203 CDF CIF 0 /USED BY ROUTINE "ONQB" IN LIBRARY 000232 4630 JMS I .-2 000233 5227 JMP VBACKG /IOH GET VARIABLE ROUTINE. /THIS ROUTINE MAKES THE FORMATTED I/O PROCESSOR AND THE USER'S /PROGRAM CO-ROUTINES (DEF(COROUTINE)= 2 ROUTINES EACH THINKING THE OTHER / IS A SUBROUTINE). ON ENTRY FAC=INPUT NUMBER /IF I/O IS A READ, ON RETURN FAC=OUTPUT NUMBER IF I/O IS A WRITE. 000234 0000 GETLMN, 0 000235 5577 VRETRN, JMP I [RETURN /SHORT ROUTINE FOR ALL THOSE COMMENTS, NO? /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 9 /INTERRUPT DRIVEN I/O HANDLERS 000236 0000 LPT, 0 /RING-BUFFERED - DKC8AA 000237 0176 AND [377 /JUST IN CASE 000240 7450 LPTSNA, SNA 000241 5765 JMP I (IOERR /CANNOT BE USED FOR INPUT 000242 6002 YLPT, IOF 000243 3670 DCA I LPPUT 000244 1003 TAD LPGET 000245 7041 CIA 000246 1270 TAD LPPUT 000247 7640 SZA CLA /IS LPT QUIET? 000250 5254 JMP .+4 /NO 000251 1670 TAD I LPPUT 000252 7040 CMA /NEGATIVE LOGIC 000253 6574 6574 /YES - START 'ER UP 000254 6575 6575 /ENABLE LPT INTERRUPTS 000255 7324 AC0001 000256 1270 TAD LPPUT /1 IN AC 000257 3270 DCA LPPUT 000260 1670 TAD I LPPUT 000261 7510 SPA 000262 5257 JMP .-3 /NEGATIVE NUMBERS ARE BUFFER LINKS 000263 7640 SZA CLA /ANY ROOM LEFT IN BUFFER? 000264 4764 JMS I (HANG 000265 0437 LPUHNG /WAIT FOR LINE PRINTER 000266 6001 ION /TURN INTERRUPTS BACK ON 000267 5636 JMP I LPT /RETURN 000270 6600 LPPUT, LPBUFR /*K* THE FOLLOWING ADDRESSES GET FALLEN INTO & MUST BE SMALL IFNZRO TTUHNG&7000 <__ERROR__> IFNZRO KBUHNG&7000 <__ERROR__> IFNZRO LPUHNG&7000 <__ERROR__> IFNZRO QSUHNG&7000 <__ERROR__> /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 10 /INTERRUPT-DRIVEN TELETYPE HANDLER 000271 0000 TTY, 0 /BUFFERS 2 CHARS ON OUTPUT, 1 ON INPUT 000272 6002 YTTY, IOF /DELICATE CODE AHEAD 000273 7450 SNA /INPUT OR OUTPUT? 000274 5335 JMP KBD /INPUT 000275 3236 DCA LPT /OUTPUT - SAVE CHAR 000276 1007 TAD QSINH /WAS THERE A XOFF LOCK ? 000277 7640 SZA CLA / 000300 4764 JMS I (HANG /YES, HANG ON XON WAKE-UP 000301 0500 QSUHNG 000302 1004 TAD TOCHR /GET TTY STATUS 000303 7740 SMA SZA CLA /G.T. 0 MEANS A CHAR IS BACKED UP 000304 4764 JMS I (HANG 000305 0452 TTUHNG /WAIT FOR LOG JAM TO CLEAR 000306 1004 TAD TOCHR /NO CHAR BACKED UP - SEE IF TTY BUSY 000307 7104 CLL RAL /"BUSY" FLAG IN LINK - INTERRUPTS ARE OFF! 000310 7230 CLA CML RAR /COMPLEMENT OF BUSY IN SIGN 000311 1236 TAD LPT /GET CHAR 000312 7510 SPA /IF TTY NOT BUSY, 000313 6046 TLS /OUTPUT CHAR 000314 3004 DCA TOCHR /STORE POS OR NEG, BACKED UP OR BUSY 000315 6001 TTYRET, ION /TURN INTERRUPTS BACK ON 000316 5671 JMP I TTY /AND LEAVE 000317 0000 CORHAN, 0 /ENCODE & DECODE: CHANNEL #1 000320 7450 SNA /IS IT DECODE? 000321 5324 JMP CORIN /YES, IT'S NOT A GIRL 000322 3734 DCA I CORPNT /STORE ENCODE ITEM 000323 7410 SKP 000324 1734 CORIN, TAD I CORPNT /GET DECODE ITEM 000325 3271 DCA TTY /SAVE A WHILE 000326 1734 TAD I CORPNT /GET LAST ITEM TO 000327 4763 JMS I (CORCHK /CHECK ON OVERFLOW AND EOL 000330 7440 SZA /NEW START ? 000331 3334 DCA CORPNT /YES 000332 1271 TAD TTY /GET DECODE ITEM OR 0 000333 5717 JMP I CORHAN 000334 7400 CORPNT, CORREC /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 11 000335 1005 KBD, TAD KBDCHR /HAS A CHARACTER BEEN INPUT? 000336 7650 SNA CLA 000337 4764 JMS I (HANG 000340 0473 KBUHNG /NO - RUN BACKGROUND UNTIL ONE IS 000341 1005 TAD KBDCHR /GET CHARACTER 000342 3236 DCA LPT 000343 3005 DCA KBDCHR /CHEAR CHARACTER BUFFER 000344 1236 TAD LPT 000345 5315 JMP TTYRET /RETURN WITH INTERRUPTS ON 000346 6554 KILFPP, FPHLT /BRING FPP TO A SCREECHING HALT 000347 6552 FPICL /CLEAN UP MESS HALT HAS MADE IN FPP 000350 7430 BEEORC, SZL /^C OR ^B? 000351 5762 JMP I (7600 /^C - HIYO SILVER, AWAY! 000352 6032 KCC /CLEAR KBD FLAG ON ^B 000353 4434 CTLBER, JMS I ERR /*** THIS MAY BE DANGEROUS! ** 000354 0125 CTLBMS-ERRMSG 000362 7600 000363 3760 000364 0524 000365 3346 000366 3600 000367 0600 000370 3455 000371 3400 000372 3531 000373 1447 000374 1467 000375 1600 000376 4743 000377 4745 0400 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 12 /INTERRUPT SERVICE ROUTINES 000400 3322 INTRPT, DCA INTAC 000401 7010 RAR 000402 3323 DCA INTLNK IFNZRO .-403 <VERR, ___ / CHANGE LOADER!!!> 000403 5207 VINT, JMP .+4 /** MUST BE AT 403 ** 000404 0000 0 000405 6203 CDF CIF 0 /USER INTERRUPT ROUTINE GOES HERE 000406 4604 JMS I .-2 000407 6551 FPINT /CHECK FOR FPP DONE 000410 5215 JMP LPTEST 000411 5314 FPUHNG, JMP DISMIS /ALWAYS GOES TO RESTRT IFNZRO .-412 <VERR, ___ / CHANGE LOADER!!!> 000412 5314 VDISMS, JMP DISMIS /FOR USE BY USERS 000413 5314 JMP DISMIS 000414 5314 JMP DISMIS 000415 6570 LPTEST, 6570 000416 5241 JMP NOTLPT 000417 1403 LPTLCF, TAD I LPGET 000420 7650 SNA CLA /CHECK FOR SPURIOUS INTERRUPT 000421 5314 JMPDIS, JMP DISMIS /GO AWAY IF SO 000422 3403 DCA I LPGET /ZERO CHAR JUST OUTPUT 000423 2003 ISZ LPGET 000424 1403 TAD I LPGET 000425 7510 SPA 000426 3003 DCA LPGET /TAKE CARE OF BUFFER LINKS 000427 7450 SNA 000430 1403 TAD I LPGET /MAKE SURE CHAR IS IN AC 000431 7450 SNA /IS THERE A CHARACTER? 000432 5235 JMP .+3 000433 7040 CMA /NEGATIVE LOGIC 000434 6574 6574 /YES - PRINT IT 000435 7200 CLA 000436 6570 6570 /CHECK FOR IMMEDIATE FLAG 000437 5314 LPUHNG, JMP DISMIS /NO - MAYBE RESTART PROGRAM 000440 5217 JMP LPTLCF /YES - LOOP 000441 6041 NOTLPT, TSF /CHECK TTY 000442 5253 JMP NOTTTY 000443 6042 TCF /CLEAR FLAG 000444 1004 TAD TOCHR /GET TTY STATUS 000445 7540 SMA SZA /IF THERE IS A CHARACTER WAITING, 000446 6046 TLS /OUTPUT IT. 000447 7740 SMA SZA CLA /CHANGE "WAITING" TO "BUSY", 000450 7130 STL RAR /"BUSY" TO "IDLE". 000451 3004 DCA TOCHR 000452 5314 TTUHNG, JMP DISMIS /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 13 /KBD INTERRUPTS 000453 6031 NOTTTY, KSF 000454 5311 JMP LPTERR 000455 1175 TAD [200 000456 6034 KRS /USE KRS TO FORCE PARITY BIT 000457 3005 DCA KBDCHR /AND ALSO SO THAT ^C WILL STILL BE IN BUFFER IN OS/8 000460 1005 TAD KBDCHR 000461 1377 TAD (-202 /CHECK FOR ^C OR ^B 000462 7110 CLL RAR 000463 7450 SNA 000464 5301 JMP CTCCTB /YUP - TAKE SOME DRASTIC ACTION 000465 7004 RAL 000466 1006 TAD TTM17 /CHAR - 221 (^Q) 000467 7112 CLL RTR /IF ^S (223) PUT IT IN LINK 000470 7650 SNA CLA /IS IT ^Q OR ^S ? 000471 5274 JMP TTQS /YES 000472 6032 KCC /DATA CHARACTER - CLEAR FLAG 000473 5314 KBUHNG, JMP DISMIS 000474 7004 TTQS, RAL /^S BIT BACK TO AC 000475 3007 DCA QSINH /YES, SET TTYOUT INHIBIT 000476 3005 DCA KBDCHR /AND ZAP THE CHAR 000477 6032 KCC /AND THE FLAG 000500 5314 QSUHNG, JMP DISMIS /RESTART ON HANG 000501 1073 CTCCTB, TAD CTCINH 000502 7650 SNA CLA /ARE WE IN A HANDLER? 000503 5366 JMP NOTINH /NO 000504 1323 TAD INTLNK 000505 7104 CLL RAL /YES - RETURN WITH INTERRUPTS OFF 000506 1322 TAD INTAC /TRUST IN GOD AND RTS 000507 6244 RMF 000510 5400 JMP I 0 000511 6571 LPTERR, 6571 /CLEAR DKC8 INPUT CHANNEL 000512 7410 SKP 000513 6573 6573 000514 1323 DISMIS, TAD INTLNK 000515 7104 CLL RAL 000516 1322 TAD INTAC /RESTORE AC AND LINK 000517 6244 RMF 000520 6001 ION 000521 5400 JMP I 0 /RETURN FROM THE INTERRUPT 000522 0000 INTAC, 0 000523 0000 INTLNK, 0 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 14 /BACKGROUND INITIATE/TERMINATE ROUTINE IFZERO .-0525&4000 <VERR, ___ / CHANGE LOADER!!!> 0524 VHANG= HANG 0524 *524 /FOR LOADER!! VHANG 000524 0000 HANG, 0 /ALWAYS CALLED WITH INTERRUPTS OFF! 000525 1724 TAD I HANG /GET POINTER TO UNHANGING LOCATION 000526 3371 DCA UNHANG 000527 6214 RDF /GET FIELD CALLED FROM 000530 1332 TAD HCIDF0 000531 3364 DCA HNGCDF /SAVE FOR RETURN 000532 6203 HCIDF0, CDF CIF 0 000533 1376 TAD (JMP RESTRT /CHANGE THE "JMP DISMIS" AT THAT LOC 000534 3771 DCA I UNHANG /TO A "JMP RESTRT" 000535 1373 TAD BACKLK 000536 7104 CLL RAL 000537 1372 TAD BACKAC /SET UP BACKGROUND AC AND LINK 000540 6202 BAKCIF, CIF 0 000541 6201 BAKCDF, CDF 0 000542 6001 ION 000543 5774 JMP I BACKPC /INITIATE BACKGROUND / COME HERE WHEN THE HANG CONDITION HAS GONE AWAY 000544 1221 RESTRT, TAD JMPDIS /RESTORE THE UNHANG LOCATION 000545 3771 DCA I UNHANG 000546 1322 TAD INTAC /SUSPEND THE BACKGROUND 000547 3372 DCA BACKAC 000550 1323 TAD INTLNK 000551 3373 DCA BACKLK 000552 1000 TAD 0 000553 3374 DCA BACKPC 000554 6234 RIB 000555 0174 AND [70 000556 1332 TAD HCIDF0 000557 3340 DCA BAKCIF 000560 6234 RIB 000561 4436 JMS I MCDF /*K* OK SINCE BACKGROUND DOESN'T USE MAKCDF 000562 3341 DCA BAKCDF 000563 2324 ISZ HANG 000564 7402 HNGCDF, HLT 000565 5724 JMP I HANG /INTERRUPTS ARE OFF - RETURN 000566 1221 NOTINH, TAD JMPDIS /IN CASE WE WERE HUNG, WE DON'T WANT 000567 3771 DCA I UNHANG /TO GET "UNHUNG" OUT OF THE ERROR ROUTINE! 000570 5775 JMP I (KILFPP /KILL FPP AND GO TO EXIT OR ERROR 000571 0000 UNHANG, 0 000572 0000 BACKAC, 0 000573 0000 BACKLK, 0 000574 0227 BACKPC, VBACKG 000575 0346 000576 5344 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 14-1 000577 7576 0600 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 15 /I-O CONVERSION ROUTINES - STARTUP CODE 000600 4573 RWASCI, JMS I [RWINIT /"READ(N,FMT)" OR "WRITE(N,FMT)" 000601 2000 2000 /"FORMATTED" BIT 000602 4572 JMS I [FETPC /GET ADDRESS OF FORMAT STMT 000603 3323 DCA FMTDF 000604 4572 JMS I [FETPC 000605 3273 DCA FMTADR 000606 3024 DCA FMTTYP 000607 3066 DCA PFACT /CLEAR SCALE FACTOR 000610 4571 JMS I [GETLMN /EXIT TO MAIN PROGRAM TO GET 1ST VARIABLE 000611 1377 TAD (FMTPDL-1 000612 3010 FMTSET, DCA FMTPXR /STORE NEW FORMAT PUSHDOWN POINTER 000613 1410 TAD I FMTPXR 000614 3060 DCA FMTBYT /GET NEW BYTE POINTER (NOTE-FMTPDL CONTAINS A 0) /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 16 /MAIN FORMAT DECODING LOOP 000615 1060 FMTFLP, TAD FMTBYT 000616 3362 DCA FMPBYT /SAVE CURRENT BYTE PTR FOR PARENTHESES HACK 000617 3072 FMTDLP, DCA FMTNUM /ZERO ACCUMULATED NUMBER 000620 4274 FMTCLP, JMS FMTGCH /GET A CHARACTER 000621 2060 ISZ FMTBYT /BUMP BYTE POINTER 000622 4570 JMS I [CHTYPE /CLASSIFY CHAR 000623 1063 INDDOF, DOFMT; FMTDIG /DIGIT *K* DOFMT IS POSITIVE 000624 0724 000625 7736 -42; DBLQOT /" 000626 1001 000627 7734 -44; ABORTO /$ 000630 1166 000631 7723 -55; FMINUS /- 000632 1157 000633 7722 -56; FMTPER /. 000634 1163 000635 7721 -57; SLASH // 000636 1144 000637 7724 -54; COMMA /, 000640 0671 000641 7730 -50; LPAREN /( 000642 0732 000643 7727 -51; RPAREN /) 000644 0763 000645 7731 -47; KWOTE /' 000646 1000 000647 7740 -40; FMTCLP /SPACE 000650 0620 000651 0000 0 /ANYTHING ELSE 000652 1024 TAD FMTTYP 000653 7640 SZA CLA /CHECK THAT WE DO NOT HAVE A FIELD OUTSTANDING 000654 5776 JMP I (FMTERR /IF WE DO - ERROR 000655 1071 TAD CHCH /GET FIELD CHARACTER 000656 3024 DCA FMTTYP 000657 1072 TAD FMTNUM 000660 7450 SNA /IF REPEAT COUNT WAS MISSING OR ZERO 000661 7001 IAC /MAKE IT ONE 000662 7040 CMA 000663 3026 DCA N /STORE -(REPEAT COUNT +1) 000664 3027 DCA W /CLEAR WIDTH INITIALLY 000665 2072 ISZ FMTNUM /PRECLUDE "FORMAT ERROR" ON X,P, OR H FORMATS 000666 1024 TAD FMTTYP 000667 0167 AND [7 /IS THE CHARACTER P, X, OR H? 000670 7650 SNA CLA /IF SO, DON'T WAIT 000671 4623 COMMA, JMS I INDDOF /EXECUTE THE STORED FIELD SPECIFICATION 000672 5215 JMP FMTFLP /BACK FOR MORE 000673 0000 FMTADR, 0 /ADDRESS OF FORMAT /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 17 000674 0000 FMTGCH, 0 /GET CHARACTER FROM FORMAT 000675 4303 JMS FMTGAD /GET WORD CONTAINING CHAR AND L/R SWITCH 000676 6201 CDF 0 000677 7420 SNL 000700 7002 BSW /LEFT HALF - SWAP INTO RIGHT HALF 000701 0166 AND [77 000702 5674 JMP I FMTGCH 000703 0000 FMTGAD, 0 /SUBR TO GET A WORD FROM A CHARACTER OFFSET 000704 1060 TAD FMTBYT /GET OFFSET 000705 7110 CLL RAR 000706 7100 CLL 000707 1273 TAD FMTADR /COMPUTE BASE ADDR + [OFFSET/2] 000710 3030 DCA D 000711 7004 RAL 000712 1323 TAD FMTDF 000713 4436 JMS I MCDF /SET UP PROPER DATA FIELD 000714 3315 DCA .+1 000715 7402 HLT 000716 1060 TAD FMTBYT 000717 7010 RAR 000720 7200 CLA /LEAVE L/R SWITCH IN LINK 000721 1430 TAD I D 000722 5703 JMP I FMTGAD /RETURN WITH WORD IN AC 000723 0000 FMTDF, 0 /FIELD OF 1ST CHAR OF FORMAT IN BITS 9-11 000724 1072 FMTDIG, TAD FMTNUM /DIGIT PROCESSOR 000725 7106 CLL RTL 000726 1072 TAD FMTNUM 000727 7104 CLL RAL /MULTIPLY FMTNUM BY 10 000730 1071 TAD CHCH /ADD IN THE DIGIT 000731 5217 JMP FMTDLP /STORE IT BACK AND CONTINUE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 18 /PARENTHESIS AND DIGIT ROUTINES 000732 1010 LPAREN, TAD FMTPXR 000733 1375 TAD (2-FMTPDL 000734 7440 SZA /ARE WE AT PARENTHESIS LEVEL 1? 000735 5340 JMP .+3 /NO 000736 1362 TAD FMPBYT /YES - STORE A POINTER TO THE FIRST DIGIT OF THE 000737 3774 DCA I (FMTPDL-2 /GROUP COUNT PRECEDING THIS PAREN /AS THE LOOP POINTER FOR LEVEL 1 000740 1167 TAD [7 000741 7710 SPA CLA /PUSHDOWN OVERFLOW? 000742 4434 FPOERR, JMS I ERR /YES 000743 0012 FPOMSG-ERRMSG 000744 7346 AC7775 000745 1010 TAD FMTPXR 000746 3010 DCA FMTPXR /BUMP PARENTHESIS PUSHDOWN POINTER 000747 1060 TAD FMTBYT 000750 3410 DCA I FMTPXR /SAVE BYTE POINTER 000751 1072 TAD FMTNUM 000752 7450 SNA 000753 7001 IAC /NO GROUP COUNT MEANS COUNT = 1 000754 7041 CIA 000755 3410 DCA I FMTPXR /SAVE LOOP COUNT 000756 3777 DCA I (FMTPDL-1 /INITIAL GROUP COUNT IS INFINITE! 000757 7344 RPLOOP, AC7776 /COME HERE ON RIGHT PAREN ALSO 000760 1010 TAD FMTPXR /BACK UP FORMAT PDL POINTER 000761 5212 JMP FMTSET /RESTORE FMTBYT FROM TOP OF LIST 000762 0000 FMPBYT, 0 000763 4623 RPAREN, JMS I INDDOF /EXECUTE PREVIOUS SPEC IF ANY 000764 1010 TAD FMTPXR 000765 1375 TAD (2-FMTPDL /IS THIS THE FINAL RIGHT PAREN? 000766 7650 SNA CLA 000767 4565 JMS I [ENDREC /YES - CHECK FOR END OF FORMAT 000770 2410 ISZ I FMTPXR /BUMP COUNT 000771 5357 JMP RPLOOP /DIDN'T OVERFLOW - LOOP TO BYTE AFTER ( 000772 2010 ISZ FMTPXR /POP UP PARENTHESES STACK 000773 5215 JMP FMTFLP /CONTINUE PAST RIGHT PAREN 000774 4375 000775 3403 000776 1133 000777 4376 1000 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 19 /QUOTE AND HOLLERITH FORMAT PROCESSORS 001000 1322 KWOTE, TAD MINUS5 /APOSTROPHE PROCESSOR 001001 1377 DBLQOT, TAD (-42 /QUOTE PROCESSOR 001002 3255 DCA KWODEL /SAVE TERMINATOR 001003 4263 JMS DOFMT /PROCESS PRECEDING FIELD , IF ANY 001004 7410 SKP 001005 4223 KWOTLP, JMS FMTHCV /PROCESS ONE CHARACTER 001006 4564 JMS I [FMTGCH /GET THE NEXT FORMAT CHAR 001007 1255 TAD KWODEL 001010 7640 SZA CLA /IS IT THE TERMINATOR? 001011 5205 JMP KWOTLP /NO - PROCESS IT AND CONTINUE 001012 2060 ISZ FMTBYT /BUMP OVER TERMINATOR 001013 4564 JMS I [FMTGCH 001014 1255 TAD KWODEL 001015 7650 SNA CLA /IS THIS ANOTHER TERMINATOR? 001016 5205 JMP KWOTLP /TWO TERMINATORS PRINT AS ONE 001017 5776 JMP I (FMTFLP /OTHERWISE GO BACK TO FORMAT LOOP 001020 4256 HFMT, JMS MORE /MORE CHARACTERS? 001021 4223 JMS FMTHCV /YES - PROCESS ONE 001022 5220 JMP HFMT /AND LOOP 001023 0000 FMTHCV, 0 /ROUTINE COMMON TO H AND QUOTED FORMATS 001024 1023 TAD RWFLAG /PROCESSES ONE CHAR IN OR OUT OF THE FORMAT 001025 7700 H7700, SMA CLA /IN OR OUT? 001026 5232 JMP FMTHIN /IN 001027 4564 JMS I [FMTGCH /OUT - GET THE CHAR 001030 4563 JMS I [FMTOUT /PRINT IT 001031 5253 JMP FMTHCR /RETURN 001032 4562 FMTHIN, JMS I [FMTIN /INPUT - GET THE CHAR FROM THE INPUT LINE 001033 3027 DCA W /SAVE IT 001034 4775 JMS I (FMTGAD 001035 7430 SZL /WHICH SIDE? 001036 5247 JMP FHRGHT /RIGHT SIDE 001037 0166 AND [77 /LEFT - KEEP RIGHT CHAR 001040 3256 DCA MORE 001041 1027 TAD W 001042 7106 CLL RTL 001043 7006 RTL 001044 7006 RTL 001045 1256 TAD MORE /ADD NEW CHAR IN ON THE LEFT 001046 5251 JMP .+3 001047 0225 FHRGHT, AND H7700 /KEEP THE CHAR ON THE LEFT 001050 1027 TAD W /ADD NEW CHAR IN ON THE RIGHT 001051 3430 DCA I D /RESTORE ALTERED WORD 001052 6201 CDF 0 001053 2060 FMTHCR, ISZ FMTBYT /BUMP BYTE POINTER 001054 5623 JMP I FMTHCV 001055 0000 KWODEL, 0 /MUST BE UNIQUE! /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 20 001056 0000 MORE, 0 /SUBR TO BUMP REPEAT COUNT AND EXIT ON OVFLO 001057 2026 ISZ N 001060 5656 JMP I MORE 001061 3024 DOFRTN, DCA FMTTYP /INDICATE NO SPECIFICATION COLLECTED 001062 5663 JMP I DOFMT /RETURN FROM "DOFMT" 001063 0000 DOFMT, 0 /ROUTINE TO PROCESS A FORMAT SPECIFICATION 001064 1072 TAD FMTNUM /GET THE CURRENT NUMBER 001065 3030 DCA D /STORE IT AS DECIMAL POINT SPEC 001066 3061 DCA IFLG 001067 3063 DCA EFLG 001070 3062 DCA GFLG /ZERO CONVERSION FLAGS 001071 1024 TAD FMTTYP 001072 7650 SNA CLA /ANY SPECIFICATION WAITING? 001073 5663 JMP I DOFMT /NO - JUST RETURN 001074 1027 TAD W 001075 1030 TAD D /IF THERE WAS NO W OR D SPECIFICATION, 001076 7650 SNA CLA 001077 5333 JMP FMTERR /ITS AN ERROR 001100 1024 TAD FMTTYP 001101 4570 JMS I [CHTYPE /YES - WHICH ONE? 001102 7750 -30; XFMT /X 001103 2610 001104 7754 -24; TFMT /T 001105 2660 001106 7760 -20; PFMT /P 001107 1147 001110 7764 -14; LFMT /L 001111 2642 001112 7767 -11; IFMT /I 001113 2000 001114 7770 -10; HFMT /H 001115 1020 001116 7771 -7; GFMT /G 001117 2006 001120 7772 -6; FFMT /F 001121 2014 001122 7773 MINUS5, -5; EFMT /E 001123 2010 001124 7774 -4;DF, EFMT /D - EQUIVALENT TO E IF NO D.P. FPP 001125 2010 001126 7776 -2;BF, FFMT /B - EQUIVALENT TO F IF NO D.P. FPP 001127 2014 001130 7777 -1; AFMT /A 001131 1264 001132 0000 0 /NONE OF THE ABOVE - ERROR 001133 4434 FMTERR, JMS I ERR 001134 0022 FMTMSG-ERRMSG /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 21 001135 0000 ENDREC, 0 /ROUTINE TO END A LINE AND MAYBE THE I/O 001136 4561 JMS I [EOLINE 001137 7324 AC0001 001140 0023 AND RWFLAG /LO BIT OF RWFLAG IS "I/O LIST EXHAUSTED" FLAG 001141 7650 SNA CLA /SKIP IF NO MORE ELEMENTS IN I/O LIST 001142 5735 JMP I ENDREC 001143 5560 JMP I [ENDIO /NOW FINISH UP AND LEAVE 001144 4263 SLASH, JMS DOFMT /EXECUTE THE FIELD SPEC IF ANY 001145 4561 JMS I [EOLINE /TERMINATE CURRENT LINE 001146 5776 JMP I (FMTFLP 001147 7340 PFMT, AC7777 001150 1072 TAD FMTNUM 001151 2362 ISZ MINFLG /P FORMAT - CHECK FOR NEGATIVE SCALE 001152 7041 CIA 001153 3066 DCA PFACT 001154 7340 AC7777 /FALL INTO CODE TO CLEAR MINFLG 001155 3362 DCA MINFLG /SET FLAG ON MINUS 001156 5261 JMP DOFRTN 001157 4263 FMINUS, JMS DOFMT /EXECUTE PRECEDING SPEC 001160 3362 DCA MINFLG /CLEAR MINUS FLAG 001161 5776 JMP I (FMTFLP 001162 7777 MINFLG, -1 001163 1072 FMTPER, TAD FMTNUM /PERIOD PROCESSOR 001164 3027 DCA W /STORE WIDTH 001165 5776 JMP I (FMTFLP 001166 4263 ABORTO, JMS DOFMT /$ - SPECIAL HACK TO ALLOW PROMPTS 001167 3025 DCA EOLSW /FAKE BEGINNING OF LINE 001170 3774 DCA I (TTYLF /INHIBIT LF BEFORE NEXT TTY INPUT 001171 5560 JMP I [ENDIO /GO AWAY 001174 3026 001175 0703 001176 0615 001177 7736 1200 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 22 001200 0000 CHTYPE, 0 /ROUTINE TO CLASSIFY CHARACTERS 001201 3071 DCA CHCH /SAVE CHAR 001202 5212 JMP CHLOOP+1 001203 1071 CDIGIT, TAD CHCH /CHECK FOR DIGIT 001204 1377 TAD (-72 001205 7100 CLL 001206 1157 TAD [12 001207 7430 SZL /IS CHAR A DIGIT? 001210 5222 JMP JMPOUT /YES 001211 2200 CHLOOP, ISZ CHTYPE /SKIP OVER ADDRESS 001212 7200 CLA 001213 1600 TAD I CHTYPE 001214 2200 ISZ CHTYPE 001215 7500 SMA /END OF LIST? 001216 5225 JMP JMPOTX /MAYBE - JUMP WITH CODE IN AC 001217 1071 TAD CHCH 001220 7640 SZA CLA /DOES CHAR MATCH CHAR ON LIST? 001221 5211 JMP CHLOOP /NO - KEEP LOOKING 001222 3071 JMPOUT, DCA CHCH /ZERO CHAR 001223 1600 TAD I CHTYPE 001224 3200 DCA CHTYPE /SET UP TO RETURN INDIRECTLY 001225 7640 JMPOTX, SZA CLA /IS THIS THE END? 001226 5203 JMP CDIGIT /NO - GO CHECK FOR DIGIT 001227 5600 JMP I CHTYPE /GO TO SPECIFIED ADDRESS 001230 0000 SKPOUT, 0 /ROUTINE USED BY DATA-HANDLING SPECIFICATIONS 001231 4556 JMS I [MORE /CHECK FOR REPEAT COUNT EXHAUSTED 001232 1023 TAD RWFLAG 001233 7110 CLL RAR 001234 7640 SZA CLA /IF OUTPUT, 001235 2230 ISZ SKPOUT /SKIP RETURN 001236 7630 SZL CLA /IF END OF I/O LIST, 001237 4565 JMS I [ENDREC /DON'T RETURN AT ALL - GO AWAY 001240 5630 JMP I SKPOUT /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 23 /A FORMAT PROCESSOR 001241 1376 AINPUT, TAD (4040 001242 3045 DCA ACH 001243 1376 TAD (4040 001244 3046 DCA ACL /INITIALIZE LOW-ORDER WORDS TO BLANKS 001245 4302 AINPTL, JMS GADR 001246 7430 SZL /LEFT OR RIGHT? 001247 5255 JMP AINPTR /RIGHT 001250 4562 JMS I [FMTIN 001251 7126 STL RTL /INPUT CHAR GOES IN HIGH-ORDER 001252 7006 RTL /WITH BLANK IN LOW-ORDER 001253 7006 RTL 001254 5260 JMP AINPTC 001255 4562 AINPTR, JMS I [FMTIN 001256 1711 TAD I FMTWRD /COMBINE INPUT CHAR AND OLD LEFT HALF 001257 1155 TAD [-40 /DELETE PREVIOUS RIGHT-HALF SPACE 001260 3711 AINPTC, DCA I FMTWRD /STORE WORD 001261 2027 ISZ W 001262 5245 JMP AINPTL /LOOP AROUND WIDTH 001263 4571 ANXT, JMS I [GETLMN /GET NEXT ELEMENT 001264 1030 AFMT, TAD D 001265 7041 CIA 001266 3027 DCA W /SAVE FIELD WIDTH AS A COUNT 001267 4554 JMS I [SKPOUT /CHECK FOR REPEAT COUNT OVFLO AND I/O DIR 001270 5241 JMP AINPUT 001271 4302 AOTPUT, JMS GADR /OUTPUT - GET ADDRESS OF BYTE 001272 1711 TAD I FMTWRD 001273 7420 SNL 001274 7002 BSW /LEFT HALF - SWAP INTO RIGHT HALF 001275 0166 AND [77 001276 4563 JMS I [FMTOUT /PRINT IT 001277 2027 ISZ W 001300 5271 JMP AOTPUT /LOOP ON WIDTH 001301 5263 JMP ANXT 001302 0000 GADR, 0 /BYTE ADDRESS ROUTINE FOR A FORMAT PROCESSOR 001303 1030 TAD D 001304 1027 TAD W /FORM BYTE OFFSET IN THE RANGE 0 THRU D-1 001305 7110 CLL RAR /LEAVE L/R FLAG IN LINK 001306 1375 TAD (ACX 001307 3311 DCA FMTWRD 001310 5702 JMP I GADR /LEAVE 001311 0000 FMTWRD, 0 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 24 /"STOP" ROUTINE - TERMINATES JOB 001312 1346 CALXIT, TAD EXDVNO 001313 7041 CIA 001314 3070 DCA ACI /GO THROUGH THE FORTRAN UNIT NUMBERS. 001315 3774 DCA I (ENDFLS /*K* TURN "ENDFL" INTO A SUBROUTINE 001316 4773 JMS I (LDDSRN /IF WE FIND A UNIT WHICH IS BEING USED 001317 7650 SNA CLA /AND HAS NOT BEEN ENDFILED, 001320 5325 JMP XITISZ /WE WILL DUMP THE CURRENT BUFFER (IF IT 001321 7324 AC0001 /IS A FORMATTED OUTPUT FILE) AND 001322 0110 AND FFLAGS /END-FILE IT 001323 7650 SNA CLA 001324 4772 JMS I (ENDFL 001325 2346 XITISZ, ISZ EXDVNO 001326 5312 JMP CALXIT 001327 1403 LPTTWT, TAD I LPGET /WAIT FOR LINE PRINTER AND TELETYPE TO 001330 1004 TAD TOCHR /GO QUIET. 001331 7640 SZA CLA 001332 5327 JMP LPTTWT 001333 2345 ISZ CLNADR /SET UP TO CLOSE OUTPUT FILES 001334 6002 PDPXIT, IOF /ENTER HERE FROM 7605 001335 6201 CDF 0 /TO PROTECT CLODS WITH PDP 8/E'S 001336 4771 JMS I (7607 001337 0210 0210 001340 7400 7400 /READ IN CLEANUP ROUTINE 001341 0037 37 /AND OS/8 PAGE 17600 001342 5335 JMP .-5 /AYEEEE!! SYSTEM DEVICE GONZO! 001343 6213 CDF CIF 10 001344 5745 JMP I CLNADR /CLOSE TENTATIVE FILES AND EXIT 001345 7400 CLNADR, CLNUP 001346 7767 EXDVNO, -11 001347 0000 ARGLD, 0 /ROUTINE TO GET VALUE OF AN ARG 001350 4572 JMS I [FETPC 001351 0167 AND [7 /THROW AWAY OPCODE (JA) 001352 1361 TAD FLDTM2 001353 3116 DCA FGPBF 001354 4572 JMS I [FETPC /CONSTRUCT AN FPP INSTRUCTION 001355 3117 DCA BIOPTR 001356 4553 JMS I [FPGO 001357 0116 FGPBF 001360 5747 JMP I ARGLD 001361 0400 FLDTM2, FLDA+LONG 001362 0200 FTEMP2 001363 0000 FEXIT 001371 7607 001372 1467 001373 1534 001374 1510 001375 0044 001376 4040 001377 7706 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 24-1 1400 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 25 /SUBROUTINE TO OPEN A UNIT FOR I/O 001400 0000 RWINIT, 0 001401 3023 DCA RWFLAG /DIRECTION IN AC ON ENTRY 001402 7344 AC7776 001403 0600 AND I RWINIT /IF CALLED FROM BACKSPACE, REWIND OR ENDFILE 001404 7640 SZA CLA /UNIT NUMBER IS IN FAC 001405 4552 JMS I [ARGLD /OTHERWISE, GET UNIT NUMBER 001406 4551 JMS I [FFIX 001407 1070 TAD ACI 001410 7140 CLL CMA 001411 1157 TAD [12 001412 7630 SZL CLA /CHECK DEVICE NUMBER IN RANGE 0-9 001413 4334 JMS LDDSRN /LOAD DSRN ENTRY INTO PAGE 0 001414 7650 SNA CLA /IS UNIT INITIALIZED? 001415 4434 UNTERR, JMS I ERR /NO - ERROR 001416 0031 UNTMSG-ERRMSG 001417 1023 TAD RWFLAG 001420 7510 SPA /IF WE ARE WRITEING FOR THE FIRST TIME 001421 1110 TAD FFLAGS /ON A UNIT WHICH WAS BEING READ, 001422 7044 CMA RAL /WE MUST BUMP THE RELATIVE BLOCK NUMBER DOWN 001423 7720 SNL SMA CLA /ONE BECAUSE OF A PHILOSOPHICAL DIFFERENCE 001424 4777 JMS I (RD2WR /BETWEEN READ AND WRITE 001425 1600 TAD I RWINIT 001426 1023 TAD RWFLAG /OR THE I/O TYPE AND 001427 7040 CMA 001430 0110 AND FFLAGS /DIRECTION BITS INTO THE FLAG WORD 001431 1600 TAD I RWINIT 001432 1023 TAD RWFLAG 001433 3110 DCA FFLAGS 001434 1110 TAD FFLAGS 001435 7046 CMA RTL 001436 7720 SNL SMA CLA /IT IS ILLEGAL TO ACCESS A FILE IN 001437 5215 JMP UNTERR /FORMATTED AND UNFORMATTED MODES 001440 2200 ISZ RWINIT 001441 1070 TAD ACI 001442 7104 CLL RAL 001443 1070 TAD ACI 001444 1376 TAD (DATABL-4 001445 3012 DCA XR /STORE POINTER INTO DIRECT-ACCESS TABLE 001446 5600 JMP I RWINIT /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 26 /REWIND AND END FILE 001447 4200 RWIND, JMS RWINIT /GET THE DSRN ENTRY 001450 0000 0 /DON'T PLAY WITH MODES 001451 7332 AC2000 001452 1110 TAD FFLAGS 001453 7650 SNA CLA /IF FORMATTED OUTPUT FILE AND NOT EOF'D 001454 4312 JMS DMPBUF /DUMP LAST BUFFER AS A FAVOR 001455 7324 ATLDMK, AC0001 001456 0110 AND FFLAGS /KILL ALL FLAG BITS 001457 3110 DCA FFLAGS /EXCEPT "END-FILED" BIT 001460 1102 TAD BADFLD 001461 0150 AND [7400 001462 3103 DCA CHRPTR 001463 7346 AC7775 001464 3104 DCA CHRCTR /INITIALIZE BUFFER POINTERS 001465 3106 DCA RELBLK /AND RELATIVE BLOCK # 001466 5560 JMP I [ENDIO /RESTORE DSRN AND EXIT 001467 4200 ENDFL, JMS RWINIT /*K* USED AS A SUBROUTINE BY CALXIT 001470 0001 1 /GET DSRN, SET "END FILE" FLAG 001471 1110 TAD FFLAGS /IF THE FILE IS UNFORMATTED, 001472 7044 CMA RAL /OR WAS NOT OUTPUT ONTO, 001473 7720 SNL SMA CLA /THEN ENDFILE DOES NOTHING. 001474 4312 JMS DMPBUF /ELSE DUMP THE FINAL BUFFER 001475 7350 AC3777 001476 0110 AND FFLAGS /CLEAR WRITE BIT SO WE WILL NOT TRY 001477 3110 SETTOT, DCA FFLAGS /ANYTHING ON A SUBSEQUENT ENDFILE 001500 1106 TAD RELBLK /SET NEW LENGTH OF FILE IN CASE ITS TENTATIVE, 001501 3107 DCA TOTBLK /AND SO WE WON'T READ PAST EOF. 001502 4360 ENDIO, JMS INITMV /SET UP DSRN POINTERS 001503 1413 TAD I XR1 001504 3412 DCA I XR /STORE BACK THE DSRN ENTRY 001505 2020 ISZ T /FOR THIS LOGICAL UNIT 001506 5303 JMP .-3 001507 3016 DCA VEOFSW /CLEAR EOFSW AT END OF EVERY READ 001510 5577 ENDFLS, JMP I [RETURN /RETURN TO THE CALLING PROGRAM 001511 5667 JMP I ENDFL /*K* OR RETURN TO CALXIT /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 27 /ROUTINE TO DUMP CURRENT OUTPUT BUFFER WITH ^Z AT THE END 001512 0000 DMPBUF, 0 001513 2025 ISZ EOLSW /FORCE COLUMN 1 SWITCH OFF 001514 1375 TAD (7712 /OUTPUT A LINE FEED 001515 4563 JMS I [FMTOUT 001516 1100 TAD HAND /IF THE FILE IS BEING OUTPUT VIA 001517 7700 SMA CLA /AN OS/8 HANDLER, 001520 5332 JMP CLREOL /WE MUST TERMINATE THE BUFFER PROPERLY. 001521 1374 TAD (32 001522 1330 CTZLP, TAD Z7700 /OUTPUT A ^Z AND FILL BUFFER WITH ZEROES. 001523 4563 JMS I [FMTOUT /NEGATIVE NUMBERS TURN INTO CONTROL CHARS 001524 1103 TAD CHRPTR 001525 0176 AND [377 001526 1104 TAD CHRCTR /FILL THE BUFFER UNTIL CHRPTR POINTS TO 001527 7001 IAC /A BLOCK BOUNDARY AND CHRCTR = -3 001530 7700 Z7700, SMA CLA /WE ARE THEN AT BUFFER-END 001531 5322 JMP CTZLP 001532 3025 CLREOL, DCA EOLSW /RESET TO BEGINNING OF LINE 001533 5712 JMP I DMPBUF /RETURN /ROUTINE TO MOVE THE PROPER DSRN ENTRY INTO PAGE 0 001534 0000 LDDSRN, 0 001535 1070 TAD ACI / READ/WRITE INIT SINGS THIS SONG, 001536 7106 CLL RTL / (DOO DAH, DOO DAH,) 001537 7004 RAL / DSRN ENTRIES 9 WORDS LONG 001540 1070 TAD ACI / (OH, DEE DOO DAH DAY). 001541 7450 SNA /DEVICE NUMBER 0 IS SPECIAL - 001542 1373 TAD (PTTY+11-DSRN /IT'S ALWAYS THE TELETYPE 001543 1372 TAD (DSRN-12 001544 3074 DCA LOGUNT 001545 4360 JMS INITMV /SET UP FOR MOVE 001546 1412 TAD I XR 001547 3413 DCA I XR1 /PUT DSRN ENTRY IN PAGE 0 001550 2020 ISZ T 001551 5346 JMP .-3 001552 1102 TAD BADFLD 001553 0174 AND [70 001554 1361 TAD ICDF0 001555 3112 DCA BUFCDF /SAVE BUFFER FIELD AS A CDF 001556 1100 TAD HAND 001557 5734 JMP I LDDSRN /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 28 001560 0000 INITMV, 0 /ROUTINE TO SET UP STUFF 001561 6201 ICDF0, CDF 0 001562 1074 TAD LOGUNT 001563 3012 DCA XR 001564 1166 TAD [HAND-1 /[ BECAUSE 77 001565 3013 DCA XR1 001566 1371 TAD (-11 001567 3020 DCA T 001570 5760 JMP I INITMV 001571 7767 001572 4232 001573 3642 001574 0032 001575 7712 001576 1730 001577 5000 1600 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 29 /BACKSPACE ROUTINE - WORKS ON BINARY OR ASCII FILES 001600 4573 BKSPC, JMS I [RWINIT 001601 0000 0 /GET THE DSRN ENTRY WITHOUT ALTERING MODE 001602 1100 TAD HAND 001603 7700 SMA CLA 001604 5547 JMP I [UNTERR /UNIT MUST BE BLOCK ORIENTED 001605 7332 AC2000 001606 0110 AND FFLAGS 001607 7640 SZA CLA /IS FILE FORMATTED? 001610 5256 JMP BKASCI /YES - PAIN IN NECK 001611 4223 JMS BMPBLK /UNFORMATTED FILE - REREAD LAST BLOCK 001612 1103 TAD CHRPTR 001613 1176 TAD [377 001614 3020 DCA T 001615 4111 JMS BUFFLD /SET DATA FIELD TO FIELD OF BUFFER 001616 1420 TAD I T /LOOK AT LAST WORD IN BUFFER 001617 7041 CIA /REGARD IT AS THE NUMBER OF BLOCKS/RECORD 001620 1106 TAD RELBLK 001621 3106 DCA RELBLK /RELBLK POINTS TO FIRST BLOCK OF PREV. REC 001622 5560 JMP I [ENDIO 001623 0000 BMPBLK, 0 /SUBR TO BUMP BLOCK # BACK AND READ 001624 7140 CMA CLL /AC MAY NOT BE 0 ON ENTRY 001625 1106 TAD RELBLK 001626 3106 DCA RELBLK /BUMP BLOCK BACK 001627 7420 SNL 001630 5777 JMP I (ATLDMK /BACKSPACED TOO FAR - CALL IT QUITS 001631 3103 DCA CHRPTR /ZERO CHRPTR TO FORCE A READ FROM MASSIO 001632 4546 JMS I [MASSIO /READ A BLOCK 001633 5623 JMP I BMPBLK 001634 0000 MASBMP, 0 001635 4111 JMS BUFFLD /SET TO BUFFER'S DATA FIELD 001636 2104 ISZ CHRCTR /BUMP CHAR COUNTER 001637 5634 JMP I MASBMP /CHAR 1 OR 2 - NO SWEAT 001640 7346 AC7775 001641 3104 DCA CHRCTR /CHAR 3 - RESET CHAR CTR 001642 7344 AC7776 001643 1103 TAD CHRPTR /BUMP BACK CHAR PTR 001644 3103 DCA CHRPTR 001645 2234 ISZ MASBMP 001646 5634 JMP I MASBMP /SKIP RETURN /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 30 /BACKSPACE FOR FORMATTED FILES 001647 1503 BKLORD, TAD I CHRPTR 001650 2103 ISZ CHRPTR 001651 7000 NOP 001652 0145 AND [177 /GET 7 BITS 001653 1376 TAD (-15 /COMPARE WITH C.R. - SINCE WE SKIPPED 001654 7650 SNA CLA /THE FIRST ONE THIS WILL BELONG TO THE PREVIOUS 001655 5560 JMP I [ENDIO /LINE AND WE WILL BE DONE (HAH!) 001656 4234 BKASCI, JMS MASBMP /A COMPLICATED MESS - FIRST BUMP THE 001657 7410 SKP /CHARACTER POINTER BACK TWO PLACES 001660 5314 JMP BKGTCH /AND THEN FETCH A CHARACTER. THIS WILL IGNORE 001661 1102 TAD BADFLD /THE LAST CHAR READ/WRITTEN (WHICH SHOULD 001662 0150 AND [7400 /BE A CARRIAGE RETURN). 001663 7041 CIA 001664 1103 TAD CHRPTR 001665 7110 CLL RAR 001666 7640 SZA CLA /TEST WHETHER WE HAVE TO READ AN OLD BUFFER 001667 5311 JMP BKNORD /NO 001670 1104 TAD CHRCTR /SAVE POSITION IN CURRENT DOUBLEWORD 001671 3320 DCA GETCH3 001672 3103 DCA CHRPTR 001673 7330 AC4000 /IF WE ARE BACKSPACING AN OUTPUT FILE, 001674 1110 TAD FFLAGS /WE MUST SAVE THE INFORMATION IN THE 001675 7510 SPA /CURRENT BUFFER BY WRITING IT OUT. 001676 5302 JMP .+4 001677 3110 DCA FFLAGS /ALSO CHANGE THE UNIT TO AN INPUT FILE 001700 7330 AC4000 /(RWINIT TAKES CARE OF SWITCHING BACK TO OUTPUT) 001701 4546 JMS I [MASSIO 001702 7324 AC0001 /WE DON'T WANT THE LAST BLOCK READ/WRITTEN, 001703 4223 JMS BMPBLK /THAT'S IN CORE - WE WANT THE ONE 001704 1320 TAD GETCH3 /BEFORE THAT. 001705 3104 DCA CHRCTR 001706 1104 TAD CHRCTR 001707 1375 TAD (401 001710 7410 SKP /COMPUTE WORD POINTER FROM CHAR POINTER 001711 7340 BKNORD, AC7777 001712 1103 TAD CHRPTR 001713 3103 DCA CHRPTR /BUMP WD PTR BACK 1 001714 4234 BKGTCH, JMS MASBMP /NOW GET A CHARACTER - THIS LOOKS A LOT 001715 5247 JMP BKLORD /LIKE THE INPUT ROUTINE 001716 4320 JMS GETCH3 001717 5250 JMP BKLORD+1 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 31 001720 0000 GETCH3, 0 /COMMON CODE BETWEEN BACKSPACE AND INPUT 001721 1503 TAD I CHRPTR 001722 0150 AND [7400 001723 7112 CLL RTR /IN 1700 POSITION 001724 3223 DCA BMPBLK /HANDY TEMPORARY 001725 2103 ISZ CHRPTR 001726 1503 TAD I CHRPTR 001727 0150 AND [7400 001730 7002 BSW /COMBINE TWO 4-BIT QUANTITIES 001731 1223 TAD BMPBLK /INTO A CHARACTER 1774 001732 7112 CLL RTR /377 001733 5720 JMP I GETCH3 001734 0000 DATABL, ZBLOCK 33 /DIRECT ACCESS TABLE 001775 0401 001776 7763 001777 1455 2000 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 32 /I,E,F,AND G FORMAT CONVERSIONS 002000 1030 IFMT, TAD D 002001 3027 DCA W /SET WIDTH PROPERLY 002002 3030 DCA D /FOR SCALING PURPOSES 002003 7340 AC7777 002004 3061 DCA IFLG 002005 5214 JMP FFMT 002006 7340 GFMT, AC7777 002007 3062 DCA GFLG /SET G AND E FLAGS 002010 7340 EFMT, AC7777 002011 3063 DCA EFLG /SET E FLAG 002012 5214 JMP FFMT 002013 4571 IGEF, JMS I [GETLMN /MAIN LOOP FOR CONVERSIONS - SKIPPED 1ST TIME 002014 1030 FFMT, TAD D 002015 3064 DCA OD /SAVE COUNT OF POST-D.P. DIGITS 002016 1061 TAD IFLG 002017 7650 SNA CLA /APPLY THE P-SCALE FACTOR 002020 1066 TAD PFACT /ONLY IF THE FORMAT IS NOT I 002021 3067 DCA PFACTX 002022 3065 DCA SCALE /DON'T LOOK FOR TROUBLE 002023 4554 JMS I [SKPOUT /CHECK IF MORE AND TEST DIRECTION 002024 5777 JMP I (IGEFIN /INPUT 002025 7340 AC7777 002026 3544 DCA I [FFNEG /*K* USE NEGATE ROUTINE HEADER AS SIGN FLAG 002027 1063 TAD EFLG 002030 7104 CLL RAL 002031 7104 CLL RAL /0 IF NOT E, -4 IF E 002032 1027 TAD W /THIS PROVIDES FOR THE EXP. FIELD (IF E FMT) 002033 3325 DCA OW /OR THE 4 TRAILING SPACES (IF G FMT) 002034 1045 TAD ACH 002035 7450 SNA 002036 5262 JMP SKPSHT /AC IS ZERO - SKP A LOT OF SHT 002037 7710 SPA CLA 002040 4544 JMS I [FFNEG /*K* AC<0 - NEGATE IT AND SET FLAG (CLEVER) 002041 3065 SCALUP, DCA SCALE 002042 1044 TAD ACX 002043 7740 SMA SZA CLA /AC<1.0? 002044 5252 JMP GT1 /NO 002045 4553 JMS I [FPGO /YES - MULTIPLY BY 10.0 002046 3361 FMUL10 002047 7340 AC7777 002050 1065 TAD SCALE /BUMP POWER OF TEN 002051 5241 JMP SCALUP /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 33 /I,G,E,F, OUTPUT CONVERSIONS - NUMBER IS NOW =>1.0 002052 4776 GT1, JMS I (SCALDN /NOW DECREASE IT TO THE INTERVAL [0,1) 002053 4553 JMS I [FPGO /SAVE IT AWAY 002054 3755 FSTTMP 002055 1167 TAD [7 002056 4326 JMS OSCALE 002057 4553 JMS I [FPGO /USE IT TO ROUND THE NUMBER TO BE OUTPUT 002060 5145 FADTMP 002061 4776 JMS I (SCALDN /WE COULD HAVE ROUNDED FROM .999... TO 1.000... 002062 1062 SKPSHT, TAD GFLG /ENTER HERE IF NUM WAS 0 - SCALE=0 002063 7650 SNA CLA 002064 5775 JMP I (NOTG /NOT G FORMAT 002065 1065 TAD SCALE /G FORMAT - TEST FOR OUT OF F FORMAT RANGE 002066 1067 TAD PFACTX 002067 7141 CIA CLL /F FORMAT RANGE IS [.1,10**(D VALUE)) 002070 1064 TAD OD 002071 7420 SNL 002072 5275 JMP USEE /IF OUT OF BOUNDS USE E FORMAT (FLAG IS SET) 002073 3064 DCA OD /REDUCE D VALUE BY SCALE FACTOR 002074 3063 DCA EFLG /TO RETAIN CORRECT # OF SIG. DIGITS 002075 7200 USEE, CLA 002076 5775 JMP I (NOTG /SET UP TO PRINT DIGITS 002077 0000 DIGCNT, 0 002100 1067 TAD PFACTX /COMPUTE EXPONENT JUST IN CASE E FORMAT 002101 7041 CIA 002102 1065 TAD SCALE 002103 3072 DCA FMTNUM 002104 1063 TAD EFLG 002105 7650 SNA CLA /NOW COMPUTE THE NUMBER OF DIGITS BEFORE THE D.P. 002106 1065 TAD SCALE /TAKE SCALE FACTOR INTO ACCOUNT IF NOT E FORMAT 002107 1067 TAD PFACTX /TAKE P FACTOR INTO ACCOUNT IF NOT I OR F/G 002110 3065 DCA SCALE /STORE THE NUMBER OF DIGITS BEFORE THE D.P. 002111 1544 TAD I [FFNEG /*K* INCREASE NUMBER OF LEADING BLANKS BY 1 002112 7710 SPA CLA /IF THE NUMBER IS POSITIVE. THIS DEPENDS ON 002113 2325 ISZ OW /THIS LOCATION BEING BELOW 4000. 002114 1065 TAD SCALE /GET THE NUMBER OF PRE-D.P. DIGITS (AS NEGATIVE #) 002115 7550 SPA SNA 002116 7324 AC0001 /IF NONE, PRINT A 0 SO COUNT AS 1 002117 1064 TAD OD /REDUCE THE WIDTH BY THIS NUMBER 002120 7040 CMA 002121 1325 TAD OW /REDUCE IT AGAIN BY THE POST-D.P. DIGIT COUNT 002122 7041 CIA 002123 1061 TAD IFLG /AND AGAIN BY 1 FOR THE D.P. (IF NOT I FORMAT) 002124 5677 JMP I DIGCNT 002125 0000 OW, 0 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 34 /I,G,E,F FORMAT - ROUTINE TO SCALE ROUNDING FACTOR 002126 0000 OSCALE, 0 /SUBR TO SCALE .5 THE CORRECT # OF TIMES 002127 3370 DCA NPLCS /MAX IN AC ON ENTRY 002130 3044 DCA ACX 002131 7332 AC2000 /FORM A FLOATING 0.5 IN ORDER 002132 3045 DCA ACH /TO ROUND THE NUMBER BEFORE PRINTING. 002133 3046 DCA ACL 002134 1063 TAD EFLG /FIGURE OUT HOW TO SCALE IT - 002135 7650 SNA CLA /THE THEORY IS THAT IT SHOULD BE SCALED 002136 1065 TAD SCALE /DOWN BY THE NUMBER OF SIGNIFICANT 002137 3020 DCA T /PRINTING DIGITS. THIS CAN BE 002140 1065 TAD SCALE /EXPRESSED AS: 002141 7141 CIA CLL /(P FACTOR) * (NOT (G FMT PRINTING AS F)) 002142 1064 TAD OD / + (SCALE FACTOR) * (NOT E FMT) + (D VALUE). 002143 7630 SZL CLA /THE SCALE FACTOR IS < 0 FOR 002144 1062 TAD GFLG /NUMBERS < .1, WHICH REDUCES 002145 7650 SNA CLA /THE # OF SIG. DIGITS VIA LEADING ZEROS. 002146 1067 TAD PFACTX /IF THERE ARE < 0 SIG. DIGITS 002147 1020 TAD T /IT DOESN'T MATTER WHAT WE DO 002150 1064 TAD OD /SINCE THE NUMBER WILL PRINT AS 002151 7500 SMA /0.00000 ANYWAY. 002152 7040 CMA /IF THERE ARE >NPLCS SIG. PRINTING DIGITS 002153 1370 TAD NPLCS /THE ROUNDING GETS MEANINGLESS SO MAKE 002154 7510 SPA /THE EXCESS DIVISIONS DIVIDES BY 2 INSTEAD 002155 3044 DCA ACX / OF BY 10. THIS FUDGE WORKS QUITE WELL 002156 7041 CIA /FOR NUMBERS OF UP TO NPLCS+2 002157 1370 TAD NPLCS /SIGNIFICANT DIGITS. 002160 7041 CIA 002161 3020 DCA T 002162 5365 JMP .+3 002163 4553 FDIVLP, JMS I [FPGO /SCALE THE .5 DOWN THE CORRECT NUMBER OF TIMES 002164 3355 FDIV10 002165 2020 ISZ T 002166 5363 JMP FDIVLP 002167 5726 JMP I OSCALE 002170 0000 NPLCS, 0 002171 0001 ONE, 1;2000;0 002172 2000 002173 0000 002175 2534 002176 2546 002177 2400 2200 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 35 /I,G,E,F OUTPUT CONVERSION - ACTUAL OUTPUT SECTION 002200 7500 OUTNUM, SMA /CHECK FOR FIELD OVERFLOW 002201 5333 JMP ASTSK1 /YES - PRINT ******* 002202 4337 JMS OBLNKS /PRINT LEADING BLANKS - AC IS NOT 0! /***IMPORTANT - OBLNKS CLEARS AC1 *** 002203 7346 AC7775 002204 2544 ISZ I [FFNEG /*K* IF SIGN IS NEGATIVE, 002205 4371 JMS DIGIT /OUTPUT A MINUS SIGN 002206 7200 CLA /OTHERWISE OUTPUT NOTHING 002207 1044 TAD ACX 002210 7450 SNA /ALIGN THE FAC MANTISSA INTO A DOUBLEWORD 002211 4543 JMS I [AL1 /FRACTION IN THE RANGE [.1,1) 002212 7001 IAC /THIS INVOLVES SHIFTING THE MANTISSA 002213 7040 CMA /RIGHT BY (-ACX-1) PLACES 002214 7500 SMA /WHERE A NEGATIVE NUMBER MEANS A LEFT SHIFT. 002215 4542 JMS I [ACSR 002216 7200 CLA 002217 1046 TAD ACL /NOW MOVE THE FAC DOWN A WORD SO THAT 002220 3053 DCA AC1 /WHEN WE MULTIPLY BY 10 THE OVERFLOW APPEARS 002221 1045 TAD ACH /IN THE HIGH-ORDER WORD 002222 3046 DCA ACL 002223 1065 TAD SCALE 002224 7550 SPA SNA /DO WE HAVE DIGITS TO THE LEFT OF THE D.P.? 002225 5326 JMP PRZERO /NO - PRINT A ZERO THERE 002226 4347 JMS DIGITS /YES - PRINT THEM 002227 1061 PRDCPT, TAD IFLG 002230 7640 SZA CLA 002231 5777 JMP I (IGEF /IF I FORMAT, WE'RE DONE NOW 002232 7344 AC7776 002233 4371 JMS DIGIT /OTHERWISE PRINT DECIMAL POINT 002234 1065 TAD SCALE 002235 7700 SMA CLA /CHECK WHETHER WE NEED TO PRINT LEADING ZEROS 002236 5251 JMP NOLZRO /NO 002237 1065 TAD SCALE 002240 3020 DCA T 002241 7340 LZLOOP, AC7777 002242 1064 TAD OD /BUMP D VALUE DOWN BY ONE 002243 7420 SNL /IF IT GOES NEGATIVE, 002244 5254 JMP NOMOAC /WE'VE RUN OUT OF FIELD WIDTH 002245 3064 DCA OD 002246 4371 JMS DIGIT /PRINT A ZERO 002247 2020 ISZ T /UNTIL THE COUNT (OR THE WIDTH) RUNS OUT 002250 5241 JMP LZLOOP 002251 1064 NOLZRO, TAD OD 002252 7440 SZA /IF THERE ARE ANY DIGITS YET TO BE PRINTED, 002253 4347 JMS DIGITS /PRINT THEM /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 36 /I,G,E,F OUTPUT CONVERSION - FINISH UP 002254 7200 NOMOAC, CLA 002255 1063 TAD EFLG 002256 7650 SNA CLA /E FORMAT? 002257 5317 JMP CHKG /NO - CHECK FOR G FORMAT OUTPUT AS F 002260 4262 JMS EXPFLD 002261 5777 JMP I (IGEF 002262 0000 EXPFLD, 0 002263 1376 TAD (5 002264 4563 JMS I [FMTOUT /OUTPUT "E" 002265 1072 TAD FMTNUM /GET EXPONENT 002266 7100 CLL 002267 7510 SPA 002270 7061 CML CIA /SEPARATE INTO MAGNITUDE AND SIGN 002271 3072 DCA FMTNUM /SAVE MAGNITUDE 002272 7006 RTL 002273 1375 TAD (-5 /PRINT + OR - 002274 4371 JMS DIGIT 002275 3020 DCA T /INITIALIZE QUOTIENT OF DIVISION 002276 1072 DVELP, TAD FMTNUM /SUBTRACT 10 FROM EXPONENT 002277 1141 TAD [-12 002300 7510 SPA /DID IT GO NEGATIVE? 002301 5305 JMP PRNTXP /YES - DONE 002302 3072 DCA FMTNUM /NO - STORE IT BACK 002303 2020 ISZ T /BUMP QUOTIENT 002304 5276 JMP DVELP /LOOP 002305 7200 PRNTXP, CLA 002306 1020 TAD T 002307 1141 TAD [-12 002310 7700 SMA CLA 002311 5331 JMP ASTSK3 002312 1020 TAD T 002313 4371 JMS DIGIT 002314 1072 TAD FMTNUM 002315 4371 JMS DIGIT /PRINT TWO DIGITS OF EXPONENT 002316 5662 JMP I EXPFLD 002317 1062 CHKG, TAD GFLG 002320 7450 SNA /WAS IT G FORMAT? 002321 5777 JMP I (IGEF /NO - F OR I - DONE 002322 3063 DCA EFLG /RE-SET EFLG SINCE WE ZEROED IT BEFORE 002323 1375 TAD (-5 002324 4337 JMS OBLNKS /OUTPUT 4 BLANKS 002325 5777 JMP I (IGEF /DONE WITH G FORMAT OUTPUT 002326 7200 PRZERO, CLA /COME HERE IF NO SIG. DIGITS LEFT OF D.P. 002327 4371 JMS DIGIT /PRINT A ZERO 002330 5227 JMP PRDCPT /CONTINUE 002331 7326 ASTSK3, AC0002 002332 5335 JMP .+3 002333 7200 ASTSK1, CLA /CLEAR THE AC /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 36-1 002334 1027 TAD W /GET THE FIELD WIDTH 002335 4540 JMS I [ASTRSK 002336 5777 JMP I (IGEF /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 37 /I,G,E,F OUTPUT CONVERSION - OUTPUT SUBROUTINES 002337 0000 OBLNKS, 0 /SUBROUTINE TO PRINT A STRING OF BLANKS 002340 3053 DCA AC1 /MUST LEAVE AC1 ZERO ON EXIT SO THAT 002341 5344 JMP .+3 /FAC LEFT SHIFT WON'T SHIFT IN GARBAGE LATER ON 002342 1137 TAD [40 002343 4563 JMS I [FMTOUT /OUTPUT A BLANK 002344 2053 ISZ AC1 002345 5342 JMP .-3 /LOOP 002346 5737 JMP I OBLNKS /RETURN 002347 0000 DIGITS, 0 /ROUTINE TO OUTPUT A STRING OF DECIMAL DIGITS 002350 7041 CIA 002351 3020 DCA T 002352 1053 DGLOOP, TAD AC1 002353 3054 DCA AC2 /COPY AC INTO OPERAND FOR ADDITION LATER ON 002354 1046 TAD ACL 002355 3057 DCA OPL 002356 3045 DCA ACH /CLEAR "OVERFLOW WORD" 002357 4543 JMS I [AL1 002360 4543 JMS I [AL1 /FAC=FAC*4 002361 3056 DCA OPH 002362 4536 JMS I [OADD 002363 4543 JMS I [AL1 /FAC=ORIGINAL FAC*10 002364 1045 TAD ACH /GET OVERFLOW 002365 4371 JMS DIGIT /PRINT IT 002366 2020 ISZ T /LOOP FOR SPECIFIED NUMBER 002367 5352 JMP DGLOOP 002370 5747 JMP I DIGITS /RETURN 002371 0000 DIGIT, 0 /ROUTINE TO OUTPUT A DIGIT 002372 1135 TAD [60 002373 4563 JMS I [FMTOUT /TRIVIAL, ISN'T IT? 002374 5771 JMP I DIGIT 002375 7773 002376 0005 002377 2013 2400 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 38 /I,G,E,F INPUT CONVERSION 002400 7340 IGEFIN, AC7777 /OD CONTAINS SCALING IF NO D.P. IN INPUT 002401 3325 DCA DPSW /INITIALIZE D.P. SW 002402 7340 AC7777 002403 3367 DCA INESW /DITTO EXPONENT SWITCH 002404 1027 TAD W 002405 7040 CMA 002406 3072 DCA FMTNUM /GET CHAR COUNT 002407 3044 INERSM, DCA ACX /RE-ENTER HERE AFTER SEEING "E" 002410 3045 DCA ACH /CLEAR FLOATING AC 002411 3046 DCA ACL 002412 7340 AC7777 002413 5253 JMP INMINS /SET SIGN PLUS 002414 4562 INGCH, JMS I [FMTIN /GET A CHAR 002415 4570 JMS I [CHTYPE /CLASSIFY IT 002416 1234 1234; IDIGIT /DIGIT 002417 2443 002420 7722 -56; INDCPT /. 002421 2437 002422 7725 -53; INLOOP /+ 002423 2454 002424 7723 -55; INMINS /- 002425 2453 002426 7773 -5; INE /E 002427 2503 002430 7740 -40; INLOOP /BLANK - IGNORE UNLIKE 0 IN FORTRAN STANDARD 002431 2454 002432 7724 -54; INEONM /, 002433 2456 002434 0000 0 /OTHER - ERROR 002435 4434 INER, JMS I ERR 002436 0037 INMSG-ERRMSG 002437 3064 INDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER D.P. 002440 2325 ISZ DPSW /TEST AND SET D.P. SWITCH 002441 5235 JMP INER /WHOOPS - TWO D.P.S IN A NUMBER 002442 5254 JMP INLOOP /KEEP GOING 002443 1071 IDIGIT, TAD CHCH 002444 3327 DCA DGT+1 /SAVE THE DIGIT 002445 4553 JMS I [FPGO /FORM 10*FAC + DIGIT IN FAC 002446 5136 ACMDGT 002447 1325 TAD DPSW 002450 7650 SNA CLA 002451 2064 ISZ OD /BUMP DIGIT COUNT IF D.P. SEEN 002452 5254 JMP INLOOP /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 39 002453 3544 INMINS, DCA I [FFNEG /*K* SET SIGN NEGATIVE 002454 2072 INLOOP, ISZ FMTNUM 002455 5214 JMP INGCH /LOOP UNTIL WIDTH EXHAUSTED 002456 2544 INEONM, ISZ I [FFNEG /*K* CHECK IF SIGN NEGATIVE 002457 4544 JMS I [FFNEG /*K* YES - NEGATE 002460 2367 ISZ INESW /SEE IF "E" SEEN 002461 5315 JMP FIXUPE /YES - WE HAVE EXPONENT, NOT NUMBER 002462 1067 TAD PFACTX /NO "E" SEEN - SCALE USING P FACTOR 002463 1064 SCALIN, TAD OD /GET SCALING FACTOR 002464 7120 STL 002465 7450 SNA 002466 5777 JMP I (IGEF /NO SCALING NECESSARY 002467 7500 SMA 002470 7141 CIA CLL /AC CONTAINS MAGNITUDE, LINK CONTAINS SIGN 002471 3064 DCA OD 002472 7006 RTL 002473 7004 RAL /AC CONTAINS 0 IF DIVIDE, 4 IF MULTIPLY 002474 1376 TAD (FDIV10 002475 3277 DCA IGEFOP 002476 4553 JMS I [FPGO /MULTIPLY OR DIVIDE BY 10.0 002477 0000 IGEFOP, 0 002500 2064 ISZ OD 002501 5276 JMP IGEFOP-1/MULT OR DIV APPROPRIATE NUMBER OF TIMES 002502 5777 JMP I (IGEF /RETURN FOR MORE 002503 2367 INE, ISZ INESW /SEE IF THIS IS THE SECOND "E" 002504 5235 JMP INER /YES - ERROR 002505 2325 ISZ DPSW /FORCE DP SW ON (TO INHIBIT D.P. AFTER E) 002506 1064 TAD OD /USE SCALE FACTOR ONLY IF D.P. SEEN 002507 3065 DCA SCALE /SAVE SCALE FACTOR 002510 2544 ISZ I [FFNEG /*K* 002511 4544 JMS I [FFNEG /*K* GET SIGN OF NUMBER CORRECT 002512 4553 JMS I [FPGO /SAVE IT TEMPORARILY 002513 4563 FSTTM2 002514 5207 JMP INERSM /GO COLLECT EXPONENT 002515 4551 FIXUPE, JMS I [FFIX 002516 1070 TAD ACI /GET EXPONENT 002517 7041 CIA 002520 1065 TAD SCALE /ADD IN EXPONENT TO D.P. SCALE FACTOR 002521 3064 DCA OD 002522 4553 JMS I [FPGO /GET NUMBER BACK IN FAC 002523 1361 FLDTM2 002524 5263 JMP SCALIN 002525 0000 DPSW, 0 002526 0013 DGT, 13;0;0;0;0;0 002527 0000 002530 0000 002531 0000 002532 0000 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 39-1 002533 0000 002534 4775 NOTG, JMS I (DIGCNT 002535 3346 DCA SCALDN 002536 1061 TAD IFLG 002537 7650 SNA CLA 002540 5344 JMP NOTI 002541 1065 TAD SCALE 002542 1374 TAD (-7 002543 7710 SPA CLA 002544 1346 NOTI, TAD SCALDN 002545 5773 JMP I (OUTNUM /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 40 002546 0000 SCALDN, 0 /SUBROUTINE TO SCALE THE FAC LESS THAN 1.0 002547 1044 TAD ACX 002550 7750 SPA SNA CLA /IS THE FAC => 1.0? 002551 5746 JMP I SCALDN /NO - WE'RE DONE 002552 4553 JMS I [FPGO /DIVIDE BY TEN 002553 3355 FDIV10 002554 2065 ISZ SCALE /BUMP POWER OF TEN 002555 0000 0 /BACKUP FOR WIDTH 002556 5347 JMP SCALDN+1 /LOOP 002557 0000 ASTRSK, 0 002560 7041 CIA 002561 3020 DCA T 002562 1372 TAD (52 002563 4563 JMS I [FMTOUT 002564 2020 ISZ T 002565 5362 JMP .-3 002566 5757 JMP I ASTRSK /GET NEXT ELEMENT 002567 0000 INESW, 0 /"E SEEN" SWITCH ON INPUT 002572 0052 002573 2200 002574 7771 002575 2077 002576 3355 002577 2013 2600 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 41 /L AND X FORMATS , T FORMAT INPUT 002600 4562 TFMTIN, JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY 002601 7200 CLA /BY FETCHING AND WASTING A CHARACTER 002602 1377 TAD (INBUFR 002603 3011 DCA INXR 002604 3025 DCA EOLSW /SET TO BEGINNING OF LINE 002605 5210 JMP XFMT 002606 4562 XFMTIN, JMS I [FMTIN 002607 7600 H7600, 7600 /WASTE AN INPUT CHAR 002610 4556 XFMT, JMS I [MORE /ANY MORE CHARS? 002611 1023 TAD RWFLAG /YES - IN OR OUT? 002612 7700 SMA CLA 002613 5206 JMP XFMTIN /IN 002614 1137 TPPLBL, TAD [40 /HERE WITH AC=13 TO OVERPRINT ON T OUTPUT 002615 4563 JMS I [FMTOUT /OUT 002616 5210 JMP XFMT 002617 4562 LINGCH, JMS I [FMTIN 002620 4570 JMS I [CHTYPE /GET AND CLASSIFY CHARACTER 002621 7740 -40; LINLP /BLANK 002622 2637 002623 7754 -24; LINTRU /T 002624 2631 002625 7772 -6; LINFLS /F 002626 2632 002627 0000 0 /OTHER - ERROR 002630 5776 JMP I (INER 002631 1375 LINTRU, TAD (4001 002632 7110 LINFLS, CLL RAR /PUT EITHER 0.0 OR 1.0 IN THE FAC 002633 3045 DCA ACH 002634 3046 DCA ACL 002635 7004 RAL 002636 3044 DCA ACX 002637 2027 LINLP, ISZ W 002640 5217 JMP LINGCH /LOOP ON FIELD WIDTH 002641 4571 LNXT, JMS I [GETLMN /GET NEXT ELEMENT FOR I/O 002642 1030 LFMT, TAD D 002643 7040 CMA 002644 3027 DCA W /SAVE WIDTH AS A COUNT 002645 4554 JMS I [SKPOUT /IN OR OUT? 002646 5232 JMP LINFLS /IN 002647 7324 AC0001 002650 1027 TAD W 002651 4774 JMS I (OBLNKS /OUTPUT W-1 BLANKS 002652 1045 TAD ACH 002653 7640 SZA CLA 002654 1373 TAD (16 002655 1372 TAD (6 /NON-ZERO IS TRUE, ZERO FALSE 002656 4563 JMS I [FMTOUT /OUTPUT T OR F 002657 5241 JMP LNXT /NEXT VICTIM /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 42 /T FORMAT OUTPUT AND RANDOM SUBROUTINES 002660 1030 TFMT, TAD D 002661 7041 CIA 002662 3026 DCA N /USE N TO FAKE OUT "X" FMT ROUTINE 002663 1023 TAD RWFLAG 002664 7700 SMA CLA 002665 5200 JMP TFMTIN /INPUT 002666 1026 TAD N 002667 1025 TAD EOLSW /COMPARE DESIRED POSITION WITH CURRENT ONE 002670 7510 SPA 002671 5276 JMP TPBLNK /AFTER - SPACE TO IT 002672 4300 JMS EOLINE /OUTPUT CR AND ZERO EOLSW 002673 4556 JMS I [MORE /KLUDGE FOR "T1" FORMAT 002674 1371 TAD (13 /FAKE X FORMAT INTO PRINTING 002675 5214 JMP TPPLBL /A + AND (N-1) SPACES 002676 3026 TPBLNK, DCA N /SAVE DIFFERENCE BETWEEN POSITIONS 002677 5210 JMP XFMT /GO SPACE OUT 002700 0000 EOLINE, 0 /SUBROUTINE TO TERMINATE I/O LINE 002701 1023 TAD RWFLAG /CAUTION - AC LO-ORDER BITS MAY NOT BE 0 002702 7710 SPA CLA /INPUT OR OUTPUT? 002703 5311 JMP EOOUTL /OUTPUT 002704 4562 JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY 002705 7200 CLA 002706 1370 TAD (INBUFR-1 002707 3011 DCA INXR /SET XR TO NEGATIVE WORD AT THE 002710 5313 JMP .+3 /BEGINNING OF THE INPUT BUFFER 002711 1367 EOOUTL, TAD (7715 002712 4563 JMS I [FMTOUT /OUTPUT A CARRIAGE RETURN 002713 3025 DCA EOLSW /CLEAR EOLSW FOR INPUT AND OUTPUT 002714 5700 JMP I EOLINE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 43 /ROUTINE TO MOVE A HANDLER INTO FIELD 0 002715 0000 GETHND, 0 /HANDLER CODE WORD IN AC ON ENTRY 002716 3362 DCA HCW /SAVE HANDLER CODE WORD 002717 1134 TAD [7774 002720 0362 AND HCW /KNOCK OUT ION AND FORMS CTL BITS 002721 7041 CIA 002722 7440 SZA /IF HANDLER IS NOT RESIDENT, 002723 1361 TAD HKEY /SEE IF THE HANDLER IS ALREADY 002724 7650 SNA CLA /IN THE HANDLER AREA IN FIELD 0 002725 5353 JMP HINF0 /YES 002726 1362 TAD HCW /NO - PUT IT THERE 002727 0174 AND [70 002730 1344 TAD HCDF0 002731 3342 DCA HNDCDF /GET CDF TO FIELD IN WHICH HANDLER RESIDES 002732 1362 TAD HCW 002733 0207 AND H7600 002734 1366 TAD (-1 /GET POINTER TO HANDLER ADDRESS 002735 3013 DCA XR1 /IN THAT FIELD 002736 1365 TAD (HPLACE-1 002737 3012 DCA XR /ALSO TO HANDLER AREA IN FIELD 0 002740 1150 TAD [7400 /SET UP COUNT OF 7400 002741 3361 DCA HKEY /INDEPENDENT OF HANDLER SIZE 002742 7402 HNDCDF, HLT 002743 1413 TAD I XR1 002744 6201 HCDF0, CDF 0 002745 3412 DCA I XR /MOVE HANDLER INTO HANDLER AREA 002746 2361 ISZ HKEY 002747 5342 JMP HNDCDF 002750 1134 TAD [7774 002751 0362 AND HCW 002752 3361 DCA HKEY /SET NEW KEY CODE WORD 002753 7324 HINF0, AC0001 002754 0362 AND HCW 002755 7650 SNA CLA /INTERRUPTS ALLOWED? 002756 6002 YHIOF, IOF /NO - TOO BAD 002757 2073 ISZ CTCINH /INHIBIT ^C DURING HANDLER CALL 002760 5715 JMP I GETHND IFNZRO .-2761 < HKERR,_ /'USR' NEEDS THIS > 002761 0000 HKEY, 0 002762 0000 HCW, 0 002765 5177 002766 7777 002767 7715 002770 3777 002771 0013 002772 0006 002773 0016 002774 2337 002775 4001 002776 2435 002777 4000 3000 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 44 /CHARACTER INPUT ROUTINE - LINE AT A TIME 003000 0000 FMTIN, 0 003001 1025 TAD EOLSW 003002 7450 SNA /END OF LINE ALREADY FOUND? 003003 1411 TAD I INXR /NO - GET CHAR FROM LINE BUFFER 003004 7510 SPA /TIME TO READ A NEW LINE? 003005 5215 JMP READLN /YES 003006 7450 SNA /END OF LINE? 003007 5212 JMP INEOL /YES - SET INDICATOR 003010 0166 AND [77 /CONVERT TO SIXBIT 003011 5600 JMP I FMTIN /RETURN WITH IT 003012 1354 INEOL, TAD EOLCTR /YES - SET EOL INDICATOR OR NEW LENGTH 003013 3025 UNPKLN, DCA EOLSW /OF NEXT OVERFLOW BUFFER 003014 5201 JMP FMTIN+1 /AND RETURN BLANKS FROM HERE ON IN 003015 3025 READLN, DCA EOLSW /USE EOLSW AS A COUNT SO IT WINDS UP 0 003016 1377 TAD (INBUFR 003017 3011 DCA INXR /BE SURE INXR IS CORRECT 003020 1100 TAD HAND 003021 1376 TAD (-TTY 003022 7650 SNA CLA /IS IT TELETYPE INPUT? 003023 7340 AC7777 /YES - SET TTY FLAG 003024 3353 DCA TTYFLG 003025 4345 JMS ECHO 003026 0012 TTYLF, 12 /ECHO LF IF TTY INPUT 003027 1157 TAD [12 /TTYLF IS ZEROED BY ABORTO 003030 3226 DCA TTYLF 003031 7200 READLP, CLA 003032 1100 TAD HAND 003033 7710 SPA CLA /CHARACTER ORIENTED DEVICE? 003034 5355 JMP MASSIN /NO - UNPACK CHAR FROM BUFFER 003035 4500 JMS I HAND /GET A CHARACTER 003036 0145 GOTCHR, AND [177 /STRIP OFF PARITY 003037 4570 JMS I [CHTYPE /CLASSIFY IT 003040 7763 -15; INCRET /CARRIAGE RETURN 003041 3120 003042 7601 -177; RUBOUT /RUBOUT 003043 3070 003044 7767 -11; INTAB /TAB 003045 3062 003046 7753 -25; CTRLU /^U 003047 3114 003050 7746 -32; INEOF /^Z 003051 4727 003052 7745 -33; ESCAP /ESCAPE (LIKE CR) 003053 3130 003054 0000 0 /ANYTHING ELSE 003055 1071 TAD CHCH 003056 1155 TAD [-40 003057 7500 SMA /IF CHARACTER IS >37, 003060 4332 JMS INPUTC /STORE IT AND ECHO IT IF TTY 003061 5231 JMP READLP /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 45 /CHARACTER INPUT ROUTINE - SPECIAL CHARACTER HANDLERS 003062 4332 INTAB, JMS INPUTC /TAB - INSERT (AND ECHO) BLANKS 003063 1011 TAD INXR 003064 0167 AND [7 003065 7640 SZA CLA /UNTIL A COLUMN MULTIPLE OF 8 IS REACHED 003066 5262 JMP INTAB 003067 5231 JMP READLP 003070 1025 RUBOUT, TAD EOLSW 003071 7041 CIA 003072 1777 TAD I (INBUFR /IGNORE RUBOUTS IF LINE EMPTY 003073 0353 AND TTYFLG /OR IF NON-TTY INPUT 003074 7650 SNA CLA 003075 5231 JMP READLP /OR IF NO SCOPE: 003076 4345 PATRUB, JMS ECHO / AC7777 003077 0010 10 /ECHO A BACKSPACE TAD INXR 003100 4345 JMS ECHO / DCA INXR 003101 0040 40 /SPACE TAD I INXR 003102 7000 NOP / DCA .+2 003103 4345 JMS ECHO / 003104 0010 10 /BACKSPACE 003105 7340 AC7777 003106 1011 TAD INXR 003107 3011 DCA INXR /BACK UP LINE POINTER 003110 7340 AC7777 003111 1025 TAD EOLSW 003112 3025 DCA EOLSW /AND CHAR COUNTER 003113 5231 JMP READLP 003114 4345 CTRLU, JMS ECHO 003115 0015 15 /CR 003116 7340 AC7777 /SNEAKY 003117 5325 JMP UGO /LF AT UPKLN /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 46 003120 4345 INCRET, JMS ECHO 003121 0015 15 /ECHO THE C.R. 003122 1137 ESCRET, TAD [40 /SET BLANK FOR FORMAT OVERFLOW 003123 3354 FULRET, DCA EOLCTR /SET NEW BUFFER SIZE IF BUFFER OVERFLOW 003124 3411 DCA I INXR /CARRIAGE RETURN - ZERO OUT REST OF LINE 003125 1377 UGO, TAD (INBUFR 003126 3011 DCA INXR /RESET XR TO FETCH LINE CHARS 003127 5213 JMP UNPKLN /BACK TO FETCH FIRST CHAR 003130 3226 ESCAP, DCA TTYLF /INHIBIT LF 003131 5322 JMP ESCRET /SIMULATE EOL AND NO CR 003132 0000 INPUTC, 0 /ROUTINE TO STORE AND ECHO A CHAR 003133 1137 TAD [40 003134 3336 DCA INTMP 003135 4345 JMS ECHO 003136 0000 INTMP, 0 /ECHO CHAR IF TTY INPUT 003137 1336 TAD INTMP 003140 3411 DCA I INXR /STORE CHAR IN LINE BUFFER 003141 2025 ISZ EOLSW 003142 5732 JMP I INPUTC /RETURN IF NO OVERFLOW 003143 1777 TAD I (INBUFR /GET SIZE OF BUFFER 003144 5323 JMP FULRET /AND SET NEW BUFFER READ /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 47 003145 0000 ECHO, 0 /ROUTINE TO ECHO CHAR IF TTY INPUT 003146 1745 TAD I ECHO /GET CHAR 003147 0353 AND TTYFLG 003150 7440 SZA /SHOULD WE ECHO? 003151 4500 JMS I HAND /YES 003152 5745 JMP I ECHO /RETURN TO CHARACTER - ITS SMALL 003153 0000 TTYFLG, 0 003154 0040 EOLCTR, 40 /CHARACTER INPUT ROUTINE - MASS STORAGE SECTION 003155 4775 MASSIN, JMS I (MASBMP /GET BUFFER FIELD AND CHAR NUMBER 003156 5361 JMP INLORD /CHAR 1 OR 2 - STRAIGHTFORWARD 003157 4774 JMS I (GETCH3 /USE COMMON SUBROUTINE 003160 5364 JMP MASICM /GO TO COMMON CODE 003161 4546 INLORD, JMS I [MASSIO /CHECK IF WE SHOULD READ IN A BUFFERLOAD 003162 4111 JMS BUFFLD /SET FIELD OF BUFFER 003163 1503 TAD I CHRPTR 003164 2103 MASICM, ISZ CHRPTR /GET THE CHAR (IN LOW 8 BITS) AND BUMP PTR 003165 7000 NOP /WATCH END OF FIELD FUNNYBUSINESS! 003166 6201 CDF 0 /RESET DATA FIELD 003167 5236 JMP GOTCHR /GO EXTRACT SEVEN BIT CHARACTER 003174 1720 003175 1634 003176 7507 003177 4000 3200 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 48 /CHARACTER OUTPUT ROUTINE 003200 0000 FMTOUT, 0 003201 1137 TAD [40 /FIRST CONVERT SIXBIT TO ASCII 003202 7500 SMA /CTL CHARS COME IN NEGATIVE 003203 0166 AND [77 003204 1377 TAD (240 003205 3360 DCA OCHAR /SAVE ASCII CHAR (WITHOUT PARITY BIT) 003206 1025 TAD EOLSW 003207 7640 SZA CLA 003210 5242 JMP NOT1ST /FIRST CHAR IS DECODED FOR FORMS CONTROL 003211 7326 AC0002 /CHECK TO SEE IF THIS UNIT 003212 0101 AND HCODEW /SHOULD RECEIVE FORMS CONTROL 003213 7640 SZA CLA 003214 5233 JMP LFPLCH /NO - JUST PRINT A LINE FEED AND THE CHAR 003215 1360 TAD OCHAR 003216 4570 JMS I [CHTYPE /CLASSIFY CONTROL CHAR 003217 7517 -261; OUTFF /1 - TOP OF FORM 003220 3240 003221 7520 -260; OUT2LF /0 - DOUBLE SPACE 003222 3231 003223 7525 -253; NOLF /+ - OVERPRINT 003224 3247 003225 7563 -215; LFPLCH /KEEP CR ON OUTPUT FILE 003226 3233 003227 0000 0 /ANYTHING ELSE - SINGLE SPACE 003230 5237 JMP OUTLF 003231 1307 OUT2LF, TAD F212 003232 3360 DCA OCHAR /SET 2ND CHAR TO LINE FEED 003233 7340 LFPLCH, AC7777 003234 3025 DCA EOLSW /SET SWITCH FOR 2ND CHAR 003235 1360 TAD OCHAR 003236 3071 DCA CHCH /SAVE CHARACTER AWAY 003237 7344 OUTLF, AC7776 003240 1270 OUTFF, TAD F214 /SUBSTITUTE THE APPROPRIATE FORM CONTROL 003241 3360 DCA OCHAR /FOR THE CHARACTER 003242 1100 NOT1ST, TAD HAND 003243 7710 SPA CLA /CHARACTER ORIENTED DEVICE? 003244 5253 JMP MASOUT /NO - PACK CHAR INTO BUFFER 003245 1360 TAD OCHAR 003246 4500 JMS I HAND /OUTPUT CHAR 003247 2025 NOLF, ISZ EOLSW /BUMP CHAR CTR 003250 5600 JMP I FMTOUT /NO - RETURN 003251 1071 TAD CHCH /AHA - ANOTHER CHARACTER SHOULD BE OUTPUT 003252 5241 JMP OUTFF+1 /GO TO IT /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 49 /CHARACTER OUTPUT - MASS STORAGE OUTPUT 003253 4776 MASOUT, JMS I (MASBMP /GET BUFFER FIELD AND CHAR NUMBER 003254 5263 JMP OULORD /CHAR 1 OR 2 - STRAIGHTFORWARD 003255 4272 JMS OSUBR /CHAR 3 - PACK FIRST HALFBYTE 003256 4272 JMS OSUBR /PACK SECOND HALFBYTE 003257 7330 AC4000 003260 4311 JMS MASSIO /CHECK IF WE SHOULD DUMP THE BUFFER 003261 6201 MASOCM, CDF 0 003262 5247 JMP NOLF /GO RETURN OR REENTER 003263 1503 OULORD, TAD I CHRPTR /GET OLD HIGH ORDER BITS 003264 0150 AND [7400 /IN CASE OF WRITE AFTER READ 003265 1360 TAD OCHAR /ADD IN NEW 8-BIT 003266 3503 DCA I CHRPTR /STORE CHARACTER 003267 2103 ISZ CHRPTR /BUMP CHAR PTR 003270 0214 F214, 214 /GUARD AGAINST OVFLO 003271 5261 JMP MASOCM /RETURN 003272 0000 OSUBR, 0 /ROUTINE TO PACK A HALFBYTE 003273 1360 TAD OCHAR 003274 7106 CLL RTL 003275 7006 RTL /SHIFT CHAR 4 LEFT 003276 3360 DCA OCHAR 003277 1503 TAD I CHRPTR /CLEAR OUT ANY RESIDUE 003300 0176 AND [377 /FROM HIGH-ORDER OF BUFFER WORD 003301 3503 DCA I CHRPTR /IN CASE WE ARE WRITING AFTER A BACKSPACE. 003302 1360 TAD OCHAR 003303 0150 AND [7400 /GET 4 BITS 003304 1503 TAD I CHRPTR 003305 3503 DCA I CHRPTR /ADD INTO HIGH-ORDER OF BUFFER WORD 003306 2103 ISZ CHRPTR /BUMP POINTER 003307 0212 F212, 212 /OVERFLOW! 003310 5672 JMP I OSUBR 003311 0000 MASSIO, 0 /SUBROUTINE TO READ/WRITE BUFFER IF NECESSARY 003312 6201 CDF 0 003313 1112 TAD BUFCDF /ADD BUFFER CDF TO R/W BIT IN AC 003314 1375 TAD (-6001 /TAKE AWAY CDF, LEAVE BIT 4 ON 003315 3341 DCA IOCTL /STORE I/O CONTROL WORD 003316 1103 TAD CHRPTR 003317 0176 AND [377 003320 7640 SZA CLA /SEE IF POINTER IS AT BUFFER BOUNDARY 003321 5711 JMP I MASSIO /YES - RETURN DOING NOTHING 003322 1106 TAD RELBLK 003323 1105 TAD STBLK /STORE BLOCK # IN HANDLER CALL 003324 3343 DCA BLOCK 003325 1102 TAD BADFLD 003326 0150 AND [7400 003327 3342 DCA BUFFER /STORE BUFFER ADDRESS IN HANDLER CALL /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 50 /CHARACTER OUTPUT - BUFFER I/O ROUTINE CONTINUED 003330 1107 TAD TOTBLK 003331 7141 CIA CLL 003332 1106 TAD RELBLK 003333 7630 SZL CLA /CHECK FOR FILE OVERFLOW 003334 4434 IOVFLO, JMS I ERR /YES - ERROR 003335 0115 IOVMSG-ERRMSG 003336 1101 TAD HCODEW 003337 4774 JMS I (GETHND /GET HANDLER INTO FIELD 0 003340 4500 JMS I HAND /CALL HANDLER 003341 0000 IOCTL, 0 003342 0000 BUFFER, 0 003343 0000 BLOCK, 0 003344 7700 SMA CLA /HANDLER ERROR - ABORT 003345 7410 SKP /IF NOT EOF 003346 4434 IOERR, JMS I ERR 003347 0051 IOMSG-ERRMSG 003350 4773 JMS I (RECOVR /CLEAR ANY FLAGS SET BY OS8 HANDLER 003351 2106 ISZ RELBLK /BUMP RELATIVE BLOCK NUMBER 003352 1342 TAD BUFFER 003353 3103 DCA CHRPTR /RESET CHAR PTR 003354 5711 JMP I MASSIO /RETURN /FPP CODE FOR I/O CONVERSION 003355 3400 FDIV10, FDIV+LONG 003356 4763 TEN 003357 0000 FEXIT 003360 0000 OCHAR, 0 /*** NEEDED FOR PADDING *** 003361 4400 FMUL10, FMUL+LONG /FMUL10 MUST BE AT FDIV10+4 003362 4763 TEN 003363 0000 FEXIT 003364 2400 FWTOBL, FSUB+LONG 003365 2171 ONE 003366 3400 FDIV+LONG 003367 4771 FLTG85 003370 0000 FEXIT 003373 3747 003374 2715 003375 1777 003376 1634 003377 0240 3400 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 51 /UNFORMATTED (BINARY) INPUT-OUTPUT 003400 4573 RWUNF, JMS I [RWINIT /"READ(N)" OR "WRITE(N)" 003401 1000 1000 /"UNFORMATTED" BIT 003402 1365 TAD SZLCLA /ENABLE SEQUENCE CHECKING 003403 3326 UNFIO, DCA SEQCHK /*** SET SEQCHK TO "SZL CLA" OR "CLA" 003404 3254 DCA RECCTR /ENTER HERE FROM DIRECT ACCESS 003405 1100 TAD HAND 003406 7700 SMA CLA /CHECK FOR MASS-STORAGE HANDLER 003407 5547 JMP I [UNTERR /NO - ERROR 003410 4571 JMS I [GETLMN /GET FIRST VARIABLE 003411 1023 TAD RWFLAG 003412 7710 SPA CLA 003413 1377 RSETBP, TAD (125 /INITIALIZE COUNT TO -86 FOR WRITE, 003414 7040 CMA /-1 FOR READ 003415 3104 DCA CHRCTR 003416 1102 TAD BADFLD 003417 0150 AND [7400 003420 3117 DCA BIOPTR /INITIALIZE BUFFER POINTER 003421 1102 TAD BADFLD 003422 0174 AND [70 003423 7001 IAC 003424 7112 CLL RTR /AC BIT 0 NOW ON 003425 1023 TAD RWFLAG /AC BIT 0 CONTAINS COMP. OF R/W FLAG 003426 7110 CLL RAR /AC=(.NOT.RW)*2000+BUFFER FIELD 003427 1376 TAD (FSTA+LONG /AC=(FSTA OR FLDA) + BUFFLD 003430 3116 DCA FGPBF 003431 5240 JMP UIOVLP /SKIP FIRST VARIABLE FETCH/STORE 003432 4553 BFINCR, JMS I [FPGO 003433 0116 FGPBF /LOAD OR STORE A BUFFER ENTRY 003434 2117 ISZ BIOPTR 003435 2117 ISZ BIOPTR /INCREASE BUFFER POINTER 003436 2117 ISZ BIOPTR 003437 4571 JMS I [GETLMN /GET A VARIABLE FROM THE CALLING PROGRAM 003440 1023 UIOVLP, TAD RWFLAG 003441 7110 CLL RAR /LOWORDER BIT OF RWFLAG = END LIST FLAG 003442 7630 SZL CLA 003443 5250 JMP ENDUIO /NO MORE VARIABLES - TERMINATE 003444 2104 ISZ CHRCTR /BUMP COUNTER 003445 5232 JMP BFINCR /ROOM IN BUFFER - MOVE VARIABLE 003446 4304 JMS UDOIO /GET A NEW BUFFER 003447 5213 JMP RSETBP /RESET BUFFER POINTERS AND COUNTERS 003450 1023 ENDUIO, TAD RWFLAG /COME HERE WHEN I/O LIST EXHAUSTED 003451 7710 SPA CLA /WRITE? 003452 4304 JMS UDOIO /YES - WRITE OUT THE LAST BUFFER 003453 5560 JMP I [ENDIO /RESTORE DSRN ENTRY AND QUIT 003454 0000 RECCTR, 0 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 52 /DIRECT-ACCESS I/O 003455 4573 RWDACC, JMS I [RWINIT /"READ(N'R)" OR "WRITE(N'R)" 003456 1000 1000 /DIRECT ACCESS IS UNFORMATTED I/O 003457 1412 TAD I XR 003460 3020 DCA T /GET BLOCKS/RECORD FACTOR FROM D.A. TABLE 003461 4552 JMS I [ARGLD /GET RECORD NUMBER 003462 4551 JMS I [FFIX /CONVERT TO INTEGER 003463 1020 TAD T 003464 1070 TAD ACI 003465 2020 ISZ T /MULTIPLY RECORD NUMBER BY BLOCKS/RECORD 003466 5264 JMP .-2 /TO GET RELATIVE BLOCK NUMBER 003467 3106 DCA RELBLK /(RECS-1)*(BLKS/REC) 003470 1412 TAD I XR 003471 3116 DCA FGPBF /IT SHOULD BE AN FSTA + THE FIELD 003472 1116 TAD FGPBF 003473 7650 SNA CLA /THIS LOC SHOULD NOT BE ZERO! 003474 4434 DAERR, JMS I ERR 003475 0056 DAMSG-ERRMSG 003476 1412 TAD I XR /IN WHICH THE CONTROL VARIABLE IS 003477 3117 DCA BIOPTR /STORED. THE NEXT WORD IS THE ADDRESS 003500 4553 JMS I [FPGO /OF THE CONTROL VARIABLE IN THAT FIELD 003501 0114 FADD1 /ADD 1 TO RECORD # AND STORE IN CONTROL VAR 003502 1337 TAD DUMPIT /*K* "DCA T" SAME AS "CLA" HERE 003503 5203 JMP UNFIO /NOW GO DO A REGULAR BINARY READ/WRITE 003504 0000 UDOIO, 0 003505 2254 ISZ RECCTR /BUMP NUMBER OF RECORDS TRANSFERRED 003506 1102 TAD BADFLD 003507 0150 AND [7400 003510 1176 TAD [377 /FORM POINTER TO LAST WORD IN BUFFER 003511 3117 DCA BIOPTR 003512 1254 TAD RECCTR 003513 4111 JMS BUFFLD 003514 3517 DCA I BIOPTR /FOR WRITE, PUT RECORD NUMBER IN 256TH WORD 003515 3103 UDOIOL, DCA CHRPTR 003516 7330 AC4000 003517 0023 AND RWFLAG 003520 4546 JMS I [MASSIO /DO I/O (CHRPTR=0 TO FORCE I/O) 003521 4111 JMS BUFFLD 003522 1254 TAD RECCTR 003523 7160 CMA STL /FOR READ, CHECK THE INPUT 003524 1517 TAD I BIOPTR /SEQUENCE NUMBER TO MAKE SURE IT IS 003525 6201 CDF 0 /NO LARGER THAN THE ONE WE EXPECT. 003526 7630 SEQCHK, SZL CLA /*K* IF IT IS LARGER THIS IMPLIES THAT WE 003527 5704 JMP I UDOIO /ARE STILL IN THE MIDDLE OF THE LAST 003530 5315 JMP UDOIOL /RECORD AND SO WE READ AGAIN. /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 53 /DEFINE FILE PROCESSOR 003531 4573 DFINE, JMS I [RWINIT /SET UP A POINTER INTO THE D.A. TABLE 003532 1000 1000 /DIRECT ACCESS I/O IS UNFORMATTED 003533 4552 JMS I [ARGLD /GET NUMBER OF RECORDS 003534 4551 JMS I [FFIX 003535 1070 TAD ACI 003536 7041 CIA 003537 3020 DUMPIT, DCA T /SAVE IT FOR MULTIPLY 003540 4552 JMS I [ARGLD /GET THE NUMBER OF WORDS/RECORD 003541 4553 JMS I [FPGO /CONVERT WORDS TO BLOCKS 003542 3364 FWTOBL 003543 4551 JMS I [FFIX /CONVERT TO INTEGER 003544 2070 ISZ ACI 003545 1070 TAD ACI /MULTIPLY THE NUMBER OF BLOCKS/RECORD 003546 2020 ISZ T /BY THE NUMBER OF RECORDS 003547 5345 JMP .-2 003550 3106 DCA RELBLK /TO GET THE FILE LENGTH IN BLOCKS 003551 1070 TAD ACI 003552 7041 CIA 003553 3412 DCA I XR /STORE NUMBER OF BLOCKS/RECORD 003554 4552 JMS I [ARGLD /GET POINTER TO CONTROL VARIABLE 003555 7333 AC6000 /'TAD (FSTA-FLDA' CHANGE A LOAD TO A STORE 003556 1116 TAD FGPBF 003557 3412 DCA I XR /SAVE "FSTA CONTROL-VARIABLE" 003560 1117 TAD BIOPTR 003561 3412 DCA I XR 003562 1107 TAD TOTBLK 003563 7140 CMA CLL 003564 1106 TAD RELBLK /MAKE SURE WE HAVE ROOM FOR THE FILE 003565 7630 SZLCLA, SZL CLA 003566 4434 DFERR, JMS I ERR /WE DON'T 003567 0106 DFMSG-ERRMSG 003570 7344 AC7776 003571 0110 AND FFLAGS 003572 7001 IAC /FORCE "END-FILED" BIT FOR CLOSE 003573 5775 JMP I (SETTOT /SET LENGTH AND EXIT 003575 1477 003576 6400 003577 0125 3600 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 54 /SWAPPER AND ERROR ROUTINE 003600 4572 SWAP, JMS I [FETPC /SWAPPER CALLING SEQUENCE: 003601 3020 DCA T / TRAP3 SWAP 003602 1020 TAD T / ADDR OVLY*4000000+LVL*100000+ENTRYADR 003603 0167 AND [7 003604 1377 TAD (JA 003605 3342 DCA STRTUP /STORE JA TO ENTRY POINT 003606 4572 JMS I [FETPC 003607 3343 DCA STRTUP+1 003610 1020 TAD T 003611 0174 AND [70 003612 7110 CLL RAR /FORM 4*LVL 003613 1376 TAD (OVLYTB /INDEX INTO LEVEL TABLE 003614 3043 DCA ADR 003615 1020 TAD T 003616 0150 AND [7400 003617 3020 DCA T /T CONTAINS OVERLAY NUMBER IN BITS 0-3 003620 6201 CDF 0 /WATCH D.F.! 003621 1443 TAD I ADR 003622 1020 TAD T /SEE IF THIS OVERLAY IS IN CORE 003623 7650 SNA CLA 003624 5335 JMP ITSIN /YES - DON'T LOAD 003625 1020 TAD T 003626 7041 CIA 003627 3443 DCA I ADR /MARK THIS OVERLAY IN CORE (OPTIMIST) 003630 2043 ISZ ADR 003631 1443 TAD I ADR 003632 0150 AND [7400 003633 3320 DCA OVADR /SAVE INITIAL OVERLAY LOAD ADDRESS 003634 1443 TAD I ADR 003635 0174 AND [70 003636 3317 DCA OVIOW /AND FIELD 003637 2043 ISZ ADR 003640 1443 TAD I ADR /GET STARTING BLOCK OF THIS LEVEL 003641 3321 DCA OVBLK 003642 2043 ISZ ADR 003643 1443 TAD I ADR 003644 3344 DCA OVLEN /STORE LENGTH OF OVERLAY IN BLOCKS 003645 1020 OVADLP, TAD T /LEVEL STARTING BLOCK + 003646 7450 SNA /(OVERLAY #) * (OVERLAY LENGTH) 003647 5271 JMP LOADOV /= OVERLAY STARTING BLOCK 003650 1150 TAD [7400 003651 3020 DCA T 003652 1321 TAD OVBLK 003653 1344 TAD OVLEN 003654 3321 DCA OVBLK 003655 5245 JMP OVADLP /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 55 /SWAPPER - CONTINUED 003656 3344 LOADLP, DCA OVLEN /STORE UPDATED OVERLAY LENGTH 003657 1317 TAD OVIOW /GET LAST READ CONTROL WORD 003660 7004 RAL 003661 0150 AND [7400 /CONVERT BLOCK COUNT TO WORD COUNT 003662 1320 TAD OVADR /INCREMENT OVERLAY LOAD ADDRESS (LINK = 0) 003663 3320 DCA OVADR 003664 7006 RTL 003665 7006 RTL /USE THE CARRY 003666 1317 TAD OVIOW /TO INCREMENT THE LOAD FIELD IF NECESSARY 003667 0174 AND [70 003670 3317 DCA OVIOW /OVIOW CONTAINS ONLY THE LOAD FIELD NOW 003671 1320 LOADOV, TAD OVADR 003672 7041 CIA /LOTSA CALCULATIONS HERE - OS/8 HANDLERS 003673 7450 SNA /CAN'T READ MORE THAN 15 BLOCKS AT A TIME 003674 1150 TAD [7400 /AND CANNOT READ OVER FIELD BOUNDARIES 003675 7106 CLL RTL 003676 7006 RTL /SO WE MUST BREAK UP THE OVERLAY READ 003677 7064 CMA CML RAL /INTO SEVERAL SMALL READS OF MAXIMAL LENGTH. 003700 1344 TAD OVLEN /THE NUMBER OF BLOCKS TO READ IS GIVEN BY: 003701 7040 CMA /MINIMUM(B,L,15) 003702 7500 SMA /WHERE B IS THE # OF BLOCKS LEFT IN THIS FIELD 003703 7200 CLA /AND L IS THE # OF BLOCKS LEFT IN THE OVERLAY 003704 1344 TAD OVLEN /AND 15 IS THE # OF BLOCKS A HANDLER CAN READ 003705 3020 DCA T / ANSWER IN T 003706 1020 TAD T 003707 7112 CLL RTR 003710 7012 RTR 003711 7012 RTR /TURN NUMBER OF BLOCKS INTO 0S/8 BLOCK COUNT 003712 1317 TAD OVIOW 003713 3317 DCA OVIOW /ADD FIELD BITS AND STORE AS I/O CONTROL WD 003714 1346 TAD OVHCDW /GET OVERLAY HANDLER CODE WORD 003715 4775 JMS I (GETHND /LOAD HANDLER INTO FIELD 0 003716 4745 JMS I OVHND 003717 0000 OVIOW, 0 003720 0000 OVADR, 0 003721 0000 OVBLK, 0 003722 4434 OVERR, JMS I ERR /WHOOPS - OVERLAY READ ERROR 003723 0045 OVMSG-ERRMSG 003724 4347 JMS RECOVR /CLEAR ANY NASTY FLAGS LEFT BY HANDLER 003725 1020 TAD T 003726 1321 TAD OVBLK 003727 3321 DCA OVBLK /UPDATE BLOCK NUMBER 003730 1020 TAD T 003731 7041 CIA 003732 1344 TAD OVLEN /BUMP DOWN RECORD COUNT 003733 7440 SZA /SEE IF WE ARE DONE 003734 5256 JMP LOADLP /NO - PREPARE FOR NEXT READ /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 56 /OVERLAY IN CORE - EXECUTE IT 003735 4553 ITSIN, JMS I [FPGO /START UP FPP 003736 3742 STRTUP /AND JA TO ENTRY POINT TRAP5I, TRAP6I, TRAP7I, FPAUSE, 003737 6032 FPHALT, KCC /KILL ^C FLAG WHICH LED TO FPP ERR 003740 4434 FPPERR, JMS I ERR /SHOULD NEVER GET HERE OTHERWISE 003741 0066 FPPMSG-ERRMSG 003742 0000 STRTUP, 0;0 /JA ENTRY 003743 0000 003744 0000 OVLEN, 0 003745 0000 OVHND, 0 /SET BY LOADER 003746 0000 OVHCDW, 0 /SET BY LOADER 003747 0000 RECOVR, 0 /ROUTINE TO CLEAN UP ANY FLAGS 003750 3073 DCA CTCINH /LEFT ON BY SLOPPY OS/8 HANDLERS. 003751 7000 YRCOVR, NOP 003752 7000 NOP 003753 6001 ION 003754 5747 JMP I RECOVR 003755 6400 FSTTMP, FSTA+LONG 003756 4566 FTEMP 003757 0000 FEXIT 003760 0000 CORCHK, 0 003761 1374 TAD (-215 /WAS IT EOL ? 003762 7650 SNA CLA 003763 5370 JMP COREND /YES, RESET TO START 003764 2773 ISZ I (CORPNT /GO TO NEXT LOC 003765 1773 TAD I (CORPNT 003766 1175 TAD [-7600 /OVERFLOW? 003767 7650 SNA CLA 003770 1150 COREND, TAD [CORREC /YES RESET TO BOTTOM 003771 5760 JMP I CORCHK /NO 003773 0334 003774 7563 003775 2715 003776 4204 003777 1030 4000 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 57 /INPUT BUFFER - CONTAINS STARTUP CODE 004000 7650 INBUFR, -130 /LENGTH (A BIT MORE THAN SCREEN, MODULO 8) 004001 0000 0 /INPUT LINE BUFFER - FIRST A LITTLE PADDING, /RTS EXECUTION INITIALIZATION - IN INPUT BUFFER 004002 6022 FPSTRT, PCF /HSP FLAG 004003 6012 RRB /HSR FLAG 004004 7200 CLA /CLEAR READER CHAR 004005 6135 6135 /CLEAR KW12 OR DK8-EP EVENT FLAGS 004006 7200 CLA 004007 6132 6132 /STOP KW12 CLOCKS 004010 6134 6134 /DISABLE KW12 INTERRUPTS 004011 6530 6530 /CLEAR AD8-EA FLAGS 004012 6050 6050 /CLEAR VC8/E FLAG 004013 6500 6500 /DISABLE XY8/E INTERRUPTS 004014 7340 AC7777 004015 6130 6130 /DISABLE DK8-EP INTERRUPTS 004016 7200 CLA /LEAVE SPACE FOR ADDITIONAL CLEARS 004017 6576 6576 /CLEAR DKC8-AA INTERRUPT 004020 6305 6305 004021 6325 6325 /CLEAR SLU'S 004022 6756 6756 /CLEAR FLOPPY 004023 6665 6665 /CLEAR LA8 INTENA, SET LE8 INTENA 004024 6667 6667 /CLEAR LE8 INTENA 004025 7000 NOP 004026 7000 NOP 004027 7000 NOP 004030 7000 NOP 004031 7000 NOP 004032 3025 DCA EOLSW 004033 4553 LDPROG, JMS I [FPGO /START UP FPP OR PSEUDO-FPP 004034 4044 STSWAP 004035 7000 HLTNOP, NOP /SET TO HLT IF /H SPECIFIED, 004036 1254 TAD XX215 004037 4475 JMS I PTTY /PRINT CARRIAGE RETURN 004040 1255 TAD XXJMS 004041 3656 DCA I XXERR /ENABLE ERROR TRACEBACK 004042 4553 JMS I [FPGO 004043 4052 STJUMP /NOW JUMP TO THE NEWLY-LOADED CODE 004044 3000 STSWAP, TRAP3 /TRAP3 004045 3600 SWAP 004046 0000 0 004047 4050 .+1 004050 3000 TRAP3 004051 4035 HLTNOP 004052 0000 STJUMP, 0 004053 0000 0 004054 0215 XX215, 215 004055 4563 XXJMS, JMS I [FMTOUT 004056 5035 XXERR, ERRENB 004057 0000 ZBLOCK INBUFR+132-. /PAD OUT TO END OF BUFFER + 2 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 58 4200 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 59 /OVERLAY AND DSRN TABLES 004200 0000 ZBLOCK 4 /FREE, KEEP DSRN WHERE IT WAS 004204 0000 OVLYTB, ZBLOCK 40 /OVERLAY TABLE IFNZRO .-4244 <DSERR, _ /'USR' NEEDS THIS > 0000 XV1=0 /NO INITIAL FLAGS 1234 XV2=1234 /*K* PREVENT PROBLEM IN RWINIT (WRITE AFTER READ TTY) 004244 0317 DSRN, CORHAN; 2; ZBLOCK 6; XV1 004245 0002 004246 0000 004254 0000 004255 0000 0; ZBLOCK 7; XV1 004256 0000 004265 0000 004266 0236 LPT; ZBLOCK 7; XV1 004267 0000 004276 0000 004277 0271 TTY; 0;0;XV2;0;0;0;0;XV1 004300 0000 004301 0000 004302 1234 004303 0000 004304 0000 004305 0000 004306 0000 004307 0000 004310 0000 0; ZBLOCK 7; XV1 004311 0000 004320 0000 004321 0000 0; ZBLOCK 7; XV1 004322 0000 004331 0000 004332 0000 0; ZBLOCK 7; XV1 004333 0000 004342 0000 004343 0000 0; ZBLOCK 7; XV1 004344 0000 004353 0000 004354 0000 0; ZBLOCK 7; XV1 004355 0000 004364 0000 004365 0000 ZBLOCK 12 /FORMAT PARENTHESIS PUSHDOWN LIST 004377 0000 FMTPDL, 0 /GUARD WORD 4400 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 60 /SOFTWARE FLOATING POINT ROUTINES WHICH ARE USED /EVEN IF FLOATING HARDWARE IS PRESENT /** MUST NOT DESTROY FAC! ** 004400 0000 FFIX, 0 /ROUTINE TO FIX FAC 004401 7340 AC7777 /ANSWER IS RETURNED IN ACI 004402 1044 TADACX, TAD ACX /ABS(FAC) MUST BE LESS THAN 2048 004403 7100 CLL /DETERMINE IF FAC EXPONENT IS 004404 1377 TAD (-13 /BETWEEN 1 AND 14 004405 7450 SNA 004406 5224 JMP FIXBIG /14 IS A SPECIAL CASE 004407 3070 EAEFIX, DCA ACI 004410 7430 SZL 004411 5222 JMP FIXDNE /EXP GT 14 OR LT 1 - RETURN 0 004412 1045 TAD ACH 004413 5220 JMP FIXISZ 004414 7100 FIXLP, CLL /0 IN LINK 004415 7510 SPA /IS IT LESS THAN 0? 004416 7020 CML /YES-PUT A 1 IN LINK 004417 7010 RAR /SCALE RIGHT 004420 2070 FIXISZ, ISZ ACI /DONE YET? 004421 5214 JMP FIXLP /NO 004422 3070 FIXDNE, DCA ACI /RETURN WITH ANSWER IN ACI 004423 5600 JMP I FFIX /RETURN 004424 1046 FIXBIG, TAD ACL /IF EXP IS 14 WE MUST SHIFT AC FRACTION 004425 7004 RAL /LEFT ONE PLACE TO INTEGERIZE IT. 004426 7200 CLA 004427 1045 TAD ACH 004430 7004 RAL 004431 5222 JMP FIXDNE /STORE ANSWER AND RETURN 004432 1032 SETB, TAD DATAF 004433 3776 DCA I (BASCDF /SET BASE PAGE LOCATION 004434 1043 TAD ADR 004435 3042 DCA BASADR 004436 5477 JMP I FPNXT /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 61 / /SHIFT FAC LEFT 1 BIT / 004437 0000 AL1, 0 004440 1053 TAD AC1 /GET OVERFLOW BIT 004441 7104 CLL RAL /SHIFT LEFT 004442 3053 DCA AC1 /STORE BACK 004443 1046 TAD ACL /GET LOW ORDER MANTISSA 004444 7004 RAL /SHIFT LEFT 004445 3046 DCA ACL /STORE BACK 004446 1045 TAD ACH /GET HI ORDER 004447 7004 RAL 004450 3045 DCA ACH /STORE BACK 004451 5637 JMP I AL1 /RETN. / /SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE) / 004452 0000 ACSR, 0 004453 7040 CMA /AC CONTAINS COUNT-1 004454 3052 DCA AC0 /STORE COUNT 004455 1045 LOP1, TAD ACH /GET HIGH ORDER MANTISSA 004456 7100 CLL 004457 7510 SPA /PROPAGATE SIGN 004460 7020 CML 004461 7010 RAR /SHIFT RIGHT 1, PROPAGATING SIGN 004462 3045 DCA ACH /STORE BACK 004463 1046 TAD ACL /GET LOW ORDER 004464 7010 RAR /SHIFT IT 004465 3046 DCA ACL /STORE BACK 004466 2044 ISZ ACX /INCREMENT EXPONENT 004467 7000 NOP 004470 2052 ISZ AC0 /DONE? 004471 5255 JMP LOP1 /NO-LOOP 004472 7010 RAR 004473 3053 DCA AC1 /SAVE 1 BIT OF OVERFLOW 004474 5652 JMP I ACSR /YES-RETN-AC=L=0 / /FLOATING NEGATE / 004475 0000 FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE) 004476 1046 TAD ACL /GET LOW ORDER FAC 004477 7141 CLL CMA IAC /NEGATE IT 004500 3046 DCA ACL /STORE BACK 004501 7024 CML RAL /ADJUST OVERFLOW BIT AND 004502 1045 TAD ACH /PROPAGATE CARRY-GET HI ORD 004503 7141 CLL CMA IAC /NEGATE IT 004504 3045 DCA ACH /STORE BACK 004505 5675 JMP I FFNEG /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 62 004506 0000 OADD, 0 /ADD OPERAND TO FAC 004507 7100 CLL 004510 1054 TAD AC2 /ADD OVERFLOW WORDS 004511 1053 TAD AC1 004512 3053 DCA AC1 004513 7004 RAL /ROTATE CARRY 004514 1057 TAD OPL /ADD LOW ORDER MANTISSAS 004515 1046 TAD ACL 004516 3046 DCA ACL 004517 7004 RAL 004520 1056 TAD OPH /ADD HI ORDER MANTISSAS 004521 1045 TAD ACH 004522 3045 DCA ACH 004523 5706 JMP I OADD /RETN. 004524 0000 FETPC, 0 004525 2040 ISZ PC 004526 5334 JMP PCCDF /NO FIELD BUMP 004527 2037 ISZ APT /BUMP FIELD FOR FPP RESTART (IN CASE FPP EXISTS) 004530 0010 FPC10, 10 /PROTECTION FOR ISZ 004531 1334 TAD PCCDF 004532 1330 TAD FPC10 004533 3334 DCA PCCDF 004534 7402 PCCDF, HLT 004535 1440 TAD I PC 004536 5724 JMP I FETPC 004537 7120 EEPUT, STL /EXTENDED PRECISION STORE 004540 3043 EEGET, DCA ADR /EXTENDED PRCISION FETCH 004541 1133 TAD [-6 004542 3031 DCA DATCDF 004543 7420 SNL 004544 7332 AC2000 /SET UP "TAD ACX" OR "DCA ACX" 004545 1202 TAD TADACX 004546 3351 DCA EEINST 004547 7420 EELOOP, SNL /LINK=1 MEANS STORE 004550 1443 TAD I ADR 004551 7402 EEINST, HLT 004552 7430 SZL 004553 3443 DCA I ADR 004554 2043 ISZ ADR 004555 7410 SKP 004556 4775 JMS I (DFBUMP 004557 2351 ISZ EEINST 004560 2031 ISZ DATCDF 004561 5347 JMP EELOOP 004562 5477 JMP I FPNXT 004563 6400 FSTTM2, FSTA+LONG 004564 0200 FTEMP2 004565 0000 FEXIT / 004566 0000 FTEMP, ZBLOCK 6 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 62-1 / 004575 6114 004576 6025 004577 7765 4600 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 63 /RTS ERROR MESSAGES ERRMSG, 004600 0201 ARGMSG, TEXT /BAD ARG/ 004601 0440 004602 0122 004603 0700 004604 2523 UMSG, TEXT /USER ERROR/ 004605 0522 004606 4005 004607 2222 004610 1722 004611 0000 004612 2001 FPOMSG, TEXT /PARENS TOO DEEP/ 004613 2205 004614 1623 004615 4024 004616 1717 004617 4004 004620 0505 004621 2000 004622 0617 FMTMSG, TEXT /FORMAT ERROR/ 004623 2215 004624 0124 004625 4005 004626 2222 004627 1722 004630 0000 004631 2516 UNTMSG, TEXT /UNIT ERROR/ 004632 1124 004633 4005 004634 2222 004635 1722 004636 0000 004637 1116 INMSG, TEXT /INPUT ERROR/ 004640 2025 004641 2440 004642 0522 004643 2217 004644 2200 004645 1726 OVMSG, TEXT /OVERLAY / 004646 0522 004647 1401 004650 3140 004651 0000 4651 *.-1 004651 1157 IOMSG, TEXT %I/O ERROR% 004652 1740 004653 0522 004654 2217 004655 2200 004656 1617 DAMSG, TEXT /NO DEFINE FILE/ 004657 4004 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 63-1 004660 0506 004661 1116 004662 0540 004663 0611 004664 1405 004665 0000 004666 0620 FPPMSG, TEXT /FPP ERROR/ 004667 2040 004670 0522 004671 2217 004672 2200 004673 0517 INEMSG, TEXT /EOF ERROR/ 004674 0640 004675 0522 004676 2217 004677 2200 004700 0411 DV0MSG, TEXT /DIVIDE BY 0/ 004701 2611 004702 0405 004703 4002 004704 3140 004705 6000 004706 0456 DFMSG, TEXT /D.F. TOO BIG/ 004707 0656 004710 4024 004711 1717 004712 4002 004713 1107 004714 0000 004715 0611 IOVMSG, TEXT /FILE / 004716 1405 004717 4040 004720 0000 4720 *.-1 004720 1726 OFLMSG, TEXT /OVERFLOW/ 004721 0522 004722 0614 004723 1727 004724 0000 004725 3602 CTLBMS, TEXT /^B/ 004726 0000 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 64 004727 1016 INEOF, TAD VEOFSW /CHECK SWITCH SET BY "CHKEOF" LIBRARY ROUTINE 004730 7450 SNA /WAS HE EXPECTING AN EOF? 004731 5341 JMP EOFERR /NO 004732 4436 JMS I MCDF 004733 3334 DCA .+1 004734 7402 HLT /CDF TO FIELD OF INDICATOR VARIABLE 004735 7332 AC2000 004736 3417 DCA I VEOFSW+1 /SET VARIABLE TO .5 004737 6201 CDF 0 /FALL INTO CARRIAGE RETURN CODE 004740 5777 JMP I (INCRET 004741 4434 EOFERR, JMS I ERR 004742 0073 INEMSG-ERRMSG 004743 4434 LARGER, JMS I ERR 004744 0000 ARGMSG-ERRMSG 004745 1352 USRERR, TAD ERRFLG /USER ERROR - OPTIONALLY NON-FATAL 004746 3035 DCA FATAL 004747 4434 UERR, JMS I ERR /PRINT MESSAGE 004750 0004 UMSG-ERRMSG 004751 5577 JMP I [RETURN /IF NON-FATAL, CONTINUE PROCESSING 004752 0000 ERRFLG, 0 /SET TO NON-ZERO IF /E SWITCH SPECIFIED 004753 3000 TRPPRT, TRAP3 /CODE WHICH IS LOADED INTO PROGRAM PROLOGUES 004754 5034 PRTNAM /BY THE ERROR TRACEBACK ROUTINE 004755 0000 MAKCDF, 0 /ROUTINE TO MAKE A CDF FROM AC9-11 004756 7006 RTL 004757 7004 RAL 004760 0174 AND [70 004761 1376 TAD (CDF 0 /STRAIGHTFORWARD ENOUGH, ISN'T IT? 004762 5755 JMP I MAKCDF 004763 0004 TEN, 4;2400;0;0;0;0 /10.0D0 004764 2400 004765 0000 004766 0000 004767 0000 004770 0000 004771 0007 FLTG85, 7;2520;0 /85.0 004772 2520 004773 0000 004776 6201 004777 3120 5000 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 65 005000 0000 RD2WR, 0 /ROUTINE CALLED WHEN SWITCHING 005001 7340 AC7777 /FROM READ TO WRITE. (CALLED ONLY ONCE!) 005002 1106 TAD RELBLK /BUMP BLOCK # BACK FROM "NEXT BUFFER'S BLOCK #" 005003 3106 DCA RELBLK /TO "THIS BUFFER'S BLOCK #". 005004 1104 TAD CHRCTR /HOWEVER, IF WE ARE AT THE VERY END OF A 005005 7001 IAC /BUFFER, WRITE ROUTINE EXPECTS US TO 005006 7640 SZA CLA /BE AT THE BEGINNING OF THE NEXT BUFFER, 005007 4546 JMS I [MASSIO /SO RE-READ THIS BUFFER AND SET POINTERS 005010 5600 JMP I RD2WR /RUN-TIME-SYSTEM ERROR ROUTINE 005011 0000 ERROR, 0 005012 6201 CDF 0 005013 7200 CLA 005014 1611 TAD I ERROR 005015 1377 TAD (ERRMSG /MSG-ERRMSG+ERRMSG 005016 3776 DCA I (FMTADR 005017 3775 DCA I (FMTDF 005020 1075 TAD PTTY 005021 3100 DCA HAND /QUICK FUDGE FOR TTY OUTPUT 005022 3101 DCA HCODEW /TO SET CARRIAGE CONTROL 005023 7330 AC4000 005024 3023 DCA RWFLAG 005025 4561 JMS I [EOLINE /TYPE CARRET AND SET EOLSW 005026 3060 DCA FMTBYT /INITIALIZE MESSAGE PTR 005027 4563 ERPTLP, JMS I [FMTOUT /OUTPUTS LF FIRST TIME 005030 4564 JMS I [FMTGCH /GET CHAR USING FORMAT ROUTINES 005031 2060 ISZ FMTBYT 005032 7440 SZA 005033 5227 JMP ERPTLP /LOOP UNTIL 0 CHAR /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 66 /PRINT ROUTINE NAME AND LINE NUMBER 005034 1137 PRTNAM, TAD [40 005035 5725 ERRENB, JMP I E7605 /*K* IN CASE INITIALIZATION OR /P GET ERRORS / PREVIOUS LINE REPLACED WITH: / JMS I [FMTOUT /OUTPUT A BLANK(LF ON EXTRA LINES) 005036 4553 JMS I [FPGO /START UP FPP 005037 5106 GTNMPT /GET POINTER TO NAME IN FAC 005040 1045 TAD ACH 005041 3775 DCA I (FMTDF /SET UP FORMAT GET CHARACTER ROUTINE 005042 1046 TAD ACL /TO GET CHARACTERS OF ROUTINE NAME 005043 3776 DCA I (FMTADR 005044 3060 DCA FMTBYT 005045 1133 TAD [-6 005046 3304 DCA ISN /6 CHARACTER NAME 005047 4564 PRTNML, JMS I [FMTGCH 005050 7450 SNA 005051 1137 TAD [40 /AVOID PRINTING RANDOM @S 005052 4563 JMS I [FMTOUT /GET AND PRINT A CHARACTER 005053 2060 ISZ FMTBYT 005054 2304 ISZ ISN 005055 5247 JMP PRTNML 005056 1137 TAD [40 005057 4563 JMS I [FMTOUT /SEPARATE THE NAME BY A SPACE 005060 1134 TAD [-4 /FROM THE LINE NUMBER. 005061 3304 DCA ISN 005062 1305 PTLNLP, TAD ISN+1 005063 7106 CLL RTL 005064 7004 RAL 005065 3305 DCA ISN+1 /PRINT LINE NUMBER IN OCTAL 005066 1305 TAD ISN+1 /BECAUSE THAT IS THE WAY IT APPEARS 005067 7004 RAL /IN THE FORTRAN PROGRAM LISTING 005070 0167 AND [7 005071 4774 JMS I (DIGIT 005072 2304 ISZ ISN 005073 5262 JMP PTLNLP 005074 4561 JMS I [EOLINE /OUTPUT FINAL CR 005075 1035 TAD FATAL 005076 7650 SNA CLA /FATAL ERROR? 005077 5302 JMP TRCBAK /YES - GIVE FULL TRACEBACK 005100 3035 DCA FATAL /"NON-FATAL" FLAG MUST BE SET EACH TIME 005101 5611 JMP I ERROR 005102 4553 TRCBAK, JMS I [FPGO /START UP FPP 005103 5120 UP1LEV /MOVE UP TO CALLING ROUTINE /FPP CODE DOES A "TRAP3 PRTNAM" 005104 0000 ISN, 0;0 005105 0000 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 67 /FPP CODE FOR ERROR ROUTINE 005106 0006 GTNMPT, STARTD 005107 0030 XTA 0 /LOAD LINE NUMBER FROM XR 0 005110 6400 FSTA+LONG 005111 5104 ISN /STORE AWAY 005112 0210 FLDA+BASE 10 /LOAD POINTER TO PROLOGUE 005113 2400 FSUB+LONG 005114 5116 THREE /NAME IS 3 LOCATIONS BEFORE PROLOGUE 005115 0005 STARTF /FOR NON-FPP VERSION 005116 0000 THREE, FEXIT;3 /*K* DEPENDS ON FACT THAT FEXIT=0 005117 0003 005120 0006 UP1LEV, STARTD 005121 0211 FLDA+BASE 11 /GET THE UPWARD POINTER 005122 1040 JNE 005123 5126 NOTMN /ZERO MEANS MAIN PROGRAM 005124 3000 TRAP3 005125 7605 E7605, 7605 /GO AWAY IF MAIN PROGRAM 005126 6200 NOTMN, FSTA+BASE 0 005127 0101 LDX 1 005130 0002 2 /WE WILL STORE A "TRAP3 PRTNAM" 005131 0400 FLDA+LONG /IN THE FIFTH LOCATION OF THE PROLOGUE, 005132 4753 TRPPRT 005133 6610 FSTA+IND 0+10 /WHERE THE FIRST 4 LOCS WERE A SETX AND SETB. 005134 0200 FLDA+BASE 0 /GET THE PROLOGUE ADDRESS AGAIN 005135 0007 JAC /JUMP TO IT. 005136 4400 ACMDGT, FMUL+LONG 005137 4763 TEN 005140 6400 FSTA+LONG 005141 4566 FTEMP 005142 0400 FLDA+LONG 005143 2526 DGT /GET UNNORMALIZED DIGIT INTO AC 005144 0004 FNORM /NORMALIZE IT 005145 1400 FADTMP, FADD+LONG 005146 4566 FTEMP 005147 0000 FEXIT 005174 2371 005175 0723 005176 0673 005177 4600 5200 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 68 IFNZRO .-5200 < HPLERR,_/'USR' NEEDS THIS > HPLACE, /ZBLOCK 400 /HANDLER SWAP AREA /VARIOUS INITIALIZATION STUFF OVERLAYING THE RTS HANDLER AREA 005200 0000 QLHDR, 0 /SHOULD BE A 2 FOR A LOADER IMAGE 005201 0000 QRTSWP, ZBLOCK 2 /INITIAL SWAP ARGS TO LOAD USER MAIN 005203 0000 QHGHAD, ZBLOCK 2 /HIGHEST ADDRESS USED 005205 0000 QVERNO, 0 /LOADER VERSION # 005206 0000 QDPFLG, 0 /"PROGRAM USES D.P." FLAG 005207 0000 QUSRLV, ZBLOCK 40 /USER OVERLAY INFO /EAE OVERLAY TO FIX AND FLOAT 4407 EFXFLT, RELOC EAEFIX 004407* 7040 FIXEAE, CMA 004410* 3215 DCA FIXSH /SHIFT COUNT BETWEEN 0 AND 12 004411* 7430 SZL 004412* 5216 JMP FIX0 /NOT INTEGERIZABLE 004413* 1045 TAD ACH 004414* 7415 ASR 004415* 0000 FIXSH, 0 004416* 3070 FIX0, DCA ACI 004417* 5600 JMP I FFIX 0011 FXFLTC= .-FIXEAE 5260 RELOC /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 69 /SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF /BANKS IN AC. /MUST RUN IN FIELD 0. 005260 0000 CORE, 0 005261 1331 TAD C6203 005262 6214 RDF 005263 3324 DCA CORRET 005264 6201 CORELP, CDF 0 /NEEDED FOR PDP-8L 005265 1732 TAD I C7777 005266 0307 AND COR70 /IF BITS 6-8 OF LOCATION 7777 ARE NOT ZERO, 005267 7112 CLL RTR /THEY SPECIFY THE LAST FIELD OF CORE 005270 7010 RAR /WHICH WE SHOULD USE. 005271 7440 SZA 005272 5324 JMP CORRET /SO RETURN THAT AMOUNT 005273 1330 TAD TRYFLD /GET FLD TO TST 005274 7106 CLL RTL 005275 7004 RAL 005276 0307 AND COR70 /MASK USEFUL BITS 005277 1264 TAD CORELP 005300 3301 DCA COR706 /SET UP CDF TO FLD 005301 0000 COR706, 0 005302 1726 TAD I CORLOC /SAV CURRENT CONTENTS 005303 7000 NOP /HACK FOR PDP-8 005304 3301 DCA .-3 005305 1303 TAD .-2 /7000 IS A GOOD PATTERN 005306 3726 DCA I CORLOC 005307 0070 COR70, 70 /HACK FOR PDP-8.,NO-OP 005310 1726 TAD I CORLOC /TRY TO READ BK 7000 005311 7400 CO7400, 7400 /HACK FOR PDP-8,.NO-OP 005312 1311 TAD CO7400 /GUARD AGAINST WRAP AROUND 005313 1327 TAD CORLOC+1 /TAD 1400 005314 7640 SZA CLA 005315 5322 JMP .+5 /NON EXISTENT FLD EXIT 005316 1301 TAD COR706 /RESTORE CONTENS DESTROYED 005317 3726 DCA I CORLOC 005320 2330 ISZ TRYFLD /TRY NXT HIGHER FLD 005321 5264 JMP CORELP 005322 7340 AC7777 005323 1330 TAD TRYFLD 005324 0000 CORRET, 0 005325 5660 JMP I CORE 005326 5311 CORLOC, CO7400 /ADR TO TST IN EACH FLD 005327 1400 1400 /7000+7400+1400=0 005330 0001 TRYFLD, 1 /CURRENT FLD TO TST 005331 6203 C6203, 6203 005332 7777 C7777, 7777 005333 0050 DPTEST, STARTE /EXECUTED BY FPP DURING INITIALIZATION 005334 0000 FEXIT /CHECK WHETHER DOUBLE PRECISION ENABLED /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 70 /TABLE OF MODIFICATIONS TO MAKE TO FRTS FOR BACKGROUND OPERATION /UNDER MULTI-8. FORMAT OF TABLE IS: POINTER TO FIRST WORD OF BLOCK - 1 / (0 TERMINATES) FOLLOWED BY LIST OF REPLACEMENT WORDS (0 TERMINATES). 005335 0241 BKRLST, YLPT-1 /LINE PRINTER OUTPUT ROUTINE 0242 RELOC YLPT 000242* 6666 LLS 000243* 7200 CLA /DON'T DO RING-BUFFERING - JUST "OUTPUT" CHAR. 000244* 4305 JMS CTCBCK /CHECK FOR ^C 000245* 5636 JMP I LPT 000246* 4305 FJCTCT, JMS CTCBCK /COME HERE FROM INTERPRETED FPP JUMPS 000247* 5477 JMP I FPNXT /CHECK FOR ^C AND RETURN TO INTERPRETER 5344 RELOC 005344 0000 0 005345 0271 YTTY-1 /TELETYPE INPUT/OUTPUT ROUTINE 0272 RELOC YTTY 000272* 7450 SNA 000273* 5300 JMP KBDRTS /AC=0 MEANS INPUT 000274* 6046 TLS /NO NEED TO TEST FLAG 000275* 7200 CLA 000276* 4305 JMS CTCBCK /CHECK FOR ^C TYPED 000277* 5671 JMP I TTY 000300* 6031 KBDRTS, KSF 000301* 5300 JMP .-1 /HANG UNTIL CHAR RECEIVED 000302* 4305 JMS CTCBCK /CHECK FOR ^C 000303* 6036 KRB 000304* 5671 JMP I TTY /MULTI8 DOES PARITY FOR ME 000305* 0305 CTCBCK, . /*K* CAN'T BE 0! 000306* 6034 KRS /PEEK AT NEXT CHAR IN BUFFER 000307* 1314 TAD KBM203 000310* 7650 SNA CLA /IS IT ^C? 000311* 6031 KSF /AND IS FLAG SET ? 000312* 5705 JMP I CTCBCK /NO - JUST RETURN WITH AC=0 000313* 5350 JMP BEEORC /TERMINATE JOB ON ^C 000314* 7575 KBM203, -203 5371 RELOC 005371 0000 0 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 71 /CONTINUATION OF TABLE OF MULTI-8 OVERLAYS TO FRTS 005372 0347 BEEORC-1 005373 7410 SKP /ALWAYS TRACEBACK WITH ^C 005374 0000 0 005375 4724 CTLBMS-1 005376 3603 TEXT /^C/ /^C TRACEBACK MESSAGE 005377 0000 /*K* NOTE THE IMPLICIT ZERO! 005400 4001 FPSTRT-1 4002 RELOC FPSTRT 004002* 5232 JMP LDPROG-1/SKIP FLAG-CLEARING STUFF 5402 RELOC 005402 0000 0 005403 3750 YRCOVR-1 /"RECOVER FROM OS/8 HANDLER" ROUTINE 3751 RELOC YRCOVR 003751* 5747 JMP I RECOVR /SHORT-CIRCUIT PORTION OF ROUTINE WHICH DOES 5405 RELOC /AN "ION" 005405 0000 0 005406 6305 YFJMP-1 /FPP INTERPRETER - SUCCESSFUL JUMP SECTION 005407 0246 FJCTCT /TEST FOR ^C TYPED BEFORE 005410 0000 0 /RETURNING TO THE INTERPRETER 005411 0000 0 /** LIST TERMINATOR ** /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 72 /ERROR MESSAGES FOR RUN-TIME LOADER - IN HANDLER BUFFER /*K* CANNOT LOAD BELOW HPLACE+200 AS HPLACE-HPLACE+177 ARE DESTROYED BY HEADER! IFNZRO .-HPLACE-200&4000 <__ERROR__> 005412 1617 NOLI, TEXT /NOT A LOADER IMAGE/ 005413 2440 005414 0140 005415 1417 005416 0104 005417 0522 005420 4011 005421 1501 005422 0705 005423 0000 005424 1617 NONMSG, TEXT /NO NUMERIC SWITCH/ 005425 4016 005426 2515 005427 0522 005430 1103 005431 4023 005432 2711 005433 2403 005434 1000 005435 0611 FILMSG, TEXT /FILE ERROR/ 005436 1405 005437 4005 005440 2222 005441 1722 005442 0000 005443 2331 SYSMSG, TEXT /SYSTEM DEVICE ERROR/ 005444 2324 005445 0515 005446 4004 005447 0526 005450 1103 005451 0540 005452 0522 005453 2217 005454 2200 005455 1517 TOOMCH, TEXT /MORE CORE REQUIRED/ 005456 2205 005457 4003 005460 1722 005461 0540 005462 2205 005463 2125 005464 1122 005465 0504 005466 0000 005467 2417 TOMNYH, TEXT /TOO MANY HANDLERS/ 005470 1740 005471 1501 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 72-1 005472 1631 005473 4010 005474 0116 005475 0414 005476 0522 005477 2300 005500 0301 LIOEMS, TEXT /CAN'T READ IT!/ 005501 1647 005502 2440 005503 2205 005504 0104 005505 4011 005506 2441 005507 0000 005510 0301 NODPMS, TEXT /CAUTION - NO DP/ 005511 2524 005512 1117 005513 1640 005514 5540 005515 1617 005516 4004 005517 2000 0005 XV1=XVERSN%12 0062 XV2=XV1^12 005520 0622 XVERMS, TEXT /FRTS V/ 005521 2423 005522 4026 005523 0000 5523 *.-1 005523 6560 XV1^100+XVERSN-XV2+6060 /VERSION NUMBER IN SIXBIT 005524 0101 XPATCH&77^100+XPUSER-300 /PATCH LEVEL 005525 4015 TEXT / M8 U F/ /MULTI8, USR, FPP 005526 7040 005527 2540 005530 0600 5600 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 73 /FPP INTERPRETER STARTUP ROUTINE 5600 FPPINT= . /FOR FPP OVERLAY 005600 5477 RETURN, JMP I FPNXT /RETURN DOES SOMETHING DIFFERENT IF FPP PRESENT 005601 0000 FPGO, 0 005602 6201 FPGCDF, CDF 0 /NECESSARY? 005603 7200 CLA 005604 1040 TAD PC 005605 3224 DCA SAVPC /ALLOW ONE LEVEL OF RECURSIVENESS 005606 1777 TAD I (PCCDF 005607 3225 DCA SPCCDF 005610 7340 AC7777 005611 1601 TAD I FPGO 005612 3040 DCA PC 005613 2201 ISZ FPGO 005614 1202 TAD FPGCDF /FPGO STARTS UP THE FPP FROM FIELD 0 ONLY 005615 3777 DCA I (PCCDF 005616 5477 JMP I FPNXT 005617 1224 EXIT, TAD SAVPC 005620 3040 DCA PC 005621 1225 TAD SPCCDF 005622 3777 DCA I (PCCDF /RESTORE OLD PC 005623 5601 JMP I FPGO /RETURN TO PDP-8 CODE 005624 0000 SAVPC, 0 005625 0000 SPCCDF, 0 005626 1132 FPXTA, TAD [27 /XR TO AC - NORMALIZE IF FLOATING MODE 005627 3044 DCA ACX 005630 4031 JMS DATCDF 005631 1443 TAD I ADR 005632 3046 CLFAC, DCA ACL 005633 1046 TAD ACL 005634 7710 SPA CLA /SIGN-EXTEND 12-BIT WORD 005635 7340 AC7777 /INTO FAC FRACTION 005636 3045 DCA ACH 005637 3053 NRMFAC, DCA AC1 /CLEAR OVERFLOW WORD 005640 1021 TAD DFLG 005641 7750 SPA SNA CLA /UNLESS WE ARE IN D.P.I. MODE, 005642 4770 JMS I NORMX /NORMALIZE THE FAC 005643 5477 JMP I FPNXT /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 74 /MISCELLANEOUS JUMP CLASS INSTRUCTIONS 005644 1043 JSA, TAD ADR 005645 3363 DCA PUTM 005646 1032 TAD DATAF 005647 3266 DCA JSCDF /SET UP LOC TO SAVE PC IN 005650 7326 AC0002 005651 1043 TAD ADR 005652 3043 DCA ADR /BUMP ADDRESS BY 2 005653 7006 RTL 005654 7006 RTL 005655 1032 TAD DATAF 005656 3032 DCA DATAF /INCLUDING DATA FIELD 005657 1777 JSAR, TAD I (PCCDF /JSA/JSR COMMON CODE 005660 7112 CLL RTR 005661 7010 RAR 005662 2040 ISZ PC /BUMP PC BEFORE STORING 005663 7410 SKP 005664 7001 IAC /INCLUDING FIELD BITS 005665 1376 TAD (JA-2620 /FORM "JA" INSTRUCTION 005666 7402 JSCDF, HLT 005667 3763 DCA I PUTM 005670 2363 ISZ PUTM 005671 7410 SKP 005672 4775 JMS I (DFBUMP /BUMP TARGET ADDRESS 005673 1040 TAD PC 005674 3763 DCA I PUTM 005675 5774 JMP I (DOJMP /NOW JUMP TO DESTINATION 005676 7324 JSR, AC0001 005677 1042 TAD BASADR 005700 3363 DCA PUTM 005701 7006 RTL 005702 7006 RTL 005703 1773 TAD I (BASCDF /SET JSCDF&PUTM TO BASE PAGE LOC +1 005704 3266 DCA JSCDF 005705 5257 JMP JSAR 005706 1046 FPJAC, TAD ACL 005707 3043 DCA ADR 005710 1045 TAD ACH 005711 4436 JMS I MCDF 005712 3032 DCA DATAF 005713 5774 JMP I (DOJMP 005714 1046 SPCATX, TAD ACL 005715 7410 SKP 005716 4572 FPLDX, JMS I [FETPC 005717 4031 JMS DATCDF 005720 3443 DCA I ADR /SET XR TO NEXT INST WD 005721 5477 JMP I FPNXT /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 75 /MORE INDEX REGISTER & AC-TO-MEMORY INSTRUCTIONS 005722 4572 ADDX, JMS I [FETPC 005723 4031 JMS DATCDF 005724 1443 TAD I ADR /ADD NEXT INST WD TO XR 005725 5317 JMP FPLDX+1 005726 1021 ATX, TAD DFLG /ATX WORKS DIFFERENTLY IN D.P.I. MODE 005727 7740 SMA SZA CLA 005730 5314 JMP SPCATX 005731 4770 JMS I NORMX /FAC MAY NOT BE NORMALIZED 005732 4551 JMS I [FFIX 005733 1070 TAD ACI 005734 5317 JMP FPLDX+1 005735 3362 OPMEM, DCA AD1 /GENERAL AC-TO-MEMORY INTERPRETER 005736 1362 TAD AD1 005737 3364 DCA AD2 005740 6214 RDF 005741 7112 CLL RTR 005742 7010 RAR 005743 1357 TAD KLUDGM /FORM FSTA X INSTRUCTION 005744 3363 DCA PUTM 005745 7332 AC2000 005746 0022 AND INST /TURN OP 5 TO OP 1, 005747 7640 SZA CLA 005750 1162 TAD [3000 / OP 7 TO OP 4. 005751 1162 TAD [3000 005752 1363 TAD PUTM /STICK IN FIELD BITS 005753 3361 DCA OPM 005754 4553 JMS I [FPGO 005755 5757 KLUDGM 005756 5477 JMP I FPNXT 005757 6400 KLUDGM, FSTA+LONG 005760 4566 FTEMP /SAVE AC 005761 0000 OPM, 0 005762 0000 AD1, 0 /PERFORM OP 005763 0000 PUTM, 0 005764 0000 AD2, 0 /STORE RESULT 005765 0400 FLDA+LONG 005766 4566 FTEMP /RESTORE AC 005767 0000 FEXIT 005770 7300 NORMX, FFNOR /*K* CHANGED TO EFFNOR IF EAE 005773 6025 005774 6275 005775 6114 005776 6210 005777 4534 6000 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 76 /MAIN INTERPRETER LOOP 006000 4544 NEGFAC, JMS I [FFNEG 006001 7200 ICYCLE, CLA 006002 4572 JMS I [FETPC /GET INST 006003 3022 DCA INST 006004 1022 TAD INST 006005 7106 CLL RTL 006006 7006 RTL 006007 7500 SMA /SKIP IF BASEPAGE ADDRESSING 006010 5255 JMP LONGI 006011 0167 AND [7 006012 1343 TAD BASJMP 006013 3231 DCA OPJMP /SAVE OPCODE CALL ADDRESS 006014 1022 TAD INST /DATA FIELD IS STILL SET UP 006015 7430 SZL /SO IS LINK (WITH INSTRUCTION BIT 3) 006016 5232 JMP BPAGEI /INDIRECT ADDRESSING 006017 7104 CLL RAL 006020 1022 TAD INST /MULTIPLY BASE OFFSET BY 3 006021 1175 TAD [200 /ELIMINATE ANY 006022 0377 AND (777 /HIGH ORDER BITS 006023 7100 IMFUDJ, CLL /CLL IAC IF D.P. INTEGER MODE 006024 1042 TAD BASADR /ADD IN BASE PAGE ORIGIN 006025 7402 BASCDF, HLT /CDF TO BASE PAGE FIELD 006026 7430 SZL 006027 4314 JMS DFBUMP /BUMP DF IF ADDITION OVERFLOWED 006030 7100 OPJCLL, CLL 006031 7402 OPJMP, HLT /JMP I EXECUTIONROUTINE 006032 0167 BPAGEI, AND [7 006033 3043 DCA ADR 006034 1043 TAD ADR 006035 7124 CLL CML RAL 006036 1043 TAD ADR /FORM 3*OFFSET+1 006037 1042 TAD BASADR 006040 3043 DCA ADR 006041 7006 RTL 006042 7006 RTL 006043 1225 TAD BASCDF /FORM PROPER CDF 006044 3245 DCA ADDRLO 006045 7402 ADDRLO, HLT /EXECUTE IT 006046 1443 TAD I ADR /GET FIELD BITS OF REAL ADDRESS 006047 3311 DCA ADDRHI /FROM 2D WORD OF BASE PAGE LOC 006050 2043 ISZ ADR 006051 7410 SKP 006052 4314 JMS DFBUMP /WATCH FOR FIELD OVERFLOW 006053 1443 TAD I ADR /GET LOW-ORDER ADDRESS FROM 3D WORD 006054 5265 JMP INDEX /NOW GO DO INDEXING (IF ANY) /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 77 /COME HERE IF BIT 4 OF INSTRUCTION IS OFF 006055 0167 LONGI, AND [7 006056 7420 SNL /TEST BIT 3 OF INSTRUCTION 006057 5776 JMP I (SPECAL /SPECIAL INSTRUCTION 006060 1343 TAD BASJMP 006061 3231 DCA OPJMP 006062 1022 TAD INST 006063 3311 DCA ADDRHI /HIGH-ORDER ADDRESS BITS IN INST WD 006064 4572 JMS I [FETPC /NEXT INST WORD CONTAINS LOW-ORDER ADDRESS 006065 3245 INDEX, DCA ADDRLO 006066 1022 TAD INST 006067 0174 AND [70 006070 7450 SNA /IS XR NUMBER 0? 006071 5306 JMP NOINDX /YES - NO INDEXING 006072 4325 JMS DCDIDX /GET XR VALUE (MAYBE INCREMENTED) 006073 7346 AC7775 006074 1021 TAD DFLG /GET -3 IF F, -2 IF D, -6 IF E MODE 006075 3325 DCA DCDIDX 006076 1245 TAD ADDRLO 006077 7100 XRADLP, CLL 006100 1420 TAD I T 006101 7430 SZL 006102 2311 ISZ ADDRHI 006103 2325 ISZ DCDIDX /ADD THE XR IN THE PROPER NUMBER OF TIMES 006104 5277 JMP XRADLP 006105 3245 DCA ADDRLO 006106 1311 NOINDX, TAD ADDRHI 006107 4436 JMS I MCDF 006110 3311 DCA ADDRHI /TURN HIGH-ORDER ADDRESS INTO A CDF 006111 7402 ADDRHI, HLT /AND EXECUTE IT 006112 1245 TAD ADDRLO 006113 5230 JMP OPJCLL /GO EXECUTE THE INSTRUCTION 006114 0000 DFBUMP, 0 /BUMP DATA FIELD 006115 3324 DCA DFTMP /SAVE AC 006116 6214 RDF 006117 1375 TAD (CDF 10 006120 3321 DCA .+1 006121 7402 HLT 006122 1324 TAD DFTMP /RESTORE AC 006123 5714 JMP I DFBUMP 006124 0000 DFTMP, 0 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 78 006125 0000 DCDIDX, 0 006126 7112 CLL RTR 006127 7010 RAR 006130 1041 TAD XRBASE /ADD IN BASE ADDRESS OF XR ARRAY 006131 7402 XRCDF, HLT /CDF TO XR ARRAY FIELD 006132 7430 SZL 006133 4314 JMS DFBUMP /OR MAYBE NEXT FIELD 006134 3020 DCA T /SAVE POINTER TO XR 006135 1022 TAD INST 006136 0341 AND DCD100 006137 7640 SZA CLA /INCREMENT BIT ON? 006140 2420 ISZ I T /YES - BUMP XR 006141 0100 DCD100, 100 /** PROTECTION 006142 5725 JMP I DCDIDX 006143 5744 BASJMP, JMP I JMPTB1 /JMP I JMPTB2 FOR D.P. MODE 006144 6534 JMPTB1, FFGET / F MODE (FLOATING POINT) 006145 7214 FFADD 006146 7211 FFSUB 006147 7011 FFDIV 006150 6627 FFMPY 006151 5735 OPMEM /FADDM 006152 6553 FFPUT 006153 5735 OPMEM /FMULM 006154 6542 DDGET / D MODE ( DOUBLE PRECISION INTEGER) 006155 6530 DDADD 006156 6525 DDSUB 006157 7007 DDDIV 006160 6625 DDMPY 006161 5735 OPMEM /DADDM 006162 6561 DDPUT 006163 5735 OPMEM /DMULM 006164 4540 EEGET / E MODE ( 6 WD FLOATING POINT) 006165 7214 FFADD 006166 7211 FFSUB 006167 7011 FFDIV 006170 6627 FFMPY 006171 5735 OPMEM 006172 4537 EEPUT 006173 5735 OPMEM 006175 6211 006176 6200 006177 0777 6200 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 79 /MORE I CYCLE 006200 7450 SPECAL, SNA 006201 5214 JMP XRINST /OPCODE 0 HAS MANY MANSIONS 006202 1333 TAD SPECOP 006203 3213 DCA SPCJMP /GET OPCODE JUMP ADDRESS 006204 4572 JMS I [FETPC 006205 3043 DCA ADR 006206 1022 TAD INST /ALL OF THESE ARE TWO-WORD INSTRUCTIONS 006207 4436 JMS I MCDF /SO FORM THE ADDRESS NOW 006210 3032 DCA DATAF 006211 6201 CDF 0 006212 1022 TAD INST 006213 7402 SPCJMP, HLT 006214 1022 XRINST, TAD INST 006215 0377 AND (7770 006216 6201 CDF 0 006217 7650 SNA CLA /IF SUB-OPCODE IS ZERO, 006220 5241 JMP OPERAT /DECODE SUB-SUB-OPCODE 006221 1022 TAD INST 006222 0167 AND [7 006223 7100 CLL 006224 1041 TAD XRBASE 006225 3043 DCA ADR /COMPUTE INDEX REGISTER ADDRESS 006226 7006 RTL 006227 7006 RTL 006230 1776 TAD I (XRCDF 006231 3032 DCA DATAF 006232 1022 XJCOMN, TAD INST 006233 7112 CLL RTR 006234 7010 RAR 006235 0166 AND [77 /GET OPCODE - HIGH ORDER 2 BITS ARE 0 006236 1375 OXCOMN, TAD (JMP I SP2 006237 3240 DCA .+1 /EXECUTE APPROPRIATE JUMP 006240 7402 HLT 006241 1022 OPERAT, TAD INST 006242 7041 CIA 006243 5236 JMP OXCOMN 006244 1032 SETX, TAD DATAF /SET XR0 LOC 006245 3776 DCA I (XRCDF 006246 1043 TAD ADR 006247 3041 DCA XRBASE 006250 5477 JMP I FPNXT /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 80 /JUMP DECODER 006251 0374 JUMPS, AND (100 /INSTRUCTION IN AC 006252 7112 CLL RTR /20 IN AC IF NOT COND. JUMP 006253 7440 SZA /IF NOT COND. JUMP, DECODE FURTHER 006254 5232 JMP XJCOMN 006255 1022 TAD INST 006256 0174 AND [70 006257 7112 CLL RTR 006260 7010 RAR 006261 1373 TAD (CNDSKT 006262 3020 DCA T /INDEX INTO CONDITIONAL SKIP TABLE 006263 1420 TAD I T 006264 3273 DCA CNDSKP 006265 1045 TAD ACH 006266 7440 SZA 006267 5273 JMP CNDSKP 006270 1046 TAD ACL 006271 7640 SZA CLA /IF HIGH ORDER ZERO, AC MIGHT BE UNNORMALIZED. 006272 7001 IAC /USE LOW ORDER ON 0/NOT 0 BASIS 006273 7402 CNDSKP, HLT /TEST AC 006274 5477 JMP I FPNXT /FAILED - DON'T JUMP 006275 7340 DOJMP, AC7777 006276 1043 TAD ADR 006277 3040 DCA PC 006300 7420 SNL 006301 1377 TAD (-10 006302 1032 TAD DATAF 006303 6201 CDF 0 006304 3772 DCA I (PCCDF /ADDRESS-1 TO PC 006305 5706 JMP I .+1 006306 6001 YFJMP, ICYCLE /** CHANGED IF RUNNING UNDER RTS-8 006307 0174 JXN, AND [70 /GET XR FIELD 006310 4771 JMS I (DCDIDX /GET XR VALUE WITH INCREMENTING 006311 1420 TAD I T 006312 7650 SNA CLA /ZERO? 006313 5477 JMP I FPNXT /YES 006314 5275 JMP DOJMP /JUMP ON INDEX NON-ZERO, RIGHT? 006315 7640 CNDSKT, SZA CLA /JEQ 006316 7710 SPA CLA /JGE 006317 7740 SMA SZA CLA /JLE 006320 7610 SKP CLA /JA 006321 7650 SNA CLA /JNE 006322 7700 SMA CLA /JLT 006323 7750 SPA SNA CLA /JGT 006324 5325 JMP TSTALN /JAL 006325 7200 TSTALN, CLA 006326 1044 TAD ACX 006327 1370 TAD (-27 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 80-1 006330 7750 SPA SNA CLA 006331 5477 JMP I FPNXT 006332 5275 JMP DOJMP /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 81 /OPCODE TABLES 006333 5733 SPECOP, JMP I SPECOP /SPECIAL OPCODE TABLE 006334 6251 JUMPS 006335 6307 JXN 006336 6400 TRAP3I 006337 6400 TRAP4I 006340 3737 TRAP5I 006341 3737 TRAP6I 006342 3737 TRAP7I 006343 5706 FPJAC 006344 6510 STRTD 006345 6511 STRTF 006346 5637 NRMFAC 006347 6000 NEGFAC 006350 5632 CLFAC 006351 3737 FPAUSE 006352 5617 SP2, EXIT 006353 6411 ALN 006354 5726 ATX 006355 5626 FPXTA 006356 6001 ICYCLE /NOP 006357 6477 STRTE 006360 6001 ICYCLE /UNDEF OP 006361 6001 ICYCLE /" 006362 5716 FPLDX 006363 5722 ADDX 006364 6244 SETX 006365 4432 SETB 006366 5644 JSA 006367 5676 JSR 006370 7751 006371 6125 006372 4534 006373 6315 006374 0100 006375 5752 006376 6131 006377 7770 6400 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 82 /MISCELLANEOUS OPCODE ROUTINES TRAP3I, 006400 7326 TRAP4I, AC0002 006401 1032 TAD DATAF 006402 3203 DCA .+1 /FORM CDF CIF N 006403 7402 HLT /EXECUTE IT 006404 1022 TAD INST 006405 7700 SMA CLA /TRAP4 JMS'S TO ITS TARGET ADDRESS, 006406 5443 JMP I ADR /TRAP3 JMP'S TO IT 006407 4443 JMS I ADR 006410 5477 JMP I FPNXT 006411 1044 ALN, TAD ACX /ALIGN SIMULATOR 006412 3055 DCA OPX /SAVE EXPONENT IN CASE WE'RE IN D.I. MODE 006413 1021 TAD DFLG 006414 7740 SMA SZA CLA 006415 3044 DCA ACX /ZERO EXP IF D.I. MODE 006416 4031 JMS DATCDF /SET TO XR FIELD 006417 1022 TAD INST 006420 0167 AND [7 006421 1021 TAD DFLG /IF WE'RE IN FLOATING POINT MODE, 006422 7650 SNA CLA /AND DOING AN "ALN 0", 006423 1132 TAD [27 /ALIGN UNTIL EXPONENT = 23 006424 7450 SNA 006425 1443 TAD I ADR /OTHERWISE ALIGN UNTIL EXPONENT = XR VALUE 006426 6201 CDF 0 006427 7041 CIA 006430 1044 TAD ACX 006431 7040 CMA /FORM DIFFERENCE - 1 006432 7510 SPA /IF EXPONENT IS LARGER THEN DESIRED EXPONENT, 006433 5243 JMP ALNSHL /SHIFT LEFT 006434 4542 JMS I [ACSR /OTHERWISE SHIFT RIGHT 006435 1021 ALNXIT, TAD DFLG 006436 7750 SPA SNA CLA /IF DOUBLE INTEGER MODE, 006437 5477 JMP I FPNXT 006440 1055 TAD OPX /ALIGNMENT LEAVES THE EXPONENT UNCHANGED 006441 3044 DCA ACX 006442 5477 JMP I FPNXT 006443 3020 ALNSHL, DCA T /STORE SHIFT COUNT 006444 7410 SKP /SHIFT LEFT ONE LESS THAN COUNT 006445 4531 JMS I [AL1BMP 006446 2020 ISZ T 006447 5245 JMP .-2 006450 5235 JMP ALNXIT /GO TO COMMON CODE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 83 /ARG FETCH SUBROUTINES AND MODE CHANGE OPERATORS 006451 0000 DARGET, 0 006452 3043 DCA ADR 006453 1251 TAD DARGET 006454 3257 DCA ARGET 006455 3044 DCA ACX 006456 5265 JMP ARGET2 /FAKE OUT FLOATING POINT ROUTINE 006457 0000 ARGET, 0 /SUBROUTINE TO FETCH ARG FOR ADD, SUBT, ETC. 006460 3043 DCA ADR /STORE ADDRESS OF OPERAND 006461 1443 TAD I ADR /PICK UP EXPONENT 006462 2043 ISZ ADR /MOVE POINTER TO HI MANTISSA WD 006463 7410 SKP 006464 4777 JMS I (DFBUMP 006465 3055 ARGET2, DCA OPX 006466 1443 TAD I ADR /PICK IT UP 006467 3056 DCA OPH /STORE 006470 2043 ISZ ADR /MOVE PTR. TO LO MANTISSA WD. 006471 7410 SKP 006472 4777 JMS I (DFBUMP /WATCH THOSE FIELD TRANSITIONS! 006473 1443 TAD I ADR /PICK IT UP 006474 3057 DCA OPL /STORE IT 006475 6201 CDF 0 006476 5657 JMP I ARGET /RETURN 006477 1021 STRTE, TAD DFLG /START EXTENDED PRECISION MODE 006500 7710 SPA CLA 006501 5305 JMP .+4 /CLEAR EXTENDED FAC 006502 3047 DCA EAC1 /IF NOT ALREADY IN E MODE 006503 3050 DCA EAC2 006504 3051 DCA EAC3 006505 7346 AC7775 006506 3021 DCA DFLG 006507 5313 JMP DFECMN 006510 7324 STRTD, AC0001 /START DOUBLE PRECISION INTEGER MODE 006511 3021 STRTF, DCA DFLG /START FLOATING POINT MODE 006512 1021 TAD DFLG 006513 1376 DFECMN, TAD (CLL 006514 3775 DCA I (IMFUDJ /SET D.P.I FUDGE TO "CLL" OR "CLL IAC" 006515 1021 TAD DFLG 006516 7510 SPA 006517 7040 CMA /CHANGE -3 FOR E MODE TO +2 006520 7106 CLL RTL 006521 7004 RAL 006522 1374 TAD (JMPTB1&177+5600 006523 3773 DCA I (BASJMP 006524 5477 JMP I FPNXT /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 84 /DOUBLE PRECISION INTEGER OPERATORS 006525 4251 DDSUB, JMS DARGET 006526 4772 JMS I (OPNEG 006527 7410 SKP 006530 4251 DDADD, JMS DARGET 006531 3053 DCA AC1 /CLEAR OVERFLOW JUSTINCASE 006532 4536 JMS I [OADD 006533 5477 JMP I FPNXT 006534 3043 FFGET, DCA ADR /GET A FLOATING POINT NUMBER 006535 1443 TAD I ADR 006536 3044 DCA ACX /SAVE EXPONENT 006537 2043 ISZ ADR 006540 5343 JMP .+3 /NO FIELD OVERFLOW 006541 4777 JMS I (DFBUMP /BUMP DATA FIELD 006542 3043 DDGET, DCA ADR /SUAVE - ENTRY POINT FOR D.P. INTEGER GET 006543 1443 TAD I ADR 006544 3045 DCA ACH 006545 2043 ISZ ADR 006546 7410 SKP 006547 4777 JMS I (DFBUMP 006550 1443 TAD I ADR 006551 3046 DCA ACL 006552 5477 JMP I FPNXT 006553 3043 FFPUT, DCA ADR /STORE A FLOATING POINT NUMBER 006554 1044 TAD ACX /GET FAC AND STORE IT 006555 3443 DCA I ADR /AT SPECIFIED ADDRESS 006556 2043 ISZ ADR 006557 5362 JMP .+3 006560 4777 JMS I (DFBUMP 006561 3043 DDPUT, DCA ADR /ENTRY FOR D.P. INTEGER PUT 006562 1045 TAD ACH 006563 3443 DCA I ADR 006564 2043 ISZ ADR 006565 7410 SKP 006566 4777 JMS I (DFBUMP 006567 1046 TAD ACL 006570 3443 DCA I ADR 006571 5477 JMP I FPNXT 006572 7200 006573 6143 006574 5744 006575 6023 006576 7100 006577 6114 6600 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 85 6600 FPPKG= . /FOR EAE OVERLAY /23-BIT FLOATING PT INTERPRETER /W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN 006600 0000 LPBUFR, ZBLOCK 16 006616 7161 LPBUF3 006617 0000 AL1BMP, 0 /*K* UTILITY SUBROUTINE - USED BY INTERPRETER 006620 7340 AC7777 006621 1044 TAD ACX 006622 3044 DCA ACX 006623 4543 JMS I [AL1 006624 5617 JMP I AL1BMP /FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES 006625 4777 DDMPY, JMS I (DARGET 006626 7410 SKP 006627 4776 FFMPY, JMS I (ARGET /GET OPERAND 006630 4304 JMS MDSET /SET UP FOR MPY-OPX IN AC ON RETN. 006631 1044 TAD ACX /DO EXPONENT ADDITION 006632 3044 DCA ACX /STORE FINAL EXPONENT 006633 3304 DCA MDSET /ZERO TEM STORAGE FOR MPY ROUTINE 006634 3054 DCA AC2 006635 1045 TAD ACH /IS FAC=0? 006636 7650 SNA CLA 006637 3044 DCA ACX /YES-ZERO EXPONENT 006640 4334 JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR. 006641 1056 TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER 006642 3057 DCA OPL 006643 4334 JMS MP24 006644 1054 TAD AC2 /STORE RESULT BACK IN FAC 006645 3046 DCA ACL /LOW ORDER 006646 1304 TAD MDSET /HIGH ORDER 006647 3045 DCA ACH 006650 1045 TAD ACH /DO WE NEED TO NORMALIZE? 006651 7004 RAL 006652 7700 SMA CLA 006653 4217 JMS AL1BMP /YES-DO IT FAST 006654 1053 TAD AC1 006655 7710 SPA CLA /CHECK OVERFLOW WORD 006656 2046 ISZ ACL /HIGH BIT ON - ROUND RESULT 006657 5265 JMP MDONE 006660 2045 ISZ ACH /LOW ORDER OVERFLOWED - INCREMENT HIGH ORDER 006661 1045 TAD ACH 006662 7510 SPA /CHECK FOR OVERFLOW TO 4000 0000 006663 5775 JMP I (SHR1 /WE HANDLE A SIMILIAR CASE IN FLOATING DIVIDE 006664 7200 CLA /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 86 006665 3053 MDONE, DCA AC1 /ZERO OVERFLOW WD(DO I NEED THIS???) 006666 2333 ISZ MSIGN /SHOULD RESULT BE NEGATIVE? 006667 7410 SKP /NO 006670 4544 JMS I [FFNEG /YES-NEGATE IT 006671 1045 TAD ACH 006672 7650 SNA CLA /A ZERO AC MEANS A ZERO EXPONENT 006673 3044 DCA ACX 006674 1021 TAD DFLG 006675 7740 SMA SZA CLA /D.P. INTEGER MODE? 006676 1044 TAD ACX /WITH ACX LESS THAN 0? 006677 7450 SNA 006700 5477 JMP I FPNXT /NO - RETURN 006701 7040 CMA 006702 4542 JMS I [ACSR /UN-NORMALIZE RESULT 006703 5477 JMP I FPNXT /RETURN /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 87 /MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE /ALSO SHIFTS OPERAND ONE BIT TO THE LEFT. /EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT /CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND /DATA FIELD SET PROPERLY FOR OPERAND. 006704 0000 MDSET, 0 006705 7344 AC7776 /SET SIGN CHECK TO -2 006706 3333 DCA MSIGN 006707 1056 TAD OPH /IS OPERAND NEGATIVE? 006710 7700 SMA CLA 006711 5314 JMP .+3 /NO 006712 4774 JMS I (OPNEG /YES-NEGATE IT 006713 2333 ISZ MSIGN /BUMP SIGN CHECK 006714 1057 TAD OPL /AND SHIFT OPERAND LEFT ONE BIT 006715 7104 CLL RAL 006716 3057 DCA OPL 006717 1056 TAD OPH 006720 7004 RAL 006721 3056 DCA OPH 006722 3053 DCA AC1 /CLR. OVERFLOW WORF OF FAC 006723 1045 TAD ACH /IS FAC NEGATIVE 006724 7700 SMA CLA 006725 5331 JMP LEV /NO-GO ON 006726 4544 JMS I [FFNEG /YES-NEGATE IT 006727 2333 ISZ MSIGN /BUMP SIGN CHECK 006730 7000 NOP /MAY SKIP 006731 1055 LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC 006732 5704 JMP I MDSET 006733 0000 MSIGN, 0 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 88 /24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL /MULTIPLICAND IS IN ACH AND ACL /RESULT LEFT IN MDSET,AC2, AND AC1 006734 0000 MP24, 0 006735 1373 TAD (-14 /SET UP 12 BIT COUNTER 006736 3055 DCA OPX 006737 1057 TAD OPL /IS MULTIPLIER=0? 006740 7440 SZA 006741 5345 JMP MPLP1 /NO-GO ON 006742 3053 DCA AC1 /YES-INSURE RESULT=0 006743 5734 JMP I MP24 /RETURN 006744 1057 MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER 006745 7010 MPLP1, RAR /OF MULTIPLIER AND INTO LINK 006746 3057 DCA OPL 006747 7420 SNL /WAS IT A 1? 006750 5356 JMP MPLP2 /NO - 0 - JUST SHIFT PARTIAL PRODUCT 006751 1054 TAD AC2 /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT 006752 1046 TAD ACL /LOW ORDER 006753 3054 DCA AC2 006754 7024 CML RAL /*K* NOTE THE "SNL" 5 WORDS BACK! 006755 1045 TAD ACH /HI ORDER 006756 1304 MPLP2, TAD MDSET 006757 7010 RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT 006760 3304 DCA MDSET 006761 1054 TAD AC2 006762 7010 RAR 006763 3054 DCA AC2 006764 1053 TAD AC1 006765 7010 RAR /OVERFLOW TO AC1 006766 3053 DCA AC1 006767 2055 ISZ OPX /DONE ALL 12 MULTIPLIER BITS? 006770 5344 JMP MPLP /NO-GO ON 006771 5734 JMP I MP24 /YES-RETURN 006773 7764 006774 7200 006775 7111 006776 6457 006777 6451 7000 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 89 /DIVIDE-BY-ZERO ROUTINE - MUST BE AT BEGINNING OF PAGE 007000 2035 DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL 007001 4434 JMS I ERR /GIVE ERROR MSG 007002 0100 DV0MSG-ERRMSG 007003 1200 TAD DBAD 007004 3044 DCA ACX /RETURN A VERY LARGE POSITIVE NUMBER 007005 7332 AC2000 007006 5326 JMP FD /FLOATING DIVIDE - USES DIVIDE-AND-CORRECT METHOD 007007 4777 DDDIV, JMS I (DARGET 007010 7410 SKP 007011 4776 FFDIV, JMS I (ARGET /GET OPERAND 007012 4775 JMS I (MDSET /GO SET UP FOR DIVIDE-OPX IN AC ON RETN. 007013 7041 CMA IAC /NEGATE EXP. OF OPERAND 007014 1044 TAD ACX /ADD EXP OF FAC 007015 3044 DCA ACX /STORE AS FINAL EXPONENT 007016 1056 TAD OPH /NEGATE HI ORDER OP. FOR USE 007017 7141 CLL CMA IAC /AS DIVISOR 007020 3056 DCA OPH 007021 4232 JMS DV24 /CALL DIV.--(ACH+ACL)/OPH 007022 1046 TAD ACL /SAVE QUOT. FOR LATER 007023 3053 DCA AC1 007024 1057 TAD OPL 007025 7650 SNA CLA 007026 5330 JMP DVL2 /AVOID MULTIPLYING BY 0 007027 1374 TAD (-15 /SET COUNTER FOR 12 BIT MULTIPLY 007030 3232 DCA DV24 /TO MULTIPLY QUOT. OF DIV. BY 007031 5270 JMP DVLP1 /LOW ORDER OF OPERAND (OPL) /DIVIDE ROUTINE - (ACH,ACL)/OPH = ACL REMAINDER REM (AC2=0) 007032 0000 DV24, 0 007033 1045 TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND 007034 1056 TAD OPH /DIVISOR IN OPH (NEGATIVE) 007035 7630 SZL CLA /IS IT? 007036 5200 JMP DBAD /NO-DIVIDE OVERFLOW 007037 1374 TAD (-15 /YES-SET UP 12 BIT LOOP 007040 3054 DCA AC2 007041 5252 JMP DV1 /GO BEGIN DIVIDE 007042 1045 DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT 007043 7004 RAL 007044 3045 DCA ACH /RESTORE HI ORDER 007045 1045 TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER 007046 1056 TAD OPH /DIVIDEND 007047 7430 SZL /GOOD SUBTRACT? 007050 3045 DCA ACH /YES-RESTORE HI DIVIDEND 007051 7200 CLA /NO-DON'T RESTORE--OPH.GT.ACH 007052 1046 DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT 007053 7004 RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL 007054 3046 DCA ACL /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 89-1 007055 2054 ISZ AC2 /DONE 12 BITS OF QUOT? 007056 5242 JMP DV2 /NO-GO ON 007057 5632 JMP I DV24 /YES-RETN W/AC2=0 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 90 /DIVIDE ROUTINE CONTINUED 007060 3057 MP12L, DCA OPL /STORE BACK MULTIPLIET 007061 1054 TAD AC2 /GET PRODUCT SO FAR 007062 7420 SNL /WAS MULTIPLIER BIT A 1? 007063 5266 JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT 007064 7100 CLL /YES-CLEAR LINK AND ADD MULTIPLICAND 007065 1046 TAD ACL /TO PARTIAL PRODUCT 007066 7010 RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER 007067 3054 DCA AC2 /RESULT-STORE BACK 007070 1057 DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER 007071 7010 RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.) 007072 2232 ISZ DV24 /DONE ALL BITS? 007073 5260 JMP MP12L /NO-LOOP BACK 007074 7141 CLL CIA /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC 007075 3046 DCA ACL /NEGATE AND STORE 007076 7024 CML RAL /PROPAGATE CARRY 007077 1054 TAD AC2 /NEGATE HI ORDER PRODUCT 007100 7161 STL CIA 007101 1045 TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV. 007102 7430 SZL /WELL? 007103 5332 JMP DVOPS /GREATER THAN REM.-ADJUST QUOT OF 1ST DIV. 007104 3045 DCA ACH /OK - DO (REM - (Q*OPL)) / OPH 007105 4232 DVL3, JMS DV24 /DIVIDE BY OPH (HI ORDER OPERAND) 007106 1053 DVL1, TAD AC1 /GET QUOT. OF FIRST DIV. 007107 7500 SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT 007110 5326 JMP FD /NO-ITS NORMALIZED-DONE 007111 7100 SHR1, CLL 007112 2046 ISZ ACL /ROUND AND SHIFT RIGHT ONE 007113 7410 SKP 007114 7001 IAC /DOUBLE PRECISION INCREMENT 007115 7010 RAR 007116 3045 DCA ACH /STORE IN FAC 007117 1046 TAD ACL /SHIFT LOW ORDER RIGHT 007120 7010 RAR 007121 3046 DCA ACL /STORE BACK 007122 2044 ISZ ACX /BUMP EXPONENT 007123 7000 NOP 007124 1045 TAD ACH 007125 5307 JMP DVL1+1 /IF FRACT WAS 77777777 WE MUST SHIFT AGAIN 007126 3045 FD, DCA ACH /STORE HIGH ORDER RESULT 007127 5773 JMP I (MDONE /GO LEAVE DIVIDE 007130 3046 DVL2, DCA ACL /COME HERE IF LOW-ORDER QUO=0 007131 5305 JMP DVL3 /SAVE SOME TIME /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 91 /ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE /REMAINDER OF THE FIRST DIVIDE IS LESS THAN QUOT*OPL 007132 7041 DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER 007133 3045 DCA ACH 007134 7100 CLL 007135 1056 TAD OPH 007136 1045 TAD ACH /WATCH FOR OVERFLOW 007137 7420 SNL 007140 5345 JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV. 007141 3045 DCA ACH /NO OVERFLOW-STORE NEW REM. 007142 7040 CMA /SUBTRACT 1 FROM QUOT OF 007143 1053 TAD AC1 /FIRST DIVIDE 007144 3053 DCA AC1 007145 7300 DVOP1, CLA CLL 007146 1045 TAD ACH /GET HI ORD OF REMAINDER 007147 7450 SNA /IS IT ZERO? 007150 3046 DVOP2, DCA ACL /YES-MAKE WHOLE THING ZERO 007151 3045 DCA ACH 007152 4232 JMS DV24 /DIVIDE EXTENDED REM. BY HI DIVISOR 007153 1046 TAD ACL /NEGATE THE RESULT 007154 7141 CLL CMA IAC 007155 3046 DCA ACL 007156 7420 SNL /IF QUOT. IS NON-ZERO, SUBTRACT 007157 7040 CMA /ONE FROM HIGH ORDER QUOT. 007160 5306 JMP DVL1 /GO TO IT 007161 0000 LPBUF3, ZBLOCK 10 007171 7331 LPBUF4 007173 6665 007174 7763 007175 6704 007176 6457 007177 6451 7200 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 92 /"OPNEG" MUST BE AT 0 ON PAGE 007200 0000 OPNEG, 0 /ROUTINE TO NEGATE OPERAND 007201 1057 TAD OPL /GET LOW ORDER 007202 7141 CLL CIA /NEGATE AND STORE BACK 007203 3057 DCA OPL 007204 7024 CML RAL /PROPAGATE CARRY 007205 1056 TAD OPH /GET HI ORDER 007206 7141 CLL CIA /NEGATE AND STORE BACK 007207 3056 DCA OPH 007210 5600 JMP I OPNEG / /FLOATING SUBTRACT AND ADD / 007211 4777 FFSUB, JMS I (ARGET /PICK UO THE OP. 007212 4200 JMS OPNEG /NEGATE OPERAND 007213 7410 SKP 007214 4777 FFADD, JMS I (ARGET /PICK UP OPERAND 007215 1056 TAD OPH /IS OPERAND = 0 007216 7650 SNA CLA 007217 5477 JMP I FPNXT /YES-DONE 007220 1045 TAD ACH /NO-IS FAC=0? 007221 7650 SNA CLA 007222 5366 JMP CLROFL /CLEAR OUT THE OVERFLOW BITS 007223 1044 TAD ACX /NO-DO EXPONENT CALCULATION 007224 7141 CLL CIA 007225 1055 TAD OPX 007226 7540 SMA SZA /WHICH EXP. GREATER? 007227 5244 JMP FACR /OPERANDS-SHIFT FAC 007230 7041 CIA /FAC'S-SHIFT OPERAND=DIFFRNCE+1 007231 1376 TAD (-30 007232 7500 SMA /TEST FOR INSIGNIFICANCE 007233 5253 JMP OPINSG /YES - ANSWER IS FAC 007234 1375 TAD (30 007235 4255 JMS OPSR 007236 4542 JMS I [ACSR /SHIFT FAC ONE PLACE RIGHT 007237 1055 DOADD, TAD OPX /SET EXPONENT OF RESULT 007240 3044 DCA ACX 007241 4536 JMS I [OADD /DO THE ADDITION 007242 4300 JMS FFNOR /NORMALIZE RESULT 007243 5477 JMP I FPNXT /RETURN 007244 1376 FACR, TAD (-30 007245 7500 SMA /TEST FOR INSIGNIFICANCE 007246 5325 JMP ACINSG /YES - ANSWER IS OPR 007247 1375 TAD (30 007250 4542 JMS I [ACSR /SHIFT FAC = DIFF.+1 007251 4255 JMS OPSR /SHIFT OPR. 1 PLACE 007252 5237 JMP DOADD /DO ADDITION 007253 7200 OPINSG, CLA 007254 5477 JMP I FPNXT /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 93 /OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 IN AC 007255 0000 OPSR, 0 007256 7040 CMA /- (COUNT+1) TO SHIFT COUNTER 007257 3052 DCA AC0 007260 1056 LOP2, TAD OPH /GET SIGN BIT 007261 7100 CLL /TO LINK 007262 7510 SPA 007263 7020 CML /WITH HI MANTISSA IN AC 007264 7010 RAR /SHIFT IT RIGHT, PROPAGATING SIGN 007265 3056 DCA OPH /STORE BACK 007266 1057 TAD OPL 007267 7010 RAR 007270 3057 DCA OPL /STORE LO ORDER BACK 007271 2055 ISZ OPX /INCREMENT EXPONENT 007272 7000 NOP 007273 2052 ISZ AC0 /DONE ALL SHIFTS? 007274 5260 JMP LOP2 /NO-LOOP 007275 7010 RAR /SAVE 1 BIT OF OVERFLOW 007276 3054 DCA AC2 /IN AC2 007277 5655 JMP I OPSR /YES-RETN. 007300 0000 FFNOR, 0 /ROUTINE TO NORMALIZE THE FAC 007301 1045 TAD ACH /GET THE HI ORDER MANTISSA 007302 7450 SNA /ZERO? 007303 1046 TAD ACL /YES-HOW ABOUT LOW? 007304 7450 SNA 007305 1053 TAD AC1 /LOW=0, IS OVRFLO BIT ON? 007306 7650 SNA CLA 007307 5322 JMP ZEXP /#=0-ZERO EXPONENT 007310 7332 NORMLP, AC2000 /NOT 0-MAKE A 2000 IN AC 007311 1045 TAD ACH /ADD HI ORDER MANTISSA 007312 7440 SZA /HI ORDER = 6000 007313 5316 JMP .+3 /NO-CHECK LEFT MOST DIGIT 007314 1046 TAD ACL /YES-6000 OK IF LOW=0 007315 7640 SZA CLA 007316 7710 SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS. 007317 5323 JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7) 007320 4531 JMS I [AL1BMP /SHIFT AC LEFT AND BUMP ACX DOWN 007321 5310 JMP NORMLP /GO BACK AND SEE IF NORMALIZED 007322 3044 ZEXP, DCA ACX 007323 3053 FFNORR, DCA AC1 /DONE W/NORMALIZE - CLEAR AC1 007324 5700 JMP I FFNOR /RETURN 007325 7200 ACINSG, CLA /COME HERE IF AC IS INSIGNIFICANT ON ADDITION 007326 3045 DCA ACH 007327 3046 DCA ACL 007330 5236 JMP DOADD-1 /FAKE AN ADD WITH OPR=0 007331 0000 LPBUF4, ZBLOCK 34 007365 6600 LPBUFR 007366 3053 CLROFL, DCA AC1 /CLEAR THE FLOATING AC OVERFLOW WORD 007367 3054 DCA AC2 /CLEAR THE OPERAND OVERFLOW WORD /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 93-1 007370 5237 JMP DOADD /FAC=0; DO THE ADD 007375 0030 007376 7750 007377 6457 7400 PAGE /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 94 /PAGE 7400 USED FOR THE INCORE ENCODE & DECODE 7400 CORREC=. 000131 6617 000132 0027 000133 7772 000134 7774 000135 0060 000136 4506 000137 0040 000140 2557 000141 7766 000142 4452 000143 4437 000144 4475 000145 0177 000146 3311 000147 1415 000150 7400 000151 4400 000152 1347 000153 5601 000154 1230 000155 7740 000156 1056 000157 0012 000160 1502 000161 2700 000162 3000 000163 3200 000164 0674 000165 1135 000166 0077 000167 0007 000170 1200 000171 0234 000172 4524 000173 1400 000174 0070 000175 0200 000176 0377 000177 5600 0001 FIELD 1 /FORTRAN IV FRTS SYSTEM, V50A PAL8-V50X 10-APR-92 PAGE 95 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 96 /FORTRAN IV FRTS LOADER V50 / / / /COPYRIGHT (C) 1974, 1975, 1980 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. /AND WVDMARK, ZURICH / / /WITH DOUBLE PRECSION - MKH /AND RTS-8 SUPPORT - R. LARY /LAST EDITED 5/21/74 / / CHANGES FOR OS/78 AND OS/8 V3D BY P.T. 5/1/77 / .FIXED THE D AND B FORMAT (FPP) BUG / .FIXED FIELD OVERFLOW BUG(NO. OF ASTERISKS PRINTED) / .MODS BY WVDM FOR MULTI8 14-NOV-78 / .FIXED PROBLEM WITH RESIDENT HANDLERS *WM* / .FIXED BUG IN ADDRESS CALC OF HCWTBA *WM* / .ALLOWED M&S FPP IN INIT CODE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 97 /PAGE 0 LOCATIONS FOR RTS LOADER 0010 X0= 10 0011 X1= 11 0012 X2= 12 0013 X3= 13 0020 HADR= 20 0021 UNIT= 21 0022 HCWORD= 22 0023 MXFLD= 23 0024 HLDADR= 24 0025 HGHFLD= 25 0026 HGHADR= 26 0027 RLTMP= 27 0030 HDIFF= 30 0031 CFLAG= 31 /DURING MOST OF THE LOAD OPERATION A SECTION OF FIELD 0 RTS /IS MOVED UP INTO FIELD 1 AND THE VACATED AREA OF FIELD 0 IS USED /TO RUN THE COMMAND DECODER AND TO ACCUMULATE DEVICE HANDLERS. /*K* THEREFORE, IF THE RTS LOADER IS TO MODIFY ANY CODE BETWEEN /"F0HBEG" AND "F0HEND" IT MUST MODIFY IT IN FIELD 1 IN THE "F0TO" AREA. 0000 F0HBEG= 0 3000 F0HEND= 3000 7000 F0HSAV= 7000 /400 WORDS WHERE DEVICE HANDLERS ARE TEMPORARILY SAVED /SO THAT THEY WON'T INITIALIZE THEMSELVES WRONG /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 98 /RTS LOADER TABLES 2000 *2000 012000 0000 IONTBL, ZBLOCK 100 /INTERRUPT ENABLE TABLE - LOW BIT ONLY 012100 0000 HCWTBL, ZBLOCK 14 /HANDLER CONTROL WORD - ONE PER PAGE (LOTSA WASTE) 012114 0000 TFTABL, ZBLOCK 45 /TENTATIVE FILE SAVE TABLE 012161 0000 DVTEMP, ZBLOCK 17 /HANDLER ENTRY TABLE SAVE AREA 2000 *IONTBL+0 /TTY 012000 0002 2 /FORMS CONTROL ON TTY 2004 *IONTBL+4 /LPT 012004 0002 2 /FORMS CONTROL ON LPT 2005 *IONTBL+5 /RK8 012005 0001 1 2016 *IONTBL+16 /DTA 012016 0001 1 2021 *IONTBL+21 /NEW TD8E 012021 0001 1 2023 *IONTBL+23 /RK8E 012023 0001 1 2025 *IONTBL+25 /RX01 012025 0001 1 2026 *IONTBL+26 /RL01 A,B 012026 0001 1 2031 *IONTBL+31 /RL01 C 012031 0001 1 2032 *IONTBL+32 /RX02 FLOPPY 012032 0001 1 2040 *IONTBL+40 012040 0001 1 /DIABLO DISK 2041 *IONTBL+41 012041 0001 1 /BYTE MODE FLOPPY RB01 (PDP8) 2042 *IONTBL+42 012042 0001 1 /BYTE MODE FLOPPY RB07 (VT78) 2200 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 99 /RTS LOADER 012200 4777 RTSLDR, JMS I (RTINIT 012201 4777 JMS I (RTINIT /INITIALIZE WHETHER CHAINED TO OR NOT 012202 5206 JMP NOCD 012203 4776 LICD, JMS I (200 012204 0005 5 012205 1404 1404 /.LD DEFAULT EXTENSION 012206 4775 NOCD, JMS I (TSTSWS /TEST /E,/V AND /H SWITCHES 012207 1774 TAD I (7617 012210 7450 SNA 012211 5203 JMP LICD 012212 4773 JMS I (GETHAN /GET HANDLER TO LOAD WITH 012213 0000 0 /DON'T PUT IT ANYWHERE 012214 1772 TAD I (7620 012215 3223 DCA LIBLK 012216 4771 JMS I (SVHND /COPY HANDLER TO AVOID BAD INITIALIZATION 012217 6202 CIF 0 012220 4424 JMS I HLDADR 012221 0100 0100 012222 5200 LHDR, QLHDR 012223 0000 LIBLK, 0 012224 5327 JMP LDIOER 012225 4770 JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER 012226 6201 CDF 0 012227 1020 TAD HADR 012230 3767 DCA I (OVHND 012231 1022 TAD HCWORD 012232 3766 DCA I (OVHCDW 012233 1365 TAD (QUSRLV-1 012234 3010 DCA X0 012235 7344 AC7776 012236 1622 TAD I LHDR 012237 7640 SZA CLA /VERIFY LOADER IMAGE INPUT 012240 5324 JMP NOTLI /GOOD THING WE CHECKED! 012241 1323 TAD DPFPP 012242 1765 TAD I (QDPFLG /CHECK IF TRYING TO USE D.P. WITHOUT OPTION 012243 7700 SMA CLA 012244 5247 JMP .+3 012245 4764 JMS I (RLERR /YES - PRINT WARNING MESSAGE 012246 5510 NODPMS /BUT LET THE FOOL GO ON /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 100 /SET UP RTS TABLES FROM LOADER IMAGE 012247 6201 CDF 0 012250 1363 TAD (OVLYTB-1 012251 3011 DCA X1 012252 1362 TAD (-10 012253 3027 DCA RLTMP 012254 1410 OVRELP, TAD I X0 012255 3411 DCA I X1 /MOVE USER OVERLAY INFO INTO SWAP TABLE, 012256 1410 TAD I X0 012257 3411 DCA I X1 012260 1410 TAD I X0 012261 1223 TAD LIBLK /RELOCATING THE BLOCK NUMBERS 012262 3411 DCA I X1 012263 1410 TAD I X0 012264 3411 DCA I X1 012265 2027 ISZ RLTMP 012266 5254 JMP OVRELP 012267 1761 TAD I (QRTSWP 012270 0362 AND (7770 /TURN THE LOADER INITIAL SWAP WORD 012271 3760 DCA I (STSWAP+2 012272 1761 TAD I (QRTSWP /INTO A DUMMY SWAP WORD AND A JUMP WORD 012273 0357 AND (7 /SO THAT WE CAN HALT BETWEEN 012274 1356 TAD (JA /LOADING AND STARTING USERS PROGRAM. 012275 3755 DCA I (STJUMP 012276 1754 TAD I (QRTSWP+1 012277 3753 DCA I (STJUMP+1 012300 1752 TAD I (QHGHAD 012301 3025 DCA HGHFLD 012302 1751 TAD I (QHGHAD+1 /LOCATION USED 012303 3026 DCA HGHADR 012304 4750 JMS I (GETFIL /GET USER I/O FILES IF ANY 012305 1747 TAD I (OS8DAT /SALT AWAY OS/8 DATE WORD 012306 3763 DCA I (VDATE-F0HBEG+F0TO 012307 7320 STL CLA 012310 6141 6141 /TEST IF WE ARE ON A PDP-12 012311 0261 0261 /ROL I 1 - PUTS LINK IN AC11 012312 0002 0002 /PDP 012313 3746 DCA I (V8OR12+1-F0HBEG+F0TO 012314 4745 JMS I (MOVE 012315 6211 CDF 10 012316 3155 SPSTRT-1 /MOVE SPECIAL START CODE TO LOC 200 012317 6211 CDF 10 012320 4177 200-F0HBEG+F0TO-1 /(RELOCATED 200, THAT IS) 012321 7775 -3 012322 5744 JMP I (MOVCOR 012323 3777 DPFPP, 3777 /0 IF D.P. FPP AVAILABLE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 101 012324 4764 NOTLI, JMS I (RLERR 012325 5412 NOLI 012326 5203 JMP LICD 012327 4764 LDIOER, JMS I (RLERR 012330 5500 LIOEMS 012331 6203 CDF CIF 0 012332 5743 JMP I (7605 012343 7605 012344 2400 012345 2523 012346 4226 012347 7666 012350 3200 012351 5204 012352 5203 012353 4053 012354 5202 012355 4052 012356 1030 012357 0007 012360 4046 012361 5201 012362 7770 012363 4203 012364 3662 012365 5206 012366 3746 012367 3745 012370 3635 012371 3622 012372 7620 012373 3000 012374 7617 012375 3400 012376 0200 012377 2600 2400 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 102 /FIGURE OUT CORE LIMITS AND WRITE OUT PG 17600 012400 1023 MOVCOR, TAD MXFLD 012401 7106 CLL RTL 012402 7004 RAL 012403 1377 TAD (CDF 012404 3271 DCA HCDF /PREPARE TO TRANSFER THE HANDLERS 012405 1776 TAD I (HTOP 012406 1030 TAD HDIFF /GET BOTTOM OF HANDLER AREA 012407 7450 SNA 012410 2023 ISZ MXFLD /AT LAST MAKE PROPER 15-BIT ADDRESS 012411 3027 DCA RLTMP 012412 1026 TAD HGHADR /15-BIT SUBTRACT FOR FREE SPACE 012413 7141 CLL CIA 012414 1027 TAD RLTMP 012415 7224 CLA CML RAL /CARRY TO NEXT 012416 1025 TAD HGHFLD 012417 7141 CLL CIA 012420 1023 TAD MXFLD 012421 7620 SNL CLA 012422 5311 JMP TOOBIG /ALL THAT WORK FOR NOTHING! 012423 4775 JMS I (MOVE /BEFORE WE MOVE THE HANDLERS WE SHOULD WRITE 012424 6211 CDF 10 /OUT PAGE 17600 AND THE RTS CLEANUP CODE 012425 2113 TFTABL-1 /SINCE THE HANDLERS MAY OVERLAY THEM. 012426 6211 CDF 10 /SO FIRST MOVE THE TENTATIVE FILE TABLE 012427 7577 7600-1 /INTO PAGE 17600 WHERE IT'S SAFE. 012430 7733 -45 012431 6202 CIF 0 012432 4774 JMS I (7607 012433 4210 4210 012434 7400 7400 012435 0037 37 /SUITABLE SCRATCH BLOCK 012436 5315 JMP SYSERR 012437 1030 TAD HDIFF 012440 1373 TAD (F0HEND /CHANGE HDIFF FROM AN OFFSET 012441 3030 DCA HDIFF /TO THE FIRST LOC ABOVE THE HANDLERS. /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 103 /SHUFFLE CORE AROUND AND START UP RTS 012442 1372 TAD (F0TO+VMAXCR-1 012443 3010 DCA X0 012444 1030 TAD HDIFF 012445 3410 DCA I X0 /TO VMAXCR - HIGHEST USABLE LOCATION 012446 1023 TAD MXFLD /HIGH 4! BITS OF BOTTOM-OF-HANDLERS 012447 3410 DCA I X0 /STORE IN BOTHAN 012450 1027 TAD RLTMP /LOW 12 BITS OF THE SAME 012451 3410 DCA I X0 /TO MAKE D.P. WORD 012452 1025 TAD HGHFLD /HIGH 4! BITS OF TOP-OF-BUFFERS 012453 3410 DCA I X0 /STORE IN TOPBUF 012454 1026 TAD HGHADR /LOW 12 BITS OF SAME 012455 3410 DCA I X0 /TO MAKE ANOTHER D.P. WORD 012456 7340 HLOOP, AC7777 012457 1030 TAD HDIFF /WE HAVE TO MOVE THE HANDLERS IN A COCKEYED 012460 3030 DCA HDIFF /WAY SINCE WE MIGHT BE PARTIALLY SWAPPING 012461 6201 CDF 0 /CORE BETWEEN FIELD 0 (THE HANDLERS) AND 012462 7340 AC7777 /FIELD 1 (WHERE WE SAVED FIELD 0) IN 8K SYSTEMS. 012463 1320 TAD HPTR1 012464 3320 DCA HPTR1 012465 7340 AC7777 012466 1321 TAD HPTR2 012467 3321 DCA HPTR2 012470 1720 TAD I HPTR1 012471 7402 HCDF, HLT /MOVE A HANDLER WORD FROM FIELD 0 012472 3430 DCA I HDIFF /TO FIELD N 012473 6211 CDF 10 012474 1721 TAD I HPTR2 /MEANWHILE RESTORE FIELD 0 012475 6201 CDF 0 012476 3720 DCA I HPTR1 /FROM FIELD 1 012477 2322 ISZ HMCT 012500 5256 JMP HLOOP /DO MORE THAN WE HAVE TO - IT CAN'T HURT 012501 1371 TAD (5606 / 012502 3770 DCA I (7605 /SET UP OS8 RETURN SEQUENCE TO TRAP TO RTS 012503 1367 TAD (PDPXIT / 012504 3766 DCA I (7606 /AS RANDOM RESTARTS COULD BE FATAL. 012505 6552 FPICL /RE-INITIALIZE FPP (IF ANY) 012506 6553 FPCOM /CLEAR APT POINTER FIELD BITS (IF FPP) 012507 6203 CDF CIF 0 /THIS IS A BETTER PLACE FOR CIF .... 012510 5765 JMP I (FPSTRT 012511 4764 TOOBIG, JMS I (RLERR 012512 5455 TOOMCH 012513 6203 OS8RTN, CDF CIF 0 012514 5770 JMP I (7605 012515 4764 SYSERR, JMS I (RLERR 012516 5443 SYSMSG 012517 5313 JMP OS8RTN 012520 3000 HPTR1, F0HEND 012521 7000 HPTR2, F0TO+F0HEND-F0HBEG /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 103-1 012522 5000 HMCT, F0HBEG-F0HEND /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 104 /MOVE ROUTINE 012523 0000 MOVE, 0 /GENERAL MOVE SUBROUTINE 012524 6211 CDF 10 012525 7200 CLA 012526 1323 TAD MOVE 012527 3012 DCA X2 012530 1723 TAD I MOVE 012531 3342 DCA FRMFLD 012532 1412 TAD I X2 012533 3013 DCA X3 012534 1412 TAD I X2 012535 3344 DCA TOFLD 012536 1412 TAD I X2 012537 3011 DCA X1 012540 1412 TAD I X2 012541 3352 DCA MVC 012542 7402 FRMFLD, HLT 012543 1413 TAD I X3 012544 7402 TOFLD, HLT 012545 3411 DCA I X1 012546 2352 ISZ MVC 012547 5342 JMP FRMFLD 012550 6211 CDF 10 012551 5412 JMP I X2 012552 0000 MVC, 0 012553 4764 HNDERR, JMS I (RLERR 012554 5467 TOMNYH 012555 5313 JMP OS8RTN 012564 3662 012565 4002 012566 7606 012567 1334 012570 7605 012571 5606 012572 4120 012573 3000 012574 7607 012575 2523 012576 3153 012577 6201 2600 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 105 /INITIALIZATION 012600 0000 RTINIT, 0 012601 2200 ISZ RTINIT /SKIP RETURN 012602 4777 JMS I (BAKTST /SEE IF WE'RE RUNNING IN BACKGROUND UNDER RTS-8 012603 6202 CIF 0 012604 4776 JMS I (CORE 012605 3023 DCA MXFLD 012606 7431 SWAB /SET EAE MODE TO B (IF 8/E) 012607 7201 CLA IAC 012610 7413 EAEKIL, SHL /ZERO THIS LOCATION TO INHIBIT EAE 012611 7201 CLA IAC /LOW ORDER BITS 01 012612 1375 TAD (-2 012613 7650 SNA CLA /TEST FOR 8/E EAE 012614 4774 JMS I (MOVEAE /YES - SUBSTITUTE PACKAGES 012615 1773 TAD I (OS8SWS+1 012616 7110 CLL RAR /TEST /X SWITCH 012617 7630 SZL CLA 012620 5247 JMP NOFPP /IT WAS SET, DON'T USE FPP 012621 1372 TAD (APT 012622 6555 FPST /START FPP ON "STARTE;FEXIT" 012623 5247 JMP NOFPP /DIDN'T START 012624 4771 JMS I (MOVE 012625 6211 CDF 10 012626 5577 FPPINT-1 /THE FPP HANDLER AND D.P. I/O PKG IS IN THE 012627 6201 CDF 0 /SAME LOCATIONS IN FIELD 1 AS THE 012630 5577 FPPINT-1 /FPP INTERPRETER IN FIELD 0. 012631 7000 -1000 /COUNT FOR DBL PREC SPACE 012632 6551 FPINT /WAT FOR THE RESULT 012633 5232 JMP .-1 012634 6556 FPRST /FPP HAD BETTER BE DONE BY NOW!! 012635 0370 AND (4 /GET D.P. STATUS BIT 012636 7650 SNA CLA 012637 5247 JMP NOFPP /NO DOUBLE PRECISION 012640 3767 DCA I (DPFPP /SET FLAG TO INDICATE D.P. AVAILABLE 012641 6201 CDF 0 012642 1366 TAD (DFMT 012643 3765 DCA I (DF /ENABLE D FORMAT 012644 1364 TAD (BFMT 012645 3763 DCA I (BF /AND B FORMAT 012646 6211 CDF 10 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 106 012647 4771 NOFPP, JMS I (MOVE 012650 6201 RICDF0, CDF 0 012651 7777 F0HBEG-1 012652 6211 CDF 10 012653 3777 F0TO-1 /MOVE LOWER F0 INTO F1 FOR SAFEKEEPING 012654 5000 F0HBEG-F0HEND 012655 6201 CDF 0 012656 1762 TAD I (OSJSWD /GET OS/8 STATUS WORD 012657 0361 AND (6374 /FORCE BITS ON INDICATING NON-RESTARTABLE JOB 012660 1360 TAD (1003 /AND DESTRUCTIVE CALLS TO CD AND USR 012661 3762 DCA I (OSJSWD /MEANWHILE FORCING "BATCH SAVED" BIT OFF 012662 1757 TAD I (7612 012663 1356 TAD (-3 /CHECK FOR IN-CORE TD8E'S 012664 7640 SZA CLA 012665 5312 JMP NOTDSY 012666 1023 TAD MXFLD 012667 7106 CLL RTL 012670 7004 RAL 012671 1250 TAD RICDF0 012672 3305 DCA TD8EFG /SET TD8E FLAG WHICH IS ALSO CDF 012673 1755 TAD I (7642 012674 0354 AND (70 012675 1250 TAD RICDF0 /GET THE FIELD WE'RE COMING FROM 012676 3303 DCA TD8EFL 012677 1305 TAD TD8EFG 012700 0353 AND (7770 /PATCH 51.3.3.0 012701 4752 JMS I (TDSET /REDO THE CDF'S IN F0 012702 4771 JMS I (MOVE 012703 6221 TD8EFL, CDF 20 012704 7577 7577 012705 0000 TD8EFG, 0 012706 7577 7577 012707 7604 -174 /SPARE BATCH PARAMETERS IN TOP FIELD 012710 1023 TAD MXFLD /SET FLAG IN CLEANUP ROUTINE 012711 3751 DCA I (TDEXFG /TO RESTORE TD8E HANDLER TO FIELD 2 012712 6211 NOTDSY, CDF 10 012713 1750 TAD I (7726 /HAVE WE SCOPE? 012714 0347 AND (200 012715 7650 SNA CLA 012716 5333 JMP SETTTY /NO, PATCH SOME LOCS 012717 7340 TESMAX, AC7777 012720 1023 TAD MXFLD 012721 7650 SNA CLA /8K? 012722 5326 JMP ONLY8K /YES - IGNORE BATCH & TD8E CRAP 012723 4746 JMS I (GBFLG /GET BATCH FLAG 012724 1305 TAD TD8EFG 012725 7650 SNA CLA /IF NO BATCH OR TD8E'S, 012726 1347 ONLY8K, TAD (200 /USE ALL OF THE LAST FIELD. 012727 1345 STOHDF, TAD (-F0HEND-200 012730 3030 DCA HDIFF /OTHERWISE USE ONLY UP TO 7600 012731 6211 CDF 10 012732 5600 JMP I RTINIT /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 107 012733 4771 SETTTY, JMS I (MOVE /PATCH RUBOUT A LA TECO 012734 6211 CDF 10 /WHEN NO SCOPE 012735 3520 RUBPAT-1 012736 6201 CDF 0 012737 3075 PATRUB-1 012740 7773 -5 012741 5317 JMP TESMAX 012745 4600 012746 3613 012747 0200 012750 7726 012751 7401 012752 7507 012753 7770 012754 0070 012755 7642 012756 7775 012757 7612 012760 1003 012761 6374 012762 7746 012763 1127 012764 6006 012765 1125 012766 6005 012767 2323 012770 0004 012771 2523 012772 0037 012773 7644 012774 3433 012775 7776 012776 5260 012777 3726 3000 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 108 013000 0000 GETHAN, 0 /GET HANDLER SUBROUTINE 013001 0377 AND (17 013002 3021 DCA UNIT 013003 3207 DCA H1 013004 1021 TAD UNIT 013005 4776 JMS I (200 013006 0012 12 /INQUIRE 013007 0000 H1, 0 013010 7000 NOP /ERROR RETURN ALWAYS SKIPPED 013011 1207 TAD H1 013012 7450 SNA 013013 5270 JMP NOTLDD /NOT IN CORE - MUST LOAD 013014 4330 JMS HCWTBA /IN CORE 013015 1754 GHEXIT, TAD I HCWPTR /GET CONTROL WORD FOR HANDLER PAGE 013016 3022 DCA HCWORD 013017 1024 TAD HLDADR 013020 3020 DCA HADR /ASSUME HANDLER PERMENANTLY RESIDENT 013021 1375 TAD (-4 013022 0022 AND HCWORD 013023 7650 SNA CLA /WERE WE RASH? 013024 5231 JMP RESHAN /NO 013025 1020 TAD HADR 013026 0374 AND (177 013027 1373 TAD (HPLACE /YES - I APOLOGIZE 013030 3020 DCA HADR 013031 1600 RESHAN, TAD I GETHAN /GET DSRN NUMBER 013032 7450 SNA 013033 5600 JMP I GETHAN /NO DSRN NUMBER 013034 7106 CLL RTL 013035 7004 RAL 013036 1600 TAD I GETHAN 013037 1372 TAD (DSRN-12 013040 3010 DCA X0 /XR POINTS TO DSRN ENTRY 013041 6201 CDF 0 013042 1020 TAD HADR 013043 3410 DCA I X0 /SEE PG 0, FLD 0 FOR DSRN FORMAT 013044 1022 TAD HCWORD 013045 1031 TAD CFLAG /THE C BIT REVERSES THE FORMS CTL BIT ON THIS FILE 013046 0371 AND (7773 /KILL ANY OVERFLOW 013047 3410 DCA I X0 013050 1025 TAD HGHFLD 013051 7106 CLL RTL 013052 7004 RAL 013053 1026 TAD HGHADR 013054 3410 DCA I X0 /SAVE BUFFER ADDRESS, FIELD 013055 1026 TAD HGHADR 013056 3410 DCA I X0 /INITIALIZE WORD POINTER 013057 1026 TAD HGHADR 013060 1370 TAD (400 013061 7450 SNA 013062 2025 ISZ HGHFLD /BUMP DOUBLEWORD BUFFER ADDRESS 013063 3026 DCA HGHADR 013064 7346 AC7775 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 108-1 013065 3410 DCA I X0 /INITIALIZE CHAR CTR 013066 6211 CDF 10 013067 5600 JMP I GETHAN /RETURN /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 109 /LOAD A NON-RESIDENT HANDLER 013070 4274 NOTLDD, JMS GH 013071 7201 CLA IAC 013072 4274 JMS GH /TRY 1-PAGE AND THEN 2-PAGE ASSIGN 013073 7402 HLT /ARRRGHHHH!!! 013074 0000 GH, 0 013075 3355 DCA TPFLG 013076 1353 TAD HTOP 013077 1367 TAD (7600 /BUMP HANDLER CEILING DOWN 013100 7450 SNA 013101 5766 JMP I (HNDERR /CAN'T PUT HANDLER IN PAGE 0 013102 3353 DCA HTOP 013103 1355 TAD TPFLG 013104 1353 TAD HTOP 013105 3311 DCA GHADR 013106 1021 TAD UNIT 013107 4776 JMS I (200 013110 0001 1 /FETCH HANDLER 013111 0000 GHADR, 0 013112 5674 JMP I GH /FAILED! 013113 1311 TAD GHADR /SAVE ACTUAL LOAD ADDRESS ... 013114 4330 JMS HCWTBA /INDEX INTO HCW TABLE ... 013115 1311 TAD GHADR /AND PRESET CTL/ION BITS. 013116 0367 AND (7600 013117 1030 TAD HDIFF 013120 3311 DCA GHADR /SAVE RELOCATED HANDLER PAGE ADDRESS 013121 1023 TAD MXFLD /PUT ADDR IN BITS 0-3 AND FIELD IN BITS 6-8 013122 7106 CLL RTL 013123 7004 RAL 013124 1311 TAD GHADR 013125 1754 TAD I HCWPTR /ION BIT INTO BIT 11, FORMS CTL BIT INTO BIT 10 013126 3754 DCA I HCWPTR /STORE POINTER FOR THIS PAGE 013127 5215 JMP GHEXIT /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 110 013130 0000 HCWTBA, 0 013131 3024 DCA HLDADR 013132 1021 TAD UNIT 013133 4765 JMS I (GETION /GET CTL 10 BIT,ION 11 BIT 013134 3355 DCA TPFLG /STORE A MOMENT 013135 1024 TAD HLDADR 013136 7510 SPA /IF HANDLER IS RESIDENT, USE 013137 7200 CLA /SLOT 0, WHICH IS NOT USED (PAGE 0) 013140 0367 AND (7600 013141 7106 CLL RTL 013142 7006 RTL 013143 7006 RTL /GET PAGE NUMBER 013144 1364 TAD (HCWTBL 013145 3354 DCA HCWPTR /SAVE POINTER INTO TABLE 013146 1754 TAD I HCWPTR /DON'T TOUCH POINTER IF ALREADY LOADED 013147 0375 AND (7774 /OR LEAVE ZERO IF RESIDENT 013150 1355 TAD TPFLG /BUT RESET CTL/ION BITS EACH TIME 013151 3754 DCA I HCWPTR /SO THAT RESIDENT HANDLERS KNOW THEM. 013152 5730 JMP I HCWTBA 013153 3000 HTOP, F0HEND 013154 0000 HCWPTR, 0 013155 0000 TPFLG, 0 013164 2100 013165 3600 013166 2553 013167 7600 013170 0400 013171 7773 013172 4232 013173 5200 013174 0177 013175 7774 013176 0200 013177 0017 0200 SPSTRT, RELOC 200 /STARTUP CODE 010200* 7431 SWAB /MAKE SURE EAE IS IN MODE B 010201* 5602 JMP I .+1 /EXECUTES AT 200 010202* 4002 FPSTRT /START UP IN FLAG CLEARING CODE 3161 RELOC 3200 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 111 /ROUTINE TO ACCEPT FILE SPECIFICATIONS 013200 0000 GETFIL, 0 013201 6211 CDF 10 013202 1777 TAD I (OS8SWS-1 013203 7710 SPA CLA /ALTMODE MEANS NO MORE SPECS 013204 5600 JMP I GETFIL 013205 4776 GETFCD, JMS I (SPMDCD /CALL CD IN SPECIAL MODE 013206 1775 TAD I (7600 013207 7161 STL CIA 013210 7450 SNA /OUTPUT FILE? 013211 1774 TAD I (7605 013212 7450 SNA /IN OR OUT FILE? 013213 1773 TAD I (OS8SWS+3 /NEITHER - HOW ABOUT INTERNAL HANDLER? 013214 7650 SNA CLA 013215 5201 JMP GETFIL+1 /NONE OF THE ABOVE 013216 7010 RAR /LINK MAGICALLY TELLS DIRECTION 013217 3320 DCA DIR 013220 3243 DCA DSRNUM 013221 1772 TAD I (OS8SWS+2 013222 0371 AND (777 /SWITCHES 1-9 013223 7450 SNA 013224 5770 JMP I (NONUM 013225 7106 CLL RTL 013226 2243 DNUMLP, ISZ DSRNUM 013227 7004 RAL 013230 7500 SMA 013231 5226 JMP DNUMLP /TRANSLATE SWITCH INTO NUMBER 013232 1320 TAD DIR /** AC IS NEGATIVE ** 013233 7710 SPA CLA 013234 1367 TAD (5 013235 1375 TAD (7600 013236 3261 DCA FPTR /POINT TO FILE UNIT 013237 1661 TAD I FPTR 013240 7450 SNA 013241 5324 JMP INTHND /NO FILE - GET HANDLER FROM INTERNAL LIST 013242 4766 JMS I (GETHAN /GET HANDLER - XR10 POINTS INTO DSRN 013243 0000 DSRNUM, 0 /DSRN ENTRY NUMBER 013244 1320 TAD DIR 013245 7126 STL RTL /GENERATE 2 OR 3 (LOOKUP OR ENTER) 013246 3260 DCA LKPNTR 013247 1661 TAD I FPTR /GET UNIT AND REQUESTED BLOCK COUNT (IF ENTER) 013250 2261 ISZ FPTR /BUMP POINTER SO IT POINTS TO THE FILE NAME 013251 3262 DCA FUNIT /SAVE UNIT NUMBER A SEC 013252 1661 TAD I FPTR /WATCH OUT FOR NULL FILE NAMES 013253 7650 SNA CLA /AS THEY WILL FAIL ON LOOKUPS 013254 5321 JMP NONAME /ON OUTPUT-ONLY NON-DIRECTORY DEVICES 013255 4765 JMS I (SVHND /SAVE HANDLER 013256 1262 TAD FUNIT 013257 4764 JMS I (200 013260 0000 LKPNTR, 0 /LOOKUP OR ENTER 013261 0000 FPTR, 0 /FILE NAME 013262 0000 FUNIT, 0 /GETS LENGTH /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 111-1 013263 5763 JMP I (FILERR /SOMETHING NOT KOSHER 013264 4762 JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 112 013265 1261 STDSRN, TAD FPTR 013266 6201 CDF 0 013267 3410 DCA I X0 /SAVE STARTING BLOCK 013270 3410 DCA I X0 /RELATIVE BLOCK 013271 1262 TAD FUNIT 013272 7450 SNA 013273 7001 IAC /FUDGE NON-DIRECTORY DEVICES VERY LARGE 013274 7041 CIA /TURN NEGATIVE COUNT TO POSITIVE 013275 3410 DCA I X0 /LENGTH 013276 1010 TAD X0 013277 3261 DCA FPTR /SAVE PTR TO LENGTH WORD 013300 6211 CDF 10 013301 1320 TAD DIR 013302 7700 SMA CLA /TENTATIVE FILE? 013303 5201 JMP GETFIL+1 013304 1261 TAD FPTR /YES - STORE POINTER TO LENGTH WORD OF DSRN 013305 3712 DCA I TFPTR /IN TENTATIVE FILE TABLE ENTRY 013306 4761 JMS I (MOVE 013307 6211 CDF 10 013310 7577 7600-1 013311 6211 CDF 10 013312 2114 TFPTR, TFTABL /SAVE FILE NAME AND UNIT IN 013313 7773 -5 /TENTATIVE FILE TABLE 013314 1312 TAD TFPTR 013315 1360 TAD (6 013316 3312 DCA TFPTR /BUMP PTR TO NEXT 6-WORD ENTRY 013317 5201 JMP GETFIL+1 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 113 013320 0000 DIR, 0 013321 3261 NONAME, DCA FPTR 013322 3262 DCA FUNIT /ZERO BLOCK # AND LENGTH 013323 5265 JMP STDSRN /USE ENTIRE DEVICE AS FILE 013324 7340 INTHND, AC7777 013325 1773 TAD I (OS8SWS+3 013326 0357 AND (3 /ONLY USE LOW ORDER 2 BITS OF NUMBER 013327 1356 TAD (IHTBL 013330 3020 DCA HADR /SAVE PTR INTO TABLE OF INTL HANDLERS 013331 1243 TAD DSRNUM 013332 7106 CLL RTL 013333 7004 RAL 013334 1243 TAD DSRNUM /MULTIPLY DSRN NUMBER BY 9 013335 1355 TAD (DSRN-11 /ADD TABLE BASE 013336 3243 DCA DSRNUM 013337 1420 TAD I HADR 013340 6201 CDF 0 013341 3643 DCA I DSRNUM 013342 2243 ISZ DSRNUM 013343 7344 AC7776 013344 1031 TAD CFLAG /DEPENDING ON THE C FLAG, 013345 7041 CIA 013346 3643 DCA I DSRNUM /DISABLE OR ENABLE FORMS CONTROL 013347 5201 JMP GETFIL+1 013355 4233 013356 3515 013357 0003 013360 0006 013361 2523 013362 3635 013363 3512 013364 0200 013365 3622 013366 3000 013367 0005 013370 3507 013371 0777 013372 7645 013373 7646 013374 7605 013375 7600 013376 3454 013377 7642 3400 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 114 013400 0000 TSTSWS, 0 /ROUTINE TO TEST CD SWITCHES E AND H 013401 1777 TAD I (OS8SWS 013402 0376 AND (20 013403 6201 CDF 0 013404 7650 SNA CLA /TEST FOR /H SWITCH 013405 5210 JMP .+3 013406 1375 TAD (HLT 013407 3774 DCA I (HLTNOP /SET TO HALT BEFORE STARTING PROGRAM 013410 6211 CDF 10 013411 1773 TAD I (OS8SWS+1 013412 0372 AND (4 013413 7650 SNA CLA /TEST FOR /V SWITCH 013414 5217 JMP .+3 /NO 013415 4771 JMS I (RLERR /YES - PRINT VERSION NUMBER MESSAGE 013416 5520 XVERMS 013417 1777 TAD I (OS8SWS 013420 0370 AND (200 013421 6201 CDF 0 013422 7640 SZA CLA /TEST FOR /E SWITCH 013423 2767 ISZ I (ERRFLG /MAKE USER ERRORS NON-FATAL 013424 6211 CDF 10 /(USER ERROR = MISSING SUBROUTINE, ETC) 013425 1777 TAD I (OS8SWS 013426 7006 RTL 013427 7700 SMA CLA 013430 7326 AC0002 013431 3031 DCA CFLAG /SAVE C FLAG IN PAGE0 013432 5600 JMP I TSTSWS 013433 0000 MOVEAE, 0 013434 1366 TAD (EFFNOR /SUBSTITUTE A POINTER TO THE EAE NORMALIZE 013435 6201 CDF 0 /ROUTINE FOR THE POINTER TO THE NON-EAE 013436 3765 DCA I (NORMX /NORMALIZE ROUTINE 013437 4764 JMS I (MOVE 013440 6211 CDF 10 013441 6577 FPPKG-1 /THE EAE PKG IS IN THE SAME PAGE IN FIELD 1 013442 6201 CDF 0 013443 6577 FPPKG-1 /AS THE NON-EAE PKG IN FIELD 0 013444 7200 -600 013445 4764 JMS I (MOVE 013446 6201 CDF 0 /SUBSTITUTE FAST FIX AND FLOAT 013447 5246 EFXFLT-1 013450 6201 CDF 0 013451 4406 EAEFIX-1 013452 7767 -FXFLTC 013453 5633 JMP I MOVEAE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 115 013454 0000 SPMDCD, 0 /SUBR TO DO A SPECIAL MODE COMMAND DECODE 013455 4764 JMS I (MOVE 013456 6211 CDF 10 013457 7646 OS8DVT-1 013460 6211 CDF 10 013461 2160 DVTEMP-1 /MOVE OS/8 DEVICE HANDLER TABLE 013462 7761 -17 /SINCE C.D. CLEARS IT AND WE ARE USING IT 013463 1763 TAD I (HTOP /GET LOWEST HANDLER LOADED 013464 7004 RAL 013465 7730 SZL SPA CLA /DID WE LOAD ANY BELOW 02000? 013466 5272 JMP .+4 /NO 013467 6201 CDF 0 013470 2762 ISZ I (OSJSWD /YES - MAKE CD CALLS 013471 2762 ISZ I (OSJSWD /NON DESTRUCTIVE 013472 6211 CDF 10 013473 4770 JMS I (200 013474 0005 5 /COMMAND DECODE 013475 5200 5200 /SPECIAL MODE - WROUGHT WITH PERIL 013476 0000 0 /DON'T CLEAR TENTATIVE FILES 013477 4764 JMS I (MOVE 013500 6211 CDF 10 013501 2160 DVTEMP-1 013502 6211 CDF 10 013503 7646 OS8DVT-1 013504 7761 -17 /MOVE DEVICE HANDLER TABLE BACK 013505 4200 JMS TSTSWS /CHECK FOR /E, /H 013506 5654 JMP I SPMDCD /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 116 013507 4771 NONUM, JMS I (RLERR 013510 5424 NONMSG 013511 5761 JMP I (GETFCD 013512 4771 FILERR, JMS I (RLERR 013513 5435 FILMSG 013514 5761 JMP I (GETFCD 013515 0000 IHTBL, 0;0;LPT;TTY /INTERNAL HANDLER TABLE 013516 0000 013517 0236 013520 0271 013521 7340 RUBPAT, AC7777 013522 1011 TAD INXR 013523 3011 DCA INXR 013524 1411 TAD I INXR 013525 3304 PATRUB+6&177+3200 /DCA .+2 013561 3205 013562 7746 013563 3153 013564 2523 013565 5770 013566 7102 013567 4752 013570 0200 013571 3662 013572 0004 013573 7644 013574 4035 013575 7402 013576 0020 013577 7643 3600 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 117 013600 0000 GETION, 0 013601 1377 TAD (OS8DCB-1 013602 3250 DCA GMADR 013603 1650 TAD I GMADR /GET DCB WORD 013604 7112 CLL RTR 013605 7010 RAR 013606 0376 AND (77 /INDEX INTO TABLE 013607 1375 TAD (IONTBL /WHICH INDICATES IF HANDLER CAN EXECUTE 013610 3250 DCA GMADR /WITH INTERRUPTS ON 013611 1650 TAD I GMADR /ION BIT INTO BIT 11, FORMS CONTROL INTO BIT 10 013612 5600 JMP I GETION 013613 0000 GBFLG, 0 013614 6201 CDF 0 013615 1774 TAD I (7777 /SPECIAL FLAGS LOC 013616 6211 CDF 10 013617 7006 RTL 013620 7204 CLA RAL 013621 5613 JMP I GBFLG 013622 0000 SVHND, 0 /ROUTINE TO SAVE HANDLER IN F1 013623 4250 JMS GMADR /GET MOVE FROM ADDRESS 013624 5622 JMP I SVHND /NO HANDLER TO MOVE 013625 3230 DCA SVMOVE 013626 4773 JMS I (MOVE 013627 6201 CDF 0 013630 0000 SVMOVE, 0 013631 6211 CDF 10 013632 6777 F0HSAV-1 013633 7400 -400 013634 5622 JMP I SVHND 013635 0000 RSTHND, 0 /ROUTINE TO RESTORE HANDLER FROM F1 013636 4250 JMS GMADR 013637 5635 JMP I RSTHND /HANDLER IS SYS: 013640 3245 DCA RSTMOV 013641 4773 JMS I (MOVE 013642 6211 CDF 10 013643 6777 F0HSAV-1 013644 6201 CDF 0 013645 0000 RSTMOV, 0 013646 7400 -400 013647 5635 JMP I RSTHND 013650 0000 GMADR, 0 013651 1024 TAD HLDADR 013652 7510 SPA /CHECK THAT WE'RE NOT TRYING 013653 5260 JMP RESHND /TO SAVE A RESIDENT HANDLER - 013654 0260 AND RESHND /THAT COULD BE TRICKY 013655 1374 TAD (-1 /ECCH 013656 2250 ISZ GMADR 013657 5650 JMP I GMADR 013660 7600 RESHND, 7600 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 117-1 013661 5650 JMP I GMADR /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 118 /RTS LOADER ERROR MESSAGE ROUTINE & MESSAGES 013662 0000 RLERR, 0 /ERROR MESSAGES ARE IN FIELD 0 013663 7200 CLA 013664 6211 CDF 10 013665 1662 TAD I RLERR 013666 6201 CDF 0 013667 3027 DCA RLTMP 013670 1427 RELP, TAD I RLTMP 013671 7012 RTR 013672 7012 RTR 013673 7012 RTR 013674 0376 AND (77 013675 4312 JMS LTTY 013676 1427 TAD I RLTMP 013677 0376 AND (77 013700 4312 JMS LTTY 013701 2027 ISZ RLTMP 013702 5270 JMP RELP 013703 1372 EOMSG, TAD (7515 013704 4312 JMS LTTY 013705 1371 TAD (7512 013706 4312 JMS LTTY 013707 2262 ISZ RLERR 013710 6211 CDF 10 013711 5662 JMP I RLERR /SOME MESSAGES ARE NOT FATAL 013712 0000 LTTY, 0 013713 7450 SNA 013714 5303 JMP EOMSG 013715 1370 TAD (240 013716 7500 SMA 013717 0376 AND (77 /CONVERT SIXBIT TO EIGHTBIT 013720 1370 TAD (240 013721 6046 TLS 013722 7200 CLA 013723 6041 TSF 013724 5323 JMP .-1 013725 5712 JMP I LTTY /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 119 /ROUTINE TO DETERMINE WHETHER WE ARE RUNNING IN THE /BACKGROUND UNDER MULTI-8, AND MODIFY THE RUN-TIME SYSTEM IF WE ARE. /RUNS AT INITIALIZATION TIME, BEFORE LOWER FIELD 0 IS MOVED 013726 0000 BAKTST, 0 013727 6552 FPICL /FIRST INITIALIZE FPP (IF ANY) 013730 6553 FPCOM /INCLUDING CLEARING EXTENDED APT POINTER 013731 6254 SINT /6254 TEST FOR MULTI-8 BACKGROUND WITH SKPM8 013732 5726 JMP I BAKTST /NO SKIP, WE ARE RUNNING UNDER OS/8 013733 6201 CDF 0 /MODIFY LIST AND MODIFICATIONS ARE IN FIELD 0 013734 1751 BAKLP, TAD I BKRPTR /GET POINTER TO BLOCK TO BE MODIFIED 013735 7450 SNA 013736 5347 JMP BAKRTN /ZERO - WE'RE DONE 013737 3010 DCA X0 /STORE IN AUTO-XR 013740 2351 ISZ BKRPTR 013741 1751 BAKWLP, TAD I BKRPTR /GET NEXT WORD TO STORE 013742 2351 ISZ BKRPTR 013743 7450 SNA 013744 5334 JMP BAKLP /ZERO MEANS END OF GROUP 013745 3410 DCA I X0 013746 5341 JMP BAKWLP 013747 6211 BAKRTN, CDF 10 /RESET DATA FIELD TO 10 /TAD (CLA /PATCH FPP HANDLER FOR M&S FPP UNDER MULTI8 /DCA I (YFPP1 /TAD (CLA /KILL HANG START /DCA I (YFPP2 /TAD (7000 /DCA I (YFPP3 /KILL ION 013750 5726 JMP I BAKTST /AND RETURN 013751 5335 BKRPTR, BKRLST 013770 0240 013771 7512 013772 7515 013773 2523 013774 7777 013775 2000 013776 0077 013777 7757 4000 PAGE 4000 F0TO= . /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 120 /FLOATING POINT PROCESSOR HANDLER 5600 *FPPINT 015600 5302 RETURN, JMP FPPRTN /MUST BE AT 0 IN PAGE 015601 0000 FPGO, 0 /FPP STARTUP ROUTINE - MUST BE AT 1 IN PAGE 015602 6201 CDF 0 015603 3336 DCA STEFLG 015604 1040 TAD PC 015605 3334 DCA FSAVPC /SAVE OLD PC FOR ONE LEVEL 015606 1037 TAD APT 015607 3335 DCA SAVAPT /OF RE-ENTRANTNESS 015610 1601 TAD I FPGO 015611 3040 DCA PC 015612 1037 TAD APT 015613 0377 AND (7770 015614 3037 DCA APT /SET UP ADDRESS IN APT 015615 1376 FPREST, TAD (400 /ENABLE FPP INTERRUPTS 015616 6553 FPCOM /LOAD AND STORE ENTIRE APT 015617 7200 CLA /NECESSARY? 015620 1336 TAD STEFLG /0 OR 4000?(STARTF OR STARTE) 015621 7440 SZA 015622 6567 FPEP 015623 7200 CLA 015624 1375 TAD (APT 015625 6002 IOF 015626 6555 FPST /START UP FPP 015627 5226 JMP .-1 /I HAVE NO IDEA WHY IT DIDN'T START 015630 7200 CLA /NECESSARY? 015631 4774 YFPP1, JMS I (HANG /EXECUTE BACKGROUND 015632 0411 YFPP2, FPUHNG 015633 6556 FPRST /READ FPP STATUS 015634 6552 FPICL /RESET FPP 015635 6001 YFPP3, ION 015636 7006 RTL 015637 7430 SZL /TEST TRAP BIT 015640 5252 JMP TRAP /YUP - GO EXECUTE IT 015641 0373 AND (7600 015642 7440 SZA /ANY ERRORS? 015643 5310 JMP FPPER 015644 1334 TAD FSAVPC 015645 3040 DCA PC /RESTORE OLD PC 015646 1335 TAD SAVAPT 015647 3037 DCA APT 015650 2201 ISZ FPGO 015651 5601 JMP I FPGO /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 121 /FLOATING POINT TRAP PROCESSOR 015652 7346 TRAP, AC7775 015653 1040 TAD PC 015654 3040 DCA PC /BACK UP PC TO BEFORE THE TRAP 015655 7430 SZL 015656 7340 AC7777 015657 1037 TAD APT /INCLUDING THE FIELD BITS 015660 3037 DCA APT 015661 1037 TAD APT /SET UP "FETPC" TO FETCH POSSIBLE TRAP ARGS 015662 4436 JMS I MCDF 015663 3772 DCA I (PCCDF 015664 4771 JMS I (FETPC 015665 3020 DCA T 015666 1020 TAD T /GET TRAP WORD 015667 4436 JMS I MCDF 015670 7001 IAC /MAKE A "CDF CIF N" 015671 7001 IAC 015672 3276 DCA TRPCIF 015673 4771 JMS I (FETPC 015674 3043 DCA ADR /STORE PDP8-CODE ROUTINE ADDRESS 015675 1020 TAD T 015676 7402 TRPCIF, HLT /SET DATA AND INSTRUCTION FIELDS 015677 7700 SMA CLA /TRAP3 OR TRAP4? 015700 5443 JMP I ADR /TRAP3 - GO TO ADR 015701 4443 JMS I ADR /TRAP4 - CALL ADR 015702 3336 FPPRTN, DCA STEFLG 015703 2040 ISZ PC /RESTORE PC FROM BEFORE TRAP 015704 7410 SKP 015705 2037 ISZ APT /INCLUDING FIELD 015706 6201 CDF 0 015707 5215 JMP FPREST /RESTART FPP 015710 7510 FPPER, SPA 015711 5770 JMP I (FPHALT / - FATAL ERROR 015712 7006 RTL 015713 7420 SNL 015714 5325 JMP FPOVUN 015715 2035 ISZ FATAL /DIVIDE BY 0 NON-FATAL 015716 4434 FPDVER, JMS I ERR 015717 0100 DV0MSG-ERRMSG 015720 1320 TAD . /I ALWAYS WANTED TO INCLUDE ONE OF THESE! 015721 3044 DCA ACX 015722 7332 AC2000 015723 3045 DCA ACH 015724 5215 JMP FPREST 015725 7006 FPOVUN, RTL 015726 7510 SPA 015727 5767 JMP I (CTLBER-1 /*WMM8* SIMULATE ^C ON UNDERFLOW 015730 2035 ISZ FATAL /OVERFLOW NON-FATAL 015731 4434 FPOVER, JMS I ERR 015732 0120 OFLMSG-ERRMSG 015733 5317 JMP FPDVER+1 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 121-1 015734 0000 FSAVPC, 0 015735 0000 SAVAPT, 0 015736 0000 STEFLG, 0 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 122 /RANDOM FPP CODE FOR D.P. I/O 015737 6400 DFSTM2, FSTA+LONG 015740 6321 DFTMP2 015741 0000 FEXIT 015767 0352 015770 3737 015771 4524 015772 4534 015773 7600 015774 0524 015775 0037 015776 0400 015777 7770 6000 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 123 /THIS IS DOUBLE PRECISION FORMATTED OUTPUT. /ITS A LOT LIKE SINGLE PRECISION,WITHOUT ALL THE G + I STUFF /AND, OH JOY!, NO PAGE 0 LITERALS. 016000 1023 DNXT, TAD RWFLAG /READ OR WRITE? 016001 7700 SMA CLA 016002 7330 AC4000 /ITS INPUT SO LEAVE IN STARTE MODE 016003 4777 JMS I (GETLMN 016004 5207 JMP .+3 016005 7340 DFMT, AC7777 016006 3063 BFMT, DCA EFLG 016007 1030 TAD D 016010 3064 DCA OD /SAVE COUNT OF DIGITS AFTER DEC PT 016011 1066 TAD PFACT 016012 3067 DCA PFACTX 016013 3065 DCA SCALE 016014 4776 JMS I (SKPOUT /DONE? 016015 5775 JMP I (DPIN /ITS INPUT 016016 7340 AC7777 /ITS OUTPUT 016017 3774 DCA I (FFNEG /USE THIS LOCN AS SIGN FLAG 016020 1063 TAD EFLG 016021 7104 CLL RAL 016022 7104 CLL RAL 016023 1027 TAD W /GIVE ROOM FOR EXP FIELD (IF ANY) 016024 7100 CLL /NECESSARY? 016025 3773 DCA I (OW 016026 1045 TAD ACH 016027 7450 SNA 016030 5261 JMP SKPZRO /IF AC 0,SKIP ALOT OF THIS 016031 7700 SMA CLA 016032 5235 JMP DSCLUP 016033 4772 JMS I (DFNEG /AC<0-NEGATE IT 016034 3774 DCA I (FFNEG / 0 <> 7777 016035 3065 DSCLUP, DCA SCALE 016036 1044 TAD ACX 016037 7740 SMA SZA CLA /AC<1.0? 016040 5247 JMP DGT1 /NO 016041 7330 AC4000 /STARTE 016042 4771 JMS I (FPGO /Y-MULT BY 10. 016043 3361 FMUL10 016044 7340 AC7777 016045 1065 TAD SCALE /BUMP POWER OF TEN 016046 5235 JMP DSCLUP 016047 4770 DGT1, JMS I (DSCLDN /NUMBER IS >=1.;NOW DECREASE IT TO (0,1) 016050 7330 AC4000 016051 4771 JMS I (FPGO /SAVE IT 016052 3755 FSTTMP 016053 1367 TAD (22 016054 4766 JMS I (OSCALE 016055 7330 AC4000 016056 4771 JMS I (FPGO 016057 5145 FADTMP 016060 4770 JMS I (DSCLDN /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 124 016061 4765 SKPZRO, JMS I (DIGCNT /NO NEED FOR ALL THE G STUFF TO BE /INCLUDED IN THE SINGLE PREC ROUTINE /MAKE NOTG ROUTINE A SUBROUTINE 016062 7500 SMA /EQUIV TO OUTNUM IN SINGLE PREC 016063 5345 JMP DASTRS 016064 4764 JMS I (OBLNKS 016065 7346 AC7775 016066 2774 ISZ I (FFNEG /IF SIGN IS NEG, 016067 4763 JMS I (DIGIT /PRINT A MINUS 016070 7200 CLA 016071 1044 TAD ACX 016072 7450 SNA /ALIGN FAC MANTISSA INTO A 016073 4762 JMS I (DAL1 /FRACTION (.1,1) 016074 7001 IAC 016075 7510 SPA 016076 4761 JMS I (DACSR 016077 7200 CLA 016100 1051 TAD EAC3 016101 3053 DCA AC1 /MOVE FAC DOWN SO OVERFLOW FROM 016102 1050 TAD EAC2 /MULT BY 10 IN HIGH ORDER WORD 016103 3051 DCA EAC3 016104 1047 TAD EAC1 016105 3050 DCA EAC2 016106 1046 TAD ACL 016107 3047 DCA EAC1 016110 1045 TAD ACH 016111 3046 DCA ACL 016112 1065 TAD SCALE 016113 7550 SPA SNA /ANY DIGITS TO LEFT OF DEC PT? 016114 5760 JMP I (DPRZRO /N-PRINT A 0 /JUST AS CHEAP TO DUPLICATE CODE 016115 4757 JMS I (DBLDIG /Y- PRINT THEM /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 125 016116 7344 DRDCPT, AC7776 016117 4763 JMS I (DIGIT /PRINT A DEC PT 016120 1065 TAD SCALE 016121 7700 SMA CLA /NEED LEADING ZEROS? 016122 5335 JMP DNOLZR /NO 016123 1065 TAD SCALE 016124 3020 DCA T 016125 7340 DLZERO, AC7777 016126 1064 TAD OD /DECREASE D VALUE 016127 7420 SNL 016130 5340 JMP DNOMAC /NO MORE FIELD WIDTH AVAILABLE 016131 3064 DCA OD 016132 4763 JMS I (DIGIT /PRINT A 0 016133 2020 ISZ T /CONT UNTIL COUNT OR WIDTH RUNS OUT 016134 5325 JMP DLZERO 016135 1064 DNOLZR, TAD OD 016136 7440 SZA 016137 4757 JMS I (DBLDIG /PRINT REMAINING DIGITS 016140 7200 DNOMAC, CLA 016141 1063 TAD EFLG 016142 7440 SZA /IF EFLG IS NOT ZERO IT IS -1, 016143 4756 JMS I (EXPFLD /SO WE WILL PRINT A D INSTEAD OF AN E 016144 5755 JMP I (DNXT 016145 7200 DASTRS, CLA 016146 1027 TAD W 016147 4754 JMS I (ASTRSK 016150 5755 JMP I (DNXT 016154 2557 016155 6000 016156 2262 016157 6200 016160 6267 016161 6327 016162 6272 016163 2371 016164 2337 016165 2077 016166 2126 016167 0022 016170 6255 016171 5601 016172 6535 016173 2125 016174 4475 016175 6400 016176 1230 016177 0234 6200 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 126 016200 0000 DBLDIG, 0 /OUTPUT DIGITS 016201 7041 CIA 016202 3020 DCA T 016203 3045 DBDLOP, DCA ACH /0 THE HI WORD FOR OVERFLO 016204 1053 TAD AC1 016205 3054 DCA AC2 /START TO COPY THE FAC.THIS IS 016206 1046 TAD ACL /EAC3 SHIFTED DOWN 1 WORD 016207 3057 DCA OPL 016210 1047 TAD EAC1 016211 3362 DCA L1 /ACL 016212 1050 TAD EAC2 016213 3327 DCA DACSR /EAC1 016214 1051 TAD EAC3 016215 3255 DCA DSCLDN /EAC2 016216 4272 JMS DAL1 016217 4272 JMS DAL1 016220 7100 CLL 016221 1054 TAD AC2 016222 1053 TAD AC1 016223 3053 DCA AC1 /THIS IS FAC*5 COMING UP 016224 7004 RAL 016225 1255 TAD DSCLDN 016226 1051 TAD EAC3 016227 3051 DCA EAC3 016230 7004 RAL 016231 1327 TAD DACSR 016232 1050 TAD EAC2 016233 3050 DCA EAC2 016234 7004 RAL 016235 1362 TAD L1 016236 1047 TAD EAC1 016237 3047 DCA EAC1 016240 7004 RAL 016241 1057 TAD OPL 016242 1046 TAD ACL 016243 3046 DCA ACL 016244 7004 RAL 016245 1045 TAD ACH 016246 3045 DCA ACH 016247 4272 JMS DAL1 016250 1045 TAD ACH 016251 4777 JMS I (DIGIT 016252 2020 ISZ T 016253 5203 JMP DBDLOP 016254 5600 JMP I DBLDIG /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 127 016255 0000 DSCLDN, 0 /USED AS A TEMP TOO 016256 1044 TAD ACX 016257 7750 SPA SNA CLA 016260 5655 JMP I DSCLDN /DONE IF FAC<1. 016261 7330 AC4000 016262 4776 JMS I (FPGO 016263 3355 FDIV10 016264 2065 ISZ SCALE 016265 0000 0 /A FREE LOCN! 016266 5256 JMP DSCLDN+1 016267 7200 DPRZRO, CLA 016270 4777 JMS I (DIGIT 016271 5775 JMP I (DRDCPT /6 WORD FAC LEFT SHIFT 016272 0000 DAL1, 0 016273 1053 TAD AC1 /GET OVERFLO BIT 016274 7104 CLL RAL /SHIFT LEFT 016275 3053 DCA AC1 016276 1051 TAD EAC3 /CONTINUE WORKING WAY UP THRU MANTISSA 016277 7004 RAL 016300 3051 DCA EAC3 016301 1050 TAD EAC2 016302 7004 RAL 016303 3050 DCA EAC2 016304 1047 TAD EAC1 016305 7004 RAL 016306 3047 DCA EAC1 016307 1046 TAD ACL 016310 7004 RAL 016311 3046 DCA ACL 016312 1045 TAD ACH 016313 7004 RAL 016314 3045 DCA ACH 016315 5672 JMP I DAL1 016316 0400 DFLTM2, FLDA+LONG 016317 6321 DFTMP2 016320 0000 FEXIT 016321 0000 DFTMP2, 0;0;0;0;0;0 016322 0000 016323 0000 016324 0000 016325 0000 016326 0000 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 128 /6 WORD FAC RIGHT SHIFT. ENTER WITH COUNT-1 IN AC / 016327 0000 DACSR, 0 /USED AS A TEMP BY DBDLOP 016330 3052 DCA AC0 /STORE COUNT 016331 1045 DLOP1, TAD ACH 016332 7100 CLL 016333 7510 SPA /PROPOGATE SIGN 016334 7020 CML 016335 7010 RAR 016336 3045 DCA ACH /SHIFT RIGHT 1,PROPOGATE SIGN 016337 1046 TAD ACL /DO SHIFTING FOR EACH WORD OF MANTISSA 016340 7010 RAR 016341 3046 DCA ACL 016342 1047 TAD EAC1 016343 7010 RAR 016344 3047 DCA EAC1 016345 1050 TAD EAC2 016346 7010 RAR 016347 3050 DCA EAC2 016350 1051 TAD EAC3 016351 7010 RAR 016352 3051 DCA EAC3 016353 2044 ISZ ACX /INCREMENT EXPONENT 016354 7000 NOP 016355 2052 ISZ AC0 /DONE? 016356 5331 JMP DLOP1 /NOPE 016357 7010 RAR /YUP 016360 3053 DCA AC1 /SAVE 1 BIT OF OVERFLOW 016361 5727 JMP I DACSR 016362 0000 L1, 0 016375 6116 016376 5601 016377 2371 6400 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 129 /THIS IS DOUBLE PRECISION INPUT (WITH FPP ONLY) /IT IS A LOT LIKE SINGLE PRECISION INPUT, BUT USES /ITS OWN FPP ROUTINES. 016400 7340 DPIN, AC7777 016401 3334 DCA DDPSW /INITIALIZE DEC. PT. SWITCH 016402 7340 AC7777 016403 3362 DCA DINESW /AND EXPONENT SWITCH 016404 1027 TAD W 016405 7040 CMA 016406 3072 DCA FMTNUM /CHAR COUNT 016407 3044 DINESM, DCA ACX /CLEAR FLOATING AC 016410 3045 DCA ACH 016411 3046 DCA ACL 016412 3047 DCA EAC1 016413 3050 DCA EAC2 016414 3051 DCA EAC3 016415 7340 AC7777 016416 3335 DINMIN, DCA DFNEG 016417 2072 DINLOP, ISZ FMTNUM 016420 5273 JMP DINGCH /LOOP UNTIL WIDTH EXHAUSTED 016421 2777 DINENM, ISZ I (DFNEG /IS SIGN NEGATIVE? 016422 4777 JMS I (DFNEG /YES-NEGATE 016423 2362 ISZ DINESW /SEEN A D YET? 016424 5262 JMP DFIXUP /YES-THIS IS EXP,NOT NUMBER 016425 1067 TAD PFACTX /NO D- SCALE WITH P FACTOR 016426 1064 DSCLIN, TAD OD /GET SCALING FACTOR 016427 7120 STL 016430 7450 SNA 016431 5776 JMP I (DNXT /NO SCALING NEEDED 016432 7500 SMA 016433 7141 CIA CLL /AC CONTAINS MAGNITUDE,LINK CONTAINS SIGN 016434 3064 DCA OD 016435 7006 RTL 016436 7004 RAL 016437 1375 TAD (FDIV10 016440 3243 DCA DIGFOP 016441 7330 AC4000 016442 4774 JMS I (FPGO /MULT OR DIVIDE BY 10 016443 0000 DIGFOP, 0 016444 2064 ISZ OD 016445 5241 JMP DIGFOP-2 /MULT OR DIV CORRECT NUMBER OF TIMES 016446 5776 JMP I (DNXT /GET MORE 016447 2362 DIND, ISZ DINESW /IS THERE A 2ND D? 016450 5316 JMP DINER /Y-A NO-NO 016451 2334 ISZ DDPSW /FORCE DEC. PT. SWITCH ON 016452 1064 TAD OD /USE SCALE FACTOR IF SEEN DEC. PT 016453 3065 DCA SCALE /SAVE SCALE FACTOR 016454 2335 ISZ DFNEG 016455 4335 JMS DFNEG /GET SIGN OF NUMBER 016456 7330 AC4000 016457 4774 JMS I (FPGO /SAVE IT TEMPORARILY 016460 5737 DFSTM2 016461 5207 JMP DINESM /GO COLLECT EXP /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 130 016462 4773 DFIXUP, JMS I (FFIX /IS THIS OK FOR DBL PREC??? 016463 1070 TAD ACI 016464 7041 CIA 016465 1065 TAD SCALE /ADD EXP TO DEC PT SCALE FACTOR 016466 3064 DCA OD 016467 7330 AC4000 016470 4774 JMS I (FPGO 016471 6316 DFLTM2 /GET NUMBER BACK IN FAC 016472 5226 JMP DSCLIN 016473 4772 DINGCH, JMS I (FMTIN /GET A CHAR 016474 4771 JMS I (CHTYPE /CLASSIFY IT 016475 1234 1234; DDIGIT 016476 6523 016477 7722 -56; DIDCPT /. 016500 6517 016501 7725 -53; DINLOP /+ 016502 6417 016503 7723 -55; DINMIN /- 016504 6416 016505 7774 -4; DIND /D 016506 6447 016507 7773 -5; DIND /E - BE FORGIVING 016510 6447 016511 7740 -40; DINLOP /BLANK 016512 6417 016513 7724 -54; DINENM /, 016514 6421 016515 0000 0 016516 5770 DINER, JMP I (INER 016517 3064 DIDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER DEC PT 016520 2334 ISZ DDPSW /TEST + SET DEC PT SWITCH 016521 5316 JMP DINER /2 DEC. PT. IS NO GOOD 016522 5217 JMP DINLOP 016523 1071 DDIGIT, TAD CHCH 016524 3767 DCA I (DGT+1 /SAVE DIGIT 016525 7330 AC4000 016526 4774 JMS I (FPGO 016527 5136 ACMDGT 016530 1334 TAD DDPSW 016531 7650 SNA CLA 016532 2064 ISZ OD /BUMP DIGIT IF DEC PT SEEN 016533 5217 JMP DINLOP 016534 0000 DDPSW, 0 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 131 /6 WORD FLOATING NEGATE 016535 0000 DFNEG, 0 016536 1051 TAD EAC3 016537 7141 CLL CMA IAC /NEGATE LOW ORDER WORD OF MANTISSA 016540 3051 DCA EAC3 /STORE IT BACK 016541 7024 CML RAL /ADJUST OVERFLOW+CARRY 016542 1050 TAD EAC2 /CONTINUE WITH REST OF MANTISSA 016543 7041 CMA IAC 016544 3050 DCA EAC2 016545 7024 CML RAL 016546 1047 TAD EAC1 016547 7041 CMA IAC 016550 3047 DCA EAC1 016551 7024 CML RAL 016552 1046 TAD ACL 016553 7041 CMA IAC 016554 3046 DCA ACL 016555 7024 CML RAL 016556 1045 TAD ACH 016557 7141 CLL CMA IAC 016560 3045 DCA ACH 016561 5735 JMP I DFNEG 016562 0000 DINESW, 0 016567 2527 016570 2435 016571 1200 016572 3000 016573 4400 016574 5601 016575 3355 016576 6000 016577 6535 6600 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 132 6600 *FPPKG /EAE PKG LOADS OVER REGULAR PKG 016600 0000 LPBUFR, ZBLOCK 16 016616 7124 LPBUF5 016617 0000 AL1BMP, 0 /*K* MUST BE AT SAME LOC AS NON-EAE VERSION 016620 7340 AC7777 016621 1044 TAD ACX 016622 3044 DCA ACX 016623 4777 JMS I (AL1 016624 5617 JMP I AL1BMP /EAE FLOATING POINT INTERPRETER /FOR PDP8/E WITH KE8-E EAE /W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN /FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE /THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO /A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY. /(IN THE LOW ORDER, NATCHERLY) 016625 4776 DDMPY, JMS I (DARGET 016626 7410 SKP 016627 4775 FFMPY, JMS I (ARGET 016630 4337 JMS EMDSET /SET UP FOR MULT 016631 7605 CLA MUY /MULTIPLY-LOW ORDER FAC STILL IN MQ 016632 0056 OPH /THIS IS PRODUCT OF LOW ORDERS 016633 7421 MQL /ZAP LOW ORDER RESULT-INSIGNIFICANT 016634 1045 TAD ACH /GET LOW ORDER(!) OF FAC 016635 7525 SWP MUY /TO MQ-HIGH ORD. RESLT OF LAST MPY 016636 0057 OPL /TO AC-WILL BE ADDED TO RESLT-THIS 016637 7445 DST /IS PRODUCT-LOW ORD FAC,HI ORD OP 016640 0052 AC0 /STORE RESULT 016641 7200 CLA 016642 1046 TAD ACL /HIGH ORDER FAC TO MQ 016643 7421 MQL 016644 1055 TAD OPX /GET OPERAND EXPONENT 016645 1044 TAD ACX /ADD FAC EXPONENT-GET SUM OF EXPS. 016646 3044 DCA ACX /STORE RESULT 016647 7405 MUY /MUL. HIGH ORDER FAC BY LOW ORD OP. 016650 0056 OPH /HIGH ORDER FAC WAS IN MQ 016651 7443 DAD /ADD IN RESULT OF SECOND MULTIPLY 016652 0052 AC0 016653 3045 DCA ACH /STORE HIGH ORDER RESULT 016654 1046 TAD ACL /GET HIGH ORDER FAC 016655 7521 SWP /SEND IT TO MQ AND LOW ORD. RESULT 016656 3052 DCA AC0 /OF ADD TO AC-STORE IT 016657 7004 RAL /ROTATE CARRY TO AC 016660 3046 DCA ACL /STORE AWAY 016661 7405 MUY /NOW DO PRODUCT OF HIGH ORDERS 016662 0057 OPL /FAC HIGH IN MQ, OP HIGH IN OPL 016663 7443 DAD /ADD IN THE ACCUMULATED # /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 132-1 016664 0045 ACH /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 133 /MULTIPLIES DONE - MASSAGE RESULT 016665 7450 SNA /ZERO? 016666 5303 JMP RTZRO /YES-GO ZERO EXPONENT 016667 7411 NMI /NO-NORMALIZE (1 SHIFT AT MOST!) 016670 3045 DCA ACH /STORE HIGH ORDER RESULT 016671 7641 CLA SCA /GET STEP CNTR-DID WE NEED A SHIFT? 016672 7650 SNA CLA 016673 5304 JMP SNCK /NO-JUST CHECK SIGN 016674 1052 TAD AC0 /YES - WATCH OUT FOR LOST ACCURACY! 016675 7004 RAL 016676 3052 DCA AC0 016677 7430 SZL /IF HIGH ORDER BIT OF OVERFLOW WORD WAS ON, 016700 7573 DPIC /TURN MQ11 ON (IT WAS 0 FROM THE NMI) 016701 7340 AC7777 /MUST DECREASE EXP. BY 1 016702 1044 TAD ACX 016703 3044 RTZRO, DCA ACX /STORE BACK 016704 1052 SNCK, TAD AC0 016705 7710 SPA CLA /IS HIGH ORDER OF OVERFLO WD. 1? 016706 7573 DPIC /YES-ADD 1 TO LOW ORDER-STILL IN MQ 016707 1045 TAD ACH 016710 7500 SMA 016711 5316 JMP EMDONE /WE DIDN'T OVERROUND - GOODY 016712 7417 LSR 016713 0001 1 /BUT OVERROUNDING IS EASILY CORRECTED! 016714 2044 ISZ ACX / (OVERCORRECTED??) 016715 7000 NOP /COMMON CLEANUP ROUTINE FOR MULTIPLY AND DIVIDE 016716 2336 EMDONE, ISZ EMSIGN /SHOULD SIGN BE MINUS? 016717 7410 SKP /NO 016720 7575 DCM /YES-DO IT 016721 7450 SNA 016722 3044 DCA ACX /FORCE EXPONENT 0 IF MANTISSA = 0 016723 3045 DCA ACH /STORE IT BACK 016724 7521 SWP 016725 3046 DCA ACL 016726 1021 TAD DFLG 016727 7740 SMA SZA CLA 016730 1044 TAD ACX /IF D.P. INTEGER MODE AND ACX LESS THAN 0, 016731 7450 SNA /GO TO UNNORMALIZE RESULT 016732 5477 JMP I FPNXT /OTHERWISE BUMP RETN. AND RETN. 016733 7040 CMA 016734 4774 JMS I (ACSR 016735 5477 JMP I FPNXT 016736 0000 EMSIGN, 0 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 134 /ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE 016737 0000 EMDSET, 0 016740 7344 AC7776 /MAKE A MINUS TWO 016741 3336 DCA EMSIGN /AND STORE IN EMSIGN. 016742 7663 DLD /GET HIGH ORDER MANTISSA OF OP. 016743 0056 OPH 016744 7521 SWP 016745 7500 SMA /NEGATIVE? 016746 5351 JMP .+3 /NO 016747 7575 DCM /YES-NEGATE IT 016750 2336 ISZ EMSIGN /BUMP SIGN COUNTER 016751 7413 SHL /SHIFT OPRND LEFT 1 TO AVOID OVRFLO 016752 0001 1 016753 7445 DST /STORE BACK-OPH CONTAINS LOW ORDER 016754 0056 OPH / OPL CONTAINS HIGH ORDER 016755 7663 DLD 016756 0045 ACH 016757 7521 SWP 016760 7500 SMA /FAC LESS THAN 0? 016761 5365 JMP .+4 /NO 016762 7575 DCM 016763 2336 ISZ EMSIGN 016764 7000 NOP /EMSIGN MAY BUMP TO 0 016765 7445 DST /STORE BACK - ACH CONTAINS LOW ORDER 016766 0045 ACH / ACL CONTAINS HIGH ORDER 016767 5737 JMP I EMDSET 016774 4452 016775 6457 016776 6451 016777 4437 7000 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 135 /FLOATING DIVIDE-BY-0 ROUTINE - MUST BE AT 0 IN PAGE 017000 2035 DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL 017001 4434 JMS I ERR 017002 0100 DV0MSG-ERRMSG 017003 1200 TAD DBAD 017004 3044 DCA ACX /SET AC TO A LARGE POSITIVE NUMBER 017005 7332 AC2000 017006 5777 JMP I (EMDONE /FLOATING DIVIDE 017007 4776 DDDIV, JMS I (DARGET 017010 7410 SKP 017011 4775 FFDIV, JMS I (ARGET 017012 4774 JMS I (EMDSET /GET ARG. AND SET UP SIGNS 017013 7407 DVI /DIVIDE-ACH AND ACL IN AC,MQ 017014 0057 OPL /THIS IS HI (!) ORDER DIVISOR 017015 7445 DST /QUOT TO AC0,REM TO AC1 017016 0052 AC0 017017 7630 SZL CLA /DIVIDE ERROR? 017020 5200 JMP DBAD /YES - HANDLE IT 017021 1055 TAD OPX /DO EXPONENT CALCULATION 017022 7041 CMA IAC /EXP. OF FAC - EXP. OF OP 017023 1044 TAD ACX 017024 3044 DCA ACX 017025 7451 DPSZ /IS QUOT = 0? 017026 7410 SKP /NO-GO ON 017027 3044 DCA ACX /YES-ZERO EXPONENT 017030 7405 DVLP, MUY /NO-THIS IS Q*OPL*2**-12 017031 0056 OPH 017032 7575 DCM /NEGATE IT 017033 1053 TAD AC1 /SEE IF GREATER THAN REMAINDER 017034 7420 SNL 017035 5255 JMP EDVOPS /YES-ADJUST FIRST DIVIDE 017036 7407 DVI /NO-DO Q*OPL*2**-12/OPH 017037 0057 OPL 017040 7630 SZL CLA /DIV ERROR? 017041 5200 JMP DBAD /YES 017042 1052 EDVLP1, TAD AC0 /NO-GET QUOT OF FIRST DIV. 017043 7500 SMA /NEGATIVE? 017044 5777 JMP I (EMDONE /NO-REMEMBER-QUOT OF 2ND DIV. IN MQ 017045 7417 LSR /YES-MUST SHIFT IT RIGHT 1 017046 0001 1 017047 2044 ISZ ACX /ADJUST EXPONENT 017050 7000 NOP 017051 6006 SGT /TEST SHIFTED OUT BIT 017052 5777 JMP I (EMDONE /ZERO - NO ROUND 017053 7573 DPIC /BUMP AC FRACTION 017054 5243 JMP EDVLP1+1 /MAYBE SHIFT AGAIN /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 136 /CONTINUATION OF DIVIDE ROUTINE /WE ARE ADJUSTING THE RESULT OF THE /FIRST DIVIDE. 017055 7041 EDVOPS, CMA IAC 017056 3053 DCA AC1 /ADJUST REMAINDER 017057 1057 TAD OPL /WATCH FOR OVERFLOW 017060 7141 CLL CMA IAC 017061 1053 TAD AC1 017062 7420 SNL 017063 5270 JMP EDVOP1 /DON'T ADJUST QUOT. 017064 3053 DCA AC1 017065 7340 AC7777 017066 1052 TAD AC0 017067 3052 DCA AC0 /REDUCE QUOT BY 1 017070 7300 EDVOP1, CLA CLL 017071 1053 TAD AC1 /GET REMAINDER 017072 7450 SNA /ZERO? 017073 7621 CAM /YES-ZERO EVERYTHING 017074 7407 DVI /NO 017075 0057 OPL 017076 7630 SZL CLA /DIV. OVERFLOW? 017077 5200 JMP DBAD /YES 017100 7575 DCM /NO-ADJUST HI QUOT (MAYBE) 017101 5242 JMP EDVLP1 /GO BACK /ROUTINE TO NORMALIZE THE FAC 017102 0000 EFFNOR, 0 017103 6201 CDF 0 017104 7663 DLD /PICK UP MANTISSA 017105 0045 ACH 017106 7521 SWP /PUT IT IN CORRECT ORDER 017107 7411 NMI /NORMALIZE IT 017110 7450 SNA /IS THE # ZERO? 017111 3044 DCA ACX /YES-INSURE ZERO EXPONENT 017112 3045 DCA ACH /STORE HIGH ORDER BACK 017113 7521 SWP /STORE LOW ORDER BACK 017114 3046 DCA ACL 017115 7641 CLA SCA /STEP COUNTER TO AC 017116 7041 CMA IAC /NEGATE IT 017117 1044 TAD ACX /AND ADJUST EXPONENT 017120 3044 DCA ACX 017121 5702 JMP I EFFNOR /RETURN 017122 0056 ADDRS, OPH 017123 0045 ACH 017124 0000 LPBUF5, ZBLOCK 44 017170 7336 LPBUF7 017174 6737 017175 6457 017176 6451 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 136-1 017177 6716 7200 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 137 /"OPNEG" MUST BE AT 0 IN PAGE 017200 0000 OPNEG, 0 /ROUTINE TO NEGATE OPERAND 017201 7663 DLD 017202 0056 OPH 017203 7521 SWP 017204 7575 DCM 017205 3056 DCA OPH 017206 7501 MQA 017207 3057 DCA OPL 017210 5600 JMP I OPNEG /FLOATING ADD AND SUBTRACT-IN ORDER NOT TO LOSE BITS, /WE DO NOT SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD- /ONLY SHIFTS DONE ARE TO ALIGN EXPONENTS. 017211 4777 FFSUB, JMS I (ARGET 017212 4200 JMS OPNEG /NEGATE OPERAND 017213 7410 SKP 017214 4777 FFADD, JMS I (ARGET /PICK UP ARGUMENTS 017215 1056 TAD OPH 017216 7650 SNA CLA /IF OPERAND IS 0, 017217 5477 JMP I FPNXT /RESULT IS ALREADY IN AC. 017220 1045 TAD ACH 017221 7640 SZA CLA /CHECK FOR AC=0 017222 5230 JMP BOTHN0 /NO 017223 7663 DLD 017224 0056 OPH /YES - ANSWER IS OPERAND 017225 7521 SWP 017226 3045 DCA ACH 017227 5323 JMP FADND /JUMP INTO CLEANUP CODE 017230 1055 BOTHN0, TAD OPX /PICK UP EXPONENT OF OPERAND 017231 7421 MQL /SEND IT TO MQ FOR SUBTRACT 017232 1044 TAD ACX /GET EXPONENT OF FAC 017233 7457 SAM /SUBTRACT-RESULT IN AC 017234 7510 SPA /NEGATIVE RESULT? 017235 7041 CMA IAC /YES-MAKE IT POSITIVE 017236 3271 DCA CNT /STORE IT AS A SHIFT COUNT 017237 1271 TAD CNT /COUNT TOO BIG?(CAN'T BE ALIGNED) 017240 1376 TAD (-27 017241 7750 SPA SNA CLA 017242 7340 AC7777 /NO-OK 017243 3052 DCA AC0 /YES-MAKE IT A LOAD OF LARGEST # 017244 7663 DLD /GET ADDRESSES TO SEE WHO'S SHIFTED 017245 7122 ADDRS 017246 6006 SGT /WHICH EXP GREATER(GT FLG SET /BY SUBTR. OF EXPS.) 017247 7521 SWP /OPERAND'S-SHIFT THE FAC 017250 3266 DCA SHFBG /STORE ADDRESS OF WHO GETS SHIFTED 017251 7521 SWP /GET ADDRESS OF OTHER (0 TO MQ) 017252 3257 DCA DADR /THIS ONE JUST GETS ADDED 017253 1044 TAD ACX /GET FAC EXP.INTO AC 017254 6006 SGT /WHICH EXPONENT WAS GREATER? /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 137-1 017255 3055 DCA OPX /FAC'S-STORE FINAL EXP. IN OPX /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 138 017256 7663 DLD /GET THE LARGER # TO AC,MQ 017257 0000 DADR, 0 017260 7521 SWP /PUT IN THE RIGHT ORDER 017261 2052 ISZ AC0 /COULD EXPONENTS BE ALIGNED? 017262 5316 JMP LOD /NO-JUST LEAVE LARGER IN AC,MQ 017263 7445 DST /YES-STORE THIS TEMPORARILY 017264 0052 AC0 /(IF ONLY FAC STORAGE WAS REVERSED) 017265 7663 DLD /GET THE SMALLER # 017266 0000 SHFBG, 0 017267 7521 SWP /PUT IT IN RIGHT ORDER 017270 7415 ASR /DO THE ALIGNMENT SHIFT 017271 0000 CNT, 0 017272 7443 DAD /ADD THE LARGER # 017273 0052 AC0 017274 7445 DST /STORE RESULT 017275 0052 AC0 017276 7430 SZL /OVERFLOW?(L NOT = SIGN BIT) 017277 7040 CMA /NOTE-WE DIDN'T SHIFT BOTH RIGHT 1 017300 7700 SMA CLA 017301 5307 JMP NOOV /NOPE 017302 7330 AC4000 /MAYBE-SEE IF 2 #S HAD SAME SIGN 017303 0045 AND ACH 017304 1056 TAD OPH 017305 7700 SMA CLA /SIGNS ALIKE? 017306 5330 JMP OVRFLO /YES-OVERFLOW 017307 7330 NOOV, AC4000 /NO-GET HIGH ORDER RESULT BACK 017310 1053 TAD AC1 /CHECK FOR 4000 0000 MANTISSA 017311 7451 DPSZ /IT WILL BE SET TO 0 BY NMI 017312 5315 JMP .+3 /OK-RESTORE NUMBER 017313 7332 AC2000 /GOT A 4000 0000-SET TO 6000 0000 017314 5333 JMP DOIT /AND INCREMENT EXPONENT 017315 1375 TAD (4000 /RESTORE NUMBER 017316 7411 LOD, NMI /NORMALIZE (LOW ORDER STILL IN MQ) 017317 3045 DCA ACH /STORE FINAL RESULT 017320 7441 SCA /GET SHIFT COUNTER(# OF NMI SHIFTS) 017321 7040 CMA /NEGATE IT 017322 7001 ADON, IAC 017323 1055 FADND, TAD OPX /AND ADJUST FINAL EXPONENT 017324 3044 DCA ACX 017325 7521 SWP /GET AND STORE LOW ORDER 017326 3046 DCA ACL 017327 5477 JMP I FPNXT /RETURN 017330 1053 OVRFLO, TAD AC1 /OVERFLOW-GET HIGH ORDER RESLT BACK 017331 7415 ASR /SHIFT IT RIGHT 1 017332 0001 1 017333 1375 DOIT, TAD (4000 /REVERSE SIGN BIT 017334 3045 DCA ACH /AND STORE 017335 5322 JMP ADON /DONE 017336 0000 LPBUF7, ZBLOCK 34 017372 6600 LPBUFR 017375 4000 017376 7751 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 138-1 017377 6457 7400 PAGE /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 139 7400 *7400 /RTS CLEANUP ROUTINE - SAVED WITH PG 17600 017400 3676 CLNUP, DCA I CFPTR /ENTER HERE ON ^C OR ERROR 017401 5220 TDEXFG, JMP CTMP /ENTER HERE ON "STOP" OR "CALL EXIT" 017402 1201 TAD TDEXFG /TDEXFG CONTAINS TOP MEM FIELD 017403 7106 CLL RTL /IF WE ARE ON AN IN-CORE TD8E CONFIGURATION 017404 7004 RAL 017405 1377 TAD (CDF 017406 3207 DCA TDGTDF 017407 7402 TDGTDF, HLT 017410 1724 TAD I TDPTR /MOVE THE TD8E ROUTINE 017411 6221 CDF 20 017412 3724 DCA I TDPTR /DOWN TO FIELD 2 017413 2324 ISZ TDPTR 017414 5207 JMP TDGTDF 017415 6201 CDF 0 017416 1376 TAD (6220 /CIF 20&7770 017417 4307 JMS TDSET /RESET THE F0 CDF'S TO POINT TO FIELD 2 017420 6201 CTMP, CDF 0 017421 1375 TAD (6213 017422 3774 DCA I (7605 017423 1373 TAD (5267 017424 3772 DCA I (7606 /RESTORE PAGE 7600 017425 7344 AC7776 017426 0771 AND I (OSJSWD 017427 7001 IAC 017430 3771 DCA I (OSJSWD /MARK 10000-11777 AS USELESS 017431 6041 TSF 017432 7410 SKP 017433 5240 JMP WTOVR 017434 2325 ISZ ZERO 017435 1770 TAD I (TOCHR /IF TTY IS NOT IDLE, 017436 7640 SZA CLA /DELAY LONG ENOUGH TO AVOID GARBLE. 017437 5220 JMP CTMP /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 140 017440 6211 WTOVR, CDF 10 017441 1676 CLOSLP, TAD I CFPTR 017442 7450 SNA /ANY MORE ENTRIES IN THE TENTATIVE 017443 5317 JMP GOAWAY /FILE TABLE? 017444 3220 DCA CTMP /YES - SAVE FILE LENGTH PTR 017445 6201 CDF 0 017446 1620 TAD I CTMP 017447 6211 CDF 10 017450 7450 SNA 017451 5302 JMP IGNORC /UNWRITTEN FILES AREN'T CLOSED 017452 3277 DCA FLEN 017453 4726 JMS I USR 017454 0010 10 /BRING USR IN 017455 1367 TAD (200 017456 3326 DCA USR /KEEP IT IN 017457 1366 TAD (HPLACE+1 017460 3270 DCA CHAND 017461 4726 JMS I USR 017462 0013 13 /RESET DEVICE HANDLER TABLE 017463 0000 0 /BUT NOT TENTATIVE FILES! 017464 2276 ISZ CFPTR 017465 1676 TAD I CFPTR /GET UNIT NUMBER 017466 4726 JMS I USR 017467 0001 1 017470 0000 CHAND, 0 /FETCH HANDLER 017471 5321 JMP CLSERR 017472 1676 TAD I CFPTR /GET UNIT AGAIN 017473 2276 ISZ CFPTR /BUMP PTR TO NAME 017474 4726 JMS I USR 017475 0004 C4, 4 017476 7600 CFPTR, 7600 /CLOSE THE FILE 017477 0000 FLEN, 0 017500 5321 JMP CLSERR 017501 7410 SKP 017502 7326 IGNORC, AC0002 017503 1276 TAD CFPTR 017504 1275 TAD C4 017505 3276 DCA CFPTR 017506 5241 JMP CLOSLP /LOOK FOR MORE 017507 0000 TDSET, 0 017510 3270 DCA CHAND /SAVE 62X0 X=RELOC FIELD 017511 1314 TAD K7635 /SEARCH START 017512 3344 DCA LOC 017513 5327 JMP MODLUP /GO MODIFY 017514 7635 K7635, 7635 017515 1570 M6210, -6210 017516 7710 M70, -70 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 141 017517 6203 GOAWAY, CDF CIF 0 017520 5774 JMP I (7605 /RETURN TO OS/8 AQAP 017521 4726 CLSERR, JMS I USR /"IMPOSSIBLE" ERROR - GIVE "USER ERROR 2" 017522 0007 CLS7, 7 017523 0002 2 /IT'S BETTER THAN HALTING 017524 7600 TDPTR, 7600 017525 0000 ZERO, 0 017526 7700 USR, 7700 017527 1744 MODLUP, TAD I LOC /LOOK FOR 62NX 017530 1315 TAD M6210 017531 7100 CLL 017532 1316 TAD M70 /CHECK IF RIGHT INSTRUCTION 017533 7630 SZL CLA 017534 5341 JMP NXTCCF /NO 017535 1744 TAD I LOC /GET X 017536 0322 AND CLS7 017537 1270 TAD CHAND /GET 62N 017540 3744 DCA I LOC /RESTORE MODIFIED 017541 2344 NXTCCF, ISZ LOC 017542 5327 JMP MODLUP /MORE 017543 5707 JMP I TDSET /ENDS AT 7777 017544 0000 LOC, 0 017566 5201 017567 0200 017570 0004 017571 7746 017572 7606 017573 5267 017574 7605 017575 6213 017576 6220 017577 6201 $$$-$$$-$$$ /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 142 ABORTO 1166 BACKLK 0573 COMMA 0671 DFERR 3566 ACH 0045 BACKPC 0574 CORCHK 3760 DFINE 3531 ACI 0070 BADFLD 0102 CORE 5260 DFIXUP 6462 ACINSG 7325 BAKCDF 0541 CORELP 5264 DFLG 0021 ACL 0046 BAKCIF 0540 COREND 3770 DFLTM2 6316 ACMDGT 5136 BAKLP 3734 CORHAN 0317 DFMSG 4706 ACS 7403 BAKRTN 3747 CORIN 0324 DFMT 6005 ACSR 4452 BAKTST 3726 CORLOC 5326 DFNEG 6535 ACX 0044 BAKWLP 3741 CORPNT 0334 DFSTM2 5737 AC0 0052 BASADR 0042 CORREC 7400 DFTMP 6124 AC0001 7324 BASCDF 6025 CORRET 5324 DFTMP2 6321 AC0002 7326 BASE 0200 COR70 5307 DGLOOP 2352 AC0003 7325 BASJMP 6143 COR706 5301 DGT 2526 AC0004 7307 BEEORC 0350 CO7400 5311 DGT1 6047 AC1 0053 BF 1127 CTCBCK 0305 DIDCPT 6517 AC2 0054 BFINCR 3432 CTCCTB 0501 DIGCNT 2077 AC2000 7332 BFMT 6006 CTCINH 0073 DIGFOP 6443 AC3777 7350 BIOPTR 0117 CTLBER 0353 DIGIT 2371 AC4000 7330 BKASCI 1656 CTLBMS 4725 DIGITS 2347 AC6000 7333 BKGTCH 1714 CTMP 7420 DIND 6447 AC7775 7346 BKLORD 1647 CTRLU 3114 DINENM 6421 AC7776 7344 BKNORD 1711 CTZLP 1522 DINER 6516 AC7777 7340 BKRLST 5335 C4 7475 DINESM 6407 ADDRHI 6111 BKRPTR 3751 C6203 5331 DINESW 6562 ADDRLO 6045 BKSPC 1600 C7777 5332 DINGCH 6473 ADDRS 7122 BLOCK 3343 D 0030 DINLOP 6417 ADDX 5722 BMPBLK 1623 DACSR 6327 DINMIN 6416 ADON 7322 BOTHN0 7230 DAD 7443 DIR 3320 ADR 0043 BPAGEI 6032 DADR 7257 DISMIS 0514 AD1 5762 BUFCDF 0112 DAERR 3474 DLD 7663 AD2 5764 BUFFER 3342 DAL1 6272 DLOP1 6331 AFMT 1264 BUFFLD 0111 DAMSG 4656 DLZERO 6125 AINPTC 1260 CALXIT 1312 DARGET 6451 DMPBUF 1512 AINPTL 1245 CAM 7621 DASTRS 6145 DNOLZR 6135 AINPTR 1255 CDIGIT 1203 DATABL 1734 DNOMAC 6140 AINPUT 1241 CFLAG 0031 DATAF 0032 DNUMLP 3226 ALN 6411 CFPTR 7476 DATCDF 0031 DNXT 6000 ALNSHL 6443 CHAND 7470 DBAD 7000 DOADD 7237 ALNXIT 6435 CHCH 0071 DBDLOP 6203 DOFMT 1063 AL1 4437 CHKG 2317 DBLDIG 6200 DOFRTN 1061 AL1BMP 6617 CHLOOP 1211 DBLQOT 1001 DOIT 7333 ANXT 1263 CHRCTR 0104 DCDIDX 6125 DOJMP 6275 AOTPUT 1271 CHRPTR 0103 DCD100 6141 DPFPP 2323 APT 0037 CHTYPE 1200 DCM 7575 DPIC 7573 ARGET 6457 CLFAC 5632 DDADD 6530 DPIN 6400 ARGET2 6465 CLNADR 1345 DDDIV 7007 DPRZRO 6267 ARGLD 1347 CLNUP 7400 DDGET 6542 DPSW 2525 ARGMSG 4600 CLOSLP 7441 DDIGIT 6523 DPSZ 7451 ASR 7415 CLREOL 1532 DDMPY 6625 DPTEST 5333 ASTRSK 2557 CLROFL 7366 DDPSW 6534 DRDCPT 6116 ASTSK1 2333 CLSERR 7521 DDPUT 6561 DSCLDN 6255 ASTSK3 2331 CLS7 7522 DDSUB 6525 DSCLIN 6426 ATLDMK 1455 CNDSKP 6273 DF 1125 DSCLUP 6035 ATX 5726 CNDSKT 6315 DFBUMP 6114 DSRN 4244 BACKAC 0572 CNT 7271 DFECMN 6513 DSRNUM 3243 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 142-1 DST 7445 ESCRET 3122 FMTERR 1133 FSTTMP 3755 DUMPIT 3537 EXDVNO 1346 FMTFLP 0615 FSTTM2 4563 DVELP 2276 EXIT 5617 FMTGAD 0703 FSUB 2000 DVI 7407 EXPFLD 2262 FMTGCH 0674 FTEMP 4566 DVLP 7030 E7605 5125 FMTHCR 1053 FTEMP2 0200 DVLP1 7070 FACR 7244 FMTHCV 1023 FULRET 3123 DVL1 7106 FADD 1000 FMTHIN 1032 FUNIT 3262 DVL2 7130 FADDM 5000 FMTIN 3000 FWTOBL 3364 DVL3 7105 FADD1 0114 FMTMSG 4622 FXFLTC 0011 DVOPS 7132 FADND 7323 FMTNUM 0072 F0HBEG 0000 DVOP1 7145 FADTMP 5145 FMTOUT 3200 F0HEND 3000 DVOP2 7150 FATAL 0035 FMTPDL 4377 F0HSAV 7000 DVTEMP 2161 FD 7126 FMTPER 1163 F0TO 4000 DV0MSG 4700 FDIV 3000 FMTPXR 0010 F212 3307 DV1 7052 FDIVLP 2163 FMTSET 0612 F214 3270 DV2 7042 FDIV10 3355 FMTTYP 0024 GADR 1302 DV24 7032 FETPC 4524 FMTWRD 1311 GBFLG 3613 EAC1 0047 FEXIT 0000 FMUL 4000 GETCH3 1720 EAC2 0050 FFADD 7214 FMULM 7000 GETFCD 3205 EAC3 0051 FFDIV 7011 FMUL10 3361 GETFIL 3200 EAEFIX 4407 FFGET 6534 FNORM 0004 GETHAN 3000 EAEKIL 2610 FFIX 4400 FPAUSE 3737 GETHND 2715 ECHO 3145 FFLAGS 0110 FPCOM 6553 GETION 3600 EDVLP1 7042 FFMPY 6627 FPC10 4530 GETLMN 0234 EDVOPS 7055 FFMT 2014 FPDVER 5716 GFLG 0062 EDVOP1 7070 FFNEG 4475 FPEP 6567 GFMT 2006 EEGET 4540 FFNOR 7300 FPGCDF 5602 GH 3074 EEINST 4551 FFNORR 7323 FPGO 5601 GHADR 3111 EELOOP 4547 FFPUT 6553 FPHALT 3737 GHEXIT 3015 EEPUT 4537 FFSUB 7211 FPHLT 6554 GMADR 3650 EFFNOR 7102 FGPBF 0116 FPICL 6552 GOAWAY 7517 EFLG 0063 FHRGHT 1047 FPINT 6551 GOTCHR 3036 EFMT 2010 FILERR 3512 FPJAC 5706 GTNMPT 5106 EFXFLT 5247 FILMSG 5435 FPLDX 5716 GT1 2052 EMDONE 6716 FIXBIG 4424 FPNXT 0077 HADR 0020 EMDSET 6737 FIXDNE 4422 FPOERR 0742 HAND 0100 EMSIGN 6736 FIXEAE 4407 FPOMSG 4612 HANG 0524 ENDFL 1467 FIXISZ 4420 FPOVER 5731 HCDF 2471 ENDFLS 1510 FIXLP 4414 FPOVUN 5725 HCDF0 2744 ENDIO 1502 FIXSH 4415 FPPER 5710 HCIDF0 0532 ENDREC 1135 FIXUPE 2515 FPPERR 3740 HCODEW 0101 ENDUIO 3450 FIX0 4416 FPPINT 5600 HCW 2762 EOFERR 4741 FJCTCT 0246 FPPKG 6600 HCWORD 0022 EOLCTR 3154 FLDA 0000 FPPMSG 4666 HCWPTR 3154 EOLINE 2700 FLDTM2 1361 FPPRTN 5702 HCWTBA 3130 EOLSW 0025 FLEN 7477 FPREST 5615 HCWTBL 2100 EOMSG 3703 FLTG85 4771 FPRST 6556 HDIFF 0030 EOOUTL 2711 FMINUS 1157 FPST 6555 HFMT 1020 ERPTLP 5027 FMPBYT 0762 FPSTRT 4002 HGHADR 0026 ERR 0034 FMTADR 0673 FPTR 3261 HGHFLD 0025 ERRENB 5035 FMTBYT 0060 FPUHNG 0411 HINF0 2753 ERRFLG 4752 FMTCLP 0620 FPXTA 5626 HKEY 2761 ERRMSG 4600 FMTDF 0723 FRMFLD 2542 HLDADR 0024 ERROR 5011 FMTDIG 0724 FSAVPC 5734 HLOOP 2456 ESCAP 3130 FMTDLP 0617 FSTA 6000 HLTNOP 4035 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 142-2 HMCT 2522 IOVFLO 3334 LONG 0400 NMI 7411 HNDCDF 2742 IOVMSG 4715 LONGI 6055 NOCD 2206 HNDERR 2553 ISN 5104 LOP1 4455 NODPMS 5510 HNGCDF 0564 ITSIN 3735 LOP2 7260 NOFPP 2647 HPLACE 5200 JA 1030 LPAREN 0732 NOINDX 6106 HPTR1 2520 JAC 0007 LPBUFR 6600 NOLF 3247 HPTR2 2521 JMPDIS 0421 LPBUF3 7161 NOLI 5412 HTOP 3153 JMPOTX 1225 LPBUF4 7331 NOLZRO 2251 H1 3007 JMPOUT 1222 LPBUF5 7124 NOMOAC 2254 H7600 2607 JMPTB1 6144 LPBUF7 7336 NONAME 3321 H7700 1025 JNE 1040 LPGET 0003 NONMSG 5424 ICDF0 1561 JSA 5644 LPPUT 0270 NONUM 3507 ICYCLE 6001 JSAR 5657 LPT 0236 NOOV 7307 IDIGIT 2443 JSCDF 5666 LPTERR 0511 NORMLP 7310 IFLG 0061 JSR 5676 LPTEST 0415 NORMX 5770 IFMT 2000 JUMPS 6251 LPTLCF 0417 NOTDSY 2712 IGEF 2013 JXN 6307 LPTSNA 0240 NOTG 2534 IGEFIN 2400 KBD 0335 LPTTWT 1327 NOTI 2544 IGEFOP 2477 KBDCHR 0005 LPUHNG 0437 NOTINH 0566 IGNORC 7502 KBDRTS 0300 LSE 6663 NOTLDD 3070 IHTBL 3515 KBM203 0314 LSF 6661 NOTLI 2324 IMFUDJ 6023 KBUHNG 0473 LSR 7417 NOTLPT 0441 INBUFR 4000 KILFPP 0346 LTTY 3712 NOTMN 5126 INCRET 3120 KLUDGM 5757 LZLOOP 2241 NOTTTY 0453 IND 0600 KWODEL 1055 L1 6362 NOT1ST 3242 INDCPT 2437 KWOTE 1000 MAKCDF 4755 NPLCS 2170 INDDOF 0623 KWOTLP 1005 MASBMP 1634 NRMFAC 5637 INDEX 6065 K7635 7514 MASICM 3164 NXTCCF 7541 INE 2503 LARGER 4743 MASOCM 3261 OADD 4506 INEMSG 4673 LCF 6662 MASOUT 3253 OBLNKS 2337 INEOF 4727 LDDSRN 1534 MASSIN 3155 OCHAR 3360 INEOL 3012 LDIOER 2327 MASSIO 3311 OD 0064 INEONM 2456 LDPROG 4033 MCDF 0036 OFLMSG 4720 INER 2435 LDX 0100 MDONE 6665 ONE 2171 INERSM 2407 LEV 6731 MDSET 6704 ONLY8K 2726 INESW 2567 LFMT 2642 MINFLG 1162 OPERAT 6241 INGCH 2414 LFPLCH 3233 MINUS5 1122 OPH 0056 INITMV 1560 LHDR 2222 MODLUP 7527 OPINSG 7253 INLOOP 2454 LIBLK 2223 MORE 1056 OPJCLL 6030 INLORD 3161 LICD 2203 MOVCOR 2400 OPJMP 6031 INMINS 2453 LIE 6665 MOVE 2523 OPL 0057 INMSG 4637 LIF 6667 MOVEAE 3433 OPM 5761 INPUTC 3132 LINFLS 2632 MPLP 6744 OPMEM 5735 INST 0022 LINGCH 2617 MPLP1 6745 OPNEG 7200 INTAB 3062 LINLP 2637 MPLP2 6756 OPSR 7255 INTAC 0522 LINTRU 2631 MP12L 7060 OPX 0055 INTHND 3324 LIOEMS 5500 MP24 6734 OSCALE 2126 INTLNK 0523 LKPNTR 3260 MSIGN 6733 OSJSWD 7746 INTMP 3136 LLS 6666 MUY 7405 OSUBR 3272 INTRPT 0400 LNXT 2641 MVC 2552 OS8DAT 7666 INXR 0011 LOADLP 3656 MXFLD 0023 OS8DCB 7760 IOCTL 3341 LOADOV 3671 M6210 7515 OS8DVT 7647 IOERR 3346 LOC 7544 M70 7516 OS8RTN 2513 IOMSG 4651 LOD 7316 N 0026 OS8SWS 7643 IONTBL 2000 LOGUNT 0074 NEGFAC 6000 OULORD 3263 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 142-3 OUTFF 3240 RPAREN 0763 STRTE 6477 UDOIO 3504 OUTLF 3237 RPLOOP 0757 STRTF 6511 UDOIOL 3515 OUTNUM 2200 RSETBP 3413 STRTUP 3742 UERR 4747 OUT2LF 3231 RSTHND 3635 STSWAP 4044 UGO 3125 OVADLP 3645 RSTMOV 3645 SVHND 3622 UIOVLP 3440 OVADR 3720 RTINIT 2600 SVMOVE 3630 UMSG 4604 OVBLK 3721 RTSLDR 2200 SWAB 7431 UNFIO 3403 OVERR 3722 RTZRO 6703 SWAP 3600 UNHANG 0571 OVHCDW 3746 RUBOUT 3070 SYSERR 2515 UNIT 0021 OVHND 3745 RUBPAT 3521 SYSMSG 5443 UNPKLN 3013 OVIOW 3717 RWASCI 0600 SZLCLA 3565 UNTERR 1415 OVLEN 3744 RWDACC 3455 T 0020 UNTMSG 4631 OVLYTB 4204 RWFLAG 0023 TADACX 4402 UP1LEV 5120 OVMSG 4645 RWIND 1447 TDEXFG 7401 USEE 2075 OVRELP 2254 RWINIT 1400 TDGTDF 7407 USR 7526 OVRFLO 7330 RWUNF 3400 TDPTR 7524 USRERR 4745 OW 2125 SAM 7457 TDSET 7507 VARGER 0205 OXCOMN 6236 SAVAPT 5735 TD8EFG 2705 VBACKG 0227 PATRUB 3076 SAVPC 5624 TD8EFL 2703 VBAK 0210 PC 0040 SCA 7441 TEN 4763 VBOTHN 0122 PCCDF 4534 SCALDN 2546 TESMAX 2717 VDATE 0203 PDPXIT 1334 SCALE 0065 TFMT 2660 VDEF 0213 PFACT 0066 SCALIN 2463 TFMTIN 2600 VDISMS 0412 PFACTX 0067 SCALUP 2041 TFPTR 3312 VENDF 0211 PFMT 1147 SEQCHK 3526 TFTABL 2114 VEOFSW 0016 PRDCPT 2227 SETB 4432 THREE 5116 VEXIT 0223 PRNTXP 2305 SETTOT 1477 TOCHR 0004 VHANG 0524 PRTNAM 5034 SETTTY 2733 TOFLD 2544 VINT 0403 PRTNML 5047 SETX 6244 TOMNYH 5467 VMAXCR 0121 PRZERO 2326 SHFBG 7266 TOOBIG 2511 VRDAO 0217 PTLNLP 5062 SHL 7413 TOOMCH 5455 VREADO 0221 PTTY 0075 SHR1 7111 TOTBLK 0107 VRENDO 0206 PUTM 5763 SINT 6254 TPBLNK 2676 VRETRN 0235 QDPFLG 5206 SKPOUT 1230 TPFLG 3155 VREW 0212 QHGHAD 5203 SKPSHT 2062 TPPLBL 2614 VRFSV 0207 QLHDR 5200 SKPZRO 6061 TRAP 5652 VRUO 0215 QRTSWP 5201 SLASH 1144 TRAP3 3000 VSWAP 0222 QSINH 0007 SNCK 6704 TRAP3I 6400 VTOPBF 0124 QSUHNG 0500 SPCATX 5714 TRAP4I 6400 VUERR 0204 QUSRLV 5207 SPCCDF 5625 TRAP5I 3737 VVERS 0015 QVERNO 5205 SPCJMP 6213 TRAP6I 3737 VWDAO 0216 RD2WR 5000 SPECAL 6200 TRAP7I 3737 VWRITO 0220 READLN 3015 SPECOP 6333 TRCBAK 5102 VWUO 0214 READLP 3031 SPMDCD 3454 TRPCIF 5676 V8OR12 0225 RECCTR 3454 SPSTRT 3156 TRPPRT 4753 W 0027 RECOVR 3747 SP2 6352 TRYFLD 5330 WTOVR 7440 RELBLK 0106 STARTD 0006 TSTALN 6325 XFMT 2610 RELP 3670 STARTE 0050 TSTSWS 3400 XFMTIN 2606 RESHAN 3031 STARTF 0005 TTM17 0006 XITISZ 1325 RESHND 3660 STBLK 0105 TTQS 0474 XJCOMN 6232 RESTRT 0544 STDSRN 3265 TTUHNG 0452 XPATCH 0301 RETURN 5600 STEFLG 5736 TTY 0271 XPUSER 0301 RICDF0 2650 STJUMP 4052 TTYFLG 3153 XR 0012 RLERR 3662 STOHDF 2727 TTYLF 3026 XRADLP 6077 RLTMP 0027 STRTD 6510 TTYRET 0315 XRBASE 0041 /FORTRAN IV FRTS LOADER V50 PAL8-V50X 10-APR-92 PAGE 142-4 XRCDF 6131 XRINST 6214 XR1 0013 XTA 0030 XVERMS 5520 XVERSN 0062 XV1 0005 XV2 0062 XXERR 4056 XXJMS 4055 XX215 4054 X0 0010 X1 0011 X2 0012 X3 0013 YFJMP 6306 YFPP1 5631 YFPP2 5632 YFPP3 5635 YHIOF 2756 YLPT 0242 YRCOVR 3751 YTTY 0272 ZERO 7525 ZEXP 7322 Z7700 1530 ERRORS DETECTED: 0 LINKS GENERATED: 0