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

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

Defined functions

Defined variables