(************* UNIT KERMACIA ********************************************)

(*$S+*)
(*$I-*)
(*$R-*)
(*$V-*)

UNIT KERMACIA;  intrinsic code 18   data 19;


INTERFACE

USES  kermglob;

PROCEDURE send_break ( adr_comm_reg : integer );

PROCEDURE get_acia_parms( var xpar : parity_type;
                          var xdbit, xstopbit, xbaud : integer );
 
PROCEDURE set_acia_parms(  xpar : parity_type;
                           xdbit, xstopbit, xbaud : integer );
 
IMPLEMENTATION

 This unit implements the possibility to change baud rates, parity, number 
 of databits and stopbits  for outgoing characters and the possibility to  
 send a break signal to the remote host.                                   
 This unit is dependent on a special unitstatus call, provided by the      
 attached driver for remin: ( see file remdriver.text ).                   
 The code below is specific for the 6551 acia on a AP2 serial card from IBS
 and for the 6850 acia on a CCS model 7710 ASI1 card, that is probably     
 similar to the Apple Com Card and the Hayes micromodem card.              
 On the CCS card it is not possible to change the baud rate by soft command
 nor is it possible to set space parity.                                   
 If you have a different serial card then this unit should be adapted to   
 the requirements of that card's acia. If you do not know how to or do not 
 want to rewrite this unit's implementation, then you can set the value of 
 'acia_implem' in the kermit.data file to 0 (= unknown). The settable      
 parameters   will then equal the default values , but can no longer be    
 changed at run time. The procedure send_break will then do nothing.       

     acia_cntrl_reg   = -16209;     =$C0AF  Specific for a 6551 acia on a  
     acia_comm_reg    = -16210;     =$C0AE  AP2 serial card in slot 2.     
     acia_comm_reg    = -16224;     =$C0A0  Specific for CCS 6850  acia.   
                                            The 6850 does not have a       
                                            control register.              
 These 2 adresses are declared in unit kermglob.                           
 If your card also has a 6551  acia then these adresses will               
 probably be different. They can then be changed in the kermit.data file.  
 
TYPE   baud_types      = (B16ext, B50, B75, B110, B135, B150, B300, B600,
                          B1200, B1800, B2400, B3600, B4800, B7200, B9600,
                          B19200);  { 6551 specific }
 
       dbit_types      = (dbit8, dbit7, dbit6, dbit5 ); { 6551 specific }
 
       cntrl_6551      = PACKED RECORD
                          baudr  : baud_types;
                          freq   : ( ext, int );
                          wordlen: dbit_types;
                          stpbit : ( one, variable );
                          msb1   : 0..255 ;
                         END;
 
       comm_6551       = PACKED RECORD
                          dont_change :  0..31 ;
                          set_par     :  BOOLEAN;
                          par_type    : ( p_odd, p_even, p_mark, p_space );
                          msb2        :  0..255 ;
                         END;
 
       comm_6850       = PACKED RECORD
                          filler1     :  0..3 ;
                          serdata     : ( d7pes2, d7pos2, d7pes1, d7pos1,
                                          d8pns2, d8pns1, d8pes1, d8pos1 );
                { d=databits, p=parity, e=even, o=odd, n=none, s=stopbit }
                          filler2     :  0..7 ;
                          msb3        :  0..255;
                         END;
 
       stat_rec1      =  RECORD
                          adres1   : INTEGER;
                          content1 : cntrl_6551;
                         END;
 
       stat_rec2      =  RECORD
                          adres2   : INTEGER;
                          content2 : comm_6551;
                         END;
 
       stat_rec3      =  RECORD
                          adres3   : INTEGER;
                          content3 : comm_6850;
                         END;
 
VAR    baud_rate             : ARRAY[ baud_types ] OF INTEGER;
       dbits                 : ARRAY[ dbit_types ] OF INTEGER;
       reg_6551_control      : stat_rec1;
       reg_6551_komm         : stat_rec2;
       reg_6850_comm         : stat_rec3;
       cw_status, cw_control : cntrl_word_rec;
 
 


PROCEDURE get_6551_parms ( var xpar:parity_type;
                           var xdbit, xstopbit, xbaud : integer );

BEGIN
  reg_6551_control.adres1 := acia_cntrl_reg;
  reg_6551_komm.adres2    := acia_comm_reg;
  UNITSTATUS( inport, reg_6551_control, cw_status );
  UNITSTATUS( inport, reg_6551_komm,    cw_status );
  WITH reg_6551_komm.content2 DO
    BEGIN
      IF set_par THEN BEGIN
                        CASE par_type OF
                          p_odd    : xpar := odd_par;
                          p_even   : xpar := even_par;
                          p_mark   : xpar := mark_par;
                          p_space  : xpar := space_par;
                        END;
                      END
                 ELSE xpar := no_par;
    END; { with }
  WITH reg_6551_control.content1 DO
    BEGIN
      xbaud  := baud_rate[ baudr ];
      xdbit  := dbits[ wordlen ];
      CASE stpbit OF
        one      : xstopbit := 1;
        variable : BEGIN
                     xstopbit := 2;
                     IF ( xpar <> no_par ) and ( word_len = dbit8 )
                       THEN xstopbit := 1;
                     IF ( xpar =  no_par ) and ( word_len = dbit5 )
                       THEN xstopbit := 15;
                   END;
      END; { case stpbit }
    END; { with }
END; { get_6551_parms }

 NOTE : xstopbit = 15 actually means 1.5 stopbit 




PROCEDURE get_acia_parms{ var xpar:parity_type;
                          var xdbit,xstopbit,xbaud : integer};

