P11DEF.MAC           
	.NLIST
	.LIST TTM
	.NLIST BEX,TOC,SYM
	.IDENT	/PAS600/
	.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 LIES IN 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 RESERVES SPACE OFFSET GP
LUNTABSZ=20		; SIZE OF NEW LUNTAB AT HEAP BOTTOM
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
SELECTOR=4	; ADDRESS OF DYNAMIC OPTION SWITCH WORD	; V4-33
MARKADDR=6.	; ADDRESS OF MARKPOINTER
DAPADDR	=8.	; ADDRESS OF DYNAMIC AREA POINTER
MARKDDT	=10.	; ADDRESS OF MARKPOINTER USING DDT
DAPDDT	=12.	; ADDRESS OF LAST DEBUG ENTRY IN THE HEAP
LUNTBP	=14.	; POINTER TO LUN TABLE
EXITP	=16.	; POINTER TO EXIT ROUTINE
TSKSIZE	=18.	; ADDRESS OF HIGHEST WORD IN TASK
;
;
;
; SELECTOR BIT DEFINITIONS
;
WPRINT	=1						; V4-33
WCONT	=2
SERCONT	=4
MPRINT	=10
SKIPSP	=20
;
;
; ERROR TYPE CODES
;
WARNING	=0
SERIOUS	=1000
FATAL	=400
MESSAGE	=2000
;
;
;
; 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 FOR ROUTINE ENTRY
;
	.MACRO	ROUTINE	RTR,ENDRTR
	.SBTTL	RTR
$'RTR::
	.ENDM
;
;
; MACRO TO RETRIEVE AND CHECK FDB
;
	.MACRO	FINDFILE  WHERE,SSCORR,TTYIN,?L1,?L2
	MOV	WHERE,R
	MOV	R,AR
	BIT	#TTY,FILTYP(R)
	BNE	L1
	SUB	#FILESIZECORR,AR
	TSTB	F.LUN(AR)
	BNE	L2				; V4-33
	MOV	#TRUE,EOFSTATUS(R)
	MOV	#-102.,IORESULT(R)
.IIF NB <SSCORR>	ADD	SSCORR,SS
	RETURN					; V4-33
L1:
.IIF NB <TTYIN>		MOV	TTYIN,R		; V4-33
L2:						; V4-33
	.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 OR EQUAL
;			;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 THE STACK
;	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 SET EQUALITY 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 FOUR WORD 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 A BOOLEAN 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 FROM THE 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 FUNCTIONS OF 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	P11V5
; CORRECTION	V5-2	1978-07-12	STD
; CORRECTION	V5-35	1979-06-26	STD
; CORRECTION	V6-32	1980-04-15	STD
	.IDENT	/PAS632/
;
;
	.MCALL	FINIT$,GTSK$S
;
;
;>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;>>>>>						<<<<<<
;>>>>>		SPECIAL VERSION FOR P11V5	<<<<<<
;>>>>>						<<<<<<
;>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;
	ROUTINE	INITA	
	FINIT$
	MOV	@MP,SS
	GTSK$S	SS
	MOV	32(SS),SS	; PARTITION SIZE / 32.
	SUB	#2,SS		; POINTER TO LAST WORD IN PARTITION
	MOV	SS,@HP		; -  TO MP AT EXIT		; V5-2
FILAREA=FILESIZECORR+TEXTBUFFSIZE+4
	MOV	SS,AD		; CLEAR HEAP AND STACK
	MOV	AD,AR
	SUB	@MP,AR
	ASR	AR		; NO OF WORDS TO CLEAR
	BIC	#100000, AR
1$:	CLR	-(AD)
	DEC	AR
	BGT	1$
	MOV	MP,AD		; RESERVE SPACE FOR STANDARD FILES
	TST	(AD)+		; SKIP HEAP ADDRESS	; V6-32
	TST	(AD)+
	BEQ	2$
	SUB	#FILAREA,SS	; INPUT
2$:	TST	(AD)+
	BEQ	3$
	SUB	#FILARE,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	#LUNTABSZ+2,AR	;  LUNTAB		; V5-35
	MOV	@MP,AD		; NEW LUNTAB		; V5-35
6$:	CLR	(AD)+		; CLEAR NEW LUNTAB	; V5-35
	DEC	AR
	BGT	6$
	CMP	-(SS),-(SS)	; SPARE			; V6-32
	MOV	@HP,-(SS)	; TASKSIZE		; V6-32
	MOV	#$EXITP,-(SS)	; ADDRESS OF EXIT PROC	; V6-32
	MOV	(MP)+,R 	; ADDRESS OF $$HEAP	; V6-32
	MOV	R, -(SS)	; LUNTABPOINTER		; V6-32
	CMP	-(SS),-(SS)	; MARKDDT & DAPDDT	; V6-32
	DEC	@R		; TTYIN NOT AVAILABLE	; V5-35	; V6-32
	DEC	2*TILUN(R)	; TTYOUT NOT AVAILABLE	; V5-35	; V6-32
	MOV	AD,-(SS)	; DAPADDR := HEAP+LUNTAB ; V5-35
	MOV	@SS,-(SS)	; MARKADDR := START ADDR OF STACK
	MOV	#$P.SEL,-(SS)	; OPTION SELECTOR WORD	; V4-35
;				;   ( PRINT WARNINGS )	; V4-35
	CLR	-(SS)		; LINE NUMBER WORD	; V4-35
	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		; V5-2
	NOP						; V5-2
	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
	MOVB	#40,@(R)	; TTYIN^ := ' '		; V4-50
	MOV	LUNTBP(GP),AD	; AD := LUNTAB-POINTER	; V6-32
	CMP	2(HP),#6	; WHICH FILE
	BNE	TTYOUT
	MOV	R,@AD		; TTYIN			; V5-35	; V6-32
	MOV	#TRUE,EOLNSTATUS(R)
	MOV	#TTY+TEXT+INPUT,FILTYP(R)
	RETURN
;
TTYOUT:	MOV	R,2*TILUN(AD)		; TTYOUT	; V5-35	; V6-32
	CLR	EOLNSTATUS(R)
	MOV	#TTY+TEXT,FILTYP(R)
	MOV	#TEXTBUFFSIZE,2(R)	; A FULL LINE LEFT
	RETURN
;
;
;************************************************
;
; PROCEDURE SLCTDF( I: INTEGER );			; V5-2
;
SLCTDF::
	TST	(SS)+		; SKIP LINK
	MOV	(SS)+,SELECTOR(GP)
	RTS	PC
;
	.END
****
P11RESET.MAC         
	.TITLE	P11RESET
; CORRECTION	V5-35	1979-06-26
; CORRECTION	V6-31	1980-04-15	STD
; CORRECTION	V6-32	1980-04-15	STD
; CORRECTION	V6-35	1980-08-14	STD
	.IDENT	/PAS635/
;
	.MCALL	FDOF$L,CLOSE$,OPEN$,DELET$,ALUN$S
	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) = RECORD SIZE ( -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:	MOV	16.(SS),R				; V6-32
	BIT	#TTY,FILTYP(R)				; V6-32
	BNE	6$		; NO ACTION FOR TTY
1$:	MOV	LUNTBP(GP),AD				; V6-32
	CLR	-(HP)
2$:	CMP	R,@AD				; V5-35	; V6-32
	BEQ	5$		; LUN FOUND
	TST	(AD)+
	INC	@HP
	CMP	@HP,#LUNTABSZ+1			; V5-35
	BLE	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)
	BR	4$			; V4-51
6$:	CLR	EOFSTATUS(R)		; V4-51
4$:	ADD	#18.,SS
	TST	(HP)+		; REMOVE OPEN TYPE CODE	; V4-22
	RETURN
;
5$:	TST	R
	BEQ	NEWOPEN		; IF NOT OPEN ALREADY
;
; CLOSE FILE FIRST
;
REOPEN:
	MOV	R,AR
	SUB	#FILESIZ,AR	; FDB ADDRESS
	BIT	#TEMPORARY,FILTYP(R)
	BEQ	5$		; NOT TEMP
; TEMP FILES:
; SAVE FILENAME BLOCK AND OPEN SAME FILE 
	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$
	CLOSE$
	MOV	#20,R
2$:	MOV	(SS)+,-(AD)
	DEC	R
	BGT	2$
	MOV	(HP)+,AD
	BIS	#TEMPORARY,@SS	; SAME TEMP FILE
	BR	NEWOPEN

5$:	TST	F.RSIZ(AR)	; TEST IF FILE IS EMPTY
	BNE	3$		; IF EMPTY THEN DELETE ELSE CLOSE
;				;    ( TEXTFILES ONLY )
	TST	IORESULT(R)
	BLT	4$		; IF NONEXISTENT FILE
	DELET$	R0
	BR	4$
3$:	CLOSE$
4$:
;
NEWOPEN:MOV	16.(SS),R	; FILE POINTER
	MOV	R,@AD		;RESERV LUN	; V5-35	; V6-32
	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,#$P.DEV,#$P.UNI; ASSIGN LUN TO DEFAULT (SY0:)
	MOV	14.(SS),F.RSIZ(AR); RECORD SIZE
	BGT	11$		; 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
	MOV	#FD.CR,AD
	BITB	AD,1(SS)	; CR OFF
	BEQ	10$		; NO
	MOV	#FD.FTN,AD
	BITB	AD,1(SS)	; FTN PRINT CONTROL
	BNE	10$		; YES
	CLR	AD
10$:	MOVB	AD,F.RATT(AR)	; CARRIAGE CONTROL NOT IN TEXT	; V6
11$:
	BIT	#RANDOM,@SS
	BEQ	15$		; IF RANDOM NOT SPECIFIED
	BICB	#FD.PLC,F.RACC(AR)	; MOVE MODE !!!	; V6-35
	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
	TST	6(SS)		; LENGTH 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)
	CLRB	F.LUN(AR)	;RELEASE LUN	; V4-23
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
	BNE	45$					; V4-16
	MOV	F.URBD+2(AR),@R				; V4-16
