home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / EPB13.ZIP / EPB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-05-25  |  14.8 KB  |  726 lines
  1. {ED'S PASCAL BEAUTIFIER v1.3}
  2. {Copyright 1990 by Edward Lee}
  3. {edlee@chinet.chi.il.us}
  4. {Turbo Pascal v4.0}
  5.  
  6. {31Jan1990 20:00}{Program begun}
  7. {1 Feb1990 16:41}
  8. {2 Feb1990 16:47}{v1.0 complete}{Capitalizes keywords}
  9. {4 Feb1990 22:34}{v1.1 complete}{-Lower case option added}
  10. {7 Feb1990 00:29}{v1.2 complete}{Non-alphabetic token padding added}{Identifier parsing debugged}
  11. {25Mar1990 21:15}{v1.3 maintenance}{ ) append rule modified; (***) parsing debugged; REGISTERS and TEXT keywords added}
  12. {Possible future feature:  full, automatic indentation}
  13.  
  14. LABEL
  15.   findasterisk, out, start;
  16.  
  17. CONST
  18.   nkeys = 258;  (* Number of key strings to capitalize *)
  19.  
  20.   listkeys : ARRAY [1..nkeys] OF STRING [17] =
  21. (
  22. 'ABS',
  23. 'ABSOLUTE',
  24. 'ADDR',
  25. 'AND',
  26. 'APPEND',
  27. 'ARC',
  28. 'ARCTAN',
  29. 'ARRAY',
  30. 'ASSIGN',
  31. 'ASSIGNCRT',
  32. 'BAR',
  33. 'BAR3D',
  34. 'BEGIN',
  35. 'BLOCKREAD',
  36. 'BLOCKWRITE',
  37. 'BOOLEAN',
  38. 'BYTE',
  39. 'CASE',
  40. 'CHAR',
  41. 'CHDIR',
  42. 'CHR',
  43. 'CIRCLE',
  44. 'CLEARDEVICE',
  45. 'CLEARVIEWPORT',
  46. 'CLOSE',
  47. 'CLOSEGRAPH',
  48. 'CLREOL',
  49. 'CLRSCR',
  50. 'COMP',
  51. 'CONCAT',
  52. 'CONST',
  53. 'COPY',
  54. 'COS',
  55. 'CSEG',
  56. 'DEC',
  57. 'DELAY',
  58. 'DELETE',
  59. 'DELLINE',
  60. 'DETECTGRAPH',
  61. 'DISKFREE',
  62. 'DISKSIZE',
  63. 'DISPOSE',
  64. 'DIV',
  65. 'DO',
  66. 'DOSEXITCODE',
  67. 'DOUBLE',
  68. 'DOWNTO',
  69. 'DRAWPOLY',
  70. 'DSEG',
  71. 'ELLIPSE',
  72. 'ELSE',
  73. 'END',
  74. 'EOF',
  75. 'EOLN',
  76. 'ERASE',
  77. 'EXEC',
  78. 'EXIT',
  79. 'EXP',
  80. 'EXTENDED',
  81. 'EXTERNAL',
  82. 'FALSE',
  83. 'FILE',
  84. 'FILEPOS',
  85. 'FILESIZE',
  86. 'FILLCHAR',
  87. 'FILLPOLY',
  88. 'FINDFIRST',
  89. 'FINDNEXT',
  90. 'FLOODFILL',
  91. 'FLUSH',
  92. 'FOR',
  93. 'FORWARD',
  94. 'FRAC',
  95. 'FREEMEM',
  96. 'FUNCTION',
  97. 'GETARCCOORDS',
  98. 'GETASPECTRATIO',
  99. 'GETBKCOLOR',
  100. 'GETCOLOR',
  101. 'GETDATE',
  102. 'GETDIR',
  103. 'GETFATTR',
  104. 'GETFILLPATTERN',
  105. 'GETFILLSETTINGS',
  106. 'GETFTIME',
  107. 'GETGRAPHMODE',
  108. 'GETIMAGE',
  109. 'GETINTVEC',
  110. 'GETLINESETTINGS',
  111. 'GETMAXCOLOR',
  112. 'GETMAXX',
  113. 'GETMAXY',
  114. 'GETMEM',
  115. 'GETMODERANGE',
  116. 'GETPALLETTE',
  117. 'GETPIXEL',
  118. 'GETTEXTSETTINGS',
  119. 'GETTIME',
  120. 'GETVIEWSETTINGS',
  121. 'GETX',
  122. 'GETY',
  123. 'GOTO',
  124. 'GOTOXY',
  125. 'GRAPHDEFAULTS',
  126. 'GRAPHERRORMESG',
  127. 'GRAPHRESULT',
  128. 'HALT',
  129. 'HI',
  130. 'HIGHVIDEO',
  131. 'IF',
  132. 'IMAGESIZE',
  133. 'IMPLEMENTATION',
  134. 'IN',
  135. 'INC',
  136. 'INITGRAPH',
  137. 'INLINE',
  138. 'INSERT',
  139. 'INSLINE',
  140. 'INT',
  141. 'INTEGER',
  142. 'INTERFACE',
  143. 'INTERRUPT',
  144. 'INTR',
  145. 'IORESULT',
  146. 'KEEP',
  147. 'KEYPRESSED',
  148. 'LABEL',
  149. 'LENGTH',
  150. 'LINE',
  151. 'LINEREL',
  152. 'LINETO',
  153. 'LN',
  154. 'LO',
  155. 'LONGINT',
  156. 'LOWVIDEO',
  157. 'MARK',
  158. 'MAXAVAIL',
  159. 'MEMAVAIL',
  160. 'MKDIR',
  161. 'MOD',
  162. 'MOVE',
  163. 'MOVEREL',
  164. 'MOVETO',
  165. 'MSDOS',
  166. 'NEW',
  167. 'NIL',
  168. 'NORMVIDEO',
  169. 'NOSOUND',
  170. 'NOT',
  171. 'ODD',
  172. 'OF',
  173. 'OFS',
  174. 'OR',
  175. 'ORD',
  176. 'OUTTEXT',
  177. 'OUTTEXTXY',
  178. 'PACKED',
  179. 'PACKTIME',
  180. 'PARAMCOUNT',
  181. 'PARAMSTR',
  182. 'PI',
  183. 'PIESLICE',
  184. 'POINTER',
  185. 'POS',
  186. 'PRED',
  187. 'PROCEDURE',
  188. 'PROGRAM',
  189. 'PTR',
  190. 'PUTIMAGE',
  191. 'PUTPIXEL',
  192. 'RANDOM',
  193. 'RANDOMIZE',
  194. 'READ',
  195. 'READKEY',
  196. 'READLN',
  197. 'REAL',
  198. 'RECORD',
  199. 'RECTANGLE',
  200. 'REGISTERBGIFONT',
  201. 'REGISTERBGIDRIVER',
  202. 'REGISTERS',
  203. 'RELEASE',
  204. 'RENAME',
  205. 'REPEAT',
  206. 'RESET',
  207. 'RESTORECRTMODE',
  208. 'REWRITE',
  209. 'RMDIR',
  210. 'ROUND',
  211. 'SEEK',
  212. 'SEEKEOF',
  213. 'SEEKEOLN',
  214. 'SEG',
  215. 'SET',
  216. 'SETACTIVEPAGE',
  217. 'SETALLPALETTE',
  218. 'SETBKCOLOR',
  219. 'SETCOLOR',
  220. 'SETDATE',
  221. 'SETFATTR',
  222. 'SETFILLPATTERN',
  223. 'SETFILLSTYLE',
  224. 'SETFTIME',
  225. 'SETGRAPHBUFSIZE',
  226. 'SETGRAPHMODE',
  227. 'SETINTVEC',
  228. 'SETLINESTYLE',
  229. 'SETPALETTE',
  230. 'SETTEXTBUF',
  231. 'SETTEXTJUSTIFY',
  232. 'SETTEXTSTYLE',
  233. 'SETTIME',
  234. 'SETUSERCHARSIZE',
  235. 'SETVIEWPORT',
  236. 'SETVISUALPAGE',
  237. 'SHORTINT',
  238. 'SHL',
  239. 'SHR',
  240. 'SIN',
  241. 'SINGLE',
  242. 'SIZEOF',
  243. 'SOUND',
  244. 'SPTR',
  245. 'SQR',
  246. 'SQRT',
  247. 'SSEG',
  248. 'STR',
  249. 'STRING',
  250. 'SUCC',
  251. 'SWAP',
  252. 'TEXT',
  253. 'TEXTBACKGROUND',
  254. 'TEXTCOLOR',
  255. 'TEXTHEIGHT',
  256. 'TEXTMODE',
  257. 'TEXTWIDTH',
  258. 'THEN',
  259. 'TO',
  260. 'TRUE',
  261. 'TRUNC',
  262. 'TRUNCATE',
  263. 'TYPE',
  264. 'UNIT',
  265. 'UNPACKTIME',
  266. 'UNTIL',
  267. 'UPCASE',
  268. 'USES',
  269. 'VAL',
  270. 'VAR',
  271. 'WHEREX',
  272. 'WHEREY',
  273. 'WHILE',
  274. 'WINDOW',
  275. 'WITH',
  276. 'WORD',
  277. 'WRITE',
  278. 'WRITELN',
  279. 'XOR'
  280. );  (* const listkeys (whew!) *)
  281.  
  282.   sizebuf = 65535;  (* Let's go for the maximum buffer size *)
  283.  
  284. TYPE
  285.   mybuf = ARRAY [0..65534] OF CHAR;
  286.  
  287. VAR
  288.   a, b              (* Input and Output buffer pointers *)
  289. : ^mybuf;
  290.  
  291.   istream, lowercase, ostream, showbrackcom, showparencom
  292. : BOOLEAN;
  293.  
  294.   ch, lastch
  295. : CHAR;
  296.  
  297.   infile, outfile
  298. : FILE;
  299.  
  300.   i
  301. : INTEGER;
  302.  
  303.   iname, lstr, oname, s, ustr
  304. : STRING;
  305.  
  306.   ia, ib, nread, nwrit
  307. : WORD;
  308.  
  309.  
  310. FUNCTION binsearch (s : STRING) : BOOLEAN;
  311. (*
  312.  * Binary Search variation:  success or failure returned, no index returned
  313.  *
  314.  * middle := (left+right) div 2
  315.  * if middle=left then success := (s$ = a[left]) or (s$ = a[right]) else
  316.  *   if s$ < a[middle] then right := middle;  repeat from top  else
  317.  *     if s$ > a[middle] then left := middle;  repeat from top  else  success := true;
  318.  *
  319.  * The success flag may be left undefined before entering the search routine
  320.  *)
  321. LABEL loop;
  322. VAR
  323.   flag
  324. : BOOLEAN;
  325.  
  326.   b, m, t
  327. : WORD;
  328.  
  329. {listkeys, nkeys}
  330. BEGIN
  331.   b := 1;  t := nkeys;
  332.  
  333. loop :
  334.   m := (b + t) DIV 2;
  335.   IF (m = b) THEN
  336.      flag := ( (s = listkeys [b]) OR (s = listkeys [t]) )
  337.   ELSE
  338.      IF (s < listkeys [m]) THEN
  339.         BEGIN
  340.         t := m;
  341.         GOTO loop;
  342.         END
  343.      ELSE
  344.         IF (s > listkeys [m]) THEN
  345.            BEGIN
  346.            b := m;
  347.            GOTO loop;
  348.            END
  349.         ELSE
  350.            flag := TRUE;
  351.  
  352.   binsearch := flag;
  353. END;  (* binsearch *)
  354.  
  355. PROCEDURE writeblock;
  356. {ib, outfile, b nwrit, oname}
  357. BEGIN
  358.   BLOCKWRITE (outfile, b^, ib, nwrit);
  359.   
  360.   IF (nwrit <> ib) AND (oname <> '') THEN  (* Don't check output to STDOUT *)
  361.   BEGIN
  362.   WRITELN ('pb:  cannot finish outputting');
  363.   WRITELN ('ib = ', ib, ' nwritten = ', nwrit);
  364.   CLOSE (outfile);
  365.   HALT;
  366.   END;
  367.   
  368.   ib := 0;
  369. END;  (* writeblock *)
  370.  
  371. PROCEDURE getblock;
  372. {ia, infile, a, sizebuf, nread}
  373. BEGIN
  374.   ia := 0;  BLOCKREAD (infile, a^, sizebuf, nread);
  375.   
  376.   IF (nread = 0) THEN
  377.      BEGIN
  378.      writeblock;
  379.      CLOSE (infile);
  380.      HALT;
  381.      END;
  382. END;  (* getblock *)
  383.  
  384. PROCEDURE skipspace;
  385. {a, ia, nread}
  386. BEGIN
  387.   WHILE ( (a^ [ia] = #32) OR (a^ [ia] = #13) OR (a^ [ia] = #10) ) DO
  388.         BEGIN
  389.         INC (ia);  IF (ia >= nread) THEN getblock;
  390.         END;
  391. END;  (* skipspace *)
  392.  
  393. PROCEDURE outc (c : CHAR);
  394. {b, ib, lastch, sizebuf}
  395. BEGIN
  396.   CASE c OF
  397.     '[', '(', '<', '+', '/', '*', '-', ':' :
  398.       IF (lastch <> #32) AND (lastch <> #13) AND (lastch <> #10) THEN
  399.          BEGIN
  400.          b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  401.          END;
  402.  
  403.     '=' :
  404.       IF (lastch <> #32) AND (lastch <> #13) AND (lastch <> #10) AND
  405.          (lastch <> ':') AND (lastch <> '<') AND (lastch <> '>') THEN
  406.          BEGIN
  407.          b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  408.          END;
  409.  
  410.     '>' :
  411.       IF (lastch <> #32) AND (lastch <> #13) AND (lastch <> #10) AND
  412.          (lastch <> '<') THEN
  413.          BEGIN
  414.          b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  415.          END;
  416.  
  417.     ')' :
  418.       IF (lastch = ')') THEN
  419.          BEGIN
  420.          b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  421.          END;
  422.  
  423.     ELSE  (* case c *)
  424.  
  425.       IF (c <> #32) AND (c <> #13) AND (c <> #10) THEN
  426.       CASE lastch OF
  427.         '<' :
  428.           IF (c <> '>') AND (c <> '=') THEN
  429.              BEGIN
  430.              b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  431.              END;
  432.  
  433.         '>' :
  434.           IF (c <> '=') THEN
  435.              BEGIN
  436.              b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  437.              END;
  438.  
  439.         ':' :
  440.           IF (c <> '=') THEN
  441.              BEGIN
  442.              b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  443.              END;
  444.  
  445.         ')' :
  446.           IF (c <> ';') AND (c <> ',') THEN
  447.              BEGIN
  448.              b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  449.              END;
  450.  
  451.         '=', '+', '/', '*', '-', ',' :
  452.           BEGIN
  453.           b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  454.           END;
  455.       END;  (* case lastch *)
  456.   END;  (* case c *)
  457.  
  458.   b^ [ib] := c;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  459.   lastch := c;
  460.  
  461. END;  (* outc *)
  462.  
  463. PROCEDURE outp (c : CHAR);
  464. {b, ib, lastch, sizebuf}
  465. BEGIN
  466.   b^ [ib] := c;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  467. END;  (* outp *)
  468.  
  469. PROCEDURE outl (s : STRING);
  470. VAR
  471.   ch
  472. : CHAR;
  473.  
  474.   i, len
  475. : INTEGER;
  476. {b, ib, sizebuf}
  477. BEGIN
  478.   len := LENGTH (s);
  479.   IF (len <> 0) THEN
  480.      BEGIN
  481.      ch := s [1];
  482.      IF (ch >= 'A') AND (ch <= 'Z') THEN
  483.         ch := CHR (ORD (ch) + 32);
  484.      outc (ch);
  485.      END;
  486.  
  487.   FOR i := 2 TO len DO
  488.       BEGIN
  489.       ch := s [i];
  490.       IF (ch >= 'A') AND (ch <= 'Z') THEN
  491.          ch := CHR (ORD (ch) + 32);
  492.       b^ [ib] := ch;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  493.       END;
  494.  
  495.   lastch := ch;
  496. END;  (* outl *)
  497.  
  498. PROCEDURE outs (s : STRING);
  499. VAR
  500.   i, len
  501. : INTEGER;
  502. BEGIN
  503.   len := LENGTH (s);
  504.   IF (len <> 0) THEN
  505.      outc (s [1]);
  506.  
  507.   FOR i := 2 TO len DO
  508.       BEGIN
  509.       b^ [ib] := s [i];  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  510.       END;
  511.  
  512.   lastch := s [len];
  513. END;  (* outs *)
  514.  
  515. {---- MAIN PROGRAM ----}
  516. BEGIN
  517.  
  518.   IF (PARAMCOUNT = 0) THEN
  519.      BEGIN
  520.      WRITELN (#10'ED''S PASCAL BEAUTIFIER v1.3, Copyright 1990 by Edward Lee, -Ed L');
  521.      WRITELN ('edlee@chinet.chi.il.us');
  522.      WRITELN (#10'DESCRIPTION:');
  523.      WRITELN ('  This program capitalizes keywords and adds spaces around certain tokens.');
  524.      WRITELN ('  Optionally, this program filters comments and uncapitalizes user-defined');
  525.      WRITELN ('  LABEL, CONSTant, TYPE, VARiable, FUNCTION, and PROCEDURE identifiers.');
  526.      WRITELN (#10'INVOCATION:'#13#10'  epb [-biLop] [infile] [outfile]');
  527.      WRITELN (#10'OPTIONS (case insensitive, may be anywhere on command line):');
  528.      WRITELN (' -b  Shut off the output of Bracket comments:  { ... }');
  529.      WRITELN (' -p  Shut off the output of Parentheses comments:  (* ... *)');
  530.      WRITELN (' -i  Use the STDIN  stream for Input  instead of INFILE');
  531.      WRITELN (' -o  Use the STDOUT stream for Output instead of OUTFILE');
  532.      WRITELN (' -L  Cast all alphabetic characters that are non-keywords, non-comments,');
  533.      WRITELN ('     and non-string literals into Lower case');
  534.      HALT;
  535.      END;
  536.  
  537.   showparencom := TRUE;
  538.   showbrackcom := TRUE;
  539.   istream := FALSE;
  540.   ostream := FALSE;
  541.   lowercase := FALSE;
  542.   
  543.   FOR i := 1 TO PARAMCOUNT DO  (* Process options *)
  544.       BEGIN
  545.       s := PARAMSTR (i);
  546.       IF (s [1] = '-') THEN
  547.          BEGIN
  548.          IF (POS ('b', s) > 0) OR (POS ('B', s) > 0) THEN
  549.             showbrackcom := FALSE;
  550.          IF (POS ('p', s) > 0) OR (POS ('P', s) > 0) THEN
  551.             showparencom := FALSE;
  552.          IF (POS ('i', s) > 0) OR (POS ('I', s) > 0) THEN
  553.             istream := TRUE;
  554.          IF (POS ('o', s) > 0) OR (POS ('O', s) > 0) THEN
  555.             ostream := TRUE;
  556.          IF (POS ('l', s) > 0) OR (POS ('L', s) > 0) THEN
  557.             lowercase := TRUE;
  558.          END;
  559.       END;
  560.  
  561.   iname := '';
  562.   oname := '';
  563.  
  564.   IF NOT (istream AND ostream) THEN
  565.   FOR i := 1 TO PARAMCOUNT DO  (* Get filename(s) *)
  566.       BEGIN
  567.       s := PARAMSTR (i);
  568.       IF (s [1] <> '-') THEN   (* Skip option flags *)
  569.          BEGIN
  570.          IF (istream) THEN     (* Input is from STDIN *)
  571.             BEGIN
  572.             oname := s;
  573.             GOTO out;
  574.             END
  575.          ELSE
  576.          IF (ostream) THEN     (* Output is to STDOUT *)
  577.             BEGIN
  578.             iname := s;
  579.             GOTO out;
  580.             END
  581.          ELSE
  582.          IF (iname = '') THEN  (* Input is from infile *)
  583.             iname := s
  584.          ELSE
  585.             BEGIN
  586.             oname := s;        (* Output is to outfile *)
  587.             GOTO out;
  588.             END;
  589.          END;
  590.       END;
  591.  
  592. out :
  593.   ASSIGN (infile, iname);
  594.   {$I-} RESET (infile, 1);  {$I+}
  595.   IF (IORESULT <> 0) THEN
  596.      BEGIN
  597.      WRITELN ('PB:  cannot open input file.');
  598.      HALT;
  599.      END;
  600.  
  601.   ASSIGN (outfile, oname);  REWRITE (outfile, 1);
  602.   
  603.   NEW (a);
  604.   NEW (b);
  605.   getblock;
  606.   
  607.   ib := 0;
  608.   lastch := #0;
  609.   lstr := '';
  610.   ustr := '';
  611.  
  612. start :
  613.   ch := a^ [ia];
  614.   
  615.   CASE ch OF
  616.  
  617.     #39 :   (* Do not process the contents of literal strings *)
  618.       BEGIN
  619.       outc (a^ [ia]);
  620.       INC (ia);  IF (ia >= nread) THEN getblock;
  621.       outp (a^ [ia]);
  622.       WHILE (a^ [ia] <> #39) DO
  623.             BEGIN
  624.             INC (ia);  IF (ia >= nread) THEN getblock;
  625.             outp (a^ [ia]);
  626.             END;  (* a^[ia] = #39 *)
  627.       INC (ia);  IF (ia >= nread) THEN getblock;
  628.       GOTO start;
  629.       END;
  630.  
  631.     '{' :   (* Do not process the contents of { ... } comments *)
  632.       BEGIN
  633.       IF (showbrackcom) THEN outc (a^ [ia]);
  634.       INC (ia);  IF (ia >= nread) THEN getblock;
  635.       IF (showbrackcom) THEN outp (a^ [ia]);
  636.       WHILE (a^ [ia] <> '}') DO
  637.             BEGIN
  638.             INC (ia);  IF (ia >= nread) THEN getblock;
  639.             IF (showbrackcom) THEN outp (a^ [ia]);
  640.             END;  (* a^[ia] = '}' *)
  641.       INC (ia);  IF (ia >= nread) THEN getblock;
  642.       GOTO start;
  643.       END;
  644.  
  645.     '(' :   { Do not process the contents of (* ... *) comments }
  646.       BEGIN
  647.       INC (ia);  IF (ia >= nread) THEN getblock;
  648.       IF (a^ [ia] <> '*') THEN
  649.          BEGIN
  650.          outc (ch);
  651.          GOTO start;
  652.          END
  653.       ELSE   (* A comment has begun *)
  654.          BEGIN
  655.          IF (showparencom) THEN
  656.             BEGIN
  657.             outp (ch);  outp (a^ [ia]);
  658.             END;
  659.  
  660.          INC (ia);  IF (ia >= nread) THEN getblock;
  661.          IF (showparencom) THEN outp (a^ [ia]);
  662.  
  663. findasterisk :
  664.          WHILE (a^ [ia] <> '*') DO
  665.                BEGIN
  666.                INC (ia);  IF (ia >= nread) THEN getblock;
  667.                IF (showparencom) THEN outp (a^ [ia]);
  668.                END;  (* a^[ia] = '*' *)
  669.  
  670.          INC (ia);  IF (ia >= nread) THEN getblock;
  671.          IF (showparencom) THEN outp (a^ [ia]);
  672.          
  673.          IF (a^ [ia] <> ')') THEN GOTO findasterisk;
  674.          INC (ia);  IF (ia >= nread) THEN getblock;
  675.          GOTO start;
  676.          END;
  677.       END;
  678.  
  679.     'A'..'Z', 'a'..'z', '_' :
  680.       BEGIN
  681.       ustr := ustr + UPCASE (ch);
  682.       lstr := lstr + ch;
  683.       INC (ia);  IF (ia >= nread) THEN getblock;
  684.       
  685.       ch := a^ [ia];
  686.       WHILE ( (ch >= 'A') AND (ch <= 'Z') ) OR
  687.             ( (ch >= 'a') AND (ch <= 'z') ) OR
  688.             ( (ch >= '0') AND (ch <= '9') ) OR
  689.             (ch = '_') DO   {Sets are too slow}
  690.             BEGIN
  691.             ustr := ustr + UPCASE (ch);
  692.             lstr := lstr + ch;
  693.             INC (ia);  IF (ia >= nread) THEN getblock;
  694.             ch := a^ [ia];
  695.             END;
  696.  
  697.       IF (binsearch (ustr) ) THEN
  698.          outs (ustr)
  699.       ELSE
  700.          IF (lowercase) THEN
  701.             outl (lstr)
  702.          ELSE
  703.             outs (lstr);
  704.  
  705.       lstr := '';  ustr := '';
  706.       GOTO start;
  707.       END;
  708.  
  709.   ELSE
  710.  
  711.       BEGIN
  712.       outc (ch);
  713.       INC (ia);  IF (ia >= nread) THEN getblock;
  714.       GOTO start;
  715.       END;
  716.  
  717.   END;  (* CASE ch *)
  718.  
  719. (*Inline Procedures:
  720.  *  skipquote (a, ia);
  721.  *  skipbrack (a, ia);
  722.  *  skipparens(a, ia);
  723.  *  getident  (a, ia);
  724.  *)
  725. END.
  726.