(* ----------------------------------------------------------------------------
 * $Id: MASBIOS.mi,v 1.13 1996/06/08 18:26:51 pesch Exp $
 * ----------------------------------------------------------------------------
 * This file is part of MAS.
 * ----------------------------------------------------------------------------
 * Copyright (c) 1989 - 1995 Universitaet Passau
 * ----------------------------------------------------------------------------
 * $Log: MASBIOS.mi,v $
 * Revision 1.13  1996/06/08 18:26:51  pesch
 * Removed unused code, minor corrections.
 *
 * Revision 1.12  1996/06/08 14:18:54  kredel
 * Changed Stream x closed successfully.
 *
 * Revision 1.11  1995/11/04  20:39:58  pesch
 * Renamed massignal.m? to massig.m? because of conflict with MASSIGNAL.m?
 * on certain OS.
 *
 * Revision 1.10  1995/10/13 16:02:04  pesch
 * Fixed error: sigsetmask() at wrong places caused SIGUSR1 to be blocked
 *              permanently.
 *
 * Revision 1.9  1995/09/12  17:22:48  pesch
 * Signal handling function are now declared in massignal.
 * Action has been changed according to ANSI C.
 * signal.* and massignal.* have been removed, the former because of
 * name clash with signal.h.
 *
 * Revision 1.8  1995/03/23  15:52:56  pesch
 * Improved error handling for ReadOpen and WriteOpen.
 * Reformatted import lists.
 *
 * Revision 1.7  1995/03/06  16:00:50  pesch
 * Added kpathsea and GNU readline support.
 * Added new procedures IStreamKind, OStreamKind, EStreamKind.
 *
 * Revision 1.6  1994/07/20  18:15:17  pesch
 * Made most functions atomic wrt. SIGUSR1, since they are not reentrant.
 *
 * Revision 1.5  1993/05/11  10:45:35  kredel
 * Uninitialized variable in input
 *
 * Revision 1.4  1992/10/16  13:47:49  kredel
 * Errors found by Mocka
 *
 * Revision 1.3  1992/10/15  16:24:53  kredel
 * Changed rcsid variable
 *
 * Revision 1.2  1992/02/12  17:31:49  pesch
 * Moved CONST definition to the right place
 *
 * Revision 1.1  1992/01/22  15:10:28  kredel
 * Initial revision
 *
 * ----------------------------------------------------------------------------
 *)
  
IMPLEMENTATION MODULE MASBIOS; 

(* MAS Basic I/O System Implementation Module. *)

 
(* Import lists and Definitions *) 
 
FROM MASELEM	IMPORT	GAMMAINT, MASMIN, MASSIGN; 
 
FROM MASSTOR	IMPORT	ADV, CELLS, CLOCK, COMP, DEQUE, EMPTYQUE, ENQUE,
			FIRST, GCC, GCCC, INV, LIST, LISTVAR, NEWQUE, NU,
			RED, SIL, TAU, TAU0, TIME;

FROM MASERR	IMPORT	ERROR, fatal, harmless, severe, spotless;

FROM IO		IMPORT	CloseIO, EndOfFile, EndOfLine, ReadC, ReadClose, ReadI,
			ReadNl, ReadS, StdError, StdInput, StdOutput, WriteC,
			WriteClose, WriteFlush, WriteI, WriteN, WriteNl,
			WriteOpen, WriteS, tFile;

FROM Strings	IMPORT	ArrayToString, AssignEmpty, Char, IsEqual, Length,
			ReadL, SubString, WriteL, tString;

FROM Portab	IMPORT	bs, cr, del, esc, ff, lf, nul; 

FROM massig	IMPORT	SIGUSR1, SigMask, sigblock, signal, sigsetmask;

FROM maskpathsea	IMPORT	masReadOpen;

FROM masreadline	IMPORT	masReadL;


CONST   CCHI = 150;      (* > 102 *) 
        ILEN = 79; 
        OLEN = 79; 
        itlen = 255; 
        islen = 81;     (* > ILEN *) 
        MAXFILE = 29; 
        undefstat = 'U'; 
        instat = 'I';
        outstat = 'O'; 
        clostat = 'C'; 
        anystat = 'A'; 
TYPE 
        FileDescriptor = 
          RECORD 
                stat : CHAR;       (* Unused, Input, Output, Closed. *) 
                name : tString;  
                sysf : tFile;      (* system dependent file handle etc. *) 
                sysq : GAMMAINT;   (* ram queue handle *) 
                kind : INTEGER; 
                lmarg : INTEGER; 
                rmarg : INTEGER; 
                lpos : INTEGER; 
                llen : INTEGER; 
                ByteIO : GAMMAINT; 
                LineIO : GAMMAINT; 
          END; 
 
VAR     stream : ARRAY [1..MAXFILE] OF FileDescriptor; 
        Istream, Ostream, Estream : INTEGER; 
        Istack, Ostack : LIST; 
        ACODE, LCODE, SCODE : ARRAY [1..CCHI] OF INTEGER; 
        Sin : tString; (*ARRAY [1..islen] OF CHAR;*) 
        again, itrace : INTEGER; 
        Tbuff : ARRAY [1..itlen] OF GAMMAINT; 
        blank : GAMMAINT; 
        ISIZE, ILMARG, IRMARG, IPOS, OSIZE, OLMARG, ORMARG, OPOS : INTEGER; 
        IBYTEIO, ILINEIO, OBYTEIO, OLINEIO : GAMMAINT; 
        INEWLINE, ONEWLINE, ECHO : BOOLEAN; 
 
CONST rcsidi = "$Id: MASBIOS.mi,v 1.13 1996/06/08 18:26:51 pesch Exp $";
CONST copyrighti = "Copyright (c) 1989 - 1992 Universitaet Passau";

 

PROCEDURE BKSP(); 
(*Backspace.  Reread the last character from the input stream. *) 
VAR   i : INTEGER; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1 *)
(*1*) IF again < itlen THEN again := again+1; 
         itrace := itrace-1; 
         IF itrace < 1 THEN itrace := itrace+itlen; END; 
         END; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*9*) END BKSP; 
 
 
PROCEDURE BLINES(N : GAMMAINT); 
(* Blank lines.  N is a positive integer.  N records of blanks each 
are output. *) 
VAR   i : GAMMAINT; 
      j : INTEGER; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1 *)
(*1*) OPOS := ORMARG; i := 1; 
      WHILE i <= N DO CWRITE(blank); 
            OPOS := ORMARG; i := i+1; END; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*9*) END BLINES; 
 
 
PROCEDURE CREAD(): GAMMAINT; 
(*Character read.  Returns next character from the input stream. *) 
VAR   C, D : GAMMAINT; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) IPOS := IPOS+1; C := input(); 
      IF IPOS>=IRMARG THEN IPOS := 0; 
         INEWLINE := TRUE; 
         ILINEIO := ILINEIO+1; 
         WHILE IPOS<ILMARG DO 
               IPOS := IPOS+1; D := input(); 
               END; 
         END; 
      m:=sigsetmask(m); (* restore old signal mask *)
      RETURN (C); 
