Directory of image this file is from
This file as a plain text file
/FORTRAN 4 RUNTIME SYSTEM - R.L. /AND NOW WITH DOUBLE PRECISION! - MKH /LAST EDITED 5/9/73 /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 INESW, 0 /EXPONENT SWITCH CHCH, 0 FMTNUM, 0 /CONTAINS ACCUMULATED NUMERIC VALUE CTCINH, 0 / C INHIBIT FLAG 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 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; 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 /TERMINATE THIS LINE CLA IAC AND RWFLAG SNA CLA /DID WE HIT THE END OF THE I/O LIST? JMP I ENDREC /NO - RETURN JMP I ENDIO /YES - FINISH UP AND LEAVE 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 AC3777 TAD RWFLAG /ONLY WORKS WHEN SPECIFIED IN SZA CLA /A WRITE OPERATION WHICH HAS RUN OUT OF DATA JMP I (FMTFLP /OTHERWISE IGNORED 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 ACX /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 ACX 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 STA /BETWEEN READ AND WRITE TAD RELBLK DCA RELBLK TAD FFLAGS AND I RWINIT SNA CLA /OR THE I/O TYPE INTO THE FLAG WORD TAD I RWINIT TAD FFLAGS SMA /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 ACX CLL RAL TAD ACX 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 DMPBUF, 0 /ROUTINE TO DUMP CURRENT OUTPUT BUFFER WITH Z 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 ACX / READ/WRITE INIT SINGS THIS SONG, CLL RTL / (DOO DAH, DOO DAH,) RAL / DSRN ENTRIES 9 WORDS LONG TAD ACX / (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 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 LOGUNT, 0 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 JMS I (MASBMP /WILL NOT SKIP TAD CHRPTR TAD 377 DCA T /LOOK AT LAST WORD IN BUFFER 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 (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 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 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 ACX /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 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 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? 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 ACX ISZ T /MULTIPLY RECORD NUMBER BY BLOCKS/RECORD JMP .-2 /TO GET RELATIVE BLOCK NUMBER DCA RELBLK ISZ ACX JMS I (FFLOAT /CONVERT (RECORD NUMBER +1) TO FLTG PT 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 FGPBF 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 ACX 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 ACX TAD ACX /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 ACX 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, -207 /LENGTH ZBLOCK 2 /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 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 NOP 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 SIXOUT /PDPXIT+1 /ROUTINE TO PUNCH RTS+PROGRAM ON FORTRAN UNIT 9 (UNCOMMENTED) PPTR, TAD P11 PCKSUM, DCA ACX 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 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, PDPXIT+1 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 ACX TAD ACX /ABS(FAC) MUST BE LESS THAN 2048 CLL /DETERMINE IF FAC EXPONENT IS TAD (-13 /BETWEEN 1 AND 13 EAEFIX, DCA ACX 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 ACX /DONE YET? JMP FIXLP /NO FIXDNE, DCA ACX /RETURN WITH ANSWER IN ACX JMP I FFIX /RETURN FLOT13, 13 FFLOAT, 0 /ROUTINE TO FLOAT INTEGER IN ACX TAD ACX /RESULT IN FAC DCA ACH /PUT NUMBER IN HI MANTISSA DCA ACL /CLEAR LOW MANTISSA TAD ACH SZA CLA /IF FAC IS NOT ZERO, PUT TAD FLOT13 /11(10) INTO EXPONENT FLOTLP, DCA ACX AC2000 TAD ACH /TEST FOR NORMALIZED NUMBERS SMA SZA CLA /(2XXX,3XXX,4XXX,5XXX,6000) TAD ACH SNA /OR ZERO, JUST TO SAVE SPACE (?) JMP I FFLOAT CLL RAL /NOT NORMALIZED - SHIFT LEFT DCA ACH STA TADACX, TAD ACX /AND TRY AGAIN JMP FLOTLP JMP I FFLOAT /RETURN / /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 TAD PCCDF TAD (10 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 INER; INMSG IOVFLO; IOVMSG IOERR; IOMSG DAERR; DAMSG FPPERR; FPPMSG OVERR; OVMSG EOFERR; INEMSG DBAD+1; DV0MSG FPDVER; DV0MSG FPOVER; OFLMSG DFERR; DFMSG -1; UDFMSG /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 / *.-1 UDFMSG, TEXT /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/ PAGE MAKCDF, 0 RTL RAL AND 70 TAD ERCDF JMP I MAKCDF 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 /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 FEXIT THREE, 0;3 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. TRPPRT, TRAP3 PRTNAM 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 *HPLACE 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 /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 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 DPTEST, STARTE /EXECUTED BY FPP DURING INITIALIZATION FEXIT /CHECK WHETHER DOUBLE PRECISION ENABLED /EAE OVERLAY TO FIX AND FLOAT EFXFLT= . NOPUNC *EAEFIX ENPUNC FIXEAE, CMA DCA FIXSH /SHIFT COUNT BETWEEN 0 AND 12 SZL JMP FIX0 /NOT INTEGERIZABLE TAD ACH ASR FIXSH, 0 FIX0, DCA ACX JMP I FFIX ZBLOCK FLOT13-. /PAD OUT SOME SPACE FLOT13, 13 FFLOAT, 0 CAM DCA ACL TAD ACX /GET INTEGER SNA JMP FLOT0 /ZERO IS A SPECIAL CASE NMI DCA ACH /STORE NORMALIZED MANTISSA SCA CIA TAD FLOT13 /COMPUTE RESULT EXPONENT DCA ACX JMP I FFLOAT FLOT0, DCA ACH JMP I FFLOAT FXFLTC= .-FIXEAE *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 SETB, TAD DATAF DCA I (BASCDF /SET BASE PAGE LOCATION TAD ADR DCA BASADR JMP I FPNXT FPXTA, TAD 27 /XR TO AC - NORMALIZE IF FLOATING MODE DCA ACX JMS DATCDF TAD I ADR CLFAC, DCA ACL DCA ACH TAD DFLG SMA SZA CLA JMP I FPNXT JMP I (NRMFAC /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 FFIX TAD ACX 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 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 FPNXT 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 DDSUB, JMS DARGET JMS I (OPNEG SKP DDADD, JMS DARGET DCA AC1 /CLEAR OVERFLOW JUSTINCASE JMS I OADD JMP I FPNXT DARGET, 0 DCA ADR TAD DARGET DCA ARGET DCA ACX JMP ARGET2 /FAKE OUT FLOATING POINT ROUTINE 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 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 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 SPA 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 /"NRMFAC" AND "OPNEG" MUST BE AT 0 AND 3 ON PAGE NRMFAC, DCA AC1 /KILL OVERFLOW BIT JMS FFNOR JMP I FPNXT 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 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, JMS I ACSR /SHIFT FAC = DIFF.+1 JMS OPSR /SHIFT OPR. 1 PLACE JMP DOADD /DO ADDITION /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 LPBUF4, ZBLOCK 60 LPBUFE PAGE /PAGE 7400 UNUSED RIGHT NOW LPBUFE, ZBLOCK 177 LPBUFR FIELD 1 /FORTRAN 4 RTS LOADER - R.L. /WITH DOUBLE PRECSION - MKH /LAST EDITED 5/9/73 /COPYRIGHT 1973 /DIGITAL EQUIPMENT CORP. /MAYNARD MASSACHUSETTS 01754 /PAGE 0 LOCATIONS FOR RTS LOADER X0= 10 X1= 11 X2= 12 X3= 13 HADR= 20 UNIT= 21 HCWORD= 22 MXFLD= 23 HLDADR= 24 HGHFLD= 25 HGHADR= 26 RLTMP= 27 HDIFF= 30 CFLAG= 31 /DURING MOST OF THE LOAD OPERATION A SECTION OF FIELD RTS /IS MOVED UP INTO FIELD 1 AND THE VACATED AREA OF FIELD 0 IS USED /TO RUN THE COMMAND DECODER AND TO ACCUMULATE DEVICE HANDLERS. /*K* THEREFORE, IF THE RTS LOADER IS TO MODIFY ANY CODE BETWEEN /"F0HBEG" AND "F0HEND" IT MUST MODIFY IT IN FIELD 1 IN THE "F0TO" AREA. F0HBEG= 0 F0HEND= 3000 F0HSAV= 7000 /400 WORDS WHERE DEVICE HANDLERS ARE TEMPORARILY SAVED /SO THAT THEY WON'T INITIALIZE THEMSELVES WRONG /RTS LOADER TABLES *2000 IONTBL, ZBLOCK 100 /INTERRUPT ENABLE TABLE - LOW BIT ONLY HCWTBL, ZBLOCK 14 /HANDLER CONTROL WORD - ONE PER PAGE (LOTSA WASTE) TFTABL, ZBLOCK 45 /TENTATIVE FILE SAVE TABLE DVTEMP, ZBLOCK 17 /HANDLER ENTRY TABLE SAVE AREA *IONTBL+5 /RK8 / RK8E 1 *IONTBL+16 /DTA 1 *IONTBL+6 /RF08 IN 4 FLAVORS 1;1;1;1 *IONTBL+0 /TTY 2 /FORMS CONTROL ON TTY *IONTBL+4 /LPT 2 /FORMS CONTROL ON LPT PAGE /RTS LOADER RTSLDR, JMS I (RTINIT JMS I (RTINIT /INITIALIZE WHETHER CHAINED TO OR NOT JMP NOCD LICD, JMS I (200 5 1404 /.LD DEFAULT EXTENSION NOCD, JMS I (TSTSWS /TEST /E AND /H SWITCHES TAD I (7617 SNA JMP LICD AND (17 JMS I (GETHAN /GET HANDLER TO LOAD WITH 0 /DON'T PUT IT ANYWHERE TAD I (7620 DCA LIBLK JMS I (SVHND /COPY HANDLER TO AVOID BAD INITIALIZATION CIF 0 JMS I HLDADR 0200 LHDR, QLHDR LIBLK, 0 JMP LDIOER JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER CDF 0 TAD HADR DCA I (OVHND TAD HCWORD DCA I (OVHCDW TAD (QUSRLV-1 DCA X0 AC7776 TAD I LHDR SZA CLA /VERIFY LOADER IMAGE INPUT JMP NOTLI /GOOD THING WE CHECKED! TAD DPFPP TAD I (QDPFLG /CHECK IF TRYING TO USE D.P. WITHOUT OPTION SMA CLA JMP .+3 JMS I (RLERR /YES - PRINT WARNING MESSAGE NODPMS /BUT LET THE FOOL GO ON /SET UP RTS TABLES FROM LOADER IMAGE CDF 0 TAD (OVLYTB-1 DCA X1 TAD (-10 DCA RLTMP OVRELP, TAD I X0 DCA I X1 /MOVE USER OVERLAY INFO INTO SWAP TABLE, TAD I X0 DCA I X1 TAD I X0 TAD LIBLK /RELOCATING THE BLOCK NUMBERS DCA I X1 TAD I X0 DCA I X1 ISZ RLTMP JMP OVRELP TAD I (QRTSWP AND (7770 /TURN THE LOADER INITIAL SWAP WORD DCA I (STSWAP+2 TAD I (QRTSWP /INTO A DUMMY SWAP WORD AND A JUMP WORD AND (7 /SO THAT WE CAN HALT BETWEEN TAD (JA /LOADING AND STARTING USERS PROGRAM. DCA I (STJUMP TAD I (QRTSWP+1 DCA I (STJUMP+1 TAD I (QHGHAD DCA HGHFLD CLA IAC TAD HGHFLD CMA DCA I (FCNT TAD I (QHGHAD+1 DCA HGHADR JMS I (GETFIL /GET USER I/O FILES IF ANY TAD I (OS8DAT /SALT AWAY OS/8 DATE WORD DCA I (VDATE-F0HBEG+F0TO STL CLA 6141 /TEST IF WE ARE ON A PDP-12 0261 /ROL I 1 - PUTS LINK IN AC11 0002 /PDP DCA I (V8OR12+1-F0HBEG+F0TO JMS I (MOVE CDF 10 SPSTRT /MOVE SPECIAL /P START CODE TO LOC 200 CDF 10 200-F0HBEG+F0TO /RELOCATED 200, THAT IS -3 JMP I (MOVCOR DPFPP, 3777 /0 IF D.P. FPP AVAILABLE NOTLI, JMS I (RLERR NOLI JMP LICD LDIOER, JMS I (RLERR LIOEMS CDF CIF 0 JMP I (7605 PAGE /FIGURE OUT CORE LIMITS AND WRITE OUT PG 17600 MOVCOR, TAD I (HTOP TAD HDIFF /GET BOTTOM OF HANDLER AREA CIA CLL /LENGTH OF HANDLER AREA IN AC TAD HGHADR SZL /TRICKY CODE - IF (L,AC)=0, AC GETS -1 STA /IF (L,AC) =0XXXX, AC GETS 0 SNA CLA /IF (L,AC) =1XXXX, AC GETS 1 STL STA /THERE OUGHTA BE A SHORTER WAY - RAL /I'D APPRECIATE HEARING ONE. TAD HGHFLD /USE MAGIC NUMBER TO ADJUST HGHFLD CIA /BEFORE WE COMPARE IT TO TOP-OF-CORE TAD MXFLD SPA CLA JMP TOOBIG /ALL THAT WORK FOR NOTHING! TAD MXFLD CLL RTL RAL TAD (CDF DCA HCDF /PREPARE TO TRANSFER THE HANDLERS JMS I (MOVE /BEFORE WE MOVE THE HANDLERS WE SHOULD WRITE CDF 10 /OUT PAGE 17600 AND THE RTS CLEANUP CODE TFTABL-1 /SINCE THE HANDLERS MAY OVERLAY THEM. CDF 10 /SO FIRST MOVE THE TENTATIVE FILE TABLE 7600-1 /INTO PAGE 17600 WHERE IT'S SAFE. -45 CIF 0 JMS I (7607 4210 7400 37 /SUITABLE SCRATCH BLOCK JMP SYSERR TAD HDIFF TAD (F0HEND /CHANGE HDIFF FROM AN OFFSET DCA HDIFF /TO THE FIRST LOC ABOVE THE HANDLERS. /SHUFFLE CORE AROUND AND START UP RTS HLOOP, STA TAD HDIFF /WE HAVE TO MOVE THE HANDLERS IN A COCKEYED DCA HDIFF /WAY SINCE WE MIGHT BE PARTIALLY SWAPPING CDF 0 /CORE BETWEEN FIELD 0 (THE HANDLERS) AND STA /FIELD 1 (WHERE WE SAVED FIELD 0) IN 8K SYSTEMS. TAD HPTR1 DCA HPTR1 STA TAD HPTR2 DCA HPTR2 TAD I HPTR1 HCDF, HLT /MOVE A HANDLER WORD FROM FIELD 0 DCA I HDIFF /TO FIELD N CDF 10 TAD I HPTR2 /MEANWHILE RESTORE FIELD 0 CDF 0 DCA I HPTR1 /FROM FIELD 1 ISZ HMCT JMP HLOOP /DO MORE THAN WE HAVE TO - IT CAN'T HURT CDF CIF 0 TAD (5606 DCA I (7605 /SET UP OS/8 RETURN SEQUENCE TO TRAP TO RTS TAD (PDPXIT DCA I (7606 /AS RANDOM RESTARTS COULD BE FATAL. FPICL /RE-INITIALIZE FPP (IF ANY) CLA IAC 6654 /LOAD PRINTER BUFFER ON ANALEX PRINTER SZA CLA /IS ANALEX PRESENT? JMP I (FPSTRT /NO - START UP DCA I (LPTEST /IF ANALEX TAKE OUT LPT INTERNAL HANDLER LP6652, 6652 /ALSO CLEAR ALL ANALEX FLAGS DCA I (LPTSNA 6662 /CLEAR BUFFER ON ANALEX TAD (6651 DCA I (LPTERR /REPLACE LP08 ERROR CODE BY ANALEX TAD LP6652 /TO AVOID HANGING ON ANALEX POWER OFF. DCA I (LPTERR+2 JMP I (FPSTRT TOOBIG, JMS I (RLERR TOOMCH OS8RTN, CDF CIF 0 JMP I (7605 SYSERR, JMS I (RLERR SYSMSG JMP OS8RTN HPTR1, F0HEND HPTR2, F0TO+F0HEND-F0HBEG HMCT, F0HBEG-F0HEND /MOVE ROUTINE MOVE, 0 /GENERAL MOVE SUBROUTINE CDF 10 CLA TAD MOVE DCA X2 TAD I MOVE DCA FRMFLD TAD I X2 DCA X3 TAD I X2 DCA TOFLD TAD I X2 DCA X1 TAD I X2 DCA MVC FRMFLD, HLT TAD I X3 TOFLD, HLT DCA I X1 ISZ MVC JMP FRMFLD CDF 10 JMP I X2 MVC, 0 HNDERR, JMS I (RLERR TOMNYH JMP OS8RTN PAGE /INITIALIZATION RTINIT, 0 ISZ RTINIT /SKIP RETURN CIF 0 JMS I (CORE DCA MXFLD CLA IAC JMS I (GETION /GET ION BIT FOR SYS HANDLER DCA I (HCWTBL+13 /SAVE IT SWAB /SET EAE MODE TO B (IF 8/E) FPICL /INITIALIZE FPP (IF ANY) CLA IAC SHL CLA IAC /LOW ORDER BITS 01 TAD (-2 SNA CLA /TEST FOR 8/E EAE JMS I (MOVEAE /YES - SUBSTITUTE PACKAGES TAD (APT FPST /START FPP ON "STARTE;FEXIT" JMP NOFPP /DIDN'T START JMS I (MOVE CDF 10 FPPINT-1 /THE FPP HANDLER AND D.P. I/O PKG IS IN THE CDF 0 /SAME LOCATIONS IN FIELD 1 AS THE FPPINT-1 /FPP INTERPRETER IN FIELD 0. -1000 /COUNT FOR DBL PREC SPACE FPRST /FPP HAD BETTER BE DONE BY NOW!! AND (4 /GET D.P. STATUS BIT SNA CLA JMP NOFPP /NO DOUBLE PRECISION DCA I (DPFPP /SET FLAG TO INDICATE D.P. AVAILABLE CDF 0 TAD (DFMT DCA I (DF /ENABLE D FORMAT TAD (BFMT DCA I (BF /AND B FORMAT CDF 10 NOFPP, JMS I (MOVE RICDF0, CDF 0 F0HBEG-1 CDF 10 F0TO-1 /MOVE LOWER F0 INTO F1 FOR SAFEKEEPING F0HBEG-F0HEND CDF 0 TAD I (OSJSWD /GET OS/8 STATUS WORD AND (6374 /FORCE BITS ON INDICATING NON-RESTARTABLE JOB TAD (1003 /AND DESTRUCTIVE CALLS TO CD AND USR DCA I (OSJSWD /MEANWHILE FORCING "BATCH SAVED" BIT OFF TAD I (7642 AND (7707 /CHECK FOR IN-CORE TD8E'S TAD (-6203 /NO MATTER WHAT FIELD THEY'RE IN SZA CLA JMP NOTDSY TAD MXFLD CLL RTL RAL TAD RICDF0 DCA TD8EFG /SET TD8E FLAG WHICH IS ALSO CDF TAD I (7642 AND (70 TAD RICDF0 /GET THE FIELD WE'RE COMING FROM DCA TD8EFL TAD TD8EFG IAC JMS I (TDSET /REDO THE CDF'S IN F0 JMS I (MOVE TD8EFL, CDF 20 7577 TD8EFG, 0 7577 -174 /SPARE BATCH PARAMETERS IN TOP FIELD TAD MXFLD /SET FLAG IN CLEANUP ROUTINE DCA I (TDEXFG /TO RESTORE TD8E HANDLER TO FIELD 2 NOTDSY, CDF 10 TAD MXFLD TAD (-7 SNA /32K? JMP TAKCAR /YES - UNIQUE PROBLEMS TAD (6 SNA CLA /8K? JMP ONLY8K /YES - IGNORE BATCH & TD8E CRAP JMS I (GBFLG /GET BATCH FLAG TAD TD8EFG SNA CLA /IF NO BATCH OR TD8E'S, ONLY8K, TAD (200 /USE ALL OF THE LAST FIELD. STOHDF, TAD (-F0HEND-200 DCA HDIFF /OTHERWISE USE ONLY UP TO 7600 JMP I RTINIT TAKCAR, JMS I (GBFLG /GET BATCH FLAG SNA CLA JMP NO32KB /NO BATCH - USE UP TO 77400 (TD8E ROM) TAD (6 /BATCH - USE UP TO 67600 DCA MXFLD JMP STOHDF NO32KB, TAD TD8EFG SNA CLA /IF IN-CORE TD8E'S TAD (7600 /LIMIT IS 77600 ELSE 77400 JMP STOHDF PAGE GETHAN, 0 /GET HANDLER SUBROUTINE AND (17 DCA UNIT DCA H1 TAD UNIT JMS I (200 12 /INQUIRE H1, 0 NOP /ERROR RETURN ALWAYS SKIPPED TAD H1 SNA JMP NOTLDD /NOT IN CORE - MUST LOAD JMS HCWTBA /IN CORE GHEXIT, TAD I HCWPTR /GET CONTROL WORD FOR HANDLER PAGE DCA HCWORD TAD HLDADR DCA HADR /ASSUME HANDLER PERMENANTLY RESIDENT TAD (-4 AND HCWORD SNA CLA /WERE WE RASH? JMP .+5 /NO TAD HADR AND (177 TAD (HPLACE /YES - I APOLOGIZE DCA HADR TAD I GETHAN /GET DSRN NUMBER SNA JMP I GETHAN /NO DSRN NUMBER CLL RTL RAL TAD I GETHAN TAD (DSRN-12 DCA X0 /XR POINTS TO DSRN ENTRY CDF 0 TAD HADR DCA I X0 /SEE PG 0, FLD 0 FOR DSRN FORMAT TAD HCWORD TAD CFLAG /THE C BIT REVERSES THE FORMS CTL BIT ON THIS FILE AND (7773 /KILL ANY OVERFLOW DCA I X0 TAD HGHFLD CLL RTL RAL TAD HGHADR DCA I X0 /SAVE BUFFER ADDRESS, FIELD TAD HGHADR DCA I X0 /INITIALIZE WORD POINTER TAD HGHADR TAD (400 SNA ISZ HGHFLD /BUMP DOUBLEWORD BUFFER ADDRESS DCA HGHADR AC7775 DCA I X0 /INITIALIZE CHAR CTR CDF 10 JMP I GETHAN /RETURN /LOAD A NON-RESIDENT HANDLER NOTLDD, JMS GH CLA IAC JMS GH /TRY 1-PAGE AND THEN 2-PAGE ASSIGN HLT /ARRRGHHHH!!! GH, 0 DCA TPFLG TAD HTOP TAD (7600 /BUMP HANDLER CEILING DOWN SNA JMP I (HNDERR /CAN'T PUT HANDLER IN PAGE 0 DCA HTOP TAD TPFLG TAD HTOP DCA GHADR TAD UNIT JMS I (200 1 /FETCH HANDLER GHADR, 0 JMP I GH /FAILED! TAD GHADR /SAVE ACTUAL LOAD ADDRESS JMS HCWTBA /INDEX INTO HCW TABLE TAD GHADR AND (7600 TAD HDIFF DCA GHADR /SAVE RELOCATED HANDLER PAGE ADDRESS TAD MXFLD /PUT ADDR IN BITS 0-3 AND FIELD IN BITS 6-8 CLL RTL RAL TAD GHADR DCA GHADR TAD UNIT JMS I (GETION /ION BIT INTO BIT 11, FORMS CTL BIT INTO BIT 10 TAD GHADR DCA I HCWPTR /STORE POINTER FOR THIS PAGE JMP GHEXIT HCWTBA, 0 DCA HLDADR TAD HLDADR AND (7600 CLL RTL RTL RTL /GET PAGE NUMBER TAD (HCWTBL-24 DCA HCWPTR /SAVE POINTER INTO TABLE JMP I HCWTBA HTOP, F0HEND HCWPTR, 0 TPFLG, 0 SPSTRT, SWAB / /P STARTUP CODE - MAKE SURE EAE IS IN MODE B 5602 /EXECUTES AT 200 FPSTRT /START UP IN FLAG CLEARING CODE PAGE /ROUTINE TO ACCEPT FILE SPECIFICATIONS GETFIL, 0 CDF 10 TAD I (OS8SWS-1 SPA CLA /ALTMODE MEANS NO MORE SPECS JMP I GETFIL GETFCD, JMS I (SPMDCD /CALL CD IN SPECIAL MODE TAD I (7600 STL CIA SNA /OUTPUT FILE? TAD I (7605 SNA /IN OR OUT FILE? TAD I (OS8SWS+3 /NEITHER - HOW ABOUT INTERNAL HANDLER? SNA CLA JMP GETFIL+1 /NONE OF THE ABOVE RAR /LINK MAGICALLY TELLS DIRECTION DCA DIR DCA DSRNUM TAD I (OS8SWS+2 AND (777 /SWITCHES 1-9 SNA JMP NONUM CLL RTL DNUMLP, ISZ DSRNUM RAL SMA JMP DNUMLP /TRANSLATE SWITCH INTO NUMBER TAD DIR /** AC IS NEGATIVE ** SPA CLA TAD (5 TAD (7600 DCA FPTR /POINT TO FILE UNIT TAD I FPTR SNA JMP INTHND /NO FILE - GET HANDLER FROM INTERNAL LIST JMS I (GETHAN /GET HANDLER - XR10 POINTS INTO DSRN DSRNUM, 0 /DSRN ENTRY NUMBER TAD DIR STL RTL /GENERATE 2 OR 3 (LOOKUP OR ENTER) DCA LKPNTR TAD I FPTR /GET UNIT AND REQUESTED BLOCK COUNT (IF ENTER) ISZ FPTR /BUMP POINTER SO IT POINTS TO THE FILE NAME DCA FUNIT /SAVE UNIT NUMBER A SEC TAD I FPTR /WATCH OUT FOR NULL FILE NAMES SNA CLA /AS THEY WILL FAIL ON LOOKUPS JMP NONAME /ON OUTPUT-ONLY NON-DIRECTORY DEVICES JMS I (SVHND /SAVE HANDLER TAD FUNIT JMS I (200 LKPNTR, 0 /LOOKUP OR ENTER FPTR, 0 /FILE NAME FUNIT, 0 /GETS LENGTH JMP FILERR /SOMETHING NOT KOSHER JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER STDSRN, TAD FPTR CDF 0 DCA I X0 /SAVE STARTING BLOCK DCA I X0 /RELATIVE BLOCK TAD FUNIT SNA IAC /FUDGE NON-DIRECTORY DEVICES VERY LARGE CIA /TURN NEGATIVE COUNT TO POSITIVE DCA I X0 /LENGTH TAD X0 DCA FPTR /SAVE PTR TO LENGTH WORD CDF 10 TAD DIR SMA CLA /TENTATIVE FILE? JMP GETFIL+1 TAD FPTR /YES - STORE POINTER TO LENGTH WORD OF DSRN DCA I TFPTR /IN TENTATIVE FILE TABLE ENTRY JMS I (MOVE CDF 10 7600-1 CDF 10 TFPTR, TFTABL /SAVE FILE NAME AND UNIT IN -5 /TENTATIVE FILE TABLE TAD TFPTR TAD (6 DCA TFPTR /BUMP PTR TO NEXT 6-WORD ENTRY JMP GETFIL+1 NONUM, JMS I (RLERR NONMSG JMP GETFCD FILERR, JMS I (RLERR FILMSG JMP GETFCD DIR, 0 NONAME, DCA FPTR DCA FUNIT /ZERO BLOCK # AND LENGTH JMP STDSRN /USE ENTIRE DEVICE AS FILE INTHND, STA TAD I (OS8SWS+3 AND (3 /ONLY USE LOW ORDER 2 BITS OF NUMBER TAD (IHTBL DCA HADR /SAVE PTR INTO TABLE OF INTL HANDLERS TAD DSRNUM CLL RTL RAL TAD DSRNUM /MULTIPLY DSRN NUMBER BY 9 TAD (DSRN-11 /ADD TABLE BASE DCA DSRNUM TAD I HADR CDF 0 DCA I DSRNUM ISZ DSRNUM AC7776 TAD CFLAG /DEPENDING ON THE C FLAG, CIA DCA I DSRNUM /DISABLE OR ENABLE FORMS CONTROL JMP GETFIL+1 PAGE /RTS LOADER ERROR MESSAGE ROUTINE & MESSAGES RLERR, 0 CLA CDF 10 TAD I RLERR DCA RLTMP RELP, TAD I RLTMP RTR RTR RTR AND (77 JMS LTTY TAD I RLTMP AND (77 JMS LTTY ISZ RLTMP JMP RELP EOMSG, TAD (7515 JMS LTTY TAD (7512 JMS LTTY ISZ RLERR JMP I RLERR /SOME MESSAGES ARE NOT FATAL LTTY, 0 SNA JMP EOMSG TAD (240 SMA AND (77 /CONVERT SIXBIT TO EIGHTBIT TAD (240 TLS CLA TSF JMP .-1 JMP I LTTY TSTSWS, 0 /ROUTINE TO TEST CD SWITCHES E AND H TAD I (OS8SWS AND (20 CDF 0 SNA CLA /TEST FOR /H SWITCH JMP .+3 TAD (HLT DCA I (HLTNOP /SET TO HALT BEFORE STARTING PROGRAM CDF 10 TAD I (OS8SWS AND (200 CDF 0 SZA CLA /TEST FOR /E SWITCH ISZ I (ERRFLG /MAKE USER ERRORS NON-FATAL CDF 10 /(USER ERROR = MISSING SUBROUTINE, ETC) TAD I (OS8SWS+1 AND (400 CDF 0 SNA CLA /TEST FOR /P SWITCH JMP .+3 /NO, PRAISE BE! TAD (SKP /GIVE THE DUMMY WHAT HE WANTS DCA I (HLTNOP CDF 10 TAD I (OS8SWS RTL SMA CLA AC0002 DCA CFLAG /SAVE C FLAG IN PAGE0 JMP I TSTSWS MOVEAE, 0 JMS I (MOVE CDF 10 FPPKG-1 /THE EAE PKG IS IN THE SAME PAGE IN FIELD 1 CDF 0 FPPKG-1 /AS THE NON-EAE PKG IN FIELD 0 -600 JMS I (MOVE CDF 0 /SUBSTITUTE FAST FIX AND FLOAT EFXFLT-1 CDF 0 EAEFIX-1 -FXFLTC JMP I MOVEAE SPMDCD, 0 /SUBR TO DO A SPECIAL MODE COMMAND DECODE JMS I (MOVE CDF 10 OS8DVT-1 CDF 10 DVTEMP-1 /MOVE OS/8 DEVICE HANDLER TABLE -17 /SINCE C.D. CLEARS IT AND WE ARE USING IT TAD I (HTOP /GET LOWEST HANDLER LOADED RAL SZL SPA CLA /DID WE LOAD ANY BELOW 02000? JMP .+4 /NO CDF 0 ISZ I (OSJSWD /YES - MAKE CD CALLS DESTRUCTIVE ISZ I (OSJSWD CDF 10 JMS I (200 5 /COMMAND DECODE 5200 /SPECIAL MODE - WROUGHT WITH PERIL 0 /DON'T CLEAR TENTATIVE FILES JMS I (MOVE CDF 10 DVTEMP-1 CDF 10 OS8DVT-1 -17 /MOVE DEVICE HANDLER TABLE BACK JMS TSTSWS /CHECK FOR /E, /H, /P JMP I SPMDCD IHTBL, PTR;PTP;LPT;TTY /INTERNAL HANDLER TABLE PAGE GETION, 0 TAD (OS8DCB-1 DCA GMADR TAD I GMADR /GET DCB WORD CLL RTR RAR AND (77 /INDEX INTO TABLE TAD (IONTBL /WHICH INDICATES IF HANDLER CAN EXECUTE DCA GMADR /WITH INTERRUPTS ON TAD I GMADR /ION BIT INTO BIT 11, FORMS CONTROL INTO BIT 10 JMP I GETION GBFLG, 0 CDF 0 TAD I (7777 /SPECIAL FLAGS LOC CDF 10 RTL CLA RAL JMP I GBFLG SVHND, 0 /ROUTINE TO SAVE HANDLER IN F1 JMS GMADR /GET MOVE FROM ADDRESS JMP I SVHND /NO HANDLER TO MOVE DCA SVMOVE JMS I (MOVE CDF 0 SVMOVE, 0 CDF 10 F0HSAV-1 -400 JMP I SVHND RSTHND, 0 /ROUTINE TO RESTORE HANDLER FROM F1 JMS GMADR JMP I RSTHND /HANDLER IS SYS: DCA RSTMOV JMS I (MOVE CDF 10 F0HSAV-1 CDF 0 RSTMOV, 0 -400 JMP I RSTHND GMADR, 0 TAD HLDADR SPA /CHECK THAT WE'RE NOT TRYING JMP RESHND /TO SAVE A RESIDENT HANDLER - AND RESHND /THAT COULD BE TRICKY TAD (-1 /ECCH ISZ GMADR JMP I GMADR RESHND, 7600 JMP I GMADR /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/ PAGE F0TO= . /FLOATING POINT PROCESSOR HANDLER *FPPINT RETURN, JMP FPPRTN /MUST BE AT 0 IN PAGE FPGO, 0 /FPP STARTUP ROUTINE - MUST BE AT 1 IN PAGE CDF 0 DCA STEFLG TAD PC DCA FSAVPC /SAVE OLD PC FOR ONE LEVEL TAD APT DCA SAVAPT /OF RE-ENTRANTNESS TAD I FPGO DCA PC TAD APT AND (7770 DCA APT /SET UP ADDRESS IN APT FPREST, TAD (400 /ENABLE FPP INTERRUPTS FPCOM /LOAD AND STORE ENTIRE APT CLA /NECESSARY? TAD STEFLG /0 OR 4000?(STARTF OR STARTE) SZA 6567 /A MNEMONIC? CLA TAD (APT IOF FPST /START UP FPP JMP .-1 /I HAVE NO IDEA WHY IT DIDN'T START CLA /NECESSARY? JMS I (HANG /EXECUTE BACKGROUND FPUHNG FPRST /READ FPP STATUS FPICL /RESET FPP ION RTL SZL /TEST TRAP BIT JMP TRAP /YUP - GO EXECUTE IT AND (7400 SZA /ANY ERRORS? JMP FPPER TAD FSAVPC DCA PC /RESTORE OLD PC TAD SAVAPT DCA APT ISZ FPGO JMP I FPGO /FLOATING POINT TRAP PROCESSOR TRAP, AC7775 TAD PC DCA PC /BACK UP PC TO BEFORE THE TRAP SZL STA TAD APT /INCLUDING THE FIELD BITS JMS I MCDF DCA I (PCCDF JMS I (FETPC DCA T TAD T /GET TRAP WORD JMS I MCDF IAC /MAKE A "CDF CIF N" IAC DCA TRPCIF JMS I (FETPC DCA ADR /STORE PDP8-CODE ROUTINE ADDRESS TAD T TRPCIF, HLT /SET DATA AND INSTRUCTION FIELDS SMA CLA /TRAP3 OR TRAP4? JMP I ADR /TRAP3 - GO TO ADR JMS I ADR /TRAP4 - CALL ADR FPPRTN, DCA STEFLG ISZ PC /RESTORE PC FROM BEFORE TRAP NOP CDF 0 JMP FPREST /RESTART FPP FPPER, SPA JMP I (FPPERR /FPHALT - FATAL ERROR RTL ISZ FATAL /DIVIDE BY 0 AND OVERFLOW ARE NON-FATAL SZL JMP FPDVER FPOVER, JMS I ERR SKP FPDVER, JMS I ERR TAD . /I ALWAYS WANTED TO INCLUDE ONE OF THESE! DCA ACX AC2000 DCA ACH JMP FPREST FSAVPC, 0 SAVAPT, 0 STEFLG, 0 /RANDOM FPP CODE FOR D.P. I/O DFSTM2, FSTA+LONG DFTMP2 FEXIT PAGE /THIS IS DOUBLE PRECISION FORMATTED OUTPUT. /ITS A LOT LIKE SINGLE PRECISION,WITHOUT ALL THE G + I STUFF /AND, OH JOY!, NO PAGE 0 LITERALS. DNXT, TAD RWFLAG /READ OR WRITE? SMA CLA AC4000 /ITS INPUT SO LEAVE IN STARTE MODE JMS I (GETLMN JMP .+3 DFMT, STA BFMT, DCA EFLG TAD D DCA OD /SAVE COUNT OF DIGITS AFTER DEC PT TAD PFACT DCA PFACTX DCA SCALE JMS I (SKPOUT /DONE? JMP I (DPIN /ITS INPUT STA /ITS OUTPUT DCA I (FFNEG /USE THIS LOCN AS SIGN FLAG TAD EFLG CLL RAL CLL RAL TAD W /GIVE ROOM FOR EXP FIELD (IF ANY) CLL /NECESSARY? DCA I (OW TAD ACH SNA JMP SKPZRO /IF AC 0,SKIP ALOT OF THIS SMA CLA JMP DSCLUP JMS I (DFNEG /AC<0-NEGATE IT DCA I (FFNEG / 0 <> 7777 DSCLUP, DCA SCALE TAD ACX SMA SZA CLA /AC<1.0? JMP DGT1 /NO AC4000 /STARTE JMS I (FPGO /Y-MULT BY 10. FMUL10 STA TAD SCALE /BUMP POWER OF TEN JMP DSCLUP DGT1, JMS I (DSCLDN /NUMBER IS >=1.;NOW DECREASE IT TO (0,1) AC4000 JMS I (FPGO /SAVE IT FSTTMP TAD (22 JMS I (OSCALE AC4000 JMS I (FPGO FADTMP JMS I (DSCLDN SKPZRO, JMS I (DIGCNT /NO NEED FOR ALL THE G STUFF TO BE /INCLUDED IN THE SINGLE PREC ROUTINE /MAKE NOTG ROUTINE A SUBROUTINE SMA /EQUIV TO OUTNUM IN SINGLE PREC JMP DASTRS JMS I (OBLNKS AC7775 ISZ I (FFNEG /IF SIGN IS NEG, JMS I (DIGIT /PRINT A MINUS CLA TAD ACX SNA /ALIGN FAC MANTISSA INTO A JMS I (DAL1 /FRACTION (.1,1) IAC SPA JMS I (DACSR CLA TAD EAC3 DCA AC1 /MOVE FAC DOWN SO OVERFLOW FROM TAD EAC2 /MULT BY 10 IN HIGH ORDER WORD DCA EAC3 TAD EAC1 DCA EAC2 TAD ACL DCA EAC1 TAD ACH DCA ACL TAD SCALE SPA SNA /ANY DIGITS TO LEFT OF DEC PT? JMP I (DPRZRO /N-PRINT A 0 /JUST AS CHEAP TO DUPLICATE CODE JMS I (DBLDIG /Y- PRINT THEM DRDCPT, AC7776 JMS I (DIGIT /PRINT A DEC PT TAD SCALE SMA CLA /NEED LEADING ZEROS? JMP DNOLZR /NO TAD SCALE DCA T DLZERO, STA CLL TAD OD /DECREASE D VALUE SNL JMP DNOMAC /NO MORE FIELD WIDTH AVAILABLE DCA OD JMS I (DIGIT /PRINT A 0 ISZ T /CONT UNTIL COUNT OR WIDTH RUNS OUT JMP DLZERO DNOLZR, TAD OD SZA JMS I (DBLDIG /PRINT REMAINING DIGITS DNOMAC, CLA TAD EFLG SZA /IF EFLG IS NOT ZERO IT IS -1, JMS I (EXPFLD /SO WE WILL PRINT A D INSTEAD OF AN E JMP I (DNXT DASTRS, JMS I (ASTRSK JMP I (DNXT PAGE DBLDIG, 0 /OUTPUT DIGITS CIA DCA T DBDLOP, DCA ACH /0 THE HI WORD FOR OVERFLO TAD AC1 DCA AC2 /START TO COPY THE FAC.THIS IS TAD ACL /EAC3 SHIFTED DOWN 1 WORD DCA OPL TAD EAC1 DCA L1 /ACL TAD EAC2 DCA DACSR /EAC1 TAD EAC3 DCA DSCLDN /EAC2 JMS DAL1 JMS DAL1 CLL TAD AC2 TAD AC1 DCA AC1 /THIS IS FAC*5 COMING UP RAL TAD DSCLDN TAD EAC3 DCA EAC3 RAL TAD DACSR TAD EAC2 DCA EAC2 RAL TAD L1 TAD EAC1 DCA EAC1 RAL TAD OPL TAD ACL DCA ACL RAL TAD ACH DCA ACH JMS DAL1 TAD ACH JMS I (DIGIT ISZ T JMP DBDLOP JMP I DBLDIG DSCLDN, 0 /USED AS A TEMP TOO TAD ACX SPA SNA CLA JMP I DSCLDN /DONE IF FAC<1. AC4000 JMS I (FPGO FDIV10 ISZ SCALE 0 /A FREE LOCN! JMP DSCLDN+1 DPRZRO, CLA JMS I (DIGIT JMP I (DRDCPT /6 WORD FAC LEFT SHIFT DAL1, 0 TAD AC1 /GET OVERFLO BIT CLL RAL /SHIFT LEFT DCA AC1 TAD EAC3 /CONTINUE WORKING WAY UP THRU MANTISSA RAL DCA EAC3 TAD EAC2 RAL DCA EAC2 TAD EAC1 RAL DCA EAC1 TAD ACL RAL DCA ACL TAD ACH RAL DCA ACH JMP I DAL1 DFLTM2, FLDA+LONG DFTMP2 FEXIT DFTMP2, 0;0;0;0;0;0 /6 WORD FAC RIGHT SHIFT. ENTER WITH COUNT-1 IN AC / DACSR, 0 /USED AS A TEMP BY DBDLOP DCA AC0 /STORE COUNT DLOP1, TAD ACH CLL SPA /PROPOGATE SIGN CML RAR DCA ACH /SHIFT RIGHT 1,PROPOGATE SIGN TAD ACL /DO SHIFTING FOR EACH WORD OF MANTISSA RAR DCA ACL TAD EAC1 RAR DCA EAC1 TAD EAC2 RAR DCA EAC2 TAD EAC3 RAR DCA EAC3 ISZ ACX /INCREMENT EXPONENT NOP ISZ AC0 /DONE? JMP DLOP1 /NOPE RAR /YUP DCA AC1 /SAVE 1 BIT OF OVERFLOW JMP I DACSR L1, 0 PAGE /THIS IS DOUBLE PRECISION INPUT (WITH FPP ONLY) /IT IS A LOT LIKE SINGLE PRECISION INPUT, BUT USES /ITS OWN FPP ROUTINES. DPIN, STA DCA DDPSW /INITIALIZE DEC. PT. SWITCH STA DCA DINESW /AND EXPONENT SWITCH TAD W CMA DCA FMTNUM /CHAR COUNT DINESM, DCA ACX /CLEAR FLOATING AC DCA ACH DCA ACL DCA EAC1 DCA EAC2 DCA EAC3 STA DINMIN, DCA DFNEG DINLOP, ISZ FMTNUM JMP DINGCH /LOOP UNTIL WIDTH EXHAUSTED DINENM, ISZ I (DFNEG /IS SIGN NEGATIVE? JMS I (DFNEG /YES-NEGATE ISZ DINESW /SEEN A D YET? JMP DFIXUP /YES-THIS IS EXP,NOT NUMBER TAD PFACTX /NO D- SCALE WITH P FACTOR DSCLIN, TAD OD /GET SCALING FACTOR STL SNA JMP I (DNXT /NO SCALING NEEDED SMA CIA CLL /AC CONTAINS MAGNITUDE,LINK CONTAINS SIGN DCA OD RTL RAL TAD (FDIV10 DCA DIGFOP AC4000 JMS I (FPGO /MULT OR DIVIDE BY 10 DIGFOP, 0 ISZ OD JMP DIGFOP-2 /MULT OR DIV CORRECT NUMBER OF TIMES JMP I (DNXT /GET MORE DIND, ISZ DINESW /IS THERE A 2ND D? JMP DINER /Y-A NO-NO ISZ DDPSW /FORCE DEC. PT. SWITCH ON TAD OD /USE SCALE FACTOR IF SEEN DEC. PT DCA SCALE /SAVE SCALE FACTOR ISZ DFNEG JMS DFNEG /GET SIGN OF NUMBER AC4000 JMS I (FPGO /SAVE IT TEMPORARILY DFSTM2 JMP DINESM /GO COLLECT EXP DFIXUP, JMS I (FFIX /IS THIS OK FOR DBL PREC??? TAD ACX CIA TAD SCALE /ADD EXP TO DEC PT SCALE FACTOR DCA OD AC4000 JMS I (FPGO DFLTM2 /GET NUMBER BACK IN FAC JMP DSCLIN DINGCH, JMS I (FMTIN /GET A CHAR JMS I (CHTYPE /CLASSIFY IT 1234; DDIGIT -56; DIDCPT /. -53; DINLOP /+ -55; DINMIN /- -4; DIND /D -5; DIND /E - BE FORGIVING -40; DINLOP /BLANK -54; DINENM /, 0 DINER, JMP I (INER DIDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER DEC PT ISZ DDPSW /TEST + SET DEC PT SWITCH JMP DINER /2 DEC. PT. IS NO GOOD JMP DINLOP DDIGIT, TAD CHCH DCA I (DGT+1 /SAVE DIGIT AC4000 JMS I (FPGO ACMDGT TAD DDPSW SNA CLA ISZ OD /BUMP DIGIT IF DEC PT SEEN JMP DINLOP DDPSW, 0 /6 WORD FLOATING NEGATE DFNEG, 0 TAD EAC3 CLL CMA IAC /NEGATE LOW ORDER WORD OF MANTISSA DCA EAC3 /STORE IT BACK CML RAL /ADJUST OVERFLOW+CARRY TAD EAC2 /CONTINUE WITH REST OF MANTISSA CLL CMA IAC DCA EAC2 CML RAL TAD EAC1 CLL CMA IAC DCA EAC1 CML RAL TAD ACL CLL CMA IAC DCA ACL CML RAL TAD ACH CLL CMA IAC DCA ACH JMP I DFNEG DINESW, 0 PAGE *FPPKG /EAE PKG LOADS OVER REGULAR PKG LPBUF2, ZBLOCK 16 LPBUF5 AL1BMP, 0 /*K* MUST BE AT SAME LOC AS NON-EAE VERSION STA TAD ACX DCA ACX JMS I (AL1 JMP I AL1BMP /EAE FLOATING POINT INTERPRETER /FOR PDP8/E WITH KE8-E EAE /W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN /FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE /THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO /A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY. /(IN THE LOW ORDER, NATCHERLY) DDMPY, JMS I (DARGET SKP FFMPY, JMS I (ARGET JMS EMDSET /SET UP FOR MULT CLA MUY /MULTIPLY-LOW ORDER FAC STILL IN MQ OPH /THIS IS PRODUCT OF LOW ORDERS MQL /ZAP LOW ORDER RESULT-INSIGNIFICANT TAD ACH /GET LOW ORDER(!) OF FAC SWP MUY /TO MQ-HIGH ORD. RESLT OF LAST MPY OPL /TO AC-WILL BE ADDED TO RESLT-THIS DST /IS PRODUCT-LOW ORD FAC,HI ORD OP AC0 /STORE RESULT CLA TAD ACL /HIGH ORDER FAC TO MQ MQL TAD OPX /GET OPERAND EXPONENT TAD ACX /ADD FAC EXPONENT-GET SUM OF EXPS. DCA ACX /STORE RESULT MUY /MUL. HIGH ORDER FAC BY LOW ORD OP. OPH /HIGH ORDER FAC WAS IN MQ DAD /ADD IN RESULT OF SECOND MULTIPLY AC0 DCA ACH /STORE HIGH ORDER RESULT TAD ACL /GET HIGH ORDER FAC SWP /SEND IT TO MQ AND LOW ORD. RESULT DCA AC0 /OF ADD TO AC-STORE IT RAL /ROTATE CARRY TO AC DCA ACL /STORE AWAY MUY /NOW DO PRODUCT OF HIGH ORDERS OPL /FAC HIGH IN MQ, OP HIGH IN OPL DAD /ADD IN THE ACCUMULATED # ACH /MULTIPLIES DONE - MASSAGE RESULT SNA /ZERO? JMP RTZRO /YES-GO ZERO EXPONENT NMI /NO-NORMALIZE (1 SHIFT AT MOST!) DCA ACH /STORE HIGH ORDER RESULT CLA SCA /GET STEP CNTR-DID WE NEED A SHIFT? SNA CLA JMP SNCK /NO-JUST CHECK SIGN TAD AC0 /YES - WATCH OUT FOR LOST ACCURACY! RAL DCA AC0 SZL /IF HIGH ORDER BIT OF OVERFLOW WORD WAS ON, DPIC /TURN MQ11 ON (IT WAS 0 FROM THE NMI) CLA CMA /MUST DECREASE EXP. BY 1 TAD ACX RTZRO, DCA ACX /STORE BACK SNCK, TAD AC0 SPA CLA /IS HIGH ORDER OF OVERFLO WD. 1? DPIC /YES-ADD 1 TO LOW ORDER-STILL IN MQ TAD ACH SMA JMP EMDONE /WE DIDN'T OVERROUND - GOODY LSR 1 /BUT OVERROUNDING IS EASILY CORRECTED! ISZ ACX / (OVERCORRECTED??) NOP /COMMON CLEANUP ROUTINE FOR MULTIPLY AND DIVIDE EMDONE, ISZ EMSIGN /SHOULD SIGN BE MINUS? SKP /NO DCM /YES-DO IT SNA DCA ACX /FORCE EXPONENT 0 IF MANTISSA = 0 DCA ACH /STORE IT BACK SWP DCA ACL TAD DFLG SMA SZA CLA TAD ACX /IF D.P. INTEGER MODE AND ACX LESS THAN 0, SNA /GO TO UNNORMALIZE RESULT JMP I FPNXT /OTHERWISE BUMP RETN. AND RETN. CMA JMS I (ACSR JMP I FPNXT EMSIGN, 0 /ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE EMDSET, 0 CLA CLL CMA RAL /MAKE A MINUS TWO DCA EMSIGN /AND STORE IN EMSIGN. DLD /GET HIGH ORDER MANTISSA OF OP. OPH SWP SMA /NEGATIVE? JMP .+3 /NO DCM /YES-NEGATE IT ISZ EMSIGN /BUMP SIGN COUNTER SHL /SHIFT OPRND LEFT 1 TO AVOID OVRFLO 1 DST /STORE BACK-OPH CONTAINS LOW ORDER OPH / OPL CONTAINS HIGH ORDER DLD ACH SWP SMA /FAC LESS THAN 0? JMP .+4 /NO DCM ISZ EMSIGN NOP /EMSIGN MAY BUMP TO 0 DST /STORE BACK - ACH CONTAINS LOW ORDER ACH / ACL CONTAINS HIGH ORDER JMP I EMDSET PAGE /FLOATING DIVIDE-BY-0 ROUTINE - MUST BE AT 0 IN PAGE DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL JMS I ERR TAD DBAD DCA ACX /SET AC TO A LARGE POSITIVE NUMBER AC2000 JMP I (EMDONE /FLOATING DIVIDE DDDIV, JMS I (DARGET SKP FFDIV, JMS I (ARGET JMS I (EMDSET /GET ARG. AND SET UP SIGNS DVI /DIVIDE-ACH AND ACL IN AC,MQ OPL /THIS IS HI (!) ORDER DIVISOR DST /QUOT TO AC0,REM TO AC1 AC0 SZL CLA /DIVIDE ERROR? JMP DBAD /YES - HANDLE IT TAD OPX /DO EXPONENT CALCULATION CMA IAC /EXP. OF FAC - EXP. OF OP TAD ACX DCA ACX DPSZ /IS QUOT = 0? SKP /NO-GO ON DCA ACX /YES-ZERO EXPONENT DVLP, MUY /NO-THIS IS Q*OPL*2**-12 OPH DCM /NEGATE IT TAD AC1 /SEE IF GREATER THAN REMAINDER SNL JMP EDVOPS /YES-ADJUST FIRST DIVIDE DVI /NO-DO Q*OPL*2**-12/OPH OPL SZL CLA /DIV ERROR? JMP DBAD /YES EDVLP1, TAD AC0 /NO-GET QUOT OF FIRST DIV. SMA /NEGATIVE? JMP I (EMDONE /NO-REMEMBER-QUOT OF 2ND DIV. IN MQ LSR /YES-MUST SHIFT IT RIGHT 1 1 ISZ ACX /ADJUST EXPONENT NOP SGT /TEST SHIFTED OUT BIT JMP I (EMDONE /ZERO - NO ROUND DPIC /BUMP AC FRACTION JMP EDVLP1+1 /MAYBE SHIFT AGAIN /CONTINUATION OF DIVIDE ROUTINE /WE ARE ADJUSTING THE RESULT OF THE /FIRST DIVIDE. EDVOPS, CMA IAC DCA AC1 /ADJUST REMAINDER TAD OPL /WATCH FOR OVERFLOW CLL CMA IAC TAD AC1 SNL JMP EDVOP1 /DON'T ADJUST QUOT. DCA AC1 CMA TAD AC0 DCA AC0 /REDUCE QUOT BY 1 EDVOP1, CLA CLL TAD AC1 /GET REMAINDER SNA /ZERO? CAM /YES-ZERO EVERYTHING DVI /NO OPL SZL CLA /DIV. OVERFLOW? JMP DBAD /YES DCM /NO-ADJUST HI QUOT (MAYBE) JMP EDVLP1 /GO BACK /ROUTINE TO NORMALIZE THE FAC EFFNOR, 0 CDF 0 DLD /PICK UP MANTISSA ACH SWP /PUT IT IN CORRECT ORDER NMI /NORMALIZE IT SNA /IS THE # ZERO? DCA ACX /YES-INSURE ZERO EXPONENT DCA ACH /STORE HIGH ORDER BACK SWP /STORE LOW ORDER BACK DCA ACL CLA SCA /STEP COUNTER TO AC CMA IAC /NEGATE IT TAD ACX /AND ADJUST EXPONENT DCA ACX JMP I EFFNOR /RETURN ADDRS, OPH ACH LPBUF5, ZBLOCK 50 LPBUF7 PAGE /"NRMFAC" AND "OPNEG" MUST BE AT 0 AND 3 IN PAGE NRMFAC, JMS I (EFFNOR JMP I FPNXT FORTHO, 4000 OPNEG, 0 /ROUTINE TO NEGATE OPERAND DLD OPH SWP DCM DCA OPH MQA DCA OPL JMP I OPNEG /FLOATING ADD AND SUBTRACT-IN ORDER NOT TO LOSE BITS, /WE DO NOT SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD- /ONLY SHIFTS DONE ARE TO ALIGN EXPONENTS. FFSUB, JMS I (ARGET JMS OPNEG /NEGATE OPERAND SKP FFADD, JMS I (ARGET /PICK UP ARGUMENTS TAD OPX /PICK UP EXPONENT OF OPERAND MQL /SEND IT TO MQ FOR SUBTRACT TAD ACX /GET EXPONENT OF FAC SAM /SUBTRACT-RESULT IN AC SPA /NEGATIVE RESULT? CMA IAC /YES-MAKE IT POSITIVE DCA CNT /STORE IT AS A SHIFT COUNT TAD CNT /COUNT TOO BIG?(CAN'T BE ALIGNED) TAD (-27 SPA SNA CLA CMA /NO-OK DCA AC0 /YES-MAKE IT A LOAD OF LARGEST # DLD /GET ADDRESSES TO SEE WHO'S SHIFTED ADDRS SGT /WHICH EXP GREATER(GT FLG SET /BY SUBTR. OF EXPS.) SWP /OPERAND'S-SHIFT THE FAC DCA SHFBG /STORE ADDRESS OF WHO GETS SHIFTED SWP /GET ADDRESS OF OTHER (0 TO MQ) DCA DADR /THIS ONE JUST GETS ADDED TAD ACX /GET FAC EXP.INTO AC SGT /WHICH EXPONENT WAS GREATER? DCA OPX /FAC'S-STORE FINAL EXP. IN OPX DLD /GET THE LARGER # TO AC,MQ DADR, 0 SWP /PUT IN THE RIGHT ORDER ISZ AC0 /COULD EXPONENTS BE ALIGNED? JMP LOD /NO-JUST LEAVE LARGER IN AC,MQ DST /YES-STORE THIS TEMPORARILY AC0 /(IF ONLY FAC STORAGE WAS REVERSED) DLD /GET THE SMALLER # SHFBG, 0 SWP /PUT IT IN RIGHT ORDER ASR /DO THE ALIGNMENT SHIFT CNT, 0 DAD /ADD THE LARGER # AC0 DST /STORE RESULT AC0 SZL /OVERFLOW?(L NOT = SIGN BIT) CMA /NOTE-WE DIDN'T SHIFT BOTH RIGHT 1 SMA CLA JMP NOOV /NOPE CLA CLL CML RAR /MAYBE-SEE IF 2 #S HAD SAME SIGN AND ACH TAD OPH SMA CLA /SIGNS ALIKE? JMP OVRFLO /YES-OVERFLOW NOOV, TAD AC1 /NO-GET HIGH ORDER RESULT BACK TAD FORTHO /CHECK FOR 4000 0000 MANTISSA DPSZ /IT WILL BE SET TO 0 BY NMI JMP .+3 /OK-RESTORE NUMBER CLL CML RTR /GOT A 4000 0000-SET TO 6000 0000 JMP DOIT /AND INCREMENT EXPONENT TAD FORTHO /RESTORE NUMBER LOD, NMI /NORMALIZE (LOW ORDER STILL IN MQ) DCA ACH /STORE FINAL RESULT SCA /GET SHIFT COUNTER(# OF NMI SHIFTS) CMA /NEGATE IT ADON, IAC TAD OPX /AND ADJUST FINAL EXPONENT DCA ACX SWP /GET AND STORE LOW ORDER DCA ACL JMP I FPNXT /RETURN OVRFLO, TAD AC1 /OVERFLOW-GET HIGH ORDER RESLT BACK ASR /SHIFT IT RIGHT 1 1 DOIT, TAD FORTHO /REVERSE SIGN BIT DCA ACH /AND STORE JMP ADON /DONE LPBUF7, ZBLOCK 44 LPBUFE PAGE *7400 /RTS CLEANUP ROUTINE - SAVED WITH PG 17600 CLNUP, DCA I CFPTR /ENTER HERE ON C OR ERROR TDEXFG, JMP CTMP /ENTER HERE ON "STOP" OR "CALL EXIT" TAD TDEXFG /TDEXFG CONTAINS TOP MEM FIELD CLL RTL /IF WE ARE ON AN IN-CORE TD8E CONFIGURATION RAL TAD (CDF DCA TDGTDF TDGTDF, HLT TAD I TDPTR /MOVE THE TD8E ROUTINE CDF 20 DCA I TDPTR /DOWN TO FIELD 2 ISZ TDPTR JMP TDGTDF CDF 0 TAD (CIF 20 JMS TDSET /RESET THE F0 CDF'S TO POINT TO FIELD 2 CTMP, CDF 0 TAD (6213 DCA I (7605 TAD (5267 DCA I (7606 /RESTORE PAGE 7600 AC7776 AND I (OSJSWD IAC DCA I (OSJSWD /MARK 10000-11777 AS USELESS AND I 0 AND I 0 /DELAY A WHILE IN CASE ITS AN LA30 AND I 0 AND I 0 AND I 0 TSF SKP JMP WTOVR ISZ ZERO TAD I (TOCHR /IF TTY IS NOT IDLE, SZA CLA /DELAY LONG ENOUGH TO AVOID GARBLE. JMP CTMP WTOVR, TAD I (7777 CLL RAL SMA CLA /IS BATCH EXECUTING? JMP NOBTCH /NO - RELAX TAD (212 /TO PREVENT OVERPRINTING, POP UP A LINE TLS /ON THE TELETYPE LLS /AND ON THE LINE PRINTER TSF JMP .-1 /WAIT FOR THE SLOWER ONE (I HOPE) CLA NOBTCH, CDF 10 CLOSLP, TAD I CFPTR SNA /ANY MORE ENTRIES IN THE TENTATIVE JMP GOAWAY /FILE TABLE? DCA CTMP /YES - SAVE FILE LENGTH PTR CDF 0 TAD I CTMP CDF 10 SNA JMP IGNORC /UNWRITTEN FILES AREN'T CLOSED DCA FLEN JMS I USR 10 /BRING USR IN TAD (200 DCA USR /KEEP IT IN TAD (HPLACE+1 DCA CHAND JMS I USR 13 /RESET DEVICE HANDLER TABLE 0 /BUT NOT TENTATIVE FILES! ISZ CFPTR TAD I CFPTR /GET UNIT NUMBER JMS I USR 1 CHAND, 0 /FETCH HANDLER JMP CLSERR TAD I CFPTR /GET UNIT AGAIN ISZ CFPTR /BUMP PTR TO NAME JMS I USR C4, 4 CFPTR, 7600 /CLOSE THE FILE FLEN, 0 JMP CLSERR SKP IGNORC, AC0002 TAD CFPTR TAD C4 DCA CFPTR JMP CLOSLP /LOOK FOR MORE TDSET, 0 DCA I (7721 TAD I (7721 DCA I (7727 TAD I (7721 IAC DCA I (7642 JMP I TDSET GOAWAY, CDF CIF 0 JMP I (7605 /RETURN TO OS/8 AQAP CLSERR, JMS I USR /"IMPOSSIBLE" ERROR - GIVE "USER ERROR 2" 7 2 /IT'S BETTER THAN HALTING TDPTR, 7600 ZERO, 0 USR, 7700 $$$-$$$-$$$ $GNORC, AC0002 TAD CFPTR TAD C4 DCA CFPTR JMP CLOSLP /LOOK FOR MORE TDSET, 0 DCA I (7721 TAD I (7721 DCA I (7727 TAD I (7721 IAC DCA I (7642 JMP I TDSET GOAWAY, CDF CIF 0 JMP I (7605 /RETURN TO OS/8 AQAP CLSERR, JMS I USR /"IMPOSSIBLE" ERROR - GIVE "USER ERROR 2"