X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Frtl.pa;fp=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Frtl.pa;h=13c43ea316d73ff2a28ac55369eb09aae46f793d;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/os8/v3d/sources/fortran/all/rtl.pa b/sw/os8/v3d/sources/fortran/all/rtl.pa new file mode 100644 index 0000000..13c43ea --- /dev/null +++ b/sw/os8/v3d/sources/fortran/all/rtl.pa @@ -0,0 +1,1753 @@ +/FORTRN 4 RTS LOADER +/ +/ VERSION 5A PT 16-MAY-77 +/ +/ +/ +/ +/ +// +/ +/ +/ +/ +/COPYRIGHT (C) 1974, 1975 +/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. +/ +/ +/ +/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A +/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- +/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER +/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE +/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO +/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE +/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. +/ +/ +/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT +/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL +/EQUIPMRNT COROPATION. +/ +/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS +/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. +/ +/ +/ +/ +/ +/ + /FORTRAN 4 RTS LOADER - RL +/WITH DOUBLE PRECSION - MKH +/AND RTS-8 SUPPORT - R. LARY + +/LAST EDITED 5/21/74 +/ +/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T. 5/1/77 +/ .FIXED THE D AND B FORMAT (FPP) BUG +/ .FIXED FIELD OVERFLOW BUG(NO. OF ASTERISKS PRINTED) +/ + +/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 0 RTS +/IS MOVED UP INTO FIELD 1 AND THE VACATED AREA OF FIELD 0 IS USED +/TO RUN THE COMMAND DECODER AND TO ACCUMULATE DEVICE HANDLERS. + +/*K* THEREFORE, IF THE RTS LOADER IS TO MODIFY ANY CODE BETWEEN +/"F0HBEG" AND "F0HEND" IT MUST MODIFY IT IN FIELD 1 IN THE "F0TO" AREA. + +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 + *IONTBL+23 + 1 + *IONTBL+25 + 1 + 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,/P,/V 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 + 0100 +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-1 /MOVE SPECIAL /P START CODE TO LOC 200 + CDF 10 + 200-F0HBEG+F0TO-1 /(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) + FPCOM /CLEAR APT POINTER FIELD BITS (IF FPP) + 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 + JMS I (BAKTST /SEE IF WE'RE RUNNING IN BACKGROUND UNDER RTS-8 + 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) + CLA IAC +EAEKIL, SHL /ZERO THIS LOCATION TO INHIBIT EAE + 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 (7612 + TAD (-3 /CHECK FOR IN-CORE TD8E'S + 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 RESHAN /NO + TAD HADR + AND (177 + TAD (HPLACE /YES - I APOLOGIZE + DCA HADR +RESHAN, 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, RELOC 200 / /P STARTUP CODE + SWAB /MAKE SURE EAE IS IN MODE B + JMP I .+1 /EXECUTES AT 200 + FPSTRT /START UP IN FLAG CLEARING CODE + RELOC + 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 + 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+1 + AND (4 + SNA CLA /TEST FOR /V SWITCH + JMP .+3 /NO + JMS I (RLERR /YES - PRINT VERSION NUMBER MESSAGE + XVERMS + 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 + TAD (EFFNOR /SUBSTITUTE A POINTER TO THE EAE NORMALIZE + CDF 0 /ROUTINE FOR THE POINTER TO THE NON-EAE + DCA I (NORMX /NORMALIZE ROUTINE + 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 + /RTS LOADER ERROR MESSAGE ROUTINE & MESSAGES + +RLERR, 0 /ERROR MESSAGES ARE IN FIELD 0 + CLA + CDF 10 + TAD I RLERR + CDF 0 + 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 + CDF 10 + 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 + /ROUTINE TO DETERMINE WHETHER WE ARE RUNNING IN THE +/BACKGROUND UNDER RTS-8, AND MODIFY THE RUN-TIME SYSTEM IF WE ARE. +/RUNS AT INITIALIZATION TIME, BEFORE LOWER FIELD 0 IS MOVED + +BAKTST, 0 + FPICL /FIRST INITIALIZE FPP (IF ANY) + FPCOM /INCLUDING CLEARING EXTENDED APT POINTER + TCF /TEST FOR RTS-8 BACKGROUND BY CLEARING THE + TSF /TTY FLAG AND THEN TESTING IT - IF IT IS + JMP I BAKTST /STILL SET, WE ARE RUNNING UNDER SRT-8. + CDF 0 /MODIFY LIST AND MODIFICATIONS ARE IN FIELD 0 +BAKLP, TAD I BKRPTR /GET POINTER TO BLOCK TO BE MODIFIED + SNA + JMP BAKRTN /ZERO - WE'RE DONE + DCA X0 /STORE IN AUTO-XR + ISZ BKRPTR +BAKWLP, TAD I BKRPTR /GET NEXT WORD TO STORE + ISZ BKRPTR + SNA + JMP BAKLP /ZERO MEANS END OF GROUP + DCA I X0 + JMP BAKWLP +BAKRTN, CDF 10 /RESET DATA FIELD TO 10 + DCA I (EAEKIL /EAE USES SGT WHICH IS NOT EMULATED, SO KILL IT + JMP I BAKTST /AND RETURN + +BKRPTR, BKRLST + 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 + DCA APT + TAD APT /SET UP "FETPC" TO FETCH POSSIBLE TRAP ARGS + 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 + SKP + ISZ APT /INCLUDING FIELD + 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, CLA + TAD W + 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 ACI + 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 + CMA IAC + DCA EAC2 + CML RAL + TAD EAC1 + CMA IAC + DCA EAC1 + CML RAL + TAD ACL + 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 + /"OPNEG" MUST BE AT 0 IN PAGE + +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 OPH + SNA CLA /IF OPERAND IS 0, + JMP I FPNXT /RESULT IS ALREADY IN AC. + TAD ACH + SZA CLA /CHECK FOR AC=0 + JMP BOTHN0 /NO + DLD + OPH /YES - ANSWER IS OPERAND + SWP + DCA ACH + JMP FADND /JUMP INTO CLEANUP CODE +BOTHN0, 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, AC4000 /NO-GET HIGH ORDER RESULT BACK + TAD AC1 /CHECK FOR 4000 0000 MANTISSA + DPSZ /IT WILL BE SET TO 0 BY NMI + JMP .+3 /OK-RESTORE NUMBER + AC2000 /GOT A 4000 0000-SET TO 6000 0000 + JMP DOIT /AND INCREMENT EXPONENT + TAD (4000 /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 +FADND, 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 (4000 /REVERSE SIGN BIT + DCA ACH /AND STORE + JMP ADON /DONE + +LPBUF7, ZBLOCK 34 + 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 + $$$-$$$-$$$ +