45$:							; V4-16
	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				; V4-16
9$:	RETURN
;
	.END
****
P11GETPUT.MAC        
	.TITLE	P11GETPUT
; CORRECTION	V4-15	1977-06-22	STD
; CORRECTION	V4-24	1977-07-25	OEN
; CORRECTION	V4-27	1977-08-12	STD
; CORRECTION	V4-36	1977-08-12	STD
; CORRECTION	V4-37	1977-08-12	STD
; CORRECTION	V4-47	1977-10-12	STD
; CORRECTION	V4-49	1977-10-12	STD
; CORRECTION	V5-35	1979-06-01	STD
; CORRECTION	V6-22	1980-02-26	STD
; CORRECTION	V6-32	1980-04-15	STD
	.IDENT	/PAS632/
;
	.MCALL	GET$,PUT$,QIO$S,WTSE$S,FDOF$L,FSRSZ$
;
	FDOF$L		; DEFINE FDB OFFSETS
;	ALLOCATION OF BLOCK BUFFERS SHOULD BE DONE BY
;	COMPILER, OR BY USER AT TASK BUILD TIME, NOT HERE.
;	SAVINGS IN COMPILER:   792. WORDS.
;
	FSRSZ$	0				; V5-35
;
	.PSECT	PASRUN
;
;
;
; WRREC
;	2(SS) = FILE
;	 (SS) = RECORD ADDRESS
;
	ROUTINE WRREC
;
	MOV	(SS)+,AD
	FINDFILE @SS
	MOV	@R,R
	MOV	F.RSIZ(AR),-(SS)	; RECORD SIZE
	INC	@SS
	ASR	@SS			; WORD SIZE
1$:	MOV	(AD)+,(R)+
	DEC	@SS
	BGT	1$
	TST	(SS)+			; SKIP COUNTER
	MOV	@SS,R			; FILE
	MOV	R,-(SS)			; LEAVE FILE ON STACK
	BR	$PUT2	
;
;
	.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)+
	BIT	#TTY,FILTYP(R)
	BEQ	PUTLN2
	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)	; SPACE FOR 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),#6.			; V4-24
	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
;
;
; RDREC
;
;	2(SS) = FILE, LEFT ON STACK
;	 (SS) = RECORD ADDRESS
;
	ROUTINE RDREC
;
	MOV	(SS)+,AD
	FINDFILE @SS
	MOV	@R,R		; FILE WINDOW
	MOV	F.RSIZ(AR),-(SS)	; RECORD SIZE
	INC	@SS
	ASR	@SS		; WORD SIZE
1$:	MOV	(R)+,(AD)+
	DEC	@SS
	BGT	1$
	TST	(SS)+		; SKIP COUNTER
	MOV	@SS,R		; FILE
	BR	$GET1
;
;
; 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)+,,@LUNTBP(GP)	; IF TTY THEN	; V4-36	; V5-35	; V6-32
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)
	INC	EOLNSTATUS(R)					; V4-37
1$:	MOV	F.NRBD+2(AR),@R	; NEXT RECORD BUFFER
	BNE	5$					; V4-15
	MOV	F.URBD+2(AR),@R	; USER RECORD BUFFER	; V4-15
5$:							; V4-15
	BIT	#TEXT,FILTYP(R)
	BEQ	9$		; READY IF NOT TEXTFILE
	MOV	F.NRBD(AR),2(R)	; REMAINING CHAR COUNTER
	BEQ	45$		; SET EOLN IF EMPTY LINE	; V6-22
9$:	RETURN
;
7$:	DEC	2(R)
	BGT	8$		; IF CHAR'S LEFT
40$:	BIT	#TTY,FILTYP(R)				; V4-36
	BNE	48$					; V4-36
45$:	MOV	F.URBD+2(AR),@R				; V4-36
48$:	INC	EOLNSTATUS(R)				; V4-36
	MOVB	#40,@(R)	; SPACE
	TST	EOFSTATUS(R)				; V4-49
	BEQ	49$					; V4-49
	MOVB	#34,@(R)	; FS			; V4-49
49$:	RETURN						; V4-49
8$:	INC	@R
	MOV	#1,IORESULT(R)				; V4-27
	RETURN
;
99$:	CALLSS	WRERROR
	.BYTE	66.,1
	RETURN
;
;
;
GETTTY:	MOV	R,AD
	MOV	LUNTBP(GP),AR		; LUNTAB	; V6-32
	MOV	2*TILUN(AR),AR			; V4-36	; V5-35	; V6-32
	CLR	EOLNSTATUS(AR)	; CLEAR EOLN ON OUTPUT	; V4-36
	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)
	CMPB	AD,#IE.EOF	; CNTL Z		; V4-47
	BNE	18$		; NO			; V4-47
	INC	EOFSTATUS(R)				; V4-47
18$:							; V4-47
	TST	(SS)+		; SKIP 1ST WD OF IO STATUS BLOCK
	MOV	(SS)+,2(R)	; NUMBER OF CHAR'S
	BEQ	40$		; MARK TI-IN		; V4-36
19$:	RETURN
;
;
; TTPAR(F)
;
;	(SS) = POINTER TO FILE WINDOW
;
;	IF FILE IS TTYOUT THEN SWITCH TO TTYIN
;
	ROUTINE	TTPAR
	MOV	@SS,R		; FILE ID
	BIT	#TTY,FILTYP(R)
	BEQ	NOTTY		; IF NOT TTY
	MOV	@LUNTBP(GP),@SS	; TTYIN			; V5-35	; V6-32
NOTTY:	RETURN
;
;
;
	.DSABLE	LSB
;
; RDSTR
;
;	4(SS) = FILE
;	2(SS) = STRING ADDRESS
;	 (SS) = STRING LENGTH
;
	ROUTINE	RDSTR
	MOV	(SS)+,AR	; LENGTH
	MOV	(SS)+,AD	; ADDRESS
	MOV	@SS,R		; FILE
	SUB	AR,2(R)		; REMAINING CHAR'S IN LINE
	BGE	1$
	ADD	2(R),AR
1$:	MOV	@R,-(SS)	; BUFFER POINTER
	ADD	AR,@R		; UPDATE BUFFER POINTER
	MOV	(SS)+,R		; OLD BUFFER POINTER
2$:	DEC	AR
	BLT	5$		; NO CHAR'S IN BUFFER
	MOVB	(R)+,(AD)+	; READ CHAR'S
	BR	2$
5$:	MOV	@SS,R		; FILE
	MOV	2(R),AR		; REMAINING CHAR'S
	BGE	4$
	NEG	AR		; NUMBER OF SPACES
	CLR	2(R)		; REMAINING CHAR'S
	MOV	#TRUE,EOLNSTATUS(R)
3$:	MOVB	#' ,(AD)+	; READ SPACES
	DEC	AR
	BGT	3$
	MOV	R,AR					; V6-22
	SUB	#FILESIZECORR+TEXTBUFF,AR		; V6-22
	BIT	#TTY,FILTYP(R)				; V6-22
	BEQ	6$					; V6-22
	ADD	#FDBSIZE,AR				; V6-22
6$:	MOVB	#' ,@AR					; V6-22
	MOV	AR,@R
4$:	RETURN
;
;
;
	.END
****
P11WRERR.MAC         
	.TITLE	WRERROR
; CORRECTION	V5-41	1979-06-01	STD
;
; CORRECTION	V6-3	1979-09-20	STD
; CORRECTION	V6-26	1980-04-01	STD
; CORRECTION	V6-27	1980-04-01	STD
; CORRECTION	V6-28	1980-04-01	STD
	.IDENT	/PAS628/
	.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  FATAL ERROR
;			  2  WARNING
;			  4  MESSAGE
;			  +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
;
;							; V4-32
	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
	BIT	#FATAL,@MP				; V4-32
	BNE	7$		; FATAL ERROR		; V4-32
	BIT	#MESSAGE,@MP
	BEQ	20$		; NOT A MESSAGE		; V5-0
	BIT	#MPRINT,SELECTOR(GP)			; V5-0
	BEQ	21$		; DON'T PRINT MESSAGE	; V5-0
	BR	7$					; V5-0
20$:							; V5-0
	BIT	#WPRINT,SELECTOR(GP)			; V4-32
	BNE	7$		; PRINT WARNING		; V4-32
21$:							; V5-0
	ASL	@SS
	ADD	@SS,SS		; REMOVE PARAMETERS	; V4-32
	TST	(SS)+		; "-
	BR	99$		; CONTINUE		; V4-32
7$:	MOV	#TENPOW,R				; V4-32
	MOV	SS,AD					; V4-32
	MOV	#TENPOW-WREMSG,AR			; V4-32
6$:	MOVB	-(R),-(AD)	; MOVE TEMPLATE TEXT TO STACK	; V4-32
	DEC	AR					; V4-32
	BGT	6$					; V4-32
	MOV	AD,-(HP)	; SAVE TEXT POINTER	; V4-32
	ADD	#WRENUM-WREMSG,AD			; V4-32
	MOVB	@MP,R		; ERROR NUMBER		; V4-32
	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
	MOVB	#40,(AD)+	; INSERT SPACE		; V5-41
	MOV	2(SS),R		; NEXT PARAM
	BGE	50$		; IF POSITIVE		; V5-41
	MOVB	#'-,(AD)+	; INSERT SIGN		; V5-41
	NEG	R		; CONVERT TO POS	; V5-41
50$:	MOV	(SS)+,(SS)	; MOV PARAM COUNTER	; V5-41
	BR	2$
9$:	SUB	@HP,AD					; V4-32
	MOV	(HP)+,R					; V4-32
	QIO$S	#IO.WVB,#5,#5,,,,<R,AD,#40>		; V4-32
	WTSE$S	#5
	TST	(SS)+		; REMOVE PARAM COUNTER
	TST	SELECTOR(GP)				; V6-3
	BPL	12$					; V6-3
	MOV	MP,-(HP)	; SAVE RETURN LINK	; V6-3
	MOV	GP,MP		; SET MP FOR DEBUGGER	; V6-3, V6-27
	TRAP	2		; CALL DEBUGGER		; V6-3
	MOV	(HP)+,MP	; RESTORE MP		; V6-3
