/* IEEE 488 BUS */

S=001400;
MODULE IECBUS;

SYSTEM;

Monit         : A1 ->;
Taste         : A1 <-;
BUFin         : VI <-;
BUFout        : VO ->;
BEFEHL        : XC ->;
Druck         : A2 ->;
IECout        : BU (0203) ->;
IECin         : BU (02FAFFF8) <-;

PROBLEM;

SPC Monit      DATION OUT ALPHIC CONTROL(ALL);
SPC Taste      DATION IN  ALPHIC CONTROL(ALL);
SPC BEFEHL     DATION OUT ALPHIC CONTROL(ALL);
SPC BUFout     DATION OUT ALPHIC CONTROL(ALL);
SPC BUFin      DATION IN  ALPHIC CONTROL(ALL);
SPC Druck      DATION OUT ALPHIC CONTROL(ALL);
SPC IECin      DATION IN BASIC ;
SPC IECout     DATION OUT BASIC;

DCL (REN,EOI,NRFD,DAV,NDAC,IFC,SRQ,ATN,EOF,STATUS)  BIT(1)
                   INIT ('1'B,'0'B,'1'B,'0'B,'1'B,'0'B,'0'B,'0'B,'0'B);
DCL (set,reset)    INV BIT (1) INIT ('1'B,'0'B);
DCL (STR,DS)       CHAR (80);
DCL (listen, talk) INV CHAR (1) INIT ('?', '_');
DCL CI             CHAR (1);

IN:PROCEDURE RETURNS (CHAR (1));

  DCL in   BIT (16);
  DCL CHR  CHAR (1);

  TAKE in FROM IECin;
   in  = NOT in;
  CHR  = TOCHAR (in);
  EOI  = in.BIT (7);
  DAV  = in.BIT (6);
  NRFD = in.BIT (5);
  NDAC = in.BIT (4);
/*IFC  = in.BIT (3);
  SRQ  = in.BIT (2);
  ATN  = in.BIT (1);*/

  PUT  'IN ', in, CHR, in  TO Druck BY A,X,B1,X,A,X,B4,SKIP;

  RETURN (CHR);
END;

OUT:PROCEDURE (CHR CHAR (1));

  DCL out BIT (16);
  DCL in   BIT (16);

  out  = TOBIT (TOFIXED (CHR));
  IF REN  THEN out = '0000000100000000'B OR out; FIN;
  IF EOI  THEN out = '0000001000000000'B OR out; FIN;
  IF DAV  THEN out = '0000010000000000'B OR out; FIN;
  IF NRFD THEN out = '0000100000000000'B OR out; FIN;
  IF NDAC THEN out = '0001000000000000'B OR out; FIN;
  IF IFC  THEN out = '0010000000000000'B OR out; FIN;
  IF SRQ  THEN out = '0100000000000000'B OR out; FIN;
  IF ATN  THEN out = '1000000000000000'B OR out; FIN;
  SEND NOT out TO IECout;

  TAKE in FROM IECin;
  PUT'OUT', out, CHR, out, NOT in TO Druck BY A,X,B1,X,A,X,B4,X,B1,SKIP;

END;

ABRUCH:TASK PRIO 5;

PUT '                                 ABRUCH' TO Druck BY A, SKIP;

STATUS = set;

END;

ACCEPT:PROCEDURE RETURNS (CHAR (1));

  DCL  (C, B)  CHAR (1);

  PUT ' ACCEPT' TO Druck BY A,SKIP;

  NDAC = set; NRFD = reset; DAV = reset; EOI = reset;
  CALL OUT (TOCHAR (0));
  B = IN;
  STATUS = reset;
  AFTER 0.5 SEC ACTIVATE ABRUCH;
  WHILE (NOT DAV AND NOT STATUS) REPEAT B = IN; END;
  PREVENT ABRUCH;
  IF NOT STATUS THEN
     DAV = reset; NRFD = set; NDAC = reset; EOF = EOI;
     CALL OUT (TOCHAR (0)); C = IN;
     WHILE DAV REPEAT C = IN; END;
  FIN;
  DAV = reset; NDAC = set; NRFD = set;
  CALL OUT (TOCHAR (0));
  PUT B TO Druck BY A,SKIP;
  RETURN (B);

END;

SOURCE:PROCEDURE (CHR  CHAR(1));

  DCL C  CHAR;

  PUT ' SOURCE      ', CHR TO Druck BY A,X,A,SKIP;

  NDAC = reset; NRFD = reset;
  CALL OUT (CHR); C = IN;
  WHILE C NE CHR REPEAT C = IN; END;
  STATUS = reset;
  AFTER 5 SEC ACTIVATE ABRUCH;
  WHILE (NRFD AND NOT STATUS) REPEAT C = IN; END;
  PREVENT ABRUCH;
  IF NOT STATUS THEN
     DAV = set; NDAC = reset;
     CALL OUT (CHR); C = IN;
     WHILE NDAC REPEAT C = IN; END;
  FIN;
  DAV = reset; NDAC = set; NRFD = set;
  CALL OUT (TOCHAR (0));

END;

COMMAND:PROCEDURE (Deviceadr FIXED, Secondadr FIXED);

  PUT ' COMMAND   ', Deviceadr, Secondadr TO Druck BY A,F(4),F(4),SKIP;

  ATN = set;
  CALL SOURCE (TOCHAR (Deviceadr));
  CALL SOURCE (TOCHAR (Secondadr));
  ATN = reset;
  CALL OUT (TOCHAR (0));

END;

LISTEN:PROCEDURE (Deviceadr FIXED, Secondadr FIXED);

  PUT ' LISTEN    ', Deviceadr, Secondadr TO Druck BY A,F(4),F(4),SKIP;

  REN = set;
  CALL COMMAND (Deviceadr + 32, Secondadr + 96);

