dos_compilers/RHA (Minisystems) ALGOL v55/VDU.ALG

'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'