NAMES                 
NAMES
P11DEF.MAC
P11ERRMES.MAC
P11INCLUD.MAC
P11INITC.MAC
P11SELECT.MAC
P11SWITCH.MAC
P11WTT.MAC
RECUR1.MAC
RECUR2.MAC
****
P11DEF.MAC            
	.NLIST
	.NLIST BEX,TOC,SYM
	.IDENT	/PAS6.3/
	.PSECT	PASRUN
;
; This assembly prefix file contains definitions and macros
; used by all runtime routines and by special macro routines
; of the compiler.
;
; SEVED TORSTENDAHL   1976-10-19
; Gerry Pelletier     1984-12-30
;
;
;
; The runtime support routines for Pascal are all assembled under
; psect PASRUN.
;
; All runtime support routines are called via a JSR R4 instruction
; either directly by Pascal programs or by other PASRUN routines.
;
;
;
;
;	Local constants
;
LUN1=1
LUN2=2
LUN3=3
LUN4=4
LUN5=5
LUN6=6
TILUN=5
;
;
MAXFILES=16.		; MAX NUMBER OF FILES
BUFLEN=132.		; MAX RECORD SIZE FOR TEXT FILES
;
FF=14
LF=12
CR=15
HT=11
SPC=40
;
FALSE=0
TRUE=1
;
;
;
; Offsets for hidden global variables    (GP relative offsets)
;
LINEADDR=2	; CURRENT STATEMENT LINENUMBER
SELECTOR=4	; DYNAMIC OPTION SWITCH WORD
MARKADDR=6.	; MARKPOINTER
DAPADDR	=8.	; DYNAMIC AREA POINTER
MARKDDT	=10.	; MARKPOINTER USING DDT
DAPDDT	=12.	; LAST DEBUG ENTRY IN THE HEAP
EXITP	=14.	; POINTER TO EXIT ROUTINE
HEAPBOT	=16.	; ADDRESS OF FIRST WORD OF HEAP
LUNTBL  =18.	; LUN TABLE FOR PASCAL FILES
;
;
;
; 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
ERPARM =100000
;
;
;
; Register definitions
;
AR	=%0	; GENERAL PURPOSE REGISTER
R	=%1	;     -     ''	     -
AD	=%2	;     -	    ''	     -
GP	=%3	; GLOBAL  STACK FRAME BASE POINTER
MP	=%4	; CURRENT STACK FRAME BASE POINTER
SS	=%5	; SOFTWARE STACK
HP	=%6	; HARDWARE STACK
;
;
;
;
;
; Definition of hidden part of file declaration
;
FILESIZECORR	=104.
TEXTBUFFSIZE	=132.
FDBSIZE		=96.
FDB		=-104.
EOLNSTATUS	=-8.
EOFSTATUS	=-6
IORESULT	=-4
FILTYP		=-2
;
;
; Bit definitions for the IOSPEC parameter
;
RANDOM	=1
UPDATE	=2
APPEND	=4
TEMPORARY=10
INSERT	=20
SHARED	=40
SPOOL	=100
BLKMODE	=200
NOCR	=400
FDFTN	=1000
; HIDDEN BITS
GENERATE=10000	; Generation file mode (dynamic)
TTY	=20000
TEXT	=40000
INPUT	=100000
;
;
;
;
; Macro for subroutine call
;
	.MACRO	CALLSS	RTR,ENDRTR
	JSR	MP,$'RTR
	.ENDM
;
;
; Macro for subroutine return
;
	.MACRO	RETURN
	RTS	MP
	.ENDM
;
;
;
; Macro for routine entry
;
	.MACRO	ROUTINE	RTR,ENDRTR
$'RTR::
	.ENDM
 
 
; Macro for SOB instruction
;	Emulate SOB instruction for processsors that don't have it.
;
	.MACRO	SOB	R, L
	DEC	R
	BNE	L
	.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
;
;
;
;
	.LIST
****
P11ERRMES.MAC         
	.TITLE	ERRMES
	.IDENT	'810816'
 
; CORRECTION  GP-V6:42	1980-06-04	GP
; CHANGE      GP-V6:86	1981-08016	GP
;
	.MCALL	QIO$S,WTSE$S
;
ERRMES::MOV	2(SS),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
	MOV	#EX$ERR,-(SS)		; ERROR EXIT STATUS
	JMP	@EXITP(GP)		; EXIT
