home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPA22.ZIP / TPADEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-22  |  6.9 KB  |  198 lines
  1. {═══════════════════════════════ DEMOTPA.PAS ═══════════════════════════════}
  2. { ──────────────  TP&Asm Release 2.2 features demonstration  ────────────── }
  3. { ─  Compile to Memory and F7 "Trace into" in the Version 5.0 or 5.5 IDE  ─ }
  4. {═══════════════════════════════════════════════════════════════════════════}
  5. Program DemoTPA;
  6. {$IFDEF VER50}                Uses DOS,WchMgr50;                     {$ENDIF}   
  7. {$IFDEF VER55}                Uses DOS,WchMgr55;                     {$ENDIF}
  8.  
  9. VAR TestW: Word;
  10.  
  11. {═══  The following Assembly Directive illustrates the "Asm" Statement   ═══}
  12. Procedure NearRet; Asm Ret;
  13.  
  14. Procedure First;
  15. BEGIN  {First Executable Statement of Procedure First}
  16. {╔══  The following illustrates the ability to allocate and use "Local"  ══╗}
  17. {╚══  CSeg Data in the first TRUE Procedure or Function.                 ══╝}
  18. Assemble
  19. Stc
  20. Jmp Start               ; Short Jmp (EB 06) over data (01 00 02 00 03 00)
  21. Dat Dw 1,2,3            ; FIRST Procedure can allocate and use CSeg Data.
  22. Start: IF C Mov Ax,Dat  ; Ax <-- 1
  23. Cmc
  24. IF C Mov Ax,$CEDE       ; Ax will not change
  25. Dec Ax                  ; Ax <-- 0
  26. Here: IF Z Jmp There
  27. Mov Bx,Dat+2            ; This statement won't execute
  28. There:
  29. Mov Cx,Dat+4            ; Cx <-- 3
  30. End; {Assemble}
  31. END; {Procedure First;}
  32.  
  33. {$F+} Procedure FarProc;  BEGIN Writeln('FarProc'); END; {$F-}
  34.       Procedure NearProc; BEGIN Writeln('NearProc'); END;
  35.       Procedure FwdProc;  Forward;
  36.       Procedure DosVersion; BEGIN Writeln('DemoTPA.DosVersion'); END;
  37.  
  38. Procedure TestProc;
  39. Procedure NestProc; BEGIN WriteLn('NestProc'); END;
  40. Procedure SubTest;
  41.  
  42. Label AsmLabel,PasLabel,PasForward,PastData;
  43.  
  44. BEGIN  {First Executable Statement of SubTest}
  45.  
  46. {═════════════  The following illustrates the "Asm" statement  ═════════════}
  47. Asm Call First;
  48.  
  49. Assembly
  50. ;╔══   The following Pascal statement pushes the parent procedure's Bp    ══╗
  51. ;║     before calling NestProc.  Observe the Bp on the stack (above the     ║
  52. ;║     Return Address) during NestProc and compare with the subsequent      ║
  53. ;╚══   Assembly Call:                                                     ══╝
  54.  Pas NestProc;
  55.  
  56. ;═══════  The following 2 assembly statements produce the same code:  ═══════
  57.  Push [Bp+4]    ;Push Parent Proc Bp as LAST 'Parameter'
  58.  Call NestProc;
  59.  
  60. ;═════════════  The next two statements have the same result:   ═════════════
  61.  Pas FwdProc;
  62.  Call FwdProc;
  63.  
  64. ;╔═════  You can call near Proc/Functions within this Unit, or Far     ═════╗
  65. ;╚═════  Proc/Functions within this or another Unit:                   ═════╝
  66.  Call NearProc
  67.  Call FarProc
  68.  Call DosVersion ;Unqualified reference to Proc in current module
  69.  Call Dos.DosVersion ;(Not available in version 4 DOS Unit)
  70.  Mov TestW,Ax    ;Put Function Result into TestW
  71.  
  72. ;══════  You can "Call" System Procedures using the "Pas" Statement:  ═══════
  73.  Pas WRITELN('This WRITE statement called from within an assembly block');
  74.  Pas WRITELN('The DOS Version is ',Lo(TestW),'.',Hi(TestW));
  75. END;
  76.  
  77. IF Testw = Dos.DosVersion THEN
  78.    WRITELN('This Pascal function call produced the same result');
  79.  
  80. {╔═══  Assembly labels which are defined in a "Label" statement can be  ═══╗}
  81. {╚═══  the target of a Pascal "Goto" statement:                         ═══╝}
  82. Goto AsmLabel;
  83. PasLabel:
  84.   Assemble
  85.     Xor Ax,Ax    ;First Executable Statement following PasLabel
  86. ;═════  The Ds Register can be modified and restored using "SEG Data"   ═════
  87.     Mov Ds,Ax               ; Ds <-- 0
  88.     Mov Dx,SEG Data         ; Dx <-- Program Data Segment
  89.     Mov Ds,Dx               ; Restore Ds
  90.   FarBack:
  91.     Mov TestW,Cx ;First Executable Statement following FarBack
  92.     Push Cx
  93. ;═════════  A Pascal Label can be the target of an Assembly "Call"  ═════════
  94.     Call PasForward
  95.     Pop Cx       ;Call to PasForward will Return here
  96.     Cmp Cx,2
  97. ;╔═════════  Observe the change in "CPU.CsIp,p" for the next two   ═════════╗
  98. ;╚═════════  jumps when Cx = 3                                     ═════════╝
  99.     jE ForwdFar  ; This forward jump requires 5 bytes
  100.     jB ForwdNear ; This forward jump requires 2 bytes
  101.     Mov Ax,$1234
  102.   ForwdNear:
  103.     Jmp PastData
  104.  
  105. ;══════  The following 140 bytes cannot be bridged with a short jump  ═══════
  106.     db 20 dup 0
  107.     db 20 dup 0
  108.     db 20 dup 0
  109.     db 20 dup 0
  110.     db 20 dup 0
  111.     db 20 dup 0
  112.     db 20 dup 0
  113.  
  114.   Pastdata:
  115. ;══════════════  Observe the Watch Expression "CPU.Flags-On"   ══════════════
  116.     Std
  117.     Cld
  118.     Stc
  119.     Clc
  120.   ForwdFar:
  121.     Cli
  122.     Sti
  123.     Loop FarBack
  124. ;════════  The preceding Loop builds a 7 byte instruction sequence   ════════
  125.  
  126.     Jmp Finish
  127.  
  128.   AsmLabel:
  129.     Call AsmProc
  130.     Jmp PasLabel
  131. ;═════════  A Pascal Label can be the target of an Assembly "Jmp"   ═════════
  132.  
  133.    AsmProc:
  134.      Mov Cx,3    ; Initialize Cx for the Loop
  135.      Ret
  136.  
  137.    Finish:
  138.   END;  {Assemble}
  139.   Exit;
  140.  
  141. PasForward:
  142.   WRITELN('This Pascal Label defines a callable "Procedure" terminated');
  143.   WRITELN('by the Inline/Assembly Directive "NearRet";  Counter = ',TestW);
  144.   NearRet;
  145.  
  146. End; {SubTest}
  147.  
  148. BEGIN
  149.   SubTest;
  150. End; {TestProc}
  151.  
  152. Procedure FwdProc; BEGIN WriteLn('FwdProc'); END;
  153.  
  154. PROCEDURE SetAsmWatches;
  155. BEGIN
  156. {══════════════════════════════ SetAsmWatches ══════════════════════════════}
  157. {- Displays all CPU Registers and Flags and a memory dump at the current   -}
  158. {- Stack Pointer and Instruction Pointer.  This procedure is also defined  -}
  159. {- in the WCHMGR5x Units.  It is reproduced here to illustrate the use of  -}
  160. {- the AddWatch procedure and the CPU record variable                      -}
  161. {══════════════════════════════ SetAsmWatches ══════════════════════════════}
  162.   ClrWatch;
  163.   AddWatch(CopyRight);
  164.  
  165. {════════════ Type Definitions from WCHMGR5x.TPU ════════════
  166.          (The variable CPU below is of type CPUType)
  167.  
  168.   TYPE FgBits = (C,X1,P,X3,A,x5,Z,S,T,I,D,O,X12,X13,X14,X15);
  169.   Const On = [X1,X3,X5,X12..X15];
  170.   TYPE W = ARRAY[0..32] OF WORD;
  171.  
  172.   TYPE CPUType = RECORD
  173.    Case Integer OF
  174.     1: (Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Ip,Cs,Fg,Sp,Ss :Word);
  175.     2: (Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh : Byte);
  176.     3: (dum18 :Array[1..18] of byte;
  177.         CsIp : Pointer;
  178.         Flags : Set of FgBits;
  179.         SsSp : Pointer;);
  180.   END;
  181.  
  182. ════════════════════════════════════════════════════════════}
  183.  
  184.  ClrWatch;
  185.  AddWatch('CPU.CsIp^,m');     {- Hex Dump beginning at current instruction -}
  186.  AddWatch('CPU.CsIp,p');      {- Segment:Offset of the current instruction -}
  187.  AddWatch('W(CPU.SsSp^),$');  {- Memory Dump at current Stack Pointer      -}
  188.  AddWatch('CPU.SsSp,p');      {- Segment:Offset of the Stack Pointer       -}
  189.  AddWatch('CPU.Flags-On');    {- Current state of CPU Flags                -}
  190.  AddWatch('CPU,$R');          {- Lists all register names and contents     -}
  191.  
  192. END; {PROCEDURE SetAsmWatches}
  193.  
  194. BEGIN
  195.   SetAsmWatches;  {- F7 Trace into or F8 Step over to set Assembly Watches -}
  196.   TestProc;       {- Repeat F7 Trace into and watch registers and flags    -}
  197. END.
  198.