home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PASCAL / KRTOOL.ZIP / CHAPTER8.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-10-19  |  11.9 KB  |  594 lines
  1. {$A-}
  2. PROGRAM CHAPTER8;
  3. {$I TOOLU.PAS}
  4.  
  5. PROCEDURE MACRO;
  6. CONST
  7.   BUFSIZE=1000;
  8.   MAXCHARS=500;
  9.   MAXPOS=500;
  10.   CALLSIZE=MAXPOS;
  11.   ARGSIZE=MAXPOS;
  12.   EVALSIZE=MAXCHARS;
  13.   MAXDEF=MAXSTR;
  14.   MAXTOK=MAXSTR;
  15.   HASHSIZE=53;
  16.   ARGFLAG=DOLLAR;
  17. TYPE
  18.   CHARPOS=1..MAXCHARS;
  19.   CHARBUF=ARRAY[1..MAXCHARS]OF CHARACTER;
  20.   POSBUF=ARRAY[1..MAXPOS]OF CHARPOS;
  21.   POS=0..MAXPOS;
  22.   STTYPE=(DEFTYPE,MACTYPE,IFTYPE,SUBTYPE,
  23.   EXPRTYPE,LENTYPE,CHQTYPE);
  24.   NDPTR=^NDBLOCK;
  25.   NDBLOCK=RECORD
  26.     NAME:CHARPOS;
  27.     DEFN:CHARPOS;
  28.     KIND:STTYPE;
  29.     NEXTPTR:NDPTR
  30.    END;
  31.  
  32. VAR
  33.   BUF:ARRAY[1..BUFSIZE]OF CHARACTER;
  34.   BP:0..BUFSIZE;
  35.   HASHTAB:ARRAY[1..HASHSIZE]OF NDPTR;
  36.   NDTABLE:CHARBUF;
  37.   NEXTTAB:CHARPOS;
  38.   CALLSTK:POSBUF;
  39.   CP:POS;
  40.   TYPESTK:ARRAY[1..CALLSIZE]OF STTYPE;
  41.   PLEV:ARRAY[1..CALLSIZE]OF INTEGER;
  42.   ARGSTK:POSBUF;
  43.   AP:POS;
  44.   EVALSTK:CHARBUF;
  45.   EP:CHARPOS;
  46.   (*BUILTINS*)
  47.   DEFNAME:XSTRING;
  48.   EXPRNAME:XSTRING;
  49.   SUBNAME,IFNAME,LENNAME,CHQNAME:XSTRING;
  50.   NULL:XSTRING;
  51.   LQUOTE,RQUOTE:CHARACTER;
  52.   DEFN,TOKEN:XSTRING;
  53.   TOKTYPE:STTYPE;
  54.   T:CHARACTER;
  55.   NLPAR:INTEGER;
  56. PROCEDURE PUTCHR(C:CHARACTER);
  57. BEGIN
  58.   IF(CP<=0) THEN
  59.     PUTC(C)
  60.   ELSE BEGIN
  61.     IF(EP>EVALSIZE)THEN
  62.       ERROR('MACRO: evaluation stack overflow');
  63.     EVALSTK[EP]:=C;
  64.     EP:=EP+1
  65.   END
  66. END;
  67.  
  68. PROCEDURE PUTTOK(VAR S:XSTRING);
  69. VAR
  70.   I:INTEGER;
  71. BEGIN
  72.   I:=1;
  73.   WHILE(S[I]<>ENDSTR) DO BEGIN
  74.     PUTCHR(S[I]);
  75.     I:=I+1
  76.   END
  77. END;
  78.  
  79.  
  80. FUNCTION PUSH(EP:INTEGER;VAR ARGSTK:POSBUF;AP:INTEGER):INTEGER;
  81. BEGIN
  82.   IF(AP>ARGSIZE)THEN
  83.     ERROR('MACRO: argument stack overflow');
  84.   ARGSTK[AP]:=EP;
  85.   PUSH:=AP+1
  86. END;
  87.  
  88. PROCEDURE SCCOPY(VAR S:XSTRING;VAR CB:CHARBUF;
  89. I:CHARPOS);
  90. VAR J:INTEGER;
  91. BEGIN
  92.   J:=1;
  93.   WHILE(S[J]<>ENDSTR)DO BEGIN
  94.     CB[I]:=S[J];
  95.     J:=J+1;
  96.     I:=I+1
  97.   END;
  98.   CB[I]:=ENDSTR
  99. END;
  100.  
  101. PROCEDURE CSCOPY(VAR CB:CHARBUF;I:CHARPOS;
  102.   VAR S:XSTRING);
  103. VAR J:INTEGER;
  104. BEGIN
  105.   J:=1;
  106.   WHILE(CB[I]<>ENDSTR)DO BEGIN
  107.     S[J]:=CB[I];
  108.     I:=I+1;
  109.     J:=J+1
  110.   END;
  111.   S[J]:=ENDSTR
  112. END;
  113.  
  114.  
  115. PROCEDURE PUTBACK(C:CHARACTER);
  116. BEGIN
  117.   IF(BP>=BUFSIZE)THEN
  118.     ERROR('too many characters pushed back');
  119.   BP:=BP+1;
  120.   BUF[BP]:=C
  121. END;
  122.  
  123. FUNCTION GETPBC(VAR C:CHARACTER):CHARACTER;
  124. BEGIN
  125.   IF(BP>0)THEN
  126.     C:=BUF[BP]
  127.   ELSE BEGIN
  128.     BP:=1;
  129.     BUF[BP]:=GETC(C)
  130.   END;
  131.   IF(C<>ENDFILE)THEN
  132.     BP:=BP-1;
  133.   GETPBC:=C
  134. END;
  135.  
  136. FUNCTION GETTOK(VAR TOKEN:XSTRING;TOKSIZE:INTEGER):
  137.   CHARACTER;
  138. VAR I:INTEGER;
  139.     DONE:BOOLEAN;
  140. BEGIN
  141.   I:=1;
  142.   DONE:=FALSE;
  143.   WHILE(NOT DONE) AND (I<TOKSIZE) DO
  144.     IF(ISALPHANUM(GETPBC(TOKEN[I]))) THEN
  145.       I:=I+1
  146.     ELSE
  147.       DONE:=TRUE;
  148.   IF(I>=TOKSIZE)THEN
  149.      ERROR('DEFINE: token too long');
  150.   IF(I>1) THEN BEGIN (*SOME ALPHA WAS SEEN*)
  151.     PUTBACK(TOKEN[I]);
  152.     I:=I-1
  153.   END;
  154.   (*ELSE SINGLE NON-ALPHANUMERIC*)
  155.   TOKEN[I+1]:=ENDSTR;
  156.   GETTOK:=TOKEN[1]
  157. END;
  158.  
  159. PROCEDURE PBSTR (VAR S:XSTRING);
  160. VAR I:INTEGER;
  161. BEGIN
  162.   FOR I:=XLENGTH(S) DOWNTO 1 DO
  163.     PUTBACK(S[I])
  164. END;
  165.  
  166.  
  167. FUNCTION HASH(VAR NAME:XSTRING):INTEGER;
  168. VAR
  169.   I,H:INTEGER;
  170. BEGIN
  171.   H:=0;
  172.   FOR I:=1 TO XLENGTH(NAME) DO
  173.     H:=(3*H+NAME[I]) MOD HASHSIZE;
  174.   HASH:=H+1
  175. END;
  176.  
  177. FUNCTION HASHFIND(VAR NAME:XSTRING):NDPTR;
  178. VAR
  179.   P:NDPTR;
  180.   TEMPNAME:XSTRING;
  181.   FOUND:BOOLEAN;
  182. BEGIN
  183.   FOUND:=FALSE;
  184.   P:=HASHTAB[HASH(NAME)];
  185.   WHILE (NOT FOUND) AND (P<>NIL) DO BEGIN
  186.     CSCOPY(NDTABLE,P^.NAME,TEMPNAME);
  187.     IF(EQUAL(NAME,TEMPNAME)) THEN
  188.       FOUND:=TRUE
  189.     ELSE
  190.       P:=P^.NEXTPTR
  191.   END;
  192.   HASHFIND:=P
  193. END;
  194.  
  195. PROCEDURE INITHASH;
  196. VAR I:1..HASHSIZE;
  197. BEGIN
  198.   NEXTTAB:=1;
  199.   FOR I:=1 TO HASHSIZE DO
  200.     HASHTAB[I]:=NIL
  201. END;
  202.  
  203. FUNCTION LOOKUP(VAR NAME,DEFN:XSTRING; VAR T:STTYPE)
  204.  :BOOLEAN;
  205. VAR P:NDPTR;
  206. BEGIN
  207.   P:=HASHFIND(NAME);
  208.   IF(P=NIL)THEN
  209.     LOOKUP:=FALSE
  210.   ELSE BEGIN
  211.     LOOKUP:=TRUE;
  212.     CSCOPY(NDTABLE,P^.DEFN,DEFN);
  213.     T:=P^.KIND
  214.   END
  215. END;
  216.  
  217.  
  218. PROCEDURE INSTALL(VAR NAME,DEFN:XSTRING;T:STTYPE);
  219. VAR
  220.   H,DLEN,NLEN:INTEGER;
  221.   P:NDPTR;
  222. BEGIN
  223.   NLEN:=XLENGTH(NAME)+1;
  224.   DLEN:=XLENGTH(DEFN)+1;
  225.   IF(NEXTTAB + NLEN +DLEN > MAXCHARS) THEN BEGIN
  226.     PUTSTR(NAME,STDERR);
  227.     ERROR(': too many definitions')
  228.   END
  229.   ELSE BEGIN
  230.     H:=HASH(NAME);
  231.     NEW(P);
  232.     P^.NEXTPTR:=HASHTAB[H];
  233.     HASHTAB[H]:=P;
  234.     P^.NAME:=NEXTTAB;
  235.     SCCOPY(NAME,NDTABLE,NEXTTAB);
  236.     NEXTTAB:=NEXTTAB+NLEN;
  237.     P^.DEFN:=NEXTTAB;
  238.     SCCOPY(DEFN,NDTABLE,NEXTTAB);
  239.     NEXTTAB:=NEXTTAB+DLEN;
  240.     P^.KIND:=T
  241.   END
  242. END;
  243.  
  244.  
  245.  
  246. PROCEDURE DODEF(VAR ARGSTK:POSBUF;I,J:INTEGER);
  247. VAR
  248.   TEMP1,TEMP2 : XSTRING;
  249. BEGIN
  250.   IF(J-I>2) THEN BEGIN
  251.     CSCOPY(EVALSTK,ARGSTK[I+2],TEMP1);
  252.     CSCOPY(EVALSTK,ARGSTK[I+3],TEMP2);
  253.     INSTALL(TEMP1,TEMP2,MACTYPE)
  254.   END
  255. END;
  256.   
  257.  
  258. PROCEDURE DOIF(VAR ARGSTK:POSBUF;I,J:INTEGER);
  259. VAR
  260.   TEMP1,TEMP2,TEMP3:XSTRING;
  261. BEGIN
  262.   IF(J-I>=4) THEN BEGIN
  263.     CSCOPY(EVALSTK,ARGSTK[I+2],TEMP1);
  264.     CSCOPY(EVALSTK,ARGSTK[I+3],TEMP2);
  265.     IF(EQUAL(TEMP1,TEMP2))THEN
  266.       CSCOPY(EVALSTK,ARGSTK[I+4],TEMP3)
  267.     ELSE IF (J-I>=5) THEN
  268.       CSCOPY(EVALSTK,ARGSTK[I+5],TEMP3)
  269.     ELSE
  270.       TEMP3[I]:=ENDSTR;
  271.     PBSTR(TEMP3)
  272.   END
  273. END;
  274.  
  275. PROCEDURE PBNUM(N:INTEGER);
  276. VAR
  277.   TEMP:XSTRING;
  278.   JUNK:INTEGER;
  279. BEGIN
  280.   JUNK:=ITOC(N,TEMP,1);
  281.   PBSTR(TEMP)
  282. END;
  283. FUNCTION EXPR(VAR S:XSTRING;VAR I:INTEGER):INTEGER;FORWARD;
  284.  
  285. PROCEDURE DOEXPR(VAR ARGSTK:POSBUF;I,J:INTEGER);
  286. VAR
  287.   JUNK:INTEGER;
  288.   TEMP:XSTRING;
  289. BEGIN
  290.   CSCOPY(EVALSTK,ARGSTK[I+2],TEMP);
  291.   JUNK:=1;
  292.   PBNUM(EXPR(TEMP,JUNK))
  293. END;
  294.  
  295. FUNCTION EXPR;
  296. VAR
  297.   V:INTEGER;
  298.   T:CHARACTER;
  299.   
  300. FUNCTION GNBCHAR(VAR S:XSTRING;VAR I:INTEGER):CHARACTER;
  301. BEGIN
  302.   WHILE(S[I]IN[BLANK,TAB,NEWLINE])DO
  303.     I:=I+1;
  304.   GNBCHAR:=S[I]
  305. END;
  306.  
  307. FUNCTION TERM(VAR S:XSTRING;VAR I:INTEGER):INTEGER;
  308. VAR
  309.   V:INTEGER;
  310.   T:CHARACTER;
  311.  
  312. FUNCTION FACTOR (VAR S:XSTRING;VAR I:INTEGER):
  313.   INTEGER;
  314. BEGIN
  315.   IF(GNBCHAR(S,I)=LPAREN) THEN BEGIN
  316.     I:=I+1;
  317.     FACTOR:=EXPR(S,I);
  318.     IF(GNBCHAR(S,I)=RPAREN) THEN
  319.       I:=I+1
  320.     ELSE
  321.       WRITELN('MACRO: missing paren in expr')
  322.   END
  323.   ELSE
  324.     FACTOR:=CTOI(S,I)
  325. END;(*FACTOR*)
  326.  
  327. BEGIN(*TERM*)
  328.   V:=FACTOR(S,I);
  329.   T:=GNBCHAR(S,I);
  330.   WHILE(T IN [STAR,SLASH,PERCENT]) DO BEGIN
  331.     I:=I+1;
  332.     CASE T OF
  333.       STAR:V:=V*FACTOR(S,I);
  334.     SLASH:
  335.       V:=V DIV FACTOR(S,I);
  336.     PERCENT:
  337.       V:=V MOD FACTOR(S,I)
  338.     END;
  339.     T:=GNBCHAR(S,I)
  340.   END;
  341.   TERM:=V
  342. END;(*TERM*)
  343.  
  344. BEGIN(*EXPR*)
  345.   V:=TERM(S,I);
  346.   T:=GNBCHAR(S,I);
  347.   WHILE(T IN [PLUS,MINUS])DO BEGIN
  348.     I:=I+1;
  349.     IF(T IN [PLUS]) THEN
  350.       V:=V+TERM(S,I)
  351.     ELSE(*MINUS*)
  352.       V:=V-TERM(S,I);
  353.     T:=GNBCHAR(S,I)
  354.   END;
  355.   EXPR:=V
  356. END;
  357.  
  358. PROCEDURE DOLEN(VAR ARGSTK:POSBUF;I,J:INTEGER);
  359. VAR
  360.   TEMP:XSTRING;
  361. BEGIN
  362.   IF(J-I>1)THEN BEGIN
  363.     CSCOPY(EVALSTK,ARGSTK[I+2],TEMP);
  364.     PBNUM(XLENGTH(TEMP))
  365.   END
  366.   ELSE
  367.     PBNUM(0)
  368. END;
  369.   
  370.  
  371. PROCEDURE DOSUB(VAR ARGSTK:POSBUF;I,J:INTEGER);
  372. VAR
  373.   AP,FC,K,NC:INTEGER;
  374.   TEMP1,TEMP2:XSTRING;
  375. BEGIN
  376.   IF(J-I>=3) THEN BEGIN
  377.     IF(J-I<4) THEN
  378.       NC:=MAXTOK
  379.     ELSE BEGIN
  380.       CSCOPY(EVALSTK,ARGSTK[I+4],TEMP1);
  381.       K:=1;
  382.       NC:=EXPR(TEMP1,K)
  383.     END;
  384.     CSCOPY(EVALSTK,ARGSTK[I+3],TEMP1);
  385.     AP:=ARGSTK[I+2];
  386.     K:=1;
  387.     FC:=AP+EXPR(TEMP1,K)-1;
  388.     CSCOPY(EVALSTK,AP,TEMP2);
  389.     IF(FC>=AP) AND (FC<AP+XLENGTH(TEMP2)) THEN BEGIN
  390.       CSCOPY(EVALSTK,FC,TEMP1);
  391.       FOR K:=FC+MIN(NC,XLENGTH(TEMP1))-1 DOWNTO FC DO
  392.         PUTBACK(EVALSTK[K])
  393.       END
  394.     END
  395.   END;
  396.  
  397.   PROCEDURE DOCHQ(VAR ARGSTK:POSBUF;I,J:INTEGER);
  398.   VAR
  399.     TEMP:XSTRING;
  400.     N:INTEGER;
  401.   BEGIN
  402.     CSCOPY(EVALSTK,ARGSTK[I+2],TEMP);
  403.     N:=XLENGTH(TEMP);
  404.     IF(N<=0)THEN BEGIN
  405.       LQUOTE:=ORD(LESS);
  406.       RQUOTE:=ORD(GREATER)
  407.     END
  408.     ELSE IF (N=1) THEN BEGIN
  409.       LQUOTE:=TEMP[1];
  410.       RQUOTE:=LQUOTE
  411.     END
  412.     ELSE BEGIN
  413.       LQUOTE:=TEMP[1];
  414.       RQUOTE:=TEMP[2]
  415.     END
  416.   END;
  417.   
  418.  
  419. PROCEDURE EVAL(VAR ARGSTK:POSBUF;TD:STTYPE;
  420.   I,J:INTEGER);
  421. VAR
  422.   ARGNO,K,T:INTEGER;
  423.   TEMP:XSTRING;
  424. BEGIN
  425.   T:=ARGSTK[I];
  426.   IF(TD=DEFTYPE)THEN
  427.     DODEF(ARGSTK,I,J)
  428.   ELSE IF (TD=EXPRTYPE)THEN
  429.     DOEXPR(ARGSTK,I,J)
  430.   ELSE IF (TD=SUBTYPE) THEN
  431.     DOSUB(ARGSTK,I,J)
  432.   ELSE IF (TD=IFTYPE) THEN
  433.     DOIF(ARGSTK,I,J)
  434.   ELSE IF (TD=LENTYPE) THEN
  435.     DOLEN(ARGSTK,I,J)
  436.   ELSE IF (TD=CHQTYPE) THEN
  437.     DOCHQ(ARGSTK,I,J)
  438.   ELSE BEGIN
  439.     K:=T;
  440.     WHILE(EVALSTK[K]<>ENDSTR) DO
  441.       K:=K+1;
  442.     K:=K-1;
  443.     WHILE(K>T) DO BEGIN
  444.       IF(EVALSTK[K-1] <> ARGFLAG) THEN
  445.         PUTBACK(EVALSTK[K])
  446.       ELSE BEGIN
  447.         ARGNO:=ORD(EVALSTK[K])-ORD('0');
  448.         IF(ARGNO>=0) AND (ARGNO <J-I)THEN BEGIN
  449.           CSCOPY(EVALSTK,ARGSTK[I+ARGNO+1],TEMP);
  450.           PBSTR(TEMP)
  451.         END;
  452.         K:=K-1
  453.       END;
  454.       K:=K-1
  455.     END;
  456.     IF(K=T)THEN
  457.       PUTBACK(EVALSTK[K])
  458.     END
  459.   END;
  460. PROCEDURE INITMACRO;
  461.   BEGIN
  462.     NULL[1]:=ENDSTR;
  463.       DEFNAME[1]:=ORD('d');
  464.       DEFNAME[2]:=ORD('e');
  465.       DEFNAME[3]:=ORD('f');
  466.       DEFNAME[4]:=ORD('i');
  467.       DEFNAME[5]:=ORD('n');
  468.       DEFNAME[6]:=ORD('e');
  469.       DEFNAME[7]:=ENDSTR;
  470.       SUBNAME[1]:=ORD('s');
  471.       SUBNAME[2]:=ORD('u');
  472.       SUBNAME[3]:=ORD('b');
  473.       SUBNAME[4]:=ORD('s');
  474.       SUBNAME[5]:=ORD('t');
  475.       SUBNAME[6]:=ORD('r');
  476.       SUBNAME[7]:=ENDSTR;
  477.       EXPRNAME[1]:=ORD('e');
  478.       EXPRNAME[2]:=ORD('x');
  479.       EXPRNAME[3]:=ORD('p');
  480.       EXPRNAME[4]:=ORD('r');
  481.       EXPRNAME[5]:=ENDSTR;
  482.       IFNAME[1]:=ORD('i');
  483.       IFNAME[2]:=ORD('f');
  484.       IFNAME[3]:=ORD('e');
  485.       IFNAME[4]:=ORD('l');
  486.       IFNAME[5]:=ORD('s');
  487.       IFNAME[6]:=ORD('e');
  488.       IFNAME[7]:=ENDSTR;
  489.       LENNAME[1]:=ORD('l');
  490.       LENNAME[2]:=ORD('e');
  491.       LENNAME[3]:=ORD('n');
  492.       LENNAME[4]:=ENDSTR;
  493.       CHQNAME[1]:=ORD('c');
  494.       CHQNAME[2]:=ORD('h');
  495.       CHQNAME[3]:=ORD('a');
  496.       CHQNAME[4]:=ORD('n');
  497.       CHQNAME[5]:=ORD('g');
  498.       CHQNAME[6]:=ORD('e');
  499.       CHQNAME[7]:=ORD('q');
  500.       CHQNAME[8]:=ENDSTR;
  501.     BP:=0;
  502.     INITHASH;
  503.     LQUOTE:=ORD('`');
  504.     RQUOTE:=ORD('''')
  505.   END;
  506.  
  507.       
  508.  
  509.   
  510. BEGIN
  511.   INITMACRO;
  512.   INSTALL(DEFNAME,NULL,DEFTYPE);
  513.   INSTALL(EXPRNAME,NULL,EXPRTYPE);
  514.   INSTALL(SUBNAME,NULL,SUBTYPE);
  515.   INSTALL(IFNAME,NULL,IFTYPE);
  516.   INSTALL(LENNAME,NULL,LENTYPE);
  517.   INSTALL(CHQNAME,NULL,CHQTYPE);
  518.   
  519.   CP:=0;AP:=1;EP:=1;
  520.   
  521.   WHILE(GETTOK(TOKEN,MAXTOK)<>ENDFILE)DO
  522.     IF(ISLETTER(TOKEN[1]))THEN BEGIN
  523.       IF(NOT LOOKUP(TOKEN,DEFN,TOKTYPE))THEN
  524.         PUTTOK(TOKEN)
  525.       ELSE BEGIN
  526.         CP:=CP+1;
  527.         IF(CP>CALLSIZE)THEN
  528.           ERROR('MACRO: call stack overflow');
  529.         CALLSTK[CP]:=AP;
  530.         TYPESTK[CP]:=TOKTYPE;
  531.         AP:=PUSH(EP,ARGSTK,AP);
  532.         PUTTOK(DEFN);
  533.         PUTCHR(ENDSTR);
  534.         AP:=PUSH(EP,ARGSTK,AP);
  535.         PUTTOK(TOKEN);
  536.         PUTCHR(ENDSTR);
  537.         AP:=PUSH(EP,ARGSTK,AP);
  538.         T:=GETTOK(TOKEN,MAXTOK);
  539.         PBSTR(TOKEN);
  540.         IF(T<>LPAREN)THEN BEGIN
  541.           PUTBACK(RPAREN);
  542.           PUTBACK(LPAREN)
  543.         END;
  544.         PLEV[CP]:=0
  545.       END
  546.     END
  547.     ELSE IF(TOKEN[1]=LQUOTE) THEN BEGIN
  548.       NLPAR:=1;
  549.       REPEAT
  550.         T:=GETTOK(TOKEN,MAXTOK);
  551.         IF(T=RQUOTE)THEN
  552.           NLPAR:=NLPAR-1
  553.         ELSE IF (T=LQUOTE)THEN
  554.           NLPAR:=NLPAR+1
  555.         ELSE IF (T=ENDFILE) THEN
  556.           ERROR('MACRO: missing right quote');
  557.         IF(NLPAR>0) THEN
  558.           PUTTOK(TOKEN)
  559.       UNTIL(NLPAR=0)
  560.     END
  561.     ELSE IF (CP=0)THEN
  562.       PUTTOK(TOKEN)
  563.     ELSE IF (TOKEN[1]=LPAREN) THEN BEGIN
  564.       IF(PLEV[CP]>0)THEN
  565.         PUTTOK(TOKEN);
  566.       PLEV[CP]:=PLEV[CP]+1
  567.     END
  568.     ELSE IF (TOKEN[1]=RPAREN)THEN BEGIN
  569.       PLEV[CP]:=PLEV[CP]-1;
  570.       IF(PLEV[CP]>0)THEN
  571.         PUTTOK(TOKEN)
  572.       ELSE BEGIN
  573.         PUTCHR(ENDSTR);
  574.         EVAL(ARGSTK,TYPESTK[CP],CALLSTK[CP],AP-1);
  575.         AP:=CALLSTK[CP];
  576.         EP:=ARGSTK[AP];
  577.         CP:=CP-1
  578.       END
  579.     END
  580.     ELSE IF (TOKEN[1]=COMMA) AND (PLEV[CP]=1)THEN BEGIN
  581.       PUTCHR(ENDSTR);
  582.       AP:=PUSH(EP,ARGSTK,AP)
  583.     END
  584.     ELSE
  585.       PUTTOK(TOKEN);
  586.   IF(CP<>0)THEN
  587.     ERROR('MACRO: unexpected end of input')
  588. END;
  589.  
  590. BEGIN
  591.   MACRO;
  592.   ENDCMD;
  593. END.
  594.