perm filename IOSER.TNX[IMS,AIL]1 blob sn#032336 filedate 1973-04-01 generic text, type T, neo UTF8
COMMENT ⊗ TENEX-IOSER -- R. SMITH ⊗
	LSTON	(IOSER)


IFN ALWAYS, <BEGIN IOSER>

COMMENT ⊗ INDICES, BITS FOR TENEX VERSION OF IOSER ⊗


EXTERNAL JFNTBL,CDBTBL




;WORDS IN CDB BLOCK FOR EACH CHANNEL


↓GFL←←0				;FLAGS FOR GTJFN
↓OFL←←1				;FLAGS FOR OPENF
↓BRCHAR←←2			;BRCHAR ADDRESS
↓ICOUNT←←3			;COUNT ADDRESS
↓ENDFL←←4			;EOF ADDRESS
↓ICOWNT←←5			;INPUT COUNT
↓IBP←←6				;INPUT BYTE-POINTER
↓OCNT←←7			;OUTPUT COUNT
↓OBP←←10			;OUTPUT BYTE-POINTER
↓DVTYP←←11				;DEVICE TYPE
↓DVDSG←←12			;DEVICE DESIGNATOR
↓OPNDUN←←13			;TRUE IF OPENED WITH THE OPEN STATEMENT
↓DVCH←←14			;DEVICE CHARACTERISTICS

↓IOTLEN←←15			;CURRENT LENGTH OF CDB BLOCK

↓JFNSIZE←←20			;NUMBER OF CHANNELS ALLOWED
↓DMOCNT←←200			;(DEFAULT) COUNT FOR DUMP MODE OUTPUT
↓STARTPAGE←←610			;STARTING PAGE FOR BUFFERS

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

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

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

	SKIPL	Q,Y
	CAILE	Q,JFNSIZE
	  JRST	Z	
	MOVE	CDB,CDBTBL(Q)
	HRRZ	X,JFNTBL(Q)
	SKIPN	X
	  JRST	Z
>
	
;ONLY USES AC X
DEFINE VALCH1(X,Y,Z) <
	SKIPL	X,Y
	CAILE	X,JFNSIZE
	   JRST	Z
	HRRZ	X,JFNTBL(X)
	SKIPN	X
	   JRST	Z
>



COMPIL(PAT,<OPEN,LOOKUP,ENTER,USETI,USETO,MTAPE,RELEASE,CLOSE,CLOSIN,CLOSO,GETCHAN,CVJFN,RENAME>
	,<SAVE,RESTR,RELEASE,CORGET>
	,<PAT -- TENEX ROUTINES EMULATING DEC CALLS>)

	BEGIN PAT

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

;SEE WHAT KIND OF DEVICE WE HAVE

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

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

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

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

GTNOW:	
	MOVSI	GTFLAGS,100001
	MOVE	1,GTFLAGS
	MOVE	2,(SP)			;DEVICE STRING
	GTJFN	
	   JRST	BADOPN			;NOPE CANNOT GET
	MOVEM	1,JFNTBL(Q)		;SAVE JFN
	MOVEM	GTFLAGS,GFL(CDB)	;AND SAVE THEM
;COMPUTE OPENF FLAGS
	SETZ	OPFLAGS,
	MOVE	2,DVCH(CDB)		;DEVICE CHARACTERISTICS
	TDNE	2,[1B1]			;CAN DO INPUT?
	   TDO	OPFLAGS,[RDBIT]
	TDNE	2,[1B0]			;CAN DO OUTPUT?
	   TDO	OPFLAGS,[WRBIT]
;NOW TRY VARIOUS THINGS, LOOKING FOR SOMETHING THAT WORKS
	HRRZ	1,JFNTBL(Q)
	HRLI	OPFLAGS,440000
	MOVE	2,OPFLAGS		;36-BIT, MODE 0
	OPENF	
	   SKIPA
	JRST	OPOK	
	HRRZ	1,JFNTBL(Q)
	HRLI	OPFLAGS,447400		;36-BIT, MODE 17
	MOVE	2,OPFLAGS
	OPENF
	  SKIPA
	JRST 	OPOK
	HRRZ	1,JFNTBL(Q)
	HRLI	OPFLAGS,70000		;7-BIT, MODE 0
	MOVE	2,OPFLAGS
	OPENF
	   JRST NOOPN
OPOK:	MOVEM	OPFLAGS,OFL(CDB)	;SAVE OP FLAGS
GUDRET:	
;SAVE FLAGS
	SETOM	OPNDUN(CDB)		;INDICATE OPENED WITH OPEN
	POP	P,TEMP			;RETURN ADDRESS
	POP	P,ENDFL(CDB)		;SAVE GOOD THINGS
	POP	P,BRCHAR(CDB)
	POP	P,ICOUNT(CDB)		
	SETZM	@ENDFL(CDB)		;INDICATE GOOD OPENING
	SUB	SP,X22			;CLEAN UP STACKS
	SUB	P,X44
	JRST	RESTR			;AND RETURN
	

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




	BEND OPEN

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

⊗

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

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

	
	SKIPL	Q,CHNARG
	CAILE	Q,JFNSIZE	
	   JRST	BADLU1
	MOVE	CDB,CDBTBL(Q)
	SKIPN	OPNDUN(CDB)		;ERROR IF NOT OPENED
	   JRST	BADLU1
	MOVE	2,DVCH(CDB)		;GET DEVICE CHARACTERISTICS
	TLNN	2,100000		;DOES DEVICE HAVE A DIRECTORY?
	   JRST	LUKRET			;NO, NO LOOKUP
	SKIPE	JFNTBL(Q)		;JFN ALREADY ASSIGNED?
	   JRST	BADLU1			;YES, THIS WILL BE AN ERROR (NOT QUITE RIGHT)

	PUSH	P,[=100]
	PUSHJ	P,ZSETST		;MAKE A STRING
	PUSH	P,1			;SAVE BP IN CASE OF ERROR
	MOVE	2,DVDSG(CDB)	
	DEVST				;GET THE STRING
	   JRST	BADDST			;ERROR IN AC1 (AND DONT FORGET STRING STUFF)
	SUB	P,X11			;REMOVE OLD BP FROM STACK
	PUSH	P,[=100]
	PUSH	P,1			;UPDATED BP
	PUSHJ	P,ZADJST		;STRING NOW ON STACK
	PUSH	P,[":"]
	PUSHJ	P,CATCHR
	PUSHJ	P,CAT.RV		;CONCATENATE IN REVERSE ORDER
	PUSH	P,[0]
	PUSHJ	P,CATCHR		;AND A NULL FOR GTJFN
	MOVSI	1,100001		;OLD FILE
	MOVE	2,(SP)
	GTJFN	
	   JRST	BADLUK
	MOVEM	1,JFNTBL(Q)
	MOVSI	3,100001
	MOVEM	3,GFL(CDB)
	MOVE	2,[XWD 440000,200000]	;36-BIT
	OPENF
	   SKIPA
	JRST 	GUDLUK
	MOVE	1,JFNTBL(Q)
	MOVE	2,[XWD 447400,200000]	;36-BIT, DUMP
	OPENF
	   SKIPA
	JRST	GUDLUK
	MOVE	1,JFNTBL(Q)
	MOVE	2,[XWD 70000,200000]	;7-BIT
	OPENF
	   JRST	BADLUK
GUDLUK:	MOVEM	2,OFL(CDB)
	SETZM	@FLGARG
LUKRET:	POP	P,CDB
	POP	P,Q
	POP	P,3
	POP	P,2
	POP	P,1
	SUB	SP,X22
	SUB	P,X33
	JRST	@3(P)

BADLUK:	MOVEM	1,@FLGARG
	JRST	LUKRET

BADLU1:	SETOM	@FLGARG		
	JRST	LUKRET

BADDST:	
;HERE WITH ORIGINAL BP ON THE STACK

	PUSH	P,[=100]
	PUSH	P,-1(P)
	PUSHJ	P,ZADJST
	SUB	P,X11
	JRST	BADLU1

	BEND LOOKUP

	
HERE(ENTER)
	BEGIN ENTER

	PUSHJ	P,TENXFI

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

	SKIPL	Q,CHNARG
	CAILE	Q,JFNSIZE
	   JRST	BADEN1
	MOVE	CDB,CDBTBL(Q)
	SKIPN	OPNDUN(CDB)
	   JRST	BADEN1			;WAS AN OPEN PERFORMED HERE?
	SKIPN	1,JFNTBL(Q)
	   JRST	NOTOPN
	MOVE	2,DVCH(CDB)		;GET DEVICE CHARACTERISTICS
	TLNN	2,100000		;DOES DEVICE HAVE DIRECTORY?
	   JRST	ENTRET			;NO

	PUSH	P,1			;SAVE JFN
	CLOSF
	   JRST	BADENT			;ERROR IN 1
	POP	P,1
	MOVE	2,OFL(CDB)
	TDO	2,[WRBIT]		;TURN ON WRITE BIT
	MOVEM	2,OFL(CDB)		;AND SAVE NEW FLAGS
	OPENF
	   JRST	BADENT			;ERROR IN 1	    
	JRST	ENTRET			;RETURN

NOTOPN:	
	PUSH	P,[=100]
	PUSHJ	P,ZSETST		;GET A BP
	PUSH	P,1			;AND SAVE IF AN ERROR HAPPENS
	MOVE	2,DVDSG(CDB)
	DEVST
	   JRST	BADDST			;CANNOT GET STRING
	SUB	P,X11			;ADJUST
	PUSH	P,[=100]
	PUSH	P,1
	PUSHJ	P,ZADJST
	PUSH	P,[":"]	
	PUSHJ	P,CATCHR
	PUSHJ	P,CAT.RV		;CONCATENATE IN REVERSE ORDER
	PUSH	P,[0]
	PUSHJ	P,CATCHR		;NULL ON THE END
	MOVSI	1,600001		;NEW FILE
	MOVE	2,(SP)
	GTJFN
	   JRST	BADENT			;CANNOT GTJFN
	MOVEM	1,JFNTBL(Q)
	MOVSI	2,600001		;THE 
	MOVEM	2,GFL(CDB)		;SAVE THE GTJFN FLAGS
B36:	HRRZ	1,JFNTBL(Q)
	MOVE	2,[XWD 440000,100000]	;36-BIT
	OPENF	
	   SKIPA
	JRST	ENT1	
	HRRZ	1,JFNTBL(Q)
	MOVE	2,[XWD 447400,100000]	;36-BIT, DUMP
	OPENF
	   SKIPA
	JRST	ENT1
	HRRZ	1,JFNTBL(Q)
	MOVE	2,[XWD 70000,100000]
	OPENF
	   JRST	BADENT
