Return to see-ext.fs CVS log

Up to [gforth] / gforth

Fixes in see
Split kernel conditionals in extra file

    1: \ see-ext.fs extentions for see locals, floats
    2: 
    3: \ made extra 26jan97jaw
    4: 
    5: : c-loop-lp+!#  c-loop cell+ ;
    6: : c-?branch-lp+!#  c-?branch cell+ ;
    7: : c-branch-lp+!#   c-branch  cell+ ;
    8: 
    9: : c-@local#
   10:     Display? IF
   11: 	S" @local" 0 .string
   12: 	dup @ dup 1 cells / abs 0 <# #S rot sign #> 0 .string bl cemit
   13:     THEN
   14:     cell+ ;
   15: 
   16: : c-flit
   17:     Display? IF
   18: 	dup f@ scratch represent 0=
   19: 	IF    2drop  scratch 3 min 0 .string
   20: 	ELSE
   21: 	    IF  '- cemit  THEN  1-
   22: 	    scratch over c@ cemit '. cemit 1 /string 0 .string
   23: 	    'E cemit
   24: 	    dup abs 0 <# #S rot sign #> 0 .string bl cemit
   25: 	THEN THEN
   26:     float+ ;
   27: 
   28: : c-f@local#
   29:     Display? IF
   30: 	S" f@local" 0 .string
   31: 	dup @ dup 1 floats / abs 0 <# #S rot sign #> 0 .string bl cemit
   32:     THEN
   33:     cell+ ;
   34: 
   35: : c-laddr#
   36:     Display? IF
   37: 	S" laddr# " 0 .string
   38: 	dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit
   39:     THEN
   40:     cell+ ;
   41: 
   42: : c-lp+!#
   43:     Display? IF
   44: 	S" lp+!# " 0 .string
   45: 	dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit
   46:     THEN
   47:     cell+ ;
   48: 
   49: create c-extend1
   50: 	' @local# A,        ' c-@local# A,
   51:         ' flit A,           ' c-flit A,
   52: 	' f@local# A,       ' c-f@local# A,
   53: 	' laddr# A,         ' c-laddr# A,
   54: 	' lp+!# A,          ' c-lp+!# A,
   55:         ' ?branch-lp+!# A,  ' c-?branch-lp+!# A,
   56:         ' branch-lp+!# A,   ' c-branch-lp+!# A,
   57:         ' (loop)-lp+!# A,   ' c-loop-lp+!# A,
   58:         ' (+loop)-lp+!# A,  ' c-loop-lp+!# A,
   59:         ' (s+loop)-lp+!# A, ' c-loop-lp+!# A,
   60:         ' (-loop)-lp+!# A,  ' c-loop-lp+!# A,
   61:         ' (next)-lp+!# A,   ' c-loop-lp+!# A,
   62: 	0 ,		here 0 ,
   63: 
   64: \ extend see-table
   65: c-extender @
   66: c-extend1 over a!
   67: c-extender !