Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/23/simeio.sim
There is 1 other file named simeio.sim in the archive. Click here to see a list.
OPTIONS(/E/-A/-Q/-I/-D/C/P:"SAFEIO - System");

EXTERNAL REF (Infile) PROCEDURE findinfile;
EXTERNAL REF (Outfile) PROCEDURE findoutfile;
EXTERNAL TEXT PROCEDURE conc,upcase,frontstrip,rest,checkextension;
EXTERNAL CHARACTER PROCEDURE fetchar,findtrigger;
EXTERNAL LONG REAL PROCEDURE scanreal;
EXTERNAL INTEGER PROCEDURE checkreal,checkint,scanint,ilog;
EXTERNAL BOOLEAN PROCEDURE menu;
COMMENT --- CLASS SAFEIO --- Version 4.0
Date: 76-01-09
Author: Mats Ohlin
Swedish Research Institute of National Defence
FOA 1
Fack
S-104 50 STOCKHOLM 80
SWEDEN

The information in this document is subject to change without
notice. The institute assumes no responsibility for any errors that
may be present in this document. The described software is furnished
to the user for use on a SIMULA system. (SIMULA is a registered
trademark of the Norwegian Computing Center, Oslo, Norway).

Copyright 1975 by the Swedish Research Institute for National Defence.
Copying is allowed.
----------------------------------------------------------------------

SIMEIO is a SIMULA class which is designed to faciliate the
programming of conversational parts of SIMULA programs.
For more information, see SAFEIO.HLP and SAFEIO.DOC.
;

