home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / turbopas / conv_p18.arc / CONV_P18.PAS < prev    next >
Pascal/Delphi Source File  |  1989-11-21  |  31KB  |  822 lines
  1. PROGRAM UpConv;
  2. {$B-}     {shortcut Boolean}
  3. {$D-}     {no debug}
  4. {$L-}     {no local symbols}
  5. {$S-}     {no stack checking}
  6. {$V-}     {no VAR-string checking}
  7.  
  8. Uses Dos,Strings;         {v1.3 for all the wildcard stuff
  9.                            v1.8 STRINGS.TPU for some string stuff}
  10.  
  11. { DEFINE NO_OVERWRITE}   {this enables .FMT file existence checking.
  12.                           I suggest you leave it .. that keeps the
  13.                           system from trying to reformat earlier
  14.                           .FMT files during a wildcard run where the user
  15.                           specified *.* or something equally dumb!
  16.                          }
  17.  
  18. {
  19.  Original based on a bulletin board program by Jeff Firestone
  20.  This version based on a program by Douglas S. Stivison in his book:
  21.      'Turbo Pascal Library' published by Sybex.
  22.  
  23.   One peculiarity about the comment-handling:  Anything within the usual
  24.   '}{' comments is skipped over; anything within the "parenthesis asterisk"
  25.   type comment IS processed!  So .. put real comments within '}{' comments,
  26.   and commented-out code within the '(* *)' type comments.
  27.  
  28.  
  29.  
  30.   v1.8, Toad Hall, 20 Nov 89
  31.     - Adding ability to use user-selected reserved word .DAT data files
  32.       (from the command line).
  33.       Default data file will be CONV_P.DAT.
  34.     - Totally rewrote TOK_STR to handle multiple reserved word text files
  35.       to build a reserved word .DAT file.
  36.       We don't have sorted reserved words any more (but that's ok).
  37.     - Using STRINGS.TPU for some string-related functions.
  38.     - Rebuilt Args into records of strings and filename type
  39.       (to handle cmdline switches, data files, source files).
  40.     - Using newer (slightly tweaked) POSBM2 POS() replacement.
  41.  
  42.   v1.7, Toad Hall, 25 Oct 89
  43.     - Bug in TOK_STR.PAS (missing tokens when a concatenated token
  44.       string reached max length).  Fixed.
  45.     - No changes in UPCONV itself, just in the TOKENS.DAT file
  46.       TOK_STR.EXE produces.  Replace your existing TOKENS.DAT with
  47.       the new one and UPCONV16 will run just fine.
  48.  
  49.   v1.6, Toad Hall, 20 Oct 89
  50.     - Moved the reserved word strings to an external file (UPCONV.DAT),
  51.       created by the TOK_STR utility.
  52.     - Now uses linked lists of string pointers to dynamic reserved
  53.       word strings (rather than the previous "hard-coded" typed constant
  54.       array of reserved word strings).
  55.     - Add a couple more missing reserved words (ParamCnt, ParamStr),
  56.       changed 'Assign' to "ASSIGN".
  57.     - Executable is now smaller, loads faster, runs faster.
  58.  
  59.   v1.5, Toad Hall, 13 Oct 89
  60.     - Adding some missing reserved words (LongInt, Word)
  61.     - Added a modicum of file write error-trapping.
  62.  
  63.   v1.4, Toad Hall, 15 Jun 89
  64.     - Added some missing reserved words (FillChar, FOR, FUNCTION).
  65.     - Adding faster replacement for the POS() function (POSBM).
  66.     - Made Args array dynamic (e.g., via pointers)
  67.     - Buffering string reads, writes via two dynamic buffers to reduce
  68.       disk thrashing, slightly speed up program (maybe 10%).
  69.       (Not doing any memory testing yet, so I hope your system
  70.       has sufficient memory.)
  71.     - Writing a terminating ^Z to our output file
  72.       (just to be neat, keep same file size, etc.).
  73.  
  74.   v1.3, Toad Hall, 14 Apr 89
  75.     - Tweaking for Turbo Pascal v5.0
  76.     - Adding a bunch of TP 4.0 and 5.0 Borland words.
  77.     - Tightening up a little.
  78.     - Added commandline multiple filename/wildcard capability.
  79.     - Added '/L' switch for Pascal (non-Borland) reserved word
  80.       lowercase conversion.
  81.     - Building formatted output string (WorkLine).  Saved only a little
  82.       processing time, but did cut out about 60-70 bytes of code.
  83.                   time        size
  84.       $DEFINE:    1:16.35     12160 bytes
  85.       No DEFINE:  1:15.79     12096 bytes
  86.     - Tried a Move instruction to concatenate strings to WorkLine
  87.       (vs. WorkLine := WorkLine + String); gained no time, only saved
  88.       16 bytes .. not worth the obtuseness.
  89.     - Adding chars to WorkLine the hard way (see code) vs. normal way
  90.       (WorkLine := WorkLine + char)  saved code, time:
  91.                    1:17.34     12208 bytes
  92.  
  93.   v1.2, Toad Hall, 12 Oct 88
  94.     - Bug in Scan_Till procedure.  Fixed.
  95.     - Isn't leaving quoted strings alone.  Fixed.
  96.  
  97.   v1.1 Toad Hall Tweak, Sep 88
  98.     - Added command line filename input.
  99.     - Moved Identifier char set to a global typed constant.
  100.     - Changed simple Reserved Word uppercasing to include Turbo Pascal
  101.       formatted reserved words.
  102.     - Added more reserved words for Turbo Pascal.  (Complete thru v3.0,
  103.       I think .. don't have 4.0, so that should be added.)
  104.     - Command line switch ('-U') to force all reserved words to uppercase
  105.       (e.g., ignore Turbo Pascal format).
  106.     - Considering how to change other text (non-quoted, non-comments)
  107.       to all-upper, all-lower, As-Is, like PFORMAT.PAS does.
  108.     - Still suspect a fancy hash procedure to confirm a RamWord as a
  109.       reserved word would be better than this "if word is in line"
  110.       business.  Later.
  111.  
  112.   v1.0
  113.     - Found in SIMTEL20's PD1:<MSDOS.TURBOPAS>UPCONV.ARC.
  114.       Original author unknown.
  115.  
  116.   David Kirschbaum
  117.   Toad Hall
  118.   kirsch@arsocomvax.socom.mil
  119. }
  120.  
  121.  
  122. CONST
  123.   Default_DataName : STRING[12] = 'CONV_P.DAT';   {default data file v1.8}
  124.  
  125. TYPE
  126.   StrPtr = ^Str_Rec;                   {v1.6}
  127.   Str_Rec = RECORD
  128.               S : STRING;
  129.               next : Pointer;
  130.             END;
  131. VAR
  132.   ReservedWords : StrPtr;               {v1.6 pointer to first dynamic
  133.                                          reserved word string record}
  134.   UCReserved : StrPtr;                  {v1.6 pointer to first dynamic
  135.                                          uppercase reserved word string record}
  136.   curr,curruc : StrPtr;                 {for current normal and uppercased
  137.                                          str recs v1.8}
  138.  
  139.  
  140. CONST
  141.   APOS          = #39;            {This is the ' symbol.}
  142.   OPENCOMMENT   = '{';
  143.   CLOSECOMMENT  = '}';
  144.  
  145.    {Note: These are the only valid characters that can be used in Turbo
  146.     identifiers.}
  147.   Identifier : SET OF CHAR = ['A'..'Z', '0'..'9', '_'];
  148.  
  149. VAR
  150.   charpsn,
  151.   linenum    : Word;
  152.  
  153.   GotData,                    {flag true if we have a /I file on cmdline v1.8}
  154.   Lower,                      {If TRUE, all Pascal reserved words        v1.3
  155.                                lowercased (but not the Borland ones!)}
  156.   AllUpper   : BOOLEAN;       {if TRUE, ALL reserved words uppercased
  157.                                (Borland ones also)}
  158.  
  159.   UcWord,                               {possible keyword, uppercased}
  160.   Padded     : STRING[20];              {UcWord, padded with spaces}
  161.  
  162.   WorkLine,                             {v1.3 Build formatted output line}
  163.   ProgLine   : STRING;                  {v1.3 STRING[128]}
  164.   worklen    : Byte Absolute WorkLine;  {v1.3}
  165.  
  166.   RamWord    : STRING [100];
  167.  
  168.   InFile,
  169.   OutFile : TEXT;
  170.  
  171.  
  172. { Multiple cmdline parm/wildcard stuff }
  173. CONST
  174.   MAXARGS = 10;                         {change as you like}
  175.  
  176. TYPE
  177.   ArgType = (switch,data,source);        {v1.8 types of files}
  178.   ArgRec = RECORD
  179.              Pth : PathStr;             {filename}
  180.              Typ : ArgType;             {whether it's data, source,}
  181.            END;                         { or a -L or -U switch}
  182.  
  183. VAR
  184.   Ok : BOOLEAN;
  185.   argv, argc : Byte;
  186.   Args : ARRAY[1..MAXARGS]              {v1.4 array of cmdline parm ptrs}
  187.            OF ArgRec;                   {v1.8}
  188.  
  189.   Dir : DirStr;                         {STRING[79]}
  190.   Name: NameStr;                        {STRING[8]}
  191.   Ext : ExtStr;                         {STRING[4]}
  192.  
  193.   OutName : PathStr;                    {STRING[79]}
  194.  
  195. {SearchRec is declared in the Dos unit:}
  196. (*
  197.  TYPE SearchRec = RECORD
  198.                     fill : ARRAY[1..21] OF Byte;
  199.                     Attr : Byte;
  200.                     Time : LongInt;
  201.                     size : LongInt;
  202.                     Name : STRING[12];
  203.                   END;
  204. *)
  205.     SrchRec : SearchRec;
  206.  
  207.  
  208. CONST
  209.   MAXBUFFLINES = 256;                   {v1.4 seems a likely number}
  210.  
  211. {v1.4  Our new read/write string buffers}
  212.  
  213. TYPE
  214.   BuffPtr = ^STRING;                     {v1.4}
  215.   Buffer = ARRAY[1..MAXBUFFLINES] OF BuffPtr;
  216.  
  217. VAR
  218.   InBuff,OutBuff   : Buffer;
  219.   inlines,
  220.   currin, currout  : Word;
  221.  
  222.  
  223. PROCEDURE Usage;
  224.   {Give user help, terminate.
  225.    Happens on cmd line of '?', '-?', '/?', '-h', '/h', or empty.
  226.   }
  227.   BEGIN
  228.     WRITELN(
  229. 'CONV_P v1.8 - Convert Pascal reserved words to uppercase,');
  230.     WRITELN(
  231. '       If Turbo Pascal reserved words, convert to Borland style');
  232.     WRITELN(
  233. 'Usage:  UPCONV [[-][/]U][L] [/Idatafile.typ] [/I...] file1[.typ]');
  234.     WRITELN( 'Switches:');
  235.     WRITELN(
  236. ' -u, -U, /u, or /U : uppercase ALL reserved words');
  237.     WRITELN(
  238. '                     (overriding the Borland Style)');
  239.     WRITELN(
  240. ' -l, -L, /l, or /L : lowercase Pascal (non-Borland) reserved words');
  241.     WRITELN(                                                        {v1.8}
  242. ' /I : Use this text file (with YOUR set of reserved words)');
  243.     WRITELN(
  244. '      instead of the default CONV_P.DAT reserved word data file.');
  245.     WRITELN(
  246. 'Source filename file1 will be forced to .PAS if no type is given.');
  247.     WRITELN(
  248. 'Formatted output filename forced to .FMT type.');
  249.     WRITELN('Wildcards may be used for file1.typ');
  250.     HALT;
  251.   END;  {of Usage}
  252.  
  253. {v1.4  Replacement for POS() function
  254.  Dr Dobbs, Jul 89
  255. }
  256. {Link in the POSBM Boyer-Moore function }
  257.  
  258. {$F+}
  259. {$L POSBM2}  {v1.8}
  260.  
  261. FUNCTION posBM(Pat,S : STRING) : Byte; EXTERNAL;
  262. {$F-}
  263.  
  264.  
  265. PROCEDURE Uc_Str(VAR S : STRING);
  266.   {v1.3  Same as STRINGS' Uppercase, but changes the string "in place".}
  267.   BEGIN
  268. InLine(
  269.   $8C/$DB/       {  mov   bx,DS      ;preserve DS}
  270.   $C5/$B6/>S/    {  lds   si,>S[bp]  ;get the VAR addr}
  271.   $31/$C0/       {  xor   ax,ax}
  272.   $8A/$04/       {  mov   al,[si]    ;snarf the length}
  273.   $89/$C1/       {  mov   cx,ax      ;loop counter}
  274.   $E3/$0E/       {  jcxz  Exit       ;zero length, forget it}
  275.                  {;}
  276.   $BA/$61/$20/   {  mov   dx,$2061   ;DL='a',DH=$20}
  277.                  {L1:}
  278.   $46/           {  inc   si         ;next char}
  279.   $8A/$04/       {  mov   al,[si]    ;snarf the char}
  280.   $38/$D0/       {  cmp   al,dl}
  281.   $72/$02/       {  jb    S1         ;already uppercase}
  282.   $28/$34/       {  sub   [si],dh    ;uppercase it}
  283.                  {S1:}
  284.   $E2/$F5/       {  loop  L1}
  285.                  {Exit:}
  286.   $8E/$DB);      {  mov   DS,bx      ;restore DS}
  287.   END;  {of Uc_Str}
  288.  
  289.  
  290. PROCEDURE Lo_Str (VAR S : STRING);
  291.   {v1.3 Lowercase a string}
  292.   BEGIN
  293. InLine(
  294.   $1E/           {  push  DS}
  295.   $C5/$B6/>S/    {  lds   si,>S[bp]}
  296.   $31/$C0/       {  xor   ax,ax}
  297.   $8A/$04/       {  mov   al,[si];snarf the length}
  298.   $09/$C0/       {  or    ax,ax  ;0 length?}
  299.   $74/$16/       {  je    Exit   ;yep, exit}
  300.  
  301.   $89/$C1/       {  mov   cx,ax}
  302.   $BA/$41/$5A/   {  mov   dx,$5A41  ;DL='A',DH='Z'}
  303.   $B4/$20/       {  mov   ah,$20 ;handy constant}
  304.                  {L1:}
  305.   $46/           {  inc   si     ;next char}
  306.   $8A/$04/       {  mov   al,[si];snarf the char}
  307.   $38/$D0/       {  cmp   al,dl  ;<'A'?}
  308.   $72/$06/       {  jb    S1     ;yep}
  309.   $38/$F0/       {  cmp   al,dh  ;>'Z'?}
  310.   $77/$02/       {  ja    S1     ;yep}
  311.   $00/$24/       {  add   [si],ah  ;lowercase}
  312.                  {S1:}
  313.   $E2/$F1/       {  loop  L1}
  314.                  {Exit:}
  315.   $1F);          {  pop   DS    ;restore}
  316.  
  317.   END;  {of Lo_Str}
  318.  
  319.  
  320. FUNCTION ReadLn_B(VAR S : STRING) : BOOLEAN;
  321.   {v1.4 Returns a string from our input buffer.
  322.    If buffer is exhausted, refills from InFile.
  323.    Returns FALSE IF (1) buffer is exhausted, and
  324.                     (2) EOF(InFile)
  325.    Else returns TRUE.
  326.   }
  327.   BEGIN
  328.     ReadLn_B := TRUE;                   {assume success}
  329.     Inc(currin);                        {bump to next line}
  330.     IF currin <= inlines THEN BEGIN     {we still have lines in buffer}
  331.       S := InBuff[currin]^;             {return the string}
  332.       Exit;                             {done}
  333.     END;
  334.  
  335.     {We've hit buffer end .. read in a new buffer full
  336.      (or as much as is available).
  337.     }
  338.     currin := 1;                     {start at InBuff[1]}
  339.     inlines := 0;                    {init input buffer string counter}
  340.     WHILE NOT EOF(InFile)            {stop at EOF}
  341.     AND (inlines < MAXBUFFLINES)     {or when input buffer is full}
  342.     DO BEGIN
  343.       Inc(inlines);                     {bump input buffer string counter}
  344.       READLN(InFile,InBuff[inlines]^);  {Read in a buffer string}
  345.                                        {(Let Turbo handle any errors for now)}
  346.     END;
  347.     IF inlines > 0                     {we did read at least one line}
  348.     THEN S := InBuff[currin]^
  349.     ELSE ReadLn_B := FALSE;            {EOF, no lines read}
  350.   END;  {of ReadLn_B}
  351.  
  352.  
  353. PROCEDURE WriteLn_B(S : STRING);
  354.   {v1.4 Buffered string output.
  355.    Move S to our output buffer OutBuff.
  356.    If OutBuff is full, write it to disk.
  357.   }
  358.   VAR  err : INTEGER;  {v1.5}
  359.   BEGIN
  360.     Inc(currout);                      {bump output line counter}
  361.     IF currout > MAXBUFFLINES          {output buffer's full}
  362.     THEN BEGIN
  363.       FOR currout := 1 TO MAXBUFFLINES DO BEGIN
  364. {$I-}
  365.         WRITELN(OutFile,OutBuff[currout]^);  {write to file}
  366.                                        {(Let Turbo handle any errors for now)}
  367.         err := IOResult;               {v1.5}
  368. {$I+}
  369.         IF err <> 0 THEN BEGIN
  370.           WRITELN('File Write Error');
  371.           HALT(err);
  372.         END;
  373.       END;
  374.  
  375.       currout := 1;                    {back to output buffer start}
  376.     END;
  377.     OutBuff[currout]^ := S;            {move string into output buffer}
  378.   END;  {of Writeln_B}
  379.  
  380.  
  381. PROCEDURE Flush_OutBuff;
  382.   {v1.4  If any output strings are left in our output buffer,
  383.    write them to disk.
  384.    (We really should test to see if we've written ANYTHING
  385.    to our output file, and delete it if it's empty (or something).
  386.    Not messing with that for now (since you can't do a FileSize
  387.    on text files, and we'd have to reopen as some other type, etc.).
  388.   }
  389.   VAR
  390.     i : Word;
  391.     err : INTEGER;
  392.   BEGIN
  393.     IF currout > 0                      {if there are any buffer lines}
  394.     THEN FOR i := 1 TO currout DO BEGIN {write them all out}
  395. {$I-}
  396.       WRITELN(OutFile,OutBuff[i]^);
  397.       err := IOResult;               {v1.5}
  398. {$I+}
  399.       IF err <> 0 THEN BEGIN
  400.         WRITELN('File Write Error');
  401.         HALT(err);
  402.       END;
  403.  
  404.     END;
  405.     WRITE(OutFile,^Z);                  {v1.4 terminating ^Z}
  406.  
  407. {$I-}
  408.     CLOSE(InFile);
  409.     CLOSE(OutFile);                     {close up}
  410. {$I+}
  411.     IF IOResult <> 0 THEN ;             {we don't care}
  412.  
  413.   END;  {of Flush_OutBuff}
  414.  
  415.  
  416. PROCEDURE Get_Args;
  417.   {v1.4 Process command line for all target filenames.
  418.         Move them into an array of Args records.
  419.    v1.8 We may have "/IDATAFILE.DAT" data files on the cmdline.
  420.         Move them (if any) into that same Args record array,
  421.         but flag the file type as "data" rather than "source".
  422.   }
  423.   CONST
  424.     HelpArgs   : STRING[13] = ' -? /? -H /H ';  {v1.8}
  425.     SwitchArgs : STRING[13] = ' -U /U -L /L ';  {v1.8}
  426.   VAR
  427.     Ch : CHAR;
  428.     TStr : STRING;
  429.     p : Byte;
  430.  
  431.   BEGIN
  432.     argc := ParamCount;
  433.     IF (argc = 0)                       {no parms at all}
  434.     OR (argc > MAXARGS)                 {or more than we can handle}
  435.     THEN Usage;                         {display help, die}
  436.  
  437.  
  438.     Lower    := FALSE;                  {assume no switches}
  439.     AllUpper := FALSE;
  440.     GotData  := FALSE;                  {and no /I data file}
  441.  
  442.     FOR argv := 1 TO argc DO BEGIN      {process args}
  443.  
  444.       Args[argv].Pth := Uppercase(ParamStr(argv)); {snarf parm, uppercased}
  445.       Args[argv].Typ := source;           {assume source file v1.8}
  446.  
  447. { The first arg could've been a '-U' or '/U', or a '-L' or '/L'.
  448.   Check that out now.  If so, we set the arg type to switch
  449.   so we can skip that arg when it comes time to open files.
  450. }
  451.  
  452.       IF Args[argv].Pth[1] IN ['-','/']  {may be a switch}
  453.       THEN BEGIN                          {so let's see what kind}
  454.         TStr := ' ' + Args[argv].Pth + ' ';   {pad with spaces}
  455.  
  456.         IF posBM(TStr, HelpArgs) <> 0       {help arg? v1.8}
  457.         THEN Usage;                         {help, die}
  458.  
  459.         p := posBM(TStr,SwitchArgs);        {see if any switches}
  460.         IF p <> 0 THEN BEGIN                {we have a /U or /L switch}
  461.           Args[argv].Typ := switch;        {flag as a switch}
  462.           IF p < 7 THEN AllUpper := TRUE    {-U or /U}
  463.           ELSE Lower := TRUE;               {-L or /L}
  464.         END
  465.         {Not a lower/upper switch, might be a '/I' switch}
  466.         ELSE IF Args[argv].Pth[2] = 'I'    {'/I switch}
  467.         THEN BEGIN                          {it's an input data file}
  468.           DELETE(Args[argv].Pth,1,2);      {delete the '/I' chars}
  469.           Args[argv].Typ := data;          {flag as data file}
  470.           GotData := TRUE;                  {flag we got one}
  471.         END;
  472.       END;  {if first char is '-/'
  473.       {Else this Arg is flagged as a source file}
  474.     END;  {argc loop}
  475.  
  476.   END;  {of Get_Args}
  477.  
  478.  
  479. {$IFDEF NO_OVERWRITE}      {v1.3 only if we want no overwriting}
  480.  
  481. FUNCTION Exists(Name : PathStr) : BOOLEAN;
  482.   {Returns TRUE if Name exists on current drive:\dir}
  483.   VAR  F : TEXT;
  484.   BEGIN
  485.     ASSIGN(F, Name);
  486.     {$I-}  RESET (F);  {$I+}
  487.     IF IOResult = 0 THEN BEGIN
  488.       Exists := TRUE;
  489.       CLOSE(F);
  490.     END
  491.     ELSE Exists := FALSE;
  492.   END;  {of Exists}
  493.  
  494. {$ENDIF}
  495.  
  496.  
  497. FUNCTION Open_Files : BOOLEAN;
  498.   {Works FindNext if appropriate, else uses a new Arg string.
  499.    v1.4 Returns TRUE or FALSE  per success/failure.
  500.   }
  501.   VAR  FName : PathStr;
  502.   BEGIN
  503.     Open_Files := FALSE;                {v1.4 assume failure}
  504.  
  505.     IF SrchRec.Name = '' THEN BEGIN     {time for a new name}
  506.  
  507.       REPEAT
  508.         Inc(argv);                        {bump for first/next name}
  509.         IF argv > argc THEN Exit;         {all done, return FALSE  v1.8}
  510.       UNTIL Args[argv].Typ = source;  {until we get a new source file v1.8}
  511.  
  512.       FSplit(Args[argv].Pth, Dir, Name, Ext);  {split up the new name v1.4}
  513.       IF Ext = '' THEN Ext := '.PAS';       {force to .PAS type}
  514.       FName := Dir + Name + Ext;            {build new name}
  515.       FindFirst(FName,ReadOnly OR Archive,SrchRec)  {first time thru}
  516.     END
  517.     ELSE FindNext(SrchRec);             {working a wildcard}
  518.  
  519.     Ok := (DosError = 0);               {from FindFirst or FindNext}
  520.     IF NOT Ok THEN BEGIN                {not found}
  521.       SrchRec.Name := '';               {Flag we need a new arg
  522.                                          and FindFirst}
  523.       Exit;                             {v1.4 return FALSE}
  524.     END;
  525.  
  526.     FName := Dir + SrchRec.Name;        {new name from FindFirst/FindNext}
  527.     Args[argv].Pth := FName;           {Update Args for outside display v1.8}
  528.  
  529. {v1.3 We'll always force the '.FMT' file type for output.}
  530.  
  531.     FSplit(FName, Dir, Name, Ext);
  532.  
  533.     OutName := Name + '.FMT';           {build a new output path
  534.                                          (current drive:\directory) }
  535.  
  536. {$IFDEF NO_OVERWRITE}
  537.  
  538.     IF Exists(OutName) THEN BEGIN       {If .FMT file already exists...}
  539.       WRITELN(Outname + ' already exists .. skipping!');
  540.       Exit;                             {v1.4 return FALSE}
  541.     END;
  542. {$ENDIF}
  543.  
  544.     ASSIGN(InFile, FName);
  545.     RESET(InFile);                      {open input file}
  546.  
  547.     ASSIGN(OutFile, OutName);
  548.     {$I-}  REWRITE (OutFile);  {$I+}
  549.     Ok := (IOResult = 0);
  550.     IF NOT Ok THEN BEGIN
  551.       CLOSE(InFile);                    {be neat}
  552.       WRITELN('Unable to open file [' + OutName + ']');
  553.     END                                 {v1.4 return FALSE}
  554.     ELSE BEGIN
  555.       currin := 0;                      {init input string buffer ptr}
  556.       currout := 0;                     {init output string buffer ptr}
  557.       inlines := 0;                     {insure initial input buffer fill}
  558.  
  559.       Open_Files := TRUE;               {v1.4 return TRUE}
  560.     END;
  561.   END;  {of Open_Files}
  562.  
  563.  
  564. PROCEDURE Build_Reserved_Arrays;
  565.   {v1.6  Read in our file of reserved word strings.
  566.    Create two linked lists of string records:
  567.    one normal (Borland and Pascal reserved words with mixed case),
  568.    one all uppercased).
  569.    We just do this once.
  570.   }
  571.  
  572.   PROCEDURE Read_DataFile(DataName : PathStr);
  573.     VAR
  574.       p : StrPtr;            {working string record pointer}
  575.       TokenFile : TEXT;      {file of reserved word strings}
  576.     BEGIN
  577.       ASSIGN(TokenFile,DataName);        {file of reserved word strings v1.8}
  578.       {$I-}  RESET(TokenFile);  {$I+}    {open it}
  579.       IF IOResult <> 0 THEN BEGIN        {not found .. die}
  580.         WRITELN(DataName + ' file not found.  Aborting!');  {v1.8}
  581.         HALT(1);                         {die}
  582.       END;
  583.  
  584.       WHILE NOT EOF(TokenFile) DO BEGIN {read in all the strings}
  585.         READLN(TokenFile,curr^.S);      {read in string}
  586.         NEW(p);                         {allocate new normal record}
  587.         curr^.next := p;                {point THIS record to next one}
  588.         curruc^.S := Uppercase(curr^.S);       {create uppercased reserve word}
  589.         curr := p;                      {bump to next normal record}
  590.  
  591.         NEW(p);                         {allocate new uppercased record}
  592.         curruc^.next := p;              {assume no next uppercase rec}
  593.         curruc := p;                    {bump to next uppercase rec}
  594.       END;
  595.       curr^.S := '';                    {last string is empty}
  596.       curr^.next := NIL;                {..and points nowhere}
  597.       curruc^ := curr^;                 {also empty}
  598.  
  599.       {$I-} CLOSE(TokenFile);  {$I+}    {close up}
  600.       IF IOResult <> 0 THEN ;           {we don't care}
  601.     END;  {of Read_DataFile}
  602.  
  603.   BEGIN  {Build_Reserved_Arrays}
  604.  
  605.     NEW(ReservedWords);               {allocate first reserved string
  606.                                        record}
  607.     ReservedWords^.S := '';           {build first string ptr}
  608.     ReservedWords^.next := NIL;       {no next}
  609.  
  610.     NEW(UcReserved);                  {create first dynamic uppercased
  611.                                        string ptr}
  612.     UcReserved^ := ReservedWords^;    {initialize it also}
  613.  
  614.     curr := ReservedWords;            {point to first string ptr}
  615.     curruc := UcReserved;             {and first uppercased str ptr}
  616.  
  617.     IF NOT GotData                    {no arg was a data filename  v1.8}
  618.     THEN Read_DataFile(Default_DataName)  {so use default  v1.8}
  619.     ELSE BEGIN
  620.       FOR argv := 1 TO argc DO     {check all the arg filenames v1.8}
  621.       IF Args[argv].Typ = data    {ok, it's a data type v1.8}
  622.       THEN Read_DataFile(Args[argv].Pth);  {so read THAT data file in v1.8}
  623.     END;  {using arg datafile name}
  624.   END;  {of Build_Reserved_Arrays}
  625.  
  626.  
  627. PROCEDURE Test_For_Reserved_Words;
  628.   {Test if the current word (RamWord) is a reserved word.
  629.    If so, write its equivalent (uppercased or Turbo Pascal format)
  630.    out to our output file.
  631.    Else just write it as it is.
  632.   }
  633.   VAR
  634.     p,len : Word;
  635.   BEGIN
  636.     Padded := ' ' + Uppercase(RamWord) + ' ';  {Uppercase, bracket with spaces}
  637.     len := LENGTH(RamWord);             {v1.3}
  638.  
  639.     curruc := UcReserved;               {ptr to first dynamic uppercased
  640.                                          reserved word string record}
  641.     IF NOT AllUpper                     {not just uppercase}
  642.     THEN curr := ReservedWords          {use Borland/normal case array also}
  643.     ELSE curr := UcReserved;
  644.  
  645.     WHILE curruc^.next <> NIL DO BEGIN  {check all the reserved words}
  646.       p := posBM(Padded, curruc^.S);    {v1.6 is this uppercased, padded
  647.                                          word in the reserved word line?}
  648.       IF p > 0 THEN BEGIN               {yep}
  649.         Inc(p);                         {bump past the space}
  650.         IF AllUpper                     {converting to uppercase..}
  651.         THEN Padded := COPY(curruc^.S,  {..so move in the uppercased word}
  652.                             p, len)
  653.         ELSE BEGIN                      {more processing}
  654.           Padded := COPY(curr^.S,       {word per our Reserved table}
  655.                          p, len);       {uppercase or Borlandized}
  656.           IF Lower
  657.           THEN IF Padded = Uppercase(Padded)   {If the mixed-case Table word
  658.                                          matches the uppercased word..
  659.                                          it's non-Borland...}
  660.             THEN Lo_Str(Padded);        {..so lowercase it}
  661.         END;
  662.         WorkLine := WorkLine + Padded;  {v1.3 build in WorkLine}
  663.         Exit;                           {don't look at any more lines}
  664.       END;  {if Padded in line}
  665.       curruc := curruc^.next;           {point to next uppercased reserved
  666.                                          word string record}
  667.       curr := curr^.next;                {point to next normal string}
  668.     END;    {line-checking loop}
  669.  
  670. {We checked all the lines, didn't find our RamWord as a Reserved word}
  671.  
  672.     WorkLine := WorkLine + RamWord;     {v1.3 build WorkLine with orig word}
  673.  
  674.   END;  {of Test_For_Reserved_Words}
  675.  
  676.  
  677. PROCEDURE Process_A_Word;
  678.   VAR
  679.     len : Byte;   {v1.3}
  680.     strt : Word;  {v1.3}
  681.   BEGIN
  682.     strt := charpsn;                    {v1.3 remember where we started}
  683.     WHILE (UpCase (ProgLine [charpsn]) IN Identifier)  {it's a legal char}
  684.     AND (charpsn <= LENGTH (ProgLine) )                {and line isn't done}
  685.     DO  Inc(charpsn);                   {v1.3 bump ProgLine ptr}
  686.  
  687.     len := (charpsn - strt);            {v1.3 nr chars in word}
  688.     RamWord[0] := CHAR(len);            {v1.3 force string length}
  689.     Move(ProgLine[strt], RamWord[1], len);  {v1.3 copy portion of ProgLine}
  690.  
  691.     Test_For_Reserved_Words;            {check RamWord for reserved
  692.                                          words, write out}
  693.   END;  {of Process_A_Word}
  694.  
  695.  
  696. PROCEDURE Scan_Till (SearchChar: CHAR);
  697.   VAR
  698.     Ch : CHAR;  {v1.2}
  699.   BEGIN
  700.     REPEAT
  701.       IF charpsn > LENGTH (ProgLine) THEN BEGIN
  702.  
  703.         WriteLn_B(WorkLIne);            {v1.4 Write the Workline we have
  704.                                          (Buffered string output)
  705.                                          (Ok if it's empty) }
  706.  
  707.         IF NOT ReadLn_B(ProgLine)       {v1.4 If we have another input line
  708.                                          (buffered string input) }
  709.         THEN Exit;                      {FALSE means EOF}
  710.  
  711.         charpsn := 1;
  712.         WorkLine := '';                 {v1.3 Reinit WorkLine}
  713.       END;
  714.  
  715.       IF ProgLine <> '' THEN BEGIN      {do non-blank lines}
  716.         Ch := ProgLine[charpsn];        {v1.2 remember what this char was}
  717.  
  718.         Inc(worklen);                   {v1.3 bump workline length}
  719.         WorkLine[worklen] := Ch;        {v1.3 stuff char in line}
  720. (* same as
  721.         WorkLine := WorkLine + Ch;
  722.    but faster, tighter
  723. *)
  724.         Inc(charpsn);                   {v1.3 bump char ptr}
  725.       END
  726.       ELSE Ch := #0;                    {v1.2 blank line, clear Ch}
  727.     UNTIL (Ch = SearchChar);            {v1.2 the LAST char was end of
  728.                                          quoted string or comment}
  729. {v1.4 If we hit EOF, we exit above}
  730.   END;  {of Scan_Till}
  731.  
  732.  
  733. PROCEDURE Convert;
  734.   VAR Ch : CHAR;
  735.   BEGIN
  736.     WRITE('Converting ', Args[argv].Pth, ' => ', OutName,   {v1.4}
  737.           ', Processing line: ');
  738.  
  739.     linenum := 0;
  740.  
  741.     WHILE ReadLn_B(ProgLine) DO BEGIN   {v1.4 buffered string input
  742.                                          FALSE means EOF}
  743.       charpsn := 1;
  744.       WorkLine := '';                   {v1.3 clear WorkLine string}
  745.  
  746.       IF LENGTH(ProgLine) <> 0 THEN BEGIN     {v1.3 nonblank line}
  747.         REPEAT
  748.           Ch := UpCase(ProgLine[charpsn]);
  749.           IF Ch IN Identifier           {could be a reserved word}
  750.           THEN Process_A_Word           {so process it}
  751.           ELSE BEGIN
  752.  
  753.             Inc(worklen);               {v1.3 bump WorkLine length}
  754.             WorkLine[worklen] := Ch;    {v1.3 stuff char in WorkLine}
  755. (* Same as
  756.             WorkLine := WorkLine + Ch;
  757.    but tighter, faster
  758. *)
  759.             Inc(charpsn);               {v1.3 bump ptr}
  760.             IF Ch = OPENCOMMENT
  761.             THEN Scan_Till(CLOSECOMMENT)  {v1.2 write until
  762.                                            closing comment}
  763.             ELSE IF Ch = APOS
  764.             THEN Scan_Till(APOS);       {v1.2 write until 2d '}
  765.           END;
  766.         UNTIL (charpsn > LENGTH (ProgLine));
  767.       END; {If nonblank}
  768.  
  769.       Writeln_B(WorkLine);              {v1.4 Output Workline
  770.                                          (buffered string output)
  771.                                          (Ok if blank) }
  772.  
  773.       WRITE(linenum:6,^H^H^H^H^H^H);    {display, back up}
  774.  
  775.       Inc(linenum);                     {v1.3 bump linenr}
  776.     END;  {While}
  777.  
  778.     WRITELN;                            {v1.3 clean up screen}
  779.  
  780.     Flush_OutBuff;                      {v1.4 flush output buffer,
  781.                                          close up everything}
  782.   END;  {of Convert}
  783.  
  784.  
  785. BEGIN  {main}
  786.  
  787.   Get_Args;                             {process cmdline args
  788.                                          (may die)}
  789.  
  790.   Build_Reserved_Arrays;                {v1.6 build two linked lists
  791.                                          of reserved word records
  792.                                          (one normal, one uppercased) }
  793.  
  794.   {v1.4 So far, so good.  Initialize our dynamic input and output
  795.    buffer array pointers.
  796.    Later, check for avail memory, constrain buffers, etc.
  797.   }
  798.  
  799.   FOR currin := 1 TO MAXBUFFLINES DO
  800.     NEW(InBuff[currin]);
  801.   FOR currout := 1 TO MAXBUFFLINES DO
  802.     NEW(OutBuff[currout]);
  803.  
  804. {Now we go into our file loop.
  805.  We continue until FindNext returns no more files.
  806.  Get_Args set argv appropriately.
  807. }
  808.  
  809.   SrchRec.Name := '';                   {clear for first file}
  810.   argv := 0;                            {start with first arg}
  811.  
  812.   WHILE (SrchRec.Name <> '')            {we're working a wildcard}
  813.   OR (argv < argc)                      {no wildcard, but still got args}
  814.   DO BEGIN
  815.  
  816.     IF Open_Files                       {v1.4 open InFile,OutFile}
  817.     THEN Convert;                       {v1.4 files open, do the conversion}
  818.  
  819.   END;  {until all done}
  820.  
  821. END.
  822.