DataMuseum.dk

top - download

    Length: 6656 (0x1a00)
    Types: TextFile
    Names: »INDEXER.PAS«

└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
    └─ ⟦this⟧ »INDEXER.PAS« 

TextFile

PROGRAM INDEXIT;
æ-------------------------------------------------------å
æPurpose  : Find procedure and function declarations andå
æ           output them in alphabetical order to a file å
æInputs   : File to be indexed.                         å
æOutputs  : File of procedures and functions            å
æCREATED  : Jan 31, 1981 NJL                            å 
æ-------------------------------------------------------å

CONST
  CPMLINESZ = 127;

TYPE
  STRNG=STRINGÆ20Å;
  FILENAME = STRINGÆ127Å;
  RWFILE = (RESETT,REWRITTE);
  FYLE = FILE;
  SUM_TYPE = (SHORT,LONG);
VAR
  FIN : TEXT;
  FOUT : TEXT;
  NAME : FILENAME;
  STR : STRING;
  I : INTEGER;
  CPMCMDBUF : ABSOLUTEÆ$80Å PACKED ARRAY Æ0..CPMLINESZÅ OF CHAR;
  CPMSTR : STRINGÆCPMLINESZÅ;
  PROGFLG : BOOLEAN;
  SUMMARY : SUM_TYPE;

EXTERNAL FUNCTION KEYPRESSED:BOOLEAN;
EXTERNAL PROCEDURE @HLT;

PROCEDURE ABORT;
BEGIN
  WRITELN;
  WRITELN('Pascal/MT+ Program Index utility aborted from console');
  @HLT
END;


FUNCTION DOFILE(VAR F : TEXT;RW : RWFILE; NAME : FILENAME) : BOOLEAN;
æ---------------------------------------------------------------å
æ Purpose: Attempt to reset or rewrite the given file. Check    å
æ          IORESULT.                                            å
æ Inputs:  File,whether to reset or rewrite, and name of file.  å
æ Outputs: File open for reading or writing. True if successful,å
æ          false if not successful.                             å
æ Last Mod:                                                     å
æ---------------------------------------------------------------å
BEGIN
  ASSIGN(F,NAME);
  IF RW = RESETT THEN
    RESET(F)
  ELSE
    REWRITE(F);
  IF IORESULT = 255 THEN
    DOFILE := FALSE
  ELSE
    DOFILE := TRUE;
END;

PROCEDURE GETNAME(VAR OUTSTR : FILENAME);
æ---------------------------------------------------------------å
æ Purpose: Read a name from the keyboard, return in STR.        å
æ Inputs:  CPMCMDBUF.                                           å
æ Outputs: STR contains name of file if it was given to start.  å
æ Last Mod: 11/23/80                                            å
æ---------------------------------------------------------------å
BEGIN
  OUTSTR := '';
  WHILE (LENGTH(STR) <> 0) AND (STRÆ1Å <> ' ') DO
    BEGIN
      OUTSTR := CONCAT(OUTSTR,STRÆ1Å);
      DELETE(STR,1,1)
    END;
  IF LENGTH(STR) <> 0 THEN
    DELETE(STR,1,1);            (* DELETE NEXT BLANK *)
END;


FUNCTION STRIPBLNKS(S : STRING):INTEGER;
VAR
  I : INTEGER;
BEGIN
  STRIPBLNKS := 0;
  I := 1;
  WHILE (SÆIÅ = ' ') AND (I <= LENGTH(S)) DO
    I := I + 1;
  IF I > LENGTH(S) THEN
    STRIPBLNKS := 0
  ELSE
    STRIPBLNKS := I;
END;

FUNCTION PRESENT(KEYWORD,STR : STRING):BOOLEAN; 
æ---------------------------------------------------------------å
æ Purpose: Return true if the string KEYWORD                    å
æ          the first string on the input line STR.  If it is    å
æ          not first or is  not present return false.           å
æ Inputs:  KEYWORD,STR.                                         å
æ Outputs: Function return value of true or false.             nå
æ Last Mod: 11/23/80                                            å
æ---------------------------------------------------------------å
VAR 
  FIRSTCH : INTEGER;
BEGIN
  FIRSTCH :=  STRIPBLNKS(STR);
  IF FIRSTCH <> 0 THEN
    BEGIN
      IF POS(KEYWORD,STR) = FIRSTCH THEN
        PRESENT := TRUE
      ELSE
        PRESENT := FALSE
    END
  ELSE
    PRESENT := FALSE;
END;


PROCEDURE TRANSFER(VAR STR : STRING);
æ---------------------------------------------------------------å
æ Purpose: Transfer lines from FIN to FOUT until the next proc/ å
æ          func or begin is encountered.                        å
æ Inputs:  STR contains the line with the PROC, FUNC or PROG defå
æ          FIN provides the text.                               å
æ Outputs: STR contains the line containing a PROC, FUNC def or å
æ          a begin. FOUT contains new text.                     å
æ Last Mod: 11/23/80                                            å
æ---------------------------------------------------------------å
VAR SHORTSTR : STRINGÆ25Å;
    DONE : BOOLEAN;
    TSTRING : STRING;
BEGIN
  DONE := FALSE;
  TSTRING := STR;
  WRITELN(FOUT,TSTRING);
  IF SUMMARY = LONG THEN
  REPEAT
    READLN(FIN,TSTRING);
    WRITE('.');
    IF KEYPRESSED THEN
      ABORT;
    SHORTSTR := TSTRING;
    IF (PRESENT('BEGIN',SHORTSTR)) THEN
         DONE := TRUE
    ELSE
      BEGIN
        IF (PRESENT('FUNCTION',SHORTSTR)) OR
         (PRESENT('PROCEDURE',SHORTSTR)) THEN
          BEGIN
            WRITELN(FOUT);
            WRITELN(FOUT);
          END;
        WRITELN(FOUT,TSTRING) 
      END
  UNTIL ( EOF(FIN)) OR (DONE);

  IF SUMMARY = SHORT THEN
    BEGIN
      READLN(FIN,TSTRING);
      WRITE('.')
    END;

  IF KEYPRESSED THEN
    ABORT;
  STR := TSTRING;  
  WRITELN(FOUT);
  WRITELN(FOUT);
END;


PROCEDURE DOINDEX;
VAR
  I : INTEGER;
  STR : STRING;
BEGIN
  WHILE NOT EOF(FIN) DO
    BEGIN
      IF PRESENT('PROCEDURE',STR) THEN
          TRANSFER(STR)
      ELSE
        IF PRESENT('FUNCTION',STR) THEN
            TRANSFER(STR);
      READLN(FIN,STR);
      WRITE('.');
      IF KEYPRESSED THEN
        ABORT;
    END;
END;

        
  

BEGIN
  MOVE(CPMCMDBUF,STR,CPMLINESZ + 1); (* COPY COMMAND TAIL *)
  IF LENGTH(STR) <> 0 THEN
    DELETE(STR,1,1);                 (* STRIP CP/M'S LEADING BLANK *)

  WRITELN('Pascal/MT+ Program Index Utility -- Release 5.2');
  WRITELN('Copyright (c) 1981 by MT MicroSYSTEMS');
  WRITELN;

  GETNAME(NAME);
  WRITELN('Reading text from:  ',NAME);
  IF DOFILE(FIN,RESETT,NAME) THEN
    BEGIN
      GETNAME(NAME);
      WRITELN('Output directed to: ',NAME);
      IF DOFILE(FOUT,REWRITTE,NAME) THEN
      BEGIN
        GETNAME(NAME);
        WRITELN('Summary form:       ',NAME);
        IF NAMEÆ1Å IN Æ'L','l'Å THEN
          SUMMARY := LONG
        ELSE
          SUMMARY := SHORT;
        READLN(FIN,STR);
        WRITE('.');
        TRANSFER(STR);
        DOINDEX;
        CLOSE(FOUT,I);
        WRITELN('Pascal/MT+ Program Index utility processing complete');
      END
      ELSE
        WRITELN('Cannot create ',NAME)
    END
  ELSE
    WRITELN('Cannot open ',NAME);
END.
«eof»