! File:   LOIO.BLI
!
!    This work was supported by the Advanced Research
!    Projects Agency of the Office of the Secretary of
!    Defense (F44620-73-C-0074) and is monitored by the
!    Air Force Office of Scientific Research.

MODULE LOIO(TIMER=EXTERNAL(SIX12))=
BEGIN
SWITCHES NOLIST;
REQUIRE COMMON.BEG;
REQUIRE IOMACS.BEG;
REQUIRE IO.BEG;
SWITCHES LIST;
BEGIN

BIND	TENEX = FALSE;

MACRO
	STATUS=OPENBLOCK[0]$,
	DEVCE=OPENBLOCK[1]$,
	BUFFERS=OPENBLOCK[2]$;

GLOBAL ROUTINE OPN(CHNL,DEV,MODE,BUFS)=
    BEGIN
      BIND OPEN=#50,	    INBUF=#64,	    OUTBUF=#65;
      BIND NUMBUFS=(.BUFS<LH>+.BUFS<RH>),
	    INPUT=.BUFS<LH> EQL 0;
      LOCAL OPENBLOCK[3],DUMBUF;
      REGISTER R;
      MAP BUFVEC CHNL;
      EXTERNAL JOBFF;

      IF .CHNL GTR 0 THEN CHNL[BHADRF]_GETSPACE(ST,HDRSIZE);
      DEVCE_.DEV;
      STATUS_.MODE;
      BUFFERS_IF INPUT THEN .CHNL[BHADRF] ELSE .CHNL[BHADRF]^18;

      IF NOT SKIP(EXECUTE(OPEN,.CHNL,OPENBLOCK<0,0>))
	THEN
	    BEGIN
	    IF .CHNL LEQ 0 THEN RETURN 0;
	    RELEASESPACE(ST,.CHNL[BHADRF],HDRSIZE);
	    RETURN CHNL[ADRWORD]_0
	    END;

      IF .CHNL GTR 0
	THEN
	    BEGIN ! GET BUFFER AREA
	    JOBFF<RH>_DUMBUF[-1]<0,0>;
	    EXECUTE(IF INPUT THEN INBUF ELSE OUTBUF,.CHNL,1);
	    JOBFF<RH>_CHNL[BADRF]_
		    GETSPACE(ST,CHNL[BUFSIZEF]_(.DUMBUF<18,17>+2)*NUMBUFS);
	    END ! OF GET BUFFER AREA
	ELSE JOBFF<RH>_.CHNL[BADRF];

      ! NOW WE REALLY GET BUFFERS

      EXECUTE(IF INPUT THEN INBUF ELSE OUTBUF,.CHNL,NUMBUFS);
      1
    END; ! OF OPN


GLOBAL ROUTINE RLS(CHNL)=
    BEGIN
      REGISTER R;
      MAP BUFVEC CHNL;
      BIND RELEASE=#71;

      IF .CHNL[ADRWORD] EQL 0 THEN RETURN NOVALUE;
      EXECUTE(RELEASE,.CHNL,0);
      IF .CHNL[BHADRF] NEQ 0 THEN RELEASESPACE(ST,.CHNL[BHADRF],HDRSIZE);
      IF .CHNL[BADRF] NEQ 0 THEN RELEASESPACE(ST,.CHNL[BADRF],.CHNL[BUFSIZEF]);
      CHNL[ADRWORD]_0
    END; ! OF RLS


GLOBAL ROUTINE RESET=
    BEGIN
      DECR I FROM #17 TO 1 DO RLS(.I);
      CALLI(0,0);
    END; ! OF RESET

MACRO
	FILE=LEBLOCK[0]$,
	EXT=LEBLOCK[1]$,
	JUNK=LEBLOCK[2]$,
	PPN=LEBLOCK[3]$;


