Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/21/cocos.src
There are 4 other files named cocos.src in the archive. Click here to see a list.
00010 OPTIONS(/C);
00020 COMMENT COCOS - Conditional Compilation in SIMULA;
00030 COMMENT =========================================;
00040 COMMENT
00050 COMMENT COCOS is a program to allow one SIMULA source program to
00060 COMMENT compile into several differing programs. A preprocessor
00070 COMMENT selects statements from the initial source program according
00080 COMMENT to selection statements. The initial source program can also
00090 COMMENT be compiled directly as one of the versions.
00100 COMMENT
00110 COMMENT In the future, some SIMULA compilers may include the
00120 COMMENT interpretation of the COCOS commands, or some other similar
00130 COMMENT scheme, so that no preprocessing is necessary.
00140 COMMENT
00150 COMMENT COCOS commands all begin with % in the first character
00160 COMMENT position of an input line. (COCOS commands can also begin
00170 COMMENT with "COMMENT%" which must be the first non-blank text on a
00180 COMMENT source program line. The source program should not contain
00190 COMMENT any such lines beginning with COMMENT% except COCOS command
00200 COMMENT lines.)
00210 COMMENT
00220 COMMENT The four COCOS commands are:
00230 COMMENT
00240 COMMENT %COCOS <variable> = <value>
00250 COMMENT %IF <variable>
00260 COMMENT %IFNOT <variable>
00270 COMMENT %IFEND <variable> (%ENDIF also allowd)
00280 COMMENT
00290 COMMENT The commands may, but must not end with semicolon. There
00300 COMMENT should be no other text on these command lines.
00310 COMMENT
00320 COMMENT <variable> can be any valid SIMULA identifier. COCOS
00330 COMMENT variables are however always global throughout the whole
00340 COMMENT program and can have the same name as other identifiers
00350 COMMENT in the program.
00360 COMMENT
00370 COMMENT <value> can only take the values TRUE or FALSE.
00380 COMMENT
00390 COMMENT Example: Output:
00400 COMMENT
00410 COMMENT BEGIN COMMENT BEGIN
00420 COMMENT %COCOS GERMAN = FALSE; COMMENT outtext("I am.");
00430 COMMENT %IF GERMAN; COMMENT outimage;
00440 COMMENT outtext("Ich bin."); COMMENT END;
00450 COMMENT %IFNOT GERMAN;
00460 COMMENT outtext("I am.");
00470 COMMENT %IFEND GERMAN;
00480 COMMENT outimage;
00490 COMMENT END;
00500 COMMENT
00510 COMMENT With %COCOS GERMAN = TRUE, the output file will include "Ich
00520 COMMENT bin." instead of "I am.". With each switch is associated
00530 COMMENT three values, the variable name (<variable>), the value
00540 COMMENT (<value>) and the condition.
00550 COMMENT
00560 COMMENT %IF gives the condition the value YES. %IFEND gives the
00570 COMMENT condition the value NEUTRAL. %IFNOT gives the condition the
00580 COMMENT value NO. No COCOS command lines are copied to the compilable
00590 COMMENT program. Other lines are copied only if for all TRUE
00600 COMMENT switches, the condition is yes or neutral, and for all FALSE
00610 COMMENT switches, the condition is no or neutral.
00620 COMMENT
00630 COMMENT There can be more than one %COCOS commands for the same
00640 COMMENT variable in a processed program. The last command is valid.
00650 COMMENT
00660 COMMENT If a %IF... command is encountered with no known value for
00670 COMMENT the switch, then COCOS will ask the conversational terminal
00680 COMMENT for a value.
00690 COMMENT
00692 COMMENT When COCOS is executed, you can give the following command
00694 COMMENT string:
00696 COMMENT <outfile>=<infile>/<variable1>:<value1>/variable2>:<value2>...
00698 COMMENT
00700 COMMENT END OF COMMENT;
00720 COMMENT ============================================ PAGE 2;
00730
00740 COMMENT%IF DEC10;
00750 OPTIONS(/c);
00760 COMMENT%IFEND DEC10;
00770 BEGIN
00780 COMMENT%IF DEC10;
00790 COMMENT DEC10 SIMULA LIBRARY PROCEDURES;
00800 EXTERNAL TEXT PROCEDURE from, tagord, storbokstav, scanto, conc;
00805 EXTERNAL TEXT PROCEDURE compress, front;
00810 EXTERNAL REF (infile) PROCEDURE findinfile;
00820 EXTERNAL REF (outfile) PROCEDURE findoutfile;
00830 EXTERNAL BOOLEAN PROCEDURE numbered, rescan;
00840 EXTERNAL CHARACTER PROCEDURE fetchar;
00850 EXTERNAL INTEGER PROCEDURE rename;
00860 COMMENT%IFEND DEC10;
00880 COMMENT ============================================ PAGE 3;
00885
00890 COMMENT%IFNOT DEC10;
00895 COMMENT SIMULA VERSIONS OF DEC 10 SIMULA LIBRARY PROCEDURES;
00900
00905 TEXT PROCEDURE compress(t,c); TEXT t; CHARACTER c;
00910 COMMENT will return a reference to a new text containing
00915 all characters in the text t except the character c;
00920 BEGIN TEXT s; CHARACTER cc;
00925 t.setpos(1); s:- t;
00930 WHILE t.more DO
00935 BEGIN cc:= t.getchar;
00940 IF cc NE c THEN s.putchar(cc);
00945 END;
00950 IF s =/= NOTEXT THEN compress:- s.sub(1,s.pos-1);
00955 END;
01046
01050 TEXT PROCEDURE tagord(tt); NAME tt; TEXT tt;
01051
01052 COMMENT
01053 First any blanks or tabs after POS in the text are skipped.
01054 Then the procedure reads an item. By an item is meant
01055 either an identifier (a letter followed by letters, digits)
01056 or a number (a series of digits which may contain one dot)
01057 or any other character except blank.
01058
01059 The input text "IF CAR.WHEEL_SIZE > 13.5" will thus by
01060 successive calls to tagord give:
01061 IF/CAR/./WHEEL/_/SIZE/>/13.5
01062
01063 The result is a reference to a subtext (not a copy) of the
01070 text passed as a parameter, or NOTEXT if there are only
01080 blanks left or pos > length.
01090
01100 Notes:
01110 1. The position of the parameter starts from current pos.
01120 2. Preceding blanks or tabs (if any) are skipped.
01130 3. The resulting position indicator setting is that
01140 following the last character of the matched word;
01150
01160 IF tt =/= NOTEXT THEN
01170 BEGIN
01180 CHARACTER window; INTEGER startpos; TEXT t;
01190
01200 CHARACTER PROCEDURE getchar;
01210 IF t.more THEN
01220 getchar:= window:= t.getchar ELSE GOTO out;
01230
01240 BOOLEAN PROCEDURE idchar(c); CHARACTER c;
01250 idchar:= letter(c) OR digit(c);
01260
01270 t:- tt; t.setpos(tt.pos);
01280 startpos:= t.length+1;
01290 getchar;
01300 WHILE window = ' ' OR window = char(9) DO getchar;
01310 startpos:= t.pos-1;
01320 IF NOT bokstav(window) THEN
01330 BEGIN
01340 IF digit(window) THEN WHILE digit(getchar) DO;
01350 IF window = '.' THEN WHILE digit(getchar) DO;
01360 END ELSE WHILE idchar(getchar) DO;
01370 IF t.pos > startpos + 1 THEN t.setpos(t.pos-1);
01380 out:
01390 tagord:- t.sub(startpos,t.pos-startpos);
01400 tt.setpos(t.pos);
01410 END;
01420
01430
01440
01450
01460
01470 CHARACTER PROCEDURE fetchar(t,p); TEXT t; INTEGER p;
01480 COMMENT fetch the p-th character out of the text t;
01490 IF p >= 1 AND p <= t.length THEN
01500 fetchar:= t.sub(p,1).getchar;
01510
01520 TEXT PROCEDURE from(t,i); TEXT t; INTEGER i;
01530 COMMENT subtext of t after the i-th character;
01540 IF i <= t.length THEN
01550 from:- IF i <= 0 THEN t ELSE t.sub(i,t.length-i+1);
01560
01570 BOOLEAN PROCEDURE bokstav(t); CHARACTER t;
01580 COMMENT TRUE for character regarded as letter in SIMULA id-s;
01590 bokstav:= letter(t) OR t = '_';
01600
01610 TEXT PROCEDURE storbokstav(t); TEXT t;
01620 COMMENT Upper case transformation including swedish letters;
01630 IF t =/= NOTEXT THEN
01640 BEGIN
01650 CHARACTER c; INTEGER shift;
01660 shift:= rank('a') - rank('A');
01670 t.setpos(1);
01680 WHILE t.more DO
01690 BEGIN
01700 c:= t.getchar;
01710 IF letter(c) AND c >= 'a' AND c <= 'z' THEN
01720 BEGIN
01730 c:= char(rank(c) - shift);
01740 t.setpos(t.pos-1); t.putchar(c);
01750 END;
01760 END;
01770 t.setpos(1);
01780 storbokstav:- t;
01790 END;
01800
01810 TEXT PROCEDURE scanto(tt,c);
01820 NAME tt; VALUE c; TEXT tt; CHARACTER c;
01830 COMMENT scan to next occurence of c after pos in tt;
01840 BEGIN TEXT t; INTEGER p;
01850 t:- tt; p:= t.pos;
01860 WHILE t.more DO
01870 IF t.getchar = c THEN
01880 BEGIN
01890 scanto:- t.sub(p,t.pos-p-1);
01900 GOTO out;
01910 END;
01920 scanto:- from(t,p);
01930 out: tt.setpos(t.pos);
01940 END of scanto;
01950
01960 COMMENT%IFEND DEC10;
01980 COMMENT ============================================ PAGE 4;
01990
02000 REF (swi) switches; COMMENT List of COCOS variables;
02010 INTEGER yes, no, neutral; COMMENT constants with these meanings;
02020 BOOLEAN commentswitch, inhibiterror;
02030
02040 CLASS swi(variable,switch_value,condition);
02050 COMMENT One object of this class for each COCOS variable;
02060 VALUE variable;
02070 BOOLEAN switch_value; COMMENT Is the variable TRUE or FALSE?;
02080 INTEGER condition; COMMENT Can take values yes (after %IF),
02090 no (after %IFNOT) and neutral (After %IFEND);
02100 TEXT variable; COMMENT identifier with the variable name;
02110 BEGIN REF (swi) next; COMMENT in list of all COCOS variables;
02120 next:- switches;
02130 switches:- THIS swi;
02140 END;
02160 COMMENT ============================================ PAGE 5;
02170
02180 CLASS filed;
02190 COMMENT This is a general-purpose class for the reading and and writing
02200 of source files. In the DEC 10 version, this class includes algorithms
02210 for the handling of line numbers and end-of-page markings;
02220 BEGIN
02230 COMMENT%IF DEC10;
02240 CHARACTER carriagereturn, formfeed, tab;
02250 BOOLEAN top_of_page; COMMENT TRUE IF next output line starts new
02260 page;
02270 BOOLEAN got_formfeed; COMMENT TRUE IF last input line ended a page;
02280 BOOLEAN line_numbered; COMMENT The input file is line numbered;
02290 TEXT sixdigits; COMMENT Used in procedure make_five_digits;
02300 TEXT five_sp; COMMENT Text with just five blank characters;
02310 TEXT five_sp_tab; COMMENT Text with five blanks and a tab;
02320 INTEGER last_line_number; COMMENT Number on previous input line;
02330 INTEGER this_line_number; COMMENT Number on current input line;
02340 COMMENT%IFEND DEC10;
02350 BOOLEAN first_line_read; COMMENT TRUE only after first input line;
02360 TEXT editout_image; COMMENT Image for output file;
02370 TEXT editin_image_strip; COMMENT Stripped input line from file;
02380 REF (infile) editin; COMMENT The input text file;
02390 REF (outfile) editout; COMMENT The output text file;
02410 COMMENT ============================================ PAGE 6;
02420
02430 COMMENT%IF DEC10;
02440 TEXT PROCEDURE make_five_digits(line_number);
02450 COMMENT: This procedure produces a five-character long string
02460 containing the parameter number in ASCII format with leading zeroes
02470 (for use as line number on the output file);
02480 INTEGER line_number;
02490 BEGIN
02500 sixdigits.putint(line_number+100000);
02510 make_five_digits:- sixdigits.sub(2,5);
02520 END;
02530 COMMENT%IFEND DEC10;
02550 COMMENT ============================================ PAGE 7;
02560
02570 COMMENT%IF DEC10;
02580 BOOLEAN PROCEDURE five_digits(t); TEXT t;
02590 COMMENT: This procedure checks if the first five characters of the
02600 parameter string t are all digits, which is required for a correct
02610 line number;
02620 BEGIN
02630 IF t.length > 4 THEN
02640 BEGIN
02650 t.setpos(1);
02660 IF digit(t.getchar) THEN
02670 BEGIN IF digit(t.getchar) THEN
02680 BEGIN IF digit(t.getchar) THEN
02690 BEGIN IF digit(t.getchar) THEN
02700 five_digits:= digit(t.getchar);
02710 END;
02720 END;
02730 END;
02740 END;
02750 END;
02760 COMMENT%IFEND DEC10;
02780 COMMENT ============================================ PAGE 8;
02790
02800 PROCEDURE editinimage;
02810 COMMENT: This procedure inputs a line from the input text file. The
02820 input line is stripped into the text "editin_image_strip". If the
02830 input line is the first line on a new page, then the BOOLEAN
02840 "top_of_page" becomes TRUE. Page delimiter mark is removed from the
02850 input line;
02860 INSPECT editin DO
02870 BEGIN
02880 IF first_line_read THEN first_line_read:= FALSE ELSE
02890 BEGIN
02900 getline:
02910 COMMENT%IF DEC10;
02920 top_of_page:= top_of_page OR got_formfeed;
02930 COMMENT%IFEND DEC10;
02940 inimage;
02950 END;
02960 editin_image_strip:- image.strip;
02970 COMMENT%IF DEC10;
02980 got_formfeed:= IF editin_image_strip == NOTEXT
02990 THEN FALSE ELSE fetchar(editin_image_strip,
03000 editin_image_strip.length) = formfeed;
03010 IF got_formfeed THEN
03020 BEGIN
03030 COMMENT remove form feed from input line;
03040 editin_image_strip:- editin_image_strip.sub
03050 (1,editin_image_strip.length-1);
03060 COMMENT bypass input lines containing nothing put a proper page
03070 delimiter mark;
03080 IF editin_image_strip == NOTEXT THEN GOTO getline;
03090 IF editin_image_strip = five_sp THEN GOTO getline;
03100 IF editin_image_strip = five_sp_tab THEN GOTO getline;
03110 END;
03120 COMMENT%IFEND DEC10;
03130 END;
03150 COMMENT ============================================ PAGE 9;
03160
03170 PROCEDURE editoutimage(t); TEXT t;
03180
03190 COMMENT%IF DEC10;
03200 COMMENT: This procedure outputs the parameter text "t" as a line
03202 for
03210 the output file. If the BOOLEAN "line_numbered" is TRUE, but "t"
03220 does not contain a correct line number, then a number is added or
03222 an
03230 incorrect number is replaced.
03240
03250 IF the BOOLEAN "top_of_page" is TRUE, then a proper page mark is
03260 inserted into the output file in front of the output line, and
03270 "top_of_page" is made FALSE at the same time;
03280 COMMENT%IFEND DEC10;
03290
03300 BEGIN
03310 t:- t.strip;
03320 COMMENT%IF DEC10;
03330 IF line_numbered THEN
03340 BEGIN
03350 IF top_of_page THEN
03360 BEGIN COMMENT output proper page mark;
03370 editout.image:- editout_image;
03380 editout.image.setpos(6);
03390 editout.outchar(carriagereturn);
03400 editout.outchar(formfeed);
03410 editout.breakoutimage; top_of_page:= FALSE;
03420 END;
03430 IF five_digits(t) THEN
03440 BEGIN
03450 this_line_number:= t.sub(1,5).getint;
03460 IF t.length = 5 THEN GOTO goodnumbered;
03470 IF fetchar(t,6) = tab THEN GOTO goodnumbered;
03480 END;
03490 COMMENT The line had no line number, concatate line number in
03500 front of the line;
03510 last_line_number:= last_line_number+1;
03520 editout.image:- editout_image;
03530 editout.outtext(make_five_digits( last_line_number));
03540 editout.outchar(tab); editout.outtext(t);
03550 IF FALSE THEN goodnumbered:
03560 BEGIN
03570 COMMENT The line began with a line number;
03580 IF this_line_number <= last_line_number THEN
03590 BEGIN
03600 COMMENT: The line number was lower than on
03610 the previous line, a higher line number is
03620 substituted;
03630 last_line_number:= last_line_number+1;
03640 t.sub(1,5):= make_five_digits(last_line_number);
03650 END ELSE last_line_number:= this_line_number;
03660 editout.image:- t;
03670 END;
03680 editout.outimage;
03690 END ELSE
03700 BEGIN COMMENT the output file should NOT be line numbered;
03710 IF top_of_page THEN
03720 BEGIN COMMENT Output proper page mark;
03730 editout.image:- editout_image;
03740 editout.outchar(formfeed);
03750 editout.breakoutimage; top_of_page:= FALSE;
03760 END;
03770 COMMENT%IFEND DEC10;
03780 editout.image:- t; editout.outimage;
03790 COMMENT%IF DEC10;
03800 END;
03810 COMMENT%IFEND DEC10;
03820 END;
03840 COMMENT ============================================ PAGE 10;
03850
03860 COMMENT%IF DEC10;
03870 COMMENT initialize constants and dummy variables used by the program;
03880
03890 carriagereturn:= char(13); formfeed:= char(12);
03900 tab:= char(9);
03910
03920 sixdigits:- blanks(6); five_sp:- blanks(5);
03930 five_sp_tab:- blanks(6); five_sp_tab.setpos(5);
03940 five_sp_tab.putchar(tab);
03950 COMMENT%IFEND DEC10;
03960 END of class filed;
03980 COMMENT ============================================ PAGE 11;
03990
04000 COMMENT Here comes the part of COCOS which uses the CLASS
04010 "filed" for reading and writing source files for the special
04020 purposes of COCOS;
04030 filed BEGIN
04040 TEXT uc_line; COMMENT Up-cased line;
04050 TEXT after_number; COMMENT Part of line without line-number;
04060 TEXT variable; COMMENT COCOS variable name being treated;
04070 TEXT swi_type; COMMENT Text after %, either "COCOS" or
04080 "IF" or "IFEND" or "IFNOT" or "ENDIF";
04090 TEXT command; COMMENT initial command string;
04100 TEXT outf; COMMENT name of output file;
04110 TEXT inf; COMMENT name of input file;
04120 COMMENT%IF DEC10;
04130 TEXT backf; COMMENT backuped name of output file;
04140 COMMENT%IFEND DEC10;
04150 BOOLEAN truthvalue; COMMENT of initial command string variable;
04160 BOOLEAN switch_true; COMMENT Current COCOS variable is TRUE;
04170 CHARACTER c; COMMENT Temporary character;
04180 CHARACTER tab; COMMENT ASCII character = Horizontal Tab;
04190
04200 REF (swi) PROCEDURE find_switch;
04210 COMMENT will find an already known COCOS variable with the name
04220 "variable";
04230 BEGIN
04240 REF (swi) sw;
04250 sw:- switches;
04260 WHILE sw =/= NONE DO
04270 BEGIN
04280 IF sw.variable = variable THEN find_switch:- sw;
04290 sw:- sw.next;
04300 END;
04310 END;
04320
04330 PROCEDURE set_condition(setting); INTEGER setting;
04340 COMMENT will set the condition (yes, no or neutral) for the current
04350 COCOS variable;
04360 BEGIN
04370 REF (swi) sw;
04380 sw:- find_switch;
04390 IF sw =/= NONE THEN sw.condition:= setting ELSE
04400 BEGIN
04410 ask: outtext("Give value for switch: """);
04420 outtext(variable); outtext(""": ");
04430 breakoutimage;
04440 inimage;
04450 c:= inchar; IF c = 'T' OR c = 't' OR c = 'Y' OR c = 'y' THEN
04460 sw:- NEW swi(variable,TRUE,setting) ELSE
04470 IF c = 'F' OR c = 'f' OR c = 'N' OR c = 'n' THEN
04480 sw:- NEW swi(variable,FALSE,setting) ELSE
04490 BEGIN outtext("Answer either ""TRUE"" or ""FALSE""COMMENT ");
04500 outimage; GOTO ask;
04510 END;
04520 END;
04530 switch_true:= TRUE; sw:- switches;
04540 WHILE sw =/= NONE DO
04550 INSPECT sw DO
04560 BEGIN
04570 IF condition = yes AND NOT switch_value
04580 THEN switch_true:= FALSE ELSE
04590 IF condition = no AND switch_value
04600 THEN switch_true:= FALSE;
04610 sw:- next;
04620 END;
04630 END;
04640
04650 PROCEDURE create_variable;
04660 COMMENT interpretation of the COCOS %COCOS command,
04670 setting a COCOS variable to TRUE or FALSE;
04680 BEGIN TEXT word;
04690 word:- tagord(uc_line);
04700 IF word NE "=" THEN
04710 error("No ""="" after variable name.");
04720 word:- tagord(uc_line);
04730 IF word = "TRUE" THEN
04740 BEGIN
04750 INSPECT find_switch WHEN swi DO switch_value:= TRUE
04760 OTHERWISE NEW swi(variable,TRUE,neutral);
04770 END ELSE IF word = "FALSE" THEN
04780 BEGIN
04790 INSPECT find_switch WHEN swi DO switch_value:= FALSE
04800 OTHERWISE NEW swi(variable,FALSE,neutral);
04810 END ELSE
04820 error("""TRUE"" or ""FALSE"" expected after ""="".");
04830 END;
04840
04850 PROCEDURE error(t); NAME t; TEXT t;
04860 BEGIN COMMENT Error message printer;
04870 IF NOT inhibiterror THEN
04880 BEGIN
04890 outtext(editin_image_strip);
04900 outimage;
04910 outtext("%COCOS - "); outtext(t); outimage;
04920 END;
04930 GOTO evalend;
04940 END;
04950
04960 PROCEDURE swi_evaluate;
04970 BEGIN COMMENT Interpretation of line beginning with % or COMMENT%;
04980 uc_line:= after_number.sub(after_number.pos-1,
04990 after_number.length - after_number.pos+2);
05000 storbokstav(uc_line); uc_line.setpos(1);
05010 WHILE uc_line.more DO COMMENT convert tabs to spaces;
05020 BEGIN scanto(uc_line,tab);
05030 IF uc_line.more THEN uc_line.sub(uc_line.pos-1,1):= " ";
05040 END;
05050 uc_line.setpos(1);
05060 IF commentswitch THEN
05070 BEGIN
05080 IF scanto(uc_line,'%') NE "COMMENT" THEN
05090 GOTO evalend;
05100 END ELSE uc_line.setpos(2);
05110 IF NOT uc_line.more THEN GOTO evalend;
05120 swi_type:- scanto(uc_line,' ');
05130 IF swi_type == NOTEXT THEN
05140 error("No text after %");
05150 IF NOT uc_line.more THEN GOTO evalend;
05160 variable:- tagord(uc_line);
05170 inhibiterror:= NOT commentswitch;
05180 IF variable == NOTEXT THEN
05190 error("No variable after ""%"".");
05200 IF NOT letter(variable.getchar) THEN
05210 error("Variable name does not begin with letter.");
05220 COMMENT Yes, this was a proper COCOS command, please do the
05230 appropriate action;
05240 IF swi_type = "IF" THEN set_condition(yes)
05250 ELSE IF swi_type = "IFNOT" THEN set_condition(no)
05260 ELSE IF swi_type = "IFEND" OR swi_type = "ENDIF" THEN
05270 set_condition(neutral) ELSE
05280 IF swi_type = "COCOS" OR swi_type = "SWITCH" THEN
05290 create_variable ELSE
05294 error(
05301 "Expected ""IF"" OR ""IFNOT"" OR"" ""IFEND"" OR ""COCOS"".");
05310 inhibiterror:= FALSE;
05320 GOTO after_print;
05330 END;
05340
05350 COMMENT Start of execution, initialization;
05360 no:= 1; neutral:= 2; yes:= 3; tab:= char(9);
05370 switch_true:= TRUE;
05380 uc_line:- blanks(140);
05390 sysout.image:- blanks(140);
05400 outtext("COCOS - Conditional Compilation in SIMULA - Version 7807:");
05410 outimage;
05420
05430 COMMENT Read initial command string;
05440 COMMENT%IF DEC10;
05450 IF rescan THEN
05460 BEGIN
05464 inimage; IF sysin.endfile THEN GOTO finalexit;
05471 command:- sysin.image; scanto(command,'-');
05480 command:- from(command,command.pos).strip;
05490 IF command == NOTEXT THEN GOTO prompter;
05500 END ELSE prompter:
05510 BEGIN
05520 outchar('>'); breakoutimage;
05530 COMMENT%IFNOT DEC10;
05534 BEGIN prompter: outtext("Give command:"); outimage;
05550 COMMENT%IFEND DEC10;
05560 IF sysin.endfile THEN GOTO finalexit;
05564 switches:- NONE;
05564 COMMENT%IF DEC10;
05565 backf:-
05566 COMMENT%IFEND DEC10;
05567 inf:- outf:- NOTEXT;
05570 inimage; IF sysin.endfile THEN GOTO finalexit;
05580 command:- compress(storbokstav(sysin.image.strip),' ');
05590 END;
05600 IF command == NOTEXT THEN
05610 BEGIN outtext("Type ? for help."); outimage;
05620 GOTO prompter;
05630 END;
05650 IF command.getchar = '?' THEN
05660 BEGIN
05670 COMMENT%IF DEC10;
05674 outtext(
05681 "outfil.ext=infil.ext/variable1:value1/variable2:value2...");
05690 outimage;
05700 COMMENT%IFNOT DEC10;
05710 outtext("outfil=infil/variable1:value1/variable2:value2 ...");
05720 COMMENT%IFEND DEC10;
05730 outimage;
05740 GOTO prompter;
05750 END;
05760 command:- compress(storbokstav(command),' '); command.setpos(1);
05770 outf:- copy(scanto(command,'=').strip);
05780 inf:- copy(scanto(command,'/').strip);
05790 IF inf == NOTEXT THEN
05800 BEGIN inf:- outf;
05805 outtext("Assumming input file = "); outtext(inf); outimage;
05810 outtext("Give output file name: "); outimage;
05820 COMMENT%IF DEC10;
05830 outchar('>'); breakoutimage;
05840 COMMENT%IFEND DEC10;
05850 inimage; command:- compress(storbokstav(sysin.image),' ');
05860 outf:- copy(scanto(command,'/').strip);
05870 END;
05915 outf.setpos(1); inf.setpos(1);
05920 IF scanto(outf,'/') = scanto(inf,'/') THEN
05930 BEGIN
05931 OUTTEXT(
05935 "?COCOS - INFILE IS EQUAL TO OUTFILE. BEWARE!!!");
05941 OUTIMAGE;
05950 GOTO prompter;
05960 END;
06180 command:- copy(from(command,command.pos));
06190 WHILE command.more DO
06200 BEGIN
06210 variable:- scanto(command,':');
06220 IF NOT command.more THEN
06230 BEGIN outtext("%COCOS - no value for variable: ");
06232 outtext(variable); outimage;
06240 GOTO prompter;
06250 END;
06260 c:= command.getchar; scanto(command,'/');
06270 IF c = 'T' or c = 't' or c = 'Y' or c = 'y' THEN
06280 truthvalue:= TRUE ELSE IF c = 'N' or c = 'n' or c = 'F' or c = 'f'
06290 THEN truthvalue:= FALSE
06300 ELSE
06310 BEGIN outtext("%COCOS - Unknown value for variable: ");
06320 outtext(variable); outimage; GOTO prompter;
06330 END;
06340 INSPECT find_switch WHEN swi DO
06350 BEGIN outtext("%COCOS - multiply defined variable: ");
06360 outtext(variable); outimage; GOTO prompter;
06370 END OTHERWISE NEW swi(variable,truthvalue,neutral);
06380 END;
06390
06400 COMMENT Opening of the input text file;
06410 COMMENT%IF DEC10;
06420 editin:- findinfile(inf);
06430 IF editin == NONE THEN
06440 BEGIN outtext("?COCOS - cannot find input file: "); outtext(inf);
06450 outimage; GOTO prompter;
06460 END;
06470 COMMENT%IFNOT DEC10;
06480 editin:- NEW infile(inf);
06490 COMMENT%IFEND DEC10;
06500 editin.open(blanks(140));
06510 COMMENT First line must be read here to check if the input file is
06520 line numbered;
06530 editin.inimage; first_line_read:= TRUE;
06540 COMMENT%IF DEC10;
06550 line_numbered:= numbered;
06560 COMMENT%IFEND DEC10;
06570
06580 COMMENT%IF DEC10;
06581 INSPECT findinfile(outf) DO
06582 BEGIN
06583 backf:- copy(outf);
06584 IF scanto(backf,'.') == backf THEN backf:- conc(backf,".Q")
06585 ELSE IF backf.more THEN backf.putchar('Q') ELSE
06586 backf:- conc(backf,"Q");
06587 outtext("%COCOS renaming previous output file:");
06588 outimage; outchar('"');
06589 outtext(outf); outtext(""" to backup file name """);
06590 outtext(backf); outtext("""."); outimage;
06591 IF rename(backf,NOTEXT,TRUE) > 0 THEN
06592 BEGIN outtext("%COCOS - cannot delete file: "); outtext(backf);
06593 outimage; GOTO prompter;
06594 END;
06595 IF rename(THIS infile,backf,FALSE) > 0 THEN
06596 BEGIN outtext("%COCOS - cannot rename file """);
06597 outtext(outf); outtext(""" to backup name """);
06598 outtext(backf); outtext("""."); outimage;
06599 GOTO prompter;
06600 END;
06601 END;
06602 COMMENT%IFEND DEC10;
06603
06604 COMMENT Opening of the output text file;
06606 COMMENT%IF DEC10;
06608 COMMENT The output file is made line numbered if the input file was
06610 line numbered. You may prefer to add other options;
06620 COMMENT%IFEND DEC10;
06630 COMMENT%IF DEC10;
06640 IF line_numbered THEN outf:- conc(outf,"/NUMBERED");
06650 editout:- findoutfile(outf);
06660 IF editout == NONE THEN
06670 BEGIN outtext("?COCOS - cannot open output file: "); outtext(outf);
06680 outimage; GOTO prompter;
06690 END;
06700 COMMENT%IFNOT DEC10;
06710 editout:- NEW outfile(outf);
06720 COMMENT%IFEND DEC10;
06730 editout_image:- blanks(140); editout.open(editout_image);
06740
06750 after_number:- editin.image;
06760 COMMENT%IF DEC10;
06770 IF line_numbered THEN after_number:- after_number.sub(7,133);
06780 COMMENT%IFEND DEC10;
06790 WHILE TRUE DO
06800 BEGIN COMMENT Loop of reading successive lines in the file;
06810 editinimage;
06820 IF editin.endfile THEN GOTO close;
06830 after_number.setpos(1); c:= after_number.getchar;
06840 IF c = '%' THEN COMMENT % in column 1;
06850 BEGIN
06860 commentswitch:= FALSE;
06870 swi_evaluate;
06880 END ELSE
06890 BEGIN COMMENT Search for 'C' as first character in line except for
06900 spaces and tabs;
06910 commentswitch:= TRUE;
06920 GOTO entry;
06930 cloop: COMMENT Loop of scanning for first printable character;
06940 c:= after_number.getchar;
06950 entry: IF (c = ' ' OR c = tab) AND after_number.more
06960 THEN GOTO cloop;
06970 IF c = 'c' OR c = 'C' THEN swi_evaluate;
06980 evalend:
06990 END;
07000 IF switch_true THEN editoutimage(editin_image_strip);
07010 after_print:
07020 END;
07030 close:
07040 editin.close;
07050 editout.close;
07060 finalexit:
07070 END;
07080 END of the whole COCOS program;