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