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