perm filename IOSER.TNX[10X,AIL]5 blob sn#145757 filedate 1975-02-17 generic text, type T, neo UTF8
     

     

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	
04000	;ADDITIONS TO CDB NUMBERS SHOULD INCLUDE CHANGE TO IOTLEN BELOW
04100	
04200	?IOTLEN←←25			;CURRENT LENGTH OF CDB BLOCK
04300	
     

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	
02800	;MACROS FOR BIT TESTING
02900	
03000	DEFINE .ZZZ $ (X,Y,Z)<
03100	IFN Z&777777000000, <TL$X Y,Z⊗-=18>	;Z LSH -=18
03200	IFN Z&777777, <TR$X Y,Z>
03300	>
03400	
03500	DEFINE TESTE (Y,Z) <.ZZZ NE,Y,Z>	;TDNE Y,[Z]
03600	DEFINE TESTN (Y,Z) <.ZZZ NN,Y,Z>	;TDNN Y,[Z]
03700	DEFINE TESTO (Y,Z) <.ZZZ O,Y,Z>		;TDO Y,[Z]
03800	DEFINE TESTZ (Y,W) <.ZZZ Z,Y,W>		;TDZ Y,[Z]
03900	
04000	
04100	;MACRO TO GET THE JFN NUMBER IN X FROM Y.  IF INVALID, JUMP TO LABEL Z
04200	;LOADS CDB (I.E., 11) WITH THE CDB ADDRESS
04300	;LOADS CHNL WITH THE CHANNEL NUMBER
04400	DEFINE VALCHN(X,Y,Z) <
04500	
04600		SKIPL	CHNL,Y
04700		CAIL	CHNL,JFNSIZE
04800		  JRST	Z	
04900		MOVE	CDB,CDBTBL(CHNL)
05000		HRRZ	X,JFNTBL(CHNL)
05100		JUMPE	X,Z
05200	>;VALCHN
05300		
05400	DEFINE LITCHN(X,Y,Z) <
05500		SKIPL	X,Y
05600		CAIL	X,JFNSIZE
05700		  JRST 	Z
05800		MOVEM	X,CHNL
05900		MOVE	CDB,CDBTBL(CHNL)
06000		HRRZ	X,JFNTBL(CHNL)
06100	>;LITCHN 
06200	
06300	;ONLY USES AC X
06400	DEFINE VALCH1(X,Y,Z) <
06500		SKIPL	X,Y
06600		CAIL	X,JFNSIZE
06700		   JRST	Z
06800		HRRZ	X,JFNTBL(X)
06900		JUMPE	X,Z
07000	>
07100	
07200	;TTY STUFF
07300	;CHAR FOR LINE DELETION (DELLINE) AND CHARACTER DELETION (RUBCHAR)
07400	IFNDEF DELLINE,<?DELLINE←←"U"-100>	;CTRL-U	
07500	IFNDEF RUBCHAR,<?RUBCHAR←←177>		;RUBOUT
07600	?ALTMODE←←175			;ONE OF MANY VERSIONS OF ALTMODE
07700	
07800	
     

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		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,IOTLEN
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,IOTLEN-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		JRST	GUDRET			;AND RETURN
08600	
08700	;MOUNT AND OPEN DECTAPE IN DUMP MODE
08800	DOMNT:	MOVE	A,DVDSG(CDB)		;GET DEVICE DESIGNATOR
08900		TLO	A,(1B3)			;DONT READ DIRECTORY FOR DUMP MODE
09000		JSYS MOUNT
09100		   JRST	BADOPN			;CANNOT MOUNT
09200		MOVSI	GTFLAGS,100001
09300		MOVE	1,GTFLAGS
09400		MOVE	2,(SP)
09500		JSYS GTJFN
09600		   JRST	BADOPN
09700		MOVEM	1,JFNTBL(CHNL)
09800		MOVEM	GTFLAGS,GFL(CDB)
09900		MOVE	OPFLAGS,[447400000000!RDBIT!WRBIT]
10000		MOVE	2,OPFLAGS
10100		JSYS OPENF
10200		   JRST	CNTOPN
10300		JRST	OPOK
10400	
10500	GTNOW:	
10600		MOVSI	GTFLAGS,100001
10700		MOVE	1,GTFLAGS
10800		MOVE	2,(SP)			;DEVICE STRING
10900		JSYS GTJFN	
11000		   JRST	BADOPN			;NOPE CANNOT GET
11100		MOVEM	1,JFNTBL(CHNL)		;SAVE JFN
11200		MOVEM	GTFLAGS,GFL(CDB)	;AND SAVE THEM
11300	;COMPUTE OPENF FLAGS
11400		SETZ	OPFLAGS,
11500		MOVE	2,DVCH(CDB)		;DEVICE CHARACTERISTICS
11600		TESTE	2,<1B1>			;CAN DO INPUT?
11700		   TESTO  OPFLAGS,RDBIT
11800		TESTE	2,<1B0>			;CAN DO OUTPUT?
11900		   TESTO  OPFLAGS,WRBIT
12000		MOVE	1,DVTYP(CDB)		;CHECK DEVICE TYPE
12100		CAIN	1,12			;IS IT A TTY?
12200		   JRST	OP7BT			;USE 7 BIT BYTES
12300	;NOW TRY VARIOUS THINGS, LOOKING FOR SOMETHING THAT WORKS
12400	
12500		HRRZ	1,JFNTBL(CHNL)
12600		HRLI	OPFLAGS,440000
12700		MOVE	2,OPFLAGS		;36-BIT, MODE 0
12800		JSYS OPENF	
12900		   SKIPA
13000		JRST	OPOK	
13100		HRRZ	1,JFNTBL(CHNL)
13200		HRLI	OPFLAGS,447400		;36-BIT, MODE 17
13300		MOVE	2,OPFLAGS
13400		JSYS OPENF
13500		  SKIPA
13600		JRST 	OPOK
13700	OP7BT:	HRRZ	1,JFNTBL(CHNL)
13800		HRLI	OPFLAGS,70000		;7-BIT, MODE 0
13900		MOVE	2,OPFLAGS
14000		JSYS OPENF
14100		   JRST NOOPN
14200	OPOK:	MOVEM	OPFLAGS,OFL(CDB)	;SAVE OP FLAGS
14300	GUDRET:	
14400	;SAVE FLAGS
14500		SETOM	OPNDUN(CDB)		;INDICATE OPENED WITH OPEN
14600		POP	P,TEMP			;RETURN ADDRESS
14700		POP	P,ENDFL(CDB)		;SAVE GOOD THINGS
14800		POP	P,BRCHAR(CDB)
14900		POP	P,ICOUNT(CDB)		
15000		SETZM	@ENDFL(CDB)		;INDICATE GOOD OPENING
15100		SUB	SP,X22			;CLEAN UP STACKS
15200		SUB	P,X44
15300		JRST	RESTR			;AND RETURN
15400		
15500	
15600	NOOPN:
15700	CNTOPN:	SKIPN	1,JFNTBL(CHNL)		;RELEASE JFN
15800		JSYS RLJFN
15900		  JFCL
16000	BADOPN:
16100		SKIPE	B,CDBTBL(CHNL)		;CORE ALLOCATED?
16200		  PUSHJ	P,CORREL		;RELEASE CORE
16300		SETZM	JFNTBL(CHNL)
16400		SETZM	CDBTBL(CHNL)
16500		SKIPN	@-1(P)			;USER WANTS ERROR?
16600		  ERR	<OPEN:  IO ERROR OR ILLEGAL SPECIFICATIONS>,1
16700		SETOM	@-1(P)
16800		POP	P,TEMP
16900		SUB	P,[XWD 7,7]
17000		SUB	SP,X22	
17100		JRST	RESTR
17200	
17300	
17400	
17500	
17600		BEND OPEN
17700	
17800	;MAKE UPPER CASE LETTERS
17900	MAKUP:	PUSHJ	P,SAVE
18000		SKIPE	SGLIGN(USER)
18100		  PUSHJ	P,INSET
18200		HRRZ	A,-1(SP)		;LENGTH OF STRING	
18300		ADDM	A,REMCHR(USER)
18400		SKIPLE	REMCHR(USER)		;OK?
18500		  PUSHJ	P,STRNGC		;NO, COLLECT
18600		MOVE	B,A
18700		HRRO	A,A
18800		PUSH	SP,A
18900		PUSH	SP,TOPBYTE(USER)
19000	UPPER1:	JUMPLE	B,UPPER2		;DONE YET?
19100		ILDB	C,-2(SP)		;NEXT CHAR
19200		CAIL	C,141		
19300		CAILE	C,172
19400		  SKIPA	
19500		SUBI	C,40			;CONVERT TO UPPER CASE
19600		IDPB	C,TOPBYTE(USER)
19700		SOJA	B,UPPER1	
19800	UPPER2:	POP	SP,-2(SP)
19900		POP	SP,-2(SP)
20000		SETZ	LPSA,
20100		POP	P,TEMP			;RETURN ADDR
20200		JRST	RESTR			;RETURN
20300	
     

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		
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		PUSH	P,[=100]
07900		PUSHJ	P,ZSETST		;BP IN 1
08000		MOVE	2,DVDSG(CDB)		;DEVICE DESIGNATOR
08100		JSYS	DEVST
08200		   ERR <LOOKUP, ENTER, OR RENAME:  CANNOT DO DEVST>
08300		PUSH	P,[=100]
08400		PUSH	P,1			;UPDATED BP
08500		PUSHJ	P,ZADJST
08600		PUSH	P,[":"]
08700		PUSHJ	P,CATCHR
08800		PUSHJ	P,CAT.RV		
08900		PUSH	P,[0]
09000		PUSHJ	P,CATCHR
09100		POP	P,2
09200		POP	P,1
09300		POPJ	P,
09400	
09500	;RELEASE JFN ALREADY THERE
09600	RELNOW:	
09700		PUSH	P,CHNL			;CHANNEL
09800		PUSHJ	P,CLOSF			;CLOSE DANCE
09900		PUSH	P,1
10000		MOVE	1,JFNTBL(CHNL)		;GET JFN	
10100		JSYS	RLJFN			;RELEASE
10200		  ERR <CANNOT RELEASE JFN>,1
10300		SETZM	JFNTBL(CHNL)		;AND ZERO OUT
10400		SETZM	IOSTT(CDB)		;NO STATUS
10500		POP	P,1
10600		POPJ	P,
10700	
10800		
     

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		SKIPL	CHNL,CHNARG
01500		CAIL	CHNL,JFNSIZE
01600		   JRST	BADEN1
01700		MOVE	CDB,CDBTBL(CHNL)
01800		SKIPN	OPNDUN(CDB)
01900		   JRST	BADEN1			;WAS AN OPEN PERFORMED HERE?
02000		SKIPN	1,JFNTBL(CHNL)
02100		   JRST	NOTOPN
02200		MOVE	2,DVCH(CDB)		;GET DEVICE CHARACTERISTICS
02300		TLNN	2,100000		;DOES DEVICE HAVE DIRECTORY?
02400		   JRST	ENTRET			;NO
02500	
02600		SKIPGE	IOSTT(CDB)		;A DEC-STYLE CLOSE DONE? CHKDECCLZ
02700		  JRST [PUSHJ P,RELNOW		;RELEASE JFN
02800			JRST NOTOPN		;AND PROCEED
02900		      ]
03000	
03100		PUSH	P,1			;SAVE JFN
03200		SETO	1,			;UNMAP THE BUFFER PAGE
03300		MOVE	2,FKPAGE(CDB)
03400		SETZ	3,
03500		JSYS	PMAP			;REMOVE PAGE
03600		POP	P,1
03700	
03800		SETOM	IOPAGE(CDB)
03900		SETZM	IOSTT(CDB)
04000		
04100		PUSH	P,1			;SAVE JFN
04200		TLO	1,400000		;DO NOT RELEASE THE JFN
04300		JSYS 	CLOSF
04400		   JFCL	;IGNORE
04500		POP	P,1
04600		MOVE	2,OFL(CDB)
04700		TESTO	2,WRBIT			;TURN ON WRITE BIT
04800		MOVEM	2,OFL(CDB)		;AND SAVE NEW FLAGS
04900		JSYS OPENF
05000		   JRST	BADENT			;ERROR IN 1	    
05100		JRST	ENTRET			;RETURN
05200	
05300	NOTOPN:	
05400		PUSHJ	P,DEVCAT
05500	
05600		MOVSI	1,600001		;NEW FILE
05700		MOVE	2,(SP)
05800		JSYS GTJFN
05900		   JRST	BADENT			;CANNOT GTJFN
06000		MOVEM	1,JFNTBL(CHNL)
06100		MOVSI	2,600001		;THE 
06200		MOVEM	2,GFL(CDB)		;SAVE THE GTJFN FLAGS
06300	B36:	HRRZ	1,JFNTBL(CHNL)
06400		MOVE	2,[XWD 440000,100000]	;36-BIT
06500		JSYS OPENF	
06600		   SKIPA
06700		JRST	ENT1	
06800		HRRZ	1,JFNTBL(CHNL)
06900		MOVE	2,[XWD 447400,100000]	;36-BIT, DUMP
07000		JSYS OPENF
07100		   SKIPA
07200		JRST	ENT1
07300		HRRZ	1,JFNTBL(CHNL)
07400		MOVE	2,[XWD 70000,100000]
07500		JSYS OPENF
07600		   JRST	BADENT
07700	ENT1:	MOVEM	2,OFL(CDB)
07800	ENTRET:	SETZM	@FLGARG
07900	ENTPOP:	POP	P,CDB
08000		POP	P,CHNL
08100		POP	P,3
08200		POP	P,2
08300		POP	P,1
08400		SUB	SP,X22
08500		SUB	P,X33
08600		JRST	@3(P)
08700	
08800	
08900	BADENT:	MOVEM	1,@FLGARG
09000		JRST	ENTPOP
09100	
09200	BADEN1:	SETOM	@FLGARG
09300		JRST	ENTPOP
09400	
09500		BEND ENTER
09600		
     

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:	JSYS DELF				;JFN IN 1
07200		   JRST	RENERR
07300		JRST	RENRET
07400		BEND RENAME
07500	
     

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,[CLOSE_INHIBIT_BITS])
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,IOTLEN
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,IOTLEN-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,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)
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		PUSH	P,[0]
01100		PUSHJ	P,CATCHR		
01200		MOVE 	1,(SP)			;BYTE-POINTER
01300		SETZB 	2,.SKIP.		;NO SPECIAL FORMAT, ASSUME NO ERROR
01400		JSYS IDTIM
01500		  MOVEM 2,.SKIP.		;ERROR TO USER
01600		MOVE  	1,2			;ANSWER
01700		SUB	SP,X22			;ADJUST SP STACK
01800		POPJ	P,			;RETURN
     

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	ENDCOM(JOBINF)
00200	
     

