; VMemA.asm. Interlisp-D virtual memory package
; Changed StackHi December 14, 1984  2:12 PM van Melle
; Pruned unused routines May 21, 1984  3:47 PM van Melle
; 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, ReadFlags, ReadRP, SetFlags
	.ent	BGetBase32, XGetBase32
	.ent	BGetBasePtr, XGetBasePtr
	.ent	BSetWriteBR, XSetReadBR, XSetWriteBR, RRead, RWrite
	.ent	XGetBase
	.ent	BGetBase, BPutBase
	.ent	SGetBase, SPutBase
	.ent	BPutBase32
	.ent	Fault

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

; procedures used
	.extn	PageFault

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

	.dusr	SWAT         = #77400

	.ZREL

BGetBase32:	.bgb32
XGetBase32:	.xgb32
BGetBasePtr:	.bgbPtr
XGetBasePtr:	.xgbPtr
BSetWriteBR:	.bswBR
XSetWriteBR:	.xswBR
XSetReadBR:	.xsrBR
RRead:		.rrd
RWrite:		.rwt
XGetBase:	.xgbs
BGetBase:	.bgbs
SGetBase:	.sgbs
BPutBase:	.bpbs
SPutBase:	.spbs
BPutBase32:	.bpbPtr

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

	.SREL
BP:		.bp
ReadRP:		.rrp
ReadFlags:	.rfg
SetFlags:	.sfg
Fault:		fault		; not called - makes Swat stack prettier

	.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

; *** 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

; 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

; BGetBasePtr(addr0, addr1) -> {VPtr0,,VPtr1}
.bgbPtr: sta	3, 1,2
doRD2:	uBGetBase32		; ptr value returned in AC0,,AC1
	jsr	fault
	lda	3, RMSK		; mask right half of hi word
	and	3, 0
	jmp	boxACs

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


; *** 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

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

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

StackSpaceHi:	1


	.END