🚀 go-pugleaf

Submitted-by: munroe@dmc.com (Dick Munroe)
Posting-number: Volume 3, Issue 102
Archive-name: sdlgcc/part01

       SDLGCC is a back end for SDL that produces include
       files for VAX C, GCC, and "vanilla" ansi C compilers. 
       It differs from SDLCC as distributed in the UNSDL
       package a number of ways [which are documented in the
       file AAAREADME.1ST].

-- 
Dick Munroe				Internet: munroe@dmc.com
Doyle Munroe Consultants, Inc.		UUCP: ...uunet!thehulk!munroe
267 Cox St.				Office: (508) 568-1618
Hudson, Ma.				FAX: (508) 562-1133

GET CONNECTED!!! Send mail to info@dmc.com to find out about DMConnection.
$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-010  25-Jun-1992
$!   On 22-JUL-1992 09:21:22.40   By user MUNROE 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 2 PARTS, TO KEEP EACH PART
$!  BELOW 100 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. AAAREADME.1ST;7
$!       2. COMPILE-GCC.COM;3
$!       3. SDLGCC.C;84
$!       4. SDLDEF.H;3
$!       5. SDLCC-CLD.CLD;8
$!       6. ALL4GCC.COM;2
$!       7. ALL5GCC.COM;6
$!       8. DEBUGGCC.COM;13
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ x = P1 - f$parse(P1,,,"version")
$ y = f$search(x)
$ if y .eqs. "" then $ goto file_absent
$ x = f$integer(f$parse(P1,,,"version")-";")
$ y = f$integer(f$parse(y,,,"version")-";")
$ if x .gt. y then $ goto file_absent
$ if f$mode() .eqs. "INTERACTIVE" then $ goto file_interactive
$ if x .eq. y then e "-W-EXISTS, File ''P1' exists. Skipped."
$ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists. Skipped."
$file_delete:
$ delete 'f'*
$ exit
$file_interactive:
$ if x .eq. y then e "-W-EXISTS, File ''P1' exists."
$ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists."
$ read/error=file_delete/end=file_delete-
  /prompt="Create new version [y/n]: " -
  sys$command x
