![[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.