.titl OUTINLD
;OUTINLD.A
; SWAT.16
;  new disk command/label format (5/22/74)
; OUTLD and INLD are used to save alto memory images.
; a complete save-restore cycle happens like this:
; OUTLD	writes a loader
;  	writes pages 2,3,... to the end
;		writes pages 1,0
;		returns true
; INLD	reads the loader into page 0 and jmps to it
; the loader copies a message into page 0
;		reads in pages 2,3,... to the end
;		transfers to the restored OUTLD
; OUTLD	copies the message into the user's area
;		restores page 1, via page 0
;		restores page 0
;		returns false
;
; all the subroutines are used by both the resident
; and the page 0 loader, so must be dynamically
; relocatable.
;
.rdx 8
.ent OUTLD
.ent INLD
;
msize = 24	; size of message
hspa = 176400	; highest swapped page's address
;

	.srel
OUTLD:	OUTLDC
INLD:	INLDC

	.nrel
; displacements in disk control block.
nxtcm=0
statu=1
cmmd=2
hdrpt=3
lblpt=4
cmadd=5
okint=6
errin=7
hdr1=10
curre=11
nextp=12
backp=13
unuse=14
numch=15
pn=16
vn=17
sn1=20
sn2=21
;
OUTLDC:	; ac0 = table(sn1,sn2,vn,nil,disk address)
	; ac1 = a msize word vector to receive message
	; upon resumption;
	sta 0,oda	; output file id
	sta 1,ovec	; output message vector
	sta 3,retrn
	jsr .+1	; save ac2
outtag: lda 0,stackd
	add 0,3
	sta 2,0,3
; write loader onto first page

	; translate fid into label
	jsr tlabl	; get ptr to label area in ac3
	lda 2,oda	; file descriptor
	lda 1,0,2
	sta 1,sn1-12,3
	lda 1,1,2
	sta 1,sn2-12,3
	lda 1,2,2
	sta 1,vn-12,3
	lda 1,4,2
	sta 1,nextp-12,3

	mov 3,1		; pass setup a faked label block
	lda 0,writ	; write and check command
	jsrii isetu	; set up command blocks
	lda@ 0,loadrp
	jsrii ipage	; write out loader
; loader written.
; write out bulk of mem. (pages 2 through end)
	jsrii ibulk
; bulk written, cur is last command block.
; write page 1
	lda 0,in400
	jsrii ipage
; page 1 written, write page 0
	sub 0,0
	jsrii ipage
; page 0 written, outload phase finished.
	lda 0,true
	jmp exit
;
; the page 0 loader returns here when file is restored.
contuc:	; ac0 = next page info
	; tvec = message vector in page 0
	sta 0,npi
	lda 3,tvec
	lda 0,0,3
	mov 0,0,snr	; message present?
	jmp rp1		; no
	inc 3,1		; yes, ac1 ← @tvec+1
	lda 2,ovec	; pointer outload got eons ago
	jsr copy
	    msize
; message copied into user's area.
;read in pages 0 and 1.
rp1:	lda 0,read1
	lda 1,npi
	jsrii isetu	; read putative page 1 into page 0
	sub 0,0
	jsrii ipage
; move it carefully into its rightful place.
	sub 1,1	; start at loc 0
	lda 2,k400	; ac2 runs through page 1
	jsr copy
	    430-400	; ac1=30,ac2=430
	inc 1,1
	inc 2,2		; skip real time clock
	jsr copy
	    521-431	; ac1=121, ac2=521
	lda 0,n3	; skip kblk (hopefully 0)
	add 0,1		; skip disk status
	add 0,2		; skip disk address
	jsr copy
	    1000-524
; page 1 restored. read in page 0.
	sub 0,0
	jsrii ipage
; page 0 is in. exit
	sub 0,0		; return false
exit:	lda 2,stack
	lda 3,retrn
	jmp 1,3		; assume called from bcpl
; many eons later inload is invoked by a running program, passing
; the file id of the file we just wrote on ...
;
INLDC:	; ac0 = file id of saved memory image
	; ac1 = message to be passed to it,e.g. table(2,100,-6)
	sta 0,ida	; input disk address
	sta 1,ivec	; input message, no need to save ac3
	sta 2,stack	; for error return
	sub 0,0
	sta 0,@dasta	; clear screen
	sta 0,@activ	; kill interrupts

	lda 2,ida	; tranlate fid into label
	jsr tlabl	; get label ptr in ac3
	lda 1,0,2
	sta 1,sn1-12,3
	lda 1,1,2
	sta 1,sn2-12,3
	lda 1,2,2
	sta 1,vn-12,3
	lda 1,4,2
	sta 1,nextp-12,3

	mov 3,1		; pass setup fabricated label
	lda 0,read	; read and check command
	jsrii isetu

	subzl 0,0	; read loader into 1,2,...,400
	jsrii ipage
; page 0 now contains loader below.
	jsr .+1		; load current dcb address into ac1
