perm filename IOSER.OLD[S,AIL] blob sn#263537 filedate 1977-02-13 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00035 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	HISTORY
C00012 00003	Indices, Bits for IOSER 
C00015 00004	Simio, Ioinst, Lpryer, Cserr 
C00027 00005	Getchn 
C00030 00006	Filnam 
C00037 00007	Flscan 
C00040 00008	Open 
C00046 00009
C00052 00010	Release 
C00057 00011	Lookup, Enter 
C00061 00012	
C00062 00013	Fileinfo 
C00064 00014	Out 
C00068 00015	Input 
C00078 00016	Realin, Realscan 
C00080 00017	Intin, Intscan 
C00082 00018	DSCR NUMIN
C00085 00019	NUMIN -- CONTD.
C00089 00020	SCAN (CALLED BY NUMIN AND STRIN)
C00094 00021	   Character table for SCAN (Realscan,Intscan,Realin,Intin)
C00096 00022	DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
C00098 00023	Arryout, Wordout 
C00103 00024	Arryin, Wordin 
C00113 00025	Linout 
C00115 00026	Breakset,setbreak,stdbrk fakes
C00116 00027	Close, Closin, Closo
C00118 00028	Mtape 
C00120 00029	 Useti, Useto, Rename 
C00123 00030	where Usercon used to be
C00124 00031	Ttyuuo functions 
C00143 00032	Ptyuuo functions 
C00152 00033	  TMPIN (input from a tmpcor file)
C00159 00034	  TMPOUT (output to a tmpcor file)
C00167 00035
C00168 ENDMK
C⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  102100000075  ⊗;


COMMENT ⊗
VERSION 17-1(61) 10-18-74 BY rls check herefks
VERSION 17-1(60) 10-14-74 BY JFR FIX BUG IN INPUT
VERSION 17-1(59) 10-14-74 BY JFR REMOVE HACK'S
VERSION 17-1(58) 10-13-74 BY JFR %BS% BREAK TABLE BUGS
VERSION 17-1(57) 10-11-74 BY JFR FIS TYPOS %BS%
VERSION 17-1(56) 10-11-74 BY JFR MINOR FIX TO INPUT %BS%
VERSION 17-1(55) 10-11-74 BY RHT FEAT %BQ% MAKE CLOSE TAKE INHIBIT BITS AS ARG
VERSION 17-1(54) 10-11-74 BY JFR REMOVE HEREFK'S
VERSION 17-1(53) 10-11-74 BY JFR FEAT %BS% NEW WAY TO DO BREAK TABLES
VERSION 17-1(52) 10-10-74 BY JFR FEAT %BS% NEW WAY TO DO BREAK TABLES
VERSION 17-1(51) 9-27-74 BY JFR FIX AUTHOR REASON STUFF
VERSION 17-1(50) 8-8-74 BY LDE BUG #TB# TYPO IN INPUT PREVENTED SETPL PAGENUM TO WORK
VERSION 17-1(49) 5-24-74 
VERSION 17-1(48) 5-24-74 
VERSION 17-1(47) 5-24-74 BY rht mode saibrk & saiprn to strser
VERSION 17-1(46) 5-24-74 
VERSION 17-1(45) 5-24-74 
VERSION 17-1(44) 5-24-74 
VERSION 17-1(43) 5-24-74 
VERSION 17-1(42) 5-24-74 
VERSION 17-1(41) 5-24-74 
VERSION 17-1(40) 5-19-74 
VERSION 17-1(39) 5-19-74 
VERSION 17-1(38) 5-19-74 
VERSION 17-1(37) 5-19-74 
VERSION 17-1(36) 5-5-74 BY RHT ADD $PRINT
VERSION 17-1(35) 5-5-74 
VERSION 17-1(34) 5-5-74 
VERSION 17-1(33) 5-5-74 BY  JRL BUG #RX# (CMU =B7=) LDE  SAYS SOSNUM,LINNUM,PAGNUM S/B INITIALIZED
VERSION 17-1(32) 3-26-74 BY RHT FEAT %AX% FINISH UP SETPL (POLISH IT LATER!!!)
VERSION 17-1(31) 3-26-74 BY RHT SOMEONE (ON 12 MARCH 1974) RAN SOS ON THIS FILE!
			IF ANY TIME BOMBS WERE PLANTED, WE WILL FIND OUT!
VERSION 17-1(30) 2-22-74 BY RHT FEAT %BG% ADD BREAKSET MODE "F"
VERSION 17-1(29) 2-1-74 BY RHT BUG #QY# USBSTS NEEDED PATCHING
VERSION 17-1(28) 2-1-74 
VERSION 17-1(27) 1-12-74 BY RHT MAKE COUNT RIGHT IN INOUT
VERSION 17-1(26) 1-12-74 
VERSION 17-1(25) 1-12-74 BY RHT FIX COMPIL FOR SAITTY
VERSION 17-1(24) 1-11-74 BY RHT TTYINL STUFF
VERSION 17-1(23) 1-11-74 BY RHT MERGE IN CMU CHANGES
VERSION 17-1(22) 1-11-74 
VERSION 17-1(21) 1-11-74 
VERSION 17-1(20) 1-11-74 
VERSION 17-1(19) 1-11-74 
VERSION 17-1(18) 12-15-73 BY RFS FIX BUGS QC,QD.
VERSION 17-1(17) 12-10-73 BY JRL REMOVE LAST REFERENCES TO PGNNO
VERSION 17-1(16) 12-10-73 
VERSION 17-1(15) 12-10-73 
VERSION 17-1(14) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 17-1(13) 12-8-73 BY RFS MAKE ALTMODE 33 FOR EXPORT SYSTEMS
VERSION 17-1(12) 12-5-73 BY RHT BUG #PO#
VERSION 17-1(11) 12-5-73 
VERSION 17-1(10) 12-5-73 
VERSION 17-1(9) 12-3-73 BY RFS REMOVE ALL III DISPLAY STUFF
VERSION 17-1(8) 12-2-73 BY RHT FIX INPUT
VERSION 17-1(7) 12-2-73 BY RLS EDIT
VERSION 17-1(6) 12-2-73 BY RHT ALSO SOME WRD SPARES
VERSION 17-1(5) 12-2-73 BY RHT FEAT %AV% CHNCDB.  ALSO SPARES ADDED TO OPN & BRK
VERSION 17-1(4) 12-2-73 
VERSION 17-1(3) 12-1-73 BY RLS BUG #PM#  DONT LOSE A CHAR IN INPUT
VERSION 17-1(2) 12-1-73 BY RLS ADD SETPL FUNCTION
VERSION 17-1(1) 7-27-73 BY JRL CHANGE OPEN TO FACT THAT RELEASE NOW TAKES TWO ARGUMENTS
VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(45) 5-7-73 BY JRL CHANGE PTYALL TO HANDLE LARGER BUFFERS
VERSION 16-2(44) 3-21-73 BY JRL ADD COMPIL(SAIDM3)
VERSION 16-2(43) 2-25-73 BY RHT BUG #LP# GO TO OUT OF PROCESS SHOULDNT LOOP!
VERSION 16-2(42) 2-14-73 BY RHT BUG #LM# TYPO IN PITBND
VERSION 16-2(41) 1-9-73 BY RHT REPAIR COMPIL FOR SAIPIT
VERSION 16-2(40) 12-2-72 BY RHT MODIFY PIT STUFF FOR NEW INFOTAB &DATAB
VERSION 16-2(39) 12-1-72 BY JRL CHANGE LEAP INDEX USED TO CALL FRELS WITHIN BEXIT
VERSION 16-2(38) 11-28-72 BY RHT ADD CLEANUPS TO BEXIT CODE
VERSION 16-2(37) 9-24-72 BY JRL LIBRARY REQUESTS
VERSION 16-2(36) 9-21-72 BY JRL ADD DADDY CURSCB ETC TO DUM
VERSION 16-2(35) 8-31-72 BY JRL RELEASE VALUE SETS CORRECTLY IN STKUWD
VERSION 16-2(34) 8-27-72 BY RHT CHANGE SPOT IN WHICH STKUWD SAVES RETN
VERSION 16-2(33) 8-23-72 BY JRL ADD FORGET CONTEXT CODE TO BEXIT
VERSION 16-2(32) 8-14-72 BY RHT EVAL NOW NAMED APPLY
VERSION 16-2(31) 7-22-72 BY RHT ADD KILL LIST TO BEXIT
VERSION 16-2(30) 7-12-72 BY DCS BUG #IN# PTYALL INVALID REMCHR PROBLEM
VERSION 16-2(29) 7-3-72 BY DCS MANY THINGS
VERSION 16-2(28) 6-7-72 BY DCS BUG #HO# RETURN BOTH ADDRESSES FROM ..ARCOP FOR .MES2
VERSION 16-2(27) 5-24-72 BY RHT CHANGE STKUWD TO LOOK AT PPDA
VERSION 16-2(26) 5-15-72 BY JRL ARRPDP BUG AGAIN
VERSION 16-2(24) 5-11-72 BY DCS BUG #HC# BETTER EXPO OUTSTR
VERSION 16-2(23) 5-11-72 BY DCS BUG #HA# IMPRV. ERR. ENB, FIX MUDDY FEET IN EXPO
VERSION 16-2(22) 5-11-72 BY DCS BUG #GT# ALLOW LARGE OCTAL PPNS
VERSION 15-6(17-21) 5-4-72 
VERSION 15-6(17) 3-7-72 BY DCS FIX OUTSTR(NULL) GARBAGING
VERSION 15-6(7-16) 2-20-72 
VERSION 15-6(6) 2-18-72 BY RHT CREATE THE NEW WORLD
VERSION 15-2(5) 2-6-72 BY DCS BUG #FQ# (WD-ARRY)(IN-OUT) WORD COUNT KEPT RIGHT, IOERR OK, DUMP MODE OK
VERSION 15-2(4) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR
VERSION 15-2(3) 2-1-72 BY DCS BUG #GF# INCHWL BREAKS ON MORE THINGS, TELLS WHAT THEY ARE
VERSION 15-2(2) 1-25-72 BY DCS BUG #GD# Fix non-standard buffer size setup in OPEN
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER

⊗;

COMMENT ⊗Indices, Bits for IOSER ⊗
	LSTON	(IOSER)

IFN ALWAYS,<BEGIN IOSER>
DSCR IOSER -- IOSER GENERAL DISCUSSION
 ;SEE GOGOL FOR MORE DETAILS
 ; FORMAT OF CDBs
 DMODE	←← 0	;DATA MODE
 DNAME	←← 1	;DEVICE
 BFHED	←← 2	;HEADER POINTERS
 OBPNT	←← 3	;OUTPUT BUFFER POINTER
 OBP	←← 4	;OUTPUT BYTE POINTER
 OCOWNT	←← 5	;OUTPUT BYTE COUNT
 ONAME	←← 6	;OUTPUT FILE NAME -- FOR INFORMATION ONLY
 OBUF	←← 7	;OUTPUT BUFFER LOCATION
 IBPNT	←←10	;SAME STUFF FOR INPUT
 IBP	←←11
 ICOWNT	←←12
 INAME	←←13
 IBUF	←←14
 ICOUNT	←←15	;INPUT DATA COUNT LIMIT ADDRESS
 BRCHAR	←←16	;XWD TTYDEV FLAG, INPUT BREAK CHAR ADDR
 TTYDEV  ←←16	;LH -1 IF DEVICE IS A TTY -- USED BY OUT
 ENDFL	←←17	;INPUT END OF FILE FLAG ADDR
 ERRTST	←←20	;USER ERROR BITS SPECIFICATION WORD
 LINNUM  ←←21		;ADDR OF LINE NUMBER WORD (SETPL FUNCTION)
 PAGNUM  ←←22		;ADDR OF PAGE NUMBER WORD (SETPL FUNCTION)
 SOSNUM  ←←23		;ADDR OF SOS NUMBER WORD  (SETPL FUNCTION)

 ; SIMIO INDICES

 ?IOSTATUS	←←0
 ?IOIN		←←1	;SEE EXPLANATIONS IN SIMIO ROUTINE
 ?IODIN		←←2
 ?IOOUT		←←3
 ?IODOUT	←←4
 ?IOCLOSE	←←5
 ?IORELEASE	←←6
 ?IOINBUF	←←7
 ?IOOUTBUF	←←10
 ?IOSETI		←←11
 ?IOSETO		←←12
;;%##% A NEW GOODIE
?SETIOSTS	←←13
 ?IOOPEN		←←14
 ?IOLOOKUP	←←15
 ?IOENTER	←←16
 ?IORENAME	←←17
⊗
COMPIL(SIM,,,,,,DUMMYFORSCISS)
TYMSHR <
COMPXX(SIM,<SIMIO,CHNIOV,CHNIOR,CSERR,LPRYER>,<GOGTAB,X22,.SKIP.,DDFINA,INTRPT>
	,<SIMIO,CSERR,LPRYER -- SUPPORT ROUTINES>)
>;TYMSHR
NOTYMSHR <
COMPXX(SIM,<SIMIO,CSERR,LPRYER>,<GOGTAB>
	  ,<SIMIO, CSERR, LPRYER -- SUPPORT ROUTINES>)
>;NOTYMSHR
     
COMMENT ⊗Simio, Ioinst, Lpryer, Cserr ⊗

DSCR SIMIO
CAL XCT INDEX,SIMIO
PAR AC field is index into instruction table (see below)
 CHNL contains I/O channel number
 other params can be gleaned from instruction table
RES an I/O instruction is executed. Routine skips if I/O instr did.
 If the INDEX is LEQ 12, and if the instruction skips (error or EOF),
 status is presented in LH of user's EOF vbl (@ENDFL(CDB)), so he
 can test it, or an error message is provided (depending on user-
 enabling). This simplifies many I/O routines.
SID NONE
DES This routine makes I/O instructions re-entrant. The problem is
 that the channel cannot be referenced indirectly.
⊗

↑↑SIMIO:	PUSHJ	P,.+1		;SAVE PC OF XCT
	PUSH	P,C		;SAVE C
	MOVE	C,-1(P)		;ASSUME SKIP RETURN
	LDB	C,[POINT 4,-1(C),12] ;INDEX OF XCT
	JUMPE	C,USTST		;WANT STATUS BITS ONLY
	CAIL	C,13		;NOW SPLIT HIGH AND LOW INDICES
	 JRST	 ALTIO		;SKIP RETURN CHECK ONLY
;;%##% CHECK TO NOT SCREW STANDARD DEC LOSERS
EXPO <
	CAIN	C,IOIN	;
	JRST	ISIOU	;
	CAIE	C,IOOUT	;IN OR OUT ?
	JRST	NOTIOU	;NOPE
ISIOU:	SKIPG	@USBTST(C)	;CHECK FOR NO BUFFERS (& MORE AT CMU)
	JRST	USFUNY		;NO BUFFERS, ETC.
>;EXPO
NOTIOU:MOVE	C,IOINST(C)	;GET INSTRUCTION
TYMSHR <HLL CHNL,C
	XCT IOINS2(C)>;TYMSHR
NOTYMSHR <
	DPB	CHNL,[POINT 4,C,12]	;CHANNEL NUMBER
	XCT	C		;DO OPERATION>;NOTYMSHR
	 JRST	 USOUT		;ALL KOSHER, NO EOF OR ERR
USTST: NOTYMSHR <	MOVE	C,[GETSTS C]	;WHA-
	DPB	CHNL,[POINT 4,C,12] ; T HAPPEN-
	XCT	C		;	  ED?>;NOTYMSHR
TYMSHR <HRLI CHNL,CIOGST
	CHANIO CHNL,C>;TYMSHR
;;%##%	SAVE STATUS BITS
	MOVEM	C,FSTATS(USER)
CMU <
USERF:
>;CMU
	TRZ	C,10000		;IOACT BIT, USER LOOKUP CHECK BIT
	HRLZM	C,@ENDFL(CDB)	;GIVE USER THE BITS
	TDNN	C,ERRTST(CDB)	;ANY HE CAN'T HANDLE?
	JUMPA	CHNL,USSKIP	;NOPE, JUST SKIP-RETURN
;;%CQ% JFR 7-29-75 more information, please
;;	ERR	<I-O DEVICE ERROR ON CHANNEL >,7 ;JUMPA TO PROVIDE CHANNEL AC
	ERRSPL	1,[[ASCIZ /
I-O device error, channel @D status @B   @F: @F  @F/]
NOTYMSHR <	PWORD	CHNL	;CHANNEL #>;NOTYMSHR
TYMSHR <	PRIGHT CHNL>;TYMSHR
		PLEFT	@ENDFL(CDB)	;STATUS BITS
		PWORD	DNAME(CDB)	;DEVICE
		PWORD	INAME(CDB)	;INPUT FILE NAME
		PWORD	ONAME(CDB)]	;OUTPUT FILE NAME
;;%CQ% ↑
USSKIP:	AOS	-1(P)		;SKIP-RETURN
USOUT:	POP	P,C		;RESTORE C
	POPJ	P,		;DONE

ALTIO:	MOVE	C,IOINST(C)	;GET INSTR
TYMSHR <	HLL CHNL,C
	XCT IOINS2(C)>;TYMSHR
NOTYMSHR <
	DPB	CHNL,[POINT 4,C,12]
	XCT	C		;DO IT>;NOTYMSHR
	JRST	USOUT		;NO SKIP
	JRST	USSKIP		;SKIP
EXPO <
USFUNY:	
CMU <	SKIPE	@USBTST(C)	;FUNNY DEVICE?
	JRST	REALTM		; YES.
>;CMU
	JUMP	CHNL,		;FOR THE ERR MSG
	ERR	<NO BUFFERS ASSIGNED FOR I-O CHAN >,7
	JRST	USSKIP
CMU,<	COMMENT ⊗	THIS NONSENSE IS A SPECIAL MODE FOR
	THE CMU SPEECH DEVICES.  ESSENTIALLY, IT DOES EVERTHING
	AS NORMAL, EXCEPT THAT IT PICKS UP THE TIMING ERR AND
	RUN-OUT-OF BUFFERS BIT OF THE
	I/O  STATUS FROM THE STATUS WORD IN THE BUFFER HEADER,
	INSTEAD OF USING THE BIT FROM THE GETSTS.	⊗
TIMERR←←100000		;TIMING ERR BIT FOR SPEECH DEVICES
ROBERR←←200000		;RUN-OUT-OF-BUFFER ERR

