.TITLE	ZOBJ
	.IDENT	/V1.4/
; ++
; This is the Z-machine handler for object opcodes.
; (c) 2000 by Johnny Billquist
;
; History:
;
;	00-07-19	BQT	Initial coding started.
; Y1.0	00-08-26 21:00	BQT	First release.
; Y1.1	00-08-30 04:00	BQT	Bugfix in LOADB and LOADW. Address calc
;				should be with 32 bit numbers.
; Y1.2	00-08-31 20:00	BQT	Bugfix. The same goes for copy table.
; V1.3	00-09-16 12:00	BQT	Changed ZEXIT to ABORT.
;				Make it more officially done.
; V1.4	05-02-24 00:00	BQT	Started adding V6 functions.
; --
	.INCLUDE	/ZMAC/

	.PSECT	CODE,I,RO
;
; Routine to read a property header. V1-V3.
;
; In: R0 - Address of property.
;
; Out: R0 - Address of property data.
;      R2 - Size of property data.
;      R3 - Number of property.
;
PCV1::	.GETBB	R0,R3			; Get number
	INC	R0			; Point at data.
	MOV	R3,R2			; Get size.
	ASH	#-5,R2			; Size done.
	INC	R2
	BIC	#^C37,R3		; Number.
	RETURN
;
; Routine to read a property header for V4 and newer.
;
; See PCV1 for more info.
;
PCV4::	.GETBB	R0,R3			; Get number.
	INC	R0			; Point at next byte.
	BIT	#200,R3			; Two bytes?
	BNE	10$			; Yes.
	MOV	R3,R2			; No.
	ASH	#-6,R2			; Get size.
	INC	R2
5$:	BIC	#^C77,R3
	RETURN
10$:	.GETBB	R0,R2			; Get size.
	INC	R0
	BIC	#^C77,R2		; Mask bits.
	BNE	5$
	MOV	#64.,R2
	BR	5$
;
; GPA - Get property list address.
;
; In: R0 - Object number.
;
; Out: R0 - Property address list start.
;
GPA::	MOV	R1,-(SP)		; Save registers.
	MOV	R0,R1			; Get object number in R1.
	MUL	OBJLEN,R1		; Multiply by length of objects.
	ADD	ZOBJ,R1			; Add start of object list.
	ADD	OBJOFF,R1		; Add offset past global props.
	SUB	#2,R1			; Backup.
	.GETWB	R1,R0			; Read address.
	MOV	(SP)+,R1		; Restore registers.
	RETURN
;
; FNDPRO - Find property.
;
; In: R0 - Address where property list start.
;     R1 - Property number.
;
; Out: R0 - Address of property data.
;      R1 - Size of property in bytes.
;
FNDPRO::
	MOV	R2,-(SP)		; Save registers.
	MOV	R3,-(SP)
	.GETBB	R0,R2			; Read byte.
	ADD	R2,R0			; Skip past description.
	INC	R2			; Descr is length*2 + 1
10$:	ADD	R2,R0
	CALL	@NXTPRO			; Get next prop.
	CMP	R3,R1			; No match?
	BHI	10$			; Not yet...
	BEQ	30$			; Match.
;
; We didn't find a matching prop. Let's give the address of global
; prop...
;
	MOV	ZOBJ,R0			; Get object address.
	DEC	R1			; Make prop # bias 0.
	ASL	R1			; Make prop # into offset.
	ADD	R1,R0			; Get prop address.
	MOV	#2,R1			; Size is word.
	SEC				; Indicate we have global prop.
	BR	100$
;
; We found property.
;
30$:	MOV	R2,R1			; Get size in R1.
	CLC				; Okay.
100$:	MOV	(SP)+,R3		; Restore registers.
	MOV	(SP)+,R2
	RETURN				; Done.
;
; FNDOBJ - Find object.
;
; In:  R0 - Object number.
; Out: R0 - Byte address of object.
;
FNDOBJ::
	MOV	R1,-(SP)		; Save registers.
	MOV	R0,R1			; Get object # in R1.
	DEC	R1			; Objects start at 1.
	MUL	OBJLEN,R1		; Multiply by object size.
	ADD	ZOBJ,R1			; Add address of object table.
	ADD	OBJOFF,R1		; And skip default property list.
	MOV	R1,R0			; Save result.
	MOV	(SP)+,R1		; Restore registers.
	RETURN				; Done.
