218 lines
4.0 KiB
Plaintext
218 lines
4.0 KiB
Plaintext
|
||
'BEGIN'
|
||
'INTEGER' D,I,J,S,L,LC;
|
||
'BOOLEAN' WFLAG,FILL,UCASE;
|
||
'INTEGER' 'ARRAY' LET[&A:&Z+1];
|
||
'BYTE' 'ARRAY' W[1:40,1:10],LINE[1:150];
|
||
|
||
|
||
'INTEGER' 'PROCEDURE' LOCATION(I);
|
||
'VALUE' I; 'INTEGER' I; IOC(24);
|
||
|
||
|
||
'PROCEDURE' SETI(A);
|
||
'VALUE' A; 'INTEGER' A; IOC(30);
|
||
|
||
|
||
'PROCEDURE' SETO(A);
|
||
'VALUE' A; 'INTEGER' A; IOC(31);
|
||
|
||
|
||
'INTEGER' 'PROCEDURE' PEEK(A);
|
||
'VALUE' A; 'INTEGER' A; IOC(36);
|
||
|
||
|
||
'INTEGER' 'PROCEDURE' SWLIST;
|
||
IOC(39);
|
||
|
||
'INTEGER' 'PROCEDURE' SLOC(S);
|
||
'STRING' S; IOC(55);
|
||
|
||
|
||
'INTEGER' 'PROCEDURE' FINDINPUT(S);
|
||
'STRING' S;
|
||
'BEGIN' GETLIST(S); IOC(5);
|
||
FINDINPUT:=INPUT; IOC(1)
|
||
'END';
|
||
|
||
|
||
'INTEGER' 'PROCEDURE' FINDOUTPUT(S);
|
||
'STRING' S;
|
||
'BEGIN' GETLIST(S); IOC(3);
|
||
FINDOUTPUT:=OUTPUT; IOC(1)
|
||
'END';
|
||
|
||
|
||
'PROCEDURE' GETLIST(S);
|
||
'STRING' S;
|
||
'BEGIN' 'INTEGER' I;
|
||
IOC(0); IOC(1); TEXT(7,S);
|
||
CHOUT(7,0);
|
||
I:=CHIN(7);
|
||
'IF' I=&? 'THEN'
|
||
'BEGIN' 'FOR' I:=CHIN(7) 'WHILE'
|
||
I#0 'DO' CHOUT(1,I);
|
||
I:=CHIN(7)
|
||
'END';
|
||
IOC(0);
|
||
'END';
|
||
|
||
|
||
'PROCEDURE' CLARR(A,L);
|
||
'VALUE' A,L; 'INTEGER' A,L;
|
||
IOC(50);
|
||
|
||
|
||
|
||
'PROCEDURE' CHAR;
|
||
'BEGIN'
|
||
LOOP: I:=CHIN(1);
|
||
'IF' I=&^X 'THEN'
|
||
'BEGIN' WFLAG:='NOT' WFLAG;
|
||
'GOTO' LOOP;
|
||
'END' 'ELSE'
|
||
'IF' I=&^Z 'OR' I=&^C 'THEN'
|
||
'BEGIN' CLOSE(D); 'GOTO' FLOOP
|
||
'END' 'ELSE'
|
||
'IF' I=127 'THEN'
|
||
'BEGIN' 'IF' LC>0 'THEN'
|
||
'BEGIN' CHOUT(1,LINE[LC]);
|
||
LC:=LC-1;
|
||
'END';
|
||
FILL:='FALSE' ;
|
||
'GOTO' LOOP
|
||
'END' 'ELSE'
|
||
'IF' I=&^U 'THEN'
|
||
'BEGIN' LC:=0; TEXT(1,"*^U*N");
|
||
FILL:=WFLAG;
|
||
'GOTO' LOOP
|
||
'END' 'ELSE'
|
||
'IF' I=&^R 'THEN'
|
||
'BEGIN' SKIP(1);
|
||
'FOR' I:=1 'STEP' 1 'UNTIL' LC 'DO'
|
||
CHOUT(1,LINE[I]);
|
||
'END' 'ELSE'
|
||
'IF' I<&A 'OR' I>&Z 'THEN' FILL:=WFLAG 'ELSE'
|
||
'IF' I<&*T 'OR' I>&*C 'AND' I<&*S 'THEN' 'GOTO' LOOP
|
||
'END' ;
|
||
|
||
|
||
'PROCEDURE' OUTL(I); 'VALUE' I; 'INTEGER' I;
|
||
'BEGIN' LC:=LC+1; LINE[LC]:=I
|
||
'END' ;
|
||
|
||
|
||
'PROCEDURE' OUTW(M,L);
|
||
'VALUE' M,L; 'INTEGER' M,L;
|
||
'BEGIN' 'INTEGER' K;
|
||
LOOP: L:=L+1; K:=W[M,L];
|
||
'IF' L<11 'AND' K#0 'THEN'
|
||
'BEGIN' OUTL(K); CHOUT(1,K);
|
||
'GOTO' LOOP
|
||
'END' ;
|
||
'IF' UCASE 'THEN'
|
||
'BEGIN' OUTL(&'); CHOUT(1,&');
|
||
'END' ;
|
||
OUTL(&*S); CHOUT(1,&*S);
|
||
FILL:=WFLAG;
|
||
'END' ;
|
||
|
||
|
||
'PROCEDURE' GETWORD;
|
||
'BEGIN' 'INTEGER' L,MN,MX;
|
||
L:=1; FILL:='FALSE';
|
||
MN:=LET[I];
|
||
'IF' MN<0 'THEN' 'GOTO' FIN;
|
||
MX:=MN;
|
||
'FOR' MX:=MX+1 'WHILE' W[MX,1]=I 'DO' ;
|
||
MX:=MX-1;
|
||
L1: 'IF' MX=MN 'THEN'
|
||
'BEGIN' OUTW(MN,L); 'GOTO' FIN;
|
||
'END';
|
||
L:=L+1; CHAR; OUTL(I);
|
||
L2: 'IF' I=W[MN,L] 'THEN' 'GOTO' L3;
|
||
MN:=MN+1;
|
||
'IF' MN>MX 'THEN' 'GOTO' FIN 'ELSE' 'GOTO' L2;
|
||
L3: 'IF' I=W[MX,L] 'THEN' 'GOTO' L1;
|
||
MX:=MX-1;
|
||
'IF' MX>=MN 'THEN' 'GOTO' L3;
|
||
FIN:
|
||
'END' ;
|
||
|
||
|
||
{SET UP KEY WORDS}
|
||
SETI(SLOC("
|
||
<
|
||
AND ARRAY
|
||
BEGIN BOOLEAN BYTE
|
||
COMMENT
|
||
DIFFER DO
|
||
ELSE END EQUIVALENT
|
||
FALSE FINISH FOR
|
||
GOTO
|
||
IF IMPLIES INTEGER
|
||
LABEL LIBRARY
|
||
MASK MOD
|
||
NOT
|
||
OR
|
||
PROCEDURE
|
||
REAL
|
||
STEP STRING SWITCH
|
||
THEN TRUE
|
||
UNTIL
|
||
VALUE
|
||
WHILE
|
||
> "));
|
||
|
||
'FOR' I:=&A 'STEP' 1 'UNTIL' &Z+1 'DO'
|
||
LET[I]:=-1;
|
||
CLARR(LOCATION(W[1,1]),400);
|
||
'FOR' J:=CHIN(10) 'WHILE' J#&< 'DO' ;
|
||
I:=0; S:=0;
|
||
'FOR' J:=CHIN(10) 'WHILE' J#&> 'DO'
|
||
'BEGIN' 'IF' J<=&*S 'THEN'
|
||
'BEGIN' 'FOR' J:=CHIN(10) 'WHILE' J<=&*S 'DO' ;
|
||
'IF' J=&> 'THEN' 'GOTO' DONE;
|
||
I:=I+1; L:=1;
|
||
'IF' J#S 'THEN'
|
||
'BEGIN' S:=J; LET[J]:=I;
|
||
'END' ;
|
||
'END' ;
|
||
W[I,L]:=J; L:=L+1;
|
||
'END' ;
|
||
|
||
{GET OUTPUT FILE}
|
||
|
||
{DEFAULT EXTENSION}
|
||
DONE: SETO(SWLIST+13); TEXT(10,"ALG");
|
||
FLOOP: D:=FINDOUTPUT("?FILE =");
|
||
'IF' D<1 'THEN' 'GOTO' FIN;
|
||
UCASE:=PEEK(SWLIST)=&U; {UPPER CASE CONVENTION ?}
|
||
WFLAG:='TRUE' ; {SWITCH ON AUTO FILL}
|
||
FILL:=WFLAG;
|
||
LC:=0; {# CHARS ON LINE}
|
||
TEXT(1,"*^*N"); {PROMPT}
|
||
|
||
INLOOP: CHAR; {GET NEXT CHARACTER}
|
||
'IF' I=&*C 'THEN'
|
||
'BEGIN' 'FOR' I:=1 'STEP' 1 'UNTIL' LC 'DO' CHOUT(D,LINE[I]);
|
||
LC:=0; SKIP(D);
|
||
'END' 'ELSE'
|
||
'IF' 'NOT' FILL 'THEN' OUTL(I) 'ELSE'
|
||
'IF' UCASE 'THEN'
|
||
'BEGIN' OUTL(I);
|
||
'IF' I=&' 'THEN'
|
||
'BEGIN' CHAR; OUTL(I);
|
||
'IF' I>=&A 'AND' I<=&Z 'THEN'
|
||
GETWORD
|
||
'END'
|
||
'END' 'ELSE'
|
||
'BEGIN' OUTL(I);
|
||
'IF' I>=&A 'AND' I<=&Z 'THEN'
|
||
GETWORD;
|
||
'END' ;
|
||
'GOTO' INLOOP;
|
||
FIN:
|
||
'END'
|
||
'FINISH'
|
||
|