/*+B*/
/**********************************************************************/
/*                    VERSION 24.08.86                                */
/*              Optimierung von Digitalschaltungen                    */
/**********************************************************************/
/*        FRANK STEIGNER, TIROLERSTR. 2, 6090 RUESSELSHEIM 7          */
/*        ANPASSUNG FUER ATARI ST   -- CP 10/86                       */
/*                                                                    */
/*        NICHT VON DISKETTE KOMPILIEREN                              */
/*                                                                    */
/*        ACHTUNG: Fuer RTOS-UH fuer Atari ST ab 1/87                 */
/*        Vor Level 2.0                                               */
/*        ist eine Anpassung erforderlich:                            */
/*                                                                    */
/*        Auskommentierte Prozedur CURSET wieder einbinden/austauschen*/
/*        dito. fuer Prozedur CLEAR                                   */
/*        Systemanschluss CURSCO/CURSLI anpassen fuer 512K/ 1MByte    */
/*        Linken mit CURSEA-Assemblerprogramm zur Cursorabschaltung   */
/*-L*/;
S=30000;
MODULE QMC;
SYSTEM; DIALOG:A1.;
        BED:XC.;
        FILE:ED.FILE;
        TASTE:A1.(TFU=1); /*FUER EINZELNE TASTEN   */
/****** SYSTEMANSCHLUSS ZU AKTUELLER CURSORCOLUMN U. CURSORLINE *******/
/*      FUER 1 MBYTE:                                                 */
/*       CURSLI:BU(020F7408)<->;
         CURSCO:BU(020F740A)<->;   */
/*      FUER 512 KBYTE:
         CURSLI:BU(02077408)<->;
         CURSCO:BU(0207740A)<->;   */

PROBLEM; SPC (DIALOG,FILE)            DATION INOUT ALPHIC CONTROL(ALL);
         SPC TASTE                    DATION IN ALPHIC CONTROL(ALL);
         SPC (BED)                    DATION OUT ALPHIC CONTROL(ALL);
/*       SPC CLEAR                    ENTRY GLOBAL;                  */
         SPC WIDTH                    ENTRY GLOBAL;
/*       SPC (CURSLI,CURSCO)          DATION INOUT BASIC;
         SPC (CEIN,CAUS)              ENTRY GLOBAL; /*CURSOR EIN/AUS */

         DCL (CURX,CURY,MAX,EING)     FIXED INIT(0,0,100,0);
         DCL LISTE(32767)             BIT(16);
         DCL LDAT(32767)              BIT(2);
         DCL PRIMLIST(200)            BIT(32);
         DCL INDEX(17,3)              FIXED;
         DCL FRAGE                    CHAR(43);
         DCL (XWDTH,YWDTH)            FIXED;
         DCL (MX,MY,OX,OY)            FIXED INIT (0,8,15,22);
                                      /* CURSORPOSITIONEN */
         DCL ANTW                     CHAR(1);

/**********************************************************************/
/**********************************************************************/
BOX:PROC((x,y,xlen,ylen,c)FIXED);

CALL LINE(x,y,x+xlen,y,c);
CALL LINE(x,y,x,y+ylen,c);
CALL LINE(x,y+ylen,x+xlen,y+ylen,c);
CALL LINE(x+xlen,y,x+xlen,y+ylen,c);

END; /*PROC BOX */

/**********************************************************************/
/*  PROC CURSET; POSITIONIERT DEN CURSOR                              */
/*====================================================================*/
/*  UEBERGABEPARAMETER : CURL 0<=CURL<=24 ; FUER FARBMONITOR: 23      */
/*                       CURC 0<=CURC<=80                             */
/*====================================================================*/
/*
CURSET: PROC((CURC,CURL) FIXED);

  DCL (CC,CL) BIT(16);
  IF ((CURL LE 24)AND(CURL GE 0)) AND ((CURC LE 79)AND(CURC GE 0)) THEN
      CC=TOBIT CURC;                           /* WANDLE DEZIMAL->BIT */
/*    CL=TOBIT CURL;
      CALL CAUS;                    /* CURSOR AUS,SONST GIBTS DRECK */
/*    SEND CC TO CURSCO;                           /* SCHREIBE COLUMN */
/*    SEND CL TO CURSLI;                             /* SCHREIBE LINE */
/*    CALL CEIN;                      /*CURSOR WIEDER EINSCHALTEN */
/*FIN;
END;  /* CURSET */

