home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / octa21fs.zip / octave / f2c / src / defs.h < prev    next >
C/C++ Source or Header  |  2000-01-15  |  34KB  |  1,055 lines
  1. /****************************************************************
  2. Copyright 1990 - 1994 by AT&T Bell Laboratories, Bellcore.
  3.  
  4. Permission to use, copy, modify, and distribute this software
  5. and its documentation for any purpose and without fee is hereby
  6. granted, provided that the above copyright notice appear in all
  7. copies and that both that the copyright notice and this
  8. permission notice and warranty disclaimer appear in supporting
  9. documentation, and that the names of AT&T Bell Laboratories or
  10. Bellcore or any of their entities not be used in advertising or
  11. publicity pertaining to distribution of the software without
  12. specific, written prior permission.
  13.  
  14. AT&T and Bellcore disclaim all warranties with regard to this
  15. software, including all implied warranties of merchantability
  16. and fitness.  In no event shall AT&T or Bellcore be liable for
  17. any special, indirect or consequential damages or any damages
  18. whatsoever resulting from loss of use, data or profits, whether
  19. in an action of contract, negligence or other tortious action,
  20. arising out of or in connection with the use or performance of
  21. this software.
  22. ****************************************************************/
  23.  
  24. #include "sysdep.h"
  25.  
  26. #include "ftypes.h"
  27. #include "defines.h"
  28. #include "machdefs.h"
  29.  
  30. #define MAXDIM 20
  31. #define MAXINCLUDES 10
  32. #define MAXLITERALS 200        /* Max number of constants in the literal
  33.                    pool */
  34. #define MAXTOKENLEN 502        /* length of longest token */
  35. #define MAXCTL 20
  36. #define MAXHASH 401
  37. #define MAXSTNO 801
  38. #define MAXEXT 200
  39. #define MAXEQUIV 150
  40. #define MAXLABLIST 258        /* Max number of labels in an alternate
  41.                    return CALL or computed GOTO */
  42. #define MAXCONTIN 99        /* Max continuation lines */
  43.  
  44. /* These are the primary pointer types used in the compiler */
  45.  
  46. typedef union Expression *expptr, *tagptr;
  47. typedef struct Chain *chainp;
  48. typedef struct Addrblock *Addrp;
  49. typedef struct Constblock *Constp;
  50. typedef struct Exprblock *Exprp;
  51. typedef struct Nameblock *Namep;
  52.  
  53. extern FILEP infile;
  54. extern FILEP diagfile;
  55. extern FILEP textfile;
  56. extern FILEP asmfile;
  57. extern FILEP c_file;        /* output file for all functions; extern
  58.                    declarations will have to be prepended */
  59. extern FILEP pass1_file;    /* Temp file to hold the function bodies
  60.                    read on pass 1 */
  61. extern FILEP expr_file;        /* Debugging file */
  62. extern FILEP initfile;        /* Intermediate data file pointer */
  63. extern FILEP blkdfile;        /* BLOCK DATA file */
  64.  
  65. extern int current_ftn_file;
  66. extern int maxcontin;
  67.  
  68. extern char *blkdfname, *initfname, *sortfname;
  69. extern long headoffset;        /* Since the header block requires data we
  70.                    don't know about until AFTER each
  71.                    function has been processed, we keep a
  72.                    pointer to the current (dummy) header
  73.                    block (at the top of the assembly file)
  74.                    here */
  75.  
  76. extern char main_alias[];    /* name given to PROGRAM psuedo-op */
  77. extern char token [ ];
  78. extern int toklen;
  79. extern long lineno;
  80. extern char *infname;
  81. extern int needkwd;
  82. extern struct Labelblock *thislabel;
  83.  
  84. /* Used to allow runtime expansion of internal tables.  In particular,
  85.    these values can exceed their associated constants */
  86.  
  87. extern int maxctl;
  88. extern int maxequiv;
  89. extern int maxstno;
  90. extern int maxhash;
  91. extern int maxext;
  92.  
  93. extern flag nowarnflag;
  94. extern flag ftn66flag;        /* Generate warnings when weird f77
  95.                    features are used (undeclared dummy
  96.                    procedure, non-char initialized with
  97.                    string, 1-dim subscript in EQUIV) */
  98. extern flag no66flag;        /* Generate an error when a generic
  99.                    function (f77 feature) is used */
  100. extern flag noextflag;        /* Generate an error when an extension to
  101.                    Fortran 77 is used (hex/oct/bin
  102.                    constants, automatic, static, double
  103.                    complex types) */
  104. extern flag zflag;        /* enable double complex intrinsics */
  105. extern flag shiftcase;
  106. extern flag undeftype;
  107. extern flag shortsubs;        /* Use short subscripts on arrays? */
  108. extern flag onetripflag;    /* if true, always execute DO loop body */
  109. extern flag checksubs;
  110. extern flag debugflag;
  111. extern int nerr;
  112. extern int nwarn;
  113.  
  114. extern int parstate;
  115. extern flag headerdone;        /* True iff the current procedure's header
  116.                    data has been written */
  117. extern int blklevel;
  118. extern flag saveall;
  119. extern flag substars;        /* True iff some formal parameter is an
  120.                    asterisk */
  121. extern int impltype[ ];
  122. extern ftnint implleng[ ];
  123. extern int implstg[ ];
  124.  
  125. extern int tycomplex, tyint, tyioint, tyreal;
  126. extern int tylog, tylogical;    /* TY____ of the implementation of   logical.
  127.                    This will be LONG unless '-2' is given
  128.                    on the command line */
  129. extern int type_choice[];
  130. extern char *typename[];
  131.  
  132. extern int typesize[];    /* size (in bytes) of an object of each
  133.                    type.  Indexed by TY___ macros */
  134. extern int typealign[];
  135. extern int proctype;    /* Type of return value in this procedure */
  136. extern char * procname;    /* External name of the procedure, or last ENTRY name */
  137. extern int rtvlabel[ ];    /* Return value labels, indexed by TY___ macros */
  138. extern Addrp retslot;
  139. extern Addrp xretslot[];
  140. extern int cxslot;    /* Complex return argument slot (frame pointer offset)*/
  141. extern int chslot;    /* Character return argument slot (fp offset) */
  142. extern int chlgslot;    /* Argument slot for length of character buffer */
  143. extern int procclass;    /* Class of the current procedure:  either CLPROC,
  144.                CLMAIN, CLBLOCK or CLUNKNOWN */
  145. extern ftnint procleng;    /* Length of function return value (e.g. char
  146.                string length).  If this is -1, then the length is
  147.                not known at compile time */
  148. extern int nentry;    /* Number of entry points (other than the original
  149.                function call) into this procedure */
  150. extern flag multitype;    /* YES iff there is more than one return value
  151.                possible */
  152. extern int blklevel;
  153. extern long lastiolabno;
  154. extern int lastlabno;
  155. extern int lastvarno;
  156. extern int lastargslot;    /* integer offset pointing to the next free
  157.                location for an argument to the current routine */
  158. extern int argloc;
  159. extern int autonum[];        /* for numbering
  160.                    automatic variables, e.g. temporaries */
  161. extern int retlabel;
  162. extern int ret0label;
  163. extern int dorange;        /* Number of the label which terminates
  164.                    the innermost DO loop */
  165. extern int regnum[ ];        /* Numbers of DO indicies named in
  166.                    regnamep   (below) */
  167. extern Namep regnamep[ ];    /* List of DO indicies in registers */
  168. extern int maxregvar;        /* number of elts in   regnamep   */
  169. extern int highregvar;        /* keeps track of the highest register
  170.                    number used by DO index allocator */
  171. extern int nregvar;        /* count of DO indicies in registers */
  172.  
  173. extern chainp templist[];
  174. extern int maxdim;
  175. extern chainp earlylabs;
  176. extern chainp holdtemps;
  177. extern struct Entrypoint *entries;
  178. extern struct Rplblock *rpllist;
  179. extern struct Chain *curdtp;
  180. extern ftnint curdtelt;
  181. extern chainp allargs;        /* union of args in entries */
  182. extern int nallargs;        /* total number of args */
  183. extern int nallchargs;        /* total number of character args */
  184. extern flag toomanyinit;    /* True iff too many initializers in a
  185.                    DATA statement */
  186.  
  187. extern flag inioctl;
  188. extern int iostmt;
  189. extern Addrp ioblkp;
  190. extern int nioctl;
  191. extern int nequiv;
  192. extern int eqvstart;    /* offset to eqv number to guarantee uniqueness
  193.                and prevent <something> from going negative */
  194. extern int nintnames;
  195.  
  196. /* Chain of tagged blocks */
  197.  
  198. struct Chain
  199.     {
  200.     chainp nextp;
  201.     char * datap;        /* Tagged block */
  202.     };
  203.  
  204. extern chainp chains;
  205.  
  206. /* Recall that   field   is intended to hold four-bit characters */
  207.  
  208. /* This structure exists only to defeat the type checking */
  209.  
  210. struct Headblock
  211.     {
  212.     field tag;
  213.     field vtype;
  214.     field vclass;
  215.     field vstg;
  216.     expptr vleng;        /* Expression for length of char string -
  217.                    this may be a constant, or an argument
  218.                    generated by mkarg() */
  219.     } ;
  220.  
  221. /* Control construct info (for do loops, else, etc) */
  222.  
  223. struct Ctlframe
  224.     {
  225.     unsigned ctltype:8;
  226.     unsigned dostepsign:8;    /* 0 - variable, 1 - pos, 2 - neg */
  227.     unsigned dowhile:1;
  228.     int ctlabels[4];    /* Control labels, defined below */
  229.     int dolabel;        /* label marking end of this DO loop */
  230.     Namep donamep;        /* DO index variable */
  231.     expptr domax;        /* constant or temp variable holding MAX
  232.                    loop value; or expr of while(expr) */
  233.     expptr dostep;        /* expression */
  234.     Namep loopname;
  235.     };
  236. #define endlabel ctlabels[0]
  237. #define elselabel ctlabels[1]
  238. #define dobodylabel ctlabels[1]
  239. #define doposlabel ctlabels[2]
  240. #define doneglabel ctlabels[3]
  241. extern struct Ctlframe *ctls;        /* Keeps info on DO and BLOCK IF
  242.                        structures - this is the stack
  243.                        bottom */
  244. extern struct Ctlframe *ctlstack;    /* Pointer to current nesting
  245.                        level */
  246. extern struct Ctlframe *lastctl;    /* Point to end of
  247.                        dynamically-allocated array */
  248.  
  249. typedef struct {
  250.     int type;
  251.     chainp cp;
  252.     } Atype;
  253.  
  254. typedef struct {
  255.     int defined, dnargs, nargs, changes;
  256.     Atype atypes[1];
  257.     } Argtypes;
  258.  
  259. /* External Symbols */
  260.  
  261. struct Extsym
  262.     {
  263.     char *fextname;        /* Fortran version of external name */
  264.     char *cextname;        /* C version of external name */
  265.     field extstg;        /* STG -- should be COMMON, UNKNOWN or EXT
  266.                    */
  267.     unsigned extype:4;    /* for transmitting type to output routines */
  268.     unsigned used_here:1;    /* Boolean - true on the second pass
  269.                    through a function if the block has
  270.                    been referenced */
  271.     unsigned exused:1;    /* Has been used (for help with error msgs
  272.                    about externals typed differently in
  273.                    different modules) */
  274.     unsigned exproto:1;    /* type specified in a .P file */
  275.     unsigned extinit:1;    /* Procedure has been defined,
  276.                    or COMMON has DATA */
  277.     unsigned extseen:1;    /* True if previously referenced */
  278.     chainp extp;        /* List of identifiers in the common
  279.                    block for this function, stored as
  280.                    Namep (hash table pointers) */
  281.     chainp allextp;        /* List of lists of identifiers; we keep one
  282.                    list for each layout of this common block */
  283.     int curno;        /* current number for this common block,
  284.                    used for constructing appending _nnn
  285.                    to the common block name */
  286.     int maxno;        /* highest curno value for this common block */
  287.     ftnint extleng;
  288.     ftnint maxleng;
  289.     Argtypes *arginfo;
  290.     };
  291. typedef struct Extsym Extsym;
  292.  
  293. extern Extsym *extsymtab;    /* External symbol table */
  294. extern Extsym *nextext;
  295. extern Extsym *lastext;
  296. extern int complex_seen, dcomplex_seen;
  297.  
  298. /* Statement labels */
  299.  
  300. struct Labelblock
  301.     {
  302.     int labelno;        /* Internal label */
  303.     unsigned blklevel:8;    /* level of nesting, for branch-in-loop
  304.                    checking */
  305.     unsigned labused:1;
  306.     unsigned fmtlabused:1;
  307.     unsigned labinacc:1;    /* inaccessible? (i.e. has its scope
  308.                    vanished) */
  309.     unsigned labdefined:1;    /* YES or NO */
  310.     unsigned labtype:2;    /* LAB{FORMAT,EXEC,etc} */
  311.     ftnint stateno;        /* Original label */
  312.     char *fmtstring;    /* format string */
  313.     };
  314.  
  315. extern struct Labelblock *labeltab;    /* Label table - keeps track of
  316.                        all labels, including undefined */
  317. extern struct Labelblock *labtabend;
  318. extern struct Labelblock *highlabtab;
  319.  
  320. /* Entry point list */
  321.  
  322. struct Entrypoint
  323.     {
  324.     struct Entrypoint *entnextp;
  325.     Extsym *entryname;    /* Name of this ENTRY */
  326.     chainp arglist;
  327.     int typelabel;            /* Label for function exit; this
  328.                        will return the proper type of
  329.                        object */
  330.     Namep enamep;            /* External name */
  331.     };
  332.  
  333. /* Primitive block, or Primary block.  This is a general template returned
  334.    by the parser, which will be interpreted in context.  It is a template
  335.    for an identifier (variable name, function name), parenthesized
  336.    arguments (array subscripts, function parameters) and substring
  337.    specifications. */
  338.  
  339. struct Primblock
  340.     {
  341.     field tag;
  342.     field vtype;
  343.     unsigned parenused:1;        /* distinguish (a) from a */
  344.     Namep namep;            /* Pointer to structure Nameblock */
  345.     struct Listblock *argsp;
  346.     expptr fcharp;            /* first-char-index-pointer (in
  347.                        substring) */
  348.     expptr lcharp;            /* last-char-index-pointer (in
  349.                        substring) */
  350.     };
  351.  
  352.  
  353. struct Hashentry
  354.     {
  355.     int hashval;
  356.     Namep varp;
  357.     };
  358. extern struct Hashentry *hashtab;    /* Hash table */
  359. extern struct Hashentry *lasthash;
  360.  
  361. struct Intrpacked    /* bits for intrinsic function description */
  362.     {
  363.     unsigned f1:3;
  364.     unsigned f2:4;
  365.     unsigned f3:7;
  366.     unsigned f4:1;
  367.     };
  368.  
  369. struct Nameblock
  370.     {
  371.     field tag;
  372.     field vtype;
  373.     field vclass;
  374.     field vstg;
  375.     expptr vleng;        /* length of character string, if applicable */
  376.     char *fvarname;        /* name in the Fortran source */
  377.     char *cvarname;        /* name in the resulting C */
  378.     chainp vlastdim;    /* datap points to new_vars entry for the */
  379.                 /* system variable, if any, storing the final */
  380.                 /* dimension; we zero the datap if this */
  381.                 /* variable is needed */
  382.     unsigned vprocclass:3;    /* P____ macros - selects the   varxptr
  383.                    field below */
  384.     unsigned vdovar:1;    /* "is it a DO variable?" for register
  385.                    and multi-level loop    checking */
  386.     unsigned vdcldone:1;    /* "do I think I'm done?" - set when the
  387.                    context is sufficient to determine its
  388.                    status */
  389.     unsigned vadjdim:1;    /* "adjustable dimension?" - needed for
  390.                    information about copies */
  391.     unsigned vsave:1;
  392.     unsigned vimpldovar:1;    /* used to prevent erroneous error messages
  393.                    for variables used only in DATA stmt
  394.                    implicit DOs */
  395.     unsigned vis_assigned:1;/* True if this variable has had some
  396.                    label ASSIGNED to it; hence
  397.                    varxptr.assigned_values is valid */
  398.     unsigned vimplstg:1;    /* True if storage type is assigned implicitly;
  399.                    this allows a COMMON variable to participate
  400.                    in a DIMENSION before the COMMON declaration.
  401.                    */
  402.     unsigned vcommequiv:1;    /* True if EQUIVALENCEd onto STGCOMMON */
  403.     unsigned vfmt_asg:1;    /* True if char *var_fmt needed */
  404.     unsigned vpassed:1;    /* True if passed as a character-variable arg */
  405.     unsigned vknownarg:1;    /* True if seen in a previous entry point */
  406.     unsigned visused:1;    /* True if variable is referenced -- so we */
  407.                 /* can omit variables that only appear in DATA */
  408.     unsigned vnamelist:1;    /* Appears in a NAMELIST */
  409.     unsigned vimpltype:1;    /* True if implicitly typed and not
  410.                    invoked as a function or subroutine
  411.                    (so we can consistently type procedures
  412.                    declared external and passed as args
  413.                    but never invoked).
  414.                    */
  415.     unsigned vtypewarned:1;    /* so we complain just once about
  416.                    changed types of external procedures */
  417.     unsigned vinftype:1;    /* so we can restore implicit type to a
  418.                    procedure if it is invoked as a function
  419.                    after being given a different type by -it */
  420.     unsigned vinfproc:1;    /* True if -it infers this to be a procedure */
  421.     unsigned vcalled:1;    /* has been invoked */
  422.     unsigned vdimfinish:1;    /* need to invoke dim_finish() */
  423.     unsigned vrefused:1;    /* Need to #define name_ref (for -s) */
  424.     unsigned vsubscrused:1;    /* Need to #define name_subscr (for -2) */
  425.     unsigned veqvadjust:1;    /* voffset has been adjusted for equivalence */
  426.  
  427. /* The   vardesc   union below is used to store the number of an intrinsic
  428.    function (when vstg == STGINTR and vprocclass == PINTRINSIC), or to
  429.    store the index of this external symbol in   extsymtab   (when vstg ==
  430.    STGEXT and vprocclass == PEXTERNAL) */
  431.  
  432.     union    {
  433.         int varno;        /* Return variable for a function.
  434.                        This is used when a function is
  435.                        assigned a return value.  Also
  436.                        used to point to the COMMON
  437.                        block, when this is a field of
  438.                        that block.  Also points to
  439.                        EQUIV block when STGEQUIV */
  440.         struct Intrpacked intrdesc;    /* bits for intrinsic function*/
  441.         } vardesc;
  442.     struct Dimblock *vdim;    /* points to the dimensions if they exist */
  443.     ftnint voffset;        /* offset in a storage block (the variable
  444.                    name will be "v.%d", voffset in a
  445.                    common blck on the vax).  Also holds
  446.                    pointers for automatic variables.  When
  447.                    STGEQUIV, this is -(offset from array
  448.                    base) */
  449.     union    {
  450.         chainp namelist;    /* points to names in the NAMELIST,
  451.                        if this is a NAMELIST name */
  452.         chainp vstfdesc;    /* points to (formals, expr) pair */
  453.         chainp assigned_values;    /* list of integers, each being a
  454.                        statement label assigned to
  455.                        this variable in the current function */
  456.         } varxptr;
  457.     int argno;        /* for multiple entries */
  458.     Argtypes *arginfo;
  459.     };
  460.  
  461.  
  462. /* PARAMETER statements */
  463.  
  464. struct Paramblock
  465.     {
  466.     field tag;
  467.     field vtype;
  468.     field vclass;
  469.     field vstg;
  470.     expptr vleng;
  471.     char *fvarname;
  472.     char *cvarname;
  473.     expptr paramval;
  474.     } ;
  475.  
  476.  
  477. /* Expression block */
  478.  
  479. struct Exprblock
  480.     {
  481.     field tag;
  482.     field vtype;
  483.     field vclass;
  484.     field vstg;
  485.     expptr vleng;        /* in the case of a character expression, this
  486.                    value is inherited from the children */
  487.     unsigned opcode;
  488.     expptr leftp;
  489.     expptr rightp;
  490.     };
  491.  
  492.  
  493. union Constant
  494.     {
  495.     struct {
  496.         char *ccp0;
  497.         ftnint blanks;
  498.         } ccp1;
  499.     ftnint ci;        /* Constant longeger */
  500.     double cd[2];
  501.     char *cds[2];
  502.     };
  503. #define ccp ccp1.ccp0
  504.  
  505. struct Constblock
  506.     {
  507.     field tag;
  508.     field vtype;
  509.     field vclass;
  510.     field vstg;        /* vstg = 1 when using Const.cds */
  511.     expptr vleng;
  512.     union Constant Const;
  513.     };
  514.  
  515.  
  516. struct Listblock
  517.     {
  518.     field tag;
  519.     field vtype;
  520.     chainp listp;
  521.     };
  522.  
  523.  
  524.  
  525. /* Address block - this is the FINAL form of identifiers before being
  526.    sent to pass 2.  We'll want to add the original identifier here so that it can
  527.    be preserved in the translation.
  528.  
  529.    An example identifier is q.7.  The "q" refers to the storage class
  530.    (field vstg), the 7 to the variable number (int memno). */
  531.  
  532. struct Addrblock
  533.     {
  534.     field tag;
  535.     field vtype;
  536.     field vclass;
  537.     field vstg;
  538.     expptr vleng;
  539.     /* put union...user here so the beginning of an Addrblock
  540.      * is the same as a Constblock.
  541.      */
  542.     union {
  543.         Namep name;        /* contains a pointer into the hash table */
  544.         char ident[IDENT_LEN + 1];    /* C string form of identifier */
  545.         char *Charp;
  546.         union Constant Const;    /* Constant value */
  547.         struct {
  548.         double dfill[2];
  549.         field vstg1;
  550.         } kludge;    /* so we can distinguish string vs binary
  551.                  * floating-point constants */
  552.     } user;
  553.     long memno;        /* when vstg == STGCONST, this is the
  554.                    numeric part of the assembler label
  555.                    where the constant value is stored */
  556.     expptr memoffset;    /* used in subscript computations, usually */
  557.     unsigned istemp:1;    /* used in stack management of temporary
  558.                    variables */
  559.     unsigned isarray:1;    /* used to show that memoffset is
  560.                    meaningful, even if zero */
  561.     unsigned ntempelt:10;    /* for representing temporary arrays, as
  562.                    in concatenation */
  563.     unsigned dbl_builtin:1;    /* builtin to be declared double */
  564.     unsigned charleng:1;    /* so saveargtypes can get i/o calls right */
  565.     unsigned cmplx_sub:1;    /* used in complex arithmetic under -s */
  566.     unsigned skip_offset:1;    /* used in complex arithmetic under -s */
  567.     unsigned parenused:1;    /* distinguish (a) from a */
  568.     ftnint varleng;        /* holds a copy of a constant length which
  569.                    is stored in the   vleng   field (e.g.
  570.                    a double is 8 bytes) */
  571.     int uname_tag;        /* Tag describing which of the unions()
  572.                    below to use */
  573.     char *Field;        /* field name when dereferencing a struct */
  574. }; /* struct Addrblock */
  575.  
  576.  
  577. /* Errorbock - placeholder for errors, to allow the compilation to
  578.    continue */
  579.  
  580. struct Errorblock
  581.     {
  582.     field tag;
  583.     field vtype;
  584.     };
  585.  
  586.  
  587. /* Implicit DO block, especially related to DATA statements.  This block
  588.    keeps track of the compiler's location in the implicit DO while it's
  589.    running.  In particular, the   isactive and isbusy   flags tell where
  590.    it is */
  591.  
  592. struct Impldoblock
  593.     {
  594.     field tag;
  595.     unsigned isactive:1;
  596.     unsigned isbusy:1;
  597.     Namep varnp;
  598.     Constp varvp;
  599.     chainp impdospec;
  600.     expptr implb;
  601.     expptr impub;
  602.     expptr impstep;
  603.     ftnint impdiff;
  604.     ftnint implim;
  605.     struct Chain *datalist;
  606.     };
  607.  
  608.  
  609. /* Each of these components has a first field called   tag.   This union
  610.    exists just for allocation simplicity */
  611.  
  612. union Expression
  613.     {
  614.     field tag;
  615.     struct Addrblock addrblock;
  616.     struct Constblock constblock;
  617.     struct Errorblock errorblock;
  618.     struct Exprblock exprblock;
  619.     struct Headblock headblock;
  620.     struct Impldoblock impldoblock;
  621.     struct Listblock listblock;
  622.     struct Nameblock nameblock;
  623.     struct Paramblock paramblock;
  624.     struct Primblock primblock;
  625.     } ;
  626.  
  627.  
  628.  
  629. struct Dimblock
  630.     {
  631.     int ndim;
  632.     expptr nelt;        /* This is NULL if the array is unbounded */
  633.     expptr baseoffset;    /* a constant or local variable holding
  634.                    the offset in this procedure */
  635.     expptr basexpr;        /* expression for comuting the offset, if
  636.                    it's not constant.  If this is
  637.                    non-null, the register named in
  638.                    baseoffset will get initialized to this
  639.                    value in the procedure's prolog */
  640.     struct
  641.         {
  642.         expptr dimsize;    /* constant or register holding the size
  643.                    of this dimension */
  644.         expptr dimexpr;    /* as above in basexpr, this is an
  645.                    expression for computing a variable
  646.                    dimension */
  647.         } dims[1];    /* Dimblocks are allocated with enough
  648.                    space for this to become dims[ndim] */
  649.     };
  650.  
  651.  
  652. /* Statement function identifier stack - this holds the name and value of
  653.    the parameters in a statement function invocation.  For example,
  654.  
  655.     f(x,y,z)=x+y+z
  656.         .
  657.         .
  658.     y = f(1,2,3)
  659.  
  660.    generates a stack of depth 3, with <x 1>, <y 2>, <z 3> AT THE INVOCATION, NOT
  661.    at the definition */
  662.  
  663. struct Rplblock    /* name replacement block */
  664.     {
  665.     struct Rplblock *rplnextp;
  666.     Namep rplnp;        /* Name of the formal parameter */
  667.     expptr rplvp;        /* Value of the actual parameter */
  668.     expptr rplxp;        /* Initialization of temporary variable,
  669.                    if required; else null */
  670.     int rpltag;        /* Tag on the value of the actual param */
  671.     };
  672.  
  673.  
  674.  
  675. /* Equivalence block */
  676.  
  677. struct Equivblock
  678.     {
  679.     struct Eqvchain *equivs;    /* List (Eqvchain) of primblocks
  680.                        holding variable identifiers */
  681.     flag eqvinit;
  682.     long eqvtop;
  683.     long eqvbottom;
  684.     int eqvtype;
  685.     } ;
  686. #define eqvleng eqvtop
  687.  
  688. extern struct Equivblock *eqvclass;
  689.  
  690.  
  691. struct Eqvchain
  692.     {
  693.     struct Eqvchain *eqvnextp;
  694.     union
  695.         {
  696.         struct Primblock *eqvlhs;
  697.         Namep eqvname;
  698.         } eqvitem;
  699.     long eqvoffset;
  700.     } ;
  701.  
  702.  
  703.  
  704. /* For allocation purposes only, and to keep lint quiet.  In particular,
  705.    don't count on the tag being able to tell you which structure is used */
  706.  
  707.  
  708. /* There is a tradition in Fortran that the compiler not generate the same
  709.    bit pattern more than is necessary.  This structure is used to do just
  710.    that; if two integer constants have the same bit pattern, just generate
  711.    it once.  This could be expanded to optimize without regard to type, by
  712.    removing the type check in   putconst()   */
  713.  
  714. struct Literal
  715.     {
  716.     short littype;
  717.     short litnum;            /* numeric part of the assembler
  718.                        label for this constant value */
  719.     int lituse;        /* usage count */
  720.     union    {
  721.         ftnint litival;
  722.         double litdval[2];
  723.         ftnint litival2[2];    /* length, nblanks for strings */
  724.         } litval;
  725.     char *cds[2];
  726.     };
  727.  
  728. extern struct Literal *litpool;
  729. extern int maxliterals, nliterals;
  730. extern char Letters[];
  731. #define letter(x) Letters[x]
  732.  
  733. struct Dims { expptr lb, ub; };
  734.  
  735. extern int forcedouble;        /* force real functions to double */
  736. extern int doin_setbound;    /* special handling for array bounds */
  737. extern int Ansi;
  738. extern char hextoi_tab[];
  739. #define hextoi(x) hextoi_tab[(x) & 0xff]
  740. extern char *casttypes[], *ftn_types[], *protorettypes[], *usedcasts[];
  741. extern int Castargs, infertypes;
  742. extern FILE *protofile;
  743. extern char binread[], binwrite[], textread[], textwrite[];
  744. extern char *ei_first, *ei_last, *ei_next;
  745. extern char *wh_first, *wh_last, *wh_next;
  746. extern char *halign, *outbuf, *outbtail;
  747. extern flag keepsubs;
  748. #ifdef TYQUAD
  749. extern flag use_tyquad;
  750. #endif
  751. extern int n_keywords, n_st_fields;
  752. extern char *c_keywords[], *st_fields[];
  753.  
  754. #ifdef KR_headers
  755. #define Argdcl(x) ()
  756. #define Void /* void */
  757. #else
  758. #define Argdcl(x) x
  759. #define Void void
  760. #endif
  761.  
  762. char*    Alloc Argdcl((int));
  763. char*    Argtype Argdcl((int, char*));
  764. void    Fatal Argdcl((char*));
  765. struct    Impldoblock* mkiodo Argdcl((chainp, chainp));
  766. tagptr    Inline Argdcl((int, int, chainp));
  767. struct    Labelblock* execlab Argdcl((long));
  768. struct    Labelblock* mklabel Argdcl((long));
  769. struct    Listblock* mklist Argdcl((chainp));
  770. void    Un_link_all Argdcl((int));
  771. void    add_extern_to_list Argdcl((Addrp, chainp*));
  772. int    addressable Argdcl((tagptr));
  773. tagptr    addrof Argdcl((tagptr));
  774. char*    addunder Argdcl((char*));
  775. Addrp    autovar Argdcl((int, int, tagptr, char*));
  776. void    backup Argdcl((char*, char*));
  777. void    bad_atypes Argdcl((Argtypes*, char*, int, int, int, char*, char*));
  778. int    badchleng Argdcl((tagptr));
  779. void    badop Argdcl((char*, int));
  780. void    badstg Argdcl((char*, int));
  781. void    badtag Argdcl((char*, int));
  782. void    badthing Argdcl((char*, char*, int));
  783. void    badtype Argdcl((char*, int));
  784. Addrp    builtin Argdcl((int, char*, int));
  785. char*    c_name Argdcl((char*, int));
  786. tagptr    call0 Argdcl((int, char*));
  787. tagptr    call1 Argdcl((int, char*, tagptr));
  788. tagptr    call2 Argdcl((int, char*, tagptr, tagptr));
  789. tagptr    call3 Argdcl((int, char*, tagptr, tagptr, tagptr));
  790. tagptr    call4 Argdcl((int, char*, tagptr, tagptr, tagptr, tagptr));
  791. tagptr    callk Argdcl((int, char*, chainp));
  792. void    cast_args Argdcl((int, chainp));
  793. char*    cds Argdcl((char*, char*));
  794. void    changedtype Argdcl((Namep));
  795. ptr    ckalloc Argdcl((int));
  796. int    cktype Argdcl((int, int, int));
  797. void    clf Argdcl((FILEP*, char*, int));
  798. int    cmpstr Argdcl((char*, char*, long, long));
  799. char*    c_type_decl Argdcl((int, int));
  800. Extsym*    comblock Argdcl((char*));
  801. char*    comm_union_name Argdcl((int));
  802. void    consconv Argdcl((int, Constp, Constp));
  803. void    consnegop Argdcl((Constp));
  804. int    conssgn Argdcl((tagptr));
  805. char*    convic Argdcl((long));
  806. void    copy_data Argdcl((chainp));
  807. char*    copyn Argdcl((int, char*));
  808. char*    copys Argdcl((char*));
  809. tagptr    cpblock Argdcl((int, char*));
  810. tagptr    cpexpr Argdcl((tagptr));
  811. void    cpn Argdcl((int, char*, char*));
  812. char*    cpstring Argdcl((char*));
  813. void    dataline Argdcl((char*, long, int));
  814. char*    dataname Argdcl((int, long));
  815. void    dataval Argdcl((tagptr, tagptr));
  816. void    dclerr Argdcl((char*, Namep));
  817. void    def_commons Argdcl((FILEP));
  818. void    def_start Argdcl((FILEP, char*, char*, char*));
  819. void    deregister Argdcl((Namep));
  820. void    do_uninit_equivs Argdcl((FILEP, ptr));
  821. void    doequiv(Void);
  822. int    dofork(Void);
  823. void    doinclude Argdcl((char*));
  824. void    doio Argdcl((chainp));
  825. void    done Argdcl((int));
  826. void    donmlist(Void);
  827. int    dsort Argdcl((char*, char*));
  828. char*    dtos Argdcl((double));
  829. void    elif_out Argdcl((FILEP, tagptr));
  830. void    end_else_out Argdcl((FILEP));
  831. void    enddcl(Void);
  832. void    enddo Argdcl((int));
  833. void    endio(Void);
  834. void    endioctl(Void);
  835. void    endproc(Void);
  836. void    entrypt Argdcl((int, int, long, Extsym*, chainp));
  837. int    eqn Argdcl((int, char*, char*));
  838. char*    equiv_name Argdcl((int, char*));
  839. void    err Argdcl((char*));
  840. void    err66 Argdcl((char*));
  841. void    errext Argdcl((char*));
  842. void    erri Argdcl((char*, int));
  843. void    errl Argdcl((char*, long));
  844. tagptr    errnode(Void);
  845. void    errstr Argdcl((char*, char*));
  846. void    exarif Argdcl((tagptr, struct Labelblock*, struct Labelblock*, struct Labelblock*));
  847. void    exasgoto Argdcl((Namep));
  848. void    exassign Argdcl((Namep, struct Labelblock*));
  849. void    excall Argdcl((Namep, struct Listblock*, int, struct Labelblock**));
  850. void    exdo Argdcl((int, Namep, chainp));
  851. void    execerr Argdcl((char*, char*));
  852. void    exelif Argdcl((tagptr));
  853. void    exelse(Void);
  854. void    exenddo Argdcl((Namep));
  855. void    exendif(Void);
  856. void    exequals Argdcl((struct Primblock*, tagptr));
  857. void    exgoto Argdcl((struct Labelblock*));
  858. void    exif Argdcl((tagptr));
  859. void    exreturn Argdcl((tagptr));
  860. void    exstop Argdcl((int, tagptr));
  861. void    extern_out Argdcl((FILEP, Extsym*));
  862. void    fatali Argdcl((char*, int));
  863. void    fatalstr Argdcl((char*, char*));
  864. void    ffilecopy Argdcl((FILEP, FILEP));
  865. void    fileinit(Void);
  866. int    fixargs Argdcl((int, struct Listblock*));
  867. tagptr    fixexpr Argdcl((Exprp));
  868. tagptr    fixtype Argdcl((tagptr));
  869. char*    flconst Argdcl((char*, char*));
  870. void    flline(Void);
  871. void    fmt_init(Void);
  872. void    fmtname Argdcl((Namep, Addrp));
  873. int    fmtstmt Argdcl((struct Labelblock*));
  874. tagptr    fold Argdcl((tagptr));
  875. void    frchain Argdcl((chainp*));
  876. void    frdata Argdcl((chainp));
  877. void    freetemps(Void);
  878. void    freqchain Argdcl((struct Equivblock*));
  879. void    frexchain Argdcl((chainp*));
  880. void    frexpr Argdcl((tagptr));
  881. void    frrpl(Void);
  882. void    frtemp Argdcl((Addrp));
  883. char*    gmem Argdcl((int, int));
  884. void    hashclear(Void);
  885. chainp    hookup Argdcl((chainp, chainp));
  886. expptr    imagpart Argdcl((Addrp));
  887. void    impldcl Argdcl((Namep));
  888. int    in_vector Argdcl((char*, char**, int));
  889. void    incomm Argdcl((Extsym*, Namep));
  890. void    inferdcl Argdcl((Namep, int));
  891. int    inilex Argdcl((char*));
  892. void    initkey(Void);
  893. int    inregister Argdcl((Namep));
  894. long    int commlen Argdcl((chainp));
  895. long    int convci Argdcl((int, char*));
  896. long    int iarrlen Argdcl((Namep));
  897. long    int lencat Argdcl((expptr));
  898. long    int lmax Argdcl((long, long));
  899. long    int lmin Argdcl((long, long));
  900. long    int wr_char_len Argdcl((FILEP, struct Dimblock*, int, int));
  901. Addrp    intraddr Argdcl((Namep));
  902. tagptr    intrcall Argdcl((Namep, struct Listblock*, int));
  903. int    intrfunct Argdcl((char*));
  904. void    ioclause Argdcl((int, expptr));
  905. int    iocname(Void);
  906. int    is_negatable Argdcl((Constp));
  907. int    isaddr Argdcl((tagptr));
  908. int    isnegative_const Argdcl((Constp));
  909. int    isstatic Argdcl((tagptr));
  910. chainp    length_comp Argdcl((struct Entrypoint*, int));
  911. int    lengtype Argdcl((int, long));
  912. char*    lexline Argdcl((ptr));
  913. void    list_arg_types Argdcl((FILEP, struct Entrypoint*, chainp, int, char*));
  914. void    list_decls Argdcl((FILEP));
  915. void    list_init_data Argdcl((FILE **, char *, FILE *));
  916. void    listargs Argdcl((FILEP, struct Entrypoint*, int, chainp));
  917. char*    lit_name Argdcl((struct Literal*));
  918. int    log_2 Argdcl((long));
  919. char*    lower_string Argdcl((char*, char*));
  920. int    main Argdcl((int, char**));
  921. expptr    make_int_expr Argdcl((expptr));
  922. void    make_param Argdcl((struct Paramblock*, tagptr));
  923. void    many Argdcl((char*, char, int));
  924. void    margin_printf Argdcl((FILEP, char*, ...));
  925. int    maxtype Argdcl((int, int));
  926. char*    mem Argdcl((int, int));
  927. void    mem_init(Void);
  928. char*    memname Argdcl((int, long));
  929. Addrp    memversion Argdcl((Namep));
  930. tagptr    mkaddcon Argdcl((long));
  931. Addrp    mkaddr Argdcl((Namep));
  932. Addrp    mkarg Argdcl((int, int));
  933. tagptr    mkbitcon Argdcl((int, int, char*));
  934. chainp    mkchain Argdcl((char*, chainp));
  935. Constp    mkconst Argdcl((int));
  936. tagptr    mkconv Argdcl((int, tagptr));
  937. tagptr    mkcxcon Argdcl((tagptr, tagptr));
  938. tagptr    mkexpr Argdcl((int, tagptr, tagptr));
  939. Extsym*    mkext Argdcl((char*, char*));
  940. Extsym*    mkext1 Argdcl((char*, char*));
  941. Addrp    mkfield Argdcl((Addrp, char*, int));
  942. tagptr    mkfunct Argdcl((tagptr));
  943. tagptr    mkintcon Argdcl((long));
  944. tagptr    mklhs Argdcl((struct Primblock*, int));
  945. tagptr    mklogcon Argdcl((int));
  946. Namep    mkname Argdcl((char*));
  947. Addrp    mkplace Argdcl((Namep));
  948. tagptr    mkprim Argdcl((Namep, struct Listblock*, chainp));
  949. tagptr    mkrealcon Argdcl((int, char*));
  950. Addrp    mkscalar Argdcl((Namep));
  951. void    mkstfunct Argdcl((struct Primblock*, tagptr));
  952. tagptr    mkstrcon Argdcl((int, char*));
  953. Addrp    mktmp Argdcl((int, tagptr));
  954. Addrp    mktmp0 Argdcl((int, tagptr));
  955. Addrp    mktmpn Argdcl((int, int, tagptr));
  956. void    namelist Argdcl((Namep));
  957. int    ncat Argdcl((expptr));
  958. void    negate_const Argdcl((Constp));
  959. void    new_endif(Void);
  960. Extsym*    newentry Argdcl((Namep, int));
  961. int    newlabel(Void);
  962. void    newproc(Void);
  963. Addrp    nextdata Argdcl((long*));
  964. void    nice_printf Argdcl((FILEP, char*, ...));
  965. void    not_both Argdcl((char*));
  966. void    np_init(Void);
  967. int    oneof_stg Argdcl((Namep, int, int));
  968. int    op_assign Argdcl((int));
  969. tagptr    opconv Argdcl((tagptr, int));
  970. FILEP    opf Argdcl((char*, char*));
  971. void    out_addr Argdcl((FILEP, Addrp));
  972. void    out_asgoto Argdcl((FILEP, tagptr));
  973. void    out_call Argdcl((FILEP, int, int, tagptr, tagptr, tagptr));
  974. void    out_const Argdcl((FILEP, Constp));
  975. void    out_else Argdcl((FILEP));
  976. void    out_for Argdcl((FILEP, tagptr, tagptr, tagptr));
  977. void    out_init(Void);
  978. void    outbuf_adjust(Void);
  979. void    p1_label Argdcl((long));
  980. void    prcona Argdcl((FILEP, long));
  981. void    prconi Argdcl((FILEP, long));
  982. void    prconr Argdcl((FILEP, Constp, int));
  983. void    procinit(Void);
  984. void    procode Argdcl((FILEP));
  985. void    prolog Argdcl((FILEP, chainp));
  986. void    protowrite Argdcl((FILEP, int, char*, struct Entrypoint*, chainp));
  987. expptr    prune_left_conv Argdcl((expptr));
  988. int    put_one_arg Argdcl((int, char*, char**, char*, char*));
  989. expptr    putassign Argdcl((expptr, expptr));
  990. Addrp    putchop Argdcl((tagptr));
  991. void    putcmgo Argdcl((tagptr, int, struct Labelblock**));
  992. Addrp    putconst Argdcl((Constp));
  993. tagptr    putcxop Argdcl((tagptr));
  994. void    puteq Argdcl((expptr, expptr));
  995. void    putexpr Argdcl((expptr));
  996. void    puthead Argdcl((char*, int));
  997. void    putif Argdcl((tagptr, int));
  998. void    putout Argdcl((tagptr));
  999. expptr    putsteq Argdcl((Addrp, Addrp));
  1000. void    putwhile Argdcl((tagptr));
  1001. tagptr    putx Argdcl((tagptr));
  1002. void    r8fix(Void);
  1003. int    rdlong Argdcl((FILEP, long*));
  1004. int    rdname Argdcl((FILEP, ptr, char*));
  1005. void    read_Pfiles Argdcl((char**));
  1006. Addrp    realpart Argdcl((Addrp));
  1007. chainp    revchain Argdcl((chainp));
  1008. int    same_expr Argdcl((tagptr, tagptr));
  1009. int    same_ident Argdcl((tagptr, tagptr));
  1010. void    save_argtypes Argdcl((chainp, Argtypes**, Argtypes**, int, char*, int, int, int, int));
  1011. void    saveargtypes Argdcl((Exprp));
  1012. void    set_externs(Void);
  1013. void    set_tmp_names(Void);
  1014. void    setbound Argdcl((Namep, int, struct Dims*));
  1015. void    setdata Argdcl((Addrp, Constp, long));
  1016. void    setext Argdcl((Namep));
  1017. void    setfmt Argdcl((struct Labelblock*));
  1018. void    setimpl Argdcl((int, long, int, int));
  1019. void    setintr Argdcl((Namep));
  1020. void    setlog(Void);
  1021. void    settype Argdcl((Namep, int, long));
  1022. void    sigcatch Argdcl((int));
  1023. void    start_formatting(Void);
  1024. void    startioctl(Void);
  1025. void    startproc Argdcl((Extsym*, int));
  1026. void    startrw(Void);
  1027. char*    string_num Argdcl((char*, long));
  1028. int    struct_eq Argdcl((chainp, chainp));
  1029. tagptr    subcheck Argdcl((Namep, tagptr));
  1030. tagptr    suboffset Argdcl((struct Primblock*));
  1031. int    type_fixup Argdcl((Argtypes*, Atype*, int));
  1032. void    unamstring Argdcl((Addrp, char*));
  1033. void    unclassifiable(Void);
  1034. void    vardcl Argdcl((Namep));
  1035. void    warn Argdcl((char*));
  1036. void    warn1 Argdcl((char*, char*));
  1037. void    warni Argdcl((char*, int));
  1038. void    wr_abbrevs Argdcl((FILEP, int, chainp));
  1039. char*    wr_ardecls Argdcl((FILE*, struct Dimblock*, long));
  1040. void    wr_array_init Argdcl((FILEP, int, chainp));
  1041. void    wr_common_decls Argdcl((FILEP));
  1042. void    wr_equiv_init Argdcl((FILEP, int, chainp*, int));
  1043. void    wr_globals Argdcl((FILEP));
  1044. void    wr_nv_ident_help Argdcl((FILEP, Addrp));
  1045. void    wr_struct Argdcl((FILEP, chainp));
  1046. void    wronginf Argdcl((Namep));
  1047. void    yyerror Argdcl((char*));
  1048. int    yylex(Void);
  1049. int    yyparse(Void);
  1050.  
  1051. #ifdef USE_DTOA
  1052. #define atof(x) strtod(x,0)
  1053. void    g_fmt Argdcl((char*, double));
  1054. #endif
  1055.