Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TPA2_A.ZIP/DEMONEW.PAS

Pascal/Delphi Source File | 1989-02-11 | 5.7 KB | 185 lines

{═══════════════════════════════ DEMONEW.PAS ═══════════════════════════════}
{ ─────────────  TP&Asm Release 2 new features demonstration  ───────────── }
{═══════════════════════════════════════════════════════════════════════════}
Uses DOS,ASMWATCH;

(*
════════════════════════  Watches  ═════════════════════════
      Place Cursor in column 1, Hit <Ctrl><F7>, and
      Cursor right to get entire Watch Expression.

CPU.CsIp,p       - Segment:Offset of the current instruction
CPU.CsIp^,m      - Hex Dump beginning at current instruction
CPU.Flags-On     - Current state of CPU Flags
CPU.SsSp,P       - Segment:Offset of the Stack Pointer
W(CPU.SsSp^),$   - Memory Dump at current Stack Pointer
CPU,$R           - Lists all register names and contents

════════════ Type Definitions from ASMWATCH.TPU ════════════
        (The variable CPU above is of type CPUType)

TYPE FgBits = (C,X1,P,X3,A,x5,Z,S,T,I,D,O,X12,X13,X14,X15);
Const On = [X1,X3,X5,X12..X15];
TYPE W = ARRAY[0..32] OF WORD;

TYPE CPUType = RECORD
 Case Integer OF
  1: (Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Ip,Cs,Fg,Sp,Ss :Word);
  2: (Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh : Byte);
  3: (dum18 :Array[1..18] of byte;
      CsIp : Pointer;
      Flags : Set of FgBits;
      SsSp : Pointer;);
END;

════════════════════════════════════════════════════════════
*)


VAR TestW:Word;

{═══  The following Assembly Directive illustrates the "Asm" Statement   ═══}
Procedure NearRet; Asm Ret;

Procedure First;
BEGIN  {First Executable Statement of Procedure First}
{╔══  The following illustrates the ability to allocate and use "Local"  ══╗}
{╚══  CSeg Data in the first TRUE Procedure or Function.                 ══╝}
Assemble
Stc
Jmp Start
Dat Dw 1,2,3            ; FIRST Procedure can allocate and use CSeg Data.
Start: IF C Mov Ax,Dat  ; Ax <-- 1
Cmc
IF C Mov Ax,$CEDE       ; Ax will not change
Dec Ax                  ; Ax <-- 0
Here: IF Z Jmp There
Mov Bx,Dat+2            ; This statement won't execute
There:
Mov Cx,Dat+4            ; Cx <-- 3
End; {Assemble}
END; {Procedure First;}

{$F+} Procedure FarProc;  BEGIN Writeln('FarProc'); END; {$F-}
      Procedure NearProc; BEGIN Writeln('NearProc'); END;
      Procedure FwdProc;  Forward;

Procedure TestProc;
Procedure NestProc; BEGIN WriteLn('NestProc'); END;
Procedure SubTest;

Label AsmLabel,PasLabel,PasForward,PastData;

BEGIN  {First Executable Statement of SubTest}

{═════════════  The following illustrates the "Asm" statement  ═════════════}
Asm Call First;

Assembly
;╔══   The following Pascal statement pushes the parent procedure's Bp    ══╗
;║     before calling NestProc.  Observe the Bp on the stack (above the     ║
;║     Return Address) during NestProc and compare with the subsequent      ║
;╚══   Assembly Call:                                                     ══╝
 Pas NestProc;

;═══════  The following 2 assembly statements produce the same code:  ═══════
 Push [Bp+4]    ;Push Parent Proc Bp as LAST 'Parameter'
 Call NestProc;

;═════════════  The next two statements have the same result:   ═════════════
 Pas FwdProc;
 Call FwdProc;

;╔═════  You can call near Proc/Functions within this Unit, or Far     ═════╗
;╚═════  Proc/Functions within this or another Unit:                   ═════╝
 Call NearProc
 Call FarProc
 Call DosVersion ;(Not available in version 4 DOS Unit)
 Mov TestW,Ax    ;Put Function Result into TestW

;══════  You can "Call" System Procedures using the "Pas" Statement:  ═══════
 Pas WRITELN('This WRITE statement called from within an assembly block');
 Pas WRITELN('The DOS Version is ',Lo(TestW),'.',Hi(TestW));
END;

IF Testw = DosVersion THEN
   WRITELN('This Pascal function call produced the same result');

{╔═══  Assembly labels which are defined in a "Label" statement can be  ═══╗}
{╚═══  the target of a Pascal "Goto" statement:                         ═══╝}
Goto AsmLabel;
PasLabel:
  Assemble
    Xor Ax,Ax    ;First Executable Statement following PasLabel
;═════  The Ds Register can be modified and restored using "SEG Data"   ═════
    Mov Ds,Ax               ; Ds <-- 0
    Mov Dx,SEG Data         ; Dx <-- Program Data Segment
    Mov Ds,Dx               ; Restore Ds
  FarBack:
    Mov TestW,Cx ;First Executable Statement following FarBack
    Push Cx
;═════════  A Pascal Label can be the target of an Assembly "Call"  ═════════
    Call PasForward
    Pop Cx       ;Call to PasForward will Return here
    Cmp Cx,2
;╔═════════  Observe the change in "CPU.CsIp,p" for the next two   ═════════╗
;╚═════════  jumps when Cx = 3                                     ═════════╝
    jE ForwdFar  ; This forward jump requires 5 bytes
    jB ForwdNear ; This forward jump requires 2 bytes
    Mov Ax,$1234
  ForwdNear:
    Jmp PastData

;══════  The following 140 bytes cannot be bridged with a short jump  ═══════
    db 20 dup 0
    db 20 dup 0
    db 20 dup 0
    db 20 dup 0
    db 20 dup 0
    db 20 dup 0
    db 20 dup 0

  Pastdata:
;══════════════  Observe the Watch Expression "CPU.Flags-On"   ══════════════
    Std
    Cld
    Stc
    Clc
  ForwdFar:
    Cli
    Sti
    Loop FarBack
;════════  The preceding Loop builds a 7 byte instruction sequence   ════════

    Jmp Finish

  AsmLabel:
    Call AsmProc
    Jmp PasLabel
;═════════  A Pascal Label can be the target of an Assembly "Jmp"   ═════════

   AsmProc:
     Mov Cx,3    ; Initialize Cx for the Loop
     Ret

   Finish:
  END;  {Assemble}
  Exit;

PasForward:
  WRITELN('This Pascal Label defines a callable "Procedure" terminated');
  WRITELN('by the Inline/Assembly Directive "NearRet";  Counter = ',TestW);
  NearRet;

End; {SubTest}

BEGIN
  SubTest;
End; {TestProc}

Procedure FwdProc; BEGIN WriteLn('FwdProc'); END;

BEGIN
  TestProc;
END.