home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume21 / p2c / part14 < prev    next >
Text File  |  1990-04-05  |  41KB  |  1,457 lines
  1. Subject:  v21i059:  Pascal to C translator, Part14/32
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4. X-Checksum-Snefru: d5f29716 75062373 fd923800 f99ed6dc
  5.  
  6. Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
  7. Posting-number: Volume 21, Issue 59
  8. Archive-name: p2c/part14
  9.  
  10. #! /bin/sh
  11. # This is a shell archive.  Remove anything before this line, then unpack
  12. # it by saving it into a file and typing "sh file".  To overwrite existing
  13. # files, type "sh file -c".  You can also feed this as standard input via
  14. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  15. # will see the following message at the end:
  16. #        "End of archive 14 (of 32)."
  17. # Contents:  src/decl.c.3
  18. # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:37 1990
  19. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  20. if test -f 'src/decl.c.3' -a "${1}" != "-c" ; then 
  21.   echo shar: Will not clobber existing file \"'src/decl.c.3'\"
  22. else
  23. echo shar: Extracting \"'src/decl.c.3'\" \(38042 characters\)
  24. sed "s/^X//" >'src/decl.c.3' <<'END_OF_FILE'
  25. X            strcmp(tp->smax->val.s, "4294967295.0") <= 0) {
  26. X            tp = tp_unsigned;
  27. X            break;
  28. X        }
  29. X        tp->basetype = ord_type(tp->smin->val.type);
  30. X        } else {
  31. X        tp = tp_integer;
  32. X        }
  33. X            break;
  34. X    }
  35. X    if (sizespec >= 0)
  36. X    note(format_d("Don't know how to interpret size = %d bits [111]", sizespec));
  37. X    return tp;
  38. X}
  39. X
  40. X
  41. X
  42. X
  43. X
  44. XType *p_funcdecl(isfunc, istype)
  45. Xint *isfunc, istype;
  46. X{
  47. X    Meaning *retmp = NULL, *mp, *firstmp, *lastmp, **prevm, **oldprevm;
  48. X    Type *type, *tp;
  49. X    enum meaningkind parkind;
  50. X    int anyvarflag, constflag, volatileflag, num = 0;
  51. X    Symbol *sym;
  52. X    Expr *defval;
  53. X    Token savetok;
  54. X    Strlist *l1;
  55. X
  56. X    if (*isfunc || modula2) {
  57. X        sym = findsymbol(format_s(name_RETV, curctx->name));
  58. X        retmp = addmeaning(sym, MK_VAR);
  59. X    retmp->isreturn = 1;
  60. X    }
  61. X    type = maketype(TK_FUNCTION);
  62. X    if (curtok == TOK_LPAR) {
  63. X        prevm = &type->fbase;
  64. X        do {
  65. X            gettok();
  66. X        p_mech_spec(1);
  67. X        p_attributes();
  68. X        checkkeyword(TOK_ANYVAR);
  69. X            if (curtok == TOK_VAR || curtok == TOK_ANYVAR) {
  70. X                parkind = MK_VARPARAM;
  71. X                anyvarflag = (curtok == TOK_ANYVAR);
  72. X                gettok();
  73. X            } else if (curtok == TOK_PROCEDURE || curtok == TOK_FUNCTION) {
  74. X        savetok = curtok;
  75. X        gettok();
  76. X        wexpecttok(TOK_IDENT);
  77. X        *prevm = firstmp = addmeaning(curtoksym, MK_PARAM);
  78. X        prevm = &firstmp->xnext;
  79. X        firstmp->anyvarflag = 0;
  80. X        curtok = savetok;   /* rearrange tokens to a proc ptr type! */
  81. X        firstmp->type = p_type(firstmp);
  82. X        continue;
  83. X            } else {
  84. X                parkind = MK_PARAM;
  85. X                anyvarflag = 0;
  86. X            }
  87. X        oldprevm = prevm;
  88. X        if (modula2 && istype) {
  89. X        firstmp = addmeaning(findsymbol(format_d("_A%d", ++num)), parkind);
  90. X        } else {
  91. X        wexpecttok(TOK_IDENT);
  92. X        firstmp = addmeaning(curtoksym, parkind);
  93. X        gettok();
  94. X        }
  95. X            *prevm = firstmp;
  96. X            prevm = &firstmp->xnext;
  97. X            firstmp->isactive = 0;   /* nit-picking Turbo compatibility */
  98. X        lastmp = firstmp;
  99. X            while (curtok == TOK_COMMA) {
  100. X                gettok();
  101. X                if (wexpecttok(TOK_IDENT)) {
  102. X            *prevm = lastmp = addmeaning(curtoksym, parkind);
  103. X            prevm = &lastmp->xnext;
  104. X            lastmp->isactive = 0;
  105. X        }
  106. X                gettok();
  107. X            }
  108. X        constflag = volatileflag = 0;
  109. X        defval = NULL;
  110. X            if (curtok != TOK_COLON && !modula2) {
  111. X        if (parkind != MK_VARPARAM)
  112. X            wexpecttok(TOK_COLON);
  113. X        parkind = MK_VARPARAM;
  114. X                tp = tp_anyptr;
  115. X                anyvarflag = 1;
  116. X            } else {
  117. X        if (curtok == TOK_COLON)
  118. X            gettok();
  119. X        if (curtok == TOK_IDENT && !curtokmeaning &&
  120. X            !strcicmp(curtokbuf, "UNIV")) {
  121. X            if (parkind == MK_PARAM)
  122. X            note("UNIV may not work for non-VAR parameters [112]");
  123. X            anyvarflag = 1;
  124. X            gettok();
  125. X        }
  126. X        p_attributes();
  127. X        if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
  128. X            constflag = 1;
  129. X            strlist_delete(&attrlist, l1);
  130. X        }
  131. X        if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
  132. X            volatileflag = 1;
  133. X            strlist_delete(&attrlist, l1);
  134. X        }
  135. X        if ((l1 = strlist_find(attrlist, "UNSAFE")) != NULL &&
  136. X            parkind == MK_VARPARAM) {
  137. X            anyvarflag = 1;
  138. X            strlist_delete(&attrlist, l1);
  139. X        }
  140. X        if ((l1 = strlist_find(attrlist, "REFERENCE")) != NULL) {
  141. X            note("REFERENCE attribute treated like VAR [107]");
  142. X            parkind = MK_VARPARAM;
  143. X            strlist_delete(&attrlist, l1);
  144. X        }
  145. X        checkkeyword(TOK_VARYING);
  146. X                if (curtok == TOK_IDENT && curtokmeaning == mp_string &&
  147. X                    !anyvarflag && parkind == MK_VARPARAM) {
  148. X                    anyvarflag = (varstrings > 0);
  149. X                    tp = tp_str255;
  150. X                    gettok();
  151. X            if (curtok == TOK_LBR) {
  152. X            wexpecttok(TOK_SEMI);
  153. X            skipparens();
  154. X            }
  155. X        } else if (curtok == TOK_ARRAY || curtok == TOK_PACKED ||
  156. X               curtok == TOK_VARYING) {
  157. X            prevm = oldprevm;
  158. X            tp = p_conformant_array(firstmp->name, &prevm);
  159. X            *prevm = firstmp;
  160. X            while (*prevm)
  161. X            prevm = &(*prevm)->xnext;
  162. X                } else {
  163. X                    tp = p_type(firstmp);
  164. X                }
  165. X                if (!varfiles && isfiletype(tp))
  166. X                    parkind = MK_PARAM;
  167. X                if (parkind == MK_VARPARAM)
  168. X                    tp = makepointertype(tp);
  169. X            }
  170. X        if (curtok == TOK_ASSIGN) {    /* check for parameter default */
  171. X        gettok();
  172. X        p_mech_spec(0);
  173. X        defval = gentle_cast(p_expr(tp), tp);
  174. X        if ((tp->kind == TK_STRING || tp->kind == TK_ARRAY) &&
  175. X            tp->basetype->kind == TK_CHAR &&
  176. X            tp->structdefd &&     /* conformant string */
  177. X            defval->val.type->kind == TK_STRING) {
  178. X            mp = *oldprevm;
  179. X            if (tp->kind == TK_ARRAY) {
  180. X            mp->constdefn = makeexpr_long(1);
  181. X            mp = mp->xnext;
  182. X            }
  183. X            mp->constdefn = strmax_func(defval);
  184. X        }
  185. X        }
  186. X            while (firstmp) {
  187. X                firstmp->type = tp;
  188. X                firstmp->kind = parkind;    /* in case it changed */
  189. X                firstmp->isactive = 1;
  190. X                firstmp->anyvarflag = anyvarflag;
  191. X        firstmp->constqual = constflag;
  192. X        firstmp->volatilequal = volatileflag;
  193. X        if (defval) {
  194. X            if (firstmp == lastmp)
  195. X            firstmp->constdefn = defval;
  196. X            else
  197. X            firstmp->constdefn = copyexpr(defval);
  198. X        }
  199. X                if (parkind == MK_PARAM &&
  200. X                    (tp->kind == TK_STRING ||
  201. X                     tp->kind == TK_ARRAY ||
  202. X                     tp->kind == TK_SET ||
  203. X                     ((tp->kind == TK_RECORD || tp->kind == TK_PROCPTR) && copystructs < 2))) {
  204. X                    firstmp->othername = stralloc(format_s(name_COPYPAR, firstmp->name));
  205. X                    firstmp->rectype = makepointertype(tp);
  206. X                }
  207. X        if (firstmp == lastmp)
  208. X            break;
  209. X                firstmp = firstmp->xnext;
  210. X            }
  211. X        } while (curtok == TOK_SEMI || curtok == TOK_COMMA);
  212. X        if (!wneedtok(TOK_RPAR))
  213. X        skippasttotoken(TOK_RPAR, TOK_SEMI);
  214. X    }
  215. X    if (modula2) {
  216. X    if (curtok == TOK_COLON) {
  217. X        *isfunc = 1;
  218. X    } else {
  219. X        unaddmeaning(retmp);
  220. X    }
  221. X    }
  222. X    if (*isfunc) {
  223. X        if (wneedtok(TOK_COLON)) {
  224. X        retmp->type = type->basetype = p_type(NULL);
  225. X        switch (retmp->type->kind) {
  226. X        
  227. X          case TK_RECORD:
  228. X          case TK_PROCPTR:
  229. X                if (copystructs >= 3)
  230. X                    break;
  231. X        
  232. X        /* fall through */
  233. X          case TK_ARRAY:
  234. X          case TK_STRING:
  235. X          case TK_SET:
  236. X                type->basetype = retmp->type = makepointertype(retmp->type);
  237. X                retmp->kind = MK_VARPARAM;
  238. X                retmp->anyvarflag = 0;
  239. X                retmp->xnext = type->fbase;
  240. X                type->fbase = retmp;
  241. X                retmp->refcount++;
  242. X                break;
  243. X
  244. X          default:
  245. X        break;
  246. X        }
  247. X    } else
  248. X        retmp->type = type->basetype = tp_integer;
  249. X    } else
  250. X        type->basetype = tp_void;
  251. X    return type;
  252. X}
  253. X
  254. X
  255. X
  256. X
  257. X
  258. XSymbol *findlabelsym()
  259. X{
  260. X    if (curtok == TOK_IDENT && 
  261. X        curtokmeaning && curtokmeaning->kind == MK_LABEL) {
  262. X#if 0
  263. X    if (curtokmeaning->ctx != curctx && curtokmeaning->val.i != 0)
  264. X        curtokmeaning->val.i = --nonloclabelcount;
  265. X#endif
  266. X    } else if (curtok == TOK_INTLIT) {
  267. X        strcpy(curtokcase, curtokbuf);
  268. X        curtoksym = findsymbol(curtokbuf);
  269. X        curtokmeaning = curtoksym->mbase;
  270. X        while (curtokmeaning && !curtokmeaning->isactive)
  271. X            curtokmeaning = curtokmeaning->snext;
  272. X        if (!curtokmeaning || curtokmeaning->kind != MK_LABEL)
  273. X            return NULL;
  274. X#if 0
  275. X    if (curtokmeaning->ctx != curctx && curtokmeaning->val.i != 0)
  276. X        if (curtokint == 0)
  277. X        curtokmeaning->val.i = -1;
  278. X        else
  279. X        curtokmeaning->val.i = curtokint;
  280. X#endif
  281. X    } else
  282. X    return NULL;
  283. X    return curtoksym;
  284. X}
  285. X
  286. X
  287. Xvoid p_labeldecl()
  288. X{
  289. X    Symbol *sp;
  290. X    Meaning *mp;
  291. X
  292. X    do {
  293. X        gettok();
  294. X        if (curtok != TOK_IDENT)
  295. X            wexpecttok(TOK_INTLIT);
  296. X        sp = findlabelsym();
  297. X        mp = addmeaning(curtoksym, MK_LABEL);
  298. X    mp->val.i = 0;
  299. X    mp->xnext = addmeaning(findsymbol(format_s(name_LABVAR,
  300. X                           mp->name)),
  301. X                   MK_VAR);
  302. X    mp->xnext->type = tp_jmp_buf;
  303. X    mp->xnext->refcount = 0;
  304. X        gettok();
  305. X    } while (curtok == TOK_COMMA);
  306. X    if (!wneedtok(TOK_SEMI))
  307. X    skippasttoken(TOK_SEMI);
  308. X}
  309. X
  310. X
  311. X
  312. X
  313. X
  314. XMeaning *findfieldname(sym, variants, nvars)
  315. XSymbol *sym;
  316. XMeaning **variants;
  317. Xint *nvars;
  318. X{
  319. X    Meaning *mp, *mp0;
  320. X
  321. X    mp = variants[*nvars-1];
  322. X    while (mp && mp->kind == MK_FIELD) {
  323. X        if (mp->sym == sym) {
  324. X            return mp;
  325. X        }
  326. X        mp = mp->cnext;
  327. X    }
  328. X    while (mp) {
  329. X        variants[(*nvars)++] = mp->ctx;
  330. X        mp0 = findfieldname(sym, variants, nvars);
  331. X        if (mp0)
  332. X            return mp0;
  333. X        (*nvars)--;
  334. X        while (mp->cnext && mp->cnext->ctx == mp->ctx)
  335. X            mp = mp->cnext;
  336. X        mp = mp->cnext;
  337. X    }
  338. X    return NULL;
  339. X}
  340. X
  341. X
  342. X
  343. X
  344. XExpr *p_constrecord(type, style)
  345. XType *type;
  346. Xint style;   /* 0=HP, 1=Turbo, 2=Oregon+VAX */
  347. X{
  348. X    Meaning *mp, *mp0, *variants[20], *newvariants[20], *curfield;
  349. X    Symbol *sym;
  350. X    Value val;
  351. X    Expr *ex, *cex;
  352. X    int i, j, nvars, newnvars, varcounts[20];
  353. X
  354. X    if (!wneedtok(style ? TOK_LPAR : TOK_LBR))
  355. X    return makeexpr_long(0);
  356. X    cex = makeexpr(EK_STRUCTCONST, 0);
  357. X    nvars = 0;
  358. X    varcounts[0] = 0;
  359. X    curfield = type->fbase;
  360. X    for (;;) {
  361. X    if (style == 2) {
  362. X        if (curfield) {
  363. X        mp = curfield;
  364. X        if (mp->kind == MK_VARIANT || mp->isforward) {
  365. X            val = p_constant(mp->type);
  366. X            if (mp->kind == MK_FIELD) {
  367. X            insertarg(&cex, cex->nargs, makeexpr_val(val));
  368. X            mp = mp->cnext;
  369. X            }
  370. X            val.type = mp->val.type;
  371. X            if (!valuesame(val, mp->val)) {
  372. X            while (mp && !valuesame(val, mp->val))
  373. X                mp = mp->cnext;
  374. X            if (mp) {
  375. X                note("Attempting to initialize union member other than first [113]");
  376. X                curfield = mp->ctx;
  377. X            } else {
  378. X                warning("Tag value does not exist in record [129]");
  379. X                curfield = NULL;
  380. X            }
  381. X            } else
  382. X            curfield = mp->ctx;
  383. X            goto ignorefield;
  384. X        } else {
  385. X            i = cex->nargs;
  386. X            insertarg(&cex, i, NULL);
  387. X            if (mp->isforward && curfield->cnext)
  388. X            curfield = curfield->cnext->ctx;
  389. X            else
  390. X            curfield = curfield->cnext;
  391. X        }
  392. X        } else {
  393. X        warning("Too many fields in record constructor [130]");
  394. X        ex = p_expr(NULL);
  395. X        freeexpr(ex);
  396. X        goto ignorefield;
  397. X        }
  398. X    } else {
  399. X        if (!wexpecttok(TOK_IDENT)) {
  400. X        skiptotoken2(TOK_RPAR, TOK_RBR);
  401. X        break;
  402. X        }
  403. X        sym = curtoksym;
  404. X        gettok();
  405. X        if (!wneedtok(TOK_COLON)) {
  406. X        skiptotoken2(TOK_RPAR, TOK_RBR);
  407. X        break;
  408. X        }
  409. X        newnvars = 1;
  410. X        newvariants[0] = type->fbase;
  411. X        mp = findfieldname(sym, newvariants, &newnvars);
  412. X        if (!mp) {
  413. X        warning(format_s("Field %s not in record [131]", sym->name));
  414. X        ex = p_expr(NULL);   /* good enough */
  415. X        freeexpr(ex);
  416. X        goto ignorefield;
  417. X        }
  418. X        for (i = 0; i < nvars && i < newnvars; i++) {
  419. X        if (variants[i] != newvariants[i]) {
  420. X            warning("Fields are members of incompatible variants [132]");
  421. X            ex = p_subconst(mp->type, style);
  422. X            freeexpr(ex);
  423. X            goto ignorefield;
  424. X        }
  425. X        }
  426. X        while (nvars < newnvars) {
  427. X        variants[nvars] = newvariants[nvars];
  428. X        if (nvars > 0) {
  429. X            for (mp0 = variants[nvars-1]; mp0->kind != MK_VARIANT; mp0 = mp0->cnext) ;
  430. X            if (mp0->ctx != variants[nvars])
  431. X            note("Attempting to initialize union member other than first [113]");
  432. X        }
  433. X        i = varcounts[nvars];
  434. X        for (mp0 = variants[nvars]; mp0 && mp0->kind == MK_FIELD; mp0 = mp0->cnext)
  435. X            i++;
  436. X        nvars++;
  437. X        varcounts[nvars] = i;
  438. X        while (cex->nargs < i)
  439. X            insertarg(&cex, cex->nargs, NULL);
  440. X        }
  441. X        i = varcounts[newnvars-1];
  442. X        for (mp0 = variants[newnvars-1]; mp0->sym != sym; mp0 = mp0->cnext)
  443. X        i++;
  444. X        if (cex->args[i])
  445. X        warning(format_s("Two constructors for %s [133]", mp->name));
  446. X    }
  447. X    ex = p_subconst(mp->type, style);
  448. X    if (ex->kind == EK_CONST &&
  449. X        (ex->val.type->kind == TK_RECORD ||
  450. X         ex->val.type->kind == TK_ARRAY))
  451. X        ex = (Expr *)ex->val.i;
  452. X    cex->args[i] = ex;
  453. Xignorefield:
  454. X        if (curtok == TOK_COMMA || curtok == TOK_SEMI)
  455. X            gettok();
  456. X        else
  457. X            break;
  458. X    }
  459. X    if (!wneedtok(style ? TOK_RPAR : TOK_RBR))
  460. X    skippasttoken2(TOK_RPAR, TOK_RBR);
  461. X    if (style != 2) {
  462. X    j = 0;
  463. X    mp = variants[0];
  464. X    for (i = 0; i < cex->nargs; i++) {
  465. X        while (!mp || mp->kind != MK_FIELD)
  466. X        mp = variants[++j];
  467. X        if (!cex->args[i]) {
  468. X        warning(format_s("No constructor for %s [134]", mp->name));
  469. X        cex->args[i] = makeexpr_name("<oops>", mp->type);
  470. X        }
  471. X        mp = mp->cnext;
  472. X    }
  473. X    }
  474. X    val.type = type;
  475. X    val.i = (long)cex;
  476. X    val.s = NULL;
  477. X    return makeexpr_val(val);
  478. X}
  479. X
  480. X
  481. X
  482. X
  483. XExpr *p_constarray(type, style)
  484. XType *type;
  485. Xint style;
  486. X{
  487. X    Value val;
  488. X    Expr *ex, *cex;
  489. X    int nvals, skipped;
  490. X    long smin, smax;
  491. X
  492. X    if (type->kind == TK_SMALLARRAY)
  493. X        warning("Small-array constructors not yet implemented [135]");
  494. X    if (!wneedtok(style ? TOK_LPAR : TOK_LBR))
  495. X    return makeexpr_long(0);
  496. X    if (type->smin && type->smin->kind == EK_CONST)
  497. X        skipped = type->smin->val.i;
  498. X    else
  499. X        skipped = 0;
  500. X    cex = NULL;
  501. X    for (;;) {
  502. X        if (style && (curtok == TOK_LPAR || curtok == TOK_LBR)) {
  503. X            ex = p_subconst(type->basetype, style);
  504. X            nvals = 1;
  505. X    } else if (curtok == TOK_REPEAT) {
  506. X        gettok();
  507. X        ex = p_expr(type->basetype);
  508. X        if (ord_range(type->indextype, &smin, &smax)) {
  509. X        nvals = smax - smin + 1;
  510. X        if (cex)
  511. X            nvals -= cex->nargs;
  512. X        } else {
  513. X        nvals = 1;
  514. X        note("REPEAT not translatable for non-constant array bounds [114]");
  515. X        }
  516. X            ex = gentle_cast(ex, type->basetype);
  517. X        } else {
  518. X            ex = p_expr(type->basetype);
  519. X            if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING &&
  520. X                ex->val.i > 1 && !skipped && style == 0 && !cex &&
  521. X                type->basetype->kind == TK_CHAR &&
  522. X                checkconst(type->indextype->smin, 1)) {
  523. X                if (!wneedtok(TOK_RBR))
  524. X            skippasttoken2(TOK_RBR, TOK_RPAR);
  525. X                return ex;   /* not quite right, but close enough */
  526. X            }
  527. X            if (curtok == TOK_OF) {
  528. X                ex = gentle_cast(ex, tp_integer);
  529. X                val = eval_expr(ex);
  530. X                freeexpr(ex);
  531. X                if (!val.type)
  532. X                    warning("Expected a constant [127]");
  533. X                nvals = val.i;
  534. X                gettok();
  535. X                ex = p_expr(type->basetype);
  536. X            } else
  537. X                nvals = 1;
  538. X            ex = gentle_cast(ex, type->basetype);
  539. X        }
  540. X        nvals += skipped;
  541. X        skipped = 0;
  542. X        if (ex->kind == EK_CONST &&
  543. X            (ex->val.type->kind == TK_RECORD ||
  544. X             ex->val.type->kind == TK_ARRAY))
  545. X            ex = (Expr *)ex->val.i;
  546. X        if (nvals != 1) {
  547. X            ex = makeexpr_un(EK_STRUCTOF, type->basetype, ex);
  548. X            ex->val.i = nvals;
  549. X        }
  550. X        if (cex)
  551. X            insertarg(&cex, cex->nargs, ex);
  552. X        else
  553. X            cex = makeexpr_un(EK_STRUCTCONST, type, ex);
  554. X        if (curtok == TOK_COMMA)
  555. X            gettok();
  556. X        else
  557. X            break;
  558. X    }
  559. X    if (!wneedtok(style ? TOK_RPAR : TOK_RBR))
  560. X    skippasttoken2(TOK_RPAR, TOK_RBR);
  561. X    val.type = type;
  562. X    val.i = (long)cex;
  563. X    val.s = NULL;
  564. X    return makeexpr_val(val);
  565. X}
  566. X
  567. X
  568. X
  569. X
  570. XExpr *p_conststring(type, style)
  571. XType *type;
  572. Xint style;
  573. X{
  574. X    Expr *ex;
  575. X    Token close = (style ? TOK_RPAR : TOK_RBR);
  576. X
  577. X    if (curtok != (style ? TOK_LPAR : TOK_LBR))
  578. X    return p_expr(type);
  579. X    gettok();
  580. X    ex = p_expr(tp_integer);  /* should handle "OF" and "," for constructors */
  581. X    if (curtok == TOK_OF || curtok == TOK_COMMA) {
  582. X        warning("Multi-element string constructors not yet supported [136]");
  583. X    skiptotoken(close);
  584. X    }
  585. X    if (!wneedtok(close))
  586. X    skippasttoken(close);
  587. X    return ex;
  588. X}
  589. X
  590. X
  591. X
  592. X
  593. XExpr *p_subconst(type, style)
  594. XType *type;
  595. Xint style;
  596. X{
  597. X    Value val;
  598. X
  599. X    if (curtok == TOK_IDENT && curtokmeaning &&
  600. X    curtokmeaning->kind == MK_TYPE) {
  601. X    if (curtokmeaning->type != type)
  602. X        warning("Type conflict in constant [137]");
  603. X    gettok();
  604. X    }
  605. X    if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "ZERO") &&
  606. X    !curtokmeaning) {   /* VAX Pascal foolishness */
  607. X    gettok();
  608. X    if (type->kind == TK_STRING)
  609. X        return makeexpr_string("");
  610. X    if (type->kind == TK_REAL)
  611. X        return makeexpr_real("0.0");
  612. X    val.type = type;
  613. X    if (type->kind == TK_RECORD || type->kind == TK_ARRAY ||
  614. X        type->kind == TK_SET)
  615. X        val.i = (long)makeexpr_un(EK_STRUCTCONST, type, makeexpr_long(0));
  616. X    else
  617. X        val.i = 0;
  618. X    val.s = NULL;
  619. X    return makeexpr_val(val);
  620. X    }
  621. X    switch (type->kind) {
  622. X    
  623. X      case TK_RECORD:
  624. X    if (curtok == (style ? TOK_LPAR : TOK_LBR))
  625. X        return p_constrecord(type, style);
  626. X    break;
  627. X    
  628. X      case TK_SMALLARRAY:
  629. X      case TK_ARRAY:
  630. X    if (curtok == (style ? TOK_LPAR : TOK_LBR))
  631. X        return p_constarray(type, style);
  632. X    break;
  633. X    
  634. X      case TK_SMALLSET:
  635. X      case TK_SET:
  636. X    if (curtok == TOK_LBR)
  637. X        return p_setfactor(type);
  638. X    break;
  639. X    
  640. X      default:
  641. X    break;
  642. X    
  643. X    }
  644. X    return gentle_cast(p_expr(type), type);
  645. X}
  646. X
  647. X
  648. X
  649. Xvoid p_constdecl()
  650. X{
  651. X    Meaning *mp;
  652. X    Expr *ex, *ex2;
  653. X    Type *oldtype;
  654. X    char savetokcase[sizeof(curtokcase)];
  655. X    Symbol *savetoksym;
  656. X    Strlist *sl;
  657. X    int i, saveindent, outflag = (blockkind != TOK_IMPORT);
  658. X
  659. X    if (outflag)
  660. X        outsection(majorspace);
  661. X    flushcomments(NULL, -1, -1);
  662. X    gettok();
  663. X    oldtype = NULL;
  664. X    while (curtok == TOK_IDENT) {
  665. X        strcpy(savetokcase, curtokcase);
  666. X        savetoksym = curtoksym;
  667. X        gettok();
  668. X        strcpy(curtokcase, savetokcase);   /* what a kludge! */
  669. X        curtoksym = savetoksym;
  670. X        if (curtok == TOK_COLON) {     /* Turbo Pascal typed constant */
  671. X            mp = addmeaning(curtoksym, MK_VAR);
  672. X        decl_comments(mp);
  673. X            gettok();
  674. X            mp->type = p_type(mp);
  675. X            if (wneedtok(TOK_EQ)) {
  676. X        if (mp->kind == MK_VARMAC) {
  677. X            freeexpr(p_subconst(mp->type, 1));
  678. X            note("Initializer ignored for variable with VarMacro [115]");
  679. X        } else {
  680. X            mp->constdefn = p_subconst(mp->type, 1);
  681. X            if (blockkind == TOK_EXPORT) {
  682. X            /*  nothing  */
  683. X            } else {
  684. X            mp->isforward = 1;   /* static variable */
  685. X            }
  686. X        }
  687. X        }
  688. X        decl_comments(mp);
  689. X        } else {
  690. X            sl = strlist_find(constmacros, curtoksym->name);
  691. X            if (sl) {
  692. X                mp = addmeaning(curtoksym, MK_VARMAC);
  693. X                mp->constdefn = (Expr *)sl->value;
  694. X                strlist_delete(&constmacros, sl);
  695. X            } else {
  696. X                mp = addmeaning(curtoksym, MK_CONST);
  697. X            }
  698. X        decl_comments(mp);
  699. X            if (!wexpecttok(TOK_EQ)) {
  700. X        skippasttoken(TOK_SEMI);
  701. X        continue;
  702. X        }
  703. X        mp->isactive = 0;   /* A fine point indeed (see below) */
  704. X        gettok();
  705. X        if (curtok == TOK_IDENT &&
  706. X        curtokmeaning && curtokmeaning->kind == MK_TYPE &&
  707. X        (curtokmeaning->type->kind == TK_RECORD ||
  708. X         curtokmeaning->type->kind == TK_SMALLARRAY ||
  709. X         curtokmeaning->type->kind == TK_ARRAY)) {
  710. X        oldtype = curtokmeaning->type;
  711. X        gettok();
  712. X        ex = p_subconst(oldtype, (curtok == TOK_LBR) ? 0 : 2);
  713. X        } else
  714. X        ex = p_expr(NULL);
  715. X        mp->isactive = 1;   /* Re-enable visibility of the new constant */
  716. X            if (mp->kind == MK_CONST)
  717. X                mp->constdefn = ex;
  718. X            if (ord_type(ex->val.type)->kind == TK_INTEGER) {
  719. X                i = exprlongness(ex);
  720. X                if (i > 0)
  721. X                    ex->val.type = tp_integer;
  722. X        else if (i < 0)
  723. X                    ex->val.type = tp_int;
  724. X            }
  725. X        decl_comments(mp);
  726. X            mp->type = ex->val.type;
  727. X            mp->val = eval_expr(ex);
  728. X            if (mp->kind == MK_CONST) {
  729. X                switch (ex->val.type->kind) {
  730. X
  731. X                    case TK_INTEGER:
  732. X                    case TK_BOOLEAN:
  733. X                    case TK_CHAR:
  734. X                    case TK_ENUM:
  735. X                    case TK_SUBR:
  736. X                    case TK_REAL:
  737. X                        if (foldconsts > 0)
  738. X                            mp->anyvarflag = 1;
  739. X                        break;
  740. X
  741. X                    case TK_STRING:
  742. X                        if (foldstrconsts > 0)
  743. X                            mp->anyvarflag = 1;
  744. X                        break;
  745. X
  746. X            default:
  747. X            break;
  748. X                }
  749. X            }
  750. X        flushcomments(&mp->comments, CMT_PRE, -1);
  751. X            if (ex->val.type->kind == TK_SET) {
  752. X                mp->val.type = NULL;
  753. X        if (mp->kind == MK_CONST) {
  754. X            ex2 = makeexpr(EK_MACARG, 0);
  755. X            ex2->val.type = ex->val.type;
  756. X            mp->constdefn = makeexpr_assign(ex2, ex);
  757. X        }
  758. X            } else if (mp->kind == MK_CONST && outflag) {
  759. X                if (ex->val.type != oldtype) {
  760. X                    outsection(minorspace);
  761. X                    oldtype = ex->val.type;
  762. X                }
  763. X                switch (ex->val.type->kind) {
  764. X
  765. X                    case TK_ARRAY:
  766. X                    case TK_RECORD:
  767. X                        select_outfile(codef);
  768. X                        outsection(minorspace);
  769. X                        if (blockkind == TOK_IMPLEMENT || blockkind == TOK_PROGRAM)
  770. X                            output("static ");
  771. X                        if (useAnyptrMacros == 1 || useconsts == 2)
  772. X                            output("Const ");
  773. X                        else if (useconsts > 0)
  774. X                            output("const ");
  775. X                        outbasetype(mp->type, ODECL_CHARSTAR|ODECL_FREEARRAY);
  776. X                        output(" ");
  777. X                        outdeclarator(mp->type, mp->name,
  778. X                      ODECL_CHARSTAR|ODECL_FREEARRAY);
  779. X                        output(" = {");
  780. X            outtrailcomment(mp->comments, -1, declcommentindent);
  781. X            saveindent = outindent;
  782. X            moreindent(tabsize);
  783. X            moreindent(structinitindent);
  784. X                     /*   if (mp->val.s)
  785. X                            output(mp->val.s);
  786. X                        else  */
  787. X                            out_expr((Expr *)mp->val.i);
  788. X                        outindent = saveindent;
  789. X                        output("\n};\n");
  790. X                        outsection(minorspace);
  791. X                        if (blockkind == TOK_EXPORT) {
  792. X                            select_outfile(hdrf);
  793. X                            if (usevextern)
  794. X                                output("vextern ");
  795. X                            if (useAnyptrMacros == 1 || useconsts == 2)
  796. X                                output("Const ");
  797. X                            else if (useconsts > 0)
  798. X                                output("const ");
  799. X                            outbasetype(mp->type, ODECL_CHARSTAR);
  800. X                            output(" ");
  801. X                            outdeclarator(mp->type, mp->name, ODECL_CHARSTAR);
  802. X                            output(";\n");
  803. X                        }
  804. X                        break;
  805. X
  806. X                    default:
  807. X                        if (foldconsts > 0) break;
  808. X                        output(format_s("#define %s", mp->name));
  809. X            mp->isreturn = 1;
  810. X                        out_spaces(constindent, 0, 0, 0);
  811. X            saveindent = outindent;
  812. X            outindent = cur_column();
  813. X                        out_expr_factor(ex);
  814. X            outindent = saveindent;
  815. X            outtrailcomment(mp->comments, -1, declcommentindent);
  816. X                        break;
  817. X
  818. X                }
  819. X            }
  820. X        flushcomments(&mp->comments, -1, -1);
  821. X            if (mp->kind == MK_VARMAC)
  822. X                freeexpr(ex);
  823. X            mp->wasdeclared = 1;
  824. X        }
  825. X        if (!wneedtok(TOK_SEMI))
  826. X        skippasttoken(TOK_SEMI);
  827. X    }
  828. X    if (outflag)
  829. X        outsection(majorspace);
  830. X}
  831. X
  832. X
  833. X
  834. X
  835. Xvoid declaresubtypes(mp)
  836. XMeaning *mp;
  837. X{
  838. X    Meaning *mp2;
  839. X    Type *tp;
  840. X    struct ptrdesc *pd;
  841. X
  842. X    while (mp) {
  843. X    if (mp->kind == MK_VARIANT) {
  844. X        declaresubtypes(mp->ctx);
  845. X    } else {
  846. X        tp = mp->type;
  847. X        while (tp->basetype && !tp->meaning && tp->kind != TK_POINTER)
  848. X        tp = tp->basetype;
  849. X        if (tp->meaning && !tp->meaning->wasdeclared &&
  850. X        (tp->kind == TK_RECORD || tp->kind == TK_ENUM) &&
  851. X        tp->meaning->ctx && tp->meaning->ctx != nullctx) {
  852. X        pd = ptrbase;   /* Do this now, just in case */
  853. X        while (pd) {
  854. X            if (pd->tp->basetype == tp_abyte) {
  855. X            mp2 = pd->sym->mbase;
  856. X            while (mp2 && !mp2->isactive)
  857. X                mp2 = mp2->snext;
  858. X            if (mp2 && mp2->kind == MK_TYPE) {
  859. X                pd->tp->basetype = mp2->type;
  860. X                if (!mp2->type->pointertype)
  861. X                mp2->type->pointertype = pd->tp;
  862. X            }
  863. X            }
  864. X            pd = pd->next;
  865. X        }
  866. X        declaretype(tp->meaning);
  867. X        }
  868. X    }
  869. X    mp = mp->cnext;
  870. X    }
  871. X}
  872. X
  873. X
  874. Xvoid declaretype(mp)
  875. XMeaning *mp;
  876. X{
  877. X    int saveindent;
  878. X
  879. X    switch (mp->type->kind) {
  880. X    
  881. X      case TK_RECORD:
  882. X    if (mp->type->meaning != mp) {
  883. X        output(format_ss("typedef %s %s;",
  884. X                 mp->type->meaning->name,
  885. X                 mp->name));
  886. X    } else {
  887. X        declaresubtypes(mp->type->fbase);
  888. X        outsection(minorspace);
  889. X        if (record_is_union(mp->type))
  890. X        output("typedef union ");
  891. X        else
  892. X        output("typedef struct ");
  893. X        output(format_s("%s {\n", format_s(name_STRUCT, mp->name)));
  894. X        saveindent = outindent;
  895. X        moreindent(tabsize);
  896. X        moreindent(structindent);
  897. X        outfieldlist(mp->type->fbase);
  898. X        outindent = saveindent;
  899. X        output(format_s("} %s;", mp->name));
  900. X    }
  901. X    outtrailcomment(mp->comments, -1, declcommentindent);
  902. X    mp->type->structdefd = 1;
  903. X    if (mp->type->meaning == mp)
  904. X        outsection(minorspace);
  905. X    break;
  906. X    
  907. X      case TK_ARRAY:
  908. X      case TK_SMALLARRAY:
  909. X    output("typedef ");
  910. X    if (mp->type->meaning != mp) {
  911. X        output(format_ss("%s %s",
  912. X                 mp->type->meaning->name,
  913. X                 mp->name));
  914. X    } else {
  915. X        outbasetype(mp->type, 0);
  916. X        output(" ");
  917. X        outdeclarator(mp->type, mp->name, 0);
  918. X    }
  919. X    output(";");
  920. X    outtrailcomment(mp->comments, -1, declcommentindent);
  921. X    break;
  922. X    
  923. X      case TK_ENUM:
  924. X    if (useenum) {
  925. X        output("typedef ");
  926. X        if (mp->type->meaning != mp)
  927. X        output(mp->type->meaning->name);
  928. X        else
  929. X        outbasetype(mp->type, 0);
  930. X        output(" ");
  931. X        output(mp->name);
  932. X        output(";");
  933. X        outtrailcomment(mp->comments, -1,
  934. X                declcommentindent);
  935. X    }
  936. X    break;
  937. X    
  938. X      default:
  939. X    break;
  940. X    }
  941. X    mp->wasdeclared = 1;
  942. X}
  943. X
  944. X
  945. X
  946. Xvoid declaretypes(outflag)
  947. Xint outflag;
  948. X{
  949. X    Meaning *mp;
  950. X
  951. X    for (mp = curctx->cbase; mp; mp = mp->cnext) {
  952. X        if (mp->kind == MK_TYPE && !mp->wasdeclared) {
  953. X            if (outflag) {
  954. X        flushcomments(&mp->comments, CMT_PRE, -1);
  955. X        declaretype(mp);
  956. X        flushcomments(&mp->comments, -1, -1);
  957. X            }
  958. X            mp->wasdeclared = 1;
  959. X        }
  960. X    }
  961. X}
  962. X
  963. X
  964. X
  965. Xvoid p_typedecl()
  966. X{
  967. X    Meaning *mp;
  968. X    int outflag = (blockkind != TOK_IMPORT);
  969. X    struct ptrdesc *pd;
  970. X
  971. X    if (outflag)
  972. X        outsection(majorspace);
  973. X    flushcomments(NULL, -1, -1);
  974. X    gettok();
  975. X    outsection(minorspace);
  976. X    deferallptrs = 1;
  977. X    anydeferredptrs = 0;
  978. X    notephase = 1;
  979. X    while (curtok == TOK_IDENT) {
  980. X        mp = addmeaning(curtoksym, MK_TYPE);
  981. X    mp->type = tp_integer;    /* in case of syntax errors */
  982. X        gettok();
  983. X    decl_comments(mp);
  984. X    if (curtok == TOK_SEMI) {
  985. X        mp->type = tp_anyptr;    /* Modula-2 opaque type */
  986. X    } else {
  987. X        if (!wneedtok(TOK_EQ)) {
  988. X        skippasttoken(TOK_SEMI);
  989. X        continue;
  990. X        }
  991. X        mp->type = p_type(mp);
  992. X        decl_comments(mp);
  993. X        if (!mp->type->meaning)
  994. X        mp->type->meaning = mp;
  995. X        if (mp->type->kind == TK_RECORD)
  996. X        mp->type->structdefd = 1;
  997. X        if (!anydeferredptrs)
  998. X        declaretypes(outflag);
  999. X    }
  1000. X    if (!wneedtok(TOK_SEMI))
  1001. X        skippasttoken(TOK_SEMI);
  1002. X    }
  1003. X    notephase = 0;
  1004. X    deferallptrs = 0;
  1005. X    while (ptrbase) {
  1006. X        pd = ptrbase;
  1007. X    if (pd->tp->basetype == tp_abyte) {
  1008. X        mp = pd->sym->mbase;
  1009. X        while (mp && !mp->isactive)
  1010. X        mp = mp->snext;
  1011. X        if (!mp || mp->kind != MK_TYPE) {
  1012. X        warning(format_s("Unsatisfied forward reference to type %s [138]", pd->sym->name));
  1013. X        } else {
  1014. X        pd->tp->basetype = mp->type;
  1015. X        if (!mp->type->pointertype)
  1016. X            mp->type->pointertype = pd->tp;
  1017. X        }
  1018. X        }
  1019. X        ptrbase = ptrbase->next;
  1020. X        FREE(pd);
  1021. X    }
  1022. X    declaretypes(outflag);
  1023. X    outsection(minorspace);
  1024. X    flushcomments(NULL, -1, -1);
  1025. X    if (outflag)
  1026. X        outsection(majorspace);
  1027. X}
  1028. X
  1029. X
  1030. X
  1031. X
  1032. X
  1033. XStatic void nameexternalvar(mp, name)
  1034. XMeaning *mp;
  1035. Xchar *name;
  1036. X{
  1037. X    if (!wasaliased) {
  1038. X    if (*externalias && my_strchr(externalias, '%'))
  1039. X        strchange(&mp->name, format_s(externalias, name));
  1040. X    else
  1041. X        strchange(&mp->name, name);
  1042. X    }
  1043. X}
  1044. X
  1045. X
  1046. XStatic void handlebrackets(mp, skip, wasaliased)
  1047. XMeaning *mp;
  1048. Xint skip, wasaliased;
  1049. X{
  1050. X    Expr *ex;
  1051. X
  1052. X    checkkeyword(TOK_ORIGIN);
  1053. X    if (curtok == TOK_ORIGIN) {
  1054. X    gettok();
  1055. X    ex = p_expr(tp_integer);
  1056. X    mp->kind = MK_VARREF;
  1057. X    mp->constdefn = gentle_cast(ex, tp_integer);
  1058. X    } else if (curtok == TOK_LBR) {
  1059. X        gettok();
  1060. X        ex = p_expr(tp_integer);
  1061. X        if (!wneedtok(TOK_RBR))
  1062. X        skippasttotoken(TOK_RBR, TOK_SEMI);
  1063. X        if (skip) {
  1064. X            freeexpr(ex);
  1065. X            return;
  1066. X        }
  1067. X        if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
  1068. X        nameexternalvar(mp, ex->val.s);
  1069. X        mp->isfunction = 1;   /* make it extern */
  1070. X        } else {
  1071. X            note(format_s("Absolute-addressed variable %s was generated [116]", mp->name));
  1072. X            mp->kind = MK_VARREF;
  1073. X            mp->constdefn = gentle_cast(ex, tp_integer);
  1074. X        }
  1075. X    }
  1076. X}
  1077. X
  1078. X
  1079. X
  1080. XStatic void handleabsolute(mp, skip)
  1081. XMeaning *mp;
  1082. Xint skip;
  1083. X{
  1084. X    Expr *ex;
  1085. X    Value val;
  1086. X    long i;
  1087. X
  1088. X    checkkeyword(TOK_ABSOLUTE);
  1089. X    if (curtok == TOK_ABSOLUTE) {
  1090. X        gettok();
  1091. X        if (skip) {
  1092. X            freeexpr(p_expr(tp_integer));
  1093. X            if (curtok == TOK_COLON) {
  1094. X                gettok();
  1095. X                freeexpr(p_expr(tp_integer));
  1096. X            }
  1097. X            return;
  1098. X        }
  1099. X        note(format_s("Absolute-addressed variable %s was generated [116]", mp->name));
  1100. X        mp->kind = MK_VARREF;
  1101. X        if (curtok == TOK_IDENT && 
  1102. X            curtokmeaning && (curtokmeaning->kind != MK_CONST ||
  1103. X                              ord_type(curtokmeaning->type)->kind != TK_INTEGER)) {
  1104. X            mp->constdefn = makeexpr_addr(p_expr(NULL));
  1105. X        mp->isfunction = 1;   /* make it extern */
  1106. X        } else {
  1107. X            ex = gentle_cast(p_expr(tp_integer), tp_integer);
  1108. X            if (curtok == TOK_COLON) {
  1109. X                val = eval_expr(ex);
  1110. X                if (!val.type)
  1111. X                    warning("Expected a constant [127]");
  1112. X                i = val.i & 0xffff;
  1113. X                gettok();
  1114. X                val = p_constant(tp_integer);
  1115. X                i = (i<<16) | (val.i & 0xffff);   /* as good a notation as any! */
  1116. X                ex = makeexpr_long(i);
  1117. X                insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
  1118. X            }
  1119. X            mp->constdefn = ex;
  1120. X        }
  1121. X    }
  1122. X}
  1123. X
  1124. X
  1125. X
  1126. Xvoid setupfilevar(mp)
  1127. XMeaning *mp;
  1128. X{
  1129. X    if (mp->kind != MK_VARMAC && isfiletype(mp->type)) {
  1130. X    if (storefilenames && *name_FNVAR)
  1131. X        mp->namedfile = 1;
  1132. X    if (checkvarinlists(bufferedfiles, unbufferedfiles, 0, mp))
  1133. X        mp->bufferedfile = 1;
  1134. X    }
  1135. X}
  1136. X
  1137. X
  1138. X
  1139. X
  1140. Xvoid p_vardecl()
  1141. X{
  1142. X    Meaning *firstmp, *lastmp;
  1143. X    Type *tp;
  1144. X    int aliasflag, volatileflag, constflag, staticflag, globalflag, externflag;
  1145. X    Strlist *l1;
  1146. X    Expr *initexpr;
  1147. X
  1148. X    gettok();
  1149. X    notephase = 1;
  1150. X    while (curtok == TOK_IDENT) {
  1151. X        firstmp = lastmp = addmeaning(curtoksym, MK_VAR);
  1152. X    lastmp->type = tp_integer;    /* in case of syntax errors */
  1153. X        aliasflag = wasaliased;
  1154. X        gettok();
  1155. X        handlebrackets(lastmp, (lastmp->kind != MK_VAR), aliasflag);
  1156. X    decl_comments(lastmp);
  1157. X        while (curtok == TOK_COMMA) {
  1158. X            gettok();
  1159. X            if (wexpecttok(TOK_IDENT)) {
  1160. X        lastmp = addmeaning(curtoksym, MK_VAR);
  1161. X        lastmp->type = tp_integer;
  1162. X        aliasflag = wasaliased;
  1163. X        gettok();
  1164. X        handlebrackets(lastmp, (lastmp->kind != MK_VAR), aliasflag);
  1165. X        decl_comments(lastmp);
  1166. X        }
  1167. X        }
  1168. X        if (!wneedtok(TOK_COLON)) {
  1169. X        skippasttoken(TOK_SEMI);
  1170. X        continue;
  1171. X    }
  1172. X    p_attributes();
  1173. X    volatileflag = constflag = staticflag = globalflag = externflag = 0;
  1174. X    if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
  1175. X        constflag = 1;
  1176. X        strlist_delete(&attrlist, l1);
  1177. X    }
  1178. X    if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
  1179. X        volatileflag = 1;
  1180. X        strlist_delete(&attrlist, l1);
  1181. X    }
  1182. X    if ((l1 = strlist_find(attrlist, "STATIC")) != NULL) {
  1183. X        staticflag = 1;
  1184. X        strlist_delete(&attrlist, l1);
  1185. X    }
  1186. X    if ((l1 = strlist_find(attrlist, "AUTOMATIC")) != NULL) {
  1187. X        /* This is the default! */
  1188. X        strlist_delete(&attrlist, l1);
  1189. X    }
  1190. X    if ((l1 = strlist_find(attrlist, "AT")) != NULL) {
  1191. X            note(format_s("Absolute-addressed variable %s was generated [116]", lastmp->name));
  1192. X            lastmp->kind = MK_VARREF;
  1193. X            lastmp->constdefn = makeexpr_long(l1->value);
  1194. X        strlist_delete(&attrlist, l1);
  1195. X    }
  1196. X    if ((l1 = strlist_find(attrlist, "GLOBAL")) != NULL ||
  1197. X        (l1 = strlist_find(attrlist, "WEAK_GLOBAL")) != NULL) {
  1198. X        globalflag = 1;
  1199. X        if (l1->value != -1)
  1200. X        nameexternalvar(lastmp, (char *)l1->value);
  1201. X        if (l1->s[0] != 'W')
  1202. X        strlist_delete(&attrlist, l1);
  1203. X    }
  1204. X    if ((l1 = strlist_find(attrlist, "EXTERNAL")) != NULL ||
  1205. X        (l1 = strlist_find(attrlist, "WEAK_EXTERNAL")) != NULL) {
  1206. X        externflag = 1;
  1207. X        if (l1->value != -1)
  1208. X        nameexternalvar(lastmp, (char *)l1->value);
  1209. X        if (l1->s[0] != 'W')
  1210. X        strlist_delete(&attrlist, l1);
  1211. X    }
  1212. X        tp = p_type(firstmp);
  1213. X    decl_comments(lastmp);
  1214. X        handleabsolute(lastmp, (lastmp->kind != MK_VAR));
  1215. X    initexpr = NULL;
  1216. X    if (curtok == TOK_ASSIGN) {    /* VAX Pascal initializer */
  1217. X        gettok();
  1218. X        initexpr = p_subconst(tp, 2);
  1219. X        if (lastmp->kind == MK_VARMAC) {
  1220. X        freeexpr(initexpr);
  1221. X        initexpr = NULL;
  1222. X        note("Initializer ignored for variable with VarMacro [115]");
  1223. X        }
  1224. X    }
  1225. X        for (;;) {
  1226. X            if (firstmp->kind == MK_VARREF) {
  1227. X                firstmp->type = makepointertype(tp);
  1228. X                firstmp->constdefn = makeexpr_cast(firstmp->constdefn, firstmp->type);
  1229. X            } else {
  1230. X                firstmp->type = tp;
  1231. X        setupfilevar(firstmp);
  1232. X        if (initexpr) {
  1233. X            if (firstmp == lastmp)
  1234. X            firstmp->constdefn = initexpr;
  1235. X            else
  1236. X            firstmp->constdefn = copyexpr(initexpr);
  1237. X        }
  1238. X            }
  1239. X        firstmp->volatilequal = volatileflag;
  1240. X        firstmp->constqual = constflag;
  1241. X        firstmp->isforward |= staticflag;
  1242. X        firstmp->isfunction |= externflag;
  1243. X        firstmp->exported |= globalflag;
  1244. X        if (globalflag && (curctx->kind != MK_MODULE || mainlocals))
  1245. X        declarevar(firstmp, -1);
  1246. X            if (firstmp == lastmp)
  1247. X                break;
  1248. X            firstmp = firstmp->cnext;
  1249. X        }
  1250. X        if (!wneedtok(TOK_SEMI))
  1251. X        skippasttoken(TOK_SEMI);
  1252. X    }
  1253. X    notephase = 0;
  1254. X}
  1255. X
  1256. X
  1257. X
  1258. X
  1259. Xvoid p_valuedecl()
  1260. X{
  1261. X    Meaning *mp;
  1262. X
  1263. X    gettok();
  1264. X    while (curtok == TOK_IDENT) {
  1265. X    if (!curtokmeaning ||
  1266. X        curtokmeaning->kind != MK_VAR) {
  1267. X        warning(format_s("Initializer ignored for variable %s [139]",
  1268. X                 curtokmeaning->name));
  1269. X        skippasttoken(TOK_SEMI);
  1270. X    } else {
  1271. X        mp = curtokmeaning;
  1272. X        gettok();
  1273. X        if (curtok == TOK_DOT || curtok == TOK_LBR) {
  1274. X        note("Partial structure initialization not supported [117]");
  1275. X        skippasttoken(TOK_SEMI);
  1276. X        } else if (wneedtok(TOK_ASSIGN)) {
  1277. X        mp->constdefn = p_subconst(mp->type, 2);
  1278. X        if (!wneedtok(TOK_SEMI))
  1279. X            skippasttoken(TOK_SEMI);
  1280. X        } else
  1281. X        skippasttoken(TOK_SEMI);
  1282. X    }
  1283. X    }
  1284. X}
  1285. X
  1286. X
  1287. X
  1288. X
  1289. X
  1290. X
  1291. X
  1292. X/* Make a temporary variable that must be freed manually (or at the end of
  1293. X   the current function by default) */
  1294. X
  1295. XMeaning *maketempvar(type, name)
  1296. XType *type;
  1297. Xchar *name;
  1298. X{
  1299. X    struct tempvarlist *tv, **tvp;
  1300. X    Symbol *sym;
  1301. X    Meaning *mp;
  1302. X    char *fullname;
  1303. X
  1304. X    tvp = &tempvars;   /* find a freed but allocated temporary */
  1305. X    while ((tv = *tvp) && (!similartypes(tv->tvar->type, type) ||
  1306. X                           tv->tvar->refcount == 0 ||
  1307. X                           strcmp(tv->tvar->val.s, name)))
  1308. X        tvp = &(tv->next);
  1309. X    if (!tv) {
  1310. X        tvp = &tempvars;    /* take over a now-cancelled temporary */
  1311. X        while ((tv = *tvp) && (tv->tvar->refcount > 0 || 
  1312. X                               strcmp(tv->tvar->val.s, name)))
  1313. X            tvp = &(tv->next);
  1314. X    }
  1315. X    if (tv) {
  1316. X        tv->tvar->type = type;
  1317. X        *tvp = tv->next;
  1318. X        mp = tv->tvar;
  1319. X        FREE(tv);
  1320. X        mp->refcount++;
  1321. X        if (debug>1) { fprintf(outf,"maketempvar revives %s\n", mp->name); }
  1322. X    } else {
  1323. X        tempvarcount = 0;    /***/  /* experimental... */
  1324. X        for (;;) {
  1325. X            if (tempvarcount)
  1326. X                fullname = format_s(name, format_d("%d", tempvarcount));
  1327. X            else
  1328. X                fullname = format_s(name, "");
  1329. X            ++tempvarcount;
  1330. X            sym = findsymbol(fullname);
  1331. X            mp = sym->mbase;
  1332. X            while (mp && !mp->isactive)
  1333. X                mp = mp->snext;
  1334. X            if (!mp)
  1335. X                break;
  1336. X            if (debug>1) { fprintf(outf,"maketempvar rejects %s\n", fullname); }
  1337. X        }
  1338. X    mp = addmeaning(sym, MK_VAR);
  1339. X        mp->istemporary = 1;
  1340. X        mp->type = type;
  1341. X        mp->refcount = 1;
  1342. X        mp->val.s = stralloc(name);
  1343. X        if (debug>1) { fprintf(outf,"maketempvar creates %s\n", mp->name); }
  1344. X    }
  1345. X    return mp;
  1346. X}
  1347. X
  1348. X
  1349. X
  1350. X/* Make a temporary variable that will be freed at the end of this statement
  1351. X   (rather than at the end of the function) by default */
  1352. X
  1353. XMeaning *makestmttempvar(type, name)
  1354. XType *type;
  1355. Xchar *name;
  1356. X{
  1357. X    struct tempvarlist *tv;
  1358. X    Meaning *tvar;
  1359. X
  1360. X    tvar = maketempvar(type, name);
  1361. X    tv = ALLOC(1, struct tempvarlist, tempvars);
  1362. X    tv->tvar = tvar;
  1363. X    tv->active = 1;
  1364. X    tv->next = stmttempvars;
  1365. X    stmttempvars = tv;
  1366. X    return tvar;
  1367. X}
  1368. X
  1369. X
  1370. X
  1371. XMeaning *markstmttemps()
  1372. X{
  1373. X    return (stmttempvars) ? stmttempvars->tvar : NULL;
  1374. X}
  1375. X
  1376. X
  1377. Xvoid freestmttemps(mark)
  1378. XMeaning *mark;
  1379. X{
  1380. X    struct tempvarlist *tv;
  1381. X
  1382. X    while ((tv = stmttempvars) && tv->tvar != mark) {
  1383. X        if (tv->active)
  1384. X            freetempvar(tv->tvar);
  1385. X        stmttempvars = tv->next;
  1386. X        FREE(tv);
  1387. X    }
  1388. X}
  1389. X
  1390. X
  1391. X
  1392. X/* This temporary variable is no longer used */
  1393. X
  1394. Xvoid freetempvar(tvar)
  1395. XMeaning *tvar;
  1396. X{
  1397. X    struct tempvarlist *tv;
  1398. X
  1399. X    if (debug>1) { fprintf(outf,"freetempvar frees %s\n", tvar->name); }
  1400. X    tv = stmttempvars;
  1401. X    while (tv && tv->tvar != tvar)
  1402. X        tv = tv->next;
  1403. X    if (tv)
  1404. X        tv->active = 0;
  1405. X    tv = ALLOC(1, struct tempvarlist, tempvars);
  1406. X    tv->tvar = tvar;
  1407. X    tv->next = tempvars;
  1408. X    tempvars = tv;
  1409. X}
  1410. X
  1411. X
  1412. X
  1413. X/* The code that used this temporary variable has been deleted */
  1414. X
  1415. Xvoid canceltempvar(tvar)
  1416. XMeaning *tvar;
  1417. X{
  1418. X    if (debug>1) { fprintf(outf,"canceltempvar cancels %s\n", tvar->name); }
  1419. X    tvar->refcount--;
  1420. X    freetempvar(tvar);
  1421. X}
  1422. X
  1423. X
  1424. X
  1425. X
  1426. X
  1427. X
  1428. X
  1429. X
  1430. X/* End. */
  1431. X
  1432. X
  1433. END_OF_FILE
  1434. if test 38042 -ne `wc -c <'src/decl.c.3'`; then
  1435.     echo shar: \"'src/decl.c.3'\" unpacked with wrong size!
  1436. fi
  1437. # end of 'src/decl.c.3'
  1438. fi
  1439. echo shar: End of archive 14 \(of 32\).
  1440. cp /dev/null ark14isdone
  1441. MISSING=""
  1442. for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 ; do
  1443.     if test ! -f ark${I}isdone ; then
  1444.     MISSING="${MISSING} ${I}"
  1445.     fi
  1446. done
  1447. if test "${MISSING}" = "" ; then
  1448.     echo You have unpacked all 32 archives.
  1449.     echo "Now see PACKNOTES and the README"
  1450.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  1451. else
  1452.     echo You still need to unpack the following archives:
  1453.     echo "        " ${MISSING}
  1454. fi
  1455. ##  End of shell archive.
  1456. exit 0
  1457.