GLOBAL ROUTINE FILESELECT(CHNL,INPUT)=
    BEGIN
    REGISTER R;
      MAP BUFVEC CHNL;
      BIND LOOKUP=#76,	ENTER=#77;
      LOCAL LEBLOCK[4];
      FILE_.CHNL[FILENAMEF];
      IF .CHNL EQL SRCCHN THEN SRCFIL_.FILE;
      EXT_.CHNL[EXTF]^18;
      IF .CHNL EQL SRCCHN THEN SRCEXT_.EXT;
      JUNK_0;
      PPN_.CHNL[PPNF];
      SKIP(EXECUTE(IF .INPUT THEN LOOKUP ELSE ENTER,.CHNL,LEBLOCK<0,0>))
    END; ! OF FILESELECT

%<
GLOBAL ROUTINE NTR(CHNL)=
    BEGIN
      REGISTER R;
      MAP BUFVEC CHNL;
      BIND ENTER=#77;
      LOCAL LEBLOCK[4];
      FILE_.CHNL[FILENAMEF];
      EXT_.CHNL[EXTF]^18;
      JUNK_0;
      PPN_.CHNL[PPNF];
      SKIP(EXECUTE(ENTER,.CHNL,LEBLOCK<0,0>))
    END; ! OF NTR
>%

    ROUTINE CHECKTTY=
	! RETURNS 1 IF TTY WILL ACCEPT OUTPUT, OTHERWISE 0
	BEGIN
	REGISTER R;
	EXTERNAL TRMBLOCK,
		 JOBNUM;
	BIND PJOB=#30,
	     TRMNO=#115,
	     TRMOP=#116,

	     TOCOM=#1001;

	IF TENEX THEN RETURN 1;
	IF .TTYDIR LSS 0 THEN RETURN 1;
	IF .JOBNUM EQL 0			! FIRST CALL ON CHECKTTY
	    THEN BEGIN
		JOBNUM_CALLI(R,PJOB);
		TRMBLOCK[0]_TOCOM
		END
	    ELSE R_.JOBNUM;
	IF NOT SKIP(CALLI(R,TRMNO))
	    THEN RETURN (.R NEQ 0)		! JOB IS DETACHED
						! OR UUO NOT IMPLEMENTED
	    ELSE BEGIN
		TRMBLOCK[1]_.R;
		R_(2^18) OR TRMBLOCK<0,0>;
		IF NOT SKIP(CALLI(R,TRMOP))
		    THEN RETURN 1		! PROBABLY, UUO NOT IMPLEMENTED
		    ELSE IF .R NEQ 0
			THEN RETURN 0		! TERMINAL IN MONITOR MODE
		END;
	RETURN 1
	END;	! OF CHECKTTY

GLOBAL ROUTINE TTYLIST(CHAR)=
    BEGIN
      MACHOP OUTPUT=#67;
      IF NOT CHECKTTY() THEN RETURN;
      REPLACEI(BUFDATA[TTYCHN,BYTEPF],.CHAR);
      OUTPUT(TTYCHN,0);
      NOVALUE
    END; ! OF TTYLIST

