Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/21/simexp.sim
There is 1 other file named simexp.sim in the archive. Click here to see a list.
00010 OPTIONS(/W/-Q/-A/-I/-D);
00020 BEGIN
00030 COMMENT /Q switch determines what to do with external files:
00040
00050 /Q:1 Files that can't be found will not be expanded.
00060 (default)
00070 /Q:2 Terminal question issued when external file
00080 can't be found.
00090 /Q:3 Terminal question issued every time a new external
00100 declaration occurs.;
00110
00120 EXTERNAL BOOLEAN PROCEDURE upcompare,numbered,lookup;
00130 EXTERNAL REF ( Infile ) PROCEDURE findinfile;
00140 EXTERNAL REF ( Outfile ) PROCEDURE findoutfile;
00150 EXTERNAL TEXT PROCEDURE
00160 tagord,conc,rest,scanto,front,conc2,storbokstav;
00170 COMMENT My own checkextension. Illegal memory reference ocurred
00180 when ordinary checkextension was used. ;
00190 TEXT PROCEDURE checkextension(t,defaultextension);
00200 VALUE defaultextension; TEXT t,defaultextension;
00210 IF t=/=NOTEXT THEN
00220 BEGIN
00230 t.Setpos(1);
00240 IF findtrigger(t,Copy(":")) NE ':' OR
00250 rest(t).Strip =/= NOTEXT THEN
00260 BEGIN t.Setpos(1);
00270 IF findtrigger(t,Copy(".")) NE '.' THEN
00280 t:-conc(t,defaultextension);
00290 END;
00300 checkextension:-t;
00310 END of checkextension;
00320 EXTERNAL CHARACTER PROCEDURE findtrigger;
00330 EXTERNAL INTEGER PROCEDURE scanint;
00340 EXTERNAL PROCEDURE exit;
00350
00360 PROCEDURE exitprog;
00370 BEGIN
00380 Outtext("Thank you!");
00390 Outimage;
00400 exit(0);
00410 restartflag:=TRUE;
00420 GO TO restart;
00430 END;
00440
00450 BOOLEAN PROCEDURE scanblanc(newline); NAME newline; TEXT newline;
00460 BEGIN CHARACTER c;
00470 c:=' ';
00480 WHILE newline.More AND c=' ' DO c:=newline.Getchar;
00490 IF c\=' ' THEN
00500 BEGIN
00510 scanblanc:=TRUE;
00520 newline.Setpos(newline.Pos-1);
00530 END;
00540 END;
00550
00560 PROCEDURE scancomment(newline,commentflag);
00570 NAME newline,commentflag; TEXT newline; BOOLEAN commentflag;
00580 BEGIN CHARACTER c; INTEGER p; TEXT t;
00590 start:IF commentflag THEN
00600 BEGIN
00610 scanto(newline,';');
00620 IF NOT newline.More THEN
00630 BEGIN
00640 newline.Setpos(newline.Pos-1);
00650 IF newline.Getchar=';' THEN commentflag:=FALSE;
00660 END ELSE commentflag:=FALSE;
00670 END;
00680 IF (IF \commentflag THEN scanblanc(newline) ELSE FALSE)THEN
00690 COMMENT check if there is another comment on this line;
00700 BEGIN
00710 p:=newline.Pos;
00720 t:-tagord(newline);
00730 c:=t.Getchar;
00740 IF c='!'
00750 OR (IF t.Length=7 THEN upcompare(t,idcomment) ELSE FALSE) THEN
00760 BEGIN
00770 commentflag:=TRUE;
00780 GO TO start;
00790 END ELSE
00800 BEGIN
00810 newline.Setpos(p);
00820 END;
00830 END;
00840 END;
00850
00860 PROCEDURE scanendcomment(newline,endcommentflag);
00870 NAME newline,endcommentflag;
00880 TEXT newline; BOOLEAN endcommentflag;
00890 BEGIN TEXT t; INTEGER p;
00900 WHILE newline.More AND endcommentflag DO
00910 BEGIN
00920 p:=newline.Pos;
00930 t:-tagord(newline);
00940 IF t=";"
00950 OR (IF t.Length=3 THEN upcompare(t,idend) ELSE FALSE)
00960 OR (IF t.Length=4 THEN upcompare(t,idelse) ELSE FALSE)
00970 OR (IF t.Length=4 THEN upcompare(t,idwhen) ELSE FALSE )
00980 OR (IF t.Length=9 THEN upcompare(t,idotherwise) ELSE FALSE)
00990 THEN endcommentflag:=FALSE;
01000 END;
01010 IF (IF t.Length=3 THEN upcompare(t,idend) ELSE FALSE)
01020 THEN newline.Setpos(p);
01030 END;
01040
01050 PROCEDURE scantext(newline,textflag);
01060 NAME newline,textflag; TEXT newline; BOOLEAN textflag;
01070 BEGIN CHARACTER c;
01080 WHILE newline.More AND c\='"' DO
01090 c:=newline.Getchar;
01100 IF c='"' THEN textflag:=FALSE;
01110 END;
01120
01130 BOOLEAN PROCEDURE firstitem(checkline); TEXT checkline;
01140 BEGIN INTEGER p;
01150 p:=checkline.Pos;
01160 checkline.Setpos(1);
01170 tagord(checkline);
01180 IF p=checkline.Pos THEN firstitem:=TRUE
01190 ELSE checkline.Setpos(p);
01200 END;
01210
01220 CHARACTER PROCEDURE lastchar(newline);
01230 TEXT newline;
01240 BEGIN
01250 newline.Setpos(newline.Length);
01260 lastchar:=newline.Getchar;
01270 END;
01280
01290 BOOLEAN PROCEDURE skipexternal(mainimage,commentflag);
01300 NAME mainimage,commentflag; TEXT mainimage; BOOLEAN commentflag;
01310 BEGIN TEXT t;
01320 WHILE mainimage.More AND t\=";" AND NOT commentflag DO
01330 BEGIN
01340 scancomment(mainimage,commentflag);
01350 t:-tagord(mainimage);
01360 IF t=";" THEN
01370 BEGIN
01380 mainimage:-rest(mainimage);
01390 skipexternal:=TRUE;
01400 END ;
01410 END;
01420 END;
01430
01440 TEXT PROCEDURE textsplit(newline); NAME newline; TEXT newline;
01450 BEGIN INTEGER p,r; CHARACTER c;
01460 WHILE p<=72 DO
01470 BEGIN
01480 r:=p;
01490 scan: c:=findtrigger(newline,Copy(",["));
01500 IF c='[' THEN
01510 BEGIN
01520 scanto(newline,']');
01530 GO TO scan;
01540 END;
01550 p:=newline.Pos;
01560 END;
01570 newline.Setpos(r);
01580 textsplit:-front(newline);
01590 newline:-rest(newline);
01600 END textsplit;
01610
01620 BOOLEAN restartflag;
01630 TEXT newidentifiers;
01640 TEXT idexternal,idoptions,idbegin,idend,idcomment,
01650 idelse,idwhen,idotherwise,idclass,idprocedure;
01660
01670 restart:
01680 newidentifiers:-Copy(
01690 "EXTERNALOPTIONSBEGINENDCOMMENTELSEWHENOTHERWISECLASSPROCEDURE");
01700 idexternal:-newidentifiers.Sub(1,8);
01710 idoptions:-newidentifiers.Sub(9,7);
01720 idbegin:-newidentifiers.Sub(16,5);
01730 idend:-newidentifiers.Sub(21,3);
01740 idcomment:-newidentifiers.Sub(24,7);
01750 idelse:-newidentifiers.Sub(31,4);
01760 idwhen:-newidentifiers.Sub(35,4);
01770 idotherwise:-newidentifiers.Sub(39,9);
01780 idclass:-newidentifiers.Sub(48,5);
01790 idprocedure:-newidentifiers.Sub(53,9);
01800 Simset BEGIN
01810 CHARACTER c;
01820 REF (Infile) prog; REF (Outfile) outf;
01830 TEXT t,mainimage;
01840 BOOLEAN expand1,expand2,expand3;
01850
01860 BOOLEAN PROCEDURE findoptions(inf,txt1,txt2);
01870 NAME txt1,txt2; REF(Infile)inf; TEXT txt1,txt2;
01880 COMMENT External file found. Does it contain options (/e) ? ;
01890 BEGIN
01900 TEXT t,mainimage; CHARACTER c;
01910 BOOLEAN eflag,macroflag,fortflag,commentflag,optionsflag,textflag;;
01920 INSPECT inf DO
01930 BEGIN
01940 Open(Blanks(200));
01950 WHILE NOT Endfile DO
01960
01970 BEGIN
01980 Inimage;
01990 IF numbered THEN mainimage:-Image.Sub(7,193).Strip
02000 ELSE mainimage:-Image.Strip;
02010 WHILE mainimage.More DO
02020 IF commentflag THEN scancomment(mainimage,commentflag)
02030 ELSE IF textflag THEN scantext(mainimage,textflag)
02040 ELSE IF optionsflag THEN GO TO check
02050 ELSE BEGIN
02060 t:-tagord(mainimage);
02070 IF (IF t.Length=5 THEN upcompare(t,idbegin)
02080 ELSE FALSE) THEN GO TO ready
02090 ELSE IF (IF t.Length=7 THEN
02100 upcompare(t,idoptions) ELSE FALSE) THEN
02110 BEGIN
02120 c:=' ';
02130 check: WHILE c\=';' AND mainimage.More DO
02140 BEGIN
02150 c:=findtrigger(mainimage,Copy("/;"));
02160 WHILE c='/' AND mainimage.More DO
02170 BEGIN
02180 c:=mainimage.Getchar;
02190 IF Digit(c) THEN
02200 BEGIN
02210 mainimage.Setpos(mainimage.Pos-1);
02220 scanint(mainimage);
02230 c:=mainimage.Getchar;
02240 END;
02250 IF c='E' OR c='e' THEN
02260 BEGIN
02270 c:=findtrigger(mainimage,Copy(":/;"));
02280 IF c=':' THEN
02290 BEGIN c:=mainimage.Getchar;
02300 IF c='f' OR c='F' THEN fortflag:=TRUE
02310 ELSE IF c='c' OR c='C' OR c='q' OR c='Q' THEN
02320 macroflag:=TRUE;
02330 END
02340 ELSE eflag:=TRUE;
02350 GO TO ready;
02360 END;
02370 c:=findtrigger(mainimage,Copy("/;"));
02380 END;
02390 END;
02400 IF c\=';' THEN optionsflag:=TRUE;
02410 END
02420 ELSE IF (IF t.Length=7 THEN upcompare(t,idcomment)
02430 ELSE FALSE) OR t="!" THEN commentflag:=TRUE
02440 ELSE IF t="""" THEN textflag:=TRUE;
02450 END;
02460 END;
02470 ready:
02480 Close;
02490 END inspect;
02500 findoptions:=eflag;
02510 IF macroflag THEN
02520 BEGIN
02530 txt1:-Copy("%SIMEXP - Macro10 external procedure ");
02540 txt2:-Copy(" not expanded.");
02550 END ELSE IF fortflag THEN
02560 BEGIN
02570 txt1:-Copy("%SIMEXP - Fortran external procedure ");
02580 txt2:-Copy(" not expanded.");
02590 END ELSE IF eflag THEN
02600 BEGIN
02610 txt1:-Copy("%SIMEXP - External module ");
02620 txt2:-Copy(" expanded.");
02630 END ELSE
02640 BEGIN
02650 txt1:-Copy("?SIMEXP - Options(/e) not found in external module: ");
02660 txt2:-Copy(". No expansion.");
02670 END;
02680 END findoptions;
02690
02700 REF(Infile) PROCEDURE externexp(t); TEXT t;
02710 COMMENT Should t be expanded or not ? ;
02720 BEGIN
02730 CHARACTER c; TEXT newprocedure; REF(Infile) newinf;
02740 newinf:-findinfile(t);
02750 IF expand1 AND newinf==NONE THEN
02760 BEGIN
02770 Sysout.Outtext("%SIMEXP - CANNOT FIND EXTERNAL MODULE ");
02780 Sysout.Outtext(t); Sysout.Outimage;
02790 END;
02800 enterfile1:IF expand2 AND newinf==NONE THEN
02810 BEGIN
02820 Sysout.Outtext("%SIMEXP - CANNOT FIND EXTERNAL MODULE ");
02830 Sysout.Outtext(t); Sysout.Outimage;
02840 Sysout.Outtext("Please enter file desc. if you want the procedure");
02850 Sysout.Outtext(" expanded.(<CR> if not)");
02860 Sysout.Outimage; Sysout.Outtext("*"); Sysout.Breakoutimage;
02870 Sysin.Inimage;
02880 IF Sysin.Image.Strip=/= NOTEXT THEN
02890 BEGIN
02900 newprocedure:-Sysin.Image.Strip;
02910 newprocedure:-checkextension(newprocedure,".sim");
02920 newinf:-findinfile(newprocedure);
02930 GO TO enterfile1;
02940 END;
02950 END;
02960 IF expand3 THEN
02970 BEGIN
02980 enterfile2: Sysout.Outtext("%SIMEXP - DO YOU WANT EXTERNAL MODULE: ");
02990 Sysout.Outtext(t);Sysout.Outtext(" EXPANDED?");
03000 Sysout.Outimage;
03010 Sysout.Outtext("Answer yes or no.*");
03020 Sysout.Breakoutimage;
03030 Sysin.Inimage;
03040 c:=Sysin.Image.Getchar;
03050 IF c='N' OR c='n' THEN newinf:-NONE
03060 ELSE IF c='Y' OR c='y' THEN
03070 BEGIN
03080 Sysout.Outtext(
03081 "%SIMEXP - If you want to use new file spec insert it here,");
03090 Sysout.Outimage;
03100 Sysout.Outtext("else answer <CR>. *");
03110 Sysout.Breakoutimage; Sysin.Inimage;
03120 newprocedure:-Sysin.Image.Strip;
03130 IF newprocedure=/=NOTEXT THEN
03140 newinf:-findinfile(newprocedure);
03150 IF newinf==NONE THEN
03160 BEGIN
03170 Sysout.Outtext("%SIMEXP - CANNOT FIND EXTERNAL MODULE ");
03180 Sysout.Outtext(t);Sysout.Outimage;
03190 GO TO enterfile2;
03200 END;
03210 END ELSE
03220 BEGIN
03230 Sysout.Outtext("?SIMEXP - Illegal answer");
03240 Sysout.Outimage;
03250 GO TO enterfile2;
03260 END;
03270 END;
03280 externexp:-newinf;
03290 END;
03300
03310 Link CLASS externproc(t); TEXT t;
03320 COMMENT List containing names of expanded modules.;
03330 BEGIN
03340 Into(q);
03350 END;
03360 Head CLASS myhead;
03370 BEGIN
03380 PROCEDURE compare(modulnamn,libsimflag,preexpandflag);
03390 NAME libsimflag,preexpandflag;
03400 TEXT modulnamn; BOOLEAN libsimflag,preexpandflag;
03410 BEGIN
03420 REF(externproc)x;
03430 libsimflag:=FALSE; preexpandflag:=FALSE;
03440 IF modulnamn.Length>6 THEN modulnamn:-modulnamn.Sub(1,6);
03450 COMMENT Check if modulnamn is in libsim;
03460 IF modulnamn = "FQCINL" THEN GOTO lib;
03470 IF modulnamn = "FQCCHE" THEN GOTO lib;
03480 IF modulnamn = "FETCH2" THEN GOTO lib;
03490 IF modulnamn = "FETCH1" THEN GOTO lib;
03500 IF modulnamn = "DBMSET" THEN GOTO lib;
03510 IF modulnamn = "DBM" THEN GOTO lib;
03520 IF modulnamn = "DBMTXT" THEN GOTO lib;
03530 IF modulnamn = "COSYS" THEN GOTO lib;
03540 IF modulnamn = "COSYSF" THEN GOTO lib;
03550 IF modulnamn = "GRAPHI" THEN GOTO lib;
03560 IF modulnamn = "FIGURE" THEN GOTO lib;
03570 IF modulnamn = "RUBOUT" THEN GOTO lib;
03580 IF modulnamn = "FORM" THEN GOTO lib;
03590 IF modulnamn = "VISTA" THEN GOTO lib;
03600 IF modulnamn = "TTYWAI" THEN GOTO lib;
03610 IF modulnamn = "SELECT" THEN GOTO lib;
03620 IF modulnamn = "CALLMI" THEN GOTO lib;
03630 IF modulnamn = "SCAN" THEN GOTO lib;
03640 IF modulnamn = "TRMOP" THEN GOTO lib;
03650 IF modulnamn = "GETCH" THEN GOTO lib;
03660 IF modulnamn = "CHANGE" THEN GOTO lib;
03670 IF modulnamn = "SPLIT" THEN GOTO lib;
03680 IF modulnamn = "SPLITA" THEN GOTO lib;
03690 IF modulnamn = "SIMEI" THEN GOTO lib;
03700 IF modulnamn = "SIMEIO" THEN GOTO lib;
03710 IF modulnamn = "SIMMIN" THEN GOTO lib;
03720 IF modulnamn = "SAFEI" THEN GOTO lib;
03730 IF modulnamn = "SAFEIO" THEN GOTO lib;
03740 IF modulnamn = "DECOM" THEN GOTO lib;
03750 IF modulnamn = "SAFMIN" THEN GOTO lib;
03760 IF modulnamn = "UNIQUE" THEN GOTO lib;
03770 IF modulnamn = "DAHELP" THEN GOTO lib;
03780 IF modulnamn = "MENU" THEN GOTO lib;
03790 IF modulnamn = "MENY" THEN GOTO lib;
03800 IF modulnamn = "STORE" THEN GOTO lib;
03810 IF modulnamn = "LSUM" THEN GOTO lib;
03820 IF modulnamn = "RSUM" THEN GOTO lib;
03830 IF modulnamn = "ISUM" THEN GOTO lib;
03840 IF modulnamn = "CHECKE" THEN GOTO lib;
03850 IF modulnamn = "HASH" THEN GOTO lib;
03860 IF modulnamn = "ILOG" THEN GOTO lib;
03870 IF modulnamn = "INLINE" THEN GOTO lib;
03880 IF modulnamn = "LOOKUP" THEN GOTO lib;
03890 IF modulnamn = "OUTTIM" THEN GOTO lib;
03900 IF modulnamn = "RANDOM" THEN GOTO lib;
03910 IF modulnamn = "SCRAMB" THEN GOTO lib;
03920 IF modulnamn = "SIGMA2" THEN GOTO lib;
03930 IF modulnamn = "SIGMEA" THEN GOTO lib;
03940 IF modulnamn = "SORTIA" THEN GOTO lib;
03950 IF modulnamn = "SORTID" THEN GOTO lib;
03960 IF modulnamn = "SORTLA" THEN GOTO lib;
03970 IF modulnamn = "SORTLD" THEN GOTO lib;
03980 IF modulnamn = "SORTRA" THEN GOTO lib;
03990 IF modulnamn = "SORTRD" THEN GOTO lib;
04000 IF modulnamn = "SORTTA" THEN GOTO lib;
04010 IF modulnamn = "SORTTD" THEN GOTO lib;
04020 IF modulnamn = "LINECO" THEN GOTO lib;
04030 IF modulnamn = "FRONT" THEN GOTO lib;
04040 IF modulnamn = "UPTO" THEN GOTO lib;
04050 IF modulnamn = "SQHELP" THEN GOTO lib;
04060 IF modulnamn = "RADIX" THEN GOTO lib;
04070 IF modulnamn = "GETRAD" THEN GOTO lib;
04080 IF modulnamn = "FROM" THEN GOTO lib;
04090 IF modulnamn = "FETCHA" THEN GOTO lib;
04100 IF modulnamn = "ZIMULA" THEN GOTO lib;
04110 IF modulnamn = "ZIMSET" THEN GOTO lib;
04120 IF modulnamn = "CONC" THEN GOTO lib;
04130 IF modulnamn = "CONC2" THEN GOTO lib;
04140 IF modulnamn = "PUTTEX" THEN GOTO lib;
04150 IF modulnamn = "FRONTS" THEN GOTO lib;
04160 IF modulnamn = "UPCASE" THEN GOTO lib;
04170 IF modulnamn = "FRONTC" THEN GOTO lib;
04180 IF modulnamn = "LOOKAH" THEN GOTO lib;
04190 IF modulnamn = "FINDIN" THEN GOTO lib;
04200 IF modulnamn = "FINDOU" THEN GOTO lib;
04210 IF modulnamn = "FINDPR" THEN GOTO lib;
04220 IF modulnamn = "FINDDI" THEN GOTO lib;
04230 IF modulnamn = "SCRATC" THEN GOTO lib;
04240 IF modulnamn = "TSUB" THEN GOTO lib;
04250 IF modulnamn = "PUTSIZ" THEN GOTO lib;
04260 IF modulnamn = "MAKETE" THEN GOTO lib;
04270 IF modulnamn = "STARTP" THEN GOTO lib;
04280 IF modulnamn = "DEPCHA" THEN GOTO lib;
04290 IF modulnamn = "ECHO" THEN GOTO lib;
04300 IF modulnamn = "SEARCH" THEN GOTO lib;
04310 IF modulnamn = "COMPRE" THEN GOTO lib;
04320 IF modulnamn = "SPLITC" THEN GOTO lib;
04330 IF modulnamn = "SCANTO" THEN GOTO lib;
04340 IF modulnamn = "SKIP" THEN GOTO lib;
04350 IF modulnamn = "UPCOMP" THEN GOTO lib;
04360 IF modulnamn = "FINDTR" THEN GOTO lib;
04370 IF modulnamn = "SLEEP" THEN GOTO lib;
04380 IF modulnamn = "READ" THEN GOTO lib;
04390 IF modulnamn = "WRITE" THEN GOTO lib;
04400 IF modulnamn = "INPUT" THEN GOTO lib;
04410 IF modulnamn = "OUTPUT" THEN GOTO lib;
04420 IF modulnamn = "INPUTW" THEN GOTO lib;
04430 IF modulnamn = "INPUTC" THEN GOTO lib;
04440 IF modulnamn = "CLOCKT" THEN GOTO lib;
04450 IF modulnamn = "DAYTIM" THEN GOTO lib;
04460 IF modulnamn = "CPTIME" THEN GOTO lib;
04470 IF modulnamn = "DAYNO" THEN GOTO lib;
04480 IF modulnamn = "TODAY" THEN GOTO lib;
04490 IF modulnamn = "MAXREA" THEN GOTO lib;
04500 IF modulnamn = "MAXINT" THEN GOTO lib;
04510 IF modulnamn = "CHECKR" THEN GOTO lib;
04520 IF modulnamn = "CHECKF" THEN GOTO lib;
04530 IF modulnamn = "CHECKI" THEN GOTO lib;
04540 IF modulnamn = "SCANRE" THEN GOTO lib;
04550 IF modulnamn = "SCANFR" THEN GOTO lib;
04560 IF modulnamn = "SCANIN" THEN GOTO lib;
04570 IF modulnamn = "FILENA" THEN GOTO lib;
04580 IF modulnamn = "LASTLO" THEN GOTO lib;
04590 IF modulnamn = "ABORT" THEN GOTO lib;
04600 IF modulnamn = "ENTERD" THEN GOTO lib;
04610 IF modulnamn = "DOTYPE" THEN GOTO lib;
04620 IF modulnamn = "PACK" THEN GOTO lib;
04630 IF modulnamn = "UNPACK" THEN GOTO lib;
04640 IF modulnamn = "INITEM" THEN GOTO lib;
04650 IF modulnamn = "GETITE" THEN GOTO lib;
04660 IF modulnamn = "NUMBER" THEN GOTO lib;
04670 IF modulnamn = "REST" THEN GOTO lib;
04680 IF modulnamn = "FORSIM" THEN GOTO lib;
04690 IF modulnamn = "LOWCAS" THEN GOTO lib;
04700 IF modulnamn = "SAVE" THEN GOTO lib;
04710 IF modulnamn = "RESTOR" THEN GOTO lib;
04720 IF modulnamn = "FREEZE" THEN GOTO lib;
04730 IF modulnamn = "RUN" THEN GOTO lib;
04740 IF modulnamn = "TMPNAM" THEN GOTO lib;
04750 IF modulnamn = "OUTCHR" THEN GOTO lib;
04760 IF modulnamn = "TTYCHE" THEN GOTO lib;
04770 IF modulnamn = "TMPIN" THEN GOTO lib;
04780 IF modulnamn = "TMPOUT" THEN GOTO lib;
04790 IF modulnamn = "GETTAB" THEN GOTO lib;
04800 IF modulnamn = "EXIT" THEN GOTO lib;
04810 IF modulnamn = "SCALES" THEN GOTO lib;
04820 IF modulnamn = "PUTFLO" THEN GOTO lib;
04830 IF modulnamn = "PUTTIM" THEN GOTO lib;
04840 IF modulnamn = "REQUES" THEN GOTO lib;
04850 IF modulnamn = "HISTP" THEN GOTO lib;
04860 IF modulnamn = "RESCAN" THEN GOTO lib;
04870 IF modulnamn = "BITFIE" THEN GOTO lib;
04880 IF modulnamn = "IDRX50" THEN GOTO lib;
04890 IF modulnamn = "IDSIXB" THEN GOTO lib;
04900 IF modulnamn = "INSING" THEN GOTO lib;
04910 IF modulnamn = "NEXTRA" THEN GOTO lib;
04920 IF modulnamn = "IASHIF" THEN GOTO lib;
04930 IF modulnamn = "CALSIM" THEN GOTO lib;
04940 IF modulnamn = "BOKSTA" THEN GOTO lib;
04950 IF modulnamn = "LITENB" THEN GOTO lib;
04960 IF modulnamn = "STORBO" THEN GOTO lib;
04970 IF modulnamn = "INORD" THEN GOTO lib;
04980 IF modulnamn = "TAGORD" THEN GOTO lib;
04990 x:-First;
05000 IF x=/=NONE THEN
05010 BEGIN
05020 IF x.t=modulnamn THEN preexpandflag:=TRUE
05030 ELSE FOR x:-x.Suc WHILE x=/=NONE AND NOT preexpandflag DO
05040 IF x.t=modulnamn THEN preexpandflag:=TRUE;
05050 END;
05060 IF NOT preexpandflag THEN
05070 BEGIN
05080 IF modulnamn.Length>6 THEN modulnamn:-Copy(modulnamn.Sub(1,6));
05090 NEW externproc(modulnamn);
05100 END;
05110
05120 IF FALSE THEN lib:
05130 BEGIN
05140 Outtext("%SIMEXP - LIBSIM MODULE NOT EXPANDED: ");
05150 Outtext(modulnamn); Outimage;
05160 libsimflag:=TRUE;
05170 END;
05180 END compare;
05190 END myhead;
05200
05210 Link CLASS textrows(t,qopt); VALUE t; TEXT t; REF(Head) qopt;
05220 BEGIN
05230 Into(qopt);
05240 END;
05250
05260 COMMENT start ;
05270 REF(myhead) q;
05280 IF restartflag THEN GO TO tryagain;
05290 COMMENT%IFNOT EE;
05300 Outtext(" SIMEXP-SIMULA Expanding Program. Version 2.1");
05310 COMMENT%IFEND EE;
05320 COMMENT%IF EE
05330 Outtext(" SIMEXP-SIMULA Expanding Program. Version 2.0");
05340 COMMENT%IFEND EE;
05350 Outimage;
05360 Outtext(" Enter file descriptions: outfile=infile[/switches]");
05370 Outimage;
05380 tryagain: Outtext("*"); Breakoutimage;
05390 Inimage;
05400 WHILE Sysin.Image.Strip==NOTEXT DO
05410 BEGIN
05420 Outtext("Please enter file descriptions for output and input");
05430 Outtext(" files."); Outimage;
05440 Outtext(" (type ? for help.)"); Outimage;
05450 Outtext("*"); Breakoutimage;Inimage;
05460 END;
05470 IF Sysin.Image.Strip="?" THEN
05480 BEGIN
05490 Outtext("Enter file descriptions for output and input files");
05500 Outimage; Outtext("Input should have the following format");
05510 Outimage; Outtext(" Outfile=Infile[/switches]");
05520 Outimage;
05530 Outtext("/Q switch determines what to do with external files:");
05540 Outimage;
05550 Outtext(" /Q:1 Files that can't be found will not be expanded.");
05560 Outimage;Outtext(" (default)");Outimage;
05570 Outtext(" /Q:2 Terminal question issued when external file");
05580 Outimage;
05590 Outtext(" can't be found."); Outimage;
05600 Outtext(" /Q:3 Terminal question issued every time a new external"
05610 );
05620 Outimage;Outtext(" declaration occurs.");
05630 Outimage; GO TO tryagain;
05640 END;
05650
05660 mainimage:-Sysin.Image.Strip;
05670 t:-scanto(mainimage,'=');
05680 t:-t.Strip;
05690 t:-checkextension(t,".sim");
05700 outf:-findoutfile(t);
05710 IF outf==NONE THEN
05720 BEGIN
05730 Outtext("?SIMEXP - Illegal file desc for outfile. Try again.");
05740 Outimage; GO TO tryagain;
05750 END;
05760 trynewinfile: t:-scanto(mainimage,'/');
05770 t:-t.Strip;
05780 t:-checkextension(t,".sim");
05790 prog:-findinfile(t);
05800 IF prog==NONE THEN
05810 BEGIN
05820 Outtext("?SIMEXP - Illegal file desc for infile.");
05830 Outimage; Outtext("Enter new file desc for input file");
05840 Outimage; Outtext("*"); Breakoutimage; Inimage;
05850 mainimage:-Sysin.Image.Strip;
05860 GO TO trynewinfile;
05870 END;
05880 COMMENT input switches;
05890 WHILE mainimage.More DO
05900 BEGIN
05910 INTEGER i;
05920
05930 t:-scanto(mainimage,'/');
05940 t:-t.Strip;
05950 c:=t.Getchar;
05960 IF c='Q' OR c='q' THEN
05970 BEGIN
05980 c:=t.Getchar;
05990 i:=scanint(t);
06000 IF i=1 THEN expand1:=TRUE
06010 ELSE IF i=2 THEN expand2:=TRUE
06020 ELSE IF i=3 THEN expand3:=TRUE;
06030 END
06040 END ;
06050 IF NOT(expand1 OR expand2 OR expand3) THEN expand1:=TRUE;
06060 q:-NEW myhead;
06070
06080 INSPECT outf DO
06090 BEGIN
06100
06110 PROCEDURE copyfile(inf,mainprogflag,filename); REF(Infile) inf;
06120 BOOLEAN mainprogflag; TEXT filename;
06130 BEGIN
06140 REF (Infile) newextfile;
06150 CHARACTER window;
06160 TEXT mainimage;
06170 BOOLEAN endcommentflag,optionsflag,opskipflag,
06180 commentflag,textflag,numberflag,fullbufferflag,
06190 fastcopyflag,firstbeginflag;
06200 INTEGER begincount,endcount;
06210
06220 INSPECT inf DO
06230 BEGIN
06240 PROCEDURE nextimage;
06250 BEGIN
06260 Inimage;
06270 IF numbered THEN numberflag:=TRUE;
06280 IF numberflag THEN mainimage:-Image.Sub(7,193).Strip
06290 ELSE mainimage:-Image.Strip;
06300 END;
06310
06320 PROCEDURE notfirstitem;
06330 IF NOT firstitem(mainimage) THEN
06340 BEGIN
06350 mainimage.Setpos(mainimage.Pos-8);
06360 Outtext(front(mainimage)); Outimage;
06370 mainimage:-rest(mainimage);
06380 tagord(mainimage);
06390 END;
06400
06410 PROCEDURE newexternal;
06420 COMMENT read external declaration;
06430 BEGIN
06440 TEXT temptext,txt1,txt2,extdeclaration,extfile;
06450 BOOLEAN notexpandflag,preexpandflag,ppnflag,
06460 libsimflag,eflag;
06470 PROCEDURE notexpandedproc;
06480 BEGIN
06490 IF notexpandflag THEN extdeclaration:-conc2(extdeclaration,",")
06500 ELSE extdeclaration:-conc2(extdeclaration," ");
06510 extdeclaration:-conc2(extdeclaration,temptext);
06520 notexpandflag:=TRUE;
06530 END;
06540 extdeclaration:-Copy(t);
06550 WHILE NOT(IF t.Length=9 THEN upcompare(t,idprocedure) ELSE FALSE)
06560 AND NOT(IF t.Length=5 THEN upcompare(t,idclass) ELSE FALSE) DO
06570
06580 BEGIN
06590 IF NOT mainimage.More THEN nextimage;
06600 scancomment(mainimage,commentflag);
06610 IF \commentflag THEN
06620 BEGIN
06630 t:-tagord(mainimage);
06640 IF t NE NOTEXT THEN
06650 extdeclaration:-conc(extdeclaration,Copy(" "),t);
06660 END;
06670 END;
06680 f2: scancomment(mainimage,commentflag);
06690 window:=' ';
06700 t:-tagord(mainimage);
06710 WHILE t==NOTEXT OR commentflag DO
06720 BEGIN
06730 nextimage;
06740 scancomment(mainimage,commentflag);
06750 IF NOT commentflag THEN t:-tagord(mainimage);
06760 END;
06770 extfile:-Copy(storbokstav(t));
06780 q.compare(extfile,libsimflag,preexpandflag);
06790 temptext:-Copy(extfile);
06800 WHILE window NE ',' AND window NE ';' DO
06810 BEGIN
06820 IF NOT mainimage.More THEN nextimage;
06830 scancomment(mainimage,commentflag);
06840 WHILE commentflag DO
06850 BEGIN
06860 scancomment(mainimage,commentflag);
06870 IF commentflag THEN nextimage;
06880 END;
06890 window:=findtrigger(mainimage,Copy("[=,.;"));
06900 IF window='.' THEN
06910 BEGIN
06920 t:-tagord(mainimage);
06930 temptext:-conc(temptext,Copy("."),t);
06940 extfile:-checkextension(extfile,".sim");
06950 END ELSE
06960 IF window='[' THEN
06970 BEGIN
06980 extfile:- checkextension(extfile,".sim");
06990 t:-conc(Copy("["),tagord(mainimage),
07000 tagord(mainimage),tagord(mainimage),tagord(mainimage));
07010 temptext:-conc2(temptext,t);
07020 extfile:-conc2(extfile,t);
07030 ppnflag:=TRUE;
07040 END ELSE
07050 IF window='=' THEN
07060 BEGIN
07070 extfile:-tagord(mainimage);
07080 temptext:-conc(temptext,Copy("="),extfile);
07090 END ELSE
07100 IF (window=',' OR window=';') AND \ppnflag THEN
07110 extfile:-checkextension(extfile,".sim");
07120 END;
07130 IF NOT preexpandflag THEN
07140 BEGIN
07150 IF libsimflag THEN GO TO foundinlibsim;
07160 newextfile:-externexp(extfile);
07170 IF newextfile=/=NONE THEN
07180 BEGIN
07190 eflag:=findoptions(newextfile,txt1,txt2);
07200 Sysout.Outtext(txt1); Sysout.Outtext(extfile);
07210 Sysout.Outtext(txt2);
07220 Sysout.Outimage;
07230 IF \eflag THEN notexpandedproc
07240 ELSE
07250 COMMENT Expand external module:newextfile;
07260 copyfile(newextfile,FALSE,extfile);
07270 END ELSE
07280 COMMENT Module either not found or found in libsim;
07290 foundinlibsim: notexpandedproc;
07300 END;
07310 IF window NE ';' THEN GO TO f2;
07320 mainimage:-rest(mainimage);
07330 IF notexpandflag THEN BEGIN
07340 extdeclaration:-conc2(extdeclaration,";");
07350 WHILE extdeclaration.Length >72 DO
07360 BEGIN
07370 Outtext(textsplit(extdeclaration));
07380 Outimage;
07390 END;
07400 Outtext(extdeclaration);
07410 Outimage;
07420 END;
07430 END newexternal;
07440
07450 PROCEDURE scanoptions(newline,optionsflag,opskipflag);
07460 COMMENT If optionsstatement contains /e then it
07470 should not be copied;
07480 NAME newline,optionsflag,opskipflag;
07490 TEXT newline; BOOLEAN optionsflag,opskipflag;
07500 BEGIN
07510 TEXT t; CHARACTER c; INTEGER p;
07520 REF(Head) longoptionsstatement;
07530
07540 PROCEDURE skipoptions;
07550 BEGIN
07560 newline:-rest(newline);
07570 opskipflag:=FALSE;
07580 END ;
07590
07600 PROCEDURE checkoptions;
07610 BEGIN
07620 WHILE t\=";" AND newline.More DO
07630 BEGIN
07640 IF \textflag THEN t:-tagord(newline)
07650 ELSE t:-NOTEXT;
07660 IF t="""" OR textflag THEN
07670 BEGIN
07680 textflag:=TRUE;
07690 scantext(newline,textflag);
07700 END
07710 ELSE IF t="/" THEN
07720 BEGIN
07730 c:=newline.Getchar;
07740 IF Digit(c) THEN
07750 BEGIN
07760 newline.Setpos(newline.Pos-1);
07770 scanint(newline);
07780 c:=newline.Getchar;
07790 END;
07800 IF c='E' OR c='e' THEN opskipflag:=TRUE;
07810 END;
07820 END;
07830 IF t=";" AND \textflag THEN optionsflag:=FALSE;
07840 END;
07850
07860 IF \firstitem(newline) THEN
07870 BEGIN
07880 newline.Setpos(newline.Pos-7);
07890 Outtext(front(newline));
07900 Outimage;
07910 newline:-rest(newline);
07920 END;
07930 checkoptions;
07940 IF NOT optionsflag THEN
07950 BEGIN
07960 IF opskipflag THEN skipoptions;
07970 END ELSE
07980 BEGIN COMMENT optionsstatement exceeds one line;
07990 longoptionsstatement:-NEW Head;
08000 WHILE optionsflag DO
08010 BEGIN
08020 NEW textrows(newline,longoptionsstatement);
08030 nextimage;
08040 newline:-mainimage;
08050 checkoptions;
08060 END;
08070 IF opskipflag THEN skipoptions
08080 ELSE BEGIN
08090 REF(textrows) txt;
08100 txt:-longoptionsstatement.First;
08110 WHILE txt=/=NONE DO
08120 BEGIN
08130 Outtext(txt.t); Outimage;
08140 txt:-txt.Suc;
08150 END;
08160 END;
08170 END flera rader;
08180 END scanoptions;
08190
08200 Open(Blanks(200));
08210 GO TO linein;
08220 WHILE NOT Endfile DO
08230 BEGIN
08240 WHILE mainimage.More DO
08250 BEGIN
08260 IF endcommentflag THEN
08270 scanendcomment(mainimage,endcommentflag)
08280 ELSE IF commentflag THEN
08290 scancomment(mainimage,commentflag)
08300 ELSE IF textflag THEN
08310 scantext(mainimage,textflag)
08320 ELSE IF optionsflag THEN
08330 BEGIN
08340 scanoptions(mainimage,optionsflag,opskipflag);
08350 IF mainimage==NOTEXT THEN GO TO linein;
08360 END
08370 ELSE BEGIN
08380 t:-tagord(mainimage);
08390 IF t==NOTEXT THEN
08400 ELSE IF (IF t.Length=8 THEN
08410 upcompare(t,idexternal) ELSE FALSE) THEN
08420 BEGIN
08430 notfirstitem;
08440 IF \firstbeginflag
08450 COMMENT%IFNOT EE;
08460 OR \mainprogflag
08470 COMMENT%IFEND EE;
08480 THEN
08490 BEGIN BOOLEAN b1;
08500 WHILE NOT b1 DO
08510 BEGIN
08520 b1:=skipexternal(mainimage,commentflag);
08530 IF NOT b1 THEN nextimage;
08540 END;
08550 END ELSE
08560 newexternal;
08570 IF mainimage==NOTEXT THEN GO TO linein;
08580 END
08590 ELSE IF (IF t.Length=7 THEN
08600 upcompare(t,idoptions) ELSE FALSE) THEN
08610 optionsflag:=TRUE
08620 ELSE IF (IF t.Length=3 THEN
08630 upcompare(t,idend) ELSE FALSE) THEN
08640 endcommentflag:=TRUE
08650 ELSE IF (IF t.Length=7 THEN
08660 upcompare(t,idcomment) ELSE FALSE)
08670 OR t="!" THEN commentflag:=TRUE
08680 ELSE IF t="""" THEN textflag:=TRUE
08690 ELSE IF(IF t.Length=5 THEN
08700 upcompare(t,idbegin) ELSE FALSE) THEN
08710 BEGIN
08720 firstbeginflag:=TRUE;
08730 COMMENT%IFNOT EE;
08740 IF \mainprogflag THEN fastcopyflag:=TRUE;
08750 COMMENT%IFEND EE;
08760 END;
08770
08780 END;
08790 END mainimage.more;
08800 Outtext(mainimage); Outimage;
08810 COMMENT%IFNOT EE;
08820 IF fastcopyflag THEN GO TO fastcopy;
08830 COMMENT%IFEND EE;
08840 linein:nextimage;
08850 END;
08860 IF endcommentflag THEN
08870 BEGIN
08880 Outtext(";"); Outimage;
08890 END;
08900
08910 COMMENT%IFNOT EE;
08920 fastcopy: IF \Endfile THEN
08930 BEGIN TEXT ARRAY indeximage[1:3]; INTEGER i,j;
08940
08950 PROCEDURE inindeximage;
08960 BEGIN
08970 inf.Image:-indeximage(i);
08980 Inimage;
08990 END;
09000
09010 BOOLEAN PROCEDURE endbysemicolon;
09020 BEGIN
09030 IF i=1 THEN i:=3 ELSE i:=i-1;
09040 IF numberflag THEN indeximage(i):-indeximage(i).Sub(7,193).Strip
09050 ELSE indeximage(i):-indeximage(i).Strip;
09060 IF indeximage(i)=/=NOTEXT THEN
09070 BEGIN
09080 endbysemicolon:=TRUE;
09090 IF lastchar(indeximage(i))\=';' THEN
09100 BEGIN
09110 Outtext(";"); Outimage;
09120 END;
09130 END ;
09140 END ;
09150
09160 FOR i:=1 STEP 1 UNTIL 3 DO
09170 indeximage(i):-Blanks(200);
09180 i:=1;
09190 inindeximage;
09200
09210 WHILE \Endfile DO
09220 BEGIN
09230 i:=i+1;
09240 inindeximage;
09250 IF i=3 THEN BEGIN
09260
09270 WHILE NOT Endfile DO
09280 BEGIN
09290 IF i=3 THEN i:=1 ELSE i:=i+1;
09300 IF numberflag THEN outf.Image:=indeximage(i).Sub(7,193)
09310 ELSE outf.Image:-indeximage(i);
09320 Outimage;
09330 inindeximage;
09340 END while;
09350 fullbufferflag:=TRUE;
09360 FOR j:=1 STEP 1 UNTIL 2 DO
09370 BEGIN
09380 IF i=3 THEN i:=1 ELSE i:=i+1;
09390 IF numberflag THEN outf.Image:=indeximage(i).Sub(7,193)
09400 ELSE outf.Image:=indeximage(i);
09410 Outimage;
09420 END for;
09430 IF i=3 THEN i:=1 ELSE i:=i+1;
09440 END i=3;
09450 END while;
09460 IF NOT fullbufferflag AND i=2 THEN
09470 BEGIN
09480 IF numberflag THEN outf.Image:=indeximage(1).Sub(7,193)
09490 ELSE outf.Image:-indeximage(i);
09500 Outimage;
09510 END;
09520 outf.Image:-Blanks(200);
09530 IF fullbufferflag THEN
09540 BEGIN
09550 IF \endbysemicolon THEN
09560 BEGIN
09570 IF \endbysemicolon THEN
09580 BEGIN
09590 Sysout.Outtext("%SIMEXP - WARNING More than one ");
09600 Sysout.Outtext("blank line at end of external module: ");
09610 Sysout.Outtext(filename);
09620 Sysout.Outimage;
09630 END;
09640 END;
09650 END ELSE
09660 BEGIN
09670 IF (IF i=2 THEN \endbysemicolon ELSE TRUE)
09680 AND endcommentflag THEN
09690 BEGIN
09700 Outtext(";"); Outimage;
09710 END;
09720 END;
09730 END;
09740 COMMENT%IFEND EE;
09750
09760 Close;
09770 END inspect;
09780 END copyfile;
09790 Open(Blanks(200));
09800 copyfile(prog,TRUE,Copy("MAIN PROGRAM"));
09810 Close;
09820 END inspect;
09830 END simset;
09840 exitprog;
09850 END;