ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/ASSEMBLY/CONV_A11.ZIP/CONV_A1.PAS

Pascal/Delphi Source File | 1989-11-06 | 28.6 KB | 815 lines

PROGRAM Conv_A;
{$B-}     {shortcut Boolean}
{$D-}     {no debug}
{$L-}     {no local symbols}
{$S-}     {no stack checking}
{$V-}     {no VAR-string checking}

Uses Dos,Crt;                {for all the wildcard stuff,
                              and some GotoXY calls}

{ DEFINE NO_OVERWRITE}   {this enables .FMT file existence checking.
                          I suggest you define it .. that keeps the
                          system from trying to reformat earlier
                          .FMT files during a wildcard run where the user
                          specified *.* or something equally dumb!
                         }

{
 Original based on a bulletin board program by Jeff Firestone
 This version based on a program by Douglas S. Stivison in his book:
     'Turbo Pascal Library' published by Sybex.

  v1.1, Toad Hall, 5 Nov 89
   - Tightened up POSBM a little (now POSBM2).
   - Moved Uc string uppercase function to EXTERNAL function
     (UC.ASM, UC.OBJ).
   - Fixed bug in TOKSTR_A.PAS (wasn't correctly padding reserved words
     in token strings with spaces).

  v1.0, Toad Hall, 13 Oct 89
    - Rewriting UPCONV15.PAS to handle assembly language reserved
      words (operators, instructions, etc.)

  David Kirschbaum
  Toad Hall
  [e-mail]
}


CONST
  TokFilename : STRING[10] = 'CONV_A.DAT';  {file of reserved word strings}

TYPE
  StrPtr = ^Str_Rec;
  Str_Rec = RECORD
              S : STRING;
              next : Pointer;
            END;

VAR
  ReservedWords : StrPtr;               {pointer to first dynamic
                                         reserved word string record}
  UCReserved : StrPtr;                  {pointer to first dynamic uppercase
                                         reserved word string record}

