home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / modula / tsr.mod < prev   
Encoding:
Modula Implementation  |  1991-09-23  |  3.9 KB  |  178 lines
  1. (*========================================================*)
  2. (*                       TSR.MOD                          *)
  3. (*      Copyright (C) 1991 P. Engels & DOS-toolbox        *)
  4. (*--------------------------------------------------------*)
  5. (* Compiler: Topspeed Modula-2 Version 2.XX               *)
  6. (*========================================================*)
  7.  
  8. IMPLEMENTATION MODULE TSR;
  9.  
  10. (*# call (seg_name => null) *)
  11.  
  12. (*# data (seg_name => null) *)
  13.  
  14. (*# check (nil_ptr  => off,
  15.            index    => off,
  16.            stack    => off,
  17.            range    => off,
  18.            overflow => off),
  19.     debug (vid      => off) *)
  20.  
  21. FROM SYSTEM IMPORT Ret, Registers, HeapBase, A2;
  22. FROM Lib    IMPORT Intr, Dos, SetReturnCode, PSP, Speaker;
  23.  
  24. TYPE
  25.   A3      = ARRAY [0..2] OF SHORTCARD;
  26.  
  27. (*# save,
  28.     call (near_call  => off,
  29.           reg_param  => (ax),
  30.           reg_return => (ax)) *)
  31.  
  32.   KeyProc = PROCEDURE (CARDINAL): CARDINAL;
  33.  
  34. (*# restore *)
  35.  
  36. (*# data (volatile => on) *)
  37.  
  38. VAR
  39.   PopUpSSeg,
  40.   PopUpSOfs  : CARDINAL;
  41.   SystemSSeg,
  42.   SystemSOfs : CARDINAL;
  43.   PopUp_     : PROC;
  44.   HotKey_    : CARDINAL;
  45.   Int16Save  : KeyProc;
  46.  
  47. (*# save,
  48.     call (reg_return => (ax)) *)
  49.  
  50.   PROCEDURE SSeg(): CARDINAL = A3 (8CH, 0D0H, Ret);
  51.  
  52.   PROCEDURE SOfs(): CARDINAL = A3 (8BH, 0C4H, Ret);
  53.  
  54.   PROCEDURE BasePtr(): CARDINAL = A3 (8BH, 0C5H, Ret);
  55.  
  56. (*# call (inline => on) *)
  57.  
  58.   PROCEDURE GetFlags(): BITSET = A2 (9CH, 58H);
  59.  
  60. (*# call (inline => off) *)
  61.  
  62. (*# restore *)
  63.  
  64.   PROCEDURE RegisterOfs(): CARDINAL;
  65.   BEGIN
  66.     RETURN BasePtr() + 2
  67.   END RegisterOfs;
  68.  
  69.   PROCEDURE GetInt(nr: SHORTCARD;
  70.               VAR ISR: InterruptRoutine);
  71.   VAR
  72.     dummy: POINTER 0 TO InterruptRoutine;
  73.   BEGIN
  74.     dummy := NearADDRESS(CARDINAL(nr) << 2);
  75.     ISR := dummy^
  76.   END GetInt;
  77.  
  78.   PROCEDURE SetInt(nr: SHORTCARD;
  79.                   ISR: InterruptRoutine);
  80.   VAR
  81.     dummy: POINTER 0 TO InterruptRoutine;
  82.   BEGIN
  83.     dummy := NearADDRESS(CARDINAL(nr) << 2);
  84.     dummy^ := ISR
  85.   END SetInt;
  86.  
  87.   PROCEDURE Keep(ReturnCode: SHORTCARD);
  88.   VAR
  89.     r : Registers;
  90.   BEGIN
  91.     SetReturnCode(ReturnCode);
  92.     r.AH := 31H;
  93.     r.DX := HeapBase - PSP;
  94.     Dos(r)
  95.   END Keep;
  96.  
  97. (*# save,
  98.     call (inline    => on,
  99.           reg_saved => (ds),
  100.           reg_param => (ax)) *)
  101.  
  102.   PROCEDURE LoadSS (SS: CARDINAL) = A2 (8EH, 0D0H);
  103.  
  104.   PROCEDURE LoadSP (SP: CARDINAL) = A2 (8BH, 0E0H);
  105.  
  106.   PROCEDURE SwitchStack;
  107.   BEGIN
  108.     SystemSSeg := SSeg();
  109.     SystemSOfs := SOfs();
  110.     LoadSS(PopUpSSeg);
  111.     LoadSP(PopUpSOfs)
  112.   END SwitchStack;
  113.  
  114.   PROCEDURE SwitchBack;
  115.   BEGIN
  116.     LoadSS(SystemSSeg);
  117.     LoadSP(SystemSOfs)
  118.   END SwitchBack;
  119.  
  120. (*# restore *)
  121.  
  122. (*# save,
  123.     call (interrupt => on,
  124.           same_ds   => off,
  125.           near_call => off) *)
  126.  
  127.   PROCEDURE Int16;
  128.  
  129.   VAR
  130.     IntReg:    RegisterPtr;
  131.     CurrInt16: InterruptRoutine;
  132.     Read:      BOOLEAN;
  133.   BEGIN
  134.     IntReg := [SSeg() : RegisterOfs()];
  135.     WITH IntReg^ DO
  136.       Read := BITSET(AH)*BITSET(3) = {};
  137.       PushF;
  138.       AX := Int16Save(AX);
  139.       Flags := GetFlags();
  140.       IF Read THEN
  141.       Speaker(1000, 100);
  142.         IF (AX = HotKey_) THEN
  143.           SwitchStack;
  144.           GetInt(16H, CurrInt16);
  145.           SetInt(16H, InterruptRoutine(Int16Save));
  146.           PopUp_;
  147.           SetInt(16H, CurrInt16);
  148.           SwitchBack
  149.         END
  150.       END
  151.     END
  152.   END Int16;
  153.  
  154. (* restore *)
  155.  
  156.   PROCEDURE MakeResident(PopUp:  PROC;
  157.                          HotKey: CARDINAL);
  158.   BEGIN
  159.     PopUp_ := PopUp;
  160.     HotKey_ := HotKey;
  161.     GetInt(16H, InterruptRoutine(Int16Save));
  162.     SetInt(16H, Int16);
  163.     Keep(0)
  164.   END MakeResident;
  165.  
  166. BEGIN
  167.   PopUpSSeg := SSeg();
  168. (*%T _fcall*)
  169.   PopUpSOfs := SOfs() + 4;
  170. (*%E*)
  171. (*%F _fcall*)
  172.   PopUpSOfs := SOfs() + 2
  173. (*%E*)
  174. END TSR.
  175.  
  176. (*========================================================*)
  177. (*                   Ende von TSR.MOD                     *)
  178.