perm filename IOSER[NEW,AIL] blob sn#410576 filedate 1979-01-15 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 
C00026 00005	Getchn 
C00029 00006	Filnam 
C00041 00007	Flscan 
C00046 00008	Open 
C00052 00009
C00058 00010	Release 
C00063 00011	Lookup, Enter 
C00067 00012	
C00068 00013	Fileinfo 
C00070 00014	Out 
C00074 00015	Input 
C00084 00016	IFN ALWAYS,<BEGIN NUMIN>
C00090 00017	NUMIN:			SET UP TO READ FROM A CHANNEL
C00093 00018	LNUMIN	NUMBER INPUT
C00096 00019	GETNUM GETNU1
C00099 00020	DFSC
C00103 00021	DMUL..
C00106 00022	DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
C00110 00023	Arryout, Wordout 
C00115 00024	Arryin, Wordin 
C00125 00025	Linout 
C00127 00026	Breakset,setbreak,stdbrk fakes
C00128 00027	Close, Closin, Closo
C00130 00028	Mtape 
C00132 00029	 Useti, Useto, Rename 
C00135 00030	where Usercon used to be
C00136 00031	Ttyuuo functions 
C00154 00032	Ptyuuo functions 
C00162 00033	  TMPIN (input from a tmpcor file)
C00169 00034	  TMPOUT (output to a tmpcor file)
C00177 00035
C00178 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)>
NOITS <
	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
>;NOITS
ITS <
begin FNR

;its style command line scanner
;	non-skip return for null file spec
;clobbers acs with reckless abandon

break←a		;returns with character that broke scan
dev←b		;returns dev,fn1,fn2,sname
fn1←c
fn2←d
sname←x
ac←y
char←z
acptr←q3
limbo←temp	;scanner read ahead character
		;cannot leave psname until zero

for a in(a,b,c,z,q3,temp)
<	push p,a
>
	hrrzs 1(sp)		;only want length part
	pushj p,getfil
	jfcl			;null spec is okay
	movem fn1,fname(user)
	movem fn2,ext(user)
	movem sname,prpn(user)
	cain dev,0
fnrxit:	aos -6(p)		;do a skip return

for a in (temp,q3,z,c,b,a)
<	pop p,a
>
cpopj:	popj p,

;filnam subroutines

getcc:	skipn break,limbo
	pushj p,nextc
	setzm limbo
	popj p,

nextc:	movei break,0		;assume no more
	sosl 1(sp)
	ildb break,2(sp)
	popj p,

psname:	pushj p,getcc		;break off word from input stream
	caie break,40		;ignore leading spaces
	cain break,11		;tabs too
	jrst psname
	move acptr,[440600,,ac]
	tdza ac,ac
name1:	pushj p,getcc
	pushj p,brktst
	jrst nambrk		;found a break character
name2:	tlne acptr,770000	;ignore everything after 6 characters
	idpb char,acptr
	jrst name1

nambrk:	jumpn char,cpopj	;no trailing spaces
nambr1:	pushj p,getcc
	caie break,40		;ignore trailing spaces
	cain break,11
	jrst nambr1
	pushj p,brktst
	popj p,			;a break character
	movem break,limbo	;space broke us
	movei break,40
	popj p,

;converts break to sixbit and puts result in char
;↑Q quotes next character
;fails to skip on break character

brktst:	cain break,11
	movei break,40
	pushj p,sixtst
	jumpl char,[	caie break,21		;↑Q
			popj p,		;non-sixbit breaks us
			pushj p,getcc
			pushj p,sixtst
			jumpl char,cpopj	;non-sixbit
			jrst brkt1]
	jumpe char,cpopj
	caie char,':'
	cain char,';'
	popj p,
brkt1:	aos (p)
	popj p,

;convert break to sixbit

sixtst:	movni char,1
	cail break,40
	caile break,"←"
	jrst sixt1	;might be lower case
	movei char,-40(break)
	popj p,
sixt1:	cail break,"a"
	caile break,"z"
	popj p,
	movei char,<"A"-"a"-40>(break)
	popj p,

;this routine scans command line for file specification

getfil:	setzb fn1,fn2
	setzb dev,sname
	setzm limbo
	pushj p,psname
	jumpe ac,cpopj
	aosa (p)
