erkyrath.infocom-zcode-terps/64/lzip/ops012.asm

	PAGE	
	SBTTL "--- 0-OPS ---"


; -----
; RTRUE
; -----
; SIMULATE A "RETURN 1"

ZRTRUE:	LDX	#1	
ZRT0:	LDA	#0	
ZRT1:	STX	ARG1+LO	; GIVE TO
	STA	ARG1+HI	; [ARG1]
	JMP	ZRET	; AND DO THE RETURN


; ------
; RFALSE
; ------
; SIMULATE A "RETURN 0"

ZRFALS:	LDX	#0	
	BEQ	ZRT0	


; ------
; PRINTI
; ------
; PRINT Z-STRING FOLLOWING THE OPCODE

ZPRI:	LDX	#5	;MOVE ZPC INTO MPC
ZPRI1:			
	LDA	ZPC,X	
	STA	MPC,X	
	DEX		
	BPL	ZPRI1	;NO NEED TO VALIDATE AS ZPC WAS VALID ANYWAY
	JSR	PZSTR	; PRINT THE Z-STRING AT [MPC]
	LDX	#5	; COPY STATE OF [MPC]
ZPRI2:	LDA	MPC,X	; INTO [ZPC]
	STA	ZPC,X	
	DEX		
	BPL	ZPRI2	
	RTS		


; ------
; PRINTR
; ------
; DO A "PRINTI," FOLLOWED BY "CRLF" AND "RTRUE"

ZPRR:	JSR	ZPRI	
	JSR	ZCRLF	
	JMP	ZRTRUE	


; ------
; RSTACK
; ------
; "RETURN" WITH VALUE ON STACK

ZRSTAK:	JSR	POPVAL	; GET VALUE INTO [X/A]
	JMP	ZRT1	; AND GIVE IT TO "RETURN"


; ------
; VERIFY
; ------
; VERIFY GAME CODE ON DISK

ZVER:	JSR	ZCRLF		; DISPLAY VERSION NUMBER, GET SIDE 1
	LDX	#3
	LDA	#0
ZVR:	STA	K+LO,X		; CLEAR [K], [L]
	STA	MPC,X		; [MPC] AND [MPCFLG]
	DEX
	BPL	ZVR
	LDA	#64		; POINT [MPC] TO Z-ADDRESS $00040
	STA	MPCL		; 1ST 64 BYTES AREN'T CHECKED
	LDA	ZBEGIN+ZLENTH	; GET MSB
	STA	I+HI		; AND
	LDA	ZBEGIN+ZLENTH+1	; LSB OF Z-CODE LENGTH IN BYTES
	ASL	A		; MULTIPLY BY
	ROL	I+HI		; FOUR
	ROL	K+LO
	ASL	A
	STA	I+LO
	ROL	I+HI		; TO GET # BYTES
	ROL	K+LO		; IN GAME
	LDA	#0		; START AT BEGINNING
	STA	DBLOCK+LO
	STA	DBLOCK+HI
	JMP	READIN		; READ FIRST BLOCK IN

VSUM:	LDA	MPCL		; NEW PAGE?
	BNE	VSUM2		; NO, CONTINUE
READIN:	LDA	#HIGH IOBUFF	; FAKE READ OUT SO
	STA	DBUFF+HI	; IT DOESN'T MOVE BUFFER
	JSR	GETDSK		; GO READ A PAGE
	BCC	VSUM2
	JMP	DSKERR		; BAD DISK!!!!!

VSUM2:	LDY	MPCL		; GET THIS BYTE
	LDA	IOBUFF,Y
	INC	MPCL		; SET FOR NEXT BYTE
	BNE	VSUM3
	INC	MPCM
	BNE	VSUM3
	INC	MPCH
VSUM3:	CLC
	ADC	L+LO		; ADD IT TO SUM
	STA	L+LO		; IN [J]
	BCC	VSUM1
	INC	L+HI
VSUM1:	LDA	MPCL		; END OF Z-CODE YET?
	CMP	I+LO		; CHECK LSB
	BNE	VSUM
	LDA	MPCM		; MIDDLE BYTE
	CMP	I+HI
	BNE	VSUM
	LDA	MPCH		; AND HIGH BIT
	CMP	K+LO
	BNE	VSUM

	LDA	ZBEGIN+ZCHKSM+1	; GET LSB OF CHECKSUM
	CMP	L+LO		; DOES IT MATCH?
	BNE	BADVER		; NO, PREDICATE FAILS
	LDA	ZBEGIN+ZCHKSM	; ELSE CHECK MSB
	CMP	L+HI		; LOOK GOOD?
	BNE	BADVER		; IF MATCHED,
	JMP	PREDS		; GAME IS OKAY
BADVER:	JMP	PREDF	



	PAGE	
	SBTTL "--- 1-OPS ---"


; -----
; ZERO?
; -----
; [ARG1] = 0?

ZZERO:	LDA	ARG1+LO	
	ORA	ARG1+HI	
	BEQ	PFINE	
PYUCK:	JMP	PREDF	


; -----
; NEXT?
; -----
; RETURN "NEXT" POINTER IN OBJECT [ARG1] ;
; FAIL IF LAST AND RETURN ZERO

