C
C	COPYRIGHT (C)   1976
C	DIGITAL EQUIPMENT CORPORATION,  MAYNARD,   MASS.
C
C	THIS SOFTWARE  IS FURNISHED  UNDER A LICENSE  FOR USE ONLY ON A
C	SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION
C	OF THE ABOVE  COPYRIGHT  NOTICE.  THIS  SOFTWARE, OR  ANY OTHER
C	COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE
C	TO ANY OTHER PERSON  EXCEPT  FOR USE ON SUCH SYSTEM  AND TO ONE
C	WHO AGREES  TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP  OF
C	THE SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
C
C	THE  INFORMATION  IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
C	NOTICE  AND  SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
C	EQUIPMENT CORPORATION.
C
C	DEC  ASSUMES NO  RESPONSIBILITY  FOR  THE  USE  OR  RELIABILITY
C	OF  ITS  SOFTWARE ON  EQUIPMENT WHICH  IS  NOT SUPPLIED BY DEC.
C
C
C	CONDITIONALIZER PROGRAM
C
C
	LOGICAL*1 ANS(30,30),Y,CONDS(6,30),LINE(100),NUMSIN,LPAR,BLANK,
     X  CMDS(6,15),COND(11),INCLUD(11),INSERT,SUBNAM(6),FILE(20),CND(5),
     X  FIRST,SEMI,FORMF,QMARK,TAB,EQUALS,QUOTE,COMMA,
     X  PAT(5,30),REP(5,30)
	INTEGER IN,OUT,INS,LPAT(5),LREP(5)
	DATA LEVEL,NACOND,NSUBS/1,1,0/
	DATA ANS,CONDS/900*0,180*0/
	DATA NUMSIN,Y,LPAR,BLANK,SEMI,COMMA/'#','Y','(',' ',';',','/
	DATA FORMF,QMARK,TAB,EQUALS/"14,'?',"11,'='/
	DATA IN,OUT,INS/1,2,3/
	DATA CND/'.','C','N','D',0/
	DATA CMDS/
     X  'F','I','L','E',0,0,'I','F','T','F',0,0,
     X  'I','F','T',0,0,0,'I','F','F',0,0,0,'I','F','N',0,0,0,
     X  'I','F',0,0,0,0,'E','N','D','C',0,0,
     X  'C','A','L','L',0,0,'N','A','M','E',0,0,
     X  'A','S','K',0,0,0,'S','E','T',0,0,0,
     X  'P','R','I','N','T',0,'Q','U','O','T','E',0,
     X  'S','U','B','S',0,0,'E','N','D','S',0,0/
	DATA SUBNAM/'*','N','O','N','E','*'/
	DATA QUOTE,FIRST,INSERT,INCLUD,COND/.FALSE.,.TRUE.,.FALSE.,
     X  .TRUE.,10*0,.TRUE.,10*0/
C
C
	WRITE(5,5)
5	FORMAT(' COND V2.0')
	WRITE(5,10)
10	FORMAT('$FILE NAME ? ')
	READ(5,20)N,(FILE(I),I=1,N)
20	FORMAT(Q,100A1)
	DO 30 I=1,5
30	FILE(N+I)=CND(I)
	CALL ASSIGN(IN,FILE)
110	IF(.NOT.INSERT)READ(IN,20,END=2000,ERR=99000)N,(LINE(I),I=1,N)
	IF(INSERT)READ(INS,20,END=580,ERR=98000)N,(LINE(I),I=1,N)
	IF(LINE(1).EQ.SEMI)GOTO 110
	IF(LINE(1).NE.FORMF)GOTO 140
	DO 130 I=2,N
130	LINE(I-1)=LINE(I)
	N=N-1
140	IF(NSUBS.EQ.0)GOTO 185
	DO 180 I=1,NSUBS
	IS=1
142	IF(IS+LPAT(I)-1.GT.N)GOTO 180
	DO 145 J=1,LPAT(I)
	IE=IS+J-1
	IF(LINE(IE).NE.PAT(I,J))GOTO 175
145	CONTINUE
	K=LPAT(I)-LREP(I)
	IF(K)150,153,160
150	DO 152 J=1,N-IE
152	LINE(N-K+1-J)=LINE(N+1-J)
153	IF(LREP(I).LE.0)GOTO 155
	DO 154 J=1,LREP(I)
154	LINE(IS+J-1)=REP(I,J)
155	N=N-K
	IS=IS+LREP(I)
	GOTO 176
160	DO 162 J=IE+1,N
162	LINE(J-K)=LINE(J)
	GOTO 153
175	IS=IS+1
176	IF(IS.LE.N)GOTO 142
180	CONTINUE
185	IF(N.LT.4)GOTO 110
	LINE(N+1)=0
	IF(LINE(1).NE.TAB.OR.LINE(2).NE.NUMSIN.OR.QUOTE)GOTO 1000
	DO 950 III=1,15
	DO 190 J=1,6
	IF(CMDS(J,III).EQ.0.AND.(LINE(J+2).EQ.0.OR.LINE(J+2).EQ.TAB))
     X  GOTO 195
	IF(LINE(J+2).NE.CMDS(J,III))GOTO 950