;
ERRTAB:	.WORD	M1,L1
	.WORD	M2,L2
	.WORD	M3,L3
	.WORD	M4,L4
	.WORD	M5,L5					; GP-V6:42
	.WORD	M6,L6					; GP-V6:42
;
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/	; GP-V6:42
L5 = .-M5
M6:	.ASCII	'PAS -- I/O ERROR ON OUTPUT'		; GP-V6:42
L6 = .-M6
	.EVEN
;
	.END
****
P11INCLUD.MAC         
	.TITLE	INCLUDE
	.IDENT	'810906'
;
; CORRECTION  GP-V6:77	1981-09-06
;
 
	.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),R0	; FILE OBJECT
	ADD	#FDB,R0		; FDB
	CLOSE$	R0
	OPEN$R	R0,,SS
	ADD	#14.,SS		; REMOVE PARAMETERS
	RTS	PC		; RETURN
 
;
; SAVEFDB ( VAR FDB: TEXTFDB;  VAR F: TEXT;  FN: STR20 );
;
SAVEFDB::
	TST	(SS)+		; SKIP LINK
	MOV	2(SS),R1	; FILE OBJECT: F
 
 
; MOVE REMAINDER OF CURRENT LINE OF FILE F TO ITS USER RECORD BUFFER
; WITHIN THE FILE OBJECT STRUCTURE.
 
	MOV	FDB+F.URBD+2(R1),R2  ; USER RECORD BUFFER
	MOV	2(R1),R0	; NUMDER OF REMAINING CHARS
	MOV	@R1,R1		; CURRENT RECORD POINTER
1$:	MOVB	(R1)+,(R2)+	; MOV BUFFER CONTENTS
	SOB	R0,1$
 
	MOV	4(SS),R1	; POINT R1 TO SAVE AREA
	MOV	2(SS),R2	; FILE OBJECT ADDRESS
	MOV	R2,-(HP)	; SAVE FILE OBJECT ADDRESS
	MOV	FDB+F.URBD+2(R2),@R2  ; NEW BUFFER
	CLR	-(SS)		; SAVEFDB
	BR	TRFR		; BR TO COMMON CODE
 
;
; UNSAVEFDB ( VAR F: TEXT;  VAR FDB: TEXTFDB );
;
UNSAVEFDB::
	TST	(SS)+		; SKIP LINK
	MOV	(SS)+,R2	; SAVE AREA
	MOV	(SS),R1		; FILE OBJECT
	MOV	R1,R0
	ADD	#FDB,R0		; POINT TO FDB WITHIN FILE OBJECT
	CLOSE$	R0		; CLOSE CURRENT FILE (IF OPEN)
	MOV	#FALSE,EOFSTATUS(R1) ; EOF(F) := FALSE
 
 
; COMMON CODE
 
TRFR:	ADD	#FDB+F.FNB,R2
	ADD	#FDB+F.FNB,R1
	MOV	#15.,R0		; SIZE OF FILENAME BLOCK
1$:	MOV	(R2)+,(R1)+	; SAVE/UNSAVE FILENAME BLOCK INFO
	SOB	R0,1$
	TST	(SS)+
	BEQ	9$		; BR IF SAVEFDB
 
 
; CONTINUE UNSAVEFDB
 
	MOV	R1,R0
	SUB	#FDBSIZE,R0	; POINT TO FDB
	OFID$	R0		; RE-OPEN BY FILE ID.
	MOV	R3,-(HP)	; SAVE R3
	MOV	(R2)+,R1	; RECOVER FILE POSITION FROM SAVE AREA
	MOV	(R2)+,R3
	MOV	(R2)+,R2
	CALL	.POINT		; RE-POSITION FILE
	MOV	F.NRBD+2(R0),R2	; CURRENT RECORD ADDRESS
	MOV	-(R2),F.NRBD(R0); RESTORE RECORD LENGTH (ASSUME VAR REC FILE)
	MOV	(HP)+,R3	; RESTORE R3
	RTS	PC		; RETURN
 
 
; CONTINUE SAVEFDB
 