(*9*) END CREAD; 
 
 
PROCEDURE CREADB(): GAMMAINT; 
(*Character read, skipping blanks. Returns next character from the 
input stream. *) 
VAR   C : GAMMAINT; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) REPEAT 
             C := CREAD(); 
             UNTIL C<>blank; 
      m:=sigsetmask(m); (* restore old signal mask *)
      RETURN (C); 
(*9*) END CREADB; 
 
 
PROCEDURE CWRITE(C : GAMMAINT); 
(*Character write. The character c is transmitted to the output 
stream. *) 
VAR   i : INTEGER; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) OPOS := OPOS+1; 
      IF OPOS >= ORMARG THEN 
         OPOS := 0; 
         ONEWLINE := TRUE; 
         OLINEIO := OLINEIO+1; 
         WHILE OPOS < OLMARG DO 
               OPOS := OPOS+1; 
               output(blank); 
               END; 
         END; 
      output(C); 
      m:=sigsetmask(m); (* restore old signal mask *)
(*9*) END CWRITE; 
 
 
PROCEDURE DIBUFF(); 
(*Display input buffer.  The input buffer status is displayed.*) 
VAR   i, j : INTEGER; 
      L : GAMMAINT; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) BLINES(0); 
      SWRITE("Input buffer follows, last character read underscored."); 
      BLINES(0); 
      j := itrace+itlen-50; 
      IF j>itlen THEN j := j-itlen;  END; 
      FOR i := 1 TO 50 DO 
          j := j+1; 
          IF j>itlen THEN j := j-itlen; END; 
          L := Tbuff[j]; 
          CWRITE(L); 
          END; 
      BLINES(0); 
      FOR i := 2 TO 50-1 DO  CWRITE(blank); END; 
      SWRITE("-"); BLINES(1); 
      m:=sigsetmask(m); (* restore old signal mask *)
(*9*) END DIBUFF; 
 
 
PROCEDURE DIGIT(C : GAMMAINT): BOOLEAN; 
(* Digit.  c is a character.  If c is a digit then TRUE is returned 
otherwise FALSE is returned. *) 
VAR   t : BOOLEAN; 
BEGIN 
(*1*) IF C <= 9 THEN t := TRUE; ELSE t := FALSE; END; 
      RETURN (t); 
(*9*) END DIGIT; 
 
 
PROCEDURE GREAD(): GAMMAINT; 
(* Gamma-integer read.  A gamma-integer is read from the input 
stream.  Any preceding blanks are skipped. *) 
VAR   a, C, S : GAMMAINT; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (*Skip blanks and read sign, if any.*) 
      S := 1; 
      C := CREADB(); 
      IF C = MASORD('+') THEN C := CREADB(); 
         ELSE IF C = MASORD('-') THEN 
                 C := CREADB(); S := -1; 
                 END; 
         END; 
      IF NOT DIGIT(C) THEN 
         ERROR(harmless, "GREAD: digit expected."); 
         DIBUFF(); 
         m:=sigsetmask(m); (* restore old signal mask *)
         RETURN 0; 
         END; 
(*2*) (*read digits and convert.*) 
        a := 0; 
        REPEAT 
               a := 10*a+C; 
               C := CREAD(); 
                         (*teste ob a>10**delta*) 
               UNTIL NOT DIGIT(C); 
        BKSP(); a := S*a; 
	m:=sigsetmask(m); (* restore old signal mask *)
        RETURN (a); 
(*9*) END GREAD; 
 
 
PROCEDURE GWRITE(a : GAMMAINT); 
(* Gamma-integer write.  The gamma-integer a is written in the output 
stream.*) 
VAR   D : ARRAY [1..20] OF GAMMAINT; 
      ap, q : GAMMAINT; 
      N : INTEGER; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*5*) (*Write minus sign.*) 
      IF a < 0 THEN ap := -a; SWRITE("-"); 
               ELSE ap := a; END; 
(*2*) (*Convert to decimal.*) 
      N := 0; 
      REPEAT 
             q := ap DIV 10; 
             N := N+1; 
             IF N>20 THEN 
                     ERROR(harmless, "GWRITE: not a gamma-integer."); 
                     m:=sigsetmask(m); (* restore old signal mask *)
                     RETURN; 
                     END; 
             D[N] := ap-10*q; 
             ap := q; 
             UNTIL ap = 0; 
(*3*) (*Write digits.*) 
      REPEAT 
             CWRITE(D[N]); 
             N := N-1; 
             UNTIL N = 0; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*6*) END GWRITE; 
 
 
PROCEDURE Hold(); 
(* Hold. Pause programm if some key is pressed.*) 
VAR   C : CHAR; 
      m: INTEGER;
BEGIN   
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) C := CHAR(0); (*ReadC(StdInput);*) 
      IF ORD(C) > 0 THEN 
         IF C=esc THEN
            ERROR(severe, "ESC key pressed."); 
            END; 
         Pause(); 
         END; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*9*) END Hold; 
 
 
PROCEDURE InitBIOS(); 
(*Initialize BIOS.  Initialize the basic input/output system.*) 
VAR   C, D, I, J : INTEGER; 
      S, T, R : GAMMAINT; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (*Initialize file descriptors. *) 
      FOR I := 1 TO MAXFILE DO 
          stream[I].stat := undefstat; 
          AssignEmpty(stream[I].name); 
          stream[I].ByteIO := 0; 
          stream[I].LineIO := 0; 
          stream[I].lmarg := 0; 
          stream[I].rmarg := ILEN; 
          stream[I].llen := ILEN; 
          stream[I].lpos := 0; 
          LISTVAR(stream[I].sysq); 
          END; 
      Istream := 0; Ostream := 0; 
      again := 0; itrace := 1; 
      LISTVAR(Istack); LISTVAR(Ostack); 
(*2*) (*Set input globals.*) 
      ECHO := FALSE; Istack := SIL; 
      R := SIUNIT("CON:"); 
(*3*) (*Set output globals.*) 
      Ostack := SIL; 
      R := SOUNIT("CON:"); 
(*4*) (*Initialize code arrays.*) 
      INITCC(); 
      FOR I := 1 TO INTEGER(CHI) DO 
          SCODE[I] := LCODE[I]; 
          ACODE[I] := I-1; 
          END; 
      FOR J := INTEGER(CHI)-1 TO 1 BY -1 DO 
          FOR I := 1 TO J DO 
              C := SCODE[I]; 
              D := SCODE[I+1]; 
              S := MASSIGN(GAMMAINT(C)); 
              T := MASSIGN(GAMMAINT(D)); 
              IF (S>T) OR (S=T) AND (C>D) THEN 
                 SCODE[I] := D; SCODE[I+1] := C; C := ACODE[I]; 
                 ACODE[I] := ACODE[I+1]; 
                 ACODE[I+1] := C; 
                 END; 
              END; 
          END; 
      blank := MASORD(' ');     
      ringclear(); 
      m:=sigsetmask(m); (* restore old signal mask *)
