File: RTS.PA of Tape: Sources/Fortran/s2
(Source file text)
/FORTRAN 4 RUNTIME SYSTEM - R.L. /AND NOW WITH DOUBLE PRECISION! - MKH /LAST EDITED 5/9/73 /UPDATED TO VERSION 3?? W.V.D.MARK / FEBRUARY 2, 1977 /COPYRIGHT 1973 /DIGITAL EQUIPMENT CORP. /MAYNARD MASSACHUSETTS 01754 /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 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 INTEG, 0 /CONVERTED INTEGER CHCH, 0 FMTNUM, 0 /CONTAINS ACCUMULATED NUMERIC VALUE CTCINH, 0 /^C INHIBIT FLAG LOGUNT, 0 /LOGICAL UNIT 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 FADONE, FADD+LONG ONE /GET CONSTANT ONE 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 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 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 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 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 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; QUOTE /' -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 QUOTE, TAD MINUS5 /APOSTROPHE PROCESSOR DBLQOT, TAD (-42 /QUOTE PROCESSOR DCA QUODEL /SAVE TERMINATOR JMS DOFMT /PROCESS PRECEDING FIELD , IF ANY SKP QUOTLP, JMS FMTHCV /PROCESS ONE CHARACTER JMS I [FMTGCH /GET THE NEXT FORMAT CHAR TAD QUODEL SZA CLA /IS IT THE TERMINATOR? JMP QUOTLP /NO - PROCESS IT AND CONTINUE ISZ FMTBYT /BUMP OVER TERMINATOR JMS I [FMTGCH TAD QUODEL SNA CLA /IS THIS ANOTHER TERMINATOR? JMP QUOTLP /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 QUODEL, 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; PFMTPT /P *W* PATCH -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 SNA CLA /DID WE HIT THE END OF THE I/O LIST? JMP I ENDREC JMP I [ENDIO /FINISH UP AND LEAVE NOP NOP NOP /*W* FOR COMPATIBILITY SLASH, JMS DOFMT /EXECUTE THE FIELD SPEC IF ANY JMS I [EOLINE /TERMINATE CURRENT LINE JMP I (FMTFLP PFMT, 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 INTEG /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 INTEG 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 (MASBCK /BETWEEN READ AND WRITE TAD I RWINIT TAD RWFLAG CMA /OR THE I/O TYPE INTO THE FLAG WORD AND FFLAGS TAD I RWINIT /OR THE WRITE BIT IN AS WELL 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 INTEG CLL RAL TAD INTEG 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 DMPBUF, 0 /ROUTINE TO DUMP CURRENT OUTPUT BUFFER WITH ^Z ISZ EOLSW TAD (7712 /NEGATIVE FOR CONTROL JMS I [FMTOUT /THIS OUTPUTS A LINEFEED AS IT IS IN COL 1 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 INTEG / READ/WRITE INIT SINGS THIS SONG, CLL RTL / (DOO DAH, DOO DAH,) RAL / DSRN ENTRIES 9 WORDS LONG TAD INTEG / (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 /LOOK AT LAST WORD IN BUFFER JMS BUFFLD TAD I T 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 (IGEFIP /*W* PATCH(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 /SET UP TO PRINT DIGITS NOTG, JMS DIGCNT JMP I (OUTNUM 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 PFMTPT, STA /*W* PATCH JMP I .+1 PFMT 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 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 ASTSK1, 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 ONE, 1;2000;0 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 JMP INER /*W* PATCH INDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER D.P. ISZ DPSW /TEST AND SET D.P. SWITCH INER, JMS I (TTERR /WHOOPS - ERROR IN A NUMBER /*W* PATCH /TEST IF TTY AND TREAT ACCORDINGLY JMP INLOOP /KEEP GOING IBLDIG, TAD EOLSW /SINCE THE BLEEPING STANDARD DOESN'T COVER CLA /IGNORE TRAILING BLANKS *W* PATCH OS8 SIG JULY 1975 /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 INTEG /GET INTEGER 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 FTEMP, ZBLOCK 6 DGT, 13;0;0;0;0;0 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 CLA TAD W /ASTERISK OUT OVERFLOWING FIELDS CIA DCA T TAD (52 JMS I [FMTOUT ISZ T JMP .-3 JMP I ASTRSK /GET NEXT ELEMENT INESW, 0 IGEFIP, DCA OD /*W* PATCH OD DEFAULT JMP IGEFIN 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 JMS I (TTERR /*W* PATCH MAYBE? 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? 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 INTEG 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 FADONE /RECORD NUMBER + ONE 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 INTEG 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 INTEG TAD INTEG /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 INTEG 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. 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 ZBLOCK 1 /INPUT LINE BUFFER - FIRST A LITTLE PADDING, /RTS EXECUTION INITIALIZATION - IN INPUT BUFFER FPSTRT, NOP/6601 /CLEAR DF32 FLAG PCF /HSP FLAG RRB /HSR FLAG PP7600, 7600 /CLEAR READER CHAR NOP/6135 /CLEAR KW12 OR DK8-EP EVENT FLAGS NOP/6132 /STOP KW12 CLOCKS NOP/6134 /DISABLE KW12 INTERRUPTS NOP/6530 /CLEAR AD8-EA FLAGS NOP 6050 /CLEAR VC8/E FLAG NOP/6500 /DISABLE XY8/E INTERRUPTS STA NOP/6130 /DISABLE DK8-EP INTERRUPTS CLA /LEAVE SPACE FOR ADDITIONAL CLEARS 6077/NOP /CLEAR DISPLAY*WM* 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 INTEG 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 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; ZBLOCK 10 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 FFIX, 0 /ROUTINE TO FIX FAC STA /ANSWER IS RETURNED IN INTEG TADACX, TAD ACX /ABS(FAC) MUST BE LESS THAN 2048 CLL /DETERMINE IF FAC EXPONENT IS TAD (-13 /BETWEEN 1 AND 13 SNA JMP MAXFIX EAEFIX, DCA INTEG SZL JMP FIXDNE /NO - 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 INTEG /DONE YET? JMP FIXLP /NO FIXDNE, DCA INTEG /RETURN WITH ANSWER IN INTEG JMP I FFIX /RETURN MAXFIX, TAD ACL /FIX ONE BIT OF ACL RAL CLA TAD ACH RAL JMP FIXDNE SETB, TAD DATAF /SET BASE PAGE LOCATION DCA I (BASCDF 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 P10, 10 TAD PCCDF TAD P10 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 PAGE /RUN-TIME SYSTEM ERROR LIST ERRLST, VARGER; ARGMSG UERR; UMSG FPOERR; FPOMSG FMTERR; FMTMSG UNTERR; UNTMSG CTLBER; CTLBMS INERR; INMSG IOVFLO; IOVMSG IOERR; IOMSG DAERR; DAMSG FPPERR; FPPMSG OVERR; OVMSG EOFERR; INEMSG FPOVER; OFLMSG DFERR; DFMSG -1; DV0MSG /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 PRTNAM PAGE MAKCDF, 0 RTL RAL AND [70 TAD ERCDF JMP I MAKCDF MASBCK, 0 /BUMP RECORD BACK BY ONE STA TAD RELBLK DCA RELBLK TAD CHRCTR IAC SZA CLA JMS I [MASSIO JMP I MASBCK /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 / 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, 0;3 /ZERO FUNCTIONS AS 'FEXIT' 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=. /HANDLER SWAP AREA 400 LONG /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 INTEG 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 CORLOC-2 CORELP, CDF 0 /NEEDED FOR PDP-8L TAD I BATLOC AND COR70 CLL RTR /TEST SOFTWARE CORE RAR SZA JMP CORLOC-2 TAD TRYFLD /GET FLD TO TST CLL RTL RAL AND COR70 /MASK USEFUL BITS TAD CORELP DCA .+1 /SET UP CDF TO FLD 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 7400 /HACK FOR PDP-8,.NO-OP TAD .-1 /GUARD AGAINST WRAP AROUND TAD CORLOC+1 /TAD 1400 SZA CLA JMP .+5 /NON EXISTENT FLD EXIT TAD COR70-6 /RESTORE CONTENS DESTROYED DCA I CORLOC ISZ TRYFLD /TRY NXT HIGHER FLD JMP CORELP STA TAD TRYFLD 0 JMP I CORE CORLOC, COR70+2 /ADR TO TST IN EACH FLD 1400 /7000+7400+1400=0 TRYFLD, 1 /CURRENT FLD TO TST C6203, 6203 BATLOC, 7777 DPTEST, STARTE /EXECUTED BY FPP DURING INITIALIZATION FEXIT /CHECK WHETHER DOUBLE PRECISION ENABLED PATCHS=. /PATCHES FOT RUNNING UNDER REAL TIME LPTSNA+2-1 RELOC LPTSNA+2 LLS CLA JMS CTCCHK JMP I LPT CTCLOK, JMS CTCCHK JMP I FPNXT 0 PTP+1-1 RELOC PTP+1 CLA 0 PTR+1-1 RELOC PTR+1 CLA 0 TTY+1-1 RELOC TTY+1 SNA JMP KBDRT TSF JMP .-1 TLS CLA JMS CTCCHK JMP I TTY KBDRT, KSF JMP .-1 JMS CTCCHK KRB AND RT177 TAD RT177 IAC JMP I TTY CTCCHK, . KRS AND RT177 TAD RTM2 CLL RAR SNA CLA KSF JMP I CTCCHK JMP CTLBER-3 RT177, 177 RTM2, -2 0 HINF0+3-1 RELOC HINF0+3 NOP 0 RECOVR+2-1 RELOC RECOVR+2 JMP I RECOVR 0 RTCHK-1 RELOC RTCHK CTCLOK 0 0 RELOC /ERROR MESSAGES 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/ VERSIO, TEXT /FRTS V3AX FT / *HPLACE+400 /BACK INTO MAIN SEQUENCE /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 CLA CMA DCA ACH NRMFAC, DCA AC1 TAD DFLG SPA SNA CLA JMS I DFFNOR 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 DFFNOR JMS I [FFIX TAD INTEG 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 DFFNOR, FFNOR /DIFFERENT FOR DIFFERENT PACKAGES 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 RTCHK, ICYCLE 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 /DOUBLE PRECISION INTEGER OPCODE INTERPRETERS 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 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 STRTF, DCA DFLG 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 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, 0 /ROUTINE TO NEGATE OPERAND TAD OPL /GET LOW ORDER CLL CMA IAC /NEGATE AND STORE BACK DCA OPL CML RAL /PROPAGATE CARRY TAD OPH /GET HI ORDER CLL CMA IAC /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 DOADD /YES-DO ADD TAD ACX /NO-DO EXPONENT CALCULATION CLL CMA IAC TAD OPX SMA SZA /WHICH EXP. GREATER? JMP FACR /OPERANDS-SHIFT FAC CMA IAC /FAC'S-SHIFT OPERAND=DIFFRNCE+1 TAD (-30 SMA JMP NOADD 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 JMP OPADD TAD (30 JMS I [ACSR /SHIFT FAC = DIFF.+1 JMS OPSR /SHIFT OPR. 1 PLACE JMP DOADD /DO ADDITION NOADD, 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 OPADD, CLA DCA ACH DCA ACL JMP DOADD-1 LPBUF4, ZBLOCK 40 LPBUFE PAGE TTERR, 0 CLA TAD HAND TAD MTTY SNA CLA TAD VEOFSW SNA INERR, JMS I ERR JMS I MCDF DCA .+1 HLT STA DCA I VEOFSW+1 CDF 0 TAD [40 DCA EOLSW JMP I TTERR MTTY, -TTY LPBUFE, ZBLOCK 155 LPBUFR FIELD 1