9$:	MOV	R4,-(SS)	; SAVE R4
	MOV	R3,-(SS)	; SAVE R3
	MOV	R1,-(SS)	; SAVE SAVE AREA POINTER
	MOV	R2,R0
	SUB	#FDBSIZE,R0	; POINT TO FDB
	CALL	.MARK		; OBTAIN CURRENT FILE POSITION
	MOV	(SS)+,R4	; SAVE AREA POINTER
	MOV	R1,(R4)+	; SAVE FILE POSITION IN SAVE AREA
	MOV	R3,(R4)+
	MOV	R2,(R4)+
	MOV	(SS)+,R3	; RESTORE R3
	MOV	(SS)+,R4	; RESTORE R4
 
 
; STACK CURRENTLY HAS ADDRESSES OF PARAMETERS 'F' AND 'FN',
; PREPARE REMAINING PARAMETERS TO CALL NEWSOURCE:
;
;   NEWSOURCE ( VAR F: TEXT;          VAR FN: STR20;
;		VAR FLINE: LINEBUFF;  FLEN: INTEGER );
 
	MOV	2(SS),R1	; FILE OBJECT: F
	MOV	@R1,-(SS)	; POINTER TO NEXT CHAR
	DEC	@SS		; ARRAY [1..
	MOV	2(R1),-(SS)	; FLEN
	MOV	GP,-(SS)	; LINK
	CALL	NEWSOURCE
 
 
	MOV	(HP)+,R1	; FILE OBJECT
	TSTB	FDB+F.ERR(R1)	; CHECK FCS ERROR STATUS
	BGE	10$		; IF OK
	MOV	#TRUE,EOFSTATUS(R1) ; SIGNAL TO OPTION INCLUDE
10$:	TST	(SS)+		; SKIP SAVE AREA ADDRESS
	RTS	PC		; RETURN
 
	.END
****
P11INITC.MAC          
	.TITLE	P11INITC       
	.IDENT	'810813'
 
; CORRECTION	V5-3	1978-06-01	STD
; CORRECTION	V5-35	1979-06-26	STD
; CHANGE      GP-V6:14  1980-06-06	GP
; CHANGE      GP-V6:44	1980-06-06	GP
; CORRECTION  GP-V6:45	1980-06-24	GP
; CHANGE      GP-V6:86	1981-08-13	GP
; CHANGE      GP-V6:88	1981-08-13	GP
 
	.MCALL	FINIT$,GTSK$S
 
 
 
	ROUTINE	INITA	; PASCAL RUNTIME INITIALIZATION
 
;  *****************************************************************
;  **								  **
;  **	SPECIAL PASCAL INITIALIZATION ROUTINE FOR COMPILER ONLY   **
;  **								  **
;  *****************************************************************
;
;
;  INPUT:
;	 (MP)	ADDR OF FILE OUTPUT (GP RELATIVE)
;	2(MP)	ADDR OF FILE INPUT	"
;	4(MP)	ADDR OF FILE TTY (OUT)	"
;	6(MP)	ADDR OF FILE TTYIN	"
;
;	REGISTER R = ADDR OF BOTTOM OF HEAP    (=$$HEAP)
;
;
 
 
FILAREA = FILESIZECORR + TEXTBUFFSIZE + 4	; FOR NORMAL FILES
 
TTYFILAREA = FILAREA - FDBSIZE		; TTY FILES DONT HAVE FDB
 
 
	FINIT$			; INITIALIZE FCS
 
	MOV	R,SS
	GTSK$S	SS
	MOV	32(SS),SS	; PARTITION SIZE
 
 
; RESERVE SPACE FOR STANDARD FILES
 
	MOV	MP,AD
	TST	(AD)+
	BEQ	2$
	SUB	#FILAREA,SS	; OUTPUT
2$:	TST	(AD)+
	BEQ	3$
	SUB	#FILARE,SS	; INPUT
3$:	TST	(AD)+
	BEQ	4$
	SUB	#TTYFILAREA,SS	; TTYOUT
4$:	TST	(AD)+
	BEQ	5$
	SUB	#TTYFILAREA,SS	; TTYIN
5$:
 
 
; ALLOCATE AND INITIALIZE LUN TABLE
 
	MOV	#MAXFILES+1,AD	; NUMBER OF LUN TABLE ENTRIES
7$:	CLR	-(SS)		; ZERO FOR ALL NON-TTY FILES
	SOB	AD,7$		; LOOP
	DEC	(SS)		; TTYIN NOT AVAILABLE
	DEC	<2*TILUN>(SS)	; TTYOUT NOT AVAILABLE
 
 
; INITIALIZE HIDDEN GLOBAL VARIABLES
 
	MOV	R,-(SS)		; HEAPBOT := ADDRESS OF FIRST WORD OF HEAP
	MOV	#$EXITP,-(SS)	; EXITP := ADDRESS OF STANDARD EXIT ROUTINE
	CLR	-(SS)		; DAPDDT
	CLR	-(SS)		; MARKDDT
	MOV	R,-(SS)		; DAPADDR := BOTTOM OF HEAP
	MOV	R,-(SS)		; MARKADDR := BOTTOM OF HEAP
	MOV	#$P.SEL,-(SS)	; SELECTOR := DEFAULT DYNAMIC OPTIONS
	CLR	-(SS)		; LINEADDR
	TST	-(SS)		; RESERV SPACE FOR
	MOV	SS,@SS		;   STATIC LINK
	MOV	SS,GP
 
 
; OPEN STANDARD FILES:
;
;   DO THE USUAL FOR TTYIN AND TTYOUT,
;   MAKE FILE INPUT LOOK LIKE AN EMPTY FILE,
;   SET FILE OUTPUT SO THAT ANY PUTS DONE TO IT WILL CAUSE ERROR
;
	MOV	#-2,AR		; COUNTER
NEW:	ADD	#2, AR		; INDEX TO FNAM & OPEN-ROUTINE
	MOV	(MP)+,AD	; GP RELATIVE ADDR OF FILE
	BEQ	NEXT
	ADD	GP,AD		; ABSOLUTE ADDR OF FILE
	CLR	2(AD)		; NO CHARACTERS REMAINING
	MOV	AD,(AD)		; SET FILE POINTER
	SUB	#<FILAREA-4>,(AD)  ;     FOR NORMAL TEXT FILE
	JSR	MP,@FSTOPN(AR)
NEXT:	CMP	AR,#6
	BNE	NEW		; MORE FILES LEFT
 
 
; SPECIAL RETURN SEQUENCE FOR COMPILER -- BECAUSE THIS MODULE IS
; IN AN OVERLAY SEGMENT IN THE PRESENCE OF RECURSEG.
 
	MOV	MP,2(HP)	; RETURN FROM RECURSEG
	MOV	GP,MP		; INITIAL MP
	RTS	PC		; RETURN TO RECURSEG
 
 
FSTOPN:	.WORD	OPNOUT, OPNIN, OPNTTY, OPNTTY
 
 
OPNTTY:
	CLR	EOFSTATUS(AD)	; EOF(TTY) := FALSE
	MOV	#1,IORESULT(AD)	; IORESULT(TTY) := OK
	ADD	#FDBSIZE,(AD)	; ADJUST FILE POINTER
	MOVB	#' ,@(AD)	; TTYIN^ := ' '		; V4-50
	CMP	AR,#6		; WHICH FILE?
	BNE	TTYOUT		; BR IF TTYOUT
	MOV	AD,LUNTBL(GP)	; TTYIN LUNTABLE ENTRY
	MOV	#TRUE,EOLNSTATUS(AD)  ; EOLN(TTYIN) := TRUE
	MOV	#TTY+TEXT+INPUT,FILTYP(AD)
	CLR	2(AD)		; SET TTYIN LINE EMPTY
	RETURN
 
TTYOUT:	MOV	AD,LUNTBL+<2*TILUN>(GP)	; TTYOUT LUNTABLE ENTRY
	CLR	EOLNSTATUS(AD)	; EOLN(TTYOUT) := FALSE
	MOV	#TTY+TEXT,FILTYP(AD)
	MOV	#TEXTBUFFSIZE,2(AD)	; A FULL LINE REMAINING
	RETURN
 
 
 
OPNOUT:
	MOV	#TEXT,FILTYP(AD)	; FILTYP
	RETURN
 
 
 
OPNIN:
	MOV	#TEXT,FILTYP(AD)	; FILTYP
	MOV	#IE.EOF,IORESULT(AD)	; IORESULT
	MOV	#TRUE,EOFSTATUS(AD)	; EOFSTATUS
	MOV	#TRUE,EOLNSTATUS(AD)	; EOLNSTATUS
	MOVB	#' ,@(AD)		; INPUT^ := ' '
	RETURN
 
 
	.END
****
P11SELECT.MAC         
	.TITLE	SELECTOR
SELECTOR::	; DUMMY PROCEDURE TO ALLOW HEAVIER OVERLAY STRUCTURE
	JMP	DOSELECTOR
	.END
****
P11SWITCH.MAC         
	.TITLE	P11SWITCH
	.PSECT	SWCHIN
;
VERSION::
	.WORD	600.	; VERSION 6.0
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	#18.,R0
1$:	MOV	-(R1),@(R5)+
	DEC	R0
	BGT	1$
	RTS	PC
;
	.END
****
P11WTT.MAC            
	.TITLE	P11WTT
	.IDENT	'840129'
 
; CHANGE      GP-V6:40	1980-06-07	GP
; CHANGE      GP-V6:43	1980-06-04	GP
; CORRECTION  GP-V6:45	1980-06-24	GP
; CHANGE      GP-V6:86	1981-08-16	GP
; CORRECTION  GP-V6:95	1984-01-29	GP

 
	.NLIST	BEX,SYM,TOC
;
;	.PSECT ADDED TO ALLOW DATA TO BE PLACED IN ROOT
	.PSECT	WTTDAT, D, GBL		; MUST BE IN ROOT SEGMENT
BUFF:	.BLKB	132.
EOLN:	.WORD	FALSE
EOF:	.WORD	FALSE
IORES:	.WORD	1	;OK
FILETP:	.WORD	TEXT+TTY
TT:	.WORD	BUFF	; TTY^
CNT:	.WORD	132.
;
	.PSECT	PASRUN			; MAY BE PLACED IN OVERLAY SEGMENT
;
	.MCALL	QIO$S,WTSE$S
;
;
;
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);		; GP-V6:43
	;
	; FILE INPUT IS ASSUMED HERE TO ALWAYS BE
	; ASSIGNED TO LUN 1.
 
	MOV	LUNTBL+2(GP),R0		; ADDR OF FILE ON LUN 1
	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
