![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mainsubs.src CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Infocom source] / coco|
Return to mainsubs.src CVS log | Up to [Infocom source] / coco |
1.1 root 1: PAGE
2: SBTTL "--- MAIN LOOP SUPPORT ---"
3:
4: ; -----------------------
5: ; FETCH A SHORT IMMEDIATE
6: ; -----------------------
7:
8: GETSHT: JSR NEXTPC ; NEXT Z-BYTE IS
9: STA TEMP+1 ; THE LSB OF ARGUMENT
10: CLR TEMP ; MSB IS ZERO
11: RTS
12:
13: ; ----------------------
14: ; FETCH A LONG IMMEDIATE
15: ; ----------------------
16:
17: GETLNG: JSR NEXTPC ; NEXT Z-BYTE IS MSB
18: PSHS A ; SAVE ON STACK
19: JSR NEXTPC ; NOW GRAB LSB
20: STA TEMP+1 ; STORE IT
21: PULS A ; RETRIEVE MSB
22: STA TEMP ; AND STORE IT
23: RTS
24:
25: ; ----------------
26: ; FETCH A VARIABLE
27: ; ----------------
28:
29: ; GET WITHIN AN OPCODE
30:
31: VARGET: TSTA ; IF NON-ZERO,
32: BNE GETVR1 ; ACCESS A VARIABLE
33: JSR POPSTK ; ELSE TAKE VAR OFF STACK
34: BRA PSHSTK ; WITHOUT ALTERING STACK
35:
36: GETVAR: JSR NEXTPC ; GRAB VAR-TYPE BYTE
37: TSTA ; IF ZERO,
38: BEQ POPSTK ; VALUE IS ON STACK
39:
40: ; IS VARIABLE LOCAL OR GLOBAL?
41:
42: GETVR1: CMPA #16
43: BHS GETVRG ; IT'S GLOBAL
44:
45: ; HANDLE A LOCAL VARIABLE
46:
47: GETVRL: DECA ; FORM A ZERO-ALIGNED INDEX
48: ASLA ; WORD INDEX
49: LDX #LOCALS ; INTO LOCAL VAR TABLE
50: TFR A,B ; MOVE AND
51: GTVX: ABX ; ADD INDEXING OFFSET
52: LDD ,X ; FETCH VALUE
53: STD TEMP ; AND RETURN IT
54: RTS
55:
56: ; HANDLE A GLOBAL VARIABLE
57:
58: GETVRG: SUBA #16 ; ZERO-ALIGN
59: LDX GLOBAL ; BASE OF GLOBAL VAR TABLE
60: TFR A,B ; CONVERT TO WORD-ALIGNED INDEX
61: ABX ; BY ADDING OFFSET TWICE (CLEVER, EH?)
62: BRA GTVX ; 2ND ADD ABOVE
63:
64: ; --------------
65: ; RETURN A VALUE
66: ; --------------
67:
68: ; RETURN FROM WITHIN OPCODE
69:
70: VARPUT: TSTA ; IF NON-ZERO
71: BNE PUTVR1 ; ACCESS A VARIABLE
72: PULU D ; ELSE FLUSH TOP ITEM OFF STACK
73: CMPU #TOPSTA
74: BHI UNDER ; WATCH FOR UNDERFLOW!
75: BRA PSHSTK ; AND PUSH [TEMP] ONTO STACK
76:
77: ; RETURN A ZERO
78:
79: RET0: CLRA ; CLEAR MSB
80:
81: ; RETURN BYTE IN [A]
82:
83: PUTBYT: STA TEMP+1 ; USE [A] AS LSB
84: CLR TEMP ; ZERO MSB
85:
86: ; RETURN VALUE IN [TEMP]
87:
88: PUTVAL: LDX TEMP ; GET VALUE IN [TEMP]
89: PSHS X ; AND HOLD ON TO IT
90: JSR NEXTPC ; GET VAR-TYPE BYTE
91: PULS X ; RETRIEVE VALUE
92: STX TEMP ; PUT IT BACK IN [TEMP]
93: TSTA ; IF TYPE-BYTE IS ZERO,
94: BEQ PSHSTK ; VALUE GOES TO THE STACK
95:
96: ; LOCAL OR GLOBAL?
97:
98: PUTVR1: CMPA #16
99: BHS PUTVLG ; IT'S GLOBAL
100:
101: ; HANDLE A LOCAL VARIABLE
102:
103: PUTVLL: DECA
104: ASLA
105: TFR A,B
106: LDX #LOCALS ; INTO LOCAL VARIABLE TABLE
107: PTVX: ABX
108: LDD TEMP
109: STD ,X
110: RTS
111:
112: ; HANDLE A GLOBAL VARIABLE
113:
114: PUTVLG: SUBA #16 ; ZERO-ALIGN
115: LDX GLOBAL ; BASE OF GLOBAL VAR TABLE
116: TFR A,B ; FORM WORD-ALIGNED INDEX
117: ABX ; BY ADDING OFFSET TO BASE
118: BRA PTVX ; TWICE
119:
120: ; --------------------
121: ; PUSH [TEMP] TO STACK
122: ; --------------------
123:
124: PSHSTK: LDD TEMP
125:
126: ; PUSH [D] TO STACK
127:
128: PSHDZ: PSHU D
129: CMPU #ZSTACK
130: BLO OVER
131: RTS
132:
133: ; -------------------------
134: ; POP STACK, SAVE IN [TEMP]
135: ; -------------------------
136:
137: POPSTK: PULU D ; PULL A WORD
138: STD TEMP ; SAVE IT IN [TEMP]
139: CMPU #TOPSTA
140: BHI UNDER
141: RTS
142:
143: ; *** ERROR #5 -- Z-STACK UNDERFLOW ***
144:
145: UNDER: LDA #5
146: JMP ZERROR
147:
148: ; *** ERROR #6 -- Z-STACK OVERFLOW ***
149:
150: OVER: LDA #6
151: JMP ZERROR
152:
153: ; ---------------
154: ; PREDICATE FAILS
155: ; ---------------
156:
157: PREDF: JSR NEXTPC ; GET 1ST BRANCH BYTE
158: TSTA ; IF BIT 7 ISN'T SET,
159: BPL PREDB ; DO THE BRANCH
160:
161: PREDNB: ANDA #%01000000 ; ELSE TEST BIT 6
162: BNE PNBX ; ALL DONE IF SET
163: JSR NEXTPC ; ELSE SKIP OVER 2ND BRANCH BYTE
164: PNBX: RTS ; BEFORE LEAVING
165:
166: ; ------------------
167: ; PREDICATE SUCCEEDS
168: ; ------------------
169:
170: PREDS: JSR NEXTPC
171: TSTA ; IF BIT 7 IS SET,
172: BPL PREDNB ; BRANCH ON PREDICATE FAILURE
173:
174: ; ----------------
175: ; PERFORM A BRANCH
176: ; ----------------
177:
178: PREDB: BITA #%01000000 ; LONG OR SHORT BRANCH?
179: BEQ PREDLB ; LONG IF BIT 6 IS OFF
180: ANDA #%00111111 ; ELSE FORM SHORT OFFSET
181: STA TEMP+1 ; USE AS LSB OF BRANCH OFFSET
182: CLR TEMP ; ZERO MSB OF OFFSET
183: BRA PREDB1 ; AND DO THE BRANCH
184:
185: ; HANDLE A LONG BRANCH
186:
187: PREDLB: ANDA #%00111111 ; FORM MSB OF OFFSET
188: BITA #%00100000 ; CHECK SIGN OF 14-BIT VALUE
189: BEQ DOB2 ; IT'S POSITIVE
190: ORA #%11100000 ; ELSE EXTEND SIGN BITS
191: DOB2: PSHS A ; SAVE MSB OF BRANCH
192: JSR NEXTPC ; GRAB NEXT Z-BYTE
193: STA TEMP+1 ; USE AS LSB OF BRANCH
194: PULS A
195: STA TEMP ; RETRIEVE MSB
196:
197: ; BRANCH TO Z-ADDRESS IN [TEMP]
198:
199: PREDB1: LDD TEMP ; IF OFFSET IS ZERO,
200: LBEQ ZRFALS ; DO AN "RFALSE"
201: SUBD #1 ; IF OFFSET IS ONE,
202: LBEQ ZRTRUE ; DO AN "RTRUE"
203:
204: PREDB3: SUBD #1 ; D = OFFSET-2
205: STD TEMP ; SAVE NEW OFFSET
206:
207: ; USE [VAL] TO HOLD TOP 9 BITS OF OFFSET
208:
209: STA VAL+1
210: CLRB
211: ASLA ; EXTEND THE SIGN BIT
212: ROLB ; SHIFT CARRY TO BIT 0 OF [B]
213: STB VAL ; SAVE AS UPPER BYTE OF OFFSET
214:
215: LDA TEMP+1 ; GET LOW BYTE OF OFFSET
216: ANDCC #%11111110 ; CLEAR CARRY
217: ADCA ZPCL ; ADD LOW BYTE OF CURRENT ZPC
218: BCC PDB0 ; IF OVERFLOWED,
219:
220: INC VAL+1 ; UPDATE
221: BNE PDB0 ; UPPER
222: INC VAL ; 9 BITS
223:
224: PDB0: STA ZPCL ; LOW-BYTES CALCED
225:
226: LDD VAL ; IF 9 UPPER BITS ARE ZERO,
227: BEQ PDB1 ; NO NEED TO CHANGE PAGES
228:
229: LDA VAL+1 ; ELSE ADD MIDDLE BYTES
230: ANDCC #%11111110 ; CLEAR CARRY
231: ADCA ZPCM
232: STA ZPCM
233: LDA VAL ; NOW ADD THE TOP BITS
234: ADCA ZPCH ; USING PREVIOUS CARRY
235: ANDA #%00000001 ; ISOLATE BIT 0
236: STA ZPCH
237: CLR ZPCFLG ; CHANGED PAGES
238: PDB1: RTS
239:
240: END
241:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.