NAMES                 
NAMES
P11DEF.MAC
P11ERRMES.MAC
P11INCLUD.MAC
P11INITC.MAC
P11SWITCH.MAC
P11WTT.MAC
RECURSEG.MAC
****
P11DEF.MAC            
	.NLIST
	.NLIST BEX,TOC,SYM
	.IDENT	/PAS501/
	.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
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
LUNTAB	=10.	; LOGICAL UNIT TABLE
;
;
;
; 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
;
;
; MACRO FOR SOB INSTRUCTION
;
	.MACRO	SOB	R, L
	DEC	R
	BNE	L
	.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
****
P11ERRMES.MAC         
	.TITLE	ERRMES
	.IDENT	'791121'
;
	.MCALL	QIO$S,WTSE$S
;
ERRMES::MOV	2(R5),R2
	DEC	R2
	ASL	R2
	ASL	R2
	MOV	ERRTAB(R2),R1
	MOV	ERRTAB+2(R2),R0
2$:	QIO$S	#IO.WVB,#5,#5,,,,<R1,R0,#40>
	WTSE$S	#5
	CALLSS	EXITP
;
ERRTAB:	.WORD	M1,L1
	.WORD	M2,L2
	.WORD	M3,L3
	.WORD	M4,L4
	.WORD	M5,L5
	.WORD	M6,L6
;
M1:	.ASCII	/PAS -- FILE SPECIFICATION ERROR/
L1=.-M1
M2:	.ASCII	/PAS -- FILE NOT FOUND/
L2=.-M2
M3:	.ASCII	/PAS -- SWITCH ERROR/
L3=.-M3
M4:	.ASCII	/PAS -- EOF ENCOUNTERED/
L4=.-M4
M5:	.ASCII	/PAS -- ERROR OPENING OUTPUT FILE/
L5 = .-M5
M6:	.ASCII	'PAS -- I/O ERROR ON OUTPUT'
L6 = .-M6
	.EVEN
;
	.END
****
P11INCLUD.MAC         
	.TITLE	INCLUDE
;
;
	.MCALL	OPEN$R,FDOF$L,OFID$,CLOSE$
;
	FDOF$L
;
; OPEN ( VAR F: TEXT;  STRING NAM,DIR,DEV );
;
OPEN::	TST	(SS)+		; SKIP LINK
	MOV	12.(SS),AR	; FILE ID
	SUB	#FILESIZE,AR	; FDB
	CLOSE$	R0
	OPEN$R	R0,,SS
	ADD	#14.,SS
	RTS	PC
;
;
; SAVEFDB ( VAR FDB: TEXTFDB;  VAR : TEXT;  FN: STR20 );
;
SAVEFDB::
	TST	(SS)+		; SKIP LINK
	MOV	2(SS),R		; FILE ID
	MOV	F.URBD-FILESIZE+2(R),AD	; USER RECORD BUFFER
	MOV	2(R),AR		; NUMDER OF REMAINING CHARS
	MOV	@R,R		; CURRENT RECORD POINTER
1$:	MOVB	(R)+,(AD)+	; MOV BUFFER CONTENTS
	DEC	AR
	BGT	1$
	MOV	4(SS),R		; SAVE AREA
	MOV	2(SS),AD	; FILE ID
	MOV	AD,-(HP)	; SAVE FILE ID 
	MOV	F.URBD-FILESIZE+2(AD),@AD  ; NEW BUFFER
	CLR	-(SS)		; SAVEFDB
	BR	TRFR
;
;
; UNSAVEFDB ( VAR F: TEXT;  VAR FDB: TEXTFDB );
;
UNSAVEFDB::
	TST	(SS)+		; SKIP LINK
	MOV	(SS)+,AD	; SAVE AREA
	MOV	(SS),R		; FILE ID
	MOV	R,AR
	SUB	#FILESIZE,AR
	CLOSE$	R0
	MOV	#TRUE,EOLNSTATUS(R)
	MOV	#FALSE,EOFSTATUS(R)
TRFR:	SUB	#FILESIZE-F.FNB,AD
	SUB	#FILESIZE-F.FNB,R
	MOV	#15.,AR		; SIZE OF FILENAME BLOCK
