Topspeed_JPI/TS-V3/EXAMPLES/INT24.LST

Listing:

    1  IMPLEMENTATION MODULE Int24 ;
    2  (*========================================================
    3  == TopSpeed Modula-2 V3                                 ==
    4  == demo program:                                        ==
    5  ==                                                      ==
    6  ==        Int24 handler                                 ==
    7  ==                                                      ==
    8  == Skeleton handler for "critical errors"               ==
    9  ==                                                      ==
   10  ========================================================*)
   11  (*# check(stack=>off,index=>off,range=>off,overflow=>off,nil_ptr=>off) *)
   12  
   13  (* Example of defining an interrupt handler in Modula-2 *)
   14  
   15  IMPORT SYSTEM,Lib,Str ;
   16  
   17  CONST
   18    ContinueProg = FALSE;    (* Set this to TRUE if you want to continue
   19                                after an abort (returning 255 to the
   20                                calling program).
   21                                If ContinueProg is set to FALSE then the
   22                                program will terminate on 'abort' *)
   23  
   24  (*----------------------------------------------------------------------*)
   25  
   26  (* These are "safe" version of IO routines,
   27     i.e. they do not call any  DOS function > 12
   28     Alternatively "Window" routines could be used.
   29  *)
   30  
   31  PROCEDURE WrStr(string: ARRAY OF CHAR);
*****                                   ^ not supported yet
   32  VAR R : SYSTEM.Registers;
*****                 ^ not supported yet
   33      i : CARDINAL;
   34  BEGIN
   35    i := 0;
   36    WHILE (i<SIZE(string))AND(string[i]<>CHR(0)) DO
*****             ^ undeclared identifier
*****                  ^ not supported yet
*****                              ^ not supported yet
*****                                      ^ not supported yet
*****                                         ^ undeclared identifier
*****                                              ^ not supported yet
   37      R.DL := SHORTCARD(string[i]);
*****      ^ not supported yet
*****        ^ not supported yet
*****                        ^ not supported yet
*****                                ^ not supported yet
   38      R.AH := 6;
*****      ^ not supported yet
*****        ^ not supported yet
   39      Lib.Intr( R ,21H ); (* Don't use Lib.Dos as this will trigger
*****      ^ not supported yet
*****          ^ not supported yet
*****                ^ not supported yet
*****                       ^ not supported yet
   40                             re-entered check *)
   41      INC(i);
*****      ^ undeclared identifier
*****           ^ not supported yet
   42    END;
   43  END WrStr;
*****      ^ not supported yet
   44  
   45  PROCEDURE WrLn;
   46  TYPE
   47    a3 = ARRAY [0..1] OF CHAR;
*****                   ^ not supported yet
*****                         ^ not supported yet
   48  CONST
   49    crlf = a3(CHR(13),CHR(10));
*****              ^ undeclared identifier
*****                    ^ not supported yet
*****                      ^ undeclared identifier
*****                            ^ not supported yet
   50  BEGIN
   51    WrStr( crlf );
*****    ^ not supported yet
*****                ^ not supported yet
   52  END WrLn;
*****      ^ not supported yet
   53  
   54  PROCEDURE RdKey(): CHAR;
   55  VAR R : SYSTEM.Registers;
*****                 ^ not supported yet
   56  BEGIN
   57    R.AH := 7;
*****    ^ not supported yet
*****      ^ not supported yet
   58    Lib.Intr( R ,21H ); (* Don't use Lib.Dos as this will trigger
*****    ^ not supported yet
*****        ^ not supported yet
*****              ^ not supported yet
*****                     ^ not supported yet
   59                           re-entered check *)
   60    RETURN CHAR(R.AL);
*****                ^ not supported yet
*****                  ^ not supported yet
   61  END RdKey;
*****      ^ not supported yet
   62  
   63  (*----------------------------------------------------------------------*)
   64  (* The pop stack inline code is required if the program should
   65     continue after an abort (returning 255 to the calling program).
   66  *)
   67  
   68  TYPE
   69    Code26 = ARRAY[0..25] OF SHORTCARD ;
*****                      ^ not supported yet
*****                             ^ not supported yet
   70  
   71  (*# save,
   72      call( reg_saved=>(dx,ax,bx,cx,si,di,es,ds,st1,st2),
   73            inline=>on )
   74  *)
   75  
   76  PROCEDURE PopStack()=Code26(
*****                       ^ not supported yet
   77         08BH,0E5H,           (*  mov   sp,bp           *)
   78         083H,0C4H,01CH,      (*  add   sp,1CH          *)
   79         058H,                (*  pop   ax              *)
   80         05BH,                (*  pop   bx              *)
   81         059H,                (*  pop   cx              *)
   82         05AH,                (*  pop   dx              *)
   83         05EH,                (*  pop   si              *)
   84         05FH,                (*  pop   di              *)
   85         058H,                (*  pop   ax              *)
   86         01FH,                (*  pop   ds              *)
   87         007H,                (*  pop   es              *)
   88         08BH,0ECH,           (*  mov   bp,sp           *)
   89         080H,04EH,004H,001H, (*  or    byte [bp][4],1  *)
   90         08BH,0E8H,           (*  mov   bp,ax           *)
   91         0B8H,0FFH,000H,      (*  mov   ax,0FFH         *)
   92         0CFH);               (*  iret                  *)
   93  
   94  
   95  (*----------------------------------------------------------------------*)
   96  (* Actual Int24 Interrupt Handler
   97  *)
   98  
   99  (* pragmas for interrupt handler *)
  100  (*# save,
  101      call(interrupt => on,
  102           reg_param => (),
  103           same_ds   => off
  104          )
  105  *)
  106  
  107  (* NB, The interrupt pragma sets up the registers as parameters to the
  108         procedure in the order defined below. This allows easy access to
  109         the entry registers
  110  *)
  111  PROCEDURE Irpt24 ( Flags : BITSET;        (* Registers on entry *)
*****                             ^ undeclared identifier
  112                     CS,IP : CARDINAL;
  113                     AX,CX : CARDINAL;
  114                     DX,BX : CARDINAL;
  115                     SP,BP : CARDINAL;
  116                     SI,DI : CARDINAL;
  117                     DS,ES : CARDINAL ) ;
  118  VAR
  119      s       : ARRAY[0..40] OF CHAR ;
*****                         ^ not supported yet
*****                                ^ not supported yet
  120      k       : CHAR ;
  121      saveipf : BOOLEAN ;
  122      P_AL    : POINTER TO SHORTCARD;
*****                           ^ not supported yet
  123  BEGIN
  124    (* N.B. Only DOS functions <= 12 may be called from a critical
  125       error handler
  126    *)
  127    CASE DI OF
  128    0 : s := 'Disk write protected' |
*****        ^ not supported yet
*****             ^ not supported yet
  129    2 : s := 'Drive not ready'      |
*****        ^ not supported yet
*****             ^ not supported yet
  130    9 : s := 'Printer out of paper' |
*****        ^ not supported yet
*****             ^ not supported yet
  131    ELSE
  132      s := 'Disk error' ;
*****      ^ not supported yet
*****           ^ not supported yet
  133    END ;
  134    Str.Append(s,'. Abort, Retry, Ignore?');
*****    ^ not supported yet
*****        ^ not supported yet
*****               ^ not supported yet
*****                 ^ not supported yet
  135    WrStr(s) ; WrLn ;
*****    ^ not supported yet
*****          ^ not supported yet
*****               ^ not supported yet
  136    REPEAT
  137      k := CAP(RdKey()) ;
*****           ^ undeclared identifier
*****               ^ not supported yet
*****                     ^ not supported yet
  138    UNTIL (k='R') OR (k='I') OR (k='A') ;
  139    P_AL := ADR(AX);
*****    ^ not supported yet
*****            ^ undeclared identifier
*****                  ^ not supported yet
  140    IF k='I'    THEN P_AL^ := 0 ;  (* ignore *)
*****                     ^ not supported yet
  141    ELSIF k='R' THEN P_AL^ := 1 ;  (* retry  *)
*****                     ^ not supported yet
  142    ELSE                           (* abort  *)
  143      IF ContinueProg THEN
*****         ^ not supported yet
  144        PopStack; (* Removes MSDOS call frame and Return 255 to caller *)
*****        ^ not supported yet
  145        (* Does not return here *)
  146      ELSE
  147        HALT ;
*****        ^ undeclared identifier
  148      END ;
  149    END ;
  150  END Irpt24;
*****      ^ not supported yet
  151  (*# restore *)
  152  
  153  
  154  VAR
  155    Int24Vec[0:24H*4]   : FarADDRESS;
*****             ^ not supported yet
*****                   ^ not supported yet
*****                          ^ undeclared identifier
  156  VAR
  157    h : CARDINAL;
  158  BEGIN
  159    SYSTEM.DI ;
*****    ^ not supported yet
*****           ^ not supported yet
  160    (* Install interrupt 24 *)
  161    Int24Vec := FarADR(Irpt24) ;
*****    ^ not supported yet
*****                ^ undeclared identifier
*****                       ^ not supported yet
  162    SYSTEM.EI ;
*****    ^ not supported yet
*****           ^ not supported yet
  163  END Int24.
*****      ^ not supported yet

   85 errors