{$M 16384,1000,655360}
{$E+}
(*****************************************************************************
 *  This is the root module for the IOD48 board demonstartion for            *
 *  change of state interrupt programming.                                   *
 *****************************************************************************)

Uses Crt, DOS, IOD48FCT;

CONST
   PORT0A       = $0000;
   PORT0B       = $0001;
   PORT0C       = $0002;
   PORT0CONTROL = $0003;
   PORT1A       = $0004;
   PORT1B       = $0005;
   PORT1C       = $0006;
   PORT1CONTROL = $0007;
   COSENABLE    = $000B;
   CLRCOSINT    = $000F;

TYPE
   BYTELIST = array[0..5] of integer;

VAR
   IOD48      : integer;
   enum       : boolean;
   isr_flag   : integer;

(*****************************************************************************
 *  FUNCTION: signon -- local routine                                        *
 *  PURPOSE: To display an initial sign on message on the screen.           *
 *****************************************************************************)

Procedure signon;
begin
   ClrScr;
   gotoxy(6, 2);
   WriteLn('   I O D - 4 8 S   I N T E R R U P T   D E M O N S T R A T O R');
   gotoxy(33, 10);
   WriteLn(' PORT READING');
   gotoxy(5, 12);
   WriteLn('            PPI #0                                   PPI #1');
   gotoxy(5, 12);
   WriteLn(' PORTA      PORT B      PORT C          PORT A       PORT B       PORT C');
   gotoxy(1, 16);
   WriteLn('                          Flashing bits have changed!');
   gotoxy(1, 17);
   WriteLn('                          PRESS ANY KEY TO EXIT PROGRAM');
end;

(*****************************************************************************
 *  FUNCTION: write_port_data -- local routine                               *
 *  PURPOSE: Displays the current port values on the screen.  If a bit has  *
 *            changed, the bit is displayed flashing.                        *
 *****************************************************************************)

procedure write_port_data(var cur, comp : BYTELIST);
var
   x, index, index1, value : integer;

begin
   x := 5;   { x coordinate to write value to screen }
   for index := 0 to 5 do   { for each array member }
      begin
         value := cur[index];
         for index1 := 0 to 7 do   { for each bit in array member }
            begin
               { if not 0, then bit has changed, so write bit flashing }
               gotoxy(x, 14);
               if ((comp[index] mod 2) = 1) then
                  begin
                     textcolor(WHITE + BLINK);
                     if ((value mod 2) = 1) then write('1')
                     else write('0');
                  end
               else   { has not changed, write bit normally }
                  begin
                     textcolor(WHITE);
                     if ((value mod 2) = 1) then write('1')
                     else write('0');
                  end;
               comp[index] := comp[index] shr 1; { roll next compare bit}
               value := value shr 1;
               inc(x);
            end;
         x := x + 4;
         if (index = 2) then x := x + 5;  { extra display distance between each PPI}
      end;
   textcolor(LIGHTGRAY);
end;
{end write_port_data}

(*****************************************************************************
 *  FUNCTION: compare_ports -- local routine                                 *
 *  PURPOSE: Compares two sets of port readings passed to it.  The compare  *
 *            array will have a one in each bit position that has changed.   *
 *****************************************************************************)

procedure compare_ports(var cur, nw, comp : BYTELIST);
var
   index : integer;
begin
   for index := 0 to 5 do  { for each port }
      begin
         { does an XOR comparison which result will indicate bits that changed }
         comp[index] := cur[index] XOR nw[index];
         cur[index] := nw[index]; { set new values as current values }
      end;
end;

(*****************************************************************************
 *  FUNCTION: setflag -- global routine                                      *
 *  PURPOSE: This is The interrupt service routine.  It is called when the  *
 *            IOD48 board has detected a status change from the ports.  The  *
 *            IOD48 asserts the IRQ 3, which is this routine.                *
 *****************************************************************************)

procedure setflag; interrupt;
begin
   asm cli; end;   { do not allow further interrupts }
   isr_flag := 1;   { indicate an interrupt has occurred }
end;   { end setflag }

(*****************************************************************************
 *  FUNCTION: read_all_IOD48_ports - local routine                           *
 *  PURPOSE: Reads all six IOD48 ports.                                     *
 *****************************************************************************)

procedure read_all_IOD48_ports(var cur : bytelist; portad : integer);
begin
   cur[0] := IOD48_read_port(portad, PORT0A);
   cur[1] := IOD48_read_port(portad, PORT0B);
   cur[2] := IOD48_read_port(portad, PORT0C);
   cur[3] := IOD48_read_port(portad, PORT1A);
   cur[4] := IOD48_read_port(portad, PORT1B);
   cur[5] := IOD48_read_port(portad, PORT1C);
end;

function AskForBaseAddress(OldOne : String) : Word;
const
   Msg : string[4] = '0';
var
   NewOne, Success, Dummy, Error : Word;
   AddrInputPosX, AddrInputPosY : Word;
begin
   if (OldOne = 'OLD') then OldOne := Msg;
   WriteLn('Please enter the Base Address (0000-FFFF) for your card (in hex)');
   WriteLn('or press ENTER for ', OldOne, '.  ');
   Write('>');
   AddrInputPosX := WhereX; AddrInputPosY := WhereY;
   repeat
      GotoXY(AddrInputPosX, AddrInputPosY);
      ClrEol;
      Readln(Msg);
      Val('$' + Msg, NewOne, Error);
      if (error=0) then begin
         Success := 1;
         Dummy := NewOne;
      end else if (Msg = '') then begin
         GotoXY(AddrInputPosX, AddrInputPosY);
         WriteLn(OldOne);
         Msg := OldOne;
         Success := 1;
         Val('$' + Msg, Dummy, Error);
      end;
   until (Success = 1);
   AskForBaseAddress := Dummy;
end;  { end of AskForBaseAddress }

(*****************************************************************************
 *    Function : AskForIrq                                                   *
 *    Purpose : this function allows the user to input the irq level        *
 *****************************************************************************)


function AskForIRQ(OldOne : String) : integer;
const
   Msg : string[3] = '0';
var
   NewOne, Success, Dummy, Error : Word;
   IrqInputPosX, IrqInputPosY : Word;
begin
   if (OldOne = 'OLD') then OldOne := Msg;
   WriteLn('Please enter the IRQ number (2-7, 10-12, 14, 15)');
   WriteLn('or press ENTER for ',OldOne);
   Write('>');
   IrqInputPosX := WhereX; IrqInputPosY := WhereY;
   Success := 0;
   repeat
      GotoXY(IrqInputPosX, IrqInputPosY);
      ClrEol;
      Readln(Msg);
      Val(Msg, NewOne, Error);
      if ((NewOne >= 2) AND (NewOne <= 7))
        or ((NewOne >= 10) AND (NewOne <= 12))
        or (NewOne = 14) or (NewOne = 15) then
      begin
         Success := 1;
         Val(Msg, Dummy, Error);
         Dummy := NewOne;
      end else if (Msg = '') then begin
         GotoXY(IrqInputPosX, IrqInputPosY);
         WriteLn(OldOne);
         Msg := OldOne;
         Success := 1;
         Val(Msg, Dummy, Error);
      end;
   until (Success = 1);
   AskForIrq := Dummy;
end;

(*****************************************************************************
 *  FUNCTION: main -- local routine                                          *
 *****************************************************************************)

VAR
   portadd : integer;
   old_mask, int_mask : integer;
   oldisr : procedure;
   basetemp : word;
   Irq_num : integer;
   current : bytelist;
   new : bytelist;
   compare : bytelist;
   error : integer;

