perm filename IOSER.TNX[10X,AIL]20 blob sn#257751 filedate 1977-01-14 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00114 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00010 00002	TENX<THE ENTIRE FILE IS FOR TENEX ONLY
C00013 00003	DSCR IOSTT(CDB) values.
C00016 00004
C00020 00005	COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,TENXFI,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
C00029 00006	DSCR  PROCEDURE LOOKUP(INTEGER CHNL STRING FILE REFERENCE INTEGER FLAG)
C00033 00007	HERE(ENTER)
C00036 00008	DSCR
C00039 00009	DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
C00041 00010	DSCR	PROCEDURE CLOSE(INTEGER CHANNEL,[CLOSE_INHIBIT_BITS])
C00042 00011	HERE(RELEASE)
C00043 00012	DSCR	
C00044 00013	DSCR	STRING PROCEDURE TENXFI(STRING DECFILE)
C00048 00014	DSCR
C00050 00015	COMPIL(JOBINF,<ODTIM,IDTIM,RUNTM,GTAD,GJINF>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
C00051 00016
C00052 00017	DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK REFERENCE INTEGER CONSOLE)
C00053 00018	DSCR INTEGER SIMPLE PROCEDURE GTAD
C00054 00019	DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO)
C00055 00020	ENDCOM(JOBINF)
C00056 00021	COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
C00058 00022	DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
C00060 00023	COMPIL(RUNPRG,<RUNPRG>,<X22,X33,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
C00065 00024	COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE,SETCHAN>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
C00074 00025	DSCR PROCEDURE SETINPUT(INTEGER CHAN REFERENCE INTEGER COUNT,BR,EOF)
C00075 00026	DSCR
C00077 00027	DSCR
C00079 00028	DSCR SETCHAN(JFN,GTFLAGS,OPFLAGS)
C00080 00029	COMPIL(GTJFN,<GTJFN,GTJFNL>,<.SKIP.,SETCHN,CATCHR,X11,X22,X44>,<GTJFN -- GET A JFN>)
C00082 00030	DSCR INTEGER PROCEDURE GTJFNL(STRING ORIG INTEGER FLAGS, XWDJFN!JFN
C00085 00031	COMPIL(FILINF,<GNJFN,DELF,UNDELETE,DELNF,SIZEF,JFNS,JFNSL,OPENF,CFILE,CLOSF,RLJFN,GTSTS,STSTS,RNAMF>
C00087 00032	DSCR	PROCEDURE DELF(INTEGER CHAN)
C00089 00033	DSCR	PROCEDURE UNDELETE(INTEGER CHAN)
C00090 00034	DSCR	INTEGER PROCEDURE SIZEF(INTEGER JFN)
C00091 00035
C00093 00036	DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
C00095 00037
C00098 00038	DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
C00100 00039	DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
C00101 00040	DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN)
C00102 00041	DSCR BOOLEAN SIMPLE PROCEDURE STSTS(INTEGER JFN,STATUS)
C00103 00042	DSCR BOOLEAN SIMPLE PROCEDURE RNAMF(INTEGER EXISTINGJFN,NEWJFN)
C00104 00043	COMPIL(DEVINF,<CNDIR,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST,GTFDB,CHFDB>
C00106 00044	DSCR BOOLEAN PROCEDURE ASND(INTEGER DEVICE)
C00107 00045	DSCR BOOLEAN PROCEDURE RELD(INTEGER DEVICE)
C00108 00046	DSCR INTEGER SIMPLE PROCEDURE GDSTS(INTEGER CHAN REFERENCE INTEGER WORDCNT)
C00109 00047	DSCR PROCEDURE SDSTS(INTEGER JFN,NEWSTATUS)
C00110 00048	DSCR INTEGER PROCEDURE STDEV(STRING S)
C00111 00049
C00112 00050	DSCR	SIMPLE PROCEDURE GTFDB(INTEGER JFN REFERENCE INTEGER ARRAY BUF)
C00113 00051
C00114 00052	DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN)
C00116 00053	HERE(ARRYIN)
C00120 00054	HERE(WORDOUT)
C00122 00055	HERE(ARRYOUT)
C00125 00056
C00127 00057	HERE(SWDPTR)
C00129 00058
C00136 00059	SETWPT:
C00140 00060	SETWIO:
C00141 00061	ADWI:	
C00143 00062	DSCR  CHAR←CHARIN(CHANNEL)
C00146 00063	DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR)
C00150 00064	Input 
C00158 00065	.DOINP:	PUSHJ	P,DOINP
C00159 00066
C00163 00067	Realin, Realscan 
C00165 00068	Intin, Intscan 
C00167 00069	DSCR NUMIN
C00170 00070	NUMIN -- CONTD.
C00174 00071	SCAN (CALLED BY NUMIN AND STRIN)
C00179 00072	   Character table for SCAN (Realscan,Intscan,Realin,Intin)
C00181 00073	DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
C00182 00074
C00184 00075
C00187 00076	DSCR	PROCEDURE LINOUT(INTEGER JFN,VALUE)
C00190 00077	HERE(RCHPTR)
C00191 00078	HERE(SCHPTR)
C00193 00079	DSCR	Auxiliary routines for character i/o.
C00199 00080	SETCPT:
C00202 00081	SETCIO:
C00203 00082	DSCR
C00216 00083	DSCR 	ADCO,ADCO1
C00220 00084	DSCR SETIO
C00227 00085	DSCR
C00230 00086	ENDCOM(IOROU)
C00231 00087	DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
C00232 00088	DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
C00233 00089	DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
C00234 00090	DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
C00235 00091	DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN)
C00236 00092	COMPIL(DSKOPS,<DSKIN,DSKOUT>
C00238 00093	DSCR SIMPLE PROCEDURE 
C00239 00094	COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR>
C00240 00095	DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN REFERENCE INTEGER AC1,AC3)
C00241 00096	DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
C00243 00097	COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET,RDSEG>
C00249 00098	DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
C00252 00099	DSCR
C00256 00100	COMPIL(TTM,<RFMOD,SFMOD,STPAR,STI,RFCOC,SFCOC,GTTYP,STTYP,SETEDIT>
C00262 00101	COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
C00263 00102	COMPIL(TT2,<PBTIN,INTTY>
C00264 00103	DSCR STRING SIMPLE PROCEDURE INTTY
C00266 00104	NOIMSSS<NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
C00270 00105	 TTY FUNCTIONS 
C00273 00106	HERE(PBIN)
C00283 00107	Filnam 
C00286 00108	Flscan 
C00288 00109	COMPIL(CAS,<CSERR,LPRYER>,<GOGTAB>
C00289 00110	
C00290 00111
C00291 00112
C00292 00113
C00293 00114
C00294 ENDMK
C⊗;
TENX<;THE ENTIRE FILE IS FOR TENEX ONLY
COMMENT ⊗ TENEX-IOSER -- R. SMITH ⊗
	LSTON	(IOSER)


IFN ALWAYS, <BEGIN IOSER>

COMMENT ⊗ INDICES, BITS FOR TENEX VERSION OF IOSER ⊗


;WORDS IN CDB BLOCK FOR EACH CHANNEL


?GFL←←0				;FLAGS FOR GTJFN
?OFL←←1				;FLAGS FOR OPENF
?BRCHAR←←2			;BRCHAR ADDRESS
?ICOUNT←←3			;COUNT ADDRESS
?ENDFL←←4			;EOF ADDRESS
?IOCNT←←5			;I/O COUNT
?IOBP←←6			;I/O BP
?IOSTT←←7			;STATUS OF THE IO (SEE FLAGS BELOW)
?IOADDR←←10			;ADDRESS OF THE IO BUFFER IF THERE IS ONE
?DVTYP←←11				;DEVICE TYPE
?DVDSG←←12			;DEVICE DESIGNATOR
?OPNDUN←←13			;TRUE IF OPENED WITH THE OPEN STATEMENT
?DVCH←←14			;DEVICE CHARACTERISTICS
?DMPED←←15			;TRUE IF DUMP MODE OUTPUT SEEN
				;IN PARTICULAR USED TO NOTE IF A MAGTAPE
				;HAS BEEN WRITTEN BUT NOT YET CLOSED,
				;SINCE EOF'S ARE WRITTEN AT THE CLOSE
				;BY CLOSF,CFILE,CLOSE,ETC.
?LINNUM←←16			;LINE NO (FOR INPUT FUNCTION)
?PAGNUM←←17			;PAGE NO (FOR INPUT FUNCTION)
?SOSNUM←←20			;SOS LINE NO (FOR INPUT FUNCTION)
?FKPAGE←←21			;XWD FORK,PAGE FOR PMAPPING TO DSK
?IOPAGE←←22			;PAGE OF THE FILE (IF PMAPPED)
?FDBSZ←←23			;BYTE SIZE OF FILE AS IN FDB
?FDBEOF←←24			;NO. OF BYTES TO EOF AS IN FDB
?TTYINF←←25			;TTY BUFFERING INFO--

;ADDITIONS TO CDB NUMBERS SHOULD INCLUDE CHANGE TO IOTLEN BELOW

?IOTLEN←←26			;CURRENT LENGTH OF CDB BLOCK

DSCR IOSTT(CDB) values.
	The following numbers can be in IOSTT(CDB).  They indicate
the current state of the IO for the associated channel.
	These numbers are set up by SETIO, which is called by
the first IO that happens on the channel.  Each routine has
a dispatch table, usually called TABL, and the SIMIO macro
does an XCT on those tables.
⊗

?XNULL←←0			;NOTHING HAPPENING YET
?XICHAR←←1			;PMAPPING INPUT CHARS
?XOCHAR←←2			;PMAPPING OUTPUT CHARS
?XIWORD←←3			;PMAPPING INPUT WORDS
?XOWORD←←4			;PMAPPING OUTPUT WORDS
?XCICHAR←←5			;36 BIT BUFFERING, INPUT CHARS
?XCOCHAR←←6			;36 BIT BUFFERING, OUTPUT CHARS
?XCIWORD←←7			;36 BIT BUFFERING, INPUT OR OUTPUT WORDS
?XBYTE7←←10			;7 BIT BIN, SIN ETC
?XDICHAR←←11			;DUMP MODE CHARACTER INPUT
?XDOCHAR←←12			;DUMP MODE CHARACTER OUTPUT
?XDARR←←13			;DUMP MORE ARRAY INPUT OR OUTPUT

DEFINE SIMIO(AC,TABL,ERR) <
	SKIPGE	AC,IOSTT(CDB)	
	  JRST [PUSHJ	P,OPNCHK
		MOVE	AC,IOSTT(CDB)	
		JRST	.+1]
	CAILE	AC,13		;MAXIMUM THAT IOSTT CAN BE
	  JRST	ERR
	XCT	TABL(AC)
>;SIMIO

DEFINE CHKDECCLZ <
	SKIPGE	IOSTT(CDB)
	  PUSHJ P,OPNCHK
>;CHKDECCLZ

DEFINE SETZEOF <
	SETZM	.SKIP.
	SKIPE	ENDFL(CDB)
	  SETZM	@ENDFL(CDB)
>;SETZEOF

DEFINE SETOEOF <
	SETOM	.SKIP.
	SKIPE	ENDFL(CDB)
	  SETOM	@ENDFL(CDB)
>;SETOEOF



IFNDEF JFNSIZE, <?JFNSIZE←←20>			;NUMBER OF CHANNELS ALLOWED
?DMOCNT←←200			;(DEFAULT) COUNT FOR DUMP MODE OUTPUT
IFNDEF STARTPAGE,<?STARTPAGE←←610			;STARTING PAGE FOR BUFFERS>

;BITS FOR SCAN FLAGS FOR OPENFILE ROUTINE
;THE BITS OF THE FLAGS WORD ARE THE SAME AS THE BITS OF GTJFN AND OPENF
;HOPEFULLY (WHERE APPLICABLE)

?STARBIT←←1B11			;B11 OF GTJFN FOR INDEXED FILES
?TEMBIT←←1B5			;B5 OF GTJFN FOR TEMPORARY FILE
?DELBIT←←1B8			;GTJFN -- IGNORE DELETED BIT
?RDBIT←←1B19			;B19 OF OPENF FOR READING
?WRBIT←←1B20			;B20 OF OPENF FOR WRITING
?APPBIT←←1B22			;B22 OF OPENF FOR APPEND
?CONFB1←←1B3			;GTJFN BIT TO PRINT [CONFIRM] ETC
?CONFB2←←1B4			;GTJFN BIT TO REQUIRE CONFIRMATION FROM USER
				;ODDLY ENOUGH 3 AND 4 ARE ILLEGAL
?OUTBIT←←1B0			;GTJFN -- FILE FOR OUTPUT USE
?OLDBIT←←1B2			;GTJFN -- OLD FILE
?NEWBIT←←1B1			;GTJFN -- NEW FILE
?ERTNBIT←←1B27			;ERROR RETURN BIT -- INTERNAL
?BINBIT←←1B26			;BINARY BIT -- INTERNAL
?THAWBIT←←1B25			;THAWBIT GTJFN
?ERSNBIT←←1B28			;ERROR SEEN -- INTERNAL
?CONFBIT←←1B29			;CONFIRMATION -- INTERNAL

;MACROS FOR BIT TESTING

DEFINE .ZZZ $ (X,Y,Z)<
IFN Z&777777000000, <TL$X Y,Z⊗-=18>	;Z LSH -=18
IFN Z&777777, <TR$X Y,Z>
>

DEFINE TESTE (Y,Z) <.ZZZ NE,Y,Z>	;TDNE Y,[Z]
DEFINE TESTN (Y,Z) <.ZZZ NN,Y,Z>	;TDNN Y,[Z]
DEFINE TESTO (Y,Z) <.ZZZ O,Y,Z>		;TDO Y,[Z]
DEFINE TESTZ (Y,W) <.ZZZ Z,Y,W>		;TDZ Y,[Z]


;MACRO TO GET THE JFN NUMBER IN X FROM Y.  IF INVALID, JUMP TO LABEL Z
;LOADS CDB (I.E., 11) WITH THE CDB ADDRESS
;LOADS CHNL WITH THE CHANNEL NUMBER
DEFINE VALCHN(X,Y,Z) <

	SKIPL	CHNL,Y
	CAIL	CHNL,JFNSIZE
	  JRST	Z	
	MOVE	CDB,CDBTBL(CHNL)
	HRRZ	X,JFNTBL(CHNL)
	JUMPE	X,Z
>;VALCHN
	
DEFINE LITCHN(X,Y,Z) <
	SKIPL	X,Y
	CAIL	X,JFNSIZE
	  JRST 	Z
	MOVEM	X,CHNL
	MOVE	CDB,CDBTBL(CHNL)
	HRRZ	X,JFNTBL(CHNL)
>;LITCHN 

;ONLY USES AC X
DEFINE VALCH1(X,Y,Z) <
	SKIPL	X,Y
	CAIL	X,JFNSIZE
	   JRST	Z
	HRRZ	X,JFNTBL(X)
	JUMPE	X,Z
>

;TTY STUFF
;FOR DEC-STYLE I/O
;CHAR FOR LINE DELETION (DELLINE) AND CHARACTER DELETION (RUBCHAR)
IFNDEF DELLINE,<?DELLINE←←"U"-100>	;CTRL-U	
IFNDEF RUBCHAR,<?RUBCHAR←←177>		;RUBOUT
IFNDEF ALTMODE,<?ALTMODE←←33	;ONE OF MANY VERSIONS>

DSCR
	TTYINF for information about the controlling terminal.
⊗

?ISCTRM←← 1B0				;CHANNEL IS THE CONTROLLING TERM
?TNXINP←← 0				;DO STANDARD TENEX INPUT
?DECLED←← 1				;DO DEC-STYLE INPUT
?TENXED←← 2				;DO TENEX-STYLE INPUT
?QTTEOF←←1B17				;QUE AN EOF FOR THE TTY
COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,TENXFI,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
	,<SAVE,RESTR,RELEASE,CORGET,INSET>
	,<PAT -- TENEX ROUTINES EMULATING DEC CALLS>)

	BEGIN PAT

DSCR	PROCEDURE OPEN(INTEGER CHAN; STRING DEV; INTEGER MODE,IBUF,OBUF;
	REFERENCE INTEGER COUNT,BR,EOF)
⊗
HERE(OPEN)
	BEGIN OPEN
GTFLAGS←←4
OPFLAGS←←5
	PUSH	P,-7(P)
	PUSH	P,[0]				;CLOSE INHIBIT
	PUSHJ	P,RELEASE			;RELEASE IF ALREADY OPEN

;SEE WHAT KIND OF DEVICE WE HAVE

	PUSH	SP,-1(SP)
	PUSH	SP,-1(SP)
	PUSH	P,[0]
	PUSHJ	P,CATCHR		;PUT ON A NULL CHAR
	PUSHJ	P,MAKUP			;MAKE UPPER CASE (DAMMIT)
	PUSH	SP,-3(SP)
	PUSH	SP,-3(SP)
	PUSH	SP,[3]
	PUSH	SP,[POINT 7,[ASCIZ/:
/]]
	PUSHJ	P,CAT			;PUT ON A STRING
	POP	SP,-4(SP)
	POP	SP,-4(SP)		;SAVE ABOVE

	PUSHJ	P,SAVE			;NOW SAVE ACS
	SETZ	LPSA,			;NO PARAMETERS TO REMOVE
	MOVE	CHNL,-7(P)			;USER CHANNEL NUMBER
	MOVE	1,(SP)			;STRING FOR DEVICE	
	SUB	SP,X22			;ADJUST STACK
	JSYS STDEV
	   JRST BADOPN			;NOT A PLAUSIBLE DEVICE
	PUSH	P,2			;SAVE DEVICE DESIGNATOR
;ITS A PLAUSIBLE DEVICE
	MOVEI	C,IOTLEN
	PUSHJ	P,CORGET
	  ERR <OPEN:  CANNOT GET CORE>
	MOVE	CDB,B			;IO BLOCK ADDRESS
	MOVEM	CDB,CDBTBL(CHNL)	;SAVE 
;ZERO OUT CORE (SINCE CORGET DOESNT!!!)
	HRL	B,B
	ADDI	B,1
	SETZM	(CDB)
	BLT	B,IOTLEN-1(CDB)		

	POP	P,1			;GET DEVICE DESIGNATOR
	MOVEM	1,DVDSG(CDB)		;AND SAVE IT
	JSYS DVCHR
	MOVEM	2,DVCH(CDB)		;SAVE DEVICE CHARACTERISTICS
	HLRZ	1,2			
	ANDI	1,777			;DEVICE TYPE
	MOVEM	1,DVTYP(CDB)		;SAVE IT
	MOVEI	2,STARTPAGE(CHNL)	;PAGE BUFFERING
	HRLI	2,400000		;XWD FORK,PAGE
	MOVEM	2,FKPAGE(CDB)
	LSH	2,9			;ADDRESS
	MOVEM	2,IOADDR(CDB)
	SETOM	IOPAGE(CDB)		;AT (MYTHICAL) PAGE -1
	MOVE	2,DVCH(CDB)		;DEVICE CHARS
	TLNN	2,100000		;IS DEVICE A DIRECTORY DEVICE	
	   JRST	GTNOW			;NOPE, DO GTJFN AND OPENF NO
HASDIR:
;GET THE MODE IN 4
	MOVE	4,-6(P)			;MODE
	ANDI	4,17			;FORGET OTHER JUNK
;IF DEVICE IS A DECTAPE IN DUMP MODE THEN DO IT NOW ALSO
	CAIE	1,3			;IS IT A DECTAPE?
	  JRST	HASDI1			;NO	
	CAIN	4,17			;IN DUMP MODE?		
	  JRST	DOMNT			;YES MOUNT AND THEN OPEN
;SO DONT DO GTJFN NOW, BUT WAIT
HASDI1:	SETZM	JFNTBL(CHNL)		;BE SURE
	MOVEM	4,GFL(CDB)		;SAVE THE MODE AS THE GTJFN FLAGS
	HRL	4,-5(P)			;INPUT BUFFERS
	HRR	4,-4(P)			;OUTPUT BUFFERS	
	MOVEM	4,OFL(CDB)		;SAVE AS THE OPENF FLAGS
	JRST	GUDRET			;AND RETURN

;MOUNT AND OPEN DECTAPE IN DUMP MODE
DOMNT:	MOVE	A,DVDSG(CDB)		;GET DEVICE DESIGNATOR
	TLO	A,(1B3)			;DONT READ DIRECTORY FOR DUMP MODE
	JSYS MOUNT
	   JRST	BADOPN			;CANNOT MOUNT
	MOVSI	GTFLAGS,100001
	MOVE	1,GTFLAGS
	MOVE	2,(SP)
	JSYS GTJFN
	   JRST	BADOPN
	MOVEM	1,JFNTBL(CHNL)
	MOVEM	GTFLAGS,GFL(CDB)
	MOVE	OPFLAGS,[447400000000!RDBIT!WRBIT]
	MOVE	2,OPFLAGS
	JSYS OPENF
	   JRST	CNTOPN
	JRST	OPOK

GTNOW:	
	MOVSI	GTFLAGS,100001
	MOVE	1,GTFLAGS
	MOVE	2,(SP)			;DEVICE STRING
	JSYS GTJFN	
	   JRST	BADOPN			;NOPE CANNOT GET
	MOVEM	1,JFNTBL(CHNL)		;SAVE JFN
	MOVEM	GTFLAGS,GFL(CDB)	;AND SAVE THEM
;CHECK IF IT IS THE CONTROLLING TERMINAL (DEVICE "TTY" ONLY )
	MOVE	2,DVTYP(CDB)		;GET DEVICE TYPE
	CAIE	2,12			;IS IT A TERMINAL?
	  JRST	NOTTTY			;NO
	PUSH	P,3
	PUSH	P,4
	PUSH	P,5
	PUSH	P,6
	HRRZ	2,JFNTBL(CHNL)
	HRROI	1,4			;WRITE IN 4
	MOVSI	3,200000		;DEVICE ONLY
	SETZ	4,
	JSYS	JFNS			;GET STRING
	MOVEM	4,2			;SAVE IN 2
	POP	P,6
	POP	P,5			;RESTORE
	POP	P,4
	POP	P,3
	CAME	2,[ASCIZ/TTY/]		;DEVICE TTY?
	  JRST	NOTTTY			;NO
	MOVE	2,[ISCTRM+DECLED]	;THE CONTROLLING TERMINAL
	MOVEM	2,TTYINF(CDB)		;REMEMBER
NOTTTY:
;COMPUTE OPENF FLAGS
	SETZ	OPFLAGS,
	MOVE	2,DVCH(CDB)		;DEVICE CHARACTERISTICS
	TESTE	2,<1B1>			;CAN DO INPUT?
	   TESTO  OPFLAGS,RDBIT
	TESTE	2,<1B0>			;CAN DO OUTPUT?
	   TESTO  OPFLAGS,WRBIT
	MOVE	1,DVTYP(CDB)		;CHECK DEVICE TYPE
	CAIE	1,7			;IS IT THE LPT?
	CAIN	1,12			;IS IT A TTY?
	   JRST	OP7BT			;USE 7 BIT BYTES
;NOW TRY VARIOUS THINGS, LOOKING FOR SOMETHING THAT WORKS

	HRRZ	1,JFNTBL(CHNL)
	HRLI	OPFLAGS,440000
	MOVE	2,OPFLAGS		;36-BIT, MODE 0
	JSYS OPENF	
	   SKIPA
	JRST	OPOK	
	HRRZ	1,JFNTBL(CHNL)
	HRLI	OPFLAGS,447400		;36-BIT, MODE 17
	MOVE	2,OPFLAGS
	JSYS OPENF
	  SKIPA
	JRST 	OPOK
OP7BT:	HRRZ	1,JFNTBL(CHNL)
	HRLI	OPFLAGS,70000		;7-BIT, MODE 0
	MOVE	2,OPFLAGS
	JSYS OPENF
	   JRST NOOPN
OPOK:	MOVEM	OPFLAGS,OFL(CDB)	;SAVE OP FLAGS
GUDRET:	
;SAVE FLAGS
	SETOM	OPNDUN(CDB)		;INDICATE OPENED WITH OPEN
	POP	P,TEMP			;RETURN ADDRESS
	POP	P,ENDFL(CDB)		;SAVE GOOD THINGS
	POP	P,BRCHAR(CDB)
	POP	P,ICOUNT(CDB)		
	SETZM	@ENDFL(CDB)		;INDICATE GOOD OPENING
	SUB	SP,X22			;CLEAN UP STACKS
	SUB	P,X44
	JRST	RESTR			;AND RETURN
	

NOOPN:
CNTOPN:	SKIPN	1,JFNTBL(CHNL)		;RELEASE JFN
	JSYS RLJFN
	  JFCL
BADOPN:
	SKIPE	B,CDBTBL(CHNL)		;CORE ALLOCATED?
	  PUSHJ	P,CORREL		;RELEASE CORE
	SETZM	JFNTBL(CHNL)
	SETZM	CDBTBL(CHNL)
	SKIPN	@-1(P)			;USER WANTS ERROR?
	  ERR	<OPEN:  IO ERROR OR ILLEGAL SPECIFICATIONS>,1
	SETOM	@-1(P)
	POP	P,TEMP
	SUB	P,[XWD 7,7]
	SUB	SP,X22	
	JRST	RESTR




	BEND OPEN

;MAKE UPPER CASE LETTERS
MAKUP:	PUSHJ	P,SAVE
	SKIPE	SGLIGN(USER)
	  PUSHJ	P,INSET
	HRRZ	A,-1(SP)		;LENGTH OF STRING	
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)		;OK?
	  PUSHJ	P,STRNGC		;NO, COLLECT
	MOVE	B,A
	HRRO	A,A
	PUSH	SP,A
	PUSH	SP,TOPBYTE(USER)
UPPER1:	JUMPLE	B,UPPER2		;DONE YET?
	ILDB	C,-2(SP)		;NEXT CHAR
	CAIL	C,141		
	CAILE	C,172
	  SKIPA	
	SUBI	C,40			;CONVERT TO UPPER CASE
	IDPB	C,TOPBYTE(USER)
	SOJA	B,UPPER1	
UPPER2:	POP	SP,-2(SP)
	POP	SP,-2(SP)
	SETZ	LPSA,
	POP	P,TEMP			;RETURN ADDR
	JRST	RESTR			;RETURN

DSCR  PROCEDURE LOOKUP(INTEGER CHNL; STRING FILE; REFERENCE INTEGER FLAG)

⊗

HERE(LOOKUP)
	BEGIN	LOOKUP
	PUSHJ	P,TENXFI		;MAKE THE FILE SPEC TENEX

	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	PUSH	P,CHNL
	PUSH	P,CDB
	DEFINE CHNARG <-7(P)>
	DEFINE FLGARG <-6(P)>

	SETZM	@FLGARG			;CLEAR FLAG
	SKIPL	CHNL,CHNARG
	CAIL	CHNL,JFNSIZE	
	   JRST	BADLU1
	MOVE	CDB,CDBTBL(CHNL)
	SKIPN	OPNDUN(CDB)		;ERROR IF NOT OPENED
	   JRST	BADLU1
	MOVE	2,DVCH(CDB)		;GET DEVICE CHARACTERISTICS
	TLNN	2,100000		;DOES DEVICE HAVE A DIRECTORY?
	   JRST	LUKRET			;NO, NO LOOKUP
	SKIPE	JFNTBL(CHNL)		;JFN ALREADY ASSIGNED?
	   PUSHJ P,RELNOW		;YES, RELEASE IT

	PUSHJ	P,DEVCAT

	MOVSI	1,100001		;OLD FILE
	MOVE	2,(SP)
	JSYS GTJFN	
	   JRST	BADLUK
	MOVEM	1,JFNTBL(CHNL)
	MOVSI	3,100001
	MOVEM	3,GFL(CDB)
	MOVE	2,[XWD 440000,200000]	;36-BIT
	JSYS OPENF
	   SKIPA
	JRST 	GUDLUK
	MOVE	1,JFNTBL(CHNL)
	MOVE	2,[XWD 447400,200000]	;36-BIT, DUMP
	JSYS OPENF
	   SKIPA
	JRST	GUDLUK
	MOVE	1,JFNTBL(CHNL)
	MOVE	2,[XWD 70000,200000]	;7-BIT
	JSYS OPENF
	   JRST	BADLUK
GUDLUK:	MOVEM	2,OFL(CDB)
	SETZM	@FLGARG
LUKRET:	POP	P,CDB
	POP	P,CHNL
	POP	P,3
	POP	P,2
	POP	P,1
	SUB	SP,X22
	SUB	P,X33
	JRST	@3(P)

BADLUK:	MOVEM	1,@FLGARG
	JRST	LUKRET

BADLU1:	SETOM	@FLGARG		
	JRST	LUKRET


	BEND LOOKUP

DEVCAT:
;HERE WITH CDB LOADED, FILENAME ON THE SP STACK
;RETURN WITH "DEV:FILE" & 0 ON THE SP STACK
;MUST NOT HAVE CALLED SAVE WHEN THIS IS CALLED
	PUSH	P,1
	PUSH	P,2
	PUSH	P,[=100]
	PUSHJ	P,ZSETST		;BP IN 1
	MOVE	2,DVDSG(CDB)		;DEVICE DESIGNATOR
	JSYS	DEVST
	   ERR <LOOKUP, ENTER, OR RENAME:  CANNOT DO DEVST>
	PUSH	P,[=100]
	PUSH	P,1			;UPDATED BP
	PUSHJ	P,ZADJST
	PUSH	P,[":"]
	PUSHJ	P,CATCHR
	PUSHJ	P,CAT.RV		
	PUSH	P,[0]
	PUSHJ	P,CATCHR
	POP	P,2
	POP	P,1
	POPJ	P,

;RELEASE JFN ALREADY THERE
RELNOW:	
	PUSH	P,CHNL			;CHANNEL
	PUSHJ	P,CLOSF			;CLOSE DANCE
	PUSH	P,1
	MOVE	1,JFNTBL(CHNL)		;GET JFN	
	JSYS	RLJFN			;RELEASE
	  ERR <CANNOT RELEASE JFN>,1
	SETZM	JFNTBL(CHNL)		;AND ZERO OUT
	SETZM	IOSTT(CDB)		;NO STATUS
	POP	P,1
	POPJ	P,

	
HERE(ENTER)
	BEGIN ENTER

	PUSHJ	P,TENXFI

	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	PUSH	P,CHNL
	PUSH	P,CDB
	DEFINE 	CHNARG <-7(P)>
	DEFINE	FLGARG <-6(P)>

	SETZM	@FLGARG			;CLEAR FLAG FOR USER
	SKIPL	CHNL,CHNARG
	CAIL	CHNL,JFNSIZE
	   JRST	BADEN1
	MOVE	CDB,CDBTBL(CHNL)
	SKIPN	OPNDUN(CDB)
	   JRST	BADEN1			;WAS AN OPEN PERFORMED HERE?
	SKIPN	1,JFNTBL(CHNL)
	   JRST	NOTOPN
	MOVE	2,DVCH(CDB)		;GET DEVICE CHARACTERISTICS
	TLNN	2,100000		;DOES DEVICE HAVE DIRECTORY?
	   JRST	ENTRET			;NO

	SKIPGE	IOSTT(CDB)		;A DEC-STYLE CLOSE DONE? CHKDECCLZ
	  JRST [PUSHJ P,RELNOW		;RELEASE JFN
		JRST NOTOPN		;AND PROCEED
	      ]

	PUSH	P,1			;SAVE JFN
	SETO	1,			;UNMAP THE BUFFER PAGE
	MOVE	2,FKPAGE(CDB)
	SETZ	3,
	JSYS	PMAP			;REMOVE PAGE
	POP	P,1

	SETOM	IOPAGE(CDB)
	SETZM	IOSTT(CDB)
	
	PUSH	P,1			;SAVE JFN
	TLO	1,400000		;DO NOT RELEASE THE JFN
	JSYS 	CLOSF
	   JFCL	;IGNORE
	POP	P,1
	MOVE	2,OFL(CDB)
	TESTO	2,WRBIT			;TURN ON WRITE BIT
	MOVEM	2,OFL(CDB)		;AND SAVE NEW FLAGS
	JSYS OPENF
	   JRST	BADENT			;ERROR IN 1	    
	JRST	ENTRET			;RETURN

NOTOPN:	
	PUSHJ	P,DEVCAT

	MOVSI	1,600001		;NEW FILE
	MOVE	2,(SP)
	JSYS GTJFN
	   JRST	BADENT			;CANNOT GTJFN
	MOVEM	1,JFNTBL(CHNL)
	MOVSI	2,600001		;THE 
	MOVEM	2,GFL(CDB)		;SAVE THE GTJFN FLAGS
B36:	HRRZ	1,JFNTBL(CHNL)
	MOVE	2,[XWD 440000,100000]	;36-BIT
	JSYS OPENF	
	   SKIPA
	JRST	ENT1	
	HRRZ	1,JFNTBL(CHNL)
	MOVE	2,[XWD 447400,100000]	;36-BIT, DUMP
	JSYS OPENF
	   SKIPA
	JRST	ENT1
	HRRZ	1,JFNTBL(CHNL)
	MOVE	2,[XWD 70000,100000]
	JSYS OPENF
	   JRST	BADENT
ENT1:	MOVEM	2,OFL(CDB)
ENTRET:	SETZM	@FLGARG
ENTPOP:	POP	P,CDB
	POP	P,CHNL
	POP	P,3
	POP	P,2
	POP	P,1
	SUB	SP,X22
	SUB	P,X33
	JRST	@3(P)


BADENT:	MOVEM	1,@FLGARG
	JRST	ENTPOP

BADEN1:	SETOM	@FLGARG
	JRST	ENTPOP

	BEND ENTER
	
DSCR
	RENAME(CHNL,"STR",PROT,@FLAG)
	Since protection is not implemented in TENEX,
the feature will be ignored.
⊗

HERE(RENAME)
	BEGIN RENAME
	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	PUSH	P,CHNL
	PUSH	P,CDB
	DEFINE CHNARG <-10(p)>
	DEFINE FLGARG <-6(P)>	

	VALCHN	1,CHNARG,RENBAD
	PUSHJ	P,OPNCHK		;MAKE SURE OPEN (SOMEWHAT REDUNDANT)
	MOVE	2,DVCH(CDB)		;DEVICE CHARS
	TLNN	2,100000		;DIRECTORY DEVICE?
	  JRST	RENRET			;NO, NOP
	
	PUSHJ	P,TENXFI		;MAKE A TENEX FILE NAME

;PERHAPS ONLY A DELETE?
	HRRZ	2,-1(SP)		;NULL FILE SPEC?
	JUMPE	2,RENDEL		;YES, DELETE 	

;ACTUALLY RENAME (ON THE SAME DEVICE)
	PUSH	P,CHNARG
	PUSHJ	P,CLOSF			;FIRST CLOSE THE FILE

	PUSHJ	P,DEVCAT

	MOVE	3,1			;SAVE FIRST JFN
	MOVE	1,GFL(CDB)		;USE SAME FLAGS
	TESTZ	1,OLDBIT		;EXCEPT NOT OLD
	TESTO	1,NEWBIT		;BUT DO WANT NEW
	TESTO	1,OUTBIT		;AND VERSION DEFAULTING
	MOVEM	1,GFL(CDB)		;SAVE FLAGS
	MOVE	2,(SP)
	JSYS GTJFN
	   JRST	RENERR			;ERROR BITS IN 1
	
	MOVE	2,1			;NEW JFN	
	MOVE	1,3			;OLD JFN
	JSYS RNAMF
	   JRST	RENERR			;ERROR BITS IN 1
	MOVE	1,2			;NEW JFN
	MOVE	2,OFL(CDB)		;OPENF FLAGS
	JSYS	OPENF
	   JRST	RENERR			;ERROR BITS IN 1
	MOVEM	1,JFNTBL(CHNL)		;SAVE THE NEW JFN

RENRET:	SETZM	@FLGARG			;INDICATE A GOOD RETURN
RENRE1:	POP	P,CDB
	POP	P,CHNL
	POP	P,3
	POP	P,2
	POP	P,1
	SUB	SP,X22
	SUB	P,X44
	JRST	@4(P)

RENERR:	MOVEM	1,@FLGARG
	JRST	RENRE1

RENBAD:	SETOM	@FLGARG
	JRST	RENRE1

RENDEL:	TLO	1,400000		;TURN ON BIT 0 FOR NO RELEASE
	JSYS DELF			;JFN IN 1
	   JRST	RENERR
	JRST	RENRET
	BEND RENAME

DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
⊗

HERE(USETI)
HERE(USETO)
	BEGIN USETS

	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	PUSH	P,CHNL
	SETZM	.SKIP.
	VALCHN	1,-6(P),USETERR
	MOVE	2,DVTYP(CDB)
	CAIN	2,3			;IS IT A DECTAPE
	  JRST	USEDTA
	MOVE	2,-5(P)			;ARGUMENT
	SOJ	2,
	LSH	2,7			;CONVERT BLOCK TO WORD NUMBER
	PUSH	P,-6(P)			;CHANNEL ARG
	PUSH	P,2			;WORD TO SET TO
	PUSHJ	P,SWDPTR		;SET THE WORD POINTER
USETRET:POP	P,CHNL
	POP	P,3
	POP	P,2
	POP	P,1
	SUB	P,X33
	JRST	@3(P)


USEDTA:
	MOVEI	2,30			;OPERATION 30 FOR DECTAPES
	HRRZ	3,-5(P)			;TAPE BLOCK
	JSYS MTOPR				;SET DIRECTLY
	JRST	USETRET			;AND RETURN

USETER: ERR<Illegal JFN>,1
	SETOM	.SKIP.
	JRST	USETRET			;AND RETURN

	BEND USETS
		
DSCR	PROCEDURE CLOSE(INTEGER CHANNEL,[CLOSE_INHIBIT_BITS])
	procedure closo(integer chan; integer bits(0))
	procedure closin(integer chan; integer bits(0))
⊗
	BEGIN CLOSES

HERE(CLOSIN)
HERE(CLOSO)
	PUSH 	P,-2(P)
	PUSHJ	P,CLOSF
	PUSHJ	P,SAVE
	VALCHN	1,-2(P),.+2
	SETOM	IOSTT(CDB)		;MARK AS BEING CLOSED
	MOVE	LPSA,X33
	JRST	RESTR

HERE(CLOSE)
DOOPN:	PUSH	P,-2(P)
	PUSHJ	P,CLOSF			;FORCE BUFFERS OUT, WRITE MAGT EOFS, CLOSF
	PUSHJ	P,SAVE
	VALCHN	1,-2(P),CLORET
	SETOM	IOSTT(CDB)		;MARK AS BEING CLOSED
CLORET:	MOVE	LPSA,X33
	JRST	RESTR

	BEND CLOSES

HERE(RELEASE)
DSCR
	Ignores the close inhibit bits that are available in 
the STANFORD SAIL, until we decide what to do with them.
⊗

	PUSH	P,1
	PUSH	P,-3(P)		;CHANNEL
	PUSHJ	P,CFILE
	POP	P,1		;RESTORE 1
	SUB	P,X33
	JRST	@3(P)		;RETURN




DSCR	
	PROCEDURE MTAPE(INTEGER CHAN,OPERATION)
(the operation is a character e.g., "U" to unload)
as in the SAIL manual.
⊗

HERE(MTAPE)
	BEGIN MTAPE
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	LDB	C,[POINT 5,-1(P),35]
	MOVE	A,OPTAB
	MOVE	B,OPTAB+1
	TRZE	C,30			;COMPRESS TABLE
	ADDI	C,5	
	LSH	C,2
	ROTC	A,(C)
	ANDI	B,17
	VALCHN	1,-2(P),MTAERR
	PUSHJ	P,OPNCHK		;MAKE SURE OPEN
	JSYS MTOPR
	JRST	RESTR
MTAERR: ERR <Illegal JFN>,1
	JRST	RESTR

OPTAB:	BYTE (4) 16,17,0,0,3,6,7,13,10	;A,B,E,F,R,S,T
	BYTE (4) 11,0,1			;U,W

	BEND MTAPE

	


DSCR	STRING PROCEDURE TENXFI(STRING DECFILE)

	Converts the string to a TENEX file specification.
A la Alex Cannara.
⊗

HERE(TENXFI)
	BEGIN TENXFI

CTRLV←←"V"-100
FIND←←2

	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	SETZM	FIND
	PUSH	SP,[0]		;DEVICE TEMPORARY
	PUSH	SP,[0]
	PUSH	SP,[0]		;DIR TEMPORARY
	PUSH	SP,[0]
	PUSH	SP,[0]		;NAM TEMPORARY
	PUSH	SP,[0]	

DEFINE ORIG <-7(SP)>
DEFINE ORIG1 <-6(SP)>
DEFINE DEV <-5(SP)>
DEFINE DEV1 <-4(SP)>
DEFINE DIR <-3(SP)>
DEFINE DIR1 <-2(SP)>
DEFINE NAM <-1(SP)>
DEFINE NAM1 <0(SP)>

;SIMPLE SINCE NAME IS AT THE TOP OF SP
DEFINE CATNAM (X) <
	PUSH	P,X
	PUSHJ	P,CATCHR
>
DEFINE CATDIR (X) <
	PUSH	P,X
	PUSH	SP,DIR
	PUSH	SP,DIR
	PUSHJ	P,CATCHR
	POP	SP,-4(SP)
	POP	SP,-4(SP)
>

DEFINE GCH <
	HRRZ	1,ORIG
	JUMPE	1,TENDUN
	ILDB	3,ORIG1
	SOS	ORIG
>


TENX1:	GCH
	CAIE	3,CTRLV
	  JRST	NOQUOTE
	SKIPE	FIND
	  JRST	QUODIR
	PUSHJ	P,CATNA3
	GCH	
	PUSHJ	P,CATNA3 		;AND THE CHAR FOLLOWING THE CTRLV	
	JRST	TENX1
QUODIR:	PUSHJ	P,CATDI3
	GCH
	PUSHJ	P,CATDI3
	JRST	TENX1			;AND CONTINUE

NOQUOTE:
	CAIN	3,":"			;COLON -- DEVICE
	   JRST	ISDEV			;ITS BEEN A DEVICE ALL ALONG!!
	CAIN	3,","
	   JRST	TENX1			;IGNORE COMMA
	CAIE	3,40			;SPACE
	CAIN	3,11			;OR TAB
	   JRST	TENX1

	CAIE	3,"<"			;THESE START THE DIRECTORY NAME
	CAIN	3,"["
	   JRST	STDIR
	CAIE	3,">"			;THESE FINISH THE DIR. NAME
	CAIN	3,"]"
	   JRST	ENDDIR
	SKIPE	FIND			;DOING DIRECTORY?
	   JRST	.+3			;YES
	PUSHJ	P,CATNA3
	JRST	TENX1
	PUSHJ	P,CATDI3
	JRST	TENX1

STDIR:	SETOM	FIND
	SKIPE	DIR			;ANYTHING THERE?
	   JRST	TENX1			;YES, IGNORE
	CATDIR	<[74]>
	JRST	TENX1

ENDDIR:	SETZM	FIND
	JRST	TENX1

ISDEV:	PUSHJ	P,CATNA3		;PUT THE COLON ON THE NAME
	MOVE	3,NAM			;THE "NAME" HAS REALLY BEEN A DEV
	MOVEM	3,DEV
	MOVE	3,NAM1
	MOVEM	3,DEV1			
	
	SETZM	NAM			;SO CLEAR THE NAME -- START OVER
	SETZM	NAM1
	JRST	TENX1

TENDUN:	
;CHECK TO SEE WHAT LAST CHAR OF DIR IS
	SKIPN	DIR
	  JRST	GOTDIR			;NO DIRECTORY THERE
	CATDIR	<[76]>			;PUT ON A ">"
;NOW STACK HAS ORIG,DEV,DIR,NAM
GOTDIR: 
	PUSHJ	P,CAT
;NOW STACK HAS ORIG,DEV,<DIR>NAM
	PUSHJ	P,CAT
;NOW STACK HAS ORIG,DEV:<DIR>NAM
GOTDI1:	POP	SP,-2(SP)
	POP	SP,-2(SP)

TXFRET:
	POP	P,3
	POP	P,2
	POP	P,1
	POPJ	P,


;CALL CAT MACROS WITH AC 3 AS THE ARG
CATNA3:	CATNAM 3
	POPJ	P,

CATDI3:	CATDIR 3
	POPJ	P,


	BEND TENXFI

DSCR
	INTEGER PROCEDURE GETCHAN(INTEGER I)
RETURNS AN UNUSED CHANNEL NUMBER, AND MARKS IT
FOR USE, SO THAT NO ONE WILL TRY TO USE IT.
⊗

HERE(GETCHAN)
	MOVE	A,[XWD -JFNSIZE+1,1]		;START AT CHANNEL 1
GETCH1:	SKIPN	CDBTBL(A)	;ALLOCATED YET?
	   JRST	GETCH2		;NO, TAKE IT
	AOBJN A,GETCH1	;YES
	SETOM	A		;INDICATE ERROR 
	POPJ	P,

GETCH2:	HRRZ	A,A
	PUSH	P,B		;NOW ALLOCATE A TABLE
	PUSH	P,C
	MOVEI	C,IOTLEN
	PUSHJ	P,CORGET
	  ERR <GETCHAN:  CANNOT GET CORE>
	MOVEM	B,CDBTBL(A)

	HRL	C,B		;ZERO OUT BLOCK
	HRRI	C,1(B)
	SETZM	(B)
	BLT	C,IOTLEN-1(B)
		
	SETZM	JFNTBL(A)	;BUT NO JFN (YET)
	POP	P,C
	POP	P,B
	POPJ	P,

DSCR
	INTEGER PROCEDURE CVJFN(INTEGER CHAN)

	Returns the JFN (XWD flags,jfn)  associated
with a logical channel, -1 if no jfn assigned.
	Hereby, the user of these routines can access
the system directly if the need arises.
⊗
HERE(CVJFN)
	SKIPL	1,-1(P)
	CAIL	1,JFNSIZE
	  JRST 	CVJFER
	SKIPN	1,JFNTBL(1)
	  JRST	CVJFER
CVJFR:	SUB	P,X22
	JRST	@2(P)
CVJFER:	SETO	1,
	JRST	CVJFR


BEND PAT

ENDCOM(PAT)

COMPIL(JOBINF,<ODTIM,IDTIM,RUNTM,GTAD,GJINF>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
	,<JOBINF -- JOB UTILITY ROUTINES>)
DSCR STRING SIMPLE PROCEDURE ODTIM(INTEGER DT,FORMAT)
	Returns the string representation of DT
(which is in internal TENEX representation).  If DT
is -1 the current date and time are used.  If format
is -1, the standard format is used.
⊗
HERE(ODTIM)
	PUSH	P,[=100]	; 100 CHARS
	PUSHJ	P,ZSETST	;GET BP IN 1
	MOVE 2,-2(P)		;TIME
	MOVE 3,-1(P)		;FORMAT
	JSYS ODTIM
	PUSH	P,[=100]
	PUSH	P,1		;UPDATED BP
	PUSHJ	P,ZADJST	;GET STRING
	SUB	P,X33		;ADJUST STACK
	JRST	@3(P)		;RETURN

DSCR INTEGER SIMPLE PROCEDURE IDTIM(STRING S)
	Returns the internal TENEX representation of S, which
is assumed to be the date and time in some reasonable format.
If the format cannot be scanned, the error is returned in .SKIP.

⊗

HERE(IDTIM)
	PUSH	P,[0]
	PUSHJ	P,CATCHR		
	MOVE 	1,(SP)			;BYTE-POINTER
	SETZB 	2,.SKIP.		;NO SPECIAL FORMAT, ASSUME NO ERROR
	JSYS IDTIM
	  MOVEM 2,.SKIP.		;ERROR TO USER
	MOVE  	1,2			;ANSWER
	SUB	SP,X22			;ADJUST SP STACK
	POPJ	P,			;RETURN
DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK; REFERENCE INTEGER CONSOLE);
	Returns the runtime of a fork.  If FORK=-5, then then
whole job.  Time is returned as milliseconds for you.  Console time,
similarly converted, is returned in CONSOLE.
⊗
HERE(RUNTM)
	MOVE 	1,-2(P)
	JSYS RUNTM
	MOVEM 	3,@-1(P)
	SUB	P,X33	
	JRST	@3(P)
DSCR INTEGER SIMPLE PROCEDURE GTAD;
	Returns the current date and time.  See Jsys manual,
3-3.
⊗
HERE(GTAD)
	JSYS GTAD
	POPJ P,
DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO);
	Returns the TENEX jobnumber.  LOGDIR is the directory 
no. logged in, CONDIR is the connected directory number.  TTYNO is the
TENEX teletype number, which is -1 if the job is detached.  
	See the DIRST routine for converting directory numbers to 
directory strings.
⊗

HERE(GJINF)
	JSYS GJINF
	MOVEM 	1,@-3(P)
	MOVEM 	2,@-2(P)
	MOVEM 	4,@-1(P)
	MOVE 	1,3;
	SUB	P,X44
	JRST	@4(P)
ENDCOM(JOBINF)

COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
	,<DIRECT -- TENEX DIRECTORY SPECS>)
DSCR INTEGER SIMPLE PROCEDURE STDIR(STRING S; BOOLEAN DORECOGNITION)
DESR
	Returns the directory number associated with a string.
Any problems are returned in .SKIP. with the code:
		1 string does not match
		2 string is ambiguous.
⊗
HERE(STDIR)
	PUSH	P,[0]
	PUSHJ	P,CATCHR	;TACK ON 0
	SETZ 	3,		;
	MOVEI 	1,1 		; ASSUME NO RECOGNITION
	SKIPE 	-1(P)		; DO WE WANT IT?
	SETO  	1,		; YES AFTER ALL
	MOVE 	2,(SP)		;BYTE-POINTER
	JSYS STDIR
	  SKIPA	3,[1]		; NO MATCH;
	  MOVEI	3,2 		; AMBIGUOUS
	MOVEM 	3,.SKIP.	; SAVE IT FOR USER
	HRRZ 	1,1 		; SAVE DIR NO. (ONLY)
	SUB	SP,X22		;ADJUST STRING STACK
	SUB	P,X22
	JRST	@2(P)		;RETURN	
	
DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
	Returns the string name for directory I.  Any problems
cause .SKIP. to be set TRUE.
⊗

HERE(DIRST)
	BEGIN 	DIRST
	PUSH	P,[=100]
	PUSHJ	P,ZSETST
	SETZM 	.SKIP.
	MOVE 	2,-1(P)		;DIRECTORY NO.
	PUSH	P,1		;SAVE STRING POINTER
	JSYS DIRST
	  JRST	DIRERR		;ERROR RETURN
	SUB	P,X11		;CLEAR STACK, DONT NEED STRING POINTER
DOADJ:	PUSH	P,[=100]
	PUSH	P,1		;UPDATED STRING POINTER
	PUSHJ	P,ZADJST	;GET SAIL STRING ON STACK
	SUB	P,X22		
	JRST	@2(P)

DIRERR:	MOVEM	1,.SKIP.	;ERROR NUMBER IN TOPS 20, STRING POINTER IN TENEX
				;ALWAYS TRUE
	POP	P,1		;GET BACK ORIGINAL BP
	JRST	DOADJ		;AND FIX STRINGS
	BEND 	DIRST
ENDCOM(DIRECT)
COMPIL(RUNPRG,<RUNPRG>,<X22,X33,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
DSCR INTEGER SIMPLE PROCEDURE RUNPRG(STRING PROGRAM; INTEGER INCREM; BOOLEAN NEWFORK)
	This does two entirely different things depending on whether
NEWFORK is true or not.
	If NEWFORK then a new fork is created, capabilities transmitted,
and PROGRAM is run there.  INCREM is added to the entry vector.  Any problems
cause the routine to return FALSE, otherwise it returns TRUE.
	If not NEWFORK then the current job is destroyed and replaced
with PROGRAM, with INCREM added to the entry vector location.  This is
like the DEC RUN uuo, and hence if the increment is 1, the program is
started at the CCL address.  If the routine returns at all, there was a problem
with the file.
	Remember to say .SAV as the PROGRAM extension.
⊗


HERE(RUNPRG)
	BEGIN 
	JFN←←0
	FORK←←14
	PUSH	P,[0]
	PUSHJ	P,CATCHR	
	MOVSI	1,100001 	; OLD FILE, PTR IN 2	
	MOVE	2,(SP) 		; STRING POINTER
	JSYS GTJFN 			; TRY FOR JFN		
	   JRST RUNERR 		; ERROR
	MOVEM	1,JFN 		; SAVE JFN		

	SKIPN	-1(P) 		; USER WANTS FORK?
	   JRST SWP 		; NO, REPLACE CURRENT PRG

	MOVSI	1,100000 	; XMIT CAPABILITIES
	JSYS CFORK
	   JRST RUNERR 	; CANNOT CREATE FORK
	MOVEM	1,FORK 	; SAVE HANDLE
	SETOB	2,3 	; INDICATE ALL PRIVILEDGES
	JSYS EPCAP
	HRLZ	1,1 	; FORK HANDLE
	HRR	1,JFN 	; THE JFN
	JSYS GET 		; JSYS GET THE FILE
	MOVEI	1,400000 	; CURRENT FORK
	JSYS	GPJFN	;PRIMARY JFNS IN 2
	MOVE	1,FORK 	; SET PRIMARY IO	
	JSYS SPJFN	;FOR NEW FORK
	MOVE	1,FORK 	; FORK
	MOVE	2,-2(P) 	; USER VALUE FOR ENTRY VECTOR
	JSYS SFRKV	;START THE FORK
	MOVE	1,FORK ;
	JSYS WFORK
	SKIPE	1,FORK 	; SET TO KILL
	JSYS KFORK	;KILL THE FORK
	HRRZ	1,JFN ;
	JSYS RLJFN 		; RELEASE
	JFCL 		; IGNORE	
	JRST 	RUNRET 		; AND RETURN SAFELY

SWP:	
IMSSS,<				;DESTROY EMULATOR INFO AT IMSSS
	SETO	1,
	MOVE	2,[XWD 400000,711]	;PAGE 711
	JSYS	PMAP			;DESTROY
>;IMSSS
	PUSH	P,JFN			;SAVE THE JFN
	HRLI	A1 			; BLT INTO ACS
	HRRI	1 ;
	BLT	15 		; THE INSTRUCTIONS -- NOTE THAT RF IS NOW CLOBBERED
	POP	P,0		; RESTORE JFN TO AC0
	HRLI	0,400000 	; XWD FORK, JFN
 	MOVE	16,-2(P) 	; THE INCREMENT -- NOTE THAT SP IS NOW CLOBBERED
	MOVE	17,[254000400010] 	; FOR COMPARISON -- NOTE THAT THE P STACK IS GONE
	JRST	4 		; AND GO
A1:	-1 		; FOR PMAP
A2:	400000000677 	; THIS FORK, START AT 677 (LEAVING EMULATOR)
A3:	0 ;
A4:	JSYS PMAP
A5:	SOJL	2,4 	; LOOP THROUGH PAGES
A6:	MOVE	1,0 	; XWD 400000,JFN
A7:	JSYS GET ;
A10:	MOVEI	1,400000 	; THIS FORK
A11:	JSYS GEVEC 		; JSYS GET ENTRY VECTOR
A12:	CAMN	2,17 	; DEC STYLE??
A13:	  HRRZ	2,120 	; YES
A14:	ADD	2,16 	; ADD THE INCREMREMENT
A15:	JRST	(2) 	; AND START THE JOB

RUNERR:	TDZA	1,[-1]	;ZERO 1 AND SKIP
RUNRET:	SETO	1,	;INDICATE SUCCESS
	SUB	SP,X22
	SUB	P,X33
	JRST	@3(P)


	BEND;RUNPRG
ENDCOM(RUNPRG)
COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE,SETCHAN>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
DSCR INTEGER SIMPLE PROCEDURE OPENFILE(STRING NAME,OPTIONS)

	Name is the name of the file to be opened.  If it is null, then
OPENFILE goes to the user's console for the filname (with recognition).
	The value of the call is the jfn returned to the user.
	OPTIONS is a string of options available to the user.  Legal 
characters are:

One of these:
	R		read
	W		write
	A		append
Version numbering
	O		old file
	N		new file
	T		temporary file
	*		index with INDEXFILE routine

Independent:
	C		require confirmation
	D		ignore deleted bit
	H		"thawed" access
Error handling
	E		return errors to user in the external
			integer !skip!.  TENEX error codes are used.
			(JFN will be released in this case.)
	OPENFILE does a GTJFN followed by a OPENF.  If GTJFN fails, a new
attempt is made, from the user's console.  
⊗

	BEGIN OPENFILE
JFN←3				;WHERE TO PUT THINGS
FLAGS←4
GTFLAGS←5
OPFLAGS←6

DEFINE EQ $ (X,Y) <
	CAIE	A,"$X$"
	   JRST .+3
	TESTO	FLAGS,Y
	JRST	OPCONT
>

DEFINE JTRUE $ (X) <
	TESTN	FLAGS,X
>
DEFINE JFALSE (X) <
	TESTE	FLAGS,X
>

DEFINE 	SGT (X) <
	TESTO	GTFLAGS,X
>
DEFINE  SOF (X) <
	TESTO	OPFLAGS,X
>
DEFINE  TGT (X) <
	TESTE	FLAGS,X
	  TESTO GTFLAGS,X
>
DEFINE  TOP (X) <
	TESTE	FLAGS,X
	  TESTO OPFLAGS,X
>

HERE(OPENFILE)
	SETZB	FLAGS,.SKIP.
	SETZB	GTFLAGS,OPFLAGS
	HRRZ	B,-1(SP)		;COUNT OF OPTIONS WORD

WHIOPT:	JUMPE	B,OPTDUN
	ILDB	A,(SP)			;GET AN OPTION
	CAIGE	A,141
	   JRST .+3
	CAIG	A,172
	   SUBI	A,40			;CONVERT TO UPPER CASE
;ANY NON-ALPHABETIC CHARS GO HERE

	EQ 	*,STARBIT
;NOW ALLOW ONLY ALPHABETIC CHARS
	CAIL	A,101			;MUST BE 
	CAILE	A,132
	   JRST	OPTERR
	SKIPN	BITTBL-"A"(A)		;SOMETHING THERE?
	   JRST	OPTERR			;NOPE, ERROR
	TDO	FLAGS,BITTBL-"A"(A)	;RIGHT SPOT IN TABLE
	SOJGE	B,WHIOPT
	  JRST	OPTDUN
;HERE ON ERROR
OPTERR:	ERR	<OPENFILE:  ILLEGAL OPTION >,1
	TESTO	FLAGS,ERSNBIT

  OPCONT:
	SOJGE	B,WHIOPT

;NOW SET UP GTFLAGS ACCORDING TO THE SCANNED INFORMATION
OPTDUN:		
	TGT	OLDBIT			;INSIST ON OLD?
	TGT	NEWBIT			;INSIST ON NEW?
	JTRUE	OLDBIT
	JFALSE	NEWBIT			;IF NEITHER
	  JRST	OPTDU1			;WELL, ONE
	JTRUE	WRBIT			;IF WRITING
	  JRST	OPTDU1
	JFALSE	RDBIT			;AND READING
	JTRUE	APPBIT			;BUT NOT APPENDING
	  SGT	OUTBIT			;THEN SET OUTPUT BIT
OPTDU1:
	JFALSE	RDBIT			;IF READING
	JFALSE	WRBIT			;AND NOT WRITING
	   JRST	OPTDU2	   
	JTRUE	APPBIT			;AND NOT APPENDING
	   SGT	OLDBIT			;THEN INSIST ON OLD
OPTDU2:
;NOW TEST FOR INDEPENDANT THINGS
	TOP	RDBIT
	TOP	WRBIT
	TOP	APPBIT
	TGT	TEMBIT
	TGT	STARBIT
	TGT	DELBIT
	TOP	THAWBIT
	JFALSE	CONFBIT
	   JRST	[SGT	CONFB1
		 SGT	CONFB2
		 JRST	.+1]
	TLO	GTFLAGS,1		;SHORT CALL OF GTJFN
GTAGAIN:
	HRRZ	A,-3(SP)		;LENGTH OF NAME
	JUMPE	A,[TRYAGN:  
		   TLO	GTFLAGS,2
		   MOVE	2,[XWD 100,101]
		   JRST  GT]
	AND 	GTFLAGS,[717777777777]
	
	PUSH	SP,-3(SP)
	PUSH	SP,-3(SP)
	PUSH	P,[0]
	PUSHJ	P,CATCHR		;CONCATENATE A NULL CHAR
	MOVE	2,(SP)			;BYTE-POINTER
	SUB	SP,X22			;ADJUST STACK
GT:	MOVE	1,GTFLAGS
	JSYS GTJFN
	  JRST 	GTERR
	MOVEM	1,JFN			;REMEMBER JFN
	PUSHJ	P,SETCHN		;SET A CHANNEL, ALLOCATE, GET CDB, SET DVTYP, RETURN CHANNEL
	MOVEM	1,CHNL			;REMEMBER CHANNEL	
	MOVEM	GTFLAGS,GFL(CDB)


COMMENT ⊗ Do the open.
⊗
	MOVE	1,DVTYP(CDB)		;CHECK THE DEVICE TYPE
	CAIE	1,7			;IS IT THE LPT?
	CAIN	1,12			;IS IT A TTY?
	   JRST	B7			;YES, USE 7 BIT
B36:	HRRZ	1,JFN			;JFN
	HRRZ	2,OPFLAGS
	HRLI	2,440000		;36-BIT, MODE 0
	JSYS OPENF	
	   JRST	B36DMP			;TRY 36-BIT, DUMP MODE
	JRST	OPNOK
B36DMP:	HRRZ	1,JFN
	HRRZ	2,OPFLAGS
	HRLI	2,447400		;36 BITS, DUMP MODE
	JSYS OPENF			
	   JRST	B7
	JRST	OPNOK
B7:	HRRZ	1,JFN
	HRRZ	2,OPFLAGS
	HRLI	2,70000			;7 BIT
	JSYS OPENF
	    JRST OPERR			;NOPE
OPNOK:	MOVEM	2,OFL(CDB)		;SAVE 
	MOVE	1,CHNL			;RETURN CHANNEL NO	
OPFRET:	SUB	SP,X44			;ADJUST
	POPJ	P,			;AND RETURN




GTERR:
;HERE WITH ERROR ON GTJFN
	JTRUE	ERTNBIT			;USER WANT'S ERRORS?
	   JRST	GTER1			;NO
ERRRET:	MOVEM	1,.SKIP.		;STORE FOR USER
	SETO	1,			;SOMETHING SUSPICIOUS
	JRST	OPFRET			;AND RETURN

GTER1:	PUSHJ	P,SERSTR		;SHOW ERSTR
	HRROI	1,[ASCIZ/
Cannot GTJFN file /]
	JSYS PSOUT
	PUSH	SP,-3(SP)
	PUSH	SP,-3(SP)
	PUSHJ	P,OUTSTR
	HRROI	1,[ASCIZ/, try again  */]
	JSYS PSOUT
	JRST	TRYAGN



OPERR:	JTRUE	ERTNBIT
	   JRST	OPER1
	PUSH	P,1			;SAVE ERROR BITS
	PUSH	P,CHNL
	PUSHJ	P,CFILE			
	POP	P,1			;RESTORE ERROR BITS
	JRST	ERRRET

OPER1:	PUSHJ	P,SERSTR		;SHOW ERSTR
	HRROI	1,[ASCIZ/
Cannot OPENF file /]
	JSYS 	PSOUT
	PUSH	SP,-3(SP)
	PUSH	SP,-3(SP)
	PUSHJ	P,OUTSTR
	HRROI	1,[ASCIZ/, try again  */]
	JSYS 	PSOUT	
	PUSH	P,CHNL			;CLOSE AND RELEASE FILE AND CDB BLOCK
	PUSHJ	P,CFILE
	JRST	TRYAGN	

;HERE WITH THE TENEX ERROR CODE IN 1 -- 1 MAY BE CLOBBERED
SERSTR:
	PUSH	P,2			;SAVE ACS
	PUSH	P,3
	HRRZ	2,1
	HRLI	2,400000		;THIS FORK
	HRROI	1,[ASCIZ/
/]
	JSYS	PSOUT
	MOVEI	1,101			;PRIMARY OUTPUT
	SETZ	3,			;FLAGS
	JSYS	ERSTR
	  JFCL
	  JFCL
	POP	P,3
	POP	P,2
	POPJ	P,


BITTBL: APPBIT	;A
	BINBIT	;B
	CONFBIT	;C
	DELBIT	;D
	ERTNBIT	;E
	0	;F
	0	;G
	THAWBIT	;H
	0	;I
	0	;J
	0	;K
	0	;L
	0	;M
	NEWBIT	;N
	OLDBIT	;O
	0	;P
	0	;Q
	RDBIT	;R
	0	;S
	TEMBIT	;T
	0	;U
	0	;V
	WRBIT	;W
	0	;X
	0	;Y
	0	;Z


	BEND OPENFILE

DSCR PROCEDURE SETINPUT(INTEGER CHAN; REFERENCE INTEGER COUNT,BR,EOF)
	Sets up the variables associated with input (as in the DEC
open statement.)
⊗

HERE(SETINPUT)
	PUSHJ	P,SAVE
	VALCHN	1,-4(P),SETERR
	POP	P,TEMP
	POP	P,ENDFL(CDB)
	SKIPE	ENDFL(CDB)
	   SETZM @ENDFL(CDB)		;ASSUME NOT EOF
	POP	P,BRCHAR(CDB)
	SKIPE	BRCHAR(CDB)
	   SETZM @BRCHAR(CDB)		;ASSUME NO BRCHAR
	POP	P,ICOUNT(CDB)
	SETZ	LPSA,			;NO PARAMETERS
	SUB	P,X11
	JRST	RESTR
SETERR: ERR <Illegal JFN>,1
	MOVE	LPSA,[XWD 5,5]
	JRST	RESTR

DSCR
	SETPL(CHAN,@LINNUM,@PAGNUM,@SOSNUM)

	Names the variables to be used by the INPUT
function for counting the line-feeds (12), formfeeds (14)
seen by INPUT, as well as keeping the current SOS line
number, if any.  Useful when scanning a file, and
you want to know what page,line you are on.
	Initializes all three variables to 0.

⊗
HERE(SETPL)
	PUSHJ	P,SAVE
	VALCHN	1,-4(P),SETPER
	POP	P,TEMP		;RET ADR
	POP	P,SOSNUM(CDB)
	SETZM	@SOSNUM(CDB)
	POP	P,PAGNUM(CDB)
	SETZM	@PAGNUM(CDB)
	POP	P,LINNUM(CDB)
	SETZM	@LINNUM(CDB)
	SUB	P,X11		;REMOVE CHANNEL NO.
SETRET:	SETZ	LPSA,
	JRST	RESTR
SETPER: ERR <Illegal JFN>,1
	MOVE	LPSA,[XWD 5,5]
	JRST	RESTR




DSCR
	BOOLEAN PROCEDURE INDEXFILE(INTEGER JFN)

RETURNS TRUE AS LONG AS WE CAN GNJFN ANOTHER FILE
⊗

HERE(INDEXFILE)
	PUSH	P,-1(P)
	PUSHJ	P,CLOSF
	PUSH	P,-1(P)
	PUSHJ	P,GNJFN
	JUMPE	1,INDRET		;RETURN FALSE IF NO OTHER FILES
	PUSH	P,2
	PUSH	P,CDB
	PUSH	P,CHNL		
;CHANNEL ALREADY VALID
	MOVE	CHNL,-4(P)			;CHANNEL NUMBER
	MOVE	CDB,CDBTBL(CHNL)		;CDB LOC
	HRRZ	1,JFNTBL(CHNL)		;JFN
	MOVE	2,OFL(CDB)		;GET OPENFLAGS
	JSYS OPENF			;TRY OPENING
	  JRST NOIND
	SKIPE	ENDFL(CDB)		;ZERO SETINPUT (or OPEN) VARIABLES IF HERE
	  SETZM	@ENDFL(CDB)
	SKIPE	BRCHAR(CDB)
	  SETZM	@BRCHAR(CDB)
	SKIPE	LINNUM(CDB)		;ZERO SETPL VARS
	  SETZM	@LINNUM(CDB)
	SKIPE	PAGNUM(CDB)
	  SETZM	@PAGNUM(CDB)
	SKIPE	SOSNUM(CDB)
	  SETZM	@SOSNUM(CDB)
	SETO	1,
INDPOP:	POP	P,CHNL
	POP	P,CDB
	POP	P,2
INDRET:	SUB	P,X22	
	JRST	@2(P)

NOIND:	ERR <INDEXFILE:  CANNOT OPENF>,1
	SETZ	1,
	JRST	INDPOP
DSCR SETCHAN(JFN,GTFLAGS,OPFLAGS)

	JFN is a real TENEX jfn.  It is inserted in the SAIL
runtime system, and the internal book-keeping is set to
believe that the GTJFN was done with GTFLAGS and the OPENF
with OPFLAGS.  JFN may have come from some random source.
⊗
HERE(SETCHAN)
	PUSHJ	P,SAVE
	MOVE	LPSA,X44
	MOVE	A,-3(P)				;JFN
	PUSHJ	P,SETCHN
	MOVEM	A,RACS+A(USER)			;CHANNEL
	HRROI	A,-1(P)				;PREPARE FOR POPPING
	POP	A,OFL(CDB)			;MOVE FROM THE STACK
	POP	A,GFL(CDB)
	JRST	RESTR

ENDCOM(OPF)
COMPIL(GTJFN,<GTJFN,GTJFNL>,<.SKIP.,SETCHN,CATCHR,X11,X22,X44>,<GTJFN -- GET A JFN>)
DSCR INTEGER SIMPLE PROCEDURE GTJFN(STRING S; INTEGER FLAGS)
	Does a GTJFN.  If S is non-null, it is the filename, otherwise
the routine goes to the user's console for a file.  FLAGS are used for
accumulator 1, and any error code is returned in .SKIP.  The value
of the call is the JFN, if obtained.
	Defaults for FLAGS:  0  means ordinary input, 1 means ordinary
output.  Ordinarily the user will use the OPENFI routine.
⊗

HERE(GTJFN)
	SKIPN	1,-1(P)
	  MOVSI 1,100001
	CAIN	1,1
	  MOVSI	1,600001
	TLO	1,1			;MARK FOR SHORT CALL
	HRRZ	2,-1(SP)
	JUMPE	2,[MOVE 2,[100000101]
		  TLO	1,2		;INDICATE XWD JFN,JFN IN 2
		   JRST GOTDEST]
	TLZ	1,2			;INDICATE BYTE-POINTER IN 2
	PUSH	P,[0]			
	PUSHJ	P,CATCHR		;PUT ON A NULL
	MOVE	2,(SP)
GOTDEST: SETZM	.SKIP.			;ASSUME NO ERROR
	PUSH	P,1			;SAVE FLAGS
	JSYS GTJFN
	  JRST GTBAD 		; SOMETHING IS WRONG
	PUSHJ	P,SETCHN	;SETUP A CHANNEL, AND ALLOCATE, GET STATUS, SET CDB
	POP	P,GFL(CDB)	;SAVE FLAGS
GTRET:	SUB	SP,X22
	SUB	P,X22
	JRST	@2(P)

GTBAD:
	
	MOVEM 	1,.SKIP.		; REMEMBER
	POP	P,1			;ADJUST STACK
	SETO 	1, 		; SOMETHING SUSPICIOUS TO RETURN TO USER
	JRST	GTRET

DSCR INTEGER PROCEDURE GTJFNL(STRING ORIG; INTEGER FLAGS, XWDJFN!JFN;
	STRING DEV,DIR,NAM,EXT,PROT,ACCOUNT; INTEGER DESIRED!JFN)

	Does the long form of GTJFN.  
⊗
HERE(GTJFNL)
	BEGIN GTJFNL

DEFINE STRPUT(X)<
	PUSHJ	P,.STPUT
	MOVEM	A,X
>
DEFINE FLG <-14(P)>
DEFINE IOJFN <-13(P)>
DEFINE DESJFN <-12(P)>
	ADD	P,[XWD 11,11]		;ROOM FOR LONG-FORM TABLE
	TLNN	P,400000		;OVERFLOW?
	  ERR	<GTJFNL:  P-stack overflow>
	MOVE	A,DESJFN	
	MOVEM	A,0(P)			;THE DESIRED JFN
	STRPUT	-1(P)			;ACCOUNT
	STRPUT	-2(P)			;PROTECTION
	STRPUT	-3(P)			;EXTENSION
	STRPUT	-4(P)			;NAME
	STRPUT	-5(P)			;DIRECTORY
	STRPUT	-6(P)			;DEVICE
	MOVE	A,IOJFN			;XWD INPUT JFN, OUTPUT JFN
	MOVEM	A,-7(P)
	MOVE	A,FLG	
	MOVEM	A,-10(P)
	STRPUT	B			;MAIN STRING POINTER
	MOVEI	A,-10(P)		;ADDRESS OF BLOCK (ON STACK)
	SETZM	.SKIP.			;ASSUME NO ERROR
	JSYS	GTJFN			;LONG FORM
	   JRST	GTLBAD			;NOPE
	PUSHJ	P,SETCHN		;SET UP CHANNEL TABLE, ALLOCATE, GET STATUS, SET CDB
	MOVE	B,-10(P)		;GTJFN FLAGS
	MOVEM	B,GFL(CDB)		;SAVE
GTLRET:	SUB	P,[XWD 11+4,11+4]	;ADJUST STACK FOR LONG-FORM TABLE, AND ARGUMENTS
	JRST	@4(P)			;AND RETURN

GTLBAD:	MOVEM	A,.SKIP.		;RETURN ERROR CODE TO USER
	SETO	A,			;SOMETHING SUSPICIOUS
	JRST	GTLRET			;AND RETURN

.STPUT:	HRRZ	A,-1(SP)		;GET THE COUNT
	  JUMPE	A,[SUB	SP,X22		;ADJUST AND RETURN
		   POPJ	P,]
	PUSH	P,[0]
	PUSHJ	P,CATCHR
	POP	SP,A
	SUB	SP,X11
	POPJ	P,


	BEND GTJFNL



ENDCOM(GTJFN)
COMPIL(FILINF,<GNJFN,DELF,UNDELETE,DELNF,SIZEF,JFNS,JFNSL,OPENF,CFILE,CLOSF,RLJFN,GTSTS,STSTS,RNAMF>
	,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST,FINIO>
	,<FILINF -- UTILITY FILE ROUTINES>)


DSCR INTEGER SIMPLE PROCEDURE GNJFN(INTEGER JFN)
	Does the GNJFN jsys.
⊗
HERE(GNJFN)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN 1,<-1(P)>,GNERR
	MOVE	1,JFNTBL(CHNL)		;GET THE WHOLE JFN
	JSYS	GNJFN
	  JRST	GNRLZ			;FAILURE TO INDEX, RELEASE JFN
	MOVEM	1,.SKIP.		;SAVE BITS INDICATING CHANGE
	SETOM	RACS+A(USER)		;INDICATE SUCCESS
GNRET:	JRST	RESTR

GNERR:  ERR <Illegal JFN>,1
	SETZM	RACS+A(USER)
	JRST	RESTR

GNRLZ:	SETZM	.SKIP.			;NOTHING THERE
	SETZM	RACS+A(USER)		;FAILURE TO INDEX
	PUSH	P,-1(P)
	PUSHJ	P,CFILE			;SO RELEASE FILE
	JRST	RESTR

DSCR	PROCEDURE DELF(INTEGER CHAN)
	Deletes file open on CHAN.  Errors to .SKIP. 
⊗
HERE(DELF)
	PUSH	P,1
	VALCH1	1,-2(P),DELF1
	TLO	1,400000		;DONT RELEASE THE JFN
	JSYS	DELF
	  JRST	DELF2
	SETZM	.SKIP.			;NO ERROR
DELFRE:	POP	P,1
	SUB	P,X22
	JRST	@2(P)
DELF1:	SETO	1,
DELF2:	MOVEM	1,.SKIP.
	JRST	DELFRE

DSCR INTEGER PROCEDURE DELNF(INTEGER CHAN,NUM)
⊗
HERE(DELNF)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCH1	1,-2(P),DLNERR
	MOVE	2,-1(P)
	SETZM	.SKIP.
	JSYS	DELNF
	  JRST	DLNERR
	MOVM	2,2			;ABSOLUTE NUMBER OF
	MOVEM	2,RACS+A(USER)		;FILES DELETED
	JRST	RESTR	
DLNERR:	MOVEM	1,.SKIP.;
	SETZM	RACS+A(USER)		;INDICATE NO FILES DELETED
	JRST	RESTR
DSCR	PROCEDURE UNDELETE(INTEGER CHAN)
	Undeletes file open on CHAN.  Errors to .SKIP.
⊗
HERE(UNDELETE)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCH1	1,-1(P),UNDEL1
	HRLI	1,1			;XWD 1,JFN
	MOVSI	2,(1B3)			;DELETED BIT
	SETZ	3,			;TURN IT OFF
	JSYS	CHFDB			;CHANGE THE FDB
	JRST	RESTR
UNDEL1:	SETOM	.SKIP.
	JRST	RESTR
	



DSCR	INTEGER PROCEDURE SIZEF(INTEGER JFN)
	Gets the size in pages of the file open on JFN, with error code to 
.SKIP.
⊗
HERE(SIZEF)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN 1,<-1(P)>,SIZERR
	SETZM	.SKIP.
	JSYS SIZEF
	JRST [MOVEM 1,.SKIP.
		SETZM	RACS+A(USER)
		JRST SIZRET]
	MOVEM	3,RACS+A(USER)		;ANSWER IN AC 3
SIZRET:	JRST	RESTR

SIZERR: ERR <Illegal JFN>
	SETOM	.SKIP.
	JRST	SIZRET



DSCR STRING SIMPLE PROCEDURE JFNS(INTEGER JFN,FLAGS)
	Returns the name of the file associated with JFN.
FLAGS are for ac 3 as described in the jsys manual, with
0 the reasonable default.
⊗

HERE(JFNS)
	VALCHN	2,<-2(P)>,JFNSER	;GET JFN IN AC2
	PUSH	P,[=400]
	PUSHJ	P,ZSETST		;GET BP IN AC 1
	MOVE	3,-1(P)
	JSYS JFNS
	PUSH	P,[=400]
	PUSH	P,1
	PUSHJ	P,ZADJST
JFNSRE:	SUB	P,X33
	JRST	@3(P)
JFNSER: ERR <Illegal JFN>,1
	PUSH	SP,[0]			;RETURN NULL STRING
	PUSH	SP,[0]
	JRST	JFNSRE


DSCR JFNSL is added to correct a design error in JFNS, which did
not allow full flexibility.
⊗

HERE(JFNSL)
	BEGIN JFNSL
	VALCHN	2,<-3(P)>,JFNSER	;VALIDATE, GETTING JFN IN 2
	MOVE	1,-1(P)			;FLAGS FOR LH
	CAMN	1,[-1]			;-1??
	 HLRZ	1,JFNTBL(CHNL)		;YES, GET THOSE USED BY GTJFN
	HRL	2,1			;NOW PUT FLAGS INTO LH(2)
	PUSH	P,[=400]
	PUSHJ	P,ZSETST		;GET BP IN AC 1
	MOVE	3,-2(P)			;CONTROL FLAGS FOR FORMAT
	JSYS JFNS
	PUSH	P,[=400]
	PUSH	P,1
	PUSHJ	P,ZADJST
JFNSRE:	SUB	P,[XWD 4,4]
	JRST	@4(P)
JFNSER: ERR <Illegal JFN>,1
	PUSH	SP,[0]			;RETURN NULL STRING
	PUSH	SP,[0]
	JRST	JFNSRE

	BEND JFNSL
DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
	Does an OPENF.

PARAMETERS:
	JFN     the JFN
	FLAGS 	for accumulator 2.
	.SKIP.	the error code (if pertinent)

Some defaults:
	FLAGS		ACTION
	-----------------------
	0		INPUT CHARACTERS
	1		OUTPUT CHARACTERS
	2		INPUT 36-BIT WORDS
	3		OUTPUT 36-BIT WORDS
	4		DUMP MODE INPUT (USE DUMPI FUNCTION)
	5		DUMP MODE OUTPUT (USE DUMPO FUNCTION)
	VALUES 6-10 ARE RESERVED FOR EXPANSION

Other values of FLAGS are interpreted literally.
	Ordinarily the user will use the OPENFI routine.
⊗

HERE(OPENF)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCHN	1,-2(P),OPNERR
	SKIPL	2,-1(P)		;GET THE FLAGS
	CAILE	2,5		;CHECK IN RANGE 0-5
	   JRST	GOTFLAGS
	MOVE	2,OPNTBL(2)	;GET CORRECT WORD
GOTFLAGS:
	SETZM	.SKIP.
	PUSH	P,2		;SAVE FLAGS
	JSYS OPENF
	  JRST	NOOPN
	POP     P,OFL(CDB)	;AND SAVE FLAGS
	SETZM	IOSTT(CDB)	;CLEAR STATUS
OPNRET:	JRST	RESTR

OPNERR: ERR <Illegal JFN>,1
	SETOM	.SKIP.
	JRST	OPNRET

NOOPN:	MOVEM	1,.SKIP.
	SUB	P,X11		;ADJUST STACK
	JRST	OPNRET

OPNTBL:	070000200000		;7-BIT READ
	070000100000		;7-BIT WRITE
	440000200000		;36-BIT READ
	440000100000		;36-BIT WRITE
	447400200000		;36-BIT DUMP READ
	447400100000		;36-BIT DUMP WRITE

DSCR SIMPLE INTEGER PROCEDURE CFILE(INTEGER JFN)
	Closes the file (CLOSF) and releases (RLFJN)
the jfn.  This is the ordinary way the user will use
to dispense with a file.
	Returns TRUE if JFN legal and released, FALSE o.w.
Always returns.
⊗

HERE(CFILE)
	PUSH	P,2
	PUSH	P,3
	PUSH	P,CHNL
	PUSH	P,CDB
	SKIPL	CHNL,-5(P)
	CAIL	CHNL,JFNSIZE
	   JRST	CFBAD
	MOVE	CDB,CDBTBL(CHNL)	;GET CDB
	SKIPN	1,JFNTBL(CHNL)	;JFN ASSIGNED?
	   JRST	CFBA1		;NO, JUST RELEASE CORE
	HRRZ	1,1		;JFN ONLY
	PUSHJ	P,FINIO		;WRITE OUT REMAINING STUFF, CHECK EOF, MAGTAPE

RLCOR:	SKIPE	B,CDBTBL(CHNL)	; ANY CORE TO RELEASE?
	  PUSHJ	P,CORREL	; RELEASE THE BLOCK
	TLZ	1,400000	; BE SURE TO RELEASE
	JSYS CLOSF		; CLOSE (AND RELEASE)
	   JFCL			; ERROR RETURN
	HRRZ	1,JFNTBL(CHNL)	; GET JFN AGAIN
	JSYS	RLJFN		; RELEASE (FOR GOOD MEASURE IF FILE NOT OPEN)
	   JFCL			; ERROR RETURN
	SETO	1, 		; RETURN TRUE FOR GOOD RELEASE
      	SETZM	CDBTBL(CHNL)
	SETZM	JFNTBL(CHNL)
CFRET:	POP	P,CDB
	POP	P,CHNL
	POP	P,3
	POP	P,2
	SUB	P,X22 		; ADJUST
	JRST	@2(P) 		; RETURN

CFBAD:	SETZ	1, 		; RETURN FALSE
	JRST	CFRET ;

CFBA1:	SKIPE	B,CDB
	PUSHJ	P,CORREL	;RELEASE CORE BLOCK
	SETZM	CDBTBL(CHNL)	;REMOVE ALL TRACE
	SETZM	JFNTBL(CHNL)	
	SETZ	1,		; RETURN FALSE
	JRST	CFRET

DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
	Does a CLOSF on the JFN.  Ordinarily the user
will want to use the CFILE routine, which handles errors
internally. The CLOSF is accomplished in such a way that
the JFN is actually not released.
	If the device is a magtape open for output, then
2 eof's are written, followed by a backspace.  This writes
a standard end-of-file on the tape.
⊗
HERE(CLOSF)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN	1,<-1(P)>,CLOERR
	PUSHJ	P,FINIO		;WRITE OUT BUFFERS, SET FDB, WRITE MAGT EOFS, CLEAR BUFFERS

DOCLO:	SETZM 	.SKIP.		;ASSUME NO ERROR
	TLO 1,400000 		; DO NOT RELEASE THE JFN
	JSYS CLOSF
	  MOVEM	1,.SKIP.	;ERROR
CLORET:	JRST	RESTR

CLOERR:	
	SETOM	.SKIP.
	JRST	CLORET

DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
	Does the RLJFN jsys.  Ordinarily the user will want
to use the CFILE routine, which handles errors internally.
⊗

HERE(RLJFN)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	SKIPL	C,-1(P)
	CAIL	C,JFNSIZE
	   JRST	RLJBAD
	SKIPN	1,JFNTBL(C)
 	   JRST	RLJBAD
	SETZM	JFNTBL(C)	
	SKIPE	B,CDBTBL(C)
	PUSHJ	P,CORREL
	SETZM	CDBTBL(C)
	SETZM	.SKIP.		;ASSUME NO ERROR
	JSYS RLJFN
	  MOVEM	1,.SKIP.	;ERROR RETURN
RLJRET:	JRST	RESTR

RLJBAD: ERR <Illegal JFN>,1
	SETOM 	.SKIP.
	JRST	RLJRET


DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN);
	Gets the file status. 
	WARNING: The results of this call are not necessarily appropriate
if the file is open in special character input mode.  If you want to check
for end-of-file, examine the EOF variable instead.
⊗

HERE(GTSTS)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN	1,<-1(P)>,GTSERR
	JSYS GTSTS
	MOVEM	2,RACS+A(USER)
GTSRET:	JRST	RESTR

GTSERR:	ERR <Illegal JFN>,1
	JRST	GTSRET
DSCR BOOLEAN SIMPLE PROCEDURE STSTS(INTEGER JFN,STATUS);
	Sets the status of JFN to STATUS using the STSTS jsys.
⊗

HERE(STSTS)
	VALCH1 	1,<-2(P)>,STSERR
	MOVE	2,-1(P)
	SETO	3,			;ASSUME	SKIP
	SETZM	.SKIP.
	JSYS	STSTS
	  JRST [STERRT: SETZ	3,			;PROBLEM	
		MOVEM	1,.SKIP.
		JRST .+1]
	MOVE	1,3			;RETURN
	SUB	P,X33
	JRST	@3(P)

STSERR:	ERR <Illegal JFN>,1
	JRST	STERRT			;RETURN

DSCR BOOLEAN SIMPLE PROCEDURE RNAMF(INTEGER EXISTINGJFN,NEWJFN);
	File open on EXISTINGJFN is renamed to file open
on NEWJFN.
⊗
HERE(RNAMF)
	VALCH1	1,<-2(P)>,RNFERR
	VALCH1	2,<-1(P)>,RNFERR
	SETO	3,			;ASSUME OK
	SETZM	.SKIP.
	JSYS	RNAMF
	   JRST [RNERET:  SETZ	3,
		 MOVEM	1,.SKIP.
		 JRST	.+1]
RNFRET:	MOVE	1,3			;RETURN VALUE
	SUB	P,X33
	JRST	@3(P)

RNFERR:	ERR <Illegal JFN>,1
	JRST	RNERET

ENDCOM(FILINF)	
COMPIL(DEVINF,<CNDIR,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST,GTFDB,CHFDB>
	,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST>
	,<DEVINF -- DEVICE AND DIRECTORY ROUTINES>)

DSCR BOOLEAN SIMPLE PROCEDURE CNDIR(INTEGER DIR; STRING PASSWORD);
	Using the CNDIR jsys, connects to TENEX directory DIR (for
AC1.)  PASSWORD is the password, which will usually be null, as
in the EXEC CONNECT command.
⊗

HERE(CNDIR)
	PUSH	P,[0]
	PUSHJ	P,CATCHR		;PUT A NULL ON THE END OF THE PASSWORD
	POP	SP,2			;GET BP IN 2
	SUB	SP,X11			;CLEAN UP SP STACK
	MOVE	1,-1(P)			;DIRECTORY NO 
	SETO	3,			;ASSUME SUCCESS
	SETZM	.SKIP.
	JSYS	CNDIR
	  JRST	[SETZ 3,
		 MOVEM	1,.SKIP.
		 JRST	.+1]
	MOVE	1,3
	SUB	P,X22
	JRST	@2(P)

DSCR BOOLEAN PROCEDURE ASND(INTEGER DEVICE)
	Assigns the device specified by DEVICE using the ASND jsys.
Returns TRUE if successful, else error code in .SKIP.
⊗	

HERE(ASND)
	MOVE	1,-1(P)			;GET DEVICE DESIGNATOR
	JSYS	ASND
	  JRST	[MOVEM 1,.SKIP.
		 SETZ	1,
		 JRST .+2]
	SETO	1,
	SUB	P,X22
	JRST	@2(P)
DSCR BOOLEAN PROCEDURE RELD(INTEGER DEVICE)
	Releases DEVICE using the RELD jsys.  If DEVICE is -1,
then releases all devices assigned to this job.
⊗
	
HERE(RELD)
	MOVE	1,-1(P)
	JSYS	RELD
	  JRST	[MOVEM	1,.SKIP.
		 SETZ	1,
		 JRST	.+2]
	SETO	1,
	SUB	P,X22
	JRST	@2(P)
DSCR INTEGER SIMPLE PROCEDURE GDSTS(INTEGER CHAN; REFERENCE INTEGER WORDCNT)
	Returns the device status of device open on CHAN using the GDSTS
jsys.  The LH of WORDCNT has the word count of the last transfer completed,
negative if the last transfer completed unsuccessful.
⊗

HERE(GDSTS)
	VALCH1	1,<-2(P)>,GDSERR
	SETZM	.SKIP.
	JSYS	GDSTS
	MOVEM	3,@-1(P)			;REFERENCE ARG
	MOVE	1,2				;RETURN VALUE
GDSRET:	SUB	P,X33
	JRST	@3(P)
GDSERR:	ERR <Illegal JFN>,1
	SETOM	.SKIP.	
	SETZ	1,		
	JRST	GDSRET
DSCR PROCEDURE SDSTS(INTEGER JFN,NEWSTATUS)
⊗
HERE(SDSTS)
	VALCH1	1,<-2(P)>,SDSERR
	SETZM	.SKIP.				;INDICATE NO ERROR
	MOVE	2,-1(P)
	JSYS	SDSTS
SDSRET:	SUB	P,X33
	JRST	@3(P)
SDSERR:	ERR	<Illegal JFN>,1
	SETOM	.SKIP.
	JRST	SDSRET
DSCR INTEGER PROCEDURE STDEV(STRING S)
	S is a string pointer to a string of the form DTA1.
The device designator is returned.
⊗

HERE(STDEV)
	PUSH	P,[0]
	PUSHJ	P,CATCHR
	POP	SP,1
	SUB	SP,X11			;CLEAN SP STACK
	SETZM	.SKIP.
	JSYS	STDEV
	  JRST	[PUSHJ	P,SAVE		;GET FRESH ACS
		 MOVEI	1,400000	;THIS FORK
		 JSYS 	GETER		;GET ERROR NUMBER
		 HRRZM	2,.SKIP.	;SAVE IN .SKIP. FOR USER
		 SETZM	RACS+1(USER)	;ZERO RETURN
		 SETZ	LPSA,		;NOTHING TO REMOVE FROM STACK
		 JRST	RESTR		;AND RETURN
		]
	MOVE	1,2
	POPJ	P,


DSCR STRING PROCEDURE DEVST(INTEGER DEVICE)
⊗
HERE(DEVST)
	PUSH	P,[=100]
	PUSHJ	P,ZSETST		;GET A BP FOR 100 CHARS
	SETZM	.SKIP.
	MOVE	2,-1(P)
	JSYS	DEVST
	  MOVEM	2,.SKIP.		;INDICATE ERROR
	PUSH	P,[=100]
	PUSH	P,1			;UPDATED BP
	PUSHJ	P,ZADJST
	SUB	P,X22
	JRST	@2(P)
	
DSCR	SIMPLE PROCEDURE GTFDB(INTEGER JFN; REFERENCE INTEGER ARRAY BUF)

	Entire FDB of JFN is read into BUF.  No bounds checking,
so BUF should be at least '26 words.
⊗
HERE(GTFDB)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCHN	1,<-2(P)>,FDBAD
	MOVSI	2,25		;ALL 25 WORDS
	HRRZ 	3,-1(P)		;ADDRESS OF ARRAY
	JSYS GTFDB
	JRST	RESTR

FDBAD: ERR <Illegal JFN>,1
	JRST	RESTR

HERE(CHFDB)
DSCR
	CHFDB(CHAN,DISPLACEMENT,MASK,CHANGED!BITS)
⊗
	PUSHJ	P,SAVE
	MOVE	LPSA,[XWD 5,5]
	VALCHN	1,-4(P),FDBAD		;GET JFN TO 1
	HRL	1,-3(P)			;DISPLACEMENT TO LEFT HALF OF ONE
	MOVE	2,-2(P)
	MOVE	3,-1(P)
	JSYS	CHFDB
	JRST	RESTR


ENDCOM(DEVINF)

DEFINE WORDROU < WORDIN,ARRYIN,WORDOUT,ARRYOUT,RWDPTR,SWDPTR >
DEFINE CHARROU < CHARIN,SINI,INPUT,REALIN,REALSCAN,INTIN,INTSCAN,CHAROUT,OUT,LINOUT,RCHPTR,SCHPTR >
DEFINE UTILROU < FINIO >

COMPIL(IOROU,<WORDROU,CHARROU,UTILROU>
	,<JFNTBL,CDBTBL,X22,X33,X44,.SKIP.,SAVE,RESTR>
	,<IOROU -- Input and output routines>)	

DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN);
	Reads a word in from the file
⊗
HERE(WORDIN)
	BEGIN WORDIN

	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN	1,-1(P),WERR
	SETZEOF					;INDICATE NO EOF

DOSIMIO:SIMIO	2,TABL,WERR			;SOSGE IOCNT(CDB)
	  JRST	.ADWI
	ILDB	2,IOBP(CDB)	
STOAC2:	MOVEM	2,RACS+A(USER)
	JRST	RESTR

DOBIN:	JSYS	BIN
	JUMPN	2,STOAC2			;CANNOT BE END OF FILE
CHKEOF:	SETZM	RACS+A(USER)			;RETURN 0 IN ANY EVENT
	JSYS	GTSTS
	TESTE	2,1B8				;EOF?
	   JRST	INPEOF				;YES, INDICATE
	JRST	RESTR

TABL:	JRST	DOSETWI				;0 -- SET UP
	JRST	.CISWI				;1 -- XICHAR
	JRST	.COSWI				;2 -- XOCHAR
	SOSGE	IOCNT(CDB)			;3 -- XIWORD
	JRST	.WOSWI				;4 -- XOWORD
	JRST	WERR				;5 -- XCICHAR
	JRST	WERR				;6 -- XCOCHAR
	JRST	DOBIN				;7 -- XCWORD
	REPEAT 4,<JRST WERR>			;10-13

DOSETWI:
	PUSHJ	P,SETWI
	JRST	DOSIMIO


.ADWI:	PUSHJ	P,ADWI
	  JRST	.ADEOF			;END OF FILE
	JRST	DOSIMIO				;START OVER

.ADEOF:	SETZM	RACS+A(USER)			;RETURN 0 WORD
	JRST	INPEOF				;AND INDICATE EOF
WERR:  	ERR	<Dryrot at WORDIN>,1
	SETZM	RACS+A(USER)
	JRST	INPEOF				;INDICATING EOF OR ERROR

.CISWI:	PUSHJ	P,CISWI
	JRST	DOSIMIO

.COSWI:	PUSHJ	P,COSWI
	JRST	DOSIMIO

.WOSWI:	PUSHJ	P,WOSWI
	JRST	DOSIMIO


	BEND WORDIN
HERE(ARRYIN)
	BEGIN ARRYIN

	PUSHJ	P,SAVE
	MOVE	LPSA,X44
 	VALCHN	1,-3(P),WERR
	SETZEOF					;ASSUME OK
DOSIMIO:
	SIMIO	2,TABL,WERR			;MOVE	6,-2(P)
	SKIPGE	2,-1(P)				;EXTENT
	  ERR	<ARRYIN:  Negative word count>
WIN3:	JUMPE	2,RESTR				;NOTHING LEFT TO TRANSFER
	SKIPG	E,IOCNT(CDB)
	  JRST	WIN5
	IBP	IOBP(CDB)			;INCREMENT THE POINTER
	HRL	C,IOBP(CDB)			;SOURCE
	MOVEI	D,(6)				;FOR BLT
	HRR	C,6				;"TO" ADDRESS
	CAIG	B,(E)				;ENOUGH HERE
	  JRST	WIN4
	ADDI	D,-1(E)				;FINISH HERE
	BLT	C,(D)
	SUBM	E,IOCNT(CDB)
	ADDM	E,IOBP(CDB)
	ADD	6,E				;FIX INPUT POINTER
	SUB	B,E				;FIX INPUT COUNT
WIN5:	PUSHJ	P,ADWI				;GET MORE
	  JRST	ISEOF				;END OF FILE -- NO MORE THERE
	JRST	WIN3
WIN4:	ADDI	D,-1(B)				;
	BLT	C,(D)				;LAST BLT
	SUB	E,B				;FIX UP COUNT
	SOJ	B,
	MOVEM	E,IOCNT(CDB)
	ADDM	B,IOBP(CDB)
	JRST	RESTR

TABL:	JRST	DOSETWI				;0 -- SET UP
	JRST	.CISWI				;1 -- XICHAR
	JRST	.COSWI				;2 -- XOCHAR
	MOVE	6,-2(P)				;3 -- XIWORD
	JRST	.WOSWI				;4 -- XOWORD
	JRST	WERR				;5 -- XCICHAR
	JRST	WERR				;6 -- XCOCHAR
	JRST	DOSIN				;7 -- XCWORD
	JRST	WERR				;10 -- XBYTE7
	JRST	WERR				;11 -- XDICHAR
	JRST	WERR				;12 -- XDOCHAR
	JRST	DODUMPI				;13 -- XDARR

ISEOF:	MOVE	TEMP,-1(P)			;NUMBER OF WORDS WANTED
	SUBM	TEMP,B				;INPUT IN RH
WIN2:	HRROM	B,.SKIP.
	SKIPE	ENDFL(CDB)
	  HRROM	B,@ENDFL(CDB)
	JRST	RESTR

.CISWI:	PUSHJ	P,CISWI
	JRST	DOSIMIO

.COSWI:	PUSHJ	P,COSWI
	JRST	DOSIMIO

.WOSWI:	PUSHJ	P,WOSWI
	JRST	DOSIMIO

DOSETWI:
	PUSHJ	P,SETWI
	JRST	DOSIMIO

DOSIN:
	MOVN	3,-1(P)				;WORD COUNT	
	MOVSI	2,444400
	HRR	2,-2(P)				;ADDRESS OF BUFFER
	JSYS	SIN
	JUMPE	3,RESTR				;DID WE GET IT ALL?
SINEOF:	ADD	3,-1(P)				;CALCULATE NO OF WORDS READ
	HRLI	3,-1				;MAKE IT XWD -1,,COUNT
	SKIPE	ENDFL(CDB)			;EOF LOCATION?
	  MOVEM	3,@ENDFL(CDB)			;YES
	MOVEM	3,.SKIP.
	JRST	RESTR				;AND RETURN

DODUMPI:
	MOVN	3,-1(P)
	MOVEI	2,3
	HRL	3,3
	HRR	3,-2(P)				;ADDRESS OF BUFFER
	SUBI	3,1
	SETZ	4,				;END OF DUMP MODE COMMAND LIST
	JSYS	DUMPI				;DO IT
	  JRST	DMPERR
	JRST	RESTR				;ALL OK

DMPERR:	CAIN	1,600220			;EOF?
	  JRST	DUMPEOF				;NO
	ERR	<ARRYIN:  Dump mode error>,1
	MOVEM	1,.SKIP.
	JRST	RESTR

DUMPEOF:
	MOVE	1,DVTYP(CDB)
	CAIE	1,2				;MAGTAPE DEVICE?
	  JRST	INPEOF				;NO JUST INDICATE EOF
	HRRZ	1,JFNTBL(CHNL)	
	SETZ	2,				;MTOPR RESET
	JSYS	MTOPR	
	JRST	INPEOF				;INDICATE EOF AND RETURN

WERR:	ERR	<ARRYIN:  Illegal JFN, byte-size, or mode.>,1
	JRST	INPEOF


	BEND ARRYIN
HERE(WORDOUT)
	BEGIN WORDOUT
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCHN	1,-2(P),WERR
	SETZEOF
DOSIMIO:SIMIO	2,TABL,WERR			;SOSGE IOCNT(CDB)
	  JRST	.ADWO
	MOVE	2,-1(P)
	IDPB	2,IOBP(CDB)
	JRST	RESTR

TABL:	JRST	DOSETWO				;0 -- XNULL
	JRST	.CISWO				;1 -- XICHAR
	JRST	.COSWO				;2 -- XOCHAR
	JRST	.WISWO				;3 -- XIWORD
	SOSGE	IOCNT(CDB)			;4 -- XOWORD
	JRST	WERR				;5 -- XCICHAR
	JRST	WERR				;6 -- XCOCHAR
	JRST	DOBOUT				;7 -- XCWORD
	REPEAT 4,<JRST WERR>			;10-13

.ADWO:	PUSHJ	P,ADWO
	JRST	DOSIMIO

DOSETWO:
	PUSHJ	P,SETWO
	JRST	DOSIMIO

.CISWO:	PUSHJ	P,CISWO
	JRST	DOSIMIO

.COSWO:	PUSHJ	P,COSWO
	JRST	DOSIMIO

.WISWO:	PUSHJ	P,WISWO
	JRST	DOSIMIO

WERR:	ERR	<WORDOUT:  Illegal JFN, byte-size, mode, or combination>,1
	JRST	INPEOF				;AND INDICATE ERROR

DOBOUT:	MOVE	2,-1(P)
	JSYS	BOUT
	JRST	RESTR

	BEND WORDOUT
HERE(ARRYOUT)
	BEGIN ARRYOUT

	PUSHJ	P,SAVE
	MOVE	LPSA,X44
	VALCHN	1,-3(P),WERR
	SKIPN	3,-1(P)
	  JRST	RESTR				;NOTHING TO MOVE
	JUMPGE	3,.+2
	   JRST	WERR
	SETZEOF
DOSIMIO:SIMIO	2,TABL				;MOVE	6-2(P)
	SKIPGE	B,-1(P)
	  ERR	<ARRYOUT:  Word count is negative>,1
WOUT2:	SKIPG	E,IOCNT(CDB)
	  JRST	WOUT5
	JUMPE	B,RESTR				;NOTHING LEFT
	IBP	IOBP(CDB)
	MOVE	C,IOBP(CDB)			;TO ADDR
	HRRZI	D,(C)				;FOR BLT TERMINATION
	HRLI	C,(6)
	CAIGE	B,(E)				;ENOUGHT IN BUFFER
	  JRST	WOUT3				;YES
	ADDI	D,-1(E)				;FINAL ADDRESS
	BLT	C,(D)
	ADDI	6,(E)				;UPDATE BP
	SUBI	B,(E)	
	SETZM	IOCNT(CDB)
	HRRM	D,IOBP(CDB)
WOUT5:	PUSHJ	P,ADWO
	JRST	WOUT2
WOUT3:	JUMPLE	B,RESTR
	SOJ	B,
	ADD	D,B
	BLT	C,(D)
	SUBI	E,1(B)
	MOVEM	E,IOCNT(CDB)
	ADDM	B,IOBP(CDB)
	JRST	RESTR

TABL:	JRST	DOSETWO				;0 -- XNULL
	JRST	.CISWO				;1 -- XICHAR
	JRST	.COSWO				;2 -- XOCHAR
	JRST	.WISWO				;3 -- XIWORD
	MOVE	6,-2(P)				;4 -- XOWORD
	JRST	WERR				;5 -- XCICHAR
	JRST	WERR				;6 -- XCOCHAR
	JRST	DOSOUT				;7 -- XBYTE36
	JRST	WERR				;10 -- XBYTE7
	JRST	WERR				;11 -- XDICHAR
	JRST	WERR				;12 -- XDOCHAR
	JRST	DODUMPO				;13 -- XDARR

DOSETWO:
	PUSHJ	P,SETWO
	JRST	DOSIMIO

.CISWO:	PUSHJ	P,CISWO
	JRST	DOSIMIO

.COSWO:	PUSHJ	P,COSWO
	JRST	DOSIMIO

.WISWO:	PUSHJ	P,WISWO
	JRST	DOSIMIO

DOSOUT:	
	MOVN	3,-1(P)
	MOVSI	2,444400
	HRR	2,-2(P)
	JSYS	SOUT
	JRST	RESTR
	
DODUMPO:
	MOVN	3,-1(P)
	MOVEI	2,3
	HRL	3,3
	HRR	3,-2(P)
	SUBI	3,1
	SETZ	4,
	JSYS	DUMPO
	  JRST	DMPERR
    	SETOM	DMPED(CDB)			
	JRST	RESTR

WERR:	ERR	<ARRYOUT:  Illegal JFN, byte-size, mode, or combination.>,1
	JRST	INPEOF


DMPERR:	ERR	<ARRYOUT:  Dump mode error>,1
	MOVEM	1,.SKIP.			;SAVE TENEX ERROR NUMBER
	JRST	RESTR


	BEND ARRYOUT

HERE(RWDPTR)
	BEGIN RWDPTR

	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN	1,-1(P),WERR
	SETZM	.SKIP.
DOSIMIO:SIMIO	2,TABL,WERR			;PUSHJ P,GETWPT
STOAC2:	MOVEM	2,RACS+A(USER)
	JRST	RESTR

TABL:	JRST	RNULL				;0 -- XNULL
	PUSHJ	P,GETWPT			;1 -- XICHAR
	PUSHJ 	P,GETWPT			;2 -- XOCHAR	
	PUSHJ	P,GETWPT			;3 -- XIWORD
	PUSHJ	P,GETWPT			;4 -- XOWORD
	JRST	WERR				;5 -- XCICHAR
	JRST	WERR				;6 -- XCOCHAR
	JRST	DORFPTR				;7 -- XCWORD
	REPEAT 4,<JRST WERR>			;10-13

DORFPTR:
	JSYS	RFPTR
	   JRST .+2
	JRST	STOAC2
	ERR	<RWDPTR:  Cannot do RFPTR.>,1
	MOVEM	1,.SKIP.
	JRST	RNULL
WERR:	ERR	<RWDPTR:  Illegal JFN, illegal mode or byte size.>,1
	SETOM	.SKIP.

RNULL:	
	PUSHJ	P,SETWIO
	JRST	DOSIMIO				;AND LOOK AGAIN


	BEND RWDPTR
HERE(SWDPTR)
	BEGIN SWDPTR
	
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCHN	1,-2(P),WERR	
	SETZM	.SKIP.
DOSIMIO:MOVE	2,-1(P)				;PICK UP NEW WORD IN 2
	SIMIO	3,TABL,WERR
	JRST	RESTR

TABL:	JRST 	RNULL				;0 -- XNULL
	PUSHJ	P,SETWPT			;1 -- XICHAR
	PUSHJ	P,SETWPT			;2 -- XOCHAR	
	PUSHJ	P,SETWPT			;3 -- XIWORD
	PUSHJ	P,SETWPT			;4 -- XOWORD
	JRST	WERR				;5 -- XCICHAR
	JRST 	WERR				;6 -- XCOCHAR
	JRST	DOSFPTR				;7 -- XCWORD
	REPEAT	4,<JRST	WERR>			;10-13

DOSFPTR:JSYS	SFPTR
	  JRST	SFERR
	JRST	RESTR

SFERR:	ERR	<SWDPTR:  Cannot do SFPTR>,1
	MOVEM	1,.SKIP.
	JRST	RESTR

WERR:	ERR	<SWDPTR:  Illegal JFN, byte size, or mode.>,1
	SETOM	.SKIP.
	JRST	RESTR

RNULL:	PUSHJ	P,SETWIO
	JRST	DOSIMIO

	BEND SWDPTR

DSCR
	Some auxiliary routines, mostly for word i/o.
⊗
INPEOF:
;HERE IF WE HAVE HIT EOF ON INPUT AND WISH TO SIMPLY SAY SO AND RETURN
	SETOEOF
	JRST	RESTR

;ROUTINES TO SET TO WORD OUTPUT
COSWO:	PUSHJ	P,CHCEOF			;CHECK FOR NEW CHARACTER EOF
CISWO:
WISWO:
	PUSHJ	P,GTWPT1
	MOVEM	3,IOBP(CDB)
	MOVEM	4,IOCNT(CDB)
	MOVEI	3,XOWORD
	MOVEM	3,IOSTT(CDB)
	POPJ	P,

;ROUTINES TO SET TO CHARACTER OUTPUT
WOSCO:	PUSHJ	P,CHWEOF			;CHECK FOR NEW WORD EOF
CISCO:
WISCO:
	PUSHJ	P,GTCPT1
	MOVEM	3,IOBP(CDB)
	MOVEM	4,IOCNT(CDB)
	MOVEI	3,XOCHAR
	MOVEM	3,IOSTT(CDB)
	POPJ	P,


;ROUTINES TO SET TO CHARACTER INPUT
WOSCI:	PUSHJ	P,CHWEOF			;CHECK FOR NEW WORD EOF
	JRST	.+2	
COSCI:	PUSHJ	P,CHCEOF			;CHECK FOR NEW CHARACTER EOF
WISCI:	PUSHJ	P,GTCPT1
	MOVEM	3,IOBP(CDB)
	MOVEM	5,IOCNT(CDB)
	MOVEI	3,XICHAR
	MOVEM	3,IOSTT(CDB)
	POPJ	P,

;ROUTINES TO SET TO WORD INPUT
COSWI:	PUSHJ	P,CHCEOF			;CHECK FOR NEW CHARACTER EOF
	JRST	.+2
WOSWI:	PUSHJ	P,CHWEOF			;CHECK FOR NEW WORD EOF
CISWI:	PUSHJ	P,GTWPT1
	MOVEM	3,IOBP(CDB)
	MOVEM	5,IOCNT(CDB)
	MOVEI	3,XIWORD
	MOVEM	3,IOSTT(CDB)
	POPJ	P,


SETWND:
;1, CDB LOADED
;SETS THE FDB SO THAT THE BYTE SIZE IS 36 AND THE NUMBER OF BYTES IS AS IN 2
	PUSH	P,2				;SAVE 
	PUSH	P,3
	MOVEM	2,FDBEOF(CDB)
	HRLI	1,12				;OFFSET FOR
	MOVEM	2,3				;NUMBER OF WORDS
	SETO	2,				;BYTE MASK
	JSYS	CHFDB				;CHANGE THE EOF POINTER
	MOVEI	2,=36
	MOVEM	2,FDBSZ(CDB)
	HRLI	1,11				;OFFSET FOR BYTE SIZE
	MOVSI	2,007700			;MASK
	MOVSI	3,004400			;36 BIT BYTES
	JSYS	CHFDB
	HRLI	1,0				;RESTORE GOOD JFN IN 1
	POP	P,3				;RESTORE
	POP	P,2
	POPJ	P,				;AND RETURN


GETWND:
;HERE WITH 1,CDB LOADED
;RETURN THE WORD THAT ADDRESSES EOF IN 2, ACCORDING TO THE SYSTEM
	BEGIN GETWND
	PUSH	P,3
	SKIPN	3,FDBSZ(CDB)			;IF BYTE SIZE IS ZERO
	  JRST	RET0				;THEN RETURN 0
	CAIN	3,=36				;ALREADY 36?
	  JRST	RET1				;RETURN WHAT WE ALREADY HAVE THERE
;THE BYTE SIZE OF A FILE CAN BE 0 TO =64.  0 IS ALREADY TAKEN CARE OF ABOVE
	CAILE	3,=36	
	  ERR	<GETWND:  File byte size is bigger than 36 bits>,1
	MOVEI	2,=36
	IDIVI	2,(3)				;NUMBER TO MULTIPLY BY -- CLOBBERS 3!!
	MOVEM	2,3
	MOVE	2,FDBEOF(CDB)
	IDIVI	2,(3)				;NUMBER OF WORDS -- CLOBBERS 3!!
	JUMPE	3,.+2				;EXTRA WORDS?
	  AOJ	2,				;YES.
POPBACK:POP	P,3
	POPJ	P,

RET0:	SETZ	2,
	JRST	POPBACK

RET1:	MOVE	2,FDBEOF(CDB)
	JRST	POPBACK

	BEND GETWND

GETWPT:	
;HERE WITH 1,CDB LOADED
;RETURNS IN 2 THE WORD THAT ADDRESSES EOB
	BEGIN GETWPT
	SKIPN	2,IOBP(CDB)
	  POPJ	P,				;WORD ZERO
	PUSH	P,3
	TLZ	2,007700
	TLO	2,004400			;MAKE 36 BIT
	IBP	2
	MOVE	3,IOADDR(CDB)	
	SUBI	3,(2)
	MOVE	2,IOPAGE(CDB)			;CURRENT PAGE
	LSH	2,9				;NUMBER OF WORDS IN PREVIOUS PAGES
	SUB	2,3				;SUBTRACT SINCE 3 IS NEGATIVE
	POP	P,3				;RESULT IN 2
	POPJ	P,

	BEND GETWPT

GTWPT1:
;HERE WITH 1,CHNL,CDB LOADED
;RETURN IN 2 THE WORD THAT ADDRESSES EOB IN 2, ACCORDING TO THE CURRENT POINTER
;RETURN IN 3 THE UPDATED BYTE POINTER
;RETURN IN 4 THE COUNT REMAINING FOR OUTPUT
;RETURN IN 5 THE COUNT REMAINING FOR INPUT
	BEGIN GTWPT1
	SKIPN	3,IOBP(CDB)	
	  JRST	NULRET
	TLZ	3,007700
	TLO	3,004400			;MAKE A 36-BIT BP	
	MOVEM	3,2				;COPY INTO 2
	IBP	2
	MOVE	4,IOADDR(CDB)			;START OF BUFFER
	SUBI	4,(2)				;NUMBER OF WORDS CURRENTLY COMMITTED TO
						;IN THIS BUFFER
	MOVE	2,IOPAGE(CDB)			;WHERE THE CURRENT IO IS
	LSH	2,9
	SUB	2,4				;NUMBER OF WORDS TO ADDRESS EOF
	ADDI	4,1000				;NUMBER OF WORDS REMAINING IN  THIS BUFFER
						;FOR OUTPUT PURPOSES
	MOVEM	2,5				;SAVE CURRENT EOB POINTER
	PUSHJ	P,GETWND			;READ THE END OF FILE IN FDB
 	EXCH	5,2				;EOB POINTER TO 2, EOF TO 5
	SUB	5,2				;SUBTRACT THE CURRENT EOB POINTER
	CAML	5,4				;IF LESS THAN OUTPUT COUNT THEN USE IT ELSE
	  MOVEM	4,5				;USE OUTPUT COUNT
	POPJ	P,

NULRET:	SETZB	2,3				;EVERYTHING ZERO
	SETZB	4,5
	POPJ	P,


	BEND GTWPT1

CHWEOF:
;1,CDB LOADED
;SEES IF A CHANGE OF EOF IS NEEDED, AND DOES IT
	SKIPN	IOBP(CDB)			;ANYTHING THERE?
	  POPJ	P,				;NO, DONT FIDDLE AROUND
	PUSH	P,2
	PUSH	P,3
	PUSHJ	P,GETWND			;GET WORD EOF
	MOVEM	2,3				;SAVE IN 6
	PUSHJ	P,GETWPT			;GET WORD EOB
	CAML	2,3				;IS EOB LESS THAN EOF?
	  PUSHJ	P,SETWND			;BETTER RESET FDB -- ALSO IF TEST IS EQUAL	   
	POP	P,3
	POP	P,2
	POPJ	P,


SETWPT:
	BEGIN SETWPT
;HERE WITH 1,CDB LOADED
;2 HAS THE WORD THAT WE WANT TO SET TO
	MOVE	3,IOSTT(CDB)
	CAIN	3,XOWORD			;DOING WORD OUTPUT?
	  PUSHJ	P,CHWEOF			;YES CHECK
	CAIN	3,XOCHAR			;DOING CHAR OUTPUT?
	  PUSHJ	P,CHCEOF			;CHECK IT ALSO
	CAMN	2,[-1]				;WANT EOF?
	  PUSHJ	P,GETWND			;YES
	PUSH	P,2				;SAVE ON STACK
	LSH	2,-9
	CAME	2,IOPAGE(CDB)			;SAME PAGE?
	  PUSHJ	P,SETPAGE			;NO, SET THE PAGE
	POP	P,2	
	ANDI	2,777				;PICK UP WORD IN PAGE
	MOVE	3,IOADDR(CDB)
	ADDI	3,(2)
	HRLI	3,444400			;MAKE A BYTE POINTER
	MOVEM	3,IOBP(CDB)
	MOVE	3,IOSTT(CDB)			;CHECK THE STATUS AT THE MOMENT	
	CAIE	3,XICHAR			;IF INPUTTING CHARS
	CAIN	3,XIWORD			;OR WORDS
	  JRST	ASSUMIN				;THEN ASSUME WE WILL CONTINUE TO INPUT
	MOVEI	3,XOWORD			;WELL ASSUME OUTPUT
	MOVEM	3,IOSTT(CDB)
FULBU1:	MOVEI	3,1000				;OTHERWISE ASSUME OUTPUT
	SUBI	3,(2)
STOAC3:	MOVEM	3,IOCNT(CDB)
	POPJ	P,
ASSUMIN:
	MOVEI	3,XIWORD
	MOVEM	3,IOSTT(CDB)
	PUSH	P,2				;SAVE THE NUMBER OF WORDS
	PUSHJ	P,GETWND			;GET THE END OF THE FILE IN WORDS IN 2
	IDIVI	2,1000				;PAGES IN 2, WORDS IN 3	
	CAMGE	2,IOPAGE(CDB)			;IS REQUESTED PAGE BEYOND EOF?
	  JRST	EMPBUF				;YES
	CAME	2,IOPAGE(CDB)			;SOMEWHERE ON THIS PAGE?
	  JRST	FULBUF				;NO
	POP	P,2
	SUB	3,2
	JRST	STOAC3

FULBUF:	POP	P,2
	JRST	FULBU1

EMPBUF:	POP	P,2
	SETZ	3,				;SAY EMPTY
	JRST	STOAC3
	BEND SETWPT

SETPAGE:
;1,CDB,CHNL LOADED
;2 HAS THE NUMBER OF THE PAGE WE WANT MAPPED
	PUSH	P,1				;SAVE JFN
	PUSH	P,2
	PUSH	P,3
	MOVEM	2,IOPAGE(CDB)			;PAGE BEING INSERTED
	PUSH	P,1				;SAVE JFN OVER SFPTR
	LSH	2,9				;MAKE INTO WORDS
	JSYS	SFPTR
	  ERR	<SETPAGE:  Cannot do SFPTR>,1
	POP	P,1
	HRL	1,1
	HRR	1,IOPAGE(CDB)			;XWD JFN,FILEPAGE
	HRLZI	3,140000			;BITS 2 AND 3 FOR READ, WRITE -- ASSUME THIS
	MOVE	2,OFL(CDB)			;BUT BETTER CHECK:
	TESTN	2,WRBIT				;IF WRITING OR
	TESTE	2,APPBIT			;APPENDING
	  JRST	.+2				;THEN DONT DO
	TESTO	3,1B9				;THE COPY ON WRITE -- DO IT FOR READING THOUGH
	MOVE	2,FKPAGE(CDB)			;BUFFER IN CORE
	JSYS	PMAP
	POP	P,3
	POP	P,2
	POP	P,1				;RESTORE THE JFN
	POPJ	P,

SETWIO:
;1,CDB LOADED
;DECIDE WHETHER TO SETWI OR SETWO
;CLOBBERS 2,3
	MOVEI	3,SETWI				;ASSUME WORD INPUT
	MOVE	2,OFL(CDB)
	TESTN	2,RDBIT				;DOING INPUT
	  MOVEI	3,SETWO				;NOPE ASSUME OUTPUT
	JRST	(3)				;AND POPJ BACK
ADWI:	
;1,CDB LOADED
;CALL PUSHJ
;RETURN:
;	+1 FOR EOF
;	+2 FOR NORMAL
;ADVANCES WORD INPUT FROM DSK
	BEGIN ADWI

	PUSH	P,2
	PUSH	P,3
	MOVE	3,IOPAGE(CDB)			;CURRENT PAGE
	AOJ	3,				;NEXT PAGE
	LSH	3,9				;WORDS IN THAT PAGE
	PUSHJ	P,GETWND			;END OF FILE POINTER
	CAML	3,2				;BEYOND
	  JRST	ADEOF				;YES SAY SO
	SUB	2,3	
	CAILE	2,1000				;LESS THAN A FULL BUFFER?
	  MOVEI	2,1000				;NO GIVE ENTIRE AMOUNT
	MOVEM	2,IOCNT(CDB)
	AOS	2,IOPAGE(CDB)			;INCREMEMT PAGE, GET IN 2
	PUSHJ	P,SETPAGE	
	MOVE	2,IOADDR(CDB)
	HRLI	2,444400
	MOVEM	2,IOBP(CDB)
ADRET:	AOS	-2(P)
ADEOF:	POP	P,3
	POP	P,2
	POPJ	P,

	BEND ADWI

ADWO:
;1,CDB LOADED
;ADVANCES WORD OUTPUT FROM DSK
	BEGIN ADWO

	PUSH	P,2
	AOS	2,IOPAGE(CDB)			;NEXT PAGE OF THE FILE
	PUSHJ	P,SETPAGE
 	MOVEI	2,1000
	MOVEM	2,IOCNT(CDB)	
	MOVE	2,IOADDR(CDB)	
	HRLI	2,444400
	MOVEM	2,IOBP(CDB)
	POP	P,2
	POPJ	P,

	BEND ADWO
DSCR  CHAR←CHARIN(CHANNEL)
⊗
HERE(CHARIN)
	BEGIN CHARIN

	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	LITCHN	1,-1(P),CHALIT
	SETZEOF
DOSIMIO:	
	SIMIO	E,TABL,CERR			;SOSGE IOCNT(CDB)
	  JRST	.DOINP
	ILDB	2,IOBP(CDB)
STOAC2:	MOVEM	2,RACS+A(USER)
	JRST	RESTR

TABL:	JRST	DOSETCI				;0 -- XNULL
	SOSGE	IOCNT(CDB)			;1 -- XICHAR
	JRST	.COSCI				;2 -- XOCHAR
	JRST	.WISCI				;3 -- XIWORD
	JRST	.WOSCI				;4 -- XOWORD
	SOSGE	IOCNT(CDB)			;5 -- XCICHAR
	REPEAT 2,<JRST CERR>			;6,7 -- XCOCHAR,XCOWORD
	SOSGE	IOCNT(CDB)			;10 -- XBYTE7
	SOSGE	IOCNT(CDB)			;11 -- XDICHAR
	REPEAT 2,<JRST CERR>			;12,13 -- XDOCHAR,XDARR

.DOINP:
	PUSHJ	P,DOINP				;READ NEXT BUFFER
	JRST	DOSIMIO				;BUFFERED INPUT RETURN
	JRST	IND				;CHARACTER IN D--DID A BIN
	JRST	ADCIEOF				;EOF

ADCIEOF:SETZM	RACS+A(USER)			;RETURN 0
	JRST	INPEOF				;AND SAY EOF
DOSETCI:
	PUSHJ	P,SETCI
	JRST	DOSIMIO


.COSCI:	PUSHJ	P,COSCI
	JRST	DOSIMIO

.WISCI:	PUSHJ	P,WISCI
	JRST	DOSIMIO

.WOSCI:	PUSHJ	P,WOSCI
	JRST	DOSIMIO

CERR:	ERR	<CHARIN:  Illegal JFN, byte-size, or mode>,1
	JRST	INPEOF				;INDICATE EOF AND RETURN

CHALIT:	SETZM	.SKIP.
	MOVE	1,-1(P)				;PICK UP JFN LITERALLY
	JSYS	BIN
	JUMPN	2,STOAC2
	SETZM	RACS+A(USER)
	JSYS	GTSTS
	TESTE	2,1B8
	  SETOM	.SKIP.
	JRST	RESTR

IND:	MOVEM	D,2				;PUT IN 2
	JRST	STOAC2				;AND RETURN CHARACTER

	BEND CHARIN
DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR);
	Reads in a string of characters, terminated by BRKCHAR or	
reaching maxlength, whichever happens first.
⊗

HERE(SINI)
	BEGIN	SINI

	PUSHJ	P,SAVE
	MOVE	LPSA,X44
	VALCHN	1,-3(P),CERR
	SETZEOF
DOSIMIO:SKIPG	C,-2(P)
	  JRST	NULRET
	SIMIO	2,TABL,CERR		;EXCH	1,C
	SKIPE	SGLIGN(USER)	
	  PUSHJ	P,INSET
	ADDM	1,REMCHR(USER)		
	SKIPLE	REMCHR(USER)
	  PUSHJ	P,STRNGC
	MOVE	E,TOPBYTE(USER)		;BYTE POINTER TO TOP OF STRING SPACE
	PUSH	SP,[0]
	PUSH	SP,E
	EXCH	1,C			;1 HAS JFN, C HAS COUNT
	MOVN	C,C
IN1:	SOSGE	IOCNT(CDB)
	  JRST	.DOINP
IN2:	ILDB	D,IOBP(CDB)
IND:	JUMPE	D,IN1			;IF EMPTY KEEP LOOKING
	CAMN	D,-1(P)			;BREAK CHAR?
	  JRST	DOBRK			;YES
	IDPB	D,E
IN3:	AOJL	C,IN1			;SUBTRACT 1 AND JUMP IF GREATER

	SETOM	.SKIP.			;INDICATE TERMINATED FOR COUNT
DONE:	ADDM	C,REMCHR(USER)		;MAKE REMCHR HONEST
	MOVEM	E,TOPBYTE(USER)
	ADD	C,-2(P)			;GET ACTUAL NUMBER OF CHARACTERS 
					;TRANSFERRED	
	HRROM	C,-1(SP)		;SAVE COUNT FOR USER
	JRST	RESTR

DOBRK:	IDPB	D,E			;SAVE THE BREAK CHARACTER (AS DOES THE SIN JSYS)
	MOVEM	D,.SKIP.		;SAVE BREAK CHARACTER IN .SKIP. AS DOC. SAYS
	AOJ	C,			;ADD 1 TO THE COUNT
	JRST 	DONE			;AND FINISH UP

CERR:	ERR <SINI:  Illegal JFN, illegal mode or byte size>,1
NULRET:	PUSH	SP,[0]			;RETURN NULL STRING
	PUSH	SP,[0]
	JRST	RESTR
	
TABL:	JRST	DOSETCI			;0 -- XNULL
	EXCH	1,C			;1 -- XICHAR
	JRST	.COSCI			;2 -- XOCHAR
	JRST	.WISCI			;3 -- XIWORD
	JRST	.WOSCI			;4 -- XOWORD		
	EXCH	1,C			;5 -- XCICHAR
	JRST	CERR			;6 -- XCOCHAR
	JRST	CERR			;7 -- XCWORD
	EXCH	1,C			;10 -- XBYTE7
	EXCH	1,C			;11 -- XDICHAR
	REPEAT 2,<JRST CERR>		;12,13 -- XDOCHAR,XDARR

.DOINP:	PUSHJ	P,DOINP			;READ IN THE NEXT BUFFER
	JRST	IN1			;GOT IT
	JRST	IND			;CHARACTER IN D
DOEOF:	SETOEOF				;END OF FILE
	JRST	DONE

DOSETCI:	
	PUSHJ	P,SETCI
	JRST	DOSIMIO

.COSCI:	PUSHJ	P,COSCI
	JRST	DOSIMIO

.WISCI:	PUSHJ	P,WISCI
	JRST	DOSIMIO

.WOSCI:	PUSHJ	P,WOSCI
	JRST	DOSIMIO


	BEND SINI

COMMENT ⊗Input ⊗

DSCR  "STRING"←INPUT(CHANNEL,BREAK TABLE NUMBER);
CAL SAIL
SID NO ACS SAVED BY INPUT!!!!!!
⊗

.IN.:
HERE (INPUT)	
	MOVE	USER,GOGTAB	;GET TABLE POINTER
;;%##% FOR BENEFIT OF ERROR ROUTINE
	MOVE	TEMP,(P)
	MOVEM	TEMP,UUO1(USER)
;;%##%
	MOVEM	RF,RACS+RF(USER);SAVE F-REGISTER
	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	
	VALCHN	1,-2(P),INPBAD	;MOSTLY EXTRA CODE REALLY
INPSIM:
	SIMIO	E,INPTBL,INPBAD	;MOVE X,-1(P)  ; TABLE NUMBER

	MOVEI	TEMP,-1		;ERROR IF BLOCK NOT THERE OR TABLE NOT INIT'ED
	PUSHJ	P,BKTCHK	;CHECK TABLE #
	 JRST	[PUSH	SP,[0]	;ERROR
		PUSH	SP,[0]
		SUB	P,X33
		JRST	@3(P)]
	PUSH	P,CDB		;SAVE POINTER TO CORGET BLOCK
	PUSH	P,CHNL		;SAVE RANGE 1 TO 18

	MOVE	CHNL,-4(P)	;CHANNEL NUMBER -- ALREADY CHECKED
	MOVE	CDB,CDBTBL(CHNL)
	HRRZ	CHNL,JFNTBL(CHNL);ALREADY CHECKED ABOVE
;;;;	LDB	E,[POINT 4,OFL(CDB),9] ;DATA MODE
	SETZEOF
	SKIPE	BRCHAR(CDB)	;BRCHAR LOCATION
	  SETZM	@BRCHAR(CDB)	;ASSUME NO BREAK CHAR
	MOVEI	A,=200		;DEFAULT NO. OF CHARS
	SKIPE	ICOUNT(CDB)	;USER-SPECIFIED COUNT?
	  HRRZ	A,@ICOUNT(CDB)	;MAX COUNT FOR INPUT STRING
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)	;ENOUGH ROOM?
	PUSHJ	P,STRNGC	;NO, TRY TO GET SOME

	POP	P,TEMP
	MOVE	FF,BRKMSK(TEMP)	;BITS FOR THIS TABLE
	POP	P,LPSA		;LPSA POINTS AT CORGET BLOCK FOR BREAK TABLES
	ADD	TEMP,LPSA	;TEMP IS RELOCATED 1 TO 18
	MOVEM	TEMP,-1(P)	;SAVE RELOCATED 1 TO 18 ON STACK
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
	  MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU

	MOVN	B,A		;NEGATE MAX CHAR COUNT
	PUSH	SP,[0]		;LEAVE ROOM FOR FIRST STR WORD
	PUSH	SP,TOPBYTE(USER)	;SECOND STRING WORD
	MOVE	Y,LPSA
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(LPSA)
	JUMPE	B,DONE1		; BECAUSE THE AOJL WON'T

;;%DQ% JFR 8-17-76
	TRNE	FF,@BRKDUM(LPSA);TREAT NUL LIKE ORDINARY CITIZEN?
	TROA	C,1		;YES
	TRZ	C,1		;NO
;;%DQ% ↑
	TRNE	FF,@BRKCVT(LPSA)	;DOING UC COERCION?
	TLOA	C,400000	;YES
	TLZ	C,400000	;NO
	
.IN:	SOSGE	IOCNT(CDB)	;BUFFER EMPTY?
	 JRST	.DOINP
IN1:	
	ILDB	D,IOBP(CDB)	;GET NEXT CHARACTER
    	TDNE	Z,@IOBP(CDB)	;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
	JRST	INLINN		;YES, GO SEE WHAT TO DO
IN2:
INB:
;;%DQ% JFR 8-17-76
	JUMPE	D,[TRNN	C,1	;REALLY IGNORE 0'S ?
		   JRST	.IN	;YES
		   JRST	NOCV.I	];NO-- AND WE KNOW IT'S A 0, SO GET TO THE POINT
;;%DQ% ↑
	CAILE	D,14		;FIRST CHECK
	  JRST	INB1		;IF IN RANGE AT ALL
	CAIN	D,12
	  JRST	INB2
	CAIE	D,14		;LF OR FF?
	  JRST	INB1		;NO
INB2:	SKIPN	LINNUM(CDB)	;COUNTING VIA SETPL FUNCTION??
 	  JRST	INB1		;NO
	TDNN	FF,@Y		;SOMETHING SPECIAL FOR THIS CHARACTER?
	  JRST	INCR		;NO NOTHING SPECIAL
	HLLZ	TEMP,@Y		;GET BITS FOR THIS CHAR
	TDNN	TEMP,FF		;IGNORE?
	  JRST	INCR		;YES
	MOVE	TEMP,-1(P)	;BREAKTABLE (RELOCATED)
	SKIPLE	DSPTBL(TEMP)	;APPEND OR SKIP?
	  JRST	INB1		;YES
INCR:	CAIN	D,12		;LINE-FEED?
	  AOS	@LINNUM(CDB)	;INDICATE ANOTHER LINE
	CAIE	D,14		;FORM-FEED?
	  JRST	INB1		;NO
	SKIPE	PAGNUM(CDB)	
	 AOS	@PAGNUM(CDB)	;COUNT PAGES ALSO
	SKIPE	LINNUM(CDB)
	  SETZM @LINNUM(CDB)	;SET LINNUM TO ZERO (NEW PAGE)

INB1:	JUMPGE	C,NOCV.I	;NOT COERCING?
	CAIL	D,"a"		;ONLY COERCE LOWER CASE
	CAILE	D,"z"		;
	JRST	.+2		;SPECIAL RHT "FAST SKIP"
	TRZ	D,40		;MAKE UPPER CASE

NOCV.I:	TDNE	FF,@Y		;MUST WE DO SOMETHING SPECIAL?
	JRST	INSPC		;YES, HANDLE

MOVEC:	IDPB	D,TOPBYTE(USER)	;LENGTHEN STRING
	AOJL	B,.IN		;GET SOME MORE
	JRST	DONE1

INSPC:	HLLZ	TEMP,@Y		;IGNORE OR BREAK?
	TDNN	TEMP,FF		;  (CHOOSE ONE)
	JRST	.IN		;IGNORE

;  BREAK -- STORE BREAK CHAR, FINISH OFF

DONE:	SKIPE	BRCHAR(CDB)	;USER BRCHAR VAR?
	  MOVEM	D,@BRCHAR(CDB)	;STORE BREAK CHAR
	MOVE	TEMP,-1(P)	;RELOCATED 1 TO 18
	SKIPN	Y,DSPTBL(TEMP)	;WHAT TO DO WITH BREAK CHAR?
	JRST	DONE1		;SKIP IT
	JUMPL	Y,APPEND	;ADD TO END OF INPUT STRING

RETAIN:	PUSHJ	P,BACKUP
	JRST	DONE1

APPEND:	IDPB	D,TOPBYTE(USER)	;PUT ON END
	AOJA	B,DONE1		;ONE MORE TO COUNT


;  DONE -- MARK STRING COUNT WORD

DONE1:	ADDM	B,REMCHR(USER)	;GIVE UP THOSE NOT USED
	SKIPN	ICOUNT(CDB)	;USER SUPPLIED COUNT?
	  JRST	[ADDI B,=200	;USER DEFAULT
		 JRST .+2]
	ADD	B,@ICOUNT(CDB)	;HOW MANY DID WE ACTUALLY GET?
;;#GI# DCS 2-5-72 REMOVE TOPSTR
	HRROM	B,-1(SP)	;MARK RESULT, NON-CONSTANT
;;#GI#
	MOVE	RF,RACS+RF(USER);GET F-REGISTER BACK
	SUB	P,X33		;REMOVE INPUT PARAMETER, RETURN ADDRESS
	JRST	@3(P)		;RETURN

;  CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
;  TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
;  NOT A LINE NUMBER FOR NEXT TIME




.DOINP:	PUSHJ	P,DOINP
	JRST	.IN			;NORMAL BUFFERED RETURN
	JRST	INB			;7-BIT, CHAR IN D
	JRST	DONE1			;EOF OR ERROR

	BEGIN INPTBL

↑INPTBL:JRST	DOSETCI			;0 -- XNULL
	MOVE	X,-1(P)			;1 -- XICHAR
	JRST	.COSCI			;2 -- XOCHAR
	JRST	.WISCI			;3 -- XIWORD
	JRST	.WOSCI			;4 -- XOWORD
	MOVE	X,-1(P)			;5 -- XCICHAR
	REPEAT 2,<JRST INPBAD>		;6,7 
	MOVE	X,-1(P)			;10 -- XBYTE7
	MOVE	X,-1(P)			;11 -- XDICHAR
	REPEAT 2,<JRST INPBAD>		;12,13

DOSETCI:	
	PUSHJ	P,SETCI
	JRST	INPSIM

.COSCI:	PUSHJ	P,COSCI
	JRST	INPSIM

.WISCI:	PUSHJ	P,WISCI
	JRST	INPSIM

.WOSCI:	PUSHJ	P,WOSCI
	JRST	INPSIM


	BEND INPTBL


COMMENT ⊗ BACKUP TO BACKUP JFN ⊗

;CALL TO HERE WITH A PUSHJ, WITH CDB,CHNL LOADED
↑BACKUP:
	PUSH	P,1
	LDB	1,[POINT 6,OFL(CDB),5]	;BYTE-SIZE
	CAIN 	1,44
	  JRST	BACKU1
	SKIPE	TTYINF(CDB)	;CONTROLLING TERMINAL?
	  JRST	BACTTY		;YES
BACBKJ:	HRRZ	1,CHNL		;THE JFN
	JSYS 	BKJFN
	  ERR <BACKUP:  Cannot do BKJFN jsys for RETAIN>,1
BACRET:	POP	P,1
	POPJ	P,
BACKU1:	SOS	IOBP(CDB)
	IBP	IOBP(CDB)
	IBP	IOBP(CDB)
	IBP	IOBP(CDB)
	IBP	IOBP(CDB)
	AOS	IOCNT(CDB)
	JRST	BACRET

BACTTY:	HRRZ	1,TTYINF(CDB)
	CAIN	1,TNXINP			;TENEX DEFAULT
	  JRST	BACBKJ				;YES, USE BKJFN
	CAIE	1,DECLED			;DEC STYLE?
	CAIN	1,TENXED			;OR TENEX?
	  JRST	BACKU1
	ERR	<BACKUP:  Illegal editing mode for controlling terminal>,1
	JRST 	BACKU1

;LINE NUMBER STUFF

INLINN:
NOPGNN:
	SKIPE	SOSNUM(CDB)	;WANT THE NUMBER?
	  JRST 	[MOVE TEMP,@IOBP(CDB)	;SAVE IT FOR THE USER
		 MOVEM TEMP,@SOSNUM(CDB)
		 JRST .+1]
	MOVE	TEMP,-1(P)	;RELOCATED TABLE
	SKIPGE	TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
	 JRST	 GIVLIN	; WANTS IT NEXT TIME OR SOMETHING

	JSP	TEMP,EATLIN	;TOSS IT OUT, AND 
	JRST	.IN		; CONTINUE

EATLIN:
	AOS	IOBP(CDB)	;FORGET IT ENTIRELY
	MOVNI	A,5		;INDICATE SKIPPING SIX
	ADDB	A,IOCNT(CDB)	;IN COUNT
	JUMPGE	A,(TEMP)	;OVERFLOW BUFFER??
	PUSHJ	P,DOINP
	JRST	OKLN		;36-BIT RETURN
	ERR	<INPUT:  7-BIT BYTES CANNOT HAVE LINE NUMBERS>
	JRST	DONE1		;END-OF-FILE
OKLN:	
	IBP	IOBP(CDB)	;GET OVER TAB FINALLY
	SOS	IOCNT(CDB)	;IS THIS RIGHT -- RLS 12/74
	JRST	(TEMP)		;AND CONTINUE


GIVLIN:	TRNE	TEMP,-1		;WANT LINE NO IN BRCHAR WORD?
	 JRST	 GVLLN		;NO, WANTS IT NEXT TIME.
	SKIPL	TEMP,@IOBP(CDB)	;NEGATED LINE NO
	MOVNS	TEMP
	SKIPE	BRCHAR(CDB)	;USER LOCATION?
	MOVEM	TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
	JSP	TEMP,EATLIN	;GO EAT UP LINE NUMBER AND
	JRST	DONE1		;FINISH UP
GVLLN:
	SKIPE	BRCHAR(CDB)
	  SETOM	@BRCHAR(CDB)	;TELL THE USER
	AOS	IOCNT(CDB)	;REVERSE THE SOSLE
	MOVE	Y,OFL(CDB)	;NOW CHECK TO SEE IF WE CAN DO THIS WITHOUT DISASTER
	TESTN	Y,WRBIT		;WRITING?
	TESTE	Y,APPBIT	;OR APPENDING?
	  ERR	<INPUT:  Give line feature not implemented when reading and writing.
Continuation will cause the line number to be modified.>
	MOVEI	Y,1		;TURN OFF LINE NUMBER 
	ANDCAM	Y,@IOBP(CDB)	;  BIT
	MOVSI	Y,070000	;BACK UP BYTE POINTER
	ADDM	Y,IOBP(CDB)
	JRST	DONE1		;FINISH OFF IN BAZE OF GORY

INPBAD:	ERR <INPUT:  Illegal JFN or bad input>

COMMENT ⊗Realin, Realscan ⊗

DSCR REAL←REALIN(CHANNEL NUMBER);
CAL SAIL
⊗

HERE (REALIN)
IFN ALWAYS,<BEGIN NUMIN>

	PUSHJ P,SAVE
	PUSHJ P,NUMIN;		GET NUMBER IN A AND TEN EXPONENT IN C
	MOVE LPSA,X22
	JRST REALFN

DSCR REAL←REALSCAN(@"STRING");
CAL SAIL
⊗

HERE (REALSCAN)
	PUSHJ P,SAVE
	PUSHJ P,STRIN
	MOVE LPSA,X33
REALFN:	SETZ D,;		POS SIGN
	JUMPE A,ADON
	JUMPG A,FPOS
	SETO D,;		NUMBER NEGATIVE
	MOVNS A
FPOS:	;WE NOW HAVE A POSITIVE NUMBER IN A WITH SIGN IN D
	JFFO A,.+1;		NUMBER OF LEADING ZEROS IN B
	ASH A,-1(B);		BIT0=0, BIT1=1
	MOVN X,B;		BIN EXPONENT -2
	JUMPE C,FLO;		IF TEN EXPONENT ZERO THEN FINISH
	JUMPL C,FNEG
	CAIL C,100;		CHECK BOUND OF EXPOENT
	JRST ERROV1
	SETZ Y,
	JRST TEST
FNEG:	MOVNS C
	CAIL C,100
	JRST ERROV1
	MOVEI Y,6
TEST:	TRNE C,1;		DEPENDING ON LOW ORDER BIT OF EXP
	JRST MULT;		EITHER MULTIPLY 
NEXT:	ASH C,-1;		OR DON'T.
	AOJA Y,TEST;		INDEX INTO MULTIPLIER TABLE
MULT:	ADD X,.CH.(Y);		EXPONENT
	MUL A,.MT.(Y)		;MULTIPLY AND NORMALIZE
	TLNE A,200000
	 JRST DTEST
	ASHC A,1
	SOJA X,.+1
DTEST:	SOJG C,NEXT
FLO:	IDIVI A,1B18
	FSC A,255
	FSC B,234
	FADR A,B
	SKIPE D
	MOVNS A
	FSC A,(X);		SCALE
	JRST ALLDON
	SUBTTL	INTIN	INTEGER NUMBER INPUT ROUTINE	LOU PAUL
COMMENT ⊗Intin, Intscan ⊗

DSCR INTEGER←INTIN(CHANNEL NUMBER);
CAL SAIL
⊗

HERE (INTIN)
	;INTEGER NUMBER INPUT ROUTINE RETURNS VALUE IN A
	;USES NUMIN TO PERFORM FREE FIELD SCAN

	PUSHJ P,SAVE
	PUSHJ P,NUMIN;		GET NUMBER IN A, TEN EXPONENT IN C
	MOVE LPSA,X22
	JRST INTFN

DSCR INTEGER←INTSCAN("STRING");
CAL SAIL
⊗

HERE (INTSCAN)
	PUSHJ P,SAVE
	PUSHJ P,STRIN
	MOVE LPSA,X33
INTFN:	JUMPE A,ADON
	JUMPE C,ADON
	JUMPL C,DIVOUT;		IF EXPONENT NEG WE WILL DIVIDE
	CAIL C,13
	JRST ERROV1
	IMUL A,.TEN.(C)
	JRST ALLDON
DIVOUT:	MOVNS C
	CAIL C,13
	JRST [SETZ A,
		JRST ADON ]
	MOVE C,.TEN.(C)
	IDIV A,C
	ASH C,-1
	CAML B,C;		ROUND POSITIVELY
	AOJA A,ALLDON
	MOVNS B
	CAML B,C
	SOJ A,
ALLDON:	JOV ERROV1;		CHECK FOR OVERFLOW
ADON:	MOVEM A,RACS+1(USER)
	JRST RESTR
ERROV1:	PUSHJ P,ERROV
	JRST ADON
	SUBTTL	FREE FIELD NUMBER SCANNER		LOU PAUL
DSCR NUMIN
DES THE COMMON ROUTINE USED BY REALIN, REALSCAN, INTIN, ETC.
⊗
	;NUMIN PERFORMS A FREE FIELD READ AND RETURNS THE MOST SIGNIFICIANT
	;PART OF THE NUMBER IN A AND THE APPROPIATE TENS EXPONENT IN C
	;TAKING CARE OF LEADING ZEROS AND TRUNCATION ETC.
	;SCANNING IS ACCORDING TO THE FOLLOWING BNF
	;<NUMBER>::=<DEL><SIGN><NUM><DEL>
	;<NUM>	::=<NO>|<NO><EXP>|<EXP>
	;<NO>	::=<INTEGER>|<INTEGER>.|
	;	   <INTEGER>.<INTEGER>|.<INTEGER>
	;<INTEGER>::=<DIGIT>|<INTEGER><DIGIT>
	;<EXP>	::=E<SIGN><INTEGER>|@<SIGN><INTEGER>
	;<DIGIT>::=0|1|2|3|4|5|6|7|8|9
	;<SIGN>	::=+|-|<EMPTY>
	;NULL AND CARR. RET. ARE IGNORED.
	;SCANNING IS FACILITATED BY A CHARACTER CLASS TABLE "TAB" AND
	;TWO MACROS AHEAD AND ASTERN. THE LEFT HALF OF THE 200+1 WORD TABLE
	;CONTAINS -1 IF NOT A DIGIT AND THE VALUE OF THE DIGIT IF IT IS A DIGIT
	;THE RIGHT HALF CONTAINS -1 IF A DIGIT AND THE CLASS NUMBER IF NOT.
	;CLASS 0	NULL, CARR RET, NOTHING
	;CLASS 1	.
	;CLASS 2	-
	;CLASS 3	+
	;CLASS 4	@,E
	;CLASS 5	ANY OTHER CHARACETR
	;CLASS 6 	END OF FILE
	;TAB(200) IS USED FOR FND OF FILE
	;MACRO AHEAD IS USED FOR FORWARD SCANNING, ASTERN FOR SCANNING
	;THE STACK CONSISTING OF AC Y WHICH HAS CLASS SYMBOLS SHIFTED INTO IT.
	DEFINE AHEAD(DIG,POINT,MINUS,PLUS,E,CHA,EOF)<
	HRRE X,TAB(D)
	JRST @.+2(X)
	JUMP DIG
	JRST .-4
	JUMP POINT
	JUMP MINUS
	JUMP PLUS
	JUMP E
	JUMP CHA
	JUMP EOF>

	DEFINE ASTERN(NULL,POINT,MINUS,PLUS,E,CHA)<
	SETZ X,
	LSHC X,3
	JRST @.+1(X)
	JUMP NULL
	JUMP POINT
	JUMP MINUS
	JUMP PLUS
	JUMP E
	JUMP CHA
	JUMP CHA>
;NUMIN -- CONTD.

NUMIN:
?NUMSIM:
	VALCHN	1,-2(P),NUMBAD		;1,CDB, CHNL LOADED
	SIMIO	Z,NUMTBL,NUMBAD		;MOVE	CHNL,1	;JFN TO 1
	SKIPE	ENDFL(CDB)
	  SETZM	@ENDFL(CDB)
	SETZM	.SKIP.
	SKIPE	BRCHAR(CDB)
	  SETZM	@BRCHAR(CDB)

	MOVE LPSA,[JSP X,NCH]
	MOVEI	Z,1			;FOR LINE NUMBER TEST
	PUSHJ P,SCAN
	SKIPE	BRCHAR(CDB)		;USER WANTS BREAK CHARACTER?
	  MOVEM D,@BRCHAR(CDB)		;FIX UP BREAK CHARACTER
	SOS	IOBP(CDB)		;BACK UP TO GET IT NEXT TIME
	FOR II←1,4 <
	IBP	IOBP(CDB)>
	AOS	IOCNT(CDB)
	POPJ P,

; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
NCH:	SOSGE IOCNT(CDB);	DECREMENT CHARACTER COUNT
	  JRST	NUMINP

NCH1:	ILDB D,IOBP(CDB);	LOAD BYTE
	TDNE Z,@IOBP(CDB);	CHECK FOR LINE NUMBER
	JRST NCH5
NCH1.1:	SKIPN	LINNUM(CDB)	;WANT SETPL THINGS?
	   JRST	(X)		;NO RETURN
	CAIN	D,12		;LINE FEED?
	   AOS	@LINNUM(CDB)	;YES
	CAIE	D,14		;FORM FEED?
	   JRST	(X)		;NOPE, NOTHING
	SKIPE	PAGNUM(CDB)
	   AOS	@PAGNUM(CDB)	;INCREMENT PAGE COUNTER
	SKIPE	LINNUM(CDB)
	  SETZM	@LINNUM(CDB)	;AND ZERO LINE COUNTER
	JRST (X);		RETURN

NCH7:	MOVEI D,200		;EOF OR DATA ERROR.
	JRST (X)

NCH5:	SKIPE	SOSNUM(CDB)	;WANT SETPL STUFF?
	  JRST	[MOVE	D,@IOBP(CDB)
		 MOVEM	D,@SOSNUM(CDB)	;INFORM USER ABOUT LINE NUMBER
		 JRST	.+1]
	AOS IOBP(CDB);		WE HAVE A LINE NUMBER
	MOVNI D,5;		MOVE OVER IT
	ADDB D,IOCNT(CDB)
	SKIPL	 D		;NOTHING LEFT?
	  JRST NCH		;DO ANOTHER INPUT
	PUSHJ	P,DOINP		;
	  JRST	NCH6		;36-BIT RETURN -- MUST BE
	  PUSHJ	P,NUMBAD	;IMPOSSIBLE
	  JRST	NCH7		;EOF OR SOME SUCH

NCH6:	SOSGE IOCNT(CDB);	REMOVE TAB
	JRST NCH7		;NONE THERE OR ERROR
	IBP IOBP(CDB)
	JRST NCH

;SETUP FOR STRING INPUT (REALSCAN, INTSCAN)
STRIN:	MOVE LPSA,[JSP X,NCHA]
	HRRZ Z,-3(P)
	HRRZ Z,-1(Z)
	HRRZS -3(P)		;SO CAN INDIRECT THROUGH IT.
	PUSHJ P,SCAN
	HRRZ X,-3(P)
	SOS (X)			;BACK UP BYTE POINTER
	FOR II←1,4<
	IBP (X)>
	AOJ Z,
	HRRM Z,-1(X)
	MOVEM D,@-2(P)		;STORE BREAK CHARACTER
	POPJ P,

;READ A CHARACTER ROUTINE FOR STRINGS.
NCHA:	SOJL Z,NCH7
	ILDB D,@-4(P)
	JRST (X)

;SCAN (CALLED BY NUMIN AND STRIN)

SCAN:	JOV .+1
	SETO TEMP,		;FLAG REGISTER.
	SETZ	Y,
	SETZB A,C;		NUMBER		EXPOENT
MORE:	XCT LPSA;		THIS GETS A CHARACTER IN D,200 IF FO EOF
	AHEAD(DIG1,STACK,STACK,STACK,STACK,STACK,DONE)
STACK:	LSHC X,-3;		PUSH SYMBOL ONTO STACK "AC Y"
	JRST MORE

DIG1:	SETZ TEMP,;		FLAG REG.
	ASTERN(INT1,FRA1,SIG1,SIG2,EXP1,INT1)

SIG1:	TRO TEMP,4;		NEGATIVE SIGN
SIG2:	ASTERN(INT1,ERR2,ERR5,ERR5,EXP1,INT1)

EXP1:	MOVEI A,1
	ASTERN(EXP2,ERR2,SIG3,SIG4,ERR1,EXP2)

SIG3:	MOVNS A
SIG4:	ASTERN(EXP2,ERR2,ERR5,ERR5,ERR1,EXP2)

FRA1:	TRO TEMP,1;		DECIMAL POINT
	SOJ C,
	ASTERN(INT1,ERR2,SIG5,SIG6,ERR1,INT1)

SIG5:	TRO TEMP,4;		NEGATIVE SIGN
SIG6:	ASTERN(INT1,ERR2,ERR5,ERR5,ERR1,INT1)

EXP2:	HLRE FF,TAB(D);		FIRST DIGIT
EXP5:	XCT LPSA;		GET NEXT CHARACTER
EXP9:	HLRE B,TAB(D)
	JUMPL B,EEXP;		NEGATIVE IF NOT A DIGIT
	IMULI FF,12
	ADD FF,B
	JRST EXP5

	XCT LPSA
;;#QD# SEE DONE5: BELOW
EEXP:	AHEAD(EXP9,ERR2,DONE5,DONE5,ERR1,EN,EN)
EN:	TRNE TEMP,4;		SIGN OF EXPONENT
	MOVNS FF
	ADD C,FF;		FIX UP EXPONENT
	JOV ERR3

;#QD# CHANGE ALL 'ERR5'S IN AHEAD MACROS DO 'DONE5'S, TO AVOID SNARFING EXTRA
;SIGNS ..... RFS 12-15-73 (TWO PLACES BELOW AND ONE ABOVE ALSO)
DONE5:
DONE:	ANDI D,177
	JUMPGE TEMP,.+2
	SETO D,
	POPJ P,

INT1:	HLRE A,TAB(D);		FIRST DIGIT
	TRNE TEMP,4
	MOVNS A;		NEGATE IF NECESSARY
INT2:	XCT LPSA;		GET NEXT CHARACTER
INT5:	HLRE B,TAB(D)
	JUMPL B,EON;		NEGATIVE IF NOT A NUMBER
	TRNE TEMP,1;		IF PASSED DECIMAL POINT THEN DEC EXP BY ONE
	SOJ C,
	TRNE TEMP,2;		IF ENOUGH DIGITS THEN INC EXP BY ONE
INT3:	AOJA C,INT2
	MOVE X,A
	IMULI A,12
	TRNE TEMP,4;		NEGATE DIGIT IS SIGN NEGATIVE
	MOVNS B
	ADD A,B
	JOV INT4;		CHECK FOR OVERFLOW
	JRST INT2;		IF SO USE LAST VALUE

INT4:	TRO TEMP,2
	MOVE A,X
	JRST INT3

	XCT LPSA
EON:	AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)

DP1:	TROE TEMP,1
	JRST ERR2
	XCT LPSA
;#QD# (SEE DONE5: ABOVE)
	AHEAD(INT5,ERR2,DONE5,DONE5,EXP6,DONE,DONE)

EXP6:	SETZ TEMP,
	XCT LPSA
	AHEAD(EXP2,ERR2,EXP7,EXP8,ERR1,ERR1,ERR1)

EXP7:	TRO TEMP,4
EXP8:	XCT LPSA
;#QD# (SEE DONE5: ABOVE)
	AHEAD(EXP2,ERR2,DONE5,DONE5,ERR1,ERR1,ERR1)

ERR1:	ERR(<NUMIN: IMPROPER EXPONENT>,1,RZ)

ERR2:	ERR(<NUMIN: MISPLACED DECIMAL POINT>,1,RZ)

ERR3:	ERR(<NUMIN: EXPONENT OUT OF BOUND>,1,RZ)

ERR5:	ERR(<NUMIN: MISPLACED SIGN>,1,RZ)

ERROV:	ERR(<NUMIN: NUMBER OUT OF BOUND>,1,RZ)

NUMBAD: ERR<NUMIN:  Illegal JFN, byte-size or mode>
	POPJ	P,


	BEGIN NUMTBL

↑NUMTBL:JRST	DOSETCI				;0 -- XNULL
	MOVE    CHNL,1				;1 -- XICHAR
	JRST	.COSCI				;2 -- XOCHAR
	JRST	.WISCI				;3 -- XIWORD
	JRST	.WOSCI				;4 -- XOWORD
	MOVE	CHNL,1				;5 -- XCICHAR
	REPEAT 2,<JRST	NUMBAD>			;6,7
	MOVE	CHNL,1				;10 -- XBYTE7
	MOVE	CHNL,1				;11 -- XDICHAR
	REPEAT 2,<JRST NUMBAD>			;12,13

DOSETCI:
	PUSHJ	P,SETCI
	JRST	NUMSIM
	
.COSCI:	PUSHJ	P,COSCI
	JRST	NUMSIM

.WISCI:	PUSHJ	P,WISCI
	JRST	NUMSIM

.WOSCI:	PUSHJ	P,WOSCI
	JRST	NUMSIM

	BEND NUMTBL

NUMINP:	PUSHJ	P,DOINP
	JRST	NCH				;BUFFERED INPUT
	JRST	NCH1.1				;7-BIT
	JRST	NCH7				;EOF OR ERROR


RZ:	SETZ A,
	JRST DONE
;   Character table for SCAN (Realscan,Intscan,Realin,Intin)
TAB:	FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
;#QC# MAKE 32 (CONTROL Z) IGNORED
	FOR A IN (5,5,0,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
>
	FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
>
	FOR A IN (5,5,5,5,5,5)<XWD -1,A
>
;;%DY% ! GJA/JFR 1-13-77 MAKE "E" EQUIVALENT TO "@"
	FOR A IN (4,5,5,5,5,4,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	XWD -1,6

ENDCOM(NUM)
COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)
DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
⊗

↑↑.CH.:	4
	7
	16
	33
	66
	153
	777777777775
	777777777772
	777777777763
	777777777746
	777777777713
	777777777626
↑↑.MT.:	240000000000
	310000000000
	234200000000
	276570200000
	216067446770
	235613266501
	314631463147
	243656050754
	321556135310
	253630734215
	346453122767
	317542172553
↑↑.TEN.:	1
	=10
	=100
	=1000
	=10000
	=100000
	=1000000
	=10000000
	=100000000
	=1000000000
	=10000000000

ENDCOM(TBB)
IFN ALWAYS,<
	BEND
>;IFN ALWAYS

DSCR SIMPLE PROCEDURE CHAROUT(INTEGER JFN, CHAR)
⊗
HERE(CHAROUT)
	BEGIN CHAROUT
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	LITCHN	1,-2(P),CHOLIT
DOSIMIO:SIMIO	3,TABL,CERR		;SOSGE IOCNT(CDB)
	  PUSHJ	P,ADCO1
	MOVE	2,-1(P)
	IDPB	2,IOBP(CDB)
	JRST	RESTR

TABL:	JRST	DOSETCO			;0 -- XNULL
	JRST	.CISCO			;1 -- XICHAR
	SOSGE	IOCNT(CDB)		;2 -- XOCHAR
	JRST	.WISCO			;3 -- XIWORD
	JRST	.WOSCO			;4 -- XOWORD
	JRST	CERR			;5 -- XCICHAR
	SOSGE	IOCNT(CDB)		;6 -- XCOCHAR
	JRST	CERR			;7 -- XCWORD
	JRST	DOBOUT			;10 -- XBYTE7
	JRST	CERR			;11 -- XDICHAR
	SOSGE	IOCNT(CDB)		;12 -- XDOCHAR
	JRST	CERR			;13 -- XDARR

DOSETCO:	
	PUSHJ	P,SETCO
	JRST	DOSIMIO

.CISCO:	PUSHJ	P,CISCO
	JRST	DOSIMIO

.WISCO:	PUSHJ	P,WISCO
	JRST	DOSIMIO

.WOSCO:	PUSHJ	P,WOSCO
	JRST	DOSIMIO

CERR:	ERR <CHAROUT:  Illegal JFN, byte-size, or mode.>,1
	JRST	RESTR

CHOLIT:
DOBOUT:	MOVE	2,-1(P)
	JSYS	BOUT
	JRST	RESTR

	BEND CHAROUT

DSCR SIMPLE PROCEDURE OUT(INTEGER JFN; STRING S)
⊗
HERE(OUT)
	BEGIN OUT
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	LITCHN	1,-1(P),CHKTTY
DOSIMIO:SIMIO	2,TABL,CERR	;HRRZ 3,-1(SP)
	JUMPE	3,SOURET	;DONT SEND EMPTY STRING
LOOP:	SOSGE	IOCNT(CDB)	;DECREMENT BUFFER COUNT
	  PUSHJ	P,ADCO1		;GET NEW BUFFER
	ILDB	2,(SP)		;NEXT CHAR ON STRING
	IDPB	2,IOBP(CDB)	;AND COPY THE CHARACTER
	SOJG	3,LOOP		;STRING CHAR COUNT

SOURET:	SUB	SP,X22		;ADJUST STRING STACK
	JRST	RESTR

DOSOUT:	
	SKIPE	CTLOSW		;IF CONTROL-O AND
	SKIPN	TTYINF(CDB)	;THE CONTROLLING TERMINAL
	  JRST 	.+2
	 JRST	SOURET		;THEN DONT DO OUTPUT
REPEAT 0,<;BUGS IN SOUT JSYS -- ARE THEY STILL THERE??
DOSOU1:	HRRZ	3,-1(SP)
	JUMPE	3,SOURET
SOUT1:	ILDB	2,(SP)		;NEXT CHAR
	JSYS	BOUT
	SOJG	3,SOUT1		;STRING CHAR COUNT
	JRST	SOURET
>;REPEAT 0
DOSOU1:	
	HRRZ	3,-1(SP)	;COUNT
	JUMPE	3,SOURET	;DONT SEND NULL STRING
	MOVE	2,(SP)		;STRING BP
	MOVN	3,3		;NEGATIVE COUNT
	JSYS	SOUT		;STRING OUTPUT
	JRST	SOURET		;AND RETURN
	
CERR:	ERR <OUT:  Illegal JFN, byte-size, or mode>,1
	JRST 	SOURET

TABL:	JRST	DOSETCO		;0 -- XNULL
	JRST	.CISCO		;1 -- XICHAR	
	HRRZ 3,-1(SP)		;2 -- XOCHAR
	JRST	.WISCO		;3 -- XIWORD
	JRST	.WOSCO		;4 -- XOWORD
	JRST	CERR		;5 -- XCICHAR
	HRRZ 3,-1(SP)		;6 -- XCOCHAR
	JRST	CERR		;7 -- XCWORD	
	JRST	DOSOUT		;10 -- XBYTE7
	JRST	CERR		;11 -- XDICHAR
	HRRZ 3,-1(SP)		;12 -- XDOCHAR
	JRST	CERR		;13 -- XDARR

DOSETCO:	
	PUSHJ	P,SETCO
	JRST	DOSIMIO

.CISCO:	PUSHJ	P,CISCO
	JRST	DOSIMIO

.WISCO:	PUSHJ	P,WISCO
	JRST	DOSIMIO

.WOSCO:	PUSHJ	P,WOSCO
	JRST	DOSIMIO

CHKTTY:
	SKIPN	CTLOSW				;CONTROL-O SWITCH ON?
	  JRST	DOSOU1				;NO
	CAIE	1,100				;CONTROLLING TERMINAL?
	CAIN	1,101
	  JRST	SOURET				;YES, RETURN
	JRST	DOSOU1				;NO, JUST DO IT


	BEND OUT

DSCR	PROCEDURE LINOUT(INTEGER JFN,VALUE)
⊗

HERE(LINOUT)
	BEGIN LINOUT

	PUSHJ	P,SAVE
	VALCHN	A,-2(P),LINBAD
DOSIMIO:SIMIO	B,TABL,LINBAD	;SKIPG	B,IOCNT(CDB)
	   PUSHJ P,ADCO		;NO, SEND (OR PERHAPS JUST INITIALIZE)
	MOVE	TEMP,IOBP(CDB)	;GET BP

LINOPL:	TLNN	TEMP,760000	;LINED BP?
	   JRST	OKLIGN
	IBP	TEMP
	SOJA	B,LINOPL	

OKLIGN:	MOVEM	TEMP,IOBP(CDB)
	MOVEM	B,IOCNT(CDB)
	CAIGE	B,=10		;ENOUGH FOR 10 CHARS?
	  PUSHJ	P,ADCO		;NO
	SKIPGE	B,-1(P)		;GET LINE-NO
	  JRST	[MOVNS B
		 MOVNI A,5
		 JRST	NOCONV]
	MOVNI	A,6
	MOVE	C,[<ASCII /00000/>/2]	
	EXCH	B,C
	PUSH	P,LNBAK
LNCONV:	IDIVI 	C,=10
	IORI	D,"0"
	DPB	D,[POINT 7,(P),6]
	SKIPE	C
	PUSHJ	P,LNCONV	;THE RECURSIVE PRINTER
	HLL	C,(P)
	LSHC	B,7
LNBAK:	POPJ	P,.+1
	LSH	B,1
	TRO	B,1
NOCONV:	AOS	C,IOBP(CDB)	;MOVE A WORD OUT
	MOVEM	B,(C)
	ADDM	A,IOCNT(CDB)
	MOVEI	B,11
	CAME	A,[-5]
	  IDPB	B,IOBP(CDB)	;OUTPUT A TAB
NOTAB:	MOVE	LPSA,X33
	JRST	RESTR

LINBAD:	ERR <LINOUT:  Illegal JFN, byte-size, or mode>,1
	JRST	NOTAB

TABL:	JRST	DOSETCO				;0 -- XNULL
	JRST	.CISCO				;1 -- XICHAR
	SKIPG	B,IOCNT(CDB)			;2 -- XOCHAR
	JRST	.WISCO				;3 -- XIWORD
	JRST	.WOSCO				;4 -- XOWORD
	JRST	LINBAD				;5 -- XCIWORD
	SKIPG	B,IOCNT(CDB)			;6 -- XCOWORD
	JRST	LINBAD				;7 -- XCWORD
	JRST	LINBAD				;10 -- XBYTE7
	JRST	LINBAD				;11 -- XDICHAR
	SKIPG	B,IOCNT(CDB)			;12 -- XDOCHAR
	JRST	LINBAD				;13 -- XDARR

DOSETCO:
	PUSHJ	P,SETCO
	JRST	DOSIMIO

.CISCO:	PUSHJ	P,CISCO
	JRST	DOSIMIO

.WISCO:	PUSHJ	P,WISCO
	JRST	DOSIMIO

.WOSCO:	PUSHJ	P,WOSCO
	JRST	DOSIMIO


	BEND LINOUT

HERE(RCHPTR)
	BEGIN RCHPTR
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN	1,-1(P),CERR
	SETZM	.SKIP.
DOSIMIO:SIMIO	2,TABL,CERR
STOAC2:	MOVEM	2,RACS+A(USER)
	JRST	RESTR

TABL:	JRST	RNULL				;0 -- XNULL
	REPEAT 	4,<PUSHJ P,GETCPT>		;1-4
	REPEAT  3,<JRST CERR>			;5-7
	JRST	DORFPTR				;10 -- XBYTE7
	REPEAT	3,<JRST CERR>

DORFPTR:
	JSYS	RFPTR
	  JRST	.+2
	JRST	STOAC2
;HERE WITH AN ERROR FROM RFPTR
	MOVEM	1,.SKIP.
	JRST	RNULL

CERR:	ERR	<RCHPTR:  Illegal jfn, mode, or byte size>,1
	SETOM	.SKIP.
	SETZM	RACS+A(USER)
	JRST	RESTR

RNULL:
	PUSHJ	P,SETCIO
	JRST	DOSIMIO
	
	BEND RCHPTR
HERE(SCHPTR)
	BEGIN SCHPTR
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCHN	1,-2(P),CERR
	SETZM	.SKIP.
DOSIMIO:MOVE	2,-1(P)				;POINTER
	SIMIO	3,TABL,CERR
	JRST	RESTR

TABL:	JRST	RNULL				;0 -- XNULL .  Remember arg in 2
	PUSHJ	P,SETCPT			;1 -- XICHAR
	PUSHJ	P,SETCPT			;2 -- XOCHAR
	PUSHJ	P,SETCPT			;3 -- XIWORD
	PUSHJ	P,SETCPT			;4 -- XOWORD
	REPEAT 	3,<JRST CERR>			;5-7
	JRST	DOSFPTR				;10 -- XBYTE7
	REPEAT	3,<JRST CERR>			;11-13

RNULL:
	PUSHJ	P,SETCIO
	JRST	DOSIMIO				;BUT GET ARGUMENT AGAIN

DOSFPTR:
	JSYS	SFPTR
	  JRST	.+2				;ERROR IN 1
	JRST	RESTR
	MOVEM	1,.SKIP.
	ERR	<SCHPTR:  Cannot do SFPTR>,1
	JRST	RESTR

CERR:	ERR	<Dryrout at SCHPTR>,1
	SETOM	.SKIP.
	JRST	RESTR


	BEND SCHPTR
DSCR	Auxiliary routines for character i/o.
⊗

SETCND:	
;sets the FDB so tht the byte size is 7 and the number of bytes is as in 2
;1, CHNL, CDB loaded
;call is PUSHJ 
	PUSH	P,2
	PUSH	P,3
	MOVEM	2,FDBEOF(CDB)
	HRLI	1,12				;OFFSET
	MOVEM	2,3				;NEW COUNT
	SETO	2,				;MASK FOR CHANGED BITS
	JSYS	CHFDB				;NEW NUMBER OF BYTES TO END
	MOVEI	2,=7
	MOVEM	2,FDBSZ(CDB)
	HRLI	1,11
	MOVSI	2,007700			;MASK
	MOVSI	3,000700			;AND CHANGED BITS
	JSYS	CHFDB				;NEW BYTE SIZE
	HRLI	1,0				;LEAVE JFN IN 1
	POP	P,3
	POP	P,2
	POPJ	P,

GETCND:
;returns in 2 the character count that addresses EOF according to the FDB
;1, CDB loaded
	BEGIN	GETCND
	PUSH	P,3
	SKIPN	3,FDBSZ(CDB)
	  JRST	RET0
	CAIN	3,=36				;36 BITS?
	  JRST	RET2				;YES
	CAIN	3,=7				;7 BIT?
	  JRST	RET1				;YES
	CAILE	3,=36				;BETTER BE LEQ 36
	  ERR	<GETCND:  Byte size bigger than 36 bits>,1
	PUSH	P,4
	MOVEI	2,=36
	IDIVI	2,(3)				;GET THE NUMBER OF BYTES IN EACH 36-BIT WORD
	MOVE	3,FDBEOF(CDB)			;GET THE NUMBER OF BYTES IN THE FILE
	IDIVI	3,(2)				;THIS MANY WORDS -- EXTRA BYTES TO 3
	IMULI	3,5				;THIS MANY CHARACTERS IN THE WORDS
	PUSH	P,3				;SAVE ON STACK
	MOVEI	2,(4)				;EXTRA BYTES
	IMUL	2,FDBSZ(CDB)			;EXTRA BITS
	IDIVI	2,5				;CHARACTERS
	JUMPE	3,.+2				;ANYTHING LEFT OVER?
	  AOJ	2,				;YES
	POP	P,3				;GET BACK NUMBER OF CHARACTERS
	ADD	2,3				;PLUS THE ADDITIONAL ONES HERE -- ANSWER IN 2
	POP	P,4				;RESTORE
POPBACK:
	POP	P,3		
	POPJ	P,				;RETURN ANSWER IN 2

RET0:	SETZ	2,
	JRST	POPBACK

RET1:	MOVE	2,FDBEOF(CDB)			;7 BIT ALREADY 
	JRST	POPBACK

RET2:	MOVE	2,FDBEOF(CDB)			;36 BIT BYTES
	IMULI	2,5				;5 CHARACTERS PER BYTE
	JRST	POPBACK				;RETURN IT

	BEND GETCND

	BEGIN GETCPT
;ROUTINES FOR CHAR EOB

↑↑GETCPT:
;1,CDB LOADED
;RETURNS IN 2 THE END OF BUFFER CHARACTER
	SKIPN	2,IOBP(CDB)
	  POPJ	P,				;RETURN 0
	PUSH	P,3
	TLZ	2,007700
	TLO	2,000700			;MAKE A 7-BIT POINTER
	IBP	2				;INCREMENT
	HRRZM	2,3				;ADDRESS	
	HRRI	2,BYTES
	LDB	2,2
	SUB	3,IOADDR(CDB)			;SUBTRACT
	IMULI	3,5				;CHARACTERS
	ADDI	3,(2)				;PLUS THESE IN EXTRA WORD
	MOVE	2,IOPAGE(CDB)
	IMULI	2,1000*5			;PREVIOUS PAGES IN THE FILE
	ADDI	2,(3)				;PLUS THESE
	POP	P,3
	POPJ	P,				;RETURN IN 2


↑↑GTCPT1:
;1, CHNL, CDB loaded
;call PUSHJ
;returns the following
;	2	how many characters until the end of the buffer
;	3	bp to first free character
;	4	count for character output
;	5	count for character input
	SKIPN	3,IOBP(CDB)
	  JRST	RET
	TLZ	3,007700
	TLO	3,000700			;MAKE A 7-BIT POINTER
	MOVEM	3,2				;COPY IN 2
	IBP	2
	HRRZM	2,4				;ADDRESS
	HRRI	2,BYTES				
	LDB	2,2				;NUMBER OF ADDTL CHARS
	SUB	4,IOADDR(CDB)			;ADDRESS OF BUFFER
	IMULI	4,5
	ADDI	4,(2)
	MOVE	2,IOPAGE(CDB)
	IMULI	2,1000*5
	ADDI	2,(4)
	MOVNI	4,(4)
	ADDI	4,1000*5
	MOVEM	2,5				;SAVE 2
	PUSHJ	P,GETCND			;GET CHAR EOF
	EXCH	5,2
	SUB	5,2
	CAML	5,4
	  MOVEM	4,5
	POPJ	P,

BYTES:	BYTE (7) 0,1,2,3,4

RET:	SETZB	2,3				;NOT INITIALIZED
	SETZB	4,5
	POPJ	P,

	BEND GETCPT

CHCEOF:	
;CHECKS TO SEE IF CHARACTER EOF POINTER NEEDS RESETTING
;1, CDB LOADED
	SKIPN	IOBP(CDB)			;DONT CHECK IF NOTHING THERE
	  POPJ	P,
	PUSH	P,2
	PUSH	P,3
	PUSHJ	P,GETCND			;GET CHARACTER EOF IN 2
	MOVEM	2,3				;SAVE IN 6
	PUSHJ	P,GETCPT			;GET CHARACTER EOB IN 2	
	CAML	2,3				;NEED RESETTING?
	  PUSHJ	P,SETCND			;YES
	POP	P,3
	POP	P,2
	POPJ	P,

SETCPT:
;1,CDB LOADED
;2 HAS THE BYTE IN THE FILE TO SET TO
	BEGIN SETCPT

	MOVE	3,IOSTT(CDB)
	CAIN	3,XOWORD			;PREVIOUSLY DOING WORD OUTPUT?
	  PUSHJ	P,CHWEOF			;YES CHECK EOF
	CAIN	3,XOCHAR			;PREVIOUSLY DOING CHAR OUTPUT
	  PUSHJ	P,CHCEOF			;CHECK EOF
	CAMN	2,[-1]				;WANT EOF?
	  PUSHJ P,GETCND			;YES, GET IN 2
	IDIVI	2,1000*5			;PAGE BEING REQUESTED
	CAME	2,IOPAGE(CDB)			;SAME AS CURRENT
	  PUSHJ	P,SETPAGE			;NO GET NEW PAGE
	MOVE	2,IOADDR(CDB)
	MOVEM	3,5				;NUMBER OF CHARS IN THIS BUFFER
 	IDIVI	3,5				;WORDS TO 3, BYTES TO 4
	ADDI	2,(3)				;3 STILL HAS THE CHAR IN THIS PAGE
	HLL	2,BPS(4)
	MOVEM	2,IOBP(CDB)
	MOVE	3,IOSTT(CDB)
	CAIE	3,XICHAR	
	CAIN	3,XIWORD
	  JRST	ASSUMIN
	MOVEI	3,XOCHAR
	MOVEM	3,IOSTT(CDB)
FULBUF:	MOVEI	3,1000*5
SUBI3:	SUBI	3,(5)
STOAC3:	MOVEM	3,IOCNT(CDB)
	POPJ	P,
ASSUMIN:
	MOVEI	3,XICHAR
	MOVEM	3,IOSTT(CDB)
	PUSHJ	P,GETCND			;GET THE CHARACTER END OF FILE
	IDIVI	2,1000*5			;PAGES IN 2, CHARS IN 3
	CAMGE	2,IOPAGE(CDB)			;IS REQUESTED PAGE BEYOND EOF?
	   JRST	EMPBUF				;YES, NO INPUT THERE
	CAME	2,IOPAGE(CDB)			;ON THIS PAGE?
	   JRST	FULBUF				;NO
	JRST	SUBI3				;SUBTRACT ALREADY COMMITTED

EMPBUF:	SETZ	3,
	JRST	STOAC3

BPS:	POINT 7,0,-1
	POINT 7,0,6
	POINT 7,0,13
	POINT 7,0,20
	POINT 7,0,27

	BEND SETCPT
SETCIO:
;1,CDB LOADED 
;DECIDE WHETHER TO SETCI OR SETCO
	MOVEI	3,SETCI				;ASSUME CHARACTER INPUT
	MOVE	2,OFL(CDB)
	TESTN	2,RDBIT				;DOING INPUT?
	  MOVEI	3,SETCO				;NOPE ASSUME OUTPUT
	JRST	(3)				;AND POPJ RETURN
DSCR
	ADCI

Accepts:  1	jfn
	  CDB	channel data block

Call:	PUSHJ

Returns:	+1 for eof
		+2 for good input

Resets values in the CDB
⊗

	BEGIN ADCI

↑↑ADCI:	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	SIMIO	2,TABL,ADCERR			;MOVE 3,IOPAGE(CDB)
	AOJ	3,				;NEXT PAGE
	IMULI	3,1000*5			;NEXT CHARACTER
	PUSHJ	P,GETCND			;CHARACTER EOF IN 2
	CAML	3,2				;IS IT BEYOND
	  JRST	ADEOF				;YES -- CONFESS THAT IT IS
	SUB	2,3				;COUNT CHARACTERS IN NEW BUFFER
	CAILE	2,1000*5			;LESS THAN A FULL BUFFER
	  MOVEI	2,1000*5			;NO
	MOVEM	2,IOCNT(CDB)
	AOS	2,IOPAGE(CDB)			;INCREMENT PAGE COUNTER, GET IN 2
	PUSHJ	P,SETPAGE			;GET NEXT PAGE
	MOVE	2,IOADDR(CDB)
	HRLI	2,440700			;MAKE A BYTE-POINTER
	MOVEM	2,IOBP(CDB)
ADRET:	AOS	-3(P)				;INCREMENT PC WORD
ADEOF:	POP	P,3				;EOF --  DONT INCREMENT
	POP	P,2
	POP	P,1
	POPJ	P,				;RETURN

TABL:	JRST	ADCERR				;0 -- XNULL
	MOVE	3,IOPAGE(CDB)			;1 -- XICHAR
	REPEAT 3,<JRST ADCERR>			;2-4
	JRST	DOSIN				;5 -- XCICHAR
	REPEAT 3,<JRST ADCERR>			;6-10
	JRST	DODUMPI				;11 -- XDICHAR
	REPEAT 2,<JRST	ADCERR>			;12,13

ADCERR:	ERR	<Dryrot at ADCI>,1
	JRST	ADEOF


DOSIN:	MOVE	2,IOADDR(CDB)
	HRL	3,2
	HRRI	3,1(2)
	SETZM	(2)
	BLT	3,777(2)
	HRLI	2,444400
	MOVNI	3,1000
	JSYS	SIN
	CAMG	3,[-1000]
	  JRST	[CAMN	3,[-1000]		;EOF?
		  JRST	ADEOF
		 JRST .+1]
	ADDI	3,1000				;NUMBER OF WORDS READ
	IMULI	3,5				;NUMBER OF CHARACTERS
STOCNT:	MOVEM	3,IOCNT(CDB)
	MOVE	2,IOADDR(CDB)
	HRLI	2,440700
	MOVEM	2,IOBP(CDB)
	JRST	ADRET				;AND RETURN

DODUMPI:
	PUSH	P,1				;SAVE JFN OVER POSSIBLE DUMPI ERROR
	PUSH	P,4
	MOVE	3,IOADDR(CDB)
	HRL	2,3
	HRRI	2,1(3)
	SETZM	(3)
	BLT	2,777(3)	
	SOJ	3,
	HRLI	3,-1000				;MAKE AN IOWD
	MOVEI	2,3				;COMMAND LIST STARTS AT 3
	SETZ	4,				;AND ENDS AT 4
	JSYS	DUMPI
	  JRST	DMIERR
	MOVEI	3,1000*5
	POP	P,4
	POP	P,1
	JRST	STOCNT

DMIERR:	CAIE	1,600220			;EOF?
	  ERR	<ADCI:  Dump mode input error>,1
	POP	P,4				;RESTORE
	POP	P,1				;PRECIOUS JFN
	MOVE	2,DVTYP(CDB)			;GET DEVICE TYPE
	CAIE	2,3				;MAGTAPE?
	  JRST	ADEOF				;NO, JUST INDICATE EOF
	SETZ	2,				;MTOPR RESET
	JSYS	MTOPR
	JRST	ADEOF				;AND SAY WE ARE AT THE END OF THE FILE


	BEND ADCI
DOINP:
;CHNL has the JFN
;CDB has the channel data block
;returns +1 for good buffered input
;	 +2 for 7-bit input with char in D
;	 +3 for eof or error
	BEGIN DOINP
	PUSH	P,1				;SAVE 1
	PUSH	P,2
	MOVE	1,CHNL				;JFN
	MOVE	D,IOSTT(CDB)			;D IS FREE
	CAIE	D,XBYTE7			;7-BIT?
	  JRST	DOBUFF
	SKIPE	TTYINF(CDB)			;CONTROLLING TERMINAL?
	  JRST	CHKTTY				;YES
DOBIN:	JSYS	BIN
	JUMPE	2,CHKEOF			;IF 0 MAY BE EOF
	MOVEM	2,D				;STORE 
	JRST	DOB7
;;;	MOVE	2,DVTYP(CDB)			;IS THE DEVICE A TTY?
;;;	CAIE	2,12				;
;;;	  JRST	DOB7
;;;	CAIE	2,12				;
;;;	  JRST	DOB7				;NO
;;;	CAIN	D,32				;A CONTROL-Z?
;;;	  JRST	DOIEOF				;YES INDICATE EOF
;;;	CAIN	D,37				;PHONEY BBN EOL?
;;;	  MOVEI	D,12				;A LINE-FEED
;;;	JRST	DOB7				;AND RETURN

CHKEOF:	JSYS	GTSTS				;BETTER CHECK
	TESTE	2,1B8			
	  JRST	DOIEOF				;YEP
	SETZ	D,
	JRST	DOB7

DOIEOF:	SETOM	.SKIP.
	SKIPE	ENDFL(CDB)			;SPECIFIED?
	  SETOM	@ENDFL(CDB)			;YES
	AOS	-2(P)
DOB7:	AOS	-2(P)
DORET:	POP	P,2
	POP	P,1
	POPJ	P,


DOBUFF:
	PUSHJ	P,ADCI
	  JRST	DOIEOF				;INDICATE EOF
	JRST	DORET

CHKTTY:
	MOVE	2,TTYINF(CDB)			;CHECK STATUS OF TTY
	TESTE	2,QTTEOF			;EOF QUED?
	  JRST	DOIEOF				;YES
	SETZM	CTLOSW				;INDICATE REQUEST 
						;FOR INPUT
	HRRZ	2,2
	CAIN	2,TNXINP			;TENEX DEFAULT
	  JRST	DOBIN
	CAIN	2,TENXED			;TENEX STYLE EDITING?
	  JRST	TNXBUF				;YES
	CAIN	2,DECLED			;DEC STYLE BUFFERING?
	  JRST	DECBUF
	ERR	<DOINP:  Illegal buffering request for terminal>,1

IMSSS<
TNXBUF:
	BEGIN TNXBUF
ORIGCNT←← =1000

	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	HRRO	1,IOADDR(CDB)		;BP TO BUFFER FOR CHAN
	SETZ	3,
	MOVEI	2,ORIGCNT		;DEFAULT LENGTH
	JSYS 	PSTIN
	MOVEI	3,ORIGCNT		;MAXIMUM
	SUBI	3,(2)			;GET NUMBER RECEIVED IN 3
	LDB	2,1			;GET THE LAST CHAR
	CAIE	2,15			;CARRIAGE RETURN (PROB!!)
	  JRST	NOTCR
	MOVEI	2,12			;INSERT A 12 AFTER IT
	IDPB	2,1
	AOJ	3,			;INCREMENT COUNT
	JRST	GOTBRK			;BREAK TENDED

NOTCR:
	CAIE	2,32			;EOF?
	  JRST	GOTBRK
	MOVE	2,[QTTEOF]
	ORM	2,TTYINF(CDB)		;QUE THE END OF FILE
	SOJ	3,			;SUBTRACT ONE FROM COUNT -- CTRL-Z

GOTBRK:	MOVEM	3,IOCNT(CDB)		;SAVE COUNT
	MOVE	1,IOADDR(CDB)
	HRLI	1,440700		;MAKE A BP
	MOVEM	1,IOBP(CDB)		;SAVE IT FOR USER
	POP	P,3			;RESTORE
	POP	P,2
	POP	P,1
	JRST	DORET			;AND RETURN

	BEND TNXBUF
>;IMSSS

NOIMSSS<;NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
;UNDER BBN'S LACK OF A SYSTEM LINE EDITOR

TNXBUF:
	BEGIN TNXBUF
ORIGCNT←← =200
;AC USES  A,B,C  JSYS TEMPORARIES
;	  D	 BYTEPOINTER
;	  E	 COUNT, INITIALLY 0
;	  Q1 (=6) ORIGINAL BP
	PUSH	P,A			;SAVE
	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	PUSH	P,E
	PUSH	P,Q1
	MOVE	Q1,IOADDR(CDB)
	HRLI	Q1,440700		;MAKE A BP

RESTRT:	MOVE	D,Q1			;GET THE ORIGINAL BP	
	SETZ	E,			;ZERO THE COUNT
INLUP:	CAIL	E,ORIGCNT
	  JRST	CNTEXH			;COUNT EXHAUSTED
	JSYS	PBIN			;GET A CHAR
	CAIN	A,37			;EOL?
	  JRST	DOEOL			;YES
	CAIN	A,12			;LINE FEED (ON TOPS 20)
	  JRST	DONE			;YES
	CAIN	A,33			;ESCAPE?
	  JRST	DONE
 	CAIN	A,7			;CTRL-G
	  JRST	DONE
	CAIN	A,32			;CTRL-Z
	  JRST	TTYEOF			;INDICATE EOF
	CAIN	A,"R"-100		;CTRL-R FOR REPEAT
	  JRST	DOCTR
	CAIN	A,"X"-100		;CTRL-Z FOR DELETE LINE
	  JRST	DOCTX			;YES
	CAIE	A,177			;EITHER RUBOUT
	CAIN	A,"A"-100		;OR CTRL-A
	  JRST	DOCTA			;FOR DELETE CHARACTER
	IDPB	A,D
	AOJA	E,INLUP			;CONTINUE

DOCTR:	HRROI	A,[ASCIZ/
/]
	JSYS	PSOUT
	JUMPE	E,INLUP
	MOVEI	A,101
	MOVE	B,Q1			;ORIG BP
	MOVN	C,E			;COUNT THUS FAR
	JSYS	SOUT
	JRST	INLUP			;AND CONTINUE

DOCTX:	HRROI	A,[ASCIZ/
/]
	JSYS	PSOUT
	JRST	RESTRT			;AND START ALL OVER

DOCTA:	JUMPLE	E,DOCTX			;IF NO CHARS THEN DO A CONTROL-X
	MOVEI	A,"\"
	JSYS	PBOUT
	LDB	A,D			;LAST CHAR
	JSYS	PBOUT	
	SOJ	D,
	IBP	D
	IBP	D
	IBP	D
	IBP	D
	SOJA	E,INLUP			;SUBTRACT 1 AND CONTINUE

DOEOL:	
	MOVEI	A,15
	IDPB	A,D
	AOJ	E,
	MOVEI	A,12
DONE:	IDPB	A,D
	AOJ	E,
CNTEXH:
	MOVEM	E,IOCNT(CDB)			;COUNT
	MOVEM	Q1,IOBP(CDB)			;BP
	POP	P,Q1				;RESTORE
	POP	P,E
	POP	P,D
	POP	P,C
	POP	P,B
	POP	P,A
	JRST	DORET				;RETURN

TTYEOF:	MOVE	A,[QTTEOF]
	ORM	A,TTYINF(CDB)			;QUE END-OF-FILE
	JRST	CNTEXH				;AND RETURN
	BEND TNXBUF
>;NOIMSSS

DECBUF:
	BEGIN DECBUF

ORIGCNT ←← =1000				;LOTS OF ROOM

	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	PUSH	P,E
	PUSH	P,Q1

	MOVE	Q1,IOADDR(CDB)
	HRLI	Q1,440700			;MAKE A BP
	
RESTRT:	MOVE	D,Q1
	SETZ	E,				;COUNT
INLUP:	CAIL	E,ORIGCNT			;BEYOND?
	  JRST	CNTEXH				;YES
	JSYS	PBIN
	CAIN	A,DELLINE			;DELETE ENTIRE LINE?
	  JRST	CTRLU				;YES
	CAIN	A,RUBCHAR			;RUBOUT?
	  JRST	RUBOUT				;YES
	CAIN	A,37				;PHONEY BBN EOL?
	  JRST	SAWEOL
	CAIN	A,33
	  JRST	SAWESC
	CAIN	A,32				;CONTROL-Z?
	  JRST	TTYEOF				;YES, EOF
	CAIE	A,7				;CONTROL-G
	CAIN	A,12				;OR LF
	  JRST	DONE
	IDPB	A,D
	AOJA	E,INLUP				;CONTINUE

CTRLU:	HRROI	A,[BYTE (7) 7,15,12,0,0]
	JSYS	PSOUT
	JRST	RESTRT				;START OVER

RUBOUT:	JUMPE	E,CTRLU				;NOTHING, DO CTRLU
IMSSS <
	MOVEI	1,101
	JSYS	DELCH
	  JFCL
	JRST	DLTED
	JRST	DLTED
>;IMSSS
	MOVEI	A,"\"
	JSYS	PBOUT
	LDB	A,D				;LAST CHAR
	JSYS	PBOUT
DLTED:
	SOJ	D,				;DECREMENT BP
	IBP	D
	IBP	D
	IBP	D
	IBP	D
	SOJA	E,INLUP				;DECREMENT COUNT AND CONTINUE

DONE:
	IDPB	A,D
	AOJ	E,
CNTEXH:
	MOVEM	E,IOCNT(CDB)
	MOVEM	Q1,IOBP(CDB)
	POP	P,Q1
	POP	P,E
	POP	P,D
	POP	P,C
	POP	P,B
	POP	P,A
	JRST	DORET

SAWEOL:	MOVEI	A,15				;SIMULATE CR
	IDPB	A,D
	AOJ	E,
	MOVEI	A,12				;SIMULATE LF
	JRST	DONE

SAWESC:	MOVEI	A,ALTMODE			;DEC ALTMODE
	JRST	DONE

TTYEOF:	MOVE	A,[QTTEOF]
	ORM	A,TTYINF(CDB)			;QUE AN EOF
	JRST	CNTEXH				;AND RETURN

	BEND DECBUF

	BEND DOINP
DSCR 	ADCO,ADCO1
CAL	PUSHJ
SID	SAVES ALL ACS
ARGS
	1		JFN
	CDB		address of channel data block
⊗

	BEGIN ADCO
;HERE IF THE COUNT ALREADY PROMISES A CHARACTER
↑↑ADCO1:
	AOS	IOCNT(CDB)	;MAKE THE COUNT HONEST, TEMPORARILY
	PUSHJ	P,ADCO		;CALL ADCO
	SOS	IOCNT(CDB)	;REFLECT THE FACT THAT A CHARACTER IS PROMISED
	POPJ	P,		;AND RETURN (TO CHARACTER OUTPUT CODE)

↑↑ADCO:
	PUSH	P,2		;SAVE ACS
	PUSH	P,3
	PUSH	P,4
	MOVE	2,IOSTT(CDB)	;GET STATUS
	CAIE	2,XOCHAR	;PMAPPING THE DSK?
	  JRST	NOPMAP		;GUESS NOT
	AOS	2,IOPAGE(CDB)	;NEXT PAGE
	PUSHJ	P,SETPAGE
	MOVEI	2,1000*5	
	MOVEM	2,IOCNT(CDB)	;CAN WRITE THIS MANY
	MOVE	2,IOADDR(CDB)	
	HRLI	2,440700	
	MOVEM	2,IOBP(CDB)	;OK
ADRET:	POP	P,4
	POP	P,3
	POP	P,2
	POPJ	P,


NOPMAP:
	CAIN	2,XCOCHAR	;36-BIT ETC.?
	  JRST	STRSOU		;USE SOUT
	CAIE	2,XDOCHAR	;BETTER BE DUMP-MODE
	  ERR	<Dryrot at ADCO>,1
	SKIPN	IOBP(CDB)	;SET UP YET?
	  JRST	DMPINIT
	MOVE	3,IOADDR(CDB)
	MOVEI	4,DMOCNT*5
	CAMG	4,IOCNT(CDB)	;ANY CHARS TO SEND
	  JRST	ADRET
	
	MOVEI	2,3
	SUBI	3,1
	MOVNI	4,DMOCNT	;WORD COUNT FOR DUMP MODE OUTPUT	
	HRL	3,4		;MAKE AN IOWD
	SETZ	4,		;MAKE A COMMAND LIST
	JSYS DUMPO
	  ERR <DUMPOUT:  CANNOT WRITE DATA IN DUMP MODE>,1
	SETOM	DMPED(CDB)	;AND INDICATE DONE
DMPINIT:
	MOVE	3,IOADDR(CDB)
	HRL	2,3
	HRRI	2,1(3)
	SETZM	(3)
	BLT	2,DMOCNT-1(3)	;ZERO OUT
	MOVEI	2,DMOCNT*5	
	MOVEM	2,IOCNT(CDB)	;SAVE COUNT
	HLL	3,[POINT 7,0,-1];FIX A BYTE-POINTER
	MOVEM	3,IOBP(CDB)	;AND SAVE BYTE-POINTER
	JRST	ADRET

STRSOU:	
	SKIPN	IOBP(CDB)
	  JRST	SOUINIT
	MOVEI	3,1000*5
	SUB	3,IOCNT(CDB)	;NUMBER OF CHARACTERS ACTUALLY IN BUFFER
	IDIVI	3,5		;NUMBER OF WORDS
	SKIPE	4		;ANY REMAINDER?
	   AOJ	3,		;YES, ANOTHER WORD FOR EXTRA CHARACTERS
	JUMPE	3,ADRET		;RETURN IF NO CHARACTERS TO SEND
	MOVN	3,3		;NEGATIVE WORD COUNT FOR SOUT
	MOVE	2,IOADDR(CDB)
	HRLI	2,444400	;MAKE A BP
	JSYS SOUT
SOUINIT:
	MOVE	2,IOADDR(CDB)
	HRL	3,2
	HRRI	3,1(2)
	SETZM	(2)
	BLT	3,777(2)	;CLEAR OUT PAGE
	HRLI	2,440700
	MOVEM	2,IOBP(CDB)
	MOVEI	3,1000*5
	MOVEM	3,IOCNT(CDB)
	JRST	ADRET

	BEND ADCO
DSCR SETIO
	Master routine to set up the file io possibilities.

Arguments:
	1,CHNL,CDB set up

There are four entries to the function, depending on the kind of IO that
appears to be desired.  They are:

	SETCI		character input
	SETCO		character output	
	SETWI		word input
	SETWO		word output


This routine does the following things:
	(1)  sets up IOSTT


It does so by first deciding each of these
	(1)  input or output immediately desired
	(2)  chars or words immediately desired
	(3)  7 or 36 bit bytes open
	(4)  mode 0 or 17	
	(5)  dsk or non-dsk

An additional consideration is that the file, if on the disk,
may need to be CLOSFed and reOPENFed to allow reading (and writing
if appending).
This facilitates (indeed, makes possible) PMAPping the file and
doing I/O directly into pages of the file.  Should this reOPENF
fail (as when protection does not allow it), it will be necessary
to restrict the possibility of doing data mixed and random I/O
to the file.  Such is the design of TENEX. (Example:  MESSAGE.TXT
is ordinarily such that you can append to it but not read and
write, when it is someone else's file.)
⊗

	BEGIN SETIO
↑SETWI:	SKIPA	6,[=8]				;wants word input
↑SETWO:	MOVEI	6,=24				;wants word output
	JRST	SETIO				;

↑SETCI:	TDZA	6,[-1]				;wants character input
↑SETCO:	MOVEI	6,=16				;wants character output

SETIO:	LDB	2,[POINT 6,OFL(CDB),5]		;7-36 BIT BYTES?
	CAIN	2,=36
	  ADDI	6,4				;36
	LDB	2,[POINT 4,OFL(CDB),9]
	JUMPE	2,.+2				;MODE 0 OR 17?
	  ADDI	6,2				;17
	SKIPE	DVTYP(CDB)			;DSK OR NON-DSK?
	  AOJ	6,				;NON-DSK
	IDIVI	6,7				;SET UP FOR LDB
	LDB	6,BPS(7)
	JUMPN	6,.+2			
	  ERR	<DRYROT at SETIO:  Nonsense combination of bytes and modes for io request.>,1
	MOVEM	6,IOSTT(CDB)			;THAT IS THE ANSWER
	CAIL	6,XICHAR			;PMAPPED DISK FILE?
	CAILE	6,XOWORD
	  JRST	NOPMAP
	MOVE	2,OFL(CDB)
	TESTN	2,WRBIT				;WRITING
	TESTE	2,APPBIT			;OR APPENDING?
	  JRST	.+2				;THEN BETTER BE READING
	JRST	CHKED1
	TESTO	2,RDBIT				;MUST BE READING
	TESTN	2,APPBIT			;REMEMBER IF APPENDING
	  JRST	NOAPP				;NOT APPENDING
	TESTZ	2,APPBIT			;TURN OFF APPENDING
	TESTO	2,WRBIT				;INDICATE WRITING
	SKIPA	3,[-1]				;APPENDING
NOAPP:	  SETZ	3,				;NOT APPENDING
	CAMN	2,OFL(CDB)			;DIFFERENT?
	  JRST	CHKED				;NO
	TESTO	1,1B0				;DONT RELEASE
	JSYS	CLOSF
	  ERR	<SETIO:  Cannot do CLOSF>
	TESTZ	1,1B0				;RESET DONT RELEASE BIT
	PUSH	P,1				;SAVE JFN
	JSYS	OPENF
	  JRST  NOROPN				;CANNOT RE-OPEN FILE
	POP	P,1				;RESTORE JFN
	MOVEM	2,OFL(CDB)			;AND REMEMBER NEW FLAGS
CHKED:	SKIPA	2,3				;PICK UP SAVED POINTER
CHKED1:	  SETZ	2,
	PUSH	P,2				;SAVE POINTER
	SETOM	IOPAGE(CDB)			;DENY THAT THERE IS A PAGE THERE
	MOVE	2,[XWD 2,11]			;READ FDB
	MOVEI	3,2
	JSYS	GTFDB
	MOVEM	3,FDBEOF(CDB)			;SAVE EOF
	LDB	2,[POINT 6,2,11]
	MOVEM	2,FDBSZ(CDB)
	POP	P,2				;GET POINTER BACK
	CAIE	6,XIWORD			;SEE IF WORDS
	CAIN	6,XOWORD
	  JRST	SETWPT				;WORDS	   POPJ BACK
	JRST	SETCPT				;CHARACTERS  POPJ BACK

NOROPN:	POP	P,1				;CLOBBERED JFN
	MOVE	2,OFL(CDB)			;FLAGS AS THEY WERE -- CANT DO NO BETTER
	JSYS	OPENF
	  ERR	<SETIO:  Cannot do OPENF>
	MOVE	2,IOSTT(CDB)			;STATUS -- MUST BE CHANGED
	CAIN	2,XICHAR
	  MOVEI	3,XCICHAR
	CAIN	2,XOCHAR
	  MOVEI	3,XCOCHAR
	CAIE	2,XIWORD
	CAIN	2,XOWORD
	  MOVEI	3,XCIWORD
	MOVEM	3,IOSTT(CDB)			;SAVE STATUS -- BEST WE CAN DO
						;FALL THRU AND RETURN
NOPMAP:	SETZM	IOCNT(CDB)
	SETZM	IOBP(CDB)			
	POPJ	P,	


BPS:	POINT	5,TABL(6),4			;BYTE POINTERS
	POINT	5,TABL(6),9
	POINT	5,TABL(6),14
	POINT	5,TABL(6),19
	POINT	5,TABL(6),24
	POINT	5,TABL(6),29
	POINT	5,TABL(6),34	

TABL:	BYTE (5) XBYTE7,XBYTE7,0,0,XICHAR,XCICHAR,XDICHAR
	BYTE (5) XDICHAR,0,0,0,0,XIWORD,XCIWORD
	BYTE (5) XDARR,XDARR,XBYTE7,XBYTE7,0,0,XOCHAR
	BYTE (5) XCOCHAR,XDOCHAR,XDOCHAR,0,0,0,0
	BYTE (5) XOWORD,XCIWORD,XDARR,XDARR


	BEND SETIO
DSCR
	FINIO

	Finishes the io.  
	Mainly does the following:

	(1)  outputs any remaining buffers
	(2)  checks eof pointer in FDB of dsk files
	(3)  writes EOF marks to magtape

CAL	PUSHJ from runtimes (CFILE and CLOSF)
ARGS	1,CDB
SID	nothing saved
⊗
HERE(FINIO)
	BEGIN FINIO
	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	PUSH	P,4
	PUSH	P,5
	PUSH	P,6
	SIMIO	2,TABL,POPBACK
UNMAP:	SETZM	DMPED(CDB)			;RESET VALUES TO ORIGINALS
	SETZM	IOCNT(CDB)
	SETZM	IOBP(CDB)
	SETZM	IOSTT(CDB)
	SETOM	IOPAGE(CDB)			;N.B.
	SETO	1,				;DESTROY PAGE -- NOTE: CLOBBERS JFN 
 	MOVE	2,FKPAGE(CDB)			;UNTIL POP BELOW
	SETZ	3,
	JSYS	PMAP
POPBACK:POP	P,6
	POP	P,5
	POP	P,4
	POP	P,3
	POP	P,2
	POP	P,1
	POPJ	P,

TABL:	JRST	POPBACK				;0 -- XNULL
	JFCL					;1 -- XICHAR
	PUSHJ	P,CHCEOF			;2 -- XOCHAR -- POPJ RETURN
	JFCL					;3 -- XIWORD
	PUSHJ	P,CHWEOF			;4 -- XOWORD
	JFCL					;5 -- XCICHAR
	PUSHJ	P,ADCO				;6 -- XCOCHAR
	JFCL					;7 -- XCWORD
	JRST 	DOB7				;10 -- XBYTE7
	JFCL					;11 -- XDICHAR
	JRST	XDO1				;12 -- XDOCHAR
	JRST	XDO2				;13 -- XDARR
	
DOB7:	SKIPN	2,TTYINF(CDB)			;A TELETYPE?
	  JRST	UNMAP				;NOPE
	TESTZ	2,QTTEOF			;TURN OFF QUED EOF
	MOVEM	2,TTYINF(CDB)
	JRST	UNMAP				;AND UNBUFFER

XDO1:	PUSHJ	P,ADCO				;WRITE OUT WHATEVER IS THERE		
XDO2:	SKIPN	DMPED(CDB)			;DUMP MODE OUTPUT SEEN?
	  JRST	UNMAP				;NOPE
	MOVE	2,DVTYP(CDB)			;DEVICE TYPE
	CAIE	2,2				;MAGTAPE?
	  JRST	UNMAP				;NOPE
	MOVEI	2,3				;EOF
	JSYS	MTOPR				;WRITE TWO
	JSYS	MTOPR		
	MOVEI	2,17				;BACKSPACE OVER 1 EOF
	JSYS	MTOPR
	JRST	UNMAP


	BEND FINIO
ENDCOM(IOROU)

COMPIL(BINROU,<SFPTR,RFPTR,MTOPR,BKJFN,RFBSZ>
	,<SAVE,RESTR,X22,X33,X44,.SKIP.,JFNTBL,CDBTBL>
	,<BINROU -- Binary routines generally to not be used>)

DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
	Sets the file open on JFN to byte POINTER (-1 for EOF).
Errors returned in .SKIP.
	WARNING:  presently not compatible with special character
mode.
⊗
HERE(SFPTR)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCHN 1,-2(P),SFBAD
	SETZM	.SKIP.
	MOVE 2,-1(P)
	JSYS SFPTR
	  MOVEM	1,.SKIP.
SFRET:	JRST	RESTR

SFBAD:  ERR <Illegal JFN>,1
	SETOM	.SKIP.
	JRST	SFRET


DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
	Reads the pointer of JFN.  Error codes to .SKIP.
	WARNING:  presently does not work for files in special character
mode.
⊗
HERE(RFPTR)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN	1,-1(P),RFBAD
	SETZM	.SKIP.
	JSYS RFPTR
	MOVEM 1,.SKIP.
	MOVEM	2,RACS+A(USER)	;ANSWER IN 2
RFRET:	JRST	RESTR

RFBAD:  ERR <Illegal JFN>,1
	SETOM	.SKIP.
	JRST	RFRET

DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
	Does the MTOPR jsys.
⊗
HERE(MTOPR)
	BEGIN MTOPR
	PUSHJ	P,SAVE
	MOVE	LPSA,X44
	VALCHN 1,-3(P),MTBAD
	MOVE 	2,-2(P)
	MOVE	3,-1(P)
	JSYS MTOPR
MTRET:	JRST	RESTR

MTBAD:  ERR <Illegal JFN>,1
	JRST	MTRET

	BEND MTOPR

DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
	Does the BKJFN jsys on JFN, error code to .SKIP.
⊗
HERE(BKJFN)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN 1,-1(P),BKBAD
	SETZM	.SKIP.
BKJF1:	JSYS BKJFN
	MOVEM 1,.SKIP.			;ERROR RETURN
BKRET:	JRST	RESTR

BKBAD:  MOVE	1,-1(P)			;USE LITERALLY
	JRST	BKJF1
DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN);
	Reads the byte-size of the file open on JFN.
⊗
HERE(RFBSZ)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN 1,-1(P),RFBBAD
	JSYS RFBSZ
	  JFCL				;TOPS 20 ERROR RETURN
	MOVEM	2,RACS+A(USER)		;ANSWER IN 2
RFBRET:	JRST	RESTR

RFBBAD: ERR <Illegal JFN>,1
	JRST	RFBRET

ENDCOM(BINROU)

COMPIL(DSKOPS,<DSKIN,DSKOUT>
	,<JFNTBL,CDBTBL,.SKIP.>
	,<DSKOPS -- DIRECT DSK ROUTINES>)

DSCR SIMPLE PROCEDURE 
DSKIN(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC);

	IMSSS only.
	Does direct IO from the DSK (formerly device "PAK").
Modules 4-7 are legal for everyone.  Other modules require enabled
status.
	Count words are read into user's core at location LOC, from
MODULE, record RECNO.  Error bits are in .SKIP.
	Does the DSKOP jsys (as modified at IMSSS).
⊗

	BEGIN DSKOPS
HERE(DSKIN)
NOIMSSS<
	ERR	<DSKIN:  Only defined in IMSSS system>
>;NOIMSSS
	PUSHJ	P,SAVE
	SETZ	4,		;INDICATE READ ONLY

DSK1:	HRRZ	2,-2(P)
	JUMPLE	2,DSBAD	;LEQ 0 -- ERROR
	CAILE	2,1000		;DONT READ MORE THAN 1000 WORDS
	   JRST DSBAD
	IOR	2,4		;PICK UP READ OR WRITE (SET IN 4)
	HRLZ	1,-4(P)		;MODULE
	HRR	1,-3(P)		;RECORD NO. IN RIGHT HALF
	TLO	1,600000	;SOFTWARD ADDRESS, IMSSS FORMAT (BITS 0 AND 1 RES.)
	HRRZ 	3,-1(P) 		; GET THE USER LOCATION
    	JSYS DSKOP
DSDUN:	MOVEM 1,.SKIP.		; SAVE ERROR BITS
DSRET:	MOVE 	LPSA,[XWD 5,5]	; TO ADJUST STACK
	JRST	RESTR
DSBAD:	ERR <DSKIN OR DSKOUT:  WORD COUNT EITHER <= 0 OR > '1000>,1
	SETOM	.SKIP.
	JRST	DSRET



DSCR SIMPLE PROCEDURE 
	DSKOUT(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC)
DESR Similar to DSKIN, except that a write is done.
⊗

HERE(DSKOUT)
NOIMSSS<
	ERR	<DSKOUT:  Only defined at IMSSS>
>;NOIMSSS
	PUSHJ	P,SAVE
	MOVSI	4,(1B14)	;INDICATE WRITE (TO BE IOR'ED INTO AC 2)
	JRST	DSK1		;AND TO THE ABOVE CODE

	BEND DSKOPS

ENDCOM(DSKOP)

COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR>
	,<X22,X44,.SKIP.,JFNTBL,CDBTBL>
	,<DEVS -- DEVICE HANDLERS, ERROR ROUTINE>)
DSCR INTEGER SIMPLE PROCEDURE DEVTYPE(INTEGER JFN);
	Returns (via the DEVCHR jsys) the device type of
the device open on JFN.  The more general DEVCHR call is
also implemented (below).
⊗
HERE(DEVTYPE)
	VALCHN 1,-1(P),DEVBAD
	JSYS DVCHR
	HLRZ	1,2
	ANDI	1,777
DEVRET:	SUB	P,X22
	JRST	@2(P)
DEVBAD: ERR <Illegal JFN>,1
	JRST	DEVRET
DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN; REFERENCE INTEGER AC1,AC3);
	Does the DEVCHR jsys, returning the flags from AC2 as the
value of the call, and AC1 and AC3 get the contents of ac's 1 and 3.;
⊗
HERE(DVCHR)
	VALCHN 1,-3(P),DVBAD
	JSYS DVCHR
	MOVEM	1,@-2(P)
	MOVEM	3,@-1(P)
	MOVE	1,2
DVRET:	SUB	P,X44
	JRST	@4(P)
DVBAD: ERR <Illegal JFN>,1
	JRST	DVRET
	

DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
	Using the ERSTR jsys, types out on the console the TENEX error string
associated with ERRNO for FORK fork (0 for the current fork).  Parameters (in
the sense of the ERSTR jsys) are expanded.
	Types out the string ERSTR:  UNDEFINED ERROR number if
something is with your error number or fork (and sets .SKIP. to -1).
⊗
HERE(ERSTR)
	SETZM	.SKIP.
	MOVEI	1,101		;PRIMARY OUTPUT
	SKIPN	2,-1(P)		;ANY FORK MENTIONED?
	   MOVEI 2,400000	;ASSUME CURRENT FORK
	HRLZ	2,2		;IN LEFT HALF
	HRR	2,-2(P)		;THE ERROR NUMBER
	SETZ	3,		;NO LIMIT TO SIZE OF STRING
	JSYS ERSTR
	   JRST	ERSERR		
	   JRST	ERSERR		;ERROR RETURNS
ERSRET:	SUB	P,X33
	JRST	@3(P)
ERSERR:	HRROI	1,[ASCIZ/
ERSTR:  UNDEFINED ERROR NUMBER
/]
	JSYS PSOUT
	SETOM	.SKIP.		;INDICATE ERROR 
	JRST	ERSRET
ENDCOM(DEVS)

COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET,RDSEG>
	,<CORGET,GOGTAB,JFNTBL,CDBTBL,STRNGC,INSET,SAVE,RESTR,X33>
	,<UTILITY -- UTILITY TENEX ROUTINES>)
DSCR
	SETCHN accepts in A the JFN, and returns in A the channel number associated with a JFN.  
It sets up the JFNTBL, the CDBTBL table, and returns the address of the
file command block in ac CDB.  Other acs are not modified (except USER).
	In order to accommodate the OPEN statement, a channel will be
considered allocated when it has a CDB, even if it does not yet have a jfn.
⊗

HERE(SETCHN)
	MOVE	USER,GOGTAB
	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	MOVEI	B,JFNSIZE		;FOR COMPARISON TO RH OF A
	CAILE	B,(A)			;IS THE JFN BEYOND THE NUMBER OF CHANNELS
	SKIPE	CDBTBL(A)		;OR IS IT ALLOCATED OR USED?
	   JRST FNDCHN			;PERHAPS NOT, FIND ONE SOMEHOW
	HRRZ	D,A			;USE JFN NO. AS CHANNEL
;MUST GET A CHANNEL DATA BLOCK
GTCDB:	MOVEI	C,IOTLEN
	PUSHJ	P,CORGET
	   ERR <SETCHN:  NO CORE>
	MOVE	CDB,B
	MOVEM	CDB,CDBTBL(D)		;SAVE ADDR OF CDB
;HERE WITH B,CDB, D LOADED WITH: CDBADDR,CDBADDR,CHANNEL
CLCDB:	
	HRL	B,B
	ADDI	B,1
	SETZM	(CDB)
	BLT	B,IOTLEN-1(CDB)

GOTCHN:	
	MOVEM 	A,JFNTBL(D)
	HRRZ	1,A			;JFN
	JSYS DVCHR			;CLOBBERS 1,2,3
	MOVEM	1,DVDSG(CDB)		;SAVE DESIGNATOR
	MOVEM	2,DVCH(CDB)		;AND CHARACTERISTICS
	HLRZ	1,2
	ANDI	1,777			;GET DEVICE TYPE
	MOVEM	1,DVTYP(CDB)		;AND SAVE IT
	CAIE	1,12			;IS IT A TTY?
	  JRST	NOTTTY			;NOPE
;CHECK THAT IT IS DEVICE "TTY" (IN WHICH CASE IT IS THE CONTROLLING TERM)
	HRRZ	2,JFNTBL(D)		;GET JFN
	TRNE	2,400000		;A TERMINAL SPECIFIER FROM SETCHAN?
	  JRST	NOTTTY			;YES, NOT DEVICE "TTY"
	PUSH	P,3			;SOME SPACE
	PUSH	P,4
	PUSH	P,5
	PUSH	P,6
	HRROI	1,4
	MOVSI	3,200000		;DEVICE FIELD ONLY
	SETZ	4,
	JSYS	JFNS
	MOVEM	4,2			;SAVE IN 2
	POP	P,6			;RESTORE ACS
	POP	P,5
	POP	P,4
	POP	P,3
	CAME	2,[ASCIZ/TTY/]		;DEVICE TTY?
	  JRST	NOTTTY			;NOT THE CONTROLLING TERMINAL
	MOVE	2,[ISCTRM+TENXED]	;DEFAULT -- TENEX STYLE
	MOVEM	2,TTYINF(CDB)

NOTTTY:	MOVEI	2,STARTPAGE(D)		;PAGE FOR BUFFER
	HRLI	2,400000		;THIS FORK
	MOVEM	2,FKPAGE(CDB)		;XWD FORK,PAGE FOR PMAPPING
	LSH	2,9			;MAKE AN ADDRESS
	MOVEM	2,IOADDR(CDB)		;AND SAVE IT AS WELL
	SETOM	IOPAGE(CDB)		;DENY THAT THERE IS A PAGE THERE
	HRRZ	A,D			;CHANNEL INTO A
	POP	P,D			;RESTORE
	POP	P,C			
	POP	P,B
	POPJ	P,


;FIND AN OPEN CHANNEL AND RETURN THE NUMBER IN D
;A HAS THE JFN NO. IN IT, SO CHECK TO SEE IF THE SAME
;B MAY BE CLOBBERED
FNDCHN:	HRRZ	D,JFNTBL(A)		;CHECK OLD JFN
	CAIE	D,(A)			;SAME AS THE NEW?
	  JRST  FNDCH2			;NO
	MOVE	CDB,CDBTBL(D)		;GET OLD CDB
	MOVE	B,CDB			;COPY CDB ADDR FOR BLT
	JRST	CLCDB			

FNDCH2:	SETZ	D,
FNDCH1:	CAIL	D,JFNSIZE
	   ERR <SETCHN:  JFN TABLE IS FULL (SHOULD NEVER HAPPEN)>
	SKIPE	CDBTBL(D)		;IS IT EMPTY?
	  AOJA	D,FNDCH1	   	;NO LOOK SOME MORE
	JRST	GTCDB			;YES, USE IT


DSCR SIMPLE INTEGER PROCEDURE ZSETST(INTEGER I);

	Internal book-keeping routine not intended for
use from SAIL.  Causes liberation from SAIL.

	THE ARGUMENT IS THE MAXIMUM SIZE OF THE EXPECTED STRING.
THE RETURN IS THE BYTEPOINTER POINTING INTO THE TOP OF STRING SPACE
⊗

HERE(ZSETST)
	MOVE USER,GOGTAB 		; GET USER
	SKIPE	SGLIGN(USER)
	  PUSHJ	P,INSET			;ASSUMING THAT IT IS TRANSPARENT FOR THE ACS
	MOVE	1,-1(P)		;GET EXPECTED LENGTH
	ADDM 1,REMCHR(USER) 		; ADD ON
	SKIPLE REMCHR(USER) 		; NEED TO COLLECT?
	  PUSHJ P,GOCOLLECT 		; YES
	MOVE 1,TOPBYTE(USER) 		; RETURN BP
	SUB P,X22 			; ADJUST STACK
	JRST @2(P) 			; RETURN

GOCOLLECT:	
	MOVEM	RF,RACS+RF(USER)	;SAVE RF
	PUSHJ P,STRNGC ;
	POPJ P, 			; RETURN TO ABOVE

DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
	Internal book-keeping routine.
	ADJUSTS THE PARAMETERS ASSOCIATED WITH STRING SPACE.
BP IS OUR NEW TOPBYTE.  CNTEST IS THE COUNT ESTIMATE WE
ORIGINALLY MADE.
	FIRST, WE MUST MAKE REMCHR HONEST, THEN WE
	CAN FIX TOPSTR AND THE USER'S LENGTH WORD.
⊗
HERE(ZADJST)
	BEGIN ZADJST


	MOVE USER,GOGTAB;	
	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	PUSH	P,4

DEFINE CNTARG <-6(P)>
DEFINE BPARG <-5(P)>

	MOVE	2,BPARG			;UPDATED BP
	MOVE 	1,TOPBYTE(USER) 	; GET OLD TOPBYTE
	CAMN 	1,2 			; THE NULL STRING?
	  JRST NULRET;			;YES
;P. KANERVA'S BYTE ROUTINE
	LDB	3,[POINT 6,1,5]		;BITS TO THE RIGHT OF BYTE 1
	LDB	4,[POINT 6,2,5]		;BITS TO THE RIGHT OF BYTE 2
	SUBI	3,(4)			;BIT DIFFERENCE
	IDIVI	3,7			;WITHIN-WORD BYTE DIFFERENCE
	
	SUBI	2,(1)			;WORDS BETWEEN BYTES
	HRRE	2,2			;FULL WORD DIFFERENCE
	IMULI	2,5			;CONVERT IT TO BYTE DIFFERENCE
	ADD	2,3			;ADD COUNT DERIVED FROM WITHIN-WORD
					;DIFFERENCE

	CAMLE	2,CNTARG		;WITHIN RANGE?
	  ERR <ZADJST:  TENEX WROTE TOO LONG A STRING, MAY BE FATAL>,1
GOTLNG:	HRRO	1,2			; XWD -1,COUNT
	PUSH 	SP,1 			; XWD -1,COUNT
       	PUSH 	SP,TOPBYTE(USER) 	; OLD TOPBYTE FOR BP FOR STRING
	JUMPE	2,NOLNG
	MOVE	1,BPARG
	MOVEM	1,TOPBYTE(USER)
NOLNG:
	SUB 	2,CNTARG		; SUBTRACT THE COUNT ESTIMATE
	ADDM 	2,REMCHR(USER) 		; MAKE REMCHR HONEST
	POP	P,4
	POP	P,3			
	POP	P,2
	POP	P,1
	SUB 	P,X33 			; ADJUST STACK
	JRST @3(P) ;

NULRET:	SETZ 2,;
	JRST GOTLNG 			; BE SURE TO FIX UP ALL THE GOODIES
	
	BEND ZADJST

DSCR
	.RESET
SID	SAVES ALL ACS
CAL	JSP P,.RESET  from SAILOR

	RESETS TENEX IO AND BOOKKEEPING, AND SETS THE TTY MODE TO WAKEUP
ON EVERY CHARACTER.  TTY WAKEUP IS NOT DONE IF THE JOB IS DETACHED.
THIS SHOULD ONLY BE CALLED FROM SAILOR.
⊗
HERE(.RESET)
BEGIN RESET
;ZERO OUT BOOKKEEPING
	SETZM	JFNTBL
	MOVE	1,[XWD JFNTBL,JFNTBL+1]
	BLT	1,JFNTBL+JFNSIZE-1
	SETZM	CDBTBL
	MOVE	1,[XWD CDBTBL,CDBTBL+1]
	BLT	1,CDBTBL+JFNSIZE-1

;RELEASE PAGES ASSOCIATED WITH FILES (FROM STARTPAGE TO STARTPAGE+JFNSIZE-1)
	SETO	1,			;RELEASE PAGE
	SETZ	3,			;FLAGS WORD
	MOVE	2,[XWD 400000,STARTPAGE]
.RESE1:	CAMN	2,[XWD 400000,STARTPAGE+JFNSIZE]	;THIS WOULD BE TOO MANY PAGES
	  JRST .RESE2
	JSYS	PMAP			
	AOJA	2,.RESE1		;NEXT?

.RESE2:
	JSYS RESET		;CLEAR ALL IO

;SET UP PSI SYSTEM
	HRRZI	1,400000	;USE EXISTING TABLE IF THERE
;;	JSYS	RIR
;;	JUMPN	2,.+3		;ALREADY THERE
	MOVE	2,[XWD LEVTAB,CHNTAB]
	JSYS	SIR
	JSYS	EIR		;TURN ON INTERRUPTS

;CHECK AND SEE IF WE ARE DETACHED
	JSYS	GJINF
	CAMN	4,[-1]		;-1 FOR DETACHED JOBS
	  JRST	DTCHED		;YES IT IS DETACHED

;SET PRIMARY INPUT TO WAKE UP ON EVERY CHARACTER
;THE USER MAY RESET THIS.
	MOVEI	1,100		;PRIMARY INPUT
	JSYS RFMOD
	TRO	2,170000	;WAKEUP ON ALL CHARS
	JSYS SFMOD
DTCHED:	SETZM	CTLOSW		;CLEAR OUTPUT-SUPPRESSION SWITCH

	JRST	(P)		;AND RETURN
BEND RESET

;ROUTINE TO CHECK IF A JFN HAS BEEN CLOSED BY ONE OF
;THE DEC-STYLE CLOSE ROUTINES (IN WHICH CASE IT
;MUST BE AVAILABLE FOR RE-OPENING)
;ARGS:
;	1	JFN
;	CDB	THE CHANNEL DATA BLOCK
↑OPNCHK:
	SKIPL	IOSTT(CDB)		;CLOSED BY DEC?
	   POPJ P,			;NO
	PUSH	P,2			;SAVE 2
	MOVE	2,OFL(CDB)		;PREVIOUSLY USED FLAGS
	JSYS	OPENF			;OPEN
	   ERR <OPNCHK:  Cannot OPENF file>,1
	SETZM	IOSTT(CDB)
	POP	P,2			;RESTORE 2
	POPJ	P,			;RETURN

HERE(RDSEG)
	PUSHJ	P,SAVE			;
	MOVE	LPSA,X33		;FOR RESTR BELOW
	HRRZ	A,SEGPAGE*1000 + 12	;ADDRESS OF LAST WORD OF SEGMENT IS HERE
	LSH	A,-=9			;MAKE IT A PAGE NUMBER
	HRLI	A,SEGPAGE		;FIRST PAGE OF SEGMENT
	MOVEM	A,@-2(P)		;STORE
	HRLI	A,STARTPAGE		;FIRST WORD OF BUFFER REGION
	HRRI	A,STARTPAGE+JFNSIZE-1	;LAST PAGE OF BUFFER REGION
	MOVEM	A,@-1(P)		;STORE
	JRST	RESTR			;AND RETURN

ENDCOM(UTILITY)
COMPIL(TTM,<RFMOD,SFMOD,STPAR,STI,RFCOC,SFCOC,GTTYP,STTYP,SETEDIT>
	,<SAVE,RESTR,X22,X33,X44>
	,<TTM -- TERMINAL MODE ROUTINES>)

DSCR INTEGER PROCEDURE RFMOD(INTEGER CHAN)

	Reads a file's mode word.

     PROCEDURE SFMOD(INTEGER CHAN,AC2)

	Sets a file's mode word to argument AC2.

     PROCEDURE STPAR(INTEGER CHAN,BITS)

	Executes the STPAR jsys on CHAN with arguments BITS

     PROCEDURE STI(INTEGER CHAN,CHAR)

	Executes the STI jsys on CHAN with character CHAR.

     PROCEDURE RFCOC(INTEGER CHAN; REFERENCE INTEGER AC2,AC3)

	Does RFCOC jsys, returning values in AC2 and AC3.

     PROCEDURE SFCOC(INTEGER CHAN,AC2,AC3)

	Does SFCOC jsys, setting to AC2 and AC3.

     INTEGER PROCEDURE GTTYP(INTEGER CHAN; REFERENCE INTEGER BUFS)

	Does GTTYP jsys on CHAN/TTY and returns the
	typ information as the value of the call.  BUFS is the
	result from AC 3.

     PROCEDURE STTYP(INTEGER CHAN,NEWTYPE)

	Sets the terminal type of CHAN to NEWTYPE

⊗

HERE(RFMOD)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCH1	1,-1(P),RFMO1
RFMO2:	JSYS	RFMOD
	MOVEM	2,RACS+A(USER)
	JRST	RESTR
RFMO1:	MOVE	1,-1(P)		;USE LITERALLY
	JRST	RFMO2



HERE(SFMOD)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCH1	1,-2(P),SFMO1
SFMO2:	MOVE	2,-1(P)
	JSYS SFMOD
	JRST	RESTR
SFMO1:	MOVE	1,-2(P)
	JRST	SFMO2

HERE(STPAR)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCH1	1,-2(P),STPAR1
STPAR2:	MOVE	2,-1(P)		;PARAMETERS TO SET
	JSYS	STPAR		;EXECUTE JSYS
	JRST	RESTR
STPAR1:	MOVE	1,-2(P)		;USE LITERALLY
	JRST	STPAR2

HERE(STI)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCH1	1,-2(P),STI1
STI2:	MOVE	2,-1(P)
	JSYS	STI
	JRST	RESTR
STI1:	MOVE	1,-2(P)		;USE LITERALLY
	JRST	STI2
	

HERE(RFCOC)
	PUSHJ	P,SAVE
	MOVE	LPSA,X44
	VALCH1	1,-3(P),RFCO1
RFCO2:	JSYS	RFCOC
	MOVEM	2,@-2(P)
	MOVEM	3,@-1(P)
	JRST	RESTR
RFCO1:	MOVE	1,-3(P)		;USE LITERALLY
	JRST 	RFCO2

HERE(SFCOC)
	PUSHJ	P,SAVE
	MOVE	LPSA,X44
	VALCH1	1,-3(P),SFCO1
SFCO2:	MOVE	2,-2(P)
	MOVE	3,-1(P)	
	JSYS	SFCOC
	JRST	RESTR
SFCO1:	MOVE	1,-3(P)		;USE LITERALLY
	JRST	SFCO2

HERE(GTTYP)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCH1	1,-2(P),GTTYP1
GTTYP2:	JSYS	GTTYP
	MOVEM	2,RACS+A(USER)	;TERMINAL TYPE NUMBER FOR RETURN
	MOVEM	3,@-1(P)	;XWD INBUFS, OUTBUFS
	JRST	RESTR
GTTYP1:	MOVE	1,-2(P)		;USE LITERALLY
	JRST	GTTYP2

HERE(STTYP)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCH1	1,-2(P),STTYP1
STTYP2:	MOVE	2,-1(P)		;NEW TERMINAL TYPE
	JSYS	STTYP
	JRST	RESTR
STTYP1:	MOVE	1,-2(P)		;USE LITERALLY
	JRST	STTYP2

HERE(SETEDIT)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCHN	1,-2(P),SETTT1
	SKIPL	2,TTYINF(CDB)	;IS IT THE CONTROLLING TERMINAL?
	  JRST	SETTT2		;NO RETURN(0);
	HRRZ	2,2		;OLD VALUE
	MOVE	2,["B"
		   "D"
		   "T"](2)
	HRRZM	2,RACS+A(USER)	;RETURN OLD VALUE
	MOVE	2,-1(P)		;NEW VALUE
	CAIL	2,"a"
	CAILE	2,"z"
	  JRST 	.+2
	 SUBI	2," "		;UPPER CASE
	CAIN	2,"B"
	  JRST	[MOVEI 2,TNXINP
		 JRST  SETTT3]
	CAIN	2,"D"
	  JRST	[MOVEI 2,DECLED
		 JRST	SETTT3]
	CAIN	2,"T"
	  JRST	[MOVEI 2,TENXED
		 JRST	SETTT3]
	  ERR	<SETEDIT:  Buffering mode must be "B", "D" or "T">,1
	MOVEI	2,TENXED	;ASSUME THIS FOR USER
SETTT3:	HRRM	2,TTYINF(CDB)
	JRST	RESTR		;AND RETURN

SETTT1:	ERR <SETEDIT:  Channel argument must be a SAIL channel>,1
	JRST	RESTR

SETTT2:	SETZM	RACS+A(USER)
	JRST	RESTR

ENDCOM(TTM)

COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
	,<PAGES -- PAGE MANAGEMENT>)
DSCR SIMPLE PROCEDURE PMAP(INTEGER AC1,AC2,AC3);
DESR
	Does the PMAP jsys, with these parameters:

ARGUMENTS:	
	AC1		contents of AC1
	AC2		  "	 of AC2
	AC3		  "	 of AC3

⊗
HERE(PMAP)
	PUSHJ	P,SAVE
	MOVE	LPSA,X44
	MOVE	1,-3(P)			;FILEPAGE
	MOVE	2,-2(P)			;XWD FORK,PAGE
	MOVE 	3,-1(P)			;ACCESS BITS
	JSYS PMAP
	JRST	RESTR
ENDCOM(PAGES)
COMPIL(TT2,<PBTIN,INTTY>
	,<X22,.SKIP.,ZSETST,ZADJST,CTLOSW>
	,<TT2 -- IMSSS TTY ROUTINES>)

DSCR INTEGER SIMPLE PROCEDURE PBTIN(INTEGER SECONDS);
DESR 
	Executes the PBTIN jsys, with timing of SECONDS.
⊗
HERE(PBTIN)
NOIMSSS<
	ERR	<PBTIN:  Only defined at IMSSS>
>;NOIMSSS
	SETZM	CTLOSW			;PROGRAM REQUESTS INPUT
	MOVE	1,-1(P)			;TIME IN SECONDS
	JSYS PBTIN
	SUB	P,X22
	JRST	@2(P)

DSCR STRING SIMPLE PROCEDURE INTTY;
	Using the PSTIN jsys, accepts as many as 200 characters from
the user's Teletype, with the standard system breakcharacters.  The
breakcharacter itself is removed from the string, and
no timing is available.
⊗
IMSSS<
HERE(INTTY)
	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	SETZB	3,CTLOSW		;PROGRAM REQUESTS INPUT
	MOVEI	2,=200			;DEFAULT LENGTH
INTT2:	PUSH	P,2			;LENGTH
	PUSHJ	P,ZSETST		;GET BP IN 1
	JSYS PSTIN
	CAIL	2,=200			;DID WE GET 200 CHARS?
	   JRST	[SETOM	.SKIP.
		 JRST	INTT1]
	LDB	3,1			;GET THE LAST CHAR
	MOVEM	3,.SKIP.		;AND SAVE IT
	SOJ	1,			;BACK UP BYTE-POINTER (OVER LAST CHAR)
	IBP	1
	IBP	1
	IBP	1
	IBP	1
INTT1:	PUSH	P,[=200]
	PUSH	P,1
	PUSHJ	P,ZADJST		;GET STRING ON STACK
	POP	P,3	
	POP	P,2
	POP	P,1
	POPJ	P,			;RETURN
>;IMSSS


NOIMSSS<;NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
;UNDER BBN'S LACK OF A SYSTEM LINE EDITOR

DSCR INTTY
	Simulation of the above routine, doing something
that looks like "TENEX" line editing.
⊗;
HERE(INTTY)
	BEGIN INTTY
ORIGCNT←←=200
;AC USES  A,B,C  JSYS TEMPORARIES
;	  D	 BYTEPOINTER
;	  E	 COUNT, INITIALLY 0
;	  Q1 (=6) ORIGINAL BP


	PUSHJ	P,SAVE
	SETZM	CTLOSW
	MOVEI	A,101
	JSYS	RFMOD
	PUSH	P,B			;SAVE THE TTY MODE
	TRO	B,170000		;WAKEUP ON EVERYTHING
	JSYS	SFMOD
	
	PUSH	P,[ORIGCNT]		;
	PUSHJ	P,ZSETST		;GET A GOOD BP IN A
	MOVE	Q1,A



RESTRT:	MOVE	D,Q1			;GET THE ORIGINAL BP	
	SETZ	E,			;ZERO THE COUNT
INLUP:	CAIL	E,ORIGCNT
	  JRST	CNTEXH			;COUNT EXHAUSTED
INLU1:	JSYS	PBIN			;GET A CHAR
	CAIN	A,15			;CARRIAGE RETURN?
	  JRST	INLU1			;YES, IGNORE
	CAIN	A,37			;EOL?
	  MOVEI	A,12			;MAKE LINEFEED
	CAIN	A,12
	  JRST	DONE			;IS A BREAK CHARACTER
	CAIN	A,33			;ESCAPE?
	  JRST	DONE
	CAIE	A,32			;CTRL-Z
 	CAIN	A,7			;CTRL-G
	  JRST	DONE
	CAIE	A,"R"-100		;CTRL-R FOR REPEAT
	  JRST	NOCTR	
	HRROI	A,[ASCIZ/
/]
	JSYS	PSOUT
	JUMPE	E,INLUP
	MOVEI	A,101
	MOVE	B,Q1			;ORIG BP
	MOVN	C,E			;COUNT THUS FAR
	JSYS	SOUT
	JRST	INLUP			;AND CONTINUE
NOCTR:	CAIE	A,"X"-100		;CONTROL-X FOR DELETE LINE
	  JRST	NOCTX
DOCTX:	HRROI	A,[ASCIZ/
/]
	JSYS	PSOUT
	JRST	RESTRT			;AND START ALL OVER
NOCTX:	CAIE	A,177			;RUBOUT OR
	CAIN	A,"A"-100		;CONTROL-A
	  JRST	.+2
	 JRST	NOCTA
	JUMPLE	E,DOCTX			;IF NO CHARS THEN DO A CONTROL-X
	MOVEI	A,"\"
	JSYS	PBOUT
	LDB	A,D			;LAST CHAR
	JSYS	PBOUT	
	MOVE	A,D
	JSYS	BKJFN
	  JFCL
	MOVEM	A,D			;BACK UP BP
	SOJA	E,INLUP			;SUBTRACT 1 AND CONTINUE
NOCTA:	IDPB	A,D
	AOJA	E,INLUP			;ONE MORE CHAR	

CNTEXH:	SETO	A,			;INDICATE NO COUNT
DONE:	MOVEM	A,.SKIP.		;BREAK CHAR, -1 FOR EXHAUSTED
	PUSH	P,[ORIGCNT]	
	PUSH	P,D			;NEW BP
	PUSHJ	P,ZADJST		;FIX UP STRING SPACE, PUT STRING ON STACK
	MOVEI	A,101
	POP	P,B			;MODE SETTING
	JSYS	SFMOD			;RESET
	MOVE	LPSA,X11
	JRST	RESTR			;AND RETURN

	BEND INTTY
>;NOIMSSS

ENDCOM(TT2)
COMMENT ⊗ TTY FUNCTIONS ⊗


DSCR TTY FUNCTIONS
CAL SAIL
⊗

Comment ⊗
INTEGER PROCEDURE INCHRW;
 RETURN A CHAR FROM PBIN

INTEGER PROCEDURE INCHRS;
 RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (SIBE FOLLOWED BY PBIN)

STRING PROCEDURE INCHWL;
 WAIT FOR A LINE, THEN RETURN IT (PBINs, LINE EDITING)

STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
 FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0, 
	STR←LINE (SIBE, FOLLOWED BY PBINs)

STRING PROCEDURE INSTR(INTEGER BRCHAR);
 RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (PBINs)

STRING PROCEDURE INSTRL(INTEGER BRCHAR);
 WAIT FOR ONE LINE, THEN DO INSTR (PBINs WITH EDITING)

STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
 FLAG←-1, STR←NULL IF NO LINES, ELSE FLAG←0, 
  STR←INSTR(BRCHAR)


PROCEDURE OUTCHR(INTEGER CHAR);
 OUTPUT CHAR (PBOUT)

PROCEDURE OUTSTR(STRING STR);
 OUTPUT STR (SOUT)


PROCEDURE CLRBUF;
 CLEARS INPUT BUFFER (CFIBF)

TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
 TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
 ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
 TTYINL DOES A WAIT FOR LINE FIRST.
 FULL BREAKSET CAPABILITIES EXCEPT FOR 
 "R" MODE (AND OF COURSE, LINE NUM. STUFF)

	TITLE	TTYUUO
⊗

COMPIL(TTY,<PBIN,PBOUT,PSOUT,INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL,TTYUP
>
	  ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.,CTLOSW>
	  ,<TELETYPE FUNCTIONS>)
;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
; .SKIP. EXTERNAL ABOVE
;;#GF#
 
HERE(PBIN)
HERE (INCHRW)
	SETZM	CTLOSW		;INPUT REQUESTED
INCHR1:	JSYS PBIN
	POPJ	P,

HERE (INCHRS)
	SETZM	CTLOSW		;INPUT REQUESTED
	MOVEI	1,100
	JSYS SIBE
	   JRST	INCHR1
	SETO	1,		;RETURN -1
	POPJ	P,

HERE(PBOUT)
HERE (OUTCHR)	
	SKIPE	CTLOSW		;DOING OUTPUT?
	  JRST	OUTCRE		;NO
	EXCH	1,-1(P)		;GET PARAMETER, SAVING AC 1
	JSYS PBOUT			;OUTPUT CHAR	
	EXCH	1,-1(P)		;GET BACK 1	
OUTCRE:	SUB	P,X22
	JRST	@2(P)		;RETURN


HERE(PSOUT)
HERE (OUTSTR)
	SKIPE	CTLOSW		;DOING OUTPUT?
	  JRST	[SUB SP,X22
		 POPJ P,
		]
	EXCH	2,(SP)		;BP WORD
	EXCH	3,-1(SP)	;LENGTH WORD
	PUSH	P,1		;ALSO NEED 1
	HRRZ	3,3		;COUNT
	JUMPE	3,NULSTR	;DONT SEND EMPTY STR
	MOVEI	1,101		;TERMINAL OUTPUT
	MOVN	3,3
	JSYS SOUT
NULSTR:	POP	P,1
	POP	SP,2
	POP	SP,3		;ADJUSTS STACK AUTOMATICALLY
	POPJ 	P,		;RETURN

;REDSTR (0) MARKS CTLOSW THAT INPUT WAS REQUESTED
;(1) PREPARES TO MAKE A STRING OF 200 CHARS, 
;(2) ZEROS C FOR COUNT
;(3) SETS UP D WITH THE ORIGINAL BYTE-POINTER

REDSTR:	SETZM	CTLOSW		;INPUT REQUESTED
	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVEI	A,=200
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)
	PUSHJ	P,STRNGC
	SETZ	C,		;COUNT HERE
	MOVE	D,TOPBYTE(USER)	;ORIGINAL BYTE-POINTER, IF NEEDED
	PUSH	SP,[0]		;NULL STRING IF NOTHING DONE
	PUSH	SP,TOPBYTE(USER)
	POPJ	P,

FINSTR:	MOVEI	A,=200
	SUB	A,C		;NUMBER USED
	ADDM	A,REMCHR(USER)
	HRROM	C,-1(SP)	;STRING COUNT WORD
	MOVEM	D,TOPBYTE(USER)	;NEW TOPBYTE
	JRST	RESTR

;CALL TO HERE WITH A PUSHJ TO GET A CHAR IN AC1
;AC 3 HAS THE COUNT, D THE BYTE-POINTER
EDICHR:
	JSYS PBIN			;GET A CHARACTER
	CAIN	1,DELLINE	;DELETE LINE CHAR
	   JRST	CTRLU
	CAIN	1,RUBCHAR	;RUBOUT?
	   JRST	RUBOUT
	CAIN	1,37		;PHONEY TENEX EOL?
	   MOVEI 1,12
	CAIN	1,33		;PHONEY TENEX ALTMODE?
	  MOVEI 1,ALTMODE	;DEC ALTMODE
	POPJ	P,		;GOOD CHAR FOR USER
	
CTRLU:	
;AC 1 IS FREE
	HRROI	1,[BYTE (7) 7,15,12,0,0]
	JSYS PSOUT	
	JUMPE	C,EDICHR	;IF NO CHARS THEN DO NOTHING
	SETZ	C,
	MOVE	D,TOPBYTE(USER)
	JRST	EDICHR

RUBOUT:	JUMPE	C,CTRLU		;IF NO CHARS THEN DO CTRLU
;AC 1 IS AVAILABLE
IMSSS<
	MOVEI	1,101		;PRIMARY OUTPUT
	JSYS	DELCH
	  JFCL
	  JRST	DLTED		;DISPLAY -- LINE EMPTY
	  JRST	DLTED		;DISPLAY -- DELETE DONE
>;IMSSS
	MOVEI	1,"\"
	JSYS PBOUT
	LDB	1,D		;GET LAST CHAR
	JSYS PBOUT			;AND SEND IT
DLTED:
	SOJ	D,		;BACK UP BP TO LAST CHAR
	IBP	D
	IBP	D
	IBP	D
	IBP	D
	SOJA	C,EDICHR	;AND GET ANOTHER CHAR

HERE(INSTRL)
HERE (INSTR) 
	PUSHJ	P,SAVE
	PUSHJ	P,REDSTR
	MOVE	B,-1(P)		;BREAK CHAR
	MOVE	LPSA,X22	;# TO REMOVE

INS1:	CAIL	C,=200		;COUNT EXHAUSTED?
	 JRST	FINSTR		;YES
INS2:	PUSHJ	P,EDICHR	;GET A CHAR IN 1, USING EDITING
	CAMN	1,B		;BREAK?
	 JRST	 FINSTR		; YES, ALL DONE
	IDPB	1,D		;PUT IT AWAY AND
	AOJA	C,INS1

HERE (INCHWL)	PUSHJ	P,SAVE
	PUSHJ	P,REDSTR
	MOVE	LPSA,X11

INS3:	CAIL	C,=200		;COUNT EXHAUSTED?
	  JRST	DNSTR1		;YES
	PUSHJ	P,EDICHR	;GET A CHAR
	CAIE	1,ALTMODE
	CAIN	1,12
	   JRST	DNSTR
	CAIN	1,15		;CR?	
	   JRST	INS3		;IGNORE
	IDPB	1,D		;PUT IT AWAY AND
	AOJA	C,INS3		;NEXT CHARACTER

DNSTR:	MOVEM	1,.SKIP.	;SET BREAK CHAR
	JRST	FINSTR
DNSTR1:	SETOM	.SKIP.		;INDICATE COUNT EXHAUSTED
	JRST	FINSTR


HERE (INCHSL)	PUSHJ	P,SAVE
	MOVE	LPSA,X22	;PARAM (FLAG) AND RETURN
	PUSHJ	P,REDSTR
	SETOM	@-1(P)		;ASSUME FAILED
	MOVEI	1,100		;PRIMARY INPUT
	JSYS SIBE			;CHARACTERS WAITING?
	    SKIPA		;YES
	JRST	FINSTR		;NO, FIX UP AND RETURN
	SETZM	@-1(P)
	JRST	INS3		;AND USE INCHWL'S LOOP

	
HERE(INSTRS)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	PUSHJ	P,REDSTR
	SETOM	@-2(P)		;ASSUME FAILED
	MOVEI	1,100		;RIMARY INPUT
	JSYS SIBE			;CHARACTERS WAITING
	   SKIPA		;YES
	JRST	FINSTR		;NO, FIX UP AND RETURN	
	SETZM	@-2(P)		;INDICATE SUCCESS
	MOVE	B,-1(P)		;GET BREAK CHARACTER	
	JRST	INS2

HERE (CLRBUF)
	PUSH	P,1
	MOVEI	1,100		;PRIMARY INPUT
	JSYS CFIBF			;CLEAR BUFFER
	POP	P,1
	POPJ	P,

HERE (TTYINS) PUSHJ	P,SAVE
	PUSHJ	P,REDSTR	;PREPARE TO MAKE A STRING
	MOVE	LPSA,X33
	SETOM	@-1(P)		;ASSUME NO CHARS
	MOVEI	1,100		;PRIMARY INPUT
	JSYS SIBE			;CHARS WAITING?
	   SKIPA		;YES
	JRST	FINSTR		;NONE WAITING
	JRST	TYIN1		;GO AHEAD


HERE(TTYINL)
HERE (TTYIN)	PUSHJ	P,SAVE
TYIN:	PUSHJ	P,REDSTR		;PREPARE STACK,A,STRNGC FOR A STRING
	MOVE	LPSA,X33		;PREPARE TO RETURN
TYIN1:	SETZM	@-1(P)		;ASSUME NO BREAK CHAR
	MOVE	X,-2(P)		;TABLE #
	MOVEI	TEMP,-1		;BLOCK MUST BE THERE AND TABLE MUST BE INIT'ED
	PUSHJ	P,BKTCHK		;CHECK TABLE #
	 JRST	FINSTR		;ERROR
	MOVE	FF,BRKMSK(CHNL)	;BITS FOR THIS TABLE
	ADD	CHNL,CDB	;RELOCATE RANGE 1 TO 18
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(CHNL)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
	MOVE	Y,CDB
	ADD	Y,[XWD 1,BRKTBL] ;BRKTBL+RLC(CDB)
TTYN:	CAIL	C,=200		;COUNT EXCEEDED?
	   JRST	FINSTR		;YES
	PUSHJ	P,EDICHR	;GET A CHAR
TTYN1:	TDNE	FF,@Y		;BREAK OR OMIT?
	JRST	TTYSPC		; YES, FIND OUT WHICH
TTYC:	IDPB	1,D		;PUT IT AWAY
	AOJA	C,TTYN		;COUNT AND CONTINUE
	JRST	FINSTR		;DONE
TTYSPC:	HLLZ	TEMP,@Y		;WHICH?
	TDNN	TEMP,FF
	JRST	TTYN		;OMIT
	MOVEM	1,@-1(P)
	SKIPN	Y,DSPTBL(CHNL)	;WHAT TO DO WITH IT
	JRST	FINSTR		;DONE, NO SAVE
	JUMPL	Y,TTYAPP	;APPEND
	PUSH	P,1		;SAVE 
	MOVEI	1,100		;PRIMARY INPUT
	JSYS BKJFN
	  ERR	<CAN'T RETAIN BREAK CHAR FROM TTYIN>,1
	POP	P,1
	JRST	FINSTR		;AND RETURN
TTYAPP:	IDPB	1,D		;COUNT THE BREAK CHAR
	ADDI	C,1		;ONE MORE HAPPY CHAR
	JRST	FINSTR


DSCR INTEGER PROCEDURE TTYUP(INTEGER NEWVALUE)

	Using the RFMOD and SFMOD jsyses, sets lower-to-upper
case conversion to NEWVALUE, returning the oldvalue.  Tests
and modifies bit 31 of the RFMOD word for the primary input
file.	
⊗;
HERE(TTYUP)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22		;SET FOR RETURN
	MOVEI	A,101			;PRIMARY INPUT FILE
	JSYS	RFMOD			;GET THE CURRENT SETTINGS
	SETZ	C,			;ASSUME NOT CURRENTLY SET
	TRNE	B,1B31			;IS IT SET?
	  SETO	C,			;IT WAS
	MOVEM	C,RACS+A(USER)	
	MOVE	C,[TRO B,1B31]		;ASSUME WE WANT TO SET UP
	SKIPN	-1(P)			;DID WE REALLY?
	  MOVE	C,[TRZ B,1B31]		;NO, DONT
	XCT	C
	JSYS	STPAR
	JRST	RESTR			;AND RETURN


ENDCOM(TTY)
COMPIL(PTY)
ENDCOM(PTY)

COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
COMMENT ⊗Filnam ⊗

DSCR FILNAM
CAL PUSHJ
PAR file name string on SP stack
 of form FILENAME<.EXT><[PROJ,PROG]>
RES FNAME(USER) : SIXBIT /filename/
 EXT(USER): SIXBIT /extension,,0/
 0
 PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
⊗

↑↑FILNAM:
	SUB	SP,X22		;ADJUST STACK
	FOR II←1,3 <
	SETZM	FNAME+II(USER)>
	MOVEI	X,FNAME(USER)	;WHERE TO PUT IT
	PUSHJ	P,FLSCAN	;GET FILE NAME
	JUMPE	Y,FLDUN	;FILE NAME ONLY
	CAIE	Y,"."		;EXTENSION?
	JRST	FLEXT		;NO, CHECK PPN
	MOVEI	X,FNAME+1(USER)
	PUSHJ	P,FLSCAN
FLEXT:	JUMPE	Y,FLDUN	;NO PPN SPECIFIED
	CAIE	Y,"["
	JRST	FLERR		;INVALID CHARACTER
	PUSHJ	P,[

	RJUST:	SETZM	PROJ(USER)
		MOVEI	X,PROJ(USER)
		PUSHJ	P,FLSCAN	;GET PROJ OR PROG IN SIXBIT
IFN SIXSW,<
		MOVE	X,PROJ(USER)
		IMULI	D,-6		;SHIFT FACTOR
		LSH	X,(D)		;RIGHT-JUSTIFY THE PROJ OR PROG
>;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
	
IFE SIXSW,<
		MOVEI	X,0
;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
		MOVE	D,PROJ(USER)	;WAS A HLLZ
;;
	FBACK:	MOVEI	C,0
		LSHC	C,6		;GET A SIXBIT CHAR
		CAIL	C,'0'
		CAILE	C,'7'
		JRST	FLERR		;INVALID OCTAL
		LSH	X,3
		IORI	X,-'0'(C)
		JUMPN	D,FBACK
>;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
	FPOP:	POPJ	P,]

	HRLZM	X,FNAME+3(USER)
	CAIE	Y,","
	JRST	FLERR		;INVALID CHAR
	PUSHJ	P,RJUST		;JUSTIFY(AND CONVERT IF EXPORT) PROG #
	HRRM	X,FNAME+3(USER)
	CAIN	Y,"]"
FLDUN:	AOS	(P)		;SUCCESSFUL
FLERR:	POPJ	P,		;DONE, NOT NECESSARILY RIGHT

ENDCOM(FIL)
COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
COMMENT ⊗Flscan ⊗

DSCR FLSCAN
CAL PUSHJ
PAR X -- addr of destination SIXBIT
 1(SP), 2(SP) -- input string
RES sixbit for next filename, etc in word addressed by X
 break (punctuation) char in Y (0 if string exhausted)
 D,X, input string adjusted
SID only those AC changes listed above (Y, for instance)
⊗

↑↑FLSCAN:  
	HRRZS	1(SP)		;WANT ONLY LENGTH PART
	MOVEI	D,6		;MAX NUMBER PICKED UP
	SETZM	(X)		;ZERO DESTINATION
	HRLI	X,440600	;BYTE POINTER NOW
FLN1:	MOVEI	Y,0		;ASSUME NO STRING LEFT
	SOSGE	1(SP)		;TEST 0-LENGTH STRING
	 POPJ	 P,
	ILDB	Y,2(SP)		;GET BYTE
	CAIE	Y,"."		;CHECK VALID BREAK CHAR
	CAIN	Y,"["
	POPJ	P,
	CAIE	Y,"]"
	CAIN	Y,","
	POPJ	P,
	JUMPE	D,FLN1		;NEED NO MORE CHARS
	TRZN	Y,100		;MOVE 100 BIT TO 40 BIT
	TRZA	Y,40		; TO CONVERT TO SIXBIT
	TRO	Y,40		; (NO CHECKING)
	IDPB	Y,X		;PUT IT AWAY
	SOJA	D,FLN1		;CONTINUE

ENDCOM(FLS)
COMPIL(CAS,<CSERR,LPRYER>,<GOGTAB>
	  ,<CSERR, LPRYER -- SUPPORT ROUTINES>)
HERE(CSERR)	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)	;STANDARD PLACE
	ERR	<CASE INDEX OVERFLOW, VALUE IS >,13
	JRST	@UUO1(USER)	;RETURN OK

HERE (LPRYER) ERR	<DATUM OF ARRAY NOT THERE>,1
	POPJ	P,

ENDCOM(CAS)


IFN ALWAYS, <BEND IOSER>
DSCR BEND IOSER ⊗
>;TENX