/**********************************************************************/

CURSET: PROC((CURC,CURL) FIXED);  /* Variante fuer Level 2.0          */

  PUT TOCHAR(27),'=',TOCHAR(CURL+32),TOCHAR(CURC+32) TO DIALOG BY (4)A;

END;

CLEAR: PROC;                      /* Variante fuerLevel 2.0           */

  PUT TOCHAR(27),'*' TO DIALOG BY (2)A;

END;

/**********************************************************************/
BEEP: PROC;
  PUT TOCHAR 7 TO DIALOG BY A;
END;

/**********************************************************************/
EINGABE: PROC((A,B) FIXED);                     /* ZAHLENEINGABE  */
 EING=0;
 WHILE EING LT A OR EING GT B REPEAT /* ZIFFER INNERHALB DER GRENZEN? */
     CALL CURSET(OX,OY);
     PUT FRAGE TO DIALOG BY A;
     CALL CURSET(OX+36,OY);
     CALL BEEP;
     GET EING FROM DIALOG BY SKIP,LIST;      /* ZIFFER EINGEBEN */
 END;
END;

/**********************************************************************/
CREATE: PROC;                                    /* ED.FILE ERSTELLEN */
DCL STRING CHAR(18) INIT(' PONMLKJIHGFEDCBA ');

FOR N FROM 1 TO 17-EING REPEAT; /* NICHT BENOETIGTE EINGAENGE LOESCHEN*/
 STRING.CHAR(N)=' ';
END;
OPEN FILE;
CALL REWIND(FILE);
PUT 'Projekt :................................................',
    'Datum   :................................................',
    'Name    :................................................',
    'Eingaenge:' TO FILE BY (3)(A,SKIP),SKIP,A,(2)SKIP;
FOR N FROM 65 TO 64+EING REPEAT;                         /* EINGAENGE */
 PUT TOCHAR N,':..............................' TO FILE BY (2)A,SKIP;
END;
 PUT 'Ausgaenge:' TO FILE BY SKIP,A,(2)SKIP;
FOR N FROM 1 TO 8 REPEAT;                            /* AUSGAENGE 1-8 */
 PUT 'Q',N,':............................' TO FILE BY A,F(2),A,SKIP;
END;
PUT 'I    EINGAENGE     I           AUSGAENGE           I'
     TO FILE BY (2)SKIP,A,SKIP;
PUT 'I------------------I-------------------------------I---------------
-----' TO FILE BY A,SKIP;
PUT 'I',STRING,'I 1 I 2 I 3 I 4 I 5 I 6 I 7 I 8 I   Kommentar'
     TO FILE BY (3)A,SKIP;
PUT 'I------------------I---I---I---I---I---I---I---I---I---------------
-----' TO FILE BY A,SKIP;
FOR N FROM 1 TO MAX REPEAT;
 PUT 'I                  I   I   I   I   I   I   I   I   I..............
......' TO FILE BY A,SKIP;
END;
PUT TOCHAR 4 TO FILE BY A;                                /* FILEENDE */
CALL REWIND(FILE);
CLOSE FILE;
END;
/**********************************************************************/
ANZAHL: PROC(A FIXED);/* ERMITTLUNG DER ANZAHL DER EINSEN IM DATENFILE*/
DCL EINS FIXED;                     /* ANZAHL DER EINSEN IM DATENWORT */
DCL STRING CHAR(50), INP CHAR(1);

FOR N FROM 1 TO 17 REPEAT;                     /* INDEXLISTE LOESCHEN */
 INDEX(N,1)=0; INDEX(N,2)=0; INDEX(N,3)=0;
END;

FOR N FROM 1 TO 23+EING REPEAT; GET FROM FILE BY SKIP; END;
 GET STRING FROM FILE BY SKIP,A(50);
  INP=STRING.CHAR(1);
FOR N FROM 1 TO MAX WHILE INP NE 'E' AND INP NE TOCHAR 4 REPEAT;
   EINS=1;
   IF STRING.CHAR(22+((A-1)*4)) EQ '1' OR
      STRING.CHAR(22+((A-1)*4)) EQ 'X' THEN
    FOR M FROM 3 TO 18 REPEAT;                    /* EINSEN ERMITTELN */
     IF STRING.CHAR(M) EQ '1' THEN  EINS=EINS+1;
     FIN;
    END;
    INDEX(EINS,1)=INDEX(EINS,1)+2;
   FIN;
  GET STRING FROM FILE BY SKIP,A(50);
 INP=STRING.CHAR(1);