(*9*) END InitBIOS; 
 
  
PROCEDURE CloseBIOS(); 
(*Close BIOS.  Close all streams and write summary. *) 
VAR   I, k, j: INTEGER; 
      c : CHAR; 
      K : GAMMAINT; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (*Close streams on stacks. *) 
        WHILE RED(Istack)<>SIL DO 
              I := INTEGER(FIRST(Istack)); 
              Istack := RED(Istack); 
              c := stream[I].stat; j:=-1; 
              IF c=instat THEN j:=CioUNIT(I,0) END; 
              IF c=outstat THEN j:=CioUNIT(0,I) END; 
              IF j = 0 THEN 
                 SWRITE("Stream "); StWRITE(stream[I].name); 
                 SWRITE(" closed successfully."); BLINES(1); END; 
              END; 
        WHILE RED(Ostack)<>SIL DO 
              I := INTEGER(FIRST(Ostack)); 
              Ostack := RED(Ostack); 
              c := stream[I].stat; j:=-1;
              IF c=instat THEN j:=CioUNIT(I,0) END; 
              IF c=outstat THEN j:=CioUNIT(0,I) END; 
              IF j = 0 THEN 
                 SWRITE("Stream "); StWRITE(stream[I].name); 
                 SWRITE(" closed successfully."); BLINES(1); END; 
              END; 
(*2*) (*Close remaining streams, exept terminal/stdIO. *) 
        FOR I := 1 TO MAXFILE DO 
            IF (I<>Istream) AND (I<>Ostream) THEN
               c := stream[I].stat; j:=-1; 
               IF c=instat THEN j:=CioUNIT(I,0) END; 
               IF c=outstat THEN j:=CioUNIT(0,I) END; 
               IF j = 0 THEN 
                  SWRITE("Stream "); StWRITE(stream[I].name); 
                  SWRITE(" closed successfully."); BLINES(1); END; 
               END; 
            END; 
      (* Summary(); *) 
      CloseIO;  
      m:=sigsetmask(m); (* restore old signal mask *)
(*4*) END CloseBIOS; 
 
 
PROCEDURE INITCC(); 
(*Initialize the ALDES character codes in LCODE.*) 
VAR      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) CHI := 0;       (*DIGITS*) 
      AddCode("0123456789");    (*LETTERS*) 
      AddCode("aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ");
             (*SPECIAL*) 
      AddCode(".,=+-*/$() !"); 
      AddCode('"'); (*"*)
      AddCode("#%&':;<>?@[\]^_`{}|~"); (*' fool cpp*)
      CHI := CHI+1; 
      LCODE[INTEGER(CHI)] := 254;       (* copyright ??*) 
      CHI := CHI+1; 
      LCODE[INTEGER(CHI)] := INTEGER(ORD(esc)); 
      m:=sigsetmask(m); (* restore old signal mask *)
(*2*) END INITCC; 
 
 
PROCEDURE AddCode(S : ARRAY OF CHAR); 
(* Add Code. The characters of S are added to the LCODE array, 
CHI is advanced. *) 
VAR   K : INTEGER; 
      I : CARDINAL; 
BEGIN 
(*1*) K := CHI; 
      FOR I := 0 TO HIGH(S) DO K := K+1; 
          LCODE[K] := INTEGER(ORD(S[I])); END; 
      CHI := GAMMAINT(K); 
(*3*) END AddCode; 
 
 
PROCEDURE LETTER(C : GAMMAINT): BOOLEAN; 
(* Letter.  c is a character.  If c is a letter then TRUE is returned 
otherwise FALSE is returned. *) 
VAR   t : BOOLEAN; 
BEGIN 
(*1*) IF (C>=MASORD('a')) AND (C<=MASORD('Z')) 
         THEN t := TRUE; 
         ELSE t := FALSE END; 
      RETURN (t); 
(*3*) END LETTER; 
 
 
PROCEDURE input(): GAMMAINT; 
(* Input. The charcter C is recieved from the input stream and converted 
to aldes code. *) 
VAR   i, retry : INTEGER; 
      c : CHAR; 
      C, j : GAMMAINT; 
      ok : BOOLEAN; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (*read from internal buffer, if not empty. *) 
        IF again > 0 THEN again := again-1; 
                IPOS := IPOS-1; C := ringget(); 
                RETURN (C); END; 
        retry := MAXFILE; 
        (* avoid endless retrys *) 
        REPEAT  c:=" ";
                i := stream[Istream].kind; 
        CASE i OF 
             | ramkind : ok := NOT EMPTYQUE(stream[Istream].sysq); 
                         IF ok THEN 
                            C := DEQUE(stream[Istream].sysq); 
                            ringput(C); END; 
            | termkind : ok := TRUE; 
                         masReadL(Sin);  
                         ringstring(Sin); 
                         C := ringget(); 
                         IF stream[Ostream].kind=termkind THEN 
                            WriteNl(StdOutput); WriteFlush(StdOutput) END; 
            | diskkind : REPEAT 
                               ok := NOT EndOfFile(stream[Istream].sysf);
                               IF ok THEN c:=ReadC(stream[Istream].sysf);  
                                          END;
                          UNTIL ( c >= " " ) OR NOT ok; 
                          IF ok THEN 
                                C := MASORD(c); 
                                ELSE 
                                C := blank; 
                                END; 
                          ringput(C); 
             | winkind : ok := FALSE; 
             | nulkind : ok := FALSE; 
                  ELSE   ok := FALSE; 
                         END; 
        IF NOT ok THEN 
           (*DEBUG 
           ERROR(spotless,"End of stream: "); 
           ERROR(spotless,stream[Istream].name); 
             GUBED*) 
           j := CioUNIT(Istream,0); 
           retry := retry-1; 
           IF retry<0 THEN c := esc; ok := TRUE END; 
           ringclear(); 
           END; 
        UNTIL ok; 
      IF c=esc THEN (* emergency exit *) 
         ERROR(severe, "INPUT: ESC key pressed.") END; 
      IBYTEIO := IBYTEIO+1; 
      m:=sigsetmask(m); (* restore old signal mask *)
      RETURN (C); 
(*9*) END input; 
 
 
PROCEDURE LISTS(S : ARRAY OF CHAR): LIST;   
(*List from string. S is a character string with respect to local 
character code. A list if the corresponding ALDES character codes 
is returned.*) 
VAR   I, J : INTEGER; 
      II : GAMMAINT; 
      L : LIST; 
BEGIN 
(*1*) J := INTEGER(HIGH(S)); I := 0; L := SIL; 
      WHILE ( I <= J ) AND (S[I] <> nul) DO        
            II := MASORD( S[I] ); L := COMP(II,L); 
            I := I+1; END; 
      L := INV(L); RETURN (L); 
(*9*) END LISTS; 
 
 
PROCEDURE SLIST(A : LIST; VAR S : ARRAY OF CHAR); 
(*String from list. A is a list of ALDES character codes. 
S is a the corresponding character string with respect to local 
character codes. *) 
VAR   I : GAMMAINT; 
      AP : LIST; 
      i : INTEGER;     
BEGIN 
(*1*) AP := A; S[0] := nul; i := -1; 
      WHILE AP <> SIL DO ADV(AP, I, AP); 
            IF I < SIL THEN i:=i+1; S[i] := MASCHR(I) END; 
            END; 
      S[i+1]:=nul;
(*2*) END SLIST; 
 
 
PROCEDURE MASCHR(C : GAMMAINT): CHAR; 
(*MAS char.  Returns the local character for the aldes character c. *) 
VAR   i : INTEGER; 
      c : CHAR; 
BEGIN 
(*1*) IF (0<=C) AND (C<=CHI) 
         THEN i := INTEGER(C); 
         ELSE ERROR(spotless, "Non-standard character to convert. "); 
              GWRITE(C); SWRITE(" "); 
              i := INTEGER(blank); END; 
      c := CHR(LCODE[i+1]); RETURN (c); 
(*2*) END MASCHR; 
 
 
PROCEDURE MASORD(C : CHAR): GAMMAINT; 
(*MAS order.  Returns the aldes code for the character c. *) 
VAR   D : GAMMAINT; 
BEGIN 
(*1*) D := GAMMAINT(ORD(C)); D := MASORDI(D); 
      RETURN (D); 
(*2*) END MASORD; 
 
 
PROCEDURE MASORDI(C : GAMMAINT): GAMMAINT; 
(*MAS order integer.  Returns the aldes code for the integer c.*) 
VAR   CC, D, J, L, M, U, KK : INTEGER; 
      K : GAMMAINT; 
BEGIN 
(*1*) CC := INTEGER(C); L := 1; U := INTEGER(CHI); 
      REPEAT 
             J := L+U; 
             M := J DIV 2; 
             D := SCODE[M]; 
             IF (CC<0) AND ((D>=0) OR (CC<=D)) OR (D>0) AND (CC<=D) 
                THEN U := M; 
                ELSE L := M+1; END; 
             UNTIL L=U; 
       IF CC = SCODE[L] 
          THEN KK := ACODE[L]; 
          ELSE ERROR(spotless, "Non-standard character to convert. "); 
               GWRITE(C); SWRITE(" "); 
               KK := INTEGER(blank); END; 
      K := GAMMAINT(KK); RETURN (K); 
(*9*) END MASORDI; 
 
 
PROCEDURE output(C : GAMMAINT); 
(* Output. The charcter C is converted to local code and transmitted 
to the output stream. *) 
VAR   i, retry : INTEGER; 
      c : CHAR; 
      ok : BOOLEAN; 
      j : GAMMAINT; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) retry := MAXFILE;      (* avoid endless retrys *) 
        REPEAT 
                i := stream[Ostream].kind; 
                CASE i OF 
                        | ramkind : 
                                ENQUE(C, stream[Ostream].sysq); 
                                ok := (NOT EMPTYQUE(stream[Ostream].sysq)); 
                        | termkind : 
                                IF ONEWLINE THEN 
                                   ONEWLINE := FALSE; 
                                   WriteNl(StdOutput); 
                                   WriteFlush(StdOutput);
                                   (* Hold(); *) 
                                END; 
                                c := MASCHR(C); 
                                WriteC(StdOutput,c); 
                                WriteFlush(StdOutput);
                                ok := TRUE; 
                        | diskkind : 
                                IF ONEWLINE THEN 
                                        ONEWLINE := FALSE; 
                                        WriteNl(stream[Ostream].sysf); 
                                END; 
                                c := MASCHR(C); 
                                WriteC(stream[Ostream].sysf, c);   
                                ok := TRUE;
                        | winkind : 
                                ok := TRUE; 
                        | nulkind : 
                                ok := TRUE; 
                        ELSE 
                                ok := FALSE; 
                END; 
                IF NOT ok THEN (*one cannot debug this case*) 
                        j := CioUNIT(0,Ostream); 
                        retry := retry-1; 
                        IF retry < 0 THEN 
                           ERROR(fatal, "No output possible."); 
                           END; (* no more output possible *) 
                END; 
        UNTIL ok; 
      OBYTEIO := OBYTEIO+1; 
      (*DEBUG   Hold;   GUBED*) 
      m:=sigsetmask(m); (* restore old signal mask *)
(*3*) END output; 
 
 
PROCEDURE Pause(); 
(*Pause. Delay programm until some key is pressed.*) 
VAR   C : CHAR; 
BEGIN 
(*1*) C:=ReadC(StdInput); 
(*2*) END Pause; 
 
 
PROCEDURE ringclear(); 
(*clear ring buffer. *) 
VAR   i : INTEGER; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) FOR i := 1 TO itlen DO Tbuff[i] := blank; END; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*2*) END ringclear; 
 
 
PROCEDURE ringget(): GAMMAINT; 
(*get gamma integer from ring buffer. *) 
VAR   I : GAMMAINT; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) I := Tbuff[itrace]; itrace := itrace+1; 
      IF itrace>itlen THEN itrace := itrace-itlen; END; 
      m:=sigsetmask(m); (* restore old signal mask *)
      RETURN (I); 
(*2*) END ringget; 
 
 
PROCEDURE ringput(I : GAMMAINT); 
(*put gamma integer in ring buffer. *) 
VAR      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) Tbuff[itrace] := I; itrace := itrace+1; 
      IF itrace>itlen THEN itrace := itrace-itlen; END; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*2*) END ringput; 
 
 
PROCEDURE ringstring(S : tString (*ARRAY OF CHAR*)); 
(*put string in ring buffer. *) 
VAR   i, k, l : INTEGER; 
      j : GAMMAINT;
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (*prepare*) l := Length(S); 
      IF l > ISIZE THEN l := ISIZE; END; 
      (* ASSERT again = 0 *)
      again := again+ISIZE;  k := itrace; 
(*2*) (*insert string*) i := 1;            
      WHILE i <= l DO 
            IF Char(S,i) = bs THEN k := k-1; 
               IF k < 1 THEN k := k+itlen; END; 
         ELSIF Char(S,i) = del THEN i := i+1; 
          ELSE Tbuff[k] := MASORD(Char(S,i)); 
               k := k+1; END; 
            IF k > itlen THEN k := k-itlen; END; 
            i := i+1; END; 
(*3*) (*insert blanks*) 
      WHILE i < ISIZE DO Tbuff[k] := blank; 
            k := k+1; 
            IF k>itlen THEN k := k-itlen; END; 
            i := i+1; END; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*4*) END ringstring; 
 
 