ZNEXT:	LDA	ARG1+LO	
	LDX	ARG1+HI	; (EZIP)
	JSR	OBJLOC	; GET OBJECT ADDR INTO [I]
	LDY	#8	; POINT TO "NEXT" SLOT (EZIP)
	BNE	FIRST1	; JMP


; ------
; FIRST?
; ------
; RETURN "FIRST" POINTER IN OBJECT [ARG1] ;
; FAIL IF LAST AND RETURN ZERO
; (EZIP ALTERATIONS)

ZFIRST:	LDA	ARG1+LO	
	LDX	ARG1+HI	
	JSR	OBJLOC	; GET OBJECT ADDR INTO [I]
	LDY	#10	; POINT TO "FIRST" SLOT
FIRST1:	LDA	(I),Y	; GET CONTENTS OF SLOT
	TAX		
	INY		
	LDA	(I),Y	; INTO A,X
	JSR	PUTBYT	; PASS IT TO VARIABLE
	LDA	VALUE+LO	; EXAMINE THE VALUE JUST "PUT"
	BNE	PFINE	
	LDA	VALUE+HI	
	BEQ	PYUCK	; FAIL IF IT WAS ZERO
PFINE:	JMP	PREDS	; ELSE REJOICE


; ---
; LOC
; ---
; RETURN THE OBJECT CONTAINING OBJECT [ARG1] ;
; RETURN ZERO IF NONE
; (EZIP ALTERED)

ZLOC:	LDA	ARG1+LO	
	LDX	ARG1+HI	
	JSR	OBJLOC	; GET ADDR OF OBJECT INTO [I]
	LDY	#6	; POINT TO "LOC" SLOT
	LDA	(I),Y	; GET THE WORD
	TAX		
	INY		
	LDA	(I),Y	
	JMP	PUTBYT	; AND SHIP IT OUT


; ------
; PTSIZE
; ------
; RETURN LENGTH OF PROP TABLE [ARG1] IN BYTES

ZPTSIZ:	LDA	ARG1+HI		; MOVE ABS ADDR OF
	CLC			; THE PROP TABLE
	ADC	ZCODE		; INTO [I]
	STA	I+HI
	LDA	ARG1+LO		; DECREMENT THE
	SEC			; ADDRESS
	SBC	#1		; WHILE MOVING LSB
	STA	I+LO
	BCS	PTZ0
	DEC	I+HI
PTZ0:	LDY	#0		; GET THE LENGTH
	LDA	(I),Y		; OF PROPERTY AT [I] INTO [A]
	BMI	PTZ2		; BIT 7 = 1, LENGTH LOW  2 BYTES
	AND	#%01000000
	BEQ	PTZ1		; BIT 6 = 0, LENGTH = 1
	LDA	#2		; BIT 6 = 1, LENGTH = 2
	BNE	PTZ3		; JMP
PTZ1:	LDA	#1
	BNE	PTZ3		; JMP
PTZ2:	AND	#%00111111	; SIZE > 2
PTZ3:	LDX	#0		; CLEAR FOR PUTBYT
	JMP	PUTBYT


; ---
; INC
; ---
; INCREMENT VARIABLE [ARG1]

ZINC:	LDA	ARG1+LO	
	JSR	VARGET	; FETCH VARIABLE INTO [VALUE]
	INC	VALUE+LO
	BNE	ZINC1
	INC	VALUE+HI
ZINC1:	JMP	ZD0


; ---
; DEC
; ---
; DECREMENT VARIABLE [ARG1]

ZDEC:	LDA	ARG1+LO	
	JSR	VARGET	; FETCH VAR INTO [VALUE]
	LDA	VALUE+LO	
	SEC		
	SBC	#1	
	STA	VALUE+LO	
	LDA	VALUE+HI	
	SBC	#0	
	STA	VALUE+HI	
ZD0:	LDA	ARG1+LO	; PUT RESULT BACK
	JMP	VARPUT	; INTO THE SAME VARIABLE


; ------
; PRINTB
; ------
; PRINT Z-STRING AT [ARG1]

ZPRB:	LDA	ARG1+LO	
	STA	I+LO	
	LDA	ARG1+HI	
	STA	I+HI	
	JSR	SETWRD	; MOVE Z-ADDR TO [MPC]
	JMP	PZSTR	; AND PRINT


; ------
; REMOVE
; ------
; MOVE OBJECT [ARG1] INTO PSEUDO-OBJECT #0
; (EZIP CHANGES - 1) OBJLOC NEEDS HI & LO
; 2) MOVES AND COMPARES 2 BYTES)

