%BEGIN; !TAKEON: CONVERT IMP15 GRAMMAR %CONSTINTEGER GRAMMAR=1, OLDFILE=2; !IN STREAMS %CONSTINTEGER REPORT=0, NEWFILE=1, GLIST=2, DLIST=3; !OUT STREAMS %CONSTINTEGER IDENT=70 %CONSTINTEGER LASTBIT=512, EXIT=0 %OWNINTEGER CHARMAX=0, NMAX=-1, INITS=0 %OWNINTEGER NEWNAME=0 %INTEGER SYM,GMIN,GMAX,KMAX %BYTEINTEGERARRAY CHAR(1:600) %INTEGERARRAY INDEX(0:127) %INTEGERARRAY ITEM,NEXT(0:255) %INTEGERARRAY INITIAL(1:79) %INTEGERARRAY KEYDICT(32:511) %const %integer phrase min = 112 %const %integer atom max = 111 %integer %array phrase(phrase min:255) %integer %array atomic(80:111) %ROUTINE READ SYM %CYCLE READ SYMBOL(SYM) %UNTIL SYM # ' ' %RETURN %UNLESS SYM = '-' %AND NEXTSYMBOL = NL SKIP SYMBOL %REPEAT %END %ROUTINE PRINT CHARS(%INTEGER P) PRINT SYMBOL(CHAR(P)) %AND P=P+1 %WHILE CHAR(P) # 0 %END %ROUTINE PRINT NAME(%INTEGER N) PRINT CHARS(INDEX(N&127)) %WHILE N&384 # 0 %CYCLE PRINT SYMBOL('<'); N = N-128 %REPEAT %END %ROUTINE READ NAME(%INTEGERNAME N) %INTEGER I,J,K,M I = CHARMAX %CYCLE I = I+1; CHAR(I) = SYM READ SYMBOL(SYM) %EXIT %UNLESS 'A'<=SYM<='Z' %OR '0'<=SYM<='9' %OR SYM='''' %REPEAT I = I+1; CHAR(I) = 0 READ SYM %IF SYM = ' ' M = NMAX %WHILE M >= 0 %CYCLE J = INDEX(m); K = CHARMAX+1 %WHILE J # 0 %AND CHAR(J) = CHAR(K) %CYCLE ->OK %IF CHAR(J) = 0 J = J+1; K = K+1 %REPEAT M = M-1 %REPEAT OK: %IF NEWNAME # 0 %START %IF M >= 0 %START %PRINTTEXT 'DUPLICATE: ' PRINT CHARS(CHARMAX+1) NEWLINE %FINISH INDEX(N) = CHARMAX+1; CHARMAX = I NMAX = N %IF NMAX < N %FINISH %ELSE %START %IF M < 0 %START %PRINTTEXT 'UNKNOWN: ' PRINT CHARS(CHARMAX+1) NEWLINE M = 0 %FINISH N = M %FINISH %END %ROUTINE READ GRAMMAR %OWNINTEGER MINMIN=0, MAXMAX=0 %INTEGER I,J,K,L,P,MIN,MAX,EXP,END %INTEGERARRAY CONVERTED(-100:150), HEAD,TAIL(-100:-1), TOKEN,LINK(1:150) %INTEGERARRAY MAP(0:255) %INTEGERFN CELL(%INTEGER H,T) !CREATES A LIST CELL, IF NECESSARY, WITH HEAD H AND TAIL T %INTEGER I I = T; I = 0 %IF I > 0 %WHILE I # MIN %CYCLE I = I-1 %RESULT = I %IF HEAD(I) = H %AND TAIL(I) = T %REPEAT MIN = MIN-1; HEAD(MIN) = H; TAIL(MIN) = T CONVERTED(MIN) = 0 %RESULT = MIN %END %INTEGERFN UNION(%INTEGER X,Y) %INTEGER HX,HY %RESULT = X %IF X = Y HX=X %AND X=Y %AND Y=HX %IF X < Y %IF X >= 0 %START %RESULT = CELL(X,Y) %IF Y >= 0 HY = HEAD(Y) %RESULT = CELL(X,Y) %IF X > HY %RESULT = CELL(HY,UNION(X,TAIL(Y))) %IF X # HY %RESULT = Y %FINISH HX = HEAD(X); HY = HEAD(Y) %RESULT = CELL(HX,UNION(TAIL(X),Y)) %IF HX > HY %RESULT = CELL(HY,UNION(X,TAIL(Y))) %IF HX # HY %RESULT = CELL(HX,UNION(TAIL(X),TAIL(Y))) %END %ROUTINE CONCATENATE(%INTEGER X,Y) %INTEGER I,J I = X %UNTIL I = X %CYCLE J = LINK(I); LINK(I) = Y; I = J %REPEAT %END %ROUTINE ACCEPT EXP(%INTEGERNAME EXP,EXP END) !INPUTS A REGULAR EXPRESSION AND CREATES INTERMEDIATE GRAPH REPRESENTATION %INTEGER I,STRING,STRING END,UNIT,UNIT END EXP = 0 S: STRING = 0 U: %IF SYM = '(' %START READ SYM ACCEPT EXP(UNIT,UNIT END) ->ERR %IF UNIT = 0 %OR SYM # ')' READ SYM %FINISH %ELSE %START %IF 'A' <= SYM <= 'Z' %START READ NAME(I) I = I+128 %AND READ SYM %WHILE SYM = '<' %FINISH %ELSE %START ->ERR %IF SYM # '+' I = 0 I = I+128 %AND READ SYM %WHILE SYM = '+' %FINISH MAX = MAX+1; TOKEN(MAX) = I; LINK(MAX) = MAX UNIT = MAX; UNIT END = MAX %FINISH %IF SYM = '*' %OR SYM = '!' %START MAX = MAX+1; TOKEN(MAX) = -1; LINK(MAX) = MAX MIN = MIN-1; HEAD(MIN) = MAX; TAIL(MIN) = UNIT CONCATENATE(UNIT END,MIN); UNIT END = MAX UNIT = MIN %IF SYM = '*' READ SYM %FINISH %IF SYM = '?' %START MAX = MAX+1; TOKEN(MAX) = -1 LINK(MAX) = LINK(UNIT END); LINK(UNIT END) = MAX MIN = MIN-1; HEAD(MIN) = MAX; TAIL(MIN) = UNIT UNIT = MIN READ SYM %FINISH %IF STRING=0 %THEN STRING=UNIT %ELSE CONCATENATE(STRING END,UNIT) STRING END = UNIT END ->U %UNLESS SYM = ',' %OR SYM = ')' %OR SYM = NL %IF EXP = 0 %START EXP = STRING EXP END = STRING END %FINISH %ELSE %START EXP = UNION(STRING,EXP) I = LINK(EXP END) LINK(EXP END) = LINK(STRING END) LINK(STRING END) = I %FINISH %RETURN %UNLESS SYM = ',' READ SYM %UNTIL SYM # NL ->S ERR:EXP = 0 %END %ROUTINE CONVERT %INTEGER I,J,COUNT,M,N,GMAX1,LOOPSTOP %ROUTINE TCOUNT(%INTEGER X) %INTEGER T %CYCLE %RETURN %IF X = 0 %IF X < 0 %START TCOUNT(TAIL(X)) X = HEAD(X) %FINISH T = TOKEN(X) %EXIT %IF T >= 0 %RETURN %IF T = LOOPSTOP TOKEN(X) = LOOPSTOP X = LINK(X) %REPEAT COUNT = COUNT-1 %END %ROUTINE ADD COMPONENTS(%INTEGER X) %OWNINTEGER I,T,TC,U,UC %WHILE X # 0 %CYCLE %IF X < 0 %START ADD COMPONENTS(TAIL(X)) X = HEAD(X) %FINISH T = TOKEN(X) %EXIT %IF T >= 0 %RETURN %IF T = LOOPSTOP TOKEN(X) = LOOPSTOP X = LINK(X) %REPEAT %IF X # 0 %THEN X = LINK(X) %ELSE T = EXIT TC = T&127 I = GMAX1 %CYCLE I = I+1 %EXIT %IF I > GMAX U = ITEM(I) NEXT(I)=UNION(NEXT(I),X) %AND %RETURN %IF U = T UC = U&127 %IF UC = TC %OR (UC > ATOMMAX %AND TC > ATOMMAX) %START %PRINTTEXT 'CLASH: '; PRINT NAME(U); SPACE; PRINT NAME(T) NEWLINE %FINISH %IF TC = IDENT %OR (TC=PHRASEMIN) %OR UC = 0 %START %CYCLE I = GMAX,-1,I ITEM(I+1) = ITEM(I) NEXT(I+1) = NEXT(I) %REPEAT %EXIT %FINISH %REPEAT GMAX = GMAX+1 ITEM(I) = T; NEXT(I) = X %END LOOPSTOP = -1; GMIN = GMAX+1 %CYCLE I = MIN,1,MAX CONVERTED(I) = 0 %REPEAT N = NEXT(0) 1: GMAX1 = GMAX LOOPSTOP = LOOPSTOP-1 ADD COMPONENTS(N) ITEM(GMAX) = ITEM(GMAX)+LASTBIT %IF GMAX1 = 0 %START INITS = GMAX INITS = INITS-1 %WHILE INITS # 0 %AND ITEM(INITS)&127 >= PHRASEMIN %FINISH CONVERTED(N) = GMAX+1 M = 0 %CYCLE I = GMIN,1,GMAX J = NEXT(I) %IF J # 0 %START COUNT = CONVERTED(J) %IF COUNT = 0 %START LOOPSTOP = LOOPSTOP-1 TCOUNT(J) CONVERTED(J) = COUNT %FINISH %IF COUNT < M %START M = COUNT; N = J %FINISH %FINISH %REPEAT ->1 %IF M # 0 %CYCLE I = GMIN,1,GMAX J = NEXT(I) J = CONVERTED(J) %IF J # 0 NEXT(I) = J %REPEAT %END; !CONVERT %ROUTINE MINIMIZE %INTEGER I,J,K,M,N %INTEGERARRAY STACK(1:150) %INTEGERFN ULT MAP(%INTEGER I) %INTEGER J J=I %AND I=MAP(I) %UNTIL I = J %OR I = 0 %RESULT = J %END %INTEGERFN EQUIVALENT(%INTEGER NN,MM) %INTEGER I,J,K,POS1,POS2 POS1 = 0; POS2 = 0 1: %CYCLE K = ITEM(MM) ->9 %UNLESS ITEM(NN) = K I = NEXT(NN); J = NEXT(MM) ->9 %IF (I=0 %AND J#0) %OR (I#0 %AND J=0) POS1 = POS1+1; STACK(POS1) = NN; MAP(NN) = MM NN = NN+1; MM = MM+1 %EXIT %IF K&LASTBIT # 0 %REPEAT 2: %RESULT = 1 %IF POS2 = POS1 POS2 = POS2+1; I = STACK(POS2) NN = ULT MAP(NEXT(I)); MM = ULT MAP(NEXT(MAP(I))) ->2 %IF NN = MM %IF NN < MM %START I = NN; NN = MM; MM = I %FINISH ->1 %IF NN > N 9: %WHILE POS1 # 0 %CYCLE I = STACK(POS1); MAP(I) = I POS1 = POS1-1 %REPEAT %RESULT = 0 %END %CYCLE I = 0,1,GMAX MAP(I) = I %REPEAT %CYCLE N = GMIN,1,GMAX %IF MAP(N) = N %START %IF N = GMIN %OR ITEM(N-1)&LASTBIT # 0 %START M = 1 %WHILE M # N %CYCLE %EXIT %IF MAP(M) = M %AND EQUIVALENT(N,M) # 0 M = M+1 %REPEAT %FINISH %FINISH %ELSE %START MAP(N) = ULT MAP(N) %FINISH %REPEAT J = GMIN-1 %CYCLE I = GMIN,1,GMAX K = MAP(I) %IF K = I %START J = J+1; MAP(I) = J ITEM(J) = ITEM(I); NEXT(J) = NEXT(I) %FINISH %ELSE %START MAP(I) = MAP(K) %FINISH %REPEAT GMAX = J %CYCLE I = GMIN,1,GMAX K = NEXT(I) NEXT(I) = MAP(K) %IF K # 0 %REPEAT %END; !MINIMIZE GMAX = 0 1: READ SYM %UNTIL SYM # NL ->10 %IF SYM = '/' %IF SYM = 'S' %AND NEXT SYMBOL = 'S' %START SKIP SYMBOL; P = 0 %FINISH %ELSE %START READ NAME(P); ->9 %UNLESS PHRASEMIN <= P <= 127 %FINISH MIN = 0; MAX = 0 READ SYM %UNTIL SYM # NL %AND SYM # '-' %AND SYM # '>' ACCEPT EXP(EXP,END) ->9 %IF EXP = 0 %OR SYM # NL CONCATENATE(END,0) ITEM(0) = 1023; NEXT(0) = EXP CONVERT MINMIN = MIN %IF MIN < MINMIN MAXMAX = MAX %IF MAX > MAXMAX I = GMIN MINIMIZE %AND I=MAP(GMIN) %UNLESS P = 112; !APP SELECT OUTPUT(GLIST) %IF P = 0 %START; !SS %CYCLE I = 1,1,GMAX J = ITEM(I); K = NEXT(I) %IF K # 0 %START K = K-INITS; %STOP %IF K <= 0 %FINISH %IF I <= INITS %START L = J&127 ->99 %IF L >= PHRASEMIN L = ATOMIC(L) %IF L >= 80 %MONITOR 25 %IF INITIAL(L) # 0 INITIAL(L) = j<<8+K;! j was jj *** %FINISH %ELSE %START ITEM(I-INITS) = J; NEXT(I-INITS) = K %FINISH 99: %REPEAT GMAX = GMAX-INITS %FINISH %ELSE %START PHRASE(P) = I PRINT NAME(P); %PRINTTEXT ' =>' WRITE(I,1) %FINISH K = LASTBIT %CYCLE I = GMIN,1,GMAX %IF K&LASTBIT # 0 %START NEWLINE; WRITE(I,3); J = 0 %FINISH J = J+1 %IF J > 5 %START NEWLINE; SPACES(4); J = 1 %FINISH SPACES(3) K = ITEM(I) %IF K&127 # 0 %START PRINT NAME(K) %FINISH %ELSE %START %PRINTTEXT '*E' PRINT SYMBOL('+') %AND K=K-128 %WHILE K&384 # 0 %FINISH WRITE(NEXT(I),1) %REPEAT NEWLINE SELECT OUTPUT(REPORT) ->1 9: PRINT NAME(P) %AND NEWLINE %IF P # 0 %PRINTTEXT 'WRONG FORMAT AT: ' K = 0 %WHILE SYM # NL %OR K = ',' %OR K = '-' %CYCLE PRINT SYMBOL(SYM); K = SYM; READ SYMBOL(SYM) %REPEAT NEWLINE ->1 10: %PRINTTEXT 'MIN ='; WRITE(MINMIN,1) %PRINTTEXT ' MAX ='; WRITE(MAXMAX,1) NEWLINE !DEAL WITH INITIAL PHRASE !ASSUMES EXACTLY ONE (IMP) P = PHRASE(ITEM(1)&127) %MONITOR 26 %IF P = 0 %CYCLE J = ITEM(P); K = J&127 %MONITOR 27 %IF K >= PHRASEMIN K = ATOMIC(K) %IF K >= 80 %MONITOR 28 %IF INITIAL(K) # 0 INITIAL(K) = (J&127+LASTBIT)<<8+NEXT(P) %EXIT %IF J&LASTBIT # 0 P = P+1 %REPEAT SELECT OUTPUT(GLIST) NEWLINES(2) %CYCLE I = 1,1,79 K = INITIAL(I) %IF K # 0 %START WRITE(I,2); %PRINTTEXT ': ' PRINT NAME(K>>8); WRITE(K&255,3) NEWLINE %FINISH %REPEAT SELECT OUTPUT(REPORT) %END; !READ GRAMMAR %ROUTINE READ ATOMS %INTEGER I,J,K,DICT,DMAX,CODE,CLASS,SUB %INTEGERARRAY CHAR,CONT,ALT(0:450) %ROUTINE READ CODE CODE = NEXT SYMBOL; SUB = 0 %IF CODE # ',' %AND CODE # NL %START SKIP SYMBOL %RETURN %UNLESS CODE = '(' READ(SUB) SKIP SYMBOL %FINISH CODE = CLASS+128 %END %ROUTINE INSERT WORD(%INTEGERNAME X) %CYCLE CODE = NL %IF CODE = '$' %WHILE CHAR(X) < CODE %CYCLE CONT(X) = SUB %IF CONT(X) = 0 X == ALT(X) %REPEAT %IF CHAR(X) # CODE %START DMAX = DMAX+1; CHAR(DMAX) = CODE CONT(DMAX) = 0; ALT(DMAX) = X; X = DMAX %FINISH %EXIT %IF CODE&128 # 0 READ CODE X == CONT(X) %REPEAT CONT(X) = SUB %END %ROUTINE STORE(%INTEGER X) %INTEGER M,N,V %CYCLE KMAX = KMAX+1; N = KMAX M = ALT(X) STORE(M) %AND M=-131072 %IF M # 0 V = CHAR(X); X = CONT(X) %EXIT %IF V&128 # 0 %IF M = 0 %START; !NO ALTERNATIVES %IF ALT(X) = 0 %AND CHAR(X)&128 = 0 %START V = CHAR(X)<<7+V; X = CONT(X) %FINISH %FINISH %ELSE %START V = (KMAX+1)<<7+V-131072 %FINISH KEYDICT(N) = V %REPEAT KEYDICT(N) = M + 65536 + X<<6 + V&63 %END DICT = 0; DMAX = 0; CHAR(0) = 999 1: %CYCLE SYM = NEXT SYMBOL %EXIT %UNLESS SYM = '[' %OR SYM = NL READ SYMBOL(SYM) %UNTIL SYM = NL %REPEAT ->10 %IF SYM = '/' READ(CLASS) NEWNAME = 1 READ SYM; READ NAME(CLASS) NEWNAME = 0 %IF CLASS < 80 %START %IF SYM # '[' %START %CYCLE CODE = SYM; INSERT WORD(DICT) READ SYMBOL(SYM) %EXIT %IF SYM # ',' READ SYMBOL(SYM) %UNTIL SYM # ' ' %AND SYM # NL %REPEAT %FINISH %FINISH %ELSE %START %IF CLASS < PHRASEMIN %AND SYM = '=' %START READ SYM; READ NAME(ATOMIC(CLASS)) %FINISH %FINISH READ SYMBOL(SYM) %WHILE SYM # NL ->1 %ROUTINE DISPLAY(%INTEGER I,S) %INTEGER J 1: J = KEYDICT(I) %IF J&65536 = 0 %START PRINT SYMBOL(J&127) %IF J > 0 %START J = J>>7 PRINT SYMBOL(J) %AND S=S+1 %IF J # 0 SPACE I = I+1; S = S+2 ->1 %FINISH SPACE DISPLAY(J>>7&511,S+2) %FINISH %ELSE %START PRINT SYMBOL(':'); PRINT NAME(J&63) WRITE(J>>6&1023,1); NEWLINE %FINISH %RETURN %IF J >= 0 SPACES(S); I = I+1 ->1 %END 10: SELECT OUTPUT(DLIST); NEWLINES(2) KMAX = 95; KEYDICT(32) = 0 %CYCLE I = 33,1,95 PRINT SYMBOL(I); SPACE %IF CHAR(DICT) = I %START J = (KMAX+1)<<2 STORE(CONT(DICT)) DICT = ALT(DICT) DISPLAY(J>>2,2) %FINISH %ELSE %START PRINT SYMBOL('?'); NEWLINE J = 32<<2 %FINISH !LET:0 DIG:1 TERM:2 OTHER:3 J = J+3 %UNLESS 'A'<=I<='Z' J = J-2 %IF '0'<=I<='9' J = J-1 %IF I = ';' KEYDICT(I) = J %REPEAT NEWLINES(2) SELECT OUTPUT(REPORT) %END %INTEGER I,J,K CHARMAX = 0 %CYCLE I = 1,1,127; INDEX(I) = 0; %REPEAT %CYCLE I = 1,1,79; INITIAL(I) = 0; %REPEAT SELECT OUTPUT(REPORT) READ SYMBOL(I) %UNTIL I = '/' READ SYMBOL(I) %UNTIL I = NL READ ATOMS READ SYMBOL(I) %UNTIL I = NL READ GRAMMAR !WRITE REQUIRED VALUES SELECT OUTPUT(NEWFILE) SELECT INPUT(OLDFILE); %FAULT 9 ->EOF I = 0 %CYCLE READ SYMBOL(K); PRINT SYMBOL(K) I = 1 %IF K = '!' %AND NEXT SYMBOL = '*' %EXIT %IF I = 1 %AND K = NL %REPEAT EOF:%PRINTTEXT '%OWNINTEGER GMAX1='; WRITE(GMAX,0) NEWLINE %PRINTTEXT '%OWNINTEGER GMAX='; WRITE(GMAX,0) NEWLINES(2) %PRINTTEXT '%OWNINTEGERARRAY PHRASE(112:127) = %C' %CYCLE I = 112,1,127 NEWLINE %IF I&7 = 0 WRITE(phrase(I),3) PRINT SYMBOL(',') %UNLESS I = 127 %REPEAT NEWLINES(2) %PRINTTEXT '%OWNINTEGERARRAY ATOMIC(80:111) = %C' %CYCLE I = 80,1,111 NEWLINE %IF I&7 = 0 WRITE(atomic(I),3) PRINT SYMBOL(',') %UNLESS I = 111 %REPEAT NEWLINES(2) %INTEGERFN PACKED(%INTEGER J,K) K = (J&896)<<1+K J = J&127 %RESULT = K<<7+J %END %PRINTTEXT '%OWNINTEGERARRAY INITIAL(1:79) = %C' NEWLINE; SPACES(9) %CYCLE I = 1,1,79 NEWLINE %IF I&7 = 0 WRITE(PACKED(INITIAL(I)>>8,INITIAL(I)&255),7) PRINT SYMBOL(',') %UNLESS I = 79 %REPEAT NEWLINES(2) %PRINTTEXT '%OWNINTEGERARRAY GRAM(0:255) = %C' %CYCLE I = 0,1,255 NEWLINE %IF I&7 = 0 K = 0 K = PACKED(ITEM(I)!!512,NEXT(I)) %IF I # 0 %AND I <= GMAX WRITE(K,7) PRINT SYMBOL(',') %UNLESS I = 255 %REPEAT NEWLINES(2) %PRINTTEXT '%OWNINTEGERARRAY KDICT(32:'; WRITE(KMAX,0) %PRINTTEXT ') = %C' %CYCLE I = 32,1,KMAX NEWLINE %IF I&7 = 0 WRITE(KEYDICT(I),7) PRINT SYMBOL(',') %UNLESS I = KMAX %REPEAT NEWLINES(2) %FAULT 9 ->99 %CYCLE %EXIT %IF NEXT SYMBOL = '!' READ SYMBOL(K) %UNTIL K = NL %REPEAT %CYCLE READ SYMBOL(K); PRINT SYMBOL(K) %REPEAT 99: %ENDOFPROGRAM