PROCEDURE findslot(S : ARRAY OF CHAR; stat : CHAR; VAR old, slot : INTEGER); 
(* Find slot.  The old or new slot for stream S for status 'stat' is 
searched in the file descriptor table. *) 
VAR   i : INTEGER; 
      da, gl : BOOLEAN; 
      sp: tString;
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (* See if allready defined. *) 
        slot := 0; old := 0; 
        ArrayToString(S,sp);
        FOR i := 1 TO MAXFILE DO 
            IF stream[i].stat = undefstat THEN slot := i; END; 
            da := IsEqual(sp,stream[i].name); 
            IF stat=anystat THEN gl := TRUE; 
               ELSE gl := (stream[i].stat=stat) OR (stream[i].stat=clostat); 
                    END; 
            IF da AND gl THEN old := i; END; 
            END; 
        IF old>0 THEN slot := old; END; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*3*) END findslot; 
 
 
PROCEDURE saveold(s : INTEGER); 
(* The characteristics of the old stream are saved in the descriptor 
table. *) 
VAR   m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) IF (s<1) OR (s>MAXFILE) THEN       
         ERROR(severe, "saveold: stream out of range."); 
         RETURN; END; 
(*2*) (* input stream. *) 
        IF stream[s].stat=instat THEN 
           stream[s].lmarg := ILMARG; 
           stream[s].rmarg := IRMARG; 
           stream[s].llen := ISIZE; 
           stream[s].lpos := IPOS; 
           stream[s].ByteIO := IBYTEIO; 
           stream[s].LineIO := ILINEIO; 
           END; 
(*3*) (* output stream. *) 
        IF stream[s].stat=outstat THEN 
           stream[s].lmarg := OLMARG; 
           stream[s].rmarg := ORMARG; 
           stream[s].llen := OSIZE; 
           stream[s].lpos := OPOS; 
           stream[s].ByteIO := OBYTEIO; 
           stream[s].LineIO := OLINEIO; 
           END; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*4*) END saveold; 
 
 
PROCEDURE storeold(s : INTEGER); 
(* The characteristics of the old stream are restored from the descriptor 
table. *) 
VAR      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) IF (s<1) OR (s>MAXFILE) THEN 
         ERROR(severe, "storeold: stream out of range."); 
	 m:=sigsetmask(m); (* restore old signal mask *)
         RETURN; END; 
(*2*) (* input stream. *) 
        IF stream[s].stat=instat THEN 
           ILMARG := stream[s].lmarg; 
           IRMARG := stream[s].rmarg; 
           ISIZE := stream[s].llen; 
           IPOS := stream[s].lpos; 
           IBYTEIO := stream[s].ByteIO; 
           ILINEIO := stream[s].LineIO; 
           END; 
(*3*) (* output stream. *) 
        IF stream[s].stat=outstat THEN 
           OLMARG := stream[s].lmarg; 
           ORMARG := stream[s].rmarg; 
           OSIZE := stream[s].llen; 
           OPOS := stream[s].lpos; 
           OBYTEIO := stream[s].ByteIO; 
           OLINEIO := stream[s].LineIO; 
           END; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*4*) END storeold; 
 
 
PROCEDURE detkind(S : ARRAY OF CHAR): INTEGER; 
(*Determine the kind of the stream S. *) 
VAR   k : INTEGER; 
      w : CARDINAL;
      sp, sp1, pre : tString;  
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (* identify prefix in character string. *) 
        k := diskkind; 
        ArrayToString(S,sp1); SubString(sp1,1,4,sp);  
        ArrayToString("CON:",pre); 
        IF IsEqual(sp,pre) THEN k := termkind; END; 
        ArrayToString("WIN:",pre); 
        IF IsEqual(sp,pre) THEN k := winkind; END; 
        ArrayToString("RAM:",pre); 
        IF IsEqual(sp,pre) THEN k := ramkind; END; 
        ArrayToString("NUL:",pre); 
        IF IsEqual(sp,pre) THEN k := nulkind; END; 
        ArrayToString("GRA:",pre); 
        IF IsEqual(sp,pre) THEN k := termkind; END; 
      m:=sigsetmask(m); (* restore old signal mask *)
        RETURN (k); 
(*2*) END detkind; 
 
 
PROCEDURE popIstream(); 
(* Pop input stream.  The most recently open input stream is popped from 
the open stream stack.  Popping continues until a non closed stream is 
found.  *) 
VAR   s, slot : INTEGER; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (* Check if it is last on stack. *) 
        slot := INTEGER(FIRST(Istack)); 
        IF (RED(Istack)<>SIL) AND (slot=Istream) THEN 
           Istack := RED(Istack); 
           slot := INTEGER(FIRST(Istack)); 
           END; 
        s := Istream; 
        Istream := slot; 
(*2*) (*save and store. *) 
        saveold(s); 
        storeold(slot); 
(*3*) (*recursion*) 
        IF stream[slot].stat=clostat THEN popIstream(); END; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*5*) END popIstream; 
 
 
PROCEDURE popOstream(); 
(* Pop output stream.  The most recently open output stream is popped from 
the open stream stack.  Popping continues until a non closed stream is 
found.  *) 
VAR   s, slot : INTEGER; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (* Check if it is last on stack. *) 
        slot := INTEGER(FIRST(Ostack)); 
        IF (RED(Ostack)<>SIL) AND (slot=Ostream) THEN 
           Ostack := RED(Ostack); 
           slot := INTEGER(FIRST(Ostack)); 
           END; 
        s := Ostream; 
        Ostream := slot; 
(*2*) (*save and store. *) 
        saveold(s); 
        storeold(slot); 
(*3*) (*recursion*) 
        IF stream[slot].stat=clostat THEN popOstream(); END; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*4*) END popOstream; 
 
 
PROCEDURE pushstream(s : INTEGER); 
(*Push stream.  The stream 'slot' is pushed to the open stream stack. *) 
VAR   i : INTEGER; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (*save old values. *) 
        CASE stream[s].stat OF 
                | outstat : 
                        IF Ostream>0 THEN 
                           saveold(Ostream); END; 
                        Ostack := COMP(GAMMAINT(s),Ostack); 
                        Ostream := s; 
                | instat : 
                        IF Istream>0 THEN saveold(Istream); END; 
                        Istack := COMP(GAMMAINT(s),Istack); 
                        Istream := s; 
                ELSE 
                END; 
(*2*) (*store old values. *) 
        storeold(s); 
      m:=sigsetmask(m); (* restore old signal mask *)
(*3*) END pushstream; 
 
 
PROCEDURE CUNIT(S : ARRAY OF CHAR): GAMMAINT; 
(* Close unit.  The unit S is closed, with S as the external name. 
CUNIT returns 0 on successful completion, ne 0 else.*) 
VAR     iold, oold, slot, k : INTEGER; 
        ok : BOOLEAN; 
        m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (* See if open. *) 
        findslot(S, instat, iold, slot); 
        findslot(S, outstat, oold, slot); 
(*2*) (* Pop from open stream stacks. *) 
        IF Istream=iold THEN popIstream(); END; 
        IF Ostream=oold THEN popOstream(); END; 
