home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / EFFO / pd6.lzh / LIB / TILE / structures.f83 < prev   
Text File  |  1989-12-23  |  4KB  |  115 lines
  1. \
  2. \  STRUCTURE DEFINITIONS
  3. \
  4. \  Copyright (c) 1989 by Mikael R.K. Patel
  5. \
  6. \  Computer Aided Design Laboratory (CADLAB)
  7. \  Department of Computer and Information Science
  8. \  Linkoping University
  9. \  S-581 83 LINKOPING
  10. \  SWEDEN
  11. \
  12. \  Email: mip@ida.liu.se
  13. \
  14. \  Started on: 30 June 1988
  15. \
  16. \  Last updated on: 26 November 1989
  17. \
  18. \  Dependencies:
  19. \       (forth) none
  20. \
  21. \  Description:
  22. \       Allows aggregates of data to be described as structures.
  23. \
  24. \  Copying:
  25. \       This program is free software; you can redistribute it and\or modify
  26. \       it under the terms of the GNU General Public License as published by
  27. \       the Free Software Foundation; either version 1, or (at your option)
  28. \       any later version.
  29. \
  30. \       This program is distributed in the hope that it will be useful,
  31. \       but WITHOUT ANY WARRANTY; without even the implied warranty of
  32. \       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  33. \       GNU General Public License for more details.
  34. \
  35. \       You should have received a copy of the GNU General Public License
  36. \       along with this program; see the file COPYING.  If not, write to
  37. \       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  38.  
  39. .( Loading Structure definitions...) cr
  40.  
  41. vocabulary structures
  42.  
  43. structures definitions 
  44.  
  45. 0 field +size ( struct -- size) private
  46. 4 field +initiate ( struct -- initiate) private
  47.  
  48. : as ( -- struct)  
  49.   ' >body                              ( Quote next symbol and access body)
  50.   [compile] literal ; immediate                ( If compiling generate a literal)
  51.  
  52. : this ( -- ptr)  
  53.   last >body ;                         ( Access the body of the last symbol)
  54.  
  55. : initiate ( ptr struct -- )  
  56.   +initiate @ ?dup                     ( Access initiate. code pointer)
  57.   if >r else drop then ;               ( If available perform initialization)
  58.  
  59. : make ( struct -- ptr) 
  60.   here dup >r                          ( Save pointer to instance)
  61.   over +size @ allot                   ( Access size and allocate memory)
  62.   swap initiate r> ;                   ( Perform initialization)
  63.  
  64. : new ( -- ptr)  
  65.   [compile] as                                 ( Take the next symbol, "as")
  66.   ?compile make ; immediate            ( And "make" an instance)
  67.  
  68. : sizeof ( -- size)  
  69.   ' >body +size @                      ( Access size of structure)
  70.   [compile] literal ; immediate                ( And make literal if compiling)
  71.  
  72. : assign ( a b -- )  
  73.   [compile] sizeof                     ( Access size and assign instance)
  74.   ?compile cmove ; immediate
  75.  
  76. : struct.type ( -- struct offset0)  
  77.   create here 0 0 , 0 ,                ( Allocate initial struct information)
  78.   does> create make drop ;             ( Create a new instance)
  79.  
  80. : bytes ( offset1 n -- offset2)  
  81.   over field + ;                       ( Create an access field of "n" bytes)
  82.  
  83. : align ( offset1 -- offset2)  
  84.   dup 1 and + ;                                ( Align field offset to even address)
  85.  
  86. : field ( bytes -- )  
  87.   create , nil ,                       ( Create a predefined field type)
  88.   does> @ bytes ; private              ( At run-time create field names)
  89.  
  90. : struct ( -- )  
  91.   [compile] sizeof bytes ;             ( Create a structure sized field name)
  92.  
  93. ( Initial set of field names)
  94. 1 field byte ( -- )
  95. 2 field word ( -- )
  96. 4 field long ( -- )
  97. 4 field ptr  ( -- )
  98. 4 field enum ( -- )
  99.  
  100. : struct.init ( struct offset3 -- )
  101.   align over +size !                   ( Assign size of structure type)
  102.   here swap +initiate ! ] ;            ( And pointer to initialization code)
  103.  
  104. : struct.does ( -- ) 
  105.   [compile] does>                      ( Do what does-does)
  106. ; immediate compilation
  107.  
  108. : struct.end ( [] or [struct offset3] -- )  
  109.   compiling                            ( Check compilation status)
  110.   if [compile] ;                       ( If compiling then end definition)
  111.   else swap +size ! then ; immediate   ( Else assign size of structure type)
  112.  
  113. forth only
  114.  
  115.