Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/TURBO9.ZIP/PASCAPS.PAS

Pascal/Delphi Source File | 1984-07-10 | 5.9 KB | 181 lines

PROGRAM PasCaps;

{  This program converts the lower case Pascal identifiers in a source  }
{  code file to upper case.                                             }
{  Jeff Firestone.  June, 1984.                                         }

CONST
  Idents1 = ' ARCTAN ASSIGN AUX AUXINPTR AUXOUTPTR BLOCKREAD BLOCKWRITE BOOLEAN ';
  Idents2 = ' BUFLEN BYTE CHAIN CHAR CHR CLOSE CLREOL CLRSCR CON CONINPTR ';
  Idents3 = ' CONCAT CONSTPTR COPY COS CRTEXIT CRTINIT DELLINE DELAY DELETE ';
  Idents4 = ' EOF EOLN ERASE EXECUTE EXP FALSE FILEPOS FILESIZE FILLCHAR FLUSH ';
  Idents5 = ' FRAC GETMEM GOTOXY HEAPPTR HI HIGHVIDEO IORESULT INPUT INSLINE INSERT ';
  Idents6 = ' INT INTEGER KBD KEYPRESSED LENGTH LN LO LST LSTOUTPTR MARK MAXINT MEM ';
  Idents7 = ' MEMAVAIL MOVE NEW NORMVIDEO ODD ORD OUTPUT PI PORT POS PRED PTR RANDOM ';
  Idents8 = ' RANDOMIZE READ READLN REAL RELEASE RENAME RESET REWRITE ROUND SEEK SIN ';
  Idents9 = ' SIZEOF SQR SQRT STR SUCC SWAP TEXT TRM TRUE TRUNC UPCASE USR USRINPTR ';
  Idents10= ' USROUTPTR VAL WRITE WRITELN ABSOLUTE AND ARRAY BEGIN CASE CONST DIV ';
  Idents11= ' DO DOWNTO ELSE END EXTERNAL FILE FOR FORWARD FUNCTION GOTO IF IN ';
  Idents12= ' INLINE LABEL MOD NIL NOT OF OR PACKED PROCEDURE PROGRAM RECORD REPEAT ';
  Idents13= ' SET SHL SHR STRING THEN TO TYPE UNTIL VAR WHILE WITH XOR OFS SEG MEM MEMW';
  OpenBracket  = '{';
  CloseBracket = '}';
  OpenParen    = '(';
  CloseParen   = ')';
  Null         = '';
TYPE
  Caps = Set of 'A'..'Z';
  Nums = Set of '0'..'9';
  Strng = STRING[255];
VAR
  pntr, LineNum : INTEGER;
  ProgLine, Name : STRING[255];
  Word : STRING[100];
  f1, f2 : TEXT;
  Identifier: SET OF CHAR;


PROCEDURE UpShift(VAR S: Strng);
BEGIN
  INLINE
         ($C4/$BE/S/         {     LES   DI,S[BP]     }
          $26/$8A/$0D/       {     MOV   CL,ES:[DI]   }
          $FE/$C1/           {     INC   CL           }
          $FE/$C9/           {L1:  DEC   CL           }
          $74/$13/           {     JZ    L2           }
          $47/               {     INC   DI           }
          $26/$80/$3D/$61/   {     CMP   ES:BYTE PRT [DI],'a'}
          $72/$F5/           {     JB    L1           }
          $26/$80/$3D/$7A/   {     CMP   ES:BYTE PTR [DI],'z'}
          $77/$EF/           {     JA    L1           }
          $26/$80/$2D/$20/   {     SUB   ES:BYTE PRT [DI],20H}
          $EB/$E9            {     JMP   SHORT L1     }
                             {L2:                     });
END;


PROCEDURE Greeting;
BEGIN
  GOTOXY(23,1);
  WRITELN('CAPITALIZE PASCAL IDENTIFIERS');
  WRITELN;WRITELN;
  WRITELN('This program reads a Pascal source file and capitalizes all the identifiers');
  WRITELN('in that file.  The results are output to a file the users specifies.');
  WRITELN;
  WRITELN('The output file tends to be easier to read than one in which a hodge-podge');
  WRITELN('of capitalized and lower case identifiers co-reside.  It is the prefered');
  WRITELN('format for Pascal source code.');
  WRITELN;
  WRITELN('With this utility, you can type all your source code in lower case and then');
  WRITELN('convert it to standard format later.  This manner of writing Pascal saves you');
  WRITELN('considerable time and bother.');
  WRITELN; WRITELN; WRITELN;