ENT1:	MOVEM	2,OFL(CDB)
ENTRET:	SETZM	@FLGARG
ENTPOP:	POP	P,CDB
	POP	P,Q
	POP	P,3
	POP	P,2
	POP	P,1
	SUB	SP,X22
	SUB	P,X33
	JRST	@3(P)


BADENT:	MOVEM	1,@FLGARG
	JRST	ENTPOP

BADEN1:	SETOM	@FLGARG
	JRST	ENTPOP

BADDST:	PUSH	P,[=100]
	PUSH	P,-2(P)		;BYTE-POINTER
	PUSHJ	P,ZADJST
	SUB	P,X11
	JRST	BADEN1


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

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

	PUSHJ	P,TENXFI
	VALCHN	1,CHNARG,RENBAD
	HRRZ	2,-1(SP)		;NULL FILE SPEC?
	JUMPE	2,RENDEL		;YES, DELETE 	
	PUSH	P,[0]
	PUSHJ 	P,CATCHR
	MOVE	3,1			;SAVE FIRST JFN
	MOVE	1,GFL(CDB)		;USE SAME FLAGS
	TDZ	1,OLDBIT		;EXCEPT NOT OLD
	TDO	1,NEWBIT		;BUT DO WANT NEW
	MOVE	2,(SP)
	GTJFN
	   JRST	RENERR
	MOVE	2,1			;NEW JFN	
	MOVE	1,3			;OLD JFN
	RNAMF
	   JRST	RENERR
	MOVEM	2,JFNTBL(Q)		;AND SAVE NEW JFN
RENRET:	SETZM	@FLGARG
RENRE1:	POP	P,CDB
	POP	P,Q
	POP	P,3
	POP	P,2
	POP	P,1
	SUB	SP,X22
	SUB	P,X33
	JRST	@3(P)			

RENERR:	MOVEM	1,@FLGARG
	JRST	RENRE1

RENBAD:	SETOM	@FLGARG
	JRST	RENRE1

RENDEL:	DELF				;JFN IN 1
	   JRST	RENERR
	JRST	RENRET
	BEND RENAME

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

HERE(USETI)
HERE(USETO)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	VALCHN	1,-2(P),USETER
	MOVE	2,DVTYP(CDB)		
	CAIN	2,3			;IS IT A DECTAPE?
	   JRST	USEDTA			;YES
DOSFPT:	MOVE	2,-1(P)
	SUBI	2,1
	IMULI	2,200			;BLOCK NUMBER
	SFPTR
	   ERR <USETI OR USETO:  CANNOT DO SFPTR>,1
	JRST	RESTR

USEDTA:
	LDB	2,[POINT 4,OFL(CDB),9]	;MODE	
	CAIE	2,17			;DUMP MODE?
	  JRST	DOSFPT			;NO
	MOVEI	2,30			;OPERATION 30 FOR DECTAPES
	HRRZ	3,-1(P)			;TAPE BLOCK
	MTOPR				;SET DIRECTLY
	JRST	RESTR			;AND RETURN
USETER:	ERR <USETI OR USETO:	ILLEGAL JFN>,1
	JRST	RESTR			;AND RETURN
		
DSCR
	PROCEDURE CLOSE(INTEGER CHANNEL)
	PROCEDURE CLOSO(INTEGER CHANNEL)
	PROCEDURE CLOSIN(INTEGER CHANNEL)
⊗
HERE(CLOSIN)	
	PUSH	P,-1(P)
	PUSHJ	P,CLOSF			;CLOSE OUT
	SKIPE	.SKIP.
	   ERR <CLOSIN:  CANNOT CLOSF JFN>,1
	PUSHJ	P,SAVE
	VALCHN	1,-1(P),CLOBAD
	MOVE	2,OFL(CDB)
	TDZ	2,[RDBIT]
	MOVEM	2,OFL(CDB)
	OPENF
	   JRST	CLOBAD
	JRST	CLORET

HERE(CLOSO)
	PUSH	P,-1(P)
	PUSHJ	P,CLOSF
	SKIPE	.SKIP.
	   ERR <CLOSO:  CANNOT CLOSF JFN>,1
	PUSHJ	P,SAVE
	VALCHN	1,-1(P),CLOBAD
	MOVE	2,OFL(CDB)
	TDZ	2,[WRBIT]
	MOVEM	2,OFL(CDB)
	OPENF
	   JRST	CLOBAD
CLORET:	MOVE	LPSA,X22
	JRST	RESTR
CLOBAD:	ERR <CLOSO OR CLOSIN:  CANNOT OPENF FILE>,1
	JRST	CLORET

HERE(CLOSE)
	PUSH	P,-1(P)
	PUSHJ	P,CLOSF
	SKIPE	.SKIP.	
	   ERR <CLOSE:  CANNOT CLOSF JFN>,1
	SUB	P,X22
	JRST	@2(P)

HERE(RELEASE)
	JRST	CFILE




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

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

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

	BEND MTAPE

	


DSCR	
	STRING PROCEDURE TENXFI(STRING DECFILE)

	Converts the string to a TENEX file specification.
⊗
	BEGIN TENXFI

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

HERE(TENXFI)
	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	SETZM	FIND
	PUSH	SP,[0]		;DIR TEMPORARY
	PUSH	SP,[0]
	PUSH	SP,[0]		;NAM TEMPORARY
	PUSH	SP,[0]	

DEFINE ORIG <-5(SP)>
DEFINE ORIG1 <-4(SP)>
DEFINE DIR <-3(SP)>
DEFINE DIR1 <-2(SP)>
DEFINE NAM <-1(SP)>
DEFINE NAM1 <(SP)>

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

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


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

NOQUOTE:
	CAIN	3,","
	   JRST	TENX1			;IGNORE COMMA
	CAIE	3,40			;SPACE
	CAIN	3,11			;OR TAB
	   JRST	TENX1

	CAIE	3,"<"	
	CAIN	3,"["
	   JRST	STDIR
	CAIE	3,">"
	CAIN	3,"]"
	   JRST	ENDDIR
	SKIPE	FIND
	   JRST	[PUSHJ	P,CATDI3
		 JRST TENX1]
	PUSHJ	P,CATNA3
	JRST	TENX1

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

ENDDIR:	SETZM	FIND
	JRST	TENX1


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

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


NODIR:
;STACK IS ORIG,DIR,NAM (AND DIR IS EMPTY)
	POP	SP,-4(SP)		;REPLACE ORIG WITH NAM
	POP	SP,-4(SP)
	SUB	SP,X22			;REMOVE DIR
	JRST	TXFRET			;AND RETURN


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

CATDI3:	CATDIR 3
	POPJ	P,


	BEND TENXFI

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

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

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

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

DSCR
	INTEGER PROCEDURE CVJFN(INTEGER CHAN)

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


BEND PAT

ENDCOM(PAT)

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

⊗

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

HERE(GJINF)
	JSYS  13;
	MOVEM 	1,@-3(P)
	MOVEM 	2,@-2(P)
	MOVEM 	4,@-1(P)
	MOVE 	1,3;
	SUB	P,X44
	JRST	@4(P)
DSCR
	Does the HALTF jsys.
⊗
HERE(HALTF)
	JSYS	170		;HALTF
	POPJ	P,		;RETURN UPON CONTINUATION



ENDCOM(JOBINF)

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

HERE(DIRST)
	PUSH	P,[=100]
	PUSHJ	P,ZSETST
	SETZM 	.SKIP.
	MOVE 	2,-1(P)		;DIRECTORY NO.
	JSYS 	41		;DIRST
	SETOM 	.SKIP.
	PUSH	P,[=100]
	PUSH	P,1		;UPDATED BP
	PUSHJ	P,ZADJST	;GET STRING ON STACK
	SUB	P,X22		
	JRST	@2(P)

ENDCOM(DIRECT)
COMPIL(RUNPRG,<RUNPRG>,<X22,X33,CATCHR>,<RUNPRG -- RUN A PROGRAM>)
DSCR INTEGER SIMPLE PROCEDURE RUNPRG(STRING PROGRAM; INTEGER INCREM; BOOLEAN NEWFORK)
	This does two entirely different things depending on whether
NEWFORK is true or not.
	If NEWFORK then a new fork is created, capabilities transmitted,
and PROGRAM is run there.  INCREM is added to the entry vector.  Any problems
cause the routine to return FALSE, otherwise it returns TRUE.
	If not NEWFORK then the current job is destroyed and replaced
with PROGRAM, with INCREM added to the entry vector location.  This is
like the DEC RUN uuo, and hence if the increment is 1, the program is
started at the CCL address.  If the routine returns at all, there was a problem
with the file.
	Remember to say .SAV as the PROGRAM extension.
⊗


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

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

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

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

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


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

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

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

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

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

DEFINE EQ $ (X,Y) <
	CAIE	A,"$X$"
	   JRST .+3
	TDO	FLAGS,[Y]
	JRST	CONT
>

DEFINE JTRUE $ (X) <
	TDNN	FLAGS,[X]
>
DEFINE JFALSE (X) <
	TDNE	FLAGS,[X]
>

DEFINE 	SGT (X) <
	TDO	GTFLAGS,[X]
>
DEFINE  SOF (X) <
	TDO	OPFLAGS,[X]
>
DEFINE  TGT (X) <
	TDNE 	FLAGS,[X]
	   TDO	GTFLAGS,[X]
>
DEFINE  TOP (X) <
	TDNE	FLAGS,[X]
	   TDO	OPFLAGS,[X]
>

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

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

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

    CONT:
	SOJGE	B,WHIOPT

;NOW SET UP GTFLAGS ACCORDING TO THE SCANNED INFORMATION
OPTDUN:		
	JFALSE	NEWBIT			;NEW
	   JRST	[TGT OLDBIT		;ALSO OLD?	
		 JRST	OPTDU1
		]
	JTRUE	OLDBIT			;OLD?
	  JRST	NEITHER			;NEITHER
	SGT	OLDBIT			;YES, SET OLDBIT
	JRST	OPTDU1
NEITHER:
	JTRUE	RDBIT
	JFALSE	APPBIT
	   SGT	OLDBIT
	JTRUE	WRBIT
	   JRST	OPTDU1
	JFALSE	RDBIT	
	JTRUE	APPBIT
	   SGT	OUTBIT
OPTDU1:	
;NOW TEST FOR INDEPENDANT THINGS
	TOP	RDBIT
	TOP	WRBIT
	TOP	APPBIT
	TGT	TEMBIT
	TGT	STARBIT
	TGT	THAWBIT
	JFALSE	CONFBIT
	   JRST	[SGT	CONFB1
		 SGT	CONFB2
		 JRST	.+1]
	TLO	GTFLAGS,1		;SHORT CALL OF GTJFN
