home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 3 / CDPDIII.bin / pd / programming / gnusmalltalk / cstruct.st < prev    next >
Text File  |  1992-02-16  |  6KB  |  200 lines
  1. "======================================================================
  2. |
  3. | Copyright (C) 1990, 1991, 1992 Free Software Foundation, Inc.
  4. | Written by Steve Byrne.
  5. |
  6. | This file is part of GNU Smalltalk.
  7. |
  8. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  9. | under the terms of the GNU General Public License as published by the Free
  10. | Software Foundation; either version 1, or (at your option) any later version.
  11. | 
  12. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  13. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  14. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  15. | details.
  16. | 
  17. | You should have received a copy of the GNU General Public License along with
  18. | GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  19. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  20. |
  21.  ======================================================================"
  22.  
  23. "
  24. |     Change Log
  25. | ============================================================================
  26. | Author       Date       Change 
  27. | sbb         16 Feb 92      created summer 90.
  28. |
  29. "
  30.  
  31. CObject variableWordSubclass: #CStruct
  32.     instanceVariableNames: ''
  33.     classVariableNames: 'typeMap'
  34.     poolDictionaries: ''
  35.     category: 'C structures'
  36. !
  37.  
  38.  
  39. !Integer methodsFor: 'extension'!
  40.  
  41. alignTo: anInteger
  42.     "Like ceilingTo (if there were one)"
  43.     "^(self + anInteger - 1) // anInteger * anInteger"
  44.     ^(self + anInteger - 1) truncateTo: anInteger
  45. ! !
  46.  
  47.  
  48.  
  49. !CStruct class methodsFor: 'instance creation'!
  50.  
  51. initialize
  52.     typeMap _ Dictionary new.
  53.     typeMap at: #long put: #CLongType; 
  54.         at: #uLong put: #CULongType;
  55.         at: #char put: #CCharType;
  56.         at: #uChar put: #CUCharType;
  57.         at: #short put: #CShortType;
  58.         at: #uShort put: #CUShortType;
  59.         at: #float put: #CFloatType;
  60.         at: #double put: #CDoubleType;
  61.         at: #string put: #CStringType.
  62. !
  63.  
  64.  
  65. newStruct: structName declaration: array
  66.     | type name newClass offset maxAlignment str inspStr |
  67.     newClass _ CStruct variableWordSubclass: structName asSymbol
  68.                instanceVariableNames: ''
  69.                classVariableNames: ''
  70.                poolDictionaries: ''
  71.                category: 'Synthetic Class'.
  72.  
  73.     offset _ 0.
  74.     maxAlignment _ 1.
  75.     inspStr _ WriteStream on: (String new: 8).
  76.     inspStr nextPutAll: 'inspect'; nl.
  77.     "Iterate through each member, doing alignment, size calculations,
  78.      and creating accessor methods"
  79.     array do:
  80.     [ :dcl | name _ dcl at: 1.
  81.          type _ dcl at: 2.
  82.          self emitInspectTo: inspStr for: name.
  83.    "stdout nextPutAll: 'name is '; nextPutAll: name; nl;
  84.        nextPutAll: 'type is '; nextPutAll: type printString; nl."
  85.          self computeTypeString: type block:
  86.              [ :size :alignment 
  87.                :typeString | 
  88.     "offset printNl."
  89.                      
  90.                      offset _ offset alignTo: alignment.
  91.     "stdout nextPutAll: 'size '.  size printNl.
  92.     stdout nextPutAll: 'offset: '; nextPutAll: offset printString; 
  93.     nextPutAll: ' alignment '; nextPutAll: alignment printString; nl."
  94.     "stdout nextPutAll: 'typestring '; nextPutAll: typeString; nl."
  95.                      maxAlignment _ alignment max: 
  96.                      maxAlignment.
  97.                      str _ WriteStream on: (String new: 20).
  98.                      str nextPutAll: name;
  99.                      nextPutAll: '
  100.     ^self at: '; nextPutAll: offset printString;
  101.                      nextPutAll: ' type: ', typeString.
  102. " str contents printNl.
  103.     stdout nextPutAll: 'size '.  size printNl."
  104.                      newClass compile: str contents.
  105.                      offset _ offset + size
  106.                      ]
  107.              ].
  108.     newClass compile: inspStr contents.
  109.     self compileSize: offset align: maxAlignment for: newClass.
  110.     newClass class compile: 'new
  111.     ^self alloc: self sizeof'
  112. !                    
  113.             
  114.             
  115. computeTypeString: type block: aBlock
  116.     | typeClass typeClassName |
  117.     type class == Array
  118.     ifTrue: [ self computeAggregateType: type block: aBlock ]
  119.     ifFalse:        "must be a type name, either built in or 
  120.                  struct"
  121.         [ typeClassName _ typeMap at: type
  122.                   ifAbsent: [ nil ].
  123.           typeClassName notNil
  124.           ifTrue: [ typeClass _ Smalltalk at: typeClassName.
  125.                 aBlock value: typeClass subType sizeof
  126.                    value: typeClass subType alignof
  127.                    value: typeClassName ]
  128.           ifFalse: [ typeClass _ Smalltalk at: type.
  129.                  aBlock value: typeClass sizeof
  130.                     value: typeClass alignof
  131.                     value: '(CType baseType: ', type, ')' ]
  132.           ]
  133. !
  134.  
  135. computeAggregateType: type block: aBlock
  136.     "Format:
  137.         (array int 3)
  138.         (ptr FooStruct)
  139.     "
  140.     | structureType |
  141.     " ### Should check for 2 or 3 elts only "
  142.     structureType _ type at: 1.
  143.     structureType == #array 
  144.     ifTrue: [ ^self computeArrayType: type block: aBlock ].
  145.     structureType == #ptr
  146.     ifTrue: [ ^self computePtrType: type block: aBlock ].
  147. !
  148.     
  149. computeArrayType: type block: aBlock
  150.     | numElts subType |
  151.     subType _ type at: 2.
  152.     numElts _ type at: 3.
  153.     self computeTypeString: subType
  154.      block: [ :size :alignment 
  155.           :typeString | aBlock value: size * numElts
  156.                        value: alignment
  157.                        value: '(CType baseType: CArray ',
  158.                            'subType: ', typeString,
  159.                                            ' numElements: ',
  160.                                    (numElts printString),
  161.                               ')' ]
  162. !
  163.  
  164. computePtrType: type block: aBlock
  165.     | subType |
  166.     subType _ type at: 2.
  167.     self computeTypeString: subType
  168.      block: [ :size :alignment 
  169.           :typeString | aBlock value: CPtr sizeof
  170.                        value: CPtr alignof
  171.                        value: '(CType baseType: CPtr
  172.                               subType: ', typeString,
  173.                               ')' ]
  174. !
  175.  
  176.  
  177. compileSize: size align: alignment for: aClass
  178.     size _ size alignTo: alignment.
  179.     aClass compile: 'sizeof
  180.     ^self class sizeof'.
  181.     aClass compile: 'alignof
  182.     ^self class alignof'.
  183.     aClass class compile: 'sizeof
  184.     ^', (size printString).
  185.     aClass class compile: 'alignof
  186.     ^', (alignment printString)
  187. !
  188.  
  189. emitInspectTo: str for: name
  190.     str nextPutAll: '    stdout nextPutAll: ''';
  191.     nextPutAll: name;
  192.     nextPutAll: ':''.'; nl.
  193.     str nextPutAll: '    self ';
  194.     nextPutAll: name;
  195.     nextPutAll: ' inspect.'; nl
  196. !!
  197.  
  198. CStruct initialize!
  199.  
  200.