home *** CD-ROM | disk | FTP | other *** search
- .( Loading Structure Test...) cr
-
- #include structures.f83
-
- structures
-
- .( 1: Print size of primitive fields) cr
-
- sizeof byte .
- sizeof word .
- sizeof ptr .
- sizeof long .
- sizeof enum .
- cr
-
-
- .( 2: Allocate some data) cr
- here . new word . here . cr
-
-
- .( 3: Define a list structures) cr
-
- struct.type LIST
- ptr +next
- struct.init ( self -- )
- nil swap +next !
- struct.end
-
- sizeof LIST . new LIST dup . +next @ . cr
-
-
- .( 4: Define a double linked list) cr
-
- struct.type QUEUE
- struct LIST +succ
- struct LIST +pred
- struct.init ( flag self -- )
- swap
- if dup over +succ !
- dup +pred !
- else
- dup +succ as LIST initiate
- +pred as LIST initiate
- then
- struct.end
-
- sizeof QUEUE . cr
- true new QUEUE dup . dup +succ +next @ . +pred +next @ . cr
- false new QUEUE dup . dup +succ +next @ . +pred +next @ . cr
-
-
- .( 5: Define a block using double linked list and instance function) cr
-
- struct.type BLOCK
- struct QUEUE +queue
- long +size
- struct.init ( size flag self -- )
- tuck +queue as QUEUE initiate
- over allot +size !
- struct.does ( self -- ptr)
- sizeof BLOCK +
- struct.end
-
- : block ( ptr -- block) sizeof BLOCK - ;
- : size ( ptr -- size) block +size @ sizeof BLOCK + ;
-
- sizeof BLOCK .
- here 1000 true BLOCK x here swap - .
- x .
- x block .
- x block +size @ .
- x size . cr
-
- forth only
-
-