Return to interpreter.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / bootstrap

Annotation of qemu/roms/openbios/forth/bootstrap/interpreter.fs, revision 1.1

1.1     ! root        1: \ tag: forth interpreter
        !             2: \ 
        !             3: \ Copyright (C) 2003 Stefan Reinauer
        !             4: \ 
        !             5: \ See the file "COPYING" for further information about
        !             6: \ the copyright and warranty status of this work.
        !             7: \ 
        !             8: 
        !             9: 
        !            10: \ 
        !            11: \ 7.3.4.6 Display pause
        !            12: \ 
        !            13: 
        !            14: 0 value interactive?
        !            15: 0 value terminate?
        !            16: 
        !            17: : exit?
        !            18:   interactive? 0= if
        !            19:     false exit
        !            20:   then
        !            21:   false \ FIXME we should check whether to interrupt output
        !            22:         \ and ask the user how to proceed.
        !            23:   ;
        !            24: 
        !            25: 
        !            26: \ 
        !            27: \ 7.3.9.1 Defining words
        !            28: \ 
        !            29: 
        !            30: : forget 
        !            31:   s" This word is obsolescent." type cr
        !            32:   ['] ' execute
        !            33:   cell - dup 
        !            34:   @ dup 
        !            35:   last ! latest !
        !            36:   here!
        !            37:   ;
        !            38:  
        !            39: \ 
        !            40: \ 7.3.9.2.4 Miscellaneous dictionary
        !            41: \ 
        !            42: 
        !            43: \ interpreter. This word checks whether the interpreted word
        !            44: \ is a word in dictionary or a number. It honours compile mode 
        !            45: \ and immediate/compile-only words.
        !            46: 
        !            47: : interpret 
        !            48:   0 >in !
        !            49:   begin
        !            50:     parse-word dup 0> \ was there a word at all?
        !            51:   while
        !            52:     $find 
        !            53:     if
        !            54:       dup flags? 0<> state @ 0= or if
        !            55:         execute
        !            56:       else
        !            57:         ,             \ compile mode && !immediate
        !            58:       then
        !            59:     else              \ word is not known. maybe it's a number
        !            60:       2dup $number
        !            61:       if
        !            62:         span @ >in !  \ if we encountered an error, don't continue parsing
        !            63:         type 3a emit
        !            64:        -13 throw
        !            65:       else
        !            66:         -rot 2drop 1 handle-lit
        !            67:       then
        !            68:     then
        !            69:     depth 200 >=  if -3 throw then 
        !            70:     depth 0<      if -4 throw then
        !            71:     rdepth 200 >= if -5 throw then 
        !            72:     rdepth 0<     if -6 throw then
        !            73:   repeat
        !            74:   2drop
        !            75:   ;
        !            76: 
        !            77: : refill ( -- )
        !            78:        ib #ib @ expect 0 >in ! ;
        !            79: 
        !            80: : print-status  ( exception -- )
        !            81:   space
        !            82:   ?dup if
        !            83:     dup sys-debug \ system debug hook
        !            84:     case 
        !            85:        -1 of s" Aborted." type endof
        !            86:        -2 of s" Aborted." type endof
        !            87:        -3 of s" Stack Overflow." type 0 depth! endof
        !            88:        -4 of s" Stack Underflow." type 0 depth! endof
        !            89:        -5 of s" Return Stack Overflow." type endof
        !            90:        -6 of s" Return Stack Underflow." type endof
        !            91:       -13 of s" undefined word." type endof
        !            92:       -15 of s" out of memory." type endof
        !            93:       -21 of s" undefined method." type endof
        !            94:       -22 of s" no such device." type endof
        !            95:       dup s" Exception #" type . 
        !            96:       0 state !
        !            97:     endcase
        !            98:   else
        !            99:     state @ 0= if
        !           100:       s" ok"
        !           101:     else 
        !           102:       s" compiled"
        !           103:     then
        !           104:     type
        !           105:   then
        !           106:   cr
        !           107:   ;
        !           108: 
        !           109: defer status
        !           110: ['] noop ['] status (to)
        !           111: 
        !           112: : print-prompt
        !           113:   status 
        !           114:   depth . 3e emit space
        !           115:   ;
        !           116:   
        !           117: defer outer-interpreter
        !           118: :noname
        !           119:   cr
        !           120:   begin
        !           121:     print-prompt
        !           122:     source 0 fill           \ clean input buffer
        !           123:     refill 
        !           124: 
        !           125:     ['] interpret catch print-status
        !           126:     terminate?
        !           127:   until
        !           128: ; ['] outer-interpreter (to)
        !           129: 
        !           130: \ 
        !           131: \ 7.3.8.5 Other control flow commands
        !           132: \ 
        !           133: 
        !           134: : save-source  ( -- )
        !           135:   r>               \ fetch our caller
        !           136:   ib >r #ib @ >r   \ save current input buffer
        !           137:   source-id >r     \ and all variables 
        !           138:   span @ >r        \ associated with it.
        !           139:   >in @ >r
        !           140:   >r               \ move back our caller
        !           141:   ;
        !           142: 
        !           143: : restore-source ( -- )
        !           144:   r> 
        !           145:   r> >in ! 
        !           146:   r> span ! 
        !           147:   r> ['] source-id (to) 
        !           148:   r> #ib ! 
        !           149:   r> ['] ib (to) 
        !           150:   >r
        !           151:   ;
        !           152: 
        !           153: : (evaluate) ( str len -- ??? )
        !           154:   save-source
        !           155:   -1 ['] source-id (to)
        !           156:   dup
        !           157:   #ib ! span !
        !           158:   ['] ib (to)
        !           159:   interpret
        !           160:   restore-source
        !           161:   ; 
        !           162: 
        !           163: : evaluate ( str len -- ?? )
        !           164:   2dup + -rot
        !           165:   over + over do 
        !           166:     i c@ 0a = if 
        !           167:       i over - 
        !           168:       (evaluate)
        !           169:       i 1+ 
        !           170:     then 
        !           171:   loop 
        !           172:   swap over - (evaluate)
        !           173:   ;
        !           174:   
        !           175: : eval evaluate ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.