( COMPATIBLE STRUCTURES--TYPE BROWSER Version: 1.0.1 File: shotype.fs Author: David.N.Williams@umich.edu License: LGPL Starting date: July 2, 1995 Last revision: July 10, 1995 [version 1.0] June 14, 2000 [version 1.0.1] ) \ Copyright (C) 2000 by David N. Williams ( This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or at your option any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. Please see the file POLITENESS included with this distribution. ) \ *** BEGIN nonportable stuff : .token ( token.dfa -- ) ( This word is not portable, because of the phrase 6 - NFA WCOUNT below. If possible, recode it to do your system's method for converting a dfa to a name field address. If not, you could rewrite the word TOKEN so it copies the names of newly CREATE'd tokens to let you get at them. Or you could replace the line as indicated below. ) ?dup IF 6 - nfa wcount type \ for simple portability, replace this line with \ ." id " 0 .r ELSE ." anonymous" THEN ; \ hide-case ans-on hide-case \ *** END nonportable stuff CR .( Loading file: cstruct.fs) S" cstruct.fs" INCLUDED : .0 ( n -- ) 0 .R ; : .2 ( n -- ) 2 .R ; : hex. ( n -- ) BASE @ >R HEX . R> BASE ! ; : .class ( class -- ) CASE unstruct-class OF ." type unstruct" ENDOF struct-class OF ." type struct" ENDOF atomic-class OF ." type atomic" ENDOF array-class OF ." type array" ENDOF union-class OF ." type union" ENDOF bit-field-class OF ." bit-field type" ENDOF ENDCASE ; : shotype ( type -- ) ( Show the type definition parameters for a general type. In the present context, it would be silly to factor this word. ) DUP >type-size @ ( type size) SWAP DUP >type-class @ ( size type class) SWAP DUP >type-align @ SWAP ( size class align type) LOCALS| type align class size | BASE @ >R DECIMAL CR class CASE unstruct-class OF ." unstruct type, size " size .0 ." , alignment " align .0 ENDOF struct-class OF ." struct type, size " size .0 ." , alignment " align .0 type >field-parms type >#fields @ CR ." fields:" 0 DO ( field-parms) CR I 1+ .2 ." . " DUP @ .token ." : offset " DUP >field-os @ .0 ." , " DUP >field-type @ >type-class @ .class ." , type pointer hex " DUP >field-type @ hex. /field-parms + LOOP DROP ENDOF atomic-class OF ." atomic type, size " size .0 ." , alignment " align .0 ENDOF array-class OF ." array type, size " size .0 ." , alignment " align .0 ." ," CR 2 SPACES type >ar-#elems @ . ." array elements of " type >ar-elemtype @ dup >type-class @ .class ." , size " dup /type .0 ." , alignment " /align .0 ENDOF union-class OF ." union type, size " size .0 ." , alignment " align .0 type >field-parms type >#fields @ CR ." fields:" 0 DO ( field-parms) CR I 1+ .2 ." . " DUP @ .token ." : offset " DUP >field-os @ .0 ." , " DUP >field-type @ >type-class @ .class ." , type pointer hex " DUP >field-type @ hex. /field-parms + LOOP ( field-parms) DROP ENDOF bit-field-class OF ." bit-field type, container(s) size " size .0 ." , container alignment " align .0 ." ," CR ." max bit width " type >bf-max#bits @ .0 ." , bit offset " type >bf-os @ .0 ." , bits in field " type >bf-#bits @ .0 ENDOF ." Type class " class . ." not implemented." ENDCASE R> BASE ! ; : }shotype ( id_m ... id_1 stype|utype -- ) \ syntax: { name_m ... name_1 stype|utype.word }shotype ( Show the type definition parameters for a structure or union field, with a complete or incomplete chain for nested substructures. There has to be at least one argument. Then, for example, { utype.word }shotype is equivalent to utype.word shotype ) }# 1- SWAP >sfo&type shotype DROP ; \ Sample structures for browsing. struct{ cint 3 bit-field george cint 5 bit-field sue cint 25 bit-field jimmy cint 32 bit-field melissa }struct bits.s union{ cint 3 bit-field george cint 5 bit-field sue cint 25 bit-field jimmy cint 32 bit-field melissa }union bits.u struct{ cint 3 bit-field george }struct one.s union{ cint 3 bit-field george }union one.u struct{ cint field george cint field sue }struct try.s union{ cint field george cint field sue }union try.u struct{ cchar field sue 10 clong array-field george }struct harry.s union{ cchar field sue 10 clong array-field george }union harry.u struct{ 15 harry.s array-field arthur 20 harry.u array-field marie }struct harrys.s union{ 15 harry.s array-field arthur 20 harry.u array-field marie }union harrys.u \ Sample use of SHOTYPE and }SHOTYPE. CR .( Sample: bits.s shotype) bits.s shotype CR CR .( Sample: { bits.s }shotype \ same as bits.s shotype) { bits.s }shotype CR CR .( Sample: { sue bits.s }shotype) { sue bits.s }shotype CR CR .( Sample: { jimmy bits.s }shotype) { jimmy bits.s }shotype CR CR .( Sample: { melissa bits.s }shotype) { melissa bits.s }shotype