1$:	MOV	(AD)+,(R)+	; SAVE FILE DESCR
	DEC	AR
	BGT	1$
	TST	(SS)+
	BEQ	9$		; SAVEFDB
	MOV	R,AR
	SUB	#96.,AR		; POINT TO FDB
	OFID$	R0
	MOV	R3,-(HP)
	MOV	(AD)+,R1
	MOV	(AD)+,R3
	MOV	(AD)+,R2
	CALL	.POINT
	MOV	F.NRBD+2(AR),AD
	MOV	-(AD),F.NRBD(AR)
	MOV	(HP)+,R3
	RTS	PC
9$:	MOV	R4,-(SS)
	MOV	R3,-(SS)
	MOV	R1,-(SS)
	MOV	AD,AR
	SUB	#96.,AR		; POINT TO FDB
	CALL	.MARK
	MOV	(SS)+,R4
	MOV	R1,(R4)+
	MOV	R3,(R4)+
	MOV	R2,(R4)+
	MOV	(SS)+,R3
	MOV	(SS)+,R4
	MOV	2(SS),R		; FILE ID
	MOV	@R,-(SS)	; POINTER TO NEXT CHAR
	DEC	@SS		; ARRAY [1..
	MOV	2(R),-(SS)	; LEN
	MOV	GP,-(SS)	; LINK
	CALL	NEWSOURCE
	MOV	@SS,AD		; SAVE AREA ADDRESS
	MOV	(HP)+,R		; FILE ID
	TSTB	F.ERR-FILESIZE(R)
	BGE	10$		; IF OK
	CLR	F.FNB-FILESIZE(AD)	; SIGNAL TO OPTION INCLUDE
	BR	TRFR		; UNSAVE
10$:	TST	(SS)+		; SKIP SAVE AREA ADDRESS
	RTS	PC
;
;
	.END
****
P11INITC.MAC          
	.TITLE	P11INITC	;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
	.IDENT	'791012'
 
	.SBTTL	INITIALIZATION
;
	.MCALL	FINIT$,GTSK$S
;
;
;>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;>>>>>						<<<<<<
;>>>>>	SPECIAL VERSION FOR P11V5 COMPILER	<<<<<<
;>>>>>						<<<<<<
;>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;
	ROUTINE	INITA	
	FINIT$
	MOV	#$$HEAP,SS
	GTSK$S	SS
	MOV	32(SS),SS	; PARTITION SIZE
	SUB	#2,SS		; POINTER TO LAST WORD IN PARTITION
 
FILAREA=FILESIZECORR+TEXTBUFFSIZE+4
 
	MOV	SS,AD		; CLEAR HEAP AND STACK
	MOV	AD,AR
	SUB	#$$HEAP,AR
	ASR	AR		; NO OF WORDS TO CLEAR
	BIC	#100000, AR	; TO CLEAR HEAP LONGER THAN 16K
1$:	CLR	-(AD)
	SOB	AR, 1$
	MOV	MP,AD		; RESERV SPACE FOR STANDARD FILES
	TST	(AD)+
	BEQ	2$
	SUB	#FILAREA,SS	; OUTPUT
2$:	TST	(AD)+
	BEQ	3$
	SUB	#FILARE,SS	; INPUT
3$:	TST	(AD)+
	FILAREA=FILAREA-FDBSIZE
	BEQ	4$
	SUB	#FILAREA,SS	; TTYOUT
4$:	TST	(AD)+
	BEQ	5$
	SUB	#FILAREA,SS	; TTYIN
5$:	MOV	#MAXFILES+2,AR	;  LUNTAB
6$:	CLR	-(SS)		; CLEAR LUN TABLE
	SOB	AR, 6$
	DEC	@SS		; TTYIN NOT AVAILABLE
	DEC	2*TILUN(SS)	; TTYOUT NOT AVAILABLE
	MOV	#$$HEAP,-(SS)	; DAPADDR := START ADDR OF STACK
	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	MP,2(HP)	; RETURN FROM $$AUTP
	MOV	GP,MP		; INIT MP
	RTS	PC
;>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<
;
FSTOPN:	.WORD	$REWRITE,$RESET,OPNTTY,OPNTTY
FNAM:	.WORD	NMO,NMI,NMO,NMI
NMI:	.ASCII	/INPUT /
NMO:	.ASCII	/OUTPUT/
	.EVEN
;
;
OPNTTY:	ADD	#16.,SS		; SKIP FILE SPEC
	MOV	(SS)+,R		; FILE POINTER
	CLR	EOFSTATUS(R)	; FALSE
	MOV	#1,IORESULT(R)	; OK
	MOV	R,@R
	SUB	#FILESICORR+TEXTBUFFSIZE-FDBSIZE,@R
	CLR	2(R)		; NO CHAR'S
	CMP	2(HP),#6	; WHICH FILE
	BNE	TTYOUT
	MOV	R,LUNTAB(GP)	; TTYIN
	MOV	#TRUE,EOLNSTATUS(R)
	MOV	#TTY+TEXT+INPUT,FILTYP(R)
	RETURN
;
TTYOUT:	MOV	R,LUNTAB+<2*TILUN>(GP)	; TTYOUT
	CLR	EOLNSTATUS(R)
	MOV	#TTY+TEXT,FILTYP(R)
	RETURN
	.END
****
P11SWITCH.MAC         
	.TITLE	P11SWITCH
	.IDENT	'791004'
	.PSECT	SWCHIN
;
SWCHIN::
;
	.WORD	3	; /A3	DEFLEVEL
	.WORD	55.	; /P55	PAGEWIDTH
	.WORD	132.	; /L132	LINEWIDTH
	.WORD	0	; /E-	EXTSET
	.WORD	0	; /G-	FLTSET
	.WORD	0	; /F-	FPPUNIT
	.WORD	1	; /L+	LIST
	.WORD	0	; /C-	PRCODE
	.WORD	0	; /X-	CONDCOMP
	.WORD	1	; /W+	WARNINGS
	.WORD	1	; /R+	RUNTMCHECK
	.WORD	1	; /T+	HEAPCHECK
	.WORD	1	; /M+	MAIN
	.WORD	0	; /Y-	PSECTGEN
	.WORD	0	; /S-	TRACE
	.WORD	0	; /D-	DEBUG
	.WORD	0	; /Q-	FREQUENCE
;
;
SWITCHINIT::
	MOV	PC,R1
	CMP	(R5)+,-(R1)	; SKIP LINK AND MOV INSTR
	MOV	#17.,R0
1$:	MOV	-(R1),@(R5)+
	DEC	R0
	BGT	1$
	RTS	PC
;
	.END
****
P11WTT.MAC            
	.TITLE	P11WTT
	.IDENT	'791104'
;
BUFF:	.BLKB	132.
EOLN:	.WORD	FALSE
EOF:	.WORD	FALSE
IORES:	.WORD	1	;OK
FILETP:	.WORD	TEXT+TTY
TT:	.WORD	BUFF	; TTY^
CNT:	.WORD	132.
;
;
WTTINT::
	MOV	#TT,-(SS)	; WRITE( TTY, N:5 )
	MOV	4(SS),-(SS)
	MOV	#5,-(SS)
	CALLSS	WRI
	ADD	#4,SS
	RTS	PC
;
;
;
WTTERR::
 
	; WRITELN (TTY, CURRENT LINE FROM FILE INPUT);
	;
	; FILE INPUT IS ASSUMED HERE TO ALWAYS BE
	; ASSIGED TO LUN 2.
 
	MOV	LUNTAB+4(GP), R0	; ADDR OF FILE ON LUN 2
	ADD	#FDB, R0		; OFFSET TO FILE'S FDB
	MOV	F.NRBD(R0), R1		; CURRENT RECORD SIZE
	MOV	F.NRBD+2(R0), R0	; CURRENT RECORD ADDR
 
	MOV	#TT, -(SS)		; WRITE (TTY,
	MOV	R0, -(SS)		;        'SOURCE LINE');
	MOV	R1, -(SS)
	MOV	(SS), -(SS)
	CALLSS	WRS
	CALLSS	PUTLN			; WRITELN (TTY);
 
	MOV	#TT,-(SS)	; WRITE( TTY,
	MOV	#ERRMESS,-(SS)	;     'ERROR IN LINE ',
	MOV	#14.,-(SS)
	MOV	@SS,-(SS)
	CALLSS	WRS
	MOV	4(SS),-(SS)	;     N:6'
	MOV	#6,-(SS)
	CALLSS	WRI
	MOV	#':,-(SS)	;     ':' ) ;
	MOV	#1,-(SS)
	CALLSS	WRCHA
	ADD	#4,SS
	RTS	PC