;
; FNDATR - Find attribute.
;
; In:  R0 - Address of attributes.
;      R1 - Attribute number.
; Out: R0 - Address of attribute byte.
;      R1 - Attribute mask.
;
FNDATR::
	MOV	R2,-(SP)		; Save registers.
	INC	R1			; Count attribs from 1.
	CLC				; Carry should be 0.
	MOV	#200,R2			; Get mask.
20$:	DEC	R1			; Count off attribs.
	BEQ	30$			; Done. We have the answer.
	RORB	R2			; Not done. Shift mask.
	BCC	20$			; Mask not finished. Repeat.
	INC	R0			; Mask finished. Bump address.
	RORB	R2
	BR	20$			; Do mask over again.
30$:	MOV	R2,R1			; Get mask in R1.
	MOV	(SP)+,R2		; Restore registers.
	RETURN				; Done.
;
; Remove object. V1-V3 objects.
;
; In: R0 - Object.
;
DORO3::	MOV	R0,-(SP)		; Save registers.
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	CLR	R3
	MOV	R0,R1			; Save object number.
	CALL	FNDOBJ			; Find object.
	ADD	#5,R0			; Address of sibling.
	.GETBB	R0,R2			; Get next sibling.
	DEC	R0			; Point at parent value.
	.GETBB	R0,R3			; Get parent object.
	.PUTBB	R0,#0			; Clear parent object.
	MOV	R3,R0			; Get parent obj in R0.
	BEQ	25$			; We didn't have a parent. Done...
	CALL	FNDOBJ			; Find object.
	INC	R0			; Adjust for child.
10$:	ADD	#5,R0			; Get sibling (child) object.
	.GETBB	R0,R3			; Get next sibling.
	BEQ	30$			; Ooops. None found.
	CMP	R1,R3			; Is the next us?
	BEQ	20$			; Yes.
	MOV	R3,R0			; No. Go to next child.
	CALL	FNDOBJ			; Get next object.
	BR	10$			; And try again.
;
; We have found the object previous to ours.
;
20$:	.PUTBB	R0,R2			; Link in the next object instead.
25$:	MOV	(SP)+,R3		; Restore registers.
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
;
; The child wasn't in the parents list...
;
30$:	.MSG	<"Fatal error. Child wasn't in parent list.">
	JMP	BADFUN
;
; Insert object in another object in V1-V3.
;
DOIO3::	CALL	DORO3			; Remove from current parent.
	MOV	R0,-(SP)		; Save registers.
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R0,R2			; Save object number.
	MOV	R1,R0			; Get parent.
	BEQ	10$			; No new real parent... Hmmm...
	CALL	FNDOBJ			; Find parent.
	ADD	#6,R0			; Point at child.
	.GETBB	R0,R3			; Get current first child.
	.PUTBB	R0,R2			; Save new first child.
10$:	MOV	R2,R0			; Get new child.
	CALL	FNDOBJ			; Find object.
	ADD	#4,R0			; Point at parent field.
	.PUTBB	R0,R1			; Set parent value.
	INC	R0			; Point at sibling value.
	.PUTBB	R0,R3			; Save sibling value.
	MOV	(SP)+,R3		; Restore registers.
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
;
; Remove object. V4-V8 objects.
;
; In: R0 - Object.
;
DORO4::	MOV	R0,-(SP)		; Save registers.
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R0,R1			; Save object number.
	CALL	FNDOBJ			; Find object.
	ADD	#8.,R0			; Address of sibling.
	.GETWB	R0,R2			; Get next sibling.
	SUB	#2,R0			; Point at parent value.
	.GETWB	R0,R3			; Get parent object.
	.PUTWB	R0,#0			; Clear parent object.
	MOV	R3,R0			; Get parent obj in R0.
	BEQ	25$			; We didn't have a parent. Done...
	CALL	FNDOBJ			; Find object.
	ADD	#2,R0			; Adjust for child.
10$:	ADD	#8.,R0			; Get sibling (child) object.
	.GETWB	R0,R3			; Get next sibling.
	BEQ	30$			; Ooops. None found.
	CMP	R1,R3			; Is the next us?
	BEQ	20$			; Yes.
	MOV	R3,R0			; No. Go to next child.
	CALL	FNDOBJ			; Get next object.
	BR	10$			; And try again.
;
; We have found the object previous to ours.
;
20$:	.PUTWB	R0,R2			; Link in the next object instead.
25$:	MOV	(SP)+,R3		; Restore registers.
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
;
; The child wasn't in the parents list...
;
30$:	.MSG	<"Fatal error. Child wasn't in parent list.">
	JMP	BADFUN
