home *** CD-ROM | disk | FTP | other *** search
/ Dream 52 / Amiga_Dream_52.iso / RiscOS / APP / DEVS / FORTH / WIMPFO.ZIP / !WimpForth / args < prev    next >
Text File  |  1996-02-18  |  10KB  |  335 lines
  1. \ $Id: args.f 1.1 1994/04/01 07:52:01 andrew Exp $
  2.  
  3. cr .( Loading Local Variable support...)
  4.  
  5. ((
  6. Named input parameters and local variables.  This implementation is
  7. copied from the Macintosh Forth system Yerkes (formerly Neon).
  8.  
  9. Note: The ANSI Standard "Local" is similiar to what are called "args"
  10. in this documentation, except for reversed order.
  11.  
  12. Syntax:
  13.  
  14. : wordname  { arg1 arg2 \ loc1 loc2 -- result }
  15.         arg1            \ returns value of 1st argument
  16.         0  TO loc1      \ stores a value to local 1
  17.         35 TO arg1      \ ok to change value of an arg
  18.         1  +TO loc2     \ increment local 2
  19.         &LOCAL loc1     \ address of the local following
  20.         ... ;
  21.  
  22. You can have 0 or more args or locals up to a total of 8. The -- and }
  23. are required parts of the syntax. Anything between -- and } is treated
  24. as a comment and does not do anything. The following are all valid
  25. argument declarations:
  26.  
  27.   { -- }                        \ does nothing
  28.  
  29.   { arg -- }                    \ one input argument
  30.  
  31.   { \ local -- }                \ one local (not initialized!)
  32.  
  33.   { arg \ local -- }            \ one arg and one local
  34.  
  35.   { arg1 arg2 -- result }       \ two args
  36.  
  37.  
  38. The args and locals are similiar to "values", in the sense that the
  39. value of the current arg or local is pushed on the stack during execution
  40. of a definition when the name is encountered.  The content of an arg or
  41. local may be changed by using TO or +TO .
  42.  
  43. Restrictions:
  44.  
  45.   1.  Left brace '{' must be first word if used in a :M method definition.
  46.   2.  Total #args + #locals limited to 8.
  47.   3.  No double precision.
  48.   4.  Locals are not initialized.
  49.   5.  Names cannot begin with '\' '-' or '}'
  50.   6.  Entire declaration must fit on one source line.
  51.   7.  A definition may have only one occurrence of the use of {
  52.       or LOCALS| .  If one is used in a definition, the other may NOT
  53.       be used!
  54.  
  55. Implementation:
  56.  
  57.   At the start of the word, locals are allocated and arguments are poped
  58.   from the data stack and pushed onto the return stack.  They are
  59.   referenced relative to the user variable 'mp'.  When you use exit or ;
  60.   the arguments are deallocated.  It is ok to use do..loop and >r r> at
  61.   the same time as locals.
  62.  
  63.   Since there is some runtime overhead, you should only use args and
  64.   locals when it would clear up the code or when you find yourself
  65.   doing a lot of stack juggling.  Do not abuse this feature!
  66.  
  67.                 { a b \ c d -- }
  68.  
  69.         oldbp -> +--------+
  70.                  | retadr |
  71.                  +--------+
  72.                  | old lp |
  73.            lp -> +--------+
  74.                  | arg 0  |   d
  75.                  +--------+
  76.                  | arg 1  |   c
  77.                  +--------+
  78.                  | arg 2  |   b
  79.                  +--------+
  80.                  | arg 3  |   a
  81.            bp -> +--------+
  82.  
  83.  
  84. Additional notes:
  85.   The LOCALS| word, as specified in the LOCAL-EXT extension in the ANS
  86.   Standard has now been implemented.  The following is an example:
  87.  
  88.         : FOO
  89.                 LOCALS|  A1 A2 |
  90.                 2 +TO A2
  91.                 A1 A2 ;
  92.  
  93.   The sequence  7 8 FOO will return 8 and 9 on the stack, with the 9
  94.   on top.
  95.  
  96. ))
  97.  
  98. 0 value ?:M
  99.  
  100. 8 constant #-locals
  101.  
  102. create local-ptrs ' L0 , ' L1 , ' L2 , ' L3 , ' L4 , ' L5 ,  ' L6 , ' L7 ,
  103.  
  104. : >loc  ( n -- cfa )  cells local-ptrs + @ ;
  105.  
  106.  
  107. \ -------------------- Parameter Name List --------------------
  108.  
  109. \ Names in Win32For are limited in length to name-max-chars characters.
  110. \ Parameter names are stored as name-max-chars byte counted string.
  111.  
  112. create ParmList
  113.         #-locals 1+ name-max-chars 1+ * allot \ list of paramter names
  114.                                 \ first slot is temp for current name
  115.  
  116. 0 value Parms   \ number of parameters
  117.  
  118. : ToParm        ( addr cnt -- )   \ store string in first slot of parmlist
  119.                 name-max-chars min parmList place ;
  120.  
  121. : AddParm       ( addr cnt -- )         \ add string to end of parmlist
  122.                 parms #-locals 1- > abort" Too many parameters"
  123.                 1 +to parms
  124.                 2dup ToParm
  125.                 name-max-chars min parmList parms
  126.                 name-max-chars 1+ * + place ;
  127.  
  128.  
  129. \ -------------------- Parameter Compiler --------------------
  130.  
  131. 0 value inParms         \ number of input paramters
  132. 0 value locFlg          \ 1 = compiling args, 0 = compiling locals
  133.  
  134. : parms,  ( -- )   \ compile runtime to push parameters
  135.         ?:M                             \ in method?
  136.         if      cell negate allot       \ then deallocate the cell layed down
  137.         else    postpone init-locals    \ else this is a normal local def
  138.         then
  139.         inParms parms over - c, ( #locals ) c, ( #args )
  140.         0 c, 0 c,  ( unused filler bytes for cell alignment )   ;
  141.  
  142. : firstChr  ( addr cnt -- addr cnt chr )  over c@ ;
  143.  
  144. : (LOCAL)       ( addr cnt -- )
  145.         dup 0=
  146.         IF      2drop
  147.         ELSE
  148.                 addParm
  149.                 inParms locFlg + to inparms
  150.         THEN
  151.         ;
  152.  
  153. : {  ( -- )
  154. \       ?comp
  155.         0 to parms
  156.         0 to inparms
  157.         1 to locFlg
  158.  
  159.         BEGIN
  160.                 bl word count 2dup upper
  161.                 firstChr [char] - <>
  162.         WHILE
  163.                 firstChr [char] \ =
  164.                 IF
  165.                         0 to LocFlg 2drop
  166.                 ELSE
  167.                         firstChr [char] } = abort" Args missing --"
  168.                         (LOCAL)
  169.                 THEN
  170.         REPEAT
  171.         2drop
  172.         parms IF  parms,  ( compile runtime code )  THEN
  173.         BEGIN
  174.                 bl word dup c@ 0= abort" Args missing }"
  175.                 count firstChr [char] } = nip nip
  176.         UNTIL
  177.  ; immediate
  178.  
  179. : REVERSEARGS   ( -- )
  180.         inParms 0= ?EXIT
  181.         inParms 2/ 0
  182.         ?DO     ParmList I 1+ name-max-chars 1+ * +
  183.                 ParmList name-max-chars 1+ move
  184.                 ParmList inParms I - name-max-chars 1+ * +
  185.                 ParmList I 1+ name-max-chars 1+ * +
  186.                 name-max-chars 1+ move
  187.                 Parmlist
  188.                 ParmList inParms I - name-max-chars 1+ * +
  189.                 name-max-chars 1+ move
  190.         LOOP ;
  191.  
  192. : LOCALS|       ( -- )
  193.                 parms abort" Locals may be defined only once per definition."
  194.                 0 to parms
  195.                 0 to inparms
  196.                 1 to locFlg
  197.                 BEGIN
  198.                         bl word count 2dup upper
  199.                         firstChr [char] | <>
  200.                 WHILE
  201.                         (LOCAL)
  202.                 REPEAT  2drop
  203.                 parms IF  parms,  ( compile runtime code )  THEN
  204.                 reverseargs
  205.                 ; IMMEDIATE
  206.  
  207. : &LOCAL        ( -<name>- a1 )
  208.                 r> dup cell+ >r
  209.                 @ dup call@ dolocal <>
  210.                 abort" Must be followed by a local variable"
  211.                 cell+ @ lp @ + ;
  212. comment ╓
  213. also environment definitions
  214.  
  215. : LOCALS ;
  216.  
  217. #-locals constant #LOCALS
  218.  
  219. previous definitions
  220. ╓
  221.  
  222.  
  223. \ -------------------- Local Dictionary Search --------------------
  224.  
  225. : D= d- or 0= ;
  226.  
  227. : (pfind)   ( addr -- cfa t | addr f )
  228.         false parms
  229.         IF      over count ToParm
  230.                 parms 1+ 1
  231.                 DO      ParmList i name-max-chars 1+ * + count
  232.                         ParmList count name-max-chars min
  233.                         compare 0=                      \ true if matched
  234.                         IF      2drop  parms  i  -  >loc TRUE
  235.                                 LEAVE
  236.                         THEN
  237.                 LOOP
  238.         THEN ;
  239.  
  240. : pfind state @ if (pfind) else false then ;
  241.  
  242. : parmFind  ( addr -- addr 0 | cfa -1 | cfa 1 )
  243.         pfind ?dup 0= if  (find)  then ;
  244.  
  245.  
  246. \ -------------------- New Colon Compiler --------------------
  247.  
  248. warning @ warning off   nostack1
  249.  
  250. : Parms-init    ( -- )
  251.                 0 to Parms ;
  252.  
  253. : _parms:       ( -- )
  254.                 false to ?:M
  255.                 Parms-init _: ;
  256.  
  257. : exit  ( -- )
  258.         ?:M     ( -- f1 )
  259.         false to ?:M
  260.                 ( -- f1 ) abort" Can't use EXIT in a Method !"
  261.         Parms
  262.         if      postpone exitp
  263.         else    postpone exit
  264.         then    ; immediate
  265.  
  266. \ : EXITM   ( -- )
  267. \        ?:M 0= abort" Can use EXITM only in a Method !"
  268. \        Parms
  269. \        IF      postpone unparms
  270. \        THEN
  271. \        postpone exitm ; immediate
  272.  
  273. : ?exit ( f1 -- )
  274.         ?:M     ( -- f1 )
  275.         false to ?:M
  276.                 ( -- f1 ) abort" Can't use ?EXIT in a Method !"
  277.         ?comp
  278.         compile ?branch >mark
  279.         [compile] exit
  280.         compile _then
  281.         >resolve ; immediate
  282.  
  283. : ;     ( -- )
  284.         ?:M     ( -- f1 )
  285.         false to ?:M
  286.                 ( -- f1 ) abort" Methods must END in ;M !"
  287.         ?csp reveal
  288.         parms if  postpone unnestp  else  postpone unnest  then
  289.         postpone [
  290.         0 to Parms
  291.         semicolon-chain do-chain ; immediate
  292.  
  293. : DOES>  ( -- )
  294.         ?:M     ( -- f1 )
  295.         false to ?:M
  296.                 ( -- f1 ) abort" Can't use DOES> in a Method !"
  297.         Parms
  298.         if
  299.                 postpone unparms
  300.                 postpone Parms-init
  301.         then
  302.         postpone does>
  303.         Parms-init ; immediate
  304.  
  305. : localAlloc:   ( n1 -<name>- )   \ allocate a local n1 byte buffer to local "name"
  306.                 compile _localAlloc postpone to ; immediate
  307.  
  308. comment ÷
  309. assembler defined ;CODE nip #IF  forth
  310. : _;CODEP   ( -- )
  311.         parms
  312.         IF      postpone unparms
  313.         THEN    [ assembler asm-hidden ] _;code [ forth ]
  314.         ; immediate
  315.  
  316. #THEN
  317. ÷
  318. forth
  319.  
  320. warning !
  321.  
  322. \ -------------------- Enable Locals --------------------
  323.  
  324. : locals-on
  325.                 ['] parmFind is find
  326.                 ['] _parms:  is :
  327. \+ _;codep      ['] _;codep is ;code
  328.                 0 to Parms ;
  329.  
  330. : locals-off
  331.         ['] (find) is find ;
  332.  
  333. locals-on
  334.  
  335.