GTAGAIN:
	HRRZ	A,-3(SP)		;LENGTH OF NAME
	JUMPE	A,[TRYAGN:  
		   TLO	GTFLAGS,2
		   MOVE	2,[XWD 100,101]
		   JRST  GT]
	AND 	GTFLAGS,[717777777777]
	
	PUSH	SP,-3(SP)
	PUSH	SP,-3(SP)
	PUSH	P,[0]
	PUSHJ	P,CATCHR		;CONCATENATE A NULL CHAR
	MOVE	2,(SP)			;BYTE-POINTER
GT:	MOVE	1,GTFLAGS
	JSYS	20			;GTJFN	
	  JRST 	GTERR
	MOVEM	1,JFN			;REMEMBER JFN
	PUSHJ	P,SETCHN		;SET A CHANNEL, ALLOCATE, GET CDB, SET DVTYP, RETURN CHANNEL
	MOVEM	1,Q			;REMEMBER CHANNEL	
	MOVEM	GTFLAGS,GFL(CDB)


COMMENT ⊗ Do the open.
⊗

B36:	HRRZ	1,JFN			;JFN
	HRRZ	2,OPFLAGS
	HRLI	2,440000		;36-BIT, MODE 0
	OPENF	
	   JRST	B36DMP			;TRY 36-BIT, DUMP MODE
	JRST	OPNOK
B36DMP:	HRRZ	1,JFN
	HRRZ	2,OPFLAGS
	HRLI	2,447400		;36 BITS, DUMP MODE
	OPENF			
	   JRST	B7
	JRST	OPNOK
B7:	HRRZ	1,JFN
	HRRZ	2,OPFLAGS
	HRLI	2,70000			;7 BIT
	OPENF
	    JRST OPERR			;NOPE
OPNOK:	MOVEM	2,OFL(CDB)		;SAVE 
	MOVE	1,Q			;RETURN CHANNEL NO	
OPFRET:	SUB	SP,X44			;ADJUST
	POPJ	P,			;AND RETURN




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

GTER1:	HRROI	1,[ASCIZ/
CANNOT GTJFN FILE /]
	PSOUT
	PUSH	SP,-3(SP)
	PUSH	SP,-3(SP)
	PUSHJ	P,OUTSTR
	HRROI	1,[ASCIZ/, TRY AGAIN  */]
	PSOUT
	JRST	TRYAGN



OPERR:	JTRUE	ERTNBIT
	   JRST	OPER1
	JRST	ERRRET

OPER1:	HRROI	1,[ASCIZ/
CANNOT OPENF FILE /]
	PSOUT
	PUSH	SP,-3(SP)
	PUSH	SP,-3(SP)
	PUSHJ	P,OUTSTR
	HRROI	1,[ASCIZ/, TRY AGAIN  */]
	PSOUT	
	PUSH	P,Q			;CLOSE AND RELEASE FILE AND CDB BLOCK
	PUSHJ	P,CFILE
	JRST	TRYAGN	

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


	BEND OPENFILE

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

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

DSCR
	BOOLEAN PROCEDURE INDEXFILE(INTEGER JFN)

RETURNS TRUE AS LONG AS WE CAN GNJFN ANOTHER FILE
⊗

HERE(INDEXFILE)
	PUSH	P,-1(P)
	PUSHJ	P,CLOSF
	PUSH	P,-1(P)
	PUSHJ	P,GNJFN
	JUMPE	1,INDRET		;RETURN FALSE IF NO OTHER FILES
	PUSH	P,2
	PUSH	P,CDB
	PUSH	P,Q		
	VALCHN	1,-4(P),NOIND
	MOVE	2,OFL(CDB)		;GET OPENFLAGS
	OPENF
	   JRST NOIND
	SETO	1,
INDRET:	POP	P,Q
	POP	P,CDB
	POP	P,2
	SUB	P,X22	
	JRST	@2(P)
NOIND:	SETZ	1,
	JRST	INDRET




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

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

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

ENDCOM(GTJFN)
COMPIL(FILINF,<GNJFN,SIZEF,JFNS,OPENF,CFILE,CLOSF,RLJFN,GTSTS>
	,<JFNTBL,CDBTBL,STRSND,X22,X33,CORREL,.SKIP.,ZSETST,ZADJST>
	,<FILINF -- UTILITY TENEX FILE ROUTINES>)

DSCR INTEGER SIMPLE PROCEDURE GNJFN(INTEGER JFN)
	Does the GNJFN jsys.
⊗
HERE(GNJFN)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN 1,<-1(P)>,GNERR
	MOVE	1,JFNTBL(Q)		;GET THE WHOLE JFN
	SETO	2,;			;ASSUME GOOD
	JSYS  17			;GNJFN
	SETZ 	2,
	MOVEM	2,RACS+A(USER)
GNRET:	JRST	RESTR

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


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

SIZERR:	ERR <SIZEF:  ILLEGAL JFN>
	SETOM	.SKIP.
	JRST	SIZRET


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

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

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

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

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

Other values of FLAGS are interpreted literally.
⊗

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

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

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

OPNTBL:	070000200000		;7-BIT READ
	070000100000		;7-BIT WRITE
	440000200000		;36-BIT READ
	440000100000		;36-BIT WRITE
	447400200000		;36-BIT DUMP READ
	447400100000		;36-BIT DUMP WRITE


DSCR SIMPLE INTEGER PROCEDURE CFILE(INTEGER JFN)
	Closes the file (CLOSF) and releases (RLFJN)
the jfn.  This is the ordinary way the user will use
to dispense with a file.
	Returns TRUE if JFN legal and released, FALSE o.w.
Always returns.
⊗

HERE(CFILE)
	PUSH	P,2
	PUSH	P,3
	PUSH	P,Q
	PUSH	P,CDB
	SKIPL	Q,-5(P)
	CAILE	Q,JFNSIZE
	   JRST	CFBAD
	MOVE	CDB,CDBTBL(Q)	;GET CDB
	SKIPN	1,JFNTBL(Q)	;JFN ASSIGNED?
	   JRST	CFBA1		;NO, JUST RELEASE CORE
	HRRZ	1,1		;JFN ONLY
	LDB	2,[POINT 6,OFL(CDB),5]		;GET BYTE SIZE
	CAIE	2,=36		;36-BIT?
	   JRST RLCOR		;NO
;FILE IN 36-BIT BYTES
	SKIPN	OBP(CDB)	; A BYTE-POINTER?
	  JRST 	RLCOR		; NO, NOTHING IN THE BUFFER
	PUSHJ	P,STRSND	;SEND OUT THE BUFFER

RLCOR:	SKIPE	B,CDBTBL(Q)	; ANY CORE TO RELEASE?
	  PUSHJ	P,CORREL	; RELEASE THE BLOCK
	PUSH	P,1 		; SAVE JFN
	JSYS 	22 		; CLOSF
	  JFCL 			; IGNORE 
	POP	P,1		; GET JFN AGAIN;
	JSYS 	23 		; RLJFN	
	  JRST	CFBAD 		; NO
	SETO	1, 		; RETURN TRUE
      	SETZM	CDBTBL(Q)
	SETZM	JFNTBL(Q)
CFRET:	POP	P,CDB
	POP	P,Q
	POP	P,3
	POP	P,2
	SUB	P,X22 		; ADJUST
	JRST	@2(P) 		; RETURN

CFBAD:	SETZ	1, 		; RETURN FALSE
	JRST	CFRET ;

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

DSCR SIMPLE PROCEDURE CLOSF(INTEGER JFN)
	Does a CLOSF on the JFN.  Ordinarily the user
will want to use the CFILE routine, which handles errors
internally. The CLOSF is accomplished in such a way that
the JFN is actually not released.
⊗
HERE(CLOSF)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN	1,<-1(P)>,CLOERR
	LDB	2,[POINT 6,OFL(CDB),5]	;BYTE-SIZE
	CAIE	2,=36		;36-BIT BYTES?
	   JRST	DOCLO
	SKIPN	OBP(CDB)
	   JRST	DOCLO
	PUSHJ	P,STRSND

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

CLOERR:	ERR <CLOSF:  NO JFN ASSIGNED>,1
	SETOM	.SKIP.
	JRST	CLORET





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

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

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


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

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

GTSERR:	ERR <GTSTS:  ILLEGAL JFN>,1
	JRST	GTSRET

ENDCOM(FILINF)
COMPIL(FIO,<OUT,CHAROUT,LINOUT,GTFDB>
	,<CDBTBL,JFNTBL,X22,X33,X44,.SKIP.,SAVE,RESTR>
	,<FILIO -- IO ROUTINES>)

DSCR SIMPLE PROCEDURE CHAROUT(INTEGER JFN; INTEGER JFN)
⊗
HERE(CHAROUT)
	BEGIN CHAROUT

	PUSH	P,1
	PUSH	P,2
	PUSH	P,CDB
	PUSH	P,Q
	VALCHN 1,-2(P),CHAOBAD
	LDB	2,[POINT 6,OFL(CDB),5]	;GET BYTE SIZE			
	CAIE	2,7
	   JRST B36
	MOVE	2,-1(P)
	BOUT
	JRST	CHARET

B36:	CAIE	2,=36
	   JRST	CHAOBAD
	MOVE	2,-1(P)
	SOSG	OCNT(CDB)	
	   PUSHJ P,STRSND		;WITH 1,CDB,Q LOADED
	IDPB	2,OBP(CDB)	
CHARET:	POP	P,Q
	POP	P,CDB
	POP	P,2
	POP	P,1
	SUB	P,X33
	JRST	@3(P)

CHAOBAD: ERR <CHAROUT:  ILLEGAL JFN OR BYTE-SIZE>,1
	JRST	CHARET
	BEND CHAROUT



DSCR SIMPLE PROCEDURE OUT(INTEGER JFN; STRING S)
	Outputs a SAIL string to the JFN, which may be open
in DUMP mode.
⊗
HERE(OUT)
	BEGIN OUT
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	HRRZ 3,-1(SP) 		; GET THE COUNT
	JUMPE 3,SOURET 		; DONT SEND NULL STRING
	VALCHN	1,-1(P),SOUBAD
	LDB	2,[POINT 6,OFL(CDB),5]	;GET BYTE SIZE
	CAIN	2,7		;7-BIT?
	   JRST	USESOU		;USE SOUT
	CAIE	2,=36		;36-BIT?
	   JRST SOUBAD

