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