home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / sozobon2 / d2.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-23  |  10.3 KB  |  647 lines
  1. /* Copyright (c) 1988 by Sozobon, Limited.  Author: Johann Ruegg
  2.  *
  3.  * Permission is granted to anyone to use this software for any purpose
  4.  * on any computer system, and to redistribute it freely, with the
  5.  * following restrictions:
  6.  * 1) No charge may be made other than reasonable charges for reproduction.
  7.  * 2) Modified versions must be clearly marked as such.
  8.  * 3) The authors are not responsible for any harmful consequences
  9.  *    of using this software, even if they result from defects in it.
  10.  *
  11.  *    d2.c
  12.  *
  13.  *    Declaration subroutines
  14.  *
  15.  *    Mostly routines for initializations
  16.  */
  17.  
  18. #include <stdio.h>
  19. #include "param.h"
  20. #include "tok.h"
  21. #include "nodes.h"
  22. #include "cookie.h"
  23.  
  24. #if MMCC
  25. overlay "pass2"
  26. #endif
  27.  
  28. extern NODEP cur;
  29. extern NODEP symtab[];
  30. extern level;
  31.  
  32. extern int oflags[];
  33. #define debugi    oflags['i'-'a']
  34.  
  35. su_size(lp, cp, xp, isunion)
  36. register long *lp;
  37. char *cp;
  38. register NODE *xp;
  39. {
  40.     long sz;
  41.     char al;
  42.  
  43.     sz = xp->n_tptr->t_size;
  44.     al = xp->n_tptr->t_aln;
  45.     if (isunion) {
  46.         *lp = *lp > sz ? *lp : sz;
  47.     } else {
  48.         while (al & (*lp)) {    /* align new field */
  49.             (*lp)++;
  50.             xp->e_offs++;
  51.         }
  52.         *lp += sz;
  53.     }
  54.     *cp = *cp > al ? *cp : al;
  55. }
  56.  
  57. lc_size(lp, rp, xp)
  58. register long *lp;
  59. int *rp;
  60. register NODE *xp;
  61. {
  62.     long sz;
  63.     char al;
  64.     long arg_size();
  65. #ifdef LAT_HOST
  66.     long tsz;
  67. #endif
  68.  
  69.     if (level > 1 && xp->e_sc == K_REGISTER) {
  70.         if (lc_reg(rp, xp))
  71.             return;
  72.         else
  73.             xp->e_sc = K_AUTO;
  74.     }
  75.     if (xp->e_sc == K_AUTO || level == 1) {
  76.         sz = xp->n_tptr->t_size;
  77.         al = xp->n_tptr->t_aln;
  78.         while (al & (*lp)) {    /* align new field */
  79.             (*lp)++;
  80.             xp->e_offs++;
  81.         }
  82.         if (level == 1) {
  83. #ifndef LAT_HOST
  84.             sz = arg_size(sz,xp);
  85. #else
  86.             tsz = arg_size(sz,xp);
  87.             sz = tsz;
  88. #endif
  89.             xp->e_offs += ARG_BASE + *lp;
  90.         }
  91.         *lp += sz;
  92.         if (level != 1)
  93.             xp->e_offs = LOC_BASE - *lp;
  94.     }
  95. }
  96.  
  97. su_fld(lp, alp, xp, fldw, fop)
  98. register long *lp;
  99. char *alp;
  100. register NODE *xp;
  101. int *fop;
  102. {
  103.     if (*alp < ALN_I)
  104.         *alp = ALN_I;
  105.     if (fldw == 0) {
  106.         afterfld(lp, fop);
  107.         return;
  108.     }
  109.     if (fldw + *fop > 8*SIZE_I)
  110.         afterfld(lp, fop);
  111.     if (xp) {
  112.         xp->e_fldw = fldw;
  113.         xp->e_fldo = *fop;
  114.     }
  115.     *fop += fldw;
  116. }
  117.  
  118. afterfld(szp, fop)
  119. long *szp;
  120. int *fop;
  121. {
  122.     if (*fop) {
  123.         *szp += SIZE_I;
  124.         *fop = 0;
  125.     }
  126. }
  127.  
  128. ok_gsh(sc, np)
  129. NODE *np;
  130. {
  131.     if (sc == K_REGISTER || sc == K_AUTO) {
  132.         error("reg/auto outside fun");
  133.         return 0;
  134.     }
  135.     return ok_ty(np, NULL);
  136. }
  137.  
  138. ok_gx(np, endp)
  139. NODEP np, endp;
  140. {
  141.     if (np)
  142.         return ok_ty(np->n_tptr, endp);
  143.     return 0;
  144. }
  145.  
  146. ok_lsh(sc, np)
  147. NODE *np;
  148. {
  149.     return ok_ty(np, NULL);
  150. }
  151.  
  152. arytoptr(np)
  153. NODEP np;
  154. {
  155.     NODEP tp = np->n_tptr;
  156.     NODEP copyone();
  157.  
  158.     if (np->n_flags & N_COPYT) {    /* cant change if a dupl. */
  159.         tp = copyone(tp);
  160.         np->n_tptr = tp;
  161.         np->n_flags &= ~N_COPYT;
  162.     }
  163.     tp->t_token = STAR;
  164.     strcpy(tp->n_name, "Aptr to");
  165. }
  166.  
  167. ok_lx(np,endp)
  168. NODEP np, endp;
  169. {
  170.     if (np) {
  171.         if (level == 1 && np->n_tptr->t_token == '[')
  172.             arytoptr(np);
  173.         return ok_ty(np->n_tptr, endp);
  174.     }
  175.     return 0;
  176. }
  177.  
  178. ok_suh(np)
  179. NODEP np;
  180. {
  181.     return 1;
  182. }
  183.  
  184. ok_sux(np, endp)
  185. NODEP np, endp;
  186. {
  187.     if (np)
  188.         return ok_ty(np->n_tptr, endp);
  189.     return 0;
  190. }
  191.  
  192. ok_enx(np, endp)
  193. NODEP np, endp;
  194. {
  195.     if (np && np->n_tptr == endp)    /* no modifiers */
  196.         return 1;
  197.     return 0;
  198. }
  199.  
  200. ok_cast(np, endp)
  201. NODEP np, endp;
  202. {
  203.     if (np)
  204.         return ok_ty(np, endp);
  205.     return 0;
  206. }
  207.  
  208. ok_ty(np, endp)
  209. register NODEP np, endp;
  210. {
  211.     NODEP child;
  212.     long csize;
  213.     long conlval();
  214.  
  215.     if (np == endp)
  216.         return 1;
  217.     child = np->n_tptr;
  218.     if (child) {
  219.         if (ok_ty(child, endp) == 0)
  220.             return 0;
  221.         csize = child->t_size;
  222.     }
  223.  
  224.     switch (np->t_token) {
  225.     case STAR:
  226.         np->t_size = SIZE_P;
  227.         np->t_aln = ALN_P;
  228.         break;
  229.     case '(':
  230.         /* size 0 okay - fun ret void */
  231.         if (child->t_token == '[') {
  232.             error("bad func");
  233.             return 0;
  234.         }
  235.         /* size 0 */
  236.         break;
  237.     case '[':
  238.         if (csize == 0) {
  239.             error("bad array");
  240.             return 0;
  241.         }
  242.         if (np->n_right) {
  243.             csize *= conlval(np->n_right);
  244.             np->n_right = NULL;
  245.             np->t_size = csize;
  246.         }
  247.         np->t_aln = child->t_aln;
  248.         break;
  249.     default:
  250.         return 1;
  251.     }
  252.     return 1;
  253. }
  254.  
  255. ok_revx(rv,forcast)
  256. NODEP rv;
  257. {
  258.     if (rv == NULL)
  259.         return 1;
  260.     if (forcast == 0 && rv->e_token != ID) {
  261.         error("need ID");
  262.         return 0;
  263.     }
  264.     if (forcast && rv->e_token == ID) {
  265.         error("ID in cast");
  266.         return 0;
  267.     }
  268.     return 1;
  269. }
  270.  
  271. opt_ginit(xp)
  272. NODEP xp;
  273. {
  274.     if (xp->e_token != ID)
  275.         return;
  276.     if (xp->n_tptr->t_token == '(')
  277.         return;
  278.     switch (xp->e_sc) {
  279.     case K_STATIC:
  280.     case HERE_SC:
  281.         if (cur->e_token == '=') {
  282.             out_gv(xp, 0);
  283.             fadvnode();
  284.             g_init(xp->n_tptr);
  285.         } else
  286.             out_gv(xp, 1);
  287.     }
  288. }
  289.  
  290. opt_linit(xp)
  291. NODEP xp;
  292. {
  293.     if (xp->e_token != ID)
  294.         return;
  295.     if (xp->n_tptr->t_token == '(')
  296.         return;
  297.     switch (xp->e_sc) {
  298.     case K_STATIC:
  299.         if (cur->e_token == '=') {
  300.             out_gv(xp, 0);
  301.             fadvnode();
  302.             g_init(xp->n_tptr);
  303.         } else
  304.             out_gv(xp, 1);
  305.         to_text();
  306.         break;
  307.     case K_AUTO:
  308.     case K_REGISTER:
  309.         if (cur->e_token == '=')
  310.             a_init(xp);
  311.         break;
  312.     }
  313. }
  314.  
  315. a_init(op)
  316. NODEP op;
  317. {
  318.     register NODEP np, xp;
  319.     NODEP assignx(), copynode();
  320.  
  321.     np = cur;  advnode();
  322.     xp = assignx();
  323.     op = copynode(op);
  324.     np->n_left = op;
  325.     np->n_right = xp;
  326.     np->e_type = E_BIN;
  327.     do_expr(np, FORSIDE);
  328.     return;
  329. }
  330.  
  331. opt_enval(intp)
  332. int *intp;
  333. {
  334.     NODEP np;
  335.     NODEP questx();
  336.  
  337.     if (cur->e_token == '=') {
  338.         fadvnode();
  339.         np = questx();
  340.         *intp = conxval(np);
  341.         return;
  342.     }
  343. }
  344.  
  345. opt_field(xp,wdp,isunion)
  346. NODE *xp;
  347. int *wdp;
  348. {
  349.     NODEP np;
  350.     NODEP questx();
  351.     int i;
  352.  
  353.     *wdp = -1;
  354.     if (isunion) return;
  355.     if (cur->e_token == ':') {
  356.         fadvnode();
  357.         np = questx();
  358.         i = conxval(np);
  359.         if (i > 8*SIZE_I) {
  360.             error("field too big");
  361.             i = 8*SIZE_I;
  362.         }
  363.         if (xp) {
  364.             if (i <= 0 || bad_fty(xp->n_tptr)) {
  365.                 error("bad field");
  366.                 return;
  367.             }
  368.         } else if (i < 0) {
  369.             error("neg field width");
  370.             return;
  371.         }
  372.         *wdp = i;
  373.         return;
  374.     }
  375. }
  376.  
  377. bad_fty(tp)
  378. NODEP tp;
  379. {
  380.     int tok;
  381.  
  382.     tok = tp->t_token;
  383.     if (tok == K_INT || tok == K_UNSIGNED)
  384.         return 0;
  385.     return 1;
  386. }
  387.  
  388. field(xp, wd, ofp)
  389. NODEP xp;
  390. int *ofp;
  391. {
  392. }
  393.  
  394. NODEP
  395. def_type()
  396. {
  397.     NODEP bas_type();
  398.  
  399.     return bas_type(K_INT);
  400. }
  401.  
  402. #define NSC    LAST_SC-FIRST_SC+1
  403. #define NBAS    LAST_BAS-FIRST_BAS+1
  404.  
  405. NODE basics[NBAS];
  406. NODE str_ptr, fun_int;
  407.  
  408. struct bt {
  409.     char    *name;
  410.     int    size;
  411.     char    align;
  412. } btbl[] = {
  413.     {"Uchar",    SIZE_C, ALN_C},
  414.     {"Ulong",    SIZE_L, ALN_L},
  415.     {"Long",    SIZE_L,    ALN_L},
  416.     {"Short",    SIZE_S, ALN_S},
  417.     {"Uns",        SIZE_U, ALN_U},
  418.     {"Int",        SIZE_I, ALN_I},
  419.     {"Char",    SIZE_C, ALN_C},
  420.     {"Float",    SIZE_F, ALN_F},
  421.     {"Dbl",        SIZE_D, ALN_D},
  422.     {"Void",    0},
  423. };
  424.  
  425. NODEP
  426. bas_type(btype)
  427. {
  428.     NODEP rv;
  429.     static once = 0;
  430.  
  431.     if (once == 0) {
  432.         once++;
  433.  
  434.         sprintf(str_ptr.n_name, "Ptr to");
  435.         str_ptr.t_token = STAR;
  436.         str_ptr.n_tptr = bas_type(K_CHAR);
  437.         str_ptr.n_flags = N_COPYT;
  438.         str_ptr.t_size = SIZE_P;
  439.         str_ptr.t_aln = ALN_P;
  440.  
  441.         sprintf(fun_int.n_name, "Fun ret");
  442.         fun_int.t_token = '(';
  443.         fun_int.n_tptr = bas_type(K_INT);
  444.         fun_int.n_flags = N_COPYT;
  445.     }
  446.     if (btype == SCON)
  447.         return &str_ptr;
  448.     else if (btype == '(')
  449.         return &fun_int;
  450.     rv = &basics[btype-FIRST_BAS];
  451.     if (rv->t_token == 0) {
  452.         rv->t_token = btype;
  453.         rv->t_size = btbl[btype-FIRST_BAS].size;
  454.         rv->t_aln = btbl[btype-FIRST_BAS].align;
  455.         sprintf(rv->n_name, btbl[btype-FIRST_BAS].name);
  456.     }
  457.     return rv;
  458. }
  459.  
  460. /* new function name seen in expr */
  461. NODEP
  462. new_fun(op)
  463. NODE *op;
  464. {
  465.     NODEP np;
  466.     NODEP copyone();
  467.  
  468.     /* we know left, right and tptr are NULL */
  469.     np = copyone(op); /* ID node */
  470.     np->n_tptr = bas_type('(');
  471.     np->n_flags = N_COPYT;
  472.     np->e_sc = K_EXTERN;
  473.     new_sym(symtab, np);
  474.     return np;
  475. }
  476.  
  477. /* declare arg name as int */
  478. def_arg(listpp, op)
  479. NODE **listpp, *op;
  480. {
  481.     register NODEP np;
  482.     NODEP copyone();
  483.  
  484.     np = copyone(op);
  485.     np->n_tptr = bas_type(K_INT);
  486.     np->n_flags = N_COPYT;
  487.     np->e_sc = K_AUTO;
  488.     new_sym(listpp, np);
  489. }
  490.  
  491. /* initialize 0 or 1 thing of any type (tp) */
  492. g_init(tp)
  493. register NODEP tp;
  494. {
  495.     int nsee;
  496.     long sz;
  497.     int oldsize;
  498.     int seebr = 0;
  499.  
  500.     if (cur->e_token == SCON &&
  501.            tp->t_token == '[' &&
  502.            tp->n_tptr->t_token == K_CHAR) { /* hack for SCON ary */
  503.             nsee = out_scon(cur);
  504.             fadvnode();
  505.             a_fix(tp, nsee);
  506.             return 1;
  507.     }
  508.  
  509.     if (cur->e_token == '{') {
  510.         fadvnode();
  511.         seebr = 1;
  512.     }
  513.  
  514.     switch (tp->t_token) {
  515.     case '[':
  516.         if (tp->t_size)
  517.             oldsize = tp->t_size / tp->n_tptr->t_size;
  518.         else
  519.             oldsize = 0;
  520.         nsee = inita(tp->n_tptr, oldsize);
  521.         if (nsee)
  522.             a_fix(tp, nsee);
  523.         break;
  524.     case K_STRUCT:
  525.         o_aln(tp->t_aln);
  526.         nsee = inits(tp->n_right);
  527.         break;
  528.     case K_UNION:
  529.         o_aln(tp->t_aln);
  530.         nsee = g_init(tp->n_right->n_tptr);
  531.         if (nsee) {
  532.             sz = tp->t_size - tp->n_right->n_tptr->t_size;
  533.             if (sz)
  534.                 o_nz(sz, 0);
  535.         }
  536.         break;
  537.     default:
  538.         nsee = init1(tp);
  539.         break;
  540.     }
  541.  
  542.     if (seebr) {
  543.         if (cur->e_token == ',')
  544.             fadvnode();
  545.         eat('}');
  546.     }
  547.     return nsee ? 1 : 0;
  548. }
  549.  
  550. /* initialize one (or 0) scalar to an expr */
  551. init1(tp)
  552. register NODEP tp;
  553. {
  554.     NODEP xp;
  555.     NODEP assignx();
  556.  
  557.     if (debugi) {
  558.         printf("init1");
  559.         printnode(tp);
  560.     }
  561.     xp = assignx();
  562.     if (xp) {
  563.         if (debugi)
  564.             printnode(xp);
  565.         o_vinit(tp, xp);
  566.         return 1;
  567.     } else
  568.         return 0;
  569. }
  570.  
  571. /* set array size or fill array with zeros */
  572. a_fix(tp, nsee)
  573. register NODEP tp;
  574. {
  575.     int oldsize;
  576.  
  577.     if (tp->t_size) {
  578.         oldsize = tp->t_size / tp->n_tptr->t_size;
  579.         if (oldsize > nsee) {
  580.             o_nz(tp->n_tptr->t_size * (oldsize-nsee),
  581.                 tp->n_tptr->t_aln);
  582.         } else if (oldsize < nsee) {
  583.             error("too many init exprs");
  584.         }
  585.     } else
  586.         tp->t_size = nsee * tp->n_tptr->t_size;
  587. }
  588.  
  589. /* initialize up to max items of type tp */
  590. /* if max is 0, any number is okay */
  591.  
  592. inita(tp, maxi)
  593. NODEP tp;
  594. {
  595.     int nsee;
  596.  
  597.     nsee = g_init(tp);
  598.     if (nsee == 0)
  599.         return 0;
  600.  
  601.     while (cur->e_token == ',') {
  602.         if (nsee == maxi)
  603.             break;
  604.         fadvnode();
  605.         nsee += g_init(tp);
  606.     }
  607.     return nsee;
  608. }
  609.  
  610. /* initialize (possible) structure */
  611. inits(np)
  612. register NODEP np;
  613. {
  614.     int see1;
  615.  
  616.     see1 = g_init(np->n_tptr);
  617.     if (see1 == 0)
  618.         return 0;
  619.  
  620.     while (np->n_next) {
  621.         np = np->n_next;
  622.         if (cur->e_token == ',') {
  623.             fadvnode();
  624.             see1 = g_init(np->n_tptr);
  625.         } else
  626.             see1 = 0;
  627.         if (see1 == 0)
  628.             z_init(np->n_tptr);
  629.     }
  630.  
  631.     return 1;
  632. }
  633.  
  634. z_init(tp)
  635. register NODEP tp;
  636. {
  637.     switch (tp->t_token) {
  638.     case '[':
  639.     case K_STRUCT:
  640.     case K_UNION:
  641.         o_nz(tp->t_size, tp->t_aln);
  642.         break;
  643.     default:
  644.         out_zi(tp);
  645.     }
  646. }
  647.