190	CONTINUE
195	GOTO (200,250,300,350,400,500,450,550,600,650,700,
     X  750,800,850,900),III
C
C	<TAB>#FILE<TAB><FILE NAME>
C
200	IF(.NOT.INCLUD(LEVEL))GOTO 110
	IF(N.GE.8)GOTO 220
205	WRITE(5,210)SUBNAM,(LINE(K),K=1,N)
210	FORMAT(' MISSING FILE NAME IN ',6A1,/,1X,80A1)
	GOTO 110
220	IF(.NOT.FIRST)CALL CLOSE(OUT)
	FIRST=.FALSE.
	CALL ASSIGN(OUT,LINE(8))
	GOTO 110
C
C	<TAB>#IFTF[<TAB><CONDITIONAL>]
C
250	IF(LEVEL.GT.1)INCLUD(LEVEL)=INCLUD(LEVEL-1)
	GOTO 110
C
C	<TAB>#IFT[<TAB><CONDITIONAL>]
C
300	IF(LEVEL.GT.1)INCLUD(LEVEL)=COND(LEVEL).AND.INCLUD(LEVEL-1)
	GOTO 110
C
C	<TAB>#IFF[<TAB><CONDITIONAL>]
C
350	IF(LEVEL.GT.1)INCLUD(LEVEL)=.NOT.COND(LEVEL).AND.INCLUD(LEVEL-1)
	GOTO 110
C
C	<TAB>#IFN<TAB><CONDITIONAL>
C
400	IF(LEVEL.LT.11)GOTO 410
401	WRITE(5,405)SUBNAM,(LINE(K),K=1,N)
405	FORMAT(' TOO MANY NESTED CONDITIONALS IN ',6A1,/,1X,80A1)
	GOTO 110
410	IF(N.GE.7)GOTO 418
412	WRITE(5,415)SUBNAM,(LINE(K),K=1,N)
415	FORMAT(' MISSING CONDITIONAL IN ',6A1,/,1X,80A1)
	GOTO 110
418	DO 430 I=1,30
	DO 420 J=1,6
	IF(LINE(J+6).EQ.0.AND.CONDS(J,I).EQ.0)GOTO 425
420	IF(LINE(J+6).NE.CONDS(J,I))GOTO 430
425	LEVEL=LEVEL+1
	COND(LEVEL)=ANS(I,1).NE.Y
	INCLUD(LEVEL)=COND(LEVEL).AND.INCLUD(LEVEL-1)
	GOTO 110
430	CONTINUE
435	WRITE(5,440)SUBNAM,(LINE(K),K=1,N)
440	FORMAT(' UNDEFINED CONDITIONAL IN ',6A1,/,1X,80A1)
	GOTO 110
C
C	<TAB>#ENDC[<TAB><CONDITIONAL>]
C
450	IF(LEVEL.GT.1)GOTO 460
	WRITE(5,455)SUBNAM,(LINE(K),K=1,N)
455	FORMAT(' TOO MANY #ENDC''S IN ',6A1,/,1X,80A1)
	GOTO 110
460	LEVEL=LEVEL-1
	GOTO 110
C
C	<TAB>#IF<TAB><CONDITIONAL>
C
500	IF(LEVEL.GE.11)GOTO 401
	IF(N.LT.6)GOTO 412
	DO 530 I=1,30
	DO 520 J=1,6
	IF(LINE(J+5).EQ.0.AND.CONDS(J,I).EQ.0)GOTO 525
520	IF(LINE(J+5).NE.CONDS(J,I))GOTO 530
525	LEVEL=LEVEL+1
	COND(LEVEL)=ANS(I,1).EQ.Y
	INCLUD(LEVEL)=COND(LEVEL).AND.INCLUD(LEVEL-1)
	GOTO 110
530	CONTINUE
	GOTO 435
C
C	<TAB>#CALL<TAB><FILE NAME>
C
550	IF(.NOT.INCLUD(LEVEL))GOTO 110
	IF(N.LT.10)GOTO 205
	IF(.NOT.INSERT)GOTO 570
	WRITE(5,560)SUBNAM,(LINE(K),K=1,N)
560	FORMAT(' NESTED #CALL IN ',6A1,/,1X,80A1)
	GOTO 110
570	INSERT=.TRUE.
	CALL ASSIGN(INS,LINE(8))
	GOTO 110
580	INSERT=.FALSE.
	CALL CLOSE(INS)
	GOTO 110
C
C	<TAB>#NAME<TAB><SEGMENT NAME>
C
600	IF(LEVEL.NE.1)WRITE(5,605)SUBNAM,(LINE(K),K=1,N)
605	FORMAT(' TOO FEW #ENDC''S IN ',6A1,/,1X,80A1)
	LEVEL=1
	DO 610 I=1,6
	K=LINE(I+7)
	IF(I+7.GT.N)K=BLANK
610	SUBNAM(I)=K
	GOTO 110
C
C	<TAB>#ASK<TAB><QUESTION>?<CONDITIONAL>
C
650	IF(.NOT.INCLUD(LEVEL))GOTO 110
	IF(NACOND.LE.30)GOTO 655
