<div id='wikitext'>
<pre><b> File: RTL.PA of Tape: Original/Originals/AL-4545D-SA</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/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
/&quot;F0HBEG&quot; AND &quot;F0HEND&quot; IT MUST MODIFY IT IN FIELD 1 IN THE &quot;F0TO&quot; AREA.

F0HBEG=	0
F0HEND=	3000
F0HSAV=	7000	/400 WORDS WHERE DEVICE HANDLERS ARE TEMPORARILY SAVED
		/SO THAT THEY WON&#039;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&#039;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&#039;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&#039;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&#039;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&#039;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 &quot;STARTE;FEXIT&quot;
	JMP	NOFPP	/DIDN&#039;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 &quot;BATCH SAVED&quot; BIT OFF
	TAD I	(7612
	TAD	(-3	/CHECK FOR IN-CORE TD8E&#039;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&#039;RE COMING FROM
	DCA	TD8EFL
	TAD	TD8EFG
	IAC
	JMS I	(TDSET	/REDO THE CDF&#039;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 &amp; TD8E CRAP
	JMS I	(GBFLG	/GET BATCH FLAG
	TAD	TD8EFG
	SNA CLA		/IF NO BATCH OR TD8E&#039;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&#039;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&#039;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&#039;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&#039;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 &amp; 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&#039;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&#039;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 &quot;FETPC&quot; 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 &quot;CDF CIF N&quot;
	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&lt;0-NEGATE IT
	DCA I	(FFNEG		/ 0 &lt;&gt; 7777
DSCLUP,	DCA	SCALE
	TAD	ACX
	SMA SZA CLA		/AC&lt;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 &gt;=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&lt;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&#039;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&#039;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
/&quot;OPNEG&quot; 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&#039;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&#039;S SHIFTED
	ADDRS
	SGT		/WHICH EXP GREATER(GT FLG SET
			/BY SUBTR. OF EXPS.)
	SWP		/OPERAND&#039;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&#039;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&#039;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 &quot;STOP&quot; OR &quot;CALL EXIT&quot;
	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&#039;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&#039;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	/&quot;IMPOSSIBLE&quot; ERROR - GIVE &quot;USER ERROR 2&quot;
	7
	2		/IT&#039;S BETTER THAN HALTING

TDPTR,	7600
ZERO,	0
USR,	7700
	$$$-$$$-$$$
</pre>
<hr/>
</div>