;HERE TO FAKE DUMP MODE OUTPUT
DMPAGN:	ILDB	2,(SP)		;GET A CHARACTER
	SOSG	OCNT(CDB)	;AND DECREMENT COUNT
	  PUSHJ	P,STRSND	;SO SEND THE BUFFER	;WITH 1,CDB,Q LOADED
	IDPB	2,OBP(CDB)	;AND COPY THE CHARACTER
	SOJG	3,DMPAGN
SOURET:	SUB	SP,X22
	JRST	RESTR

	
USESOU:	MOVE 2,(SP) 		; GET THE BYTE-POINTER	
	MOVN 3,3 		; NEGATE BYTE-COUNT
	JSYS  53 		; SOUT JSYS
	JRST	SOURET	
	
SOUBAD:	ERR <OUT ILLEGAL JFN OR BYTE-SIZE>,1
	JRST 	SOURET

	BEND OUT

DSCR	PROCEDURE LINOUT(INTEGER JFN,VALUE)
⊗

HERE(LINOUT)
	BEGIN LINOUT

	PUSHJ	P,SAVE
	VALCHN	A,-2(P),LINBAD
	LDB	B,[POINT 6,OFL(CDB),5]	;GET BYTE-SIZE
	CAIE	B,=36		;MUST BE 36-BIT
	   JRST	LINBAD
	SKIPG	B,OCNT(CDB)	;ANY CHARS WAITING?
	   PUSHJ P,STRSND	;NO, SEND (OR PERHAPS JUST INITIALIZE)
	MOVE	TEMP,OBP(CDB)	;GET BP

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

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

	BEND LINOUT



DSCR 	STRSND
CAL	PUSHJ
SID	SAVES ALL ACS
ARGS
	1		JFN
	CDB		address of channel data block
	  
The routine:
	1)  does the dump mode output only if there are characters
to be sent.
	2)  resets the OCNT and OBP variables
⊗

	BEGIN STRSND
↑↑STRSND:
	PUSH	P,2		;SAVE ACS
	PUSH	P,3
	PUSH	P,4
	LDB	2,[POINT 4,OFL(CDB),9]	;GET MODE
	JUMPE	2,STRSOU	;USE SOUT
	CAIE	2,17		;BETTER BE DUMP MODE
	   ERR <STRSND:  MODE NOT 0 OR 17>
	HRRZI	3,STARTPAGE(1)	;GET THE PAGE NUMBER FOR THE BUFFER
	IMULI	3,1000		;MAKE AN ADDRESS

	SKIPN	OBP(CDB)	;INITIALIZED?
	  JRST	DMPINIT		;NO, JUST INITIALIZE
	MOVEI	4,DMOCNT*5
	CAMG	4,OCNT(CDB)	;ANY CHARS TO SEND
	  JRST	STRRET		;NO
	
	MOVEI	2,3
	SUBI	3,1
	MOVNI	4,DMOCNT	;WORD COUNT FOR DUMP MODE OUTPUT	
	HRL	3,4		;MAKE AN IOWD
	SETZ	4,		;MAKE A COMMAND LIST
	JSYS	66		;DUMPO	
	  ERR <DUMPOUT:  CANNOT WRITE DATA IN DUMP MODE>,1
DMPINIT:
	MOVEI	3,STARTPAGE(1)
	IMULI	3,1000
	HRL	2,3
	HRRI	2,1(3)
	SETZM	(3)
	BLT	2,DMOCNT-1(3)	;ZERO OUT
	MOVEI	2,DMOCNT*5	
	MOVEM	2,OCNT(CDB)	;SAVE COUNT
	HLL	3,[POINT 7,0,-1];FIX A BYTE-POINTER
	MOVEM	3,OBP(CDB)	;AND SAVE BYTE-POINTER
STRRET:	POP	P,4		;RESTORE AND RETURN
	POP	P,3
	POP	P,2
	POPJ	P,

STRSOU:	SKIPN	OBP(CDB)	;INITIALIZED?
	   JRST	SOUINIT		;NO
	MOVEI	3,1000*5
	CAMG	3,OCNT(CDB)	;ANYTHING TO SEND?
	   JRST	STRRET		;NO
	HRRZI	2,STARTPAGE(1)	
	IMULI	2,1000		;CALCULATE ADDRESS
	HRLI	2,444400	;BP	
	MOVNI	3,1000		;COUNT
	SOUT
SOUINIT:
	HRRZI	2,STARTPAGE(1)
	IMULI	2,1000
	HRL	3,2
	HRRI	3,1(2)
	SETZM	(2)
	BLT	3,777(2)	;CLEAR OUT PAGE
	HRLI	2,440700
	MOVEM	2,OBP(CDB)
	MOVEI	3,1000*5
	MOVEM	3,OCNT(CDB)	
	JRST	STRRET

	BEND STRSND	

	

	


	
DSCR	SIMPLE PROCEDURE GTFDB(INTEGER JFN; REFERENCE INTEGER ARRAY BUF)

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

GTFBAD:	ERR <GTFDB:  ILLEGAL JFN>,1
	JRST	GTFRET


ENDCOM(FIO)
COMPIL(BINROU,<WORDIN,WORDOUT,ARRYIN,ARRYOUT,MTOPR,SFPTR,RFPTR,BKJFN,RFBSZ>
	,<JFNTBL,X22,X33,.SKIP.,CDBTBL,SAVE,RESTR>
	,<BINROU -- BINARY ROUTINES>)
DSCR INTEGER SIMPLE PROCEDURE WORDIN(INTEGER JFN);
	Does the BIN jsys on JFN.
⊗
HERE(WORDIN)
	PUSH	P,2
	PUSH	P,Q
	PUSH	P,CDB
	VALCHN 1,<-1(P)>,BINBAD
	SKIPE	ENDFL(CDB)
	  SETZM	@ENDFL(CDB)		;ASSUME NO EOF
	JSYS 	50			;BIN
	JUMPE	2,CKWEOF		;CHECK EOF
	MOVE 1,2;
BINRET:	POP	P,CDB			;RESTORE 
	POP	P,Q
	POP	P,2
        SUB	P,X22
	JRST	@2(P)
BINBAD:	ERR <BIN:  ILLEGAL JFN>,1
	SETZ	1,			;RETURN A NULL
	JRST	BINRET

CKWEOF:	GTSTS				;CHECK STATUS
	TDNE	2,[1B8]			;END-OF-FILE?
	     JRST [SKIPE ENDFL(CDB)	;EOF LOCATION
		      SETOM @ENDFL(CDB)	;YES
		   JRST .+1]
	SETZ	1,			;RETURN NULL TO USER
	JRST	BINRET


DSCR SIMPLE PROCEDURE WORDOUT(INTEGER JFN,BYTE);
	Does the BOUT jsys.;
⊗
HERE(WORDOUT)
	EXCH	1,-2(P)
	EXCH	2,-1(P)
	CAIL	1,0
	CAILE	1,JFNSIZE
	   JRST	BOUBAD
	SKIPN	1,JFNTBL(1)
	   JRST	BOUBAD
	HRRZ	1,1
	JSYS	51			;BOUT
BOURET:	EXCH	1,-2(P)	
	EXCH	2,-1(P)
	SUB	P,X33
	JRST	@3(P)
BOUBAD:	ERR <WORDOUT OR BOUT:  ILLEGAL JFN>,1
	JRST	BOURET

DSCR SIMPLE PROCEDURE ARRYIN(INTEGER JFN; REFERENCE INTEGER LOC; INTEGER COUNT);
	Reads in COUNT words into LOC from JFN.  The file should be open
for 36-bit bytes for this to work.
	WARNING:  no array bounds checking.
⊗
HERE(ARRYIN)
	PUSHJ	P,SAVE
	MOVE	LPSA,X44
	MOVN	3,-1(P)		;NEGATIVE WORD COUNT
	JUMPE	3,ARIRET
	JUMPG	3,ARIBAD	;NEGATIVE WORD COUNT
	SKIPL	Q,-3(P)
	CAILE	Q,JFNSIZE
	   JRST	ARIBAD
	MOVE	CDB,CDBTBL(Q)	;GET CDB
	SKIPN	1,JFNTBL(Q)
	   JRST	ARIBAD
	SKIPE	ENDFL(CDB)	;EOF LOCATION?
	   SETZM @ENDFL(CDB)	;ASSUME GOOD
	HRRZ	1,1		;THIS IS THE JFN NOW
	LDB	2,[POINT 4,OFL(CDB),9]	;GET THE MODE
	JUMPE	2,USESIN	;MODE ZERO?
	CAIE	2,17		;BETTER BE DUMP
	    JRST ARIBAD
USEDMP:	MOVEI	2,3
	HRL	3,3		;NEGATIVE WORD COUNT
	HRR	3,-2(P)		;ADDRESS OF BUFFER
	SUBI	3,1
	SETZB	4,.SKIP.	;ZERO NEXT LOCATION, ERROR WORD
	JSYS	65
	   JRST	DMPERR
	JRST	ARIRET		;RETURN

USESIN:	MOVSI	2,444400	;BYTE-POINTER
	HRR	2,-2(P)		;LOCATION
	SETZM	.SKIP.		;ASSUME NO ERROR
	JSYS 	52		;SIN
	SKIPE	3		;EVERYTHING READ ?
	   JRST	SINEOF
ARIRET:	JRST	RESTR

SINEOF:	ADD	3,-1(P)		;CALCULATE NO. OF WORDS READ IN
	HRLI	3,-1		;MAKE IT XWD -1,COUNT
	SKIPE	ENDFL(CDB)	;EOF LOCATION
	   MOVEM	3,@ENDFL(CDB)	;AND SAVE
	JRST	ARIRET


ARIBAD:	ERR <ARRYIN:  NEGATIVE WORD COUNT, ILLEGAL JFN OR ILLEGAL MODE>,1
ARIBA1:	SETOM	.SKIP.
	JRST	ARIRET

DMPERR:	CAIN	1,600220	;END OF FILE?
	  JRST	DMPEOF
	ERR <ARRYIN:  DUMP MODE ERROR>,1
	JRST	ARIBA1

DMPEOF:	SKIPE	ENDFL(CDB)	;EOF LOCATION
	  SETOM	@ENDFL(CDB)	;INDICATE EOF
	MOVE	1,DVTYP(CDB)	;GET DEVICE TYPE
	CAIE	1,2		;IS IT MAGNETIC TAPE?
	  JRST	ARIRET		;NO
	HRRZ	1,JFNTBL(Q)	;THE JFN
	SETZ	2,
	MTOPR			;CLEAR STATUS
	JRST	ARIRET		;AND RETURN	


DSCR SIMPLE PROCEDURE ARRYOUT(INTEGER JFN; REFERENCE INTEGER LOC; INTEGER COUNT);
DESR 
	Writes COUNT words to JFN starting at LOC.  The file should be open