intag:	lda 1,curd
	add 1,3
	lda 1,0,3
	lda 2,ilbld
	add 2,1
	lda 2,n402	; copy label block
	jsr copy	; to 402,403,...
	    10		; because that's where
			; boot microcode puts it
	lda 1,ivec	; copy message
	lda 2,tvec	; to page 0
	subzl 0,0
	sta 0,0,2	; signal message present
	inc 2,2		; put it a @tvec+1,...
	jsr copy
	    msize
	jmp 1		; jump to page 0 loader,
; storage for OUTLD and INLD
dasta:	420	; display control word
read1:	44120
k400:	400
oda:	.blk 1	; output file id
ovec:	.blk 1	; receiver's message vector
retrn:	.blk 1	; OUTLD's ra
ida:	.blk 1	; input file id, INLD's temp
ivec:	.blk 1	; sent message. INLD's temp
npi:	.blk 1	; next page info. INLD's temp
count:	.blk 1	; general purpose counter
tlabl:	jsr 0,3	; put ptr into ac3
	.blk 10		; fabricated label goes here
tvec:	mvec-strtl+1	; page 0 address of mvec
activ:	453	; interrupt mask
true:	177777
; static pointers and constant words for things below
isetu:	setup
ipage:	page
iwait:	wait
writ:	writecom
icont:	cont
ilbld:	nextp
ibulk:	bulk
curd:	cur-intag
in400:	v400
stackd:	stack-outtag
loadrp: loadr

	.srel
setup:	setupc		; static pointers to code
page:	pagec
wait:	waitc
cont:	contc
bulk:	bulkc
contu:	contuc
loadr:	strtl

	.nrel
copy:	; ac1 = first address of source
	; ac2 = first address of sink
	;(ac3) = number of words to move
	sta 3,copr
	lda 0,0,3
	mov 0,0,snr
	jmp 1,3
	sta 0,count
	mov 1,3
cloop:	lda 0,0,3
	sta 0,0,2
	inc 2,2
	inc 3,3
	dsz count
	jmp cloop
	mov 3,1
	lda 3,copr	; ac1 = first word not moved
	jmp 1,3	; ac2 = first word not stored into
copr:	.blk 1
;
pagec:	; ac0 = main mem address to save or restore
	; process and check page
	sta 3,rpage
	jsr contc
	lda 0,cur
	lda 1,alt
	sta 1,cur
	sta 0,alt
	sta 1,@kblk
	jsr waitc
	jmp @rpage
rpage:	.blk 1
;end of page
;
; the page 0 loader
;
strtl:	; this code (next 256 words) was written on the saved file
	; and executes in page 0.
	; it starts in location 0 if brought in by INLD,
	; location 1 if brought in by boot button
	; 402 = file id for next page of save file
	; tvec = message
; read in bulk of saved image
rd:	jmp .+2
	0		; this word clobbered if booting
	lda 0,read
	lda 1,n402	; get file id left by inload or boot
	jsr setupc
	jsr bulkc
; bulk of file in, cur holds next page info.
	lda 3,cur
	lda 0,lblds
	add 3,0
	jsrii .+1
	contu		; address in restored code
;
stack:	.blk 1	; saved ac2
; constants
read:	44120	; read, check label command
writecom=44130	;write, check label command
write:	writecom
n2:	2
n3:	3
n10:	10
n377:	377
v400=	400
n400:	v400
n402:	402
n1000:	1000
kblk:	521	; mail box for disk controller
maxad:	hspa	; address of last page, 48k memory
;
; subroutines;
; setup, cont, page, and wait, are a subsystem to
; communicate with the disk controller. after setup, cur and alt
; are two disk command blocks such that cur is the last one
; placed in kblk -- by us or the disk controller.

;
bulkc:	; reads or writes pages 2 thru maxad/400
	; d.c. dormant
	; cur and alt have been set up
	; this code is asynchronous and took several trys
	; to get right!
	; it's supposed to be timing independent.
	sta 3,blret
	lda 0,n1000
	jsr contc	; begin on page 2
swtch:	lda 0,cur
	lda 1,alt
	sta 1,cur
	sta 0,alt

waitl:	; all pages before cur are processed and checked.
	; link of cur is 0.
	; either d.c. is active, working on cur
	; or d.c. is dormant, never started cur
	; or d.c. is dormant, finished cur
	lda 2,cur
	lda 0,nextp,2
	mov 0,0,szr
	jmp lblin	; d.c. started cur, working or finished
	lda 0,@kblk
	mov 0,0,szr
	jmp waitl	; d.c. active, started cur
	lda 0,statu,2
	mov 0,0,szr
	jmp funny	; d.c. finished, probably an error
	sta 2,@kblk	; d.c. never started cur
	jmp waitl
;
funny:	jsr waitc	; have wait check for errors
			; it may retry.
			; label as well as data in

lblin:	; now we know address of next page. set up alt
	lda 0,cmadd,2	; ac2 = cur
	lda 1,maxad
	sub# 0,1,snr
	jmp last
	lda 1,n400
	add 1,0
	jsr contc
	jsr waitc	; for cur's data
	jmp swtch
last:	jsr waitc
	jmp @blret
	; pages 0...end done, d.c. dormant
