home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / UPCONV13.ZIP / UPCONV13.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-04-14  |  24.9 KB  |  663 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;                {v1.3 for all the wildcard stuff}
  9.  
  10. {$DEFINE NO_OVERWRITE}   {this enables .FMT file existence checking.
  11.                           I suggest you leave it .. that keeps the
  12.                           system from trying to reformat earlier
  13.                           .FMT files during a wildcard run where
  14.                           the user specified *.* or something!
  15.                          }
  16. { DEFINE NOWORKLINE}     {for timing tests: building an output string
  17.                           in WorkLine vs. outputting chars or words.
  18.                          }
  19.  
  20. { DEFINE TURTLE}         {Enable if you want Turtle-related reserved words}
  21.  
  22. {
  23.  Original based on a bulletin board program by Jeff Firestone
  24.  This version based on a program by Douglas S. Stivison in his book:
  25.      'Turbo Pascal Library' published by Sybex.
  26.  
  27.   v1.3, Toad Hall, 14 Apr 89
  28.     - Tweaking for Turbo Pascal v5.0
  29.     - Adding a bunch of TP 4.0 and 5.0 Borland words.
  30.     - Tightening up a little.
  31.     - Added commandline multiple filename/wildcard capability.
  32.     - Added '/L' switch for Pascal (non-Borland) reserved word
  33.       lowercase conversion.
  34.     - Building formatted output string (WorkLine).  Saved only a little
  35.       processing time, but did cut out about 60-70 bytes of code.
  36.                   time        size
  37.       $DEFINE:    1:16.35     12160 bytes
  38.       No DEFINE:  1:15.79     12096 bytes
  39.     - Tried a Move instruction to concatenate strings to WorkLine
  40.       (vs. WorkLine := WorkLine + String); gained no time, only saved
  41.       16 bytes .. not worth the obtuseness.
  42.     - Adding chars to WorkLine the hard way (see code) vs. normal way
  43.       (WorkLine := WorkLine + char)  saved code, time:
  44.                    1:17.34     12208 bytes
  45.  
  46.   v1.2, Toad Hall, 12 Oct 88
  47.     - Bug in Scan_Till procedure.  Fixed.
  48.     - Isn't leaving quoted strings alone.  Fixed.
  49.  
  50.   v1.1 Toad Hall Tweak, Sep 88
  51.     - Added command line filename input.
  52.     - Moved Identifier char set to a global typed constant.
  53.     - Changed simple Reserved Word uppercasing to include Turbo Pascal
  54.       formatted reserved words.
  55.     - Added more reserved words for Turbo Pascal.  (Complete thru v3.0,
  56.       I think .. don't have 4.0, so that should be added.)
  57.     - Command line switch ('-U') to force all reserved words to uppercase
  58.       (e.g., ignore Turbo Pascal format).
  59.     - Considering how to change other text (non-quoted, non-comments)
  60.       to all-upper, all-lower, As-Is, like PFORMAT.PAS does.
  61.     - Still suspect a fancy hash procedure to confirm a RamWord as a
  62.       reserved word would be better than this "if word is in line"
  63.       business.  Later.
  64.   One peculiarity about the comment-handling:  Anything within the usual
  65.   '}{' comments is skipped over; anything within the "parenthesis asterisk"
  66.   type comment IS processed!  So .. put real comments within '}{' comments,
  67.   and commented-out code within the '(* *)' type comments.
  68.  
  69.   v1.0
  70.     - Found in SIMTEL20's PD1:<MSDOS.TURBOPAS>UPCONV.ARC.
  71.       Original author unknown.
  72.  
  73.   David Kirschbaum
  74.   Toad Hall
  75.   kirsch@braggvax.ARPA
  76. }
  77.  
  78.  
  79. CONST
  80. {$IFNDEF TURTLE}
  81.   NRLINES = 57;     {v1.3}
  82. {$ELSE}
  83.   NRLINES = 60;     {v1.3 3 more lines of Turtle-related reserved words}
  84. {$ENDIF}
  85.  
  86. TYPE
  87.   ReservedArray =   ARRAY[1..NRLINES] OF STRING[80];  {v1.3}
  88.  
  89. CONST
  90. { These words are NOT in any special order .. I alphabetized them just
  91.   to make them neat.
  92. }
  93.  
  94.   ReservedWords : ReservedArray = (
  95. ' $DEFINE $ELSE $ENDIF $IFDEF $IFNDEF $IFOPT $UNDEF ABS Absolute Addr AND ',
  96. ' AnyFile Append Arc ArcCoordsType Archive ARCTAN ARRAY Assign AssignCrt ATT400 ',
  97. ' ATT400C1 ATT400C2 ATT400C3 ATT400Hi ATT400Med Aux AuxIn AuxInPtr AuxOutPtr ',
  98. ' Bar3D BEGIN BkSlashFill BLACK BlockRead BlockWrite BLUE BOOLEAN BottomText ',
  99. ' BufLen BW40 BW80 Byte C40 C80 CASE CBreak CenterLn CenterText CGA CGAC0 CGAC1 ',
  100. ' CGAC3 CGAHi Chain CHAR ChDir CheckBreak CheckEOF CheckSnow ChkEOF CHR Circle ',
  101. ' ClearViewPort ClipOff ClipOn CLOSE CloseDotFill CloseGraph ClrEol ClrScr ',
  102. ' Con CONCAT ConIn ConInPtr ConOut ConOutPtr CONST ConstPtr COPY CopyPut COS ',
  103. ' CrtExit CrtInit CSeg CurrentDriver CYAN DARKGRAY DashedLn DateTime Dec ',
  104. ' Delay DELETE DelLine Detect DetectGraph Directory DirectVideo DirStr DiskFree ',
  105. ' Dispose DIV DO DosError DosExitCode DosVersion DottedLn DOWNTO Draw DrawPoly ',
  106. ' EGA EGA64 EGABlack EGABlue EGABrown EGACyan EGADarkGray EGAGreen EGAHi ',
  107. ' EGALightcyan EGALightgray EGALightgreen EGALightmagenta EGALightred EGALo ',
  108. ' EGAMono EGAMonoHi EGARed EGAWhite EGAYellow Ellipse ELSE EmptyFill END ',
  109. ' EnvStr EOF EOLN Erase ErrorAddr Execute Exit ExitCode ExitProc EXP EXTERNAL ',
  110. ' FALSE FAuxiliar FCarry FExpand FILE FileMode FilePos FileRec FileSize ',
  111. ' FillEllipse FillPattern FillPatternType FillPoly FillScreen FillSettingsType ',
  112. ' FindFirst FindNext FloodFill Flush fmClosed fmInOut fmInput fmOutput Font8x8 ',
  113. ' FORWARD FOverflow FParity Frac FreeMem FreeMin FreePtr FSearch FSign FSplit ',
  114. ' FZero GetArcCoords GetAspectRatio GetBkColor GetCBreak GetColor GetDate ',
  115. ' GetDir GetDotColor GetDriverName GetEnv GetFAttr GetFillPattern ',
  116. ' GetFTime GetGraphMode GetImage GetIntVec GetLineSettings GetMaxColor ',
  117. ' GetMaxX GetMaxY GetMem GetModeName GetModeRange GetPaletteSize GetPallette ',
  118. ' GetPixel GetTextSettings GetTime GetVerify GetViewSettings GetX GetY ',
  119. ' GOTO GotoXY Graph Graph3 GraphBackGround GraphColorMode GraphDefaults ',
  120. ' GraphFreeMemPtr GraphGetMemPtr GraphMode GraphResult GraphWindow GREEN ',
  121. ' grFileNotFound grFontNotFound grInvalidDriver grInvalidFont grInvalidFontNum ',
  122. ' grIOerror grNoFloodMem grNoFontMem grNoInitGraph grNoLoadMem grNoScanMem ',
  123. ' grOk HALT HatchFill HeapError HeapOrg HeapPtr HeapStr HercMono HercMonoHi Hi ',
  124. ' HighVideo HiRes HiResColor HorizDir IBM8514 IBM8514HI IBM8514LO IF ImageSize ',
  125. ' IN Inc InitGraph InLine InOutRes INPUT INSERT InsLine InstallUserDriver ',
  126. ' INT INTEGER InterleaveFill Intr IOResult Kbd Keep KeyPressed LABEL LastMode ',
  127. ' LENGTH LIGHTBLUE LIGHTCYAN LIGHTGRAY LIGHTGREEN LIGHTMAGENTA LIGHTRED Line ',
  128. ' LineRel LineSettingsType LineTo LN Lo LongFilePos LongFileSize LongSeek ',
  129. ' Lst LstOut LstOutPtr LtBkSlashFill LtSlashFill MAGENTA MARK MaxAvail ',
  130. ' MAXINT MCGA MCGAC0 MCGAC1 MCGAC2 MCGAC3 MCGAHi MCGAMed Mem MemAvail MemL MemW ',
  131. ' MOD Move MoveRel Moveto MsDos NameStr NEW NIL NormVideo NormWidth NoSound NOT ',
  132. ' ODD OF Ofs OR ORD OrPut OUTPUT OutText OutTextXY OverClearBuf OverCodeList ',
  133. ' OverInitEMS Overlay OverSetBuf OvrDebugPtr OvrDosHandle OvrEmsHandle ovrError ',
  134. ' OvrHeapEnd OvrHeapOrg OvrHeapPtr OvrHeapSize ovrIOError OvrLoadList ',
  135. ' ovrNoEMSMemory ovrNoMemory ovrNotFound ovrOk OvrPath OvrResult PACKED ',
  136. ' Palette PaletteType Pattern PC3270 PC3270Hi Pi PieSlice Plot PointType Port ',
  137. ' POS PRED PrefixSeg Printer PROCEDURE PROGRAM Ptr PutImage PutPic PutPixel ',
  138. ' Randomize RandSeed READ ReadKey READLN ReadOnly REAL RECORD RecTangle RED ',
  139. ' RegisterBGIfont Registers RELEASE Rename REPEAT RESET RestoreCrtMode REWRITE ',
  140. ' RmDir ROUND SanSeriFont SearchRec Sector Seek Seg SET SetActivePage ',
  141. ' SetAspectRatio SetBkColor SetCBreak SetColor SetDate SetFAttr SetFillPattern ',
  142. ' SetFTime SetGraphBufSize SetGraphMode SetIntVec SetLineStyle SetPalette ',
  143. ' SetTextJustify SetTextStyle SetTime SetUserCharSize SetVerify SetViewPort ',
  144. ' SetWriteMode ShL ShR SIN SIZEOF SlashFill SmallFont SolidFill SolidLn Sound ',
  145. ' Sqrt SSeg StackLimit STR STRING SUCC Swap SwapVectors SysFile Test8087 TEXT ',
  146. ' TextBackGround TextBuf TextColor TextHeight TextMode TextRec TextSettingsType ',
  147. ' THEN ThickWidth TO ToadHall TopOff TopOn TopText TriplexFont Trm TRUE TRUNC ',
  148. ' Turbo3 TYPE Unit UnpackTime UNTIL UpCase UserCharSize UserFill Uses Usr ',
  149. ' UsrIn UsrInPtr UsrOut UsrOutPtr VAL VAR VertDir VGA VGAHi VGALo VGAMed ',
  150. ' VolumeID WhereX WhereY WHILE WHITE WideDotFill WindMax WindMin Window WITH ',
  151. ' WRITE WRITELN XHatchFill XOr XORPut YELLOW '
  152. {$IFDEF TURTLE}
  153. ,         {need a comma}
  154. ' Back ClearScreen Forwd Heading HideTurtle Home NoWrap PenUp PenDown '
  155. ' SetHeading SetPenColor SetPosition ShowTurtle TurnLeft TurnRight',
  156. ' TurtleDelay TurtleThere TurtleWindow Wrap Xcor Ycor'
  157. {$ENDIF}
  158. );
  159.  
  160. { There's also a bunch of CP/M stuff, like BDOS .. you CP/M'ers do that. }
  161.  
  162.  
  163.   APOS          = #39;            {This is the ' symbol.}
  164.   OPENCOMMENT   = '{';
  165.   CLOSECOMMENT  = '}';
  166.  
  167. TYPE
  168.   Str80  = STRING[80];
  169.  
  170. CONST
  171.    {Note: These are the only valid characters that can be used in Turbo
  172.     identifiers.}
  173.   Identifier : SET OF CHAR = ['A'..'Z', '0'..'9', '_'];
  174.  
  175. VAR
  176.   charpsn,
  177.   linenum    : word;          {v1.3 INTEGER;}
  178.   Lower,                      {v1.3 If TRUE, all Pascal reserved words
  179.                                lowercased (but not the Borland ones!)}
  180.   AllUpper   : BOOLEAN;       {if TRUE, ALL reserved words uppercased
  181.                                (Borland ones also)}
  182.  
  183.   UcWord,                               {possible keyword, uppercased}
  184.   Padded     : STRING[20];              {UcWord, padded with spaces}
  185.  
  186.   WorkLine,                             {v1.3 Build formatted output line}
  187.   ProgLine   : String;                  {v1.3 STRING[128]}
  188.   worklen    : BYTE absolute WorkLine;  {v1.3}
  189.  
  190.   RamWord    : STRING [100];
  191.  
  192.   InFile,
  193.   OutFile : TEXT;
  194.   UCReserved : ReservedArray;           {uppercased reserved word lines}
  195.  
  196.  
  197. { Multiple cmdline parm/wildcard stuff }
  198. CONST
  199.   MAXARGS = 10;                         {change as you like}
  200.  
  201. VAR
  202.   Ok : BOOLEAN;
  203.   argv, argc : Byte;
  204.   Args : ARRAY[1..MAXARGS]              {array of cmdline parms}
  205.            OF PathStr;                  {STRING[79]}
  206.  
  207.   Dir : DirStr;                         {STRING[79]}
  208.   Name: NameStr;                        {STRING[8]}
  209.   Ext : ExtStr;                         {STRING[4]}
  210.  
  211.   OutName : PathStr;                    {STRING[79]}
  212.  
  213. {SearchRec is declared in the Dos unit:}
  214. (*
  215.  TYPE SearchRec = RECORD
  216.                     fill : ARRAY[1..21] OF Byte;
  217.                     attr : Byte;
  218.                     time : longint;
  219.                     size : longint;
  220.                     Name : STRING[12];
  221.                   END;
  222. *)
  223.     SrchRec : SearchRec;
  224.  
  225.  
  226. PROCEDURE Usage;
  227.   {Give user help, terminate.
  228.    Happens on cmd line of '?', '-?', '/?', '-h', '/h', or empty.
  229.   }
  230.   BEGIN
  231.     WRITELN(
  232. 'UPCONV v1.3 - Convert Pascal reserved words to uppercase,');
  233.     WRITELN(
  234. '       If Turbo Pascal reserved words, convert to Borland style');
  235.     WRITELN(
  236. 'Usage:  UPCONV [[-][/]U][L] file1[.typ]');
  237.     WRITELN( 'Switches:');
  238.     Writeln(
  239. ' -u, -U, /u, or /U : uppercase ALL reserved words');
  240.     Writeln(
  241. '                     (overriding the Borland Style)');
  242.     Writeln(
  243. ' -l, -L, /l, or /L : lowercase Pascal (non-Borland) reserved words');
  244.     WRITELN(
  245. 'Source filename file1 will be forced to .PAS if no type is given.');
  246.     WRITELN(
  247. 'Formatted output filename forced to FILE1.FMT');
  248.     WRITELN('Wildcards may be used for file1.typ');
  249.     Halt;
  250.   END;  {of Usage}
  251.  
  252.  
  253. FUNCTION Uc (S : String) : String;
  254.   {v1.3 Returns S uppercased}
  255.   BEGIN
  256. Inline(
  257.   $31/$C0/       {  xor   ax,ax}
  258.   $8A/$86/>S/    {  mov   al,>S[bp]  ;snarf the length}
  259.   $09/$C0/       {  or    ax,ax      ;0 length?}
  260.   $74/$18/       {  jz    Exit       ;yep, exit}
  261.  
  262.   $89/$C1/       {  mov   cx,ax      ;loop counter}
  263.   $BA/$61/$20/   {  mov   dx,$2061   ;DL='a',DH=$20}
  264.   $31/$F6/       {  xor   si,si}
  265.                  {L1:}
  266.   $46/           {  inc   si       ;next char}
  267.   $36/           {  SS:}
  268.   $8A/$82/>S/    {  mov   al,>S[bp][si]  ;snarf the char}
  269.   $38/$D0/       {  cmp   al,dl}
  270.   $72/$05/       {  jb    S1       ;already uppercase}
  271.   $36/           {  SS:}
  272.   $28/$B2/>S/    {  sub  >S[bp][si],dh   ;uppercase it}
  273.                  {S1:}
  274.   $E2/$EF);      {  loop  L1}
  275.                  {Exit:}
  276.  
  277.     Uc := S;    {return the function}
  278.   END;  {of Uc}
  279.  
  280.  
  281. PROCEDURE Uc_Str(VAR S : String);
  282.   {v1.3  Same as Uc, but changes the string "in place".}
  283.   BEGIN
  284. Inline(
  285.   $8C/$DB/       {  mov   bx,DS      ;preserve DS}
  286.   $C5/$B6/>S/    {  lds   si,>S[bp]  ;get the VAR addr}
  287.   $31/$C0/       {  xor   ax,ax}
  288.   $8A/$04/       {  mov   al,[si]    ;snarf the length}
  289.   $89/$C1/       {  mov   cx,ax      ;loop counter}
  290.   $E3/$0E/       {  jcxz  Exit       ;zero length, forget it}
  291.                  {;}
  292.   $BA/$61/$20/   {  mov   dx,$2061   ;DL='a',DH=$20}
  293.                  {L1:}
  294.   $46/           {  inc   si         ;next char}
  295.   $8A/$04/       {  mov   al,[si]    ;snarf the char}
  296.   $38/$D0/       {  cmp   al,dl}
  297.   $72/$02/       {  jb    S1         ;already uppercase}
  298.   $28/$34/       {  sub   [si],dh    ;uppercase it}
  299.                  {S1:}
  300.   $E2/$F5/       {  loop  L1}
  301.                  {Exit:}
  302.   $8E/$DB);      {  mov   DS,bx      ;restore DS}
  303.   END;  {of Uc_Str}
  304.  
  305. PROCEDURE Lo_Str (VAR S : String);
  306.   {v1.3 Lowercase a string}
  307.   BEGIN
  308. Inline(
  309.   $1E/           {  push  DS}
  310.   $C5/$B6/>S/    {  lds   si,>S[bp]}
  311.   $31/$C0/       {  xor   ax,ax}
  312.   $8A/$04/       {  mov   al,[si];snarf the length}
  313.   $09/$C0/       {  or    ax,ax  ;0 length?}
  314.   $74/$16/       {  je    Exit   ;yep, exit}
  315.  
  316.   $89/$C1/       {  mov   cx,ax}
  317.   $BA/$41/$5A/   {  mov   dx,$5A41  ;DL='A',DH='Z'}
  318.   $B4/$20/       {  mov   ah,$20 ;handy constant}
  319.                  {L1:}
  320.   $46/           {  inc   si     ;next char}
  321.   $8A/$04/       {  mov   al,[si];snarf the char}
  322.   $38/$D0/       {  cmp   al,dl  ;<'A'?}
  323.   $72/$06/       {  jb    S1     ;yep}
  324.   $38/$F0/       {  cmp   al,dh  ;>'Z'?}
  325.   $77/$02/       {  ja    S1     ;yep}
  326.   $00/$24/       {  add   [si],ah  ;lowercase}
  327.                  {S1:}
  328.   $E2/$F1/       {  loop  L1}
  329.                  {Exit:}
  330.   $1F);          {  pop   DS    ;restore}
  331.  
  332.   END;  {of Lo_Str}
  333.  
  334.  
  335. PROCEDURE Get_Args;
  336.   {v1.3 process command line for all target filenames.
  337.         Move them into a dynamic array of PathStrs.
  338.   }
  339.   VAR Ch : CHAR;
  340.   BEGIN
  341.     argc := ParamCount;
  342.     IF (argc = 0)                       {no parms at all}
  343.     OR (argc > MAXARGS)                 {or more than we can handle}
  344.     THEN Usage;                         {display help, die}
  345.  
  346.     FOR argv := 1 TO argc DO
  347.       Args[argv] := Uc(ParamStr(argv)); {snarf parm, (uppercased)}
  348.     Args[SUCC(argc)] := '';             {double-insure no overruns}
  349.  
  350. { The first arg could've been a '-u' or '/u',
  351.   or a '-l' or '/l'.
  352.   Check that out now.  If so, we set a global and skip that arg
  353.   when it comes time to open files.
  354. }
  355.     argv := 0;                          {assume we start at 1}
  356.     Lower := FALSE;
  357.     AllUpper := FALSE;                  {assume no switches}
  358.  
  359.     IF (LENGTH(Args[1]) = 2)            {2 chars to a switch}
  360.     AND (Args[1][1] IN ['-','/'])       {first is a switch char}
  361.     THEN BEGIN                          {we got a switch}
  362.       Ch := Args[1][2];                 {grab 2d char}
  363.       IF Ch IN ['?','H'] THEN Usage;    {help, die}
  364.  
  365.       IF Ch = 'U' THEN AllUpper := TRUE     {maybe upper switch}
  366.       ELSE IF Ch = 'L' THEN Lower := TRUE;  {or maybe lower}
  367.       IF NOT (AllUpper OR Lower)            {bogus switch}
  368.       THEN Writeln('Unknown switch: [', Args[1], '], ignored!');
  369.  
  370.       Inc(argv);                        {skip 1st arg in any case}
  371.     END;  {if Arg(1) was a switch}
  372.  
  373.   END;  {of Get_Args}
  374.  
  375.  
  376. {$IFDEF NO_OVERWRITE}      {v1.3 only if we want no overwriting}
  377.  
  378. FUNCTION Exists(Name : PathStr) : BOOLEAN;
  379.   {Returns TRUE if Name exists on current drive:\dir}
  380.   VAR  F : TEXT;
  381.   BEGIN
  382.     Assign(F, Name);
  383.     {$I-}  RESET (F);  {$I+}
  384.     IF IOResult = 0 THEN BEGIN
  385.       Exists := TRUE;
  386.       Close(F);
  387.     END
  388.     ELSE Exists := FALSE;
  389.   END;  {of Exists}
  390.  
  391. {$ENDIF}
  392.  
  393.  
  394. PROCEDURE Open_Files;
  395.   {Works FindNext if appropriate, else uses a new Arg string.
  396.    Returns Global Ok boolean per success/failure.
  397.   }
  398.   VAR  FName : PathStr;
  399.   BEGIN
  400.     IF SrchRec.Name = '' THEN BEGIN         {time for a new name}
  401.  
  402.       Inc(argv);                            {bump for first/next name}
  403.       Ok := (argv <= argc);
  404.       IF NOT Ok THEN Exit;                  {all done, Ok FALSE}
  405.  
  406.       FSplit(Args[argv], Dir, Name, Ext);   {split up the new name}
  407.       IF Ext = '' THEN Ext := '.PAS';       {force to .PAS type}
  408.       FName := Dir + Name + Ext;            {build new name}
  409.       FindFirst(FName,READONLY OR ARCHIVE,SrchRec)  {first time thru}
  410.     END
  411.     ELSE FindNext(SrchRec);                 {working a wildcard}
  412.  
  413.     Ok := (DosError = 0);               {from FindFirst or FindNext}
  414.     IF NOT Ok THEN BEGIN                {not found}
  415.       SrchRec.Name := '';               {Flag we need a new arg
  416.                                          and FindFirst}
  417.       Exit;                             {Ok is FALSE}
  418.     END;
  419.  
  420.     FName := Dir + SrchRec.Name;        {new name from FindFirst/FindNext}
  421.     Args[argv] := FName;                {Update Args for outside display}
  422.  
  423. {v1.3 We'll always force the '.FMT' file type for output.}
  424.  
  425.     FSplit(FName, Dir, Name, Ext);
  426.  
  427.     OutName := Name + '.FMT';           {build a new output path
  428.                                          (current drive:\directory) }
  429.  
  430. {$IFDEF NO_OVERWRITE}
  431.  
  432.     IF Exists(OutName) THEN BEGIN       {If .FMT file already exists...}
  433.       Writeln(Outname + ' already exists .. skipping!');
  434.       Ok := FALSE;                      {no processing}
  435.       Exit;
  436.     END;
  437. {$ENDIF}
  438.  
  439.     Assign(InFile, FName);
  440.     Reset(InFile);                      {open input file}
  441.  
  442.     Assign(OutFile, OutName);
  443.     {$I-}  REWRITE (OutFile);  {$I+}
  444.     Ok := (IOResult = 0);
  445.     IF NOT Ok THEN BEGIN
  446.       Close(InFile);                    {be neat}
  447.       Writeln('Unable to open file [' + OutName + ']');
  448.     END;                                {Exit, Ok FALSE}
  449.   END;  {of Open_Files}
  450.  
  451.  
  452. PROCEDURE Uc_The_Array;
  453.   {Create a new array of uppercased lines of reserved words.
  454.    We just do this once.
  455.   }
  456.   VAR i : word;                         {v1.3 INTEGER;}
  457.   BEGIN
  458.     UcReserved := ReservedWords;        {v1.3 copy the entire array}
  459.     FOR i := 1 TO NRLINES DO
  460.       Uc_Str(UCReserved[i]);            {v1.3 and uppercase them all}
  461.  
  462.     END;  {of Uc_The_Array}
  463.  
  464.  
  465. PROCEDURE Test_For_Reserved_Words;
  466.   {Test if the current word (RamWord) is a reserved word.
  467.    If so, write its equivalent (uppercased or Turbo Pascal format)
  468.    out to our output file.
  469.    Else just write it as it is.
  470.   }
  471.   VAR
  472.     i,p,len : word;                     {v1.3 INTEGER;}
  473.   BEGIN
  474.     Padded := ' ' + Uc(RamWord) + ' ';  {bracket with spaces}
  475.     len := LENGTH(RamWord);             {v1.3}
  476.  
  477.     FOR i := 1 TO NRLINES DO BEGIN      {check all the reserved words}
  478.       p := POS(Padded, UcReserved[i]);  {is this word (padded and uppercased)
  479.                                          in the uppercase reserved word
  480.                                          line?}
  481.       IF p > 0 THEN BEGIN               {yep}
  482.  
  483.         Inc(p);                            {bump past the space}
  484.         IF AllUpper                        {uppercasing everything}
  485.         THEN Padded := Copy(UcReserved[i], {so get word from uppercase table}
  486.                             p, len)
  487.         ELSE BEGIN                         {might be per Reserved table
  488.                                             or lowercasing}
  489.           Padded := Copy(ReservedWords[i], {word per our Reserved table}
  490.                          p, len);          {uppercase or Borlandized}
  491.           IF Lower
  492.           THEN IF Padded = Uc(Padded)      {If the mixed-case Table word
  493.                                             matches the uppercased word..
  494.                                             it's non-Borland...}
  495.             THEN Lo_Str(Padded);           {..so lowercase it}
  496.         END;
  497. {$IFDEF NOWORKLINE}
  498.  
  499.         Write(OutFile, Padded);
  500. {$ELSE}
  501.         WorkLine := WorkLine + Padded;     {v1.3 build in WorkLine}
  502. {$ENDIF}
  503.         Exit;                              {don't look at any more lines}
  504.       END;  {if Padded in line}
  505.     END;    {line-checking loop}
  506.  
  507. {We checked all the lines, didn't find our RamWord as a Reserved word}
  508.  
  509. {$IFDEF NOWORKLINE}
  510.     WRITE (OutFile, RamWord);           {.. so write the original word}
  511. {$ELSE}
  512.     WorkLine := WorkLine + RamWord;     {v1.3 build WorkLine with orig word}
  513. {$ENDIF}
  514.  
  515.   END;  {of Test_For_Reserved_Words}
  516.  
  517.  
  518. PROCEDURE Process_A_Word;
  519.   VAR
  520.     len : byte;   {v1.3}
  521.     strt : word;  {v1.3}
  522.   BEGIN
  523.     strt := charpsn;                    {v1.3 remember where we started}
  524.     WHILE (UpCase (ProgLine [charpsn]) IN Identifier)  {it's a legal char}
  525.     AND (charpsn <= LENGTH (ProgLine) )                {and line isn't done}
  526.     DO  Inc(charpsn);                   {v1.3 bump ProgLine ptr}
  527.  
  528.     len := (charpsn - strt);            {v1.3 nr chars in word}
  529.     RamWord[0] := CHAR(len);            {v1.3 force string length}
  530.     Move(ProgLine[strt], RamWord[1], len);  {v1.3 copy portion of ProgLine}
  531.  
  532.     Test_For_Reserved_Words;            {check RamWord for reserved
  533.                                          words, write out}
  534.   END;  {of Process_A_Word}
  535.  
  536.  
  537. PROCEDURE Scan_Till (SearchChar: CHAR);
  538.   VAR
  539.     Ch : CHAR;  {v1.2}
  540.   BEGIN
  541.     REPEAT
  542.       IF charpsn > LENGTH (ProgLine) THEN BEGIN
  543.  
  544. {$IFDEF NOWORKLINE}
  545.         WRITELN (OutFile);              {Simply terminates current line
  546.                                          on output.}
  547. {$ELSE}
  548.         Writeln(OutFile,WorkLine);      {Write the WorkLine we have
  549.                                          (Ok if it's empty)}
  550. {$ENDIF}
  551.  
  552.         READLN (InFile, ProgLine);      {Gets the next input line.}
  553.         charpsn := 1;
  554.         WorkLine := '';                 {v1.3 Reinit WorkLine}
  555.       END;
  556.  
  557.       IF ProgLine <> '' THEN BEGIN      {do non-blank lines}
  558.         Ch := ProgLine[charpsn];        {v1.2 remember what this char was}
  559.  
  560. {$IFDEF NOWORKLINE}
  561.         WRITE (OutFile, Ch);            {v1.2 write it out}
  562. {$ELSE}
  563.  
  564.         Inc(worklen);                   {v1.3 bump workline length}
  565.         WorkLine[worklen] := Ch;        {v1.3 stuff char in line}
  566. (* same as
  567.         WorkLine := WorkLine + Ch;
  568.    but faster, tighter
  569. *)
  570. {$ENDIF}
  571.  
  572.         Inc(charpsn);                   {v1.3 bump char ptr}
  573.       END
  574.       ELSE Ch := #0;                    {v1.2 blank line, clear Ch}
  575.     UNTIL (Ch = SearchChar)             {v1.2 the LAST char was end of
  576.                                          quoted string or comment}
  577.     OR EOF(InFile);
  578.   END;  {of Scan_Till}
  579.  
  580.  
  581. PROCEDURE Convert;
  582.   VAR Ch : CHAR;
  583.   BEGIN
  584.     WRITE('Converting ', Args[argv], ' => ', OutName,
  585.           ', Processing line: ');
  586.  
  587.     linenum := 0;
  588.  
  589.     WHILE NOT EOF(InFile) DO BEGIN
  590.       charpsn := 1;
  591.       WorkLine := '';                   {v1.3 clear WorkLine string}
  592.       READLN (InFile, ProgLine);
  593.       IF LENGTH(ProgLine) <> 0 THEN BEGIN     {v1.3 nonblank line}
  594.         REPEAT
  595.           Ch := Upcase(ProgLine[charpsn]);
  596.           IF Ch IN Identifier           {could be a reserved word}
  597.           THEN Process_A_Word           {so process it}
  598.           ELSE BEGIN
  599.  
  600. {$IFDEF NOWORKLINE}
  601.             WRITE (OutFile, ProgLine [charpsn]);  {v1.2 write out char}
  602. {$ELSE}
  603.             Inc(worklen);               {v1.3 bump WorkLine length}
  604.             WorkLine[worklen] := Ch;    {v1.3 stuff char in WorkLine}
  605. (* Same as
  606.             WorkLine := WorkLine + Ch;
  607.    but tighter, faster
  608. *)
  609. {$ENDIF}
  610.  
  611.             Inc(charpsn);               {v1.3 bump ptr}
  612.             IF Ch = OPENCOMMENT
  613.             THEN Scan_Till(CLOSECOMMENT)  {v1.2 write until
  614.                                            closing comment}
  615.             ELSE IF Ch = APOS
  616.             THEN Scan_Till(APOS);       {v1.2 write until 2d '}
  617.           END;
  618.         UNTIL (charpsn > LENGTH (ProgLine));
  619.       END; {If nonblank}
  620.  
  621. {$IFDEF NOWORKLINE}
  622.       Writeln(OutFile);                 {v1.3 new line}
  623. {$ELSE}
  624.       Writeln(OutFile, WorkLine);       {v1.3 Output Workline
  625.                                          (Ok if blank)}
  626. {$ENDIF}
  627.       Write(linenum:6,^H^H^H^H^H^H);    {display, back up}
  628.       Inc(linenum);                     {v1.3 bump linenr}
  629.     END;  {While}
  630.  
  631.     Writeln;                            {v1.3 clean up screen}
  632.  
  633.     CLOSE (InFile);
  634.     CLOSE (OutFile);
  635.   END;  {of Convert}
  636.  
  637.  
  638. BEGIN  {main}
  639.  
  640.   Get_Args;                             {process cmdline args
  641.                                          (may die)}
  642.   Uc_The_Array;                         {v1.1 build an array of uppercased
  643.                                          reserved word lines}
  644.  
  645. {Now we go into our file loop.
  646.  We continue until FindNext returns no more files.
  647.  Get_Args set argv appropriately.
  648. }
  649.  
  650.   SrchRec.Name := '';                   {clear for first file}
  651.  
  652.   WHILE (SrchRec.Name <> '')            {we're working a wildcard}
  653.   OR (argv < argc)                      {no wildcard, but still got args}
  654.   DO BEGIN
  655.  
  656.     Open_Files;                         {open InFile,OutFile}
  657.  
  658.     IF Ok THEN Convert;                 {files open, do the conversion}
  659.  
  660.   END;  {until all done}
  661.  
  662. END.
  663.