00100	COMPIL(DIRECT,<STDIR,DIRST>,<X22,X33,CATCHR,ZSETST,ZADJST.SKIP.>
00200		,<DIRECT -- TENEX DIRECTORY SPECS>)
00300	DSCR INTEGER SIMPLE PROCEDURE STDIR(STRING S; BOOLEAN DORECOGNITION)
00400	DESR
00500		Returns the directory number associated with a string.
00600	Any problems are returned in .SKIP. with the code:
00700			1 string does not match
00800			2 string is ambiguous.
00900	⊗
01000	HERE(STDIR)
01100		PUSH	P,[0]
01200		PUSHJ	P,CATCHR	;TACK ON 0
01300		SETZ 	3,		;
01400		MOVEI 	1,1 		; ASSUME NO RECOGNITION
01500		SKIPE 	-1(P)		; DO WE WANT IT?
01600		SETO  	1,		; YES AFTER ALL
01700		MOVE 	2,(SP)		;BYTE-POINTER
01800		JSYS STDIR
01900		MOVEI 	3,1		; NO MATCH;
02000		MOVEI 	3,2 		; AMBIGUOUS
02100		MOVEM 	3,.SKIP.	; SAVE IT FOR USER
02200		HRRZ 	1,1 		; SAVE DIR NO. (ONLY)
02300		SUB	SP,X22		;ADJUST STRING STACK
02400		SUB	P,X22
02500		JRST	@2(P)		;RETURN	
02600		
     

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		PUSH	P,[=100]
00800		PUSHJ	P,ZSETST
00900		SETZM 	.SKIP.
01000		MOVE 	2,-1(P)		;DIRECTORY NO.
01100		JSYS DIRST
01200		SETOM 	.SKIP.
01300		PUSH	P,[=100]
01400		PUSH	P,1		;UPDATED BP
01500		PUSHJ	P,ZADJST	;GET STRING ON STACK
01600		SUB	P,X22		
01700		JRST	@2(P)
01800	
01900	ENDCOM(DIRECT)
     

00100	COMPIL(RUNPRG,<RUNPRG>,<X22,X33,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		Remember to say .SAV as the PROGRAM extension.
01400	⊗
01500	
01600	
01700	HERE(RUNPRG)
01800		BEGIN 
01900		JFN←←0
02000		FORK←←14
02100		PUSH	P,[0]
02200		PUSHJ	P,CATCHR	
02300		MOVSI	1,100001 	; OLD FILE, PTR IN 2	
02400		MOVE	2,(SP) 		; STRING POINTER
02500		JSYS GTJFN 			; TRY FOR JFN		
02600		   JRST RUNERR 		; ERROR
02700		MOVEM	1,JFN 		; SAVE JFN		
02800	
02900		SKIPN	-1(P) 		; USER WANTS FORK?
03000		   JRST SWP 		; NO, REPLACE CURRENT PRG
03100	
03200		MOVSI	1,100000 	; XMIT CAPABILITIES
03300		JSYS CFORK
03400		   JRST RUNERR 	; CANNOT CREATE FORK
03500		MOVEM	1,FORK 	; SAVE HANDLE
03600		SETOB	2,3 	; INDICATE ALL PRIVILEDGES
03700		JSYS EPCAP
03800		HRLZ	1,1 	; FORK HANDLE
03900		HRR	1,JFN 	; THE JFN
04000		JSYS GET 		; JSYS GET THE FILE
04100		MOVEI	1,400000 	; CURRENT FORK
04200		JSYS	GPJFN	;PRIMARY JFNS IN 2
04300		MOVE	1,FORK 	; SET PRIMARY IO	
04400		JSYS SPJFN	;FOR NEW FORK
04500		MOVE	1,FORK 	; FORK
04600		MOVE	2,-2(P) 	; USER VALUE FOR ENTRY VECTOR
04700		JSYS SFRKV	;START THE FORK
04800		MOVE	1,FORK ;
04900		JSYS WFORK
05000		SKIPE	1,FORK 	; SET TO KILL
05100		JSYS KFORK	;KILL THE FORK
05200		HRRZ	1,JFN ;
05300		JSYS RLJFN 		; RELEASE
05400		JFCL 		; IGNORE	
05500		JRST 	RUNRET 		; AND RETURN SAFELY
05600	
05700	SWP:	
05800	IMSSS,<				;DESTROY EMULATOR INFO AT IMSSS
05900		SETO	1,
06000		MOVE	2,[XWD 400000,711]	;PAGE 711
06100		JSYS	PMAP			;DESTROY
06200	>;IMSSS
06300		PUSH	P,JFN			;SAVE THE JFN
06400		HRLI	A1 			; BLT INTO ACS
06500		HRRI	1 ;
06600		BLT	15 		; THE INSTRUCTIONS -- NOTE THAT RF IS NOW CLOBBERED
06700		POP	P,0		; RESTORE JFN TO AC0
06800		HRLI	0,400000 	; XWD FORK, JFN
06900	 	MOVE	16,-2(P) 	; THE INCREMENT -- NOTE THAT SP IS NOW CLOBBERED
07000		MOVE	17,[254000400010] 	; FOR COMPARISON -- NOTE THAT THE P STACK IS GONE
07100		JRST	4 		; AND GO
07200	A1:	-1 		; FOR PMAP
07300	A2:	400000000677 	; THIS FORK, START AT 677 (LEAVING EMULATOR)
07400	A3:	0 ;
07500	A4:	JSYS PMAP
07600	A5:	SOJL	2,4 	; LOOP THROUGH PAGES
07700	A6:	MOVE	1,0 	; XWD 400000,JFN
07800	A7:	JSYS GET ;
07900	A10:	MOVEI	1,400000 	; THIS FORK
08000	A11:	JSYS GEVEC 		; JSYS GET ENTRY VECTOR
08100	A12:	CAMN	2,17 	; DEC STYLE??
08200	A13:	  HRRZ	2,120 	; YES
08300	A14:	ADD	2,16 	; ADD THE INCREMREMENT
08400	A15:	JRST	(2) 	; AND START THE JOB
08500	
08600	RUNERR:	TDZA	1,[-1]	;ZERO 1 AND SKIP
08700	RUNRET:	SETO	1,	;INDICATE SUCCESS
08800		SUB	SP,X22
08900		SUB	P,X33
09000		JRST	@3(P)
09100	
09200	
09300		BEND;RUNPRG
09400	ENDCOM(RUNPRG)
     

00100	COMPIL(OPF,<OPENFILE,SETINPUT,SETPL,INDEXFILE>,<.SKIP.>,<OPENFILE -- OPEN A FILE>)
00200	DSCR INTEGER SIMPLE PROCEDURE OPENFILE(STRING NAME,OPTIONS)
00300	
00400		Name is the name of the file to be opened.  If it is null, then
00500	OPENFILE goes to the user's console for the filname (with recognition).
00600		The value of the call is the jfn returned to the user.
00700		OPTIONS is a string of options available to the user.  Legal 
00800	characters are:
00900	
01000	One of these:
01100		R		read
01200		W		write
01300		A		append
01400	Version numbering
01500		O		old file
01600		N		new file
01700		T		temporary file
01800		*		index with INDEXFILE routine
01900	
02000	Independent:
02100		C		require confirmation
02200		D		ignore deleted bit
02300		H		"thawed" access
02400	Error handling
02500		E		return errors to user in the external
02600				integer !skip!.  TENEX error codes are used.
02700				(JFN will be released in this case.)
02800		OPENFILE does a GTJFN followed by a OPENF.  If GTJFN fails, a new
02900	attempt is made, from the user's console.  
03000	⊗
03100	
03200		BEGIN OPENFILE
03300	JFN←3				;WHERE TO PUT THINGS
03400	FLAGS←4
03500	GTFLAGS←5
03600	OPFLAGS←6
03700	
03800	DEFINE EQ $ (X,Y) <
03900		CAIE	A,"$X$"
04000		   JRST .+3
04100		TESTO	FLAGS,Y
04200		JRST	OPCONT
04300	>
04400	
04500	DEFINE JTRUE $ (X) <
04600		TESTN	FLAGS,X
04700	>
04800	DEFINE JFALSE (X) <
04900		TESTE	FLAGS,X
05000	>
05100	
05200	DEFINE 	SGT (X) <
05300		TESTO	GTFLAGS,X
05400	>
05500	DEFINE  SOF (X) <
05600		TESTO	OPFLAGS,X
05700	>
05800	DEFINE  TGT (X) <
05900		TESTE	FLAGS,X
06000		  TESTO GTFLAGS,X
06100	>
06200	DEFINE  TOP (X) <
06300		TESTE	FLAGS,X
06400		  TESTO OPFLAGS,X
06500	>
06600	
06700	HERE(OPENFILE)
06800		SETZB	FLAGS,.SKIP.
06900		SETZB	GTFLAGS,OPFLAGS
07000		HRRZ	B,-1(SP)		;COUNT OF OPTIONS WORD
07100	
07200	WHIOPT:	JUMPE	B,OPTDUN
07300		ILDB	A,(SP)			;GET AN OPTION
07400		CAIGE	A,141
07500		   JRST .+3
07600		CAIG	A,172
07700		   SUBI	A,40			;CONVERT TO UPPER CASE
07800	;ANY NON-ALPHABETIC CHARS GO HERE
07900	
08000		EQ 	*,STARBIT
08100	;NOW ALLOW ONLY ALPHABETIC CHARS
08200		CAIL	A,101			;MUST BE 
08300		CAILE	A,132
08400		   JRST	OPTERR
08500		SKIPN	BITTBL-"A"(A)		;SOMETHING THERE?
08600		   JRST	OPTERR			;NOPE, ERROR
08700		TDO	FLAGS,BITTBL-"A"(A)	;RIGHT SPOT IN TABLE
08800		SOJGE	B,WHIOPT
08900		  JRST	OPTDUN
09000	;HERE ON ERROR
09100	OPTERR:	ERR	<OPENFILE:  ILLEGAL OPTION >,1
09200		TESTO	FLAGS,ERSNBIT
09300	
09400	  OPCONT:
09500		SOJGE	B,WHIOPT
09600	
09700	;NOW SET UP GTFLAGS ACCORDING TO THE SCANNED INFORMATION
09800	OPTDUN:		
09900		TGT	OLDBIT			;INSIST ON OLD?
10000		TGT	NEWBIT			;INSIST ON NEW?
10100		JTRUE	OLDBIT
10200		JFALSE	NEWBIT			;IF NEITHER
10300		  JRST	OPTDU1			;WELL, ONE
10400		JTRUE	WRBIT			;IF WRITING
10500		  JRST	OPTDU1
10600		JFALSE	RDBIT			;AND READING
10700		JTRUE	APPBIT			;BUT NOT APPENDING
10800		  SGT	OUTBIT			;THEN SET OUTPUT BIT
10900	OPTDU1:
11000		JFALSE	RDBIT			;IF READING
11100		JFALSE	WRBIT			;AND NOT WRITING
11200		   JRST	OPTDU2	   
11300		JTRUE	APPBIT			;AND NOT APPENDING
11400		   SGT	OLDBIT			;THEN INSIST ON OLD
11500	OPTDU2:
11600	;NOW TEST FOR INDEPENDANT THINGS
11700		TOP	RDBIT
11800		TOP	WRBIT
11900		TOP	APPBIT
12000		TGT	TEMBIT
12100		TGT	STARBIT
12200		TGT	DELBIT
12300		TOP	THAWBIT
12400		JFALSE	CONFBIT
12500		   JRST	[SGT	CONFB1
12600			 SGT	CONFB2
12700			 JRST	.+1]
12800		TLO	GTFLAGS,1		;SHORT CALL OF GTJFN
12900	GTAGAIN:
13000		HRRZ	A,-3(SP)		;LENGTH OF NAME
13100		JUMPE	A,[TRYAGN:  
13200			   TLO	GTFLAGS,2
13300			   MOVE	2,[XWD 100,101]
13400			   JRST  GT]
13500		AND 	GTFLAGS,[717777777777]
13600		
13700		PUSH	SP,-3(SP)
13800		PUSH	SP,-3(SP)
13900		PUSH	P,[0]
14000		PUSHJ	P,CATCHR		;CONCATENATE A NULL CHAR
14100		MOVE	2,(SP)			;BYTE-POINTER
14200		SUB	SP,X22			;ADJUST STACK
14300	GT:	MOVE	1,GTFLAGS
14400		JSYS GTJFN
14500		  JRST 	GTERR
14600		MOVEM	1,JFN			;REMEMBER JFN
14700		PUSHJ	P,SETCHN		;SET A CHANNEL, ALLOCATE, GET CDB, SET DVTYP, RETURN CHANNEL
14800		MOVEM	1,CHNL			;REMEMBER CHANNEL	
14900		MOVEM	GTFLAGS,GFL(CDB)
15000	
15100	
15200	COMMENT ⊗ Do the open.
15300	⊗
15400		MOVE	1,DVTYP(CDB)		;CHECK THE DEVICE TYPE
15500		CAIN	1,12			;IS IT A TTY?
15600		   JRST	B7			;YES, USE 7 BIT
15700	B36:	HRRZ	1,JFN			;JFN
15800		HRRZ	2,OPFLAGS
15900		HRLI	2,440000		;36-BIT, MODE 0
16000		JSYS OPENF	
16100		   JRST	B36DMP			;TRY 36-BIT, DUMP MODE
16200		JRST	OPNOK
16300	B36DMP:	HRRZ	1,JFN
16400		HRRZ	2,OPFLAGS
16500		HRLI	2,447400		;36 BITS, DUMP MODE
16600		JSYS OPENF			
16700		   JRST	B7
16800		JRST	OPNOK
16900	B7:	HRRZ	1,JFN
17000		HRRZ	2,OPFLAGS
17100		HRLI	2,70000			;7 BIT
17200		JSYS OPENF
17300		    JRST OPERR			;NOPE
17400	OPNOK:	MOVEM	2,OFL(CDB)		;SAVE 
17500		MOVE	1,CHNL			;RETURN CHANNEL NO	
17600	OPFRET:	SUB	SP,X44			;ADJUST
17700		POPJ	P,			;AND RETURN
17800	
17900	
18000	
18100	
18200	GTERR:
18300	;HERE WITH ERROR ON GTJFN
18400		JTRUE	ERTNBIT			;USER WANT'S ERRORS?
18500		   JRST	GTER1			;NO
18600	ERRRET:	MOVEM	1,.SKIP.		;STORE FOR USER
18700		SETO	1,			;SOMETHING SUSPICIOUS
18800		JRST	OPFRET			;AND RETURN
18900	
19000	GTER1:	PUSHJ	P,SERSTR		;SHOW ERSTR
19100		HRROI	1,[ASCIZ/
19200	Cannot GTJFN file /]
19300		JSYS PSOUT
19400		PUSH	SP,-3(SP)
19500		PUSH	SP,-3(SP)
19600		PUSHJ	P,OUTSTR
19700		HRROI	1,[ASCIZ/, try again  */]
19800		JSYS PSOUT
19900		JRST	TRYAGN
20000	
20100	
20200	
20300	OPERR:	JTRUE	ERTNBIT
20400		   JRST	OPER1
20500		PUSH	P,1			;SAVE ERROR BITS
20600		PUSH	P,CHNL
20700		PUSHJ	P,CFILE			
20800		POP	P,1			;RESTORE ERROR BITS
20900		JRST	ERRRET
21000	
21100	OPER1:	PUSHJ	P,SERSTR		;SHOW ERSTR
21200		HRROI	1,[ASCIZ/
21300	Cannot OPENF file /]
21400		JSYS 	PSOUT
21500		PUSH	SP,-3(SP)
21600		PUSH	SP,-3(SP)
21700		PUSHJ	P,OUTSTR
21800		HRROI	1,[ASCIZ/, try again  */]
21900		JSYS 	PSOUT	
22000		PUSH	P,CHNL			;CLOSE AND RELEASE FILE AND CDB BLOCK
22100		PUSHJ	P,CFILE
22200		JRST	TRYAGN	
22300	
22400	;HERE WITH THE TENEX ERROR CODE IN 1 -- 1 MAY BE CLOBBERED
22500	SERSTR:
22600		PUSH	P,2			;SAVE ACS
22700		PUSH	P,3
22800		HRRZ	2,1
22900		HRLI	2,400000		;THIS FORK
23000		HRROI	1,[ASCIZ/
23100	/]
23200		JSYS	PSOUT
23300		MOVEI	1,101			;PRIMARY OUTPUT
23400		SETZ	3,			;FLAGS
23500		JSYS	ERSTR
23600		  JFCL
23700		  JFCL
23800		POP	P,3
23900		POP	P,2
24000		POPJ	P,
24100	
24200	
24300	BITTBL: APPBIT	;A
24400		BINBIT	;B
24500		CONFBIT	;C
24600		DELBIT	;D
24700		ERTNBIT	;E
24800		0	;F
24900		0	;G
25000		THAWBIT	;H
25100		0	;I
25200		0	;J
25300		0	;K
25400		0	;L
25500		0	;M
25600		NEWBIT	;N
25700		OLDBIT	;O
25800		0	;P
25900		0	;Q
26000		RDBIT	;R
26100		0	;S
26200		TEMBIT	;T
26300		0	;U
26400		0	;V
26500		WRBIT	;W
26600		0	;X
26700		0	;Y
26800		0	;Z
26900	
27000	
27100		BEND OPENFILE
27200	
     

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	
02900	
03000	
03100	
     

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,UNDELETE,DELNF,SIZEF,JFNS,OPENF,CFILE,CLOSF,RLJFN,GTSTS,STSTS,RNAMF>
00200		,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST,FINIO>
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)
00200		Deletes file open on CHAN.  Errors to .SKIP. 
00300	⊗
00400	HERE(DELF)
00500		PUSH	P,1
00600		VALCH1	1,-2(P),DELF1
00700		JSYS	DELF
00800		  JRST	DELF2
00900		SETZM	.SKIP.			;NO ERROR
01000	DELFRE:	POP	P,1
01100		SUB	P,X22
01200		JRST	@2(P)
01300	DELF1:	SETO	1,
01400	DELF2:	MOVEM	1,.SKIP.
01500		JRST	DELFRE
01600	
01700	DSCR INTEGER PROCEDURE DELNF(INTEGER CHAN,NUM)
01800	⊗
01900	HERE(DELNF)
02000		PUSHJ	P,SAVE
02100		MOVE	LPSA,X33
02200		VALCH1	1,-2(P),DLNERR
02300		MOVE	2,-1(P)
02400		SETZM	.SKIP.
02500		JSYS	DELNF
02600		  JRST	DLNERR
02700		MOVEM	2,RACS+A(USER)		;NUMBER OF FILES DELETED
02800		JRST	RESTR	
02900	DLNERR:	MOVEM	1,.SKIP.;
03000		SETZM	RACS+A(USER)		;INDICATE NO FILES DELETED
03100		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	
     

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	OPNRET:	JRST	RESTR
03900	
04000	OPNERR: ERR <Illegal JFN>,1
04100		SETOM	.SKIP.
04200		JRST	OPNRET
04300	
04400	NOOPN:	MOVEM	1,.SKIP.
04500		SUB	P,X11		;ADJUST STACK
04600		JRST	OPNRET
04700	
04800	OPNTBL:	070000200000		;7-BIT READ
04900		070000100000		;7-BIT WRITE
05000		440000200000		;36-BIT READ
05100		440000100000		;36-BIT WRITE
05200		447400200000		;36-BIT DUMP READ
05300		447400100000		;36-BIT DUMP WRITE
05400	
     

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:	SKIPE	B,CDBTBL(CHNL)	; ANY CORE TO RELEASE?
02500		  PUSHJ	P,CORREL	; RELEASE THE BLOCK
02600		TLZ	1,400000	; BE SURE TO RELEASE
02700		JSYS CLOSF		; CLOSE (AND RELEASE)
02800		   JFCL			; ERROR RETURN
02900		HRRZ	1,JFNTBL(CHNL)	; GET JFN AGAIN
03000		JSYS	RLJFN		; RELEASE (FOR GOOD MEASURE IF FILE NOT OPEN)
03100		   JFCL			; ERROR RETURN
03200		SETO	1, 		; RETURN TRUE FOR GOOD RELEASE
03300	      	SETZM	CDBTBL(CHNL)
03400		SETZM	JFNTBL(CHNL)
03500	CFRET:	POP	P,CDB
03600		POP	P,CHNL
03700		POP	P,3
03800		POP	P,2
03900		SUB	P,X22 		; ADJUST
04000		JRST	@2(P) 		; RETURN
04100	
04200	CFBAD:	SETZ	1, 		; RETURN FALSE
04300		JRST	CFRET ;
04400	
04500	CFBA1:	SKIPE	B,CDB
04600		PUSHJ	P,CORREL	;RELEASE CORE BLOCK
04700		SETZM	CDBTBL(CHNL)	;REMOVE ALL TRACE
04800		SETZM	JFNTBL(CHNL)	
04900		SETZ	1,		; RETURN FALSE
05000		JRST	CFRET
05100	
     

