erkyrath.infocom-zcode-terps/apple/xzip/opsx.asm

	PAGE			
	STTL "--- X-OPS ---"


	; ------
	; EQUAL?
	; ------
	; IS [ARG1] = [ARG2] (OR [ARG3] OR [ARG4])?

ZEQUAL:	DEC	NARGS	; DOUBLE-CHECK # ARGS
	BNE	DOEQ	; MUST BE AT LEAST TWO, OR ...

	; *** ERROR #9: NOT ENOUGH "EQUAL?" ARGS ***

	LDA	#9	
	JMP	ZERROR	
DOEQ:	LDA	ARG1+LO	; FETCH LSB
	LDX	ARG1+HI	; AND MSB OF [ARG1]
	CMP	ARG2+LO	; TEST LSB OF [ARG2]
	BNE	TRY2	; NO GOOD, LOOK FOR ANOTHER ARG
	CPX	ARG2+HI	; ELSE TRY MSB OF [ARG2]
	BEQ	EQOK	; MATCHED!
TRY2:	DEC	NARGS	; OUT OF ARGS YET?
	BEQ	EQBAD	; YES, WE FAILED
	CMP	ARG3+LO	; TRY LSB OF [ARG3]
	BNE	TRY3	; NO GOOD, LOOK FOR ANOTHER ARG
	CPX	ARG3+HI	; HOW ABOUT MSB OF [ARG3]?
	BEQ	EQOK	; YAY!
TRY3:	DEC	NARGS	; OUT OF ARGS YET?
	BEQ	EQBAD	; IF NOT ...
	CMP	ARG4+LO	; TRY [ARG4]
	BNE	EQBAD	; SORRY, CHUM
	CPX	ARG4+HI	; MSB MATCHED?
	BNE	EQBAD	; TOO BAD

EQOK:	JMP	PREDS	; FINALLY MATCHED!

EQBAD:	JMP	PREDF	; FAILURE (SNIFF!)


; ----------------------------
; ICALL,ICALL1, ICALL2, IXCALL
; ----------------------------

ZICALL:
ZICLL1:
ZICLL2:
ZIXCLL:	LDA	#1	; SET FLAG FOR RETURNLESS CALL
	STA	IRET
	BNE	IENTR	; JMP OVER NORMAL SETTING


; -------------------
; XCALL, CALL1, CALL2
; -------------------

ZXCALL:			; DROP	THROUGH
ZCALL1:			; CALL	RTN HANDLES ALL 4 KINDS
ZCALL2:


; ----
; CALL
; ----
; BRANCH TO FUNCTION AT ([ARG1]*4), PASSING
; OPTIONAL PARAMETERS IN [ARG2]-[ARG4]
; ([ARG5]-[ARG8] FOR XCALL (EZIP))

ZCALL:	LDA	#0
	STA	IRET		; SET FLAG TO RETURN SOMETHING
IENTR:	LDA	ARG1+LO
	ORA	ARG1+HI		; IS CALL ADDRESS ZERO?
	BNE	DOCALL		; NO, CONTINUE
	LDA	IRET		; any ret value?
	BEQ	Ij		; yes, so return a zero

	RTS			; otherwise, just end
Ij:
	LDX	#0
	JMP	PUTBYT		; ELSE RETURN THE ZERO IN [A]