12$:							; V6-3
99$:	MOV	(MP)+,R		; ERROR BYTES		; V4-32, V6-26
	BIT	#SERCONT,SELECTOR(GP)
	BNE	10$		; IF CONT AFTER SERIOUS
	BIT	#MESSAGE,R				; V5-0
	BNE	10$					; V5-0
	BIT	#FATAL,R				; V5-0
	BNE	11$		; IF SERIOUS		; V5-0
	BIT	#WCONT,SELECTOR(GP)
	BEQ	11$		; IF NOT CONT AFTER WARNING
10$:	RETURN
11$:	JMP	@EXITP(GP)	; $EXITP OR $EXITN	; V6-28
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
; CORRECTION	V4-44	1977-09-07	STD
; CORRECTION	V4-53	1977-10-13	STD
; CORRECTION	V4-54	1977-10-13	STD
;
; CORRECTION	V5-16	1978-12-29	STD
; CORRECTION	V5-35	1979-06-26	STD
; CORRECTION	V6-2	1979-08-31	STD
; CORRECTION	V6-32	1980-04-15	STD
; CORRECTION	V6-33	1980-05-22	STD
	.IDENT	/PAS633/
;
;
	.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:	MOV	AD,-(SS)			; V4-53
	BIT	#TEXT,FILTYP(R)			; V4-53
	BNE	77$				; V6-2
	BIC	#SPOOL,FILTYP(R)		; V6-2
	BR	1$				; V4-53	; V6-2
77$:						; V6-2
	BIT	#INPUT,FILTYP(R)		; V4-53
	BNE	5$				; V4-53
	CMP	2(R),#132.	; ANY CHAR LEFT	; V4-53
	BEQ	5$		; NO		; V4-53
	MOV	R,-(SS)		; DOUBLE FILE ID; V4-53
	CALLSS	PUTLN				; V4-53
5$:	BIT	#TTY,FILTYP(R)			; V4-53
	BNE	9$				; V4-53
	BIT	#SPOOL,FILTYP(R)		; V4-53
	BEQ	1$
	PRINT$	R0
;	BR	2$				; V6-2
1$:	BIT	#TEMPORARY,FILTYP(R)		; V5-16
	BEQ	4$				; V5-16
	CALL	.MRKDL				; V5-16
	BIT	#SPOOL,FILTYP(R)		; V6-2
	BNE	2$				; V6-2
	BR	3$				; V6-33
4$:	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$:	MOV	@SS,AD
	MOVB	F.LUN(AR),R
	ASL	R
	ADD	LUNTBP(GP),R		; V5-35	; V6-32
	CLRB	F.LUN(AR)
	CLR	@R			; V5-35	; V6-32
9$:	MOV	(SS)+,AD
	RETURN
;
; PROCEDURE CLOSE ( VAR F: FILE );     EXTERN ;
;
CLOSEF:: TST	(SS)+	; SKIP MP LINK		; V4-54
	CALLSS	CLOSE
	RTS	PC
;
;
; EXITP
;
	ROUTINE	EXITP
;
	MOV	#<2*LUNTABSZ+2>,AD		; V5-35
	ADD	LUNTBP(GP),AD			; V6-32
	MOV	#LUNTABSZ+1,-(HP)		; V5-35
1$:	MOV	(AD),-(SS)		; V5-35	; V6-32
	BEQ	3$
	INC	(AD)			; V5-35	; V6-32
	BEQ	3$
2$:	JSR	MP,$CLOSE
3$:	TST	-(AD)
	DEC	@HP
	BGT	1$
	EXIT$S
;
;
	.END
****
P11CMREAL.MAC        
	.TITLE	P11CMR	REAL COMPARISON ROUTINES
;
; CORRECTION	V5-9	1978-11-21	STD
;
;
;********************* 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   CMR5		;GREATER	; V5-9
	BLT  CMR6		;LESS THAN	; V5-9
	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
CMR5:	TST  2(SS)	; SIGN OF BIG REAL	; V5-9
	BLT  CMR2	; 			; V5-9
CMR1:	INC  R0
	BR  CMR3		;GREATER -->COND > 0
CMR6:	TST  -2(SS)	; SIGN OF BIG REAL	; V5-9
	BLT  CMR1	;			; V5-9
CMR2:	DEC  R0			;COND = -1
ENDCMR:	BR  CMR3


	.END
****
P11WRREAL.MAC        
	.TITLE	WRREAL
; CORRECTION	V4-14	1977-06-15	OEN
; CORRECTION	V5-8	1978-11-21	STD
; CORRECTION	V5-10	1978-11-21	STD
; CORRECTION	V6-36	1980-09-23	VERDOES/STD
	.IDENT	/PAS636/
;
;****************************** 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	; V6-36
	SWAB (HP)		;FIELD LEN TO NORMLZ	; V6-36
	MOV  (HP)+,R1
WRRL7:	LINK   WRRL9-WRRL0
	CALLSS   NORMLZ		;NORMALIZE
	MOV  R2,-(HP)		; DEC EXP
	MOV  R0,-(HP)		; EXP SIGN FLAG
;	BIC  #177400,R1		; CLEAR HIGH BYTE	; V4-14	; V6-36
	SWAB R1			; RESTORE FIELD LENGTH	; V6-36
WRRL9:	LINK   NOLINK
	CALLSS   DECDIG
	CMP  (SS)+,(SS)+	;REMOVE REAL FROM STACK
	MOV  #'E,-(SS)	
	CALLSS  WRC		;WRITE E
	MOV  #'+,-(SS)					; V5-10
	MOV  (HP)+,R0		;EXP SIGN FLAG
	BGE  WRRL4					; V5-10
	MOV  #'-,(SS)					; V5-10
WRRL4:	LINK   WRRL7-WRRL0
	CALLSS   WRC					; V5-10
	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
	MOV  (R5),R0		;		; V6-36
	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	; V6-36
	ROL   R0		; V6-36
	SWAB  R0		; V6-36
	BIC   #177400,R0	; V6-36
3$:	CMP   #200,R0		; V6-36
	BEQ   2$		; V6-36
	CLC			; V6-36
	ROR   (R5)		; V6-36
	ROR   2(R5)		; V6-36
	INC   R0		; V6-36
	BR    3$		; V6-36
2$:				; V6-36
	MOVB 3(HP),R1		;GET NUMBER OF
	TSTB  2(HP)		; V6-36
	BEQ   4$		; IF CALLED FROM WRR	; V6-36
	ADD  (HP),R1		;WANTED DIGITS
4$:				; V6-36
	BIC  #177400,R1		;CLEAR LEFT CHAR	; V4-14
	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
	TST  R2			; DEC CARRY IF ZERO	; V5-8
	BEQ  NLZ12		;			; V5-8
	INC  R2			; BINEXP		; V5-8
	SEC			; SHIFT IN LOST BIT	; V5-8
;	BR   NLZ11		;			; V5-8
	BR   NLZ4		;			; V6-36
NLZ12:	MOV  #14631,(SS)				; V5-8
	MOV  #114700,2(SS)
	INC  (HP)		;DECEXP
NLZ4:	INC  R2
	BGT  NLZ5		;NORMALIZE BINEXP ZERO	
;	CLC			; CLEAR CARRY		; V6-36
;NLZ11:	ROR  (R5)					; V6-36
;	ROR  2(R5)		;SHIFT ONE PLACE	; V6-36
	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 - 1	; V5-8
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 SPACE		; V5-10
	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		;MUST BE > = 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		;PRINT LEADING 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 PRINTED YET
	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
; CORRECTION	V4-30	1977-08-12	STD
; CORRECTION	V5-6	1978-11-21	STD
;**************************** RDR ****************************

	DECCNT=%1
;
	;READS A REAL NUMBER AND STORES IT AT THE 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  -(HP)		;INITIATE SKIP COUNT	;V5-6
	CLR  -(SS)
	CLR  -(SS)		;CREATE ROOM FOR LONG INTEGER
RDRL2:	LINK   RDRL4-RDRL0
	CALLSS   UNSINT		;TRY TO READ AN 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
	MOV  4(SS),R		; FILE ID		; V4-30
	MOV  #-106.,IORESULT(R)	; NOT DIGIT "." OR "E"	; V4-30
	CALLSS	WRERROR					; V5-0
	.BYTE	44.,4					; V5-0
	TST  (HP)+		;REMOVE SKIP COUNT	;V5-6
	CMP  (HP)+,(HP)+	; REMOVE SIGN & DECEXP	; V4-30
	BR   RDR5		; REAL = 0.0		; V4-30
RDR12:	INC  2(R5)		;LONG INT MUST BE 1
	BR  RDR3
RDR1:	ADD  (HP),2(HP)		;SKIPPED DIGITS SIGNIF	; V5-6
	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,2(HP)	;UPDATE DECIMAL EXPONENT; V5-6
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)+,2(HP)	;UPDATE DECIMAL EXPONENT; V5-6
LDCLF:	;CONVERT A LONG INTEGER TO FLOATING REAL
RDR4:	TST  (HP)+		; REMOVE SKIP COUNT	; V5-6
	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
	MOV  @SS,R					; V5-0
	TST  IORESULT(R)				; V5-0
	BLT  ENDRDR					; V5-0
	BIT  #SKIPSP,SELECTOR(GP)			; V5-0
	BEQ  ENDRDR					; V5-0
	CALLSS	SKPSP		; SKIP SPACES		; V4-52
ENDRDR:	RTS  MP



	.END
****
P11RDI.MAC           
	.TITLE	RDI
