home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB33.ZIP / MAIN2.INC < prev    next >
Encoding:
Text File  |  1986-02-10  |  6.2 KB  |  190 lines
  1.  
  2.   PROCEDURE SetupJumpTable;
  3.       {-initialize the names and offsets of the near procedures}
  4.       {
  5.       ***************************************************
  6.       * The programmer must maintain the lists below to *
  7.       * include all global procedure names that will be *
  8.       * called from the Far code segment.               *
  9.       ***************************************************
  10.       }
  11.     BEGIN
  12.       {
  13.       *** EXAMPLES and COMMENTS ********************************************
  14.       * Order is unimportant, except that procedures which are called most *
  15.       *  often from far segment should be first in list.                   *
  16.       * Case of the string is important. Must be same as string passed to  *
  17.       *  MakeLongCall (avoids overhead time of uppercasing every call).    *
  18.       * Fill in your own procedure names below.                            *
  19.       **********************************************************************
  20.       }
  21.       pnames[1] := 'mainproc1';
  22.       poffsets[1] := Ofs(mainproc1);
  23.       pnames[2] := 'mainproc2';
  24.       poffsets[2] := Ofs(mainproc2);
  25.     END;                      {SetupJumpTable}
  26.  
  27.   PROCEDURE MainCallHandler;
  28.       {-pick up control from a far call and transfer to near procedure}
  29.     VAR
  30.       i : Integer;
  31.       procofs : Integer;
  32.       procname : BigTurboString;
  33.     BEGIN
  34.       {get procname from the es:si pointer passed in}
  35.       INLINE(
  36.         $31/$C9/              {XOR    CX,CX}
  37.         $26/                  {ES:    }
  38.         $8A/$0C/              {MOV    CL,[SI]}
  39.         $FE/$C1/              {INC    CL}
  40.         $BF/procname/         {MOV    DI,ofs(procname)}
  41.         $FC/                  {CLD    }
  42.         {10B:}
  43.         $26/                  {ES:    }
  44.         $AC/                  {LODSB    }
  45.         $88/$03/              {MOV    [BP+DI],AL}
  46.         $47/                  {INC    DI}
  47.         $E2/$F9               {LOOP    010B}
  48.         );
  49.       {match against the stored procnames}
  50.       i := 0;
  51.       REPEAT
  52.         i := i+1;
  53.       UNTIL (i > MaxNumProcs) OR (pnames[i] = procname);
  54.       {error check}
  55.       IF i > MaxNumProcs THEN BEGIN
  56.         WriteLn(Con);
  57.         WriteLn(Con, 'Far procedure ', procname, ' not found....');
  58.         Halt;
  59.       END;
  60.       {check for stack space, later}
  61.       {assure stack aligned for parameter passing, later}
  62.       {call the procedure}
  63.       procofs := poffsets[i];
  64.       INLINE(
  65.         $C4/$46/< procofs/    {LES    AX,procofs[BP]}
  66.         $FF/$D0               {CALL    AX}
  67.         );
  68.  
  69.       {restore stack frame and FAR return}
  70.       INLINE(
  71.         $8B/$E5/              {mov sp,bp}
  72.         $5D/                  {pop bp}
  73.         $CB                   {ret far}
  74.         );
  75.     END;                      {MainCallHandler}
  76.  
  77.   PROCEDURE LoadFarCode(FarComFileName : BigTurboString);
  78.       {-load the FarComFile and set up the required addresses}
  79.     CONST
  80.       id1string : BigTurboString = 'FARCALLHANDLER FOLLOWS';
  81.       id2string : BigTurboString = 'SETJUMPTABLE FOLLOWS';
  82.     VAR
  83.       f : FILE;
  84.       len : Byte ABSOLUTE FarComFileName;
  85.       i : Integer;
  86.       size : Integer;
  87.       FarCodeSeg : Integer;
  88.       FarCodeOfs : Integer;
  89.       ext : STRING[4];
  90.       testlen : Byte;
  91.       teststring : BigTurboString;
  92.     BEGIN
  93.  
  94.       {assure it is a .COM file}
  95.       ext := Copy(FarComFileName, len-3, 4);
  96.       FOR i := 1 TO 4 DO ext[i] := UpCase(ext[i]);
  97.       IF ext <> '.COM' THEN BEGIN
  98.         WriteLn(Con);
  99.         WriteLn(Con, 'Far Code File must be a .COM file');
  100.         Halt;
  101.       END;
  102.  
  103.       {make sure it exists and open it}
  104.       Assign(f, FarComFileName);
  105.       {note we are using a block size of 1}
  106.       {$I-} Reset(f, 1);      {$I+}
  107.       IF IOResult <> 0 THEN BEGIN
  108.         WriteLn(Con);
  109.         WriteLn(Con, 'Far Code File not found....');
  110.         Halt;
  111.       END;
  112.  
  113.       {make sure there is something in it}
  114.       size := FileSize(f);
  115.       IF size = 0 THEN BEGIN
  116.         WriteLn(Con);
  117.         WriteLn(Con, 'Far Code File is empty....');
  118.         Halt;
  119.       END;
  120.  
  121.       {make sure there is space for it}
  122.       IF (size SHR 4) > (MaxAvail-32) THEN BEGIN
  123.         WriteLn(Con);
  124.         WriteLn(Con, 'Far Code too large to load on heap....');
  125.         Close(f);
  126.         Halt;
  127.       END;
  128.  
  129.       {allocate memory on heap}
  130.       GetMem(FarCodePtr, size+512);
  131.       {IMPORTANT: normalize seg and ofs so that we can make farcodeofs=$100}
  132.       FarCodeSeg := Seg(FarCodePtr);
  133.       FarCodeOfs := Ofs(FarCodePtr);
  134.       WHILE FarCodeOfs > $100 DO BEGIN
  135.         FarCodeOfs := FarCodeOfs-16;
  136.         FarCodeSeg := FarCodeSeg+1;
  137.       END;
  138.       FarCodePtr := Ptr(FarCodeSeg, $100);
  139.       FarCodeOfs := $100;
  140.  
  141.       {load code onto heap}
  142.       BlockRead(f, farcodeptr^, size);
  143.       Close(f);
  144.  
  145.       {store the pointers}
  146.       FarJumpSet.segment := FarCodeSeg;
  147.       FarHand.segment := FarCodeSeg;
  148.       {store the local addresses}
  149.       MainHand.offset := Ofs(MainCallHandler);
  150.       MainHand.segment := CSeg;
  151.  
  152.       {search the far code for the idstrings identifying key offsets}
  153.       {start at the top and work backwards, should be faster}
  154.       i := size;
  155.       testlen := Length(id1string)+1;
  156.       REPEAT
  157.         i := i-1;
  158.         Move(Mem[FarCodeSeg:(FarCodeOfs+i)], teststring, testlen);
  159.       UNTIL (i < 1) OR (teststring = id1string);
  160.       IF i < 1 THEN BEGIN
  161.         WriteLn(Con);
  162.         WriteLn(Con, 'ID string ', id1string, ' not found in Far code....');
  163.         Halt;
  164.       END;
  165.       {store the adjusted offset for far calls}
  166.       FarHand.offset := FarCodeOfs+i-7;
  167.  
  168.       testlen := Length(id2string)+1;
  169.       REPEAT
  170.         i := i-1;
  171.         Move(Mem[FarCodeSeg:(FarCodeOfs+i)], teststring, testlen);
  172.       UNTIL (i < 1) OR (teststring = id2string);
  173.       IF i < 1 THEN BEGIN
  174.         WriteLn(Con);
  175.         WriteLn(Con, 'ID string ', id2string, ' not found in Far code....');
  176.         Halt;
  177.       END;
  178.       {store the adjusted offset for far calls}
  179.       FarJumpSet.offset := FarCodeOfs+i-7;
  180.  
  181.       {set up the local jump table}
  182.       SetupJumpTable;
  183.  
  184.       {set up the far jump table}
  185.       INLINE(
  186.         $FF/$1E/FarJumpSet    {CALL    FAR FarJumpSet}
  187.         );
  188.       {we are done}
  189.     END;                      {LoadFarCode}
  190.