REALTM:	PUSH	P,D		;NEED ANOTHER AC
	CAIE	C,IOIN		;INPUTTING?
	JRST	REALOT		; NO
	MOVSI	C,(<IN>)
	DPB	CHNL,[POINT 4,C,12]	;CHAN #
	XCT	C			;DO THE INPUT
	JRST	REALOK			;NO ERR, SO FAR
	MOVE	C,[GETSTS C]	
	DPB	CHNL,[POINT 4,C,12]	;LOOKS FAMILIAR
	XCT	C
	TRZA	C,TIMERR!ROBERR		;TURN OFF THE ONES FROM THE GETSTS
REALOK:	MOVEI	C,0
	HRRZ	D,IBPNT(CDB)		;ADDRESS OF THE NEW BUFFER
	IOR	C,-1(D)			;THE BITS FROM THE BUFFER
REALRT:	POP	P,D			;RESTORE THE AC
	TRNN	C,760000		;ERR OR EOF?
	JRST	USOUT			; NO
	JRST	USERF			; YES, GO LOOK AT IT

REALOT:	MOVE	C,[GETSTS C]
	DPB	CHNL,[POINT 4,C,12]
	XCT	C
	TRNN	C,ROBERR		;STOPPED FOR A ROB?
	JRST	REAL5			; NO
	HRRI	D,(C)			;GET THE BITS
	TRZ	D,760000		;TURN OFF THE ERRS
	HRLI	D,(<SETSTS>)
	DPB	CHNL,[POINT 4,D,12]
	XCT	D
REAL5:	MOVSI	D,(<OUT>)
	DPB	CHNL,[POINT 4,D,12]
	XCT	D
	JRST	REALRT
	JRST	REALRT			;IGNORE NOW, CATCH THE NEXT TIME THRU

>;CMU

USBTST←.-1
	XWD	CDB,IBUF	;1
;;#QY# ! RHT 2-1-74 NEEDED A DUMMY HERE. 
	777777			;@ THRU THIS  WILL BE ILL MEM REF
	XWD	CDB,OBUF	;3
>;EXPO


DSCR INSTRUCTION TABLE
⊗
IOINST←.-1		;IOSTATUS ←← 0  GET STATUS
NOTYMSHR <
	IN		;IOIN     ←← 1  BUFFERED INPUT
	IN D		;IODIN	  ←← 2  DUMP MODE INPUT
	OUT		;IOOUT	  ←← 3  BUFFERED OUTPUT
	OUT D		;IODOUT	  ←← 4  DUMP MODE OUTPUT
	CLOSE (D)	;IOCLOSE  ←← 5  CLOSE I,O, OR BOTH
;; ALLOW USE OF INHIBIT BITS IN RELEASE
	RELEASE	(D)	;IORELEASE←← 6
	INBUF (A)	;IOINBUF  ←← 7
	OUTBUF (A)	;IOOUTBUF ←←10
	USETI (A)	;IOSETI	  ←←11
	USETO (A)	;IOSETO	  ←←12
;;%##% A NEW GOODIE
	SETSTS  (A)	; SET IO STATUS
	OPEN DMODE(CDB)	  ;IOOPEN	  ←←14
	LOOKUP FNAME(USER);IOLOOKUP←←15
	ENTER FNAME(USER);IOENTER  ←←16
	RENAME FNAME(USER);IORENAME←←17>;NOTYMSHR
TYMSHR <
	XWD CIOIN,0
	XWD CIOIN,1	;INDECIS ARE SAME AS ABOVE
	XWD CIOOUT,0
	XWD CIOOUT,1
	XWD CIOCLS,2
	XWD CIORLS,2
	XWD CIOIBF,3
	XWD CIOOBF,3
	XWD CIOUSI,3
	XWD CIOUSO,3
	XWD CIOSTS,3
	XWD CIOOPN,4
	XWD CIOLUK,5
	XWD CIOENT,5
	XWD CIOREN,5

IOINS2:	CHANIO CHNL,
	CHANIO CHNL,D
	CHANIO CHNL,(D)
	CHANIO CHNL,(A)
	CHANIO CHNL,DMODE(CDB)
	CHANIO CHNL,FNAME(USER)>;TYMSHR

HACK <

;; ****** these two routines are badly misplaced
;; they ought to be removed from this compil someday
;; check with Bob Smith first, though
>;HACK

HERE(CSERR)	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)	;STANDARD PLACE
	ERR	<CASE INDEX OVERFLOW, VALUE IS >,13
	JRST	@UUO1(USER)	;RETURN OK

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

TYMSHR <
COMMENT !
	CHNIOV(CHANNEL,ARG,FUNCTION NUMBER)
	CHNIOR IS SAME BUT ARG IS REFERENCE
	IF FUNCTION NUMBER HAS BITS IN LEFT HAF FOR CALL BY
	VALUE, ITS FOR AN "IMMEDIATE" TYPE INSTR LIKE SETSTS
	BOTH FUCNTIONS RETURN A VALUE BUT IT HAS MEANING ONLY
	IN SOME CASES (DEPENDS ON FUNCTION).
	SETS .SKIP.
!

HEREFK(CHNIOV,CHNCV.)
	POP P,1		;RETURN ADDRESS
	EXCH 1,-1(P)	;NOW ITS ARGUMENT
	MOVE 2,[CHANIO 3,1]
CHNCLC:	POP P,3		;FUNCTION
	TLNE 3,-1
	HRR 2,1		;FOR IMMEDIATE
	SETOM .SKIP.
	HRL 3,-1(P)	;CHANNEL NUMBER
	MOVSS 3		;CHANNEL IS IN LEFT HALF
	SKIPE INTRPT
	XCT DDFINA
	XCT 2
	SETZM .SKIP.
	SUB P,X22
	JRST @2(P)

HEREFK(CHNIOR,CHNCR.)
	POP P,2
	EXCH 2,-1(P)	;NOW ITS PARAMETER ADDRESS
	MOVE 1,2		;IN CASE FUNCTION WITH BITS IN LH
	HRLI 2,(<CHANIO 3,>)
	JRST CHNCLC
>;TYMSHR
ENDCOM(SIM)
COMPIL(CHN,<GETCHN,NOTOPN,GETCHAN>,<GOGTAB>,<GETCHN, NOTOPN, GETCHAN>)

COMMENT ⊗Getchn ⊗

DSCR Getchn, Getchan

PAR A -- addr of ASCII for routine name
 CHNL -- I/O channel number from SAIL call
RES -- CHNL contains actual I/O channel number (diff for shared TTY)
 CDB contains ptr to  actual CDB table for that channel
SID A(lh) is changed
DES normally just sets up CHNL and CDB
 if error occurs (channel out of bounds, already open), a fatal message
  is printed, using the address in A to get the routine name.
 This routine is called by most I/O routines, having saved ACs and 
  fetched CHNL.
⊗

GETCHN:
	HRLI	A,(<PUUO 3,0>)	;PREPARE FOR ERR MESS
	TRZE	CHNL,777760	;CHECK FOR VALID CHANNEL NO
	 JRST	 NOTVALID	;INVALID CHANNEL NUMBER
	SKIPE	CDB,@CDBLOC(USER) ;IS CHANNEL OPEN? (CDBLOC SET BY ALLOC)
	POPJ	P,

NOTOPN:	
	XCT	A		;PRINT ROUTINE NAME
	ERR	<: CHANNEL OR FILE NOT OPEN>


NOTVALID:
	XCT	A		;ROUTINE NAME
	ERR	<: CHANNEL NUMBER INVALID>


DSCR INTEGER←GETCHAN;
CAL SAIL
⊗

HERE (GETCHAN)
	MOVE	USER,GOGTAB
	ADD	USER,[XWD A,CHANS]	;MAKE @ WORD
	MOVEI	A,1			;START AT CHANNEL 1
CHLUP:	SKIPN	@USER			;IF CHANNEL IS FREE,
	POPJ	P,			; RETURN
	CAIGE	A,17			;CYCLE TO 0?
	AOJA	A,CHLUP			;NO, TRY NEXT
	MOVEI	A,0			;TRY 0
	SKIPE	@USER			;FREE?
	HRROI	A,-1			;NOPE
	POPJ	P,			;DONE

ENDCOM(CHN)
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
***** SKIP RETURNS IF SUCCESSFUL *****
⊗

↑↑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
TYMSHR <	CAIE Y,"("
	JRST CHKEXT	;NOT USER NAME
	SETZM FUSER(USER)
	SETZM FUSER1(USER)
	HRRZS 1(SP)
	MOVEI D,12	;12 CHRS MAX
	MOVEI X,FUSER(USER)
	PUSHJ P,FLSCAN+2
	CAIE Y,")"
	JRST FLERR	;NOT DELIMITED PROPERLY
	MOVEI X,FUSER(USER)
	HRRZM X,FNAME+3(USER)	;STORE POINTER
	MOVEI X,FNAME(USER)
	PUSHJ P,FLSCAN
CHKEXT:
>; TYMSHR
	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
CMU <		;HANDLE PPNS VIA UUO, MAYBE
	HRRZS	1(SP)	;LENGTH PART
		;SNEAK A LOOK AT FIRST CHAR
	SKIPN	1(SP)	;IS THERE A FIRST CHAR?
	JRST	FLERR	; NO.
	MOVE	X,2(SP)
	ILDB	X,X
;;=C4= 1 of several LDE 28-Jun-74	allow null ppn within [].
	CAIN	X,"]"		;is it null?
	JRST	OCTPPN		; yes -- let the other guy handle it.
;;
	CAIL	X,"0"
	CAILE	X,"7"
	SKIPA		; NOT OCTAL DIGIT
	JRST	OCTPPN
	PUSH	P,A	;NEED MORE ROOM
	PUSH	P,B
	SETZM	A	;CLEAR THE AREA
	SETZM	B
	SETZM	C
	MOVEI	D,=13+1	;MAX #CHARS+1
	MOVE	X,[POINT 7,A]	;DUMP THEM THERE
FLN2:	SOSGE	1(SP)
	JRST	FLERRC	;RAN OUT OF STRING
	ILDB	Y,2(SP)	;THE NEXT CHAR
;;=C4= 2 OF SEVERAL
	JUMPE	Y,FLN2	;IGNORE NULLS
;;
	CAIN	Y,"]"	;THE END?
	JRST	GOTRB	; YES
	JUMPLE	D,FLERRC	;WE DON'T WANT ANY MORE CHARACTERS
	IDPB	Y,X	;STICK THE CHAR THERE
	SOJA	D,FLN2	;GET ANOTHER

GOTRB:	MOVEI	X,A	;THATS WHERE THE UUO WILL FIND THEM
	CALLI	X,-2		;CMUDEC UUO
	JRST	FLERRC	;SOMETHING WRONG
	MOVEM	X,FNAME+3(USER)	;SAVE IT

	AOS	-2(P)		;INDICATE SUCCESS
FLERRC:	POP	P,B
	POP	P,A
	POPJ	P,
OCTPPN:
>;CMU
TYMSHR <	SKIPE FNAME+3(USER)	;IGNORE IF USER NAME
	JRST FLDUN	;TREAT AS DONE
>;TYMSHR
	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
;;=C4= 3 OF several LE03 28-JUN-74	ALLOW NULL PPN
;		MOVE	D,PROJ(USER)	;WAS A HLLZ
		SKIPN	D,PROJ(USER)
		POPJ	P,
;;
;;
	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,","
;;=C4 4 OF several
;	JRST	FLERR		;INVALID CHAR
	JRST	[JUMPE	X,FLDUN1	;ALLOW NULL PPN - CHECK FOR "]"
		 JRST	FLERR]		;A REAL ERROR.
;;
DEC<
IFE ALWAYS,<EXTERN MYPPN>
;;=I09=	FOR SFD, IF NULL ARG, TAKE FROM OUR PPN
	JUMPN	X,.+3	;IF NULL FIRST HALF,
	MOVE	X,MYPPN	;USE OUR PPN INSTEAD
	HLLM	X,FNAME+3(USER)
>;DEC
	PUSHJ	P,RJUST		;JUSTIFY(AND CONVERT IF EXPORT) PROG #
DEC<
	JUMPN	X,.+2
	MOVE	X,MYPPN	;IF NULL SECOND HALF, USE OUR PPN
>;DEC
	HRRM	X,FNAME+3(USER)
;;=C4= 5 OF several.
FLDUN1:
;;
;;%DP% ! JFR 8-13-76 by popular demand, allows trailing ] to be omitted
;;	CAIN	Y,"]"

;;=I09=	3 OF MANY
SFDS<
	CAIN	Y,"]"
	JRST	FLDUN	;IF ], OK
	CAIE	Y,","	;IF "," MUST BE SFD COMING
	JRST	FLERR	;IF NEITHER, ERROR
	SETZM	PATHBL(USER)	;INIT PATHBLOCK
	SETZM	PATHBL+1(USER)
	MOVE	C,PRPN(USER)	;GET PPN AND PUT IN PATH BLOCK
	MOVEM	C,PATHBL+2(USER)
	MOVEI	C,PATHBL(USER)	;AND PUT PTR TO PATH BLOCK IN PPN
	MOVEM	C,PRPN(USER)
	MOVEI	X,PATHBL+3(USER)	;FIRST SFD PLACE
	MOVEI	C,SFDLVL	;COUNTER - SFDLVL IS MAX NO. OF SFDS
FLSFD:	PUSHJ	P,FLSCAN	;GET SFD NAME
	CAIN	Y,"]"	;IF LAST ONE
	JRST	FLSFD1	;FINISHED
	MOVEI	X,1(X)	;OTHERWISE LOOK AT NEXT
	CAIN	Y,","
	SOJG	C,FLSFD	;UNLESS TOO MANY
	JRST	FLERR	;WHICH IS ERROR
FLSFD1:	SETZM	1(X)	;PUT ZERO AT END OF PATH BLOCK
> ;SFDS
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
TYMSHR <	CAIE Y,"("
	CAIN Y,")"
	POPJ P,
>;TYMSHR
	CAIE	Y,"."		;CHECK VALID BREAK CHAR
	CAIN	Y,"["
	POPJ	P,
	CAIE	Y,"]"
	CAIN	Y,","
	POPJ	P,
	JUMPE	D,FLN1		;NEED NO MORE CHARS
;;=C4=	6 of several.	IGNORE NULL CHARACTERS.
	JUMPE	Y,FLN2X
TYMSHR <	CAIGE Y,40
	JRST FLN2>;TYMSHR
;;
	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
;;=C4= 7 of several
FLN2X:
;;
	SOJA	D,FLN1		;CONTINUE

TYMSHR< FLN2:	MOVEI Y,0
	SOSGE 1(SP)
FLN3:	 POPJ P,
	ILDB Y,2(SP)	;JUST GET SOME CHRS
	SOJL D,FLN3	;RETURN IF DONE
	TRZN Y,100
	TRZA Y,40
	TRO Y,40
	IDPB Y,X
	JRST FLN2>;TYMSHR
ENDCOM(FLS)
COMPIL(OPN,<OPEN,RELEASE,SETPL,CHNCDB>
	  ,<GETCHN,SAVE,RESTR,CORGET,FLSCAN,SIMIO,X33,X22,X11,CORREL>
	  ,<OPEN RELEASE AND SETPL FUNCTIONS>)


COMMENT ⊗Open ⊗

DSCR OPEN(CHAN,"DEV",MODE,IBFS,OBFS,@INCNT,@INBRCHR,@INEOF);
CAL SAIL
⊗
COMMENT ⊗
Allocate IBFS input and OBFS output buffers on channel CHAN for
 device DEV(SAIL/GOGOL string). Store INCNT, and the INBCHR and INEOF 
 addresses in a newly allocated CDB (channel data block). Store 
 all necessary information to carry out I/O on this channel
 in the CDB. Mark the channel open.
⊗

.OPN:
HERE (OPEN)
; FIRST RELEASE IF ALREADY OPEN
	PUSH	P,-7(P)
; RELEAS NOW TAKES TWO ARGS
	PUSH	P,[0]
	PUSHJ	P,RELEASE	;SIMPLE

; NEXT SAVE AC'S, SET UP USER REGISTER, OBTAIN A CDB

	PUSHJ	P,SAVE		;SAVE ACS
	MOVEI	C,IOTLEN	;SIZE
	PUSHJ	P,CORGET	;OBTAIN A BLOCK
	 JRST	 BADOPN		;CAN'T GET IT
	MOVE	CDB,B		;CDB ptr to CHANNEL TABLE
;;#WZ# JFR 6-17-76 ZERO OUT THE WHOLE THING. SUPERSEDES #RX# (CMU =B7=)
	SETZB	LPSA,(CDB)	;NOW GET READY IN CASE OF ERROR
	MOVSI	TEMP,(CDB)
	HRRI	TEMP,1(CDB)
	BLT	TEMP,IOTLEN-1(CDB)
;;#WZ# ↑
	SUB	SP,X22

; FILL IT WITH NON-CONTROVERSIAL THINGS

	POP	P,TEMP		;RETURN ADDRESS
	POP	P,ENDFL(CDB)	;END OF FILE FLAG ADDRESS
	POP	P,BRCHAR(CDB)	;BREAK CHAR ADDRESS
	POP	P,ICOUNT(CDB)	;INPUT COUNT ADDRESS
	POP	P,OBUF(CDB)	;NUMBER OF OUTPUT BUFFERS
	POP	P,IBUF(CDB)	;NUMBER OF INPUT BUFFERS
	POP	P,Z		;DATA MODE
	POP	P,CHNL		;DATA CHANNEL
	CHKCHN	CHNL,<OPEN>	;ASSURE VALID
;;#HA# DCS 5-11-72 IMPROVE ERROR ENABLE. ALSO, IN EXPO SYSTEM,
;;		   AVOID REFERENCES TO PGNNO, WHICH IS same as ERRTST!
	HRRZI	X,750000	;ERROR BITS POSSIBLY ENABLED  -- WAS A HRROI
;;#HA#
	ANDCM	X,Z		;ERROR BITS ACTUALLY ENABLED ARE 0
	MOVEM	X,ERRTST(CDB)	;SAVE ENABLATIONS
	TRZ	Z,750000	;REMOVE IRRELEVANT BITS
ILLMOD ←← 777777
DEC<ILLMOD←←007777
>;DEC
CMU <
ILLMOD ←← 377776		;BIT 400000 FOR SPECIAL DEVICE (CMU)
				;BIT 000001 FOR KEEPING NULLS
	TLZE	Z,10000	;IOACTIVE BIT TO BE SET ON OPEN ??? (LDE)
	TRO	Z,10000	;YES
