; VMemA.asm. Interlisp-D virtual memory package
; Removed MoveWords December 14, 1982  6:03 PM van Melle
; Fault change on November 2, 1982  5:09 PM by van Melle
; xSetxxxBr change on July 21, 1982  9:47 PM van Melle
; MoveWords change on July 20, 1981 6:34 PM by Beau Sheil
; Trill change February 24, 1981  10:40 AM by Beau Sheil
; XBitBlt change January 28, 1981  5:03 PM by Alan Bell and Beau Sheil
; Modified January 27, 1981  7:17 PM by Beau Sheil

; procedures defined
	.ent	BP, MovePage, ReadFlags, ReadRP, SetFlags
	.ent	BGetBase32, XGetBase32
	.ent	BGetBasePtr, XGetBasePtr, AGetBasePtr
	.ent	BSetWriteBR, XSetReadBR, XSetWriteBR, RRead, RWrite
	.ent	XGetBase, XGetBase1, XPutBase
	.ent	BGetBase, BGetBase1, BPutBase
	.ent	SGetBase, SPutBase
	.ent	APutBase32, BPutBase32, XPutBase32
	.ent	IncMiscStats, MiscStatsAdd1, BitBltSUBR
	.ent	AtomNotNIL
	.ent	Fault

; statics used
	.extd	lvVPtr, VPtr0, VPtr1, Bpt, MiscSTATSbase

; procedures used
	.extn	PageFault

; Lisp extended Nova instructions
	.dusr	uReadFlags   = #67401	; ReadFlags(vp) -> (RP, flags)
	.dusr	uSetFlags    = #67402	; SetFlags(vp, RP, flags)
	.dusr	uXferPage    = #67403	; XferPage(toVP, fromVP)
	.dusr	uBGetBase    = #67404
	.dusr	uBPutBase    = #67405
	.dusr	uBGetBase32  = #67406
	.dusr	uBGetBasePtr = #67407
	.dusr	uBPutBase32  = #67410

	.dusr	XBITBLT      = #67416
	.dusr	SWAT         = #77400

	.ZREL

BGetBase32:	.bgb32
XGetBase32:	.xgb32
BGetBasePtr:	.bgbPtr
XGetBasePtr:	.xgbPtr
AGetBasePtr:	.agbPtr
BSetWriteBR:	.bswBR
XSetWriteBR:	.xswBR
XSetReadBR:	.xsrBR
RRead:		.rrd
RWrite:		.rwt
XGetBase:	.xgbs
XGetBase1:	.xgbs1
BGetBase:	.bgbs
BGetBase1:	.bgbs1
SGetBase:	.sgbs
BPutBase:	.bpbs
SPutBase:	.spbs
XPutBase:	.xpbs
APutBase32:	.apbPtr
BPutBase32:	.bpbPtr
XPutBase32:	.xpbPtr
AtomNotNIL:	.ann
IncMiscStats:	.imss

RBaseReg0:	  0
RBaseReg1:	  0
WBaseReg0:	  0
WBaseReg1:	  0

	.SREL
BP:		.bp
MovePage:	.vmXp
ReadRP:		.rrp
ReadFlags:	.rfg
SetFlags:	.sfg
Fault:		fault		; not called - makes Swat stack prettier
MiscStatsAdd1:	.msa1
BitBltSUBR:	.xbbt

	.NREL

; BP(i) returns a pointer to the ith real page descriptor
.bp:	mov	0,1			; computing 3*i as offset
	add	0,1			; 2*i
	add	0,1			; 3*i
	lda	0, Bpt			; start of table
	add	1,0			; + offset 
	jmp	1,3

; MovePage(toVP, fromVP)
; Uses ucode routines to move contents of one virtual page to another
.vmXp:	uXferPage
	SWAT			; shouldn't fault
	jmp	1,3

; *** The following are for vmem access to the hardware map ***

; ReadRP(Vp) -> RP
.rrp:	uReadFlags
	jmp	1,3

; ReadFlags(Vp) -> flags
.rfg:	uReadFlags
	mov	1,0		; get flags into ac0
	jmp	1,3

; SetFlags(vp, RP, flags)
.sfg:	uSetFlags
	jmp	1,3

; *** The following are for vmem read access ***

; BSetWriteBR(addr0, addr1) -> ()  Sets base register for writing
.bswBR:	sta	0, WBaseReg0
	sta	1, WBaseReg1
	jmp	1,3

; XSetWriteBR(ptr) -> ()  Sets base register for writing
.xswBR:	mov	3,1
	mov	0,3
	lda	0,0,3
	sta	0, WBaseReg0
	lda	0,1,3
	sta	0, WBaseReg1
	mov	3,0
	mov	1,3
	jmp	1,3