getf1:	pushj p,psname		;break off first name
	jumpe ac,cpopj		;let initl worry about it
	cain break,":"
	jrst [	move dev,ac
		jrst getf1]
	cain break,";"
	jrst [	move sname,ac
		jrst getf1]

;this must be fn1 or fn2

	caie break,40
	jrst [	jumpn fn1,[	move fn2,ac
				popj p,]
		move fn1,ac
		popj p,]
	jumpn fn1,[	move fn2,ac
			jrst getf1]
	move fn1,ac
	jrst getf1

bend FNR
>;ITS

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
;; \UR#25\ JRL 6/20/78 ALLOW OCTAL DIGITS AS FILE NAMES
; Wish to allow #oooooooooooo as file name (where each o is an
; octal digit). Main reason is to allow SAIL programs to deal
; with funny filenames such as UFD's.
	MOVEI	Y,0		; BREAK CHAR IN CASE NO STRING
	SOSGE	1(SP)		; DECREMENT STRING LENGTH
	POPJ	P,		;	NO STRING, RETURN
	ILDB	Y,2(SP)		; PICK UP CHAR
	CAIE	Y,"#"		; IS THIS AN OCTAL FILE NAME?
	JRST	URNOCT		; NOPE, HANDLE NORMAL WAY.
	PUSH	P,X		; SAVE ADDRESS TO PLACE ANSWER
	MOVEI	D,=12		; OCTAL NAME MAY HAVE 12 DIGITS
	MOVEI	X,0		; ACCUMULATE ANSWER IN X
URFLN1: MOVEI	Y,0		; BREAK CHAR IF STRING EXHAUSTED
	SOSGE	1(SP)		; 
	JRST	URFRET		; STRING EXHAUSTED, RETURN
	ILDB	Y,2(SP)		; PICK UP CHAR
	CAIE	Y,"."		; SEE IF BREAK CHARACTER.
	CAIN	Y,"["		; 
	JRST	URFRET		; 
	CAIE	Y,"]"		;
	CAIN	Y,","		; 
	JRST	URFRET
; NOT A BREAK CHARACTER. SEE IF DIGIT. IF NOT IGNORE IT.
	JUMPE	D,URFLN1	; ALREADY HAVE 12 DIGITS?
	CAIG	Y,"7"		; CHECK TO SEE IF DIGIT
	CAIGE	Y,"0"
	JRST	URFLN1	; NOT DIGIT. IGNORE
	ANDI	Y,7		; GET VALUE OF DIGIT.
	LSH	X,3		; ACCUMULATE DIGITS
	ORI	X,(Y)
	SOJA	D,URFLN1	; LOOP
URFRET: MOVEM	X,@(P)		; STORE ANSWER
	POP	P,X		; CLEAN-UP STACK
	POPJ	P,		; RETURN
FLN1:	MOVEI	Y,0		;ASSUME NO STRING LEFT
	SOSGE	1(SP)		;TEST 0-LENGTH STRING
	 POPJ	 P,
	ILDB	Y,2(SP)		;GET BYTE
URNOCT:				; NOT AN OCTAL FILE NAME
;; \UR#25\ END OF #OCTAL DIGIT FILE NAME HACK CHANGES
TYMSHR <	CAIE Y,"("
	CAIN Y,")"
	POPJ P,
>;TYMSHR
;;#ZK# -- QUOTE-MODE ADDED -- 78-07-10 DON
STANFO <	CAIN Y,"↓"	;DOWN-ARROWS DELIMIT QUOTED CHARS
		 JRST  [TLC D,400000	;USE SIGN BIT OF TALLY AS FLAG
			JRST FLN1]
		JUMPL D,FLQTED
>;STANFO  #ZK#
NOITS <
	CAIE	Y,"."		;CHECK VALID BREAK CHAR
	CAIN	Y,"["
	POPJ	P,
	CAIE	Y,"]"
	CAIN	Y,","
	POPJ	P,
>;NOITS
FLQTED:	TRNN	D,777777	;TEST FOR TALLY (IGNORING STANFO QUOTE-FLAG) BEING 0
	 JRST	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


