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