ZREMOV:	LDA	ARG1+LO	; GET SOURCE OBJECT ADDR
	LDX	ARG1+HI	
	JSR	OBJLOC	; INTO [I]
	LDA	I+LO	; COPY THE SOURCE ADDR
	STA	J+LO	; INTO [J]
	LDA	I+HI	; FOR LATER REFERENCE
	STA	J+HI	
	LDY	#7	; POINT TO "LOC" SLOT
	LDA	(I),Y	; GET THE DATA
	STA	K	; HOLD IT
	DEY		
	LDA	(I),Y	
	TAX		; X = HI
	LDA	K	; A = LO
	ORA	(I),Y	; COMPARE BYTES
	BEQ	REMVEX	; SCRAM IF NO OBJECT
	LDA	K	; PICK UP, DESTROYED BY ORA
	JSR	OBJLOC	; ELSE GET ADDR OF OBJECT [A] INTO [I]
	LDY	#10	; POINT TO "FIRST" SLOT
	LDA	(I),Y	; GRAB DATA
	TAX		
	INY		
	LDA	(I),Y	; A=LO, X=HI
	CMP	ARG1+LO	; IS THIS THE FIRST?
	BNE	REMVC1	; NO, KEEP SEARCHING
	CPX	ARG1+HI	; HM?
	BNE	REMVC1	
	LDY	#8	; ELSE COPY SOURCE'S "NEXT" SLOT
	LDA	(J),Y	
	INY		; INTO DEST'S "FIRST" SLOT ([Y] = 10)
	INY		
	STA	(I),Y	
	DEY		; BACK UP TO GET HIGH BYTE
	LDA	(J),Y	
	INY		
	INY		
	STA	(I),Y	
	BNE	REMVC2	; BRANCH ALWAYS
REMVC1:	JSR	OBJLOC	
	LDY	#8	; GET "NEXT"
	LDA	(I),Y	
	TAX		
	INY		
	LDA	(I),Y	
	CMP	ARG1+LO	; FOUND IT?
	BNE	REMVC1	; NO, KEEP TRYING
	CPX	ARG1+HI	
	BNE	REMVC1	
	LDY	#8	; WHEN FOUND
	LDA	(J),Y	; MOVE "NEXT" SLOT OF SOURCE (THIS OBJECT)
	STA	(I),Y	; TO "NEXT" SLOT OF DEST
			;(OBJECT THAT REFERENCED THIS ONE)
	INY		
	LDA	(J),Y	
	STA	(I),Y	
REMVC2:	LDA	#0	
	LDY	#6	; CLEAR "LOC"
	STA	(J),Y	
	INY		
	STA	(J),Y	
	INY		; AND "NEXT" SLOTS ([Y] = 5)
	STA	(J),Y	; OF SOURCE OBJECT (ARG1)
	INY		
	STA	(J),Y	
REMVEX:	RTS		


; ------
; PRINTD
; ------
; PRINT SHORT DESCRIPTION OF OBJECT [ARG1]

ZPRD:	LDA	ARG1+LO	
	LDX	ARG1+HI	; (EZIP)

	; ENTRY POINT FOR "USL"

PRNTDC:	JSR	OBJLOC	; GET ADDR OF OBJECT INTO [I]
	LDY	#12	; GET PROP TABLE POINTER (EZIP)
	LDA	(I),Y	; FETCH MSB
	TAX		; SAVE IT HERE
	INY		
	LDA	(I),Y	; FETCH LSB
	STA	I+LO	; STORE LSB
	STX	I+HI	; AND MSB
	INC	I+LO	; POINT PAST THE
	BNE	PDC0	; LENGTH BYTE
	INC	I+HI	
PDC0:	JSR	SETWRD	; CALC Z-STRING ADDR
	JMP	PZSTR	; AND PRINT IT


; ------
; RETURN
; ------
; RETURN FROM "CALL" WITH VALUE [ARG1]

ZRET:	LDA	OLDZSP+LO	; RE-SYNC THE
	STA	ZSP+LO	; Z-STACK POINTER
	LDA	OLDZSP+HI	
	STA	ZSP+HI	
	JSR	POPVAL	; POP # LOCALS INTO [X/A]
	STX	I+HI	; SAVE HERE
	TXA		; SET FLAGS; ANY LOCALS?
	BEQ	RET2	; SKIP IF NOT

	; RESTORE PUSHED LOCALS

	DEX		; ZERO-ALIGN
	TXA		; AND
	ASL	A	; WORD-ALIGN # LOCALS
	STA	I+LO	; FOR USE AS A STORAGE INDEX
RET1:	JSR	POPVAL	; POP A LOCAL INTO [X/A]
	LDY	I+LO	; RETRIEVE STORAGE INDEX
	STA	LOCALS+HI,Y	; STORE MSB OF LOCAL
	TXA		; MOVE LSB
	STA	LOCALS+LO,Y	; AND STORE THAT TOO
	DEC	I+LO	
	DEC	I+LO	; UPDATE STORAGE INDEX
	DEC	I+HI	; AND LOCALS COUNT
	BNE	RET1	; POP TILL NO MORE LOCALS

	; RESTORE OTHER VARIABLES

RET2:	JSR	POPVAL	; POP [ZPCH] AND [ZPCM]
	STX	ZPCM	
	STA	ZPCH	
	JSR	POPVAL	; POP AND RESTORE

	;EZIP STX OLDZSP

	STA	ZPCL	
	JSR	POPVAL	
	STX	OLDZSP+LO	
	STA	OLDZSP+HI	
	JSR	VLDZPC	;MAKE VALID
	JSR	A12VAL	; MOVE [ARG1] TO [VALUE]
PATCHI	EQU	$+1	; FOR ZINPUT RTN (IF A FCN CALL) (EZIP)
	JMP	PUTVAL	; AND RETURN IT


; ----
; JUMP
; ----
; JUMP TO Z-LOCATION IN [ARG1]

ZJUMP:	JSR	A12VAL	; MOVE [ARG1] TO [VALUE]
	JMP	PREDB3	; A BRANCH THAT ALWAYS SUCCEEDS