END;


TALK:PROCEDURE (Deviceadr FIXED, Secondadr FIXED);

  PUT ' TALK      ', Deviceadr, Secondadr TO Druck BY A,F(4),F(4),SKIP;

  REN = set;
  CALL COMMAND (Deviceadr + 64, Secondadr + 96);

END;

UN:PROCEDURE ( wort  CHAR(1));

  PUT ' UN    ' TO Druck BY A, SKIP,SKIP;

  ATN = set;
  CALL SOURCE (wort);
  ATN = reset;
/*CALL SOURCE (TOCHAR (0)); */
CALL OUT (TOCHAR(0));
END;


CLOSE:PROCEDURE (Deviceadr FIXED, Secondadr FIXED);

  PUT ' CLOSE     ', Deviceadr, Secondadr TO Druck BY A,F(4),F(4),SKIP;

  EOF = reset;
  CALL COMMAND (Deviceadr + 32, Secondadr + 224);
  REN = reset;  
  CALL UN(listen);

END;

STRLEN:PROCEDURE ( string CHAR (80)) RETURNS (FIXED);

  DCL pointer   FIXED;

  PUT ' STRLEN' TO Druck BY A,SKIP;

  pointer = 80;
  FOR I FROM 80 BY -1 TO 1
    WHILE string.CHAR (I) EQ ' ' REPEAT
    pointer = I; END;
  RETURN (pointer-1);

END;

OUTPUT:PROCEDURE ( string CHAR (82), len FIXED);

  PUT ' OUTPUT  ', string TO Druck BY A,A,SKIP;

  FOR I FROM 1 TO (len - 1)
    REPEAT CALL SOURCE (string.CHAR(I)); END;
  EOI = set;
  CALL SOURCE (string.CHAR(len));
  EOI = reset;
  CALL UN(listen);

END;

OPEN:PROCEDURE (Deviceadr FIXED, Secondadr FIXED, Filename CHAR(32));

  PUT ' Open      ', Deviceadr, Secondadr TO Druck BY A,F(4),F(4),X,X;
  PUT Filename TO Druck BY A,SKIP;

  REN = set;       
  CALL COMMAND (Deviceadr + 32, Secondadr + 240);
  CALL OUTPUT (Filename, STRLEN(Filename));

END;

Print:PROCEDURE (Deviceadr FIXED, Secondadr FIXED, string CHAR(80));

  PUT ' Print     ', Deviceadr, Secondadr TO Druck BY A,F(4),F(4),X,X;
  PUT string  TO Druck BY A,SKIP;

  CALL LISTEN (Deviceadr, Secondadr);
  CALL OUTPUT (string, STRLEN(string));

END;

PRINT:PROCEDURE (Deviceadr FIXED, Secondadr FIXED, string CHAR(80));

  DCL L   FIXED;

  PUT ' PRINT     ', Deviceadr, Secondadr TO Druck BY A,F(4),F(4),X,X;
  PUT string  TO Druck BY A,SKIP;

  CALL LISTEN (Deviceadr, Secondadr);
  L =  STRLEN(string);
  IF string.CHAR (L) /= TOCHAR (13) THEN
     L = L + 1;
     string.CHAR(L) = TOCHAR (13); FIN;
  CALL OUTPUT (string, L);

END;


LPRINT:PROCEDURE (Deviceadr FIXED, Secondadr FIXED, string CHAR(80));

  DCL L   FIXED;

  PUT ' LPRINT    ', Deviceadr, Secondadr TO Druck BY A,F(4),F(4),X,X;
  PUT string  TO Druck BY A,SKIP;

  CALL LISTEN (Deviceadr, Secondadr);
  L =  STRLEN(string);
  IF string.CHAR (L) /= TOCHAR (13) THEN
     L = L + 2;
     string.CHAR(L - 1) = TOCHAR (13);
     string.CHAR(L) = TOCHAR (10); FIN;
  CALL OUTPUT (string, L);

END;

Input:PROCEDURE (Deviceadr FIXED, Secondadr FIXED) RETURNS (CHAR(1));

  DCL C  CHAR (1);

  PUT ' Input     ', Deviceadr, Secondadr TO Druck BY A,F(4),F(4),SKIP;

  CALL TALK (Deviceadr, Secondadr);
  C = ACCEPT;
  CALL UN(talk);
  PUT C TO Druck BY A,SKIP;
  RETURN (C);

END;

INPUT:PROCEDURE (Deviceadr FIXED, Secondadr FIXED) RETURNS (CHAR(80));

  DCL string  CHAR (80);
  DCL C       CHAR (1);

  PUT ' INPUT     ', Deviceadr, Secondadr TO Druck BY A,F(4),F(4),SKIP;

  FOR I FROM 1 TO 80
      REPEAT string.CHAR (I) = TOCHAR (0); END;
  CALL TALK (Deviceadr, Secondadr);
  C = ACCEPT;
  FOR I FROM 1 TO 80
      WHILE C /= TOCHAR (13)
        REPEAT string.CHAR (I) = C;
        IF NOT EOF THEN C = ACCEPT;
                   ELSE C = TOCHAR (0);
        FIN;
      END;
  CALL UN(talk);
  PUT string TO Druck BY A,SKIP;
  RETURN (string);

END;


IECBUS:TASK;

DCL STRING CHAR (80);

CALL OUT (TOCHAR (0));
CI = IN;
CALL LPRINT (8,15,'I0');
STRING = INPUT (8,15);
CALL CLOSE (8,15);
PUT STRING TO Monit BY A, SKIP;
PUT ('UNLOAD IECBUS, IECBUS, ABRUCH') TO BEFEHL BY A, A, A, SKIP;
END;

MODEND;