;
;
;
WTTEOL::
	MOV	#TT,-(SS)	; WRITELN( TTY ) ;
	CALLSS	PUTLN
	ADD	#2,SS
	RTS	PC
;
;
; PROC WTTHEAD( VAR HDR,DAY,TIM: ALFA );
;
WTTHEA::
	MOV	#TT,-(SS)	; WRITELN( TTY,
	MOV	#HEAD,-(SS)	;     'PASCAL  PDP-11  VERSION ',
	MOV	#24.,-(SS)
	MOV	@SS,-(SS)
	CALLSS	WRS
	MOV	8.(SS),-(SS)	;	HDR ) ;
	INC	@SS
	MOV	#10.,-(SS)
	MOV	@SS,-(SS)
	CALLSS	WRS
	CALLSS	PUTLN
	MOV	2(SS),@SS	;  
	CALLSS	TIME
	MOV	2(SS),-(SS)
	CALLSS	DATE
	MOV	#TT,-(SS)	; WRITELN(TTY,
	MOV	4(SS),-(SS)	;	DAY,
	INC	@SS
	MOV	#10.,-(SS)
	MOV	@SS,-(SS)
	CALLSS	WRS
	MOV	2(SS),-(SS)	;	TIM );
	INC	@SS
	MOV	#12.,-(SS)
	MOV	#8.,-(SS)
	CALLSS	WRS
	CALLSS	PUTLN
	CMP	(SS)+,(SS)+
	TST	(SS)+
	RTS	PC