END;
 IF INDEX(1,1) GE 1 THEN INDEX(1,1)=2; INDEX(1,2)=2;
                    ELSE INDEX(1,2)=0;
 FIN;
FOR N FROM 1 TO 16 REPEAT;                  /* INDEXLISTE UMSORTIEREN */
 INDEX(N+1,2)=INDEX(N,2)+INDEX(N+1,1);
END;
INDEX(17,3)=INDEX(17,2);
END;
/**********************************************************************/
EINSEN: PROC(A FIXED) RETURNS(FIXED);   /* ANZAHL EINSEN IN PRIMLISTE */
DCL EIN FIXED INIT(0);

FOR P FROM 1 TO 16 REPEAT;                          /* EINSEN ZAEHLEN */
IF PRIMLIST(A).BIT(P) THEN EIN=EIN+1;
FIN;
END;
RETURN(EIN);
END;
/**********************************************************************/
OVL:PROC;                                        /* SPEICHERUEBERLAUF */
  CALL CLEAR; CALL CURSET(OX,OY);
  PUT 'SPEICHERUEBERLAUF; Programm abgebrochen'
      TO DIALOG BY A,SKIP;
  TERMINATE;
END;
/**********************************************************************/
VERGLEICHEN: PROC(A FIXED);               /* INDEXGRUPPEN VERGLEICHEN */
 DCL (ZEIGER,SUG,EUG,SOG,EOG,ERG) FIXED;
 DCL FLAG BIT(1);
 DCL (BIN1,BIN2,BIN3,BIN4) BIT(16);

  IF A EQ 1 THEN SUG=1;
            ELSE SUG=INDEX(A-1,2)+1;
  FIN;
ZEIGER=INDEX(17,3)+1; EUG=INDEX(A,2); SOG=EUG+1; EOG=INDEX(A+1,2);

IF SUG NE SOG THEN
FOR B FROM SUG BY 2 TO EUG REPEAT;
 FOR C FROM SOG BY 2 TO EOG REPEAT;
  IF LISTE(B) EQ LISTE(C) THEN ERG=0; BIN4=LISTE(B);
     BIN1=LISTE(B+1);
     BIN2=LISTE(C+1);
     BIN3=BIN1 EXOR BIN2;                        /* DATEN VERGLEICHEN */
     FOR N FROM 1 TO 16 REPEAT;    /* ZAHL DER EINSEN IM WORT ZAEHLEN */
      IF BIN3.BIT(N) THEN ERG=ERG+1;
      FIN;
     END;
      IF ERG EQ 1 THEN FLAG='1'B;
        FOR D FROM INDEX(17,3)+1 BY 2 TO ZEIGER WHILE FLAG REPEAT;
         IF LISTE(D) EQ (BIN4 OR BIN3) AND
            LISTE(D+1) EQ (BIN2 AND NOT BIN3) THEN FLAG='0'B;
         FIN;
        END;
           LDAT(B+1)=LDAT(B+1) OR '10'B; /* GEFUNDENE DATEN MARKIEREN */
           LDAT(C+1)=LDAT(C+1) OR '10'B;
         IF FLAG THEN LISTE(ZEIGER)=BIN4 OR BIN3;
                      LISTE(ZEIGER+1)=BIN2 AND NOT BIN3;
                      LDAT(ZEIGER+1)='00'B;
                      ZEIGER=ZEIGER+2;
                       IF ZEIGER GE 32766 THEN CALL OVL;
                       FIN;
         FIN;
      FIN;
  FIN;
 END;
END;
FIN;
INDEX(A,3)=ZEIGER-1; INDEX(17,3)=ZEIGER-1;
END;

/**********************************************************************/
OPTIMIEREN: PROC;
  DCL STRING CHAR(50), OUTPUT CHAR(255), INP CHAR(1), INPUT CHAR(4);
  DCL WERT FIXED(31), WERTE(100) FIXED(31);
  DCL (MAXI,EIN,EINS,PP,LP,OP,WEPO,FOUND) FIXED, MT(100) FIXED;
  DCL MASK BIT(32) INIT('11111111111111110000000000000000'B);
  DCL (BIN,BIN1) BIT(32), (BIN2,BIN3,BIN4) BIT(16), FLAG BIT(1);
  DCL FELD(100,100) BIT(1);
  DCL FILEENDE FIXED INIT(0);

