Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0135/comp/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;