CP/M/CPM_CDROM.iso/simtel/sigm/vols000/vol021/entry.pas

Pascal/Delphi Source File | 1984-04-29 | 5.3 KB | 200 lines

PROGRAM CREATE_ENTRY_FOR_EXTERNALDECLARATIONS;
{                            by
                      Robert H. Harsch
                     ph: [phone]
             2362 American River Dr, Suite 311
                   Sacramento, Ca. 95825.
                    All rights reserved.        }

{ only the first 6 characters are significant }

CONST    $ENTRY_KEY='{@';  { string we look for to pick up entry
            name and insert into file name.ZZZ }

    $MAIN_PROGRAM_BEGIN='L99'; { string to look for to stop
            program.  Nothing is copied beyond
            this point to file name.ZZZ }

TYPE
    $STRING0= STRING 0;
    $STRING32= STRING 80;
    $STRING255= STRING 255;
    BYTE= 0..255;

    SYM_LINK= ^SYM_TYPE; { symbol (entry points) linked }
    SYM_TYPE= RECORD
            $SYM: $STRING32;
            PTR: SYM_LINK
        END;

VAR
    INFILE,OUTFILE: TEXT;
    $SYMBOL, $LINE: $STRING255;
    $CH, $TAB: CHAR;
    K,I: INTEGER;
    LOWERCASE, IDSTART, IDENTIFIER: SET OF CHAR;
    PROGRAM_DONE, BADCHAR, PREV_DEFN, FOUND_ENTRY: BOOLEAN;
    SYM_DEFN_ROOT: SYM_LINK;
    UPPERCASE: ARRAY['a'..'z'] OF 'A'..'Z';


FUNCTION LENGTH(X: $STRING255): INTEGER; EXTERNAL;
FUNCTION INDEX(X,Y: $STRING255): INTEGER; EXTERNAL;
PROCEDURE SETLENGTH(VAR X: $STRING0; Y: INTEGER); EXTERNAL;



PROCEDURE GET_FILE_NAME_FROM_COMMAND_LINE(VAR $INF: $STRING32);
VAR    I: INTEGER;

FUNCTION PEEK(ADDR: INTEGER): BYTE;
    TYPE    CONTENTS= PACKED RECORD
                BYT: BYTE { byte in memory }
            END; { of record }
        FORM=(INTEGR,ADDRESS);
        REFERENCE= RECORD
            CASE FORM OF
                INTEGR:  (I: INTEGER);
                ADDRESS: (P: ^CONTENTS)
            END;

    VAR    TEMP: REFERENCE;

    BEGIN { of function peek }
        TEMP.I:= ADDR;
        PEEK:= TEMP.P^.BYT
    END; { of function peek }

    BEGIN { of procedure GET_FILE_NAME_FROM_COMMAND_LINE }
    SETLENGTH($INF,0);
    FOR I:= 129 TO 128 + PEEK(128) DO
            APPEND( $INF, CHR(PEEK(I)) )
    END; { of procedure GET_FILE_NAME_FROM_COMMAND_LINE }



PROCEDURE OPENFILES;
CONST    $M1= 'Input file (without entry points): ';
    $M2= 'Output file (with entry points): ';
VAR    $FILENAME, $NAME_EXT: $STRING32;
    $CR : CHAR; { carriage return }
    BEGIN
        $CR:= CHR(13); { carriage return }
        GET_FILE_NAME_FROM_COMMAND_LINE($FILENAME);
        $NAME_EXT:= $FILENAME;
        APPEND($NAME_EXT, '.SRC');
        APPEND($NAME_EXT,$CR);    { see note #3 of
                hot news, filenames passed to
                rewrite or reset must be
                deleted with a carriage return}
        RESET($NAME_EXT, INFILE);
        WRITELN($M1, $NAME_EXT);
        $NAME_EXT:= $FILENAME;
        APPEND($NAME_EXT, '.ZZZ');
        APPEND($NAME_EXT,$CR);    { see note #3 of
                hot news, filenames passed to
                rewrite or reset must be
                deleted with a carriage return}
        REWRITE($NAME_EXT, OUTFILE);
        WRITELN($M2, $NAME_EXT);
    END; { of procedure openfiles }



