P11DEF.MAC           
	.NLIST
	.LIST TTM
	.NLIST BEX,TOC,SYM
	.IDENT	/PAS001/
	.PSECT	PASRUN
;
; THIS IS THE RSX-11M RUNTIME SUPPORT PACKAGE FOR PASCAL.
; CALLED SUBROUTINES ARE ALWAYS INCLUDED IN THE TASK BY THE TASKBUILDER.
;
;SEVED TORSTENDAHL   1976-10-19
;
;
;
; PASRUN, THE RUNTIME SUPPORT PACKAGE FOR PASCAL, WILL GET THE
; CONTROL WHEN A USER TASK IS STARTED. BEFORE TRANSFERRING CONTROL
; TO THE USER PART SOME INITIALIZING IS PERFORMED.
; -	SS (=R5), THE SOFTWARE STACK POINTER, IS INITIALIZED TO GIVE
;	64 BYTES TO THE HARDWARE STACK, POINTED TO BY HP (=R6)
; -	GP (=R3), THE POINTER TO THE DATA OF THE MAIN PROGRAM BLOCK
;	AND THE HIDDEN GLOBAL DATA, IS SET
; -	MP (=R4), THE POINTER TO THE DATA OF THE CURRENT BLOCK
;	IS SET = GP
; -	A SST VECTOR IS DECLARED. THIS IS TO MAKE IT POSSIBLE TO
;	CLOSE ALL FILES AT ABORT. A POST MORTEM DUMP IN A FORM
;	WITH VARIABLE NAMES AND OTHER DETAILES TO SIMPLIFY DEBUGGING
;	CAN ALSO BE PRINTED IF REQUESTED AT COMPILE TIME.
; -	CONTROL IS TRANSFERRED TO THE USER PROGRAM
;
;
;
; THE USER PROGRAM CAN REQUEST SERVICES FROM PASRUN
; THROUGH THE TRAP INSTRUCTION. THIS INSTRUCTION HAS A PARAMETER,
; WHOSE VALUE LIESIN THE RANGE 0..255. EACH VALUE CORRESPONDS TO A
; SERVICE ROUTINE. TRAPS ARE DEFINED FOR REAL ARITHMATIC,
; ARITHMETIC FUNCTIONS, FILE OPERATIONS ETCETERA.
;
;
;
;
	.SBTTL	LOCAL CONSTANTS
;
LUN1=1
LUN2=2
LUN3=3
LUN4=4
LUN5=5
LUN6=6
TILUN=5
;
;
MAXFILES=5		;MAX NUMBER OF FILES
BUFLEN=132.		; MAX RECORD SIZE
;
FF=14
LF=12
CR=15
HT=11
SPC=40
;
FALSE=0
TRUE=1
;
;
;
; BIT DEFINITIONS FOR THE IOSPEC PARAMETER
;
RANDOM	=1
UPDATE	=2
APPEND	=4
TEMPORARY=10
INSERT	=20
SHARED	=40
SPOOL	=100
BLKMODE	=200
; HIDDEN BITS
TTY	=20000
TEXT	=40000
INPUT	=100000
;
;
; OFFSET DEFINITION FOR THE STACKS
;
STACKBEG=2
HPSIZE	=400	; 256 BYTES FOR HARDWARE STACK
;
LINEADDR=2	; ADDRESS OF LINENUMBER
MARKADDR=6.	; ADDRESS OF MARKPOINTER
DAPADDR	=8.	; ADDRESS OF DYNAMIC AREA POINTER
LUNTAB	=10.	; LOGICAL UNIT TABLE
;
;
;
; REGISTER DEFINITIONS
;
AR	=%0	; GENERAL PURPOSE REGISTER
R	=%1	;     -     ''	     -
AD	=%2	;     -	    ''	     -
GP	=%3	; GLOBAL  BLOCK BASE POINTER
MP	=%4	; CURRENT BLOCK BASE POINTER
SS	=%5	; SOFTWARE STACK
HP	=%6	; HARDWARE STACK
;
;
;
;
;
; DEFINITION OF HIDDEN PART OF FILE DEKLARATION
;
FILESIZECORR	=104.
TEXTBUFFSIZE	=132.
FDBSIZE		=96.
FDB		=-104.
EOLNSTATUS	=-8.
EOFSTATUS	=-6
IORESULT	=-4
FILTYP		=-2
;
;
;
;
	.SBTTL	LOCAL MACROS
;
;
;
; MACRO FOR SUBROUTINE CALL
;
	.MACRO	CALLSS	RTR,ENDRTR
	JSR	MP,$'RTR
	.ENDM
;
;
; MACRO FOR SUBROUTINE RETURN
;
	.MACRO	RETURN
	RTS	MP
	.ENDM
;
;
;
; DUMMY MACRO FOR OLD LINK COMPATIBILITY
;
	.MACRO	LINK	NEXT
	.ENDM
;
;
; MACRO FORROUTINE ENTRY
;
	.MACRO	ROUTINE	RTR,ENDRTR
	.SBTTL	RTR
$'RTR::
	.ENDM
;
;
; MACRO TO RETRIEVE AND CHECK FDB
;
	.MACRO	FINDFILE  WHERE,SSCORR,RESULT,?L1
	MOV	WHERE,R
	MOV	R,AR
	BIT	#TTY,FILTYP(R)
	BNE	L1
	SUB	#FILESIZECORR,AR
	TSTB	F.LUN(AR)
	BNE	L1
	MOV	#TRUE,EOFSTATUS(R)
	MOV	#-102.,IORESULT(R)
.IIF NB <SSCORR>	ADD	SSCORR,SS
.IIF NB <RESULT>	MOV	RESULT,-(SS)
	RETURN
L1:
	.ENDM	FINDFILE
;
;
;
;
;NAMES OF THE RUNTIME ROUTINES AND THEIR FUNCTION
;
;	ERRN = 0.	;DUMMY ROUTINE FOR ERROR DETECTION
;REAL COMPARISON ROUTINES
;	EQUR = 1	;EQUALITY TEST FOR REALS
;	NEQR = 2	;NOT EQUAL REAL
;	LESR = 3	;LESS THAN
;	LEQR = 4	;LESS OR EQUAL
;	GRTR = 5	;GREATER THAN
;	GEQR = 6	;GREATER OREQUAL
;			;REAL COMPARISON ROUTINES FIRST SUBTRACT THE REALS AND
;			;THEN TEST THE VALUE OF THE RESULT ON TOP OF THE STACK
;REAL ARITHMETIC
;	ADR = 7		;ADDS TWO REALS ON TTHE STACK
;	SBR = 8.	;SUBTRACTS THE REAL ON TOP FROM THE REAL NEXT TO TOP
;	SQRR = 9.	;SQUARE THE REAL ON TOP OF THE STACK
;	MPR = 10.	;MULTIPLY REALS
;	DVR = 11.	;DIVIDE REALS
;	FLO = 12.	;FLOAT THE REAL NEXT TO TOP
;	FLT = 13.	;FLOAT THE REAL ON TOP
;	TRC = 14.	;TRUNCATE THE REAL ON TOP OF THESTACK
;	RND = 15.	;ROUND 
;MULTIPLE VALUE COMPARISON ROUTINES
;	GRTM = 17.	;GREATER THAN
;	GRTM2 = 18.	;
;	LESM = 19.	;LESS THAN
;	LESM2 = 20.	;
;	GEQM = 21.	;GREATER THAN OR EQUAL
;	GEQM2 = 22.	;
;	LEQM = 23.	;LESS THAN OR EQUAL
;	LEQM2 = 24.	;
;	EQUM = 25.	;EQUAL
;	EQUM2 = 26.	;
;	EQUS4 = 27.	;LARGE SETEQUALITY TEST (4 WORDS)
;	NEQM = 28.	;NOT EQUAL
;	NEQM2 = 29.	;
;	NEQS4 = 30.	;LARGE SET INEQUALITY TEST
;SINGLE WORD COMPARISON ROUTINES
;	EQU = 31.	;EQUAL  INTEGER
;	NEQ = 32.	;NOT EQUAL
;	GRT = 33.	;GREATER
;	GEQ = 34.	;GREATER OR EQUAL
;	LES = 35.	;LESS THAN
;	LEQ = 36.	;LESS OR EQUAL
;INTEGER ARITHMETIC
;	DVI = 37.	;INTEGER DIVISION
;	MODI = 38.	;INTEGER MODULO
;	SQI = 39.	;SQUARE INTEGER
;	MPI = 40.	;INTEGER MULTIPLICATION
;MULTIPLE MOVE
;	MOVM = 41.	;MOVE A MULTIPLE VALUE: ADDRESSES ON THE STACK
;	MOVM2 = 42.	;MOVE A MULTIPLE VALUE: ADDRESSES IN REGISTERS AR,AD
;	MOVMR = 97.	;MOVE A MULTIPLE VALUE IN REVERSE DIRECTION
;SET MANIPULATION ROUTINES
;	INN = 44.	;TESTS IF A SETELEMENT IS IN A SET
;	SGSIN = 45.	;ADDS ONE SETELEMENT TO A SET (1 OR 4 WORD)
;	INITS = 46.	;CREATES AN EMPTY FOUR WORD SET ON THE STACK
;	UNI4 = 47.	;UNION OF TWO FOURWORD SETS ON THE STACK
;	INT4 = 48.	;FORMS THE INTERSECTION OF TWO FOUR WORD SETS
;	DIF4 = 49.	;FORMS THE DIFFERENCE OF TWO FOUR WORD SETS
;	EXPST = 50.	;EXPANDS THE 1-WORD SET ON TOP TO A 4-WORD SET
;	EXPSN = 51.	;EXPANDS THE 1-WORD SET NEXT TO TOP
;	REDST = 52.	;REDUCES THE 4-WORD SET ON TOP TO A 1-WORD SET
;	REDSN = 53.	;REDUCES THE 4-WORD SET NEXT TO TOP IN THE STACK
;	LEQS1 = 70.	;SETINCLUSION (1 WORD SET)
;	LEQS4 = 71.	;      ,,     (4 WORD SET)
;	GEQS1 = 72.	;      ,,     (1 WORD SET)
;	GEQS4 = 73.	;      ,,     (4 WORD SET)
;MARK,RELEASE AND RUNTIME CHECK ROUTINES
;	MARKP = 66.	;MARKS THE CURRENT VALUE OF DYNAMIC AREA POINTER
;	RELEASEP = 67.	;RELEASES PART OF THE ALLOCATED HEAP
;	OVFLCHK= 68.	;CHECK FOR FREE STORAGE SPACE
;	SUBRCHK = 69.	;CHECK SUBRANGE OVERFLOW
;PACKED BOOLEAN ACCESS ROUTINES AND ADDITIONALS
;	IXB = 54.	;INDEXING IN BOOLEAN ARRAYS
;	STPB = 55.	;STORE A BOOLEAN IN A PACKED B ARRAY
;	LPB = 56.	;LOAD ABOOLEAN FROM A PACKED BOOLEAN ARRAY
;	CLRAREA = 57.	;CLEAR PART OF THE AREA (FOR PACKED STRUCTURE)
;	CLRSTK = 58.	;CLEAR LOCAL AREA OF PROCEDURE BLOCK
;ROUTINES FOR FILE HANDLING
;	EOFF = 77.	;END OF FILE
;	RESETF = 78.	;RESET A FILE FOR READING
;	REWRITEF = 79.	;REWRITE A FILE FOR WRITING
;READ AND WRITE
;	RDC = 59.	;READ A CHARACTER FROM THE FILE INPUT
;	RDI = 60.	;READ AN INTEGER FROMTHE FILE INPUT
;	RDR = 61.	;READ A REAL FROM THE FILE INPUT
;	WRCHA = 43.	;WRITE CHARACTER IN A FIELD OF SPECIFIED LENGTH
;	WRC = 62.	;WRITE A SINGLE CHARACTER ON A LINE OF 78 CHARS MAX.
;	WRS = 63.	;WRITE A STRING IN A FIELD OF SPECIFIED LENGTH
;	WRI = 64.	;WRITE AN INTEGER   ,,      	,,	   ,,
;	WRR = 65.	;WRITE A REAL			,,	   ,,
;	WRFIX = 92.	;WRITE A REAL IN FIXED FORMAT
;	GETCH = 74.	;GET NEXT CHARACTER OF INPUTFILE
;	GETLINE = 75.	;SKIPS THE INPUTSTRING UNTIL 'EOL' HAS BEEN READ
;	GETBUFFER = 76.	;GETS NEW BUFFER FROM KEYBOARD(ONE LINE, 60 CHARS MAX)
;	PUTCH = 80.	;APPENDS THE OUTPUT BUFFER VARIABLE TO THE OUTPUT FILE
;	PUTLINE = 81.	;APPENDS THE CONTROL CHAR'S <CR><LF> TO THE OUTPUTFILE
;ADDITIONAL ROUTINES
;	EXITP = 16.	;TERMINATES A PROGRAM
;	CMR = 82.	;COMPARE REALS
;	EXPTOP = 83.	;EXPONENT ON TOP
;	EXPNTOP = 84.	;EXPONENT NEXT TO TOP
;	SIGNS = 85.	;SIGNS OF REALS
;	NORM = 86.	;FOR NORMALIZATION
;	SCALE = 87.	;SCALING
;	RDSIGN = 88.	;READS SIGN OF NUMERICAL INPUT
;	WRERROR = 89.	;WRITES ERROR MESSAGES
;	DIGIT = 90.	;CHECKS CHARACTER AND CONVERTS TO DIGIT
;	UNSINT = 91.	;READS AN UNSIGNED INTEGER
;	NORMLZ = 93.	;REAL NORMALIZATION
;	DECDIG = 94.	;PRINTS DECIMAL DIGITS OF A REAL
;	PRTSGN = 95.	;PRINTS THE SIGN OF A REAL
;	TRAILR = 96.	;PRINTS A NUMBER OF (EQUAL) CHARACTERS
;	TWPOW = 98.	;POWERS OF TWO
;	SPLTRL = 99.	;SPLITS A REAL INTO EXPONENT AND MANTISSA
;ARITHMETIC FUNCTIONSOF TYPE REAL
;	RSIN = 100.	;SINUS
;	RCOS = 101.	;COSINE
;	RARCTAN = 102.	;ARCTANGENT
;	REXP = 103.	;EXPONENT
;	RLOG = 104.	;NATURAL LOGARITHM
;	RSQRT = 105.	;SQUARE ROOT
;	SUBSTRCHECK = 106.	;CHECKS BOUNDS OF SUBSTRING
;	STRINGINDEX = 107.	;CHECKS INDEX IN STRINGPARAMETER
;	DUMRTR = 108.	;DUMMY END ROUTINE
;
;
	.LIST
****
P11INIT.MAC          
	.TITLE	P11INIT
	.SBTTL	INITIALIZATION
;
	.MCALL	FINIT$
;
;
;
	ROUTINE	INITA
	FINIT$
	MOV	#$STACK,SS	; INIT GLOBAL HIDDEN AREA
FILAREA=FILESIZECORR+TEXTBUFFSIZE+4
	MOV	SS,AD		; CLEAR HEAPAND STACK
	MOV	AD,AR
	SUB	#$$HEAP,AR
	ASR	AR		; NO OF WORDS TO CLEAR
1$:	CLR	-(AD)
	DEC	AR
	BGT	1$
	MOV	MP,AD		; RESERV SPACE FOR STANDARD FILES
	TST	(AD)+
	BEQ	2$
	SUB	#FILAREA,SS	; INPUT
2$:	TST	(AD)+
	BEQ	3$
	SUB	#FILAREA,SS	; OUTPUT
3$:	TST	(AD)+
	FILAREA=FILAREA-FDBSIZE
	BEQ	4$
	SUB	#FILAREA,SS	;TTYIN
4$:	TST	(AD)+
	BEQ	5$
	SUB	#FILAREA,SS	; TTYOUT
5$:	MOV	#MAXFILES+2,AR	;  LUNTAB
6$:	CLR	-(SS)
	DEC	AR
	BGT	6$
	DEC	@SS		; TTYIN NOT AVAILABLE
	DEC	10.(SS)		; TTYOUT NOT AVAILABLE
	MOV	#$$HEAP,-(SS)	; DAPADDR := START ADDR OF STACK
	MOV	@SS,-(SS)	; MARKADDR := START ADDR OF STACK
	CMP	-(SS),-(SS)	; TTY IO STATUS BLOCK (TTYSB)
	TST	-(SS)		; RESERV SPACE FOR
	MOV	SS,@SS		;   STATIC LINK
	MOV	SS,GP
;
; OPEN STANDARD FILES
;
	MOV	#-2,-(HP)	; COUNTER
NEW:	ADD	#2,@HP		; INDEX TO FNAM & OPEN-ROUTINE
	MOV	@HP,R
	MOV	(MP)+,-(SS)	; FILE POINTER
	BEQ	NOFILE
	ADD	GP,@SS
	MOV	#-1,-(SS)	; FILE TYPE = TEXT
	MOV	FNAM(R),-(SS)	; ADDR TO FNAM STRING
	MOV	#6,-(SS)	; LEN OF FNAM STRING
	CLR	-(SS)		; DIR STRING
	CLR	-(SS)
	CLR	-(SS)		; DEV STRING
	CLR	-(SS)
	CLR	-(SS)		; IOSPEC
	JSR	MP,@FSTOPN(R)
	BR	NEXT
;
NOFILE:	TST	(SS)+		; REMOVE ZERO
NEXT:	CMP	@HP,#6
	BNE	NEW		; MORE FILEPOINTERS LEFT
	TST	(HP)+		; REMOVE COUNTER
	MOV	GP,@HP		; TO MP AT EXIT
	RETURN
;
FSTOPN:	.WORD	$REWRITE,$RESET,OPNTTY,OPNTTY
FNAM:	.WORD	NMO,NMI,NMO,NMI
NMI:	.ASCII	/INPUT /
NMO:	.ASCII	/OUTPUT/
	.EVEN
;
;
OPNTTY:	ADD	#16.,SS		; SKIP FILE SPEC
	MOV	(SS)+,R		; FILE POINTER
	CLR	EOFSTATUS(R)	; FALSE
	MOV	#1,IORESULT(R)	; OK
	MOV	R,@R
	SUB	#FILESICORR+TEXTBUFFSIZE-FDBSIZE,@R
	CLR	2(R)		; NO CHAR'S
	CMP	2(HP),#6		; WHICH FILE
	BNE	TTYOUT
	MOV	R,LUNTAB(GP)	; TTYIN
	MOV	#TRUE,EOLNSTATUS(R)
	MOV	#TTY+TEXT+INPUT,FILTYP(R)
	RETURN
;
TTYOUT:	MOV	R,LUNTAB+10.(GP)	; TTYOUT = LUN 5
	CLR	EOLNSTATUS(R)
	MOV	#TTY+TEXT,FILTYP(R)
	MOV	#TEXTBUFFSIZE,2(R)
;
; WRITE(TTY,'*'); BREAK; READLN(TTY);
;
	RETURN
;
;
	.END
****
P11RESET.MAC         
	.TITLE	P11RESET
;
	.MCALL	FDOF$L,CLOSE$,OPEN$,ALUN$S,DELET$
	FDOF$L		; DEFINE FDB OFFSETS
;
;
;
; REWRITE(F,FNAM,FDIR,FDEV,IOSPEC)
;
;   RESET(F,FNAM,FDIR,FDEV,IOSPEC)
;
;	16(SS) = POINTER TO FILE POINTER
;	14(SS) = RECORDSIZE ( -1 FOR TEXT FILES )
;	12(SS) = ADDR OF FNAM STRING
;	10(SS) = LEN  OF FNAM STRING
;	 8(SS) = ADDR OF FDIR STRING
;	 6(SS) = LEN  OF FDIR STRING
;	 4(SS) = ADDR OF FDEV STRING
;	 2(SS) = LEN  OF FDEV STRING
;	  (SS) = IOSPEC
;
	ROUTINE	RESET
;
	BIC	#APPEND+UPDATE,@SS
1$:	MOV	#FO.RD,-(HP)
	BIS	#INPUT,@SS
	BR	RESET1
;
;
	ROUTINE	REWRITE
;
	MOV	#FO.WRT,-(HP)
	BIC	#INPUT,@SS
RESET1:	BIT	#TTY,@SS
	BNE	4$		; NO ACTION FOR TTY
	MOV	16.(SS),R
1$:	MOV	#<2*MAXFILES+2>,AD
	ADD	GP,AD
	MOV	#MAXFILES+1,-(HP)
2$:	CMP	R,LUNTAB(AD)
	BEQ	5$		; LUN FOUND
	TST	-(AD)
	DEC	@HP
	BGE	2$
	TST	(HP)+		; REMOVE COUNTER
	TST	R
	BEQ	3$		; NO FREE LUN AVAILABLE
	CLR	R
	BR	1$		; SEARCH FOR FREE LUN
3$:	MOV	16.(SS),R	; FILE POINTER
	MOV	#101.,IORESULT(R)
	MOV	#TRUE,EOFSTATUS(R)
4$:	ADD	#18.,SS
	RETURN
;
5$:	TST	R
	BEQ	NEWOPEN		; IF NOT OPEN ALREADY
;
; CLOSE FILE FIRST
;
REOPEN:
	MOV	R,AR
	SUB	#FILESIZ,AR	; FDB ADDRESS
; SAVE FILENAME BLOCK AND OPEN SAME FILE WITH UPDATE:
;     NOT EQUIVALENT TO OPEN-WRITE
;
;	MOV	AD,-(HP)	; SAVE LUN INDEX
;	MOV	AR,AD
;	ADD	#F.FNB,AD	; ADDRESS TO FILENAME PART OF FDB
;	MOV	#20,R
;1$:	MOV	(AD)+,-(SS)
;	DEC	R
;	BGT	1$
	TST	F.RSIZ(AR)	; TEST IF FILE IS EMPTY
	BNE	3$		; IF EMPTY THEN DELETE ELSECLOSE
;				;    ( TEXTFILES ONLY )
	TST	IORESULT(R)
	BLT	4$		; IF NONEXISTENT FILE
	DELET$	R0
	BR	4$
3$:	CLOSE$
4$:
;	MOV	#20,R
;2$:	MOV	(SS)+,-(AD)
;	DEC	R
;	BGT	2$
;	MOV	(HP)+,AD
;	BIT	#INPUT,@SS
;	BNE	NEWOPEN		; IF INPUT
;	BIS	#UPDATE,@SS	; WRITE SAME FILE = UPDATE
;
NEWOPEN:MOV	16.(SS),R	; FILE POINTER
	MOV	R,LUNTAB(AD)	;RESERV LUN
	MOV	R,AR
	SUB	#FILESIZECORR,AR; FDB ADDRESS
	MOV	(HP)+,AD
	MOVB	AD,F.LUN(AR)	; SET LUN IN FDB
	MOV	R,F.URBD+2(AR)
	ADD	#2,F.URBD+2(AR)	; USER RECORD BUFFER ADDRESS
	MOV	14.(SS),F.URBD(AR) ; USER RECORD BUFFER LENGTH
	MOVB	#R.FIX,F.RTYP(AR); NOT TEXT
	MOVB	#FD.PLC,F.RACC(AR); LOCATE MODE
	ALUN$S	AD,#"SY,#0	; ASSIGN LUN TO SY0:
	MOV	14.(SS),F.RSIZ(AR); RECORD SIZE
	BGT	10$		; IF NOT TEXTFILE