(*3*) (* determine stream kind and close streams. *) 
        IF iold>0 THEN 
           k := stream[iold].kind; 
                CASE k OF 
                        | termkind : ok := TRUE; 
                        | ramkind :  ok := TRUE; 
                        | winkind :  ok := TRUE; 
                        | nulkind :  ok := TRUE; 
                        | diskkind : ReadClose(stream[iold].sysf); 
                                     ok := TRUE; 
                     ELSE ok := FALSE; 
                          END; 
           IF NOT ok THEN 
              ERROR(harmless, "Cannot close requested stream. "); 
              m:=sigsetmask(m); (* restore old signal mask *)
              RETURN (GAMMAINT(iold)); END; 
           stream[iold].stat := clostat; 
           END; 
        IF oold>0 THEN 
           k := stream[oold].kind; 
                CASE k OF 
                        | termkind : ok := TRUE; 
                        | ramkind :  ok := TRUE; 
                        | winkind :  ok := TRUE; 
                        | nulkind :  ok := TRUE; 
                        | diskkind : WriteClose(stream[oold].sysf); 
                                     ok := TRUE; 
                     ELSE ok := FALSE; 
                          END; 
           IF NOT ok THEN 
              ERROR(harmless, "Cannot close requested stream. "); 
              m:=sigsetmask(m); (* restore old signal mask *)
              RETURN (GAMMAINT(oold)); 
              END; 
           stream[oold].stat := clostat; 
           END; 
      m:=sigsetmask(m); (* restore old signal mask *)
      RETURN 0; 
(*5*) END CUNIT; 

 
PROCEDURE CioUNIT(iold, oold : INTEGER): GAMMAINT; 
(* Close unit.  The unit in slot iold or oold is closed. 
CioUNIT returns 0 on successful completion, ne 0 else.*) 
VAR   slot, k : INTEGER; 
      ok : BOOLEAN; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (* Pop from open stream stacks. *) 
      IF Istream=iold THEN popIstream(); END; 
      IF Ostream=oold THEN popOstream(); END; 
(*2*) (* determine stream kind and close streams. *) 
        IF iold>0 THEN 
           k := stream[iold].kind; 
                CASE k OF 
                        | termkind : ok := TRUE; 
                        | ramkind :  ok := TRUE; 
                        | winkind :  ok := TRUE; 
                        | nulkind :  ok := TRUE; 
                        | diskkind : ReadClose(stream[iold].sysf); 
                                     ok := TRUE; 
                     ELSE ok := FALSE; 
                          END; 
           IF NOT ok THEN 
              ERROR(harmless, "Cannot close requested stream. "); 
              m:=sigsetmask(m); (* restore old signal mask *)
              RETURN (GAMMAINT(iold)); END; 
           stream[iold].stat := clostat; 
           END; 
        IF oold>0 THEN 
           k := stream[oold].kind; 
                CASE k OF 
                        | termkind : ok := TRUE; 
                        | ramkind :  ok := TRUE; 
                        | winkind :  ok := TRUE; 
                        | nulkind :  ok := TRUE; 
                        | diskkind : WriteClose(stream[oold].sysf); 
                                     ok := TRUE; 
                     ELSE ok := FALSE; 
                          END; 
           IF NOT ok THEN 
              ERROR(harmless, "Cannot close requested stream. "); 
              m:=sigsetmask(m); (* restore old signal mask *)
              RETURN (GAMMAINT(oold)); 
              END; 
           stream[oold].stat := clostat; 
           END; 
      m:=sigsetmask(m); (* restore old signal mask *)
      RETURN 0; 
(*5*) END CioUNIT; 
 
 
PROCEDURE SIUNIT(S : ARRAY OF CHAR): GAMMAINT; 
(* Set input unit.  Input unit is set to S, with S as the external name. 
SIUNIT returns 0 on successful completion, ne 0 else.*) 
VAR   i, slot, old, sp, k : INTEGER; 
      INI : GAMMAINT; 
      ok : BOOLEAN; 
      m: INTEGER;

BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (* See if allready defined. *) 
        findslot(S, instat, old, slot); 
        IF slot=0 THEN 
           ERROR(severe, "Maximal number of Files is allready in use. "); 
           m:=sigsetmask(m); (* restore old signal mask *)
           RETURN 1; END; 
(*2*) (* Save and set characteristics of old stream. *) 
        IF (old>0) THEN 
           saveold(Istream); 
           storeold(old); 
           Istream := old;
           IF stream[old].stat=instat THEN 
              m:=sigsetmask(m); (* restore old signal mask *)
              RETURN 0; END; 
           END; 
(*3*) (* determine stream kind if new and open stream 'slot'. *) 
        IF (old=0) THEN 
           k := detkind(S); 
           stream[slot].kind := k; 
        ELSE  k := stream[slot].kind; 
        END; 
        CASE k OF 
                | termkind : ok := TRUE; ECHO := FALSE; 
                | ramkind : INI := NEWQUE(); 
                            findslot(S, anystat, old, sp); 
                            IF old>0 THEN 
                               INI := stream[old].sysq; END; 
                            stream[slot].sysq := INI; 
                            ok := TRUE; ECHO := FALSE; 
                | winkind : ok := TRUE; ECHO := FALSE; 
                | nulkind : ok := TRUE; ECHO := FALSE; 
                | diskkind : stream[slot].sysf := masReadOpen(S);
                             IF stream[slot].sysf < 0 THEN  
                                ERROR(harmless, S); 
                                ERROR(harmless, "Cannot open file. "); 
                                m:=sigsetmask(m); (* restore old signal mask *)
                                RETURN (GAMMAINT(slot)); END; 
                             ok := TRUE; ECHO := TRUE; 
            ELSE ok := FALSE; END; 
        IF NOT ok THEN 
           ERROR(harmless, "Cannot open requested stream. "); 
           m:=sigsetmask(m); (* restore old signal mask *)
           RETURN (GAMMAINT(slot)); 
           END; 
(*4*) (* initialize file descriptor and line characteristics. *) 
        IF (old=0) THEN 
           ArrayToString(S,stream[slot].name); END; 
        stream[slot].stat := instat; 
        INEWLINE := FALSE; 
        pushstream(slot); 
      m:=sigsetmask(m); (* restore old signal mask *)
      RETURN 0; 
(*5*) END SIUNIT; 
 
 
PROCEDURE SOUNIT(S : ARRAY OF CHAR): GAMMAINT; 
(* Set output unit.  Output unit is set to stream S, with s as the 
external name.  SOUNIT returns 0 on successful completion, ne 0 else. *) 
VAR   i, slot, old, k, sp : INTEGER; 
      ok : BOOLEAN; 
      INI : GAMMAINT; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) (* See if allready defined. *) 
        findslot(S, outstat, old, slot); 
        IF slot=0 THEN 
           ERROR(severe, "Maximal number of Files is allready in use. "); 
           m:=sigsetmask(m); (* restore old signal mask *)
           RETURN 1; END; 
(*2*) (* Save and set characteristics of old stream. *) 
        IF old>0 THEN 
           saveold(Ostream); 
           storeold(old); 
           Ostream := old; 
           IF stream[old].stat=outstat THEN 
              m:=sigsetmask(m); (* restore old signal mask *)
              RETURN 0; END; 
           END; 