PROCEDURE WRITEOUT(VAR $SYMBOL: $STRING32;
            PREV_DEFN, BADCHAR: BOOLEAN);
CONST    $MSG1= 'Error, symbol previously defined';
    $MSG2= 'Error, "#" or "_" character in symbol defined';
VAR    $TAB: CHAR;
    SYM_NODE: SYM_LINK;
    BEGIN
        $TAB:= CHR(9);
        WRITELN(OUTFILE,$TAB,'ENTRY',$TAB, $SYMBOL);
        WRITELN(OUTFILE,$SYMBOL,':');

        { write info to screen }
        WRITELN;
        WRITELN('Entry symbol found:');
        WRITELN($TAB,'ENTRY',$TAB, $SYMBOL);
        WRITELN($SYMBOL,':');
        IF PREV_DEFN THEN
            WRITELN($MSG1);
        IF BADCHAR THEN
            WRITELN($MSG2);

        { insert new symbol into link list }
        NEW(SYM_NODE);
        SYM_NODE^.$SYM:= $SYMBOL;
        SYM_NODE^.PTR:= SYM_DEFN_ROOT;
        SYM_DEFN_ROOT:= SYM_NODE;
    END; { of procedure writeout }



PROCEDURE WAS_$SYMBOL_PREVIOUSLY_DEFN(
        VAR $SYMBOL: $STRING32;
        VAR PREV_DEFN: BOOLEAN);
VAR    SYM_NODE: SYM_LINK;
    BEGIN
        SYM_NODE:= SYM_DEFN_ROOT;
        PREV_DEFN:= FALSE;
        WHILE (SYM_NODE <> NIL) AND NOT PREV_DEFN DO
            WITH SYM_NODE^ DO
                IF $SYM = $SYMBOL
                    THEN PREV_DEFN:= TRUE
                    ELSE SYM_NODE:= PTR;
    END; { of procedure WAS_$SYMBOL_PREVIOUSLY_DEFN }


BEGIN { of main program }
WRITELN;
WRITELN('Program for automatic insertion of entry points.');
WRITELN('By Robert Harsch.');
WRITELN;
WRITELN('WORKING.');

{ initialize global variables }
SYM_DEFN_ROOT:= NIL;
FOR $CH:='a' TO 'z' DO
    UPPERCASE[$CH]:= CHR(ORD('A') + (ORD($CH) - ORD('a')));
LOWERCASE:= ['a'..'z'];  { We will convert lower case
        characters to upper case like the assembler. }
{ set of "IDentifier START" and "IDentifier" characters }
IDSTART:= ['A'..'Z'] + LOWERCASE + ['$', '%', '.'] + ['#','_'];
IDENTIFIER:= IDSTART + ['0'..'9'];

OPENFILES;
REPEAT
    SETLENGTH($LINE,0);
    READLN(INFILE,$LINE);
    WRITELN(OUTFILE,$LINE);
    APPEND($LINE, ' ');     { sentinel }
    I:= INDEX ($LINE, $ENTRY_KEY);
    K:= I + LENGTH ( $ENTRY_KEY );
    FOUND_ENTRY:= (I > 0) AND ( $LINE[K] IN IDSTART );
    IF FOUND_ENTRY THEN
        BEGIN
        SETLENGTH($SYMBOL,0);

        { pick up first 6 significant chars, and
        convert lower to upper case, store in $SYMBOL }
        I:= K; BADCHAR:= FALSE;
        REPEAT
            IF $LINE[I] IN LOWERCASE THEN
                $LINE[I]:= UPPERCASE[$LINE[I]];
            IF $LINE[I] IN ['#','_'] THEN
                BADCHAR:= TRUE;
            APPEND($SYMBOL,$LINE[I]);
            I:= I + 1
        UNTIL NOT ($LINE[I] IN IDENTIFIER) OR (I-K =6);

        WAS_$SYMBOL_PREVIOUSLY_DEFN($SYMBOL,PREV_DEFN);
        WRITEOUT($SYMBOL,PREV_DEFN,BADCHAR);
        END;
    PROGRAM_DONE:= (INDEX($LINE, $MAIN_PROGRAM_BEGIN) = 1)
                AND
             NOT ($LINE[4] IN IDENTIFIER);
UNTIL PROGRAM_DONE;
WRITELN('PROGRAM IS DONE.');

END.