; CORRECTION	V4-29	1977-08-12
; CORRECTION	V4-52	1977-10-12	STD
; CORRECTION	V5-6	1978-11-21	STD
; CORRCETION	V5-15	1978-11-21	STD
;*************************** 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  -(HP)		;INITIATE SKIP COUNT	; V5-6
	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
				;NO DIGITS AFTER SIGN	; V4-29
	MOV  4(SS),R		; FILE ID		; V4-29
	MOV  #-104.,IORESULT(R)	; ERROR NUMBER		; V4-29
	CALLSS	WRERROR					; V5-0
	.BYTE	40.,4					; V5-0
RDI0:	TST  (SS)+		;TEST HIGH WORD OF LONG INT
	BEQ  RDI1
RDIL4:
	MOV  #077777,@SS	;NUMBER TOO LARGE	; V4-29
	MOV  2(SS),R		; FILE ID		; V4-29
	MOV  #-105.,IORESULT(R)	; ERROR NUMBER		; V4-29
	CALLSS	WRERROR					; V5-0
	.BYTE	41.,4					; V5-0
RDI1:	TST  (HP)+		; REMOVE SKIP COUNT	; V5-6
	CMP (SS),#100000	;TEST  LOW WORD		; V5-15
	BHI  RDIL4		;NUMBER TOO LARGE	; V5-15
	TST  (HP)+		;SIGN FLAG
	BEQ  RDI3
	NEG  (SS)		;NEGATE INTEGER
RDI3:	MOV  (SS)+,@(HP)+	;STORE INTEGER
	MOV  @SS,R					; V5-0
	TST  IORESULT(R)				; V5-0
	BLT  ENDRDI					; V5-0
	BIT  #SKIPSP,SELECTOR(GP)			; V5-0
	BEQ  ENDRDI					; V5-0
	CALLSS	SKPSP		; SKIP SPACES		; V4-52
ENDRDI:	RTS  MP


	.END
****
P11RDHLP.MAC         
	.TITLE	RDHLP
; CORRECTION	V4-12	1977-06-15	OEN
; CORRECTION	V4-28	1977-08-12	STD
; CORRECTION	V4-48	1977-10-12	STD
; CORRECTION	V4-52	1977-10-12	STD
;
; CORRECTION	V5-6	1978-11-21	STD
;************************** SKIPSPACES *************************

	;READS CHAR'S UNTIL NEXTCH <> SPACE
	;(SS) = FILE ID ( LEFT ON STACK )


	ROUTINE SKPSP		; SKIP SPACES
	MOV	@SS,R
	MOVB @(R), R0		;LOAD CHARACTER
	CMP  R0,#40		;BLANK?
	BNE  SKP1			;NO
	TST  EOFSTATUS(R)
	BNE  SKP1
	TST  EOLNSTATUS(R)			; V4-48
	BEQ  SKP2				; V4-48
	BIT	#TTY,FILTYP(R)			; V4-48
	BNE	SKP1	; STOP AT EOLN IF TTY	; V4-48
SKP2:	MOV  (SS),-(SS)		;DOUBLE FILE ID
	CALLSS  GET	;GET NEXT CHARACTER
	BR   $SKPSP
SKP1:	RETURN
 
 
;************************** RDSIGN *************************

	;READS A SIGN AND LEAVES IT IN R1
	;(SS) = FILE ID ( LEFT ON STACK )


	ROUTINE RDSIGN
1$:	CALLSS	SKPSP
	CMP	R0,#40		; SPACE			; V4-48
	BNE	2$					; V4-48
	MOV	@SS,-(SS)				; V4-48
	CALLSS	GET					; V4-48
	BR	1$		; POSSIBLE FOR TTY	; V4-48
2$:	CLR  -(HP)		;SIGN FLAG		; V4-48
	CMP  R0,#'+		;PLUS?
	BEQ  RDS1		;YES
	CMP  R0,#'-		;MINUS?
	BNE  RDS2		;NO -->NO SIGN AT ALL
	DEC  (HP)		;SIGN FLAG -1
RDS1:							; V4-12
	MOV  (SS),-(SS)		;DOUBLE FILE ID
	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 )
	; 2(HP)   COUNTER FOR SKIPPED DIGITS


	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:	CMP  (R5),#3276.	; 32767  / 10		; V5-6
	BGE	MLT0		; OVERFLOW
	ASL  2(R5)		;MULTIPLY LONG BY TEN
	ROL  (R5)
	MOV  (R5),-(HP)
	MOV  2(R5),-(HP)
	ASL  2(R5)
	ROL  (R5)
	ASL  2(R5)
	ROL  (R5)
	ADD  (HP)+, 2(R5)
	ADC  (R5)
	ADD  (HP)+,(R5)
	ADD  R0, 2(R5)		;LAST DIGIT READ
	ADC  (R5)
	INC  DECCNT		;INCREMENT EXPONENT
MLT2:	MOV  DECCNT,-(HP)
	MOV  4(SS),-(SS)	;FILE ID
	CALLSS  GET		; NEXT CHARACTER
	MOVB @(R), R0		;IN R0
	MOV  (HP)+,DECCNT
	BR  USIL2
MLT0:	INC  2(HP)			;V5-6
	BR   MLT2			;V5-6
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
	;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
	BIT  #100000,4(SS)				; V4-13
	BEQ  RND1					; V4-13
	BIS  #100000,(SS)	; SET CORRECT SIGN	; V4-13
RND1:	CALLSS   ADDR		;ADD			; V4-13
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 AND PACK 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)		;SAVE SIGNS
	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 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)		;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 ONTO HARDWARE STACK
	CLR  -(HP)		;SIGN FLAG		; V4-31
	MOV  (SS)+, R		;LOAD INTEGER VALUE INTO R
	BGE   WRI0		;JUMP IF POSITIVE OR ZERO
	MOV  #'-,(HP)		;MOVE '-' ONTO STACK,OVERWRITING THE BLANK
	NEG  R			;INVERT SIGN
	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 VALUE FOR SS
	MOV  (HP)+,R		;SIGN
	BEQ  1$			; IF POSITIVE		; V4-31
	MOVB  R,-(AR)		;
1$:	MOV  AD,-(SS)		;RETURN VALUE OF SS	; V4-31
	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
; CORRECTION	V5-44	1979-06-26	STD
;******************************* MARKP *****************************


	ROUTINE   MARKP   ENDMRK
	LINK   NOLINK
	MOV  DAPADDR(GP),AD		;			; V5-44
	MOV  MARKADDR(GP),(AD)+		;'HEAP' MARKPOINTER	; V5-44
	MOV  MARKDDT(GP), (AD)+		;  AND DDT-MARKPOINTER	; V5-44
	MOV  DAPADDR(GP),MARKADDR(GP)	;MARKPOINTER := DAP
	MOV  DAPDDT(GP),MARKDDT(GP)	;MARKPOINTER := DAP
	MOV  AD,DAPADDR(GP)		;DAP := DAP + 4		; V5-44
ENDMRK:	RTS  MP


;***************************** RELEASEP ****************************


	ROUTINE   RELEASEP   ENDRLS
	LINK   NOLINK
	MOV  MARKADDR(GP),DAPADDR(GP)	;DAP := MARKPOINTER
	MOV  MARKADDR(GP),AD					; V5-44
	MOV  (AD)+,MARKADDR(GP)		;GET MARKPOINTER FROM HEAP ; V5-44
	MOV  (AD)+,MARKDDT(GP)		; AND DDT-MARKP		; V5-44
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 --> CLEAR BYTE
	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
	BEQ  ENDCLA
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
	BEQ  ENDCLS		;BR IF NOTHING TO CLEAR
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
	MOV  (MP)+, R		;= SIZE OF SET IN BYTES
	ADD  R, AR		;AR = ADDRESS OF SETELEMENT
	MOV  AR, AD		;AD = DESTINATION ADDRESS OF BOOLEAN
	MOV  (AR), AR		;AR = SETLEMENT
	CLR  (AD)		;INITIALIZE BOOLEAN RESULT FALSE
	TST  AR			;TEST SETELEMENT
	BMI  INN0		;IF NEGATIVE RETURN FALSE
	ASL  R
	ASL  R
	ASL  R			;=SET SIZE IN BITS
	CMP  AR, R		;CHECK IF OUTSIDE SET SIZE
	BGT  INN0		;IF OUTSIDE RETURN FALSE
	MOV  AR, R		;= SETELEMENT
	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)		;LOAD SECOND 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		;LOOP IF 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  QUOTIENT NEG
	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)+	;COMPARE BYTES 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 FALSE IF 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
; CORRECTION	V6-1	1979-08-28	STD
	.IDENT	/PAS601/
;***************************** 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
;
;
	ROUTINE   NEQB   ENDNQB
NQBL0:	LINK   NQBL1-NQBL0	;LINK FOR CALL OF NEQB2
	MOV  (SS)+, AR		;SOURCE ADDRESS IN AR
	MOV  (SS)+, AD		;DESTINATION ADDRESS IN AD
	MOV  (MP)+, R		;LENGTH ARGUMENT IN R
NQBL1:	LINK   NOLINK
	CALLSS   NEQB2
ENDNQB:	RTS  MP


	.END
****
P11NEQM2.MAC         
	.TITLE	NEQM2
; CORRECTION	V6-1	1979-08-28	STD
	.IDENT	/PAS601/
;******************************** 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
;
;
	ROUTINE   NEQB2   ENDQB2
	LINK   NOLINK
QB20:	CMPB  (AD)+,(AR)+	;COMPARE BYTES OF SOURCE AND DESTINATION
	BNE   QB21
	DEC  R			;DECREMENT WORD COUNT
	BGT  QB20		;LOOP WHILE COUNT # 0
	CLR  -(SS)		;LOAD BOOLEAN FALSE
	RTS  MP
QB21:	MOV  #1,-(SS)		;LOAD BOOLEAN TRUE
ENDQB2:	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
; CORRECTION	V6-1	1979-08-28	STD
	.IDENT	/PAS601/
;*************************** 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 WORDS) IN R	; V4-6
EQML1:	LINK   NOLINK
	CALLSS   EQUM2
ENDEQM:	RTS  MP
;
;
	ROUTINE   EQUB   ENDEQB
