Google
 

Trailing-Edge - PDP-10 Archives - bb-4157j-bm_fortran20_v11_16mt9 - fortran-compiler/blio.bli
There are 12 other files named blio.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1987
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
!AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

! Author: */AHM

MODULE BLIO=
BEGIN

GLOBAL BIND BLIOV = #11^24 + 0^18 + 1;	! Version Date:	24-Jul-81

%(

***** Begin Revision History *****

***** Begin Version 6 *****

1	1077	AHM	8-Jun-81	-----
	Put in missing JFCL after GETPPN uuo in GETPPN routine.

***** End Revision History *****

)%

%(
	THE CHANNEL TABLE
)%
	MACRO TABMAX=16$, TABSIZ=15$; % MAX CHANNELS AND SIZE %
	STRUCTURE CHTB[I,J]=[(I+1)*(J+1)]((.CHTB+.I*(J+1)+.J)<0,36>);
	GLOBAL CHTB CHNLTAB[TABMAX,TABSIZ];
	GLOBAL CHNLMAX;
	EXTERNAL IOZERROR;
	
%(
	C H A N N E L   T A B L E   M A C R O S
)%
%(
	STATUS WORD BITS
)%
MACRO
	FMODE=CHAN[0]$,
	FDEV=CHAN[1]$,
	FBUF=CHAN[2]$,
	FBUFO=CHAN[2]<18,18>$,
	FBUFI=CHAN[2]<0,18>$,
	FOBUFH=CHAN[3]$,
	FOPTR=CHAN[4]$,
	FOCNT=CHAN[5]$,
	FIBUFH=CHAN[6]$,
	FIPTR=CHAN[7]$,
	FICNT=CHAN[8]$,
	FFILE=CHAN[9]$,
	FEXT=CHAN[10]$,
	FERR=CHAN[10]<0,12>$,
	FBLK=CHAN[10]<0,18>$,	% DEVICE BLK NO DSK=0 %
	FPROT=CHAN[11]<27,9>$,
	FDMODE=CHAN[11]<23,4>$,
	FTIME=CHAN[11]<13,10>$,
	FDATE=CHAN[11]<0,12>$,
	FPPN=CHAN[12]$,
	FPRJ=CHAN[12]<18,18>$,
	FPRG=CHAN[12]<0,18>$,
	FSIZ=CHAN[12]<18,18>$,
	FSTATUS=CHAN[13]$,
	FSWITCH=CHAN[14]$,
	FNEWPR=CHAN[15]<0,10>$,
	FUSER=0,18$,	% ENTIRE USER FIELD %
	FYEND=0,1$,	% ENDFILE ALLOWED %
	FYREW=1,1$,	% REWIND ALLOWED  %
	FYREAD=2,1$,	% READING ALLOWED %
	FYWRITE=3,1$,	% WRITING ALLOWED %
	FYUPDAT=4,1$,	% UPDATING ALLOWED %
	FYDUMMY=5,1$,	% DUMMY CHANNEL   %
	FYSIMUL=6,1$,	% SIMULTANEOUS READ/WRITE ALLOWED %
	FPRIMARY=7,1$,	% PRIMARY DEFAULT VALUE %

% SYSTEM BITS OF STATUS WORD %
	FSYS=18,18$,	% ENTIRE SYSTEM FIELD %
	FROPEN=18,1$,	% FILE OPEN FOR INPUT %
	FWOPEN=19,1$,	% FILE OPEN FOR OUTPUT %
	FEOF=20,1$,	% ENDFILE ENCOUNTERED %
	FIS35=21,1$,	% BIT 35 IS SET %
	FSET35=22,1$,	% SET BIT 35 ON NEXT WRITE %
	FSEQ=24,1$,	% PROCESSING SEQUENCE NO. %
	FPGMK=25,1$,	% PROCESSING PAGE MARK %
	FFISTAR=26,1$,	% FILE NAME IS "*" %
	FXSTAR=27,1$,	% EXTENSION NAME IS "*" %
	FUOPEN=28,1$,	% FILE OPEN FOR UPDATE %
	FDEVAS=29,1$,	% DEVICE IS ASSIGNED THIS CHANNEL %
	FIOERR=30,1$,	% ERROR DETECTED %
	FNSET=35,1$;	% CHANNEL NOT SET %
MACRO
	XFYEND=1^0$,	% ENDFILE ALLOWED %
	XFYREW=1^1$,	% REWIND ALLOWED  %
	XFYREAD=1^2$,	% READING ALLOWED %
	XFYWRITE=1^3$,	% WRITING ALLOWED %
	XFYUPDAT=1^4$,	% UPDATE ALLOWED %
	XFYDUMMY=1^5$,	% DUMMY CHANNEL %
	XFYSIMUL=1^6$,	% SIMULTANEOUS READ/WRITE ALLOWED %
	XFPRIMARY=1^7$,	% PRIMARY DEFAULT VALUE %
	XFROPEN=1^18$,	% FILE OPEN FOR INPUT %
	XFWOPEN=1^19$,	% FILE OPEN FOR OUTPUT %
	XFEOF=1^20$,	% ENDFILE ENCOUNTERED %
	XFIS35=1^21$,	% BIT 35 IS SET %
	XFSET35=1^22$,	% SET BIT 35 ON NEXT WRITE %
	XFSEQ=1^24$,	% PROCESSING SEQUENCE NO. %
	XFPGMK=1^25$,	% PROCESSING PAGE MARK %
	XFFISTAR=1^26$,	% FILE NAME IS "*" %
	XFXSTAR=1^27$,	% EXTENSION NAME IS "*" %
	XFUOPEN=1^28$,	% FILE IS OPEN FOR UPDATE %
	XFDEVAS=1^29$,	% DEVICE ASSIGNED %
	XFIOERR=1^30$,	% I/O ERROR DETECTED %
	XFNSET=1^35$;	% CHANNEL NOT SET %
%(
	MACROS WHICH DEFINE THE CALLS TO SETTBL/GETTBL
)%
MACRO	UMAX=0$,	% MAXIMUM CHANNEL %
	UMODE=1$,	% DATA MODE %
	UDEV=2$,	% DEVICE IN SIXBIT %
	UOBUFF=3$,	% OUTPUT BUFFER HEADER POINTER %
	UIBUFF=4$,	% INPUT BUFFER HEADER POINTER %
	UOBUFFR=5$,	% ADDR OF OUTPUT BUFFER %
	UOPTR=6$,	% OUTPUT BUFFER BYTE POINTER %
	UOCNT=7$,	% OUTPUT BUFFER BYTE COUNT %
	UIBUFFR=8$,	% ADDR OF INPUT BUFFER %
	UIPTR=9$,	% INPUT BUFFER BYTE POINTER %
	UICNT=10$,	% INPUT BUFFER BYTE COUNT %
	UFILE=11$,	% FILE NAME IN SIXBIT %
	UEXT=12$,	% EXTENSION NAME IN SIXBIT %
	UBLK=13$,	% %
	UERR=14$,	% ERROR NUMBER %
	UPROT=15$,	% PROTECTION KEY %
	UDMODE=16$,	% CREATION DATA MODE %
	UTIME=17$,	% CREATION TIME %
	UDATE=18$,	% CREATION DATE %
	UPPN=19$,	% PPN %
	USTAT=20$,	% USER BITS OF STATUS WORD %
	USSTAT=21$,	% SYSTEM BITS OF STATUS WORD %
	USWITCH=22$,	% SWITCH WORD %
	UREPROT=23$,	% REPROTECTION WORD %
	USIZ=24$;	% FILE SIZE %
	FORWARD
CLOSE,		%(#30	PARAMETERS: A CHANNEL NUMBER
			FUNCTION: CLOSES THE SPECIFIED CHANNEL,
				RELEASES ITS DEVICE, AND RESETS THE
				ASSOCIATED BITS IN THE CHNLTAB ENTRY
			USES: XCT
			EXTERNALS: CHNLTAB
		)%

CMUDEC;		%(#40	PARAMETERS: LEFT JUSTIFIED ALPHA CMU
				CHARGE NO., OR 0.
					LEFT JUSTIFIED ALPHA CMU
				MAN NO., OR 0.
			FUNCTION: CONVERTS GIVEN PARAMETERS TO 
			DEC PPN NUMBERS....RETURNS 0 FOR 0-VALUES.
		
			VALUE: A DEC PPN---LEFT HALF PROJECT, RIGHT
				HALF PROGRAMMER.
		)%
	EXTERNAL
DEFAULTS;
	FORWARD
DUMCHN,		%(#37	PARAMETERS: 1) A CHANNEL NUMBER
			    	    2) THE DUMMY-MODE TO SET
					1 -> MARK AS DUMMY
					0 -> MARK AS NOT-DUMMY
			FUNCTION:  MARKS THE SPECIFIED CHANNEL
				AS A DUMMY CHANNEL (IF 
				MODE=1). DUMMY CHANNELS EAT UP
				OUTPUT AND RETURN ENDFILES ON INPUT.
				A CHANNEL MAY BE UNDUMMIED AT
				ANY TIME, SINCE IT DOES NOT AFFECT
				THE ENDFILE BITS ON READ.  THE
				SET35 BIT IS RESET ON DUMMY OUTPUT,
				HOWEVER.
			EXTERNALS: CHNLTAB
		)%
ENDALL,		%(#31	PARAMETERS: NONE
			FUNCTION: CLOSES ALL I/O CHANNELS
			USES: CLOSE
			EXTERNALS: CHNLTAB
		)%
ENTER,		%(#43	PARAMETERS: A CHANNEL NUMBER
			FUNCTION: PERFORMS AN ENTER UUO ON THE
				SPECIFIED CHANNEL
			VALUES: 1 => SUCCESS; 0 => FAILURE
		)%
FILLIN,		%( 26	FUNCTION: FILLS THE INPUT BUFFER FOR A
				GIVEN CHANNEL
			PARAMETERS: THE CHANNEL NUMBER
			USES: XINPUT, IOERR
			EXTERNALS: CHNLTAB
			VALUES:
				0 - END-OF-FILE OCCURED
				1 - SUCCESSFUL INPUT
		)%
GETCHAR,	%(  5	FUNCTION: RETURNS A SINGLE ASCII CHARACTER
				OBTAINED FROM THE TELETYPE.
			PARAMETERS: NONE
			USES: TTCALL (MONITOR UUO)
			VALUES: THE CHARACTER, RIGHT JUSTIFIED
		)%
GETPPN,		%(#23	FUNCTION: RETURNS THE VALUE OF THE 
				CURRENT PROJECT-PROGRAMMER NUMBER.
			USES: CALLI (MONITOR UUO)
			VALUE: THE PPN PAIR AS PER DEC SPECS.
		)%
GETSTAT,	%(#32
		)%
GETSW,		%(#36	PARAMETERS: 1) A CHANNEL NUMBER
			FUNCTION: RETURNS THE SWITCH WORD FOR THAT CHANNEL
			EXTERNALS: CHNLTAB
		)%
INVALID;	%(# 4
		)%
	EXTERNAL
IOERR;
	FORWARD
IOPACK,		%( 39  )%
ISREADOK,	%(  9
		)%
ISWRITEOK,	%( 18
		)%
LOOKUP,		%(#42	PARAMETERS: A CHANNEL NUMBER
			FUNCTION: PERFORMS A LOOKUP UUO ON
				THE SPECIFIED CHANNEL.
			VALUES: 1 => SUCCESS; 0 => FAILURE
		)%
OPEN,		%( 17	PARAMETERS: A CHANNEL NUMBER
			FUNCTION: EXECUTES AND OPEN INSTRUCTION ON THE DEVICE
				ASSOCIATED WITH THAT CHANNEL
			USES: XCTSKIP
			EXTERNALS: CHNLTAB
			VALUES 1-> SUCCESS; 0 -> FAILURE
		)%
OPENIN,		%( 16	PARAMETRS: A CHANNEL NUMBER
			FUNCTION: OPENS A DEVICE IF PERMISSIBLE AND
				PERFORMS A LOOKUP AND INBUF ON THAT CHANNEL
			USES: XCTSKIP,XCT,IOERR,IOPANIC,OPEN
			EXTERNALS: CHNLTAB,IOZERROR
			IOERRS: (7) LOOKUP FAILED
			        (8) OPEN FAILED
			VALUES: 1 -> SUCCESS; 0 -> FAILURE
		)%
OPENOUT,	%( 19
		)%
OUTMSG,		%(#38
		)%
PADNULL;	%(#25
		)%
	EXTERNAL 
IOPANIC;		%( 71	PARAMETERS: AN IOERR NUMBER
			FUNCTION: USED AS A IOPANIC STOP FOR
				ERROS WHICH HAVE NO RECOVERY
				BUT SOMEHOW RETURNED
			USES:PUTMSG,DECIMAL,TTYPUTS, CALLI ,12
		)%
	FORWARD 
PUTCHAR,	%( 28
		)%
PUTMSG,		%(#34	PARAMETERS: AN IOERR MESSAGE, BROKEN INTO
				AS MANY 5-CHARACTER LEFT-JUSTIFIED
				ASCII STRINGS AS NECESSARY.  ANY
				NUMBER OF SUCH PARAMETERS MAY BE
				PROVIDED.   ALL BUT THE LAST MUST
				BE PRECISELY 5 CHARACTERS; THE
				LAST MUST BE LESS THAN 5.
			FUCNTION: TYPES OUT THE MESSAGE ON THE TTY
			USES: TTYPUTS
		)%
READ,		%(#27
		)%
RENAME,		%(#41 	PARAMETERS: 1) A CHANNEL NUMBER
				    2) A NEW FILE NAME, OR 0 TO
					RETAIN OLD ONE
				     3) A NEW EXTENSION NAME, OR 0 TO
					RETAIN OLD ONE
				     4) A NEW PROTECTION KEY OR
					0 TO RETAIN OLD ONE
			FUNCTION: RENAMES OR DELETES THE FILE JUST
				CLOSED ON THE CHANNEL SPECIFIED
			USES: RENAME UUO, UNPACK, PAC, IOERR
			IOERRS: 26: UNDEFINED IOERR
				34: NO UFD
				35: WRITE PROTECTED
				36: ACTIVE FILE
				37: ALREADY EXISTING FILE
				38: NO FILE SELECTED
				39: NO DEVICE
			VALUES: 0 => RENAME FAILURE
				1 => RENAME SUCCESS
		)%
RESET,		%(# 3	FUNCTION: RESETS I/O CHANNELS AND SETS
				UP DEFAULTS FOR CHANNEL ASSIGNEMNTS.
			USES: CALLI (MONITOR UUO), RETABLE
		)%
RETABLE,	%( 35	PARAMETERS: NONE
			FUNCTION: COMPLETELY CLEARS CHNLTAB AND
				THEN SETS DEFAULT VALUES
			EXTERNALS: CHNLTAB
			USES: DEFAULTS
		)%
SET35,		%(#33	PARAMETERS: A CHANNEL NUMBER
			FUNCTION: MARKS THE STATUS WORD SO THAT
				THE WORD CONTAINING THE NEXT
				CHARACTER TO BE PLACED BY A WRITE
				WILL GET BIT 35 SET TO 1.  NOTE
				THAT THIS BIT IS RESET WHEN BIT 35
				IS SET.
			USES: CHNLTAB

		)%
SETCHN,		%(#10
		)%
SIXBIT,		%(# 7	RETURNS SIXBIT VALUE OF ITS ARGUEMENT
		)%
TTYPUTS,	%( 20
		)%
WRITE,		%(#21
		%
XCT,		%(#24	PARAMETERS: AN OP, A REGISTER, AND THE REST OF A 23-BIT ADDRESS
			FUNCTION: CONSTRUCTS AN  INSTRUCTION FROM
				THE GIVEN DATA AND DOES AN
				XCT AGAINST IT.
			VALUE: 0
		%
XCTSKIP,	%(#13	PARAMETERS: AN OP, A REGISTER, AND THE REST OF A 23-BIT ADDRESS
			FUNCTION: CONSTRUCTS AND INSTRUCTION FROM
				THE GIVEN DATA AND DOES AN XCT 
				AGAINST IT.
			VALUES: 1 -> SKIPPED; 0 -> DID NOT
		%
XINPUT,		%( 14	PARAMETERS: A CHANNEL NUMBER
			FUNCTION: EXECUTES IN "INPUT" INSTRUCTION
			USES: XCTSKIP
			VALUES:  0-> ENDFILE; 1-> SUCCESS; 2-> IOERR
		)%
XOUTPUT;	%( 15	PARAMETERS: A CHANNEL NUMBER
			FUNCTION: EXECUTES AND "OUTPUT" INSTRUCTION
			USES: XCTSKIP
			VALUES: 0 -. ENDFILE; 1 -> SUCCESS; 2-> IOERR
		)%
GLOBAL ROUTINE CRLF(CHNL)=
%%
%
       THIS ROUTINE OUTPUTS A CARRIAGE RETURN/LINE FEED PAIR
       ON THE GIVEN CHANNEL.  IT IS CHEAPER TO USE A ROUTINE
       TO  DO THIS AND CALL IT (USES 3 INSTRUCTIONS) THAN TO
       USE A MACRO IN LINE (USES 8 INSTRUCTIONS).
%
%%
	(WRITE(.CHNL,#015); WRITE(.CHNL,#012));
GLOBAL ROUTINE RESET=
%%
%
       THIS  ROUTINE RESETS ALL MONITOR I/O CHANNELS AND ALL
       SORTS   OF   WONDERFUL   THINGS   WITH    ONLY    ONE
       INSTRUCTION!!! HOW ABOUT THAT!!! FURTHERMORE IT CALLS
       RETABLE TO CLEAR THE CHANNEL TABLE  TO  ZEROES.  NOTE
       THAT  THIS  ASSUMES ALL I/O ACTIVITY HAS BEEN CLEARED
       UP. IF IT WASN'T, THE CALLI MADE SURE.
%
%%
	BEGIN
		MACHOP CALLI=#047;
		CALLI (0,0,0,0);
	RETABLE()
	END;

GLOBAL ROUTINE INVALID(CHNL,ERR)=
%%
%
       THIS  ROUTINE  CHECKS  TO  SEE  IF THE CHANNEL NUMBER
       GIVEN IS VALID. A VALID CHANNEL NUMBER IS EITHER ZERO
       (TTY) OR IN THE RANGE 1 =< CHNL =< CHNLMAX.  IF IT IS
       OUTSIDE THIS RANGE THEN THE CHANNEL NUMBER IS PLUNKED
       INTO  IOZERROR AND THE ERROR HANDLER IS CALLED.  NOTE
       THAT IF CONTROL RETURNS FROM THE ERROR HANDLER "TRUE"
       IS PASSED TO THE CALLER OF INVALID.
%
%%
	(IF (.CHNL NEQ 0) AND (.CHNL LSS 0 OR .CHNL GTR .CHNLMAX) THEN
		(IOZERROR_.CHNL; IOERR(.ERR); 1) ELSE 0);
ROUTINE GETCHAR=
%%
%
       THIS ROUTINE IS CALLED IN THE CASE  OF  A  READ  FROM
       CHANNEL 0. NOTE THAT THE TTCALL IS "INCHWL", OR INPUT
       IN LINE MODE.  THUS  THIS  ROUTINE  WILL  NOT  RETURN
       CONTROL  UNTIL A CARRIAGE RETURN, FORM FEED, ALTMODE,
       OR VERTICAL TAB HAS BEEN TYPED. SUCCESSIVE CALLS WILL
       RETURN  SUCESSIVE CHARACTERS UNTIL THE LINE BUFFER IS
       EMPTY, AFTER WHICH THE NEXT CALL WILL WAIT  UNTIL  IT
       IS FILLED AGAIN.
%
%%
	BEGIN
		MACHOP TTCALL=#051;
		TTCALL(4,VREG,0,0);
		.VREG
	END;
GLOBAL ROUTINE GETSTS(CHNL)=
    BEGIN
	MACRO GETSTS=#062$;
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	LOCAL T;
	IF INVALID(.CHNL,18) THEN 18^18 ELSE 
	    IF NOT .FSTATUS<FDEVAS> THEN  0 ELSE
		(XCT(GETSTS,@CHNL-1,T);
	.T)
    END;
GLOBAL ROUTINE SIXBIT(CHAR)=
	(((IF .CHAR GEQ "\" THEN .CHAR AND #137 ELSE IF .CHAR LSS " " THEN #40 ELSE .CHAR)
		+#40) AND #77);
ROUTINE ISREADOK(CHNL)=
%%
%
THIS ROUTINE RETURNS TRUE IF READING IS ALLOWED ON THE GIVEN
       CHANNEL, OTHERWISE IT CALLES THE  I/O  ERROR  ROUTINE
       AND  RETURNS  WHATEVER  VALUE IT RETURNS (USUALLY THE
       ERROR CODE IN THE LEFT HALFWORD)
%
%%
    BEGIN
	REGISTER T;
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	T_.FSTATUS;
		IF (.T<FUSER> AND (XFYREAD+XFYUPDAT+XFYSIMUL)) EQL 0 THEN 
		    BEGIN
			IOZERROR_.CHNL;
			IOERR(2)
		    END
%(
	E R R O R   2 :   ATTEMPT TO READ FROM NOREADABLE 
		DEVICE.
)%
		ELSE
		IF .T<FWOPEN> AND NOT .T<FYSIMUL>  THEN
		    BEGIN
			IOZERROR_.CHNL;
			IOERR(3)
		    END
%(
	E R R O R   3:  ATTEMPT TO READ FROM DEVICE BEING WRITTEN ON
)%
		ELSE
    1
    END;
GLOBAL ROUTINE SETCHN (CHNL,MODE,DEV,FILE,EXT,PRJ,PRG,STATUS,SW,PROT)=
	BEGIN
%(
 		THE FUNCTION OF THIS ROUTINE IS TO 
 		INITIALIZE THE CHANNEL TABLE VALUES
 		GIVEN ASCII STRINGS FOR NAMES.
 
 	THE STRUCTURE OF THE CHANNEL TABLE IS:
 
 	0	MODE (ASCII, USUALLY)
 	1	DEVICE IN SIXBIT FO$MAT
 	2	BUFFER WORD (OUT,,IN)
 	3-5	OUTPUT BUFFER HEADER
 	6-8	INPUT BUFFER HEADER
 	9	FILENAME IN SIXBIT
 	10	EXTENSION IN SIXBIT
 	11	0 (SET LATER BY MONITOR)
 	12	PPN
 	13	STATUS
 	14	SWITCHES
	15	RIGHTMOST 10 BITS: PROTECTION WORD
 
 
 	THE SWITCH WORD CONTAINS BITS FOR EACH OF THE SWITCHES
 	SET EITHER BY DEFAULT OR BY /N NOTATION.  THE ASSIGNMENTS ARE:
 
 	P/S	BIT	SWITCH
 	<0,1>	35	/A
 	<1,1>	34	/B
 	<2,1>	33	/C
 	<3,1>	32	/D
 	<4,1>	31	/E
 	<5,1>	30	/F
 	<6,1>	29	/G
 	<7,1>	28	/H
 	<8,1>	27	/I
 	<9,1>	26	/J
 	<10,1>	25	/K
 	<11,1>	24	/L
 	<12,1>	23	/M
 	<13,1>	22	/N
 	<14,1>	21	/O
 	<15,1>	20	/P
 	<16,1>	19	/Q
 	<17,1>	18	/R
 	<18,1>	17	/S
 	<19,1>	16	/T
 	<20,1>	15	/U
 	<21,1>	14	/V
 	<22,1>	13	/W
 	<23,1>	12	/X
 	<24,1>	11	/Y
 	<25,1>	10	/Z
 	<26,1>	 9	/0
 	<27,1>	 8	/1
 	<28,1>	 7	/2
 	<29,1>	 6	/3
 	<30,1>	 5	/4
 	<31,1>	 4	/5
 	<32,1>	 3	/6
 	<33,1>	 2	/7
 	<34,1>	 1	/8
 	<35,1>	 0	/9
 
 	THE PARAMETERS PASSED ARE:
 	CHNL	A CHANNEL NUMBER 1=< N =< 16
 	MODE	A DATA MODE (E.G. 1=ASCII)
 	DEV	A POINTER TO TWO WORDS CONTAINING A DEVICE NAME
 	FILE	"    "     "  "    "         "    A FILE NAME
 	EXT	"    "     " A WORD CONTAINING AN EXTENSION NAME
 	PRJ	A PROJECT N(MBER
 	PRG	A PROGRAMMER NUMBER
 	STATUS	BITS 32-35 OF THE STATUS WORD
 	SW	A 36-BIT SWITCH MASK
 
 	NOTE THE FOLLOWING ACTIONS ARE TAKEN ON ZERO VALUES:
 	CHNL- TTY CHANNEL (NO ACTION)
 	MODE- THE DEFAULT MODE IS USED
 	DEV-  THE DEFAULT DEVICE IS USED.  THIS IS TRUE IF
 		.DEV=0 OR ..DEV=0
 	FILE- THE DEFAULT FILES IS USED. THIS IS TRUE IF
 		.FILE=0 OR ..FILE=0
 	EXT - THE DEFAULT EXTENSION IS USED. AS IN FILE AND DEV.
 	PRJ )
 	PRG ) NO SPECIAL ACTION, BUT EITHER BOTH MUST BE ZERO OR
 		BOTH NONZERO.  IF ZERO THE PPN WILL BE SET TO 0.
 	STATUS - USE DEFAULT STATUS
 	SW - NO SPECIAL ACTION.  SINCE SW BITS ARE OR'ED IN, A
 		ZERO VALUE PRODUCES NO CHANGE
 
)%
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	MACRO F1ST=29,7$;
	IF .CHNL EQL 0 % TTY % THEN 1 ELSE 
	    IF .CHNL LSS 0 OR .CHNL GTR TABMAX THEN IOERR(4) ELSE 
		IF (.FSTATUS AND (XFUOPEN+XFROPEN+XFWOPEN)) NEQ 0   THEN IOERR(17) ELSE 
! SET UP THE PPN FIELDS
		IF (.PRJ EQL 0) XOR (.PRG EQL 0) THEN
				IOERR(5) ELSE 
%(
		E R R O R   5:  PROJ OR PROG SPECIFIED BUT NOT BOTH
)%
	    BEGIN
		FPRJ_.PRJ;
		FPRG_.PRG;
%(
	E R R O R   4 :   ATTEMPT TO USE CHANNEL > 16, OR < 1
)%
%(
	SET MAXCHN TO HIGHEST CHANNEL NUMBER GIVEN SO FAR
)%
		IF .CHNL GTR .CHNLMAX THEN CHNLMAX_.CHNL;
%(
		E R R O R   1 7 : ATTEMPT TO SETCHN ON AN OPEN CHANNEL
)%

! SET STATUS BITS
    IF .STATUS NEQ 0 THEN
		FSTATUS_.STATUS;
		FSTATUS<FNSET>_0;		% TURN OFF INVALID BIT %

! SET MODE:
    IF .MODE NEQ 0 THEN
		FMODE_.MODE;

! SET DEVICE
IF .DEV NEQ 0 THEN
    IF .@DEV NEQ 0 THEN  FDEV_IOPACK((@DEV)<0,0>,6);

! SET OBUF POINTER
		IF .STATUS<FYWRITE> OR .STATUS<FYUPDAT> THEN
				FBUFO_FOBUFH;

! SET IBUF POINTER
		IF .STATUS<FYREAD> OR .STATUS<FYUPDAT>  THEN
				FBUFI_FIBUFH;

! SET UP THE FILE NAME
IF .FILE NEQ 0 THEN
    IF ..FILE NEQ 0 THEN 
		BEGIN
		FFILE_IOPACK((@FILE)<0,0>,6);
		IF ..FILE<F1ST> EQL "*" THEN FSTATUS<FFISTAR>_1;
		END;

! SET UP THE EXTENSION
IF .EXT NEQ 0 THEN
    IF ..EXT NEQ 0 THEN 
		BEGIN
		FEXT_IOPACK((@EXT)<0,0>,3);
		IF ..EXT<F1ST> EQL "*" THEN FSTATUS<FXSTAR>_1;
		END;
! SET THE SWITCH WORD
		FSWITCH_.FSWITCH OR .SW;

! SET THE PROTECTION WORD
		IF .PROT NEQ 0 THEN FNEWPR_.PROT;

		1
	    END
    END;
GLOBAL ROUTINE XCTSKIP(OP,REG,ETC)=
	BEGIN
%%
%
       THE FUNCTION OF THIS ROUTINE IS TO EXECUTE A  MONITOR
       UUO  WHICH  DOES  A  SKIP-RETURN.   THE  VALUE OF THE
       ROUTINE IS TRUE IF  THE  SKIP-RETURN  WAS  TAKEN  AND
       FALSE IF NOT TAKEN.
%
%%
	MACHOP XCT=#256, MOVEI=#201;
		MACRO OPCOD=27,9$, REGFLD=23,4$;
	REGISTER T;
		T_.ETC;
		T<OPCOD>_.OP;
		T<REGFLD>_.REG;
	
! WE NOW HAVE AN INSTRUCTION.  SET R TRUE ASSUMING SKIP RETURN
		MOVEI (VREG,1);
		XCT (0,T);
		MOVEI (VREG,0);
! IF NO SKIP OCCURED, R IS NOW FALSE;
		.VREG
		END;
ROUTINE XINPUT(CHNL)=
	BEGIN
		MACRO IN=#056$, STATZ=#063$;
%%
%
       THIS ROUTINE  EXECUTES  AN  "INPUT"  INSTRUCTION  AND
       RETURNS ONE OF THREE VALUES:
	0 = ENDFILE OCCURED
	1 = SUCCESSFUL EXECUTION
	2 = FAILURE FOR I/O ERROR OF SOME KIND

       NOTE HOW SNEAKY WE ARE: BOTH 0 AND 2 ARE  INTERPRETED
       AS  "FALSE" BY BLISS!!! SO WE CAN (AND DO) USE XINPUT
       IN IF-EXPRESSIONS.
%
%%
	IF XCTSKIP(IN,@CHNL-1,0) THEN 
		BEGIN

! IF "IN" SKIPS THEN WE HAVE AN ERROR
		 IF XCTSKIP(STATZ,@CHNL-1,#740000) THEN
			 0 ELSE  2
! IF "STATZ" SKIPS THEN WE HAVE ENDFILE, ELSE ERROR
		END 
		ELSE
! "IN" DID NOT SKIP SO WE HAVE A NEW BLOCK
		 1
	END;
ROUTINE XOUTPUT(CHNL)=
	BEGIN
%%
%
       THIS  ROUTINE MISBEHAVES THE SAME AS XINPUT.  GO BACK
       AND READ IT THERE, I'M TIRED OF TYPING.
%
%%
	MACRO OUT=#057$, STATZ=#063$;
	IF XCTSKIP(OUT,@CHNL-1,0) THEN
		BEGIN
! IF "OUT" SKIPS THEN WE HAVE AN ERROR
		    IF XCTSKIP(STATZ,@CHNL-1,#740000) THEN
			 0 ELSE  2
! IF "STATZ" SKIPS THEN WE HAVE PHYSICAL END OF DEVICE ELSE OTHER SCREWUPS
		END
		ELSE
! "OUT" DID NOT SKIP, SO WE GOT RID OF THAT BLOCK OK
		1
	END;
ROUTINE OPENIN(CHNL)=
	BEGIN
%%
%
       THIS ROUTINE OPENS A CHANNEL (VIA ROUTINE "OPEN") AND
       THEN PERFORMS THE NECESSARY LOOKUP AND INBUF TO ALLOW
       READ OPERATIONS.
%
%%
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	MACRO  INBUF=#064$;
	LOCAL T;
	IF NOT (T_ISREADOK(.CHNL)) THEN RETURN .T;
	IF OPEN(@CHNL) THEN
		BEGIN
		FSTATUS<FDEVAS>_1;
			IF LOOKUP(.CHNL) THEN
			    BEGIN
					SELECT #0, #1, #10, #13, #14 OF
				    NSET
				.FMODE: XCT(INBUF,@CHNL-1,2);
				    TESN;
				 1
			    END
			    ELSE
			%LOOKUP FAILED %
			( IOZERROR_.CHNL; IOERR( SELECT .FERR OF
				NSET
				0:  7;
				1:  27;
				2:  28;
				7:  29;
			OTHERWISE:	    30;
				TESN))
%%
%
	E R R O R   7 :   LOOKUP FAILED
%
%%
		END
		ELSE
		%OPEN FAILED %
				(IOZERROR_.CHNL;IOERR(8))
%%
%
	E R R O R   8 :  OPEN FAILED
%
%%
	END;
ROUTINE OPEN(CHNL)=
	BEGIN
%%
%
       THIS ROUTINE OPENS A CHANNEL AND RETURNS TRUE IF  THE
       CHANNEL OPENED OR FAILS IF IT DIDN'T
%
%%
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	MACRO OPEN=#050$;
	IF .FSTATUS<FDEVAS> THEN 1 ELSE 
		XCTSKIP(OPEN,@CHNL-1,FMODE) 
	END;
ROUTINE ISWRITEOK(CHNL)=
	BEGIN
%%
%
       THIS ROUTINE  EITHER  RETURNS  TRUE  (IN  WHICH  CASE
       WRITING  IS  PERMISSIBLE) OR CALLS THE IOERR HANDLER,
       AND RETURNS ITS VALUE.
%
%%
	REGISTER T;
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	
	IOZERROR_.CHNL;
	T_.FSTATUS;
	IF (.T<FUSER> AND (XFYWRITE+XFYUPDAT+XFYSIMUL)) EQL 0 THEN IOERR(9) ELSE

	    IF .T<FROPEN> THEN (IF NOT (.T<FYUPDAT> OR .T<FYSIMUL>) THEN IOERR(10) ELSE 1) ELSE 

		    1
%%
%
	E R R O R   9 :  ATTEMPT TO WRITE ON NONWRITEABLE DEVICE
	E R R O R   10 : ATTEMPT TO WRITE ON INPUT DEVICE
%
%%
	END;
ROUTINE OPENOUT(CHNL)=
	BEGIN
%%
%
       THIS  ROUTINE  OPENS  A CHANNEL FOR OUPUT BY DOING AN
       OPEN UUO TO OBTAIN A DEVICE, AN ENTER TO  CREATE  THE
       FILE, AND AN OUTBUF IF NECESSARY TO CREATE THE BUFFER
       CHAIN (AND A  DUMMY  OUTPUT  UUO  TO  INITIALIZE  THE
       BUFFERS).
%
%%
	MACRO  OUTBUF=#065$, OUTPUT=#067$;
	LOCAL T;
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	IF NOT (T_ISWRITEOK(.CHNL)) THEN  .T ELSE 
      BEGIN
	IF OPEN(@CHNL) THEN
	    BEGIN
		FSTATUS<FDEVAS>_1;
		IF ENTER(.CHNL) THEN
		    BEGIN
			SELECT #0, #1, #10, #13, #14 OF
			    NSET
			.FMODE: (XCT (OUTBUF,@CHNL-1,3);
				XCT (OUTPUT,@CHNL-1,0));
			    TESN;
			 1
		    END
		    ELSE
		    %ENTER FAILED%
		 	(IOZERROR_.CHNL; IOERR(SELECT .FERR OF
				NSET
				1:  31;
				2:  32;
				3:  33;
				7:  6;
			OTHERWISE: 11;
				TESN))
%%
%
	E R R O R   11 :  ENTER FAILED
%
%%
	    END
	    ELSE
	%OPEN FAILED%
		(IOZERROR_.CHNL;IOERR(12))
%%
%
	E R R O R   12 : OPEN FAILED
%
%%
      END
	END;
GLOBAL ROUTINE TTYPUTS(STR)=
%%
%
       THIS ROUTINE OUTPUTS A STRING TO THE TTY.  THE  VALUE
       PASSED IS A POINTER TO THE STRING.
%
%%
	BEGIN
	  MACHOP TTCALL=#051;
	    TTCALL (3,STR,0,1);
	END;
GLOBAL ROUTINE WRITE (CHNL,CHAR)=
%%
%
       THIS ROUTINE TAKES THE CHARACTER PASSED AND WRITES IT
       KN  THE SPECIFIED CHANNEL.  IF THE CHANNEL IS A DUMMY
       CHANNEL  NO  OPERATION  TAKES  PLACE.   BUFFERS   ARE
       AUTOMATICALLY  WRITTEN  OUT  AS THEY ARE FILLED.  THE
       CHANNEL AND FILE ARE OPENED IF NECESSARY.  FOR  ASCII
       MODE  FILES, BIT 35 OF THE WORD WHICH WILL ACCEPT THE
       GIVEN CHARACTER MAY BE SET TO 1 IF THE  <FSET35>  BIT
       OF  THE STATUS WORD IS 1.  THIS (THE <FSET35> BIT) IS
       THEN CLEARED. RETURNS TRUE IF SUCCESSFUL AND FALSE IF
       NOT.   THE  FIOERR  BIT IS SET FOR FAILURES INVOLVING
       VALID CHANNELS.
%
%%
    BEGIN
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	LOCAL T;
	
	IF INVALID(.CHNL,23) THEN 23^18 ELSE 

	IF .CHNL EQL 0 THEN (PUTCHAR(.CHAR);1) ELSE

      BEGIN
	FSTATUS<FIOERR>_1;  % ASSUME WRONG UNTIL PROVEN OTHERWISE %
%%
%
	IF WE HAVE A DUMMY CHANNEL, GO BACK WITHOUT DOING ANYTHING
%
%%
	IF .FSTATUS<FYDUMMY> THEN (FSTATUS_ .FSTATUS AND NOT(XFSET35+XFIOERR);
					  RETURN 1);
	IF NOT .FSTATUS<FWOPEN> THEN
	    BEGIN
		IF NOT (T_OPENOUT(.CHNL))  THEN RETURN .T; % IF IT WASNT OPEN, THEN OPEN IT %
		FSTATUS<FWOPEN>_1;
	    END;

	IF .FOCNT EQL 0 THEN
	    % BUFFER IS FULL %
	    BEGIN
		IF NOT XOUTPUT(.CHNL) THEN (IOZERROR_.CHNL;RETURN IOERR(23));
	    END;

	FOCNT_.FOCNT-1;
%%
%
       WE  HAVE  JUST  DECREASED THE BUFFER COUNT. NOW PUT A
       CHARACTER IN
%
%%
	 REPLACEI (FOPTR,.CHAR); 

%%
%
       IF USER SETS BIT <FSET35> THEN HE WANTS BIT 35 OF THE
       CURRENT WORD SET TO A 1 FOR SEQUENCE NUMBERS.
%
%%
	IF .FSTATUS<FSET35>THEN
	    BEGIN
		(@FOPTR)<0,36>_.((@FOPTR)<0,36>) OR 1;
		FSTATUS<FSET35>_0;
	    END;
	FSTATUS<FIOERR>_0;  % PROVEN OTHERWISE %
     1
      END
    END;
GLOBAL ROUTINE GETPPN=
%%
%
       THIS  ROUTINE  RETURNS  THE PROJECT PROGRAMMER NUMBER
       PAIR AS DETERMINED BY THE JOB LOGGED ON.  IT USES THE
       CALLI UUO.
%
%%
    BEGIN
%[1077]% 	MACHOP CALLI=#047,JFCL=#255;
	CALLI (VREG,#24) ;  % CALL [SIXBIT /GETPPN/]%
%[1077]%	JFCL (0,0);  % NOOP FOR REMOTE POSSIBILITY OF GETPPN SKIPPING %
	 .VREG
    END;
GLOBAL ROUTINE XCT(OP,REG,ETC)=
	BEGIN
	MACHOP XCT=#256;
	REGISTER T;
	MACRO OPCOD=27,9$, REGFLD=23,4$;
		T_.ETC;
	    T<OPCOD>_.OP;
	    T<REGFLD>_.REG;
	    XCT(0,T);
	END;
GLOBAL ROUTINE PADNULL(CHNL)=
    BEGIN
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	MACRO POS=30,6$;
	MACRO SIZE=24,6$;
	LOCAL T;
%(
 THE FUNCTION OF THIS ROUTINE IS TO PADD THE CURRENT WORD
  BEING FILLED TO NULLS, ALLOWING INSERTION OF SEQUENCE
  NUMBERS IN THE NEXT WORD.

  WE ACCOMPLISH THIS BY WRITING CHARS UNTIL THE BYTE POINTER
  POSITION FIELD BECOMES LESS THAN THE SIZE FIELD, INDICATING THE NEXT REPLACEI WILL
  WRITE INTO THE FIRST CHARACTER OF THE ENXT WORD.
)%
	IF .FSTATUS<FWOPEN> THEN 
	WHILE .FOPTR<POS> GEQ .FOPTR<SIZE> DO
	IF NOT (T_WRITE(.CHNL,0)) THEN RETURN .T;
	1
    END;
ROUTINE FILLIN(CHNL)=
	BEGIN
	LOCAL T;
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	IF NOT (T_XINPUT(.CHNL)) THEN
	% WE HAVE EITHER AN ERROR OR AN ENDFILE %
	    BEGIN
		IF .T EQL 0 THEN
		    BEGIN
			% WE HAVE AN ENDFILE %
			FSTATUS<FEOF>_1;
			 0
		    END
		    ELSE
		    BEGIN
			% WE HAVE OTHER PROBLEMS %
			(IOZERROR_.CHNL;IOERR(13))
!
!	E R R O R   1 3 : READ ERROR
!
		    END
	    END
	    ELSE
	% WE HAVE FILLED A BUFFER %
		 1
	END;
GLOBAL ROUTINE READ(CHNL)=
    BEGIN
	LOCAL T;
	REGISTER TEMP;
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	IF INVALID(.CHNL,22) THEN (FSTATUS<FIOERR>_1; 22^18) ELSE
	IF .CHNL EQL 0 THEN  GETCHAR() ELSE 
%(
	IF DUMMY CHANNEL OR EOF BIT ON THEN GIVE ENFILE
)%
      BEGIN
	IF (.FSTATUS AND (XFYDUMMY+XFEOF)) NEQ 0  THEN (FSTATUS<FEOF>_1; RETURN -1);

	FSTATUS<FIOERR>_0; % ASSUME OK %
	IF NOT .FSTATUS<FROPEN> THEN
	    BEGIN
		IF NOT (T_OPENIN(.CHNL)) THEN RETURN .T;
		FSTATUS<FROPEN>_1;
		IF ((T_ FILLIN(.CHNL)) EQL 0 ) THEN RETURN -1 ELSE IF NOT .T THEN (FSTATUS<FIOERR>_1; RETURN .T);
	    END;

% AT THIS POINT WE PRESUMABLY HAVE SOMETHING IN THE BUFFER %

	WHILE .FICNT EQL 0 DO
	    BEGIN
		% BUFFER WAS EMPTY %
		IF ((T_ FILLIN(.CHNL)) EQL 0 ) THEN RETURN -1 ELSE IF NOT .T THEN (FSTATUS<FIOERR>_1; RETURN .T);
	    END;
% DECREASE CHAR COUNT BY 1 %
	FICNT_.FICNT-1;
	T_ SCANI(FIPTR);
% SEE IF BIT 35 OF WORD WE JUST GOT CHAR FROM IS SET %
	TEMP_.(@FIPTR)<0,36>;
	FSTATUS<FSEQ>_ IF .TEMP THEN 1 ELSE .FSTATUS<FIS35>;
	FSTATUS<FPGMK>_(.TEMP EQL #064321400001);
	FSTATUS<FIS35>_.TEMP;
	.T
      END
    END;
ROUTINE PUTCHAR(CHAR)=
	BEGIN
	MACHOP TTCALL=#051;
	TTCALL(1,CHAR);
	END;
GLOBAL ROUTINE CLOSE(CHNL)=
    BEGIN
%(
	THE FUNCTION HERE IS TO CLOSE THE SPECIFIED CHANNEL AND
	RELESASE THE DEVICE.  ALL RELEVANT STATUS BITS OF THE
	CHANNEL TABLE ENTRY ARE CLEARED
)%
	MACRO CLOS=#070$, RELEAS=#071$;
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	LOCAL T;
	T_1;
    IF INVALID(.CHNL,21) THEN 21^18 ELSE 
      IF .CHNL EQL 0 THEN  1 ELSE 
	(REGISTER F;
	 F_.FSTATUS;
	IF (.F AND (XFUOPEN+XFROPEN+XFWOPEN)) NEQ 0  THEN
	    BEGIN
		XCT(CLOS,.CHNL-1,0);
		F_.F AND NOT (XFUOPEN+XFROPEN+XFWOPEN);
		IF (T_.FNEWPR) NEQ 0 THEN 
			(IF .FPROT NEQ .T<0,9> THEN T_RENAME(.CHNL,0,0,.T<0,9>));
		XCT(RELEAS,.CHNL-1,0);
	F<FDEVAS>_0;
%(
	IF REWIND ALLOWED, WE TURN OFF ENDFILE BITS OF INPUT
	FILES.  IF REWIND NOT ALLOWED, WE MARK  CHANNEL
	AS UNREADABLE AND UNWRITEABLE.
)%
	F_.F AND NOT (XFIOERR+XFIS35+XFSET35+XFSEQ+XFPGMK);
	IF .F<FYREW> THEN
%(
	REWIND IS ALLOWED
)%
	    BEGIN
		F<FEOF>_0; %TURN OFF ENDFILE BIT%

	% IF OUTPUT CHANNEL WE DO NOT WANT TO RESET DUMMY BIT %
	    END
		ELSE
	    BEGIN
%(
	REWIND NOT ALLOWED
)%
	F_.F AND NOT (XFYUPDAT+XFYREAD+XFYWRITE);
	    END;
	    END;
	FSTATUS_.F;
	.T)
    END;
GLOBAL ROUTINE ENDALL=
	BEGIN
	INCR I FROM 1 TO .CHNLMAX DO CLOSE(.I);
	1
	END;
GLOBAL ROUTINE GETSTAT(CHNL)=
    BEGIN
	IF .CHNL LSS 0 OR .CHNL GTR .CHNLMAX THEN  (1^35) ELSE
	    IF .CHNL EQL 0 THEN  0 ELSE
		.CHNLTAB[.CHNL,13]
    END;
GLOBAL ROUTINE SET35(CHNL)=
    BEGIN
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	IF INVALID(.CHNL,19) THEN 19^18 ELSE 
	    IF .FMODE GTR 1 THEN IOERR(20) ELSE 
		IF .CHNL EQL 0 THEN  1 ELSE   (FSTATUS<FSET35>_1)
    END;
GLOBAL ROUTINE PUTMSG(MSG)=
%(
	THIS IS A SNEAKY ROUTINE.  WHAT IT DOES IS DETERMINE THE
	NUMBER OF PARAMETERS IT HAS BEEN GIVEN BY EXAMINING
	THE "SUB" INSTRUCTION WHICH IS POINTED TO BY THE RETURN
	ADDRESS IN THE STACK.  IT THEN GOES BACK THIS MANY 
	POSITIONS AND DOES A TTYPUTS OF THE STRING STACKED
	THERE.  THE SNEAKY WAY IT DOES THIS IS ATTRIBUTED TO
	BILL WULF.  IF IT DOESN'T WORK YOU CAN BLAME HIM.  IF
	IT DOES, YOU MAY APPLAUD.


)%
    BEGIN
	LOCAL N,SSAV;
	
	N_ IF .(@(MSG+1 %THE RETURN ADDRESS%))<27,9> %THE OPCODE%
		NEQ #274 %A SUBTRACT INSTR% THEN 0 ELSE
			.(@@(MSG+1))<0,18> %THE WORD POINTED TO
				BY THE ADDR OF THE SUBTRACT%;
	SSAV_.(MSG+1)<29,7>;	% SAVE STATE BITS %
	IF .N GTR 0 THEN  (IF .MSG<1,7> NEQ 0 THEN (MSG+1)<29,7>_0;TTYPUTS(MSG-(.N-1)));
	(MSG+1)<29,7>_.SSAV;		% RESTORE STATE BITS %
    END;
GLOBAL ROUTINE RETABLE=
    BEGIN
	CHNLMAX_TABMAX;       % NUMBER OF CHANNELS %
	CHNLTAB_TABSIZ;  % SIZE OF ENTRY %
	INCR J FROM 1 TO TABMAX DO   % STEPS THRU CHNLS %
		( BIND VECTOR CHAN=CHNLTAB[.J,0]<0,36>;
		INCR I TO TABSIZ DO   % STEPS THRU ENTRY %
			CHAN[.I]_0);
	INCR J FROM 1 TO TABMAX DO CHNLTAB[.J,13]<FNSET>_1;
	DEFAULTS();
    END;
GLOBAL ROUTINE GETSW(CHNL)=
	BEGIN
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	IF INVALID(.CHNL,16) THEN  0 ELSE 
	    IF .CHNL EQL 0 THEN  0 ELSE
		.FSWITCH
    END;
GLOBAL ROUTINE DUMCHN(CHNL,TYPE)=
	BEGIN
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	IF INVALID(.CHNL,15) THEN 15^18 ELSE 
	    IF .CHNL EQL 0 THEN  1 ELSE 
		(FSTATUS<FYDUMMY>_.TYPE; 1)
	END;
GLOBAL ROUTINE OUTMSG(MSG)=
    BEGIN
%(
	THIS ROUTINE IS CALLED BY SPECIFYING A CHANNEL NUMBER
	AND A SERIES OF STRINGS ENCLOSED IN QUOTES.  THE ROUTINE
	DETERMINES THE NUMBER OF SUCH STRINGS AND WRITES THE
	ENTIRE SET TO THE SPECIFIED CHANNEL.
)%
	LOCAL T,N,P,CHNL,ERR;
	N_ IF .(@(MSG+1))<27,9> NEQ #274 THEN 0 ELSE
		(.(@@(MSG+1))<0,18>)-1;
	CHNL_.(MSG-.N)<0,36>;
	P_(MSG-.N)<0,7>;
	INCR I FROM 1  TO .N*5 DO
		IF (T_SCANI(P)) EQL 0 THEN EXITLOOP ELSE IF NOT (ERR_WRITE(.CHNL,.T)) THEN RETURN .ERR;
	1
    END;
GLOBAL ROUTINE IOPACK(FROMLOC,CNT)=
    BEGIN
	LOCAL PTR,ACC;
	PTR_(.FROMLOC)<36,7>;
	FROMLOC_ACC<36,6>;
	ACC_0; % CLEAR ACC %
	DECR I FROM .CNT-1 TO 0 DO REPLACEI(FROMLOC, SIXBIT(SCANI(PTR)));
	.ACC
    END;
GLOBAL ROUTINE CMUDEC(PROJ,PROG)=
    BEGIN
	LOCAL T,P1,P2,PTR;

	P1_P2_0;
	IF .PROJ NEQ 0 THEN
	    BEGIN
		PTR_PROJ<36,7>;
		P1_((SCANI(PTR)-"A")*1000)
			+((SCANI(PTR)-"0")*100)
			+((SCANI(PTR)-"0")*10)
			+((SCANI(PTR)-"0"))
			+9;
	    END;
	IF .PROG NEQ 0 THEN
	    BEGIN
		PTR_PROG<36,7>;
		P2_((SCANI(PTR)-"A")*9360)  % *36*26*10 %
			+((SCANI(PTR)-"A")*360)  % *36*10 % 
			+((SCANI(PTR)-"0")*36)
			+((IF (T_SCANI(PTR)) LSS "A" THEN 
				(.T-"0") ELSE (.T-"A"+10)));
	    END;
	T<18,18>_.P1<0,18>;
	T<0,18>_.P2<0,18>;
	.T
    END;
GLOBAL ROUTINE RENAME (CHNL,FILE, EXT, PROT)=
    BEGIN
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	LOCAL PTR1, PTR2, TEMP;
	MACRO RENAME=#055$,CLOS=#070$;
    IF .CHNL EQL 0 THEN 1 ELSE 
	IF INVALID(.CHNL,25) THEN 25^18 ELSE 
      BEGIN

	IF .FSTATUS<FUOPEN> OR .FSTATUS<FWOPEN> OR .FSTATUS<FROPEN> THEN
	    BEGIN
		XCT (CLOS,.CHNL-1,0);
		FSTATUS<FUOPEN>_FSTATUS<FWOPEN>_FSTATUS<FROPEN>_0;
	    END;
	IF .FILE GTR 0 THEN
		(IF ..FILE NEQ 0 THEN
			FFILE_IOPACK(@FILE,6);
		) ELSE IF .FILE LSS 0 THEN  FFILE_FEXT_0;
	IF .EXT NEQ 0 THEN
		IF ..EXT NEQ 0 THEN
			FEXT_IOPACK(@EXT,3);
	IF .PROT NEQ 0 THEN FPROT_.PROT;

	IF XCTSKIP(RENAME,@CHNL-1,FFILE) THEN  1 ELSE
		IOERR( SELECT .FERR OF
		NSET
		1:  34;
		2:  35;
		3:  36;
		4:  37;
		5:  38;
		7:  39;
	OTHERWISE:	    26;
		TESN)
      END
    END;
GLOBAL ROUTINE LOOKUP(CHNL)=
    BEGIN
	MACRO LOOKUP=#076$;
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	XCTSKIP(LOOKUP,@CHNL-1,FFILE)
    END;
GLOBAL ROUTINE ENTER(CHNL)=
    BEGIN
	MACRO ENTER=#077$;
	BIND VECTOR CHAN=CHNLTAB[.CHNL,0]<0,36>;
	XCTSKIP(ENTER,@CHNL-1,FFILE)
    END;
END ELUDOM