(*3*) (* determine stream kind if new and open stream 'slot'. *) 
        IF (old=0) THEN 
           k := detkind(S); 
           stream[slot].kind := k; 
        ELSE  k := stream[slot].kind; END; 
        CASE k OF 
                | termkind : ok := TRUE; 
                | ramkind : INI := NEWQUE(); 
                            findslot(S, anystat, old, sp); 
                            IF old>0 THEN 
                               INI := stream[old].sysq; 
                               END; 
                            stream[slot].sysq := INI; 
                            ok := TRUE; 
                | winkind : ok := TRUE; 
                | nulkind : ok := TRUE; 
                | diskkind : stream[slot].sysf := WriteOpen(S); 
                             IF stream[slot].sysf < 0 THEN 
                                (* stream[slot].sysf := Create(S); *) 
     	       	    	       ok:=FALSE;
                                END; 
                             ok := TRUE; 
             ELSE ok := FALSE; END; 
        IF NOT ok THEN 
           ERROR(harmless, S); 
           ERROR(harmless, "Cannot open requested stream. "); 
           m:=sigsetmask(m); (* restore old signal mask *)
           RETURN (GAMMAINT(slot)); END; 
(*4*) (* initialize file descriptor and line characteristics. *) 
        IF (old=0) THEN 
           ArrayToString(S,stream[slot].name); END; 
        stream[slot].stat := outstat; 
        ONEWLINE := FALSE; 
        pushstream(slot); 
      m:=sigsetmask(m); (* restore old signal mask *)
      RETURN 0; 
(*5*) END SOUNIT; 
 
 
PROCEDURE SILINE(VAR S, L, R : GAMMAINT); 
(* Set input line.  The input line length is set to S, the left margin is 
set to L and the right margin is set to R. If any of the values of 
S, L or R is negative, then the corresponding value is left unchanged. 
The values in effect are returned. *) 
VAR   S1, L1, R1 : GAMMAINT; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) S1 := GAMMAINT(ISIZE); L1 := GAMMAINT(ILMARG); 
      R1 := GAMMAINT(IRMARG); 
      IF S>0 THEN ISIZE := INTEGER(S); END; 
      IF R>0 THEN IRMARG := INTEGER(R); END; 
      IF L>=0 THEN ILMARG := INTEGER(L); END; 
      IF IRMARG>ISIZE THEN IRMARG := ISIZE; END; 
      IF ILMARG>=IRMARG THEN ILMARG := IRMARG-1; END; 
      S := S1; L := L1; R := R1; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*2*) END SILINE; 
 
 
PROCEDURE SOLINE(VAR S, L, R : GAMMAINT); 
(* Set output line.  The output line length is set to S, the left margin is 
set to L and the right margin is set to R. If any of the values of 
S, L or R is negative, then the corresponding value is left unchanged. 
The values in effect are returned. *) 
VAR   S1, L1, R1 : GAMMAINT; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) S1 := GAMMAINT(OSIZE); L1 := GAMMAINT(OLMARG); 
      R1 := GAMMAINT(ORMARG); 
      IF S>0 THEN OSIZE := INTEGER(S); END; 
      IF R>0 THEN ORMARG := INTEGER(R); END; 
      IF L>=0 THEN OLMARG := INTEGER(L); END; 
      IF ORMARG>OSIZE THEN ORMARG := OSIZE; END; 
      IF OLMARG>=ORMARG THEN OLMARG := ORMARG-1; END; 
      S := S1; L := L1; R := R1; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*2*) END SOLINE; 
 
 
PROCEDURE Summary(); 
(*Summary of stream IO. *) 
VAR   i : INTEGER; 
      j : GAMMAINT; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) BLINES(1); SWRITE("Summary of stream IO "); BLINES(1); 
      j := 0; 
        FOR i := 1 TO MAXFILE DO 
                IF stream[i].stat<>undefstat THEN 
                        j := j+1; 
                        IF i=Istream THEN 
                                saveold(i); 
                        END; 
                        IF i=Ostream THEN 
                                saveold(i); 
                        END; 
                        SWRITE("Name     "); 
                        StWRITE(stream[i].name); 
                        SWRITE(", "); 
                        BLINES(0); 
                        CASE stream[i].stat OF 
                                | instat : 
                                        SWRITE("Input,   "); 
                                | outstat : 
                                        SWRITE("Output,  "); 
                                | clostat : 
                                        SWRITE("Closed,  "); 
                                ELSE 
                                        SWRITE("Unknown, "); 
                                END; 
                        SWRITE("Byte-IO "); 
                        GWRITE(stream[i].ByteIO); 
                        SWRITE(", Line-IO "); 
                        GWRITE(stream[i].LineIO); 
                        SWRITE(", Lmarg "); 
                        GWRITE(GAMMAINT(stream[i].lmarg)); 
                        SWRITE(", Rmarg "); 
                        GWRITE(GAMMAINT(stream[i].rmarg)); 
                        SWRITE(", Size "); 
                        GWRITE(GAMMAINT(stream[i].llen)); 
                        SWRITE(". "); 
                        BLINES(0); 
                END; 
        END; 
      BLINES(1); GWRITE(j); SWRITE(" Files used. "); 
      (*Hold();*) BLINES(1); 
      m:=sigsetmask(m); (* restore old signal mask *)
(*3*) END Summary; 
 
 
PROCEDURE StorSummary(); 
(*MASSTOR Summary. *) 
VAR   ML, NL, TL : LIST; 
BEGIN 
(*1*) BLINES(1); 
      ML := GCC; NL := GCCC; TL := TAU; 
      GWRITE(ML); SWRITE(" garbage collections, "); 
      GWRITE(NL); SWRITE(" cells reclaimed, in "); 
      GWRITE(TL); SWRITE(" milliseconds."); BLINES(0); 
      NL := CELLS(); TL := TIME()-TAU0; 
      GWRITE(NL); SWRITE(" cells used, in "); 
      GWRITE(TL); SWRITE(" milliseconds."); BLINES(0); 
      TL := CLOCK()-TAU0; 
      GWRITE(NU); SWRITE(" cells allocated. "); 
      SWRITE("Total time "); GWRITE(TL); SWRITE(" milliseconds."); 
      BLINES(0); 
(*2*) END StorSummary; 
 

PROCEDURE SWRITE(S : ARRAY OF CHAR); 
(* String write. S is a character string with respect to local 
character codes. The single characters are converted to ALDES codes 
and written to the output stream. *) 
VAR   i, l: CARDINAL; 
      C : GAMMAINT; 
BEGIN 
(*1*) i:=0; l:=HIGH(S); 
      REPEAT  
             IF S[i] <> nul THEN C := MASORD(S[i]); CWRITE(C);
                            ELSE RETURN END; 
             i:=i+1;
             UNTIL i > l; 
(*2*) END SWRITE; 


PROCEDURE StWRITE(S : tString); 
(* String write. S is a character string with respect to local 
character codes. The single characters are converted to ALDES codes 
and written to the output stream. *) 
VAR     i, l : CARDINAL; 
        C : GAMMAINT; 
