2.9BSD - /usr/src/ucb/pascal/pxp/rec.c

   1: #
   2: /*
   3:  * pxp - Pascal execution profiler
   4:  *
   5:  * Bill Joy UCB
   6:  * Version 1.2 January 1979
   7:  */
   8: 
   9: #include "0.h"
  10: 
  11: tyrec(r, p0)
  12:     int *r, p0;
  13: {
  14: 
  15:     if (r != NIL)
  16:         setinfo(r[1]);
  17:     if (p0 == NIL) {
  18:         ppgoin(DECL);
  19:         ppnl();
  20:         indent();
  21:         ppkw("record");
  22:         ppspac();
  23:     } else {
  24:         ppspac();
  25:         ppbra("(");
  26:     }
  27:     ppgoin(DECL);
  28:     if (r) {
  29:         field(r[2], r[3]);
  30:         variant(r[3]);
  31:     }
  32:     if (r != NIL)
  33:         setinfo(r[1]);
  34:     putcml();
  35:     ppgoout(DECL);
  36:     if (p0 == NIL) {
  37:         ppnl();
  38:         indent();
  39:         ppkw("end");
  40:         ppgoout(DECL);
  41:     } else {
  42:         ppitem();
  43:         ppket(")");
  44:     }
  45: }
  46: 
  47: field(r, v)
  48:     int *r, *v;
  49: {
  50:     register int *fp, *tp, *ip;
  51: 
  52:     fp = r;
  53:     if (fp != NIL)
  54:         for (;;) {
  55:             tp = fp[1];
  56:             if (tp != NIL) {
  57:                 setline(tp[1]);
  58:                 ip = tp[2];
  59:                 ppitem();
  60:                 if (ip != NIL)
  61:                     for (;;) {
  62:                         ppid(ip[1]);
  63:                         ip = ip[2];
  64:                         if (ip == NIL)
  65:                             break;
  66:                         ppsep(", ");
  67:                     }
  68:                 else
  69:                     ppid("{field id list}");
  70:                 ppsep(":");
  71:                 gtype(tp[3]);
  72:                 setinfo(tp[1]);
  73:                 putcm();
  74:             }
  75:             fp = fp[2];
  76:             if (fp == NIL)
  77:                 break;
  78:             ppsep(";");
  79:         }
  80:     if (v != NIL && r != NIL)
  81:         ppsep(";");
  82: }
  83: 
  84: variant(r)
  85:     register int *r;
  86: {
  87:     register int *v, *vc;
  88: 
  89:     if (r == NIL)
  90:         return;
  91:     setline(r[1]);
  92:     ppitem();
  93:     ppkw("case");
  94:     v = r[2];
  95:     if (v != NIL) {
  96:         ppspac();
  97:         ppid(v);
  98:         ppsep(":");
  99:     }
 100:     gtype(r[3]);
 101:     ppspac();
 102:     ppkw("of");
 103:     for (vc = r[4]; vc != NIL;) {
 104:         v = vc[1];
 105:         if (v == NIL)
 106:             continue;
 107:         ppgoin(DECL);
 108:         setline(v[1]);
 109:         ppnl();
 110:         indent();
 111:         ppbra(NIL);
 112:         v = v[2];
 113:         if (v != NIL) {
 114:             for (;;) {
 115:                 gconst(v[1]);
 116:                 v = v[2];
 117:                 if (v == NIL)
 118:                     break;
 119:                 ppsep(", ");
 120:             }
 121:         } else
 122:             ppid("{case label list}");
 123:         ppket(":");
 124:         v = vc[1];
 125:         tyrec(v[3], 1);
 126:         setinfo(v[1]);
 127:         putcml();
 128:         ppgoout(DECL);
 129:         vc = vc[2];
 130:         if (vc == NIL)
 131:             break;
 132:         ppsep(";");
 133:     }
 134:     setinfo(r[1]);
 135:     putcm();
 136: }

Defined functions