in 36-bit bytes.;
⊗

HERE(ARRYOUT)
	PUSHJ	P,SAVE
	MOVE	LPSA,X44
	MOVN	3,-1(P)		;COUNT
	JUMPE	3,ARORET	
	JUMPG	3,AROBAD	;NEGATIVE COUNT?
	SKIPL	1,-3(P)		;CHANNEL
	CAILE	1,JFNSIZE
	  JRST	AROBAD
	MOVE	CDB,CDBTBL(1)	
	SKIPN	1,JFNTBL(1)	
	  JRST	AROBAD
	HRRZ	1,1		;JFN
	LDB	2,[POINT 4,OFL(CDB),9]	;GET THE MODE
	JUMPE	2,AROSOU 	;MODE ZERO?

	CAIE	2,17		;BETTER BE DUMP
	  JRST	AROBAD		;NOT OPEN IN DUMP MODE
ARODMP:	MOVEI	2,3
	HRL	3,3		;NEGATIVE WORD COUNT
	HRR	3,-2(P)
	SUBI	3,1		;MAKE AN IOWD
	SETZB	4,.SKIP.
	JSYS	66		;DUMPO
	   JRST	DMPOER
	JRST	ARORET		;RETURN
AROSOU:	MOVSI	2,444400	;BYTE-POINTER
	HRR	2,-2(P)		;LOCATION
	SETZM	.SKIP.
	JSYS	53		;SOUT
ARORET:	JRST	RESTR

AROBAD:	ERR <ARRYOUT:  NEGATIVE WORD COUNT, ILLEGAL JFN OR ILLEGAL MODE>,1
AROBA1:	SETOM	.SKIP.
	JRST	ARORET

DMPOER:	ERR <ARRYOUT:  DUMP MODE ERROR>,1
	JRST	AROBA1


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

MTBAD:	ERR <MTOPR:  ILLEGAL JFN>,1
	JRST	MTRET


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

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




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

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

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

BKBAD:	ERR <BKJFN:  ILLEGAL JFN>,1
	SETOM	.SKIP.
	JRST	BKRET
DSCR INTEGER SIMPLE PROCEDURE RFBSZ(INTEGER JFN);
	Reads the byte-size of the file open on JFN.
⊗
HERE(RFBSZ)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	VALCHN 1,-1(P),RFBBAD
	JSYS 	45
	MOVEM	2,RACS+A(USER)		;ANSWER IN 2
RFBRET:	JRST	RESTR

RFBBAD:	ERR <RFBSZ:  ILLEGAL JFN>,1
	JRST	RFBRET
ENDCOM(BINROU)

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

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

	IMSSS only.
	Does direct IO from the DSK (formerly device "PAK").
Modules 4-7 are legal for everyone.  Other modules require enabled
status.
	Count words are read into user's core at location LOC, from
MODULE, record RECNO.  Error bits are in .SKIP.
	Since the system cannot read into core across page boundaries, DSKIN
uses page 577 as a temporary buffer if the user's buffer is not within
a page boundary.
	Does the DSKOP jsys (as modified at IMSSS).
⊗

	BEGIN
	USRPAGE←←577
HERE(DSKIN)
	HRRZ	2,-2(P)
	JUMPE	2,DSIRET	;DONT READ NOTHING
	JUMPL	2,DSIBAD
	CAILE	2,1000		;DONT READ MORE THAN 1000 WORDS
	   JRST	DSIBAD
	HRLZ	1,-4(P)		;MODULE
	HRR	1,-3(P)		;RECORD NO. IN RIGHT HALF
	TLO	1,600000	;TURN ON BITS 0 AND 1 INDICATING MODULE-RECNO FORMAT
	HRRZ 	3,-1(P) 		; GET THE USER LOCATION
	MOVE 	4,3		
	IORI 	4,777;		; LAST WORD OF USER'S PAGE
	MOVEI 	5,-1(3) 		; USER LOCATION, LESS ONE
	ADD 	5,2 		; ADD COUNT (NOW IN AC2)
	CAMGE 	5,4 		; BEYOND PAGE?
	  JRST OK 		; NOPE
	MOVEI 3,USRPAGE*1000 	; PAGE TO READ FROM
	JSYS 	242 		; INPUT
	MOVEM 	1,.SKIP. 		; SAVE ERROR
	JUMPN 	1,DSIRET 		; RETURN IF ERROR, DONT BLT TO USER
	HRLZ 	1,3 		; ADDRESS READ INTO
	HRR 	1,-1(P) 		; USER ADDRESS
	MOVE 	3,-1(P) 		; GET USER ADDRESS
	ADD 	3,2 		; COMPUTE LAST WORD (I.E., ONE BEYOND LAST WORD)
	BLT 1,-1(3) 		; BLT TO USER
DSIRET:	SUB	P,[XWD 5,5]
	JRST	@5(P)


OK:	JSYS 242 		; DSKOP
	MOVEM 1,.SKIP.		; SAVE ERROR BITS
	JRST	DSIRET		; AND RETURN
DSIBAD:	ERR <DSKIN:  WORD COUNT EITHER < 0 OR > '1000>,1
	SETOM	.SKIP.
	JRST	DSIRET


BEND;DSKIN


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

HERE(DSKOUT)
	BEGIN
USRPAGE←577
	SKIPN	2,-2(P)		;COUNT
	   JRST	DSORET		;RETURN, NOTHING TO WRITE
	JUMPL	2,DSOBAD
	CAILE	2,1000		;CANNOT WRITE MORE THAN 1000 WORDS			
	   JRST	DSOBAD
	HRLZ 	1,-4(P) 	; GET MODULE	
	HRR 	1,-3(P) 	; AND RECORD NO.
	TLO 	1,600000 	; TURN ON BITS 0 AND 1 INDICATING MODULE-RECNO FORMAT
	TLO 	2,10		; SET TO WRITE
	HRRZ 	3,-1(P) 	; USER'S ADDRESS
	MOVE 	4,3 		; COPY USER'S ADDRESS
	IORI 	4,777 		; LAST WORD OF USER'S ADDRESS
	MOVEI 	5,-1(3) 	; USER LOCATION, LESS 1
	ADD 	5,2 		; ADD THE COUNT
	CAMGE 	5,4 		; WITHIN BOUNDARY?
	   JRST OK 		; OK TO WRITE DIRECTLY TO USER
	MOVEI 	3,USRPAGE*1000 	; GET USER PAGE ADDRESS
	HRLZ 	4,-1(P) 		; GET USER ADDRESS
	HRR 	4,3 		; PREPARE FOR BLT
	MOVE 	5,2		; GET COUNT
	ADD 	5,3
	BLT 	4,-1(5)		; BLT UP TO PAGE
OK:	JSYS 	242 		; SEND TO DSK
	MOVEM 1,.SKIP.		; RECORD ERROR FOR USER
DSORET:	SUB	P,[XWD 5,5]
	JRST	@5(P)
DSOBAD:	ERR <DSKOUT:  WORD COUNT EITHER <0 OR >1000>,1
	SETOM	.SKIP.
	JRST	DSORET	
BEND;DSKOUT

ENDCOM(DSKOP)
>;IFN IMSSS


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

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

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

HERE(SETCHN)
	MOVE	USER,GOGTAB
	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	MOVEI	C,IOTLEN
	PUSHJ	P,CORGET
	   ERR <SETCHN:  CANNOT GET CORE FOR FILE DESCRIPTOR BLOCK>
	MOVE	CDB,B			;

	HRL	B,B			;ZERO OUT BLOCK
	ADDI	B,1
	SETZM	(CDB)
	BLT	B,IOTLEN-1(CDB)

	SKIPE	CDBTBL(A)		;CAN WE USE THE SAME CHANNEL AS JFN?
	   JRST FNDCHN			;NO, FIND ANOTHER CHANNEL
	HRRZ	D,A			;YES
GOTCHN:	MOVEM 	CDB,CDBTBL(D)	
	SKIPE	JFNTBL(D)		;CHECK FOR CONSISTENCY
	   ERR <SETCHN:  INCONSISTENT BOOK-KEEPING>,1
	MOVEM 	A,JFNTBL(D)
	HRRZ	1,A			;JFN
	DVCHR				;CLOBBERS 1,2,3
	MOVEM	1,DVDSG(CDB)		;SAVE DESIGNATOR
	MOVEM	2,DVCH(CDB)		;AND CHARACTERISTICS
	HLRZ	1,2
	ANDI	1,777			;GET DEVICE TYPE
	MOVEM	1,DVTYP(CDB)		;AND SAVE IT
	HRRZ	A,D			;CHANNEL INTO A
	POP	P,D			;RESTORE
	POP	P,C			
	POP	P,B
	POPJ	P,


;FIND AN OPEN CHANNEL AND RETURN THE NUMBER IN 2
FNDCHN:	SETZ	D,
FNDCH1:	CAILE	D,JFNSIZE
	   ERR <SETCHN:  JFN TABLE IS FULL (SHOULD NEVER HAPPEN)>
	SKIPE	CDBTBL(D)
	  AOJA	D,FNDCH1	   
	JRST	GOTCHN



DSCR SIMPLE INTEGER PROCEDURE ZSETST(INTEGER I);

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

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

HERE(ZSETST)
	MOVE USER,GOGTAB 		; GET USER
	MOVE	1,-1(P)		;GET EXPECTED LENGTH
	ADDM 1,REMCHR(USER) 		; ADD ON
	SKIPLE REMCHR(USER) 		; NEED TO COLLECT?
	  PUSHJ P,GOCOLLECT 		; YES
	MOVE 1,TOPBYTE(USER) 		; RETURN BP
	SUB P,X22 			; ADJUST STACK
	JRST @2(P) 			; RETURN

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

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


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

DEFINE CNTARG <-4(P)>
DEFINE BPARG <-3(P)>


	MOVE 	1,TOPBYTE(USER) 		; GET OLD TOPBYTE
	CAMN 	1,BPARG 			; THE NULL STRING?
	  JRST NULRET;
	MOVEI 2,1 			; SET UP FOR COUNT
MORE:	IBP 1 				; DO INCREMENTS
	CAIL 	2,CNTARG		;MORE THAN POSSIBLE?
	   ERR <DRYROT AT ZADJST&MORE>
	CAME	1,BPARG
	AOJA 2,MORE 				; NO, CONTINUE