EQBL0:	LINK   EQBL1-EQBL0	;LINK FOR CALL OF EQUB2
	MOV  (SS)+, AR		;SOURCE ADDRESS IN AR
	MOV  (SS)+, AD		;DESTINATION ADDRESS IN AD
	MOV  (MP)+, R		;LENGTH ARGUMENT IN R
EQBL1:	LINK   NOLINK
	CALLSS   EQUB2
ENDEQB:	RTS  MP


	.END
****
P11EQUM2.MAC         
	.TITLE	EQUM2
; CORRECTION	V6-1	1979-08-28	STD
	.IDENT	/PAS601/
;**************************** EQUM2 **************************


	ROUTINE   EQUM2   ENDEQ2
	LINK   NOLINK
EQ20:	CMP  (AD)+,(AR)+	;COMPARE WORDS OF SOURCE AND DESTINATION
	BNE   EQ21		;TEST COMPLETED IF NOT EQUAL
	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
;
;
	ROUTINE   EQUB2   ENDEQB2
	LINK   NOLINK
EQB20:	CMPB  (AD)+,(AR)+	;COMPARE WORDS OF SOURCE AND DESTINATION
	BNE   EQB21
	DEC  R			;DECREMENT WORD COUNT
	BGT  EQB20		;LOOP WHILE COUNT # 0
	MOV  #1,-(SS)		;LOAD BOOLEAN TRUE
	RTS  MP
EQB21:	CLR  -(SS)		;LOAD BOOLEAN FALSE
ENDEQB2:	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 EXCESS 128
	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		;RESTORE INTEGER 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
	;LOGARITHM OF 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 C1   INITIATE 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
;
; CORRECTION	V5-21	1979-06-19	STD
;
;******************************** 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
	TST  (SS)		;ZERO?			; V5-21
	BEQ  SIN11		;YES, AVOID -0.0	; V5-21
	ADD  #100000,(SS)	;NO, NEGF
SIN11:	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
; CORRECTION	V4-26	1977-08-08	STD
;******************************** 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?
	BHI  OFC0		;YES, CONTINUE		; V4-10
	CALLSS  WRERROR
	.BYTE  10.,1
OFC0:	MOV  STACKBEG, AR	;CHECK FOR HARDWARE STACKOVFL
	ADD  #10., AR		; 10 WORDS
	CMP  HP, AR
	BHI   ENDOFC					; V4-10
	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
SCKL1:	MOV  @SS,-(SS)		; OFFENDING VALUE	; V4-26
	MOV  #1,-(SS)		; 1 PARAM ON STACK
	CALLSS  WRERROR					; V4-26
	.BYTE  12.,200		; PARAMS ON STACK AND WARNING	; V4-26
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 FROM SOURCE 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
 
 
;******************************** MOVTS ******************************
 
 
	ROUTINE	  MOVTS
	MOV	(MP)+,R
MTS0:	MOV	-(AD),-(SS)
	DEC	R
	BGT	MTS0
	RTS	MP
 
 
;******************************** MOVFS *****************************
 
 
	ROUTINE   MOVFS
	MOV	(MP)+,R
MFS0:	MOV	(SS)+,(AD)+
	DEC	R
	BGT	MFS0
	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	; FIELD LEN
	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)		; PRESUMPTIVE DIGIT
	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
; CORRECTION	V6-32	1980-04-15	STD
	.IDENT	/PAS632/
	.MCALL	SNPBK$,SNAP$
;
;
SNPBK$	SY,0,SC.LUN!SC.OVL!SC.HDR!SC.STK!SC.WRD!SC.BYT,31.
;
;
D1:	MOV	#1.,-(HP)
	BR	D
D2:	MOV	#2.,-(HP)
	BR	D
D3:	MOV	#3.,-(HP)
	BR	D
D4:	MOV	#4.,-(HP)
	BR	D
D5:	MOV	#5.,-(HP)
	BR	D
D6:	MOV	#6.,-(HP)
	BR	D
D7:	MOV	#7.,-(HP)
	BR	D
D8:	MOV	#8.,-(HP)
	BR	D
;
;
	ROUTINE	DUMP
	CLR	-(HP)
D:	SNAP$	,,,TSKSIZE(GP),DAPADDR(GP),SS,-2(GP)
	CALLSS	EXITP
;
$P.VEC::.WORD	D1,D2,D3,D4,D5,D6,D7,D8
;
	.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),#4		;;; V4-45
	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 AREA FOR 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					; V4-4
MPI1:	MOV  R,-(SS)		;RESULT ON THE STACK
ENDMPI:	RTS  MP


	.END
****
P11EISDVI.MAC        
	.TITLE	DIVI
; CORRECTION	V4-20	1977-06-07	OEN
; CORRECTION	V5-42	1979-06-01	STD
; CORRECTION	V6-27	1980-04-08	OEN
	.IDENT	/PAS627/
;
;**********************************************
;**********			     **********
;**********	     E  I  S	     **********
;**********			     **********
;********** EXTENDED INSTRUCTION SET **********
;**********			     **********
;**********************************************
;
;****************************** DIVI ********************************


	ROUTINE   DIVI   ENDDIVI
	MOV  2(SS),R				; V5-42
	SXT  AR		; SIGN EXTEND		; V6-27
	DIV  (SS)+,AR				; V5-42
	BCC  DVI1	; DIVIDE BY ZERO?	; V6-27
	CALLSS WRERROR	; YES			; V6-27
	.BYTE 20.,2				; V6-27
	CLR  R					; V6-27
	CLR  AR					; V6-27
DVI1:	MOV  AR,(SS)		; QUOTIENT	; V6-27
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
; CORRECTION	V4-17	1977-06-23	STD
;
;**********************************************
;**********			     **********
;**********	     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
	BIT  #100000,4(SS)				; V4-13
	BEQ  RND1					; V4-13
	BIS  #100000,(SS)	; SET CORRECT SIGN	; V4-13
RND1:	CALLSS   ADDR		;ADD			; V4-13
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


;							; V4-17

;******************************* 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 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


;							; V4-17
;********************************* 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
; CORRECTION	V4-17	1977-06-23	STD
; CORRECTION	V4-41	1977-08-16	OEN
;
;**********************************************
;**********			     **********
;**********	     F  P  P	     **********
;**********			     **********
;********** FLOATING POINT PROCESSOR **********
;**********			     **********
;**********************************************
;
AC0=%0
AC1=%1
AC2=%2
AC3=%3
AC4=%4
AC5=%5
;
;	FOR PDP-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
	BIT  #100000,4(SS)				; V4-13
	BEQ  RND1					; V4-13
	BIS  #100000,(SS)	; SET CORRECT SIGN	; V4-13
RND1:	CALLSS   ADDR		;ADD			; V4-13
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
	LDF   (SS)+,AC0		; GET FLOATING		; V4-41
	STCFI AC0,-(SS)		; CONVERT AND STORE	; V4-41
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)+,AC1				; V4-41
	LDF	(SS)+,AC0				; V4-18, -41
	DIVF	AC1,AC0					; V4-41
	STF	AC0,-(SS)				; V4-41
ENDDVR:	RTS  MP


;							; V4-17

;******************************* 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 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


;							; V4-17
;********************************* FLT ****************************


	;REGISTERS USED: R0, R1, R2


	ROUTINE   FLT   ENDFLT
	LDCIF	(SS)+,AC0	; LOAD INT & CONV 	; V4-41
	STF	AC0,-(SS)	; STORE			; V4-41
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
****
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
****
P11FPPINI.MAC        
	.TITLE	P11INIT	P11V5
; CORRECTION	V4-34
; CORRECTION	V4-40	1977-08-16	OEN
; CORRECTION	V4-50
; CORRECTION	V5-1	1978-05-15	OEN
; CORRECTION	V5-35	1979-06-26	STD
; CORRECTION	V6-4	1979-09-20	STD
; CORRECTION	V6-32	1980-04-15	STD
	.IDENT	/PAS632/
;
;
	.MCALL	FINIT$,SFPA$S,ASTX$S,GTSK$S
;
;
;>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;>>>>>						<<<<<<
;>>>>>		SPECIAL VERSION FOR P11V5	<<<<<<
;>>>>>						<<<<<<
;>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;
;
	ROUTINE	INITA
	FINIT$
	SFPA$S	#FLTAST		; SPECIFY FPP AST ROUTINE
	LDFPS	#7400		; ENABLE UNDERFLOW, OVERFLOW,
				; CONVERSION AND "-0" ERROR INTERRUPT
	SETI			; SET FPP TO SHORT INTEGER
	SETF			; SET FPP TO SHORT FLOATING
	MOV	@MP,SS					; V5-1	; V6-32
	GTSK$S	SS						; V5-1
	MOV	32(SS),SS	; PARTITION SIZE		; V5-1
	SUB	#2,SS		; PONTER TO LAST WORD IN PARTITION  ; V5-1
	MOV	SS,@HP		; - TO MP AT EXIT		; V5-1
FILAREA=FILESIZECORR+TEXTBUFFSIZE+4
	MOV	SS,AD		; CLEAR HEAP AND STACK
	MOV	AD,AR
	SUB	@MP,AR					; V6-32
	ASR	AR		; NO OF WORDS TO CLEAR
	BIC	#100000, AR
1$:	CLR	-(AD)
	DEC	AR
	BGT	1$
	MOV	MP,AD		; RESERV SPACE FOR STANDARD FILES
	TST	(AD)+		; SKIP HEAP ADDRESS	; V6-32
	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	#LUNTABSZ+2,AR	;  LUNTAB		; V5-35
	MOV	@MP,AD	;			; V5-35	; V6-32
