erkyrath.infocom-zcode-terps/atari/opsx.dip

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

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

	; ENTRY: [NARGS] = 0

GCALL:	LDX	#15		; FILL THE ARG-TYPE LIST
	LDA	#%11000000	; WITH "NO MORE ARGS" BYTES
GCL:	STA	CTYPES,X
	DEX
	BPL	GCL

	LDA	#4
	STA	ADEX		; INIT BYTE INDEX
	STA	ADEX2		; AND ARG BYTE COUNTER

GCL0:	JSR	NEXTPC		; GRAB AN ARGUMENT BYTE
	STA	ABYTE		; SAVE IT HERE
	JMP	GCL2		; SKIP OVER 1ST SHIFT

GCL1:	LDA	ABYTE
	ASL	A
	ASL	A
	STA	ABYTE

GCL2:	AND	#%11000000	; MASK GARBAGE
	CMP	#%11000000	; LAST ARGUMENT?
	BEQ	GCL3		; YES, TIME TO DECODE ARGS

	LDX	NARGS		; ELSE ADD THIS ARGUMENT
	STA	CTYPES,X	; TO THE ARG-TYPE LIST
	INC	NARGS		; UPDATE # ARGUMENTS

	DEC	ADEX		; THIS ARG BYTE EMPTY?
	BNE	GCL1		; NO, GET NEXT ARG

	LDA	#4		; ELSE RESET
	STA	ADEX		; ARGUMENT INDEX
	DEC	ADEX2		; DONE 4 ARG BYTES?
	BNE	GCL0		; NO, GET ANOTHER

	; [CTYPES] HAS LIST OF ARG TYPES
	; [NARGS] HAS # ARGUMENTS

GCL3:	LDA	#0		; RESET THE
	STA	ADEX		; ARGUMENT INDEX
	STA	ADEX2		; AND STORAGE INDEX

	LDA	NARGS		; CONTINUE ONLY IF
	BNE	GCL4		; [NARGS] <> 0

	; *** ERROR #12: NO CALL ADDRESS ***

	LDA	#12
	JMP	GERROR

GCL4:	LDX	ADEX		; GET ARG INDEX
	CPX	NARGS		; OUT OF ARGS YET?
	BEQ	GCL8		; YES IF [X] = [NARGS]

	INC	ADEX		; ELSE UPDATE THE INDEX
	LDA	CTYPES,X	; GET A TYPE BYTE
	BNE	GCL5
	JSR	GETLNG		; 00 = LONG IMMEDIATE
	JMP	GCL7

GCL5:	CMP	#%01000000
	BNE	GCL6
	JSR	GETSHT		; 01 = SHORT IMMEDIATE
	JMP	GCL7

GCL6:	JSR	GETVAR		; ELSE GET VARIABLE

	; ARGUMENT IS NOW IN [VALUE]

GCL7:	LDX	ADEX2		; GET STORAGE INDEX
	LDA	VALUE+LO	; MOVE LSB OF VALUE
	STA	CARGS,X		; INTO [CARGS]
	LDA	VALUE+HI	; ALSO MOVE
	STA	CARGS+1,X	; MSB

	INX
	INX			; UPDATE THE
	STX	ADEX2		; STORAGE INDEX
	BNE	GCL4		; LOOP BACK FOR ANOTHER ARGUMENT

	; ARGUMENTS IN [CARGS], # ARGUMENTS IN [NARGS]

GCL8:	LDA	CARGS+LO	; IS CALL ADDRESS
	ORA	CARGS+HI	; ZERO?
	BNE	DOCALL		; NO, CONTINUE

	JMP	PUTBYT		; ELSE RETURN THE ZERO IN [A]

DOCALL:	LDX	OLDGSP		; SAVE [OLDGSP]
	TXA
	JSR	PSHXA

	LDX	GPCL		; AND [GPC]
	LDA	GPCH
	JSR	PSHXA

;***
	LDX	GPC0
	JSR	PSHXA
;***


	LDA	CARGS+LO	; RESET [GPC]
	STA	GPCL
	LDA	CARGS+HI
	STA	GPCH
	LDA	#0