00100	DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
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.  This writes
00800	a standard end-of-file on the tape.
00900	⊗
01000	HERE(CLOSF)
01100		PUSHJ	P,SAVE
01200		MOVE	LPSA,X22
01300		VALCHN	1,<-1(P)>,CLOERR
01400		PUSHJ	P,FINIO		;WRITE OUT BUFFERS, SET FDB, WRITE MAGT EOFS, CLEAR BUFFERS
01500	
01600	DOCLO:	SETZM 	.SKIP.		;ASSUME NO ERROR
01700		TLO 1,400000 		; DO NOT RELEASE THE JFN
01800		JSYS CLOSF
01900		  MOVEM	1,.SKIP.	;ERROR
02000	CLORET:	JRST	RESTR
02100	
02200	CLOERR:	
02300		SETOM	.SKIP.
02400		JRST	CLORET
02500	
     

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		SKIPE	B,CDBTBL(C)
01600		PUSHJ	P,CORREL
01700		SETZM	CDBTBL(C)
01800		SETZM	.SKIP.		;ASSUME NO ERROR
01900		JSYS RLJFN
02000		  MOVEM	1,.SKIP.	;ERROR RETURN
02100	RLJRET:	JRST	RESTR
02200	
02300	RLJBAD: ERR <Illegal JFN>,1
02400		SETOM 	.SKIP.
02500		JRST	RLJRET
02600	
02700	
     

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	ENDCOM(FILINF)	
     

00100	COMPIL(DEVINF,<CNDIR,ASND,RELD,GDSTS,SDSTS,STDEV,DEVST,GTFDB,CHFDB>
00200		,<JFNTBL,CDBTBL,X11,X22,X33,CORREL,.SKIP.,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	
     

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	[MOVEM 2,.SKIP.
01400			 SETZ	1,
01500			 JRST .+2]
01600		MOVE	1,2
01700		POPJ	P,
01800	
     

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,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
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		ADD	6,E				;FIX INPUT POINTER
02400		SUB	B,E				;FIX INPUT COUNT
02500	WIN5:	PUSHJ	P,ADWI				;GET MORE
02600		  JRST	ISEOF				;END OF FILE -- NO MORE THERE
02700		JRST	WIN3
02800	WIN4:	ADDI	D,-1(B)				;
02900		BLT	C,(D)				;LAST BLT
03000		SUB	E,B				;FIX UP COUNT
03100		SOJ	B,
03200		MOVEM	E,IOCNT(CDB)
03300		ADDM	B,IOBP(CDB)
03400		JRST	RESTR
03500	
03600	TABL:	JRST	DOSETWI				;0 -- SET UP
03700		JRST	.CISWI				;1 -- XICHAR
03800		JRST	.COSWI				;2 -- XOCHAR
03900		MOVE	6,-2(P)				;3 -- XIWORD
04000		JRST	.WOSWI				;4 -- XOWORD
04100		JRST	WERR				;5 -- XCICHAR
04200		JRST	WERR				;6 -- XCOCHAR
04300		JRST	DOSIN				;7 -- XCWORD
04400		JRST	WERR				;10 -- XBYTE7
04500		JRST	WERR				;11 -- XDICHAR
04600		JRST	WERR				;12 -- XDOCHAR
04700		JRST	DODUMPI				;13 -- XDARR
04800	
04900	ISEOF:	MOVE	TEMP,-1(P)			;NUMBER OF WORDS WANTED
05000		SUBM	TEMP,B				;INPUT IN RH
05100	WIN2:	HRROM	B,.SKIP.
05200		SKIPE	ENDFL(CDB)
05300		  HRROM	B,@ENDFL(CDB)
05400		JRST	RESTR
05500	
05600	.CISWI:	PUSHJ	P,CISWI
05700		JRST	DOSIMIO
05800	
05900	.COSWI:	PUSHJ	P,COSWI
06000		JRST	DOSIMIO
06100	
06200	.WOSWI:	PUSHJ	P,WOSWI
06300		JRST	DOSIMIO
06400	
06500	DOSETWI:
06600		PUSHJ	P,SETWI
06700		JRST	DOSIMIO
06800	
06900	DOSIN:
07000		MOVN	3,-1(P)				;WORD COUNT	
07100		MOVSI	2,444400
07200		HRR	2,-2(P)				;ADDRESS OF BUFFER
07300		JSYS	SIN
07400		JUMPE	3,RESTR				;DID WE GET IT ALL?
07500	SINEOF:	ADD	3,-1(P)				;CALCULATE NO OF WORDS READ
07600		HRLI	3,-1				;MAKE IT XWD -1,,COUNT
07700		SKIPE	ENDFL(CDB)			;EOF LOCATION?
07800		  MOVEM	3,@ENDFL(CDB)			;YES
07900		MOVEM	3,.SKIP.
08000		JRST	RESTR				;AND RETURN
08100	
08200	DODUMPI:
08300		MOVN	3,-1(P)
08400		MOVEI	2,3
08500		HRL	3,3
08600		HRR	3,-2(P)				;ADDRESS OF BUFFER
08700		SUBI	3,1
08800		SETZ	4,				;END OF DUMP MODE COMMAND LIST
08900		JSYS	DUMPI				;DO IT
09000		  JRST	DMPERR
09100		JRST	RESTR				;ALL OK
09200	
09300	DMPERR:	CAIN	1,600220			;EOF?
09400		  JRST	DUMPEOF				;NO
09500		ERR	<ARRYIN:  Dump mode error>,1
09600		MOVEM	1,.SKIP.
09700		JRST	RESTR
09800	
09900	DUMPEOF:
10000		MOVE	1,DVTYP(CDB)
10100		CAIE	1,2				;MAGTAPE DEVICE?
10200		  JRST	INPEOF				;NO JUST INDICATE EOF
10300		HRRZ	1,JFNTBL(CHNL)	
10400		SETZ	2,				;MTOPR RESET
10500		JSYS	MTOPR	
10600		JRST	INPEOF				;INDICATE EOF AND RETURN
10700	
10800	WERR:	ERR	<ARRYIN:  Illegal JFN, byte-size, or mode.>,1
10900		JRST	INPEOF
11000	
11100	
11200		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		PUSH	P,4
08400		SKIPN	2,FDBSZ(CDB)			;IF BYTE SIZE IS ZERO
08500		  JRST	POPBACK				;THEN RETURN
08600		MOVE	3,FDBEOF(CDB)
08700		CAIN	2,=36				;ALREADY 36?
08800		  JRST	RET				;YES
08900		CAIE	2,7
09000		  ERR	<GETWND:  File byte size is neither 7 nor 36>,1
09100		IDIVI	3,5				;CALCULATE BYTES
09200		JUMPE	4,.+2
09300		  AOJ	3,				;ACCOUNT FOR REMAINDER
09400	RET:	MOVEM	3,2
09500	POPBACK:POP	P,4
09600		POP	P,3
09700		POPJ	P,
09800		BEND GETWND
09900	
10000	GETWPT:	
10100	;HERE WITH 1,CDB LOADED
10200	;RETURNS IN 2 THE WORD THAT ADDRESSES EOB
10300		BEGIN GETWPT
10400		SKIPN	2,IOBP(CDB)
10500		  POPJ	P,				;WORD ZERO
10600		PUSH	P,3
10700		TLZ	2,007700
10800		TLO	2,004400			;MAKE 36 BIT
10900		IBP	2
11000		MOVE	3,IOADDR(CDB)	
11100		SUBI	3,(2)
11200		MOVE	2,IOPAGE(CDB)			;CURRENT PAGE
11300		LSH	2,9				;NUMBER OF WORDS IN PREVIOUS PAGES
11400		SUB	2,3				;SUBTRACT SINCE 3 IS NEGATIVE
11500		POP	P,3				;RESULT IN 2
11600		POPJ	P,
11700	
11800		BEND GETWPT
11900	
12000	GTWPT1:
12100	;HERE WITH 1,CHNL,CDB LOADED
12200	;RETURN IN 2 THE WORD THAT ADDRESSES EOB IN 2, ACCORDING TO THE CURRENT POINTER
12300	;RETURN IN 3 THE UPDATED BYTE POINTER
12400	;RETURN IN 4 THE COUNT REMAINING FOR OUTPUT
12500	;RETURN IN 5 THE COUNT REMAINING FOR INPUT
12600		BEGIN GTWPT1
12700		SKIPN	3,IOBP(CDB)	
12800		  JRST	NULRET
12900		TLZ	3,007700
13000		TLO	3,004400			;MAKE A 36-BIT BP	
13100		MOVEM	3,2				;COPY INTO 2
13200		IBP	2
13300		MOVE	4,IOADDR(CDB)			;START OF BUFFER
13400		SUBI	4,(2)				;NUMBER OF WORDS CURRENTLY COMMITTED TO
13500							;IN THIS BUFFER
13600		MOVE	2,IOPAGE(CDB)			;WHERE THE CURRENT IO IS
13700		LSH	2,9
13800		SUB	2,4				;NUMBER OF WORDS TO ADDRESS EOF
13900		ADDI	4,1000				;NUMBER OF WORDS REMAINING IN  THIS BUFFER
14000							;FOR OUTPUT PURPOSES
14100		MOVEM	2,5				;SAVE CURRENT EOB POINTER
14200		PUSHJ	P,GETWND			;READ THE END OF FILE IN FDB
14300	 	EXCH	5,2				;EOB POINTER TO 2, EOF TO 5
14400		SUB	5,2				;SUBTRACT THE CURRENT EOB POINTER
14500		CAML	5,4				;IF LESS THAN OUTPUT COUNT THEN USE IT ELSE
14600		  MOVEM	4,5				;USE OUTPUT COUNT
14700		POPJ	P,
14800	
14900	NULRET:	SETZB	2,3				;EVERYTHING ZERO
15000		SETZB	4,5
15100		POPJ	P,
15200	
15300	
15400		BEND GTWPT1
15500	
15600	CHWEOF:
15700	;1,CDB LOADED
15800	;SEES IF A CHANGE OF EOF IS NEEDED, AND DOES IT
15900		SKIPN	IOBP(CDB)			;ANYTHING THERE?
16000		  POPJ	P,				;NO, DONT FIDDLE AROUND
16100		PUSH	P,2
16200		PUSH	P,3
16300		PUSHJ	P,GETWND			;GET WORD EOF
16400		MOVEM	2,3				;SAVE IN 6
16500		PUSHJ	P,GETWPT			;GET WORD EOB
16600		CAML	2,3				;IS EOB LESS THAN EOF?
16700		  PUSHJ	P,SETWND			;BETTER RESET FDB -- ALSO IF TEST IS EQUAL	   
16800		POP	P,3
16900		POP	P,2
17000		POPJ	P,
17100	
17200	
     

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		PUSH	P,1				;SAVE JFN
05800		PUSH	P,2
05900		PUSH	P,3
06000		MOVEM	2,IOPAGE(CDB)			;PAGE BEING INSERTED
06100		PUSH	P,1				;SAVE JFN OVER SFPTR
06200		LSH	2,9				;MAKE INTO WORDS
06300		JSYS	SFPTR
06400		  ERR	<SETPAGE:  Cannot do SFPTR>,1
06500		POP	P,1
06600		HRL	1,1
06700		HRR	1,IOPAGE(CDB)			;XWD JFN,FILEPAGE
06800		HRLZI	3,140000			;BITS 2 AND 3 FOR READ, WRITE -- ASSUME THIS
06900		MOVE	2,OFL(CDB)			;BUT BETTER CHECK:
07000		TESTN	2,WRBIT				;IF WRITING OR
07100		TESTE	2,APPBIT			;APPENDING
07200		  JRST	.+2				;THEN DONT DO
07300		TESTO	3,1B9				;THE COPY ON WRITE -- DO IT FOR READING THOUGH
07400		MOVE	2,FKPAGE(CDB)			;BUFFER IN CORE
07500		JSYS	PMAP
07600		POP	P,3
07700		POP	P,2
07800		POP	P,1				;RESTORE THE JFN
07900		POPJ	P,
08000	
     

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		AOS	3,IOPAGE(CDB)			;NEXT PAGE
01300		LSH	3,9				;WORDS IN THAT PAGE
01400		PUSHJ	P,GETWND			;END OF FILE POINTER
01500		CAML	3,2				;BEYOND
01600		  JRST	ADEOF				;YES SAY SO
01700		SUB	2,3	
01800		CAILE	2,1000				;LESS THAN A FULL BUFFER?
01900		  MOVEI	2,1000				;NO GIVE ENTIRE AMOUNT
02000		MOVEM	2,IOCNT(CDB)
02100		MOVE	2,IOPAGE(CDB)
02200		PUSHJ	P,SETPAGE	
02300		MOVE	2,IOADDR(CDB)
02400		HRLI	2,444400
02500		MOVEM	2,IOBP(CDB)
02600	ADRET:	AOS	-2(P)
02700	ADEOF:	POP	P,3
02800		POP	P,2
02900		POPJ	P,
03000	
03100		BEND ADWI
03200	
03300	ADWO:
03400	;1,CDB LOADED
03500	;ADVANCES WORD OUTPUT FROM DSK
03600		BEGIN ADWO
03700	
03800		PUSH	P,2
03900		AOS	2,IOPAGE(CDB)			;NEXT PAGE OF THE FILE
04000		PUSHJ	P,SETPAGE
04100	 	MOVEI	2,1000
04200		MOVEM	2,IOCNT(CDB)	
04300		MOVE	2,IOADDR(CDB)	
04400		HRLI	2,444400
04500		MOVEM	2,IOBP(CDB)
04600		POP	P,2
04700		POPJ	P,
04800	
04900		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	DOSIMIO:	
01100		SIMIO	E,TABL,CERR			;SOSGE IOCNT(CDB)
01200		  JRST	.DOINP
01300		ILDB	2,IOBP(CDB)
01400	STOAC2:	MOVEM	2,RACS+A(USER)
01500		JRST	RESTR
01600	
01700	TABL:	JRST	DOSETCI				;0 -- XNULL
01800		SOSGE	IOCNT(CDB)			;1 -- XICHAR
01900		JRST	.COSCI				;2 -- XOCHAR
02000		JRST	.WISCI				;3 -- XIWORD
02100		JRST	.WOSCI				;4 -- XOWORD
02200		SOSGE	IOCNT(CDB)			;5 -- XCICHAR
02300		REPEAT 2,<JRST CERR>			;6,7 -- XCOCHAR,XCOWORD
02400		JRST	DOBIN				;10 -- XBYTE7
02500		SOSGE	IOCNT(CDB)			;11 -- XDICHAR
02600		REPEAT 2,<JRST CERR>			;12,13 -- XDOCHAR,XDARR
02700	
02800	.DOINP:
02900		PUSHJ	P,ADCI
03000		  JRST	ADCIEOF				;EOF
03100		JRST	DOSIMIO
03200	
03300	ADCIEOF:SETZM	RACS+A(USER)			;RETURN 0
03400		JRST	INPEOF				;AND SAY EOF
03500	DOSETCI:
03600		PUSHJ	P,SETCI
03700		JRST	DOSIMIO
03800	
03900	
04000	.COSCI:	PUSHJ	P,COSCI
04100		JRST	DOSIMIO
04200	
04300	.WISCI:	PUSHJ	P,WISCI
04400		JRST	DOSIMIO
04500	
04600	.WOSCI:	PUSHJ	P,WOSCI
04700		JRST	DOSIMIO
04800	
04900	CERR:	ERR	<CHARIN:  Illegal JFN, byte-size, or mode>,1
05000		JRST	INPEOF				;INDICATE EOF AND RETURN
05100	
05200	CHALIT:	SETZM	.SKIP.
05300		MOVE	1,-1(P)				;PICK UP JFN LITERALLY
05400		JSYS	BIN
05500		JUMPN	2,STOAC2
05600		SETZM	RACS+A(USER)
05700		JSYS	GTSTS
05800		TESTE	2,1B8
05900		  SETOM	.SKIP.
06000		JRST	RESTR
06100	
06200	DOBIN:	JSYS	BIN
06300		JUMPN	2,STOAC2
06400	
06500		SETZM	RACS+A(USER)			;ASSUME RETURN 0
06600		JSYS	GTSTS
06700		TESTE	2,1B8
06800		  JRST	INPEOF				;INDICATE EOF
06900		JRST	RESTR				;NOT EOF, JUST RETURN
07000	
07100		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	DOSIMIO:SKIPG	C,-2(P)
01400		  JRST	NULRET
01500		SIMIO	2,TABL,CERR		;EXCH	1,C
01600		SKIPE	SGLIGN(USER)	
01700		  PUSHJ	P,INSET
01800		ADDM	1,REMCHR(USER)		
01900		SKIPLE	REMCHR(USER)
02000		  PUSHJ	P,STRNGC
02100		MOVE	E,TOPBYTE(USER)		;BYTE POINTER TO TOP OF STRING SPACE
02200		PUSH	SP,[0]
02300		PUSH	SP,E
02400		EXCH	1,C			;1 HAS JFN, C HAS COUNT
02500		MOVN	C,C
02600	IN1:	SOSGE	IOCNT(CDB)
02700		  JRST	.DOINP
02800	IN2:	ILDB	D,IOBP(CDB)
02900		JUMPE	D,IN1			;IF EMPTY KEEP LOOKING
03000		CAMN	D,-1(P)			;BREAK CHAR?
03100		  JRST	DOBRK			;YES
03200		IDPB	D,E
03300	IN3:	AOJL	C,IN1			;SUBTRACT 1 AND JUMP IF GREATER
03400	
03500		SETOM	.SKIP.			;INDICATE TERMINATED FOR COUNT
03600	DONE:	ADDM	C,REMCHR(USER)		;MAKE REMCHR HONEST
03700		MOVEM	E,TOPBYTE(USER)
03800		ADD	C,-2(P)			;GET ACTUAL NUMBER OF CHARACTERS 
03900						;TRANSFERRED	
04000		HRROM	C,-1(SP)		;SAVE COUNT FOR USER
04100		JRST	RESTR
04200	
04300	DOBRK:	IDPB	D,E			;SAVE THE BREAK CHARACTER (AS DOES THE SIN JSYS)
04400		MOVEM	D,.SKIP.		;SAVE BREAK CHARACTER IN .SKIP. AS DOC. SAYS
04500		AOJ	C,			;ADD 1 TO THE COUNT
04600		JRST 	DONE			;AND FINISH UP
04700	
04800	B7:	MOVEM	1,2			;SAVE JFN IN 2
04900		PUSH	P,-2(P)			;MAXLENGTH
05000		PUSHJ	P,ZSETST
05100		EXCH	1,2			;JFN TO 1, BP TO 2
05200		MOVE	3,-2(P)			;MAXLENGTH
05300		MOVE	4,-1(P)			;OPTIONAL BREAKCHARACTER
05400		JSYS 	SIN
05500		PUSH	P,-2(P)			;MAXLENGTH
05600		PUSH	P,2			;UPDATED BYTE-POINTER
05700		PUSHJ	P,ZADJST		;GET STRING ON STACK
05800		JSYS	GTSTS			;CHECK STATUS
05900		TESTN	2,1B8			;EOF?
06000		   JRST	RESTR			;NO EOF
06100		JRST	INPEOF			;YES, AT THE END
06200	
06300	CERR:	ERR <SINI:  Illegal JFN, illegal mode or byte size>,1
06400	NULRET:	PUSH	SP,[0]			;RETURN NULL STRING
06500		PUSH	SP,[0]
06600		JRST	RESTR
06700		
06800	TABL:	JRST	DOSETCI			;0 -- XNULL
06900		EXCH	1,C			;1 -- XICHAR
07000		JRST	.COSCI			;2 -- XOCHAR
07100		JRST	.WISCI			;3 -- XIWORD
07200		JRST	.WOSCI			;4 -- XOWORD		
07300		EXCH	1,C			;5 -- XCICHAR
07400		JRST	CERR			;6 -- XCOCHAR
07500		JRST	CERR			;7 -- XCWORD
07600		JRST	B7			;10 -- XBYTE7
07700		EXCH	1,C			;11 -- XDICHAR
07800		REPEAT 2,<JRST CERR>		;12,13 -- XDOCHAR,XDARR
07900	
08000	.DOINP:	PUSHJ	P,DOINP			;READ IN THE NEXT BUFFER
08100		JRST	IN1			;GOT IT
08200		JRST	CERR			;IMPOSSIBLE
08300	DOEOF:	SETOEOF				;END OF FILE
08400		JRST	DONE
08500	
08600	DOSETCI:	
08700		PUSHJ	P,SETCI
08800		JRST	DOSIMIO
08900	
09000	.COSCI:	PUSHJ	P,COSCI
09100		JRST	DOSIMIO
09200	
09300	.WISCI:	PUSHJ	P,WISCI
09400		JRST	DOSIMIO
09500	
09600	.WOSCI:	PUSHJ	P,WOSCI
09700		JRST	DOSIMIO
09800	
09900	
10000		BEND SINI
10100	
     

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		TRNE	FF,@BRKCVT(LPSA)	;DOING UC COERCION?
06300		TLOA	C,400000	;YES
06400		TLZ	C,400000	;NO
06500		
06600	.IN:	SOSGE	IOCNT(CDB)	;BUFFER EMPTY?
06700		 JRST	.DOINP
06800	IN1:	
06900		ILDB	D,IOBP(CDB)	;GET NEXT CHARACTER
07000	    	TDNE	Z,@IOBP(CDB)	;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
07100		JRST	INLINN		;YES, GO SEE WHAT TO DO
07200	IN2:
07300	INB:	JUMPE	D,.IN		;ALWAYS IGNORE 0'S
07400		SKIPN	LINNUM(CDB)	;COUNTING VIA SETPL FUNCTION??
07500		  JRST	INB1		;NO
07600		CAIN	D,12		;LINE-FEED?
07700		  AOS	@LINNUM(CDB)	;INDICATE ANOTHER LINE
07800		CAIE	D,14		;FORM-FEED?
07900		  JRST	INB1		;NO
08000		SKIPE	PAGNUM(CDB)	
08100		 AOS	@PAGNUM(CDB)	;COUNT PAGES ALSO
08200		SKIPE	LINNUM(CDB)
08300		  SETZM @LINNUM(CDB)	;SET LINNUM TO ZERO (NEW PAGE)
08400	
08500	INB1:	JUMPGE	C,NOCV.I	;NOT COERCING?
08600		CAIL	D,"a"		;ONLY COERCE LOWER CASE
08700		CAILE	D,"z"		;
08800		JRST	.+2		;SPECIAL RHT "FAST SKIP"
08900		TRZ	D,40		;MAKE UPPER CASE
09000	
09100	NOCV.I:	TDNE	FF,@Y		;MUST WE DO SOMETHING SPECIAL?
09200		JRST	INSPC		;YES, HANDLE
09300	
09400	MOVEC:	IDPB	D,TOPBYTE(USER)	;LENGTHEN STRING
09500		AOJL	B,.IN		;GET SOME MORE
09600		JRST	DONE1
09700	
09800	INSPC:	HLLZ	TEMP,@Y		;IGNORE OR BREAK?
09900		TDNN	TEMP,FF		;  (CHOOSE ONE)
10000		JRST	.IN		;IGNORE
10100	
10200	;  BREAK -- STORE BREAK CHAR, FINISH OFF
10300	
10400	DONE:	SKIPE	BRCHAR(CDB)	;USER BRCHAR VAR?
10500		  MOVEM	D,@BRCHAR(CDB)	;STORE BREAK CHAR
10600		MOVE	TEMP,-1(P)	;RELOCATED 1 TO 18
10700		SKIPN	Y,DSPTBL(TEMP)	;WHAT TO DO WITH BREAK CHAR?
10800		JRST	DONE1		;SKIP IT
10900		JUMPL	Y,APPEND	;ADD TO END OF INPUT STRING
11000	
11100	RETAIN:	PUSHJ	P,BACKUP
11200		JRST	DONE1
11300	
11400	APPEND:	IDPB	D,TOPBYTE(USER)	;PUT ON END
11500		AOJA	B,DONE1		;ONE MORE TO COUNT
11600	
11700	
11800	;  DONE -- MARK STRING COUNT WORD
11900	
12000	DONE1:	ADDM	B,REMCHR(USER)	;GIVE UP THOSE NOT USED
12100		SKIPN	ICOUNT(CDB)	;USER SUPPLIED COUNT?
12200		  JRST	[ADDI B,=200	;USER DEFAULT
12300			 JRST .+2]
12400		ADD	B,@ICOUNT(CDB)	;HOW MANY DID WE ACTUALLY GET?
12500	;;#GI# DCS 2-5-72 REMOVE TOPSTR
12600		HRROM	B,-1(SP)	;MARK RESULT, NON-CONSTANT
12700	;;#GI#
12800		MOVE	RF,RACS+RF(USER);GET F-REGISTER BACK
12900		SUB	P,X33		;REMOVE INPUT PARAMETER, RETURN ADDRESS
13000		JRST	@3(P)		;RETURN
13100	
13200	;  CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
13300	;  TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
13400	;  NOT A LINE NUMBER FOR NEXT TIME
13500	
13600	
13700	
13800	
     

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
00500	↑BACKUP:
00600		PUSH	P,1
00700		LDB	1,[POINT 6,OFL(CDB),5]	;BYTE-SIZE
00800		CAIN 	1,44
00900		  JRST	BACKU1
01000	;HERE USE BKJFN	
01100		HRRZ	1,CHNL		;THE JFN
01200		JSYS BKJFN
01300		  ERR <BACKUP:  CANNOT DO RETAIN MODE ON THIS FILE>,1
01400	BACRET:	POP	P,1
01500		POPJ	P,
01600	BACKU1:	SOS	IOBP(CDB)
01700		IBP	IOBP(CDB)
01800		IBP	IOBP(CDB)
01900		IBP	IOBP(CDB)
02000		IBP	IOBP(CDB)
02100		AOS	IOCNT(CDB)
02200		JRST	BACRET
02300	
02400	;LINE NUMBER STUFF
02500	
02600	INLINN:
02700	NOPGNN:
02800		SKIPE	SOSNUM(CDB)	;WANT THE NUMBER?
02900		  JRST 	[MOVE TEMP,@IOBP(CDB)	;SAVE IT FOR THE USER
03000			 MOVEM TEMP,@SOSNUM(CDB)
03100			 JRST .+1]
03200		MOVE	TEMP,-1(P)	;RELOCATED TABLE
03300		SKIPGE	TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
03400		 JRST	 GIVLIN	; WANTS IT NEXT TIME OR SOMETHING
03500	
03600		JSP	TEMP,EATLIN	;TOSS IT OUT, AND 
03700		JRST	.IN		; CONTINUE
03800	
03900	EATLIN:
04000		AOS	IOBP(CDB)	;FORGET IT ENTIRELY
04100		MOVNI	A,5		;INDICATE SKIPPING SIX
04200		ADDB	A,IOCNT(CDB)	;IN COUNT
04300		JUMPGE	A,(TEMP)	;OVERFLOW BUFFER??
04400		PUSHJ	P,DOINP
04500		JRST	OKLN		;36-BIT RETURN
04600		ERR	<INPUT:  7-BIT BYTES CANNOT HAVE LINE NUMBERS>
04700		JRST	DONE1		;END-OF-FILE
04800	OKLN:	
04900		IBP	IOBP(CDB)	;GET OVER TAB FINALLY
05000		SOS	IOCNT(CDB)	;IS THIS RIGHT -- RLS 12/74
05100		JRST	(TEMP)		;AND CONTINUE
05200	
05300	
05400	GIVLIN:	TRNE	TEMP,-1		;WANT LINE NO IN BRCHAR WORD?
05500		 JRST	 GVLLN		;NO, WANTS IT NEXT TIME.
05600		SKIPL	TEMP,@IOBP(CDB)	;NEGATED LINE NO
05700		MOVNS	TEMP
05800		SKIPE	BRCHAR(CDB)	;USER LOCATION?
05900		MOVEM	TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
06000		JSP	TEMP,EATLIN	;GO EAT UP LINE NUMBER AND
06100		JRST	DONE1		;FINISH UP
06200	GVLLN:
06300		SKIPE	BRCHAR(CDB)
06400		  SETOM	@BRCHAR(CDB)	;TELL THE USER
06500		AOS	IOCNT(CDB)	;REVERSE THE SOSLE
06600		MOVE	Y,OFL(CDB)	;NOW CHECK TO SEE IF WE CAN DO THIS WITHOUT DISASTER
06700		TESTN	Y,WRBIT		;WRITING?
06800		TESTE	Y,APPBIT	;OR APPENDING?
06900		  ERR	<INPUT:  Give line feature not implemented when reading and writing.
07000	Continuation will cause the line number to be modified.>
07100		MOVEI	Y,1		;TURN OFF LINE NUMBER 
07200		ANDCAM	Y,@IOBP(CDB)	;  BIT
07300		MOVSI	Y,070000	;BACK UP BYTE POINTER
07400		ADDM	Y,IOBP(CDB)
07500		JRST	DONE1		;FINISH OFF IN BAZE OF GORY
07600	
07700	INPBAD:	ERR <INPUT:  Illegal JFN or bad input>
07800	
     

00100	COMMENT ⊗Realin, Realscan ⊗
00200	
00300	DSCR REAL←REALIN(CHANNEL NUMBER);
00400	CAL SAIL
00500	⊗
00600	
00700	HERE (REALIN)
00800	IFN ALWAYS,<BEGIN NUMIN>
00900	
01000		PUSHJ P,SAVE
01100		PUSHJ P,NUMIN;		GET NUMBER IN A AND TEN EXPONENT IN C
01200		MOVE LPSA,X22
01300		JRST REALFN
01400	
01500	DSCR REAL←REALSCAN(@"STRING");
01600	CAL SAIL
01700	⊗
01800	
01900	HERE (REALSCAN)
02000		PUSHJ P,SAVE
02100		PUSHJ P,STRIN
02200		MOVE LPSA,X33
02300	REALFN:	SETZ D,;		POS SIGN
02400		JUMPE A,ADON
02500		JUMPG A,FPOS
02600		SETO D,;		NUMBER NEGATIVE
02700		MOVNS A
02800	FPOS:	;WE NOW HAVE A POSITIVE NUMBER IN A WITH SIGN IN D
02900		JFFO A,.+1;		NUMBER OF LEADING ZEROS IN B
03000		ASH A,-1(B);		BIT0=0, BIT1=1
03100		MOVN X,B;		BIN EXPONENT -2
03200		JUMPE C,FLO;		IF TEN EXPONENT ZERO THEN FINISH
03300		JUMPL C,FNEG
03400		CAIL C,100;		CHECK BOUND OF EXPOENT
03500		JRST ERROV1
03600		SETZ Y,
03700		JRST TEST
03800	FNEG:	MOVNS C
03900		CAIL C,100
04000		JRST ERROV1
04100		MOVEI Y,6
04200	TEST:	TRNE C,1;		DEPENDING ON LOW ORDER BIT OF EXP
04300		JRST MULT;		EITHER MULTIPLY 
04400	NEXT:	ASH C,-1;		OR DON'T.
04500		AOJA Y,TEST;		INDEX INTO MULTIPLIER TABLE
04600	MULT:	ADD X,.CH.(Y);		EXPONENT
04700		MUL A,.MT.(Y)		;MULTIPLY AND NORMALIZE
04800		TLNE A,200000
04900		 JRST DTEST
05000		ASHC A,1
05100		SOJA X,.+1
05200	DTEST:	SOJG C,NEXT
05300	FLO:	IDIVI A,1B18
05400		FSC A,255
05500		FSC B,234
05600		FADR A,B
05700		SKIPE D
05800		MOVNS A
05900		FSC A,(X);		SCALE
06000		JRST ALLDON
06100		SUBTTL	INTIN	INTEGER NUMBER INPUT ROUTINE	LOU PAUL
     

00100	COMMENT ⊗Intin, Intscan ⊗
00200	
00300	DSCR INTEGER←INTIN(CHANNEL NUMBER);
00400	CAL SAIL
00500	⊗
00600	
00700	HERE (INTIN)
00800		;INTEGER NUMBER INPUT ROUTINE RETURNS VALUE IN A
00900		;USES NUMIN TO PERFORM FREE FIELD SCAN
01000	
01100		PUSHJ P,SAVE
01200		PUSHJ P,NUMIN;		GET NUMBER IN A, TEN EXPONENT IN C
01300		MOVE LPSA,X22
01400		JRST INTFN
01500	
01600	DSCR INTEGER←INTSCAN("STRING");
01700	CAL SAIL
01800	⊗
01900	
02000	HERE (INTSCAN)
02100		PUSHJ P,SAVE
02200		PUSHJ P,STRIN
02300		MOVE LPSA,X33
02400	INTFN:	JUMPE A,ADON
02500		JUMPE C,ADON
02600		JUMPL C,DIVOUT;		IF EXPONENT NEG WE WILL DIVIDE
02700		CAIL C,13
02800		JRST ERROV1
02900		IMUL A,.TEN.(C)
03000		JRST ALLDON
03100	DIVOUT:	MOVNS C
03200		CAIL C,13
03300		JRST [SETZ A,
03400			JRST ADON ]
03500		MOVE C,.TEN.(C)
03600		IDIV A,C
03700		ASH C,-1
03800		CAML B,C;		ROUND POSITIVELY
03900		AOJA A,ALLDON
04000		MOVNS B
04100		CAML B,C
04200		SOJ A,
04300	ALLDON:	JOV ERROV1;		CHECK FOR OVERFLOW
04400	ADON:	MOVEM A,RACS+1(USER)
04500		JRST RESTR
04600	ERROV1:	PUSHJ P,ERROV
04700		JRST ADON
04800		SUBTTL	FREE FIELD NUMBER SCANNER		LOU PAUL
     

00100	DSCR NUMIN
00200	DES THE COMMON ROUTINE USED BY REALIN, REALSCAN, INTIN, ETC.
00300	⊗
00400		;NUMIN PERFORMS A FREE FIELD READ AND RETURNS THE MOST SIGNIFICIANT
00500		;PART OF THE NUMBER IN A AND THE APPROPIATE TENS EXPONENT IN C
00600		;TAKING CARE OF LEADING ZEROS AND TRUNCATION ETC.
00700		;SCANNING IS ACCORDING TO THE FOLLOWING BNF
00800		;<NUMBER>::=<DEL><SIGN><NUM><DEL>
00900		;<NUM>	::=<NO>|<NO><EXP>|<EXP>
01000		;<NO>	::=<INTEGER>|<INTEGER>.|
01100		;	   <INTEGER>.<INTEGER>|.<INTEGER>
01200		;<INTEGER>::=<DIGIT>|<INTEGER><DIGIT>
01300		;<EXP>	::=E<SIGN><INTEGER>|@<SIGN><INTEGER>
01400		;<DIGIT>::=0|1|2|3|4|5|6|7|8|9
01500		;<SIGN>	::=+|-|<EMPTY>
01600		;NULL AND CARR. RET. ARE IGNORED.
01700		;SCANNING IS FACILITATED BY A CHARACTER CLASS TABLE "TAB" AND
01800		;TWO MACROS AHEAD AND ASTERN. THE LEFT HALF OF THE 200+1 WORD TABLE
01900		;CONTAINS -1 IF NOT A DIGIT AND THE VALUE OF THE DIGIT IF IT IS A DIGIT
02000		;THE RIGHT HALF CONTAINS -1 IF A DIGIT AND THE CLASS NUMBER IF NOT.
02100		;CLASS 0	NULL, CARR RET, NOTHING
02200		;CLASS 1	.
02300		;CLASS 2	-
02400		;CLASS 3	+
02500		;CLASS 4	@,E
02600		;CLASS 5	ANY OTHER CHARACETR
02700		;CLASS 6 	END OF FILE
02800		;TAB(200) IS USED FOR FND OF FILE
02900		;MACRO AHEAD IS USED FOR FORWARD SCANNING, ASTERN FOR SCANNING
03000		;THE STACK CONSISTING OF AC Y WHICH HAS CLASS SYMBOLS SHIFTED INTO IT.
03100		DEFINE AHEAD(DIG,POINT,MINUS,PLUS,E,CHA,EOF)<
03200		HRRE X,TAB(D)
03300		JRST @.+2(X)
03400		JUMP DIG
03500		JRST .-4
03600		JUMP POINT
03700		JUMP MINUS
03800		JUMP PLUS
03900		JUMP E
04000		JUMP CHA
04100		JUMP EOF>
04200	
04300		DEFINE ASTERN(NULL,POINT,MINUS,PLUS,E,CHA)<
04400		SETZ X,
04500		LSHC X,3
04600		JRST @.+1(X)
04700		JUMP NULL
04800		JUMP POINT
04900		JUMP MINUS
05000		JUMP PLUS
05100		JUMP E
05200		JUMP CHA
05300		JUMP CHA>
     

00100	;NUMIN -- CONTD.
00200	
00300	NUMIN:
00400		SKIPL	CHNL,-2(P)	;
00500		CAIL	CHNL,JFNSIZE	
00600		  PUSHJ	P,NUMBAD
00700		MOVE	CDB,CDBTBL(CHNL)
00800		SKIPN	CHNL,JFNTBL(CHNL)
00900		  PUSHJ	P,NUMBAD
01000		SKIPE	ENDFL(CDB)
01100		  SETZM	@ENDFL(CDB)
01200		SETZM	.SKIP.
01300		SKIPE	BRCHAR(CDB)
01400		  SETZM	@BRCHAR(CDB)
01500	
01600		MOVE LPSA,[JSP X,NCH]
01700	?NUMSIM:
01800		SIMIO	Z,NUMTBL,NUMBAD		;MOVEI Z,1 -- FOR LINE NUMBER TEST
01900		PUSHJ P,SCAN
02000		SKIPE	BRCHAR(CDB)		;USER WANTS BREAK CHARACTER?
02100		  MOVEM D,@BRCHAR(CDB)		;FIX UP BREAK CHARACTER
02200		SOS	IOBP(CDB)		;BACK UP TO GET IT NEXT TIME
02300		FOR II←1,4 <
02400		IBP	IOBP(CDB)>
02500		AOS	IOCNT(CDB)
02600		POPJ P,
02700	
02800	; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
02900	NCH:	SOSGE IOCNT(CDB);	DECREMENT CHARACTER COUNT
03000		  JRST	NUMINP
03100	
03200	NCH1:	ILDB D,IOBP(CDB);	LOAD BYTE
03300		TDNE Z,@IOBP(CDB);	CHECK FOR LINE NUMBER
03400		JRST NCH5
03500	NCH1.1:	SKIPN	LINNUM(CDB)	;WANT SETPL THINGS?
03600		   JRST	(X)		;NO RETURN
03700		CAIN	D,12		;LINE FEED?
03800		   AOS	@LINNUM(CDB)	;YES
03900		CAIE	D,14		;FORM FEED?
04000		   JRST	(X)		;NOPE, NOTHING
04100		SKIPE	PAGNUM(CDB)
04200		   AOS	@PAGNUM(CDB)	;INCREMENT PAGE COUNTER
04300		SKIPE	LINNUM(CDB)
04400		  SETZM	@LINNUM(CDB)	;AND ZERO LINE COUNTER
04500		JRST (X);		RETURN
04600	
04700	NCH7:	MOVEI D,200		;EOF OR DATA ERROR.
04800		JRST (X)
04900	
05000	NCH5:	SKIPE	SOSNUM(CDB)	;WANT SETPL STUFF?
05100		  JRST	[MOVE	D,@IOBP(CDB)
05200			 MOVEM	D,@SOSNUM(CDB)	;INFORM USER ABOUT LINE NUMBER
05300			 JRST	.+1]
05400		AOS IOBP(CDB);		WE HAVE A LINE NUMBER
05500		MOVNI D,5;		MOVE OVER IT
05600		ADDB D,IOCNT(CDB)
05700		SKIPL	 D		;NOTHING LEFT?
05800		  JRST NCH		;DO ANOTHER INPUT
05900		PUSHJ	P,DOINP		;
06000		  JRST	NCH6		;36-BIT RETURN -- MUST BE
06100		  PUSHJ	P,NUMBAD	;IMPOSSIBLE
06200		  JRST	NCH7		;EOF OR SOME SUCH
06300	
06400	NCH6:	SOSGE IOCNT(CDB);	REMOVE TAB
06500		JRST NCH7		;NONE THERE OR ERROR
06600		IBP IOBP(CDB)
06700		JRST NCH
06800	
06900	;SETUP FOR STRING INPUT (REALSCAN, INTSCAN)
07000	STRIN:	MOVE LPSA,[JSP X,NCHA]
07100		HRRZ Z,-3(P)
07200		HRRZ Z,-1(Z)
07300		HRRZS -3(P)		;SO CAN INDIRECT THROUGH IT.
07400		PUSHJ P,SCAN
07500		HRRZ X,-3(P)
07600		SOS (X)			;BACK UP BYTE POINTER
07700		FOR II←1,4<
07800		IBP (X)>
07900		AOJ Z,
08000		HRRM Z,-1(X)
08100		MOVEM D,@-2(P)		;STORE BREAK CHARACTER
08200		POPJ P,
08300	
08400	;READ A CHARACTER ROUTINE FOR STRINGS.
08500	NCHA:	SOJL Z,NCH7
08600		ILDB D,@-4(P)
08700		JRST (X)
08800	
     

00100	;SCAN (CALLED BY NUMIN AND STRIN)
00200	
00300	SCAN:	JOV .+1
00400		SETO TEMP,		;FLAG REGISTER.
00500		SETZ	Y,
00600		SETZB A,C;		NUMBER		EXPOENT
00700	MORE:	XCT LPSA;		THIS GETS A CHARACTER IN D,200 IF FO EOF
00800		AHEAD(DIG1,STACK,STACK,STACK,STACK,STACK,DONE)
00900	STACK:	LSHC X,-3;		PUSH SYMBOL ONTO STACK "AC Y"
01000		JRST MORE
01100	
01200	DIG1:	SETZ TEMP,;		FLAG REG.
01300		ASTERN(INT1,FRA1,SIG1,SIG2,EXP1,INT1)
01400	
01500	SIG1:	TRO TEMP,4;		NEGATIVE SIGN
01600	SIG2:	ASTERN(INT1,ERR2,ERR5,ERR5,EXP1,INT1)
01700	
01800	EXP1:	MOVEI A,1
01900		ASTERN(EXP2,ERR2,SIG3,SIG4,ERR1,EXP2)
02000	
02100	SIG3:	MOVNS A
02200	SIG4:	ASTERN(EXP2,ERR2,ERR5,ERR5,ERR1,EXP2)
02300	
02400	FRA1:	TRO TEMP,1;		DECIMAL POINT
02500		SOJ C,
02600		ASTERN(INT1,ERR2,SIG5,SIG6,ERR1,INT1)
02700	
02800	SIG5:	TRO TEMP,4;		NEGATIVE SIGN
02900	SIG6:	ASTERN(INT1,ERR2,ERR5,ERR5,ERR1,INT1)
03000	
03100	EXP2:	HLRE FF,TAB(D);		FIRST DIGIT
03200	EXP5:	XCT LPSA;		GET NEXT CHARACTER
03300	EXP9:	HLRE B,TAB(D)
03400		JUMPL B,EEXP;		NEGATIVE IF NOT A DIGIT
03500		IMULI FF,12
03600		ADD FF,B
03700		JRST EXP5
03800	
03900		XCT LPSA
04000	;;#QD# SEE DONE5: BELOW
04100	EEXP:	AHEAD(EXP9,ERR2,DONE5,DONE5,ERR1,EN,EN)
04200	EN:	TRNE TEMP,4;		SIGN OF EXPONENT
04300		MOVNS FF
04400		ADD C,FF;		FIX UP EXPONENT
04500		JOV ERR3
04600	
04700	;#QD# CHANGE ALL 'ERR5'S IN AHEAD MACROS DO 'DONE5'S, TO AVOID SNARFING EXTRA
04800	;SIGNS ..... RFS 12-15-73 (TWO PLACES BELOW AND ONE ABOVE ALSO)
04900	DONE5:
05000	DONE:	ANDI D,177
05100		JUMPGE TEMP,.+2
05200		SETO D,
05300		POPJ P,
05400	
05500	INT1:	HLRE A,TAB(D);		FIRST DIGIT
05600		TRNE TEMP,4
05700		MOVNS A;		NEGATE IF NECESSARY
05800	INT2:	XCT LPSA;		GET NEXT CHARACTER
05900	INT5:	HLRE B,TAB(D)
06000		JUMPL B,EON;		NEGATIVE IF NOT A NUMBER
06100		TRNE TEMP,1;		IF PASSED DECIMAL POINT THEN DEC EXP BY ONE
06200		SOJ C,
06300		TRNE TEMP,2;		IF ENOUGH DIGITS THEN INC EXP BY ONE
06400	INT3:	AOJA C,INT2
06500		MOVE X,A
06600		IMULI A,12
06700		TRNE TEMP,4;		NEGATE DIGIT IS SIGN NEGATIVE
06800		MOVNS B
06900		ADD A,B
07000		JOV INT4;		CHECK FOR OVERFLOW
07100		JRST INT2;		IF SO USE LAST VALUE
07200	
07300	INT4:	TRO TEMP,2
07400		MOVE A,X
07500		JRST INT3
07600	
07700		XCT LPSA
07800	EON:	AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)
07900	
08000	DP1:	TROE TEMP,1
08100		JRST ERR2
08200		XCT LPSA
08300	;#QD# (SEE DONE5: ABOVE)
08400		AHEAD(INT5,ERR2,DONE5,DONE5,EXP6,DONE,DONE)
08500	
08600	EXP6:	SETZ TEMP,
08700		XCT LPSA
08800		AHEAD(EXP2,ERR2,EXP7,EXP8,ERR1,ERR1,ERR1)
08900	
09000	EXP7:	TRO TEMP,4
09100	EXP8:	XCT LPSA
09200	;#QD# (SEE DONE5: ABOVE)
09300		AHEAD(EXP2,ERR2,DONE5,DONE5,ERR1,ERR1,ERR1)
09400	
09500	ERR1:	ERR(<NUMIN: IMPROPER EXPONENT>,1,RZ)
09600	
09700	ERR2:	ERR(<NUMIN: MISPLACED DECIMAL POINT>,1,RZ)
09800	
09900	ERR3:	ERR(<NUMIN: EXPONENT OUT OF BOUND>,1,RZ)
10000	
10100	ERR5:	ERR(<NUMIN: MISPLACED SIGN>,1,RZ)
10200	
10300	ERROV:	ERR(<NUMIN: NUMBER OUT OF BOUND>,1,RZ)
10400	
10500	NUMBAD: ERR<NUMIN:  Illegal JFN, byte-size or mode>
10600		POPJ	P,
10700	
10800	
10900		BEGIN NUMTBL
11000	
11100	↑NUMTBL:JRST	DOSETCI				;0 -- XNULL
11200		MOVEI	Z,1				;1 -- XICHAR
11300		JRST	.COSCI				;2 -- XOCHAR
11400		JRST	.WISCI				;3 -- XIWORD
11500		JRST	.WOSCI				;4 -- XOWORD
11600		MOVEI	Z,1				;5 -- XCICHAR
11700		REPEAT 2,<JRST	NUMBAD>			;6,7
11800		MOVEI	Z,1				;10 -- XBYTE7
11900		MOVEI	Z,1				;11 -- XDICHAR
12000		REPEAT 2,<JRST NUMBAD>			;12,13
12100	
12200	DOSETCI:
12300		PUSHJ	P,SETCI
12400		JRST	NUMSIM
12500		
12600	.COSCI:	PUSHJ	P,COSCI
12700		JRST	NUMSIM
12800	
12900	.WISCI:	PUSHJ	P,WISCI
13000		JRST	NUMSIM
13100	
13200	.WOSCI:	PUSHJ	P,WOSCI
13300		JRST	NUMSIM
13400	
13500		BEND NUMTBL
13600	
13700	NUMINP:	PUSHJ	P,DOINP
13800		JRST	NCH				;BUFFERED INPUT
13900		JRST	NCH1.1				;7-BIT
14000		JRST	NCH7				;EOF OR ERROR
14100	
14200	
14300	RZ:	SETZ A,
14400		JRST DONE
     