;
;
;   PROCEDURE  WTTSTAT( E:BOOLEAN; P,D,DD,T: INTEGER ) ;
;
WTTSTAT::
	MOV	#TT,-(SS)	; WRITELN( TTY,
	TST	12.(SS)
	BEQ	1$
	MOV	#"**,ERRM2
1$:	MOV	#ERRM2,-(SS)	;     '** ERROR DETECTED' ) ;
	MOV	#17.,-(SS)
	MOV	@SS,-(SS)
	CALLSS	WRS
	CALLSS	PUTLN
	MOV	#TT,-(SS)	; WRITELN( TTY,
	MOV	#STAT1,-(SS)	;     'TOTAL PROGRAM SIZE: ',
	MOV	#28.,-(SS)
	MOV	@SS,-(SS)
	CALLSS	WRS
	MOV	10.(SS),-(SS)	;     P:7:O ) ;
	MOV	#7,-(SS)
	CALLSS	WROCT
	CALLSS	PUTLN
	MOV	#TT,-(SS)	; WRITELN( TTY,
	MOV	#STAT2,-(SS)	;     'OUTERMOST DATA SIZE: ',
	MOV	#28.,-(SS)
	MOV	@SS,-(SS)
	CALLSS	WRS
	MOV	6.(SS),-(SS)	;     DD:7:O ) ;
	MOV	#7,-(SS)
	CALLSS	WROCT
	CALLSS	PUTLN
	MOV	#TT,-(SS)	; WRITELN( TTY,
	MOV	#STAT3,-(SS)	;     'RESERVED STACK & HEAP SIZE: ',
	MOV	#28.,-(SS)
	MOV	@SS,-(SS)
	CALLSS	WRS
	MOV	8.(SS),-(SS)	;     D:7:O ) ;
	MOV	#7,-(SS)
	CALLSS	WROCT
	CALLSS	PUTLN
	MOV	#TT,-(SS)	; WRITELN( TTY,
	MOV	#RUNTM,-(SS)	;     'RUNTIME: ',
	MOV	#9.,-(SS)
	MOV	@SS,-(SS)
	CALLSS	WRS
	MOV	4(SS),-(SS)	;     T:8,
	BGE	2$
	ADD	#28800.,(SS)	; (* 8 HOUR WRAP AROUND *)
2$:	MOV	#8.,-(SS)
	CALLSS	WRI
	MOV	#SEC,-(SS)	;     '  SECONDS' ) ;
	MOV	#9.,-(SS)
	MOV	@SS,-(SS)
	CALLSS	WRS
	CALLSS	PUTLN
	ADD	#12.,SS
	RTS	PC
;
ERRMESS: .ASCII	/ERROR IN LINE /
HEAD:	.ASCII	/PASCAL  PDP-11  VERSION /
	.EVEN
ERRM2:	.ASCII	/NO ERROR DETECTED/
STAT1:	.ASCII	/TOTAL PROGRAM SIZE:         /
STAT2:	.ASCII	/OUTERMOST DATA SIZE:        /
STAT3:	.ASCII	/RESERVED STACK & HEAP SIZE: /
RUNTM:	.ASCII	/RUNTIME: /
SEC:	.ASCII	/  SECONDS/
	.EVEN
;
;
	.END
****
RECURSEG.MAC          
	.LIST	TTM
 
	.TITLE	RECURSEG	RECURSIVE SEGMENT ALLOCATION
	.IDENT	'791120'
 
	.NLIST	BEX,SYM,TOC
 
 
	.PSECT	$$AUTP	; TO ASSURE ALLOCATION IMMEDIATELY
			; AFTER $$AUTO
 