; INIT TEXTFILE PARAMETERS
	SUB	#TEXTBUFFSIZE+FILESIZECORR+2,F.URBD+2(AR)
;				; POINT TO HIDDEN BUFFER
	MOV	#TEXTBUFFSIZE,F.URBD(AR)
	CLR	F.RSIZ(AR)
	MOVB	#R.VAR,F.RTYP(AR)
	BIS	#TEXT,@SS
10$:	MOVB	#FD.CR,F.RATT(AR); CARRIAGE CONTROL NOT IN TEXT
	BIT	#RANDOM,@SS
	BEQ	15$		; IF RANDOM NOT SPECIFIED
	BISB	#FD.BLK,F.RATT(AR)	; RECORDS MAY NOT
;				;   CROSS BLOCK BOUNDARIES
	BISB	#FD.RAN,F.RACC(AR)	; RANDOM ACCESS MODE
	BIC	#INSERT,@SS	; INSERT AND RANDOM NOT ALLOWED TOGETHER
15$:	BIT	#UPDATE,@SS
	BEQ	20$		; IF UPDATE NOT SPECIFIED
	BIT	#INSERT,@SS	; INSERT ?
	BEQ	17$		; IF NO
	BISB	#FD.INS,F.RACC(AR)
17$:	MOV	#FO.UPD,(HP)	; CHANGE FO.WRT TO FO.UPD
	BR	25$
; NOT UPDATE
20$:	BIT	#APPEND,@SS
	BEQ	25$		; IF NOT APPEND
	MOV	#FO.APD,(HP)	; CHANGE FO.WRT TO FO.APD
; ALWAYS
25$:	BIT	#SHARED,@SS
	BEQ	30$		; IF NOT SHARED
	BIS	#FA.SHR,(HP)
; ALWAYS
30$:	;   FD.INS => BIC #^C<INSERT>,@SS  ; ?????????
31$:	BIT	#TEMPORARY,@SS
	BEQ	38$
	BIS	#FA.TMP,(HP)
; ALWAYS SKIP TRAILING BLANKS OF FILENAME, DIR AND DEV
38$:	MOV	SS,-(HP)
	ADD	#12.,(HP)	; POINT TO FNAME ADDRESS
32$:	MOV	@(HP),AD	; ADDRESS OF FILENAME STRING
	SUB	#2,(HP)
	TST	AD		; STRING GIVEN ?
	BEQ	37$		; NO
	ADD	@(HP),AD	; LENGTH OF STRING
33$:	CMPB	-(AD),#40
	BGT	34$		; IF CHAR > SPACE
	DEC	@(HP)		; ADJUST STRING LEN IF SPACE OR LESS
	BGT	33$
34$:	CMPB	(AD)+,#':
	BNE	39$
	DEC	@(HP)
39$:	MOV	@(HP),-(HP)	; TEMP COUNTER FOR
50$:	DEC	@HP		; CONVERTING LOWER CASE
	BLT	60$		; TO UPPER CASE
	CMPB	-(AD),#137
	BLE	50$
	BICB	#40,@AD
	BR	50$
60$:	TST	(HP)+		; REMOVE TEMP COUNTER
37$:	SUB	#2,(HP)
	CMP	(HP),SS
	BGT	32$		;FOR DIR AND DEV
	TST	(HP)+		; DELETE TEMP
; ALWAYS. DIR STRING IN []
	MOV	8.(SS),AD	; ADDRESS OF DIR STRING
	BEQ	36$		; IF NOT GIVEN
	MOVB	#'[,(AD)
	ADD	6(SS),AD
	DEC	AD		; POINT TO LAST CHAR
	MOVB	#'],(AD)
36$:	MOV	(HP)+,AD
	CLR	EOFSTATUS(R)
	MOV	(SS)+,FILTYP(R)
	OPEN$	,AD,,SS
	MOVB	F.ERR(AR),AD
	MOV	AD,IORESULT(R)
	BGT	35$
	INC	EOFSTATUS(R)
35$:	ADD	#16.,SS
	BIT	#INPUT+UPDATE,FILTYP(R)
	BEQ	40$		; IF WRITE OR APPEND
;
	TST	EOFSTATUS(R)	; OPEN OK ?
	BNE	9$		; NO
	JMP	$GET1		; IF READ OR UPDATE
;
40$:	BIS	#TRUE,EOFSTATUS(R)	; TRUE
	CLR	EOLNSTATUS(R)	; FALSE
	MOV	F.NRBD+2(AR),@R
	BIT	#TEXT,FILTYP(R)
	BEQ	9$		; IF NOT TEXTFILE
	MOV	F.NRBD(AR),2(R)
	BNE	9$
	MOV	F.URBD(AR),2(R)
	MOV	F.URBD+2(AR),@R
9$:	RETURN
;
	.END
****
P11GETPUT.MAC        
	.TITLE	P11GETPUT
;
	.MCALL	GET$,PUT$,QIO$S,WTSE$S,FDOF$L,FSRSZ$
;
	FDOF$L		; DEFINE FDB OFFSETS
	FSRSZ$	MAXFILES
;
	.PSECT	PASRUN
;
;
;
	.SBTTL	PUT
;
; PUT(F)
;
;	(SS) = POINTER TO FILE WINDOW
;
	ROUTINE	PUT
	FINDFILE	(SS)+
$PUT2::	BIT	#TEXT,FILTYP(R)
	BNE	PUTCH1
	PUT$
	MOV	F.NRBD+2(AR),@R	; NEXT RECORD BUFFER
	MOVB	F.ERR(AR),AD	; ERROR BYTE
	MOV	AD,IORESULT(R)	; NEG IF ERROR
9$:	RETURN
PUTCH1:	INC	@R
	DEC	2(R)
	BLE	PUTLN2
	MOV	#1,IORESULT(R)
	RETURN
;
;
	.SBTTL	PUTLINE
;
; PUTLINE(F)
;
;	(SS) = POINTER TO FILE WINDOW
;
	ROUTINE	PUTLN
	FINDFILE	(SS)+
PUTLN2:	BIT	#TTY,FILTYP(R)
	BNE	PUTTTY
	MOV	#TEXTBUFFSIZE,AD
	SUB	2(R),AD		; REMAINING CHAR IN LINE COUNTER
	PUT$	,,AD
	MOV	#TEXTBUFFSIZE,2(R)
	MOV	F.NRBD+2(AR),@R	; NEXT RECORD BUFFER POINTER
	MOVB	F.ERR(AR),AD
	MOV	AD,IORESULT(R)
	RETURN
;
;
;
; BREAK
;
;	(SS) = FILE POINTER
;
	ROUTINE	BRKLN
	$BRK::
	FINDFILE	(SS)+
	MOV	#44,AR		; CARRIAGE CONTROL CHAR
	BR	BRK2
;
PUTTTY:	MOV	#40,AR		; CARRIAGE CONTROL CHAR
BRK2:	MOV	R,AD
	SUB	#FILESIZECORR+TEXTBUFFSIZE-FDBSIZE,AD
	SUB	AD,@R
	CMP	-(SS),-(SS)	; SPACEFOR IO STATUS BLOCK
	QIO$S	#IO.WVB,#TILUN,#5,,SS,,<AD,@R,AR>
	WTSE$S	#5
	MOV	AD,@R
	MOV	#TEXTBUFFSIZE,2(R)
	MOVB	@SS,AD
	CMP	(SS)+,(SS)+	; REMOVE IO STATUS BLOCK
	MOV	AD,IORESULT(R)
	RETURN
;
;
;
	.SBTTL	WRCHA
;
; WRCHA(F,CHAR:N)
;
;	4(SS) = POINTER TO FILE WINDOW
;	2(SS) = CHARACTER
;	 (SS) = FIELDLENGTH
;
	ROUTINE	WRCHA
	CLR	AD
	MOV	#1,-(SS)	; STRINGLENGTH
	BR	WRS1
;
;
	.SBTTL	WRC
;
; WRC(F,CHAR)
;
;	2(SS) = POINTER TO FILE WINDOW
;	 (SS) = CHARACTER
;
	ROUTINE	WRC
	MOV	(SS)+,R		; GET CHAR
	MOV	@SS,AD		; GET FILE POINTER
	MOVB	R,@(AD)+	; PUT CHAR IN FILE WINDOW
	MOV	(SS),-(SS)	; LEAVE FILE POINTER ON STACK
	JMP	$PUT
;
;
;
; PAGE(F)
;
;	(SS) = FILE POINTER
;
	ROUTINE	PAGE
	MOV	@SS,-(SS)	; SAVE FILE POINTER
	CALLSS	PUTLN
	MOV	#FF,-(SS)	; FORM FEED
	CALLSS	WRC
	CALLSS	PUTLN
	RETURN
;
;
;
; WRS(F,STRING)
;
;	6(SS) = POINTER TO FILE WINDOW
;	4(SS) = ADDRESS OF STRING
;	2(SS) = FIELDLENGTH
;	 (SS) = LENGTH  OF STRING
;
	ROUTINE	WRS
	MOV	GP,AD		; <> ZERO
WRS1:	FINDFILE	6(SS),#8.
	MOV	AD,-(HP)	; WRCHA OR WRS
	CMP	(SS),2(SS)	;
	BLE	6$		; STR.LEN <= FIELDLEN
	MOV	2(SS),(SS)	; FIELDLEN := MIN(FL,STRL)
6$:	MOV	(SS)+,-(HP)	; SAVE STRINGLENGTH
	CMP	@SS,2(R)
	BLE	2$		; ENOUGH SPACE
	MOV	4(SS),-(SS)	;FILE POINTER
	JSR	MP,PUTLN2
	TST	(SS)+		; REMOVE FILE POINTER
2$:	MOV	(SS)+,AR	; FIELD LENGTH
	MOV	@R,AD
	SUB	AR,2(R)		; ADJUST COUNTER
	BGE	11$
	ADD	2(R),AR		; IF FIELD > TEXTBUFF THEN FIELD := TEXTBUFF
	CLR	2(R)
11$:	SUB	(HP),AR		; FIELDLEN - STR.LEN
	BLE	7$		; IF NOT ENOUGH SPACE
4$:	MOVB	#40,(AD)+	; SPACES
	DEC	AR
	BGT	4$
7$:	ADD	(HP)+,AR	; STRINGLENGTH
	BLE	10$
	TST	(HP)+
	BEQ	5$		; WRCHA
	MOV	(SS)+,R
3$:	MOVB	(R)+,(AD)+
	DEC	AR
	BGT	3$
	BR	8$
5$:	MOVB	(SS)+,(AD)+	; INSERT WANTED CHAR AT END
	TSTB	(SS)+		; WORD ALLIGNMENT
	BR	8$
10$:	TST	(HP)+		; REMOVE WRCHA INDICATION
	TST	(SS)+		; REMOVE STRING POINTER
8$:	MOV	@SS,R
	MOV	AD,@R		; POINTER IN BUFFER
	TST	2(R)		; REMAINING CHAR COUNTER
	BGT	9$
	MOV	@SS,-(SS)	; DOUBLE FILE POINTER
	CALLSS	PUTLN		; OUTPUT LINE IF BUFFER FULL
9$:	RETURN			; LEAVE FILE POINTER ON SS
;
;
;
; RDC(F,CHAR)
;
;	2(SS) = POINTER TO FILE WINDOW
;	 (SS) = ADDRESS OF CHARACTER
;
	ROUTINE	RDC
;
	MOV	@2(SS),AD	; POINTER IN BUFFER
	MOVB	@AD,@(SS)+
	MOV	@SS,-(SS)	; LEAVE FILE POINTER ON STACK
	BR	$GET		; CONSUMES ONE FILE POINTER
;
;
;
;
; GET(F)
;
;	(SS) = POINTER TO FILE WINDOW
;
	.ENABLE	LSB
;
	ROUTINE	GETLN
;
	MOV	GP,AD		; <> ZERO
	BR	GET3
;
	ROUTINE	GET
;
	CLR	AD		; ZERO
;
GET3:	FINDFILE	(SS)+
GET2:	TST	EOFSTATUS(R)
	BNE	99$
	TST	AD
	BNE	3$		; IF GETLINE
	TST	EOLNSTATUS(R)
	BNE	3$		; IF EOLN THEN GETLN
2$:	BIT	#TEXT,FILTYP(R)
	BNE	7$		; IF TEXTFILE
$GET1::
3$:	CLR	EOLNSTATUS(R)
	BIT	#TTY,FILTYP(R)
	BNE	GETTTY
	GET$
	MOVB	F.ERR(AR),AD
	MOV	AD,IORESULT(R)	;***** MOV(B) LEAVES CARRY-BIT UNCHANGED
	BCC	1$		; IF TRANSFER OK
	INC	EOFSTATUS(R)
1$:	MOV	F.NRBD+2(AR),@R	; NEXT RECORD BUFFER
	BIT	#TEXT,FILTYP(R)
	BEQ	9$		; READYIF NOT TEXTFILE
	MOV	F.NRBD(AR),2(R)	; REMAINING CHAR COUNTER
	BEQ	7$		; SET EOLN IF EMPTY LINE
9$:	RETURN
;
7$:	DEC	2(R)
	BGT	8$		; IF CHAR'S LEFT
	INC	EOLNSTATUS(R)
	MOV	F.URBD+2(AR),@R
	MOVB	#40,@(R)	; SPACE
	RETURN
8$:	INC	@R
	RETURN
;
99$:	CALLSS	WRERROR
	.BYTE	66.,1
	RETURN
;
;
;
GETTTY:	MOV	R,AD
	CMP	-(SS),-(SS)	; SPACE FOR IO STATUS BLOCK
	SUB	#FILESIZECORR+TEXTBUFFSIZE-FDBSIZE,AD
	QIO$S	#IO.RVB,#TILUN,#5,,SS,,<AD,#TEXTBUFFSIZE>
	WTSE$S	#5
	MOV	AD,@R
	MOVB	@SS,AD		; 1ST BYTE OF TTYSB
	MOV	AD,IORESULT(R)
	TST	(SS)+		; SKIP 1ST WD OF IO STATUS BLOCK
	MOV	(SS)+,2(R)	; NUMBER OF CHAR'S
	BNE	19$
	INC	EOLNSTATUS(R)	; SET EOLN IF EMPTY LINE
	MOVB	#40,@(R)	; SPACE
19$:	RETURN
;
	.DSABLE	LSB
;
;
	.END
****
P11WRERR.MAC         
	.TITLE	WRERROR
;
	.MCALL	QIO$S,WTSE$S,EXIT$S,PRINT$,CLOSE$,FDOF$L
;
	FDOF$L		; DEFINE FDB OFFSETS
;
;
; WRERROR
;
;	MP = ADDRESS OF ERROR BYTES
;
;		BYTE 1 :  ERROR NUMBER
;		BYTE 2 :  ERROR TYPE
;			  0  WARNING
;			  1  SERIOUS ERROR
;			  2  FATAL ERROR
;			  +128. IF PARAMETERS ON SS
;
;
; IF ERROR BYTE 2 > 127. THEN SS DELIVERS PARAMETERS:
;
;	M*2(SS)		PARAM NR M
;	M*2-2(SS)	PARAM NR M-1
;	- - -
;	4(SS)		PARAM NR 2
;	2(SS)		PARAM NR 1
;	 (SS)		M = NUMBER OF PARAMETERS ON SS
;
	ROUTINE	WRERROR
;
	MOVB	(MP),R
	TST	(MP)		; TEST TYPE BYTE
	BLT	1$		;  PARAMS ON SS
	CLR	-(SS)
1$:	MOV	@SS,-(SS)	; PARAM COUNTER
	MOV	LINEADDR(GP),2(SS)	; 1ST PARAM = LINENO
	INC	@SS
	MOV	#WRENUM,AD
	MOV	#TENPOW+6,AR	; ERROR NO < 100.
	BR	8$
2$:	MOV	#TENPOW,AR
8$:	MOVB	#60,(AD)
3$:	SUB	@AR,R
	BLT	4$
	INCB	@AD
	BR	3$
4$:	TSTB	(AD)+
	ADD	(AR)+,R
	TST	(AR)
	BNE	8$
	DEC	(SS)
	BLT	9$		; NO MORE PARAMS
	MOV	2(SS),R		; NEXT PARAM
	MOV	(SS)+,(SS)	; MOV PARAM COUNTER
	TSTB	(AD)+		; LEAVE ONE SPACE BETWEEN PARAM'S
	BR	2$
9$:	SUB	#WREMSG,AD
	QIO$S	#IO.WVB,#5,#5,,,,<#WREMSG,AD,#40>
	WTSE$S	#5
	TST	(SS)+		; REMOVE PARAM COUNTER
	MOV	(MP)+,R	; ERROR BYTES
	BIT	#1000,R		; TYPE OF ERROR
	BEQ	11$		; IF SERIOUS
				; IF WARNING ONLY
	RETURN
11$:	JMP	$EXITP
WREMSG:	.ASCII	/PASRUN -- ERROR /
WRENUM:	.ASCII	/00 00000 00000 00000 00000/
	.EVEN
TENPOW:	.WORD	10000.,1000.,100.,10.,1,0
;
;
;
	.END
****
P11EXIT.MAC          
	.TITLE	P11EXIT
;
	.MCALL	QIO$S,WTSE$S,EXIT$S,PRINT$,CLOSE$
	.MCALL	FDOF$L,DELET$
	FDOF$L		; DEFINE FDB OFFSETS
;
; CLOSE(F)
;
;	(SS)	POINTER TO FILE POINTER
;
$CLOSE:
;
	FINDFILE	(SS)+
CLOSE1:	BIT	#TTY,FILTYP(R)
	BNE	9$
	BIT	#SPOOL,FILTYP(R)
	BEQ	1$
	BIT	#TEXT,FILTYP(R)
	BEQ	1$
	PRINT$	R0
	BR	2$
1$:	TST	F.RSIZ(AR)	; TEST IF FILE IS EMPTY
	BNE	3$		; IF EMPTY THEN DELETE ELSE CLOSE
;				; ( TEXTFILES ONLY )
	DELET$	R0
	BR	2$
3$:	CLOSE$	R0
2$:	MOVB	F.LUN(AR),AD
	ASL	AD
	CLRB	F.LUN(AR)
	ADD	GP,AD
	CLR	LUNTAB(AD)
9$:	RETURN
;
; PROCEDURE CLOSE ( VAR F: FILE );     EXTERN ;
;
CLOSEF:: TST	(SP)+	; SKIP MP LINK
	CALLSS	CLOSE
	RTS	PC
;
;
; EXITP
;
	ROUTINE	EXITP
;
	MOV	#<2*MAXFILES+2>,AD
	ADD	GP,AD
	MOV	#MAXFILES+1,-(HP)
1$:	MOV	LUNTAB(AD),-(SS)
	BEQ	3$
	INC	LUNTAB(AD)
	BEQ	3$
2$:	JSR	MP,$CLOSE
3$:	TST	-(AD)
	DEC	@HP
	BGT	1$
	EXIT$S
;
;
	.END
****
P11CMREAL.MAC        
	.TITLE	CMREAL
	.TITLE	P11CMR	REAL COMPARISON ROUTINES
;********************* EQUR *************************
;
;
	ROUTINE  EQUR  ENDEQR
EQRL0:	LINK   EQRL1-EQRL0
EQRL1:	LINK   NOLINK		;NO MORE CALLS
	CALLSS   CMR
	TST  (SS)		;RESULT OF COMPARE
	BEQ  EQR0
	CLR  (SS)		;FALSE
	RTS  MP
EQR0:	INC  (SS)		;TRUE
ENDEQR:	RTS  MP
;******************************* NEQR *******************************
	ROUTINE    NEQR   ENDNQR
NQRL0:	LINK   NQRL1-NQRL0
NQRL1:	LINK   NOLINK
	CALLSS   CMR
	TST  (SS)
	BEQ  NQR0
	MOV  #1,(SS)		;TRUE
	RTS  MP
NQR0:
ENDNQR:	RTS  MP
;****************************** LESR *******************************
	ROUTINE   LESR   ENDLSR
LSRL0:	LINK   LSRL1-LSRL0
LSRL1:	LINK   NOLINK
	CALLSS   CMR
	TST  (SS)
	BLT  LSR0
	CLR  (SS)		;FALSE
	RTS  MP
LSR0:	MOV  #1,(SS)		;TRUE
ENDLSR:	RTS  MP
;************************** LEQR *******************************
	ROUTINE   LEQR   ENDLQR
LQRL0:	LINK   LQRL1-LQRL0
LQRL1:	LINK   NOLINK
	CALLSS   CMR
	TST  (SS)
	BLE  LQR0
	CLR  (SS)		;FALSE
	RTS  MP
LQR0:	MOV  #1,(SS)		;TRUE
ENDLQR:	RTS  MP
;************************* GRTR ******************************
	ROUTINE   GRTR   ENDGRR
GRRL0:	LINK   GRRL1-GRRL0
GRRL1:	LINK   NOLINK
	CALLSS  CMR
	TST  (SS)
	BGT  GRR0
	CLR  (SS)		;FALSE
	RTS  MP
GRR0:	MOV  #1,(SS)		;TRUE
ENDGRR:	RTS MP
;************************** GEQR *******************************
	ROUTINE   GEQR   ENDGQR
GQRL0:	LINK   GQRL1-GQRL0
GQRL1:	LINK   NOLINK
	CALLSS  CMR
	TST  (SS)
	BGE  GQR0
	CLR  (SS)		;FALSE
	RTS  MP
GQR0:	MOV  #1,(SS)		;TRUE
ENDGQR:	RTS  MP
;****************************** CMR ***************************
$CMR:
	LINK   NOLINK
	CLR  R0			;CONDITION REGISTER
	CMP  4(SS),(SS)+	;COMPARE LOW WORDS
	BGT   CMR1		;GREATER
	BLT  CMR2		;LESS THAN
	TST  2(SS)		;TEST SIGN OF REALS
	BPL  CMR4		;POSITIVE
	CMP  4(SS),(SS)		;COMPARE NEGATIVE OPERANDS
	BHI  CMR2		;GREATER --> RESULT=SMALLER
	BLO  CMR1
	BR CMR3		;EQUAL