651	WRITE(5,652)SUBNAM,(LINE(K),K=1,N)
652	FORMAT(' TOO MANY CONDITIONALS IN ',6A1,/,1X,80A1)
	GOTO 110
655	DO 660 I=7,N
	IF(LINE(I).EQ.QMARK)GOTO 670
660	CONTINUE
661	WRITE(5,665)SUBNAM,(LINE(K),K=1,N)
665	FORMAT(' BAD #ASK IN ',6A1,/,1X,80A1)
	GOTO 110
670	WRITE(5,675)(LINE(J),J=7,I),BLANK
675	FORMAT('$',100A1)
	IF(N.EQ.I)GOTO 661
	DO 680 J=1,N-I
	CONDS(J,NACOND)=LINE(I+J)
680	CONTINUE
	READ(5,685)J,(LINE(K),K=1,J)
685	FORMAT(Q,80A1)
	J=MIN0(J,29)
	DO 690 K=1,J
690	ANS(NACOND,K)=LINE(K)
	ANS(NACOND,J+1)=0
	NACOND=NACOND+1
	GOTO 110
C
C	<TAB>#SET<TAB><CONDITIONAL>=<ANSWER>
C
700	IF(.NOT.INCLUD(LEVEL))GOTO 110
	IF(NACOND.GT.30)GOTO 651
	DO 710 I=7,13
	IF(LINE(I).EQ.EQUALS)GOTO 730
710	CONTINUE
	WRITE(5,720)SUBNAM,(LINE(K),K=1,N)
720	FORMAT(' BAD #SET IN ',6A1,/,1X,80A1)
	GOTO 110
730	DO 740 J=7,I-1
740	CONDS(J-6,NACOND)=LINE(J)
	DO 745 J=I+1,N+1
745	ANS(NACOND,J-I)=LINE(J)
	NACOND=NACOND+1
	GOTO 110
C
C	<TAB>#PRINT<TAB>MESSAGE
C
750	IF(INCLUD(LEVEL))WRITE(5,755)(LINE(J),J=9,N)
755	FORMAT(1X,100A1)
	GOTO 110
C
C	<TAB>#QUOTE
C
800	QUOTE=.TRUE.
	GOTO 110
C
C	<TAB>#SUBS<TAB><QUOTE><PATTERN><QUOTE><CONDITIONAL>[,...]
C
850	IF(.NOT.INCLUD(LEVEL))GOTO 110
	IP=8
	NSTEMP=NSUBS
851	NSUBS=NSUBS+1
	IQC=LINE(IP)
	DO 852 J=1,30
	PAT(NSUBS,J)=LINE(IP+J)
	IF(LINE(IP+J).EQ.IQC)GOTO 860
852	CONTINUE
853	WRITE(5,855)SUBNAM,(LINE(K),K=1,N)
855	FORMAT(' BAD SUBSTITUTE PATTERN IN ',6A1,/,1X,80A1)
856	NSUBS=NSTEMP
	GOTO 110
860	LPAT(NSUBS)=J-1
	IP=IP+J
	DO 890 I=1,30
	DO 865 J=1,6
	IF((LINE(IP+J).EQ.0.OR.LINE(IP+J).EQ.COMMA).AND.
     X  CONDS(J,I).EQ.0)GOTO 870
865	IF(LINE(IP+J).NE.CONDS(J,I))GOTO 890
	J=7
870	DO 880 K=1,30
	REP(NSUBS,K)=ANS(I,K)
	IF(REP(NSUBS,K).NE.0)GOTO 880
	LREP(NSUBS)=K-1
	IP=IP+J+1
	IF(LINE(IP-1).EQ.COMMA)GOTO 851
	GOTO 110
880	CONTINUE
890	CONTINUE
	WRITE(5,895)SUBNAM,(LINE(K),K=1,N)
895	FORMAT(' UNDEFINED CONDITIONAL IN ',6A1,/,1X,80A1)
	GOTO 856
C
C	<TAB>.ENDS
C
900	IF(INCLUD(LEVEL))NSUBS=0
	GOTO 110
950	CONTINUE
	WRITE(5,960)SUBNAM,(LINE(K),K=1,N)
960	FORMAT(' UNDEFINED COMMAND IN ',6A1,/,1X,80A1)
1000	IF(INCLUD(LEVEL))WRITE(OUT,1010,END=97000,ERR=97000)
     X  (LINE(I),I=1,N)
1010	FORMAT(100A1)
1020	QUOTE=.FALSE.
	GOTO 110
2000	CALL CLOSE(IN)
	IF(.NOT.FIRST)CALL CLOSE(OUT)
	STOP
97000	WRITE(5,97010)SUBNAM
97010	FORMAT(' OUTPUT ERROR IN ',6A1)
	STOP
98000	WRITE(5,98010)SUBNAM
98010	FORMAT(' INSERT ERROR IN ',6A1)
	STOP
99000	WRITE(5,99010)SUBNAM
99010	FORMAT(' INPUT ERROR IN ',6A1)
	STOP
	END
                   