home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / EFFO / pd6.lzh / TST / structures.tst < prev    next >
Text File  |  1989-12-21  |  1KB  |  76 lines
  1. .( Loading Structure Test...) cr
  2.  
  3. #include structures.f83
  4.  
  5. structures
  6.  
  7. .( 1: Print size of primitive fields) cr
  8.  
  9. sizeof byte .
  10. sizeof word .
  11. sizeof ptr  .
  12. sizeof long .
  13. sizeof enum .
  14. cr
  15.  
  16.  
  17. .( 2: Allocate some data) cr
  18. here . new word . here . cr
  19.  
  20.  
  21. .( 3: Define a list structures) cr
  22.  
  23. struct.type LIST
  24.   ptr +next
  25. struct.init ( self -- )
  26.   nil swap +next !
  27. struct.end
  28.  
  29. sizeof LIST . new LIST dup . +next @ .  cr
  30.  
  31.  
  32. .( 4: Define a double linked list) cr
  33.  
  34. struct.type QUEUE
  35.   struct LIST +succ
  36.   struct LIST +pred
  37. struct.init ( flag self -- )
  38.   swap
  39.   if dup over +succ !
  40.     dup +pred !
  41.   else
  42.     dup +succ as LIST initiate
  43.     +pred as LIST initiate
  44.   then
  45. struct.end
  46.  
  47. sizeof QUEUE . cr
  48. true new QUEUE dup . dup +succ +next @ . +pred +next @ . cr
  49. false new QUEUE dup . dup +succ +next @ . +pred +next @ . cr
  50.  
  51.  
  52. .( 5: Define a block using double linked list and instance function) cr
  53.  
  54. struct.type BLOCK
  55.   struct QUEUE +queue
  56.   long   +size
  57. struct.init ( size flag self -- )
  58.   swap over +queue as QUEUE initiate
  59.   over allot +size !
  60. struct.does ( self -- ptr)
  61.   sizeof BLOCK +
  62. struct.end
  63.  
  64. : block ( ptr -- block)  sizeof BLOCK - ;
  65. : size ( ptr -- size)  block +size @ sizeof BLOCK + ;
  66.  
  67. sizeof BLOCK . 
  68. here 1000 true BLOCK x here swap - . 
  69. x . 
  70. x block . 
  71. x block +size @ .
  72. x size . cr
  73.  
  74. forth only
  75.  
  76.