.mcall	vrdata
vrdata	UCLGRL remark=<UCL+ Global Region Loader>

.mcall	.addr,  .assume, .craw,   .crrg,   .elrg,  .exit,  .map,  .print
.mcall	.rdbbk, .readw,  .settop, .wdbbk,  .writw

.iif ndf grl$sz, grl$sz ==: 10.*1024./32. ;Default size of global region

grl$sp ==: 1010	;Our stack pointer

userpc	= 40	;Program start address
usersp	= 42	;Program initial stack pointer
jsw	= 44	;Job status word
userto	= 50	;Program high limit
errbyt	= 52	;Monitor error reporting byte
userrb	= 53	;User program error byte
rlocbk	= 62	;Relative start of relocation information

sever$	= 10	;"Severe" error bit in USERRB
ovly$	= 1000	;Overlay bit in JSW
xe.prv	= 15	;.CRRG error code: global region privately owned

	.asect
. = usersp
	.word	grl$sp	;Initial stack pointer value	
	.word	ovly$	;Lie to RT-11 so chan 17 will be open into ourselves

. = grl$sp	;Our stack goes here

; Program data area

pcsav::	.word	0	;Storage for .REL start address
spsav::	.word	0	;Storage for .REL stack pointer
jswsav::.word	0	;Storage for .REL job status word

region:	.rdbbk	grl$sz, <rs.gbl ! rs.cgr>, name=ucl
window:	.wdbbk	1, grl$sz
parea:	.blkw	6		;Argument area for plas programmed requests
area:	.blkw	5		;Argument area for other programmed requests
grl$nm	==: region+r.gnam

; ASCII stuff

	.nlist	bex
merpfx:	.nlcsi	part=prefix, type=i
	.ascii	"F-"<200>
msette:	.asciz	"No room"
mplase:	.asciz	"PLAS error"
mioerr:	.asciz	"I/O error"
	.even
	.list	bex

start::
	.crrg	#parea,#region	;Create a global region
	bcs	plaser		;Branch on error

; We have now successfully allocated/created the global region.
; Now map it to a window, load the .REL code if necessary, and
; initiate execution of the relocated code.

10$:	mov	region+r.gid,window+w.nrid ;Put region ID in the WDB
	.craw	#parea,#window	;Create a window
	bcs	plaser		;If error, go handle it
	.map	#parea,#window	;Map the window to the region
	bcs	plaser		;If error, go handle it
	bit	#rs.new,region+r.gsts ;Did we just create the global region?
	bne	grl$rl		;Go put .REL code in it, if so

	tst	pcsav		;Make sure we have a PC value
	beq	grl$rl		;Branch if not
	bis	jswsav,@#jsw	;Set any extra JSW bits the .REL code wants
	mov	spsav,sp	; and set up the user stack pointer
	sub	#1000,pcsav	;Calculate the start address...
	add	window+w.nbas,pcsav
	jmp	@pcsav		;Go execute "relocated" code

; Here we load the .REL code into the global region
; This is also the "reload" entry point.

grl$rl::
	call	rlodr

; Now detach from global region to make it shareable.  Then loop
; back and reattach to global region.

	call	detach		;Detach from global region
	bcs	plaser		;Branch if there is an error
	br	start		;Go reattach to global region

; Routine to detach from a global region

detach:	.elrg	#parea,#region	;Detach from global region
	return

; Error traps...

setter:	mov	#msette,r1	;.SETTOP
	br	ferxit
plaser:	mov	#mplase,r1	;PLAS routines

ferxit:	bis	#<rs.gbl!rs.egr>,region+r.gsts ;Attempt to eliminate global
	call	detach		; region
ferx00:	.print	#merpfx		;Print error message prefix
	.print	r1		;Print error message
	bisb	#sever$,@#userrb ; indicate a severe error to system,
	clr	r0		; and do a hard exit...
	.exit

; GRL$XX is an entry point from the user program which can be used to reload
; the program's .REL code prior to taking a "fatal" exit.  The address of
; an error message is assumed to be on the stack.

grl$xx::
	call	rlodr		;Reload the .REL code
	mov	(sp)+,r1	;Put message address in R1
	br	ferx00		;Do "fatal" exit

ioerr:	mov	#mioerr,r1	;.READW/.WRITW error trap
	br	ferxit

; RLODR reads in block 0 of the concatenated .REL file and sets up some
; pointers and data.  It then reads the rest into the global region and
; does the relocation.
;
relbk0	= <buf-3>/512.+1

rlodr::
	.settop	#buf+510.	;Get some space for the I/O buffer
	cmp	r0,#buf+510	;Branch if no room...
	blo	setter
	mov	#relbk0,r2	;R2 = 1st block to read
	mov	#buf,r1		;R1 => I/O buffer
	.readw	#area,#17,r1,#256.,r2 ;Read the .REL block 0
	bcs	ioerr		;Handle errors
	mov	jsw(r1),jswsav	;Save .REL JSW
	mov	usersp(r1),spsav ;Save .REL stack pointer
	mov	userpc(r1),pcsav ;Save .REL start address
	.writw	#area,#17,#1000,,#1 ;Save our own block 1 configuration

	mov	rlocbk(r1),r4	;Make R4 = actual block no. of relocation
	add	#relbk0,r4	; information
 	mov	userto(r1),r3	;R3 = .REL program high limit
    	clc			;Make high limit a word count...
	ror	r3
	sub	#255.,r3	;Adjust for block 0

	mov	window+w.nbas,r1 ;R1 = virtual base address of global region
	inc	r2		;Bump block no. for .REL read
	.readw	#area,#17,r1,r3,r2 ;Load .REL program's image
	bcs	ioerr		; into global region

	mov	r4,r2		;R2 =  block no. of start of relocation data
10$:	mov	#buf,r1		;R1 => I/O buffer
	.readw	#area,#17,r1,#256.,r2 ;Read a block of the relocation table...
	bcs	30$		;Handle errors
	inc	r2		;Bump block number
	mov	#128.,r3	;R3 = max. no. of offset/value pairs in buffer

20$:	mov	(r1)+,r4	;R4 = word offset of a value to be relocated
	bmi	40$		;Branch if done
	clc			;Make word offset a byte offset...
	rol	r4
	add	window+w.nbas,r4 ;Now make it an offset into the global region

	mov	(r1)+,r5	;R5 = value to be relocated
	sub	#1000,r5	;Subtract original base
	add	window+w.nbas,r5 ;Add current base address

	mov	r5,(r4)		;Deposit relocated value
	sob	r3,20$		;Go handle the next offset/value pair
	br	10$		;If done with a buffer load, go read another

30$:	tstb	@#errbyt	;Attempt to read past end-of-file?
	bne	ioerr		;Handle as error if not

40$:	return			;Just return otherwise

.assume	. le 2000	message=<;*** LOADER CODE TOO LARGE ***>

buf::	.end	start		;I/O buffer starts here
