basic/types.in.bas

   1 REM                  Z 0   ->  1
   2 REM nil                0   ->  (unused)
   3 REM boolean            1   ->  0: false, 1: true
   4 REM integer            2   ->  int value
   5 REM float              3   ->  ???
   6 REM string/kw          4   ->  ZS$ index
   7 REM symbol             5   ->  ZS$ index
   8 REM list next/val      6   ->  next Z% index (0 for last)
   9 REM                    followed by value (unless empty)
  10 REM vector next/val    7   ->  next Z% index (0 for last)
  11 REM                    followed by value (unless empty)
  12 REM hashmap next/val   8   ->  next Z% index (0 for last)
  13 REM                    followed by key or value (alternating)
  14 REM function           9   ->  function index
  15 REM mal function       10  ->  body AST Z% index
  16 REM                    followed by param and env Z% index
  17 REM atom               11  ->  Z% index
  18 REM environment        13  ->  data/hashmap Z% index
  19 REM                    followed by 13 and outer Z% index (-1 for none)
  20 REM reference/ptr      14  ->  Z% index / or 0
  21 REM next free ptr      15  ->  Z% index / or 0
  22
  23 INIT_MEMORY:
  24   T%=FRE(0)
  25
  26   S1%=3072: REM Z% (boxed memory) size (X2)
  27   REM S1%=4096: REM Z% (boxed memory) size (X2)
  28   S2%=256: REM ZS% (string memory) size
  29   S3%=256: REM ZZ% (call stack) size
  30   S4%=128: REM ZR% (release stack) size
  31
  32   REM global error state
  33   ER%=0
  34   ER$=""
  35
  36   REM boxed element memory
  37   DIM Z%(S1%,1): REM TYPE ARRAY
  38
  39   REM Predefine nil, false, true
  40   Z%(0,0) = 0
  41   Z%(0,1) = 0
  42   Z%(1,0) = 1
  43   Z%(1,1) = 0
  44   Z%(2,0) = 1
  45   Z%(2,1) = 1
  46
  47   REM start of unused memory
  48   ZI%=3
  49
  50   REM start of free list
  51   ZK%=3
  52
  53   REM string memory storage
  54   ZJ%=0
  55   DIM ZS$(S2%)
  56
  57   REM call/logic stack
  58   ZL%=-1
  59   DIM ZZ%(S3%): REM stack of Z% indexes
  60
  61   REM pending release stack
  62   ZM%=-1
  63   DIM ZR%(S4%): REM stack of Z% indexes
  64
  65   REM PRINT "Lisp data memory: " + STR$(T%-FRE(0))
  66   REM PRINT "Interpreter working memory: " + STR$(FRE(0))
  67   RETURN
  68
  69 REM memory functions
  70
  71 REM ALLOC(SZ%) -> R%
  72 ALLOC:
  73   REM PRINT "ALLOC SZ%: "+STR$(SZ%)+", ZK%: "+STR$(ZK%)
  74   U3%=ZK%
  75   U4%=ZK%
  76   ALLOC_LOOP:
  77     IF U4%=ZI% THEN GOTO ALLOC_UNUSED
  78     REM TODO sanity check that type is 15
  79     IF ((Z%(U4%,0)AND-16)/16)=SZ% THEN GOTO ALLOC_MIDDLE
  80     REM PRINT "ALLOC search: U3%: "+STR$(U3%)+", U4%: "+STR$(U4%)
  81     U3%=U4%: REM previous set to current
  82     U4%=Z%(U4%,1): REM current set to next
  83     GOTO ALLOC_LOOP
  84   ALLOC_MIDDLE:
  85     REM PRINT "ALLOC_MIDDLE: U3%: "+STR$(U3%)+", U4%: "+STR$(U4%)
  86     R%=U4%
  87     REM set free pointer (ZK%) to next free
  88     IF U4%=ZK% THEN ZK%=Z%(U4%,1)
  89     REM set previous free to next free
  90     IF U4%<>ZK% THEN Z%(U3%,1)=Z%(U4%,1)
  91     RETURN
  92   ALLOC_UNUSED:
  93     REM PRINT "ALLOC_UNUSED ZI%: "+STR$(ZI%)+", U3%: "+STR$(U3%)+", U4%: "+STR$(U4%)
  94     R%=U4%
  95     ZI%=ZI%+SZ%
  96     IF U3%=U4% THEN ZK%=ZI%
  97     REM set previous free to new memory top
  98     IF U3%<>U4% THEN Z%(U3%,1)=ZI%
  99     RETURN
 100
 101 REM FREE(AY%, SZ%) -> nil
 102 FREE:
 103   REM assumes reference count cleanup already (see RELEASE)
 104   Z%(AY%,0) = (SZ%*16)+15: REM set type(15) and size
 105   Z%(AY%,1) = ZK%
 106   IF SZ%>=2 THEN Z%(AY%+1,0)=0
 107   IF SZ%>=2 THEN Z%(AY%+1,1)=0
 108   IF SZ%>=3 THEN Z%(AY%+2,0)=0
 109   IF SZ%>=3 THEN Z%(AY%+2,1)=0
 110   ZK%=AY%
 111   RETURN
 112
 113
 114 REM RELEASE(AY%) -> nil
 115 REM R% should not be affected by this call
 116 RELEASE:
 117   RC%=0
 118
 119   GOTO RELEASE_ONE
 120
 121   RELEASE_TOP:
 122
 123   IF RC%=0 THEN RETURN
 124
 125   REM pop next object to release, decrease remaining count
 126   AY%=ZZ%(ZL%): ZL%=ZL%-1
 127   RC%=RC%-1
 128
 129   RELEASE_ONE:
 130
 131   REM nil, false, true
 132   IF AY%<3 THEN GOTO RELEASE_TOP
 133
 134   U6%=Z%(AY%,0)AND15: REM type
 135
 136   REM AZ%=AY%: PR%=1: GOSUB PR_STR
 137   REM PRINT "RELEASE AY%:"+STR$(AY%)+"["+R$+"] (byte0:"+STR$(Z%(AY%,0))+")"
 138
 139   REM sanity check not already freed
 140   IF (U6%)=15 THEN ER%=1: ER$="Free of free memory: " + STR$(AY%): RETURN
 141   IF Z%(AY%,0)<15 THEN ER%=1: ER$="Free of freed object: " + STR$(AY%): RETURN
 142
 143   REM decrease reference count by one
 144   Z%(AY%,0)=Z%(AY%,0)-16
 145
 146   REM our reference count is not 0, so don't release
 147   IF Z%(AY%,0)>=16 GOTO RELEASE_TOP
 148
 149   REM switch on type
 150   IF (U6%<=5) OR (U6%=9) THEN GOTO RELEASE_SIMPLE
 151   IF (U6%>=6) AND (U6%<=8) THEN GOTO RELEASE_SEQ
 152   IF U6%=10 THEN GOTO RELEASE_MAL_FUNCTION
 153   IF U6%=13 THEN GOTO RELEASE_ENV
 154   IF U6%=14 THEN GOTO RELEASE_REFERENCE
 155   IF U6%=15 THEN ER%=1: ER$="RELEASE of already freed: "+STR$(AY%): RETURN
 156   ER%=1: ER$="RELEASE not defined for type " + STR$(U6%): RETURN
 157
 158   RELEASE_SIMPLE:
 159     REM simple type (no recursing), just call FREE on it
 160     SZ%=1: GOSUB FREE
 161     GOTO RELEASE_TOP
 162   RELEASE_SIMPLE_2:
 163     REM free the current element and continue
 164     SZ%=2: GOSUB FREE
 165     GOTO RELEASE_TOP
 166   RELEASE_SEQ:
 167     IF Z%(AY%,1)=0 THEN GOTO RELEASE_SIMPLE_2
 168     IF Z%(AY%+1,0)<>14 THEN ER%=1: ER$="invalid list value"+STR$(AY%+1): RETURN
 169     REM add value and next element to stack
 170     RC%=RC%+2: ZL%=ZL%+2: ZZ%(ZL%-1)=Z%(AY%+1,1): ZZ%(ZL%)=Z%(AY%,1)
 171     GOTO RELEASE_SIMPLE_2
 172   RELEASE_MAL_FUNCTION:
 173     REM add ast, params and environment to stack
 174     RC%=RC%+3: ZL%=ZL%+3
 175     ZZ%(ZL%-2)=Z%(AY%,1): ZZ%(ZL%-1)=Z%(AY%+1,0): ZZ%(ZL%)=Z%(AY%+1,1)
 176     REM free the current 2 element mal_function and continue
 177     SZ%=2: GOSUB FREE
 178     GOTO RELEASE_TOP
 179   RELEASE_ENV:
 180     REM add the hashmap data to the stack
 181     RC%=RC%+1: ZL%=ZL%+1: ZZ%(ZL%)=Z%(AY%,1)
 182     REM if no outer set
 183     IF Z%(AY%+1,1)=-1 THEN GOTO RELEASE_ENV_FREE
 184     REM add outer environment to the stack
 185     RC%=RC%+1: ZL%=ZL%+1: ZZ%(ZL%)=Z%(AY%+1,1)
 186     RELEASE_ENV_FREE:
 187       REM free the current 2 element environment and continue
 188       SZ%=2: GOSUB FREE
 189       GOTO RELEASE_TOP
 190   RELEASE_REFERENCE:
 191     IF Z%(AY%,1)=0 THEN GOTO RELEASE_SIMPLE
 192     REM add the referred element to the stack
 193     RC%=RC%+1: ZL%=ZL%+1: ZZ%(ZL%)=Z%(AY%,1)
 194     REM free the current element and continue
 195     SZ%=1: GOSUB FREE
 196     GOTO RELEASE_TOP
 197
 198 REM RELEASE_PEND() -> nil
 199 RELEASE_PEND:
 200   REM REM IF ER%<>0 THEN RETURN
 201   IF ZM%<0 THEN RETURN
 202   REM PRINT "here2 RELEASE_PEND releasing:"+STR$(ZR%(ZM%))
 203   AY%=ZR%(ZM%): GOSUB RELEASE
 204   ZM%=ZM%-1
 205   GOTO RELEASE_PEND
 206
 207 REM DEREF_R(R%) -> R%
 208 DEREF_R:
 209   IF (Z%(R%,0)AND15)=14 THEN R%=Z%(R%,1): GOTO DEREF_R
 210   RETURN
 211
 212 REM DEREF_A(A%) -> A%
 213 DEREF_A:
 214   IF (Z%(A%,0)AND15)=14 THEN A%=Z%(A%,1): GOTO DEREF_A
 215   RETURN
 216
 217 REM DEREF_B(B%) -> B%
 218 DEREF_B:
 219   IF (Z%(B%,0)AND15)=14 THEN B%=Z%(B%,1): GOTO DEREF_B
 220   RETURN
 221
 222 CHECK_FREE_LIST:
 223   P1%=ZK%: P2%=0: REM start and accumulator
 224   CHECK_FREE_LIST_LOOP:
 225     IF P1%>=ZI% THEN GOTO CHECK_FREE_LIST_DONE
 226     IF (Z%(P1%,0)AND15)<>15 THEN P2%=-1: GOTO CHECK_FREE_LIST_DONE
 227     P2%=P2%+(Z%(P1%,0)AND-16)/16
 228     P1%=Z%(P1%,1)
 229     GOTO CHECK_FREE_LIST_LOOP
 230   CHECK_FREE_LIST_DONE:
 231     IF P2%=-1 THEN PRINT "corrupt free list at "+STR$(P1%)
 232     RETURN
 233
 234 PR_MEMORY_SUMMARY:
 235   GOSUB CHECK_FREE_LIST: REM get count in P2%
 236   PRINT
 237   PRINT "Free memory (FRE)      : " + STR$(FRE(0))
 238   PRINT "Value memory (Z%)      : " + STR$(ZI%-1) + " /" + STR$(S1%)
 239   PRINT "                         ";
 240   PRINT " used:"+STR$(ZI%-1-P2%)+", freed:"+STR$(P2%);
 241   PRINT ", post repl_env:"+STR$(ZT%)
 242   PRINT "String values (ZS$)    : " + STR$(ZJ%) + " /" + STR$(S2%)
 243   PRINT "Call stack size (ZZ%)  : " + STR$(ZL%+1) + " /" + STR$(S3%)
 244   RETURN
 245
 246 REM PR_MEMORY(P1%, P2%) -> nil
 247 PR_MEMORY:
 248   IF P2%<P1% THEN P2%=ZI%-1
 249   PRINT "vvvvvv"
 250   PRINT "Z% Value Memory"+STR$(P1%)+"->"+STR$(P2%);
 251   PRINT " (ZI%: "+STR$(ZI%)+", ZK%: "+STR$(ZK%)+"):"
 252   IF P2%<P1% THEN PRINT "  ---": GOTO PR_MEMORY_AFTER_VALUES
 253   I=P1%
 254   PR_MEMORY_VALUE_LOOP:
 255     IF I>P2% THEN GOTO PR_MEMORY_AFTER_VALUES
 256     PRINT " " + STR$(I);
 257     IF (Z%(I,0)AND15)=15 THEN GOTO PR_MEMORY_FREE
 258       PRINT ": ref cnt: " + STR$((Z%(I,0)AND-16)/16);
 259       PRINT ", type: " + STR$(Z%(I,0)AND15) + ", value: " + STR$(Z%(I,1))
 260       I=I+1
 261       IF (Z%(I-1,0)AND15)<>10 THEN GOTO PR_MEMORY_VALUE_LOOP
 262         PRINT " "+STR$(I)+":            ";
 263         PRINT "params: "+STR$(Z%(I+1,0))+", env:"+STR$(Z%(I+1,1))
 264         I=I+1
 265       GOTO PR_MEMORY_VALUE_LOOP
 266     PR_MEMORY_FREE:
 267       PRINT ": FREE size: "+STR$((Z%(I,0)AND-16)/16)+", next: "+STR$(Z%(I,1));
 268       IF I=ZK% THEN PRINT " (free list start)";
 269       PRINT
 270       IF (Z%(I,0)AND-16)=32 THEN I=I+1: PRINT " "+STR$(I)+": ---"
 271       I=I+1
 272       GOTO PR_MEMORY_VALUE_LOOP
 273   PR_MEMORY_AFTER_VALUES:
 274   PRINT "ZS% String Memory (ZJ%: " + STR$(ZJ%) + "):"
 275   IF ZJ%<=0 THEN PRINT "  ---": GOTO PR_MEMORY_SKIP_STRINGS
 276   FOR I=0 TO ZJ%-1
 277     PRINT " " + STR$(I) + ": '" + ZS$(I) + "'"
 278     NEXT I
 279   PR_MEMORY_SKIP_STRINGS:
 280   PRINT "ZZ% Stack Memory (ZL%: " + STR$(ZL%) + "):"
 281   IF ZL%<0 THEN PRINT "  ---": GOTO PR_MEMORY_SKIP_STACK
 282   FOR I=0 TO ZL%
 283     PRINT " "+STR$(I)+": "+STR$(ZZ%(I))
 284     NEXT I
 285   PR_MEMORY_SKIP_STACK:
 286   PRINT "^^^^^^"
 287   RETURN
 288
 289
 290 REM general functions
 291
 292 REM EQUAL_Q(A%, B%) -> R%
 293 EQUAL_Q:
 294   GOSUB DEREF_A: GOSUB DEREF_B
 295
 296   R%=0
 297   U1%=(Z%(A%,0)AND15): U2%=(Z%(B%,0)AND15)
 298   IF NOT ((U1%=U2%) OR ((U1%=6 OR U1%=7) AND (U2%=6 OR U2%=7))) THEN RETURN
 299   IF U1%=6 THEN GOTO EQUAL_Q_SEQ
 300   IF U1%=7 THEN GOTO EQUAL_Q_SEQ
 301   IF U1%=8 THEN GOTO EQUAL_Q_HM
 302
 303   IF Z%(A%,1)=Z%(B%,1) THEN R%=1
 304   RETURN
 305
 306   EQUAL_Q_SEQ:
 307     IF (Z%(A%,1)=0) AND (Z%(B%,1)=0) THEN R%=1: RETURN
 308     IF (Z%(A%,1)=0) OR (Z%(B%,1)=0) THEN R%=0: RETURN
 309
 310     REM push A% and B%
 311     ZL%=ZL%+2: ZZ%(ZL%-1)=A%: ZZ%(ZL%)=B%
 312     A%=Z%(A%+1,1): B%=Z%(B%+1,1): GOSUB EQUAL_Q
 313     REM pop A% and B%
 314     A%=ZZ%(ZL%-1): B%=ZZ%(ZL%): ZL%=ZL%-2
 315     IF R%=0 THEN RETURN
 316
 317     REM next elements of the sequences
 318     A%=Z%(A%,1): B%=Z%(B%,1): GOTO EQUAL_Q_SEQ
 319   EQUAL_Q_HM:
 320     R%=0
 321     RETURN
 322
 323 REM string functions
 324
 325 REM STRING_(AS$) -> R%
 326 REM intern string (returns string index, not Z% index)
 327 STRING:
 328   IF ZJ%=0 THEN GOTO STRING_NOT_FOUND
 329
 330   REM search for matching string in ZS$
 331   FOR I=0 TO ZJ%-1
 332     IF AS$=ZS$(I) THEN R%=I: RETURN
 333     NEXT I
 334
 335   STRING_NOT_FOUND:
 336     ZS$(ZJ%) = AS$
 337     R%=ZJ%
 338     ZJ%=ZJ%+1
 339     RETURN
 340
 341
 342
 343
 344 REM list functions
 345
 346 REM LIST_Q(A%) -> R%
 347 LIST_Q:
 348   R%=0
 349   IF (Z%(A%,0)AND15)=6 THEN R%=1
 350   RETURN
 351
 352 REM EMPTY_Q(A%) -> R%
 353 EMPTY_Q:
 354   R%=0
 355   IF Z%(A%,1)=0 THEN R%=1
 356   RETURN
 357
 358 REM COUNT(A%) -> R%
 359 COUNT:
 360   R%=-1
 361   DO_COUNT_LOOP:
 362     R%=R%+1
 363     IF Z%(A%,1)<>0 THEN A%=Z%(A%,1): GOTO DO_COUNT_LOOP
 364   RETURN
 365
 366 REM LAST(A%) -> R%
 367 LAST:
 368   REM TODO check that actually a list/vector
 369   IF Z%(A%,1)=0 THEN R%=0: RETURN: REM empty seq, return nil
 370   T6%=0
 371   LAST_LOOP:
 372     IF Z%(A%,1)=0 THEN GOTO LAST_DONE: REM end, return previous value
 373     T6%=A%: REM current becomes previous entry
 374     A%=Z%(A%,1): REM next entry
 375     GOTO LAST_LOOP
 376   LAST_DONE:
 377     R%=T6%+1: GOSUB DEREF_R
 378     Z%(R%,0)=Z%(R%,0)+16
 379     RETURN
 380
 381 REM hashmap functions
 382
 383 REM HASHMAP() -> R%
 384 HASHMAP:
 385   SZ%=2: GOSUB ALLOC
 386   Z%(R%,0) = 8+16
 387   Z%(R%,1) = 0
 388   Z%(R%+1,0) = 14
 389   Z%(R%+1,1) = 0
 390   RETURN
 391
 392 REM ASSOC1(HM%, K%, V%) -> R%
 393 ASSOC1:
 394   REM deref to actual key and value
 395   R%=K%: GOSUB DEREF_R: K%=R%
 396   R%=V%: GOSUB DEREF_R: V%=R%
 397
 398   REM inc ref count of key and value
 399   Z%(K%,0)=Z%(K%,0)+16
 400   Z%(V%,0)=Z%(V%,0)+16
 401   SZ%=4: GOSUB ALLOC
 402   REM key ptr
 403   Z%(R%,0) = 8+16
 404   Z%(R%,1) = R%+2: REM point to next element (value)
 405   Z%(R%+1,0) = 14
 406   Z%(R%+1,1) = K%
 407   REM value ptr
 408   Z%(R%+2,0) = 8+16
 409   Z%(R%+2,1) = HM%: REM hashmap to assoc onto
 410   Z%(R%+3,0) = 14
 411   Z%(R%+3,1) = V%
 412   RETURN
 413
 414 REM ASSOC1(HM%, K$, V%) -> R%
 415 ASSOC1_S:
 416   REM add the key string, then call ASSOC1
 417   SZ%=1: GOSUB ALLOC
 418   K%=R%
 419   ZS$(ZJ%) = K$
 420   Z%(R%,0) = 4: REM key ref cnt will be inc'd by ASSOC1
 421   Z%(R%,1) = ZJ%
 422   ZJ%=ZJ%+1
 423   GOSUB ASSOC1
 424   RETURN
 425
 426 REM HASHMAP_GET(HM%, K%) -> R%
 427 HASHMAP_GET:
 428   H2%=HM%
 429   T1$=ZS$(Z%(K%,1)): REM search key string
 430   T3%=0: REM whether found or not (for HASHMAP_CONTAINS)
 431   R%=0
 432   HASHMAP_GET_LOOP:
 433     REM no matching key found
 434     IF Z%(H2%,1)=0 THEN R%=0: RETURN
 435     REM follow value ptrs
 436     T2%=H2%+1
 437     HASHMAP_GET_DEREF:
 438       IF Z%(T2%,0)=14 THEN T2%=Z%(T2%,1): GOTO HASHMAP_GET_DEREF
 439     REM get key string
 440     T2$=ZS$(Z%(T2%,1))
 441     REM if they are equal, we found it
 442     IF T1$=T2$ THEN T3%=1: R%=Z%(H2%,1)+1: RETURN
 443     REM skip to next key
 444     H2%=Z%(Z%(H2%,1),1)
 445     GOTO HASHMAP_GET_LOOP
 446
 447 REM HASHMAP_CONTAINS(HM%, K%) -> R%
 448 HASHMAP_CONTAINS:
 449   GOSUB HASHMAP_GET
 450   R%=T3%
 451   RETURN
 452
 453 REM NATIVE_FUNCTION(A%) -> R%
 454 NATIVE_FUNCTION:
 455   SZ%=1: GOSUB ALLOC
 456   Z%(R%,0) = 9+16
 457   Z%(R%,1) = A%
 458   RETURN
 459
 460 REM NATIVE_FUNCTION(A%, P%, E%) -> R%
 461 MAL_FUNCTION:
 462   SZ%=2: GOSUB ALLOC
 463   Z%(A%,0)=Z%(A%,0)+16
 464   Z%(P%,0)=Z%(P%,0)+16
 465   Z%(E%,0)=Z%(E%,0)+16
 466
 467   Z%(R%,0) = 10+16
 468   Z%(R%,1) = A%
 469   Z%(R%+1,0) = P%
 470   Z%(R%+1,1) = E%
 471   RETURN