.mcall	vrdata
vrdata	UCLGRL remark=<UCL+ Global Region Loader>

; This program is the "front end" of the XM version of UCL+ (UCLXM.SAV).
;
; UCLXM.SAV is built in two parts: this program, and a special XM assembly
; of the UCL+ program, linked with a base address of 20000.  UCLGRL is
; concatenated with the part of the UCL+ binary that starts at 20000 to form
; UCLGRL.SAV.
;
; The front end section is the only part that resides in low memory; the
; actual UCL+ executable code runs out of a global region in extended memory
; with a virtual base address of 20000.  The first time that UCLXM runs after
; a boot, the loader code creates the global region, loads the UCL+ program
; into it, and commences execution.  At any successive time that UCLXM is run,
; the loader merely attaches to the global region, and jumps to the start
; address.
;
; It is interesting to note all the hand-holding necessary to make this work
; under TSX-Plus following the "improvements" made starting around V6.3. Two
; items are identified in the comments (look for the word "foobed"). A third
; is the .rctrlo request issued just prior to the jump to the starting address
; in the global region. Apparently, TSX-Plus has some trouble keeping track of
; program context following the detach/reattach sequence necessary to
; establish a new global region. Before the .rctrlo was added, UCL+ would
; sometimes crash the first time it was run because the global region it just
; created and loaded was not "visible" after the reattach occurred.
; Evidently, the brief context switch caused by the addition of the .rctrlo
; causes TSX-Plus to get its act together.

.mcall	.addr, .assume, .craw,   .crrg,  .elaw,  .elrg,   .exit,  .gval
.mcall	.map,  .print,  .rctrlo, .rdbbk, .readw, .settop, .wdbbk, .writw

.iif ndf grl$sz, grl$sz ==: 41.*256./32. ;Default size of global region

ucl$sp ==: 1000	;UCL code's stack pointer
grl$sp ==: 1010	;Our stack pointer

userpc	= 40	;Program start address
usersp	= 42	;Program initial stack pointer
jsw	= 44	;Job status word
 ovly$	= 001000 ;Overlay bit in JSW
userto	= 50	;Program high limit
errbyt	= 52	;Monitor error reporting byte
userrb	= 53	;User program error byte
 fatal$	= 010	;"Fatal" error bit in USERRB
tsxsiz	= 56	;SETSIZ location for TSX+ (no. of K words program requires)

config	= 300	;Monitor offset to configuration word
 kt11$	= 010000 ;XM bit in configuration word

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

. = tsxsiz
	.word	1	;If TSX+: 1 KW low memory is more than enough

. = grl$sp		;Our stack goes here

; Program data area

pcsav::	.word	0	;Storage for UCL code start address
spsav::	.word	ucl$sp	;Storage for UCL code stack pointer
jswsav::.word	0	;Storage for UCL code 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"
mcntxe:	.asciz	"Not XM monitor"
	.even
	.list	bex

start::
	mov	#mcntxe,r1	;Set up for possible context error
	.gval	#area,#config	;Get contents of CONFIG word in RMON
	bit	#kt11$,r0	;XM monitor?
	beq	ferx00		;Take error trap if not
	mov	#<rs.gbl!rs.cgr>,region+r.gsts ;Hand-holding: foobed TSX+ 6.31

start0:	.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 UCL code if necessary, and
; initiate execution of the code.

	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 load UCL code, 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 UCL code wants
	mov	spsav,sp	; and set up the user stack pointer
	.rctrlo			;Ensure any JSW changes are "noticed"
	jmp	@pcsav		;Go execute UCL code

; Here we load the UCL 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
	mov	#rs.gbl,region+r.gsts ;Hand-holding: foobed TSX+ 6.31
	br	start0		;Go reattach to global region

; Routine to detach from a global region

detach:	.elaw	#parea,#window	;Eliminate mapping window (foobed TSX+ 6.31)
	.elrg	#parea,#region	;Detach from global region
	return

; Error traps...

plaser:	mov	#mplase,r1	;PLAS routines enter here

ferxit:	mov	#<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	#fatal$,@#userrb ; indicate a fatal 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 UCL 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 UCL 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 UCL code file and sets up some
; pointers and data.  It then reads the remainder into the global region and
; returns.

relbk0	= <buf-3>/512.+1

rlodr::
	mov	#msette,r1	;Assume possible .SETTOP error
	.settop	#buf+510.	;Get some space for the I/O buffer
	cmp	r0,#buf+510	;Branch if no room (unlikely!!!)...
	blo	ferxit
	mov	#relbk0,r2	;R2 = 1st block to read
	mov	#buf,r1		;R1 => I/O buffer
	.readw	#area,#17,r1,#256.,r2 ;Read the UCL code block 0
	bcs	ioerr		;Handle errors
	mov	jsw(r1),jswsav	;Save UCL code JSW
	mov	userpc(r1),pcsav ;Save UCL start address
	.writw	#area,#17,#1000,,#1 ;Save our own block 1 configuration

 	mov	userto(r1),r3	;R3 = UCL program high limit
    	clc			;Make high limit a word count...
	ror	r3
	sub	#7777,r3	;Adjust for 20000 base address

	inc	r2		;Bump block no. for UCL code read
	.readw	#area,#17,#20000,r3,r2 ;Load UCL code's image
	bcs	ioerr		; into global region...

	return			;Quit

.assume	. le 2000	message=<;*** LOADER CODE TOO LARGE ***>

buf::	.end	start		;I/O buffer starts here
