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