--- /dev/null
+/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.
+/
+/
+/
+/
+/
+/
+\f/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
+\f/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
+\f/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
+\f/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
+\fNOTLI, JMS I (RLERR
+ NOLI
+ JMP LICD
+
+LDIOER, JMS I (RLERR
+ LIOEMS
+ CDF CIF 0
+ JMP I (7605
+ PAGE
+\f/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.
+\f/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
+\f/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
+\f/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
+\fNOFPP, 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
+\fTAKCAR, 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
+\fGETHAN, 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
+\f/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
+\fHCWTBA, 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
+\f/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
+\fSTDSRN, 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
+\fNONUM, 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
+\fTSTSWS, 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
+\fSPMDCD, 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
+\fGETION, 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
+\f/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
+\f/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= .
+\f/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
+\f/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
+\f/RANDOM FPP CODE FOR D.P. I/O
+DFSTM2, FSTA+LONG
+ DFTMP2
+ FEXIT
+
+ PAGE
+\f/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
+\fSKPZRO, 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
+\fDRDCPT, 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
+\fDBLDIG, 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
+\fDSCLDN, 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
+\f/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
+\f/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
+\fDFIXUP, 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
+\f/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
+\f *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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/"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
+\f 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
+\f *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
+\fNOBTCH, 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
+\fGOAWAY, 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
+ $$$-$$$-$$$
+\f
projects / pdp8.git / blobdiff