Commit | Line | Data |
---|---|---|
d7a6c2d6 | 1 | REM Memory layout: |
7895453b | 2 | REM |
d7a6c2d6 JM |
3 | REM type bytes |
4 | REM ---------- ---------- | |
5 | REM nil ref/ 0 | 0 | | | |
6 | REM false ref/ 1 | 0 | | | |
7 | REM true ref/ 1 | 1 | | | |
8 | REM integer ref/ 2 | int | | | |
9 | REM float ref/ 3 | ??? | | | |
10 | REM string/kw ref/ 4 | S$ idx | | | |
11 | REM symbol ref/ 5 | S$ idx | | | |
12 | REM list ref/ 6 | next Z% idx | val Z% idx | | |
13 | REM vector ref/ 7 | next Z% idx | val Z% idx | | |
14 | REM hashmap ref/ 8 | next Z% idx | key Z% idx | val Z% idx | |
15 | REM function ref/ 9 | fn idx | | | |
16 | REM mal function ref/10 | body Z% idx | param Z% idx | env Z% idx | |
17 | REM macro fn ref/11 | body Z% idx | param Z% idx | env Z% idx | |
18 | REM atom ref/12 | val Z% idx | | | |
19 | REM environment ref/13 | hmap Z% idx | outer Z% idx | | |
20 | REM metadata ref/14 | obj Z% idx | meta Z% idx | | |
21 | REM FREE sz/15 | next Z% idx | | | |
22 | REM | |
7895453b | 23 | REM Locations 0-15 are for constant/persistent values: |
d7a6c2d6 JM |
24 | REM 0: nil |
25 | REM 2: false | |
26 | REM 4: true | |
27 | REM 6: empty list | |
28 | REM 9: empty vector | |
29 | REM 12: empty hash-map | |
30 | ||
4a445e84 JM |
31 | REM Note: DIM_MEMORY for C64 BASIC and the INIT_MEMORY function are at |
32 | REM end of this file for efficiency on C64. The most commonly used | |
33 | REM function should be at the top since C64 BASIC scans line numbers | |
34 | REM for every GOTO/GOSUB. On the other hand, QBasic requires that | |
35 | REM arrays are dimensioned at the top of the file, not just as the | |
36 | REM first operation on that array so DIM_MEMORY for QBasic is here at | |
37 | REM the top. | |
38 | ||
39 | #qbasic DIM_MEMORY: | |
40 | #qbasic T=0 | |
41 | #qbasic | |
42 | #qbasic Z1=8191+1424: REM Z% (boxed memory) size (2 bytes each) | |
43 | #qbasic Z2=199: REM S$/S% (string memory) size (3+2 bytes each) | |
44 | #qbasic Z3=200: REM X% (call stack) size (2 bytes each) | |
45 | #qbasic Z4=64: REM Y% (release stack) size (4 bytes each) | |
46 | #qbasic | |
47 | #qbasic REM boxed element memory | |
48 | #qbasic DIM Z%(Z1): REM TYPE ARRAY | |
49 | #qbasic | |
50 | #qbasic REM string memory storage | |
51 | #qbasic S=0:DIM S$(Z2):DIM S%(Z2) | |
52 | #qbasic | |
53 | #qbasic REM call/logic stack | |
54 | #qbasic X=-1:DIM X%(Z3): REM stack of Z% indexes | |
55 | #qbasic | |
56 | #qbasic REM pending release stack | |
57 | #qbasic Y=-1:DIM Y%(Z4,1): REM stack of Z% indexes and level/LV values | |
58 | #qbasic | |
59 | #qbasic RETURN | |
d7a6c2d6 JM |
60 | |
61 | REM stack functions | |
62 | ||
63 | #qbasic PUSH_A: | |
64 | #qbasic X=X+1:X%(X)=A:RETURN | |
65 | #qbasic POP_A: | |
66 | #qbasic A=X%(X):X=X-1:RETURN | |
7895453b | 67 | #qbasic |
d7a6c2d6 JM |
68 | #qbasic PUSH_R: |
69 | #qbasic X=X+1:X%(X)=R:RETURN | |
70 | #qbasic POP_R: | |
71 | #qbasic R=X%(X):X=X-1:RETURN | |
7895453b | 72 | #qbasic |
d7a6c2d6 JM |
73 | #qbasic PUSH_Q: |
74 | #qbasic X=X+1:X%(X)=Q:RETURN | |
75 | #qbasic POP_Q: | |
76 | #qbasic Q=X%(X):X=X-1:RETURN | |
77 | #qbasic PEEK_Q: | |
78 | #qbasic Q=X%(X):RETURN | |
79 | #qbasic PEEK_Q_1: | |
80 | #qbasic Q=X%(X-1):RETURN | |
81 | #qbasic PEEK_Q_2: | |
82 | #qbasic Q=X%(X-2):RETURN | |
83 | #qbasic PEEK_Q_Q: | |
84 | #qbasic Q=X%(X-Q):RETURN | |
85 | #qbasic PUT_Q: | |
86 | #qbasic X%(X)=Q:RETURN | |
87 | #qbasic PUT_Q_1: | |
88 | #qbasic X%(X-1)=Q:RETURN | |
89 | #qbasic PUT_Q_2: | |
90 | #qbasic X%(X-2)=Q:RETURN | |
91 | ||
92 | #cbm PUSH_A: | |
93 | #cbm X=X+2:POKE X,A AND255:POKE X+1,A/256:RETURN | |
94 | #cbm POP_A: | |
95 | #cbm A=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN | |
7895453b | 96 | #cbm |
d7a6c2d6 JM |
97 | #cbm PUSH_R: |
98 | #cbm X=X+2:POKE X,R AND255:POKE X+1,R/256:RETURN | |
99 | #cbm POP_R: | |
100 | #cbm R=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN | |
7895453b | 101 | #cbm |
d7a6c2d6 JM |
102 | #cbm PUSH_Q: |
103 | #cbm X=X+2:POKE X,Q AND255:POKE X+1,Q/256:RETURN | |
104 | #cbm POP_Q: | |
105 | #cbm Q=PEEK(X)+PEEK(X+1)*256:X=X-2:RETURN | |
106 | #cbm PEEK_Q: | |
107 | #cbm Q=PEEK(X)+PEEK(X+1)*256:RETURN | |
108 | #cbm PEEK_Q_1: | |
109 | #cbm Q=PEEK(X-2)+PEEK(X-1)*256:RETURN | |
110 | #cbm PEEK_Q_2: | |
111 | #cbm Q=PEEK(X-4)+PEEK(X-3)*256:RETURN | |
112 | #cbm PEEK_Q_Q: | |
113 | #cbm Q=PEEK(X-Q*2)+PEEK(X-Q*2+1)*256:RETURN | |
114 | #cbm PUT_Q: | |
115 | #cbm POKE X,Q AND255:POKE X+1,Q/256:RETURN | |
116 | #cbm PUT_Q_1: | |
117 | #cbm POKE X-2,Q AND255:POKE X-1,Q/256:RETURN | |
118 | #cbm PUT_Q_2: | |
119 | #cbm POKE X-4,Q AND255:POKE X-3,Q/256:RETURN | |
120 | ||
121 | REM memory functions | |
122 | ||
123 | REM ALLOC(T,L) -> R | |
124 | REM ALLOC(T,L,M) -> R | |
125 | REM ALLOC(T,L,M,N) -> R | |
126 | REM L is value for Z%(R+1) | |
127 | REM M is value for Z%(R+2), if SZ>2 | |
128 | REM N is value for Z%(R+3), if SZ>3 | |
129 | ALLOC: | |
130 | SZ=3 | |
131 | IF T<6 OR T=9 OR T=12 THEN SZ=2 | |
132 | IF T=8 OR T=10 OR T=11 THEN SZ=4 | |
133 | REM PRINT "ALLOC T: "+STR$(T)+", SZ: "+STR$(SZ)+", ZK: "+STR$(ZK) | |
134 | U=ZK | |
135 | R=ZK | |
136 | ALLOC_LOOP: | |
137 | IF R=ZI THEN GOTO ALLOC_UNUSED | |
138 | REM TODO sanity check that type is 15 | |
139 | IF ((Z%(R)AND-32)/32)=SZ THEN GOTO ALLOC_MIDDLE | |
140 | REM PRINT "ALLOC search: U: "+STR$(U)+", R: "+STR$(R) | |
141 | U=R: REM previous set to current | |
142 | R=Z%(R+1): REM current set to next | |
143 | GOTO ALLOC_LOOP | |
144 | ALLOC_MIDDLE: | |
145 | REM PRINT "ALLOC_MIDDLE: U: "+STR$(U)+", R: "+STR$(R) | |
146 | REM set free pointer (ZK) to next free | |
147 | IF R=ZK THEN ZK=Z%(R+1) | |
148 | REM set previous free to next free | |
149 | IF R<>ZK THEN Z%(U+1)=Z%(R+1) | |
150 | GOTO ALLOC_DONE | |
151 | ALLOC_UNUSED: | |
152 | REM PRINT "ALLOC_UNUSED ZI: "+STR$(ZI)+", U: "+STR$(U)+", R: "+STR$(R) | |
7895453b | 153 | IF R+SZ>Z1 THEN GOSUB PR_MEMORY_SUMMARY_SMALL:PRINT "Out of mal memory!":END |
d7a6c2d6 JM |
154 | ZI=ZI+SZ |
155 | IF U=R THEN ZK=ZI | |
156 | REM set previous free to new memory top | |
157 | IF U<>R THEN Z%(U+1)=ZI | |
158 | GOTO ALLOC_DONE | |
159 | ALLOC_DONE: | |
160 | Z%(R)=T+32 | |
161 | REM set Z%(R+1) to default L | |
162 | Z%(R+1)=L | |
163 | IF T>5 AND T<>9 THEN Z%(L)=Z%(L)+32: REM value is a Z% idx | |
164 | IF SZ>2 THEN Z%(M)=Z%(M)+32:Z%(R+2)=M | |
165 | IF SZ>3 THEN Z%(N)=Z%(N)+32:Z%(R+3)=N | |
166 | ||
167 | RETURN | |
168 | ||
169 | REM FREE(AY, SZ) -> nil | |
170 | FREE: | |
171 | REM assumes reference count cleanup already (see RELEASE) | |
172 | Z%(AY)=(SZ*32)+15: REM set type(15) and size | |
173 | Z%(AY+1)=ZK | |
174 | ZK=AY | |
175 | IF SZ>=3 THEN Z%(AY+2)=0 | |
176 | IF SZ=4 THEN Z%(AY+3)=0 | |
177 | REM TODO: fail if SZ>4 | |
178 | RETURN | |
179 | ||
180 | ||
181 | REM RELEASE(AY) -> nil | |
182 | REM R should not be affected by this call | |
183 | RELEASE: | |
184 | RC=0 | |
185 | ||
186 | GOTO RELEASE_ONE | |
187 | ||
188 | RELEASE_TOP: | |
189 | ||
190 | IF RC=0 THEN RETURN | |
191 | ||
192 | REM pop next object to release, decrease remaining count | |
193 | GOSUB POP_Q:AY=Q | |
194 | RC=RC-1 | |
195 | ||
196 | RELEASE_ONE: | |
197 | IF AY=-1 THEN RETURN | |
198 | ||
199 | U=Z%(AY)AND 31: REM type | |
200 | V=Z%(AY+1): REM main value/reference | |
201 | ||
202 | REM set the size | |
203 | REM TODO: share with ALLOC calculation | |
204 | SZ=3 | |
205 | IF U<6 OR U=9 OR U=12 THEN SZ=2 | |
206 | IF U=8 OR U=10 OR U=11 THEN SZ=4 | |
207 | ||
208 | REM AZ=AY: B=1: GOSUB PR_STR | |
209 | REM PRINT "RELEASE AY:"+STR$(AY)+" ["+R$+"] (byte0:"+STR$(Z%(AY))+", SZ:"+STR$(SZ)+")" | |
210 | ||
211 | REM sanity check not already freed | |
7895453b JM |
212 | REM MEMORY DEBUGGING: |
213 | REM IF U=15 THEN PRINT "RELEASE of free:"+STR$(AY):END | |
214 | REM IF Z%(AY)<15 THEN PRINT "RELEASE of unowned:"+STR$(AY):END | |
d7a6c2d6 JM |
215 | |
216 | REM decrease reference count by one | |
217 | Z%(AY)=Z%(AY)-32 | |
218 | ||
219 | REM nil, false, true, empty sequences | |
7895453b JM |
220 | REM MEMORY DEBUGGING: |
221 | REM IF AY<16 AND Z%(AY)<32 THEN PRINT "RELEASE of empty:"+STR$(AY):END | |
d7a6c2d6 JM |
222 | IF AY<16 THEN GOTO RELEASE_TOP |
223 | ||
224 | REM our reference count is not 0, so don't release | |
225 | IF Z%(AY)>=32 GOTO RELEASE_TOP | |
226 | ||
227 | REM switch on type | |
228 | ON U+1 GOSUB RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_STRING,RELEASE_STRING,RELEASE_SEQ,RELEASE_SEQ,RELEASE_HASH_MAP,RELEASE_SIMPLE,RELEASE_MAL_FUNCTION,RELEASE_MAL_FUNCTION,RELEASE_ATOM,RELEASE_ENV,RELEASE_METADATA | |
229 | ||
230 | REM free the current element and continue, SZ already set | |
231 | GOSUB FREE | |
232 | GOTO RELEASE_TOP | |
233 | ||
234 | RELEASE_SIMPLE: | |
235 | RETURN | |
236 | RELEASE_STRING: | |
237 | REM string type, release interned string, then FREE reference | |
7895453b JM |
238 | REM MEMORY DEBUGGING: |
239 | REM IF S%(V)=0 THEN PRINT "RELEASE of free string:"+STR$(S%(V)):END | |
d7a6c2d6 JM |
240 | S%(V)=S%(V)-1 |
241 | IF S%(V)=0 THEN S$(V)="": REM free BASIC string | |
242 | REM free the atom itself | |
243 | RETURN | |
244 | RELEASE_SEQ: | |
245 | IF V=0 THEN RETURN | |
246 | REM add value and next element to stack | |
247 | RC=RC+2 | |
248 | Q=Z%(AY+2):GOSUB PUSH_Q | |
249 | Q=V:GOSUB PUSH_Q | |
250 | RETURN | |
251 | RELEASE_HASH_MAP: | |
252 | IF V=0 THEN RETURN | |
253 | REM add key, value and next element to stack | |
254 | RC=RC+3 | |
255 | Q=Z%(AY+2):GOSUB PUSH_Q | |
256 | Q=Z%(AY+3):GOSUB PUSH_Q | |
257 | Q=V:GOSUB PUSH_Q | |
258 | RETURN | |
259 | RELEASE_ATOM: | |
260 | REM add contained/referred value | |
261 | RC=RC+1 | |
262 | Q=V:GOSUB PUSH_Q | |
263 | REM free the atom itself | |
264 | RETURN | |
265 | RELEASE_MAL_FUNCTION: | |
266 | REM add ast, params and environment to stack | |
267 | RC=RC+3 | |
268 | Q=V:GOSUB PUSH_Q | |
269 | Q=Z%(AY+2):GOSUB PUSH_Q | |
270 | Q=Z%(AY+3):GOSUB PUSH_Q | |
271 | REM free the current 3 element mal_function | |
272 | RETURN | |
273 | RELEASE_ENV: | |
274 | REM add the hashmap data to the stack | |
275 | RC=RC+1 | |
276 | Q=V:GOSUB PUSH_Q | |
277 | REM if outer set, add outer env to stack | |
278 | IF Z%(AY+2)<>0 THEN RC=RC+1:Q=Z%(AY+2):GOSUB PUSH_Q | |
279 | RETURN | |
280 | RELEASE_METADATA: | |
281 | REM add object and metadata object | |
282 | RC=RC+2 | |
283 | Q=V:GOSUB PUSH_Q | |
284 | Q=Z%(AY+2):GOSUB PUSH_Q | |
285 | RETURN | |
286 | ||
287 | ||
4202ef7b JM |
288 | REM INC_REF_R(R) -> R |
289 | REM - return R with 1 ref cnt increase | |
290 | REM - call with GOTO to return at caller callsite | |
291 | REM - call with GOSUB to return to caller | |
292 | INC_REF_R: | |
293 | Z%(R)=Z%(R)+32 | |
294 | RETURN | |
295 | ||
296 | REM RETURN_TRUE_FALSE(R) -> R | |
297 | REM - take BASIC true/false R, return mal true/false R with ref cnt | |
298 | REM - called with GOTO as a return RETURN | |
299 | RETURN_TRUE_FALSE: | |
300 | IF R THEN R=4 | |
301 | IF R=0 THEN R=2 | |
302 | GOTO INC_REF_R | |
303 | ||
304 | ||
d7a6c2d6 JM |
305 | REM release stack functions |
306 | ||
307 | #qbasic PEND_A_LV: | |
308 | #qbasic Y=Y+1:Y%(Y,0)=A:Y%(Y,1)=LV:RETURN | |
309 | #qbasic | |
310 | #qbasic REM RELEASE_PEND(LV) -> nil | |
311 | #qbasic RELEASE_PEND: | |
312 | #qbasic IF Y<0 THEN RETURN | |
313 | #qbasic IF Y%(Y,1)<=LV THEN RETURN | |
314 | #qbasic REM PRINT "RELEASE_PEND releasing:"+STR$(Y%(Y,0)) | |
315 | #qbasic AY=Y%(Y,0):GOSUB RELEASE | |
316 | #qbasic Y=Y-1 | |
317 | #qbasic GOTO RELEASE_PEND | |
318 | ||
319 | #cbm PEND_A_LV: | |
320 | #cbm Y=Y+4:POKE Y,A AND255:POKE Y+1,A/256 | |
321 | #cbm POKE Y+2,LV AND255:POKE Y+3,LV/256:RETURN | |
322 | #cbm | |
323 | #cbm REM RELEASE_PEND(LV) -> nil | |
324 | #cbm RELEASE_PEND: | |
325 | #cbm IF Y<Z4 THEN RETURN | |
326 | #cbm IF (PEEK(Y+2)+PEEK(Y+3)*256)<=LV THEN RETURN | |
327 | #cbm REM PRINT "RELEASE_PEND releasing:"+STR$(Y%(Y,0)) | |
328 | #cbm AY=(PEEK(Y)+PEEK(Y+1)*256):GOSUB RELEASE | |
329 | #cbm Y=Y-4 | |
330 | #cbm GOTO RELEASE_PEND | |
331 | ||
332 | ||
d7a6c2d6 | 333 | |
4a445e84 JM |
334 | #cbm DIM_MEMORY: |
335 | #cbm T=FRE(0) | |
336 | #cbm | |
337 | #cbm Z1=8191+1424: REM Z% (boxed memory) size (2 bytes each) | |
338 | #cbm Z2=199: REM S$/S% (string memory) size (3+2 bytes each) | |
339 | #cbm Z3=49152: REM X starting point at $C000 (2 bytes each) | |
340 | #cbm Z4=52992: REM Y starting point at $CF00 (4 bytes each) | |
341 | #cbm | |
342 | #cbm REM TODO: for performance, define all/most non-array variables here | |
343 | #cbm REM so that the array area doesn't have to be shifted down everytime | |
344 | #cbm REM a new non-array variable is defined | |
345 | #cbm | |
346 | #cbm REM boxed element memory | |
347 | #cbm DIM Z%(Z1): REM TYPE ARRAY | |
348 | #cbm | |
349 | #cbm REM string memory storage | |
350 | #cbm S=0:DIM S$(Z2):DIM S%(Z2) | |
351 | #cbm | |
352 | #cbm REM call/logic stack | |
353 | #cbm X=Z3-2: REM stack of 1920 Z% indexes at $C000 | |
354 | #cbm | |
355 | #cbm REM pending release stack | |
356 | #cbm Y=Z4-4: REM stack of 64 Y% indexes/levels at $CF00 | |
357 | #cbm | |
358 | #cbm RETURN | |
359 | ||
360 | INIT_MEMORY: | |
361 | GOSUB DIM_MEMORY | |
d7a6c2d6 JM |
362 | |
363 | REM global error state | |
364 | REM -2 : no error | |
365 | REM -1 : string error in E$ | |
366 | REM >=0 : pointer to error object | |
367 | ER=-2 | |
368 | E$="" | |
369 | ||
d7a6c2d6 JM |
370 | REM Predefine nil, false, true, and an empty sequences |
371 | FOR I=0 TO 15:Z%(I)=0:NEXT I | |
372 | Z%(0)=32: REM nil | |
373 | Z%(2)=1+32: REM false | |
374 | Z%(4)=1+32:Z%(5)=1: REM true | |
375 | Z%(6)=6+32: REM emtpy list | |
376 | Z%(9)=7+32: REM empty vector | |
377 | Z%(12)=8+32: REM empty hash-map | |
378 | ||
379 | REM start of unused memory | |
380 | ZI=16 | |
381 | ||
382 | REM start of free list | |
383 | ZK=16 | |
384 | ||
4a445e84 | 385 | REM start of time clock |
d7a6c2d6 JM |
386 | BT=TI |
387 | ||
388 | RETURN | |
389 | ||
390 |