home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume21 / p2c / part28 < prev    next >
Encoding:
Internet Message Format  |  1990-04-05  |  51.5 KB
  1. Subject:  v21i073:  Pascal to C translator, Part28/32
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4. X-Checksum-Snefru: 1cb00360 91d85a32 6e2d46c8 954f3167
  5.  
  6. Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
  7. Posting-number: Volume 21, Issue 73
  8. Archive-name: p2c/part28
  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 28 (of 32)."
  17. # Contents:  src/decl.c.1
  18. # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:51 1990
  19. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  20. if test -f 'src/decl.c.1' -a "${1}" != "-c" ; then 
  21.   echo shar: Will not clobber existing file \"'src/decl.c.1'\"
  22. else
  23. echo shar: Extracting \"'src/decl.c.1'\" \(49193 characters\)
  24. sed "s/^X//" >'src/decl.c.1' <<'END_OF_FILE'
  25. X/* "p2c", a Pascal to C translator.
  26. X   Copyright (C) 1989 David Gillespie.
  27. X   Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  28. X
  29. XThis program is free software; you can redistribute it and/or modify
  30. Xit under the terms of the GNU General Public License as published by
  31. Xthe Free Software Foundation (any version).
  32. X
  33. XThis program is distributed in the hope that it will be useful,
  34. Xbut WITHOUT ANY WARRANTY; without even the implied warranty of
  35. XMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  36. XGNU General Public License for more details.
  37. X
  38. XYou should have received a copy of the GNU General Public License
  39. Xalong with this program; see the file COPYING.  If not, write to
  40. Xthe Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  41. X
  42. X
  43. X
  44. X#define PROTO_DECL_C
  45. X#include "trans.h"
  46. X
  47. X
  48. X
  49. X#define MAXIMPORTS 100
  50. X
  51. X
  52. X
  53. XStatic struct ptrdesc {
  54. X    struct ptrdesc *next;
  55. X    Symbol *sym;
  56. X    Type *tp;
  57. X} *ptrbase;
  58. X
  59. XStatic struct ctxstack {
  60. X    struct ctxstack *next;
  61. X    Meaning *ctx, *ctxlast;
  62. X    struct tempvarlist *tempvars;
  63. X    int tempvarcount, importmark;
  64. X} *ctxtop;
  65. X
  66. XStatic struct tempvarlist {
  67. X    struct tempvarlist *next;
  68. X    Meaning *tvar;
  69. X    int active;
  70. X} *tempvars, *stmttempvars;
  71. X
  72. XStatic int tempvarcount;
  73. X
  74. XStatic int stringtypecachesize;
  75. XStatic Type **stringtypecache;
  76. X
  77. XStatic Meaning *importlist[MAXIMPORTS];
  78. XStatic int firstimport;
  79. X
  80. XStatic Type *tp_special_anyptr;
  81. X
  82. XStatic int wasaliased;
  83. XStatic int deferallptrs;
  84. XStatic int anydeferredptrs;
  85. XStatic int silentalreadydef;
  86. XStatic int nonloclabelcount;
  87. X
  88. XStatic Strlist *varstructdecllist;
  89. X
  90. X
  91. X
  92. X
  93. XStatic Meaning *findstandardmeaning(kind, name)
  94. Xenum meaningkind kind;
  95. Xchar *name;
  96. X{
  97. X    Meaning *mp;
  98. X    Symbol *sym;
  99. X
  100. X    sym = findsymbol(fixpascalname(name));
  101. X    for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
  102. X    if (mp) {
  103. X    if (mp->kind == kind)
  104. X        mp->refcount = 1;
  105. X    else
  106. X        mp = NULL;
  107. X    }
  108. X    return mp;
  109. X}
  110. X
  111. X
  112. XStatic Meaning *makestandardmeaning(kind, name)
  113. Xenum meaningkind kind;
  114. Xchar *name;
  115. X{
  116. X    Meaning *mp;
  117. X    Symbol *sym;
  118. X
  119. X    sym = findsymbol(fixpascalname(name));
  120. X    for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
  121. X    if (!mp) {
  122. X        mp = addmeaning(sym, kind);
  123. X        strchange(&mp->name, stralloc(name));
  124. X        if (debug < 4)
  125. X            mp->dumped = partialdump;     /* prevent irrelevant dumping */
  126. X    } else {
  127. X        mp->kind = kind;
  128. X    }
  129. X    mp->refcount = 1;
  130. X    return mp;
  131. X}
  132. X
  133. X
  134. XStatic Type *makestandardtype(kind, mp)
  135. Xenum typekind kind;
  136. XMeaning *mp;
  137. X{
  138. X    Type *tp;
  139. X
  140. X    tp = maketype(kind);
  141. X    tp->meaning = mp;
  142. X    if (mp)
  143. X        mp->type = tp;
  144. X    return tp;
  145. X}
  146. X
  147. X
  148. X
  149. X
  150. XStatic Stmt *nullspecialproc(mp)
  151. XMeaning *mp;
  152. X{
  153. X    warning(format_s("Procedure %s not yet supported [118]", mp->name));
  154. X    if (curtok == TOK_LPAR)
  155. X        skipparens();
  156. X    return NULL;
  157. X}
  158. X
  159. XMeaning *makespecialproc(name, handler)
  160. Xchar *name;
  161. XStmt *(*handler)();
  162. X{
  163. X    Meaning *mp;
  164. X
  165. X    if (!handler)
  166. X        handler = nullspecialproc;
  167. X    mp = makestandardmeaning(MK_SPECIAL, name);
  168. X    mp->handler = (Expr *(*)())handler;
  169. X    return mp;
  170. X}
  171. X
  172. X
  173. X
  174. XStatic Stmt *nullstandardproc(ex)
  175. XExpr *ex;
  176. X{
  177. X    warning(format_s("Procedure %s not yet supported [118]", ((Meaning *)ex->val.i)->name));
  178. X    return makestmt_call(ex);
  179. X}
  180. X
  181. XMeaning *makestandardproc(name, handler)
  182. Xchar *name;
  183. XStmt *(*handler)();
  184. X{
  185. X    Meaning *mp;
  186. X
  187. X    if (!handler)
  188. X        handler = nullstandardproc;
  189. X    mp = findstandardmeaning(MK_FUNCTION, name);
  190. X    if (mp) {
  191. X    mp->handler = (Expr *(*)())handler;
  192. X    if (mp->isfunction) {
  193. X        warning(format_s("Procedure %s was declared as a function [119]", name));
  194. X        mp->isfunction = 0;
  195. X    }
  196. X    } else if (debug > 0)
  197. X    warning(format_s("Procedure %s was never declared [120]", name));
  198. X    return mp;
  199. X}
  200. X
  201. X
  202. X
  203. XStatic Expr *nullspecialfunc(mp)
  204. XMeaning *mp;
  205. X{
  206. X    warning(format_s("Function %s not yet supported [121]", mp->name));
  207. X    if (curtok == TOK_LPAR)
  208. X        skipparens();
  209. X    return makeexpr_long(0);
  210. X}
  211. X
  212. XMeaning *makespecialfunc(name, handler)
  213. Xchar *name;
  214. XExpr *(*handler)();
  215. X{
  216. X    Meaning *mp;
  217. X
  218. X    if (!handler)
  219. X        handler = nullspecialfunc;
  220. X    mp = makestandardmeaning(MK_SPECIAL, name);
  221. X    mp->isfunction = 1;
  222. X    mp->handler = handler;
  223. X    return mp;
  224. X}
  225. X
  226. X
  227. X
  228. XStatic Expr *nullstandardfunc(ex)
  229. XExpr *ex;
  230. X{
  231. X    warning(format_s("Function %s not yet supported [121]", ((Meaning *)ex->val.i)->name));
  232. X    return ex;
  233. X}
  234. X
  235. XMeaning *makestandardfunc(name, handler)
  236. Xchar *name;
  237. XExpr *(*handler)();
  238. X{
  239. X    Meaning *mp;
  240. X
  241. X    if (!handler)
  242. X        handler = nullstandardfunc;
  243. X    mp = findstandardmeaning(MK_FUNCTION, name);
  244. X    if (mp) {
  245. X    mp->handler = handler;
  246. X    if (!mp->isfunction) {
  247. X        warning(format_s("Function %s was declared as a procedure [122]", name));
  248. X        mp->isfunction = 1;
  249. X    }
  250. X    } else if (debug > 0)
  251. X    warning(format_s("Function %s was never declared [123]", name));
  252. X    return mp;
  253. X}
  254. X
  255. X
  256. X
  257. X
  258. XStatic Expr *nullspecialvar(mp)
  259. XMeaning *mp;
  260. X{
  261. X    warning(format_s("Variable %s not yet supported [124]", mp->name));
  262. X    if (curtok == TOK_LPAR || curtok == TOK_LBR)
  263. X        skipparens();
  264. X    return makeexpr_var(mp);
  265. X}
  266. X
  267. XMeaning *makespecialvar(name, handler)
  268. Xchar *name;
  269. XExpr *(*handler)();
  270. X{
  271. X    Meaning *mp;
  272. X
  273. X    if (!handler)
  274. X        handler = nullspecialvar;
  275. X    mp = makestandardmeaning(MK_SPVAR, name);
  276. X    mp->handler = handler;
  277. X    return mp;
  278. X}
  279. X
  280. X
  281. X
  282. X
  283. X
  284. Xvoid setup_decl()
  285. X{
  286. X    Meaning *mp, *mp2, *mp_turbo_shortint;
  287. X    Symbol *sym;
  288. X    Type *tp;
  289. X    int i;
  290. X
  291. X    numimports = 0;
  292. X    firstimport = 0;
  293. X    permimports = NULL;
  294. X    stringceiling = stringceiling | 1;   /* round up to odd */
  295. X    stringtypecachesize = (stringceiling + 1) >> 1;
  296. X    stringtypecache = ALLOC(stringtypecachesize, Type *, misc);
  297. X    curctxlast = NULL;
  298. X    curctx = NULL;   /* the meta-ctx has no parent ctx */
  299. X    curctx = nullctx = makestandardmeaning(MK_MODULE, "SYSTEM");
  300. X    strlist_add(&permimports, "SYSTEM")->value = (long)nullctx;
  301. X    ptrbase = NULL;
  302. X    tempvars = NULL;
  303. X    stmttempvars = NULL;
  304. X    tempvarcount = 0;
  305. X    deferallptrs = 0;
  306. X    silentalreadydef = 0;
  307. X    varstructdecllist = NULL;
  308. X    nonloclabelcount = -1;
  309. X    for (i = 0; i < stringtypecachesize; i++)
  310. X        stringtypecache[i] = NULL;
  311. X
  312. X    tp_integer = makestandardtype(TK_INTEGER, makestandardmeaning(MK_TYPE,
  313. X                     (integer16) ? "LONGINT" : "INTEGER"));
  314. X    tp_integer->smin = makeexpr_long(MININT);             /* "long" */
  315. X    tp_integer->smax = makeexpr_long(MAXINT);
  316. X
  317. X    if (sizeof_int >= 32) {
  318. X        tp_int = tp_integer;                              /* "int" */
  319. X    } else {
  320. X        tp_int = makestandardtype(TK_INTEGER,
  321. X                     (integer16 > 1) ? makestandardmeaning(MK_TYPE, "INTEGER")
  322. X                     : NULL);
  323. X        tp_int->smin = makeexpr_long(min_sshort);
  324. X        tp_int->smax = makeexpr_long(max_sshort);
  325. X    }
  326. X    mp = makestandardmeaning(MK_TYPE, "C_INT");
  327. X    mp->type = tp_int;
  328. X    if (!tp_int->meaning)
  329. X    tp_int->meaning = mp;
  330. X
  331. X    mp_unsigned = makestandardmeaning(MK_TYPE, "UNSIGNED");
  332. X    tp_unsigned = makestandardtype(TK_INTEGER, mp_unsigned);
  333. X    tp_unsigned->smin = makeexpr_long(0);                 /* "unsigned long" */
  334. X    tp_unsigned->smax = makeexpr_long(MAXINT);
  335. X
  336. X    if (sizeof_int >= 32) {
  337. X        tp_uint = tp_unsigned;                            /* "unsigned int" */
  338. X    mp_uint = mp_unsigned;
  339. X    } else {
  340. X    mp_uint = makestandardmeaning(MK_TYPE, "C_UINT");
  341. X        tp_uint = makestandardtype(TK_INTEGER, mp_uint);
  342. X        tp_uint->smin = makeexpr_long(0);
  343. X        tp_uint->smax = makeexpr_long(MAXINT);
  344. X    }
  345. X
  346. X    tp_sint = makestandardtype(TK_INTEGER, NULL);
  347. X    tp_sint->smin = copyexpr(tp_int->smin);               /* "signed int" */
  348. X    tp_sint->smax = copyexpr(tp_int->smax);
  349. X
  350. X    tp_char = makestandardtype(TK_CHAR, makestandardmeaning(MK_TYPE, "CHAR"));
  351. X    if (unsignedchar == 0) {
  352. X    tp_char->smin = makeexpr_long(-128);              /* "char" */
  353. X    tp_char->smax = makeexpr_long(127);
  354. X    } else {
  355. X    tp_char->smin = makeexpr_long(0);
  356. X    tp_char->smax = makeexpr_long(255);
  357. X    }
  358. X
  359. X    tp_charptr = makestandardtype(TK_POINTER, NULL);      /* "unsigned char *" */
  360. X    tp_charptr->basetype = tp_char;
  361. X    tp_char->pointertype = tp_charptr;
  362. X
  363. X    mp_schar = makestandardmeaning(MK_TYPE, "SCHAR");     /* "signed char" */
  364. X    tp_schar = makestandardtype(TK_CHAR, mp_schar);
  365. X    tp_schar->smin = makeexpr_long(-128);
  366. X    tp_schar->smax = makeexpr_long(127);
  367. X
  368. X    mp_uchar = makestandardmeaning(MK_TYPE, "UCHAR");     /* "unsigned char" */
  369. X    tp_uchar = makestandardtype(TK_CHAR, mp_uchar);
  370. X    tp_uchar->smin = makeexpr_long(0);
  371. X    tp_uchar->smax = makeexpr_long(255);
  372. X
  373. X    tp_boolean = makestandardtype(TK_BOOLEAN, makestandardmeaning(MK_TYPE, "BOOLEAN"));
  374. X    tp_boolean->smin = makeexpr_long(0);                  /* "boolean" */
  375. X    tp_boolean->smax = makeexpr_long(1);
  376. X
  377. X    sym = findsymbol("Boolean");
  378. X    sym->flags |= SSYNONYM;
  379. X    strlist_append(&sym->symbolnames, "===")->value = (long)tp_boolean->meaning->sym;
  380. X
  381. X    tp_real = makestandardtype(TK_REAL, makestandardmeaning(MK_TYPE, "REAL"));
  382. X                                                          /* "float" or "double" */
  383. X    mp = makestandardmeaning(MK_TYPE, "LONGREAL");
  384. X    if (doublereals)
  385. X    mp->type = tp_longreal = tp_real;
  386. X    else
  387. X    tp_longreal = makestandardtype(TK_REAL, mp);
  388. X
  389. X    tp_void = makestandardtype(TK_VOID, NULL);            /* "void" */
  390. X
  391. X    mp = makestandardmeaning(MK_TYPE, "SINGLE");
  392. X    if (doublereals)
  393. X    makestandardtype(TK_REAL, mp);
  394. X    else
  395. X    mp->type = tp_real;
  396. X    makestandardmeaning(MK_TYPE, "SHORTREAL")->type = mp->type;
  397. X    mp = makestandardmeaning(MK_TYPE, "DOUBLE");
  398. X    mp->type = tp_longreal;
  399. X    mp = makestandardmeaning(MK_TYPE, "EXTENDED");
  400. X    mp->type = tp_longreal;   /* good enough */
  401. X    mp = makestandardmeaning(MK_TYPE, "QUADRUPLE");
  402. X    mp->type = tp_longreal;   /* good enough */
  403. X
  404. X    tp_sshort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE,
  405. X                  (integer16 == 1) ? "INTEGER" : "SWORD"));
  406. X    tp_sshort->basetype = tp_integer;                     /* "short" */
  407. X    tp_sshort->smin = makeexpr_long(min_sshort);
  408. X    tp_sshort->smax = makeexpr_long(max_sshort);
  409. X
  410. X    if (integer16) {
  411. X    if (integer16 != 2) {
  412. X        mp = makestandardmeaning(MK_TYPE, "SWORD");
  413. X        mp->type = tp_sshort;
  414. X    }
  415. X    } else {
  416. X    mp = makestandardmeaning(MK_TYPE, "LONGINT");
  417. X    mp->type = tp_integer;
  418. X    }
  419. X
  420. X    tp_ushort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, modula2 ? "UWORD" : "WORD"));
  421. X    tp_ushort->basetype = tp_integer;                     /* "unsigned short" */
  422. X    tp_ushort->smin = makeexpr_long(0);
  423. X    tp_ushort->smax = makeexpr_long(max_ushort);
  424. X
  425. X    mp = makestandardmeaning(MK_TYPE, "CARDINAL");
  426. X    mp->type = (integer16) ? tp_ushort : tp_unsigned;
  427. X    mp = makestandardmeaning(MK_TYPE, "LONGCARD");
  428. X    mp->type = tp_unsigned;
  429. X
  430. X    if (modula2) {
  431. X    mp = makestandardmeaning(MK_TYPE, "WORD");
  432. X    mp->type = tp_integer;
  433. X    } else {
  434. X    makestandardmeaning(MK_TYPE, "UWORD")->type = tp_ushort;
  435. X    }
  436. X
  437. X    tp_sbyte = makestandardtype(TK_SUBR, NULL);           /* "signed char" */
  438. X    tp_sbyte->basetype = tp_integer;
  439. X    tp_sbyte->smin = makeexpr_long(min_schar);
  440. X    tp_sbyte->smax = makeexpr_long(max_schar);
  441. X
  442. X    mp_turbo_shortint = (which_lang == LANG_TURBO) ? makestandardmeaning(MK_TYPE, "SHORTINT") : NULL;
  443. X    mp = makestandardmeaning(MK_TYPE, "SBYTE");
  444. X    if (needsignedbyte || signedchars == 1 || hassignedchar) {
  445. X    mp->type = tp_sbyte;
  446. X    if (mp_turbo_shortint)
  447. X        mp_turbo_shortint->type = tp_sbyte;
  448. X    tp_sbyte->meaning = mp_turbo_shortint ? mp_turbo_shortint : mp;
  449. X    } else {
  450. X    mp->type = tp_sshort;
  451. X    if (mp_turbo_shortint)
  452. X        mp_turbo_shortint->type = tp_sshort;
  453. X    }
  454. X
  455. X    tp_ubyte = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, "BYTE"));
  456. X    tp_ubyte->basetype = tp_integer;                      /* "unsigned char" */
  457. X    tp_ubyte->smin = makeexpr_long(0);
  458. X    tp_ubyte->smax = makeexpr_long(max_uchar);
  459. X
  460. X    if (signedchars == 1)
  461. X        tp_abyte = tp_sbyte;                              /* "char" */
  462. X    else if (signedchars == 0)
  463. X        tp_abyte = tp_ubyte;
  464. X    else {
  465. X        tp_abyte = makestandardtype(TK_SUBR, NULL);
  466. X        tp_abyte->basetype = tp_integer;
  467. X        tp_abyte->smin = makeexpr_long(0);
  468. X        tp_abyte->smax = makeexpr_long(max_schar);
  469. X    }
  470. X
  471. X    mp = makestandardmeaning(MK_TYPE, "POINTER");
  472. X    mp2 = makestandardmeaning(MK_TYPE, "ANYPTR");
  473. X    tp_anyptr = makestandardtype(TK_POINTER, (which_lang == LANG_HP) ? mp2 : mp);
  474. X    ((which_lang == LANG_HP) ? mp : mp2)->type = tp_anyptr;
  475. X    tp_anyptr->basetype = tp_void;                        /* "void *" */
  476. X    tp_void->pointertype = tp_anyptr;
  477. X
  478. X    if (useAnyptrMacros == 1) {
  479. X        tp_special_anyptr = makestandardtype(TK_SUBR, NULL);
  480. X        tp_special_anyptr->basetype = tp_integer;
  481. X        tp_special_anyptr->smin = makeexpr_long(0);
  482. X        tp_special_anyptr->smax = makeexpr_long(max_schar);
  483. X    } else
  484. X        tp_special_anyptr = NULL;
  485. X
  486. X    tp_proc = maketype(TK_PROCPTR);
  487. X    tp_proc->basetype = maketype(TK_FUNCTION);
  488. X    tp_proc->basetype->basetype = tp_void;
  489. X    tp_proc->escale = 1;   /* saved "hasstaticlinks" */
  490. X
  491. X    tp_str255 = makestandardtype(TK_STRING, NULL);             /* "Char []" */
  492. X    tp_str255->basetype = tp_char;
  493. X    tp_str255->indextype = makestandardtype(TK_SUBR, NULL);
  494. X    tp_str255->indextype->basetype = tp_integer;
  495. X    tp_str255->indextype->smin = makeexpr_long(0);
  496. X    tp_str255->indextype->smax = makeexpr_long(stringceiling);
  497. X
  498. X    tp_strptr = makestandardtype(TK_POINTER, NULL);            /* "Char *" */
  499. X    tp_str255->pointertype = tp_strptr;
  500. X    tp_strptr->basetype = tp_str255;
  501. X
  502. X    mp_string = makestandardmeaning(MK_TYPE, "STRING");
  503. X    tp = makestandardtype(TK_STRING, mp_string);
  504. X    tp->basetype = tp_char;
  505. X    tp->indextype = tp_str255->indextype;
  506. X
  507. X    tp_smallset = maketype(TK_SMALLSET);
  508. X    tp_smallset->basetype = tp_integer;
  509. X    tp_smallset->indextype = tp_boolean;
  510. X
  511. X    tp_text = makestandardtype(TK_POINTER, makestandardmeaning(MK_TYPE, "TEXT"));
  512. X    tp_text->basetype = makestandardtype(TK_FILE, NULL);       /* "FILE *" */
  513. X    tp_text->basetype->basetype = tp_char;
  514. X    tp_text->basetype->pointertype = tp_text;
  515. X
  516. X    tp_jmp_buf = makestandardtype(TK_SPECIAL, NULL);
  517. X
  518. X    mp = makestandardmeaning(MK_TYPE, "INTERACTIVE");
  519. X    mp->type = tp_text;
  520. X
  521. X    mp = makestandardmeaning(MK_TYPE, "BITSET");
  522. X    mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
  523. X                        makeexpr_long(setbits-1)));
  524. X    mp->type->meaning = mp;
  525. X
  526. X    mp = makestandardmeaning(MK_TYPE, "INTSET");
  527. X    mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
  528. X                        makeexpr_long(defaultsetsize-1)));
  529. X    mp->type->meaning = mp;
  530. X
  531. X    mp_input = makestandardmeaning(MK_VAR, "INPUT");
  532. X    mp_input->type = tp_text;
  533. X    mp_input->name = stralloc("stdin");
  534. X    ex_input = makeexpr_var(mp_input);
  535. X
  536. X    mp_output = makestandardmeaning(MK_VAR, "OUTPUT");
  537. X    mp_output->type = tp_text;
  538. X    mp_output->name = stralloc("stdout");
  539. X    ex_output = makeexpr_var(mp_output);
  540. X
  541. X    mp_stderr = makestandardmeaning(MK_VAR, "STDERR");
  542. X    mp_stderr->type = tp_text;
  543. X    mp_stderr->name = stralloc("stderr");
  544. X
  545. X    mp_escapecode = makestandardmeaning(MK_VAR, "ESCAPECODE");
  546. X    mp_escapecode->type = tp_sshort;
  547. X    mp_escapecode->name = stralloc(name_ESCAPECODE);
  548. X
  549. X    mp_ioresult = makestandardmeaning(MK_VAR, "IORESULT");
  550. X    mp_ioresult->type = tp_integer;
  551. X    mp_ioresult->name = stralloc(name_IORESULT);
  552. X
  553. X    mp_false = makestandardmeaning(MK_CONST, "FALSE");
  554. X    mp_false->type = mp_false->val.type = tp_boolean;
  555. X    mp_false->val.i = 0;
  556. X
  557. X    mp_true = makestandardmeaning(MK_CONST, "TRUE");
  558. X    mp_true->type = mp_true->val.type = tp_boolean;
  559. X    mp_true->val.i = 1;
  560. X
  561. X    mp_maxint = makestandardmeaning(MK_CONST, "MAXINT");
  562. X    mp_maxint->type = mp_maxint->val.type = tp_integer;
  563. X    mp_maxint->val.i = MAXINT;
  564. X    mp_maxint->name = stralloc((integer16) ? "SHORT_MAX" :
  565. X                               (sizeof_int >= 32) ? "INT_MAX" : "LONG_MAX");
  566. X
  567. X    mp = makestandardmeaning(MK_CONST, "MAXLONGINT");
  568. X    mp->type = mp->val.type = tp_integer;
  569. X    mp->val.i = MAXINT;
  570. X    mp->name = stralloc("LONG_MAX");
  571. X
  572. X    mp_minint = makestandardmeaning(MK_CONST, "MININT");
  573. X    mp_minint->type = mp_minint->val.type = tp_integer;
  574. X    mp_minint->val.i = MININT;
  575. X    mp_minint->name = stralloc((integer16) ? "SHORT_MIN" :
  576. X                               (sizeof_int >= 32) ? "INT_MIN" : "LONG_MIN");
  577. X
  578. X    mp = makestandardmeaning(MK_CONST, "MAXCHAR");
  579. X    mp->type = mp->val.type = tp_char;
  580. X    mp->val.i = 127;
  581. X    mp->name = stralloc("CHAR_MAX");
  582. X
  583. X    mp = makestandardmeaning(MK_CONST, "MINCHAR");
  584. X    mp->type = mp->val.type = tp_char;
  585. X    mp->val.i = 0;
  586. X    mp->anyvarflag = 1;
  587. X
  588. X    mp = makestandardmeaning(MK_CONST, "BELL");
  589. X    mp->type = mp->val.type = tp_char;
  590. X    mp->val.i = 7;
  591. X    mp->anyvarflag = 1;
  592. X
  593. X    mp = makestandardmeaning(MK_CONST, "TAB");
  594. X    mp->type = mp->val.type = tp_char;
  595. X    mp->val.i = 9;
  596. X    mp->anyvarflag = 1;
  597. X
  598. X    mp_str_hp = mp_str_turbo = NULL;
  599. X    mp_val_modula = mp_val_turbo = NULL;
  600. X    mp_blockread_ucsd = mp_blockread_turbo = NULL;
  601. X    mp_blockwrite_ucsd = mp_blockwrite_turbo = NULL;
  602. X    mp_dec_dec = mp_dec_turbo = NULL;
  603. X}
  604. X
  605. X
  606. X
  607. X/* This makes sure that if A imports B and then C, C's interface is not
  608. X   parsed in the environment of B */
  609. Xint push_imports()
  610. X{
  611. X    int mark = firstimport;
  612. X    Meaning *mp;
  613. X
  614. X    while (firstimport < numimports) {
  615. X    if (!strlist_cifind(permimports, importlist[firstimport]->sym->name)) {
  616. X        for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
  617. X        mp->isactive = 0;
  618. X    }
  619. X        firstimport++;
  620. X    }
  621. X    return mark;
  622. X}
  623. X
  624. X
  625. X
  626. Xvoid pop_imports(mark)
  627. Xint mark;
  628. X{
  629. X    Meaning *mp;
  630. X
  631. X    while (firstimport > mark) {
  632. X        firstimport--;
  633. X        for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
  634. X            mp->isactive = 1;
  635. X    }
  636. X}
  637. X
  638. X
  639. X
  640. Xvoid import_ctx(ctx)
  641. XMeaning *ctx;
  642. X{
  643. X    Meaning *mp;
  644. X    int i;
  645. X
  646. X    for (i = firstimport; i < numimports && importlist[i] != ctx; i++) ;
  647. X    if (i >= numimports) {
  648. X        if (numimports == MAXIMPORTS)
  649. X            error(format_d("Maximum of %d simultaneous imports exceeded", MAXIMPORTS));
  650. X        importlist[numimports++] = ctx;
  651. X    }
  652. X    for (mp = ctx->cbase; mp; mp = mp->cnext) {
  653. X        if (mp->exported)
  654. X            mp->isactive = 1;
  655. X    }
  656. X}
  657. X
  658. X
  659. X
  660. Xvoid perm_import(ctx)
  661. XMeaning *ctx;
  662. X{
  663. X    Meaning *mp;
  664. X
  665. X    /* Import permanently, as in Turbo's "system" unit */
  666. X    for (mp = ctx->cbase; mp; mp = mp->cnext) {
  667. X        if (mp->exported)
  668. X            mp->isactive = 1;
  669. X    }
  670. X}
  671. X
  672. X
  673. X
  674. Xvoid unimport(mark)
  675. Xint mark;
  676. X{
  677. X    Meaning *mp;
  678. X
  679. X    while (numimports > mark) {
  680. X        numimports--;
  681. X    if (!strlist_cifind(permimports, importlist[numimports]->sym->name)) {
  682. X        for (mp = importlist[numimports]->cbase; mp; mp = mp->cnext)
  683. X        mp->isactive = 0;
  684. X    }
  685. X    }
  686. X}
  687. X
  688. X
  689. X
  690. X
  691. Xvoid activatemeaning(mp)
  692. XMeaning *mp;
  693. X{
  694. X    Meaning *mp2;
  695. X
  696. X    if (debug>1) fprintf(outf, "Reviving %s\n", curctxlast->name);
  697. X    mp->isactive = 1;
  698. X    if (mp->sym->mbase != mp) {     /* move to front of symbol list */
  699. X        mp2 = mp->sym->mbase;
  700. X        for (;;) {
  701. X            if (!mp2) {
  702. X        /* Not on symbol list: must be a special kludge meaning */
  703. X                return;
  704. X            }
  705. X            if (mp2->snext == mp)
  706. X                break;
  707. X            mp2 = mp2->snext;
  708. X        }
  709. X        mp2->snext = mp->snext;
  710. X        mp->snext = mp->sym->mbase;
  711. X        mp->sym->mbase = mp;
  712. X    }
  713. X}
  714. X
  715. X
  716. X
  717. Xvoid pushctx(ctx)
  718. XMeaning *ctx;
  719. X{
  720. X    struct ctxstack *top;
  721. X
  722. X    top = ALLOC(1, struct ctxstack, ctxstacks);
  723. X    top->ctx = curctx;
  724. X    top->ctxlast = curctxlast;
  725. X    top->tempvars = tempvars;
  726. X    top->tempvarcount = tempvarcount;
  727. X    top->importmark = numimports;
  728. X    top->next = ctxtop;
  729. X    ctxtop = top;
  730. X    curctx = ctx;
  731. X    curctxlast = ctx->cbase;
  732. X    if (curctxlast) {
  733. X        activatemeaning(curctxlast);
  734. X        while (curctxlast->cnext) {
  735. X            curctxlast = curctxlast->cnext;
  736. X            activatemeaning(curctxlast);
  737. X        }
  738. X    }
  739. X    tempvars = NULL;
  740. X    tempvarcount = 0;
  741. X    if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
  742. X    progress();
  743. X}
  744. X
  745. X
  746. X
  747. Xvoid popctx()
  748. X{
  749. X    struct ctxstack *top;
  750. X    struct tempvarlist *tv;
  751. X    Meaning *mp;
  752. X
  753. X    if (!strlist_cifind(permimports, curctx->sym->name)) {
  754. X    for (mp = curctx->cbase; mp; mp = mp->cnext) {
  755. X        if (debug>1) fprintf(outf, "Hiding %s\n", mp->name);
  756. X        mp->isactive = 0;
  757. X    }
  758. X    }
  759. X    top = ctxtop;
  760. X    ctxtop = top->next;
  761. X    curctx = top->ctx;
  762. X    curctxlast = top->ctxlast;
  763. X    while (tempvars) {
  764. X        tv = tempvars->next;
  765. X        FREE(tempvars);
  766. X        tempvars = tv;
  767. X    }
  768. X    tempvars = top->tempvars;
  769. X    tempvarcount = top->tempvarcount;
  770. X    unimport(top->importmark);
  771. X    FREE(top);
  772. X    if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
  773. X    progress();
  774. X}
  775. X
  776. X
  777. X
  778. Xvoid forget_ctx(ctx, all)
  779. XMeaning *ctx;
  780. Xint all;
  781. X{
  782. X    register Meaning *mp, **mpprev, *mp2, **mpp2;
  783. X
  784. X    if (ctx->kind == MK_FUNCTION && ctx->isfunction && ctx->cbase)
  785. X    mpprev = &ctx->cbase->cnext;   /* Skip return-value variable */
  786. X    else
  787. X    mpprev = &ctx->cbase;
  788. X    while ((mp = *mpprev) != NULL) {
  789. X    if (all ||
  790. X        (mp->kind != MK_PARAM &&
  791. X         mp->kind != MK_VARPARAM)) {
  792. X        *mpprev = mp->cnext;
  793. X        mpp2 = &mp->sym->mbase;
  794. X        while ((mp2 = *mpp2) != NULL && mp2 != mp)
  795. X        mpp2 = &mp2->snext;
  796. X        if (mp2)
  797. X        *mpp2 = mp2->snext;
  798. X        if (mp->kind == MK_CONST)
  799. X        free_value(&mp->val);
  800. X        freeexpr(mp->constdefn);
  801. X        if (mp->cbase)
  802. X        forget_ctx(mp, 1);
  803. X        if (mp->kind == MK_FUNCTION && mp->val.i)
  804. X        free_stmt((Stmt *)mp->val.i);
  805. X        strlist_empty(&mp->comments);
  806. X        if (mp->name)
  807. X        FREE(mp->name);
  808. X        if (mp->othername)
  809. X        FREE(mp->othername);
  810. X        FREE(mp);
  811. X    } else
  812. X        mpprev = &mp->cnext;
  813. X    }
  814. X}
  815. X
  816. X
  817. X
  818. X
  819. Xvoid handle_nameof()
  820. X{
  821. X    Strlist *sl, *sl2;
  822. X    Symbol *sp;
  823. X    char *cp;
  824. X
  825. X    for (sl = nameoflist; sl; sl = sl->next) {
  826. X        cp = my_strchr(sl->s, '.');
  827. X        if (cp) {
  828. X            sp = findsymbol(fixpascalname(cp + 1));
  829. X            sl2 = strlist_add(&sp->symbolnames, 
  830. X                              format_ds("%.*s", (int)(cp - sl->s), sl->s));
  831. X        } else {
  832. X            sp = findsymbol(fixpascalname(sl->s));
  833. X            sl2 = strlist_add(&sp->symbolnames, "");
  834. X        }
  835. X        sl2->value = sl->value;
  836. X        if (debug > 0)
  837. X            fprintf(outf, "symbol %s gets \"%s\" -> \"%s\"\n",
  838. X                          sp->name, sl2->s, sl2->value);
  839. X    }
  840. X    strlist_empty(&nameoflist);
  841. X}
  842. X
  843. X
  844. X
  845. XStatic void initmeaning(mp)
  846. XMeaning *mp;
  847. X{
  848. X/*    mp->serial = curserial = ++serialcount;    */
  849. X    mp->cbase = NULL;
  850. X    mp->xnext = NULL;
  851. X    mp->othername = NULL;
  852. X    mp->type = NULL;
  853. X    mp->needvarstruct = 0;
  854. X    mp->varstructflag = 0;
  855. X    mp->wasdeclared = 0;
  856. X    mp->isforward = 0;
  857. X    mp->isfunction = 0;
  858. X    mp->istemporary = 0;
  859. X    mp->volatilequal = 0;
  860. X    mp->constqual = 0;
  861. X    mp->warnifused = (warnnames > 0);
  862. X    mp->constdefn = NULL;
  863. X    mp->val.i = 0;
  864. X    mp->val.s = NULL;
  865. X    mp->val.type = NULL;
  866. X    mp->refcount = 1;
  867. X    mp->anyvarflag = 0;
  868. X    mp->isactive = 1;
  869. X    mp->exported = 0;
  870. X    mp->handler = NULL;
  871. X    mp->dumped = 0;
  872. X    mp->isreturn = 0;
  873. X    mp->fakeparam = 0;
  874. X    mp->namedfile = 0;
  875. X    mp->bufferedfile = 0;
  876. X    mp->comments = NULL;
  877. X}
  878. X
  879. X
  880. X
  881. Xint issafename(sp, isglobal, isdefine)
  882. XSymbol *sp;
  883. Xint isglobal, isdefine;
  884. X{
  885. X    if (isdefine && curctx->kind != MK_FUNCTION) {
  886. X    if (sp->flags & FWDPARAM)
  887. X        return 0;
  888. X    }
  889. X    if ((sp->flags & AVOIDNAME) ||
  890. X    (isdefine && (sp->flags & AVOIDFIELD)) ||
  891. X        (isglobal && (sp->flags & AVOIDGLOB)))
  892. X        return 0;
  893. X    else
  894. X        return 1;
  895. X}
  896. X
  897. X
  898. X
  899. Xstatic Meaning *enum_tname;
  900. X
  901. Xvoid setupmeaning(mp, sym, kind, namekind)
  902. XMeaning *mp;
  903. XSymbol *sym;
  904. Xenum meaningkind kind, namekind;
  905. X{
  906. X    char *name, *symfmt, *editfmt, *cp, *cp2;
  907. X    int altnum, isglobal, isdefine;
  908. X    Symbol *sym2;
  909. X    Strlist *sl;
  910. X
  911. X    if (!sym)
  912. X    sym = findsymbol("Spam");   /* reduce crashes due to internal errors */
  913. X    if (sym->mbase && sym->mbase->ctx == curctx &&
  914. X    curctx != NULL && !silentalreadydef)
  915. X        alreadydef(sym);
  916. X    mp->sym = sym;
  917. X    mp->snext = sym->mbase;
  918. X    sym->mbase = mp;
  919. X    if (sym == curtoksym) {
  920. X    sym->kwtok = TOK_NONE;
  921. X    sym->flags &= ~KWPOSS;
  922. X    }
  923. X    mp->ctx = curctx;
  924. X    mp->kind = kind;
  925. X    if (pascalcasesens && curctx && curctx->sym && kind != MK_SYNONYM &&
  926. X    strlist_cifind(permimports, curctx->sym->name)) { /* a built-in name */
  927. X    Meaning *mp2;
  928. X    if (islower(sym->name[0]))
  929. X        sym2 = findsymbol(strupper(sym->name));
  930. X    else
  931. X        sym2 = findsymbol(strlower(sym->name));
  932. X    mp2 = addmeaning(sym2, MK_SYNONYM);
  933. X    mp2->xnext = mp;
  934. X    }
  935. X    if (kind == MK_VAR) {
  936. X        sl = strlist_find(varmacros, sym->name);
  937. X        if (sl) {
  938. X            kind = namekind = MK_VARMAC;
  939. X            mp->constdefn = (Expr *)sl->value;
  940. X            strlist_delete(&varmacros, sl);
  941. X        }
  942. X    }
  943. X    if (kind == MK_FUNCTION || kind == MK_SPECIAL) {
  944. X        sl = strlist_find(funcmacros, sym->name);
  945. X        if (sl) {
  946. X            mp->constdefn = (Expr *)sl->value;
  947. X            strlist_delete(&funcmacros, sl);
  948. X        }
  949. X    }
  950. X    if (kind == MK_VAR || kind == MK_VARREF || kind == MK_VARMAC ||
  951. X    kind == MK_TYPE || kind == MK_CONST || kind == MK_FUNCTION) {
  952. X        mp->exported = (blockkind == TOK_IMPORT || blockkind == TOK_EXPORT);
  953. X    if (blockkind == TOK_IMPORT)
  954. X        mp->wasdeclared = 1;   /* suppress future declaration */
  955. X    } else
  956. X        mp->exported = 0;
  957. X    if (sym == curtoksym)
  958. X        name = curtokcase;
  959. X    else
  960. X        name = sym->name;
  961. X    isdefine = (namekind == MK_CONST);
  962. X    isglobal = (!curctx ||
  963. X        curctx->kind != MK_FUNCTION ||
  964. X                namekind == MK_FUNCTION ||
  965. X        namekind == MK_TYPE ||
  966. X                isdefine) &&
  967. X               (curctx != nullctx);
  968. X    mp->refcount = isglobal ? 1 : 0;   /* make sure globals don't disappear */
  969. X    if (namekind == MK_SYNONYM)
  970. X    return;
  971. X    if (!mp->exported || !*exportsymbol)
  972. X        symfmt = "";
  973. X    else if (*export_symbol && my_strchr(name, '_'))
  974. X        symfmt = export_symbol;
  975. X    else
  976. X        symfmt = exportsymbol;
  977. X    wasaliased = 0;
  978. X    if (*externalias && !my_strchr(externalias, '%')) {
  979. X        register int i;
  980. X        name = format_s("%s", externalias);
  981. X        i = numparams;
  982. X        while (--i >= 0 && strcmp(rctable[i].name, "ALIAS")) ;
  983. X        if (i < 0 || !undooption(i, ""))
  984. X            *externalias = 0;
  985. X        wasaliased = 1;
  986. X    } else if (sym->symbolnames) {
  987. X        if (curctx) {
  988. X            if (debug > 2)
  989. X                fprintf(outf, "checking for \"%s\" of %s\n", curctx->name, sym->name);
  990. X            sl = strlist_cifind(sym->symbolnames, curctx->sym->name);
  991. X            if (sl) {
  992. X                if (debug > 2)
  993. X                    fprintf(outf, "found \"%s\"\n", sl->value);
  994. X                name = (char *)sl->value;
  995. X                wasaliased = 1;
  996. X            }
  997. X        }
  998. X        if (!wasaliased) {
  999. X            if (debug > 2)
  1000. X                fprintf(outf, "checking for \"\" of %s\n", sym->name);
  1001. X            sl = strlist_find(sym->symbolnames, "");
  1002. X            if (sl) {
  1003. X                if (debug > 2)
  1004. X                    fprintf(outf, "found \"%s\"\n", sl->value);
  1005. X                name = (char *)sl->value;
  1006. X                wasaliased = 1;
  1007. X            }
  1008. X        }
  1009. X    }
  1010. X    if (!*symfmt || wasaliased)
  1011. X    symfmt = "%s";
  1012. X    altnum = -1;
  1013. X    do {
  1014. X        altnum++;
  1015. X        cp = format_ss(symfmt, name, curctx ? curctx->name : "");
  1016. X    switch (namekind) {
  1017. X
  1018. X      case MK_CONST:
  1019. X        editfmt = constformat;
  1020. X        break;
  1021. X
  1022. X      case MK_MODULE:
  1023. X        editfmt = moduleformat;
  1024. X        break;
  1025. X
  1026. X      case MK_FUNCTION:
  1027. X        editfmt = functionformat;
  1028. X        break;
  1029. X
  1030. X      case MK_VAR:
  1031. X      case MK_VARPARAM:
  1032. X      case MK_VARREF:
  1033. X      case MK_VARMAC:
  1034. X      case MK_SPVAR:
  1035. X        editfmt = varformat;
  1036. X        break;
  1037. X
  1038. X      case MK_TYPE:
  1039. X        editfmt = typeformat;
  1040. X        break;
  1041. X
  1042. X      case MK_VARIANT:   /* A true kludge! */
  1043. X        editfmt = enumformat;
  1044. X        break;
  1045. X
  1046. X      default:
  1047. X        editfmt = "";
  1048. X    }
  1049. X    if (!*editfmt)
  1050. X        editfmt = symbolformat;
  1051. X    if (*editfmt)
  1052. X        if (editfmt == enumformat)
  1053. X        cp = format_ss(editfmt, cp,
  1054. X                   enum_tname ? enum_tname->name : "ENUM");
  1055. X        else
  1056. X        cp = format_ss(editfmt, cp,
  1057. X                   curctx ? curctx->name : "");
  1058. X    if (dollar_idents == 2) {
  1059. X        for (cp2 = cp; *cp2; cp2++)
  1060. X        if (*cp2 == '$' || *cp2 == '%')
  1061. X            *cp2 = '_';
  1062. X    }
  1063. X        sym2 = findsymbol(findaltname(cp, altnum));
  1064. X    } while (!issafename(sym2, isglobal, isdefine) &&
  1065. X         namekind != MK_MODULE && !wasaliased);
  1066. X    mp->name = stralloc(sym2->name);
  1067. X    if (sym2->flags & WARNNAME)
  1068. X        note(format_s("A symbol named %s was defined [100]", mp->name));
  1069. X    if (isglobal) {
  1070. X        switch (namekind) {     /* prevent further name conflicts */
  1071. X
  1072. X            case MK_CONST:
  1073. X        case MK_VARIANT:
  1074. X            case MK_TYPE:
  1075. X                sym2->flags |= AVOIDNAME;
  1076. X                break;
  1077. X
  1078. X            case MK_VAR:
  1079. X            case MK_VARREF:
  1080. X            case MK_FUNCTION:
  1081. X                sym2->flags |= AVOIDGLOB;
  1082. X                break;
  1083. X
  1084. X        default:
  1085. X        /* name is completely local */
  1086. X        break;
  1087. X        }
  1088. X    }
  1089. X    if (debug > 4)
  1090. X    fprintf(outf, "Created meaning %s\n", mp->name);
  1091. X}
  1092. X
  1093. X
  1094. X
  1095. XMeaning *addmeaningas(sym, kind, namekind)
  1096. XSymbol *sym;
  1097. Xenum meaningkind kind, namekind;
  1098. X{
  1099. X    Meaning *mp;
  1100. X
  1101. X    mp = ALLOC(1, Meaning, meanings);
  1102. X    initmeaning(mp);
  1103. X    setupmeaning(mp, sym, kind, namekind);
  1104. X    mp->cnext = NULL;
  1105. X    if (curctx) {
  1106. X        if (curctxlast)
  1107. X            curctxlast->cnext = mp;
  1108. X        else
  1109. X            curctx->cbase = mp;
  1110. X        curctxlast = mp;
  1111. X    }
  1112. X    return mp;
  1113. X}
  1114. X
  1115. X
  1116. X
  1117. XMeaning *addmeaning(sym, kind)
  1118. XSymbol *sym;
  1119. Xenum meaningkind kind;
  1120. X{
  1121. X    return addmeaningas(sym, kind, kind);
  1122. X}
  1123. X
  1124. X
  1125. X
  1126. XMeaning *addmeaningafter(mpprev, sym, kind)
  1127. XMeaning *mpprev;
  1128. XSymbol *sym;
  1129. Xenum meaningkind kind;
  1130. X{
  1131. X    Meaning *mp;
  1132. X
  1133. X    if (!mpprev->cnext && mpprev->ctx == curctx)
  1134. X        return addmeaning(sym, kind);
  1135. X    mp = ALLOC(1, Meaning, meanings);
  1136. X    initmeaning(mp);
  1137. X    setupmeaning(mp, sym, kind, kind);
  1138. X    mp->ctx = mpprev->ctx;
  1139. X    mp->cnext = mpprev->cnext;
  1140. X    mpprev->cnext = mp;
  1141. X    return mp;
  1142. X}
  1143. X
  1144. X
  1145. Xvoid unaddmeaning(mp)
  1146. XMeaning *mp;
  1147. X{
  1148. X    Meaning *prev;
  1149. X
  1150. X    prev = mp->ctx;
  1151. X    while (prev && prev != mp)
  1152. X    prev = prev->cnext;
  1153. X    if (prev)
  1154. X    prev->cnext = mp->cnext;
  1155. X    else
  1156. X    mp->ctx = mp->cnext;
  1157. X    if (!mp->cnext && mp->ctx == curctx)
  1158. X    curctxlast = prev;
  1159. X}
  1160. X
  1161. X
  1162. Xvoid readdmeaning(mp)
  1163. XMeaning *mp;
  1164. X{
  1165. X    mp->cnext = NULL;
  1166. X    if (curctx) {
  1167. X        if (curctxlast)
  1168. X            curctxlast->cnext = mp;
  1169. X        else
  1170. X            curctx->cbase = mp;
  1171. X        curctxlast = mp;
  1172. X    }
  1173. X}
  1174. X
  1175. X
  1176. XMeaning *addfield(sym, flast, rectype, tname)
  1177. XSymbol *sym;
  1178. XMeaning ***flast;
  1179. XType *rectype;
  1180. XMeaning *tname;
  1181. X{
  1182. X    Meaning *mp;
  1183. X    int altnum;
  1184. X    Symbol *sym2;
  1185. X    Strlist *sl;
  1186. X    char *name, *name2;
  1187. X
  1188. X    mp = ALLOC(1, Meaning, meanings);
  1189. X    initmeaning(mp);
  1190. X    mp->sym = sym;
  1191. X    if (sym) {
  1192. X        mp->snext = sym->fbase;
  1193. X        sym->fbase = mp;
  1194. X        if (sym == curtoksym)
  1195. X            name2 = curtokcase;
  1196. X        else
  1197. X            name2 = sym->name;
  1198. X    name = name2;
  1199. X        if (tname)
  1200. X            sl = strlist_find(fieldmacros,
  1201. X                              format_ss("%s.%s", tname->sym->name, sym->name));
  1202. X        else
  1203. X            sl = NULL;
  1204. X        if (sl) {
  1205. X            mp->constdefn = (Expr *)sl->value;
  1206. X            strlist_delete(&fieldmacros, sl);
  1207. X            altnum = 0;
  1208. X        } else {
  1209. X            altnum = -1;
  1210. X            do {
  1211. X                altnum++;
  1212. X        if (*fieldformat)
  1213. X            name = format_ss(fieldformat, name2,
  1214. X                     tname && tname->name ? tname->name
  1215. X                                          : "FIELD");
  1216. X                sym2 = findsymbol(findaltname(name, altnum));
  1217. X            } while (!issafename(sym2, 0, 0) ||
  1218. X             ((sym2->flags & AVOIDFIELD) && !reusefieldnames));
  1219. X        sym2->flags |= AVOIDFIELD;
  1220. X        }
  1221. X        mp->kind = MK_FIELD;
  1222. X        mp->name = stralloc(findaltname(name, altnum));
  1223. X    } else {
  1224. X        mp->name = stralloc("(variant)");
  1225. X        mp->kind = MK_VARIANT;
  1226. X    }
  1227. X    mp->cnext = NULL;
  1228. X    **flast = mp;
  1229. X    *flast = &(mp->cnext);
  1230. X    mp->ctx = NULL;
  1231. X    mp->rectype = rectype;
  1232. X    mp->val.i = 0;
  1233. X    return mp;
  1234. X}
  1235. X
  1236. X
  1237. X
  1238. X
  1239. X
  1240. Xint isfiletype(type)
  1241. XType *type;
  1242. X{
  1243. X    return (type->kind == TK_POINTER &&
  1244. X            type->basetype->kind == TK_FILE);
  1245. X}
  1246. X
  1247. X
  1248. XMeaning *isfilevar(ex)
  1249. XExpr *ex;
  1250. X{
  1251. X    Meaning *mp;
  1252. X
  1253. X    if (ex->kind == EK_VAR) {
  1254. X    mp = (Meaning *)ex->val.i;
  1255. X    if (mp->kind == MK_VAR)
  1256. X        return mp;
  1257. X    } else if (ex->kind == EK_DOT) {
  1258. X    mp = (Meaning *)ex->val.i;
  1259. X    if (mp && mp->kind == MK_FIELD)
  1260. X        return mp;
  1261. X    }
  1262. X    return NULL;
  1263. X}
  1264. X
  1265. X
  1266. X
  1267. XType *findbasetype_(type, flags)
  1268. XType *type;
  1269. Xint flags;
  1270. X{
  1271. X    long smin, smax;
  1272. X
  1273. X    for (;;) {
  1274. X        switch (type->kind) {
  1275. X
  1276. X            case TK_POINTER:
  1277. X                if (type->basetype == tp_void) {     /* ANYPTR */
  1278. X                    if (tp_special_anyptr)
  1279. X                        return tp_special_anyptr;   /* write "Anyptr" */
  1280. X                    if (!voidstar)
  1281. X                        return tp_abyte;    /* write "char *", not "void *" */
  1282. X                }
  1283. X                switch (type->basetype->kind) {
  1284. X
  1285. X                    case TK_ARRAY:       /* use basetype's basetype: */
  1286. X                    case TK_STRING:      /* ^array[5] of array[3] of integer */
  1287. X                    case TK_SET:         /*  => int (*a)[3]; */
  1288. X                if (stararrays == 1 ||
  1289. X                !(flags & ODECL_FREEARRAY) ||
  1290. X                type->basetype->structdefd) {
  1291. X                type = type->basetype;
  1292. X                flags &= ~ODECL_CHARSTAR;
  1293. X            }
  1294. X                        break;
  1295. X
  1296. X            default:
  1297. X            break;
  1298. X                }
  1299. X                break;
  1300. X
  1301. X            case TK_FUNCTION:
  1302. X            case TK_STRING:
  1303. X            case TK_SET:
  1304. X            case TK_SMALLSET:
  1305. X            case TK_SMALLARRAY:
  1306. X                if (!type->basetype)
  1307. X                    return type;
  1308. X                break;
  1309. X
  1310. X            case TK_ARRAY:
  1311. X                if (type->meaning && type->meaning->kind == MK_TYPE &&
  1312. X                    type->meaning->wasdeclared)
  1313. X                    return type;
  1314. X                break;
  1315. X
  1316. X            case TK_FILE:
  1317. X                return tp_text->basetype;
  1318. X
  1319. X            case TK_PROCPTR:
  1320. X        return tp_proc;
  1321. X
  1322. X        case TK_CPROCPTR:
  1323. X        type = type->basetype->basetype;
  1324. X        continue;
  1325. X
  1326. X            case TK_ENUM:
  1327. X                if (useenum)
  1328. X                    return type;
  1329. X                else if (!enumbyte ||
  1330. X             type->smax->kind != EK_CONST ||
  1331. X             type->smax->val.i > 255)
  1332. X            return tp_sshort;
  1333. X        else if (type->smax->val.i > 127)
  1334. X                    return tp_ubyte;
  1335. X        else
  1336. X                    return tp_abyte;
  1337. X
  1338. X            case TK_BOOLEAN:
  1339. X                if (*name_BOOLEAN)
  1340. X                    return type;
  1341. X                else
  1342. X                    return tp_ubyte;
  1343. X
  1344. X            case TK_SUBR:
  1345. X                if (type == tp_abyte || type == tp_ubyte || type == tp_sbyte ||
  1346. X                    type == tp_ushort || type == tp_sshort) {
  1347. X                    return type;
  1348. X                } else if ((type->basetype->kind == TK_ENUM && useenum) ||
  1349. X                           type->basetype->kind == TK_BOOLEAN && *name_BOOLEAN) {
  1350. X                    return type->basetype;
  1351. X                } else {
  1352. X                    if (ord_range(type, &smin, &smax)) {
  1353. X                        if (squeezesubr != 0) {
  1354. X                            if (smin >= 0 && smax <= max_schar)
  1355. X                                return tp_abyte;
  1356. X                            else if (smin >= 0 && smax <= max_uchar)
  1357. X                                return tp_ubyte;
  1358. X                            else if (smin >= min_schar && smax <= max_schar &&
  1359. X                     (signedchars == 1 || hassignedchar))
  1360. X                                return tp_sbyte;
  1361. X                            else if (smin >= min_sshort && smax <= max_sshort)
  1362. X                                return tp_sshort;
  1363. X                            else if (smin >= 0 && smax <= max_ushort)
  1364. X                                return tp_ushort;
  1365. X                            else
  1366. X                                return tp_integer;
  1367. X                        } else {
  1368. X                            if (smin >= min_sshort && smax <= max_sshort)
  1369. X                                return tp_sshort;
  1370. X                            else
  1371. X                                return tp_integer;
  1372. X                        }
  1373. X                    } else
  1374. X                        return tp_integer;
  1375. X                }
  1376. X
  1377. X        case TK_CHAR:
  1378. X        if (type == tp_schar &&
  1379. X            (signedchars != 1 && !hassignedchar)) {
  1380. X            return tp_sshort;
  1381. X        }
  1382. X        return type;
  1383. X
  1384. X            default:
  1385. X                return type;
  1386. X        }
  1387. X        type = type->basetype;
  1388. X    }
  1389. X}
  1390. X
  1391. X
  1392. XType *findbasetype(type, flags)
  1393. XType *type;
  1394. Xint flags;
  1395. X{
  1396. X    if (debug>1) {
  1397. X    fprintf(outf, "findbasetype(");
  1398. X    dumptypename(type, 1);
  1399. X    fprintf(outf, ",%d) = ", flags);
  1400. X    type = findbasetype_(type, flags);
  1401. X    dumptypename(type, 1);
  1402. X    fprintf(outf, "\n");
  1403. X    return type;
  1404. X    }
  1405. X    return findbasetype_(type, flags);
  1406. X}
  1407. X
  1408. X
  1409. X
  1410. XExpr *arraysize(tp, incskipped)
  1411. XType *tp;
  1412. Xint incskipped;
  1413. X{
  1414. X    Expr *ex, *minv, *maxv;
  1415. X    int denom;
  1416. X
  1417. X    ord_range_expr(tp->indextype, &minv, &maxv);
  1418. X    if (maxv->kind == EK_VAR && maxv->val.i == (long)mp_maxint &&
  1419. X    !exprdependsvar(minv, mp_maxint)) {
  1420. X        return NULL;
  1421. X    } else {
  1422. X        ex = makeexpr_plus(makeexpr_minus(copyexpr(maxv),
  1423. X                                          copyexpr(minv)),
  1424. X                           makeexpr_long(1));
  1425. X        if (tp->smin && !incskipped) {
  1426. X            ex = makeexpr_minus(ex, copyexpr(tp->smin));
  1427. X        }
  1428. X        if (tp->smax) {
  1429. X            denom = (tp->basetype == tp_sshort) ? 16 : 8;
  1430. X            denom >>= tp->escale;
  1431. X            ex = makeexpr_div(makeexpr_plus(ex, makeexpr_long(denom-1)),
  1432. X                              makeexpr_long(denom));
  1433. X        }
  1434. X        return ex;
  1435. X    }
  1436. X}
  1437. X
  1438. X
  1439. X
  1440. XType *promote_type(tp)
  1441. XType *tp;
  1442. X{
  1443. X    Type *tp2;
  1444. X
  1445. X    if (tp->kind == TK_ENUM) {
  1446. X    if (promote_enums == 0 ||
  1447. X        (promote_enums < 0 &&
  1448. X         (useenum)))
  1449. X        return tp;
  1450. X    }
  1451. X    if (tp->kind == TK_ENUM ||
  1452. X         tp->kind == TK_SUBR ||
  1453. X         tp->kind == TK_INTEGER ||
  1454. X         tp->kind == TK_CHAR ||
  1455. X         tp->kind == TK_BOOLEAN) {
  1456. X        tp2 = findbasetype(tp, 0);
  1457. X    if (tp2 == tp_ushort && sizeof_int == 16)
  1458. X        return tp_uint;
  1459. X        else if (tp2 == tp_sbyte || tp2 == tp_ubyte ||
  1460. X         tp2 == tp_abyte || tp2 == tp_char ||
  1461. X         tp2 == tp_sshort || tp2 == tp_ushort ||
  1462. X         tp2 == tp_boolean || tp2->kind == TK_ENUM) {
  1463. X            return tp_int;
  1464. X        }
  1465. X    }
  1466. X    if (tp == tp_real)
  1467. X    return tp_longreal;
  1468. X    return tp;
  1469. X}
  1470. X
  1471. X
  1472. XType *promote_type_bin(t1, t2)
  1473. XType *t1, *t2;
  1474. X{
  1475. X    t1 = promote_type(t1);
  1476. X    t2 = promote_type(t2);
  1477. X    if (t1 == tp_longreal || t2 == tp_longreal)
  1478. X    return tp_longreal;
  1479. X    if (t1 == tp_unsigned || t2 == tp_unsigned)
  1480. X    return tp_unsigned;
  1481. X    if (t1 == tp_integer || t2 == tp_integer) {
  1482. X    if ((t1 == tp_uint || t2 == tp_uint) &&
  1483. X        sizeof_int > 0 &&
  1484. X        sizeof_int < (sizeof_long > 0 ? sizeof_long : 32))
  1485. X        return tp_uint;
  1486. X    return tp_integer;
  1487. X    }
  1488. X    if (t1 == tp_uint || t2 == tp_uint)
  1489. X    return tp_uint;
  1490. X    return t1;
  1491. X}
  1492. X
  1493. X
  1494. X
  1495. X#if 0
  1496. Xvoid predeclare_varstruct(mp)
  1497. XMeaning *mp;
  1498. X{
  1499. X    if (mp->ctx &&
  1500. X     mp->ctx->kind == MK_FUNCTION &&
  1501. X     mp->ctx->varstructflag &&
  1502. X     (usePPMacros != 0 || prototypes != 0) &&
  1503. X     !strlist_find(varstructdecllist, mp->ctx->name)) {
  1504. X    output("struct ");
  1505. X    output(format_s(name_LOC, mp->ctx->name));
  1506. X    output(" ;\n");
  1507. X    strlist_insert(&varstructdecllist, mp->ctx->name);
  1508. X    }
  1509. X}
  1510. X#endif
  1511. X
  1512. X
  1513. XStatic void declare_args(type, isheader, isforward)
  1514. XType *type;
  1515. Xint isheader, isforward;
  1516. X{
  1517. X    Meaning *mp = type->fbase;
  1518. X    Type *tp;
  1519. X    int firstflag = 0;
  1520. X    int usePP, dopromote, proto, showtypes, shownames;
  1521. X    int staticlink;
  1522. X    char *name;
  1523. X
  1524. X#if 1   /* This seems to work better! */
  1525. X    isforward = !isheader;
  1526. X#endif
  1527. X    usePP = (isforward && usePPMacros != 0);
  1528. X    dopromote = (promoteargs == 1 ||
  1529. X         (promoteargs < 0 && (usePP || !fullprototyping)));
  1530. X    if (ansiC == 1 && blockkind != TOK_EXPORT)
  1531. X    usePP = 0;
  1532. X    if (usePP)
  1533. X        proto = (prototypes) ? prototypes : 1;
  1534. X    else
  1535. X        proto = (isforward || fullprototyping) ? prototypes : 0;
  1536. X    showtypes = (proto > 0);
  1537. X    shownames = (proto == 1 || isheader);
  1538. X    staticlink = (type->issigned ||
  1539. X                  (type->meaning &&
  1540. X                   type->meaning->ctx->kind == MK_FUNCTION &&
  1541. X                   type->meaning->ctx->varstructflag));
  1542. X    if (mp || staticlink) {
  1543. X        if (usePP)
  1544. X            output(" PP(");
  1545. X        output("(");
  1546. X        if (showtypes || shownames) {
  1547. X            firstflag = 0;
  1548. X            while (mp) {
  1549. X                if (firstflag++) output(",\002 ");
  1550. X                name = (mp->othername && isheader) ? mp->othername : mp->name;
  1551. X                tp = (mp->othername) ? mp->rectype : mp->type;
  1552. X                if (!showtypes) {
  1553. X                    output(name);
  1554. X                } else {
  1555. X            output(storageclassname(varstorageclass(mp)));
  1556. X            if (!shownames || (isforward && *name == '_')) {
  1557. X            out_type(tp, 1);
  1558. X            } else {
  1559. X            if (dopromote)
  1560. X                tp = promote_type(tp);
  1561. X            outbasetype(tp, ODECL_CHARSTAR|ODECL_FREEARRAY);
  1562. X            output(" ");
  1563. X            outdeclarator(tp, name,
  1564. X                      ODECL_CHARSTAR|ODECL_FREEARRAY);
  1565. X            }
  1566. X        }
  1567. X                if (isheader)
  1568. X                    mp->wasdeclared = showtypes;
  1569. X                if (mp->type == tp_strptr && mp->anyvarflag) {     /* VAR STRING parameter */
  1570. X                    output(",\002 ");
  1571. X                    if (showtypes) {
  1572. X            if (useAnyptrMacros == 1 || useconsts == 2)
  1573. X                output("Const ");
  1574. X            else if (ansiC > 0)
  1575. X                output("const ");
  1576. X                        output("int");
  1577. X            }
  1578. X                    if (shownames) {
  1579. X                        if (showtypes)
  1580. X                            output(" ");
  1581. X                        output(format_s(name_STRMAX, mp->name));
  1582. X                    }
  1583. X                }
  1584. X                mp = mp->xnext;
  1585. X            }
  1586. X            if (staticlink) {     /* sub-procedure with static link */
  1587. X                if (firstflag++) output(",\002 ");
  1588. X                if (type->issigned) {
  1589. X                    if (showtypes)
  1590. X            if (tp_special_anyptr)
  1591. X                output("Anyptr ");
  1592. X            else if (voidstar)
  1593. X                output("void *");
  1594. X            else
  1595. X                output("char *");
  1596. X                    if (shownames)
  1597. X                        output("_link");
  1598. X                } else {
  1599. X                    mp = type->meaning->ctx;
  1600. X                    if (showtypes) {
  1601. X                        output("struct ");
  1602. X                        output(format_s(name_LOC, mp->name));
  1603. X                        output(" *");
  1604. X                    }
  1605. X                    if (shownames) {
  1606. X                        output(format_s(name_LINK, mp->name));
  1607. X                    }
  1608. X                }
  1609. X            }
  1610. X        }
  1611. X        output(")");
  1612. X        if (usePP)
  1613. X            output(")");
  1614. X    } else {
  1615. X        if (usePP)
  1616. X            output(" PV()");
  1617. X        else if (void_args)
  1618. X            output("(void)");
  1619. X        else
  1620. X            output("()");
  1621. X    }
  1622. X}
  1623. X
  1624. X
  1625. X
  1626. Xvoid outdeclarator(type, name, flags)
  1627. XType *type;
  1628. Xchar *name;
  1629. Xint flags;
  1630. X{
  1631. X    int i, depth, anyptrs, anyarrays;
  1632. X    Expr *dimen[30];
  1633. X    Expr *ex, *maxv;
  1634. X    Type *tp, *functype;
  1635. X    Expr funcdummy;   /* yow */
  1636. X
  1637. X    anyptrs = 0;
  1638. X    anyarrays = 0;
  1639. X    functype = NULL;
  1640. X    for (depth = 0, tp = type; tp; tp = tp->basetype) {
  1641. X        switch (tp->kind) {
  1642. X
  1643. X            case TK_POINTER:
  1644. X                if (tp->basetype) {
  1645. X                    switch (tp->basetype->kind) {
  1646. X
  1647. X                case TK_VOID:
  1648. X                if (tp->basetype == tp_void &&
  1649. X                tp_special_anyptr) {
  1650. X                tp = tp_special_anyptr;
  1651. X                continue;
  1652. X                }
  1653. X                break;
  1654. X
  1655. X                        case TK_ARRAY:    /* ptr to array of x => ptr to x */
  1656. X                        case TK_STRING:   /*                or => array of x */
  1657. X                        case TK_SET:
  1658. X                if (stararrays == 1 ||
  1659. X                !(flags & ODECL_FREEARRAY) ||
  1660. X                (tp->basetype->structdefd &&
  1661. X                 stararrays != 2)) {
  1662. X                tp = tp->basetype;
  1663. X                flags &= ~ODECL_CHARSTAR;
  1664. X                } else {
  1665. X                continue;
  1666. X                }
  1667. X                            break;
  1668. X
  1669. X            default:
  1670. X                break;
  1671. X                    }
  1672. X                }
  1673. X                dimen[depth++] = NULL;
  1674. X                anyptrs++;
  1675. X                continue;
  1676. X
  1677. X            case TK_ARRAY:
  1678. X        flags &= ~ODECL_CHARSTAR;
  1679. X                if (tp->meaning && tp->meaning->kind == MK_TYPE &&
  1680. X                    tp->meaning->wasdeclared)
  1681. X                    break;
  1682. X        if (tp->structdefd) {    /* conformant array */
  1683. X            if (!variablearrays &&
  1684. X            !(tp->basetype->kind == TK_ARRAY &&
  1685. X              tp->basetype->structdefd))   /* avoid mult. notes */
  1686. X            note("Conformant array code may not work in all compilers [101]");
  1687. X        }
  1688. X                ex = arraysize(tp, 1);
  1689. X                if (!ex)
  1690. X                    ex = makeexpr_name("", tp_integer);
  1691. X                dimen[depth++] = ex;
  1692. X        anyarrays++;
  1693. X                continue;
  1694. X
  1695. X            case TK_SET:
  1696. X                ord_range_expr(tp->indextype, NULL, &maxv);
  1697. X                maxv = enum_to_int(copyexpr(maxv));
  1698. X                if (ord_type(maxv->val.type)->kind == TK_CHAR)
  1699. X                    maxv->val.type = tp_integer;
  1700. X                dimen[depth++] = makeexpr_plus(makeexpr_div(maxv, makeexpr_setbits()),
  1701. X                                               makeexpr_long(2));
  1702. X                break;
  1703. X
  1704. X            case TK_STRING:
  1705. X                if ((flags & ODECL_CHARSTAR) && stararrays == 1) {
  1706. X                    dimen[depth++] = NULL;
  1707. X                } else {
  1708. X                    ord_range_expr(tp->indextype, NULL, &maxv);
  1709. X                    dimen[depth++] = makeexpr_plus(copyexpr(maxv), makeexpr_long(1));
  1710. X                }
  1711. X                continue;
  1712. X
  1713. X            case TK_FILE:
  1714. X                break;
  1715. X
  1716. X        case TK_CPROCPTR:
  1717. X        dimen[depth++] = NULL;
  1718. X        anyptrs++;
  1719. X        if (procptrprototypes)
  1720. X            continue;
  1721. X                dimen[depth++] = &funcdummy;
  1722. X        break;
  1723. X
  1724. X            case TK_FUNCTION:
  1725. X                dimen[depth++] = &funcdummy;
  1726. X                if (!functype)
  1727. X                    functype = tp;
  1728. X                continue;
  1729. X
  1730. X        default:
  1731. X        break;
  1732. X        }
  1733. X        break;
  1734. X    }
  1735. X    if (!*name && depth && (spaceexprs > 0 ||
  1736. X                            (spaceexprs != 0 && !dimen[depth-1])))
  1737. X        output(" ");    /* spacing for abstract declarator */
  1738. X    if ((flags & ODECL_FUNCTION) && anyptrs)
  1739. X        output(" ");
  1740. X    if (anyarrays > 1 && !(flags & ODECL_FUNCTION))
  1741. X    output("\003");
  1742. X    for (i = depth; --i >= 0; ) {
  1743. X        if (!dimen[i])
  1744. X            output("*");
  1745. X        if (i > 0 &&
  1746. X            ((dimen[i] && !dimen[i-1]) ||
  1747. X             (dimen[i-1] && !dimen[i] && extraparens > 0)))
  1748. X            output("(");
  1749. X    }
  1750. X    if (flags & ODECL_FUNCTION)
  1751. X        output("\n");
  1752. X    if (anyarrays > 1 && (flags & ODECL_FUNCTION))
  1753. X    output("\003");
  1754. X    output(name);
  1755. X    for (i = 0; i < depth; i++) {
  1756. X        if (i > 0 &&
  1757. X            ((dimen[i] && !dimen[i-1]) ||
  1758. X             (dimen[i-1] && !dimen[i] && extraparens > 0)))
  1759. X            output(")");
  1760. X        if (dimen[i]) {
  1761. X            if (dimen[i] == &funcdummy) {
  1762. X        if (lookback(1) == ')')
  1763. X            output("\002");
  1764. X        if (functype)
  1765. X            declare_args(functype, (flags & ODECL_HEADER) != 0,
  1766. X                           (flags & ODECL_FORWARD) != 0);
  1767. X        else
  1768. X            output("()");
  1769. X            } else {
  1770. X        if (lookback(1) == ']')
  1771. X            output("\002");
  1772. X                output("[");
  1773. X                if (!(flags & ODECL_FREEARRAY) || stararrays == 0 || i > 0)
  1774. X                    out_expr(dimen[i]);
  1775. X                freeexpr(dimen[i]);
  1776. X                output("]");
  1777. X            }
  1778. X        }
  1779. X    }
  1780. X    if (anyarrays > 1)
  1781. X    output("\004");
  1782. X}
  1783. X
  1784. X
  1785. X
  1786. X
  1787. X
  1788. X
  1789. X/* Find out if types t1 and t2 will work out to be the same C type,
  1790. X   for purposes of type-casting */
  1791. X
  1792. XType *canonicaltype(type)
  1793. XType *type;
  1794. X{
  1795. X    if (type->kind == TK_SUBR || type->kind == TK_ENUM ||
  1796. X        type->kind == TK_PROCPTR)
  1797. X        type = findbasetype(type, 0);
  1798. X    if (type == tp_char)
  1799. X        return tp_ubyte;
  1800. X    if (type->kind == TK_POINTER) {
  1801. X        if (type->basetype->kind == TK_ARRAY ||
  1802. X            type->basetype->kind == TK_STRING ||
  1803. X            type->basetype->kind == TK_SET)
  1804. X            return makepointertype(canonicaltype(type->basetype->basetype));
  1805. X        else if (type->basetype == tp_void)
  1806. X            return (voidstar) ? tp_anyptr : makepointertype(tp_abyte);
  1807. X        else if (type->basetype->kind == TK_FILE)
  1808. X            return tp_text;
  1809. X        else
  1810. X            return makepointertype(canonicaltype(type->basetype));
  1811. X    }
  1812. X    return type;
  1813. X}
  1814. X
  1815. X
  1816. Xint similartypes(t1, t2)
  1817. XType *t1, *t2;
  1818. X{
  1819. X    t1 = canonicaltype(t1);
  1820. X    t2 = canonicaltype(t2);
  1821. X    return (t1 == t2);
  1822. X}
  1823. X
  1824. X
  1825. X
  1826. X
  1827. X
  1828. XStatic int checkstructconst(mp)
  1829. XMeaning *mp;
  1830. X{
  1831. X    return (mp->kind == MK_VAR &&
  1832. X        mp->constdefn &&
  1833. X            mp->constdefn->kind == EK_CONST &&
  1834. X            (mp->constdefn->val.type->kind == TK_ARRAY ||
  1835. X             mp->constdefn->val.type->kind == TK_RECORD));
  1836. X}
  1837. X
  1838. X
  1839. XStatic int mixable(mp1, mp2, args, flags)
  1840. XMeaning *mp1, *mp2;
  1841. Xint args, flags;
  1842. X{
  1843. X    Type *tp1 = mp1->type, *tp2 = mp2->type;
  1844. X
  1845. X    if (mixvars == 0)
  1846. X        return 0;
  1847. X    if (mp1->kind == MK_FIELD &&
  1848. X        (mp1->val.i || mp2->val.i) && mixfields == 0)
  1849. X        return 0;
  1850. X    if (checkstructconst(mp1) || checkstructconst(mp2))
  1851. X        return 0;
  1852. X    if (mp1->comments) {
  1853. X    if (findcomment(mp1->comments, CMT_NOT | CMT_PRE, -1))
  1854. X        return 0;
  1855. X    }
  1856. X    if (mp2->comments) {
  1857. X    if (findcomment(mp2->comments, CMT_PRE, -1))
  1858. X        return 0;
  1859. X    }
  1860. X    if ((mp1->constdefn && (mp1->kind == MK_VAR || mp1->kind == MK_VARREF)) ||
  1861. X    (mp2->constdefn && (mp2->kind == MK_VAR || mp2->kind == MK_VARREF))) {
  1862. X        if (mixinits == 0)
  1863. X            return 0;
  1864. X        if (mixinits != 1 &&
  1865. X            (!mp1->constdefn || !mp2->constdefn))
  1866. END_OF_FILE
  1867. if test 49193 -ne `wc -c <'src/decl.c.1'`; then
  1868.     echo shar: \"'src/decl.c.1'\" unpacked with wrong size!
  1869. fi
  1870. # end of 'src/decl.c.1'
  1871. fi
  1872. echo shar: End of archive 28 \(of 32\).
  1873. cp /dev/null ark28isdone
  1874. MISSING=""
  1875. 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
  1876.     if test ! -f ark${I}isdone ; then
  1877.     MISSING="${MISSING} ${I}"
  1878.     fi
  1879. done
  1880. if test "${MISSING}" = "" ; then
  1881.     echo You have unpacked all 32 archives.
  1882.     echo "Now see PACKNOTES and the README"
  1883.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  1884. else
  1885.     echo You still need to unpack the following archives:
  1886.     echo "        " ${MISSING}
  1887. fi
  1888. ##  End of shell archive.
  1889. exit 0
  1890.