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 and other small amounts of
  20 REM  information.  The bottom 2 bits indicate the semantics of Z%(x,1):
  21
  22 REM  &01 : Z%(x,1) is a pointer into Z%()
  23 REM  &02 : Z%(x,1) is a pointer into S$()
  24
  25 REM  Z%(x,2) and Z%(x,3) are always pointers into Z%(), to 'nil' if nothing
  26 REM  else.
  27
  28 REM  The &40 bit is used to distinguish empty lists, vectors and hash-maps.
  29 REM  The &80 bit distinguishes vectors from lists and macros from functions.
  30
  31 REM  sS%() is a shadow stack, used to keep track of which mal values might
  32 REM  be referenced from local variables at a given depth of the BASIC call
  33 REM  stack.  It grows upwards.  sSP% points to the first unused word.  sFP%
  34 REM  points to the start of the current shadow stack frame.  The first word
  35 REM  of each shadow stack frame is the saved value of sFP%.  The rest are
  36 REM  mal values.
  37
  38 REM  Types are:
  39 REM  &00  nil
  40 REM  &04  boolean
  41 REM  &08  integer
  42 REM  &0C  core function
  43 REM  &01  atom
  44 REM  &05  free block
  45 REM  &09  list/vector (each object is a cons cell)
  46 REM  &0D  environment
  47 REM  &11  hash-map internal node
  48 REM  &15  mal function (first part)
  49 REM  &19  mal function (second part)
  50 REM  &02  string/keyword
  51 REM  &06  symbol
  52 REM  &0A  hash-map leaf node
  53
  54 REM  Formats of individual objects are defined below.
  55
  56 DEF PROCtypes_init
  57   REM  Arbitrarily use a quarter of BASIC's heap as the mal heap, with a bit
  58   REM  more for strings.  Each heap entry is sixteen bytes.
  59   DIM Z%((HIMEM-LOMEM)/64,3)
  60   DIM S$((HIMEM-LOMEM)/128), S%((HIMEM-LOMEM)/128)
  61   DIM sS%((HIMEM-LOMEM)/64)
  62   Z%(1,0) = &04 : REM false
  63   Z%(2,0) = &04 : Z%(2,1) = TRUE : REM true
  64   Z%(3,0) = &49 : Z%(3,1) = 3 : REM empty list
  65   Z%(4,0) = &C9 : Z%(4,1) = 4 : REM empty vector
  66   Z%(5,0) = &51 : REM empty hashmap
  67   next_Z% = 6
  68   next_S% = 0
  69   sSP% = 1
  70   sFP% = 0
  71   F% = 0
  72   SF% = 0
  73 ENDPROC
  74
  75 DEF FNtype_of(val%)
  76 =Z%(val%,0) AND &1F
  77
  78 DEF PROCgc_enter
  79   REM PRINT ;sFP%;
  80   sS%(sSP%) = sFP%
  81   sFP% = sSP%
  82   sSP% += 1
  83   REM PRINT " >>> ";sFP%
  84 ENDPROC
  85
  86 REM  FNgc_save is equivalent to PROCgc_enter except that it returns a
  87 REM  value that can be passed to PROCgc_restore to pop all the stack
  88 REM  frames back to (and including) the one pushed by FNgc_save.
  89 DEF FNgc_save
  90   PROCgc_enter
  91 =sFP%
  92
  93 DEF PROCgc_exit
  94   REM PRINT ;sS%(sFP%);" <<< ";sFP%
  95   sSP% = sFP%
  96   sFP% = sS%(sFP%)
  97 ENDPROC
  98
  99 DEF PROCgc_restore(oldFP%)
 100   sFP% = oldFP%
 101   REM PRINT "!!! FP reset"
 102   PROCgc_exit
 103 ENDPROC
 104
 105 DEF FNref_local(val%)
 106   sS%(sSP%) = val%
 107   sSP% += 1
 108 =val%
 109
 110 DEF FNgc_exit(val%)
 111   PROCgc_exit
 112 =FNref_local(val%)
 113
 114 DEF FNgc_restore(oldFP%, val%)
 115   PROCgc_restore(oldFP%)
 116 =FNref_local(val%)
 117
 118 DEF PROCgc_keep_only2(val1%, val2%)
 119   PROCgc_exit
 120   PROCgc_enter
 121   val1% = FNref_local(val1%)
 122   val2% = FNref_local(val2%)
 123 ENDPROC
 124
 125 DEF FNmalloc(type%)
 126   LOCAL val%
 127   REM  If the heap is full, collect garbage first.
 128   IF F% = 0 AND next_Z% > DIM(Z%(),1) THEN PROCgc
 129   IF F% <> 0 THEN
 130     val% = F%
 131     F% = Z%(val%,1)
 132   ELSE
 133     val% = next_Z%
 134     next_Z% += 1
 135   ENDIF
 136   Z%(val%,0) = type%
 137 =FNref_local(val%)
 138
 139 DEF FNsalloc(s$)
 140   LOCAL val%
 141   IF SF% <> 0 THEN
 142     val% = SF%
 143     SF% = S%(val%)
 144   ELSE
 145     val% = next_S%
 146     next_S% += 1
 147   ENDIF
 148   S$(val%) = s$
 149 =val%
 150
 151 DEF PROCfree(val%)
 152   IF (Z%(val%,0) AND &02) THEN PROCsfree(Z%(val%,1))
 153   Z%(val%,0) = &05
 154   Z%(val%,1) = F%
 155   Z%(val%,2) = 0
 156   Z%(val%,3) = 0
 157   F% = val%
 158 ENDPROC
 159
 160 DEF PROCsfree(val%)
 161   S$(val%) = ""
 162   S%(val%) = SF%
 163   SF% = val%
 164 ENDPROC
 165
 166 DEF PROCgc
 167   REM PRINT "** START GC **"
 168   PROCgc_markall
 169   PROCgc_sweep
 170   REM PRINT "** FINISH GC **"
 171 ENDPROC
 172
 173 DEF PROCgc_markall
 174   LOCAL sp%, fp%
 175   fp% = sFP%
 176   REM PRINT ">>marking...";
 177   FOR sp% = sSP% - 1 TO 0 STEP -1
 178     IF sp% = fp% THEN
 179       fp% = sS%(sp%)
 180       REM PRINT " / ";
 181     ELSE PROCgc_mark(sS%(sp%))
 182     ENDIF
 183   NEXT sp%
 184   REM PRINT
 185 ENDPROC
 186
 187 DEF PROCgc_mark(val%)
 188   IF (Z%(val%,0) AND &100) = 0 THEN
 189     REM PRINT " ";val%;
 190     Z%(val%,0) += &100
 191     IF (Z%(val%,0) AND &01) THEN PROCgc_mark(Z%(val%,1))
 192     PROCgc_mark(Z%(val%,2))
 193     PROCgc_mark(Z%(val%,3))
 194   ENDIF
 195 ENDPROC
 196
 197 DEF PROCgc_sweep
 198   LOCAL val%
 199   REM PRINT ">>sweeping ...";
 200   FOR val% = 6 TO next_Z% - 1
 201     IF FNtype_of(val%) <> &05 AND (Z%(val%,0) AND &100) = 0 THEN
 202       REM PRINT " ";val%;
 203       PROCfree(val%)
 204     ELSE
 205       Z%(val%,0) -= &100
 206     ENDIF
 207   NEXT val%
 208   REM PRINT
 209 ENDPROC
 210
 211 DEF FNmeta(val%)
 212 =Z%(val%,3)
 213
 214 DEF FNwith_meta(val%, meta%)
 215   LOCAL newval%
 216   newval% = FNmalloc(Z%(val%,0))
 217   Z%(newval%,1) = Z%(val%,1)
 218   Z%(newval%,2) = Z%(val%,2)
 219   Z%(newval%,3) = meta%
 220 =newval%
 221
 222 REM ** Nil **
 223
 224 DEF FNis_nil(val%)
 225 =FNtype_of(val%) = 0
 226
 227 DEF FNnil
 228 =0
 229
 230 REM ** Boolean **
 231
 232 REM  Z%(x,1) = TRUE or FALSE
 233
 234 DEF FNis_boolean(val%)
 235 =FNtype_of(val%) = &04
 236
 237 DEF FNalloc_boolean(bval%)
 238   IF bval% THEN =2
 239 =1
 240
 241 DEF FNunbox_boolean(val%)
 242   IF NOT FNis_boolean(val%) THEN ERROR &40E80911, "Not a boolean"
 243 =Z%(val%,1)
 244
 245 DEF FNis_truish(val%)
 246   IF FNis_nil(val%) THEN =FALSE
 247   IF FNis_boolean(val%) THEN =FNunbox_boolean(val%)
 248 =TRUE
 249
 250 REM ** Integers **
 251
 252 REM  Z%(x,1) = integer value
 253
 254 DEF FNis_int(val%)
 255 =FNtype_of(val%) = &08
 256
 257 DEF FNalloc_int(ival%)
 258   LOCAL val%
 259   val% = FNmalloc(&08)
 260   Z%(val%,1) = ival%
 261 =val%
 262
 263 DEF FNunbox_int(val%)
 264   IF NOT FNis_int(val%) THEN ERROR &40E80912, "Not an integer"
 265 =Z%(val%,1)
 266
 267 REM ** Strings and keywords **
 268
 269 REM  A keyword is a string with first character CHR$(127).
 270
 271 DEF FNis_string(val%)
 272 =FNtype_of(val%) = &02
 273
 274 DEF FNalloc_string(sval$)
 275   LOCAL val%
 276   val% = FNmalloc(&02)
 277   Z%(val%,1) = FNsalloc(sval$)
 278 =val%
 279
 280 DEF FNunbox_string(val%)
 281   IF NOT FNis_string(val%) THEN ERROR &40E80914, "Not a string"
 282 =S$(Z%(val%,1))
 283
 284 REM ** Symbols **
 285
 286 REM  Z%(x,1) = index in S$() of the value of the symbol
 287
 288 DEF FNis_symbol(val%)
 289 =FNtype_of(val%) = &06
 290
 291 DEF FNalloc_symbol(sval$)
 292   LOCAL val%
 293   val% = FNmalloc(&06)
 294   Z%(val%,1) = FNsalloc(sval$)
 295 =val%
 296
 297 DEF FNunbox_symbol(val%)
 298   IF NOT FNis_symbol(val%) THEN ERROR &40E80915, "Not a symbol"
 299 =S$(Z%(val%,1))
 300
 301 REM ** Lists and vectors **
 302
 303 REM  Lists and vectors are both represented as linked lists: the only
 304 REM  difference is in the state of the is_vector flag in the head cell
 305 REM  of the list.  Note that this means that the tail of a list may be
 306 REM  a vector, and vice versa.  FNas_list and FNas_vector can be used
 307 REM  to convert a sequence to a particular type as necessary.
 308
 309 REM  Z%(x,0) AND &80 = is_vector flag
 310 REM  Z%(x,1) = index in Z%() of next pair
 311 REM  Z%(x,2) = index in Z%() of first element
 312
 313 REM  The empty list is a distinguished value, with elements that match
 314 REM  the spec of 'first' and 'rest'.
 315
 316 DEF FNempty
 317 =3
 318
 319 DEF FNempty_vector
 320 =4
 321
 322 DEF FNalloc_pair(car%, cdr%)
 323   LOCAL val%
 324   val% = FNmalloc(&09)
 325   Z%(val%,2) = car%
 326   Z%(val%,1) = cdr%
 327 =val%
 328
 329 DEF FNalloc_vector_pair(car%, cdr%)
 330   LOCAL val%
 331   val% = FNalloc_pair(car%, cdr%)
 332   Z%(val%,0) = Z%(val%,0) OR &80
 333 =val%
 334
 335 DEF FNis_empty(val%)
 336 =(Z%(val%,0) AND &40) = &40
 337
 338 DEF FNis_seq(val%)
 339 =FNtype_of(val%) = &09
 340
 341 DEF FNis_list(val%)
 342 =FNtype_of(val%) = &09 AND (Z%(val%, 0) AND &80) = &00
 343
 344 DEF FNis_vector(val%)
 345 =FNtype_of(val%) = &09 AND (Z%(val%, 0) AND &80) = &80
 346
 347 DEF FNas_list(val%)
 348   IF FNis_list(val%) THEN =val%
 349   IF FNis_empty(val%) THEN =FNempty
 350 =FNalloc_pair(FNfirst(val%), FNrest(val%))
 351
 352 DEF FNas_vector(val%)
 353   IF FNis_vector(val%) THEN =val%
 354   IF FNis_empty(val%) THEN =FNempty_vector
 355 =FNalloc_vector_pair(FNfirst(val%), FNrest(val%))
 356
 357 DEF FNfirst(val%)
 358   IF NOT FNis_seq(val%) THEN ERROR &40E80916, "Can't get car of non-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 =FNref_local(Z%(val%,1))
 364
 365 DEF FNalloc_list2(val0%, val1%)
 366   =FNalloc_pair(val0%, FNalloc_pair(val1%, FNempty))
 367
 368 DEF FNalloc_list3(val0%, val1%, val2%)
 369   =FNalloc_pair(val0%, FNalloc_pair(val1%, FNalloc_pair(val2%, FNempty)))
 370
 371 DEF FNcount(val%)
 372   LOCAL i%
 373   WHILE NOT FNis_empty(val%)
 374     val% = FNrest(val%)
 375     i% += 1
 376   ENDWHILE
 377 = i%
 378
 379 DEF FNnth(val%, n%)
 380   WHILE n% > 0
 381     IF FNis_empty(val%) THEN ERROR &40E80923, "Subscript out of range"
 382     val% = FNrest(val%)
 383     n% -= 1
 384   ENDWHILE
 385   IF FNis_empty(val%) THEN ERROR &40E80923, "Subscript out of range"
 386 =FNfirst(val%)
 387
 388 REM ** Core functions **
 389
 390 REM  Z%(x,1) = index of function in FNcore_call
 391
 392 DEF FNis_corefn(val%)
 393 =FNtype_of(val%) = &0C
 394
 395 DEF FNalloc_corefn(fn%)
 396   LOCAL val%
 397   val% = FNmalloc(&0C)
 398   Z%(val%,1) = fn%
 399 =val%
 400
 401 DEF FNunbox_corefn(val%)
 402   IF NOT FNis_corefn(val%) THEN ERROR &40E80919, "Not a core function"
 403 =Z%(val%,1)
 404
 405 REM ** Hash-maps **
 406
 407 REM  Hash-maps are represented as a crit-bit tree.
 408
 409 REM  An internal node has:
 410 REM  Z%(x,0) >> 16 = next bit of key to check
 411 REM  Z%(x,1) = index in Z%() of left child (if next bit of key is 0)
 412 REM  Z%(x,2) = index in Z%() of right child (if next bit of key is 1)
 413
 414 REM  A leaf node has
 415 REM  Z%(x,1) = index in S$() of key
 416 REM  Z%(x,2) = index in Z%() of value
 417
 418 REM  The empty hash-map is a special value containing no data.
 419
 420 DEF FNempty_hashmap
 421 =5
 422
 423 DEF FNhashmap_alloc_leaf(key$, val%)
 424   LOCAL entry%
 425   entry% = FNmalloc(&0A)
 426   Z%(entry%,1) = FNsalloc(key$)
 427   Z%(entry%,2) = val%
 428 =entry%
 429
 430 DEF FNhashmap_alloc_node(bit%, left%, right%)
 431   LOCAL entry%
 432   entry% = FNmalloc(&11)
 433   Z%(entry%,0) += (bit% << 16)
 434   Z%(entry%,1) = left%
 435   Z%(entry%,2) = right%
 436 =entry%
 437
 438 DEF FNis_hashmap(val%)
 439   LOCAL t%
 440   t% = FNtype_of(val%)
 441 =t% = &11 OR t% = &0A
 442
 443 DEF FNkey_bit(key$, bit%)
 444   LOCAL cnum%
 445   cnum% = bit% >> 3
 446   IF cnum% >= LEN(key$) THEN =FALSE
 447 =ASC(MID$(key$, cnum% + 1, 1)) AND (1 << (bit% AND 7))
 448
 449 DEF FNkey_bitdiff(key1$, key2$)
 450   LOCAL bit%
 451   WHILE FNkey_bit(key1$, bit%) = FNkey_bit(key2$, bit%)
 452     bit% += 1
 453   ENDWHILE
 454 =bit%
 455
 456 DEF FNhashmap_set(map%, key$, val%)
 457   LOCAL bit%, left%, right%
 458   IF FNis_empty(map%) THEN =FNhashmap_alloc_leaf(key$, val%)
 459   IF FNtype_of(map%) = &0A THEN
 460     IF S$(Z%(map%,1)) = key$ THEN =FNhashmap_alloc_leaf(key$, val%)
 461     bit% = FNkey_bitdiff(key$, S$(Z%(map%,1)))
 462     IF FNkey_bit(key$, bit%) THEN
 463       left% = map%
 464       right% = FNhashmap_alloc_leaf(key$, val%)
 465     ELSE
 466       right% = map%
 467       left% = FNhashmap_alloc_leaf(key$, val%)
 468     ENDIF
 469     =FNhashmap_alloc_node(bit%, left%, right%)
 470   ENDIF
 471   IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN
 472     =FNhashmap_alloc_node(Z%(map%,0)>>16, Z%(map%,1), FNhashmap_set(Z%(map%,2), key$, val%))
 473   ELSE
 474     =FNhashmap_alloc_node(Z%(map%,0)>>16, FNhashmap_set(Z%(map%,1), key$, val%), Z%(map%,2))
 475   ENDIF
 476
 477 DEF FNhashmap_remove(map%, key$)
 478   LOCAL child%
 479   IF FNis_empty(map%) THEN =map%
 480   IF FNtype_of(map%) = &0A THEN
 481     IF S$(Z%(map%,1)) = key$ THEN =FNempty_hashmap
 482   ENDIF
 483   IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN
 484     child% = FNhashmap_remove(Z%(map%,2), key$)
 485     IF FNis_empty(child%) THEN =Z%(map%,1)
 486     =FNhashmap_alloc_node(Z%(map%,0)>>16, Z%(map%,1), child%)
 487   ELSE
 488     child% = FNhashmap_remove(Z%(map%,1), key$)
 489     IF FNis_empty(child%) THEN =Z%(map%,2)
 490     =FNhashmap_alloc_node(Z%(map%,0)>>16, child%, Z%(map%,2))
 491   ENDIF
 492
 493
 494 DEF FNhashmap_get(map%, key$)
 495   IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap"
 496   IF FNis_empty(map%) THEN =FNnil
 497   IF FNtype_of(map%) = &0A THEN
 498     IF S$(Z%(map%,1)) = key$ THEN =FNref_local(Z%(map%,2)) ELSE =FNnil
 499   ENDIF
 500   IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN =FNhashmap_get(Z%(map%,2), key$)
 501 =FNhashmap_get(Z%(map%,1), key$)
 502
 503 DEF FNhashmap_contains(map%, key$)
 504   IF NOT FNis_hashmap(map%) THEN ERROR &40E80918, "Can't get item from a non-hashmap"
 505   IF FNis_empty(map%) THEN =FALSE
 506   IF FNtype_of(map%) = &0A THEN
 507     IF S$(Z%(map%,1)) = key$ THEN =TRUE ELSE =FALSE
 508   ENDIF
 509   IF FNkey_bit(key$, Z%(map%,0) >> 16) THEN =FNhashmap_contains(Z%(map%,2), key$)
 510 =FNhashmap_contains(Z%(map%,1), key$)
 511
 512 DEF FNhashmap_keys(map%)
 513 =FNhashmap_keys1(map%, FNempty)
 514
 515 DEF FNhashmap_keys1(map%, acc%)
 516   REM PROChashmap_dump(map%)
 517   IF FNis_empty(map%) THEN =acc%
 518   IF FNtype_of(map%) = &0A THEN
 519     =FNalloc_pair(FNalloc_string(S$(Z%(map%,1))), acc%)
 520   ENDIF
 521 =FNhashmap_keys1(Z%(map%,2), FNhashmap_keys1(Z%(map%,1), acc%))
 522
 523 DEF FNhashmap_vals(map%)
 524 =FNhashmap_vals1(map%, FNempty)
 525
 526 DEF FNhashmap_vals1(map%, acc%)
 527   REM PROChashmap_dump(map%)
 528   IF FNis_empty(map%) THEN =acc%
 529   IF FNtype_of(map%) = &0A THEN
 530     =FNalloc_pair(Z%(map%,2), acc%)
 531   ENDIF
 532 =FNhashmap_vals1(Z%(map%,2), FNhashmap_vals1(Z%(map%,1), acc%))
 533
 534 DEF PROChashmap_dump(map%)
 535   IF FNis_empty(map%) THEN
 536     PRINT "[empty]"
 537   ELSE
 538     PRINT "[-----]"
 539     PROChashmap_dump_internal(map%, "")
 540   ENDIF
 541 ENDPROC
 542
 543 DEF PROChashmap_dump_internal(map%, prefix$)
 544   IF FNtype_of(map%) = &0A PRINT prefix$;S$(Z%(map%,1))
 545   IF FNtype_of(map%) = &11 THEN
 546     PRINT prefix$;"<";Z%(map%,0) >> 16;">"
 547     PROChashmap_dump_internal(Z%(map%,1), prefix$ + "L ")
 548     PROChashmap_dump_internal(Z%(map%,2), prefix$ + "R ")
 549   ENDIF
 550 ENDPROC
 551
 552 REM ** Functions **
 553
 554 REM  A function is represented by two cells:
 555 REM  Z%(x,0) AND &80 = is_macro flag
 556 REM  Z%(x,1) = index in Z%() of ast
 557 REM  Z%(x,2) = y
 558
 559 REM  Z%(y,1) = index in Z%() of params
 560 REM  Z%(y,2) = index in Z%() of env
 561
 562 DEF FNis_fn(val%)
 563 =FNtype_of(val%) = &15
 564
 565 DEF FNis_nonmacro_fn(val%)
 566 =FNtype_of(val%) = &15 AND (Z%(val%, 0) AND &80) = &00
 567
 568 DEF FNis_macro(val%)
 569 =FNtype_of(val%) = &15 AND (Z%(val%, 0) AND &80) = &80
 570
 571 DEF FNalloc_fn(ast%, params%, env%)
 572   LOCAL val1%, val2%
 573   val1% = FNmalloc(&15)
 574   Z%(val1%,1) = ast%
 575   val2% = FNmalloc(&19)
 576   Z%(val1%,2) = val2%
 577   Z%(val2%,1) = params%
 578   Z%(val2%,2) = env%
 579 =val1%
 580
 581 DEF FNas_macro(val%)
 582   IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function"
 583   LOCAL newval%
 584   newval% = FNmalloc(Z%(val%,0) OR &80)
 585   Z%(newval%,1) = Z%(val%,1)
 586   Z%(newval%,2) = Z%(val%,2)
 587   Z%(newval%,3) = Z%(val%,3)
 588 =newval%
 589
 590 DEF FNfn_ast(val%)
 591   IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function"
 592 =FNref_local(Z%(val%,1))
 593
 594 DEF FNfn_params(val%)
 595   IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function"
 596 =FNref_local(Z%(Z%(val%,2),1))
 597
 598 DEF FNfn_env(val%)
 599   IF NOT FNis_fn(val%) THEN ERROR &40E8091A, "Not a function"
 600 =FNref_local(Z%(Z%(val%,2),2))
 601
 602 REM ** Atoms **
 603
 604 REM Z%(x,1) = index in Z% of current referent
 605
 606 DEF FNis_atom(val%)
 607 =FNtype_of(val%) = &01
 608
 609 DEF FNalloc_atom(contents%)
 610   LOCAL val%
 611   val% = FNmalloc(&01)
 612   Z%(val%,1) = contents%
 613 =val%
 614
 615 DEF FNatom_deref(val%)
 616 =FNref_local(Z%(val%,1))
 617
 618 DEF PROCatom_reset(val%, contents%)
 619   Z%(val%,1) = contents%
 620 ENDPROC
 621
 622 REM ** Environments **
 623
 624 REM  Z%(x,1) = index in Z% of hash-map
 625 REM  Z%(x,2) = index in Z% of outer environment
 626
 627 DEF FNis_environment(val%)
 628 =FNtype_of(val%) = &0D
 629
 630 DEF FNalloc_environment(outer%)
 631   LOCAL val%
 632   val% = FNmalloc(&0D)
 633   Z%(val%,1) = FNempty_hashmap
 634   Z%(val%,2) = outer%
 635 =val%
 636
 637 DEF FNenvironment_data(val%)
 638   IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment"
 639 =FNref_local(Z%(val%,1))
 640
 641 DEF PROCenvironment_set_data(val%, data%)
 642   IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment"
 643   Z%(val%,1) = data%
 644 ENDPROC
 645
 646 DEF FNenvironment_outer(val%)
 647   IF NOT FNis_environment(val%) THEN ERROR &40E8091D, "Not an environment"
 648 =FNref_local(Z%(val%,2))
 649
 650 REM Local Variables:
 651 REM indent-tabs-mode: nil
 652 REM End: