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