Topspeed_JPI/TS-V3/SRC/TSLOCATE.LST

Listing:

    1  (* Release 3.10 *)
    2  (*-------------------------------------------------------------------------*
    3  *                                                                          *
    4  *  TSLOCATE.MOD - Embedded code locator                                    *
    5  *                                                                          *
    6  *  COPYRIGHT (C) 1989..1992 Clarion Software Corporation.                  *
    7  *  All Rights Reserved                                                     *
    8  *                                                                          *
    9  *--------------------------------------------------------------------------*)
   10  
   11  (*# call(near_call=>on,
   12           o_a_copy=>off) *)
   13  (*# check(index=>on,
   14            range=>off,
   15            stack=>on,
   16            overflow=>off) *)
   17  (*# optimize(alias=>on) *)
   18  
   19  MODULE tslocate;
   20  IMPORT Lib,Str,FIO,IO,Storage;
   21  
   22  (* This program is used to locate an MSDOS exe file.
   23     The output is in Absolute Binary format,
   24     suitable for blowing a stand-alone system into PROM.
   25     The memory layout of the target system is specified in the
   26     .mem file, together with the linker classes which are to be
   27     put in the memory, for example:
   28  
   29     rom F0000  FFFF0 CODE FCODE
   30     ram 80000  E0000 DATA Dummy BSS M_DATA HEAP STACK
   31  
   32     The second address is a 'stop' address, so that a warning can
   33     be produced if there is not enough memory.
   34  
   35  *)
   36  
   37  CONST
   38    cNamePos = 4; (* change to 3 if it is required to locate segments rather than classes *)
   39  
   40  CONST
   41    Delim = Str.CHARSET{' '};
*****            ^ not supported yet
*****                ^ not supported yet
   42    ImageBufMax=4000H;
   43  
   44  TYPE
   45    StringType = ARRAY [0..31] OF CHAR;
   46  
   47    LongStringType = ARRAY [0..511] OF CHAR;
   48  
   49    UnitType = RECORD
   50      Name:StringType;
   51      Start,Stop:LONGCARD;
   52      StartSeg:CARDINAL;
   53      Diff:CARDINAL;
   54      Located:BOOLEAN;
   55      Rom:BOOLEAN;
   56      MemStart:LONGCARD;
   57    END;
   58  
   59    ExeHeaderType = RECORD
   60      magic : CARDINAL;
   61      sizemod512 : CARDINAL;
   62      sizediv512 : CARDINAL;
   63      numrelocitem : CARDINAL;
   64      headerparas : CARDINAL;
   65      heapminparas : CARDINAL;
   66      heapmaxparas : CARDINAL;
   67      initialss : CARDINAL;
   68      initialsp : CARDINAL;
   69      checksum : CARDINAL;
   70      initialip : CARDINAL;
   71      initialcs : CARDINAL;
   72      relocations : CARDINAL;
   73      ovrlay : CARDINAL;
   74      undocumented : CARDINAL;
   75      (* relocation items follow *)
   76    END;
   77  
   78    ImageType = RECORD
   79      index:CARDINAL;
   80      pos,size:LONGCARD;
   81      buf:ARRAY [0..ImageBufMax] OF SHORTCARD; (* note extra byte at start *)
   82      (* this is required to deal with fixups to the last byte of the buffer *)
   83      (* which are deferred until the next buffer load is read *)
   84    END;
   85  
   86  VAR
   87    ExeFile,
   88    MapFile,
   89    MemFile,
   90    Mp2File : FIO.File;
   91  
   92    BinFile : ARRAY[1..4] OF FIO.File;
   93  
   94    MemWidth : CARDINAL;
   95  
   96    Image : ImageType;
   97  
   98    ExeHeader : ExeHeaderType;
   99  
  100    HeaderSize:LONGCARD; (* size of exeheader in bytes *)
  101  
  102    NosUnit:CARDINAL;
  103  
  104    Unit:ARRAY [1..300] OF UnitType;
  105  
  106  PROCEDURE ReadHex( s:ARRAY OF BYTE; i:CARDINAL ):LONGCARD;
  107  VAR
  108    res:LONGCARD;
  109    c:SHORTCARD;
  110  BEGIN
  111    res := 0;
  112    LOOP
  113      c := SHORTCARD(s[i]);
  114      INC(i);
  115      CASE CHAR(c) OF
  116      | 'A'..'F': c := c - ( SHORTCARD('A') - 10 ) ;
  117      | '0'..'9': c := c - SHORTCARD('0');
  118      ELSE EXIT;
  119      END;
  120      res := res * 16 + VAL(LONGCARD, c );
  121    END;
  122    RETURN res;
  123  END ReadHex;
  124  
  125  PROCEDURE ReadMapFile;
  126  VAR
  127    cname,token:StringType;
  128    line:LongStringType;
  129  BEGIN
  130    NosUnit := 0;
  131    REPEAT
  132      FIO.RdStr(MapFile,line) ;
  133    UNTIL (line[0]<>CHAR(0)) AND (line[1]>='0') AND (line[1]<='9') ;
  134    LOOP
  135      IF Str.Length(line) < 40 THEN EXIT END;
  136      Str.Item( cname, line, Delim, cNamePos );
  137      IF ( NosUnit = 0 )
  138      OR ( Str.Compare(cname,Unit[NosUnit].Name) <> 0 )
  139      THEN
  140        INC(NosUnit);
  141        WITH Unit[NosUnit] DO
  142          Name := cname;
  143          Str.Item( token, line, Delim, 0 );
  144          Start := ReadHex( token,0 );
  145          StartSeg := CARDINAL(Start DIV 16);
  146          Located := FALSE;
  147          Rom := FALSE;
  148          Diff := 0;
  149        END;
  150      END;
  151      IF ( NosUnit <> 0 ) THEN
  152        Str.Item( token, line, Delim, 1 );
  153        Unit[NosUnit].Stop := ReadHex( token, 0 );
  154      END;
  155      FIO.RdStr(MapFile,line);
  156    END;
  157    IF NosUnit = 0 THEN
  158      IO.WrStr('Bad .map file');
  159      HALT;
  160    END;
  161    Unit[NosUnit+1] := Unit[NosUnit]; (* sentinel *)
  162  END ReadMapFile;
  163  
  164  PROCEDURE ClassSearch( cname:ARRAY OF CHAR ):CARDINAL;
  165  VAR i:CARDINAL;
  166  BEGIN
  167    i := 1;
  168    WHILE ( i <= NosUnit ) AND ( Str.Compare( Unit[i].Name, cname ) <> 0 ) DO
  169      INC(i);
  170    END;
  171    RETURN i;
  172  END ClassSearch;
  173  
  174  PROCEDURE ReadMemFile;
  175  VAR
  176    cname,token:StringType;
  177    line:LongStringType;
  178    memstart,memstop:LONGCARD;
  179    rom:BOOLEAN;
  180    ram:BOOLEAN;
  181    i,item:CARDINAL;
  182  BEGIN
  183    MemWidth := 1; (* default width *)
  184    LOOP
  185      FIO.RdStr(MemFile,line);
  186      Str.Item( token, line, Delim, 0 );
  187      ram := FALSE;
  188      rom := FALSE;
  189      IF Str.Compare(token,'') = 0 THEN
  190        EXIT;
  191      ELSIF Str.Compare(token,'rom') = 0 THEN
  192        rom := TRUE;
  193      ELSIF Str.Compare(token,'ram') = 0 THEN
  194        ram := TRUE;
  195      ELSIF Str.Compare(token,'width') = 0 THEN
  196        Str.Item( token, line, Delim, 1 );
  197        MemWidth := CARDINAL( ReadHex( token,0 ) );
  198      ELSE
  199        IO.WrStr('Bad .mem file');
  200        HALT;
  201      END;
  202      IF rom OR ram THEN
  203        Str.Item( token, line, Delim, 1 );
  204        memstart := ReadHex( token,0 );
  205        Str.Item( token, line, Delim, 2 );
  206        memstop := ReadHex( token,0 );
  207        item := 3;
  208        LOOP
  209          Str.Item( cname, line, Delim, item );
  210          INC(item);
  211          IF cname[0]=CHAR(0) THEN
  212            EXIT;
  213          END;
  214          (* search table *)
  215          i := ClassSearch( cname );
  216          IF i > NosUnit THEN
  217            IO.WrStr('Warning: ');
  218            IO.WrStr(cname);
  219            IO.WrStr(' not found in .map file');
  220            IO.WrLn;
  221          ELSE
  222            INC( memstart, LONGCARD( CARDINAL(Unit[i].Start-memstart) MOD 16 ));
  223            Unit[i].MemStart := memstart;
  224            IF Unit[i].Located THEN
  225              IO.WrStr('Warning : ');
  226              IO.WrStr(cname);
  227              IO.WrStr(' specified more than once in .mem file');
  228              IO.WrLn;
  229            END;
  230            Unit[i].Located := TRUE;
  231            Unit[i].Rom := rom;
  232            Unit[i].Diff := CARDINAL( (Unit[i].Start-memstart) DIV 16 );
  233            INC( memstart, Unit[i].Stop - Unit[i].Start );
  234            IF memstart > memstop THEN
  235              IO.WrStr('Warning: not enough memory for ');
  236              IO.WrStr(cname);
  237              IO.WrLn;
  238            END;
  239          END;
  240        END;
  241      END;
  242    END;
  243  END ReadMemFile;
  244  
  245  PROCEDURE NewSeg( seg,off:CARDINAL ):CARDINAL;
  246  VAR loc:LONGCARD;
  247      k:CARDINAL;
  248  BEGIN
  249    loc := 16*VAL(LONGCARD,seg) + VAL(LONGCARD,off);
  250    k := 1;
  251    (* search for location segment = k *)
  252    WHILE ( k <= NosUnit ) AND ( loc >= Unit[k].Start ) DO INC(k) END;
  253    DEC(k);
  254    RETURN seg - Unit[k].Diff;
  255  END NewSeg;
  256  
  257  PROCEDURE ChkRead( VAR buf:ARRAY OF BYTE; count:CARDINAL );
  258  BEGIN
  259    IF FIO.RdBin( ExeFile, buf, count ) <> count THEN
  260      IO.WrStr('?? on read');
  261      HALT;
  262    END;
  263  END ChkRead;
  264  
  265  PROCEDURE GetByte():SHORTCARD;
  266  VAR
  267    pindex:CARDINAL;
  268    fixlocabs:LONGCARD;
  269    target:CARDINAL;
  270    wp:POINTER TO CARDINAL;
  271    exefix:RECORD off,seg:CARDINAL END;
  272    dummy:CARDINAL;
  273    i,j:CARDINAL;
  274  BEGIN
  275    IF Image.pos >= Image.size THEN
  276      INC(Image.pos);
  277      RETURN 99H;
  278    END;
  279    IF Image.index >= ImageBufMax THEN
  280      IF Image.pos = 0 THEN
  281        Image.index := 1;
  282      ELSE
  283        Image.buf[0] := Image.buf[ImageBufMax];
  284        Image.index := 0;
  285      END;
  286      FIO.Seek( ExeFile, HeaderSize+Image.pos+LONGCARD(1-Image.index) );
  287      dummy := FIO.RdBin( ExeFile, Image.buf[1], SIZE(Image.buf)-1 );
  288  
  289      (* now apply segment fixups for this buffer *)
  290      FIO.Seek( ExeFile, LONGCARD(ExeHeader.relocations) );
  291      FOR i := 1 TO ExeHeader.numrelocitem DO
  292        ChkRead( exefix, SIZE(exefix) );
  293        fixlocabs := VAL(LONGCARD,exefix.off)+16*VAL(LONGCARD,exefix.seg);
  294        IF fixlocabs - Image.pos <= ImageBufMax THEN
  295          pindex := CARDINAL(fixlocabs-Image.pos) + Image.index;
  296          IF pindex < ImageBufMax THEN
  297            wp := ADR(Image.buf[pindex]);
  298            target := wp^;
  299            j := 0;
  300            LOOP (* search for target segment = j *)
  301              INC(j);
  302              IF ( j > NosUnit ) OR ( target < Unit[j].StartSeg ) THEN
  303                EXIT;
  304              END;
  305            END;
  306            DEC(j);
  307            wp^ := target - Unit[j].Diff;
  308          END;
  309        END;
  310      END;
  311    END;
  312    INC(Image.pos);
  313    INC(Image.index);
  314    RETURN Image.buf[Image.index-1];
  315  END GetByte;
  316  
  317  VAR OutPos : LONGCARD;
  318  
  319  PROCEDURE PutByte( b:SHORTCARD );
  320  BEGIN
  321    FIO.WrBin( BinFile[1+(CARDINAL(OutPos) MOD MemWidth)], b, 1 );
  322    INC( OutPos );
  323  END PutByte;
  324  
  325  PROCEDURE PutUnit( unit:UnitType );
  326  VAR
  327    total:LONGCARD;
  328    dummy:SHORTCARD;
  329    buf:ARRAY [0..15] OF SHORTCARD;
  330    i,count,seg,off:CARDINAL;
  331  BEGIN
  332    IF NOT unit.Located THEN
  333      IO.WrStr('Warning: ');
  334      IO.WrStr(unit.Name);
  335      IO.WrStr(' not located ');
  336      IO.WrLn;
  337    END;
  338    total := unit.Stop-unit.Start;
  339    IF total > 0 THEN
  340      IF unit.Rom THEN
  341        WHILE Image.pos < unit.Start DO
  342          dummy := GetByte();
  343        END;
  344        IF unit.Start <> Image.pos THEN
  345          IO.WrStr('Overshoot error??');
  346          IO.WrLngHex(unit.Start,6);
  347          IO.WrLngHex(Image.pos,6);
  348          HALT;
  349        END;
  350        IF OutPos = 0 THEN
  351          OutPos := unit.MemStart;
  352        ELSE
  353          WHILE OutPos < unit.MemStart DO
  354            PutByte(0FFH);
  355          END;
  356        END;
  357        WHILE total > 0 DO
  358          PutByte( GetByte() );
  359          DEC(total);
  360        END;
  361      END;
  362    END;
  363  END PutUnit;
  364  
  365  PROCEDURE WriteBinFile;
  366  VAR
  367    i:CARDINAL;
  368  BEGIN
  369    ChkRead( ExeHeader, SIZE(ExeHeader) );
  370    HeaderSize := VAL(LONGCARD,ExeHeader.headerparas)*16;
  371    Image.size := FIO.Size(ExeFile)-HeaderSize;
  372    Image.pos := 0;
  373    Image.index := ImageBufMax;
  374    OutPos := 0;
  375    FOR i := 1 TO NosUnit DO
  376      PutUnit( Unit[i] );
  377    END;
  378  END WriteBinFile;
  379  
  380  PROCEDURE Hex(n:CARDINAL):CHAR;
  381  BEGIN
  382    n := n MOD 16;
  383    IF n > 9 THEN
  384      RETURN CHAR( n + ORD('A') - 10 )
  385    ELSE
  386      RETURN CHAR( n + ORD('0') );
  387    END;
  388  END Hex;
  389  
  390  PROCEDURE EditMap;
  391  VAR
  392    line:LongStringType;
  393    i:CARDINAL;
  394    seg,off:CARDINAL;
  395    addr:LONGCARD;
  396    k:CARDINAL;
  397    cname:StringType;
  398    start:RECORD
  399      off,seg:CARDINAL;
  400    END;
  401  BEGIN
  402    k := 0;
  403    FIO.Seek(MapFile,0);
  404    LOOP
  405      FIO.RdStr(MapFile,line);
  406      IF FIO.EOF THEN EXIT END;
  407      IF ( line[0] = ' ' ) AND ( line[6] = 'H' ) THEN
  408        Str.Item( cname, line, Delim, cNamePos );
  409        k := ClassSearch(cname);
  410        IF k <= NosUnit THEN
  411          FOR i := 0 TO 7 BY 7 DO
  412            addr := ReadHex(line,i+1);
  413            seg := CARDINAL(addr DIV 16);
  414            off := CARDINAL(addr) MOD 16;
  415            seg := seg - Unit[k].Diff;
  416            line[i+4] := Hex(seg); seg := seg DIV 16;
  417            line[i+3] := Hex(seg); seg := seg DIV 16;
  418            line[i+2] := Hex(seg); seg := seg DIV 16;
  419            line[i+1] := Hex(seg); seg := seg DIV 16;
  420          END;
  421        END;
  422      ELSIF ( line[0] = 'P' ) THEN
  423        seg := CARDINAL(ReadHex(line,23));
  424        off := CARDINAL(ReadHex(line,28));
  425        seg := NewSeg(seg,off);
  426        start.seg := seg;
  427        start.off := off;
  428        line[26] := Hex(seg); seg := seg DIV 16;
  429        line[25] := Hex(seg); seg := seg DIV 16;
  430        line[24] := Hex(seg); seg := seg DIV 16;
  431        line[23] := Hex(seg); seg := seg DIV 16;
  432      ELSE
  433        FOR i := 5 TO Str.Length(line) DO
  434          IF ( line[i] = ':' ) THEN
  435            seg := CARDINAL(ReadHex(line,i-4));
  436            off := CARDINAL(ReadHex(line,i+1));
  437            seg := NewSeg( seg, off );
  438            line[i-1] := Hex(seg); seg := seg DIV 16;
  439            line[i-2] := Hex(seg); seg := seg DIV 16;
  440            line[i-3] := Hex(seg); seg := seg DIV 16;
  441            line[i-4] := Hex(seg); seg := seg DIV 16;
  442          END;
  443        END;
  444      END;
  445      IF line[0] <> CHAR(0) THEN
  446        FIO.WrStr(Mp2File,line);
  447      END;
  448      FIO.WrLn(Mp2File);
  449    END;
  450  END EditMap;
  451  
  452  PROCEDURE PrintSummary;
  453  VAR i:CARDINAL;
  454  BEGIN
  455    FOR i := 1 TO NosUnit DO
  456      WITH Unit[i] DO
  457        IO.WrStr(' Start=');  IO.WrLngHex(Start,6);
  458        IO.WrStr(' ');
  459        IO.WrStr(' Stop=');  IO.WrLngHex(Stop,6);
  460        IO.WrStr(' ');
  461        IF Located THEN
  462          IO.WrStr('MemStart=');
  463          IO.WrLngHex(MemStart,6);
  464          IO.WrStr(' ');
  465        ELSE
  466          IO.WrStr('Not located ');
  467        END;
  468        IO.WrStr(Name);
  469        IO.WrLn;
  470      END;
  471    END;
  472  END PrintSummary;
  473  
  474  PROCEDURE GiveBuf( f:FIO.File );
  475  TYPE buf = ARRAY [1..800H+FIO.BufferOverhead] OF SHORTCARD;
  476  VAR bufp :POINTER TO buf;
  477  BEGIN
  478    Storage.ALLOCATE(bufp,SIZE(buf));
  479    FIO.AssignBuffer(f,bufp^);
  480  END GiveBuf;
  481  
  482  PROCEDURE Create(ext:ARRAY OF CHAR):FIO.File;
  483  VAR
  484    filename:FIO.PathStr;
  485    res:FIO.File;
  486  BEGIN
  487    Str.Concat( filename, Lib.CommandLine^, ext );
  488    res := FIO.Create(filename);
  489    GiveBuf(res);
  490    RETURN res;
  491  END Create;
  492  
  493  PROCEDURE Open(ext:ARRAY OF CHAR):FIO.File;
  494  VAR
  495    filename:FIO.PathStr;
  496    res:FIO.File;
  497  BEGIN
  498    Str.Concat( filename, Lib.CommandLine^, ext );
  499    res := FIO.Open(filename);
  500    IF Str.Compare(ext, '.exe') # 0 THEN
  501      GiveBuf(res);
  502    END;
  503    RETURN res;
  504  END Open;
  505  
  506  BEGIN
  507    IO.WrStr('TopSpeed Locator Version 1.10');
  508    IO.WrLn;
  509    IO.WrStr('Copyright (C) 1987-1992 Clarion Software Corporation');
  510    IO.WrLn;
  511  
  512    ExeFile := Open('.exe'); (* no buffering because random access *)
  513    MemFile := Open('.mem');
  514    MapFile := Open('.map');
  515    Mp2File := Create('.mp2');
  516    ReadMapFile;
  517    ReadMemFile;
  518    BinFile[1] := Create('.bn1');
  519    IF MemWidth > 1 THEN
  520      BinFile[2] := Create('.bn2');
  521    END;
  522    IF MemWidth > 2 THEN
  523      BinFile[3] := Create('.bn3');
  524      BinFile[4] := Create('.bn4');
  525    END;
  526    (*PrintSummary;*)
  527    WriteBinFile;
  528    EditMap;
  529    FIO.Close(ExeFile);
  530    FIO.Close(MemFile);
  531    FIO.Close(MapFile);
  532    FIO.Close(Mp2File);
  533    FIO.Close(BinFile[1]);
  534    IF MemWidth > 1 THEN
  535      FIO.Close(BinFile[2]);
  536    END;
  537    IF MemWidth > 2 THEN
  538      FIO.Close(BinFile[3]);
  539      FIO.Close(BinFile[4]);
  540    END;
  541  END tslocate.

    2 errors