;
;
;
;   PROCEDURE RTTY ( VAR LINE: LINEBUFF;  VAR LEN: INTEGER );
;
RTTY::
	MOV	#TT,-(SS)	; WRITE( TTY,
	MOV	#PROMPT,-(SS)	;     'PAS>' );
	MOV	#4,-(SS)	;
	MOV	@SS,-(SS)
	CALLSS	WRS
	CALLSS	BRKLN		; BREAK;
	TST	-(SS)
	ADD	#1,6(SS)	;   (* ARRAY (.1..80.)  *)
	QIO$S	#IO.RVB,#5,#5,,SS,,<6(SS),#80.>
	WTSE$S	#5		; READLN;  READ(LINE);
	MOV	2(SS),@4(SS)
	CMPB	@SS,#IE.EOF
	BNE	9$
	JMP	@EXITP(GP)
9$:	ADD	#8.,SS
	RTS	PC
;
;
;
ERRMESS: .ASCII	/ERROR IN LINE /
PROMPT:	.ASCII	/PAS>/
	.EVEN
;
	.END
****
RECUR1.MAC            
	.TITLE	RECURSEG  (RECURS1) RECURSIVE SEGMENT RELOADING
	.IDENT	'800604'

; THIS VERSION IS FOR USE ON SYSTEMS THAT HAVE A SYSTEM LIBRARY
; OVERLAY ROUTINE 'AUTO' THAT HAS A MODULE IDENT OF '08' OR LESS.
; (EG. RSX-11M V3.2)
 