;; \UR#23\ (1 of 2) JRL 5/2/78 following used to be SOJLE 
;;          (would have caused buffer to be written out too early 
;;           except for compensating error below).
.OUT:	SOJL	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
;; \UR#23\ (2 of 2) JRL 5/2/78 following instruction used to be
;;        a JRST. We must decrement byte count to take care of
;;        current byte being written. This bug was formerly compensated
;;        for above
	SOJA	A,.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,<LREALIN,LREALSCAN,REALIN,REALSCAN,INTIN,INTSCAN>
	  ,<SIMIO,SAVE,RESTR,X11,X22,X33,X44,GETCHN,NOTOPN>
	  ,<STRING TO NUMBER CONVERSION>)

IFN ALWAYS,<BEGIN NUMIN>
HERE (REALIN)
	PUSHJ	P,SAVE
	PUSHJ	P,NUMIN		;SET UP TO GET CHARS FROM CHANNEL
	PUSHJ	P,RLNIN		;GOBBLE A REAL NUMBER
	SNGL	A,A
INRETA:	MOVEM	A,RACS+A(USER)
INRET:
	MOVEM	Z,@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)
	MOVE	LPSA,X22	;GET RID OF CHANNEL AND RET. WD
	JRST	RESTR

HERE (REALSCAN)
	PUSHJ	P,SAVE
	PUSHJ	P,STRIN		;SET UP TO GET CHARS FROM A STRING
	PUSHJ	P,RLNIN
	SNGL	A,A
STRRTA:	MOVEM	A,RACS+A(USER)
STRRET:
	HRRZ	X,-2(P)
	SOJ	CDB,		;BACK UP BYTE POINTER
FOR II←1,4<
	IBP	CDB>
	MOVEM	CDB,(X)
	AOJ	CHNL,
	HRRM	CHNL,-1(X)
	MOVEM	Z,@-1(P)	;STORE BREAK CHARACTER
	MOVE	LPSA,X33	;GET RID OF BRK VAR, STR ADDR
	JRST	RESTR

FNDDIG:			;FIND DIGIT OR DECIMAL POINT, KEEP TRACK OF SIGN
	EXCH	A,(P)		;FIRST PUT "GET NEXT CHAR" INSTR ON STACK
	PUSH	P,A		;AHEAD OF RETURN WORD
FNDDI1:	XCT	-1(P)		;GET NEXT CHAR
	CAIL	D,"0"
	CAILE	D,"9"
	CAIN	D,"."
	 POPJ	P,
	JUMPL	D,.-1		;EOF OR END OF STRING
	CAIN	D,"-"
	 TLOA	FF,NUMNEG
	TLZ	FF,NUMNEG	;SIGN MUST IMMEDIATELY PRECEDE NUMBER
	JRST	FNDDI1

RLNIN:
	SETZ	FF,		;ZERO FLAGS
	PUSHJ	P,FNDDIG
	JUMPL	D,.+2
	 TLO	FF,NUMSAW	;THERE WAS PART OF A NUMBER
	PUSHJ	P,GETNUM	;TRY FOR AN INTEGER
	CAIE	D,"."
	 TRZA	C,-1		;NO DIGITS AFTER DEC PT.
	 PUSHJ	P,GETN1D	;FINISH UP FRACTION
	EXCH	C,(P)		;DIGIT COUNTS ↔ NXTCHR INSTR
	PUSH	P,X		;PARTIAL RESULT
	PUSH	P,Y
	PUSH	P,FF		;FLAGS
	PUSH	P,C		;NXTCHR INSTR
	SETZ	FF,		;EXPONENT FLAGS
	CAIE	D,"@"
	CAIN	D,"E"
	 JRST	[XCT	(P)		;EAT A CHAR
		CAIE	D,"@"
		CAIN	D,"E"
	RLNIN2:	 XCT	(P)		;ALLOW FOR TWO OF THESE
		CAIN	D,"-"
		 TLOA	FF,NUMNEG
		CAIN	D,"+"
		 XCT	(P)		;PAST SIGN
		PUSHJ	P,GETNUM	;RECURSE FOR EXPONENT
		PUSHJ	P,TZMUL	;GET EXPONENT AS AN INTEGER
		JUMPN	C,RLNIN1
		 ERR	<NUMIN: Improper exponent>,1	;NO DIGITS APPEARED
		JRST	RLNIN1
		]
	CAIN	D,"D"
	 JRST	RLNIN2
	SETZB	X,Y		;EXPONENT IS ZERO
	SETZ	C,		;AND THERE WERE NO DIGITS IN IT