CMR4:	CMP 4(SS), (SS) 	;EQUAL LOW WORDS, COMPARE HIGH WORDS
	BHI  CMR1		;GREATER
	BLO  CMR2		;LESS THAN
CMR3:	CMP  (SS)+,(SS)+	;REMOVE WORD
	MOV  R0,(SS)		;'BOOLEAN' RESULT
	RTS  MP
CMR1:	INC  R0
	BR  CMR3		;GREATER -->COND > 0
CMR2:	DEC  R0			;COND = -1
ENDCMR:	BR  CMR3
	.END
****
P11WRREAL.MAC        
	.TITLE	WRREAL
;****************************** WRR ********************************
	;WRITE THE REAL IN 2(SS), 4(SS) IN FLOATING FORMAT
	;FIELDLENGTH IN (SS), FILE IN 6(SS)
	ROUTINE   WRR   ENDWRR
WRRL0:	LINK   WRRL1-WRRL0
	MOV	6(SS),AD
	CMP	@SS,2(AD)	; SPACE ENOUGH IN CURRENT LINE ?
	BLE	1$		; YES
	MOV	AD,-(SS)	; NO. TAKE NEXT LINE ( CR-LF )
	CALLSS	PUTLN
1$:	MOV  (SS)+, -(HP)	;FIELDLENGTH
	MOV  (HP), R0
	SUB  #14., R0		;ANY LEADING BLANKS?
	MOV  4(SS),-(SS)	;FILE
	MOV  #' ,-(SS)		;BLANKS
WRRL1:	LINK   WRRL2-WRRL0
	CALLSS   TRAILR
WRR1:	SUB  #6, (HP)		;CALCULATE NUMBER OF DIGITS
	BGT  WRR3		;FIELDLENGTH MUST BE 7 AT LEAST
	MOV  #1, (HP)		;MINIMUM NUMBER OF DIGITS
WRR3:	CMP  (HP), #8.		;MAXIMUM 
	BLE  WRR4
	MOV  #8., (HP)		;TAKE MAXIMUM
WRR4:	MOV  2(SS), R0		;LOW WORD FOR SIGN
WRRL2:	LINK   WRRL4-WRRL0
	CALLSS   PRTSGN
	BIC  #100000,2(SS)	;REMOVE SIGN
	MOV  #'.,-(SS)		;PRINT '.'
WRRL3:	CALLSS  WRC
	TST  (SS)+		;REMOVE FILE
	MOVB (HP),1(HP)		;FIELD LEN TO NORMLZ
	MOV  (HP)+,R1
WRRL7:	LINK   WRRL9-WRRL0
	CALLSS   NORMLZ		;NORMALIZE
	MOV  R2,-(HP)		; DEC EXP
	MOV  R0,-(HP)		; EXP SIGN FLAG
	MOVB R1,R1		; CLEAR HIGH BYTE
WRRL9:	LINK   NOLINK
	CALLSS   DECDIG
	CMP  (SS)+,(SS)+	;REMOVE REAL FROM STACK
	MOV  #'E,-(SS)	
	CALLSS  WRC		;WRITE E
	MOV  (HP)+,R0		;EXP SIGN FLAG
WRRL4:	LINK   WRRL7-WRRL0
	CALLSS   PRTSGN
	MOV  #60,-(SS)		;LOAD '0'
	MOV  (HP)+,R2		;EXPONENT
WRR6:	CMP  R2, #10.		;GREATER THAN 10?
	BLT   WRR5
	SUB  #10., R2
	INC  (SS)		;DECADES
	BR  WRR6
WRR5:	MOV  R2,-(HP)		;SAVE DECIMAL EXP
	CALLSS  WRC
	MOV  (HP)+,-(SS)	;RETRIEVE DEC EXP
	ADD  #60, (SS)
	CALLSS  WRC		;WRITE EXPONENT IN TWO DECIMALS
ENDWRR:	RTS  MP
;*********************************** NORMLZ **********************************
	;NORMALIZES A (POSITIVE) REAL ON TOP BETWEEN 0.1 AND 1
	;REGISTER USE: R0, R1, R2   R1 UNMODIFIED, R2 CONTAINS (SIGNED) DECEXP
	ROUTINE   NORMLZ   ENDNLZ
NLZL0:	LINK   NLZL1-NLZL0
	CLR  -(HP)		;SET EXPONENT SIGN FLAG
	MOV  R1,-(HP)		;STORE NUMBER OF DIGITS AFTER
	JSR  MP, BINEXP		;GET BINARY EXPONENT
	BEQ  NLZ0		;EASY JOB
	BPL  NLZ6		;PLUS
	DEC  2(HP)		;SET SIGN FLAG
	NEG  R2			;POSITIVE EXPONENT
NLZ6:	MOV  R2,-(SS)
NLZL1:	LINK   NLZL2-NLZL0
	CALLSS   FLT		;FLOAT BINEXP
	MOV  #20233,-(SS)
	MOV  #37632,-(SS)	;LOAD LOG2 ON THE STACK
NLZL2:	LINK   NLZL3-NLZL0
	CALLSS   MULR
NLZL3:	LINK   NLZL4-NLZL0
	CALLSS   TRC		;INTEGER RAW DECEXP
	MOV  (SS)+, R2		;LOAD INTO R2
NLZ0:	MOV  R2,-(HP)		;STORE DECEXP
	MOV  4(HP), R0		;SIGN FLAG
NLZL4:	LINK   NLZL5-NLZL0
	CALLSS   SCALE
	TST  R0			;ADD SIGN TO STORED DECEXP
	BPL  NLZ10
	NEG  (HP)		;SIGNED DECEXP
NLZ10:	JSR  MP, BINEXP		;GET BINARY EXPONENT
	BEQ  NLZ2
	BPL  NLZ1		;EXP > 0 --> DIVIDE BY 10
	CMP  (SS), #37314	;COMPARE NORMALIZED REAL TO 0.1
	BGT  NLZ2		;GREATER --> NORMALIZED ALREADY
	BLT  NLZ1		;LESS --> MULTIPLY
	CMP  2(SS), #146314	;SECOND PART
	BHIS  NLZ2		;GREATER OR EQUAL 0.1
NLZ1:	CLR  -(SS)
	MOV  #41040,-(SS)	;LOAD FLOATING 10
	TST  R2			;MULTIPLY OR DIVIDE?
	BGT  NLZ3
	DEC  (HP)		;DECREMENT EXPONENT
NLZL5:	LINK   NLZL6-NLZL0
	CALLSS   MULR		;MULTIPLY 
	BR  NLZ2		;READY
NLZ3:	INC  (HP)		;INCREMENT EXPONENT
NLZL6:	LINK   NOLINK
	CALLSS   DIVR
;************************* CALL ROUND HERE? *********************
NLZ2:	JSR MP, BINEXP		;GET BINARY EXPONENT
	TST  @R5
	BEQ  1$			; FLOATING ZERO
	CLRB 1(R5)		;REMOVE EXPONENT
	BIS  #200, (R5)		;HIDDEN BIT
	SWAB  (R5)
	MOVB  3(R5),(R5)
1$:	CLRB  3(R5)
	SWAB  2(R5)		;ARRANG REAL FOR OUTPUT
	MOVB 3(HP),R1		;GET NUMBER OF
	ADD  (HP),R1		;WANTED DIGITS
	MOVB R1,R1		;CLEAR LEFT CHAR
	CMP  R1,#9.
	BGT  NLZ4
	CLR  R0			; OVERFLOW SIGNAL
	ASL  R1
	ASL  R1
	ADD NLZRND-2(R1),2(SS)
	ADC  (SS)
	ADC  R0
	ADD  NLZRND-4(R1),(SS)
	ADC  R0
	BEQ  NLZ4
	MOV	#14631,(SS)
	MOV	#114700,2(SS)
	INC	(HP)		;DECEXP
	BR	NLZ5
NLZ4:	INC  R2
	BGT  NLZ5		;NORMALIZE BINEXP ZERO
	CLC			; CLEAR CARRY
NLZ11:	ROR  (R5)
	ROR  2(R5)		;SHIFT ONE PLACE
	BR  NLZ4
NLZ5:	MOV  (HP)+, R2		;RESTORE DECEXP
	BPL  NLZ9
	NEG  R2			;MAKE EXPONENT PLUS
NLZ9:	MOV  (HP)+, R1		;GET NUMBER OF DIGITS
	MOV  (HP)+, R0		;RESTORE DECEXP SIGN
	TST  R2			;CHECK IF EQUAL
	BNE  NLZ7		;IF DECEXP 0 THEN SIGN = +
	CLR  R0
NLZ7:	RTS  MP
;
NLZRND:	.WORD	6314,146315
	.WORD	507,127024
	.WORD	40,142234
	.WORD	3,43334
	.WORD	0,51743
	.WORD	0,4143
	.WORD	0,327
	.WORD	0,25
	.WORD	0,2
BINEXP:	MOV  (R5), R2		;EXPONENT PART
	BEQ  ENDNLZ
	ROL  R2
	CLRB  R2
	SWAB  R2
	SUB  #200, R2		;BINARY EXPONENT
ENDNLZ:	RTS  MP
;********************************** DECDIG ******************************
	;DECDIG PRINTS DECIMAL DIGITS FROM A NORMALIZED REAL
	;R1= NUMBER OF DIGITS
	;R2 = DECEXP
	;   4(SS)FILE ID ( LEFT ON STACK )
	;   2(SS)   NORM. REAL
	;    (SS)   "-
	ROUTINE   DECDIG   ENDDDG
DDGL0:	LINK   NOLINK
	MOV  R1, -(HP)		;SAVE NUMBER OF DIGITS TO BE PRINTED
	BLE   DDG2
DDG1:	CLR  R0			;INITIALIZE
	ASL  2(R5)
	ROL  (R5)		;SHIFT ONE PLACE
	ROL  R0			;CATCH BITS FALLING OUT
	MOV  R0,-(HP)
	MOV (R5),-(HP)
	MOV  2(R5),-(HP)	;STORE 
	ASL  2(R5)
	ROL  (R5)
	ROL  R0			;MULTIPLY BY TWO
	ASL  2(R5)
	ROL  (R5)
	ROL  R0			;ANOTHER TIME
	ADD  (HP)+,2(R5)
	ADC  (R5)
	ADC  R0
	ADD  (HP)+, (R5)	;ADD FOR MULTIPLY BY 10
	ADC  R0
	ADD  (HP)+, R0		;COMPLETE DIGIT
	ADD  #60, R0		;CHARACTER CONVERSION
	MOV  4(SS),-(SS)	;FILE ID
	MOV  R0, -(SS)
	CALLSS  WRC
	TST  (SS)+		;REMOVE FILE ID
	DEC  (HP)		;COUNT  DIGITS
	BGT  DDG1
DDG2:	TST  (HP)+		;REMOVE COUNT
ENDDDG:	RTS  MP
;******************************* PRTSGN *******************************
	;PRINTS A SIGN ON THE SIGN FLAG IN R0
	;   (SS)   FILE ID ( LEFT ON STACK )
	ROUTINE   PRTSGN   ENDPSN
PSNL0:	LINK   NOLINK
	MOV  #'+,-(SS)		;LOAD PLUS SIGN
	TST  R0			;DETERMINE SIGN
	BPL  PSNL1
	MOV  #'-,(SS)		;MINUS
PSNL1:	CALLSS  WRC		;WRITE SIGN
ENDPSN:	RTS  MP
;****************************** TRAILR *******************************
	;PRINTS R0 CHARACTERS OF THE KIND GIVEN IN (SS)
	;   2(SS)   FILE ID ( LEFT ON STACK )
	ROUTINE   TRAILR   ENDTRL
TRLL0:	LINK   NOLINK
	MOV  (SS)+,-(HP)	;SAVE CHARACTER
	MOV  R0,-(HP)		;SAVE NUMBER OF CHAR'S
TRL0:	TST  (HP)		;NUMBER OF CHARACTERS
	BLE  TRL1		;NO MORE
	MOV  2(HP),-(SS)	;LOAD CHARACTER
	CALLSS  WRC
	DEC  (HP)		;DECREMENT COUNTER
	BGT  TRL0
TRL1:	CMP (HP)+,(HP)+		;REMOVE MODEL
ENDTRL:	RTS  MP
;***************************** WRFIX ******************************
	;WRITES THE REAL IN 4(SS), 6(SS) IN A FIXED FORMAT
	;FILE IN 8(SS)
	;FIELDLENGTH IN 2(SS)
	;NUMBER OF DIGITS AFTER DECIMAL POINT IN (SS)
	ROUTINE   WRFIX   ENDWRF
WRFL0:	LINK   WRFL2-WRFL0
	MOV	8.(SS),AD
	CMP	2(SS),2(AD)	; SPACE ENOUGH IN CURRENT LINE ?
	BLE	1$		; YES
	MOV	AD,-(SS)	; NO. TAKE NEXT LINE ( CR-LF )
	CALLSS	PUTLN
1$:	MOV  (SS)+, R2		;NUMBER OF DIGITS AFTER
	BMI  WRF6		;MUSTBE > = 0
	SUB  R2, (SS)		;CALCULATE NUMBER OF DIGITS BEFORE
	SUB  #2, (SS)		;FOR SIGN AND DEC. POINT
	BMI  WRF6		;MUST BE >= 0
	MOVB  R2,1(SS)		;PACK 'BEFORE' AND 'AFTER'
	MOV  (SS)+, R1		;AND MOVE TO R1
	MOV  2(SS), -(HP)
	MOV  (SS),-(HP)		;STORE REAL FOR FLOATING OUTPUT
	BIC  #100000,(SS)	;REMOVE SIGN
WRFL2:	LINK   WRFL3-WRFL0
	CALLSS   NORMLZ		;NORMALIZE FOR EXPONENT
	MOV  R1,-(HP)
	MOV  R2,-(HP)
	TST  R0			;EXPONENT SIGN
	BPL  WRF1		;PLUS OR ZERO
	NEG  (HP)		;SIGNED DECEXP
	MOV  4(SS),-(SS)	;FILE ID
	MOVB  2(HP), R0		;NUMBER OF DIGITS BEFORE
	MOV  #' ,-(SS)
WRFL9:	LINK   WRFL10-WRFL0
	CALLSS   TRAILR		;PRINTLEADING BLANKS
	MOV  4(HP), R0		;RESTORE SIGN OF REAL
WRFL3:	LINK   WRFL4-WRFL0
	CALLSS   PRTSGN
	BR   WRF2
WRF1:	MOVB  2(HP), R0		;CHECK IF FIELD LARGE ENOUGH
	SUB  (HP), R0		;R0 = NUMBER OF LEADING BLANKS
	BGE  WRF3
	CMP  (HP)+,(HP)+	;REMOVE TEMPS
	MOV  (HP)+, (SS)
	MOV  (HP)+, 2(SS)	;LOAD ORIGINAL REAL
	CLR  -(SS)		;FOR FIELDLENGTH
WRF6:	MOV  #15.,(SS)		;DEFAULT VALUE
WRFL10:	LINK  WRFL11-WRFL0
	CALLSS   WRR		;WRITE IN FLOATING FORMAT
	RTS  MP
WRF3:	MOV  4(SS),-(SS)	;FILE
	MOV  #' ,-(SS)
WRFL4:	LINK   WRFL5-WRFL0
	CALLSS   TRAILR		;PRINT BLANKS
	MOV  4(HP),R0		;SIGN
WRFL11:	LINK   NOLINK
	CALLSS   PRTSGN
	TST  (SS)+		;REMOVE FILE ID
	MOV  (HP), R1		;INITIATE R1 FOR DECDIG
WRFL5:	LINK   WRFL7-WRFL0
	CALLSS   DECDIG		;PRINTS DIGITS BEFORE DEC. POINT
	MOV  4(SS),-(SS)	;FILE ID
WRF2:	MOV  #'.,-(SS)
	CALLSS  WRC		;PRINT DECIMAL POINT
	MOVB 3(HP),R1		;INIT R1 FOR DECDIG
	TST  (HP)		;IF (HP) < 0 THEN NO DIGITS PRINTEDYET
	BPL  WRF5
	NEG  (HP)		;MAKE (HP) > 0
	CMPB (HP), 3(HP)
	BLE  WRF4
	MOVB  3(HP), (HP)	;IF 3(HP) > (HP) THEN ONLY ZEROES
WRF4:	MOV  (HP), R0		;FOR TRAILR
	MOV  #'0,-(SS)		;ZEROES
WRFL7:	LINK   WRFL8-WRFL0
	CALLSS   TRAILR		;
	MOVB 3(HP),R1
	SUB  (HP), R1		;NO OF DIGITS TO BE PRINTED
WRF5:	TST  (SS)+		;REMOVE FILE ID	
WRFL8:	LINK   WRFL9-WRFL0
	CALLSS   DECDIG
	CMP  (SS)+,(SS)+	;REMOVE REALS
	ADD  #8.,HP		;REMOVE TEMPS AND REALS
ENDWRF:	RTS  MP
	.END
****
P11RDR.MAC           
	.TITLE	RDR
;**************************** RDR ****************************
	DECCNT=%1
;
	;READS A REAL NUMBER AND STORES IT ATTHE ADDRESS IN (SS)
	; 2(SS) = FILE ID  ( LEFT ON STACK )
	ROUTINE   RDR ENDRDR
RDRL0:	LINK   RDRL1-RDRL0
	MOV  (SS)+,-(HP)	;ADDRESS OF RESULT
RDRL1:	LINK   RDRL2-RDRL0
	CALLSS   RDSIGN		;READ SIGN
	MOV  R1,-(HP)		;STORE SIGN FLAG
	CLR  -(HP)		;INITIATE DECEXP ON STACK
	CLR  -(SS)
	CLR  -(SS)		;CREATE ROOM FOR LONG INTEGER
RDRL2:	LINK   RDRL4-RDRL0
	CALLSS   UNSINT		;TRY TO READAN UNSIGNED INT
	BVS  RDR1		;INTO (R5), 2(R5). IF V-BIT CLEAR
				;THEN NO DIGITS READ
	CMP  R0, #'E		;LAST READ CHARACTER AN 'E'?
	BEQ  RDR12		;YES
	CMP  R0,#'.		;LAST CHARACTER A '.' THEN?
	BEQ  RDRL3		;YES
	CALLSS  WRERROR
	.BYTE  44.,0
RDR12:	INC  2(R5)		;LONG INT MUST BE 1
	BR  RDR3
RDR1:	CMP  R0, #'.		;LAST CHAR A DECIMAL POINT?
	BNE  RDR2		;NO
RDRL3:	MOV  4(SS),-(SS)	;FILE ID
	CALLSS  GET		;YES, GET NEXT CHARACTER
	MOVB @(R), R0		;AND STORE IT IN R0
RDRL4:	LINK   RDRL6-RDRL0
	CALLSS   UNSINT		;ADD FRACTION PART TO LONG INT
	SUB DECCNT,(HP)	;UPDATE DECIMAL EXPONENT
RDR2:	CMP  R0, #'E		;EXPONENT PART?
	BNE  RDR4		;NO
RDR3:	CLR  -(SS)		;YES, PREPARE FOR RDI
	MOV  SS, R2		;ADDRESS FOR INTEGER VALUE
	MOV  6(SS),-(SS)	;FILE ID TO RDI
	MOV  R2,-(SS)		;LOAD ADDRESS FOR RDI
	MOV  2(SS),-(SS)	;FILE ID TO GET
	CALLSS  GET	;GET NEXT CHARACTER
RDRL6:	LINK   RDRL7-RDRL0
	CALLSS   RDI		;READ EXPONENT AND LEAVE IN IN (SS)
	TST  (SS)+		;REMOVE FILE ID
	ADD  (SS)+, (HP)	;UPDATE DECIMAL EXPONENT
LDCLF:	;CONVERT A LONG INTEGER TO FLOATING REAL
RDR4:	TST  (R5)		;TEST HIGH WORD
	BNE CLF1		;NUMBER IS >= 0
	TST  2(R5)		;LEAST SIGN PART
	BEQ  CLF2		;NO NEED TO NORM IF EQUAL
CLF1:	MOV  #30, R2		;STANDARD NO OF SHIFTS
	CLR  R1			;NO CARRY
	CLR  R0			;SIGN FLAG
RDRL7:	LINK   RDRL8-RDRL0
	CALLSS   NORM		;NORMALIZE FRACTION
CLF2:	MOV  #-1,R0		;INITIALIZE SIGN FLAG
	MOV  (HP)+, R2		;RESTOREE DECIMAL EXPONENT
	BPL  CLF3
	INC  R0			;SIGN FLAG
	NEG  R2			;DECEXP > 0
CLF3:
RDRL8:	LINK   NOLINK
	CALLSS   SCALE
	MOV  (HP)+, R0		;TEST SIGN OF REAL
	BPL  RDR5		;PLUS?
	BIS  #100000,(R5)	;SET SIGN BIT
RDR5:	MOV  (HP)+, R0		;GET REAL ADDRESS
	MOV  (SS)+,(R0)+
	MOV  (SS)+,(R0)+	;STORE REAL
ENDRDR:	RTS  MP
	.END
****
P11RDI.MAC           
	.TITLE	RDI
;*************************** RDI *******************************
	;READS AN INTEGER AND STORES IT AT THE ADDRESS IN (SS)
	;2(SS) FILE  ( LEFT ON STACK )
	ROUTINE   RDI   ENDRDI
RDIL0:	LINK   RDIL1-RDIL0
	MOV  (SS)+,-(HP)	;SAVE RESULT ADDRESS
RDIL1:	LINK RDIL2-RDIL0
	CALLSS   RDSIGN
	MOV  R1,-(HP)		;STORE SIGN
	CLR  -(SS)
	CLR-(SS)		;INITIATE LONG INTEGER ON STACK
RDIL2:	LINK   NOLINK
	CALLSS   UNSINT		;READ UNSIGNED INTEGER
	BVS   RDI0		;DIGITS READ IF V-BIT SET
	CALLSS  WRERROR
	.BYTE  40.,0		;NO DIGITS AFTER SIGN
RDI0:	TST  (R5)+		;TEST HIGH WORD OF LONG INT
	BEQ  RDI1
RDIL4:	CALLSS  WRERROR
	.BYTE  41.,0		;NUMBER TOO LARGE
RDI1:	TST  (R5)		;TEST  LOW WORD
	BMI  RDIL4		;NUMBER TOO LARGE
	TST  (HP)+		;SIGN FLAG
	BEQ  RDI3
	NEG  (SS)		;NEGATE INTEGER
RDI3:	MOV  (SS)+,@(HP)+	;STOREINTEGER
ENDRDI:	RTS  MP
	.END
****
P11RDHLP.MAC         
	.TITLE	RDHLP
;************************** RDSIGN *************************
	;READS A SIGNAND LEAVES IT IN R1
	;(SS) = FILE ID ( LEFT ON STACK )
	ROUTINE   RDSIGN ENDRDS