;
; Insert object in another object. V4-V8 objects.
;
DOIO4::	CALL	DORO4			; Remove from current parent.
	MOV	R0,-(SP)		; Save registers.
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R0,R2			; Save object number.
	MOV	R1,R0			; Get parent.
	BEQ	10$			; No new real parent... Hmmm...
	CALL	FNDOBJ			; Find parent.
	ADD	#10.,R0			; Point at child.
	.GETWB	R0,R3			; Get current first child.
	.PUTWB	R0,R2			; Save new first child.
10$:	MOV	R2,R0			; Get new child.
	CALL	FNDOBJ			; Find object.
	ADD	#6,R0			; Point at parent field.
	.PUTWB	R0,R1			; Set parent value.
	ADD	#2,R0			; Point at sibling value.
	.PUTWB	R0,R3			; Save sibling value.
	MOV	(SP)+,R3		; Restore registers.
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
;
; 2OP:11 B set_attr object attribute
;
	.ENABL	LSB
SATTR::	.INSTR	"set_attr",#2
	MOV	(R2)+,R0		; Get object.
	CALL	FNDOBJ
	MOV	(R2)+,R1		; Get attribute.
	CALL	FNDATR
	.GETBB	R0,R2			; Get attribute byte.
	BIS	R1,R2			; Set attribute.
	.PUTBB	R0,R2			; Save new attribute.
	RETURN
	.DSABL	LSB
;
; 2OP:12 C clear_attr object attribute
;
	.ENABL	LSB
CATTR::	.INSTR	"clear_attr",#2
	MOV	(R2)+,R0		; Get object.
	CALL	FNDOBJ
	MOV	(R2)+,R1		; Get attribute.
	CALL	FNDATR
	.GETBB	R0,R2			; Get attribute byte.
	BIC	R1,R2			; Clear bit.
	.PUTBB	R0,R2			; Seave new attribute.
	RETURN
	.DSABL	LSB
;
; 2OP:13 D store (variable) value
;
	.ENABL	LSB
STORE::	.INSTR	"store",#2
	MOV	(R2)+,R0		; Get variable.
	MOV	(R2),R1			; Get value.
	CALLR	STOREV
	.DSABL	LSB
;
; 2OP:14 E insert_obj object destination
;
	.ENABL	LSB
IOBJ::	.INSTR	"insert_obj",#2
	MOV	(R2)+,R0		; Get object.
	MOV	(R2),R1			; Get new parent.
	CALLR	@DOIO			; And insert.
	.DSABL	LSB
;
; 2OP:15 F loadw array word-index -> (result)
; LOADW - load a word. Address is arg0 + arg1*2
;
	.ENABL	LSB
LOADW::	.INSTR	"loadw",#2
	MOV	(R2),R3			; Get base address.
	CLR	R2			; As a 32-bit number.
	ADD	ARGS+2,R3		; Add offset * 2
	ADC	R2
	ADD	ARGS+2,R3
	ADC	R2
	CALL	ATRAN			; Translate address.
	CLR	-(SP)			; Create space on stack for result.
	MOVB	(R0),1(SP)		; Get high byte.
	INC	R3			; Next address.
	BNE	10$
	INC	R2
10$:	CALL	ATRAN
	MOVB	(R0),(SP)		; Get low byte.
	MOV	(SP)+,R0
	CALLR	RESULT
	.DSABL	LSB
;
; 2OP:16 10 loadb array byte-index -> (result)
; LOADB - Load a byte. Address is arg0+arg1.
;
	.ENABL	LSB
LOADB::	.INSTR	"loadb",#2
	MOV	(R2),R3			; Get base address.
	CLR	R2			; As a 32-bit number.
	ADD	ARGS+2,R3		; Get offset.
	ADC	R2
	CALL	ATRAN
	MOVB	(R0),R0
	BIC	#^C377,R0
	CALLR	RESULT
	.DSABL	LSB
;
; 2OP:17 11 get_prop object property -> (result)
;
	.ENABL	LSB
GPROP::	.INSTR	"get_prop",#2
	MOV	(R2)+,R0		; Get object number.
	CALL	GPA			; Get property list address.
	MOV	(R2),R1			; Get prop number.
	CALL	FNDPRO			; Find property address.
	DEC	R1			; Size of one byte?
	BEQ	10$			; Yes.
	DEC	R1			; Two bytes?
	BNE	30$			; Error.
	.GETWB	R0			; Get data.
	CALLR	RESULT
