{$U-,C-,I-}
PROGRAM CONVERT;


{------------------------------------------------------------------------------

    WARNING  WARNING  WARNING  WARNING  WARNING  WARNING  WARNING  WARNING

      THIS PROGRAM HAS BEEN TESTED ON MANY DIFFERENT FORMS OF PROCEDURES
  AND FUNCTIONS, BUT MAY NOT WORK ON THE PARTICULAR ONE YOU HAVE CREATED.  IF
  YOUR PROCEDURE DOES NOT WORK MAKE SURE THAT THERE ARE NO NESTED PROCEDURES
  AND THAT THERE IS ENOUGH MEMORY TO LOAD THE FULL PROCEDURE IN.

  SPECIFICALLY FOR VERSION 2.00B OF THE GENERIC MS-DOS OR IBM PC-DOS
  IMPLEMENTATIONS TURBO PASCAL.  IT WOULD BE EASY TO CONVERT THIS FOR OTHER
  VERSIONS OF THOSE SAME IMPLEMENTATIONS.  SEE CONSIDERATION #4 BELOW.  IF
  ANYONE WANTS TO CONVERT THIS FOR THE CP/M 86 IMPLEMENTATION, YOU ARE WELCOME
  TO DO SO AND UPLOAD IT HERE.

 ------------------------------------------------------------------------------


      CONVERT IS USED TO CHANGE PRECOMPILED CHAIN FILES INTO A FORMAT THAT IS
 CALLABLE BY A TURBO PROGRAM AS AN EXTERNAL .COM FILE.  THERE IS A LOADER
 ( LOADER.INC ) THAT MUST BE INCLUDED IE.  $I LOADER.INC  BY THE PROGRAM THAT
 IS TO USE THE .COM FILES CREATED BY CONVERT.


      THERE ARE JUST A FEW CONSIDERATIONS AND PRECAUTIONS THAT MUST BE TAKEN
 FOR THE EXTERNAL CREATED BY CONVERT TO WORK PROPERLY :

   1 : THE FILES TO BE CONVERTED MUST BE CHAIN FILES.
   2 : THE PROCEDURE SHOULD HAVE A DUMMY BEGIN END. TO BE COMPILED. DO
       NOT PUT ANYTHING INSIDE THE BEGIN END. OF THE EXTERNAL PROCEDURE.
   3 : EACH PROCEDURE OR FUNCTION CANNOT HAVE NESTED PROCEDURES OR FUNCTIONS
       INSIDE OF IT.
      013D
   4 : THE PROGRAM CONVERT MUST HAVE THE CONST LIBRARYSIZE SET TO THE ENDING
       OF THE TURBO RUN-TIME LIBRARY ( $2828 FOR THE PC 2.00B, $2565 FOR
       THE GENERIC MS-DOS IMPLEMENTATION OF TURBO PASCAL VERSION 2.00B ).
   5 : EACH PROGRAM THAT USES THE LOADER AND AN EXTERNAL PROCEDURE CANNOT
       BE RUN TWICE WITHIN TURBO,  UNLESS A RECOMPILATION OCCURS.

 FOR AN EXAMPLE OF AN EXTERNAL AND A CALLING PROGRAM READ THE FILE CONVRT.DOC.

                                                     WRITTEN BY
                                                     JIM MCCARTHY
                                                     TECHNICAL SUPPORT
                                                     BORLAND INTERNATIONAL

------------------------------------------------------------------------------}

  CONST
    LIBRARYSIZE = $2954;               { SIZE OF RUN-TIME LIBRARY }
    PROCSTART   = $296A;               { LIBRARYSIZE + $16 }

  TYPE
    STR3  = STRING[ 3 ];
    STR80 = STRING[ 80 ];
    CHARARR15 = ARRAY [ 0..15 ] OF CHAR;
    PTR   = ^PROC;
    PROC  = RECORD
              BYTE_VAL : BYTE;
              SETADDR : BOOLEAN;
              NEXT : PTR;
            END;

  CONST
    HEXSTR : CHARARR15 = '0123456789ABCDEF';

  VAR
    PROC_TOP, PROC_CURRENT, PROC_TEMP,
    HEAD_TOP, HEAD_CURRENT, HEAD_TEMP    : PTR;
    CMDLINE                              : STR80 ABSOLUTE CSEG:$0080;
    FILENAME, OUTFILE, BASE              : STR80;
    EXTENSION                            : STR3;
    ELEMENT, BYTE_BUFF                   : BYTE;
    INP, OUT                             : FILE OF BYTE;
    I, J, SIZE, ADDRESS, TABLE_SIZE,
    TABLE_ADDR, CURRENT_ADDR, NUM_CALLS,
    PROG_SIZE, SIZE_FILE                 : INTEGER;

  PROCEDURE INIT;

    VAR
      I : INTEGER;

    BEGIN
      FOR I := 1 TO 5 DO WRITELN;
      HEAD_TOP := NIL;
      PROC_TOP := NIL;
      NUM_CALLS := 0;
      I := $100;
      PROG_SIZE := 0;
      TABLE_ADDR := 1;
      CURRENT_ADDR := 0;
    END;


  PROCEDURE REPORT( FILENAME : STR80; ERROR : INTEGER );

    BEGIN
      CASE ( ERROR ) OF
        1 : WRITELN( 'DISK FULL.' );
        2 : WRITELN( 'FILE MUST NOT BE A .COM FILE.' );
        3 : WRITELN( 'CANNOT OPEN FILE : ''', FILENAME, '''.' );
        4 : WRITELN( 'READ ERROR ON FILE : ''',FILENAME,'''.' );
        5 : WRITELN( 'WRITE ERROR ON FILE : ''',FILENAME,'''.' );
      END;
      WRITELN( 'PROGRAM ENDING.' );
      CLOSE( INP );
      CLOSE( OUT );
      HALT;
    END;

  PROCEDURE TRUNCFORSP( VAR BUFFER : STR80 );

    VAR
      I, J, LEN : INTEGER;

    BEGIN
      I := 1;
      LEN := LENGTH( BUFFER );
      WHILE ( BUFFER[ I ] = ' ' ) AND ( I <= LEN ) DO
        I := I + 1;
      FOR J := 1 TO LEN - I + 1 DO
        BUFFER[ J ] := BUFFER[ I + J - 1 ];
      BUFFER[ 0 ] := CHR(LEN - I + 1);
    END;

  FUNCTION HEXADDR( ADDRESS : INTEGER ) : STR80;

    VAR
      BUFFER : STR80;
      LOW1NIB, LOW2NIB, HIGH1NIB, HIGH2NIB : BYTE;

    BEGIN
      LOW1NIB := ADDRESS AND $F;
      HIGH1NIB := ( ADDRESS AND $F0 ) SHR 4;
      LOW2NIB := ( ADDRESS AND $F00 ) SHR 8;
      HIGH2NIB := ( ADDRESS AND $F000 ) SHR 12;
      HEXADDR := HEXSTR[ HIGH2NIB ] + HEXSTR[ LOW2NIB ] +
                 HEXSTR[ HIGH1NIB ] + HEXSTR[ LOW1NIB ];
    END;

  PROCEDURE GETFILEBASE( VAR FILENAME : STR80;  VAR BASE : STR80;
                         VAR EXTENSION : STR3 );

    VAR
      I, J : INTEGER;

    BEGIN
      I := 1;
      WHILE ( NOT ( FILENAME[ I ] IN [ '.', ' ' ] )) AND
            ( I <= LENGTH( FILENAME )) DO
        BEGIN
          FILENAME[ I ] := UPCASE( FILENAME[ I ] );
          BASE[ I ] := FILENAME[ I ];
          BASE[ 0 ] := CHR( I );
          I := I + 1;
        END;
      IF ( FILENAME[ I ] = '.' ) THEN
        BEGIN
          I := I + 1;
          J := 1;
          WHILE ( NOT ( FILENAME[ I ] IN [ ' ', '.' ] )) AND
                ( I <= LENGTH( FILENAME )) AND ( J <= 3 ) DO
            BEGIN
              FILENAME[ I ] := UPCASE( FILENAME[ I ] );
              EXTENSION[ J ] := FILENAME[ I ];
              EXTENSION[ 0 ] := CHR( J );
              J := J + 1;
              I := I + 1;
            END;
        END;
    END;

  PROCEDURE SETUPFILES( FILENAME : STR80 );

    BEGIN
      ASSIGN( INP, FILENAME );
      RESET( INP );
      IF ( IORESULT <> 0 ) THEN REPORT( FILENAME, 3 );
      GETFILEBASE( FILENAME, BASE, EXTENSION );
      IF ( EXTENSION <> 'COM' ) THEN
        OUTFILE := BASE + '.COM'
      ELSE REPORT( '', 2 );
      ASSIGN( OUT, OUTFILE );
      REWRITE( OUT );
      IF ( IORESULT <> 0 ) THEN REPORT( '', 1 );
    END;

   PROCEDURE ADDHEADPTR( VALUE : BYTE; SETCALL : BOOLEAN );

     BEGIN
       NEW( HEAD_TEMP );
       HEAD_TEMP^.BYTE_VAL := VALUE;
       HEAD_TEMP^.SETADDR := SETCALL;
       IF ( HEAD_TOP <> NIL ) THEN
         HEAD_CURRENT^.NEXT := HEAD_TEMP
       ELSE
         HEAD_TOP := HEAD_TEMP;
       HEAD_CURRENT := HEAD_TEMP;
       HEAD_CURRENT^.NEXT := NIL;
     END;

   PROCEDURE ADDPROCPTR( VALUE : BYTE; SETCALL : BOOLEAN );

     BEGIN
       NEW( PROC_TEMP );
       PROC_TEMP^.BYTE_VAL := VALUE;
       PROC_TEMP^.SETADDR := SETCALL;
       IF ( PROC_TOP <> NIL ) THEN
         PROC_CURRENT^.NEXT := PROC_TEMP
       ELSE
         PROC_TOP := PROC_TEMP;
       PROC_CURRENT := PROC_TEMP;
       PROC_CURRENT^.NEXT := NIL;
     END;

   PROCEDURE DUMPPTR( TOP : PTR );

     VAR
       CURRENT, TEMP : PTR;
       VALUE : BYTE;
       I : INTEGER;

     BEGIN
       I := 0;
       CURRENT := TOP;
       WHILE ( CURRENT <> NIL ) DO
         BEGIN
           TEMP := CURRENT;
           VALUE := CURRENT^.BYTE_VAL;
           WRITE( OUT, VALUE );
           IF ( IORESULT <> 0 ) THEN REPORT( OUTFILE, 5 );
           CURRENT := CURRENT^.NEXT;
           I := I + 1;
         END;
     END;

  PROCEDURE CREATHEADER( VAR HEADER_SIZE : INTEGER; NUMCALLS : INTEGER );

    VAR
      TEMP, TEMP1, TEMP2 : PTR;
      I, CURRENT_ADDR : INTEGER;

    BEGIN
      CURRENT_ADDR := 0;
      HEADER_SIZE := 0;
      TEMP := PROC_TOP;
      I := 0;
      WHILE ( TEMP <> NIL ) AND ( I <= NUMCALLS ) DO
        BEGIN
          IF ( TEMP^.BYTE_VAL = $E8 ) OR ( TEMP^.BYTE_VAL = $E9 ) THEN
            BEGIN
              TEMP1 := TEMP^.NEXT;
              TEMP2 := TEMP1^.NEXT;
              ADDRESS := ( TEMP2^.BYTE_VAL SHL 8 ) + TEMP1^.BYTE_VAL;
              ADDRESS := ( PROCSTART + CURRENT_ADDR + 2 ) - ( ADDRESS XOR $FFFF );
              IF ( TEMP^.BYTE_VAL = $E9 ) THEN
                WRITE( 'JMP MADE TO  : ', HEXADDR( ADDRESS ))
              ELSE
                WRITE( 'CE_VAL = $E9 ) THEN
                WRITE( 'JMP MADE TO  : ', HEXADDR( ADDRESS ))
              ELSE
                WRITE( 'CALL MADE TO : ', HEXADDR( ADDRESS ));
              IF ( ADDRESS < LIBRARYSIZE ) AND ( ADDRESS > $100 ) THEN
                BEGIN
                  WRITELN( '  ADDRESS TO BE CHANGED.' );
                  TEMP^.SETADDR := TRUE;
                  ADDHEADPTR( $E9, FALSE );
                  ADDHEADPTR( ADDRESS AND $FF, FALSE );
                  ADDHEADPTR(( ADDRESS AND $FF00 ) SHR 8, FALSE );
                  HEADER_SIZE := HEADER_SIZE + 3;
                  I := I + 1;
                END
              ELSE
                WRITELN( '  ADDRESS NOT CHANGED.' );
              CURRENT_ADDR := CURRENT_ADDR + 2;
              TEMP := TEMP2^.NEXT;
            END
          ELSE TEMP := TEMP^.NEXT;
          CURRENT_ADDR := CURRENT_ADDR + 1;
        END;
      WRITELN;
    END;

  PROCEDURE SETPROCCALLS( HEADER_SIZE, NUMCALLS : INTEGER );

    VAR
      ADDRESS, CURRENT_ADDR, CURR_PROC_ADDR,
      CURR_HEAD_ADDR, I, LINE                  : INTEGER;
      TEMP, TEMP1, TEMP2                       : PTR;

    BEGIN
      TEMP := PROC_TOP;
      CURR_HEAD_ADDR := 3;
      CURR_PROC_ADDR := HEADER_SIZE + 3;
      CURRENT_ADDR := 0;
      LINE := 1;
      I := 0;
      WHILE ( TEMP <> NIL ) AND ( I <= NUMCALLS ) DO
        BEGIN
          IF (( TEMP^.BYTE_VAL = $E8 ) OR ( TEMP^.BYTE_VAL = $E9 )) AND
             ( TEMP^.SETADDR = TRUE ) THEN
            BEGIN
              TEMP1 := TEMP^.NEXT;
              TEMP2 := TEMP1^.NEXT;
              TEMP := TEMP2^.NEXT;
              ADDRESS := ( CURR_PROC_ADDR - CURR_HEAD_ADDR + 2 ) XOR $FFFF;
              TEMP1^.BYTE_VAL := ( ADDRESS AND $FF );
              TEMP2^.BYTE_VAL := ( ADDRESS AND $FF00 ) SHR 8;
              CURRENT_ADDR := CURRENT_ADDR + 2;
              CURR_HEAD_ADDR := CURR_HEAD_ADDR + 3;
              CURR_PROC_ADDR := CURR_PROC_ADDR + 2;
              I := I + 1;
            END
          ELSE
            TEMP := TEMP^.NEXT;
          CURR_PROC_ADDR := CURR_PROC_ADDR + 1;
          CURRENT_ADDR := CURRENT_ADDR + 1;
          LINE := LINE + 1;
        END;
    END;

  PROCEDURE POINTTOSTART;

    VAR
      I : INTEGER;
      BYTE_VAL : BYTE;

    BEGIN
      FOR I := 0 TO $15 DO
        BEGIN
          READ( INP, BYTE_VAL );
          IF ( IORESULT <> 0 ) THEN REPORT( FILENAME, 4 );
        END;
    END;

  PROCEDURE SETHEADERSIZE( TABLE_SIZE : INTEGER );

    VAR
      ELEMENT : BYTE;

    BEGIN
      ELEMENT := $E9;
      WRITE( OUT, ELEMENT );
      ELEMENT := TABLE_SIZE AND $FF;
      WRITE( OUT, ELEMENT );
      ELEMENT := ( TABLE_SIZE AND $FF00 ) SHR 8;
      WRITE( OUT, ELEMENT );
    END;

  BEGIN
    LOWVIDEO;
    FILENAME := CMDLINE;
    IF ( LENGTH( FILENAME ) = 0 ) THEN
      BEGIN
        WRITE( 'CHAIN FILE NAME TO CONVERT TO .COM FILE : ' );
        HIGHVIDEO;
        READLN( FILENAME );
        LOWVIDEO;
        WRITELN;
      END;
    TRUNCFORSP( FILENAME );
    IF ( LENGTH( FILENAME ) > 0 ) THEN
      BEGIN
        INIT;
        SETUPFILES( FILENAME );
        POINTTOSTART;
        SIZE_FILE := FILESIZE( INP );
        WHILE ( NOT EOF( INP )) AND ( MEMAVAIL > 10 ) AND
              ( PROG_SIZE < SIZE_FILE - $1C ) DO
          BEGIN
            READ( INP, BYTE_BUFF );
            ADDPROCPTR( BYTE_BUFF, FALSE );
            IF ( BYTE_BUFF = $E8 ) OR ( BYTE_BUFF = $E9 ) THEN
              NUM_CALLS := NUM_CALLS + 1;
            PROG_SIZE := PROG_SIZE + 1;
          END;
        WRITELN( 'BYTES OF PROGRAM READ : ', HEXADDR( PROG_SIZE ));
        WRITELN( 'CALLS  OR  JUMPS MADE : ', HEXADDR( NUM_CALLS ));
        WRITELN;
        CREATHEADER( TABLE_SIZE, NUM_CALLS );
        WRITELN( 'HEADER SIZE : ', HEXADDR( TABLE_SIZE ));
        SETPROCCALLS( TABLE_SIZE, NUM_CALLS );
        SETHEADERSIZE( TABLE_SIZE );
        DUMPPTR( HEAD_TOP );
        DUMPPTR( PROC_TOP );
        CLOSE( INP );
        CLOSE( OUT );