SKIPSPACES:
	MOV	@SS,R
	MOVB @(R), R0		;LOAD CHARACTER
	CMP  R0,#40		;BLANK?
	BNE  SKP1			;NO
	MOV  (SS),-(SS)		;DOUBLE FILE ID
	CALLSS  GET	;GET NEXT CHARACTER
	TST  EOLNSTATUS(R)
	BEQ  SKIPSPACES
	MOVB @(R),R0
SKP1:
	CLR  -(HP)		;SIGN FLAG
	CMP  R0,#'+		;PLUS?
	BEQ  RDS1		;YES
	CMP  R0,#'-		;MINUS?
	BNE  RDS2		;NO -->NO SIGN AT ALL
	DEC  (HP)			;SIGN FLAG -1
	MOV  (SS),-(SS)		;DOUBLE FILE ID
RDS1:
	CALLSS  GET
	MOVB @(R1),R0      	;LEAVE NEXT CHARACTER IN R0
RDS2:	MOV  (HP)+,R1		;SIGN FLAG
	RTS  MP
;*************************** DIGIT ***************************
	;CHECKS DIGITS AND LEAVES THEM AS INTEGERS IN R0
	ROUTINE   DIGIT   ENDDGT
	LINK   NOLINK
RANGE:	CMP  R0, #':
	BMI  RNG2		;MAYBE IN RANGE
RNG1:	SEV			;SET V-BIT 
	RTS  MP			;CHARACTER NOT DIGIT
RNG2:	CMP  R0, #'0
	BMI  RNG1		;NOT IN RANGE
	SUB  #'0,R0		;IN RANGE,  CLEAR V-BIT
ENDDGT:	RTS  MP
;**************************** UNSINT **************************
	;READS AN UNSIGNED INTEGER
	; 4(SS)   FILE ID
	;2(SS),(SS)   ROOM FOR LONG INTEGER ( INITIALIZED )
	DECCNT = %1
	ROUTINE   UNSINT   ENDUSI
USIL0:	LINK   USIL1-USIL0
	CLR  DECCNT		;COUNTS DECIMALS
USIL1:	LINK   USIL2-USIL0
	CALLSS   DIGIT
	BVC  USI2		;V-BIT CLEAR --> DIGIT READ
	CLV			;CLEAR V BIT: NO DIGIT READ
	RTS  MP			;VALUE 0, V-BIT CLEAR
USIL2:	LINK   NOLINK
	CALLSS   DIGIT		;TEST NEXT CHARACTER
	BVS  USI4		;NO DIGIT --> LEAVE
USI2:	ASL  2(R5)		;MULTIPLY LONG BY TEN
	ROL  (R5)
	BCS  MLT0		;OVERFLOW
	MOV  (R5),-(HP)
	MOV  2(R5),-(HP)
	ASL  2(R5)
	ROL  (R5)
	BCS  MLT0		;OVERFLOW
	ASL  2(R5)
	ROL  (R5)
	BCS  MLT0		;OVERFLOW
	ADD  (HP)+, 2(R5)
	ADC  (R5)
	BVS  MLT0		;ARITHMETIC OVERFLOW
	ADD  (HP)+,(R5)
	BVS  MLT0		;ARITHMETIC OVERFLOW
	ADD  R0, 2(R5)		;LAST DIGIT READ
	ADC  (R5)
	BVS  MLT0		;OVERFLOW: NUMBER MUST BE POSITIVE
	INC  DECCNT		;INCREMENT EXPONENT
	MOV  DECCNT,-(HP)
	MOV  4(SS),-(SS)	;FILE ID
	CALLSS  GET		; NEXT CHARACTER
	MOVB @(R), R0		;IN R0
	MOV  (HP)+,DECCNT
	BR  USIL2
MLT0:
	CALLSS  WRERROR	;OVERFLOW
	.BYTE  42.,0
USI4:
ENDUSI:	RTS  MP
	;THE LONG INTEGER IS NOW IN (R5), 2(R5),
	;V-BIT SET MEANS: DIGITS READ
	.END
****
P11REAL.MAC          
	.TITLE	P11RAR	REAL ARITHMETIC SUBROUTINES
;
;*****************************************
;**********			**********
;********** NO EXTRA HARDWARE	**********
;**********			**********
;*****************************************
;
;************************** SCALE ****************************
	;R0 CONTAINS SIGN FLAG:  R0 = 0 --> PLUS OR ZERO, R0 = -1 --> MINUS
	;RAW DECIMAL EXPONENT IN R2
	;AFTEREXECUTION:  R0 UNCHANGED, R2 = 0
	ROUTINE   SCALE   ENDSCL
SCLL0:	LINK   SCLL1-SCLL0
SCL0:	TST  R2			;ZERO?
	BEQ  SCL6		;YES, READY
	CMP  R2, #11.		;DECEXP >=10?
	BPL  SCL2
	DEC  R2
	ASL  R2
	ASL  R2
	MOV  R2, R1		;FIND POWER TABLE ENTRY 
	CLR  R2			;AND SAVE R2
	ADD  PC, R1		;BASE ADDRESS
BZX1:	ADD  #TENPOW+4-BZX1,R1	;TENPOWERS
	BR  SCL3
SCL2:	SUB  #10., R2		;DECREMENT DECEXP BY TEN
	MOV  PC, R1		;BASE ADDRESS
BZX2:	ADD  #TENPWO+4-BZX2, R1	;FLOATING E10
SCL3:	MOV  -(R1),-(SS)
	MOV  -(R1),-(SS)	;LOAD TENPOWERS
	MOV  R2,-(HP)		;STORE DECEXP
	MOV  R0,-(HP)		;STORE R0
	BPL  SCL4		;BRANCH IF PLUS --> DIVIDE
SCLL1:	LINK   SCLL2-SCLL0
	CALLSS   MULR		;MULTIPLY
	BR  SCL5
SCL4:
SCLL2:	LINK   NOLINK
	CALLSS   DIVR
SCL5:	MOV  (HP)+, R0
	MOV  (HP)+, R2		;RESTORE REGISTERS
	BR  SCL0		;TRY AGAIN
SCL6:	RTS  MP
TENPOW:	.FLT2 1E1
	.FLT2 1E2
	.FLT2 1E3
	.FLT2 1E4
	.FLT2 1E5
	.FLT2 1E6
	.FLT2 1E7
	.FLT2 1E8
	.FLT2 1E9
TENPWO:	.FLT2 1E10		;TABLE OF TENPOWERS
ENDSCL=.-2
;********************************** RND ***************************
	;ADDS 0.5 TO THE REALIN (SS), 2(SS) BEFORE TRUNCATION
	ROUTINE   RND   ENDRND
RNDL0:	LINK   RNDL1-RNDL0
	CLR  -(SS)
	MOV  #40000, -(SS)	;LOAD REAL VALUE 0.5
RNDL1:	LINK   RNDL2-RNDL0
	CALLSS   ADDR		;ADD
RNDL2:	LINK   NOLINK
	CALLSS   TRC		;TRUNCATE
ENDRND:	RTS  MP
;******************************* TRC ****************************
	;EXPECTS A REAL AT (SS), 2(SS).  LEAVES AN INTEGER AT (SS)
	;REGISTER USE:  R0, R1,  AND  R2
	ROUTINE   TRC   ENDTRC
TRCL0:	LINK   TRCL1-TRCL0
TRCL1:	LINK   NOLINK
	CALLSS   EXPTOP		;RETURNS R1=EXP, R0=SIGN
	CLR  R2			;CLEAR RESULT
	TST  R1	
	BLE  TRC2		;EXP <=0 --> RESULT = 0
	CMP  R1, #16.		;EXP TOO LARGE?
	BLT  TRC3		;NO
	CALLSS  WRERROR
	.BYTE  33.,1
	BR  TRC2
TRC3:	ASL  2(R5)		;SHIFT 
	ROL  (R5)
	ROL  R2			;COMPOSE INTEGER
	DEC  R1
	BGT  TRC3		;LOOP
	MOVB R2, (R5)		;MOVE SECOND BYTE
	SWAB  (R5)		;SWAP BYTES
	MOV  (R5), R2		;RESULT IN R2
	TST  R0
	BEQ  TRC2		;INTEGER > 0?
	NEG  R2
TRC2:	CMP (R5)+,(R5)+
	MOV  R2,-(SS)
ENDTRC:	RTS  MP
;************************** SQRR ******************************
	ROUTINE   SQRR   ENDSQR
SQRL0:	LINK  SQRL1-SQRL0
	MOV  2(SS),-(SS)	;COPY THE REAL ON TOP OF THE STACK
	MOV  2(SS),-(SS)	;
SQRL1:	LINK   NOLINK		;AND MULTIPLY
	CALLSS   MULR
ENDSQR:	RTS  MP
;******************************* ADDR *******************************
	;REALS ARE EXPECTED AT (R5),2(R5) AND 4(R5),6(R5)
	;SS INCREMENTED BY 4 AFTER RETURN
	;REGISTERS USED: R0, R1, R2, AND R5 (=SS)
	R0 = %0
	R1 = %1
	R2 = %2
	R5 = %5
	ROUTINE   ADDR   ENDADDR
	TST	@R5	; FIRST OPERAND = ZERO ?
	BNE	1$	; NO
	ADD	#4,R5	; YES, JUST SKIP IT
	BR	ENDADR
1$:	TST	4(R5)	; SECOND OPERAND = ZERO
	BNE	2$	; NO
	MOV	(R5)+,2(R5)	; RESULT = FIRST OPERAND
	MOV	(R5)+,2(R5)
	BR	ENDADR
2$:	CALLSS   EXPTOP
	CALLSS   EXPNTOP	;GET EXPONENTS AND SIGNS
				;IN R2,R3 AND R0
	CMP  R2,R1		;EXPONENTS EQUAL?
	BGT  ADR2
	BLT  ADR1
	CMP  4(R5),(R5)		;COMPARE FRACTIONS
	BMI  ADR1
	BGT  ADR2
	CMP  6(R5),2(R5)	;SECOND PART OF FRACTIONS
	BHIS  ADR2		;WE HAVE TO INTERCHANGE
ADR1:	MOV  (R5)+,-(HP)
	MOV  (R5)+,-(HP)
	MOV  2(R5),-(R5)
	MOV  2(R5),-(R5)
	MOV  (HP)+,6(R5)
	MOV  (HP)+, 4(R5)	;INTERCHANGE REALS
	MOV  R2,-(HP)
	MOV  R1,R2
	MOV  (HP)+,R1		;INTERCHANGE EXPONENTS
	SWAB  R0		;INTERCHANGE SIGN BYTES
ADR2:	CLR  -(HP)		;CLEAR FOR CARRY BITS
	SUB  R2, R1
	BEQ  ADR4		;NO SHIFTING
	NEG  R1			;SHIFT COUNTER
	CMP  R1, #26.		;BIG DIFFERENCE IN EXPONENTS?
	BPL  ADR6		;YES
ADR3:	ASR  (R5)
	ROR  2(R5)		;DIVIDE BY 2^(E(U)-E(V))
	ROR  (HP)		;STORE CARRY BIT
	DEC  R1
	BNE  ADR3		;LOOP
ADR4:	TST  R0			;BOTH SIGNS 'PLUS'?
	BEQ  ADR5
	CMP  R0, #401		;OR BOTH SIGNS 'MINUS'?
	BEQ  ADR5
	NEG  2(R5)		;WE HAVE TO DO SOMETHING
	ADC  (R5)
	NEG  (R5)
ADR5:	ADD  2(R5),6(R5)	;ADD FRACTIONS
	ADC  4(R5)		;TAKE CARE OF CARRY
	ADD  (R5),4(R5)
ADR6:	CMP  (R5)+,(R5)+
	MOV  (HP)+, R1		;RESTORE R1
ADRL3:	LINK   NOLINK
	CALLSS   NORM		;NORMALIZE ANDPACK IN (R5), 2(R5)
ENDADR:	RTS  MP
;******************************* MULR*****************************
	ROUTINE   MULR   ENDMPR
MPRL0:	LINK   MPRL1-MPRL0
	TST  4(R5)		;ZERO?
	BEQ  MPR1
	TST  (R5)		;SECOND OPERAND ZERO?
	BNE  MPR2
MPR1:	CMP  (R5)+,(R5)+	;REMOVE SECOND OPERAND
	CLR  (R5)
	CLR  2(R5)		;ZERO RESULT
	RTS  MP
MPR2:
MPRL1:	LINK   MPRL2-MPRL0
	CALLSS   EXPTOP
MPRL2:	LINK   MPRL3-MPRL0
	CALLSS   EXPNTOP	;GET EXPONENTS IN R2,R3
				;AND SIGNS IN R0
	ADD  R1, R2		;COMPUTE RAW EXPONENT
	ADD  #10, R2
	MOV  R0,-(HP)		;SAVESIGNS
	MOV  #24.,-(HP)		;SHIFT COUNT
	CLR  R0
	CLR  R1
MPR3:	ASL  R0			;R0 = LEAST SIGNIFICANT PART
	ROL  R1			;THEN COMES R1, 6(R5) AND 4(R5)
	ROL  6(R5)
	ROL  4(R5)		;DOUBLE PRECISION SHIFT
	BIT  #400,4(R5)		;MOST SIGNIFICANT BIT
	BEQ  MPR4
	ADD  2(R5), R0
	ADC  R1
	ADC  6(R5)
	ADC  4(R5)
	ADD  (R5), R1
	ADC  6(R5)
	ADC  4(R5)
MPR4:	DEC  (HP)
	BGT  MPR3		;GO AGAIN
	TST  (HP)+		;REMOVE COUNT
	CLRB  5(R5)		;
	MOV  (HP)+, R0		;RESTORE SIGNS
	CMP  (R5)+,(R5)+	;REMOVE SECOND OPERAND
MPRL3:	LINK   NOLINK
	CALLSS   SIGNS		;GET RESULT SIGN IN R0
ENDMPR:	RTS  MP
;***************************** SIGNS ******************************
	;REGISTER USE: R0 ONLY
	;R2, R0 ARE PASSED TO NORM
	ROUTINE   SIGNS   ENDSGN
SGNL0:	LINK   SGNL1-SGNL0
	TST  R0
	BEQ  SGN0		;BOTH 'PLUS'
	ASL  R0
	CMP  R0, #1002
	BEQ  SGN0		;BOTH 'MINUS'
	MOV  #1, R0
SGN0:
SGNL1:	LINK   NOLINK
	CALLSS   NORM		;NORMALIZE REAL
ENDSGN:	RTS  MP
;******************************** SUBR ****************************
	ROUTINE   SUBR   ENDSUBR
SBRL0:	LINK   SBRL1-SBRL0
	ADD  #100000,(SS)	;NEGATE REAL ON TOP
SBRL1:	LINK   NOLINK
	CALLSS   ADDR		;ADD REALS
ENDSBR:	RTS  MP
;*************************** DIVR *****************************
	ROUTINE   DIVR   ENDDIVR
DVRL0:	LINK   DVRL2-DVRL0
	TST  4(R5)
	BEQ  DVR1		;ZERO? --> NOTHING TO DO
	TST  (R5)		;DENOMINATOR ZERO?
	BNE  DVR2		;NO, GO ON
	CALLSS  WRERROR
	.BYTE  34.,1		;ZERO DIVISION
DVR1:	CMP  (R5)+,(R5)+	;REMOVE SECOND REAL
	CLR  2(R5)		;ZERO RESULT
	RTS  MP
DVR2:
DVRL2:	LINK   DVRL3-DVRL0
	CALLSS  EXPTOP
DVRL3:	LINK   DVRL4-DVRL0
	CALLSS   EXPNTOP	;GET EXPONENTS IN R2,R1
	MOV  R0,-(HP)		;SAVE SIGNS
	SUB  R1,R2
	MOV  4(R5),R1
	MOV  6(R5),R0		;COPY NUMERATOR
	CLR  4(R5)
	CLR  6(R5)		;INITIATE RESULT
	MOV  #24.,-(HP)		;COUNT FOR SHIFTS
DVR3:	CMP  R1,(R5)		;POSSIBLE TO SUBTRACT?
	BLO  DVR5		;NO
	BHI  DVR4		;YES
	CMP  R0,2(R5)		;CHECK LOW ORDER
	BLO  DVR5		;NOTHING TO DO
DVR4:	SUB  2(R5), R0		;SUBTRACTION
	SBC  R1
	SUB  (R5), R1
	INC  6(R5)		;UPDATE QUOTIENT
DVR5:	ASL  R0
	ROL  R1			;MULTIPLE SHIFT
	ASL  6(R5)		;SHIFT QUOTIENT
	ROL  4(R5)
	DEC  (HP)			;DECREMENT COUNT
	BGT  DVR3		;LOOP
	TST  (HP)+
	CMP  (R5)+,(R5)+	;REMOVE SECOND REAL
	MOV  (HP)+, R0		;RESTORE SIGN
	CLR  R1			;CLEAR CARRY REG.
DVRL4:	LINK   NOLINK
	CALLSS   SIGNS		;SIGN AND NORMALIZE
ENDDVR:	RTS  MP
;******************************* EXPTOP *****************************
	;EXPECTS A REAL AT (R5), 2(R5).
	;SIGN AND EXPONENT ARE TAKEN FROM THE REAL AND STORED
	;IN  R0  AND  R1.   REAL FRACTION IS LEFT AT  (R5), 2(R5)
	ROUTINE   EXPTOP   ENDXPT
	LINK   NOLINK
	CLR  R0			;CLEAR SIGNS
	MOV  (R5), R1
	ASL  R1
	ROR  R0			;SIGN OF SECOND REAL
	SWAB  R0
	ASL  R0
	CLRB R1
	SWAB  R1		;EXPONENT OF SECOND REAL
	SUB  #200, R1		;PURE EXPONENT
	CLRB 1(R5)
	BIS  #200, (R5)		;HIDDEN BIT
ENDXPT:	RTS  MP
;***************************** EXPNTOP ***************************
	;EXPECTS A REAL AT  4(R5), 6(R5)
	;SIGN AND EXPONENT ARE RETURNED IN  R0  AND  R2
	;REAL FRACTION LEFT AT4(R5), 6(R5)
	ROUTINE   EXPNTOP   ENDXPN
	LINK   NOLINK
	MOV  4(R5), R2
	ASL  R2
	ADC  R0			;SIGN OF DESTINATION
	CLRB  R2
	SWAB  R2		;EXPONENT
	SUB  #200, R2
	CLRB  5(R5)
	BIS  #200, 4(R5)	;HIDDEN BIT
ENDXPN:	RTS  MP
;********************************* FLT ****************************
	;REGISTERS USED: R0, R1, R2
	ROUTINE   FLT   ENDFLT
FLTL0:	LINK   FLTL1-FLTL0
	CLR R0			;INIT SIGN REGISTER
	MOV  (SS),-(SS)		;MOVE ONE PLACE
	BGT   FLT1		;TEST VALUE
	BEQ  ENDFLT
	NEG  (SS)		;NEGATE INTEGER
	INC  R0			;SIGN < 0
FLT1:	MOV  #10,R2		;EXPONENT
FLT2:	CLR  2(SS)		;CLEAR SECOND WORD
	CLR  R1			;NO CARRY BIT
FLTL1:	LINK   NOLINK
	CALLSS   NORM		;NORMALIZE REAL
ENDFLT:	RTS  MP
;******************************* FLO ***************************
	ROUTINE   FLO   ENDFLO
FLOL0:	LINK   FLOL1-FLOL0
	MOV  (SS)+,-(HP)
	MOV  (SS)+,-(HP)	;STORE REAL ON TOP
FLOL1:	LINK   NOLINK
	CALLSS   FLT		;FLOAT INTEGER ON TOP
	MOV  (HP)+,-(SS)
	MOV  (HP)+,-(SS)	;RESTORE REAL
ENDFLO:	RTS  MP
;*************************** NORM ******************************
	;(NOT NORMALIZED) REAL FRACTION EXPECTED AT  (R5), 2(R5)
	;BINARY EXPONENT IN R2,  SIGN IN R0. R1 CONTAINS CARRY BIT.
	;A NORMALIZED REAL IS LEFT IN  (R5), 2(R5)
	ROUTINE   NORM   ENDNRM
NRML0:	LINK   NOLINK
	ADD  #200, R2		;EXCESS 200
	TST  (R5)		;FRACTION ZERO?
	BNE  NRM1		;NO
	TST  2(R5)		;MAYBE
	BEQ  NRM7		;YES
NRM1:	CMP  (R5), #400		;FRACTION OVERFLOW?
	BPL  NRM3		;YES.
NRM2:	CMP  (R5), #200		;NORMALIZED?
	BPL  NRM4
	ASL  R1			;GET CARRY BIT
	ROL  2(R5)		;SCALE
	ROL  (R5)		;LEFT
	DEC  R2			;ADJUST EXPONENT
	BR  NRM2		;GO AGAIN
NRM3:	ASR  (R5)		;SCALE
	ROR  2(R5)		;RIGHT
	ROR  R1			;STORE CARRY BIT
	INC  R2
	BR  NRM1
NRM4:	ASL  R1
	BCC  NRM8
	ADC  2(R5)
	ADC  (R5)
	CLR  R1
	BR  NRM1		;RETURN FOR NEXT TRY
NRM8:	CMP  R2, #377		;EXPONENT OVERFLOW?
	BLE  NRM5		;NO
	CALLSS  WRERROR
	.BYTE  30.,2
	MOV  #-1,(R5)
	MOV  (R5),2(R5)		;BIGGEST ABSOLUTE VALUE
	ASR  R0
	ROR  (R5)		;SIGN
	RTS  MP
NRM5:	TST  R2			;EXPONENT UNDERFLOW?
	BPL  NRM6		;NO
	CALLSS  WRERROR
	.BYTE  31.,2
	CLR  (R5)
	CLR  2(R5)		;FLOATING ZERO
	RTS  MP
NRM6:	BICB  #200,(R5)		;REMOVE SIGNIFICANT BIT
	SWAB  R2
	ASR  R0			;SIGN
	ROR  R2			;RIGHT POSITION
	BIS  R2,(R5)		;PACK EXPONENT
NRM7:	
ENDNRM:	RTS  MP
	.END
****
P11WRI.MAC           
	.TITLE	WRI
;**************************** WRI *************************************
;   4(SS)  FILE
;    2(SS)  INTEGER
;     (SS)  FIELD LENGTH
;
	ROUTINE   WRI   ENDWRI