; CORRECTION  GP-V6:23	1980-06-04	GP
 
	.NLIST	BEX,SYM,TOC
 
 
	.PSECT	$$AUTP	; TO ASSURE ALLOCATION IMMEDIATELY
			; AFTER $$AUTO
 
;
;  THIS ROUTINE IS INVOKED THROUGH 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
;   OR
;	GBLPAT = ROOT:$AUTO+34:437  ; ON SOME OLDER SYSTEMS,
;				    ; (EG. RSX-11M V2, IAS V2)
;
;
;  ANOTHER PATCH MUST ALSO BE DONE TO THE AUTO ROUTINE TO ENSURE
; THAT THE BRANCH INTO THIS ROUTINE IS ALWAYS DONE, WHETHER OR
; NOT THE REQUIRED SEGMENT IS CURRENTLY IN MEMORY.
;
;	GBLPAT = ROOT:$AUTO+10:403  ; SKIP SEGMENT TEST
;
;
;  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 SAVED ON A PRIVATE STACK
; AND THE SP STACK IS ADJUSTED SO THAT, WHEN THE SEGMENT READ IS
; COMPLETE, CONTROL WILL BE TRANSFERED TO SEGEXIT.  WE THEN JUMP
; BACK TO THE AUTO ROUTINE SO THAT IT CAN DO THE SEGMENT LOADING.
; WHEN THE LOADING IS DONE, CONTROL GOES TO SEGEXIT.
; IF THE SEGMENT WAS ALREADY IN MEMORY, WE DON'T JUMP BACK TO AUTO.
; INSTEAD, WE JUST DO A RETURN WHICH EFFECTIVELY RESTORES ALL
; REGISTERS AND RETURNS CONTROL TO SEGEXIT.
;
;  AT SEGEXIT, A CALL IS EXECUTED TO THE CALLED ROUTINE ENTRY POINT.
; IN THIS WAY, WE WILL REGAIN CONTROL WHEN THE ROUTINE RETURNS.
;
;  WHEN THE CALLED ROUTINE RETURNS, THE SEGMENT STACK IS ACCESSED
; TO SEE IF THE CURRENT SEGMENT HAS OVERLAYED ANY SEGMENTS THAT
; WERE IN MEMORY BEFORE THE CALL WAS ISSUED.  IF THE PREVIOUS
; SEGMENT IS NO LONGER RESIDENT THEN WE JUMP INTO AUTO TO LOAD
; IT AND ANY OTHER SEGMENTS ON ITS PATH THAT WERE OVERLAYED.
; WHEN THE LOAD IS DONE, CONTROL IS AUTOMATICALLY RETURNED TO
; THE ORIGINAL CALLER.   IF, HOWEVER, THE PREVIOUS SEGMENT IS
; STILL IN MEMORY THEN WE JUST RESTORE REGISTERS AND RETURN
; TO THE ORIGINAL CALLER.
;
;  NOTE THAT THIS FACILITY ONLY WORKS WHEN THE CALLED ROUTINE
; DOES ITS RETURN VIA AN RTS PC INSTRUCTION.  ALSO, IT SHOULD BE KEPT
; IN MIND THAT ANY ROUTINE IN AN OVERLAY SEGMENT CAN BE OVERLAYED
; AND RELOADED DURING ITS EXECUTION AND SHOULD THEREFORE, IN GENERAL,
; BE PURE READ-ONLY CODE.  NOTE ALSO THAT THE CARRY BIT AND OTHER PSW
; STATUS IS LOST THROUGH THE RETURN PROCESS.
;
;

	.ENABL	LSB
 
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
	BR	READ		; CONDITIONALLY LOAD SEGMENT.
				; WHEN DONE CONTROL GOES TO SEGEXIT.