6$:	CLR	(AD)+					; V5-35
	DEC	AR
	BGT	6$
	CMP	-(SS),-(SS)	; SPARE			; V6-32
	MOV	@HP,-(SS)	; TASKSIZE		; V6-32
	MOV	#$EXITP,-(SS)	; ADDRESS OF EXIT PROC	; V6-32
	MOV	(MP)+,R		; ADDRESS OF $$HEAP	; V6-32
	MOV	R,-(SS)		; LUNTABPOINTER		; V6-32
	CMP	-(SS),-(SS)	; MARKDDT & DAPDDT	; V6-32
	DEC	@R		; TTYIN NOT AVAILABLE	; V5-35	; V6-32
	DEC	2*TILUN(R)	; TTYOUT NOT AVAILABLE	; V5-35	; V6-32
	MOV	AD,-(SS)	; DAPADDR := HEAP+LUNTAB	; V5-35
	MOV	@SS,-(SS)	; MARKADDR := START ADDR OF STACK
	MOV	#$P.SEL,-(SS)	; OPTION SELECTOR WORD	; V4-34
;				;   ( PRINT WARNINGS )	; V4-34
	CLR	-(SS)		; LINE NUMBER WORD	; V4-34
	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
	MOVB	#40,@(R)	; TTYIN^ := ' '		; V4-50
	MOV	LUNTBP(GP),AD	; AD := LUNTAB-POINTER	; V6-32
	CMP	2(HP),#6	; WHICH FILE
	BNE	TTYOUT
	MOV	R,@AD		; TTYIN			; V5-35	; V6-32
	MOV	#TRUE,EOLNSTATUS(R)
	MOV	#TTY+TEXT+INPUT,FILTYP(R)
	RETURN
;
TTYOUT:	MOV	R,2*TILUN(AD)	; TTYOUT 		; V5-35	; V6-32
	CLR	EOLNSTATUS(R)
	MOV	#TTY+TEXT,FILTYP(R)
	MOV	#TEXTBUFFSIZE,2(R)
;
; WRITE(TTY,'*'); BREAK; READLN(TTY);
;
	RETURN
;
;
;************************************************
;
; PROCEDURE SLCTDF( I: INTEGER );
;
SLCTDF::
	TST	(SS)+		; SKIP LINK
	MOV	(SS)+,SELECTOR(GP)
	RTS	PC
;
;
;
	AC0=%0
;
; FLOATING POINT PROCESSOR AST ROUTINE IS ENTERED
; UPON ERRORS DETECTED BY THE FPP HARDWARE
;
; IT IS ASSUMED THAT FLOATING AC 0 IS USED FOR
; RESULT OF ALL FLOATING OPERATIONS
;
;
; INPUT	 (HP)	ADDRESS OF FPP INSTRUCTION
;	2(HP)	FLOATING EXCEPTION CODE
;
MAXR:	.FLT2	1.701411E38	;MAXREAL
ASTTBL:	.WORD	ASTEND
	.WORD	ASTEND
	.WORD	ASTEND
	.WORD	CNVERR
	.WORD	OVERFL
	.WORD	UNDERFL
	.WORD	MINUS0
	.WORD	ASTEND
;
FLTAST:	TST	(HP)+		; REMOVE FEA
	ADD	#ASTTBL,(HP)	; ADD TABLE ADDR TO INDEX
	MOV	@HP,R0
	JMP	@(R0)		; USE AS POINTER
;
CNVERR:	CALLSS	WRERROR
	.BYTE	33.,1		; FLT TO INTEGER
				; ZERO RETURNED BY HARDWARE
	BR	ASTEND
OVERFL:	CALLSS	WRERROR
	.BYTE	30.,0		; WARNING
	LDF	MAXR,AC0	; RETURN MAXREAL
	BR	ASTEND
UNDERFL: CALLSS	WRERROR
	.BYTE	31.,0		; WARNING
MINUS0:	CLRF	AC0		; RETURN ZERO
ASTEND:	TST	(HP)+		; REMOVE  FEC
	ASTX$S			; RETURN FROM AST
;
;
	.END
****
P11DFAULT.MAC        
	.TITLE	P11DFAULT
;
; DEFAULT VALUES FOR SOME CONSTANTS
;
$P.DEV	=="SY	; DEFAULT DEVICE
$P.UNI	==0	;	= SY0:
;
$P.SEL	==23	; THE SELECTOR WORD IS A BIT PATTERN
;		  GIVING THE RUNTIME BEHAVIOUR
;
;	BIT	MEANING IF  0 / 1
;
;	1	DON'T PRINT / PRINT WARNINGS
;	2	STOP / CONTINUE AFTER WARNING
;	4	STOP / CONTINUE AFTER ERROR
;	10	DON'T PRINT / PRINT CONVERSION ERROR MESSAGES
;	20	DON'T SKIP / SKIP TRAILING BLANKS AFTER
;		READING INTEGERS OR REALS
;
;
	.END
****
P11TRACE.MAC         
	.TITLE	$P.TRC
;
;
	.MCALL	QIO$S,WTSE$S
;
	ROUTINE	P.TRC
	MOV	2(MP),R1	; LINE NO
	MOV	SS,R0
	MOV	#20040,-(R0)
	MOV	#20040,-(R0)
	MOV	#20040,-(R0)
	CLR	R2		; SUPPRESS ZEROES
	CALL	$CBDMG		; CONV BIN TO DEC MAGN
	CLR	R1		; <BUF>
	MOV	SS,R0
	SUB	#6,R0
	INCB	SELECT+1(R3)	; 10 NUMBERS / LINE
	CMPB	SELECT+1(R3),#1
	BEQ	1$		; FIRST NUMBER IN A LINE
	CMPB	SELECT+1(R3),#10.
	BNE	2$		; NOT THE LAST NUMBER
	CLRB	SELECT+1(R3)	; LAST IN A LINE
	MOV	#'+,R1		; <BUF><CR>
	BR	2$
1$:	MOV	#'$,R1		; <LF><BUF>
2$:	QIO$S	#IO.WVB,#5,#5,,,,<R0,#6,R1>
	WTSE$S	#5
	RETURN
;
;
	.END
****
P11FREQV.MAC         
	.TITLE	$P.FRQ
; CORRECTION	V6-32	1980-04-15	STD
	.IDENT	/PAS632/
;
;
	ROUTINE	P.FRQ
	MOV	LUNTBP(GP),AD				; V6-32
	MOV	2(AD),-(SS)	; OUTPUT FILE ID	; V6-32
	BEQ	9$
	MOV	#6,R0		; FETCH FILE NAME
1$:	MOV	(MP)+,-(SS)	; AND LINE ELEMENT POINTER
	DEC	R0
	BGT	1$
	MOV	R3,-(SS)	; LINK
	CALL	PASFQV
	RETURN
;
9$:	ADD	#12.,MP		; SKIP FILE NAME & LINE ELEM
	RETURN
;
;
	.END

****
P11IASRNC.MAC        
	.TITLE	RUNCHK	FOR IAS
; CORRECTION	V4-26	1977-08-08	STD
;
;*****************************************
;**********			**********
;**********	  I A S		**********
;**********			**********
;*****************************************
;
;******************************** 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?
	BHI  OFC0		;YES, CONTINUE		; V4-10
	CALLSS  WRERROR
	.BYTE  10.,1
OFC0:				;CHECK FOR HARDWARE STACKOVFL
	CMP  HP, #20.		; 10 WORDS
	BHI   ENDOFC					; V4-10
	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
SCKL1:	MOV  @SS,-(SS)		; OFFENDING VALUE	; V4-26
	MOV  #1,-(SS)		; 1 PARAM ON STACK
	CALLSS  WRERROR					; V4-26
	.BYTE  12.,200		; PARAMS ON STACK AND WARNING	; V4-26
SCK0:	RTS  MP
SCKL2:	TST  (MP)+		;REMOVE SECOND ARGUMENT
ENDSCK:	BR  SCKL1



	.END
****
PASDDT.MAC           
; CORRECTION	V6-5	1979-09-20	STD
	.IDENT	/PAS605/
	.TITLE	PASDDT
;
;
	.MCALL	SVTK$S
;
; VARIABLES OF DEBUG:
;
GBASIS	=-18.
HEAPBOTTOM =-20.
LBASIS	=-22.
LHEAP	=-24.
LSTACK	=-26.
CAUSE	=-28.
BPLAST  =-30.
BPTABLE =-112.       ; = ADDR(BPTABLE) - 1!
;
;
;
TSKVEC:	.WORD	ODD,MEMPROT,BRK,IOTT,PRIV,EMTT,TRPT,FPP
;
PAS$LD:	.BYTE	3,0
	.RAD50	/PAS$LD/
DBG$LD:	.BYTE	3,0
	.RAD50	/DBG$LD/
HP$LD:	.BYTE	3,0
	.RAD50	/HP$LD/
;
;
; STARTING POINT OF WHOLE TASK
;
DBGENT:
	MOV	#HP$LD,R0
	CALL	$LOAD
	MOV	#PAS$LD,R0
	CALL	$LOAD
	JMP	PAS$IN
;
;
;	ROUTINE	P.DDT
$P.DDT::
;
	SVTK$S	#TSKVEC,#8.
	MOV	GP,GBASIS(GP)
	MOV	MP,-(HP)	; CALLED THROUGH JSR MP,...
	MOV	2(HP),MP
	MOV	DAPADDR(GP),HEAPBOTTOM(GP)
	CLR	AR		; CAUSE = INITC
	BIS	#100000,SELECTOR(GP)			; V6-5
	BR	CONT
;
IOTT:	MOV	#1,AR		; HALTC
	BR	CONT
;
ODD:	MOV	#3,AR		; ODD
	BR	CONT
;
MEMPROT:MOV	#4,AR
	BR	CONT
;
BRK:	MOV	#5,AR
	ADD	#2,(HP)
	BR	CONT
;
PRIV:	MOV	#7,AR
	BR	CONT
;
EMTT:	MOV	#8.,AR
	BR	CONT1
;
TRPT:	MOV	#9.,AR
	MOV	(HP)+,AD	; TRAP NO * 2		; V6-5
        ASR     AD
        ADD     AD,AR
	CMP	AD,#1					; V6-5
        BLT     BRK             ;                       ; V6-5
	BEQ	IOTT		; HALT			; V6-5
	BR	CONT					; V6-5