WRIL0:  LINK   WRIL1-WRIL0
	MOV  (SS)+,-(HP)	;MOVE FIELDLENGTH ONTOHARDWARE STACK
	MOV  #40,-(HP)		;MOVE BLANK (FOR POSITIVE VALUES)ONTO STACK
	MOV  (SS)+, R		;LOAD INTEGER VALUE INTO R
	BGE   WRI0		;JUMP IF POSITIVE OR ZERO
	MOV  #55,(HP)		;MOVE '-' ONTO STACK,OVERWRITING THE BLANK
	NEG  R			;INVERTSIGN
	BVC   WRI0		;JUMP IF NO CARRY OCCURRED (BY -32768)
	MOV  SS, AR
	MOV  AR,-(SS)		;LOAD RETURN VALUE OF SS
	TST  (HP)+		;REMOVE SIGN CHAR
	MOV  PC,AR		;ACTIONS IN ORDER TO WRITE -32768
	ADD  #14.,AR		;
	MOV  #6.,AD		;LENGTH IN AD
	MOV  2(SS),-(SS)	;FILE ID
	BR   WRI1		;
	.ASCII /-32768/
WRI0:	MOV  SS,-(HP)		;LOAD RETURN VALUE OF STACKPOINTER
	MOV  SS, AR		;STARTADDRESS OF INTEGER (STRING)
	SUB  #6, SS		;ROOM FOR STRING (6 BYTES)
WRI2:	MOV  AR,-(HP)		;STORE STRINGADDRESS
	MOV  R,-(SS)		;LOAD NUMERATOR
	MOV  #10.,-(SS)		;LOAD DENOMINATOR
WRIL1:	LINK   NOLINK
	CALLSS   DIVI		;DIVIDE
	MOV  (SS)+,AD		;QUOTIENT
	ADD  #60, R		;CONVERT REMAINDER TO CHAR
	MOV  (HP)+, AR		;RESTORE SS
	MOVB  R,-(AR)		;COMPOSE STRING
	MOV  AD, R		;
	BNE  WRI2
	MOV  (HP)+,AD		;RETURN VALUEFOR SS
	MOV  (HP)+,R		;SIGN
	MOVB  R,-(AR)		;
	MOV  AD,-(SS)		;RETURN VALUE OF SS
	MOV  (AD),-(SS)		;FILE ID
	SUB  AR, AD		;AD = STRINGLENGTH
WRI1:	MOV  AR,-(SS)		;LOAD STRINGADDRESS
	MOV  (HP)+,-(SS)	;FIELDLENGTH
	CMP  AD,(SS)
	BLE  WRI3
	MOV  AD,(SS)
WRI3:	MOV  AD,-(SS)		;LOAD STRINGLENGTH
	CALLSS  WRS		;WRITE THE STRING  (NUMBER)
	MOV  2(SS), SS		;REMOVE STRING
ENDWRI:	RTS  MP
	.END
****
P11MARKP.MAC         
	.TITLE	MARKP
;******************************* MARKP *****************************
	ROUTINE   MARKP   ENDMRK
	LINK   NOLINK
	MOV  MARKADDR(GP),@DAPADDR(GP)	;'HEAP' MARKPOINTER
	MOV  DAPADDR(GP),MARKADDR(GP)	;MARKPOINTER := DAP
	ADD  #2,DAPADDR(GP)		;DAP := DAP + 2
ENDMRK:	RTS  MP
;***************************** RELEASEP ****************************
	ROUTINE   RELEASEP   ENDRLS
	LINK   NOLINK
	MOV  MARKADDR(GP),DAPADDR(GP)	;DAP := MARKPOINTER
	MOV  @DAPADDR(GP),MARKADDR(GP)	;GET MARKPOINTER FROM HEAP
ENDRLS:	RTS  MP
	.END
****
P11PBOOL.MAC         
	.TITLE	PBOOL
;********************************** IXB *******************************
	ROUTINE   IXB   ENDIXB
	LINK   NOLINK
	MOV  (SS)+, AR		;AR = (CORRECTED) INDEXVALUE FOR PACKED
				;BOOLEAN ARRAY
	MOV  AR, R		;COPY
	ASR  R
	ASR  R
	ASR R			;R = INDEXVALUE DIV 8
	BIC  #177770, AR	;AR = INDEXVALUE MOD 8
	MOV  (SS)+, AD		;AD = ACTUAL ADDRESS OF PACKED B ARRAY
	ADD  R, AD		;AD = BYTE ADDRESS IN PACKED BOOLEAN ARRAY
	ADD  PC, AR		;SELECT MASK BYTE
	MOVB  6(AR), AR		;MASK BYTE IN AR
	RTS  MP
	.WORD  001001		;BYTE MASK TABLE
	.WORD  004004
	.WORD 020020
ENDIXB:	.WORD  100100
;********************************* STPB ******************************
	ROUTINE   STPB   ENDSTB
STBL0:	LINK   STBL1-STBL0	;LINK FOR CALL OF IXB
	MOV  (SS)+,-(HP)	;STORE BOOLEAN
STBL1:	LINK   NOLINK
	CALLSS   IXB
	TST  (HP)+		;TEST BOOLEAN VALUE
	BEQ  STB0		;ZERO --> CLEARBYTE
	BISB  AR,(AD)		;TRUE --> SET BYTE
	RTS  MP
STB0:	BICB  AR,(AD)		;SET BOOLEAN FALSE
ENDSTB:	RTS  MP
;******************************** LPB ******************************
	ROUTINE   LPB   ENDLPB
LPBL0:	LINK   LPBL1-LPBL0
LPBL1:	LINK   NOLINK
	CALLSS   IXB
	CLR  R			;BOOLEAN FALSE IN R
	BITB  AR,(AD)		;TEST BOOLEAN VALUE
	BEQ   LPB0		;EQUAL --> FALSE
	INC  R			;BOOLEAN FALSE --> TRUE
LPB0:	MOV  R,-(SS)		;LOAD BOOLEAN VALUE
ENDLPB:	RTS  MP
;******************************** CLRAREA ****************************
	ROUTINE  CLRAREA   ENDCLA
	LINK   NOLINK
	MOV  DAPADDR(GP), AD	;AD = DYNAMIC AREA POINTER (FORMER NP)
	MOV  (MP)+, R		;R = LENGTH  OF AREA TO BE CLEARED
CLA0:	CLR  (AD)+		;CLEAR WORD
	DEC  R			;DECREMENT WORD COUNT
	BGT   CLA0		;LOOP
ENDCLA:	RTS  MP
;****************************** CLRSTK ********************************
	ROUTINE   CLRSTK   ENDCLS
	LINK   NOLINK
	MOV  (MP)+, R		;R = LENGTH ARGUMENT
CLS0:	CLR  -(SS)		;CLEAR STACKSPACE
	DEC  R			;DECREMENT WORD COUNT
	BGT   CLS0		;LOOP
ENDCLS:	RTS  MP
	.END
****
P11REDSET.MAC        
	.TITLE	REDSET
;******************************* REDST ****************************
	ROUTINE   REDST   ENDRST
	LINK   NOLINK
	MOV  (SS)+,(SS)		;MOVE FIRST SET WORD THREE PLACES UP
	MOV  (SS)+,(SS)
	MOV  (SS)+,(SS)
ENDRST:	RTS  MP
;***************************** REDSN ********************************
	ROUTINE    REDSN   ENDRSN
	LINK   NOLINK
	MOV  (SS)+, 4(SS)	;SHIFT WORD OF SET
	MOV  (SS)+, 4(SS)
	TST  (SS)+		;REMOVE LAST WORD
ENDRSN:	RTS  MP
	.END
****
P11EXPSET.MAC        
	.TITLE	EXPSET
;*****************************EXPST *****************************
	ROUTINE   EXPST   ENDEST
	LINK   NOLINK
	MOV  (SS), AR		;TEMPORARY STORAGE OF ONE WORD SET
	CLR  (SS)		;CLEAR THREE TOP WORDS OF SET
	CLR  -(SS)
	CLR  -(SS)
	MOV  AR,-(SS)		;COMPLETE FOUR WORD SET WITH FIRST WORD
ENDEST:	RTS  MP
;***************************** EXPSN***************************
	ROUTINE   EXPSN  ENDESN
	LINK   NOLINK
	MOV SS, AR		;AR = ADDRESS OF SET ON TOP
	SUB  #6, SS		;(SS) IS SMALL SET IN THE STACK
	MOV  SS, AD		;AD = ADDRESS OF SMALL SET
	MOV  (AR)+,(AD)+	;SHIFT BOTH SETS THREE PLACES IN THE STACK
	MOV  (AR)+,(AD)+
	MOV  (AR)+,(AD)+
	MOV  (AR)+,(AD)+
	MOV  (AR),(AD)+
	CLR  (AR)		;CLEAR THREE TOP WORDS OF EXPANDED SET
	CLR  -(AR)
	CLR  -(AR)
ENDESN:	RTS  MP
	.END
****
P11UNI4.MAC          
	.TITLE	UNI4
;****************************** UNI4 ********************************
	ROUTINE   UNI4   ENDUNI
	LINK   NOLINK
	MOV  SS, AD		;CALCULATE SET ADDRESSES IN SS AND AD
	ADD  #8., AD		;
	BIS  (SS)+,(AD)+	;PERFORM 'OR' FUNCTION ON
	BIS  (SS)+,(AD)+	;CORRESSONDING WORDS OF THE SET
	BIS  (SS)+,(AD)+
	BIS  (SS)+,(AD)+
ENDUNI:	RTS  MP
	.END
****
P11INT4.MAC          
	.TITLE	INT4
;****************************** INT4 *******************************
	ROUTINE   INT4   ENDINT
	LINK   NOLINK
	MOV  SS, AD		;CALCULATE SET ADDRESSES IN SS AND AD
	ADD  #8., AD		;
	MOV  #4, R		;INITIALIZE WORD COUNT R
INT0:	COM  (SS)		;COMPLEMENT WORDS OF DESTINATION
	BIC  (SS)+,(AD)+	;BIT CLEAR
	DEC  R			;DECREMENT WORD COUNT
	BGT   INT0		;LOOP WHILE COUNT # 0
ENDINT:	RTS  MP
	.END
****
P11DIF4.MAC          
	.TITLE	DIF4
;****************************** DIF4 *********************************
	ROUTINE   DIF4   ENDDIF
	LINK   NOLINK
	MOV  SS, AD		;CALCULATE SET ADDRESSES IN SS AND AD
	ADD  #8., AD		;
	BIC  (SS)+,(AD)+	;SET DIFFERENCE
	BIC  (SS)+,(AD)+
	BIC  (SS)+,(AD)+
	BIC (SS)+,(AD)+
ENDDIF:	RTS  MP
	.END
****
P11INITS.MAC         
	.TITLE	INITS
;****************************** INITS ******************************
	ROUTINE   INITS   ENDITS
	LINK   NOLINK
	MOV  (SS), AR		;TEMPORARY STORAGE OF TOPELEMENT OF STACK
	CLR  (SS)		;CREATE AN EMPTY FOUR WORD SET
	CLR  -(SS)
	CLR  -(SS)
	CLR  -(SS)
	MOV  AR,-(SS)		;REPLACE TOPELEMENT ON THE STACK.
				;TOPELEMENT = SETELEMENT TO BE ADDED TO THE SET
ENDITS:	RTS  MP
	.END
****
P11SGSIN.MAC         
	.TITLE	SGSIN
;****************************** SGSIN ***************************
	ROUTINE   SGSIN   ENDSGS
	LINK   NOLINK
	MOV (SS)+, R		;ORDINAL NUMBER OF SETELEMENT IN R
	MOV  R, AR		;COPY R IN AR
	BIC  #177770, AR	;AR := AR MOD 8
	ASR  R
	ASR  R
	ASR  R			;R := R DIV 8
	ADD  SS, R		;R NOW CONTAINS BYTE ADDRESS (IN SET)
	ADD  PC, AR		;CALCULATE ADDRESS OF BYTE MASK IN AR
	BISB  6(AR),(R)		;SET BIT IN SET ON STACK
	RTS  MP
	.WORD  001001		;BYTE MASK TABLE
	.WORD  004004		;
	.WORD  020020
ENDSGS:	.WORD  100100
	.END
****
P11INN.MAC           
	.TITLE	INN
;**************************** INN **************************
	ROUTINE   INN   ENDINN
	LINK   NOLINK
	MOV  SS, AR
	ADD  (MP)+, AR		;AR = ADDRESS OF SETELEMENT
				;(MP) CONTAINS LENGTH OF SET
	MOV  AR, AD		;AD = DESTINATION ADDRESS OF BOOLEAN
	MOV  (AR), AR		;AR = SETLEMENT
	CLR  (AD)		;INITIALIZE BOOLEAN RESULT FALSE
	MOV  AR, R		;COPY AR INTO R
	BIC  #177770, AR	;AR BECOMES  AR MOD 8
	ASR  R			;
	ASR  R
	ASR  R			;R := R DIV 8
	ADD  SS, R		;R NOW CONTAINS ADDRESS OF BYTE IN SET
	ADD  PC, AR		;CALCULATE THE ADDRESS OF A MASK BYTE
	BITB  12.(AR),(R)	;TEST IF SETELEMENT IS PRESENT
	BEQ   INN0		;ZERO RESULT --> ELEMENT NOT IN SET
	INC  (AD)		;BOOLEAN TRUE
INN0:	MOV  AD, SS		;REMOVE SET FROM STACK
	RTS  MP
	.WORD  001001		;MASK TABLE
	.WORD  004004		;
	.WORD  020020		;
ENDINN:	.WORD  100100		;
	.END
****
P11MPI.MAC           
	.TITLE	MULI
;
;*****************************************
;**********			**********
;********** NO EXTRA HARDWARE	**********
;**********			**********
;*****************************************
;
;****************************** SQI *********************************
	ROUTINE   SQI   ENDSQI
SQIL0:	LINK   SQIL1-SQIL0
	MOV  (SS),-(SS)		;LOADSECOND ARG FOR MULI
SQIL1:	LINK   NOLINK
	CALLSS   MULI		;MULTIPLY
ENDSQI:	RTS  MP
;******************************* MULI ********************************
	ROUTINE   MULI   ENDMULI
MPIL0:	LINK   NOLINK
	CLR  AD			;HELPVARIABLE := 0
	MOV  (SS)+, R		;R = FIRST OPERAND
	MOV  (SS)+, AR		;AR = OPERAND
	BGE MPI0		;IF MULTIPLIER NONNEGATIVE
	NEG  AR			;NEGATE OPERAND
	NEG  R			;NEGATE SECOND OPERAND (WHICH IS EXPECTED IN R)
	BVC  MPI0		;NO OVERFLOW?
MPIL1:	CALLSS  WRERROR
	.BYTE  23.,1		;ERROR 23,RESTARTABLE
	BR  MPI1
MPI0:	BEQ   MPI1		;EQUAL ZERO? --> READY
MPI2:	BIT  #1, AR		;TEST FOR OPERAND EVEN
	BNE   MPI3		;ADDITION IF NOT ZERO
MPI4:	ASR  AR			;DIVIDE BY 2
	ASL  R			;MULTIPLY BY 2
	BR MPI2			;LOOP
MPI3:	ADD  R, AD		;COMPOSE RESULT
	DEC  AR
	BNE  MPI4		;LOOPIF NOT YET READY
MPI1:	MOV  AD,-(SS)		;RESULT ON THE STACK
ENDMPI:	RTS  MP
	.END
****
P11DVI.MAC           
	.TITLE	DIVI
;
;*****************************************
;**********			**********
;********** NO EXTRA HARDWARE	**********
;**********			**********
;*****************************************
;
;****************************** DIVI ********************************
	ROUTINE   DIVI   ENDDIVI
DVIL0:	LINK   NOLINK
	MOV  (SS)+, AD		;DENOMINATOR IN AD
	BNE   DVI0		;TEST FOR DENOMINATOR ZERO
	CLR  (SS)		;ZERO RESULT AFTER ATTEMP TO DIVIDE BY 0
DVIL1:	CALLSS  WRERROR	;PRINT ERROR MESSAGE
	.BYTE  20.		;ERROR 20
	.BYTE  1		;CLASS OF ERROR
	RTS  MP
DVI0:
	MOV  AD,-(HP)		;STACK DENOMINATOR FOR SIGN
	BPL   DVI2		;POSITIVE OPERANDS REQUIRED
	NEG  AD
	BVC  DVI2		;TEST FOR MOST NEGATIVE NUMBER
	CALLSS  WRERROR
	.BYTE 21.		;ERROR 21
	.BYTE 1			;NOT FATAL
DVI2:	MOV  (SS), -(HP)	;FOR SIGN
	BPL   DVI3		;INVERT SIGN IF NEGATIVE
	NEG  (SS)
DVI3:	MOV  #20, AR		;COUNT 16
	TSTB  1(SS)		;POSSIBLY FASTER?
	BNE  DVI4		;NO
	ASR  AR			;YES, 8 IS ENOUGH
	SWAB  (SS)
DVI4:	CLR  R			;CLEAR REMAINDER
DVI5:	ASL  (SS)		;SHIFT NUMERATOR
	ROL  R
	CMP  R, AD		;REMAINDER > DENOMINATOR?
	BMI  DVI9		;NO
	SUB  AD, R		;YES,SUBTRACT DENOM.
	INC  (SS)		;UPDATE QUOTIENT
DVI9:	DEC  AR
	BGT  DVI5
DVI6:
	TST  (HP)+		;REMOVE NUMERATOR FROM STACK
	BMI   DVI7		;SIGN TEST
	TST  (HP)+		;REMAINDER HAS THE RIGHT SIGN
				;DETERMINE QUOTIENT SIGN
	BPL  ENDDVI		;IF DEN < 0 THEN  QUOTIENTNEG
	NEG  (SS)
	RTS  MP
DVI7:	TST  (HP)+		;TEST DENOMINATOR SIGN
	BMI   DVI8		;IF DENOM. < 0 THEN QUOTIENT HAS RIGHT SIGN
	NEG  (SS)
DVI8:	NEG  R
ENDDVI:	RTS  MP
;***************************** MODI ******************************
	ROUTINE   MODI   ENDMOD
MODL0:	LINK   MODL1-MODL0
MODL1:	LINK   NOLINK
	CALLSS   DIVI
	MOV  R,(SS)		;LOAD THE REMAINDER
ENDMOD:	RTS   MP
	.END
****
P11LEQS1.MAC         
	.TITLE	LEQS1
;***************************** LEQS1 ******************************
	ROUTINE   LEQS1   ENDLS1
	LINK   NOLINK
	CLR  R			;BOOLEAN FALSE
	MOV  (SS)+, AR		;AR CONTAINS SET
	BIS  AR,(SS)		;FORM SET UNION
	CMP  (SS), AR		;COMPARE SETS FOR DIFFERENCES
	BNE   LS10		;NOT EQUAL -->FALSE
	INC  R			;FALSE --> TRUE
LS10:	MOV  R,(SS)		;LOAD BOOLEAN RESULT
ENDLS1:	RTS  MP
	.END
****
P11LEQS4.MAC         
	.TITLE	LEQS4
;******************************* LEQS4 ****************************
	ROUTINE   LEQS4   ENDLS4
	LINK   NOLINK
	MOV  SS, AR		;AR = ADDRESS OF SET OPERAND
	MOV SS, AD
	ADD  #8., AD		;ADDRESS OF SECOND SET
	CLR  -(SS)		;INITIALIZE BOOLEAN RESULT
	MOV  #4, R		;LENGTH IN WORDS
LS40:	BIS  (AR),(AD)		;SET UNION
	CMP  (AR)+,(AD)+	;EQUAL?
	BNE   LS41
	DEC  R			;DECREMENT WORD COUNT
	BGT   LS40		;LOOP
	INC  (SS)		;BOOLEAN TRUE
LS41:	MOV  (SS), 16.(SS)	;LOAD RESULT
	ADD  #16., SS		;REMOVE SETS
ENDLS4:	RTS  MP
	.END
****
P11LEQ.MAC           
	.TITLE	LEQ
;****************************** LEQ ********************************
	ROUTINE   LEQ   ENDLEQ
	LINK   NOLINK
	CLR  R
	CMP  (SS)+,(SS)
	BLT  LEQ0
	INC  R
LEQ0:	MOV  R, (SS)
ENDLEQ:	RTS  MP
	.END
****
P11LEQM.MAC          
	.TITLE	LEQM
;*************************** LEQM ***************************
	ROUTINE   LEQM   ENDLQM
LQML0:	LINK   LQML1-LQML0	;LINK FOR CALL OF LEQM2
	MOV  (SS)+, AR		;SOURCE ADDRESS IN AR
	MOV  (SS)+, AD		;DESTINATION ADDRESS IN AD
	MOV  (MP)+, R		;LENGTH IN BYTES IN R
LQML1:	LINK   NOLINK
	CALLSS   LEQM2
ENDLQM:	RTS  MP
	.END
****
P11LEQM2.MAC         
	.TITLE	LEQM2
;*************************** LEQM2 ***************************
	ROUTINE   LEQM2   ENDLQ2
	LINK   NOLINK		;NO CALLS FROM THIS ROUTINE
LQ20:	CMPB  (AD)+,(AR)+	;COMPARE BYTES IN SOURCE AND DEST
	BNE   LQ21		;TEST RELATION IF NOT EQUAL
	DEC  R			;DECREMENT BYTE COUNTER
	BGT  LQ20		;LOOP WHILE COUNT # 0
LQ22:	MOV  #1,-(SS)		;LOAD BOOLEAN TRUE
	RTS  MP
LQ21:	BLT   LQ22		;LESS: RESULT = TRUE
	CLR  -(SS)		;LOAD BOOLEAN FALSE
ENDLQ2:	RTS  MP
	.END
****
P11GEQ.MAC           
	.TITLE	GEQ
;***************************** GEQ ************************************
	ROUTINE   GEQ   ENDGEQ
	LINK   NOLINK
	CLR  R
	CMP  (SS)+,(SS)
	BGT   GEQ0
	INC  R
GEQ0:	MOV  R, (SS)
ENDGEQ:	RTS  MP
	.END
****
P11GEQM.MAC          
	.TITLE	GEQM
;**************************** GEQM ************************
	ROUTINE   GEQM   ENDGQM
GQML0:	LINK   GQML1-GQML0
	MOV  (SS)+, AR		;LOAD SOURCE ADDRESS IN AR
	MOV  (SS)+, AD		;LOAD DESTINATION ADDRESS IN AD
	MOV  (MP)+, R		;FETCH LENGTH ARGUMENT
GQML1:	LINK   NOLINK
	CALLSS   GEQM2
ENDGQM:	RTS  MP
	.END
****
P11GEQM2.MAC         
	.TITLE	GEQM2
;************************* GEQM2 *****************************
	ROUTINE   GEQM2   ENDGQ2
	LINK   NOLINK
GQ20:	CMPB  (AD)+,(AR)+	;COMPAREBYTES OF SOURCE AND DESTINATION
	BNE   GQ21		;TEST RELATION IF NOT EQUAL
	DEC R			;DECREMENT BYTE COUNTER
	BGT  GQ20		;LOOP WHILE COUNT # 0