00100	;   Character table for SCAN (Realscan,Intscan,Realin,Intin)
00200	TAB:	FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
00300	>
00400		FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
00500	>
00600		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
00700	>
00800	;#QC# MAKE 32 (CONTROL Z) IGNORED
00900		FOR A IN (5,5,0,5,5,5,5,5)<XWD -1,A
01000	>
01100		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
01200	>
01300		FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
01400	>
01500		FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
01600	>
01700		FOR A IN (5,5,5,5,5,5)<XWD -1,A
01800	>
01900		FOR A IN (4,5,5,5,5,5,5,5)<XWD -1,A
02000	>
02100		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02200	>
02300		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02400	>
02500		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02600	>
02700		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02800	>
02900		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03000	>
03100		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03200	>
03300		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03400	>
03500		XWD -1,6
03600	
03700	ENDCOM(NUM)
03800	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),DOSOUT
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	;USE BOUTS SINCE SOUT DOESNT WORK AT IMSSS
02100	DOSOUT:	HRRZ	3,-1(SP)
02200		JUMPE	3,SOURET
02300	SOUT1:	ILDB	2,(SP)		;NEXT CHAR
02400		JSYS	BOUT
02500		SOJG	3,SOUT1		;STRING CHAR COUNT
02600		JRST	SOURET
02700		
02800	CERR:	ERR <OUT:  Illegal JFN, byte-size, or mode>,
02900		JRST 	SOURET
03000	
03100	TABL:	JRST	DOSETCO		;0 -- XNULL
03200		JRST	.CISCO		;1 -- XICHAR	
03300		HRRZ 3,-1(SP)		;2 -- XOCHAR
03400		JRST	.WISCO		;3 -- XIWORD
03500		JRST	.WOSCO		;4 -- XOWORD
03600		JRST	CERR		;5 -- XCICHAR
03700		HRRZ 3,-1(SP)		;6 -- XCOCHAR
03800		JRST	CERR		;7 -- XCWORD	
03900		JRST	DOSOUT		;10 -- XBYTE7
04000		JRST	CERR		;11 -- XDICHAR
04100		HRRZ 3,-1(SP)		;12 -- XDOCHAR
04200		JRST	CERR		;13 -- XDARR
04300	
04400	DOSETCO:	
04500		PUSHJ	P,SETCO
04600		JRST	DOSIMIO
04700	
04800	.CISCO:	PUSHJ	P,CISCO
04900		JRST	DOSIMIO
05000	
05100	.WISCO:	PUSHJ	P,WISCO
05200		JRST	DOSIMIO
05300	
05400	.WOSCO:	PUSHJ	P,WOSCO
05500		JRST	DOSIMIO
05600	
05700		BEND OUT
05800	
     

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	2,FDBSZ(CDB)
03200		  JRST	POPBACK
03300		MOVE	3,FDBEOF(CDB)
03400		CAIN	2,=7				;7-BIT?
03500		  JRST	RET				;YES, RETURN
03600		CAIE	2,=36
03700		  ERR 	<GETCND:  File byte size is neither 36 or 7>,1
03800		IMULI	3,5				;CONVERT TO CHARACTERS
03900	RET:	MOVEM	3,2				;RESULT IN 2
04000	POPBACK:POP	P,3
04100		POPJ	P,	
04200		BEND GETCND
04300	
04400		BEGIN GETCPT
04500	;ROUTINES FOR CHAR EOB
04600	
04700	↑↑GETCPT:
04800	;1,CDB LOADED
04900	;RETURNS IN 2 THE END OF BUFFER CHARACTER
05000		SKIPN	2,IOBP(CDB)
05100		  POPJ	P,				;RETURN 0
05200		PUSH	P,3
05300		TLZ	2,007700
05400		TLO	2,000700			;MAKE A 7-BIT POINTER
05500		IBP	2				;INCREMENT
05600		HRRZM	2,3				;ADDRESS	
05700		HRRI	2,BYTES
05800		LDB	2,2
05900		SUB	3,IOADDR(CDB)			;SUBTRACT
06000		IMULI	3,5				;CHARACTERS
06100		ADDI	3,(2)				;PLUS THESE IN EXTRA WORD
06200		MOVE	2,IOPAGE(CDB)
06300		IMULI	2,1000*5			;PREVIOUS PAGES IN THE FILE
06400		ADDI	2,(3)				;PLUS THESE
06500		POP	P,3
06600		POPJ	P,				;RETURN IN 2
06700	
06800	
06900	↑↑GTCPT1:
07000	;1, CHNL, CDB loaded
07100	;call PUSHJ
07200	;returns the following
07300	;	2	how many characters until the end of the buffer
07400	;	3	bp to first free character
07500	;	4	count for character output
07600	;	5	count for character input
07700		SKIPN	3,IOBP(CDB)
07800		  JRST	RET
07900		TLZ	3,007700
08000		TLO	3,000700			;MAKE A 7-BIT POINTER
08100		MOVEM	3,2				;COPY IN 2
08200		IBP	2
08300		HRRZM	2,4				;ADDRESS
08400		HRRI	2,BYTES				
08500		LDB	2,2				;NUMBER OF ADDTL CHARS
08600		SUB	4,IOADDR(CDB)			;ADDRESS OF BUFFER
08700		IMULI	4,5
08800		ADDI	4,(2)
08900		MOVE	2,IOPAGE(CDB)
09000		IMULI	2,1000*5
09100		ADDI	2,(4)
09200		MOVNI	4,(4)
09300		ADDI	4,1000*5
09400		MOVEM	2,5				;SAVE 2
09500		PUSHJ	P,GETCND			;GET CHAR EOF
09600		EXCH	5,2
09700		SUB	5,2
09800		CAML	5,4
09900		  MOVEM	4,5
10000		POPJ	P,
10100	
10200	BYTES:	BYTE (7) 0,1,2,3,4
10300	
10400	RET:	SETZB	2,3				;NOT INITIALIZED
10500		SETZB	4,5
10600		POPJ	P,
10700	
10800		BEND GETCPT
10900	
11000	CHCEOF:	
11100	;CHECKS TO SEE IF CHARACTER EOF POINTER NEEDS RESETTING
11200	;1, CDB LOADED
11300		SKIPN	IOBP(CDB)			;DONT CHECK IF NOTHING THERE
11400		  POPJ	P,
11500		PUSH	P,2
11600		PUSH	P,3
11700		PUSHJ	P,GETCND			;GET CHARACTER EOF IN 2
11800		MOVEM	2,3				;SAVE IN 6
11900		PUSHJ	P,GETCPT			;GET CHARACTER EOB IN 2	
12000		CAML	2,3				;NEED RESETTING?
12100		  PUSHJ	P,SETCND			;YES
12200		POP	P,3
12300		POP	P,2
12400		POPJ	P,
12500	
     

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			;AOS 3,IOPAGE(CDB)
02100		IMULI	3,1000*5			;NEXT CHARACTER
02200		PUSHJ	P,GETCND			;CHARACTER EOF IN 2
02300		CAML	3,2				;IS IT BEYOND
02400		  JRST	ADEOF				;YES -- CONFESS THAT IT IS
02500		SUB	2,3
02600		CAILE	2,1000*5			;LESS THAN A FULL BUFFER
02700		  MOVEI	2,1000*5			;NO
02800		MOVEM	2,IOCNT(CDB)
02900		MOVE	2,IOPAGE(CDB)
03000		PUSHJ	P,SETPAGE			;GET NEXT PAGE
03100		MOVE	2,IOADDR(CDB)
03200		HRLI	2,440700			;MAKE A BYTE-POINTER
03300		MOVEM	2,IOBP(CDB)
03400	ADRET:	AOS	-3(P)				;INCREMENT PC WORD
03500	ADEOF:	POP	P,3				;EOF --  DONT INCREMENT
03600		POP	P,2
03700		POP	P,1
03800		POPJ	P,				;RETURN
03900	
04000	TABL:	JRST	ADCERR				;0 -- XNULL
04100		AOS	3,IOPAGE(CDB)			;1 -- XICHAR
04200		REPEAT 3,<JRST ADCERR>			;2-4
04300		JRST	DOSIN				;5 -- XCICHAR
04400		REPEAT 3,<JRST ADCERR>			;6-10
04500		JRST	DODUMPI				;11 -- XDICHAR
04600		REPEAT 2,<JRST	ADCERR>			;12,13
04700	
04800	ADCERR:	ERR	<Dryrot at ADCI>,1
04900		JRST	ADEOF
05000	
05100	
05200	DOSIN:	MOVE	2,IOADDR(CDB)
05300		HRL	3,2
05400		HRRI	3,1,(2)
05500		SETZM	(2)
05600		BLT	3,777(2)
05700		HRLI	2,444400
05800		MOVNI	3,1000
05900		JSYS	SIN
06000		CAMG	3,[-1000]
06100		  JRST	[CAMN	3,[-1000]		;EOF?
06200			  JRST	ADEOF
06300			 JRST .+1]
06400		ADDI	3,1000				;NUMBER OF WORDS READ
06500		IMULI	3,5				;NUMBER OF CHARACTERS
06600	STOCNT:	MOVEM	3,IOCNT(CDB)
06700		MOVE	2,IOADDR(CDB)
06800		HRLI	2,440700
06900		MOVEM	2,IOBP(CDB)
07000		JRST	ADRET				;AND RETURN
07100	
07200	DODUMPI:
07300		PUSH	P,1				;SAVE JFN OVER POSSIBLE DUMPI ERROR
07400		PUSH	P,4
07500		MOVE	3,IOADDR(CDB)
07600		HRL	2,3
07700		HRRI	2,1(3)
07800		SETZM	(3)
07900		BLT	2,777(3)	
08000		SOJ	3,
08100		HRLI	3,-1000				;MAKE AN IOWD
08200		MOVEI	2,3				;COMMAND LIST STARTS AT 3
08300		SETZ	4,				;AND ENDS AT 4
08400		JSYS	DUMPI
08500		  JRST	DMIERR
08600		MOVEI	3,1000*5
08700		POP	P,4
08800		POP	P,1
08900		JRST	STOCNT
09000	
09100	DMIERR:	CAIE	1,600220			;EOF?
09200		  ERR	<ADCI:  Dump mode input error>,1
09300		POP	P,4				;RESTORE
09400		POP	P,1				;PRECIOUS JFN
09500		MOVE	2,DVTYP(CDB)			;GET DEVICE TYPE
09600		CAIE	2,3				;MAGTAPE?
09700		  JRST	ADEOF				;NO, JUST INDICATE EOF
09800		SETZ	2,				;MTOPR RESET
09900		JSYS	MTOPR
10000		JRST	ADEOF				;AND SAY WE ARE AT THE END OF THE FILE
10100	
10200	
10300		BEND ADCI
     