DOCALL:	LDX	OLDZSP+LO	; SAVE OLD STACK POINTER
	LDA	OLDZSP+HI
	JSR	PUSHXA
	LDA	ZPCL		; AND LSB OF [ZPC]
	LDX	IRET		; AND RETURN FLAG
	JSR	PUSHXA		; ON THE Z-STACK
	LDX	ZPCM		; SAVE MIDDLE 8 BITS
	LDA	ZPCH		; AND TOP BIT OF [ZPC]
	JSR	PUSHXA		; AS WELL

	; FORM 16-BIT ADDRESS FROM [ARG1]

	LDA	#0	
	ASL	ARG1+LO		; MULTIPLY [ARG1]
	ROL	ARG1+HI		; (BY 2)
	ROL	A		;	>BIT INTO [A]
	STA	ZPCH		; NEW >BIT OF [ZPC]
	ASL	ARG1+LO		; BY 4 (EZIP)
	ROL	ARG1+HI	
	ROL	ZPCH	
	LDA	ARG1+HI		; GET NEW <BYTES
	STA	ZPCM	
	LDA	ARG1+LO	
	STA	ZPCL	
	JSR	VLDZPC	
	JSR	NEXTPC		; FETCH # LOCALS TO PASS
	STA	J+LO		; SAVE HERE FOR COUNTING
	STA	J+HI		; AND HERE FOR LATER REFERENCE
	BEQ	ZCLL2		; SKIP IF NO LOCALS
	LDA	#0	
	STA	I+LO		; ELSE INIT STORAGE INDEX
ZCLL1:
	LDY	I+LO	
	LDX	LOCALS+LO,Y	; GET LSB OF LOCAL INTO [X]
	LDA	LOCALS+HI,Y	; AND MSB INTO [A]
	JSR	PUSHXA		; PUSH LOCAL IN [X/A] ONTO Z-STACK
	LDY	I+LO		; RESTORE INDEX
	LDA	#0		; ZERO ALL LOCALS (X)
	STA	LOCALS+LO,Y
	STA	LOCALS+HI,Y
	INY		
	INY			; UPDATE
	STY	I+LO		; THE STORAGE INDEX
	DEC	J+LO		; ANY MORE LOCALS?
	BNE	ZCLL1		; YES, KEEP LOOPING

	; MOVE UP TO 3 ARGUMENTS TO [LOCALS] ( 7 FOR XCALL (EZIP))