>;CMU
	TLNE	Z,ILLMOD	;CHECK VALIDITY SOMEWHAT
	 ERR	 <OPEN: INVALID DATA MODE>,1
	MOVEM	Z,DMODE(CDB)	;STORE MODE

; GET DEVICE NAME

	MOVEI	X,DNAME(CDB) ;WHERE SIXBIT'S TO GO
	PUSHJ	P,FLSCAN	;GET DEVICE NAME
;;%##% ONLY GIVE ERROR MESSAGE IF NOT ASKED NOT TO
	JUMPN	Y,[
		SKIPN	@ENDFL(CDB)	;FLAGGED??
		ERR	<INVALID DEVICE NAME FOR OPEN>,1
		JRST	.+1
		]

;IF TTY, MARK TTYDEV FOR OUT

	HLRZ	TEMP,DNAME(CDB)	;GET LH DEVICE NAME
	MOVSI	Z,400000	;BIT TO MARK WITH
;;%##% DO A DEVCHR NOW
;;	CAIE	TEMP,'TTY'	;IF TTY OR PTY,
	CAIN	TEMP,'PTY'	; ,
	JRST	MRKTYB		;MARK AS A TTY
	MOVE	TEMP,DNAME(CDB)	;PICK UP DEVICE AGAIN (FULL SIXBIT)
	CALL6	(TEMP,DEVCHR)	;GET CHARACTERISTICS
	TLNE	TEMP,10		;A TTY???
MRKTYB:	 IORM	 Z,TTYDEV(CDB); IT'S A TTY
;;%##%

; NOW SET HEADER PTRS IN CDB

	HRRZI	Z,-1		;TO TEST RIGHT HALF
	SETZM	BFHED(CDB)	;CLEAR HEADER POINTER
	LDB	E,[POINT 4,DMODE(CDB),35] ;DATA MODE
	CAIL	E,15		;DUMP MODE?
	 JRST	 AGNN		; YES, NO BUFFER HEADER WORD
	MOVEI	TEMP,OBPNT(CDB)	;IF OUTPUT, SET POINTER
	TDNE	Z,OBUF(CDB)	;ANY OUTPUT BUFFERS?
	 HRLM	 TEMP,BFHED(CDB)
	MOVEI	TEMP,IBPNT(CDB)	;SAME FOR INPUT
	TDNE	Z,IBUF(CDB)	;ANY INPUT BUFFERS?
	 HRRM	 TEMP,BFHED(CDB)

; NOW OPEN THE FILE, GET THE BUFFERS,ETC.

AGNN:	XCT	IOOPEN,SIMIO		; OPEN CHAN,MODE
	 JRST	 [SKIPE @ENDFL(CDB) ;DOES USER WANT TO KNOW?
			 JRST	NORELO ;YES, RELEASE CDB, ERASE ALL OF ATTEMPT
			 JRST	RTRY]


COMMENT ⊗
ERMAN'S IMPROVED BUFFER GETTER   ---  DEC. 1970
 If a buffer size is specified (lh #buf word), allocate that size, else the
standard size (determined via a dummy XXXBUF, clever soul that LDE is).
"NOTICE WITH AWE THAT NO CORE IS EVER WASTED, AS IN THE INFERIOR OLD WAY" (sic).
⊗
	MOVEI	Z,0		;FOR DUMMY (AND REAL) OUTBUF
	PUSHJ	P,GETBFS	;GET CORE, DO THE OUTBUFS (OR SIMULATIONS)
	ADDI	CDB,OBUF-OBPNT+1 ;RELOCATE FOR INPUT IN CDB
	MOVEI	Z,-1
	PUSHJ	P,GETBFS	;GET CORE, DO INBUFS
	SUBI	CDB,OBUF-OBPNT+1;RE-RELOCATE
CMU <	;FUNNY INPUT DEVICE
	SKIPL	DMODE(CDB)		;DID HE SPECIFY TO GET ERRS FROM
					; BUFFER HEADER?
	JRST	STNIT			;     NO.
	HRLZI	TEMP,400000
	SKIPE	IBUF(CDB)		;INPUT BUFFERS?
	JRST	[IORM	TEMP,IBUF(CDB)	; YES
		 JRST	STNIT]
	SKIPE	OBUF(CDB)		;OR OUTPUT BUFFERS?
	JUMPA	CHNL,[IORM	TEMP,OBUF(CDB)	; YES
			JRST	STNIT]
	ERR<OPEN: SPEECH DEV BUT NO BUFFERS, CHAN >,7
>;CMU

; FINISH OUT -- SET EOF FLAG IF DESIRED

STNIT:	;SETOM	JOBFF		;ONE MUST KNOW WHAT HE IS DOING TO USE
	MOVEM	CDB,@CDBLOC(USER) ;STORE CDB ADDR IN CHANS TABLE
	SETZM	@ENDFL(CDB)	;MARK OPEN SUCCESSFUL
	JRST	RESTR		;RESTORE ACS, RETURN

BADOPN:	HRRZ	TEMP,JOBREN	;NEXT START WILL ASK ALLOC
	HRRM	TEMP,JOBSA	;QUESTION
	ERR	<TOO MANY CHANNELS OR I/O BUFFERS REQUESTED>,1,<(TEMP)>

RTRY:	TERPRI	<OPEN: DEVICE NOT AVAILABLE>
	TERPRI	<TYPE "R" TO RETRY, "X" TO GO ON WITHOUT>
	PRINT	<?>
	PUUO	TEMP
	CAIE	TEMP,"r"
	CAIN	TEMP,"R"	;TRY AGAIN?
	 JRST	 AGNN		;YES
;;%##%
	SETOM	@ENDFL(CDB)	;MARK A LOSER
	JRST	 NORELO
;;%##%

GETBFS:	SETZM	ONAME(CDB)	;CLEAR FILE NAME
	HRRZ	Y,OBUF(CDB)	;NUMBER OF BUFFERS
	HLRZ	D,OBUF(CDB)	;SIZE
EXPO <
	HRRZS	OBUF(CDB)	;MARK FOR SPECIAL TEST
>;EXPO
	JUMPE	Y,GBUFRT	;NO BUFFERS
	JUMPE	D,GETDES	;WANTS DEFAULT SIZE
NOTYMSHR<	ANDI	D,7777		;MAX BUFFER SIZE>;NOTYMSHR
TYMSHR<ANDI D,37777>;TYMSHR
	HRLZ	A,D		;SIZE IN LH
	PUSHJ	P,GETCOR	;GET THE CORE (SURPRISE!)
	SETZM	OCOWNT(CDB)	;IN CASE NO ACTUAL INBUF (OUTBUF) DONE
	CAIL	E,15		;DUMP MODE?
	 JRST	 GBUFRT		; YES, DON'T ACTUALLY FUDGE UP BUFFERS
NOEXPO <;USE UINBF, UOUTBF
;;#GD# 01-25-72 DCS (1-2) set up JOBFF, Fix XCT, bad count
	MOVEM	B,JOBFF		;B FROM CORGET HAS BUFFER AREA ADDRESS
	SUBI	D,2		;GETCOR INCREMENTED
;;#GD#
	HRRZ	C,Y
	MOVE	A,[UINBF C]
	JUMPN	Z,.+2
	MOVE	A,[UOUTBF C]
	DPB	CHNL,[POINT 4,A,12]
;;#GD# 01-25-72 DCS (2-2) (was XCT CHNL, clearly wrong)
	XCT	A		;DO THE ALLOCATIONS
;;#GD#
	POPJ	P,
>;NOEXPO
EXPO <
	ADDI	B,1		;SECOND WORD
BUFC1:	HRR	A,B
	SOJLE	Y,BUFC2
	ADD	B,D		;NEXT ONE
	MOVEM	A,(B)		;MAKE POINT TO PREV
	JRST	BUFC1

BUFC2:	MOVE	B,OBUF(CDB)	;BACK TO FIRST
	MOVEM	A,1(B)		;LINK IT TOO
	HRLI	A,400000	;RING-USE BIQ
	MOVEM	A,OBPNT(CDB)	;BUFFER PTR
	POPJ	P,
>;EXPO

GETCOR:	ADDI	D,2		;+2 FOR ACCOUNTING
	MOVE	C,D
	IMUL	C,Y		;TOTAL CORE NEEDED
	PUSHJ	P,CORGET	;GRAB IT
	ERR	<OPEN: NOT ENUFF CORE FOR BUFFERS>
	HRRZM	B,OBUF(CDB)	;SAVE SO CAN RELEASE
	POPJ	P,

GETDES:	MOVEI	A,1		;1 DUMMY BUFFER
	CAIL	E,15		;GOOD OLD DUMP MODE?
	 JRST	 [MOVEI D,202	;ASSUME THIS, SINCE INBUF/OUTBUF WON'T
		  JRST GDIT]	; WORK IN DUMP MODE
;;#VE# UGLY CODE REPLACED BY DIFFERENT UGLY CODE
;	MOVEI	TEMP,BRKDUM-1(USER)
;	MOVEM	TEMP,JOBFF
	PUSH	P,[0]		;
	HRRZM	P,JOBFF		;
	PUSH	P,[0]		;MOST LIKEYL ONLY ONE PUSH IS ENOUGH, BUT ...
	PUSH	P,[0]		;
	PUSHJ	P,GETIOB	;DUMMY IN/OUBUF
	LDB	D,[POINT 17,-1(P),17] ;GET THE SIZE
	SUB	P,X33		;POP BACK
;;#VE# ↑↑
GDIT:	PUSHJ	P,GETCOR	;GET THE CORE
	SETZM	OCOWNT(CDB)	;CLEAR BYTE COUNT
	CAIL	E,15		;DUMP MODE?
	JRST	GBUFRT		;YES, NO BUFFER STRUCTURE
	MOVEM	B,JOBFF
	MOVE	A,Y		;NUMBER OF BUFFERS
	PUSHJ	P,GETIOB	;NOW FOR REAL
GBUFRT:	SETOM	JOBFF		;FOR SPITE
	POPJ	P,

GETIOB:	SKIPN	Z
	XCT	IOOUTBUF,SIMIO	;DO OUTBUF
	SKIPE	Z
	XCT	IOINBUF,SIMIO	;INBUF
	POPJ	P,
SUBTTL	RELEASE

COMMENT ⊗Release ⊗

DSCR RELEASE(CHANNEL NO,INHIBIT BITS);
CAL SAIL
DES THIS USES THE DEFAULT PARAMETER MECHANISM, 0 DEFAULT FOR INHIBIT BITS
⊗

COMMENT ⊗
Release channel, i/o buffers, channel table if channel is open
Adjust special TTY stuff to reflect lossage if TTY channel
⊗


HERE(RELEASE)
.RELS:
	SETOM	JOBFF		;MARK INVALID
	PUSHJ	P,SAVE		;SAVE REGS, GET USER, SAVE RETURN
;; FOLLOWING WAS MOVE LPSA,X22
	MOVE	LPSA,X33
;; FOLOWING WAS CHNL,-1(P)
	MOVE	CHNL,-2(P)	;CHANNEL #
	CHKCHN	CHNL,<RELEASE> ;VALIDATE
	SKIPN	CDB,@CDBLOC(USER) ;GET ADDR FROM CHANS TABLE-- CHANNEL OPEN?
	 JRST	 RESTR		;CHANNEL NOT OPEN, FORGET IT
	SETZM	@CDBLOC(USER)	;CLEAR CHANS TABLE ENTRY
;; INHIBIT BITS;
	HRRZ	D,-1(P)		;THE DEFAULT OR USER SPECIFIED INHIBIT BITS
	XCT	IORELEASE,SIMIO	;RELEASE CHAN,0
	HRRZ	B,IBUF(CDB)	;RELEASE ANY INPUT
	PUSHJ	P,BUFREL	; BUFFERS
	HRRZ	B,OBUF(CDB)	;ALSO OUTPUT
	PUSHJ	P,BUFREL	; BUFFERS
NORELO:	HRRZ	B,CDB		;WHERE TO RELEASE
	PUSHJ	P,CORREL	;GIVE CDB BACK
	JRST	RESTR		;RESTORE AND RETURN

BUFREL:	JUMPN	B,CORREL	;RELEASE IF ANY TO RELEASE
	POPJ	P,		;ELSE RETURN


DSCR SETPL(CHANNEL,@LINNUM,@PAGNUM,@SOSNUM)
CAL SAIL
⊗

HERE(SETPL)
	PUSHJ	P,SAVE
	MOVE	CHNL,-4(P)	;GET CHANNEL
	PUSHJ	P,GETCHN	;VALIDATE, LOAD CDB
	POP	P,TEMP		;RETURN ADDRESS (GET OUT OF WAY)
	POP	P,SOSNUM(CDB)
	SETZM	@SOSNUM(CDB)
	POP	P,PAGNUM(CDB)
	SETZM	@PAGNUM(CDB)
	POP	P,LINNUM(CDB)	;LINE NUMBER
	SETZM	@LINNUM(CDB)
	MOVE	LPSA,X11	;REMOVE CHANNEL NUMBER FROM STACK
	JRST	RESTR

;;%AV% -- rht
DSCR CHNCDB(CHANNEL);
CAL SAIL
DES RETURNS INTEGER = INPHDR,,OUTHDR
	(ACTUALLY COULD BE GOTTEN FROM CDB BY USER, BUT THIS
	PROMISSES MORE STABILITY)
⊗

HERE(CHNCDB)
	PUSHJ	P,SAVE		;
	MOVE	CHNL,-1(P)	;GET CHANNEL NUMBER
	PUSHJ	P,GETCHN	;CHECK & LOAD CDB
	MOVEI	1,DMODE(CDB)	;GET VALUE
	MOVEM	1,RACS+1(USER)	;SO RESTR WINS
	MOVE	LPSA,X22	;
	JRST RESTR		;RETURN

HERE(OPNSP1)			;PERHAPS PUT GETSTS HERE
;;%##% GOBBLED DOWN TWO SPARE HERES HERE FOR STATUS ROUTINES THAT FOLLOW
	ERR <DRYROT IN OPEN SPARES>

ENDCOM (OPN)
;;%##%
COMPIL(STS,<GETSTS,SETSTS>
	,<SAVE,RESTR,SIMIO,GOGTAB,GETCHN,X11,X33,X22>
	,<GETSTS AND SETSTS>)


COMMENT ⊗GETSTS,SETSTS⊗

DSCR STATUS←GETSTS(CHANNEL);
CAL SAIL
⊗

.STS:
HERE(GETSTS)
	PUSHJ	P,SAVE
	LOADI7	A,<GETSTS>
	MOVE	CHNL,-1(P)	;CHANNEL #
	PUSHJ	P,GETCHN
	XCT	IOSTATUS,SIMIO	;DO THE UUO
	JFCL
	MOVE	A,FSTATS(USER)	;THE RESULT
	MOVEM	A,RACS+A(USER)	;SO RESTR WORKS
	MOVE	LPSA,X22
	JRST	RESTR

DSCR SETSTS(CHANNEL,STATURS);
CAL SAIL
⊗

HERE(SETSTS)
	PUSHJ	P,SAVE
	LOADI7	A,<SETSTS>
	MOVE	CHNL,-2(P)
	PUSHJ	P,GETCHN
	MOVE	A,-1(P)		;INTENDED STATUS BITS
	XCT	SETIOSTS,SIMIO	;XECUTE THE INST
	JFCL			;SHOULDN'T SKIP
	MOVE	LPSA,X33
	JRST	RESTR		;GO RESTORE

ENDCOM(STS)
COMPIL(LOK,<LOOKUP,ENTER,FILEINFO>
	  ,<SAVE,RESTR,GETCHN,FILNAM,SIMIO,X33,X22,GOGTAB>
	  ,<LOOKUP, ENTER, AND FILEINFO ROUTINES>)

COMMENT ⊗Lookup, Enter ⊗

DSCR LOOKUP(CHANNEL,"FILE NAME",@FAILURE FLAG);
CAL SAIL
⊗

Comment ⊗
LOOKUP or ENTER file FILENAME on channel CHANNEL, where FILENAME has
	a format acceptable to FILNAM above. If successful,
	FAILURE!FLAG (called by reference) is zeroed. It is
	otherwise set to -1 in LH, error code in RH.
⊗


.LOK:
HERE (LOOKUP) PUSHJ	P,SAVE
	LOADI7	A,<LOOKUP>
	PUSH	P,[XCT	IOLOOKUP,SIMIO]	;LOOKUP CH,FILE
	MOVEI	B,INAME			;TO STORE FILE NAME
	JRST	LOKENT			;DO THE OPERATION

DSCR ENTER(CHANNEL,"FILE NAME",@FAILURE FLAG);
CAL SAIL
⊗

HERE (ENTER)
	PUSHJ	P,SAVE
	LOADI7	A,<ENTER>
	PUSH	P,[XCT IOENTER,SIMIO]	;ENTER CH,FILE
	MOVEI	B,ONAME			;TO STORE FILE NAME
LOKENT:
	MOVE	LPSA,X33		;PARAM ADJUST FOR RESTR
	MOVE	CHNL,-3(P)		;GET CHANNEL #
	PUSHJ	P,GETCHN		;VALIDATE
	SETZM	@-2(P)			;ASSUME SUCCESS
	PUSHJ	P,FILNAM		;GET FILE
	 JRST	 BADSPC			; NO GOOD, REPORT ERROR
	ADD	B,CDB			;ADDR OF FILE NAME HOLDER
	MOVEW	(<(B)>,<FNAME(USER)>)	;STORE IT
TYMSHR <	MOVEI X,5	;SPECIAL LOOKUP HERE
	EXCH X,FNAME(USER)
	EXCH X,FNAME+2(USER)
	MOVEM X,FNAME+4(USER)
	MOVE X,FNAME+3(USER)
	EXCH X,FNAME+1(USER)
	MOVEM X,FNAME+3(USER)>;TYMSHR
	POP	P,X			;INSTRUCTION TO DO
	MOVE	Y,[JRST ELERR]		;FAILURE
NOTYMSHR <	MOVE	Z,[JRST RESTR]		;SUCCESS>;NOTYMSHR
TYMSHR <	MOVE Z,[JRST LOKNT1]		;SUCCESS>;TYMSHR
ENF1:	JRST	X			;ENTER/LOOKUP

BADSPC:	POP	P,(P)			;REMOVE IO INSTRUCTION
	HRRZ	TEMP,ERRTST(CDB)	;GET USER-ENABLE BITS
	TRNE	TEMP,10000		;ENABLED FOR HANDLING BAD FILE SPECS?
	ERR	<LOOKUP OR ENTER: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
	SKIPA	TEMP,[=8]		;ALWAYS REPORT NO GOOD LOOKUP/ENTER
ELERR:	TYMSHR <PUSHJ P,LOKNTC>;TYMSHR
NOTYMSHR<	HRRZ	TEMP,FNAME+1(USER)	;WHY DID IT BLOW?>;NOTYMSHR
	HRROM	TEMP,@-1(P)		;TELL THE USER
	JRST	RESTR
TYMSHR <
LOKNTC:	MOVE TEMP,FNAME+4(USER)
	EXCH TEMP,FNAME+2(USER)	;PUT THINGS BACK
	MOVEM TEMP,FNAME(USER)
	MOVE TEMP,FNAME+1(USER)
	EXCH TEMP,FNAME+3(USER)
	MOVEM TEMP,FNAME+1(USER)
	POPJ P,

LOKNT1:	PUSHJ P,LOKNTC
	JRST RESTR>;TYMSHR
     
COMMENT ⊗Fileinfo ⊗

DSCR FILEINFO(INTEGER ARRAY INFO[1:6]);
CAL SAIL
⊗

Comment ⊗ This routine gives the user the entire 6 word block
  from the last LOOKUP, ENTER, or RENAME operation done by SAIL.⊗

HERE (FILEINFO)
	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)		;GET RID OF IT, MARK LAST SAIL CALL
	POP	P,LPSA			;ARRAY ADDRESS WHERE INFO IS TO GO
	SKIPGE	-2(LPSA)		;MAKE SURE IT'S NOT A STRING ARRAY
	 ERR	 <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
	MOVE	TEMP,-1(LPSA)		;TOTAL ARRAY SIZE WORD
	CAML	TEMP,[XWD 1,6]		;MUST BE 1-D, AT LEAST 6 WORDS
	CAMLE	TEMP,[XWD 1,-1]		;BUT NOT 2-D
	 ERR	 <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
	MOVEI	TEMP,5(LPSA)		;BLT TERMINATOR
	HRLI	LPSA,FNAME(USER)	;SOURCE OF VALUABLE INFORMATION
	BLT	LPSA,(TEMP)		;GIVE!
	JRST	@UUO1(USER)		;GONE