RLNIN1:
	MOVE	Z,D		;SAVE BRCHAR (COULD BE -1 FOR EOF)
	SUB	P,X11		;GET RID OF NXTCHR INSTR
	TLNN	FF,NUMNEG
	 SKIPA	D,Y		;LOW WD OF EXPONENT
	 MOVN	D,Y		;EXPONENT WAS NEG
	POP	P,FF		;FLAGS OF FRACTION
			;-2(P): FRACTION DIGIT COUNTS
			;-1(P), -0(P): FRACTION
	TLNN	C,-1		;IF ANY TRAILING ZEROES LEFT, A WHOPPING BIG EXP.
	SKIPE	X		;HIGH PART HAD BETTER BE ZERO
	 JRST	[SUB	P,X33	;WIPE OUT FRACTION AND DIGIT COUNTS
		 JRST	DFSERR]	;AND COMPLAIN
	POP	P,Y		;FRACTION PART
	POP	P,X
	POP	P,C		;DIGIT COUNTS OF FRACTON
	JRST	DFSC
	
HEREFK(LREALIN,LREA.IN)
	PUSHJ	P,SAVE
	PUSHJ	P,NUMIN
	PUSHJ	P,RLNIN
	DMOVEM	A,RACS+A(USER)
	JRST	INRET

HEREFK(LREALSCAN,LREA.SCAN)
	PUSHJ	P,SAVE
	PUSHJ	P,STRIN
	PUSHJ	P,RLNIN
	DMOVEM	A,RACS+A(USER)
	JRST	STRRET

HERE (INTIN)
	PUSHJ	P,SAVE
	PUSHJ	P,NUMIN
	PUSHJ	P,RLNIN
	SNGL	A,A
	PUSHJ	P,RFIX
	JRST	INRETA

RFIX:			;SIGN(A)*FLOOR(ABS(A)+0.5) 
KI10<	JUMPL	A,.+3
	 FIXR	A,A
	 POPJ	P,
	MOVN	A,A
	FIXR	A,A
	MOVN	A,A
	POPJ	P,
>;KI10
NOKI10<	JUMPL	A,.+4
	 FADRI	A,(0.5)		;SORRY, 166 !
	 FIX	A,A
	 POPJ	P,
	MOVN	A,A
	FADRI	A,(0.5)
	FIX	A,A
	MOVN	A,A
	POPJ	P,
>;NOKI10

HERE (INTSCAN)
	PUSHJ	P,SAVE
	PUSHJ	P,STRIN
	PUSHJ	P,RLNIN
	SNGL	A,A
	PUSHJ	P,RFIX
	JRST	STRRTA

COMMENT \
.INSERT SAILPD.FAI[S,AIL]
	SAILPD	($REALIN,REAL,1,0,<INTEGR>)
	SAILPD	($INTIN,INTEGR,1,0,<INTEGR>)
	SAILPD	($REALSCAN,REAL,2,0,<STRING+REFERENCE,INTEGR+REFERENCE>)
	SAILPD	($INTSCAN,INTEGR,2,0,<STRING+REFERENCE,INTEGR+REFERENCE>)
	SAILPD	(LREALIN,DBLPRC+REAL,1,0,<INTEGR>)
	SAILPD	(LREALSCAN,DBLPRC+REAL,2,0,<STRING+REFERENCE,INTEGR+REFERENCE>)
\
NUMIN:			;SET UP TO READ FROM A CHANNEL
	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	A,[JSP A,NCH]
	MOVEI Z,1;		FOR LINE NUMBER TEST
	POPJ	P,

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
	CAIN D,15		;IGNORE CR
	 JRST NCH
	JUMPE D,NCH		;AND NUL
	SKIPN	LINNUM(CDB)	;WANT SETPL STUFF???
	JRST (A) 		;NO, RETURN
	CAIN	D,12		;YES, IS THIS A LF?
	AOS	@LINNUM(CDB)	;YES, BUMP LINE COUNT
	CAIE	D,14		;A FF?
	JRST	(A)		;NOPE
	SKIPN	PAGNUM(CDB)	;BUG TRAP
	JRST    [ ERR	<DRYROT -- SETPL LOSSAGE DETECTED BY NUMIN>,1
		JRST	(A) ]
	AOS	@PAGNUM(CDB)	;BUMP PAGE COUNT
	SETZM	@LINNUM(CDB)	;ZERO LINE COUNT
	JRST	(A)		;RETURN