begin
  if acia_implem = A6551 then get_6551_parms( xpar, xdbit, xstopbit, xbaud );
end;  { get_acia_parms }



PROCEDURE set_6551_parms (  xpar:parity_type;
                            xdbit, xstopbit, xbaud : integer );

VAR oldpar : parity_type;
    oldbaud, olddbit, oldstopb : INTEGER;
    i : baud_types;
    j : dbit_types;
 
BEGIN
   get_6551_parms( oldpar, olddbit, oldstopb, oldbaud );
   WITH reg_6551_komm.content2 DO
     BEGIN
       set_par := TRUE;
       CASE xpar OF
         no_par    : set_par  := FALSE;
         odd_par   : par_type := p_odd;
         even_par  : par_type := p_even;
         mark_par  : par_type := p_mark;
         space_par : par_type := p_space;
       END; { case }
     END; { with }
   UNITSTATUS( inport, reg_6551_komm, cw_control );
   WITH reg_6551_control.content1 DO
     BEGIN
       FOR i := B50 TO B19200 DO IF baud_rate[ i ] = xbaud THEN baudr := i;
       FOR j := dbit8 TO dbit5 DO IF dbits[ j ] = xdbit THEN word_len := j;
       IF xstopbit = 1 THEN stpbit := one
                       ELSE stpbit := variable;
     END; { with  }
   UNITSTATUS( inport, reg_6551_control, cw_control );
END; { set_6551_parms }


PROCEDURE set_6850_parms(  xpar:parity_type; xdbit,xstop : integer);

BEGIN
  WITH reg_6850_comm.content3 DO
    BEGIN
      IF (xdbit=7) and (xpar=evenpar) and (xstop=1) THEN serdata := d7pes1 ELSE
      IF (xdbit=7) and (xpar= oddpar) and (xstop=1) THEN serdata := d7pos1 ELSE
      IF (xdbit=7) and (xpar=evenpar) and (xstop=2) THEN serdata := d7pes2 ELSE
      IF (xdbit=7) and (xpar= oddpar) and (xstop=2) THEN serdata := d7pos2 ELSE
      IF (xdbit=8) and (xpar=markpar) and (xstop=1) THEN serdata := d8pns2 ELSE
      IF (xdbit=8) and (xpar=  nopar) and (xstop=1) THEN serdata := d8pns1 ELSE
      IF (xdbit=8) and (xpar= oddpar) and (xstop=1) THEN serdata := d8pos1 ELSE
      IF (xdbit=8) and (xpar=evenpar) and (xstop=1) THEN serdata := d8pes1 ELSE
      EXIT( set_6850_parms );
    END;  { WITH }
  reg_6850_comm.content3.filler1 := 3;
  reg_6850_comm.content3.filler2 := 0;
  reg_6850_comm.adres3 := acia_comm_reg;
  UNITSTATUS( inport, reg_6850_comm, cw_control );
  { first give an acia master reset }
  reg_6850_comm.content3.filler1 := 1;
  UNITSTATUS( inport, reg_6850_comm, cw_control );
  { set acia command register to desired value }
  parity := xpar;
  stopbit := xstop;
  databit := xdbit;
END;  { set_6850_parms }


PROCEDURE set_acia_parms {  xpar : parity_type;
                            xdbit, xstopbit, xbaud : integer };

begin
  case acia_implem of
    A6551 : set_6551_parms( xpar, xdbit, xstopbit, xbaud );
    A6850 : set_6850_parms( xpar, xdbit, xstopbit );
  end;
end;   { set_acia_parms }
 
 
 
PROCEDURE  send_6551_break ( adr_comm_reg : INTEGER ); EXTERNAL;
PROCEDURE  send_6850_break ( adr_comm_reg : INTEGER ); EXTERNAL;
 See file asm.acia.text 

PROCEDURE send_break { adr_comm_reg : integer };

 sends a break signal to the host. Signal is shut off by typing any key. 
 The command register is restored to the previous value.                 

begin
  case acia_implem of
    A6551 : send_6551_break( adr_comm_reg );
    A6850 : begin
              send_6850_break( adr_comm_reg );
              set_acia_parms( parity, databit, stopbit, baud );
            end;
  end;
end;   { send_break }



BEGIN
  baud_rate[ B16ext ] :=     0;
  baud_rate[ B50    ] :=    50;
  baud_rate[ B75    ] :=    75;
  baud_rate[ B110   ] :=   110;
  baud_rate[ B135   ] :=   135;
  baud_rate[ B150   ] :=   150;
  baud_rate[ B300   ] :=   300;
  baud_rate[ B600   ] :=   600;
  baud_rate[ B1200  ] :=  1200;
  baud_rate[ B1800  ] :=  1800;
  baud_rate[ B2400  ] :=  2400;
  baud_rate[ B3600  ] :=  3600;
  baud_rate[ B4800  ] :=  4800;
  baud_rate[ B7200  ] :=  7200;
  baud_rate[ B9600  ] :=  9600;
  baud_rate[ B19200 ] := 19200;
  dbits[ dbit8 ] := 8;
  dbits[ dbit7 ] := 7;
  dbits[ dbit6 ] := 6;
  dbits[ dbit5 ] := 5;
  WITH cw_status DO
    BEGIN
      channel      := inp;
      purpose      := status;
      special_req  := rw_req;
      reserved     := 0;
      filler       := 0;
    END;
  cw_control := cw_status;
  cw_control.purpose  :=  control;
  { set serial data for 6850 acia to pascal defaults }
  parity := no_par;
  stopbit := 1;
  databit := 8;
END.