ENDCOM (LOK)
COMPIL(OUT,<OUT>,<SAVE,RESTR,GETCHN,SIMIO,NOTOPN,X11,X22>
	  ,<STRING OUTPUT ROUTINE>)

COMMENT ⊗Out ⊗

DSCR OUT(CHANNEL,"STRING");
CAL SAIL
⊗
COMMENT ⊗
Simply places all characters of string in output buffer for channel.
Close file if device is TTY    ⊗

.OUT.:
HERE (OUT)	PUSHJ	P,SAVE		;ACS, GET USER, SAVE RETURN FOR ERROR
	MOVE	LPSA,X22
	MOVE	CHNL,-1(P)	;CHANNEL NUMBER
	LOADI7	A,<OUT>
	PUSHJ	P,GETCHN	;VALIDATE AND GET CDB, ETC.
	HRRE	Z,-1(SP)	;#CHARS
	POP	SP,D
	SUB	SP,X11
;;#WZ# JFR 6-17-76 TRAP OUT WITH NO PLACE TO PUT STRING
	SKIPN	B,OBP(CDB)
	 JRST	[ERRSPL	1,[[ASCIZ/
OUT: No buffer. Channel @D file @F:  @F  @F/]
			PWORD	CHNL
			PWORD	DNAME(CDB)
			PWORD	INAME(CDB)
			PWORD	ONAME(CDB)]
		JRST	RESTR]
;;#WZ# ↑
	MOVE	A,OCOWNT(CDB)
	JRST	.OUT1


.OUT:	SOJLE	A,OUT1		;NEED OUTPUT??
.OUT2:	ILDB	X,D		;GET A CHAR
	IDPB	X,B		;PUT IT AWAY
.OUT1:	SOJGE	Z,.OUT		;LOOP
OUTDUN:	MOVEM	B,OBP(CDB)	;PUT BP AWAY
	MOVEM	A,OCOWNT(CDB)	;COUNT AWAY
	SKIPGE	TTYDEV(CDB)	;TTY?
	XCT	IOOUT,SIMIO	; YES, FORCE OUTPUT
	JRST	RESTR
	JRST	RESTR

OUT1:	LDB	TEMP,[POINT 4,DMODE(CDB),35] ;MODE
	CAIL	TEMP,15		;DUMP?
	 JRST	 DMPO		;YES
	MOVEM	B,OBP(CDB)	;PUT REAL BP AWAY
	XCT	IOOUT,SIMIO	;DO THE OUTPUT
	JFCL			;ERRORS HANDLED IN SIMIO
	MOVE	B,OBP(CDB)	;NEW BP
	MOVE	A,OCOWNT(CDB)	;NEW COUNT
	JRST	.OUT2		;CONTINUE

; SPECIAL DUMP-MODE OUTPUT STUFF

DMPO:	PUSH	P,D
	HRRZ	D,OBUF(CDB)	;PTR TO BUFFER AREA
	SUBI	D,1		;ADDR-1 FOR IOWD
	HRLI	D,-=128		;-WORD COUNT
	MOVEI	D+1,0
	XCT	IODOUT,SIMIO	;OUT D,
	JFCL			;ERRORS HANDLED IN SIMIO
OKO:	HRRZ	B,D		;SAVE ADDR
	HRLI	D,1(D)		;BLT WORD
	HRRI	D,2(D)
	SETZM	-1(D)
	BLT	D,=128(B)	;CLEAR BUFFER
	POP	P,D		;RESTORE INPUT BYTE POINTER
	AOS	@ENDFL(CDB)	;SPECIAL TREATMENT
	HRLI	B,700		;POINT 7,-1(1ST WORD),35
	MOVEM	B,OBP(CDB)
	MOVEI	A,5*=128	;CHAR COUNT
	MOVEM	A,OCOWNT(CDB)
	JRST	.OUT2		;AFTER OUTPUT SIMULATION, GO ON

ENDCOM(OUT)
COMPIL(INP,<INPUT>
	  ,<SAVE,.SKIP.,INSET,RESTR,SIMIO,GETCHN,STRNGC,BRKMSK,BKTCHK,X33,NOTOPN,GOGTAB
>
	  ,<STRING INPUT ROUTINE>)

COMMENT ⊗Input ⊗

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

.IN.:
HERE (INPUT)	
	MOVE	USER,GOGTAB	;GET TABLE POINTER
;;%##% FOR BENEFIT OF ERR ROUTINE
	MOVE	TEMP,(P)
	MOVEM	TEMP,UUO1(USER)
;;%##%
	MOVEM	RF,RACS+RF(USER);SAVE F-REGISTER
	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVE	X,-1(P)		;TABLE #
	MOVEI	TEMP,-1		;ERROR IF BLOCK NOT THERE, NEEDS TO BE INIT'ED
	PUSHJ	P,BKTCHK	;CHECHK OUT TABLE #
	 JRST	[PUSH	SP,[0]	;ERROR
		PUSH	SP,[0]
		SUB	P,X33
		JRST	@3(P)]
	PUSH	P,CDB		;SAVE POINTER TO CORGET BLOCK
	PUSH	P,CHNL		;SAVE RANGE 1 TO 18
	MOVE	CHNL,-4(P)	;CHANNEL #
	LOADI7	A,<IN>		;ROUTINE NAME
	PUSHJ	P,GETCHN	;SET UP, VALIDATE
	LDB	E,[POINT 4,DMODE(CDB),35] ;DATA MODE
	CAIGE	E,15		;DUMP MODE?
	SETZM	@ENDFL(CDB)	;NO, HELP USER ASSUME NO EOF,ERR
	SETZM	@BRCHAR(CDB)	;ASSUME NO BREAK CHAR
CMU <
	SETZM	.SKIP.
>;CMU
	HRRZ	A,@ICOUNT(CDB)	;MAX COUNT FOR INPUT STRING
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)	;ENOUGH ROOM?
	PUSHJ	P,STRNGC	;NO, TRY TO GET SOME
	POP	P,TEMP
	MOVE	FF,BRKMSK(TEMP)	;GET MASK FOR THIS TABLE
	POP	P,LPSA		;LPSA POINTS AT CORGET BLOCK
	ADD	TEMP,LPSA	;TEMP IS RELOCATED 1 TO 18
	MOVEM	TEMP,-1(P)	;SAVE THIS BLOODY THING ON THE STACK
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
	MOVN	B,A		;NEGATE MAX CHAR COUNT
	PUSH	SP,[0]		;LEAVE ROOM FOR FIRST STR WORD
	PUSH	SP,TOPBYTE(USER)	;SECOND STRING WORD
	MOVE	Y,LPSA
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(LPSA)
	JUMPE	B,DONE1		; BECAUSE THE AOJL WON'T
NOCMU<
	MOVEI	C,0
>;NOCMU
CMU <
	MOVS	C,DMODE(CDB)	;FUNNY MODE BITS TO RH
>;CMU
;;%DQ% 2! JFR 8-17-76
	TRNE	FF,@BRKDUM(LPSA);TREAT NULLS LIKE ORDINARY CITIZENS?
	 IORI	C,1		;YES, FLAG BIT
	TRNE	FF,@BRKCVT(LPSA) ;DOING UC COERCION?
	TLOA	C,400000	;YES
	TLZ	C,400000	;NO
	
.IN:	SOSG	ICOWNT(CDB)	;BUFFER EMPTY?
	JRST	DOINP		;YES, GET MORE
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:
	JUMPE	D,[ TRNN  C,1	;REALLY IGNORE NULL??
		    JRST  .IN	;YES
		    JRST  .+1	;NOPE
		   ]
;;%AX% ugh! another instruction
	SKIPE	LINNUM(CDB)	;COUNTING VIA SETPL?
	JRST	[ CAIN	D,12		;LF?
		  AOS	@LINNUM(CDB)	;YES -- BUMP COUNT
;; #TB# ! (CMU =C9) TYPO, USED TO BE CAIE C,14
		  CAIE	D,14		;FF?
		  JRST	.+1		;NOPE
		  SKIPN	PAGNUM(CDB)	;BE SURE NO MESSUP
		  ERR	<DRYROT -- SETPL LOSSAGE DETECTED IN INPUT>,1,NOCV.I
		  AOS	@PAGNUM(CDB)	;BUMP PAGE COUNT
		  SETZM	@LINNUM(CDB)	;THE LINE COUNT ← 0
		  JRST	NOCV.I		;SINCE KNOW NOT LOWER CASE
		]
;;%##%	COERCING ??
	JUMPGE	C,NOCV.I	;NOT COERCIING ??
	CAIL	D,"a"		;ONLY COERCE LOWER CASE
	CAILE	D,"z"		;
	JRST	.+2		;FAST SKIP
	TRZ	D,40		;MAKE UC
NOCV.I:	TDNE	FF,@Y		;MUST WE DO SOMETHING SPECIAL?
	JRST	INSPC		;YES, HANDLE

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

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

;  BREAK -- STORE BREAK CHAR, FINISH OFF

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

RETAIN:	SOS	IBP(CDB)		;BACK UP TO GET IT NEXT TIME
	FOR II←1,4 <
	IBP	IBP(CDB)>
	AOS	ICOWNT(CDB)
	JRST	DONE1

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

INEOF1: POP	P,D+1		;LEFT OVER FROM DUMP MODE ROUT

;  DONE -- MARK STRING COUNT WORD

DONE1:	ADDM	B,REMCHR(USER)	;GIVE UP THOSE NOT USED
	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
; GET A NEW BUFFER

DOINP:
CMU <
	AOS	.SKIP.
>;CMU
	CAIL	E,15		;DUMP MODE?
	 JRST	 DMPI		; YES
	XCT	IOIN,SIMIO	;IN CHAN,0
	 JRST	 IN1		;ALL OK, CONTINUE
	 JRST	 DONE1		;ERROR OR EOF, QUIT

; DUMP MODE SIMULATION OF SAME
DMPI:	PUSH	P,D+1
	HRRZ	D,IBUF(CDB)	;PTR TO BUFFER AREA
	SUBI	D,1
	HRLI	D,-=128
	MOVEI	D+1,0
	XCT	IODIN,SIMIO	;IN CHAN,D
	 JRST	OKI
	 JRST	INEOF1		;REMOVE D,QUIT
OKI:	POP	P,D+1
	AOS	@ENDFL(CDB)	;SPECIAL TREATMENT
	HRLI	D,700
	MOVEM	D,IBP(CDB)
	MOVEI	A,5*=128
	MOVEM	A,ICOWNT(CDB)
	JRST	IN1		;DONE SIMULATING, RETURN

INLINN:
;;%AX% MORE SETPL STUFF
	SKIPE	SOSNUM(CDB)	;DOES THE USER WANT IT???
	JRST	[ MOVE	TEMP,@IBP(CDB) ;YES
		  MOVEM	TEMP,@SOSNUM(CDB);
		  JRST	.+1 ]
	MOVE	TEMP,-1(P)	;RELOCATED 1 TO 18
	SKIPGE	TEMP,LINTBL(TEMP) ;WHAT ABOUT LINE #?
	 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	A,5		;INDICATE SKIPPING SIX
	ADDB	A,ICOWNT(CDB)	;IN COUNT
				;OVERFLOW BUFFER?
	JUMPG	A,(TEMP)	;NO, CONTINUE
	CAIL	E,15
	 ERR	 <CAN'T HANDLE THIS FILE IN DUMP MODE>
	XCT	IOIN,SIMIO	;YES, GET TAB FROM NEXT BUFFER
	 JRST	OKLN		;GOT IT, CONTINUE
	 JRST	DONE1

OKLN:	SOSG	ICOWNT(CDB)	;IF ONLY ONE CHAR,
	JRST	[MOVEI TEMP,20000	;THEN EOF COMES NEXT
		 IORM  TEMP,@ENDFL(CDB)
		 JRST  DONE1]	;ALL DONE
	IBP	IBP(CDB)	;GET OVER TAB FINALLY
;;#PM  12-1-73 RLS  DONT LOSE A CHARACTER IN THE (NEW) BUFFER 
	AOS	ICOWNT(CDB)	;INCREMENT COUNT
;;#PM
	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
	MOVEM	TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
	JSP	TEMP,EATLIN	;GO EAT UP LINE NUMBER AND
	JRST	DONE1		;FINISH UP
GVLLN:
	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