; XSetReadBR(ptr) -> ()  Sets base register for reading
.xsrBR:	mov	3,1
	mov	0,3
	lda	0,0,3
	sta	0, RBaseReg0
	lda	0,1,3
	sta	0, RBaseReg1
	mov	3,0
	mov	1,3
	jmp	1,3

; RRead(disp) -> value
.rrd:	lda	1, RBaseReg1
	addz	0,1			; carry set if overflow segment
	lda	0, RBaseReg0
	mov#	0,0 szc			; do nothing, skip if no carry
	inc	0,0			; next segment
; now an ordinary BGetBase, so fall on thru

; BGetBase(addr0, addr1) -> hi order word
.bgbs:	sta	3,1,2
doRD1:	uBGetBase
	jsr	fault
	lda	3,1,2
	jmp	1,3

; SGetBase(stackAddr) -> word
.sgbs:	mov	0,1
	lda	0, StackSpaceHi
	jmp	.bgbs

; XGetBase(ptr) -> word
.xgbs:	sta	3,1,2
	mov	0,3
	lda	0,0,3
	lda	1,1,3
	jmp	doRD1

; BGetBase1(addr0, addr1) -> low order word
.bgbs1: sta	3,1,2
doRD1x: uBGetBasePtr
	jsr	fault
	mov	1,0
	lda	3,1,2
	jmp	1,3

; XGetBase1(ptr) -> word
.xgbs1: sta	3,1,2
	mov	0,3
	lda	0,0,3
	lda	1,1,3
	jmp	doRD1x

; BGetBase32(addr0, addr1) -> {VPtr0,,VPtr1}
.bgb32: sta	3, 1,2
doRD32: uBGetBase32		; 32-bit value returned in AC0,,AC1
	jsr	fault
boxACs:	sta	0, VPtr0
	sta	1, VPtr1
	lda	0, lvVPtr
	lda	3,1,2
	jmp	1,3

; XGetBase32(ptr) -> {VPtr0,,VPtr1}
.xgb32: sta	3,1,2
	mov	0,3
	lda	0,0,3
	lda	1,1,3
	jmp	doRD32

