![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ops1.src CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Infocom source] / coco|
Return to ops1.src CVS log | Up to [Infocom source] / coco |
1.1 root 1: PAGE
2: SBTTL "--- 1-OPS ---"
3:
4: ; -----
5: ; ZERO?
6: ; -----
7:
8: ; Is arg1 equal to zero? [PRED]
9:
10: ZZERO: LDD ARG1
11: LBEQ PREDS
12: JMP PREDF
13:
14: ; -----
15: ; NEXT?
16: ; -----
17:
18: ; Return the NEXT pointer in object "arg1"; fail if
19: ; none left, and return zero [VALUE][PRED]
20:
21: ZNEXT: LDA ARG1+1
22: JSR OBJLOC
23: LDB #5 ; SAME AS FIRST?
24: BRA FIRST1
25:
26: ; ------
27: ; FIRST?
28: ; ------
29:
30: ; Return the FIRST pointer in object "arg1"; fail if
31: ; none, and return zero [VALUE][PRED]
32:
33: ZFIRST: LDA ARG1+1
34: JSR OBJLOC
35: LDB #6
36:
37: FIRST1: LDX TEMP
38: LDA B,X ; FETCH SLOT
39: STA TEMP+1 ; SAVE HERE
40: PSHS A ; AND ON STACK
41: CLR TEMP ; ZERO MSB
42: JSR PUTVAL
43: PULS A
44: TSTA
45: LBEQ PREDF ; FAILURE
46: JMP PREDS ; OR SUCCESS
47:
48: ; ---
49: ; LOC
50: ; ---
51:
52: ; Return the object containing object "arg1"; zero if none [VALUE]
53:
54: ZLOC: LDA ARG1+1
55: JSR OBJLOC
56: LDX TEMP
57: LDA 4,X
58: STA TEMP+1
59: CLR TEMP
60: JMP PUTVAL
61:
62: ; ------
63: ; PTSIZE
64: ; ------
65:
66: ; Return length of prop table "arg1" in bytes [VALUE]
67:
68: ZPTSIZ: LDD ARG1
69: ADDD #ZCODE
70: SUBD #1
71: STD TEMP
72: CLRB
73: JSR PROPL
74: INCA
75: JMP PUTBYT
76:
77: ; ---
78: ; INC
79: ; ---
80:
81: ; Increment arg1 [VALUE]
82:
83: ZINC: LDA ARG1+1
84: JSR VARGET
85: LDD TEMP
86: ADDD #1
87: ZINC1: STD TEMP
88: PSHS D
89: LDA ARG1+1
90: JSR VARPUT
91: PULS D
92: STD TEMP
93: RTS
94:
95: ; ---
96: ; DEC
97: ; ---
98:
99: ; Decrement arg1 [VALUE]
100:
101: ZDEC: LDA ARG1+1
102: JSR VARGET
103: LDD TEMP
104: SUBD #1
105: BRA ZINC1
106:
107: ; ------
108: ; PRINTB
109: ; ------
110:
111: ; PRINT the string pointed to by BYTE-pointer "arg1"
112:
113: ZPRB: LDD ARG1
114: STD TEMP
115: JSR SETWRD
116: JMP PZSTR
117:
118: ; ------
119: ; REMOVE
120: ; ------
121:
122: ; Move object "arg1" to pseudo-object #0
123:
124: ZREMOV: LDA ARG1+1
125: JSR OBJLOC
126: LDX TEMP
127: LDA 4,X
128: BEQ REMVEX ; NO OBJECT
129:
130: PSHS X ; SAVE [TEMP]
131:
132: JSR OBJLOC
133: LDX TEMP
134: LDA 6,X
135: CMPA ARG1+1
136: BNE REMVC1
137:
138: PULS X ; RETRIEVE FORMER [TEMP]
139: PSHS X ; SAVE COPY ON STACK
140:
141: LDA 5,X ; OLD [TEMP] IS IN [X]
142: LDX TEMP
143: STA 6,X
144:
145: BRA REMVC2
146:
147: REMVC1: JSR OBJLOC
148: LDX TEMP
149: LDA 5,X
150: CMPA ARG1+1
151: BNE REMVC1
152:
153: PULS X
154: PSHS X
155:
156: LDA 5,X
157: LDX TEMP
158: STA 5,X
159:
160: REMVC2: PULS X
161: CLR 4,X
162: CLR 5,X
163:
164: REMVEX: RTS
165:
166: ; ------
167: ; PRINTD
168: ; ------
169:
170: ; Print short description of object "arg1"
171:
172: ZPRD: LDA ARG1+1
173:
174: PRNTDC: JSR OBJLOC
175: LDX TEMP
176: LDD 7,X
177: ADDD #1 ; INCREMENT
178: STD TEMP ; AND SAVE
179: JSR SETWRD
180: JMP PZSTR
181:
182: ; ------
183: ; RETURN
184: ; ------
185:
186: ; Return from a CALL with value "arg1"
187:
188: ZRET: LDU OZSTAK ; STAY IN SYNC!
189: JSR POPSTK ; POP # LOCALS
190: STB VAL ; SAVE COUNT HERE
191:
192: COMA ; COMPLEMENT [A]
193: CMPA VAL ; SHOULD BE OPPOSITE OF [B]
194: BNE RETERR ; IF NOT, STACK IS BAD (BM 11/24/84)
195:
196: TSTB ; CHECK # LOCALS
197: BEQ RET2 ; SKIP IF NO LOCALS
198:
199: ; RESTORE LOCAL VARIABLES
200:
201: LDX #LOCALS ; SET UP A POINTER
202: ASLB ; WORD-ALIGN THE INDEX
203: ABX ; [X] POINTS TO LAST LOCAL VAR
204:
205: RET1: JSR POPSTK ; POP A VALUE ([X] UNAFFECTED)
206: STD ,--X ; SAVE IN [LOCALS], UPDATE INDEX
207: DEC VAL
208: BNE RET1 ; LOOP TILL ALL LOCALS POPPED
209:
210: ; RESTORE OTHER VARIABLES
211:
212: RET2: JSR POPSTK
213: STD ZPCH ; RESTORE TOP 9 BITS OF ZPC
214: JSR POPSTK
215: STB ZPCL ; RESTORE LOWER 8 BITS OF ZPC
216: JSR POPSTK
217: STD OZSTAK ; AND OLD ZSP
218: CLR ZPCFLG ; PC NO LONGER VALID
219:
220: LDD ARG1
221: STD TEMP ; PASS THE RETURN VALUE
222: JMP PUTVAL ; TO PUTVAL
223:
224: ; *** ERROR #15: Z-STACK DESTROYED ***
225:
226: RETERR: LDA #15
227: JMP ZERROR
228:
229: ; ----
230: ; JUMP
231: ; ----
232:
233: ; Branch to location pointed to by 16-bit 2's-comp "arg1"
234:
235: ZJUMP: LDD ARG1 ; TREAT LIKE A BRANCH
236: SUBD #1 ; THAT ALWAYS SUCCEEDS
237: STD TEMP
238: JMP PREDB3
239:
240: ; -----
241: ; PRINT
242: ; -----
243:
244: ; Print the z-string pointed to by WORD-pointer "arg1"
245:
246: ZPRINT: LDD ARG1
247: STD TEMP ; TELL SETSTR
248: JSR SETSTR ; WHERE THE STRING RESIDES
249: JMP PZSTR ; AND PRINT IT
250:
251: ; -----
252: ; VALUE
253: ; -----
254:
255: ; Return value of arg1 [VALUE]
256:
257: ZVALUE: LDA ARG1+1 ; GRAB VARIABLE ID
258: JSR VARGET ; FETCH ITS VALUE
259: JMP PUTVAL ; AND RETURN IT
260:
261: ; ----
262: ; BCOM
263: ; ----
264:
265: ; Complement arg1 [VALUE]
266:
267: ZBCOM: LDD ARG1 ; GRAB ARGUMENT
268: COMA ; COMPLEMENT MSB
269: COMB ; AND LSB
270: STD TEMP ; AND PASS TO PUTVAL
271: JMP PUTVAL
272:
273: END
274:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.