![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to opsx.src CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Infocom source] / coco|
Return to opsx.src CVS log | Up to [Infocom source] / coco |
1.1 root 1: PAGE
2: SBTTL "--- X-OPS ---"
3:
4: ; ------
5: ; EQUAL?
6: ; ------
7:
8: ZEQUAL: DEC ARGCNT
9: BNE DOEQ
10:
11: ; *** ERROR #9: NOT ENOUGH "EQUAL?" ARGS ***
12:
13: LDA #9
14: JSR ZERROR
15:
16: DOEQ: LDD ARG1
17: CMPD ARG2
18: BEQ EQOK
19: DEC ARGCNT
20: BEQ EQBAD
21:
22: CMPD ARG3
23: BEQ EQOK
24: DEC ARGCNT
25: BEQ EQBAD
26:
27: CMPD ARG4
28: BEQ EQOK
29: EQBAD: JMP PREDF
30:
31: EQOK: JMP PREDS
32:
33: ; ----
34: ; CALL
35: ; ----
36:
37: ; Branch to function pointed to by [arg1 * 2], passing
38: ; the optional parameters "arg2" thru "arg4" [VALUE]
39:
40: ZCALL: LDD ARG1 ; DID FUNCTION = 0?
41: BNE DOCALL ; NO, CONTINUE
42: JMP MATH ; ELSE RETURN A ZERO
43:
44: DOCALL: LDD OZSTAK ; ZSP FROM PREVIOUS ZCALL
45: JSR PSHDZ
46: LDB ZPCL ; LOW 8 BITS OF ZPC
47: JSR PSHDZ ; SAVE TO Z-STACK
48: LDD ZPCH ; PUSH H & M PC
49: JSR PSHDZ
50:
51: ; MULTIPLY ARG1 BY 2; FORM 17-BIT ADDR
52:
53: CLRA
54: ASL ARG1+1 ; BOTTOM 8 BITS
55: ROL ARG1 ; MIDDLE 8
56: ROLA ; TOP BIT
57: STA ZPCH
58: LDD ARG1
59: STD ZPCM
60: CLR ZPCFLG ; [ZPC] HAS CHANGED ...
61:
62: JSR NEXTPC ; FETCH # NEW LOCALS
63: STA TEMP2 ; SAVE IT HERE FOR INDEXING
64: STA TEMP2+1 ; AND HERE FOR REFERENCE
65: BEQ ZCALL2 ; NO LOCALS IN THIS FUNCTION
66:
67: ; SAVE OLD LOCALS, REPLACE WITH NEW
68:
69: LDX #LOCALS ; INIT POINTER
70: ZCALL1: LDD ,X ; GRAB AN OLD LOCAL
71: PSHS X ; SAVE THE POINTER
72: JSR PSHDZ ; PUSH OLD LOCAL TO Z-STACK
73: JSR NEXTPC ; GET MSB OF NEW LOCAL
74: PSHS A ; SAVE HERE
75: JSR NEXTPC ; NOW GET LSB
76: TFR A,B ; POSITION IT PROPERLY
77: PULS A ; RETRIEVE MSB
78: PULS X ; THIS IS WHERE IT GOES
79: STD ,X++ ; STORE NEW LOCAL, UPDATE POINTER
80: DEC TEMP2 ; ANY MORE OLD LOCALS?
81: BNE ZCALL1 ; KEEP LOOPING TILL DONE
82:
83: ZCALL2: DEC ARGCNT ; EXTRA ARGUMENTS IN THIS CALL?
84: BEQ ZCALL4 ; NO ARGS TO PASS
85:
86: ; MOVE UP TO 3 ARGS TO LOCAL STORAGE
87:
88: ZCALL3: LDD ARG2
89: STD LOCALS
90: DEC ARGCNT
91: BEQ ZCALL4
92: LDD ARG3
93: STD LOCALS+2
94: DEC ARGCNT
95: BEQ ZCALL4
96: LDD ARG4
97: STD LOCALS+4
98:
99: ZCALL4: LDB TEMP2+1 ; REMEMBER # LOCALS SAVED
100: TFR B,A ; COPY INTO [A]
101: COMA ; COMPLEMENT FOR ERROR CHECK (BM 11/24/84)
102: JSR PSHDZ ; AND RETURN
103: STU OZSTAK ; "THE WAY WE WERE ..."
104: RTS
105:
106: ; ---
107: ; PUT
108: ; ---
109:
110: ; Set item "arg2" in WORD-table "arg1" equal to "arg3"
111:
112: ZPUT: ASL ARG2+1 ; WORD-ALIGN
113: ROL ARG2 ; ARG2
114: LDD ARG2
115: ADDD ARG1 ; ADD Z-ADDR OF TABLE
116: ADDD #ZCODE ; FORM ABSOLUTE ADDRESS
117: TFR D,X ; FOR USE AS AN INDEX
118: LDD ARG3
119: STD ,X
120: RTS
121:
122: ; ----
123: ; PUTB
124: ; ----
125:
126: ; Set item "arg2" in BYTE-table "arg1" equal to "arg3"
127:
128: ZPUTB: LDD ARG2
129: ADDD ARG1
130: ADDD #ZCODE
131: TFR D,X
132: LDA ARG3+1
133: STA ,X
134: RTS
135:
136: ; ----
137: ; PUTP
138: ; ----
139:
140: ; Set property "arg2" in object "arg1" equal to "arg3"
141:
142: ZPUTP: JSR PROPB
143: PUTP1: JSR PROPN
144: CMPA ARG2+1
145: BEQ PUTP2
146: BHS PTP
147:
148: ; *** ERROR #10: BAD PROPERTY NUMBER ***
149:
150: LDA #10
151: JSR ZERROR ; ERROR #7 (BAD PROPERTY #)
152:
153: PTP: JSR PROPNX ; NEXT ITEM
154: BRA PUTP1
155:
156: PUTP2: JSR PROPL
157: INCB
158: TSTA
159: BEQ PUTP2A
160: CMPA #1
161: BEQ PTP1
162:
163: ; *** ERROR #11: PROPERTY LENGTH ***
164:
165: LDA #11
166: JSR ZERROR ; ERROR #8 (PROP TOO LONG)
167:
168: PTP1: LDX TEMP
169: ABX
170: LDD ARG3
171: STD ,X
172: RTS
173:
174: PUTP2A: LDA ARG3+1
175: LDX TEMP
176: ABX
177: STA ,X
178: RTS
179:
180: ; ------
181: ; PRINTC
182: ; ------
183:
184: ; Print the character with ASCII value "arg1"
185:
186: ZPRC: LDA ARG1+1
187: JMP COUT
188:
189: ; ------
190: ; PRINTN
191: ; ------
192:
193: ; Print "arg1" as a signed integer
194:
195: ZPRN: LDD ARG1
196: STD TEMP
197:
198: ; PRINT THE SIGNED VALUE IN [TEMP]
199:
200: NUMBER: LDD TEMP
201: BPL DIGCNT ; IF NUMBER IS NEGATIVE,
202: LDA #$2D ; START WITH A MINUS SIGN
203: JSR COUT
204: JSR ABTEMP ; GET ABS(TEMP)
205:
206: ; COUNT # OF DECIMAL DIGITS
207:
208: DIGCNT: CLR MASK ; RESET INDEX
209: DGC: LDD TEMP ; CHECK QUOTIENT
210: BEQ PRNTN3 ; SKIP IF ZERO
211: LDD #10
212: STD VAL ; ELSE DIVIDE BY 10
213: JSR UDIV ; UNSIGNED DIVIDE
214: LDA VAL+1 ; GET LSB OF REMAINDER
215: PSHS A ; SAVE ON STACK
216: INC MASK ; INCREMENT CHAR COUNT
217: BRA DGC ; LOOP TILL ARG1=0
218:
219: PRNTN3: LDA MASK
220: BEQ PZERO ; PRINT AT LEAST A "0"
221: PRNTN4: PULS A ; GET A CHAR
222: ADDA #$30 ; CONVERT TO ASCII NUMBER
223: JSR COUT
224: DEC MASK ; OUT OF CHARS?
225: BNE PRNTN4 ; KEEP PRINTING TILL
226: RTS ; DONE
227:
228: ; PRINT A ZERO
229:
230: PZERO: LDA #$30 ; ASCII "0"
231: JMP COUT
232:
233: ; ------
234: ; RANDOM
235: ; ------
236:
237: ; Return a random value between zero and "arg1" [VALUE]
238:
239: ZRAND: LDD ARG1 ; USE [ARG1]
240: STD VAL ; AS THE DIVISOR
241:
242: LDD RAND1 ; GET A RANDOM #
243: ADDD #$AA55 ; DO WEIRD THINGS
244: STA RAND2 ; SAVE AS
245: STB RAND1 ; NEW SEED
246: ANDA #%01111111 ; MAKE POSITIVE
247: STD TEMP ; MAKE IT THE DIVIDEND
248:
249: JSR DIVIDE ; UNSIGNED DIVIDE!
250: LDD VAL ; GET REMAINDER
251: ADDD #1 ; AT LEAST 1
252: JMP MATH
253:
254: ; ----
255: ; PUSH
256: ; ----
257:
258: ; Push "arg1" onto the Z-stack
259:
260: ZPUSH: LDD ARG1
261: JMP PSHDZ
262:
263: ; ---
264: ; POP
265: ; ---
266:
267: ; Pop a word off Z-stack and store in variable "arg1"
268:
269: ZPOP: JSR POPSTK
270: LDA ARG1+1 ; GET VARIABLE ID
271: JMP VARPUT
272:
273: ; -----
274: ; SPLIT
275: ; -----
276:
277: ZSPLIT EQU ZNOOP
278:
279: ; ------
280: ; SCREEN
281: ; ------
282:
283: ZSCRN EQU ZNOOP
284:
285: END
286:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.