END;


PROCEDURE OpenFiles;
BEGIN
  WRITE('What is the name of the source code file (RETURN to end) : ');
  READLN(name);
  IF LENGTH(name) = 0 THEN halt;
  IF (POS('.', name) = 0) THEN name:= name + '.pas';
  ASSIGN(f1, name);
  RESET(f1);
  WRITE('Where do you want to output to be sent (RETURN for Screen) : ');
  READLN(name); UpShift(Name);
  IF LENGTH(name) = 0 THEN name:= 'CON:';
  ASSIGN(f2, name);
  REWRITE(f2);
  WRITELN; WRITE('Capitalizing...');
END;


PROCEDURE GetWord;
VAR
  TmpWord,TmpWrd : STRING[255];
  GotIdent : INTEGER;
BEGIN
  Word:= '';
  WHILE (UPCASE(ProgLine[pntr]) IN Identifier) AND
        (pntr <= LENGTH(ProgLine)) DO
             BEGIN
               Word:= Word + ProgLine[pntr];
               pntr:= pntr + 1;
             END;

  TmpWrd:= Word; UpShift(TmpWrd);
  TmpWord:= ' ' + TmpWrd + ' ';
  GotIdent:= POS(TmpWord, Idents1) + POS(TmpWord, Idents2) +
             POS(TmpWord, Idents3) + POS(TmpWord, Idents4) +
             POS(TmpWord, Idents5) + POS(TmpWord, Idents6) +
             POS(TmpWord, Idents7) + POS(TmpWord, Idents8) +
             POS(TmpWord, Idents9) + POS(TmpWord, Idents10) +
             POS(TmpWord, Idents11) + POS(TmpWord, Idents12) +
             POS(TmpWord, Idents13);
  IF GotIdent > 0 THEN
     WRITE(f2, TmpWrd)
  ELSE
     WRITE(f2, Word);
END;


PROCEDURE ScanTill(SearchChar: CHAR);
BEGIN
  REPEAT
    WRITE(f2, ProgLine[pntr]);
    pntr:= pntr + 1;
    IF pntr > LENGTH(ProgLine) THEN
    BEGIN
      WRITELN(f2);
      READLN(f1, ProgLine);
      pntr:= 1;
    END;
  UNTIL (ProgLine[pntr] = SearchChar) OR EOF(f1);
  WRITE(f2, ProgLine[pntr]);
  pntr:= pntr + 1;
END;


PROCEDURE Convert;
BEGIN
  LineNum:= 0;
  WHILE NOT EOF(f1) DO
  BEGIN
    pntr:= 1;
    READLN(f1, ProgLine);
    IF LENGTH(ProgLine) > 0 THEN
    BEGIN
    REPEAT
      CASE UPCASE(ProgLine[pntr]) OF
        'A'..'Z', '0'..'9', '_'  :  GetWord;
        OpenBracket              :  ScanTill(CloseBracket);
        ELSE
          IF ProgLine[pntr] = CHR(39) THEN
            ScanTill(CHR(39))
          ELSE
          BEGIN
            WRITE(f2, ProgLine[pntr]);
            pntr:= pntr + 1;
          END;
      END;  {  Case UpCase  }
    UNTIL (pntr > LENGTH(ProgLine));
    WRITELN(f2);
    IF Name <> 'CON:' THEN
      BEGIN
        gotoXY(4, 21);
        WRITE(LineNum);
        LineNum:= LineNum + 1;
      END
    END;
    IF LENGTH(ProgLine) = 0 THEN WRITELN(f2);
  END;  { WHILE }
  CLOSE(f1); CLOSE(f2);
END;

BEGIN
  Identifier:= ['A'..'Z', '0'..'9', '_'];
  Greeting;
  OpenFiles;
  Convert;
END.