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) AND 1)=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   REM AZ=A:PR=1:GOSUB PR_STR
 123   REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
 124
 125   GOSUB DEREF_A
 126
 127   GOSUB LIST_Q
 128   IF R THEN GOTO APPLY_LIST
 129   REM ELSE
 130     CALL EVAL_AST
 131     GOTO EVAL_RETURN
 132
 133   APPLY_LIST:
 134     GOSUB EMPTY_Q
 135     IF R THEN R=A:Z%(R,0)=Z%(R,0)+32:GOTO EVAL_RETURN
 136
 137     A0=A+1
 138     R=A0:GOSUB DEREF_R:A0=R
 139
 140     REM get symbol in A$
 141     IF (Z%(A0,0)AND31)<>5 THEN A$=""
 142     IF (Z%(A0,0)AND31)=5 THEN A$=S$(Z%(A0,1))
 143
 144     IF A$="def!" THEN GOTO EVAL_DEF
 145     IF A$="let*" THEN GOTO EVAL_LET
 146     GOTO EVAL_INVOKE
 147
 148     EVAL_GET_A3:
 149       A3=Z%(Z%(Z%(A,1),1),1)+1
 150       R=A3:GOSUB DEREF_R:A3=R
 151     EVAL_GET_A2:
 152       A2=Z%(Z%(A,1),1)+1
 153       R=A2:GOSUB DEREF_R:A2=R
 154     EVAL_GET_A1:
 155       A1=Z%(A,1)+1
 156       R=A1:GOSUB DEREF_R:A1=R
 157       RETURN
 158
 159     EVAL_DEF:
 160       REM PRINT "def!"
 161       GOSUB EVAL_GET_A2: REM set A1 and A2
 162
 163       X=X+1:X%(X)=A1: REM push A1
 164       A=A2:CALL EVAL: REM eval a2
 165       A1=X%(X):X=X-1: REM pop A1
 166
 167       IF ER<>-2 THEN GOTO EVAL_RETURN
 168
 169       REM set a1 in env to a2
 170       K=A1:V=R:GOSUB ENV_SET
 171       GOTO EVAL_RETURN
 172
 173     EVAL_LET:
 174       REM PRINT "let*"
 175       GOSUB EVAL_GET_A2: REM set A1 and A2
 176
 177       X=X+1:X%(X)=A2: REM push/save A2
 178       REM create new environment with outer as current environment
 179       O=E:GOSUB ENV_NEW
 180       E=R
 181       EVAL_LET_LOOP:
 182         IF Z%(A1,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
 183
 184         X=X+1:X%(X)=A1: REM push A1
 185         REM eval current A1 odd element
 186         A=Z%(A1,1)+1:CALL EVAL
 187         A1=X%(X):X=X-1: REM pop A1
 188
 189         REM set environment: even A1 key to odd A1 eval'd above
 190         K=A1+1:V=R:GOSUB ENV_SET
 191         AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership
 192
 193         REM skip to the next pair of A1 elements
 194         A1=Z%(Z%(A1,1),1)
 195         GOTO EVAL_LET_LOOP
 196
 197       EVAL_LET_LOOP_DONE:
 198         A2=X%(X):X=X-1: REM pop A2
 199         A=A2:CALL EVAL: REM eval A2 using let_env
 200         GOTO EVAL_RETURN
 201     EVAL_INVOKE:
 202       CALL EVAL_AST
 203       R3=R
 204
 205       REM if error, return f/args for release by caller
 206       IF ER<>-2 THEN GOTO EVAL_RETURN
 207       F=R+1
 208
 209       AR=Z%(R,1): REM rest
 210       R=F:GOSUB DEREF_R:F=R
 211       IF (Z%(F,0)AND31)<>9 THEN ER=-1:ER$="apply of non-function":GOTO EVAL_RETURN
 212       GOSUB DO_FUNCTION
 213       AY=R3:GOSUB RELEASE
 214       GOTO EVAL_RETURN
 215
 216   EVAL_RETURN:
 217     REM AZ=R: PR=1: GOSUB PR_STR
 218     REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER)
 219
 220     REM release environment if not the top one on the stack
 221     IF E<>X%(X-1) THEN AY=E:GOSUB RELEASE
 222
 223     LV=LV-1: REM track basic return stack level
 224
 225
 226     REM trigger GC
 227     TA=FRE(0)
 228
 229     REM pop A and E off the stack
 230     E=X%(X-1):A=X%(X):X=X-2
 231
 232 END SUB
 233
 234 REM DO_FUNCTION(F, AR)
 235 DO_FUNCTION:
 236   AZ=F:GOSUB PR_STR
 237   F$=R$
 238   AZ=AR:GOSUB PR_STR
 239   AR$=R$
 240
 241   REM Get the function number
 242   FF=Z%(F,1)
 243
 244   REM Get argument values
 245   R=AR+1:GOSUB DEREF_R:AA=Z%(R,1)
 246   R=Z%(AR,1)+1:GOSUB DEREF_R:AB=Z%(R,1)
 247
 248   REM Switch on the function number
 249   IF FF=1 THEN GOTO DO_ADD
 250   IF FF=2 THEN GOTO DO_SUB
 251   IF FF=3 THEN GOTO DO_MULT
 252   IF FF=4 THEN GOTO DO_DIV
 253   ER=-1:ER$="unknown function"+STR$(FF):RETURN
 254
 255   DO_ADD:
 256     T=2:L=AA+AB:GOSUB ALLOC
 257     GOTO DO_FUNCTION_DONE
 258   DO_SUB:
 259     T=2:L=AA-AB:GOSUB ALLOC
 260     GOTO DO_FUNCTION_DONE
 261   DO_MULT:
 262     T=2:L=AA*AB:GOSUB ALLOC
 263     GOTO DO_FUNCTION_DONE
 264   DO_DIV:
 265     T=2:L=AA/AB:GOSUB ALLOC
 266     GOTO DO_FUNCTION_DONE
 267
 268   DO_FUNCTION_DONE:
 269     RETURN
 270
 271 REM PRINT(A) -> R$
 272 MAL_PRINT:
 273   AZ=A:PR=1:GOSUB PR_STR
 274   RETURN
 275
 276 REM REP(A$) -> R$
 277 REM Assume D has repl_env
 278 SUB REP
 279   R1=0:R2=0
 280   GOSUB MAL_READ
 281   R1=R
 282   IF ER<>-2 THEN GOTO REP_DONE
 283
 284   A=R:E=D:CALL EVAL
 285   R2=R
 286   IF ER<>-2 THEN GOTO REP_DONE
 287
 288   A=R:GOSUB MAL_PRINT
 289   RT$=R$
 290
 291   REP_DONE:
 292     REM Release memory from MAL_READ and EVAL
 293     IF R2<>0 THEN AY=R2:GOSUB RELEASE
 294     IF R1<>0 THEN AY=R1:GOSUB RELEASE
 295     R$=RT$
 296 END SUB
 297
 298 REM MAIN program
 299 MAIN:
 300   GOSUB INIT_MEMORY
 301
 302   LV=0
 303
 304   REM create repl_env
 305   O=-1:GOSUB ENV_NEW:D=R
 306
 307   E=D
 308   REM + function
 309   A=1:GOSUB NATIVE_FUNCTION
 310   K$="+":V=R:GOSUB ENV_SET_S
 311
 312   REM - function
 313   A=2:GOSUB NATIVE_FUNCTION
 314   K$="-":V=R:GOSUB ENV_SET_S
 315
 316   REM * function
 317   A=3:GOSUB NATIVE_FUNCTION
 318   K$="*":V=R:GOSUB ENV_SET_S
 319
 320   REM / function
 321   A=4:GOSUB NATIVE_FUNCTION
 322   K$="/":V=R:GOSUB ENV_SET_S
 323
 324   ZT=ZI: REM top of memory after base repl_env
 325
 326   REPL_LOOP:
 327     A$="user> ":GOSUB READLINE: REM call input parser
 328     IF EOF=1 THEN GOTO QUIT
 329
 330     A$=R$:CALL REP: REM call REP
 331
 332     IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
 333     PRINT R$
 334     GOTO REPL_LOOP
 335
 336   QUIT:
 337     REM P1=ZT: P2=-1: GOSUB PR_MEMORY
 338     GOSUB PR_MEMORY_SUMMARY
 339     END
 340
 341   PRINT_ERROR:
 342     PRINT "Error: "+ER$
 343     ER=-2:ER$=""
 344     RETURN
 345