; -----
; PRINT
; -----
; PRINT Z-STRING AT WORD (QUAD) POINTER [ARG1]

ZPRINT:	LDA	ARG1+LO	
	STA	I+LO	
	LDA	ARG1+HI	
	STA	I+HI	
	JSR	SETSTR	; CALC STRING ADDRESS
	JMP	PZSTR	; AND PRINT IT


; -----
; VALUE
; -----
; RETURN VALUE OF VARIABLE [ARG1]

ZVALUE:	LDA	ARG1+LO	
	JSR	VARGET	; GET THE VALUE
	JMP	PUTVAL	; EASY ENOUGH


; ----
; BCOM
; ----
; COMPLEMENT [ARG1]

ZBCOM:	LDA	ARG1+LO	
	EOR	#$FF	
	TAX		
	LDA	ARG1+HI	
	EOR	#$FF	

	; FALL THROUGH ...


; ---------------------
; RETURN VALUE IN [X/A]
; ---------------------

VEXIT:	STX	VALUE+LO	
	STA	VALUE+HI	
	JMP	PUTVAL	



	PAGE	
	SBTTL "--- 2-OPS ---"


; -----
; LESS?
; -----
; [ARG1] HIGH  [ARG2]?

ZLESS:	JSR	A12VAL	; MOVE [ARG1] TO [VALUE]
	JMP	DLS0	; MOVE [ARG2] TO [I] & COMPARE


; ------
; DLESS?
; ------
; DECREMENT [ARG1] ; SUCCEED IF HIGH  [ARG2]

ZDLESS:	JSR	ZDEC	; MOVES ([ARG1]-1) TO [VALUE]
DLS0:	LDA	ARG2+LO	; MOVE [ARG2] TO [I]
	STA	I+LO	
	LDA	ARG2+HI	
	STA	I+HI	

	JMP	COMPAR	; COMPARE & RETURN


; -----
; GRTR?
; -----
; [ARG1] LOW  [ARG2]?

ZGRTR:	LDA	ARG1+LO	; MOVE [ARG1] TO [I]
	STA	I+LO	
	LDA	ARG1+HI	
	STA	I+HI	
	JMP	A2VAL	; MOVE [ARG2] TO [VALUE] & COMPARE


; ------
; IGRTR?
; ------
; INCREMENT [ARG1] ; SUCCEED IF GREATER THAN [ARG2]

ZIGRTR:	JSR	ZINC	; GET ([ARG1]+1) INTO [VALUE]
	LDA	VALUE+LO	; MOVE [VALUE] TO [I]
	STA	I+LO	
	LDA	VALUE+HI	
	STA	I+HI	
A2VAL:	LDA	ARG2+LO	; MOVE [ARG2] TO [VALUE]
	STA	VALUE+LO	
	LDA	ARG2+HI	
	STA	VALUE+HI	


; -----------------
; SIGNED COMPARISON
; -----------------
; ENTRY: VALUES IN [VALUE] AND [I]

COMPAR:	LDA	I+HI
	EOR	VALUE+HI
	BPL	SCMP
	LDA	I+HI
	CMP	VALUE+HI
	BCC	PGOOD
	JMP	PREDF

SCMP:	LDA	VALUE+HI
	CMP	I+HI
	BNE	SCEX
	LDA	VALUE+LO
	CMP	I+LO
SCEX:	BCC	PGOOD
	JMP	PREDF


; ---
; IN?
; ---
; IS OBJECT [ARG1] CONTAINED IN OBJECT [ARG2]?

ZIN:	LDA	ARG1+LO	
	LDX	ARG1+HI	
	JSR	OBJLOC	; GET ADDR OF TARGET OBJECT INTO [I]
	LDY	#6	; POINT TO "LOC" SLOT
	LDA	(I),Y	; GET DATA
	CMP	ARG2+HI	; IS IT THERE?
	BNE	PBAD	; NO
	INY		
	LDA	(I),Y	
	CMP	ARG2+LO	
	BEQ	PGOOD	; YES, SUCCEED
PBAD:	JMP	PREDF	; TOO BAD, CHUM ...


; ----
; BTST
; ----
; IS EVERY "ON" BIT IN [ARG1]
; ALSO "ON" IN [ARG2]?

ZBTST:	LDA	ARG2+LO	; FIRST CHECK LSBS
	AND	ARG1+LO	
	CMP	ARG2+LO	; LSBS MATCH?
	BNE	PBAD	; NO, EXIT NOW
	LDA	ARG2+HI	; ELSE CHECK MSBS
	AND	ARG1+HI	
	CMP	ARG2+HI	; MATCHED?
	BNE	PBAD	; SORRY ...
PGOOD:	JMP	PREDS	


; ---
; BOR
; ---
; RETURN [ARG1] "OR" [ARG2]

ZBOR:	LDA	ARG1+LO	
	ORA	ARG2+LO	
	TAX		
	LDA	ARG1+HI	
	ORA	ARG2+HI	
	JMP	VEXIT	


; ----
; BAND
; ----
; RETURN [ARG1] "AND" [ARG2]

ZBAND:	LDA	ARG1+LO	
	AND	ARG2+LO	
	TAX		
	LDA	ARG1+HI	
	AND	ARG2+HI	
	JMP	VEXIT	