NCH2:	XCT IOIN,SIMIO;		INPUT
	JRST NCH1		;ALL OK
NCH7:	SETO	D,		;EOF OR DATA ERROR.
	JRST (A)
NCH5:	
	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]
	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

STRIN:			;SET UP TO READ FROM A STRING
	MOVE	A,[JSP A,NCHA]
	HRRZ	CHNL,-3(P)	;ADDR OF WD2
	MOVE	CDB,(CHNL)	;BP
	HRRZ	CHNL,-1(CHNL)	;LENGTH
	POPJ	P,

NCHA:	SOJL	CHNL,NCH7
	ILDB	D,CDB
	CAIN	D,15
	 JRST	NCHA		;IGNORE CR
	JUMPE	D,NCHA		;AND NUL
	JRST (A)
;LNUMIN	NUMBER INPUT
COMMENT ⊗
These routines form a character-string
to number conversion package.  GETNUM eats characters one at a time
until a non-digit is eaten; GETNUM then returns intermediate information
which can be used by the other routines.
GETNU1 is the routine to call
after GETNUM when a decimal point is seen and you eventually want a floating
point number.

GETNUM:	-1(P)	instruction to XCT, gets next character in D
	(P)	return word
	D	first digit
result:	as in GETNU1

GETNU1:	X,Y	double length partial integer result
	-1(P)	instruction to XCT, gets next character in D
	(P)	return word
	C	# trailing zeroes ,, power of 10 scale factor
	D	first digit
result:	X,Y	double length partial integer result
	(P)	instructin to XCT, gets next character in D
	FF	flags (sign, overflow)
	C	# trailing zeroes ,, scale factor + # digits since then
	D	break character

MAKINT:	X,Y	double length partial integer result
	(P)	return word
	FF	sign flag
	C	# trailing zeroes ,, junk
result:	A	integer value

DFSC:
	X,Y	double length partial integer result
	(P)	return word
	FF	flags
	C	# trailing zeroes ,, # digits since decimal point
	D	exponent
result:	A,B	floating point value

AC USAGE:

FF	flags
A,B	double temp		return word for JSP NCH
C	#tz ,, # digits
D	char
X,Y	double integer partial result
Z	1 (for testing line numbers)
CHNL	channel number, or # chars left in string
CDB	channel data block addr, or bp to string
RF	res.
LPSA	scale factor for DMUL	gen.temp.
TEMP	gen. temp.
USER	res.
SP	res.
P	res.

⊗
;GETNUM GETNU1

NUMNEG←←400000
EXPNEG←←200000
NUMSAW←←100000

GETNUC:	XCT	-1(P)		;GET A CHAR FIRST
GETNUM:
	SETZB	X,Y		;INITIAL RESULT
	SETZ	C,		;DIGIT COUNTS
	JRST	2,@.+1		;CLEAR FLAGS
	GETNU1

GETN1D:	TRZA	C,-1		;NUMBER OF DIGITS SINCE DEC. PT IS ZERO
GETN1E:	AOBJN	C,.+1		;A TRAILING ZERO
GETN1C:	XCT	-1(P)		;GET NEXT CHAR
GETNU1:	CAIL	D,"0"
	CAILE	D,"9"
	 POPJ	P,		;NOT DIGIT
	SUBI	D,"0"		;CONVERT TO DIGIT NOW
	JUMPE	D,GETN1E	;A TRAILING ZERO
	ADDI	C,1		;ANOTHER DIGIT
	TLNE	C,-1		;WERE THERE TRAILING ZEROES BEFORE IT?
	 PUSHJ	P,TZMUL		;YES
	PUSHJ	P,M10ADD	;MULT BY =10 AND ADD D
	JRST	GETN1C

TZMUL:	HLRZ	TEMP,C		;# TRAILING ZEROES
	JUMPE	TEMP,CPOPJ	;QUIT IF NONE
	MOVEI	C,(C)		;WILL BE NONE IF WE FINISH WITHOUT OVERFLOW
;;%YZ%	pmf Feb 11 77
;	CAIN	TEMP,(C)
;	 JRST	CPOPJ		;TRAILERS WERE ALSO LEADERS!
	MOVEI	LPSA,(D)	;SAVE DIGIT
	SETZ	D,
	PUSHJ	P,M10ADD	;ADJUST VALUE TO ACCOUNT FOR TRAILING ZEROES
	SOJG	TEMP,.-2
	MOVEI	D,(LPSA)	;RESTORE D
	POPJ	P,

M10ADD:
	MOVE	A,Y		;LOW HALF
	MULI	A,=10
	TLO	A+1,400000	;PREVENT OVERFLOW
	ADDI	A+1,(D)		;ADD NEW DIGIT
	TLZN	A+1,400000	;WOULD THERE HAVE BEEN AN OVERFLOW?
	 ADDI	A,1		;YES. (THIS CAN'T OVERFLOW; A WAS AT MOST 9)
	MOVE	D,X		;HIGH HALF
	IMULI	D,=10
	 JOV	[ADD	C,X11	;PRETEND WE HAD A TRAILING ZERO
		SOJA	C,CPOPJ]
	TLO	D,400000	;PREVENT OVERFLOW
	ADDI	D,(A)		;CARRY IN FROM LOW HALF
	TLZN	D,400000	;WOULD THERE HAVE BEEN AN OVERFLOW?
	 JRST	@.-4		;YES
	MOVEM	A+1,Y		;STORE LOW HALF
	MOVEM	D,X		;AND HIGH HALF
CPOPJ:	POPJ	P,
;DFSC

;	FF	NUMNEG FLAG
;	C	# TRAILING ZEROES,, # DIGITS SINCE DECIMAL PT.
;	D	EXPONENT
;	X,Y	FRACTION

DFSC:
	MOVE	A,X		;BEGIN CONVERTING TO PURE FRACTION
	JFFO	A,DFSC1
	MOVE	A,X+1		;HIGH WD WAS ZERO
	JFFO	A,.+1
	ADDI	A+1,=35
DFSC1:	MOVEI	LPSA,-1(A+1)	;# OF PLACES TO SHIFT (REMEMBER SIGN BIT)
	ASHC	X,(LPSA)	;MAKE INTO PURE FRACTION
	SUBI	LPSA,=70
	MOVN	LPSA,LPSA	;EXPONENT OF 2 OF FRACTION
	
;***** SOMETHING FISHY HERE.  CONSIDER 12345.98@3
	SUBI	D,(C)		;DIGITS SINCE DECIMAL POINT DECREASE THE EXPONENT
	HLRZ	C,C
	ADDI	D,(C)		;BUT TRAILING ZEROES DONT COUNT
	JUMPE	D,DFSC2		;EXPONENT OF 10 IS ZERO
	JUMPG	D,DFSC3
	TLO	FF,EXPNEG	;EXPONENT WAS NEG
	MOVN	D,D
	SKIPA	TEMP,[EXP.M1,,FR.M1]	;USE THIS TABLE SINCE EXP WAS NEG
DFSC3:	MOVE	TEMP,[EXP.P1,,FR.P1]	;EXP WAS POS
	TRNE	D,777700	;CHECK EXPONENT RANGE
	 JRST	DFSERR
	TRNE	D,40		;E+-32 INVOLVED?
	TLNE	FF,EXPNEG	;YES. TOO BAD IF E-48
	 JRST	MULOOP		;OK
	TRNE	D,20		;E-48 ?
	 JRST	DFSERR
MULOOP:	TRZE	D,1		;SHOULD WE MULTIPLY?
	 PUSHJ	P,DMUL..	;YES
	JUMPE	D,DFSC2
	ASH	D,-1		;NEXT BIT INTO POSITION
	AOBJN	TEMP,.+1	;ADD 1 TO LH
	AOJA	TEMP,MULOOP	;AND 2 TO RH

DFSC2:
KI10<	DMOVE	A,X	>;KI10
NOKI10<	MOVE	A,X
	MOVE	A+1,X+1	>;NOKI10
	ASHC	A,-8		;MAKE ROOM FOR EXPONENT
	FSC	A,200(LPSA)	;INSERT IT
	JFOV	DFSERR
DFSC4:
	JUMPGE	Z,.+3		;IF RAN OUT OF CHARS
	 TLNE	FF,NUMSAW	; AND SAW NUMBER
	  MOVEI	Z,0		;  THEN FLAG IT THIS WAY
KI10<	TLNE	FF,NUMNEG
	 DMOVN	A,A
	POPJ	P,
>;KI10
NOKI10<	TLNN	FF,NUMNEG
	 POPJ	P,
	SETCA	A,		;ONES COMPLEMENT OF HIGH WORD
	MOVN	A+1,A+1		;TWOS COMPLEMENT OF LOW WORD
	TLZ	A+1,400000	;FORCE SIGN BIT OFF
	JUMPN	A+1,CPOPJ	;IF LOW SIGNIFICANCE, DONE
	AOJA	A,CPOPJ		;OTHERWISE TWOS COMPLEMENT OF HIGH WORD
>;NOKI10

DFSERR:	ERR	<NUMIN: Exponent range exceeded>,1
	SETOB	A,A+1
	TLNN	FF,EXPNEG
	 TLZA	A,400000	;EXPONENT WAS POS, GIVE AN INFINITY
	SETZB	A,A+1		;EXPONENT WAS NEG, GIVE ZERO
	JRST	DFSC4		;OF RIGHT SIGN
;DMUL..
;MULTIPLY TWO DOUBLE-LENGTH PURE FRACTIONS. ONE IS (TEMP), OTHER IS X,Y PAIR
;RETURN DOUBLE-LENGTH RESULT IN X,Y
;SCALE FACTOR KEPT IN LPSA

DMUL..:
NOKL10<	PUSH	P,X		;SAVE HIGH
	SETZM	X		;1ST WORD, FINAL PRODUCT
	MOVE	A,(TEMP)	;HIGH
	MULM	A,Y		;* LOW
				;IGNORING 3RD WORDS: 8 EXPONENT BITS TO BURN
	MOVE	A,1(TEMP)	;LOW
	MUL	A,(P)		;* HIGH
	TLO	A,400000	;PREVENT OVERFLOWS
	ADD	A,Y		;ADD 2ND WORDS
	TLZN	A,400000	;WOULD THERE HAVE BEEN AN OVERFLOW?
	 AOS	X		;YES, DO CARRY (SETS X TO 1)
	MOVEM	A,Y		;STORE LOW RESULT
	POP	P,A		;HIGH
	MUL	A,(TEMP)	;* HIGH
	TLO	A+1,400000	;PREVENT OVERFLOW
	ADD	A+1,Y		;COLLECT 2ND WORD
	TLZN	A+1,400000	;WOULD THERE HAVE BEEN AN OVERFLOW?
	 ADDI	A,1		;YES
	ADD	A,X		;COLLECT 1ST WORD (THIS CAN'T OVERFLOW)
>;NOKL10
KL10<
	DMOVE	A,X
	DMOVEM	A+2,X
	DMUL	A,(TEMP)
	DMOVE	A+2,X
>;KL10
	TLNE	A,(1B1)		;NORMALIZED FRACTION?
	 JRST	.+3		;YES
	ASHC	A,1		;NO, SHIFT OVER
	SUBI	LPSA,1		;AND ADJUST EXPONENT
	MOVS	TEMP,TEMP		;COLLECT EXPONENT CHANGES
	ADD	LPSA,(TEMP)
	MOVS	TEMP,TEMP
	MOVEM	A,X		;STORE RESULT SO FAR
	MOVEM	A+1,Y
	POPJ	P,

FR.P1:	240000,,0	;10↑1		PURE FRACTION PART
	0
	310000,,0	;10↑2
	0
	234200,,0	;10↑4
	0
	276570,,200000	;10↑8
	0
	216067,,446770	;10↑16
	040000,,0
	235613,,266501	;10↑32
	133413,,263574
EXP.P1:	4				;POWER OF 2 EXPONENT PART
	7
	16
	33
	66
	153

FR.M1:	314631,,463146	;10↑-1
	146314,,631463
	243656,,050753	;10↑-2
	205075,,314217
	321556,,135307	;10↑-4
	020626,,245364
	253630,,734214	;10↑-8
	043034,,737425
	346453,,122766	;10↑-16
	042336,,053314
	317542,,172552	;10↑-32
	051631,,227215
EXP.M1:	-3
	-6
	-15
	-32
	-65
	-152
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 <NOSTANFO<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.
;#ZL# Following MOVEM was missing, triggering bugtrap in STRNGC -- DON -- 12-Jul-78
	MOVEM   RF,RACS+RF(USER); STRNGC requires this be done
;#ZL#
	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
⊗