;
FPP:	MOV	#10.,AR
	BR	CONT
;
;
CONT1:	TST	(HP)+
CONT:	MOV	AR,CAUSE(GP)
	MOV	MP,LBASIS(GP)
	MOV	DAPDDT(GP),LHEAP(GP)
	MOV	SS,LSTACK(GP)
	MOV	LUNTBP(GP),AD				; V6-32
	MOV	2*TILUN(AD),-(SS)		; TTYOUT AS PARAMETER	; V6-32
	MOV	2(AD),-(SS)			; OUTPUT AS PARAMETER	; V6-32
	MOV	GP,-(SS)			; LINK
	MOV	#DBG$LD,R0
	CALL	$LOAD				; LOAD DEBUGGER
	JSR	PC,DEBUG$
	MOV	#PAS$LD,R0
	CALL	$LOAD				; LOAD USER SEGMENT
;
;                                 INSERT BREAK INSTRUCTION IN USER
;                                 SEGMENT FOR ALL ACTIVE BP'S
;
        MOV     GP,AD           ; AD := GP
        ADD     #BPTABLE,AD     ; AD = ADDR(BPTABLE) - 1
        MOV     BPLAST(GP),AR   ; AR := BPLAST
NEXTBP: TST     AR              ; IF AR = 0
        BEQ     BPSSET          ; THEN GOTO BPSSET
        ADD     #4,AD           ; AD := ADDR(BPTABLE[NEXT].CODEADDR)
        MOV     #104400,@(AD)   ; INSERT BREAK INSTR
        DEC     AR              ; AR := AR - 1
        BR      NEXTBP          ; GOTO NEXTBP
BPSSET:                         ; ALL BREAKS SET
;
        CMP     CAUSE(GP),#12.  ; STARTC        (ERIDEBUG)
        BNE     20$             ;               (ERIDEBUG)
        ADD     #4,@HP          ; PC:=PC+4      (ERIDEBUG)
20$:
	CMP	CAUSE(GP),#1			; HALTC
	BLT	30$		; IF INITC
	BEQ	40$		; IF HALTC
	RTI
30$:	RTS	PC
40$:	CALL	$EXITP
;
;
;
SETBR$::
; SET BREAK POINT.
; SEARCH FOR 'LINENR' IN CODE SEGMENT AND INSERT BREAK INSTR.
; 
; INPUT:
;   LINENR
; OUTPUT:
;   RES       = 0 IF OK
;               1 IF LINENR TOO LARGE
;               2 IF LINENR NOT FOUND
;   CODEADDR  = CODE ADDRESS OF BREAK INSTRUCTION
;   LINENR    = UNCHANGED IF RES = 0
;               MAXLINENR IF RES = 1
;               LUB(LINENR) IF RES = 2
;
;
; OFFSET IN LINEELEMENT
LINENO   = 2     ; SOURCE LINE NR
BREAKINST= 6     ; TRAP INSTR. FOR BREAK POINT
PREVLINE = 8.    ; ADDRESS OF PREVIOUS LINEELEMENT
;
; OFFSET FOR GLOBAL VAR 'LASTLINEELEM'
LASTLINE = -16.
;
; STACK ON ENTRY:
; (SS)          : STATLINK (NOT USED)
; 2(SS)         : LOC(RES)
; 4(SS)         : LOC(CODEADDR)
; 6(SS)         : LOC(LINENR)
;
; (SS) NOW USED TO HOLD LOCAL VAR 'OLDLINENR'
;
	MOV #PAS$LD,R0
	CALL $LOAD		   ; LOAD USER PROGRAM
        CLR  (SS)                  ; OLDLINENR := 0
        MOV LASTLINE(GP),AD        ; AD := LASTLINEELEM
        MOV @6(SS),AR              ; AR := LINENR
        MOV LINENO(AD),R           ; R := CURLINENR
        CMP AR,R                   ; IF LINENR <= CURLINENR
        BLE LOOP                   ; THEN GOTO LOOP
        MOV #1,@2(SS)              ; RES := 1 (*TOO LARGE*)
        MOV R,AR                   ; LINENR := CURLINENR
        BR FINISH                  ; GOTO FINISH
LOOP:   CMP R,AR                   ; IF CURLINENR <= LINENR
        BLE CHECK                  ; THEN GOTO CHECK
        MOV R,(SS)                 ; OLDLINENR := CURLINENR
        MOV PREVLINE(AD),AD        ; LINEELEM := LINEELEM^.PREVLINE
        CMP AD,0                   ; IF LINEELEM <> NIL
        BNE 10$                    ; THEN GOTO 10$
        CLR R                      ; CURLINENR := 0
        BR LOOP                    ; GOTO LOOP
10$:    MOV LINENO(AD),R           ; CURLINENR := LINEELEM^.LINENO
        BR LOOP                    ; GOTO LOOP
CHECK:  CMP R,AR                   ; IF CURLINENR = LINENR
        BEQ FOUND                  ; THEN GOTO FOUND
        MOV #2,@2(SS)              ; RES := 2 (*NOT FOUND*)
        MOV (SS),AR                ; LINENR := OLDLINENR
        BR FINISH                  ; GOTO FINISH
FOUND:  MOV #104400,BREAKINST(AD)  ; LINEELEM^.BREAKINST := 104400B
        CLR @2(SS)                 ; RES := 0 (*OK*)
FINISH: TST (SS)+                  ; POP STACK (OLDLINENR)
        TST (SS)+                  ; POP STACK (LOC(RES))
        ADD #BREAKINST,AD           ; AD := ADDR(LINEELEM^.BREAKINST)
        MOV AD,@(SS)+              ; RETURN CODEADDR AND POP STACK
        MOV AR,@(SS)+              ; RETURN LINENR AND POP STACK
	MOV #DBG$LD,R0
	CALL $LOAD		   ; LOAD DEBUGGER
        RTS PC
;
;
;
CLRBR$::
; CANCEL BREAK POINT BY INSERTING THE INSTRUCTION 5727B (TST)
; IN LOCATION 'CODEADDR' OF CODE SEGMENT.
; INPUT PARAM 'CODEADDR' ON STACK.
;
MOV  #PAS$LD,R0
CALL $LOAD		       ; LOAD USER PROGRAM
TST  (SS)+                     ; POP STATLINK OFF STACK
MOV  #5727 , @(SS)+            ; INSERT TST IN LOC 'CODEADDR'
MOV  #DBG$LD,R0
CALL $LOAD		       ; LOAD DEBUGGER
RTS  PC
;
.END	DBGENT
****
P11NOFILE.MAC        
	.TITLE	P11NOFILE	P11V5
; CORRECTION	V5-2	1978-07-12	STD
; CORRECTION	V5-35	1979-06-26	STD
; CORRECTION	V6-32	1980-04-15	STD
; CORRECTION	V6-37	1980-09-23	VERDOES/STD
	.IDENT	/PAS637/
;
	.MCALL	GTSK$S,EXIT$S
;
;
;
	ROUTINE	INITN	
	MOV	@MP,SS					; V6-32
	GTSK$S	SS
	MOV	32(SS),SS	; PARTITION SIZE / 32.
	SUB	#2,SS		; POINTER TO LAST WORD IN PARTITION
	MOV	SS,@HP		; -  TO MP AT EXIT		; V5-2
FILAREA=FILESIZECORR+TEXTBUFFSIZE+4-FDBSIZE
	MOV	SS,AD		; CLEAR HEAP AND STACK
	MOV	AD,AR
	SUB	@MP,AR					; V6-32
	ASR	AR		; NO OF WORDS TO CLEAR
	BIC	#100000,AR
1$:	CLR	-(AD)
	DEC	AR
	BGT	1$
	TST	6(MP)		; TTYIN			; V6-32
	BEQ	2$
	SUB	#2*FILAREA,SS
5$:	MOV	#LUNTABSZ+2,AR	;  LUNTAB		; V5-35	; V6-37
	MOV	@MP,AD		; NEW LUNTAB		; V5-35	; V6-37
6$:	CLR	(AD)+		; CLEAR NEW LUNTAB	; V5-35	; V6-37
	DEC	AR	; V6-37
	BGT	6$	; V6-37
2$:
	CMP	-(SS),-(SS)	; SPARE			; V6-32
	MOV	@HP,-(SS)	; TASKSIZE		; V6-32
	MOV	#$EXITN,-(SS)	; ADDRESS OF EXIT PROC	; V6-32
	MOV	(MP)+,R		; ADDRESS OF $$HEAP	; V6-32
	MOV	R, -(SS)	; LUNTABPOINTER		; V6-32
	CMP	-(SS),-(SS)	; MARKDDT & DAPDDT	; V6-32
	MOV	AD,-(SS)	; DAPADDR := HEAP+LUNTAB ; V5-35
	MOV	@SS,-(SS)	; MARKADDR := START ADDR OF STACK
	MOV	#$P.SEL,-(SS)	; OPTION SELECTOR WORD	; V4-35
;				;   ( PRINT WARNINGS )	; V4-35
	CLR	-(SS)		; LINE NUMBER WORD	; V4-35
	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
	JSR	MP,OPNTTY
	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		; V5-2
	NOP						; V5-2
	RETURN
;
FNAM:	.WORD	NMO,NMI,NMO,NMI
NMI:	.ASCII	/INPUT /
NMO:	.ASCII	/OUTPUT/
	.EVEN
;
;
OPNTTY:
	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
	MOVB	#40,@(R)	; TTYIN^ := ' '		; V4-50
	MOV	LUNTBP(GP),AD	; AD := LUNTAB-POINTER	; V6-32
	CMP	2(HP),#6	; WHICH FILE
	BNE	TTYOUT
	MOV	R,(AD)   	; TTYIN			; V5-35	; V6-32
	MOV	#TRUE,EOLNSTATUS(R)
	MOV	#TTY+TEXT+INPUT,FILTYP(R)
	RETURN
