{$T-} program SUPERMAC_FORMATTER; const NL=CHR(10); HT=CHR(9); CR=CHR(13); BLANK=CHR(32); DEL=CHR(127); var CH:CHAR; C,TAB:INTEGER; FILENAME: array [1..32] of CHAR; INFILE,OUTFILE: TEXT; procedure TABLOC(C:CHAR); var L,K,EQUAL:INTEGER; CH:CHAR; INSTRUCTION: array [0..2] of CHAR; type MTAB=array [0..10] of array [0..2] of CHAR; const SPEC=MTAB( 'PRO','REP','UNT','CAS','WHI','IF ','FI ','END','ON.','ELS','THR'); begin L:=1; INSTRUCTION[0]:=C; while L<=2 do begin CH:=INFILE@; if (CH#CR) & (CH#NL) then GET(INFILE) else CH:=BLANK; INSTRUCTION[L]:=CH; L:=L+1; end; L:=-1; repeat L:=L+1; K:=0; EQUAL:=0; while (K<=2) & (EQUAL=0) do begin if SPEC[L,K]#INSTRUCTION[K] then EQUAL:=1; K:=K+1 end; until (EQUAL=0) ! (L>10); case L of 0,1,3,4,5,8,10:begin WRITE(OUTFILE,' '); TAB:=TAB+2 end; 2,6,7:TAB:=TAB-2; 9:TAB:=TAB; 11:WRITE(OUTFILE,' ') end; WRITE(OUTFILE,INSTRUCTION) end; begin WRITE(OUT,NL,CR,'FILE NAME='); BREAK(OUT); C:=0; repeat READ(INP,CH); if CH#DEL then begin C := C + 1; FILENAME[C] := CH end else if C # 0 then begin CH := FILENAME[C]; C := C - 1; WRITE(OUT,'/',CH,'/'); BREAK(OUT) end; until CH=CR; while C<=32 do begin FILENAME[C]:=BLANK; C:=C+1 end; RESET(INFILE,FILENAME); REWRITE(OUTFILE,'OUTFILE.MAC '); TAB:=0; while ~EOF(INFILE) do begin repeat C:=0; READ(INFILE,CH); if CH=BLANK then C:=1; if CH=HT then C:=1; if CH=NL then C:=1; until EOF(INFILE) ! (C=0); C:=0; while C<=TAB do begin WRITE(OUTFILE,BLANK); C:=C+1; end; TABLOC(CH); while ~EOF(INFILE) & (CH#NL) do begin READ(INFILE,CH); WRITE(OUTFILE,CH); end; BREAK(OUTFILE); if TAB<0 then begin TAB:=0; WRITE(OUT,'EXTRA END, FI, OR UNTIL',NL,CR); BREAK(OUT); end; end; if TAB#0 then begin WRITE(OUT,'EXTRA PROC, WHILE, REPEAT, FOR, CASE, OR FI',NL,CR); BREAK(OUT); end; WRITE(OUT,NL,CR,'PROCESSING OF ',FILENAME,NL,CR); WRITE(OUT,'IS COMPLETE.',NL,CR); BREAK(OUT); end.