; -----
; FSET?
; -----
; IS FLAG [ARG2] SET IN OBJECT [ARG1]?

ZFSETP:	JSR	FLAGSU	; GET BITS INTO [K] AND [J]
	LDA	K+HI	; DO MSBS
	AND	J+HI	
	STA	K+HI	
	LDA	K+LO	; DO LSBS
	AND	J+LO	
	ORA	K+HI	; ANY BITS ON?
	BNE	PGOOD	; TARGET BIT MUST BE ON
	JMP	PREDF	


; ----
; FSET
; ----
; SET FLAG [ARG2] IN OBJECT [ARG1]

ZFSET:	JSR	FLAGSU	; GET BITS INTO [K] & [J], ADDR IN [I]
	LDY	#0	
	LDA	K+HI	; FIRST DO MSBS
	ORA	J+HI	
	STA	(I),Y	
	INY		
	LDA	K+LO	; THEN LSBS
	ORA	J+LO	
	STA	(I),Y	
	RTS		


; ------
; FCLEAR
; ------
; CLEAR FLAG [ARG2] IN OBJECT [ARG1]

ZFCLR:	JSR	FLAGSU	; GETS BITS INTO [J] & [K], ADDR IN [I]
	LDY	#0	
	LDA	J+HI	; FETCH MSB
	EOR	#$FF	; COMPLEMENT IT
	AND	K+HI	; RUB OUT FLAG
	STA	(I),Y	
	INY		
	LDA	J+LO	; SAME FOR LSB
	EOR	#$FF	
	AND	K+LO	
	STA	(I),Y	
	RTS		


; ---
; SET
; ---
; SET VARIABLE [ARG1] EQUAL TO [ARG2]

ZSET:	LDA	ARG2+LO	; MOVE THE VALUE
	STA	VALUE+LO	; INTO [VALUE]
	LDA	ARG2+HI	
	STA	VALUE+HI	
	LDA	ARG1+LO	; GET VARIABLE ID
	JMP	VARPUT	; AND CHANGE THE VARIABLE


; ----
; MOVE
; ----
; MOVE OBJECT [ARG1] INTO OBJECT [ARG2]
; (EZIP - EXPANDED FROM BYTE OBJECTS TO WORD OBJECTS)

ZMOVE:	JSR	ZREMOV	; REMOVE FIRST - CUT ARG1 OUT OF WHERE IT IS

	; NOW, IF IT IS ANYWHERE

	LDA	ARG1+LO	
	LDX	ARG1+HI	
	JSR	OBJLOC	; GET SOURCE OBJECT ADDR INTO [I]
	LDA	I+LO	; COPY SOURCE (ARG1) ADDRESS
	STA	J+LO	; INTO [J]
	LDA	I+HI	
	STA	J+HI	
	LDA	ARG2+HI	; GET DEST OBJECT ID
	LDY	#6	; POINT TO "LOC" SLOT OF SOURCE
	STA	(I),Y	; AND MOVE IT IN
	TAX		; (MOVE ARG2 INTO PARENT SLOT OF ARG1)
	LDA	ARG2+LO	
	INY		
	STA	(I),Y	; X/A (HI/LO) SET FOR OBJLOC
	JSR	OBJLOC	; GET ADDR OF DEST OBJECT INTO [I] (GET PARENT)

	; NOW SWAP IN NEW VALUE

	LDY	#10	; POINT TO "FIRST" SLOT
	LDA	(I),Y	; OF PARENT (ARG2)
	STA	K+HI	; SAVE HERE FOR A MOMENT
	LDA	ARG1+HI	; GET SOURCE OBJECT ID
	STA	(I),Y	; MAKE IT "FIRST" OF PARENT
	INY		
	LDA	(I),Y	
	TAX		
	LDA	ARG1+LO	
	STA	(I),Y	
	TXA		
	ORA	K+HI	; CHECK OLD "FIRST" OF DEST/PARENT
	BEQ	ZMVEX	; SCRAM IF ZERO
	TXA		; GET LO BYTE AGAIN
	LDY	#9	; MAKE OLD "FIRST" OF PARENT
	STA	(J),Y	; THE "NEXT" (SIBLING) OF THIS OBJECT (ARG1)
	DEY		; I.E. ADD THIS ONE AT THE TOP OF LIST
	LDA	K+HI	; & GET HIGH BYTE
	STA	(J),Y	
ZMVEX:	RTS		


; ---
; GET
; ---
; RETURN ITEM [ARG2] IN WORD-TABLE [ARG1]

ZGET:	JSR	WCALC	; CALC ADDRESS
	JSR	GETBYT	; GET 1ST BYTE (MSB)
DOGET:	STA	VALUE+HI	; SAVE MSB
	JSR	GETBYT	; GET LSB
	STA	VALUE+LO	; SAVE AND

	JMP	PUTVAL	; HAND IT OVER


; ----
; GETB
; ----
; RETURN ITEM [ARG2] IN BYTE-TABLE AT [ARG1]

ZGETB:	JSR	BCALC	
	LDA	#0	
	BEQ	DOGET	; [A] = 0, SO CLEAR MSB OF [VALUE]


; --------------------
; CALC TABLE ADDRESSES
; --------------------
; WORD-ALIGNED ENTRY