ZCLL2:
	LDA	ASSVLU		; get how many here
	JSR	PUSHXA		; save how many args for ASSIGNED?
	DEC	NARGS		; EXTRA ARGS IN THIS CALL?
	LDA	NARGS		; SAVE FOR ASSIGNED? OP
	STA	ASSVLU		; and save away
	BEQ	ZCALL3		; NO, CONTINUE
	LDA	ARG2+LO		; MOVE [ARG2] TO LOCAL #1
	STA	LOCALS+LO	
	LDA	ARG2+HI	
	STA	LOCALS+HI	
	DEC	NARGS		; ANY LEFT?
	BEQ	ZCALL3		; NO, SCRAM
	LDA	ARG3+LO		; MOVE [ARG3] TO LOCAL #2
	STA	LOCALS+LO+2	
	LDA	ARG3+HI	
	STA	LOCALS+HI+2	
	DEC	NARGS		; ANY LEFT?
	BEQ	ZCALL3		; NO, EXUENT
	LDA	ARG4+LO		; MOVE [ARG4] TO LOCAL #3
	STA	LOCALS+LO+4	
	LDA	ARG4+HI	
	STA	LOCALS+HI+4	
	DEC	NARGS		; MORE (THAT MEANS IT'S AN XCALL)
	BEQ	ZCALL3		; NO, JUST A CALL
	LDA	ARG5+LO		; MOVE [ARG5] TO LOCAL #4
	STA	LOCALS+LO+6	
	LDA	ARG5+HI	
	STA	LOCALS+HI+6	
	DEC	NARGS		; MORE?
	BEQ	ZCALL3		; NO
	LDA	ARG6+LO		; MOVE [ARG6] TO LOCAL #5
	STA	LOCALS+LO+8	
	LDA	ARG6+HI	
	STA	LOCALS+HI+8	
	DEC	NARGS		; MORE?
	BEQ	ZCALL3		; NO
	LDA	ARG7+LO		; MOVE [ARG7] TO LOCAL #6
	STA	LOCALS+LO+10	
	LDA	ARG7+HI	
	STA	LOCALS+HI+10	
	DEC	NARGS		; MORE?
	BEQ	ZCALL3		; NO
	LDA	ARG8+LO		; MOVE [ARG8] TO LOCAL #7
	STA	LOCALS+LO+12	
	LDA	ARG8+HI	
	STA	LOCALS+HI+12	
ZCALL3:	LDX	J+HI		; RETRIEVE # LOCALS
	TXA			; DUPE FOR NO GOOD REASON
	JSR	PUSHXA		; PUSH # LOCALS ONTO Z-STACK
	LDA	ZSP+HI		; REMEMBER WHERE
	STA	OLDZSP+HI	; WE CAME FROM
	LDA	ZSP+LO	
	STA	OLDZSP+LO	
	RTS			; WHEW!


; ---
; PUT
; ---
; SET ITEM [ARG2] IN WORD-TABLE [ARG1] EQUAL TO [ARG3]

ZPUT:	ASL	ARG2+LO	; WORD-ALIGN [ARG2]
	ROL	ARG2+HI	
	JSR	PCALC	; GET ITEM ADDR INTO [I]
	LDA	ARG3+HI	; STORE MSB OF [ARG3]
	STA	(I),Y	; INTO MSB OF TABLE POSITION
	INY		; POINT TO LSB
	BNE	PUTLSB	; BRANCH ALWAYS


; ----
; PUTB
; ----
; SET ITEM [ARG2] IN BYTE-TABLE [ARG1] EQUAL TO [ARG3]

ZPUTB:	JSR	PCALC	

	; ENTRY FOR "PUT"

PUTLSB:	LDA	ARG3+LO	; GET LSB OF [ARG3]
	STA	(I),Y	; STORE IN TABLE AT [Y]
	RTS		


; ---------------------------
; CALC ITEM ADDRESS FOR "PUT"
; ---------------------------

PCALC:	LDA	ARG2+LO	; ADD ITEM OFFSET IN [ARG2]
	CLC		; TO TABLE ADDR IN [ARG1]
	ADC	ARG1+LO	; TO FORM A POINTER
	STA	I+LO	; IN [I]
	LDA	ARG2+HI	; SAME FOR MSB
	ADC	ARG1+HI	
	CLC		
	ADC	ZCODE	; MAKE IT ABSOLUTE
	STA	I+HI	
	LDY	#0	; ZERO FOR INDEXING
	RTS		


; ----
; PUTP
; ----
; SET PROPERTY [ARG2] IN OBJECT [ARG1] EQUAL TO [ARG3]

ZPUTP:	JSR	PROPB	; GET PROP TBL ADDR

PUTP1:	JSR	PROPN	; GET ID
	CMP	ARG2+LO	
	BEQ	PUTP2	
	BCC	PNERR	; ERROR IF LOWER
	JSR	NEXTPI	; TRY NEXT PROPERTY, ALIGN [I] AT IT (EZIP)
	JMP	PUTP1	
PUTP2:	JSR	PROPL	; GET PROPERTY LENGTH INTO [A]
	INY		; MAKE [Y] POINT TO 1ST PROPERTY BYTE
	CMP	#1	; IF LENGTH = 1
	BEQ	PUTP3	; PUT A BYTE
	CMP	#2	; PUT A WORD IF [A] = 2
	BNE	PLERR	; ELSE LENGTH IS BAD
	LDA	ARG3+HI	; GET MSB OF PROPERTY
	STA	(I),Y	; AND STORE IN OBJECT
	INY		; POINT TO LSB SLOT
PUTP3:	LDA	ARG3+LO	; FETCH LSB
	STA	(I),Y	; AND STORE IN OBJECT
	RTS		

	; *** ERROR #10: BAD PROPERTY NUMBER ***

PNERR:	LDA	#10	
	JMP	ZERROR	

	; *** ERROR #11: PUTP PROPERTY LENGTH ***

PLERR:	LDA	#11	
	JMP	ZERROR	


; ------
; PRINTC
; ------
; PRINT CHAR WITH ASCII VALUE IN [ARG1]

ZPRC:	LDA	ARG1+LO	; GRAB THE CHAR
	JMP	COUT	; AND SHIP IT OUT


; ------
; PRINTN
; ------
; PRINT VALUE OF [ARG1] AS A SIGNED INTEGER

ZPRN:	LDA	ARG1+LO	; MOVE [ARG1] TO [QUOT]
	STA	QUOT+LO	
	LDA	ARG1+HI	
	STA	QUOT+HI	

	; PRINT [QUOT]

NUMBER:	LDA	QUOT+HI	; IF VALUE IS POSITIVE
	BPL	DIGCNT	; CONTINUE
	LDA	#$2D	; ELSE START WITH A MINUS SIGN
	JSR	COUT	
	JSR	ABQUOT	; AND CALC ABS([QUOT])

	; COUNT # OF DECIMAL DIGITS

DIGCNT:	LDA	#0	; RESET
	STA	DIGITS	; DIGIT INDEX
DGC:	LDA	QUOT+LO	; IS QUOTIENT
	ORA	QUOT+HI	; ZERO YET?
	BEQ	PRNTN3	; YES, READY TO PRINT
	LDA	#10	; ELSE DIVIDE [QUOT]
	STA	REMAIN+LO	; BY 10 (LSB)
	LDA	#0	
	STA	REMAIN+HI	; 10 (MSB)
	JSR	UDIV	; UNSIGNED DIVIDE
	LDA	REMAIN+LO	; FETCH LSB OF REMAINDER (THE DIGIT)
	PHA		; SAVE IT ON STACK
	INC	DIGITS	; UPDATE DIGIT COUNT
	BNE	DGC	; LOOP TILL QUOTIENT=0
PRNTN3:	LDA	DIGITS	; IF DIGIT COUNT IS NZ
	BNE	PRNTN4	; CONTINUE
	LDA	#'0'	; ELSE PRINT "0"
	JMP	COUT	; AND RETURN
PRNTN4:	PLA		; PULL A DIGIT OFF THE STACK
	CLC		
	ADC	#'0'	; CONVERT TO DB	II
	JSR	COUT	; AND PRINT IT
	DEC	DIGITS	; OUT OF DIGITS YET?
	BNE	PRNTN4	; NO, KEEP LOOPING
	RTS		


; ------
; RANDOM
; ------
; RETURN A RANDOM VALUE BETWEEN 0 AND [ARG1]

ZRAND:	LDA	ARG1+LO		; IF VALUE IS ZERO
	ORA	ARG1+HI
	BNE	ZRAND1
	STA	SRHOLD+LO	; RETURN TO RANDOM RANDOM
	STA	SRHOLD+HI	; CLEAR INDICATOR
	JMP	RET0		; AND RETURN THRU HERE SO ALIGNED
ZRAND1:	LDA	SRHOLD+LO	; ARE WE NONRAMDOM INCREMENTING? (EZIP)
	ORA	SRHOLD+HI
	BNE	ZRAND3		; YUP
	LDA	ARG1+HI
	BPL	ZRAND2		; GENERATE A RANDOM #
	EOR	#$FF		; SET UP TO INCREMENT FROM 1 THRU INT
	STA	SRHOLD+HI	; GET ABSOLUTE
	LDA	ARG1+LO
	EOR	#$FF
	STA	SRHOLD+LO
	INC	SRHOLD+LO
	LDA	#0		; W/ NO RAMDOMNESS
	STA	RAND1+LO
	STA	RAND1+HI
	BEQ	ZRAND3		; JMP  (END EZIP)
ZRAND2:	LDA	ARG1+LO		; MAKE [ARG1] THE DIVISOR
	STA	ARG2+LO
	LDA	ARG1+HI
	STA	ARG2+HI
	JSR	RANDOM		; GET RANDOM BYTES INTO [A] AND [X]
	STX	ARG1+LO		; MAKE THEM THE DIVIDEND
	AND	#$7F		; MAKE SURE MSB IS POSITIVE
	STA	ARG1+HI
	JSR	DIVIDE		; SIGNED DIVIDE, [ARG1] / [ARG2]
	LDA	REMAIN+LO	; MOVE REMAINDER
	CLC
	ADC	#1		; ADD 1
	STA	VALUE+LO	; INTO [VALUE]
	LDA	REMAIN+HI
	ADC	#0
	STA	VALUE+HI
	JMP	PUTVAL		; AND RETURN RESULT

	; NON RANDOM INCREMENTING

ZRAND3:	;LDA	ARG1+LO		; RESET TOP OF COUNT W/ EACH ENTRY
;	STA	SRHOLD+LO	; SO ALWAYS W/IN RANGE OF CALL
;	LDA	ARG1+HI
;	STA	SRHOLD+HI

	LDA	RAND1+HI	; (EZIP)
	CMP	SRHOLD+HI
	BCC	ZRAND4
	LDA	RAND1+LO
	CMP	SRHOLD+LO
	BCC	ZRAND4
	BEQ	ZRAND4
	LDA	#1		; WENT THRU ALL
	STA	RAND1+LO	; START AGAIN
	LDA	#0
	STA	RAND1+HI
ZRAND4:	LDA	RAND1+LO
	STA	VALUE+LO
	LDA	RAND1+HI
	STA	VALUE+HI
	INC	RAND1+LO	; FOR NEXT TIME
	BNE	ZRAND5
	INC	RAND1+HI
ZRAND5:	JMP	PUTVAL		; (END EZIP)


; ----
; PUSH
; ----
; PUSH [ARG1] ONTO THE Z-STACK

ZPUSH:	LDX	ARG1+LO	
	LDA	ARG1+HI	
	JMP	PUSHXA	


; ---
; POP
; ---
; POP WORD OFF Z-STACK, STORE IN VARIABLE [ARG1]

ZPOP:	JSR	POPVAL	; VALUE INTO [VALUE]
	LDA	ARG1+LO	; GET VARIABLE ID
	JMP	VARPUT	; AND CHANGE THE VARIABLE


; ------
; INTBL?
; ------

ZINTBL:
	LDA	ARG3+HI		; JIC COUNT IS 0,
	BMI	INTNF		; >0, just ignore!
	ORA	ARG3+LO
	BEQ	INTNF		; SAY NOT FOUND

	LDA	NARGS		; IS THERE A RECORD SPEC?
	CMP	#4
	BEQ	SET4
SETDEF:	LDA	#130		; NO, SET DEFAULT
	STA	ARG4+LO

SET4:	LDA	ARG4+LO
	BEQ	SETDEF		; GO BACK AND GET VALUE
	LDA	#0		; COMPARE BYTE OR WORD?
	ASL	ARG4+LO
	ROL	A		; PICK UP INDICATOR
	LSR	ARG4+LO		; CLEAR FROM RECORD LENGTH
	STA	TYPE 		; BYTE (0) OR WORD (1)
	LDA	TYPE		; SET FLAG
	BNE	SETTBL
	LDA	ARG1+LO		; IF ONLY BYTE, MOVE IT
	STA	ARG1+HI		; TO FIRST BYTE CHECKED

SETTBL:	LDA	ARG2+LO		; PICK UP TBL ADDR
	STA	MPCL
	LDA	ARG2+HI
	STA	MPCM
	LDA	#0
	STA	MPCH		; ONLY A WORD ADDR, SO IN 1ST 64K
	JSR	VLDMPC

INTLP:	LDA	MPCL		; HOLD START ADDR, MPC WILL BE A MESS
	STA	VWCUR+0
	LDA	MPCM
	STA	VWCUR+1
	LDA	MPCH
	STA	VWCUR+2
	JSR	GETBYT		; GET 1ST BYTE
	CMP	ARG1+HI		; DOES IT = THE VALUE LOOKING FOR?
	BNE	INTNXT		; NO
	LDA	TYPE
	BEQ	INTFND		; ONLY COMPARING A BYTE SO FOUND!
	JSR	GETBYT
	CMP	ARG1+LO
	BEQ	INTFND		; YES, FOUND IT
INTNXT:
	LDA	VWCUR+0		; TO MOVE UP, JUST ADD
	CLC			; OFFSET FROM START OF THIS
	ADC	ARG4+LO		; ENTRY
	STA	MPCL
	BCC	INEXT0

	LDA	VWCUR+1		; PICK UP CARRY
	ADC	#0
	STA	MPCM
	LDA	VWCUR+2
	ADC	#0
	STA	MPCH
	JSR	VLDMPC		; CROSSED PAGE SO RE-VALIDATE

INEXT0:	DEC	ARG3+LO		; CHECKED ALL ENTRIES?
	BNE	INTLP
	LDA	ARG3+HI
	BEQ	INTNF
	DEC	ARG3+HI
	BNE	INTLP

INTNF:
	LDA	#0		; 0 = NOT FOUND
	STA	VALUE+LO
	STA	VALUE+HI
	JSR	PUTVAL
	JMP	PREDF		; FAILED!

INTFND:
	LDA	VWCUR+LO
	STA	VALUE+LO	; AND SET TO RETURN THE VALUE
	LDA	VWCUR+HI
	STA	VALUE+HI
	JSR	PUTVAL		; SEND IT BACK
	JMP	PREDS		; AND SCREEM SUCCESS

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

ZBCOM:	LDA	ARG1+LO
	EOR	#$FF
	STA	VALUE+LO
	LDA	ARG1+HI
	EOR	#$FF
	STA	VALUE+HI
	JMP	PUTVAL


; -----
; COPYT
; -----

ZCOPYT:
	LDA	ARG2+LO		; CHECK OUT WHAT'S TO BE DONE
	ORA	ARG2+HI
	BNE	ZC0
	JMP	CASE1		; ZERO LENGTH BYTES OF SOURCE
ZC0:
	LDA	ARG3+HI
	CMP	#$7F
	BCC	CASE2
	JMP	CASE3		; FORWARD COPY

	; CASE2 - CHECK IF FORWARD OR BACKWARD COPY

CASE2:	LDA	ARG1+HI		; IF SRC < DEST
	CMP	ARG2+HI
	BCC	CHK2
	BEQ	ZC1
	JMP	FRWRD		; NO
ZC1:	LDA	ARG1+LO
	CMP	ARG2+LO
	BEQ	CHK2
	BCS	FRWRD		; NO
CHK2:	LDA	ARG1+LO		; AND SRC + LENGTH > DEST
	CLC
	ADC	ARG3+LO
	STA	I+LO
	LDA	ARG1+HI
	ADC	ARG3+HI
	CMP	ARG2+HI
	BCC	FRWRD		; NO
	BNE	BKWRD		; YES
	LDA	I+LO
	CMP	ARG2+LO
	BEQ	FRWRD		; DEBUG, IF EQUAL REALLY LESS
	BCS	BKWRD		; OVERLAPS SO DO BACKWARD COPY

	; ELSE FALL THROUGH TO FORWARD COPY

FRWRD:	LDA	#0		; USE GETBYT CAUSE MAY  BE
	STA	MPCH		; BEYOND MAIN MEMORY
	LDA	ARG1+HI
	STA	MPCM
	LDA	ARG1+LO
	STA	MPCL
	JSR	VLDMPC		; AND ALIGN TO CORRECT PAGE
	LDA	ARG2+LO
	STA	I+LO
	LDA	ARG2+HI
	CLC
	ADC	ZCODE		; MAKE ABSOLUTE
	STA	I+HI
	LDA	ARG3+LO
	STA	J+LO
	LDA	ARG3+HI
	STA	J+HI
FRLP:
	JSR	DECJ
	BCC	FRDUN		; CARRY CLEAR ON $FFFF
	JSR	GETBYT
	LDY	#0
	STA	(I),Y

	INC	I+LO
	BNE	FRLP
	INC	I+HI
	JMP	FRLP

FRDUN:	RTS


BKWRD:	
	LDA	ARG3+LO		; DECR 1ST TO GET CORRECT OFFSET
	STA	J+LO
	LDA	ARG3+HI
	STA	J+HI
	JSR	DECJ
	LDA	ARG1+LO		; SET TO END OF SOURCE & DEST.
	CLC
	ADC	J+LO
	STA	I+LO
	LDA	ARG1+HI
	ADC	J+HI
	CLC
	ADC	ZCODE		; ABSOLUTE
	STA	I+HI
	LDA	ARG2+LO
	CLC
	ADC	J+LO
	STA	K+LO
	LDA	ARG2+HI
	ADC	J+HI
	CLC
	ADC	ZCODE
	STA	K+HI
BKLP:	LDY	#0
	LDA	(I),Y
	STA	(K),Y
	LDA	I+LO		; DECR >BYTE AFTER X00 BYTE MOVED
	BNE	BKL0
	DEC	I+HI
BKL0:	DEC	I+LO
	LDA	K+LO
	BNE	BKL1
	DEC	K+HI
BKL1:	DEC	K+LO
	JSR	DECJ		; RETURNS CARRY CLEAR ON $FFFF
	BCS	BKLP
BKDUN:
	RTS

	; ZERO LENGTH # OF BYTES OF SOURCE

CASE1:	LDA	ARG1+LO
	STA	I+LO
	LDA	ARG1+HI
	CLC
	ADC	ZCODE		; ABSOLUTE
	STA	I+HI
	LDA	ARG3+LO		; SET UP COUNTER
	STA	J+LO
	LDA	ARG3+HI
	STA	J+HI
	LDY	#0
C1LP:	JSR	DECJ		; CARRY CLEAR WHEN J = $FFFF
	BCC	C1DUN
	LDA	#0
	STA	(I),Y
	INY
	BNE	C1LP
	INC	I+HI		; NEXT PAGE
	JMP	C1LP
C1DUN:
	RTS

	; 2'S COMPLEMENT LENGTH (XOR + 1) THEN DO FORWARD COPY

CASE3:
	LDA	ARG3+LO
	EOR	#$FF
	STA	ARG3+LO
	LDA	ARG3+HI
	EOR	#$FF
	STA	ARG3+HI
	INC	ARG3+LO
	BNE	GOFRWD
	INC	ARG3+HI
GOFRWD:	JMP	FRWRD


; ---------
; ASSIGNED?
; ---------


ZASSND:
	LDA	ARG1+LO		; COMPARE TO # OF OPTIONALS FROM LAST CALL
	CMP	ASSVLU
	BCC	DOYES		; IF LESS OR EQUAL, WAS ASSIGNED
	BEQ	DOYES
	JMP	PREDF
DOYES:
	JMP	PREDS


; -------------
; LOGICAL SHIFT
; -------------
; SHIFT ARG1, ARG2 BITS (LEFT IF ARG2 IS POS. RIGHT IF NEG.)

ZSHIFT:	LDA	ARG1+LO		; SET UP FOR SHIFT
	STA	VALUE+LO
	LDA	ARG1+HI
	STA	VALUE+HI
	LDA	ARG2+LO		; IF NEGATIVE, SHIFT RIGHT
	CMP	#$80
	BCS	SRIGHT

	; SHIFT LEFT

	TAY			; COUNT
SLP1:	ASL	VALUE+LO
	ROL	VALUE+HI
	DEY
	BNE	SLP1
	JMP	PUTVAL		; AND RETURN THE VALUE

SRIGHT:	EOR	#$FF		; COMPLEMENT
	TAY
SLP2:	LSR	VALUE+HI	; SHIFT
	ROR	VALUE+LO
	DEY
	BPL	SLP2
	JMP	PUTVAL


; ----------------
; ARITHMETIC SHIFT
; ----------------
; PROPAGATING SIGN BIT ON RIGHT SHIFT

ZASHFT:	LDA	ARG2+LO		; IF NEGATIVE, SHIFT RIGHT
	CMP	#$80
	BCC	ZSHIFT		; SAME AS LOGICAL SHIFT
	LDX	ARG1+LO		; SET UP FOR SHIFT
	STX	VALUE+LO
	LDX	ARG1+HI
	STX	VALUE+HI

	EOR	#$FF		; COMPLEMENT COUNT
	TAY
ASLP2:	LDA	ARG1+HI
	ASL	A		; GET SIGN BIT
	ROR	VALUE+HI	; SHIFT
	ROR	VALUE+LO
	DEY
	BPL	ASLP2
	JMP	PUTVAL
	
	END