; AGetBasePtr(atom#) -> {VPtr0,,VPtr1}
.agbPtr: movzl	0,1
	lda	0, ValSpaceLow
	add	0,1
	lda	0, ValSpaceHi
; falls thru to BGetBasePtr

; BGetBasePtr(addr0, addr1) -> {VPtr0,,VPtr1}
.bgbPtr: sta	3, 1,2
doRD2:	uBGetBasePtr		; ptr value returned in AC0,,AC1
	jsr	fault
	jmp	boxACs

; XGetBasePtr(ptr) -> {VPtr0,,VPtr1}
.xgbPtr: sta	3,1,2
	mov	0,3
	lda	0,0,3
	lda	1,1,3
	jmp	doRD2

; AtomNotNIL(atom#) -> true if atom is non NIL, else false
.ann:	sta	3,3,2		; store return in 3rd arg slot!!!
	movzl	0,1
	lda	0, ValSpaceHi
	uBGetBasePtr
	jsr	fault
	mov#	0,0, snr	; skip if not an atom, thus not NIL
	mov	1,0		; ac1 whether zero or not will do as result
	lda	3,3,2
	jmp	1,3

; *** Handler for Bcpl generated page faults ***
; This is tricky. We don't want to make a Bcpl frame unless we are
; calling PageFault, but the code must be reentrant b/c it can be called
; from interrupt routines (e.g., for the mouse and keyboard). Thus we
; have special purpose version of GetFrame here.  Points of note:
; The ucode has left faulting addr in {AC0,,AC1} - any other arg is in AC2(3)
; The addr of the faulter is left in AC2(2)
; We no longer care but we used to determine whether it was a read or write
; fault by comparing the fault addr with the address of this code. Thus
; all read routines had to precede this code and write routines follow it

fault:	sta	3,2,2		; addr of vmema routine that faulted
	mov	2,3
	lda	2,stksze	; negative number of words of stack needed
	add	3,2		; we now have a new stack ptr in AC2
	sta	1,5,2		; save AC1 for use in stk ovfl check
	lda	1,#335		; #335 = StackLimit
	subz#	1,2 snc		; skip unless we've gone too low
	SWAT
	sta	3,0,2		; link back to previous frame
	sta	0,4,2		; save addr hi, low part already saved
	lda	0,c4		; ac0 _ 4
	add	2,0		; ac0 _ lv 4(ac2) = lvAddr
	mov	2,1		; ac1 _ Frame pointer
	jsrii	pflt		; PageFault(lvAddr, ac2)
		2		; two arguments
	lda	0,4,2		; restore addr
	lda	1,5,2
	lda	2,0,2		; ditch frame
	lda	3,2,2		; retrieve addr of fault
	jmp	-2,3		; re-execute faulting instruction!!!!

pflt:	PageFault
stksze:	-6
c4:	4

; *** The following provide vmem write access

; RWrite(disp, value) -> ()
.rwt:	sta	1,3,2			; new value in AC2,3 for BPutBase
	lda	1, WBaseReg1
	addz	0,1			; carry set if overflow segment
	lda	0, WBaseReg0
	mov#	0,0 szc			; do nothing, skip if no carry
	inc	0,0			; next segment
; now an ordinary BPutBase, so fall on thru

; BPutBase(addr0, addr1, word) -> ()
.bpbs:	sta	3, 1,2
doRW1:	uBPutBase
	jsr	fault
	lda	3, 1,2
	jmp	1,3

; XPutBase(ptr, word) -> ()
.xpbs:	sta	3, 1,2
	sta	1,3,2
	mov	0,3
	lda	0,0,3
	lda	1,1,3
	jmp	doRW1

; SPutBase(stackAddr, word) -> ()
.spbs:	sta	1,3,2
	mov	0,1
	lda	0, StackSpaceHi
	jmp	.bpbs

; APutBase32(atom#, ptr) -> ()
.apbPtr: sta	1,3,2		; new value ptr in AC2,3
	movzl	0,1
	lda	0, ValSpaceLow
	add	0,1
	lda	0, ValSpaceHi
; fall thru into BPutBase32

; BPutBase32(addr0, addr1, ptr) -> ()
.bpbPtr: sta	3, 1,2
doRW2:	uBPutBase32
	jsr	fault
	lda	3, 1,2
	jmp	1,3

; XPutBase32(VAptr, valptr) -> ()
.xpbPtr: sta	3, 1,2
	sta	1,3,2		; valptr in AC2,3
	mov	0,3
	lda	0,0,3
	lda	1,1,3
	jmp	doRW2

StackSpaceHi:	27
ValSpaceHi:	22
ValSpaceLow:	0

; MiscStatsAdd1(i) increments the ith location in MISCSTATS by 1
.msa1:	subzl	1,1		; set ac1 to 1

; IncMiscStats(i,n) increment the ith location in MISCSTATS by n
.imss:	sta	1, incTemp

; must check for MISCSTATSbase having been initialized; the paging
; routines try to keep stats, even before there are any pages in core

	lda	1, MiscSTATSbase
	mov	1, 1, snr
	jmp	1, 3			; return
	sta	3, incRtn		; save return addr
	add	0, 1
	sta	1, incAddr		; save addr in stats
	lda	0, StatsSp
	jsr	@BGetBase1
incRtn:		0			; use as temp, nargs not checked
	lda	1, incTemp
	addz	0, 1, snc		; skip if overflow
	jmp	noovl
	sta	1, incTemp
	lda	1, incAddr		; addr in stats
	lda	0, StatsSp
	jsr	@BGetBase
incAddr:	0			; use as temp, nargs not checked
	inc	0, 0			; ovfl increment for hi word
 	sta	0, 3,2			; new value as 3rd arg
	lda	1, incAddr		; addr in stats
	lda	0, StatsSp
	jsr	@BPutBase		; store into hi order word
incTemp:	0			; use as temp, nargs not checked
	lda	1, incTemp
noovl:	sta	1, 3,2			; new value as 3rd arg
	lda	1, incAddr		; addr in stats
	inc	1, 1			; low word
	lda	0, StatsSp
 	lda	3, incRtn		; load our return addr and JMP
	jmp	@BPutBase		; store into low order word
StatsSp:	26			; use for constant, nargs not checked

; BitBltSUBR(Ebbt)
.xbbt:	sta	3, xbtrtn
	sta	2, xbtAC2
.dxbb0:	sta	0, xbtAC0
	sub	3,3 skp		; AC3 _ 0 and skip into loop
.dxbb2:	lda	0, xbtAC0
	XBITBLT
	 jmp	.dxbb2		; Nww int
	 jmp	.dxbb1		; Page fault
	lda	2, xbtAC2	; restore stack
	sub	1,1		; *** Strictly for debugging ***	
	sta	1, xbtAC2	; *** Strictly for debugging ***
	lda	3, xbtrtn
	jmp	1,3

.dxbb1:	lda	2, xbtAC2	; restore stack
	sta	3, xbtT		; store scan line count
	jmp	.dxbb4
	jmp	.dxbb3		; return from JSR fault comes here
.dxbb4:	jsr	fault
.dxbb3:	lda	3, xbtT
	jmp	.dxbb2

xbtAC0:	0
xbtAC2:	0
xbtT:	0
xbtrtn:	0

	.END