CONST
  APOS          = #39;            {This is the ' symbol.}
  QUOTE         = '"';            {This is the " symbol.}
  COMMENT       = ';';            {Assembly language uses semicolon}

   {Note: These are the only valid characters that are used in assembly
    language and MASM identifiers, etc.}
  Identifier : SET OF CHAR = ['A'..'Z', '0'..'9', '%','.','?'];

VAR
  charP,                   {character pointer}
  linenum,                 {line counter}
  ourX,                    {col coordinate for line counter display}
  quote1P,                 {quote char pointers}
  quote2P    : Word;

  Lower,                      {If TRUE, all assembly language instructions
                               lowercased (but not the MASM ones!)}
  AllUpper   : BOOLEAN;       {if TRUE, ALL reserved words uppercased}

  UcWord,                               {possible keyword, uppercased}
  Padded     : STRING[20];              {UcWord, padded with spaces}

  UProgLine,                            {Uppercased line of source txt}
  CommentLine,                          {Hold comments, quoted text}
  WorkLine,                             {Build formatted output line}
  ProgLine   : STRING;                  {Original line of source txt}
  worklen    : Byte Absolute WorkLine;

  RamWord    : STRING [100];

  InFile,
  OutFile : TEXT;

  CommentCh : CHAR;                     {holds MASM COMMENT char or #0}

{ Multiple cmdline parm/wildcard stuff }
CONST
  MAXARGS = 10;                         {change as you like}

TYPE
  PathStrPtr = ^PathStr;

VAR
  Ok : BOOLEAN;
  argv, argc : Byte;
  Args : ARRAY[1..MAXARGS]              {array of cmdline parm ptrs}
           OF PathStrPtr;               {STRING[79]}

  Dir : DirStr;                         {STRING[79]}
  Name: NameStr;                        {STRING[8]}
  Ext : ExtStr;                         {STRING[4]}

  OutName : PathStr;                    {STRING[79]}

{SearchRec is declared in the Dos unit:}
(*
 TYPE SearchRec = RECORD
                    fill : ARRAY[1..21] OF Byte;
                    attr : Byte;
                    time : LongInt;
                    size : LongInt;
                    Name : STRING[12];
                  END;
*)
    SrchRec : SearchRec;


CONST
  MAXBUFFLINES = 256;                   {seems a likely number}

{Our new read/write string buffers}

TYPE
  BuffPtr = ^STRING;
  Buffer = ARRAY[1..MAXBUFFLINES] OF BuffPtr;

VAR
  InBuff,OutBuff   : Buffer;
  inlines,
  currin, currout  : Word;


PROCEDURE Usage;
  {Give user help, terminate.
   Happens on cmd line of '?', '-?', '/?', '-h', '/h', or empty.
  }
  BEGIN
    WRITELN(
'CONV_A v1.1 - Convert assembly language instructions to lower case,');
    WRITELN(
'       If MASM-peculiar reserved words, convert to upper case');
    WRITELN(
'Usage:  CONV_A [[-][/]U][L] file1[.typ]');
    WRITELN( 'Switches:');
    WRITELN(
' -u, -U, /u, or /U : uppercase ALL reserved words');
    WRITELN(
' -l, -L, /l, or /L : lowercase MASM reserved words and ASM instructions');
    WRITELN(
'Source filename file1 will be forced to .ASM if no type is given.');
    WRITELN(
'Formatted output filename forced to FILE1.FMT');
    WRITELN('Wildcards may be used for file1.typ');
    HALT;
  END;  {of Usage}

{Replacement for POS() function
 Dr Dobbs, Jul 89
}
{Link in the POSBM Boyer-Moore function }

{$F+}

{$L POSBM2}  {v1.1}

FUNCTION posBM(Pat,S : STRING) : Byte; EXTERNAL;


{Link in the Toad Hall posCh function}
{$L POSCH}

FUNCTION posCh(Ch : CHAR; S : STRING) : Byte; EXTERNAL;

{v1.1 And the Uc string uppercase function}
{$L UC}

FUNCTION Uc(S : STRING) : STRING; EXTERNAL;

{$F-}


PROCEDURE Uc_Str(VAR S : STRING);
  {Same as Uc, but changes the string "in place".}
  BEGIN
InLine(
  $8C/$DB/       {  mov   bx,DS      ;preserve DS}
  $C5/$B6/>S/    {  lds   si,>S[bp]  ;get the VAR addr}
  $31/$C0/       {  xor   ax,ax}
  $8A/$04/       {  mov   al,[si]    ;snarf the length}
  $89/$C1/       {  mov   cx,ax      ;loop counter}
  $E3/$0E/       {  jcxz  Exit       ;zero length, forget it}
                 {;}
  $BA/$61/$20/   {  mov   dx,$2061   ;DL='a',DH=$20}
                 {L1:}
  $46/           {  inc   si         ;next char}
  $8A/$04/       {  mov   al,[si]    ;snarf the char}
  $38/$D0/       {  cmp   al,dl}
  $72/$02/       {  jb    S1         ;already uppercase}
  $28/$34/       {  sub   [si],dh    ;uppercase it}
                 {S1:}
  $E2/$F5/       {  loop  L1}
                 {Exit:}
  $8E/$DB);      {  mov   DS,bx      ;restore DS}
  END;  {of Uc_Str}


PROCEDURE Lo_Str (VAR S : STRING);
  {Lowercase a string}
  BEGIN
InLine(
  $1E/           {  push  DS}
  $C5/$B6/>S/    {  lds   si,>S[bp]}
  $31/$C0/       {  xor   ax,ax}
  $8A/$04/       {  mov   al,[si];snarf the length}
  $09/$C0/       {  or    ax,ax  ;0 length?}
  $74/$16/       {  je    Exit   ;yep, exit}

  $89/$C1/       {  mov   cx,ax}
  $BA/$41/$5A/   {  mov   dx,$5A41  ;DL='A',DH='Z'}
  $B4/$20/       {  mov   ah,$20 ;handy constant}
                 {L1:}
  $46/           {  inc   si     ;next char}
  $8A/$04/       {  mov   al,[si];snarf the char}
  $38/$D0/       {  cmp   al,dl  ;<'A'?}
  $72/$06/       {  jb    S1     ;yep}
  $38/$F0/       {  cmp   al,dh  ;>'Z'?}
  $77/$02/       {  ja    S1     ;yep}
  $00/$24/       {  add   [si],ah  ;lowercase}
                 {S1:}
  $E2/$F1/       {  loop  L1}
                 {Exit:}
  $1F);          {  pop   DS    ;restore}

  END;  {of Lo_Str}


FUNCTION ReadLn_B(VAR S : STRING) : BOOLEAN;
  {Returns a string from our input buffer.
   If buffer is exhausted, refills from InFile.
   Returns FALSE IF (1) buffer is exhausted, and
                    (2) EOF(InFile)
   Else returns TRUE.
  }
  BEGIN
    ReadLn_B := TRUE;                   {assume success}
    Inc(currin);                        {bump to next line}
    IF currin <= inlines THEN BEGIN     {we still have lines in buffer}
      S := InBuff[currin]^;             {return the string}
      Exit;                             {done}
    END;

    {We've hit buffer end .. read in a new buffer full
     (or as much as is available).
    }
    currin := 1;                        {start at InBuff[1]}
    inlines := 0;                       {init input buffer string counter}
    WHILE NOT EOF(InFile)               {stop at EOF}
    AND (inlines < MAXBUFFLINES)        {or when input buffer is full}
    DO BEGIN
      Inc(inlines);                     {bump input buffer string counter}
      READLN(InFile,InBuff[inlines]^);  {Read in a buffer string}
                                       {(Let Turbo handle any errors for now)}
    END;
    IF inlines > 0                     {we did read at least one line}
    THEN S := InBuff[currin]^
    ELSE ReadLn_B := FALSE;            {EOF, no lines read}
  END;  {of ReadLn_B}


PROCEDURE WriteLn_B(S : STRING);
  {Buffered string output.
   Move S to our output buffer OutBuff.
   If OutBuff is full, write it to disk.
  }
  VAR  err : INTEGER;
  BEGIN
    Inc(currout);                       {bump output line counter}
    IF currout > MAXBUFFLINES           {output buffer's full}
    THEN BEGIN
      FOR currout := 1 TO MAXBUFFLINES DO BEGIN
{$I-}
        WRITELN(OutFile,OutBuff[currout]^);  {write to file}
        err := IOResult;
{$I+}
        IF err <> 0 THEN BEGIN
          WRITELN('File Write Error');
          HALT(err);
        END;
      END;

      currout := 1;                     {back to output buffer start}
    END;
    OutBuff[currout]^ := S;             {move string into output buffer}
  END;  {of Writeln_B}


PROCEDURE Flush_OutBuff;
  {If any output strings are left in our output buffer,
   write them to disk.
   (We really should test to see if we've written ANYTHING
   to our output file, and delete it if it's empty (or something).
   Not messing with that for now (since you can't do a FileSize
   on text files, and we'd have to reopen as some other type, etc.).
  }
  VAR
    i : Word;
    err : INTEGER;
  BEGIN
    IF currout > 0                      {if there are any buffer lines}
    THEN FOR i := 1 TO currout DO BEGIN {write them all out}
{$I-}
      WRITELN(OutFile,OutBuff[i]^);
      err := IOResult;
{$I+}
      IF err <> 0 THEN BEGIN
        WRITELN('File Write Error');
        HALT(err);
      END;

    END;
    WRITE(OutFile,^Z);                  {terminating ^Z}

{$I-}
    CLOSE(InFile);
    CLOSE(OutFile);                     {close up}
{$I+}
    IF IOResult <> 0 THEN ;             {we don't care}

  END;  {of Flush_OutBuff}


PROCEDURE Get_Args;
  {Process command line for all target filenames.
   Move them into a dynamic array of PathStrs.
  }
  VAR Ch : CHAR;
  BEGIN
    argc := ParamCount;
    IF (argc = 0)                       {no parms at all}
    OR (argc > MAXARGS)                 {or more than we can handle}
    THEN Usage;                         {display help, die}

    FOR argv := 1 TO argc DO BEGIN
      NEW(Args[argv]);
      Args[argv]^ := Uc(ParamStr(argv)); {snarf parm, (uppercased)}
    END;

{ The first arg could've been a '-u' or '/u',
  or a '-l' or '/l'.
  Check that out now.  If so, we set a global and skip that arg
  when it comes time to open files.
}
    argv := 0;                          {assume we start at 1}
    Lower := FALSE;
    AllUpper := FALSE;                  {assume no switches}

    IF (LENGTH(Args[1]^) = 2)           {2 chars to a switch}
    AND (Args[1]^[1] IN ['-','/'])      {first is a switch char}
    THEN BEGIN                          {we got a switch}
      Ch := Args[1]^[2];                {grab 2d char}
      IF Ch IN ['?','H'] THEN Usage;    {help, die}

      IF Ch = 'U' THEN AllUpper := TRUE     {maybe upper switch}
      ELSE IF Ch = 'L' THEN Lower := TRUE;  {or maybe lower}
      IF NOT (AllUpper OR Lower)            {bogus switch}
      THEN WRITELN('Unknown switch: [', Args[1]^, '], ignored!');

      Inc(argv);                        {skip 1st arg in any case}
    END;  {if Arg(1) was a switch}

  END;  {of Get_Args}


{$IFDEF NO_OVERWRITE}      {only if we want no overwriting}

FUNCTION Exists(Name : PathStr) : BOOLEAN;
  {Returns TRUE if Name exists on current drive:\dir}
  VAR  F : TEXT;
  BEGIN
    Assign(F, Name);
    {$I-}  RESET (F);  {$I+}
    IF IOResult = 0 THEN BEGIN
      Exists := TRUE;
      CLOSE(F);
    END
    ELSE Exists := FALSE;
  END;  {of Exists}

{$ENDIF}


FUNCTION Open_Files : BOOLEAN;
  {Works FindNext if appropriate, else uses a new Arg string.
   Returns TRUE or FALSE  per success/failure.
  }
  VAR  FName : PathStr;
  BEGIN
    Open_Files := FALSE;                {assume failure}

    IF SrchRec.Name = '' THEN BEGIN     {time for a new name}

      Inc(argv);                        {bump for first/next name}
      IF Args[argv] = NIL THEN Exit;    {all done, return FALSE}

      FSplit(Args[argv]^, Dir, Name, Ext);  {split up the new name}
      IF Ext = '' THEN Ext := '.ASM';       {force to .ASM type}
      FName := Dir + Name + Ext;            {build new name}
      FindFirst(FName,ReadOnly OR Archive,SrchRec)  {first time thru}
    END
    ELSE FindNext(SrchRec);             {working a wildcard}

    Ok := (DosError = 0);               {from FindFirst or FindNext}
    IF NOT Ok THEN BEGIN                {not found}
      SrchRec.Name := '';               {Flag we need a new arg
                                         and FindFirst}
      Exit;                             {return FALSE}
    END;

    FName := Dir + SrchRec.Name;        {new name from FindFirst/FindNext}
    Args[argv]^ := FName;               {Update Args for outside display}

{We'll always force the '.FMT' file type for output.}

    FSplit(FName, Dir, Name, Ext);

    OutName := Name + '.FMT';           {build a new output path
                                         (current drive:\directory) }

{$IFDEF NO_OVERWRITE}

    IF Exists(OutName) THEN BEGIN       {If .FMT file already exists...}
      WRITELN(Outname + ' already exists .. skipping!');
      Exit;                             {return FALSE}
    END;
{$ENDIF}

    Assign(InFile, FName);
    RESET(InFile);                      {open input file}

    Assign(OutFile, OutName);
    {$I-}  REWRITE (OutFile);  {$I+}
    Ok := (IOResult = 0);
    IF NOT Ok THEN BEGIN
      CLOSE(InFile);                    {be neat}
      WRITELN('Unable to open file [' + OutName + ']');
    END                                 {return FALSE}
    ELSE BEGIN
      currin := 0;                      {init input string buffer ptr}
      currout := 0;                     {init output string buffer ptr}
      inlines := 0;                     {insure initial input buffer fill}

      Open_Files := TRUE;               {return TRUE}
    END;
  END;  {of Open_Files}


PROCEDURE Build_Reserved_Arrays;
  {Read in our file of reserved word strings.
   Create two linked lists of string records:
   one normal (lowercased assembly language instructions,
               uppercased MASM instructions),
   one all uppercased).
   We just do this once.
  }
  VAR
    p,                     {working string record pointer}
    curr,curruc : StrPtr;  {for current normal and uppercased str recs}
    TokenFile : TEXT;      {file of reserved word strings}
  BEGIN
      ASSIGN(TokenFile,TokFilename);    {file of reserved word strings}
      {$I-}  RESET(TokenFile);  {$I+}    {open it}
      IF IOResult <> 0 THEN BEGIN        {not found .. die}
        WRITELN(TokFilename, ' file not found.  Aborting!');
        HALT(1);                         {die}
      END;

      NEW(ReservedWords);               {allocate first reserved string
                                         record}
      ReservedWords^.S := '';           {build first string ptr}
      ReservedWords^.next := NIL;       {no next}

      NEW(UcReserved);                  {create first dynamic uppercased
                                         string ptr}
      UcReserved^ := ReservedWords^;    {initialize it also}

      curr := ReservedWords;            {point to first string ptr}
      curruc := UcReserved;             {and first uppercased str ptr}

      WHILE NOT EOF(TokenFile) DO BEGIN {read in all the strings}
        READLN(TokenFile,curr^.S);      {read in string}
        NEW(p);                         {allocate new normal record}
        curr^.next := p;                {point THIS record to next one}
        curruc^.S := Uc(curr^.S);       {create uppercased reserve word}
        curr := p;                      {bump to next normal record}

        NEW(p);                         {allocate new uppercased record}
        curruc^.next := p;              {assume no next uppercase rec}
        curruc := p;                    {bump to next uppercase rec}
      END;
      curr^.S := '';                    {last string is empty}
      curr^.next := NIL;                {..and points nowhere}
      curruc^ := curr^;                 {also empty}

      {$I-} CLOSE(TokenFile);  {$I+}    {close up}
      IF IOResult <> 0 THEN ;           {we don't care}

    END;  {of Build_Reserved_Arrays}


PROCEDURE Test_For_Reserved_Words;
  {Test if the current word (RamWord) is a reserved word.
   If so, write its equivalent (uppercased or upper/lower words)
   out to our output file.
   Else just write it as it is.
  }
  VAR
    p,len : Word;
    curruc,                            {uppercased word str ptr}
    curr : StrPtr;                     {reserved word str ptr}
  BEGIN

    Padded := ' ' + Uc(RamWord) + ' ';  {Uppercase, bracket with spaces}
    len := LENGTH(RamWord);

    curruc := UcReserved;               {ptr to first dynamic uppercased
                                         reserved word string record}
    IF NOT AllUpper                     {not just uppercase}
    THEN curr := ReservedWords          {Upper/lower case array also}
    ELSE curr := UcReserved;

    WHILE curruc^.next <> NIL DO BEGIN  {check all the reserved words}

      p := posBM(Padded, curruc^.S);    {is this uppercased, padded
                                         word in the reserved word line?}
(*
      p := firstPos(Padded,curruc^.S,0);  {v1.1}
*)
      IF p > 0 THEN BEGIN               {yep, we have a reserved word}

        Inc(p);                         {bump past the space}
        IF AllUpper                     {converting to uppercase..}
        THEN Padded := COPY(curruc^.S,  {..so move in the uppercased word}
                            p, len)
        ELSE BEGIN                      {more processing}
          Padded := COPY(curr^.S,       {word per our Reserved table}
                         p, len);       {uppercase or lower}
          IF Lower
          THEN IF Padded = Uc(Padded)   {If the mixed-case Table word
                                         matches the uppercased word..
                                         it's non-MASM...}
            THEN Lo_Str(Padded);        {..so lowercase it}
        END;
        WorkLine := WorkLine + Padded;  {build in WorkLine}
        Exit;                           {don't look at any more lines}
      END;  {if Padded in line}
      curruc := curruc^.next;           {point to next uppercased reserved
                                         word string record}
      curr := curr^.next;               {point to next normal string}
    END;    {line-checking loop}

{We checked all the lines, didn't find our RamWord as a Reserved word}

    WorkLine := WorkLine + RamWord;     {build WorkLine with orig word}

  END;  {of Test_For_Reserved_Words}



PROCEDURE Process_A_Word;
  VAR
    len : Byte;
    strt : Word;
  BEGIN
    strt := charP;                      {remember where we started}
    WHILE ( (Upcase(ProgLine[charP]) IN Identifier)  {it's a legal char}
    AND (charP <= LENGTH (ProgLine) ) ) {and line isn't done}
                                        {Special case:
                                         bp.label  or  si.label}
    AND NOT ((ProgLine[charP] = '.') AND (charP > strt) )
    DO  Inc(charP);                     {bump ProgLine ptr}

    len := (charP - strt);              {nr chars in word}
    RamWord[0] := CHAR(len);            {force string length}
    Move(ProgLine[strt], RamWord[1], len);  {copy portion of ProgLine
                                             into a working string}

    Test_For_Reserved_Words;            {check RamWord for reserved words,
                                         maybe add to WorkLine}
  END;  {of Process_A_Word}


PROCEDURE Process_COMMENT;
  {Handle any COMMENT directives.
   This assumes our comment end will be a separate line
   without any real code or data.
   Bad assumption, I know .. but for the time being...
  }
  VAR  p : WORD;
  BEGIN
    UProgLine := Uc(ProgLine);          {produce uppercased source line}

    charP := posBM('COMMENT',UProgLine);  {check for COMMENT ~}
(*
    charP := firstpos('COMMENT',UProgLine,0);
*)
    IF charP = 0 THEN Exit;             {forget it}

    {maybe we have one, but could be "comment_str" or some such.
     We'll snarf the potential " COMMENT ".
     If first word in line, there won't be a leading space; we'll add one.
     If not really COMMENT, there'll be no leading whitespace
     or trailing whitespace.
     Proper " COMMENT " should be 9 chars long, leading and trailing
     whitespace.
     We'll snarf one MORE than that to be sure line is long enough
     for the actual comment character.
     }

    IF (charP = 1)                      {first word in line}
    THEN RamWord := ' ' + COPY(UProgLine,1,9)  {add leading space}
    ELSE RamWord := COPY(UProgLine,PRED(charP),10);  {snarf char before}

    IF (LENGTH(RamWord) < 10)           {not long enough for " COMMENT ~"}
    OR NOT (RamWord[1] IN [#$20,#$09])  {leading char must be space or tab}
    OR NOT (RamWord[9] IN [#$20,#$09])  {separator must be space or tab}
    THEN Exit;                          {forget it}

    {Truly a COMMENT.  However, there may be more than one whitespace
     between "COMMENT" and the comment character.
    }
    p := charP + 7;                     {point past "COMMENT"}
    CommentCh := ProgLine[p];           {snarf next char}

    WHILE (p <= LENGTH(ProgLine))       {until EOL}
    AND (CommentCh IN [#$20,#$09])      {white space}
    DO BEGIN
      CommentCh := ProgLine[p];         {snarf next char}
      Inc(p);                           {bump ptr}
    END;

    IF (p > LENGTH(ProgLine))           {hit EOL}
    AND (CommentCh IN [#$20,#$09])      {didn't get real comment token}
    THEN BEGIN
      Writeln;                          {end counter display line}
      Writeln('Comment error at line ', linenum);  {error msg}
      GotoXY(ourX,WhereY);              {reposition to correct col}
      WRITE('Processing line: ');       {redisplay counter display}
      Exit;                             {process as "normal" source code}
    END;

    {truly a COMMENT line}
    IF Lower THEN RamWord := 'comment'
    ELSE RamWord := 'COMMENT';
    Move(RamWord[1],ProgLine[charP],7); {fix COMMENT word}

    Writeln_B(ProgLine);                {write out the entire line}

    WHILE ReadLn_B(ProgLine)            {new line, not EOF}
    AND (CommentCh <> #0)               {last line wasn't last comment line}
    DO BEGIN
      Writeln_B(ProgLine);              {so write out comment}
      WRITE(linenum:6,^H^H^H^H^H^H);    {display, back up}
      Inc(linenum);                     {bump linenr}
      IF posCh(CommentCh,ProgLine) <> 0 {last COMMENT line}
      THEN CommentCh := #0;             {clear as a flag to exit next loop}
    END;

  END;  {of Process_COMMENT}


PROCEDURE Process_Quotes;
  {Process any ";" comments, quotes, etc.}
  BEGIN
    charP := posCh(COMMENT,ProgLine);   {find first ';'}
    IF charP = 1 THEN BEGIN             {entire line is commented}
      CommentLine := ProgLine;          {so move into CommentLine for write}
      ProgLine := '';                   {nothing left}
      Exit;                             {all done}
    END;

    IF charP <> 0 THEN BEGIN            {commented within line}
                                        {save commented txt}
      CommentLine := COPY(ProgLine,charP,LENGTH(ProgLine));
      Delete(ProgLine,charP,LENGTH(ProgLine));  {delete commented txt}
    END;

{ Process remaining line for Quoted text,
  handling "nested" quotation marks to pick up the first one.
}
    charP := 0;                         {init quote pointer}

    quote1P  := posCh(APOS,ProgLine);   {find first '''}
    quote2P  := posCh(QUOTE,ProgLine);  {find first '"'}

    IF quote1P <> 0 THEN BEGIN          {we have a '}
      IF quote2P = 0                    {no " quote}
      THEN charP := quote1P             {so mark first quote}
      ELSE IF quote1P < quote2P         {we have both quotes}
      THEN charP := quote1P             {and ' comes before "}
      ELSE charP := quote2P;            {we have both quotes
                                         and " comes before '}
    END
    ELSE IF quote2P <> 0 THEN BEGIN     {we have a "}
      IF quote1P = 0                    {no ' quote}
      THEN charP := quote2P             {so mark first quote}
      ELSE IF quote2P < quote1P         {we have both quotes}
      THEN charP := quote2P             {and " comes before '}
      ELSE charP := quote1P;            {we have both quotes
                                         and ' comes before "}
    END;
    IF (charP <> 0) THEN BEGIN          {we have quoted text}
      CommentLine := COPY(ProgLine,charP,LENGTH(ProgLine))  {Put quoted}
                     + CommentLine;             { txt before Commented txt}
      Delete(ProgLine,charP,LENGTH(ProgLine));  {delete Quoted text}
    END;
  END;  {of Process_Quotes}


PROCEDURE Convert;
  VAR
    Ch : CHAR;
    p : INTEGER;
  BEGIN
    WRITE('Converting ', Args[argv]^, ' => ', OutName,', ');
    ourX := WhereX;                     {pick up current col coord}
    WRITE('Processing line: ');

    linenum := 1;

    WHILE ReadLn_B(ProgLine) DO BEGIN   {buffered string input
                                         FALSE means EOF}
      WorkLine := '';                   {initialize working line}
      CommentLine := '';                {and commentline}

      IF LENGTH(ProgLine) <> 0 THEN BEGIN     {nonblank line}

        Process_COMMENT;                {handle any COMMENT lines}
        IF LENGTH(ProgLine) <> 0        {we have a line to process}
        THEN Process_Quotes;            {handle any ";" comments or quotes}

{Process remaining line (if any) for reserved words}

        charP := 1;
        WHILE charP <= LENGTH(ProgLine) DO BEGIN
          Ch := UProgLine[charP];       {next uppercased prog char}
          IF Ch IN Identifier           {could be a reserved word}
          THEN Process_A_Word           {process possible reserved word}
          ELSE BEGIN

            Inc(worklen);               {bump WorkLine length}
            WorkLine[worklen] := Ch;    {stuff char in WorkLine}
(* Same as
            WorkLine := WorkLine + Ch;
   but tighter, faster
*)
            Inc(charP);                 {bump ptr}
          END;  {non-identifier char}
        END;  {WHILE processing remaining non-commented, non-quoted text}
      END; {If nonblank ProgLine}

      Writeln_B(WorkLine + CommentLine); {buffered string output}

      WRITE(linenum:6,^H^H^H^H^H^H);    {display, back up}
      Inc(linenum);                     {bump linenr}
    END;  {While}

    WRITELN;                            {clean up screen}

    Flush_OutBuff;                      {flush output buffer,
                                         close up everything}
  END;  {of Convert}


BEGIN  {main}

  Get_Args;                             {process cmdline args
                                         (may die)}
  Build_Reserved_Arrays;                {build two linked lists
                                         of reserved word records
                                         (one normal, one uppercased) }

  {So far, so good.  Initialize our dynamic input and output
   buffer array pointers.
   Later, check for avail memory, constrain buffers, etc.
  }

  FOR currin := 1 TO MAXBUFFLINES DO
    NEW(InBuff[currin]);
  FOR currout := 1 TO MAXBUFFLINES DO
    NEW(OutBuff[currout]);

{Now we go into our file loop.
 We continue until FindNext returns no more files.
 Get_Args set argv appropriately.
}

  SrchRec.Name := '';                   {clear for first file}

  WHILE (SrchRec.Name <> '')            {we're working a wildcard}
  OR (argv < argc)                      {no wildcard, but still got args}
  DO BEGIN

    IF Open_Files                       {open InFile,OutFile}
    THEN Convert;                       {files open, do the conversion}

  END;  {until all done}

END.