home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPA22.ZIP / TPA&RTL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-10-16  |  8.7 KB  |  260 lines
  1. (****         TPA&RTL  Documentation and Demonstration         ****
  2.  
  3.                   TP&Asm Version 2.2  (Revision 1)
  4.  
  5. This revision can be distinguished from the original Version 2.2 by
  6. the 2:21 time stamp and by the Version number shown in the copyright
  7. message.  In most of the documentation, however, I will continue to
  8. refer to this revision as "Version 2.2".
  9.  
  10. TP&Asm Version 2.21 contains a small but interesting upgrade to the
  11. TP&Asm program file which permits you to call any routine in the
  12. Turbo Pascal RunTime Library directly from your TP&Asm assembly code.
  13. (You do not need to purchase the RTL source license).
  14.  
  15. To use this feature you must determine the System Unit internal hex
  16. code which designates the appropriate routine (more on this below),
  17. and declare a standard Pascal constant equal to $C0DE0000 plus this
  18. code.  You may then specify the constant identifier as the target of
  19. any assembly Call (or JMP) statement, and TP&Asm will link in the
  20. designated RunTime Library routine.
  21.  
  22. For example, the internal hex code for the RunTime Library "LMod"
  23. function is $0018.  The following code fragment will compute
  24. L1 Mod L2 and leave the result in (Bx,Cx)
  25.  
  26.  CONST LMod = $C0DE0018;
  27.   :
  28.   Assembly
  29.    Les Ax,L1
  30.    Mov Dx,Es ;load L1 into (Dx,Ax)
  31.    Les Cx,L2
  32.    Mov Bx,Es ;load L2 into (Bx,Cx)
  33.    Call LMod ;call RTL routine which leaves result in (Bx,Cx)
  34.    :
  35.  
  36.  
  37. All valid internal hex codes are multiples of 4, and the following
  38. limits are enforced:
  39.  
  40.   VER40: $0004 to $0260
  41.   VER50: $0004 to $0284
  42.   VER55: $0004 to $0294
  43.  
  44. I don't guarantee that all codes up to these maximum values are valid
  45. RTL routines, however I am fairly certain that codes beyond these are
  46. not valid.
  47.  
  48. Please note:
  49. I have made no attempt to explain or even determine what all of the
  50. RunTime Library routines do nor how they should be called.  I have
  51. left that to the user.  In many cases the following technique can
  52. be applied to determine the internal code of a particular RunTime
  53. Library routine:
  54.  
  55.  1) create a file which defines the entire range of RTL constants
  56.     and makes one call to each, and which also contains a single
  57.     Pascal line which will invoke the desired RTL routine:
  58.  
  59.      Program FindRTL;
  60.      CONST
  61.        RTL0004 = $C0DE0004;
  62.        RTL0008 = $C0DE0008;
  63.         :          :
  64.        RTL0294 = $C0DE0294; {- v5.5 Maximum -}
  65.      VAR
  66.        L1,L2,L3: LongInt;
  67.      BEGIN
  68.       L3 := L1 Mod L2; {- invoke RTL LMod function -}
  69.       Assembly
  70.        Call RTL0004
  71.        Call RTL0008
  72.         :
  73.        Call RTL0294
  74.       End; {Assembly}
  75.      END.
  76.  
  77.  2) compile and create a map file, eg: "tpa c FindRTL/gd".  Then use
  78.     EXAMINE.EXE (available in the archive TP-XMN) to examine the
  79.     compiled file and save the output ("examine FindRTL >rtl.xmn").
  80.  
  81.  3) Edit the examine output file, find the Far Call(s) associated
  82.     with the Pascal statement, and locate the assembly Call(s) which
  83.     reference the same location.  The relevant parts of the example
  84.     in (1) are shown below:
  85.  
  86.      VAR
  87.        L1,L2,L3: LongInt;
  88.      BEGIN
  89.  
  90.     3FC1:0000 9A0000F83F    CALL 3FF8:0000
  91.     3FC1:0005 55            PUSH BP
  92.     3FC1:0006 89E5          MOV BP,SP
  93.     ----
  94.       L3 := L1 Mod L2; {- invoke RTL LMod function -}
  95.  
  96.     3FC1:0008 C4063E00      LES AX,[003E]
  97.     3FC1:000C 8CC2          MOV DX,ES
  98.     3FC1:000E C40E4200      LES CX,[0042]
  99.     3FC1:0012 8CC3          MOV BX,ES
  100.     3FC1:0014 9A9402F83F    CALL 3FF8:0294    ** This is the RTL Call **
  101.     3FC1:0019 89C8          MOV AX,CX
  102.     3FC1:001B 89DA          MOV DX,BX
  103.     3FC1:001D A34600        MOV [0046],AX
  104.     3FC1:0020 89164800      MOV [0048],DX
  105.     ----
  106.      :
  107.      :
  108.     ----
  109.        Call RTL0018
  110.  
  111.     3FC1:0040 9A9402F83F    CALL 3FF8:0294   ** Matching Assembly Call **
  112.     ----
  113.        Call RTL001C
  114.  
  115.     3FC1:0045 9A0203F83F    CALL 3FF8:0302
  116.     ----
  117.      :
  118.  
  119.  
  120. It has been my observation that many of the RunTime Library routines
  121. have retained the same internal code for all versions (4.0 and above),
  122. however I am not certain that that will be true in all cases.  In some
  123. cases, for example RtlGetMem and RtlFreeMem shown below, the internal
  124. code has remained the same but the calling conventions have changed.
  125.  
  126. The example below is designed to provide a simple demonstration of
  127. the use of assembly language RTL calls.  The RunTime Library FreeMem
  128. pocedure is used to implement a "ShrinkMem" capability.  A typical
  129. use of ShrinkMem would be to read a data file into a large buffer on
  130. the heap, and then to reduce the allocated heap space to the amount
  131. actually required:
  132.  
  133.   GetMem(DataBuf,64000);
  134.   Assign(DataFile,DataPath); Reset(DataFile,1);
  135.   BlockRead(DataFile,DataBuf^,64000,BytesRead);
  136.   ShrinkMem(DataBuf,64000,BytesRead);
  137.  
  138. An additional example is provided by the UserRunError procedure,
  139. which demonstrates one of the relatively rare circumstances where
  140. it is useful to make an unconditional JMP to a procedure.
  141.  
  142. Unlike the Version 5.x "RunError" procedure which flags the address
  143. of the RunError call itself, this procedure provides a more useful
  144. function by flagging the line which invoked the routine containing
  145. the UserRunError call.  Thus,
  146.  
  147.   ShrinkMem(p1,21000,30000);      {- RunTime Error 204 -}
  148.  
  149. will generate a RunTime Error at this line itself, not at some
  150. obscure point within ShrinkMem where the error was detected.  If
  151. ShrinkMem resides in a unit which was compiled without debug
  152. information ({$D-}), or for which source code is not available,
  153. UserRunError (but not v 5.x RunError) will still correctly report
  154. the address of the invalid ShrinkMem Call.
  155.  
  156. ShrinkMem could have been written entirely in Pascal; the use of
  157. assembly language simply makes it smaller and faster.  Note that
  158. it could not be written in inline or External assembly language,
  159. however - unless you have purchased the RTL license, recompiled
  160. the System unit with all of the routines "interfaced", and then
  161. recompiled all of your standard and user-defined units to recognize
  162. the recompiled System unit.
  163.  
  164. I believe that UserRunError is an example of a procedure which
  165. could not be written either in Pascal or inline/External assembly
  166. (again, unless you have the RTL license and recompile all your
  167. units).
  168.  
  169. This example file can be compiled with TP&Asm Version 2.21 running
  170. Turbo Pascal Version 4.0, 5.0, or 5.5.
  171.  
  172. *****************************************************************)
  173.  
  174. {$M $1000,51000,51000}
  175.  
  176. CONST
  177.   RtlRunError = $C0DE0008;
  178.   RtlGetMem   = $C0DE0088;
  179.   RtlFreeMem  = $C0DE008C;
  180.  
  181. VAR
  182.   p1,p2,p3: POINTER;
  183.  
  184. {$F+} PROCEDURE RunError(ErrorNo: WORD); Forward; {$F-}
  185. {$F+} PROCEDURE UserRunError(ErrorNo: WORD); Forward; {$F-}
  186.  
  187. Internal RTE
  188.  
  189. RunError Proc Far   ; (for version 4.0 users)
  190.   Mov Bx,Sp
  191.   Ss Mov Ax,[Bx+4]  ;load ErrorNo into Ax
  192.   Jmp RtlRunError   ;Jmp to Runtime Library Routine
  193. RunError ENDP
  194.  
  195. UserRunError Proc Far
  196.   Pop Ax,Ax,Ax      ;Clear Return Cs:Ip and load ErrorNo into Ax
  197.   Mov Sp,Bp         ;Proc/Function containing UserRunError
  198.   Pop Bp            ; Must have standard Proc/Function entry code
  199.   Jmp RtlRunError   ;  (and must be FAR)
  200. UserRunError ENDP
  201.  
  202. End
  203.  
  204. {$F+} PROCEDURE ShrinkMem(PVar: POINTER; OldSize,NewSize: WORD); {$F-}
  205. {$S-} BEGIN {$S+}
  206.  Assembly
  207.   Les Ax,PVar     ;set Dx:Ax
  208.   Mov Dx,Es       ; to PVar
  209.   Add Ax,NewSize  ;Point to "PVar+NewSize"
  210.   Mov Bx,Ax       ;Normalize
  211.   And Ax,000Fh    ; Pointer
  212.   Shr Bx,4        ;  before passing
  213.   Add Dx,Bx       ;   to FreeMem
  214.   Mov Bx,OldSize  ;Compute
  215.   Sub Bx,NewSize  ; amount to free
  216.  
  217.   jA Valid
  218.   Pas UserRunError(204);
  219.  Valid:
  220.  
  221.  Pas {$IFDEF VER55} {- 5.5 uses pointer Value -}
  222.   Push Dx,Ax,Bx   ;Push parameters for FreeMem
  223.  Pas {$ELSE}        {- 4.0, 5.0 use pointer Address -}
  224.   Mov W PVar,Ax
  225.   Mov W PVar+2,Dx
  226.   Lea Ax,PVar
  227.   Push Ss,Ax,Bx   ;Push parameters for FreeMem
  228.  Pas {$ENDIF}
  229.  
  230.   Call RtlFreeMem ;Call RunTime Library Routine
  231.  End {Assembly}
  232. END;
  233.  
  234. PROCEDURE ShowMaxAvail;
  235. BEGIN  WRITELN('Size of largest available block is ',MaxAvail);  END;
  236.  
  237. BEGIN    {- Verify proper operation of ShrinkMem -}
  238.  
  239.   ShowMaxAvail;
  240.   GetMem(p1,30000);                {- Allocate        -}
  241.   GetMem(p2,10000);                {-      three      -}
  242.   GetMem(p3,10000);                {-          blocks -}
  243.   ShowMaxAvail;
  244.  
  245.  {- First free the center block -}
  246.   FreeMem(p2,10000);            ShowMaxAvail;  {- 10,000 -}
  247.  
  248.  {- Free some of 1st block, should merge with freed 2nd block -}
  249.   ShrinkMem(p1,30000,21000);    ShowMaxAvail;  {- 19,000 -}
  250.  
  251.  {- Free remainder of 1st block, should merge again -}
  252.   FreeMem(p1,21000);            ShowMaxAvail;  {- 40,000 -}
  253.  
  254.   Halt;
  255.  
  256.  {- The following line would generate a RunTime Error -}
  257.   ShrinkMem(p1,21000,30000);      {- RunTime Error 204 -}
  258.  
  259. END.
  260.