Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/27/libtes.sim
There are 2 other files named libtes.sim in the archive. Click here to see a list.
00010	OPTIONS(/P:"Tests of external MACRO-10 procedures");
00020	BEGIN
00030	EXTERNAL TEXT PROCEDURE conc,daytime,today;
00040	EXTERNAL REAL PROCEDURE clocktime,cptime;
00050	EXTERNAL INTEGER PROCEDURE output,putsize,input,scanint;
00060	EXTERNAL TEXT PROCEDURE rest, frontstrip;
00070	EXTERNAL PROCEDURE write,read,sleep;
00080	EXTERNAL TEXT PROCEDURE inline,upcase;
00090	TEXT p,t,t1,t2,t3,t4,t5,t6;
00100	INTEGER i,j,k,l,m,n;
00110	BOOLEAN b,b1,b2,b3;
00120	REAL r,r1,r2,r3;
00130	LONG REAL lr,lr1,lr2,lr3;
00140	CHARACTER c,c1,c2,c3;
00150	REF(Infile)inf,inf1,inf2;
00160	REF(Directfile)df,df1,df2;
00170	REF(Outfile)ouf,ouf1,ouf2;
00180	REF(Printfile)prf,prf1,prf2;
00190	CHARACTER testchar;
00200	TEXT im;
00210	PROCEDURE prompt(t); VALUE t; TEXT t;
00220	BEGIN Outtext(t); Breakoutimage; END;
00230	PROCEDURE display(t1,t2); VALUE t1,t2; TEXT t1,t2;
00240	BEGIN Outtext(t1); Outchar('"'); Outtext(t2); Outchar('"');  Outimage; END;
00250	PROCEDURE inim;
00260	BEGIN Inimage; im.Setpos(1); IF Endfile THEN GOTO out;
00270	END;
00280	INTEGER nproc;
00290	BOOLEAN PROCEDURE testexists(procname); VALUE procname; TEXT procname;
00300	BEGIN  upcase(procname);
00310	    IF testchar='?' THEN
00320	    BEGIN Outtext(procname);
00330		IF nproc = 5 THEN
00340		BEGIN   nproc:=0;
00350		    Outimage;
00360		END ELSE
00370		BEGIN   nproc:=nproc+1;
00380		    Outchar(Char(9));
00390		END;
00400	    END ELSE testexists:=upcase(p)=procname;
00410	END testexists;
00420	
00430	im :- Sysin.Image;
00440	inf:-Sysin; ouf:-Sysout;
00450	
00460	start:  Outimage;  nproc:= 0;
00470	Outtext("Which procedure?"); Breakoutimage;
00480	inim;
00490	p:-Sysin.Image.Sub(1,6);
00500	testchar:=p.Getchar;
00510	IF testchar='?' THEN
00520	BEGIN Outtext("Available procedures:"); Outimage;
00530	END;
00540	Sysin.Setpos(0);
00550	
00560	    COMMENT Each test on a new page, surrounded by
00570	    !    IF testexists("p-name") THEN
00580	    !    BEGIN
00590	    !    <test code, including declaration of
00600	    !     EXTERNAL [<type>] PROCEDURE p-name>
00610	    !    END ELSE
00620	    ! where p-name is exactly 6 characters from the start of
00630	    ! the procedure name;
     
00640	IF testexists("abort ") THEN
00650	BEGIN
00660	    EXTERNAL PROCEDURE abort;
00670	    prompt("Give message:"); inim;
00680	    t:-Copy(im.Strip);
00690	    abort(t);
00700	END ELSE
00702	
00704	!-------------------------------------------------------------------;
00706	
00710	IF testexists("boksta") THEN
00720	BEGIN
00730	    EXTERNAL BOOLEAN PROCEDURE bokstav;
00740	    INTEGER i; CHARACTER c;
00750	    FOR i:=0 STEP 1 UNTIL 127 DO
00760	    IF bokstav(Char(i)) THEN
00770	    BEGIN Outchar(Char(i)); Outchar('('); Outint(i,3); Outtext(")  ");
00780		IF Pos>50 THEN Outimage;
00790	    END;
00800	    Outimage
00810	END ELSE
00812	
00814	!-------------------------------------------------------------------;
00816	
00830	IF testexists("check?") THEN GOTO scan_number ELSE
00832	
00834	!-------------------------------------------------------------------;
00836	
00840	IF testexists("compre") THEN
00850	BEGIN
00860	    EXTERNAL TEXT PROCEDURE compress;
00870	
00880	    l:	t:-inline("input text t:",Sysin);
00890	    IF t==NOTEXT THEN GO TO out;
00900	    prompt("Char to eliminate:/(blank)/:"); inim;
00910	    c:=im.Getchar;
00920	    display("compress(t,c)=",compress(t,c));
00930	    GO TO l;
00940	    out:
00950	END ELSE
     