;
10$:	.GETBB	R0			; Get data.
	CALLR	RESULT			; We have the result.
30$:	.MSG	<"get_prop on data larger than 2 bytes!">
	JMP	BADFUN
	.DSABL	LSB
;
; 2OP:18 12 get_prop_addr object property -> (result)
;
	.ENABL	LSB
GPROPA::
	.INSTR	"get_prop_addr",#2
	MOV	(R2)+,R0		; Get object number.
	CALL	GPA
	MOV	(R2),R1			; Get prop number.
	CALL	FNDPRO			; Find property address.
	BCC	10$			; Found it?
	CLR	R0			; No. Clear result.
10$:	CALLR	RESULT			; Give answer.
	.DSABL	LSB
;
; 2OP:19 13 get_next_prop object property -> (result)
;
	.ENABL	LSB
GNPROP::
	.INSTR	"get_next_prop",#2
	MOV	(R2)+,R0		; Get object.
	CALL	GPA			; Get address of props.
	MOV	(R2),R1			; Get requested prop number.
	.GETBB	R0,R2			; Length of description.
	ADD	R2,R0
	ADD	R2,R0
	INC	R0
	TST	R1			; Is this the address we want?
	BEQ	100$			; Yes.
30$:	CALL	@NXTPRO			; No. Get next prop.
	ADD	R2,R0			; Point at next property.
	CMP	R3,R1			; Check property number.
	BHI	30$			; Still more to go?
	BEQ	100$			; This was the correct entry.
	.MSG	<"Tried next_prop on bad prop. Obj %D, P: %D">,ARGS,ARGS+2
	JMP	BADFUN
100$:	CALL	@NXTPRO			; Get number of next prop.
	MOV	R3,R0
	CALLR	RESULT			; Done.
	.DSABL	LSB
;
; 1OP:129 1 get_sibling object -> (result) ?(label)
;
	.ENABL	LSB
GSIB::	.INSTR	"get_sibling",#1
	MOV	(R2),R0			; Get object.
	CALL	FNDOBJ
	CMP	ZVER,#3
	BHI	10$			; V4 or later...
	ADD	#5,R0			; Sibling address.
	.GETBB	R0			; Get sibling.
	BR	20$
10$:	ADD	#8.,R0
	.GETWB	R0
20$:	CALL	RESULT
	TST	R0
	BEQ	30$
	JMP	BTRUE
30$:	JMP	BFALSE
	.DSABL	LSB
;
; 1OP:130 2 get_child object -> (result) ?(label)
;
	.ENABL	LSB
GCHLD::	.INSTR	"get_child",#1
	MOV	(R2),R0			; Get object.
	CALL	FNDOBJ
	CMP	ZVER,#3
	BHI	10$			; V4 or later...
	ADD	#6,R0			; Sibling address.
	.GETBB	R0			; Get child.
	BR	20$
10$:	ADD	#10.,R0
	.GETWB	R0
20$:	CALL	RESULT
	TST	R0
	BEQ	30$
	JMP	BTRUE
30$:	JMP	BFALSE
	.DSABL	LSB
;
; 1OP:131 3 get_parent object -> (result)
;
	.ENABL	LSB
GPAREN::
	.INSTR	"get_parent",#1
	MOV	(R2),R0			; Get object.
	CALL	FNDOBJ
	CMP	ZVER,#3
	BHI	10$			; V4 or later...
	ADD	#4,R0			; Sibling address.
	.GETBB	R0			; Get parent.
	CALLR	RESULT
10$:	ADD	#6,R0
	.GETWB	R0
	CALLR	RESULT
	.DSABL	LSB
;
; 1OP:132 4 get_prop_len property-address -> (result)
;
	.ENABL	LSB
GPROPL::
	.INSTR	"get_prop_len",#1
	MOV	(R2),R0			; Get property address.
	CMP	ZVER,#3			; Two different algorithms...
	BHI	10$			; >V3 is more advanced.
;
; Get length of property in V1-V3.
;
	DEC	R0			; Address of length byte.
	.GETBB	R0			; Read byte.
	ASH	#-5,R0			; Shift down.
	INC	R0			; And adjust.
	CALLR	RESULT			; That's the answer.
