Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/demos/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