$ if .not. x then $ e "-W-SKIPPED, File ''P1' skipped."
$ if .not. x then $ goto file_delete
$ P1 = P1 - f$parse(P1,,,"version")
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
XIf you don't have Joe Meadows UNSDL product, you must get it in
Xorder to utilize SDLGCC.  You may retrieve a copy of UNSDL from
XWKUVX1.BITNET by running the following command procedure
X
X$!---------------------------------------------------------------
X$ define/user foo your-favorite-transport%"""filserv@wkuvx1.bitnet"""
X$ mail sys$input: foo
X$ deck
XSEND UNSDL
X$ eod
X$ exit
X$!---------------------------------------------------------------
X
XOnce you have UNSDL, you may proceed to use this back end.
X
XSDLGCC is a back end for SDL that produces include file for VAX
XC, GCC, and "vanilla" ansi C compilers.  It differs from SDLCC as
Xdistributed in the UNSDL package a number of ways:
X
X1. The IFNDEF brackets generated when an output filename is given
Xare correct.
X
X2. The back end will generate variant data structures suitable
Xfor VAX C (as did SDLCC), but it will ALSO generate a functional
Xequivalent for GCC through the use of DEFINEs to flatten the name
Xspace.
X
X3. void and void * are used to represent types which can be
X"anything".  This is more consistent with the C language
Xsemantics and is a LOT safer when feeding the include files into
XGCC when running in C++ mode.
X
X4. Entries in data structures which point to functions are
Xcorrectly typed AND have a dummy variable parameter list added to
Xthem.  This allows G++ to actually USE such entries without
Xcasting and all sorts of other ugliness.  At some point I may get
Xaround to generating real parameter lists for such entries but I
Xdon't need that functionality at this time.
X
X5. When VAX C include files are generated, the file contains a
X#pragma nostandard/standard bracket around the content of the
Xfile.
X
X6. When GCC include files are generated, the file contains a C
Xlinkage bracket around the content of the file.
X
X7. The version of the GCC compiler I have complains about things
Xwith the definition double float which I'm assuming is VAX C
Xspecific.  I don't do a whole lot of floating point and NONE of
Xit with the lib$routines, so I'm not going to test this other
Xthan to warn you that the when generating files for the GCC
Xcompiler, the SDLGCC back end won't generate "double float" for g
Xand h float types.
X
X8. When prototypes are NOT being generated a variable argument
Xlist is generated for GCC.  It is NOT generated for VAX C as that
Xcompler doesn't need it.
X
XThis kit consists of the following files:
X
X`09AAAREADME.1ST
X`09COMPILE-GCC.COM
X`09SDLGCC.C
X`09SDLDEF.H
X`09SDLCC-CLD.CLD
X`09ALL4GCC.COM
X`09ALL5GCC.COM
X`09DEBUGGCC.COM
X
XBEFORE running COMPILE-GCC.COM you MUST have compiled UNSDL.
XThe SDLGCC kit is intended to be built in the SAME directory as
Xthat containing UNSDL.
X
XALL5GCC.COM builds a full set of VMS include files for GCC,
Xincluding prototypes.  ALL4GCC does the same thing, but excludes
Xprototypes.  Instructions for use of SDLGCC are analogous to
Xthose given for using any SDL back end in UNSDL.
X
XThe instructions given for linking to SDL back ends is incorrect.
XAll you need to do is define a logical name of the form:
X
X`09$ DEFINE SDLlanguage-name ...
X
Xyou do NOT need to define SDL$SHARE.
X
XThe CLI interface to SDLGCC is slightly different from that of
XSDLCC, but the CLD object file is completely compatible and
Xreplaces the one shipped with the UNSDL kit.  The full interface
X(contained in the "options" string fed to UNSDL) to the SDLGCC
Xmodule is:
X
X
X`09INDENT=value
X`09`09number of spaces to indent for structures/unions
X`09MASK=`5BHEX `7C DECIMAL`5D
X`09`09us HEX or DECIMAL masks for #define
X`09CASE=`5BORIGINAL `7C MIXED `7C UPPER `7C LOWER`5D
X`09`09select the case to use, ORIGINAL specifies that the original
X`09`09case is to be used, MIXED specifies that #defines will be
X`09`09done in uppercase, and structure/union/variable declarations
X`09`09will be done in lower case. UPPER specifies that everything
X`09`09will be uppercased, and LOWER specifies that everything
X`09`09will be lowercased. Note that this does not modify text in
X`09`09comments..
X`09`5BNO`5DPROTOTYPES
X`09`09specifies that function prototypes are to be used. Note that
X`09`09this feature is a use at your own risk adventure. I've noticed
X`09`09several functions which were declared wrong in the original
X`09`09SDL files.. (i.e. lib$getjpi, lib$getdvi, lib$getsyi)
X`09`5BNO`5DCOMMENTS
X`09`09specifies wether to include comments or not. Can reduce
X`09`09the size significantly if you use NOCOMMENTS
X`09MODULES=(module-list)
X`09`09Allows you to extract a single module (or list of modules).
X`09`09The module name(s) can be wildcarded.
X`09`5BNO`5DSEPARATE
X`09`09Specifies that separate output files are to be created
X`09`09for each module. The files will be named according to
X`09`09the module name.
X`09COMPILER=`5BVAXC `7C GCC`5D
X`09`09Include files for the VAX C or Gnu C compiler are
X`09`09generated.  The default is VAXC.
X`09`5BNO`5DVARIANT
X`09`09Generate variant struct/union defininitions or
X`09`09their functional equivalent.  The default is
X`09`09NOVARIANT.
X
XIf you make any changes or fix any problems let me know what the
Xfix was as I'ld like to keep my stuff current.  If you have any
Xproblem, let me know and I'll see what I can do about fixing it.
X
XUse this stuff in good health.
X
XDick Munroe
XDoyle, Munroe Consultants, Inc.
X267 Cox St.
XHudson, Ma. 01749
X(508) 568-1618
X(FAX) (508) 562-1133
Xmunroe@dmc.com
$ CALL UNPACK AAAREADME.1ST;7 402858326
$ create 'f'
X$ set command/object sdlcc-cld.cld
X$ cc/debug/noopt sdlgcc.c
X$ link/share/debug sdlgcc.obj,misc.obj,readable.obj,sdlcc-cld.obj,sdl/option
$ CALL UNPACK COMPILE-GCC.COM;3 674184311
$ create 'f'
X/*
X** Version 1.0 20-Jul-92
X**
X** This program is mapped in by SDLNPARSE, it does not get run directly.
X** You may either use the provided UNSDL program, or use SDL/NOPARSE
X** directly.  It is based pretty much completely on the SDLCC module provide
Vd by
X** Joe Meadows and is intended to generate include files acceptable to GCC a
Vnd,
X** more particularly, GCC when running in C++ mode.  To make this work, vari
Vant
X** structs and unions had to be eliminated.  This was done by replacing them
V by
X** a series of define statements that have the same effect as variant struct
Vures
X** and unions but are parsable by GCC.
X**
X**
X** 20-Jul-92 Dick Munroe
X**`09     Doyle, Munroe Consultants, Inc.
X**`09     267 Cox St.
X**`09     Hudson, Ma. 01749
X**`09     (508) 568-1618
X**`09     (FAX) (508) 562-1133
X**`09     munroe@dmc.com
X**`09    `20
X**`09  Make a version of the CC UNSDL processor that does GCC include files.
X**`09  The multiple word primitive vax types, quad and octa word aren't bein
Vg
X**`09  represented properly.
X**`09  Handle the vaxc variant structure, the GCC #define equivalents, and
X**`09  the novariant cases (In other words, this generates everything that
X**`09  SDLCC does, only "better").
X**`09  Use void and void * for anything and anything pointer generation.
X**`09  This is more consistent with the target language and a LOT more type
X**`09  safe when dealing with C++.
X**`09  For parameters and entries in structures that are pointers to
X**`09  functions, get the return type generated properly and a dummy
X**`09  parameter list, at least of the form (...) so that type checking can
X**`09  be avoided.
X**`09  Generate logic to add C linkage specifications if __cplusplus is
X**`09  defined (thus making the generated file fully compatibile with GCC
X**`09  when running in C++ mode, at least in theory).
X**`09  Include a #pragma no/standard bracket in include files generate with
X**`09  VMS variants.
X**`09  Note that if no variant is used, NO specialization either for GCC or
X**`09  for VAX C is done (neither C linkages nor VAXC #pragma statements are
X**`09  added).
X**`09  Parse the output file name so that when the IFNDEF is generated,
X**`09  device, directory, and extension is NOT include.
X**`09  DOUBLE FLOAT isn't valid for GCC, I don't know if DOUBLE is
X**`09  equivalent, but for now we'll assume that it is.  I don't use floatin
Vg
X**`09  point that much, so without some examination, I really DON'T know wha
Vt
X**`09  the problem is.
X**`09  Generate varying argument lists for gcc when generating prototype
X**`09  functions.
X**`09 `20
X  `20
X   7/20/89 Add "variants" clause
X
X   8/5/88 Fixed handling of structure/union ending.
X          removed the check for the 'bottom' flag, now all structures
X          and unions are closed after recursively displaying their
X          associated fields. This means that the comments meant for the
X          next structure will be included at the end of the previous
X          structure. Ugly. But it works.
X
X   8/3/88 modified to compile with GCC compiler.
X
X   7/15/88 modified to work with VMS 5.0
X
X   3/11/88 Added #ifdef, supposrt for mixed case, better comments
X
X   2/4/88 Modified a few things, renamed first arg to sdl$output
X          from outfile to outputname to avoid conflict with the globally
X          declared filehandle of the (previously) same name.
X
X   Future:
X`09Add better handling for DFloat vs. GFloat
X`09use #if CC$gfloat to figure out which is in use.
X`09possibly define D/F and Hfloat with structures that
X`09actually define the mantissa et al correctly.
X**`09Add generation of full parameter list for function invocations within
X**`09parameter lists of other functions.  Do the same for entries.
X**`09Make sure that data generated to contain pointers to data will be
X**`09generated with parameter lists as well.
X**`09
X*/
X#include <stdio.h>
X#include <ctype.h>
X#include <descrip.h>
X#include <jpidef.h>
X#include "sdldef.h"
X
X#define CLI$_NEGATED 0X000381F8
X
Xint readable();
Xint uncc();
X
Xvoid print_variant_name(struct Node*,int) ;
Xstruct Node *resolveAddress(struct Node*) ;
X
X#define INDENT 4
X#define MAXLEVEL 20
X#define CASE 0
X#define MASK 1
X#define COMMENTS 1
X#define PROTOTYPES 0
X#define SEPARATE 0
X#define VARIANTS 0
X#define COMPILER 0
X
Xstatic FILE *outfile = 0;
Xstatic char out`5B256`5D;
Xstatic int maxlevel;
Xstatic char spaces`5BINDENT*MAXLEVEL+1`5D;
X
Xstatic struct sptr *variantName`5BMAXLEVEL`5D;
Xstatic char *structOrUnion`5BMAXLEVEL`5D ;
X
Xstatic int column;
Xstatic char *datatypes`5B`5D =
X    `7B"void "`09`09`09`09`09`09/*void*/,
X     "void *",`09`09`09`09`09`09/* address */
X     "char ",`09`09`09`09`09`09/* byte */
X     "char ",`09`09`09`09`09`09/* character */
X     "char ",`09`09`09`09`09`09/* boolean */
X     "char "`09`09`09`09`09`09/*decimal*/,
X     "double float "`09`09`09`09`09/*dfloat*/,
X     "float ",`09`09`09`09`09`09/* ffloat */
X     "double float "`09`09`09`09`09/*gfloat*/,
X     "int ",`09`09`09`09`09`09/*hfloat*/
X     "long int ",`09`09`09`09`09/* longword */
X     "int ",`09`09`09`09`09`09/*octaword*/
X     "int ",`09`09`09`09`09`09/*quadword*/
X     "unsigned ",`09`09`09`09`09/*bitfield*/
X     "short ",`09`09`09`09`09`09/*word*/
X     "struct ",`09`09`09`09`09`09/*structure*/
X     "union ",`09`09`09`09`09`09/*union*/
X     "int ",`09`09`09`09`09`09/*anything*/
X     "int (*",`09`09`09`09`09`09/*entry*/
X     "DFLOAT_COMPLEX",
X     "FFLOAT_COMPLEX",
X     "GFLOAT_COMPLEX",
X     "HFLOAT_COMPLEX"/* possibly, just guessing */ `7D;
X
Xstatic char isPrimitive`5B`5D =
X    `7B1,`09`09`09`09`09`09`09/*void*/
X     1,`09`09`09`09`09`09`09/* address */
X     1,`09`09`09`09`09`09`09/* byte */
X     1,`09`09`09`09`09`09`09/* character */
X     1,`09`09`09`09`09`09`09/* boolean */
X     0,`09`09`09`09`09`09`09/*decimal*/
X     1,`09`09`09`09`09`09`09/*dfloat*/
X     1,`09`09`09`09`09`09`09/* ffloat */
X     1,`09`09`09`09`09`09`09/*gfloat*/
X     0,`09`09`09`09`09`09`09/*hfloat*/
X     1,`09`09`09`09`09`09`09/* longword */
X     0,`09`09`09`09`09`09`09/*octaword*/
X     0,`09`09`09`09`09`09`09/*quadword*/
X     1,`09`09`09`09`09`09`09/*bitfield*/
X     1,`09`09`09`09`09`09`09/*word*/
X     1,`09`09`09`09`09`09`09/*structure*/
X     1,`09`09`09`09`09`09`09/*union*/
X     1,`09`09`09`09`09`09`09/*anything*/
X     1,`09`09`09`09`09`09`09/*entry*/
X     1,
X     1,
X     1,
X     1`09`09`09`09`09`09`09/* possibly, just guessing */ `7D;
X
Xstatic char isUnsigned`5B`5D =
X    `7B0,`09`09`09`09`09`09`09/*void*/
X     0,`09`09`09`09`09`09`09/* address */
X     1,`09`09`09`09`09`09`09/* byte */
X     1,`09`09`09`09`09`09`09/* character */
X     0,`09`09`09`09`09`09`09/* boolean */
X     0,`09`09`09`09`09`09`09/*decimal*/
X     0,`09`09`09`09`09`09`09/*dfloat*/
X     0,`09`09`09`09`09`09`09/* ffloat */
X     0,`09`09`09`09`09`09`09/*gfloat*/
X     0,`09`09`09`09`09`09`09/*hfloat*/
X     1,`09`09`09`09`09`09`09/* longword */
X     1,`09`09`09`09`09`09`09/*octaword*/
X     1,`09`09`09`09`09`09`09/*quadword*/
X     1,`09`09`09`09`09`09`09/*bitfield*/
X     1,`09`09`09`09`09`09`09/*word*/
X     0,`09`09`09`09`09`09`09/*structure*/
X     0,`09`09`09`09`09`09`09/*union*/
X     0,`09`09`09`09`09`09`09/*anything*/
X     0,`09`09`09`09`09`09`09/*entry*/
X     0,
X     0,
X     0,
X     0`09`09`09`09`09`09`09/* possibly, just guessing */ `7D;
X
Xstatic struct dsc$descriptor null =
X       `7B1,DSC$K_DTYPE_T,DSC$K_CLASS_S,"\0"`7D;
Xstatic struct dsc$descriptor cmd_prefix =
X       `7B8,DSC$K_DTYPE_T,DSC$K_CLASS_S,"UNSDLCC "`7D;
Xstatic struct dsc$descriptor command =
X`09`7B0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0`7D;
Xstatic struct dsc$descriptor string =
X`09`7B0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0`7D;
X
Xstatic struct Head *main_arg3;
Xstatic struct `7B
X    int indent;             /* number of spaces to indent per level */
X    unsigned outcase : 2;      /* 0=Original, 1=Natural, 2=Upper, 3=Lower */
X    unsigned mask : 1;      /* 0=decimal, 1=hex */
X    unsigned comments : 1;  /* 0=no comments, 1=comments */
X    unsigned separate : 1;  /* 0=don't separate, 1=do */
X    unsigned prototype : 1; /* 0=don't include prototypes, 1=do */
X    unsigned variant : 1;   /* 0=don't use variant_struct/union, 1=use`09
V      */
X`09`09`09    /* variant_struct/union`09      */
X    unsigned compiler: 1;   /* 0 => vax c, 1 => gcc. */
X`7D options;
X
Xstruct ModuleName `7B
X  struct dsc$descriptor name;
X  struct ModuleName *next;
X`7D;
Xstatic struct ModuleName SelectModules;
X
Xsdl$output(outputname,module,root)
X  struct sptr *outputname, *module;
X  struct Head *root;
X`7B
X  struct Node *node;
X  char out`5B256`5D;
X  char ifdef`5B256`5D ;
X  char *xxxPC ;
X  char *fileNamePC ;
X  int status,i;
X  int four=4;
X  int five=5;
X  long int imagecount,imagecountsaved;
X  struct dsc$descriptor imagecnt =
X           `7B4,DSC$K_DTYPE_T,DSC$K_CLASS_S,&imagecount`7D;
X  struct itmlst jpi`5B2`5D = `7B`7B4,JPI$_IMAGECOUNT,&imagecount,0`7D,`7B0,0
V,0,0`7D`7D;
X  struct ModuleName *mod;
X
X  for (i=0; i < (INDENT*MAXLEVEL); i++)
X    spaces`5Bi`5D = ' ';
X  spaces`5Bi`5D = '\0';
X  for (i = 0;  i < MAXLEVEL;  i++)
X  `7B
X    variantName`5Bi`5D = 0 ;
X    structOrUnion`5Bi`5D = 0 ;
X  `7D ;
X
X  options.indent = INDENT;
X  options.mask = MASK;
X  options.outcase = CASE;
X  options.comments = COMMENTS;
X  options.separate = SEPARATE;
X  options.prototype = PROTOTYPES;
X  options.variant = VARIANTS;
X  options.compiler = COMPILER ;
X `20
X  /* let's check for the symbol SDL_SYMBOL (defined in sdldef.h),
X     if it exists, we should set things up accordingly */
X  status = lib_get_symbol(SDL_SYMBOL,&string);
X  if (status & 1) `7B
X    /* pull out the first four bytes (the imagecount) and compare it
X       with our image count (make sure this isn't an old symbol */
X    /* well, get around to it eventually */
X    str$left(&imagecnt,&string,&four); /* numeric result in 'imagecount' */
X    str$right(&string,&string,&five);
X
X    /* save the image count (plus 1 for new image activation since unsdl) */
X    imagecountsaved = imagecount + 1;
X    /* get the real imagecount */
X    status = sys$getjpiw(0,0,0,&jpi,0,0,0);
X    if (!(status & 1)) return(status);
X    /* compare the imagecounts - should be equal */
X    if (imagecount == imagecountsaved) `7B
X      /* prefix command string with command */
X      str$copy_dx(&command,&cmd_prefix);
X      str$append(&command,&string);
X
X      /* need to parse the string */
X      status = cli$dcl_parse(&command,uncc);
X      if (!(status & 1))
X        return;
X
X      if (cli_get_value("P1.INDENT",&string) & 1) `7B
X        str$append(&string,&null);
X        options.indent = atoi(string.dsc$a_pointer);
X      `7D;
X
X      if (cli_present("P1.MASK.DECIMAL") & 1) options.mask = 0;
X      if (cli_present("P1.MASK.HEX") & 1) options.mask = 1;
X      if (cli_present("P1.CASE.ORIGINAL") & 1) options.outcase = 0;
X      if (cli_present("P1.CASE.MIXED") & 1) options.outcase = 1;
X      if (cli_present("P1.CASE.UPPER") & 1) options.outcase = 2;
X      if (cli_present("P1.CASE.LOWER") & 1) options.outcase = 3;
X      status = cli_present("P1.COMMENTS");
X      if (status & 1) options.comments = 1;
X      if (status == CLI$_NEGATED) options.comments = 0;
X      if (cli_present("P1.PROTOTYPES") & 1) options.prototype = 1;
X      if (cli_present("P1.VARIANTS") & 1) options.variant = 1;
X      if (cli_present("P1.SEPARATE") & 1) options.separate = 1;
X      if (cli_present("P1.COMPILER.VAXC") & 1) options.compiler = 0;
X      if (cli_present("P1.COMPILER.GCC") & 1) options.compiler = 1;
X      if (cli_present("P1.MODULES") & 1) `7B
X        mod = &SelectModules;
X        while (cli_get_value("P1.MODULES",&string) & 1) `7B
X          mod->next = calloc(1,sizeof(struct ModuleName));
X`09  mod = mod->next;
X          mod->name = string;
X          string.dsc$w_length = 0;
X          string.dsc$a_pointer = 0;
X        `7D;
X      `7D;
X    `7D;
X  `7D;
X
X  if (options.compiler != 0)
X  `7B
X    /*
X    ** For all compilers OTHER than VAX C, I'm assuming that the "double flo
Vat"
X    ** construct used for DFLOAT and GFLOAT types is invalid.  Use "double"
X    ** instead.
X    */
X   `20
X    datatypes`5BSDL$C_TYPE_DFLOAT`5D = "double " ;
X    datatypes`5BSDL$C_TYPE_GFLOAT`5D = "double " ;
X  `7D ;`09`09`09`09`09`09`09/* End if (options.compiler != 0)`09`09`09`09`09
V*/
X
X  maxlevel = (INDENT*MAXLEVEL) / ((options.indent == 0)?1:options.indent);
X  printf("Source: %.*s\n",root->banner_len,root->banner);
X
X  if (options.separate == 0) `7B
X    /* get outputname copied into local space, so I can add a zero to it. */
X    for (i=0; (i < outputname->len) && (outputname->str`5Bi`5D != ' '); i++)
X      out`5Bi`5D = outputname->str`5Bi`5D;
X    out`5Bi`5D = '\0';
X    /* if no output file name present, use module name. */
X    if (i==0) `7B
X      for (i=0; (i < module->len) && (module->str`5Bi`5D != ' '); i++)
X        out`5Bi`5D = module->str`5Bi`5D;
X      out`5Bi`5D = '.';
X      out`5Bi+1`5D = 'H';
X      out`5Bi+2`5D = '\0';
X    `7D;
X
X    /*
X    ** Extract the filname.ext;version portion of the file name.
X    */
X   `20
X    strcpy (ifdef, out) ;
X    fileNamePC = &ifdef ;
X    for (xxxPC = strtok (ifdef, ":`5B`5D");
X         xxxPC == NULL;
X`09 xxxPC = strtok (NULL, ":`5B`5D"))
X    `7B
X      fileNamePC = xxxPC ;
X    `7D ;
X   `20
X    strtok (fileNamePC, ".;") ;`09`09`09`09/* Extract just the filename port
Vio of the pointer.`09`09`09*/
X    for (xxxPC = fileNamePC;
X         *xxxPC != 0;
X`09 xxxPC++)
X    `7B
X      if (islower(*xxxPC))
X      `7B
X`09*xxxPC = toupper(*xxxPC);
X      `7D ;`09`09`09`09`09`09/* End if (islower(*xxxPC))`09`09`09`09`09`09*/
X    `7D ;`09`09`09`09`09`09`09/* End for (xxxPC = fileNamePC;`09`09`09`09`09
V`09*/
X   `20
X    printf("Creating file %s\n",out);
X    outfile = fopen(out,"w","rfm=var","rat=cr");
X    fprintf(outfile,"/* Created by SDL %.*s */\n",10,root->version);
X    fprintf(outfile,"/* Source: %.*s */\n",root->banner_len,root->banner);
X    fprintf(outfile,"#ifndef _%s_H_\n",fileNamePC);
X    fprintf(outfile,"#define _%s_H_\n",fileNamePC);
X    switch (options.compiler)
X    `7B
X      case 0:
X`09fprintf(outfile, "#pragma nostandard\n") ;
X`09break ;
X
X      case 1:
X`09fprintf(outfile, "#ifdef __cplusplus\n") ;
X`09fprintf(outfile, "extern \"C\" `7B\n") ;
X`09fprintf(outfile, "#endif\n") ;
X`09break ;
X
X      default :
X`09break;
X    `7D ;`09`09`09`09`09`09`09/* End switch (options.compiler)`09`09`09`09`0
V9*/
X    column = 1;
X  `7D;
X  main_arg3 = root;
X
X  node = root->head;
X  if ((readable(node)) && (node->type == SDL$C_NODE_ROOT)) `7B
X    if (readable(node->flink))
X      traverse_modules(node->flink); /* this should be the root node */
X    else
X      printf("INTERNAL ERROR, ROOT NODE FORWARD POINTER CORRUPT\n");
X    `7D
X  else
X    printf("INTERNAL ERROR, ROOT NODE CORRUPT\n");
X
X  /* delete the symbol */
X  lib_delete_symbol(SDL_SYMBOL);
X
X  switch (options.compiler)
X  `7B
X    case 0:
X      fprintf(outfile, "#pragma standard\n") ;
X      break ;
X
X    case 1:
X      fprintf(outfile, "#ifdef __cplusplus\n") ;
X      fprintf(outfile, "`7D\n") ;
X      fprintf(outfile, "#endif\n") ;
X      break ;
X
X    default :
X      break;
X  `7D ;`09`09`09`09`09`09`09/* End switch (options.compiler)`09`09`09`09`09*
V/
X  fprintf(outfile,"#endif\n");
X  fclose(outfile);
X
X  /* should reset the dcl parse tables somehow... */
X  /* but since that is imposible, the local tables include 'infile' */
X`7D
X
Xtraverse_modules(node)
X  struct Node *node;`20
X`7B
X  while (node->type == SDL$C_NODE_MODULE) `7B
X    printf("Reading module %.*s\n",node->name.len,node->name.str);
X    if (check_module(node)) `7B
X      setcase(node,1);
X      if (options.separate == 1) `7B
X        if (outfile) `7B
X`09  switch (options.compiler)
X`09  `7B
X`09    case 0:
X`09      fprintf(outfile, "#pragma standard\n") ;
X`09      break ;
X
X`09    case 1:
X`09      fprintf(outfile, "#ifdef __cplusplus\n") ;
X`09      fprintf(outfile, "`7D\n") ;
X`09      fprintf(outfile, "#endif\n") ;
X`09      break ;
X
X`09    default :
X`09      break;
X`09  `7D ;`09`09`09`09`09`09/* End switch (options.compiler)`09`09`09`09`09*
V/
X          fprintf(outfile,"#endif\n");
X          fclose(outfile);
X        `7D;
X        sprintf(out,"%.*s.H",node->name.len,node->name.str);
X        outfile = fopen(out,"w","rfm=var","rat=cr");
X
X        printf("Creating file %s\n",out);
X        fprintf(outfile,"/* Created by SDL %.*s */\n",
X`09`0910,main_arg3->version);
X        fprintf(outfile,"/* Source: %.*s */\n",
X`09`09main_arg3->banner_len,main_arg3->banner);
X        fprintf(outfile,"#ifndef _%.*s_H_\n",node->name.len,node->name.str);
X        fprintf(outfile,"#define _%.*s_H_\n",node->name.len,node->name.str);
X`09switch (options.compiler)
X`09`7B
X`09  case 0:
X`09    fprintf(outfile, "#pragma nostandard\n") ;
X`09    break ;
X
X`09  case 1:
X`09    fprintf(outfile, "#ifdef __cplusplus\n") ;
X`09    fprintf(outfile, "extern \"C\" `7B\n") ;
X`09    fprintf(outfile, "#endif\n") ;
X`09    break ;
X
X`09  default :
X`09    break;
X`09`7D ;`09`09`09`09`09`09/* End switch (options.compiler)`09`09`09`09`09*/
X      `7D;
X      fprintf(outfile," \n");
X      fprintf(outfile,"/*** MODULE %.*s ***/\n",node->name.len,node->name.st
Vr);
X      column = 1;
X      if (node->comment) `7B
X        print_comment(node);
X        newline();
X      `7D;
X      if (readable(node->child))
X        traverse_module(node->child,0);
X      else `7B
X        printf("INTERNAL ERROR, MODULE NODES CHILD POINTER CORRUPT\n");
X        printf("MODULE NOT BEING PROCESSED\n");
X      `7D;
X    `7D;
X    node = node->flink;
X    if (!readable(node)) `7B
X      printf("INTERNAL ERROR, MODULE NODE FORWARD POINTER CORRUPT\n");
X      printf("ABORTING\n");
X      return;
X    `7D;
X  `7D;
X`7D
X
Xtraverse_module(node,level)
X  struct Node *node;
X  int level;
X`7B
X  /* the first node should always be a head node, let's verify that
X     and then move forward. Note that we then simply loop until we
X     get back to the head node again */
X  if (node->type == SDL$C_NODE_HEAD) `7B
X    node = node->flink;
X    while(readable(node) && (node->type != SDL$C_NODE_HEAD)) `7B
X      print_module(node,level);
X      node = node->flink;
X    `7D;
X    if (!readable(node))
X      printf("INTERNAL ERROR, FORWARD POINTER CORRUPT\n");
X  `7D
X  else
X    printf("INTERNAL ERROR, NODE NOT A HEAD NODE\n");
X`7D
X
Xprint_module(node,level)
X  struct Node *node;
X  int level;
X`7B
X  column = 1;
X  switch (node->type) `7B
X    case SDL$C_NODE_COMMENT:
X      setcase(node,0);
X      if (options.comments) `7B
X        print_comment(node);
X        newline();
X      `7D;
X      break;
X    case SDL$C_NODE_CONSTANT:
X      setcase(node,1);
X      column += fprintf(outfile,"#define ");
X      print_name(node,level);
X      column += fprintf(outfile," ");
X      if (node->sdl_flag_bits.flag.m_mask && options.mask)
X        column += fprintf(outfile,"0x%08X",node->typeinfo);
X      else
X        column += fprintf(outfile,"%d",node->typeinfo);
X      print_comment(node);
X      newline();
X      break;
X    case SDL$C_NODE_ENTRY:
X      setcase(node,-1);
X
X      column += fprintf(outfile,"/*+`7E");
X      print_name(node,level);
X      column += fprintf(outfile,"`7E+*/");
X      newline();
X
X      print_predatatype(node,level);
X      print_name(node,level);
X      print_postdatatype(node);
X
X      /* okay, let's see if they want function prototyping */
X      if (options.prototype) `7B
X        column += fprintf(outfile,"(");
X        if (node->child) `7B /* any arguments? */
X          print_comment(node);
X          newline();
X          column = 1;
X          if (readable(node->child))
X            print_prototype(node->child);
X          else `7B
X            printf("INTERNAL ERROR, ENTRY NODE CHILD POINTER CORRUPT\n");
X            fprintf(outfile,
X              "/* INTERNAL ERROR, UNABLE TO INCLUDE PROTOTYPE */\n");
X            column = 1;
X          `7D;
X          column += fprintf(outfile,"%.*s) ;",options.indent,spaces);
X        `7D
X        else `7B /* if not, just display the rest of line */
X          column += fprintf(outfile,") ;");
X          print_comment(node);
X        `7D;
X        newline();
X      `7D
X      else `7B
X`09if (options.compiler == 0)
X`09`7B
X`09  column += fprintf(outfile,"() ;");
X`09`7D
X`09else
X`09`7B
X`09  column += fprintf(outfile,"(...) ;");
X`09`7D ;`09`09`09`09`09`09/* End if (options.compiler == 0)`09`09`09`09`09*/
X        print_comment(node);
X        newline();
X      `7D;
X
X      column += fprintf(outfile,"/*`7E-");
X      print_name(node,level);
X      column += fprintf(outfile,"-`7E*/");
X      newline();
X
X      break;
X    case SDL$C_NODE_ITEM:
X      print_item(node,level);
X      break;
X  `7D;
X`7D
X
Xprint_item(node,level)
X  struct Node *node;
X  int level;
X`7B
X  struct Node
X    *addressPN = node
X    ;
X   `20
X  setcase(node,-1);
X  if (level > maxlevel)
X    level = maxlevel;
X  column += fprintf(outfile,"%.*s",level*options.indent,spaces);
X  switch (node->datatype) `7B
X    case SDL$C_TYPE_STRUCTURE:
X    case SDL$C_TYPE_UNION:
X      print_predatatype(node,level);
X      if (level==0) `7B
X        print_name(node,level);
X        column += fprintf(outfile," ");
X      `7D;
X      print_postdatatype(node);
X      if ((level==0) && (node->sdl_flag_bits.flag.m_based) && (node->typeinf
Vo))
X        column += fprintf(outfile," /* WARNING: aggregate has origin of %d *
V/",
X`09`09node->typeinfo);
X      print_comment(node);
X      newline();
X      column = 1;
X      if (readable(node->child))
X        traverse_module(node->child,level+1);
X      else
X        printf("INTERNAL ERROR, ITEM NODE CHILD POINTER CORRUPT\n");
X      if (level > 0) `7B
X        column += fprintf(outfile,"%.*s`7D ",(level+1)*options.indent,spaces
V);
X        print_name(node,0);
X        column += fprintf(outfile,";");
X        newline();
X      `7D
X      else `7B
X        column += fprintf(outfile,"%.*s`7D ;",level*options.indent,spaces);
X        newline();
X      `7D
X      break;
X    default:
X      if ((node->datatype == SDL$C_TYPE_ADDRESS) && (readable(node->typeinfo
V2)))
X      `7B
X`09addressPN = resolveAddress(node->typeinfo2) ;
X`09print_predatatype(addressPN,level);
X`09column += fprintf(outfile, "*") ;
X      `7D
X      else
X      `7B
X`09print_predatatype(node,level);
X      `7D ;`09`09`09`09`09`09/* End if ((node->datatype == SDL$C_TYPE_ADDRES
VS) &&`09`09`09*/
X      print_name(node,level);
X      print_postdatatype(node);
X      if (addressPN->type == SDL$C_NODE_ENTRY)
X      `7B
X`09column += fprintf(outfile,"(...)") ;
X      `7D ;`09`09`09`09`09`09/* End if (addressPN->type == SDL$C_NODE_ENTRY)
V`09`09`09`09*/
X      column += fprintf(outfile,";");
X      print_comment(node);
X      newline();
X      print_variant_name(node,level) ;
X      break;
X  `7D;
X`7D;
X
Xvoid print_variant_name (
X  struct Node *node,
X  int level)
X`7B
X  int
X    i
X    ;
X   `20
X  /*
X  ** Variant names only get generated if we are DEEP within a structure
X  ** definition (first level names don't NEED to be flattened) and we are
X  ** generating code for GCC (vms uses variant structures/unions to flatten
V the
X  ** name space) and the member isn't a fill member (in which case, who care
Vs
X  ** WHAT it's name is).
X  */
X `20
X  if ((level <= 1) `7C`7C (options.variant == 0) `7C`7C (options.compiler ==
V 0) `7C`7C (node->sdl_flag_bits.flag.m_fill == 1))
X  `7B
X    return ;
X  `7D ;
X
X  /*
X  ** Variant names for GCC are generated as follows:
X  **
X  **  #define member-name path.to.member._U/S_member-name
X  **
X  ** Where _U/S_ is _U_ for a union member and _S_ for a structure member.
X  */
X `20
X  fprintf (outfile, "#define %.*s ", node->name.len, node->name.str) ;
X  for (i = 1;  i <= level-1;  i++)
X  `7B
X    fprintf (outfile, "%.*s.", variantName`5Bi`5D->len, variantName`5Bi`5D->
Vstr) ;
X  `7D
X  fprintf (outfile, "%s%.*s", structOrUnion`5Blevel-1`5D, node->name.len, no
Vde->name.str) ;
X
X  newline() ;
X`7D ;
X
Xprint_comment(node)
X  struct Node *node;
X`7B
X  struct sptr *ptr;
X  char *c;
X  int l,x;
X `20
X  if (node->comment && options.comments) `7B
X    /* print leading space if not at start of line */
X    if (column > 1)
X      column += fprintf(outfile," ");
X
X    /* print white space up to next tab */
X    x = 8 - ((column - 1) % 8);
X    if (x == 8)
X      x = 0;
X    if (x)
X      column += fprintf(outfile,"%.*s",x,spaces);
X         `20
X    ptr = node->comment;
X
X    column += fprintf(outfile,"/*");
X    c = ptr->str;
X    l = ptr->len;
X    for (x = 0;(x < l) && (c`5Bx`5D != '\t');++x);
X    while (c`5Bx`5D == '\t') `7B
X      column += fprintf(outfile,"%.*s",x,c);
X      ++x;
X      c += x;
X      l -= x;
X      /* print white space up to next tab */
X      x = 8 - ((column - 1) % 8);
X      if (x == 8)
X        x = 0;
X      if (x)
X        column += fprintf(outfile,"%.*s",x,spaces);
X      for (x = 0;(x < l) && (c`5Bx`5D != '\t');++x);
X    `7D;
X    column += fprintf(outfile,"%.*s",x,c);
X
X    x = 79 - column; /* pad to 80 columns if possible */
X    if (x < 0) `7B
X      x = 8 - ((column + 1) % 8); /* pad to next tab if over 80 chars */
X      if (x == 8)
X        x = 0;
X    `7D;
X    column += fprintf(outfile,"%.*s*/",x,spaces);
X
X  `7D;
X`7D
X
Xprint_name(node,level)
X  struct Node *node;
X  int level ;
X`7B
X
X  /*
X  ** See print_variant_name for a discussion of the format and conditions of
X  ** generation of variant names.
X  */
X `20
X  if ((level <= 1) `7C`7C (options.variant == 0) `7C`7C (options.compiler ==
V 0) `7C`7C (node->sdl_flag_bits.flag.m_fill == 1))
X  `7B
X    column += fprintf(outfile,"%.*s",node->name.len,node->name.str);
X  `7D
X  else
X  `7B
X    column += fprintf(outfile,"%s%.*s",structOrUnion`5Blevel-1`5D,node->name
V.len,node->name.str);
X  `7D
X`7D
X
Xprint_predatatype(node, level)
X  struct Node *node;
X  int level;
X`7B
X  static char tmpname`5B9`5D = "        ";
X  static int tmpindx = -1;
X  int i;
X
X  if (node->sdl_flag_bits.flag.m_unsigned)
X    if (isUnsigned`5Bnode->datatype`5D)
X    `7B
X      column += fprintf(outfile,"unsigned ");
X    `7D
X    else
X    `7B
X      column += fprintf(outfile,"/* unsigned */ ");
X    `7D
X
X  switch (node->datatype) `7B
X    case SDL$C_TYPE_HFLOAT:
X      for (i=0; (i < 8) && (i < node->name.len); i++) `7B
X        if (tmpname`5Bi`5D != node->name.str`5Bi`5D)
X          tmpindx = -1;
X        tmpname`5Bi`5D = node->name.str`5Bi`5D;
X      `7D;
X      ++tmpindx;
X      tmpname`5Bi`5D = '\0';
X      column += fprintf(outfile,"struct `7Bint %s$$ret_%d_ `5B4`5D;`7D ",
X`09`09tmpname,tmpindx);
X      /* hmm, the above name is used by the VWS SDLCC for ENTRY nodes,
X         I need to find an example in an ITEM node and see if they do it
X         any differently.. Probably they change the "ret" to something else
X      */
X      break;
X    case SDL$C_TYPE_STRUCTURE:
X    case SDL$C_TYPE_UNION:
X      if ((options.variant == 1) && (options.compiler == 0) && (level > 0))
X        column += fprintf(outfile,"variant_");
X      variantName`5Blevel`5D = &node->name ;
X      structOrUnion`5Blevel`5D = (node->datatype == SDL$C_TYPE_STRUCTURE ? "
V_S_" : "_U_") ;
X      column += fprintf(outfile,"%s",datatypes`5Bnode->datatype`5D);
X      break;
X    default:
X      column += fprintf(outfile,"%s",datatypes`5Bnode->datatype`5D);
X      break;
X  `7D;
X`7D
X
Xprint_postdatatype(node)
X  struct Node *node;
X`7B
X  switch(node->datatype) `7B
X    case SDL$C_TYPE_BITFIELD:
X      column += fprintf(outfile," : %d",node->fldsiz);
X      break;
X    case SDL$C_TYPE_DECIMAL:
X      /* I don't know how to do this, I have seen no uses of it yet.
X         I would think I need to use node->size or (hidim-lodim)/2 or
X         something along those lines. */
X      column += fprintf(outfile," `5B%d`5D",node->size);
X      break;
X    case SDL$C_TYPE_QUADWORD:
X      column += fprintf(outfile," `5B2`5D");
X      break;
X    case SDL$C_TYPE_OCTAWORD:
X      column += fprintf(outfile," `5B4`5D");
X      break;
X    case SDL$C_TYPE_STRUCTURE:
X    case SDL$C_TYPE_UNION:
X      column += fprintf(outfile,"`7B");
X      break;
X    case SDL$C_TYPE_ENTRY:
X      column += fprintf(outfile,")()");
X      break;
X  `7D;
X  if (node->sdl_flag_bits.flag.m_dimen)
X    column += fprintf(outfile," `5B%d`5D",node->hidim - node->lodim + 1);
X
X  if (node->datatype == SDL$C_TYPE_CHARACTER) `7B
X    if (node->typeinfo == 0)
X      column += fprintf(outfile," `5B`5D");
X    else
X      if (node->typeinfo > 1)
X        column += fprintf(outfile," `5B%d`5D",node->typeinfo);
X  `7D;
X`7D
X
Xcheck_module(node)
X  struct Node *node;
X`7B
X  static char symbol_name`5B80`5D;
X  static struct dsc$descriptor module =
X`09`7B0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0`7D;
X  static struct dsc$descriptor string = `7B0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0`7
VD;
X  struct ModuleName *mod;
X  int found = 0, i = 0;
X
X  if ((mod = SelectModules.next) == 0)
X    return(1);
X
X  module.dsc$w_length = node->name.len;
X  module.dsc$a_pointer = node->name.str;
X  /* this needs to loop through all the modules and see if one matches */
X  while (mod && !found) `7B
X    found = str$match_wild(&module,&(mod->name)) & 1;
X    mod = mod->next;
X  `7D;
X  return(found);
X`7D
X
Xprint_prototype(node)
X  struct Node *node;
X`7B
X  int firstparam = 1, firstopt = 1;
X
X  if (node->type == SDL$C_NODE_HEAD) `7B
X    node = node->flink;
X    while(readable(node) && (node->type != SDL$C_NODE_HEAD)) `7B
X      if (check_if_args_optional(node)) `7B
X        if (firstparam) `7B
X          print_parameter(node,1);
X          firstopt = 0;
X        `7D else `7B
X          if (firstopt) `7B
X            fprintf(outfile,"%.*s...\n",options.indent,spaces);
X            column = 1;
X            firstopt = 0;
X          `7D;
X          print_parameter(node,1);
X        `7D;
X      `7D
X      else
X        print_parameter(node,0);
X      node = node->flink;
X      firstparam = 0;
X    `7D;
X    if (!readable(node))
X      printf("INTERNAL ERROR, FORWARD POINTER CORRUPT\n");
X  `7D
X  else
X    printf("INTERNAL ERROR, NODE NOT A HEAD NODE\n");
X`7D;
X
Xcheck_if_args_optional(node)
X  struct Node *node;
X`7B /* this function check if this node and all further parameter
X     nodes are optional, if so, it returns a 1, if not, it returns
X     a 0 */
X  int optional = 1;
X
X  while(readable(node) && (node->type != SDL$C_NODE_HEAD) && optional) `7B
X    optional = node->sdl_flag_bits.flag.m_optional;
X    node = node->flink;
X  `7D;
X  if (!readable(node))
X    printf("INTERNAL ERROR, FORWARD POINTER CORRUPT\n");
X  return(optional);
X`7D
X
Xprint_parameter(node,commented)
X  struct Node *node;
X  int commented;
X`7B
X  struct Node
X    *addressPN = NULL
X    ;
X
X  setcase(node,-1);
X  column += fprintf(outfile,"%.*s",options.indent,spaces);
X
X  if (commented)
X    column += fprintf(outfile,"/* ");
X
X  if ((node->sdl_flag_bits.flag.m_in) && !(node->sdl_flag_bits.flag.m_out))
X    column += fprintf(outfile,"const ");
X
X  if ((node->sdl_flag_bits.flag.m_descriptor) `7C`7C
X      (node->sdl_flag_bits.flag.m_rtl_str_desc))
X  `7B
X    column += fprintf(outfile,"struct dsc$descriptor *");
X    print_name(node,0);
X  `7D
X  else
X  `7B
X    switch (node->datatype)
X    `7B
X      case SDL$C_TYPE_ADDRESS:
X`09if (readable(node->typeinfo2))
X`09`7B
X`09  /*
X`09  ** If the type information is specified, go ahead and use it,
X`09  ** otherwise let it alone and drop through to the normal case.
X`09  */
X`09 `20
X`09  addressPN = resolveAddress(node->typeinfo2) ;
X`09  print_predatatype(addressPN,0) ;`09`09/* Type information is obtained i
Vndirectly.`09`09`09`09*/
X`09  if (!(node->sdl_flag_bits.flag.m_value))`09/* must be passed by ref. */
X`09  `7B
X`09    column += fprintf(outfile, "*") ;`09`09/* This data is passed by refe
Vrence.  It may ALSO be pointer data, but`09  */
X`09`09`09`09`09`09`09/* that's caught below.`09`09`09`09`09`09`09  */
X`09  `7D ;
X`09  print_name(node,0) ;
X`09  print_postdatatype(node,0) ;
X`09  column += fprintf(outfile, "(...)") ;`09`09/* This was an address so it
V must be a routine.`09`09`09`09*/
X`09  break ;
X`09`7D ;`09`09`09`09`09`09/* End if (readable(node->typeinfo2))`09`09`09`09`
V09*/
X
X      default :
X`09print_predatatype(node,0);
X`09if (!(node->sdl_flag_bits.flag.m_value))`09/* must be passed by ref. */
X`09`7B
X`09  if (isPrimitive`5Bnode->datatype`5D)
X`09  `7B
X`09    column += fprintf(outfile," *");`09`09/* This most likely ISN'T the a
Vddress of an entry, so go ahead and`09*/
X`09`09`09`09`09`09`09/* use the special case of automatically generating the
V *.`09`09*/
X`09    print_name(node,0);
X`09  `7D
X`09  else
X`09  `7B
X`09    column += fprintf(outfile," (*");
X`09    print_name(node,0);
X`09    column += fprintf(outfile,")") ;
X`09  `7D`09`09`09`09`09`09/* End if (isPrimitive`5Bnode->datatype`5D)`09`09`
V09`09`09*/
X`09`7D
X`09else
X`09`7B
X`09  print_name(node,0);`09`09`09`09/* Just print the name of all other type
Vs of nodes.`09`09`09*/
X`09`7D ;`09`09`09`09`09`09/* End if (!(node->sdl_flag_bits.flag.m_value))`09
V`09`09`09*/
X`09print_postdatatype(node,0) ;
X`09break;
X    `7D ;`09`09     `20
X  `7D;
X
X  if ((node->flink)->type != SDL$C_NODE_HEAD)
X    column += fprintf(outfile,",");
X
X  if (commented)
X    column += fprintf(outfile," */");
X
X  print_comment(node);
X  newline();
X
X`7D
X
Xsetcase(node,casetype)
X  struct Node *node;
X  int casetype;
X`7B
X  char *p = node->name.str;
X  int i;
X
X  switch (options.outcase)
X  `7B
X    case 0:
X      casetype = 0;
X      break;
X    case 1:
X      break;
X    case 2:
X      casetype = 1;
X      break;
X    case 3:
X      casetype = -1;
X      break;
X  `7D
X
X  switch (casetype)
X  `7B
X    case 1: /* uppercase name */
X      for (i = 0; i < node->name.len; i++, p++)
X        if (islower(*p)) *p = toupper(*p);
X      break;
X    case -1: /* lowercase name */
X      for (i = 0; i < node->name.len; i++, p++)
X        if (isupper(*p)) *p = tolower(*p);
X      break;
X  `7D; `20
X`7D
X
Xnewline()
X`7B
X  fprintf(outfile,"\n");
X  column = 1;
X`7D
X
Xstruct Node *resolveAddress (
X  struct Node *node)
X`7B
X  if (node->type != SDL$C_NODE_HEAD)
X  `7B
X    printf("INTERNAL ERROR, TYPEINFO2 DOESN'T POINT TO A HEAD NODE\n") ;
X    return NULL ;
X  `7D ;
X `20
X  if (!readable(node->flink))
X  `7B
X    printf("INTERNAL ERROR, ROOT NODE FORWARD POINTER CORRUPT\n");
X    return NULL ;
X  `7D ;
X
X  node = node -> flink ;
X
X  if (node->type != SDL$C_NODE_OBJECT)
X  `7B
X    printf("INTERNAL ERROR, ROOT FLINK DOESN'T POINT TO AN OBJECT NODE\n") ;
X    return NULL ;
X  `7D ;
X `20
X  if (!readable(node->typeinfo2))
X  `7B
X    printf("INTERNAL ERROR, ADDRESS OBJECT TYPEINFO2 POINTER CORRUPT\n");
X    return NULL ;
X  `7D ;
X
X  node = node -> typeinfo2 ;
X `20
X  if (node->type != SDL$C_NODE_HEAD)
X  `7B
X    printf("INTERNAL ERROR, ADDRESS OBJECT TYPEINFO2 DOESN'T POINT TO A HEAD
V NODE\n") ;
X    return NULL ;
X  `7D ;
X `20
X  if (!readable(node->flink))
X  `7B
X    printf("INTERNAL ERROR, ROOT NODE FORWARD POINTER CORRUPT\n");
X    return NULL ;
X  `7D ;
X
X  return node -> flink ;
X`7D ;
$ CALL UNPACK SDLGCC.C;84 335627880
$ create 'f'
X/* Version 1.0, Feb 4, 1988
X   First release - No modifications.
X
X   Standard include file for SDL modules (UNSDL, SDLCC, SDLDUMP)
X**
X**  0.001 Dick Munroe 20-Jul-92
X**`09The type constant for GFLOAT was misspelled.
X*/
X
Xstruct itmlst `7B /* this is an item list - for getjpi etc. */
X  short int  BufLen;
X  short int  ItmCod;
X  char      *BufAdr;
X  short int *RetLenAdr;
X`7D;
X
Xstruct sptr `7B /* this is a string pointer, as used in PLI apparently */
X  short int len;
X  char str`5B32`5D;
X`7D;
X
Xstruct Head `7B
X    char fill`5B298`5D;
X    short int banner_len;
X    char banner`5B68`5D;
X    char version`5B10`5D;
X    struct Node *head;
X`7D;
X
Xstruct Node `7B
X  /* this is the structure of a node used in the tree created by
X     SDL/NOPARSE, note that I have not been able to find where the
X     src_lines variable is kept, since I have not found any SDI
X     files that contain a non-zero src_lines field. */
X  struct Node *flink, *blink;
X  short int size;
X  short int type;
X  struct Node *parent, *child;
X  char fill1`5B4`5D;
X  int hidim;
X  int lodim;
X  int default_value;
X  struct sptr name;
X  char fill2`5B2`5D;
X  struct sptr prefix;
X  char fill3`5B34`5D;
X  struct sptr tag;
X  struct sptr naked;
X  char fill4`5B2`5D;
X  int offset;
X  int fldsiz;
X  unsigned int datatype;
X  union `7B
X    int flags;
X    struct `7B
X      unsigned m_value : 1;
X      unsigned m_mask : 1;
X      unsigned m_unsigned : 1;
X      unsigned m_common : 1; /* ??? */
X      unsigned m_global : 1; /* ??? */
X      unsigned m_varying : 1; /* ??? */
X      unsigned m_variable : 1;
X      unsigned m_based : 1;
X      unsigned m_descriptor : 1;
X      unsigned m_dimen : 1;
X      unsigned m_in : 1;
X      unsigned m_out : 1;
X      unsigned m_bottom : 1;
X      unsigned m_bound : 1; /* ??? */
X      unsigned m_ref : 1;
X      unsigned m_fill : 1;
X      unsigned m_16 : 1;
X      unsigned m_default : 1;
X      unsigned m_vardim : 1;
X      unsigned m_link : 1;
X      unsigned m_optional : 1;
X      unsigned m_21 : 1;
X      unsigned m_fixed : 1;
X      unsigned m_generated : 1;
X      unsigned m_24 : 1;
X      unsigned m_list : 1;
X      unsigned m_rtl_str_desc : 1;
X      unsigned m_complex : 1;
X      unsigned m_28 : 1;
X      unsigned m_29 : 1;
X      unsigned m_30 : 1;
X      unsigned m_31 : 1;
X    `7D flag;
X  `7D sdl_flag_bits ; /* end of variant_union */
X  int typeinfo;
X  int typeinfo2;
X  struct sptr *comment;
X  struct sptr typename;
X`7D;
X
X#define SDL$C_NODE_ROOT 1
X#define SDL$C_NODE_COMMENT 2
X#define SDL$C_NODE_CONSTANT 3
X#define SDL$C_NODE_ENTRY 4
X#define SDL$C_NODE_ITEM 5
X#define SDL$C_NODE_MODULE 6
X#define SDL$C_NODE_PARAMETER 7
X#define SDL$C_NODE_UNKNOWN 8
X#define SDL$C_NODE_OBJECT 9
X#define SDL$C_NODE_HEAD 10
X
X#define SDL$C_TYPE_ADDRESS 1
X#define SDL$C_TYPE_BYTE 2
X#define SDL$C_TYPE_CHARACTER 3
X#define SDL$C_TYPE_BOOLEAN 4
X#define SDL$C_TYPE_DECIMAL 5 /* ??? */
X#define SDL$C_TYPE_DFLOAT 6
X#define SDL$C_TYPE_FFLOAT 7
X#define SDL$C_TYPE_GFLOAT 8
X#define SDL$C_TYPE_HFLOAT 9
X#define SDL$C_TYPE_LONGWORD 10
X#define SDL$C_TYPE_OCTAWORD 11 /* ??? */
X#define SDL$C_TYPE_QUADWORD 12
X#define SDL$C_TYPE_BITFIELD 13
X#define SDL$C_TYPE_WORD 14
X#define SDL$C_TYPE_STRUCTURE 15
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-