;
; Get property length in V4 and later.
;
10$:	DEC	R0			; Backup.
	.GETBB	R0			; Get byte.
	BIT	#200,R0			; Is this a two-byte entry?
	BNE	20$			; Yes.
	ASH	#-6,R0			; No. Size is in bit 6.
	INC	R0			; Adjust.
	CALLR	RESULT
20$:	BIC	#^C77,R0		; Size is 6 bits.
	BNE	30$			; Size zero means 64.
	MOV	#64.,R0
30$:	CALLR	RESULT
	.DSABL	LSB
;
; 1OP:137 9 remove_obj object
;
	.ENABL	LSB
REMOBJ::
	.INSTR	"remove_obj",#1
	MOV	(R2),R0			; Get object.
	CALLR	@DORO
	.DSABL	LSB
;
; 1OP:142 E load (variable) -> (result)
; Load value of variable.
; (This is silly. Why not just use a variable argument?)
;
	.ENABL	LSB
LOAD::	.INSTR	"load",#1
	MOV	(R2),R0			; Get variable number.
	CALL	VARVAL			; Get value of variable.
	MOV	R1,R0
	CALLR	RESULT			; Save value.
	.DSABL	LSB
;
; 0OP:185 9 1 pop
;
	.ENABL	LSB
POP::	.INSTR	"pop",#0
	ADD	#2,R5			; Just drop from stack.
	RETURN
	.DSABL	LSB
;
; EXT:21 15 6 pop_stack items stack
;
	.ENABL	LSB
POPSTK::
	.INSTR	"pop_stack"
	MOV	(R2)+,R0
	CMP	R3,#1			; System stack?
	BNE	10$			; No.
	ADD	R0,R5			; Yes. Simple. Just add value*2 to
	ADD	R0,R5			; stack pointer.
	RETURN				; Done.
10$:	MOV	(R2),R1			; User specified stack. Get address.
	.GETWB	R1,R2			; Read header word.
	ADD	R0,R2			; Add the freed words to free size.
	.PUTWB	R1,R2			; Save new header value.
	RETURN				; Done.
;
; VAR:225 1 storew array word-index value
;
	.ENABL	LSB
STOREW::
	.INSTR	"storew",#3
	MOV	(R2)+,R0		; Get address of base.
	ADD	(R2),R0			; Add offset*2.
	BCS	10$
	ADD	(R2)+,R0
	BCS	10$
	.PUTWB	R0,(R2)			; Write data to the resulting address.
	RETURN
10$:	.MSG	<"storew over write limit. %M+2*%M.">,ARGS,ARGS+2
	JMP	BADFUN
	.DSABL	LSB
;
; VAR:226 2 storeb array byte-index value
;
	.ENABL	LSB
STOREB::
	.INSTR	"storeb",#3
	MOV	(R2)+,R0		; Get base address.
	ADD	(R2)+,R0		; Add offset.
	BCS	10$
	.PUTBB	R0,(R2)			; And store value at this address.
	RETURN
10$:	.MSG	<"storeb over write limit. %M+%M.">,ARGS,ARGS+2
	JMP	BADFUN
	.DSABL	LSB
;
; VAR:227 3 put_prop object property value
;
	.ENABL	LSB
PUTPRP::
	.INSTR	"put_prop",#3
	MOV	(R2)+,R0		; Get object number.
	CALL	GPA
	MOV	(R2)+,R1		; Get property number.
	CALL	FNDPRO			; Find property.
	BCS	10$			; Property not found.
	DEC	R1			; Size of one byte?
	BEQ	1$			; Yes.
	DEC	R1			; Two bytes?
	BEQ	2$			; Yes.
;
	.MSG	<"Property size is bad: %D+2 bytes.">,R1
	JMP	BADFUN
;
1$:	.PUTBB	R0,(R2)
	RETURN
2$:	.PUTWB	R0,(R2)
	RETURN
;
10$:	.MSG	<"Property not found. %D.">,ARGS+2
	JMP	BADFUN
	.DSABL	LSB
;
; VAR:232 8 push value
;
	.ENABL	LSB
PUSH::	.INSTR	"push",#1
	.DBG	#D.STK,<"Pusing value on stack. SP = %P. Value is %D.">,R5,(R2)
	MOV	(R2),-(R5)		; Very simple.
	RETURN
	.DSABL	LSB
;
; EXT:24 18 6 push_stack value stack ?(label)
;
	.ENABL	LSB
