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