File RTL.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/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 $$$-$$$-$$$



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search