File:  [Infocom source] / coco / opsx.src
Revision 1.1.1.2 (vendor branch): download - view: text, annotated - select for diffs
Fri Mar 20 10:19:50 2020 UTC (20 months, 2 weeks ago) by root
Branches: infocom, MAIN
CVS tags: tandy, makefile, lwasm, VERSION_D, HEAD
Patches for lwasm

	PAGE
	;SBTTL "--- X-OPS ---"

	; ------
	; EQUAL?
	; ------

ZEQUAL: DEC	ARGCNT
	BNE	DOEQ

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

	LDA	#9
	JSR	ZERROR

DOEQ:	LDD	ARG1
	CMPD	ARG2
	BEQ	EQOK
	DEC	ARGCNT
	BEQ	EQBAD

	CMPD	ARG3
	BEQ	EQOK
	DEC	ARGCNT
	BEQ	EQBAD

	CMPD	ARG4
	BEQ	EQOK
EQBAD:	JMP	PREDF

EQOK:	JMP	PREDS

	; ----
	; CALL
	; ----

	; Branch to function pointed to by [arg1 * 2], passing
	; the optional parameters "arg2" thru "arg4" [VALUE]

ZCALL:	LDD	ARG1		; DID FUNCTION = 0?
	BNE	DOCALL		; NO, CONTINUE
	JMP	MATH		; ELSE RETURN A ZERO

DOCALL:	LDD	OZSTAK		; ZSP FROM PREVIOUS ZCALL
	JSR	PSHDZ
	LDB	ZPCL		; LOW 8 BITS OF ZPC
	JSR	PSHDZ		; SAVE TO Z-STACK
	LDD	ZPCH		; PUSH H & M PC
	JSR	PSHDZ

	; MULTIPLY ARG1 BY 2; FORM 17-BIT ADDR

	CLRA
	ASL	ARG1+1		; BOTTOM 8 BITS
	ROL	ARG1		; MIDDLE 8
	ROLA			; TOP BIT
	STA	ZPCH
	LDD	ARG1
	STD	ZPCM
	CLR	ZPCFLG		; [ZPC] HAS CHANGED ...

	JSR	NEXTPC		; FETCH # NEW LOCALS
	STA	TEMP2		; SAVE IT HERE FOR INDEXING
	STA	TEMP2+1		; AND HERE FOR REFERENCE
	BEQ	ZCALL2		; NO LOCALS IN THIS FUNCTION

	; SAVE OLD LOCALS, REPLACE WITH NEW

	LDX	#LOCALS		; INIT POINTER
ZCALL1:	LDD	,X		; GRAB AN OLD LOCAL
	PSHS	X		; SAVE THE POINTER
	JSR	PSHDZ		; PUSH OLD LOCAL TO Z-STACK
	JSR	NEXTPC		; GET MSB OF NEW LOCAL
	PSHS	A		; SAVE HERE
	JSR	NEXTPC		; NOW GET LSB
	TFR	A,B		; POSITION IT PROPERLY
	PULS	A		; RETRIEVE MSB
	PULS	X		; THIS IS WHERE IT GOES
	STD	,X++		; STORE NEW LOCAL, UPDATE POINTER
	DEC	TEMP2		; ANY MORE OLD LOCALS?
	BNE	ZCALL1		; KEEP LOOPING TILL DONE

ZCALL2:	DEC	ARGCNT		; EXTRA ARGUMENTS IN THIS CALL?
	BEQ	ZCALL4		; NO ARGS TO PASS

	; MOVE UP TO 3 ARGS TO LOCAL STORAGE

ZCALL3:	LDD	ARG2
	STD	LOCALS
	DEC	ARGCNT
	BEQ	ZCALL4
	LDD	ARG3
	STD	LOCALS+2
	DEC	ARGCNT
	BEQ	ZCALL4
	LDD	ARG4
	STD	LOCALS+4

ZCALL4:	LDB	TEMP2+1		; REMEMBER # LOCALS SAVED
	TFR	B,A		; COPY INTO [A]
	COMA			; COMPLEMENT FOR ERROR CHECK (BM 11/24/84)
	JSR	PSHDZ		; AND RETURN
	STU	OZSTAK		; "THE WAY WE WERE ..."
	RTS

	; ---
	; PUT
	; ---

	; Set item "arg2" in WORD-table "arg1" equal to "arg3"

