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<UC AND UC>=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