Simulation CLASS simeio(savefilename,language);   VALUE savefilename,language;
TEXT savefilename,language;
VIRTUAL: PROCEDURE special;   LABEL eof;
BEGIN



    PROCEDURE printint(i);   INTEGER i;
    COMMENT Printint prints the integer i without leading spaces
    on Sysout in Putfrac(i,0) format. ;
    BEGIN
	Outtext(fracput(i))
    END of printint;
    	
    PROCEDURE printreal(x);   REAL x;
    COMMENT Printreal prints the value of the real variable x
    without leading spaces.
    If Abs(x) is in the range (E-4,E8) the fixed point format will
    be used so that 8 significant digits are typed out. Else the
    Putreal format with 8 significant digits will be used. ;
    BEGIN   Outtext(realput(x));  END of printreal;

    	
    TEXT PROCEDURE fracput(i);   INTEGER i;
    COMMENT Fracput returns a text containing
    the value of the integer i without leading spaces
    in Putfrac(i,0) format. ;
    BEGIN   u.Putfrac(i,0);
	fracput:- Copy(frontstrip(u))
    END of fracput;

    TEXT PROCEDURE intput(i);   INTEGER i;
    COMMENT Intput returns a text containing
    the value of the integer i without leading spaces. ;
    BEGIN    u.Putint(i);
	intput:- Copy(frontstrip(u))
    END of intput;

    TEXT PROCEDURE realput(x);   REAL x;
    BEGIN
	IF x = 0 THEN u.Putfix(x,0) ELSE
	IF Abs(x) >= &8 THEN u.Putreal(x,8) ELSE
	IF Abs(x) >= &-4 THEN u.Putfix(x,8-ilog(x)) ELSE
	u.Putreal(x,8);
	realput:- Copy(frontstrip(u))
    END of realput;

    PROCEDURE outline(t);   VALUE t;   TEXT t;
    BEGIN
	WHILE t.Length > Length DO
	BEGIN   Outtext(t.Sub(1,Length));
	    t:- t.Sub(Length+1,t.Length-Length)
	END loop;
	Outtext(t);   Outimage;
    END of outline;

    BOOLEAN PROCEDURE irange(test,low,high);   INTEGER test,low,high;
    irange:= low <= test AND test <= high;

    BOOLEAN PROCEDURE range(test,low,high);   REAL test,low,high;
    range:= low <= test AND test <= high;

    TEXT PROCEDURE outofrange(low,high);   REAL low,high;
    outofrange:- conc(message[83],realput(low),
    ",",realput(high),"].");

    TEXT PROCEDURE outofirange(low,high);   INTEGER low,high;
    outofirange:- conc(message[83],intput(low),
    ",",intput(high),"].");

    BOOLEAN PROCEDURE commandhelp(table,n);   TEXT ARRAY table;   INTEGER n;
    BEGIN  INTEGER i;
	Outtext(message[84]);   Outimage;
	FOR i:= 1 STEP 1 UNTIL n DO
	BEGIN   Outtext(table[i]);
		IF Pos < Length//2 THEN Setpos(Length//2)
		ELSE Outimage;
	END;
	Outimage
    END of commandhelp;

    TEXT PROCEDURE commandmessage(index);   INTEGER index;
    commandmessage:-
    IF index = 0 THEN message[85] ELSE message[86];

    PROCEDURE special;
    ! The programmer may specify his own procedure special (with exactly
    ! that name and no parameter. Since it is virtual the local procedure
    ! will be called when the user types in '!%'.
    ! Note that the programmer may implement code for analysing the rest
    ! of the currentfile.image following the '!%'.
    ! Note also that the special procedure may call other procedures
    ! which in turn may have parameters.
    ! This declaration has the sole purpose of avoiding run time error
    ! ("No virtual match") if the programmer hasn't declared his
    ! own special procedure. ;
    BEGIN   Outtext(message[1]);   Outimage   END;

    PROCEDURE cmdclose;
    ! This procedure closes all open input SAFEIO files.
    ! If no input file is used a message is printed. ;
    IF currentitem.file == Sysin THEN
    BEGIN   Outtext(message[2]);   Outimage   END ELSE
    WHILE currentitem.file =/= Sysin DO currentitem.down;

    PROCEDURE recordclose;
    ! This procedure will close the recording (log) file.
    ! If no recordfile is open no action is taken. ;
    BEGIN
	IF recordfile =/= NONE THEN
	BEGIN
	    IF trace THEN
	    BEGIN   Outtext(message[3]);   Outtext(recordname);
		Outchar(']');   Outimage;
	    END trace;
	    recordfile.Setpos(1);
	    recordfile.Close;   recordfile:- NONE
	END;

    END of recordclose;

    PROCEDURE recordappend;
    ! This procedure closes the current recording file and opens it
    ! again in append mode. The programmer may insert class to recordappend
    ! whenever he wants this kind of checkpoint. The user may call the
    ! procedure by typing in '!+'. ;
    IF recordfile == NONE THEN
    BEGIN   Outtext(message[4]);
	Outimage
    END ELSE
    BEGIN   recordfile.Setpos(1);   recordfile.Close;
	recordfile:- NEW Outfile(conc(message[5],recordname,message[6]));
	recordfile.Open(record_buffer);
	IF trace THEN
	BEGIN   Outtext(message[7]);   Outtext(recordname);
	    Outtext(message[8]);   Outimage
	END trace
    END of recordappend;

    CLASS fileitem(file,filename,wait);   VALUE filename;   TEXT filename;
    ! Class fileitem describes the elements in the input file stack.
    ! Since input file calls ('!<' and '!_') may be nested we need this
    ! class. The currentitem (REF (fileitem) )  always points at the top
    ! of the stack. Usually the currentfile (REF (Infile) ) points at
    ! currentitem.file. However when an illegal or unvalid input has been
    ! read the currentfile will temporarly be switched to Sysin.
    ! The filename is used to remember the filenames of the input files.
    ! The wait attribute flags the wait/nowait state of the input
    ! operations. ;
    REF (Infile) file;   BOOLEAN wait;
    BEGIN   REF (fileitem) p,s;

	PROCEDURE up(x);   REF (fileitem) x;
	! The procedure up will add a new input file to the stack.
	! The new file will be opened. ;
	BEGIN   s:- x;   x.p:- THIS fileitem;
	    IF trace THEN
	    BEGIN
		Outtext(message[9]);
		Outchar(IF x.wait THEN cmdchar ELSE cmdnowaitchar);
		Outtext(x.filename);   Outchar(']');   Outimage;
	    END trace;
	    currentitem:- x;   x.file.Open(cmd_buffer);
	    waitforsysin:= x.wait
	END of up;

	PROCEDURE down;
	! This procedure removes the top element of the
	! stack if not equal to Sysin (when a message will be issued). ;
	IF file == Sysin THEN
	BEGIN   Outtext(message[10]);   Outimage;
	    GO TO eof
	END ELSE
	BEGIN  file.Close;   cmdcount:= cmdcount - 1;
	    IF trace THEN
	    BEGIN   Outimage;
		Outtext(message[11]);   Outtext(filename);
		Outtext(message[12]);
		Outchar(IF p.wait THEN cmdchar ELSE cmdnowaitchar);
		Outtext(p.filename);   Outchar('(');
		printint(cmdcount);   Outtext(")]");   Outimage;
	    END trace ELSE
	    IF p.file == Sysin THEN
	    BEGIN   Outtext(message[13]);   Outimage   END;
	    currentfile:- p.file;   currentitem:- p;   waitforsysin:= p.wait;
	    p.s:- NONE;   p:- NONE;
	END OF DOWN;

    END OF FILEITEM;

    BOOLEAN PROCEDURE nohelp;   outline(message[14]);
    ! The nohelp procedure issues a message that no special help
    ! information is available. The programmer is however encouraged to
    ! define his specific help procedures when using
    ! the request procedure. ;

    BOOLEAN PROCEDURE help(message);   NAME message;   TEXT message;
    ! This procedure will have the side effect of displaying the
    ! text MESSAGE on Sysout.;
    IF message.Length <= Length THEN
    BEGIN   Outtext(message);   Outimage   END ELSE
    BEGIN   TEXT t;   INTEGER i;
	t:- Copy(message);
	WHILE t.Length > Length DO
	BEGIN
	    FOR i:= Length STEP -1 UNTIL 2 DO
	    IF fetchar(t,i) = ' ' THEN GO TO blankfound;
	    i:= Length;
	    blankfound:   Outtext(t.Sub(1,i));
	    t:- t.Sub(i+1,t.Length-i);
	END loop;
	Outtext(t);   Outimage
    END of help;

    OPTIONS(/P);
    BOOLEAN PROCEDURE intinput(result,valid);
    ! This procedure checks that the rest of the currentfile.image
    ! contain exactly one integer item (and nothing more).
    ! If so the syntaxok will be flagged true (so that the errormessage in
    ! request may be printed) and the intinput will return the value of
    ! the dynamically evaluated parameter valid (which usually is a boolean
    ! expression). Otherwise a message will be issued and the syntaxok will
    ! will be flagged false. ;
    NAME result,valid;   INTEGER result;   BOOLEAN valid;
    BEGIN   INTEGER p,x;

	p:= currentfile.Pos;
	x:= scanint(currentfile.Image);
	IF currentfile.Pos > p AND rest(currentfile.Image).Strip == NOTEXT THEN
	BEGIN
	    result:= x;
	    syntaxok:= TRUE;
	    intinput:= IF checkvalidity THEN valid ELSE TRUE
	END ELSE
	BEGIN   Outtext(message[15]);
	    outline(currentfile.Image.Sub(p,currentfile.Length-p+1).Strip);
	    syntaxok:= FALSE
	END error

    END of intinput;

    BOOLEAN PROCEDURE realinput(result,valid);
    ! This procedure checks a real item. Otherwise as intinput. ;
    NAME result,valid;   REAL result;   BOOLEAN valid;
    BEGIN   INTEGER p;   REAL x;
	p:= currentfile.Pos;
	x:= scanreal(currentfile.Image);
	IF
	currentfile.Pos > p AND rest(currentfile.Image).Strip == NOTEXT
	THEN
	BEGIN   currentfile.Setpos(p);
	    result:= x;
	    syntaxok:= TRUE;
	    realinput:= IF checkvalidity THEN valid ELSE TRUE
	END ELSE
	BEGIN   syntaxok:= FALSE;
	    Outtext(message[16]);
	    outline(currentfile.Image.Sub(p,currentfile.Length-p+1).Strip)
	END error

    END of realinput;

    BOOLEAN PROCEDURE longrealinput(result,valid);
    ! This procedure checks a real item in double
    ! precision. The syntax checking does not differ form that in realinput,
    ! but the result parameter is long real so that long results may be
    ! returned. ;
    NAME result,valid;   LONG REAL result;   BOOLEAN valid;
    BEGIN   INTEGER p;   LONG REAL x;

	p:= currentfile.Pos;
	x:= scanreal(currentfile.Image);
	IF
	currentfile.Pos > p AND rest(currentfile.Image).Strip == NOTEXT
	THEN
	BEGIN   currentfile.Setpos(p);
	    result:= x;
	    syntaxok:= TRUE;
	    longrealinput:= IF checkvalidity THEN valid ELSE TRUE
	END ELSE
	BEGIN   syntaxok:= FALSE;
	    Outtext(message[17]);
	    outline(currentfile.Image.Sub(p,currentfile.Length-p+1).Strip)
	END error

    END of longrealinput;

    BOOLEAN PROCEDURE boolinput(result);   NAME result;   BOOLEAN result;
    ! The boolinput procedure has one parameter only. The validity check
    ! is of course unnecessary for boolean parameters.
    ! Accepted input depends on the content in the SAFEIO.language file.
    ! The input line may have lower case letters.
    ! In the English case it is YES, NO, TRUE OR FALSE.
    ! P} svenska g{ller JA, NEJ, SANN eller FALSK.;
    BEGIN   TEXT t;   CHARACTER c;
	t:- upcase(rest(currentfile.Image).Strip);
	IF t.Length = 1 THEN c:= t.Getchar;
	syntaxok:= TRUE;	! Allow errormessage to be issued.;
	GO TO
	IF c = 'Y' OR c = 'J' THEN l_true ELSE
	IF c = 'N' THEN l_false ELSE
	IF t = message[18] THEN l_false ELSE
	IF t = message[19] THEN l_true ELSE
	IF t = message[20] THEN l_true ELSE
	IF t = message[21] THEN l_false ELSE
	error;
	l_true:
	boolinput:= result:= TRUE;   GO TO exit;

	l_false:
	boolinput:= TRUE;   result:= FALSE;   GO TO exit;

	error:
	Outtext(message[22]);   outline(t);   syntaxok:= FALSE;

	exit:

    END of boolinput;

    BOOLEAN PROCEDURE textinput(result,valid);
    ! This procedure returns a copy of the stripped rest of the input line.
    ! The syntax is always considered correct.;
    NAME result,valid;   TEXT result;   BOOLEAN valid;
    BEGIN
	result:- Copy(rest(currentfile.Image).Strip);
	syntaxok:= TRUE;   textinput:= IF checkvalidity THEN valid ELSE TRUE

    END of textinput;

    OPTIONS(/P);
    PROCEDURE request(prompt,default,inputok,errormessage,help);
    ! The request procedure has the following parameters:
    ! Prompt	is the prompting question, often ending with a
    !		prompting character as ':'.
    ! Default	is the default text value. If default action is to be
    !		prohibited, the nodefault variable should be used.
    ! Inputok	shall become true if the input is to be accepted,
    !		else false. Usually the actual parameter is a call to
    !		an ***input procedure.;
    ! Errormessage is a text that will be printed if inputok is
    !		is false and syntaxok is true (c.f. comment for intinput).
    ! Help	is a BOOLEAN parameter by NAME which will
    !		be evaluated when the user types a '?'.
    !;
    VALUE prompt;   NAME default,errormessage,inputok,help;
    TEXT prompt,default,errormessage;   BOOLEAN inputok,help;
    BEGIN   INTEGER p;   TEXT u;

	mainprompt:- prompt;   reqcount:= reqcount + 1;
	IF reqcount > 1 AND recordfile =/= NONE THEN
	BEGIN   Outtext(message[87]);   Outimage;   END warning;
	IF NOT inputsaved THEN currentfile.Setpos(0);

	inputsaved:= FALSE;   GO TO start;

	WHILE NOT inputok AND (IF syntaxok THEN NOT overrideflag ELSE TRUE) DO
	BEGIN   currentfile.Setpos(0);   currentfile:- Sysin;
	    IF syntaxok THEN
	    BEGIN   Outtext(errormessage);   Outimage   END;
	    GO TO mustprompt;

	    start:
	    IF displayprompt THEN   mustprompt:  Outtext(prompt);

	    IF displaydefault AND default =/= nodefault THEN
	    BEGIN   Outchar(defaultquote);   Outtext(default);
		Outchar(defaultquote);   Outchar(promptingchar);
	    END display default;

	    noprompt:
	    overrideflag:= FALSE;

	    IF Pos > 1 THEN
	    BEGIN
		IF Pos < margin THEN Setpos(margin);   Breakoutimage
	    END;

	    u:- rest(currentfile.Image);
	    IF u.Strip == NOTEXT THEN
	    BEGIN
		IF currentfile.Endfile THEN
		BEGIN   currentitem.down;   GO TO mustprompt  END;
		currentfile.Inimage;
		u:- currentfile.Image
	    END ELSE IF FALSE THEN  continue:  u:- rest(currentfile.Image);


	    ! Ignore lines ending with char 11(VT), 12(FF).;
	    FOR p:= IF u.Strip =/= NOTEXT THEN
	    Rank(u.Sub(u.Strip.Length,1).Getchar) ELSE 0
	    WHILE p = 11 OR p = 12 DO
	    BEGIN
		IF currentfile.Endfile THEN
		BEGIN   currentitem.down;   GO TO mustprompt  END;
		currentfile.Inimage;
		u:- currentfile.Image
	    END;

	    IF u.Strip == NOTEXT THEN
	    BEGIN
		IF default == nodefault THEN
		BEGIN   Outtext(message[23]);   Outimage;
		    currentfile:- Sysin;   GO TO mustprompt
		END no default allowed;

		! Note the implicit restriction on length
		! of the default text. ;
		u:= IF default.Length > u.Length THEN
		default.Sub(1,u.Length) ELSE  default;

	    END empty input ELSE
	    test: switchtest(mustprompt,noprompt,continue,help);

	    p:= currentfile.Pos;

	    ! If input from disk and displayinput is true then
	    ! print input value. ;
	    IF displayinput AND currentfile =/= Sysin THEN
	    BEGIN   Outtext(currentfile.Image.Sub(p,currentfile.Length-p+1).Strip);
		IF waitforsysin THEN
		BEGIN   Outtext(message[24]);   Breakoutimage  END  ELSE Outimage
	    END display input value;

	    ! Check Sysin actions: ;
	    IF waitforsysin AND currentfile =/= Sysin THEN
	    BEGIN  Inimage;
		currentfile.Setpos(p);
		IF Sysin.Image.Strip =/= NOTEXT THEN
		BEGIN   currentfile:- Sysin;
		    GO TO test
		END overriding cmd answer
	    END wait for sysin ok;

	END input ok loop;

	! Save in recordfile if not NONE. ;
	INSPECT recordfile DO
	BEGIN
	    ! May have been some Sysin overriding input since last time. ;
	    IF Pos > 1 THEN BEGIN   Image:= NOTEXT;   Setpos(1)  END;
	    Outchar(switchchar);   Outchar(switchchar);
	    Outint(prompt.Length+7,3);   Outchar(Char(9));
	    Outtext(prompt);
	    IF overrideflag THEN
	    BEGIN   Outchar(switchchar);   Outchar(overridechar)    END;
	    Outtext(currentfile.Image.Sub(p,currentfile.Length-p+1).Strip);
	END recording;

	! Restore currentfile.Image since REQUEST may have been
	! called recursively.;

	currentfile.Setpos(0);
	currentfile:- currentitem.file;
	! C.f. procedure switchtest. ;
	IF NOT inputsaved THEN currentfile.Setpos(0);
	INSPECT recordfile DO
	BEGIN   Outimage;
	    IF reqcount NE 1 THEN
	    BEGIN
		Outtext(message[88]);   Outint(reqcount,2);
		Outimage;
	    END warning;
	END inspect;

	reqcount:= reqcount - 1;

    END of request;

    PROCEDURE nooverride;   overridechar:= switchchar;
    ! A call of nooverride shortcircuits the '!&' override validity test
    ! facility. See procedure switchtest. ;

    OPTIONS(/P);
    PROCEDURE switchtest(mustprompt,noprompt,continue,helpvar); 
    ! This procedure takes care of all input lines starting with '!' or '?'. ;
    NAME helpvar;   LABEL mustprompt,noprompt,continue;    BOOLEAN helpvar;
    BEGIN   CHARACTER c;   INTEGER startpos;   BOOLEAN dummy;

	PROCEDURE toggle(switch_,string);   NAME switch_,string;
	! Change a switch value and tell the user. ;
	BOOLEAN switch_;   TEXT string;
	BEGIN   switch_:= NOT switch_;   Outtext(message[25]);
	    Outtext(string);   Outtext(message[26]);
	    Outtext(IF switch_ THEN message[27] ELSE message[28]);   Outimage;

	END of toggle;

	BOOLEAN PROCEDURE synchelp;
	! Printing information concerning syncronization question. ;
	BEGIN   Outtext(message[29]);
	    Outimage;   Outtext(message[30]);
	    Outimage;   Outtext(message[31]);
	    Outimage;   Outtext(message[32]);
	    Outchar(promptingchar);   Outtext(message[33]);
	    Outimage;
	END of synchelp;

	IF currentfile.Lastitem THEN
	BEGIN   currentitem.down;   GO TO exit   END of file;

	c:= currentfile.Inchar;

	! Call help if input line starts with ?. ;
	IF c = helpchar THEN
	BEGIN   IF helpvar THEN ;   GO TO exit  END;

	IF c = switchchar THEN
	BEGIN
	    c:= currentfile.Inchar;
	    IF c = ' ' THEN GO TO exit;
	    IF c = switchchar THEN
	    BEGIN   posfield:- currentfile.Image.Sub(3,3);
		! Reading the position where the answer starts. ;
		IF checkint(posfield) = 1 THEN
		BEGIN   startpos:= posfield.Getint;
		    IF startpos < 7 OR startpos > currentfile.Length THEN GO TO exit;
		    ! Compare input file question with current question. ;
		    IF (IF checkprompt AND currentfile =/= Sysin THEN
		    mainprompt NE currentfile.Image.Sub(7,startpos-7)
		    ELSE FALSE) THEN
		    BEGIN   REF (Outfile) savefile;   CHARACTER savechar;
			TEXT ARRAY table[1:3];   TEXT command;
			INTEGER action,oldcount,nskip;
			BOOLEAN savedisplay,saveprompt;
			PROCEDURE restore;
			BEGIN
			    switchchar:= savechar;   recordfile:- savefile;
			    displayinput:= savedisplay;   displayprompt:= saveprompt;
			END of restore;

			table[1]:- message[79];   table[2]:- message[80];
			table[3]:- message[81];
			Outtext(message[34]);
			Outimage;   Outtext(message[35]);
			Outtext(currentfile.Image.Sub(7,currentfile.Length-6).Strip);
			Outchar(']');   Outimage;
			currentfile:- Sysin;
			! Save possibly recording file and shortcircuit
			! the '!' facilities for this question. ;
			! Save also the displayinput value. ;
			! As well as the displayprompt value. ;
			! And the reqcount value. ;
			savefile:- recordfile;   recordfile:- NONE;
			savechar:= switchchar;   switchchar:= ' ';
			savedisplay:= displayinput;   displayinput:= TRUE;
			saveprompt:= displayprompt;   displayprompt:= TRUE;
			oldcount:= reqcount;   reqcount:= 0;
			request(message[36],nodefault,
			textinput(command,menu(command,action,table,3)),
			message[37],synchelp);
			IF action = 2 THEN
			BEGIN   currentfile:- Sysin;
			    request("How many records:","1",intinput(nskip,
			    nskip >=1),"? Must be >= 1.",
			    help("Enter number of records to be replaced."));
			END;
			FOR nskip:= nskip - 1 WHILE nskip > 0 DO
			BEGIN   IF currentfile.Endfile THEN
			    BEGIN   currentitem.down;   restore;
				   GO TO mustprompt
			    END;
				currentfile.Inimage;
			END loop;
			! .. and restore as before. ;
		restore;
			reqcount:= oldcount;
			! If action =  1  : use input file still (accept).
			! If action =  2  : replace input with Sysin
			! for this question.
			! If action =  3  : save input line for next question.;
			inputsaved:= action = 3;
			IF action >= 2 THEN
			BEGIN   currentfile:- Sysin;
			    currentitem.file.Setpos(action-2);
			    GO TO mustprompt
			END >= 2;
			! Still using startpos since action = 1 ;
		    END no syncronization;
		    currentfile.Setpos(startpos);
		    GO TO continue
		END ELSE GO TO exit;
	    END ELSE
	    IF c = recordchar THEN recordswitch ELSE
	    IF c = cmdchar OR c = cmdnowaitchar THEN cmdswitch(c,continue) ELSE
	    IF c = closechar THEN cmdclose ELSE
	    IF c = displaychar THEN toggle(displaydefault,message[38]) ELSE
	    IF c = tracechar THEN toggle(trace,message[39]) ELSE
	    IF c = promptswitchchar THEN toggle(displayprompt,message[40]) ELSE
	    IF c = helpchar THEN BEGIN   switchhelp;   GO TO exit  END ELSE
	    IF c = appendchar THEN recordappend ELSE
	    IF c = inputchar THEN
	    BEGIN   toggle(displayinputvalue,message[41]);
		displayprompt:= displaydefault:= displayinputvalue;
	    END ELSE
	    IF c = specialchar THEN special ELSE
	    IF c = overridechar THEN
	    BEGIN   overrideflag:= TRUE;   GO TO continue   END ELSE
	    IF c = commentchar THEN   outline(currentfile.Image.Strip) ELSE
	    BEGIN  exit:    currentfile.Setpos(0);   GO TO mustprompt   END;

	    currentfile.Setpos(0);
	    GO TO noprompt

	END c = switchchar ELSE currentfile.Setpos(currentfile.Pos-1);

    END of switchtest;

    OPTIONS(/P);
    PROCEDURE switchhelp;
    ! This procedure prints information on the SAFEIO ! commands. ;
    BEGIN   CHARACTER exclam;
	PROCEDURE charout(c,t);   NAME t;   TEXT t;   CHARACTER c;
	BEGIN   Outchar(exclam);   Outchar(c);   Outtext(message[42]);
	    Outtext(t);   Outimage
	END of charout;

	PROCEDURE switchout(c,t,sw);   NAME t;   CHARACTER c;   TEXT t;
	BOOLEAN sw;
	BEGIN   Outchar(exclam);   Outchar(c);   Outtext(message[43]);
	    Outtext(t);   Outtext(message[44]);
	    Outtext(IF sw THEN message[45] ELSE message[46]);    Outimage
	END switchout;

	Outtext(message[47]);   Outimage;   Eject(Line+1);
	charout(helpchar,message[48]);
	Eject(Line+1);   Outtext(message[49]);   Outchar(switchchar);
	Outimage;   Eject(Line+1);
	exclam:= switchchar;
	switchout(promptswitchchar,message[50],displayprompt);
	switchout(displaychar,message[51],displaydefault);
	switchout(inputchar,message[52],displayinputvalue);
	switchout(tracechar,message[53],trace);
	charout(appendchar,message[54]);
	charout(commentchar,message[55]);
	charout(specialchar,message[56]);
	! Will be printed only if not shortcircuited. ;
	IF overridechar NE switchchar THEN
	charout(overridechar,message[57]);
	Outchar(exclam);   Outchar(cmdchar);
	Outtext(message[58]);
	Outtext(defaultextension);   Outimage;
	charout(cmdnowaitchar,message[59]);
	charout(cmdchar,message[60]);
	charout(closechar,message[61]);
	Outchar(exclam);   Outchar(cmdnowaitchar);
	Outtext(message[62]);
	Outtext(defaultextension);   Outimage;
	Outchar(exclam);   Outchar(recordchar);
	Outtext(message[63]);
	Outtext(defaultextension);   Outimage;
	charout(recordchar,message[64]);
	charout(helpchar,message[65]);
	Eject(Line+1);
	Outtext(message[66]);
	Outchar(switchchar);   Outtext(message[67]);
	Outimage;   Eject(Line+1)


    END of switchhelp;

    OPTIONS(/P);
    PROCEDURE cmdswitch(c,continue);   CHARACTER c;   LABEL continue;
    ! This procedure takes care of !< and !_ commands. ;
    BEGIN   TEXT cmdname;
	cmdname:- rest(currentfile.Image).Strip;
	currentfile.Setpos(0);

	IF cmdname == NOTEXT THEN
	! No file name given. ;
	BEGIN
	    IF currentitem.file == Sysin THEN
	    BEGIN   Outtext(message[68]);
		Outimage;   currentfile:- currentitem.file
	    END ELSE
	    IF c = cmdnowaitchar THEN
	    BEGIN
		! Change to nowait input mode. ;
		BEGIN    waitforsysin:= FALSE;   currentfile.Setpos(0);
		    currentfile:- currentitem.file;   GO TO continue;
		END;
	    END ELSE
	    ! Close current input file:; currentitem.down
	END ELSE
	! File name was given. ;
	BEGIN
	    cmdname:- checkextension(cmdname,defaultextension);
	    IF cmdcount = maxcmdfiles THEN
	    BEGIN
		Outtext(message[82]);    Outimage
	    END ELSE
	    BEGIN   REF (Infile) x;
		cmdcount:= cmdcount + 1;
		x:- findinfile(cmdname);
		IF x == NONE THEN
		BEGIN   Outtext(message[89]);   Outtext(cmdname);
		    Outtext(message[91]);   Outimage
		END ELSE
		BEGIN
		    IF trace THEN
		    BEGIN   Outtext(message[69]);   Breakoutimage   END;
		    currentitem.up(NEW fileitem(x,cmdname,c = cmdchar));
		    currentfile:- currentitem.file
		END input ok;
	    END new cmd file;
	END new cmd file;

    END of cmdswitch;

    PROCEDURE recordswitch;
    ! This procedure takes care of the !> command. ;
    BEGIN   TEXT oldname;

	oldname:- recordname;
	recordname:- Copy(rest(currentfile.Image).Strip);
	currentfile.Setpos(0);

	IF recordname == NOTEXT THEN
	! No file name given. ;
	BEGIN
	    IF recordfile =/= NONE THEN
	    ! Close it. ;
	    BEGIN    recordfile.Setpos(1);
		recordfile.Close;   recordfile:- NONE;
		IF trace THEN
		BEGIN   Outtext(message[70]);   Outtext(oldname);
		    Outchar(']');   Outimage
		END trace
	    END active record file ELSE
	    ! No active file to close. ;
	    BEGIN   Outtext(message[71]);   Outimage   END no file
	END notext ELSE
	! File name was given. ;
	BEGIN
	    IF recordfile =/= NONE THEN
	    ! Already recording. ;
	    BEGIN   Outtext(message[72]);   Outtext(oldname);
		Outtext(message[73]);   Outimage;
		recordname:- oldname
	    END active record file ELSE
	    ! Open new recording file. ;
	    BEGIN
		recordname:- checkextension(recordname,defaultextension);
		recordfile:- findoutfile(conc(message[74],recordname));
		IF recordfile == NONE THEN
		BEGIN   Outtext(message[90]);
		    Outtext(recordname);   Outtext(message[91]);
		    Outimage
		END impossible ELSE
		BEGIN
		    recordfile.Open(record_buffer);
		    IF trace THEN
		    BEGIN   Outtext(message[75]);
			Outtext(recordname);   Outchar(']');
			Outimage
		    END trace
		END log ok
	    END was no active record file
	END file name given

    END of recordswitch;

    PROCEDURE closefiles;
    ! Close all open input and recording SAFEIO files. ;
    BEGIN
	recordclose;
	WHILE currentitem.file =/= Sysin DO currentitem.down;
    END of closefiles;

    PROCEDURE readmessages;
    ! Reads an input file containing SAFEIO messages.
    ! Currently two files are available: SAFEIO.ENG and SAFEIO.SWE
    ! for english and swedish texts respectively.
    ! If no such files exists on the user's area, the SYS: files
    ! will be used.
    ! Parameter "own.fra" will use the file "OWN.FRA".
    ! The parameter "own" will use a file OWN.ENG on your own disk
    ! area. SAFEIO("","") will create no log file and use the SAFEIO.ENG
    ! file on the SYS: area. ;
    BEGIN   REF (Infile) languagefile;   BOOLEAN sys_tried;
	INTEGER i;

	language:-
	frontstrip(language.Strip);
	IF language == NOTEXT THEN
	language:- Copy("SAFEIO.ENG");

	WHILE language.More DO
	IF language.Getchar = '.' THEN GO TO lookup;
	! Add default file name:;
	language.Setpos(1);
	WHILE language.More DO
	IF language.Getchar = ':' THEN
	GO TO colonfound;
	language:- conc("SAFEIO.",language);
	GO TO lookup;
	colonfound:
	language:- conc( language.Sub(1,language.Pos-1),
	    "SAFEIO.",rest(language));

	lookup:
	languagefile:- findinfile(language);
	INSPECT languagefile DO
	BEGIN   Open(Blanks(80));   Inimage;
	    i:= 0;
	    FOR i:= i + 1 WHILE NOT Endfile AND i <= 91 DO
	    BEGIN   message[i]:- Copy(Image.Sub(2,Image.Strip.Length-2));
		Inimage
	    END endfile loop;
	    Close
	END inspect OTHERWISE
	BEGIN
	    IF sys_tried THEN
	    BEGIN   Outtext("? Unknown language:");   Outtext(language);
		Outimage;   Outtext("ENGLISH used.");   Outimage;
		language:- Copy("sys:SAFEIO.ENG");
		GO TO lookup
	    END ELSE
	    BEGIN   sys_tried:= TRUE;
		WHILE language.More DO
		IF language.Getchar = '[' THEN
		BEGIN   language:- language.Sub(1,language.Pos-2);
		    GO TO out
		END;
		out:   language:- conc("SYS:",language);
		GO TO lookup
	    END sys trial
	END unsuccessfull lookup;

    END of readmessages;

    OPTIONS(/P);
    REF (Infile) currentfile;   REF (fileitem) currentitem;
    TEXT cmd_buffer,mainprompt,recordname,record_buffer,
    nodefault,defaultextension,posfield,u;
    TEXT ARRAY message[1:91];
    BOOLEAN trace,syntaxok,displayprompt,displayinput,displaydefault,
    inputsaved,checkprompt,overrideflag,waitforsysin,checkvalidity;
    REF (Outfile) recordfile;
    INTEGER margin,cmdcount,maxcmdfiles,reqcount;
    CHARACTER cmdchar,recordchar,displaychar,tracechar,promptswitchchar,
    switchchar,cmdnowaitchar,helpchar,inputchar,promptingchar,defaultquote,
    closechar,commentchar,appendchar,specialchar,overridechar;

    ! Length of images may be increased. ;
    u:- Blanks(20);
    maxcmdfiles:= 10;
    cmd_buffer:- Blanks(IF Length > 80 THEN Length ELSE 80);
    record_buffer:- Blanks(cmd_buffer.Length);

    readmessages;

    ! Set up initial values. ;

    nodefault:- message[76];    defaultextension:- message[77];

    checkprompt:= checkvalidity:=
    syntaxok:= displaydefault:= displayprompt:= displayinput:= trace:= TRUE;

    currentfile:- Sysin;
    currentitem:- NEW fileitem(currentfile,message[78],waitforsysin);

    ! May be changed to zero if no indentation of answers
    ! is wanted. Could also be increased if very long questions. ;
    margin:= 35;

    ! All these characters may be changed. However be
    ! carefull for clashes. See procedure switchtest about the
    ! testing order. Note the possibility to shortcircuit a facility
    ! by setting the corresponding character to ' '. ;

    cmdchar:= '<';
    recordchar:= '>';
    helpchar:= '?';
    displaychar:= '/';
    tracechar:= '[';
    promptswitchchar:= '*';
    inputchar:= '=';
    switchchar:= '!';
    cmdnowaitchar:= '_';
    defaultquote:= '/';
    promptingchar:= ':';
    specialchar:= '%';
    overridechar:= '&';
    appendchar:= '+';
    commentchar:= ';';
    closechar:= '^';

    ! Initializing recordfile from start. ;
    IF savefilename =/= NOTEXT THEN
    BEGIN   Sysin.Image:= savefilename;   Sysin.Setpos(1);
	recordswitch;   Sysin.Setpos(0);
    END;

    ! Eliminating page skipping on Sysout. ;
    INSPECT Sysout WHEN Printfile DO Linesperpage(-1);

    start: ;
    INNER;

    ! Jumped here if End of File on Sysin:;
    eof:
    closefiles;

END of simeio;