GOTLNG:	HRRZ	1,2			;GET LENGTH
	HRLI	1,-1			
	PUSH 	SP,1 			; XWD -1,COUNT
       	PUSH SP,TOPBYTE(USER) 		; OLD TOPBYTE FOR BP FOR STRING
	SUB 2,CNTARG			; SUBTRACT THE COUNT ESTIMATE
	ADDM 2,REMCHR(USER) 		; MAKE REMCHR HONEST
	MOVE	2,BPARG		; GET THE NEW TOPBYTE
	MOVEM 2,TOPBYTE(USER) 		; AND SAVE IT
	POP	P,2
	POP	P,1
	SUB P,X33 			; ADJUST STACK
	JRST @3(P) ;

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

DSCR
	.RESET
SID	SAVES ALL ACS
CAL	PUSHJ

	RESETS TENEX IO AND BOOKKEEPING
THIS SHOULD ONLY BE CALLED INTERNALLY
⊗
HERE(.RESET)
	PUSH	P,1
;ZERO OUT BOOKKEEPING
	SETZM	JFNTBL
	MOVE	1,[XWD JFNTBL,JFNTBL+1]
	BLT	1,JFNTBL+JFNSIZE-1
	SETZM	CDBTBL
	MOVE	1,[XWD CDBTBL,CDBTBL+1]
	BLT	1,CDBTBL+JFNSIZE-1
	RESET
	POP	P,1
	POPJ	P,		;RETURN



ENDCOM(UTILITY)
COMPIL(PAGES,<PMAP>,<JFNTBL,CDBTBL>
	,<PAGES -- PAGE MANAGEMENT>)
DSCR SIMPLE PROCEDURE PMAP(INTEGER JFN,FILEPAGE,FORKNPAGE,ACCESS);
DESR
	Does the PMAP jsys, with these parameters:

	JFN:	THE CHANNEL
	FILEPAGE:	DESIRED PAGE OF FILE
	FORKNPAGE:	XWD FORK, PAGE (to map into)
	ACCESS:		GOOD BITS FOR AC3.

⊗
HERE(PMAP)
	VALCHN 1,-4(P),PMPERR
	HRLZ	1,1			;JFN IN LEFT HALF
	HRR	1,-3(P)			;FILEPAGE
	MOVE	2,-2(P)			;XWD FORK,PAGE
	MOVE 	3,-1(P)			;ACCESS BITS
	JSYS 	56			;PMAP
PMPRET:	SUB	P,[XWD 5,5]
	JRST	@5(P)
PMPERR:	ERR <PMAP:  ILLEGAL JFN>,1
	JRST	PMPRET
ENDCOM(PAGES)
IFN IMSSS,<
COMPIL(TT2,<PBTIN,INTTY,PSTIN>
	,<X22,.SKIP.,ZSETST,ZADJST>
	,<TT2 -- IMSSS TTY ROUTINES>)

DSCR INTEGER SIMPLE PROCEDURE PBTIN(INTEGER SECONDS);
DESR 
	Executes the PBTIN jsys, with timing of SECONDS.
⊗
HERE(PBTIN)
	EXCH	1,-1(P)
	JSYS	600
	EXCH	1,-1(P)
	SUB	P,X22
	JRST	@2(P)

DSCR STRING SIMPLE PROCEDURE INTTY;
	Using the PSTIN jsys, accepts as many as 200 characters from
the user's Teletype, with the standard system breakcharacters.  The
breakcharacter itself is removed from the string, and
no timing is available.  For fancier calls, see PSTIN routine.
⊗

HERE(INTTY)
	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	SETZ	3,			
	MOVEI	2,=200			;DEFAULT LENGTH
	PUSHJ	P,INTT2			
	POP	P,3
	POP	P,2
	POP	P,1
	POPJ	P,

;PUSHJ TO HERE
INTT2:	PUSH	P,[=200]
	PUSHJ	P,ZSETST		;GET BP IN 1
	PSTIN
	CAIL	2,=200			;DID WE GET 200 CHARS?
	   JRST	[SETOM	.SKIP.
		 JRST	INTT1]
	LDB	3,1			;GET THE LAST CHAR
	MOVEM	3,.SKIP.		;AND SAVE IT
	SOJ	1,			;BACK UP BYTE-POINTER (OVER LAST CHAR)
	IBP	1
	IBP	1
	IBP	1
	IBP	1
INTT1:	PUSH	P,[=200]
	PUSH	P,1
	PUSHJ	P,ZADJST		;GET STRING ON STACK
	POPJ	P,



DSCR STRING SIMPLE PROCEDURE PSTIN
(INTEGER MAXLENGTH,TIMING; STRING BRKS)
	This routine does the PSTIN jsys.  It reads MAXLENGTH characters from the TTY
(default is 200), with TIMING timing.  Breaks on any standard break character or the first
two characters in BRKS.  The break-character is removed from the value returned,
and put into .SKIP.
⊗
HERE(PSTIN)
	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	HRLZ	3,-1(P)		;TIMING
	AND	3,[777000000]
	HRRZ	1,-1(SP)	;LENGTH OF BRKS STRING
	JUMPE	1,PSTI1
	ILDB	2,(SP)		;FIRST CHAR
	SOJ	1,		;LESS ONE
	LSH	2,=9		;MOVE IT OVER
	JUMPE	1,PSTI1		;ANOTHER BREAK
	ILDB	1,(SP)		;SECOND CHAR
	OR	2,1		;AND PUT IT IN ALSO
	HRR	3,2		;XWD TIMING, CHAR 1 CHAR2
;HERE AC 3 IS SET UP
PSTI1:
	SKIPN	2,-2(P)		;COUNT?
	   MOVEI 2,=200		;DEFAULT
	SUB	SP,X22		;CLEAR OFF BRKS STRING
	PUSHJ	P,INTT2		;AND CALL ABOVE ROUTINE
	POP	P,3
	POP	P,2
	POP	P,1
	SUB	P,X33
	JRST	@3(P)
ENDCOM(TT2)
>;IFN IMSSS
COMMENT ⊗ TTY FUNCTIONS ⊗


DSCR TTY FUNCTIONS
CAL SAIL
⊗

Comment ⊗
INTEGER PROCEDURE INCHRW;
 RETURN A CHAR FROM PBIN

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

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

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

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

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

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


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

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


PROCEDURE CLRBUF;
 CLEARS INPUT BUFFER (CFIBF)

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

	TITLE	TTYUUO
⊗

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

HERE (INCHRS)
	MOVEI	1,100
	SIBE
	   JRST	INCHR1
	SETO	1,		;RETURN -1
	POPJ	P,
INCHR1:
	PBIN			
	POPJ	P,

HERE(PBOUT)
HERE (OUTCHR)	
	EXCH	1,-1(P)		;GET PARAMETER, SAVING AC 1
	PBOUT			;OUTPUT CHAR	
	EXCH	1,-1(P)		;GET BACK 1	
	SUB	P,X22
	JRST	@2(P)		;RETURN


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

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

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

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

;CALL TO HERE WITH A PUSHJ TO GET A CHAR IN AC1
;AC 3 HAS THE COUNT, D THE BYTE-POINTER
EDICHR:
	PBIN			;GET A CHARACTER
	CAIN	1,"U"-100	;CONTROL-U?
	   JRST	CTRLU
	CAIN	1,177		;RUBOUT?
	   JRST	RUBOUT
	POPJ	P,		;GOOD CHAR FOR USER
	
CTRLU:	
;AC 1 IS FREE
	HRROI	1,[BYTE (7) 7,"↑","U",15,12
		   0]		;MESSAGE
	PSOUT	
	JUMPE	C,EDICHR	;IF NO CHARS THEN DO NOTHING
	SETZ	C,
	MOVE	D,TOPBYTE(USER)
	JRST	EDICHR

RUBOUT:	JUMPE	C,CTRLU		;IF NO CHARS THEN DO CTRLU
;AC 1 IS AVAILABLE
	MOVEI	1,"\"
	PBOUT
	LDB	1,D		;GET LAST CHAR
	PBOUT			;AND SEND IT
IFN IMSSS,<
	MOVEI	1,377		;THREE RUBOUTS FOR IMLACS
	PBOUT
	PBOUT
	PBOUT
>;IFN IMSSS
	SOJ	D,		;BACK UP BP TO LAST CHAR
	IBP	D
	IBP	D
	IBP	D
	IBP	D
	SOJA	C,EDICHR	;AND GET ANOTHER CHAR

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

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

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

INS3:	CAILE	C,=200		;COUNT EXHAUSTED?
	  JRST	DNSTR1		;YES
	PUSHJ	P,EDICHR	;GET A CHAR
	CAIN	1,37		;EOL?
	   JRST	[MOVEI	1,12	;MAKE IT AN LF	    
		 JRST	DNSTR]
	CAIN	1,33		;ALTMODE?
	   JRST	[MOVEI	1,175	;MAKE IT A REAL ALTMODE
		 JRST	DNSTR]
	CAIE	1,175		;ALTMODE?
	CAIN	1,12
	   JRST	DNSTR
	CAIN	1,15		;CR?	
	   JRST	INS3		;IGNORE
	IDPB	1,D		;PUT IT AWAY AND
	AOJA	C,INS3		;NEXT CHARACTER

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


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

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

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

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


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

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

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

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

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

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

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

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

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

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

ENDCOM(FLS)
COMPIL(INP,<INPUT,CHARIN>
	,<INSET,STRNGC,BRKMSK,X33,GOGTAB,JFNTBL,CDBTBL>
	,<STRING INPUT ROUTINE>)


DSCR  CHAR←CHARIN(CHANNEL)
⊗
HERE(CHARIN)
	BEGIN CHARIN
	PUSH	P,CDB
	PUSH	P,CHNL
	PUSH	P,D
	SKIPL	CHNL,-3(P)
	CAILE	CHNL,JFNSIZE
	   JRST	CHABAD	
	MOVE	CDB,CDBTBL(CHNL)		;CDB
	SKIPN	CHNL,JFNTBL(CHNL)		;JFN IN CHNL FOR DOINP
	   JRST	CHABAD
	SKIPE	ENDFL(CDB)			;EOF LOCATION?
	   SETZM @ENDFL(CDB)			;YES, ASSUME GOOD
	SOSG	ICOWNT(CDB)
	   JRST	[PUSHJ P,DOINP
		 JRST	IN1			;36-BIT RETURN 
	 	 JRST	INB			;7-BIT RETURN	(WITH CHAR IN D)
		 JRST	CHAEOF			;END OF FILE OR ERROR
		]
IN1:	ILDB	D,IBP(CDB)
INB:	MOVE	1,D				;CHAR IN 1
CHARET:	POP	P,D
	POP	P,CHNL
	POP	P,CDB
	SUB	P,X22
	JRST	@2(P)

CHAEOF:	SKIPE	ENDFL(CDB)			;LOCATION GIVEN?
	  SETOM	@ENDFL(CDB)			;YES
