|
|
1.1 root 1: PAGE 1.1.1.2 ! root 2: ;SBTTL "--- 1-OPS ---" 1.1 root 3: 4: ; ----- 5: ; ZERO? 6: ; ----- 7: 8: ; Is arg1 equal to zero? [PRED] 9: 10: ZZERO: LDD ARG1 11: LBEQ PREDS 12: JMP PREDF 13: 14: ; ----- 15: ; NEXT? 16: ; ----- 17: 18: ; Return the NEXT pointer in object "arg1"; fail if 19: ; none left, and return zero [VALUE][PRED] 20: 21: ZNEXT: LDA ARG1+1 22: JSR OBJLOC 23: LDB #5 ; SAME AS FIRST? 24: BRA FIRST1 25: 26: ; ------ 27: ; FIRST? 28: ; ------ 29: 30: ; Return the FIRST pointer in object "arg1"; fail if 31: ; none, and return zero [VALUE][PRED] 32: 33: ZFIRST: LDA ARG1+1 34: JSR OBJLOC 35: LDB #6 36: 37: FIRST1: LDX TEMP 38: LDA B,X ; FETCH SLOT 39: STA TEMP+1 ; SAVE HERE 40: PSHS A ; AND ON STACK 41: CLR TEMP ; ZERO MSB 42: JSR PUTVAL 43: PULS A 44: TSTA 45: LBEQ PREDF ; FAILURE 46: JMP PREDS ; OR SUCCESS 47: 48: ; --- 49: ; LOC 50: ; --- 51: 52: ; Return the object containing object "arg1"; zero if none [VALUE] 53: 54: ZLOC: LDA ARG1+1 55: JSR OBJLOC 56: LDX TEMP 57: LDA 4,X 58: STA TEMP+1 59: CLR TEMP 60: JMP PUTVAL 61: 62: ; ------ 63: ; PTSIZE 64: ; ------ 65: 66: ; Return length of prop table "arg1" in bytes [VALUE] 67: 68: ZPTSIZ: LDD ARG1 69: ADDD #ZCODE 70: SUBD #1 71: STD TEMP 72: CLRB 73: JSR PROPL 74: INCA 75: JMP PUTBYT 76: 77: ; --- 78: ; INC 79: ; --- 80: 81: ; Increment arg1 [VALUE] 82: 83: ZINC: LDA ARG1+1 84: JSR VARGET 85: LDD TEMP 86: ADDD #1 87: ZINC1: STD TEMP 88: PSHS D 89: LDA ARG1+1 90: JSR VARPUT 91: PULS D 92: STD TEMP 93: RTS 94: 95: ; --- 96: ; DEC 97: ; --- 98: 99: ; Decrement arg1 [VALUE] 100: 101: ZDEC: LDA ARG1+1 102: JSR VARGET 103: LDD TEMP 104: SUBD #1 105: BRA ZINC1 106: 107: ; ------ 108: ; PRINTB 109: ; ------ 110: 111: ; PRINT the string pointed to by BYTE-pointer "arg1" 112: 113: ZPRB: LDD ARG1 114: STD TEMP 115: JSR SETWRD 116: JMP PZSTR 117: 118: ; ------ 119: ; REMOVE 120: ; ------ 121: 122: ; Move object "arg1" to pseudo-object #0 123: 124: ZREMOV: LDA ARG1+1 125: JSR OBJLOC 126: LDX TEMP 127: LDA 4,X 128: BEQ REMVEX ; NO OBJECT 129: 130: PSHS X ; SAVE [TEMP] 131: 132: JSR OBJLOC 133: LDX TEMP 134: LDA 6,X 135: CMPA ARG1+1 136: BNE REMVC1 137: 138: PULS X ; RETRIEVE FORMER [TEMP] 139: PSHS X ; SAVE COPY ON STACK 140: 141: LDA 5,X ; OLD [TEMP] IS IN [X] 142: LDX TEMP 143: STA 6,X 144: 145: BRA REMVC2 146: 147: REMVC1: JSR OBJLOC 148: LDX TEMP 149: LDA 5,X 150: CMPA ARG1+1 151: BNE REMVC1 152: 153: PULS X 154: PSHS X 155: 156: LDA 5,X 157: LDX TEMP 158: STA 5,X 159: 160: REMVC2: PULS X 161: CLR 4,X 162: CLR 5,X 163: 164: REMVEX: RTS 165: 166: ; ------ 167: ; PRINTD 168: ; ------ 169: 170: ; Print short description of object "arg1" 171: 172: ZPRD: LDA ARG1+1 173: 174: PRNTDC: JSR OBJLOC 175: LDX TEMP 176: LDD 7,X 177: ADDD #1 ; INCREMENT 178: STD TEMP ; AND SAVE 179: JSR SETWRD 180: JMP PZSTR 181: 182: ; ------ 183: ; RETURN 184: ; ------ 185: 186: ; Return from a CALL with value "arg1" 187: 188: ZRET: LDU OZSTAK ; STAY IN SYNC! 189: JSR POPSTK ; POP # LOCALS 190: STB VAL ; SAVE COUNT HERE 191: 192: COMA ; COMPLEMENT [A] 193: CMPA VAL ; SHOULD BE OPPOSITE OF [B] 194: BNE RETERR ; IF NOT, STACK IS BAD (BM 11/24/84) 195: 196: TSTB ; CHECK # LOCALS 197: BEQ RET2 ; SKIP IF NO LOCALS 198: 199: ; RESTORE LOCAL VARIABLES 200: 201: LDX #LOCALS ; SET UP A POINTER 202: ASLB ; WORD-ALIGN THE INDEX 203: ABX ; [X] POINTS TO LAST LOCAL VAR 204: 205: RET1: JSR POPSTK ; POP A VALUE ([X] UNAFFECTED) 206: STD ,--X ; SAVE IN [LOCALS], UPDATE INDEX 207: DEC VAL 208: BNE RET1 ; LOOP TILL ALL LOCALS POPPED 209: 210: ; RESTORE OTHER VARIABLES 211: 212: RET2: JSR POPSTK 213: STD ZPCH ; RESTORE TOP 9 BITS OF ZPC 214: JSR POPSTK 215: STB ZPCL ; RESTORE LOWER 8 BITS OF ZPC 216: JSR POPSTK 217: STD OZSTAK ; AND OLD ZSP 218: CLR ZPCFLG ; PC NO LONGER VALID 219: 220: LDD ARG1 221: STD TEMP ; PASS THE RETURN VALUE 222: JMP PUTVAL ; TO PUTVAL 223: 224: ; *** ERROR #15: Z-STACK DESTROYED *** 225: 226: RETERR: LDA #15 227: JMP ZERROR 228: 229: ; ---- 230: ; JUMP 231: ; ---- 232: 233: ; Branch to location pointed to by 16-bit 2's-comp "arg1" 234: 235: ZJUMP: LDD ARG1 ; TREAT LIKE A BRANCH 236: SUBD #1 ; THAT ALWAYS SUCCEEDS 237: STD TEMP 238: JMP PREDB3 239: 240: ; ----- 241: ; PRINT 242: ; ----- 243: 244: ; Print the z-string pointed to by WORD-pointer "arg1" 245: 246: ZPRINT: LDD ARG1 247: STD TEMP ; TELL SETSTR 248: JSR SETSTR ; WHERE THE STRING RESIDES 249: JMP PZSTR ; AND PRINT IT 250: 251: ; ----- 252: ; VALUE 253: ; ----- 254: 255: ; Return value of arg1 [VALUE] 256: 257: ZVALUE: LDA ARG1+1 ; GRAB VARIABLE ID 258: JSR VARGET ; FETCH ITS VALUE 259: JMP PUTVAL ; AND RETURN IT 260: 261: ; ---- 262: ; BCOM 263: ; ---- 264: 265: ; Complement arg1 [VALUE] 266: 267: ZBCOM: LDD ARG1 ; GRAB ARGUMENT 268: COMA ; COMPLEMENT MSB 269: COMB ; AND LSB 270: STD TEMP ; AND PASS TO PUTVAL 271: JMP PUTVAL 272: 1.1.1.2 ! root 273: ;END 1.1 root 274:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.