ENDCOM(INP)
COMPIL(NUM,<REALIN,REALSCAN,INTIN,INTSCAN>
	  ,<SIMIO,SAVE,RESTR,X22,X33,GETCHN,NOTOPN,.CH.,.MT.,.TEN.>
	  ,<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
	MUL A,.MT.(Y)		;MULTIPLY AND NORMALIZE
	TLNE A,200000
	 JRST DTEST
	ASHC A,1
	SOJA X,.+1
DTEST:	SOJG C,NEXT
FLO:	IDIVI A,1B18
	FSC A,255
	FSC B,234
	FADR A,B
	SKIPE D
	MOVNS A
	FSC A,(X);		SCALE
	JRST ALLDON
	SUBTTL	INTIN	INTEGER NUMBER INPUT ROUTINE	LOU PAUL

COMMENT ⊗Intin, Intscan ⊗

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

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

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

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

HERE (INTSCAN)
	PUSHJ P,SAVE
	PUSHJ P,STRIN
	MOVE LPSA,X33
INTFN:	JUMPE A,ADON
	JUMPE C,ADON
	JUMPL C,DIVOUT;		IF EXPONENT NEG WE WILL DIVIDE
	CAIL C,13
	JRST ERROV1
	IMUL A,.TEN.(C)
	JRST ALLDON
DIVOUT:	MOVNS C
	CAIL C,13
	JRST [SETZ A,
		JRST ADON ]
	MOVE C,.TEN.(C)
	IDIV A,C
	ASH C,-1
	CAML B,C;		ROUND POSITIVELY
	AOJA A,ALLDON
	MOVNS B
	CAML B,C
	SOJ A,
ALLDON:	JOV ERROV1;		CHECK FOR OVERFLOW
ADON:	MOVEM A,RACS+1(USER)
	JRST RESTR
ERROV1:	PUSHJ P,ERROV
	JRST ADON
	SUBTTL	FREE FIELD NUMBER SCANNER		LOU PAUL

DSCR NUMIN
DES THE COMMON ROUTINE USED BY REALIN, REALSCAN, INTIN, ETC.
⊗
	;NUMIN PERFORMS A FREE FIELD READ AND RETURNS THE MOST SIGNIFICIANT
	;PART OF THE NUMBER IN A AND THE APPROPIATE TENS EXPONENT IN C
	;TAKING CARE OF LEADING ZEROS AND TRUNCATION ETC.
	;SCANNING IS ACCORDING TO THE FOLLOWING BNF
	;<NUMBER>::=<DEL><SIGN><NUM><DEL>
	;<NUM>	::=<NO>|<NO><EXP>|<EXP>
	;<NO>	::=<INTEGER>|<INTEGER>.|
	;	   <INTEGER>.<INTEGER>|.<INTEGER>
	;<INTEGER>::=<DIGIT>|<INTEGER><DIGIT>
	;<EXP>	::=E<SIGN><INTEGER>|@<SIGN><INTEGER>
	;<DIGIT>::=0|1|2|3|4|5|6|7|8|9
	;<SIGN>	::=+|-|<EMPTY>
	;NULL AND CARR. RET. ARE IGNORED.
	;SCANNING IS FACILITATED BY A CHARACTER CLASS TABLE "TAB" AND
	;TWO MACROS AHEAD AND ASTERN. THE LEFT HALF OF THE 200+1 WORD TABLE
	;CONTAINS -1 IF NOT A DIGIT AND THE VALUE OF THE DIGIT IF IT IS A DIGIT
	;THE RIGHT HALF CONTAINS -1 IF A DIGIT AND THE CLASS NUMBER IF NOT.
	;CLASS 0	NULL, CARR RET, NOTHING
	;CLASS 1	.
	;CLASS 2	-
	;CLASS 3	+
	;CLASS 4	@,E
	;CLASS 5	ANY OTHER CHARACETR
	;CLASS 6 	END OF FILE
	;TAB(200) IS USED FOR FND OF FILE
	;MACRO AHEAD IS USED FOR FORWARD SCANNING, ASTERN FOR SCANNING
	;THE STACK CONSISTING OF AC Y WHICH HAS CLASS SYMBOLS SHIFTED INTO IT.
	DEFINE AHEAD(DIG,POINT,MINUS,PLUS,E,CHA,EOF)<
	HRRE X,TAB(D)
	JRST @.+2(X)
	JUMP DIG
	JRST .-4
	JUMP POINT
	JUMP MINUS
	JUMP PLUS
	JUMP E
	JUMP CHA
	JUMP EOF>

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

;NUMIN -- CONTD.

NUMIN:	MOVE CHNL,-2(P)
	LOADI7 A,<IN>
	PUSHJ P,GETCHN;		SET UP FOR INPUT
	SETZM @ENDFL(CDB);	CLEAR EOF AND BREAK FLAGS
	SETZM @BRCHAR(CDB)
	MOVE LPSA,[JSP X,NCH]
	MOVEI Z,1;		FOR LINE NUMBER TEST
	PUSHJ P,SCAN
	MOVEM D,@BRCHAR(CDB);	FIX UP BREAK CHARACTER
	SOS	IBP(CDB)		;BACK UP TO GET IT NEXT TIME
	FOR II←1,4 <
	IBP	IBP(CDB)>
	AOS	ICOWNT(CDB)
	POPJ P,

; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
NCH:	SOSG ICOWNT(CDB);	DECREMENT CHARACTER COUNT
	JRST NCH2
NCH1:	ILDB D,IBP(CDB);	LOAD BYTE
	TDNE Z,@IBP(CDB);	CHECK FOR LINE NUMBER
	JRST NCH5
;;%AX% UGH! MORE IN THE LOOP!!
	SKIPN	LINNUM(CDB)	;WANT SETPL STUFF???
	JRST (X) 		;NO, RETURN
	CAIN	D,12		;YES, IS THIS A LF?
	AOS	@LINNUM(CDB)	;YES, BUMP LINE COUNT
	CAIE	D,14		;A FF?
	JRST	(X)		;NOPE
	SKIPN	PAGNUM(CDB)	;BUG TRAP
	JRST    [ ERR	<DRYROT -- SETPL LOSSAGE DETECTED BY NUMIN>,1
		JRST	(X) ]
	AOS	@PAGNUM(CDB)	;BUMP PAGE COUNT
	SETZM	@LINNUM(CDB)	;ZERO LINE COUNT
	JRST	(X)		;RETURN
;;%AX%

NCH2:	XCT IOIN,SIMIO;		INPUT
	JRST NCH1		;ALL OK
NCH7:	MOVEI D,200		;EOF OR DATA ERROR.
	JRST (X)

NCH5:	
;;%AX%	MORE SETPL STUFF
	SKIPE	SOSNUM(CDB)	;DOES THE LOSER WANT IT??
	JRST	[ MOVE	D,@IBP(CDB)	;YES, GET IT
		MOVEM	D,@SOSNUM(CDB)	;WHERE HE SAID TO PUT IT
		JRST	.+1]
;;%AX%
	
	AOS IBP(CDB);		WE HAVE A LINE NUMBER
	MOVNI D,5;		MOVE OVER IT
	ADDB D,ICOWNT(CDB)
	SKIPLE D;		NOTHING LEFT
	JRST NCH;		DO ANOTHER INPUT
	XCT IOIN,SIMIO

NCH6:	SOSG ICOWNT(CDB);	REMOVE TAB
	JRST NCH7		;NONE THERE OR ERROR
	IBP IBP(CDB)
	JRST NCH

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

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


;SCAN (CALLED BY NUMIN AND STRIN)

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

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

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

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

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

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

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

EXP2:	HLRE FF,TAB(D);		FIRST DIGIT
EXP5:	XCT LPSA;		GET NEXT CHARACTER
EXP9:	HLRE B,TAB(D)
	JUMPL B,EEXP;		NEGATIVE IF NOT A DIGIT
	IMULI FF,12		
;;%##% ! (RHT) 10-25-75 IF OVERFLOW, MUST BE WRONG
;;	JOV ERR3	;JUST NOT SURE IF SHOULD DO THIS, THOUGH
	ADD FF,B
	JRST EXP5

	XCT LPSA
;;#QD# SEE DONE5: BELOW
;;#XR# ! JFR 10-31-76 TREAT SIGNS AFTER EXPONENT JUST LIKE OTHER CHARS
EEXP:	AHEAD(EXP9,ERR2,EN,EN,ERR1,EN,EN)
EN:	TRNE TEMP,4;		SIGN OF EXPONENT
	MOVNS FF
	ADD C,FF;		FIX UP EXPONENT
	JOV ERR3

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

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

INT4:	TRO TEMP,2
	MOVE A,X
;;%##% USED TO BE JRST INT3
	AOJA C,INT2

	XCT LPSA		;GET HERE FROM THE AHEAD MACRO
EON:	AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)

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

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

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

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

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

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

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

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

RZ:	SETZ A,
	JRST DONE

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

ENDCOM(NUM)
COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)

DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
⊗

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

ENDCOM(TBB)
IFN ALWAYS,<
	BEND
>;IFN ALWAYS
COMPIL(WRD,<ARRYOUT,WORDOUT,ARRYIN,WORDIN>
	  ,<GETCHN,SAVE,RESTR,GOGTAB,SIMIO,X22,X33,X44,NOTOPN>
	  ,<ARRYIN, ARRYOUT, WORDIN, AND WORDOUT>)

COMMENT ⊗Arryout, Wordout ⊗

DSCR ARRYOUT(CHANNEL,@STARTING LOC,EXTENT);
CAL SAIL
⊗

HERE (ARRYOUT)
	PUSHJ	P,SAVE
	MOVE	LPSA,[XWD 4,4]
ARO:	MOVE	CHNL,-3(P)
	LOADI7	A,<ARRYOUT>
	PUSHJ	P,GETCHN
;;%##% CONSIDER THIS
CMU <
	SETZM	@ENDFL(CDB)	;CLEAR ERROR FLAG
>;CMU
	LDB	TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
CMU <
;;=B4= 1 OF 13 -- FOR CMU SPECIAL MODES.
	MOVEI	Z,1		;ASSUME NOT IMP MODE
	CAIN	TEMP,3		;IS THE MODE 3?
	 TRZA	Z,-1		; YES - CMU 32-BIT IMP MODE.
				; WE WILL USE Z BOTH AS SIGNAL AND AS
				; A GUARANTEED 0 THAT CAN BE USED FOR A DPB
	CAIN	TEMP,4		; (THIS ONE IS CMU-IMAGE MODE)
	 JRST	OUTRAY		; THEN OKAY, NOT DUMP MODE EITHER.
;;=B4=
>;CMU
	CAIGE	TEMP,10		;MAKE SURE AT LEAST BINARY MODE
	 ERR	 <ARRYOUT: mode must be '14,'10, or '17, not >,6
	MOVE	0,[XCT IODOUT,SIMIO] ;IN CASE DUMP MODE
	CAIL	TEMP,15
	 JRST	 ARYDMP		;COMMON DUMP MODE ROUTINE

OUTRAY:	MOVE	A,-2(P)		;STARTING LOC
	SKIPGE	B,-1(P)		;EXTENT
	ERR	<ARRYOUT: negative word count, value is>,6

;;#FQ# DCS 2-6-72 (1-4) COUNT NO LONGER HELD EXCESSIVE

WOUT2:	SKIPG	E,OCOWNT(CDB)	;# WORDS LEFT IN BUFFER
	JRST	WOUT5		;BETTER GET ANOTHER BUFFER
	JUMPE	B,RESTR		;NOTHING LEFT TO DO
CMU <
;;=B4= 2 OF 13
	CAIN	Z,0		;IMP MODE?
	LSH	E,-2		;DIVIDE BY 4 TO GET WORD COUNT
;;=B4=
>;CMU
	IBP	OBP(CDB)	;MAKE SURE PTRS TO FIRST WORD
CMU <
;;=B4= 3 OF 13
	CAIN	Z,0		;IMP MODE?
	DPB	Z,[POINT 6,OBP(CDB),5]
;;=B4=
>;CMU
	MOVE	C,OBP(CDB)	;"TO" ADDR
	HRRZI	D,(C)		;FOR BLT TERMINATION CALCULATION
	HRLI	C,(A)		;"FROM" ADDR
	CAIGE	B,(E)		;ENUFF IN BUFFER?? (NOTICE THAT CAIGE
				;AS OPPOSED TO CAIG WILL FORCE AN OUTPUT
				;IF WE JUST FILL THE BUFFER)
	JRST	WOUT3		;YES
	ADDI	D,-1(E)		;FINAL ADDR
	BLT	C,(D)		;DO IT!
	ADDI	A,(E)		;UPDATE PTR
	SUBI	B,(E)		;AND COUNT
	SETZM	OCOWNT(CDB)
	HRRM	D,OBP(CDB)
WOUT5:	XCT	IOOUT,SIMIO	;DO THE OUTPUT
	JFCL			;ERRORS HANDLED ALREADY
	JRST	WOUT2		;TRY NEXT CHUNK

WOUT3:	JUMPLE	B,RESTR		;NOTHING TO MOVE
	SUBI	B,1
	ADD	D,B		;END OF BLOCK
	BLT	C,(D)		;MOVE IT
	SUBI	E,1(B)		;FIX LENGTH
CMU <
;;=B4= 4 OF 13
	CAIN	Z,0		;IMP MODE?
	 LSH	E,2		;MULTIPLY BY 4 FOR BYTE COUNT
;;=B4=
>;CMU
	MOVEM	E,OCOWNT(CDB)	;
	ADDM	B,OBP(CDB)	;FIX BYTE POINTER
;;#FQ# (1-4)
	JRST	RESTR		;LEAVE LIKE A TREE AND MAKE

DSCR WORDOUT(CHAN,VALUE);
CAL SAIL
⊗

HERE (WORDOUT)			;WRITE ONE WORD
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	MOVE	CHNL,-2(P)
	LOADI7	A,<WORDOUT>
	PUSHJ	P,GETCHN
;;%##% CONSIDER THIS
CMU <
	SETZM	@ENDFL(CDB)	;CLEAR ERROR FLAG
>;CMU
	LDB	A,[POINT 4,DMODE(CDB),35];DATA MODE
	CAIL	A,15		;A DUMP MODE?
	 JRST	 DMPWO		;WO IS ME, YES
;;#FQ# DCS 2-6-72 (2-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
WDO:	SOSL	OCOWNT(CDB)	;BUFFER FULL?
	 JRST	 WOKO		;NO
	XCT	IOOUT,SIMIO	;YES, WRITE IT
	 JFCL			; ERRORS HANDLED ELSEWHERE
	JRST	WDO		;GO BACK AND DO IT RIGHT
WOKO:	MOVE	TEMP,-1(P)	;THING TO BE WRITTEN
	IDPB	TEMP,OBP(CDB)	;WRITE IT
	JRST	RESTR

DMPWO:	MOVE	LPSA,[XWD 7,7]	;ACCOUNT FOR EVERYTHING
	MOVEI	TEMP,-1(P)	;PNT TO WORD TO BE WRITTEN
	PUSH	P,-2(P)		;CHANNEL
	PUSH	P,TEMP		;ADDR OF WORD
	PUSH	P,[1]		;COUNT
	PUSHJ	P,ARO		;JOIN THE ROUTINE (RETAD JUST FOR STACK SYNCH)
;;#FQ# (2-4)

COMMENT ⊗Arryin, Wordin ⊗

DSCR ARRYIN(CHAN,@STARTING LOC,EXTENT);
CAL SAIL
⊗

HERE (ARRYIN)
	PUSHJ	P,SAVE
	MOVE	LPSA,X44
ARI:	MOVE	CHNL,-3(P)
	LOADI7	A,<ARRYIN>
	PUSHJ	P,GETCHN
	SETZM	@ENDFL(CDB)	;ASSUME NO END OF FILE
	LDB	TEMP,[POINT 4,DMODE(CDB),35] ;CHECK DUMP MODE
CMU <
;;=B4= 5 OF 13
	MOVEI	Z,1		;ASSUME NOT IMP MODE
	CAIN	TEMP,3		;IS THE MODE 3?
	 TRZA	Z,-1		; YES - CMU 32-BIT IMP MODE.
	CAIN	TEMP,4		;IF ONE OF THE SPECIAL CMU MODES,
	 JRST	INARY		; THEN OKAY, NOT DUMP MODE EITHER
;;=B4=
>;CMU
	CAIGE	TEMP,10
	 ERR	 <ARRYIN: mode must be '10 or '14 or '17, not >,6
	MOVE	0,[XCT IODIN,SIMIO] ;IN CASE DUMP MODE
	CAIL	TEMP,15
	 JRST	 ARYDMP		;USE COMMON ROUTINE

;;#FQ# DCS 2-6-72 (3-4) COUNT NO LONGER HELD EXCESSIVE
INARY:	MOVE	A,-2(P)		;STARTING LOC
	SKIPGE	B,-1(P)		;EXTENT
	ERR	<ARRYIN: negative word count, value is >,6
WIN3:	JUMPE	B,RESTR		;NOTHING LEFT TO DO
	SKIPG	E,ICOWNT(CDB)	;#LEFT IN BUFFER
	JRST	WIN5
CMU <
;;=B4= 6 OF 13
	CAIN	Z,0		;IMP MODE?
	 LSH	E,-2		;DIVIDE BY 4 TO GET WORD COUNT
;;=B4=
>;CMU
	IBP	IBP(CDB)	;MAKE SURE PTS TO NEXT
	HRL	C,IBP(CDB)	;ADDR OF FIRST WORD TO READ
	MOVEI	D,(A)		;FOR BLT TERMINATION
	HRR	C,A		;"TO" ADDRESS
	CAIG	B,(E)		;ENOUGH HERE?
	JRST	WIN4		;YES
	ADDI	D,-1(E)		;NO, FINISH THIS BUFFER
	BLT	C,(D)
	ADD	A,E		;FIX INPUT POINTER
	SUB	B,E		;FIX INPUT COUNT
WIN5:	XCT	IOIN,SIMIO	;DO INPUT
	JRST	WIN3		;OK, GO AHEAD
	JRST	WIEOF1		;EOF OR ERROR, LEAVE

WIN4:	ADDI	D,-1(B)		;FINISH UP
	BLT	C,(D)
	SUB	E,B		;FIX UP COUNT
CMU <
;;=B4= 7 OF 13
	CAIE	Z,0		;IMP MODE?
	 JRST	.+3
	LSH	E,2		;MULTIPLY BY 4 FOR BYTE COUNT
	DPB	Z,[POINT 6,IBP(CDB),5]
;;=B4=
>;CMU
	SUBI	B,1		;PREPARE TO CORRECT BP
	MOVEM	E,ICOWNT(CDB)	;UPDATE WORDS LEFT
	ADDM	B,IBP(CDB)	; POINTER
;;#FQ# (3-4)
	JRST	RESTR		;LEAVE

WIEOF1:	MOVE	TEMP,-1(P)	;#WORDS WANTED -1
	SUBM	TEMP,B		;#INPUT IN RH
WIN2:	HRRM	B,@ENDFL(CDB)	;#INPUT IN RH, ERR OR EOF BITS IN LH
	JRST	RESTR

DSCR VALUE←WORDIN(CHAN);
CAL SAIL
⊗

HERE (WORDIN)			;READ ONE WORD -- USE ARRYIN
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	LOADI7	A,<WORDIN>
	MOVE	CHNL,-1(P)	;CHANNEL NUMBER
	PUSHJ	P,GETCHN
;;#FQ# DCS 2-6-72 (4-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
	LDB	TEMP,[POINT 4,DMODE(CDB),35];DATA MODE
	CAIL	TEMP,15		;DUMP MODE?
	 JRST	 DUMPWI		; YES
	SETZM	@ENDFL(CDB)
WI:	SOSL	ICOWNT(CDB)
	 JRST	 WOKI		;ALL OK
	XCT	IOIN,SIMIO
	 JRST	 WI		;OK, GO BACK TO KEEP COUNT RIGHT
	 TDZA	 A,A		;RETURN 0, WITH ERROR
WOKI:	ILDB	A,IBP(CDB)	;OK, RETURN NEXT WORD
	MOVEM	A,RACS+1(USER)	;RESULT
	JRST	RESTR

DUMPWI:	MOVE	LPSA,[XWD 6,6]
	MOVEI	TEMP,RACS+1(USER);RESULT GOES HERE
	PUSH	P,-1(P)		;CHANNEL
	PUSH	P,TEMP		;ADDRESS
	PUSH	P,[1]		;1 WORD TRANSFER
	PUSHJ	P,ARI		;WON'T RETURN, JUST SYNCH STACK
;;#FQ# (4-4)

ARYDMP:	
	MOVN	TEMP,-1(P)		;-WORD COUNT
	JUMPGE	TEMP,[ERR <DUMP MODE WORD COUNT NOT POSITIVE, VALUE IS >,6]
	SOS	D,-2(P)			;STARTING ADDR - 1
	HRL	D,TEMP			;IOWD -COUNT,STARTING ADDR -1
	MOVEI	D+1,0			;TERMINATE THE READ
	MOVE	A,[JRST RESTR] ;IF IT SUCCEEDS
	MOVE	B,[JRST RESTR] ;IF IT FAILS (EOF OR ERR, ALREADY HANDLED)
	JRST	0		;GO DO DUMP I/O

HERE(WRDSP1)
HERE(WRDSP2)
HERE(WRDSP3)

	ERR	<DRYROT WRD SPARES>

ENDCOM(WRD)
COMPIL(THR,<INOUT>,<SIMIO,SAVE,RESTR,GETCHN>
	,<THROUGH I/O ROUTINE>)


COMMENT ⊗ INOUT ⊗

DSCR INOUT(INCHAN,OUTCHAN,EXTENT);
CAL  SAIL
⊗

HERE (INOUT)
	PUSHJ	P,SAVE		;SAVE AC'S,GET GOGTAB
	MOVE	LPSA,[XWD 6,6]
	MOVE	CHNL,-2(P)	;OUTPUT CH NUMBER
	LOADI7	A,<INOUT (OUTPUT SIDE)>
	PUSHJ	P,GETCHN
	SETZM	@ENDFL(CDB)	;CLEAR ERROR INDICATOR
	LDB	TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