BEGIN 
(*1*) l:=Length(S); i:=0;
      WHILE i < l DO i:=i+1; C := MASORD( Char(S,i) );
            CWRITE(C); END;
(*2*) END StWRITE; 
 
 
(* 
PROCEDURE testBIOS(); 
(* Test BASBIOS. Some tests are performed to check correct 
implementation. *) 
VAR   i, j, k : GAMMAINT; 
      L, M : LIST; 
      ii : INTEGER; 
BEGIN 
(*1*) (*see if initialization was ok. *) 
      Summary(); 
(*2*) (*write character code card to terminal. *) 
        FOR ii := 0 TO CHI DO 
            CWRITE(ii); CWRITE(blank); END; 
        BLINES(1); 
        i := 1; 
        IF i=1 THEN 
           (*test terminal input. *) 
           REPEAT 
                  BLINES(0); 
                  SWRITE("Bitte Zahlen eingeben (0 = ende) "); 
                  i := GREAD(); BLINES(0); 
                  SWRITE("Eingegeben "); GWRITE(i); BLINES(1); 
                  UNTIL i = 0; 
           BLINES(1); 
           SWRITE("MASBIOS 1. test finished. "); BLINES(1); 
           Summary(); 
           (*test write to ram stream. *) 
           k := SOUNIT("RAM:1"); 
           IF k<>0 THEN 
              SWRITE("Open RAM:1 for output not successful. "); 
              BLINES(1); END; 
           FOR ii := 1 TO 1000 DO 
               GWRITE(GAMMAINT(ii)); CWRITE(blank); END; 
           k := CUNIT("RAM:1"); 
           IF k<>0 THEN 
              SWRITE("Close RAM:1: not successful. "); 
              BLINES(1); END; 
           (*test read from ram stream. *) 
           k := SIUNIT("RAM:1"); 
           IF k<>0 THEN 
              SWRITE("Open RAM:1 for input not successful. "); 
              BLINES(1); END; 
           i := 0; 
           REPEAT 
                  i := i+1; 
                  j := GREAD(); 
                  IF i<>j THEN SWRITE("wrong ");
                     GWRITE(i); CWRITE(blank); 
                     GWRITE(j); BLINES(0); 
                     END; 
                  UNTIL i>=10; 
            k := CUNIT("RAM:1"); 
            IF k<>0 THEN 
               SWRITE("Close RAM:1: not successful. "); 
               BLINES(1); END; 
            BLINES(1); 
            SWRITE("MASBIOS 2. test finished. "); BLINES(1); 
            Summary(); 
            (*test write to disk stream. *) 
            k := SOUNIT("TEST.TXT"); 
            IF k<>0 THEN 
               SWRITE("Open TEST.TXT for output not successful. "); 
               BLINES(1); END; 
            FOR ii := 1 TO 1000 DO GWRITE(GAMMAINT(ii)); 
                CWRITE(blank); END; 
            k := CUNIT("TEST.TXT"); 
            IF k<>0 THEN 
               SWRITE("Close TEST.TXT not successful. "); 
               BLINES(1); END; 
            BLINES(1); 
            SWRITE("MASBIOS 3. test finished. "); BLINES(1); 
            (*test read from disk stream. *) 
            k := SIUNIT("TEST.TXT"); 
            IF k<>0 THEN 
               SWRITE("Open TEST.TXT for input not successful. "); 
               BLINES(1); END; 
            i := 1; 
            REPEAT 
                   j := GREAD(); 
                   IF i<>j THEN SWRITE("wrong ");
                                GWRITE(i); 
                                SWRITE(" - "); 
                                GWRITE(j); 
                                BLINES(0); 
                      END; 
                   i := i+1; 
                   UNTIL i>=100; 
            k := CUNIT("TEST.TXT"); 
            IF k<>0 THEN 
               SWRITE("Close TEST.TXT not successful. "); 
               BLINES(1); END; 
            BLINES(1); 
            SWRITE("MASBIOS 4. test finished. "); BLINES(1); 
            Summary(); 
            (*open several files at a time. *) 
            k := SIUNIT("RAM:1"); 
            IF k<>0 THEN 
               SWRITE("Open RAM:1 for input not successful. "); 
               BLINES(1); END; 
            k := SIUNIT("TEST.TXT"); 
            IF k<>0 THEN 
               SWRITE("Open TEST.TXT for input not successful. "); 
               BLINES(1); END; 
            REPEAT 
                   j := GREAD(); 
                   UNTIL j>999;   
            BLINES(1); 
            SWRITE("MASBIOS 5. test finished. "); BLINES(1); 
            Summary(); 
        END; 
        (*read from file and write to screen. *) 
        k := SIUNIT("LISP.INI"); 
        IF k<>0 THEN 
           SWRITE("Open LISP.INI for input not successful. ");
           BLINES(1); END; 
        k := MASORD("a"); 
        i := 0; 
        REPEAT 
               j := CREAD(); 
               CWRITE(j); 
               i := i+1; 
               IF i>=40 THEN 
                  BLINES(1); 
                  i := 0; 
                  END; 
               UNTIL j>=k; 
        BLINES(1); 
        SWRITE("MASBIOS 6. test finished. "); BLINES(1); 
        Summary(); 
(*9*) END testBIOS; 
*) 
 
PROCEDURE TAB(N : GAMMAINT); 
(* Tabulate.  n is a positive integer.  If lmarg lt n le rmarg then 
blanks are transmitted to the output stream until opos eq n.*) 
VAR   n : INTEGER; 
      m: INTEGER;
BEGIN 
      m:=sigblock(SigMask(SIGUSR1)); (* block SIGUSR1*)
(*1*) n := INTEGER(N); 
      IF (OLMARG<n) AND (n<=ORMARG) THEN 
         WHILE OPOS<n DO CWRITE(blank); END; 
         END; 
      m:=sigsetmask(m); (* restore old signal mask *)
(*2*) END TAB; 
 
PROCEDURE IStreamKind(): INTEGER;
(* Input stream kind. The kind of the current input stream is returned. *)
BEGIN
     RETURN stream[Istream].kind; 
END IStreamKind;

PROCEDURE OStreamKind(): INTEGER;
(* Output stream kind. The kind of the current output stream is returned. *)
BEGIN
     RETURN stream[Ostream].kind; 
END OStreamKind;

PROCEDURE EStreamKind(): INTEGER;
(* Error stream kind. The kind of the current error stream is returned. *) 
BEGIN
     RETURN stream[Estream].kind; 
END EStreamKind;


 
(* MASBIOS initialization *) 
BEGIN 
(*1*) InitBIOS(); 
(*2*) (*DEBUG   
        SWRITE("Module MASBIOS initialized."); 
        BLINES(1); 
        testBIOS(); 
        CloseBIOS(); 
        StorSummary(); 
        SWRITE("Test MASBIOS ready.");  BLINES(1);
        CloseIO;
          GUBED*) 
(*3*) END MASBIOS. 
 
(* -EOF- *)