PUSHUS::
	.INSTR	"push_stack",#2
	MOV	2(R2),R0	; Get stack.
	.GETWB	R0,R1		; Get free slots.
	BEQ	10$		; Stack full...
	MOV	R1,-(SP)	; Save free size.
	ASL	R1		; Multiply by 2.
	ADD	R0,R1		; Get address of free slot.
	.PUTWB	R1,(R2)		; Save value.
	MOV	(SP)+,R1	; Get free size again.
	DEC	R1		; One less left.
	.PUTWB	R0,R1		; Save new free slots.
	CALLR	BTRUE		; All good.
10$:	CALLR	BFALSE
;
; VAR:233 9 1 pull (variable)
;
	.ENABL	LSB
PULL1::	.INSTR	"pull(1)",#1
	MOV	(R2),R0			; Get variable where to store result.
	MOV	(R5)+,R1		; Get value to store.
	.DBG	D.STK,<"Pulling from stack. SP = %P. Value is %D.">,R5,R1
	CALLR	STOREV			; Store result.
	.DSABL	LSB
;
; VAR:233 9 6 pull stack -> (result)
;
	.ENABL	LSB
PULL2::	.INSTR	"pull(6)"
	TST	R3		; User specified stack?
	BNE	10$		; Yes.
	MOV	(R5)+,R0	; No. Very simple. Just pop value.
	CALLR	RESULT		; Done.
10$:	MOV	(R2),R0		; User specified stack. Get address.
	.GETWB	R0,R1		; Read free size.
	INC	R1		; Increment free size.
	.PUTWB	R0,R1		; Store new free size.
	ASL	R1		; *2 now gives offset to address of data.
	ADD	R0,R1		; Point at actual data.
	.GETWB	R1,R0		; Read data.
20$:	CALLR	RESULT
	.DSABL	LSB
;
; VAR:253 1D 5 copy_table first second size
;
; A short note. Source might get into high memory, so we'll keep
; that in R2,R3. Destination however, must be in dynamic memory,
; so we can keep that in a specific register.
;
	.ENABL	LSB
CPYTAB::
	.INSTR	"copy_table",#3
	MOV	R4,-(SP)		; Save registers.
	MOV	R5,-(SP)
	MOV	4(R2),R0		; Length.
	BEQ	CDON			; No length. Done.
	MOV	R0,R4			; Get length in R4.
	BPL	1$			; If positive, we're good.
	NEG	R4			; If negative, invert it.
1$:	MOV	(R2)+,R3		; Source.
	MOV	(R2),R5			; Destination...
	BEQ	CLR			; No destination. Do a clear.
	TST	R0			; Check if forced up.
	BMI	CUP			; Yes.
	CMP	R5,R3			; Check if need to copy up.
	BLO	CUP			; dst < src - copy up.
;
; We know we shall copy down.
; R5 - destination
; R3 - source
; R4 - length
;
	ADD	ZEROP,R5
	ADD	R4,R5			; Point past end of tables.
	CLR	R2
	ADD	R4,R3
	ADC	R2
;
; Now we have the destination end physical address in R5, while the
; source virtual end is in R2,R3
; R4 holds length.
;
; We shall copy down... We might have overlap, or not.
; Who cares, we do know that we don't have a negative overlap.
;
CDN:	SUB	#1,R3			; Next virtual address.
	SBC	R2
	CALL	ATRAN			; Translate address.
	MOVB	(R0),-(R5)		; Copy byte.
	SOB	R4,CDN			; Loop.
	BR	CDON			; Done.
;
; We know we shall copy up.
; R5 - destination
; R3 - source
; R4 - length
;
CUP:	ADD	ZEROP,R5		; Make to physical address.
	CLR	R2
;
; Now we have the destination physical address in R5, while the
; source virtual is in R2,R3
; R4 holds length.
;
; We shall copy up... We might have overlap, or not.
; Who cares, we do know that we don't have a negative overlap.
;
10$:	CALL	ATRAN			; Translate address.
	MOVB	(R0),(R5)+		; Copy byte.
	INC	R3			; Next virtual address.
	BNE	20$
	INC	R2
20$:	SOB	R4,10$			; Loop.
	BR	CDON
;
; We shall clear memory.
; Address is actually in source.
;
CLR:	ADD	ZEROP,R3		; Make physical.
30$:	CLRB	(R3)+			; Clear data.
	SOB	R4,30$			; Loop.
CDON:	MOV	(SP)+,R5		; Restore registers.
	MOV	(SP)+,R4
	RETURN
;
	.DSABL	LSB
;
	.END