X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Ff4%2FFRTSRC%2Frts.pa;fp=sw%2Ff4%2FFRTSRC%2Frts.pa;h=7fd43cf7b5e5edbc7b12ed191ae215c877c18a24;hb=7af5ad59491ddf2066641aef1e0025a337c0f247;hp=0000000000000000000000000000000000000000;hpb=919757fd611e482003ce51f366f6783cab73dea3;p=pdp8.git diff --git a/sw/f4/FRTSRC/rts.pa b/sw/f4/FRTSRC/rts.pa new file mode 100644 index 0000000..7fd43cf --- /dev/null +++ b/sw/f4/FRTSRC/rts.pa @@ -0,0 +1,3789 @@ +/FORTRAN IV RUNTIME SYSTEM, V5A +/ +/ +/ +/ +/ +/ +/ +// +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1975 +/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. +/ +/ +/ +/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A +/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- +/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER +/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE +/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO +/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE +/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. +/ +/ +/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT +/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL +/EQUIPMRNT COROPATION. +/ +/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS +/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. +/ +/ +/ +/ +/ +/ + /FORTRAN 4 RUNTIME SYSTEM - R.LARY +/AND NOW WITH DOUBLE PRECISION! - MKH +/RTS-8 SUPPORT ADDED 5/20/74 - RL +/LAST EDITED 5/19/74 + +XVERSN=5 /UPDATE WITH EVERY RELEASE! +XPATCH="A /PATCH LEVEL A + +/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. +/ +/ +/ 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 + /DEFINITIONS: + +AC7775= STA CLL RTL +AC7776= STA CLL RAL +AC4000= CLA STL RAR +AC3777= STA CLL RAR +AC2000= CLA STL RTR +AC0002= CLA STL RTL + +/DEFINITIONS OF KE-8/E INSTRUCTIONS + +MQL= 7421 +MQA= 7501 +CAM= CLA MQL +SWP= MQA MQL +SWAB= 7431 +SCA= 7441 +MUY= 7405 +DVI= 7407 +NMI= 7411 +SHL= 7413 +ASR= 7415 +LSR= 7417 +ACS= 7403 +SAM= 7457 +DAD= 7443 +DLD= 7663 +DST= 7445 +DPIC= 7573 +DCM= 7575 +DPSZ= 7451 +SGT= 6006 + +/DEFINITIONS OF FPP IOT'S + +FPINT= 6551 +FPICL= 6552 +FPCOM= 6553 +FPHLT= 6554 +FPST= 6555 +FPRST= 6556 + /FPP OPCODES: + +FLDA= 0000 +FADD= 1000 +FSUB= 2000 +FDIV= 3000 +FMUL= 4000 +FADDM= 5000 +FSTA= 6000 +FMULM= 7000 + LONG= 400 /TWO-WORD ADDRESSING + BASE= 200 /BASEPAGE ADDRESSING + IND= 600 /INDIRECT ADDRESSING + +FEXIT= 0000 +FNORM= 0004 +STARTF= 0005 +STARTD= 0006 +JAC= 0007 +XTA= 0030 +STARTE= 0050 +LDX= 0100 + +JA= 1030 +JNE= 1040 +TRAP3= 3000 + +/OS8 EQUIVALENCES: + +OS8SWS= 7643 +OSJSWD= 7746 +OS8DVT= 7647 +OS8DCB= 7760 +OS8DAT= 7666 + +/VARIOUS OTHER IOT'S: + +LSF= 6661 +LCF= 6662 +LSE= 6663 +LIE= 6665 +LLS= 6666 +LIF= 6667 + /PAGE ZERO FOR FORTRAN IV RTS + + *0 /INTERRUPT STUFF + 0 + JMP I .+1 + INTRPT +LPGET, LPBUFR /LINE PRINTER RING BUFFER FETCH POINTER +TOCHR, 0 /TELETYPE STATUS WORD +KBDCHR, 0 /KEYBOARD INPUT CHARACTER +POCHR, 0 /P.T. PUNCH COMPLETION FLAG +RDRCHR, 0 /P.T. READER STATUS +FMTPXR, 0 /XR USED TO INDEX FORMAT PARENTHESIS ARRAY +INXR, INBUFR-1 /XR USED TO GET CHARS FROM INPUT LINE +XR, 0 +XR1, 0 + +*16 +VEOFSW, 0 /USED BY "EOFCHK" TO STORE VARIABLE ADDRESS + 0 /*K* MUST BE IN AUTO - XR +T, 0 /TEMPORARY +DFLG, 0 /0 = F.P., 1 = D.P. +INST, 0 /CURRENT INSTRUCTION WORD + +/IOH PAGE ZERO LOCATIONS + +RWFLAG, 0 /READ/WRITE FLAG +FMTTYP, 0 /TYPE OF CONVERSION BEING DONE +EOLSW, 0 /EOL SW ON INPUT - CHAR POS ON OUTPUT +N, 0 /REPEAT FACTOR +W, 0 /FIELD WIDTH +D, 0 /NUMBER OF PLACES AFTER DECIMAL POINT + +DATCDF, 0 /SUBROUTINE TO CHANGE DATA FIELD +DATAF, 0 /CONTAINS VARIOUS CDF'S + JMP I DATCDF /RETURN + +ERR, ERROR /POINTER TO ERROR ROUTINE +FATAL, 0 /FATAL ERROR FLAG - 0=FATAL +MCDF, MAKCDF + +/FPP PARAMETER TABLE LOCATIONS: + +APT, 0 /VARIOUS FIELD BITS FOR FPP +PC, DPTEST /FPP PROGRAM COUNTER +XRBASE, 0 /FPP INDEX REGISTER ARRAY ADDRESS +BASADR, 0 /FPP BASE PAGE ADDRESS +ADR, 0 /ADDRESS TEMPORARY +ACX, 0 +ACH, 0 /*** FLOATING ACCUMULATOR *** +ACL, 0 +EAC1, 0 +EAC2, 0 /** FOR EXTENDED PRECISION OPTION ** +EAC3, 0 + /FLOATING POINT PACKAGE LOCATIONS + +AC0, 0 +AC1, 0 /FLOATING AC OVERFLOW WORD +AC2, 0 /OPERAND OVFLOW WORD +OPX, 0 +OPH, 0 /*** FLOATING OPERAND REGISTER *** +OPL, 0 + +/RTS I/O CONVERSION SYSTEM LOCATIONS + +FMTBYT, 0 /FORMAT BYTE POINTER +IFLG, 0 /I FOEMAT FLAG +GFLG, 0 /G FORMAT FLAG +EFLG, 0 /E FORMAT FLAG - SOMETIMES ON FOR G FMT +OD, 0 +SCALE, 0 +PFACT, 0 /P-SCALE FACTOR +PFACTX, 0 /TEMP FOR PFACT +ACI, 0 /INTEGERIZED FAC FROM "FFIX" SUBR +CHCH, 0 +FMTNUM, 0 /CONTAINS ACCUMULATED NUMERIC VALUE +CTCINH, 0 /^C INHIBIT FLAG +LOGUNT, 0 /DSRN POINTER - ONLY USED FROM ONE PAGE! +PTTY, TTY /POINTER TO TTY HANDLER - USED BY LDDSRN + 0 / SO FORMS CONTROL WILL WORK ON UNIT 0 +FPNXT, ICYCLE /USED AS INTERPRETER ADDRESS IF NO FPP + +/DSRN IMAGE + +HAND, 0 /HANDLER ENTRY POINT +HCODEW, 0 /HANDLER LOAD ADDR & FIELD + IOFFLG + FORMS CTL FLG +BADFLD, 0 /BUFFER ADDRESS AND FIELD +CHRPTR, 0 /ACTUALLY A WORD POINTER +CHRCTR, 0 /COUNTER - RANGES FROM -3 TO -1 +STBLK, 0 /STARTING BLOCK OF FILE +RELBLK, 0 /CURRENT RELATIVE BLOCK NUMBER +TOTBLK, 0 /LENGTH OF FILE +FFLAGS, 0 /FILE FLAGS: + /BIT 0 - "HAS BEEN WRITTEN" FLAG + /BITS 1-2 - FORMATTED/UNFORMATTED FLAGS + /BIT 11 - "END-FILED" FLAG + +BUFFLD, 0 /ROUTINE TO SET DF TO BUFFER FIELD +BUFCDF, HLT + JMP I BUFFLD + +FADD1, FADD+LONG /FPP CODE TO ADD 1.0 TO FAC + ONE /AND FALL INTO STORE CODE +FGPBF, 0 /THESE THREE WORDS ARE USED +BIOPTR, 0 /TO FETCH AND STORE FLOATING POINT NUMBERS + FEXIT /FROM RANDOM MEMORY + PAGE + /STARTUP CODE + +FTEMP2, ISZ .+3 /ALSO USED AS I/O F.P. TEMPORARY + CDF CIF 10 + JMP I .+1 +VDATE, RTSLDR /USED TO STORE OS/8 DATE + +/RTS ENTRY POINTS - "VERSION INDEPENDENT" + +VUERR, JMP I (USRERR /USER ERROR + /** LOADER MUST DEFINE #ARGER AS VARGER-1 ** +VARGER, JMS I ERR /LIBRARY ARGUMENT ERROR +VRENDO, ISZ RWFLAG /END OF I/O LIST +VRFSV, JMP I GETLMN /I/O LIST ARG ENTRY - COROUTINE WITH GETLMN +VBAK, JMP I (BKSPC /"BACKSPACE" ROUTINE +VENDF, JMP I (ENDFL /"END FILE" ROUTINE +VREW, JMP I (RWIND /"REWIND" ROUTINE +VDEF, JMP I (DFINE /"DEFINE FILE" ROUTINE +VWUO, AC4000 /UNFORMATTED WRITE +VRUO, JMP I (RWUNF /UNFORMATTED READ +VWDAO, AC4000 /DIRECT ACCESS WRITE +VRDAO, JMP I (RWDACC /DIRECT ACCESS READ +VWRITO, AC4000 /FORMATTED (ASCII) WRITE +VREADO, JMP I (RWASCI /FORMATTED (ASCII) READ +VSWAP, JMP I (SWAP /OVERLAY PROCESSOR +VEXIT, TRAP3; CALXIT /"STOP" ROUTINE - ENTERED IN FPP MODE +V8OR12, 0;0 /0;1 IF CPU IS A PDP-12 +VBACKG, JMP I (NULLJB /BACKGROUND JOB DISPATCHER + 0 + CDF CIF 0 /USED BY ROUTINE "ONQB" IN LIBRARY + JMS I .-2 + 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. + +GETLMN, 0 +VRETRN, JMP I [RETURN /SHORT ROUTINE FOR ALL THOSE COMMENTS, NO? + /INTERRUPT DRIVEN I/O HANDLERS + +LPT, 0 /RING-BUFFERED - LP08 OR LS8E + AND [377 /JUST IN CASE +LPTSNA, SNA + JMP I (IOERR /CANNOT BE USED FOR INPUT +YLPT, IOF + DCA I LPPUT + TAD LPGET + CIA + TAD LPPUT + SZA CLA /IS LPT QUIET? + JMP .+3 /NO + TAD I LPPUT + LLS /YES - START 'ER UP + CLA IAC + LIE /ENABLE LPT INTERRUPTS + TAD LPPUT /1 IN AC, REMEMBER? + DCA LPPUT + TAD I LPPUT + SPA + JMP .-3 /NEGATIVE NUMBERS ARE BUFFER LINKS + SZA CLA /ANY ROOM LEFT IN BUFFER? + JMS I (HANG + LPUHNG /WAIT FOR LINE PRINTER + ION /TURN INTERRUPTS BACK ON + JMP I LPT /RETURN + +LPPUT, LPBUFR + +PTP, 0 /PAPER TAPE PUNCH HANDLER +YPTP, SNA + JMP I (IOERR /INPUT IS ERROR + DCA LPT /SAVE CHAR + IOF + TAD POCHR /IF PUNCH IS NOT IDLE, + SZA CLA /WE DISMISS JOB + JMS I (HANG + PPUHNG /WAIT FOR PUNCH INTERRUPT + TAD LPT + PLS /OUTPUT CHAR + DCA POCHR /SET FLAG NON-ZERO + ION + JMP I PTP + +/*K* THE FOLLOWING ADDRESSES GET FALLEN INTO & MUST BE SMALL + + IFNZRO PPUHNG&7000 <__ERROR__> + IFNZRO TTUHNG&7000 <__ERROR__> + IFNZRO KBUHNG&7000 <__ERROR__> + IFNZRO RDUHNG&7000 <__ERROR__> + IFNZRO LPUHNG&7000 <__ERROR__> + /INTERRUPT-DRIVEN PTR AND TELETYPE HANDLER + +PTR, 0 /CRUDE READER HANDLER +YPTR, SZA CLA + JMP I (IOERR /OUTPUT ILLEGAL TO PTR + IOF + RFC /START READER + JMS I (HANG + RDUHNG /HANG UNTIL COMPLETE + TAD RDRCHR /GET CHARACTER + ION + JMP I PTR /RETURN + +TTY, 0 /BUFFERS 2 CHARS ON OUTPUT, 1 ON INPUT +YTTY, IOF /DELICATE CODE AHEAD + SNA /INPUT OR OUTPUT? + JMP KBD /INPUT + DCA LPT /OUTPUT - SAVE CHAR + TAD TOCHR /GET TTY STATUS + SMA SZA CLA /G.T. 0 MEANS A CHAR IS BACKED UP + JMS I (HANG + TTUHNG /WAIT FOR LOG JAM TO CLEAR + TAD TOCHR /NO CHAR BACKED UP - SEE IF TTY BUSY + CLL RAL /"BUSY" FLAG IN LINK - INTERRUPTS ARE OFF! + CLA CML RAR /COMPLEMENT OF BUSY IN SIGN + TAD LPT /GET CHAR + SPA /IF TTY NOT BUSY, + TLS /OUTPUT CHAR + DCA TOCHR /STORE POS OR NEG, BACKED UP OR BUSY +TTYRET, ION /TURN INTERRUPTS BACK ON + JMP I TTY /AND LEAVE + KBD, TAD KBDCHR /HAS A CHARACTER BEEN INPUT? + SNA CLA + JMS I (HANG + KBUHNG /NO - RUN BACKGROUND UNTIL ONE IS + TAD KBDCHR /GET CHARACTER + DCA LPT + DCA KBDCHR /CHEAR CHARACTER BUFFER + TAD LPT + JMP TTYRET /RETURN WITH INTERRUPTS ON + +KILFPP, FPHLT /BRING FPP TO A SCREECHING HALT + ISZ .-1 + JMP .-1 /WAIT FOR IT TO STOP + FPICL /CLEAN UP MESS HALT HAS MADE IN FPP +BEEORC, SZL /^C OR ^B? + JMP I (7600 /^C - HIYO SILVER, AWAY! + KCC /CLEAR KBD FLAG ON ^B +CTLBER, JMS I ERR /*** THIS MAY BE DANGEROUS! ** + PAGE + /INTERRUPT SERVICE ROUTINES + +INTRPT, DCA INTAC + RAR + DCA INTLNK +VINT, JMP .+4 /** MUST BE AT 403 ** + IFNZRO VINT-403 <___ CHANGE LOADER!!!> + 0 + CDF CIF 0 /USER INTERRUPT ROUTINE GOES HERE + JMS I .-2 + + FPINT /CHECK FOR FPP DONE + JMP LPTEST +FPUHNG, JMP DISMIS /ALWAYS GOES TO RESTRT + +VDISMS, JMP DISMIS /FOR USE BY USERS + JMP DISMIS + JMP DISMIS + +LPTEST, LSF + JMP NOTLPT +LPTLCF, LCF /CLEAR FLAG + TAD I LPGET + SNA CLA /CHECK FOR SPURIOUS INTERRUPT +JMPDIS, JMP DISMIS /GO AWAY IF SO + DCA I LPGET /ZERO CHAR JUST OUTPUT + ISZ LPGET + TAD I LPGET + SPA + DCA LPGET /TAKE CARE OF BUFFER LINKS + SNA + TAD I LPGET /MAKE SURE CHAR IS IN AC + SZA /IS THERE A CHARACTER? + LLS /YES - PRINT IT + CLA + LSF /CHECK FOR IMMEDIATE FLAG +LPUHNG, JMP DISMIS /NO - MAYBE RESTART PROGRAM + JMP LPTLCF /YES - LOOP + +NOTLPT, TSF /CHECK TTY + JMP NOTTTY + TCF /CLEAR FLAG + TAD TOCHR /GET TTY STATUS + SMA SZA /IF THERE IS A CHARACTER WAITING, + TLS /OUTPUT IT. + SMA SZA CLA /CHANGE "WAITING" TO "BUSY", + STL RAR /"BUSY" TO "IDLE". + DCA TOCHR +TTUHNG, JMP DISMIS + /KBD AND PTP INTERRUPTS + +NOTTTY, KSF + JMP NOTKBD + TAD [200 + KRS /USE KRS TO FORCE PARITY BIT + DCA KBDCHR /AND ALSO SO THAT ^C WILL STILL BE IN BUFFER IN OS/8 + TAD KBDCHR + TAD (-202 /CHECK FOR ^C OR ^B + CLL RAR + SNA CLA + JMP CTCCTB /YUP - TAKE SOME DRASTIC ACTION + KCC /DATA CHARACTER - CLEAR FLAG +KBUHNG, JMP DISMIS + +CTCCTB, TAD CTCINH + SNA CLA /ARE WE IN A HANDLER? + JMP NOTINH /NO + TAD INTLNK + CLL RAL /YES - RETURN WITH INTERRUPTS OFF + TAD INTAC /TRUST IN GOD AND RTS + RMF + JMP I 0 + +NOTKBD, PSF + JMP NOTPTP + PCF /P.T. PUNCH INTERRUPT - CLEAR FLAG + DCA POCHR /CLEAR SOFTWARE FLAG +PPUHNG, JMP DISMIS + +NOTPTP, RSF + JMP LPTERR + TAD [200 + RRB /GET RDR CHAR + DCA RDRCHR +RDUHNG, JMP DISMIS + +LPTERR, LSE /TEST FOR LP08 ERROR FLAG + SKP + LIF /DISABLE LP08 INTERRUPTS IF ERROR FLAG ON +DISMIS, TAD INTLNK + CLL RAL + TAD INTAC /RESTORE AC AND LINK + RMF + ION + JMP I 0 /RETURN FROM THE INTERRUPT + +INTAC, 0 +INTLNK, 0 + /BACKGROUND INITIATE/TERMINATE ROUTINE + +HANG, 0 /ALWAYS CALLED WITH INTERRUPTS OFF! + TAD I HANG /GET POINTER TO UNHANGING LOCATION + DCA UNHANG + RDF /GET FIELD CALLED FROM + TAD HCIDF0 + DCA HNGCDF /SAVE FOR RETURN +HCIDF0, CDF CIF 0 + TAD (JMP RESTRT /CHANGE THE "JMP DISMIS" AT THAT LOC + DCA I UNHANG /TO A "JMP RESTRT" + TAD BACKLK + CLL RAL + TAD BACKAC /SET UP BACKGROUND AC AND LINK +BAKCIF, CIF 0 +BAKCDF, CDF 0 + ION + JMP I BACKPC /INITIATE BACKGROUND + +/ COME HERE WHEN THE HANG CONDITION HAS GONE AWAY + +RESTRT, TAD JMPDIS /RESTORE THE UNHANG LOCATION + DCA I UNHANG + TAD INTAC /SUSPEND THE BACKGROUND + DCA BACKAC + TAD INTLNK + DCA BACKLK + TAD 0 + DCA BACKPC + RIB + AND [70 + TAD HCIDF0 + DCA BAKCIF + RIB + JMS I MCDF /*K* OK SINCE BACKGROUND DOESN'T USE MAKCDF + DCA BAKCDF + ISZ HANG +HNGCDF, HLT + JMP I HANG /INTERRUPTS ARE OFF - RETURN + +NOTINH, TAD JMPDIS /IN CASE WE WERE HUNG, WE DON'T WANT + DCA I UNHANG /TO GET "UNHUNG" OUT OF THE ERROR ROUTINE! + JMP I (KILFPP /KILL FPP AND GO TO EXIT OR ERROR + +UNHANG, 0 +BACKAC, 0 +BACKLK, 0 +BACKPC, VBACKG +VHANG= HANG + IFNZRO VHANG-0524 <__ CHANGE LOADER!> + PAGE + /I-O CONVERSION ROUTINES - STARTUP CODE + +RWASCI, JMS I [RWINIT /"READ(N,FMT)" OR "WRITE(N,FMT)" + 2000 /"FORMATTED" BIT + JMS I [FETPC /GET ADDRESS OF FORMAT STMT + DCA FMTDF + JMS I [FETPC + DCA FMTADR + DCA FMTTYP + DCA PFACT /CLEAR SCALE FACTOR + JMS I [GETLMN /EXIT TO MAIN PROGRAM TO GET 1ST VARIABLE + + TAD (FMTPDL-1 +FMTSET, DCA FMTPXR /STORE NEW FORMAT PUSHDOWN POINTER + TAD I FMTPXR + DCA FMTBYT /GET NEW BYTE POINTER (NOTE-FMTPDL CONTAINS A 0) + /MAIN FORMAT DECODING LOOP + +FMTFLP, TAD FMTBYT + DCA FMPBYT /SAVE CURRENT BYTE PTR FOR PARENTHESES HACK +FMTDLP, DCA FMTNUM /ZERO ACCUMULATED NUMBER +FMTCLP, JMS FMTGCH /GET A CHARACTER + ISZ FMTBYT /BUMP BYTE POINTER + JMS I [CHTYPE /CLASSIFY CHAR + 1234; FMTDIG /DIGIT + -42; DBLQOT /" + -44; ABORTO /$ + -55; FMINUS /- + -56; FMTPER /. + -57; SLASH // + -54; COMMA /, + -50; LPAREN /( + -51; RPAREN /) + -47; KWOTE /' + -40; FMTCLP /SPACE + 0 /ANYTHING ELSE + + TAD FMTTYP + SZA CLA /CHECK THAT WE DO NOT HAVE A FIELD OUTSTANDING + JMP I (FMTERR /IF WE DO - ERROR + TAD CHCH /GET FIELD CHARACTER + DCA FMTTYP + TAD FMTNUM + SNA /IF REPEAT COUNT WAS MISSING OR ZERO + IAC /MAKE IT ONE + CMA + DCA N /STORE -(REPEAT COUNT +1) + DCA W /CLEAR WIDTH INITIALLY + ISZ FMTNUM /PRECLUDE "FORMAT ERROR" ON X,P, OR H FORMATS + TAD FMTTYP + AND [7 /IS THE CHARACTER P, X, OR H? + SNA CLA /IF SO, DON'T WAIT +COMMA, JMS I (DOFMT /EXECUTE THE STORED FIELD SPECIFICATION + JMP FMTFLP /BACK FOR MORE + +FMTADR, 0 /ADDRESS OF FORMAT + FMTGCH, 0 /GET CHARACTER FROM FORMAT + JMS FMTGAD /GET WORD CONTAINING CHAR AND L/R SWITCH + CDF 0 + JMS I (FMTGLR /EXTRACT CHARACTER + JMP I FMTGCH + +FMTGAD, 0 /SUBR TO GET A WORD FROM A CHARACTER OFFSET + TAD FMTBYT /GET OFFSET + CLL RAR + CLL + TAD FMTADR /COMPUTE BASE ADDR + [OFFSET/2] + DCA D + RAL + TAD FMTDF + JMS I MCDF /SET UP PROPER DATA FIELD + DCA .+1 + HLT + TAD FMTBYT + RAR + CLA /LEAVE L/R SWITCH IN LINK + TAD I D + JMP I FMTGAD /RETURN WITH WORD IN AC + +FMTDF, 0 /FIELD OF 1ST CHAR OF FORMAT IN BITS 9-11 + +FMTDIG, TAD FMTNUM /DIGIT PROCESSOR + CLL RTL + TAD FMTNUM + CLL RAL /MULTIPLY FMTNUM BY 10 + TAD CHCH /ADD IN THE DIGIT + JMP FMTDLP /STORE IT BACK AND CONTINUE + /PARENTHESIS AND DIGIT ROUTINES + +LPAREN, TAD FMTPXR + TAD (2-FMTPDL + SZA /ARE WE AT PARENTHESIS LEVEL 1? + JMP .+3 /NO + TAD FMPBYT /YES - STORE A POINTER TO THE FIRST DIGIT OF THE + DCA I (FMTPDL-2 /GROUP COUNT PRECEDING THIS PAREN + /AS THE LOOP POINTER FOR LEVEL 1 + TAD [7 + SPA CLA /PUSHDOWN OVERFLOW? +FPOERR, JMS I ERR /YES + AC7775 + TAD FMTPXR + DCA FMTPXR /BUMP PARENTHESIS PUSHDOWN POINTER + TAD FMTBYT + DCA I FMTPXR /SAVE BYTE POINTER + TAD FMTNUM + SNA + IAC /NO GROUP COUNT MEANS COUNT = 1 + CIA + DCA I FMTPXR /SAVE LOOP COUNT + DCA I (FMTPDL-1 /INITIAL GROUP COUNT IS INFINITE! +RPLOOP, AC7776 /COME HERE ON RIGHT PAREN ALSO + TAD FMTPXR /BACK UP FORMAT PDL POINTER + JMP FMTSET /RESTORE FMTBYT FROM TOP OF LIST + +FMPBYT, 0 + +RPAREN, JMS I (DOFMT /EXECUTE PREVIOUS SPEC IF ANY + TAD FMTPXR + TAD (2-FMTPDL /IS THIS THE FINAL RIGHT PAREN? + SNA CLA + JMS I [ENDREC /YES - CHECK FOR END OF FORMAT + ISZ I FMTPXR /BUMP COUNT + JMP RPLOOP /DIDN'T OVERFLOW - LOOP TO BYTE AFTER ( + ISZ FMTPXR /POP UP PARENTHESES STACK + JMP FMTFLP /CONTINUE PAST RIGHT PAREN + PAGE + /QUOTE AND HOLLERITH FORMAT PROCESSORS + +KWOTE, TAD MINUS5 /APOSTROPHE PROCESSOR +DBLQOT, TAD (-42 /QUOTE PROCESSOR + DCA KWODEL /SAVE TERMINATOR + JMS DOFMT /PROCESS PRECEDING FIELD , IF ANY + SKP +KWOTLP, JMS FMTHCV /PROCESS ONE CHARACTER + JMS I [FMTGCH /GET THE NEXT FORMAT CHAR + TAD KWODEL + SZA CLA /IS IT THE TERMINATOR? + JMP KWOTLP /NO - PROCESS IT AND CONTINUE + ISZ FMTBYT /BUMP OVER TERMINATOR + JMS I [FMTGCH + TAD KWODEL + SNA CLA /IS THIS ANOTHER TERMINATOR? + JMP KWOTLP /TWO TERMINATORS PRINT AS ONE + JMP I (FMTFLP /OTHERWISE GO BACK TO FORMAT LOOP + +HFMT, JMS MORE /MORE CHARACTERS? + JMS FMTHCV /YES - PROCESS ONE + JMP HFMT /AND LOOP + +FMTHCV, 0 /ROUTINE COMMON TO H AND QUOTED FORMATS + TAD RWFLAG /PROCESSES ONE CHAR IN OR OUT OF THE FORMAT +H7700, SMA CLA /IN OR OUT? + JMP FMTHIN /IN + JMS I [FMTGCH /OUT - GET THE CHAR + JMS I [FMTOUT /PRINT IT + JMP FMTHCR /RETURN +FMTHIN, JMS I [FMTIN /INPUT - GET THE CHAR FROM THE INPUT LINE + DCA W /SAVE IT + JMS I (FMTGAD + SZL /WHICH SIDE? + JMP FHRGHT /RIGHT SIDE + AND [77 /LEFT - KEEP RIGHT CHAR + DCA MORE + TAD W + CLL RTL + RTL + RTL + TAD MORE /ADD NEW CHAR IN ON THE LEFT + JMP .+3 +FHRGHT, AND H7700 /KEEP THE CHAR ON THE LEFT + TAD W /ADD NEW CHAR IN ON THE RIGHT + DCA I D /RESTORE ALTERED WORD + CDF 0 +FMTHCR, ISZ FMTBYT /BUMP BYTE POINTER + JMP I FMTHCV + +KWODEL, 0 /MUST BE UNIQUE! + MORE, 0 /SUBR TO BUMP REPEAT COUNT AND EXIT ON OVFLO + ISZ N + JMP I MORE +DOFRTN, DCA FMTTYP /INDICATE NO SPECIFICATION COLLECTED + JMP I DOFMT /RETURN FROM "DOFMT" + +DOFMT, 0 /ROUTINE TO PROCESS A FORMAT SPECIFICATION + TAD FMTNUM /GET THE CURRENT NUMBER + DCA D /STORE IT AS DECIMAL POINT SPEC + DCA IFLG + DCA EFLG + DCA GFLG /ZERO CONVERSION FLAGS + TAD FMTTYP + SNA CLA /ANY SPECIFICATION WAITING? + JMP I DOFMT /NO - JUST RETURN + TAD W + TAD D /IF THERE WAS NO W OR D SPECIFICATION, + SNA CLA + JMP FMTERR /ITS AN ERROR + TAD FMTTYP + JMS I [CHTYPE /YES - WHICH ONE? + -30; XFMT /X + -24; TFMT /T + -20; PFMT /P + -14; LFMT /L + -11; IFMT /I + -10; HFMT /H + -7; GFMT /G + -6; FFMT /F +MINUS5, -5; EFMT /E + -4;DF, EFMT /D - EQUIVALENT TO E IF NO D.P. FPP + -2;BF, FFMT /B - EQUIVALENT TO F IF NO D.P. FPP + -1; AFMT /A + 0 /NONE OF THE ABOVE - ERROR +FMTERR, JMS I ERR + ENDREC, 0 /ROUTINE TO END A LINE AND MAYBE THE I/O + JMS I [EOLINE + CLA IAC + AND RWFLAG /LO BIT OF RWFLAG IS "I/O LIST EXHAUSTED" FLAG + SNA CLA /SKIP IF NO MORE ELEMENTS IN I/O LIST + JMP I ENDREC + JMP I [ENDIO /NOW FINISH UP AND LEAVE + +SLASH, JMS DOFMT /EXECUTE THE FIELD SPEC IF ANY + JMS I [EOLINE /TERMINATE CURRENT LINE + JMP I (FMTFLP + +PFMT, CLA CMA + TAD FMTNUM + ISZ MINFLG /P FORMAT - CHECK FOR NEGATIVE SCALE + CIA + DCA PFACT + STA /FALL INTO CODE TO CLEAR MINFLG + DCA MINFLG /SET FLAG ON MINUS + JMP DOFRTN + +FMINUS, JMS DOFMT /EXECUTE PRECEDING SPEC + DCA MINFLG /CLEAR MINUS FLAG + JMP I (FMTFLP + +MINFLG, -1 + +FMTPER, TAD FMTNUM /PERIOD PROCESSOR + DCA W /STORE WIDTH + JMP I (FMTFLP + +ABORTO, JMS DOFMT /$ - SPECIAL HACK TO ALLOW PROMPTS + DCA EOLSW /FAKE BEGINNING OF LINE + DCA I (TTYLF /INHIBIT LF BEFORE NEXT TTY INPUT + JMP I [ENDIO /GO AWAY + PAGE + CHTYPE, 0 /ROUTINE TO CLASSIFY CHARACTERS + DCA CHCH /SAVE CHAR + JMP CHLOOP+1 +CDIGIT, TAD CHCH /CHECK FOR DIGIT + TAD (-72 + CLL + TAD [12 + SZL /IS CHAR A DIGIT? + JMP JMPOUT /YES +CHLOOP, ISZ CHTYPE /SKIP OVER ADDRESS + CLA + TAD I CHTYPE + ISZ CHTYPE + SMA /END OF LIST? + JMP JMPOTX /MAYBE - JUMP WITH CODE IN AC + TAD CHCH + SZA CLA /DOES CHAR MATCH CHAR ON LIST? + JMP CHLOOP /NO - KEEP LOOKING +JMPOUT, DCA CHCH /ZERO CHAR + TAD I CHTYPE + DCA CHTYPE /SET UP TO RETURN INDIRECTLY +JMPOTX, SZA CLA /IS THIS THE END? + JMP CDIGIT /NO - GO CHECK FOR DIGIT + JMP I CHTYPE /GO TO SPECIFIED ADDRESS + + +SKPOUT, 0 /ROUTINE USED BY DATA-HANDLING SPECIFICATIONS + JMS I [MORE /CHECK FOR REPEAT COUNT EXHAUSTED + TAD RWFLAG + CLL RAR + SZA CLA /IF OUTPUT, + ISZ SKPOUT /SKIP RETURN + SZL CLA /IF END OF I/O LIST, + JMS I [ENDREC /DON'T RETURN AT ALL - GO AWAY + JMP I SKPOUT + /A FORMAT PROCESSOR + +AINPUT, TAD (4040 + DCA ACH + TAD (4040 + DCA ACL /INITIALIZE LOW-ORDER WORDS TO BLANKS +AINPTL, JMS GADR + SZL /LEFT OR RIGHT? + JMP AINPTR /RIGHT + JMS I [FMTIN + STL RTL /INPUT CHAR GOES IN HIGH-ORDER + RTL /WITH BLANK IN LOW-ORDER + RTL + JMP AINPTC +AINPTR, JMS I [FMTIN + TAD I FMTGLR /COMBINE INPUT CHAR AND OLD LEFT HALF + TAD [-40 /DELETE PREVIOUS RIGHT-HALF SPACE +AINPTC, DCA I FMTGLR /STORE WORD + ISZ W + JMP AINPTL /LOOP AROUND WIDTH +ANXT, JMS I [GETLMN /GET NEXT ELEMENT +AFMT, TAD D + CIA + DCA W /SAVE FIELD WODTH AS A COUNT + JMS I [SKPOUT /CHECK FOR REPEAT COUNT OVFLO AND I/O DIR + JMP AINPUT +AOTPUT, JMS GADR /OUTPUT - GET ADDRESS OF BYTE + TAD I FMTGLR + JMS FMTGLR /GET BYTE + JMS I [FMTOUT /PRINT IT + ISZ W + JMP AOTPUT /LOOP ON WIDTH + JMP ANXT + +FMTGLR, 0 /SUBR TO EXTRACT A CHAR FROM A WORD + SZL + JMP .+4 /RIGHT HALF + RTR + RTR + RTR /LEFT HALF - ROTATE INTO RIGHT HALF + AND [77 + JMP I FMTGLR + +GADR, 0 /BYTE ADDRESS ROUTINE FOR A FORMAT PROCESSOR + TAD D + TAD W /FORM BYTE OFFSET IN THE RANGE 0 THRU D-1 + CLL RAR + TAD (ACX + DCA FMTGLR + JMP I GADR /LEAVE WITH L/R FLAG IN LINK + /"STOP" ROUTINE - TERMINATES JOB + +CALXIT, TAD EXDVNO + CIA + DCA ACI /GO THROUGH THE FORTRAN UNIT NUMBERS. + DCA I (ENDFLS /*K* TURN "ENDFL" INTO A SUBROUTINE + JMS I (LDDSRN /IF WE FIND A UNIT WHICH IS BEING USED + SNA CLA /AND HAS NOT BEEN ENDFILED, + JMP XITISZ /WE WILL DUMP THE CURRENT BUFFER (IF IT + CLA IAC /IS A FORMATTED OUTPUT FILE) AND + AND FFLAGS /END-FILE IT + SNA CLA + JMS I (ENDFL +XITISZ, ISZ EXDVNO + JMP CALXIT +LPTTWT, TAD I LPGET /WAIT FOR LINE PRINTER AND TELETYPE TO + TAD TOCHR /GO QUIET. + SZA CLA + JMP LPTTWT + ISZ CLNADR /SET UP TO CLOSE OUTPUT FILES +PDPXIT, IOF /ENTER HERE FROM 7605 + CDF 0 /TO PROTECT CLODS WITH PDP 8/E'S + JMS I (7607 + 0210 + 7400 /READ IN CLEANUP ROUTINE + 37 /AND OS/8 PAGE 17600 + JMP .-5 /AYEEEE!! SYSTEM DEVICE GONZO! + CDF CIF 10 + JMP I CLNADR /CLOSE TENTATIVE FILES AND EXIT +CLNADR, CLNUP +EXDVNO, -11 + +ARGLD, 0 /ROUTINE TO GET VALUE OF AN ARG + JMS I [FETPC + AND [7 /THROW AWAY OPCODE (JA) + TAD FLDTM2 + DCA FGPBF + JMS I [FETPC /CONSTRUCT AN FPP INSTRUCTION + DCA BIOPTR + JMS I [FPGO + FGPBF + JMP I ARGLD + +FLDTM2, FLDA+LONG + FTEMP2 + FEXIT + PAGE + /SUBROUTINE TO OPEN A UNIT FOR I/O + +RWINIT, 0 + DCA RWFLAG /DIRECTION IN AC ON ENTRY + AC7776 + AND I RWINIT /IF CALLED FROM BACKSPACE, REWIND OR ENDFILE + SZA CLA /UNIT NUMBER IS IN FAC + JMS I [ARGLD /OTHERWISE, GET UNIT NUMBER + JMS I [FFIX + TAD ACI + CLL CMA + TAD [12 + SZL CLA /CHECK DEVICE NUMBER IN RANGE 0-9 + JMS LDDSRN /LOAD DSRN ENTRY INTO PAGE 0 + SNA CLA /IS UNIT INITIALIZED? +UNTERR, JMS I ERR /NO - ERROR + TAD RWFLAG + SPA /IF WE ARE WRITEING FOR THE FIRST TIME + TAD FFLAGS /ON A UNIT WHICH WAS BEING READ, + CMA RAL /WE MUST BUMP THE RELATIVE BLOCK NUMBER DOWN + SNL SMA CLA /ONE BECAUSE OF A PHILOSOPHICAL DIFFERENCE + JMS I (RD2WR /BETWEEN READ AND WRITE + TAD I RWINIT + TAD RWFLAG /OR THE I/O TYPE AND + CMA + AND FFLAGS /DIRECTION BITS INTO THE FLAG WORD + TAD I RWINIT + TAD RWFLAG + DCA FFLAGS + TAD FFLAGS + CMA RTL + SNL SMA CLA /IT IS ILLEGAL TO ACCESS A FILE IN + JMP UNTERR /FORMATTED AND UNFORMATTED MODES + ISZ RWINIT + TAD ACI + CLL RAL + TAD ACI + TAD (DATABL-4 + DCA XR /STORE POINTER INTO DIRECT-ACCESS TABLE + JMP I RWINIT + /REWIND AND END FILE + +RWIND, JMS RWINIT /GET THE DSRN ENTRY + 0 /DON'T PLAY WITH MODES + AC2000 + TAD FFLAGS + SNA CLA /IF FORMATTED OUTPUT FILE AND NOT EOF'D + JMS DMPBUF /DUMP LAST BUFFER AS A FAVOR +ATLDMK, CLA IAC + AND FFLAGS /KILL ALL FLAG BITS + DCA FFLAGS /EXCEPT "END-FILED" BIT + TAD BADFLD + AND [7400 + DCA CHRPTR + AC7775 + DCA CHRCTR /INITIALIZE BUFFER POINTERS + DCA RELBLK /AND RELATIVE BLOCK # + JMP I [ENDIO /RESTORE DSRN AND EXIT + +ENDFL, JMS RWINIT /*K* USED AS A SUBROUTINE BY CALXIT + 1 /GET DSRN, SET "END FILE" FLAG + TAD FFLAGS /IF THE FILE IS UNFORMATTED, + CMA RAL /OR WAS NOT OUTPUT ONTO, + SNL SMA CLA /THEN ENDFILE DOES NOTHING. + JMS DMPBUF /ELSE DUMP THE FINAL BUFFER + AC3777 + AND FFLAGS /CLEAR WRITE BIT SO WE WILL NOT TRY +SETTOT, DCA FFLAGS /ANYTHING ON A SUBSEQUENT ENDFILE + TAD RELBLK /SET NEW LENGTH OF FILE IN CASE ITS TENTATIVE, + DCA TOTBLK /AND SO WE WON'T READ PAST EOF. +ENDIO, JMS INITMV /SET UP DSRN POINTERS + TAD I XR1 + DCA I XR /STORE BACK THE DSRN ENTRY + ISZ T /FOR THIS LOGICAL UNIT + JMP .-3 + DCA VEOFSW /CLEAR EOFSW AT END OF EVERY READ +ENDFLS, JMP I [RETURN /RETURN TO THE CALLING PROGRAM + JMP I ENDFL /*K* OR RETURN TO CALXIT + +INITMV, 0 /ROUTINE TO SET UP STUFF +ICDF0, CDF 0 + TAD LOGUNT + DCA XR + TAD (HAND-1 + DCA XR1 + TAD (-11 + DCA T + JMP I INITMV + /ROUTINE TO DUMP CURRENT OUTPUT BUFFER WITH ^Z AT THE END + +DMPBUF, 0 + ISZ EOLSW /FORCE COLUMN 1 SWITCH OFF + TAD (7712 /OUTPUT A LINE FEED + JMS I [FMTOUT + TAD HAND /IF THE FILE IS BEING OUTPUT VIA + SMA CLA /AN OS/8 HANDLER, + JMP CLREOL /WE MUST TERMINATE THE BUFFER PROPERLY. + TAD (32 +CTZLP, TAD Z7700 /OUTPUT A ^Z AND FILL BUFFER WITH ZEROES. + JMS I [FMTOUT /NEGATIVE NUMBERS TURN INTO CONTROL CHARS + TAD CHRPTR + AND [377 + TAD CHRCTR /FILL THE BUFFER UNTIL CHRPTR POINTS TO + IAC /A BLOCK BOUNDARY AND CHRCTR = -3 +Z7700, SMA CLA /WE ARE THEN AT BUFFER-END + JMP CTZLP +CLREOL, DCA EOLSW /RESET TO BEGINNING OF LINE + JMP I DMPBUF /RETURN + +/ROUTINE TO MOVE THE PROPER DSRN ENTRY INTO PAGE 0 + +LDDSRN, 0 + TAD ACI / READ/WRITE INIT SINGS THIS SONG, + CLL RTL / (DOO DAH, DOO DAH,) + RAL / DSRN ENTRIES 9 WORDS LONG + TAD ACI / (OH, DEE DOO DAH DAY). + + SNA /DEVICE NUMBER 0 IS SPECIAL - + TAD (PTTY+11-DSRN /IT'S ALWAYS THE TELETYPE + TAD (DSRN-12 + DCA LOGUNT + JMS INITMV /SET UP FOR MOVE + TAD I XR + DCA I XR1 /PUT DSRN ENTRY IN PAGE 0 + ISZ T + JMP .-3 + TAD BADFLD + AND [70 + TAD ICDF0 + DCA BUFCDF /SAVE BUFFER FIELD AS A CDF + TAD HAND + JMP I LDDSRN + PAGE + /BACKSPACE ROUTINE - WORKS ON BINARY OR ASCII FILES + +BKSPC, JMS I [RWINIT + 0 /GET THE DSRN ENTRY WITHOUT ALTERING MODE + TAD HAND + SMA CLA + JMP I [UNTERR /UNIT MUST BE BLOCK ORIENTED + AC2000 + AND FFLAGS + SZA CLA /IS FILE FORMATTED? + JMP BKASCI /YES - PAIN IN NECK + JMS BMPBLK /UNFORMATTED FILE - REREAD LAST BLOCK + TAD CHRPTR + TAD [377 + DCA T + JMS BUFFLD /SET DATA FIELD TO FIELD OF BUFFER + TAD I T /LOOK AT LAST WORD IN BUFFER + CIA /REGARD IT AS THE NUMBER OF BLOCKS/RECORD + TAD RELBLK + DCA RELBLK /RELBLK POINTS TO FIRST BLOCK OF PREV. REC + JMP I [ENDIO + +BMPBLK, 0 /SUBR TO BUMP BLOCK # BACK AND READ + CMA CLL /AC MAY NOT BE 0 ON ENTRY + TAD RELBLK + DCA RELBLK /BUMP BLOCK BACK + SNL + JMP I (ATLDMK /BACKSPACED TOO FAR - CALL IT QUITS + DCA CHRPTR /ZERO CHRPTR TO FORCE A READ FROM MASSIO + JMS I [MASSIO /READ A BLOCK + JMP I BMPBLK + +/**** NULL JOB GOES HERE FOR LACK OF A BETTER PLACE **** + +NULLJB, TAD N2525 +NULLLP, ISZ N2525 /PUT THE FAMOUS "POLY BASIC PATTERN" + JMP NULLLP /IN THE AC LIGHTS + ISZ NUMISZ + JMP NULLLP + CML CMA RAR + DCA N2525 + TAD [-4 + DCA NUMISZ + JMP I (VBACKG /GOT SOMETHING MORE USEFUL TO DO? +N2525, 2525 +NUMISZ, -4 + /BACKSPACE FOR FORMATTED FILES + +BKLORD, TAD I CHRPTR + ISZ CHRPTR + NOP + AND [177 /GET 7 BITS + TAD (-15 /COMPARE WITH C.R. - SINCE WE SKIPPED + SNA CLA /THE FIRST ONE THIS WILL BELONG TO THE PREVIOUS + JMP I [ENDIO /LINE AND WE WILL BE DONE (HAH!) +BKASCI, JMS I (MASBMP /A COMPLICATED MESS - FIRST BUMP THE + SKP /CHARACTER POINTER BACK TWO PLACES + JMP BKGTCH /AND THEN FETCH A CHARACTER. THIS WILL IGNORE + TAD BADFLD /THE LAST CHAR READ/WRITTEN (WHICH SHOULD + AND [7400 /BE A CARRIAGE RETURN). + CIA + TAD CHRPTR + CLL RAR + SZA CLA /TEST WHETHER WE HAVE TO READ AN OLD BUFFER + JMP BKNORD /NO + TAD CHRCTR /SAVE POSITION IN CURRENT DOUBLEWORD + DCA GETCH3 + DCA CHRPTR + AC4000 /IF WE ARE BACKSPACING AN OUTPUT FILE, + TAD FFLAGS /WE MUST SAVE THE INFORMATION IN THE + SPA /CURRENT BUFFER BY WRITING IT OUT. + JMP .+4 + DCA FFLAGS /ALSO CHANGE THE UNIT TO AN INPUT FILE + AC4000 /(RWINIT TAKES CARE OF SWITCHING BACK TO OUTPUT) + JMS I [MASSIO + CLA IAC /WE DON'T WANT THE LAST BLOCK READ/WRITTEN, + JMS BMPBLK /THAT'S IN CORE - WE WANT THE ONE + TAD GETCH3 /BEFORE THAT. + DCA CHRCTR + TAD CHRCTR + TAD (401 + SKP /COMPUTE WORD POINTER FROM CHAR POINTER +BKNORD, STA + TAD CHRPTR + DCA CHRPTR /BUMP WD PTR BACK 1 +BKGTCH, JMS I (MASBMP /NOW GET A CHARACTER - THIS LOOKS A LOT + JMP BKLORD /LIKE THE INPUT ROUTINE + JMS GETCH3 + JMP BKLORD+1 + GETCH3, 0 /COMMON CODE BETWEEN BACKSPACE AND INPUT + TAD I CHRPTR + AND [7400 + DCA BMPBLK /HANDY TEMPORARY + ISZ CHRPTR + TAD I CHRPTR + AND [7400 + CLL RTR + RTR /COMBINE TWO 4-BIT QUANTITIES + TAD BMPBLK /INTO A CHARACTER + CLL RTR + RTR + JMP I GETCH3 + +DATABL, ZBLOCK 33 /DIRECT ACCESS TABLE + PAGE + /I,E,F,AND G FORMAT CONVERSIONS + +IFMT, TAD D + DCA W /SET WIDTH PROPERLY + DCA D /FOR SCALING PURPOSES + STA + DCA IFLG + JMP FFMT + +GFMT, STA + DCA GFLG /SET G AND E FLAGS + +EFMT, STA + DCA EFLG /SET E FLAG + JMP FFMT + +IGEF, JMS I [GETLMN /MAIN LOOP FOR CONVERSIONS - SKIPPED 1ST TIME +FFMT, TAD D + DCA OD /SAVE COUNT OF POST-D.P. DIGITS + TAD IFLG + SNA CLA /APPLY THE P-SCALE FACTOR + TAD PFACT /ONLY IF THE FORMAT IS NOT I + DCA PFACTX + DCA SCALE /DON'T LOOK FOR TROUBLE + JMS I [SKPOUT /CHECK IF MORE AND TEST DIRECTION + JMP I (IGEFIN /INPUT + STA + DCA I [FFNEG /USE NEGATE ROUTINE HEADER AS SIGN FLAG + TAD EFLG + CLL RAL + CLL RAL /0 IF NOT E, -4 IF E + TAD W /THIS PROVIDES FOR THE EXP. FIELD (IF E FMT) + DCA OW /OR THE 4 TRAILING SPACES (IF G FMT) + TAD ACH + SNA + JMP SKPSHT /AC IS ZERO - SKP A LOT OF SHT + SPA CLA + JMS I [FFNEG /AC<0 - NEGATE IT AND SET FLAG (CLEVER) +SCALUP, DCA SCALE + TAD ACX + SMA SZA CLA /AC<1.0? + JMP GT1 /NO + JMS I [FPGO /YES - MULTIPLY BY 10.0 + FMUL10 + STA + TAD SCALE /BUMP POWER OF TEN + JMP SCALUP + /I,G,E,F, OUTPUT CONVERSIONS - NUMBER IS NOW =>1.0 + +GT1, JMS I (SCALDN /NOW DECREASE IT TO THE INTERVAL [0,1) + JMS I [FPGO /SAVE IT AWAY + FSTTMP + TAD [7 + JMS OSCALE + JMS I [FPGO /USE IT TO ROUND THE NUMBER TO BE OUTPUT + FADTMP + JMS I (SCALDN /WE COULD HAVE ROUNDED FROM .999... TO 1.000... +SKPSHT, TAD GFLG /ENTER HERE IF NUM WAS 0 - SCALE=0 + SNA CLA + JMP NOTG /NOT G FORMAT + TAD SCALE /G FORMAT - TEST FOR OUT OF F FORMAT RANGE + TAD PFACTX + CIA CLL /F FORMAT RANGE IS [.1,10**(D VALUE)) + TAD OD + SNL + JMP USEE /IF OUT OF BOUNDS USE E FORMAT (FLAG IS SET) + DCA OD /REDUCE D VALUE BY SCALE FACTOR + DCA EFLG /TO RETAIN CORRECT # OF SIG. DIGITS +USEE, CLA + JMP NOTG + +/SET UP TO PRINT DIGITS + + +DIGCNT, 0 + TAD PFACTX /COMPUTE EXPONENT JUST IN CASE E FORMAT + CIA + TAD SCALE + DCA FMTNUM + TAD EFLG + SNA CLA /NOW COMPUTE THE NUMBER OF DIGITS BEFORE THE D.P. + TAD SCALE /TAKE SCALE FACTOR INTO ACCOUNT IF NOT E FORMAT + TAD PFACTX /TAKE P FACTOR INTO ACCOUNT IF NOT I OR F/G + DCA SCALE /STORE THE NUMBER OF DIGITS BEFORE THE D.P. + TAD I [FFNEG /INCREASE NUMBER OF LEADING BLANKS BY 1 + SPA CLA /IF THE NUMBER IS POSITIVE. THIS DEPENDS ON + ISZ OW /THIS LOCATION BEING BELOW 4000. + TAD SCALE /GET THE NUMBER OF PRE-D.P. DIGITS (AS NEGATIVE #) + SPA SNA + CLA IAC /IF NONE, PRINT A 0 SO COUNT AS 1 + TAD OD /REDUCE THE WIDTH BY THIS NUMBER + CMA + TAD OW /REDUCE IT AGAIN BY THE POST-D.P. DIGIT COUNT + CIA + TAD IFLG /AND AGAIN BY 1 FOR THE D.P. (IF NOT I FORMAT) + JMP I DIGCNT +OW, 0 + /I,G,E,F FORMAT - ROUTINE TO SCALE ROUNDING FACTOR + +OSCALE, 0 /SUBR TO SCALE .5 THE CORRECT # OF TIMES + DCA NPLCS /MAX IN AC ON ENTRY + DCA ACX + AC2000 /FORM A FLOATING 0.5 IN ORDER + DCA ACH /TO ROUND THE NUMBER BEFORE PRINTING. + DCA ACL + TAD EFLG /FIGURE OUT HOW TO SCALE IT - + SNA CLA /THE THEORY IS THAT IT SHOULD BE SCALED + TAD SCALE /DOWN BY THE NUMBER OF SIGNIFICANT + DCA T /PRINTING DIGITS. THIS CAN BE + TAD SCALE /EXPRESSED AS: + CIA CLL /(P FACTOR) * (NOT (G FMT PRINTING AS F)) + TAD OD / + (SCALE FACTOR) * (NOT E FMT) + (D VALUE). + SZL CLA /THE SCALE FACTOR IS < 0 FOR + TAD GFLG /NUMBERS < .1, WHICH REDUCES + SNA CLA /THE # OF SIG. DIGITS VIA LEADING ZEROS. + TAD PFACTX /IF THERE ARE < 0 SIG. DIGITS + TAD T /IT DOESN'T MATTER WHAT WE DO + TAD OD /SINCE THE NUMBER WILL PRINT AS + SMA /0.00000 ANYWAY. + CMA /IF THERE ARE >NPLCS SIG. PRINTING DIGITS + TAD NPLCS /THE ROUNDING GETS MEANINGLESS SO MAKE + SPA /THE EXCESS DIVISIONS DIVIDES BY 2 INSTEAD + DCA ACX / OF BY 10. THIS FUDGE WORKS QUITE WELL + CIA /FOR NUMBERS OF UP TO NPLCS+2 + TAD NPLCS /SIGNIFICANT DIGITS. + CIA + DCA T + JMP .+3 +FDIVLP, JMS I [FPGO /SCALE THE .5 DOWN THE CORRECT NUMBER OF TIMES + FDIV10 + ISZ T + JMP FDIVLP + JMP I OSCALE +NPLCS, 0 +ONE, 1;2000;0 + PAGE + /I,G,E,F OUTPUT CONVERSION - ACTUAL OUTPUT SECTION + +OUTNUM, SMA /CHECK FOR FIELD OVERFLOW + JMP ASTSK1 /YES - PRINT ******* + JMS OBLNKS /PRINT LEADING BLANKS - AC IS NOT 0! + /***IMPORTANT - OBLNKS CLEARS AC1 *** + AC7775 + ISZ I [FFNEG /IF SIGN IS NEGATIVE, + JMS DIGIT /OUTPUT A MINUS SIGN + CLA /OTHERWISE OUTPUT NOTHING + TAD ACX + SNA /ALIGN THE FAC MANTISSA INTO A DOUBLEWORD + JMS I [AL1 /FRACTION IN THE RANGE [.1,1) + IAC /THIS INVOLVES SHIFTING THE MANTISSA + CMA /RIGHT BY (-ACX-1) PLACES + SMA /WHERE A NEGATIVE NUMBER MEANS A LEFT SHIFT. + JMS I [ACSR + CLA + TAD ACL /NOW MOVE THE FAC DOWN A WORD SO THAT + DCA AC1 /WHEN WE MULTIPLY BY 10 THE OVERFLOW APPEARS + TAD ACH /IN THE HIGH-ORDER WORD + DCA ACL + TAD SCALE + SPA SNA /DO WE HAVE DIGITS TO THE LEFT OF THE D.P.? + JMP PRZERO /NO - PRINT A ZERO THERE + JMS DIGITS /YES - PRINT THEM +PRDCPT, TAD IFLG + SZA CLA + JMP I (IGEF /IF I FORMAT, WE'RE DONE NOW + AC7776 + JMS DIGIT /OTHERWISE PRINT DECIMAL POINT + TAD SCALE + SMA CLA /CHECK WHETHER WE NEED TO PRINT LEADING ZEROS + JMP NOLZRO /NO + TAD SCALE + DCA T +LZLOOP, STA CLL + TAD OD /BUMP D VALUE DOWN BY ONE + SNL /IF IT GOES NEGATIVE, + JMP NOMOAC /WE'VE RUN OUT OF FIELD WIDTH + DCA OD + JMS DIGIT /PRINT A ZERO + ISZ T /UNTIL THE COUNT (OR THE WIDTH) RUNS OUT + JMP LZLOOP +NOLZRO, TAD OD + SZA /IF THERE ARE ANY DIGITS YET TO BE PRINTED, + JMS DIGITS /PRINT THEM + /I,G,E,F OUTPUT CONVERSION - FINISH UP + +NOMOAC, CLA + TAD EFLG + SNA CLA /E FORMAT? + JMP CHKG /NO - CHECK FOR G FORMAT OUTPUT AS F + JMS EXPFLD + JMP I (IGEF +EXPFLD, 0 + TAD (5 + JMS I [FMTOUT /OUTPUT "E" + TAD FMTNUM /GET EXPONENT + CLL + SPA + CML CIA /SEPARATE INTO MAGNITUDE AND SIGN + DCA FMTNUM /SAVE MAGNITUDE + RTL + TAD (-5 /PRINT + OR - + JMS DIGIT + DCA T /INITIALIZE QUOTIENT OF DIVISION +DVELP, TAD FMTNUM /SUBTRACT 10 FROM EXPONENT + TAD [-12 + SPA /DID IT GO NEGATIVE? + JMP PRNTXP /YES - DONE + DCA FMTNUM /NO - STORE IT BACK + ISZ T /BUMP QUOTIENT + JMP DVELP /LOOP +PRNTXP, CLA + TAD T + TAD [-12 + SMA CLA + JMP ASTSK3 + TAD T + JMS DIGIT + TAD FMTNUM + JMS DIGIT /PRINT TWO DIGITS OF EXPONENT + JMP I EXPFLD + +CHKG, TAD GFLG + SNA /WAS IT G FORMAT? + JMP I (IGEF /NO - F OR I - DONE + DCA EFLG /RE-SET EFLG SINCE WE ZEROED IT BEFORE + TAD (-5 + JMS OBLNKS /OUTPUT 4 BLANKS + JMP I (IGEF /DONE WITH G FORMAT OUTPUT + +PRZERO, CLA /COME HERE IF NO SIG. DIGITS LEFT OF D.P. + JMS DIGIT /PRINT A ZERO + JMP PRDCPT /CONTINUE + +ASTSK3, AC0002 + JMP .+3 +ASTSK1, CLA /CLEAR THE AC + TAD W /GET THE FIELD WIDTH + JMS I [ASTRSK + JMP I (IGEF + /I,G,E,F OUTPUT CONVERSION - OUTPUT SUBROUTINES + +OBLNKS, 0 /SUBROUTINE TO PRINT A STRING OF BLANKS + DCA AC1 /MUST LEAVE AC1 ZERO ON EXIT SO THAT + JMP .+3 /FAC LEFT SHIFT WON'T SHIFT IN GARBAGE LATER ON + TAD [40 + JMS I [FMTOUT /OUTPUT A BLANK + ISZ AC1 + JMP .-3 /LOOP + JMP I OBLNKS /RETURN + +DIGITS, 0 /ROUTINE TO OUTPUT A STRING OF DECIMAL DIGITS + CIA + DCA T +DGLOOP, TAD AC1 + DCA AC2 /COPY AC INTO OPERAND FOR ADDITION LATER ON + TAD ACL + DCA OPL + DCA ACH /CLEAR "OVERFLOW WORD" + JMS I [AL1 + JMS I [AL1 /FAC=FAC*4 + DCA OPH + JMS I [OADD + JMS I [AL1 /FAC=ORIGINAL FAC*10 + TAD ACH /GET OVERFLOW + JMS DIGIT /PRINT IT + ISZ T /LOOP FOR SPECIFIED NUMBER + JMP DGLOOP + JMP I DIGITS /RETURN + +DIGIT, 0 /ROUTINE TO OUTPUT A DIGIT + TAD [60 + JMS I [FMTOUT /TRIVIAL, ISN'T IT? + JMP I DIGIT + PAGE + /I,G,E,F INPUT CONVERSION + +IGEFIN, STA /OD CONTAINS SCALING IF NO D.P. IN INPUT + DCA DPSW /INITIALIZE D.P. SW + STA + DCA INESW /DITTO EXPONENT SWITCH + TAD W + CMA + DCA FMTNUM /GET CHAR COUNT +INERSM, DCA ACX /RE-ENTER HERE AFTER SEEING "E" + DCA ACH /CLEAR FLOATING AC + DCA ACL + STA + JMP INMINS /SET SIGN PLUS + +INGCH, JMS I [FMTIN /GET A CHAR + JMS I [CHTYPE /CLASSIFY IT + 1234; IDIGIT /DIGIT + -56; INDCPT /. + -53; INLOOP /+ + -55; INMINS /- + -5; INE /E + -40; IBLDIG /BLANK - TREAT LIKE 0 IN FORTRAN STANDARD + -54; INEONM /, + 0 /OTHER - ERROR +INER, JMS I ERR + +INDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER D.P. + ISZ DPSW /TEST AND SET D.P. SWITCH + JMP INER /WHOOPS - TWO D.P.S IN A NUMBER + JMP INLOOP /KEEP GOING + +IBLDIG, TAD EOLSW /SINCE THE BLEEPING STANDARD DOESN'T COVER + SZA CLA /TELETYPE I/O, WE KEEP SOME COOL BY IGNORING + JMP INLOOP /BLANKS CREATED BY EARLY LINE TERMINATION. + +IDIGIT, TAD CHCH + DCA DGT+1 /SAVE THE DIGIT + JMS I [FPGO /FORM 10*FAC + DIGIT IN FAC + ACMDGT + TAD DPSW + SNA CLA + ISZ OD /BUMP DIGIT COUNT IF D.P. SEEN + JMP INLOOP + INMINS, DCA I [FFNEG /SET SIGN NEGATIVE + +INLOOP, ISZ FMTNUM + JMP INGCH /LOOP UNTIL WIDTH EXHAUSTED +INEONM, ISZ I [FFNEG /CHECK IF SIGN NEGATIVE + JMS I [FFNEG /YES - NEGATE + ISZ INESW /SEE IF "E" SEEN + JMP FIXUPE /YES - WE HAVE EXPONENT, NOT NUMBER + TAD PFACTX /NO "E" SEEN - SCALE USING P FACTOR + +SCALIN, TAD OD /GET SCALING FACTOR + STL + SNA + JMP I (IGEF /NO SCALING NECESSARY + SMA + CIA CLL /AC CONTAINS MAGNITUDE, LINK CONTAINS SIGN + DCA OD + RTL + RAL /AC CONTAINS 0 IF DIVIDE, 4 IF MULTIPLY + TAD (FDIV10 + DCA IGEFOP + JMS I [FPGO /MULTIPLY OR DIVIDE BY 10.0 +IGEFOP, 0 + ISZ OD + JMP IGEFOP-1/MULT OR DIV APPROPRIATE NUMBER OF TIMES + JMP I (IGEF /RETURN FOR MORE + +INE, ISZ INESW /SEE IF THIS IS THE SECOND "E" + JMP INER /YES - ERROR + ISZ DPSW /FORCE DP SW ON (TO INHIBIT D.P. AFTER E) + TAD OD /USE SCALE FACTOR ONLY IF D.P. SEEN + DCA SCALE /SAVE SCALE FACTOR + ISZ I [FFNEG + JMS I [FFNEG /GET SIGN OF NUMBER CORRECT + JMS I [FPGO /SAVE IT TEMPORARILY + FSTTM2 + JMP INERSM /GO COLLECT EXPONENT + +FIXUPE, JMS I [FFIX + TAD ACI /GET EXPONENT + CIA + TAD SCALE /ADD IN EXPONENT TO D.P. SCALE FACTOR + DCA OD + JMS I [FPGO /GET NUMBER BACK IN FAC + FLDTM2 + JMP SCALIN + +DPSW, 0 +DGT, 13;0;0;0;0;0 +NOTG, JMS I (DIGCNT + DCA SCALDN + TAD IFLG + SNA CLA + JMP NOTI + TAD SCALE + TAD (-7 + SPA CLA +NOTI, TAD SCALDN + JMP I (OUTNUM + SCALDN, 0 /SUBROUTINE TO SCALE THE FAC LESS THAN 1.0 + TAD ACX + SPA SNA CLA /IS THE FAC => 1.0? + JMP I SCALDN /NO - WE'RE DONE + JMS I [FPGO /DIVIDE BY TEN + FDIV10 + ISZ SCALE /BUMP POWER OF TEN + 0 /BACKUP FOR WIDTH + JMP SCALDN+1 /LOOP + +ASTRSK, 0 + CIA + DCA T + TAD (52 + JMS I [FMTOUT + ISZ T + JMP .-3 + JMP I ASTRSK /GET NEXT ELEMENT + +INESW, 0 /"E SEEN" SWITCH ON INPUT + PAGE + /L AND X FORMATS , T FORMAT INPUT + +TFMTIN, JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY + CLA /BY FETCHING AND WASTING A CHARACTER + TAD (INBUFR + DCA INXR + DCA EOLSW /SET TO BEGINNING OF LINE + JMP XFMT +XFMTIN, JMS I [FMTIN +H7600, 7600 /WASTE AN INPUT CHAR +XFMT, JMS I [MORE /ANY MORE CHARS? + TAD RWFLAG /YES - IN OR OUT? + SMA CLA + JMP XFMTIN /IN +TPPLBL, TAD [40 /HERE WITH AC=13 TO OVERPRINT ON T OUTPUT + JMS I [FMTOUT /OUT + JMP XFMT + +LINGCH, JMS I [FMTIN + JMS I [CHTYPE /GET AND CLASSIFY CHARACTER + -40; LINLP /BLANK + -24; LINTRU /T + -6; LINFLS /F + 0 /OTHER - ERROR + JMP I (INER + +LINTRU, TAD (4001 +LINFLS, CLL RAR /PUT EITHER 0.0 OR 1.0 IN THE FAC + DCA ACH + DCA ACL + RAL + DCA ACX +LINLP, ISZ W + JMP LINGCH /LOOP ON FIELD WIDTH + +LNXT, JMS I [GETLMN /GET NEXT ELEMENT FOR I/O +LFMT, TAD D + CMA + DCA W /SAVE WIDTH AS A COUNT + JMS I [SKPOUT /IN OR OUT? + JMP LINFLS /IN + CLA IAC + TAD W + JMS I (OBLNKS /OUTPUT W-1 BLANKS + TAD ACH + SZA CLA + TAD (16 + TAD (6 /NON-ZERO IS TRUE, ZERO FALSE + JMS I [FMTOUT /OUTPUT T OR F + JMP LNXT /NEXT VICTIM + /T FORMAT OUTPUT AND RANDOM SUBROUTINES + +TFMT, TAD D + CIA + DCA N /USE N TO FAKE OUT "X" FMT ROUTINE + TAD RWFLAG + SMA CLA + JMP TFMTIN /INPUT + TAD N + TAD EOLSW /COMPARE DESIRED POSITION WITH CURRENT ONE + SPA + JMP TPBLNK /AFTER - SPACE TO IT + JMS EOLINE /OUTPUT CR AND ZERO EOLSW + JMS I [MORE /KLUDGE FOR "T1" FORMAT + TAD (13 /FAKE X FORMAT INTO PRINTING + JMP TPPLBL /A + AND (N-1) SPACES +TPBLNK, DCA N /SAVE DIFFERENCE BETWEEN POSITIONS + JMP XFMT /GO SPACE OUT + +EOLINE, 0 /SUBROUTINE TO TERMINATE I/O LINE + TAD RWFLAG /CAUTION - AC LO-ORDER BITS MAY NOT BE 0 + SPA CLA /INPUT OR OUTPUT? + JMP EOOUTL /OUTPUT + JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY + CLA + TAD (INBUFR-1 + DCA INXR /SET XR TO NEGATIVE WORD AT THE + JMP .+3 /BEGINNING OF THE INPUT BUFFER +EOOUTL, TAD (7715 + JMS I [FMTOUT /OUTPUT A CARRIAGE RETURN + DCA EOLSW /CLEAR EOLSW FOR INPUT AND OUTPUT + JMP I EOLINE + /ROUTINE TO MOVE A HANDLER INTO FIELD 0 + +GETHND, 0 /HANDLER CODE WORD IN AC ON ENTRY + DCA HCW /SAVE HANDLER CODE WORD + TAD [7774 + AND HCW /KNOCK OUT ION AND FORMS CTL BITS + CIA + SZA /IF HANDLER IS NOT RESIDENT, + TAD HKEY /SEE IF THE HANDLER IS ALREADY + SNA CLA /IN THE HANDLER AREA IN FIELD 0 + JMP HINF0 /YES + TAD HCW /NO - PUT IT THERE + AND [70 + TAD HCDF0 + DCA HNDCDF /GET CDF TO FIELD IN WHICH HANDLER RESIDES + TAD HCW + AND H7600 + TAD (-1 /GET POINTER TO HANDLER ADDRESS + DCA XR1 /IN THAT FIELD + TAD (HPLACE-1 + DCA XR /ALSO TO HANDLER AREA IN FIELD 0 + TAD [7400 /SET UP COUNT OF 7400 + DCA HKEY /INDEPENDENT OF HANDLER SIZE +HNDCDF, HLT + TAD I XR1 +HCDF0, CDF 0 + DCA I XR /MOVE HANDLER INTO HANDLER AREA + ISZ HKEY + JMP HNDCDF + TAD [7774 + AND HCW + DCA HKEY /SET NEW KEY CODE WORD +HINF0, CLA IAC + AND HCW + SNA CLA /INTERRUPTS ALLOWED? +YHIOF, IOF /NO - TOO BAD + ISZ CTCINH /INHIBIT ^C DURING HANDLER CALL + JMP I GETHND +HKEY, 0 +HCW, 0 + PAGE + /CHARACTER INPUT ROUTINE - LINE AT A TIME + +FMTIN, 0 + TAD EOLSW + SNA /END OF LINE ALREADY FOUND? + TAD I INXR /NO - GET CHAR FROM LINE BUFFER + SPA /TIME TO READ A NEW LINE? + JMP READLN /YES + SNA /END OF LINE? + JMP INEOL /YES - SET INDICATOR + AND [77 /CONVERT TO SIXBIT + JMP I FMTIN /RETURN WITH IT +INEOL, TAD [40 +UNPKLN, DCA EOLSW /SET EOL INDICATOR TO A BLANK + JMP FMTIN+1 /AND RETURN BLANKS FROM HERE ON IN +READLN, DCA EOLSW /USE EOLSW AS A COUNT SO IT WINDS UP 0 + TAD HAND + TAD (-TTY + SNA CLA /IS IT TELETYPE INPUT? + STA /YES - SET TTY FLAG + DCA TTYFLG + JMS ECHO +TTYLF, 12 /ECHO LF IF TTY INPUT + TAD [12 /TTYLF IS ZEROED BY ABORTO + DCA TTYLF + +READLP, CLA + TAD HAND + SPA CLA /CHARACTER ORIENTED DEVICE? + JMP MASSIN /NO - UNPACK CHAR FROM BUFFER + JMS I HAND /GET A CHARACTER +GOTCHR, AND [177 /STRIP OFF PARITY + JMS I [CHTYPE /CLASSIFY IT + -15; INCRET /CARRIAGE RETURN + -177; RUBOUT /RUBOUT + -11; INTAB /TAB + -25; CTRLU /^U + -32; INEOF /^Z + 0 /ANYTHING ELSE + TAD CHCH + TAD [-40 + SMA /IF CHARACTER IS >37, + JMS INPUTC /STORE IT AND ECHO IT IF TTY + JMP READLP + /CHARACTER INPUT ROUTINE - SPECIAL CHARACTER HANDLERS + +INTAB, JMS INPUTC /TAB - INSERT (AND ECHO) BLANKS + TAD INXR + AND [7 + SZA CLA /UNTIL A COLUMN MULTIPLE OF 8 IS REACHED + JMP INTAB + JMP READLP + +RUBOUT, TAD EOLSW + CIA + TAD I (INBUFR /IGNORE RUBOUTS IF LINE EMPTY + AND TTYFLG + SNA CLA + JMP READLP /OR IF NON-TTY INPUT + JMS ECHO + 134 /ECHO A BACKSLASH +IBAKUP, STA + TAD INXR + DCA INXR /BACK UP LINE POINTER + STA + TAD EOLSW + DCA EOLSW /AND CHAR COUNTER + JMP READLP + +INEOF, TAD VEOFSW /CHECK SWITCH SET BY "CHKEOF" LIBRARY ROUTINE + SNA /WAS HE EXPECTING AN EOF? +EOFERR, JMS I ERR /NO + JMS I MCDF + DCA .+1 + HLT /CDF TO FIELD OF INDICATOR VARIABLE + AC2000 + DCA I VEOFSW+1 /SET VARIABLE TO .5 + CDF 0 /FALL INTO CARRIAGE RETURN CODE + +INCRET, DCA I INXR /CARRIAGE RETURN - ZERO OUT REST OF LINE + SKP +CTRLU, STA /SNEAKY, SNEAKY! + TAD (INBUFR + DCA INXR /RESET XR TO FETCH LINE CHARS + JMS ECHO + 15 /ECHO THE C.R. + JMP UNPKLN /BACK TO FETCH FIRST CHAR + +INPUTC, 0 /ROUTINE TO STORE AND ECHO A CHAR + TAD [40 + DCA INTMP + JMS ECHO +INTMP, 0 /ECHO CHAR IF TTY INPUT + TAD INTMP + DCA I INXR /STORE CHAR IN LINE BUFFER + ISZ EOLSW + JMP I INPUTC /RETURN IF NO OVERFLOW + JMP IBAKUP /IGNORE CHAR IF OVERFLOW + ECHO, 0 /ROUTINE TO ECHO CHAR IF TTY INPUT + TAD I ECHO /GET CHAR + AND TTYFLG + SZA /SHOULD WE ECHO? + JMS I HAND /YES + JMP I ECHO /RETURN TO CHARACTER - ITS SMALL +TTYFLG, 0 + +/CHARACTER INPUT ROUTINE - MASS STORAGE SECTION + +MASSIN, JMS MASBMP /GET BUFFER FIELD AND CHAR NUMBER + JMP INLORD /CHAR 1 OR 2 - STRAIGHTFORWARD + JMS I (GETCH3 /USE COMMON SUBROUTINE + JMP MASICM /GO TO COMMON CODE + +INLORD, JMS I [MASSIO /CHECK IF WE SHOULD READ IN A BUFFERLOAD + JMS BUFFLD /SET FIELD OF BUFFER + TAD I CHRPTR +MASICM, ISZ CHRPTR /GET THE CHAR (IN LOW 8 BITS) AND BUMP PTR + NOP /WATCH END OF FIELD FUNNYBUSINESS! + CDF 0 /RESET DATA FIELD + JMP GOTCHR /GO EXTRACT SEVEN BIT CHARACTER + +MASBMP, 0 + JMS BUFFLD /SET TO BUFFER'S DATA FIELD + ISZ CHRCTR /BUMP CHAR COUNTER + JMP I MASBMP /CHAR 1 OR 2 - NO SWEAT + AC7775 + DCA CHRCTR /CHAR 3 - RESET CHAR CTR + AC7776 + TAD CHRPTR /BUMP BACK CHAR PTR + DCA CHRPTR + ISZ MASBMP + JMP I MASBMP /SKIP RETURN + PAGE + /CHARACTER OUTPUT ROUTINE + +FMTOUT, 0 + TAD [40 /FIRST CONVERT SIXBIT TO ASCII + SMA /CTL CHARS COME IN NEGATIVE + AND [77 + TAD (240 + DCA OCHAR /SAVE ASCII CHAR (WITHOUT PARITY BIT) + TAD EOLSW + SZA CLA + JMP NOT1ST /FIRST CHAR IS DECODED FOR FORMS CONTROL + AC0002 /CHECK TO SEE IF THIS UNIT + AND HCODEW /SHOULD RECEIVE FORMS CONTROL + SZA CLA + JMP LFPLCH /NO - JUST PRINT A LINE FEED AND THE CHAR + TAD OCHAR + JMS I [CHTYPE /CLASSIFY CONTROL CHAR + -261; OUTFFX /1 - TOP OF FORM + -260; OUT2LF /0 - DOUBLE SPACE + -253; NOLF /+ - OVERPRINT + 0 /ANYTHING ELSE - SINGLE SPACE + JMP OUTLF + +OUTFFX, TAD HAND + TAD (-TTY /IF HANDLER IS TTY OUTPUT TWO LINE FEEDS + SZA CLA /INSTEAD OF A FORM FEED + JMP OUTFF +OUT2LF, TAD [12 + DCA OCHAR /SET 2ND CHAR TO LINE FEED +LFPLCH, STA + DCA EOLSW /SET SWITCH FOR 2ND CHAR + TAD OCHAR + DCA CHCH /SAVE CHARACTER AWAY +OUTLF, AC7776 +OUTFF, TAD F214 /SUBSTITUTE THE APPROPRIATE FORM CONTROL + DCA OCHAR /FOR THE CHARACTER +NOT1ST, TAD HAND + SPA CLA /CHARACTER ORIENTED DEVICE? + JMP MASOUT /NO - PACK CHAR INTO BUFFER + TAD OCHAR + JMS I HAND /OUTPUT CHAR +NOLF, ISZ EOLSW /BUMP CHAR CTR + JMP I FMTOUT /NO - RETURN + TAD CHCH /AHA - ANOTHER CHARACTER SHOULD BE OUTPUT + JMP OUTFF+1 /GO TO IT + /CHARACTER OUTPUT - MASS STORAGE OUTPUT + +MASOUT, JMS I (MASBMP /GET BUFFER FIELD AND CHAR NUMBER + JMP OULORD /CHAR 1 OR 2 - STRAIGHTFORWARD + JMS OSUBR /CHAR 3 - PACK FIRST HALFBYTE + JMS OSUBR /PACK SECOND HALFBYTE + AC4000 + JMS MASSIO /CHECK IF WE SHOULD DUMP THE BUFFER +MASOCM, CDF 0 + JMP NOLF /GO RETURN OR REENTER + +OULORD, TAD OCHAR + DCA I CHRPTR /STORE CHAR, ZAPPING HIGH-ORDER BITS + ISZ CHRPTR /BUMP CHAR PTR +F214, 214 /GUARD AGAINST OVFLO + JMP MASOCM /RETURN + +OSUBR, 0 /ROUTINE TO PACK A HALFBYTE + TAD OCHAR + CLL RTL + RTL /SHIFT CHAR 4 LEFT + DCA OCHAR + TAD I CHRPTR /CLEAR OUT ANY RESIDUE + AND [377 /FROM HIGH-ORDER OF BUFFER WORD + DCA I CHRPTR /IN CASE WE ARE WRITING AFTER A BACKSPACE. + TAD OCHAR + AND [7400 /GET 4 BITS + TAD I CHRPTR + DCA I CHRPTR /ADD INTO HIGH-ORDER OF BUFFER WORD + ISZ CHRPTR /BUMP POINTER + 200 /OVERFLOW! + JMP I OSUBR + +MASSIO, 0 /SUBROUTINE TO READ/WRITE BUFFER IF NECESSARY + CDF 0 + TAD BUFCDF /ADD BUFFER CDF TO R/W BIT IN AC + TAD (-6001 /TAKE AWAY CDF, LEAVE BIT 4 ON + DCA IOCTL /STORE I/O CONTROL WORD + TAD CHRPTR + AND [377 + SZA CLA /SEE IF POINTER IS AT BUFFER BOUNDARY + JMP I MASSIO /YES - RETURN DOING NOTHING + TAD RELBLK + TAD STBLK /STORE BLOCK # IN HANDLER CALL + DCA BLOCK + TAD BADFLD + AND [7400 + DCA BUFFER /STORE BUFFER ADDRESS IN HANDLER CALL + /CHARACTER OUTPUT - BUFFER I/O ROUTINE CONTINUED + + TAD TOTBLK + CIA CLL + TAD RELBLK + SZL CLA /CHECK FOR FILE OVERFLOW +IOVFLO, JMS I ERR /YES - ERROR + TAD HCODEW + JMS I (GETHND /GET HANDLER INTO FIELD 0 + JMS I HAND /CALL HANDLER +IOCTL, 0 +BUFFER, 0 +BLOCK, 0 + SMA CLA /HANDLER ERROR - ABORT + SKP /IF NOT EOF +IOERR, JMS I ERR + JMS I (RECOVR /CLEAR ANY FLAGS SET BY OS8 HANDLER + ISZ RELBLK /BUMP RELATIVE BLOCK NUMBER + TAD BUFFER + DCA CHRPTR /RESET CHAR PTR + JMP I MASSIO /RETURN +/FPP CODE FOR I/O CONVERSION + +FDIV10, FDIV+LONG + TEN + FEXIT +OCHAR, 0 /*** NEEDED FOR PADDING *** +FMUL10, FMUL+LONG /FMUL10 MUST BE AT FDIV10+4 + TEN + FEXIT + +FWTOBL, FSUB+LONG + ONE + FDIV+LONG + FLTG85 + FEXIT + PAGE + /UNFORMATTED (BINARY) INPUT-OUTPUT + +RWUNF, JMS I [RWINIT /"READ(N)" OR "WRITE(N)" + 1000 /"UNFORMATTED" BIT + TAD SZLCLA /ENABLE SEQUENCE CHECKING +UNFIO, DCA SEQCHK /*** SET SEQCHK TO "SZL CLA" OR "CLA" + DCA RECCTR /ENTER HERE FROM DIRECT ACCESS + TAD HAND + SMA CLA /CHECK FOR MASS-STORAGE HANDLER + JMP I [UNTERR /NO - ERROR + JMS I [GETLMN /GET FIRST VARIABLE + TAD RWFLAG + SPA CLA +RSETBP, TAD (125 /INITIALIZE COUNT TO -86 FOR WRITE, + CMA /-1 FOR READ + DCA CHRCTR + TAD BADFLD + AND [7400 + DCA BIOPTR /INITIALIZE BUFFER POINTER + TAD BADFLD + AND [70 + IAC + CLL RTR /AC BIT 0 NOW ON + TAD RWFLAG /AC BIT 0 CONTAINS COMP. OF R/W FLAG + CLL RAR /AC=(.NOT.RW)*2000+BUFFER FIELD + TAD (FSTA+LONG /AC=(FSTA OR FLDA) + BUFFLD + DCA FGPBF + JMP UIOVLP /SKIP FIRST VARIABLE FETCH/STORE +BFINCR, JMS I [FPGO + FGPBF /LOAD OR STORE A BUFFER ENTRY + ISZ BIOPTR + ISZ BIOPTR /INCREASE BUFFER POINTER + ISZ BIOPTR + JMS I [GETLMN /GET A VARIABLE FROM THE CALLING PROGRAM +UIOVLP, TAD RWFLAG + CLL RAR /LOWORDER BIT OF RWFLAG = END LIST FLAG + SZL CLA + JMP ENDUIO /NO MORE VARIABLES - TERMINATE + ISZ CHRCTR /BUMP COUNTER + JMP BFINCR /ROOM IN BUFFER - MOVE VARIABLE + JMS UDOIO /GET A NEW BUFFER + JMP RSETBP /RESET BUFFER POINTERS AND COUNTERS + +ENDUIO, TAD RWFLAG /COME HERE WHEN I/O LIST EXHAUSTED + SPA CLA /WRITE? + JMS UDOIO /YES - WRITE OUT THE LAST BUFFER + JMP I [ENDIO /RESTORE DSRN ENTRY AND QUIT + +RECCTR, 0 + /DIRECT-ACCESS I/O + +RWDACC, JMS I [RWINIT /"READ(N'R)" OR "WRITE(N'R)" + 1000 /DIRECT ACCESS IS UNFORMATTED I/O + TAD I XR + DCA T /GET BLOCKS/RECORD FACTOR FROM D.A. TABLE + JMS I [ARGLD /GET RECORD NUMBER + JMS I [FFIX /CONVERT TO INTEGER + TAD T + TAD ACI + ISZ T /MULTIPLY RECORD NUMBER BY BLOCKS/RECORD + JMP .-2 /TO GET RELATIVE BLOCK NUMBER + DCA RELBLK + TAD I XR + SNA /THIS LOC SHOULD NOT BE ZERO! +DAERR, JMS I ERR + DCA FGPBF /IT SHOULD BE AN FSTA + THE FIELD + TAD I XR /IN WHICH THE CONTROL VARIABLE IS + DCA BIOPTR /STORED. THE NEXT WORD IS THE ADDRESS + JMS I [FPGO /OF THE CONTROL VARIABLE IN THAT FIELD + FADD1 /ADD 1 TO RECORD # AND STORE IN CONTROL VAR + TAD DUMPIT /*K* "DCA T" SAME AS "CLA" HERE + JMP UNFIO /NOW GO DO A REGULAR BINARY READ/WRITE + +UDOIO, 0 + ISZ RECCTR /BUMP NUMBER OF RECORDS TRANSFERRED + TAD BADFLD + AND [7400 + TAD [377 /FORM POINTER TO LAST WORD IN BUFFER + DCA BIOPTR + TAD RECCTR + JMS BUFFLD + DCA I BIOPTR /FOR WRITE, PUT RECORD NUMBER IN 256TH WORD +UDOIOL, DCA CHRPTR + AC4000 + AND RWFLAG + JMS I [MASSIO /DO I/O (CHRPTR=0 TO FORCE I/O) + JMS BUFFLD + TAD RECCTR + CMA STL /FOR READ, CHECK THE INPUT + TAD I BIOPTR /SEQUENCE NUMBER TO MAKE SURE IT IS + CDF 0 /NO LARGER THAN THE ONE WE EXPECT. +SEQCHK, SZL CLA /*K* IF IT IS LARGER THIS IMPLIES THAT WE + JMP I UDOIO /ARE STILL IN THE MIDDLE OF THE LAST + JMP UDOIOL /RECORD AND SO WE READ AGAIN. + /DEFINE FILE PROCESSOR + +DFINE, JMS I [RWINIT /SET UP A POINTER INTO THE D.A. TABLE + 1000 /DIRECT ACCESS I/O IS UNFORMATTED + JMS I [ARGLD /GET NUMBER OF RECORDS + JMS I [FFIX + TAD ACI + CIA +DUMPIT, DCA T /SAVE IT FOR MULTIPLY + JMS I [ARGLD /GET THE NUMBER OF WORDS/RECORD + JMS I [FPGO /CONVERT WORDS TO BLOCKS + FWTOBL + JMS I [FFIX /CONVERT TO INTEGER + ISZ ACI + TAD ACI /MULTIPLY THE NUMBER OF BLOCKS/RECORD + ISZ T /BY THE NUMBER OF RECORDS + JMP .-2 + DCA RELBLK /TO GET THE FILE LENGTH IN BLOCKS + TAD ACI + CIA + DCA I XR /STORE NUMBER OF BLOCKS/RECORD + JMS I [ARGLD /GET POINTER TO CONTROL VARIABLE + TAD FGPBF + TAD (FSTA-FLDA /CHANGE A LOAD TO A STORE + DCA I XR /SAVE "FSTA CONTROL-VARIABLE" + TAD BIOPTR + DCA I XR + TAD TOTBLK + CMA CLL + TAD RELBLK /MAKE SURE WE HAVE ROOM FOR THE FILE +SZLCLA, SZL CLA +DFERR, JMS I ERR /WE DON'T + AC7776 + AND FFLAGS + IAC /FORCE "END-FILED" BIT FOR CLOSE + JMP I (SETTOT /SET LENGTH AND EXIT + PAGE + /SWAPPER AND ERROR ROUTINE + +SWAP, JMS I [FETPC /SWAPPER CALLING SEQUENCE: + DCA T / TRAP3 SWAP + TAD T / ADDR OVLY*4000000+LVL*100000+ENTRYADR + AND [7 + TAD (JA + DCA STRTUP /STORE JA TO ENTRY POINT + JMS I [FETPC + DCA STRTUP+1 + TAD T + AND [70 + CLL RAR /FORM 4*LVL + TAD (OVLYTB /INDEX INTO LEVEL TABLE + DCA ADR + TAD T + AND [7400 + DCA T /T CONTAINS OVERLAY NUMBER IN BITS 0-3 + CDF 0 /WATCH D.F.! + TAD I ADR + TAD T /SEE IF THIS OVERLAY IS IN CORE + SNA CLA + JMP ITSIN /YES - DON'T LOAD + TAD T + CIA + DCA I ADR /MARK THIS OVERLAY IN CORE (OPTIMIST) + ISZ ADR + TAD I ADR + AND [7400 + DCA OVADR /SAVE INITIAL OVERLAY LOAD ADDRESS + TAD I ADR + AND [70 + DCA OVIOW /AND FIELD + ISZ ADR + TAD I ADR /GET STARTING BLOCK OF THIS LEVEL + DCA OVBLK + ISZ ADR + TAD I ADR + DCA OVLEN /STORE LENGTH OF OVERLAY IN BLOCKS +OVADLP, TAD T /LEVEL STARTING BLOCK + + SNA /(OVERLAY #) * (OVERLAY LENGTH) + JMP LOADOV /= OVERLAY STARTING BLOCK + TAD [7400 + DCA T + TAD OVBLK + TAD OVLEN + DCA OVBLK + JMP OVADLP + /SWAPPER - CONTINUED + +LOADLP, DCA OVLEN /STORE UPDATED OVERLAY LENGTH + TAD OVIOW /GET LAST READ CONTROL WORD + RAL + AND [7400 /CONVERT BLOCK COUNT TO WORD COUNT + TAD OVADR /INCREMENT OVERLAY LOAD ADDRESS (LINK = 0) + DCA OVADR + RTL + RTL /USE THE CARRY + TAD OVIOW /TO INCREMENT THE LOAD FIELD IF NECESSARY + AND [70 + DCA OVIOW /OVIOW CONTAINS ONLY THE LOAD FIELD NOW + +LOADOV, TAD OVADR + CIA /LOTSA CALCULATIONS HERE - OS/8 HANDLERS + SNA /CAN'T READ MORE THAN 15 BLOCKS AT A TIME + TAD [7400 /AND CANNOT READ OVER FIELD BOUNDARIES + CLL RTL + RTL /SO WE MUST BREAK UP THE OVERLAY READ + CMA CML RAL /INTO SEVERAL SMALL READS OF MAXIMAL LENGTH. + TAD OVLEN /THE NUMBER OF BLOCKS TO READ IS GIVEN BY: + CMA /MINIMUM(B,L,15) + SMA /WHERE B IS THE # OF BLOCKS LEFT IN THIS FIELD + CLA /AND L IS THE # OF BLOCKS LEFT IN THE OVERLAY + TAD OVLEN /AND 15 IS THE # OF BLOCKS A HANDLER CAN READ + DCA T / ANSWER IN T + TAD T + CLL RTR + RTR + RTR /TURN NUMBER OF BLOCKS INTO 0S/8 BLOCK COUNT + TAD OVIOW + DCA OVIOW /ADD FIELD BITS AND STORE AS I/O CONTROL WD + TAD OVHCDW /GET OVERLAY HANDLER CODE WORD + JMS I (GETHND /LOAD HANDLER INTO FIELD 0 + JMS I OVHND +OVIOW, 0 +OVADR, 0 +OVBLK, 0 +OVERR, JMS I ERR /WHOOPS - OVERLAY READ ERROR + JMS RECOVR /CLEAR ANY NASTY FLAGS LEFT BY HANDLER + TAD T + TAD OVBLK + DCA OVBLK /UPDATE BLOCK NUMBER + TAD T + CIA + TAD OVLEN /BUMP DOWN RECORD COUNT + SZA /SEE IF WE ARE DONE + JMP LOADLP /NO - PREPARE FOR NEXT READ + /OVERLAY IN CORE - EXECUTE IT + +ITSIN, JMS I [FPGO /START UP FPP + STRTUP /AND JA TO ENTRY POINT + +TRAP5I, +TRAP6I, +TRAP7I, +FPAUSE, +FPPERR, JMS I ERR /SHOULD NEVER GET HERE + +STRTUP, 0;0 /JA ENTRY +OVLEN, 0 +OVHND, 0 /SET BY LOADER +OVHCDW, 0 /SET BY LOADER + +RECOVR, 0 /ROUTINE TO CLEAN UP ANY FLAGS + DCA CTCINH /LEFT ON BY SLOPPY OS/8 HANDLERS. +YRCOVR, NOP + NOP + NOP + NOP /RIGHT NOW I DON'T KNOW OF ANY. + NOP + NOP + NOP + NOP + ION + JMP I RECOVR + +FSTTMP, FSTA+LONG + FTEMP + FEXIT + +TEN, 4;2400;0;0;0;0 /10.0D0 +FLTG85, 7;2520;0 /85.0 + PAGE + /INPUT BUFFER - CONTAINS STARTUP CODE + +INBUFR, -206 /LENGTH + 0 /INPUT LINE BUFFER - FIRST A LITTLE PADDING, + +/RTS EXECUTION INITIALIZATION - IN INPUT BUFFER + +FPSTRT, 6601 /CLEAR DF32 FLAG + PCF /HSP FLAG + RRB /HSR FLAG +PP7600, 7600 /CLEAR READER CHAR + 6135 /CLEAR KW12 OR DK8-EP EVENT FLAGS + CLA + 6132 /STOP KW12 CLOCKS + 6134 /DISABLE KW12 INTERRUPTS + 6530 /CLEAR AD8-EA FLAGS + 6050 /CLEAR VC8/E FLAG + 6500 /DISABLE XY8/E INTERRUPTS + STA + 6130 /DISABLE DK8-EP INTERRUPTS + CLA /LEAVE SPACE FOR ADDITIONAL CLEARS + NOP + NOP + NOP + NOP + NOP + NOP + NOP + NOP + NOP + NOP + NOP + DCA EOLSW +LDPROG, JMS I [FPGO /START UP FPP OR PSEUDO-FPP + STSWAP +HLTNOP, NOP /SET TO HLT IF /H SPECIFIED, + JMP PRTCR /SKP IF /P SPECIFIED + TAD .-1 + DCA LDPROG /BYPASS LOADING ON STARTUP + TAD PCHWD /HLT + DCA I (PDPXIT+1 + /ROUTINE TO PUNCH RTS+PROGRAM ON FORTRAN UNIT 9 (UNCOMMENTED) + +PPTR, TAD P11 +PCKSUM, DCA ACI + JMS I (LDDSRN + SMA CLA + JMP I [UNTERR + JMP LDRTLR +FLDLP, DCA PPTR + DCA PCKSUM + TAD (100 + JMS SIXOUT + JMS SIXOUT + TAD FLD + AND [70 +JFMOUT, JMS I [FMTOUT /*K* ONLY WORKS FOR FIELD 0-3 + TAD (100 + JMS SIXOUT + JMS SIXOUT +FLD, CDF 0 + TAD I PPTR + CDF 0 + JMS PCHWD + ISZ PPTR +P11, 11 + ISZ PCTR + JMP FLD + TAD PCKSUM + JMS PCHWD + TAD FLD + TAD (10 + DCA FLD +LDRTLR, TAD PP7600 + DCA ACH + TAD [200 + JMS SIXOUT + ISZ ACH + JMP .-3 + ISZ FCNT + JMP FLDLP + TAD (6000 + DCA FFLAGS + DCA I (ENDFLS /*K* SAME KLUDGE AS CALXIT + JMS I (ENDFL + DCA I (PDPXIT+1 /WIPE HALT SO WE CAN RETURN TO OS/8 + JMP I (PDPXIT-1 + PCHWD, HLT + DCA ACH + TAD ACH + RTR + RTR + RTR + AND [77 + JMS SIXOUT + TAD ACH + AND [77 + JMS SIXOUT + JMP I PCHWD + +SIXOUT, 0 + DCA T + CLA IAC + DCA EOLSW + TAD PCKSUM + TAD T + DCA PCKSUM + TAD T + TAD (-300 + JMS I [FMTOUT + JMP I SIXOUT + +PCTR, 200 /DON'T PUNCH 07600! +FCNT, 0 + PRTCR, TAD (215 + JMS I PTTY /PRINT CARRIAGE RETURN + TAD JFMOUT + DCA I (ERRENB /ENABLE ERROR TRACEBACK + JMS I [FPGO + STJUMP /NOW JUMP TO THE NEWLY-LOADED CODE +STSWAP, TRAP3 /TRAP3 + SWAP + 0 + .+1 + TRAP3 + HLTNOP + PAGE +STJUMP, 0 + 0 + ZBLOCK INBUFR+210-. /PAD OUT TO END OF BUFFER + /OVERLAY AND DSRN TABLES + + *.-4 /FIRST ENTRY IN OVLYTB ONLY NEEDED TO LOAD MAIN PGM + +OVLYTB, ZBLOCK 40 /OVERLAY TABLE + +DSRN, PTR; ZBLOCK 10 + PTP; ZBLOCK 10 + LPT; ZBLOCK 10 + TTY; 0;0 + 1234 /*K* PREVENT PROBLEM IN + ZBLOCK 5 /RWINIT INVOLVING WRITE + /AFTER READ ON TELETYPE + ZBLOCK 55 + + ZBLOCK 12 /FORMAT PARENTHESIS PUSHDOWN LIST +FMTPDL, 0 /GUARD WORD + PAGE + /SOFTWARE FLOATING POINT ROUTINES WHICH ARE USED +/EVEN IF FLOATING HARDWARE IS PRESENT + +/** MUST NOT DESTROY FAC! ** + +FFIX, 0 /ROUTINE TO FIX FAC + STA /ANSWER IS RETURNED IN ACI +TADACX, TAD ACX /ABS(FAC) MUST BE LESS THAN 2048 + CLL /DETERMINE IF FAC EXPONENT IS + TAD (-13 /BETWEEN 1 AND 14 + SNA + JMP FIXBIG /14 IS A SPECIAL CASE +EAEFIX, DCA ACI + SZL + JMP FIXDNE /EXP GT 14 OR LT 1 - RETURN 0 + TAD ACH + JMP FIXISZ +FIXLP, CLL /0 IN LINK + SPA /IS IT LESS THAN 0? + CML /YES-PUT A 1 IN LINK + RAR /SCALE RIGHT +FIXISZ, ISZ ACI /DONE YET? + JMP FIXLP /NO +FIXDNE, DCA ACI /RETURN WITH ANSWER IN ACI + JMP I FFIX /RETURN + +FIXBIG, TAD ACL /IF EXP IS 14 WE MUST SHIFT AC FRACTION + RAL /LEFT ONE PLACE TO INTEGERIZE IT. + CLA + TAD ACH + RAL + JMP FIXDNE /STORE ANSWER AND RETURN + +SETB, TAD DATAF + DCA I (BASCDF /SET BASE PAGE LOCATION + TAD ADR + DCA BASADR + JMP I FPNXT + / +/SHIFT FAC LEFT 1 BIT +/ +AL1, 0 + TAD AC1 /GET OVERFLOW BIT + CLL RAL /SHIFT LEFT + DCA AC1 /STORE BACK + TAD ACL /GET LOW ORDER MANTISSA + RAL /SHIFT LEFT + DCA ACL /STORE BACK + TAD ACH /GET HI ORDER + RAL + DCA ACH /STORE BACK + JMP I AL1 /RETN. +/ +/SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE) +/ +ACSR, 0 + CMA /AC CONTAINS COUNT-1 + DCA AC0 /STORE COUNT +LOP1, TAD ACH /GET HIGH ORDER MANTISSA + CLL + SPA /PROPAGATE SIGN + CML + RAR /SHIFT RIGHT 1, PROPAGATING SIGN + DCA ACH /STORE BACK + TAD ACL /GET LOW ORDER + RAR /SHIFT IT + DCA ACL /STORE BACK + ISZ ACX /INCREMENT EXPONENT + NOP + ISZ AC0 /DONE? + JMP LOP1 /NO-LOOP + RAR + DCA AC1 /SAVE 1 BIT OF OVERFLOW + JMP I ACSR /YES-RETN-AC=L=0 +/ +/FLOATING NEGATE +/ +FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE) + TAD ACL /GET LOW ORDER FAC + CLL CMA IAC /NEGATE IT + DCA ACL /STORE BACK + CML RAL /ADJUST OVERFLOW BIT AND + TAD ACH /PROPAGATE CARRY-GET HI ORD + CLL CMA IAC /NEGATE IT + DCA ACH /STORE BACK + JMP I FFNEG + OADD, 0 /ADD OPERAND TO FAC + CLL + TAD AC2 /ADD OVERFLOW WORDS + TAD AC1 + DCA AC1 + RAL /ROTATE CARRY + TAD OPL /ADD LOW ORDER MANTISSAS + TAD ACL + DCA ACL + RAL + TAD OPH /ADD HI ORDER MANTISSAS + TAD ACH + DCA ACH + JMP I OADD /RETN. + +FETPC, 0 + ISZ PC + JMP PCCDF /NO FIELD BUMP + ISZ APT /BUMP FIELD FOR FPP RESTART (IN CASE FPP EXISTS) +FPC10, 10 /PROTECTION FOR ISZ + TAD PCCDF + TAD FPC10 + DCA PCCDF +PCCDF, HLT + TAD I PC + JMP I FETPC + +EEPUT, STL /EXTENDED PRECISION STORE +EEGET, DCA ADR /EXTENDED PRCISION FETCH + TAD [-6 + DCA DATCDF + SNL + AC2000 /SET UP "TAD ACX" OR "DCA ACX" + TAD TADACX + DCA EEINST +EELOOP, SNL /LINK=1 MEANS STORE + TAD I ADR +EEINST, HLT + SZL + DCA I ADR + ISZ ADR + SKP + JMS I (DFBUMP + ISZ EEINST + ISZ DATCDF + JMP EELOOP + JMP I FPNXT + +FSTTM2, FSTA+LONG + FTEMP2 + FEXIT +/ +FTEMP, ZBLOCK 6 +/ + PAGE + /RUN-TIME SYSTEM ERROR LIST + +ERRLST, VARGER; ARGMSG + UERR; UMSG + FPOERR; FPOMSG + FMTERR; FMTMSG + UNTERR; UNTMSG + CTLBER; CTLBMS + INER; INMSG + IOVFLO; IOVMSG + IOERR; IOMSG + DAERR; DAMSG + FPPERR; FPPMSG + OVERR; OVMSG + EOFERR; INEMSG + FPOVER; OFLMSG + DFERR; DFMSG + -1; DV0MSG /BY ELIMINATION + /RTS ERROR MESSAGES + +ARGMSG, TEXT /BAD ARG/ +UMSG, TEXT /USER ERROR/ +FPOMSG, TEXT /PARENS TOO DEEP/ +FMTMSG, TEXT /FORMAT ERROR/ +UNTMSG, TEXT /UNIT ERROR/ +INMSG, TEXT /INPUT ERROR/ +OVMSG, TEXT /OVERLAY / + *.-1 +IOMSG, TEXT %I/O ERROR% +DAMSG, TEXT /NO DEFINE FILE/ +FPPMSG, TEXT /FPP ERROR/ +INEMSG, TEXT /EOF ERROR/ +DV0MSG, TEXT /DIVIDE BY 0/ +DFMSG, TEXT /D.F. TOO BIG/ +IOVMSG, TEXT /FILE / + *.-1 +OFLMSG, TEXT /OVERFLOW/ +CTLBMS, TEXT /^B/ + +USRERR, TAD ERRFLG /USER ERROR - OPTIONALLY NON-FATAL + DCA FATAL +UERR, JMS I ERR /PRINT MESSAGE + JMP I [RETURN /IF NON-FATAL, CONTINUE PROCESSING +ERRFLG, 0 /SET TO NON-ZERO IF /E SWITCH SPECIFIED + +TRPPRT, TRAP3 /CODE WHICH IS LOADED INTO PROGRAM PROLOGUES + PRTNAM /BY THE ERROR TRACEBACK ROUTINE + PAGE + MAKCDF, 0 /ROUTINE TO MAKE A CDF FROM AC9-11 + RTL + RAL + AND [70 + TAD ERCDF /STRAIGHTFORWARD ENOUGH, ISN'T IT? + JMP I MAKCDF + +RD2WR, 0 /ROUTINE CALLED WHEN SWITCHING + STA /FROM READ TO WRITE. (CALLED ONLY ONCE!) + TAD RELBLK /BUMP BLOCK # BACK FROM "NEXT BUFFER'S BLOCK #" + DCA RELBLK /TO "THIS BUFFER'S BLOCK #". + TAD CHRCTR /HOWEVER, IF WE ARE AT THE VERY END OF A + IAC /BUFFER, WRITE ROUTINE EXPECTS US TO + SZA CLA /BE AT THE BEGINNING OF THE NEXT BUFFER, + JMS I [MASSIO /SO RE-READ THIS BUFFER AND SET POINTERS + JMP I RD2WR + +/RUN-TIME-SYSTEM ERROR ROUTINE + +ERROR, 0 +ERCDF, CDF 0 + CLA + TAD (ERRLST-2 + DCA XR +ERRLP, ISZ XR /SEARCH ERROR LIST FOR CALLING ADDRESS + TAD I XR /ERROR LIST CONTAINS + CMA + SZA /CALLING ADDRESSES AND + TAD ERROR /CORRESPONDING MESSAGES + SZA CLA + JMP ERRLP + TAD I XR + DCA I (FMTADR + DCA I (FMTDF + TAD PTTY + DCA HAND /QUICK FUDGE FOR TTY OUTPUT + DCA HCODEW /TO SET CARRIAGE CONTROL + AC4000 + DCA RWFLAG + JMS I [EOLINE /TYPE CARRET AND SET EOLSW + DCA FMTBYT /INITIALIZE MESSAGE PTR +ERPTLP, JMS I [FMTOUT /OUTPUTS LF FIRST TIME + JMS I [FMTGCH /GET CHAR USING FORMAT ROUTINES + ISZ FMTBYT + SZA + JMP ERPTLP /LOOP UNTIL 0 CHAR + /PRINT ROUTINE NAME AND LINE NUMBER + +PRTNAM, TAD [40 +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) + JMS I [FPGO /START UP FPP + GTNMPT /GET POINTER TO NAME IN FAC + TAD ACH + DCA I (FMTDF /SET UP FORMAT GET CHARACTER ROUTINE + TAD ACL /TO GET CHARACTERS OF ROUTINE NAME + DCA I (FMTADR + DCA FMTBYT + TAD [-6 + DCA ISN /6 CHARACTER NAME +PRTNML, JMS I [FMTGCH + SNA + TAD [40 /AVOID PRINTING RANDOM @S + JMS I [FMTOUT /GET AND PRINT A CHARACTER + ISZ FMTBYT + ISZ ISN + JMP PRTNML + TAD [40 + JMS I [FMTOUT /SEPARATE THE NAME BY A SPACE + TAD [-4 /FROM THE LINE NUMBER. + DCA ISN +PTLNLP, TAD ISN+1 + CLL RTL + RAL + DCA ISN+1 /PRINT LINE NUMBER IN OCTAL + TAD ISN+1 /BECAUSE THAT IS THE WAY IT APPEARS + RAL /IN THE FORTRAN PROGRAM LISTING + AND [7 + JMS I (DIGIT + ISZ ISN + JMP PTLNLP + + JMS I [EOLINE /OUTPUT FINAL CR + TAD FATAL + SNA CLA /FATAL ERROR? + JMP TRCBAK /YES - GIVE FULL TRACEBACK + DCA FATAL /"NON-FATAL" FLAG MUST BE SET EACH TIME + JMP I ERROR +TRCBAK, JMS I [FPGO /START UP FPP + UP1LEV /MOVE UP TO CALLING ROUTINE + /FPP CODE DOES A "TRAP3 PRTNAM" +ISN, 0;0 + /FPP CODE FOR ERROR ROUTINE + +GTNMPT, STARTD + XTA 0 /LOAD LINE NUMBER FROM XR 0 + FSTA+LONG + ISN /STORE AWAY + FLDA+BASE 10 /LOAD POINTER TO PROLOGUE + FSUB+LONG + THREE /NAME IS 3 LOCATIONS BEFORE PROLOGUE + STARTF /FOR NON-FPP VERSION +THREE, FEXIT;3 /*K* DEPENDS ON FACT THAT FEXIT=0 + +UP1LEV, STARTD + FLDA+BASE 11 /GET THE UPWARD POINTER + JNE + NOTMN /ZERO MEANS MAIN PROGRAM + TRAP3 +E7605, 7605 /GO AWAY IF MAIN PROGRAM +NOTMN, FSTA+BASE 0 + LDX 1 + 2 /WE WILL STORE A "TRAP3 PRTNAM" + FLDA+LONG /IN THE FIFTH LOCATION OF THE PROLOGUE, + TRPPRT + FSTA+IND 0+10 /WHERE THE FIRST 4 LOCS WERE A SETX AND SETB. + FLDA+BASE 0 /GET THE PROLOGUE ADDRESS AGAIN + JAC /JUMP TO IT. + +ACMDGT, FMUL+LONG + TEN + FSTA+LONG + FTEMP + FLDA+LONG + DGT /GET UNNORMALIZED DIGIT INTO AC + FNORM /NORMALIZE IT +FADTMP, FADD+LONG + FTEMP + FEXIT +LPBUFR, ZBLOCK 4 + LPBUF2 + PAGE + HPLACE, /ZBLOCK 400 /HANDLER SWAP AREA + +/VARIOUS INITIALIZATION STUFF OVERLAYING THE RTS HANDLER AREA + +QLHDR, 0 /SHOULD BE A 2 FOR A LOADER IMAGE +QRTSWP, ZBLOCK 2 /INITIAL SWAP ARGS TO LOAD USER MAIN +QHGHAD, ZBLOCK 2 /HIGHEST ADDRESS USED +QVERNO, 0 /LOADER VERSION # +QDPFLG, 0 /"PROGRAM USES D.P." FLAG +QUSRLV, ZBLOCK 40 /USER OVERLAY INFO + +/EAE OVERLAY TO FIX AND FLOAT + +EFXFLT, RELOC EAEFIX + +FIXEAE, CMA + DCA FIXSH /SHIFT COUNT BETWEEN 0 AND 12 + SZL + JMP FIX0 /NOT INTEGERIZABLE + TAD ACH + ASR +FIXSH, 0 +FIX0, DCA ACI + JMP I FFIX + +FXFLTC= .-FIXEAE + RELOC + /SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF +/BANKS IN AC. +/MUST RUN IN FIELD 0. + +CORE, 0 + TAD C6203 + RDF + DCA CORRET +CORELP, CDF 0 /NEEDED FOR PDP-8L + TAD I C7777 + AND COR70 /IF BITS 6-8 OF LOCATION 7777 ARE NOT ZERO, + CLL RTR /THEY SPECIFY THE LAST FIELD OF CORE + RAR /WHICH WE SHOULD USE. + SZA + JMP CORRET /SO RETURN THAT AMOUNT + TAD TRYFLD /GET FLD TO TST + CLL RTL + RAL + AND COR70 /MASK USEFUL BITS + TAD CORELP + DCA COR706 /SET UP CDF TO FLD +COR706, 0 + TAD I CORLOC /SAV CURRENT CONTENTS + NOP /HACK FOR PDP-8 + DCA .-3 + TAD .-2 /7000 IS A GOOD PATTERN + DCA I CORLOC +COR70, 70 /HACK FOR PDP-8.,NO-OP + TAD I CORLOC /TRY TO READ BK 7000 +CO7400, 7400 /HACK FOR PDP-8,.NO-OP + TAD CO7400 /GUARD AGAINST WRAP AROUND + TAD CORLOC+1 /TAD 1400 + SZA CLA + JMP .+5 /NON EXISTENT FLD EXIT + TAD COR706 /RESTORE CONTENS DESTROYED + DCA I CORLOC + ISZ TRYFLD /TRY NXT HIGHER FLD + JMP CORELP + STA + TAD TRYFLD +CORRET, 0 + JMP I CORE +CORLOC, CO7400 /ADR TO TST IN EACH FLD + 1400 /7000+7400+1400=0 +TRYFLD, 1 /CURRENT FLD TO TST +C6203, 6203 +C7777, 7777 + +DPTEST, STARTE /EXECUTED BY FPP DURING INITIALIZATION + FEXIT /CHECK WHETHER DOUBLE PRECISION ENABLED + /TABLE OF MODIFICATIONS TO MAKE TO FRTS FOR BACKGROUND OPERATION +/UNDER RTS-8. FORMAT OF TABLE IS: POINTER TO FIRST WORD OF BLOCK - 1 +/ (0 TERMINATES) FOLLOWED BY LIST OF REPLACEMENT WORDS (0 TERMINATES). + +BKRLST, YLPT-1 /LINE PRINTER OUTPUT ROUTINE + RELOC YLPT + LLS + CLA /DON'T DO RING-BUFFERING - JUST "OUTPUT" CHAR. + JMS CTCBCK /CHECK FOR ^C OR ^B + JMP I LPT +FJCTCT, JMS CTCBCK /COME HERE FROM INTERPRETED FPP JUMPS + JMP I FPNXT /CHECK FOR ^C,^B AND RETURN TO INTERPRETER + RELOC + 0 + + YPTP-1 /PAPER-TAPE PUNCH ROUTINE + CLA /ALL PAPER-TAPE I/O ILLEGAL + 0 + YPTR-1 /PAPER TAPE READER ROUTINE + CLA /ALL PAPER-TAPE I/O ILLEGAL + 0 + + YTTY-1 /TELETYPE INPUT/OUTPUT ROUTINE + RELOC YTTY + SNA + JMP KBDRTS /AC=0 MEANS INPUT + TSF + JMP .-1 /HANG UNTIL OUTPUT BUFFER NOT FULL + TLS + CLA + JMS CTCBCK /CHECK FOR ^C OR ^B TYPED + JMP I TTY +KBDRTS, KSF + JMP .-1 /HANG UNTIL CHAR RECEIVED + JMS CTCBCK /CHECK FOR ^C OR ^B + KRB + AND KB177 /STRIP PARITY + TAD KB177 + IAC /NOW FORCE PARITY BIT ON (177+1=200) + JMP I TTY + +CTCBCK, . /*K* CAN'T BE 0! + KRS /PEEK AT NEXT CHAR IN BUFFER + AND KB177 + TAD KBM2 + CLL RAR + SNA CLA /IS IT ^C OR ^B? + KSF /AND IS IT REALLY PENDING? + JMP I CTCBCK /NO - JUST RETURN WITH AC=0 + JMP BEEORC /TERMINATE JOB - LINK HAS ^C/^B FLAG +KB177, 177 +KBM2, -2 + RELOC + 0 + /CONTINUATION OF TABLE OF RTS-8 OVERLAYS TO FRTS + + YHIOF-1 /"GET OS/8 HANDLER" ROUTINE + NOP /ELIMINATE "IOF" INSTRUCTION + 0 + + YRCOVR-1 /"RECOVER FROM OS/8 HANDLER" ROUTINE + RELOC YRCOVR + JMP I RECOVR /SHORT-CIRCUIT PORTION OF ROUTINE WHICH DOES + RELOC /AN "ION" + 0 + + YFJMP-1 /FPP INTERPRETER - SUCCESSFUL JUMP SECTION + FJCTCT /TEST FOR ^C OR ^B TYPED BEFORE + 0 /RETURNING TO THE INTERPRETER + + 0 /** LIST TERMINATOR ** + /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__> + +NOLI, TEXT /NOT A LOADER IMAGE/ +NONMSG, TEXT /NO NUMERIC SWITCH/ +FILMSG, TEXT /FILE ERROR/ +SYSMSG, TEXT /SYSTEM DEVICE ERROR/ +TOOMCH, TEXT /MORE CORE REQUIRED/ +TOMNYH, TEXT /TOO MANY HANDLERS/ +LIOEMS, TEXT /CAN'T READ IT!/ +NODPMS, TEXT /CAUTION - NO DP/ +XVERMS, TEXT /FRTS V/ + *.-1 + XVERSN&70^7+XVERSN+4060 /VERSION NUMBER IN SIXBIT + XPATCH&77^100+40 /PATCH LEVEL + TEXT / / + PAGE + /FPP INTERPRETER STARTUP ROUTINE + +FPPINT= . /FOR FPP OVERLAY +RETURN, JMP I FPNXT /RETURN DOES SOMETHING DIFFERENT IF FPP PRESENT + +FPGO, 0 +FPGCDF, CDF 0 /NECESSARY? + CLA + TAD PC + DCA SAVPC /ALLOW ONE LEVEL OF RECURSIVENESS + TAD I (PCCDF + DCA SPCCDF + STA + TAD I FPGO + DCA PC + ISZ FPGO + TAD FPGCDF /FPGO STARTS UP THE FPP FROM FIELD 0 ONLY + DCA I (PCCDF + JMP I FPNXT + +EXIT, TAD SAVPC + DCA PC + TAD SPCCDF + DCA I (PCCDF /RESTORE OLD PC + JMP I FPGO /RETURN TO PDP-8 CODE +SAVPC, 0 +SPCCDF, 0 + +FPXTA, TAD [27 /XR TO AC - NORMALIZE IF FLOATING MODE + DCA ACX + JMS DATCDF + TAD I ADR +CLFAC, DCA ACL + TAD ACL + SPA CLA /SIGN-EXTEND 12-BIT WORD + STA /INTO FAC FRACTION + DCA ACH +NRMFAC, DCA AC1 /CLEAR OVERFLOW WORD + TAD DFLG + SPA SNA CLA /UNLESS WE ARE IN D.P.I. MODE, + JMS I NORMX /NORMALIZE THE FAC + JMP I FPNXT + /MISCELLANEOUS JUMP CLASS INSTRUCTIONS + +JSA, TAD ADR + DCA PUTM + TAD DATAF + DCA JSCDF /SET UP LOC TO SAVE PC IN + AC0002 + TAD ADR + DCA ADR /BUMP ADDRESS BY 2 + RTL + RTL + TAD DATAF + DCA DATAF /INCLUDING DATA FIELD +JSAR, TAD I (PCCDF /JSA/JSR COMMON CODE + CLL RTR + RAR + ISZ PC /BUMP PC BEFORE STORING + SKP + IAC /INCLUDING FIELD BITS + TAD (JA-2620 /FORM "JA" INSTRUCTION +JSCDF, HLT + DCA I PUTM + ISZ PUTM + SKP + JMS I (DFBUMP /BUMP TARGET ADDRESS + TAD PC + DCA I PUTM + JMP I (DOJMP /NOW JUMP TO DESTINATION + +JSR, CLA CLL IAC + TAD BASADR + DCA PUTM + RTL + RTL + TAD I (BASCDF /SET JSCDF&PUTM TO BASE PAGE LOC +1 + DCA JSCDF + JMP JSAR + +FPJAC, TAD ACL + DCA ADR + TAD ACH + JMS I MCDF + DCA DATAF + JMP I (DOJMP + +SPCATX, TAD ACL + SKP +FPLDX, JMS I [FETPC + JMS DATCDF + DCA I ADR /SET XR TO NEXT INST WD + JMP I FPNXT + /MORE INDEX REGISTER & AC-TO-MEMORY INSTRUCTIONS + +ADDX, JMS I [FETPC + JMS DATCDF + TAD I ADR /ADD NEXT INST WD TO XR + JMP FPLDX+1 + +ATX, TAD DFLG /ATX WORKS DIFFERENTLY IN D.P.I. MODE + SMA SZA CLA + JMP SPCATX + JMS I NORMX /FAC MAY NOT BE NORMALIZED + JMS I [FFIX + TAD ACI + JMP FPLDX+1 + +OPMEM, DCA AD1 /GENERAL AC-TO-MEMORY INTERPRETER + TAD AD1 + DCA AD2 + RDF + CLL RTR + RAR + TAD KLUDGM /FORM FSTA X INSTRUCTION + DCA PUTM + AC2000 + AND INST /TURN OP 5 TO OP 1, + SZA CLA + TAD [3000 / OP 7 TO OP 4. + TAD [3000 + TAD PUTM /STICK IN FIELD BITS + DCA OPM + JMS I [FPGO + KLUDGM + JMP I FPNXT + +KLUDGM, FSTA+LONG + FTEMP /SAVE AC +OPM, 0 +AD1, 0 /PERFORM OP +PUTM, 0 +AD2, 0 /STORE RESULT + FLDA+LONG + FTEMP /RESTORE AC + FEXIT + +NORMX, FFNOR /*K* CHANGED TO EFFNOR IF EAE + PAGE + /MAIN INTERPRETER LOOP + +NEGFAC, JMS I [FFNEG + +ICYCLE, CLA + JMS I [FETPC /GET INST + DCA INST + TAD INST + CLL RTL + RTL + SMA /SKIP IF BASEPAGE ADDRESSING + JMP LONGI + AND [7 + TAD BASJMP + DCA OPJMP /SAVE OPCODE CALL ADDRESS + TAD INST /DATA FIELD IS STILL SET UP + SZL /SO IS LINK (WITH INSTRUCTION BIT 3) + JMP BPAGEI /INDIRECT ADDRESSING + CLL RAL + TAD INST /MULTIPLY BASE OFFSET BY 3 + TAD [200 /ELIMINATE ANY + AND (777 /HIGH ORDER BITS +IMFUDJ, CLL /CLL IAC IF D.P. INTEGER MODE + TAD BASADR /ADD IN BASE PAGE ORIGIN +BASCDF, HLT /CDF TO BASE PAGE FIELD + SZL + JMS DFBUMP /BUMP DF IF ADDITION OVERFLOWED +OPJCLL, CLL +OPJMP, HLT /JMP I EXECUTIONROUTINE + +BPAGEI, AND [7 + DCA ADR + TAD ADR + CLL CML RAL + TAD ADR /FORM 3*OFFSET+1 + TAD BASADR + DCA ADR + RTL + RTL + TAD BASCDF /FORM PROPER CDF + DCA ADDRLO +ADDRLO, HLT /EXECUTE IT + TAD I ADR /GET FIELD BITS OF REAL ADDRESS + DCA ADDRHI /FROM 2D WORD OF BASE PAGE LOC + ISZ ADR + SKP + JMS DFBUMP /WATCH FOR FIELD OVERFLOW + TAD I ADR /GET LOW-ORDER ADDRESS FROM 3D WORD + JMP INDEX /NOW GO DO INDEXING (IF ANY) + /COME HERE IF BIT 4 OF INSTRUCTION IS OFF + +LONGI, AND [7 + SNL /TEST BIT 3 OF INSTRUCTION + JMP I (SPECAL /SPECIAL INSTRUCTION + TAD BASJMP + DCA OPJMP + TAD INST + DCA ADDRHI /HIGH-ORDER ADDRESS BITS IN INST WD + JMS I [FETPC /NEXT INST WORD CONTAINS LOW-ORDER ADDRESS +INDEX, DCA ADDRLO + TAD INST + AND [70 + SNA /IS XR NUMBER 0? + JMP NOINDX /YES - NO INDEXING + JMS DCDIDX /GET XR VALUE (MAYBE INCREMENTED) + AC7775 + TAD DFLG /GET -3 IF F, -2 IF D, -6 IF E MODE + DCA DCDIDX + TAD ADDRLO +XRADLP, CLL + TAD I T + SZL + ISZ ADDRHI + ISZ DCDIDX /ADD THE XR IN THE PROPER NUMBER OF TIMES + JMP XRADLP + DCA ADDRLO +NOINDX, TAD ADDRHI + JMS I MCDF + DCA ADDRHI /TURN HIGH-ORDER ADDRESS INTO A CDF +ADDRHI, HLT /AND EXECUTE IT + TAD ADDRLO + JMP OPJCLL /GO EXECUTE THE INSTRUCTION + +DFBUMP, 0 /BUMP DATA FIELD + DCA DFTMP /SAVE AC + RDF + TAD (CDF 10 + DCA .+1 + HLT + TAD DFTMP /RESTORE AC + JMP I DFBUMP +DFTMP, 0 + DCDIDX, 0 + CLL RTR + RAR + TAD XRBASE /ADD IN BASE ADDRESS OF XR ARRAY +XRCDF, HLT /CDF TO XR ARRAY FIELD + SZL + JMS DFBUMP /OR MAYBE NEXT FIELD + DCA T /SAVE POINTER TO XR + TAD INST + AND DCD100 + SZA CLA /INCREMENT BIT ON? + ISZ I T /YES - BUMP XR +DCD100, 100 /** PROTECTION + JMP I DCDIDX + +BASJMP, JMP I JMPTB1 /JMP I JMPTB2 FOR D.P. MODE + +JMPTB1, FFGET / F MODE (FLOATING POINT) + FFADD + FFSUB + FFDIV + FFMPY + OPMEM /FADDM + FFPUT + OPMEM /FMULM + + DDGET / D MODE ( DOUBLE PRECISION INTEGER) + DDADD + DDSUB + DDDIV + DDMPY + OPMEM /DADDM + DDPUT + OPMEM /DMULM + + EEGET / E MODE ( 6 WD FLOATING POINT) + FFADD + FFSUB + FFDIV + FFMPY + OPMEM + EEPUT + OPMEM + PAGE + /MORE I CYCLE + +SPECAL, SNA + JMP XRINST /OPCODE 0 HAS MANY MANSIONS + TAD SPECOP + DCA SPCJMP /GET OPCODE JUMP ADDRESS + JMS I [FETPC + DCA ADR + TAD INST /ALL OF THESE ARE TWO-WORD INSTRUCTIONS + JMS I MCDF /SO FORM THE ADDRESS NOW + DCA DATAF + CDF 0 + TAD INST +SPCJMP, HLT + +XRINST, TAD INST + AND (7770 + CDF 0 + SNA CLA /IF SUB-OPCODE IS ZERO, + JMP OPERAT /DECODE SUB-SUB-OPCODE + TAD INST + AND [7 + CLL + TAD XRBASE + DCA ADR /COMPUTE INDEX REGISTER ADDRESS + RTL + RTL + TAD I (XRCDF + DCA DATAF +XJCOMN, TAD INST + CLL RTR + RAR + AND [77 /GET OPCODE - HIGH ORDER 2 BITS ARE 0 +OXCOMN, TAD (JMP I SP2 + DCA .+1 /EXECUTE APPROPRIATE JUMP + HLT + +OPERAT, TAD INST + CIA + JMP OXCOMN + +SETX, TAD DATAF /SET XR0 LOC + DCA I (XRCDF + TAD ADR + DCA XRBASE + JMP I FPNXT + /JUMP DECODER + +JUMPS, AND (100 /INSTRUCTION IN AC + CLL RTR /20 IN AC IF NOT COND. JUMP + SZA /IF NOT COND. JUMP, DECODE FURTHER + JMP XJCOMN + TAD INST + AND [70 + CLL RTR + RAR + TAD (CNDSKT + DCA T /INDEX INTO CONDITIONAL SKIP TABLE + TAD I T + DCA CNDSKP + TAD ACH + SZA + JMP CNDSKP + TAD ACL + SZA CLA /IF HIGH ORDER ZERO, AC MIGHT BE UNNORMALIZED. + IAC /USE LOW ORDER ON 0/NOT 0 BASIS +CNDSKP, HLT /TEST AC + JMP I FPNXT /FAILED - DON'T JUMP + +DOJMP, STA CLL + TAD ADR + DCA PC + SNL + TAD (-10 + TAD DATAF + CDF 0 + DCA I (PCCDF /ADDRESS-1 TO PC + JMP I .+1 +YFJMP, ICYCLE /** CHANGED IF RUNNING UNDER RTS-8 + +JXN, AND [70 /GET XR FIELD + JMS I (DCDIDX /GET XR VALUE WITH INCREMENTING + TAD I T + SNA CLA /ZERO? + JMP I FPNXT /YES + JMP DOJMP /JUMP ON INDEX NON-ZERO, RIGHT? + +CNDSKT, SZA CLA /JEQ + SPA CLA /JGE + SMA SZA CLA /JLE + SKP CLA /JA + SNA CLA /JNE + SMA CLA /JLT + SPA SNA CLA /JGT + JMP TSTALN /JAL + +TSTALN, CLA + TAD ACX + TAD (-27 + SPA SNA CLA + JMP I FPNXT + JMP DOJMP + /OPCODE TABLES + +SPECOP, JMP I SPECOP /SPECIAL OPCODE TABLE + JUMPS + JXN + TRAP3I + TRAP4I + TRAP5I + TRAP6I + TRAP7I + + FPJAC + STRTD + STRTF + NRMFAC + NEGFAC + CLFAC + FPAUSE +SP2, EXIT + ALN + ATX + FPXTA + ICYCLE /NOP + STRTE + ICYCLE /UNDEF OP + ICYCLE /" + FPLDX + ADDX + SETX + SETB + JSA + JSR + PAGE + /MISCELLANEOUS OPCODE ROUTINES + +TRAP3I, +TRAP4I, AC0002 + TAD DATAF + DCA .+1 /FORM CDF CIF N + HLT /EXECUTE IT + TAD INST + SMA CLA /TRAP4 JMS'S TO ITS TARGET ADDRESS, + JMP I ADR /TRAP3 JMP'S TO IT + JMS I ADR + JMP I FPNXT + +ALN, TAD ACX /ALIGN SIMULATOR + DCA OPX /SAVE EXPONENT IN CASE WE'RE IN D.I. MODE + TAD DFLG + SMA SZA CLA + DCA ACX /ZERO EXP IF D.I. MODE + JMS DATCDF /SET TO XR FIELD + TAD INST + AND [7 + TAD DFLG /IF WE'RE IN FLOATING POINT MODE, + SNA CLA /AND DOING AN "ALN 0", + TAD [27 /ALIGN UNTIL EXPONENT = 23 + SNA + TAD I ADR /OTHERWISE ALIGN UNTIL EXPONENT = XR VALUE + CDF 0 + CIA + TAD ACX + CMA /FORM DIFFERENCE - 1 + SPA /IF EXPONENT IS LARGER THEN DESIRED EXPONENT, + JMP ALNSHL /SHIFT LEFT + JMS I [ACSR /OTHERWISE SHIFT RIGHT +ALNXIT, TAD DFLG + SPA SNA CLA /IF DOUBLE INTEGER MODE, + JMP I FPNXT + TAD OPX /ALIGNMENT LEAVES THE EXPONENT UNCHANGED + DCA ACX + JMP I FPNXT +ALNSHL, DCA T /STORE SHIFT COUNT + SKP /SHIFT LEFT ONE LESS THAN COUNT + JMS I [AL1BMP + ISZ T + JMP .-2 + JMP ALNXIT /GO TO COMMON CODE + /ARG FETCH SUBROUTINES AND MODE CHANGE OPERATORS + +DARGET, 0 + DCA ADR + TAD DARGET + DCA ARGET + DCA ACX + JMP ARGET2 /FAKE OUT FLOATING POINT ROUTINE + +ARGET, 0 /SUBROUTINE TO FETCH ARG FOR ADD, SUBT, ETC. + DCA ADR /STORE ADDRESS OF OPERAND + TAD I ADR /PICK UP EXPONENT + ISZ ADR /MOVE POINTER TO HI MANTISSA WD + SKP + JMS I (DFBUMP +ARGET2, DCA OPX + TAD I ADR /PICK IT UP + DCA OPH /STORE + ISZ ADR /MOVE PTR. TO LO MANTISSA WD. + SKP + JMS I (DFBUMP /WATCH THOSE FIELD TRANSITIONS! + TAD I ADR /PICK IT UP + DCA OPL /STORE IT + CDF 0 + JMP I ARGET /RETURN + +STRTE, TAD DFLG /START EXTENDED PRECISION MODE + SPA CLA + JMP .+4 /CLEAR EXTENDED FAC + DCA EAC1 /IF NOT ALREADY IN E MODE + DCA EAC2 + DCA EAC3 + AC7775 + DCA DFLG + JMP DFECMN + +STRTD, CLA IAC /START DOUBLE PRECISION INTEGER MODE +STRTF, DCA DFLG /START FLOATING POINT MODE + TAD DFLG +DFECMN, TAD (CLL + DCA I (IMFUDJ /SET D.P.I FUDGE TO "CLL" OR "CLL IAC" + TAD DFLG + SPA + CMA /CHANGE -3 FOR E MODE TO +2 + CLL RTL + RAL + TAD (JMPTB1&177+5600 + DCA I (BASJMP + JMP I FPNXT + /DOUBLE PRECISION INTEGER OPERATORS + +DDSUB, JMS DARGET + JMS I (OPNEG + SKP +DDADD, JMS DARGET + DCA AC1 /CLEAR OVERFLOW JUSTINCASE + JMS I [OADD + JMP I FPNXT + +FFGET, DCA ADR /GET A FLOATING POINT NUMBER + TAD I ADR + DCA ACX /SAVE EXPONENT + ISZ ADR + JMP .+3 /NO FIELD OVERFLOW + JMS I (DFBUMP /BUMP DATA FIELD +DDGET, DCA ADR /SUAVE - ENTRY POINT FOR D.P. INTEGER GET + TAD I ADR + DCA ACH + ISZ ADR + SKP + JMS I (DFBUMP + TAD I ADR + DCA ACL + JMP I FPNXT + +FFPUT, DCA ADR /STORE A FLOATING POINT NUMBER + TAD ACX /GET FAC AND STORE IT + DCA I ADR /AT SPECIFIED ADDRESS + ISZ ADR + JMP .+3 + JMS I (DFBUMP +DDPUT, DCA ADR /ENTRY FOR D.P. INTEGER PUT + TAD ACH + DCA I ADR + ISZ ADR + SKP + JMS I (DFBUMP + TAD ACL + DCA I ADR + JMP I FPNXT + PAGE + FPPKG= . /FOR EAE OVERLAY + +/23-BIT FLOATING PT INTERPRETER +/W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN + +LPBUF2, ZBLOCK 16 + LPBUF3 + +AL1BMP, 0 /*K* UTILITY SUBROUTINE - USED BY INTERPRETER + STA + TAD ACX + DCA ACX + JMS I [AL1 + JMP I AL1BMP + +/FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES +DDMPY, JMS I (DARGET + SKP +FFMPY, JMS I (ARGET /GET OPERAND + JMS MDSET /SET UP FOR MPY-OPX IN AC ON RETN. + TAD ACX /DO EXPONENT ADDITION + DCA ACX /STORE FINAL EXPONENT + DCA MDSET /ZERO TEM STORAGE FOR MPY ROUTINE + DCA AC2 + TAD ACH /IS FAC=0? + SNA CLA + DCA ACX /YES-ZERO EXPONENT + JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR. + TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER + DCA OPL + JMS MP24 + TAD AC2 /STORE RESULT BACK IN FAC + DCA ACL /LOW ORDER + TAD MDSET /HIGH ORDER + DCA ACH + TAD ACH /DO WE NEED TO NORMALIZE? + RAL + SMA CLA + JMS AL1BMP /YES-DO IT FAST + TAD AC1 + SPA CLA /CHECK OVERFLOW WORD + ISZ ACL /HIGH BIT ON - ROUND RESULT + JMP MDONE + ISZ ACH /LOW ORDER OVERFLOWED - INCREMENT HIGH ORDER + TAD ACH + SPA /CHECK FOR OVERFLOW TO 4000 0000 + JMP I (SHR1 /WE HANDLE A SIMILIAR CASE IN FLOATING DIVIDE + CLA + MDONE, DCA AC1 /ZERO OVERFLOW WD(DO I NEED THIS???) + ISZ MSIGN /SHOULD RESULT BE NEGATIVE? + SKP /NO + JMS I [FFNEG /YES-NEGATE IT + TAD ACH + SNA CLA /A ZERO AC MEANS A ZERO EXPONENT + DCA ACX + TAD DFLG + SMA SZA CLA /D.P. INTEGER MODE? + TAD ACX /WITH ACX LESS THAN 0? + SNA + JMP I FPNXT /NO - RETURN + CMA + JMS I [ACSR /UN-NORMALIZE RESULT + JMP I FPNXT /RETURN + /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. + +MDSET, 0 + CLA CLL CMA RAL /SET SIGN CHECK TO -2 + DCA MSIGN + TAD OPH /IS OPERAND NEGATIVE? + SMA CLA + JMP .+3 /NO + JMS I (OPNEG /YES-NEGATE IT + ISZ MSIGN /BUMP SIGN CHECK + TAD OPL /AND SHIFT OPERAND LEFT ONE BIT + CLL RAL + DCA OPL + TAD OPH + RAL + DCA OPH + DCA AC1 /CLR. OVERFLOW WORF OF FAC + TAD ACH /IS FAC NEGATIVE + SMA CLA + JMP LEV /NO-GO ON + JMS I [FFNEG /YES-NEGATE IT + ISZ MSIGN /BUMP SIGN CHECK + NOP /MAY SKIP +LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC + JMP I MDSET +MSIGN, 0 + /24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL +/MULTIPLICAND IS IN ACH AND ACL +/RESULT LEFT IN MDSET,AC2, AND AC1 + +MP24, 0 + TAD (-14 /SET UP 12 BIT COUNTER + DCA OPX + TAD OPL /IS MULTIPLIER=0? + SZA + JMP MPLP1 /NO-GO ON + DCA AC1 /YES-INSURE RESULT=0 + JMP I MP24 /RETURN +MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER +MPLP1, RAR /OF MULTIPLIER AND INTO LINK + DCA OPL + SNL /WAS IT A 1? + JMP MPLP2 /NO - 0 - JUST SHIFT PARTIAL PRODUCT + TAD AC2 /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT + TAD ACL /LOW ORDER + DCA AC2 + CML RAL /*K* NOTE THE "SNL" 5 WORDS BACK! + TAD ACH /HI ORDER +MPLP2, TAD MDSET + RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT + DCA MDSET + TAD AC2 + RAR + DCA AC2 + TAD AC1 + RAR /OVERFLOW TO AC1 + DCA AC1 + ISZ OPX /DONE ALL 12 MULTIPLIER BITS? + JMP MPLP /NO-GO ON + JMP I MP24 /YES-RETURN + PAGE + /DIVIDE-BY-ZERO ROUTINE - MUST BE AT BEGINNING OF PAGE + +DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL + JMS I ERR /GIVE ERROR MSG + TAD DBAD + DCA ACX /RETURN A VERY LARGE POSITIVE NUMBER + AC2000 + JMP FD + +/FLOATING DIVIDE - USES DIVIDE-AND-CORRECT METHOD + +DDDIV, JMS I (DARGET + SKP +FFDIV, JMS I (ARGET /GET OPERAND + JMS I (MDSET /GO SET UP FOR DIVIDE-OPX IN AC ON RETN. + CMA IAC /NEGATE EXP. OF OPERAND + TAD ACX /ADD EXP OF FAC + DCA ACX /STORE AS FINAL EXPONENT + TAD OPH /NEGATE HI ORDER OP. FOR USE + CLL CMA IAC /AS DIVISOR + DCA OPH + JMS DV24 /CALL DIV.--(ACH+ACL)/OPH + TAD ACL /SAVE QUOT. FOR LATER + DCA AC1 + TAD OPL + SNA CLA + JMP DVL2 /AVOID MULTIPLYING BY 0 + TAD (-15 /SET COUNTER FOR 12 BIT MULTIPLY + DCA DV24 /TO MULTIPLY QUOT. OF DIV. BY + JMP DVLP1 /LOW ORDER OF OPERAND (OPL) + +/DIVIDE ROUTINE - (ACH,ACL)/OPH = ACL REMAINDER REM (AC2=0) + +DV24, 0 + TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND + TAD OPH /DIVISOR IN OPH (NEGATIVE) + SZL CLA /IS IT? + JMP DBAD /NO-DIVIDE OVERFLOW + TAD (-15 /YES-SET UP 12 BIT LOOP + DCA AC2 + JMP DV1 /GO BEGIN DIVIDE +DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT + RAL + DCA ACH /RESTORE HI ORDER + TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER + TAD OPH /DIVIDEND + SZL /GOOD SUBTRACT? + DCA ACH /YES-RESTORE HI DIVIDEND + CLA /NO-DON'T RESTORE--OPH.GT.ACH +DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT + RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL + DCA ACL + ISZ AC2 /DONE 12 BITS OF QUOT? + JMP DV2 /NO-GO ON + JMP I DV24 /YES-RETN W/AC2=0 + /DIVIDE ROUTINE CONTINUED + +MP12L, DCA OPL /STORE BACK MULTIPLIET + TAD AC2 /GET PRODUCT SO FAR + SNL /WAS MULTIPLIER BIT A 1? + JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT + CLL /YES-CLEAR LINK AND ADD MULTIPLICAND + TAD ACL /TO PARTIAL PRODUCT + RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER + DCA AC2 /RESULT-STORE BACK +DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER + RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.) + ISZ DV24 /DONE ALL BITS? + JMP MP12L /NO-LOOP BACK + CLL CIA /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC + DCA ACL /NEGATE AND STORE + CML RAL /PROPAGATE CARRY + TAD AC2 /NEGATE HI ORDER PRODUCT + STL CIA + TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV. + SZL /WELL? + JMP DVOPS /GREATER THAN REM.-ADJUST QUOT OF 1ST DIV. + DCA ACH /OK - DO (REM - (Q*OPL)) / OPH +DVL3, JMS DV24 /DIVIDE BY OPH (HI ORDER OPERAND) +DVL1, TAD AC1 /GET QUOT. OF FIRST DIV. + SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT + JMP FD /NO-ITS NORMALIZED-DONE +SHR1, CLL + ISZ ACL /ROUND AND SHIFT RIGHT ONE + SKP + IAC /DOUBLE PRECISION INCREMENT + RAR + DCA ACH /STORE IN FAC + TAD ACL /SHIFT LOW ORDER RIGHT + RAR + DCA ACL /STORE BACK + ISZ ACX /BUMP EXPONENT + NOP + TAD ACH + JMP DVL1+1 /IF FRACT WAS 77777777 WE MUST SHIFT AGAIN +FD, DCA ACH /STORE HIGH ORDER RESULT + JMP I (MDONE /GO LEAVE DIVIDE + +DVL2, DCA ACL /COME HERE IF LOW-ORDER QUO=0 + JMP DVL3 /SAVE SOME TIME + /ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE +/REMAINDER OF THE FIRST DIVIDE IS LESS THAN QUOT*OPL + +DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER + DCA ACH + CLL + TAD OPH + TAD ACH /WATCH FOR OVERFLOW + SNL + JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV. + DCA ACH /NO OVERFLOW-STORE NEW REM. + CMA /SUBTRACT 1 FROM QUOT OF + TAD AC1 /FIRST DIVIDE + DCA AC1 +DVOP1, CLA CLL + TAD ACH /GET HI ORD OF REMAINDER + SNA /IS IT ZERO? +DVOP2, DCA ACL /YES-MAKE WHOLE THING ZERO + DCA ACH + JMS DV24 /DIVIDE EXTENDED REM. BY HI DIVISOR + TAD ACL /NEGATE THE RESULT + CLL CMA IAC + DCA ACL + SNL /IF QUOT. IS NON-ZERO, SUBTRACT + CMA /ONE FROM HIGH ORDER QUOT. + JMP DVL1 /GO TO IT + +LPBUF3, ZBLOCK 12 + LPBUF4 + PAGE + /"OPNEG" MUST BE AT 0 ON PAGE + +OPNEG, 0 /ROUTINE TO NEGATE OPERAND + TAD OPL /GET LOW ORDER + CLL CIA /NEGATE AND STORE BACK + DCA OPL + CML RAL /PROPAGATE CARRY + TAD OPH /GET HI ORDER + CLL CIA /NEGATE AND STORE BACK + DCA OPH + JMP I OPNEG +/ +/FLOATING SUBTRACT AND ADD +/ +FFSUB, JMS I (ARGET /PICK UO THE OP. + JMS OPNEG /NEGATE OPERAND + SKP +FFADD, JMS I (ARGET /PICK UP OPERAND + TAD OPH /IS OPERAND = 0 + SNA CLA + JMP I FPNXT /YES-DONE + TAD ACH /NO-IS FAC=0? + SNA CLA + JMP CLROFL /CLEAR OUT THE OVERFLOW BITS + TAD ACX /NO-DO EXPONENT CALCULATION + CLL CIA + TAD OPX + SMA SZA /WHICH EXP. GREATER? + JMP FACR /OPERANDS-SHIFT FAC + CIA /FAC'S-SHIFT OPERAND=DIFFRNCE+1 + TAD (-30 + SMA /TEST FOR INSIGNIFICANCE + JMP OPINSG /YES - ANSWER IS FAC + TAD (30 + JMS OPSR + JMS I [ACSR /SHIFT FAC ONE PLACE RIGHT +DOADD, TAD OPX /SET EXPONENT OF RESULT + DCA ACX + JMS I [OADD /DO THE ADDITION + JMS FFNOR /NORMALIZE RESULT + JMP I FPNXT /RETURN +FACR, TAD (-30 + SMA /TEST FOR INSIGNIFICANCE + JMP ACINSG /YES - ANSWER IS OPR + TAD (30 + JMS I [ACSR /SHIFT FAC = DIFF.+1 + JMS OPSR /SHIFT OPR. 1 PLACE + JMP DOADD /DO ADDITION + +OPINSG, CLA + JMP I FPNXT + /OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 IN AC + +OPSR, 0 + CMA /- (COUNT+1) TO SHIFT COUNTER + DCA AC0 +LOP2, TAD OPH /GET SIGN BIT + CLL /TO LINK + SPA + CML /WITH HI MANTISSA IN AC + RAR /SHIFT IT RIGHT, PROPAGATING SIGN + DCA OPH /STORE BACK + TAD OPL + RAR + DCA OPL /STORE LO ORDER BACK + ISZ OPX /INCREMENT EXPONENT + NOP + ISZ AC0 /DONE ALL SHIFTS? + JMP LOP2 /NO-LOOP + RAR /SAVE 1 BIT OF OVERFLOW + DCA AC2 /IN AC2 + JMP I OPSR /YES-RETN. + +FFNOR, 0 /ROUTINE TO NORMALIZE THE FAC + TAD ACH /GET THE HI ORDER MANTISSA + SNA /ZERO? + TAD ACL /YES-HOW ABOUT LOW? + SNA + TAD AC1 /LOW=0, IS OVRFLO BIT ON? + SNA CLA + JMP ZEXP /#=0-ZERO EXPONENT +NORMLP, CLA CLL CML RTR /NOT 0-MAKE A 2000 IN AC + TAD ACH /ADD HI ORDER MANTISSA + SZA /HI ORDER = 6000 + JMP .+3 /NO-CHECK LEFT MOST DIGIT + TAD ACL /YES-6000 OK IF LOW=0 + SZA CLA + SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS. + JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7) + JMS I [AL1BMP /SHIFT AC LEFT AND BUMP ACX DOWN + JMP NORMLP /GO BACK AND SEE IF NORMALIZED +ZEXP, DCA ACX +FFNORR, DCA AC1 /DONE W/NORMALIZE - CLEAR AC1 + JMP I FFNOR /RETURN + +ACINSG, CLA /COME HERE IF AC IS INSIGNIFICANT ON ADDITION + DCA ACH + DCA ACL + JMP DOADD-1 /FAKE AN ADD WITH OPR=0 + +LPBUF4, ZBLOCK 40 + LPBUFE +CLROFL, DCA AC1 /CLEAR THE FLOATING AC OVERFLOW WORD + DCA AC2 /CLEAR THE OPERAND OVERFLOW WORD + JMP DOADD /FAC=0; DO THE ADD + PAGE + /PAGE 7400 UNUSED RIGHT NOW + +LPBUFE, ZBLOCK 177 + LPBUFR + FIELD 1 +