;
;  THIS ROUTINE IS ACCESSED BY A BRANCH INSTRUCTION PATCHED INTO
; THE SYSTEM OVERLAY AUTOLOAD ROUTINE, AUTO. THE PATCH MUST BE
; DONE AT TASK BUILD TIME:
;
;	GBLPAT = ROOT:$AUTO+34:435    ; BR SEGENT
;
;
;  THIS BRANCH WILL ONLY BE EXECUTED WHEN AUTO HAS DETERMINED THAT
; A SEGMENT READ IS REQUIRED.  UPON BRANCHING TO SEGENT, THE STACK
; AND REGISTERS ARE AS FOLLOWS:
;
;	SP+14 = RETURN TO ORIGINAL CALLER
;	SP+12 = ADDRESS OF 2 WORD AUTOLOAD PACKET
;	SP+10 = SAVED R5
;	SP+06 = SAVED R4
;	SP+04 = SAVED R3
;	SP+02 = RETURN TO REGISTER RESTORE ROUTINE ($SAVRG)
;	SP+00 = SAVED R2
;
;	(R5)  = ENTRY POINT OF CALLED ROUTINE
;	R2    = ADDRESS OF SEGMENT DESCRIPTOR OF CALLED ROUTINE
;
;
;  THE SEGMENT DESCRIPTOR ADDRESS IS THEN SAVED ON A PRIVATE STACK
; AND THE STACK IS ADJUSTED SO THAT WHEN THE SEGMENT READ IS COMPLETE
; CONTROL WILL BE TRANSFERED TO SEGEXIT.
;
;  AT THIS POINT A CALL IS EXECUTED TO THE CALLED ROUTINE ENTRY POINT.
; IN THIS WAY, WE WILL REGAIN CONTROL WHEN THE ROUTINE RETURNS.
;
;  FINALLY, THE PRIVATE STACK IS ACCESSED TO SEE IF THIS CALL HAS
; CAUSED AN OVERLAY OF THE SEGMENT, IF ANY, THAT WAS IN MEMORY
; BEFORE THE CALL WAS ISSUED.  IF NECESSARY, THE OLD SEGMENT(S)
; WILL BE RE-LOADED.  THIS IS DONE HERE BY PUTTING APPROPRIATE
; DATA ON THE STACK AND IN R2 AND JUMPING TO $AUTO+40 IN THE AUTO
; ROUTINE.
;
;  NOTE THAT THIS FACILITY ONLY WORKS WHEN THE CALLED ROUTINE IS
; BEING ACCESSED VIA A JSR PC INSTRUCTION.
;
;

SEGENT:
	MOV	(R5),ENTRYP	; SAVE ENTRY POINT
	MOV	#SEGEXIT,12(SP)
	SUB	#2,SEGP		; POINTER IN SEGMENT ID STACK
	CMP	SEGP,#SEGP	; WATCH FOR STACK OVERFLOW
	BEQ	99$
	MOV	R2,@SEGP	; SAVE POINTER TO SEGMENT DESCR TABLE
	JMP	$AUTO+40	; READ SEGMENTS. WHEN DONE, CONTROL
				; IS TRANSFERRED TO SEGEXIT
99$:	CALLSS	WRERROR
	.BYTE	70.,1
 
 
SEGEXIT:
	CALL	@ENTRYP		; CALL THE WANTED ROUTINE.
;
; PASCAL NEVER USES THE R6 STACK, SO THE EXTRA RETURN ADDRESS
; DOESN'T DO ANY HARM.
;
	JSR	R5,$SAVRG	; RECONSTRUCT STACK
	MOV	R2,-(SP)	; SAVE R2
	ADD	#2,SEGP		; SKIP THE SEGMENT JUST USED
	MOV	@SEGP,R2	; DESCRIPTOR FOR OLD SEGMENT
	BEQ	9$		; NO OLD SEG
	BIT	#10000,(R2)	; SEGMENT ALREADY THERE ?
	BEQ	9$		; YES
	JMP	$AUTO+40
 
9$:	MOV	(SP)+,R2	; RESTORE R2
	RTS	PC
 
 
	.PSECT	$SEGST
;
ENTRYP:	.WORD	0
SEGP:	.WORD	SEGSTND
SEGSTK:	.BLKW	100	; SEGMENT DESCRIPTOR STACK
SEGSTND:.WORD	0
 
 
	.END
****