00100	DOINP:
00200	;CHNL has the JFN
00300	;CDB has the channel data block
00400	;returns +1 for good buffered input
00500	;	 +2 for 7-bit input with char in D
00600	;	 +3 for eof or error
00700		BEGIN DOINP
00800		PUSH	P,1				;SAVE 1
00900		PUSH	P,2
01000		MOVE	1,CHNL				;JFN
01100		MOVE	D,IOSTT(CDB)			;D IS FREE
01200		CAIE	D,XBYTE7			;7-BIT?
01300		  JRST	DOBUFF
01400		JSYS	BIN
01500		JUMPE	2,CHKEOF			;IF 0 MAY BE EOF
01600		MOVEM	2,D				;STORE 
01700		MOVE	2,DVTYP(CDB)			;IS THE DEVICE A TTY?
01800		CAIE	2,12				;
01900		  JRST	DOB7				;NO
02000		CAIN	D,32				;A CONTROL-Z?
02100		  JRST	DOIEOF				;YES INDICATE EOF
02200		CAIN	D,37				;PHONEY BBN EOL?
02300		  MOVEI	D,12				;A LINE-FEED
02400		JRST	DOB7				;AND RETURN
02500	
02600	CHKEOF:	JSYS	GTSTS				;BETTER CHECK
02700		TESTE	2,1B8			
02800		  JRST	DOIEOF				;YEP
02900		SETZ	D,
03000		JRST	DOB7
03100	
03200	DOIEOF:	SETOM	.SKIP.
03300		SKIPE	ENDFL(CDB)			;SPECIFIED?
03400		  SETOM	@ENDFL(CDB)			;YES
03500		AOS	-2(P)
03600	DOB7:	AOS	-2(P)
03700	DORET:	POP	P,2
03800		POP	P,1
03900		POPJ	P,
04000	
04100	
04200	DOBUFF:
04300		PUSHJ	P,ADCI
04400		  JRST	DOIEOF				;INDICATE EOF
04500		JRST	DORET
04600	
04700		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
02400		AOS	2,IOPAGE(CDB)	;NEXT PAGE
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,XDICHAR	;BETTER BE DUMP-MODE
04100		  ERR	<Dryrot at ADCO>,1
04200		MOVE	3,IOADDR(CDB)
04300		MOVEI	4,DMOCNT*5
04400		CAMG	4,IOCNT(CDB)	;ANY CHARS TO SEND
04500		  JRST	ADRET
04600		
04700		MOVEI	2,3
04800		SUBI	3,1
04900		MOVNI	4,DMOCNT	;WORD COUNT FOR DUMP MODE OUTPUT	
05000		HRL	3,4		;MAKE AN IOWD
05100		SETZ	4,		;MAKE A COMMAND LIST
05200		JSYS DUMPO
05300		  ERR <DUMPOUT:  CANNOT WRITE DATA IN DUMP MODE>,1
05400		SETOM	DMPED(CDB)	;AND INDICATE DONE
05500	DMPINIT:
05600		MOVE	3,IOADDR(CDB)
05700		HRL	2,3
05800		HRRI	2,1(3)
05900		SETZM	(3)
06000		BLT	2,DMOCNT-1(3)	;ZERO OUT
06100		MOVEI	2,DMOCNT*5	
06200		MOVEM	2,IOCNT(CDB)	;SAVE COUNT
06300		HLL	3,[POINT 7,0,-1];FIX A BYTE-POINTER
06400		MOVEM	3,IOBP(CDB)	;AND SAVE BYTE-POINTER
06500		JRST	ADRET
06600	
06700	STRSOU:	
06800		MOVEI	3,1000*5
06900		SUB	3,IOCNT(CDB)	;NUMBER OF CHARACTERS ACTUALLY IN BUFFER
07000		IDIVI	3,5		;NUMBER OF WORDS
07100		SKIPE	4		;ANY REMAINDER?
07200		   AOJ	3,		;YES, ANOTHER WORD FOR EXTRA CHARACTERS
07300		JUMPE	3,ADRET		;RETURN IF NO CHARACTERS TO SEND
07400		MOVN	3,3		;NEGATIVE WORD COUNT FOR SOUT
07500		MOVE	2,IOADDR(CDB)
07600		HRLI	2,444400	;MAKE A BP
07700		JSYS SOUT
07800	SOUINIT:
07900		MOVE	2,IOADDR(CDB)
08000		HRL	3,2
08100		HRRI	3,1(2)
08200		SETZM	(2)
08300		BLT	3,777(2)	;CLEAR OUT PAGE
08400		HRLI	2,440700
08500		MOVEM	2,IOBP(CDB)
08600		MOVEI	3,1000*5
08700		MOVEM	3,IOCNT(CDB)
08800		JRST	ADRET
08900	
09000		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,XOWORD,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:	SETZM	DMPED(CDB)			;RESET VALUES TO ORIGINALS
02500		SETZM	IOCNT(CDB)
02600		SETZM	IOBP(CDB)
02700		SETZM	IOSTT(CDB)
02800		SETOM	IOPAGE(CDB)			;N.B.
02900		SETO	1,				;DESTROY PAGE -- NOTE: CLOBBERS JFN 
03000	 	MOVE	2,FKPAGE(CDB)			;UNTIL POP BELOW
03100		SETZ	3,
03200		JSYS	PMAP
03300	POPBACK:POP	P,6
03400		POP	P,5
03500		POP	P,4
03600		POP	P,3
03700		POP	P,2
03800		POP	P,1
03900		POPJ	P,
04000	
04100	TABL:	JRST	POPBACK				;0 -- XNULL
04200		JFCL					;1 -- XICHAR
04300		PUSHJ	P,CHCEOF			;2 -- XOCHAR -- POPJ RETURN
04400		JFCL					;3 -- XIWORD
04500		PUSHJ	P,CHWEOF			;4 -- XOWORD
04600		JFCL					;5 -- XCICHAR
04700		PUSHJ	P,ADCO				;6 -- XCOCHAR
04800		JFCL					;7 -- XCWORD
04900		JFCL					;10 -- XBYTE7
05000		JFCL					;11 -- XDICHAR
05100		JRST	XDO1				;12 -- XDOCHAR
05200		JRST	XDO2				;13 -- XDARR
05300		
05400	
05500	XDO1:	PUSHJ	P,ADCO				;WRITE OUT WHATEVER IS THERE		
05600	XDO2:	SKIPN	DMPED(CDB)			;DUMP MODE OUTPUT SEEN?
05700		  JRST	UNMAP				;NOPE
05800		MOVE	2,DVTYP(CDB)			;DEVICE TYPE
05900		CAIE	2,2				;MAGTAPE?
06000		  JRST	UNMAP				;NOPE
06100		MOVEI	2,3				;EOF
06200		JSYS	MTOPR				;WRITE TWO
06300		JSYS	MTOPR		
06400		MOVEI	2,17				;BACKSPACE OVER 1 EOF
06500		JSYS	MTOPR
06600		JRST	UNMAP
06700	
06800	
06900		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		MOVEM	2,RACS+A(USER)		;ANSWER IN 2
01000	RFBRET:	JRST	RESTR
01100	
01200	RFBBAD: ERR <Illegal JFN>,1
01300		JRST	RFBRET
01400	
01500	ENDCOM(BINROU)
01600	
     