CMU <
;;=B4= 8 OF 13
	MOVEI	Z,1
	CAIN	TEMP,3		;IS THE MODE 3
	 TRZA	Z,-1		; YES!!!
	CAIN	TEMP,4		;OR CMU IMAGE MODE?
	 JRST	.+4		;UGLY, BE CAREFUL OF CODE CHANGES!
;;=B4=
>;CMU
	CAIL	TEMP,10		;MUST BE BINARY MODE
	CAILE	TEMP,14		;AND NOT DUMP MODE
	ERR	<INOUT (OUTPUT SIDE): ILLEGAL DATA MODE:>,6
	PUSH	P,CDB		;SAVE - 
	PUSH	P,CHNL		;WELL DO IT AGAIN
	MOVE	CHNL,-5(P)		;SEE...
	LOADI7	A,<INOUT (INPUT SIDE)>
	PUSHJ	P,GETCHN	;DO YOUR THING
	SETZM	@ENDFL(CDB)	;CLEAR ERROR INDICATOR
	LDB	TEMP,[POINT 4,DMODE(CDB),35]
CMU <
;;=B4= 9 OF 13
	MOVEI	Y,1
	CAIN	TEMP,3		;IS THE MODE 3
	 TRZA	Y,-1		;YES!!!
	CAIN	TEMP,4		;OR CMU IMAGE MODE
	 JRST	.+4		;CAREFUL OF RELATIVE JUMPS!
;;=B4=
>;CMU
	CAIL	TEMP,10
	CAILE	TEMP,14
	ERR	<INOUT (INPUT SIDE): ILLEGAL DATA MODE:>,6
	SKIPGE	B,-3(P)		;# OF WORDS
	HRLOI	B,377777	;ARBITRARILY LARGE NUMBER OF WDS
TH1:	JUMPE	B,RESTR		;NO MORE TO DO
	SKIPG	E,ICOWNT(CDB)	;#OF WORDS IN BUFFER
	JRST	TH5		;BETTER GET SOME MORE
CMU <
;;=B4= 10 OF 13
	CAIN	Y,0		;IMP MODE?
	 LSH	E,-2		;DIVIDE BY 4 TO GET WORD COUNT
;;=B4=
>;CMU
	IBP	IBP(CDB)	;MAKE SURE POINT TRIGHT
	HRL	C,IBP(CDB)	;INPUT POINTER
	EXCH	CHNL,(P)	;NOW FREEN OUTPUT STUFF
	EXCH	CDB,-1(P)
	SKIPG	OCOWNT(CDB)	;SOME LEFT
	XCT	IOOUT,SIMIO
	SKIPA
	JRST	THERR
	IBP	OBP(CDB)
	HRR	C,OBP(CDB)	;OUTPUT POINTER
	CAML	E,B		;FIND # OF WORDS
	MOVE	E,B		;TO BLIT
NOCMU <
;;=B4= 11 OF 13
	CAML	E,OCOWNT(CDB)	;=MIN(B,ICOWNT,OCOWNT)
	MOVE	E,OCOWNT(CDB)
>;NOCMU
CMU <
	CAMGE	E,OCOWNT(CDB)	;=MIN(B,ICOWNT,OCOWNT)
	JRST	.+4
	MOVE	E,OCOWNT(CDB)
	CAIN	Z,0		;IMP MODE?
	LSH	E,-2		;DIVIDE BYTE COUNT BY 4
;;=B4=
>;CMU
	MOVEI	D,(C)		;MAKE BLT TERMINATOR
	ADDI	D,-1(E)		;FINAL ADDRESS
	BLT	C,(D)		;CHOMP CHOMP
	SUB	B,E		;WE'VE DONE THESE
	MOVEI	A,-1(E)		;TO UPDATE BYTE POINTER
	ADDM	A,OBP(CDB)	;TOLD YOU SO
CMU <
;;=B4= 12 OF 13
	CAIE	Z,0		;IMP MODE?
	 JRST	.+3
	LSH	E,2		;MULTIPLY BY 4 FOR BYTE COUNT
	DPB	Z,[POINT 6,OBP(CDB),5]
;;=B4=
>;CMU
	SUBM	E,OCOWNT(CDB)	;UPDATE WORD COUNT
	MOVNS	OCOWNT(CDB)	;CLEVER,EH?
TH6:	EXCH	CHNL,(P)	;BACK TO INPUT SETUP
	EXCH	CDB,-1(P)
	ADDM	A,IBP(CDB)	;UPDATE INPUT PTR
CMU <
;;=B4= 13 OF 13
	CAIE	Y,0		;IMP MODE?
	 JRST	.+3
	LSH	E,2		;MULTIPLY BY 4 FOR BYTE COUNT
	DPB	Y,[POINT 6,IBP(CDB),5]
;;=B4=
>;CMU
	SUBM	E,ICOWNT(CDB)	;UPDATE WORD COUNT
	MOVNS	ICOWNT(CDB)	;SUBTRACTION WAS BACKWARDS
	JRST	TH1		;MORE OF SAME
TH5:	XCT	IOIN,SIMIO	;DO SOME INPUT
	JRST	TH1		;NOW GO PLAY
THERR:	SKIPGE	TEMP,-3(P)	;# THE GUY WANTED
	HRLOI	TEMP,377777	;IT WAS A FUDGE
	SUB	TEMP,B		;SUBTRACT #LEFT TO GET
	HRRM	TEMP,@ENDFL(CDB);#HE GOT
	JRST	RESTR

ENDCOM(THR)
COMPIL(LIN,<LINOUT>,<SIMIO,SAVE,RESTR,GETCHN,X33>,<LINOUT ROUTINE>)

COMMENT ⊗Linout ⊗

DSCR LINOUT(CHANNEL,VALUE);
CAL SAIL
⊗

HERE (LINOUT)
	PUSHJ	P,SAVE
	MOVE	CHNL,-2(P)	;CHANNEL
	LOADI7	A,<LINOUT>
	PUSHJ	P,GETCHN	;CHANNEL DATA
	MOVE	TEMP,OBP(CDB)	;ADJUST TO FULL WORD
	HRRZ	A,OCOWNT(CDB)	;DON'T FORGET COUNT
LINOLP:	TLNN	TEMP,760000	;LINED UP?
	 JRST	 OKLIGN		; YES
	IBP	TEMP		;0 WILL BE THERE
	SOJA	A,LINOLP

OKLIGN:	MOVEM	TEMP,OBP(CDB)
	MOVEM	A,OCOWNT(CDB)	;REPLACE UPDATED THINGS
	CAIGE	A,=10		;ENOUGH ROOM FOR 2 WORDS?
	 XCT	 IOOUT,SIMIO	;NO, OUTPUT
	 JFCL			;IN CASE OUTPUT HAPPENED

	SKIPGE	B,-1(P)		;GET LINE NUMBER
	 JRST	 [MOVNS B
		  MOVNI A,5	;ONLY PUT OUT 5 CHARS
		  JRST NOCONV]	;WAS GIVEN TO US IN TOTO
	MOVNI	A,6		;PUT OUT TAB AFTER
	MOVE	C,[<ASCII /00000/>/2] ;TO MAKE 5
	EXCH	B,C
	PUSH	P,LNBAK		;RETURN ADDR
LNCONV:	IDIVI	C,=10
	IORI	D,"0"
	DPB	D,[POINT 7,(P),6]
	SKIPE	C		;THE RECURSIVE PRINTER
	PUSHJ	P,LNCONV
	HLL	C,(P)		;ONE CHAR, LEFT JUST
	LSHC	B,7
LNBAK:	POPJ	P,.+1
	LSH	B,1
	TRO	B,1
NOCONV:	AOS	C,OBP(CDB)	;MOVE OUT A WORD
	MOVEM	B,(C)
	ADDM	A,OCOWNT(CDB)	;UPDATE COUNT
	MOVEI	B,11
	CAME	A,[-5]
	 IDPB	 B,OBP(CDB)	;OUTPUT A TAB
NOTAB:	MOVE	LPSA,X33
	JRST	RESTR		;THAT'S IT

ENDCOM(LIN)


COMMENT ⊗Breakset,setbreak,stdbrk fakes⊗

;;%  % MOVED IT TO STRSER

COMPIL(CLS,<CLOSIN,CLOSO,CLOSE>,<SAVE,RESTR,SIMIO,X33>,<CLOSE ROUTINES>)

COMMENT ⊗Close, Closin, Closo
  CLOSE(CHAN)     

CLOSIN closes only the input side
CLOSO closes only the output side

⊗
DSCR CLOSIN(CHAN)
CAL SAIL
⊗

HERE (CLOSIN) PUSHJ	P,SAVE		;CLOSE INPUT ONLY
	MOVEI	D,1
	JRST	CLSS

DSCR CLOSO(CHANNEL);
CAL SAIL
⊗
HERE (CLOSO)	
	PUSHJ	P,SAVE		;CLOSE OUTPUT ONLY
	MOVEI	D,2
	JRST	CLSS
DSCR CLOSE(CHANNEL);
CAL SAIL
⊗
.CLS:
HERE (CLOSE)				;CLOSE BOTH
	PUSHJ	P,SAVE		;SAVE ACS AND THINGS
CLSS:	
;;%BQ% RHT 10-11-74 ALLOW CLOSE TO TAKE INHIBIT BITS AS AN ARGUMENT
;; FOLLOWING WAS MOVE LPSA,X22
	MOVE	LPSA,X33
;; FOLOWING WAS CHNL,-1(P)
	MOVE	CHNL,-2(P)	;CHANNEL #
	HRRZ	D,-1(P)		;CHANNEL CLOSE INHIBIT BITS
;;%BQ% ↑
	CHKCHN	CHNL,<CLOSE>	;VERIFY OK CHANNEL
	SKIPN	CDB,@CDBLOC(USER) ;GET CDB
	 JRST	 RESTR		;NOT OPEN, DON'T CLOSE
	XCT	IOCLOSE,SIMIO	;CLOSE CHAN,SPEC
	SETZM	INAME(CDB)
	SETZM	ONAME(CDB)	;NO FILE NAMES OPEN
	JRST	RESTR		;RETURN

ENDCOM(CLS)
COMPIL(MTP,<MTAPE,USETI,USETO,RENAME,ERENAME>
	  ,<SAVE,RESTR,GETCHN,SIMIO,FILNAM,X22,X33,X44>
	  ,<MTAPE, USETI, USETO, RENAME ROUTINES>)

COMMENT ⊗Mtape ⊗

DSCR MTAPE(CHANNEL,MODE);
CAL SAIL
⊗

.MTP:
HERE (MTAPE)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	MOVE	CHNL,-2(P)		;CHANNEL NUMBER
	LOADI7	A,<MTAPE>
	PUSHJ	P,GETCHN
	LDB	C,[POINT 5,-1(P),35]	;PART OF COMMAND CHAR
EXPO <
	MOVEI	B,101
	CAIN	C,11			;MTAPE "I" DOES SPECIAL THINGS.
	 JRST	 MTAPQ			;GO SET IBM COMPABILITY MODE
>;EXPO
;;%##%	ALLOW MTAPE(NULL) TO DO A MTAPE 0 -- WAIT
	MOVEI	B,0
	JUMPE	C,MTAPQ			;THIS IS DEFINITELY NOT A NO-OP
	MOVE	A,OPTAB			;COMMAND BITS
	MOVE	B,OPTAB+1		;MORE
	TRZE	C,30			;COMPRESS TABLE
	ADDI	C,5
	LSH	C,2			;EACH COMMAND IS 4 BITS
	ROTC	A,(C)			;GET RIGHT COMMAND
	ANDI	B,17			;DO IF SYSTEM DOESN'T
	JUMPE	B,[ERR	<MTAPE: ILLEGAL CODE>,1
		JRST	RESTR]
MTAPQ:	HRLI	B,(<MTAPE>)		;CREATE MTAPE OPERATION
	DPB	CHNL,[POINT 4,B,12]
;%##%	TRNE	B,-1			;IS THERE AN OPERATION?
	XCT	B			;YES, DO IT
	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

COMMENT ⊗ Useti, Useto, Rename ⊗

