home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / OOP / STIX.TAR / stix / generr.st < prev    next >
Encoding:
Text File  |  1991-09-13  |  6.6 KB  |  200 lines
  1. "======================================================================
  2. |
  3. | Copyright (C) 1990, 1991 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. "
  25. |     Change Log
  26. | ============================================================================
  27. | Author       Date       Change 
  28. | sbyrne     24 May 90      created.
  29. |
  30. "
  31.  
  32. Smalltalk at: #DataTypeMap put: Dictionary new.
  33. Smalltalk at: #DataTypeSize put: Dictionary new!
  34.  
  35.  
  36. DataTypeMap at: #card8 put: #ubyte.
  37. DataTypeMap at: #bool put: #byte.
  38. DataTypeMap at: #keycode put: #byte.
  39. DataTypeMap at: #card16 put: #uword.
  40. DataTypeMap at: #int16 put: #word.
  41. DataTypeMap at: #setOfKeyButMask put: #word.
  42. DataTypeMap at: #card32 put: #ulong.
  43. DataTypeMap at: #window put: #long.
  44. DataTypeMap at: #drawable put: #long.
  45. DataTypeMap at: #atom put: #long.
  46. DataTypeMap at: #colormap put: #long.
  47. DataTypeMap at: #timestamp put: #long.
  48.  
  49.  
  50.  
  51. DataTypeSize at: #card8 put: 1.
  52. DataTypeSize at: #bool put: 1.
  53. DataTypeSize at: #keycode put: 1.
  54. DataTypeSize at: #card16 put: 2.
  55. DataTypeSize at: #int16 put: 2.
  56. DataTypeSize at: #setOfKeyButMask put: 2.
  57. DataTypeSize at: #card32 put: 4.
  58. DataTypeSize at: #window put: 4.
  59. DataTypeSize at: #drawable put: 4.
  60. DataTypeSize at: #atom put: 4.
  61. DataTypeSize at: #colormap put: 4.
  62. DataTypeSize at: #timestamp put: 4
  63. !
  64.  
  65. !Object class methodsFor: 'hacking'!
  66.  
  67. genErrorInit
  68.     | stream |
  69.     stream _ FileStream open: 'Xerr.st' mode: 'w'.
  70.     stream close.
  71. !
  72.  
  73. genErrorClass: className args: anArray
  74.     | stream |
  75.     stream _ FileStream open: 'Xerr.st' mode: 'a'.
  76.     self genErrorClassDef: className on: stream args: anArray.
  77.     self genErrorClassMethods: className on: stream args: anArray.
  78.     stream nextPut: Character newPage.
  79.     stream nl.
  80.     stream close
  81. !
  82.  
  83. " private definitions "
  84.  
  85. genErrorClassDef: className on: aStream args: anArray
  86.     self genClassDef: 'Error' forClass: className on: aStream args: anArray
  87. !
  88.  
  89. genClassDef: type forClass: className on: aStream args: anArray
  90.     'X', type, ' subclass: #' printOn: aStream.
  91.     className, type printOn: aStream.
  92.     aStream nl.
  93.     self genClassInstVars: anArray on: aStream.
  94. '    classVariableNames: ''''
  95.     poolDictionaries: ''''
  96.     category: ''X hacking''
  97. !' printOn: aStream.
  98.     aStream nl.
  99.     aStream nl
  100. !
  101.  
  102. genErrorClassMethods: className on: aStream args: anArray
  103.     self genClassMethods: 'Error' forClass: className on: aStream args: anArray
  104. !
  105.  
  106. genClassMethods: type forClass: className on: aStream args: anArray
  107.     | totalBytes dataType | 
  108.     '!', className, type, ' class methodsFor: ''instance creation''!
  109.  
  110. newFrom: aStream
  111.     ^self new initFrom: aStream
  112. !!
  113.  
  114. ' printOn: aStream.
  115.     '!', className, type ' methodsFor: ''private''!
  116.  
  117. ' printOn: aStream.
  118. 'initFrom: aStream' printOn: aStream.  aStream nl.
  119.     totalBytes _ 0.
  120.     anArray do:
  121.     [ :var | '    ' printOn: aStream.
  122.          var size > 1
  123.              ifTrue: [ (var at: 1) printOn: aStream.
  124.                    ' _ ' printOn: aStream ].
  125.          'aStream ' printOn: aStream.
  126.          dataType _ (var at: var size).
  127.                  (self mapType: dataType) printOn: aStream.
  128.          totalBytes _ totalBytes + (self typeSize: dataType).
  129.          '. ' printOn: aStream. aStream nl ].
  130.     '    aStream skipBytes: ' printOn: aStream.
  131.     (30 - totalBytes) printOn: aStream.
  132.     aStream nl.
  133.     '!!' printOn: aStream.
  134.     aStream nl.
  135.     aStream nl.
  136. !
  137.  
  138. mapType: aType
  139.     ^DataTypeMap at: aType
  140.          ifAbsent: [ self error: 'no such type: ', (aType printString) ]
  141. !
  142.  
  143. typeSize: aType
  144.     ^DataTypeSize at: aType
  145.              ifAbsent: [ self error: 'no such type: ', (aType printString) ]
  146. !    
  147.  
  148. genClassInstVars: anArray on: aStream
  149.     | varName |
  150.     aStream tab.
  151.     'instanceVariableNames: ''' printOn: aStream.
  152.     anArray do: 
  153.     [ :var | var size = 2
  154.              ifTrue: [ (#(sequenceNumber minorOp majorOp)
  155.                    indexOf: (varName _ var at: 1)) = 0
  156.                    ifTrue: [ varName, ' ' printOn: aStream ] ]
  157.              ].
  158.     '''' printOn: aStream.
  159.     aStream nl
  160. !!
  161.  
  162. Object genErrorInit.
  163. Object genErrorClass: 'Request' 
  164.     args: #((sequenceNumber card16) (card32) (minorOp card16) (majorOp card8)).
  165. Object genErrorClass: 'Value'
  166.     args: #((sequenceNumber card16) (badValue card32) (minorOp card16) (majorOp card8)).
  167. Object genErrorClass: 'Window' 
  168.     args: #((sequenceNumber card16) (badId card32) (minorOp card16) (majorOp card8)).
  169. Object genErrorClass: 'Pixmap'
  170.     args: #((sequenceNumber card16) (badId card32) (minorOp card16) (majorOp card8)).
  171. Object genErrorClass: 'Atom'
  172.     args: #((sequenceNumber card16) (badId card32) (minorOp card16) (majorOp card8)).
  173. Object genErrorClass: 'Cursor'
  174.     args: #((sequenceNumber card16) (badId card32) (minorOp card16) (majorOp card8)).
  175. Object genErrorClass: 'Font' 
  176.     args: #((sequenceNumber card16) (badId card32) (minorOp card16) (majorOp card8)).
  177. Object genErrorClass: 'Match'
  178.     args: #((sequenceNumber card16) (card32) (minorOp card16) (majorOp card8)).
  179. Object genErrorClass: 'Drawable'
  180.     args: #((sequenceNumber card16) (badId card32) (minorOp card16) (majorOp card8)).
  181. Object genErrorClass: 'Access' 
  182.     args: #((sequenceNumber card16) (card32) (minorOp card16) (majorOp card8)).
  183. Object genErrorClass: 'Alloc'
  184.     args: #((sequenceNumber card16) (card32) (minorOp card16) (majorOp card8)).
  185. Object genErrorClass: 'Colormap' 
  186.     args: #((sequenceNumber card16) (badId card32) (minorOp card16) (majorOp card8)).
  187. Object genErrorClass: 'GContext' 
  188.     args: #((sequenceNumber card16) (badId card32) (minorOp card16) (majorOp card8)).
  189. Object genErrorClass: 'IDChoice'
  190.     args: #((sequenceNumber card16) (badId card32) (minorOp card16) (majorOp card8)).
  191. Object genErrorClass: 'Name'
  192.     args: #((sequenceNumber card16) (card32) (minorOp card16) (majorOp card8)).
  193. Object genErrorClass: 'Length'
  194.     args: #((sequenceNumber card16) (card32) (minorOp card16) (majorOp card8)).
  195. Object genErrorClass: 'Implementation'
  196.     args: #((sequenceNumber card16) (card32) (minorOp card16) (majorOp card8))
  197. !
  198.  
  199. Smalltalk quitPrimitive!
  200.