;***
	STA	GPC0		; ALL FUNCTIONS START ON WORD BOUNDRIES
;***

	STA	GPCFLG		; AND ANNOUNCE CHANGE

	JSR	NEXTPC		; GET # LOCALS IN FUNCTION
	STA	ADEX		; SAVE HERE FOR REFERENCE
	STA	ADEX2		; AND HERE FOR COUNTING
	BEQ	CALL2		; IF ZERO, JUMP AHEAD

	LDA	#0
	STA	J+LO		; INIT LOOP INDEX

CALL1:	LDY	J+LO
	LDX	LOCALS,Y	; GET LSB OF LOCAL INTO [X]
	LDA	LOCALS+1,Y	; GET MSB INTO [A]
	JSR	PSHXA		; PUSH [X/A]

	JSR	NEXTPC		; GET MSB OF NEW LOCAL
	LDY	J+LO
	STA	LOCALS+1,Y	; MOVE MSB TO [LOCALS]

	JSR	NEXTPC		; GET LSB OF NEW LOCAL
	LDY	J+LO
	STA	LOCALS,Y	; STORE LSB

	INY
	INY
	STY	J+LO		; UPDATE STORAGE INDEX

	DEC	ADEX2		; ANY MORE LOCALS?
	BNE	CALL1		; YES, LOOP BACK

CALL2:	DEC	NARGS		; ANY ARGS LEFT?
	BEQ	CALL4		; NO, SCRAM NOW

	; PASS UP TO 15 [CARGS] TO [LOCALS]

	LDX	#0		; INIT LOOP INDEX

CALL3:	LDA	CARGS+2,X	; GET LSB OF ARGUMENT
	STA	LOCALS,X	; ASSIGN TO A LOCAL
	LDA	CARGS+3,X	; SAME FOR
	STA	LOCALS+1,X	; MSB

	INX			; POINT TO THE
	INX			; NEXT ENTRIES

	DEC	NARGS		; OUT OF ARGS YET?
	BNE	CALL3		; NO, KEEP LOOPING

	; PUSH # LOCALS

CALL4:	LDX	ADEX		; # LOCALS KEPT HERE
	TXA
	JSR	PSHXA

	LDA	GSP		; REMEMBER WHERE WE ARE
	STA	OLDGSP

	JMP	MLOOP		; BACK TO MAIN LOOP

	; ---
	; PUT
	; ---

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

;GPUT:	ASL	ARG2+LO		; WORD-ALIGN
;	ROL	ARG2+HI		; [ARG2]
;	JSR	PCALC

;***
GPUT:	CLC


	JSR	PCALC		; GET ADDRESS INTO [I]
;***


	LDA	ARG3+HI
	STA	(I),Y		; [Y] = 0
	INY
	BNE	PUTLSB		; BRANCH ALWAYS

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

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

;GPUTB:	JSR	PCALC

;***
GPUTB:	CLC

	LSR	ARG2+HI		; DIVIDE BY TWO TO ADJUST FOR BYTE POINTING
	ROR	ARG2+LO		; LEAVE BIT 0 IN CARRY FOR PCALC
	JSR	PCALC
;***

PUTLSB:	LDA	ARG3+LO
	STA	(I),Y
	RTS

	; ------------------
	; CALC "PUT" ADDRESS
	; ------------------

PCALC:	LDY	#0		; FOR INDEXING

;***
	BCC	PCALC1		; TAKE CARE OF CARRY FROM GPUTB
	INY
;***
PCALC1: LDA	ARG2+LO		; ADD ITEM OFFSET
	CLC			; TO TABLE ADDRESS
	ADC	ARG1+LO		; FIRST LSB
	STA	I+LO

	LDA	ARG2+HI		; THEN MSB
	ADC	ARG1+HI

