basic/core.in.bas

   1 REM APPLY should really be in types.in.bas but it is here because it
   2 REM calls DO_TCO_FUNCTION so it will cause syntax errors for steps1-3
   3 REM if it is in types.in.bas because there are unresolved labels.
   4
   5 REM APPLY(F, AR) -> R
   6 REM   - restores E
   7 REM   - call using GOTO and with return label/address on the stack
   8 SUB APPLY
   9   REM if metadata, get the actual object
  10   IF (Z%(F,0)AND31)>=16 THEN F=Z%(F,1)
  11
  12   IF (Z%(F,0)AND31)=9 THEN GOTO APPLY_FUNCTION
  13   IF (Z%(F,0)AND31)=10 THEN GOTO APPLY_MAL_FUNCTION
  14   IF (Z%(F,0)AND31)=11 THEN GOTO APPLY_MAL_FUNCTION
  15
  16   APPLY_FUNCTION:
  17     REM regular function
  18     IF Z%(F,1)<60 THEN GOSUB DO_FUNCTION:GOTO APPLY_DONE
  19     REM for recur functions (apply, map, swap!), use GOTO
  20     IF Z%(F,1)>60 THEN CALL DO_TCO_FUNCTION
  21     GOTO APPLY_DONE
  22
  23   APPLY_MAL_FUNCTION:
  24     X=X+1:X%(X)=E: REM save the current environment
  25
  26     REM create new environ using env and params stored in the
  27     REM function and bind the params to the apply arguments
  28     O=Z%(F+1,1):BI=Z%(F+1,0):EX=AR:GOSUB ENV_NEW_BINDS
  29
  30     A=Z%(F,1):E=R:CALL EVAL
  31
  32     AY=E:GOSUB RELEASE: REM release the new environment
  33
  34     E=X%(X):X=X-1: REM pop/restore the saved environment
  35
  36   APPLY_DONE:
  37 END SUB
  38
  39
  40 REM DO_TCO_FUNCTION(F, AR)
  41 SUB DO_TCO_FUNCTION
  42   FF=Z%(F,1)
  43
  44   REM Get argument values
  45   R=AR+1:GOSUB DEREF_R:AA=R
  46   R=Z%(AR,1)+1:GOSUB DEREF_R:AB=R
  47
  48   ON FF-60 GOTO DO_APPLY,DO_MAP,DO_SWAP_BANG
  49
  50   DO_APPLY:
  51     F=AA
  52     AR=Z%(AR,1)
  53     A=AR:GOSUB COUNT:R4=R
  54
  55     A=Z%(AR+1,1)
  56     REM no intermediate args, but not a list, so convert it first
  57     IF R4<=1 AND (Z%(A,0)AND31)<>6 THEN T=6:GOSUB FORCE_SEQ_TYPE:GOTO DO_APPLY_2
  58     REM no intermediate args, just call APPLY directly
  59     IF R4<=1 THEN GOTO DO_APPLY_1
  60
  61     REM prepend intermediate args to final args element
  62     A=AR:B=0:C=R4-1:GOSUB SLICE
  63     REM release the terminator of new list (we skip over it)
  64     AY=Z%(R6,1):GOSUB RELEASE
  65     REM attach end of slice to final args element
  66     Z%(R6,1)=Z%(A+1,1)
  67     Z%(Z%(A+1,1),0)=Z%(Z%(A+1,1),0)+32
  68
  69     GOTO DO_APPLY_2
  70
  71     DO_APPLY_1:
  72       AR=A:CALL APPLY
  73
  74       GOTO DO_TCO_FUNCTION_DONE
  75
  76     DO_APPLY_2:
  77       X=X+1:X%(X)=R: REM push/save new args for release
  78
  79       AR=R:CALL APPLY
  80
  81       AY=X%(X):X=X-1:GOSUB RELEASE: REM pop/release new args
  82       GOTO DO_TCO_FUNCTION_DONE
  83
  84   DO_MAP:
  85     F=AA
  86
  87     REM first result list element
  88     T=6:L=0:N=0:GOSUB ALLOC
  89
  90     REM push future return val, prior entry, F and AB
  91     X=X+4:X%(X-3)=R:X%(X-2)=0:X%(X-1)=F:X%(X)=AB
  92
  93     DO_MAP_LOOP:
  94       REM set previous to current if not the first element
  95       IF X%(X-2)<>0 THEN Z%(X%(X-2),1)=R
  96       REM update previous reference to current
  97       X%(X-2)=R
  98
  99       IF Z%(AB,1)=0 THEN GOTO DO_MAP_DONE
 100
 101       REM create argument list for apply call
 102       Z%(3,0)=Z%(3,0)+32
 103       REM inc ref cnt of referred argument
 104       T=6:L=3:N=Z%(AB+1,1):GOSUB ALLOC
 105
 106       REM push argument list
 107       X=X+1:X%(X)=R
 108
 109       AR=R:CALL APPLY
 110
 111       REM pop apply args are release them
 112       AY=X%(X):X=X-1:GOSUB RELEASE
 113
 114       REM set the result value
 115       Z%(X%(X-2)+1,1)=R
 116
 117       REM restore F
 118       F=X%(X-1)
 119
 120       REM update AB to next source element
 121       X%(X)=Z%(X%(X),1)
 122       AB=X%(X)
 123
 124       REM allocate next element
 125       T=6:L=0:N=0:GOSUB ALLOC
 126
 127       GOTO DO_MAP_LOOP
 128
 129     DO_MAP_DONE:
 130       REM get return val
 131       R=X%(X-3)
 132       REM pop everything off stack
 133       X=X-4
 134       GOTO DO_TCO_FUNCTION_DONE
 135
 136
 137   DO_SWAP_BANG:
 138     F=AB
 139
 140     REM add atom to front of the args list
 141     T=6:L=Z%(Z%(AR,1),1):N=Z%(AA,1):GOSUB ALLOC: REM cons
 142     AR=R
 143
 144     REM push args for release after
 145     X=X+1:X%(X)=AR
 146
 147     REM push atom
 148     X=X+1:X%(X)=AA
 149
 150     CALL APPLY
 151
 152     REM pop atom
 153     AA=X%(X):X=X-1
 154
 155     REM pop and release args
 156     AY=X%(X):X=X-1:GOSUB RELEASE
 157
 158     REM use reset to update the value
 159     AB=R:GOSUB DO_RESET_BANG
 160
 161     REM but decrease ref cnt of return by 1 (not sure why)
 162     AY=R:GOSUB RELEASE
 163
 164     GOTO DO_TCO_FUNCTION_DONE
 165
 166   DO_TCO_FUNCTION_DONE:
 167 END SUB
 168
 169
 170 REM DO_FUNCTION(F, AR)
 171 DO_FUNCTION:
 172   REM Get the function number
 173   FF=Z%(F,1)
 174
 175   REM Get argument values
 176   R=AR+1:GOSUB DEREF_R:AA=R
 177   R=Z%(AR,1)+1:GOSUB DEREF_R:AB=R
 178
 179   REM Switch on the function number
 180   IF FF>59 THEN ER=-1:ER$="unknown function"+STR$(FF):RETURN
 181   ON FF/10+1 GOTO DO_1_9,DO_10_19,DO_20_29,DO_30_39,DO_40_49,DO_50_56
 182
 183   DO_1_9:
 184   ON FF GOTO DO_EQUAL_Q,DO_THROW,DO_NIL_Q,DO_TRUE_Q,DO_FALSE_Q,DO_STRING_Q,DO_SYMBOL,DO_SYMBOL_Q,DO_KEYWORD
 185   DO_10_19:
 186   ON FF-9 GOTO DO_KEYWORD_Q,DO_PR_STR,DO_STR,DO_PRN,DO_PRINTLN,DO_READ_STRING,DO_READLINE,DO_SLURP,DO_LT,DO_LTE
 187   DO_20_29:
 188   ON FF-19 GOTO DO_GT,DO_GTE,DO_ADD,DO_SUB,DO_MULT,DO_DIV,DO_TIME_MS,DO_LIST,DO_LIST_Q,DO_VECTOR
 189   DO_30_39:
 190   ON FF-29 GOTO DO_VECTOR_Q,DO_HASH_MAP,DO_MAP_Q,DO_ASSOC,DO_THROW,DO_GET,DO_CONTAINS,DO_KEYS,DO_VALS,DO_SEQUENTIAL_Q
 191   DO_40_49:
 192   ON FF-39 GOTO DO_CONS,DO_CONCAT,DO_NTH,DO_FIRST,DO_REST,DO_EMPTY_Q,DO_COUNT,DO_THROW,DO_THROW,DO_WITH_META
 193   DO_50_56:
 194   ON FF-49 GOTO DO_META,DO_ATOM,DO_ATOM_Q,DO_DEREF,DO_RESET_BANG,DO_EVAL,DO_READ_FILE
 195
 196   DO_EQUAL_Q:
 197     A=AA:B=AB:GOSUB EQUAL_Q
 198     R=R+1
 199     RETURN
 200   DO_THROW:
 201     ER=AA
 202     Z%(ER,0)=Z%(ER,0)+32
 203     R=0
 204     RETURN
 205   DO_NIL_Q:
 206     R=1
 207     IF AA=0 THEN R=2
 208     RETURN
 209   DO_TRUE_Q:
 210     R=1
 211     IF AA=2 THEN R=2
 212     RETURN
 213   DO_FALSE_Q:
 214     R=1
 215     IF AA=1 THEN R=2
 216     RETURN
 217   DO_STRING_Q:
 218     R=1
 219     IF (Z%(AA,0)AND31)<>4 THEN RETURN
 220     IF MID$(S$(Z%(AA,1)),1,1)=CHR$(127) THEN RETURN
 221     R=2
 222     RETURN
 223   DO_SYMBOL:
 224     T=5:L=Z%(AA,1):GOSUB ALLOC
 225     RETURN
 226   DO_SYMBOL_Q:
 227     R=1
 228     IF (Z%(AA,0)AND31)=5 THEN R=2
 229     RETURN
 230   DO_KEYWORD:
 231     A=Z%(AA,1)
 232     AS$=S$(A)
 233     IF MID$(AS$,1,1)<>CHR$(127) THEN AS$=CHR$(127)+AS$
 234     GOSUB STRING_
 235     T=4:L=R:GOSUB ALLOC
 236     RETURN
 237   DO_KEYWORD_Q:
 238     R=1
 239     IF (Z%(AA,0)AND31)<>4 THEN RETURN
 240     IF MID$(S$(Z%(AA,1)),1,1)<>CHR$(127) THEN RETURN
 241     R=2
 242     RETURN
 243
 244   DO_PR_STR:
 245     AZ=AR:PR=1:SE$=" ":GOSUB PR_STR_SEQ
 246     AS$=R$:T=4:GOSUB STRING
 247     RETURN
 248   DO_STR:
 249     AZ=AR:PR=0:SE$="":GOSUB PR_STR_SEQ
 250     AS$=R$:T=4:GOSUB STRING
 251     RETURN
 252   DO_PRN:
 253     AZ=AR:PR=1:SE$=" ":GOSUB PR_STR_SEQ
 254     PRINT R$
 255     R=0
 256     RETURN
 257   DO_PRINTLN:
 258     AZ=AR:PR=0:SE$=" ":GOSUB PR_STR_SEQ
 259     PRINT R$
 260     R=0
 261     RETURN
 262   DO_READ_STRING:
 263     A$=S$(Z%(AA,1))
 264     GOSUB READ_STR
 265     RETURN
 266   DO_READLINE:
 267     A$=S$(Z%(AA,1)):GOSUB READLINE
 268     IF EOF=1 THEN EOF=0:R=0:RETURN
 269     AS$=R$:T=4:GOSUB STRING
 270     RETURN
 271   DO_SLURP:
 272     R$=""
 273     REM OPEN 1,8,2,S$(Z%(AA,1))+",SEQ,R"
 274     REM OPEN 1,8,2,S$(Z%(AA,1))
 275     OPEN 1,8,0,S$(Z%(AA,1))
 276     DO_SLURP_LOOP:
 277       A$=""
 278       GET#1,A$
 279       IF ASC(A$)=10 THEN R$=R$+CHR$(13)
 280       IF (ASC(A$)<>10) AND (A$<>"") THEN R$=R$+A$
 281       IF (ST AND 64) THEN GOTO DO_SLURP_DONE
 282       IF (ST AND 255) THEN ER=-1:ER$="File read error "+STR$(ST):RETURN
 283       GOTO DO_SLURP_LOOP
 284     DO_SLURP_DONE:
 285       CLOSE 1
 286       AS$=R$:T=4:GOSUB STRING
 287       RETURN
 288
 289   DO_LT:
 290     R=1
 291     IF Z%(AA,1)<Z%(AB,1) THEN R=2
 292     RETURN
 293   DO_LTE:
 294     R=1
 295     IF Z%(AA,1)<=Z%(AB,1) THEN R=2
 296     RETURN
 297   DO_GT:
 298     R=1
 299     IF Z%(AA,1)>Z%(AB,1) THEN R=2
 300     RETURN
 301   DO_GTE:
 302     R=1
 303     IF Z%(AA,1)>=Z%(AB,1) THEN R=2
 304     RETURN
 305
 306   DO_ADD:
 307     T=2:L=Z%(AA,1)+Z%(AB,1):GOSUB ALLOC
 308     RETURN
 309   DO_SUB:
 310     T=2:L=Z%(AA,1)-Z%(AB,1):GOSUB ALLOC
 311     RETURN
 312   DO_MULT:
 313     T=2:L=Z%(AA,1)*Z%(AB,1):GOSUB ALLOC
 314     RETURN
 315   DO_DIV:
 316     T=2:L=Z%(AA,1)/Z%(AB,1):GOSUB ALLOC
 317     RETURN
 318   DO_TIME_MS:
 319     T=2:L=INT((TI-BT)*16.667):GOSUB ALLOC
 320     RETURN
 321
 322   DO_LIST:
 323     R=AR
 324     Z%(R,0)=Z%(R,0)+32
 325     RETURN
 326   DO_LIST_Q:
 327     A=AA:GOSUB LIST_Q
 328     R=R+1: REM map to mal false/true
 329     RETURN
 330   DO_VECTOR:
 331     A=AR:T=7:GOSUB FORCE_SEQ_TYPE
 332     RETURN
 333   DO_VECTOR_Q:
 334     R=1
 335     IF (Z%(AA,0)AND31)=7 THEN R=2
 336     RETURN
 337   DO_HASH_MAP:
 338     A=AR:T=8:GOSUB FORCE_SEQ_TYPE
 339     RETURN
 340   DO_MAP_Q:
 341     R=1
 342     IF (Z%(AA,0)AND31)=8 THEN R=2
 343     RETURN
 344   DO_ASSOC:
 345     H=AA
 346     AR=Z%(AR,1)
 347     DO_ASSOC_LOOP:
 348       R=AR+1:GOSUB DEREF_R:K=R
 349       R=Z%(AR,1)+1:GOSUB DEREF_R:V=R
 350       Z%(H,0)=Z%(H,0)+32
 351       GOSUB ASSOC1:H=R
 352       AR=Z%(Z%(AR,1),1)
 353       IF AR=0 OR Z%(AR,1)=0 THEN RETURN
 354       GOTO DO_ASSOC_LOOP
 355   DO_GET:
 356     IF AA=0 THEN R=0:RETURN
 357     H=AA:K=AB:GOSUB HASHMAP_GET
 358     GOSUB DEREF_R
 359     Z%(R,0)=Z%(R,0)+32
 360     RETURN
 361   DO_CONTAINS:
 362     H=AA:K=AB:GOSUB HASHMAP_CONTAINS
 363     R=R+1
 364     RETURN
 365   DO_KEYS:
 366     GOTO DO_KEYS_VALS
 367   DO_VALS:
 368     AA=Z%(AA,1)
 369   DO_KEYS_VALS:
 370     REM first result list element
 371     T=6:L=0:N=0:GOSUB ALLOC:T2=R
 372
 373     DO_KEYS_VALS_LOOP:
 374       IF AA=0 OR Z%(AA,1)=0 THEN R=T2:RETURN
 375
 376       REM copy the value
 377       T1=Z%(AA+1,1)
 378       REM inc ref cnt of referred argument
 379       Z%(T1,0)=Z%(T1,0)+32
 380       Z%(R+1,1)=T1
 381
 382       T1=R: REM save previous
 383       REM allocate next element
 384       T=6:L=0:N=0:GOSUB ALLOC
 385       REM point previous element to this one
 386       Z%(T1,1)=R
 387
 388       IF Z%(Z%(AA,1),1)=0 THEN R=T2:RETURN
 389
 390       AA=Z%(Z%(AA,1),1)
 391
 392       GOTO DO_KEYS_VALS_LOOP
 393
 394   DO_SEQUENTIAL_Q:
 395     R=1
 396     IF (Z%(AA,0)AND31)=6 OR (Z%(AA,0)AND31)=7 THEN R=2
 397     RETURN
 398   DO_CONS:
 399     T=6:L=AB:N=AA:GOSUB ALLOC
 400     RETURN
 401   DO_CONCAT:
 402     REM if empty arguments, return empty list
 403     IF Z%(AR,1)=0 THEN R=3:Z%(R,0)=Z%(R,0)+32:RETURN
 404
 405     REM single argument
 406     IF Z%(Z%(AR,1),1)<>0 THEN GOTO DO_CONCAT_MULT
 407       REM force to list type
 408       A=AA:T=6:GOSUB FORCE_SEQ_TYPE
 409       RETURN
 410
 411     REM multiple arguments
 412     DO_CONCAT_MULT:
 413       CZ=X: REM save current stack position
 414       REM push arguments onto the stack
 415       DO_CONCAT_STACK:
 416         R=AR+1:GOSUB DEREF_R
 417         X=X+1:X%(X)=R: REM push sequence
 418         AR=Z%(AR,1)
 419         IF Z%(AR,1)<>0 THEN GOTO DO_CONCAT_STACK
 420
 421     REM pop last argument as our seq to prepend to
 422     AB=X%(X):X=X-1
 423     REM last arg/seq is not copied so we need to inc ref to it
 424     Z%(AB,0)=Z%(AB,0)+32
 425     DO_CONCAT_LOOP:
 426       IF X=CZ THEN R=AB:RETURN
 427       AA=X%(X):X=X-1: REM pop off next seq to prepend
 428       IF Z%(AA,1)=0 THEN GOTO DO_CONCAT_LOOP: REM skip empty seqs
 429       A=AA:B=0:C=-1:GOSUB SLICE
 430
 431       REM release the terminator of new list (we skip over it)
 432       AY=Z%(R6,1):GOSUB RELEASE
 433       REM attach new list element before terminator (last actual
 434       REM element to the next sequence
 435       Z%(R6,1)=AB
 436
 437       AB=R
 438       GOTO DO_CONCAT_LOOP
 439   DO_NTH:
 440     B=Z%(AB,1)
 441     A=AA:GOSUB COUNT
 442     IF R<=B THEN R=0:ER=-1:ER$="nth: index out of range":RETURN
 443     DO_NTH_LOOP:
 444       IF B=0 THEN GOTO DO_NTH_DONE
 445       B=B-1
 446       AA=Z%(AA,1)
 447       GOTO DO_NTH_LOOP
 448     DO_NTH_DONE:
 449       R=Z%(AA+1,1)
 450       Z%(R,0)=Z%(R,0)+32
 451       RETURN
 452   DO_FIRST:
 453     IF AA=0 THEN R=0:RETURN
 454     IF Z%(AA,1)=0 THEN R=0
 455     IF Z%(AA,1)<>0 THEN R=AA+1:GOSUB DEREF_R
 456     IF R<>0 THEN Z%(R,0)=Z%(R,0)+32
 457     RETURN
 458   DO_REST:
 459     IF AA=0 THEN R=3:Z%(R,0)=Z%(R,0)+32:RETURN
 460     IF Z%(AA,1)=0 THEN A=AA
 461     IF Z%(AA,1)<>0 THEN A=Z%(AA,1)
 462     T=6:GOSUB FORCE_SEQ_TYPE
 463     RETURN
 464   DO_EMPTY_Q:
 465     R=1
 466     IF Z%(AA,1)=0 THEN R=2
 467     RETURN
 468   DO_COUNT:
 469     A=AA:GOSUB COUNT
 470     T=2:L=R:GOSUB ALLOC
 471     RETURN
 472
 473   DO_WITH_META:
 474     T=Z%(AA,0)AND31
 475     REM remove existing metadata first
 476     IF T>=16 THEN AA=Z%(AA,1):GOTO DO_WITH_META
 477     T=T+16:L=AA:N=AB:GOSUB ALLOC
 478     RETURN
 479   DO_META:
 480     IF (Z%(AA,0)AND31)<16 THEN R=0:RETURN
 481     R=Z%(AA+1,1)
 482     Z%(R,0)=Z%(R,0)+32
 483     RETURN
 484   DO_ATOM:
 485     T=12:L=AA:GOSUB ALLOC
 486     RETURN
 487   DO_ATOM_Q:
 488     R=1
 489     IF (Z%(AA,0)AND31)=12 THEN R=2
 490     RETURN
 491   DO_DEREF:
 492     R=Z%(AA,1):GOSUB DEREF_R
 493     Z%(R,0)=Z%(R,0)+32
 494     RETURN
 495   DO_RESET_BANG:
 496     R=AB
 497     REM release current value
 498     AY=Z%(AA,1):GOSUB RELEASE
 499     REM inc ref by 2 for atom ownership and since we are returning it
 500     Z%(R,0)=Z%(R,0)+64
 501     REM update value
 502     Z%(AA,1)=R
 503     RETURN
 504
 505   REM DO_PR_MEMORY:
 506   REM   P1=ZT:P2=-1:GOSUB PR_MEMORY
 507   REM   RETURN
 508   REM DO_PR_MEMORY_SUMMARY:
 509   REM   GOSUB PR_MEMORY_SUMMARY
 510   REM   RETURN
 511
 512   DO_EVAL:
 513     A=AA:E=D:CALL EVAL
 514     RETURN
 515
 516   DO_READ_FILE:
 517     A$=S$(Z%(AA,1))
 518     GOSUB READ_FILE
 519     RETURN
 520
 521 INIT_CORE_SET_FUNCTION:
 522   GOSUB NATIVE_FUNCTION
 523   V=R:GOSUB ENV_SET_S
 524   RETURN
 525
 526 REM INIT_CORE_NS(E)
 527 INIT_CORE_NS:
 528   REM create the environment mapping
 529   REM must match DO_FUNCTION mappings
 530
 531   K$="=":A=1:GOSUB INIT_CORE_SET_FUNCTION
 532   K$="throw":A=2:GOSUB INIT_CORE_SET_FUNCTION
 533   K$="nil?":A=3:GOSUB INIT_CORE_SET_FUNCTION
 534   K$="true?":A=4:GOSUB INIT_CORE_SET_FUNCTION
 535   K$="false?":A=5:GOSUB INIT_CORE_SET_FUNCTION
 536   K$="string?":A=6:GOSUB INIT_CORE_SET_FUNCTION
 537   K$="symbol":A=7:GOSUB INIT_CORE_SET_FUNCTION
 538   K$="symbol?":A=8:GOSUB INIT_CORE_SET_FUNCTION
 539   K$="keyword":A=9:GOSUB INIT_CORE_SET_FUNCTION
 540   K$="keyword?":A=10:GOSUB INIT_CORE_SET_FUNCTION
 541
 542   K$="pr-str":A=11:GOSUB INIT_CORE_SET_FUNCTION
 543   K$="str":A=12:GOSUB INIT_CORE_SET_FUNCTION
 544   K$="prn":A=13:GOSUB INIT_CORE_SET_FUNCTION
 545   K$="println":A=14:GOSUB INIT_CORE_SET_FUNCTION
 546   K$="read-string":A=15:GOSUB INIT_CORE_SET_FUNCTION
 547   K$="readline":A=16:GOSUB INIT_CORE_SET_FUNCTION
 548   K$="slurp":A=17:GOSUB INIT_CORE_SET_FUNCTION
 549
 550   K$="<":A=18:GOSUB INIT_CORE_SET_FUNCTION
 551   K$="<=":A=19:GOSUB INIT_CORE_SET_FUNCTION
 552   K$=">":A=20:GOSUB INIT_CORE_SET_FUNCTION
 553   K$=">=":A=21:GOSUB INIT_CORE_SET_FUNCTION
 554   K$="+":A=22:GOSUB INIT_CORE_SET_FUNCTION
 555   K$="-":A=23:GOSUB INIT_CORE_SET_FUNCTION
 556   K$="*":A=24:GOSUB INIT_CORE_SET_FUNCTION
 557   K$="/":A=25:GOSUB INIT_CORE_SET_FUNCTION
 558   K$="time-ms":A=26:GOSUB INIT_CORE_SET_FUNCTION
 559
 560   K$="list":A=27:GOSUB INIT_CORE_SET_FUNCTION
 561   K$="list?":A=28:GOSUB INIT_CORE_SET_FUNCTION
 562   K$="vector":A=29:GOSUB INIT_CORE_SET_FUNCTION
 563   K$="vector?":A=30:GOSUB INIT_CORE_SET_FUNCTION
 564   K$="hash-map":A=31:GOSUB INIT_CORE_SET_FUNCTION
 565   K$="map?":A=32:GOSUB INIT_CORE_SET_FUNCTION
 566   K$="assoc":A=33:GOSUB INIT_CORE_SET_FUNCTION
 567   K$="dissoc":A=34:GOSUB INIT_CORE_SET_FUNCTION
 568   K$="get":A=35:GOSUB INIT_CORE_SET_FUNCTION
 569   K$="contains?":A=36:GOSUB INIT_CORE_SET_FUNCTION
 570   K$="keys":A=37:GOSUB INIT_CORE_SET_FUNCTION
 571   K$="vals":A=38:GOSUB INIT_CORE_SET_FUNCTION
 572
 573   K$="sequential?":A=39:GOSUB INIT_CORE_SET_FUNCTION
 574   K$="cons":A=40:GOSUB INIT_CORE_SET_FUNCTION
 575   K$="concat":A=41:GOSUB INIT_CORE_SET_FUNCTION
 576   K$="nth":A=42:GOSUB INIT_CORE_SET_FUNCTION
 577   K$="first":A=43:GOSUB INIT_CORE_SET_FUNCTION
 578   K$="rest":A=44:GOSUB INIT_CORE_SET_FUNCTION
 579   K$="empty?":A=45:GOSUB INIT_CORE_SET_FUNCTION
 580   K$="count":A=46:GOSUB INIT_CORE_SET_FUNCTION
 581
 582   REM K$="conj":A=47:GOSUB INIT_CORE_SET_FUNCTION
 583   REM K$="seq":A=48:GOSUB INIT_CORE_SET_FUNCTION
 584
 585   K$="with-meta":A=49:GOSUB INIT_CORE_SET_FUNCTION
 586   K$="meta":A=50:GOSUB INIT_CORE_SET_FUNCTION
 587   K$="atom":A=51:GOSUB INIT_CORE_SET_FUNCTION
 588   K$="atom?":A=52:GOSUB INIT_CORE_SET_FUNCTION
 589   K$="deref":A=53:GOSUB INIT_CORE_SET_FUNCTION
 590   K$="reset!":A=54:GOSUB INIT_CORE_SET_FUNCTION
 591
 592   K$="eval":A=55:GOSUB INIT_CORE_SET_FUNCTION
 593   K$="read-file":A=56:GOSUB INIT_CORE_SET_FUNCTION
 594
 595   REM these are in DO_TCO_FUNCTION
 596   K$="apply":A=61:GOSUB INIT_CORE_SET_FUNCTION
 597   K$="map":A=62:GOSUB INIT_CORE_SET_FUNCTION
 598   K$="swap!":A=63:GOSUB INIT_CORE_SET_FUNCTION
 599
 600   RETURN