GQ22:	MOV  #1,-(SS)		;LOAD BOOLEAN  TRUE
	RTS  MP
GQ21:	BGT  GQ22		;IF GREATER THEN RESULT =TRUE
	CLR  -(SS)		;LOAD BOOLEAN FALSE
ENDGQ2:	RTS  MP
	.END
****
P11LES.MAC           
	.TITLE	LES
;****************************** LES **********************************
	ROUTINE   LES   ENDLES
	LINK   NOLINK
	CLR  R
	CMP  (SS)+,(SS)
	BLE   LES0
	INC  R
LES0:	MOV  R, (SS)
ENDLES:	RTS  MP
	.END
****
P11LESM.MAC          
	.TITLE	LESM
;**************************** LESM *************************
	ROUTINE   LESM   ENDLSM
LSML0:	LINK   LSML1-LSML0
	MOV  (SS)+, AR		;LOAD SOURCE ADDRESS IN AR
	MOV  (SS)+, AD		;LOAD DESTINATION ADDRESS IN AD
	MOV  (MP)+,  R		;FETCH LENGTH ARGUMENT
LSML1:	LINK   NOLINK
	CALLSS   LESM2
ENDLSM:	RTS  MP
	.END
****
P11LESM2.MAC         
	.TITLE	LESM2
;**************************** LESM2 **************************
	ROUTINE   LESM2   ENDLS2
	LINK   NOLINK
LS20:	CMPB  (AD)+, (AR)+	;COMPARE SOURCE AND DESTINATION BYTES
	BNE   LS21
	DEC  R
	BGT  LS20		;LOOP WHILE COUNT# 0
LS22:	CLR  -(SS)		;BOOLEAN FALSE
	RTS  MP
LS21:	BGT   LS22		;FALSE RESULT IF GREATER
	MOV  #1,-(SS)		;BOOLEAN TRUE
ENDLS2:	RTS  MP
	.END
****
P11GRT.MAC           
	.TITLE	GRT
;****************************** GRT ***********************************
	ROUTINE   GRT   ENDGRT
	LINK   NOLINK
	CLR  R
	CMP  (SS)+,(SS)
	BGE   GRT0
	INC  R
GRT0:	MOV  R,(SS)
ENDGRT:	RTS  MP
	.END
****
P11GRTM.MAC          
	.TITLE	GRTM
;************************ GRTM ******************************
	ROUTINE   GRTM   ENDGRM
GRML0:	LINK   GRML1-GRML0
	MOV  (SS)+, AR		;LOAD SOURCE ADDRESS IN AR
	MOV  (SS)+, AD		;LOAD DESTINATION ADDRESS IN AD
	MOV  (MP)+, R		;FETCH LENGTH ARGUMENT
GRML1:	LINK  NOLINK
	CALLSS   GRTM2
ENDGRM:	RTS  MP
	.END
****
P11GRTM2.MAC         
	.TITLE	GRTM2
;************************* GRTM2 **************************
	ROUTINE   GRTM2   ENDGR2
	LINK   NOLINK
GR20:	CMPB  (AD)+,(AR)+	;COMPARE BYTES IN SOURCE AND DEST.
	BNE   GR21
	DEC  R			;DECREMENT COUNTER
	BGT  GR20		;LOOP WHILE COUNT # 0
GR22:	CLR  -(SS)
	RTS  MP
GR21:	BLT  GR22		;LOAD FALSEIF LESS THAN
	MOV  #1,-(SS)		;BOOLEAN TRUE
ENDGR2:	RTS  MP
	.END
****
P11NEQ.MAC           
	.TITLE	NEQ
;******************************** NEQ **********************************
	ROUTINE   NEQ   ENDNEQ
	LINK   NOLINK
	CLR  R			;BOOLEAN FALSE
	CMP  (SS)+,(SS)		;COMPARE ITEMS ON THE STACK
	BEQ   NEQ0		;EQUAL --> FALSE
	INC  R			;FALSE --> TRUE
NEQ0:	MOV  R,(SS)		;LOAD BOOLEAN RESULT
ENDNEQ:	RTS  MP
	.END
****
P11NEQM.MAC          
	.TITLE	NEQM
;***************************** NEQM ******************************
	ROUTINE  NEQM   ENDNQM
NQML0:	LINK   NQML1-NQML0	;LINK FOR CALL OF NEQM2
	MOV  (SS)+, AR		;SOURCE ADDRESS IN AR
	MOV  (SS)+, AD		;DESTINATION ADDRESS IN AD
	MOV  (MP)+, R		;LENGTH ARGUMENT IN R
NQML1:	LINK   NOLINK
	CALLSS   NEQM2
ENDNQM:	RTS  MP
	.END
****
P11NEQM2.MAC         
	.TITLE	NEQM2
;******************************** NEQM2 *****************************
	ROUTINE   NEQM2   ENDQM2
	LINK   NOLINK
QM20:	CMP  (AD)+,(AR)+	;COMPARE WORDS OF SOURCE AND DESTINATION
	BNE   QM21
	DEC  R			;DECREMENT WORD COUNT
	BGT  QM20		;LOOP WHILE COUNT# 0
	CLR  -(SS)		;LOAD BOOLEAN FALSE
	RTS  MP
QM21:	MOV  #1,-(SS)		;LOAD BOOLEAN TRUE
ENDQM2:	RTS  MP
	.END
****
P11EQU.MAC           
	.TITLE	EQU
;******************************* EQU **********************************
	ROUTINE  EQU   ENDEQU
	LINK   NOLINK
	CLR  R			;BOOLEAN FALSE
	CMP  (SS)+,(SS)		;COMPARE TWO ITEMS ON THE STACK
	BNE   EQU0		;NOT EQUAL --> FALSE
	INC  R			;FALSE --> TRUE
EQU0:	MOV  R, (SS)		;LOAD BOOLEAN RESULT
ENDEQU:	RTS  MP
	.END
****
P11EQUM.MAC          
	.TITLE	EQUM
;*************************** EQUM ***************************
	ROUTINE   EQUM   ENDEQM
EQML0:	LINK   EQML1-EQML0	;LINK FOR CALL OF EQUM2
	MOV  (SS)+,AR		;SOURCE ADDRESS IN AR
	MOV  (SS)+,AD		;DESTINATION ADDRESS IN AD
	MOV  (MP)+, R		;LENGTH (IN BYTES) IN R
EQML1:	LINK   NOLINK
	CALLSS   EQUM2
ENDEQM:	RTS  MP
	.END
****
P11EQUM2.MAC         
	.TITLE	EQUM2
;**************************** EQUM2 **************************
	ROUTINE   EQUM2   ENDEQ2
	LINK   NOLINK
EQ20:	CMP  (AD)+,(AR)+	;COMPARE WORDS OF SOURCE AND DESTINATION
	BNE   EQ21		;TEST COMPLETED IF NOTEQUAL
	DEC  R			;DECREMENT WORD COUNT
	BGT  EQ20		;LOOP WHILE COUNT # 0
	MOV #1,-(SS)		;LOAD BOOLEAN TRUE
	RTS  MP
EQ21:	CLR  -(SS)		;LOAD BOOLEAN FALSE
ENDEQ2:	RTS  MP
	.END
****
P11NEQS4.MAC         
	.TITLE	NEQS4
;******************************** NEQS4 ********************************
	ROUTINE NEQS4   ENDNQ4
NQ4L0:	LINK   NQ4L1-NQ4L0	;LINK FOR CALL OF NEQM
	MOV  SS, AR		;SOURCE ADDRESS IN AR
	MOV  SS, AD
	ADD  #8., AD		;DESTINATION ADDRESS IN AD
	MOV  #4, R		;LENGTH IN R
NQ4L1:	LINK   NOLINK
	CALLSS   NEQM2
	MOV  (SS), 16.(SS)	;LOAD BOOLEAN RESULT
	ADD  #16., SS		;REMOVE SETS
ENDNQ4:	RTS  MP
	.END
****
P11GEQS1.MAC         
	.TITLE	GEQS1
;******************************* GEQS1 *****************************
	ROUTINE   GEQS1   ENDGS1
	LINK  NOLINK
	CLR  R			;BOOLEAN FALSE
	MOV  (SS)+, AR		;AR CONTAINS SET
	BIS  (SS), AR		;SET UNION
	CMP  (SS), AR		;COMPARE
	BNE   GS10
	INC  R			;FALSE --> TRUE
GS10:	MOV  R,(SS)		;LOAD BOOLEAN 
ENDGS1:	RTS  MP
	.END
****
P11GEQS4.MAC         
	.TITLE	GEQS4
;******************************** GEQS4 ****************************
	ROUTINE   GEQS4   ENDGS4
	LINK   NOLINK
	MOV  SS, AR		;AR = ADDRESS OF SET
	MOV  SS, AD
	ADD  #8., AD		;ADDRESS OF SECOND SET
	CLR  -(SS)		;INITIALIZE BOOLEAN RESULT
	MOV  #4, R		;LENGTH IN WORDS
GS40:	BIS  (AD),(AR)		;SET UNION
	CMP  (AD)+,(AR)+	;COMPARE IF EQUAL
	BNE   GS41
	DEC  R			;DECREMENT WORD COUNT
	BGT   GS40		;LOOP
	INC  (SS)		;BOOLEAN TRUE
GS41:	MOV  (SS), 16.(SS)	;LOAD BOOLEAN RESULT
	ADD  #16.,SS		;REMOVE SETS
ENDGS4:	RTS MP
	.END
****
P11EQUS4.MAC         
	.TITLE	EQUS4
;****************************** EQUS4 ****************************
	ROUTINE   EQUS4   ENDQS4
QS4L0:	LINK   QS4L1-QS4L0	;LINK FOR CALL OF  EQUM2
	MOV  SS, AR		;SOURCE ADDRESS IN AR
	MOV  SS, AD
	ADD  #8., AD		;DESTINATION ADDRESS IN AD
	MOV  #4, R		;LENGTH IN R
QS4L1:	LINK   NOLINK
	CALLSS   EQUM2		;
	MOV  (SS), 16.(SS)	;LOAD BOOLEAN RESULT
	ADD  #16., SS		;REMOVE SETS
ENDQS4:	RTS  MP
	.END
****
P11TWPOW.MAC         
	.TITLE	TWPOW
;******************************* TWPOW ******************************
	ROUTINE   TWPOW   ENDTWP
	LINK   NOLINK
	MOV  (SS)+, R1		;LOAD PARAMETER (EXPONENT)
	ADD  #201, R1		;MAKE EXPONENT IN EXCESS128
	CLR  -(SS)
	CLR  -(SS)		;INITIATE RESULT ON STACK
	MOVB  R1, 1(SS)		;STORE EXPONENT
	ASR  (SS)		;CORRECT PLACE
	BIC #100000,(SS)	;SIGN BIT 0
ENDTWP:	RTS  MP
	.END
****
P11SPLTRL.MAC        
	.TITLE	SPLTRL
;******************************* SPLTRL *******************************
	ROUTINE   SPTRL   ENDSPR
	LINK   NOLINK
	MOV  (SS)+, R1		;ADDRESS OF RESULT PARAMETER
	MOV  (SS), R2		;LOW WORD OF (VALUE) REAL PARAMETER
	ASL  R2			;REMOVE SIGN
	SWAB  R2		;GET EXPONENT IN LOW BYTE OF R2
	BIC #177400, R2		;CLEAR HIGH BYTE OF R2
	SUB  #200, R2		;PURE EXPONENT
	MOV  R2, (R1)		;STORE EXPONENT
	BIC #77600, (SS)	;CLEAR EXPONENT PART OF REAL
	BIS #40000, (SS)	;ZERO EXPONENT  --> RESULT ON STACK
ENDSPR:	RTS  MP
	.END
****
P11REXP.MAC          
	.TITLE	REXP
;*************************** REXP *******************************
	;REXP EXPECTS A REAL  X ON TOP OF THE STACK AT (SS), 2(SS)
	;EXP(X) IS RETURNED IN (SS), 2(SS)
	;REGISTER USE:  ALL
	ROUTINE   REXP   ENDEXP
EXPL0:	LINK   EXPL1-EXPL0
	MOV  #125073,-(SS)
	MOV  #040270,-(SS)	;LOAD  LOG2(E)
EXPL1:	LINK   EXPL2-EXPL0
	CALLSS   MULR		;X * LOG2(E)
	MOV  2(SS),-(SS)
	MOV  2(SS),-(SS)	;COPY  X * LOG2(E)  ON THE STACK
EXPL2:	LINK   EXPL3-EXPL0
	CALLSS   TRC		;TRUNCATE:  INT(X * LOG2(E))  ON STACK
	MOV  (SS),-(HP)		;STORE INTEGER PART
EXPL3:	LINK   EXPL4-EXPL0
	CALLSS   FLT		;FLOAT INTEGER FOR SUBTRACTION
EXPL4:	LINK   EXPL5-EXPL0
	CALLSS   SUBR		;FRACTION(X * LOG2(E)) = 
				;X * LOG2(E) - INT(X* LOG2(E))
	MOV  #125073,-(SS)
	MOV  #040470,-(SS)	;LOAD  2*LOG2(E)
EXPL5:	LINK   EXPL6-EXPL0
	CALLSS   DIVR		;Y := FRACTION(X * LOG2(E))/(2 * LOG2(E))
	TST  (SS)		;EQUAL?
	BNE  EX0		;NO --> USUAL  CONTINUATION
	CLR  2(SS)	
	MOV  #040200,(SS)	;MAKE RESULT 1.0
	BR  EX1			;CONTINUE
EX0:	MOV  2(SS),-(SS)
	MOV  2(SS),-(SS)	;LOAD COPY OF Y IN ADVANCE
	MOV  #071571,-(SS)
	MOV  #042426,-(SS)	;LOAD A1 = 601.8042667 FOR LATER USE
	MOV  6(SS),-(SS)
	MOV  6(SS),-(SS)	;LOAD ANOTHER COPY OF Y
EXPL6:	LINK   EXPL7-EXPL0
	CALLSS   SQRR		;Y * Y  ON TOP OF STACK
	MOV  #056133,-(SS)	
	MOV  #041560,-(SS)	;LOAD B1 = 60.0901907
EXPL7:	LINK   EXPL8-EXPL0
	CALLSS   ADDR		;B1 + Y * Y
EXPL8:	LINK   EXPL9-EXPL0
	CALLSS   DIVR		;DIVIDE:  A1/(B1 + Y * Y)
	MOV  #036602,-(SS)
	MOV  #141100,-(SS)	;LOAD A0 = -12.01501675
EXPL9:	LINK   EXPL10-EXPL0
	CALLSS   ADDR		;A0 + A1/(B1 + Y * Y)
EXPL10:	LINK   EXPL11-EXPL0
	CALLSS   ADDR		;A0 + Y + A1/(B1 + Y * Y)
EXPL11:	LINK   EXPL12-EXPL0
	CALLSS   DIVR		;Y/(A0 + Y + A1/(B1 + Y * Y))
	CLR  -(SS)
	MOV  #140400,-(SS)	;LOAD  -2.0