GLOBAL ROUTINE TTYMES(PTR)=
    BEGIN
    LOCAL SAVDEV;
    SAVDEV_.DEVICE;
    DEVICE_TTYDEV;
    OUTXSTRING(.PTR,#777777,0);
    DEVICE_.SAVDEV;
    NOVALUE
    END; ! OF TTYMES

%<  GLOBAL ROUTINE OUTPUT(CHUNK)=
    ! OUTPUT A CHUNK (FULLWORD OR CHAR) ON 'DEV', WHERE
    !    DEV=1    TTY				:TTYDEV
    !        2    BINARY DEVICE			:BINDEV
    !        4    LISTING DEVICE		:LSTDEV
    !	     5	  LISTING DEVICE AND TTY	:ERRDEV
  
	BEGIN
	OWN D,D1;
	IF .DEVICE OR ((.DEVICE EQL LSTDEV) AND .TTYLST AND NOT .LSTFLG) THEN TTYLIST(.CHUNK);
	D_.DEVICE AND NOT TTYDEV;
	IF .D EQL 0 THEN RETURN;
	IF .D EQL LSTDEV THEN IF .TTYLST THEN RETURN;
	D1_IF .D EQL BINDEV THEN .BINFLG ELSE .LSTFLG;
	IF NOT .D1 THEN
	    BEGIN
	    MAP BUFVEC D;
	    D_CASE .DEVICE^(-1) OF SET 0; BINCHN; LSTCHN TES;
	    IF (D[BYTECF]_.D[BYTECF]-1) LEQ 0 THEN FORCE(.D);
	    REPLACEI(D[BYTEPF],.CHUNK);
	    END;
	END;
>%

GLOBAL ROUTINE OUTPUT(CHUNK)=
	BEGIN
	! OUTPUT A CHUNK (WORD OR CHAR) TO THE PLACE SPECIFIED
	! BY THE VALUE OF THE GLOBAL VARIABLE DEVICE.
	! DEVICE= 1 --> TTY (TTYDEV)
	!	  2 --> BINARY DEVICE (BINDEV)
	!	  4 --> LISTING DEVICE (LSTDEV)
	!	  5 --> LISTING DEVICE AND TTY (ERRDEV)

	MACRO PUT(CH)=
	    BEGIN
	    REPLACEI(BUFDATA[CH,BYTEPF],.CHUNK);
	    IF (BUFDATA[CH,BYTECF]_.BUFDATA[CH,BYTECF]-1) LEQ 0 THEN FORCE(CH);
	    END$;
	BIND GARBAGE=0;
	CASE .DEVICE OF
	SET
	    ! 0
		0;
	    ! 1 - TTYDEV
		TTYLIST(.CHUNK);
	    ! 2 - BINDEV
		PUT(BINCHN);
	    ! 3
		0;
	    ! 4 - LSTDEV
		IF NOT .LSTFLG THEN (IF .TTYLST THEN TTYLIST(.CHUNK) ELSE PUT(LSTCHN));
	    ! 5 - ERRDEV
		IF NOT .TTYLST THEN (PUT(LSTCHN); IF NOT .ERRBIT THEN TTYLIST(.CHUNK))
		    ELSE TTYLIST(.CHUNK)
	TES;
	1
	END;

GLOBAL ROUTINE OUTXSTRING(PTR,LIMIT,REQD)=
    BEGIN
	LOCAL DOTTY,DOLST;
	LOCAL LOOPVAL;
	REGISTER SRCPTR,DSTPTR,CHAR,NLIMIT;
	BIND SPACES=(PLIT (26:'     '))<29,7>;

    ! DECIDE WHICH DEVICES TO OUTPUT TO

	DOTTY_DOLST_0;
	CASE .DEVICE OF
	  SET
	    RETURN;
	    DOTTY_-1;
	    RETURN;
	    RETURN;
	    IF .LSTFLG THEN RETURN 0 ELSE IF .TTYLST THEN DOTTY_-1 ELSE DOLST_-1;
	    (IF NOT .ERRBIT THEN DOTTY_-1; IF .TTYLST THEN DOTTY_-1 ELSE DOLST_-1)
	  TES;
	IF .DOTTY THEN DOTTY_CHECKTTY();
	IF NOT (.DOTTY OR .DOLST) THEN RETURN;

    ! OUTPUT TO THE TTY

	IF .DOTTY THEN
	  BEGIN
	  NLIMIT_0;
	  SRCPTR_.PTR;
	  CHAR_SCANN(SRCPTR);
	  WHILE 1 DO
	    BEGIN
	    DSTPTR_.BUFDATA[TTYCHN,BYTEPF];
	    LOOPVAL_DECR I FROM .BUFDATA[TTYCHN,BYTECF] TO 1 DO
		     BEGIN
		     IF .NLIMIT EQL .LIMIT THEN EXITLOOP .I
		     ELSE IF .CHAR EQL "?0" THEN EXITLOOP .I
		     ELSE IF .CHAR EQL "?1" THEN EXITLOOP .I;
		     REPLACEI(DSTPTR,.CHAR);
		     CHAR_SCANI(SRCPTR);
		     NLIMIT_.NLIMIT+1
		     END;
	    BUFDATA[TTYCHN,BYTEPF]_.DSTPTR;
	    FORCE(TTYCHN);
	    IF .LOOPVAL GTR 0
		THEN EXITLOOP;
	    END;
	  END;

    ! OUTPUT TO THE LISTING DEVICE

	IF .DOLST THEN
	  BEGIN
	  NLIMIT_0;
	  SRCPTR_.PTR;
	  CHAR_SCANN(SRCPTR);
	  WHILE 1 DO
	    BEGIN
	    DSTPTR_.BUFDATA[LSTCHN,BYTEPF];
	    LOOPVAL_DECR I FROM .BUFDATA[LSTCHN,BYTECF] TO 1 DO
		     BEGIN
		     IF .NLIMIT EQL .LIMIT THEN EXITLOOP .I
		     ELSE IF .CHAR EQL "?0" THEN EXITLOOP .I
		     ELSE IF .CHAR EQL "?1" THEN EXITLOOP .I;
		     REPLACEI(DSTPTR,.CHAR);
		     CHAR_SCANI(SRCPTR);
		     NLIMIT_.NLIMIT+1
		     END;
	    BUFDATA[LSTCHN,BYTEPF]_.DSTPTR;
	    IF .LOOPVAL LSS 0
		THEN FORCE(LSTCHN)
		ELSE (BUFDATA[LSTCHN,BYTECF]_.LOOPVAL;
		      EXITLOOP);
	     END;
	  END;

    ! OUTPUT TRAILING BLANKS IF NECESSARY

	IF .NLIMIT LSS .REQD THEN
	  NLIMIT_.NLIMIT+OUTXSTRING(SPACES,.REQD-.NLIMIT,0);
	.NLIMIT
    END; ! OF OUTXSTRING




ROUTINE STOP(STR,NUM)=
    BEGIN
      LOCAL SDEV;
      EXTERNAL JOBSA,JOBDDT;
      SDEV_.DEVICE;
      DEVICE_ERRDEV;
      OUTXSTRING(.STR,4,4); OUTS('! #');
      OUTDEC(.NUM,0);
      CRLF; CRLF;
      DEVICE_.SDEV;
      IF .JOBDDT NEQ 0 THEN SIX12(-1) ELSE (.JOBSA)();
    END; ! OF STOP

GLOBAL ROUTINE PUNT(NUM)=STOP(MSG(PUNT),.NUM);
GLOBAL ROUTINE QUIT(NUM)=STOP(MSG(QUIT),.NUM);

GLOBAL ROUTINE ERR8=
    BEGIN ! TRANSMISSION ERROR ON INPUT DEVICE
    TTYMES(MSG(??Transmission error on input device?M?J));
    QUIT(8)
    END; ! OF ERR8

GLOBAL ROUTINE ERR12=
    BEGIN ! INPUT LINE TOO LONG
    TTYMES(MSG(??Input line too long:?M?J));
    REPLACEN(PBUFF,0);	! TO TERMINATE LINE TYPEOUT
    TTYMES(BUFF<29,7>); TTYMES(MSG(?M?J));
    QUIT(12)
    END; ! OF ERR12

GLOBAL ROUTINE FORCE(CHNL)=
    BEGIN
      REGISTER R;
      BIND OUT=#57;
      IF NOT SKIP(EXECUTE(OUT,.CHNL,0)) THEN RETURN NOVALUE;
      TTYMES(MSG(??Output error on ));
      TTYMES(IF .CHNL EQL BINCHN
		THEN MSG(binary )
		ELSE MSG(listing ));
      TTYMES(MSG(device?M?J));
      QUIT(45)
    END; ! OF FORCE

    ROUTINE DAYOFWEEK(M,D,Y)=
	((13*(.M+10-(.M+10)/13*12)-1)/5+.D+77
	+5*(.Y+(.M-14)/12-(.Y+(.M-14)/12)/100*100)/4
	+(.Y+(.M-14)/12)/400-(.Y+(.M-14)/12)/100*2) MOD 7;

ROUTINE GETDATE=
    BEGIN
      LOCAL T;
      BIND
	    MONTHPLIT=PLIT(
		    '-Jan-',
		    '-Feb-',
		    '-Mar-',
		    '-Apr-',
		    '-May-',
		    '-Jun-',
		    '-Jul-',
		    '-Aug-',
		    '-Sep-',
		    '-Oct-',
		    '-Nov-',
		    '-Dec-'   );

      BIND
	    DAYPLIT = PLIT(
		'Sunda', 'y',
		'Monda', 'y',
		'Tuesd', 'ay',
		'Wedne', 'sday',
		'Thurs', 'day',
		'Frida', 'y',
		'Satur', 'day'  );

      CALLI(VREG,#14);
      T_.VREG;
      XDATE[0]_(.T MOD 31) + 1;
      XDATE[1]_(T_.T/31) MOD 12;
      XDATE[2]_.T/12 + 64;
      XDATE[3]_DAYPLIT[DAYOFWEEK(.XDATE[1]+1,.XDATE[0],.XDATE[2]+1900)*2];
      XDATE[1]_.MONTHPLIT[.XDATE[1]]
    END; ! OF GETDATE


ROUTINE OUTSIXP(PTR,LIM)=
    BEGIN
    LOCAL C,P;
    P_(.PTR)<36,6>;
    DECR I FROM .LIM-1 TO 0 DO
	IF (C_SCANI(P)) EQL 0 THEN EXITLOOP
	    ELSE OUTPUT(.C+#40)
    END; ! OF OUTSIXP

GLOBAL ROUTINE PAGE=
    BEGIN
      EXTERNAL JOBVER;
      MAP BUFVEC CURCHN;
    LOCAL SAVDEVICE;
    SAVDEVICE_.DEVICE;
    DEVICE_LSTDEV;
      DOPAGE_0;
      PAGCNT_.PAGCNT+1;
      IF .LSTFLG THEN RETURN;
      OUTPUT(IF .TTYLST THEN #13 ELSE #14);
      OUTP(IF BLIS11 THEN PLIT ASCIZ '; BLIS11 V.'
		     ELSE PLIT ASCIZ 'BLIS10?IV.');
      OUTDEC(.JOBVER<RH>,IF BLIS11 THEN 0 ELSE 6);
      TAB;
      IF .XDATE EQL 0 THEN GETDATE();
      OUTP(.XDATE[3]); OUTPUT(" ");
      OUTDEC(.XDATE[0],0);
      OUTP(XDATE[1]);
      OUTDEC(.XDATE[2],0);
      OUTPUT(" ");
      BEGIN
	LOCAL M,S,T;
	CALLI(VREG,#22);
	T_.VREG;
	T_.T/60;
	S_.T MOD 60;
	T_.T/60;
	M_.T MOD 60;
	OUTDEC(.T/60,1);
	OUTPUT(":");
	OUTDEC(.M,2);
	OUTPUT(".");
	OUTDEC(.S,2);
	TAB
      END;
      IF NOT .TTYLST THEN
       ( OUTSIXP(IF .CURCHN[ADRWORD] EQL 0 THEN SRCFIL ELSE CURCHN[FILENAMEF],6);
	OUTPUT(".");
	OUTSIXP(IF .CURCHN[ADRWORD] EQL 0 THEN SRCEXT ELSE CURCHN[EXTF],3);
	TAB    );
      OUTS('Page ');
      OUTDEC(.SOSPGC,0);
      IF .PAGCNT GTR 0 THEN
       ( OUTPUT("-");
	 OUTDEC(.PAGCNT,0)  );
      OUTS('?M?J?M?J');
      NLINES _ 0;
      DEVICE_.SAVDEVICE
    END; ! OF PAGE

END
END
ELUDOM