00100	IMSSS,<
00200	COMPIL(DSKOPS,<DSKIN,DSKOUT>
00300		,<JFNTBL,CDBTBL,.SKIP.>
00400		,<DSKOPS -- DIRECT DSK ROUTINES>)
00500	
00600	DSCR SIMPLE PROCEDURE 
00700	DSKIN(INTEGER MODULE,RECNO,COUNT; REFERENCE INTEGER LOC);
00800	
00900		IMSSS only.
01000		Does direct IO from the DSK (formerly device "PAK").
01100	Modules 4-7 are legal for everyone.  Other modules require enabled
01200	status.
01300		Count words are read into user's core at location LOC, from
01400	MODULE, record RECNO.  Error bits are in .SKIP.
01500		Does the DSKOP jsys (as modified at IMSSS).
01600	⊗
01700	
01800		BEGIN DSKOPS
01900	HERE(DSKIN)
02000		PUSHJ	P,SAVE
02100		SETZ	4,		;INDICATE READ ONLY
02200	
02300	DSK1:	HRRZ	2,-2(P)
02400		JUMPLE	2,DSBAD	;LEQ 0 -- ERROR
02500		CAILE	2,1000		;DONT READ MORE THAN 1000 WORDS
02600		   JRST DSBAD
02700		IOR	2,4		;PICK UP READ OR WRITE (SET IN 4)
02800		HRLZ	1,-4(P)		;MODULE
02900		HRR	1,-3(P)		;RECORD NO. IN RIGHT HALF
03000		TLO	1,600000	;SOFTWARD ADDRESS, IMSSS FORMAT (BITS 0 AND 1 RES.)
03100		HRRZ 	3,-1(P) 		; GET THE USER LOCATION
03200	    	JSYS DSKOP
03300	DSDUN:	MOVEM 1,.SKIP.		; SAVE ERROR BITS
03400	DSRET:	MOVE 	LPSA,[XWD 5,5]	; TO ADJUST STACK
03500		JRST	RESTR
03600	DSBAD:	ERR <DSKIN OR DSKOUT:  WORD COUNT EITHER <= 0 OR > '1000>,1
03700		SETOM	.SKIP.
03800		JRST	DSRET
03900	
04000	
04100	
     

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		PUSHJ	P,SAVE
00800		MOVSI	4,(1B14)	;INDICATE WRITE (TO BE IOR'ED INTO AC 2)
00900		JRST	DSK1		;AND TO THE ABOVE CODE
01000	
01100		BEND DSKOPS
01200	
01300	ENDCOM(DSKOP)
01400	>;IMSSS
01500	
     

00100	COMPIL(DEVS,<DEVTYPE,DVCHR,ERSTR>
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	ENDCOM(DEVS)
02800	
     

00100	COMPIL(UTILITY,<SETCHN,ZSETST,ZADJST,.RESET>
00200		,<CORGET,GOGTAB,JFNTBL,CDBTBL,STRNGC,INSET>
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,IOTLEN
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,IOTLEN-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		MOVEI	2,STARTPAGE(D)		;PAGE FOR BUFFER
04500		HRLI	2,400000		;THIS FORK
04600		MOVEM	2,FKPAGE(CDB)		;XWD FORK,PAGE FOR PMAPPING
04700		LSH	2,9			;MAKE AN ADDRESS
04800		MOVEM	2,IOADDR(CDB)		;AND SAVE IT AS WELL
04900		SETOM	IOPAGE(CDB)		;DENY THAT THERE IS A PAGE THERE
05000		HRRZ	A,D			;CHANNEL INTO A
05100		POP	P,D			;RESTORE
05200		POP	P,C			
05300		POP	P,B
05400		POPJ	P,
05500	
05600	
05700	;FIND AN OPEN CHANNEL AND RETURN THE NUMBER IN D
05800	;A HAS THE JFN NO. IN IT, SO CHECK TO SEE IF THE SAME
05900	;B MAY BE CLOBBERED
06000	FNDCHN:	HRRZ	D,JFNTBL(A)		;CHECK OLD JFN
06100		CAIE	D,(A)			;SAME AS THE NEW?
06200		  JRST  FNDCH2			;NO
06300		MOVE	CDB,CDBTBL(D)		;GET OLD CDB
06400		MOVE	B,CDB			;COPY CDB ADDR FOR BLT
06500		JRST	CLCDB			
06600	
06700	FNDCH2:	SETZ	D,
06800	FNDCH1:	CAIL	D,JFNSIZE
06900		   ERR <SETCHN:  JFN TABLE IS FULL (SHOULD NEVER HAPPEN)>
07000		SKIPE	CDBTBL(D)		;IS IT EMPTY?
07100		  AOJA	D,FNDCH1	   	;NO LOOK SOME MORE
07200		JRST	GTCDB			;YES, USE IT
07300	
07400	
07500	DSCR SIMPLE INTEGER PROCEDURE ZSETST(INTEGER I);
07600	
07700		Internal book-keeping routine not intended for
07800	use from SAIL.  Causes liberation from SAIL.
07900	
08000		THE ARGUMENT IS THE MAXIMUM SIZE OF THE EXPECTED STRING.
08100	THE RETURN IS THE BYTEPOINTER POINTING INTO THE TOP OF STRING SPACE
08200	⊗
08300	
08400	HERE(ZSETST)
08500		MOVE USER,GOGTAB 		; GET USER
08600		SKIPE	SGLIGN(USER)
08700		  PUSHJ	P,INSET			;ASSUMING THAT IT IS TRANSPARENT FOR THE ACS
08800		MOVE	1,-1(P)		;GET EXPECTED LENGTH
08900		ADDM 1,REMCHR(USER) 		; ADD ON
09000		SKIPLE REMCHR(USER) 		; NEED TO COLLECT?
09100		  PUSHJ P,GOCOLLECT 		; YES
09200		MOVE 1,TOPBYTE(USER) 		; RETURN BP
09300		SUB P,X22 			; ADJUST STACK
09400		JRST @2(P) 			; RETURN
09500	
09600	GOCOLLECT:	
09700		MOVEM	RF,RACS+RF(USER)	;SAVE RF
09800		PUSHJ P,STRNGC ;
09900		POPJ P, 			; RETURN TO ABOVE
10000	
     

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,TOPBY∃E(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		SETO	1,			;RELEASE PAGE
02200		SETZ	3,			;FLAGS WORD
02300		MOVE	2,[XWD 400000,STARTPAGE]
02400	.RESE1:	CAMN	2,[XWD 400000,STARTPAGE+JFNSIZE]	;THIS WOULD BE TOO MANY PAGES
02500		  JRST .RESE2
02600		JSYS	PMAP			
02700		AOJA	2,.RESE1		;NEXT?
02800	
02900	.RESE2:
03000		JSYS RESET		;CLEAR ALL IO
03100	
03200	;SET UP PSI SYSTEM
03300		HRRZI	1,400000	;USE EXISTING TABLE IF THERE
03400		JSYS	RIR
03500		JUMPN	2,.+3		;ALREADY THERE
03600		MOVE	2,[XWD LEVTAB,CHNTAB]
03700		JSYS	SIR
03800		JSYS	EIR		;TURN ON INTERRUPTS
03900	
04000	;CHECK AND SEE IF WE ARE DETACHED
04100		JSYS	GJINF
04200		CAMN	4,[-1]		;-1 FOR DETACHED JOBS
04300		  JRST	DTCHED		;YES IT IS DETACHED
04400	
04500	;SET PRIMARY INPUT TO WAKE UP ON EVERY CHARACTER
04600	;THE USER MAY RESET THIS.
04700		MOVEI	1,100		;PRIMARY INPUT
04800		JSYS RFMOD
04900		TRO	2,170000	;WAKEUP ON ALL CHARS
05000		JSYS SFMOD
05100	DTCHED:	SETZM	CTLOSW		;CLEAR OUTPUT-SUPPRESSION SWITCH
05200	
05300		JRST	(P)		;AND RETURN
05400	BEND RESET
05500	
05600	;ROUTINE TO CHECK IF A JFN HAS BEEN CLOSED BY ONE OF
05700	;THE DEC-STYLE CLOSE ROUTINES (IN WHICH CASE IT
05800	;MUST BE AVAILABLE FOR RE-OPENING)
05900	;ARGS:
06000	;	1	JFN
06100	;	CDB	THE CHANNEL DATA BLOCK
06200	↑OPNCHK:
06300		SKIPL	IOSTT(CDB)		;CLOSED BY DEC?
06400		   POPJ P,			;NO
06500		PUSH	P,2			;SAVE 2
06600		MOVE	2,OFL(CDB)		;PREVIOUSLY USED FLAGS
06700		JSYS	OPENF			;OPEN
06800		   ERR <OPNCHK:  Cannot OPENF file>,1
06900		SETZM	IOSTT(CDB)
07000		POP	P,2			;RESTORE 2
07100		POPJ	P,			;RETURN
07200	
07300	ENDCOM(UTILITY)
     

00100	COMPIL(TTM,<RFMOD,SFMOD,STPAR,STI,RFCOC,SFCOC,GTTYP,STTYP>
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		JRST	RESTR
06900	STPAR1:	MOVE	1,-2(P)		;USE LITERALLY
07000		JRST	STPAR2
07100	
07200	HERE(STI)
07300		PUSHJ	P,SAVE
07400		MOVE	LPSA,X33
07500		VALCH1	1,-2(P),STI1
07600	STI2:	MOVE	2,-1(P)
07700		JSYS	STI
07800		JRST	RESTR
07900	STI1:	MOVE	1,-2(P)		;USE LITERALLY
08000		JRST	STI2
08100		
08200	
08300	HERE(RFCOC)
08400		PUSHJ	P,SAVE
08500		MOVE	LPSA,X44
08600		VALCH1	1,-3(P),RFCO1
08700	RFCO2:	JSYS	RFCOC
08800		MOVEM	2,@-2(P)
08900		MOVEM	3,@-1(P)
09000		JRST	RESTR
09100	RFCO1:	MOVE	1,-3(P)		;USE LITERALLY
09200		JRST 	RFCO2
09300	
09400	HERE(SFCOC)
09500		PUSHJ	P,SAVE
09600		MOVE	LPSA,X44
09700		VALCH1	1,-3(P),SFCO1
09800	SFCO2:	MOVE	2,-2(P)
09900		MOVE	3,-1(P)	
10000		JSYS	SFCOC
10100		JRST	RESTR
10200	SFCO1:	MOVE	1,-3(P)		;USE LITERALLY
10300		JRST	SFCO2
10400	
10500	HERE(GTTYP)
10600		PUSHJ	P,SAVE
10700		MOVE	LPSA,X33
10800		VALCH1	1,-2(P),GTTYP1
10900	GTTYP2:	JSYS	GTTYP
11000		MOVEM	2,RACS+A(USER)	;TERMINAL TYPE NUMBER FOR RETURN
11100		MOVEM	3,@-1(P)	;XWD INBUFS, OUTBUFS
11200		JRST	RESTR
11300	GTTYP1:	MOVE	1,-2(P)		;USE LITERALLY
11400		JRST	GTTYP2
11500	
11600	HERE(STTYP)
11700		PUSHJ	P,SAVE
11800		MOVE	LPSA,X33
11900		VALCH1	1,-2(P),STTYP1
12000	STTYP2:	MOVE	2,-1(P)		;NEW TERMINAL TYPE
12100		JSYS	STTYP
12200		JRST	RESTR
12300	STTYP1:	MOVE	1,-2(P)		;USE LITERALLY
12400		JRST	STTYP2
12500	
12600	ENDCOM(TTM)
12700	
     

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	IMSSS,<
00200	COMPIL(TT2,<PBTIN,INTTY>
00300		,<X22,.SKIP.,ZSETST,ZADJST,CTLOSW>
00400		,<TT2 -- IMSSS TTY ROUTINES>)
00500	
00600	DSCR INTEGER SIMPLE PROCEDURE PBTIN(INTEGER SECONDS);
00700	DESR 
00800		Executes the PBTIN jsys, with timing of SECONDS.
00900	⊗
01000	HERE(PBTIN)
01100		SETZM	CTLOSW			;PROGRAM REQUESTS INPUT
01200		MOVE	1,-1(P)			;TIME IN SECONDS
01300		JSYS PBTIN
01400		SUB	P,X22
01500		JRST	@2(P)
01600	
     

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.  For fancier calls, see PSTIN routine.
00600	⊗
00700	
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	
03500	
03600	ENDCOM(TT2)
03700	>;IMSSS
03800	
     

00100	NOIMSSS<;NON-IMSSS VERSION OF INTTY FOR THOSE WHO SUFFER
00200	;UNDER BBN'S LACK OF A SYSTEM LINE EDITOR
00300	
00400	COMPIL(TT2,<INTTY>
00500		,<X11,.SKIP.,ZSETST,ZADJST,CTLOSW,SAVE,RESTR>
00600		,<TT2 -- INTTY FOR TENEX STYLE INPUT>)
00700	DSCR INTTY
00800	
00900	
01000	⊗;
01100	HERE(INTTY)
01200		BEGIN INTTY
01300	ORIGCNT←←=200
01400	;AC USES  A,B,C  JSYS TEMPORARIES
01500	;	  D	 BYTEPOINTER
01600	;	  E	 COUNT, INITIALLY 0
01700	;	  Q1 (=6) ORIGINAL BP
01800	
01900	
02000		PUSHJ	P,SAVE
02100		SETZM	CTLOSW
02200		MOVEI	A,101
02300		JSYS	RFMOD
02400		PUSH	P,B			;SAVE THE TTY MODE
02500		TRO	B,170000		;WAKEUP ON EVERYTHING
02600		JSYS	SFMOD
02700		
02800		PUSH	P,[ORIGCNT]		;
02900		PUSHJ	P,ZSETST		;GET A GOOD BP IN A
03000		MOVE	Q1,A
03100	
03200	
03300	
03400	RESTRT:	MOVE	D,Q1			;GET THE ORIGINAL BP	
03500		SETZ	E,			;ZERO THE COUNT
03600	INLUP:	CAIL	E,ORIGCNT
03700		  JRST	CNTEXH			;COUNT EXHAUSTED
03800		JSYS	PBIN			;GET A CHAR
03900		CAIE	A,37			;EOL?
04000		CAIN	A,33			;ESCAPE?
04100		  JRST	DONE
04200		CAIE	A,32			;CTRL-Z
04300	 	CAIN	A,7			;CTRL-G
04400		  JRST	DONE
04500		CAIE	A,"R"-100		;CTRL-R FOR REPEAT
04600		  JRST	NOCTR	
04700		HRROI	A,[ASCIZ/
04800	/]
04900		JSYS	PSOUT
05000		JUMPE	E,INLUP
05100		MOVEI	A,101
05200		MOVE	B,Q1			;ORIG BP
05300		MOVN	C,E			;COUNT THUS FAR
05400		JSYS	SOUT
05500		JRST	INLUP			;AND CONTINUE
05600	NOCTR:	CAIE	A,"X"-100		;CONTROL-X FOR DELETE LINE
05700		  JRST	NOCTX
05800	DOCTX:	HRROI	A,[ASCIZ/
05900	/]
06000		JSYS	PSOUT
06100		JRST	RESTRT			;AND START ALL OVER
06200	NOCTX:	CAIE	A,177			;RUBOUT OR
06300		CAIN	A,"A"-100		;CONTROL-A
06400		  JRST	.+2
06500		 JRST	NOCTA
06600		JUMPLE	E,DOCTX			;IF NO CHARS THEN DO A CONTROL-X
06700		MOVEI	A,"\"
06800		JSYS	PBOUT
06900		LDB	A,D			;LAST CHAR
07000		JSYS	PBOUT	
07100		MOVE	A,D
07200		JSYS	BKJFN
07300		  JFCL
07400		MOVEM	A,D			;BACK UP BP
07500		SOJA	E,INLUP			;SUBTRACT 1 AND CONTINUE
07600	NOCTA:	IDPB	A,D
07700		AOJA	E,INLUP			;ONE MORE CHAR	
07800	
07900	CNTEXH:	SETO	A,			;INDICATE NO COUNT
08000	DONE:	MOVEM	A,.SKIP.		;BREAK CHAR, -1 FOR EXHAUSTED
08100		PUSH	P,[ORIGCNT]	
08200		PUSH	P,D			;NEW BP
08300		PUSHJ	P,ZADJST		;FIX UP STRING SPACE, PUT STRING ON STACK
08400		MOVEI	A,101
08500		POP	P,B			;MODE SETTING
08600		JSYS	SFMOD			;RESET
08700		MOVE	LPSA,X11
08800		JRST	RESTR			;AND RETURN
08900	
09000		BEND INTTY
09100	ENDCOM(TT2)
09200	>;NOIMSSS
     

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
05400	>
05500		  ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,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	CHNL,@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,CHNL
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	
25900	ENDCOM(TTY)
26000	COMPIL(PTY)
26100	ENDCOM(PTY)
26200	
26300	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 BREAK CHAR
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