bbc-basic/types

   1 REM > types library for mal in BBC BASIC
   2
   3 REM  This library should be the only thing that understands the
   4 REM  implementation of mal data types in BBC BASIC.  All other
   5 REM  code should use routines in this library to access them.
   6
   7 REM  As far as other code is concerned, a mal object is just an
   8 REM  opaque 32-bit integer, which might be a pointer, or might not.
   9
  10 REM  Following the 8-bit BASIC implementation, we currently have two
  11 REM  arrays, Z%() containing most objects and S$() containing strings
  12 REM  (referenced from Z%()).  Unlike that implementation, we use a
  13 REM  two-dimensional array where each object is a whole row.  This
  14 REM  is inefficient but should make memory management simpler.
  15
  16 REM  S%() holds reference counts for the strings in S$().  At present
  17 REM  these are all 0 or 1.
  18
  19 REM  Z%(x,0) holds the type of an object.  High-order bits contain flags.
  20
  21 REM  sS%() is a shadow stack, used to keep track of which mal values might
  22 REM  be referenced from local variables at a given depth of the BASIC call
  23 REM  stack.  It grows upwards.  sSP% points to the first unused word.  sFP%
  24 REM  points to the start of the current shadow stack frame.  The first word
  25 REM  of each shadow stack frame is the saved value of sFP%.  The rest are
  26 REM  mal values.
  27
  28 REM  Types are:
  29 REM  0   nil
  30 REM  1   boolean
  31 REM  2   integer
  32 REM  4   string
  33 REM  5   symbol
  34 REM  6   list (each object is a cons cell)
  35 REM  8   hash-map (each object is one entry)
  36 REM  9   core function
  37 REM  10  mal function
  38 REM  13  environment
  39 REM  15  free block
  40
  41 REM  Formats of individual objects are defined below.
  42
  43 DEF PROCtypes_init
  44   REM  Arbitrarily use half of BASIC's heap as the mal heap, with a bit
  45   REM  more for strings.  Each heap entry is sixteen bytes.
  46   DIM Z%((HIMEM-LOMEM)/32,3)
  47   DIM S$((HIMEM-LOMEM)/64), S%((HIMEM-LOMEM)/64)
  48   DIM sS%((HIMEM-LOMEM)/64)
  49   Z%(1,0) = 1: REM false
  50   Z%(2,0) = 1: Z%(2,1) = TRUE: REM true
  51   Z%(3,0) = 6: REM empty list
  52   Z%(5,0) = 8: REM empty hashmap
  53   next_Z% = 6
  54   next_S% = 0
  55   sSP% = 1
  56   sFP% = 0
  57   F% = 0
  58   GCtoggle% = 0
  59   SF% = 0
  60 ENDPROC
  61
  62 DEF FNtype_of(val%)
  63 =Z%(val%,0) AND 31
  64
  65 DEF PROCgc_enter
  66   REM PRINT ;sFP%;
  67   sS%(sSP%) = sFP%
  68   sFP% = sSP%
  69   sSP% += 1
  70   REM PRINT " >>> ";sFP%
  71 ENDPROC
  72
  73 DEF FNgc_save
  74 =sFP%
  75
  76 DEF PROCgc_exit
  77   REM PRINT ;sS%(sFP%);" <<< ";sFP%
  78   sSP% = sFP%
  79   sFP% = sS%(sFP%)
  80 ENDPROC
  81
  82 DEF PROCgc_restore(oldFP%)
  83   sFP% = oldFP%
  84   sSP% = sFP% + 1
  85   REM PRINT "!!! ";sFP%
  86 ENDPROC
  87
  88 DEF FNref_local(val%)
  89   sS%(sSP%) = val%
  90   sSP% += 1
  91 =val%
  92
  93 DEF FNgc_exit(val%)
  94   PROCgc_exit
  95   val% = FNref_local(val%)
  96 =val%
  97
  98 DEF PROCgc_keep_only2(val1%, val2%)
  99   PROCgc_exit
 100   PROCgc_enter
 101   val1% = FNref_local(val1%)
 102   val2% = FNref_local(val2%)
 103 ENDPROC
 104
 105 DEF FNmalloc(type%)
 106   LOCAL val%
 107   REM  If the heap is full, collect garbage first.
 108   IF F% = 0 AND next_Z% > DIM(Z%(),1) THEN PROCgc
 109   IF F% <> 0 THEN
 110     val% = F%
 111     F% = Z%(val%,1)
 112   ELSE
 113     val% = next_Z%
 114     next_Z% += 1
 115   ENDIF
 116   Z%(val%,0) = type% OR GCtoggle%
 117 =FNref_local(val%)
 118
 119 DEF FNsalloc(s$)
 120   LOCAL val%
 121   IF SF% <> 0 THEN
 122     val% = SF%
 123     SF% = S%(val%)
 124   ELSE
 125     val% = next_S%
 126     next_S% += 1
 127   ENDIF
 128   S$(val%) = s$
 129 =val%
 130
 131 DEF PROCfree(val%)
 132   CASE FNtype_of(val%) OF
 133     WHEN 4 : PROCfree_string(val%)
 134     WHEN 5 : PROCfree_symbol(val%)
 135     WHEN 8 : PROCfree_hashmap(val%)
 136   ENDCASE
 137   Z%(val%,0) = 15
 138   Z%(val%,1) = F%
 139   Z%(val%,2) = 0
 140   Z%(val%,3) = 0
 141   F% = val%
 142 ENDPROC
 143
 144 DEF PROCsfree(val%)
 145   S$(val%) = ""
 146   S%(val%) = SF%
 147   SF% = val%
 148 ENDPROC
 149
 150 DEF PROCgc
 151   REM PRINT "** START GC **"
 152   GCtoggle% = GCtoggle% EOR &100
 153   PROCgc_markall
 154   PROCgc_sweep
 155   REM PRINT "** FINISH GC **"
 156 ENDPROC
 157
 158 DEF PROCgc_markall
 159   LOCAL sp%, fp%
 160   fp% = sFP%
 161   REM PRINT ">>marking...";
 162   FOR sp% = sSP% - 1 TO 0 STEP -1
 163     IF sp% = fp% THEN
 164       fp% = sS%(sp%)
 165       REM PRINT " / ";
 166     ELSE PROCgc_mark(sS%(sp%))
 167     ENDIF
 168   NEXT sp%
 169   REM PRINT
 170 ENDPROC
 171
 172 DEF PROCgc_mark(val%)
 173   IF (Z%(val%,0) AND &100) <> GCtoggle% THEN
 174     REM PRINT " ";val%;
 175     Z%(val%,0) = Z%(val%,0) EOR &100
 176     CASE FNtype_of(val%) OF
 177       WHEN 6 :  PROCgc_mark_list(val%)
 178       WHEN 8 :  PROCgc_mark_hashmap(val%)
 179       WHEN 10 : PROCgc_mark_fn(val%)
 180       WHEN 12 : PROCgc_mark_atom(val%)
 181       WHEN 13 : PROCgc_mark_environment(val%)
 182     ENDCASE
 183   ENDIF
 184 ENDPROC
 185
 186 DEF PROCgc_sweep
 187   LOCAL val%
 188   REM PRINT ">>sweeping ...";
 189   FOR val% = 6 TO next_Z% - 1
 190     IF FNtype_of(val%) <> 15 AND (Z%(val%,0) AND &100) <> GCtoggle% THEN
 191       REM PRINT " ";val%;
 192       PROCfree(val%)
 193     ENDIF
 194   NEXT val%
 195   REM PRINT
 196 ENDPROC
 197
 198 REM ** Nil **
 199
 200 DEF FNis_nil(val%)
 201 =FNtype_of(val%) = 0
 202
 203 DEF FNnil
 204 =0
 205
 206 REM ** Boolean **
 207
 208 REM  Z%(x,1) = TRUE or FALSE
 209
 210 DEF FNis_boolean(val%)
 211 =FNtype_of(val%) = 1
 212
 213 DEF FNalloc_boolean(bval%)
 214   IF bval% THEN =2
 215 =1
 216
 217 DEF FNunbox_boolean(val%)
 218   IF NOT FNis_boolean(val%) THEN ERROR &40E80911, "Not a boolean"
 219 =Z%(val%,1)
 220
 221 DEF FNis_truish(val%)
 222   IF FNis_nil(val%) THEN =FALSE
 223   IF FNis_boolean(val%) THEN =FNunbox_boolean(val%)
 224 =TRUE
 225
 226 REM ** Integers **
 227
 228 REM  Z%(x,1) = integer value
 229
 230 DEF FNis_int(val%)
 231 =FNtype_of(val%) = 2
 232
 233 DEF FNalloc_int(ival%)
 234   LOCAL val%
 235   val% = FNmalloc(2)
 236   Z%(val%,1) = ival%
 237 =val%
 238
 239 DEF FNunbox_int(val%)
 240   IF NOT FNis_int(val%) THEN ERROR &40E80912, "Not an integer"
 241 =Z%(val%,1)
 242
 243 REM ** Strings **
 244
 245 DEF FNis_string(val%)
 246 =FNtype_of(val%) = 4
 247
 248 DEF FNalloc_string(sval$)
 249   LOCAL val%
 250   val% = FNmalloc(4)
 251   Z%(val%,1) = FNsalloc(sval$)
 252 =val%
 253
 254 DEF PROCfree_string(val%)
 255   PROCsfree(Z%(val%,1))
 256 ENDPROC
 257
 258 DEF FNunbox_string(val%)
 259   IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string"
 260 =S$(Z%(val%,1))
 261
 262 REM ** Symbols **
 263
 264 REM  Z%(x,1) = index in S$() of the value of the symbol
 265
 266 DEF FNis_symbol(val%)
 267 =FNtype_of(val%) = 5
 268
 269 DEF FNalloc_symbol(sval$)
 270   LOCAL val%
 271   val% = FNmalloc(5)
 272   Z%(val%,1) = FNsalloc(sval$)
 273 =val%
 274
 275 DEF PROCfree_symbol(val%)
 276   PROCsfree(Z%(val%,1))
 277 ENDPROC
 278
 279 DEF FNunbox_symbol(val%)
 280   IF NOT FNis_symbol(val%) THEN ERROR &40E80915, "Not a symbol"
 281 =S$(Z%(val%,1))
 282
 283 REM ** Lists **
 284
 285 REM  Z%(x,1) = index in Z%() of next pair
 286 REM  Z%(x,2) = index in Z%() of first element
 287
 288 REM  The empty list is a distinguished value, which happens to have
 289 REM  both elements nil.
 290
 291 DEF FNempty
 292 =3
 293
 294 DEF FNalloc_pair(car%, cdr%)
 295   LOCAL val%
 296   val% = FNmalloc(6)
 297   Z%(val%,2) = car%
 298   Z%(val%,1) = cdr%
 299 =val%
 300
 301 DEF FNis_empty(val%)
 302 =val% = FNempty
 303
 304 DEF FNis_list(val%)
 305 =FNtype_of(val%) = 6
 306
 307 DEF PROCgc_mark_list(val%)
 308   IF NOT FNis_empty(val%) THEN
 309     PROCgc_mark(Z%(val%,1))
 310     PROCgc_mark(Z%(val%,2))
 311   ENDIF
 312 ENDPROC
 313
 314 DEF FNlist_car(val%)
 315   IF NOT FNis_list(val%) THEN ERROR &40E80916, "Can't get car of non-list"
 316   IF Z%(val%,1) = 0 THEN ERROR &40E80920, "Can't get car of empty list"
 317 =FNref_local(Z%(val%,2))
 318
 319 DEF FNlist_cdr(val%)
 320   IF NOT FNis_list(val%) THEN ERROR &40E80916, "Can't get cdr of non-list"
 321   IF Z%(val%,1) = 0 THEN ERROR &40E80920, "Can't get cdr of empty list"
 322 =FNref_local(Z%(val%,1))
 323
 324 DEF FNalloc_list2(val0%, val1%)
 325   =FNalloc_pair(val0%, FNalloc_pair(val1%, FNempty))
 326
 327 DEF FNalloc_list3(val0%, val1%, val2%)
 328   =FNalloc_pair(val0%, FNalloc_pair(val1%, FNalloc_pair(val2%, FNempty)))
 329
 330 DEF FNlist_len(val%)
 331   LOCAL i%
 332   WHILE NOT FNis_empty(val%)
 333     val% = FNlist_cdr(val%)
 334     i% += 1
 335   ENDWHILE
 336 = i%
 337
 338 DEF FNlist_nth(val%, n%)
 339   WHILE n% > 0
 340     IF FNis_empty(val%) THEN ERROR &40E80923, "Subscript out of range"
 341     val% = FNlist_cdr(val%)
 342     n% -= 1
 343   ENDWHILE
 344   IF FNis_empty(val%) THEN ERROR &40E80923, "Subscript out of range"
 345 =FNlist_car(val%)
 346
 347 DEF PROClist_to_array(val%, a%())
 348   REM  a%() must already be correctly dimensioned.
 349   LOCAL i%
 350   WHILE NOT FNis_empty(val%)
 351     a%(i%) = FNref_local(FNlist_car(val%))
 352     val% = FNlist_cdr(val%)
 353     i% += 1
 354   ENDWHILE
 355 ENDPROC
 356
 357 DEF FNarray_to_list(a%())
 358   LOCAL i%, val%
 359   PROCgc_enter
 360   val% = FNempty
 361   IF DIM(a%(), 1) = 0 THEN =val%
 362   FOR i% = DIM(a%(), 1) - 1 TO 0 STEP -1
 363     val% = FNalloc_pair(a%(i%), val%)
 364   NEXT i%
 365 =FNgc_exit(val%)
 366
 367 REM ** Core functions **
 368
 369 REM  Z%(x,1) = index of function in FNcore_call
 370
 371 DEF FNis_corefn(val%)
 372 =FNtype_of(val%) = 9
 373
 374 DEF FNalloc_corefn(fn%)
 375   LOCAL val%
 376   val% = FNmalloc(9)
 377   Z%(val%,1) = fn%
 378 =val%
 379
 380 DEF FNunbox_corefn(val%)
 381   IF NOT FNis_corefn(val%) THEN ERROR &40E80919, "Not a core function"
 382 =Z%(val%,1)
 383
 384 REM ** Hash-maps **
 385
 386 REM  Z%(x,1) = index in Z%() of next element
 387 REM  Z%(x,2) = index in S$() of value
 388 REM  Z%(x,3) = index in Z%() of value
 389
 390 REM  To defer implementing mal strings for a bit, hashmap keys are
 391 REM  currently BASIC strings rather than arbitrary values.
 392
 393 DEF FNempty_hashmap
 394 =5
 395
 396 DEF FNalloc_hashmap_entry(key$, val%, next%)
 397   LOCAL entry%
 398   entry% = FNmalloc(8)
 399   Z%(entry%,1) = next%
 400   Z%(entry%,2) = FNsalloc(key$)
 401   Z%(entry%,3) = val%
 402 =entry%
 403
 404 DEF FNis_hashmap(val%)
 405 =FNtype_of(val%) = 8
 406
 407 DEF PROCgc_mark_hashmap(val%)
 408   PROCgc_mark(Z%(val%,1))
 409   PROCgc_mark(Z%(val%,3))
 410 ENDPROC
 411
 412 DEF PROCfree_hashmap(val%)
 413   PROCsfree(Z%(val%,2))
 414 ENDPROC
 415
 416 DEF FNhashmap_get(map%, key$)
 417   IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap"
 418   IF map% = FNempty_hashmap THEN =FNnil
 419   IF S$(Z%(map%,2)) = key$ THEN =FNref_local(Z%(map%,3))
 420 =FNhashmap_get(Z%(map%,1), key$)
 421
 422 DEF FNhashmap_contains(map%, key$)
 423   IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap"
 424   IF map% = FNempty_hashmap THEN =FALSE
 425   IF S$(Z%(map%,2)) = key$ THEN =TRUE
 426 =FNhashmap_get(Z%(map%,1), key$)
 427
 428 REM ** Functions **
 429
 430 REM  Z%(x,0) AND &80 = is_macro flag
 431 REM  Z%(x,1) = index in Z%() of ast
 432 REM  Z%(x,2) = index in Z%() of params
 433 REM  Z%(x,3) = index in Z%() of env
 434
 435 DEF FNis_fn(val%)
 436 =FNtype_of(val%) = 10
 437
 438 DEF FNis_nonmacro_fn(val%)
 439 =FNtype_of(val%) = 10 AND (Z%(val%, 0) AND &80) = &00
 440
 441 DEF FNis_macro(val%)
 442 =FNtype_of(val%) = 10 AND (Z%(val%, 0) AND &80) = &80
 443
 444 DEF FNalloc_fn(ast%, params%, env%)
 445   LOCAL val%
 446   val% = FNmalloc(10)
 447   Z%(val%,1) = ast%
 448   Z%(val%,2) = params%
 449   Z%(val%,3) = env%
 450 =val%
 451
 452 DEF PROCmake_macro(val%)
 453   IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function"
 454   Z%(val%, 0) = Z%(val%, 0) OR &80
 455 ENDPROC
 456
 457 DEF PROCgc_mark_fn(val%)
 458   PROCgc_mark(Z%(val%,1))
 459   PROCgc_mark(Z%(val%,2))
 460   PROCgc_mark(Z%(val%,3))
 461 ENDPROC
 462
 463 DEF FNfn_ast(val%)
 464   IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function"
 465 =FNref_local(Z%(val%,1))
 466
 467 DEF FNfn_params(val%)
 468   IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function"
 469 =FNref_local(Z%(val%,2))
 470
 471 DEF FNfn_env(val%)
 472   IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function"
 473 =FNref_local(Z%(val%,3))
 474
 475 REM ** Atoms **
 476
 477 REM Z%(x,1) = index in Z% of current referent
 478
 479 DEF FNis_atom(val%)
 480 =FNtype_of(val%) = 12
 481
 482 DEF FNalloc_atom(contents%)
 483   LOCAL val%
 484   val% = FNmalloc(12)
 485   Z%(val%,1) = contents%
 486 =val%
 487
 488 DEF PROCgc_mark_atom(val%)
 489   PROCgc_mark(Z%(val%,1))
 490 ENDPROC
 491
 492 DEF FNatom_deref(val%)
 493 =FNref_local(Z%(val%,1))
 494
 495 DEF PROCatom_reset(val%, contents%)
 496   Z%(val%,1) = contents%
 497 ENDPROC
 498
 499 REM ** Environments **
 500
 501 REM  Z%(x,1) = index in Z% of hash-map
 502 REM  Z%(x,2) = index in Z% of outer environment
 503
 504 DEF FNis_environment(val%)
 505 =FNtype_of(val%) = 13
 506
 507 DEF FNalloc_environment(outer%)
 508   LOCAL val%
 509   val% = FNmalloc(13)
 510   Z%(val%,1) = FNempty_hashmap
 511   Z%(val%,2) = outer%
 512 =val%
 513
 514 DEF PROCgc_mark_environment(val%)
 515   PROCgc_mark(Z%(val%,1))
 516   PROCgc_mark(Z%(val%,2))
 517 ENDPROC
 518
 519 DEF FNenvironment_data(val%)
 520   IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment"
 521 =FNref_local(Z%(val%,1))
 522
 523 DEF PROCenvironment_set_data(val%, data%)
 524   IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment"
 525   Z%(val%,1) = data%
 526 ENDPROC
 527
 528 DEF FNenvironment_outer(val%)
 529   IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment"
 530 =FNref_local(Z%(val%,2))
 531
 532 REM Local Variables:
 533 REM indent-tabs-mode: nil
 534 REM End: