home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume21 / p2c / part27 < prev    next >
Text File  |  1990-04-05  |  53KB  |  1,926 lines
  1. Subject:  v21i072:  Pascal to C translator, Part27/32
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4. X-Checksum-Snefru: 4ea6754b 000f0649 c85b054a 545aa469
  5.  
  6. Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
  7. Posting-number: Volume 21, Issue 72
  8. Archive-name: p2c/part27
  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 27 (of 32)."
  17. # Contents:  src/decl.c.2
  18. # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:50 1990
  19. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  20. if test -f 'src/decl.c.2' -a "${1}" != "-c" ; then 
  21.   echo shar: Will not clobber existing file \"'src/decl.c.2'\"
  22. else
  23. echo shar: Extracting \"'src/decl.c.2'\" \(49154 characters\)
  24. sed "s/^X//" >'src/decl.c.2' <<'END_OF_FILE'
  25. X            return 0;
  26. X    }
  27. X    if (args) {
  28. X        if (mp1->kind == MK_PARAM && mp1->othername)
  29. X            tp1 = mp1->rectype;
  30. X        if (mp2->kind == MK_PARAM && mp2->othername)
  31. X            tp2 = mp2->rectype;
  32. X    }
  33. X    if (tp1 == tp2)
  34. X        return 1;
  35. X    switch (mixtypes) {
  36. X        case 0:
  37. X            return 0;
  38. X        case 1:
  39. X            return (findbasetype(tp1, flags) == findbasetype(tp2, flags));
  40. X        default:
  41. X            if (findbasetype(tp1, flags) != findbasetype(tp2, flags))
  42. X        return 0;
  43. X            while (tp1->kind == TK_POINTER && tp1->basetype)
  44. X                tp1 = tp1->basetype;
  45. X            while (tp2->kind == TK_POINTER && tp2->basetype)
  46. X                tp2 = tp2->basetype;
  47. X            return (tp1 == tp2);
  48. X    }
  49. X}
  50. X
  51. X
  52. X
  53. Xvoid declarefiles(fnames)
  54. XStrlist *fnames;
  55. X{
  56. X    Meaning *mp;
  57. X    char *cp;
  58. X
  59. X    while (fnames) {
  60. X    mp = (Meaning *)fnames->value;
  61. X    if (mp->kind == MK_VAR || mp->kind == MK_FIELD) {
  62. X        if (mp->namedfile) {
  63. X        output(storageclassname(varstorageclass(mp)));
  64. X        output(format_ss("%s %s", charname,
  65. X                 format_s(name_FNVAR, fnames->s)));
  66. X        output(format_s("[%s];\n", *name_FNSIZE ? name_FNSIZE : "80"));
  67. X        }
  68. X        if (mp->bufferedfile && *declbufname) {
  69. X        cp = format_s("%s", storageclassname(varstorageclass(mp)));
  70. X        if (*cp && isspace(cp[strlen(cp)-1]))
  71. X          cp[strlen(cp)-1] = 0;
  72. X        if (*cp || !*declbufncname) {
  73. X            output(declbufname);
  74. X            output("(");
  75. X            output(fnames->s);
  76. X            output(",");
  77. X            output(cp);
  78. X        } else {
  79. X            output(declbufncname);
  80. X            output("(");
  81. X            output(fnames->s);
  82. X        }
  83. X        output(",");
  84. X        out_type(mp->type->basetype->basetype, 1);
  85. X        output(");\n");
  86. X        }
  87. X    }
  88. X    strlist_eat(&fnames);
  89. X    }
  90. X}
  91. X
  92. X
  93. X
  94. Xchar *variantfieldname(num)
  95. Xint num;
  96. X{
  97. X    if (num >= 0)
  98. X        return format_d("U%d", num);
  99. X    else
  100. X        return format_d("UM%d", -num);
  101. X}
  102. X
  103. X
  104. Xint record_is_union(tp)
  105. XType *tp;
  106. X{
  107. X    return (tp->fbase && tp->fbase->kind == MK_VARIANT);
  108. X}
  109. X
  110. X
  111. Xvoid outfieldlist(mp)
  112. XMeaning *mp;
  113. X{
  114. X    Meaning *mp0;
  115. X    int num, only_union, empty, saveindent, saveindent2;
  116. X    Strlist *fnames, *fn;
  117. X
  118. X    if (!mp) {
  119. X    output("int empty_struct;   /* Pascal record was empty */\n");
  120. X    return;
  121. X    }
  122. X    only_union = (mp && mp->kind == MK_VARIANT);
  123. X    fnames = NULL;
  124. X    while (mp && mp->kind == MK_FIELD) {
  125. X    flushcomments(&mp->comments, CMT_PRE, -1);
  126. X    output(storageclassname(varstorageclass(mp) & 0x10));
  127. X        outbasetype(mp->type, 0);
  128. X        output(" \005");
  129. X    for (;;) {
  130. X        outdeclarator(mp->type, mp->name, 0);
  131. X        if (mp->val.i && (mp->type != tp_abyte || mp->val.i != 8))
  132. X        output(format_d(" : %d", mp->val.i));
  133. X        if (isfiletype(mp->type)) {
  134. X        fn = strlist_append(&fnames, mp->name);
  135. X        fn->value = (long)mp;
  136. X        }
  137. X        mp->wasdeclared = 1;
  138. X        if (!mp->cnext || mp->cnext->kind != MK_FIELD ||
  139. X        varstorageclass(mp) != varstorageclass(mp->cnext) ||
  140. X        !mixable(mp, mp->cnext, 0, 0))
  141. X        break;
  142. X            mp = mp->cnext;
  143. X            output(",\001 ");
  144. X        }
  145. X        output(";");
  146. X    outtrailcomment(mp->comments, -1, declcommentindent);
  147. X    flushcomments(&mp->comments, -1, -1);
  148. X        mp = mp->cnext;
  149. X    }
  150. X    declarefiles(fnames);
  151. X    if (mp) {
  152. X    saveindent = outindent;
  153. X    empty = 1;
  154. X        if (!only_union) {
  155. X            output("union {\n");
  156. X        moreindent(tabsize);
  157. X        moreindent(structindent);
  158. X        }
  159. X        while (mp) {
  160. X            mp0 = mp->ctx;
  161. X            num = ord_value(mp->val);
  162. X            while (mp && mp->ctx == mp0)
  163. X                mp = mp->cnext;
  164. X            if (mp0) {
  165. X        empty = 0;
  166. X                if (!mp0->cnext && mp0->kind == MK_FIELD) {
  167. X                    outfieldlist(mp0);
  168. X                } else {
  169. X                    if (mp0->kind == MK_VARIANT)
  170. X                        output("union {\n");
  171. X                    else
  172. X                        output("struct {\n");
  173. X            saveindent2 = outindent;
  174. X            moreindent(tabsize);
  175. X            moreindent(structindent);
  176. X                    outfieldlist(mp0);
  177. X            outindent = saveindent2;
  178. X                    output("} ");
  179. X                    output(format_s(name_VARIANT, variantfieldname(num)));
  180. X                    output(";\n");
  181. X                }
  182. X        flushcomments(&mp0->comments, -1, -1);
  183. X            }
  184. X        }
  185. X    if (empty)
  186. X        output("int empty_union;   /* Pascal variant record was empty */\n");
  187. X        if (!only_union) {
  188. X            outindent = saveindent;
  189. X            output("} ");
  190. X            output(format_s(name_UNION, ""));
  191. X            output(";\n");
  192. X        }
  193. X    }
  194. X}
  195. X
  196. X
  197. X
  198. Xvoid outbasetype(type, flags)
  199. XType *type;
  200. Xint flags;
  201. X{
  202. X    Meaning *mp;
  203. X    int saveindent;
  204. X
  205. X    type = findbasetype(type, flags);
  206. X    switch (type->kind) {
  207. X
  208. X        case TK_INTEGER:
  209. X            if (type == tp_uint) {
  210. X                output("unsigned");
  211. X            } else if (type == tp_sint) {
  212. X                if (useAnyptrMacros == 1)
  213. X                    output("Signed int");
  214. X                else if (hassignedchar)
  215. X                    output("signed int");
  216. X                else
  217. X                    output("int");   /* will sign-extend by hand */
  218. X            } else if (type == tp_unsigned) {
  219. X                output("unsigned long");
  220. X            } else if (type != tp_int)
  221. X                output(integername);
  222. X            else
  223. X                output("int");
  224. X            break;
  225. X
  226. X        case TK_SUBR:
  227. X            if (type == tp_special_anyptr) {
  228. X                output("Anyptr");
  229. X            } else if (type == tp_abyte) {
  230. X                output("char");
  231. X            } else if (type == tp_ubyte) {
  232. X                output(ucharname);
  233. X            } else if (type == tp_sbyte) {
  234. X                output(scharname);
  235. X                if (signedchars != 1 && !hassignedchar)
  236. X                    note("'signed char' may not be valid in all compilers [102]");
  237. X            } else {
  238. X                if (type == tp_ushort)
  239. X                    output("unsigned ");
  240. X                output("short");
  241. X            }
  242. X            break;
  243. X
  244. X        case TK_CHAR:
  245. X            if (type == tp_uchar) {
  246. X                output(ucharname);
  247. X            } else if (type == tp_schar) {
  248. X                output(scharname);
  249. X                if (signedchars != 1 && !hassignedchar)
  250. X                    note("'signed char' may not be valid in all compilers [102]");
  251. X        } else
  252. X        output(charname);
  253. X            break;
  254. X
  255. X        case TK_BOOLEAN:
  256. X            output((*name_BOOLEAN) ? name_BOOLEAN : ucharname);
  257. X            break;
  258. X
  259. X        case TK_REAL:
  260. X        if (type == tp_longreal)
  261. X        output("double");
  262. X        else
  263. X        output("float");
  264. X            break;
  265. X
  266. X        case TK_VOID:
  267. X            if (ansiC == 0)
  268. X                output("int");
  269. X            else if (useAnyptrMacros == 1)
  270. X                output("Void");
  271. X            else
  272. X                output("void");
  273. X            break;
  274. X
  275. X        case TK_PROCPTR:
  276. X        output(name_PROCEDURE);
  277. X        break;
  278. X
  279. X        case TK_FILE:
  280. X            output("FILE");
  281. X            break;
  282. X
  283. X    case TK_SPECIAL:
  284. X        if (type == tp_jmp_buf)
  285. X        output("jmp_buf");
  286. X        break;
  287. X
  288. X        default:
  289. X            if (type->meaning && type->meaning->kind == MK_TYPE &&
  290. X                type->meaning->wasdeclared) {
  291. X                output(type->meaning->name);
  292. X            } else {
  293. X                switch (type->kind) {
  294. X
  295. X                    case TK_ENUM:
  296. X                        output("enum {\n");
  297. X            saveindent = outindent;
  298. X            moreindent(tabsize);
  299. X            moreindent(structindent);
  300. X                        mp = type->fbase;
  301. X                        while (mp) {
  302. X                            output(mp->name);
  303. X                            mp = mp->xnext;
  304. X                            if (mp)
  305. X                output(",\001 ");
  306. X                        }
  307. X                        outindent = saveindent;
  308. X                        output("\n}");
  309. X                        break;
  310. X
  311. X                    case TK_RECORD:
  312. X                        if (record_is_union(type))
  313. X                            output("union ");
  314. X                        else
  315. X                            output("struct ");
  316. X                        if (type->meaning)
  317. X                            output(format_s(name_STRUCT, type->meaning->name));
  318. X            if (!type->structdefd) {
  319. X                if (type->meaning) {
  320. X                type->structdefd = 1;
  321. X                output(" ");
  322. X                }
  323. X                            output("{\n");
  324. X                saveindent = outindent;
  325. X                moreindent(tabsize);
  326. X                moreindent(structindent);
  327. X                            outfieldlist(type->fbase);
  328. X                            outindent = saveindent;
  329. X                            output("}");
  330. X                        }
  331. X            break;
  332. X
  333. X            default:
  334. X            break;
  335. X
  336. X                }
  337. X            }
  338. X            break;
  339. X    }
  340. X}
  341. X
  342. X
  343. X
  344. Xvoid out_type(type, witharrays)
  345. XType *type;
  346. Xint witharrays;
  347. X{
  348. X    if (!witharrays && type->kind == TK_ARRAY)
  349. X        type = makepointertype(type->basetype);
  350. X    outbasetype(type, 0);
  351. X    outdeclarator(type, "", 0);    /* write an "abstract declarator" */
  352. X}
  353. X
  354. X
  355. X
  356. X
  357. Xint varstorageclass(mp)
  358. XMeaning *mp;
  359. X{
  360. X    int sclass;
  361. X
  362. X    if (mp->kind == MK_PARAM || mp->kind == MK_VARPARAM ||
  363. X    mp->kind == MK_FIELD)
  364. X    sclass = 0;
  365. X    else if (blockkind == TOK_EXPORT)
  366. X        if (usevextern)
  367. X        if (mp->constdefn &&
  368. X        (mp->kind == MK_VAR ||
  369. X         mp->kind == MK_VARREF))
  370. X        sclass = 2;    /* extern */
  371. X        else
  372. X        sclass = 1;    /* vextern */
  373. X        else
  374. X            sclass = 0;                         /* (plain) */
  375. X    else if (mp->isfunction && mp->kind != MK_FUNCTION)
  376. X    sclass = 2;   /* extern */
  377. X    else if (mp->ctx->kind == MK_MODULE &&
  378. X         (var_static != 0 ||
  379. X          (findsymbol(mp->name)->flags & NEEDSTATIC)) &&
  380. X         !mp->exported && !mp->istemporary && blockkind != TOK_END)
  381. X        sclass = (useAnyptrMacros) ? 4 : 3;     /* (private) */
  382. X    else if (mp->isforward)
  383. X        sclass = 3;   /* static */
  384. X    else
  385. X    sclass = 0;   /* (plain) */
  386. X    if (mp->volatilequal)
  387. X    sclass |= 0x10;
  388. X    if (mp->constqual)
  389. X    sclass |= 0x20;
  390. X    if (debug>2) fprintf(outf, "varstorageclass(%s) = %d\n", mp->name, sclass);
  391. X    return sclass;
  392. X}
  393. X
  394. X
  395. Xchar *storageclassname(i)
  396. Xint i;
  397. X{
  398. X    char *scname;
  399. X
  400. X    switch (i & 0xf) {
  401. X        case 1:
  402. X            scname = "vextern ";
  403. X        break;
  404. X        case 2:
  405. X            scname = "extern ";
  406. X        break;
  407. X        case 3:
  408. X            scname = "static ";
  409. X        break;
  410. X        case 4:
  411. X            scname = "Static ";
  412. X        break;
  413. X        default:
  414. X            scname = "";
  415. X        break;
  416. X    }
  417. X    if (i & 0x10)
  418. X    if (useAnyptrMacros == 1)
  419. X        scname = format_s("%sVolatile ", scname);
  420. X    else if (ansiC > 0)
  421. X        scname = format_s("%svolatile ", scname);
  422. X    if (i & 0x20)
  423. X    if (useAnyptrMacros == 1)
  424. X        scname = format_s("%sConst ", scname);
  425. X    else if (ansiC > 0)
  426. X        scname = format_s("%sconst ", scname);
  427. X    return scname;
  428. X}
  429. X
  430. X
  431. X
  432. Xvoid declarevar(mp, which)
  433. XMeaning *mp;
  434. Xint which;    /* 0x1=header, 0x2=body, 0x4=trailer, 0x8=in varstruct */
  435. X{
  436. X    int isstatic, isstructconst, saveindent;
  437. X
  438. X    isstructconst = checkstructconst(mp);
  439. X    isstatic = varstorageclass(mp);
  440. X    if (which & 0x8)
  441. X    isstatic &= 0x10;   /* clear all but Volatile flags */
  442. X    flushcomments(&mp->comments, CMT_PRE, -1);
  443. X    if (which & 0x1) {
  444. X        if (isstructconst)
  445. X            outsection(minorspace);
  446. X        output(storageclassname(isstatic));
  447. X        outbasetype(mp->type, 0);
  448. X        output(" \005");
  449. X    }
  450. X    if (which & 0x2) {
  451. X        outdeclarator(mp->type, mp->name, 0);
  452. X        if (mp->constdefn && blockkind != TOK_EXPORT &&
  453. X        (mp->kind == MK_VAR || mp->kind == MK_VARREF)) {
  454. X            if (mp->varstructflag) {    /* move init code into function body */
  455. X                intwarning("declarevar",
  456. X                    format_s("Variable %s initializer not removed [125]", mp->name));
  457. X            } else {
  458. X                output(" = ");
  459. X                if (isstructconst) {
  460. X                    output("{\n");
  461. X            saveindent = outindent;
  462. X            moreindent(tabsize);
  463. X            moreindent(structinitindent);
  464. X                    out_expr((Expr *)mp->constdefn->val.i);
  465. X                    outindent = saveindent;
  466. X                    output("\n}");
  467. X                } else
  468. X                    out_expr(mp->constdefn);
  469. X            }
  470. X        }
  471. X    }
  472. X    if (which & 0x4) {
  473. X        output(";");
  474. X    outtrailcomment(mp->comments, -1, declcommentindent);
  475. X    flushcomments(&mp->comments, -1, -1);
  476. X        if (isstructconst)
  477. X            outsection(minorspace);
  478. X    }
  479. X}
  480. X
  481. X
  482. X
  483. X
  484. XStatic int checkvarmacdef(ex, mp)
  485. XExpr *ex;
  486. XMeaning *mp;
  487. X{
  488. X    int i;
  489. X
  490. X    if ((ex->kind == EK_NAME || ex->kind == EK_BICALL) &&
  491. X    !strcmp(ex->val.s, mp->name)) {
  492. X    ex->kind = EK_VAR;
  493. X    ex->val.i = (long)mp;
  494. X    ex->val.type = mp->type;
  495. X    return 1;
  496. X    }
  497. X    if (ex->kind == EK_VAR && ex->val.i == (long)mp)
  498. X    return 1;
  499. X    i = ex->nargs;
  500. X    while (--i >= 0)
  501. X    if (checkvarmacdef(ex->args[i], mp))
  502. X        return 1;
  503. X    return 0;
  504. X}
  505. X
  506. X
  507. Xint checkvarmac(mp)
  508. XMeaning *mp;
  509. X{
  510. X    if (mp->kind != MK_VARMAC && mp->kind != MK_FUNCTION)
  511. X    return 0;
  512. X    if (!mp->constdefn)
  513. X    return 0;
  514. X    return checkvarmacdef(mp->constdefn, mp);
  515. X}
  516. X
  517. X
  518. X
  519. X#define varkind(k) ((k)==MK_VAR||(k)==MK_VARREF||(k)==MK_PARAM||(k)==MK_VARPARAM)
  520. X
  521. Xint declarevars(ctx, invarstruct)
  522. XMeaning *ctx;
  523. Xint invarstruct;
  524. X{
  525. X    Meaning *mp, *mp0, *mp2;
  526. X    Strlist *fnames, *fn;
  527. X    int flag, first;
  528. X
  529. X    if (ctx->kind == MK_FUNCTION && ctx->varstructflag && !invarstruct) {
  530. X        output("struct ");
  531. X        output(format_s(name_LOC, ctx->name));
  532. X        output(" ");
  533. X        output(format_s(name_VARS, ctx->name));
  534. X        output(";\n");
  535. X        flag = 1;
  536. X    } else
  537. X        flag = 0;
  538. X    if (debug>2) {
  539. X        fprintf(outf,"declarevars:\n");
  540. X        for (mp = ctx->cbase; mp; mp = mp->xnext) {
  541. X            fprintf(outf, "  %-22s%-15s%3d", mp->name,
  542. X                                             meaningkindname(mp->kind),
  543. X                                             mp->refcount);
  544. X            if (mp->wasdeclared)
  545. X                fprintf(outf, " [decl]");
  546. X            if (mp->varstructflag)
  547. X                fprintf(outf, " [struct]");
  548. X            fprintf(outf, "\n");
  549. X        }
  550. X    }
  551. X    fnames = NULL;
  552. X    for (;;) {
  553. X        mp = ctx->cbase;
  554. X        while (mp && (!(varkind(mp->kind) || checkvarmac(mp)) ||
  555. X              mp->wasdeclared || mp->varstructflag != invarstruct ||
  556. X              mp->refcount <= 0))
  557. X            mp = mp->cnext;
  558. X        if (!mp)
  559. X            break;
  560. X        flag = 1;
  561. X        first = 1;
  562. X        mp0 = mp2 = mp;
  563. X        while (mp) {
  564. X            if ((varkind(mp->kind) || checkvarmac(mp)) &&
  565. X        !mp->wasdeclared &&
  566. X                varstorageclass(mp) == varstorageclass(mp0) &&
  567. X                mp->varstructflag == invarstruct && mp->refcount > 0) {
  568. X                if (mixable(mp2, mp, 0, 0) || first) {
  569. X                    if (!first)
  570. X                        output(",\001 ");
  571. X                    declarevar(mp, (first ? 0x3 : 0x2) |
  572. X                       (invarstruct ? 0x8 : 0));
  573. X            mp2 = mp;
  574. X                    mp->wasdeclared = 1;
  575. X                    if (isfiletype(mp->type)) {
  576. X                        fn = strlist_append(&fnames, mp->name);
  577. X                        fn->value = (long)mp;
  578. X                    }
  579. X                    first = 0;
  580. X                } else
  581. X                    if (mixvars != 1)
  582. X                        break;
  583. X            }
  584. X        if (first) {
  585. X        intwarning("declarevars",
  586. X               format_s("Unable to declare %s [126]", mp->name));
  587. X        mp->wasdeclared = 1;
  588. X        first = 0;
  589. X        }
  590. X            if (mixvars == 0)
  591. X                break;
  592. X            mp = mp->cnext;
  593. X        }
  594. X        declarevar(mp2, 0x4);
  595. X    }
  596. X    declarefiles(fnames);
  597. X    return flag;
  598. X}
  599. X
  600. X
  601. X
  602. Xvoid redeclarevars(ctx)
  603. XMeaning *ctx;
  604. X{
  605. X    Meaning *mp;
  606. X
  607. X    for (mp = ctx->cbase; mp; mp = mp->cnext) {
  608. X        if ((mp->kind == MK_VAR || mp->kind == MK_VARREF) &&
  609. X            mp->constdefn) {
  610. X            mp->wasdeclared = 0;    /* mark for redeclaration, this time */
  611. X        }                           /*  with its initializer */
  612. X    }
  613. X}
  614. X
  615. X
  616. X
  617. X
  618. X
  619. Xvoid out_argdecls(ftype)
  620. XType *ftype;
  621. X{
  622. X    Meaning *mp, *mp0;
  623. X    Type *tp;
  624. X    int done;
  625. X    int flag = 1;
  626. X    char *name;
  627. X
  628. X    done = 0;
  629. X    do {
  630. X        mp = ftype->fbase;
  631. X        while (mp && mp->wasdeclared)
  632. X            mp = mp->xnext;
  633. X        if (mp) {
  634. X            if (flag)
  635. X                output("\n");
  636. X            flag = 0;
  637. X            mp0 = mp;
  638. X            outbasetype(mp->othername ? mp->rectype : mp->type,
  639. X            ODECL_CHARSTAR|ODECL_FREEARRAY);
  640. X            output(" \005");
  641. X            while (mp) {
  642. X                if (!mp->wasdeclared) {
  643. X                    if (mp == mp0 ||
  644. X            mixable(mp0, mp, 1, ODECL_CHARSTAR|ODECL_FREEARRAY)) {
  645. X                        if (mp != mp0)
  646. X                            output(",\001 ");
  647. X                        name = (mp->othername) ? mp->othername : mp->name;
  648. X                        tp = (mp->othername) ? mp->rectype : mp->type;
  649. X                        outdeclarator(tp, name,
  650. X                      ODECL_CHARSTAR|ODECL_FREEARRAY);
  651. X                        mp->wasdeclared = 1;
  652. X                    } else
  653. X                        if (mixvars != 1)
  654. X                            break;
  655. X                }
  656. X                mp = mp->xnext;
  657. X            }
  658. X            output(";\n");
  659. X        } else
  660. X            done = 1;
  661. X    } while (!done);
  662. X    for (mp0 = ftype->fbase; mp0 && (mp0->type != tp_strptr ||
  663. X                                     !mp0->anyvarflag); mp0 = mp0->xnext) ;
  664. X    if (mp0) {
  665. X        output("int ");
  666. X        for (mp = mp0; mp; mp = mp->xnext) {
  667. X            if (mp->type == tp_strptr && mp->anyvarflag) {
  668. X                if (mp != mp0) {
  669. X                    if (mixvars == 0)
  670. X                        output(";\nint ");
  671. X                    else
  672. X                        output(",\001 ");
  673. X                }
  674. X                output(format_s(name_STRMAX, mp->name));
  675. X            }
  676. X        }
  677. X        output(";\n");
  678. X    }
  679. X    if (ftype->meaning && ftype->meaning->ctx->kind == MK_FUNCTION &&
  680. X                          ftype->meaning->ctx->varstructflag) {
  681. X        if (flag)
  682. X            output("\n");
  683. X        output("struct ");
  684. X        output(format_s(name_LOC, ftype->meaning->ctx->name));
  685. X        output(" *");
  686. X        output(format_s(name_LINK, ftype->meaning->ctx->name));
  687. X        output(";\n");
  688. X    }
  689. X}
  690. X
  691. X
  692. X
  693. X
  694. Xvoid makevarstruct(func)
  695. XMeaning *func;
  696. X{
  697. X    int flag = 0;
  698. X    int saveindent;
  699. X
  700. X    outsection(minfuncspace);
  701. X    output(format_s("\n/* Local variables for %s: */\n", func->name));
  702. X    output("struct ");
  703. X    output(format_s(name_LOC, func->name));
  704. X    output(" {\n");
  705. X    saveindent = outindent;
  706. X    moreindent(tabsize);
  707. X    moreindent(structindent);
  708. X    if (func->ctx->kind == MK_FUNCTION && func->ctx->varstructflag) {
  709. X        output("struct ");
  710. X        output(format_s(name_LOC, func->ctx->name));
  711. X        output(" *");
  712. X        output(format_s(name_LINK, func->ctx->name));
  713. X        output(";\n");
  714. X        flag++;
  715. X    }
  716. X    flag += declarevars(func, 1);
  717. X    if (!flag)                       /* Avoid generating an empty struct */
  718. X        output("int _meef_;\n");     /* (I don't think this will ever happen) */
  719. X    outindent = saveindent;
  720. X    output("} ;\n");
  721. X    outsection(minfuncspace);
  722. X    strlist_insert(&varstructdecllist, func->name);
  723. X}
  724. X
  725. X
  726. X
  727. X
  728. X
  729. X
  730. XType *maketype(kind)
  731. Xenum typekind kind;
  732. X{
  733. X    Type *tp;
  734. X    tp = ALLOC(1, Type, types);
  735. X    tp->kind = kind;
  736. X    tp->basetype = NULL;
  737. X    tp->indextype = NULL;
  738. X    tp->pointertype = NULL;
  739. X    tp->meaning = NULL;
  740. X    tp->fbase = NULL;
  741. X    tp->smin = NULL;
  742. X    tp->smax = NULL;
  743. X    tp->issigned = 0;
  744. X    tp->dumped = 0;
  745. X    tp->structdefd = 0;
  746. X    return tp;
  747. X}
  748. X
  749. X
  750. X
  751. X
  752. XType *makesubrangetype(type, smin, smax)
  753. XType *type;
  754. XExpr *smin, *smax;
  755. X{
  756. X    Type *tp;
  757. X
  758. X    if (type->kind == TK_SUBR)
  759. X        type = type->basetype;
  760. X    tp = maketype(TK_SUBR);
  761. X    tp->basetype = type;
  762. X    tp->smin = smin;
  763. X    tp->smax = smax;
  764. X    return tp;
  765. X}
  766. X
  767. X
  768. X
  769. XType *makesettype(setof)
  770. XType *setof;
  771. X{
  772. X    Type *tp;
  773. X    long smax;
  774. X
  775. X    if (ord_range(setof, NULL, &smax) && smax < setbits && smallsetconst >= 0)
  776. X        tp = maketype(TK_SMALLSET);
  777. X    else
  778. X        tp = maketype(TK_SET);
  779. X    tp->basetype = tp_integer;
  780. X    tp->indextype = setof;
  781. X    return tp;
  782. X}
  783. X
  784. X
  785. X
  786. XType *makestringtype(len)
  787. Xint len;
  788. X{
  789. X    Type *type;
  790. X    int index;
  791. X
  792. X    len |= 1;
  793. X    if (len >= stringceiling)
  794. X        type = tp_str255;
  795. X    else {
  796. X        index = (len-1) / 2;
  797. X        if (stringtypecache[index])
  798. X            return stringtypecache[index];
  799. X        type = maketype(TK_STRING);
  800. X        type->basetype = tp_char;
  801. X        type->indextype = makesubrangetype(tp_integer, 
  802. X                                           makeexpr_long(0), 
  803. X                                           makeexpr_long(len));
  804. X        stringtypecache[index] = type;
  805. X    }
  806. X    return type;
  807. X}
  808. X
  809. X
  810. X
  811. XType *makepointertype(type)
  812. XType *type;
  813. X{
  814. X    Type *tp;
  815. X
  816. X    if (type->pointertype)
  817. X        return type->pointertype;
  818. X    tp = maketype(TK_POINTER);
  819. X    tp->basetype = type;
  820. X    type->pointertype = tp;
  821. X    return tp;
  822. X}
  823. X
  824. X
  825. X
  826. X
  827. X
  828. XValue p_constant(type)
  829. XType *type;
  830. X{
  831. X    Value val;
  832. X    Expr *ex;
  833. X
  834. X    ex = p_expr(type);
  835. X    if (type)
  836. X        ex = gentle_cast(ex, type);
  837. X    val = eval_expr(ex);
  838. X    freeexpr(ex);
  839. X    if (!val.type) {
  840. X        warning("Expected a constant [127]");
  841. X        val.type = (type) ? type : tp_integer;
  842. X    }
  843. X    return val;
  844. X}
  845. X
  846. X
  847. X
  848. X
  849. Xint typebits(smin, smax)
  850. Xlong smin, smax;
  851. X{
  852. X    unsigned long size;
  853. X    int bits;
  854. X
  855. X    if (smin >= 0 || (smin == -1 && smax == 0)) {
  856. X        bits = 1;
  857. X        size = smax;
  858. X    } else {
  859. X        bits = 2;
  860. X        smin = -1L - smin;
  861. X        if (smin >= smax)
  862. X            size = smin;
  863. X        else
  864. X            size = smax;
  865. X    }
  866. X    while (size > 1) {
  867. X        bits++;
  868. X        size >>= 1;
  869. X    }
  870. X    return bits;
  871. X}
  872. X
  873. X
  874. Xint packedsize(fname, typep, sizep, mode)
  875. Xchar *fname;
  876. XType **typep;
  877. Xlong *sizep;
  878. Xint mode;
  879. X{
  880. X    Type *tp = *typep;
  881. X    long smin, smax;
  882. X    int res, issigned;
  883. X    short savefold;
  884. X    long size;
  885. X
  886. X    if (packing == 0)   /* suppress packing */
  887. X        return 0;
  888. X    if (tp->kind != TK_SUBR && tp->kind != TK_INTEGER && tp->kind != TK_ENUM &&
  889. X        tp->kind != TK_CHAR && tp->kind != TK_BOOLEAN)
  890. X        return 0;
  891. X    if (tp == tp_unsigned)
  892. X    return 0;
  893. X    if (!ord_range(tp, &smin, &smax)) {
  894. X        savefold = foldconsts;
  895. X        foldconsts = 1;
  896. X        res = ord_range(tp, &smin, &smax);
  897. X        foldconsts = savefold;
  898. X        if (res) {
  899. X            note(format_s("Field width for %s is based on expansion of #defines [103]",
  900. X                          fname));
  901. X        } else {
  902. X            note(format_ss("Cannot compute size of field %s; assuming %s [104]",
  903. X                           fname, integername));
  904. X            return 0;
  905. X        }
  906. X    } else {
  907. X        if (tp->kind == TK_ENUM)
  908. X            note(format_ssd("Field width for %s assumes enum%s has %d elements [105]",
  909. X                            fname,
  910. X                            (tp->meaning) ? format_s(" %s", tp->meaning->name) : "",
  911. X                            smax + 1));
  912. X    }
  913. X    issigned = (smin < 0);
  914. X    size = typebits(smin, smax);
  915. X    if (size >= ((sizeof_long > 0) ? sizeof_long : 32))
  916. X        return 0;
  917. X    if (packing != 1) {
  918. X        if (size <= 8)
  919. X            size = 8;
  920. X        else if (size <= 16)
  921. X            size = 16;
  922. X        else
  923. X            return 0;
  924. X    }
  925. X    if (!issigned) {
  926. X        *typep = (mode == 0) ? tp_int : tp_uint;
  927. X    } else {
  928. X        if (mode == 2 && !hassignedchar && !*signextname)
  929. X            return 0;
  930. X        *typep = (mode == 1) ? tp_int : tp_sint;
  931. X    }
  932. X    *sizep = size;
  933. X    return issigned;
  934. X}
  935. X
  936. X
  937. X
  938. XStatic void fielddecl(mp, type, tp2, val, ispacked, aligned)
  939. XMeaning *mp;
  940. XType **type, **tp2;
  941. Xlong *val;
  942. Xint ispacked, *aligned;
  943. X{
  944. X    long smin, smax, smin2, smax2;
  945. X
  946. X    *tp2 = *type;
  947. X    *val = 0;
  948. X    if (ispacked && !mp->constdefn && *type != tp_unsigned) {
  949. X        (void)packedsize(mp->sym->name, tp2, val, signedfield);
  950. X        if (*aligned && *val &&
  951. X            (ord_type(*type)->kind == TK_CHAR ||
  952. X             ord_type(*type)->kind == TK_INTEGER) &&
  953. X            ord_range(findbasetype(*type, 0), &smin, &smax)) {
  954. X        if (ord_range(*type, &smin2, &smax2)) {
  955. X        if (typebits(smin, smax) == 16 &&
  956. X            typebits(smin2, smax2) == 8 && *val == 8) {
  957. X            *tp2 = tp_abyte;
  958. X        }
  959. X        }
  960. X        if (typebits(smin, smax) == *val &&
  961. X        *val != 7) {    /* don't be fooled by tp_abyte */
  962. X        /* don't need to use a bit-field for this field */
  963. X        /* so not specifying one may make it more efficient */
  964. X        /* (and also helps to simulate HP's $allow_packed$ mode) */
  965. X        *val = 0;
  966. X        *tp2 = *type;
  967. X        } 
  968. X        }
  969. X        if (*aligned && *val == 8 &&
  970. X            (ord_type(*type)->kind == TK_BOOLEAN ||
  971. X             ord_type(*type)->kind == TK_ENUM)) {
  972. X            *val = 0;
  973. X            *tp2 = tp_ubyte;
  974. X        }
  975. X    }
  976. X    if (*val != 8 && *val != 16)
  977. X    *aligned = (*val == 0);
  978. X}
  979. X
  980. X
  981. X
  982. X/* This function locates byte-sized fields which were unaligned, but which
  983. X   are followed by aligned quantities so that they can be made aligned
  984. X   with no loss in storage efficiency. */
  985. X
  986. XStatic void realignfields(firstmp, stopmp)
  987. XMeaning *firstmp, *stopmp;
  988. X{
  989. X    Meaning *mp;
  990. X
  991. X    for (mp = firstmp; mp && mp != stopmp; mp = mp->cnext) {
  992. X    if (mp->kind == MK_FIELD) {
  993. X        if (mp->val.i == 16) {
  994. X        if (mp->type == tp_uint)
  995. X            mp->type = tp_ushort;
  996. X        else
  997. X            mp->type = tp_sshort;
  998. X        mp->val.i = 0;
  999. X        } else if (mp->val.i == 8) {
  1000. X        if (mp->type == tp_uint) {
  1001. X            mp->type = tp_ubyte;
  1002. X            mp->val.i = 0;
  1003. X        } else if (hassignedchar || signedchars == 1) {
  1004. X            mp->type = tp_sbyte;
  1005. X            mp->val.i = 0;
  1006. X        } else
  1007. X            mp->type = tp_abyte;
  1008. X        }
  1009. X    }
  1010. X    }
  1011. X}
  1012. X
  1013. Xstatic void tryrealignfields(firstmp)
  1014. XMeaning *firstmp;
  1015. X{
  1016. X    Meaning *mp, *head;
  1017. X
  1018. X    head = NULL;
  1019. X    for (mp = firstmp; mp; mp = mp->cnext) {
  1020. X    if (mp->kind == MK_FIELD) {
  1021. X        if (mp->val.i == 8 || mp->val.i == 16) {
  1022. X        if (!head)
  1023. X            head = mp;
  1024. X        } else {
  1025. X        if (mp->val.i == 0)
  1026. X            realignfields(head, mp);
  1027. X        head = NULL;
  1028. X        }
  1029. X    }
  1030. X    }
  1031. X    realignfields(head, NULL);
  1032. X}
  1033. X
  1034. X
  1035. X
  1036. Xvoid decl_comments(mp)
  1037. XMeaning *mp;
  1038. X{
  1039. X    Strlist *cmt;
  1040. X
  1041. X    if (spitcomments != 1) {
  1042. X    changecomments(curcomments, -1, -1, CMT_PRE, 0);
  1043. X    strlist_mix(&mp->comments, curcomments);
  1044. X    curcomments = NULL;
  1045. X    cmt = grabcomment(CMT_TRAIL);
  1046. X    if (cmt) {
  1047. X        changecomments(mp->comments, CMT_TRAIL, -1, CMT_PRE, -1);
  1048. X        strlist_mix(&mp->comments, cmt);
  1049. X    }
  1050. X    if (mp->comments)
  1051. X        mp->refcount++;   /* force it to be included if it has comments */
  1052. X    }
  1053. X}
  1054. X
  1055. X
  1056. X
  1057. X
  1058. X
  1059. XStatic void p_fieldlist(tp, flast, ispacked, tname)
  1060. XType *tp;
  1061. XMeaning **flast;
  1062. Xint ispacked;
  1063. XMeaning *tname;
  1064. X{
  1065. X    Meaning *firstm, *lastm, *veryfirstm;
  1066. X    Symbol *sym;
  1067. X    Type *type, *tp2;
  1068. X    long li1, li2;
  1069. X    int aligned, constflag, volatileflag;
  1070. X    short saveskipind;
  1071. X    Strlist *l1;
  1072. X
  1073. X    saveskipind = skipindices;
  1074. X    skipindices = 0;
  1075. X    aligned = 1;
  1076. X    lastm = NULL;
  1077. X    veryfirstm = NULL;
  1078. X    while (curtok == TOK_IDENT) {
  1079. X        firstm = addfield(curtoksym, &flast, tp, tname);
  1080. X    if (!veryfirstm)
  1081. X        veryfirstm = firstm;
  1082. X        lastm = firstm;
  1083. X        gettok();
  1084. X    decl_comments(lastm);
  1085. X        while (curtok == TOK_COMMA) {
  1086. X            gettok();
  1087. X            if (wexpecttok(TOK_IDENT))
  1088. X        lastm = addfield(curtoksym, &flast, tp, tname);
  1089. X            gettok();
  1090. X        decl_comments(lastm);
  1091. X        }
  1092. X        if (wneedtok(TOK_COLON)) {
  1093. X        constflag = volatileflag = 0;
  1094. X        p_attributes();
  1095. X        if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
  1096. X        constflag = 1;
  1097. X        strlist_delete(&attrlist, l1);
  1098. X        }
  1099. X        if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
  1100. X        volatileflag = 1;
  1101. X        strlist_delete(&attrlist, l1);
  1102. X        }
  1103. X        type = p_type(firstm);
  1104. X        decl_comments(lastm);
  1105. X        fielddecl(firstm, &type, &tp2, &li1, ispacked, &aligned);
  1106. X        for (;;) {
  1107. X        firstm->type = tp2;
  1108. X        firstm->val.type = type;
  1109. X        firstm->val.i = li1;
  1110. X        firstm->constqual = constflag;
  1111. X        firstm->volatilequal = volatileflag;
  1112. X        tp->meaning = tname;
  1113. X        setupfilevar(firstm);
  1114. X        tp->meaning = NULL;
  1115. X        if (firstm == lastm)
  1116. X            break;
  1117. X        firstm = firstm->cnext;
  1118. X        }
  1119. X    } else
  1120. X        skiptotoken2(TOK_SEMI, TOK_CASE);
  1121. X        if (curtok == TOK_SEMI)
  1122. X            gettok();
  1123. X    }
  1124. X    if (curtok == TOK_CASE) {
  1125. X        gettok();
  1126. X    if (curtok == TOK_COLON)
  1127. X        gettok();
  1128. X    wexpecttok(TOK_IDENT);
  1129. X    sym = curtoksym;
  1130. X    if (curtokmeaning)
  1131. X        type = curtokmeaning->type;
  1132. X    gettok();
  1133. X        if (curtok == TOK_COLON) {
  1134. X            firstm = addfield(sym, &flast, tp, tname);
  1135. X        if (!veryfirstm)
  1136. X        veryfirstm = firstm;
  1137. X            gettok();
  1138. X        firstm->isforward = 1;
  1139. X            firstm->val.type = type = p_type(firstm);
  1140. X            fielddecl(firstm, &firstm->val.type, &firstm->type, &firstm->val.i, 
  1141. X                      ispacked, &aligned);
  1142. X        } else {
  1143. X        firstm = NULL;
  1144. X    }
  1145. X        if (!wneedtok(TOK_OF)) {
  1146. X        skiptotoken2(TOK_END, TOK_RPAR);
  1147. X        goto bounce;
  1148. X    }
  1149. X    if (firstm)
  1150. X        decl_comments(firstm);
  1151. X    while (curtok == TOK_VBAR)
  1152. X        gettok();
  1153. X        while (curtok != TOK_END && curtok != TOK_RPAR) {
  1154. X            firstm = NULL;
  1155. X            for (;;) {
  1156. X        lastm = addfield(NULL, &flast, tp, tname);
  1157. X        if (!firstm)
  1158. X            firstm = lastm;
  1159. X        checkkeyword(TOK_OTHERWISE);
  1160. X        if (curtok == TOK_ELSE || curtok == TOK_OTHERWISE) {
  1161. X            lastm->val = make_ord(type, 999);
  1162. X            break;
  1163. X        } else {
  1164. X            lastm->val = p_constant(type);
  1165. X            if (curtok == TOK_DOTS) {
  1166. X            gettok();
  1167. X            li1 = ord_value(lastm->val);
  1168. X            li2 = ord_value(p_constant(type));
  1169. X            while (++li1 <= li2) {
  1170. X                lastm = addfield(NULL, &flast, tp, tname);
  1171. X                lastm->val = make_ord(type, li1);
  1172. X            }
  1173. X            }
  1174. X        }
  1175. X                if (curtok == TOK_COMMA)
  1176. X                    gettok();
  1177. X                else
  1178. X                    break;
  1179. X            }
  1180. X        if (curtok == TOK_ELSE || curtok == TOK_OTHERWISE) {
  1181. X        gettok();
  1182. X            } else if (!wneedtok(TOK_COLON) ||
  1183. X             (!modula2 && !wneedtok(TOK_LPAR))) {
  1184. X        skiptotoken2(TOK_END, TOK_RPAR);
  1185. X        goto bounce;
  1186. X        }
  1187. X            p_fieldlist(tp, &lastm->ctx, ispacked, tname);
  1188. X            while (firstm != lastm) {
  1189. X                firstm->ctx = lastm->ctx;
  1190. X                firstm = firstm->cnext;
  1191. X            }
  1192. X        if (modula2) {
  1193. X        while (curtok == TOK_VBAR)
  1194. X            gettok();
  1195. X        } else {
  1196. X        if (!wneedtok(TOK_RPAR))
  1197. X            skiptotoken(TOK_RPAR);
  1198. X        }
  1199. X            if (curtok == TOK_SEMI)
  1200. X                gettok();
  1201. X        }
  1202. X    if (modula2) {
  1203. X        wneedtok(TOK_END);
  1204. X        if (curtok == TOK_IDENT) {
  1205. X        note("Record variants supported only at end of record [106]");
  1206. X        p_fieldlist(tp, &lastm->ctx, ispacked, tname);
  1207. X        }
  1208. X    }
  1209. X    }
  1210. X    tryrealignfields(veryfirstm);
  1211. X    if (lastm && curtok == TOK_END) {
  1212. X    strlist_mix(&lastm->comments, curcomments);
  1213. X    curcomments = NULL;
  1214. X    }
  1215. X
  1216. X  bounce:
  1217. X    skipindices = saveskipind;
  1218. X}
  1219. X
  1220. X
  1221. X
  1222. XStatic Type *p_arraydecl(tname, ispacked, confp)
  1223. Xchar *tname;
  1224. Xint ispacked;
  1225. XMeaning ***confp;
  1226. X{
  1227. X    Type *tp, *tp2;
  1228. X    Meaning *mp;
  1229. X    long size, smin, smax, bitsize, fullbitsize;
  1230. X    int issigned, bpower, hasrange;
  1231. X
  1232. X    tp = maketype(TK_ARRAY);
  1233. X    if (confp == NULL) {
  1234. X    tp->indextype = p_type(NULL);
  1235. X    if (tp->indextype->kind == TK_SUBR) {
  1236. X        if (ord_range(tp->indextype, &smin, NULL) &&
  1237. X        smin > 0 && smin <= skipindices && !ispacked) {
  1238. X        tp->smin = makeexpr_val(make_ord(tp->indextype->basetype, smin));
  1239. X        tp->indextype = makesubrangetype(tp->indextype->basetype,
  1240. X                         makeexpr_val(make_ord(
  1241. X                                 tp->indextype->basetype, 0)),
  1242. X                         copyexpr(tp->indextype->smax));
  1243. X        }
  1244. X    }
  1245. X    } else {
  1246. X    if (modula2) {
  1247. X        **confp = mp = addmeaning(findsymbol(format_s(name_ALOW, tname)), MK_PARAM);
  1248. X        mp->fakeparam = 1;
  1249. X        mp->constqual = 1;
  1250. X        mp->xnext = addmeaning(findsymbol(format_s(name_AHIGH, tname)), MK_PARAM);
  1251. X        mp->xnext->fakeparam = 1;
  1252. X        mp->xnext->constqual = 1;
  1253. X        *confp = &mp->xnext->xnext;
  1254. X        tp2 = maketype(TK_SUBR);
  1255. X        tp2->basetype = tp_integer;
  1256. X        mp->type = tp_integer;
  1257. X        mp->xnext->type = mp->type;
  1258. X        tp2->smin = makeexpr_long(0);
  1259. X        tp2->smax = makeexpr_minus(makeexpr_var(mp->xnext),
  1260. X                       makeexpr_var(mp));
  1261. X        tp->indextype = tp2;
  1262. X        tp->structdefd = 1;
  1263. X    } else {
  1264. X        wexpecttok(TOK_IDENT);
  1265. X        tp2 = maketype(TK_SUBR);
  1266. X        if (peeknextchar() != ',' &&
  1267. X        (!curtokmeaning || curtokmeaning->kind != MK_TYPE)) {
  1268. X        mp = addmeaning(curtoksym, MK_PARAM);
  1269. X        gettok();
  1270. X        wneedtok(TOK_DOTS);
  1271. X        wexpecttok(TOK_IDENT);
  1272. X        mp->xnext = addmeaning(curtoksym, MK_PARAM);
  1273. X        gettok();
  1274. X        if (wneedtok(TOK_COLON)) {
  1275. X            tp2->basetype = p_type(NULL);
  1276. X        } else {
  1277. X            tp2->basetype = tp_integer;
  1278. X        }
  1279. X        } else {
  1280. X        mp = addmeaning(findsymbol(format_s(name_ALOW, tname)), MK_PARAM);
  1281. X        mp->xnext = addmeaning(findsymbol(format_s(name_AHIGH, tname)), MK_PARAM);
  1282. X        tp2->basetype = p_type(NULL);
  1283. X        }
  1284. X        mp->fakeparam = 1;
  1285. X        mp->constqual = 1;
  1286. X        mp->xnext->fakeparam = 1;
  1287. X        mp->xnext->constqual = 1;
  1288. X        **confp = mp;
  1289. X        *confp = &mp->xnext->xnext;
  1290. X        mp->type = tp2->basetype;
  1291. X        mp->xnext->type = tp2->basetype;
  1292. X        tp2->smin = makeexpr_var(mp);
  1293. X        tp2->smax = makeexpr_var(mp->xnext);
  1294. X        tp->indextype = tp2;
  1295. X        tp->structdefd = 1;     /* conformant array flag */
  1296. X    }
  1297. X    }
  1298. X    if (curtok == TOK_COMMA || curtok == TOK_SEMI) {
  1299. X        gettok();
  1300. X        tp->basetype = p_arraydecl(tname, ispacked, confp);
  1301. X        return tp;
  1302. X    } else {
  1303. X    if (!modula2) {
  1304. X        if (!wneedtok(TOK_RBR))
  1305. X        skiptotoken(TOK_OF);
  1306. X    }
  1307. X        if (!wneedtok(TOK_OF))
  1308. X        skippasttotoken(TOK_OF, TOK_COMMA);
  1309. X    checkkeyword(TOK_VARYING);
  1310. X    if (confp != NULL &&
  1311. X        (curtok == TOK_ARRAY || curtok == TOK_PACKED ||
  1312. X         curtok == TOK_VARYING)) {
  1313. X        tp->basetype = p_conformant_array(tname, confp);
  1314. X    } else
  1315. X        tp->basetype = p_type(NULL);
  1316. X        if (!ispacked)
  1317. X            return tp;
  1318. X        size = 0;
  1319. X        tp2 = tp->basetype;
  1320. X        if (!tname)
  1321. X            tname = "array";
  1322. X        issigned = packedsize(tname, &tp2, &size, 1);
  1323. X        if (!size || size > 8 ||
  1324. X            (issigned && !packsigned) ||
  1325. X            (size > 4 &&
  1326. X             (!issigned || (signedchars == 1 || hassignedchar))))
  1327. X            return tp;
  1328. X        bpower = 0;
  1329. X        while ((1<<bpower) < size)
  1330. X            bpower++;        /* round size up to power of two */
  1331. X        size = 1<<bpower;    /* size = # bits in an array element */
  1332. X        tp->escale = bpower;
  1333. X        tp->issigned = issigned;
  1334. X        hasrange = ord_range(tp->indextype, &smin, &smax) &&
  1335. X                   (smax < 100000);    /* don't be confused by giant arrays */
  1336. X        if (hasrange &&
  1337. X        (bitsize = (smax - smin + 1) * size)
  1338. X            <= ((sizeof_integer > 0) ? sizeof_integer : 32)) {
  1339. X            if (bitsize > ((sizeof_short > 0) ? sizeof_short : 16)) {
  1340. X                tp2 = (issigned) ? tp_integer : tp_unsigned;
  1341. X                fullbitsize = ((sizeof_integer > 0) ? sizeof_integer : 32);
  1342. X            } else if (bitsize > ((sizeof_char > 0) ? sizeof_char : 8) ||
  1343. X                       (issigned && !(signedchars == 1 || hassignedchar))) {
  1344. X                tp2 = (issigned) ? tp_sshort : tp_ushort;
  1345. X                fullbitsize = ((sizeof_short > 0) ? sizeof_short : 16);
  1346. X            } else {
  1347. X                tp2 = (issigned) ? tp_sbyte : tp_ubyte;
  1348. X                fullbitsize = ((sizeof_char > 0) ? sizeof_char : 8);
  1349. X            }
  1350. X            tp->kind = TK_SMALLARRAY;
  1351. X            if (ord_range(tp->indextype, &smin, NULL) &&
  1352. X                smin > 0 && smin <= fullbitsize - bitsize) {
  1353. X                tp->smin = makeexpr_val(make_ord(tp->indextype->basetype, smin));
  1354. X                tp->indextype = makesubrangetype(tp->indextype->basetype,
  1355. X                                                 makeexpr_val(make_ord(
  1356. X                                                     tp->indextype->basetype, 0)),
  1357. X                                                 copyexpr(tp->indextype->smax));
  1358. X            }
  1359. X        } else {
  1360. X            if (!issigned)
  1361. X                tp2 = tp_ubyte;
  1362. X            else if (signedchars == 1 || hassignedchar)
  1363. X                tp2 = tp_sbyte;
  1364. X            else
  1365. X                tp2 = tp_sshort;
  1366. X        }
  1367. X        tp->smax = makeexpr_type(tp->basetype);
  1368. X        tp->basetype = tp2;
  1369. X        return tp;
  1370. X    }
  1371. X}
  1372. X
  1373. X
  1374. X
  1375. XStatic Type *p_conformant_array(tname, confp)
  1376. Xchar *tname;
  1377. XMeaning ***confp;
  1378. X{
  1379. X    int ispacked;
  1380. X    Meaning *mp;
  1381. X    Type *tp, *tp2;
  1382. X
  1383. X    p_attributes();
  1384. X    ignore_attributes();
  1385. X    if (curtok == TOK_PACKED) {
  1386. X    ispacked = 1;
  1387. X    gettok();
  1388. X    } else
  1389. X    ispacked = 0;
  1390. X    checkkeyword(TOK_VARYING);
  1391. X    if (curtok == TOK_VARYING) {
  1392. X    gettok();
  1393. X    wneedtok(TOK_LBR);
  1394. X    wexpecttok(TOK_IDENT);
  1395. X    mp = addmeaning(curtoksym, MK_PARAM);
  1396. X    mp->fakeparam = 1;
  1397. X    mp->constqual = 1;
  1398. X    **confp = mp;
  1399. X    *confp = &mp->xnext;
  1400. X    mp->type = tp_integer;
  1401. X    tp2 = maketype(TK_SUBR);
  1402. X    tp2->basetype = tp_integer;
  1403. X    tp2->smin = makeexpr_long(1);
  1404. X    tp2->smax = makeexpr_var(mp);
  1405. X    tp = maketype(TK_STRING);
  1406. X    tp->indextype = tp2;
  1407. X    tp->basetype = tp_char;
  1408. X    tp->structdefd = 1;     /* conformant array flag */
  1409. X    gettok();
  1410. X    wneedtok(TOK_RBR);
  1411. X    skippasttoken(TOK_OF);
  1412. X    tp->basetype = p_type(NULL);
  1413. X    return tp;
  1414. X    }
  1415. X    if (wneedtok(TOK_ARRAY) &&
  1416. X    (modula2 || wneedtok(TOK_LBR))) {
  1417. X    return p_arraydecl(tname, ispacked, confp);
  1418. X    } else {
  1419. X    return tp_integer;
  1420. X    }
  1421. X}
  1422. X
  1423. X
  1424. X
  1425. X
  1426. X/* VAX Pascal: */
  1427. Xvoid p_attributes()
  1428. X{
  1429. X    Strlist *l1;
  1430. X
  1431. X    if (modula2)
  1432. X    return;
  1433. X    while (curtok == TOK_LBR) {
  1434. X    implementationmodules = 1;    /* auto-detect VAX Pascal */
  1435. X    do {
  1436. X        gettok();
  1437. X        if (!wexpecttok(TOK_IDENT)) {
  1438. X        skippasttoken(TOK_RBR);
  1439. X        return;
  1440. X        }
  1441. X        l1 = strlist_append(&attrlist, strupper(curtokbuf));
  1442. X        l1->value = -1;
  1443. X        gettok();
  1444. X        if (curtok == TOK_LPAR) {
  1445. X        gettok();
  1446. X        if (!strcmp(l1->s, "CHECK") ||
  1447. X            !strcmp(l1->s, "OPTIMIZE") ||
  1448. X            !strcmp(l1->s, "KEY") ||
  1449. X            !strcmp(l1->s, "COMMON") ||
  1450. X            !strcmp(l1->s, "PSECT") ||
  1451. X            !strcmp(l1->s, "EXTERNAL") ||
  1452. X            !strcmp(l1->s, "GLOBAL") ||
  1453. X            !strcmp(l1->s, "WEAK_EXTERNAL") ||
  1454. X            !strcmp(l1->s, "WEAK_GLOBAL")) {
  1455. X            l1->value = (long)stralloc(curtokbuf);
  1456. X            gettok();
  1457. X            while (curtok == TOK_COMMA) {
  1458. X            gettok();
  1459. X            gettok();
  1460. X            }
  1461. X        } else if (!strcmp(l1->s, "INHERIT") ||
  1462. X               !strcmp(l1->s, "IDENT") ||
  1463. X               !strcmp(l1->s, "ENVIRONMENT")) {
  1464. X            p_expr(NULL);
  1465. X            while (curtok == TOK_COMMA) {
  1466. X            gettok();
  1467. X            p_expr(NULL);
  1468. X            }
  1469. X        } else {
  1470. X            l1->value = ord_value(p_constant(tp_integer));
  1471. X            while (curtok == TOK_COMMA) {
  1472. X            gettok();
  1473. X            p_expr(NULL);
  1474. X            }
  1475. X        }
  1476. X        if (!wneedtok(TOK_RPAR)) {
  1477. X            skippasttotoken(TOK_RPAR, TOK_LBR);
  1478. X        }
  1479. X        }
  1480. X    } while (curtok == TOK_COMMA);
  1481. X    if (!wneedtok(TOK_RBR)) {
  1482. X        skippasttoken(TOK_RBR);
  1483. X    }
  1484. X    }
  1485. X}
  1486. X
  1487. X
  1488. Xvoid ignore_attributes()
  1489. X{
  1490. X    while (attrlist) {
  1491. X    if (strcmp(attrlist->s, "HIDDEN") &&
  1492. X        strcmp(attrlist->s, "INHERIT") &&
  1493. X        strcmp(attrlist->s, "ENVIRONMENT"))
  1494. X        warning(format_s("Type attribute %s ignored [128]", attrlist->s));
  1495. X    strlist_eat(&attrlist);
  1496. X    }
  1497. X}
  1498. X
  1499. X
  1500. Xint size_attributes()
  1501. X{
  1502. X    int size = -1;
  1503. X    Strlist *l1;
  1504. X
  1505. X    if ((l1 = strlist_find(attrlist, "BIT")) != NULL)
  1506. X    size = 1;
  1507. X    else if ((l1 = strlist_find(attrlist, "BYTE")) != NULL)
  1508. X    size = 8;
  1509. X    else if ((l1 = strlist_find(attrlist, "WORD")) != NULL)
  1510. X    size = 16;
  1511. X    else if ((l1 = strlist_find(attrlist, "LONG")) != NULL)
  1512. X    size = 32;
  1513. X    else if ((l1 = strlist_find(attrlist, "QUAD")) != NULL)
  1514. X    size = 64;
  1515. X    else if ((l1 = strlist_find(attrlist, "OCTA")) != NULL)
  1516. X    size = 128;
  1517. X    else
  1518. X    return -1;
  1519. X    if (l1->value >= 0)
  1520. X    size *= l1->value;
  1521. X    strlist_delete(&attrlist, l1);
  1522. X    return size;
  1523. X}
  1524. X
  1525. X
  1526. Xvoid p_mech_spec(doref)
  1527. Xint doref;
  1528. X{
  1529. X    if (curtok == TOK_IDENT && doref &&
  1530. X    !strcicmp(curtokbuf, "%REF")) {
  1531. X    note("Mechanism specified %REF treated like VAR [107]");
  1532. X    curtok = TOK_VAR;
  1533. X    return;
  1534. X    }
  1535. X    if (curtok == TOK_IDENT &&
  1536. X    (!strcicmp(curtokbuf, "%REF") ||
  1537. X     !strcicmp(curtokbuf, "%IMMED") ||
  1538. X     !strcicmp(curtokbuf, "%DESCR") ||
  1539. X     !strcicmp(curtokbuf, "%STDESCR"))) {
  1540. X    note(format_s("Mechanism specifier %s ignored [108]", curtokbuf));
  1541. X    gettok();
  1542. X    }
  1543. X}
  1544. X
  1545. X
  1546. XType *p_modula_subrange(basetype)
  1547. XType *basetype;
  1548. X{
  1549. X    Type *tp;
  1550. X    Value val;
  1551. X
  1552. X    wneedtok(TOK_LBR);
  1553. X    tp = maketype(TK_SUBR);
  1554. X    tp->smin = p_ord_expr();
  1555. X    if (basetype)
  1556. X    tp->smin = gentle_cast(tp->smin, basetype);
  1557. X    if (wexpecttok(TOK_DOTS)) {
  1558. X    gettok();
  1559. X    tp->smax = p_ord_expr();
  1560. X    if (tp->smax->val.type->kind == TK_REAL &&
  1561. X        tp->smax->kind == EK_CONST &&
  1562. X        strlen(tp->smax->val.s) == 12 &&
  1563. X        strcmp(tp->smax->val.s, "2147483648.0") >= 0 &&
  1564. X        strcmp(tp->smax->val.s, "4294967295.0") <= 0) {
  1565. X        tp = tp_unsigned;
  1566. X    } else if (basetype) {
  1567. X        tp->smin = gentle_cast(tp->smin, basetype);
  1568. X        tp->basetype = basetype;
  1569. X    } else {
  1570. X        basetype = ord_type(tp->smin->val.type);
  1571. X        if (basetype->kind == TK_INTEGER) {
  1572. X        val = eval_expr(tp->smin);
  1573. X        if (val.type && val.i >= 0)
  1574. X            basetype = tp_unsigned;
  1575. X        else
  1576. X            basetype = tp_integer;
  1577. X        }
  1578. X        tp->basetype = basetype;
  1579. X    }
  1580. X    } else {
  1581. X    tp = tp_integer;
  1582. X    }
  1583. X    if (!wneedtok(TOK_RBR))
  1584. X    skippasttotoken(TOK_RBR, TOK_SEMI);
  1585. X    return tp;
  1586. X}
  1587. X
  1588. X
  1589. Xvoid makefakestruct(tp, tname)
  1590. XType *tp;
  1591. XMeaning *tname;
  1592. X{
  1593. X    Symbol *sym;
  1594. X
  1595. X    if (!tname)
  1596. X    return;
  1597. X    while (tp && (tp->kind == TK_ARRAY || tp->kind == TK_FILE))
  1598. X    tp = tp->basetype;
  1599. X    if (tp && tp->kind == TK_RECORD && !tp->meaning) {
  1600. X    sym = findsymbol(format_s(name_FAKESTRUCT, tname->name));
  1601. X    silentalreadydef++;
  1602. X    tp->meaning = addmeaning(sym, MK_TYPE);
  1603. X    silentalreadydef--;
  1604. X    tp->meaning->type = tp;
  1605. X    tp->meaning->refcount++;
  1606. X    declaretype(tp->meaning);
  1607. X    }
  1608. X}
  1609. X
  1610. X
  1611. XType *p_type(tname)
  1612. XMeaning *tname;
  1613. X{
  1614. X    Type *tp;
  1615. X    int ispacked = 0;
  1616. X    Meaning **flast;
  1617. X    Meaning *mp;
  1618. X    Strlist *sl;
  1619. X    int num, isfunc, saveind, savenotephase, sizespec;
  1620. X    Expr *ex;
  1621. X    Value val;
  1622. X    static int proctypecount = 0;
  1623. X
  1624. X    p_attributes();
  1625. X    sizespec = size_attributes();
  1626. X    ignore_attributes();
  1627. X    tp = tp_integer;
  1628. X    if (curtok == TOK_PACKED) {
  1629. X        ispacked = 1;
  1630. X        gettok();
  1631. X    }
  1632. X    checkkeyword(TOK_VARYING);
  1633. X    if (modula2)
  1634. X    checkkeyword(TOK_POINTER);
  1635. X    switch (curtok) {
  1636. X
  1637. X        case TOK_RECORD:
  1638. X            gettok();
  1639. X        savenotephase = notephase;
  1640. X        notephase = 1;
  1641. X            tp = maketype(TK_RECORD);
  1642. X            p_fieldlist(tp, &(tp->fbase), ispacked, tname);
  1643. X        notephase = savenotephase;
  1644. X            if (!wneedtok(TOK_END)) {
  1645. X        skippasttoken(TOK_END);
  1646. X        }
  1647. X            break;
  1648. X
  1649. X        case TOK_ARRAY:
  1650. X            gettok();
  1651. X        if (!modula2) {
  1652. X        if (!wneedtok(TOK_LBR))
  1653. X            break;
  1654. X        }
  1655. X        tp = p_arraydecl(tname ? tname->name : NULL, ispacked, NULL);
  1656. X        makefakestruct(tp, tname);
  1657. X            break;
  1658. X
  1659. X    case TOK_VARYING:
  1660. X        gettok();
  1661. X        tp = maketype(TK_STRING);
  1662. X        if (wneedtok(TOK_LBR)) {
  1663. X        ex = p_ord_expr();
  1664. X        if (!wneedtok(TOK_RBR))
  1665. X            skippasttoken(TOK_RBR);
  1666. X        } else
  1667. X        ex = makeexpr_long(stringdefault);
  1668. X        if (wneedtok(TOK_OF))
  1669. X        tp->basetype = p_type(NULL);
  1670. X        else
  1671. X        tp->basetype = tp_char;
  1672. X        val = eval_expr(ex);
  1673. X        if (val.type) {
  1674. X        if (val.i > 255 && val.i > stringceiling) {
  1675. X            note(format_d("Strings longer than %d may have problems [109]",
  1676. X                  stringceiling));
  1677. X        }
  1678. X        if (stringceiling != 255 &&
  1679. X            (val.i >= 255 || val.i > stringceiling)) {
  1680. X            freeexpr(ex);
  1681. X            ex = makeexpr_long(stringceiling);
  1682. X        }
  1683. X        }
  1684. X        tp->indextype = makesubrangetype(tp_integer, makeexpr_long(0), ex);
  1685. X        break;
  1686. X
  1687. X        case TOK_SET:
  1688. X            gettok();
  1689. X            if (!wneedtok(TOK_OF))
  1690. X        break;
  1691. X        tp = p_type(NULL);
  1692. X        if (tp == tp_integer || tp == tp_unsigned)
  1693. X        tp = makesubrangetype(tp, makeexpr_long(0),
  1694. X                      makeexpr_long(defaultsetsize-1));
  1695. X        if (tp->kind == TK_ENUM && !tp->meaning && useenum) {
  1696. X        outbasetype(tp, 0);
  1697. X        output(";");
  1698. X        }
  1699. X            tp = makesettype(tp);
  1700. X            break;
  1701. X
  1702. X        case TOK_FILE:
  1703. X            gettok();
  1704. X        tp = maketype(TK_FILE);
  1705. X            if (curtok == TOK_OF) {
  1706. X                gettok();
  1707. X                tp->basetype = p_type(NULL);
  1708. X            } else {
  1709. X                tp->basetype = tp_abyte;
  1710. X            }
  1711. X        if (tp->basetype->kind == TK_CHAR && charfiletext) {
  1712. X        tp = tp_text;
  1713. X        } else {
  1714. X        makefakestruct(tp, tname);
  1715. X        tp = makepointertype(tp);
  1716. X        }
  1717. X            break;
  1718. X
  1719. X        case TOK_PROCEDURE:
  1720. X    case TOK_FUNCTION:
  1721. X        isfunc = (curtok == TOK_FUNCTION);
  1722. X            gettok();
  1723. X        if (curtok != TOK_LPAR && !isfunc && hasstaticlinks == 1) {
  1724. X        tp = tp_proc;
  1725. X        break;
  1726. X        }
  1727. X        proctypecount++;
  1728. X        mp = addmeaning(findsymbol(format_d("__PROCPTR%d",
  1729. X                        proctypecount)),
  1730. X                MK_FUNCTION);
  1731. X        pushctx(mp);
  1732. X        tp = maketype((hasstaticlinks != 0) ? TK_PROCPTR : TK_CPROCPTR);
  1733. X        tp->basetype = p_funcdecl(&isfunc, 1);
  1734. X        tp->fbase = mp;   /* (saved, but not currently used) */
  1735. X        tp->escale = hasstaticlinks;
  1736. X        popctx();
  1737. X            break;
  1738. X
  1739. X        case TOK_HAT:
  1740. X    case TOK_ADDR:
  1741. X    case TOK_POINTER:
  1742. X        if (curtok == TOK_POINTER) {
  1743. X        gettok();
  1744. X        wneedtok(TOK_TO);
  1745. X        if (curtok == TOK_IDENT && !strcmp(curtokbuf, "WORD")) {
  1746. X            tp = tp_anyptr;
  1747. X            gettok();
  1748. X            break;
  1749. X        }
  1750. X        } else
  1751. X        gettok();
  1752. X        p_attributes();
  1753. X        ignore_attributes();
  1754. X            tp = maketype(TK_POINTER);
  1755. X            if (curtok == TOK_IDENT &&
  1756. X        (!curtokmeaning || curtokmeaning->kind != MK_TYPE ||
  1757. X         (deferallptrs && curtokmeaning->ctx != curctx))) {
  1758. X                struct ptrdesc *pd;
  1759. X                pd = ALLOC(1, struct ptrdesc, ptrdescs);
  1760. X                pd->sym = curtoksym;
  1761. X                pd->tp = tp;
  1762. X                pd->next = ptrbase;
  1763. X                ptrbase = pd;
  1764. X                tp->basetype = tp_abyte;
  1765. X        anydeferredptrs = 1;
  1766. X                gettok();
  1767. X            } else {
  1768. X                tp->basetype = p_type(NULL);
  1769. X                if (!tp->basetype->pointertype)
  1770. X                    tp->basetype->pointertype = tp;
  1771. X            }
  1772. X            break;
  1773. X
  1774. X        case TOK_LPAR:
  1775. X            if (!useenum)
  1776. X                outsection(minorspace);
  1777. X        enum_tname = tname;
  1778. X            tp = maketype(TK_ENUM);
  1779. X            flast = &(tp->fbase);
  1780. X            num = 0;
  1781. X            do {
  1782. X                gettok();
  1783. X                if (!wexpecttok(TOK_IDENT)) {
  1784. X            skiptotoken(TOK_RPAR);
  1785. X            break;
  1786. X        }
  1787. X                sl = strlist_find(constmacros, curtoksym->name);
  1788. X                mp = addmeaningas(curtoksym, MK_CONST,
  1789. X                  (*enumformat) ? MK_VARIANT :
  1790. X                                  (useenum) ? MK_VAR : MK_CONST);
  1791. X                mp->val.type = tp;
  1792. X                mp->val.i = num++;
  1793. X                mp->type = tp;
  1794. X                if (sl) {
  1795. X                    mp->constdefn = (Expr *)sl->value;
  1796. X                    mp->anyvarflag = 1;    /* Make sure constant is folded */
  1797. X                    strlist_delete(&constmacros, sl);
  1798. X                    if (mp->constdefn->kind == EK_NAME)
  1799. X                        strchange(&mp->name, mp->constdefn->val.s);
  1800. X                } else {
  1801. X                    if (!useenum) {
  1802. X            output(format_s("#define %s", mp->name));
  1803. X            mp->isreturn = 1;
  1804. X            out_spaces(constindent, 0, 0, 0);
  1805. X            saveind = outindent;
  1806. X            outindent = cur_column();
  1807. X            output(format_d("%d\n", mp->val.i));
  1808. X            outindent = saveind;
  1809. X            }
  1810. X        }
  1811. X                *flast = mp;
  1812. X                flast = &(mp->xnext);
  1813. X                gettok();
  1814. X            } while (curtok == TOK_COMMA);
  1815. X        if (!wneedtok(TOK_RPAR))
  1816. X        skippasttoken(TOK_RPAR);
  1817. X            tp->smin = makeexpr_long(0);
  1818. X            tp->smax = makeexpr_long(num-1);
  1819. X            if (!useenum)
  1820. X                outsection(minorspace);
  1821. X            break;
  1822. X
  1823. X    case TOK_LBR:
  1824. X        tp = p_modula_subrange(NULL);
  1825. X        break;
  1826. X
  1827. X        case TOK_IDENT:
  1828. X            if (!curtokmeaning) {
  1829. X                undefsym(curtoksym);
  1830. X                tp = tp_integer;
  1831. X                mp = addmeaning(curtoksym, MK_TYPE);
  1832. X                mp->type = tp;
  1833. X                gettok();
  1834. X                break;
  1835. X            } else if (curtokmeaning == mp_string) {
  1836. X                gettok();
  1837. X                tp = maketype(TK_STRING);
  1838. X                tp->basetype = tp_char;
  1839. X                if (curtok == TOK_LBR) {
  1840. X                    gettok();
  1841. X                    ex = p_ord_expr();
  1842. X                    if (!wneedtok(TOK_RBR))
  1843. X            skippasttoken(TOK_RBR);
  1844. X                } else {
  1845. X            ex = makeexpr_long(stringdefault);
  1846. X                }
  1847. X                val = eval_expr(ex);
  1848. X                if (val.type && stringceiling != 255 &&
  1849. X                    (val.i >= 255 || val.i > stringceiling)) {
  1850. X                    freeexpr(ex);
  1851. X                    ex = makeexpr_long(stringceiling);
  1852. X                }
  1853. X                tp->indextype = makesubrangetype(tp_integer, makeexpr_long(0), ex);
  1854. X                break;
  1855. X            } else if (curtokmeaning->kind == MK_TYPE) {
  1856. X                tp = curtokmeaning->type;
  1857. X        if (sizespec > 0) {
  1858. X            if (ord_type(tp)->kind == TK_INTEGER && sizespec <= 32) {
  1859. X            if (checkconst(tp->smin, 0)) {
  1860. X                if (sizespec == 32)
  1861. X                tp = tp_unsigned;
  1862. X                else
  1863. X                tp = makesubrangetype(tp_unsigned,
  1864. X                     makeexpr_long(0),
  1865. X                         makeexpr_long((1L << sizespec) - 1));
  1866. X            } else {
  1867. X                tp = makesubrangetype(tp_integer,
  1868. X                     makeexpr_long(- ((1L << (sizespec-1)))),
  1869. X                     makeexpr_long((1L << (sizespec-1)) - 1));
  1870. X            }
  1871. X            sizespec = -1;
  1872. X            }
  1873. X        }
  1874. X                gettok();
  1875. X        if (curtok == TOK_LBR) {
  1876. X            if (modula2) {
  1877. X            tp = p_modula_subrange(tp);
  1878. X            } else {
  1879. X            gettok();
  1880. X            ex = p_expr(tp_integer);
  1881. X            note("UCSD size spec ignored; using 'long int' [110]");
  1882. X            if (ord_type(tp)->kind == TK_INTEGER)
  1883. X                tp = tp_integer;
  1884. X            if (!wneedtok(TOK_RBR))
  1885. X                skippasttotoken(TOK_RBR, TOK_SEMI);
  1886. X            }
  1887. X        }
  1888. X                break;
  1889. X            }
  1890. X
  1891. X        /* fall through */
  1892. X        default:
  1893. X            tp = maketype(TK_SUBR);
  1894. X            tp->smin = p_ord_expr();
  1895. X        if (wexpecttok(TOK_DOTS)) {
  1896. X        gettok();
  1897. X        tp->smax = p_ord_expr();
  1898. X        if (tp->smax->val.type->kind == TK_REAL &&
  1899. X            tp->smax->kind == EK_CONST &&
  1900. X            strlen(tp->smax->val.s) == 12 &&
  1901. X            strcmp(tp->smax->val.s, "2147483648.0") >= 0 &&
  1902. END_OF_FILE
  1903. if test 49154 -ne `wc -c <'src/decl.c.2'`; then
  1904.     echo shar: \"'src/decl.c.2'\" unpacked with wrong size!
  1905. fi
  1906. # end of 'src/decl.c.2'
  1907. fi
  1908. echo shar: End of archive 27 \(of 32\).
  1909. cp /dev/null ark27isdone
  1910. MISSING=""
  1911. 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
  1912.     if test ! -f ark${I}isdone ; then
  1913.     MISSING="${MISSING} ${I}"
  1914.     fi
  1915. done
  1916. if test "${MISSING}" = "" ; then
  1917.     echo You have unpacked all 32 archives.
  1918.     echo "Now see PACKNOTES and the README"
  1919.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  1920. else
  1921.     echo You still need to unpack the following archives:
  1922.     echo "        " ${MISSING}
  1923. fi
  1924. ##  End of shell archive.
  1925. exit 0
  1926.