Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/util/cdcsim.sim
There is 1 other file named cdcsim.sim in the archive. Click here to see a list.
OPTIONS(/-a/-d/-i/-q/l);
! CONVERSION FROM CDC SIMULA TO DEC SYSTEM-10 SIMULA
!
! 3.1 WHAT IS DONE BY THE CDCSIM PROGRAM
!
! The program CDCSIM can be used to perform the following
! conversion tasks:
!
! > Change characters from the CDC to the ASCII character set.
!
! > Change certain SIMULA words which are differently spelled on
! CDC and DEC (e.g. "POWER" to "**").
!
! > Find CDC identifiers longer than 12 characters, which are
! different but equal in their first 12 characters, and rename
! a few characters in one of them since only the first 12
! characters are significant on DEC SIMULA.
!
! > Rename identifiers which are reserved words on DEC but not
! on CDC (e.g. ELSE or THEN).
!
! > Remove the "@" characters surrounding operator words on CDC.
!
! > Remove blanks inside identifiers.
!
! 3.2 WHAT IS NOT DONE BY THE CDCSIM PROGRAM
!
! Here is an incomplete list of things not done by the CDCSIM
! program:
!
! > Conversion of TEXT and CHARACTER constants.
!
! > Conversion of COMMENTS.
!
!
! > Conversion of the format of declarations of external FORTRAN
! and ASSEMBLY procedures.
!
! > Conversion because RANK and CHAR work differently with the
! CDC and the ASCII character codes.
!
! 3.3 PROBLEMS WHICH MAY OCCUR
!
! You may have trouble with multi-line text constants in some
! special cases.
!
! Since the conversion of the CDCSIM program from IBM to DEC
! SIMULA, it has only been tested on one very large CDC
! program, which program however was converted correctly.
! CDCSIM has however been tested very thoroughly on many IBM
! SIMULA installations before conversion to DEC.
!
! 3.4 HOW TO USE THE CDCSIM PROGRAM
!
! Just run the program and answer the questions put to you.
! The program will ask for:
! > File name for input CDC program and output DEC program.
! > If you want to list the output program on the TTY.
! > If you want the program to modify long identifiers to avoid
! name clashes.
! > If you want to modify yourself the first 8 characters of
! such clashing identifiers.
!
! The program will use default values for all input parameters
! except the file name of the CDC program. Help is available
! by answering ? to the questions given by the program.
!
! If you modify long identifiers, then the program will
! produce a temporary file TEMP.TMP.
!
! The program also has a facility to convert from UNIVAC to
! IBM SIMULA, but this facility has not been tested on DEC.
! The facility is triggered by a line "%CON" in the input
! file.
!
! 3.5 ACKNOWLEDGEMENT
!
! CDCSIM was originally produced by the Norwegian Computing
! Center for converting UNIVAC and CDC SIMULA programs to IBM.
! We are very grateful for their permission to modify it for
! CDC to DEC conversion.
!
! 3.6 WHERE TO GET IT
!
! At the QZ Computing Center in Stockholm, CDCSIM is stored on
! DEC-tape H40A72.
!
! [END of CDCSIM.HLP];
OPTIONS(/l);
COMMENT this program was originally written as a one time
job for one special conversion task. As so often happens,
the program was found useful and was later extended many
times its original size by many different programmers.
The program may be regarded as a bad example of non-structured programming
although it does work in spite of all people who have meddled
into it without understanding all its inner workings.
The program is intended to convert to and from many different
computers, how many I do not know.
You may however, at your own risk, try to convert UNIVAC
programs to DEC with it, by setting con:= true.
The last, but not only, person who meddled into the
program and tried to make it runnable on a DEC 10 was
Jacob Palme. Previously I believe Karel Babcicky and Lars Enderin
have been working on it, if any of us or someone else
is responsible for the state of the program now is a closely
guarded secret but we would all like to rewrite the program
properly if we have time which will probably be never;
BEGIN BOOLEAN list, ownnames, tolongreal, lastlong;
BOOLEAN firstreplace, intextconstant, atendofrealconstant;
BOOLEAN dotfound;
EXTERNAL TEXT PROCEDURE upcase,rest;
EXTERNAL LONG REAL PROCEDURE scanreal;
EXTERNAL INTEGER PROCEDURE scanint;
EXTERNAL BOOLEAN PROCEDURE menu;
EXTERNAL CLASS safmin;
BOOLEAN change,change1; TEXT eof, inputfilename, outputfilename;
REF(safmin) safetalk;
REF(Outfile)temp; REF(tree) top,q,y;
REF(Infile)tempin, inputprogramfile;
TEXT PROCEDURE replacename(oldname); TEXT oldname;
INSPECT safetalk DO
BEGIN
TEXT newname, fullnewname; CHARACTER upcase;
IF firstreplace THEN
BEGIN
Outtext(
"Give replacement beginnings (1 to 8 characters) for identifiers which");
Outimage;
Outtext("have to be renamed:"); Outimage; Outimage;
firstreplace:= FALSE;
END;
getnewname:
Outtext("OLD = "); Outtext(oldname); Outtext(", ");
request("NEW = ",nodefault,textinput(newname,newname.Length<=7),
"? May not be longer than 7 characters.",nohelp);
IF NOT Letter(newname.Sub(1,1).Getchar) THEN
BEGIN
Outtext("Identifier must begin with letter.");
Outimage; GOTO getnewname;
END;
newname.Setpos(1); WHILE newname.More DO
BEGIN
upcase:= newname.Getchar;
IF NOT Letter(upcase) AND NOT Digit(upcase) AND upcase NE '_' THEN
BEGIN
Outtext("Identifier may only contain letters, digits and '_'.");
Outimage; GOTO getnewname;
END;
IF Rank(upcase) >= Rank('a') AND Rank(upcase) <= Rank('z') THEN
newname.Sub(newname.Pos-1,1).Putchar(Char(Rank(upcase)-32));
END;
fullnewname:- Copy("_____________");
fullnewname.Sub(1,newname.Length):= newname;
replacename:- fullnewname;
END;
CLASS tree(t,r); VALUE t; TEXT t,r;
BEGIN REF(tree) left,right; END;
top:-NEW tree ("LLLLLL******",NOTEXT);
INSPECT NEW safmin DO
BEGIN
PROCEDURE t(s); NAME s; TEXT s;
BEGIN Outtext(s); Outimage;
END;
BOOLEAN PROCEDURE changehelp;
BEGIN
t("");
t("The first 256 characters are significant in identifiers");
t("on CDC, but only the first 12 characters on DEC. This");
t("means that two different identifiers with the same leading");
t("12 characters will be regarded as one and the same identifier");
t("on DEC. If you answer yes to this question, the program will");
t("modify the names of such clashing identifiers to avoid");
t("name clashes. If you answer no, this will not be done.");
END;
BOOLEAN PROCEDURE filenamehelp;
BEGIN
t("");
t("The device and file name is given according to normal");
t("DEC practice, that is e.g. ");
t("MYPROG.CDC");
t("or");
t("DTA:MYPROG.SIM");
t("You are not allowed to assume a default value for the input");
t("file name, for the output file name the default value is");
t("LPT:");
t("that is, producing a spooled line printer output file.");
END;
BOOLEAN PROCEDURE listhelp;
BEGIN
t("");
t("If you answer yes, the converted output program will be");
t("printed both on the terminal and on the output device");
t("which you just specified. If you answer no, the converted");
t("output program will only be printed on the device specified");
t("by you, and not on the terminal(except if you specified");
t("TTY: as the device of course).");
END;
BOOLEAN PROCEDURE ownhelp;
BEGIN
t("");
t("When the system tries to rename identifiers which have to");
t("be renamed on the DEC to avoid name clashes, it may");
t("ask you to supply new text for character 1-8 of");
t("the identifier at the terminal.");
t("");
END;
BOOLEAN PROCEDURE longrealhelp;
BEGIN
t("");
t("The wordlength of REAL variables is 60 bits on CDC 6000 series,");
t("but only 36 bits on DECsystem-10. By converting to LONG REAL, you");
t("a word length of 72 bits on DECsystem-10, keeping the full CDC");
t("precision.");
t("");
END;
firstreplace:= TRUE;
BEGIN COMMENT start of question-and answer section;
Outchar(Char(12)); Outimage;
t("CDCSIM - conversion of SIMULA programs from CDC to DEC.");
t("======================================================");
t("");
t("If you want help explanation to a question from the");
t("computer, type ?."); Outimage;
t("If you want the computer to use default values as");
t("answers to its questions to you, type CARRIAGE RETURN only.");
Outimage;
END;
request("Give device and file name of CDC program:",nodefault,
textinput(inputfilename,TRUE),"",filenamehelp);
request("Give device and file name for outputting DEC program","LPT:",
textinput(outputfilename,TRUE),"",filenamehelp);
request("Do you want to list output program on the TTY?:",
"no",boolinput(list),"",listhelp);
request("Do you want the program to remove identifier name clashes?:",
"yes",boolinput(change),"",changehelp);
request("Do you want to convert CDC REAL to DEC10 LONG REAL?","no",
boolinput(tolongreal),"",longrealhelp);
IF change THEN
request("Do you want to give new identifier beginnings yourself?:",
"no",boolinput(ownnames),"",ownhelp);
safetalk:- THIS safmin;
END of inspect safeio;
inputprogramfile:- NEW Infile(inputfilename);
inputprogramfile.Open(Blanks(80));
INSPECT inputprogramfile DO
INSPECT NEW Outfile(outputfilename) DO
BEGIN PROCEDURE Outimage;
IF NOT intextconstant THEN
BEGIN IF list THEN BEGIN Sysout.Image:=Image;Sysout.Outimage END;
THIS Outfile.Outimage;
END;
PROCEDURE scantree(x); REF(tree) x;
INSPECT x DO
BEGIN scantree(left);
Outtext(r.Sub(1,12)); Outchar(' '); Outtext(t); Outimage;
scantree(right);
END;
Open(Blanks(72));
BEGIN TEXT i,v,t;
TEXT w; BOOLEAN ident; INTEGER count,k;
BOOLEAN cdc,con,b;
CHARACTER PROCEDURE inchar1;
BEGIN CHARACTER inctemp;
IF NOT w.More THEN
BEGIN
IF intextconstant AND w.Length < 72 THEN
BEGIN
TEXT wmain;
wmain:- inputprogramfile.Image.Sub(1,72); wmain.Setpos(w.Pos);
w:- wmain;
END ELSE
BEGIN
IF NOT ident THEN Outimage ELSE
IF cdc THEN ident:=FALSE ELSE
BEGIN inchar1:=' '; GOTO exit END;
tempin.Inimage;
IF eof="/*" THEN GOTO finis ELSE
w:-inputprogramfile.Image.Sub(1,72).Strip
END;
END;
inchar1:= inctemp:=IF w.More THEN w.Getchar ELSE ' ' ;
IF w.Pos = 3 AND inctemp = '*' THEN
BEGIN IF w.Sub(1,2) = "/*" THEN inchar1:= ' ';
END;
exit:
END;
BEGIN TEXT ARRAY u(0:64); TEXT tt; INTEGER j,m,x; CHARACTER sem3;
CHARACTER PROCEDURE Inchar; Inchar:=inchar1;
BOOLEAN PROCEDURE Lastitem;
BEGIN WHILE Inchar=' ' DO; k:=w.Pos - 1; w.Setpos(k); END;
TEXT ARRAY tr(0:127);
CHARACTER c,sem1,sem2,space,iquote,iplus,iminus,istar,islash,iequal,
idot,icomma,icolon,isemicolon,iet,ileft,iright,iapostroph;
PROCEDURE next;
FOR c:=Inchar WHILE c=space DO
IF eof="/*" THEN GOTO finis;
SWITCH s:=slash,equal,dot,colon,et,bracket,apostroph,scantext,start;
eof:-inputprogramfile.Image.Sub(1,2);
v:-Blanks(72);
tempin:-inputprogramfile;
zac: IF NOT Lastitem THEN c:=Inchar;
IF c='%' THEN
BEGIN IF NOT con THEN con:=w="%CON";
IF NOT list THEN list:=w="%LIST";
IF NOT change THEN change:=w="%CHANGE";
w:-NOTEXT; GOTO zac
END;
IF c='.' THEN BEGIN w.Putchar('/'); Outtext(w); w:-NOTEXT; GOTO zac END;
IF change THEN
BEGIN CHARACTER ch; ch:=c;
BEGIN
COMMENT THIS PIECE OF CODING LOCATES ALL IDENTIFIERS THAT HAVE TO BE
SYSTEMATICALLY CHANGED TO AVOID CONFLICTS ARISING FROM A RATHER
RESTRICTED LENGTH OF IBM SIMULA IDENTIFIERS. THE SUBSTITUTE
IDENTIFIER IS FORMED FROM THE ORIGINAL IDENTIFIER BY INSERTING
"NNN" IS THE ORDINAL NUMBER WITHIN THE GROUP OF AMBIGUOUS
"_NNN" AS THE LAST OF THE 12 SIGNIFICANT CHARACTERS, WHERE
IDENTIFIERS. POSSIBLE REPLACEMENTS ARE
ABCDEFGIJ_9M1 FOR ABCDEFGHIJKLM1, ABCDEFGHI_10M2 FOR
ABCDEFGIJKLM2, ETC. THE STARTING NUMBER MAY BE GIVEN ON THE
CARD FOLLOWING THE %CHANGE CARD. ;
CLASS node(t); VALUE t; TEXT t;
BEGIN REF(node) l,r,s; END;
PROCEDURE scan(x); REF(node) x;
INSPECT x DO INSPECT s DO
BEGIN e:-x.t; scan(l); scan(r);
scan(x.l); scan(x.r);
END OTHERWISE
BEGIN count:=count + 1;
root:=e; excess:=t; v:-b.Strip;
IF count=k THEN BEGIN k:=k*10; ndig:=ndig+1; END;
u:-Copy(v); idn:-u.Sub(12-ndig,ndig+1);
IF ownnames THEN u.Sub(1,10):= replacename(u).Sub(1,10);
idn.Putchar('_'); idn.Sub(2,ndig).Putint(count);
FOR y:-top,IF v<y.t THEN y.left ELSE y.right
WHILE y=/=NONE DO w:-y;
IF v<w.t THEN w.left :-NEW tree(v,u)
ELSE w.right:-NEW tree(v,u);
scan(l); scan(r);
END;
BOOLEAN btx,txt;
CHARACTER c;
REF(node) first,q,x;
REF(tree) w;
INTEGER count,k,ndig;
BOOLEAN ARRAY d(0:127);
TEXT root,excess,id,idn,r,e,b,u,v;
LONG REAL ln10;
COMMENT *** INITIAL ACTION OF THE FIRST SCAN ***;
b:-inputprogramfile.Image; id:-Copy(b); b:=NOTEXT;
IF Digit(ch) THEN
BEGIN count:=id.Getint; id:=b; END;
temp:-NEW Outfile("TEMP.TMP");
temp.Open(b); temp.Outtext(id); temp.Outimage;
WHILE NOT Endfile DO BEGIN Inimage; temp.Outimage END;
temp.Close;
b:-Blanks(256);
root:-b.Sub(1,12); excess:-b.Sub(13,244);
b:="0123456789;&-*/#.,:^!%<)\('??:>+_\";
FOR c:=b.Getchar WHILE c\=' ' DO d(Rank(c)):=TRUE;
ln10:=Ln(10);
k:=IF count=0 THEN 1 ELSE 10&&0*10&&0**Entier(Ln(count)/ln10);
ndig:=Entier(Ln(k)/ln10+0.5);
first:-NEW node("LLLLLL******"); first.s:-NEW node(r);
tempin:-NEW Infile("TEMP.TMP"); tempin.Open(inputprogramfile.Image);
INSPECT tempin DO
BEGIN
Main: IF Lastitem THEN GOTO print;
c:=Inchar;
test: IF d(Rank(c)) THEN GOTO Main;
IF Letter(c) THEN COMMENT *** IDENTIFIER ***; BEGIN
b:=NOTEXT; b.Setpos(1);
put: b.Putchar(c);
next: IF Lastitem OR Pos>72 THEN BEGIN Inimage; GOTO next END;
c:=Inchar;
IF Letter(c) OR Digit(c) THEN GOTO put;
IF b.Pos>12 THEN BEGIN
r:-root; e:-excess.Strip;
FOR x:-first,IF r<x.t THEN x.l ELSE x.r WHILE x=/=NONE DO
IF r\=x.t THEN q:-x ELSE
IF r==e THEN GOTO out ELSE
BEGIN q:-x:-x.s; IF e=x.t THEN GOTO out; r:-e END;
x:-NEW node(r);
IF r=/=e THEN x.s:-NEW node(e);
IF r<q.t THEN q.l:-x ELSE q.r:-x;
out: END; END;
IF c='@' THEN COMMENT *** BASIC WORD OR TEXT CONSTANT ***;
BEGIN IF Image.Sub(Pos,7)="COMMENT" THEN
BEGIN Setpos(Pos+8);
c:= Inchar;
incomment: WHILE c NE '!' AND c NE '.' DO c:= Inchar;
IF c = '.' THEN
BEGIN
c:= Inchar; IF c NE ',' THEN GOTO incomment;
END;
GOTO Main;
END;
btx:=TRUE; txt:=FALSE;
WHILE NOT Lastitem DO
IF Inchar NE c THEN btx:=FALSE ELSE
IF txt THEN
BEGIN IF btx THEN GOTO Main ELSE btx:=TRUE END ELSE
IF btx THEN BEGIN txt:=TRUE; btx:=FALSE END ELSE GOTO Main;
END;
IF c='$' THEN COMMENT *** CHARACTER CONSTANT ***;
BEGIN Inchar; Inchar END;
GOTO Main;
END;
print:scan(first);
tempin.Close; tempin.Open(inputprogramfile.Image);
change:=FALSE; change1:=TRUE; GOTO zac;
END;
END;
IF c='S' THEN BEGIN Outchar(c);
FOR c:=Inchar WHILE Letter(c) DO Outchar(c);
IF c=' ' THEN BEGIN Outchar(' ');
FOR c:=Inchar WHILE c=' ' DO Outchar(c)
END;
END;
cdc:=NOT Letter(c); sem3:='!';
i:-IF cdc THEN Copy(";&-*/#.,:!@%<$)^('{?}>+_\ ")
ELSE
IF con THEN Copy(" &-*/#.,';:%<@")
ELSE Copy(" +-*/=.,:;&()'");
IF NOT cdc THEN BEGIN i.Putchar('"'); i.Setpos(1);
sem1:='!'; sem2:='$'; space:='\'
END
ELSE BEGIN i.Sub(i.Length,1).Putchar('"');
sem1:=sem2:='!'; space:=' '
END;
iquote :=i.Getchar; tr(Rank(iquote )):-Copy("8");
iplus :=i.Getchar; tr(Rank(iplus )):-Copy("+");
iminus :=i.Getchar; tr(Rank(iminus )):-Copy("-");
istar :=i.Getchar; tr(Rank(istar )):-Copy("*");
islash :=i.Getchar; tr(Rank(islash )):-Copy("1");
iequal :=i.Getchar; tr(Rank(iequal )):-Copy("2");
idot :=i.Getchar; tr(Rank(idot )):-Copy("3");
icomma :=i.Getchar; tr(Rank(icomma )):-Copy(",");
icolon :=i.Getchar; tr(Rank(icolon )):-Copy("4");
isemicolon:=i.Getchar; tr(Rank(isemicolon)):-Copy("9");
iet :=i.Getchar; tr(Rank(iet )):-Copy("5");
ileft :=i.Getchar; tr(Rank(ileft )):-Copy("6");
iright :=i.Getchar; tr(Rank(iright )):-Copy(")");
iapostroph:=i.Getchar; tr(Rank(iapostroph)):-Copy("7");
IF NOT cdc THEN
tr(Rank('!')):-tr(Rank('$')):-tr(Rank(isemicolon));
IF NOT cdc THEN GOTO l2;
tr(Rank(i.Getchar )):-Copy("**" );
tr(Rank(i.Getchar )):-Copy(">" );
tr(Rank(i.Getchar )):-Copy(">=" );
tr(Rank(i.Getchar )):-Copy("<=" );
tr(Rank(i.Getchar )):-Copy("<" );
tr(Rank(i.Getchar )):-Copy(" AND ");
tr(Rank(i.Getchar )):-Copy(" OR " );
tr(Rank(i.Getchar )):-Copy(" EQV ");
tr(Rank(i.Getchar )):-Copy("\" );
tr(Rank(i.Getchar )):-Copy(" IMP ");
tr(Rank(i.Getchar )):-Copy(")" );
tr(Rank(i.Getchar )):-Copy("(" );
COMMENT *** SEE NOTE BELOW ***;
BEGIN
PROCEDURE p(reserved); VALUE reserved; TEXT reserved;
BEGIN
u(x):- reserved; x:= x+1;
END;
x:= 0;
p("ACTIVATE ");
p("ACTIVATE ");p("AFTER ");p("AND ");p("ARRAY ");
p("AT ");p("BEFORE ");p("BEGIN ");
p("BOOLEAN ");p("CHARACTER ");p("CLASS ");p("COMMENT ");
p("DELAY ");p("DO ");p("ELSE ");p("END ");
p("EQ ");p("EQV ");p("EXTERNAL ");p("FALSE ");
p("FOR ");p("GE ");p("GO ");
p("GOTO ");p("GT ");p("IF ");p("IMP ");
p("IN ");p("INNER ");p("INSPECT ");p("INTEGER ");
p("IS ");p("LABEL ");p("LE ");p("LONG ");
p("LT ");p("NAME ");p("NE ");p("NEW ");
p("NONE ");p("NOT ");p("NOTEXT ");
p("OPTIONS ");p("OR ");
p("OTHERWISE ");p("PRIOR ");p("PROCEDURE ");p("QUA ");
p("REACTIVATE");p("REAL ");p("REF ");p("SHORT ");
p("STEP ");p("SWITCH ");p("TEXT ");p("THEN ");
p("THIS ");p("TO ");p("TRUE ");p("UNTIL ");
p("VALUE ");p("VIRTUAL ");p("WHEN ");p("WHILE ");
END;
tt:-Blanks(10);
GOTO l2;
l1: c:=Inchar;
l2: IF c NE iet AND atendofrealconstant THEN
BEGIN Outtext("&&0"); atendofrealconstant:= FALSE;
END;
t:-tr(Rank(c));
IF Letter(c) THEN
BEGIN ident:=TRUE; v.Setpos(1); k:=w.Pos;
WHILE Letter(c) OR Digit(c) DO
BEGIN v.Putchar(c); next END;
t:-v.Sub(1,v.Pos-1);
COMMENT
************************************************************************
* *
* NOTE: A CDC IDENTIFIER MAY HAVE UP TO 256 CHARACTERS I.E. THE SET *
* OF ALL DIFFERENTLY SPELLED IDENTIFIERS THAT ARE AVAILABLE , *
* IS PRACTICALLY INFINITE.YET, THERE ARE SOME FUCKING IDIOTS *
* IN THIS WORLD,WHO ARE NOT ABLE TO WRITE A BLOODY CDC-SIMULA *
* PROGRAM WITHOUT USING SIMULA RESERVED WORDS FOR THEIR *
* BLEEDING IDENTIFIERS. *
* THIS COSTLY PIECE OF CODING IS A TRIBUTE TO THEIR MISPLACED *
* GENIUS ... *
* *
***********************************************************************;
IF cdc AND t.Length <= 10 THEN
BEGIN tt:=t; j:=0; m:=64;
try: IF m<=j+1 THEN GOTO out1 ELSE x:=Entier((m-j)/2)+j;
IF tt<u(x) THEN
BEGIN m:=x; GOTO try; END ELSE
IF tt>u(x) THEN
BEGIN j:=x; GOTO try; END;
IF t.Length=4 THEN
BEGIN
IF t="TEXT" THEN BEGIN t:="COPY";GOTO out1 END END;
COMMENT THIS EVEN MORE COSTLY CODE ENSURES THAT
SOME TWOCHAR RESERVED IDS DO NOT LOSE THEIR IDENTITY:-
GE -> G_, GO -> P_, GT -> H_
IF -> F_, IN -> I_, IS-> S-,
LE -> L_, LT -> K_
;
IF t.Length=2 THEN
BEGIN CHARACTER c1,c2;
TEXT substr;
INTEGER i;
t.Setpos(1); c1:=t.Getchar;
IF c1='I' THEN i:=3 ELSE
IF c1='L' THEN i:=6 ELSE
IF c1\='G' THEN GOTO over;
c2:=t.Getchar;
IF c2>='S' THEN i:=2+i ELSE
IF c2>='N' THEN i:=1+i;
substr:-Copy("GPHFISL_K");
c1:=substr.Sub(i+1,1).Getchar;
t.Setpos(1); t.Putchar(c1);
END;
over:
t.Setpos(t.Length); t.Putchar('_');
out1:
END ELSE IF t.Length>=12 AND change1 THEN
BEGIN FOR y:-top,IF t<y.t THEN y.left ELSE
IF t>y.t THEN y.right ELSE NONE WHILE y=/=NONE DO
q:-y;
IF t=q.t THEN t:-q.r;
END; Outtext(t);
IF \t.More THEN Outchar(' ');
k:=w.Pos-k; IF k GT 0 THEN BEGIN k:=k-t.Length;
IF k GT 0 THEN Outtext(Blanks(k))
END ELSE k:=1000;
IF ident THEN ident:=FALSE ELSE Outimage;
IF cdc AND k=1000 THEN Setpos(w.Pos-1);
IF t="COMMENT" THEN GOTO com ELSE GOTO l2
END ELSE
BEGIN COMMENT here we come if c was not a letter;
IF t==NOTEXT THEN
BEGIN
IF tolongreal AND Digit(c) THEN
BEGIN
WHILE Digit(c) OR c =' ' OR c ='.' DO
BEGIN
IF c NE ' ' THEN Outchar(c);
IF c EQ '.' THEN dotfound:= TRUE;
c:= Inchar;
END;
IF NOT dotfound THEN GOTO l2;
dotfound:= FALSE;
atendofrealconstant:= TRUE; GOTO l2;
END ELSE Outchar(c);
END ELSE
IF Digit(t.Getchar) THEN GOTO s(t.Getint) ELSE Outtext(t);
GOTO l1;
END;
start: Outchar(';'); Outimage; Outimage;
Outtext("COMMENT *** THIS PROGRAM WAS CONVERTED");
Outtext(" ***");
Outimage; Setpos(9); Outtext("*** FROM ITS ");
IF cdc THEN Outtext("CDC") ELSE Outtext("UNIVAC");
Outtext(" REPRESENTATION"); IF con THEN
BEGIN Outtext(" ***"); Outimage; Setpos(9);
Outtext("*** (USING CON OPTION). ***")
END ELSE IF NOT cdc THEN Outtext(". ***") ELSE Outtext(". ***");
Outimage;
Setpos(9); Outtext("*** CONVERSION WAS PERFORMED ***");
Outimage; Setpos(9); Outtext("*** ON A");
Outtext(IF Rank('A')=6 THEN " UNIVAC" ELSE IF
Rank('A')=65 THEN " DEC-10" ELSE "N IBM");
Outtext(" COMPUTER. ");
IF Rank('A') NE 6 AND Rank('A') NE 65 THEN Outtext(" ");
Outtext("***;"); Outimage; Outimage;
IF change1 THEN
BEGIN Outtext("COMMENT CHANGE OPTION WAS SPECIFIED UNDER CONVERSION:");
Outimage; Outimage;
scantree(top.left); scantree(top.right); Outchar(';');
END;
t.Main.Putchar(';'); GOTO l1;
slash: next; IF c=iright THEN BEGIN Outchar(')'); next END
ELSE Outchar('/'); GOTO l2;
bracket: next; IF c=islash THEN next; Outchar('('); GOTO l2;
dot: next; IF c=idot THEN Outchar(':') ELSE
IF c=icomma THEN Outchar(';') ELSE
IF c=iequal THEN Outtext(":=") ELSE
IF c=iminus THEN Outtext(":-") ELSE
BEGIN Outchar('.'); IF Digit(c) THEN dotfound:= TRUE;
GOTO l2
END; GOTO l1;
colon: IF NOT cdc THEN Outchar(':') ELSE
BEGIN count:=0; ident:=TRUE;
FOR c:=Inchar WHILE c=' ' DO count:=count+1;
IF c=islash THEN Outtext("//") ELSE
BEGIN Outchar(':');
IF c NE '=' OR c NE '-' THEN Outtext(Blanks(count));
IF ident THEN ident:=FALSE ELSE Outimage;
GOTO l2 END; END;
GOTO l1;
et: next; IF c=iplus OR c=iminus OR Digit(c) THEN
BEGIN
Outtext(IF tolongreal THEN "&&" ELSE "&");
atendofrealconstant:= FALSE;
END ELSE
BEGIN
IF atendofrealconstant THEN
BEGIN Outtext("&&0"); atendofrealconstant:= FALSE;
END;
IF c=iet THEN
BEGIN IF cdc THEN GOTO scantext ELSE Outchar('&')END
ELSE IF cdc THEN GOTO scanbasic;
END; GOTO l2;
equal: IF cdc THEN Outchar('=') ELSE
BEGIN c:=Inchar; IF c=islash THEN
BEGIN c:=Inchar; IF c\=iequal THEN BEGIN Outtext("\="); GOTO l2
END ELSE Outtext("=/="); END ELSE BEGIN Outchar('='); GOTO l2
END;
END; GOTO l1;
apostroph:Outchar('''); c:=Inchar; Outchar(c);
Inchar; Outchar('''); GOTO l1;
scantext:Outchar('"');
intextconstant:= TRUE;
BEGIN
TEXT textconstant, newtextconstant, parttextconstant;
INTEGER charsleft;
PROCEDURE outtext2(t); TEXT t;
WHILE t.More DO outchar2(t.Getchar);
PROCEDURE outchar2(c); CHARACTER c;
BEGIN
IF NOT textconstant.More THEN
BEGIN newtextconstant:- Blanks(textconstant.Length+72);
newtextconstant:= textconstant;
newtextconstant.Setpos(textconstant.Length+1);
textconstant:- newtextconstant;
END;
textconstant.Putchar(c);
END;
textconstant:- Blanks(80);
l:FOR c:=Inchar WHILE c NE iet DO
IF c=iquote THEN GOTO out ELSE
BEGIN IF cdc AND c='"' THEN c:='('; outchar2(c); END;
b:=FALSE; v.Setpos(1); v.Putchar(c);
FOR c:=Inchar WHILE c NE iet DO
BEGIN v.Putchar(c);
IF c NE ' ' AND ( c=iright IMP b) THEN
BEGIN outtext2(v.Sub(1,v.Pos-1)); GOTO l END;
IF c=iright THEN b:=TRUE;
END;
out:
outchar2('"');
intextconstant:= FALSE;
textconstant:- textconstant.Sub(1,textconstant.Pos-1);
outputit:
charsleft:= THIS Outfile.Image.Length-THIS Outfile.Image.Pos+1;
IF textconstant.Length <= charsleft THEN Outtext(textconstant)
ELSE
BEGIN
parttextconstant:- textconstant.Sub(1,charsleft).Strip;
IF parttextconstant.Length = 0 AND charsleft = 72 THEN
parttextconstant:- textconstant.Sub(1,charsleft);
textconstant:- textconstant.Sub(parttextconstant.Length+1,
textconstant.Length-parttextconstant.Length);
Outtext(parttextconstant); Outimage;
GOTO outputit;
END;
GOTO l1;
END;
com: IF cdc THEN
BEGIN FOR c:=Inchar WHILE c\=sem1 AND c \= '.' DO
IF c='$' OR c=';' THEN Outchar(' ') ELSE Outchar(c);
IF c = '.' THEN
BEGIN
c:= Inchar; IF c NE ',' THEN
BEGIN Outchar('.'); Outchar(c); GOTO com;
END;
END;
GOTO exit;
END; Outchar(c);
FOR c:=Inchar WHILE c\=sem1 AND c\=sem2 AND c\=sem3 DO
ll: BEGIN IF c=idot THEN
BEGIN c:=Inchar; IF c=icomma THEN GOTO exit
ELSE BEGIN Outchar('.'); GOTO ll END
END; Outchar(c)
END;
exit: Outchar(';'); GOTO l1;
scanbasic: v:=NOTEXT; v.Setpos(2);
WHILE c NE iet DO BEGIN v.Putchar(c);next END;
t:-v.Sub(1,v.Pos);
IF t=" % " THEN GOTO scantext ELSE
IF t=" / " OR t=" DIV " THEN Outtext("//") ELSE
IF t = " REAL " THEN
BEGIN
IF NOT lastlong AND tolongreal THEN Outtext("LONG REAL ") ELSE
Outtext("REAL "); lastlong:= FALSE;
END ELSE IF t =" LONG " THEN
BEGIN
lastlong:= TRUE; Outtext("LONG");
END ELSE
IF t=" POWER " THEN Outtext("**") ELSE
IF t=" GREATER " THEN Outchar('>') ELSE
IF t=" NOTLESS " THEN Outtext(">=") ELSE
IF t=" EQUAL " THEN Outchar('=') ELSE
IF t=" NOTEQUAL " THEN Outtext(" NE ") ELSE
IF t=" NOTGREATER " THEN Outtext("<=") ELSE
IF t=" LESS " THEN Outchar('<') ELSE
IF t=" EQUIV " THEN Outtext(" EQV ") ELSE
IF t=" IDENT " THEN Outtext("==") ELSE
IF t=" NOTIDENT " THEN Outtext("=/=") ELSE
IF t=" IMPL " THEN Outtext(" IMP ") ELSE
IF Pos=1 THEN Outtext(t.Sub(2,t.Length-1)) ELSE BEGIN k:=Pos-1;
Setpos(k);
c:=Image.Getchar; IF Letter(c) OR Digit(c) THEN
Outtext(t) ELSE Outtext(t.Sub(2,t.Length-1)); END;
GOTO IF t=" COMMENT " THEN com ELSE l1;
END;
finis:
END ;
inputprogramfile.Close;
IF tempin=/=inputprogramfile THEN INSPECT tempin DO Close; Close;
END ;
END ;