Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/INTR_DMO.ZIP/INTR.PAS

Pascal/Delphi Source File | 1985-11-19 | 15.5 KB | 428 lines

Program Demonstrate_Interrupt_Handlers;

{ This program is placed in the public domain by Steve Wood, author of
  the book Using Turbo Pascal, published by Osborne McGraw-Hill. }

{ Compile as a .COM program with segment sizes specified as follows:
  For cOde enter 320
  For Data enter 790
  For mAx  enter 400
  For mIn  enter 400 }

{$V-}  { These compiler directives should not be changed }
{$K-}
{$C-}
{$R-}

{$I STD-ATTR.INC}  { Video addresses and attribute control routines. }
{$I STD-CTV.INC}   { Standard global constants, types and variables. }
{$I PLS-UTIL.INC}  { Misc. global procedures and functions. }
{$I PLS-INP.INC}   { Controlled input and related routines. }
{$I PLS-DISP.INC}  { Video display and related routines. }
{$I DEMO-CTV.INC}  { Constants, types and vars specific to this program. }

const INTR_VECTOR = $80; { Defines the interrupt vector for the
                           interrupt routine being defined.
                           Be sure it does not conflict with
                           other interrupt drivers that have
                           been or will be installed. }

{ Typed constants hold values pertinent to the calling
  program (hold_xxx) and the interrupt program (new_xxx). }

      hold_sseg   : Integer = ZERO;
      hold_sp     : Integer = ZERO;
      new_dseg    : Integer = ZERO;
      new_sseg    : Integer = ZERO;
      new_sp      : Integer = ZERO;
      mem_size    : Integer = $11B0;  { Indicates the amount of memory
                                        ( in 16 byte paragraphs )
                                        to be reserved for the resident
                                        interrupt handler. This should
                                        be equal or greater than the sum
                                        of the code segment size, data
                                        segment size and heap/stack size,
                                        all of which must be specified
                                        when the program is compiled. }

      NOTICE : Str_40 = 'copyright 1985 precision logic systems';

var   ms_reg      : RegPack;
      hold_image  : Scrn_Image;

procedure Clear_Reg(var regs: RegPack);

  begin
    FillChar(regs, sizeof(regs), ZERO);
  end;  { Clear_Reg }

procedure NumLock_On;

{ This procedure is not used in this program. I left it in because
  it illustrates how Turbo can be used to control the hardware at
  the lowest levels and felt you would find it of interest. SW }

  const NUMLOCK_ON    = $20;

  var   kbd_stat   : byte absolute $0000:$0417; { Keyboard status byte }

  begin
    kbd_stat := (kbd_stat or NUMLOCK_ON);  { Set bit 5 forcing NumLock On }
  end; { NumLock_On }

procedure Demo_Menu; { This is the procedure that is activated by
                       interrupt $80. }

  procedure Initialize;
    begin
      usr_ptr[1] := Ofs(Usr_Out_Driver);  { Install Usr_Out_Driver as the }
      usr_ptr[2] := Cseg;                 { Usr device driver.            }
      vid_attr := BRIGHT_VID;
      Load_Screen('PLS-MENU' + SCR_EXT,menu_buf);
      Get_System_Date;
      end_session := FALSE; esc_flag := FALSE; err_flag := FALSE;
      help_flag := FALSE; msg_on := TRUE;
      Load_Screen('PLS-PRMT' + SCR_EXT,prompt_dat);
    end; { Initialize }