DSCR USETI,USETO(CHANNEL,BLOCK #);
CAL SAIL
⊗

HERE (USETI)
↑↑.USETI:
	SKIPA	LPSA,[XCT IOSETI,SIMIO]	;USETI
HERE (USETO)
↑↑.USETO:
	MOVE	LPSA,[XCT IOSETO,SIMIO] ;USETO
	PUSHJ	P,SAVE
	MOVE	CHNL,-2(P)
	LOADI7	A,<USET>
	PUSHJ	P,GETCHN
	MOVE	A,-1(P)			;VALUE TO USETO
	MOVE	LPSA+1,[JRST .+2]	;BE ABLE TO GET BACK
	JRST	LPSA			;GO TO USETI/O
	MOVE	LPSA,X33
	JRST	RESTR

DSCR RENAME(CHANNEL,"NEW NAME",PROTECTION,@FAILURE FLAG);
     ERENAME(CHANNEL,"NEW NAME",PROT,DATE(0),TIME(0),MODE(0),@FLG);
CAL SAIL
⊗

HERE (RENAME)
↑↑.RENAME:
	PUSHJ	P,SAVE
	SETZM	@-1(P)
	MOVE	LPSA,X44
	LOADI7	A,<RENAME>
	MOVE	CHNL,-3(P)
	PUSHJ	P,GETCHN
	PUSHJ	P,FILNAM	;PARSE FILENAME SPEC
	 JRST	 BDSPC		;SPECIFICATION NO GOOD
	MOVE	TEMP,-2(P)
	TDZE	TEMP,[XWD 777777,777000] ;MAKE THIS RENAME STERILE
	ERR	<ATTEMPT TO SET MODE OR DATE VIA RENAME.
USE ERENAME INSTEAD>,1
	ROT	TEMP,-=9
.RENIT:	MOVEM	TEMP,FNAME+2(USER)
	XCT	IORENAME,SIMIO	;DO THE RENAME
	 JRST	 RNERR		;NO GOOD
	JRST	RESTR
BDSPC:	HRRZ	TEMP,ERRTST(CDB)	;SEE IF
	TRNE	TEMP,10000		;WILLING TO HANDLE ERROR
	ERR	<RENAME: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
	SKIPA	TEMP,[=8]		;ALWAYS REPORT CODE
RNERR:	HRRZ	TEMP,FNAME+1(USER)	;RETURN HORSESHIT NUMBER
	HRROM	TEMP,@-1(P)		;TO THE USER
	JRST	RESTR
;;%BY%

HEREFK(ERENAME,ERENA.)
	PUSHJ	P,SAVE
	SETZM	@-1(P)
	MOVE	LPSA,[XWD 7,7];
	LOADI7	A,<ERENAME>		;
	MOVE	CHNL,-6(P);
	PUSHJ	P,GETCHN
	PUSHJ	P,FILNAM		;PARSE ID SPEC;
	JRST	BDSPC			;LOST
	SKIPN	TEMP,-4(P)		;DATE
	JRST	EREN.1			;NO DATE
	LDB	C,[POINT 3,TEMP,=23]	;PICK UP HIGH ORDER BITS
	DPB	C,[POINT 3,FNAME+1(USER),=20] ;PUT THEM AWAY
EREN.1:	MOVE	C,-5(P)			;PROT
	DPB	C,[POINT =9,TEMP,=8]	;PUT AWAY
	MOVE	C,-2(P)			;MODE
	DPB	C,[POINT 4,TEMP,=12]	;PUT AWAY
	MOVE	C,-3(P)			;TIME
	DPB	C,[POINT =11,TEMP,=23]	;PUT AWAY
	JRST	.RENIT
;;%BY% ↑

ENDCOM(MTP)

COMMENT ⊗where Usercon used to be⊗



COMMENT ⊗Ttyuuo functions ⊗

DSCR TTYUUO FUNCTIONS
CAL SAIL
⊗

Comment ⊗
INTEGER PROCEDURE INCHRW;
 RETURN A CHAR FROM TTCALL 0,

INTEGER PROCEDURE INCHRS;
 RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (TTCALL 2,)

STRING PROCEDURE INCHWL;
 WAIT FOR A LINE, THEN RETURN IT (TTCALL 4, FOLLOWED BY TTCALL 0'S)

STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
 FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0, 
	STR←LINE (TTCALL 5, FOLLOWED BY TTCALL 0'S)

STRING PROCEDURE INSTR(INTEGER BRCHAR);
 RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (TTCALL 0'S)

STRING PROCEDURE INSTRL(INTEGER BRCHAR);
 WAIT FOR ONE LINE, THEN DO INSTR (TTCALL 4, FOLLOWED BY INSTR)

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 (TTCALL 1)

PROCEDURE OUTSTR(STRING STR);
 OUTPUT STR (TTCALL 3)


PROCEDURE CLRBUF;
 CLEARS INPUT BUFFER (TTCALL 11,)

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
⊗

;;%##% ADD TTYUP TO ALL THIS
COMPIL(TTY,,,,,,DUMMYFORSCISS)
DEFINE IENT1 <INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,TTYUP>
DEFINE IENT2
<INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS>
DEFINE IEXT1
<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,BKTCHK,.SKIP.>
TYMSHR <DEFINE IEXT2 <DDFINA,INTRPT,.SONTP,SAVETY>
	DEFINE IENT3 <BACKUP,IONEOU,TTYINL>> ;TYMSHR
NOTYMSHR < DEFINE IEXT2 <.SONTP>
NOTENX <DEFINE IENT3 <BACKUP,TTYINL>> ;NOTENX
TENX <DEFINE IENT3 <TTYINL> > ;TENX >;NOTYMSHR

COMPXX (TTY,<IENT1,IENT2,IENT3>,<IEXT1,IEXT2>,<TELETYPE FUNCTIONS>)
;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
; .SKIP. EXTERNAL ABOVE
;;#GF#

EXPO <
IFE ALWAYS,<
EXTERN OTSTRBF
>;IFE ALWAYS
>;EXPO

;;%##% FOR TTYUP THING
DEFINE KONVERT(AC) <
	SKIPN	TTYCVT(USER)
	JRST	.+5
	CAIL	AC,"a"
	CAILE	AC,"z"
	JRST	.+2
	TRZ	AC,40	;FORCE TO BE LOWER CASE
>
TYMSHR <
HEREFK(IONEOU,IONOU.)
	TTYUUO 15,-1(P)
	SUB P,X22
	JRST @2(P)
>;TYMSHR

HERE (INCHRW)
TYMSHR < SKIPE INTRPT
	XCT DDFINA>;TYMSHR
	TTCALL	A
;;%##%
	MOVE	USER,GOGTAB
	KONVERT	(A)
	POPJ	P,

HERE (INCHRS)	TTCALL	2,A		;SKIP IF CHAR WAITING
	MOVNI	A,1		;ELSE RETURN -1
;;%##%
	MOVE	USER,GOGTAB
	KONVERT(A)
	POPJ	P,

HERE (OUTCHR)	TTYUUO	1,-1(P)		;OUTPUT THE PARAMETER
	SUB	P,X22		;REMOVE PARAMETER
	JRST	@2(P)

HERE (OUTSTR)
;;#FO# 11-18-71 DCS (1-2)
EXPO <
;;#FO#
;;#HC# 5-11-72 DCS MAKE OUTSTR BETTER IN EXPO VERSION (DUE TO LDE)
;;#MM# 5-25-73 ! MAKE SURE ITS LOADED BEFORE WE USE IT
	MOVE 	USER,GOGTAB
	EXCH	A,-1(SP)		;LENGTH OF STRING
	HRRZS	A			; REALLY
	EXCH	B,(SP)			;PTR TO THE STRING
	PUSH	P,C			;NEED ANOTHER AC
	JUMPLE	A,OU.OUT		;DON'T DO ANYTHING
OSLOOP:	MOVE	C,A
	SUBI	A,14*5-1		;# CHARS/CHOMP
	SKIPLE	A			;LOTS LEFT??
	MOVEI	C,14*5-1		; YES,
;;%##% BETTER PLACE THAN SGACS
	MOVE	LPSA,[POINT 7,OTSTRBF];AS GOOD A PLACE AS ANY
	ILDB	TEMP,B
	SKIPE	TEMP			;NULL??
	IDPB	TEMP,LPSA		; NO
	SOJG	C,.-3
	MOVEI	TEMP,0			;A NULL FOR THE END
	IDPB	TEMP,LPSA
	TTCALL	3,OTSTRBF		;RAISON D'ETRE
	JUMPG	A,OSLOOP
OU.OUT:	POP	SP,B
	POP	SP,A
	POP	P,C
	POPJ	P,
;;#HC#
;;#FO# 11-18-71 DCS (2-2) MAKE OUTSTR WORK EFFICIENTLY USING TTYMES (STANFO ONLY)
>;EXPO
NOEXPO <
	HLRZ	TEMP,(SP)		;SIZE/POSITION FIELDS OF BP
	TRZ	TEMP,7777		;CLEAR SIZE FIELD
	OR	TEMP,-1(SP)		;POSITION, COUNT IN RH FOR DDTOUT
	TRNN	TEMP,7777		;IF NULL STRING, QUIT
	 JRST	 QUIT
	HRLM	TEMP,(SP)
	MOVE	TEMP,[SIXBIT /TTY/]	;DEVICE FOR TTYMES
	MOVEM	TEMP,-1(SP)
	MOVEI	TEMP,-1(SP)		;POINT AT SPEC
	CALLI	TEMP,400047		;WRITE FIRST CHAR FOR LENGTH CHARS
;THIS IS THE SPECIAL TTYMES UUO AS PROVIDED BY HELLIWELL
	 JFCL				;IT HAS BEEN KNOW TO SKIP-RETURN
QUIT:	SUB	SP,X22			;REMOVE THE ARGUMENT
>;NOEXPO
;;#FO#
	POPJ	P,			;DONE

TTWCHR←←=100	;MAX NUMBER OF CHARS ON TTY INPUT
CMU <		;EXCEPT WE HAVE LARGER INPUT BUFFERS
TTWCHR←←=140
>;CMU
REDSTR: TYMSHR <
	SKIPE INTRPT
	XCT DDFINA
	XCT @(P)
	PUSHJ P,SAVETY
	AOS -1(P)	;SKIP EXECUTED INSTRUCTION
> ; TYMSHR
	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVEI	A,TTWCHR
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)
	PUSHJ	P,STRNGC
	MOVNI	A,TTWCHR
	PUSH	SP,[0]		;NULL STRING IF NOTHING DONE
	PUSH	SP,TOPBYTE(USER)
TYMSHR <POP P,TEMP>;TYMSHR
	POPJ	P,

FINSTR:	CAIN	TEMP,15	;REMOVE LFD IF CR BROKE IT
	TTCALL	TEMP
FINS1:	ADDM	A,REMCHR(USER)	;NUMBER NOT USED
	ADDI	A,TTWCHR		;NUMBER USED
;;#GI# DCS 2-5-72 REMOVE TOPSTR
;;%##% ALLOW FOR ITERATIVE GETTING OF TTWCHR CHARS
	HRROS  -1(SP)		; TO STRING COUNT WORD
	ADDM	A,-1(SP)	;UPDATE COUNT WORD
;;#GI#
	JRST	RESTR

HERE (INSTR)
NOTYMSHR <	PUSHJ	P,SAVE>;NOTYMSHR
	PUSHJ	P,REDSTR
TYMSHR <JFCL>;TYMSHR
	MOVE	B,-1(P)		;BREAK CHAR
	MOVE	LPSA,X22	;# TO REMOVE

INS1:	PUUO	0,TEMP		;NEXT CHAR
;;%##%
	KONVERT	(TEMP)		;**** CONVERT BEFORE TEST BREAKEDNESS *****
INS2:	CAMN	TEMP,B		;BREAK?
	 JRST	 FINSTR		; YES, ALL DONE
	IDPB	TEMP,TOPBYTE(USER) ;PUT IT AWAY AND
;;%  %  LDE  BETTER NOT READ IN TOO MANY CHARACTERS
	AOJL	A,INS1		; IF ROOM, GO BACK FOR MORE
	PUSHJ	P,CHRMOR	;MAKE ROOM, THEN GO BACK
	JRST	INS1		;

HERE (INCHWL)
NOTYMSHR <	PUSHJ	P,SAVE>;NOTYMSHR
	PUSHJ	P,REDSTR
TYMSHR <	TTCALL 4,TEMP>;TYMSHR
	MOVE	LPSA,X11
NOTYMSHR<	TTCALL	4,TEMP>;NOTYMSHR
;;#GF# DCS 2-1-72 (2-3) DO LOOP HERE, DON'T USE INS1 LIKE BEFORE
NOTYMSHR <
INS3:	CAIE	TEMP,12
NOCMU <	;WE WILL JUST BREAK ON CR OR LF, THANK YOU
EXPO <
	CAIN	TEMP,33		;NORMAL ALTMODE.
>;EXPO
NOEXPO <
	CAIN	TEMP,175
>;NOEXPO
	 JRST	 DNSTR
	CAIE	TEMP,15		;CR?
	TRNE	TEMP,600	;CONTROL BITS ON?
>;NOCMU
CMU <	CAIE	TEMP,15		;CR?
	CAIN	TEMP,12		; OR LF?
>;CMU
	 JRST	 DNSTR		;YES
>;NOTYMSHR
TYMSHR <
INS3:	CAIE TEMP,11
	CAIL TEMP,40
	SKIPA
	JRST DNSTR
>;TYMSHR
;;%##%
	KONVERT(TEMP)
	IDPB	TEMP,TOPBYTE(USER) ;PUT IT AWAY
;;=I08=
	TTCALL	4,TEMP		;GET ANOTHER AND
;;%##%  RHT -- MADE A BIT BETTER (ALLOW FOR GETTING MORE ROOM)
	AOJL	A,INS3		;GO HANDLE IT (IF STILL HAVE ROOM)
	PUSHJ	P,CHRMOR	;GET ROOM FOR MORE CHARS
	JRST	INS3		;GO HANDLE

DNSTR:	MOVEM	TEMP,.SKIP.	;SET BREAK CHAR
	JRST	FINSTR
;;#GF#

HERE (INCHSL)
NOTYMSHR <	PUSHJ	P,SAVE
	MOVE	LPSA,X22	;PARAM (FLAG) AND RETURN>;NOTYMSHR
	PUSHJ	P,REDSTR
TYMSHR <	JFCL
	MOVE	LPSA,X22	;PARAM (FLAG) AND RETURN>;TYMSHR
	SETOM	@-1(P)		;ASSUME FAILED
	TTCALL	5,TEMP		;ARE THERE CHARS?
	JRST	FINSTR		;NO
	SETZM	@-1(P)		;YES, GET THEM
;;#GF# DCS 2-1-72 (3-3)
	JRST	INS3		;USE INCHWL'S LOOP, NOT INSTR'S
;;#GF#

HERE (INSTRL)
NOTYMSHR <	PUSHJ	P,SAVE
	MOVE	LPSA,X22>;NOTYMSHR
	PUSHJ	P,REDSTR
TYMSHR <TTCALL 4,TEMP
	MOVE	LPSA,X22>;TYMSHR
NOTYMSHR<	TTCALL	4,TEMP>;NOTYMSHR
	MOVE	B,-1(P)
	JRST	INS2

HERE (INSTRS)	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	PUSHJ	P,REDSTR
	SETOM	@-2(P)
	TTCALL	5,TEMP
	JRST	FINSTR
	SETZM	@-2(P)
	MOVE	B,-1(P)
	JRST	INS2

HERE (CLRBUF)	TTCALL	11,
	POPJ	P,

HERE (TTYINS)
NOTYMSHR <	PUSHJ	P,SAVE>;NOTYMSHR
	PUSHJ	P,REDSTR	;PREPARE TO MAKE A STRING
TYMSHR <	JFCL>;TYMSHR
	MOVE	LPSA,X33
	SETOM	@-1(P)		;ASSUME NO CHARS
	TTCALL	5,D		;SEE IF LINES WAITING
	 JRST	FINS1		;NONE WAINTING
;;%##% WILL DO INCHRW UUO IN LOOP
	MOVE	B,[TTCALL D]
	JRST	TYIN1		;GO AHEAD

HERE (TTYINL)
NOTYMSHR <
	PUSHJ	P,SAVE
	TTCALL	4,D		;WAIT FOR A LINE
	MOVE	B,[ TTCALL 4,D]
	JRST	TYIN

HERE (TTYIN)	PUSHJ	P,SAVE
	TTCALL	D		;GET A CHAR
	MOVE	B,[TTCALL D]	;FOR LOOP

TYIN:	PUSHJ	P,REDSTR	;PREPARE STACK,A,STRNGC FOR A STRING
>;NOTYMSHR
TYMSHR<
	PUSHJ P,REDSTR
	TTCALL 4,TEMP
	MOVE B,.-1
	JRST TYIN
HERE (TTYIN)	PUSHJ P,REDSTR
	TTCALL TEMP
	MOVE B,.-1

TYIN:	HRRI B,D
	MOVE D,TEMP
>;TYMSHR
	MOVE	LPSA,X33	;PREPARE TO RETURN
TYIN1:	SETZM	@-1(P)		;ASSUME NO BREAK CHAR
;;#TM# ! WAS -1(P)
	MOVE	X,-2(P)		;TABLE #
	MOVEI	TEMP,-1		;BLOCK MUST BE THERE AND TABLE MUST BE INIT'ED
	PUSHJ	P,BKTCHK	;CHECK TABLE #
	 JRST	FINS1		;ERROR OF SOME SORT
	MOVE	FF,BRKMSK(CHNL)	;GET MASK FOR THIS TABLE
	ADD	CHNL,CDB	;RELOCATE RANGE 1 TO 18
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(CHNL)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
;;%##% BREAK TABLE CONVERSION
	TRNE	FF,@BRKCVT(CDB)	 ;SPECIFY UC COERCION
	TLOA	C,400000	;YES
	TLZ	C,400000	;NO
;;%##%
	MOVE	Y,CDB
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(CDB)
	JRST	TTYN1
;;%##%
TTYN:	XCT	B		;1 CHAR
TTYN1:
;;%##%
	JUMPGE	C,TT.NUC	;COERCE BECAUSE OF BRK TBL ?
	CAIL	D,"a"		;ONLY IF LC
	CAILE	D,"z"
	JRST	TT.TSB		;GO TEST BREAK
	TRZ	D,40		;MAKE UC
	JRST	TT.TSB
TT.NUC:	KONVERT(D)		;MAY TURN TO UC BECAUSE OF TTY
TT.TSB:
;;%##%
	TDNE	FF,@Y		;BREAK OR OMIT?
	JRST	TTYSPC		; YES, FIND OUT WHICH
TTYC:	IDPB	D,TOPBYTE(USER)	;PUT IT AWAY
;;%##% BE SURE DONT EAT MORE AT A TIME THAN CAN BLOAT
	AOJL	A,TTYN		;COUNT AND CONTINUE
TTNMOR:	PUSHJ	P,CHRMOR	;ALLOW FOR MORE CHARS
	JRST	TTYN		;GO GO GO

TTYSPC:	HLLZ	TEMP,@Y		;WHICH?
	TDNN	TEMP,FF
	JRST	TTYN		;OMIT
	MOVEM	D,@-1(P)
	SKIPN	Y,DSPTBL(CHNL)	;GET DISPOSITION WORDD FOR THIS TABLE
	JRST	FINS1		;DONE, NO SAVE
	JUMPL	Y,TTYAPP	;APPEND
	ERR	<TTYIN: cannot retain break char>,1,FINS1
TTYAPP:	IDPB	D,TOPBYTE(USER)	;COUNT THE BREAK CHAR
	ADDI	A,1		;ONE MORE HAPPY CHAR
	JRST	FINS1

;;%##% ALLOW FOR ANOTHER CHUNK OF CHARS

CHRMOR:	ADDI	A,TTWCHR	;A ← NUMBER CHARS USED
	ADDM	A,-1(SP)	;UPDATE COUNT
;;#UI# ! 1 OF 2
	PUSH	P,TEMP		;SOME PEOPLE HAVE A CHARACTER HERE
	PUSH	P,[TTWCHR]	;GET SOME MORE
	PUSHJ	P,.SONTP	;BE SURE ROOM & ALIGNED
;;#UI# ! 2 OF 2
	POP	P,TEMP		;WE JUST SAVED THIS
	MOVNI	A,TTWCHR	;REFRESH THE COUNT
	POPJ	P,



HERE(TTYUP)
;;%##%  FLAGS TTY TRANSLATION TO UPPER CASE & RETURNS OLD FLAG
	MOVE 	USER,GOGTAB
	MOVE	A,-1(P)
	EXCH	A,TTYCVT(USER)
	SUB	P,X22
	JRST	@2(P)		;RETURN


;;%CS%
NOTENX<
NOSTANFORD<
HEREFK(BACKUP,BACKU.)
	TTYUUO	10,0
	 JFCL		;THIS CAN SKIP?
	POPJ	P,
>;NOSTANFORD
>;NOTENX
;;%CS% ↑
ENDCOM(TTY)
COMPIL(PTY,,,,,,DUMMYFORSCISS)
EXPO <
NOTYMSHR <
COMPXX(PTY)
>;NOTYMSHR
TYMSHR <
COMPXX(PTY,<AUXCLV,AUXCLR>,<X22,.SKIP.,DDFINA,INTRPT>,<AUXCAL ROUTINES>)
COMMENT !
	AUXCLV (PORT,ARG,FUNCTION NUMBER)
	AUXCLR IS SAME BUT ARG IS BY REFERENCE
	IF FUNCTION NUMBER HAS BITS IN LEFT HAF FOR CALL BY
	VALUE, ITS FOR AN "IMMEDIATE" TYPE INSTR LIKE SETSTS
	BOTH FUCNTIONS RETURN A VALUE BUT IT HAS MEANING ONLY
	IN SOME CASES (DEPENDS ON FUNCTION).
	SETS .SKIP.
!

HEREFK(AUXCLV,AUXCV.)
	POP P,1		;RETURN ADDRESS
	EXCH 1,-1(P)	;NOW ITS ARGUMENT
	MOVE 2,[AUXCAL 3,1]
AUXCLC:	POP P,3		;FUNCTION
	TLNE 3,-1
	HRR 2,1		;FOR IMMEDIATE
	HRL 3,-1(P)	;GET PORT NUMBER
	SETOM .SKIP.
	SKIPE INTRPT
	XCT DDFINA
	XCT 2
	SETZM .SKIP.
	SUB P,X22
	JRST @2(P)

HEREFK(AUXCLR,AUXCR.)
	POP P,2
	EXCH 2,-1(P)	;NOW ITS PARAMETER ADDRESS
	MOVE 1,2		;IN CASE FUNCTION WITH BITS IN LH
	HRLI 2,(<AUXCAL 3,>)
	JRST AUXCLC
>;TYMSHR
>;EXPO
NOEXPO <
COMPXX(PTY,<PTYGET,PTYREL,PTIFRE,PTOCNT,PTCHRW,PTCHRS
ENTINT <PTOCHS,PTOCHW,PTOSTR,BACKUP,LODED,PTYALL,PTYSTR,PTYIN>
ENTINT <PTYSTL,PTYGTL>>
	  ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,BKTCHK,.SKIP.>
	  ,<PTY ROUTINES>)

COMMENT ⊗Ptyuuo functions ⊗

	OPDEF	PTYUUO	[711B8]

DSCR PTYUUO FUNCTIONS
CAL SAIL
⊗
COMMENT ⊗
BEGIN "PTYSPC"
INTEGER PROCEDURE PTYGET;
PROCEDURE PTYREL(INTEGER LINE);
INTEGER PROCEDURE PTIFRE(INTEGER LINE);
INTEGER PROCEDURE PTOCNT(INTEGER LINE);
INTEGER PROCEDURE PTCHRS(INTEGER LINE);
PROCEDURE PTOCHS(INTEGER LINE,CHAR);
PROCEDURE PTOCHW(INTEGER LINE,CHAR);
PROCEDURE PTOSTR(INTEGER LINE; STRING INFORMATION);
PROCEDURE LODED(STRING TRYAGAIN);
STRING PROCEDURE PTYALL(INTEGER LINE);
PROCEDURE BACKUP;
STRING PROCEDURE PTYSTR(INTEGER LINE,BRCHAR);
STRING PROCEDURE PTYIN(INTEGER LINE,BKTBL; REFERENCE INTEGER BRCHAR);

END "PTYSPC"

⊗


HERE (PTYGET)
	SETOM	.SKIP.
	MOVEI	A,0
	PTYUUO	A
	SETZM	.SKIP.
	POPJ	P,

HERE (PTYREL)
	POP	P,(P)
	EXCH	A,(P)
	PTYUUO	1,A
	POP	P,A
	JRST	@2(P)

HERE (PTYGTL) PUSH	P,(P)	;ANOTHER COPY OF RETURN ADDRESS.
	PTYUUO	13,-2(P);POINT AT PTY LINE NUMBER
	MOVE	A,-1(P)	;RESULT.
	SUB	P,X33
	JRST	@3(P)	;AND RETURN.

HERE (PTYSTL) PTYUUO 14,-2(P);POINTED AT LINE NUMBER!
	SUB	P,X33
	JRST	@3(P)

HERE (PTIFRE)
	MOVE	TEMP,[PTYUUO 2,0]
	JRST	%PTY1

HERE (PTOCNT)
	SKIPA	TEMP,[PTYUUO 3,0]

HERE (PTCHRW)
	MOVE	TEMP,[PTYUUO 5,0]
%PTY1:	POP	P,(P)
	EXCH	0,(P)
	XCT	TEMP
	POP	P,0
	JRST	@2(P)

HERE (PTCHRS)
	POP	P,(P)
	EXCH	0,(P)
	PTYUUO	4,0
	MOVNI	A,1
	POP	P,0
	JRST	@2(P)

HERE (PTOCHS)
	SKIPA	TEMP,[PTYUUO 6,0]

HERE (PTOCHW)
	MOVE	TEMP,[PTYUUO 7,0]
	SETOM	.SKIP.
	POP	P,(P)
	EXCH	A,(P)
	EXCH	0,-1(P)
	XCT	TEMP
	SETZM	.SKIP.
	POP	P,A
	POP	P,0
	JRST	@3(P)

HERE (LODED)
	MOVEI	TEMP,0
	EXCH	TEMP,(P)
	PUSH	P,TEMP
	SKIPA	TEMP,[PTYUUO 15,-1(SP)]

HERE (PTOSTR)
	MOVE	TEMP,[PTYUUO  11,-1(SP)]
	PUSH	P,TEMP
	MOVE	USER,GOGTAB
	PUSHJ	P,INSET
	PUSH	SP,[1]
	PUSH	SP,[POINT 7,[0]]
	PUSHJ	P,CAT
	POP	P,TEMP
	POP	P,(P)
	POP	P,-1(SP)
	XCT	TEMP
	SUB	SP,X22
	JRST	@2(P)

HERE (BACKUP)
	TTYUUO	10,
	POPJ	P,

HERE (PTYALL)
	PUSHJ	P,SAVE
	MOVE	0,-1(P)	;LINE NUMBER
	PTYUUO	3,0
	JUMPE	A,[PUSH SP,[0]
		   PUSH SP,[0]
		   JRST ALLQ]
	MOVEI	A,=450
	ADDM	A,REMCHR(USER)
	SKIPL	REMCHR(USER)
	PUSHJ	P,STRNGC
	PUSHJ	P,INSET
	PUSH	SP,-1(P)	;PTY LINE NUMBER
	PUSH	SP,TOPBYTE(USER)	;AND BYTE POINTER.
	PTYUUO	10,-1(SP)	;AND ASK FOR ALL THAT IS THERE.
	MOVEI	B,0
	MOVE	C,(SP)		;BYTE POINTER.
;;#IN# 7-11-72 DCS TOPBYTE INVALIDLY UPDATED (ONE TOO FAR)
SOMMOR:	MOVE	LPSA,C		;LAG BY ONE		#IN#
	ILDB	0,C		;GET CHAR
	JUMPE	0,ALLDUN
	AOJA	B,SOMMOR
ALLDUN:	CAILE	B,=445
	 ERR	 <PTYALL OVERFLOW -- IT JUST CAN'T HAPPEN!!!!>
	HRROM	B,-1(SP)	;SAVE AS RESULT.
	MOVEM	LPSA,TOPBYTE(USER);THIS IS WHERE TO START ENXT ITEM. #IN#
;;#IN#
	SUBI	B,=156		;-ESTIMATE
	ADDM	B,REMCHR(USER)	;AND UPDATE FREE COUTN.
ALLQ:	MOVE	LPSA,X22
	JRST	RESTR

%REDSTR:SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVEI	A,=100
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)
	PUSHJ	P,STRNGC
	MOVNI	A,=100
	PUSH	SP,[0]		;NULL STRING IF NOTHING DONE
	PUSH	SP,TOPBYTE(USER)
	POPJ	P,

%FINSTR:	CAIN	TEMP,15	;REMOVE LFD IF CR BROKE IT
;;#PO# ! RHT THIS USED TO BE CDB (=11) & MUNGED 12
;; USE C & D INSTEAD
	PTYUUO	5,C		;HE USED TO SAY CDB
%FINS1:	ADDM	A,REMCHR(USER)	;NUMBER NOT USED
	ADDI	A,=100		;NUMBER USED
	HRROM	A,-1(SP)	; AND TO STRING COUNT WORD
	JRST	RESTR

HERE (PTYSTR)
	PUSHJ	P,SAVE
	PUSHJ	P,%REDSTR
;;#PO#
	MOVE	C,-2(P)
	MOVE	B,-1(P)		;BREAK CHAR
	MOVE	LPSA,X33	;# TO REMOVE
;;#PO# (2 LINES)
%INS1:	PTYUUO	5,C		;NEXT CHAR
%INS2:	CAMN	D,B		;BREAK?
	 JRST	 %FINSTR		; YES, ALL DONE
;;#PO#
	IDPB	D,TOPBYTE(USER) ;PUT IT AWAY AND
	AOJA	A,%INS1		; GO BACK FOR MORE

	JRST	%INS2

HERE (PTYIN) PUSHJ	P,SAVE
;;#PO# (2 LINES)
	MOVE	C,-3(P)
	PTYUUO	5,C

%TYIN:	PUSHJ	P,%REDSTR		;PREPARE STACK,A,STRNGC FOR A STRING
	MOVE	LPSA,[XWD 4,4]		;PREPARE TO RETURN
%TYIN1:	SETZM	@-1(P)		;ASSUME NO BREAK CHAR
	MOVE	X,-2(P)		;TABLE #
	MOVEI	TEMP,-1		;BLOCK MUST BE THERE AND BE INIT'ED
	PUSHJ	P,BKTCHK	;CHECK TABLE #
	 JRST	%FINS1		;ERROR OF SOME SORT
	MOVE	FF,BRKMSK(CHNL)	;GET MASK FOR THIS TABLE
	ADD	CHNL,CDB	;RELOCATE RANGE 1 TO 18
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(CHNL)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
	MOVE	Y,CDB		;BASE OF THIS GROUP
;;#PO# !
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(CDB)
	JRST	%TTYN1
;;#PO# !
%TTYN:	PTYUUO	5,C
%TTYN1:	TDNE	FF,@Y		;BREAK OR OMIT?
	JRST	%TTYSPC		; YES, FIND OUT WHICH
;;#PO# !
%TTYC:	IDPB	D,TOPBYTE(USER)	;PUT IT AWAY
	AOJL	A,%TTYN		;COUNT AND CONTINUE
	JRST	%FINS1		;DONE
%TTYSPC: HLLZ	TEMP,@Y		;WHICH?
	TDNN	TEMP,FF
	JRST	%TTYN		;OMIT
;;#PO# !
	MOVEM	D,@-1(P)
	SKIPN	Y,DSPTBL(CHNL)	;PICK UP DISPOSITION WORD
	JRST	%FINS1		;DONE, NO SAVE
	JUMPL	Y,%TTYAPP	;APPEND
	ERR	<PTYIN: cannot retain break char>,1,%FINS1
;;#PO#
%TTYAPP: IDPB	D,TOPBYTE(USER)	;COUNT THE BREAK CHAR
	ADDI	A,1		;ONE MORE HAPPY CHAR
	JRST	%FINS1

>;NOEXPO
ENDCOM(PTY)


;;#XB ! JFR 6-17-76 TOPBYT and REMCHR removed from external list
COMPIL(TMP,<TMPIN,TMPOUT>
		 ,<GOGTAB,STRNGC,INSET,CORGET,CORREL,X22,X44>
		 ,<Tmpcor input and output routines>)
COMMENT	⊗  TMPIN (input from a tmpcor file)

;; SUBROUTINES SUPPLIED BY MJC -- 9 MARCH 1976

Call from a Sail program:  STR←TMPIN(TMPFIL,@FLAG)
where TMPFIL and STR are strings and FLAG is boolean.

This routine fills STR with the contents of tmpcor file TMPFIL.  FLAG is set to
true if the tmpcor file doesn't exist, and false otherwise.  Accumulators A-F
and USER are used and not reset.

The address of the second word of STR's string descriptor and the address of
FLAG have been pushed onto the P stack, and TMPFIL's two descriptor words have
been pushed onto the SP stack.  (Note that a Sail string descriptor consists
of two words:  [constant flag,,length], [byte pointer].)  Hence the parameters
are accessed as follows:
    -1(P) contains the address of FLAG;
    (SP) contains the byte pointer to TMPFIL; and
    -1(SP) contains the flag/length word for TMPFIL.

TMPIN first asks the Sail system for a string of length =1284, in order to 
accommodate the largest possible tmpcor file, and make sure it's aligned on a
word boundary.  It then does a TMPCOR uuo to read the contents of the desired
tmpcor file into the string area.  Accumulators E and F are used to hold the
two-word tmpcor information block.  If the file doesn't exist, FLAG is set to
true (-1); otherwise, FLAG is set false, and the string descriptor for STR is
constructed.  Unused string space is released, and TMPIN returns to the caller.

Sail features used are the following:
    REMCHR(USER)	# characters remaining in string space, negated
    TOPBYT(USER)	byte pointer to the first free character in string space
    STRNGC		string storage manager
    INSET		aligns TOPBYT to a word boundary

⊗

HEREFK(TMPIN,TMPIN.)		; *** Sail wants this.
	BEGIN	TMPIN
	F←6
	G←7
; Acquire a large chunk of string space, and remember where it starts.
	MOVE	USER,GOGTAB	; Get address of Sail's user table.
	MOVEI	A,4+5*400	; Largest possible amt of string needed.
	ADDM	A,REMCHR(USER)	; REMCHR is # chars remaining in string space.
	SKIPLE	A,REMCHR(USER)	; Enough for my humongous string?
	 PUSHJ	P,STRNGC	; No--go scrounge up some room.
	PUSHJ	P,INSET		; Make sure next string starts at word boundary.
	HRRZ	A,TOPBYT(USER)	; TOPBYT is now POINT 7,word.
	MOVEI	F,-1(A)		; Make address into right half of IOWD for TMPCOR.
	HRLI	F,-400		; Fill in the length field of the IOWD.

; Get the tmpcor file name, put it into acc E for tmpcor uuo, and read the file.
	HRRZ	A,-1(SP)	; Get the length of the tmpcor file name.
	MOVE	B,(SP)		; Get the byte pointer to the name.
	MOVE	C,[POINT 6,E]	; Place to put it.
	SETZ	E,		; Initialize the name to zero.
	SOJL	A,GOTNAM
	PUSHJ	P,SIXCHR	; Turn the first character into sixbit, and put
	SOJL	A,GOTNAM	;  it into tmpcor info.
	PUSHJ	P,SIXCHR	; Same for second and third characters, if any.
	SOJL	A,GOTNAM
	PUSHJ	P,SIXCHR
GOTNAM:	MOVE	A,[1,,E]
	TMPCOR	A,		; The word count is returned in A.
	 JRST	NOFILE		; The desired tmpcor file wasn't there.
	SETZM	@-1(P)		; Get address of FLAG, and make it "false" (0).

; Turn the file contents into a Sail string, update all the relevant Sail
;  pointers and counters, and return.
MAKEBP:	MOVE	B,TOPBYT(USER)	; Pointer to new string was formerly pointer to
	MOVEM	B,(SP)		; Point STR at the text we just read.
	ADDI	B,(A)		; Point the top-of-string-space pointer just
	HRRM	B,TOPBYT(USER)	;  past the text (# words of text is in A).
	IMULI	A,5		; Compute # characters of text.
	HRLI	A,40		; Not a constant string
	MOVEM	A,-1(SP)	; Put that into STR's length field.
	SUBI	A,4+5*400	; Free up all the unused string space by decreasing
	ADDM	A,REMCHR(USER)	;  REMCHR (which is negative) by # of unused chars.
DONE:	SUB	P,X22		; Pop addresses off P stack.
	JRST	@2(P)		; Go away.

; Tmpcor file didn't exist.  Make FLAG "true" (-1) and return.
NOFILE:	SETOM	@-1(P)		
	SETZ	A,		; Length of resulting string will be zero.
	JRST	MAKEBP

; The code for SIXCHR is on the next page.

	BEND	TMPIN

COMMENT	⊗  TMPOUT (output to a tmpcor file)

Call from a Sail program:  TMPOUT(TMPFIL,STR,@FLAG)
where TMPFIL and STR are strings and FLAG is boolean.

This routine writes the string STR into tmpcor file TMPFIL.  FLAG is set to true
if the tmpcor file could not be written, and false otherwise.  Accumulators A-G
and USER are used and not reset.  Since the TMPCOR uuo will not write an empty
tmpcor file, a null STR causes FLAG to be set true.

The address of FLAG has been pushed onto the P stack, and the string descriptor
words of TMPFIL and STR have been pushed onto the SP stack.  Hence the parameters
are accessed as follows:
    -1(P) contains the address of FLAG;
    (SP) contains the byte pointer to STR;
    -1(SP) contains the flag/length word for STR;
    -2(SP) contains the byte pointer to TMPFIL; and
    -3(SP) contains the flag/length word for TMPFIL.

TMPOUT first ascertains the length of the string to be written and acquires a
chunk of core of the appropriate size for use as a buffer.  It then converts the
first three characters of TMPFIL to sixbit, copies STR to the buffer in order
to align it on a word boundary, and does the tmpcor output.  Accumulators E and
F are used for the two-word tmpcor information block.  TMPOUT then sets FLAG and
returns.

Sail features used are the following:
    CORGET		given the desired number of words of core in C, returns
			the address of a block of that size in B (skip return if
			success, direct return if failure)
    CORREL		given the address of a block in B, releases the block to
			free storage (always direct return)

⊗

HEREFK(TMPOUT,TMPOU.)		; *** Sail wants this.
	BEGIN	TMPOUT
	F←6
	G←7
; Get the right amount of buffer space and fill in tmpcor info IOWD.
	HRRZ	C,-1(SP)	; Get length of STR.
	ADDI	C,9		; Get enough words to hold the whole string plus
	IDIVI	C,5		;  an extra word, then change # chars to # words.
	PUSH	P,C		; Save the length (we'll need it for tmpcor info).
	PUSHJ	P,CORGET	; Get a buffer of the appropriate length.
	 JRST	NOSTG		; Couldn't get the core.
	MOVE	G,B		; Address of block returned in B, so remember it.
	MOVEI	F,-1(B)		; Also store in address part of tmpcor info IOWD.
	POP	P,C		; Recall the length needed for the tmpcor file.
	MOVNI	C,-1(C)		; Make it into the length part of the IOWD.
	HRL	F,C		; Decremented since extra word was CORGETed.

; Copy STR to the buffer.  Address of buffer is in B.
	HRLI	B,440700	; Convert buffer address into POINT 7,buffer.
	MOVE	C,(SP)		; Get the byte pointer for STR.
	HRRZ	A,-1(SP)	; Length of STR.
;;#XY# !
	SETZM	(B)		;CLEAR FIRST WORD OF BUFFER
LOOP:	SOJL	A,CPYDON	; Done copying?
	ILDB	D,C		; No, copy another character.
	IDPB	D,B
;;#XY# !
	SETZM	1(B)		;CLEAR NEXT WORD OF BUFFER
	JRST	LOOP
CPYDON:

; Get the tmpcor file name, put it into tmpcor info, and output the buffer.
	HRRZ	A,-3(SP)	; Get the length of the tmpcor file name.
	MOVE	B,-2(SP)	; Get the byte pointer to the name.
	MOVE	C,[POINT 6,E]	; Place to put it.
	SETZ	E,		; Initialize the name to zero.
	SOJL	A,GOTNAM
	PUSHJ	P,SIXCHR	; Turn the first character into sixbit, and put
	SOJL	A,GOTNAM	;  it into TMPNFO.
	PUSHJ	P,SIXCHR	; Same for second and third characters, if any.
	SOJL	A,GOTNAM
	PUSHJ	P,SIXCHR
GOTNAM:	MOVE	A,[3,,E]
	TMPCOR	A,		; Write the buffer.
	 JRST	NOWRIT		; Couldn't do it.
	SETZM	@-1(P)		; Get address of FLAG, and make it "false" (0).
DONE:	MOVE	B,G		; Return the buffer to free storage.
	PUSHJ	P,CORREL
XIT:	SUB	SP,X44		; Pop all the string stuff.
	SUB	P,X22
	JRST	@2(P)		; Return.

; TMPCOR uuo direct-returned.  Probably no more space for tmpcor files.
NOWRIT:	SETOM	@-1(P)		; Couldn't do output for some reason, so make
	JRST	DONE

; CORGET direct-returned.
NOSTG:	ERR	<Couldn't get core for buffer.>	; *** Sail wants this.
	JRST	XIT		; *** P and SP screwed up right now.

; Code for SIXCHR is on the next page.

	BEND	TMPOUT
COMMENT	⊗  SIXCHR (converts a character to sixbit)

This routine gets a character from a string specifying the name of a tmpcor
file (byte pointer in B), converts it to sixbit, and puts it into the tmpcor
info name field (byte pointer in C).  It's called by PUSHJ P,SIXCHR in both
TMPIN and TMPOUT.  Note that acc D is overwritten.

⊗

SIXCHR:	ILDB	D,B		; Get the ascii character.
	TRZN	D,100		; If 100 bit is on, turn it off and skip.
	TRZA	D,40		; Turn off 40 bit since 100 bit was off, and skip.
	TRO	D,40		; Turn on 40 bit since 100 bit was on.
	IDPB	D,C		; Put the sixbit character into tmpcor info.
	POPJ	P,

ENDCOM(TMP)

IFN ALWAYS,<
BEND IOSER>
DSCR BEND IOSER
⊗