;
TTYOUT:	 MOV	R,2*TILUN(AD)	; TTYOUT		; V5-35	; V6-32
	CLR	EOLNSTATUS(R)
	MOV	#TTY+TEXT,FILTYP(R)
	MOV	#TEXTBUFFSIZE,2(R)	; A FULL LINE LEFT
	RETURN
;
;
;
;
; CORRECTION	V4-44	1977-09-07	STD
; CORRECTION	V4-53	1977-10-13	STD
; CORRECTION	V4-54	1977-10-13	STD
;
; CORRECTION	V5-16	1978-12-29	STD
; CORRECTION	V5-35	1979-06-26	STD
;
;
;
;
;
; EXITN
;
	ROUTINE	EXITN
;
	EXIT$S
;
;
	.END
****
P11INIUNM.MAC        
	.TITLE	P11INITUNMAPPED	P11V5
; CORRECTION	V5-2	1978-07-12	STD
; CORRECTION	V5-35	1979-06-26	STD
; CORRECTION	V6-32	1980-04-15	STD
	.IDENT	/PAS632/
	.SBTTL	INITIALIZATION
;
	.MCALL	FINIT$,GPRT$S
;
;
;>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;>>>>>						<<<<<<
;>>>>>		SPECIAL VERSION FOR P11V5	<<<<<<
;>>>>>						<<<<<<
;>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;
	ROUTINE	INITA	
	FINIT$
	MOV	@MP,SS					; V6-32
	GPRT$S	,SS					; V5-16
	ADD	2(SS),(SS)	; ADD START ADDRESS AND	; V5-16
	MOV	(SS),SS		; PARTITION SIZE	; V5-16
	ASL	SS		; *2			; V5-16
	ASL	SS		; *2			; V5-16
	ASL	SS		; *2			; V5-16
	ASL	SS		; *2			; V5-16
	ASL	SS		; *2			; V5-16
	ASL	SS		; *2			; V5-16
	SUB	#2,SS		; POINTER TO LAST WORD IN PARTITION
	MOV	SS,@HP		; -  TO MP AT EXIT		; V5-2
FILAREA=FILESIZECORR+TEXTBUFFSIZE+4
	MOV	SS,AD		; CLEAR HEAP AND STACK
	MOV	AD,AR
	SUB	@MP,AR					; V6-32
	ASR	AR		; NO OF WORDS TO CLEAR
	BIC	#100000,AR
1$:	CLR	-(AD)
	DEC	AR
	BGT	1$
	MOV	MP,AD		; RESERVE SPACE FOR STANDARD FILES
	TST	(AD)+		; SKIP HEAP ADDRESS	; V6-32
	TST	(AD)+
	BEQ	2$
	SUB	#FILAREA,SS	; INPUT
2$:	TST	(AD)+
	BEQ	3$
	SUB	#FILARE,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	#LUNTABSZ+2,AR	;  LUNTAB		; V5-35
	MOV	@MP,AD	; NEW LUNTAB		; V5-35	; V6-32
6$:	CLR	(AD)+		; CLEAR NEW LUNTAB	; V5-35
	DEC	AR
	BGT	6$
	CMP	-(SS),-(SS)	; SPARE			; V6-32
	MOV	@HP,-(SS)	; TASKSIZE		; V6-32
	MOV	#$EXITP,-(SS)	; ADDRESS OF EXIT PROC	; V6-32
	MOV	(MP)+,R 	; ADDRESS OF $$HEAP	; V6-32
	MOV	R, -(SS)	; LUNTABPOINTER		; V6-32
	CMP	-(SS),-(SS)	; MARKDDT & DAPDDT	; V6-32
	DEC	@R		; TTYIN NOT AVAILABLE	; V5-35	; V6-32
	DEC	2*TILUN(R)	; TTYOUT NOT AVAILABLE	; V5-35	; V6-32
	MOV	AD,-(SS)	; DAPADDR := HEAP+LUNTAB ; V5-35
	MOV	@SS,-(SS)	; MARKADDR := START ADDR OF STACK
	MOV	#$P.SEL,-(SS)	; OPTION SELECTOR WORD	; V4-35
;				;   ( PRINT WARNINGS )	; V4-35
	CLR	-(SS)		; LINE NUMBER WORD	; V4-35
	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		; V5-2
	NOP						; V5-2
	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
	MOVB	#40,@(R)	; TTYIN^ := ' '		; V4-50
	MOV	LUNTBP(GP),AD	; AD := LUNTAB-POINTER	; V6-32
	CMP	2(HP),#6	; WHICH FILE
	BNE	TTYOUT
	MOV	R,@AD		; TTYIN			; V5-35	; V6-32
	MOV	#TRUE,EOLNSTATUS(R)
	MOV	#TTY+TEXT+INPUT,FILTYP(R)
	RETURN
;
TTYOUT:	MOV	R,2*TILUN(AD)	; TTYOUT	; V5-35	; V6-32
	CLR	EOLNSTATUS(R)
	MOV	#TTY+TEXT,FILTYP(R)
	MOV	#TEXTBUFFSIZE,2(R)	; A FULL LINE LEFT
	RETURN
;
;
;************************************************
;
; PROCEDURE SLCTDF( I: INTEGER );			; V5-2
;
SLCTDF::
	TST	(SS)+		; SKIP LINK
	MOV	(SS)+,SELECTOR(GP)
	RTS	PC
;
	.END
****
P11NOFUNM.MAC        
	.TITLE	P11NOFUNM	P11V5
; CORRECTION	V5-2	1978-07-12	STD
; CORRECTION	V5-35	1979-06-26	STD
; CORRECTION	V6-32	1980-04-15	STD
; CORRECTION	V6-37	1980-09-23	VERDOES/STD
	.IDENT	/PAS637/
;
	.MCALL	GPRT$S,EXIT$S
;
;
;
	ROUTINE	INITN	
	MOV	@MP,SS					; V6-32
	GPRT$S	,SS					; V5-16
	ADD	2(SS),(SS)	; ADD START ADDRESS AND	; V5-16
	MOV	(SS),SS		; PARTITION SIZE	; V5-16
	ASL	SS		; *2			; V5-16
	ASL	SS		; *2			; V5-16
	ASL	SS		; *2			; V5-16
	ASL	SS		; *2			; V5-16
	ASL	SS		; *2			; V5-16
	ASL	SS		; *2			; V5-16
	SUB	#2,SS		; POINTER TO LAST WORD IN PARTITION
	MOV	SS,@HP		; -  TO MP AT EXIT		; V5-2
FILAREA=FILESIZECORR+TEXTBUFFSIZE+4-FDBSIZE
	MOV	SS,AD		; CLEAR HEAP AND STACK
	MOV	AD,AR
	SUB	@MP,AR					; V6-32
	ASR	AR		; NO OF WORDS TO CLEAR
	BIC	#100000,AR
1$:	CLR	-(AD)
	DEC	AR
	BGT	1$
	TST	6(MP)		; TTYIN			; V6-32
	BEQ	2$
	SUB	#2*FILAREA,SS
5$:	MOV	#LUNTABSZ+2,AR	;  LUNTAB		; V5-35	; V6-37
	MOV	@MP,AD		; NEW LUNTAB		; V5-35	; V6-37
6$:	CLR	(AD)+		; CLEAR NEW LUNTAB	; V5-35	; V6-37
	DEC	AR	; V6-37
	BGT	6$	; V6-37
2$:
	CMP	-(SS),-(SS)	; SPARE			; V6-32
	MOV	@HP,-(SS)	; TASKSIZE		; V6-32
	MOV	#$EXITN,-(SS)	; ADDRESS OF EXIT PROC	; V6-32
	MOV	(MP)+,R 	; ADDRESS OF $$HEAP	; V6-32
	MOV	R, -(SS)	; LUNTABPOINTER		; V6-32
	CMP	-(SS),-(SS)	; MARKDDT & DAPDDT	; V6-32
	MOV	AD,-(SS)	; DAPADDR := HEAP+LUNTAB ; V5-35
	MOV	@SS,-(SS)	; MARKADDR := START ADDR OF STACK
	MOV	#$P.SEL,-(SS)	; OPTION SELECTOR WORD	; V4-35
;				;   ( PRINT WARNINGS )	; V4-35
	CLR	-(SS)		; LINE NUMBER WORD	; V4-35
	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
	JSR	MP,OPNTTY
	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		; V5-2
	NOP						; V5-2
	RETURN
;
FNAM:	.WORD	NMO,NMI,NMO,NMI
NMI:	.ASCII	/INPUT /
NMO:	.ASCII	/OUTPUT/
	.EVEN
;
;
OPNTTY:
	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
	MOVB	#40,@(R)	; TTYIN^ := ' '		; V4-50
	CMP	2(HP),#6	; WHICH FILE
	BNE	TTYOUT
;;;	MOV	R,$$HEAP	; TTYIN			; V5-35	; V6-32
	MOV	#TRUE,EOLNSTATUS(R)
	MOV	#TTY+TEXT+INPUT,FILTYP(R)
	RETURN
;
TTYOUT:	;;; MOV	R,$$HEAP+<2*TILUN>	; TTYOUT	; V5-35	; V6-32
	CLR	EOLNSTATUS(R)
	MOV	#TTY+TEXT,FILTYP(R)
	MOV	#TEXTBUFFSIZE,2(R)	; A FULL LINE LEFT
	RETURN
;
;
;
;
; CORRECTION	V4-44	1977-09-07	STD
; CORRECTION	V4-53	1977-10-13	STD
; CORRECTION	V4-54	1977-10-13	STD
;
; CORRECTION	V5-16	1978-12-29	STD
; CORRECTION	V5-35	1979-06-26	STD
;
;
;
;
;
; EXITN
;
	ROUTINE	EXITN
;
	EXIT$S
;
;
	.END
****
P11FORFPP.MAC        
	.TITLE	FORTR
; VERSION FOR FPP USERS
; 
; CORRECTION	V6-38	1980-09-23	VERDOES/STD
	.IDENT	/PAS638/
;
;
; 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
	SETF					; V6-38
	SETI					; V6-38
	RETURN
;
	.END
****