CHABA1:	SETZ	1,				;RETURN NULL BYTE
	JRST	CHARET

CHABAD:	ERR <CHARIN:  ILLEGAL JFN>,1
	JRST	CHABA1

	BEND CHARIN
DSCR STRING SIMPLE PROCEDURE SINI(INTEGER JFN,MAXLENGTH,BRKCHAR);
	Reads in a string of characters, terminated by BRKCHAR or	
reaching maxlength, whichever happens first.
	.SKIP.  will be -1 if call terminated for count, else
it will have the breakcharacter.
⊗

HERE(SINI)
	BEGIN	SINI

	PUSHJ	P,SAVE
	MOVE	LPSA,X44
	VALCHN	CHNL,<-3(P)>,SINBAD
	SKIPE	ENDFL(CDB)		;EOF LOCATION?
	   SETZM @ENDFL(CDB)		;YES, ASSUME NO EOF
	SKIPG	C,-2(P)			;ANY COUNT?
	  JRST	NULRET
	LDB	B,[POINT 6,OFL(CDB),5]
	CAIE	B,=36			;36-BIT BYTES?
	   JRST	SIN7
	PUSH	P,C
	PUSHJ	P,ZSETST		;GET GOOD BYTE-POINTER IN 1
	MOVN	C,C			;NEGATE THE COUNT
IN1:	SOSG	ICOWNT(CDB)
	  JRST	[PUSHJ	P,DOINP
		JRST	IN2		;36-BIT
		ERR <SINI:  INCONSISTENCIES>;7-BIT??
		JRST	SINEOF]
IN2:	ILDB	D,IBP(CDB)
	JUMPE	D,IN3
	CAIN	D,-1(P)			;BREAK CHARACTER?
	   JRST	DOBRK			;YES
	IDPB	D,1
IN3:	AOJL	C,IN1
	SETOM	.SKIP.			;INDICATE COUNT EXHAUSTED
FIXSTR:	PUSH	P,-2(P)			;ORIGINAL COUNT
	PUSH	P,1			;BP
	PUSHJ	P,ZADJST
	JRST	RESTR
DOBRK:	MOVEM	D,.SKIP.
	JRST	FIXSTR


SIN7:	CAIE	2,7			;MUST BE 7-BIT
	  JRST	SINBAD
	PUSH	P,-2(P)			;MAXLENGTH
	PUSHJ	P,ZSETST
	MOVE	2,1			;BYTE-POINTER IN 2
	HRRZ	1,CHNL			;THE JFN
	MOVE	3,-2(P)			;MAXLENGTH
	MOVE	4,-1(P)			;OPTIONAL BREAKCHARACTER
	JSYS 	52			
	HRRZ	1,CHNL			;CHECK EOF
	GTSTS				;CHECK STATUS
	TDNE	2,[1B8]			;EOF
	  JRST	NOEOF			;NO
	SKIPE	ENDFL(CDB)		;LOCATION?
	  SETOM	@ENDFL(CDB)
	SETZM	.SKIP.
NOEOF:
	PUSH	P,-2(P)			;MAXLENGTH
	PUSH	P,2			;UPDATED BYTE-POINTER
	PUSHJ	P,ZADJST
SINRET:	JRST	RESTR

SINBAD:	ERR <SINI:  ILLEGAL JFN OR ILLEGAL BYTE-SIZE>,1
NULRET:	PUSH	SP,[0]			;RETURN NULL STRING
	PUSH	SP,[0]
	JRST	RESTR
	
SINEOF:	SKIPE	ENDFL(CDB)
	  SETOM	@ENDFL(CDB)
	SETZM	.SKIP.			;BROKE ON A NULL I SUPPOSE
	JRST	FIXSTR			;RETURN WHAT WE HAVE

	BEND SINI

COMMENT ⊗Input ⊗

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

.IN.:
HERE (INPUT)	
	MOVE	USER,GOGTAB	;GET TABLE POINTER
	MOVEM	RF,RACS+RF(USER);SAVE F-REGISTER
	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	SKIPL	CHNL,-2(P)	;CHANNEL NUMBER
	CAILE	CHNL,JFNSIZE	
	  JRST	INPBAD
	MOVE	CDB,CDBTBL(CHNL)
	SKIPN	CHNL,JFNTBL(CHNL)	;GET JFN
	  JRST	INPBAD
	LDB	E,[POINT 4,OFL(CDB),9] ;DATA MODE
	SKIPE	ENDFL(CDB)	;EOF LOCATION
	  SETZM	@ENDFL(CDB)	;YES, HELP USER ASSUME NO EOF
	SKIPE	BRCHAR(CDB)	;BRCHAR LOCATION
	  SETZM	@BRCHAR(CDB)	;ASSUME NO BREAK CHAR
	MOVEI	A,=200		;DEFAULT NO. OF CHARS
	SKIPE	ICOUNT(CDB)	;USER-SPECIFIED COUNT?
	  HRRZ	A,@ICOUNT(CDB)	;MAX COUNT FOR INPUT STRING
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)	;ENOUGH ROOM?
	PUSHJ	P,STRNGC	;NO, TRY TO GET SOME
	SKIPL	C,-1(P)		;GET TABLE #, CHECK IN BOUNDS
	CAILE	C,=18
	  ERR	<IN: THERE ARE ONLY 18 BREAK TABLES>
	HRRZ	TEMP,USER
	ADD	TEMP,C		;TABLE NO(USER)
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
	  MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
	MOVN	B,A		;NEGATE MAX CHAR COUNT
	PUSH	SP,[0]		;LEAVE ROOM FOR FIRST STR WORD
	PUSH	SP,TOPBYTE(USER)	;SECOND STRING WORD
	MOVE	Q,BRKMSK(C)	;GET MASK FOR THIS TABLE
	HRRZ	Y,USER
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
	JUMPE	B,DONE1		; BECAUSE THE AOJL WON'T

	
.IN:	SOSG	ICOWNT(CDB)	;BUFFER EMPTY?
	JRST	[ PUSHJ	P,DOINP
		  JRST	IN1	;36-BIT RETURN
		  JRST	INB	;7-BIT RETURN (WITH CHAR IN D)
		  JRST	DONE1	;EOF OR ERROR
		]
IN1:	
	ILDB	D,IBP(CDB)	;GET NEXT CHARACTER
    	TDNE	Z,@IBP(CDB)	;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
	JRST	INLINN		;YES, GO SEE WHAT TO DO
IN2:
INB:	JUMPE	D,.IN		;ALWAYS IGNORE 0'S
	TDNE	Q,@Y		;MUST WE DO SOMETHING SPECIAL?
	JRST	INSPC		;YES, HANDLE

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

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

;  BREAK -- STORE BREAK CHAR, FINISH OFF

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

RETAIN:	PUSHJ	P,BACKUP
	JRST	DONE1

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


;  DONE -- MARK STRING COUNT WORD

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

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




COMMENT ⊗ BACKUP, DOINP TO BACKUP JFN, DO INPUT. ⊗

;CALL TO HERE WITH A PUSHJ, WITH CDB,CHNL LOADED
↑BACKUP:
	PUSH	P,1
	LDB	1,[POINT 6,OFL(CDB),5]	;BYTE-SIZE
	CAIN 	1,44
	  JRST	BACKU1
;HERE USE BKJFN	
	HRRZ	1,CHNL		;THE JFN
	JSYS	42		;BKJFN
	  ERR <BACKUP:  CANNOT DO RETAIN MODE ON THIS FILE>,1
BACRET:	POP	P,1
	POPJ	P,
BACKU1:	SOS	IBP(CDB)
	IBP	IBP(CDB)
	IBP	IBP(CDB)
	IBP	IBP(CDB)
	IBP	IBP(CDB)
	AOS	ICOWNT(CDB)
	JRST	BACRET

	

;CALL TO HERE WITH PUSHJ
;RETURNS +1 FOR 36-BIT INPUT, +2 FOR 7 BIT INPUT (WITH CHAR IN D),
;+3 FOR END OF FILE

↑DOINP:	PUSH	P,1
	PUSH	P,2
	PUSH	P,3
	CAIN	E,17		;DUMP MODE
	 JRST	 DMPI		; YES
;36 BIT BYTES (SIN) OR 7 BIT (BIN)
	LDB	1,[POINT 6,OFL(CDB),5]	;BYTE-SIZE			
	CAIN	1,44		;36 BIT
	   JRST	DOSIN
	CAIE	1,7		;7-BIT
	   JRST	INPBAD		;ERROR
;HERE TO DO 7-BIT INPUT
DOBIN:	
	HRRZ	1,CHNL	
	BIN
	JUMPE	2,[GTSTS	;CHECK STATUS
		   TDNN 2,[1B8]	;EOF?
		      JRST DOIEOF
		   SETZ  2,
		   JRST .+1
		  ]
	MOVE	D,2		;GET THE CHAR IN D
	CAIN	D,32		;A CONTROL-Z?
	 JRST	[MOVE	1,DVTYP(CDB)
		 CAIE	1,12	;A TTY?		 
		   JRST	.+1	;NO		 
		 JRST	DOIEOF
		]		
	SETZM	ICOWNT(CDB)	;0 COUNT (SINCE NO MORE ARE WAITING)
	POP	P,3
	POP	P,2
	POP	P,1
	AOS	(P)		;7-BIT RETURN
	POPJ	P,

DOIEOF:	SKIPE	ENDFL(CDB)	;LOCATION?
	   SETOM @ENDFL(CDB)	;YES, SET IT
	SETZM	ICOWNT(CDB)	;ZERO THE COUNT
	SETZM	IBP(CDB)	;AND THE BP
	POP	P,3
	POP	P,2
	POP	P,1
	AOS	(P)		;INDICATE EOF
	AOS	(P)
	POPJ	P,

DOSIN:	MOVE	1,CHNL		;JFN	
	MOVEI	2,STARTPAGE(1)	;THE PAGE	
	IMULI	2,1000		;THE CORE ADDRESS

	HRL	3,2
	HRRI	3,1(2)
	SETZM	(2)
	BLT	3,777(2)	;ZERO BUFFER

	HRLI	2,444400	;BYTE-POINTER
	MOVNI	3,1000		;1000 WORDS
	SIN			;INPUT
	CAMG 3,[-1000]		;SOMETHING RECEIVED?
	  JRST [CAMN	3,[-1000]	;NOTHING AT ALL?
		  JRST	DOIEOF	;NOT A SINGLE WORD
		JRST	.+1
	       ]
       	ADDI	3,1000		;GET NUMBER OF WORDS READ
	IMULI	3,5		;NUMBER OF CHARACTERS
