![[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 1.1.1.2 ! root 2: ;SBTTL "--- 2-OPS ---" 1.1 root 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: 1.1.1.2 ! root 499: ;END 1.1 root 500:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.