99$:	JSR	R4, $WRERROR
	.BYTE	70.,1
 
 
SEGEXIT:
 
; AT THIS POINT THE STACK HOLDS ONLY THE RETURN ADDR TO CALLER.
 
	CALL	@ENTRYP		; CALL THE WANTED ROUTINE.
 
; PASCAL NEVER USES THE R6 STACK, SO THE EXTRA RETURN ADDRESS
; PUSHED BY THIS CALL DOES'NT DO ANY HARM.
 
	JSR	R5,$SAVRG	; RECONSTRUCT STACK FOR AUTO
	MOV	R2,-(SP)	; SAVE R2
 
; AT THIS POINT THE STACK NOW CONTAINS:
;
;		SP+12 = RETURN TO ORIGINAL CALLER
;		SP+10 = SAVED R5
;		SP+06 = SAVED R4
;		SP+04 = SAVED R3
;		SP+02 = RETURN TO REGISTER RESTORE ROUTINE ($SAVRG)
;		SP+00 = SAVED R2
 
	ADD	#2,SEGP		; SKIP THE SEGMENT JUST USED
	MOV	@SEGP,R2	; DESCRIPTOR FOR OLD SEGMENT
	BEQ	9$		; NO OLD SEG
READ:	BIT	#10000,(R2)	; SEGMENT ALREADY THERE ?
	BEQ	9$		; YES
	JMP	$AUTO+40	; LOAD SEGMENT AND GO TO @12(SP)
 
