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/keyword
  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%(4,0) = &86 : REM empty vector
  53   Z%(5,0) = 8: REM empty hashmap
  54   next_Z% = 6
  55   next_S% = 0
  56   sSP% = 1
  57   sFP% = 0
  58   F% = 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 REM  FNgc_save is equivalent to PROCgc_enter except that it returns a
  74 REM  value that can be passed to PROCgc_restore to pop all the stack
  75 REM  frames back to (and including) the one pushed by FNgc_save.
  76 DEF FNgc_save
  77   PROCgc_enter
  78 =sFP%
  79
  80 DEF PROCgc_exit
  81   REM PRINT ;sS%(sFP%);" <<< ";sFP%
  82   sSP% = sFP%
  83   sFP% = sS%(sFP%)
  84 ENDPROC
  85
  86 DEF PROCgc_restore(oldFP%)
  87   sFP% = oldFP%
  88   REM PRINT "!!! FP reset"
  89   PROCgc_exit
  90 ENDPROC
  91
  92 DEF FNref_local(val%)
  93   sS%(sSP%) = val%
  94   sSP% += 1
  95 =val%
  96
  97 DEF FNgc_exit(val%)
  98   PROCgc_exit
  99 =FNref_local(val%)
 100
 101 DEF FNgc_restore(oldFP%, val%)
 102   PROCgc_restore(oldFP%)
 103 =FNref_local(val%)
 104
 105 DEF PROCgc_keep_only2(val1%, val2%)
 106   PROCgc_exit
 107   PROCgc_enter
 108   val1% = FNref_local(val1%)
 109   val2% = FNref_local(val2%)
 110 ENDPROC
 111
 112 DEF FNmalloc(type%)
 113   LOCAL val%
 114   REM  If the heap is full, collect garbage first.
 115   IF F% = 0 AND next_Z% > DIM(Z%(),1) THEN PROCgc
 116   IF F% <> 0 THEN
 117     val% = F%
 118     F% = Z%(val%,1)
 119   ELSE
 120     val% = next_Z%
 121     next_Z% += 1
 122   ENDIF
 123   Z%(val%,0) = type%
 124 =FNref_local(val%)
 125
 126 DEF FNsalloc(s$)
 127   LOCAL val%
 128   IF SF% <> 0 THEN
 129     val% = SF%
 130     SF% = S%(val%)
 131   ELSE
 132     val% = next_S%
 133     next_S% += 1
 134   ENDIF
 135   S$(val%) = s$
 136 =val%
 137
 138 DEF PROCfree(val%)
 139   CASE FNtype_of(val%) OF
 140     WHEN 4 : PROCfree_string(val%)
 141     WHEN 5 : PROCfree_symbol(val%)
 142     WHEN 8 : PROCfree_hashmap(val%)
 143   ENDCASE
 144   Z%(val%,0) = 15
 145   Z%(val%,1) = F%
 146   Z%(val%,2) = 0
 147   Z%(val%,3) = 0
 148   F% = val%
 149 ENDPROC
 150
 151 DEF PROCsfree(val%)
 152   S$(val%) = ""
 153   S%(val%) = SF%
 154   SF% = val%
 155 ENDPROC
 156
 157 DEF PROCgc
 158   REM PRINT "** START GC **"
 159   PROCgc_markall
 160   PROCgc_sweep
 161   REM PRINT "** FINISH GC **"
 162 ENDPROC
 163
 164 DEF PROCgc_markall
 165   LOCAL sp%, fp%
 166   fp% = sFP%
 167   REM PRINT ">>marking...";
 168   FOR sp% = sSP% - 1 TO 0 STEP -1
 169     IF sp% = fp% THEN
 170       fp% = sS%(sp%)
 171       REM PRINT " / ";
 172     ELSE PROCgc_mark(sS%(sp%))
 173     ENDIF
 174   NEXT sp%
 175   REM PRINT
 176 ENDPROC
 177
 178 DEF PROCgc_mark(val%)
 179   IF (Z%(val%,0) AND &100) = 0 THEN
 180     REM PRINT " ";val%;
 181     Z%(val%,0) += &100
 182     CASE FNtype_of(val%) OF
 183       WHEN 6 :  PROCgc_mark_seq(val%)
 184       WHEN 8 :  PROCgc_mark_hashmap(val%)
 185       WHEN 10 : PROCgc_mark_fn(val%)
 186       WHEN 12 : PROCgc_mark_atom(val%)
 187       WHEN 13 : PROCgc_mark_environment(val%)
 188     ENDCASE
 189   ENDIF
 190 ENDPROC
 191
 192 DEF PROCgc_sweep
 193   LOCAL val%
 194   REM PRINT ">>sweeping ...";
 195   FOR val% = 6 TO next_Z% - 1
 196     IF FNtype_of(val%) <> 15 AND (Z%(val%,0) AND &100) = 0 THEN
 197       REM PRINT " ";val%;
 198       PROCfree(val%)
 199     ELSE
 200       Z%(val%,0) -= &100
 201     ENDIF
 202   NEXT val%
 203   REM PRINT
 204 ENDPROC
 205
 206 REM ** Nil **
 207
 208 DEF FNis_nil(val%)
 209 =FNtype_of(val%) = 0
 210
 211 DEF FNnil
 212 =0
 213
 214 REM ** Boolean **
 215
 216 REM  Z%(x,1) = TRUE or FALSE
 217
 218 DEF FNis_boolean(val%)
 219 =FNtype_of(val%) = 1
 220
 221 DEF FNalloc_boolean(bval%)
 222   IF bval% THEN =2
 223 =1
 224
 225 DEF FNunbox_boolean(val%)
 226   IF NOT FNis_boolean(val%) THEN ERROR &40E80911, "Not a boolean"
 227 =Z%(val%,1)
 228
 229 DEF FNis_truish(val%)
 230   IF FNis_nil(val%) THEN =FALSE
 231   IF FNis_boolean(val%) THEN =FNunbox_boolean(val%)
 232 =TRUE
 233
 234 REM ** Integers **
 235
 236 REM  Z%(x,1) = integer value
 237
 238 DEF FNis_int(val%)
 239 =FNtype_of(val%) = 2
 240
 241 DEF FNalloc_int(ival%)
 242   LOCAL val%
 243   val% = FNmalloc(2)
 244   Z%(val%,1) = ival%
 245 =val%
 246
 247 DEF FNunbox_int(val%)
 248   IF NOT FNis_int(val%) THEN ERROR &40E80912, "Not an integer"
 249 =Z%(val%,1)
 250
 251 REM ** Strings and keywords **
 252
 253 REM  A keyword is a string with first character CHR$(127).
 254
 255 DEF FNis_string(val%)
 256 =FNtype_of(val%) = 4
 257
 258 DEF FNalloc_string(sval$)
 259   LOCAL val%
 260   val% = FNmalloc(4)
 261   Z%(val%,1) = FNsalloc(sval$)
 262 =val%
 263
 264 DEF PROCfree_string(val%)
 265   PROCsfree(Z%(val%,1))
 266 ENDPROC
 267
 268 DEF FNunbox_string(val%)
 269   IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string"
 270 =S$(Z%(val%,1))
 271
 272 REM ** Symbols **
 273
 274 REM  Z%(x,1) = index in S$() of the value of the symbol
 275
 276 DEF FNis_symbol(val%)
 277 =FNtype_of(val%) = 5
 278
 279 DEF FNalloc_symbol(sval$)
 280   LOCAL val%
 281   val% = FNmalloc(5)
 282   Z%(val%,1) = FNsalloc(sval$)
 283 =val%
 284
 285 DEF PROCfree_symbol(val%)
 286   PROCsfree(Z%(val%,1))
 287 ENDPROC
 288
 289 DEF FNunbox_symbol(val%)
 290   IF NOT FNis_symbol(val%) THEN ERROR &40E80915, "Not a symbol"
 291 =S$(Z%(val%,1))
 292
 293 REM ** Lists and vectors **
 294
 295 REM  Lists and vectors are both represented as linked lists: the only
 296 REM  difference is in the state of the is_vector flag in the head cell
 297 REM  of the list.  Note that this means that the tail of a list may be
 298 REM  a vector, and vice versa.  FNas_list and FNas_vector can be used
 299 REM  to convert a sequence to a particular type as necessary.
 300
 301 REM  Z%(x,0) AND &80 = is_vector flag
 302 REM  Z%(x,1) = index in Z%() of next pair
 303 REM  Z%(x,2) = index in Z%() of first element
 304
 305 REM  The empty list is a distinguished value, which happens to have
 306 REM  both elements nil.
 307
 308 DEF FNempty
 309 =3
 310
 311 DEF FNempty_vector
 312 =4
 313
 314 DEF FNalloc_pair(car%, cdr%)
 315   LOCAL val%
 316   val% = FNmalloc(6)
 317   Z%(val%,2) = car%
 318   Z%(val%,1) = cdr%
 319 =val%
 320
 321 DEF FNalloc_vector_pair(car%, cdr%)
 322   LOCAL val%
 323   val% = FNalloc_pair(car%, cdr%)
 324   Z%(val%,0) = Z%(val%,0) OR &80
 325 =val%
 326
 327 DEF FNis_empty(val%)
 328 =val% = FNempty OR val% = FNempty_vector
 329
 330 DEF FNis_seq(val%)
 331 =FNtype_of(val%) = 6
 332
 333 DEF FNis_list(val%)
 334 =FNtype_of(val%) = 6 AND (Z%(val%, 0) AND &80) = &00
 335
 336 DEF FNis_vector(val%)
 337 =FNtype_of(val%) = 6 AND (Z%(val%, 0) AND &80) = &80
 338
 339 DEF FNas_list(val%)
 340   IF FNis_list(val%) THEN =val%
 341   IF FNis_empty(val%) THEN =FNempty
 342 =FNalloc_pair(FNfirst(val%), FNrest(val%))
 343
 344 DEF FNas_vector(val%)
 345   IF FNis_vector(val%) = &80 THEN =val%
 346   IF FNis_empty(val%) THEN =FNempty_vector
 347 =FNalloc_vector_pair(FNfirst(val%), FNrest(val%))
 348
 349 DEF PROCgc_mark_seq(val%)
 350   IF NOT FNis_empty(val%) THEN
 351     PROCgc_mark(Z%(val%,1))
 352     PROCgc_mark(Z%(val%,2))
 353   ENDIF
 354 ENDPROC
 355
 356 DEF FNfirst(val%)
 357   IF NOT FNis_seq(val%) THEN ERROR &40E80916, "Can't get car of non-sequence"
 358   IF Z%(val%,1) = 0 THEN ERROR &40E80920, "Can't get car of empty sequence"
 359 =FNref_local(Z%(val%,2))
 360
 361 DEF FNrest(val%)
 362   IF NOT FNis_seq(val%) THEN ERROR &40E80916, "Can't get cdr of non-sequence"
 363   IF Z%(val%,1) = 0 THEN ERROR &40E80920, "Can't get cdr of empty sequence"
 364 =FNref_local(Z%(val%,1))
 365
 366 DEF FNalloc_list2(val0%, val1%)
 367   =FNalloc_pair(val0%, FNalloc_pair(val1%, FNempty))
 368
 369 DEF FNalloc_list3(val0%, val1%, val2%)
 370   =FNalloc_pair(val0%, FNalloc_pair(val1%, FNalloc_pair(val2%, FNempty)))
 371
 372 DEF FNcount(val%)
 373   LOCAL i%
 374   WHILE NOT FNis_empty(val%)
 375     val% = FNrest(val%)
 376     i% += 1
 377   ENDWHILE
 378 = i%
 379
 380 DEF FNnth(val%, n%)
 381   WHILE n% > 0
 382     IF FNis_empty(val%) THEN ERROR &40E80923, "Subscript out of range"
 383     val% = FNrest(val%)
 384     n% -= 1
 385   ENDWHILE
 386   IF FNis_empty(val%) THEN ERROR &40E80923, "Subscript out of range"
 387 =FNfirst(val%)
 388
 389 DEF PROClist_to_array(val%, a%())
 390   REM  a%() must already be correctly dimensioned.
 391   LOCAL i%
 392   WHILE NOT FNis_empty(val%)
 393     a%(i%) = FNref_local(FNfirst(val%))
 394     val% = FNrest(val%)
 395     i% += 1
 396   ENDWHILE
 397 ENDPROC
 398
 399 DEF FNarray_to_list(a%())
 400   LOCAL i%, val%
 401   PROCgc_enter
 402   val% = FNempty
 403   IF DIM(a%(), 1) = 0 THEN =val%
 404   FOR i% = DIM(a%(), 1) - 1 TO 0 STEP -1
 405     val% = FNalloc_pair(a%(i%), val%)
 406   NEXT i%
 407 =FNgc_exit(val%)
 408
 409 REM ** Core functions **
 410
 411 REM  Z%(x,1) = index of function in FNcore_call
 412
 413 DEF FNis_corefn(val%)
 414 =FNtype_of(val%) = 9
 415
 416 DEF FNalloc_corefn(fn%)
 417   LOCAL val%
 418   val% = FNmalloc(9)
 419   Z%(val%,1) = fn%
 420 =val%
 421
 422 DEF FNunbox_corefn(val%)
 423   IF NOT FNis_corefn(val%) THEN ERROR &40E80919, "Not a core function"
 424 =Z%(val%,1)
 425
 426 REM ** Hash-maps **
 427
 428 REM  Z%(x,1) = index in Z%() of next element
 429 REM  Z%(x,2) = index in S$() of value
 430 REM  Z%(x,3) = index in Z%() of value
 431
 432 REM  To defer implementing mal strings for a bit, hashmap keys are
 433 REM  currently BASIC strings rather than arbitrary values.
 434
 435 DEF FNempty_hashmap
 436 =5
 437
 438 DEF FNis_empty_hashmap(val%)
 439 =val% = FNempty_hashmap
 440
 441 DEF FNalloc_hashmap_entry(key$, val%, next%)
 442   LOCAL entry%
 443   entry% = FNmalloc(8)
 444   Z%(entry%,1) = next%
 445   Z%(entry%,2) = FNsalloc(key$)
 446   Z%(entry%,3) = val%
 447 =entry%
 448
 449 DEF FNis_hashmap(val%)
 450 =FNtype_of(val%) = 8
 451
 452 DEF PROCgc_mark_hashmap(val%)
 453   PROCgc_mark(Z%(val%,1))
 454   PROCgc_mark(Z%(val%,3))
 455 ENDPROC
 456
 457 DEF PROCfree_hashmap(val%)
 458   PROCsfree(Z%(val%,2))
 459 ENDPROC
 460
 461 DEF FNhashmap_get(map%, key$)
 462   IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap"
 463   WHILE map% <> FNempty_hashmap
 464     IF S$(Z%(map%,2)) = key$ THEN =FNref_local(Z%(map%,3))
 465     map% = Z%(map%,1)
 466   ENDWHILE
 467 =FNnil
 468
 469 DEF FNhashmap_contains(map%, key$)
 470   IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap"
 471   WHILE map% <> FNempty_hashmap
 472     IF S$(Z%(map%,2)) = key$ THEN =TRUE
 473     map% = Z%(map%,1)
 474   ENDWHILE
 475 =FALSE
 476
 477 DEF FNhashmap_first_key(map%)
 478   IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap"
 479 =S$(Z%(map%,2))
 480
 481 DEF FNhashmap_first_val(map%)
 482   IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap"
 483 =Z%(map%,3)
 484
 485 DEF FNhashmap_rest(map%)
 486   IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get rest of a non-hashmap"
 487 =Z%(map%,1)
 488
 489 REM ** Functions **
 490
 491 REM  Z%(x,0) AND &80 = is_macro flag
 492 REM  Z%(x,1) = index in Z%() of ast
 493 REM  Z%(x,2) = index in Z%() of params
 494 REM  Z%(x,3) = index in Z%() of env
 495
 496 DEF FNis_fn(val%)
 497 =FNtype_of(val%) = 10
 498
 499 DEF FNis_nonmacro_fn(val%)
 500 =FNtype_of(val%) = 10 AND (Z%(val%, 0) AND &80) = &00
 501
 502 DEF FNis_macro(val%)
 503 =FNtype_of(val%) = 10 AND (Z%(val%, 0) AND &80) = &80
 504
 505 DEF FNalloc_fn(ast%, params%, env%)
 506   LOCAL val%
 507   val% = FNmalloc(10)
 508   Z%(val%,1) = ast%
 509   Z%(val%,2) = params%
 510   Z%(val%,3) = env%
 511 =val%
 512
 513 DEF PROCmake_macro(val%)
 514   IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function"
 515   Z%(val%, 0) = Z%(val%, 0) OR &80
 516 ENDPROC
 517
 518 DEF PROCgc_mark_fn(val%)
 519   PROCgc_mark(Z%(val%,1))
 520   PROCgc_mark(Z%(val%,2))
 521   PROCgc_mark(Z%(val%,3))
 522 ENDPROC
 523
 524 DEF FNfn_ast(val%)
 525   IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function"
 526 =FNref_local(Z%(val%,1))
 527
 528 DEF FNfn_params(val%)
 529   IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function"
 530 =FNref_local(Z%(val%,2))
 531
 532 DEF FNfn_env(val%)
 533   IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function"
 534 =FNref_local(Z%(val%,3))
 535
 536 REM ** Atoms **
 537
 538 REM Z%(x,1) = index in Z% of current referent
 539
 540 DEF FNis_atom(val%)
 541 =FNtype_of(val%) = 12
 542
 543 DEF FNalloc_atom(contents%)
 544   LOCAL val%
 545   val% = FNmalloc(12)
 546   Z%(val%,1) = contents%
 547 =val%
 548
 549 DEF PROCgc_mark_atom(val%)
 550   PROCgc_mark(Z%(val%,1))
 551 ENDPROC
 552
 553 DEF FNatom_deref(val%)
 554 =FNref_local(Z%(val%,1))
 555
 556 DEF PROCatom_reset(val%, contents%)
 557   Z%(val%,1) = contents%
 558 ENDPROC
 559
 560 REM ** Environments **
 561
 562 REM  Z%(x,1) = index in Z% of hash-map
 563 REM  Z%(x,2) = index in Z% of outer environment
 564
 565 DEF FNis_environment(val%)
 566 =FNtype_of(val%) = 13
 567
 568 DEF FNalloc_environment(outer%)
 569   LOCAL val%
 570   val% = FNmalloc(13)
 571   Z%(val%,1) = FNempty_hashmap
 572   Z%(val%,2) = outer%
 573 =val%
 574
 575 DEF PROCgc_mark_environment(val%)
 576   PROCgc_mark(Z%(val%,1))
 577   PROCgc_mark(Z%(val%,2))
 578 ENDPROC
 579
 580 DEF FNenvironment_data(val%)
 581   IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment"
 582 =FNref_local(Z%(val%,1))
 583
 584 DEF PROCenvironment_set_data(val%, data%)
 585   IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment"
 586   Z%(val%,1) = data%
 587 ENDPROC
 588
 589 DEF FNenvironment_outer(val%)
 590   IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment"
 591 =FNref_local(Z%(val%,2))
 592
 593 REM Local Variables:
 594 REM indent-tabs-mode: nil
 595 REM End: