languages/forth/forth.pir

   1
   2 .HLL 'Forth', ''
   3 .namespace []
   4
   5 .include 'languages/forth/words.pir'
   6
   7 .sub ' init' :load
   8     # load the libraries we depend on
   9     load_bytecode 'languages/forth/tokenstream.pbc'
  10     load_bytecode 'languages/forth/variablestack.pbc'
  11     load_bytecode 'languages/forth/virtualstack.pbc'
  12
  13     # initialize the rstack
  14     .local pmc stack
  15     stack = new 'ResizablePMCArray'
  16     set_hll_global ' stack', stack
  17
  18     # word dictionary - used for compilation
  19     .local pmc dict
  20     dict = new 'Hash'
  21     set_hll_global ' dict', dict
  22
  23     .local pmc vars, vstack
  24     vars   = new 'Hash'
  25     vstack = new 'VariableStack'
  26     set_hll_global ' variables', vars
  27     set_hll_global ' vstack', vstack
  28
  29     # register the actual compiler
  30     .local pmc compiler
  31     compiler = get_hll_global ' compile'
  32     compreg 'forth', compiler
  33 .end
  34
  35 .sub main :main :anon
  36     .param pmc args
  37     .local int argc
  38     argc = elements args
  39
  40     ' init'()
  41     if argc == 0 goto prompt
  42
  43 prompt:
  44     ' prompt'()
  45     end
  46 .end
  47
  48
  49 .sub ' prompt'
  50     .local pmc stdin, stdout, forth
  51     stdin  = getstdin
  52     stdout = getstdout
  53     forth  = compreg 'forth'
  54
  55     $S0 = pop stdout
  56     print "Parrot Forth\n"
  57
  58 loop:
  59     print "> "
  60     $S0 = readline stdin
  61     unless stdin goto end
  62
  63 #    push_eh exception
  64       $P0 = forth($S0)
  65       $P0()
  66 #    pop_eh
  67
  68     print " ok\n"
  69     goto loop
  70 end:
  71     .return()
  72
  73 exception:
  74     get_results '0, 0', $P0, $S0
  75     $S0 = $P0[0]
  76     print $S0
  77     print "\n"
  78     goto loop
  79 .end
  80
  81
  82 .sub ' compile'
  83     .param pmc input
  84
  85     .local pmc code, stream, stack
  86     code   = new 'CodeString'
  87     stream = new 'TokenStream', input
  88     stack  = new 'VirtualStack'
  89
  90     code.emit(<<"END_PIR")
  91 .sub code :anon
  92     .local pmc stack
  93     stack = get_hll_global " stack"
  94 END_PIR
  95
  96     .local pmc token
  97 next_token:
  98     unless stream goto done
  99     token = shift stream
 100
 101     ' dispatch'(code, stream, stack, token)
 102
 103     goto next_token
 104
 105 done:
 106     $S0 = stack.consolidate_to_cstack()
 107     code .= $S0
 108     code.emit(<<"END_PIR")
 109     .return(stack)
 110 .end
 111 END_PIR
 112
 113     $P0 = compreg "PIR"
 114     .return $P0(code)
 115 .end
 116
 117 .sub ' dispatch'
 118     .param pmc code
 119     .param pmc stream
 120     .param pmc stack
 121     .param pmc token
 122
 123     $I0 = isa token, 'Integer'
 124     if $I0 goto numeric
 125
 126     .local pmc dict, vars
 127     dict = get_hll_global ' dict'
 128     vars = get_hll_global ' variables'
 129
 130     $S0 = token
 131     $I0 = exists dict[$S0]
 132     if $I0 goto user_word
 133     $I0 = exists vars[$S0]
 134     if $I0 goto user_var
 135
 136     $P0 = get_hll_global $S0
 137     if null $P0 goto undefined
 138     $P0(code, stream, stack)
 139     .return()
 140
 141 user_word:
 142     $S1 = stack.consolidate_to_cstack()
 143     code .= $S1
 144     $S0 = dict[$S0]
 145     code.emit("    '%0'(stack)", $S0)
 146     .return()
 147
 148 user_var:
 149     $I0 = vars[$S0]
 150     $S0 = code.unique('$P')
 151     code.emit(<<'END_PIR', $S0, $I0)
 152     %0 = new 'Integer'
 153     %0 = %1
 154 END_PIR
 155     push stack, $S0
 156     .return()
 157
 158 undefined:
 159     $S0 = token
 160     $S0 = "undefined symbol: " . $S0
 161     $P0 = new 'Exception'
 162     $P0[0] = $S0
 163     throw $P0
 164
 165 numeric:
 166     $S0 = code.unique('$P')
 167     code.emit(<<"END_PIR", $S0, token)
 168     %0 = new 'Integer'
 169     %0 = %1
 170 END_PIR
 171     push stack, $S0
 172     .return()
 173 .end
 174
 175 # Local Variables:
 176 #   mode: pir
 177 #   fill-column: 100
 178 # End:
 179 # vim: expandtab shiftwidth=4 ft=pir: