Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE TTYIO=
BEGIN
!Module to do terminal I/O on TOPS-10
!
!Conditionals
!
COMPILETIME FTNONBLOCK=%VARIANT AND 1;
!On for non-blocking TTY I/O (use PSI)
COMPILETIME FTNETSPL=(%VARIANT AND 2) NEQ 0;
!On to support the LOG command in NETSPL
!Also forces on FTLOG and FTNONBLOCK
!COMPILETIME FTLOG=(%VARIANT AND 16) NEQ 0;
!On for LOG file support (set from library file)
!FTDET is also set in the library file
%IF FTNETSPL %THEN %(%ASSIGN(FTLOG,1))% %ASSIGN(FTNONBLOCK,1) %FI

COMPILETIME CHECKPOINTBUG=1;
!On if the FILOP. function .FOURB forces out the current block & does
!not back up after updating everything, resulting in 1 line of output
!+ a whole lotta nulls per disk block.  We get around this by using
!a CLOSE followed by an OPEN for APPEND (.FOCLS & .FOAPD)

!
! Require & Library files
!
%IF FTNONBLOCK
	%THEN REQUIRE 'INTR.REQ'
	%ELSE LIBRARY 'TBL'
	%FI;

!
!Table of Contents
!
FORWARD ROUTINE
TTYIN,
TTYINC,
LOGC,	!Log a character into the LOG file
LOGS, !Log an ASCIZ string
LOG;	!The LOG command (open a log file)
%IF FTNETSPL %THEN
FORWARD ROUTINE
TTYINI,	!Initialize TTY interrupts
LOGHANDLE;
%FI
%IF FTDET %THEN
FORWARD ROUTINE
DETACH,
TYPCHR,
TYPSTR,
TRMOP,
DET_TTY,
ATTACH_TTY,
UDX,
TTYCHK;
%FI

!
!Tell about conditionals
!
%IF FTNETSPL %THEN %INFORM('TTYIO for NETSPL')
%ELSE	%IF FTLOG %THEN %INFORM('TTYIO with LOG support') %FI
	%IF FTNONBLOCK %THEN %INFORM('TTYIO with PSI support') %FI
	%FI
%IF %SWITCHES(DEBUG) %THEN
	%WARN('TTYIO WITH /DEBUG')
	%FI

THIS_IS [TTYI] VERSION [1] EDIT [10]	DATE [30,OCT,79]

%(***	R E V I S I O N   H I S T O R Y

[10]	FRCUUO also does ^C on 7.00, so use ATTACH UUO
[7]	Only 1 buffer each way for LOG file, fix error messages for LOG cmd.
[6]	Make the first block get timestamped by initializing LFFLG nonzero
[5]	Make CHECKPOINTBUG write-around free I/O buffers instead of losing them
[4]	Put in DETACH support
[3]	Put in logging
[2]	Put in conditional for non-blocking
[1]	The Beginning

END	R E V I S I O N   H I S T O R Y		)%

!
! OWN storage
!
OWN LFFLG;

!
!Externals
!
EXTERNAL ROUTINE
	BOUT,
	WRITE,
	OUTPUT;
%IF FTNETSPL %THEN
EXTERNAL ROUTINE
	UDT,
	TSIGNL,
	TSICAN,
	TSTAMP,	!Time stamper
	COPY,
	RELEASE,
	TFB,
	FBINI,
	FPARSE,
	BUFFREE,
	EATSPACES;
%FI
%IF FTDET %THEN
EXTERNAL ROUTINE INTINI;
%FI

%IF FTNONBLOCK %THEN
EXTERNAL	RUN: REF PROCESS_BLOCK;	!Current process
%FI

!
!Literals
!
LITERAL TTYTMO_INTERVAL=1;	!check every time we wake up (1/3 sec)
LITERAL CNOPR=XWD(%O'13',%O'11'); !GETTAB for OPR terminal
LITERAL DV_TTY=%O'10000000';	!DEVCHR: device is a TTY
LITERAL _TOOUC=5;		!TRMOP: output a character
LITERAL _TOOUS=7;		!TRMOP: output an ASCIZ string
LITERAL _TOHPS=%O'1011';	!TRMOP: horizontal position of carriage
LITERAL LF=%O'12';
!
!Macros
!
%IF CHECKPOINTBUG %THEN
UNDECLARE %QUOTE CHECKPOINT;
MACRO CHECKPOINT(FB)=
	BEGIN	!The FILOP. function .FOURB sets the pointer to the next block
	EXTERNAL ROUTINE BUFFREE;
	CLOSE(FB);	!but .FOCLS followed by .FOAPD works correctly
	BUFFREE(.FB[FILE$O_BRH]);	!Free the I/O buffers
	BUFFREE(.FB[FILE$I_BRH]);
	OPEN_A(FB)
	END%;
%FI

!
!Global Data
!
%IF FTNONBLOCK %THEN
GLOBAL TTYBLK: FILE_BLOCK;
GLOBAL TTYINTBLK: INT_BLOCK;	!Interrupt block for TTY
%FI
%IF FTLOG %THEN
GLOBAL LOGBLK: FILE_BLOCK;
%FI
%IF FTDET %THEN
GLOBAL PRIOUT;	!Our terminal output device
GLOBAL TERMINAL; !Our terminal
GLOBAL DETINTBLK: INT_BLOCK;	!Interrupt block for ATTACH/DETACH
%FI

!
!Routines
!

GLOBAL ROUTINE TTYIN(PTR,MAXLEN)=
!Routine to input a string from TTY (or AUTO file)
! and log it on LOG file if any
BEGIN
LOCAL C;	!Last character
DECR LEN FROM .MAXLEN TO 1 DO
	SELECT (C=TTYINC()) OF SET
		[%O'15']:			TTYINC(); !Get trailing LF
		[%O'15',%O'12',%O'33',%O'7']:	(CH$WCHAR_A(0,PTR);RETURN .C);
		[OTHERWISE]:			CH$WCHAR_A(.C,PTR)
		TES;
END;

GLOBAL ROUTINE TTYINC=
!Routine to get a character from TTY
!Returns: character (right justified)
BEGIN
MACRO TTCALL(FUN,ADDR)=(BUILTIN MACHSKIP;MACHSKIP(%O'051',FUN,ADDR))%;
LOCAL C;	!Character

%IF FTNONBLOCK %THEN
	BEGIN
	LOCAL	TTYTMO: INT_BLOCK,	!Wake us up in case PSISER doesn't
		TTO;			!Handle for timer
	CLEARV(TTYTMO);			!Empty block means just wake us up
	WHILE TTCALL(5,C) EQL 0 DO
		BEGIN
		TTO=TSIGNL(TTYTMO,UDT()+TTYTMO_INTERVAL); !Set timer
		WAIT(TTYINTBLK);	!INCHSL
		TSICAN(.TTO)		!Remove timer request
		END;
	END;

%ELSE TTCALL(4,C);			!INCHWL
%FI

%IF FTLOG %THEN LOGC(.C) ; %FI

.C					!Return the character
END;

GLOBAL ROUTINE LOGC(CHAR)=
!Write a character to the LOG file (if any)
!CHAR: Character to write
!Returns: Character that was passed to it
BEGIN
%IF FTLOG %THEN			!Just return character if NOT FTLOG

IF .LOGBLK[FILE$NAME] NEQ 0 THEN
	BEGIN
	IF .LFFLG NEQ 0 THEN
		BEGIN
		LFFLG=0;
		TSTAMP();
		END;
	BOUT(LOGBLK,.CHAR);	!Write out the character
	IF .CHAR EQL LF THEN
		BEGIN
		LFFLG=1;
		CHECKPOINT(LOGBLK) !Update rib if end of line
		END
	END;
%FI

.CHAR	!Returned value
END;	!LOGC
GLOBAL ROUTINE LOGS(STR)=
!Log an ASCIZ string in the LOG file (if any)
!STR: address of ASCIZ string (if LH=0) or byte pointer (if LH nonzero)
BEGIN

%IF FTLOG %THEN				!If NOT FTLOG routine is a no-op.
IF .LOGBLK[FILE$NAME] NEQ 0 THEN
	BEGIN
	REGISTER C;
	IF .STR<LH> EQL 0 THEN STR=CH$PTR(.STR); !Make into byte pointer if not
	WHILE (C=CH$RCHAR_A(STR)) NEQ 0 DO LOGC(.C);
	END;
%FI

END;	!LOGS

GLOBAL ROUTINE LOG(PTR,ARGS)=
!The "LOG" command: Open a new LOG file
!PTR: Address of byte pointer to command string (returned updated past filespec)
!ARGS: Additional arguments from caller (not used)
BEGIN
%IF FTLOG AND FTNETSPL %THEN

MACRO PREFIX='LOG'%;		!Prefix for MSG macro

LOCAL LOGSAV: FILE_BLOCK;	!Save old contents of LOGBLK

ESTABLISH (LOGHANDLE,LOGSAV);	!Set up handler

IF .LOGBLK[FILE$NAME] EQL 0
	THEN FBINI(LOGBLK) 		!Init if first time
	ELSE	BEGIN
		CHECKPOINT(LOGBLK);	!Update RIB first
		MSG('[','','  Previous log file was: ');
		TFB(LOGBLK);		!Say what we are replacing
		TYPE(']',CRLF);
		END;
COPY(LOGBLK,LOGSAV,FB_LEN);
EATSPACES(.PTR);

LOGBLK[FILE$EXTENSION]=(%SIXBIT'LOG')^-18;	!Set defaults
LOGBLK[FILE$NAME]=%SIXBIT'NETSPL';	
FPARSE(LOGBLK,.PTR);

	BEGIN
	IF .LOGSAV[FILE$NAME] NEQ 0
	 THEN	BEGIN
		CLOSE(LOGBLK); !Do a CLOSE
		BUFFREE(.LOGBLK[FILE$I_BRH]);	!Free the I/O buffers
		BUFFREE(.LOGBLK[FILE$O_BRH]);	!
		END;

	LOGBLK[FILE$MODE]=_IOASC;	!ASCII always
	LOGBLK[FILE$I_NBUFF]=(LOGBLK[FILE$O_NBUFF]=1); !1 buffer for each
	LOGBLK[FILE$GODLY]=1;		!As much access as possible
	OPEN_A(LOGBLK);	!Open for append
	LOGS(UPLIT(CRLF));			!Force timestamp
	END

%ELSE TYPE('%',PPREFIX,'LNS  LOG file not supported')
%FI
END;	!LOG
%IF FTNETSPL %THEN
GLOBAL ROUTINE TTYINI=
!Initialize TTY interrupts
BEGIN
EXTERNAL	INTTBL: VECTOR;

CLEARV(TTYBLK);		!Zero the TTY block first
			!This also gives us channel 0 which is reserved for TTY
PRIOUT=UDX(%SIXBIT'TTY');	!Set up primary output
TTYBLK[FILE$DEVICE]=%SIXBIT'TTY';
OPEN_U(TTYBLK);
TTYINTBLK[INT$WHAT]=.TTYBLK[FILE$CHANNEL];
TTYINTBLK[INT$REASONS]=%O'200000';	!Input done only
TTYINTBLK[INT$OFFSET]=0;	!The first slot is reserved for us
TTYINTBLK[INT$PROCESS]=.RUN;
INTTBL[0]=TTYINTBLK;		!Store interrupt block for handler
INTERRUPTS(ADD,TTYINTBLK);
!!!INTERRUPTS(CLEARDEV,TTYINTBLK);
%IF FTDET %THEN
	BEGIN
	IF .DETINTBLK[INT$OFFSET] EQL 0 THEN INTINI(DETINTBLK);
		!Initialize block if not done already
	DETINTBLK[INT$WHAT]=_PCDAT;	!ATTACH & DETACH interrupts
	DETINTBLK[INT$SIGNAL_ARGS]=4;	!Signal REATTA
	DETINTBLK[INT$S_ALWAYS]=1;
	DETINTBLK[INT$STSCODE]=REATTA;
	DETINTBLK[INT$SEVERITY]=SS$_WARN;
	INTERRUPTS(ADD,DETINTBLK);
	INTERRUPTS(CLEARDEV,DETINTBLK);
	END %FI;
END; !TTYINI

ROUTINE LOGHANDLE(SIGNAL_ARGS,MECH_ARGS,ENABLE_ARGS)=
!Condition handler for the LOG command
!Standard condition-handler arguments
!ENABLE_ARGS[1] is address of LOGSAV (old logfile spec)
BEGIN
MAP ENABLE_ARGS: REF VECTOR;
MAP MECH_ARGS: REF VECTOR;
MAP SIGNAL_ARGS: REF VECTOR;

LOCAL ERRSTRING;	!Will hold address of error message
MACRO PREFIX='COL'%;	!Prefix for MSG macro

BIND LOGSAV=.ENABLE_ARGS[1]: FILE_BLOCK;
EXTERNAL ROUTINE
	UNWIND,
	TFB,
	COPY,
	ERTEXT;

SELECT .$CODE OF SET
[FILERR TO FILOPN,FPAERR TO FPAERR+%O'17']:
	BEGIN
	BUFFREE(.LOGBLK[FILE$I_BRH]);	!Free the I/O buffers
	BUFFREE(.LOGBLK[FILE$O_BRH]);	!
	COPY(LOGSAV,LOGBLK,FB_LEN);	!Restore log file block
	IF .LOGBLK[FILE$NAME] NEQ 0 THEN
		BEGIN
		LOGSAV[FILE$NAME]=0;	!Prevent infinite recursion if open fails
		OPEN_A(LOGBLK);	!Try to re-open old one
		END
	ELSE	BEGIN
		LOGBLK[FILE$NAME]=0;
		RELEASE(LOGBLK);	!Give channel back
		END;
	WRN_NCRLF('Can''t Open LOG file (');
	ERRSTRING=ERTEXT(.$CODE);
	TSTR(.ERRSTRING);	!Type error message
	TYPE(')',CRLF);
	IF .LOGBLK[FILE$NAME] NEQ 0 THEN
		BEGIN
		MSG('[','','  Old log file: ');
		TFB(LOGBLK);	!Re-open old one
		TYPE(' re-opened]',CRLF);
		END;
	UNWIND(.MECH_ARGS[MA_DEPTH]+1)	!Unwind thru caller
	END;
[OTHERWISE]:	RETURN SS$_RESIGNAL;
TES;
END;	!LOGHANDLE
%FI

%IF FTDET %THEN
GLOBAL ROUTINE DETACH(PTR,ARGS)=
!The "DETACH" command.
!Abstract:	Detach the job from the terminal & continue operation
!		If an argument is given to the command, it is the
!		terminal to direct output to, otherwise direct it nowhere.
!		Note that "TTY" is a valid argument, directing output to
!		the terminal we are about to detach from.
!		Output is done via TRMOP. so the terminal is avaliable
!		for other use.
!		Control is not returned until the terminal is reattached
!		but the program may run anyway if interrupt-driven.
!Formals:
!PTR:	Address of byte pointer to command string
!ARGS:	Additional arguments (ignored)
!Returns: nothing
BEGIN
EXTERNAL ROUTINE
TTYINI,
WAIT,
INTINI,
INTFREE,
RDSIXA,
GETARG;
LOCAL OUTUDX;
LOCAL DETBLK: INT_BLOCK;

IF GETARG(.PTR) EQL 1
THEN	BEGIN
	OUTUDX=UDX(RDSIXA(.PTR));	!Get device name & convert to UDX
	IF TTYCHK(.OUTUDX)
		THEN PRIOUT=.OUTUDX	!Use if a valid TTY
		ELSE	BEGIN
			UNDECLARE %QUOTE PREFIX;
			MACRO PREFIX=%ASCIZ'DET'%;
			!Prefix for following messages
			WRN('"DETACH" argument is not a TTY');
				INFO('Job not detached');
			RETURN
			END
	END
ELSE	PRIOUT=0;			!No terminal output at all
DET_TTY();
INTERRUPTS(CLEARDEV,DETBLK);	!Don't enable until now or we get one right away
END; !DETACH

GLOBAL ROUTINE TYPCHR(CHR)=
!Routine to type a character on the output terminal
!CHR: character to type (right justified)
IF .PRIOUT NEQ 0 THEN
	TRMOP(_TOOUC,.PRIOUT,.CHR);


GLOBAL ROUTINE TYPSTR(STR)=
!Routine to type an ASCIZ string on the output terminal
!STR: address of ASCIZ string
IF .PRIOUT NEQ 0 THEN
	TRMOP(_TOOUS,.PRIOUT,.STR);

GLOBAL ROUTINE POS=
!Routine to return carriage position of output terminal
!Returns: horizontal position of carriage (or what monitor thinks it is)
IF .PRIOUT NEQ 0 THEN
	TRMOP(_TOHPS,.PRIOUT,0);

GLOBAL ROUTINE TELLOPR(STR)=
!Routine to type a string on OPR: device (may be remote OPR:)
BEGIN
LOCAL OPRDEV;
EXTERNAL ROUTINE GETTAB,UDX;

IF (OPRDEV=GETTAB(CNOPR)) NEQ 0
	THEN TRMOP(_TOOUS,UDX(.OPRDEV),.STR);
END; !TELLOPR

ROUTINE TRMOP(FUN,DESIGNATOR,ARG)=
!Routine to do a TRMOP. UUO
!FUN: Function code (1st argument to TRMOP.)
!DESIGNATOR: UDX of terminal (2nd argument to TRMOP.)
!ARG: Third argument to TRMOP.
BEGIN
REGISTER R;
LOCAL TRMOP_BLOCK: VECTOR[3];
TRMOP_BLOCK[0]=.FUN;
TRMOP_BLOCK[1]=.DESIGNATOR;
TRMOP_BLOCK[2]=.ARG;
R=TRMOP_BLOCK;	R<LH>=3;	!R <- len,,addr
CALLI(R,%O'116');		!TRMOP. UUO
END;

ROUTINE DET_TTY=
!Routine to detach the job from the terminal
BEGIN
REGISTER R;
LOCAL FRCBLK;

R=-1; CALLI(R,%O'115');	!TRMNO. of our terminal
IF .R EQL 0 THEN RETURN 0; !Already detached?
R=(.R<0,9>+%O'400000')^18;
CALLI(R,%O'104');	!ATTACH (our line to nothing!)
END; !DET_TTY

GLOBAL ROUTINE ATTACH_TTY(DESIGNATOR)=
!Routine to attach our job to the designated terminal (in user mode)
BEGIN
REGISTER R;
LITERAL AT_UUM=%O'200000000000';	!Force into user mode
LITERAL AT_SLF=%O'777777';		!Our job

R=AT_UUM+AT_SLF;			!Our job # + user mode
R<18,9>=.DESIGNATOR;			!Bottom 9 bits of UDX is unit #
CALLI(R,%O'104')			!ATTACH UUO
END; !ATTACH_TTY

GLOBAL ROUTINE UDX(NAME)=
!Routine to get the Universal Device Index of a device
!NAME: Sixbit name of device
!Returns: UDX of device
BEGIN
REGISTER R;
R=.NAME;
CALLI(R,%O'127');			!IONDX. UUO
.R					!Return the UDX as value
END; !UDX

ROUTINE TTYCHK(DESIGNATOR)=
!Make sure a device is a TTY
!DESIGNATOR: Device designator to check
!Returns: 1 if a TTY, 0 otherwise
BEGIN
LITERAL DV_TTY=%O'10000000';	!Bit returned from DEVCHR for TTY
REGISTER R;
R=.DESIGNATOR;
CALLI(R,4);	!DEVCHR UUO
(.R AND DV_TTY) NEQ 0	!Return true if bit is on
END;	!TTYCHK
%FI
END ELUDOM