9$:	MOV	(SP)+,R2	; RESTORE R2
	RTS	PC		; RESTORE OTHER REGISTERS AND GOTO @10(SP)
 
	.DSABL	LSB
 
 
	.PSECT	$SEGST
;
ENTRYP:	.WORD	0
SEGP:	.WORD	SEGSTND
SEGSTK:	.BLKW	100	; SEGMENT DESCRIPTOR STACK
SEGSTND:.WORD	0
 
 
	.END
****
RECUR2.MAC            
	.TITLE	RECURSEG  (RECURS2) RECURSIVE SEGMENT RELOADING
	.IDENT	'840229'

; THIS VERSION IS FOR USE ON SYSTEMS THAT HAVE A SYSTEM LIBRARY
; OVERLAY ROUTINE 'AUTO' WITH MODULE IDENT OF '09.08' OR '10.02'.
; (EG. RSX-11M V4.0, RSX-11M+ V2.0, RSTS V7.2)
 
; CORRECTION  GP-V6:23	1980-06-04	GP
; CHANGE      GP-V6:93	1984-02-29	GP
 
	.NLIST	BEX,SYM,TOC

; THE H.OVLY SYMBOL USED BELOW SHOULD PROPERLY BE DEFINED WITH THE HDRDF$
; MACRO BUT THIS MACRO IS NOT AVAILABLE ON RSTS SYSTEMS. 
;	.MCALL	HDRDF$  ; THIS MACRO IS DEFINED IN LB:[1,1]EXEMC.MLB
;	HDRDF$		; DEFINE TASK HEADER OFFSETS (H.OVLY IN PARTICULAR)
 
	.PSECT	$$AUTP  RO	; TO ASSURE ALLOCATION IMMEDIATELY
				; AFTER $$AUTO
 
;
;  THIS ROUTINE IS INVOKED THROUGH A BRANCH INSTRUCTION PATCHED INTO
; THE SYSTEM OVERLAY AUTOLOAD ROUTINE, AUTO. THE PATCH MUST BE
; DONE AT TASK BUILD TIME:
;
;	GBLPAT = ROOT:$AUTO+36:441  ; BR SEGENT (FOR AUTO 09.08)
;     OR
;       GBLPAT = ROOT:$AUTO+36:431  ; BR SEGENT (FOR AUTO 10.02)
;
;
;  ANOTHER PATCH MUST ALSO BE DONE TO THE AUTO ROUTINE TO ENSURE
; THAT THE BRANCH INTO THIS ROUTINE IS ALWAYS DONE, WHETHER OR
; NOT THE REQUIRED SEGMENT IS CURRENTLY IN MEMORY.
;
;	GBLPAT = ROOT:$AUTO+10:403  ; SKIP SEGMENT TEST
;
;
;  UPON BRANCHING TO SEGENT, THE STACK AND REGISTERS ARE AS FOLLOWS:
;
;	16(SP) = RETURN TO ORIGINAL CALLER
;	14(SP) = ADDRESS OF 2 WORD AUTOLOAD PACKET
;	12(SP) = SAVED R5
;	10(SP) = SAVED R4
;	 6(SP) = SAVED R3
;	 4(SP) = SAVED R2
;	 2(SP) = SAVED R1
;	  (SP) = RETURN TO REGISTER SAVE/RESTORE ROUTINE (.SAVR1)
;
;	(R5)  = ENTRY POINT OF CALLED ROUTINE
;	R2    = ADDRESS OF SEGMENT DESCRIPTOR OF CALLED ROUTINE
;
;
;  THIS ROUTINE SAVES THE SEGMENT DESCRIPTOR ADDRESS ON A PRIVATE STACK
; AND ADJUSTS THE SP STACK SO THAT, WHEN THE SEGMENT READ IN
; COMPLETE, CONTROL WILL BE TRANSFERED TO SEGEXIT.  IT THEN JUMPS
; BACK TO THE AUTO ROUTINE SO THAT THE SEGMENT LOADING CAN PROCEED.
; WHEN THE LOADING IS DONE, CONTROL GOES TO SEGEXIT.
; IF THE SEGMENT WAS ALREADY IN MEMORY, WE DON'T JUMP BACK TO AUTO.
; INSTEAD, WE JUST DO A RETURN WHICH EFFECTIVELY RESTORES ALL
; REGISTERS AND RETURNS CONTROL TO SEGEXIT.
;
;  AT SEGEXIT, A CALL IS EXECUTED TO THE CALLED ROUTINE ENTRY POINT.
; IN THIS WAY, WE WILL REGAIN CONTROL WHEN THE ROUTINE RETURNS.
;
;  WHEN THE CALLED ROUTINE RETURNS, THE SEGMENT STACK IS ACCESSED
; TO SEE IF THE CURRENT SEGMENT HAS OVERLAYED ANY SEGMENTS THAT
; WERE IN MEMORY BEFORE THE CALL WAS ISSUED.  IF THE PREVIOUS
; SEGMENT IS NO LONGER RESIDENT THEN WE JUMP INTO AUTO TO LOAD
; IT AND ANY OTHER SEGMENTS ON ITS PATH THAT WERE OVERLAYED.
; WHEN THE LOAD IS DONE, CONTROL IS AUTOMATICALLY RETURNED TO
; THE ORIGINAL CALLER.   IF, HOWEVER, THE PREVIOUS SEGMENT IS
; STILL IN MEMORY THEN WE JUST RESTORE REGISTERS AND RETURN
; TO THE ORIGINAL CALLER.
;
;  NOTE THAT THIS FACILITY ONLY WORKS WHEN THE CALLED ROUTINE
; DOES ITS RETURN VIA AN RTS PC INSTRUCTION.  ALSO, IT SHOULD BE KEPT
; IN MIND THAT ANY ROUTINE IN AN OVERLAY SEGMENT CAN BE OVERLAYED
; AND RELOADED DURING ITS EXECUTION AND SHOULD THEREFORE, IN GENERAL,
; BE PURE READ-ONLY CODE.  NOTE ALSO THAT THE CARRY BIT AND OTHER PSW
; STATUS IS LOST THROUGH THE RETURN PROCESS.
;
;

	.ENABL	LSB

