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