00960	IF testexists("conc  ") THEN
00970	BEGIN !text concatenation;
00980	    TEXT t1,t2,t3,t;
00990	!   EXTERNAL TEXT PROCEDURE conc;
01000	
01010	    t1:-Copy("ABCDEFGHIJ");
01020	    t2:-Copy("123456789012345");
01030	    t :- conc(t1,t2);
01040	    display("t1=",t1);
01050	    display("t2=",t2);
01060	    display("t=",t);
01070	    display("t.Sub(3,11)=",t.Sub(3,11));
01080	    display("""ZYX1234""=","ZYX1234");
01090	    display("conc=",conc(t.Sub(3,11),"ZYX1234"));
01100	END ELSE
01102	
01104	!-------------------------------------------------------------------;
01106	
01110	IF testexists("conc2 ") THEN
01120	BEGIN !text concatenation;
01130	    TEXT t1,t2,t3,t;
01140	    EXTERNAL TEXT PROCEDURE conc2;
01150	
01160	    t1:-Copy("ABCDEFGHIJ");
01170	    t2:-Copy("123456789012345");
01180	    t :- conc2(t1,t2);
01190	    display("t1=",t1);
01200	    display("t2=",t2);
01210	    display("t=",t);
01220	    display("t.Sub(3,11)=",t.Sub(3,11));
01230	    display("""ZYX1234""=","ZYX1234");
01240	    display("conc2=",conc2(t.Sub(3,11),"ZYX1234"));
01250	END ELSE
     
01260	IF testexists("date  ") THEN GOTO date_time_max_etc ELSE
01262	
01264	!-------------------------------------------------------------------;
01266	
01270	IF testexists("depcha") THEN
01280	BEGIN
01290	    EXTERNAL PROCEDURE depchar;
01300	    CHARACTER c;
01310	    TEXT t;
01320	    INTEGER i;
01330	    t:-Blanks(10);
01340	    FOR i:=-3 STEP 1 UNTIL 12 DO
01350	    BEGIN depchar(t,i,Char(Rank('A')-1+i));
01360	    END;
01370	    Outtext(t); Outimage;
01380	END ELSE
     
01390	IF testexists("dotype") THEN
01400	BEGIN
01410	    EXTERNAL BOOLEAN PROCEDURE dotypeout;
01420	    l:	prompt("Which TTY?/your own/:"); inim;
01430	    t:-Copy(im.Strip);
01440	    IF t==NOTEXT THEN
01450	    BEGIN inf1:-Sysin;
01460		ouf1:-Sysout;
01470	    END ELSE
01480	    IF im.Getchar=Char(27) THEN GOTO out ELSE
01490	    BEGIN
01500		inf1:-NEW Infile(t);
01510		ouf1:-NEW Outfile(t);
01520		inf1.Open(Blanks(80));
01530		ouf1.Open(Blanks(80));
01540	    END;
01550	    l1:	INSPECT ouf1 DO
01560	    BEGIN
01570		Outtext("Starting output - try stopping via ^O"); Outimage;
01580		FOR i:=1 STEP 1 UNTIL 10 DO
01590		BEGIN
01600		    Outint(i,5); Outtext("AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA");
01610		    Outimage;
01620		END;
01630		IF dotypeout(ouf1) THEN
01640		BEGIN
01650		    ouf1.Outtext("^O defeated"); ouf1.Outimage;
01660		END;
01670	    END;
01680	    prompt("More from the same tty?/NO/"); inim;
01690	    c:=im.Getchar;
01700	    IF NOT (c=' ' OR c='N' OR c='n') THEN GOTO l1;
01710	    IF inf1=/=Sysin THEN
01720	    BEGIN
01730		inf1.Close; ouf1.Close;
01740	    END;
01750	    GOTO l;
01760	    out:
01770	END ELSE
     
01780	IF testexists("echo  ") THEN
01790	BEGIN
01800	    EXTERNAL PROCEDURE echo;
01810	    inf:-Sysin;
01820	    prompt("Before call on echo - input a line:"); inim;
01830	    echo(inf,1);
01840	    prompt("Special editor mode, input line:"); inim;
01850	    display("Your line was:",im);
01860	    echo(inf,2);
01870	    prompt("echo should be suppressed now, input a line:"); inim;
01880	    display("Your line was:",im);
01890	    echo(inf,4);
01900	    prompt("echoing characters unaltered now, input a line:"); inim;
01910	    echo(inf,0);
01920	    prompt("Input mode as integer >=0 and <=7:"); inim;
01930	    t:-im.Strip;
01940	    echo(inf,IF t==NOTEXT THEN 0 ELSE t.Getint);
01950	    prompt("Input a line:"); inim;
01960	    display("Your line was:",im);
01970	END ELSE
01972	
01974	!-------------------------------------------------------------------;
01976	
01980	IF testexists("enterd") THEN
01990	BEGIN
02000	    EXTERNAL PROCEDURE enterdebug;
02010	    BOOLEAN con;
02020	    l:	prompt("Want to continue after enterdebug?/Yes/"); inim;
02030	    c:=im.Sub(1,1).Getchar;
02040	    IF c=Char(27) THEN GOTO out;
02050	    t:-Copy(im.Strip);
02060	    con:=t==NOTEXT OR c='y' OR c='Y';
02070	    enterdebug(con);
02080	    GOTO l;
02090	    out:
02100	END ELSE
     
02110	IF testexists("fetcha") THEN
02120	BEGIN
02130	    EXTERNAL CHARACTER PROCEDURE fetchar;
02140	    CHARACTER c;
02150	    TEXT t;
02160	    INTEGER i;
02170	    t:-Copy("ABCDEFGHIJKLMNOP");
02180	    FOR i:=-3 STEP 1 UNTIL 20 DO
02190	    BEGIN Outchar(fetchar(t,i)); Outchar(',');
02200	    END;
02210	END ELSE
02212	
02214	!-------------------------------------------------------------------;
02216	
02220	IF testexists("filena") THEN
02230	BEGIN
02240	    EXTERNAL TEXT PROCEDURE filename;
02250	    REF(Infile)inf; REF(Printfile)prf; REF(Outfile)ouf;
02260	    inf:-Sysin;
02270	    prf:-Sysout;
02280	    ouf:-NEW Outfile("TMP.TMP");
02290	    Outtext(filename(inf));
02300	    Outimage;
02310	    Outtext(filename(prf));
02320	    Outimage;
02330	    Outtext(filename(ouf));
02340	    Outimage;
02350	END ELSE
02360	
02362	
02364	!-------------------------------------------------------------------;
02366	
02370	IF testexists("finddi") THEN
02380	BEGIN
02390	    EXTERNAL REF(Directfile)PROCEDURE finddirectfile;
02400	    prompt("File spec:");	inim;
02410	    WHILE NOT (Endfile OR im.Strip==NOTEXT) DO
02420	    BEGIN
02430		t1:-Copy(im); !Save im;
02440		prompt("Access/U/:");
02450		inim; t:-im.Strip;
02460		c:='U'; IF t=/=NOTEXT THEN c:=t.Getchar;
02470		df:-finddirectfile(t1,c='U' OR c='u');
02480		b:=df=/=NONE;
02490		Outtext(IF b THEN "<FOUND>" ELSE "<NOT FOUND>");
02500		Outimage;
02510		prompt("File spec:"); inim;
02520	    END;
02530	    GOTO start;
02540	END ELSE
     
02550	IF testexists("findin") THEN
02560	BEGIN
02570	    EXTERNAL REF(Infile)PROCEDURE findinfile;
02580	    prompt("File spec:");	inim;
02590	    WHILE NOT (Endfile OR im.Strip==NOTEXT) DO
02600	    BEGIN
02610		inf:-findinfile(im);
02620		b:=inf=/=NONE;
02630		Outtext(IF b THEN "<FOUND>" ELSE "<NOT FOUND>");
02640		Outimage;
02650		prompt("File spec:"); inim;
02660	    END;
02670	    GOTO start;
02680	END ELSE
02682	
02684	!-------------------------------------------------------------------;
02686	
02690	IF testexists("findou") THEN
02700	BEGIN
02710	    EXTERNAL REF(Outfile)PROCEDURE findoutfile;
02720	    prompt("File spec:");	inim;
02730	    WHILE NOT (Endfile OR im.Strip==NOTEXT) DO
02740	    BEGIN
02750		ouf:-findoutfile(im);
02760		b:=ouf=/=NONE;
02770		Outtext(IF b THEN "<FOUND>" ELSE "<NOT FOUND>");
02780		Outimage;
02790		prompt("File spec:"); inim;
02800	    END;
02810	    GOTO start;
02820	END ELSE
02822	
02824	!-------------------------------------------------------------------;
02826	
02830	IF testexists("findpr") THEN
02840	BEGIN
02850	    EXTERNAL REF(Printfile)PROCEDURE findprintfile;
02860	    prompt("File spec:");	inim;
02870	    WHILE NOT (Endfile OR im.Strip==NOTEXT) DO
02880	    BEGIN
02890		prf:-findprintfile(im);
02900		b:=prf=/=NONE;
02910		Outtext(IF b THEN "<FOUND>" ELSE "<NOT FOUND>");
02920		Outimage;
02930		prompt("File spec:"); inim;
02940	    END;
02950	    GOTO start;
02960	END ELSE
     
02970	IF testexists("findtr") THEN
02980	BEGIN
02990	    EXTERNAL CHARACTER PROCEDURE findtrigger;
03000	    l0:	Outtext("Stop test by altmode"); Outimage;
03010	    prompt("master string:/AB....Z$#@/:"); inim;
03020	    t:-im.Strip;
03030	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
03040	    t:-Copy(IF t==NOTEXT THEN "ABCDEFGHIJKLMNOPQRSTUVWXYZ$#@" ELSE t);
03050	    display("t=",t);
03060	    l:	prompt("Start pos/1/:"); inim;
03070	    IF im.Strip == NOTEXT THEN i:=1 ELSE
03080	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
03090	    i:=im.Getint;
03100	    prompt("subtext length/rest of t/:"); inim;
03110	    IF im.Strip == NOTEXT THEN j:=t.Length-i+1 ELSE
03120	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
03130	    j:=im.Getint;
03140	    prompt("pos of subtext/1/:"); inim;
03150	    IF im.Strip == NOTEXT THEN m:=1 ELSE
03160	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
03170	    m:=im.Getint;
03180	    t1:-t.Sub(i,j);
03190	    display("master string",t1);
03200	    l1:	t1.Setpos(m);
03210	    prompt("triggers:"); inim;
03220	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l;
03230	    t2:-im.Strip;
03240	    c:=findtrigger(t1,t2);
03250	    Outtext("findtrigger value="); Outchar(c);
03260	    IF NOT t1.More THEN Outtext(" (not found)");
03270	    Outimage;
03280	    GOTO	l1;
03290	    out:
03300	END	ELSE
     
03310	IF testexists("freeze") THEN
03320	BEGIN EXTERNAL PROCEDURE freeze;
03330	    freeze(i);
03340	    Outtext("Return code:"); Outint(i,5); Outimage;
03350	END ELSE
03352	
03354	!-------------------------------------------------------------------;
03356	
03360	IF testexists("from  ") THEN
03370	BEGIN
03380	    EXTERNAL TEXT PROCEDURE from;
03390	    INTEGER i;
03400	    TEXT t;
03410	    t:-Copy("ABCDEFGHIJKL");
03420	    FOR i:=-3 STEP 1 UNTIL 20 DO
03430	    BEGIN
03440		Outtext(from(t,i)); Outimage;
03450	    END;
03460	END ELSE
03462	
03464	!-------------------------------------------------------------------;
03466	
03470	IF testexists("front ") THEN
03480	BEGIN
03490	    EXTERNAL TEXT PROCEDURE front;
03500	    TEXT t;
03510	    t:-Copy("ABCDEFGHIJKL");
03520	    WHILE t.More DO
03530	    BEGIN
03540		t.Getchar; Outtext(front(t)); Outimage;
03550	    END;
03560	END ELSE
     
03570	IF testexists("frontc") THEN
03580	BEGIN
03590	    EXTERNAL BOOLEAN PROCEDURE frontcompare;
03600	
03610	    Outtext("Input a string on each line - Stop test by altmode"); Outimage;
03620	
03630	    prompt("config:"); inim;
03640	    WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
03650	    BEGIN	
03660		t:- Copy(im.Strip);	
03670		IF t=/=NOTEXT THEN t2:-t;
03680		prompt("string:");  inim;
03690		t:-Copy(im.Strip);
03700		IF t=/=NOTEXT THEN t1:-t;
03710		prompt("string.Pos:"); inim;
03720		t:-frontstrip(im);
03730		IF t=/=NOTEXT THEN
03740		BEGIN
03750		    IF Digit(t.Getchar) THEN t1.Setpos(t.Getint);
03760		END;
03770		display("string.Rest=",rest(t1));
03780		Outimage;
03790		b:= frontcompare(t1,t2);	
03800		IF b THEN Outtext("<EQUAL>") ELSE Outtext("<UNEQUAL>");
03810		Outimage;
03820		prompt("config:"); inim;
03830	    END;
03840	    	
03850	END ELSE
     
03860	IF testexists("fronts") THEN
03870	BEGIN
03880	    TEXT t,t1,t2;
03890	    INTEGER i,j,k;
03900	
03910	    Outtext("Input a string on each line - Stop test by altmode"); Outimage;
03920	
03930	    Inimage;
03940	    WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
03950	    BEGIN	
03960		t1:- Copy(Sysin.Image.Strip);	
03970		display("t1=",t1);
03980		t:- frontstrip(t1);	
03990		display("frontstrip(t1)=",t);
04000		t2:- IF t1.Length>=8 THEN t1.Sub(3,6) ELSE NOTEXT;
04010		t:- frontstrip(t2);	
04020		display("t1.Sub(3,6)=",t2);
04030		display("frontstrip(t1.Sub(3,6))=",t);
04040		Outtext("Input a string on each line - Stop test by altmode"); Outimage;
04050		Inimage;
04060	    END;
04070	    	
04080	END ELSE
     
04090	IF testexists("getite") THEN
04100	BEGIN
04110	    EXTERNAL TEXT PROCEDURE getitem;
04120	    l0:	Outtext("Stop test by altmode"); Outimage;
04130	    prompt("text to analyze:"); inim;
04140	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
04150	    t:-Copy(im);
04160	    display("t=",t);
04170	    l:	prompt("Start pos/1/:"); inim;
04180	    IF im.Strip == NOTEXT THEN i:=1 ELSE
04190	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
04200	    i:=im.Getint;
04210	    prompt("subtext length/rest of t/:"); inim;
04220	    IF im.Strip == NOTEXT THEN j:=t.Length-i+1 ELSE
04230	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
04240	    j:=im.Getint;
04250	    prompt("pos of subtext/1/:"); inim;
04260	    IF im.Strip == NOTEXT THEN m:=1 ELSE
04270	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
04280	    m:=im.Getint;
04290	    t1:-t.Sub(i,j);
04300	    display("current text:",t1);
04310	    t1.Setpos(m);
04320	    Outtext("Items found"); Outimage;
04330	    t2:-getitem(t1);
04340	    WHILE t2=/=NOTEXT DO
04350	    BEGIN display("",t2); t2:-getitem(t1); END;
04360	    GOTO	l;
04370	    out:
04380	END	ELSE
     
04390	IF testexists("imax  ") THEN
04400	BEGIN
04410	    EXTERNAL INTEGER PROCEDURE imax;
04420	    INTEGER i1, i2;
04430	    i1:=1; i2:=2;
04440	    Outtext("imax(i1,i2)="); Outint(imax(i1,i2),5); Outimage;
04450	    Outtext("imax(i2,i1)="); Outint(imax(i2,i1),5); Outimage;
04460	END ELSE
04462	
04464	!-------------------------------------------------------------------;
04466	
04470	IF testexists("imin  ") THEN
04480	BEGIN
04490	    EXTERNAL INTEGER PROCEDURE imin;
04500	    INTEGER i1, i2;
04510	    i1:=1; i2:=2;
04520	    Outtext("imin(i1,i2)="); Outint(imin(i1,i2),5); Outimage;
04530	    Outtext("imin(i2,i1)="); Outint(imin(i2,i1),5); Outimage;
04540	END ELSE
04542	
04544	!-------------------------------------------------------------------;
04546	
04550	IF testexists("initem") THEN
04560	BEGIN
04570	    EXTERNAL TEXT PROCEDURE initem;
04580	    l0:	Outtext("Stop test by altmode"); Outimage;
04590	    l:	prompt("text to analyze:"); inim;
04600	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
04610	    Outtext("Items found"); Outimage;
04620	    t2:-initem(inf);
04630	    WHILE t2=/=NOTEXT DO
04640	    BEGIN display("",t2); t2:-initem(inf); END;
04650	    IF NOT inf.Endfile THEN GOTO l;
04660	    out:
04670	END	ELSE
04672	
04674	!-------------------------------------------------------------------;
04676	
04680	IF testexists("inord ") THEN
04690	BEGIN
04700	    EXTERNAL TEXT PROCEDURE inord;
04710	    l0:	Outtext("Stop test by altmode"); Outimage;
04720	    l:	prompt("text to analyze:"); inim;
04730	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
04740	    Outtext("Items found"); Outimage;
04750	    t2:-inord(inf);
04760	    WHILE t2=/=NOTEXT DO
04770	    BEGIN display("",t2); t2:-inord(inf); END;
04780	    IF NOT inf.Endfile THEN GOTO l;
04790	    out:
04800	END	ELSE
     
04810	IF testexists("input ") THEN
04820	BEGIN
04830	    ARRAY a[1:10], a1[1:2,3:4];
04840	    TEXT ARRAY ta[1:4];
04850	    prompt("Infile or Directfile (I or D)/I/:"); inim;
04860	    c1:=im.Getchar;
04870	    IF NOT (c1='d' OR c1='D') THEN
04880	    BEGIN
04890		INSPECT NEW Infile("output.tmp") DO
04900		BEGIN
04910		    Open(Blanks(80));
04920		    Sysout.Outimage;
04930		    inf1:-THIS Infile;
04940		    Inimage; ! To start a buffer;
04950		    FOR k:=1 STEP 1 UNTIL 8 DO
04960		    BEGIN
04970			l:=input(inf1,i,j,r,lr,c,t,t2,t3,t4,t5,t6);
04980			write(i,j,r,lr,c,t,t2,t3);
04990			Sysout.Outtext("words input:"); Sysout.Outint(l,8);
05000			Sysout.Outimage;
05010			Sysout.Outimage;
05020			l:=input(inf1,ta,a,a1,i,j);
05030			Sysout.Outtext("words input:"); Sysout.Outint(l,8);
05040			Sysout.Outimage;
05050			write("ta[1]=""",ta[1],""", ","a1[2,4]=""",a1[2,4],"""");
05060			Sysout.Outimage;
05070		    END;
05080		    Close;
05090	    END END ELSE
05100	    INSPECT NEW Directfile("putdf.tmp") DO
05110	    BEGIN
05120		Open(Blanks(80));
05130		write(i,j,r,lr,c,t2);
05140		Sysout.Outimage;
05150		df1:-THIS Directfile;
05160		FOR k:=1 STEP 1 UNTIL 8 DO
05170		BEGIN
05180		    l:=input(df1,i,j,r,lr,c,t2);
05190		    Sysout.Outtext("words input:"); Sysout.Outint(l,8);
05200		    Sysout.Outimage;
05210		    l:=input(df1,ta,a,a1,i,j);
05220		    Sysout.Outtext("words input:"); Sysout.Outint(l,8);
05230		    Sysout.Outimage;
05240		END;
05250		Close;
05260	    END;
05270	END ELSE
     
05280	IF testexists("inputc") THEN
05290	BEGIN
05300	    EXTERNAL BOOLEAN PROCEDURE inputcheck;
05310	    l:	prompt("Which TTY?/your own/:"); inim;
05320	    t:-Copy(im.Strip);
05330	    IF t==NOTEXT THEN
05340	    BEGIN inf1:-Sysin;
05350		ouf1:-Sysout;
05360	    END ELSE
05370	    IF im.Getchar=Char(27) THEN GOTO out ELSE
05380	    BEGIN
05390		inf1:-NEW Infile(t);
05400		ouf1:-NEW Outfile(t);
05410		inf1.Open(Blanks(80));
05420		ouf1.Open(Blanks(80));
05430	    END;
05440	    l1:	ouf1.Outtext("Expecting some input:"); ouf1.Breakoutimage;
05450	    IF inf1=/=Sysin THEN
05460	    BEGIN
05470		prompt("Give CR-LF when you want to go on"); inim;
05480	    END ELSE
05485	    BEGIN Outtext("Sleeping for 10 seconds: -"); Outimage;
05486		sleep(10.0);
05487	    END;
05490	    IF inputcheck(inf1) THEN
05500	    BEGIN inf1.Inimage;
05510		Outtext("Input from tty:"); Outtext(inf1.Image); Outimage;
05520	    END;
05530	    prompt("More from the same tty?/NO/"); inim;
05540	    c:=im.Getchar;
05550	    IF NOT (c=' ' OR c='N' OR c='n') THEN GOTO l1;
05560	    IF inf1=/=Sysin THEN
05570	    BEGIN
05580		inf1.Close; ouf1.Close;
05590	    END;
05600	    GOTO l;
05610	    out:
05620	END ELSE
     
05630	IF testexists("inputw") THEN
05640	BEGIN
05650	    EXTERNAL INTEGER PROCEDURE inputwait;
05660	    Simulation BEGIN   INTEGER nch;
05670		REAL maxtime;
05680		Outtext("Number of TTYs:");   Breakoutimage;
05690		nch:= Inint;
05700		prompt("Max wait time (secs)/10.000/"); inim;
05710		IF im.Strip=/=NOTEXT THEN maxtime:=Inreal ELSE maxtime:=10.000;
05720		BEGIN
05730		    INTEGER inch;
05740		    REF (Infile) ARRAY infiles[1:nch];
05750		    REF (tty) ARRAY ttys[-1:nch];
05760	
05770		    Process CLASS tty(filename);   VALUE filename;   TEXT filename;
05780		    BEGIN  REF (Infile) ttyin;    REF (Outfile) ttyout;
05790			INTEGER l;
05800			TEXT filespec;
05810			l:=filename.Length;
05820			filespec:-Blanks(2*l);
05830			filespec.Sub(1,l) := filespec.Sub(l+1,l) := filename;
05840	
05850			filespec.Sub(l*2,1).Putchar('i');
05860			ttyin :- NEW Infile(filespec);
05870			filespec.Sub(l*2,1).Putchar('o');
05880			ttyout :- NEW Outfile(filespec);
05890			INSPECT ttyin DO
05900			BEGIN   inch:= inch + 1;
05910			    IF inch > nch THEN Sqrt(-1);
05920			    infiles[inch]:- THIS Infile;
05930			    ttys[inch]:- THIS tty;
05940			    Open(Blanks(80));
05950	
05960			    INSPECT ttyout DO
05970			    BEGIN   Open(Blanks(80));
05980	
05990				WHILE NOT Endfile DO
06000				BEGIN Outtext("Input:"); Breakoutimage;
06010				    Passivate;   Inimage;
06020				    INSPECT Sysout DO
06030				    BEGIN
06040					Outtext(today); Outtext("  "); Outtext(daytime);
06050					Outtext(" Input received on ");
06060					Outtext(filename);   Outchar('"');
06070					Outtext(ttyin.Image.Strip);
06080					Outchar('"');   Outimage
06090				    END telling the master;
06100	
06110				END while loop;
06120	
06130				Close
06140			    END inspecting outfile;
06150	
06160			    Close
06170			END inspecting infile;
06180	
06190		    END of tty;
06200	
06210		    Process CLASS waiter;
06220		    BEGIN
06230			IF inch>0 THEN GO TO First;
06240			WHILE inch > 0 DO
06250			BEGIN
06260			    ACTIVATE ttys[inch];
06270			    First:
06280			    inch:= inputwait(infiles,maxtime);
06290			END loop;
06300			IF inch=0 THEN Outtext("** no input **")
06310			ELSE Outtext("** time exit **");
06320		    END waiter;
06330	
06340		    TEXT filename;
06350	
06360		    GO TO start;
06370		    WHILE filename =/= NOTEXT DO
06380		    BEGIN   ACTIVATE NEW tty(filename);
06390			start:
06400			Outtext("Device:");  Breakoutimage;
06410			Inimage; filename:- Sysin.Image.Strip;
06420		    END read loop;
06430		    ACTIVATE NEW waiter DELAY 0;
06440		    Hold(1000.0);
06450	
06460		END block 2;
06470	    END of program
06480	END ELSE
     
06490	IF testexists("lastlo") THEN
06500	BEGIN
06510	    EXTERNAL INTEGER PROCEDURE lastloc;
06520	    l:	prompt("File spec:/df.tmp/:"); inim;
06530	    IF im.Getchar=Char(27) THEN GO TO out;
06540	    df:-NEW Directfile(IF im.Strip==NOTEXT THEN "df.tmp" ELSE im.Strip);
06550	    df.Open(Blanks(20));
06560	    i:=lastloc(df);
06570	    Outtext("lastloc="); Outint(i,5); Outimage;
06580	    l1:	prompt("Add a record? Answer with Location"); inim;
06590	    IF im.Strip==NOTEXT THEN
06600	    BEGIN df.Close; GOTO l END;
06610	    j:=Inint;
06620	    IF j>0 THEN
06630	    BEGIN prompt("Contents:"); inim;
06640		df.Intext(20);
06650		df.Locate(j);
06660		df.Outimage;
06670	    END;
06680	    i:=lastloc(df);
06690	    Outtext("lastloc="); Outint(i,5); Outimage;
06700	    GOTO	l1;
06710	    out:
06720	END ELSE
     
06730	IF testexists("lineco") THEN
06740	BEGIN
06750	    EXTERNAL INTEGER PROCEDURE linecount;
06760	    REF(Printfile)p;
06770	    INTEGER normal_linecount;
06780	    p:-NEW Printfile("p.TMP");
06790	    p.Open(Blanks(80));
06800	    p.Linesperpage(100);
06810	    Outint(linecount(p),10);
06820	    normal_linecount:=linecount(Sysout);
06830	    Outint(normal_linecount,10);
06840	    Linesperpage(10);
06850	    Outint(linecount(Sysout),10);
06860	    Outint(linecount(Sysout),10);
06870	    Linesperpage(normal_linecount);
06880	    Outint(linecount(NONE),10);
06885	    p.Close;
06890	END ELSE
06892	
06894	!-------------------------------------------------------------------;
06896	
06900	IF testexists("litenb") THEN
06910	BEGIN
06920	    EXTERNAL TEXT PROCEDURE litenbokstav;
06930	    INTEGER i;
06940	    TEXT t;
06950	    Outtext("Input one string per image, stop by altmode:"); Outimage;
06960	    Inimage;
06970	    WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
06980	    BEGIN	t:-Sysin.Image.Strip;
06990		Outtext("litenbokstav=""");
07000		Outtext(litenbokstav(t));
07010		Outchar('"'); Outimage;
07020		Inimage;
07030	    END;
07040	END ELSE
     
07050	IF testexists("lookah") THEN
07060	BEGIN
07070	    EXTERNAL CHARACTER PROCEDURE lookahead;
07080	    prompt("Infile or Directfile('i' or 'd':)"); inim;
07090	    c:=im.Getchar;
07100	    b:=c='d' OR c='D';
07110	    prompt("file spec:"); inim;
07120	    t2:-im.Strip;
07130	    inf:-Sysin;
07140	    IF b THEN
07150	    BEGIN
07160		df:-NEW Directfile(IF t2==NOTEXT THEN "X.TMP/ACCESS:RONLY" ELSE t2);
07170		df.Open(Blanks(80));
07180	    END ELSE
07190	    BEGIN
07200		IF t2=/=NOTEXT THEN
07210		BEGIN inf:-NEW Infile(t2); inf.Open(Blanks(80));
07220		END ELSE IF inf==NONE THEN
07230		inf:-Sysin;
07240	    END;
07250	    IF b THEN
07260	    BEGIN
07270		INSPECT df DO
07280		BEGIN Inimage;
07290		    WHILE NOT Endfile DO
07300		    BEGIN
07310			c:=lookahead(df); c1:=Inchar;
07320			IF c NE c1 AND c NE ' ' THEN
07330			BEGIN display("Error in image:",Image);
07340			    Sqrt(-1);!!!!;
07350			    GOTO fin
07360	    END END END END ELSE
07370	    BEGIN
07380		INSPECT inf DO
07390		BEGIN Inimage;
07400		    WHILE NOT Endfile DO
07410		    BEGIN
07420			c:=lookahead(inf); c1:=Inchar;
07430			IF c NE c1 AND c NE ' ' THEN
07440			BEGIN display("Error in image:",Image);
07450			    Sqrt(-1);!!!!;
07460			    GOTO fin
07470	    END END END END;
07480	    fin:
07490	END ELSE
     
07500	IF testexists("makete") THEN
07510	BEGIN
07520	    EXTERNAL TEXT PROCEDURE maketext;
07530	    CHARACTER c;
07540	    TEXT t;
07550	    INTEGER i;
07560	    FOR i:=-3 STEP 1 UNTIL 12 DO
07570	    BEGIN t:-maketext(Char(Rank('A')-1+i),i);
07580		Outtext(t); Outimage;
07590	    END;
07600	END ELSE
07602	
07604	!-------------------------------------------------------------------;
07606	
07610	IF testexists("max???") THEN GOTO date_time_max_etc ELSE
07612	
07614	!-------------------------------------------------------------------;
07616	
07620	IF testexists("number") THEN
07630	BEGIN
07640	    EXTERNAL BOOLEAN PROCEDURE numbered;
07650	    INSPECT NEW Infile("input") DO
07660	    BEGIN
07670		Open(Blanks(80));
07680		Inimage;
07690		WHILE NOT Endfile DO
07700		BEGIN
07710		    IF numbered THEN Outtext("*** ");
07720		    Outtext(Image); Outimage;
07730		    Inimage
07740		END;
07750		Close
07760	    END;
07770	END ELSE
     
07780	IF testexists("outchr") THEN
07790	BEGIN
07800	    EXTERNAL PROCEDURE outchr;
07810	    l:	t:-inline("output file:",Sysin);
07820	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
07830	    IF t==NOTEXT THEN ouf1:-Sysout ELSE
07840	    BEGIN
07850		ouf1:-NEW Outfile(t);
07860		ouf1.Open(Blanks(20));
07870		ouf1.Outimage;
07880	    END;
07890	    l1:	t1:-inline("Chars to be copied:",Sysin);
07900	    c:=IF t1=/=NOTEXT THEN t1.Sub(1,1).Getchar ELSE Char(0);
07910	    IF c=Char(27) THEN GOTO l;
07920	    l2:	t2:-inline("Repeat count:/1/:",Sysin);
07930	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l1;
07940	    i:=1; IF t2=/=NOTEXT THEN i:=im.Getint;
07950	    WHILE t1.More DO
07960	    BEGIN
07970		c:=t1.Getchar;
07980		IF Digit(c) THEN
07990		BEGIN
08000		    t1.Setpos(t1.Pos-1);
08010		    c:=Char(scanint(t1));
08020		END;
08030		outchr(ouf1,c,i);
08040	    END;
08050	    GOTO	l2;
08060	    out:
08070	END ELSE
     
08080	IF testexists("output") THEN
08090	BEGIN
08100	    TEXT PROCEDURE tx; tx:-Copy(" tx ");
08110	    ARRAY a[1:10], a1[1:2,3:4];
08120	    TEXT ARRAY ta[1:4];
08130	    FOR i:=1 STEP 1 UNTIL 4 DO
08140	    BEGIN
08150		t:-Blanks(i);
08160		FOR j:=1 STEP 1 UNTIL i DO t.Putchar(Char(i-1+Rank('A')));
08170		ta[i]:-Copy(t);
08180	    END;
08190	    FOR i:=1 STEP 1 UNTIL 10 DO a[i]:=i*i;
08200	    FOR i:=1,2 DO FOR j:=3,4 DO a1[i,j]:=i*10+j;
08210	    r:=4004; lr:=r/345; c:='C';
08220	    prompt("Outfile or Directfile (O or D)/O/:"); inim;
08230	    c1:=im.Getchar;
08240	    IF NOT (c1='d' OR c1='D') THEN
08250	    BEGIN
08260		INSPECT NEW Outfile("output.tmp") DO
08270		BEGIN
08280		    Open(Blanks(80));
08290		    t4:-Copy("ABCDEFGHIJKLMNOPQPRSTUVWXYZ1234567890abcdefghijklmnopqrst");
08300		    write(i,j,r,lr,c,"TEXT");
08310		    Sysout.Outimage;
08320		    ouf1:-THIS Outfile;
08330		    Outimage; ! To start a buffer;
08340		    FOR i:=1 STEP 1 UNTIL 8 DO
08350		    BEGIN
08360			t5:-t4.Sub(3,7); t6:-t4.Sub(13,10);
08370			l:=putsize(i,j,r,lr,c,"TEXT",tx,t4.Sub(10,23),t4,t5,t6);
08380			Sysout.Outtext("words output according to putsize:"); Sysout.Outint(l,8);
08390			Sysout.Outimage;
08400			l:=output(ouf1,i,j,r,lr,c,"TEXT",tx,t4.Sub(10,23),t4,t5,t6);
08410			Sysout.Outimage;
08420			Sysout.Outtext("words output:"); Sysout.Outint(l,8);
08430			Sysout.Outimage;
08440			l:=output(ouf1,ta,a,a1,i,j);
08450			Sysout.Outtext("words output:"); Sysout.Outint(l,8);
08460			Sysout.Outimage;
08470		    END;
08480		    Close;
08490	    END END ELSE
08500	    INSPECT NEW Directfile("putdf.tmp") DO
08510	    BEGIN
08520		Open(Blanks(80));
08530		write(i,j,r,lr,c,"TEXT");
08540		Sysout.Outimage;
08550		df1:-THIS Directfile;
08560		FOR k:=1 STEP 1 UNTIL 8 DO
08570		BEGIN
08580		    l:=output(df1,i,j,r,lr,c,"TEXT");
08590		    Sysout.Outimage;
08600		    Sysout.Outtext("words output:"); Sysout.Outint(l,8);
08610		    Sysout.Outimage;
08620		    l:=output(df1,ta,a,a1,i,j);
08630		    Sysout.Outtext("words output:"); Sysout.Outint(l,8);
08640		    Sysout.Outimage;
08650		END;
08660		Close;
08670	    END;
08680	END ELSE
     
08690	IF testexists("puttex") THEN
08700	BEGIN
08710	    EXTERNAL BOOLEAN PROCEDURE puttext;
08720	    TEXT t,t1,t2;
08730	    INTEGER i; BOOLEAN b;
08740	
08750	    t2:- Copy("ABCDEFGHIJKLMNOPQRSTUVWXYZ");
08760	    t1:- Copy("12345678");
08770	
08780	    FOR i:=1 STEP 4 UNTIL 40 DO
08790	    BEGIN b:=puttext(t2,t1.Sub(2,6));
08800		Outtext(IF b THEN "TRUE " ELSE "FALSE ");
08810		Outtext(t2); Outimage;
08820	    END;
08830	END ELSE
08832	
08834	!-------------------------------------------------------------------;
08836	
08840	IF testexists("read") THEN GOTO write_test ELSE
     
08850	IF testexists("refio ") THEN
08860	BEGIN
08870	    INTEGER count;	! Keeps track of a objects;
08880	    CLASS a(ia,ca,iaa,ta,taa);
08890	    INTEGER ia; CHARACTER ca;
08900	    INTEGER ARRAY iaa; TEXT ta; TEXT ARRAY taa;
08910	    BEGIN
08920		INTEGER a_number;
08930		REAL x; REF(a)ra; REF(a) ARRAY raa[1:5];
08940		count:=count+1;	!Object ordinal number;
08950		IF count<10 THEN
08960		BEGIN INTEGER i;
08970		    count:=count+1;
08980		    a_number:=count;
08990		    x:=count;
09000		    ra:-THIS a;
09010		    FOR i:=1 STEP 1 UNTIL 5 DO
09020		    raa[i]:-NEW a(i,Char(Mod(Rank(ca)+1,127)),iaa,ta,taa);
09030		END;
09040	    END a;
09050	    REF(a)xa;
09060	    REF(a)ARRAY xra[1:3];
09070	    TEXT t;
09080	    TEXT ARRAY xta[1:2];
09090	    INTEGER ARRAY xia[1:2,3:4];
09100	    prompt("output or input/input/:"); inim;
09110	    testchar:=im.Getchar;
09120	    IF testchar='O' OR testchar='o' THEN
09130	    BEGIN
09140		ouf1:-NEW Outfile("putref.tmp");
09150		ouf1.Open(Blanks(80));
09160		FOR i:=1,2 DO xta[i]:-Copy("ABCDEFGHIJK").Sub(i,2);
09170		t:-Copy("12345676890");
09180		FOR i:=1,2 DO FOR j:=3,4 DO xia[i,j]:=i*10+j;
09190		FOR i:=1 STEP 1 UNTIL 3 DO
09200		xra[i]:-NEW a(i,Char(i+Rank('A')-1),xia,t,xta);
09210		FOR i:=1,2,3 DO
09220		BEGIN
09230		    xa:-xra[i];
09240		    l:=putsize(xa);
09250		    Sysout.Outtext("putsize="); Sysout.Outint(l,5); Sysout.Outimage;
09260		    l:=output(ouf1,xa);
09270		    Sysout.Outtext("output="); Sysout.Outint(l,5); Sysout.Outimage;
09280		END;
09290		ouf1.Close; ouf1:-NONE;
09300	    END	ELSE
09310	    BEGIN
09320		inf1:-NEW Infile("putref.tmp");
09330		inf1.Open(Blanks(80));
09340		FOR i:=1,2 DO xta[i]:-Copy("ABCDEFGHIJK").Sub(i,2);
09350		t:-Copy("12345676890");
09360		FOR i:=1,2 DO FOR j:=3,4 DO xia[i,j]:=i*10+j;
09370		FOR i:=1 STEP 1 UNTIL 3 DO
09380		xra[i]:-NEW a(-i,' ',xia,t,xta);
09390		FOR i:=1,2,3 DO
09400		BEGIN
09410		    xa:-xra[i];
09420		    input(inf1,xa);
09430		END;
09440		inf1.Close; inf1:-NONE;
09450	    END;
09460	END	ELSE
     
09470	IF testexists("restor") THEN
09480	BEGIN EXTERNAL PROCEDURE restore;
09490	    l:	prompt("Program name:/x/:"); inim;
09500	    t:-im.Strip;
09510	    IF t==NOTEXT THEN t:-Copy("x") ELSE t:-Copy(t);
09520	    IF t.Getchar=Char(27) THEN GOTO out;
09530	    restore(t);
09540	    GOTO l;
09550	    out:
09560	END ELSE
09562	
09564	!-------------------------------------------------------------------;
09566	
09570	IF testexists("run   ") THEN
09580	BEGIN EXTERNAL PROCEDURE run;
09590	    l:	prompt("Program name:/x/:"); inim;
09600	    t:-im.Strip;
09610	    IF t==NOTEXT THEN t:-Copy("x") ELSE t:-Copy(t);
09620	    IF t.Getchar=Char(27) THEN GOTO out;
09630	    l1:	prompt("Entry point number/1/:"); inim;
09640	    c:=im.Getchar;
09650	    IF c=Char(27) THEN GOTO l;
09660	    i:=1; IF im.Strip=/=NOTEXT THEN i:=Inint;
09670	    run(t,i);
09680	    GOTO l1;
09690	    out:
09700	END ELSE
09702	
09704	!-------------------------------------------------------------------;
09706	
09710	IF testexists("save  ") THEN
09720	BEGIN EXTERNAL INTEGER PROCEDURE save;
09730	    l:	prompt("save file name:/x.sav/:"); inim;
09740	    t:-im.Strip;
09750	    IF t==NOTEXT THEN t:-Copy("x.sav") ELSE t:-Copy(t);
09760	    IF t.Getchar=Char(27) THEN GOTO out;
09770	    l1:	prompt("Continue on error?/Yes/:"); inim;
09780	    c:=im.Getchar;
09790	    IF c=Char(27) THEN GOTO l;
09800	    b:=c=' ' OR c='Y' OR c='y';
09810	    i:=save(t,b); Outtext("Result="); Outint(i,3); Outimage;
09820	    GOTO l1;
09830	    out:
09840	END ELSE
     
09850	IF testexists("scanto") THEN
09860	BEGIN
09870	    EXTERNAL TEXT PROCEDURE scanto;
09880	    l0:	Outtext("Stop test by altmode"); Outimage;
09890	    prompt("master string:/AB....Z$#@/:"); inim;
09900	    t:-im.Strip;
09910	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
09920	    t:-Copy(IF t==NOTEXT THEN "ABCDEFGHIJKLMNOPQRSTUVWXYZ$#@" ELSE t);
09930	    display("t=",t);
09940	    l:	prompt("Start pos/1/:"); inim;
09950	    IF im.Strip == NOTEXT THEN i:=1 ELSE
09960	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
09970	    i:=im.Getint;
09980	    prompt("subtext length/rest of t/:"); inim;
09990	    IF im.Strip == NOTEXT THEN j:=t.Length-i+1 ELSE
10000	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
10010	    j:=im.Getint;
10020	    prompt("pos of subtext/1/:"); inim;
10030	    IF im.Strip == NOTEXT THEN m:=1 ELSE
10040	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
10050	    m:=im.Getint;
10060	    t1:-t.Sub(i,j);
10070	    display("master string",t1);
10080	    l1:	t1.Setpos(m);
10090	    prompt("character:/ /:"); inim;
10100	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l;
10110	    c:=im.Getchar;
10120	    t3:-scanto(t1,c);
10130	    display("scanto value=",t3);
10140	    k:=t1.Pos-1;
10150	    IF NOT t1.More THEN
10160	    BEGIN Outtext(" (not found)");
10170		Outimage;
10180	    END ELSE
10190	    BEGIN c1:=t1.Sub(k,1).Getchar;
10200		IF c1 NE c THEN
10210		BEGIN
10220		    display("found character:",t1.Sub(k,1));
10230		    Outtext("ERROR."); Outimage;
10240		END;
10250	    END;
10260	    GOTO	l1;
10270	    out:
10280	END	ELSE
     
10290	IF testexists("scan??") THEN
10300	scan_number:
10310	BEGIN
10320	    SWITCH sw:=l1,l2,l3,l4,l5,l6;
10330	    EXTERNAL INTEGER PROCEDURE checkint,checkreal,checkfrac;
10340	    EXTERNAL INTEGER PROCEDURE scanfrac;
10350	    EXTERNAL LONG REAL PROCEDURE scanreal;
10360	    TEXT t,t1;
10370	    INTEGER i,j;
10380	    l: Outtext("which procedure? 1-checkint,2-checkreal,3-scanint,4-scanreal,");
10390	    Outimage; Outtext("5-checkfrac,6-scanfrac:");
10400	    Breakoutimage; Inimage; i:=Inint;
10410	    Outtext("input string:"); Breakoutimage; Inimage;
10420	    t:-Copy(Sysin.Image);
10430	    Outtext(" Pos:/1/:"); Breakoutimage; Inimage;
10440	    IF Sysin.Image.Strip=/=NOTEXT THEN t.Setpos(Inint);
10450	    GOTO sw[i];
10460	    GOTO out;
10470	    l1: Outint(checkint(t),3); Outint(t.Pos,4); Outimage; GOTO l;
10480	    l2: Outint(checkreal(t),3); Outint(t.Pos,4); Outimage; GOTO l;
10490	    l3: Outint(scanint(t),15); Outint(t.Pos,4); Outimage; GOTO l;
10500	    l4: Outreal(scanreal(t),10,20); Outint(t.Pos,4); Outimage; GOTO l;
10510	    l5: Outint(checkfrac(t),3); Outint(t.Pos,4); Outimage; GOTO l;
10520	    l6: Outint(scanfrac(t),15); Outint(t.Pos,4); Outimage; GOTO l;
10530	    out:
10540	END ELSE
10550	
10552	
10554	!-------------------------------------------------------------------;
10556	
10560	IF testexists("scratc") THEN
10570	BEGIN
10580	    EXTERNAL BOOLEAN PROCEDURE scratchfile;
10590	    prompt("File spec:");	inim;
10600	    WHILE NOT (Endfile OR im.Strip==NOTEXT) DO
10610	    BEGIN
10620		b:=scratchfile(im);
10630		Outtext(IF b THEN "<DONE>" ELSE "<NOT DONE>");
10640		Outimage;
10650		prompt("File spec:"); inim;
10660	    END;
10670	    GOTO start;
10680	END ELSE
     
10690	IF testexists("search") THEN
10700	BEGIN
10710	    EXTERNAL INTEGER PROCEDURE search;
10720	    l0:	Outtext("Stop test by altmode"); Outimage;
10730	    prompt("master string:/AB....Z$#@/:"); inim;
10740	    t:-im.Strip;
10750	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
10760	    t:-Copy(IF t==NOTEXT THEN "ABCDEFGHIJKLMNOPQRSTUVWXYZ$#@" ELSE t);
10770	    display("t=",t);
10780	    l:	prompt("Start pos/1/:"); inim;
10790	    IF im.Strip == NOTEXT THEN i:=1 ELSE
10800	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
10810	    i:=im.Getint;
10820	    prompt("subtext length/rest of t/:"); inim;
10830	    IF im.Strip == NOTEXT THEN j:=t.Length-i+1 ELSE
10840	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
10850	    j:=im.Getint;
10860	    prompt("pos of subtext/1/:"); inim;
10870	    IF im.Strip == NOTEXT THEN m:=1 ELSE
10880	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
10890	    m:=im.Getint;
10900	    t1:-t.Sub(i,j);
10910	    display("master string",t1);
10920	    l1:	t1.Setpos(m);
10930	    prompt("pattern:"); inim;
10940	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l;
10950	    t2:-Copy(im.Strip);
10960	    prompt("Subtext pos of pattern:/1/:"); inim;
10970	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l1;
10980	    IF im.Strip=/=NOTEXT THEN
10990	    BEGIN   k:=im.Getint;
11000		IF k>0 AND k<=t2.Length
11010		THEN t2:-t2.Sub(k,t2.Length-k+1)
11020		ELSE t2:-NOTEXT;
11030		display("pattern used:",t2);
11040	    END;
11050	    k:=search(t1,t2);
11060	    Outtext("search value="); Outint(k,4);
11070	    IF k>t1.Length THEN Outtext(" (not found)");
11080	    Outimage;
11090	    IF k<=t1.Length THEN
11100	    BEGIN t3:-t1.Sub(k,t2.Length);
11110		IF t3 NE t2 THEN
11120		BEGIN
11130		    display("found subtext:",t3);
11140		    Outtext("ERROR."); Outimage;
11150		END;
11160	    END;
11170	    GOTO	l1;
11180	    out:
11190	END	ELSE
     
11200	IF testexists("skip  ") THEN
11210	BEGIN
11220	    EXTERNAL TEXT PROCEDURE skip;
11230	
11240	    l:	prompt("input text t:"); inim;
11250	    t:-im.Strip;
11260	    IF t==NOTEXT THEN GO TO out ELSE t:-Copy(t);
11270	    prompt("Char to skip:/(blank)/:"); inim;
11280	    c:=im.Getchar;
11290	    l1:	prompt("t.Setpos(i), give i:/1/:"); inim;
11300	    t1:-im.Strip;
11310	    IF t1=/=NOTEXT THEN i:=t1.Getint ELSE i:=1;
11320	    IF i=0 THEN GOTO l;
11330	    t.Setpos(i);
11340	    display("skip(t,c)=",skip(t,c));
11350	    GO TO l1;
11360	    out:
11370	END ELSE
     
11380	IF testexists("sleep ") THEN
11390	BEGIN
11400	!   EXTERNAL PROCEDURE sleep;
11410	    REAL x;
11420	    l:	prompt("Sleep interval (seconds):"); inim;
11430	    IF im.Strip==NOTEXT THEN GOTO out ELSE x:=im.Getreal;
11440	    sleep(x);
11450	    GOTO	l;
11460	    out:
11470	END ELSE
11472	
11474	!-------------------------------------------------------------------;
11476	
11480	IF testexists("storbo") THEN
11490	BEGIN
11500	    EXTERNAL TEXT PROCEDURE storbokstav;
11510	    INTEGER i;
11520	    TEXT t;
11530	    Outtext("Input one string per image, stop by altmode:"); Outimage;
11540	    Inimage;
11550	    WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
11560	    BEGIN	t:-Sysin.Image.Strip;
11570		Outtext("storbokstav=""");
11580		Outtext(storbokstav(t));
11590		Outchar('"'); Outimage;
11600		Inimage;
11610	    END;
11620	END ELSE
     
11630	IF testexists("tagord") THEN
11640	BEGIN
11650	    EXTERNAL TEXT PROCEDURE tagord;
11660	    l0:	Outtext("Stop test by altmode"); Outimage;
11670	    prompt("text to analyze:"); inim;
11680	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
11690	    t:-Copy(im);
11700	    display("t=",t);
11710	    l:	prompt("Start pos/1/:"); inim;
11720	    IF im.Strip == NOTEXT THEN i:=1 ELSE
11730	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
11740	    i:=im.Getint;
11750	    prompt("subtext length/rest of t/:"); inim;
11760	    IF im.Strip == NOTEXT THEN j:=t.Length-i+1 ELSE
11770	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
11780	    j:=im.Getint;
11790	    prompt("pos of subtext/1/:"); inim;
11800	    IF im.Strip == NOTEXT THEN m:=1 ELSE
11810	    IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
11820	    m:=im.Getint;
11830	    t1:-t.Sub(i,j);
11840	    display("current text:",t1);
11850	    t1.Setpos(m);
11860	    Outtext("Items found"); Outimage;
11870	    t2:-tagord(t1);
11880	    WHILE t2=/=NOTEXT DO
11890	    BEGIN display("",t2); t2:-tagord(t1); END;
11900	    GOTO	l;
11910	    out:
11920	END	ELSE
11922	
11924	!-------------------------------------------------------------------;
11926	
11930	IF testexists("time  ") THEN
11940	date_time_maxint_etc:
11950	BEGIN
11960	    EXTERNAL REAL PROCEDURE maxreal;
11970	    EXTERNAL INTEGER PROCEDURE maxint;
11980	    Outtext(today); Outchar(' '); Outtext(daytime); Outimage;
11990	    Outtext("cptime:"); Outfix(cptime,3,15);
12000	    Outtext("  clocktime:"); Outfix(clocktime,3,15);
12010	    Outimage;
12020	    Outtext("maxreal:"); Outreal(maxreal,19,25);
12030	    Outtext(" maxint:"); Outint(maxint,15);
12040	    Outimage;
12050	END ELSE
12060	
     
12070	IF testexists("tmpin ") THEN
12080	BEGIN
12090	    EXTERNAL TEXT PROCEDURE tmpin;
12100	    L: t:-inline("tmp name:/tmp/:",Sysin);
12110	    IF im.Sub(1,1).Getchar=Char(27) THEN GO TO out;
12120	    IF t==NOTEXT THEN t:-Copy("TMP");
12130	    t2:-inline("Delete?/no/:",Sysin);
12140	    IF t2==NOTEXT THEN b1:=FALSE ELSE
12150	    BEGIN c:=im.Sub(1,1).Getchar; b1:=c='y' OR c='Y'
12160	    END;
12170	    t1:-tmpin(t,b1);
12180	    Outtext("TMPCOR file length, contents:"); Outint(t1.Length,4); Outimage;
12190	    t2:-Image; Image:-t1; Outimage; Image:-t2;
12200	    GO TO L;
12210	out:
12220	END ELSE
12222	
12224	!-------------------------------------------------------------------;
12226	
12230	IF testexists("tmpnam") THEN
12240	BEGIN
12250	    EXTERNAL TEXT PROCEDURE tmpnam;
12260	
12270	    l:	prompt("Progid:"); inim;
12280	    t:-im.Strip;
12290	    IF im.Getchar=Char(27) THEN GOTO out;
12300	    display("tmpnam(progid)=",tmpnam(t));
12310	    GO TO l;
12320	    out:
12330	END ELSE
12332	
12334	!-------------------------------------------------------------------;
12336	
12340	IF testexists("tmpout") THEN
12350	BEGIN
12360	    EXTERNAL BOOLEAN PROCEDURE tmpout;
12370	    L: t:-inline("tmp name:/tmp/:",Sysin);
12380	    IF im.Sub(1,1).Getchar=Char(27) THEN GO TO out;
12390	    IF t==NOTEXT THEN t:-Copy("TMP");
12400	    t1:-inline("Contents of TMPCOR file:",Sysin);
12410	    IF im.Sub(1,1).Getchar=Char(27) THEN GO TO L;
12420	    t3:-Blanks(2); t3.Putchar(Char(13)); t3.Putchar(Char(10)); !CR-LF;
12430	    t2:-conc(t1,t3);
12440	    WHILE t1=/=NOTEXT DO
12450	    BEGIN
12460		t1:-inline("next line or CR",Sysin);
12470		t2:-conc(t2,t1,t3);
12480	    END;
12490	    IF tmpout(t,t2) THEN Outtext("Ok?") ELSE Outtext("Error");
12500	    GO TO L;
12510	out:
12520	END ELSE
     
12530	IF testexists("trmop ") THEN
12540	BEGIN	!test trmop functions;
12550	    EXTERNAL INTEGER PROCEDURE trmop;
12560	
12570	    INTEGER PROCEDURE inoct;
12580	    BEGIN INTEGER i; CHARACTER c;
12590		Lastitem;
12600		WHILE Sysin.Image.More DO
12610		BEGIN c:=Inchar;
12620		    IF Digit(c) THEN i:=i*8+Rank(c)-Rank('0') ELSE GOTO exit;
12630		END;
12640		exit: inoct := i
12650	
12660	    END inoct;
12670	
12680	    INTEGER function,val;
12690	    Outtext("Stop test by altmode"); Outimage;
12700	    WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
12710	    BEGIN
12720		Outtext("give function: "); Breakoutimage;
12730		function:=inoct;
12740		IF function//8r1000 NE 1 THEN
12750		BEGIN Outtext(" value: "); Breakoutimage;
12760		    val:=inoct;
12770		END;
12780		Outtext("result: "); Outint(trmop(function,Sysout,val),15);
12790		Outimage;
12800		Inimage;
12810	    END sysin input loop;
12820	END  ELSE
     
12830	IF testexists("tsub  ") THEN
12840	BEGIN
12850	    EXTERNAL TEXT PROCEDURE tsub;
12860	    INTEGER i;
12870	    TEXT t;
12880	    t:-Copy("ABCDEFGHIJKL");
12890	    FOR j:=-1 STEP 4 UNTIL 20 DO
12900	    FOR i:=-3 STEP 4 UNTIL 20 DO
12910	    BEGIN
12920		Outtext("tsub(t,"); Outint(i,3); Outchar(','); Outint(j,3);
12930		Outtext(")="""); Outtext(tsub(t,i,j)); Outchar('"');
12940		Outimage;
12950	    END;
12960	END ELSE
12962	
12964	!-------------------------------------------------------------------;
12966	
12970	IF testexists("upcase") THEN
12980	BEGIN
12990	!   EXTERNAL TEXT PROCEDURE upcase;
13000	    INTEGER i;
13010	    TEXT t;
13020	    Outtext("Input one string per image, stop by altmode:"); Outimage;
13030	    Inimage;
13040	    WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
13050	    BEGIN	t:-Sysin.Image.Strip;
13060		Outtext("upcase="""); Outtext(upcase(t)); Outchar('"'); Outimage;
13070		Inimage;
13080	    END;
13090	END ELSE
     
13100	IF testexists("upcomp") THEN
13110	BEGIN
13120	    EXTERNAL BOOLEAN PROCEDURE upcompare;
13130	
13140	    Outtext("Input a master string on each line - Stop test by altmode");
13150	    Outimage;
13160	
13170	    prompt("test string:"); inim;
13180	    WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
13190	    BEGIN	
13200		t:- Copy(im.Strip);	
13210		IF t=/=NOTEXT THEN t2:-t;
13220		prompt("master:");  inim;
13230		t:-Copy(im.Strip);
13240		IF t=/=NOTEXT THEN t1:-t;
13250		prompt("master.Pos:"); inim;
13260		t:-frontstrip(im);
13270		IF t=/=NOTEXT THEN
13280		BEGIN
13290		    IF Digit(t.Getchar) THEN t1.Setpos(t.Getint);
13300		END;
13310		display("rest(master)=",rest(t1));
13320		Outimage;
13330		b:= upcompare(t1,t2);	
13340		IF b THEN Outtext("<EQUAL>") ELSE Outtext("<UNEQUAL>");
13350		Outimage;
13360		prompt("test string:"); inim;
13370	    END;
13380	    	
13390	END ELSE
13392	
13394	!-------------------------------------------------------------------;
13396	
13400	IF testexists("upto  ") THEN
13410	BEGIN
13420	    EXTERNAL TEXT PROCEDURE upto;
13430	    INTEGER i;
13440	    TEXT t;
13450	    t:-Copy("ABCDEFGHIJKL");
13460	    FOR i:=-3 STEP 1 UNTIL 20 DO
13470	    BEGIN
13480		Outtext(upto(t,i)); Outimage;
13490	    END;
13500	END ELSE
     
13510	OPTIONS(/-W);
13520	IF testexists("write") THEN
13530	write_test: BEGIN
13540	    REAL x,y;
13550	    REAL ARRAY a[1:5],a1[1:2,1:2];
13560	    CHARACTER ARRAY ca[1:3];
13570	    INTEGER ARRAY ia[1:2];
13580	    LONG REAL ARRAY la[1:2];
13590	    TEXT ARRAY ta[1:4];
13600	
13610	    FOR i:=1,2 DO FOR j:=1,2 DO
13620	    BEGIN
13630		a[i+2*(j-1)]:=10^(i+10*j);
13640		a1[i,j]:=i+10^(-j);
13650		t:-ta[i+2*(j-1)]:-Blanks(30);
13660		FOR k:=i STEP 1 UNTIL 30+i-1 DO t.Putchar(Char(i+Rank('A')-1));
13670	    END;
13680	    write("a=",a);
13690	    write("a1=",a1);
13700	    write("ta=",ta);
13710	    l:	prompt("Type of data? (c,i,l,r),followed by a for arrays:/r/:"); inim;
13720	    c:=im.Getchar;
13730	    c2:=im.Getchar;
13740	    IF c=Char(27) THEN GO TO out;
13750	    l1:	prompt("Input an item:"); inim;
13760	    IF im.Strip==NOTEXT THEN GOTO l;
13770	    IF c='c' THEN
13780	    BEGIN
13790		IF c2='a' THEN
13800		BEGIN
13810		    read(ca);
13820		    write(ca);
13830		END ELSE
13840		BEGIN
13850		    read(c1);
13860		    write(c1)
13870		END;
13880	    END ELSE
13890	    IF c='t' THEN
13900	    BEGIN
13910		t1:-Intext(80);
13920		write(t1)
13930	    END ELSE
13940	    IF c='l' THEN
13950	    BEGIN
13960		IF c2='a' THEN
13970		BEGIN
13980		    read(la);
13990		    write(la);
14000		END ELSE
14010		BEGIN
14020		    read(lr1);
14030		    write(lr1)
14040		END;
14050	    END ELSE
14060	    IF c='i' THEN
14070	    BEGIN
14080		IF c2='a' THEN
14090		BEGIN
14100		    read(ia);
14110		    write(ia);
14120		END ELSE
14130		BEGIN
14140		    read(i);
14150		    write(i)
14160		END;
14170	    END ELSE
14180	    BEGIN
14190		IF c2='a' THEN
14200		BEGIN
14210		    read(a);
14220		    write(a);
14230		END ELSE
14240		BEGIN
14250		    read(x);
14260		    write(x)
14270		END;
14280	    END;
14290	    GOTO l1;
14300	    out:
14310	END ELSE
     
14315	!End of test program;
14317	
14320	BEGIN
14330	    IF p.Strip=/=NOTEXT THEN
14340	    BEGIN IF testchar NE '?' THEN
14350		BEGIN Outtext("No test for "); Outtext(p); Outimage;
14360		    Outtext("? for help"); Outimage;
14370	    END END;
14380	END;
14390	IF NOT Endfile THEN GOTO start;
14400	out:
14410	END