ZPUT:	ASL	ARG2+1		; WORD-ALIGN
	ROL	ARG2		; ARG2
	LDD	ARG2
	ADDD	ARG1		; ADD Z-ADDR OF TABLE
	ADDD	#ZCODE		; FORM ABSOLUTE ADDRESS
	TFR	D,X		; FOR USE AS AN INDEX
	LDD	ARG3
	STD	,X
	RTS

	; ----
	; PUTB
	; ----

	; Set item "arg2" in BYTE-table "arg1" equal to "arg3"

ZPUTB:	LDD	ARG2
	ADDD	ARG1
	ADDD	#ZCODE
	TFR	D,X
	LDA	ARG3+1
	STA	,X
	RTS

	; ----
	; PUTP
	; ----

	; Set property "arg2" in object "arg1" equal to "arg3"

ZPUTP:	JSR	PROPB
PUTP1:	JSR	PROPN
	CMPA	ARG2+1
	BEQ	PUTP2
	BHS	PTP

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

	LDA	#10
	JSR	ZERROR		; ERROR #7 (BAD PROPERTY #)

PTP:	JSR	PROPNX		; NEXT ITEM
	BRA	PUTP1

PUTP2:	JSR	PROPL
	INCB
	TSTA
	BEQ	PUTP2A
	CMPA	#1
	BEQ	PTP1

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

	LDA	#11
	JSR	ZERROR		; ERROR #8 (PROP TOO LONG)

PTP1:	LDX	TEMP
	ABX
	LDD	ARG3
	STD	,X
	RTS

PUTP2A:	LDA	ARG3+1
	LDX	TEMP
	ABX
	STA	,X
	RTS

	; ------
	; PRINTC
	; ------

	; Print the character with ASCII value "arg1"

ZPRC:	LDA	ARG1+1
	JMP	COUT

	; ------
	; PRINTN
	; ------

	; Print "arg1" as a signed integer

ZPRN:	LDD	ARG1
	STD	TEMP

	; PRINT THE SIGNED VALUE IN [TEMP]

NUMBER:	LDD	TEMP
	BPL	DIGCNT		; IF NUMBER IS NEGATIVE,
	LDA	#$2D		; START WITH A MINUS SIGN
	JSR	COUT
	JSR	ABTEMP		; GET ABS(TEMP)

	; COUNT # OF DECIMAL DIGITS

DIGCNT:	CLR	MASK		; RESET INDEX
DGC:	LDD	TEMP		; CHECK QUOTIENT
	BEQ	PRNTN3		; SKIP IF ZERO
	LDD	#10
	STD	VAL		; ELSE DIVIDE BY 10
	JSR	UDIV		; UNSIGNED DIVIDE
	LDA	VAL+1		; GET LSB OF REMAINDER
	PSHS	A		; SAVE ON STACK
	INC	MASK		; INCREMENT CHAR COUNT
	BRA	DGC		; LOOP TILL ARG1=0

PRNTN3:	LDA	MASK
	BEQ	PZERO		; PRINT AT LEAST A "0"
PRNTN4:	PULS	A		; GET A CHAR
	ADDA	#$30		; CONVERT TO ASCII NUMBER
	JSR	COUT
	DEC	MASK		; OUT OF CHARS?
	BNE	PRNTN4		; KEEP PRINTING TILL
	RTS			; DONE

	; PRINT A ZERO

PZERO:	LDA	#$30		; ASCII "0"
	JMP	COUT

	; ------
	; RANDOM
	; ------

	; Return a random value between zero and "arg1" [VALUE]

ZRAND:	LDD	ARG1		; USE [ARG1]
	STD	VAL		; AS THE DIVISOR

	LDD	RAND1		; GET A RANDOM #
	ADDD	#$AA55		; DO WEIRD THINGS
	STA	RAND2		; SAVE AS
	STB	RAND1		; NEW SEED
	ANDA	#%01111111	; MAKE POSITIVE
	STD	TEMP		; MAKE IT THE DIVIDEND

	JSR	DIVIDE		; UNSIGNED DIVIDE!
	LDD	VAL		; GET REMAINDER
	ADDD	#1		; AT LEAST 1
	JMP	MATH

	; ----
	; PUSH
	; ----

	; Push "arg1" onto the Z-stack

ZPUSH:	LDD	ARG1
	JMP	PSHDZ

	; ---
	; POP
	; ---

	; Pop a word off Z-stack and store in variable "arg1"

ZPOP:	JSR	POPSTK
	LDA	ARG1+1		; GET VARIABLE ID
	JMP	VARPUT

	; -----
	; SPLIT
	; -----

ZSPLIT	EQU	ZNOOP

	; ------
	; SCREEN
	; ------

ZSCRN	EQU	ZNOOP

	;END


unix.superglobalmegacorp.com