blret:	.blk 1
;end of bulk
;
contc:	; sets up alternate command block
	; d.c. may be active.
	; ac0 = address of core page.
	sta 3,cra
	lda 2,cur
	lda 3,alt
	sta 0,cmadd,3
	sub 0,0
	sta 0,nxtcm,3
	sta 0,statu,3
	lda 1,nextp,2
	sta 1,curre,3
	lda 1,curre,2
	sta 1,backp,3
	sta 0,nextp,3
	sta 0,pn,3
	sta 3,nxtcm,2	; put link in active command
	jmp @cra
	; alt is set up, hopefully before d.c. looked for
	; link in cur.
cra:	0
; end of cont
;
cur:	.blk 1		; current command
alt:	.blk 1		; alternate
lblds:	nextp	; label displacement in command block
;
waitc:	; d.c. probably active, working on cur
	sta 3,retw
	lda 3,n10	; try 8 times
	sta 3,tryct
retry:	lda 2,cur
	lda 0,statu,2
	mov 0,0,snr
	jmp retry
	lda 1,n377
	and 0,1,snr
	jmp @retw	; return if no error
	dsz tryct
	jmp .+2
	jmp gvup
	lda 0,n2
	sub# 0,1,snr	; skip unless label check
	jmp gvup	; label check
	sub 0,0		; strange error
	sta 0,statu,2	; clear label block
	sta 0,nextp,2
	sta 0,backp,2
	sta 0,pn,2
	sta 0,numch,2
	sta 0,unuse,2
	sta 0,hdr1,2
	com 0,0
	sta 0,@kblk2	; force seek
	sta 2,@kblk
	jmp retry
kblk2:	523
tryct:	.blk 1		; try count
retw:	0
; end of wait
;
setupc:	; d.c. is dormant
	; ac0 = read or write command
	; ac1 = label block whose nextp is adress to begin with
	; initializes command/label blocks so that
	; nextp in cur is the disk address to start
	; with. a call on page (or cont) will follow.
	sta 0,comm	; save params
	sta 1,filid
	sta 3,rstrt
	; set cur,alt and background with 0's
	jsr cba		; ac3 = first word of comm. blk. area
	mov 3,1
	sta 1,cur
	lda 3,cbsize
	add 3,1		; ac1 = start of second cb
	sta 1,alt
	add 3,1		; ac1 = end of cb2 + 1
	add 3,3		; ac3 = size of area
	neg 3,3		; (expletive deleted)
	sub 0,0
	blks		; zero all but nxtcm of cur, which
			; cont will zero later
	; put in local pointers
	lda 2,cur
	lda 3,alt
	lda 0,hdrds
	add 2,0
	sta 0,hdrpt,2
	lda 0,hdrds
	add 3,0
	sta 0,hdrpt,3
	lda 0,lblds
	add 2,0
	sta 0,lblpt,2
	lda 0,lblds
	add 3,0
	sta 0,lblpt,3
	lda 0,comm
	sta 0,cmmd,2
	sta 0,cmmd,3
	; put in file id
	lda 3,filid
	lda 0,nextp-12,3
	sta 0,nextp,2	; as if we just did page before first
	lda 0,sn1-12,3
	lda 1,sn2-12,3
	lda 3,vn-12,3
	sta 0,sn1,2
	sta 1,sn2,2
	sta 3,vn,2
	lda 2,alt
	sta 0,sn1,2
	sta 1,sn2,2
	sta 3,vn,2
	;
	; command blocks set up.
	jmp @rstrt
comm:	.blk 1
filid:	.blk 1
rstrt:	.blk 1
hdrds:	hdr1	; header displacement in command block
cbsize:	22
cba:	jsr 0,3
cb1:	.blk 22
cb2:	.blk 23
	; extra word is clobbered by blks, who cares?
;end of setup

gvup:	; waitc transfers here when all is lost because of
	; disk errors. ac2 = disk control block causing error
	; display "lights" showing offending disk control block
	; store dcb's etc. at 2,...,61
	sta 2,ofcb	; store add of offending block
	jsr sdcb
markw:	111111

dcb1:	6	; this word goes at 2
	0
	0
	200	; skip 200 scan lines

dcb2:	12	; this goes at word 6
	100022
	16	; ptr to command block
	1

dcb3:	0
	100022
	40	; ptr to mark words
	1

sdcb:	mov 3,0
	lda 1,n15	; store dcb's in 2...15
	lda 3,m14
	blt

	lda 0,ofcb	; store command block in  16...37
	subzl 1,1
	sub 1,0
	lda 1,n37
	lda 3,m22
	blt

	lda 0,markw	; store marks in 40...61
	lda 1,n61
	lda 3,m22
	blks

	lda 0,k2	; start display at 2
	sta 0,@n420
	jmp .

ofcb:	.blk 1
k2:	2
n15:	15
m14:	-14
n37:	37
n61:	61
m22:	-22
n420:	420
; end of gvup

	.blk 400-msize-.+strtl-1 ; spacer(must be ge 0)

mvec:	0	; this will appear at 400-msize-1 when loaded
		; 0 signals no message unless INLD revises
.end