Begin
  ClrScr;
  WriteLn('                SAMPLE 1.PAS : INTERRUPT PROGRAMMING');
  WriteLn('This is the root module for the IOD48S board demonstration for');
  WriteLn('change of state interrupt programming.');
  gotoxy(1, 7);
  WriteLn('IOD48S BASE ADDRESS');
  Basetemp := AskForBaseAddress('300');
  Irq_num := AskForIrq('5');

  ClrScr;
  WriteLn;
  WriteLn;
  WriteLn;
  WriteLn('Board Configuration:');
  WriteLn;
  WriteLn;
  WriteLn(' -- Base Address is ',basetemp,' hex');
  WriteLn(' -- The IRQ ',Irq_num,' jumper should be installed         (required)');
  WriteLn(' -- TST/BEN jumper should be in the BEN position (required)');
  WriteLn(' -- All remaining jumper settings are irrelevant.');
  WriteLn;
  WriteLn;
  WriteLn;
  WriteLn('Press a key to continue');
  readkey;
  asm cli; end;                { do not allow hardware interrupts }
  signon;                      { print the start up message }
  {memset(compare, 0, sizeof(compare));}
  portadd := IOD48;               { default port is 300 hex }
  IOD48_cos_enable(portadd, $FF);  { turn off board interrupts }
  isr_flag := 0;

  if( (IRQ_num < 8) AND (IRQ_num > 1) ) then
  begin
     getintvec(IRQ_num + 8, @oldisr);         { get and save old IRQ vector }
     setintvec(IRQ_num + 8, @setflag);          { set IRQ5 to our ISR }
     old_mask := port[$21];              { get hardware interrupt mask }
     int_mask := old_mask;
     int_mask := int_mask AND NOT(1 SHL IRQ_num);        { enable the IRQ bit }
     port[$21] := int_mask;               { send new mask to 8259 }
  end
  else if( (IRQ_num = 10) or (IRQ_num = 11) or (IRQ_num = 12) or
           (IRQ_num = 14) or (IRQ_num = 15)) then
  begin
     getintvec(IRQ_num - 8 + $70, @oldisr);      { get and save old IRQ vector }
     setintvec(IRQ_num - 8 + $70, @setflag);       { set IRQ5 to our ISR }
     old_mask := port[$A1];              { get hardware interrupt mask }
     int_mask := old_mask;
     int_mask := int_mask AND NOT(1 SHL (IRQ_num - 8));    { enable the IRQ bit }
     port[$A1] := int_mask;               { send new mask to 8259 }
  end;

  IOD48_port_control(portadd, PORT0CONTROL, $9B);   { set both PPI's as input }
  IOD48_port_control(portadd, PORT1CONTROL, $9B);
  read_all_IOD48_ports(current, portadd);    { make initial reading }
  write_port_data(current, compare);      { display the values }
  IOD48_clr_cos_int(portadd);             { clear any pending interrupt }
  IOD48_cos_enable(portadd, 0);           { enable all port for interrupts }
  asm sti; end;
  Repeat   { loop until key pressed }
     { other code can go here while waiting for an interrupt }
        if (isr_flag = 1) then { if flag set then interrupt has occured }
           begin
             { IOD48_cos_enable(portadd, $FF);  { disable board interrupts }
              delay(40);
              read_all_IOD48_ports(new, portadd);  { read the new values }
              compare_ports(current, new, compare); { determine what has changed}
              write_port_data(current, compare); { write new data to screen }
              isr_flag := 0;
              asm sti; end;               { allow hardware interrupts }
              IOD48_clr_cos_int(portadd);  { clear pending interrupts }
              IOD48_cos_enable(portadd,0); { enable all ports for interrupts }
              if (IRQ_num < 8) then
                 port[$20] := $20  { clear 8259 interrupt }
              else                                  { ditto }
              begin
                 port[$20] := $20;  { non-specific EOI, slave }
                 port[$A0] := $20;  { non_specific EOI, master }
              end;
           end;
  Until (keypressed);
  asm cli; end;                  { disable hardware interrupts }
  IOD48_cos_enable(portadd, $FF); { disable al board interrupts }
  IOD48_clr_cos_int(portadd);    { clear pending interrupts }
  if ((IRQ_num < 8) AND (IRQ_num > 1)) then
  begin
     setintvec(IRQ_num + 8, @oldisr);           { set IRQ5 to our ISR }
     old_mask := port[$21];              { get hardware interrupt mask }
     int_mask := old_mask;
     int_mask := (int_mask OR (1 shl IRQ_num));        {enable the IRQ bit }
     port[$21] := int_mask;               { send new mask to 8259 }
  end
  else if ((IRQ_num = 10) or (IRQ_num = 11) or (IRQ_num = 12) or
           (IRQ_num = 14) or (IRQ_num = 15)) then
  begin
     setintvec(IRQ_num + $68, @oldisr);        { set IRQ5 to our ISR }
     old_mask := port[$A1];              { get hardware interrupt mask }
     int_mask := old_mask;
     int_mask := int_mask OR (1 shl (IRQ_num - 8));    { enable the IRQ bit }
     port[$A1] := int_mask;               { send new mask to 8259 }
  end;
  asm sti; end;                    { allow hardware interrupts }
  clrscr;
END.