DO36CN:	MOVEM	3,ICOWNT(CDB)	;REMEMBER
	MOVEI	2,STARTPAGE(1)
	IMULI	2,1000
	HRLI	2,440700	;BYTE-POINTER
	MOVEM	2,IBP(CDB)	;REMEMBER
DOIRET:	POP	P,3
	POP	P,2
	POP	P,1
	POPJ	P,


; DUMP MODE -- ESPECIALLY FOR MAGTAPES
DMPI:
	PUSH	P,4		;SAVE AN EXTRA AC
	MOVE	1,CHNL		
	MOVEI	3,STARTPAGE(1)
	IMULI	3,1000		;THE ADDRESS OF THE BUFFER

	HRL	2,3		;ZERO BUFFER
	HRRI	2,1(3)
	SETZM	(3)
	BLT	2,777(3)

	SUBI	3,1
	HRLI	3,-1000		;MAKE AN IOWD
	MOVEI	2,3		;COMMAND LIST STARTS AT 3
	SETZ	4,		;COMMAND LIST ENDS AT 4
	DUMPI
	  JRST	DMIERR		;AN ERROR
	MOVEI	3,1000*5	;NO. OF CHARACTERS
	POP	P,4		;RESTORE EXTRA AC
	JRST	DO36CN		;SET UP COUNT, BP, AND RETURN

DMIERR:	CAIN	1,600220	;EOF?
	  JRST	DMIEOF		;YES
	ERR	<INPUT:  DUMP MODE ERROR>

DMIEOF:
	MOVE	1,DVTYP(CDB)
	CAIE	2,3		;MAGTAPE?
	  JRST	DOIEOF
	HRRZ	1,CHNL
	SETZ	2,
	MTOPR			;RESET STATUS
	POP	P,4		;RESTORE EXTRA AC
	JRST	DOIEOF
	

;LINE NUMBER STUFF

INLINN:
NOPGNN:
	MOVE	TEMP,-1(P)	;GET LINE NUMBER DISPOSITION FLAG,
	ADD	TEMP,USER	;RLC+TABLE
	SKIPGE	TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
	 JRST	 GIVLIN	; WANTS IT NEXT TIME OR SOMETHING

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

EATLIN:
	AOS	IBP(CDB)	;FORGET IT ENTIRELY
	MOVNI	5		;INDICATE SKIPPING SIX
	ADDB	ICOWNT(CDB)	;IN COUNT
	SKIPLE			;OVERFLOW BUFFER?
	JRST	(TEMP)		;NO, CONTINUE
	PUSHJ	P,DOINP
	JRST	OKLN		;36-BIT RETURN
	ERR	<INPUT:  7-BIT BYTES CANNOT HAVE LINE NUMBERS>
	JRST	DONE1		;END-OF-FILE
OKLN:	SOSG	ICOWNT(CDB)	;IF ONLY ONE CHAR,
	JRST	DONE1
	IBP	IBP(CDB)	;GET OVER TAB FINALLY
	JRST	(TEMP)		;AND CONTINUE


GIVLIN:	TRNE	TEMP,-1		;WANT LINE NO IN BRCHAR WORD?
	 JRST	 GVLLN		;NO, WANTS IT NEXT TIME.
	SKIPL	TEMP,@IBP(CDB)	;NEGATED LINE NO
	MOVNS	TEMP
	SKIPE	BRCHAR(CDB)	;USER LOCATION?
	MOVEM	TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
	JSP	TEMP,EATLIN	;GO EAT UP LINE NUMBER AND
	JRST	DONE1		;FINISH UP
GVLLN:
	SKIPE	BRCHAR(CDB)
	  SETOM	@BRCHAR(CDB)	;TELL THE USER
	AOS	ICOWNT(CDB)	;REVERSE THE SOSLE
	MOVEI	Y,1		;TURN OFF LINE NUMBER 
	ANDCAM	Y,@IBP(CDB)	;  BIT
	MOVSI	Y,070000	;BACK UP BYTE POINTER
	ADDM	Y,IBP(CDB)
	JRST	DONE1		;FINISH OFF IN BAZE OF GORY

INPBAD:	ERR <INPUT:  ILLEGAL JFN OR BAD INPUT>

ENDCOM(INP)
COMPIL(NUM,<REALIN,REALSCAN,INTIN,INTSCAN>
	  ,<SIMIO,SAVE,RESTR,X22,X33,GETCHN,NOTOPN,.CH.,.MT.,.TEN.,BACKUP,DOINP>
	  ,<LOU PAUL'S NUMBER INPUT AND CONVERSION ROUTINES>)
COMMENT ⊗Realin, Realscan ⊗

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

HERE (REALIN)
IFN ALWAYS,<BEGIN NUMIN>

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

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

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

LFMP:
	;MULTIPLIES AND NORMALIZES
	MUL A,.MT.(Y)
	TLNE A,200000
	JRST (Q)
	ASHC A,1
	SOJA X,(Q)
	SUBTTL	INTIN	INTEGER NUMBER INPUT ROUTINE	LOU PAUL
COMMENT ⊗Intin, Intscan ⊗

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

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

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

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

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

	DEFINE ASTERN(NULL,POINT,MINUS,PLUS,E,CHA)<
	SETZ X,
	LSHC X,3
	JRST @.+1(X)
	JUMP NULL
	JUMP POINT
	JUMP MINUS
	JUMP PLUS
	JUMP E
	JUMP CHA
	JUMP CHA>

	SKIPL	CHNL,-2(P)
	CAILE	CHNL,JFNSIZE
	  JRST	NUMBAD
	MOVE	CDB,CDBTBL(CHNL)
	SKIPN	CHNL,JFNTBL(CHNL)
	  JRST 	NUMBAD

	SKIPE	ENDFL(CDB)
	SETZM @ENDFL(CDB);	CLEAR EOF AND BREAK FLAGS
	SKIPE	BRCHAR(CDB)
	  SETZM @BRCHAR(CDB)
	MOVE LPSA,[JSP X,NCH]
	MOVEI Z,1;		FOR LINE NUMBER TEST
	PUSHJ P,SCAN
	SKIPE	BRCHAR(CDB)
	  MOVEM D,@BRCHAR(CDB);	FIX UP BREAK CHARACTER
	PUSHJ	P,BACKUP	;BACKUP FOR NEXT TIME

	POPJ P,

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

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

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

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

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

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

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

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

	XCT LPSA
EEXP:	AHEAD(EXP9,ERR2,ERR5,ERR5,ERR1,EN,EN)
EN:	TRNE Q,4;		SIGN OF EXPONENT
	MOVNS FF
	ADD C,FF;		FIX UP EXPONENT
	JOV ERR3

DONE:	ANDI D,177
	JUMPGE Q,.+2
	SETO D,
	POPJ P,

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

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

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

DP1:	TROE Q,1
	JRST ERR2
	XCT LPSA
	AHEAD(INT5,ERR2,ERR5,ERR5,EXP6,DONE,DONE)

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

EXP7:	TRO Q,4
EXP8:	XCT LPSA
	AHEAD(EXP2,ERR2,ERR5,ERR5,ERR1,ERR1,ERR1)

NCH:	SOSG ICOWNT(CDB);	DECREMENT CHARACTER COUNT
	JRST	[PUSHJ	P,DOINP
		 JRST	.+1	;36-BIT RETURN
		 JRST (5)	;7-BIT RETURN
		 JRST	NCH7	;EOF OR ERROR
		]
NCH1:	ILDB D,IBP(CDB);	LOAD BYTE
	TDNE Z,@IBP(CDB);	CHECK FOR LINE NUMBER
	JRST NCH5
	JRST (X);		RETURN

NCH7:	MOVEI D,200
	JRST (X)

NCH5:	AOS IBP(CDB);		WE HAVE A LINE NUMBER
	MOVNI TEMP,5;		MOVE OVER IT
	ADDB TEMP,ICOWNT(CDB)
	SKIPLE TEMP;		NOTHING LEFT
	JRST NCH;		DO ANOTHER INPUT
	JRST	[PUSHJ	P,DOINP
		 JRST	NCH6	;36-BIT RETURN
		 ERR <NUMIN: CANNOT HANDLE THIS FILE IN 7-BIT BYTES>
		 JRST	NCH7	;EOF RETURN
		]
NCH6:	SOSG ICOWNT(CDB);	REMOVE TAB
	JRST NCH7		;NONE THERE OR ERROR
	IBP IBP(CDB)
	JRST NCH

STRIN:	MOVE LPSA,[JSP X,NCHA]
	HRRZ Z,-3(P)
	HRRZ Z,-1(Z)
	PUSHJ P,SCAN
	HRRZ X,-3(P)
	
	SOS (X)			;BACK UP BYTE POINTER
	FOR II←1,4<
	IBP (X)>
	AOJ Z,
	HRRM Z,-1(X)
	MOVEM D,@-2(P)		;STORE BREAK CHARACTER
	POPJ P,

NCHA:	SOJL Z,NCH7
	HRRZS	-4(P)
	ILDB D,@-4(P)
	JRST (X)

ERR1:	ERR(<NUMIN: IMPROPER EXPONENT>,1,RZ)

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

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

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

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

NUMBAD:	ERR <NUMIN:  ILLEGAL JFN>

RZ:	SETZ A,
	JRST DONE

TAB:	FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,6,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
>
	FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
>
	FOR A IN (5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (4,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	XWD -1,6

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

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

ENDCOM(TBB)
IFN ALWAYS,<
	BEND
>;IFN ALWAYS
COMPIL(STDBRK,<STDBRK>,<SAVE,RESTR,GOGTAB,X22>
	,<STDBRK -- STANDARD BREAKSET ROUTINE>)
COMMENT ⊗Stdbrk ⊗

DSCR STDBRK(CHANNEL);
CAL SAIL
⊗

HERE (STDBRK)
	PUSHJ	P,SAVE
	MOVSI	1,100001		
	MOVE	2,[ASCIZ/<SUBSYS>BKTBL.BKT/]
	GTJFN
	  ERR	<STANDARD BREAK TABLE NOT FOUND>
	PUSH	P,1			;SAVE JFN
	MOVE	2,[XWD 440000,200000]
	OPENF
	  ERR	<CANNOT OPENF <SUBSYS>BKTBL.BKT>
	MOVE	USER,GOGTAB
	MOVSI	2,444400		;BYTE-POINTER
	HRR	2,DSPTBL(USER)		;ADDRESS
	MOVNI	3,=19+=19+=128
	SIN
	CLOSF
	  JFCL
	POP	P,1			;RESTORE JFN
	RLJFN	
	  JFCL
	MOVE	LPSA,X22
	JRST	RESTR



IFN ALWAYS, <BEND IOSER>
DSCR BEND IOSER ⊗