OPEN FILE;                                     /* FILELAENGE ERFASSEN */
CALL REWIND(FILE); INPUT='    ';
FOR N FROM 1 TO MAX+35 WHILE INPUT NE 'ENDE' REPEAT;
 GET INPUT FROM FILE BY SKIP,A(4);
 FILEENDE=N+8;
END;
PUT ' ' TO FILE BY SKIP,A;
CALL REWIND(FILE);
CLOSE FILE;

   FOR A FROM 1 TO 8 REPEAT;                /* 8 AUSGAENGE BEARBEITEN */
FOR N FROM 1 TO 32766 REPEAT;                     /* LISTEN LOESCHEN */
 LISTE(N)='0000000000000000'B; LDAT(N)='00'B;
END;
FOR N FROM 1 TO 200 REPEAT;
 PRIMLIST(N)='00000000000000000000000000000000'B;
END;
FOR N FROM 1 TO 100 REPEAT;
 FOR M FROM 1 TO 100 REPEAT;
  FELD(N,M)='0'B1;
 END;
END;

OPEN FILE;                               /* NEUE DATEN AUS FILE HOLEN */
CALL REWIND(FILE);
CALL ANZAHL(A);                                     /* EINSEN ZAEHLEN */
CALL REWIND(FILE);
PP=1; WEPO=1;                               /* POINTER INITIALISIEREN */
 FOR N FROM 1 TO 23+EING REPEAT; GET FROM FILE BY SKIP; END;
  GET STRING FROM FILE BY SKIP,A(50);
   INP=STRING.CHAR(1);
    FOR N FROM 1 TO MAX WHILE INP NE 'E' AND INP NE TOCHAR 4 REPEAT;
     WERT=0(31); EINS=1;
       INP=STRING.CHAR(22+((A-1)*4));
      IF INP EQ '1' OR INP EQ 'X' THEN
        FOR M FROM 3 TO 18 REPEAT;
          IF STRING.CHAR(M) EQ '1' THEN WERT=WERT+2(31)**(18-M);
                                        EINS=EINS+1;
          FIN;
        END;
         BIN=TOBIT(WERT);
         LISTE(INDEX(EINS,2)-INDEX(EINS,1)+2)=BIN SHIFT(16);
         INDEX(EINS,1)=INDEX(EINS,1)-2;
           IF INP EQ '1' THEN WERTE(WEPO)=WERT; WEPO=WEPO+1;
           FIN;
      FIN;
     GET STRING FROM FILE BY SKIP,A(50);
     INP=STRING.CHAR(1);
    END;
CALL REWIND(FILE);
CLOSE FILE;
 EINS=EING;
 INDEX(17,3)=INDEX(17,2);
FOR B FROM 1 TO EING-1 REPEAT;            /* EING-1 LISTEN BEARBEITEN */
       FOR N FROM 1 TO EING REPEAT;       /* INDEXGRUPPEN VERGLEICHEN */
        IF INDEX(N,2) NE INDEX(N+1,2) THEN CALL VERGLEICHEN(N);
        FIN;
       END;
/*************** PRIMTERME AUS LISTE SUCHEN ***************************/
   FOR N FROM 2 BY 2 TO INDEX(17,2) REPEAT;
     IF NOT LDAT(N).BIT(1) THEN
                                BIN=LISTE(N-1); BIN1=LISTE(N);
                                PRIMLIST(PP)=BIN OR BIN1 SHIFT(-16);
                                PP=PP+1;
     FIN;
   END;
/**********************************************************************/
 FOR N FROM INDEX(17,2)+1 TO INDEX(17,3) REPEAT; /* LISTE UMSORTIEREN */
   LISTE(N-INDEX(17,2))=LISTE(N);
   LDAT(N-INDEX(17,2))=LDAT(N);
 END;
   FOR N FROM 1 TO 16 REPEAT;                      /* NEUE INDEXLISTE */
    IF N LE EINS THEN INDEX(N,2)=INDEX(N,3)-INDEX(17,2);
                 ELSE INDEX(N,2)=INDEX(17,3)-INDEX(17,2);
    FIN;
   END;
  INDEX(17,2)=INDEX(16,2); INDEX(17,3)=INDEX(17,2); EINS=EINS-1;
