Menu
▾
▴
[Win32forth-cvs] win32forth/src SEE.F,1.2,1.3
|
From: George H. <geo...@us...> - 2005-06-06 09:44:49
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10104/win32forth/src Modified Files: SEE.F Log Message: gah: modified SEE to detect the difference between EXIT plus and ; EXITM and ;M. Made _EXIT and EXITP aliases of UNNEST and UNNESTP Index: SEE.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/SEE.F,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** SEE.F 1 Jun 2005 09:55:12 -0000 1.2 --- SEE.F 6 Jun 2005 09:44:39 -0000 1.3 *************** *** 142,182 **** then ; : .execution-class ( ip cfa -- ip' ) case ! ['] lit of cell+ ." lit " .word endof ! ['] (&of-local) of cell+ ." &OF " .word endof ! ['] (&of-VALUE) of cell+ ." &OF " .word endof ! &flit of cell+ ." flit " .float endof ! ['] (is) of cell+ ." (is) " .word endof ! ['] (.") of ." ." .string endof ! ['] (S") of ." S" .string endof ! ['] (Z") of ." Z" .string endof ! ['] (C") of ." C" .string endof ! ['] (abort") of ." ABORT" .string endof ! ['] ?branch of d_cr ." IF " +tab cell+ cell+ endof ! ['] -?branch of d_cr ." -IF " +tab cell+ cell+ endof ! ['] branch of -tab d_cr ." ELSE " +tab cell+ cell+ endof ! ['] (do) of d_cr ." DO " +tab cell+ cell+ endof ! ['] (?do) of d_cr ." ?DO " +tab cell+ cell+ endof ! ['] (loop) of -tab d_cr ." LOOP " cell+ cell+ endof ! ['] (+loop) of -tab d_cr ." +LOOP " cell+ cell+ endof ! ['] _case of d_cr ." CASE " +tab cell+ endof ! ['] _of of d_cr ." OF " +tab cell+ cell+ endof ['] _endof of tab ." ENDOF " -tab d_cr ! cell+ cell+ endof ! ['] _endcase of -tab d_cr ." ENDCASE " cell+ endof ! ['] _then of -tab d_cr ." THEN " cell+ endof ! ['] _begin of d_cr ." BEGIN " +tab cell+ endof ! ['] _while of -tab d_cr ." WHILE " +tab cell+ cell+ endof ! ['] _until of -tab d_cr ." UNTIL " cell+ cell+ endof ! ['] _repeat of -tab d_cr ." REPEAT " cell+ cell+ endof ! ['] _again of -tab d_cr ." AGAIN " cell+ cell+ endof ! ['] compile of .word .word endof ! ['] unnest of ." ; " drop 0 endof ! ['] unnestm of ." ;M " drop 0 endof ! ['] unnestp of ." ; " drop 0 endof ! ['] (;code) of -tab d_cr .(;CODE) tab +tab endof ! ['] create of d_cr .word tab +tab endof ! ['] init-locals of .locals endof false .execution-class-chain do-chain 0= if swap .word swap --- 142,192 ---- then ; + 0 value hi-branch + + : branch+ ( ip -- ip' ) \ advance ip by 1 cell and update hi-branch if necessary + cell+ dup @ hi-branch umax to hi-branch ; + + : .end ( ip -- ip'|0 ) \ advance ip by 1 cell, return false if there are no branches + \ past this address + cell+ dup hi-branch u< 0= if ." ;" drop 0 + else ." EXIT" then ; + : .execution-class ( ip cfa -- ip' ) case ! ['] lit of cell+ ." lit " .word endof ! ['] (&of-local) of cell+ ." &OF " .word endof ! ['] (&of-VALUE) of cell+ ." &OF " .word endof ! &flit of cell+ ." flit " .float endof ! ['] (is) of cell+ ." (is) " .word endof ! ['] (.") of ." ." .string endof ! ['] (S") of ." S" .string endof ! ['] (Z") of ." Z" .string endof ! ['] (C") of ." C" .string endof ! ['] (abort") of ." ABORT" .string endof ! ['] ?branch of d_cr ." IF " +tab branch+ cell+ endof ! ['] -?branch of d_cr ." -IF " +tab branch+ cell+ endof ! ['] branch of -tab d_cr ." ELSE " +tab branch+ cell+ endof ! ['] (do) of d_cr ." DO " +tab branch+ cell+ endof ! ['] (?do) of d_cr ." ?DO " +tab branch+ cell+ endof ! ['] (loop) of -tab d_cr ." LOOP " cell+ cell+ endof ! ['] (+loop) of -tab d_cr ." +LOOP " cell+ cell+ endof ! ['] _case of d_cr ." CASE " +tab cell+ endof ! ['] _of of d_cr ." OF " +tab branch+ cell+ endof ['] _endof of tab ." ENDOF " -tab d_cr ! branch+ cell+ endof ! ['] _endcase of -tab d_cr ." ENDCASE " cell+ endof ! ['] _then of -tab d_cr ." THEN " cell+ endof ! ['] _begin of d_cr ." BEGIN " +tab cell+ endof ! ['] _while of -tab d_cr ." WHILE " +tab branch+ cell+ endof ! ['] _until of -tab d_cr ." UNTIL " cell+ cell+ endof ! ['] _repeat of -tab d_cr ." REPEAT " cell+ cell+ endof ! ['] _again of -tab d_cr ." AGAIN " cell+ cell+ endof ! ['] compile of .word .word endof ! ['] unnest of .end space endof ! ['] unnestp of .end space endof ! ['] unnestm of .end ." M " endof ! ['] (;code) of -tab d_cr .(;CODE) tab +tab endof ! ['] create of d_cr .word tab +tab endof ! ['] init-locals of .locals endof false .execution-class-chain do-chain 0= if swap .word swap *************** *** 188,191 **** --- 198,202 ---- : .PFA ( cfa -- ) + 0 to hi-branch tabing-on 0TAB +TAB tab *************** *** 230,235 **** ." : " dup .name 2 spaces >body .pfa ; - - \ Display category of word 24APR84HHL : .DEFER ( cfa -- ) ." DEFER " DUP .NAME ." IS " >BODY @ (SEE) ; --- 241,244 ---- |
