Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0074/alged.sim
There are 2 other files named alged.sim in the archive. Click here to see a list.
COMMENT --- ALGED ALGOL Editor and Indentation program Version 1 ---
-----------------------------------------------------------------------
Date: 76-02-27
Author: Mats Ohlin
Swedish Research Institute of National Defence
FOA 1
Fack
S-104 50 STOCKHOLM 80
SWEDEN
Modified for ALGOL by: Dr. Walter Maner
Date: 8 August 1977
Department of Philosophy
Old Dominion University
Norfolk, VA 23508
The information in this document is subject to change without
notice. The institute assumes no responsibility for any errors that
may be present in this document. The described software is furnished
to the user for use on a SIMULA system. (SIMULA is a registered
trademark of the Norwegian Computing Center, Oslo, Norway).
Copyright 1977 by the Swedish Research Institute for National Defence.
Copying is allowed.
----------------------------------------------------------------------
*
* The ALGED program converts ALGOL source program files.
* The program is able to indent the program (for better readability) and
* convert reserved words, standard and user indentifiers to
* 1) UPPER CASE 2) lower case 3) Edit Case (1st char. upper case).
*
* Lines which become too long at indentation are cut at an appropriate
* position. In the case where no proper cut can be done (long text
* constants for example) a warning message is issued.
*
* The following information is requested from the user:-
* (? rather than "help" gives info at run time)
*
* 1. The file name for the source program file.
* If ending with Escape (Altmode), default values are assumed
* for 2-11.
* 2. The name of the output file (default is old name).
* 3. The maximal record line length at output.
* 4. Number of positions at indentation for each block/compound
* statement (=BEGIN).
* If a negative value is entered preliminary blanks and tabs
* at beginning of the lines will be kept.
* (default=3).
* 5. Enter the maximal position at indentation. If the nesting
* of BEGINs is too deep the value will be taken modulo the
* entered value (default=60).
* 6. Enter Yes if tabs may be used at indentation, otherwise
* No (default=No).
* 7. Enter conversion mode for reserved words (default=1).
* 8. Ditto standard identifiers (default=3).
* 9. Ditto user identifiers (default=2).
* 10. Ditto comments and option statements (default=0).
* 11. Ditto text constants (default=0).
*
* You will get the default answers for all the questions no. 2-11
* if you respond with <CR><LF>.
*
* N.B. Cut lines will not be indented properly if they contain
* BEGIN or END. Cut text constants will not be indented.
*
* Required data files:
*
* SYS:ALGED.DAT (reserved words and standard identifiers)
;
COMMENT This program was one of my first SIMULA Source Code
conversion programs. Anyone how tries to pry into it, is warned
that it is no good programming example of how to write such programs.
A more well-written program will be distributed with a later DEC-10
SIMULA Release. However, it runs rather fast this "nasty" program!
76-03-08 MO.
;
OPTIONS(/-Q/-A/-I/-D);
BEGIN
EXTERNAL TEXT PROCEDURE rest,upcase,from,conc,checkextension;
EXTERNAL REF (Outfile) PROCEDURE findoutfile;
EXTERNAL REF (Infile) PROCEDURE findinfile;
EXTERNAL CHARACTER PROCEDURE findtrigger;
EXTERNAL BOOLEAN PROCEDURE numbered;
EXTERNAL LONG REAL PROCEDURE scanreal;
EXTERNAL INTEGER PROCEDURE scanint;
EXTERNAL PROCEDURE abort;
EXTERNAL CLASS safmin;
INTEGER loopend;
Outtext("ALGED - ALGOL Editor and Indentation Program - Version 1");
Outimage;
Outtext("Written in SIMULA, a powerful and versatile superset of ALGOL60.");
Outimage;
Outimage;
safmin BEGIN
REF (tree) reswdtree,standid,simsettree,simulationtree;
CHARACTER ctab;
REF (Infile) prog;
REF (Outfile) outf;
TEXT progname,outname;
BOOLEAN leftskip;
INTEGER proglength,indent,ma,marginal,ind,inde,outlength,maxindent,
begincount,endcount;
INTEGER ARRAY convert[2:8];
BOOLEAN debug,tabs;
CHARACTER ARRAY uppercase,lowercase[0:127];
PROCEDURE inituppercase(ca);
CHARACTER ARRAY ca;
BEGIN
INTEGER i;
FOR i:= 1 STEP 1 UNTIL 95 DO ca[i]:= Char(i);
FOR i:= 96 STEP 1 UNTIL 122 DO ca[i]:= ca[i-32];
ca[123]:= ca[35];
ca[124]:= Char(124);
ca[125]:= ca[36]
END OF INIT UPPERCASE;
PROCEDURE initlowercase(ca);
CHARACTER ARRAY ca;
BEGIN
INTEGER i;
FOR i:= 1 STEP 1 UNTIL 63 DO ca[i]:= Char(i);
FOR i:= 96 STEP 1 UNTIL 122 DO ca[i]:= ca[i-32]:= Char(i);
FOR i:= 91 STEP 1 UNTIL 95 DO ca[i]:= Char(i);
ca[123]:= ca[35]:= Char(123);
ca[124]:= Char(124);
ca[125]:= ca[36]:= Char(125)
END OF INIT LOWERCASE;
PROCEDURE warning(message,t);
NAME message;
TEXT message,t;
BEGIN
Outimage;
Outtext("%ALGED - Warning: ");
Outtext(message);
IF Pos + t.Length > Length+1 THEN Outimage;
IF t.Length > Length THEN
BEGIN
WHILE t.More DO Outchar(t.Getchar);
END ELSE Outtext(t);
Outimage
END OF WARNING;
CLASS tree(case);
VALUE case;
INTEGER case;
BEGIN
REF (node) root;
TEXT column1;
CLASS node(t);
VALUE t;
TEXT t;
BEGIN
REF (node) l,r;
END OF NODE;
PROCEDURE insert(t);
TEXT t;
BEGIN
REF (node) tp;
IF root == NONE THEN root:- NEW node(t) ELSE
BEGIN
tp:- root;
WHILE TRUE DO
IF tp.t < t THEN
BEGIN
IF tp.r == NONE THEN BEGIN
tp.r:- NEW node(t);
GO TO exit
END;
tp:- tp.r
END ELSE
IF tp.t > t THEN
BEGIN
IF tp.l == NONE THEN BEGIN
tp.l:- NEW node(t);
GO TO exit
END;
tp:- tp.l
END ELSE GO TO exit;
exit:
END OF OLD ROOT
END OF INSERT;
BOOLEAN PROCEDURE found(t);
TEXT t;
BEGIN
REF (node) tp;
IF root =/= NONE THEN
BEGIN
tp:- root;
WHILE TRUE DO
IF tp.t < t THEN
BEGIN
IF tp.r == NONE THEN GO TO exit;
tp:- tp.r;
END ELSE
IF tp.t > t THEN
BEGIN
IF tp.l == NONE THEN GO TO exit;
tp:- tp.l;
END ELSE BEGIN
found:= TRUE;
GO TO exit
END;
exit:
END ROOT EXISTS
END OF FOUND;
INSPECT NEW Infile("SYS:ALGED.DAT[1,4]") DO
BEGIN
Open(Blanks(13));
column1:- Image.Sub(1,1);
searchnextasterisk:
Inimage;
WHILE column1 NE "*" DO Inimage;
IF Image.Sub(3,1).Getint = case THEN
BEGIN
Inimage;
WHILE column1 NE "*" DO
BEGIN
insert(Image.Strip);
Inimage;
END OF LOOP;
END * FOUND ELSE GO TO searchnextasterisk;
Close
END OF INSPECT
END OF TREE;
PROCEDURE outline(t);
NAME t;
TEXT t;
BEGIN
Outtext(t);
Outimage
END OF OUTLINE;
BOOLEAN PROCEDURE help1;
BEGIN
outline("Enter file specification for the input file.");
outline("Default extension is .ALG");
outline("If ending with Escape (Altmode), default values are assumed");
outline("for subsequent (dialog) requests.");
END of help1;
BOOLEAN PROCEDURE help2;
outline("Enter file specification for the resulting output file.");
BOOLEAN PROCEDURE help3;
outline("Enter maximal record length in output file.");
BOOLEAN PROCEDURE help4;
BEGIN
outline("Enter number of positions in indentation/BEGIN.");
outline("If a negative answer is entered the effect will be that");
outline("preliminary blanks and tabs NOT will be deleted.");
END OF HELP4;
BOOLEAN PROCEDURE help5;
BEGIN
outline("Enter the maximal position at indentation.");
outline("If the nesting is too deep the indentation will");
outline("be modulo the entered value.");
END OF HELP5;
BOOLEAN PROCEDURE help6;
outline(
"If tabs may be used at indentation answer ""yes"" otherwise ""no""");
BOOLEAN PROCEDURE range(x,low,hgh);
INTEGER x,low,hgh;
range:= x >= low AND x <= hgh;
BOOLEAN fastflag;
ctab:= Char(9);
proglength:= 150;
inituppercase(uppercase);
initlowercase(lowercase);
margin:= 0;
fastflag:= FALSE;
GO TO progreq;
WHILE prog == NONE DO
BEGIN
Outtext("? Cannot find specified file. Try again.");
Outimage;
progreq:
Outimage;
outline("Enter program file name followed by 'ESC' or 'ALT' to get default");
outline("values for ALL remaining questions in this series. Otherwise,");
request("enter program file name, followed by <CR><LF>: ",nodefault,
textinput(progname,TRUE),"?",help1);
IF progname.Sub(progname.Length,1).Getchar = Char(27) !Escape;
THEN
BEGIN
fastflag:= TRUE;
Outimage;
progname:- progname.Sub(1,progname.Length-1);
progname:- checkextension(progname,".ALG");
outf:- findoutfile(progname);
END ELSE progname:- checkextension(progname,".ALG");
prog:- findinfile(progname);
END loop;
IF fastflag THEN
BEGIN
outlength:= 132;
indent:= 3;
leftskip:= TRUE;
maxindent:= 60;
tabs:= FALSE;
convert[2]:= 1;
convert[3]:= 3;
convert[4]:= 2;
convert[5]:= convert[6]:= 0;
IF outf =/= NONE THEN GO TO fast;
END fast mode;
GO TO outreq;
WHILE outf == NONE DO
BEGIN
Outtext("? Cannot create specified file. Try again.");
Outimage;
outreq:
request("Enter output file name:",progname,
textinput(outname,TRUE),"?",help2);
outf:- findoutfile(outname);
END loop;
IF fastflag THEN GO TO fast;
request("Enter output file record length:","132",
intinput(outlength,range(outlength,1,135)),
"? Must be [1,135].",help3);
debug:= outlength > 10000;
outlength:= Mod(outlength,10000);
request("Enter indentation step:","3",intinput(indent,
Abs(indent) <= outlength//2),"? Illegal indent value.",help4);
leftskip:= indent > 0;
indent:= Abs(indent);
request("Enter max. indentation position:","60",
intinput(maxindent,range(maxindent,indent,outlength)),
"? Must be >= indentation step and <= output record length",help5);
IF maxindent < 1 THEN maxindent:= 1;
request("Tabs in indentation?:","No",boolinput(tabs),"?",help6);
IF tabs THEN
BEGIN
warning("Use PIP's '/W' switch to convert tabs before resubmitting ", NOTEXT);
Outtext(outname);
Outtext(" to ALGED. Command format: .COPY ");
Outtext(outname);
Outtext(" = ");
Outtext(outname);
Outtext("/W");
Outimage
END;
Outtext("Conversion modes:");
Outimage;
Outtext("No change 0");
Outtext(" Change to upper case 1");
Outimage;
Outtext("Change to lower case 2");
Outtext(" Change to Edit case 3");
Outimage;
Eject(Line+1);
Outtext("Enter conversion modes for:");
Outimage;
request("Reserved words:","1",intinput(convert[2],range(convert[2],0,3)),
"? Must be 0, 1, 2 or 3.",nohelp);
request("Standard identifiers:","3",intinput(convert[3],range(convert[3],0,3)),
"? Must be 0,1,2 or 3.",nohelp);
request("User identifiers:","2",intinput(convert[4],range(convert[4],0,3)),
"? Must be 0,1,2 or 3.",nohelp);
request("Comment and options:","0",intinput(convert[5],range(convert[5],0,2)),
"? Must be 0,1 or 2.",nohelp);
request("Text constants:","0",intinput(convert[6],range(convert[6],0,2)),
"? Must be 0,1_ or 2.",nohelp);
fast:
outline("Working....");
INSPECT outf DO
BEGIN
Open(Blanks(outlength));
INSPECT prog DO
BEGIN
PROCEDURE getstring;
BEGIN
CHARACTER c;
COMMENT getstring scans an identifier and saves it in t
(upper case mode) assuming the 1st character is stored in window.
p points at the beginning of the identifier.
;
p:= Pos - 1;
t:- t.Main;
t:= NOTEXT;
t.Setpos(1);
t.Putchar(window);
GO TO l;
WHILE (Letter(c) OR Digit(c)) DO
BEGIN
t.Putchar(c);
l: IF \ More THEN GO TO ready;
c:= uppercase[Rank(Inchar)]
END;
Setpos(Pos-1);
ready:
t:- t.Sub(1,t.Pos-1)
END OF GETSTRING;
PROCEDURE printline(t);
TEXT t;
BEGIN
INTEGER i,j,olddisplay,displayi;
CHARACTER c;
IF t.Length > outlength - outf.Pos + 1 THEN
BEGIN
!NECESSARY TO CUT LINE;
noindent:= FALSE;
FOR c:=csemicolon,cblank,ctab,ccomma DO
BEGIN
j:= outlength - outf.Pos + cutpos;
FOR i:= outlength-outf.Pos+1 STEP -1 UNTIL 2 DO
BEGIN
IF (IF display[j] = 0 OR display[j] = 5
THEN
t.Sub(i,1).Getchar = c ELSE FALSE) THEN GO TO cut;
j:= j - 1
END I LOOP
END C LOOP;
!FAILED:;
j:= outlength - outf.Pos + cutpos;
olddisplay:= display[j];
FOR i:= outlength-outf.Pos+1 STEP -1 UNTIL 2 DO
BEGIN
IF display[j] = 5 THEN GO TO cut ELSE
IF display[j] NE olddisplay THEN GO TO cut;
olddisplay:= display[j];
j:= j - 1
END;
!FAILED AGAIN:;
i:= outlength - outf.Pos + 1;
noindent:= display[cutpos+i-1] = 6;
IF outf.Pos > 1 THEN
BEGIN
outf.Setpos(1);
printline(t);
GO TO done
END;
warning("!!! Forced chance cut at line: ",t);
cut:
printline(t.Sub(1,i));
cutpos:= Pos;
IF \ cutflag AND \ noindent THEN
BEGIN
inde:= ind;
IF tabs THEN WHILE inde >= 8 DO
BEGIN
Outchar(ctab);
inde:= inde - 8
END;
outf.Setpos(outf.Pos+inde);
END CUT NON TEXT LINE;
contflag:= TRUE;
printline(t.Sub(i+1,t.Length-i));
END ELSE
BEGIN
IF debug THEN
BEGIN
j:= cutpos;
Setpos(cutpos);
FOR i:= 1 STEP 1 UNTIL t.Length DO
BEGIN
Outint(display[j],1);
j:= j + 1
END;
Outimage;
IF \ cutflag AND \ noindent THEN
BEGIN
inde:= ind;
IF tabs THEN WHILE inde >= 8 DO
BEGIN
Outchar(ctab);
inde:= inde - 8
END;
outf.Setpos(outf.Pos+inde)
END
END DEBUG OUTPUT;
j:= cutpos + t.Length - 1;
IF \ cutflag AND contflag THEN
BEGIN
WHILE More DO
BEGIN
c:= Inchar;
IF c NE ' ' AND c NE ctab THEN GO TO skipped;
cutpos:= cutpos + 1
END LOOP;
Outimage;
GO TO done;
!EMPTY LINE;
skipped:
END ELIMINATING BLANKS AND TABS AT CUT;
Setpos(cutpos);
FOR i:= cutpos STEP 1 UNTIL j DO
BEGIN
displayi:= display[i];
IF displayi <= 1 THEN Outchar(Inchar) ELSE
BEGIN
IF convert[displayi] = 0 THEN Outchar(Inchar) ELSE
IF convert[displayi] = 1 THEN
Outchar(uppercase[Rank(Inchar)]) ELSE
IF convert[displayi] = 2 THEN
Outchar(lowercase[Rank(Inchar)]) ELSE
COMMENT CONVERT[DISPLAYI] = 3;
Outchar(IF displayi = olddisplay THEN
lowercase[Rank(Inchar)] ELSE
uppercase[Rank(Inchar)]);
END CONVERSION;
olddisplay:= displayi
END I LOOP;
IF j = 1 THEN
BEGIN
IF Rank(outf.Image.Sub(outf.Pos-1,1).Getchar) = 12 THEN
BEGIN
outf.Image:- outf.Image.Sub(1,outf.Pos-1);
FOR c:= outf.Image.Getchar WHILE c = ' ' OR Rank(c) = 9 DO;
outf.Image:- outf.Image.Sub(outf.Pos-1,outf.Length-outf.Pos+2);
Breakoutimage;
outf.Image:- outf.Image.Main;
GO TO done
END
END j = 1;
Outimage
END SHORT TEXT;
done:
END OF PRINTLINE;
CHARACTER window,cblank,csemicolon,ccomma;
TEXT t,mainimage;
BOOLEAN endcommentflag,commentflag,noindent,contflag,
textflag,cutflag,numericflag,hit;
INTEGER ARRAY display[0:proglength];
INTEGER i,p,markreswd,markstandid,markchar,marktext,markcomment,
marknumeric,markuserid,marksingle,cutpos,levelcount,level;
marknumeric:= 1;
markreswd:= 2;
markstandid:= 3;
markuserid:= 4;
markcomment:= 5;
marktext:= 6;
markchar:= 7;
marksingle:= 8;
IF convert[2] = convert[4] THEN
reswdtree:- NEW tree(0) ELSE
reswdtree:- NEW tree(1);
IF convert[3] NE 0 OR convert[4] NE 0 THEN
standid:- NEW tree(2);
cblank:= ' ';
csemicolon:= ';';
ccomma:= ',';
level:= -1000;
t:- Blanks(proglength);
Open(Blanks(proglength));
Inimage;
mainimage:- Image;
Lastitem;
Image:- Image.Strip;
IF numbered THEN
BEGIN
Image:- from(Image,7);
warning("Line numbers will be removed.",NOTEXT);
END LSN;
WHILE \ Endfile DO
BEGIN
next:
IF \ More THEN
BEGIN
IF NOT textflag AND leftskip AND Length > 1 THEN
BEGIN
Setpos(1);
WHILE More DO
BEGIN
window:= Inchar;
IF window NE ' ' AND window NE ctab THEN GO TO
leftskipped
END LOOP;
leftskipped: p:= Pos - 2;
Image:- Image.Sub(Pos-1,Length-p);
loopend:= Length;
FOR i:= 1 STEP 1 UNTIL loopend DO display[i]:=
display[i+p];
FOR i:= i STEP 1 UNTIL proglength DO display[i]:= 0;
END SKIPPING PRELEMINARY BLANKS AND TABS;
IF \ cutflag THEN
BEGIN
ind:= IF ind > 0 THEN ma ELSE marginal;
ind:= inde:= Mod(ind,maxindent);
IF tabs THEN WHILE inde >= 8 DO
BEGIN
Outchar(ctab);
inde:= inde - 8
END;
outf.Setpos(outf.Pos+inde)
END NO INDENT;
cutflag:= textflag;
contflag:= FALSE;
cutpos:= 1;
printline(Image);
ma:= marginal;
ind:= 0;
restore:
Image:- mainimage;
Inimage;
IF numbered THEN Image:- from(Image,7);
Image:- Image.Strip;
IF Image == NOTEXT THEN
BEGIN
Outimage;
GO TO restore
END;
loopend:= Length;
FOR i:= 1 STEP 1 UNTIL loopend DO display[i]:= 0;
END NO MORE;
IF endcommentflag THEN GO TO scanendcomment;
IF textflag THEN GO TO scantext;
IF commentflag THEN GO TO scancomment;
window:= uppercase[Rank(Inchar)];
scan:
IF window = ' ' THEN !SKIP;
ELSE
IF window = ctab THEN !SKIP;
ELSE
IF window = csemicolon THEN !SKIP;
ELSE
IF Letter(window) THEN
BEGIN
getstring;
IF t.Length > 1 AND t.Length < 11 THEN
BEGIN
INSPECT reswdtree DO hit:= found(t)
END ELSE hit:=
FALSE;
IF hit THEN
BEGIN
loopend:= Pos - 1;
FOR i:= p STEP 1 UNTIL loopend DO display[i]:= 2;
IF t = "COMMENT" THEN GO TO scancomment;
IF t = "OPTIONS" THEN GO TO scancomment;
IF t = "END" THEN
BEGIN
moreends:
endcount:= endcount + 1;
levelcount:= levelcount - 1;
IF levelcount = level THEN
BEGIN
level:= - 1000;
simulationtree:- simsettree:- NONE
END;
IF endcount > begincount THEN
warning("More ENDs than BEGINs at line: ",Image) ELSE
BEGIN
marginal:= marginal - indent;
ind:= ind - 1;
END;
scanendcomment:
WHILE More DO
BEGIN
display[Pos]:= 5;
window:= uppercase[Rank(Inchar)];
IF window = ';' THEN
BEGIN
endcommentflag:= FALSE;
GO TO next
END ELSE
IF window = 'E' THEN
BEGIN
getstring;
IF t = "END" THEN
BEGIN
display[Pos-3]:= display[Pos-2]:=
display[Pos-1]:= 2;
GO TO moreends
END;
IF t = "ELSE" THEN
BEGIN
l4:
display[Pos-4]:= display[Pos-3]:= 2;
display[Pos-2]:=
display[Pos-1]:= 2;
endcommentflag:= FALSE;
GO TO next
END;
loopend:= Pos - 1;
FOR i:= p STEP 1 UNTIL loopend DO
display[i]:= 5;
END ELSE
IF window = 'O' THEN
BEGIN
getstring;
IF t = "OTHERWISE" THEN
BEGIN
FOR i:= -9 STEP 1 UNTIL -1 DO
display[Pos+i]:= 2;
endcommentflag:= FALSE;
GO TO next
END;
loopend:= Pos - 1;
FOR i:= p STEP 1 UNTIL loopend DO
display[i]:= 5;
END ELSE
IF window = 'W' THEN
BEGIN
getstring;
IF t = "WHEN" THEN GO TO l4;
loopend:= Pos - 1;
FOR i:= p STEP 1 UNTIL loopend DO
display[i]:= 5;
END ELSE
IF Letter(window) THEN
BEGIN
getstring;
loopend:= Pos - 1;
FOR i:= p STEP 1 UNTIL loopend DO
display[i]:= 5;
END OTHER WORD IN *ND-COMMENT
END MORE LOOP;
endcommentflag:= TRUE;
END *ND=T ELSE
IF (IF window = 'B' THEN t = "BEGIN" ELSE FALSE) THEN
BEGIN
marginal:= marginal + indent;
begincount:= begincount + 1;
levelcount:= levelcount + 1;
IF ind < 0 THEN
BEGIN
ind:= 10000;
ma:= ma - indent
END ELSE ind:= ind+1;
END
END RESWD ELSE
BEGIN
IF t.Length > 2 AND t.Length < 14 THEN
BEGIN
INSPECT standid DO hit:= found(t);
IF hit THEN
BEGIN
IF window = 'S' AND convert[3] NE
convert[4] THEN
BEGIN
IF t = "SIMSET" THEN
BEGIN
IF level = -1000 THEN level:=
levelcount;
simsettree:- NEW tree(3);
END T = SIMSET ELSE
IF t = "SIMULATION" THEN
BEGIN
IF level = -1000 THEN level:=
levelcount;
simulationtree:- NEW tree(4);
IF simsettree == NONE THEN
simsettree:- NEW tree(3)
END T = SIMULATION
END W = 'S'
END STANDID ELSE
BEGIN
INSPECT simsettree DO hit:= found(t);
IF \ hit THEN
INSPECT simulationtree DO hit:= found(t);
END TESTING SYSTEM CLASS ID
END RESONABLE T.LENGTH ELSE
hit:= t = "LN";
IF hit THEN BEGIN
loopend:= Pos - 1;
FOR i:= p STEP 1 UNTIL loopend DO display[i]:=
markstandid
END ELSE
BEGIN
loopend:= Pos - 1;
FOR i:= p STEP 1 UNTIL loopend DO display[i]:=
markuserid
END
END NOT RESWD
END SOME LETTER(S) ELSE
IF Digit(window) OR window = '&' THEN
BEGIN
morenum:
display[Pos-1]:= 1;
numericflag:= window = '&';
IF More THEN
BEGIN
window:= Inchar;
WHILE (IF More THEN Digit(window) ELSE FALSE) DO
BEGIN
display[Pos-1]:= 1;
numericflag:= FALSE;
window:= Inchar
END;
IF window = '.' THEN GO TO morenum;
IF window = '&' THEN BEGIN
numericflag:= TRUE;
GO TO morenum
END;
IF (window = '+' OR window = '-') AND numericflag THEN
GO TO morenum;
GO TO scan
END MORE LOOP
END DIGIT(S) ELSE
IF window = ':' THEN display[Pos-1]:= 8 ELSE
IF window = '*' THEN display[Pos-1]:= 8 ELSE
IF window = '/' THEN display[Pos-1]:= 8 ELSE
IF window = '=' THEN display[Pos-1]:= 8 ELSE
IF window = '#' THEN display[Pos-1]:= 8 ELSE
IF window = '+' THEN display[Pos-1]:= 8 ELSE
IF window = '-' THEN display[Pos-1]:= 8 ELSE
IF window = '\' THEN display[Pos-1]:= 8 ELSE
IF window = '"' THEN
BEGIN
scantext:
window:= ' ';
display[Pos-1]:= 6;
WHILE (IF More THEN window NE '"' ELSE FALSE) DO
BEGIN
display[Pos]:= 6;
window:= Inchar
END;
IF window NE '"' THEN
BEGIN
warning("<CR><LF> detected before text constant closed by doublequote: ",Image);
abort("Further processing by ALGED would be risky...");
cutflag:= textflag:= TRUE
END
ELSE textflag:= FALSE;
END ELSE
IF window = ''' THEN
BEGIN
display[Pos-1]:= display[Pos]:= 7;
IF \ More THEN
w0:
warning("Character constant at line: ",Image) ELSE
BEGIN
Setpos(Pos+1);
IF \ More THEN GO TO w0;
display[Pos]:= 7;
window:= Inchar;
IF window NE ''' THEN GO TO w0
END
END ELSE
IF window = '!' THEN
BEGIN
display[Pos-1]:= 5;
scancomment:
textflag:= FALSE;
WHILE (IF More THEN window NE ';' OR
(IF t = "OPTIONS" THEN textflag ELSE FALSE) ELSE FALSE) DO
BEGIN
display[Pos]:= 5;
textflag:= NOT (window = '"' EQV textflag);
window:= Inchar
END;
textflag:= FALSE;
t:= NOTEXT;
IF window NE ';' THEN display[Pos]:= 5;
commentflag:= window NE ';';
END;
END BIG LOOP;
Close
END INSPECTING INPUT;
Close
END INSPECTING OUTPUT;
IF endcount NE begincount THEN warning("Error detected in blockstructure.",NOTEXT);
Outtext("[ALGED - Number of BEGIN's (END's) found:");
Outint(begincount,5);
IF endcount NE begincount THEN
BEGIN
Outtext(" (");
Outint(endcount,5);
Outchar(')');
Outtext(" ******************")
END;
Outtext(" ]");
Outimage;
Outimage;
outline("Program is recycling to edit another file...");
outline("Use a CTRL-Z to exit from ALGED.");
GO TO start;
END OF SAFMIN
END OF PROGRAM