home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / U.ZIP / U.PAS
Encoding:
Pascal/Delphi Source File  |  1986-03-24  |  7.0 KB  |  199 lines
  1. PROGRAM PasCaps2;
  2.  
  3. {  This program converts the lower case Pascal identifiers in a source       }
  4. {  code file to upper case.                                                  }
  5. {  Jeff Firestone.  June, 1984.                                              }
  6.  
  7. {  Included Turbo Pascal version 2 additions to identifier table. Also added  }
  8. {  "IBM Goodies" (ie. Sound, Color, Windows, etc.). Also added I/O error      }
  9. {  handling if file not found. Other minor changes.                           }
  10. {  - Loren Cook  12/29/84                                                     }
  11.  
  12.  
  13. CONST
  14.   Idents1 = ' ABSOLUTE ADDR AND ARCTAN ARRAY ASSIGN AUX AUXIN AUXINPTR AUXOUT AUXOUTPTR ';
  15.   Idents2 = ' BEGIN BLOCKREAD BLOCKWRITE BOOLEAN BUFLEN BYTE CASE CHAIN CHAR CHR CLOSE ';
  16.   Idents3 = ' CLREOL CLRSCR CON CONCAT CONIN CONINPTR CONOUT CONST CONST CONSTPTR COPY ';
  17.   Idents4 = ' COS CRTEXIT CRTINIT CSEG DELAY DELETE DELLINE DISPOSE DIV DO DOWNTO DRAW ';
  18.   Idents5 = ' DSEG ELSE END EOF EOLN ERASE EXECUTE EXP EXTERNAL FALSE FILE FILEPOS ';
  19.   Idents6 = ' FILESIZE FILLCHAR FLUSH FOR FORWARD FRAC FREEMEM FUNCTION GETMEM GOTO ';
  20.   Idents7 = ' GOTOXY GRAPHBACKGROUND GRAPHCOLORMODE GRAPHMODE GRAPHWINDOW HALT HEAPPTR HI ';
  21.   Idents8 = ' HIGHVIDEO HIRES HIRESCOLOR FIN INLINE INPUT INSERT INSLINE INT INTEGER ';
  22.   Idents9 = ' INTR IORESULT KBD KEYPRESSED LABEL LENGTH LN LO LONGFILEPOS LONGFILESIZE ';
  23.   Idents10= ' LONGSEEK LST LSTOUT LSTOUTPTR MARK MAXAVAIL MAXINT MEM MEMAVAIL MEMW MOD ';
  24.   Idents11= ' MOVE MSDOS NEW NIL NORMVIDEO NOSOUND NOT ODD OF OFS OR ORD OUTPUT OVERLAY ';
  25.   Idents12= ' PACKED PALETTE PI PLOT PORT PORTW POS PRED PROCEDURE PROGRAM PTR RANDOM ';
  26.   Idents13= ' RANDOMIZE READ READLN REAL RECORD RELEASE RENAME REPEAT RESET REWRITE ';
  27.   Idents14 =' ROUND SEEK SEG SET SHL SHR SIN SIZEOF SOUND SQR SQRT SSEG STR STRING ';
  28.   Idents15 =' SUCC SWAP TEXT TEXTBACKGROUND TEXTCOLOR TEXTMODE THEN TO TRM TRUE TRUNC ';
  29.   Idents16 =' TYPE UNTIL UPCASE USR USRIN USRINPTR USROUT USROUTPTR VAL VAR WHEREX ';
  30.   Idents17 =' WHEREY WHILE WINDOW WITH WRITE WRITELN XOR ';
  31.   OpenBracket  = '{';
  32.   CloseBracket = '}';
  33.   OpenParen    = '(';
  34.   CloseParen   = ')';
  35.   Null         = '';
  36.  
  37. TYPE
  38.   Caps = SET OF 'A'..'Z';
  39.   Nums = SET OF '0'..'9';
  40.   Strng = STRING[255];
  41.  
  42. VAR
  43.   pntr, LineNum : INTEGER;
  44.   ProgLine, Name : STRING[255];
  45.   Word : STRING[100];
  46.   f1, f2 : TEXT;
  47.   Identifier: SET OF CHAR;
  48.  
  49.  
  50. PROCEDURE UpShift(VAR S: Strng);
  51. BEGIN
  52.   INLINE
  53.          ($C4/$BE/S/         {      LES   DI,S[BP]             }
  54.           $26/$8A/$0D/       {      MOV   CL,ES:[DI]           }
  55.           $FE/$C1/           {      INC   CL                   }
  56.           $FE/$C9/           { L1:  DEC   CL                   }
  57.           $74/$13/           {      JZ    L2                   }
  58.           $47/               {      INC   DI                   }
  59.           $26/$80/$3D/$61/   {      CMP   ES:BYTE PRT [DI],'a' }
  60.           $72/$F5/           {      JB    L1                   }
  61.           $26/$80/$3D/$7A/   {      CMP   ES:BYTE PTR [DI],'z' }
  62.           $77/$EF/           {      JA    L1                   }
  63.           $26/$80/$2D/$20/   {      SUB   ES:BYTE PRT [DI],20H }
  64.           $EB/$E9            {      JMP   SHORT L1             }
  65.                              { L2:                             });
  66. END;
  67.  
  68.  
  69. PROCEDURE Greeting;
  70. BEGIN
  71.   GOTOXY(23,1);
  72.   WRITELN('CAPITALIZE PASCAL IDENTIFIERS');
  73.   GOTOXY(27,2);WRITELN('version 2 - 12/29/84');WRITELN;
  74.   WRITELN('This program reads a Pascal source file and capitalizes all the identifiers');
  75.   WRITELN('in that file.  The results are output to a file the users specifies.');
  76.   WRITELN;
  77.   WRITELN('The output file tends to be easier to read than one in which a hodge-podge');
  78.   WRITELN('of capitalized and lower case identifiers co-reside.  It is the prefered');
  79.   WRITELN('format for Pascal source code.');
  80.   WRITELN;
  81.   WRITELN('With this utility, you can type all your source code in lower case and then');
  82.   WRITELN('convert it to standard format later.  This manner of writing Pascal saves you');
  83.   WRITELN('considerable time and bother.');
  84.   WRITELN; WRITELN; WRITELN;
  85. END;
  86.  
  87.  
  88. PROCEDURE OpenFiles;
  89. BEGIN
  90.   WRITE('What is the name of the source code file (RETURN to end) : ');
  91.   READLN(name);
  92.   IF (POS('.', name) = 0) THEN name:= name + '.pas';
  93.   ASSIGN(f1, name);
  94.   {$I-} RESET(f1) {$I+};
  95.   IF IORESULT <> 0 THEN BEGIN
  96.      WRITELN; GOTOXY(25,20);
  97.      WRITELN('File ',name,' not found.');
  98.      HALT;
  99.   END;
  100.   WRITE('Where do you want to output to be sent (RETURN for Screen) : ');
  101.   READLN(name); UpShift(Name);
  102.   IF LENGTH(name) = 0 THEN name:= 'CON:';
  103.   ASSIGN(f2, name);
  104.   REWRITE(f2);
  105.   WRITELN; WRITELN('Capitalizing...'); WRITELN;
  106. END;
  107.  
  108.  
  109. PROCEDURE GetWord;
  110. VAR
  111.   TmpWord,TmpWrd : STRING[255];
  112.   GotIdent : INTEGER;
  113. BEGIN
  114.   Word:= '';
  115.   WHILE (UPCASE(ProgLine[pntr]) IN Identifier) AND
  116.         (pntr <= LENGTH(ProgLine)) DO
  117.              BEGIN
  118.                Word:= Word + ProgLine[pntr];
  119.                pntr:= pntr + 1;
  120.              END;
  121.  
  122.   TmpWrd:= Word; UpShift(TmpWrd);
  123.   TmpWord:= ' ' + TmpWrd + ' ';
  124.   GotIdent:= POS(TmpWord, Idents1) + POS(TmpWord, Idents2) +
  125.              POS(TmpWord, Idents3) + POS(TmpWord, Idents4) +
  126.              POS(TmpWord, Idents5) + POS(TmpWord, Idents6) +
  127.              POS(TmpWord, Idents7) + POS(TmpWord, Idents8) +
  128.              POS(TmpWord, Idents9) + POS(TmpWord, Idents10) +
  129.              POS(TmpWord, Idents11) + POS(TmpWord, Idents12) +
  130.              POS(TmpWord, Idents13) + POS(TmpWord, Idents14) +
  131.              POS(TmpWord, Idents15) + POS(TmpWord, Idents16) +
  132.              POS(TmpWord, Idents17);
  133.   IF GotIdent > 0 THEN
  134.      WRITE(f2, TmpWrd)
  135.   ELSE
  136.      WRITE(f2, Word);
  137. END;
  138.  
  139.  
  140. PROCEDURE ScanTill(SearchChar: CHAR);
  141. BEGIN
  142.   REPEAT
  143.     WRITE(f2, ProgLine[pntr]);
  144.     pntr:= pntr + 1;
  145.     IF pntr > LENGTH(ProgLine) THEN
  146.     BEGIN
  147.       WRITELN(f2);
  148.       READLN(f1, ProgLine);
  149.       pntr:= 1;
  150.     END;
  151.   UNTIL (ProgLine[pntr] = SearchChar) OR EOF(f1);
  152.   WRITE(f2, ProgLine[pntr]);
  153.   pntr:= pntr + 1;
  154. END;
  155.  
  156.  
  157. PROCEDURE Convert;
  158. BEGIN
  159.   LineNum:= 0;
  160.   WHILE NOT EOF(f1) DO
  161.   BEGIN
  162.     pntr:= 1;
  163.     READLN(f1, ProgLine);
  164.     IF LENGTH(ProgLine) > 0 THEN
  165.     BEGIN
  166.     REPEAT
  167.       CASE UPCASE(ProgLine[pntr]) OF
  168.         'A'..'Z', '0'..'9', '_'  :  GetWord;
  169.         OpenBracket              :  ScanTill(CloseBracket);
  170.         ELSE
  171.           IF ProgLine[pntr] = CHR(39) THEN
  172.             ScanTill(CHR(39))
  173.           ELSE
  174.           BEGIN
  175.             WRITE(f2, ProgLine[pntr]);
  176.             pntr:= pntr + 1;
  177.           END;
  178.       END;  {  Case UpCase  }
  179.     UNTIL (pntr > LENGTH(ProgLine));
  180.     WRITELN(f2);
  181.     IF Name <> 'CON:' THEN
  182.       BEGIN
  183.         GOTOXY(4, 21);
  184.         WRITE(LineNum);
  185.         LineNum:= LineNum + 1;
  186.       END
  187.     END;
  188.     IF LENGTH(ProgLine) = 0 THEN WRITELN(f2);
  189.   END;  { WHILE }
  190.   CLOSE(f1); CLOSE(f2);
  191. END;
  192.  
  193. BEGIN
  194.   Identifier:= ['A'..'Z', '0'..'9', '_'];
  195.   Greeting;
  196.   OpenFiles;
  197.   Convert;
  198. END.
  199.