qemu/roms/openbios/forth/debugging/see.fs

   1 \ tag: Forth Decompiler
   2 \
   3 \ this code implements IEEE 1275-1994 ch. 7.5.3.2
   4 \
   5 \ Copyright (C) 2003 Stefan Reinauer
   6 \
   7 \ See the file "COPYING" for further information about
   8 \ the copyright and warranty status of this work.
   9 \
  10
  11 1 value (see-indent)
  12
  13 : (see-cr)
  14   cr (see-indent) spaces
  15   ;
  16
  17 : indent+
  18   (see-indent) 2+ to (see-indent)
  19   ;
  20
  21 : indent-
  22   (see-indent) 2- to (see-indent)
  23   ;
  24
  25 : (see-colon)
  26   dup ." : " cell - lfa2name type (see-cr)
  27    begin
  28    cell+ dup @ dup ['] (semis) <>
  29    while
  30     space
  31     dup
  32     case
  33
  34       ['] do?branch of
  35         ." if" (see-cr) indent+
  36         drop cell+
  37       endof
  38
  39       ['] dobranch of
  40         ." then" indent- (see-cr)
  41         drop cell+
  42       endof
  43
  44       ['] (begin) of
  45         ." begin" indent+ (see-cr)
  46         drop
  47       endof
  48
  49       ['] (again) of
  50         ." again" (see-cr)
  51         drop
  52       endof
  53
  54       ['] (until) of
  55         ." until" (see-cr)
  56         drop
  57       endof
  58
  59       ['] (while) of
  60         indent- (see-cr)
  61         ."  while"
  62         indent+ (see-cr)
  63         drop 2 cells +
  64       endof
  65
  66       ['] (repeat) of
  67         indent- (see-cr)
  68         ."  repeat"
  69         (see-cr)
  70         drop 2 cells +
  71       endof
  72
  73       ['] (lit) of
  74         ." ( lit ) h# "
  75         drop 1 cells +
  76         dup @ u.
  77       endof
  78
  79       ['] (") of
  80         22 emit space drop dup cell+ @
  81         2dup swap 2 cells + swap type
  82         22 emit
  83         + aligned cell+
  84       endof
  85
  86       cell - lfa2name type
  87     endcase
  88    repeat
  89   cr ."   ;"
  90   2drop
  91   ;
  92
  93 : (see) ( xt -- )
  94   cr
  95   dup @ case
  96     1 of
  97       (see-colon)
  98     endof
  99     3 of
 100       ." constant " dup cell - lfa2name type ."  =  " execute .
 101     endof
 102     4 of
 103       ." variable " dup cell - lfa2name type ."  =  " execute @ .
 104     endof
 105     5 of
 106       ." defer " dup  cell - lfa2name type cr
 107       ." is " cell+ @ cell - lfa2name type cr
 108     endof
 109     ." primword " swap cell - lfa2name type
 110   endcase
 111   cr
 112   ;
 113
 114 : see ' (see) ;