programming tools for Windows applications development
  Home  |   SwiftForth Archive  |   SwiftX Archive  |

Structures on the return stack.

From: Charles Melice <3d_at_forthcad.com>
Date: Mon, 18 Sep 2006 16:17:44 +0200

(
This tool enable to replace the next write-only construct:

  7 cells r-alloc dup cell+ dup 2 cells +
  locals| rect point x |

with this contruct:

  [STRUCT
      cell R-FIELD x
      2 cells R-FIELD point
      4 cells R-FIELD rect
  STRUCT]

That will result in the next compiled code:
 28 r-alloc >r 12 r@ + 4 r@ + r> locals| x point rect |
)

256 buffer: rpad

: parse>rpad ( delim -- )
    parse swap 1 chars - swap 1+ rpad append ;

: [STRUCT ( -- offset0 count )
    s" locals|" rpad place
    0 0 postpone [ ; immediate

: R-FIELD ( offset0 count size "name" -- offset0 offset1 count+1 )
    bl parse>rpad third + swap 1+ ; immediate

\ Enable to insert "normal" locals int R-STRUCT.
\ Valid only at the bottom location of the r-struct.
: +LOCALS| ( "locals'|'" -- )
    [char] | parse>rpad ;

: STRUCT] \ ( (count+1)*offset count -- )
    ] swap
    postpone literal \ data size
    postpone r-alloc \ addr
    postpone >r
    1- 0 ?DO
        postpone literal \ offset
        postpone r@
        postpone +
    LOOP drop
    postpone r>
    s" |" rpad append
    rpad count evaluate ; immediate

----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
For list command help, send subject "help" to sftalk-request_at_forth.com
Message archives are located at http://www.forth.com/archive/sftalk
----------------------------------------------------------------------
This list is a forum for SwiftForth users. For product support and
bug reports, please send email to support_at_forth.com
----------------------------------------------------------------------
Received on Mon Sep 18 2006 - 07:18:44 PDT

This archive was generated by hypermail 2.2.0 : Tue Dec 02 2008 - 03:04:40 PST