home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 379a.lha / p2c1_13a / src / src.zoo / decl4.c < prev    next >
C/C++ Source or Header  |  1990-03-10  |  28KB  |  999 lines
  1. /* "p2c", a Pascal to C translator.
  2.    Copyright (C) 1989 David Gillespie.
  3.    Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  4.  
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation (any version).
  8.  
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. GNU General Public License for more details.
  13.  
  14. You should have received a copy of the GNU General Public License
  15. along with this program; see the file COPYING.  If not, write to
  16. the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  17.  
  18. #define PROTO_DECL4_C
  19. #include "trans.h"
  20.  
  21. #define MAXIMPORTS 100
  22.  
  23. extern struct ptrdesc {
  24.     struct ptrdesc *next;
  25.     Symbol *sym;
  26.     Type *tp;
  27. } *ptrbase;
  28.  
  29. extern struct ctxstack {
  30.     struct ctxstack *next;
  31.     Meaning *ctx, *ctxlast;
  32.     struct tempvarlist *tempvars;
  33.     int tempvarcount, importmark;
  34. } *ctxtop;
  35.  
  36. extern struct tempvarlist {
  37.     struct tempvarlist *next;
  38.     Meaning *tvar;
  39.     int active;
  40. } *tempvars, *stmttempvars;
  41.  
  42. extern int tempvarcount;
  43.  
  44. extern int stringtypecachesize;
  45. extern Type **stringtypecache;
  46.  
  47. extern Meaning *importlist[MAXIMPORTS];
  48. extern int firstimport;
  49.  
  50. extern Type *tp_special_anyptr;
  51.  
  52. extern int wasaliased;
  53. extern int deferallptrs;
  54. extern int anydeferredptrs;
  55. extern int silentalreadydef;
  56. extern int nonloclabelcount;
  57.  
  58. extern Strlist *varstructdecllist;
  59.  
  60. extern Meaning *enum_tname;
  61.  
  62. Static Type *p_arraydecl(tname, ispacked, confp)
  63. char *tname;
  64. int ispacked;
  65. Meaning ***confp;
  66. {
  67.     Type *tp, *tp2;
  68.     Meaning *mp;
  69.     long size, smin, smax, bitsize, fullbitsize;
  70.     int issigned, bpower, hasrange;
  71.  
  72.     tp = maketype(TK_ARRAY);
  73.     if (confp == NULL) {
  74.     tp->indextype = p_type(NULL);
  75.     if (tp->indextype->kind == TK_SUBR) {
  76.         if (ord_range(tp->indextype, &smin, NULL) &&
  77.         smin > 0 && smin <= skipindices && !ispacked) {
  78.         tp->smin = makeexpr_val(make_ord(tp->indextype->basetype, smin));
  79.         tp->indextype = makesubrangetype(tp->indextype->basetype,
  80.                          makeexpr_val(make_ord(
  81.                                  tp->indextype->basetype, 0)),
  82.                          copyexpr(tp->indextype->smax));
  83.         }
  84.     }
  85.     } else {
  86.     if (modula2) {
  87.         **confp = mp = addmeaning(findsymbol(format_s(name_ALOW, tname)), MK_PARAM);
  88.         mp->fakeparam = 1;
  89.         mp->constqual = 1;
  90.         mp->xnext = addmeaning(findsymbol(format_s(name_AHIGH, tname)), MK_PARAM);
  91.         mp->xnext->fakeparam = 1;
  92.         mp->xnext->constqual = 1;
  93.         *confp = &mp->xnext->xnext;
  94.         tp2 = maketype(TK_SUBR);
  95.         tp2->basetype = tp_integer;
  96.         mp->type = tp_integer;
  97.         mp->xnext->type = mp->type;
  98.         tp2->smin = makeexpr_long(0);
  99.         tp2->smax = makeexpr_minus(makeexpr_var(mp->xnext),
  100.                        makeexpr_var(mp));
  101.         tp->indextype = tp2;
  102.         tp->structdefd = 1;
  103.     } else {
  104.         wexpecttok(TOK_IDENT);
  105.         tp2 = maketype(TK_SUBR);
  106.         if (peeknextchar() != ',' &&
  107.         (!curtokmeaning || curtokmeaning->kind != MK_TYPE)) {
  108.         mp = addmeaning(curtoksym, MK_PARAM);
  109.         gettok();
  110.         wneedtok(TOK_DOTS);
  111.         wexpecttok(TOK_IDENT);
  112.         mp->xnext = addmeaning(curtoksym, MK_PARAM);
  113.         gettok();
  114.         if (wneedtok(TOK_COLON)) {
  115.             tp2->basetype = p_type(NULL);
  116.         } else {
  117.             tp2->basetype = tp_integer;
  118.         }
  119.         } else {
  120.         mp = addmeaning(findsymbol(format_s(name_ALOW, tname)), MK_PARAM);
  121.         mp->xnext = addmeaning(findsymbol(format_s(name_AHIGH, tname)), MK_PARAM);
  122.         tp2->basetype = p_type(NULL);
  123.         }
  124.         mp->fakeparam = 1;
  125.         mp->constqual = 1;
  126.         mp->xnext->fakeparam = 1;
  127.         mp->xnext->constqual = 1;
  128.         **confp = mp;
  129.         *confp = &mp->xnext->xnext;
  130.         mp->type = tp2->basetype;
  131.         mp->xnext->type = tp2->basetype;
  132.         tp2->smin = makeexpr_var(mp);
  133.         tp2->smax = makeexpr_var(mp->xnext);
  134.         tp->indextype = tp2;
  135.         tp->structdefd = 1;     /* conformant array flag */
  136.     }
  137.     }
  138.     if (curtok == TOK_COMMA || curtok == TOK_SEMI) {
  139.         gettok();
  140.         tp->basetype = p_arraydecl(tname, ispacked, confp);
  141.         return tp;
  142.     } else {
  143.     if (!modula2) {
  144.         if (!wneedtok(TOK_RBR))
  145.         skiptotoken(TOK_OF);
  146.     }
  147.         if (!wneedtok(TOK_OF))
  148.         skippasttotoken(TOK_OF, TOK_COMMA);
  149.     checkkeyword(TOK_VARYING);
  150.     if (confp != NULL &&
  151.         (curtok == TOK_ARRAY || curtok == TOK_PACKED ||
  152.          curtok == TOK_VARYING)) {
  153.         tp->basetype = p_conformant_array(tname, confp);
  154.     } else
  155.         tp->basetype = p_type(NULL);
  156.         if (!ispacked)
  157.             return tp;
  158.         size = 0;
  159.         tp2 = tp->basetype;
  160.         if (!tname)
  161.             tname = "array";
  162.         issigned = packedsize(tname, &tp2, &size, 1);
  163.         if (!size || size > 8 ||
  164.             (issigned && !packsigned) ||
  165.             (size > 4 &&
  166.              (!issigned || (signedchars == 1 || hassignedchar))))
  167.             return tp;
  168.         bpower = 0;
  169.         while ((1<<bpower) < size)
  170.             bpower++;        /* round size up to power of two */
  171.         size = 1<<bpower;    /* size = # bits in an array element */
  172.         tp->escale = bpower;
  173.         tp->issigned = issigned;
  174.         hasrange = ord_range(tp->indextype, &smin, &smax) &&
  175.                    (smax < 100000);    /* don't be confused by giant arrays */
  176.         if (hasrange &&
  177.         (bitsize = (smax - smin + 1) * size)
  178.             <= ((sizeof_integer > 0) ? sizeof_integer : 32)) {
  179.             if (bitsize > ((sizeof_short > 0) ? sizeof_short : 16)) {
  180.                 tp2 = (issigned) ? tp_integer : tp_unsigned;
  181.                 fullbitsize = ((sizeof_integer > 0) ? sizeof_integer : 32);
  182.             } else if (bitsize > ((sizeof_char > 0) ? sizeof_char : 8) ||
  183.                        (issigned && !(signedchars == 1 || hassignedchar))) {
  184.                 tp2 = (issigned) ? tp_sshort : tp_ushort;
  185.                 fullbitsize = ((sizeof_short > 0) ? sizeof_short : 16);
  186.             } else {
  187.                 tp2 = (issigned) ? tp_sbyte : tp_ubyte;
  188.                 fullbitsize = ((sizeof_char > 0) ? sizeof_char : 8);
  189.             }
  190.             tp->kind = TK_SMALLARRAY;
  191.             if (ord_range(tp->indextype, &smin, NULL) &&
  192.                 smin > 0 && smin <= fullbitsize - bitsize) {
  193.                 tp->smin = makeexpr_val(make_ord(tp->indextype->basetype, smin));
  194.                 tp->indextype = makesubrangetype(tp->indextype->basetype,
  195.                                                  makeexpr_val(make_ord(
  196.                                                      tp->indextype->basetype, 0)),
  197.                                                  copyexpr(tp->indextype->smax));
  198.             }
  199.         } else {
  200.             if (!issigned)
  201.                 tp2 = tp_ubyte;
  202.             else if (signedchars == 1 || hassignedchar)
  203.                 tp2 = tp_sbyte;
  204.             else
  205.                 tp2 = tp_sshort;
  206.         }
  207.         tp->smax = makeexpr_type(tp->basetype);
  208.         tp->basetype = tp2;
  209.         return tp;
  210.     }
  211. }
  212.  
  213.  
  214.  
  215. Static Type *p_conformant_array(tname, confp)
  216. char *tname;
  217. Meaning ***confp;
  218. {
  219.     int ispacked;
  220.     Meaning *mp;
  221.     Type *tp, *tp2;
  222.  
  223.     p_attributes();
  224.     ignore_attributes();
  225.     if (curtok == TOK_PACKED) {
  226.     ispacked = 1;
  227.     gettok();
  228.     } else
  229.     ispacked = 0;
  230.     checkkeyword(TOK_VARYING);
  231.     if (curtok == TOK_VARYING) {
  232.     gettok();
  233.     wneedtok(TOK_LBR);
  234.     wexpecttok(TOK_IDENT);
  235.     mp = addmeaning(curtoksym, MK_PARAM);
  236.     mp->fakeparam = 1;
  237.     mp->constqual = 1;
  238.     **confp = mp;
  239.     *confp = &mp->xnext;
  240.     mp->type = tp_integer;
  241.     tp2 = maketype(TK_SUBR);
  242.     tp2->basetype = tp_integer;
  243.     tp2->smin = makeexpr_long(1);
  244.     tp2->smax = makeexpr_var(mp);
  245.     tp = maketype(TK_STRING);
  246.     tp->indextype = tp2;
  247.     tp->basetype = tp_char;
  248.     tp->structdefd = 1;     /* conformant array flag */
  249.     gettok();
  250.     wneedtok(TOK_RBR);
  251.     skippasttoken(TOK_OF);
  252.     tp->basetype = p_type(NULL);
  253.     return tp;
  254.     }
  255.     if (wneedtok(TOK_ARRAY) &&
  256.     (modula2 || wneedtok(TOK_LBR))) {
  257.     return p_arraydecl(tname, ispacked, confp);
  258.     } else {
  259.     return tp_integer;
  260.     }
  261. }
  262.  
  263.  
  264.  
  265.  
  266. /* VAX Pascal: */
  267. void p_attributes()
  268. {
  269.     Strlist *l1;
  270.  
  271.     if (modula2)
  272.     return;
  273.     while (curtok == TOK_LBR) {
  274.     implementationmodules = 1;    /* auto-detect VAX Pascal */
  275.     do {
  276.         gettok();
  277.         if (!wexpecttok(TOK_IDENT)) {
  278.         skippasttoken(TOK_RBR);
  279.         return;
  280.         }
  281.         l1 = strlist_append(&attrlist, strupper(curtokbuf));
  282.         l1->value = -1;
  283.         gettok();
  284.         if (curtok == TOK_LPAR) {
  285.         gettok();
  286.         if (!strcmp(l1->s, "CHECK") ||
  287.             !strcmp(l1->s, "OPTIMIZE") ||
  288.             !strcmp(l1->s, "KEY") ||
  289.             !strcmp(l1->s, "COMMON") ||
  290.             !strcmp(l1->s, "PSECT") ||
  291.             !strcmp(l1->s, "EXTERNAL") ||
  292.             !strcmp(l1->s, "GLOBAL") ||
  293.             !strcmp(l1->s, "WEAK_EXTERNAL") ||
  294.             !strcmp(l1->s, "WEAK_GLOBAL")) {
  295.             l1->value = (long)stralloc(curtokbuf);
  296.             gettok();
  297.             while (curtok == TOK_COMMA) {
  298.             gettok();
  299.             gettok();
  300.             }
  301.         } else if (!strcmp(l1->s, "INHERIT") ||
  302.                !strcmp(l1->s, "IDENT") ||
  303.                !strcmp(l1->s, "ENVIRONMENT")) {
  304.             p_expr(NULL);
  305.             while (curtok == TOK_COMMA) {
  306.             gettok();
  307.             p_expr(NULL);
  308.             }
  309.         } else {
  310.             l1->value = ord_value(p_constant(tp_integer));
  311.             while (curtok == TOK_COMMA) {
  312.             gettok();
  313.             p_expr(NULL);
  314.             }
  315.         }
  316.         if (!wneedtok(TOK_RPAR)) {
  317.             skippasttotoken(TOK_RPAR, TOK_LBR);
  318.         }
  319.         }
  320.     } while (curtok == TOK_COMMA);
  321.     if (!wneedtok(TOK_RBR)) {
  322.         skippasttoken(TOK_RBR);
  323.     }
  324.     }
  325. }
  326.  
  327.  
  328. void ignore_attributes()
  329. {
  330.     while (attrlist) {
  331.     if (strcmp(attrlist->s, "HIDDEN") &&
  332.         strcmp(attrlist->s, "INHERIT") &&
  333.         strcmp(attrlist->s, "ENVIRONMENT"))
  334.         warning(format_s("Type attribute %s ignored [128]", attrlist->s));
  335.     strlist_eat(&attrlist);
  336.     }
  337. }
  338.  
  339.  
  340. int size_attributes()
  341. {
  342.     int size = -1;
  343.     Strlist *l1;
  344.  
  345.     if ((l1 = strlist_find(attrlist, "BIT")) != NULL)
  346.     size = 1;
  347.     else if ((l1 = strlist_find(attrlist, "BYTE")) != NULL)
  348.     size = 8;
  349.     else if ((l1 = strlist_find(attrlist, "WORD")) != NULL)
  350.     size = 16;
  351.     else if ((l1 = strlist_find(attrlist, "LONG")) != NULL)
  352.     size = 32;
  353.     else if ((l1 = strlist_find(attrlist, "QUAD")) != NULL)
  354.     size = 64;
  355.     else if ((l1 = strlist_find(attrlist, "OCTA")) != NULL)
  356.     size = 128;
  357.     else
  358.     return -1;
  359.     if (l1->value >= 0)
  360.     size *= l1->value;
  361.     strlist_delete(&attrlist, l1);
  362.     return size;
  363. }
  364.  
  365.  
  366. void p_mech_spec(doref)
  367. int doref;
  368. {
  369.     if (curtok == TOK_IDENT && doref &&
  370.     !strcicmp(curtokbuf, "%REF")) {
  371.     note("Mechanism specified %REF treated like VAR [107]");
  372.     curtok = TOK_VAR;
  373.     return;
  374.     }
  375.     if (curtok == TOK_IDENT &&
  376.     (!strcicmp(curtokbuf, "%REF") ||
  377.      !strcicmp(curtokbuf, "%IMMED") ||
  378.      !strcicmp(curtokbuf, "%DESCR") ||
  379.      !strcicmp(curtokbuf, "%STDESCR"))) {
  380.     note(format_s("Mechanism specifier %s ignored [108]", curtokbuf));
  381.     gettok();
  382.     }
  383. }
  384.  
  385.  
  386. Type *p_modula_subrange(basetype)
  387. Type *basetype;
  388. {
  389.     Type *tp;
  390.     Value val;
  391.  
  392.     wneedtok(TOK_LBR);
  393.     tp = maketype(TK_SUBR);
  394.     tp->smin = p_ord_expr();
  395.     if (basetype)
  396.     tp->smin = gentle_cast(tp->smin, basetype);
  397.     if (wexpecttok(TOK_DOTS)) {
  398.     gettok();
  399.     tp->smax = p_ord_expr();
  400.     if (tp->smax->val.type->kind == TK_REAL &&
  401.         tp->smax->kind == EK_CONST &&
  402.         strlen(tp->smax->val.s) == 12 &&
  403.         strcmp(tp->smax->val.s, "2147483648.0") >= 0 &&
  404.         strcmp(tp->smax->val.s, "4294967295.0") <= 0) {
  405.         tp = tp_unsigned;
  406.     } else if (basetype) {
  407.         tp->smin = gentle_cast(tp->smin, basetype);
  408.         tp->basetype = basetype;
  409.     } else {
  410.         basetype = ord_type(tp->smin->val.type);
  411.         if (basetype->kind == TK_INTEGER) {
  412.         val = eval_expr(tp->smin);
  413.         if (val.type && val.i >= 0)
  414.             basetype = tp_unsigned;
  415.         else
  416.             basetype = tp_integer;
  417.         }
  418.         tp->basetype = basetype;
  419.     }
  420.     } else {
  421.     tp = tp_integer;
  422.     }
  423.     if (!wneedtok(TOK_RBR))
  424.     skippasttotoken(TOK_RBR, TOK_SEMI);
  425.     return tp;
  426. }
  427.  
  428.  
  429. void makefakestruct(tp, tname)
  430. Type *tp;
  431. Meaning *tname;
  432. {
  433.     Symbol *sym;
  434.  
  435.     if (!tname)
  436.     return;
  437.     while (tp && (tp->kind == TK_ARRAY || tp->kind == TK_FILE))
  438.     tp = tp->basetype;
  439.     if (tp && tp->kind == TK_RECORD && !tp->meaning) {
  440.     sym = findsymbol(format_s(name_FAKESTRUCT, tname->name));
  441.     silentalreadydef++;
  442.     tp->meaning = addmeaning(sym, MK_TYPE);
  443.     silentalreadydef--;
  444.     tp->meaning->type = tp;
  445.     tp->meaning->refcount++;
  446.     declaretype(tp->meaning);
  447.     }
  448. }
  449.  
  450.  
  451. Type *p_type(tname)
  452. Meaning *tname;
  453. {
  454.     Type *tp;
  455.     int ispacked = 0;
  456.     Meaning **flast;
  457.     Meaning *mp;
  458.     Strlist *sl;
  459.     int num, isfunc, saveind, savenotephase, sizespec;
  460.     Expr *ex;
  461.     Value val;
  462.     static int proctypecount = 0;
  463.  
  464.     p_attributes();
  465.     sizespec = size_attributes();
  466.     ignore_attributes();
  467.     tp = tp_integer;
  468.     if (curtok == TOK_PACKED) {
  469.         ispacked = 1;
  470.         gettok();
  471.     }
  472.     checkkeyword(TOK_VARYING);
  473.     if (modula2)
  474.     checkkeyword(TOK_POINTER);
  475.     switch (curtok) {
  476.  
  477.         case TOK_RECORD:
  478.             gettok();
  479.         savenotephase = notephase;
  480.         notephase = 1;
  481.             tp = maketype(TK_RECORD);
  482.             p_fieldlist(tp, &(tp->fbase), ispacked, tname);
  483.         notephase = savenotephase;
  484.             if (!wneedtok(TOK_END)) {
  485.         skippasttoken(TOK_END);
  486.         }
  487.             break;
  488.  
  489.         case TOK_ARRAY:
  490.             gettok();
  491.         if (!modula2) {
  492.         if (!wneedtok(TOK_LBR))
  493.             break;
  494.         }
  495.         tp = p_arraydecl(tname ? tname->name : NULL, ispacked, NULL);
  496.         makefakestruct(tp, tname);
  497.             break;
  498.  
  499.     case TOK_VARYING:
  500.         gettok();
  501.         tp = maketype(TK_STRING);
  502.         if (wneedtok(TOK_LBR)) {
  503.         ex = p_ord_expr();
  504.         if (!wneedtok(TOK_RBR))
  505.             skippasttoken(TOK_RBR);
  506.         } else
  507.         ex = makeexpr_long(stringdefault);
  508.         if (wneedtok(TOK_OF))
  509.         tp->basetype = p_type(NULL);
  510.         else
  511.         tp->basetype = tp_char;
  512.         val = eval_expr(ex);
  513.         if (val.type) {
  514.         if (val.i > 255 && val.i > stringceiling) {
  515.             note(format_d("Strings longer than %d may have problems [109]",
  516.                   stringceiling));
  517.         }
  518.         if (stringceiling != 255 &&
  519.             (val.i >= 255 || val.i > stringceiling)) {
  520.             freeexpr(ex);
  521.             ex = makeexpr_long(stringceiling);
  522.         }
  523.         }
  524.         tp->indextype = makesubrangetype(tp_integer, makeexpr_long(0), ex);
  525.         break;
  526.  
  527.         case TOK_SET:
  528.             gettok();
  529.             if (!wneedtok(TOK_OF))
  530.         break;
  531.         tp = p_type(NULL);
  532.         if (tp == tp_integer || tp == tp_unsigned)
  533.         tp = makesubrangetype(tp, makeexpr_long(0),
  534.                       makeexpr_long(defaultsetsize-1));
  535.             tp = makesettype(tp);
  536.             break;
  537.  
  538.         case TOK_FILE:
  539.             gettok();
  540.         tp = maketype(TK_FILE);
  541.             if (curtok == TOK_OF) {
  542.                 gettok();
  543.                 tp->basetype = p_type(NULL);
  544.             } else {
  545.                 tp->basetype = tp_abyte;
  546.             }
  547.         if (tp->basetype->kind == TK_CHAR && charfiletext) {
  548.         tp = tp_text;
  549.         } else {
  550.         makefakestruct(tp, tname);
  551.         tp = makepointertype(tp);
  552.         }
  553.             break;
  554.  
  555.         case TOK_PROCEDURE:
  556.     case TOK_FUNCTION:
  557.         isfunc = (curtok == TOK_FUNCTION);
  558.             gettok();
  559.         if (curtok != TOK_LPAR && !isfunc && hasstaticlinks == 1) {
  560.         tp = tp_proc;
  561.         break;
  562.         }
  563.         proctypecount++;
  564.         mp = addmeaning(findsymbol(format_d("__PROCPTR%d",
  565.                         proctypecount)),
  566.                 MK_FUNCTION);
  567.         pushctx(mp);
  568.         tp = maketype((hasstaticlinks != 0) ? TK_PROCPTR : TK_CPROCPTR);
  569.         tp->basetype = p_funcdecl(&isfunc, 1);
  570.         tp->fbase = mp;   /* (saved, but not currently used) */
  571.         tp->escale = hasstaticlinks;
  572.         popctx();
  573.             break;
  574.  
  575.         case TOK_HAT:
  576.     case TOK_ADDR:
  577.     case TOK_POINTER:
  578.         if (curtok == TOK_POINTER) {
  579.         gettok();
  580.         wneedtok(TOK_TO);
  581.         if (curtok == TOK_IDENT && !strcmp(curtokbuf, "WORD")) {
  582.             tp = tp_anyptr;
  583.             gettok();
  584.             break;
  585.         }
  586.         } else
  587.         gettok();
  588.         p_attributes();
  589.         ignore_attributes();
  590.             tp = maketype(TK_POINTER);
  591.             if (curtok == TOK_IDENT &&
  592.         (!curtokmeaning || curtokmeaning->kind != MK_TYPE ||
  593.          (deferallptrs && curtokmeaning->ctx != curctx))) {
  594.                 struct ptrdesc *pd;
  595.                 pd = ALLOC(1, struct ptrdesc, ptrdescs);
  596.                 pd->sym = curtoksym;
  597.                 pd->tp = tp;
  598.                 pd->next = ptrbase;
  599.                 ptrbase = pd;
  600.                 tp->basetype = tp_abyte;
  601.         anydeferredptrs = 1;
  602.                 gettok();
  603.             } else {
  604.                 tp->basetype = p_type(NULL);
  605.                 if (!tp->basetype->pointertype)
  606.                     tp->basetype->pointertype = tp;
  607.             }
  608.             break;
  609.  
  610.         case TOK_LPAR:
  611.             if (!useenum)
  612.                 outsection(minorspace);
  613.         enum_tname = tname;
  614.             tp = maketype(TK_ENUM);
  615.             flast = &(tp->fbase);
  616.             num = 0;
  617.             do {
  618.                 gettok();
  619.                 if (!wexpecttok(TOK_IDENT)) {
  620.             skiptotoken(TOK_RPAR);
  621.             break;
  622.         }
  623.                 sl = strlist_find(constmacros, curtoksym->name);
  624.                 mp = addmeaningas(curtoksym, MK_CONST,
  625.                   (*enumformat) ? MK_VARIANT :
  626.                                   (useenum) ? MK_VAR : MK_CONST);
  627.                 mp->val.type = tp;
  628.                 mp->val.i = num++;
  629.                 mp->type = tp;
  630.                 if (sl) {
  631.                     mp->constdefn = (Expr *)sl->value;
  632.                     mp->anyvarflag = 1;    /* Make sure constant is folded */
  633.                     strlist_delete(&constmacros, sl);
  634.                     if (mp->constdefn->kind == EK_NAME)
  635.                         strchange(&mp->name, mp->constdefn->val.s);
  636.                 } else {
  637.                     if (!useenum) {
  638.             output(format_s("#define %s", mp->name));
  639.             mp->isreturn = 1;
  640.             out_spaces(constindent, 0, 0, 0);
  641.             saveind = outindent;
  642.             outindent = cur_column();
  643.             output(format_d("%d\n", mp->val.i));
  644.             outindent = saveind;
  645.             }
  646.         }
  647.                 *flast = mp;
  648.                 flast = &(mp->xnext);
  649.                 gettok();
  650.             } while (curtok == TOK_COMMA);
  651.         if (!wneedtok(TOK_RPAR))
  652.         skippasttoken(TOK_RPAR);
  653.             tp->smin = makeexpr_long(0);
  654.             tp->smax = makeexpr_long(num-1);
  655.             if (!useenum)
  656.                 outsection(minorspace);
  657.             break;
  658.  
  659.     case TOK_LBR:
  660.         tp = p_modula_subrange(NULL);
  661.         break;
  662.  
  663.         case TOK_IDENT:
  664.             if (!curtokmeaning) {
  665.                 undefsym(curtoksym);
  666.                 tp = tp_integer;
  667.                 mp = addmeaning(curtoksym, MK_TYPE);
  668.                 mp->type = tp;
  669.                 gettok();
  670.                 break;
  671.             } else if (curtokmeaning == mp_string) {
  672.                 gettok();
  673.                 tp = maketype(TK_STRING);
  674.                 tp->basetype = tp_char;
  675.                 if (curtok == TOK_LBR) {
  676.                     gettok();
  677.                     ex = p_ord_expr();
  678.                     if (!wneedtok(TOK_RBR))
  679.             skippasttoken(TOK_RBR);
  680.                 } else {
  681.             ex = makeexpr_long(stringdefault);
  682.                 }
  683.                 val = eval_expr(ex);
  684.                 if (val.type && stringceiling != 255 &&
  685.                     (val.i >= 255 || val.i > stringceiling)) {
  686.                     freeexpr(ex);
  687.                     ex = makeexpr_long(stringceiling);
  688.                 }
  689.                 tp->indextype = makesubrangetype(tp_integer, makeexpr_long(0), ex);
  690.                 break;
  691.             } else if (curtokmeaning->kind == MK_TYPE) {
  692.                 tp = curtokmeaning->type;
  693.         if (sizespec > 0) {
  694.             if (ord_type(tp)->kind == TK_INTEGER && sizespec <= 32) {
  695.             if (checkconst(tp->smin, 0)) {
  696.                 if (sizespec == 32)
  697.                 tp = tp_unsigned;
  698.                 else
  699.                 tp = makesubrangetype(tp_unsigned,
  700.                      makeexpr_long(0),
  701.                          makeexpr_long((1L << sizespec) - 1));
  702.             } else {
  703.                 tp = makesubrangetype(tp_integer,
  704.                      makeexpr_long(- ((1L << (sizespec-1)))),
  705.                      makeexpr_long((1L << (sizespec-1)) - 1));
  706.             }
  707.             sizespec = -1;
  708.             }
  709.         }
  710.                 gettok();
  711.         if (curtok == TOK_LBR) {
  712.             if (modula2) {
  713.             tp = p_modula_subrange(tp);
  714.             } else {
  715.             gettok();
  716.             ex = p_expr(tp_integer);
  717.             note("UCSD size spec ignored; using 'long int' [110]");
  718.             if (ord_type(tp)->kind == TK_INTEGER)
  719.                 tp = tp_integer;
  720.             if (!wneedtok(TOK_RBR))
  721.                 skippasttotoken(TOK_RBR, TOK_SEMI);
  722.             }
  723.         }
  724.                 break;
  725.             }
  726.  
  727.         /* fall through */
  728.         default:
  729.             tp = maketype(TK_SUBR);
  730.             tp->smin = p_ord_expr();
  731.         if (wexpecttok(TOK_DOTS)) {
  732.         gettok();
  733.         tp->smax = p_ord_expr();
  734.         if (tp->smax->val.type->kind == TK_REAL &&
  735.             tp->smax->kind == EK_CONST &&
  736.             strlen(tp->smax->val.s) == 12 &&
  737.             strcmp(tp->smax->val.s, "2147483648.0") >= 0 &&
  738.             strcmp(tp->smax->val.s, "4294967295.0") <= 0) {
  739.             tp = tp_unsigned;
  740.             break;
  741.         }
  742.         tp->basetype = ord_type(tp->smin->val.type);
  743.         } else {
  744.         tp = tp_integer;
  745.         }
  746.             break;
  747.     }
  748.     if (sizespec >= 0)
  749.     note(format_d("Don't know how to interpret size = %d bits [111]", sizespec));
  750.     return tp;
  751. }
  752.  
  753.  
  754.  
  755.  
  756.  
  757. Type *p_funcdecl(isfunc, istype)
  758. int *isfunc, istype;
  759. {
  760.     Meaning *retmp = NULL, *mp, *firstmp, *lastmp, **prevm, **oldprevm;
  761.     Type *type, *tp;
  762.     enum meaningkind parkind;
  763.     int anyvarflag, constflag, volatileflag, num = 0;
  764.     Symbol *sym;
  765.     Expr *defval;
  766.     Token savetok;
  767.     Strlist *l1;
  768.  
  769.     if (*isfunc || modula2) {
  770.         sym = findsymbol(format_s(name_RETV, curctx->name));
  771.         retmp = addmeaning(sym, MK_VAR);
  772.     retmp->isreturn = 1;
  773.     }
  774.     type = maketype(TK_FUNCTION);
  775.     if (curtok == TOK_LPAR) {
  776.         prevm = &type->fbase;
  777.         do {
  778.             gettok();
  779.         p_mech_spec(1);
  780.         p_attributes();
  781.         checkkeyword(TOK_ANYVAR);
  782.             if (curtok == TOK_VAR || curtok == TOK_ANYVAR) {
  783.                 parkind = MK_VARPARAM;
  784.                 anyvarflag = (curtok == TOK_ANYVAR);
  785.                 gettok();
  786.             } else if (curtok == TOK_PROCEDURE || curtok == TOK_FUNCTION) {
  787.         savetok = curtok;
  788.         gettok();
  789.         wexpecttok(TOK_IDENT);
  790.         *prevm = firstmp = addmeaning(curtoksym, MK_PARAM);
  791.         prevm = &firstmp->xnext;
  792.         firstmp->anyvarflag = 0;
  793.         curtok = savetok;   /* rearrange tokens to a proc ptr type! */
  794.         firstmp->type = p_type(firstmp);
  795.         continue;
  796.             } else {
  797.                 parkind = MK_PARAM;
  798.                 anyvarflag = 0;
  799.             }
  800.         oldprevm = prevm;
  801.         if (modula2 && istype) {
  802.         firstmp = addmeaning(findsymbol(format_d("_A%d", ++num)), parkind);
  803.         } else {
  804.         wexpecttok(TOK_IDENT);
  805.         firstmp = addmeaning(curtoksym, parkind);
  806.         gettok();
  807.         }
  808.             *prevm = firstmp;
  809.             prevm = &firstmp->xnext;
  810.             firstmp->isactive = 0;   /* nit-picking Turbo compatibility */
  811.         lastmp = firstmp;
  812.             while (curtok == TOK_COMMA) {
  813.                 gettok();
  814.                 if (wexpecttok(TOK_IDENT)) {
  815.             *prevm = lastmp = addmeaning(curtoksym, parkind);
  816.             prevm = &lastmp->xnext;
  817.             lastmp->isactive = 0;
  818.         }
  819.                 gettok();
  820.             }
  821.         constflag = volatileflag = 0;
  822.         defval = NULL;
  823.             if (curtok != TOK_COLON && !modula2) {
  824.         if (parkind != MK_VARPARAM)
  825.             wexpecttok(TOK_COLON);
  826.         parkind = MK_VARPARAM;
  827.                 tp = tp_anyptr;
  828.                 anyvarflag = 1;
  829.             } else {
  830.         if (curtok == TOK_COLON)
  831.             gettok();
  832.         if (curtok == TOK_IDENT && !curtokmeaning &&
  833.             !strcicmp(curtokbuf, "UNIV")) {
  834.             if (parkind == MK_PARAM)
  835.             note("UNIV may not work for non-VAR parameters [112]");
  836.             anyvarflag = 1;
  837.             gettok();
  838.         }
  839.         p_attributes();
  840.         if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
  841.             constflag = 1;
  842.             strlist_delete(&attrlist, l1);
  843.         }
  844.         if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
  845.             volatileflag = 1;
  846.             strlist_delete(&attrlist, l1);
  847.         }
  848.         if ((l1 = strlist_find(attrlist, "UNSAFE")) != NULL &&
  849.             parkind == MK_VARPARAM) {
  850.             anyvarflag = 1;
  851.             strlist_delete(&attrlist, l1);
  852.         }
  853.         if ((l1 = strlist_find(attrlist, "REFERENCE")) != NULL) {
  854.             note("REFERENCE attribute treated like VAR [107]");
  855.             parkind = MK_VARPARAM;
  856.             strlist_delete(&attrlist, l1);
  857.         }
  858.         checkkeyword(TOK_VARYING);
  859.                 if (curtok == TOK_IDENT && curtokmeaning == mp_string &&
  860.                     !anyvarflag && parkind == MK_VARPARAM) {
  861.                     anyvarflag = (varstrings > 0);
  862.                     tp = tp_str255;
  863.                     gettok();
  864.             if (curtok == TOK_LBR) {
  865.             wexpecttok(TOK_SEMI);
  866.             skipparens();
  867.             }
  868.         } else if (curtok == TOK_ARRAY || curtok == TOK_PACKED ||
  869.                curtok == TOK_VARYING) {
  870.             prevm = oldprevm;
  871.             tp = p_conformant_array(firstmp->name, &prevm);
  872.             *prevm = firstmp;
  873.             while (*prevm)
  874.             prevm = &(*prevm)->xnext;
  875.                 } else {
  876.                     tp = p_type(firstmp);
  877.                 }
  878.                 if (!varfiles && isfiletype(tp))
  879.                     parkind = MK_PARAM;
  880.                 if (parkind == MK_VARPARAM)
  881.                     tp = makepointertype(tp);
  882.             }
  883.         if (curtok == TOK_ASSIGN) {    /* check for parameter default */
  884.         gettok();
  885.         p_mech_spec(0);
  886.         defval = gentle_cast(p_expr(tp), tp);
  887.         if ((tp->kind == TK_STRING || tp->kind == TK_ARRAY) &&
  888.             tp->basetype->kind == TK_CHAR &&
  889.             tp->structdefd &&     /* conformant string */
  890.             defval->val.type->kind == TK_STRING) {
  891.             mp = *oldprevm;
  892.             if (tp->kind == TK_ARRAY) {
  893.             mp->constdefn = makeexpr_long(1);
  894.             mp = mp->xnext;
  895.             }
  896.             mp->constdefn = strmax_func(defval);
  897.         }
  898.         }
  899.             while (firstmp) {
  900.                 firstmp->type = tp;
  901.                 firstmp->kind = parkind;    /* in case it changed */
  902.                 firstmp->isactive = 1;
  903.                 firstmp->anyvarflag = anyvarflag;
  904.         firstmp->constqual = constflag;
  905.         firstmp->volatilequal = volatileflag;
  906.         if (defval) {
  907.             if (firstmp == lastmp)
  908.             firstmp->constdefn = defval;
  909.             else
  910.             firstmp->constdefn = copyexpr(defval);
  911.         }
  912.                 if (parkind == MK_PARAM &&
  913.                     (tp->kind == TK_STRING ||
  914.                      tp->kind == TK_ARRAY ||
  915.                      tp->kind == TK_SET ||
  916.                      ((tp->kind == TK_RECORD || tp->kind == TK_PROCPTR) && copystructs < 2))) {
  917.                     firstmp->othername = stralloc(format_s(name_COPYPAR, firstmp->name));
  918.                     firstmp->rectype = makepointertype(tp);
  919.                 }
  920.         if (firstmp == lastmp)
  921.             break;
  922.                 firstmp = firstmp->xnext;
  923.             }
  924.         } while (curtok == TOK_SEMI || curtok == TOK_COMMA);
  925.         if (!wneedtok(TOK_RPAR))
  926.         skippasttotoken(TOK_RPAR, TOK_SEMI);
  927.     }
  928.     if (modula2) {
  929.     if (curtok == TOK_COLON) {
  930.         *isfunc = 1;
  931.     } else {
  932.         unaddmeaning(retmp);
  933.     }
  934.     }
  935.     if (*isfunc) {
  936.         if (wneedtok(TOK_COLON)) {
  937.         retmp->type = type->basetype = p_type(NULL);
  938.         switch (retmp->type->kind) {
  939.         
  940.           case TK_RECORD:
  941.           case TK_PROCPTR:
  942.                 if (copystructs >= 3)
  943.                     break;
  944.         
  945.         /* fall through */
  946.           case TK_ARRAY:
  947.           case TK_STRING:
  948.           case TK_SET:
  949.                 type->basetype = retmp->type = makepointertype(retmp->type);
  950.                 retmp->kind = MK_VARPARAM;
  951.                 retmp->anyvarflag = 0;
  952.                 retmp->xnext = type->fbase;
  953.                 type->fbase = retmp;
  954.                 retmp->refcount++;
  955.                 break;
  956.  
  957.           default:
  958.         break;
  959.         }
  960.     } else
  961.         retmp->type = type->basetype = tp_integer;
  962.     } else
  963.         type->basetype = tp_void;
  964.     return type;
  965. }
  966.  
  967.  
  968.  
  969.  
  970.  
  971. Symbol *findlabelsym()
  972. {
  973.     if (curtok == TOK_IDENT && 
  974.         curtokmeaning && curtokmeaning->kind == MK_LABEL) {
  975. #if 0
  976.     if (curtokmeaning->ctx != curctx && curtokmeaning->val.i != 0)
  977.         curtokmeaning->val.i = --nonloclabelcount;
  978. #endif
  979.     } else if (curtok == TOK_INTLIT) {
  980.         strcpy(curtokcase, curtokbuf);
  981.         curtoksym = findsymbol(curtokbuf);
  982.         curtokmeaning = curtoksym->mbase;
  983.         while (curtokmeaning && !curtokmeaning->isactive)
  984.             curtokmeaning = curtokmeaning->snext;
  985.         if (!curtokmeaning || curtokmeaning->kind != MK_LABEL)
  986.             return NULL;
  987. #if 0
  988.     if (curtokmeaning->ctx != curctx && curtokmeaning->val.i != 0)
  989.         if (curtokint == 0)
  990.         curtokmeaning->val.i = -1;
  991.         else
  992.         curtokmeaning->val.i = curtokint;
  993. #endif
  994.     } else
  995.     return NULL;
  996.     return curtoksym;
  997. }
  998.  
  999.