WCALC:	ASL	ARG2+LO	; WORD-ALIGN FOR
	ROL	ARG2+HI	; WORD ACCESS

	; BYTE-ALIGNED ENTRY

BCALC:	LDA	ARG2+LO	; ADD BASE ADDR OF TABLE
	CLC		; TO ITEM
	ADC	ARG1+LO	; INDEX
	STA	MPCL	
	LDA	ARG2+HI	; SAME FOR MSBS
	ADC	ARG1+HI	
	STA	MPCM	
	LDA	#0	
	ADC	#0	; PICK UP CARRY FROM MPCM
	STA	MPCH	; TO GET TOP BIT
	JMP	VLDMPC	


; ----
; GETP
; ----
; RETURN PROPERTY [ARG2] OF OBJECT [ARG1] ;
; IF NO PROP [ARG2], RETURN [ARG2]'TH ELEMENT OF OBJECT #0

ZGETP:	JSR	PROPB	
GETP1:	JSR	PROPN	; GET ADDR OF PROP TBL
	CMP	ARG2+LO	; GET PROP ID
	BEQ	GETP3	; FOUND IT
	BCC	GETP2	; NOT THERE
	JSR	NEXTPI	; GET NEXT PROP, ALIGN [I] TO IT (EZIP)
	JMP	GETP1	; TRY AGAIN WITH NEXT PROP

	; PROPERTY NOT THERE, GET DEFAULT

GETP2:	LDA	ARG2+LO	; GET PROPERTY #
	SEC		; ZERO-ALIGN IT
	SBC	#1	
	ASL	A	; WORD-ALIGN IT
	TAY		; USE AS AN INDEX
	LDA	(OBJTAB),Y	; GET MSB OF PROPERTY
	STA	VALUE+HI	
	INY		
	LDA	(OBJTAB),Y	; DO SAME WITH LSB
	STA	VALUE+LO	
	JMP	PUTVAL	; RETURN DEFAULT IN [VALUE]
GETP3:	JSR	PROPL	; GET LENGTH OF PROP INTO [A]
	INY		; MAKE [Y] POINT TO 1ST BYTE OF PROP
	CMP	#1	; IF LENGTH =1
	BEQ	GETPB	; GET A BYTE PROPERTY
	CMP	#2	; IF LENGTH = 2
	BEQ	GETPW	; GET A WORD PROPERTY

	; *** ERROR #7: PROPERTY LENGTH ***

	LDA	#7	
	JMP	ZERROR	

	; GET A 1-BYTE PROPERTY

GETPB:	LDA	(I),Y	; GET LSB INTO [A]
	LDX	#0	; CLEAR MSB IN [X]
	BEQ	ETPEX	

	; GET A 2-BYTE PROPERTY

GETPW:	LDA	(I),Y	; GET MSB
	TAX		; INTO [X]
	INY		; POINT TO LSB
	LDA	(I),Y	; GET IT INTO [A]
ETPEX:	STA	VALUE+LO	; STORE LSB
	STX	VALUE+HI	; AND MSB
	JMP	PUTVAL	

	IF	0

; -----
; GETPT
; -----
; RETURN POINTER TO PROP TABLE [ARG2]
; IN OBJECT [ARG1]

ZGETPT:	JSR	PROPB	; GET ADDR OF PROP TBL
GETPT1:	JSR	PROPN	; RETURNS OFFSET IN [Y]
	CMP	ARG2+LO	; CHECK ID
	BEQ	GETPT2	
	BCC	DORET	; BEYOND IT, SO NOT THERE
	JSR	NEXTPI	; GET NEXT PROPERTY, ALIGN [I] TO IT (EZIP)
	JMP	GETPT1	
GETPT2:	JSR	PROPL	; ALIGN Y @ LAST SIZE BYTE (EZIP)
	INY		; INC TO POINT AT PROPERTY VALUE (EZIP)

GETPT3:	TYA		; FETCH OFFSET
	CLC		
	ADC	I+LO	; ADD LSB OF TABLE ADDRESS
	STA	VALUE+LO	
	LDA	I+HI	; AND MSB
	ADC	#0	
	SEC		; STRIP OFF
	SBC	ZCODE	; RELATIVE POINTER
	STA	VALUE+HI	
	JMP	PUTVAL	; AND RETURN
DORET:	JMP	RET0	; ELSE RETURN A ZERO

	ENDIF

; -----
; GETPT
; -----
; RETURN POINTER TO PROP TABLE [ARG2]
; IN OBJECT [ARG1]

ZGETPT:	LDA	ARG1+LO
	LDX	ARG1+HI		; (EZIP)
	JSR	OBJLOC
	LDY	#12		; (EZIP)
	LDA	(I),Y		; GET MSB OF P-TABLE ADDRESS
	CLC
	ADC	ZCODE		; MAKE IT ABSOLUTE
	TAX			; AND SAVE HERE
	INY
	LDA	(I),Y		; NOW GET LSB
	STA	I+LO
	STX	I+HI		; [I] NOW POINTS TO PROP TABLE
	LDY	#0
	LDA	(I),Y		; GET LENGTH OF SHORT DESC
	ASL	A		; WORD-ALIGN IT
	TAY			; EXPECTED HERE
	INY			; POINT JUST PAST THE DESCRIPTION
	
