![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ops2.src CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Infocom source] / coco|
Return to ops2.src CVS log | Up to [Infocom source] / coco |
1.1 root 1: PAGE
2: SBTTL "--- 2-OPS ---"
3:
4: ; -----
5: ; LESS?
6: ; -----
7:
8: ; Is arg1 less than arg2? [PRED]
9:
10: ZLESS: LDD ARG1
11: STD TEMP
12: LDD ARG2
13: STD VAL
14: BRA CEXIT
15:
16: ; -----
17: ; GRTR?
18: ; -----
19:
20: ; Is arg1 greater than arg2? [PRED]
21:
22: ZGRTR: LDD ARG1
23: STD VAL
24: LDD ARG2
25: STD TEMP
26: BRA CEXIT
27:
28: ; ------
29: ; DLESS?
30: ; ------
31:
32: ; Decrement variable "arg1"; succeed if new value
33: ; is less than arg2 [PRED]
34:
35: ZDLESS: JSR ZDEC ; DECREMENT THE VARIABLE
36: LDD ARG2
37: STD VAL
38: BRA CEXIT ; AND COMPARE
39:
40: ; ------
41: ; IGRTR?
42: ; ------
43:
44: ; Increment variable "arg1"; succeed if new value is
45: ; greater than arg2 [PRED]
46:
47: ZIGRTR: JSR ZINC ; INCREMENT THE VARIABLE
48: LDD TEMP
49: STD VAL
50: LDD ARG2
51: STD TEMP
52:
53: CEXIT: BSR SCOMP
54: BLO POK
55: PBAD: JMP PREDF
56:
57: ; -----------------
58: ; SIGNED COMPARISON
59: ; -----------------
60:
61: SCOMP: LDA VAL ; ARE ARGUMENTS
62: EORA TEMP ; SIGNED THE SAME?
63: BPL SCMP ; YES, DO ORDINARY COMPARE
64: LDA VAL ; ELSE COMPARE
65: CMPA TEMP ; ONLY THE HIGH BYTES
66: RTS
67:
68: SCMP: LDD TEMP
69: CMPD VAL
70: RTS
71:
72: ; ---
73: ; IN?
74: ; ---
75:
76: ; Is object "arg1" contained in object "arg2?" [PRED]
77:
78: ZIN: LDA ARG1+1
79: JSR OBJLOC
80: LDX TEMP
81: LDA ARG2+1
82: CMPA 4,X
83: BNE PBAD
84: POK: JMP PREDS
85:
86: ; ----
87: ; BTST
88: ; ----
89:
90: ; Is every "on" bit in arg1 also "on" in arg2? [PRED]
91:
92: ZBTST: LDD ARG2
93: ANDA ARG1
94: ANDB ARG1+1
95: CMPD ARG2
96: BEQ POK
97: BRA PBAD
98:
99: ; ---
100: ; BOR
101: ; ---
102:
103: ; Return bitwise OR of arg1 and arg2 [VALUE]
104:
105: ZBOR: LDD ARG1
106: ORA ARG2
107: ORB ARG2+1
108: ZB0: STD TEMP
109: JMP PUTVAL
110:
111: ; ----
112: ; BAND
113: ; ----
114:
115: ; Return bitwise AND of arg1 and arg2 [VALUE]
116:
117: ZBAND: LDD ARG1
118: ANDA ARG2
119: ANDB ARG2+1
120: BRA ZB0
121:
122: ; -----
123: ; FSET?
124: ; -----
125:
126: ; Is flag "arg2" set in object "arg1?" [PRED]
127:
128: ZFSETP: JSR FLAGSU ; GET BIT
129: LDD VAL
130: ANDA MASK
131: STA VAL
132: ANDB MASK+1
133: ORB VAL
134: BNE POK ; BIT IS ON
135: BRA PBAD
136:
137: ; ----
138: ; FSET
139: ; ----
140:
141: ; Set flag "arg2" in object "arg1"
142:
143: ZFSET: JSR FLAGSU
144: LDX TEMP ; ADDRESS OF FLAGS
145: LDD VAL ; GRAB FLAGS
146: ORA MASK ; SUPERIMPOSE THE
147: ORB MASK+1 ; MASKING PATTERN
148: STD ,X ; AND REPLACE FLAG
149: RTS
150:
151: ; ------
152: ; FCLEAR
153: ; ------
154:
155: ; Clear flag "arg2" in object "arg1"
156:
157: ZFCLR: JSR FLAGSU
158: LDX TEMP ; ADDRESS OF OBJECT
159: LDD MASK ; GRAB THE MASK
160: COMA ; COMPLEMENT IT
161: COMB
162: ANDA VAL ; SUPERIMPOSE FLAGS
163: ANDB VAL+1 ; TO MASK OUT TARGET
164: STD ,X ; REPLACE THE FLAGS
165: RTS
166:
167: ; ---
168: ; SET
169: ; ---
170:
171: ; Set variable "arg1" equal to value "arg2"
172:
173: ZSET: LDD ARG2
174: STD TEMP
175: LDA ARG1+1
176: JMP VARPUT
177:
178: ; ----
179: ; MOVE
180: ; ----
181:
182: ; Put object "arg1" into object "arg2"
183:
184: ZMOVE: JSR ZREMOV ; REMOVE OBJECT FIRST
185: LDA ARG1+1
186: JSR OBJLOC ; GET ADDRESS OF OBJECT
187: LDX TEMP ; PUT ADDRESS IN X
188: PSHS X ; SAVE IT HERE TOO
189: LDA ARG2+1
190: STA 4,X
191:
192: JSR OBJLOC
193: LDX TEMP
194: LDA 6,X
195: STA VAL ; HOLD HERE FOR A MOMENT
196: LDA ARG1+1
197: STA 6,X
198: PULS X ; RESTORE OLD [TEMP]
199: LDA VAL
200: BEQ ZMVEX
201: STA 5,X
202: ZMVEX: RTS
203:
204: ; ---
205: ; GET
206: ; ---
207:
208: ; Return value of item "arg2" in WORD-table at "arg1" [VALUE]
209:
210: ZGET: ASL ARG2+1
211: ROL ARG2 ; WORD-ALIGN ARG2
212: LDD ARG2
213: ADDD ARG1 ; ADD OFFSET TO TABLE ADDRESS
214: STD TEMP
215: JSR SETWRD
216: JSR GETWRD
217: JMP PUTVAL
218:
219: ; ----
220: ; GETB
221: ; ----
222:
223: ; Return value of item "arg2" in BYTE-table at "arg1" [VALUE]
224:
225: ZGETB: LDD ARG1
226: ADDD ARG2
227: STD TEMP
228: JSR SETWRD
229: JSR GETBYT
230: STA TEMP+1
231: CLR TEMP
232: JMP PUTVAL
233:
234: ; ----
235: ; GETP
236: ; ----
237:
238: ; Return prop "arg2" of object "arg1"; if specified prop
239: ; doesn't exist, return prop'th element of default object [VALUE]
240:
241: ZGETP: JSR PROPB ; GET POINTER TO PROPS
242: GETP1: JSR PROPN
243: CMPA ARG2+1
244: BEQ GETP2
245: BLO GETP3
246:
247: JSR PROPNX
248: BRA GETP1 ; TRY AGAIN WITH NEXT PROP
249:
250: GETP3: LDD ZCODE+ZOBJEC ; Z-ADDR OF OBJECT TABLE
251: ADDD #ZCODE ; FORM THE ABSOLUTE ADDRESS
252: TFR D,X ; USE AS AN INDEX
253: LDB ARG2+1 ; GET PROPERTY #
254: DECB
255: ASLB
256: ABX ; ADD TO TABLE ADDRESS
257: LDD ,X ; FETCH THE PROPERTY
258: BRA ETPEX ; AND PASS IT ON
259:
260: GETP2: JSR PROPL
261: INCB ; SOMETHING SHOULD BE IN B!
262: TSTA ; AND IN A!
263: BEQ GETP2A
264: CMPA #1
265: BEQ GETP2B
266:
267: ; *** ERROR #7: PROPERTY LENGTH ***
268:
269: LDA #7
270: JSR ZERROR
271:
272: GETP2B: LDX TEMP
273: ABX
274: LDD ,X
275: BRA ETPEX
276:
277: GETP2A: LDX TEMP
278: ABX
279: LDB ,X
280: CLRA
281: ETPEX: STD TEMP
282: JMP PUTVAL
283:
284: ; -----
285: ; GETPT
286: ; -----
287:
288: ; Return a POINTER to prop table "arg2" in object "arg1" [VALUE]
289:
290: ZGETPT: JSR PROPB
291: GETPT1: JSR PROPN
292: CMPA ARG2+1
293: BEQ GETPT2
294: LBLO RET0
295: JSR PROPNX ; TRY NEXT ENTRY
296: BRA GETPT1
297:
298: GETPT2: INC TEMP+1
299: BNE GPT
300: INC TEMP
301: GPT: CLRA ; ADD OFFSET IN [B]
302: ADDD TEMP
303: SUBD #ZCODE ; CHANGE TO RELATIVE POINTER
304: STD TEMP
305: JMP PUTVAL
306:
307: ; -----
308: ; NEXTP
309: ; -----
310:
311: ; Return prop index number of the prop following prop "arg2"
312: ; in object "arg1"; return zero if last property; return
313: ; 1st prop # if arg2=0; error if no prop "arg2" in "arg1" [VALUE]
314:
315: ZNEXTP: JSR PROPB
316: LDA ARG2+1
317: BEQ NXTP2
318:
319: NXTP1: JSR PROPN
320: CMPA ARG2+1
321: BEQ NXTP3
322: LBCS RET0
323: JSR PROPNX ; TRY NEXT ENTRY
324: BRA NXTP1
325:
326: NXTP3: JSR PROPNX
327:
328: NXTP2: JSR PROPN
329: JMP PUTBYT
330:
331: ; ---
332: ; ADD
333: ; ---
334:
335: ; Return (arg1+arg2) [VALUE]
336:
337: ZADD: LDD ARG1
338: ADDD ARG2
339: MATH: STD TEMP
340: JMP PUTVAL
341:
342: ; ---
343: ; SUB
344: ; ---
345:
346: ; Return (arg1-arg2) [VALUE]
347:
348: ZSUB: LDD ARG1
349: SUBD ARG2
350: BRA MATH
351:
352: ; ---
353: ; MUL
354: ; ---
355:
356: ; Return (arg1*arg2) [VALUE]
357:
358: ZMUL: LDX #17 ; INIT LOOP INDEX
359: CLRA ; CLEAR THE
360: CLRB ; CARRY
361: STD MTEMP ; AND TEMP REGISTER
362:
363: ZMLOOP: ROR MTEMP
364: ROR MTEMP+1
365: ROR ARG2 ; SHIFT A BIT
366: ROR ARG2+1 ; INTO POSITION
367: BCC ZMNEXT ; NO ADDITION IF BIT CLEAR
368:
369: LDD ARG1
370: ADDD MTEMP
371: STD MTEMP
372:
373: ZMNEXT: LEAX -1,X ; ALL BITS EXAMINED?
374: BNE ZMLOOP ; NO, KEEP SHIFTING
375:
376: LDD ARG2 ; ELSE GRAB PRODUCT
377: BRA MATH ; AND RETURN
378:
379: ; ---------
380: ; DIV & MOD
381: ; ---------
382:
383: ; DIV: Return quotient of int(arg1/arg2) [VALUE]
384: ; MOD: Return remainder of int(arg1/arg2) [VALUE]
385:
386: ZDIV: BSR DVINIT
387: JMP PUTVAL ; AND SHIP OUT [TEMP]
388:
389: ZMOD: BSR DVINIT
390: LDD VAL ; RETURN THE
391: BRA MATH ; REMAINDER IN [VAL]
392:
393: ; -----------
394: ; DIVIDE INIT
395: ; -----------
396:
397: DVINIT: LDD ARG1
398: STD TEMP
399: LDD ARG2
400: STD VAL
401:
402: ; FALL THROUGH ...
403:
404: ; ---------------
405: ; SIGNED DIVISION
406: ; ---------------
407:
408: ; ENTRY: DIVIDEND IN [TEMP], DIVISOR IN [VAL]
409: ; EXIT: QUOTIENT IN [TEMP], REMAINDER IN [VAL]
410:
411: DIVIDE: LDA TEMP ; SIGN OF REMAINDER
412: STA SREM ; IS ALWAYS SIGN OF DIVIDEND
413: EORA VAL ; SIGN OF QUOTIENT IS POSITIVE
414: STA SQUOT ; IF SIGNS OF TERMS ARE THE SAME
415:
416: TST TEMP ; IF DIVIDEND IS NEGATIVE,
417: BPL TABS ; CALC ABSOLUTE VALUE
418: BSR ABTEMP
419:
420: TABS: TST VAL ; IF DIVISOR IS NEGATIVE,
421: BPL DOUDIV ; DO THE SAME
422: BSR ABSVAL
423:
424: DOUDIV: BSR UDIV ; UNSIGNED DIVIDE
425:
426: TST SQUOT
427: BPL RFLIP
428: BSR ABTEMP
429:
430: RFLIP: TST SREM
431: BPL DIVEX
432:
433: ; FALL THROUGH ...
434:
435: ; -------------
436: ; CALC ABS(VAL)
437: ; -------------
438:
439: ABSVAL: CLRA
440: CLRB
441: SUBD VAL
442: STD VAL
443:
444: DIVEX: RTS
445:
446: ; --------------
447: ; CALC ABS(TEMP)
448: ; --------------
449:
450: ABTEMP: CLRA
451: CLRB
452: SUBD TEMP
453: STD TEMP
454: RTS
455:
456: ; -----------------
457: ; UNSIGNED DIVISION
458: ; -----------------
459:
460: ; ENTRY: DIVIDEND IN [TEMP], DIVISOR IN [VAL]
461: ; EXIT: QUOTIENT IN [TEMP], REMAINDER IN [VAL]
462:
463: UDIV: LDD VAL
464: BEQ DIVERR ; CAN'T DIVIDE BY ZERO!
465:
466: LDX #16 ; INIT LOOP INDEX
467: CLRA ; CLEAR THE
468: CLRB ; CARRY
469: STD MTEMP ; AND HI-DIVIDEND REGISTER
470:
471: UDLOOP: ROL TEMP+1
472: ROL TEMP
473: ROL MTEMP+1
474: ROL MTEMP
475:
476: LDD MTEMP ; IS DIVIDEND < DIVISOR?
477: SUBD VAL
478: BCS UDNEXT ; YES, CLEAR THE CARRY AND LOOP
479: STD MTEMP ; ELSE UPDATE DIVIDEND
480: COMA ; SET THE CARRY
481: BRA DECX ; AND LOOP
482:
483: UDNEXT: CLRA ; CLEAR CARRY
484:
485: DECX: LEAX -1,X
486: BNE UDLOOP
487:
488: ROL TEMP+1 ; SHIFT LAST CARRY INTO PLACE
489: ROL TEMP
490: LDD MTEMP ; MOVE REMAINDER INTO
491: STD VAL ; ITS RIGHTFUL PLACE
492: RTS
493:
494: ; *** ERROR #8: DIVISION ***
495:
496: DIVERR: LDA #8
497: JSR ZERROR
498:
499: END
500:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.