ICENT:	CMP	GPURE		; IS CODE IN G-PRELOAD? (ENTRY FOR ICALC)
	BCC	USEGP		; YES, OK TO CHANGE

	CMP	ISTART		; IS IT BELOW THE I-FILE?
	BCC	PURERR		; CAN'T CHANGE PURE CODE!

	CMP	IPURE		; IS IT ABOVE THE I-PRELOAD?
	BCS	PURERR		; YES, UNCHANGEABLE!

	; POINT TO BYTE IN I-PRELOAD

	SEC
	SBC	ISTART		; STRIP OF V-OFFSET

;***
	ASL	I+LO		; *2
	ROL	A
****

	CLC
	ADC	ICODE+HI	; MAKE IT ABSOLUTE
	STA	I+HI

;***
PCALC2:	RTS

;***

;	RTS

	; POINT TO BYTE IN G-PRELOAD
;***
USEGP:	ASL	I+LO		; * 2 FOR 512 BYTE PAGES
	ROL	A
;***
	CLC
	ADC	GCODE		; CALC ABSOLUTE ADDR
	STA	I+HI		; IN G-PRELOAD
	RTS

	; *** ERROR #9: PURITY VIOLATION ***

PURERR:	LDA	#9
	JMP	GERROR

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

	; RETURN A RANDOM VALUE BETWEEN 1 AND [ARG1]

GRAND:	LDA	ARG1+LO		; MAKE [ARG1]
	STA	ARG2+LO		; A DIVISOR
	LDA	ARG1+HI
	STA	ARG2+HI

	JSR	DORAND		; GET RANDOM BYTES
	STX	ARG1+LO		; INTO [A] & [X]
	AND	#%01111111	; MAKE IT A POSITIVE
	STA	ARG1+HI		; DIVIDEND

	JSR 	DIVIDE		; SIGNED DIVISION

	LDA	REMAIN+LO	; GRAB THE REMAINDER
	STA	VALUE+LO
	LDA	REMAIN+HI
	STA	VALUE+HI

	JSR	INCVAL		; INCREMENT IT
	JMP	PUTVAL		; AND RETURN THE RESULT


	;-------------------------------------
	; GITER: INITIALIZE ITERATION TABLE AT
	;	WORD-ADDRESS ARG1
	;-------------------------------------

GITER:	LDA	#00		; SET ARG4=0 FOR ICALC
	STA	ARG4+LO
	STA	ARG4+HI

	LDA	ARG1+HI		; MOVE ARG1 TO ARG3
	STA	ARG3+HI
	LDA	ARG1+LO
	STA	ARG3+LO
	JSR	ICALC		; THIS WILL ALSO CHECK PURITY VIOLATIONS

	LDA	(I),Y		; GET NUMBER OF ENTRIES IN TABLE
	STA	ITICN

	INY
	TYA                   	; INIT ICOUNT Y=1 A=1
	STA	(I),Y

	INC	ARG4+LO		; POINT TO FIRST WORD OF FIRST ENTRY

GITER1:	JSR	ICALC
	LDA	(I),Y		; HIGH BYTE OF ICON ADDRESS
	PHA			; SAVE
	INY			; =1
	LDA	(I),Y 		; LOWBYTE OF ADDRESS
	TAX
	PLA
	JSR	GETI		; GET ICON INFORMATION

	LDA	#0
	LDY	#6
	STA	(I),Y		; SET NEGATE FOR POSITIVE DISPLAY
	INY			; =7
	LDA	#1
	STA	(I),Y		; SET FIRST ITERATION=1

	INY			; =8
	LDA	BSET
	STA	(I),Y		; SAVE BSET
	INY			; =9
	LDA	ITERS
	STA	(I),Y		; SAVE # OF ITERS

	INY			; =10
	LDA	IX1
	STA	(I),Y		; SAVE ICON WIDTH
	INY			; =11
	LDA	IY1
	STA	(I),Y		; SAVE ICON HEIGHTH

	JSR	NXTENT
	DEC	ITICN
	BNE	GITER1
	RTS


	;------------------------
	; GDUMP : NOT IMPLIMENTED
	;         RETURN 0
	;------------------------
GDUMP:	JMP	RET0

	;-------------------------
	; GLOAD : NOT IMPLIMENTED
	;	  RETURN 0
	;------------------------
GLOAD:	JMP	RET0

	END