home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / TP_TSR.ZIP / DOS21_0A.PAS < prev    next >
Pascal/Delphi Source File  |  1989-02-11  |  9KB  |  239 lines
  1. {═════════════════════════════ DOS21_0A.PAS ══════════════════════════════}
  2. { ─────────  Turbo 4.0/5.0 stay-resident demonstration program  ───────── }
  3. {                 Copyright (c) 1989  Richard W. Prescott                 }
  4. { This Unit contains the assembly code for the basic interrupt routine,   }
  5. { which is installed automatically by the Unit Initialization code.  The  }
  6. { original interrupt vector is stored in the current Code segment, which  }
  7. { simplifies chaining to the original interrupt routine.  This routine    }
  8. { traps only function $0A (Buffered Input), chaining to the original      }
  9. { interrupt $21 vector for all other function requests.  The assembly     }
  10. { code issues a FAR Call via the Pointer variable PascalCode, which must  }
  11. { be initialized to point to an appropriate interrupt service routine.    }
  12. {═════════════════════════════════════════════════════════════════════════}
  13. { This Unit was compiled and assembled using Turbo Pascal Version 5.0     }
  14. { and TP&Asm Version 2 ß.  TP&Asm provides an integrated compile-time     }
  15. { assembler within the Turbo development environment (and the command     }
  16. { line compiler TPC), resulting in an ASSEMBLY Development Environment    }
  17. { which is identical to your PASCAL Development Environment.              }
  18. {                                                                         }
  19. { TP&Asm Version 2.0 will be available from me for $49 plus $3 P&H.  The  }
  20. { current Beta Test Version 2 ß is available now for $39 plus $3 P&H,     }
  21. { with a free upgrade to 2.0 when it becomes available.                   }
  22. {          Please see the README file for further information.            }
  23. {═════════════════════════════════════════════════════════════════════════}
  24.  
  25. Unit DOS21_0A;
  26.  
  27. INTERFACE
  28.  
  29. PROCEDURE IRestore;
  30. PROCEDURE IReturn;
  31. PROCEDURE IChain;
  32.  
  33. TYPE
  34.   UserRegs = RECORD
  35.     CASE INTEGER OF
  36.       0: (Ax,Bx,Cx,Dx,Si,Ds,Di,Es,Bp,Ip,Cs,Flags: WORD);
  37.       1: (Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh : BYTE);
  38.   END; {UserRegs}
  39. VAR
  40.   PascalCode: Pointer;
  41.   UserSP,UserSS: WORD;
  42.   User: ^UserRegs absolute UserSP;
  43. CONST
  44.   CommandSig: WORD = 0;
  45.  
  46. {═══════════════════════════════ SetSpLow ════════════════════════════════}
  47. { Simple inline directive used in Shell to insure that "resident" stack   }
  48. { doesn't overlay the Exec Return.                                        }
  49. {═══════════════════════════════ SetSpLow ════════════════════════════════}
  50. PROCEDURE SetSpLow;  Asm Mov Sp,$180;  {- Inline Directive -}
  51.  
  52.  
  53. {═════════════════════════════ DefaultDrive ══════════════════════════════}
  54. { Returns the default drive as a capital letter.                          }
  55. {═════════════════════════════ DefaultDrive ══════════════════════════════}
  56. FUNCTION DefaultDrive: CHAR;   {- Inline Directive -}
  57.   ASSEMBLE 
  58.     Mov Ah,$19
  59.     Int $21
  60.     Add Al,$41
  61.   END; {Assemble}
  62.  
  63. {═════════════════════════ FreeEnvironmentBlock ══════════════════════════}
  64. { Reduces resident memory usage by freeing the environment block for use  }
  65. { by the next process.                                                    }
  66. {═════════════════════════ FreeEnvironmentBlock ══════════════════════════}
  67. PROCEDURE FreeEnvironmentBlock;  {- Inline Directive -}
  68. ASSEMBLE
  69.   Push PrefixSeg
  70.   Pop Es
  71.   Mov Bx,$2C  ;Addr of Environment Seg
  72.   Mov Es,Es:[Bx] ;Seg to release
  73.   Mov Ah,$49
  74.   Int $21
  75. END; {Assemble}
  76.  
  77.  
  78. IMPLEMENTATION
  79.  
  80. CONST
  81.   ActiveFlag: BOOLEAN = FALSE;
  82.  
  83.  
  84. {════════════════════════════════ CsData ═════════════════════════════════}
  85. { The CSDATA construct is used to store data in the current Code Segment. }
  86. { The original interrupt address Dos21Vec MUST be stored in this Code     }
  87. { Segment to allow Chaining to the original interrupt routine with all of }
  88. { the User Registers intact. (The remaining variables COULD be stored in  }
  89. { the Data Segment and referenced after "Mov Ax,SEG Data" & "Mov Ds,Ax"). }
  90. { CsData Variables are available throughout the current Unit.             }
  91. {════════════════════════════════ CsData ═════════════════════════════════}
  92. CsData
  93.   Dos21Vec Dd 0
  94.   OurDs Dw 0
  95.   OurSs Dw 0
  96.   OurSp Dw 0
  97.   OurBp Dw 0
  98. END; {CsData}
  99.  
  100. {═════════════════════════════════ IHook ═════════════════════════════════}
  101. { This is the assembly portion of the interrupt service routine.          }
  102. { For function requests other than $0A, chain to the original interrupt   }
  103. { using an indirect jump to the address Dos21Vec stored in this Code      }
  104. { Segment.  For $0A, save registers, then restore Ds (stored in this Code }
  105. { Segment) and check ActiveFlag to avoid re-entrancy.  If not active,     }
  106. { save user stack frame and restore the Turbo program stack frame.        }
  107. { Finally, issue an indirect call to the address stored in the Pointer    }
  108. { PascalCode.  An ordinary return from PascalCode results in an automatic }
  109. { chain to the original interrupt.  (But see also IReturn and IChain).    }
  110. { ── The Pascal code for the Interrupt Service must be a FAR Procedure ── }
  111. {═════════════════════════════════ IHook ═════════════════════════════════}
  112. PROCEDURE IHook; Forward;
  113. Internal Hook;
  114. ;- Use INTERNAL to eliminate standard Pascal Startup Code
  115.  
  116. CODE    SEGMENT 
  117.  
  118. IHook  Proc Near
  119.   Cmp Ah,0A
  120.   IF NE Jmp Dos21Vec ;- (TP&Asm generates an automatic Cs override)
  121.   Push Bp,Es,Di,Ds,Si,Dx,Cx,Bx,Ax
  122.  
  123.   Mov Ax,Ds        ; Store user signature in Ax
  124.  
  125.   Mov Ds,OurDs     ; Restore Our Ds
  126.  
  127.   Cmp CommandSig,0 ; First Call is from COMMAND.COM ... Store Signature
  128.   IF Z Mov CommandSig,Ax
  129.   Cmp ActiveFlag,0 ;NOW check Flag stored in our DS
  130.   jNZ Chain
  131.   Inc ActiveFlag   ; =1 until Resume
  132.  
  133.   Mov UserSS,Ss    ; Save User Stack Ss:Sp in Our Ds
  134.   Mov UserSP,Sp    ;  (other registers stored on User Stack)
  135.   Mov Ss,OurSs     ; Switch to Our Stack Frame
  136.   Mov Sp,OurSp
  137.   Mov Bp,OurBp
  138.  
  139.   Call PascalCode  ; pointer to Pascal Service Routine
  140.  
  141.   Mov Ss,UserSS    ; Restore User Stack Ss:Sp From Our Ds
  142.   Mov Sp,UserSP
  143.   Mov ActiveFlag,0 ; Reset Flag stored in our DS
  144. Chain:
  145.   Pop  Ax,Bx,Cx,Dx,Si,Ds,Di,Es,Bp  ;Restore user registers
  146.   Jmp Dos21Vec
  147. IHook ENDP
  148. CODE ENDS
  149. END; {INTERNAL Hook} 
  150.  
  151.  
  152. {═════════════════════════════════ IInit ═════════════════════════════════}
  153. { Store Turbo program registers Ds, Ss, Sp, and Bp, and the current value }
  154. { of the interrupt $21 vector, in the current Code Segment.  Set the new  }
  155. { value of the interrupt $21 vector to point to INTERNAL Procedure IHook. }
  156. {═════════════════════════════════ IInit ═════════════════════════════════}
  157. PROCEDURE IInit;
  158. {$S-} BEGIN {$S+}   {- Don't generate Stack check code -}
  159. ASSEMBLE
  160.  
  161.   Mov OurDs,Ds
  162.   Mov OurSs,Ss
  163.   Mov OurSp,Sp
  164.   Mov OurBp,Bp
  165.  
  166.   Mov Ax,03521          ; Get Interrupt into Es:Bx
  167.   Int 021               ;-Store in Code Seg to allow Chaining
  168.   Mov W Dos21Vec,Bx     ; This Assembly Reference will link in CsData
  169.   Mov W Dos21Vec+2,Es
  170.  
  171.   Mov Ax,02521          ; Set Interrupt to Ds:Dx
  172.   Push Cs
  173.   Pop Ds
  174.   Mov Dx,Offset IHook   ; This Assembly Reference will link in IHook
  175.   Int 021
  176.   Mov Ds,OurDs
  177.  
  178.   END; {Assemble}
  179. END; {PROCEDURE IInit}
  180.  
  181.  
  182. {═══════════════════════════════ IRestore ════════════════════════════════}
  183. { Restore the interrupt $21 vector to the value saved during IInit.  See  }
  184. { the Procedure Shell in CMDQ.PAS.                                        }
  185. {═══════════════════════════════ IRestore ════════════════════════════════}
  186. PROCEDURE IRestore;
  187. {$S-} BEGIN {$S+}   {- Don't generate Stack check code -}
  188. ASSEMBLE
  189.   Mov Ax,02521  ; Set Interrupt to Ds:Dx
  190.   Push Ds
  191.   Lds Dx,Dos21Vec
  192.   Int 021
  193.   Pop Ds
  194.   END; {Assemble}
  195. END; {IRestore;}
  196.  
  197.  
  198. {════════════════════════════════ IReturn ════════════════════════════════}
  199. { Set Inactive Flag, restore user registers, and return from interrupt.   }
  200. { May be called from within nested procedures.  User registers may be     }
  201. { inspected/modified before return via the User^ record (User^.Bx, etc).  }
  202. {════════════════════════════════ IReturn ════════════════════════════════}
  203. PROCEDURE IReturn;
  204. {$S-} BEGIN {$S+}   {- Don't generate Stack check code -}
  205. ASSEMBLE
  206.   Mov Ss,UserSS                   ;Restore User Stack Ss:Sp From Our Ds
  207.   Mov Sp,UserSP
  208.   Mov ActiveFlag,0                ;Reset Flag stored in our DS
  209.   Pop Ax,Bx,Cx,Dx,Si,Ds,Di,Es,Bp  ;Restore user registers
  210.   Iret
  211.   END; {Assemble}
  212. END; {IReturn;}
  213.  
  214.  
  215. {════════════════════════════════ IChain ═════════════════════════════════}
  216. { Set Inactive Flag, restore user registers, and jump to old interrupt.   }
  217. { May be called from within nested procedures.  User registers may be     }
  218. { inspected/modified before chain via the User^ record (User^.Bx, etc).   }
  219. {════════════════════════════════ IChain ═════════════════════════════════}
  220. PROCEDURE IChain;
  221. {$S-} BEGIN {$S+}   {- Don't generate Stack check code -}
  222. ASSEMBLE
  223.   Mov Ss,UserSS                   ;Restore User Stack Ss:Sp From Our Ds
  224.   Mov Sp,UserSP
  225.   Mov ActiveFlag,0                ;Reset Flag stored in our DS
  226.   Pop Ax,Bx,Cx,Dx,Si,Ds,Di,Es,Bp  ;Restore user registers
  227.   Jmp Dos21Vec
  228.   END; {Assemble}
  229. END; {IChain;}
  230.  
  231.  
  232. {═════════════════════════════ Initialiation ═════════════════════════════}
  233. { Automatically install interrupt system.                                 }
  234. {═════════════════════════════ Initialiation ═════════════════════════════}
  235. BEGIN
  236.   IInit;
  237. END.
  238.  
  239.