{ The following procedures do not have to be overlay procedures. This
  was done to illustrate the little known fact that interrupt handlers
  can contain overlays. This means that a memory resident interrupt handler
  need not be truly memory resident and its size is unlimited for all
  practical purposes. }

  overlay procedure Not_Available;
    begin
      Disp_Prompt(MSG_BOX_PROMPT);
      Display_Prompt(PROMPT_LINE,'MSG','Selection not yet available. Press'
                                        + ENTER_KEY);
      repeat Read_Kbd(inchr,inctl) until (inctl = CR);
    end; { Not_Avaliable }

  overlay procedure Input_Demo_Data;

    var valid_set : Any_Char;

    function Current_Value(field: Byte): Str_80;
      var num_str : Str_20;
          len     : Byte;

      begin
        Current_Value := NULL_STR;
        len := fld_dat[field].fld_len;
        with demo, fld_dat[field] do
          case field of
            1    : Current_Value := name;
            2    : Current_Value := addr.attn;
            3    : Current_Value := addr.addr;
            4    : Current_Value := addr.city;
            5    : Current_Value := addr.state;
            6    : Current_Value := addr.zip1;
            7    : Current_Value := addr.zip2;
            8    : begin
                     if (phone.area > ZERO) then
                       Str(phone.area:3,num_str)
                     else
                       num_str := NULL_STR;
                     Current_Value := num_str;
                   end;
            9    : begin
                     if (phone.prefix > ZERO) then
                       Str(phone.prefix:3,num_str)
                     else
                       num_str := NULL_STR;
                     Current_Value := num_str;
                   end;
            10   : begin
                     if (phone.number > ZERO) then
                       Str(phone.number:4,num_str)
                     else
                       num_str := NULL_STR;
                     Current_Value := num_str;
                   end;
          end; {case}
      end; { Current_Value }

      procedure Disp_Field_Value(field: Byte);
        var fld_str : Str_80;

        begin
          fld_str := Current_Value(field);
          if fld_str <> NULL_STR then
            with fld_dat[field] do
            begin  { Display fld_str and clear to end of field. }
              GoTo_XY(xloc,yloc); Write_Usr_Str(fld_str);
              Repeat_Usr_Char(SPACE,(fld_len - Length(fld_str)));
            end
          else
            Init_Field(FILL_CHAR,fld_dat[field],fld_dat[field].disp_attr);
        end; { Disp_Field_Value }

      procedure Display_Current_Values;
        var  fld_no  : Byte;

        begin
          cur_scrn := buf_scrn;
          for fld_no := 1 to fld_cnt do
            Disp_Field_Value(fld_no);
        end; { Display_Current_Values }

    procedure Update_Demo_File;
      begin
        Seek(demo_file,ZERO);
        Write(demo_file,demo);
        modified := FALSE;
      end; { Update_Parm_File }

    procedure Modify_Demo(fld_no,last_fld: Byte);

      procedure Input_Field;
        var parms     : Fld_Parms;
            err_msg,
            cmd_msg   : Str_80;
            len, i    : Byte;

        procedure Display_Default;
          begin
             vid_attr := REVERSE_VID;
            with parms do
            begin
              GoTo_XY(xloc,yloc);
              Write_Usr_Str(default);
              Repeat_Usr_Char(SPACE,fld_len - Length(default));
              vid_attr := BRIGHT_VID;
              GoToXY(xloc,yloc);
            end; {with}
          end; { Display_Default }

        begin { Input_Field }
          default := Current_Value(fld_no);
          Disp_Prompt(FLD_INP_PROMPT);
          GoTo_XY(7,MSG_LINE);
          Write_Usr_Str(default);
          parms := fld_dat[fld_no];
          len := parms.fld_len;
          Display_Default;
          with demo do
          case fld_no of
               1    : name := Valid_Str(parms);
               2    : addr.attn := Valid_Str(parms);
               3    : addr.addr := Valid_Str(parms);
               4    : addr.city := Valid_Str(parms);
               5    : addr.state := Valid_Str(parms);
               6    : addr.zip1 := Valid_Str(parms);
               7    : addr.zip2 := Valid_Str(parms);
               8    : phone.area := Valid_Int(parms,0,999);
               9    : phone.prefix := Valid_Int(parms,0,999);
               10   : phone.number := Valid_Int(parms,0,9999);
             end; {case}
          Disp_Field_Value(fld_no);  { Redisplay formated input }
        end; { Input_Field }

      begin { Modify_Demo }
        modified := TRUE;
        accepted := FALSE;
        repeat
          Input_field;
          if help_flag then
            begin
              Load_Screen('DEMO-HLP' + SCR_EXT,help_buf);
              Disp_Help(1,5,18,[ESC]);
              help_flag := FALSE;
            end;
          fld_no := fld_no + direction;
          if (fld_no < 1) then
            fld_no := 1;
        until (accepted  or esc_flag) or (fld_no > last_fld);
        if esc_flag then
          esc_flag := FALSE;
        if accepted then
          Update_Demo_File;
      end; { Modify_Demo }

      procedure Select_Field;
        const  parms: Fld_Parms = (xloc      : 38;
                                   yloc      : PROMPT_LINE;
                                   fld_len   : 2;
                                   fld_type  : NUMERIC;
                                   exit_type : MANUAL;
                                   inp_attr  : REVERSE_VID;
                                   disp_attr : BRIGHT_VID;
                                   msg_ptr   : 255);

        var i, fld_no  : Integer;
            hold_vid   : Inp_Scrn;
            prompt_msg : Str_80;

        begin  { Select_Field }
          hold_vid := cur_scrn;
          cur_scrn := buf_scrn;
          Rev_Video;
          for i := 1 to 10 do
            with fld_dat[i] do
            begin
              GoToXY(xloc,yloc);
              Write(SPACE,i,SPACE);
            end;
          Norm_Video;
          repeat
            Disp_Prompt(MSG_BOX_PROMPT);
            vid_line[25] := prompt_ln[20];
            prompt_msg := ('Enter field number. (1-10) ' + ARROW);
            Display_Prompt(PROMPT_LINE,'INP',prompt_msg);
            Init_Field(SPACE,parms,parms.inp_attr); default := '0';
            fld_no := Valid_Int(parms,1,10);
          until (fld_no in [1..10]) or esc_flag;
          if esc_flag then
            esc_flag := FALSE
          else
            begin
              cur_scrn := hold_vid;
              Modify_Demo(fld_no,10);
            end;
        end; { Select_Field }

    begin { Input_Demo_Data }
      usr_ptr[1] := Ofs(Usr_Out_Driver);  { Install Usr_Out_Driver as the }
      usr_ptr[2] := Cseg;                 { Usr video output driver.      }
      Load_Inp_Scrn('DEMO-INP' + SCR_EXT,hold_vid[1]);
      buf_scrn := vid_buf[1].buf_scrn;
      fld_dat := vid_buf[1].buf_parm;
      fld_cnt := fld_dat[72].fld_len;
      cur_scrn := buf_scrn;
      Disp_Prompt(ACCEPT_PROMPT); vid_line[25] := prompt_ln[19];
      GoTo_XY(3,1); Write_Usr_Str((SPACE + sys_date + SPACE));
      Assign(demo_file,'DEMO.DAT');
      Reset(demo_file);
      Read(demo_file,demo); modified := FALSE;
      FillChar(fld_msg,SizeOf(fld_msg),ZERO);
      Load_Fld_Msgs('DEMO.MSG');
      mode := UPDATE;
      repeat
        Display_Current_Values;
        Disp_Prompt(ACCEPT_PROMPT); vid_line[25] := prompt_ln[19];
        GoToXY(43,MSG_LINE);
        valid_set := (UPDT_SET + ACPT_SET) + (CANCEL_SET + HELP_SET);
        inctl := Valid_Key(valid_set);
        case inctl of
          UPDT_REC    : Modify_Demo(1,10);
          SLCT_FLD    : Select_Field;
          ACCEPT      : begin
                           Update_Demo_File;
                           esc_flag := TRUE;
                        end;
          ESC         : if modified then
                          Verify_Cancel
                        else
                          esc_flag := TRUE;
          HELP        : begin
                          Load_Screen('MENU-HLP.TSM',help_buf);
                          Disp_Help(13,13,10,[ESC]);
                        end;
        end;
      until (esc_flag or err_flag);
      esc_flag := FALSE;
      Close(demo_file);
    end; { Input_Demo_Data }

    begin { Demo_Menu }
      hold_image := vid_scrn;             { Save callers video screen image. }
      repeat
        Initialize;
        Disp_Menu('DEMO.MNU',' D E M O   M E N U ');
        GoToXY(65,21); Write(' End Session   ');
        GoToXY(22,PROMPT_LINE); esc_flag := FALSE;
        current_selection := Valid_Menu_Selection(6);
        if esc_flag then
          Verify_Exit;
        if end_session then
          begin
            ClrScr; WriteLn('Session ended.'); WriteLn;
          end
        else
          case current_selection of
            1       : Input_Demo_Data;
            2..6    : Not_Available;
                      { To make selections valid, insert procedures
                        as illustrated with case #1. }
          end; {case}
      until (end_session or err_flag);
      if err_flag then
        begin
         WriteLn; WriteLn; WriteLn;
         WriteLn('Session Terminated due to error indicated above.');
         Write('Press any key. '); Read(Kbd,inchr);
       end;
     vid_scrn := hold_image;          { Restore callers video screen image. }
    end; { Demo_Menu }

  procedure Save_Turbo_Values;

    begin
      new_dseg := Dseg;              { Save Dseg          }
      new_sseg := Sseg;              { Save Sseg          }
      inline($2E/$89/$26/new_sp);    { MOV [cs:new_sp],sp }
    end;  { Save_Turbo_Values }

  procedure Interrupt;

{ ***** This is the entry point for the interrupt handler ***** }

    begin
      inline($2E/$8C/$16/hold_sseg/ { Save current Sseg }
             $2E/$89/$26/hold_sp/   { Save current sp }
             $2E/$8E/$16/new_sseg/  { Point Sseg to new stack seg.}
             $2E/$8B/$26/new_sp);   { Points sp to new TOS }

      inline($50/$53/$51/$52/$57/$56/$06/$1E); { PUSH ax, bx, cx, dx,
                                                      di, si, es, ds }

      inline($2E/$A1/new_dseg/      { MOV ax,[cs:new_dseg] }
             $8E/$D8/               { MOV ds,ax      Point to new ds }
             $FB);                  { STI }

      Demo_Menu; { This may be replaced with any defined procedure identifier }

      inline($FA/                             { CLI }
             $1F/$07/$5E/$5F/$5A/$59/$5B/$58/ { POP  ds, es, si, di,
                                                     dx, cx, bx, ax }
             $2E/$8E/$16/hold_sseg/           { MOV  ss,[cs:hold_sseg] }
             $2E/$8B/$26/hold_sp/             { MOV  sp,[cs:hold_sp] }
             $5D/$5D/$CF);                    { POP return addr and IRET }

    end; { Interrupt }

{  The main program starts here. Its purpose is to install the address
   of Interrupt in the interrupt vector table as interrupt $80 and to
   allocate enough memory to make the program memory resident. When
   executed it will produce no visible results unless interrupt $80
   is already used. }

begin { Demonstrate_Interrupt_Handler }
  Save_Turbo_Values;   { So you can set up the environment in Interrupt. }
  with ms_reg do
  begin
    Clear_Reg(ms_reg); { Not absolutely necessary, but not a bad idea. }

{ Check to see if interrupt has already been installed. }

    ah := $35;  al := INTR_VECTOR; MsDos(ms_reg);
    if es <> $00 then
      begin
        WriteLn(' Interrupt handler already installed.');
        halt;                       { Quit if already installed }
      end;

{  Install Interrupt procedure address at interrupt vector INTR_VECTOR. }

    ah := $25; al := INTR_VECTOR;
    ds := Cseg; dx := Ofs(Interrupt);
    MsDos(ms_reg);

{ Make program memory resident reserving memory indicated by mem_size.}

    Clear_Reg(ms_reg);
    ax := $3100; dx := mem_size;  MsDos(ms_reg);
  end;  {with}
end. { Demonstrate_Interrupt_Handlers }