home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / ucsdappleii.zip / kermacia.text < prev    next >
Text File  |  1986-04-08  |  10KB  |  289 lines
  1. (************* UNIT KERMACIA ********************************************)
  2.  
  3. (*$S+*)
  4. (*$I-*)
  5. (*$R-*)
  6. (*$V-*)
  7.  
  8. UNIT KERMACIA;  intrinsic code 18   data 19;
  9.  
  10.  
  11. INTERFACE
  12.  
  13. USES  kermglob;
  14.  
  15. PROCEDURE send_break ( adr_comm_reg : integer );
  16.  
  17. PROCEDURE get_acia_parms( var xpar : parity_type;
  18.                           var xdbit, xstopbit, xbaud : integer );
  19.  
  20. PROCEDURE set_acia_parms(  xpar : parity_type;
  21.                            xdbit, xstopbit, xbaud : integer );
  22.  
  23. IMPLEMENTATION
  24.  
  25.  This unit implements the possibility to change baud rates, parity, number 
  26.  of databits and stopbits  for outgoing characters and the possibility to  
  27.  send a break signal to the remote host.                                   
  28.  This unit is dependent on a special unitstatus call, provided by the      
  29.  attached driver for remin: ( see file remdriver.text ).                   
  30.  The code below is specific for the 6551 acia on a AP2 serial card from IBS
  31.  and for the 6850 acia on a CCS model 7710 ASI1 card, that is probably     
  32.  similar to the Apple Com Card and the Hayes micromodem card.              
  33.  On the CCS card it is not possible to change the baud rate by soft command
  34.  nor is it possible to set space parity.                                   
  35.  If you have a different serial card then this unit should be adapted to   
  36.  the requirements of that card's acia. If you do not know how to or do not 
  37.  want to rewrite this unit's implementation, then you can set the value of 
  38.  'acia_implem' in the kermit.data file to 0 (= unknown). The settable      
  39.  parameters   will then equal the default values , but can no longer be    
  40.  changed at run time. The procedure send_break will then do nothing.       
  41.  
  42.      acia_cntrl_reg   = -16209;     =$C0AF  Specific for a 6551 acia on a  
  43.      acia_comm_reg    = -16210;     =$C0AE  AP2 serial card in slot 2.     
  44.      acia_comm_reg    = -16224;     =$C0A0  Specific for CCS 6850  acia.   
  45.                                             The 6850 does not have a       
  46.                                             control register.              
  47.  These 2 adresses are declared in unit kermglob.                           
  48.  If your card also has a 6551  acia then these adresses will               
  49.  probably be different. They can then be changed in the kermit.data file.  
  50.  
  51. TYPE   baud_types      = (B16ext, B50, B75, B110, B135, B150, B300, B600,
  52.                           B1200, B1800, B2400, B3600, B4800, B7200, B9600,
  53.                           B19200);  { 6551 specific }
  54.  
  55.        dbit_types      = (dbit8, dbit7, dbit6, dbit5 ); { 6551 specific }
  56.  
  57.        cntrl_6551      = PACKED RECORD
  58.                           baudr  : baud_types;
  59.                           freq   : ( ext, int );
  60.                           wordlen: dbit_types;
  61.                           stpbit : ( one, variable );
  62.                           msb1   : 0..255 ;
  63.                          END;
  64.  
  65.        comm_6551       = PACKED RECORD
  66.                           dont_change :  0..31 ;
  67.                           set_par     :  BOOLEAN;
  68.                           par_type    : ( p_odd, p_even, p_mark, p_space );
  69.                           msb2        :  0..255 ;
  70.                          END;
  71.  
  72.        comm_6850       = PACKED RECORD
  73.                           filler1     :  0..3 ;
  74.                           serdata     : ( d7pes2, d7pos2, d7pes1, d7pos1,
  75.                                           d8pns2, d8pns1, d8pes1, d8pos1 );
  76.                 { d=databits, p=parity, e=even, o=odd, n=none, s=stopbit }
  77.                           filler2     :  0..7 ;
  78.                           msb3        :  0..255;
  79.                          END;
  80.  
  81.        stat_rec1      =  RECORD
  82.                           adres1   : INTEGER;
  83.                           content1 : cntrl_6551;
  84.                          END;
  85.  
  86.        stat_rec2      =  RECORD
  87.                           adres2   : INTEGER;
  88.                           content2 : comm_6551;
  89.                          END;
  90.  
  91.        stat_rec3      =  RECORD
  92.                           adres3   : INTEGER;
  93.                           content3 : comm_6850;
  94.                          END;
  95.  
  96. VAR    baud_rate             : ARRAY[ baud_types ] OF INTEGER;
  97.        dbits                 : ARRAY[ dbit_types ] OF INTEGER;
  98.        reg_6551_control      : stat_rec1;
  99.        reg_6551_komm         : stat_rec2;
  100.        reg_6850_comm         : stat_rec3;
  101.        cw_status, cw_control : cntrl_word_rec;
  102.  
  103.  
  104.  
  105.  
  106. PROCEDURE get_6551_parms ( var xpar:parity_type;
  107.                            var xdbit, xstopbit, xbaud : integer );
  108.  
  109. BEGIN
  110.   reg_6551_control.adres1 := acia_cntrl_reg;
  111.   reg_6551_komm.adres2    := acia_comm_reg;
  112.   UNITSTATUS( inport, reg_6551_control, cw_status );
  113.   UNITSTATUS( inport, reg_6551_komm,    cw_status );
  114.   WITH reg_6551_komm.content2 DO
  115.     BEGIN
  116.       IF set_par THEN BEGIN
  117.                         CASE par_type OF
  118.                           p_odd    : xpar := odd_par;
  119.                           p_even   : xpar := even_par;
  120.                           p_mark   : xpar := mark_par;
  121.                           p_space  : xpar := space_par;
  122.                         END;
  123.                       END
  124.                  ELSE xpar := no_par;
  125.     END; { with }
  126.   WITH reg_6551_control.content1 DO
  127.     BEGIN
  128.       xbaud  := baud_rate[ baudr ];
  129.       xdbit  := dbits[ wordlen ];
  130.       CASE stpbit OF
  131.         one      : xstopbit := 1;
  132.         variable : BEGIN
  133.                      xstopbit := 2;
  134.                      IF ( xpar <> no_par ) and ( word_len = dbit8 )
  135.                        THEN xstopbit := 1;
  136.                      IF ( xpar =  no_par ) and ( word_len = dbit5 )
  137.                        THEN xstopbit := 15;
  138.                    END;
  139.       END; { case stpbit }
  140.     END; { with }
  141. END; { get_6551_parms }
  142.  
  143.  NOTE : xstopbit = 15 actually means 1.5 stopbit 
  144.  
  145.  
  146.  
  147.  
  148. PROCEDURE get_acia_parms{ var xpar:parity_type;
  149.                           var xdbit,xstopbit,xbaud : integer};
  150.  
  151. begin
  152.   if acia_implem = A6551 then get_6551_parms( xpar, xdbit, xstopbit, xbaud );
  153. end;  { get_acia_parms }
  154.  
  155.  
  156.  
  157. PROCEDURE set_6551_parms (  xpar:parity_type;
  158.                             xdbit, xstopbit, xbaud : integer );
  159.  
  160. VAR oldpar : parity_type;
  161.     oldbaud, olddbit, oldstopb : INTEGER;
  162.     i : baud_types;
  163.     j : dbit_types;
  164.  
  165. BEGIN
  166.    get_6551_parms( oldpar, olddbit, oldstopb, oldbaud );
  167.    WITH reg_6551_komm.content2 DO
  168.      BEGIN
  169.        set_par := TRUE;
  170.        CASE xpar OF
  171.          no_par    : set_par  := FALSE;
  172.          odd_par   : par_type := p_odd;
  173.          even_par  : par_type := p_even;
  174.          mark_par  : par_type := p_mark;
  175.          space_par : par_type := p_space;
  176.        END; { case }
  177.      END; { with }
  178.    UNITSTATUS( inport, reg_6551_komm, cw_control );
  179.    WITH reg_6551_control.content1 DO
  180.      BEGIN
  181.        FOR i := B50 TO B19200 DO IF baud_rate[ i ] = xbaud THEN baudr := i;
  182.        FOR j := dbit8 TO dbit5 DO IF dbits[ j ] = xdbit THEN word_len := j;
  183.        IF xstopbit = 1 THEN stpbit := one
  184.                        ELSE stpbit := variable;
  185.      END; { with  }
  186.    UNITSTATUS( inport, reg_6551_control, cw_control );
  187. END; { set_6551_parms }
  188.  
  189.  
  190. PROCEDURE set_6850_parms(  xpar:parity_type; xdbit,xstop : integer);
  191.  
  192. BEGIN
  193.   WITH reg_6850_comm.content3 DO
  194.     BEGIN
  195.       IF (xdbit=7) and (xpar=evenpar) and (xstop=1) THEN serdata := d7pes1 ELSE
  196.       IF (xdbit=7) and (xpar= oddpar) and (xstop=1) THEN serdata := d7pos1 ELSE
  197.       IF (xdbit=7) and (xpar=evenpar) and (xstop=2) THEN serdata := d7pes2 ELSE
  198.       IF (xdbit=7) and (xpar= oddpar) and (xstop=2) THEN serdata := d7pos2 ELSE
  199.       IF (xdbit=8) and (xpar=markpar) and (xstop=1) THEN serdata := d8pns2 ELSE
  200.       IF (xdbit=8) and (xpar=  nopar) and (xstop=1) THEN serdata := d8pns1 ELSE
  201.       IF (xdbit=8) and (xpar= oddpar) and (xstop=1) THEN serdata := d8pos1 ELSE
  202.       IF (xdbit=8) and (xpar=evenpar) and (xstop=1) THEN serdata := d8pes1 ELSE
  203.       EXIT( set_6850_parms );
  204.     END;  { WITH }
  205.   reg_6850_comm.content3.filler1 := 3;
  206.   reg_6850_comm.content3.filler2 := 0;
  207.   reg_6850_comm.adres3 := acia_comm_reg;
  208.   UNITSTATUS( inport, reg_6850_comm, cw_control );
  209.   { first give an acia master reset }
  210.   reg_6850_comm.content3.filler1 := 1;
  211.   UNITSTATUS( inport, reg_6850_comm, cw_control );
  212.   { set acia command register to desired value }
  213.   parity := xpar;
  214.   stopbit := xstop;
  215.   databit := xdbit;
  216. END;  { set_6850_parms }
  217.  
  218.  
  219. PROCEDURE set_acia_parms {  xpar : parity_type;
  220.                             xdbit, xstopbit, xbaud : integer };
  221.  
  222. begin
  223.   case acia_implem of
  224.     A6551 : set_6551_parms( xpar, xdbit, xstopbit, xbaud );
  225.     A6850 : set_6850_parms( xpar, xdbit, xstopbit );
  226.   end;
  227. end;   { set_acia_parms }
  228.  
  229.  
  230.  
  231. PROCEDURE  send_6551_break ( adr_comm_reg : INTEGER ); EXTERNAL;
  232. PROCEDURE  send_6850_break ( adr_comm_reg : INTEGER ); EXTERNAL;
  233.  See file asm.acia.text 
  234.  
  235. PROCEDURE send_break { adr_comm_reg : integer };
  236.  
  237.  sends a break signal to the host. Signal is shut off by typing any key. 
  238.  The command register is restored to the previous value.                 
  239.  
  240. begin
  241.   case acia_implem of
  242.     A6551 : send_6551_break( adr_comm_reg );
  243.     A6850 : begin
  244.               send_6850_break( adr_comm_reg );
  245.               set_acia_parms( parity, databit, stopbit, baud );
  246.             end;
  247.   end;
  248. end;   { send_break }
  249.  
  250.  
  251.  
  252. BEGIN
  253.   baud_rate[ B16ext ] :=     0;
  254.   baud_rate[ B50    ] :=    50;
  255.   baud_rate[ B75    ] :=    75;
  256.   baud_rate[ B110   ] :=   110;
  257.   baud_rate[ B135   ] :=   135;
  258.   baud_rate[ B150   ] :=   150;
  259.   baud_rate[ B300   ] :=   300;
  260.   baud_rate[ B600   ] :=   600;
  261.   baud_rate[ B1200  ] :=  1200;
  262.   baud_rate[ B1800  ] :=  1800;
  263.   baud_rate[ B2400  ] :=  2400;
  264.   baud_rate[ B3600  ] :=  3600;
  265.   baud_rate[ B4800  ] :=  4800;
  266.   baud_rate[ B7200  ] :=  7200;
  267.   baud_rate[ B9600  ] :=  9600;
  268.   baud_rate[ B19200 ] := 19200;
  269.   dbits[ dbit8 ] := 8;
  270.   dbits[ dbit7 ] := 7;
  271.   dbits[ dbit6 ] := 6;
  272.   dbits[ dbit5 ] := 5;
  273.   WITH cw_status DO
  274.     BEGIN
  275.       channel      := inp;
  276.       purpose      := status;
  277.       special_req  := rw_req;
  278.       reserved     := 0;
  279.       filler       := 0;
  280.     END;
  281.   cw_control := cw_status;
  282.   cw_control.purpose  :=  control;
  283.   { set serial data for 6850 acia to pascal defaults }
  284.   parity := no_par;
  285.   stopbit := 1;
  286.   databit := 8;
  287. END.
  288.  
  289.