File:  [gforth] / gforth / compat / macros.fs
Revision 1.2: download - view: text, annotated - select for diffs
Sun Nov 29 19:53:52 2009 UTC (14 years, 4 months ago) by anton
Branches: MAIN
CVS tags: HEAD
documentation changes

    1: \ implementation of ]] ... [[
    2: 
    3: \ This file is in the public domain. NO WARRANTY.
    4: 
    5: \ Avoid having to write so many POSTPONEs; Instead of
    6: 
    7: \ POSTPONE a POSTPONE b POSTPONE c
    8: \ write
    9: \ ]] a b c [[
   10: 
   11: \ In addition there are some shortcuts for literals (not present in
   12: \ Gforth 0.7.0 and earlier):
   13: 
   14: \ 1  ]]L               is equivalent to    1  ]]  literal
   15: \ 1. ]]2L              is equivalent to    1. ]] 2literal
   16: \ 1e ]]FL              is equivalent to    1e ]] fliteral
   17: \ parse-name foo ]]SL  is equivalent to    parse-name foo ]] sliteral
   18: 
   19: \ This program uses the following words
   20: \ from CORE :
   21: \  environment? drop : BEGIN >in @ dup 0= WHILE 2drop and REPEAT ; ! 
   22: \  POSTPONE immediate Literal 
   23: \ from BLOCK-EXT :
   24: \  \ 
   25: \ from DOUBLE :
   26: \  2Literal 
   27: \ from EXCEPTION :
   28: \  throw 
   29: \ from FILE :
   30: \  S" ( 
   31: \ from FILE-EXT :
   32: \  refill 
   33: \ from FLOAT :
   34: \  FLiteral 
   35: \ from STRING :
   36: \  compare SLiteral 
   37: \ from X:parse-name :
   38: \  parse-name 
   39: 
   40: s" X:parse-name" environment? drop \ just let the system know that we need it
   41: 
   42: : refilling-parse-name ( -- old->in c-addr u )
   43:     begin
   44: 	>in @ parse-name dup 0= while
   45: 	    2drop drop refill 0= -39 and throw
   46:     repeat ;
   47: 
   48: : ]] ( -- )
   49:     \ switch into postpone state
   50:     begin
   51: 	refilling-parse-name s" [[" compare while
   52: 	    >in ! POSTPONE postpone
   53:     repeat
   54:     drop ; immediate
   55: 
   56: : postpone-literal  postpone  literal ;
   57: : postpone-2literal postpone 2literal ;
   58: : postpone-fliteral postpone fliteral ;
   59: : postpone-sliteral postpone sliteral ;
   60: 
   61: : ]]L ( postponing: x -- ; compiling: -- x )
   62:     \ Shortcut for @code{]] literal}.
   63:     ]] postpone-literal ]] [[ ; immediate
   64: 
   65: : ]]2L ( postponing: x1 x2 -- ; compiling: -- x1 x2 )
   66:     \ Shortcut for @code{]] 2literal}.
   67:     ]] postpone-2literal ]] [[ ; immediate
   68: 
   69: : ]]FL ( postponing: r -- ; compiling: -- r )
   70:     \ Shortcut for @code{]] fliteral}.
   71:     ]] postpone-fliteral ]] [[ ; immediate
   72: 
   73: : ]]SL ( postponing: addr1 u -- ; compiling: -- addr2 u )
   74:     \ Shortcut for @code{]] sliteral}; if the string already has been
   75:     \ allocated permanently, you can use @code{]]2L} instead.
   76:     ]] postpone-sliteral ]] [[ ; immediate

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>