Topspeed_JPI/TS-V3/EXAMPLES/RS.LST

Listing:

    1  (*========================================================
    2  == JPI-TopSpeed Modula-2 V2                             ==
    3  == demo program:                                        ==
    4  ==                                                      ==
    5  ==   Example RS232 module                               ==
    6  ==                                                      ==
    7  ========================================================*)
    8  
    9  (*# call(o_a_copy=>off) *)
   10  (*# check(stack=>off,index=>off,range=>off,overflow=>off,nil_ptr=>off) *)
   11  
   12  IMPLEMENTATION MODULE rs;
   13                      (*==*)
   14  IMPORT SYSTEM, Lib;
   15  
   16  CONST Com1        = 3F8H;
   17        Com1INr     = 4;
   18        Com2        = 2F8H;
   19        Com2INr     = 3;
   20  
   21        IntEnable   = 1;
   22        DivisorMsb  = 1;
   23        IntId       = 2;
   24        LineCont    = 3;
   25        ModemCont   = 4;
   26        LineStatus  = 5;
   27        ModemStatus = 6;
   28        Debug       = TRUE;
   29  
   30  TYPE b = SET OF SHORTCARD[0..7];
*****                  ^ not supported yet
   31  VAR IOBase,ComINr : CARDINAL;
   32  
   33  CONST
   34        TXBuffer    ::= IOBase;
   35        RXBuffer    ::= IOBase;
   36        DivisorLsb  ::= IOBase;
   37  
   38  
   39        BufferSize  = 256;
   40        TRMax       = BufferSize-16;
   41        Noise       = FALSE;
   42  
   43  VAR
   44      OldC                  : FarADDRESS;
   45      Term                  : PROC;
   46  (*# save, data(volatile=>on) *)
   47      TXReady,CTS,CTSH     : BOOLEAN;
   48      RTS                  : BOOLEAN;
   49      TXCount,TXI,TXO      : CARDINAL;
   50      RXCount,RXI,RXO      : CARDINAL;
   51  (*# restore *)
   52      IBuf,OBuf            : ARRAY[0..BufferSize-1] OF SHORTCARD;
   53  
   54  PROCEDURE WrStr(string: ARRAY OF CHAR);
   55  VAR R : SYSTEM.Registers;
   56      i : CARDINAL;
   57  BEGIN
   58    IF Debug THEN
   59      i := 0;
   60      WHILE (i<SIZE(string))AND(string[i]<>CHR(0)) DO
   61        R.AL := SHORTCARD(string[i]);
   62        R.AH := 14;
   63        R.BL := 0;
   64        Lib.Intr( R ,10H );
   65        INC(i);
   66      END;
   67    END;
   68  END WrStr;
   69  
   70  PROCEDURE WrLn;
   71  TYPE
   72    a3 = ARRAY [0..1] OF CHAR;
   73  CONST
   74    crlf = a3(CHR(13),CHR(10));
   75  BEGIN
   76    WrStr( crlf );
   77  END WrLn;
   78  
   79  
   80  PROCEDURE TX;
   81  BEGIN
   82    IF CTS OR NOT CTSH THEN
   83       TXReady := FALSE;
   84       DEC(TXCount);
   85       SYSTEM.Out( TXBuffer,OBuf[TXO] );
   86       TXO := (TXO+1) MOD BufferSize;
   87    END;
   88  END TX;
   89  
   90  PROCEDURE RX;
   91  BEGIN
   92    IF RXCount >= TRMax THEN
   93       SYSTEM.Out( IOBase+ModemCont, SHORTCARD( b{0,3} ) );
   94       RTS := FALSE;
   95    END;
   96    IBuf[RXI] := SYSTEM.In( RXBuffer );
   97    IF Noise AND (Lib.RANDOM(500)=0) THEN
   98       IBuf[RXI] := SHORTCARD(Lib.RANDOM(256));
   99    END;
  100    RXI := (RXI+1) MOD BufferSize;
  101    INC(RXCount);
  102  END RX;
  103  
  104  VAR GotBreak : BOOLEAN;
  105  
  106  (* pragmas for interrupt handler *)
  107  (*# save,
  108      call(interrupt => on,
  109           reg_param => (),
  110           same_ds   => off
  111          )
  112  *)
  113  PROCEDURE Int;
  114  VAR i  : SHORTCARD;
  115      s  : b;
  116  BEGIN
  117    LOOP
  118      i := SYSTEM.In( IOBase+IntId );
  119      IF i=1 THEN EXIT; END;
  120      CASE i DIV 2 OF
  121      |  0 : (* Modem status *)
  122             s := b(SYSTEM.In( IOBase+ModemStatus ));
  123             CTS :=4 IN s;
  124             IF CTS AND (TXCount >0) AND TXReady THEN TX END;
  125  
  126      |  1 : (* TXEmpty      *)
  127             TXReady := TRUE;
  128             IF TXCount > 0 THEN TX; END;
  129  
  130      |  2 : (* RXReady      *)
  131  
  132             RX;
  133  
  134      |  3 : (* LineStatus   *)
  135  
  136             s := b(SYSTEM.In( IOBase+LineStatus ));
  137  
  138             IF 1 IN s THEN WrStr('OR-Error'); WrLn; END;
  139             IF 2 IN s THEN WrStr('PE-Error'); WrLn; END;
  140             IF 4 IN s THEN WrStr('Break'); WrLn;
  141             ELSIF 3 IN s THEN WrStr('FE-Error'); WrLn;
  142             END;
  143      ELSE
  144             WrStr('Unknown Int'); WrLn;
  145      END;
  146    END;
  147    SYSTEM.Out(20H,20H);
  148  END Int;
  149  
  150  (*# restore *)
  151  
  152  PROCEDURE RxCount():CARDINAL;
  153  BEGIN
  154    RETURN RXCount;
  155  END RxCount;
  156  
  157  PROCEDURE TxCount():CARDINAL;
  158  BEGIN
  159    RETURN TXCount;
  160  END TxCount;
  161  
  162  PROCEDURE TxFree ():CARDINAL;
  163  BEGIN
  164    RETURN TRMax-TXCount;
  165  END TxFree;
  166  
  167  VAR lc : SHORTCARD;
  168  
  169  PROCEDURE Break( Time : CARDINAL );
  170  BEGIN
  171    SYSTEM.Out( IOBase+LineCont,SHORTCARD( b(SYSTEM.In(IOBase+LineCont))+b{6})) ;
  172    Lib.Delay( Time );
  173    SYSTEM.Out( IOBase+LineCont,SHORTCARD( b(SYSTEM.In(IOBase+LineCont))-b{6}));
  174  END Break;
  175  
  176  PROCEDURE Init( Baud       : CARDINAL;
  177                  WordLength : wl;
  178                  Parity     : pt;
  179                  OneStopBit : BOOLEAN;
  180                  HandShake  : BOOLEAN);
  181  
  182  VAR d  : CARDINAL; i : SHORTCARD;
  183  BEGIN
  184    SYSTEM.DI;
  185    TXI     := 0;
  186    TXO     := 0;
  187    RXI     := 0;
  188    RXO     := 0;
  189    RXCount := 0;
  190    TXCount := 0;
  191    SYSTEM.EI;
  192    CTSH := HandShake;
  193    lc := (WordLength-5) MOD 4;
  194    IF NOT OneStopBit THEN lc := lc+4; END;
  195    CASE Parity OF
  196    | None  :;
  197    | Even  : lc := lc+18H;
  198    | Odd   : lc := lc+ 8H;
  199    | Mark  : lc := lc+38H;
  200    | Space : lc := lc+28H;
  201    END;
  202    SYSTEM.Out( IOBase+LineCont,80H );
  203    d := CARDINAL( 115200 DIV LONGCARD( Baud ) );
  204    SYSTEM.Out( DivisorLsb, SHORTCARD(d));
  205    SYSTEM.Out( IOBase+DivisorMsb, SHORTCARD(d DIV 100H));
  206    SYSTEM.Out( IOBase+LineCont,lc );
  207    TXReady := TRUE;
  208    SYSTEM.Out( IOBase+ModemCont,SHORTCARD(b{0,1,3}));
  209    CTS     := 4 IN b(SYSTEM.In( IOBase+ModemStatus ));
  210    LOOP
  211      i := SYSTEM.In( IOBase+IntId );
  212      IF i=1 THEN EXIT; END;
  213      CASE i DIV 2 OF
  214      |  0 : (* Modem status *)
  215             i := SYSTEM.In( IOBase+ModemStatus );
  216      |  1 : (* TXEmpty      *)
  217      |  2 : (* RXReady      *)
  218      |  3 : (* LineStatus   *)
  219             i := SYSTEM.In( IOBase+LineStatus );
  220      END;
  221    END;
  222  END Init;
  223  
  224  
  225  PROCEDURE Receive(VAR Buf : ARRAY OF BYTE; Len : CARDINAL );
  226  VAR i : CARDINAL;
  227  BEGIN
  228    FOR i := 0 TO Len-1 DO
  229        WHILE RXCount = 0 DO END;
  230        Buf[i] := IBuf[RXO];
  231        DEC( RXCount );
  232        RXO := (RXO+1) MOD BufferSize;
  233    END;
  234    IF NOT RTS AND (RXCount < TRMax-16) THEN
  235       SYSTEM.Out( IOBase+ModemCont, SHORTCARD( b{0,1,3} ) );
  236       RTS := TRUE;
  237    END;
  238  END Receive;
  239  
  240  (*# call(o_a_copy=>off) *)
  241  PROCEDURE Send( Buf : ARRAY OF BYTE; Len : CARDINAL );
  242  VAR i : CARDINAL;
  243  BEGIN
  244    FOR i := 0 TO Len-1 DO
  245        OBuf[TXI] := Buf[i];
  246        INC(TXCount);
  247        WHILE TXCount=BufferSize DO END;
  248        TXI := (TXI+1) MOD BufferSize;
  249        IF TXReady THEN TX; END;
  250    END;
  251  END Send;
  252  
  253  VAR
  254    IntTab[0:0] : ARRAY[0..255] OF FarADDRESS;
  255  
  256  
  257  PROCEDURE CloseDown;
  258  BEGIN
  259    SYSTEM.Out( IOBase+IntEnable,00H );
  260    SYSTEM.Out( IOBase+ModemCont,SHORTCARD(b{}));
  261    Lib.Delay(100);
  262    SYSTEM.DI;
  263    IntTab[8+ComINr] := OldC;
  264    SYSTEM.EI;
  265    Term;
  266  END CloseDown;
  267  
  268  PROCEDURE Install( Port : CARDINAL );
  269  BEGIN
  270    IF Port= 1 THEN
  271       Install2( Com1,Com1INr );
  272    ELSE
  273       Install2( Com2,Com2INr );
  274    END;
  275  END Install;
  276  
  277  PROCEDURE Install2( Port,Intr : CARDINAL);
  278  TYPE bs = SET OF SHORTCARD[0..7];
  279  VAR  s  : SHORTCARD; i : CARDINAL;
  280       fa : FarADDRESS;
  281  BEGIN
  282    SYSTEM.DI;
  283    IOBase := Port;
  284    ComINr := Intr;
  285    SYSTEM.Out( IOBase+IntEnable,00H );
  286    SYSTEM.Out( IOBase+LineStatus,0 );
  287    TXI     := 0;
  288    TXO     := 0;
  289    RXI     := 0;
  290    RXO     := 0;
  291    RXCount := 0;
  292    TXCount := 0;
  293    OldC := IntTab[8+ComINr];
  294    IntTab[8+ComINr] := FarADR(Int);
  295    Lib.Terminate( CloseDown,Term );
  296    SYSTEM.NewPriority( CARDINAL(BITSET( SYSTEM.CurrentPriority() )-{ComINr} ) );
  297    TXReady := TRUE;
  298    RTS     := TRUE;
  299    SYSTEM.Out( IOBase+IntEnable,0BH );
  300    SYSTEM.Out( IOBase+ModemCont,SHORTCARD(b{0,1,3}));
  301    SYSTEM.EI;
  302  END Install2;
  303  
  304  
  305  PROCEDURE BreakTest():BOOLEAN;
  306  BEGIN
  307    RETURN 4 IN b(SYSTEM.In( IOBase+LineStatus ));
  308  END BreakTest;
  309  
  310  BEGIN
  311    lc := SYSTEM.In( IOBase+LineCont );
  312  END rs.

    1 error