basic/core.in.bas

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