GETPT1:	LDA	(I),Y
	AND	#%00111111	; MASK OUT LENGTH BITS (EZIP)

	CMP	ARG2+LO		; CHECK ID
	BEQ	GETPT2
	BCS	DDD
	JMP	DORET		; BEYOND IT, SO NOT THERE

DDD:	LDA	(I),Y		; CHECK LENGTH FLAGS
	AND	#%10000000	; TEST BIT 7
	BEQ	SHORT0		; OFF, SO 1 OR 2 BYTES
	INY
	LDA	(I),Y		; NEXT BYTE HAS LENGTH
	AND	#%00111111	; MASK OFF EXTRA BITS
	JMP	AAA

SHORT0:	LDA	(I),Y		; PICK UP BYTE AGAIN
	AND	#%01000000	; BIT 6
	BEQ	ONE0
	LDA	#2		; BIT 6 = 1, LENGTH =2
	JMP	AAA
ONE0:	LDA	#1		; BIT 6 = 0, LENGTH =1

AAA:	TAX			; SAVE HERE
PPPX:	INY			; LOOP UNTIL
	BNE	PPPY
	INC	I+HI
PPPY:	DEX			; [Y] POINTS TO
	BNE	PPPX		; START OF NEXT PROP
	INY			; CORRECT ALIGNMENT
	TYA			; ADD OFFSET TO NEXT PROP
	CLC			; TO [I] SO I POINTS DIRECTLY
	ADC	I+LO		; AT IT
	STA	I+LO
	BCC	CCCC1
	INC	I+HI		; ADD IN CARRY
CCCC1:	LDY	#0		; CLEAR [Y] AS IT IS USED AS AN INDEX

	JMP	GETPT1

GETPT2:	LDA	(I),Y		; CHECK LENGTH FLAGS
	AND	#%10000000	; TEST BIT 7
	BEQ	SHORT1		; OFF, SO 1 OR 2 BYTES
	INY
	LDA	(I),Y		; NEXT BYTE HAS LENGTH
	AND	#%00111111	; MASK OFF EXTRA BITS
	JMP	BBB

SHORT1:	LDA	(I),Y		; PICK UP BYTE AGAIN
	AND	#%01000000	; BIT 6
	BEQ	ONE1
	LDA	#2		; BIT 6 = 1, LENGTH =2
	JMP	BBB
ONE1:	LDA	#1		; BIT 6 = 0, LENGTH =1

BBB:	INY			; INC TO POINT AT PROPERTY VALUE (EZIP)
GETPT3:	TYA			; FETCH OFFSET
	CLC
	ADC	I+LO		; ADD LSB OF TABLE ADDRESS
	STA	VALUE+LO
	LDA	I+HI		; AND MSB
	ADC	#0
	SEC			; STRIP OFF
	SBC	ZCODE		; RELATIVE POINTER
	STA	VALUE+HI
	JMP	PUTVAL		; AND RETURN
DORET:	JMP	RET0		; ELSE RETURN A ZERO


; -----
; NEXTP
; -----
; RETURN INDEX # OF PROP FOLLOWING PROP [ARG2] IN OBJECT [AR
; RETURN ZERO IF LAST ; RETURN FIRST IF [ARG2]=0; ERROR IF NO

ZNEXTP:	JSR	PROPB	; ALIGN [I] AT PROPERTY TBL'S 1ST ENTRY
	LDA	ARG2+LO	; IF [ARG2]=0
	BEQ	NXTP3	; RETURN "FIRST" SLOT
NXTP1:	JSR	PROPN	; FETCH PROPERTY #
	CMP	ARG2+LO	; COMPARE TO TARGET #
	BEQ	NXTP2	; FOUND IT!
	BCC	DORET	; LAST PROP, SO RETURN ZERO
	JSR	NEXTPI	; ELSE TRY NEXT PROPERTY (EZIP)
	JMP	NXTP1	
NXTP2:	JSR	PROPNX	; POINT TO FOLLOWING PROPERTY
NXTP3:	JSR	PROPN	; GET THE PROPERTY #
	LDX	#0	; FOR PUTBYT (EZIP)
	JMP	PUTBYT	; AND RETURN IT


; ---
; ADD
; ---
; RETURN [ARG1] + [ARG2]

ZADD:	LDA	ARG1+LO	; ADD LSBS
	CLC		
	ADC	ARG2+LO	
	TAX		; SAVE LSB HERE
	LDA	ARG1+HI	; ADD MSBS
	ADC	ARG2+HI	
	JMP	VEXIT	


; ---
; SUB
; ---
; RETURN [ARG1] - [ARG2]

ZSUB:	LDA	ARG1+LO	; SUBTRACT LSBS
	SEC		
	SBC	ARG2+LO	
	TAX		; SAVE LSB HERE
	LDA	ARG1+HI	; SUBTRACT MSBS
	SBC	ARG2+HI	
	JMP	VEXIT	; EXIT WITH [X]=LSB, [A]=MSB


; ---
; MUL
; ---
; RETURN [ARG1] * [ARG2]

ZMUL:	JSR	MINIT	; INIT THINGS
ZMLOOP:	ROR	MTEMP+HI	
	ROR	MTEMP+LO	
	ROR	ARG2+HI	
	ROR	ARG2+LO	
	BCC	ZMNEXT	
	LDA	ARG1+LO	
	CLC		
	ADC	MTEMP+LO	
	STA	MTEMP+LO	
	LDA	ARG1+HI	
	ADC	MTEMP+HI	
	STA	MTEMP+HI	