END;
/********** PRIMTERME DER LETZTEN LISTE AUSLESEN **********************/
   FOR N FROM 2 BY 2 TO INDEX(17,2) REPEAT;
      BIN=LISTE(N-1); BIN1=LISTE(N);
      PRIMLIST(PP)=BIN OR BIN1 SHIFT(-16);
      PP=PP+1;
   END;
/**********************************************************************/
FOR N FROM 1 TO PP-1 REPEAT;                        /* FELD EINTRAGEN */
  FOR M FROM 1 TO WEPO-1 REPEAT;
    BIN=(TOBIT WERTE(M)) SHIFT(16)  AND NOT PRIMLIST(N);
     IF PRIMLIST(N) SHIFT(16) EQ BIN THEN FELD(M,N)='1'B1;
     FIN;
  END;
END;
LP=1;                                        /* MINIMALTERME ERFASSEN */
FOR N FROM 1 TO WEPO-1 REPEAT;
 EIN=0;
  FOR M FROM 1 TO PP-1 REPEAT;
   IF FELD(N,M) THEN EIN=EIN+1;
   FIN;
  END;
   IF EIN EQ 1 THEN FLAG='0'B1;
                    FOR O FROM 1 TO PP-1 WHILE NOT FLAG REPEAT;
                     IF FELD(N,O) THEN FLAG='1'B1;
                      FOR P FROM 1 TO LP-1 REPEAT;
                       IF MT(P) EQ O THEN FLAG='0'B1;
                       FIN;
                      END;
                        IF FLAG THEN MT(LP)=O;
                                     LP=LP+1;
                        FIN;
                     FIN;
                    END;
   FIN;
END;
FOR N FROM 1 TO LP-1 REPEAT;               /* ERFASSTE TERME LOESCHEN */
  FOR M FROM 1 TO WEPO-1 REPEAT;
    IF FELD(M,MT(N)) THEN FOR O FROM 1 TO PP-1 REPEAT;
                            FELD(M,O)='0'B1;
                          END;
    FIN;
  END;
END;
EIN=1;                                        /* WEITERE TERME SUCHEN */
WHILE EIN NE 0 REPEAT;
 MAXI=0; FOUND=1;
  FOR N FROM 1 TO PP-1 REPEAT;
   EIN=0;
    FOR M FROM 1 TO WEPO-1 REPEAT;
     IF FELD(M,N) THEN EIN=EIN+1;
     FIN;
    END;
   IF EIN GT MAXI THEN MAXI=EIN; FOUND=N;
   FIN;
  END;
 EIN=MAXI;
 IF EIN NE 0 THEN                        /* FALLS NEUER TERM GEFUNDEN */
   FOR N FROM 1 TO WEPO-1 REPEAT;                 /* SPALTEN LOESCHEN */
    IF FELD(N,FOUND) THEN FOR O FROM 1 TO PP-1 REPEAT;
                           FELD(N,O)='0'B1;
                          END;
    FIN;
   END;
  FLAG='1'B1;
   FOR N FROM 1 TO LP-1 WHILE FLAG REPEAT;           /* TERM ERFASSEN */
    IF MT(N) EQ FOUND THEN FLAG='0'B1;
    FIN;
   END;
     IF FLAG THEN MT(LP)=FOUND;
                  LP=LP+1;
     FIN;
 FIN;
END;
 FOR N FROM 1 TO 255 REPEAT;                /* AUSGABESTRING LOESCHEN */
  OUTPUT.CHAR(N)=' ';
 END;
/***********AUSGABE DES ERGEBNISSES************************************/
OPEN FILE;
CALL REWIND(FILE);
FOR N FROM 1 TO FILEENDE REPEAT;
 GET INP FROM FILE BY SKIP,A(1);
END;

