home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / bbs / pibterm / pibt3sp1 / int24.pas < prev    next >
Pascal/Delphi Source File  |  1985-08-23  |  4KB  |  138 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         Int24, Int24ON, Int24OFF, --- handle critical DOS errors     *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. (*----------------------------------------------------------------------*)
  6. (*                                                                      *)
  7. (*     Remarks:                                                         *)
  8. (*                                                                      *)
  9. (*        This code is slightly modified from some written by Bela      *)
  10. (*        Lubkin.                                                       *)
  11. (*                                                                      *)
  12. (*----------------------------------------------------------------------*)
  13.  
  14. CONST
  15.  
  16.    INT24Err     : BOOLEAN = FALSE;
  17.    INT24ErrCode : BYTE    = 0;
  18.    OldINT24     : ARRAY[1..2] OF INTEGER = (0,0);
  19.  
  20. VAR
  21.    RegisterSet: RegPack;
  22.  
  23. (*----------------------------------------------------------------------*)
  24. (*         Int24 --- set up DOS Interrupt 24 critical error handler     *)
  25. (*----------------------------------------------------------------------*)
  26.  
  27. PROCEDURE Int24;
  28.  
  29. BEGIN (* Int24 *)
  30.  
  31.    INLINE
  32.      ($2E/$C6/$06/ INT24Err /$01/$89/$EC/$83/$C4/$08/$89/$F8/$2E/$A2/
  33.       INT24ErrCode /$58/$B0/$FF/$5B/$59/$5A/$5E/$5F/$5D/$1F/$07/$CF);
  34.     { Turbo:  PUSH BP                    (Save caller's stack frame
  35.               MOV  BP,SP                   Set up this procedure's stack frame
  36.               PUSH BP                     ?)
  37.       Inline: MOV  BYTE CS:[INT24Err],1  Set INT24Err to True
  38.               MOV  SP,BP                 Get correct SP;  ADD: Discard saved
  39.               ADD  SP,8                    BP, INT 24 return address & flags
  40.               MOV  AX,DI                 Get INT 24 error code
  41.               MOV  CS:[INT24ErrCode],AL  Save it in INT24ErrCode
  42.               POP  AX                    Pop all registers
  43.               MOV  AL,0FFH               Set FCB call error flag:
  44.               POP  BX                      will cause Turbo I/O error on file
  45.               POP  CX                      operations, no error on character
  46.               POP  DX                      operations
  47.               POP  SI
  48.               POP  DI
  49.               POP  BP
  50.               POP  DS
  51.               POP  ES
  52.               IRET                       Return to next instruction }
  53.  
  54. End   (* Int24 *);
  55.  
  56. (*----------------------------------------------------------------------*)
  57. (*              Int24ON --- Turn ON handling of interrupt 24            *)
  58. (*----------------------------------------------------------------------*)
  59.  
  60. PROCEDURE Int24On;
  61.  
  62. BEGIN (* Int24ON *)
  63.  
  64.    INT24Err:=False;
  65.  
  66.    WITH RegisterSet DO
  67.       BEGIN
  68.  
  69.          AX:=$3524;
  70.  
  71.          MsDos(RegisterSet);
  72.  
  73.          IF ( OldINT24[1] OR OldINT24[2] ) = 0 THEN
  74.             BEGIN
  75.                OldINT24[1] := ES;
  76.                OldINT24[2] := BX;
  77.             END;
  78.  
  79.          DS := CSeg;
  80.          DX := Ofs(INT24);
  81.          AX := $2524;
  82.  
  83.          MsDos( RegisterSet );
  84.  
  85.      END;
  86.  
  87. END   (* Int24ON *);
  88.  
  89. (*----------------------------------------------------------------------*)
  90. (*             Int24OFF --- Turn OFF handling of interrupt 24            *)
  91. (*----------------------------------------------------------------------*)
  92.  
  93. PROCEDURE Int24OFF;
  94.  
  95. BEGIN (* Int24OFF *)
  96.  
  97.    INT24Err:=False;
  98.  
  99.    IF ( OldINT24[1] <> 0 ) THEN
  100.       WITH RegisterSet DO
  101.          BEGIN
  102.  
  103.             DS := OldINT24[1];
  104.             DX := OldINT24[2];
  105.             AX := $2524;
  106.  
  107.             MsDos( RegisterSet );
  108.  
  109.          END;
  110.  
  111.     OldINT24[1] := 0;
  112.     OldINT24[2] := 0;
  113.  
  114. END   (* Int24OFF *);
  115.  
  116. (*----------------------------------------------------------------------*)
  117. (*      Int24Result --- Check for Turbo I/O or critical DOS error       *)
  118. (*----------------------------------------------------------------------*)
  119.  
  120. FUNCTION INT24Result: INTEGER;
  121.  
  122. VAR
  123.    I : INTEGER;
  124.  
  125. BEGIN (* INT24Result *)
  126.  
  127.    I := IOResult;
  128.  
  129.    IF INT24Err THEN
  130.       BEGIN
  131.          I := I + 256 * INT24ErrCode;
  132.          INT24On;
  133.       END;
  134.  
  135.    INT24Result := I;
  136.  
  137. END   (* INT24Result *);
  138. ə