basic/step2_eval.in.bas

   1 GOTO MAIN
   2
   3 REM $INCLUDE: 'types.in.bas'
   4 REM $INCLUDE: 'readline.in.bas'
   5 REM $INCLUDE: 'reader.in.bas'
   6 REM $INCLUDE: 'printer.in.bas'
   7
   8 REM $INCLUDE: 'debug.in.bas'
   9
  10 REM READ(A$) -> R
  11 MAL_READ:
  12   GOSUB READ_STR
  13   RETURN
  14
  15 REM EVAL_AST(A, E) -> R
  16 SUB EVAL_AST
  17   LV=LV+1
  18
  19   REM push A and E on the stack
  20   Q=E:GOSUB PUSH_Q
  21   GOSUB PUSH_A
  22
  23   IF ER<>-2 THEN GOTO EVAL_AST_RETURN
  24
  25   GOSUB DEREF_A
  26
  27   T=Z%(A,0)AND 31
  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     H=E:K=A:GOSUB HASHMAP_GET
  38     GOSUB DEREF_R
  39     IF R3=0 THEN ER=-1:E$="'"+S$(Z%(A,1))+"' not found":GOTO EVAL_AST_RETURN
  40     Z%(R,0)=Z%(R,0)+32
  41     GOTO EVAL_AST_RETURN
  42
  43   EVAL_AST_SEQ:
  44     REM allocate the first entry (T already set above)
  45     L=0:N=0:GOSUB ALLOC
  46
  47     REM push type of sequence
  48     Q=T:GOSUB PUSH_Q
  49     REM push sequence index
  50     Q=0:GOSUB PUSH_Q
  51     REM push future return value (new sequence)
  52     GOSUB PUSH_R
  53     REM push previous new sequence entry
  54     GOSUB PUSH_R
  55
  56     EVAL_AST_SEQ_LOOP:
  57       REM check if we are done evaluating the source sequence
  58       IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
  59
  60       REM if hashmap, skip eval of even entries (keys)
  61       Q=3:GOSUB PEEK_Q_Q:T=Q
  62       REM get and update index
  63       GOSUB PEEK_Q_2
  64       Q=Q+1:GOSUB PUT_Q_2
  65       IF T=8 AND ((Q-1)AND 1)=0 THEN GOTO EVAL_AST_DO_REF
  66       GOTO EVAL_AST_DO_EVAL
  67
  68       EVAL_AST_DO_REF:
  69         R=A+1:GOSUB DEREF_R: REM deref to target of referred entry
  70         Z%(R,0)=Z%(R,0)+32: REM inc ref cnt of referred value
  71         GOTO EVAL_AST_ADD_VALUE
  72
  73       EVAL_AST_DO_EVAL:
  74         REM call EVAL for each entry
  75         A=A+1:CALL EVAL
  76         A=A-1
  77         GOSUB DEREF_R: REM deref to target of evaluated entry
  78
  79       EVAL_AST_ADD_VALUE:
  80
  81       REM update previous value pointer to evaluated entry
  82       GOSUB PEEK_Q
  83       Z%(Q+1,1)=R
  84
  85       IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
  86
  87       REM allocate the next entry
  88       REM same new sequence entry type
  89       Q=3:GOSUB PEEK_Q_Q:T=Q
  90       L=0:N=0:GOSUB ALLOC
  91
  92       REM update previous sequence entry value to point to new entry
  93       GOSUB PEEK_Q
  94       Z%(Q,1)=R
  95       REM update previous ptr to current entry
  96       Q=R:GOSUB PUT_Q
  97
  98       REM process the next sequence entry from source list
  99       A=Z%(A,1)
 100
 101       GOTO EVAL_AST_SEQ_LOOP
 102     EVAL_AST_SEQ_LOOP_DONE:
 103       REM get return value (new seq), index, and seq type
 104       GOSUB PEEK_Q_1
 105       R=Q
 106       REM pop previous, return, index and type
 107       GOSUB POP_Q:GOSUB POP_Q:GOSUB POP_Q:GOSUB POP_Q
 108       GOTO EVAL_AST_RETURN
 109
 110   EVAL_AST_RETURN:
 111     REM pop A and E off the stack
 112     GOSUB POP_A
 113     GOSUB POP_Q:E=Q
 114
 115     LV=LV-1
 116 END SUB
 117
 118 REM EVAL(A, E) -> R
 119 SUB EVAL
 120   LV=LV+1: REM track basic return stack level
 121
 122   REM push A and E on the stack
 123   Q=E:GOSUB PUSH_Q
 124   GOSUB PUSH_A
 125
 126   IF ER<>-2 THEN GOTO EVAL_RETURN
 127
 128   REM AZ=A:B=1:GOSUB PR_STR
 129   REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
 130
 131   GOSUB DEREF_A
 132
 133   GOSUB LIST_Q
 134   IF R THEN GOTO APPLY_LIST
 135   REM ELSE
 136     CALL EVAL_AST
 137     GOTO EVAL_RETURN
 138
 139   APPLY_LIST:
 140     GOSUB EMPTY_Q
 141     IF R THEN R=A:Z%(R,0)=Z%(R,0)+32:GOTO EVAL_RETURN
 142
 143     EVAL_INVOKE:
 144       CALL EVAL_AST
 145       W=R
 146
 147       REM if error, return f/args for release by caller
 148       IF ER<>-2 THEN GOTO EVAL_RETURN
 149       F=R+1
 150
 151       AR=Z%(R,1): REM rest
 152       R=F:GOSUB DEREF_R:F=R
 153       IF (Z%(F,0)AND 31)<>9 THEN ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
 154       GOSUB DO_FUNCTION
 155       AY=W:GOSUB RELEASE
 156       GOTO EVAL_RETURN
 157
 158   EVAL_RETURN:
 159
 160     LV=LV-1: REM track basic return stack level
 161
 162     REM trigger GC
 163     #cbm T=FRE(0)
 164     #qbasic T=0
 165
 166     REM pop A and E off the stack
 167     GOSUB POP_A
 168     GOSUB POP_Q:E=Q
 169
 170 END SUB
 171
 172 REM DO_FUNCTION(F, AR)
 173 DO_FUNCTION:
 174   AZ=F:GOSUB PR_STR
 175   F$=R$
 176   AZ=AR:GOSUB PR_STR
 177   AR$=R$
 178
 179   REM Get the function number
 180   G=Z%(F,1)
 181
 182   REM Get argument values
 183   R=AR+1:GOSUB DEREF_R:A=Z%(R,1)
 184   R=Z%(AR,1)+1:GOSUB DEREF_R:B=Z%(R,1)
 185
 186   REM Switch on the function number
 187   IF G=1 THEN GOTO DO_ADD
 188   IF G=2 THEN GOTO DO_SUB
 189   IF G=3 THEN GOTO DO_MULT
 190   IF G=4 THEN GOTO DO_DIV
 191   ER=-1:E$="unknown function"+STR$(G):RETURN
 192
 193   DO_ADD:
 194     T=2:L=A+B:GOSUB ALLOC
 195     GOTO DO_FUNCTION_DONE
 196   DO_SUB:
 197     T=2:L=A-B:GOSUB ALLOC
 198     GOTO DO_FUNCTION_DONE
 199   DO_MULT:
 200     T=2:L=A*B:GOSUB ALLOC
 201     GOTO DO_FUNCTION_DONE
 202   DO_DIV:
 203     T=2:L=A/B:GOSUB ALLOC
 204     GOTO DO_FUNCTION_DONE
 205
 206   DO_FUNCTION_DONE:
 207     RETURN
 208
 209 REM PRINT(A) -> R$
 210 MAL_PRINT:
 211   AZ=A:B=1:GOSUB PR_STR
 212   RETURN
 213
 214 REM REP(A$) -> R$
 215 REM Assume D has repl_env
 216 SUB REP
 217   R1=0:R2=0
 218   GOSUB MAL_READ
 219   R1=R
 220   IF ER<>-2 THEN GOTO REP_DONE
 221
 222   A=R:E=D:CALL EVAL
 223   R2=R
 224   IF ER<>-2 THEN GOTO REP_DONE
 225
 226   A=R:GOSUB MAL_PRINT
 227   RT$=R$
 228
 229   REP_DONE:
 230     REM Release memory from MAL_READ and EVAL
 231     IF R2<>0 THEN AY=R2:GOSUB RELEASE
 232     IF R1<>0 THEN AY=R1:GOSUB RELEASE
 233     R$=RT$
 234 END SUB
 235
 236 REM MAIN program
 237 MAIN:
 238   GOSUB INIT_MEMORY
 239
 240   LV=0
 241
 242   REM create repl_env
 243   GOSUB HASHMAP:D=R
 244
 245   REM + function
 246   A=1:GOSUB NATIVE_FUNCTION
 247   H=D:B$="+":C=R:GOSUB ASSOC1_S:D=R
 248
 249   REM - function
 250   A=2:GOSUB NATIVE_FUNCTION
 251   H=D:B$="-":C=R:GOSUB ASSOC1_S:D=R
 252
 253   REM * function
 254   A=3:GOSUB NATIVE_FUNCTION
 255   H=D:B$="*":C=R:GOSUB ASSOC1_S:D=R
 256
 257   REM / function
 258   A=4:GOSUB NATIVE_FUNCTION
 259   H=D:B$="/":C=R:GOSUB ASSOC1_S:D=R
 260
 261   ZT=ZI: REM top of memory after base repl_env
 262
 263   REPL_LOOP:
 264     A$="user> ":GOSUB READLINE: REM call input parser
 265     IF EZ=1 THEN GOTO QUIT
 266
 267     A$=R$:CALL REP: REM call REP
 268
 269     IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
 270     PRINT R$
 271     GOTO REPL_LOOP
 272
 273   QUIT:
 274     REM GOSUB PR_MEMORY_SUMMARY
 275     END
 276
 277   PRINT_ERROR:
 278     PRINT "Error: "+E$
 279     ER=-2:E$=""
 280     RETURN
 281