EXPL12:	LINK   EXPL13-EXPL0
	CALLSS   MULR		;-2.0 * Y/(. . . 
	CLR  -(SS)
	MOV  #040200,-(SS)	;LOAD  1.0
EXPL13:	LINK   EXPL14-EXPL0
	CALLSS   ADDR		;1 - 2 * Y/( . . 
EXPL14:	LINK   NOLINK
	CALLSS   SQRR		;SQUARE(1 - 2 * Y/( . . .    )
EX1:	MOV  (HP)+,R0		;RESTOREINTEGER PART
	SWAB  R0
	CLRB  R0
	ASR  R0			;MAKE EXPONENT
	ADD  R0,(SS)		;ADD EXPONENT MODIFIER
	BMI  EX2		;OVERFLOW
	RTS  MP
EX2:
	CALLSS  WRERROR	;WRITE ERROR MESSAGE
	.BYTE  50.,2
	MOV  #-1,2(SS)
	MOV  #077777,(SS)	;BIGGEST POSSIBLE VALUE TAKEN
ENDEXP:	RTS  MP
	.END
****
P11RLOG.MAC          
	.TITLE	RLOG
;********************************* RLOG ************************************
	;RLOG EXPECTS A REAL AT (SS), 2(SS) AND RETURNS THE
	;LOGARITHMOF THIS VALUE IN THE SAME PLACE
	;REGISTER USE:  ALL
	ROUTINE   RLOG   ENDLOG
LOGL0:	LINK   LOGL2-LOGL0
	MOV  MP,-(HP)		;STORE MP
	MOV  PC, MP
LOGL$:	ADD  #LOGTAB+4-LOGL$,MP	;MP POINTS IN THE LOGTABLE
	MOV  (SS),-(SS)		;EXPONENT PART
	ROL  (SS)
	CLRB  (SS)
	SWAB  (SS)
	SUB  #200,(SS)		;BINARY EXPONENT
LOGL2:	LINK   LOGL3-LOGL0
	CALLSS   FLT		;FLOAT EXPONENT
	MOV  -(MP),-(SS)
	MOV -(MP),-(SS)	;LOAD  LN(2)
LOGL3:	LINK   LOGL4-LOGL0
	CALLSS   MULR		;AND MULTIPLY EXPONENT WITH LN(2)
	MOV  (SS)+,-(HP)
	MOV  (SS)+,-(HP)	;STORE   EXP * LN(2)
LDEXP:
	ASL  (SS)		;REMOVE SIGN
	ROL  -(HP)		;STORE SIGN BIT
	MOVB  #200, 1(SS)	;LOAD EXPONENT
	ASR  (HP)+		;GET SIGN
	ROR  (SS)		;INSERT SIGN
				;ZERO EXPONENT --> REAL BETWEEN .5 AND 1.0
	MOV  (SS),-(HP)
	MOV  2(SS),-(HP)	;STORE COPY OF X
	MOV  -(MP),-(SS)
	MOV  -(MP),-(SS)	;LOAD  1/2 * SQRT(2)
LOGL4:	LINK   LOGL5-LOGL0
	CALLSS   SUBR		;X - 1/2 * SQRT(2)
	MOV  (HP)+,-(SS)
	MOV  (HP)+,-(SS)	;LOAD X
	MOV  2(MP),-(SS)
	MOV  (MP),-(SS)		;LOAD 1/2 * SQRT(2)
LOGL5:	LINK   LOGL6-LOGL0
	CALLSS   ADDR		;X + 1/2 * SQRT(2)
LOGL6:	LINK  LOGL7-LOGL0
	CALLSS   DIVR		;W := (X - 1/2 * SQRT(2))/(X + 1/2 * SQRT(2))
	MOV  2(SS),-(SS)
	MOV  2(SS),-(SS)	;TEMPORARY STORE OF W
LOGL7:	LINK   LOGL8-LOGL0
	CALLSS   SQRR		;SQUARE   Y :=   W * W
	MOV  2(SS),-(SS)
	MOV  2(SS),-(SS)	;LOAD COPY OF Y
	MOV  2(SS),-(SS)
	MOV  2(SS),-(SS)	;AND A SECOND ONE
	MOV #3,-(HP)		;INITIALIZE COUNTER
	MOV  -(MP),-(SS)
	MOV  -(MP),-(SS)	;LOAD C1INITIATE R
LOGL8:	LINK   LOGL9-LOGL0
	CALLSS   MULR		;R := R * Y
	MOV  -(MP),-(SS)
	MOV  -(MP),-(SS)	;LOAD C2
LOGL9:	LINK   LOGL10-LOGL0
	CALLSS   ADDR		;R := R + LOGTAB[I]
	DEC  (HP)		;DECREMENT COUNTER
	BGT  LOGL8
	TST  (HP)+		;REMOVE COUNT
LOGL10:	LINK   LOGL11-LOGL0
	CALLSS   MULR		;R := R * W
	MOV  -(MP),-(SS)
	MOV  -(MP),-(SS)	;LOAD  -1/2 * LN(2)
LOGL11:	LINK   LOGL12-LOGL0
	CALLSS   ADDR		;R := R - 1/2 * LN(2)
	MOV  (HP)+,-(SS)
	MOV  (HP)+,-(SS)	;LOAD EXP * LN(2)
LOGL12:	LINK   NOLINK
	CALLSS   ADDR		;ADD SCALE FACTOR
	MOV  (HP)+,MP		;RESTORE  MP
	RTS  MP
	.FLT2 -.34657359	;-1/2 * LN(2)
	.FLT2 2.00000000	;2
	.FLT2  .66666667	;C[3]
	.FLT2  .39965910	;C[2]
	.FLT2  .30097451	;C[1]
	.FLT2  .70710678	;1/2 * SQRT(2)
LOGTAB:	.FLT2  .69314718	;LN(2)
ENDLOG= LOGTAB+2
	.END
****
P11RSQRT.MAC         
	.TITLE	RSQRT
;************************************* RSQRT **********************************
	ROUTINE   RSQRT   ENDSQT
SQTL0:	LINK   SQTL1-SQTL0
	TST  (SS)		;TEST IF EQUAL
	BEQ  ENDSQT		;EASY JOB
	BGT  SQ1		;ARGUMENT MUST BE >= 0
SQTL1:	LINK   SQTL2-SQTL0
	CALLSS   WRERROR
	.BYTE  51.,1		;POSSIBLE RETURN WITH ZERO RESULT
	CLR  2(SS)
	CLR  (SS)		;ZERO RESULT
	RTS  MP
SQ1:	MOV  2(SS),-(SS)
	MOV  2(SS),-(SS)	;LOAD COPY OF X
	ASR  (SS)
	ADD  #020100,(SS)	;INITIAL ESTIMATE  E
	MOV  #3,-(HP)		;SET ITERATION COUNT
SQ2:	MOV  6(SS),-(SS)
	MOV  6(SS),-(SS)	;LOAD COPY OF  X
	MOV  6(SS),-(SS)
	MOV  6(SS),-(SS)	;LOAD COPY OF  E
SQTL2:	LINK   SQTL3-SQTL0
	CALLSS   DIVR		;X/E
SQTL3:	LINK   SQTL4-SQTL0
	CALLSS   ADDR		;X/E + E
	CLR  -(SS)
	MOV  #040400,-(SS)	;LOAD  2.0
SQTL4:	LINK   NOLINK
	CALLSS   DIVR		;(X/E + E)/2
	DEC  (HP)		;DECREMENT ITERATION COUNT
	BGT  SQ2
	TST(HP)+		;DELETE COUNT
	MOV  (SS)+,2(SS)
	MOV  (SS)+,2(SS)	;REMOVE X AND LOAD RESULT
ENDSQT:	RTS  MP
	.END
****
P11SINCOS.MAC        
	.TITLE	SINCOS
;******************************** RSIN ******************************
	ROUTINE  RSIN   ENDSIN
SINL0:	LINK   SINL1-SINL0
	MOV  MP,-(HP)		;STORE MP
	MOV PC, MP		;INITIATE MP
SINT$:	ADD  #SINTAB+4-SINT$,MP	;MP USED AS TABLE POINTER
	CLR  -(HP)		;SIGN FLAG
	TST  (SS)		;SIGN OF ARGUMENT  X
	BPL  SIN1
	BIC  #100000,(SS)	;MAKE X PLUS
	DEC  (HP)		;SET SIGN FLAG
SIN1:	MOV  -(MP),-(SS)
	MOV  -(MP),-(SS)	;LOAD  PI/2
SINL1:	LINK   SINL2-SINL0
	CALLSS  DIVR		;X/(PI/2)
	CLR  -(SS)
	MOV  #37600,-(SS)	;LOAD  0.25
SINL2:	LINK   SINL3-SINL0
	CALLSS   MULR		;0.25 * X/(PI/2)  =X/2PI
	MOV  2(SS),-(SS)
	MOV  2(SS),-(SS)	;LOAD COPY OF X/2PI
SINL3:	LINK   SINL4-SINL0
	CALLSS   TRC		;TRUNCATE FOR FRACTION
SINL4:	LINK   SINL5-SINL0
	CALLSS   FLT		;FLOAT
SINL5:	LINK   SINL6-SINL0
	CALLSS   SUBR		;FRACTION(X/2PI)
	TST  (SS)		;ZERO?
	BEQ  SIN6		;YES, READY
	CLR -(SS)
	MOV  #40600,-(SS)	;LOAD 4.0
SINL6:	LINK   SINL7-SINL0
	CALLSS   MULR		;4.0 * FRACTION
	MOV  2(SS),-(SS)
	MOV  2(SS),-(SS)	;COPY 
SINL7:	LINK   SINL8-SINL0
	CALLSS   TRC		;TRUNCATE:  INT(4.0 * FRACTION)
	MOV (SS),-(HP)		;STORE
SINL8:	LINK   SINL9-SINL0
	CALLSS   FLT		;FLOAT
SINL9:	LINK   SINL10-SINL0
	CALLSS   SUBR		;FRACTION(4.0 * FRACTION(X/2PI))
	ROR  (HP)		;EVEN?
	BCC  SIN2		;YES
	ADD  #100000,(SS)	;NO, NEGF
	CLR  -(SS)
	MOV  #040200,-(SS)	;LOAD 1.0
SINL10:	LINK   SINL11-SINL0
	CALLSS   ADDR		;Y := 1 - Y
SIN2:	ROR  (HP)+		;TEST IF FIRST/SECOND QUADR, AND REMOVE
	BCC  SIN3		;YES, IN 1ST OR 2ND
	ADD  #100000,(SS)	;Y := -Y
SIN3:	MOV  2(SS),-(SS)
	MOV  2(SS),-(SS)	;COPY Y
SINL11:	LINK   SINL12-SINL0
	CALLSS   SQRR		;Y * Y
	MOV  #4,-(HP)		;INITIALIZE COUNT
	MOV  (SS)+,-(HP)
	MOV  (SS)+,-(HP)	;STORE COPY OF Y * Y
	MOV  -(MP),-(SS)
	MOV  -(MP),-(SS)	;LOAD  SINTAB[1]
SIN5:	MOV  (HP),-(SS)
	MOV  2(HP),-(SS)	;LOAD Y * Y
SINL12:	LINK   SINL13-SINL0
	CALLSS   MULR
	MOV  -(MP),-(SS)
	MOV  -(MP),-(SS)	;LOAD SINTAB[I]  AND INITIATE RES
SINL13:	LINK   SINL14-SINL0
	CALLSS   ADDR		;RES := RES * Z + SINTAB[I]
	DEC  4(HP)		;DECREMENT COUNT
	BGT  SIN5		;LOOP
	ADD  #6, HP		;REMOVE COUNT AND Y * Y COPY
SINL14:	LINK   NOLINK
	CALLSS   MULR		;RESULT := RES * X
SIN6:	TST  (HP)+		;TEST SIGN 
	BEQ  SIN4		;>=0
	ADD #100000,(SS)	;NEGATE SIGN
SIN4:	MOV  (HP)+, MP		;RESTORE MP
	RTS  MP
	.FLT2 1.57079632	;TABLE OF COEFFICIENTS
	.FLT2 -.64596371
	.FLT2  .07968968
	.FLT2 -.00467377
	.FLT2  .00015148
SINTAB:	.FLT2 1.57079632	;PI/2
ENDSIN = SINTAB+2
;********************************* RCOS ******************************
	ROUTINE   RCOS   ENDCOS
COSL0:	LINK   COSL1-COSL0
	MOV  #007733,-(SS)
	MOV  #040311,-(SS)	;LOAD PI/2
COSL1:	LINK   COSL2-COSL0
	CALLSS   ADDR		;X + 1/2PI
COSL2:	LINK   NOLINK
	CALLSS   RSIN		;SIN
ENDCOS:	RTS  MP
	.END
****
P11RUNCHK.MAC        
	.TITLE	RUNCHK
;******************************** SUBSTRCHECK ***********************
	ROUTINE   STRCH   SUBSTRCHECK
SBCL0:	LINK   NOLINK
	CMP  4(SS),6(SS)	;COMPARE UPPERBOUND AND LOWERBOUND
	BGE  SCK3		;CONTINUE IF  UB >= LB
	CMP  (SS)+,(SS)+	;ERROR: REMOVE LMAX AND LMIN
	BR  SCK2		;ERROR MESSAGE
SCK3:	CMP  (SS)+,2(SS)	;COMPARE LMAX TO ACTUAL UB
	BLT   SCK1		;UB > LMAX  --> ERROR
	CMP  (SS)+,2(SS)	;COMPARE LMIN TO ACTUAL LB
	BLE  ENDSBC		;LMIN <= LB  --> READY
	BR  SCK2
SCK1:	TST  (SS)+		;REMOVE LMIN
SCK2:	
	CALLSS  WRERROR
	.BYTE  60.,1
ENDSBC:	RTS  MP
;******************************* STRINGINDEX **********
	ROUTINE   STIND   STRINGINDEX
STIL0:	LINK   NOLINK
	CMP  2(SS),(SS)		;COMPARE INDEX TO SIZE
	BLE  STI1		;ERROR
	TST  (SS)		;TEST IF  >= 0
	BGE  STI2		;YES, READY
STI1:
	CALLSS  WRERROR
	.BYTE  61.,1
STI2:
ENDSTI:	RTS  MP
;*************************** OVFLCHK *****************************
	ROUTINE   OVFLCHK   ENDOFC
OFCL0:	LINK   NOLINK
	MOV  DAPADDR(GP), AR	;AR := DAP
	ADD  #80., AR		;KEEP FREE STORE OF 40 WORDS
	CMP  SS, AR		;SS > AR?
	BGT  OFC0		;YES, CONTINUE
	CALLSS  WRERROR
	.BYTE  10.,1
OFC0:	MOV  #STACKBEG, AR	;CHECK FOR HARDWARE STACKOVFL
	ADD  #10., AR		; 10 WORDS
	CMP  HP, AR
	BGT   ENDOFC
	CALLSS  WRERROR
	.BYTE  11.,1
ENDOFC:	RTS  MP
;******************************* SUBRCHK *******************************
	ROUTINE   SUBRCHK   ENDSCK
SCKL0:	LINK   NOLINK
	CMP  (SS), (MP)+	;LOWER BOUND
	BLT  SCKL2
	CMP  (SS), (MP)+	;UPPER BOUND
	BLE  SCK0
	MOV  @SS,-(SS)		; OFFENDING VALUE
	MOV  #1,-(SS)		; 1 PARAM ON STACK
SCKL1:	CALLSS WRERROR
	.BYTE  12.,201		; PARAMS ON STACK AND SERIOUS
SCK0:	RTS  MP
SCKL2:	TST  (MP)+		;REMOVE SECOND ARGUMENT
ENDSCK:	BR  SCKL1
	.END
****
P11MOVM.MAC          
	.TITLE	MOVM
;********************************* MOVM *******************************
	ROUTINE   MOVM   ENDMVM
	LINK   NOLINK
	MOV  (SS)+, AR		;LOAD SOURCE ADDRESS IN AR
	MOV  (SS)+, AD		;DESTINATION ADDRESS IN AD
	MOV  (MP)+, R		;LENGTH ARGUMENT IN R
MVM0:	MOV  (AR)+,(AD)+	;MOVE WORDS FROMSOURCE TO DEST.
	DEC  R			;DECREMENT WORD COUNT
	BGT  MVM0		;LOOP WHILE COUNT# 0
ENDMVM:	RTS  MP
;****************************** MOVM2 *****************************
	ROUTINE   MOVM2   ENDMM2
	LINK   NOLINK
	MOV  (MP)+, R		;LENGTH ARGUMENT IN R,
				;ADDRESSES ARE EXPECTED IN AR AND AD
MM20:	MOV  (AR)+,(AD)+	;MOVE WORDS FROM SOURCE TO DEST.
	DEC  R			;DECREMENT WORD COUNT
	BGT MM20		;LOOP
ENDMM2:	RTS  MP
;*********************************** MOVMR*****************************
	ROUTINE   MOVMR   ENDMMR
	LINK   NOLINK
	MOV  (MP)+, R		;LENGTH
MMR0:	MOV  -(AR),-(AD)	;MOVE MULTIPLE
	DEC  R			;DECREMENT COUNTER
	BGT  MMR0
ENDMMR:	RTS  MP
;
	.END
****
P11WROCT.MAC         
	.TITLE	WROCT
;
;
;
; WRITE(F,I:N:O)    (* WRITE OCTAL *)
;
;	4(SS) = FILE POINTER
;	2(SS) = INTEGER
;	 (SS) = FIELD LENGTH
;
	ROUTINE	WROCT
;
	MOV	4(SS),AD
	CMP	@SS,2(AD)	; SPACE ENOUGH IN CURRENT LINE ?
	BLE	2$		; YES
	MOV	AD,-(SS)	; NO. TAKE NEW LINE ( CR-LF )
	CALLSS	PUTLN
2$:	MOV	(SS)+,AR	; FIELDLEN
	MOV	(SS)+,-(HP)	; INTEGER
	MOV	AR,-(HP)
	SUB	#6,AR
	BLE	1$		; <= 6 OCTAL DIGITS WANTED
	SUB	AR,@HP		; 6 DIGITS AND
	MOV	AR,-(HP)	; SPACE COUNTER
3$:	MOV	#' ,-(SS)	; WRITE
	CALLSS	WRC		; PRECEDING SPACES
	DEC	@HP
	BGT	3$
	TST	(HP)+		; REMOVE COUNTER
1$:	MOV	#6,-(HP)	; COUNTER
	CLR	-(SS)		; PRESUMPTIVEDIGIT
	BR	20$		; 1ST DIGIT ONLY ONE SHIFT
10$:	ASL	4(HP)		; SHIFT 3 BITS TO (SS)
	ROL	(SS)
	ASL	4(HP)
	ROL	(SS)
20$:	ASL	4(HP)
	ROL	(SS)
	CMP	@HP,2(HP)	; THIS DIGIT WANTED ?
	BGT	40$		; NEVER PRINT UNWANTED DIGITS
	ADD	#60,@SS		;ASCII CHAR FOR DIGIT
	CALLSS	WRC		; PRINT DIGIT
	TST	-(SS)		; RESERV SPACE FOR NEXT DIGIT
40$:	CLR	(SS)
	DEC	@HP
	BGT	10$		; IF NOT READY
	TST	(SS)+
	ADD	#6,HP		; REMOVE TEMPS
	RETURN
;
	.END
****
P11GCML.MAC          
	.TITLE	GCML
;
	.MCALL	GMCR$,DIR$
;
CML:	GMCR$
;
;
;
; TYPE LINEBUFF = ARRAY [1..80] OF CHAR
;
; PROCEDURE GCML( LINE: LINEBUFF;  LEN: INTEGER ) ;
;
	LINE	=4
	LEN	=2
;
GCML::	DIR$	#CML
	MOV	$DSW,@LEN(SS)
	MOV	LINE(SS),AD
	TSTB	(AD)+		; LOW LIMIT = 1
	MOV	$DSW,R
	MOV	#CML+2,AR
1$:	MOVB	(AR)+,(AD)+
	DEC	R
	BGT	1$
	ADD	#LINE+2,SS
	RTS	PC
;
;
	.END
****
P11DATETM.MAC        
	.TITLE	DATETM
;
	.MCALL	GTIM$S
;
;
YEAR=	0
MONTH=	2
DAY=	4
HOUR=	6
MIN=	10
SEC=	12
TICK=	14
TICMAX=	16
;
DIV10:	MOV	#'0,R
1$:	SUB	#10.,AR
	BLT	2$
	INC	R
	BR	1$
2$:	ADD	#58.,AR		; CONVERT TO ASCII DIGIT
	MOVB	R,(AD)+		; TENS
	MOVB	AR,(AD)+	; UNITS
	RTS	PC
;
MUL60:	ASL	AD
	ASL	AD
	MOV	AD,R
	ASL	AD
	ASL	AD
	ASL	AD
	ASL	AD
	SUB	R,AD
	RTS	PC
;
GETTIM:	SUB	#20,SS
	GTIM$S	SS
	RTS	PC
;
;
;
	.MACRO	CNVRT	A,B
	MOV	A,AR
	JSR	PC,DIV10
.IIF NB <B>	MOVB	B,(AD)+
	.ENDM	CNVRT
;
;
;
	ROUTINE	TIME
	MOV	(SS)+,AD
	JSR	PC,GETTIM
	INC	AD
	CNVRT	HOUR(SS),#':
	CNVRT	MIN(SS),#':
	CNVRT	SEC(SS),#'.
	ASL	TICK(SS)
	MOV	TICK(SS),AR
	ASL	AR
	ASL	AR
	ADD	TICK(SS),AR	; MUL BY 10.
; NOW DIVIDE BY TICKMAX TO GET TENTH OF SECOND
	MOV	#'0,R
1$:	SUB	TICMAX(SS),AR
	BLT	2$
	INC	R
	BR	1$		; DIVIDE BY 100.
2$:	MOVB	R,(AD)+
	ADD	#20,SS
	RETURN
;
;
;
	ROUTINE	DATE
	MOV	(SS)+,AD
	JSR	PC,GETTIM
	INC	AD
	CNVRT	#19.
	CNVRT	YEAR(SS),#'-
	CNVRT	MONTH(SS),#'-
	CNVRT	DAY(SS)
	ADD	#20,SS
	RETURN
;
;
;
	ROUTINE	RUNTM
	JSR	PC,GETTIM
	MOV	HOUR(SS),AD
	BIC	#177770,AD		; 8 HOUR INTERVALS
	JSR	PC,MUL60
	ADD	MIN(SS),AD
	JSR	PC,MUL60
	ADD	SEC(SS),AD
	ADD	#20,SS
	MOV	AD,-(SS)
	RETURN
;
;
;
	.END
****
P11FSR.MAC           
	.TITLE	P11FSR
	.SBTTL	DATA DECLARATIONS
;
	.MCALL	FSRSZ$
;
	FSRSZ$	MAXFILES
;
	.END
****
P11DUMP.MAC          
	.TITLE	P11DMP
	.MCALL	SNPBK$,SNAP$
;
;
SNPBK$	SY,0,SC.HDR!SC.STK!SC.WRD!SC.BYT,31.
;
;
	ROUTINE	DUMP
	CLR	-(HP)
D:	SNAP$	,,,#$$HEAP-2,DAPADDR(GP),SS,#$STACK
	CALLSS	EXITP
;
TSKVEC::.WORD	D,D,D,D,D,D,D,D
;
	.END
****
P11WRBOOL.MAC        
	.TITLE	WRBOOL
;
	ROUTINE	WRB
	MOV	#6,-(SS)
	BR	WRB1
;
	ROUTINE	WRBFX
WRB1:	TST	2(SS)		; BOOLEAN
	BEQ	1$		; IF FALSE
	MOV	#TRU,2(SS)
	BR	2$
1$:	MOV	#FAL,2(SS)
2$:	MOV	#6,-(SS)	; STRING LENGTH
	CALLSS	WRS
	RETURN
;
TRU:	.ASCII	/TRUE  /
FAL:	.ASCII	/FALSE /
	.EVEN
;
	.END
****
P11ABSPAS.MAC        
	.TITLE	ABSPAS
;
	.MCALL	QIO$S,WTSE$S,FDOF$L
;
	FDOF$L
;
; procedure setwd( addr,newcont: integer );
;
SETWD::	MOV	2(SS),@4(SS)
	ADD	#6,SS
	RTS	PC
;
; function getwdi(addr: integer ): integer;
; function getwds( addr: integer ): set of 1..16;
;
GETWDI::
GETWDS:: MOV	@2(SS),4(SS)
	ADD	#4,SS
	RTS	PC
;
; procedure setbyte( addr,newcont: integer );
;
SETBYT:: MOVB	2(SS),@4(SS)
	ADD	#6,SS
	RTS	PC
;
; function getbyte( addr: integer): integer;
;
GETBYT:: MOVB	@2(SS),4(SS)
	ADD	#4,SS
	RTS	PC
;
;
; PROCEDURE ATTACH( VAR F: FILE);
; PROCEDURE DETACH( VAR F: FILE );
;
ATTACH:: MOV	#IO.ATT,AR
	BR	ATT2
DETACH:: MOV	#IO.DET,AR
ATT2:	MOV	2(SS),R	; FILE POINTER
	BIT	#TTY,FILTYP(R)
	BEQ	1$
	MOV	#TILUN,AD
	BR	2$
1$:	MOVB	F.LUN+FILESI(R),AD
2$:	QIO$S	AR,AD,AD,,SS
	WTSE$S	AD
	MOVB	@SS,AD
	MOV	AD,IORESULT(R)
	CMP	(SS)+,(SS)+	; SKIP PARAMETERS
	RTS	PC
;
;
	.END
****
P11RANDOM.MAC        
	.TITLE	P11RANDOM
;
	.MCALL	QIO$S,WTSE$S,FDOF$L
;
	FDOF$L		; DEFINE FDB OFFSETS
;
	.SBTTL	GETR, PUTR
;
; PUTR(F,RNR)
;
; GETR(F,RNR)
;
;	2(SS) = POINTER TO FILE POINTER
;	 (SS) = RECORD NUMBER
;
	ROUTINE	PUTRM
	CLR	AD		; ZERO
	BR	PUTR1
;
	ROUTINE	GETRM
	MOV	GP,AD		; <> ZERO
;
PUTR1:	FINDFILE	2(SS),#6
	BIT	#BLKMODE,FILTYP(R)
	BNE	10$		; IF BLOCK MODE
	MOV	(SS)+,F.RCNM+2(AR)
	CLR	F.RCNM(AR)	; HIGH PART OF RNR = 0
	TST	(SS)+		; SKIP FILE POINTER
	TST	AD		; GETR OR PUTR
	BEQ	1$		; IF PUTR
	JMP	$GET1		; IF GETR
1$:	JMP	$PUT2
;
;
;
10$:	MOV	#IO.RVB,-(SS)
	TST	AD
	BNE	20$
	MOV	#IO.WVB,@SS
20$:	MOVB	F.LUN(AR),AD
	CMP	-(SS),-(SS)	; RESERV AREAFOR IOSB
	QIO$S	4(SS),AD,AD,,SS,,<@R,F.URBD(AR),,#0,6(SS)>
	WTSE$S	AD
	MOVB	@SS,AD
	MOV	AD,IORESULT(R)
	ADD	#10.,SS		; REMOVE ALL PARAMETERS
	RETURN
;
;
	.END
****
P11EISMPI.MAC        
	.TITLE	MULI
;
;**********************************************
;**********			     **********
;**********	     E  I  S	     **********
;**********			     **********
;********** EXTENDED INSTRUCTION SET **********
;**********			     **********
;**********************************************
;
;****************************** SQI *********************************
	ROUTINE   SQI   ENDSQI
	MOV  (SS),R		;LOAD SECOND ARG FOR MULI
	MUL  (SS),R
	MOV  R,(SS)
ENDSQI:	RTS  MP
;******************************* MULI ********************************
	ROUTINE   MULI   ENDMULI
	MOV  (SS)+, R		;R = FIRST OPERAND
	MUL  (SS)+,R
MPI1:	MOV  R,-(SS)		;RESULT ON THE STACK
ENDMPI:	RTS  MP
	.END
****
P11EISDVI.MAC        
	.TITLE	DIVI
;
;**********************************************
;**********			     **********
;**********	     E  I  S	     **********
;**********			     **********
;********** EXTENDED INSTRUCTION SET **********
;**********			     **********
;**********************************************
;
;****************************** DIVI ********************************
	ROUTINE   DIVI   ENDDIVI
	CLR  AR
	MOV  2(SS),R
	DIV  (SS)+,AR
	MOV  AR,(SS)		;QUOTIENT
ENDDVI:	RTS  MP
;***************************** MODI ******************************
	ROUTINE   MODI   ENDMOD
	CALLSS   DIVI
	MOV  R,(SS)		;LOAD THE REMAINDER
ENDMOD:	RTS   MP
	.END
****
P11FIS.MAC           
	.TITLE	P11RAR	REAL ARITHMETIC SUBROUTINES
;
;**********************************************
;**********			     **********
;**********	     F  I  S	     **********
;**********			     **********
;********** FLOATING INSTRUCTION SET **********
;**********			     **********
;**********************************************
;
;	FOR PDP-11'S WITH FIS,FLOATING INSTRUCTION SET
;************************** SCALE ****************************
	;R0 CONTAINS SIGN FLAG:  R0 = 0 --> PLUS OR ZERO, R0 = -1 --> MINUS
	;RAW DECIMAL EXPONENT IN R2
	;AFTER EXECUTION:  R0 UNCHANGED, R2 = 0
	ROUTINE   SCALE   ENDSCL
SCLL0:	LINK   SCLL1-SCLL0
SCL0:	TST  R2			;ZERO?
	BEQ  SCL6		;YES, READY
	CMP  R2, #11.		;DECEXP >=10?
	BPL  SCL2
	DEC  R2
	ASL  R2
	ASL  R2
	MOV  R2, R1		;FIND POWER TABLE ENTRY 
	CLR  R2			;AND SAVE R2
	ADD  PC, R1		;BASE ADDRESS
BZX1:	ADD  #TENPOW+4-BZX1, R1	;TENPOWERS
	BR  SCL3
SCL2:	SUB  #10., R2		;DECREMENT DECEXP BY TEN
	MOV  PC, R1		;BASE ADDRESS
BZX2:	ADD  #TENPWO+4-BZX2, R1	;FLOATING E10
SCL3:	MOV  -(R1),-(SS)
	MOV  -(R1),-(SS)	;LOAD TENPOWERS
	MOV  R2,-(HP)		;STORE DECEXP
	MOV  R0,-(HP)		;STORE R0
	BPL  SCL4		;BRANCH IF PLUS --> DIVIDE
SCLL1:	LINK   SCLL2-SCLL0
	CALLSS   MULR		;MULTIPLY
	BR  SCL5
SCL4:
SCLL2:	LINK   NOLINK
	CALLSS   DIVR
SCL5:	MOV  (HP)+, R0
	MOV  (HP)+, R2		;RESTORE REGISTERS
	BR  SCL0		;TRY AGAIN
SCL6:	RTS  MP
TENPOW:	.FLT2 1E1
	.FLT2 1E2
	.FLT2 1E3
	.FLT2 1E4
	.FLT2 1E5
	.FLT2 1E6
	.FLT2 1E7
	.FLT2 1E8
	.FLT2 1E9
TENPWO:	.FLT2 1E10		;TABLE OF TENPOWERS
ENDSCL=.-2
;********************************** RND ***************************
	;ADDS 0.5 TO THE REAL IN (SS), 2(SS) BEFORE TRUNCATION
	ROUTINE   RND   ENDRND
RNDL0:	LINK   RNDL1-RNDL0
	CLR  -(SS)
	MOV  #40000, -(SS)	;LOAD REAL VALUE 0.5
RNDL1:	LINK   RNDL2-RNDL0
	CALLSS   ADDR		;ADD
RNDL2:	LINK   NOLINK
	CALLSS   TRC		;TRUNCATE
ENDRND:	RTS  MP
;******************************* TRC ****************************
	;EXPECTS A REAL AT (SS), 2(SS).  LEAVES AN INTEGER AT (SS)
	;REGISTER USE:  R0, R1,  AND  R2
	ROUTINE TRC   ENDTRC
TRCL0:	LINK   TRCL1-TRCL0
TRCL1:	LINK   NOLINK
	CALLSS   EXPTOP		;RETURNS R1=EXP, R0=SIGN
	CLR  R2			;CLEAR RESULT
	TST  R1	
	BLE  TRC2		;EXP <=0 --> RESULT = 0
	CMP  R1, #16.		;EXP TOO LARGE?
	BLT  TRC3		;NO
	CALLSS WRERROR
	.BYTE  33.,1
	BR  TRC2
TRC3:	ASL  2(R5)		;SHIFT 
	ROL  (R5)
	ROL R2			;COMPOSE INTEGER
	DEC  R1
	BGT  TRC3		;LOOP
	MOVB R2, (R5)		;MOVE SECOND BYTE
	SWAB  (R5)		;SWAP BYTES
	MOV  (R5), R2		;RESULT IN R2
	TST  R0
	BEQ TRC2		;INTEGER > 0?
	NEG  R2
TRC2:	CMP  (R5)+,(R5)+
	MOV  R2,-(SS)
ENDTRC:	RTS  MP
;************************** SQRR ******************************
	ROUTINE   SQRR   ENDSQR
SQRL0:	LINK   SQRL1-SQRL0
	MOV  2(SS),-(SS)	;COPY THE REAL ON TOP OF THE STACK
	MOV  2(SS),-(SS)	;
SQRL1:	LINK   NOLINK		;AND MULTIPLY
	CALLSS   MULR
ENDSQR:	RTS  MP
;******************************* ADDR *******************************
	;REALS ARE EXPECTED AT (R5),2(R5) AND 4(R5),6(R5)
	;SS INCREMENTED BY 4 AFTER RETURN
	;REGISTERS USED: R0, R1, R2, AND R5 (=SS)
	R0 = %0
	R1 = %1
	R2 = %2
	R5 = %5
	ROUTINE   ADDR   ENDADDR
	FADD	R5
ENDADR:	RTS  MP
;******************************* MULR *****************************
	ROUTINE   MULR   ENDMPR
	FMUL	R5
ENDMPR:	RTS  MP
;***************************** SIGNS ******************************
	;REGISTER USE: R0 ONLY
	;R2, R0 ARE PASSED TO NORM
	ROUTINE   SIGNS   ENDSGN
SGNL0:	LINK   SGNL1-SGNL0
	TST  R0
	BEQ  SGN0		;BOTH 'PLUS'
	ASL  R0
	CMP  R0, #1002
	BEQ  SGN0		;BOTH 'MINUS'
	MOV  #1, R0
SGN0:
SGNL1:	LINK   NOLINK
	CALLSS   NORM		;NORMALIZE REAL
ENDSGN:	RTS  MP
;******************************** SUBR ****************************
	ROUTINE   SUBR   ENDSUBR
	FSUB	R5
ENDSBR:	RTS  MP
;*************************** DIVR *****************************
	ROUTINE   DIVR   ENDDIVR
DVRL0:	LINK   DVRL2-DVRL0
	TST  4(R5)
	BEQ  DVR1		;ZERO? --> NOTHING TO DO
	TST  (R5)		;DENOMINATOR ZERO?
	BNE  DVR2		;NO, GO ON
	CALLSS  WRERROR
	.BYTE  34.,1		;ZERO DIVISION
DVR1:	CMP  (R5)+,(R5)+	;REMOVE SECOND REAL
	CLR  2(R5)		;ZERO RESULT
	RTS  MP
DVR2:
	FDIV	R5
ENDDVR:	RTS  MP
;********************************* FLT ****************************
	;REGISTERS USED: R0, R1, R2
	ROUTINE   FLT   ENDFLT
FLTL0:	LINK   FLTL1-FLTL0
	CLR  R0			;INIT SIGN REGISTER
	MOV  (SS),-(SS)		;MOVE ONE PLACE
	BGT   FLT1		;TEST VALUE
	BEQ  ENDFLT
	NEG  (SS)		;NEGATE INTEGER
	INC  R0			;SIGN < 0
FLT1:	MOV  #10,R2		;EXPONENT
FLT2:	CLR  2(SS)		;CLEAR SECOND WORD
	CLR  R1			;NO CARRY BIT
FLTL1:	LINK   NOLINK
	CALLSS   NORM		;NORMALIZE REAL
ENDFLT:	RTS  MP
;******************************* FLO ***************************
	ROUTINE   FLO   ENDFLO
FLOL0:	LINK   FLOL1-FLOL0
	MOV  (SS)+,-(HP)
	MOV  (SS)+,-(HP)	;STORE REAL ON TOP
FLOL1:	LINK   NOLINK
	CALLSS   FLT		;FLOAT INTEGER ON TOP
	MOV  (HP)+,-(SS)
	MOV  (HP)+,-(SS)	;RESTORE REAL
ENDFLO:	RTS  MP
;*************************** NORM ******************************
	;(NOT NORMALIZED) REAL FRACTION EXPECTED AT  (R5), 2(R5)
	;BINARY EXPONENT IN R2,  SIGN IN R0.  R1 CONTAINS CARRY BIT.
	;A NORMALIZED REAL IS LEFT IN  (R5), 2(R5)
	ROUTINE   NORM   ENDNRM
NRML0:	LINK   NOLINK
	ADD  #200, R2		;EXCESS 200
	TST  (R5)		;FRACTION ZERO?
	BNE  NRM1		;NO
	TST  2(R5)		;MAYBE
	BEQ  NRM7		;YES
NRM1:	CMP  (R5), #400		;FRACTION OVERFLOW?
	BPL  NRM3		;YES.
NRM2:	CMP  (R5), #200		;NORMALIZED?
	BPL  NRM4
	ASL  R1			;GET CARRY BIT
	ROL 2(R5)		;SCALE
	ROL  (R5)		;LEFT
	DEC  R2			;ADJUST EXPONENT
	BR  NRM2		;GO AGAIN
NRM3:	ASR  (R5)		;SCALE
	ROR  2(R5)		;RIGHT
	ROR  R1			;STORE CARRY BIT
	INC  R2
	BR  NRM1
NRM4:	ASL  R1
	BCC  NRM8
	ADC  2(R5)
	ADC  (R5)
	CLR  R1
	BR  NRM1		;RETURN FOR NEXT TRY
NRM8:	CMP  R2, #377		;EXPONENT OVERFLOW?
	BLE  NRM5		;NO
	CALLSS  WRERROR
	.BYTE  30.,2
	MOV  #-1,(R5)
	MOV  (R5),2(R5)		;BIGGEST ABSOLUTE VALUE
	ASR  R0
	ROR  (R5)		;SIGN
	RTS  MP
NRM5:	TST  R2			;EXPONENT UNDERFLOW?
	BPL  NRM6		;NO
	CALLSS  WRERROR
	.BYTE  31.,2
	CLR (R5)
	CLR  2(R5)		;FLOATING ZERO
	RTS  MP
NRM6:	BICB  #200,(R5)		;REMOVE SIGNIFICANT BIT
	SWAB  R2
	ASR  R0			;SIGN
	ROR  R2			;RIGHT POSITION
	BIS  R2,(R5)		;PACK EXPONENT
NRM7:	
ENDNRM:	RTS  MP
	.END
****
P11FPP.MAC           
	.TITLE	P11RAR	REAL ARITHMETIC SUBROUTINES
;
;**********************************************
;**********			     **********
;**********	     F  P P	     **********
;**********			     **********
;********** FLOATING POINT PROCESSOR **********
;**********			     **********
;**********************************************
;
AC0=%0
AC1=%1
AC2=%2
AC3=%3
AC4=%4
AC5=%5
;
;	FORPDP-11'S WITH FPP, FLOATING POINT PROCESSOR
;************************** SCALE ****************************
	;R0 CONTAINS SIGN FLAG:  R0 = 0 --> PLUS OR ZERO, R0 = -1 --> MINUS
	;RAW DECIMAL EXPONENT IN R2
	;AFTER EXECUTION:  R0 UNCHANGED, R2 = 0
	ROUTINE   SCALE   ENDSCL
SCLL0:	LINK   SCLL1-SCLL0
SCL0:	TST  R2			;ZERO?
	BEQ  SCL6		;YES, READY
	CMP  R2, #11.		;DECEXP >=10?
	BPL  SCL2
	DEC  R2
	ASL  R2
	ASL  R2
	MOV  R2, R1		;FIND POWER TABLE ENTRY 
	CLR  R2			;AND SAVE R2
	ADD  PC, R1		;BASE ADDRESS
BZX1:	ADD  #TENPOW+4-BZX1, R1	;TENPOWERS
	BR  SCL3
SCL2:	SUB  #10., R2		;DECREMENT DECEXP BY TEN
	MOV  PC, R1		;BASE ADDRESS
BZX2:	ADD  #TENPWO+4-BZX2, R1	;FLOATING E10
SCL3:	MOV  -(R1),-(SS)
	MOV  -(R1),-(SS)	;LOAD TENPOWERS
	MOV  R2,-(HP)		;STORE DECEXP
	MOV  R0,-(HP)		;STORE R0
	BPL  SCL4		;BRANCH IF PLUS --> DIVIDE
SCLL1:	LINK   SCLL2-SCLL0
	CALLSS   MULR		;MULTIPLY
	BR  SCL5
SCL4:
SCLL2:	LINK   NOLINK
	CALLSS  DIVR
SCL5:	MOV  (HP)+, R0
	MOV  (HP)+, R2		;RESTORE REGISTERS
	BR  SCL0		;TRY AGAIN
SCL6:	RTS  MP
TENPOW:	.FLT2 1E1
	.FLT2 1E2
	.FLT2 1E3
	.FLT2 1E4
	.FLT2 1E5
	.FLT2 1E6
	.FLT2 1E7
	.FLT2 1E8
	.FLT2 1E9
TENPWO:	.FLT2 1E10		;TABLE OF TENPOWERS
ENDSCL=.-2
;********************************** RND ***************************
	;ADDS 0.5 TO THE REAL IN (SS), 2(SS) BEFORE TRUNCATION
	ROUTINE   RND   ENDRND
RNDL0:	LINK   RNDL1-RNDL0
	CLR  -(SS)
	MOV  #40000, -(SS)	;LOAD REAL VALUE 0.5
RNDL1:	LINK   RNDL2-RNDL0
	CALLSS ADDR		;ADD
RNDL2:	LINK   NOLINK
	CALLSS   TRC		;TRUNCATE
ENDRND:	RTS  MP
;******************************* TRC ****************************
	;EXPECTS A REAL AT (SS), 2(SS).  LEAVES AN INTEGER AT (SS)
	;REGISTER USE:  R0, R1,  AND  R2
	ROUTINE   TRC   ENDTRC
TRCL0:	LINK   TRCL1-TRCL0
TRCL1:	LINK   NOLINK
	CALLSS   EXPTOP		;RETURNS R1=EXP, R0=SIGN
	CLR  R2			;CLEAR RESULT
	TST  R1	
	BLE  TRC2		;EXP <=0 --> RESULT = 0
	CMP  R1, #16.		;EXP TOO LARGE?
	BLT  TRC3		;NO
	CALLSS  WRERROR
	.BYTE  33.,1
	BR  TRC2
TRC3:	ASL  2(R5)		;SHIFT
	ROL  (R5)
	ROL  R2			;COMPOSE INTEGER
	DEC  R1
	BGT  TRC3		;LOOP
	MOVB R2, (R5)		;MOVE SECOND BYTE
	SWAB  (R5)		;SWAP BYTES
	MOV  (R5), R2		;RESULT INR2
	TST  R0
	BEQ  TRC2		;INTEGER > 0?
	NEG  R2
TRC2:	CMP  (R5)+,(R5)+
	MOV R2,-(SS)
ENDTRC:	RTS  MP
;************************** SQRR ******************************
	ROUTINE   SQRR   ENDSQR
SQRL0:	LINK   SQRL1-SQRL0
	MOV  2(SS),-(SS)	;COPY THE REAL ON TOP OF THE STACK
	MOV  2(SS),-(SS)	;
SQRL1:	LINK   NOLINK		;AND MULTIPLY
	CALLSS   MULR
ENDSQR:	RTS  MP
;******************************* ADDR *******************************
	;REALS ARE EXPECTED AT(R5),2(R5) AND 4(R5),6(R5)
	;SS INCREMENTED BY 4 AFTER RETURN
	;REGISTERS USED: R0, R1, R2, AND R5 (=SS)
	R0 = %0
	R1 = %1
	R2 = %2
	R5 = %5
	ROUTINE   ADDR   ENDADDR
	LDF	(SS)+,AC0
	ADDF	(SS)+,AC0
	STF	AC0,-(SS)
ENDADR:	RTS MP
;******************************* MULR *****************************
	ROUTINE   MULR   ENDMPR
	LDF	(SS)+,AC0
	MULF	(SS)+,AC0
	STF	AC0,-(SS)
ENDMPR:	RTS  MP
;***************************** SIGNS ******************************
	;REGISTER USE: R0 ONLY
	;R2, R0 ARE PASSED TO NORM
	ROUTINE   SIGNS
  ENDSGN
SGNL0:	LINK   SGNL1-SGNL0
	TST  R0
	BEQ  SGN0		;BOTH 'PLUS'
	ASL  R0
	CMP  R0, #1002
	BEQ  SGN0		;BOTH 'MINUS'
	MOV  #1, R0
SGN0:
SGNL1:	LINK  NOLINK
	CALLSS   NORM		;NORMALIZE REAL
ENDSGN:	RTS  MP
;******************************** SUBR ****************************
	ROUTINE   SUBR   ENDSUBR
	LDF	(SS)+,AC0
	SUBF	(SS)+,AC0
	NEGF	AC0
	STF	AC0,-(SS)
ENDSBR:	RTS  MP
;*************************** DIVR *****************************
	ROUTINE   DIVR   ENDDIVR
DVRL0:	LINK   DVRL2-DVRL0
	TST  4(R5)
	BEQ  DVR1		;ZERO?--> NOTHING TO DO
	TST  (R5)		;DENOMINATOR ZERO?
	BNE  DVR2		;NO, GO ON
	CALLSS  WRERROR
	.BYTE  34.,1		;ZERO DIVISION
DVR1:	CMP  (R5)+,(R5)+	;REMOVE SECOND REAL
	CLR  2(R5)		;ZERO RESULT
	RTS  MP
DVR2:
	LDF	(SS)+,AC0
	LDF	(SS)+,AC1
	DIVF	AC0,AC1
	STF	AC1,-(SS)
ENDDVR:	RTS  MP
;******************************* EXPTOP *****************************
	;EXPECTS A REAL AT (R5), 2(R5).
	;SIGN AND EXPONENT ARE TAKEN FROM THE REAL AND STORED
	;IN  R0  AND  R1.  REAL FRACTION IS LEFT AT  (R5), 2(R5)
	ROUTINE   EXPTOP   ENDXPT
	LINK   NOLINK
	CLR  R0			;CLEAR SIGNS
	MOV  (R5), R1
	ASL  R1
	ROR  R0			;SIGN OF SECOND REAL
	SWAB  R0
	ASL  R0
	CLRB  R1
	SWAB  R1		;EXPONENT OF SECOND REAL
	SUB  #200, R1		;PURE EXPONENT
	CLRB  1(R5)
	BIS  #200, (R5)		;HIDDEN BIT
ENDXPT:	RTS  MP
;***************************** EXPNTOP ***************************
	;EXPECTS A REAL AT  4(R5), 6(R5)
	;SIGN AND EXPONENT ARE RETURNED INR0  AND  R2
	;REAL FRACTION LEFT AT  4(R5), 6(R5)
	ROUTINE   EXPNTOP   ENDXPN
	LINK   NOLINK
	MOV  4(R5), R2
	ASL  R2
	ADC  R0			;SIGN OF DESTINATION
	CLRB  R2
	SWAB  R2		;EXPONENT
	SUB  #200, R2
	CLRB  5(R5)
	BIS  #200, 4(R5)	;HIDDEN BIT
ENDXPN:	RTS  MP
;********************************* FLT ****************************
	;REGISTERS USED: R0, R1, R2
	ROUTINE   FLT   ENDFLT
FLTL0:	LINK   FLTL1-FLTL0
	CLR  R0			;INIT SIGN REGISTER
	MOV  (SS),-(SS)		;MOVE ONE PLACE
	BGT   FLT1		;TEST VALUE
	BEQ  ENDFLT
	NEG  (SS)		;NEGATEINTEGER
	INC  R0			;SIGN < 0
FLT1:	MOV  #10,R2		;EXPONENT
FLT2:	CLR  2(SS)		;CLEAR SECOND WORD
	CLR  R1			;NO CARRY BIT
FLTL1:	LINK   NOLINK
	CALLSS   NORM		;NORMALIZE REAL
ENDFLT:	RTS  MP
;******************************* FLO ***************************
	ROUTINE   FLO   ENDFLO
FLOL0:	LINK   FLOL1-FLOL0
	MOV  (SS)+,-(HP)
	MOV  (SS)+,-(HP)	;STORE REAL ON TOP
FLOL1:	LINK   NOLINK
	CALLSS   FLT		;FLOAT INTEGER ON TOP
	MOV  (HP)+,-(SS)
	MOV  (HP)+,-(SS)	;RESTORE REAL
ENDFLO:	RTS  MP
;*************************** NORM ******************************
	;(NOT NORMALIZED) REAL FRACTION EXPECTED AT  (R5), 2(R5)
	;BINARY EXPONENT IN R2,  SIGN IN R0.  R1 CONTAINS CARRY BIT.
	;A NORMALIZED REAL IS LEFT IN  (R5), 2(R5)
	ROUTINE   NORM   ENDNRM
NRML0:	LINK   NOLINK
	ADD  #200, R2		;EXCESS 200
	TST  (R5)		;FRACTION ZERO?
	BNE  NRM1		;NO
	TST  2(R5)		;MAYBE
	BEQ  NRM7		;YES
NRM1:	CMP  (R5), #400		;FRACTION OVERFLOW?
	BPL  NRM3		;YES.
NRM2:	CMP  (R5), #200		;NORMALIZED?
	BPL  NRM4
	ASL  R1			;GETCARRY BIT
	ROL  2(R5)		;SCALE
	ROL  (R5)		;LEFT
	DEC  R2			;ADJUST EXPONENT
	BR  NRM2		;GO AGAIN
NRM3:	ASR  (R5)		;SCALE
	ROR  2(R5)		;RIGHT
	ROR  R1			;STORE CARRY BIT
	INC  R2
	BR  NRM1
NRM4:	ASL  R1
	BCC  NRM8
	ADC  2(R5)
	ADC  (R5)
	CLR  R1
	BR  NRM1		;RETURN FOR NEXT TRY
NRM8:	CMP  R2, #377		;EXPONENT OVERFLOW?
	BLE  NRM5		;NO
	CALLSS  WRERROR
	.BYTE  30.,2
	MOV  #-1,(R5)
	MOV  (R5),2(R5)		;BIGGEST ABSOLUTE VALUE
	ASR  R0
	ROR  (R5)		;SIGN
	RTS  MP
NRM5:	TST  R2			;EXPONENT UNDERFLOW?
	BPL  NRM6		;NO
	CALLSS  WRERROR
	.BYTE  31.,2
	CLR  (R5)
	CLR  2(R5)		;FLOATING ZERO
	RTS  MP
NRM6:	BICB  #200,(R5)		;REMOVE SIGNIFICANT BIT
	SWAB  R2
	ASR  R0			;SIGN
	ROR  R2			;RIGHT POSITION
	BIS  R2,(R5)		;PACK EXPONENT
NRM7:	
ENDNRM:	RTS  MP
	.END
****
P11FORTR.MAC         
	.TITLE	FORTR
;
; INTERFACE TO FORTRAN ROUTINES
;
	ROUTINE	FORTR
	MOV	(SS)+,AR	; NO OF PARAMS + 1
	DEC	AR
	BEQ	2$
	MOV	AR,R
	MOV	SS,AD
1$:	MOV	(AD)+,-(SS)	; REVERSE ORDER OF PARAMS
	DEC	R
	BGT	1$
2$:	MOV	AR,-(SS)	; NO OF PARAMS
	MOV	(MP)+,AD	; RELATIVE ADDR OF ROUTINE
	ADD	MP,AD
	MOV	MP,-(HP)	; SAVE R3 - R5
	MOV	SS,-(HP)
	MOV	GP,-(HP)
	MOV	DAPADDR(GP),$OTSV	; FORTRAN OTS CONTEXT SAVE/PTR
	JSR	PC,@AD
	MOV	(HP)+,GP	; RESTORE R3 -R5
	MOV	(HP)+,SS
	MOV	(HP)+,MP
	MOV	(SS)+,AD	; NO OF PARAMS
	ASL	AD
	ASL	AD
	ADD	AD,SS		; SKIP ALL PARAMETERS
	RETURN
;
	.END
****