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