Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0002/ioser.tnx
There is 1 other file named ioser.tnx in the archive. Click here to see a list.
00100	COMMENT    VALID 00112 PAGES
00200	C REC  PAGE   DESCRIPTION
00300	C00001 00001
00400	C00010 00002	TENX<THE ENTIRE FILE IS FOR TENEX ONLY
00500	C00013 00003	DSCR IOSTT(CDB) values.
00600	C00016 00004
00700	C00020 00005	COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,TENXFI,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
00800	C00029 00006	DSCR  PROCEDURE LOOKUP(INTEGER CHNL STRING FILE REFERENCE INTEGER FLAG)
00900	C00033 00007	HERE(ENTER)
01000	C00036 00008	DSCR
01100	C00039 00009	DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
01200	C00041 00010	DSCR	PROCEDURE CLOSE(INTEGER CHANNEL,[CLOSEINHIBITBITS])
01300	C00042 00011	HERE(RELEASE)
01400	C00043 00012	DSCR	
01500	C00044 00013	DSCR	STRING PROCEDURE TENXFI(STRING DECFILE)
01600	C00048 00014	DSCR
01700	C00050 00015	COMPIL(JOBINF,<ODTIM,IDTIM,RUNTM,GTAD,GJINF>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
01800	C00051 00016
01900	C00052 00017	DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK REFERENCE INTEGER CONSOLE)
02000	C00053 00018	DSCR INTEGER SIMPLE PROCEDURE GTAD
02100	C00054 00019	DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO)
02200	C00055 00020	ENDCOM(JOBINF)
02300	C00056 00021	COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
02400	C00058 00022	DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
02500	C00060 00023	COMPIL(RUNPRG,<RUNPRG>,<X22,X33,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
02600	C00065 00024	COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE,SETCHAN>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
02700	C00074 00025	DSCR PROCEDURE SETINPUT(INTEGER CHAN REFERENCE INTEGER COUNT,BR,EOF)
02800	C00075 00026	DSCR
02900	C00077 00027	DSCR
03000	C00079 00028	DSCR SETCHAN(JFN,GTFLAGS,OPFLAGS)
03100	C00080 00029	COMPIL(GTJFN,<GTJFN,GTJFNL>,<.SKIP.,SETCHN,CATCHR,X11,X22,X44>,<GTJFN -- GET A JFN>)
03200	C00082 00030	DSCR INTEGER PROCEDURE GTJFNL(STRING ORIG INTEGER FLAGS, XWDJFN!JFN
03300	C00085 00031	COMPIL(FILINF,<GNJFN,DELF,UNDELETE,DELNF,SIZEF,JFNS,JFNSL,OPENF,CFILE,CLOSF,RLJFN,GTSTS,STSTS,RNAMF>
03400	C00087 00032	DSCR	PROCEDURE DELF(INTEGER CHAN)
03500	C00089 00033	DSCR	PROCEDURE UNDELETE(INTEGER CHAN)
03600	C00090 00034	DSCR	INTEGER PROCEDURE SIZEF(INTEGER JFN)
03700	C00091 00035
03800	C00093 00036	DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
03900	C00095 00037
04000	C00098 00038	DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
04100	C00100 00039	DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
04200	C00101 00040	DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN)
04300	C00102 00041	DSCR BOOLEAN SIMPLE PROCEDURE STSTS(INTEGER JFN,STATUS)
04400	C00103 00042	DSCR BOOLEAN SIMPLE PROCEDURE RNAMF(INTEGER EXISTINGJFN,NEWJFN)
04500	C00104 00043	COMPIL(DEVINF,<CNDIR,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST,GTFDB,CHFDB>
04600	C00106 00044	DSCR BOOLEAN PROCEDURE ASND(INTEGER DEVICE)
04700	C00107 00045	DSCR BOOLEAN PROCEDURE RELD(INTEGER DEVICE)
04800	C00108 00046	DSCR INTEGER SIMPLE PROCEDURE GDSTS(INTEGER CHAN REFERENCE INTEGER WORDCNT)
04900	C00109 00047	DSCR PROCEDURE SDSTS(INTEGER JFN,NEWSTATUS)
05000	C00110 00048	DSCR INTEGER PROCEDURE STDEV(STRING S)
05100	C00111 00049
05200	C00112 00050	DSCR	SIMPLE PROCEDURE GTFDB(INTEGER JFN REFERENCE INTEGER ARRAY BUF)
05300	C00113 00051
05400	C00114 00052	DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN)
05500	C00116 00053	HERE(ARRYIN)
05600	C00120 00054	HERE(WORDOUT)
05700	C00122 00055	HERE(ARRYOUT)
05800	C00125 00056
05900	C00127 00057	HERE(SWDPTR)
06000	C00129 00058
06100	C00136 00059	SETWPT:
06200	C00140 00060	SETWIO:
06300	C00141 00061	ADWI:	
06400	C00143 00062	DSCR  CHAR_CHARIN(CHANNEL)
06500	C00146 00063	DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR)
06600	C00150 00064	Input 
06700	C00158 00065	.DOINP:	PUSHJ	P,DOINP
06800	C00159 00066
06900	C00163 00067	Realin, Realscan 
07000	C00170 00068	NUMIN -- CONTD.
07100	C00177 00069	LNUMIN	NUMBER INPUT
07200	C00188 00070
07300	C00190 00071	DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
07400	C00191 00072
07500	C00193 00073
07600	C00196 00074	DSCR	PROCEDURE LINOUT(INTEGER JFN,VALUE)
07700	C00199 00075	HERE(RCHPTR)
07800	C00200 00076	HERE(SCHPTR)
07900	C00202 00077	DSCR	Auxiliary routines for character i/o.
08000	C00208 00078	SETCPT:
08100	C00211 00079	SETCIO:
08200	C00212 00080	DSCR
08300	C00225 00081	DSCR 	ADCO,ADCO1
08400	C00229 00082	DSCR SETIO
08500	C00236 00083	DSCR
08600	C00239 00084	ENDCOM(IOROU)
08700	C00240 00085	DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
08800	C00241 00086	DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
08900	C00242 00087	DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
09000	C00243 00088	DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
09100	C00244 00089	DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN)
09200	C00245 00090	COMPIL(DSKOPS,<DSKIN,DSKOUT>
09300	C00247 00091	DSCR SIMPLE PROCEDURE 
09400	C00248 00092	COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR>
09500	C00249 00093	DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN REFERENCE INTEGER AC1,AC3)
09600	C00250 00094	DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
09700	C00252 00095	COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET,RDSEG>
09800	C00258 00096	DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
09900	C00261 00097	DSCR
10000	C00265 00098	COMPIL(TTM,<RFMOD,SFMOD,STPAR,STI,RFCOC,SFCOC,GTTYP,STTYP,SETEDIT>
10100	C00271 00099	COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
10200	C00272 00100	COMPIL(TT2,<PBTIN,INTTY>
10300	C00273 00101	DSCR STRING SIMPLE PROCEDURE INTTY
10400	C00275 00102	NOIMSSS<NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
10500	C00279 00103	 TTY FUNCTIONS 
10600	C00282 00104	HERE(PBIN)
10700	C00292 00105	Filnam 
10800	C00295 00106	Flscan 
10900	C00297 00107	COMPIL(CAS,<CSERR,LPRYER>,<GOGTAB>
11000	C00298 00108	
11100	C00299 00109
11200	C00300 00110
11300	C00301 00111
11400	C00302 00112
11500	C00303 ENDMK
11600	C;
     
00100	TENX<;THE ENTIRE FILE IS FOR TENEX ONLY
00200	COMMENT  TENEX-IOSER -- R. SMITH 
00300		LSTON	(IOSER)
00400	
00500	
00600	IFN ALWAYS, <BEGIN IOSER>
00700	
00800	COMMENT  INDICES, BITS FOR TENEX VERSION OF IOSER 
00900	
01000	
01100	;WORDS IN CDB BLOCK FOR EACH CHANNEL
01200	
01300	
01400	?GFL__0				;FLAGS FOR GTJFN
01500	?OFL__1				;FLAGS FOR OPENF
01600	?BRCHAR__2			;BRCHAR ADDRESS
01700	?ICOUNT__3			;COUNT ADDRESS
01800	?ENDFL__4			;EOF ADDRESS
01900	?IOCNT__5			;I/O COUNT
02000	?IOBP__6			;I/O BP
02100	?IOSTT__7			;STATUS OF THE IO (SEE FLAGS BELOW)
02200	?IOADDR__10			;ADDRESS OF THE IO BUFFER IF THERE IS ONE
02300	?DVTYP__11				;DEVICE TYPE
02400	?DVDSG__12			;DEVICE DESIGNATOR
02500	?OPNDUN__13			;TRUE IF OPENED WITH THE OPEN STATEMENT
02600	?DVCH__14			;DEVICE CHARACTERISTICS
02700	?DMPED__15			;TRUE IF DUMP MODE OUTPUT SEEN
02800					;IN PARTICULAR USED TO NOTE IF A MAGTAPE
02900					;HAS BEEN WRITTEN BUT NOT YET CLOSED,
03000					;SINCE EOF'S ARE WRITTEN AT THE CLOSE
03100					;BY CLOSF,CFILE,CLOSE,ETC.
03200	?LINNUM__16			;LINE NO (FOR INPUT FUNCTION)
03300	?PAGNUM__17			;PAGE NO (FOR INPUT FUNCTION)
03400	?SOSNUM__20			;SOS LINE NO (FOR INPUT FUNCTION)
03500	?FKPAGE__21			;XWD FORK,PAGE FOR PMAPPING TO DSK
03600	?IOPAGE__22			;PAGE OF THE FILE (IF PMAPPED)
03700	?FDBSZ__23			;BYTE SIZE OF FILE AS IN FDB
03800	?FDBEOF__24			;NO. OF BYTES TO EOF AS IN FDB
03900	?TTYINF__25			;TTY BUFFERING INFO--
04000	CRYPT<
04100	?DCRYPT__26			;[06] Addr of input decryption routine
04200	?NCRYPT__27			;[06] Addr of output encryption routine
04300	>; CRYPT
04400	
04500	;ADDITIONS TO CDB NUMBERS SHOULD INCLUDE CHANGE TO TIOTLN BELOW
04600	
04700	NOCRYPT<
04800	?TIOTLN__26			;CURRENT LENGTH OF CDB BLOCK
04900	>; NOCRYPT
05000	
05100	CRYPT<
05200	?TIOTLN__30			;CURRENT LENGTH OF CDB BLOCK
05300	>; CRYPT
05400	
     
00100	DSCR IOSTT(CDB) values.
00200		The following numbers can be in IOSTT(CDB).  They indicate
00300	the current state of the IO for the associated channel.
00400		These numbers are set up by SETIO, which is called by
00500	the first IO that happens on the channel.  Each routine has
00600	a dispatch table, usually called TABL, and the SIMIO macro
00700	does an XCT on those tables.
00800	
00900	
01000	?XNULL__0			;NOTHING HAPPENING YET
01100	?XICHAR__1			;PMAPPING INPUT CHARS
01200	?XOCHAR__2			;PMAPPING OUTPUT CHARS
01300	?XIWORD__3			;PMAPPING INPUT WORDS
01400	?XOWORD__4			;PMAPPING OUTPUT WORDS
01500	?XCICHAR__5			;36 BIT BUFFERING, INPUT CHARS
01600	?XCOCHAR__6			;36 BIT BUFFERING, OUTPUT CHARS
01700	?XCIWORD__7			;36 BIT BUFFERING, INPUT OR OUTPUT WORDS
01800	?XBYTE7__10			;7 BIT BIN, SIN ETC
01900	?XDICHAR__11			;DUMP MODE CHARACTER INPUT
02000	?XDOCHAR__12			;DUMP MODE CHARACTER OUTPUT
02100	?XDARR__13			;DUMP MORE ARRAY INPUT OR OUTPUT
02200	
02300	DEFINE SIMIO(AC,TABL,ERR) <
02400		SKIPGE	AC,IOSTT(CDB)	
02500		  JRST [PUSHJ	P,OPNCHK
02600			MOVE	AC,IOSTT(CDB)	
02700			JRST	.+1]
02800		CAILE	AC,13		;MAXIMUM THAT IOSTT CAN BE
02900		  JRST	ERR
03000		XCT	TABL(AC)
03100	>;SIMIO
03200	
03300	DEFINE CHKDECCLZ <
03400		SKIPGE	IOSTT(CDB)
03500		  PUSHJ P,OPNCHK
03600	>;CHKDECCLZ
03700	
03800	DEFINE SETZEOF <
03900		SETZM	.SKIP.
04000		SKIPE	ENDFL(CDB)
04100		  SETZM	@ENDFL(CDB)
04200	>;SETZEOF
04300	
04400	DEFINE SETOEOF <
04500		SETOM	.SKIP.
04600		SKIPE	ENDFL(CDB)
04700		  SETOM	@ENDFL(CDB)
04800	>;SETOEOF
04900	
05000	
     
00100	
00200	IFNDEF JFNSIZE, <?JFNSIZE__20>			;NUMBER OF CHANNELS ALLOWED
00300	?DMOCNT__200			;(DEFAULT) COUNT FOR DUMP MODE OUTPUT
00400	IFNDEF STARTPAGE,<?STARTPAGE__610			;STARTING PAGE FOR BUFFERS>
00500	
00600	;BITS FOR SCAN FLAGS FOR OPENFILE ROUTINE
00700	;THE BITS OF THE FLAGS WORD ARE THE SAME AS THE BITS OF GTJFN AND OPENF
00800	;HOPEFULLY (WHERE APPLICABLE)
00900	
01000	?STARBIT__1B11			;B11 OF GTJFN FOR INDEXED FILES
01100	?TEMBIT__1B5			;B5 OF GTJFN FOR TEMPORARY FILE
01200	?DELBIT__1B8			;GTJFN -- IGNORE DELETED BIT
01300	?RDBIT__1B19			;B19 OF OPENF FOR READING
01400	?WRBIT__1B20			;B20 OF OPENF FOR WRITING
01500	?APPBIT__1B22			;B22 OF OPENF FOR APPEND
01600	?CONFB1__1B3			;GTJFN BIT TO PRINT [CONFIRM] ETC
01700	?CONFB2__1B4			;GTJFN BIT TO REQUIRE CONFIRMATION FROM USER
01800					;ODDLY ENOUGH 3 AND 4 ARE ILLEGAL
01900	?OUTBIT__1B0			;GTJFN -- FILE FOR OUTPUT USE
02000	?OLDBIT__1B2			;GTJFN -- OLD FILE
02100	?NEWBIT__1B1			;GTJFN -- NEW FILE
02200	?ERTNBIT__1B27			;ERROR RETURN BIT -- INTERNAL
02300	?BINBIT__1B26			;BINARY BIT -- INTERNAL
02400	?THAWBIT__1B25			;THAWBIT GTJFN
02500	?ERSNBIT__1B28			;ERROR SEEN -- INTERNAL
02600	?CONFBIT__1B29			;CONFIRMATION -- INTERNAL
02700	?UPDBIT__1B30			;[CLH] UPDATE - INTERNAL
02800	
02900	;MACROS FOR BIT TESTING
03000	
03100	DEFINE .ZZZ $ (X,Y,Z)<
03200	IFN Z&777777000000, <TL$X Y,Z-=18>	;Z LSH -=18
03300	IFN Z&777777, <TR$X Y,Z>
03400	>
03500	
03600	DEFINE TESTE (Y,Z) <.ZZZ NE,Y,Z>	;TDNE Y,[Z]
03700	DEFINE TESTN (Y,Z) <.ZZZ NN,Y,Z>	;TDNN Y,[Z]
03800	DEFINE TESTO (Y,Z) <.ZZZ O,Y,Z>		;TDO Y,[Z]
03900	DEFINE TESTZ (Y,W) <.ZZZ Z,Y,W>		;TDZ Y,[Z]
04000	
04100	
04200	;MACRO TO GET THE JFN NUMBER IN X FROM Y.  IF INVALID, JUMP TO LABEL Z
04300	;LOADS CDB (I.E., 11) WITH THE CDB ADDRESS
04400	;LOADS CHNL WITH THE CHANNEL NUMBER
04500	DEFINE VALCHN(X,Y,Z) <
04600	
04700		SKIPL	CHNL,Y
04800		CAIL	CHNL,JFNSIZE
04900		  JRST	Z	
05000		MOVE	CDB,CDBTBL(CHNL)
05100		HRRZ	X,JFNTBL(CHNL)
05200		JUMPE	X,Z
05300	>;VALCHN
05400		
05500	DEFINE LITCHN(X,Y,Z) <
05600		SKIPL	X,Y
05700		CAIL	X,JFNSIZE
05800		  JRST 	Z
05900		MOVEM	X,CHNL
06000		MOVE	CDB,CDBTBL(CHNL)
06100		HRRZ	X,JFNTBL(CHNL)
06200	>;LITCHN 
06300	
06400	;ONLY USES AC X
06500	DEFINE VALCH1(X,Y,Z) <
06600		SKIPL	X,Y
06700		CAIL	X,JFNSIZE
06800		   JRST	Z
06900		HRRZ	X,JFNTBL(X)
07000		JUMPE	X,Z
07100	>
07200	
07300	;TTY STUFF
07400	;FOR DEC-STYLE I/O
07500	;CHAR FOR LINE DELETION (DELLINE) AND CHARACTER DELETION (RUBCHAR)
07600	IFNDEF DELLINE,<?DELLINE__"U"-100>	;CTRL-U	
07700	IFNDEF RUBCHAR,<?RUBCHAR__177>		;RUBOUT
07800	IFNDEF ALTMODE,<?ALTMODE__33	;ONE OF MANY VERSIONS>
07900	
08000	DSCR
08100		TTYINF for information about the controlling terminal.
08200	
08300	
08400	?ISCTRM__ 1B0				;CHANNEL IS THE CONTROLLING TERM
08500	?TNXINP__ 0				;DO STANDARD TENEX INPUT
08600	?DECLED__ 1				;DO DEC-STYLE INPUT
08700	?TENXED__ 2				;DO TENEX-STYLE INPUT
08800	?QTTEOF__1B17				;QUE AN EOF FOR THE TTY
     
00100	COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,TENXFI,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
00200		,<SAVE,RESTR,RELEASE,CORGET,INSET>
00300		,<PAT -- TENEX ROUTINES EMULATING DEC CALLS>)
00400	
00500		BEGIN PAT
00600	
00700	DSCR	PROCEDURE OPEN(INTEGER CHAN; STRING DEV; INTEGER MODE,IBUF,OBUF;
00800		REFERENCE INTEGER COUNT,BR,EOF)
00900	
01000	HERE(OPEN)
01100		BEGIN OPEN
01200	GTFLAGS__4
01300	OPFLAGS__5
01400		PUSH	P,-7(P)
01500		PUSH	P,[0]				;CLOSE INHIBIT
01600		PUSHJ	P,RELEASE			;RELEASE IF ALREADY OPEN
01700	
01800	;SEE WHAT KIND OF DEVICE WE HAVE
01900	
02000		PUSH	SP,-1(SP)
02100		PUSH	SP,-1(SP)
02200		PUSH	P,[0]
02300		PUSHJ	P,CATCHR		;PUT ON A NULL CHAR
02400		PUSHJ	P,MAKUP			;MAKE UPPER CASE (DAMMIT)
02500		PUSH	SP,-3(SP)
02600		PUSH	SP,-3(SP)
02700		PUSH	SP,[3]
02800		PUSH	SP,[POINT 7,[ASCIZ/:
02900	/]]
03000		PUSHJ	P,CAT			;PUT ON A STRING
03100		POP	SP,-4(SP)
03200		POP	SP,-4(SP)		;SAVE ABOVE
03300	
03400		PUSHJ	P,SAVE			;NOW SAVE ACS
03500		SETZ	LPSA,			;NO PARAMETERS TO REMOVE
03600		MOVE	CHNL,-7(P)			;USER CHANNEL NUMBER
03700		MOVE	1,(SP)			;STRING FOR DEVICE	
03800	;[clh]	SUB	SP,X22			;ADJUST STACK
03900		JSYS STDEV
04000		   JRST BADOPN			;NOT A PLAUSIBLE DEVICE
04100		PUSH	P,2			;SAVE DEVICE DESIGNATOR
04200	;ITS A PLAUSIBLE DEVICE
04300		MOVEI	C,TIOTLN
04400		PUSHJ	P,CORGET
04500		  ERR <OPEN:  CANNOT GET CORE>
04600		MOVE	CDB,B			;IO BLOCK ADDRESS
04700		MOVEM	CDB,CDBTBL(CHNL)	;SAVE 
04800	;ZERO OUT CORE (SINCE CORGET DOESNT!!!)
04900		HRL	B,B
05000		ADDI	B,1
05100		SETZM	(CDB)
05200		BLT	B,TIOTLN-1(CDB)		
05300	
05400		POP	P,1			;GET DEVICE DESIGNATOR
05500		MOVEM	1,DVDSG(CDB)		;AND SAVE IT
05600		JSYS DVCHR
05700		MOVEM	2,DVCH(CDB)		;SAVE DEVICE CHARACTERISTICS
05800		HLRZ	1,2			
05900		ANDI	1,777			;DEVICE TYPE
06000		MOVEM	1,DVTYP(CDB)		;SAVE IT
06100		MOVEI	2,STARTPAGE(CHNL)	;PAGE BUFFERING
06200		HRLI	2,400000		;XWD FORK,PAGE
06300		MOVEM	2,FKPAGE(CDB)
06400		LSH	2,9			;ADDRESS
06500		MOVEM	2,IOADDR(CDB)
06600		SETOM	IOPAGE(CDB)		;AT (MYTHICAL) PAGE -1
06700		MOVE	2,DVCH(CDB)		;DEVICE CHARS
06800		TLNN	2,100000		;IS DEVICE A DIRECTORY DEVICE	
06900		   JRST	GTNOW			;NOPE, DO GTJFN AND OPENF NO
07000	HASDIR:
07100	;GET THE MODE IN 4
07200		MOVE	4,-6(P)			;MODE
07300		ANDI	4,17			;FORGET OTHER JUNK
07400	;IF DEVICE IS A DECTAPE IN DUMP MODE THEN DO IT NOW ALSO
07500		CAIE	1,3			;IS IT A DECTAPE?
07600		  JRST	HASDI1			;NO	
07700		CAIN	4,17			;IN DUMP MODE?		
07800		  JRST	DOMNT			;YES MOUNT AND THEN OPEN
07900	;SO DONT DO GTJFN NOW, BUT WAIT
08000	HASDI1:	SETZM	JFNTBL(CHNL)		;BE SURE
08100		MOVEM	4,GFL(CDB)		;SAVE THE MODE AS THE GTJFN FLAGS
08200		HRL	4,-5(P)			;INPUT BUFFERS
08300		HRR	4,-4(P)			;OUTPUT BUFFERS	
08400		MOVEM	4,OFL(CDB)		;SAVE AS THE OPENF FLAGS
08500	;[clh] save away file spec for lookup or enter
08600		MOVEI	C,=11			;SIZE OF BLOCK NEEDED TO STORE DEV
08700		PUSHJ	P,CORGET
08800		  ERR	<OPEN:  CANNOT GET CORE>
08900		HRRZ	A,-1(SP)		;0 _ COUNT
09000		SUBI	A,1			;   DON'T INCLUDE THE NULL
09100		MOVEM	A,(B)
09200		MOVE	A,0(SP)			;1 _ BYTE PTR
09300		HRRI	A,2(B)
09400		MOVEM	A,1(B)
09500		HRL	A,0(SP)			;2 - 10 _ STRING ITSELF
09600		HRRI	A,2(B)
09700		BLT	A,=10(B)
09800		MOVEM	B,OPNDUN(CDB)		;SAVE ADDR OF BLOCK FOR LOOKUP/ENTER
09900		JRST	GUDRT1			;AND RETURN
10000	;[clh] ^^
10100	
10200	;MOUNT AND OPEN DECTAPE IN DUMP MODE
10300	DOMNT:	MOVE	A,DVDSG(CDB)		;GET DEVICE DESIGNATOR
10400		TLO	A,(1B3)			;DONT READ DIRECTORY FOR DUMP MODE
10500		JSYS MOUNT
10600		   JRST	BADOPN			;CANNOT MOUNT
10700		MOVSI	GTFLAGS,100001
10800		MOVE	1,GTFLAGS
10900		MOVE	2,-2(SP)		;[clh]
11000		JSYS GTJFN
11100		   JRST	BADOPN
11200		MOVEM	1,JFNTBL(CHNL)
11300		MOVEM	GTFLAGS,GFL(CDB)
11400		MOVE	OPFLAGS,[447400000000!RDBIT!WRBIT]
11500		MOVE	2,OPFLAGS
11600		JSYS OPENF
11700		   JRST	CNTOPN
11800		JRST	OPOK
11900	
12000	GTNOW:	
12100		MOVSI	GTFLAGS,100001
12200		MOVE	1,GTFLAGS
12300		MOVE	2,-2(SP)		;[clh] DEVICE STRING
12400		JSYS GTJFN	
12500		   JRST	BADOPN			;NOPE CANNOT GET
12600		MOVEM	1,JFNTBL(CHNL)		;SAVE JFN
12700		MOVEM	GTFLAGS,GFL(CDB)	;AND SAVE THEM
12800	;CHECK IF IT IS THE CONTROLLING TERMINAL (DEVICE "TTY" ONLY )
12900		MOVE	2,DVTYP(CDB)		;GET DEVICE TYPE
13000		CAIE	2,12			;IS IT A TERMINAL?
13100		  JRST	NOTTTY			;NO
13200		PUSH	P,3
13300		PUSH	P,4
13400		PUSH	P,5
13500		PUSH	P,6
13600		HRRZ	2,JFNTBL(CHNL)
13700		HRROI	1,4			;WRITE IN 4
13800		MOVSI	3,200000		;DEVICE ONLY
13900		SETZ	4,
14000		JSYS	JFNS			;GET STRING
14100		MOVEM	4,2			;SAVE IN 2
14200		POP	P,6
14300		POP	P,5			;RESTORE
14400		POP	P,4
14500		POP	P,3
14600		CAME	2,[ASCIZ/TTY/]		;DEVICE TTY?
14700		  JRST	NOTTTY			;NO
14800		MOVE	2,[ISCTRM+DECLED]	;THE CONTROLLING TERMINAL
14900		MOVEM	2,TTYINF(CDB)		;REMEMBER
15000	NOTTTY:
15100	;COMPUTE OPENF FLAGS
15200		SETZ	OPFLAGS,
15300		MOVE	2,DVCH(CDB)		;DEVICE CHARACTERISTICS
15400		TESTE	2,<1B1>			;CAN DO INPUT?
15500		   TESTO  OPFLAGS,RDBIT
15600		TESTE	2,<1B0>			;CAN DO OUTPUT?
15700		   TESTO  OPFLAGS,WRBIT
15800		MOVE	1,DVTYP(CDB)		;CHECK DEVICE TYPE
15900		CAIE	1,7			;IS IT THE LPT?
16000		CAIN	1,12			;IS IT A TTY?
16100		   JRST	OP7BT			;USE 7 BIT BYTES
16200	;NOW TRY VARIOUS THINGS, LOOKING FOR SOMETHING THAT WORKS
16300	
16400		HRRZ	1,JFNTBL(CHNL)
16500		HRLI	OPFLAGS,440000
16600		MOVE	2,OPFLAGS		;36-BIT, MODE 0
16700		JSYS OPENF	
16800		   SKIPA
16900		JRST	OPOK	
17000		HRRZ	1,JFNTBL(CHNL)
17100		HRLI	OPFLAGS,447400		;36-BIT, MODE 17
17200		MOVE	2,OPFLAGS
17300		JSYS OPENF
17400		  SKIPA
17500		JRST 	OPOK
17600	OP7BT:	HRRZ	1,JFNTBL(CHNL)
17700		HRLI	OPFLAGS,70000		;7-BIT, MODE 0
17800		MOVE	2,OPFLAGS
17900		JSYS OPENF
18000		   JRST NOOPN
18100	OPOK:	MOVEM	OPFLAGS,OFL(CDB)	;SAVE OP FLAGS
18200	GUDRET:	
18300	;SAVE FLAGS
18400		SETOM	OPNDUN(CDB)		;INDICATE OPENED WITH OPEN
18500	GUDRT1:	POP	P,TEMP			;RETURN ADDRESS
18600		POP	P,ENDFL(CDB)		;SAVE GOOD THINGS
18700		POP	P,BRCHAR(CDB)
18800		POP	P,ICOUNT(CDB)		
18900		SETZM	@ENDFL(CDB)		;INDICATE GOOD OPENING
19000		SUB	SP,X44			;[clh] CLEAN UP STACKS
19100		SUB	P,X44
19200		JRST	RESTR			;AND RETURN
19300		
19400	
19500	NOOPN:
19600	CNTOPN:	SKIPN	1,JFNTBL(CHNL)		;RELEASE JFN
19700		JSYS RLJFN
19800		  JFCL
19900	BADOPN:
20000		SKIPE	B,CDBTBL(CHNL)		;CORE ALLOCATED?
20100		  PUSHJ	P,CORREL		;RELEASE CORE
20200		SETZM	JFNTBL(CHNL)
20300		SETZM	CDBTBL(CHNL)
20400		SKIPN	@-1(P)			;USER WANTS ERROR?
20500		  ERR	<OPEN:  IO ERROR OR ILLEGAL SPECIFICATIONS>,1
20600		SETOM	@-1(P)
20700		POP	P,TEMP
20800		SUB	P,[XWD 7,7]
20900		SUB	SP,X44			;[clh]
21000		JRST	RESTR
21100	
21200	
21300	
21400	
21500		BEND OPEN
21600	
21700	;MAKE UPPER CASE LETTERS
21800	MAKUP:	PUSHJ	P,SAVE
21900		SKIPE	SGLIGN(USER)
22000		  PUSHJ	P,INSET
22100		HRRZ	A,-1(SP)		;LENGTH OF STRING	
22200		ADDM	A,REMCHR(USER)
22300		SKIPLE	REMCHR(USER)		;OK?
22400		  PUSHJ	P,STRNGC		;NO, COLLECT
22500		MOVE	B,A
22600		HRRO	A,A
22700		PUSH	SP,A
22800		PUSH	SP,TOPBYTE(USER)
22900	UPPER1:	JUMPLE	B,UPPER2		;DONE YET?
23000		ILDB	C,-2(SP)		;NEXT CHAR
23100		CAIL	C,141		
23200		CAILE	C,172
23300		  SKIPA	
23400		SUBI	C,40			;CONVERT TO UPPER CASE
23500		IDPB	C,TOPBYTE(USER)
23600		SOJA	B,UPPER1	
23700	UPPER2:	POP	SP,-2(SP)
23800		POP	SP,-2(SP)
23900		SETZ	LPSA,
24000		POP	P,TEMP			;RETURN ADDR
24100		JRST	RESTR			;RETURN
24200	
     
00100	DSCR  PROCEDURE LOOKUP(INTEGER CHNL; STRING FILE; REFERENCE INTEGER FLAG)
00200	
00300	
00400	
00500	HERE(LOOKUP)
00600		BEGIN	LOOKUP
00700		PUSHJ	P,TENXFI		;MAKE THE FILE SPEC TENEX
00800	
00900		PUSH	P,1
01000		PUSH	P,2
01100		PUSH	P,3
01200		PUSH	P,CHNL
01300		PUSH	P,CDB
01400		DEFINE CHNARG <-7(P)>
01500		DEFINE FLGARG <-6(P)>
01600	
01700		SETZM	@FLGARG			;CLEAR FLAG
01800		SKIPL	CHNL,CHNARG
01900		CAIL	CHNL,JFNSIZE	
02000		   JRST	BADLU1
02100		MOVE	CDB,CDBTBL(CHNL)
02200		SKIPN	OPNDUN(CDB)		;ERROR IF NOT OPENED
02300		   JRST	BADLU1
02400		MOVE	2,DVCH(CDB)		;GET DEVICE CHARACTERISTICS
02500		TLNN	2,100000		;DOES DEVICE HAVE A DIRECTORY?
02600		   JRST	LUKRET			;NO, NO LOOKUP
02700		SKIPE	JFNTBL(CHNL)		;JFN ALREADY ASSIGNED?
02800		   PUSHJ P,RELNOW		;YES, RELEASE IT
02900	
03000		PUSHJ	P,DEVCAT
03100	
03200		MOVSI	1,100001		;OLD FILE
03300		MOVE	2,(SP)
03400		JSYS GTJFN	
03500		   JRST	BADLUK
03600		MOVEM	1,JFNTBL(CHNL)
03700		MOVSI	3,100001
03800		MOVEM	3,GFL(CDB)
03900		MOVE	2,[XWD 440000,200000]	;36-BIT
04000		JSYS OPENF
04100		   SKIPA
04200		JRST 	GUDLUK
04300		MOVE	1,JFNTBL(CHNL)
04400		MOVE	2,[XWD 447400,200000]	;36-BIT, DUMP
04500		JSYS OPENF
04600		   SKIPA
04700		JRST	GUDLUK
04800		MOVE	1,JFNTBL(CHNL)
04900		MOVE	2,[XWD 70000,200000]	;7-BIT
05000		JSYS OPENF
05100		   JRST	BADLUK
05200	GUDLUK:	MOVEM	2,OFL(CDB)
05300		SETZM	@FLGARG
05400	LUKRET:	POP	P,CDB
05500		POP	P,CHNL
05600		POP	P,3
05700		POP	P,2
05800		POP	P,1
05900		SUB	SP,X22
06000		SUB	P,X33
06100		JRST	@3(P)
06200	
06300	BADLUK:	MOVEM	1,@FLGARG
06400		JRST	LUKRET
06500	
06600	BADLU1:	SETOM	@FLGARG		
06700		JRST	LUKRET
06800	
06900	
07000		BEND LOOKUP
07100	
07200	DEVCAT:
07300	;HERE WITH CDB LOADED, FILENAME ON THE SP STACK
07400	;RETURN WITH "DEV:FILE" & 0 ON THE SP STACK
07500	;MUST NOT HAVE CALLED SAVE WHEN THIS IS CALLED
07600		PUSH	P,1
07700		PUSH	P,2
07800	;[clh] if opndun .gt. 0, it is a pointer to a block with a device name in it
07900		SKIPG	1,OPNDUN(CDB)		;DO WE HAVE A DEVICE NAME?
08000		JRST DEVCA1			;NO [SHOULD NEVER HAPPEN]
08100		PUSH	SP,0(1)			;COPY STRING HEADER FROM DEV NAME
08200		PUSH	SP,1(1)	
08300		JRST DEVCA2
08400	DEVCA1:
08500	;[clh]^^
08600		PUSH	P,[=100]
08700		PUSHJ	P,ZSETST		;BP IN 1
08800		MOVE	2,DVDSG(CDB)		;DEVICE DESIGNATOR
08900		JSYS	DEVST
09000		   ERR <LOOKUP, ENTER, OR RENAME:  CANNOT DO DEVST>
09100		PUSH	P,[=100]
09200		PUSH	P,1			;UPDATED BP
09300		PUSHJ	P,ZADJST
09400	DEVCA2:	PUSH	P,[":"]
09500		PUSHJ	P,CATCHR
09600		PUSHJ	P,CAT.RV		
09700		PUSH	P,[0]
09800		PUSHJ	P,CATCHR
09900		POP	P,2
10000		POP	P,1
10100		POPJ	P,
10200	
10300	;RELEASE JFN ALREADY THERE
10400	RELNOW:	
10500		PUSH	P,CHNL			;CHANNEL
10600		PUSHJ	P,CLOSF			;CLOSE DANCE
10700		PUSH	P,1
10800		MOVE	1,JFNTBL(CHNL)		;GET JFN	
10900		JSYS	RLJFN			;RELEASE
11000		  ERR <CANNOT RELEASE JFN>,1
11100		SETZM	JFNTBL(CHNL)		;AND ZERO OUT
11200		SETZM	IOSTT(CDB)		;NO STATUS
11300		POP	P,1
11400		POPJ	P,
11500	
11600		
     
00100	HERE(ENTER)
00200		BEGIN ENTER
00300	
00400		PUSHJ	P,TENXFI
00500	
00600		PUSH	P,1
00700		PUSH	P,2
00800		PUSH	P,3
00900		PUSH	P,CHNL
01000		PUSH	P,CDB
01100		DEFINE 	CHNARG <-7(P)>
01200		DEFINE	FLGARG <-6(P)>
01300	
01400		SETZM	@FLGARG			;CLEAR FLAG FOR USER
01500		SKIPL	CHNL,CHNARG
01600		CAIL	CHNL,JFNSIZE
01700		   JRST	BADEN1
01800		MOVE	CDB,CDBTBL(CHNL)
01900		SKIPN	OPNDUN(CDB)
02000		   JRST	BADEN1			;WAS AN OPEN PERFORMED HERE?
02100		SKIPN	1,JFNTBL(CHNL)
02200		   JRST	NOTOPN
02300		MOVE	2,DVCH(CDB)		;GET DEVICE CHARACTERISTICS
02400		TLNN	2,100000		;DOES DEVICE HAVE DIRECTORY?
02500		   JRST	ENTRET			;NO
02600	
02700		SKIPGE	IOSTT(CDB)		;A DEC-STYLE CLOSE DONE? CHKDECCLZ
02800		  JRST [PUSHJ P,RELNOW		;RELEASE JFN
02900			JRST NOTOPN		;AND PROCEED
03000		      ]
03100	
03200		PUSH	P,1			;SAVE JFN
03300		SETO	1,			;UNMAP THE BUFFER PAGE
03400		MOVE	2,FKPAGE(CDB)
03500		SETZ	3,
03600		JSYS	PMAP			;REMOVE PAGE
03700		POP	P,1
03800	
03900		SETOM	IOPAGE(CDB)
04000		SETZM	IOSTT(CDB)
04100		
04200		PUSH	P,1			;SAVE JFN
04300		TLO	1,400000		;DO NOT RELEASE THE JFN
04400		JSYS 	CLOSF
04500		   JFCL	;IGNORE
04600		POP	P,1
04700		MOVE	2,OFL(CDB)
04800		TESTO	2,WRBIT			;TURN ON WRITE BIT
04900		MOVEM	2,OFL(CDB)		;AND SAVE NEW FLAGS
05000		JSYS OPENF
05100		   JRST	BADENT			;ERROR IN 1	    
05200		JRST	ENTRET			;RETURN
05300	
05400	NOTOPN:	
05500		PUSHJ	P,DEVCAT
05600	
05700		MOVSI	1,600001		;NEW FILE
05800		MOVE	2,(SP)
05900		JSYS GTJFN
06000		   JRST	BADENT			;CANNOT GTJFN
06100		MOVEM	1,JFNTBL(CHNL)
06200		MOVSI	2,600001		;THE 
06300		MOVEM	2,GFL(CDB)		;SAVE THE GTJFN FLAGS
06400	B36:	HRRZ	1,JFNTBL(CHNL)
06500		MOVE	2,[XWD 440000,100000]	;36-BIT
06600		JSYS OPENF	
06700		   SKIPA
06800		JRST	ENT1	
06900		HRRZ	1,JFNTBL(CHNL)
07000		MOVE	2,[XWD 447400,100000]	;36-BIT, DUMP
07100		JSYS OPENF
07200		   SKIPA
07300		JRST	ENT1
07400		HRRZ	1,JFNTBL(CHNL)
07500		MOVE	2,[XWD 70000,100000]
07600		JSYS OPENF
07700		   JRST	BADENT
07800	ENT1:	MOVEM	2,OFL(CDB)
07900	ENTRET:	SETZM	@FLGARG
08000	ENTPOP:	POP	P,CDB
08100		POP	P,CHNL
08200		POP	P,3
08300		POP	P,2
08400		POP	P,1
08500		SUB	SP,X22
08600		SUB	P,X33
08700		JRST	@3(P)
08800	
08900	
09000	BADENT:	MOVEM	1,@FLGARG
09100		JRST	ENTPOP
09200	
09300	BADEN1:	SETOM	@FLGARG
09400		JRST	ENTPOP
09500	
09600		BEND ENTER
09700		
     
00100	DSCR
00200		RENAME(CHNL,"STR",PROT,@FLAG)
00300		Since protection is not implemented in TENEX,
00400	the feature will be ignored.
00500	
00600	
00700	HERE(RENAME)
00800		BEGIN RENAME
00900		PUSH	P,1
01000		PUSH	P,2
01100		PUSH	P,3
01200		PUSH	P,CHNL
01300		PUSH	P,CDB
01400		DEFINE CHNARG <-10(p)>
01500		DEFINE FLGARG <-6(P)>	
01600	
01700		VALCHN	1,CHNARG,RENBAD
01800		PUSHJ	P,OPNCHK		;MAKE SURE OPEN (SOMEWHAT REDUNDANT)
01900		MOVE	2,DVCH(CDB)		;DEVICE CHARS
02000		TLNN	2,100000		;DIRECTORY DEVICE?
02100		  JRST	RENRET			;NO, NOP
02200		
02300		PUSHJ	P,TENXFI		;MAKE A TENEX FILE NAME
02400	
02500	;PERHAPS ONLY A DELETE?
02600		HRRZ	2,-1(SP)		;NULL FILE SPEC?
02700		JUMPE	2,RENDEL		;YES, DELETE 	
02800	
02900	;ACTUALLY RENAME (ON THE SAME DEVICE)
03000		PUSH	P,CHNARG
03100		PUSHJ	P,CLOSF			;FIRST CLOSE THE FILE
03200	
03300		PUSHJ	P,DEVCAT
03400	
03500		MOVE	3,1			;SAVE FIRST JFN
03600		MOVE	1,GFL(CDB)		;USE SAME FLAGS
03700		TESTZ	1,OLDBIT		;EXCEPT NOT OLD
03800		TESTO	1,NEWBIT		;BUT DO WANT NEW
03900		TESTO	1,OUTBIT		;AND VERSION DEFAULTING
04000		MOVEM	1,GFL(CDB)		;SAVE FLAGS
04100		MOVE	2,(SP)
04200		JSYS GTJFN
04300		   JRST	RENERR			;ERROR BITS IN 1
04400		
04500		MOVE	2,1			;NEW JFN	
04600		MOVE	1,3			;OLD JFN
04700		JSYS RNAMF
04800		   JRST	RENERR			;ERROR BITS IN 1
04900		MOVE	1,2			;NEW JFN
05000		MOVE	2,OFL(CDB)		;OPENF FLAGS
05100		JSYS	OPENF
05200		   JRST	RENERR			;ERROR BITS IN 1
05300		MOVEM	1,JFNTBL(CHNL)		;SAVE THE NEW JFN
05400	
05500	RENRET:	SETZM	@FLGARG			;INDICATE A GOOD RETURN
05600	RENRE1:	POP	P,CDB
05700		POP	P,CHNL
05800		POP	P,3
05900		POP	P,2
06000		POP	P,1
06100		SUB	SP,X22
06200		SUB	P,X44
06300		JRST	@4(P)
06400	
06500	RENERR:	MOVEM	1,@FLGARG
06600		JRST	RENRE1
06700	
06800	RENBAD:	SETOM	@FLGARG
06900		JRST	RENRE1
07000	
07100	RENDEL:	TLO	1,400000		;TURN ON BIT 0 FOR NO RELEASE
07200		JSYS DELF			;JFN IN 1
07300		   JRST	RENERR
07400		JRST	RENRET
07500		BEND RENAME
07600	
     
00100	DSCR PROCEDURE USETI,USETO(INTEGER CHANNEL,BLOCK)
00200	
00300	
00400	HERE(USETI)
00500	HERE(USETO)
00600		BEGIN USETS
00700	
00800		PUSH	P,1
00900		PUSH	P,2
01000		PUSH	P,3
01100		PUSH	P,CHNL
01200		SETZM	.SKIP.
01300		VALCHN	1,-6(P),USETERR
01400		MOVE	2,DVTYP(CDB)
01500		CAIN	2,3			;IS IT A DECTAPE
01600		  JRST	USEDTA
01700		MOVE	2,-5(P)			;ARGUMENT
01800		SOJ	2,
01900		LSH	2,7			;CONVERT BLOCK TO WORD NUMBER
02000		PUSH	P,-6(P)			;CHANNEL ARG
02100		PUSH	P,2			;WORD TO SET TO
02200		PUSHJ	P,SWDPTR		;SET THE WORD POINTER
02300	USETRET:POP	P,CHNL
02400		POP	P,3
02500		POP	P,2
02600		POP	P,1
02700		SUB	P,X33
02800		JRST	@3(P)
02900	
03000	
03100	USEDTA:
03200		MOVEI	2,30			;OPERATION 30 FOR DECTAPES
03300		HRRZ	3,-5(P)			;TAPE BLOCK
03400		JSYS MTOPR				;SET DIRECTLY
03500		JRST	USETRET			;AND RETURN
03600	
03700	USETER: ERR<Illegal JFN>,1
03800		SETOM	.SKIP.
03900		JRST	USETRET			;AND RETURN
04000	
04100		BEND USETS
04200			
     
00100	DSCR	PROCEDURE CLOSE(INTEGER CHANNEL,[CLOSEINHIBITBITS])
00200		procedure closo(integer chan; integer bits(0))
00300		procedure closin(integer chan; integer bits(0))
00400	
00500		BEGIN CLOSES
00600	
00700	HERE(CLOSIN)
00800	HERE(CLOSO)
00900		PUSH 	P,-2(P)
01000		PUSHJ	P,CLOSF
01100		PUSHJ	P,SAVE
01200		VALCHN	1,-2(P),.+2
01300		SETOM	IOSTT(CDB)		;MARK AS BEING CLOSED
01400		MOVE	LPSA,X33
01500		JRST	RESTR
01600	
01700	HERE(CLOSE)
01800	DOOPN:	PUSH	P,-2(P)
01900		PUSHJ	P,CLOSF			;FORCE BUFFERS OUT, WRITE MAGT EOFS, CLOSF
02000		PUSHJ	P,SAVE
02100		VALCHN	1,-2(P),CLORET
02200		SETOM	IOSTT(CDB)		;MARK AS BEING CLOSED
02300	CLORET:	MOVE	LPSA,X33
02400		JRST	RESTR
02500	
02600		BEND CLOSES
02700	
     
00100	HERE(RELEASE)
00200	DSCR
00300		Ignores the close inhibit bits that are available in 
00400	the STANFORD SAIL, until we decide what to do with them.
00500	
00600	
00700		PUSH	P,1
00800		PUSH	P,-3(P)		;CHANNEL
00900		PUSHJ	P,CFILE
01000		POP	P,1		;RESTORE 1
01100		SUB	P,X33
01200		JRST	@3(P)		;RETURN
01300	
01400	
01500	
01600	
     
00100	DSCR	
00200		PROCEDURE MTAPE(INTEGER CHAN,OPERATION)
00300	(the operation is a character e.g., "U" to unload)
00400	as in the SAIL manual.
00500	
00600	
00700	HERE(MTAPE)
00800		BEGIN MTAPE
00900		PUSHJ	P,SAVE
01000		MOVE	LPSA,X33
01100		LDB	C,[POINT 5,-1(P),35]
01200		MOVE	A,OPTAB
01300		MOVE	B,OPTAB+1
01400		TRZE	C,30			;COMPRESS TABLE
01500		ADDI	C,5	
01600		LSH	C,2
01700		ROTC	A,(C)
01800		ANDI	B,17
01900		VALCHN	1,-2(P),MTAERR
02000		PUSHJ	P,OPNCHK		;MAKE SURE OPEN
02100		JSYS MTOPR
02200		JRST	RESTR
02300	MTAERR: ERR <Illegal JFN>,1
02400		JRST	RESTR
02500	
02600	OPTAB:	BYTE (4) 16,17,0,0,3,6,7,13,10	;A,B,E,F,R,S,T
02700		BYTE (4) 11,0,1			;U,W
02800	
02900		BEND MTAPE
03000	
03100		
03200	
03300	
     
00100	DSCR	STRING PROCEDURE TENXFI(STRING DECFILE)
00200	
00300		Converts the string to a TENEX file specification.
00400	A la Alex Cannara.
00500	
00600	
00700	HERE(TENXFI)
00800		BEGIN TENXFI
00900	
01000	CTRLV__"V"-100
01100	FIND__2
01200	
01300		PUSH	P,1
01400		PUSH	P,2
01500		PUSH	P,3
01600		SETZM	FIND
01700		PUSH	SP,[0]		;DEVICE TEMPORARY
01800		PUSH	SP,[0]
01900		PUSH	SP,[0]		;DIR TEMPORARY
02000		PUSH	SP,[0]
02100		PUSH	SP,[0]		;NAM TEMPORARY
02200		PUSH	SP,[0]	
02300	
02400	DEFINE ORIG <-7(SP)>
02500	DEFINE ORIG1 <-6(SP)>
02600	DEFINE DEV <-5(SP)>
02700	DEFINE DEV1 <-4(SP)>
02800	DEFINE DIR <-3(SP)>
02900	DEFINE DIR1 <-2(SP)>
03000	DEFINE NAM <-1(SP)>
03100	DEFINE NAM1 <0(SP)>
03200	
03300	;SIMPLE SINCE NAME IS AT THE TOP OF SP
03400	DEFINE CATNAM (X) <
03500		PUSH	P,X
03600		PUSHJ	P,CATCHR
03700	>
03800	DEFINE CATDIR (X) <
03900		PUSH	P,X
04000		PUSH	SP,DIR
04100		PUSH	SP,DIR
04200		PUSHJ	P,CATCHR
04300		POP	SP,-4(SP)
04400		POP	SP,-4(SP)
04500	>
04600	
04700	DEFINE GCH <
04800		HRRZ	1,ORIG
04900		JUMPE	1,TENDUN
05000		ILDB	3,ORIG1
05100		SOS	ORIG
05200	>
05300	
05400	
05500	TENX1:	GCH
05600		CAIE	3,CTRLV
05700		  JRST	NOQUOTE
05800		SKIPE	FIND
05900		  JRST	QUODIR
06000		PUSHJ	P,CATNA3
06100		GCH	
06200		PUSHJ	P,CATNA3 		;AND THE CHAR FOLLOWING THE CTRLV	
06300		JRST	TENX1
06400	QUODIR:	PUSHJ	P,CATDI3
06500		GCH
06600		PUSHJ	P,CATDI3
06700		JRST	TENX1			;AND CONTINUE
06800	
06900	NOQUOTE:
07000		CAIN	3,":"			;COLON -- DEVICE
07100		   JRST	ISDEV			;ITS BEEN A DEVICE ALL ALONG!!
07200		CAIN	3,","
07300		   JRST	TENX1			;IGNORE COMMA
07400		CAIE	3,40			;SPACE
07500		CAIN	3,11			;OR TAB
07600		   JRST	TENX1
07700	
07800		CAIE	3,"<"			;THESE START THE DIRECTORY NAME
07900		CAIN	3,"["
08000		   JRST	STDIR
08100		CAIE	3,">"			;THESE FINISH THE DIR. NAME
08200		CAIN	3,"]"
08300		   JRST	ENDDIR
08400		SKIPE	FIND			;DOING DIRECTORY?
08500		   JRST	.+3			;YES
08600		PUSHJ	P,CATNA3
08700		JRST	TENX1
08800		PUSHJ	P,CATDI3
08900		JRST	TENX1
09000	
09100	STDIR:	SETOM	FIND
09200		SKIPE	DIR			;ANYTHING THERE?
09300		   JRST	TENX1			;YES, IGNORE
09400		CATDIR	<[74]>
09500		JRST	TENX1
09600	
09700	ENDDIR:	SETZM	FIND
09800		JRST	TENX1
09900	
10000	ISDEV:	PUSHJ	P,CATNA3		;PUT THE COLON ON THE NAME
10100		MOVE	3,NAM			;THE "NAME" HAS REALLY BEEN A DEV
10200		MOVEM	3,DEV
10300		MOVE	3,NAM1
10400		MOVEM	3,DEV1			
10500		
10600		SETZM	NAM			;SO CLEAR THE NAME -- START OVER
10700		SETZM	NAM1
10800		JRST	TENX1
10900	
11000	TENDUN:	
11100	;CHECK TO SEE WHAT LAST CHAR OF DIR IS
11200		SKIPN	DIR
11300		  JRST	GOTDIR			;NO DIRECTORY THERE
11400		CATDIR	<[76]>			;PUT ON A ">"
11500	;NOW STACK HAS ORIG,DEV,DIR,NAM
11600	GOTDIR: 
11700		PUSHJ	P,CAT
11800	;NOW STACK HAS ORIG,DEV,<DIR>NAM
11900		PUSHJ	P,CAT
12000	;NOW STACK HAS ORIG,DEV:<DIR>NAM
12100	GOTDI1:	POP	SP,-2(SP)
12200		POP	SP,-2(SP)
12300	
12400	TXFRET:
12500		POP	P,3
12600		POP	P,2
12700		POP	P,1
12800		POPJ	P,
12900	
13000	
13100	;CALL CAT MACROS WITH AC 3 AS THE ARG
13200	CATNA3:	CATNAM 3
13300		POPJ	P,
13400	
13500	CATDI3:	CATDIR 3
13600		POPJ	P,
13700	
13800	
13900		BEND TENXFI
14000	
     
00100	DSCR
00200		INTEGER PROCEDURE GETCHAN(INTEGER I)
00300	RETURNS AN UNUSED CHANNEL NUMBER, AND MARKS IT
00400	FOR USE, SO THAT NO ONE WILL TRY TO USE IT.
00500	
00600	
00700	HERE(GETCHAN)
00800		MOVE	A,[XWD -JFNSIZE+1,1]		;START AT CHANNEL 1
00900	GETCH1:	SKIPN	CDBTBL(A)	;ALLOCATED YET?
01000		   JRST	GETCH2		;NO, TAKE IT
01100		AOBJN A,GETCH1	;YES
01200		SETOM	A		;INDICATE ERROR 
01300		POPJ	P,
01400	
01500	GETCH2:	HRRZ	A,A
01600		PUSH	P,B		;NOW ALLOCATE A TABLE
01700		PUSH	P,C
01800		MOVEI	C,TIOTLN
01900		PUSHJ	P,CORGET
02000		  ERR <GETCHAN:  CANNOT GET CORE>
02100		MOVEM	B,CDBTBL(A)
02200	
02300		HRL	C,B		;ZERO OUT BLOCK
02400		HRRI	C,1(B)
02500		SETZM	(B)
02600		BLT	C,TIOTLN-1(B)
02700			
02800		SETZM	JFNTBL(A)	;BUT NO JFN (YET)
02900		POP	P,C
03000		POP	P,B
03100		POPJ	P,
03200	
03300	DSCR
03400		INTEGER PROCEDURE CVJFN(INTEGER CHAN)
03500	
03600		Returns the JFN (XWD flags,jfn)  associated
03700	with a logical channel, -1 if no jfn assigned.
03800		Hereby, the user of these routines can access
03900	the system directly if the need arises.
04000	
04100	HERE(CVJFN)
04200		SKIPL	1,-1(P)
04300		CAIL	1,JFNSIZE
04400		  JRST 	CVJFER
04500		SKIPN	1,JFNTBL(1)
04600		  JRST	CVJFER
04700	CVJFR:	SUB	P,X22
04800		JRST	@2(P)
04900	CVJFER:	SETO	1,
05000		JRST	CVJFR
05100	
05200	
05300	BEND PAT
05400	
05500	ENDCOM(PAT)
05600	
     
00100	COMPIL(JOBINF,<ODTIM,IDTIM,IDTIM$,RUNTM,GTAD,GJINF>,<ZSETST,ZADJST,X22,X33,X44,.SKIP.,CATCHR>
00200		,<JOBINF -- JOB UTILITY ROUTINES>)
00300	DSCR STRING SIMPLE PROCEDURE ODTIM(INTEGER DT,FORMAT)
00400		Returns the string representation of DT
00500	(which is in internal TENEX representation).  If DT
00600	is -1 the current date and time are used.  If format
00700	is -1, the standard format is used.
00800	
00900	HERE(ODTIM)
01000		PUSH	P,[=100]	; 100 CHARS
01100		PUSHJ	P,ZSETST	;GET BP IN 1
01200		MOVE 2,-2(P)		;TIME
01300		MOVE 3,-1(P)		;FORMAT
01400		JSYS ODTIM
01500		PUSH	P,[=100]
01600		PUSH	P,1		;UPDATED BP
01700		PUSHJ	P,ZADJST	;GET STRING
01800		SUB	P,X33		;ADJUST STACK
01900		JRST	@3(P)		;RETURN
     
00100	
00200	DSCR INTEGER SIMPLE PROCEDURE IDTIM(STRING S,bits[0])
00300		Returns the internal TENEX representation of S, which
00400	is assumed to be the date and time in some reasonable format.
00500	If the format cannot be scanned, the error is returned in .SKIP.
00600	
00700	
00800	
00900	HERE(IDTIM)
01000	;[clh] old form of IDTIM, without the magic bits
01100		PUSH	P,0(P)			;[clh] RET, RET
01200		SETZM	-1(P)			;[clh] 0, RET
01300	
01400	HEREFK(IDTIM$,IDTIM.)
01500	;[clh] new form of IDTIM, with bits
01600		PUSH	P,[0]
01700		PUSHJ	P,CATCHR		
01800		MOVE 	1,(SP)			;BYTE-POINTER
01900		MOVE	2,-1(P)			;[clh] bits
02000		SETZM	.SKIP.			;[clh] assume no errors
02100		JSYS IDTIM
02200		  MOVEM 2,.SKIP.		;ERROR TO USER
02300		MOVE  	1,2			;ANSWER
02400		SUB	SP,X22			;ADJUST SP STACK
02500		SUB	P,X22			;[CLH]
02600		JRST	@2(P)			;[CLH]
     
00100	DSCR INTEGER SIMPLE PROCEDURE RUNTM(INTEGER FORK; REFERENCE INTEGER CONSOLE);
00200		Returns the runtime of a fork.  If FORK=-5, then then
00300	whole job.  Time is returned as milliseconds for you.  Console time,
00400	similarly converted, is returned in CONSOLE.
00500	
00600	HERE(RUNTM)
00700		MOVE 	1,-2(P)
00800		JSYS RUNTM
00900		MOVEM 	3,@-1(P)
01000		SUB	P,X33	
01100		JRST	@3(P)
     
00100	DSCR INTEGER SIMPLE PROCEDURE GTAD;
00200		Returns the current date and time.  See Jsys manual,
00300	3-3.
00400	
00500	HERE(GTAD)
00600		JSYS GTAD
00700		POPJ P,
     
00100	DSCR INTEGER SIMPLE PROCEDURE GJINF(REFERENCE INTEGER LOGDIR,CONDIR,TTYNO);
00200		Returns the TENEX jobnumber.  LOGDIR is the directory 
00300	no. logged in, CONDIR is the connected directory number.  TTYNO is the
00400	TENEX teletype number, which is -1 if the job is detached.  
00500		See the DIRST routine for converting directory numbers to 
00600	directory strings.
00700	
00800	
00900	HERE(GJINF)
01000		JSYS GJINF
01100		MOVEM 	1,@-3(P)
01200		MOVEM 	2,@-2(P)
01300		MOVEM 	4,@-1(P)
01400		MOVE 	1,3;
01500		SUB	P,X44
01600		JRST	@4(P)
     
00100	
00200	ENDCOM(JOBINF)
00300	
     
00100	COMPIL(DIRECT,<STDIR,RCUSR,RCDIR,DIRST>
00200		,<SAVE,RESTR,X22,X33,X44,CAT,CATCHR,ZSETST,ZADJST,.SKIP.>
00300		,<DIRECT -- TENEX DIRECTORY SPECS>)
00400	DSCR INTEGER SIMPLE PROCEDURE STDIR(STRING S; BOOLEAN DORECOGNITION)
00500	DESR
00600		Returns the directory number associated with a string.
00700	Any problems are returned in .SKIP. with the code:
00800			1 string does not match
00900			2 string is ambiguous.
01000	
01100	HERE(STDIR)
01200		PUSH	P,[0]
01300		PUSHJ	P,CATCHR	;TACK ON 0
01400		SETZ 	3,		;
01500		MOVEI 	1,1 		; ASSUME NO RECOGNITION
01600		SKIPE 	-1(P)		; DO WE WANT IT?
01700		SETO  	1,		; YES AFTER ALL
01800		MOVE 	2,(SP)		;BYTE-POINTER
01900		JSYS STDIR
02000		  SKIPA	3,[1]		; NO MATCH;
02100		  MOVEI	3,2 		; AMBIGUOUS
02200		MOVEM 	3,.SKIP.	; SAVE IT FOR USER
02300		HRRZ 	1,1 		; SAVE DIR NO. (ONLY)
02400		SUB	SP,X22		;ADJUST STRING STACK
02500		SUB	P,X22
02600		JRST	@2(P)		;RETURN	
02700		
02800	;[CLH/DAW]
02900	DSCR INTEGER SIMPLE PROCEDURE RCDIR(REFERENCE STRING DIRECTORY; REFERENCE
03000						INTEGER DIRNO, FLAGS);
03100	     INTEGER SIMPLE PROCEDURE RCUSR(REFERENCE STRING USER; REFERENCE
03200						INTEGER DIRNO, FLAGS);
03300		Returns a directory number if successful, 0 otherwise.
03400	
03500	
03600	
03700	HEREFK (RCUSR,$RCUSR)
03800	
03900		PUSH	P,X
04000		MOVE	X,[JSYS RCUSR]	;SAY WHAT WE'RE DOING
04100		JRST	RCDIR1
04200	
04300	HEREFK (RCDIR,$RCDIR)
04400	
04500		push	p,x
04600		move    x,[jsys rcdir]
04700	rcdir1:	push	p,b
04800		push	p,c
04900		move	b,-6(p)		;get address of pointer
05000		push	sp,-1(b)	;put on string stack
05100		push	sp,(b)
05200		move	a,@-4(p)	;get flags
05300		tlne	a,1		;if no recognition
05400		jrst	norecg		;just make asciz
05500		push	p,[=100]	;recognition: leave lots of room
05600		pushj	p,zsetst	;sp now points to a string with 40 nulls
05700		move	b,a		;b _ new string
05800		exch	a,(sp)		;a _ old string, new one saved now 
05900		push	p,y
06000		hrrz	c,-1(sp)	;size of original
06100		caile	c,=99		;truncate if .gt. 99
06200		movei	c,=99		;copy string and put on null
06300		jumpe	c,rec2
06400	rec1:	ildb	y,a
06500		idpb	y,b
06600		sojg	c,rec1
06700	rec2:	setz	y,0
06800		idpb	y,b
06900		pop	p,y
07000	norec1:	move	a,@-4(p)	;get back flags
07100		move	b,(sp)		;string to be translated
07200		move	c,@-5(p)	;get previous directory number
07300		xct	x
07400		 erjmp	jserr
07500		setz	x,
07600		tlne	a,10000		;no more directories _ 3
07700		movei	x,3
07800		tlne	a,20000		;ambigous _ 2
07900		movei	x,2
08000		tlne	a,40000		;no match _ 1
08100		movei	x,1
08200	erret:	movem	x,.skip.	;return error code
08300		exch	a,@-4(p)	;return flags
08400		movem	c,@-5(p)	;return directory number
08500		skipn	.skip.		;if error, or
08600		tlne	a,1		; if no recognition
08700		jrst	clenup		; clean up and return
08800		push	p,[=100]	;length of original string
08900		push	p,b		;point to end of string
09000		pushj	p,zadjst	; and get new string pointer
09100		move	b,-6(p)		;get address for string return
09200		pop	sp,(b)		; and put the string there
09300		pop	sp,-1(b)
09400	clenup:	move	a,@-5(p)	;return directory number
09500		pop	p,c
09600		pop	p,b
09700		pop	p,x
09800		sub	sp,x22
09900		sub	p,x44
10000		jrst	@4(p)
10100	
10200	NORECG:	PUSH	P,[0]		;MAKE ASCIZ
10300		PUSHJ	P,CATCHR
10400		JRST	NOREC1
10500	
10600	jserr:	movei	a,400000	;get my last error
10700		jsys 	geter
10800		setzb	a,c		;zero out returned stuff
10900		hrrz	x,b		;put tenex error code here
11000		jrst	erret
11100	
11200	;[clh/daw] ^^
     
00100	DSCR STRING SIMPLE PROCEDURE DIRST(INTEGER I)
00200		Returns the string name for directory I.  Any problems
00300	cause .SKIP. to be set TRUE.
00400	
00500	
00600	HERE(DIRST)
00700		BEGIN 	DIRST
00800		PUSH	P,[=100]
00900		PUSHJ	P,ZSETST
01000		SETZM 	.SKIP.
01100		MOVE 	2,-1(P)		;DIRECTORY NO.
01200		PUSH	P,1		;SAVE STRING POINTER
01300		JSYS DIRST
01400		  JRST	DIRERR		;ERROR RETURN
01500		SUB	P,X11		;CLEAR STACK, DONT NEED STRING POINTER
01600	DOADJ:	PUSH	P,[=100]
01700		PUSH	P,1		;UPDATED STRING POINTER
01800		PUSHJ	P,ZADJST	;GET SAIL STRING ON STACK
01900		SUB	P,X22		
02000		JRST	@2(P)
02100	
02200	DIRERR:	MOVEM	1,.SKIP.	;ERROR NUMBER IN TOPS 20, STRING POINTER IN TENEX
02300					;ALWAYS TRUE
02400		POP	P,1		;GET BACK ORIGINAL BP
02500		JRST	DOADJ		;AND FIX STRINGS
02600		BEND 	DIRST
02700	ENDCOM(DIRECT)
     
00100	COMPIL(RUNPRG,<RUNPRG>,<X22,X33,$OSTYP,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
00200	DSCR INTEGER SIMPLE PROCEDURE RUNPRG(STRING PROGRAM; INTEGER INCREM; BOOLEAN NEWFORK)
00300		This does two entirely different things depending on whether
00400	NEWFORK is true or not.
00500		If NEWFORK then a new fork is created, capabilities transmitted,
00600	and PROGRAM is run there.  INCREM is added to the entry vector.  Any problems
00700	cause the routine to return FALSE, otherwise it returns TRUE.
00800		If not NEWFORK then the current job is destroyed and replaced
00900	with PROGRAM, with INCREM added to the entry vector location.  This is
01000	like the DEC RUN uuo, and hence if the increment is 1, the program is
01100	started at the CCL address.  If the routine returns at all, there was a problem
01200	with the file.
01300		
01400	
01500	
01600	
01700	HERE(RUNPRG)
01800		BEGIN 
01900		JFN__0
02000		FORK__14
02100		PUSH	P,[0]
02200		PUSHJ	P,CATCHR	
02300		MOVE	3,[ASCIZ /EXE/]	;[CLH] ASSUME EXE FILE
02400		SKIPN	$OSTYP		;[CLH] EXCEPT IF TENEX
02500		MOVE	3,[ASCIZ /SAV/]	;[CLH] THEN SAV
02600		MOVEI	1,GTBLK		;[CLH] LONG FORM BLOCK
02700		MOVE	2,(SP) 		; STRING POINTER
02800		JSYS GTJFN 			; TRY FOR JFN		
02900		   JRST RUNERR 		; ERROR
03000		MOVEM	1,JFN 		; SAVE JFN		
03100	
03200		SKIPN	-1(P) 		; USER WANTS FORK?
03300		   JRST SWP 		; NO, REPLACE CURRENT PRG
03400	
03500		MOVSI	1,100000 	; XMIT CAPABILITIES
03600		JSYS CFORK
03700		   JRST RUNERR 	; CANNOT CREATE FORK
03800		MOVEM	1,FORK 	; SAVE HANDLE
03900		SETOB	2,3 	; INDICATE ALL PRIVILEDGES
04000		JSYS EPCAP
04100		HRLZ	1,1 	; FORK HANDLE
04200		HRR	1,JFN 	; THE JFN
04300		JSYS GET 		; JSYS GET THE FILE
04400		MOVEI	1,400000 	; CURRENT FORK
04500		JSYS	GPJFN	;PRIMARY JFNS IN 2
04600		MOVE	1,FORK 	; SET PRIMARY IO	
04700		JSYS SPJFN	;FOR NEW FORK
04800		MOVE	1,FORK 	; FORK
04900		MOVE	2,-2(P) 	; USER VALUE FOR ENTRY VECTOR
05000		JSYS SFRKV	;START THE FORK
05100		MOVE	1,FORK ;
05200		JSYS WFORK
05300		SKIPE	1,FORK 	; SET TO KILL
05400		JSYS KFORK	;KILL THE FORK
05500		HRRZ	1,JFN ;
05600		JSYS RLJFN 		; RELEASE
05700		JFCL 		; IGNORE	
05800		JRST 	RUNRET 		; AND RETURN SAFELY
05900	
06000	;[CLH] allow for default extension
06100	GTBLK:	XWD 100000,0		;EXISTING FILE
06200		XWD 377777,377777	;FROM STRING ONLY
06300		0			;NO DEFAULT DEV
06400		0			;NO DEFAULT DIR
06500		0			;NO DEF NAME
06600		XWD -1,3		;DEF EXT IN AC 3
06700		0			;NO DEF PROT
06800		0			;NO DEF ACCT
06900	;[CLH]^^
07000	
07100	SWP:	
07200		MOVEI	1,400000	;[CLH] TURN OFF INTERRUPTS, SINCE HANLDER 
07300		DIR			;[CLH]    IS GOING AWAY
07400	IMSSS,<				;DESTROY EMULATOR INFO AT IMSSS
07500		SETO	1,
07600		MOVE	2,[XWD 400000,711]	;PAGE 711
07700		JSYS	PMAP			;DESTROY
07800	>;IMSSS
07900		PUSH	P,JFN			;SAVE THE JFN
08000		HRLI	A1 			; BLT INTO ACS
08100		HRRI	1 ;
08200		BLT	15 		; THE INSTRUCTIONS -- NOTE THAT RF IS NOW CLOBBERED
08300		SKIPN	$OSTYP		;[clh] if Tops20
08400		JRST	SWP1		;[clh] not, ac's are right
08500		MOVE	2,T2		;[clh] special code for Tops-20
08600		MOVE	3,T3		;[clh]    [Rsmith objects to using DMOVE, in
08700		MOVE	5,T5		;[clh]	   case of KA Tops-20?????]
08800	SWP1:	POP	P,0		; RESTORE JFN TO AC0
08900		HRLI	0,400000 	; XWD FORK, JFN
09000	 	MOVE	16,-2(P) 	; THE INCREMENT -- NOTE THAT SP IS NOW CLOBBERED
09100		MOVE	17,[254000400010] 	; FOR COMPARISON -- NOTE THAT THE P STACK IS GONE
09200		JRST	4 		; AND GO
09300	
09400	;[clh] these are AC's 2 and 3 for Tops-20
09500	T2:	400000000000	;[clh] this fork, start at 0
09600	T3:	400000001000	;[clh] repeat count, all of core
09700	T5:	CAI		;[clh] no need to loop 
09800	;here are the AC's for Tenex
09900	A1:	-1 		; FOR PMAP
10000	A2:	400000000677 	; THIS FORK, START AT 677 (LEAVING EMULATOR)
10100	A3:	0 ;
10200	A4:	JSYS PMAP
10300	A5:	SOJL	2,4 	; LOOP THROUGH PAGES
10400	A6:	MOVE	1,0 	; XWD 400000,JFN
10500	A7:	JSYS GET ;
10600	A10:	MOVEI	1,400000 	; THIS FORK
10700	A11:	JSYS GEVEC 		; JSYS GET ENTRY VECTOR
10800	A12:	CAMN	2,17 	; DEC STYLE??
10900	A13:	  HRRZ	2,120 	; YES
11000	A14:	ADD	2,16 	; ADD THE INCREMREMENT
11100	A15:	JRST	(2) 	; AND START THE JOB
11200	
11300	RUNERR:	TDZA	1,[-1]	;ZERO 1 AND SKIP
11400	RUNRET:	SETO	1,	;INDICATE SUCCESS
11500		SUB	SP,X22
11600		SUB	P,X33
11700		JRST	@3(P)
11800	
11900	
12000		BEND;RUNPRG
12100	ENDCOM(RUNPRG)
     
00100	NOCRYPT<
00200	COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE,SETCHAN>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
00300	>; NOCRYPT
00400	CRYPT<
00500	COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,SETCRYPT,INDEXFILE,SETCHAN>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
00600	>; CRYPT
00700	
00800	DSCR INTEGER SIMPLE PROCEDURE OPENFILE(STRING NAME,OPTIONS)
00900	
01000		Name is the name of the file to be opened.  If it is null, then
01100	OPENFILE goes to the user's console for the filname (with recognition).
01200		The value of the call is the jfn returned to the user.
01300		OPTIONS is a string of options available to the user.  Legal 
01400	characters are:
01500	
01600	One of these:
01700		R		read
01800		W		write
01900		A		append
02000		U		update - like RW, but uses existing version
02100	Version numbering
02200		O		old file
02300		N		new file
02400		T		temporary file
02500		*		index with INDEXFILE routine
02600	
02700	Independent:
02800		C		require confirmation
02900		D		ignore deleted bit
03000		H		"thawed" access
03100	Error handling
03200		E		return errors to user in the external
03300				integer !skip!.  TENEX error codes are used.
03400				(JFN will be released in this case.)
03500		OPENFILE does a GTJFN followed by a OPENF.  If GTJFN fails, a new
03600	attempt is made, from the user's console.  
03700	
03800	
03900		BEGIN OPENFILE
04000	JFN_3				;WHERE TO PUT THINGS
04100	FLAGS_4
04200	GTFLAGS_5
04300	OPFLAGS_6
04400	
04500	DEFINE EQ $ (X,Y) <
04600		CAIE	A,"$X$"
04700		   JRST .+3
04800		TESTO	FLAGS,Y
04900		JRST	OPCONT
05000	>
05100	
05200	DEFINE JTRUE $ (X) <
05300		TESTN	FLAGS,X
05400	>
05500	DEFINE JFALSE (X) <
05600		TESTE	FLAGS,X
05700	>
05800	
05900	DEFINE 	SGT (X) <
06000		TESTO	GTFLAGS,X
06100	>
06200	DEFINE  SOF (X) <
06300		TESTO	OPFLAGS,X
06400	>
06500	DEFINE  TGT (X) <
06600		TESTE	FLAGS,X
06700		  TESTO GTFLAGS,X
06800	>
06900	DEFINE  TOP (X) <
07000		TESTE	FLAGS,X
07100		  TESTO OPFLAGS,X
07200	>
07300	
07400	HERE(OPENFILE)
07500		SETZB	FLAGS,.SKIP.
07600		SETZB	GTFLAGS,OPFLAGS
07700		HRRZ	B,-1(SP)		;COUNT OF OPTIONS WORD
07800	
07900	WHIOPT:	JUMPE	B,OPTDUN
08000		ILDB	A,(SP)			;GET AN OPTION
08100		CAIGE	A,141
08200		   JRST .+3
08300		CAIG	A,172
08400		   SUBI	A,40			;CONVERT TO UPPER CASE
08500	;ANY NON-ALPHABETIC CHARS GO HERE
08600	
08700		EQ 	*,STARBIT
08800	;NOW ALLOW ONLY ALPHABETIC CHARS
08900		CAIL	A,101			;MUST BE 
09000		CAILE	A,132
09100		   JRST	OPTERR
09200		SKIPN	BITTBL-"A"(A)		;SOMETHING THERE?
09300		   JRST	OPTERR			;NOPE, ERROR
09400		TDO	FLAGS,BITTBL-"A"(A)	;RIGHT SPOT IN TABLE
09500		SOJGE	B,WHIOPT
09600		  JRST	OPTDUN
09700	;HERE ON ERROR
09800	OPTERR:	ERR	<OPENFILE:  ILLEGAL OPTION >,1
09900		TESTO	FLAGS,ERSNBIT
10000	
10100	  OPCONT:
10200		SOJGE	B,WHIOPT
10300	
10400	;NOW SET UP GTFLAGS ACCORDING TO THE SCANNED INFORMATION
10500	OPTDUN:		
10600		TGT	OLDBIT			;INSIST ON OLD?
10700		TGT	NEWBIT			;INSIST ON NEW?
10800		JTRUE	OLDBIT
10900		JFALSE	NEWBIT			;IF NEITHER
11000		  JRST	OPTDU1			;WELL, ONE
11100		JTRUE	WRBIT			;IF WRITING
11200		  JRST	OPTDU1
11300		JFALSE	RDBIT			;AND NOT READING
11400		JTRUE	APPBIT!UPDBIT		;[clh] OR READING AND NOT APPENDING OR UPDATING
11500		  SGT	OUTBIT			;THEN SET OUTPUT BIT
11600	OPTDU1:
11700		JFALSE	RDBIT			;IF READING
11800		JFALSE	WRBIT			;AND NOT WRITING
11900		   JRST	OPTDU2	   
12000		JTRUE	APPBIT			;AND NOT APPENDING
12100		   SGT	OLDBIT			;THEN INSIST ON OLD
12200	OPTDU2:
12300	;NOW TEST FOR INDEPENDANT THINGS
12400		TOP	RDBIT
12500		TOP	WRBIT
12600		TOP	APPBIT
12700		TGT	TEMBIT
12800		TGT	STARBIT
12900		TGT	DELBIT
13000		TOP	THAWBIT
13100		JFALSE	CONFBIT
13200		   JRST	[SGT	CONFB1
13300			 SGT	CONFB2
13400			 JRST	.+1]
13500		TLO	GTFLAGS,1		;SHORT CALL OF GTJFN
13600	GTAGAIN:
13700		HRRZ	A,-3(SP)		;LENGTH OF NAME
13800		JUMPE	A,[TRYAGN:  
13900			   TLO	GTFLAGS,2
14000			   MOVE	2,[XWD 100,101]
14100			   JRST  GT]
14200		AND 	GTFLAGS,[717777777777]
14300		
14400		PUSH	SP,-3(SP)
14500		PUSH	SP,-3(SP)
14600		PUSH	P,[0]
14700		PUSHJ	P,CATCHR		;CONCATENATE A NULL CHAR
14800		MOVE	2,(SP)			;BYTE-POINTER
14900		SUB	SP,X22			;ADJUST STACK
15000	GT:	MOVE	1,GTFLAGS
15100		JSYS GTJFN
15200		  JRST 	GTERR
15300		MOVEM	1,JFN			;REMEMBER JFN
15400		PUSHJ	P,SETCHN		;SET A CHANNEL, ALLOCATE, GET CDB, SET DVTYP, RETURN CHANNEL
15500		MOVEM	1,CHNL			;REMEMBER CHANNEL	
15600		MOVEM	GTFLAGS,GFL(CDB)
15700	
15800	
15900	COMMENT  Do the open.
16000	
16100		MOVE	1,DVTYP(CDB)		;CHECK THE DEVICE TYPE
16200		CAIE	1,7			;IS IT THE LPT?
16300		CAIN	1,12			;IS IT A TTY?
16400		   JRST	B7			;YES, USE 7 BIT
16500	B36:	HRRZ	1,JFN			;JFN
16600		HRRZ	2,OPFLAGS
16700		HRLI	2,440000		;36-BIT, MODE 0
16800		JSYS OPENF	
16900		   JRST	B36DMP			;TRY 36-BIT, DUMP MODE
17000		JRST	OPNOK
17100	B36DMP:	HRRZ	1,JFN
17200		HRRZ	2,OPFLAGS
17300		HRLI	2,447400		;36 BITS, DUMP MODE
17400		JSYS OPENF			
17500		   JRST	B7
17600		JRST	OPNOK
17700	B7:	HRRZ	1,JFN
17800		HRRZ	2,OPFLAGS
17900		HRLI	2,70000			;7 BIT
18000		JSYS OPENF
18100		    JRST OPERR			;NOPE
18200	OPNOK:	MOVEM	2,OFL(CDB)		;SAVE 
18300		MOVE	1,CHNL			;RETURN CHANNEL NO	
18400	OPFRET:	SUB	SP,X44			;ADJUST
18500		POPJ	P,			;AND RETURN
18600	
18700	
18800	
18900	
19000	GTERR:
19100	;HERE WITH ERROR ON GTJFN
19200		JTRUE	ERTNBIT			;USER WANT'S ERRORS?
19300		   JRST	GTER1			;NO
19400	ERRRET:	MOVEM	1,.SKIP.		;STORE FOR USER
19500		SETO	1,			;SOMETHING SUSPICIOUS
19600		JRST	OPFRET			;AND RETURN
19700	
19800	GTER1:	PUSHJ	P,SERSTR		;SHOW ERSTR
19900		HRROI	1,[ASCIZ/
20000	Cannot GTJFN file /]
20100		JSYS PSOUT
20200		PUSH	SP,-3(SP)
20300		PUSH	SP,-3(SP)
20400		PUSHJ	P,OUTSTR
20500		HRROI	1,[ASCIZ/, try again  */]
20600		JSYS PSOUT
20700		JRST	TRYAGN
20800	
20900	
21000	
21100	OPERR:	JTRUE	ERTNBIT
21200		   JRST	OPER1
21300		PUSH	P,1			;SAVE ERROR BITS
21400		PUSH	P,CHNL
21500		PUSHJ	P,CFILE			
21600		POP	P,1			;RESTORE ERROR BITS
21700		JRST	ERRRET
21800	
21900	OPER1:	PUSHJ	P,SERSTR		;SHOW ERSTR
22000		HRROI	1,[ASCIZ/
22100	Cannot OPENF file /]
22200		JSYS 	PSOUT
22300		PUSH	SP,-3(SP)
22400		PUSH	SP,-3(SP)
22500		PUSHJ	P,OUTSTR
22600		HRROI	1,[ASCIZ/, try again  */]
22700		JSYS 	PSOUT	
22800		PUSH	P,CHNL			;CLOSE AND RELEASE FILE AND CDB BLOCK
22900		PUSHJ	P,CFILE
23000		JRST	TRYAGN	
23100	
23200	;HERE WITH THE TENEX ERROR CODE IN 1 -- 1 MAY BE CLOBBERED
23300	SERSTR:
23400		PUSH	P,2			;SAVE ACS
23500		PUSH	P,3
23600		HRRZ	2,1
23700		HRLI	2,400000		;THIS FORK
23800		HRROI	1,[ASCIZ/
23900	/]
24000		JSYS	PSOUT
24100		MOVEI	1,101			;PRIMARY OUTPUT
24200		SETZ	3,			;FLAGS
24300		JSYS	ERSTR
24400		  JFCL
24500		  JFCL
24600		POP	P,3
24700		POP	P,2
24800		POPJ	P,
24900	
25000	
25100	BITTBL: APPBIT	;A
25200		BINBIT	;B
25300		CONFBIT	;C
25400		DELBIT	;D
25500		ERTNBIT	;E
25600		0	;F
25700		0	;G
25800		THAWBIT	;H
25900		0	;I
26000		0	;J
26100		0	;K
26200		0	;L
26300		0	;M
26400		NEWBIT	;N
26500		OLDBIT	;O
26600		0	;P
26700		0	;Q
26800		RDBIT	;R
26900		0	;S
27000		TEMBIT	;T
27100		RDBIT!WRBIT!UPDBIT ;[clh] U
27200		0	;V
27300		WRBIT	;W
27400		0	;X
27500		0	;Y
27600		0	;Z
27700	
27800	
27900		BEND OPENFILE
28000	
     
00100	DSCR PROCEDURE SETINPUT(INTEGER CHAN; REFERENCE INTEGER COUNT,BR,EOF)
00200		Sets up the variables associated with input (as in the DEC
00300	open statement.)
00400	
00500	
00600	HERE(SETINPUT)
00700		PUSHJ	P,SAVE
00800		VALCHN	1,-4(P),SETERR
00900		POP	P,TEMP
01000		POP	P,ENDFL(CDB)
01100		SKIPE	ENDFL(CDB)
01200		   SETZM @ENDFL(CDB)		;ASSUME NOT EOF
01300		POP	P,BRCHAR(CDB)
01400		SKIPE	BRCHAR(CDB)
01500		   SETZM @BRCHAR(CDB)		;ASSUME NO BRCHAR
01600		POP	P,ICOUNT(CDB)
01700		SETZ	LPSA,			;NO PARAMETERS
01800		SUB	P,X11
01900		JRST	RESTR
02000	SETERR: ERR <Illegal JFN>,1
02100		MOVE	LPSA,[XWD 5,5]
02200		JRST	RESTR
02300	
     
00100	DSCR
00200		SETPL(CHAN,@LINNUM,@PAGNUM,@SOSNUM)
00300	
00400		Names the variables to be used by the INPUT
00500	function for counting the line-feeds (12), formfeeds (14)
00600	seen by INPUT, as well as keeping the current SOS line
00700	number, if any.  Useful when scanning a file, and
00800	you want to know what page,line you are on.
00900		Initializes all three variables to 0.
01000	
01100	
01200	HERE(SETPL)
01300		PUSHJ	P,SAVE
01400		VALCHN	1,-4(P),SETPER
01500		POP	P,TEMP		;RET ADR
01600		POP	P,SOSNUM(CDB)
01700		SETZM	@SOSNUM(CDB)
01800		POP	P,PAGNUM(CDB)
01900		SETZM	@PAGNUM(CDB)
02000		POP	P,LINNUM(CDB)
02100		SETZM	@LINNUM(CDB)
02200		SUB	P,X11		;REMOVE CHANNEL NO.
02300	SETRET:	SETZ	LPSA,
02400		JRST	RESTR
02500	SETPER: ERR <Illegal JFN>,1
02600		MOVE	LPSA,[XWD 5,5]
02700		JRST	RESTR
02800	
     
00100	CRYPT< ; PROCEDURE SETCRYPT(CHAN,ENCRYPT,DECRYPT)
00200	DSCR	PROCEDURE SETCRYPT(CHAN,ENCRYPT,DECRYPT)
00300		where
00400			CHAN is the I/O channel for which cryption is desired
00500			SIMPLE PROCEDURE ENCRYPT(CHAN,LOC,BUFSTART,BUFEND)
00600			SIMPLE PROCEDURE DECRYPT(CHAN,LOC,BUFSTART,BUFEND)
00700				CHAN - I/O channel involved
00800				LOC - word or byte number of CHAN corresponding
00900				      to BUFSTART (see LH(BUFSTART) for which)
01000				BUFSTART and BUFEND - If LH is zero then these
01100					 point to the first and last word 
01200					 of the buffer.  Otherwise they
01300					 point to the first and last byte.
01400	
01500	Sets things up so PROCEDURE DECRYPT is called whenever a new buffer
01600	of data is input from CHAN, and PROCEDURE ENCRYPT is called
01700	whenever a new buffer of data is about to be output to CHAN.
01800	Call SETCRYPT after doing OPENFILE or (GTJFN/OPENF).
01900	Thus the user can manipulate incoming data before it is seen
02000	by the regular SAIL input routines, and outgoing data before it is
02100	actually sent to CHAN.  A typical use would be to decrypt incoming
02200	data and encrypt outgoing data.  
02300	
02400	Restrictions:
02500	1. Encryption of TTY IO is not allowed (continuable error).
02600	2. If a decryption routine is specified, an encryption routine must
02700	    also be specified, though it may do nothing at the user level.
02800	3. Currently, only PMAP'ed files are supported (continuable error).
02900	
03000	To implement this scheme, it is necessary to test for cryption
03100	being done whenever a new buffer or page is read in or written out.
03200	The logic for conventional I/O is simple, but TOPS20 PMAP'ed files
03300	present a problem when copy-on-write is NOT in effect:
03400	Decrypting the file in place will a) defeat encryption and b)
03500	cause problems if the user ^C's because some pages of the file will
03600	be encrypted and some not.  Thus pages of the file that are being
03700	paged in must be dissociated from the file and decrypted.  Then
03800	before they are unmapped, they must be encrypted and remapped into
03900	the file.  The logic is as follows:
04000	
04100	After PMAPing in:	if copy-on-write then DECRYPT
04200				else
04300					dissociate page from file
04400					DECRYPT
04500	
04600	When unmapping:		if copy-on-write then ENCRYPT
04700				else
04800					ENCRYPT
04900					map to file
05000	
05100	[RNG] [06]
05200	
05300	
05400	HEREFK(SETCRYPT,SETCR$)
05500	
05600		PUSHJ	P,SAVE
05700		VALCHN	1,-3(P),CRYERR
05800		SKIPE	DVTYP(CDB)		; Is it DSK:?
06400		 JRST	CRNOPM			; No, not implemented
06600		POP	P,TEMP			; RETURN ADDRESS
06700		POP	P,DCRYPT(CDB)
06800		POP	P,NCRYPT(CDB)
06900		SUB	P,X11			; REMOVE CHAN
07000		SETZ	LPSA,			; NO NEED TO ADJUST STACK
07100		JRST	RESTR
07200	
07300	CRYERR:	ERR <SETCRYPT:  Illegal Channel Number>,1
07400		JRST	CRYER1
07700	CRNOPM:	ERR <SETCRYPT:  Not implemented for non-PMAP'ed files>,1
07800	CRYER1:	MOVE	LPSA,[XWD 5,5]
07900		JRST	RESTR
08000	
08100	; Routine to save the AC's before calling the user's crypt routine.
08200	; He originally called an I/O runtime that wants to call a SAIL
08300	; routine (ENCRYPT or DECRYPT) that may call another runtime routine,
08400	; so we must save both the current runtime AC's 0-15 and the SAVE/RESTR
08500	; RACS 0-13.  Called by PUSHJ P,CRYSAV.
08600	
08700	CRYSAV:	POP	P,TEMP			; SAVE RETURN ADDR
08800		ADD	P,[XWD 14+16,14+16]	; STUFF WE WILL SAVE ON STACK
08900		PUSH	P,UUO1(USER)		; THIS TOO, MAY CAUSE PDLOV
09000						; NOW SAVE SAVED RACS
09100		PUSH	P,TEMP			; PUT RETURN ADDR BACK
09200		HRRI	TEMP,-33(P)		; DESTINATION
09300		HRLI	TEMP,RACS(USER)		; SOURCE (0-RF=12)
09400		BLT	TEMP,-21(P)		; END OF DESTINATION
09500		HRRZI	TEMP,-20(P)		; DESTINATION
09600		BLT	TEMP,-2(P)		; SOURCE (0-15)
09700		POPJ	P,
09800	
09900	; Routine to restore saved AC's.  Called by PUSHJ P,CRYRST
10000	
10100	CRYRST:	MOVE	USER,GOGTAB
10200		MOVE	TEMP,-1(P)		; GET OLD UUO1(USER)
10300		MOVEM	TEMP,UUO1(USER)
10400		MOVSI	TEMP,-20(P)		; SOURCE IS OLD 0-15
10500		BLT	TEMP,15			; RESTORE OUR AC'S
10600		HRLI	TEMP,-33(P)		; SOURCE IS OLD RACS 0-12
10700		HRRI	TEMP,RACS(USER)		; PUT THEM BACK
10800		BLT	TEMP,RACS+12(USER)
10900		MOVE	TEMP,0(P)		; GET RETURN ADDR
11000		SUB	P,[14+16+2,14+16+2]	; ADJUST STACK, INCL RET
11100		JRST	(TEMP)
11200	
11300	;;	Routine to encrypt an outgoing page if the file is being
11400	;;	written or appended to and the current page is valid.
11500	;;	1 HAS JFN, CDB, CHNL are loaded.
11600		
11700	CALNCR:	MOVE	TEMP,OFL(CDB)		; GET STATUS WORD
11800		TESTN	TEMP,WRBIT		; IF NOT (WRITING OR
11900		TESTE	TEMP,APPBIT		; APPENDING)
12000		 SKIPA
12100		 POPJ	P,			; THEN RETURN
12200		HRROI	TEMP,-1
12300		CAMN	TEMP,IOPAGE(CDB)	; IF PAGE!OF!FILE=-1
12400		 POPJ	P,			; THEN RETURN
12500		PUSH	P,1			; Prepare to check if page
12600		PUSH	P,2			; has been changed
13200		MOVE	1,FKPAGE(CDB)
13300		RPACS				; Find out status of page
13400		TESTN	2,1B10			; IF page is not private
13500		 JRST	SKIPIT			; then don't bother decrypting
13510		POP	P,2
13520		POP	P,1
13550	
13600		; Here if we really need to encrypt the page
13700		; Save all AC's and load the arguments to the user's routine
13800		PUSHJ	P,CRYSAV		; SAVE THE AC'S AND RACS
13900		PUSH	P,CHNL			; CHAN
14000		MOVE	TEMP,IOPAGE(CDB)	; GET PAGE OF FILE
14100		LSH	TEMP,11			; CONVERT TO WORD NUM IN FILE
14200		PUSH	P,TEMP
14300		HRRZ	TEMP,FKPAGE(CDB)	; GET PAGE IN CORE
14400		LSH	TEMP,11			; CONVERT TO ADDRESS OF BUFFER
14500		PUSH	P,TEMP
14600		ADDI	TEMP,777		; COMPUTE LAST WORD OF BUFFER
14700		PUSH	P,TEMP
14800		PUSHJ	P,@NCRYPT(CDB)		; CALL USER'S ROUTINE
14900	
15000		PUSHJ	P,CRYRST		; RESTORE AC'S AND RACS
15100		PUSH	P,1			; MAP PAGE BACK TO FILE
15200		PUSH	P,2
15300		PUSH	P,3
15400		HRL	2,1			; THE JFN is in 1
15500		HRR	2,IOPAGE(CDB)
15600		MOVE	1,FKPAGE(CDB)
15700		SETZ	3,
15800		TESTO	3,1B9			; SET WRITE BIT
15900		PMAP				; WRITE FILE
16000		POP	P,3
16100	SKIPIT:	POP	P,2
16200		POP	P,1
16300		POPJ	P,
16400	
16500	;;	Routine to decrypt an incoming page, guaranteed to be
16600	;;	copy-on-write.
16700	;;	CHNL, CDB loaded
16800	
16900	CALDCR:	PUSHJ	P,CRYSAV		; SAVE THE AC'S AND RACS
17000		PUSH	P,CHNL			; CHAN
17100		MOVE	TEMP,IOPAGE(CDB)	; GET PAGE OF FILE
17200		LSH	TEMP,11			; CONVERT TO WORD NUM IN FILE
17300		PUSH	P,TEMP
17400		HRRZ	TEMP,FKPAGE(CDB)	; GET PAGE IN CORE
17500		LSH	TEMP,11			; CONVERT TO ADDRESS OF BUFFER
17600		PUSH	P,TEMP
17700		ADDI	TEMP,777		; COMPUTE LAST WORD OF BUFFER
17800		PUSH	P,TEMP
17900		PUSHJ	P,@DCRYPT(CDB)		; CALL USER'S ROUTINE
18000		PUSHJ	P,CRYRST		; RESTORE AC'S AND RACS
18100		POPJ	P,			; Note we can't use PJRST here!
18200	
18300	>; CRYPT
     
00100	DSCR
00200		BOOLEAN PROCEDURE INDEXFILE(INTEGER JFN)
00300	
00400	RETURNS TRUE AS LONG AS WE CAN GNJFN ANOTHER FILE
00500	
00600	
00700	HERE(INDEXFILE)
00800		PUSH	P,-1(P)
00900		PUSHJ	P,CLOSF
01000		PUSH	P,-1(P)
01100		PUSHJ	P,GNJFN
01200		JUMPE	1,INDRET		;RETURN FALSE IF NO OTHER FILES
01300		PUSH	P,2
01400		PUSH	P,CDB
01500		PUSH	P,CHNL		
01600	;CHANNEL ALREADY VALID
01700		MOVE	CHNL,-4(P)			;CHANNEL NUMBER
01800		MOVE	CDB,CDBTBL(CHNL)		;CDB LOC
01900		HRRZ	1,JFNTBL(CHNL)		;JFN
02000		MOVE	2,OFL(CDB)		;GET OPENFLAGS
02100		JSYS OPENF			;TRY OPENING
02200		  JRST NOIND
02300		SKIPE	ENDFL(CDB)		;ZERO SETINPUT (or OPEN) VARIABLES IF HERE
02400		  SETZM	@ENDFL(CDB)
02500		SKIPE	BRCHAR(CDB)
02600		  SETZM	@BRCHAR(CDB)
02700		SKIPE	LINNUM(CDB)		;ZERO SETPL VARS
02800		  SETZM	@LINNUM(CDB)
02900		SKIPE	PAGNUM(CDB)
03000		  SETZM	@PAGNUM(CDB)
03100		SKIPE	SOSNUM(CDB)
03200		  SETZM	@SOSNUM(CDB)
03300		SETO	1,
03400	INDPOP:	POP	P,CHNL
03500		POP	P,CDB
03600		POP	P,2
03700	INDRET:	SUB	P,X22	
03800		JRST	@2(P)
03900	
04000	NOIND:	ERR <INDEXFILE:  CANNOT OPENF>,1
04100		SETZ	1,
04200		JRST	INDPOP
     
00100	DSCR SETCHAN(JFN,GTFLAGS,OPFLAGS)
00200	
00300		JFN is a real TENEX jfn.  It is inserted in the SAIL
00400	runtime system, and the internal book-keeping is set to
00500	believe that the GTJFN was done with GTFLAGS and the OPENF
00600	with OPFLAGS.  JFN may have come from some random source.
00700	
00800	HERE(SETCHAN)
00900		PUSHJ	P,SAVE
01000		MOVE	LPSA,X44
01100		MOVE	A,-3(P)				;JFN
01200		PUSHJ	P,SETCHN
01300		MOVEM	A,RACS+A(USER)			;CHANNEL
01400		HRROI	A,-1(P)				;PREPARE FOR POPPING
01500		POP	A,OFL(CDB)			;MOVE FROM THE STACK
01600		POP	A,GFL(CDB)
01700		JRST	RESTR
01800	
01900	ENDCOM(OPF)
     
00100	COMPIL(GTJFN,<GTJFN,GTJFNL>,<.SKIP.,SETCHN,CATCHR,X11,X22,X44>,<GTJFN -- GET A JFN>)
00200	DSCR INTEGER SIMPLE PROCEDURE GTJFN(STRING S; INTEGER FLAGS)
00300		Does a GTJFN.  If S is non-null, it is the filename, otherwise
00400	the routine goes to the user's console for a file.  FLAGS are used for
00500	accumulator 1, and any error code is returned in .SKIP.  The value
00600	of the call is the JFN, if obtained.
00700		Defaults for FLAGS:  0  means ordinary input, 1 means ordinary
00800	output.  Ordinarily the user will use the OPENFI routine.
00900	
01000	
01100	HERE(GTJFN)
01200		SKIPN	1,-1(P)
01300		  MOVSI 1,100001
01400		CAIN	1,1
01500		  MOVSI	1,600001
01600		TLO	1,1			;MARK FOR SHORT CALL
01700		HRRZ	2,-1(SP)
01800		JUMPE	2,[MOVE 2,[100000101]
01900			  TLO	1,2		;INDICATE XWD JFN,JFN IN 2
02000			   JRST GOTDEST]
02100		TLZ	1,2			;INDICATE BYTE-POINTER IN 2
02200		PUSH	P,[0]			
02300		PUSHJ	P,CATCHR		;PUT ON A NULL
02400		MOVE	2,(SP)
02500	GOTDEST: SETZM	.SKIP.			;ASSUME NO ERROR
02600		PUSH	P,1			;SAVE FLAGS
02700		JSYS GTJFN
02800		  JRST GTBAD 		; SOMETHING IS WRONG
02900		PUSHJ	P,SETCHN	;SETUP A CHANNEL, AND ALLOCATE, GET STATUS, SET CDB
03000		POP	P,GFL(CDB)	;SAVE FLAGS
03100	GTRET:	SUB	SP,X22
03200		SUB	P,X22
03300		JRST	@2(P)
03400	
03500	GTBAD:
03600		
03700		MOVEM 	1,.SKIP.		; REMEMBER
03800		POP	P,1			;ADJUST STACK
03900		SETO 	1, 		; SOMETHING SUSPICIOUS TO RETURN TO USER
04000		JRST	GTRET
04100	
     
00100	DSCR INTEGER PROCEDURE GTJFNL(STRING ORIG; INTEGER FLAGS, XWDJFN!JFN;
00200		STRING DEV,DIR,NAM,EXT,PROT,ACCOUNT; INTEGER DESIRED!JFN)
00300	
00400		Does the long form of GTJFN.  
00500	
00600	HERE(GTJFNL)
00700		BEGIN GTJFNL
00800	
00900	DEFINE STRPUT(X)<
01000		PUSHJ	P,.STPUT
01100		MOVEM	A,X
01200	>
01300	DEFINE FLG <-14(P)>
01400	DEFINE IOJFN <-13(P)>
01500	DEFINE DESJFN <-12(P)>
01600		ADD	P,[XWD 11,11]		;ROOM FOR LONG-FORM TABLE
01700		TLNN	P,400000		;OVERFLOW?
01800		  ERR	<GTJFNL:  P-stack overflow>
01900		MOVE	A,DESJFN	
02000		MOVEM	A,0(P)			;THE DESIRED JFN
02100		STRPUT	-1(P)			;ACCOUNT
02200		STRPUT	-2(P)			;PROTECTION
02300		STRPUT	-3(P)			;EXTENSION
02400		STRPUT	-4(P)			;NAME
02500		STRPUT	-5(P)			;DIRECTORY
02600		STRPUT	-6(P)			;DEVICE
02700		MOVE	A,IOJFN			;XWD INPUT JFN, OUTPUT JFN
02800		MOVEM	A,-7(P)
02900		MOVE	A,FLG	
03000		MOVEM	A,-10(P)
03100		STRPUT	B			;MAIN STRING POINTER
03200		MOVEI	A,-10(P)		;ADDRESS OF BLOCK (ON STACK)
03300		SETZM	.SKIP.			;ASSUME NO ERROR
03400		JSYS	GTJFN			;LONG FORM
03500		   JRST	GTLBAD			;NOPE
03600		PUSHJ	P,SETCHN		;SET UP CHANNEL TABLE, ALLOCATE, GET STATUS, SET CDB
03700		MOVE	B,-10(P)		;GTJFN FLAGS
03800		MOVEM	B,GFL(CDB)		;SAVE
03900	GTLRET:	SUB	P,[XWD 11+4,11+4]	;ADJUST STACK FOR LONG-FORM TABLE, AND ARGUMENTS
04000		JRST	@4(P)			;AND RETURN
04100	
04200	GTLBAD:	MOVEM	A,.SKIP.		;RETURN ERROR CODE TO USER
04300		SETO	A,			;SOMETHING SUSPICIOUS
04400		JRST	GTLRET			;AND RETURN
04500	
04600	.STPUT:	HRRZ	A,-1(SP)		;GET THE COUNT
04700		  JUMPE	A,[SUB	SP,X22		;ADJUST AND RETURN
04800			   POPJ	P,]
04900		PUSH	P,[0]
05000		PUSHJ	P,CATCHR
05100		POP	SP,A
05200		SUB	SP,X11
05300		POPJ	P,
05400	
05500	
05600		BEND GTJFNL
05700	
05800	
05900	
06000	ENDCOM(GTJFN)
     
00100	COMPIL(FILINF,<GNJFN,DELF,DELF$,UNDELETE,DELNF,SIZEF,JFNS,JFNSL,OPENF,CFILE,CLOSF,CLOSF$,RLJFN,GTSTS,STSTS,RNAMF,SACTF>
00200		,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST,FINIO,CATCHR,CVJFN>
00300		,<FILINF -- UTILITY FILE ROUTINES>)
00400	
00500	
00600	DSCR INTEGER SIMPLE PROCEDURE GNJFN(INTEGER JFN)
00700		Does the GNJFN jsys.
00800	
00900	HERE(GNJFN)
01000		PUSHJ	P,SAVE
01100		MOVE	LPSA,X22
01200		VALCHN 1,<-1(P)>,GNERR
01300		MOVE	1,JFNTBL(CHNL)		;GET THE WHOLE JFN
01400		JSYS	GNJFN
01500		  JRST	GNRLZ			;FAILURE TO INDEX, RELEASE JFN
01600		MOVEM	1,.SKIP.		;SAVE BITS INDICATING CHANGE
01700		SETOM	RACS+A(USER)		;INDICATE SUCCESS
01800	GNRET:	JRST	RESTR
01900	
02000	GNERR:  ERR <Illegal JFN>,1
02100		SETZM	RACS+A(USER)
02200		JRST	RESTR
02300	
02400	GNRLZ:	SETZM	.SKIP.			;NOTHING THERE
02500		SETZM	RACS+A(USER)		;FAILURE TO INDEX
02600		PUSH	P,-1(P)
02700		PUSHJ	P,CFILE			;SO RELEASE FILE
02800		JRST	RESTR
02900	
     
00100	DSCR	PROCEDURE DELF(INTEGER CHAN,BITS[0])
00200		Deletes file open on CHAN.  Errors to .SKIP. 
00300	
00400	HERE(DELF)
00500	;[clh] this is the old form of DELF, without the second arg
00600		PUSH	P,0(P)		;[CLH] RET, RET
00700		SETZM	-1(P)		;[CLH] 0, RET
00800	
00900	HEREFK(DELF$,DELF.)
01000	;[clh] this is the new DELF
01100		PUSH	P,1
01200		VALCH1	1,-3(P),DELF1
01300		HLL	1,-2(P)		;[clh] get user bits
01400		TLO	1,400000		;DONT RELEASE THE JFN
01500		JSYS	DELF
01600		  JRST	DELF2
01700		SETZM	.SKIP.			;NO ERROR
01800	DELFRE:	POP	P,1
01900		SUB	P,X33
02000		JRST	@3(P)
02100	DELF1:	SETO	1,
02200	DELF2:	MOVEM	1,.SKIP.
02300		JRST	DELFRE
02400	
02500	DSCR INTEGER PROCEDURE DELNF(INTEGER CHAN,NUM)
02600	
02700	HERE(DELNF)
02800		PUSHJ	P,SAVE
02900		MOVE	LPSA,X33
03000		VALCH1	1,-2(P),DLNERR
03100		MOVE	2,-1(P)
03200		SETZM	.SKIP.
03300		JSYS	DELNF
03400		  JRST	DLNERR
03500		MOVM	2,2			;ABSOLUTE NUMBER OF
03600		MOVEM	2,RACS+A(USER)		;FILES DELETED
03700		JRST	RESTR	
03800	DLNERR:	MOVEM	1,.SKIP.;
03900		SETZM	RACS+A(USER)		;INDICATE NO FILES DELETED
04000		JRST	RESTR
     
00100	DSCR	PROCEDURE UNDELETE(INTEGER CHAN)
00200		Undeletes file open on CHAN.  Errors to .SKIP.
00300	
00400	HERE(UNDELETE)
00500		PUSHJ	P,SAVE
00600		MOVE	LPSA,X22
00700		VALCH1	1,-1(P),UNDEL1
00800		HRLI	1,1			;XWD 1,JFN
00900		MOVSI	2,(1B3)			;DELETED BIT
01000		SETZ	3,			;TURN IT OFF
01100		JSYS	CHFDB			;CHANGE THE FDB
01200		JRST	RESTR
01300	UNDEL1:	SETOM	.SKIP.
01400		JRST	RESTR
01500		
01600	
01700	
01800	
     
00100	DSCR	INTEGER PROCEDURE SIZEF(INTEGER JFN)
00200		Gets the size in pages of the file open on JFN, with error code to 
00300	.SKIP.
00400	
00500	HERE(SIZEF)
00600		PUSHJ	P,SAVE
00700		MOVE	LPSA,X22
00800		VALCHN 1,<-1(P)>,SIZERR
00900		SETZM	.SKIP.
01000		JSYS SIZEF
01100		JRST [MOVEM 1,.SKIP.
01200			SETZM	RACS+A(USER)
01300			JRST SIZRET]
01400		MOVEM	3,RACS+A(USER)		;ANSWER IN AC 3
01500	SIZRET:	JRST	RESTR
01600	
01700	SIZERR: ERR <Illegal JFN>
01800		SETOM	.SKIP.
01900		JRST	SIZRET
02000	
02100	
     
00100	
00200	DSCR STRING SIMPLE PROCEDURE JFNS(INTEGER JFN,FLAGS)
00300		Returns the name of the file associated with JFN.
00400	FLAGS are for ac 3 as described in the jsys manual, with
00500	0 the reasonable default.
00600	
00700	
00800	HERE(JFNS)
00900		VALCHN	2,<-2(P)>,JFNSER	;GET JFN IN AC2
01000		PUSH	P,[=400]
01100		PUSHJ	P,ZSETST		;GET BP IN AC 1
01200		MOVE	3,-1(P)
01300		JSYS JFNS
01400		PUSH	P,[=400]
01500		PUSH	P,1
01600		PUSHJ	P,ZADJST
01700	JFNSRE:	SUB	P,X33
01800		JRST	@3(P)
01900	JFNSER: ERR <Illegal JFN>,1
02000		PUSH	SP,[0]			;RETURN NULL STRING
02100		PUSH	SP,[0]
02200		JRST	JFNSRE
02300	
02400	
02500	DSCR JFNSL is added to correct a design error in JFNS, which did
02600	not allow full flexibility.
02700	
02800	
02900	HERE(JFNSL)
03000		BEGIN JFNSL
03100		VALCHN	2,<-3(P)>,JFNSER	;VALIDATE, GETTING JFN IN 2
03200		MOVE	1,-1(P)			;FLAGS FOR LH
03300		CAMN	1,[-1]			;-1??
03400		 HLRZ	1,JFNTBL(CHNL)		;YES, GET THOSE USED BY GTJFN
03500		HRL	2,1			;NOW PUT FLAGS INTO LH(2)
03600		PUSH	P,[=400]
03700		PUSHJ	P,ZSETST		;GET BP IN AC 1
03800		MOVE	3,-2(P)			;CONTROL FLAGS FOR FORMAT
03900		JSYS JFNS
04000		PUSH	P,[=400]
04100		PUSH	P,1
04200		PUSHJ	P,ZADJST
04300	JFNSRE:	SUB	P,[XWD 4,4]
04400		JRST	@4(P)
04500	JFNSER: ERR <Illegal JFN>,1
04600		PUSH	SP,[0]			;RETURN NULL STRING
04700		PUSH	SP,[0]
04800		JRST	JFNSRE
04900	
05000		BEND JFNSL
     
00100	DSCR SIMPLE PROCEDURE OPENF(INTEGER JFN,FLAGS)
00200		Does an OPENF.
00300	
00400	PARAMETERS:
00500		JFN     the JFN
00600		FLAGS 	for accumulator 2.
00700		.SKIP.	the error code (if pertinent)
00800	
00900	Some defaults:
01000		FLAGS		ACTION
01100		-----------------------
01200		0		INPUT CHARACTERS
01300		1		OUTPUT CHARACTERS
01400		2		INPUT 36-BIT WORDS
01500		3		OUTPUT 36-BIT WORDS
01600		4		DUMP MODE INPUT (USE DUMPI FUNCTION)
01700		5		DUMP MODE OUTPUT (USE DUMPO FUNCTION)
01800		VALUES 6-10 ARE RESERVED FOR EXPANSION
01900	
02000	Other values of FLAGS are interpreted literally.
02100		Ordinarily the user will use the OPENFI routine.
02200	
02300	
02400	HERE(OPENF)
02500		PUSHJ	P,SAVE
02600		MOVE	LPSA,X33
02700		VALCHN	1,-2(P),OPNERR
02800		SKIPL	2,-1(P)		;GET THE FLAGS
02900		CAILE	2,5		;CHECK IN RANGE 0-5
03000		   JRST	GOTFLAGS
03100		MOVE	2,OPNTBL(2)	;GET CORRECT WORD
03200	GOTFLAGS:
03300		SETZM	.SKIP.
03400		PUSH	P,2		;SAVE FLAGS
03500		JSYS OPENF
03600		  JRST	NOOPN
03700		POP     P,OFL(CDB)	;AND SAVE FLAGS
03800		SETZM	IOSTT(CDB)	;CLEAR STATUS
03900	OPNRET:	JRST	RESTR
04000	
04100	OPNERR: ERR <Illegal JFN>,1
04200		SETOM	.SKIP.
04300		JRST	OPNRET
04400	
04500	NOOPN:	MOVEM	1,.SKIP.
04600		SUB	P,X11		;ADJUST STACK
04700		JRST	OPNRET
04800	
04900	OPNTBL:	070000200000		;7-BIT READ
05000		070000100000		;7-BIT WRITE
05100		440000200000		;36-BIT READ
05200		440000100000		;36-BIT WRITE
05300		447400200000		;36-BIT DUMP READ
05400		447400100000		;36-BIT DUMP WRITE
     
00100	
00200	DSCR SIMPLE INTEGER PROCEDURE CFILE(INTEGER JFN)
00300		Closes the file (CLOSF) and releases (RLFJN)
00400	the jfn.  This is the ordinary way the user will use
00500	to dispense with a file.
00600		Returns TRUE if JFN legal and released, FALSE o.w.
00700	Always returns.
00800	
00900	
01000	HERE(CFILE)
01100		PUSH	P,2
01200		PUSH	P,3
01300		PUSH	P,CHNL
01400		PUSH	P,CDB
01500		SKIPL	CHNL,-5(P)
01600		CAIL	CHNL,JFNSIZE
01700		   JRST	CFBAD
01800		MOVE	CDB,CDBTBL(CHNL)	;GET CDB
01900		SKIPN	1,JFNTBL(CHNL)	;JFN ASSIGNED?
02000		   JRST	CFBA1		;NO, JUST RELEASE CORE
02100		HRRZ	1,1		;JFN ONLY
02200		PUSHJ	P,FINIO		;WRITE OUT REMAINING STUFF, CHECK EOF, MAGTAPE
02300	
02400	RLCOR:	SKIPN	B,CDBTBL(CHNL)	;[CLH] ANY CORE TO RELEASE?
02500		JRST RLCOR1		;[CLH] NO
02600		SKIPLE	B,OPNDUN(B)	;[CLH] YES, POINT TO DEVICE NAM BLOCK?
02700		  PUSHJ	P,CORREL	;[CLH] YES, DO IT FIRST
02800		SKIPE	B,CDBTBL(CHNL)	; ANY CORE TO RELEASE?
02900		  PUSHJ	P,CORREL	; RELEASE THE BLOCK
03000	RLCOR1:	TLZ	1,400000	; BE SURE TO RELEASE
03100		JSYS CLOSF		; CLOSE (AND RELEASE)
03200		   JFCL			; ERROR RETURN
03300		HRRZ	1,JFNTBL(CHNL)	; GET JFN AGAIN
03400		JSYS	RLJFN		; RELEASE (FOR GOOD MEASURE IF FILE NOT OPEN)
03500		   JFCL			; ERROR RETURN
03600		SETO	1, 		; RETURN TRUE FOR GOOD RELEASE
03700	      	SETZM	CDBTBL(CHNL)
03800		SETZM	JFNTBL(CHNL)
03900	CFRET:	POP	P,CDB
04000		POP	P,CHNL
04100		POP	P,3
04200		POP	P,2
04300		SUB	P,X22 		; ADJUST
04400		JRST	@2(P) 		; RETURN
04500	
04600	CFBAD:	SETZ	1, 		; RETURN FALSE
04700		JRST	CFRET ;
04800	
04900	CFBA1:	SKIPN	B,CDB		;[CLH] ANY CORE TO RELEASE?
05000		JRST 	CFBA2		;[CLH] NO
05100		SKIPLE	B,OPNDUN(B)	;[CLH] YES, POINT TO DEVICE NAM BLOCK?
05200		  PUSHJ	P,CORREL	;[CLH] YES, DO IT FIRST
05300		SKIPE	B,CDB
05400		PUSHJ	P,CORREL	;RELEASE CORE BLOCK
05500	CFBA2:	SETZM	CDBTBL(CHNL)	;REMOVE ALL TRACE
05600		SETZM	JFNTBL(CHNL)	
05700		SETZ	1,		; RETURN FALSE
05800		JRST	CFRET
05900	
     
00100	DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN,bits[0])
00200		Does a CLOSF on the JFN.  Ordinarily the user
00300	will want to use the CFILE routine, which handles errors
00400	internally. The CLOSF is accomplished in such a way that
00500	the JFN is actually not released.
00600		If the device is a magtape open for output, then
00700	2 eof's are written, followed by a backspace, unless the
00800	abort close bit is set.  This writes a standard end-of-file 
00900	on the tape.
01000	
01100	
01200	HERE(CLOSF)
01300	;[clh] this is the old form, with only one arg
01400		PUSH	P,0(P)		;[CLH] RET, RET
01500		SETZM	-1(P)		;[CLH] 0, RET
01600	
01700	HEREFK(CLOSF$,CLOSF.)
01800	;[clh] this is the new closf
01900		PUSHJ	P,SAVE
02000		MOVE	LPSA,X33
02100		VALCHN	1,<-2(P)>,CLOERR
02200		HLL	1,-1(P)		;ADD IN BITS
02300		TLNE	1,4000		;IF ABORT CLOSE, JUST UNMAP BUFFERS
02400		PUSHJ	P,ZAPBUF
02500		TLNN	1,4000		;IF NOT ABORT CLOSE
02600		PUSHJ	P,FINIO		;THEN WRITE OUT BUFFERS, ETC.
02700	
02800	DOCLO:	SETZM 	.SKIP.		;ASSUME NO ERROR
02900		TLO 1,400000 		; DO NOT RELEASE THE JFN
03000		JSYS CLOSF
03100		  MOVEM	1,.SKIP.	;ERROR
03200	CLORET:	JRST	RESTR
03300	
03400	CLOERR:	
03500		SETOM	.SKIP.
03600		JRST	CLORET
03700	
03800	;[CLH] ROUTINE TO UNMAP PAGES ON ABORT CLOSE
03900	ZAPBUF:	PUSH P,1
04000		PUSH P,2
04100		PUSH P,3
04200		SETO 1,			;KILL PAGE
04300		MOVE 2,-6(P)		;CHANNEL NUMBER
04400		HRRI 2,STARTPAGE(2)	;BUFFER PAGE
04500		HRLI 2,400000		;THIS PROCESS
04600		SETZ 3,
04700		JSYS PMAP
04800		POP P,3
04900		POP P,2
05000		POP P,1
05100		POPJ P,
05200	;[CLH] ^^
     
00100	DSCR SIMPLE PROCEDURE RLJFN(INTEGER JFN)
00200		Does the RLJFN jsys.  Ordinarily the user will want
00300	to use the CFILE routine, which handles errors internally.
00400	
00500	
00600	HERE(RLJFN)
00700		PUSHJ	P,SAVE
00800		MOVE	LPSA,X22
00900		SKIPL	C,-1(P)
01000		CAIL	C,JFNSIZE
01100		   JRST	RLJBAD
01200		SKIPN	1,JFNTBL(C)
01300	 	   JRST	RLJBAD
01400		SETZM	JFNTBL(C)	
01500		SKIPN	B,CDBTBL(C)	;[CLH] ANY CORE TO RELEASE?
01600		JRST RLJRT1		;[CLH] NO
01700		SKIPLE	B,OPNDUN(B)	;[CLH] YES, POINT TO DEVICE NAM BLOCK?
01800		  PUSHJ	P,CORREL	;[CLH] YES, DO IT FIRST
01900		SKIPE	B,CDBTBL(C)
02000		PUSHJ	P,CORREL
02100	RLJRT1:	SETZM	CDBTBL(C)
02200		SETZM	.SKIP.		;ASSUME NO ERROR
02300		JSYS RLJFN
02400		  MOVEM	1,.SKIP.	;ERROR RETURN
02500	RLJRET:	JRST	RESTR
02600	
02700	RLJBAD: ERR <Illegal JFN>,1
02800		SETOM 	.SKIP.
02900		JRST	RLJRET
03000	
03100	
     
00100	DSCR INTEGER SIMPLE PROCEDURE GTSTS(INTEGER JFN);
00200		Gets the file status. 
00300		WARNING: The results of this call are not necessarily appropriate
00400	if the file is open in special character input mode.  If you want to check
00500	for end-of-file, examine the EOF variable instead.
00600	
00700	
00800	HERE(GTSTS)
00900		PUSHJ	P,SAVE
01000		MOVE	LPSA,X22
01100		VALCHN	1,<-1(P)>,GTSERR
01200		JSYS GTSTS
01300		MOVEM	2,RACS+A(USER)
01400	GTSRET:	JRST	RESTR
01500	
01600	GTSERR:	ERR <Illegal JFN>,1
01700		JRST	GTSRET
     
00100	DSCR BOOLEAN SIMPLE PROCEDURE STSTS(INTEGER JFN,STATUS);
00200		Sets the status of JFN to STATUS using the STSTS jsys.
00300	
00400	
00500	HERE(STSTS)
00600		VALCH1 	1,<-2(P)>,STSERR
00700		MOVE	2,-1(P)
00800		SETO	3,			;ASSUME	SKIP
00900		SETZM	.SKIP.
01000		JSYS	STSTS
01100		  JRST [STERRT: SETZ	3,			;PROBLEM	
01200			MOVEM	1,.SKIP.
01300			JRST .+1]
01400		MOVE	1,3			;RETURN
01500		SUB	P,X33
01600		JRST	@3(P)
01700	
01800	STSERR:	ERR <Illegal JFN>,1
01900		JRST	STERRT			;RETURN
02000	
     
00100	DSCR BOOLEAN SIMPLE PROCEDURE RNAMF(INTEGER EXISTINGJFN,NEWJFN);
00200		File open on EXISTINGJFN is renamed to file open
00300	on NEWJFN.
00400	
00500	HERE(RNAMF)
00600		VALCH1	1,<-2(P)>,RNFERR
00700		VALCH1	2,<-1(P)>,RNFERR
00800		SETO	3,			;ASSUME OK
00900		SETZM	.SKIP.
01000		JSYS	RNAMF
01100		   JRST [RNERET:  SETZ	3,
01200			 MOVEM	1,.SKIP.
01300			 JRST	.+1]
01400	RNFRET:	MOVE	1,3			;RETURN VALUE
01500		SUB	P,X33
01600		JRST	@3(P)
01700	
01800	RNFERR:	ERR <Illegal JFN>,1
01900		JRST	RNERET
02000	
02100	;[CLH/DAW]
02200	DSCR BOOLEAN SIMPLE PROCEDURE SACTF(INTEGER CHAN; STRING ACCOUNTSTRING);
02300		Sets the file's account string.
02400		Returns success flag.
02500	
02600	HEREFK(SACTF,$SACTF)
02700	
02800		push	p,b
02900		PUSH	P,[0]		;MAKE ASCIZ
03000		PUSHJ	P,CATCHR
03100		push	p,-2(p)		;get channel number as arg to cvjfn
03200		pushj	p,cvjfn		;get jfn to AC1
03300		tlz	a,-1		;jfn only
03400		move	b,(sp)		;get pointer to acct str into AC2
03500		setzm	.skip.		;assume success
03600		JSYS 	SACTF
03700		 jrst	sactff		;failed, code in a
03800		seto	a,		;success - return true
03900	sactfs:	pop	p,b		;retore ac's
04000		SUB	P,X22
04100		SUB	SP,X22
04200		jrst	@2(p)
04300	sactff:	movem	a,.skip.	;put code in .skip.
04400		setz	a,		;say failed
04500		jrst	sactfs		;and return
04600	;[CLH/DAW]^^
04700	
04800	ENDCOM(FILINF)	
     
00100	COMPIL(DEVINF,<CNDIR,ACCES,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST,GTFDB,CHFDB>
00200		,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,CATCHR,ZSETST,ZADJST>
00300		,<DEVINF -- DEVICE AND DIRECTORY ROUTINES>)
00400	
00500	DSCR BOOLEAN SIMPLE PROCEDURE CNDIR(INTEGER DIR; STRING PASSWORD);
00600		Using the CNDIR jsys, connects to TENEX directory DIR (for
00700	AC1.)  PASSWORD is the password, which will usually be null, as
00800	in the EXEC CONNECT command.
00900	
01000	
01100	HERE(CNDIR)
01200		PUSH	P,[0]
01300		PUSHJ	P,CATCHR		;PUT A NULL ON THE END OF THE PASSWORD
01400		POP	SP,2			;GET BP IN 2
01500		SUB	SP,X11			;CLEAN UP SP STACK
01600		MOVE	1,-1(P)			;DIRECTORY NO 
01700		SETO	3,			;ASSUME SUCCESS
01800		SETZM	.SKIP.
01900		JSYS	CNDIR
02000		  JRST	[SETZ 3,
02100			 MOVEM	1,.SKIP.
02200			 JRST	.+1]
02300		MOVE	1,3
02400		SUB	P,X22
02500		JRST	@2(P)
02600	
02700	;[CLH/DAW]
02800	DSCR BOOLEAN SIMPLE PROCEDURE ACCES(STRING DIRECTORY, PASSWORD[NULL];
02900						INTEGER FLAGS[CONNECT],JOBNO[-1]);
03000		this is the Tops-20 connect and access.  returns success.
03100	
03200	
03300	HEREFK(ACCES,$ACCES)
03400	
03500		push	p,b
03600		push	p,[0]		;make password ASCIZ
03700		pushj	p,catchr
03800		push	sp,-3(sp)	;make directory ASCIZ
03900		push	sp,-3(sp)
04000		push	p,[0]
04100		pushj	p,catchr
04200		move	a,-3(p)		;get flags
04300		cain	a,0		;if zero
04400		movsi	a,400000	;then assume connect
04500		hrri	a,3		;stuff in length of block
04600		push	p,(sp)		;put directory pointer into block
04700		movei	b,(p)		;top of stack is now addr of arg blk
04800		push	p,-2(sp)	;next password pointer
04900		push	p,-4(p)		;then job number
05000		skipn	(p)		;if zero
05100		setom	(p)		;then use this job
05200		jsys	acces
05300		 erjmp	acces2
05400		setzm	.skip.		;no error
05500		movei	a,1
05600	acces1: sub	p,x33		;get rid of arg block
05700		pop	p,b		;restore ac's
05800		sub	sp,[xwd 6,6]	;clean up and return
05900		sub	p,x33
06000		jrst	@3(p)
06100	acces2:	movei	a,400000	;get my last error
06200		jsys	geter
06300		setz	a,		;return error (false)
06400		hrrzm	b,.skip.	;put tenex error code here
06500		jrst	acces1
06600	
06700	;[clh/daw] ^^
     
00100	DSCR BOOLEAN PROCEDURE ASND(INTEGER DEVICE)
00200		Assigns the device specified by DEVICE using the ASND jsys.
00300	Returns TRUE if successful, else error code in .SKIP.
00400		
00500	
00600	HERE(ASND)
00700		MOVE	1,-1(P)			;GET DEVICE DESIGNATOR
00800		JSYS	ASND
00900		  JRST	[MOVEM 1,.SKIP.
01000			 SETZ	1,
01100			 JRST .+2]
01200		SETO	1,
01300		SUB	P,X22
01400		JRST	@2(P)
     
00100	DSCR BOOLEAN PROCEDURE RELD(INTEGER DEVICE)
00200		Releases DEVICE using the RELD jsys.  If DEVICE is -1,
00300	then releases all devices assigned to this job.
00400	
00500		
00600	HERE(RELD)
00700		MOVE	1,-1(P)
00800		JSYS	RELD
00900		  JRST	[MOVEM	1,.SKIP.
01000			 SETZ	1,
01100			 JRST	.+2]
01200		SETO	1,
01300		SUB	P,X22
01400		JRST	@2(P)
     
00100	DSCR INTEGER SIMPLE PROCEDURE GDSTS(INTEGER CHAN; REFERENCE INTEGER WORDCNT)
00200		Returns the device status of device open on CHAN using the GDSTS
00300	jsys.  The LH of WORDCNT has the word count of the last transfer completed,
00400	negative if the last transfer completed unsuccessful.
00500	
00600	
00700	HERE(GDSTS)
00800		VALCH1	1,<-2(P)>,GDSERR
00900		SETZM	.SKIP.
01000		JSYS	GDSTS
01100		MOVEM	3,@-1(P)			;REFERENCE ARG
01200		MOVE	1,2				;RETURN VALUE
01300	GDSRET:	SUB	P,X33
01400		JRST	@3(P)
01500	GDSERR:	ERR <Illegal JFN>,1
01600		SETOM	.SKIP.	
01700		SETZ	1,		
01800		JRST	GDSRET
     
00100	DSCR PROCEDURE SDSTS(INTEGER JFN,NEWSTATUS)
00200	
00300	HERE(SDSTS)
00400		VALCH1	1,<-2(P)>,SDSERR
00500		SETZM	.SKIP.				;INDICATE NO ERROR
00600		MOVE	2,-1(P)
00700		JSYS	SDSTS
00800	SDSRET:	SUB	P,X33
00900		JRST	@3(P)
01000	SDSERR:	ERR	<Illegal JFN>,1
01100		SETOM	.SKIP.
01200		JRST	SDSRET
     
00100	DSCR INTEGER PROCEDURE STDEV(STRING S)
00200		S is a string pointer to a string of the form DTA1.
00300	The device designator is returned.
00400	
00500	
00600	HERE(STDEV)
00700		PUSH	P,[0]
00800		PUSHJ	P,CATCHR
00900		POP	SP,1
01000		SUB	SP,X11			;CLEAN SP STACK
01100		SETZM	.SKIP.
01200		JSYS	STDEV
01300		  JRST	[PUSHJ	P,SAVE		;GET FRESH ACS
01400			 MOVEI	1,400000	;THIS FORK
01500			 JSYS 	GETER		;GET ERROR NUMBER
01600			 HRRZM	2,.SKIP.	;SAVE IN .SKIP. FOR USER
01700			 SETZM	RACS+1(USER)	;ZERO RETURN
01800			 SETZ	LPSA,		;NOTHING TO REMOVE FROM STACK
01900			 JRST	RESTR		;AND RETURN
02000			]
02100		MOVE	1,2
02200		POPJ	P,
02300	
     
00100	
00200	DSCR STRING PROCEDURE DEVST(INTEGER DEVICE)
00300	
00400	HERE(DEVST)
00500		PUSH	P,[=100]
00600		PUSHJ	P,ZSETST		;GET A BP FOR 100 CHARS
00700		SETZM	.SKIP.
00800		MOVE	2,-1(P)
00900		JSYS	DEVST
01000		  MOVEM	2,.SKIP.		;INDICATE ERROR
01100		PUSH	P,[=100]
01200		PUSH	P,1			;UPDATED BP
01300		PUSHJ	P,ZADJST
01400		SUB	P,X22
01500		JRST	@2(P)
01600		
     
00100	DSCR	SIMPLE PROCEDURE GTFDB(INTEGER JFN; REFERENCE INTEGER ARRAY BUF)
00200	
00300		Entire FDB of JFN is read into BUF.  No bounds checking,
00400	so BUF should be at least '26 words.
00500	
00600	HERE(GTFDB)
00700		PUSHJ	P,SAVE
00800		MOVE	LPSA,X33
00900		VALCHN	1,<-2(P)>,FDBAD
01000		MOVSI	2,25		;ALL 25 WORDS
01100		HRRZ 	3,-1(P)		;ADDRESS OF ARRAY
01200		JSYS GTFDB
01300		JRST	RESTR
01400	
01500	FDBAD: ERR <Illegal JFN>,1
01600		JRST	RESTR
01700	
01800	HERE(CHFDB)
01900	DSCR
02000		CHFDB(CHAN,DISPLACEMENT,MASK,CHANGED!BITS)
02100	
02200		PUSHJ	P,SAVE
02300		MOVE	LPSA,[XWD 5,5]
02400		VALCHN	1,-4(P),FDBAD		;GET JFN TO 1
02500		HRL	1,-3(P)			;DISPLACEMENT TO LEFT HALF OF ONE
02600		MOVE	2,-2(P)
02700		MOVE	3,-1(P)
02800		JSYS	CHFDB
02900		JRST	RESTR
03000	
     
00100	
00200	ENDCOM(DEVINF)
00300	
00400	DEFINE WORDROU < WORDIN,ARRYIN,WORDOUT,ARRYOUT,RWDPTR,SWDPTR >
00500	DEFINE CHARROU < CHARIN,SINI,INPUT,LREALIN,LREALSCAN,REALIN,REALSCAN,INTIN,INTSCAN,CHAROUT,OUT,LINOUT,RCHPTR,SCHPTR >
00600	DEFINE UTILROU < FINIO >
00700	
00800	COMPIL(IOROU,<WORDROU,CHARROU,UTILROU>
00900		,<JFNTBL,CDBTBL,X22,X33,X44,.SKIP.,SAVE,RESTR>
01000		,<IOROU -- Input and output routines>)	
01100	
     
00100	DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN);
00200		Reads a word in from the file
00300	
00400	HERE(WORDIN)
00500		BEGIN WORDIN
00600	
00700		PUSHJ	P,SAVE
00800		MOVE	LPSA,X22
00900		VALCHN	1,-1(P),WERR
01000		SETZEOF					;INDICATE NO EOF
01100	
01200	DOSIMIO:SIMIO	2,TABL,WERR			;SOSGE IOCNT(CDB)
01300		  JRST	.ADWI
01400		ILDB	2,IOBP(CDB)	
01500	STOAC2:	MOVEM	2,RACS+A(USER)
01600		JRST	RESTR
01700	
01800	DOBIN:	JSYS	BIN
01900		JUMPN	2,STOAC2			;CANNOT BE END OF FILE
02000	CHKEOF:	SETZM	RACS+A(USER)			;RETURN 0 IN ANY EVENT
02100		JSYS	GTSTS
02200		TESTE	2,1B8				;EOF?
02300		   JRST	INPEOF				;YES, INDICATE
02400		JRST	RESTR
02500	
02600	TABL:	JRST	DOSETWI				;0 -- SET UP
02700		JRST	.CISWI				;1 -- XICHAR
02800		JRST	.COSWI				;2 -- XOCHAR
02900		SOSGE	IOCNT(CDB)			;3 -- XIWORD
03000		JRST	.WOSWI				;4 -- XOWORD
03100		JRST	WERR				;5 -- XCICHAR
03200		JRST	WERR				;6 -- XCOCHAR
03300		JRST	DOBIN				;7 -- XCWORD
03400		REPEAT 4,<JRST WERR>			;10-13
03500	
03600	DOSETWI:
03700		PUSHJ	P,SETWI
03800		JRST	DOSIMIO
03900	
04000	
04100	.ADWI:	PUSHJ	P,ADWI
04200		  JRST	.ADEOF			;END OF FILE
04300		JRST	DOSIMIO				;START OVER
04400	
04500	.ADEOF:	SETZM	RACS+A(USER)			;RETURN 0 WORD
04600		JRST	INPEOF				;AND INDICATE EOF
04700	WERR:  	ERR	<Dryrot at WORDIN>,1
04800		SETZM	RACS+A(USER)
04900		JRST	INPEOF				;INDICATING EOF OR ERROR
05000	
05100	.CISWI:	PUSHJ	P,CISWI
05200		JRST	DOSIMIO
05300	
05400	.COSWI:	PUSHJ	P,COSWI
05500		JRST	DOSIMIO
05600	
05700	.WOSWI:	PUSHJ	P,WOSWI
05800		JRST	DOSIMIO
05900	
06000	
06100		BEND WORDIN
     
00100	HERE(ARRYIN)
00200		BEGIN ARRYIN
00300	
00400		PUSHJ	P,SAVE
00500		MOVE	LPSA,X44
00600	 	VALCHN	1,-3(P),WERR
00700		SETZEOF					;ASSUME OK
00800	DOSIMIO:
00900		SIMIO	2,TABL,WERR			;MOVE	6,-2(P)
01000		SKIPGE	2,-1(P)				;EXTENT
01100		  ERR	<ARRYIN:  Negative word count>
01200	WIN3:	JUMPE	2,RESTR				;NOTHING LEFT TO TRANSFER
01300		SKIPG	E,IOCNT(CDB)
01400		  JRST	WIN5
01500		IBP	IOBP(CDB)			;INCREMENT THE POINTER
01600		HRL	C,IOBP(CDB)			;SOURCE
01700		MOVEI	D,(6)				;FOR BLT
01800		HRR	C,6				;"TO" ADDRESS
01900		CAIG	B,(E)				;ENOUGH HERE
02000		  JRST	WIN4
02100		ADDI	D,-1(E)				;FINISH HERE
02200		BLT	C,(D)
02300		SUBM	E,IOCNT(CDB)
02400		ADDM	E,IOBP(CDB)
02500		ADD	6,E				;FIX INPUT POINTER
02600		SUB	B,E				;FIX INPUT COUNT
02700	WIN5:	PUSHJ	P,ADWI				;GET MORE
02800		  JRST	ISEOF				;END OF FILE -- NO MORE THERE
02900		JRST	WIN3
03000	WIN4:	ADDI	D,-1(B)				;
03100		BLT	C,(D)				;LAST BLT
03200		SUB	E,B				;FIX UP COUNT
03300		SOJ	B,
03400		MOVEM	E,IOCNT(CDB)
03500		ADDM	B,IOBP(CDB)
03600		JRST	RESTR
03700	
03800	TABL:	JRST	DOSETWI				;0 -- SET UP
03900		JRST	.CISWI				;1 -- XICHAR
04000		JRST	.COSWI				;2 -- XOCHAR
04100		MOVE	6,-2(P)				;3 -- XIWORD
04200		JRST	.WOSWI				;4 -- XOWORD
04300		JRST	WERR				;5 -- XCICHAR
04400		JRST	WERR				;6 -- XCOCHAR
04500		JRST	DOSIN				;7 -- XCWORD
04600		JRST	WERR				;10 -- XBYTE7
04700		JRST	WERR				;11 -- XDICHAR
04800		JRST	WERR				;12 -- XDOCHAR
04900		JRST	DODUMPI				;13 -- XDARR
05000	
05100	ISEOF:	MOVE	TEMP,-1(P)			;NUMBER OF WORDS WANTED
05200		SUBM	TEMP,B				;INPUT IN RH
05300	WIN2:	HRROM	B,.SKIP.
05400		SKIPE	ENDFL(CDB)
05500		  HRROM	B,@ENDFL(CDB)
05600		JRST	RESTR
05700	
05800	.CISWI:	PUSHJ	P,CISWI
05900		JRST	DOSIMIO
06000	
06100	.COSWI:	PUSHJ	P,COSWI
06200		JRST	DOSIMIO
06300	
06400	.WOSWI:	PUSHJ	P,WOSWI
06500		JRST	DOSIMIO
06600	
06700	DOSETWI:
06800		PUSHJ	P,SETWI
06900		JRST	DOSIMIO
07000	
07100	DOSIN:
07200		MOVN	3,-1(P)				;WORD COUNT	
07300		MOVSI	2,444400
07400		HRR	2,-2(P)				;ADDRESS OF BUFFER
07500		JSYS	SIN
07600		JUMPE	3,RESTR				;DID WE GET IT ALL?
07700	SINEOF:	ADD	3,-1(P)				;CALCULATE NO OF WORDS READ
07800		HRLI	3,-1				;MAKE IT XWD -1,,COUNT
07900		SKIPE	ENDFL(CDB)			;EOF LOCATION?
08000		  MOVEM	3,@ENDFL(CDB)			;YES
08100		MOVEM	3,.SKIP.
08200		JRST	RESTR				;AND RETURN
08300	
08400	DODUMPI:
08500		MOVN	3,-1(P)
08600		MOVEI	2,3
08700		HRL	3,3
08800		HRR	3,-2(P)				;ADDRESS OF BUFFER
08900		SUBI	3,1
09000		SETZ	4,				;END OF DUMP MODE COMMAND LIST
09100		JSYS	DUMPI				;DO IT
09200		  JRST	DMPERR
09300		JRST	RESTR				;ALL OK
09400	
09500	DMPERR:	CAIN	1,600220			;EOF?
09600		  JRST	DUMPEOF				;NO
09700		ERR	<ARRYIN:  Dump mode error>,1
09800		MOVEM	1,.SKIP.
09900		JRST	RESTR
10000	
10100	DUMPEOF:
10200		MOVE	1,DVTYP(CDB)
10300		CAIE	1,2				;MAGTAPE DEVICE?
10400		  JRST	INPEOF				;NO JUST INDICATE EOF
10500		HRRZ	1,JFNTBL(CHNL)	
10600		SETZ	2,				;MTOPR RESET
10700		JSYS	MTOPR	
10800		JRST	INPEOF				;INDICATE EOF AND RETURN
10900	
11000	WERR:	ERR	<ARRYIN:  Illegal JFN, byte-size, or mode.>,1
11100		JRST	INPEOF
11200	
11300	
11400		BEND ARRYIN
     
00100	HERE(WORDOUT)
00200		BEGIN WORDOUT
00300		PUSHJ	P,SAVE
00400		MOVE	LPSA,X33
00500		VALCHN	1,-2(P),WERR
00600		SETZEOF
00700	DOSIMIO:SIMIO	2,TABL,WERR			;SOSGE IOCNT(CDB)
00800		  JRST	.ADWO
00900		MOVE	2,-1(P)
01000		IDPB	2,IOBP(CDB)
01100		JRST	RESTR
01200	
01300	TABL:	JRST	DOSETWO				;0 -- XNULL
01400		JRST	.CISWO				;1 -- XICHAR
01500		JRST	.COSWO				;2 -- XOCHAR
01600		JRST	.WISWO				;3 -- XIWORD
01700		SOSGE	IOCNT(CDB)			;4 -- XOWORD
01800		JRST	WERR				;5 -- XCICHAR
01900		JRST	WERR				;6 -- XCOCHAR
02000		JRST	DOBOUT				;7 -- XCWORD
02100		REPEAT 4,<JRST WERR>			;10-13
02200	
02300	.ADWO:	PUSHJ	P,ADWO
02400		JRST	DOSIMIO
02500	
02600	DOSETWO:
02700		PUSHJ	P,SETWO
02800		JRST	DOSIMIO
02900	
03000	.CISWO:	PUSHJ	P,CISWO
03100		JRST	DOSIMIO
03200	
03300	.COSWO:	PUSHJ	P,COSWO
03400		JRST	DOSIMIO
03500	
03600	.WISWO:	PUSHJ	P,WISWO
03700		JRST	DOSIMIO
03800	
03900	WERR:	ERR	<WORDOUT:  Illegal JFN, byte-size, mode, or combination>,1
04000		JRST	INPEOF				;AND INDICATE ERROR
04100	
04200	DOBOUT:	MOVE	2,-1(P)
04300		JSYS	BOUT
04400		JRST	RESTR
04500	
04600		BEND WORDOUT
     
00100	HERE(ARRYOUT)
00200		BEGIN ARRYOUT
00300	
00400		PUSHJ	P,SAVE
00500		MOVE	LPSA,X44
00600		VALCHN	1,-3(P),WERR
00700		SKIPN	3,-1(P)
00800		  JRST	RESTR				;NOTHING TO MOVE
00900		JUMPGE	3,.+2
01000		   JRST	WERR
01100		SETZEOF
01200	DOSIMIO:SIMIO	2,TABL				;MOVE	6-2(P)
01300		SKIPGE	B,-1(P)
01400		  ERR	<ARRYOUT:  Word count is negative>,1
01500	WOUT2:	SKIPG	E,IOCNT(CDB)
01600		  JRST	WOUT5
01700		JUMPE	B,RESTR				;NOTHING LEFT
01800		IBP	IOBP(CDB)
01900		MOVE	C,IOBP(CDB)			;TO ADDR
02000		HRRZI	D,(C)				;FOR BLT TERMINATION
02100		HRLI	C,(6)
02200		CAIGE	B,(E)				;ENOUGHT IN BUFFER
02300		  JRST	WOUT3				;YES
02400		ADDI	D,-1(E)				;FINAL ADDRESS
02500		BLT	C,(D)
02600		ADDI	6,(E)				;UPDATE BP
02700		SUBI	B,(E)	
02800		SETZM	IOCNT(CDB)
02900		HRRM	D,IOBP(CDB)
03000	WOUT5:	PUSHJ	P,ADWO
03100		JRST	WOUT2
03200	WOUT3:	JUMPLE	B,RESTR
03300		SOJ	B,
03400		ADD	D,B
03500		BLT	C,(D)
03600		SUBI	E,1(B)
03700		MOVEM	E,IOCNT(CDB)
03800		ADDM	B,IOBP(CDB)
03900		JRST	RESTR
04000	
04100	TABL:	JRST	DOSETWO				;0 -- XNULL
04200		JRST	.CISWO				;1 -- XICHAR
04300		JRST	.COSWO				;2 -- XOCHAR
04400		JRST	.WISWO				;3 -- XIWORD
04500		MOVE	6,-2(P)				;4 -- XOWORD
04600		JRST	WERR				;5 -- XCICHAR
04700		JRST	WERR				;6 -- XCOCHAR
04800		JRST	DOSOUT				;7 -- XBYTE36
04900		JRST	WERR				;10 -- XBYTE7
05000		JRST	WERR				;11 -- XDICHAR
05100		JRST	WERR				;12 -- XDOCHAR
05200		JRST	DODUMPO				;13 -- XDARR
05300	
05400	DOSETWO:
05500		PUSHJ	P,SETWO
05600		JRST	DOSIMIO
05700	
05800	.CISWO:	PUSHJ	P,CISWO
05900		JRST	DOSIMIO
06000	
06100	.COSWO:	PUSHJ	P,COSWO
06200		JRST	DOSIMIO
06300	
06400	.WISWO:	PUSHJ	P,WISWO
06500		JRST	DOSIMIO
06600	
06700	DOSOUT:	
06800		MOVN	3,-1(P)
06900		MOVSI	2,444400
07000		HRR	2,-2(P)
07100		JSYS	SOUT
07200		JRST	RESTR
07300		
07400	DODUMPO:
07500		MOVN	3,-1(P)
07600		MOVEI	2,3
07700		HRL	3,3
07800		HRR	3,-2(P)
07900		SUBI	3,1
08000		SETZ	4,
08100		JSYS	DUMPO
08200		  JRST	DMPERR
08300	    	SETOM	DMPED(CDB)			
08400		JRST	RESTR
08500	
08600	WERR:	ERR	<ARRYOUT:  Illegal JFN, byte-size, mode, or combination.>,1
08700		JRST	INPEOF
08800	
08900	
09000	DMPERR:	ERR	<ARRYOUT:  Dump mode error>,1
09100		MOVEM	1,.SKIP.			;SAVE TENEX ERROR NUMBER
09200		JRST	RESTR
09300	
09400	
09500		BEND ARRYOUT
     
00100	
00200	HERE(RWDPTR)
00300		BEGIN RWDPTR
00400	
00500		PUSHJ	P,SAVE
00600		MOVE	LPSA,X22
00700		VALCHN	1,-1(P),WERR
00800		SETZM	.SKIP.
00900	DOSIMIO:SIMIO	2,TABL,WERR			;PUSHJ P,GETWPT
01000	STOAC2:	MOVEM	2,RACS+A(USER)
01100		JRST	RESTR
01200	
01300	TABL:	JRST	RNULL				;0 -- XNULL
01400		PUSHJ	P,GETWPT			;1 -- XICHAR
01500		PUSHJ 	P,GETWPT			;2 -- XOCHAR	
01600		PUSHJ	P,GETWPT			;3 -- XIWORD
01700		PUSHJ	P,GETWPT			;4 -- XOWORD
01800		JRST	WERR				;5 -- XCICHAR
01900		JRST	WERR				;6 -- XCOCHAR
02000		JRST	DORFPTR				;7 -- XCWORD
02100		REPEAT 4,<JRST WERR>			;10-13
02200	
02300	DORFPTR:
02400		JSYS	RFPTR
02500		   JRST .+2
02600		JRST	STOAC2
02700		ERR	<RWDPTR:  Cannot do RFPTR.>,1
02800		MOVEM	1,.SKIP.
02900		JRST	RNULL
03000	WERR:	ERR	<RWDPTR:  Illegal JFN, illegal mode or byte size.>,1
03100		SETOM	.SKIP.
03200	
03300	RNULL:	
03400		PUSHJ	P,SETWIO
03500		JRST	DOSIMIO				;AND LOOK AGAIN
03600	
03700	
03800		BEND RWDPTR
     
00100	HERE(SWDPTR)
00200		BEGIN SWDPTR
00300		
00400		PUSHJ	P,SAVE
00500		MOVE	LPSA,X33
00600		VALCHN	1,-2(P),WERR	
00700		SETZM	.SKIP.
00800	DOSIMIO:MOVE	2,-1(P)				;PICK UP NEW WORD IN 2
00900		SIMIO	3,TABL,WERR
01000		JRST	RESTR
01100	
01200	TABL:	JRST 	RNULL				;0 -- XNULL
01300		PUSHJ	P,SETWPT			;1 -- XICHAR
01400		PUSHJ	P,SETWPT			;2 -- XOCHAR	
01500		PUSHJ	P,SETWPT			;3 -- XIWORD
01600		PUSHJ	P,SETWPT			;4 -- XOWORD
01700		JRST	WERR				;5 -- XCICHAR
01800		JRST 	WERR				;6 -- XCOCHAR
01900		JRST	DOSFPTR				;7 -- XCWORD
02000		REPEAT	4,<JRST	WERR>			;10-13
02100	
02200	DOSFPTR:JSYS	SFPTR
02300		  JRST	SFERR
02400		JRST	RESTR
02500	
02600	SFERR:	ERR	<SWDPTR:  Cannot do SFPTR>,1
02700		MOVEM	1,.SKIP.
02800		JRST	RESTR
02900	
03000	WERR:	ERR	<SWDPTR:  Illegal JFN, byte size, or mode.>,1
03100		SETOM	.SKIP.
03200		JRST	RESTR
03300	
03400	RNULL:	PUSHJ	P,SETWIO
03500		JRST	DOSIMIO
03600	
03700		BEND SWDPTR
     
00100	
00200	DSCR
00300		Some auxiliary routines, mostly for word i/o.
00400	
00500	INPEOF:
00600	;HERE IF WE HAVE HIT EOF ON INPUT AND WISH TO SIMPLY SAY SO AND RETURN
00700		SETOEOF
00800		JRST	RESTR
00900	
01000	;ROUTINES TO SET TO WORD OUTPUT
01100	COSWO:	PUSHJ	P,CHCEOF			;CHECK FOR NEW CHARACTER EOF
01200	CISWO:
01300	WISWO:
01400		PUSHJ	P,GTWPT1
01500		MOVEM	3,IOBP(CDB)
01600		MOVEM	4,IOCNT(CDB)
01700		MOVEI	3,XOWORD
01800		MOVEM	3,IOSTT(CDB)
01900		POPJ	P,
02000	
02100	;ROUTINES TO SET TO CHARACTER OUTPUT
02200	WOSCO:	PUSHJ	P,CHWEOF			;CHECK FOR NEW WORD EOF
02300	CISCO:
02400	WISCO:
02500		PUSHJ	P,GTCPT1
02600		MOVEM	3,IOBP(CDB)
02700		MOVEM	4,IOCNT(CDB)
02800		MOVEI	3,XOCHAR
02900		MOVEM	3,IOSTT(CDB)
03000		POPJ	P,
03100	
03200	
03300	;ROUTINES TO SET TO CHARACTER INPUT
03400	WOSCI:	PUSHJ	P,CHWEOF			;CHECK FOR NEW WORD EOF
03500		JRST	.+2	
03600	COSCI:	PUSHJ	P,CHCEOF			;CHECK FOR NEW CHARACTER EOF
03700	WISCI:	PUSHJ	P,GTCPT1
03800		MOVEM	3,IOBP(CDB)
03900		MOVEM	5,IOCNT(CDB)
04000		MOVEI	3,XICHAR
04100		MOVEM	3,IOSTT(CDB)
04200		POPJ	P,
04300	
04400	;ROUTINES TO SET TO WORD INPUT
04500	COSWI:	PUSHJ	P,CHCEOF			;CHECK FOR NEW CHARACTER EOF
04600		JRST	.+2
04700	WOSWI:	PUSHJ	P,CHWEOF			;CHECK FOR NEW WORD EOF
04800	CISWI:	PUSHJ	P,GTWPT1
04900		MOVEM	3,IOBP(CDB)
05000		MOVEM	5,IOCNT(CDB)
05100		MOVEI	3,XIWORD
05200		MOVEM	3,IOSTT(CDB)
05300		POPJ	P,
05400	
05500	
05600	SETWND:
05700	;1, CDB LOADED
05800	;SETS THE FDB SO THAT THE BYTE SIZE IS 36 AND THE NUMBER OF BYTES IS AS IN 2
05900		PUSH	P,2				;SAVE 
06000		PUSH	P,3
06100		MOVEM	2,FDBEOF(CDB)
06200		HRLI	1,12				;OFFSET FOR
06300		MOVEM	2,3				;NUMBER OF WORDS
06400		SETO	2,				;BYTE MASK
06500		JSYS	CHFDB				;CHANGE THE EOF POINTER
06600		MOVEI	2,=36
06700		MOVEM	2,FDBSZ(CDB)
06800		HRLI	1,11				;OFFSET FOR BYTE SIZE
06900		MOVSI	2,007700			;MASK
07000		MOVSI	3,004400			;36 BIT BYTES
07100		JSYS	CHFDB
07200		HRLI	1,0				;RESTORE GOOD JFN IN 1
07300		POP	P,3				;RESTORE
07400		POP	P,2
07500		POPJ	P,				;AND RETURN
07600	
07700	
07800	GETWND:
07900	;HERE WITH 1,CDB LOADED
08000	;RETURN THE WORD THAT ADDRESSES EOF IN 2, ACCORDING TO THE SYSTEM
08100		BEGIN GETWND
08200		PUSH	P,3
08300		SKIPN	3,FDBSZ(CDB)			;IF BYTE SIZE IS ZERO
08400		  JRST	RET0				;THEN RETURN 0
08500		CAIN	3,=36				;ALREADY 36?
08600		  JRST	RET1				;RETURN WHAT WE ALREADY HAVE THERE
08700	;THE BYTE SIZE OF A FILE CAN BE 0 TO =64.  0 IS ALREADY TAKEN CARE OF ABOVE
08800		CAILE	3,=36	
08900		  ERR	<GETWND:  File byte size is bigger than 36 bits>,1
09000		MOVEI	2,=36
09100		IDIVI	2,(3)				;NUMBER TO MULTIPLY BY -- CLOBBERS 3!!
09200		MOVEM	2,3
09300		MOVE	2,FDBEOF(CDB)
09400		IDIVI	2,(3)				;NUMBER OF WORDS -- CLOBBERS 3!!
09500		JUMPE	3,.+2				;EXTRA WORDS?
09600		  AOJ	2,				;YES.
09700	POPBACK:POP	P,3
09800		POPJ	P,
09900	
10000	RET0:	SETZ	2,
10100		JRST	POPBACK
10200	
10300	RET1:	MOVE	2,FDBEOF(CDB)
10400		JRST	POPBACK
10500	
10600		BEND GETWND
10700	
10800	GETWPT:	
10900	;HERE WITH 1,CDB LOADED
11000	;RETURNS IN 2 THE WORD THAT ADDRESSES EOB
11100		BEGIN GETWPT
11200		SKIPN	2,IOBP(CDB)
11300		  POPJ	P,				;WORD ZERO
11400		PUSH	P,3
11500		TLZ	2,007700
11600		TLO	2,004400			;MAKE 36 BIT
11700		IBP	2
11800		MOVE	3,IOADDR(CDB)	
11900		SUBI	3,(2)
12000		MOVE	2,IOPAGE(CDB)			;CURRENT PAGE
12100		LSH	2,9				;NUMBER OF WORDS IN PREVIOUS PAGES
12200		SUB	2,3				;SUBTRACT SINCE 3 IS NEGATIVE
12300		POP	P,3				;RESULT IN 2
12400		POPJ	P,
12500	
12600		BEND GETWPT
12700	
12800	GTWPT1:
12900	;HERE WITH 1,CHNL,CDB LOADED
13000	;RETURN IN 2 THE WORD THAT ADDRESSES EOB IN 2, ACCORDING TO THE CURRENT POINTER
13100	;RETURN IN 3 THE UPDATED BYTE POINTER
13200	;RETURN IN 4 THE COUNT REMAINING FOR OUTPUT
13300	;RETURN IN 5 THE COUNT REMAINING FOR INPUT
13400		BEGIN GTWPT1
13500		SKIPN	3,IOBP(CDB)	
13600		  JRST	NULRET
13700		TLZ	3,007700
13800		TLO	3,004400			;MAKE A 36-BIT BP	
13900		MOVEM	3,2				;COPY INTO 2
14000		IBP	2
14100		MOVE	4,IOADDR(CDB)			;START OF BUFFER
14200		SUBI	4,(2)				;NUMBER OF WORDS CURRENTLY COMMITTED TO
14300							;IN THIS BUFFER
14400		MOVE	2,IOPAGE(CDB)			;WHERE THE CURRENT IO IS
14500		LSH	2,9
14600		SUB	2,4				;NUMBER OF WORDS TO ADDRESS EOF
14700		ADDI	4,1000				;NUMBER OF WORDS REMAINING IN  THIS BUFFER
14800							;FOR OUTPUT PURPOSES
14900		MOVEM	2,5				;SAVE CURRENT EOB POINTER
15000		PUSHJ	P,GETWND			;READ THE END OF FILE IN FDB
15100	 	EXCH	5,2				;EOB POINTER TO 2, EOF TO 5
15200		SUB	5,2				;SUBTRACT THE CURRENT EOB POINTER
15300		CAML	5,4				;IF LESS THAN OUTPUT COUNT THEN USE IT ELSE
15400		  MOVEM	4,5				;USE OUTPUT COUNT
15500		POPJ	P,
15600	
15700	NULRET:	SETZB	2,3				;EVERYTHING ZERO
15800		SETZB	4,5
15900		POPJ	P,
16000	
16100	
16200		BEND GTWPT1
16300	
16400	CHWEOF:
16500	;1,CDB LOADED
16600	;SEES IF A CHANGE OF EOF IS NEEDED, AND DOES IT
16700		SKIPN	IOBP(CDB)			;ANYTHING THERE?
16800		  POPJ	P,				;NO, DONT FIDDLE AROUND
16900		PUSH	P,2
17000		PUSH	P,3
17100		PUSHJ	P,GETWND			;GET WORD EOF
17200		MOVEM	2,3				;SAVE IN 6
17300		PUSHJ	P,GETWPT			;GET WORD EOB
17400		CAML	2,3				;IS EOB LESS THAN EOF?
17500		  PUSHJ	P,SETWND			;BETTER RESET FDB -- ALSO IF TEST IS EQUAL	   
17600		POP	P,3
17700		POP	P,2
17800		POPJ	P,
17900	
18000	
     
00100	SETWPT:
00200		BEGIN SETWPT
00300	;HERE WITH 1,CDB LOADED
00400	;2 HAS THE WORD THAT WE WANT TO SET TO
00500		MOVE	3,IOSTT(CDB)
00600		CAIN	3,XOWORD			;DOING WORD OUTPUT?
00700		  PUSHJ	P,CHWEOF			;YES CHECK
00800		CAIN	3,XOCHAR			;DOING CHAR OUTPUT?
00900		  PUSHJ	P,CHCEOF			;CHECK IT ALSO
01000		CAMN	2,[-1]				;WANT EOF?
01100		  PUSHJ	P,GETWND			;YES
01200		PUSH	P,2				;SAVE ON STACK
01300		LSH	2,-9
01400		CAME	2,IOPAGE(CDB)			;SAME PAGE?
01500		  PUSHJ	P,SETPAGE			;NO, SET THE PAGE
01600		POP	P,2	
01700		ANDI	2,777				;PICK UP WORD IN PAGE
01800		MOVE	3,IOADDR(CDB)
01900		ADDI	3,(2)
02000		HRLI	3,444400			;MAKE A BYTE POINTER
02100		MOVEM	3,IOBP(CDB)
02200		MOVE	3,IOSTT(CDB)			;CHECK THE STATUS AT THE MOMENT	
02300		CAIE	3,XICHAR			;IF INPUTTING CHARS
02400		CAIN	3,XIWORD			;OR WORDS
02500		  JRST	ASSUMIN				;THEN ASSUME WE WILL CONTINUE TO INPUT
02600		MOVEI	3,XOWORD			;WELL ASSUME OUTPUT
02700		MOVEM	3,IOSTT(CDB)
02800	FULBU1:	MOVEI	3,1000				;OTHERWISE ASSUME OUTPUT
02900		SUBI	3,(2)
03000	STOAC3:	MOVEM	3,IOCNT(CDB)
03100		POPJ	P,
03200	ASSUMIN:
03300		MOVEI	3,XIWORD
03400		MOVEM	3,IOSTT(CDB)
03500		PUSH	P,2				;SAVE THE NUMBER OF WORDS
03600		PUSHJ	P,GETWND			;GET THE END OF THE FILE IN WORDS IN 2
03700		IDIVI	2,1000				;PAGES IN 2, WORDS IN 3	
03800		CAMGE	2,IOPAGE(CDB)			;IS REQUESTED PAGE BEYOND EOF?
03900		  JRST	EMPBUF				;YES
04000		CAME	2,IOPAGE(CDB)			;SOMEWHERE ON THIS PAGE?
04100		  JRST	FULBUF				;NO
04200		POP	P,2
04300		SUB	3,2
04400		JRST	STOAC3
04500	
04600	FULBUF:	POP	P,2
04700		JRST	FULBU1
04800	
04900	EMPBUF:	POP	P,2
05000		SETZ	3,				;SAY EMPTY
05100		JRST	STOAC3
05200		BEND SETWPT
05300	
05400	SETPAGE:
05500	;1,CDB,CHNL LOADED
05600	;2 HAS THE NUMBER OF THE PAGE WE WANT MAPPED
05700	CRYPT<	; Check for need to encrypt outgoing page
05800		SKIPE	NCRYPT(CDB)		;DOES USER WANT TO ENCRYPT?
05900		 PUSHJ	P,CALNCR		;Yes, call user's routine
06000						;if appropriate
06100	>; CRYPT
06200		PUSH	P,1				;SAVE JFN
06300		PUSH	P,2
06400		PUSH	P,3
06500		MOVEM	2,IOPAGE(CDB)			;PAGE BEING INSERTED
06600		PUSH	P,1				;SAVE JFN OVER SFPTR
06700		LSH	2,9				;MAKE INTO WORDS
06800		JSYS	SFPTR
06900		  ERR	<SETPAGE:  Cannot do SFPTR>,1
07000		POP	P,1
07100		HRL	1,1
07200		HRR	1,IOPAGE(CDB)			;XWD JFN,FILEPAGE
07300		HRLZI	3,140000			;BITS 2 AND 3 FOR READ, WRITE -- ASSUME THIS
07400		MOVE	2,OFL(CDB)			;BUT BETTER CHECK:
07500		TESTN	2,WRBIT				;IF WRITING OR
07600		TESTE	2,APPBIT			;APPENDING
07700		  JRST	.+2				;THEN DONT DO
07800		TESTO	3,1B9				;THE COPY ON WRITE -- DO IT FOR READING THOUGH
07950	CRYPT<
07960		SKIPE	DCRYPT(CDB)		;if we are going to decrypt
07970		 JRST [	TESTO	3,1B9		;THEN ALWAYS SET COPY-ON-WRITE
07975			TESTZ	3,1B3		;AND NEVER SET WRITE BIT
07977			JRST	.+1]
07980	>; CRYPT
07990		MOVE	2,FKPAGE(CDB)			;BUFFER IN CORE
08000		JSYS	PMAP
08100		TESTE	3,1B9			;[CLH] NO COPY-ON-WRITE
08200		SKIPN	$OSTYP			;[CLH] OR TENEX?
08300		JRST	SETPGG			;[CLH] YES, DONE
08400		MOVE	1,FKPAGE(CDB)		;[CLH] READING, CHECK FOR HOLE
08500		LSH	1,11			;[CLH] ADDR OF START OF PAGE
08600		MOVE	1,(1)			;[CLH] SEE IF WE CAN ACCESS IT
08700		JUMP	16,SETPGF		;[CLH] FAILED, GET ZERO PAGE
08800		JRST	SETPGG			;[CLH] OK, DONE
08900	SETPGF:	SETO	1,			;[CLH] JUST CLEAR THE PAGE
09000		MOVE	2,FKPAGE(CDB)		;[CLH] PAGE NUMBER
09100		HRLI	2,400000		;[CLH] OUR OWN FORK
09200		SETZ	3,			;[CLH]
09300		JSYS	PMAP			;[CLH] CLEAR THE PAGE 
09400		JRST	SETPGX
09500	
09600	SETPGG:
09700	CRYPT<
09800		SKIPE	DCRYPT(CDB)		;DO WE NEED TO DECRYPT?
09900		 PUSHJ	P,CALDCR		;Yes, CALL USER'S ROUTINE
10000	>; CRYPT
10100	SETPGX: POP	P,3
10200		POP	P,2
10300		POP	P,1				;RESTORE THE JFN
10400		POPJ	P,
10500	
     
00100	SETWIO:
00200	;1,CDB LOADED
00300	;DECIDE WHETHER TO SETWI OR SETWO
00400	;CLOBBERS 2,3
00500		MOVEI	3,SETWI				;ASSUME WORD INPUT
00600		MOVE	2,OFL(CDB)
00700		TESTN	2,RDBIT				;DOING INPUT
00800		  MOVEI	3,SETWO				;NOPE ASSUME OUTPUT
00900		JRST	(3)				;AND POPJ BACK
     
00100	ADWI:	
00200	;1,CDB LOADED
00300	;CALL PUSHJ
00400	;RETURN:
00500	;	+1 FOR EOF
00600	;	+2 FOR NORMAL
00700	;ADVANCES WORD INPUT FROM DSK
00800		BEGIN ADWI
00900	
01000		PUSH	P,2
01100		PUSH	P,3
01200		MOVE	3,IOPAGE(CDB)			;CURRENT PAGE
01300		AOJ	3,				;NEXT PAGE
01400		LSH	3,9				;WORDS IN THAT PAGE
01500		PUSHJ	P,GETWND			;END OF FILE POINTER
01600		CAML	3,2				;BEYOND
01700		  JRST	ADEOF				;YES SAY SO
01800		SUB	2,3	
01900		CAILE	2,1000				;LESS THAN A FULL BUFFER?
02000		  MOVEI	2,1000				;NO GIVE ENTIRE AMOUNT
02100		MOVEM	2,IOCNT(CDB)
02150	NOCRYPT<
02200		AOS	2,IOPAGE(CDB)			;INCREMEMT PAGE, GET IN 2
02250	>
02260	CRYPT<
02265		MOVE	2,IOPAGE(CDB)
02270		ADDI	2,1				;say which page we want
02280	>
02300		PUSHJ	P,SETPAGE	
02400		MOVE	2,IOADDR(CDB)
02500		HRLI	2,444400
02600		MOVEM	2,IOBP(CDB)
02700	ADRET:	AOS	-2(P)
02800	ADEOF:	POP	P,3
02900		POP	P,2
03000		POPJ	P,
03100	
03200		BEND ADWI
03300	
03400	ADWO:
03500	;1,CDB LOADED
03600	;ADVANCES WORD OUTPUT FROM DSK
03700		BEGIN ADWO
03800	
03900		PUSH	P,2
03950	NOCRYPT<
04000		AOS	2,IOPAGE(CDB)			;NEXT PAGE OF THE FILE
04050	>
04060	CRYPT<
04070		MOVE	2,IOPAGE(CDB)			;say which page we want
04080		ADDI	2,1
04090	>
04100		PUSHJ	P,SETPAGE
04200	 	MOVEI	2,1000
04300		MOVEM	2,IOCNT(CDB)	
04400		MOVE	2,IOADDR(CDB)	
04500		HRLI	2,444400
04600		MOVEM	2,IOBP(CDB)
04700		POP	P,2
04800		POPJ	P,
04900	
05000		BEND ADWO
     
00100	DSCR  CHAR_CHARIN(CHANNEL)
00200	
00300	HERE(CHARIN)
00400		BEGIN CHARIN
00500	
00600		PUSHJ	P,SAVE
00700		MOVE	LPSA,X22
00800		LITCHN	1,-1(P),CHALIT
00900		SETZEOF
01000		MOVE	CHNL,1				;[CLH] DOINP NEEDS THIS
01100	DOSIMIO:	
01200		SIMIO	E,TABL,CERR			;SOSGE IOCNT(CDB)
01300		  JRST	.DOINP
01400		ILDB	2,IOBP(CDB)
01500	STOAC2:	MOVEM	2,RACS+A(USER)
01600		JRST	RESTR
01700	
01800	TABL:	JRST	DOSETCI				;0 -- XNULL
01900		SOSGE	IOCNT(CDB)			;1 -- XICHAR
02000		JRST	.COSCI				;2 -- XOCHAR
02100		JRST	.WISCI				;3 -- XIWORD
02200		JRST	.WOSCI				;4 -- XOWORD
02300		SOSGE	IOCNT(CDB)			;5 -- XCICHAR
02400		REPEAT 2,<JRST CERR>			;6,7 -- XCOCHAR,XCOWORD
02500		SOSGE	IOCNT(CDB)			;10 -- XBYTE7
02600		SOSGE	IOCNT(CDB)			;11 -- XDICHAR
02700		REPEAT 2,<JRST CERR>			;12,13 -- XDOCHAR,XDARR
02800	
02900	.DOINP:
03000		PUSHJ	P,DOINP				;READ NEXT BUFFER
03100		JRST	DOSIMIO				;BUFFERED INPUT RETURN
03200		JRST	IND				;CHARACTER IN D--DID A BIN
03300		JRST	ADCIEOF				;EOF
03400	
03500	ADCIEOF:SETZM	RACS+A(USER)			;RETURN 0
03600		JRST	INPEOF				;AND SAY EOF
03700	DOSETCI:
03800		PUSHJ	P,SETCI
03900		JRST	DOSIMIO
04000	
04100	
04200	.COSCI:	PUSHJ	P,COSCI
04300		JRST	DOSIMIO
04400	
04500	.WISCI:	PUSHJ	P,WISCI
04600		JRST	DOSIMIO
04700	
04800	.WOSCI:	PUSHJ	P,WOSCI
04900		JRST	DOSIMIO
05000	
05100	CERR:	ERR	<CHARIN:  Illegal JFN, byte-size, or mode>,1
05200		JRST	INPEOF				;INDICATE EOF AND RETURN
05300	
05400	CHALIT:	SETZM	.SKIP.
05500		MOVE	1,-1(P)				;PICK UP JFN LITERALLY
05600		JSYS	BIN
05700		JUMPN	2,STOAC2
05800		SETZM	RACS+A(USER)
05900		JSYS	GTSTS
06000		TESTE	2,1B8
06100		  SETOM	.SKIP.
06200		JRST	RESTR
06300	
06400	IND:	MOVEM	D,2				;PUT IN 2
06500		JRST	STOAC2				;AND RETURN CHARACTER
06600	
06700		BEND CHARIN
     
00100	DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR);
00200		Reads in a string of characters, terminated by BRKCHAR or	
00300	reaching maxlength, whichever happens first.
00400	
00500	
00600	HERE(SINI)
00700		BEGIN	SINI
00800	
00900		PUSHJ	P,SAVE
01000		MOVE	LPSA,X44
01100		VALCHN	1,-3(P),CERR
01200		SETZEOF
01300		MOVE	CHNL,1			;[CLH] DOINP NEEDS THIS
01400	DOSIMIO:SKIPG	C,-2(P)
01500		  JRST	NULRET
01600		SIMIO	2,TABL,CERR		;EXCH	1,C
01700		SKIPE	SGLIGN(USER)	
01800		  PUSHJ	P,INSET
01900		ADDM	1,REMCHR(USER)		
02000		SKIPLE	REMCHR(USER)
02100		  PUSHJ	P,STRNGC
02200		MOVE	E,TOPBYTE(USER)		;BYTE POINTER TO TOP OF STRING SPACE
02300		PUSH	SP,[0]
02400		PUSH	SP,E
02500		EXCH	1,C			;1 HAS JFN, C HAS COUNT
02600		MOVN	C,C
02700	IN1:	SOSGE	IOCNT(CDB)
02800		  JRST	.DOINP
02900	IN2:	ILDB	D,IOBP(CDB)
03000	IND:	JUMPE	D,IN1			;IF EMPTY KEEP LOOKING
03100		CAMN	D,-1(P)			;BREAK CHAR?
03200		  JRST	DOBRK			;YES
03300		IDPB	D,E
03400	IN3:	AOJL	C,IN1			;SUBTRACT 1 AND JUMP IF GREATER
03500	
03600		SETOM	.SKIP.			;INDICATE TERMINATED FOR COUNT
03700	DONE:	ADDM	C,REMCHR(USER)		;MAKE REMCHR HONEST
03800		MOVEM	E,TOPBYTE(USER)
03900		ADD	C,-2(P)			;GET ACTUAL NUMBER OF CHARACTERS 
04000						;TRANSFERRED	
04100		HRROM	C,-1(SP)		;SAVE COUNT FOR USER
04200		JRST	RESTR
04300	
04400	DOBRK:	IDPB	D,E			;SAVE THE BREAK CHARACTER (AS DOES THE SIN JSYS)
04500		MOVEM	D,.SKIP.		;SAVE BREAK CHARACTER IN .SKIP. AS DOC. SAYS
04600		AOJ	C,			;ADD 1 TO THE COUNT
04700		JRST 	DONE			;AND FINISH UP
04800	
04900	CERR:	ERR <SINI:  Illegal JFN, illegal mode or byte size>,1
05000	NULRET:	PUSH	SP,[0]			;RETURN NULL STRING
05100		PUSH	SP,[0]
05200		JRST	RESTR
05300		
05400	TABL:	JRST	DOSETCI			;0 -- XNULL
05500		EXCH	1,C			;1 -- XICHAR
05600		JRST	.COSCI			;2 -- XOCHAR
05700		JRST	.WISCI			;3 -- XIWORD
05800		JRST	.WOSCI			;4 -- XOWORD		
05900		EXCH	1,C			;5 -- XCICHAR
06000		JRST	CERR			;6 -- XCOCHAR
06100		JRST	CERR			;7 -- XCWORD
06200		EXCH	1,C			;10 -- XBYTE7
06300		EXCH	1,C			;11 -- XDICHAR
06400		REPEAT 2,<JRST CERR>		;12,13 -- XDOCHAR,XDARR
06500	
06600	.DOINP:	PUSHJ	P,DOINP			;READ IN THE NEXT BUFFER
06700		JRST	IN1			;GOT IT
06800		JRST	IND			;CHARACTER IN D
06900	DOEOF:	SETOEOF				;END OF FILE
07000		JRST	DONE
07100	
07200	DOSETCI:	
07300		PUSHJ	P,SETCI
07400		JRST	DOSIMIO
07500	
07600	.COSCI:	PUSHJ	P,COSCI
07700		JRST	DOSIMIO
07800	
07900	.WISCI:	PUSHJ	P,WISCI
08000		JRST	DOSIMIO
08100	
08200	.WOSCI:	PUSHJ	P,WOSCI
08300		JRST	DOSIMIO
08400	
08500	
08600		BEND SINI
08700	
     
00100	COMMENT Input 
00200	
00300	DSCR  "STRING"_INPUT(CHANNEL,BREAK TABLE NUMBER);
00400	CAL SAIL
00500	SID NO ACS SAVED BY INPUT!!!!!!
00600	
00700	
00800	.IN.:
00900	HERE (INPUT)	
01000		MOVE	USER,GOGTAB	;GET TABLE POINTER
01100	;;%##% FOR BENEFIT OF ERROR ROUTINE
01200		MOVE	TEMP,(P)
01300		MOVEM	TEMP,UUO1(USER)
01400	;;%##%
01500		MOVEM	RF,RACS+RF(USER);SAVE F-REGISTER
01600		SKIPE	SGLIGN(USER)
01700		PUSHJ	P,INSET
01800		
01900		VALCHN	1,-2(P),INPBAD	;MOSTLY EXTRA CODE REALLY
02000	INPSIM:
02100		SIMIO	E,INPTBL,INPBAD	;MOVE X,-1(P)  ; TABLE NUMBER
02200	
02300		MOVEI	TEMP,-1		;ERROR IF BLOCK NOT THERE OR TABLE NOT INIT'ED
02400		PUSHJ	P,BKTCHK	;CHECK TABLE #
02500		 JRST	[PUSH	SP,[0]	;ERROR
02600			PUSH	SP,[0]
02700			SUB	P,X33
02800			JRST	@3(P)]
02900		PUSH	P,CDB		;SAVE POINTER TO CORGET BLOCK
03000		PUSH	P,CHNL		;SAVE RANGE 1 TO 18
03100	
03200		MOVE	CHNL,-4(P)	;CHANNEL NUMBER -- ALREADY CHECKED
03300		MOVE	CDB,CDBTBL(CHNL)
03400		HRRZ	CHNL,JFNTBL(CHNL);ALREADY CHECKED ABOVE
03500	;;;;	LDB	E,[POINT 4,OFL(CDB),9] ;DATA MODE
03600		SETZEOF
03700		SKIPE	BRCHAR(CDB)	;BRCHAR LOCATION
03800		  SETZM	@BRCHAR(CDB)	;ASSUME NO BREAK CHAR
03900		MOVEI	A,=200		;DEFAULT NO. OF CHARS
04000		SKIPE	ICOUNT(CDB)	;USER-SPECIFIED COUNT?
04100		  HRRZ	A,@ICOUNT(CDB)	;MAX COUNT FOR INPUT STRING
04200		ADDM	A,REMCHR(USER)
04300		SKIPLE	REMCHR(USER)	;ENOUGH ROOM?
04400		PUSHJ	P,STRNGC	;NO, TRY TO GET SOME
04500	
04600		POP	P,TEMP
04700		MOVE	FF,BRKMSK(TEMP)	;BITS FOR THIS TABLE
04800		POP	P,LPSA		;LPSA POINTS AT CORGET BLOCK FOR BREAK TABLES
04900		ADD	TEMP,LPSA	;TEMP IS RELOCATED 1 TO 18
05000		MOVEM	TEMP,-1(P)	;SAVE RELOCATED 1 TO 18 ON STACK
05100		MOVEI	Z,1		;FOR TESTING LINE NUMBERS
05200		SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
05300		  MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
05400	
05500		MOVN	B,A		;NEGATE MAX CHAR COUNT
05600		PUSH	SP,[0]		;LEAVE ROOM FOR FIRST STR WORD
05700		PUSH	SP,TOPBYTE(USER)	;SECOND STRING WORD
05800		MOVE	Y,LPSA
05900		ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(LPSA)
06000		JUMPE	B,DONE1		; BECAUSE THE AOJL WON'T
06100	
06200	;;%DQ% JFR 8-17-76
06300		TRNE	FF,@BRKDUM(LPSA);TREAT NUL LIKE ORDINARY CITIZEN?
06400		TROA	C,1		;YES
06500		TRZ	C,1		;NO
06600	;;%DQ% ^
06700		TRNE	FF,@BRKCVT(LPSA)	;DOING UC COERCION?
06800		TLOA	C,400000	;YES
06900		TLZ	C,400000	;NO
07000		
07100	.IN:	SOSGE	IOCNT(CDB)	;BUFFER EMPTY?
07200		 JRST	.DOINP
07300	IN1:	
07400		ILDB	D,IOBP(CDB)	;GET NEXT CHARACTER
07500	    	TDNE	Z,@IOBP(CDB)	;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
07600		JRST	INLINN		;YES, GO SEE WHAT TO DO
07700	IN2:
07800	INB:
07900	;;%DQ% JFR 8-17-76
08000		JUMPE	D,[TRNN	C,1	;REALLY IGNORE 0'S ?
08100			   JRST	.IN	;YES
08200			   JRST	NOCV.I	];NO-- AND WE KNOW IT'S A 0, SO GET TO THE POINT
08300	;;%DQ% ^
08400		CAILE	D,14		;FIRST CHECK
08500		  JRST	INB1		;IF IN RANGE AT ALL
08600		CAIN	D,12
08700		  JRST	INB2
08800		CAIE	D,14		;LF OR FF?
08900		  JRST	INB1		;NO
09000	INB2:	SKIPN	LINNUM(CDB)	;COUNTING VIA SETPL FUNCTION??
09100	 	  JRST	INB1		;NO
09200		TDNN	FF,@Y		;SOMETHING SPECIAL FOR THIS CHARACTER?
09300		  JRST	INCR		;NO NOTHING SPECIAL
09400		HLLZ	TEMP,@Y		;GET BITS FOR THIS CHAR
09500		TDNN	TEMP,FF		;IGNORE?
09600		  JRST	INCR		;YES
09700		MOVE	TEMP,-1(P)	;BREAKTABLE (RELOCATED)
09800		SKIPLE	DSPTBL(TEMP)	;APPEND OR SKIP?
09900		  JRST	INB1		;YES
10000	INCR:	CAIN	D,12		;LINE-FEED?
10100		  AOS	@LINNUM(CDB)	;INDICATE ANOTHER LINE
10200		CAIE	D,14		;FORM-FEED?
10300		  JRST	INB1		;NO
10400		SKIPE	PAGNUM(CDB)	
10500		 AOS	@PAGNUM(CDB)	;COUNT PAGES ALSO
10600		SKIPE	LINNUM(CDB)
10700		  SETZM @LINNUM(CDB)	;SET LINNUM TO ZERO (NEW PAGE)
10800	
10900	INB1:	JUMPGE	C,NOCV.I	;NOT COERCING?
11000		CAIL	D,"a"		;ONLY COERCE LOWER CASE
11100		CAILE	D,"z"		;
11200		JRST	.+2		;SPECIAL RHT "FAST SKIP"
11300		TRZ	D,40		;MAKE UPPER CASE
11400	
11500	NOCV.I:	TDNE	FF,@Y		;MUST WE DO SOMETHING SPECIAL?
11600		JRST	INSPC		;YES, HANDLE
11700	
11800	MOVEC:	IDPB	D,TOPBYTE(USER)	;LENGTHEN STRING
11900		AOJL	B,.IN		;GET SOME MORE
12000		JRST	DONE1
12100	
12200	INSPC:	HLLZ	TEMP,@Y		;IGNORE OR BREAK?
12300		TDNN	TEMP,FF		;  (CHOOSE ONE)
12400		JRST	.IN		;IGNORE
12500	
12600	;  BREAK -- STORE BREAK CHAR, FINISH OFF
12700	
12800	DONE:	SKIPE	BRCHAR(CDB)	;USER BRCHAR VAR?
12900		  MOVEM	D,@BRCHAR(CDB)	;STORE BREAK CHAR
13000		MOVE	TEMP,-1(P)	;RELOCATED 1 TO 18
13100		SKIPN	Y,DSPTBL(TEMP)	;WHAT TO DO WITH BREAK CHAR?
13200		JRST	DONE1		;SKIP IT
13300		JUMPL	Y,APPEND	;ADD TO END OF INPUT STRING
13400	
13500	RETAIN:	PUSHJ	P,BACKUP
13600		JRST	DONE1
13700	
13800	APPEND:	IDPB	D,TOPBYTE(USER)	;PUT ON END
13900		AOJA	B,DONE1		;ONE MORE TO COUNT
14000	
14100	
14200	;  DONE -- MARK STRING COUNT WORD
14300	
14400	DONE1:	ADDM	B,REMCHR(USER)	;GIVE UP THOSE NOT USED
14500		SKIPN	ICOUNT(CDB)	;USER SUPPLIED COUNT?
14600		  JRST	[ADDI B,=200	;USER DEFAULT
14700			 JRST .+2]
14800		ADD	B,@ICOUNT(CDB)	;HOW MANY DID WE ACTUALLY GET?
14900	;;#GI# DCS 2-5-72 REMOVE TOPSTR
15000		HRROM	B,-1(SP)	;MARK RESULT, NON-CONSTANT
15100	;;#GI#
15200		MOVE	RF,RACS+RF(USER);GET F-REGISTER BACK
15300		SUB	P,X33		;REMOVE INPUT PARAMETER, RETURN ADDRESS
15400		JRST	@3(P)		;RETURN
15500	
15600	;  CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
15700	;  TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
15800	;  NOT A LINE NUMBER FOR NEXT TIME
15900	
16000	
16100	
16200	
     
00100	.DOINP:	PUSHJ	P,DOINP
00200		JRST	.IN			;NORMAL BUFFERED RETURN
00300		JRST	INB			;7-BIT, CHAR IN D
00400		JRST	DONE1			;EOF OR ERROR
00500	
00600		BEGIN INPTBL
00700	
00800	^INPTBL:JRST	DOSETCI			;0 -- XNULL
00900		MOVE	X,-1(P)			;1 -- XICHAR
01000		JRST	.COSCI			;2 -- XOCHAR
01100		JRST	.WISCI			;3 -- XIWORD
01200		JRST	.WOSCI			;4 -- XOWORD
01300		MOVE	X,-1(P)			;5 -- XCICHAR
01400		REPEAT 2,<JRST INPBAD>		;6,7 
01500		MOVE	X,-1(P)			;10 -- XBYTE7
01600		MOVE	X,-1(P)			;11 -- XDICHAR
01700		REPEAT 2,<JRST INPBAD>		;12,13
01800	
01900	DOSETCI:	
02000		PUSHJ	P,SETCI
02100		JRST	INPSIM
02200	
02300	.COSCI:	PUSHJ	P,COSCI
02400		JRST	INPSIM
02500	
02600	.WISCI:	PUSHJ	P,WISCI
02700		JRST	INPSIM
02800	
02900	.WOSCI:	PUSHJ	P,WOSCI
03000		JRST	INPSIM
03100	
03200	
03300		BEND INPTBL
03400	
     
00100	
00200	COMMENT  BACKUP TO BACKUP JFN 
00300	
00400	;CALL TO HERE WITH A PUSHJ, WITH CDB,CHNL LOADED [CHNL WITH THE JFN!]
00500	^BACKUP:
00600		PUSH	P,1
00700		LDB	1,[POINT 6,OFL(CDB),5]	;BYTE-SIZE
00800		CAIN 	1,44
00900		  JRST	BACKU1
01000		SKIPE	TTYINF(CDB)	;CONTROLLING TERMINAL?
01100		  JRST	BACTTY		;YES
01200	BACBKJ:	HRRZ	1,CHNL		;THE JFN
01300		JSYS 	BKJFN
01400		  ERR <BACKUP:  Cannot do BKJFN jsys for RETAIN>,1
01500	BACRET:	POP	P,1
01600		POPJ	P,
01700	BACKU1:	SOS	IOBP(CDB)
01800		IBP	IOBP(CDB)
01900		IBP	IOBP(CDB)
02000		IBP	IOBP(CDB)
02100		IBP	IOBP(CDB)
02200		AOS	IOCNT(CDB)
02300		JRST	BACRET
02400	
02500	BACTTY:	HRRZ	1,TTYINF(CDB)
02600		CAIN	1,TNXINP			;TENEX DEFAULT
02700		  JRST	BACBKJ				;YES, USE BKJFN
02800		CAIE	1,DECLED			;DEC STYLE?
02900		CAIN	1,TENXED			;OR TENEX?
03000		  JRST	BACKU1
03100		ERR	<BACKUP:  Illegal editing mode for controlling terminal>,1
03200		JRST 	BACKU1
03300	
03400	;LINE NUMBER STUFF
03500	
03600	INLINN:
03700	NOPGNN:
03800		SKIPE	SOSNUM(CDB)	;WANT THE NUMBER?
03900		  JRST 	[MOVE TEMP,@IOBP(CDB)	;SAVE IT FOR THE USER
04000			 MOVEM TEMP,@SOSNUM(CDB)
04100			 JRST .+1]
04200		MOVE	TEMP,-1(P)	;RELOCATED TABLE
04300		SKIPGE	TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
04400		 JRST	 GIVLIN	; WANTS IT NEXT TIME OR SOMETHING
04500	
04600		JSP	TEMP,EATLIN	;TOSS IT OUT, AND 
04700		JRST	.IN		; CONTINUE
04800	
04900	EATLIN:
05000		AOS	IOBP(CDB)	;FORGET IT ENTIRELY
05100		MOVNI	A,5		;INDICATE SKIPPING SIX
05200		ADDB	A,IOCNT(CDB)	;IN COUNT
05300		JUMPGE	A,(TEMP)	;OVERFLOW BUFFER??
05400		PUSHJ	P,DOINP
05500		JRST	OKLN		;36-BIT RETURN
05600		ERR	<INPUT:  7-BIT BYTES CANNOT HAVE LINE NUMBERS>
05700		JRST	DONE1		;END-OF-FILE
05800	OKLN:	
05900		IBP	IOBP(CDB)	;GET OVER TAB FINALLY
06000		SOS	IOCNT(CDB)	;IS THIS RIGHT -- RLS 12/74
06100		JRST	(TEMP)		;AND CONTINUE
06200	
06300	
06400	GIVLIN:	TRNE	TEMP,-1		;WANT LINE NO IN BRCHAR WORD?
06500		 JRST	 GVLLN		;NO, WANTS IT NEXT TIME.
06600		SKIPL	TEMP,@IOBP(CDB)	;NEGATED LINE NO
06700		MOVNS	TEMP
06800		SKIPE	BRCHAR(CDB)	;USER LOCATION?
06900		MOVEM	TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
07000		JSP	TEMP,EATLIN	;GO EAT UP LINE NUMBER AND
07100		JRST	DONE1		;FINISH UP
07200	GVLLN:
07300		SKIPE	BRCHAR(CDB)
07400		  SETOM	@BRCHAR(CDB)	;TELL THE USER
07500		AOS	IOCNT(CDB)	;REVERSE THE SOSLE
07600		MOVE	Y,OFL(CDB)	;NOW CHECK TO SEE IF WE CAN DO THIS WITHOUT DISASTER
07700		TESTN	Y,WRBIT		;WRITING?
07800		TESTE	Y,APPBIT	;OR APPENDING?
07900		  ERR	<INPUT:  Give line feature not implemented when reading and writing.
08000	Continuation will cause the line number to be modified.>
08100		MOVEI	Y,1		;TURN OFF LINE NUMBER 
08200		ANDCAM	Y,@IOBP(CDB)	;  BIT
08300		MOVSI	Y,070000	;BACK UP BYTE POINTER
08400		ADDM	Y,IOBP(CDB)
08500		JRST	DONE1		;FINISH OFF IN BAZE OF GORY
08600	
08700	INPBAD:	ERR <INPUT:  Illegal JFN or bad input>
08800	
     
00100	COMMENT Realin, Realscan 
00200	
00300	DSCR REAL_REALIN(CHANNEL NUMBER);
00400	CAL SAIL
00500	
00600	HERE (REALIN)
00700	IFN ALWAYS,<BEGIN NUMIN>
00800		PUSHJ	P,SAVE
00900		PUSHJ	P,NUMIN		;SET UP TO GET CHARS FROM CHANNEL
01000		PUSHJ	P,RLNIN		;GOBBLE A REAL NUMBER
01100		SNGL	A,A
01200	INRETA:	MOVEM	A,RACS+A(USER)
01300	INRET:	SKIPE	BRCHAR(CDB)		;USER WANTS BREAK CHARACTER?
01400		  MOVEM Z,@BRCHAR(CDB)		;FIX UP BREAK CHARACTER
01500		SOS	IOBP(CDB)		;BACK UP TO GET IT NEXT TIME
01600		FOR II_1,4 <
01700		IBP	IOBP(CDB)>
01800		AOS	IOCNT(CDB)
01900		MOVE	LPSA,X22	;GET RID OF CHANNEL AND RET. WD
02000		JRST	RESTR
02100	
02200	HERE (REALSCAN)
02300		PUSHJ	P,SAVE
02400		PUSHJ	P,STRIN		;SET UP TO GET CHARS FROM A STRING
02500		PUSHJ	P,RLNIN
02600		SNGL	A,A
02700	STRRTA:	MOVEM	A,RACS+A(USER)
02800	STRRET:
02900		HRRZ	X,-2(P)
03000		SOJ	CDB,		;BACK UP BYTE POINTER
03100	FOR II_1,4<
03200		IBP	CDB>
03300		MOVEM	CDB,(X)
03400		AOJ	CHNL,
03500		HRRM	CHNL,-1(X)
03600		MOVEM	Z,@-1(P)	;STORE BREAK CHARACTER
03700		MOVE	LPSA,X33	;GET RID OF BRK VAR, STR ADDR
03800		JRST	RESTR
03900	
04000	FNDDIG:			;FIND DIGIT OR DECIMAL POINT, KEEP TRACK OF SIGN
04100		EXCH	A,(P)		;FIRST PUT "GET NEXT CHAR" INSTR ON STACK
04200		PUSH	P,A		;AHEAD OF RETURN WORD
04300	FNDDI1:	XCT	-1(P)		;GET NEXT CHAR
04400		CAIL	D,"0"
04500		CAILE	D,"9"
04600		CAIN	D,"."
04700		 POPJ	P,
04800		JUMPL	D,.-1		;END OF FILE OR STRING
04900		CAIN	D,"-"
05000		 TLOA	FF,NUMNEG
05100		TLZ	FF,NUMNEG	;SIGN MUST IMMEDIATELY PRECEDE NUMBER
05200		JRST	FNDDI1
05300	
05400	RLNIN:
05500		SETZ	FF,		;ZERO FLAGS
05600		PUSHJ	P,FNDDIG
05700		JUMPL	D,.+2
05800		 TLO	FF,NUMSAW
05900		PUSHJ	P,GETNUM	;TRY FOR AN INTEGER
06000		CAIE	D,"."
06100		 TRZA	C,-1		;NO DIGITS AFTER DEC PT.
06200		 PUSHJ	P,GETN1D	;FINISH UP FRACTION
06300		EXCH	C,(P)		;DIGIT COUNTS  NXTCHR INSTR
06400		PUSH	P,X		;PARTIAL RESULT
06500		PUSH	P,Y
06600		PUSH	P,FF		;FLAGS
06700		PUSH	P,C		;NXTCHR INSTR
06800		SETZ	FF,		;EXPONENT FLAGS
06900		CAIE	D,"@"
07000		CAIN	D,"E"
07100		 JRST	[XCT	(P)		;EAT A CHAR
07200			CAIE	D,"@"
07300			CAIN	D,"E"
07400		RLNIN2:	 XCT	(P)		;ALLOW FOR TWO OF THESE
07500			CAIN	D,"-"
07600			 TLOA	FF,NUMNEG
07700			CAIN	D,"+"
07800			 XCT	(P)		;PAST SIGN
07900			PUSHJ	P,GETNUM	;RECURSE FOR EXPONENT
08000			PUSHJ	P,TZMUL	;GET EXPONENT AS AN INTEGER
08100			JUMPN	C,RLNIN1
08200			 ERR	<NUMIN: Improper exponent>,1	;NO DIGITS APPEARED
08300			JRST	RLNIN1
08400			]
08500		CAIN	D,"D"
08600		 JRST	RLNIN2
08700		SETZB	X,Y		;EXPONENT IS ZERO
08800		SETZ	C,		;AND THERE WERE NO DIGITS IN IT
08900	RLNIN1:
09000		MOVE	Z,D		;SAVE BRCHAR (COULD BE -1 FOR EOF)
09100		SUB	P,X11		;GET RID OF NXTCHR INSTR
09200		TLNN	FF,NUMNEG
09300		 SKIPA	D,Y		;LOW WD OF EXPONENT
09400		 MOVN	D,Y		;EXPONENT WAS NEG
09500		POP	P,FF		;FLAGS OF FRACTION
09600				;-2(P): FRACTION DIGIT COUNTS
09700				;-1(P), -0(P): FRACTION
09800		TLNN	C,-1		;IF ANY TRAILING ZEROES LEFT, A WHOPPING BIG EXP.
09900		SKIPE	X		;HIGH PART HAD BETTER BE ZERO
10000		 JRST	[SUB	P,X33	;WIPE OUT FRACTION AND DIGIT COUNTS
10100			 JRST	DFSERR]	;AND COMPLAIN
10200		POP	P,Y		;FRACTION PART
10300		POP	P,X
10400		POP	P,C		;DIGIT COUNTS OF FRACTON
10500		JRST	DFSC
10600		
10700	HEREFK(LREALIN,LREA.IN)
10800		PUSHJ	P,SAVE
10900		PUSHJ	P,NUMIN
11000		PUSHJ	P,RLNIN
11100		DMOVEM	A,RACS+A(USER)
11200		JRST	INRET
11300	
11400	HEREFK(LREALSCAN,LREA.SCAN)
11500		PUSHJ	P,SAVE
11600		PUSHJ	P,STRIN
11700		PUSHJ	P,RLNIN
11800		DMOVEM	A,RACS+A(USER)
11900		JRST	STRRET
12000	
12100	DSCR INTEGER_INTIN(CHANNEL NUMBER);
12200	CAL SAIL
12300	
12400	HERE (INTIN)
12500		PUSHJ	P,SAVE
12600		PUSHJ	P,NUMIN
12700		PUSHJ	P,RLNIN
12800	;[clh]	SNGL	A,A
12900		PUSHJ	P,RFIX
13000		JRST	INRETA
13100	
13200	repeat 0,<	;[clh]
13300	RFIX:			;SIGN(A)*FLOOR(ABS(A)+0.5) 
13400	KI10<	JUMPL	A,.+3
13500		 FIXR	A,A
13600		 POPJ	P,
13700		MOVN	A,A
13800		FIXR	A,A
13900		MOVN	A,A
14000		POPJ	P,
14100	>;KI10
14200	NOKI10<	JUMPL	A,.+4
14300		 FADRI	A,(0.5)		;SORRY, 166 !
14400		 FIX	A,A
14500		 POPJ	P,
14600		MOVN	A,A
14700		FADRI	A,(0.5)
14800		FIX	A,A
14900		MOVN	A,A
15000		POPJ	P,
15100	>;NOKI10
15200	> ;[clh] repeat 0
15300	
15400	;[clh] new routine to go straight from double precision to integer
15500	RFIX:			;SIGN(A)*FLOOR(ABS(A)+0.5) 
15600		JUMPGE	A,RFIX1	;MAKE POSITIVE [ASSUME FF,NUMNEG IS STILL SET]
15700	KI10<	
15800		DMOVN	A,A
15900	>; KI10
16000	NOKI10<
16100		SETCA	A,
16200		MOVN	A+1,A+1
16300		TLZ	A+1,400000
16400		JUMPN	A+1,RFIX1
16500		AOJ	A,
16600	>; NOKI10
16700	RFIX1:	LDB	C,[POINT 9,A,8]	;EXPONENT
16800		TLZ	A,777000	;CLEAR EXPONENT
16900		ASHC	A,-233(C)	;SHIFT TO MAKE INTEGER
17000		 JOV	RFIXER
17100		TLNE	B,200000	;FRACTION .GE. 1/2?
17200		ADDI	A,1		;YES, ROUND UP
17300		 JOV	RFIXER
17400		TLNE	FF,NUMNEG	;IF NEGATIVE, PUT BACK SIGN
17500		MOVN	A,A
17600		POPJ	P,
17700	
17800	RFIXER:	ERR	<RFIX:  Number too big>,1
17900		SETZ	A,
18000		POPJ	P,
18100	;[clh] ^^
18200	
18300	DSCR INTEGER_INTSCAN("STRING");
18400	CAL SAIL
18500	
18600	HERE (INTSCAN)
18700		PUSHJ	P,SAVE
18800		PUSHJ	P,STRIN
18900		PUSHJ	P,RLNIN
19000	;[clh]	SNGL	A,A
19100		PUSHJ	P,RFIX
19200		JRST	STRRTA
19300	
19400	
     
00100	;NUMIN -- CONTD.
00200	
00300	NUMIN:
00400	?NUMSIM:
00500		VALCHN	1,-2(P),NUMBAD		;1,CDB, CHNL LOADED
00600		SIMIO	Z,NUMTBL,NUMBAD		;MOVE	CHNL,1	;JFN TO 1
00700		SKIPE	ENDFL(CDB)
00800		  SETZM	@ENDFL(CDB)
00900		SETZM	.SKIP.
01000		SKIPE	BRCHAR(CDB)
01100		  SETZM	@BRCHAR(CDB)
01200	
01300		MOVE	A,[JSP A,NCH]
01400		MOVEI	Z,1			;FOR LINE NUMBER TEST
01500		POPJ	P,
01600	
01700	; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
01800	NCH:	SOSGE IOCNT(CDB);	DECREMENT CHARACTER COUNT
01900		  JRST	NUMINP
02000	
02100	NCH1:	ILDB D,IOBP(CDB);	LOAD BYTE
02200		TDNE Z,@IOBP(CDB);	CHECK FOR LINE NUMBER
02300		JRST NCH5
02400	NCH1.1:	SKIPN	LINNUM(CDB)	;WANT SETPL THINGS?
02500		   JRST	(A)		;NO RETURN
02600		CAIN	D,12		;LINE FEED?
02700		   AOS	@LINNUM(CDB)	;YES
02800		CAIE	D,14		;FORM FEED?
02900		   JRST	(A)		;NOPE, NOTHING
03000		SKIPE	PAGNUM(CDB)
03100		   AOS	@PAGNUM(CDB)	;INCREMENT PAGE COUNTER
03200		SKIPE	LINNUM(CDB)
03300		  SETZM	@LINNUM(CDB)	;AND ZERO LINE COUNTER
03400		JRST (A);		RETURN
03500	
03600	NCH7:	SETO D,		;EOF OR DATA ERROR.
03700		JRST (A)
03800	
03900	NCH5:	SKIPE	SOSNUM(CDB)	;WANT SETPL STUFF?
04000		  JRST	[MOVE	D,@IOBP(CDB)
04100			 MOVEM	D,@SOSNUM(CDB)	;INFORM USER ABOUT LINE NUMBER
04200			 JRST	.+1]
04300		AOS IOBP(CDB);		WE HAVE A LINE NUMBER
04400		MOVNI D,5;		MOVE OVER IT
04500		ADDB D,IOCNT(CDB)
04600		SKIPL	 D		;NOTHING LEFT?
04700		  JRST NCH		;DO ANOTHER INPUT
04800		PUSHJ	P,DOINP		;
04900		  JRST	NCH6		;36-BIT RETURN -- MUST BE
05000		  PUSHJ	P,NUMBAD	;IMPOSSIBLE
05100		  JRST	NCH7		;EOF OR SOME SUCH
05200	
05300	NCH6:	SOSGE IOCNT(CDB);	REMOVE TAB
05400		JRST NCH7		;NONE THERE OR ERROR
05500		IBP IOBP(CDB)
05600		JRST NCH
05700	
05800	;SETUP FOR STRING INPUT (REALSCAN, INTSCAN)
05900	STRIN:
06000		MOVE	A,[JSP A,NCHA]
06100		HRRZ	CHNL,-3(P)	;ADDR OF WD2
06200		MOVE	CDB,(CHNL)	;BP
06300		HRRZ	CHNL,-1(CHNL)	;LENGTH
06400		POPJ	P,
06500	
06600	;READ A CHARACTER ROUTINE FOR STRINGS.
06700	NCHA:	SOJL	CHNL,NCH7
06800		ILDB	D,CDB
06900		CAIN	D,15
07000		 JRST	NCHA		;IGNORE CR
07100		JUMPE	D,NCHA		;AND NUL
07200		JRST (A)
     
00100	;LNUMIN	NUMBER INPUT
00200	COMMENT 
00300	These routines form a character-string
00400	to number conversion package.  GETNUM eats characters one at a time
00500	until a non-digit is eaten; GETNUM then returns intermediate information
00600	which can be used by the other routines.
00700	GETNU1 is the routine to call
00800	after GETNUM when a decimal point is seen and you eventually want a floating
00900	point number.
01000	
01100	GETNUM:	-1(P)	instruction to XCT, gets next character in D
01200		(P)	return word
01300		D	first digit
01400	result:	as in GETNU1
01500	
01600	GETNU1:	X,Y	double length partial integer result
01700		-1(P)	instruction to XCT, gets next character in D
01800		(P)	return word
01900		C	# trailing zeroes ,, power of 10 scale factor
02000		D	first digit
02100	result:	X,Y	double length partial integer result
02200		(P)	instructin to XCT, gets next character in D
02300		FF	flags (sign, overflow)
02400		C	# trailing zeroes ,, scale factor + # digits since then
02500		D	break character
02600	
02700	MAKINT:	X,Y	double length partial integer result
02800		(P)	return word
02900		FF	sign flag
03000		C	# trailing zeroes ,, junk
03100	result:	A	integer value
03200	
03300	DFSC:
03400		X,Y	double length partial integer result
03500		(P)	return word
03600		FF	flags
03700		C	# trailing zeroes ,, # digits since decimal point
03800		D	exponent
03900	result:	A,B	floating point value
04000	
04100	AC USAGE:
04200	
04300	FF	flags
04400	A,B	double temp		return word for JSP NCH
04500	C	#tz ,, # digits
04600	D	char
04700	X,Y	double integer partial result
04800	Z	1 (for testing line numbers)
04900	CHNL	channel number, or # chars left in string
05000	CDB	channel data block addr, or bp to string
05100	RF	res.
05200	LPSA	scale factor for DMUL	gen.temp.
05300	TEMP	gen. temp.
05400	USER	res.
05500	SP	res.
05600	P	res.
05700	
05800	
05900	;GETNUM GETNU1
06000	
06100	NUMNEG__400000
06200	EXPNEG__200000
06300	NUMSAW__100000
06400	
06500	GETNUC:	XCT	-1(P)		;GET A CHAR FIRST
06600	GETNUM:
06700		SETZB	X,Y		;INITIAL RESULT
06800		SETZ	C,		;DIGIT COUNTS
06900		JRST	2,@.+1		;CLEAR FLAGS
07000		GETNU1
07100	
07200	GETN1D:	TRZA	C,-1		;NUMBER OF DIGITS SINCE DEC. PT IS ZERO
07300	GETN1E:	AOBJN	C,.+1		;A TRAILING ZERO
07400	GETN1C:	XCT	-1(P)		;GET NEXT CHAR
07500	GETNU1:	CAIL	D,"0"
07600		CAILE	D,"9"
07700		 POPJ	P,		;NOT DIGIT
07800		SUBI	D,"0"		;CONVERT TO DIGIT NOW
07900		JUMPE	D,GETN1E	;A TRAILING ZERO
08000		ADDI	C,1		;ANOTHER DIGIT
08100		TLNE	C,-1		;WERE THERE TRAILING ZEROES BEFORE IT?
08200		 PUSHJ	P,TZMUL		;YES
08300		PUSHJ	P,M10ADD	;MULT BY =10 AND ADD D
08400		JRST	GETN1C
08500	
08600	TZMUL:	HLRZ	TEMP,C		;# TRAILING ZEROES
08700		JUMPE	TEMP,CPOPJ	;QUIT IF NONE
08800		MOVEI	C,(C)		;WILL BE NONE IF WE FINISH WITHOUT OVERFLOW
08900		JUMPN	Y,.+2		;[CLH] IF X,Y=0, NOTHING TO DO
09000		JUMPE	X,CPOPJ		;[CLH]
09100		MOVEI	LPSA,(D)	;SAVE DIGIT
09200		SETZ	D,
09300		PUSHJ	P,M10ADD	;ADJUST VALUE TO ACCOUNT FOR TRAILING ZEROES
09400		SOJG	TEMP,.-2
09500		MOVEI	D,(LPSA)	;RESTORE D
09600		POPJ	P,
09700	
09800	M10ADD:
09900		MOVE	A,Y		;LOW HALF
10000		MULI	A,=10
10100		TLO	A+1,400000	;PREVENT OVERFLOW
10200		ADDI	A+1,(D)		;ADD NEW DIGIT
10300		TLZN	A+1,400000	;WOULD THERE HAVE BEEN AN OVERFLOW?
10400		 ADDI	A,1		;YES. (THIS CAN'T OVERFLOW; A WAS AT MOST 9)
10500		MOVE	D,X		;HIGH HALF
10600		IMULI	D,=10
10700		 JOV	[ADD	C,X11	;PRETEND WE HAD A TRAILING ZERO
10800			SOJA	C,CPOPJ]
10900		TLO	D,400000	;PREVENT OVERFLOW
11000		ADDI	D,(A)		;CARRY IN FROM LOW HALF
11100		TLZN	D,400000	;WOULD THERE HAVE BEEN AN OVERFLOW?
11200		 JRST	@.-4		;YES
11300		MOVEM	A+1,Y		;STORE LOW HALF
11400		MOVEM	D,X		;AND HIGH HALF
11500	CPOPJ:	POPJ	P,
11600	;DFSC
11700	
11800	;	FF	NUMNEG FLAG
11900	;	C	# TRAILING ZEROES,, # DIGITS SINCE DECIMAL PT.
12000	;	D	EXPONENT
12100	;	X,Y	FRACTION
12200	
12300	DFSC:
12400		MOVE	A,X		;BEGIN CONVERTING TO PURE FRACTION
12500		JFFO	A,DFSC1
12600		MOVE	A,X+1		;HIGH WD WAS ZERO
12700		JFFO	A,.+1
12800		ADDI	A+1,=35
12900	DFSC1:	MOVEI	LPSA,-1(A+1)	;# OF PLACES TO SHIFT (REMEMBER SIGN BIT)
13000		ASHC	X,(LPSA)	;MAKE INTO PURE FRACTION
13100		SUBI	LPSA,=70
13200		MOVN	LPSA,LPSA	;EXPONENT OF 2 OF FRACTION
13300		
13400	;***** SOMETHING FISHY HERE.  CONSIDER 12345.98@3
13500		SUBI	D,(C)		;DIGITS SINCE DECIMAL POINT DECREASE THE EXPONENT
13600		HLRZ	C,C
13700		ADDI	D,(C)		;BUT TRAILING ZEROES DONT COUNT
13800		JUMPE	D,DFSC2		;EXPONENT OF 10 IS ZERO
13900		JUMPG	D,DFSC3
14000		TLO	FF,EXPNEG	;EXPONENT WAS NEG
14100		MOVN	D,D
14200		SKIPA	TEMP,[EXP.M1,,FR.M1]	;USE THIS TABLE SINCE EXP WAS NEG
14300	DFSC3:	MOVE	TEMP,[EXP.P1,,FR.P1]	;EXP WAS POS
14400		TRNE	D,777700	;CHECK EXPONENT RANGE
14500		 JRST	DFSERR
14600		TRNE	D,40		;E+-32 INVOLVED?
14700		TLNE	FF,EXPNEG	;YES. TOO BAD IF E-48
14800		 JRST	MULOOP		;OK
14900		TRNE	D,20		;E-48 ?
15000		 JRST	DFSERR
15100	MULOOP:	TRZE	D,1		;SHOULD WE MULTIPLY?
15200		 PUSHJ	P,DMUL..	;YES
15300		JUMPE	D,DFSC2
15400		ASH	D,-1		;NEXT BIT INTO POSITION
15500		AOBJN	TEMP,.+1	;ADD 1 TO LH
15600		AOJA	TEMP,MULOOP	;AND 2 TO RH
15700	
15800	DFSC2:
15900	KI10<	DMOVE	A,X	>;KI10
16000	NOKI10<	MOVE	A,X
16100		MOVE	A+1,X+1	>;NOKI10
16200		ASHC	A,-8		;MAKE ROOM FOR EXPONENT
16300		FSC	A,200(LPSA)	;INSERT IT
16400		JFOV	DFSERR
16500	DFSC4:
16600		JUMPGE	Z,.+3		;IF RAN OUT OF CHARS
16700		 TLNE	FF,NUMSAW	; AND SAW NUMBER
16800		  MOVEI	Z,0		;  THEN FLAG IT THIS WAY
16900	KI10<	TLNE	FF,NUMNEG
17000		 DMOVN	A,A
17100		POPJ	P,
17200	>;KI10
17300	NOKI10<	TLNN	FF,NUMNEG
17400		 POPJ	P,
17500		SETCA	A,		;ONES COMPLEMENT OF HIGH WORD
17600		MOVN	A+1,A+1		;TWOS COMPLEMENT OF LOW WORD
17700		TLZ	A+1,400000	;FORCE SIGN BIT OFF
17800		JUMPN	A+1,CPOPJ	;IF LOW SIGNIFICANCE, DONE
17900		AOJA	A,CPOPJ		;OTHERWISE TWOS COMPLEMENT OF HIGH WORD
18000	>;NOKI10
18100	
18200	DFSERR:	ERR	<NUMIN: Exponent range exceeded>,1
18300		SETOB	A,A+1
18400		TLNN	FF,EXPNEG
18500		 TLZA	A,400000	;EXPONENT WAS POS, GIVE AN INFINITY
18600		SETZB	A,A+1		;EXPONENT WAS NEG, GIVE ZERO
18700		JRST	DFSC4		;OF RIGHT SIGN
18800	;DMUL..
18900	;MULTIPLY TWO DOUBLE-LENGTH PURE FRACTIONS. ONE IS (TEMP), OTHER IS X,Y PAIR
19000	;RETURN DOUBLE-LENGTH RESULT IN X,Y
19100	;SCALE FACTOR KEPT IN LPSA
19200	
19300	DMUL..:
19400	NOKL10<	PUSH	P,X		;SAVE HIGH
19500		SETZM	X		;1ST WORD, FINAL PRODUCT
19600		MOVE	A,(TEMP)	;HIGH
19700		MULM	A,Y		;* LOW
19800					;IGNORING 3RD WORDS: 8 EXPONENT BITS TO BURN
19900		MOVE	A,1(TEMP)	;LOW
20000		MUL	A,(P)		;* HIGH
20100		TLO	A,400000	;PREVENT OVERFLOWS
20200		ADD	A,Y		;ADD 2ND WORDS
20300		TLZN	A,400000	;WOULD THERE HAVE BEEN AN OVERFLOW?
20400		 AOS	X		;YES, DO CARRY (SETS X TO 1)
20500		MOVEM	A,Y		;STORE LOW RESULT
20600		POP	P,A		;HIGH
20700		MUL	A,(TEMP)	;* HIGH
20800		TLO	A+1,400000	;PREVENT OVERFLOW
20900		ADD	A+1,Y		;COLLECT 2ND WORD
21000		TLZN	A+1,400000	;WOULD THERE HAVE BEEN AN OVERFLOW?
21100		 ADDI	A,1		;YES
21200		ADD	A,X		;COLLECT 1ST WORD (THIS CAN'T OVERFLOW)
21300	>;NOKL10
21400	KL10<
21500		DMOVE	A,X
21600		DMOVEM	A+2,X
21700		DMUL	A,(TEMP)
21800		DMOVE	A+2,X
21900	>;KL10
22000		TLNE	A,(1B1)		;NORMALIZED FRACTION?
22100		 JRST	.+3		;YES
22200		ASHC	A,1		;NO, SHIFT OVER
22300		SUBI	LPSA,1		;AND ADJUST EXPONENT
22400		MOVS	TEMP,TEMP		;COLLECT EXPONENT CHANGES
22500		ADD	LPSA,(TEMP)
22600		MOVS	TEMP,TEMP
22700		MOVEM	A,X		;STORE RESULT SO FAR
22800		MOVEM	A+1,Y
22900		POPJ	P,
23000	
23100	FR.P1:	240000,,0	;10^1		PURE FRACTION PART
23200		0
23300		310000,,0	;10^2
23400		0
23500		234200,,0	;10^4
23600		0
23700		276570,,200000	;10^8
23800		0
23900		216067,,446770	;10^16
24000		040000,,0
24100		235613,,266501	;10^32
24200		133413,,263574
24300	EXP.P1:	4				;POWER OF 2 EXPONENT PART
24400		7
24500		16
24600		33
24700		66
24800		153
24900	
25000	FR.M1:	314631,,463146	;10^-1
25100		146314,,631463
25200		243656,,050753	;10^-2
25300		205075,,314217
25400		321556,,135307	;10^-4
25500		020626,,245364
25600		253630,,734214	;10^-8
25700		043034,,737425
25800		346453,,122766	;10^-16
25900		042336,,053314
26000		317542,,172552	;10^-32
26100		051631,,227215
26200	EXP.M1:	-3
26300		-6
26400		-15
26500		-32
26600		-65
26700		-152
26800	
     
00100	
00200	NUMBAD: ERR<NUMIN:  Illegal JFN, byte-size or mode>
00300		POPJ	P,
00400	
00500		BEGIN NUMTBL
00600	
00700	^NUMTBL:JRST	DOSETCI				;0 -- XNULL
00800		MOVE    CHNL,1				;1 -- XICHAR
00900		JRST	.COSCI				;2 -- XOCHAR
01000		JRST	.WISCI				;3 -- XIWORD
01100		JRST	.WOSCI				;4 -- XOWORD
01200		MOVE	CHNL,1				;5 -- XCICHAR
01300		REPEAT 2,<JRST	NUMBAD>			;6,7
01400		MOVE	CHNL,1				;10 -- XBYTE7
01500		MOVE	CHNL,1				;11 -- XDICHAR
01600		REPEAT 2,<JRST NUMBAD>			;12,13
01700	
01800	DOSETCI:
01900		PUSHJ	P,SETCI
02000		JRST	NUMSIM
02100		
02200	.COSCI:	PUSHJ	P,COSCI
02300		JRST	NUMSIM
02400	
02500	.WISCI:	PUSHJ	P,WISCI
02600		JRST	NUMSIM
02700	
02800	.WOSCI:	PUSHJ	P,WOSCI
02900		JRST	NUMSIM
03000	
03100		BEND NUMTBL
03200	
03300	NUMINP:	PUSHJ	P,DOINP
03400		JRST	NCH				;BUFFERED INPUT
03500		JRST	NCH1.1				;7-BIT
03600		JRST	NCH7				;EOF OR ERROR
03700	
03800	
03900	RZ:	SETZ A,
04000		JRST DONE
04100	ENDCOM(NUM)
04200	COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)
     
00100	DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
00200	
00300	
00400	^^.CH.:	4
00500		7
00600		16
00700		33
00800		66
00900		153
01000		777777777775
01100		777777777772
01200		777777777763
01300		777777777746
01400		777777777713
01500		777777777626
01600	^^.MT.:	240000000000
01700		310000000000
01800		234200000000
01900		276570200000
02000		216067446770
02100		235613266501
02200		314631463147
02300		243656050754
02400		321556135310
02500		253630734215
02600		346453122767
02700		317542172553
02800	^^.TEN.:	1
02900		=10
03000		=100
03100		=1000
03200		=10000
03300		=100000
03400		=1000000
03500		=10000000
03600		=100000000
03700		=1000000000
03800		=10000000000
03900	
04000	ENDCOM(TBB)
04100	IFN ALWAYS,<
04200		BEND
04300	>;IFN ALWAYS
     
00100	
00200	DSCR SIMPLE PROCEDURE CHAROUT(INTEGER JFN, CHAR)
00300	
00400	HERE(CHAROUT)
00500		BEGIN CHAROUT
00600		PUSHJ	P,SAVE
00700		MOVE	LPSA,X33
00800		LITCHN	1,-2(P),CHOLIT
00900	DOSIMIO:SIMIO	3,TABL,CERR		;SOSGE IOCNT(CDB)
01000		  PUSHJ	P,ADCO1
01100		MOVE	2,-1(P)
01200		IDPB	2,IOBP(CDB)
01300		JRST	RESTR
01400	
01500	TABL:	JRST	DOSETCO			;0 -- XNULL
01600		JRST	.CISCO			;1 -- XICHAR
01700		SOSGE	IOCNT(CDB)		;2 -- XOCHAR
01800		JRST	.WISCO			;3 -- XIWORD
01900		JRST	.WOSCO			;4 -- XOWORD
02000		JRST	CERR			;5 -- XCICHAR
02100		SOSGE	IOCNT(CDB)		;6 -- XCOCHAR
02200		JRST	CERR			;7 -- XCWORD
02300		JRST	DOBOUT			;10 -- XBYTE7
02400		JRST	CERR			;11 -- XDICHAR
02500		SOSGE	IOCNT(CDB)		;12 -- XDOCHAR
02600		JRST	CERR			;13 -- XDARR
02700	
02800	DOSETCO:	
02900		PUSHJ	P,SETCO
03000		JRST	DOSIMIO
03100	
03200	.CISCO:	PUSHJ	P,CISCO
03300		JRST	DOSIMIO
03400	
03500	.WISCO:	PUSHJ	P,WISCO
03600		JRST	DOSIMIO
03700	
03800	.WOSCO:	PUSHJ	P,WOSCO
03900		JRST	DOSIMIO
04000	
04100	CERR:	ERR <CHAROUT:  Illegal JFN, byte-size, or mode.>,1
04200		JRST	RESTR
04300	
04400	CHOLIT:
04500	DOBOUT:	MOVE	2,-1(P)
04600		JSYS	BOUT
04700		JRST	RESTR
04800	
04900		BEND CHAROUT
     
00100	
00200	DSCR SIMPLE PROCEDURE OUT(INTEGER JFN; STRING S)
00300	
00400	HERE(OUT)
00500		BEGIN OUT
00600		PUSHJ	P,SAVE
00700		MOVE	LPSA,X22
00800		LITCHN	1,-1(P),CHKTTY
00900	DOSIMIO:SIMIO	2,TABL,CERR	;HRRZ 3,-1(SP)
01000		JUMPE	3,SOURET	;DONT SEND EMPTY STRING
01100	LOOP:	SOSGE	IOCNT(CDB)	;DECREMENT BUFFER COUNT
01200		  PUSHJ	P,ADCO1		;GET NEW BUFFER
01300		ILDB	2,(SP)		;NEXT CHAR ON STRING
01400		IDPB	2,IOBP(CDB)	;AND COPY THE CHARACTER
01500		SOJG	3,LOOP		;STRING CHAR COUNT
01600	
01700	SOURET:	SUB	SP,X22		;ADJUST STRING STACK
01800		JRST	RESTR
01900	
02000	DOSOUT:	
02100		SKIPE	CTLOSW		;IF CONTROL-O AND
02200		SKIPN	TTYINF(CDB)	;THE CONTROLLING TERMINAL
02300		  JRST 	.+2
02400		 JRST	SOURET		;THEN DONT DO OUTPUT
02500	REPEAT 0,<;BUGS IN SOUT JSYS -- ARE THEY STILL THERE??
02600	DOSOU1:	HRRZ	3,-1(SP)
02700		JUMPE	3,SOURET
02800	SOUT1:	ILDB	2,(SP)		;NEXT CHAR
02900		JSYS	BOUT
03000		SOJG	3,SOUT1		;STRING CHAR COUNT
03100		JRST	SOURET
03200	>;REPEAT 0
03300	DOSOU1:	
03400		HRRZ	3,-1(SP)	;COUNT
03500		JUMPE	3,SOURET	;DONT SEND NULL STRING
03600		MOVE	2,(SP)		;STRING BP
03700		MOVN	3,3		;NEGATIVE COUNT
03800		JSYS	SOUT		;STRING OUTPUT
03900		JRST	SOURET		;AND RETURN
04000		
04100	CERR:	ERR <OUT:  Illegal JFN, byte-size, or mode>,1
04200		JRST 	SOURET
04300	
04400	TABL:	JRST	DOSETCO		;0 -- XNULL
04500		JRST	.CISCO		;1 -- XICHAR	
04600		HRRZ 3,-1(SP)		;2 -- XOCHAR
04700		JRST	.WISCO		;3 -- XIWORD
04800		JRST	.WOSCO		;4 -- XOWORD
04900		JRST	CERR		;5 -- XCICHAR
05000		HRRZ 3,-1(SP)		;6 -- XCOCHAR
05100		JRST	CERR		;7 -- XCWORD	
05200		JRST	DOSOUT		;10 -- XBYTE7
05300		JRST	CERR		;11 -- XDICHAR
05400		HRRZ 3,-1(SP)		;12 -- XDOCHAR
05500		JRST	CERR		;13 -- XDARR
05600	
05700	DOSETCO:	
05800		PUSHJ	P,SETCO
05900		JRST	DOSIMIO
06000	
06100	.CISCO:	PUSHJ	P,CISCO
06200		JRST	DOSIMIO
06300	
06400	.WISCO:	PUSHJ	P,WISCO
06500		JRST	DOSIMIO
06600	
06700	.WOSCO:	PUSHJ	P,WOSCO
06800		JRST	DOSIMIO
06900	
07000	CHKTTY:
07100		SKIPN	CTLOSW				;CONTROL-O SWITCH ON?
07200		  JRST	DOSOU1				;NO
07300		CAIE	1,100				;CONTROLLING TERMINAL?
07400		CAIN	1,101
07500		  JRST	SOURET				;YES, RETURN
07600		JRST	DOSOU1				;NO, JUST DO IT
07700	
07800	
07900		BEND OUT
08000	
     
00100	DSCR	PROCEDURE LINOUT(INTEGER JFN,VALUE)
00200	
00300	
00400	HERE(LINOUT)
00500		BEGIN LINOUT
00600	
00700		PUSHJ	P,SAVE
00800		VALCHN	A,-2(P),LINBAD
00900	DOSIMIO:SIMIO	B,TABL,LINBAD	;SKIPG	B,IOCNT(CDB)
01000		   PUSHJ P,ADCO		;NO, SEND (OR PERHAPS JUST INITIALIZE)
01100		MOVE	TEMP,IOBP(CDB)	;GET BP
01200	
01300	LINOPL:	TLNN	TEMP,760000	;LINED BP?
01400		   JRST	OKLIGN
01500		IBP	TEMP
01600		SOJA	B,LINOPL	
01700	
01800	OKLIGN:	MOVEM	TEMP,IOBP(CDB)
01900		MOVEM	B,IOCNT(CDB)
02000		CAIGE	B,=10		;ENOUGH FOR 10 CHARS?
02100		  PUSHJ	P,ADCO		;NO
02200		SKIPGE	B,-1(P)		;GET LINE-NO
02300		  JRST	[MOVNS B
02400			 MOVNI A,5
02500			 JRST	NOCONV]
02600		MOVNI	A,6
02700		MOVE	C,[<ASCII /00000/>/2]	
02800		EXCH	B,C
02900		PUSH	P,LNBAK
03000	LNCONV:	IDIVI 	C,=10
03100		IORI	D,"0"
03200		DPB	D,[POINT 7,(P),6]
03300		SKIPE	C
03400		PUSHJ	P,LNCONV	;THE RECURSIVE PRINTER
03500		HLL	C,(P)
03600		LSHC	B,7
03700	LNBAK:	POPJ	P,.+1
03800		LSH	B,1
03900		TRO	B,1
04000	NOCONV:	AOS	C,IOBP(CDB)	;MOVE A WORD OUT
04100		MOVEM	B,(C)
04200		ADDM	A,IOCNT(CDB)
04300		MOVEI	B,11
04400		CAME	A,[-5]
04500		  IDPB	B,IOBP(CDB)	;OUTPUT A TAB
04600	NOTAB:	MOVE	LPSA,X33
04700		JRST	RESTR
04800	
04900	LINBAD:	ERR <LINOUT:  Illegal JFN, byte-size, or mode>,1
05000		JRST	NOTAB
05100	
05200	TABL:	JRST	DOSETCO				;0 -- XNULL
05300		JRST	.CISCO				;1 -- XICHAR
05400		SKIPG	B,IOCNT(CDB)			;2 -- XOCHAR
05500		JRST	.WISCO				;3 -- XIWORD
05600		JRST	.WOSCO				;4 -- XOWORD
05700		JRST	LINBAD				;5 -- XCIWORD
05800		SKIPG	B,IOCNT(CDB)			;6 -- XCOWORD
05900		JRST	LINBAD				;7 -- XCWORD
06000		JRST	LINBAD				;10 -- XBYTE7
06100		JRST	LINBAD				;11 -- XDICHAR
06200		SKIPG	B,IOCNT(CDB)			;12 -- XDOCHAR
06300		JRST	LINBAD				;13 -- XDARR
06400	
06500	DOSETCO:
06600		PUSHJ	P,SETCO
06700		JRST	DOSIMIO
06800	
06900	.CISCO:	PUSHJ	P,CISCO
07000		JRST	DOSIMIO
07100	
07200	.WISCO:	PUSHJ	P,WISCO
07300		JRST	DOSIMIO
07400	
07500	.WOSCO:	PUSHJ	P,WOSCO
07600		JRST	DOSIMIO
07700	
07800	
07900		BEND LINOUT
08000	
     
00100	HERE(RCHPTR)
00200		BEGIN RCHPTR
00300		PUSHJ	P,SAVE
00400		MOVE	LPSA,X22
00500		VALCHN	1,-1(P),CERR
00600		SETZM	.SKIP.
00700	DOSIMIO:SIMIO	2,TABL,CERR
00800	STOAC2:	MOVEM	2,RACS+A(USER)
00900		JRST	RESTR
01000	
01100	TABL:	JRST	RNULL				;0 -- XNULL
01200		REPEAT 	4,<PUSHJ P,GETCPT>		;1-4
01300		REPEAT  3,<JRST CERR>			;5-7
01400		JRST	DORFPTR				;10 -- XBYTE7
01500		REPEAT	3,<JRST CERR>
01600	
01700	DORFPTR:
01800		JSYS	RFPTR
01900		  JRST	.+2
02000		JRST	STOAC2
02100	;HERE WITH AN ERROR FROM RFPTR
02200		MOVEM	1,.SKIP.
02300		JRST	RNULL
02400	
02500	CERR:	ERR	<RCHPTR:  Illegal jfn, mode, or byte size>,1
02600		SETOM	.SKIP.
02700		SETZM	RACS+A(USER)
02800		JRST	RESTR
02900	
03000	RNULL:
03100		PUSHJ	P,SETCIO
03200		JRST	DOSIMIO
03300		
03400		BEND RCHPTR
     
00100	HERE(SCHPTR)
00200		BEGIN SCHPTR
00300		PUSHJ	P,SAVE
00400		MOVE	LPSA,X33
00500		VALCHN	1,-2(P),CERR
00600		SETZM	.SKIP.
00700	DOSIMIO:MOVE	2,-1(P)				;POINTER
00800		SIMIO	3,TABL,CERR
00900		JRST	RESTR
01000	
01100	TABL:	JRST	RNULL				;0 -- XNULL .  Remember arg in 2
01200		PUSHJ	P,SETCPT			;1 -- XICHAR
01300		PUSHJ	P,SETCPT			;2 -- XOCHAR
01400		PUSHJ	P,SETCPT			;3 -- XIWORD
01500		PUSHJ	P,SETCPT			;4 -- XOWORD
01600		REPEAT 	3,<JRST CERR>			;5-7
01700		JRST	DOSFPTR				;10 -- XBYTE7
01800		REPEAT	3,<JRST CERR>			;11-13
01900	
02000	RNULL:
02100		PUSHJ	P,SETCIO
02200		JRST	DOSIMIO				;BUT GET ARGUMENT AGAIN
02300	
02400	DOSFPTR:
02500		JSYS	SFPTR
02600		  JRST	.+2				;ERROR IN 1
02700		JRST	RESTR
02800		MOVEM	1,.SKIP.
02900		ERR	<SCHPTR:  Cannot do SFPTR>,1
03000		JRST	RESTR
03100	
03200	CERR:	ERR	<Dryrout at SCHPTR>,1
03300		SETOM	.SKIP.
03400		JRST	RESTR
03500	
03600	
03700		BEND SCHPTR
     
00100	DSCR	Auxiliary routines for character i/o.
00200	
00300	
00400	SETCND:	
00500	;sets the FDB so tht the byte size is 7 and the number of bytes is as in 2
00600	;1, CHNL, CDB loaded
00700	;call is PUSHJ 
00800		PUSH	P,2
00900		PUSH	P,3
01000		MOVEM	2,FDBEOF(CDB)
01100		HRLI	1,12				;OFFSET
01200		MOVEM	2,3				;NEW COUNT
01300		SETO	2,				;MASK FOR CHANGED BITS
01400		JSYS	CHFDB				;NEW NUMBER OF BYTES TO END
01500		MOVEI	2,=7
01600		MOVEM	2,FDBSZ(CDB)
01700		HRLI	1,11
01800		MOVSI	2,007700			;MASK
01900		MOVSI	3,000700			;AND CHANGED BITS
02000		JSYS	CHFDB				;NEW BYTE SIZE
02100		HRLI	1,0				;LEAVE JFN IN 1
02200		POP	P,3
02300		POP	P,2
02400		POPJ	P,
02500	
02600	GETCND:
02700	;returns in 2 the character count that addresses EOF according to the FDB
02800	;1, CDB loaded
02900		BEGIN	GETCND
03000		PUSH	P,3
03100		SKIPN	3,FDBSZ(CDB)
03200		  JRST	RET0
03300		CAIN	3,=36				;36 BITS?
03400		  JRST	RET2				;YES
03500		CAIN	3,=7				;7 BIT?
03600		  JRST	RET1				;YES
03700		CAILE	3,=36				;BETTER BE LEQ 36
03800		  ERR	<GETCND:  Byte size bigger than 36 bits>,1
03900		PUSH	P,4
04000		MOVEI	2,=36
04100		IDIVI	2,(3)				;GET THE NUMBER OF BYTES IN EACH 36-BIT WORD
04200		MOVE	3,FDBEOF(CDB)			;GET THE NUMBER OF BYTES IN THE FILE
04300		IDIVI	3,(2)				;THIS MANY WORDS -- EXTRA BYTES TO 3
04400		IMULI	3,5				;THIS MANY CHARACTERS IN THE WORDS
04500		PUSH	P,3				;SAVE ON STACK
04600		MOVEI	2,(4)				;EXTRA BYTES
04700		IMUL	2,FDBSZ(CDB)			;EXTRA BITS
04800		IDIVI	2,5				;CHARACTERS
04900		JUMPE	3,.+2				;ANYTHING LEFT OVER?
05000		  AOJ	2,				;YES
05100		POP	P,3				;GET BACK NUMBER OF CHARACTERS
05200		ADD	2,3				;PLUS THE ADDITIONAL ONES HERE -- ANSWER IN 2
05300		POP	P,4				;RESTORE
05400	POPBACK:
05500		POP	P,3		
05600		POPJ	P,				;RETURN ANSWER IN 2
05700	
05800	RET0:	SETZ	2,
05900		JRST	POPBACK
06000	
06100	RET1:	MOVE	2,FDBEOF(CDB)			;7 BIT ALREADY 
06200		JRST	POPBACK
06300	
06400	RET2:	MOVE	2,FDBEOF(CDB)			;36 BIT BYTES
06500		IMULI	2,5				;5 CHARACTERS PER BYTE
06600		JRST	POPBACK				;RETURN IT
06700	
06800		BEND GETCND
06900	
07000		BEGIN GETCPT
07100	;ROUTINES FOR CHAR EOB
07200	
07300	^^GETCPT:
07400	;1,CDB LOADED
07500	;RETURNS IN 2 THE END OF BUFFER CHARACTER
07600		SKIPN	2,IOBP(CDB)
07700		  POPJ	P,				;RETURN 0
07800		PUSH	P,3
07900		TLZ	2,007700
08000		TLO	2,000700			;MAKE A 7-BIT POINTER
08100		IBP	2				;INCREMENT
08200		HRRZM	2,3				;ADDRESS	
08300		HRRI	2,BYTES
08400		LDB	2,2
08500		SUB	3,IOADDR(CDB)			;SUBTRACT
08600		IMULI	3,5				;CHARACTERS
08700		ADDI	3,(2)				;PLUS THESE IN EXTRA WORD
08800		MOVE	2,IOPAGE(CDB)
08900		IMULI	2,1000*5			;PREVIOUS PAGES IN THE FILE
09000		ADDI	2,(3)				;PLUS THESE
09100		POP	P,3
09200		POPJ	P,				;RETURN IN 2
09300	
09400	
09500	^^GTCPT1:
09600	;1, CHNL, CDB loaded
09700	;call PUSHJ
09800	;returns the following
09900	;	2	how many characters until the end of the buffer
10000	;	3	bp to first free character
10100	;	4	count for character output
10200	;	5	count for character input
10300		SKIPN	3,IOBP(CDB)
10400		  JRST	RET
10500		TLZ	3,007700
10600		TLO	3,000700			;MAKE A 7-BIT POINTER
10700		MOVEM	3,2				;COPY IN 2
10800		IBP	2
10900		HRRZM	2,4				;ADDRESS
11000		HRRI	2,BYTES				
11100		LDB	2,2				;NUMBER OF ADDTL CHARS
11200		SUB	4,IOADDR(CDB)			;ADDRESS OF BUFFER
11300		IMULI	4,5
11400		ADDI	4,(2)
11500		MOVE	2,IOPAGE(CDB)
11600		IMULI	2,1000*5
11700		ADDI	2,(4)
11800		MOVNI	4,(4)
11900		ADDI	4,1000*5
12000		MOVEM	2,5				;SAVE 2
12100		PUSHJ	P,GETCND			;GET CHAR EOF
12200		EXCH	5,2
12300		SUB	5,2
12400		CAML	5,4
12500		  MOVEM	4,5
12600		POPJ	P,
12700	
12800	BYTES:	BYTE (7) 0,1,2,3,4
12900	
13000	RET:	SETZB	2,3				;NOT INITIALIZED
13100		SETZB	4,5
13200		POPJ	P,
13300	
13400		BEND GETCPT
13500	
13600	CHCEOF:	
13700	;CHECKS TO SEE IF CHARACTER EOF POINTER NEEDS RESETTING
13800	;1, CDB LOADED
13900		SKIPN	IOBP(CDB)			;DONT CHECK IF NOTHING THERE
14000		  POPJ	P,
14100		PUSH	P,2
14200		PUSH	P,3
14300		PUSHJ	P,GETCND			;GET CHARACTER EOF IN 2
14400		MOVEM	2,3				;SAVE IN 6
14500		PUSHJ	P,GETCPT			;GET CHARACTER EOB IN 2	
14600		CAML	2,3				;NEED RESETTING?
14700		  PUSHJ	P,SETCND			;YES
14800		POP	P,3
14900		POP	P,2
15000		POPJ	P,
15100	
     
00100	SETCPT:
00200	;1,CDB LOADED
00300	;2 HAS THE BYTE IN THE FILE TO SET TO
00400		BEGIN SETCPT
00500	
00600		MOVE	3,IOSTT(CDB)
00700		CAIN	3,XOWORD			;PREVIOUSLY DOING WORD OUTPUT?
00800		  PUSHJ	P,CHWEOF			;YES CHECK EOF
00900		CAIN	3,XOCHAR			;PREVIOUSLY DOING CHAR OUTPUT
01000		  PUSHJ	P,CHCEOF			;CHECK EOF
01100		CAMN	2,[-1]				;WANT EOF?
01200		  PUSHJ P,GETCND			;YES, GET IN 2
01300		IDIVI	2,1000*5			;PAGE BEING REQUESTED
01400		CAME	2,IOPAGE(CDB)			;SAME AS CURRENT
01500		  PUSHJ	P,SETPAGE			;NO GET NEW PAGE
01600		MOVE	2,IOADDR(CDB)
01700		MOVEM	3,5				;NUMBER OF CHARS IN THIS BUFFER
01800	 	IDIVI	3,5				;WORDS TO 3, BYTES TO 4
01900		ADDI	2,(3)				;3 STILL HAS THE CHAR IN THIS PAGE
02000		HLL	2,BPS(4)
02100		MOVEM	2,IOBP(CDB)
02200		MOVE	3,IOSTT(CDB)
02300		CAIE	3,XICHAR	
02400		CAIN	3,XIWORD
02500		  JRST	ASSUMIN
02600		MOVEI	3,XOCHAR
02700		MOVEM	3,IOSTT(CDB)
02800	FULBUF:	MOVEI	3,1000*5
02900	SUBI3:	SUBI	3,(5)
03000	STOAC3:	MOVEM	3,IOCNT(CDB)
03100		POPJ	P,
03200	ASSUMIN:
03300		MOVEI	3,XICHAR
03400		MOVEM	3,IOSTT(CDB)
03500		PUSHJ	P,GETCND			;GET THE CHARACTER END OF FILE
03600		IDIVI	2,1000*5			;PAGES IN 2, CHARS IN 3
03700		CAMGE	2,IOPAGE(CDB)			;IS REQUESTED PAGE BEYOND EOF?
03800		   JRST	EMPBUF				;YES, NO INPUT THERE
03900		CAME	2,IOPAGE(CDB)			;ON THIS PAGE?
04000		   JRST	FULBUF				;NO
04100		JRST	SUBI3				;SUBTRACT ALREADY COMMITTED
04200	
04300	EMPBUF:	SETZ	3,
04400		JRST	STOAC3
04500	
04600	BPS:	POINT 7,0,-1
04700		POINT 7,0,6
04800		POINT 7,0,13
04900		POINT 7,0,20
05000		POINT 7,0,27
05100	
05200		BEND SETCPT
     
00100	SETCIO:
00200	;1,CDB LOADED 
00300	;DECIDE WHETHER TO SETCI OR SETCO
00400		MOVEI	3,SETCI				;ASSUME CHARACTER INPUT
00500		MOVE	2,OFL(CDB)
00600		TESTN	2,RDBIT				;DOING INPUT?
00700		  MOVEI	3,SETCO				;NOPE ASSUME OUTPUT
00800		JRST	(3)				;AND POPJ RETURN
     
00100	DSCR
00200		ADCI
00300	
00400	Accepts:  1	jfn
00500		  CDB	channel data block
00600	
00700	Call:	PUSHJ
00800	
00900	Returns:	+1 for eof
01000			+2 for good input
01100	
01200	Resets values in the CDB
01300	
01400	
01500		BEGIN ADCI
01600	
01700	^^ADCI:	PUSH	P,1
01800		PUSH	P,2
01900		PUSH	P,3
02000		SIMIO	2,TABL,ADCERR			;MOVE 3,IOPAGE(CDB)
02100		AOJ	3,				;NEXT PAGE
02200		IMULI	3,1000*5			;NEXT CHARACTER
02300		PUSHJ	P,GETCND			;CHARACTER EOF IN 2
02400		CAML	3,2				;IS IT BEYOND
02500		  JRST	ADEOF				;YES -- CONFESS THAT IT IS
02600		SUB	2,3				;COUNT CHARACTERS IN NEW BUFFER
02700		CAILE	2,1000*5			;LESS THAN A FULL BUFFER
02800		  MOVEI	2,1000*5			;NO
02900		MOVEM	2,IOCNT(CDB)
02950	NOCRYPT<
03000		AOS	2,IOPAGE(CDB)			;INCREMENT PAGE COUNTER, GET IN 2
03050	>
03060	CRYPT<
03070		MOVE	2,IOPAGE(CDB)			;say which page we want
03080		ADDI	2,1
03090	>
03100		PUSHJ	P,SETPAGE			;GET NEXT PAGE
03200		MOVE	2,IOADDR(CDB)
03300		HRLI	2,440700			;MAKE A BYTE-POINTER
03400		MOVEM	2,IOBP(CDB)
03500	ADRET:	AOS	-3(P)				;INCREMENT PC WORD
03600	ADEOF:	POP	P,3				;EOF --  DONT INCREMENT
03700		POP	P,2
03800		POP	P,1
03900		POPJ	P,				;RETURN
04000	
04100	TABL:	JRST	ADCERR				;0 -- XNULL
04200		MOVE	3,IOPAGE(CDB)			;1 -- XICHAR
04300		REPEAT 3,<JRST ADCERR>			;2-4
04400		JRST	DOSIN				;5 -- XCICHAR
04500		REPEAT 3,<JRST ADCERR>			;6-10
04600		JRST	DODUMPI				;11 -- XDICHAR
04700		REPEAT 2,<JRST	ADCERR>			;12,13
04800	
04900	ADCERR:	ERR	<Dryrot at ADCI>,1
05000		JRST	ADEOF
05100	
05200	
05300	DOSIN:	MOVE	2,IOADDR(CDB)
05400		HRL	3,2
05500		HRRI	3,1(2)
05600		SETZM	(2)
05700		BLT	3,777(2)
05800		HRLI	2,444400
05900		MOVNI	3,1000
06000		JSYS	SIN
06100		CAMG	3,[-1000]
06200		  JRST	[CAMN	3,[-1000]		;EOF?
06300			  JRST	ADEOF
06400			 JRST .+1]
06500		ADDI	3,1000				;NUMBER OF WORDS READ
06600		IMULI	3,5				;NUMBER OF CHARACTERS
06700	STOCNT:	MOVEM	3,IOCNT(CDB)
06800		MOVE	2,IOADDR(CDB)
06900		HRLI	2,440700
07000		MOVEM	2,IOBP(CDB)
07100		JRST	ADRET				;AND RETURN
07200	
07300	DODUMPI:
07400		PUSH	P,1				;SAVE JFN OVER POSSIBLE DUMPI ERROR
07500		PUSH	P,4
07600		MOVE	3,IOADDR(CDB)
07700		HRL	2,3
07800		HRRI	2,1(3)
07900		SETZM	(3)
08000		BLT	2,777(3)	
08100		SOJ	3,
08200		HRLI	3,-1000				;MAKE AN IOWD
08300		MOVEI	2,3				;COMMAND LIST STARTS AT 3
08400		SETZ	4,				;AND ENDS AT 4
08500		JSYS	DUMPI
08600		  JRST	DMIERR
08700		MOVEI	3,1000*5
08800		POP	P,4
08900		POP	P,1
09000		JRST	STOCNT
09100	
09200	DMIERR:	CAIE	1,600220			;EOF?
09300		  ERR	<ADCI:  Dump mode input error>,1
09400		POP	P,4				;RESTORE
09500		POP	P,1				;PRECIOUS JFN
09600		MOVE	2,DVTYP(CDB)			;GET DEVICE TYPE
09700		CAIE	2,3				;MAGTAPE?
09800		  JRST	ADEOF				;NO, JUST INDICATE EOF
09900		SETZ	2,				;MTOPR RESET
10000		JSYS	MTOPR
10100		JRST	ADEOF				;AND SAY WE ARE AT THE END OF THE FILE
10200	
10300	
10400		BEND ADCI
10500	DOINP:
10600	;CHNL has the JFN
10700	;CDB has the channel data block
10800	;returns +1 for good buffered input
10900	;	 +2 for 7-bit input with char in D
11000	;	 +3 for eof or error
11100		BEGIN DOINP
11200		PUSH	P,1				;SAVE 1
11300		PUSH	P,2
11400		MOVE	1,CHNL				;JFN
11500		MOVE	D,IOSTT(CDB)			;D IS FREE
11600		CAIE	D,XBYTE7			;7-BIT?
11700		  JRST	DOBUFF
11800		SKIPE	TTYINF(CDB)			;CONTROLLING TERMINAL?
11900		  JRST	CHKTTY				;YES
12000	DOBIN:	JSYS	BIN
12100		JUMPE	2,CHKEOF			;IF 0 MAY BE EOF
12200		MOVEM	2,D				;STORE 
12300		JRST	DOB7
12400	;;;	MOVE	2,DVTYP(CDB)			;IS THE DEVICE A TTY?
12500	;;;	CAIE	2,12				;
12600	;;;	  JRST	DOB7
12700	;;;	CAIE	2,12				;
12800	;;;	  JRST	DOB7				;NO
12900	;;;	CAIN	D,32				;A CONTROL-Z?
13000	;;;	  JRST	DOIEOF				;YES INDICATE EOF
13100	;;;	CAIN	D,37				;PHONEY BBN EOL?
13200	;;;	  MOVEI	D,12				;A LINE-FEED
13300	;;;	JRST	DOB7				;AND RETURN
13400	
13500	CHKEOF:	JSYS	GTSTS				;BETTER CHECK
13600		TESTE	2,1B8			
13700		  JRST	DOIEOF				;YEP
13800		SETZ	D,
13900		JRST	DOB7
14000	
14100	DOIEOF:	SETOM	.SKIP.
14200		SKIPE	ENDFL(CDB)			;SPECIFIED?
14300		  SETOM	@ENDFL(CDB)			;YES
14400		AOS	-2(P)
14500	DOB7:	AOS	-2(P)
14600	DORET:	POP	P,2
14700		POP	P,1
14800		POPJ	P,
14900	
15000	
15100	DOBUFF:
15200		PUSHJ	P,ADCI
15300		  JRST	DOIEOF				;INDICATE EOF
15400		JRST	DORET
15500	
15600	CHKTTY:
15700		MOVE	2,TTYINF(CDB)			;CHECK STATUS OF TTY
15800		TESTE	2,QTTEOF			;EOF QUED?
15900		  JRST	DOIEOF				;YES
16000		SETZM	CTLOSW				;INDICATE REQUEST 
16100							;FOR INPUT
16200		HRRZ	2,2
16300		CAIN	2,TNXINP			;TENEX DEFAULT
16400		  JRST	DOBIN
16500		CAIN	2,TENXED			;TENEX STYLE EDITING?
16600		  JRST	TNXBUF				;YES
16700		CAIN	2,DECLED			;DEC STYLE BUFFERING?
16800		  JRST	DECBUF
16900		ERR	<DOINP:  Illegal buffering request for terminal>,1
17000	
17100	IMSSS<
17200	TNXBUF:
17300		BEGIN TNXBUF
17400	ORIGCNT__ =1000
17500	
17600		PUSH	P,1
17700		PUSH	P,2
17800		PUSH	P,3
17900		HRRO	1,IOADDR(CDB)		;BP TO BUFFER FOR CHAN
18000		SETZ	3,
18100		MOVEI	2,ORIGCNT		;DEFAULT LENGTH
18200		JSYS 	PSTIN
18300		MOVEI	3,ORIGCNT		;MAXIMUM
18400		SUBI	3,(2)			;GET NUMBER RECEIVED IN 3
18500		LDB	2,1			;GET THE LAST CHAR
18600		CAIE	2,15			;CARRIAGE RETURN (PROB!!)
18700		  JRST	NOTCR
18800		MOVEI	2,12			;INSERT A 12 AFTER IT
18900		IDPB	2,1
19000		AOJ	3,			;INCREMENT COUNT
19100		JRST	GOTBRK			;BREAK TENDED
19200	
19300	NOTCR:
19400		CAIE	2,32			;EOF?
19500		  JRST	GOTBRK
19600		MOVE	2,[QTTEOF]
19700		ORM	2,TTYINF(CDB)		;QUE THE END OF FILE
19800		SOJ	3,			;SUBTRACT ONE FROM COUNT -- CTRL-Z
19900	
20000	GOTBRK:	MOVEM	3,IOCNT(CDB)		;SAVE COUNT
20100		MOVE	1,IOADDR(CDB)
20200		HRLI	1,440700		;MAKE A BP
20300		MOVEM	1,IOBP(CDB)		;SAVE IT FOR USER
20400		POP	P,3			;RESTORE
20500		POP	P,2
20600		POP	P,1
20700		JRST	DORET			;AND RETURN
20800	
20900		BEND TNXBUF
21000	>;IMSSS
21100	
21200	NOIMSSS<;NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
21300	;UNDER BBN'S LACK OF A SYSTEM LINE EDITOR
21400	;	March, 1978
21500	;	R. Smith
21600	;	Rutgers University
21700	;	Runtime-test added for TOPS20, to use RDTTY JSYS
21800	;instead of buffering code.  If a conditional-assembly switch
21900	;is ever added for TOPS20, this should be accomplished at
22000	;assembly time.
22100	
22200	TNXBUF:
22300		BEGIN TNXBUF
22400	ORIGCNT__ =200
22500	;AC USES  A,B,C  JSYS TEMPORARIES
22600	;	  D	 BYTEPOINTER
22700	;	  E	 COUNT, INITIALLY 0
22800	;	  Q1 (=6) ORIGINAL BP
22900		PUSH	P,A			;SAVE
23000		PUSH	P,B
23100		PUSH	P,C
23200		PUSH	P,D
23300		PUSH	P,E
23400		PUSH	P,Q1
23500		MOVE	Q1,IOADDR(CDB)
23600		HRLI	Q1,440700		;MAKE A BP
23700	TSTT20:	SKIPN	$OSTYP			;[CLH] SKIP IF TOPS-20
23800		  JRST	ISTENEX			;TENEX
23900	IST20:	MOVE	A,Q1			;USE BP
24000		HRLI	B,(1B1)			;BREAK OF ALL TOPS-10
24100		HRRI	B,ORIGCNT		;COUNT
24200		SETZ	C,			;NO CONTROL-R FEATURE
24300	OPDEF 	RDTTY	[104000000523]
24400		RDTTY				;DO IT
24500		  JRST	[ERR <RDTTY FAILED ON TOPS20?>,0]
24600		MOVEI	E,ORIGCNT		;CALCULATE NUMBER OF BYTES LONG
24700		SUBI	E,(B)			;SINCE RH(B) CONTAINS UPDATED CONT
24800		LDB	A,A			;[CLH] GET TERMINATOR
24900		CAIN	A,32			;[CLH] IF ^Z
25000		JRST	TEOF20			;[CLH] THEN END OF FILE
25100		JRST	CNTEXH			;STORE COUNT,BP, AND RETURN
25200	
25300	ISTENEX:
25400	RESTRT:	MOVE	D,Q1			;GET THE ORIGINAL BP	
25500		SETZ	E,			;ZERO THE COUNT
25600	INLUP:	CAIL	E,ORIGCNT
25700		  JRST	CNTEXH			;COUNT EXHAUSTED
25800		JSYS	PBIN			;GET A CHAR
25900		CAIN	A,37			;EOL?
26000		  JRST	DOEOL			;YES
26100		CAIN	A,12			;LINE FEED (ON TOPS 20)
26200		  JRST	DONE			;YES
26300		CAIN	A,33			;ESCAPE?
26400		  JRST	DONE
26500	 	CAIN	A,7			;CTRL-G
26600		  JRST	DONE
26700		CAIN	A,32			;CTRL-Z
26800		  JRST	TTYEOF			;INDICATE EOF
26900		CAIN	A,"R"-100		;CTRL-R FOR REPEAT
27000		  JRST	DOCTR
27100		CAIN	A,"X"-100		;CTRL-Z FOR DELETE LINE
27200		  JRST	DOCTX			;YES
27300		CAIE	A,177			;EITHER RUBOUT
27400		CAIN	A,"A"-100		;OR CTRL-A
27500		  JRST	DOCTA			;FOR DELETE CHARACTER
27600		IDPB	A,D
27700		AOJA	E,INLUP			;CONTINUE
27800	
27900	DOCTR:	HRROI	A,[ASCIZ/
28000	/]
28100		JSYS	PSOUT
28200		JUMPE	E,INLUP
28300		MOVEI	A,101
28400		MOVE	B,Q1			;ORIG BP
28500		MOVN	C,E			;COUNT THUS FAR
28600		JSYS	SOUT
28700		JRST	INLUP			;AND CONTINUE
28800	
28900	DOCTX:	HRROI	A,[ASCIZ/
29000	/]
29100		JSYS	PSOUT
29200		JRST	RESTRT			;AND START ALL OVER
29300	
29400	DOCTA:	JUMPLE	E,DOCTX			;IF NO CHARS THEN DO A CONTROL-X
29500		MOVEI	A,"\"
29600		JSYS	PBOUT
29700		LDB	A,D			;LAST CHAR
29800		JSYS	PBOUT	
29900		SOJ	D,
30000		IBP	D
30100		IBP	D
30200		IBP	D
30300		IBP	D
30400		SOJA	E,INLUP			;SUBTRACT 1 AND CONTINUE
30500	
30600	DOEOL:	
30700		MOVEI	A,15
30800		IDPB	A,D
30900		AOJ	E,
31000		MOVEI	A,12
31100	DONE:	IDPB	A,D
31200		AOJ	E,
31300	CNTEXH:
31400		MOVEM	E,IOCNT(CDB)			;COUNT
31500		MOVEM	Q1,IOBP(CDB)			;BP
31600		POP	P,Q1				;RESTORE
31700		POP	P,E
31800		POP	P,D
31900		POP	P,C
32000		POP	P,B
32100		POP	P,A
32200		JRST	DORET				;RETURN
32300	
32400	TEOF20:	SUBI	E,1				;[CLH] DON'T COUNT ^Z
32500	
32600	TTYEOF:	MOVE	A,[QTTEOF]
32700		ORM	A,TTYINF(CDB)			;QUE END-OF-FILE
32800		JRST	CNTEXH				;AND RETURN
32900		BEND TNXBUF
33000	>;NOIMSSS
33100	
33200	DECBUF:
33300		BEGIN DECBUF
33400	
33500	ORIGCNT __ =1000				;LOTS OF ROOM
33600	
33700		PUSH	P,A
33800		PUSH	P,B
33900		PUSH	P,C
34000		PUSH	P,D
34100		PUSH	P,E
34200		PUSH	P,Q1
34300	
34400		MOVE	Q1,IOADDR(CDB)
34500		HRLI	Q1,440700			;MAKE A BP
34600		
34700	RESTRT:	MOVE	D,Q1
34800		SETZ	E,				;COUNT
34900	INLUP:	CAIL	E,ORIGCNT			;BEYOND?
35000		  JRST	CNTEXH				;YES
35100		JSYS	PBIN
35200		CAIN	A,DELLINE			;DELETE ENTIRE LINE?
35300		  JRST	CTRLU				;YES
35400		CAIN	A,RUBCHAR			;RUBOUT?
35500		  JRST	RUBOUT				;YES
35600		CAIN	A,37				;PHONEY BBN EOL?
35700		  JRST	SAWEOL
35800		CAIN	A,33
35900		  JRST	SAWESC
36000		CAIN	A,32				;CONTROL-Z?
36100		  JRST	TTYEOF				;YES, EOF
36200		CAIE	A,7				;CONTROL-G
36300		CAIN	A,12				;OR LF
36400		  JRST	DONE
36500		IDPB	A,D
36600		AOJA	E,INLUP				;CONTINUE
36700	
36800	CTRLU:	HRROI	A,[BYTE (7) 7,15,12,0,0]
36900		JSYS	PSOUT
37000		JRST	RESTRT				;START OVER
37100	
37200	RUBOUT:	JUMPE	E,CTRLU				;NOTHING, DO CTRLU
37300	IMSSS <
37400		MOVEI	1,101
37500		JSYS	DELCH
37600		  JFCL
37700		JRST	DLTED
37800		JRST	DLTED
37900	>;IMSSS
38000		MOVEI	A,"\"
38100		JSYS	PBOUT
38200		LDB	A,D				;LAST CHAR
38300		JSYS	PBOUT
38400	DLTED:
38500		SOJ	D,				;DECREMENT BP
38600		IBP	D
38700		IBP	D
38800		IBP	D
38900		IBP	D
39000		SOJA	E,INLUP				;DECREMENT COUNT AND CONTINUE
39100	
39200	DONE:
39300		IDPB	A,D
39400		AOJ	E,
39500	CNTEXH:
39600		MOVEM	E,IOCNT(CDB)
39700		MOVEM	Q1,IOBP(CDB)
39800		POP	P,Q1
39900		POP	P,E
40000		POP	P,D
40100		POP	P,C
40200		POP	P,B
40300		POP	P,A
40400		JRST	DORET
40500	
40600	SAWEOL:	MOVEI	A,15				;SIMULATE CR
40700		IDPB	A,D
40800		AOJ	E,
40900		MOVEI	A,12				;SIMULATE LF
41000		JRST	DONE
41100	
41200	SAWESC:	MOVEI	A,ALTMODE			;DEC ALTMODE
41300		JRST	DONE
41400	
41500	TTYEOF:	MOVE	A,[QTTEOF]
41600		ORM	A,TTYINF(CDB)			;QUE AN EOF
41700		JRST	CNTEXH				;AND RETURN
41800	
41900		BEND DECBUF
42000	
42100		BEND DOINP
     
00100	DSCR 	ADCO,ADCO1
00200	CAL	PUSHJ
00300	SID	SAVES ALL ACS
00400	ARGS
00500		1		JFN
00600		CDB		address of channel data block
00700	
00800	
00900		BEGIN ADCO
01000	;HERE IF THE COUNT ALREADY PROMISES A CHARACTER
01100	^^ADCO1:
01200		AOS	IOCNT(CDB)	;MAKE THE COUNT HONEST, TEMPORARILY
01300		PUSHJ	P,ADCO		;CALL ADCO
01400		SOS	IOCNT(CDB)	;REFLECT THE FACT THAT A CHARACTER IS PROMISED
01500		POPJ	P,		;AND RETURN (TO CHARACTER OUTPUT CODE)
01600	
01700	^^ADCO:
01800		PUSH	P,2		;SAVE ACS
01900		PUSH	P,3
02000		PUSH	P,4
02100		MOVE	2,IOSTT(CDB)	;GET STATUS
02200		CAIE	2,XOCHAR	;PMAPPING THE DSK?
02300		  JRST	NOPMAP		;GUESS NOT
02350	NOCRYPT<
02400		AOS	2,IOPAGE(CDB)	;NEXT PAGE
02450	>
02460	CRYPT<
02465		MOVE	2,IOPAGE(CDB)	;say we want next page
02470		ADDI	2,1
02480	>
02500		PUSHJ	P,SETPAGE
02600		MOVEI	2,1000*5	
02700		MOVEM	2,IOCNT(CDB)	;CAN WRITE THIS MANY
02800		MOVE	2,IOADDR(CDB)	
02900		HRLI	2,440700	
03000		MOVEM	2,IOBP(CDB)	;OK
03100	ADRET:	POP	P,4
03200		POP	P,3
03300		POP	P,2
03400		POPJ	P,
03500	
03600	
03700	NOPMAP:
03800		CAIN	2,XCOCHAR	;36-BIT ETC.?
03900		  JRST	STRSOU		;USE SOUT
04000		CAIE	2,XDOCHAR	;BETTER BE DUMP-MODE
04100		  ERR	<Dryrot at ADCO>,1
04200		SKIPN	IOBP(CDB)	;SET UP YET?
04300		  JRST	DMPINIT
04400		MOVE	3,IOADDR(CDB)
04500		MOVEI	4,DMOCNT*5
04600		CAMG	4,IOCNT(CDB)	;ANY CHARS TO SEND
04700		  JRST	ADRET
04800		
04900		MOVEI	2,3
05000		SUBI	3,1
05100		MOVNI	4,DMOCNT	;WORD COUNT FOR DUMP MODE OUTPUT	
05200		HRL	3,4		;MAKE AN IOWD
05300		SETZ	4,		;MAKE A COMMAND LIST
05400		JSYS DUMPO
05500		  ERR <DUMPOUT:  CANNOT WRITE DATA IN DUMP MODE>,1
05600		SETOM	DMPED(CDB)	;AND INDICATE DONE
05700	DMPINIT:
05800		MOVE	3,IOADDR(CDB)
05900		HRL	2,3
06000		HRRI	2,1(3)
06100		SETZM	(3)
06200		BLT	2,DMOCNT-1(3)	;ZERO OUT
06300		MOVEI	2,DMOCNT*5	
06400		MOVEM	2,IOCNT(CDB)	;SAVE COUNT
06500		HLL	3,[POINT 7,0,-1];FIX A BYTE-POINTER
06600		MOVEM	3,IOBP(CDB)	;AND SAVE BYTE-POINTER
06700		JRST	ADRET
06800	
06900	STRSOU:	
07000		SKIPN	IOBP(CDB)
07100		  JRST	SOUINIT
07200		MOVEI	3,1000*5
07300		SUB	3,IOCNT(CDB)	;NUMBER OF CHARACTERS ACTUALLY IN BUFFER
07400		IDIVI	3,5		;NUMBER OF WORDS
07500		SKIPE	4		;ANY REMAINDER?
07600		   AOJ	3,		;YES, ANOTHER WORD FOR EXTRA CHARACTERS
07700		JUMPE	3,ADRET		;RETURN IF NO CHARACTERS TO SEND
07800		MOVN	3,3		;NEGATIVE WORD COUNT FOR SOUT
07900		MOVE	2,IOADDR(CDB)
08000		HRLI	2,444400	;MAKE A BP
08100		JSYS SOUT
08200	SOUINIT:
08300		MOVE	2,IOADDR(CDB)
08400		HRL	3,2
08500		HRRI	3,1(2)
08600		SETZM	(2)
08700		BLT	3,777(2)	;CLEAR OUT PAGE
08800		HRLI	2,440700
08900		MOVEM	2,IOBP(CDB)
09000		MOVEI	3,1000*5
09100		MOVEM	3,IOCNT(CDB)
09200		JRST	ADRET
09300	
09400		BEND ADCO
     
00100	DSCR SETIO
00200		Master routine to set up the file io possibilities.
00300	
00400	Arguments:
00500		1,CHNL,CDB set up
00600	
00700	There are four entries to the function, depending on the kind of IO that
00800	appears to be desired.  They are:
00900	
01000		SETCI		character input
01100		SETCO		character output	
01200		SETWI		word input
01300		SETWO		word output
01400	
01500	
01600	This routine does the following things:
01700		(1)  sets up IOSTT
01800	
01900	
02000	It does so by first deciding each of these
02100		(1)  input or output immediately desired
02200		(2)  chars or words immediately desired
02300		(3)  7 or 36 bit bytes open
02400		(4)  mode 0 or 17	
02500		(5)  dsk or non-dsk
02600	
02700	An additional consideration is that the file, if on the disk,
02800	may need to be CLOSFed and reOPENFed to allow reading (and writing
02900	if appending).
03000	This facilitates (indeed, makes possible) PMAPping the file and
03100	doing I/O directly into pages of the file.  Should this reOPENF
03200	fail (as when protection does not allow it), it will be necessary
03300	to restrict the possibility of doing data mixed and random I/O
03400	to the file.  Such is the design of TENEX. (Example:  MESSAGE.TXT
03500	is ordinarily such that you can append to it but not read and
03600	write, when it is someone else's file.)
03700	
03800	
03900		BEGIN SETIO
04000	^SETWI:	SKIPA	6,[=8]				;wants word input
04100	^SETWO:	MOVEI	6,=24				;wants word output
04200		JRST	SETIO				;
04300	
04400	^SETCI:	TDZA	6,[-1]				;wants character input
04500	^SETCO:	MOVEI	6,=16				;wants character output
04600	
04700	SETIO:	LDB	2,[POINT 6,OFL(CDB),5]		;7-36 BIT BYTES?
04800		CAIN	2,=36
04900		  ADDI	6,4				;36
05000		LDB	2,[POINT 4,OFL(CDB),9]
05100		JUMPE	2,.+2				;MODE 0 OR 17?
05200		  ADDI	6,2				;17
05300		SKIPE	DVTYP(CDB)			;DSK OR NON-DSK?
05400		  AOJ	6,				;NON-DSK
05500		IDIVI	6,7				;SET UP FOR LDB
05600		LDB	6,BPS(7)
05700		JUMPN	6,.+2			
05800		  ERR	<DRYROT at SETIO:  Nonsense combination of bytes and modes for io request.>,1
05900		MOVEM	6,IOSTT(CDB)			;THAT IS THE ANSWER
06000		CAIL	6,XICHAR			;PMAPPED DISK FILE?
06100		CAILE	6,XOWORD
06200		  JRST	NOPMAP
06300		MOVE	2,OFL(CDB)
06400		TESTN	2,WRBIT				;WRITING
06500		TESTE	2,APPBIT			;OR APPENDING?
06600		  JRST	.+2				;THEN BETTER BE READING
06700		JRST	CHKED1
06800		TESTO	2,RDBIT				;MUST BE READING
06900		TESTN	2,APPBIT			;REMEMBER IF APPENDING
07000		  JRST	NOAPP				;NOT APPENDING
07100		TESTZ	2,APPBIT			;TURN OFF APPENDING
07200		TESTO	2,WRBIT				;INDICATE WRITING
07300		SKIPA	3,[-1]				;APPENDING
07400	NOAPP:	  SETZ	3,				;NOT APPENDING
07500		CAMN	2,OFL(CDB)			;DIFFERENT?
07600		  JRST	CHKED				;NO
07700		TESTO	1,1B0				;DONT RELEASE
07800		JSYS	CLOSF
07900		  ERR	<SETIO:  Cannot do CLOSF>
08000		TESTZ	1,1B0				;RESET DONT RELEASE BIT
08100		PUSH	P,1				;SAVE JFN
08200		JSYS	OPENF
08300		  JRST  NOROPN				;CANNOT RE-OPEN FILE
08400		POP	P,1				;RESTORE JFN
08500		MOVEM	2,OFL(CDB)			;AND REMEMBER NEW FLAGS
08600	CHKED:	SKIPA	2,3				;PICK UP SAVED POINTER
08700	CHKED1:	  SETZ	2,
08800		PUSH	P,2				;SAVE POINTER
08900		SETOM	IOPAGE(CDB)			;DENY THAT THERE IS A PAGE THERE
09000		MOVE	2,[XWD 2,11]			;READ FDB
09100		MOVEI	3,2
09200		JSYS	GTFDB
09300		MOVEM	3,FDBEOF(CDB)			;SAVE EOF
09400		LDB	2,[POINT 6,2,11]
09500		MOVEM	2,FDBSZ(CDB)
09600		POP	P,2				;GET POINTER BACK
09700		CAIE	6,XIWORD			;SEE IF WORDS
09800		CAIN	6,XOWORD
09900		  JRST	SETWPT				;WORDS	   POPJ BACK
10000		JRST	SETCPT				;CHARACTERS  POPJ BACK
10100	
10200	NOROPN:	POP	P,1				;CLOBBERED JFN
10300		MOVE	2,OFL(CDB)			;FLAGS AS THEY WERE -- CANT DO NO BETTER
10400		JSYS	OPENF
10500		  ERR	<SETIO:  Cannot do OPENF>
10600		MOVE	2,IOSTT(CDB)			;STATUS -- MUST BE CHANGED
10700		CAIN	2,XICHAR
10800		  MOVEI	3,XCICHAR
10900		CAIN	2,XOCHAR
11000		  MOVEI	3,XCOCHAR
11100		CAIE	2,XIWORD
11200		CAIN	2,XOWORD
11300		  MOVEI	3,XCIWORD
11400		MOVEM	3,IOSTT(CDB)			;SAVE STATUS -- BEST WE CAN DO
11500							;FALL THRU AND RETURN
11600	NOPMAP:	SETZM	IOCNT(CDB)
11700		SETZM	IOBP(CDB)			
11800		POPJ	P,	
11900	
12000	
12100	BPS:	POINT	5,TABL(6),4			;BYTE POINTERS
12200		POINT	5,TABL(6),9
12300		POINT	5,TABL(6),14
12400		POINT	5,TABL(6),19
12500		POINT	5,TABL(6),24
12600		POINT	5,TABL(6),29
12700		POINT	5,TABL(6),34	
12800	
12900	TABL:	BYTE (5) XBYTE7,XBYTE7,0,0,XICHAR,XCICHAR,XDICHAR
13000		BYTE (5) XDICHAR,0,0,0,0,XIWORD,XCIWORD
13100		BYTE (5) XDARR,XDARR,XBYTE7,XBYTE7,0,0,XOCHAR
13200		BYTE (5) XCOCHAR,XDOCHAR,XDOCHAR,0,0,0,0
13300		BYTE (5) XOWORD,XCIWORD,XDARR,XDARR
13400	
13500	
13600		BEND SETIO
     
00100	DSCR
00200		FINIO
00300	
00400		Finishes the io.  
00500		Mainly does the following:
00600	
00700		(1)  outputs any remaining buffers
00800		(2)  checks eof pointer in FDB of dsk files
00900		(3)  writes EOF marks to magtape
01000	
01100	CAL	PUSHJ from runtimes (CFILE and CLOSF)
01200	ARGS	1,CDB
01300	SID	nothing saved
01400	
01500	HERE(FINIO)
01600		BEGIN FINIO
01700		PUSH	P,1
01800		PUSH	P,2
01900		PUSH	P,3
02000		PUSH	P,4
02100		PUSH	P,5
02200		PUSH	P,6
02300		SIMIO	2,TABL,POPBACK
02400	UNMAP:	
02500	CRYPT<	;Possibly Encrypt current page
02600		SKIPE	NCRYPT(CDB)			;ENCRYPTING?
02700		 PUSHJ	P,CALNCR			;call user's routine
02800		SETZM	NCRYPT(CDB)
02900		SETZM	DCRYPT(CDB)
03000	>; CRYPT
03100		SETZM	DMPED(CDB)			;RESET VALUES TO ORIGINALS
03200		SETZM	IOCNT(CDB)
03300		SETZM	IOBP(CDB)
03400		SETZM	IOSTT(CDB)
03500		SETOM	IOPAGE(CDB)
03600		SETO	1,				;N.B. DESTROY PAGE--NOTE: CLOBBERS JFN 
03700	 	MOVE	2,FKPAGE(CDB)			;UNTIL POP BELOW
03800		SETZ	3,
03900		JSYS	PMAP
04000	POPBACK:POP	P,6
04100		POP	P,5
04200		POP	P,4
04300		POP	P,3
04400		POP	P,2
04500		POP	P,1
04600		POPJ	P,
04700	
04800	TABL:	JRST	POPBACK				;0 -- XNULL
04900		JFCL					;1 -- XICHAR
05000		PUSHJ	P,CHCEOF			;2 -- XOCHAR -- POPJ RETURN
05100		JFCL					;3 -- XIWORD
05200		PUSHJ	P,CHWEOF			;4 -- XOWORD
05300		JFCL					;5 -- XCICHAR
05400		PUSHJ	P,ADCO				;6 -- XCOCHAR
05500		JFCL					;7 -- XCWORD
05600		JRST 	DOB7				;10 -- XBYTE7
05700		JFCL					;11 -- XDICHAR
05800		JRST	XDO1				;12 -- XDOCHAR
05900		JRST	XDO2				;13 -- XDARR
06000		
06100	DOB7:	SKIPN	2,TTYINF(CDB)			;A TELETYPE?
06200		  JRST	UNMAP				;NOPE
06300		TESTZ	2,QTTEOF			;TURN OFF QUED EOF
06400		MOVEM	2,TTYINF(CDB)
06500		JRST	UNMAP				;AND UNBUFFER
06600	
06700	XDO1:	PUSHJ	P,ADCO				;WRITE OUT WHATEVER IS THERE		
06800	XDO2:	SKIPN	DMPED(CDB)			;DUMP MODE OUTPUT SEEN?
06900		  JRST	UNMAP				;NOPE
07000		MOVE	2,DVTYP(CDB)			;DEVICE TYPE
07100		CAIE	2,2				;MAGTAPE?
07200		  JRST	UNMAP				;NOPE
07300		MOVEI	2,3				;EOF
07400		JSYS	MTOPR				;WRITE TWO
07500		JSYS	MTOPR		
07600		MOVEI	2,17				;BACKSPACE OVER 1 EOF
07700		JSYS	MTOPR
07800		JRST	UNMAP
07900	
08000	
08100		BEND FINIO
     
00100	ENDCOM(IOROU)
00200	
00300	COMPIL(BINROU,<SFPTR,RFPTR,MTOPR,BKJFN,RFBSZ>
00400		,<SAVE,RESTR,X22,X33,X44,.SKIP.,JFNTBL,CDBTBL>
00500		,<BINROU -- Binary routines generally to not be used>)
00600	
     
00100	DSCR SIMPLE PROCEDURE SFPTR(INTEGER JFN,POINTER)
00200		Sets the file open on JFN to byte POINTER (-1 for EOF).
00300	Errors returned in .SKIP.
00400		WARNING:  presently not compatible with special character
00500	mode.
00600	
00700	HERE(SFPTR)
00800		PUSHJ	P,SAVE
00900		MOVE	LPSA,X33
01000		VALCHN 1,-2(P),SFBAD
01100		SETZM	.SKIP.
01200		MOVE 2,-1(P)
01300		JSYS SFPTR
01400		  MOVEM	1,.SKIP.
01500	SFRET:	JRST	RESTR
01600	
01700	SFBAD:  ERR <Illegal JFN>,1
01800		SETOM	.SKIP.
01900		JRST	SFRET
02000	
02100	
     
00100	DSCR INTEGER SIMPLE PROCEDURE RFPTR(INTEGER JFN)
00200		Reads the pointer of JFN.  Error codes to .SKIP.
00300		WARNING:  presently does not work for files in special character
00400	mode.
00500	
00600	HERE(RFPTR)
00700		PUSHJ	P,SAVE
00800		MOVE	LPSA,X22
00900		VALCHN	1,-1(P),RFBAD
01000		SETZM	.SKIP.
01100		JSYS RFPTR
01200		MOVEM 1,.SKIP.
01300		MOVEM	2,RACS+A(USER)	;ANSWER IN 2
01400	RFRET:	JRST	RESTR
01500	
01600	RFBAD:  ERR <Illegal JFN>,1
01700		SETOM	.SKIP.
01800		JRST	RFRET
01900	
     
00100	DSCR SIMPLE PROCEDURE MTOPR(INTEGER JFN,FUNCTION,VALUE)
00200		Does the MTOPR jsys.
00300	
00400	HERE(MTOPR)
00500		BEGIN MTOPR
00600		PUSHJ	P,SAVE
00700		MOVE	LPSA,X44
00800		VALCHN 1,-3(P),MTBAD
00900		MOVE 	2,-2(P)
01000		MOVE	3,-1(P)
01100		JSYS MTOPR
01200	MTRET:	JRST	RESTR
01300	
01400	MTBAD:  ERR <Illegal JFN>,1
01500		JRST	MTRET
01600	
01700		BEND MTOPR
01800	
     
00100	DSCR SIMPLE PROCEDURE BKJFN(INTEGER JFN)
00200		Does the BKJFN jsys on JFN, error code to .SKIP.
00300	
00400	HERE(BKJFN)
00500		PUSHJ	P,SAVE
00600		MOVE	LPSA,X22
00700		VALCHN 1,-1(P),BKBAD
00800		SETZM	.SKIP.
00900	BKJF1:	JSYS BKJFN
01000		MOVEM 1,.SKIP.			;ERROR RETURN
01100	BKRET:	JRST	RESTR
01200	
01300	BKBAD:  MOVE	1,-1(P)			;USE LITERALLY
01400		JRST	BKJF1
     
00100	DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN);
00200		Reads the byte-size of the file open on JFN.
00300	
00400	HERE(RFBSZ)
00500		PUSHJ	P,SAVE
00600		MOVE	LPSA,X22
00700		VALCHN 1,-1(P),RFBBAD
00800		JSYS RFBSZ
00900		  JFCL				;TOPS 20 ERROR RETURN
01000		MOVEM	2,RACS+A(USER)		;ANSWER IN 2
01100	RFBRET:	JRST	RESTR
01200	
01300	RFBBAD: ERR <Illegal JFN>,1
01400		JRST	RFBRET
01500	
01600	ENDCOM(BINROU)
01700	
     
00100	COMPIL(DSKOPS,<DSKIN,DSKOUT>
00200		,<JFNTBL,CDBTBL,.SKIP.>
00300		,<DSKOPS -- DIRECT DSK ROUTINES>)
00400	
00500	DSCR SIMPLE PROCEDURE 
00600	DSKIN(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC);
00700	
00800		IMSSS only.
00900		Does direct IO from the DSK (formerly device "PAK").
01000	Modules 4-7 are legal for everyone.  Other modules require enabled
01100	status.
01200		Count words are read into user's core at location LOC, from
01300	MODULE, record RECNO.  Error bits are in .SKIP.
01400		Does the DSKOP jsys (as modified at IMSSS).
01500	
01600	
01700		BEGIN DSKOPS
01800	HERE(DSKIN)
01900	NOIMSSS<
02000		ERR	<DSKIN:  Only defined in IMSSS system>
02100	>;NOIMSSS
02200		PUSHJ	P,SAVE
02300		SETZ	4,		;INDICATE READ ONLY
02400	
02500	DSK1:	HRRZ	2,-2(P)
02600		JUMPLE	2,DSBAD	;LEQ 0 -- ERROR
02700		CAILE	2,1000		;DONT READ MORE THAN 1000 WORDS
02800		   JRST DSBAD
02900		IOR	2,4		;PICK UP READ OR WRITE (SET IN 4)
03000		HRLZ	1,-4(P)		;MODULE
03100		HRR	1,-3(P)		;RECORD NO. IN RIGHT HALF
03200		TLO	1,600000	;SOFTWARD ADDRESS, IMSSS FORMAT (BITS 0 AND 1 RES.)
03300		HRRZ 	3,-1(P) 		; GET THE USER LOCATION
03400	    	JSYS DSKOP
03500	DSDUN:	MOVEM 1,.SKIP.		; SAVE ERROR BITS
03600	DSRET:	MOVE 	LPSA,[XWD 5,5]	; TO ADJUST STACK
03700		JRST	RESTR
03800	DSBAD:	ERR <DSKIN OR DSKOUT:  WORD COUNT EITHER <= 0 OR > '1000>,1
03900		SETOM	.SKIP.
04000		JRST	DSRET
04100	
04200	
04300	
     
00100	DSCR SIMPLE PROCEDURE 
00200		DSKOUT(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC)
00300	DESR Similar to DSKIN, except that a write is done.
00400	
00500	
00600	HERE(DSKOUT)
00700	NOIMSSS<
00800		ERR	<DSKOUT:  Only defined at IMSSS>
00900	>;NOIMSSS
01000		PUSHJ	P,SAVE
01100		MOVSI	4,(1B14)	;INDICATE WRITE (TO BE IOR'ED INTO AC 2)
01200		JRST	DSK1		;AND TO THE ABOVE CODE
01300	
01400		BEND DSKOPS
01500	
01600	ENDCOM(DSKOP)
01700	
     
00100	COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR,ERSTRING>
00200		,<X22,X44,.SKIP.,JFNTBL,CDBTBL>
00300		,<DEVS -- DEVICE HANDLERS, ERROR ROUTINE>)
00400	DSCR INTEGER SIMPLE PROCEDURE DEVTYPE(INTEGER JFN);
00500		Returns (via the DEVCHR jsys) the device type of
00600	the device open on JFN.  The more general DEVCHR call is
00700	also implemented (below).
00800	
00900	HERE(DEVTYPE)
01000		VALCHN 1,-1(P),DEVBAD
01100		JSYS DVCHR
01200		HLRZ	1,2
01300		ANDI	1,777
01400	DEVRET:	SUB	P,X22
01500		JRST	@2(P)
01600	DEVBAD: ERR <Illegal JFN>,1
01700		JRST	DEVRET
     
00100	DSCR INTEGER SIMPLE PROCEDURE DVCHR(INTEGER JFN; REFERENCE INTEGER AC1,AC3);
00200		Does the DEVCHR jsys, returning the flags from AC2 as the
00300	value of the call, and AC1 and AC3 get the contents of ac's 1 and 3.;
00400	
00500	HERE(DVCHR)
00600		VALCHN 1,-3(P),DVBAD
00700		JSYS DVCHR
00800		MOVEM	1,@-2(P)
00900		MOVEM	3,@-1(P)
01000		MOVE	1,2
01100	DVRET:	SUB	P,X44
01200		JRST	@4(P)
01300	DVBAD: ERR <Illegal JFN>,1
01400		JRST	DVRET
01500		
01600	
     
00100	DSCR SIMPLE PROCEDURE ERSTR(INTEGER ERRNO,FORK)
00200		Using the ERSTR jsys, types out on the console the TENEX error string
00300	associated with ERRNO for FORK fork (0 for the current fork).  Parameters (in
00400	the sense of the ERSTR jsys) are expanded.
00500		Types out the string ERSTR:  UNDEFINED ERROR number if
00600	something is with your error number or fork (and sets .SKIP. to -1).
00700	
00800	HERE(ERSTR)
00900		SETZM	.SKIP.
01000		MOVEI	1,101		;PRIMARY OUTPUT
01100		SKIPN	2,-1(P)		;ANY FORK MENTIONED?
01200		   MOVEI 2,400000	;ASSUME CURRENT FORK
01300		HRLZ	2,2		;IN LEFT HALF
01400		HRR	2,-2(P)		;THE ERROR NUMBER
01500		SETZ	3,		;NO LIMIT TO SIZE OF STRING
01600		JSYS ERSTR
01700		   JRST	ERSERR		
01800		   JRST	ERSERR		;ERROR RETURNS
01900	ERSRET:	SUB	P,X33
02000		JRST	@3(P)
02100	ERSERR:	HRROI	1,[ASCIZ/
02200	ERSTR:  UNDEFINED ERROR NUMBER
02300	/]
02400		JSYS PSOUT
02500		SETOM	.SKIP.		;INDICATE ERROR 
02600		JRST	ERSRET
02700	
02800	;[clh] add erstring
02900	DSCR SIMPLE STRING PROCEDURE ERSTRING(INTEGER ERRNO,FORK)
03000		Using the ERSTR jsys, returns the TENEX error string
03100	associated with ERRNO for FORK fork (0 for the current fork).  Parameters (in
03200	the sense of the ERSTR jsys) are expanded.
03300		Returns null if
03400	something is with your error number or fork (and sets .SKIP. to -1).
03500	
03600	
03700	HEREFK(ERSTRING,ERSTR.)
03800		PUSH	P,[=100]	;MAKE SPACE TO RETURN THE VALUE
03900		PUSHJ	P,ZSETST	;BYTE POINTER TO 1
04000		SETZM	.SKIP.
04100		SKIPN	2,-1(P)		;ANY FORK MENTIONED?
04200		   MOVEI 2,400000	;ASSUME CURRENT FORK
04300		HRLZ	2,2		;IN LEFT HALF
04400		HRR	2,-2(P)		;THE ERROR NUMBER
04500		TRNN	2,777777	;NON-ZERO ERROR NUMBER?
04600		   HRRI 2,-1		;NO - USE LAST ERROR
04700		HRLZI	3,-100		;MAX STRING SIZE
04800		JSYS ERSTR
04900		   JFCL
05000		   SETOM .SKIP.		;ERRORS - SET .SKIP., RETURN NULL
05100		PUSH	P,[=100]	;ORIGINAL LENGTH
05200		PUSH	P,1		;UPDATED STRING
05300		PUSHJ	P,ZADJST	;PUT RESULT ON SP
05400		SUB	P,X33
05500		JRST	@3(P)
05600	
05700	;[clh] ^^
05800	
05900	ENDCOM(DEVS)
06000	
     
00100	COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET,RDSEG>
00200		,<CORGET,GOGTAB,JFNTBL,CDBTBL,STRNGC,INSET,SAVE,RESTR,X33>
00300		,<UTILITY -- UTILITY TENEX ROUTINES>)
00400	DSCR
00500		SETCHN accepts in A the JFN, and returns in A the channel number associated with a JFN.  
00600	It sets up the JFNTBL, the CDBTBL table, and returns the address of the
00700	file command block in ac CDB.  Other acs are not modified (except USER).
00800		In order to accommodate the OPEN statement, a channel will be
00900	considered allocated when it has a CDB, even if it does not yet have a jfn.
01000	
01100	
01200	HERE(SETCHN)
01300		MOVE	USER,GOGTAB
01400		PUSH	P,B
01500		PUSH	P,C
01600		PUSH	P,D
01700		MOVEI	B,JFNSIZE		;FOR COMPARISON TO RH OF A
01800		CAILE	B,(A)			;IS THE JFN BEYOND THE NUMBER OF CHANNELS
01900		SKIPE	CDBTBL(A)		;OR IS IT ALLOCATED OR USED?
02000		   JRST FNDCHN			;PERHAPS NOT, FIND ONE SOMEHOW
02100		HRRZ	D,A			;USE JFN NO. AS CHANNEL
02200	;MUST GET A CHANNEL DATA BLOCK
02300	GTCDB:	MOVEI	C,TIOTLN
02400		PUSHJ	P,CORGET
02500		   ERR <SETCHN:  NO CORE>
02600		MOVE	CDB,B
02700		MOVEM	CDB,CDBTBL(D)		;SAVE ADDR OF CDB
02800	;HERE WITH B,CDB, D LOADED WITH: CDBADDR,CDBADDR,CHANNEL
02900	CLCDB:	
03000		HRL	B,B
03100		ADDI	B,1
03200		SETZM	(CDB)
03300		BLT	B,TIOTLN-1(CDB)
03400	
03500	GOTCHN:	
03600		MOVEM 	A,JFNTBL(D)
03700		HRRZ	1,A			;JFN
03800		JSYS DVCHR			;CLOBBERS 1,2,3
03900		MOVEM	1,DVDSG(CDB)		;SAVE DESIGNATOR
04000		MOVEM	2,DVCH(CDB)		;AND CHARACTERISTICS
04100		HLRZ	1,2
04200		ANDI	1,777			;GET DEVICE TYPE
04300		MOVEM	1,DVTYP(CDB)		;AND SAVE IT
04400		CAIE	1,12			;IS IT A TTY?
04500		  JRST	NOTTTY			;NOPE
04600	;CHECK THAT IT IS DEVICE "TTY" (IN WHICH CASE IT IS THE CONTROLLING TERM)
04700		HRRZ	2,JFNTBL(D)		;GET JFN
04800		TRNE	2,400000		;A TERMINAL SPECIFIER FROM SETCHAN?
04900		  JRST	NOTTTY			;YES, NOT DEVICE "TTY"
05000		PUSH	P,3			;SOME SPACE
05100		PUSH	P,4
05200		PUSH	P,5
05300		PUSH	P,6
05400		HRROI	1,4
05500		MOVSI	3,200000		;DEVICE FIELD ONLY
05600		SETZ	4,
05700		JSYS	JFNS
05800		MOVEM	4,2			;SAVE IN 2
05900		POP	P,6			;RESTORE ACS
06000		POP	P,5
06100		POP	P,4
06200		POP	P,3
06300		CAME	2,[ASCIZ/TTY/]		;DEVICE TTY?
06400		  JRST	NOTTTY			;NOT THE CONTROLLING TERMINAL
06500		MOVE	2,[ISCTRM+TENXED]	;DEFAULT -- TENEX STYLE
06600		MOVEM	2,TTYINF(CDB)
06700	
06800	NOTTTY:	MOVEI	2,STARTPAGE(D)		;PAGE FOR BUFFER
06900		HRLI	2,400000		;THIS FORK
07000		MOVEM	2,FKPAGE(CDB)		;XWD FORK,PAGE FOR PMAPPING
07100		LSH	2,9			;MAKE AN ADDRESS
07200		MOVEM	2,IOADDR(CDB)		;AND SAVE IT AS WELL
07300		SETOM	IOPAGE(CDB)		;DENY THAT THERE IS A PAGE THERE
07400		HRRZ	A,D			;CHANNEL INTO A
07500		POP	P,D			;RESTORE
07600		POP	P,C			
07700		POP	P,B
07800		POPJ	P,
07900	
08000	
08100	;FIND AN OPEN CHANNEL AND RETURN THE NUMBER IN D
08200	;A HAS THE JFN NO. IN IT, SO CHECK TO SEE IF THE SAME
08300	;B MAY BE CLOBBERED
08400	FNDCHN:	HRRZ	D,JFNTBL(A)		;CHECK OLD JFN
08500		CAIE	D,(A)			;SAME AS THE NEW?
08600		  JRST  FNDCH2			;NO
08700		MOVE	CDB,CDBTBL(D)		;GET OLD CDB
08800		MOVE	B,CDB			;COPY CDB ADDR FOR BLT
08900		JRST	CLCDB			
09000	
09100	FNDCH2:	SETZ	D,
09200	FNDCH1:	CAIL	D,JFNSIZE
09300		   ERR <SETCHN:  JFN TABLE IS FULL (SHOULD NEVER HAPPEN)>
09400		SKIPE	CDBTBL(D)		;IS IT EMPTY?
09500		  AOJA	D,FNDCH1	   	;NO LOOK SOME MORE
09600		JRST	GTCDB			;YES, USE IT
09700	
09800	
09900	DSCR SIMPLE INTEGER PROCEDURE ZSETST(INTEGER I);
10000	
10100		Internal book-keeping routine not intended for
10200	use from SAIL.  Causes liberation from SAIL.
10300	
10400		THE ARGUMENT IS THE MAXIMUM SIZE OF THE EXPECTED STRING.
10500	THE RETURN IS THE BYTEPOINTER POINTING INTO THE TOP OF STRING SPACE
10600	
10700	
10800	HERE(ZSETST)
10900		MOVE USER,GOGTAB 		; GET USER
11000		SKIPE	SGLIGN(USER)
11100		  PUSHJ	P,INSET			;ASSUMING THAT IT IS TRANSPARENT FOR THE ACS
11200		MOVE	1,-1(P)		;GET EXPECTED LENGTH
11300		ADDM 1,REMCHR(USER) 		; ADD ON
11400		SKIPLE REMCHR(USER) 		; NEED TO COLLECT?
11500		  PUSHJ P,GOCOLLECT 		; YES
11600		MOVE 1,TOPBYTE(USER) 		; RETURN BP
11700		SUB P,X22 			; ADJUST STACK
11800		JRST @2(P) 			; RETURN
11900	
12000	GOCOLLECT:	
12100		MOVEM	RF,RACS+RF(USER)	;SAVE RF
12200		PUSHJ P,STRNGC ;
12300		POPJ P, 			; RETURN TO ABOVE
12400	
     
00100	DSCR STRING SIMPLE PROCEDURE ZADJST(INTEGER CNTEST,BP)
00200		Internal book-keeping routine.
00300		ADJUSTS THE PARAMETERS ASSOCIATED WITH STRING SPACE.
00400	BP IS OUR NEW TOPBYTE.  CNTEST IS THE COUNT ESTIMATE WE
00500	ORIGINALLY MADE.
00600		FIRST, WE MUST MAKE REMCHR HONEST, THEN WE
00700		CAN FIX TOPSTR AND THE USER'S LENGTH WORD.
00800	
00900	HERE(ZADJST)
01000		BEGIN ZADJST
01100	
01200	
01300		MOVE USER,GOGTAB;	
01400		PUSH	P,1
01500		PUSH	P,2
01600		PUSH	P,3
01700		PUSH	P,4
01800	
01900	DEFINE CNTARG <-6(P)>
02000	DEFINE BPARG <-5(P)>
02100	
02200		MOVE	2,BPARG			;UPDATED BP
02300		MOVE 	1,TOPBYTE(USER) 	; GET OLD TOPBYTE
02400		CAMN 	1,2 			; THE NULL STRING?
02500		  JRST NULRET;			;YES
02600	;P. KANERVA'S BYTE ROUTINE
02700		LDB	3,[POINT 6,1,5]		;BITS TO THE RIGHT OF BYTE 1
02800		LDB	4,[POINT 6,2,5]		;BITS TO THE RIGHT OF BYTE 2
02900		SUBI	3,(4)			;BIT DIFFERENCE
03000		IDIVI	3,7			;WITHIN-WORD BYTE DIFFERENCE
03100		
03200		SUBI	2,(1)			;WORDS BETWEEN BYTES
03300		HRRE	2,2			;FULL WORD DIFFERENCE
03400		IMULI	2,5			;CONVERT IT TO BYTE DIFFERENCE
03500		ADD	2,3			;ADD COUNT DERIVED FROM WITHIN-WORD
03600						;DIFFERENCE
03700	
03800		CAMLE	2,CNTARG		;WITHIN RANGE?
03900		  ERR <ZADJST:  TENEX WROTE TOO LONG A STRING, MAY BE FATAL>,1
04000	GOTLNG:	HRRO	1,2			; XWD -1,COUNT
04100		PUSH 	SP,1 			; XWD -1,COUNT
04200	       	PUSH 	SP,TOPBYTE(USER) 	; OLD TOPBYTE FOR BP FOR STRING
04300		JUMPE	2,NOLNG
04400		MOVE	1,BPARG
04500		MOVEM	1,TOPBYTE(USER)
04600	NOLNG:
04700		SUB 	2,CNTARG		; SUBTRACT THE COUNT ESTIMATE
04800		ADDM 	2,REMCHR(USER) 		; MAKE REMCHR HONEST
04900		POP	P,4
05000		POP	P,3			
05100		POP	P,2
05200		POP	P,1
05300		SUB 	P,X33 			; ADJUST STACK
05400		JRST @3(P) ;
05500	
05600	NULRET:	SETZ 2,;
05700		JRST GOTLNG 			; BE SURE TO FIX UP ALL THE GOODIES
05800		
05900		BEND ZADJST
06000	
     
00100	DSCR
00200		.RESET
00300	SID	SAVES ALL ACS
00400	CAL	JSP P,.RESET  from SAILOR
00500	
00600		RESETS TENEX IO AND BOOKKEEPING, AND SETS THE TTY MODE TO WAKEUP
00700	ON EVERY CHARACTER.  TTY WAKEUP IS NOT DONE IF THE JOB IS DETACHED.
00800	THIS SHOULD ONLY BE CALLED FROM SAILOR.
00900	
01000	HERE(.RESET)
01100	BEGIN RESET
01200	;ZERO OUT BOOKKEEPING
01300		SETZM	JFNTBL
01400		MOVE	1,[XWD JFNTBL,JFNTBL+1]
01500		BLT	1,JFNTBL+JFNSIZE-1
01600		SETZM	CDBTBL
01700		MOVE	1,[XWD CDBTBL,CDBTBL+1]
01800		BLT	1,CDBTBL+JFNSIZE-1
01900	
02000	;RELEASE PAGES ASSOCIATED WITH FILES (FROM STARTPAGE TO STARTPAGE+JFNSIZE-1)
02100		SKIPE	$OSTYP			;[04] TOPS20?
02200		 JRST	.RESE3			;[04] Yes, use faster code
02300	
02400		;TENEX version uses a loop
02500		SETO	1,			;RELEASE PAGE
02600		SETZ	3,			;FLAGS WORD
02700		MOVE	2,[XWD 400000,STARTPAGE]
02800	.RESE1:	CAMN	2,[XWD 400000,STARTPAGE+JFNSIZE]	;THIS WOULD BE TOO MANY PAGES
02900		  JRST .RESE2
03000		JSYS	PMAP			
03100		AOJA	2,.RESE1		;NEXT?
03200	
03300		;TOPS20 version:  [RNG: July 16, 1980, Use single PMAP call]
03400	.RESE3:	SETO	1,			;[04] Release page
03500		MOVE	2,[XWD 400000,STARTPAGE];[04] Start of I/O buffers
03600		HRRI	3,JFNSIZE		;[04] Repeat count
03650		HRLI	3,400000		;[04] say it's there!
03700		JSYS	PMAP			;[04]
03800	
03900	.RESE2:
04000		JSYS RESET		;CLEAR ALL IO
04100	
04200	;SET UP PSI SYSTEM
04300		HRRZI	1,400000	;USE EXISTING TABLE IF THERE
04400	;;	JSYS	RIR
04500	;;	JUMPN	2,.+3		;ALREADY THERE
04600		MOVE	2,[XWD LEVTAB,CHNTAB]
04700		JSYS	SIR
04800		JSYS	EIR		;TURN ON INTERRUPTS
04900	
05000	;CHECK AND SEE IF WE ARE DETACHED
05100		JSYS	GJINF
05200		CAMN	4,[-1]		;-1 FOR DETACHED JOBS
05300		  JRST	DTCHED		;YES IT IS DETACHED
05400	
05500	;SET PRIMARY INPUT TO WAKE UP ON EVERY CHARACTER
05600	;THE USER MAY RESET THIS.
05700		MOVEI	1,100		;PRIMARY INPUT
05800		JSYS RFMOD
05900		TRO	2,170000	;WAKEUP ON ALL CHARS
06000		JSYS SFMOD
06100	DTCHED:	SETZM	CTLOSW		;CLEAR OUTPUT-SUPPRESSION SWITCH
06200	
06300		JRST	(P)		;AND RETURN
06400	BEND RESET
06500	
06600	;ROUTINE TO CHECK IF A JFN HAS BEEN CLOSED BY ONE OF
06700	;THE DEC-STYLE CLOSE ROUTINES (IN WHICH CASE IT
06800	;MUST BE AVAILABLE FOR RE-OPENING)
06900	;ARGS:
07000	;	1	JFN
07100	;	CDB	THE CHANNEL DATA BLOCK
07200	^OPNCHK:
07300		SKIPL	IOSTT(CDB)		;CLOSED BY DEC?
07400		   POPJ P,			;NO
07500		PUSH	P,2			;SAVE 2
07600		MOVE	2,OFL(CDB)		;PREVIOUSLY USED FLAGS
07700		JSYS	OPENF			;OPEN
07800		   ERR <OPNCHK:  Cannot OPENF file>,1
07900		SETZM	IOSTT(CDB)
08000		POP	P,2			;RESTORE 2
08100		POPJ	P,			;RETURN
08200	
08300	HERE(RDSEG)
08400		PUSHJ	P,SAVE			;
08500		MOVE	LPSA,X33		;FOR RESTR BELOW
08600		HRRZ	A,SEGPAGE*1000 + 12	;ADDRESS OF LAST WORD OF SEGMENT IS HERE
08700		LSH	A,-=9			;MAKE IT A PAGE NUMBER
08800		HRLI	A,SEGPAGE		;FIRST PAGE OF SEGMENT
08900		MOVEM	A,@-2(P)		;STORE
09000		HRLI	A,STARTPAGE		;FIRST WORD OF BUFFER REGION
09100		HRRI	A,STARTPAGE+JFNSIZE-1	;LAST PAGE OF BUFFER REGION
09200		MOVEM	A,@-1(P)		;STORE
09300		JRST	RESTR			;AND RETURN
09400	
09500	ENDCOM(UTILITY)
     
00100	COMPIL(TTM,<RFMOD,SFMOD,STPAR,STI,RFCOC,SFCOC,GTTYP,STTYP,SETEDIT>
00200		,<SAVE,RESTR,X22,X33,X44>
00300		,<TTM -- TERMINAL MODE ROUTINES>)
00400	
00500	DSCR INTEGER PROCEDURE RFMOD(INTEGER CHAN)
00600	
00700		Reads a file's mode word.
00800	
00900	     PROCEDURE SFMOD(INTEGER CHAN,AC2)
01000	
01100		Sets a file's mode word to argument AC2.
01200	
01300	     PROCEDURE STPAR(INTEGER CHAN,BITS)
01400	
01500		Executes the STPAR jsys on CHAN with arguments BITS
01600	
01700	     PROCEDURE STI(INTEGER CHAN,CHAR)
01800	
01900		Executes the STI jsys on CHAN with character CHAR.
02000	
02100	     PROCEDURE RFCOC(INTEGER CHAN; REFERENCE INTEGER AC2,AC3)
02200	
02300		Does RFCOC jsys, returning values in AC2 and AC3.
02400	
02500	     PROCEDURE SFCOC(INTEGER CHAN,AC2,AC3)
02600	
02700		Does SFCOC jsys, setting to AC2 and AC3.
02800	
02900	     INTEGER PROCEDURE GTTYP(INTEGER CHAN; REFERENCE INTEGER BUFS)
03000	
03100		Does GTTYP jsys on CHAN/TTY and returns the
03200		typ information as the value of the call.  BUFS is the
03300		result from AC 3.
03400	
03500	     PROCEDURE STTYP(INTEGER CHAN,NEWTYPE)
03600	
03700		Sets the terminal type of CHAN to NEWTYPE
03800	
03900	
04000	
04100	HERE(RFMOD)
04200		PUSHJ	P,SAVE
04300		MOVE	LPSA,X22
04400		VALCH1	1,-1(P),RFMO1
04500	RFMO2:	JSYS	RFMOD
04600		MOVEM	2,RACS+A(USER)
04700		JRST	RESTR
04800	RFMO1:	MOVE	1,-1(P)		;USE LITERALLY
04900		JRST	RFMO2
05000	
05100	
05200	
05300	HERE(SFMOD)
05400		PUSHJ	P,SAVE
05500		MOVE	LPSA,X33
05600		VALCH1	1,-2(P),SFMO1
05700	SFMO2:	MOVE	2,-1(P)
05800		JSYS SFMOD
05900		JRST	RESTR
06000	SFMO1:	MOVE	1,-2(P)
06100		JRST	SFMO2
06200	
06300	HERE(STPAR)
06400		PUSHJ	P,SAVE
06500		MOVE	LPSA,X33
06600		VALCH1	1,-2(P),STPAR1
06700	STPAR2:	MOVE	2,-1(P)		;PARAMETERS TO SET
06800		JSYS	STPAR		;EXECUTE JSYS
06900		JRST	RESTR
07000	STPAR1:	MOVE	1,-2(P)		;USE LITERALLY
07100		JRST	STPAR2
07200	
07300	HERE(STI)
07400		PUSHJ	P,SAVE
07500		MOVE	LPSA,X33
07600		VALCH1	1,-2(P),STI1
07700	STI2:	MOVE	2,-1(P)
07800		JSYS	STI
07900		JRST	RESTR
08000	STI1:	MOVE	1,-2(P)		;USE LITERALLY
08100		JRST	STI2
08200		
08300	
08400	HERE(RFCOC)
08500		PUSHJ	P,SAVE
08600		MOVE	LPSA,X44
08700		VALCH1	1,-3(P),RFCO1
08800	RFCO2:	JSYS	RFCOC
08900		MOVEM	2,@-2(P)
09000		MOVEM	3,@-1(P)
09100		JRST	RESTR
09200	RFCO1:	MOVE	1,-3(P)		;USE LITERALLY
09300		JRST 	RFCO2
09400	
09500	HERE(SFCOC)
09600		PUSHJ	P,SAVE
09700		MOVE	LPSA,X44
09800		VALCH1	1,-3(P),SFCO1
09900	SFCO2:	MOVE	2,-2(P)
10000		MOVE	3,-1(P)	
10100		JSYS	SFCOC
10200		JRST	RESTR
10300	SFCO1:	MOVE	1,-3(P)		;USE LITERALLY
10400		JRST	SFCO2
10500	
10600	HERE(GTTYP)
10700		PUSHJ	P,SAVE
10800		MOVE	LPSA,X33
10900		VALCH1	1,-2(P),GTTYP1
11000	GTTYP2:	JSYS	GTTYP
11100		MOVEM	2,RACS+A(USER)	;TERMINAL TYPE NUMBER FOR RETURN
11200		MOVEM	3,@-1(P)	;XWD INBUFS, OUTBUFS
11300		JRST	RESTR
11400	GTTYP1:	MOVE	1,-2(P)		;USE LITERALLY
11500		JRST	GTTYP2
11600	
11700	HERE(STTYP)
11800		PUSHJ	P,SAVE
11900		MOVE	LPSA,X33
12000		VALCH1	1,-2(P),STTYP1
12100	STTYP2:	MOVE	2,-1(P)		;NEW TERMINAL TYPE
12200		JSYS	STTYP
12300		JRST	RESTR
12400	STTYP1:	MOVE	1,-2(P)		;USE LITERALLY
12500		JRST	STTYP2
12600	
12700	HERE(SETEDIT)
12800		PUSHJ	P,SAVE
12900		MOVE	LPSA,X33
13000		VALCHN	1,-2(P),SETTT1
13100		SKIPL	2,TTYINF(CDB)	;IS IT THE CONTROLLING TERMINAL?
13200		  JRST	SETTT2		;NO RETURN(0);
13300		HRRZ	2,2		;OLD VALUE
13400		MOVE	2,["B"
13500			   "D"
13600			   "T"](2)
13700		HRRZM	2,RACS+A(USER)	;RETURN OLD VALUE
13800		MOVE	2,-1(P)		;NEW VALUE
13900		CAIL	2,"a"
14000		CAILE	2,"z"
14100		  JRST 	.+2
14200		 SUBI	2," "		;UPPER CASE
14300		CAIN	2,"B"
14400		  JRST	[MOVEI 2,TNXINP
14500			 JRST  SETTT3]
14600		CAIN	2,"D"
14700		  JRST	[MOVEI 2,DECLED
14800			 JRST	SETTT3]
14900		CAIN	2,"T"
15000		  JRST	[MOVEI 2,TENXED
15100			 JRST	SETTT3]
15200		  ERR	<SETEDIT:  Buffering mode must be "B", "D" or "T">,1
15300		MOVEI	2,TENXED	;ASSUME THIS FOR USER
15400	SETTT3:	HRRM	2,TTYINF(CDB)
15500		JRST	RESTR		;AND RETURN
15600	
15700	SETTT1:	ERR <SETEDIT:  Channel argument must be a SAIL channel>,1
15800		JRST	RESTR
15900	
16000	SETTT2:	SETZM	RACS+A(USER)
16100		JRST	RESTR
16200	
16300	ENDCOM(TTM)
16400	
     
00100	COMPIL(PAGES,<PMAP>,<SAVE,RESTR,X44>
00200		,<PAGES -- PAGE MANAGEMENT>)
00300	DSCR SIMPLE PROCEDURE PMAP(INTEGER AC1,AC2,AC3);
00400	DESR
00500		Does the PMAP jsys, with these parameters:
00600	
00700	ARGUMENTS:	
00800		AC1		contents of AC1
00900		AC2		  "	 of AC2
01000		AC3		  "	 of AC3
01100	
01200	
01300	HERE(PMAP)
01400		PUSHJ	P,SAVE
01500		MOVE	LPSA,X44
01600		MOVE	1,-3(P)			;FILEPAGE
01700		MOVE	2,-2(P)			;XWD FORK,PAGE
01800		MOVE 	3,-1(P)			;ACCESS BITS
01900		JSYS PMAP
02000		JRST	RESTR
02100	ENDCOM(PAGES)
     
00100	COMPIL(TT2,<PBTIN,INTTY>
00200		,<X22,.SKIP.,ZSETST,ZADJST,CTLOSW,$OSTYP>
00300		,<TT2 -- IMSSS TTY ROUTINES>)
00400	
00500	DSCR INTEGER SIMPLE PROCEDURE PBTIN(INTEGER SECONDS);
00600	DESR 
00700		Executes the PBTIN jsys, with timing of SECONDS.
00800	
00900	HERE(PBTIN)
01000	NOIMSSS<
01100		ERR	<PBTIN:  Only defined at IMSSS>
01200	>;NOIMSSS
01300		SETZM	CTLOSW			;PROGRAM REQUESTS INPUT
01400		MOVE	1,-1(P)			;TIME IN SECONDS
01500		JSYS PBTIN
01600		SUB	P,X22
01700		JRST	@2(P)
01800	
     
00100	DSCR STRING SIMPLE PROCEDURE INTTY;
00200		Using the PSTIN jsys, accepts as many as 200 characters from
00300	the user's Teletype, with the standard system breakcharacters.  The
00400	breakcharacter itself is removed from the string, and
00500	no timing is available.
00600	
00700	IMSSS<
00800	HERE(INTTY)
00900		PUSH	P,1
01000		PUSH	P,2
01100		PUSH	P,3
01200		SETZB	3,CTLOSW		;PROGRAM REQUESTS INPUT
01300		MOVEI	2,=200			;DEFAULT LENGTH
01400	INTT2:	PUSH	P,2			;LENGTH
01500		PUSHJ	P,ZSETST		;GET BP IN 1
01600		JSYS PSTIN
01700		CAIL	2,=200			;DID WE GET 200 CHARS?
01800		   JRST	[SETOM	.SKIP.
01900			 JRST	INTT1]
02000		LDB	3,1			;GET THE LAST CHAR
02100		MOVEM	3,.SKIP.		;AND SAVE IT
02200		SOJ	1,			;BACK UP BYTE-POINTER (OVER LAST CHAR)
02300		IBP	1
02400		IBP	1
02500		IBP	1
02600		IBP	1
02700	INTT1:	PUSH	P,[=200]
02800		PUSH	P,1
02900		PUSHJ	P,ZADJST		;GET STRING ON STACK
03000		POP	P,3	
03100		POP	P,2
03200		POP	P,1
03300		POPJ	P,			;RETURN
03400	>;IMSSS
03500	
03600	
     
00100	NOIMSSS<;NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
00200	;UNDER BBN'S LACK OF A SYSTEM LINE EDITOR
00300	
00400	DSCR INTTY
00500		Simulation of the above routine, doing something
00600	that looks like "TENEX" line editing.
00700	;
00800	HERE(INTTY)
00900		BEGIN INTTY
01000	ORIGCNT__=200
01100	;AC USES  A,B,C  JSYS TEMPORARIES
01200	;	  D	 BYTEPOINTER
01300	;	  E	 COUNT, INITIALLY 0
01400	;	  Q1 (=6) ORIGINAL BP
01500	
01600	
01700		PUSHJ	P,SAVE
01800		SETZM	CTLOSW
01900	;GACK--TEST FOR TOPS20 OR TENEX.  THIS CODE SHOULD BE REMOVED
02000	;SOMEDAY, WHEN TENEX GOES AWAY, OR WHEN A CONDITIONAL
02100	;COMPILATION SWITCH IS PUT IN FOR TOPS20
02200		SKIPN	$OSTYP			;[CLH] TEST FOR TENEX
02300		  JRST	ISTENEX			;IT IS TENEX
02400	IST20:	
02500		PUSH	P,[ORIGCNT]
02600		PUSHJ	P,ZSETST		;GET A BP IN A
02700		HRLI	B,(1B1)			;[clh] BREAK ON CHARS
02800		HRRI	B,ORIGCNT		;COUNT IN RH(B)
02900		SETZ	C,
03000	OPDEF	RDTTY	[104000000523]
03100		RDTTY				;READ TTY INPUT
03200		 JRST	[ERR <RDTTY FAILED ON TOPS20?>,0]
03300		LDB	C,A			;GET THE LAST CHAR
03400	INTT2:	MOVEM	C,.SKIP.		;AND SAVE IT
03500		SOJ	A,			;BACK UP BYTE-POINTER (OVER LAST CHAR)
03600		IBP	A
03700		IBP	A
03800		IBP	A
03900		IBP	A
04000	;[clh] if last char is lf, see if cr preceeded it.  If so, use the cr as brk
04100		CAIE	C,12			;LF?
04200		JRST	INTT1			;NO, THEN WE HAVE THE RIGHT BREAK
04300		LDB	C,A			;GET NEXT TO LAST CHAR
04400		CAIN	C,15			;CR?
04500		JRST	INTT2			;YES, USE IT AS BREAK
04600	;[clh]^^
04700	INTT1:	PUSH	P,[=200]		;ADJUST STRING SPACE
04800		PUSH	P,A
04900		PUSHJ	P,ZADJST		;GET STRING ON STACK
05000		MOVE	LPSA,X11		
05100		JRST	RESTR			;AND RETURN
05200		
05300	ISTENEX:
05400		MOVEI	A,101
05500		JSYS	RFMOD
05600		PUSH	P,B			;SAVE THE TTY MODE
05700		TRO	B,170000		;WAKEUP ON EVERYTHING
05800		JSYS	SFMOD
05900		
06000		PUSH	P,[ORIGCNT]		;
06100		PUSHJ	P,ZSETST		;GET A GOOD BP IN A
06200		MOVE	Q1,A
06300	RESTRT:	MOVE	D,Q1			;GET THE ORIGINAL BP	
06400		SETZ	E,			;ZERO THE COUNT
06500	INLUP:	CAIL	E,ORIGCNT
06600		  JRST	CNTEXH			;COUNT EXHAUSTED
06700	INLU1:	JSYS	PBIN			;GET A CHAR
06800		CAIN	A,15			;CARRIAGE RETURN?
06900		  JRST	INLU1			;YES, IGNORE
07000		CAIN	A,37			;EOL?
07100		  MOVEI	A,12			;MAKE LINEFEED
07200		CAIN	A,12
07300		  JRST	DONE			;IS A BREAK CHARACTER
07400		CAIN	A,33			;ESCAPE?
07500		  JRST	DONE
07600		CAIE	A,32			;CTRL-Z
07700	 	CAIN	A,7			;CTRL-G
07800		  JRST	DONE
07900		CAIE	A,"R"-100		;CTRL-R FOR REPEAT
08000		  JRST	NOCTR	
08100		HRROI	A,[ASCIZ/
08200	/]
08300		JSYS	PSOUT
08400		JUMPE	E,INLUP
08500		MOVEI	A,101
08600		MOVE	B,Q1			;ORIG BP
08700		MOVN	C,E			;COUNT THUS FAR
08800		JSYS	SOUT
08900		JRST	INLUP			;AND CONTINUE
09000	NOCTR:	CAIE	A,"X"-100		;CONTROL-X FOR DELETE LINE
09100		  JRST	NOCTX
09200	DOCTX:	HRROI	A,[ASCIZ/
09300	/]
09400		JSYS	PSOUT
09500		JRST	RESTRT			;AND START ALL OVER
09600	NOCTX:	CAIE	A,177			;RUBOUT OR
09700		CAIN	A,"A"-100		;CONTROL-A
09800		  JRST	.+2
09900		 JRST	NOCTA
10000		JUMPLE	E,DOCTX			;IF NO CHARS THEN DO A CONTROL-X
10100		MOVEI	A,"\"
10200		JSYS	PBOUT
10300		LDB	A,D			;LAST CHAR
10400		JSYS	PBOUT	
10500		MOVE	A,D
10600		JSYS	BKJFN
10700		  JFCL
10800		MOVEM	A,D			;BACK UP BP
10900		SOJA	E,INLUP			;SUBTRACT 1 AND CONTINUE
11000	NOCTA:	IDPB	A,D
11100		AOJA	E,INLUP			;ONE MORE CHAR	
11200	
11300	CNTEXH:	SETO	A,			;INDICATE NO COUNT
11400	DONE:	MOVEM	A,.SKIP.		;BREAK CHAR, -1 FOR EXHAUSTED
11500		PUSH	P,[ORIGCNT]	
11600		PUSH	P,D			;NEW BP
11700		PUSHJ	P,ZADJST		;FIX UP STRING SPACE, PUT STRING ON STACK
11800		MOVEI	A,101
11900		POP	P,B			;MODE SETTING
12000		JSYS	SFMOD			;RESET
12100		MOVE	LPSA,X11
12200		JRST	RESTR			;AND RETURN
12300	
12400		BEND INTTY
12500	>;NOIMSSS
12600	
12700	ENDCOM(TT2)
     
00100	COMMENT  TTY FUNCTIONS 
00200	
00300	
00400	DSCR TTY FUNCTIONS
00500	CAL SAIL
00600	
00700	
00800	Comment 
00900	INTEGER PROCEDURE INCHRW;
01000	 RETURN A CHAR FROM PBIN
01100	
01200	INTEGER PROCEDURE INCHRS;
01300	 RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (SIBE FOLLOWED BY PBIN)
01400	
01500	STRING PROCEDURE INCHWL;
01600	 WAIT FOR A LINE, THEN RETURN IT (PBINs, LINE EDITING)
01700	
01800	STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
01900	 FLAG_-1, STR_NULL IF NO LINE, ELSE FLAG_0, 
02000		STR_LINE (SIBE, FOLLOWED BY PBINs)
02100	
02200	STRING PROCEDURE INSTR(INTEGER BRCHAR);
02300	 RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (PBINs)
02400	
02500	STRING PROCEDURE INSTRL(INTEGER BRCHAR);
02600	 WAIT FOR ONE LINE, THEN DO INSTR (PBINs WITH EDITING)
02700	
02800	STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
02900	 FLAG_-1, STR_NULL IF NO LINES, ELSE FLAG_0, 
03000	  STR_INSTR(BRCHAR)
03100	
03200	
03300	PROCEDURE OUTCHR(INTEGER CHAR);
03400	 OUTPUT CHAR (PBOUT)
03500	
03600	PROCEDURE OUTSTR(STRING STR);
03700	 OUTPUT STR (SOUT)
03800	
03900	
04000	PROCEDURE CLRBUF;
04100	 CLEARS INPUT BUFFER (CFIBF)
04200	
04300	TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
04400	 TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
04500	 ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
04600	 TTYINL DOES A WAIT FOR LINE FIRST.
04700	 FULL BREAKSET CAPABILITIES EXCEPT FOR 
04800	 "R" MODE (AND OF COURSE, LINE NUM. STUFF)
04900	
05000		TITLE	TTYUUO
05100	
05200	
05300	COMPIL(TTY,<PBIN,PBOUT,PSOUT,INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL,TTYUP,RSCAN
05400	>
05500		  ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,CATCHR,STRNGC,GOGTAB,BRKMSK,.SKIP.,CTLOSW>
05600		  ,<TELETYPE FUNCTIONS>)
05700	;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
05800	; .SKIP. EXTERNAL ABOVE
05900	;;#GF#
06000	 
     
00100	HERE(PBIN)
00200	HERE (INCHRW)
00300		SETZM	CTLOSW		;INPUT REQUESTED
00400	INCHR1:	JSYS PBIN
00500		POPJ	P,
00600	
00700	HERE (INCHRS)
00800		SETZM	CTLOSW		;INPUT REQUESTED
00900		MOVEI	1,100
01000		JSYS SIBE
01100		   JRST	INCHR1
01200		SETO	1,		;RETURN -1
01300		POPJ	P,
01400	
01500	HERE(PBOUT)
01600	HERE (OUTCHR)	
01700		SKIPE	CTLOSW		;DOING OUTPUT?
01800		  JRST	OUTCRE		;NO
01900		EXCH	1,-1(P)		;GET PARAMETER, SAVING AC 1
02000		JSYS PBOUT			;OUTPUT CHAR	
02100		EXCH	1,-1(P)		;GET BACK 1	
02200	OUTCRE:	SUB	P,X22
02300		JRST	@2(P)		;RETURN
02400	
02500	
02600	HERE(PSOUT)
02700	HERE (OUTSTR)
02800		SKIPE	CTLOSW		;DOING OUTPUT?
02900		  JRST	[SUB SP,X22
03000			 POPJ P,
03100			]
03200		EXCH	2,(SP)		;BP WORD
03300		EXCH	3,-1(SP)	;LENGTH WORD
03400		PUSH	P,1		;ALSO NEED 1
03500		HRRZ	3,3		;COUNT
03600		JUMPE	3,NULSTR	;DONT SEND EMPTY STR
03700		MOVEI	1,101		;TERMINAL OUTPUT
03800		MOVN	3,3
03900		JSYS SOUT
04000	NULSTR:	POP	P,1
04100		POP	SP,2
04200		POP	SP,3		;ADJUSTS STACK AUTOMATICALLY
04300		POPJ 	P,		;RETURN
04400	
04500	;REDSTR (0) MARKS CTLOSW THAT INPUT WAS REQUESTED
04600	;(1) PREPARES TO MAKE A STRING OF 200 CHARS, 
04700	;(2) ZEROS C FOR COUNT
04800	;(3) SETS UP D WITH THE ORIGINAL BYTE-POINTER
04900	
05000	REDSTR:	SETZM	CTLOSW		;INPUT REQUESTED
05100		SKIPE	SGLIGN(USER)
05200		PUSHJ	P,INSET
05300		MOVEI	A,=200
05400		ADDM	A,REMCHR(USER)
05500		SKIPLE	REMCHR(USER)
05600		PUSHJ	P,STRNGC
05700		SETZ	C,		;COUNT HERE
05800		MOVE	D,TOPBYTE(USER)	;ORIGINAL BYTE-POINTER, IF NEEDED
05900		PUSH	SP,[0]		;NULL STRING IF NOTHING DONE
06000		PUSH	SP,TOPBYTE(USER)
06100		POPJ	P,
06200	
06300	FINSTR:	MOVEI	A,=200
06400		SUB	A,C		;NUMBER USED
06500		ADDM	A,REMCHR(USER)
06600		HRROM	C,-1(SP)	;STRING COUNT WORD
06700		MOVEM	D,TOPBYTE(USER)	;NEW TOPBYTE
06800		JRST	RESTR
06900	
07000	;CALL TO HERE WITH A PUSHJ TO GET A CHAR IN AC1
07100	;AC 3 HAS THE COUNT, D THE BYTE-POINTER
07200	EDICHR:
07300		JSYS PBIN			;GET A CHARACTER
07400		CAIN	1,DELLINE	;DELETE LINE CHAR
07500		   JRST	CTRLU
07600		CAIN	1,RUBCHAR	;RUBOUT?
07700		   JRST	RUBOUT
07800		CAIN	1,37		;PHONEY TENEX EOL?
07900		   MOVEI 1,12
08000		CAIN	1,33		;PHONEY TENEX ALTMODE?
08100		  MOVEI 1,ALTMODE	;DEC ALTMODE
08200		POPJ	P,		;GOOD CHAR FOR USER
08300		
08400	CTRLU:	
08500	;AC 1 IS FREE
08600		HRROI	1,[BYTE (7) 7,15,12,0,0]
08700		JSYS PSOUT	
08800		JUMPE	C,EDICHR	;IF NO CHARS THEN DO NOTHING
08900		SETZ	C,
09000		MOVE	D,TOPBYTE(USER)
09100		JRST	EDICHR
09200	
09300	RUBOUT:	JUMPE	C,CTRLU		;IF NO CHARS THEN DO CTRLU
09400	;AC 1 IS AVAILABLE
09500	IMSSS<
09600		MOVEI	1,101		;PRIMARY OUTPUT
09700		JSYS	DELCH
09800		  JFCL
09900		  JRST	DLTED		;DISPLAY -- LINE EMPTY
10000		  JRST	DLTED		;DISPLAY -- DELETE DONE
10100	>;IMSSS
10200		MOVEI	1,"\"
10300		JSYS PBOUT
10400		LDB	1,D		;GET LAST CHAR
10500		JSYS PBOUT			;AND SEND IT
10600	DLTED:
10700		SOJ	D,		;BACK UP BP TO LAST CHAR
10800		IBP	D
10900		IBP	D
11000		IBP	D
11100		IBP	D
11200		SOJA	C,EDICHR	;AND GET ANOTHER CHAR
11300	
11400	HERE(INSTRL)
11500	HERE (INSTR) 
11600		PUSHJ	P,SAVE
11700		PUSHJ	P,REDSTR
11800		MOVE	B,-1(P)		;BREAK CHAR
11900		MOVE	LPSA,X22	;# TO REMOVE
12000	
12100	INS1:	CAIL	C,=200		;COUNT EXHAUSTED?
12200		 JRST	FINSTR		;YES
12300	INS2:	PUSHJ	P,EDICHR	;GET A CHAR IN 1, USING EDITING
12400		CAMN	1,B		;BREAK?
12500		 JRST	 FINSTR		; YES, ALL DONE
12600		IDPB	1,D		;PUT IT AWAY AND
12700		AOJA	C,INS1
12800	
12900	HERE (INCHWL)	PUSHJ	P,SAVE
13000		PUSHJ	P,REDSTR
13100		MOVE	LPSA,X11
13200	
13300	INS3:	CAIL	C,=200		;COUNT EXHAUSTED?
13400		  JRST	DNSTR1		;YES
13500		PUSHJ	P,EDICHR	;GET A CHAR
13600		CAIE	1,ALTMODE
13700		CAIN	1,12
13800		   JRST	DNSTR
13900		CAIN	1,15		;CR?	
14000		   JRST	INS3		;IGNORE
14100		IDPB	1,D		;PUT IT AWAY AND
14200		AOJA	C,INS3		;NEXT CHARACTER
14300	
14400	DNSTR:	MOVEM	1,.SKIP.	;SET BREAK CHAR
14500		JRST	FINSTR
14600	DNSTR1:	SETOM	.SKIP.		;INDICATE COUNT EXHAUSTED
14700		JRST	FINSTR
14800	
14900	
15000	HERE (INCHSL)	PUSHJ	P,SAVE
15100		MOVE	LPSA,X22	;PARAM (FLAG) AND RETURN
15200		PUSHJ	P,REDSTR
15300		SETOM	@-1(P)		;ASSUME FAILED
15400		MOVEI	1,100		;PRIMARY INPUT
15500		JSYS SIBE			;CHARACTERS WAITING?
15600		    SKIPA		;YES
15700		JRST	FINSTR		;NO, FIX UP AND RETURN
15800		SETZM	@-1(P)
15900		JRST	INS3		;AND USE INCHWL'S LOOP
16000	
16100		
16200	HERE(INSTRS)
16300		PUSHJ	P,SAVE
16400		MOVE	LPSA,X33
16500		PUSHJ	P,REDSTR
16600		SETOM	@-2(P)		;ASSUME FAILED
16700		MOVEI	1,100		;RIMARY INPUT
16800		JSYS SIBE			;CHARACTERS WAITING
16900		   SKIPA		;YES
17000		JRST	FINSTR		;NO, FIX UP AND RETURN	
17100		SETZM	@-2(P)		;INDICATE SUCCESS
17200		MOVE	B,-1(P)		;GET BREAK CHARACTER	
17300		JRST	INS2
17400	
17500	HERE (CLRBUF)
17600		PUSH	P,1
17700		MOVEI	1,100		;PRIMARY INPUT
17800		JSYS CFIBF			;CLEAR BUFFER
17900		POP	P,1
18000		POPJ	P,
18100	
18200	HERE (TTYINS) PUSHJ	P,SAVE
18300		PUSHJ	P,REDSTR	;PREPARE TO MAKE A STRING
18400		MOVE	LPSA,X33
18500		SETOM	@-1(P)		;ASSUME NO CHARS
18600		MOVEI	1,100		;PRIMARY INPUT
18700		JSYS SIBE			;CHARS WAITING?
18800		   SKIPA		;YES
18900		JRST	FINSTR		;NONE WAITING
19000		JRST	TYIN1		;GO AHEAD
19100	
19200	
19300	HERE(TTYINL)
19400	HERE (TTYIN)	PUSHJ	P,SAVE
19500	TYIN:	PUSHJ	P,REDSTR		;PREPARE STACK,A,STRNGC FOR A STRING
19600		MOVE	LPSA,X33		;PREPARE TO RETURN
19700	TYIN1:	SETZM	@-1(P)		;ASSUME NO BREAK CHAR
19800		MOVE	X,-2(P)		;TABLE #
19900		MOVEI	TEMP,-1		;BLOCK MUST BE THERE AND TABLE MUST BE INIT'ED
20000		PUSHJ	P,BKTCHK		;CHECK TABLE #
20100		 JRST	FINSTR		;ERROR
20200		MOVE	FF,BRKMSK(CHNL)	;BITS FOR THIS TABLE
20300		ADD	CHNL,CDB	;RELOCATE RANGE 1 TO 18
20400		MOVEI	Z,1		;FOR TESTING LINE NUMBERS
20500		SKIPN	LINTBL(CHNL)	;DON'T LET TEST SUCCEED IF
20600		 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
20700		MOVE	Y,CDB
20800		ADD	Y,[XWD 1,BRKTBL] ;BRKTBL+RLC(CDB)
20900	TTYN:	CAIL	C,=200		;COUNT EXCEEDED?
21000		   JRST	FINSTR		;YES
21100		PUSHJ	P,EDICHR	;GET A CHAR
21200	TTYN1:	TDNE	FF,@Y		;BREAK OR OMIT?
21300		JRST	TTYSPC		; YES, FIND OUT WHICH
21400	TTYC:	IDPB	1,D		;PUT IT AWAY
21500		AOJA	C,TTYN		;COUNT AND CONTINUE
21600		JRST	FINSTR		;DONE
21700	TTYSPC:	HLLZ	TEMP,@Y		;WHICH?
21800		TDNN	TEMP,FF
21900		JRST	TTYN		;OMIT
22000		MOVEM	1,@-1(P)
22100		SKIPN	Y,DSPTBL(CHNL)	;WHAT TO DO WITH IT
22200		JRST	FINSTR		;DONE, NO SAVE
22300		JUMPL	Y,TTYAPP	;APPEND
22400		PUSH	P,1		;SAVE 
22500		MOVEI	1,100		;PRIMARY INPUT
22600		JSYS BKJFN
22700		  ERR	<CAN'T RETAIN BREAK CHAR FROM TTYIN>,1
22800		POP	P,1
22900		JRST	FINSTR		;AND RETURN
23000	TTYAPP:	IDPB	1,D		;COUNT THE BREAK CHAR
23100		ADDI	C,1		;ONE MORE HAPPY CHAR
23200		JRST	FINSTR
23300	
23400	
23500	DSCR INTEGER PROCEDURE TTYUP(INTEGER NEWVALUE)
23600	
23700		Using the RFMOD and SFMOD jsyses, sets lower-to-upper
23800	case conversion to NEWVALUE, returning the oldvalue.  Tests
23900	and modifies bit 31 of the RFMOD word for the primary input
24000	file.	
24100	;
24200	HERE(TTYUP)
24300		PUSHJ	P,SAVE
24400		MOVE	LPSA,X22		;SET FOR RETURN
24500		MOVEI	A,101			;PRIMARY INPUT FILE
24600		JSYS	RFMOD			;GET THE CURRENT SETTINGS
24700		SETZ	C,			;ASSUME NOT CURRENTLY SET
24800		TRNE	B,1B31			;IS IT SET?
24900		  SETO	C,			;IT WAS
25000		MOVEM	C,RACS+A(USER)	
25100		MOVE	C,[TRO B,1B31]		;ASSUME WE WANT TO SET UP
25200		SKIPN	-1(P)			;DID WE REALLY?
25300		  MOVE	C,[TRZ B,1B31]		;NO, DONT
25400		XCT	C
25500		JSYS	STPAR
25600		JRST	RESTR			;AND RETURN
25700	
25800	;[clh/daw]
25900	DSCR BOOLEAN SIMPLE PROCEDURE RSCAN(INTEGER FUNCTION; STRING STR);
26000		Depending upon function, the string may be put into the rescan
26100			buffer.
26200	
26300	
26400	HEREFK(RSCAN,$RSCAN)
26500	
26600		push	p,b
26700		skipn	-1(sp)		;if string not null
26800		jrst	rscan1
26900		push	p,[0]		;make it ASCIZ
27000		pushj	p,catchr
27100	rscan1:	move	a,-2(p)		;get function code
27200		skipe	-1(sp)		;but if string not null
27300		move	a,(sp)		; use string pointer
27400		jsys	rscan
27500		 ercal	rscan2
27600		pop	p,b		;restore ac's
27700		sub	sp,x22		;clean up
27800		sub	p,x22
27900		jrst	@2(p)
28000	
28100	rscan2:	movei	a,400000	;get most recent error
28200		jsys 	geter		;don't trust jsys, could go away
28300		hrrm	a,.skip.	;save it
28400		setz	a,		;return zero for error
28500		popj	p,
28600	
28700	;[clh/daw] ^^
28800	
28900	ENDCOM(TTY)
29000	COMPIL(PTY)
29100	ENDCOM(PTY)
29200	
29300	COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
     
00100	COMMENT Filnam 
00200	
00300	DSCR FILNAM
00400	CAL PUSHJ
00500	PAR file name string on SP stack
00600	 of form FILENAME<.EXT><[PROJ,PROG]>
00700	RES FNAME(USER) : SIXBIT /filename/
00800	 EXT(USER): SIXBIT /extension,,0/
00900	 0
01000	 PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
01100	SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
01200	
01300	
01400	^^FILNAM:
01500		SUB	SP,X22		;ADJUST STACK
01600		FOR II_1,3 <
01700		SETZM	FNAME+II(USER)>
01800		MOVEI	X,FNAME(USER)	;WHERE TO PUT IT
01900		PUSHJ	P,FLSCAN	;GET FILE NAME
02000		JUMPE	Y,FLDUN	;FILE NAME ONLY
02100		CAIE	Y,"."		;EXTENSION?
02200		JRST	FLEXT		;NO, CHECK PPN
02300		MOVEI	X,FNAME+1(USER)
02400		PUSHJ	P,FLSCAN
02500	FLEXT:	JUMPE	Y,FLDUN	;NO PPN SPECIFIED
02600		CAIE	Y,"["
02700		JRST	FLERR		;INVALID CHARACTER
02800		PUSHJ	P,[
02900	
03000		RJUST:	SETZM	PROJ(USER)
03100			MOVEI	X,PROJ(USER)
03200			PUSHJ	P,FLSCAN	;GET PROJ OR PROG IN SIXBIT
03300	IFN SIXSW,<
03400			MOVE	X,PROJ(USER)
03500			IMULI	D,-6		;SHIFT FACTOR
03600			LSH	X,(D)		;RIGHT-JUSTIFY THE PROJ OR PROG
03700	>;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
03800		
03900	IFE SIXSW,<
04000			MOVEI	X,0
04100	;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
04200			MOVE	D,PROJ(USER)	;WAS A HLLZ
04300	;;
04400		FBACK:	MOVEI	C,0
04500			LSHC	C,6		;GET A SIXBIT CHAR
04600			CAIL	C,'0'
04700			CAILE	C,'7'
04800			JRST	FLERR		;INVALID OCTAL
04900			LSH	X,3
05000			IORI	X,-'0'(C)
05100			JUMPN	D,FBACK
05200	>;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
05300		FPOP:	POPJ	P,]
05400	
05500		HRLZM	X,FNAME+3(USER)
05600		CAIE	Y,","
05700		JRST	FLERR		;INVALID CHAR
05800		PUSHJ	P,RJUST		;JUSTIFY(AND CONVERT IF EXPORT) PROG #
05900		HRRM	X,FNAME+3(USER)
06000		CAIN	Y,"]"
06100	FLDUN:	AOS	(P)		;SUCCESSFUL
06200	FLERR:	POPJ	P,		;DONE, NOT NECESSARILY RIGHT
06300	
06400	ENDCOM(FIL)
06500	COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
     
00100	COMMENT Flscan 
00200	
00300	DSCR FLSCAN
00400	CAL PUSHJ
00500	PAR X -- addr of destination SIXBIT
00600	 1(SP), 2(SP) -- input string
00700	RES sixbit for next filename, etc in word addressed by X
00800	 break (punctuation) char in Y (0 if string exhausted)
00900	 D,X, input string adjusted
01000	SID only those AC changes listed above (Y, for instance)
01100	
01200	
01300	^^FLSCAN:  
01400		HRRZS	1(SP)		;WANT ONLY LENGTH PART
01500		MOVEI	D,6		;MAX NUMBER PICKED UP
01600		SETZM	(X)		;ZERO DESTINATION
01700		HRLI	X,440600	;BYTE POINTER NOW
01800	FLN1:	MOVEI	Y,0		;ASSUME NO STRING LEFT
01900		SOSGE	1(SP)		;TEST 0-LENGTH STRING
02000		 POPJ	 P,
02100		ILDB	Y,2(SP)		;GET BYTE
02200		CAIE	Y,"."		;CHECK VALID BRE0	CAIE	Y,
02300		CAIN	Y,"["
02400		POPJ	P,
02500		CAIE	Y,"]"
02600		CAIN	Y,","
02700		POPJ	P,
02800		JUMPE	D,FLN1		;NEED NO MORE CHARS
02900		TRZN	Y,100		;MOVE 100 BIT TO 40 BIT
03000		TRZA	Y,40		; TO CONVERT TO SIXBIT
03100		TRO	Y,40		; (NO CHECKING)
03200		IDPB	Y,X		;PUT IT AWAY
03300		SOJA	D,FLN1		;CONTINUE
03400	
03500	ENDCOM(FLS)
     
00100	COMPIL(CAS,<CSERR,LPRYER>,<GOGTAB>
00200		  ,<CSERR, LPRYER -- SUPPORT ROUTINES>)
00300	HERE(CSERR)	MOVE	USER,GOGTAB
00400		POP	P,UUO1(USER)	;STANDARD PLACE
00500		ERR	<CASE INDEX OVERFLOW, VALUE IS >,13
00600		JRST	@UUO1(USER)	;RETURN OK
00700	
00800	HERE (LPRYER) ERR	<DATUM OF ARRAY NOT THERE>,1
00900		POPJ	P,
01000	
01100	ENDCOM(CAS)
01200	
01300	
01400	IFN ALWAYS, <BEND IOSER>
01500	DSCR BEND IOSER 
01600	>;TENX
     
     
00100	
00200	
00300	
00400	
00500	
00600	
00700	
     
00100	
00200	
00300	
00400	
00500	
00600	
00700	
     
00100	
     
00100