SEGENT:
	MOV	(R5),ENTRYP	; SAVE ENTRY POINT
	MOV	#SEGEXIT,14(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
	BR	READ		; CONDITIONALLY LOAD SEGMENT.
				; WHEN DONE CONTROL GOES TO SEGEXIT.
99$:	JSR	R4, $WRERROR
	.BYTE	70.,1
 
 
SEGEXIT:
 
; AT THIS POINT THE STACK HOLDS ONLY THE RETURN ADDR TO CALLER.
 
	CALL	@ENTRYP		; CALL THE WANTED ROUTINE.
 
; PASCAL NEVER USES THE R6 STACK, SO THE EXTRA RETURN ADDRESS
; PUSHED BY THIS CALL DOES'NT DO ANY HARM.
 
	JSR	R5,.SAVR1	; RECONSTRUCT STACK FOR AUTO
 
; AT THIS POINT THE STACK NOW CONTAINS:
;
;		14(SP) = RETURN TO ORIGINAL CALLER
;		12(SP) = SAVED R5
;		10(SP) = SAVED R4
;		 6(SP) = SAVED R3
;		 4(SP) = SAVED R2
;		 2(SP) = SAVED R1
;		  (SP) = RETURN TO REGISTER RESTORE ROUTINE (.SAVR1)
 
	ADD	#2,SEGP		; SKIP THE SEGMENT JUST USED
	MOV	@SEGP,R2	; DESCRIPTOR FOR OLD SEGMENT
	BEQ	9$		; NO OLD SEG
READ:	BIT	#10000,(R2)	; SEGMENT ALREADY THERE ?
	BEQ	9$		; YES
	MOV	@#54,R1		; AUTO'S DATA AREA ADDRESS
	JMP	$AUTO+42	; LOAD SEGMENT AND GO TO @12(SP)
 
9$:	RTS	PC		; RESTORE ALL REGISTERS AND GOTO @14(SP)
 
	.DSABL	LSB
 
 
	.PSECT	$SEGST
;
ENTRYP:	.WORD	0
SEGP:	.WORD	SEGSTND
SEGSTK:	.BLKW	100	; SEGMENT DESCRIPTOR STACK
SEGSTND:.WORD	0
 
 
	.END
****