ZMNEXT:	DEX		
	BPL	ZMLOOP	
	LDX	ARG2+LO	; PUT LSB OF PRODUCT
	LDA	ARG2+HI	; AND MSB
	JMP	VEXIT	; WHERE "VEXIT" EXPECTS THEM


; ---
; DIV
; ---
; RETURN QUOTIENT OF [ARG1] / [ARG2]

ZDIV:	JSR	DIVIDE	
	LDX	QUOT+LO	
	LDA	QUOT+HI	
	JMP	VEXIT	


; ---
; MOD
; ---
; RETURN REMAINDER OF [ARG1] / [ARG2]

ZMOD:	JSR	DIVIDE	
	LDX	REMAIN+LO	; FETCH THE REMAINDER
	LDA	REMAIN+HI	; IN [REMAIN]
	JMP	VEXIT	; AND RETURN IT


; ---------------
; SIGNED DIVISION
; ---------------
; ENTRY: DIVIDEND IN [ARG1], DIVISOR IN [ARG2]
; EXIT: QUOTIENT IN [QUOT], REMAINDER IN [REMAIN]

DIVIDE:	LDA	ARG1+HI	; SIGN OF REMAINDER
	STA	RSIGN	; IS THE SIGN OF THE DIVIDEND
	EOR	ARG2+HI	; SIGN OF QUOTIENT IS POSITIVE
	STA	QSIGN	; IF SIGNS OF TERMS ARE THE SAME
	LDA	ARG1+LO	; MOVE [ARG1] TO [QUOT]
	STA	QUOT+LO	
	LDA	ARG1+HI	
	STA	QUOT+HI	; IF DIVIDEND IS POSITIVE
	BPL	ABSDIV	; MOVE DIVISOR
	JSR	ABQUOT	; ELSE CALC ABS(DIVIDEND) FIRST
ABSDIV:	LDA	ARG2+LO	
	STA	REMAIN+LO	
	LDA	ARG2+HI	
	STA	REMAIN+HI	; IF REMAINDER IS POSITIVE
	BPL	GODIV	; WE'RE READY TO DIVIDE
	JSR	ABREM	; ELSE CALC ABS(DIVISOR)
GODIV:	JSR	UDIV	; DO UNSIGNED DIVIDE
	LDA	QSIGN	; SHOULD QUOTIENT BE FLIPPED?
	BPL	RFLIP	; NO, TEST REMAINDER
	JSR	ABQUOT	; ELSE GET ABSOLUTE VALUE
RFLIP:	LDA	RSIGN	; SHOULD EMAINDER BE FLIPPED?
	BPL	DIVEX	; NO, WE'RE DONE

	; ELSE FALL THROUGH ...


; ----------------
; CALC ABS(REMAIN)
; ----------------

ABREM:	LDA	#0	
	SEC		
	SBC	REMAIN+LO	
	STA	REMAIN+LO	
	LDA	#0	
	SBC	REMAIN+HI	
	STA	REMAIN+HI	
DIVEX:	RTS		


; --------------
; CALC ABS(QUOT)
; --------------

ABQUOT:	LDA	#0	
	SEC		
	SBC	QUOT+LO	
	STA	QUOT+LO	
	LDA	#0	
	SBC	QUOT+HI	
	STA	QUOT+HI	
	RTS		


; -----------------
; UNSIGNED DIVISION
; -----------------
; ENTRY: DIVIDEND IN [QUOT], DIVISOR IN [REMAIN]
; EXIT: QUOTIENT IN [QUOT], REMAINDER IN [REMAIN]

UDIV:	LDA	REMAIN+LO	; CHECK [REMAIN]
	ORA	REMAIN+HI	; BEFORE PROCEEDING
	BEQ	DIVERR	; CAN'T DIVIDE BY ZERO!
	JSR	MINIT	; SET IT ALL UP
UDLOOP:	ROL	QUOT+LO	
	ROL	QUOT+HI	
	ROL	MTEMP+LO	
	ROL	MTEMP+HI	
	LDA	MTEMP+LO	
	SEC		
	SBC	REMAIN+LO	
	TAY		; SAVE HERE
	LDA	MTEMP+HI	
	SBC	REMAIN+HI	
	BCC	UDNEXT	
	STY	MTEMP+LO	
	STA	MTEMP+HI	
UDNEXT:	DEX		
	BNE	UDLOOP	
	ROL	QUOT+LO	; SHIFT LAST CARRY FOR QUOTIENT
	ROL	QUOT+HI	
	LDA	MTEMP+LO	; MOVE REMAINDER
	STA	REMAIN+LO	; INTO [REMAIN]
	LDA	MTEMP+HI	
	STA	REMAIN+HI	
	RTS		

	; *** ERROR #8: DIVISION BY ZERO ***

DIVERR:	LDA	#8	
	JMP	ZERROR	


; ---------
; MATH INIT
; ---------

MINIT:	LDX	#16		; INIT LOOPING INDEX
	LDA	#0
	STA	MTEMP+LO	; CLEAR TEMP
	STA	MTEMP+HI	; REGISTER
	CLC			; AND CARRY
	RTS

	END