OUTPUT.CHAR(1)='Q'; OUTPUT.CHAR(2)=TOCHAR(A+48); OUTPUT.CHAR(3)='=';
OP=4;
 FOR M FROM 1 TO LP-1 REPEAT;
  BIN2=PRIMLIST(MT(M)) SHIFT(16);
   OUTPUT.CHAR(OP)='('; OP=OP+1;
    FOR N FROM 33-EING TO 32 REPEAT;
     IF PRIMLIST(MT(M)).BIT(N-16) THEN OUTPUT.CHAR(OP)='-'; OP=OP+1;
      ELSE IF BIN2.BIT(N-16) THEN OUTPUT.CHAR(OP)=TOCHAR(97-N); OP=OP+1;
                ELSE OUTPUT.CHAR(OP)=TOCHAR(129-N); OP=OP+1;
             FIN;
     FIN;
    END;
  IF M LT LP-1 THEN OUTPUT.CHAR(OP)=')'; OUTPUT.CHAR(OP+1)='+'; OP=OP+2;
                ELSE OUTPUT.CHAR(OP)=')';
  FIN;
 END;
  PUT OUTPUT TO FILE BY SKIP,A(OP),SKIP;
  FILEENDE=FILEENDE+5;
  PUT TOCHAR 4 TO FILE BY (3)SKIP,A;
 CALL REWIND(FILE);
 CLOSE FILE;
 END;
END;

/**********************************************************************/
MENUE:PROC;

CALL WIDTH(XWDTH,YWDTH);
CALL CLEAR;
CALL CURSET(MX,MY);
PUT
'               OPTIMIEREN VON DIGITALSCHALTUNGEN            ',
'',
'               1   Daten eingeben                           ',
'               2   Optimieren                               ',
'               3   Ergebnis -> ED.OUTPUT                    ',
'               4   Ergebnis ausdrucken                      ',
'               5   Demo (QMCDEMO in F0.)                    ',
'               6   Ende                                     '
TO DIALOG BY (8)(A,SKIP);
CALL BOX(XWDTH//8,YWDTH//8,XWDTH//8*6,YWDTH//8*6,1);
END; /*PROC MENUE */

/**********************************************************************/
WAHL:PROC;
  ANTW=TOCHAR(0);
  WHILE TOFIXED(ANTW)<TOFIXED('1')OR TOFIXED(ANTW)>TOFIXED('6') REPEAT
    CALL CURSET(OX,OY);
    PUT FRAGE TO DIALOG BY A;
    CALL CURSET(OX+30,OY);
    GET ANTW FROM TASTE BY SKIP,A;
  END;
END; /* PROC WAHL */

/**********************************************************************/
QMC: TASK;
DCL INP FIXED;
DCL DONE BIT(1) INIT('0'B);
DCL STATE FIXED INIT (0);

WHILE NOT DONE REPEAT
 CALL MENUE;
 FRAGE='Bitte waehlen                            ';
   CASE STATE

     ALT CALL BEEP;
         CALL CURSET(MX+15,MY+12);
         PUT 'FERTIG. Ergebnis in ED.OUTPUT' TO DIALOG BY A;
     ALT CALL BEEP;
         CALL CURSET(MX+15,MY+12);
         PUT 'Optimierung beendet          ' TO DIALOG BY A;
     ALT CALL BEEP;
         CALL CURSET(MX+15,MY+12);
         PUT 'Demo-Daten geladen           ' TO DIALOG BY A;
     OUT;
   FIN; /* OF CASE */

 CALL WAHL;
   CALL CURSET(OX,OY);
   PUT 'Bitte warten                               'TO DIALOG BY A;
   CASE (TOFIXED(ANTW)-TOFIXED('0'))

     ALT FRAGE='Anzahl der unabhaengigen Eingaenge:   <RET>';
         CALL EINGABE(2,16);
         CALL CREATE;
         PUT 'SUSPEND QMC--ED ED.FILE--CONTINUE QMC;' TO BED BY A;
         STATE=0;

     ALT CALL OPTIMIEREN;
         STATE=2;

     ALT PUT 'O ED.OUT; COPY ED.FILE>ED.OUTPUT'
         TO BED BY A,SKIP;
         STATE=1;

     ALT PUT 'O ED.OUT; COPY ED.FILE>PP.'
         TO BED BY A,SKIP;
         STATE=0;

     ALT EING=4;CALL CREATE;
         PUT 'SU QMC -- COPY F0.QMCDEMO>ED.FILE -- C QMC' TO BED BY A;
         STATE=3;

     OUT DONE='1'B;

   FIN;
END; /* REPEAT */

PUT 'ERASE ED.FILE' TO BED BY A,SKIP;
CALL CLEAR;
PUT 'Bye ' TO DIALOG BY (2)SKIP,A,SKIP;
END;

MODEND;