basic/step3_env.in.bas

   1 GOTO MAIN
   2
   3 REM $INCLUDE: 'readline.in.bas'
   4 REM $INCLUDE: 'types.in.bas'
   5 REM $INCLUDE: 'reader.in.bas'
   6 REM $INCLUDE: 'printer.in.bas'
   7 REM $INCLUDE: 'env.in.bas'
   8
   9 REM READ(A$) -> R%
  10 MAL_READ:
  11   GOSUB READ_STR
  12   RETURN
  13
  14 REM EVAL_AST(A%, E%) -> R%
  15 EVAL_AST:
  16   LV%=LV%+1
  17
  18   REM push A% and E% on the stack
  19   ZL%=ZL%+2: ZZ%(ZL%-1)=E%: ZZ%(ZL%)=A%
  20
  21   IF ER%<>0 THEN GOTO EVAL_AST_RETURN
  22
  23   REM AZ%=A%: GOSUB PR_STR
  24   REM PRINT "EVAL_AST: " + R$ + "(" + STR$(A%) + ")"
  25   REM PRINT "EVAL_AST level: " + STR$(LV%)
  26
  27   GOSUB DEREF_A
  28
  29   T%=Z%(A%,0)AND15
  30   IF T%=5 THEN EVAL_AST_SYMBOL
  31   IF T%=6 THEN EVAL_AST_SEQ
  32   IF T%=7 THEN EVAL_AST_SEQ
  33   IF T%=8 THEN EVAL_AST_SEQ
  34
  35   REM scalar: deref to actual value and inc ref cnt
  36   R%=A%: GOSUB DEREF_R
  37   Z%(R%,0)=Z%(R%,0)+16
  38   GOTO EVAL_AST_RETURN
  39
  40   EVAL_AST_SYMBOL:
  41     K%=A%: GOSUB ENV_GET
  42     GOTO EVAL_AST_RETURN
  43
  44   EVAL_AST_SEQ:
  45     REM allocate the first entry
  46     SZ%=2: GOSUB ALLOC
  47
  48     REM make space on the stack
  49     ZL%=ZL%+4
  50     REM push type of sequence
  51     ZZ%(ZL%-3)=T%
  52     REM push sequence index
  53     ZZ%(ZL%-2)=-1
  54     REM push future return value (new sequence)
  55     ZZ%(ZL%-1)=R%
  56     REM push previous new sequence entry
  57     ZZ%(ZL%)=R%
  58
  59     EVAL_AST_SEQ_LOOP:
  60       REM set new sequence entry type (with 1 ref cnt)
  61       Z%(R%,0)=ZZ%(ZL%-3)+16
  62       Z%(R%,1)=0
  63       REM create value ptr placeholder
  64       Z%(R%+1,0)=14
  65       Z%(R%+1,1)=0
  66
  67       REM update index
  68       ZZ%(ZL%-2)=ZZ%(ZL%-2)+1
  69
  70       REM check if we are done evaluating the source sequence
  71       IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
  72
  73       REM if hashmap, skip eval of even entries (keys)
  74       IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
  75       GOTO EVAL_AST_DO_EVAL
  76
  77       EVAL_AST_DO_REF:
  78         R%=A%+1: GOSUB DEREF_R: REM deref to target of referred entry
  79         Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value
  80         GOTO EVAL_AST_ADD_VALUE
  81
  82       EVAL_AST_DO_EVAL:
  83         REM call EVAL for each entry
  84         A%=A%+1: GOSUB EVAL
  85         A%=A%-1
  86         GOSUB DEREF_R: REM deref to target of evaluated entry
  87
  88       EVAL_AST_ADD_VALUE:
  89
  90       REM update previous value pointer to evaluated entry
  91       Z%(ZZ%(ZL%)+1,1)=R%
  92
  93       IF ER%<>0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
  94
  95       REM allocate the next entry
  96       SZ%=2: GOSUB ALLOC
  97
  98       REM update previous sequence entry value to point to new entry
  99       Z%(ZZ%(ZL%),1)=R%
 100       REM update previous ptr to current entry
 101       ZZ%(ZL%)=R%
 102
 103       REM process the next sequence entry from source list
 104       A%=Z%(A%,1)
 105
 106       GOTO EVAL_AST_SEQ_LOOP
 107     EVAL_AST_SEQ_LOOP_DONE:
 108       REM if no error, get return value (new seq)
 109       IF ER%=0 THEN R%=ZZ%(ZL%-1)
 110       REM otherwise, free the return value and return nil
 111       IF ER%<>0 THEN R%=0: AY%=ZZ%(ZL%-1): GOSUB RELEASE
 112
 113       REM pop previous, return, index and type
 114       ZL%=ZL%-4
 115       GOTO EVAL_AST_RETURN
 116
 117   EVAL_AST_RETURN:
 118     REM pop A% and E% off the stack
 119     E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2
 120
 121     LV%=LV%-1
 122     RETURN
 123
 124 REM EVAL(A%, E%)) -> R%
 125 EVAL:
 126   LV%=LV%+1: REM track basic return stack level
 127
 128   REM push A% and E% on the stack
 129   ZL%=ZL%+2: ZZ%(ZL%-1)=E%: ZZ%(ZL%)=A%
 130
 131   REM AZ%=A%: GOSUB PR_STR
 132   REM PRINT "EVAL: " + R$ + "(" + STR$(A%) + "), LV%:"+STR$(LV%)
 133
 134   GOSUB DEREF_A
 135
 136   GOSUB LIST_Q
 137   IF R% THEN GOTO APPLY_LIST
 138   REM ELSE
 139     GOSUB EVAL_AST
 140     GOTO EVAL_RETURN
 141
 142   APPLY_LIST:
 143     GOSUB EMPTY_Q
 144     IF R% THEN R%=A%: Z%(R%,0)=Z%(R%,0)+16: GOTO EVAL_RETURN
 145
 146     A0%=A%+1
 147     R%=A0%: GOSUB DEREF_R: A0%=R%
 148
 149     REM get symbol in A$
 150     IF (Z%(A0%,0)AND15)<>5 THEN A$=""
 151     IF (Z%(A0%,0)AND15)=5 THEN A$=ZS$(Z%(A0%,1))
 152
 153     IF A$="def!" THEN GOTO EVAL_DEF
 154     IF A$="let*" THEN GOTO EVAL_LET
 155     GOTO EVAL_INVOKE
 156
 157     EVAL_GET_A3:
 158       A3% = Z%(Z%(Z%(A%,1),1),1)+1
 159       R%=A3%: GOSUB DEREF_R: A3%=R%
 160     EVAL_GET_A2:
 161       A2% = Z%(Z%(A%,1),1)+1
 162       R%=A2%: GOSUB DEREF_R: A2%=R%
 163     EVAL_GET_A1:
 164       A1% = Z%(A%,1)+1
 165       R%=A1%: GOSUB DEREF_R: A1%=R%
 166       RETURN
 167
 168     EVAL_DEF:
 169       REM PRINT "def!"
 170       GOSUB EVAL_GET_A2: REM set a1% and a2%
 171
 172       ZL%=ZL%+1: ZZ%(ZL%)=A1%: REM push A1%
 173       A%=A2%: GOSUB EVAL: REM eval a2
 174       A1%=ZZ%(ZL%): ZL%=ZL%-1: REM pop A1%
 175
 176       REM set a1 in env to a2
 177       K%=A1%: V%=R%: GOSUB ENV_SET
 178       GOTO EVAL_RETURN
 179
 180     EVAL_LET:
 181       REM PRINT "let*"
 182       GOSUB EVAL_GET_A2: REM set a1% and a2%
 183       REM create new environment with outer as current environment
 184       EO%=E%: GOSUB ENV_NEW
 185       E%=R%
 186       EVAL_LET_LOOP:
 187         IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
 188
 189         REM push A1%
 190         ZL%=ZL%+1: ZZ%(ZL%)=A1%
 191         REM eval current A1 odd element
 192         A%=Z%(A1%,1)+1: GOSUB EVAL
 193         REM pop A1%
 194         A1%=ZZ%(ZL%): ZL%=ZL%-1
 195
 196         REM set environment: even A1% key to odd A1% eval'd above
 197         K%=A1%+1: V%=R%: GOSUB ENV_SET
 198         AY%=R%: GOSUB RELEASE: REM release our use, ENV_SET took ownership
 199
 200         REM skip to the next pair of A1% elements
 201         A1%=Z%(Z%(A1%,1),1)
 202         GOTO EVAL_LET_LOOP
 203       EVAL_LET_LOOP_DONE:
 204         A%=A2%: GOSUB EVAL: REM eval a2 using let_env
 205         GOTO EVAL_RETURN
 206     EVAL_INVOKE:
 207       GOSUB EVAL_AST
 208       R3%=R%
 209
 210       REM if error, return f/args for release by caller
 211       IF ER%<>0 THEN GOTO EVAL_RETURN
 212       F%=R%+1
 213
 214       AR%=Z%(R%,1): REM rest
 215       R%=F%: GOSUB DEREF_R: F%=R%
 216       IF (Z%(F%,0)AND15)<>9 THEN ER%=1: ER$="apply of non-function": GOTO EVAL_RETURN
 217       GOSUB DO_FUNCTION
 218       AY%=R3%: GOSUB RELEASE
 219       GOTO EVAL_RETURN
 220
 221   EVAL_RETURN:
 222     REM release environment if not the top one on the stack
 223     IF E%<>ZZ%(ZL%-1) THEN AY%=E%: GOSUB RELEASE
 224
 225
 226     REM trigger GC
 227     TA%=FRE(0)
 228
 229     REM pop A% and E% off the stack
 230     E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2
 231
 232     LV%=LV%-1: REM track basic return stack level
 233
 234     RETURN
 235
 236 REM DO_FUNCTION(F%, AR%)
 237 DO_FUNCTION:
 238   AZ%=F%: GOSUB PR_STR
 239   F$=R$
 240   AZ%=AR%: GOSUB PR_STR
 241   AR$=R$
 242
 243   REM Get the function number
 244   FF%=Z%(F%,1)
 245
 246   REM Get argument values
 247   R%=AR%+1: GOSUB DEREF_R: AA%=Z%(R%,1)
 248   R%=Z%(AR%,1)+1: GOSUB DEREF_R: AB%=Z%(R%,1)
 249
 250   REM Allocate the return value
 251   SZ%=1: GOSUB ALLOC
 252
 253   REM Switch on the function number
 254   IF FF%=1 THEN DO_ADD
 255   IF FF%=2 THEN DO_SUB
 256   IF FF%=3 THEN DO_MULT
 257   IF FF%=4 THEN DO_DIV
 258   ER%=1: ER$="unknown function" + STR$(FF%): RETURN
 259
 260   DO_ADD:
 261     Z%(R%,0)=2+16
 262     Z%(R%,1)=AA%+AB%
 263     GOTO DO_FUNCTION_DONE
 264   DO_SUB:
 265     Z%(R%,0)=2+16
 266     Z%(R%,1)=AA%-AB%
 267     GOTO DO_FUNCTION_DONE
 268   DO_MULT:
 269     Z%(R%,0)=2+16
 270     Z%(R%,1)=AA%*AB%
 271     GOTO DO_FUNCTION_DONE
 272   DO_DIV:
 273     Z%(R%,0)=2+16
 274     Z%(R%,1)=AA%/AB%
 275     GOTO DO_FUNCTION_DONE
 276
 277   DO_FUNCTION_DONE:
 278     RETURN
 279
 280 REM PRINT(A%) -> R$
 281 MAL_PRINT:
 282   AZ%=A%: PR%=1: GOSUB PR_STR
 283   RETURN
 284
 285 REM REP(A$) -> R$
 286 REM Assume RE% has repl_env
 287 REP:
 288   R1%=0: R2%=0
 289   GOSUB MAL_READ
 290   R1%=R%
 291   IF ER%<>0 THEN GOTO REP_DONE
 292
 293   A%=R%: E%=RE%: GOSUB EVAL
 294   R2%=R%
 295   IF ER%<>0 THEN GOTO REP_DONE
 296
 297   A%=R%: GOSUB MAL_PRINT
 298   RT$=R$
 299
 300   REP_DONE:
 301     REM Release memory from MAL_READ and EVAL
 302     IF R2%<>0 THEN AY%=R2%: GOSUB RELEASE
 303     IF R1%<>0 THEN AY%=R1%: GOSUB RELEASE
 304     R$=RT$
 305     RETURN
 306
 307 REM MAIN program
 308 MAIN:
 309   GOSUB INIT_MEMORY
 310
 311   LV%=0
 312
 313   REM create repl_env
 314   EO%=-1: GOSUB ENV_NEW
 315   RE%=R%
 316
 317   E%=RE%
 318   REM + function
 319   A%=1: GOSUB NATIVE_FUNCTION
 320   K$="+": V%=R%: GOSUB ENV_SET_S
 321
 322   REM - function
 323   A%=2: GOSUB NATIVE_FUNCTION
 324   K$="-": V%=R%: GOSUB ENV_SET_S
 325
 326   REM * function
 327   A%=3: GOSUB NATIVE_FUNCTION
 328   K$="*": V%=R%: GOSUB ENV_SET_S
 329
 330   REM / function
 331   A%=4: GOSUB NATIVE_FUNCTION
 332   K$="/": V%=R%: GOSUB ENV_SET_S
 333
 334   ZT%=ZI%: REM top of memory after base repl_env
 335
 336   REPL_LOOP:
 337     A$="user> "
 338     GOSUB READLINE: REM /* call input parser */
 339     IF EOF=1 THEN GOTO QUIT
 340
 341     A$=R$: GOSUB REP: REM call REP
 342
 343     IF ER%<>0 THEN GOSUB PRINT_ERROR: GOTO REPL_LOOP
 344     PRINT R$
 345     GOTO REPL_LOOP
 346
 347   QUIT:
 348     REM P1%=ZT%: P2%=-1: GOSUB PR_MEMORY
 349     GOSUB PR_MEMORY_SUMMARY
 350     END
 351
 352   PRINT_ERROR:
 353     PRINT "Error: " + ER$
 354     ER%=0
 355     ER$=""
 356     RETURN
 357