%BEGIN; !TAKEON: CONVERT IMP15 GRAMMAR %OWNINTEGER GRA=1, OLD=2; !IN STREAMS %OWNINTEGER ERR=0, NEW=1, GLIST=2, DLIST=3; !OUT STREAMS %OWNINTEGER SSBASE=92 %OWNINTEGER EOP=0, NMAX=-1 %INTEGER SYM,COUNT,ORDINAL,CHARMAX,GMIN,GMAX,KMAX %INTEGERARRAY CHAR(1:600),INDEX(0:127) %INTEGERARRAY ITEM,NEXT(0:255),PHRASE(SSBASE:111),ATOMIC(64:111) %INTEGERARRAY KEYDICT(32:511) %FAULT 9 ->99 %ROUTINE READ SYM 1: READ SYMBOL(SYM); ->1 %IF SYM = ' ' %END %ROUTINE READ NAME(%INTEGERNAME N) %INTEGER I,J,K I = CHARMAX 1: I = I+1; CHAR(I) = SYM READ SYMBOL(SYM) ->1 %IF 'A' <= SYM <= 'Z' %OR '0' <= SYM <= '9' %OR SYM = '''' I = I+1; CHAR(I) = 0 N = -1 2: ->5 %IF N = NMAX N = N+1 J = INDEX(N); K = CHARMAX+1 3: ->2 %IF J = 0 %OR CHAR(J) # CHAR(K) ->9 %IF CHAR(J) = 0 J = J+1; K = K+1 ->3 5: N = N+1; NMAX = N INDEX(N) = CHARMAX+1; CHARMAX = I 9: READ SYM %IF SYM = ' ' %END %ROUTINE PRINT NAME(%INTEGER N) N = INDEX(N&127) 1: PRINT SYMBOL(CHAR(N)); N = N+1 ->1 %IF CHAR(N) # 0 %END %ROUTINE READ GRAMMAR %INTEGER I,J,P,MIN,MAX,EXP,END,TERMINAL %INTEGERARRAY CONVERTED(-100:125), HEAD,TAIL(-100:-1), TOKEN,LINK(1:125) %INTEGERARRAY MAP(0:255) %INTEGERFN NEW(%INTEGER H,T) %INTEGER I I = T; I = 0 %IF I > 0 1: ->2 %IF I = MIN I = I-1 %RESULT = I %IF HEAD(I) = H %AND TAIL(I) = T ->1 2: 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 %RESULT = UNION(Y,X) %IF X < Y %IF X >= 0 %THEN %START %RESULT = NEW(X,Y) %IF Y >= 0 HY = HEAD(Y) %RESULT = NEW(X,Y) %IF X > HY %RESULT = NEW(HY,UNION(X,TAIL(Y))) %IF X # HY %RESULT = UNION(X,TAIL(Y)) %FINISH HX = HEAD(X); HY = HEAD(Y) %RESULT = NEW(HX,UNION(TAIL(X),Y)) %IF HX > HY %RESULT = NEW(HY,UNION(X,TAIL(Y))) %IF HX # HY %RESULT = NEW(HX,UNION(TAIL(X),TAIL(Y))) %END %ROUTINE CONCATENATE(%INTEGER X,Y) %INTEGER I,J I = X 1: J = LINK(I); LINK(I) = Y; I = J ->1 %UNLESS I = X %END %ROUTINE ACCEPT EXP(%INTEGERNAME EXP,EXP END) %INTEGER I,STRING,STRING END,UNIT,UNIT END EXP = 0 1: STRING = 0 2: %IF SYM = '(' %THEN %START READ SYM ACCEPT EXP(UNIT,UNIT END) ->9 %UNLESS UNIT # 0 %AND SYM = ')' READ SYM %FINISH %ELSE %START ->9 %UNLESS 'A' <= SYM <= 'Z' READ NAME(I) 3: %IF SYM = '<' %THEN %START I = I+128 READ SYM ->3 %FINISH MAX = MAX+1; TOKEN(MAX) = I; LINK(MAX) = MAX UNIT = MAX; UNIT END = MAX %FINISH %IF SYM = '*' %OR SYM = '!' %THEN %START MAX = MAX+1; TOKEN(MAX) = 0; 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 = '?' %THEN %START MAX = MAX+1; TOKEN(MAX) = 0 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 ->2 %UNLESS SYM = ',' %OR SYM = ')' %OR SYM = NL %IF EXP = 0 %THEN %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 = ',' 8: READ SYM; ->8 %IF SYM = NL ->1 9: EXP = 0 %END %ROUTINE CONVERT %INTEGER I,J,K,L,M,N,GMAX1,LOOP STOP %ROUTINE TCOUNT(%INTEGER X) %INTEGER T 1: %RETURN %IF X = 0 %IF X < 0 %THEN %START TCOUNT(TAIL(X)) X = HEAD(X) %FINISH T = TOKEN(X) %IF T <= 0 %THEN %START %RETURN %IF T = LOOP STOP TOKEN(X) = LOOP STOP X = LINK(X) ->1 %FINISH K = K-1 %END %ROUTINE ADD COMPONENTS(%INTEGER X) %OWNINTEGER I,J,K,T 1: %IF X # 0 %THEN %START %IF X < 0 %THEN %START ADD COMPONENTS(TAIL(X)) X = HEAD(X) %FINISH T = TOKEN(X) %IF T <= 0 %THEN %START %RETURN %IF T = LOOP STOP TOKEN(X) = LOOP STOP; X = LINK(X) ->1 %FINISH I = GMAX1; X = LINK(X) 2: %IF I # GMAX %THEN %START I = I+1; K = ITEM(I) %IF K # T %THEN %START K = K&127 ->2 %UNLESS K>=96 %OR K=48 %OR (K>=64 %AND ATOMIC(K)=48) ->2 %UNLESS T&127 < K %CYCLE I = GMAX,-1,I ITEM(I+1) = ITEM(I) NEXT(I+1) = NEXT(I) %REPEAT GMAX = GMAX+1 ITEM(I) = T; NEXT(I) = X %FINISH %ELSE NEXT(I) = UNION(NEXT(I),X) %FINISH %ELSE %START GMAX = GMAX+1 ITEM(GMAX) = T; NEXT(GMAX) = X %FINISH %FINISH %ELSE TERMINAL = 512 %END LOOP STOP = 0; GMIN = GMAX+1 %CYCLE I = MIN,1,MAX CONVERTED(I) = 0 %REPEAT N = NEXT(0) 1: GMAX1 = GMAX LOOP STOP = LOOP STOP - 1 TERMINAL = 0 ADD COMPONENTS(N) %IF TERMINAL # 0 %THEN %START GMAX = GMAX+1 ITEM(GMAX) = 0; NEXT(GMAX) = 0 %FINISH ITEM(GMAX) = ITEM(GMAX)+512 CONVERTED(N) = GMAX1+1 M = 0 %CYCLE I = GMIN,1,GMAX J = NEXT(I) %IF J # 0 %THEN %START K = CONVERTED(J) %IF K = 0 %THEN %START LOOP STOP = LOOP STOP - 1 TCOUNT(J) CONVERTED(J) = K %FINISH %IF K < M %THEN %START M = K; N = J %FINISH %FINISH %REPEAT ->1 %IF M # 0 %CYCLE I = GMIN,1,GMAX K = NEXT(I) %IF K # 0 %THEN K = CONVERTED(K) %ELSE K = EOP NEXT(I) = K %REPEAT %END; !CONVERT %ROUTINE MINIMIZE %INTEGER I,J,K,M,N %INTEGERARRAY STACK(1:150) %INTEGERFN ULT MAP(%INTEGER I) %INTEGER J 1: J = I; I = MAP(I); ->1 %UNLESS I = J %OR I = 0 %RESULT = J %END %INTEGERFN EQUIVALENT(%INTEGER NN,MM) %INTEGER I,J,K,POS1,POS2 POS1 = 0; POS2 = 0 1: K = ITEM(MM) ->9 %UNLESS ITEM(NN) = K I = NEXT(NN); J = NEXT(MM) ->9 %UNLESS I = J %OR (255#I#0 %AND 255#J#0) POS1 = POS1+1; STACK(POS1) = NN; MAP(NN) = MM NN = NN+1; MM = MM+1 ->1 %IF K&512 = 0 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 %THEN %START I = NN; NN = MM; MM = I %FINISH ->1 %IF NN > N 9: %RESULT = 0 %IF POS1 = 0 I = STACK(POS1); MAP(I) = I; POS1 = POS1-1 ->9 %END %CYCLE I = 0,1,255; MAP(I) = I; %REPEAT %CYCLE N = GMIN,1,GMAX %IF MAP(N) = N %THEN %START ->4 %IF N # GMIN %AND ITEM(N-1)&512 = 0 M = 1 2: %IF M # N %THEN %START ->4 %IF MAP(M) = M %AND EQUIVALENT(N,M) # 0 M = M+1 ->2 %FINISH %FINISH %ELSE %START MAP(N) = ULT MAP(N) %FINISH 4: %REPEAT J = GMIN-1 %CYCLE I = GMIN,1,GMAX K = MAP(I) %IF K = I %THEN %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) %IF K # 0 %THEN %START NEXT(I) = MAP(K) %FINISH %REPEAT %END; !MINIMIZE GMAX = 0 1: READ SYM; ->1 %IF SYM = NL %RETURN %IF SYM = '/' %IF SYM = 'S' %AND NEXT SYMBOL = 'S' %THEN %START SKIP SYMBOL; READ(I); P = SSBASE+I; EOP = 0 %FINISH %ELSE %START READ NAME(P); EOP = 0255 %FINISH MIN = 0; MAX = 0 2: READ SYM; ->2 %IF SYM = NL %OR SYM = '-' %OR SYM = '>' ACCEPT EXP(EXP,END) %IF EXP = 0 %OR SYM # NL %THEN %START %PRINTTEXT 'WRONG FORMAT AT: ' 3: PRINT SYMBOL(SYM); ->1 %IF SYM = NL READ SYM ->3 %FINISH CONCATENATE(END,0) ITEM(0) = 1023; NEXT(0) = EXP CONVERT MINIMIZE %UNLESS P = 111; !APP PHRASE(P) = GMIN SELECT OUTPUT(GLIST) %CYCLE I = GMIN,1,GMAX %IF I = 1 %OR ITEM(I-1)&512 # 0 %THEN %START NEWLINE; WRITE(I,3); J = 0 %FINISH J = J+1 %IF J > 5 %THEN %START NEWLINE; SPACES(4); J = 1 %FINISH SPACES(3) %IF ITEM(I)&511 # 0 %THEN %START PRINT NAME(ITEM(I)&127) WRITE(NEXT(I),1) %FINISH %ELSE %PRINTTEXT '*E*' %REPEAT NEWLINE; SELECT OUTPUT(ERR) ->1 %END; !READ GRAMMAR %ROUTINE READ ATOMS %INTEGER I,J,K,L,P,S,T %INTEGERARRAY CHAR,CONT,ALT(0:450) %ROUTINE READ S S = NEXT SYMBOL; T = 0 %IF S # ',' %AND S # NL %THEN %START %UNLESS '0' <= S <= '9' %THEN %START SKIP SYMBOL %RETURN %UNLESS S = '(' %FINISH READ(T) SKIP SYMBOL %IF NEXT SYMBOL = ')' %FINISH S = K+128 %END %ROUTINE INSERT IN(%INTEGERNAME X) %IF CHAR(X) < S %THEN %START CONT(X) = T %IF CONT(X) = 0 INSERT IN(ALT(X)); %RETURN %FINISH %IF CHAR(X) # S %THEN %START J = J+1; CHAR(J) = S CONT(J) = 0; ALT(J) = X; X = J %FINISH %IF S&128 = 0 %THEN %START READ S; INSERT IN (CONT(X)) %FINISH %ELSE %START T = CONT(ALT(J)) %IF T = 0 %AND ALT(J) # 0 CONT(J) = T %FINISH %END %ROUTINE STORE(%INTEGER X) %INTEGER M,N 1: %RETURN %IF X = 0 2: KMAX = KMAX+1; M = KMAX ->2 %IF P # 0 %AND CHAR(X) > M %IF ALT(X) # 0 %THEN %START STORE(ALT(X)); N = \131071 %FINISH %ELSE N = 0 %IF CHAR(X)&128 = 0 %THEN %START KMAX = 95 %IF KMAX < 95 KEYDICT(M) = N + (KMAX+1)<<7 + CHAR(X) X = CONT(X); P = 0 ->1 %FINISH KEYDICT(M) = N + 65536 + CONT(X)<<6 + CHAR(X)&63 %END I = 0; J = 0; CHAR(0) = 999 1: SYM = NEXT SYMBOL ->5 %IF SYM = '[' %OR SYM = NL ->6 %IF SYM = '/' READ(ORDINAL) %STOP %IF ORDINAL <= NMAX NMAX = ORDINAL-1 READ SYM; READ NAME(K) %STOP %IF K # ORDINAL %IF K >= 64 %THEN %START ->1 %UNLESS SYM = '/' READ SYM; READ NAME(L) %STOP %IF L = NMAX ATOMIC(K) = L ->1 %FINISH ->5 %IF SYM = '[' 3: S = SYM; INSERT IN(I) ->1 %IF NEXT SYMBOL = NL SKIP SYMBOL 4: READ SYMBOL(SYM); ->4 %IF SYM = ' ' %OR SYM = NL ->3 5: READ SYMBOL(SYM); ->5 %UNLESS SYM = NL ->1 6: %CYCLE J = 32,1,95; KEYDICT(J) = 0; %REPEAT KMAX = 32; P = 1; STORE(I) KEYDICT(94) = KEYDICT(92); !EQUATE UPARROW TO BACKSLASH %ROUTINE DISPLAY(%INTEGER I,S) %INTEGER J 1: J = KEYDICT(I) %IF I = 32 %THEN %START PRINT SYMBOL('?'); NEWLINE; %RETURN %FINISH %IF J&65536 = 0 %THEN %START PRINT SYMBOL(J&127); 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 SELECT OUTPUT(DLIST); NEWLINES(2) %CYCLE I = 33,1,95 J = (KEYDICT(I)>>7&511)<<2; J = 32<<2 %IF J = 0 J = J+3 %UNLESS 'A'<=I<='Z'; J = J-2 %IF '0'<=I<='9' J = J-1 %IF I = ';' KEYDICT(I) = J PRINT SYMBOL(I); SPACE; DISPLAY(J>>2,2) %REPEAT NEWLINES(2) SELECT OUTPUT(ERR) %END %INTEGER I,J,K CHARMAX = 0 %CYCLE I = 1,1,127; INDEX(I) = 0; %REPEAT %CYCLE I = 64,1,111; ATOMIC(I) = I; %REPEAT %CYCLE I = 96,1,111; PHRASE(I) = 0; %REPEAT 1: READ SYMBOL(I); ->1 %UNLESS I = '/' 2: READ SYMBOL(I); ->2 %UNLESS I = NL READ ATOMS 3: READ SYMBOL(I); ->3 %UNLESS I = NL READ GRAMMAR !WRITE REQUIRED VALUES SELECT OUTPUT(NEW) WRITE(GMAX,1); WRITE(KMAX,1) 5: WRITE(PHRASE(SSBASE),1) SSBASE = SSBASE+1 ->5 %IF SSBASE < 96 NEWLINE %CYCLE I = 96,1,111 NEWLINE %IF I&7 = 0 WRITE(PHRASE(I),3) %REPEAT NEWLINE %CYCLE I = 64,1,111 NEWLINE %IF I&7 = 0 WRITE(ATOMIC(I),7) %REPEAT NEWLINE %CYCLE I = 1,1,255 NEWLINE %IF (I-1)&7 = 0 K = 0 %IF I <= GMAX %THEN %START J = ITEM(I) K = -131072 %IF J&512 = 0 K = (J&384)<<8+K K = NEXT(I)<<7+K K = J&127+K %FINISH WRITE(K,7) %REPEAT NEWLINE %CYCLE I = 32,1,511 NEWLINE %IF (I-1)&7 = 0 WRITE(KEYDICT(I),7) %REPEAT NEWLINES(2) SELECT INPUT(OLD) 10: READ SYMBOL(I); ->10 %UNLESS I = '%' %OR I = '!' 20: PRINT SYMBOL(I); READ SYMBOL(I); ->20 99: %ENDOFPROGRAM