perm filename IOSER[S,AIL]12 blob sn#081247 filedate 1974-01-12 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00034 PAGES VERSION 17-1(27)
RECORD PAGE   DESCRIPTION
 00001 00001
 00007 00002	HISTORY
 00013 00003	Indices, Bits for IOSER 
 00016 00004	Simio, Ioinst, Lpryer, Cserr 
 00024 00005	Getchn 
 00027 00006	Filnam 
 00031 00007	Flscan 
 00033 00008	Open 
 00038 00009	
 00044 00010	Release 
 00049 00011	Lookup, Enter 
 00052 00012	Fileinfo 
 00054 00013	Out 
 00057 00014	Input 
 00066 00015	Realin, Realscan 
 00068 00016	Intin, Intscan 
 00070 00017	DSCR NUMIN
 00073 00018	NUMIN -- CONTD.
 00076 00019	SCAN (CALLED BY NUMIN AND STRIN)
 00080 00020	   Character table for SCAN (Realscan,Intscan,Realin,Intin)
 00082 00021	DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
 00084 00022	Arryout, Wordout 
 00089 00023	Arryin, Wordin 
 00097 00024	Linout 
 00100 00025	Breakset 
 00104 00026	Setbreak 
 00106 00027	Stdbrk 
 00108 00028	Close, Closin, Closo
 00110 00029	Mtape 
 00112 00030	 Useti, Useto, Rename 
 00114 00031	Usercon 
 00116 00032	Ttyuuo functions 
 00120 00033	
 00132 00034	Ptyuuo functions 
 00140 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  102100000033  ⊗;


COMMENT ⊗
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,<SIMIO,CSERR,LPRYER>,<GOGTAB>
	  ,<SIMIO, CSERR, LPRYER -- SUPPORT ROUTINES>)
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
	DPB	CHNL,[POINT 4,C,12]	;CHANNEL NUMBER
	XCT	C		;DO OPERATION
	 JRST	 USOUT		;ALL KOSHER, NO EOF OR ERR
USTST:	MOVE	C,[GETSTS C]	;WHA-
	DPB	CHNL,[POINT 4,C,12] ; T HAPPEN-
	XCT	C		;	  ED?
;;%##%	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
	ERR	<I-O DEVICE ERROR ON CHANNEL >,7 ;JUMPA TO PROVIDE CHANNEL AC
USSKIP:	AOS	-1(P)		;SKIP-RETURN
USOUT:	POP	P,C		;RESTORE C
	POPJ	P,		;DONE

ALTIO:	MOVE	C,IOINST(C)	;GET INSTR
	DPB	CHNL,[POINT 4,C,12]
	XCT	C		;DO IT
	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
	XWD	CDB,OBUF	;2
>;EXPO


DSCR INSTRUCTION TABLE
⊗
IOINST←.-1		;IOSTATUS ←← 0  GET STATUS
	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

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,

ENDCOM(SAV)
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
⊗

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

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

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

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

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

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

ENDCOM(FLS)
COMPIL(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
	MOVEI	LPSA,0		;NOW GET READY IN CASE OF ERROR
	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
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
	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
	ANDI	D,7777		;MAX BUFFER SIZE
	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
	MOVEI	TEMP,BRKDUM-1(USER)
	MOVEM	TEMP,JOBFF
	PUSHJ	P,GETIOB	;DUMMY IN/OUBUF
	LDB	D,[POINT 17,BRKDUM(USER),17] ;GET THE SIZE
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
	POP	P,X			;INSTRUCTION TO DO
	MOVE	Y,[JRST ELERR]		;FAILURE
	MOVE	Z,[JRST RESTR]		;SUCCESS
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:	HRRZ	TEMP,FNAME+1(USER)	;WHY DID IT BLOW?
	HRROM	TEMP,@-1(P)		;TELL THE USER
	JRST	RESTR
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
	MOVE	B,OBP(CDB)
	MOVE	A,OCOWNT(CDB)
	JRST	.OUT1


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

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

; SPECIAL DUMP-MODE OUTPUT STUFF

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

ENDCOM(OUT)
COMPIL(INP,<INPUT>
	  ,<SAVE,.SKIP.,INSET,RESTR,SIMIO,GETCHN,STRNGC,BRKMSK,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	CHNL,-2(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
	SKIPL	C,-1(P)		;GET TABLE #, CHECK IN BOUNDS
	CAILE	C,=18
	ERR	<IN: THERE ARE ONLY 18 BREAK TABLES>
	HRRZ	TEMP,USER
	ADD	TEMP,C		;TABLE NO(USER)
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
	MOVN	B,A		;NEGATE MAX CHAR COUNT
	PUSH	SP,[0]		;LEAVE ROOM FOR FIRST STR WORD
	PUSH	SP,TOPBYTE(USER)	;SECOND STRING WORD
	MOVE	FF,BRKMSK(C)	;GET MASK FOR THIS TABLE
	HRRZ	Y,USER
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
	JUMPE	B,DONE1		; BECAUSE THE AOJL WON'T
CMU <
	MOVS	C,DMODE(CDB)	;FUNNY MODE BITS TO RH
>;CMU
	TRNE	FF,@BRKCVT(USER) ;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:
NOCMU <
	JUMPE	D,.IN		;ALWAYS IGNORE 0'S
>;NOCMU
CMU <
	JUMPE	D,[ TRNN  C,1	;REALLY IGNORE NULL??
		    JRST  .IN	;YES
		    JRST  .+1	;NOPE
		   ]
>;CMU
;;%##%	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	Y,-1(P)	;TABLE # AGAIN
	ADD	Y,USER		;RELOCATE
	SKIPN	Y,DSPTBL(Y)	;WHAT TO DO WITH BREAK CHAR?
	JRST	DONE1		;SKIP IT
	JUMPL	Y,APPEND	;ADD TO END OF INPUT STRING

RETAIN:	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:
	MOVE	TEMP,-1(P)	;GET LINE NUMBER DISPOSITION FLAG,
	ADD	TEMP,USER	;RLC+TABLE
	SKIPGE	TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
	 JRST	 GIVLIN	; WANTS IT NEXT TIME OR SOMETHING

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

EATLIN:
	AOS	IBP(CDB)	;FORGET IT ENTIRELY
	MOVNI	A,5		;INDICATE SKIPPING SIX
	ADDB	A,ICOWNT(CDB)	;IN COUNT
				;OVERFLOW BUFFER?
	JUMPG	A,(TEMP)	;NO, CONTINUE
	CAIL	E,15
	 ERR	 <CAN'T HANDLE THIS FILE IN DUMP MODE>
	XCT	IOIN,SIMIO	;YES, GET TAB FROM NEXT BUFFER
	 JRST	OKLN		;GOT IT, CONTINUE
	 JRST	DONE1

OKLN:	SOSG	ICOWNT(CDB)	;IF ONLY ONE CHAR,
	JRST	[MOVEI TEMP,20000	;THEN EOF COMES NEXT
		 IORM  TEMP,@ENDFL(CDB)
		 JRST  DONE1]	;ALL DONE
	IBP	IBP(CDB)	;GET OVER TAB FINALLY
;;#PM  12-1-73 RLS  DONT LOSE A CHARACTER IN THE (NEW) BUFFER 
	AOS	ICOWNT(CDB)	;INCREMENT COUNT
;;#PM
	JRST	(TEMP)		;AND CONTINUE


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

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

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

HERE (REALIN)
IFN ALWAYS,<BEGIN NUMIN>

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

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

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

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

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

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

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

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

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

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

; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
NCH:	SOSG ICOWNT(CDB);	DECREMENT CHARACTER COUNT
	JRST NCH2
NCH1:	ILDB D,IBP(CDB);	LOAD BYTE
	TDNE Z,@IBP(CDB);	CHECK FOR LINE NUMBER
	JRST NCH5
	JRST (X);		RETURN

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

NCH5:	AOS IBP(CDB);		WE HAVE A LINE NUMBER
	MOVNI D,5;		MOVE OVER IT
	ADDB D,ICOWNT(CDB)
	SKIPLE D;		NOTHING LEFT
	JRST NCH;		DO ANOTHER INPUT
	XCT IOIN,SIMIO

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

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

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

;SCAN (CALLED BY NUMIN AND STRIN)

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

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

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

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

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

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

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

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

	XCT LPSA
;;#QD# SEE DONE5: BELOW
EEXP:	AHEAD(EXP9,ERR2,DONE5,DONE5,ERR1,EN,EN)
EN:	TRNE TEMP,4;		SIGN OF EXPONENT
	MOVNS FF
	ADD C,FF;		FIX UP EXPONENT
	JOV ERR3

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

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

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

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

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

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

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

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

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

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

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

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

RZ:	SETZ A,
	JRST DONE
;   Character table for SCAN (Realscan,Intscan,Realin,Intin)
TAB:	FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
;#QC# MAKE 32 (CONTROL Z) IGNORED
	FOR A IN (5,5,0,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
>
	FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
>
	FOR A IN (5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (4,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	XWD -1,6

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

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

ENDCOM(TBB)
IFN ALWAYS,<
	BEND
>;IFN ALWAYS
COMPIL(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
	CAIGE	TEMP,10		;MAKE SURE AT LEAST BINARY MODE
CMU <
	CAIN	TEMP,4		;CMU HAS A WIERD MODE
	SKIPA
>;CMU
	 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
	IBP	OBP(CDB)	;MAKE SURE PTRS TO FIRST WORD
	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
	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
	CAIGE	TEMP,10
CMU <
	CAIN	TEMP,4		;CMU HAS A WIERD MODE
	SKIPA
>;CMU
	 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
	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
	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
⊗

HEREFK (INOUT,.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
	CAIL	TEMP,10		;MUST BE BINARY MODE
	CAILE	TEMP,14		;AND NOT DUMP MODE
	ERR	<INOUT (OUTPUT SIDE): ILLEGAL DATA MODE>
	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)	;CEAR ERROR INDICATOR
	LDB	TEMP,[POINT 4,DMODE(CDB),35]
	CAIL	TEMP,10
	CAILE	TEMP,14
	ERR	<INOUT (INPUT SIDE): ILLEGAL DATA MODE>
	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
	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
	CAML	E,OCOWNT(CDB)	;=MIN(B,ICOWNT,OCOWNT)
	MOVE	E,OCOWNT(CDB)
	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
	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
	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)
COMPIL(BRK,<BREAKSET,SETBREAK,STDBRK>
	  ,<SAVE,RESTR,BRKMSK,SIMIO,GOGTAB,X22,X33>
	  ,<BREAKSET, SETBREAK, STDBRK ROUTINES>)
COMMENT ⊗Breakset ⊗

DSCR BREAKSET(TABLE #,"STRING",WAY);
CAL SAIL
⊗

HERE (BREAKSET)
	PUSHJ	P,SAVE		;SAVE ACS AND THINGS
	MOVE	LPSA,X33
	SUB	SP,X22
	SKIPLE	A,-2(P)		;TABLE #
	CAILE	A,=18
	ERR	<THERE ARE ONLY 18 BREAK TABLES>
	HLLZ	B,BRKMSK(A)	;BREAK MASK FOR THIS TABLE
	ADD	A,USER
	MOVE	C,[ANDCAM B,(D)]  ;USUAL CLEARING INSTR
	LDB	X,[POINT 4,-1(P),35] ;COMMAND
	TRZN	X,10		  ;LEFT OR RIGHT HALF OF TABLE?
	SKIPA	X,BKCOM(X)	  ;RIGHT HALF
	HLRZ	X,BKCOM(X)	  ;LEFT HALF
	JRST	(X)		  ;DISPATCH

BKCOM:	XWD	XCLUDE,PASLINS	;X,,P
	XWD	INCL,PENDCH	;I,,A
	XWD	ILLSET,RETCH	;-,,R
;;%##% ADD BREAK MODE FOR COERCIONS
	XWD	UCASE,SKIPCH	;K,,S
	XWD	BRKLIN,RESTR	;L,,D
	XWD	ILLSET,ERMAN	;-,,E
	XWD	NOLINS,ILLSET	;N,,-
	XWD	OMIT,ILLSET	;O,,-

ILLSET:	ERR	<ILLEGAL COMMAND TO BREAKSET>,1
	JRST	RESTR

XCLUDE:	SKIPA	C,[IORM B,(D)]	;YES, SET ALL TO 1 TO INITIALIZE
OMIT:	MOVSS	B		;OMIT, PUT BIT IN RH
INCL:	MOVSI	D,-200
	HRRI	D,BRKTBL(USER)	;RELOCATABLE IOWD
BRKLUP:	XCT	C		;CLEAR (OR SET) PROPER (HALF OF PROPER) TABLE
	AOBJN	D,BRKLUP
	MOVE	C,[IORM B,BRKTBL(D)]	;USUAL SETTING INSTR
	CAIN	X,XCLUDE	;BY EXCEPTION?
	MOVE	C,[ANDCAM B,BRKTBL(D)] ;YES, WANT TO TURN OFF BITS
	ADDI	C,(USER)	;RELOCATE IT
	HRRZ	A,1(SP)		;LENGTH OF STRING
	MOVE	X,2(SP)		;BYTE POINTER
	JRST	BRKL2
BRKL1:	ILDB	D,X		;GET A CHAR
	XCT	C		;DO RIGHT THING TO RIGHT BIT
BRKL2:	SOJGE	A,BRKL1
	JRST	RESTR

PASLINS: TDZA	B,B		;PASS LINE NOS. SINE COMMENT
NOLINS:	MOVEI	B,-1		;INFORM IN THAT IT SHOULD 
	MOVEM	B,LINTBL(A)	;  DELETE LINE NOS.
	JRST	RESTR

BRKLIN:	SKIPA	B,[-1]		;MARK BREAK ON LINE NOS. FOR THIS TBL
ERMAN:	MOVSI	B,-1		;LH NEG SIGNALS ERMAN'S SCHEME
	MOVEM	B,LINTBL(A)
	JRST	RESTR

PENDCH:	SETOM	DSPTBL(A)	;APPEND TO END OF INPUT
	JRST	RESTR

SKIPCH:	TDZA	B,B		;CHAR NEVER APPEARS IN INPUT STRING
RETCH:	MOVEI	B,-1		;RETAIN FOR NEXT TIME
	MOVEM	B,DSPTBL(A)
	JRST	RESTR

;;%##%
UCASE:	MOVSS	B	;INTO RIGHT HLF
	IORM	B,BRKCVT(USER)
	JRST	RESTR
COMMENT ⊗Setbreak 

  TBL IS AS IN BREAKSET
  BRKSTRNG IS USED FOR ANY "I" OR "X" APPEARING IN MODESTRNG
  OMITSTRNG (IF NOT NULL) IS USED TO SET THE "OMIT" SIDE OF THE TABLE
  MODESTRNG CAN CONTAIN ANY OF THE VALID BREAKSET "MODE" CHARACTERS
     I,X,O,N,R,A,P, or S.
This function is not attainable by the user unless he declares it.
⊗

DSCR SETBREAK(TABLE,"BREAKSTRING","OMITSTRING",MODESTRING");
CAL SAIL
⊗

HERE (SETBREAK)
	HRRZ	TEMP,-3(SP)		;DO OMIT STRING, IF PRESENT
	JUMPE	TEMP,NO.O		;NULL STRING DOESN'T COUNT
	PUSH	P,-1(P)			;TABLE #
	PUSH	SP,-3(SP)		;OMIT CHARACTERS
	PUSH	SP,-3(SP)
	PUSH	P,["O"]			;OMIT!
	PUSHJ	P,BREAKSET		;DO THAT
NO.O:	HRRZS	-1(SP)			;COUNT OF # OF COMMANDS
BKSLUP:	SOSGE	-1(SP)		;DONE?
	 JRST	 BKSDUN			; YES
	PUSH	P,-1(P)			;TABLE #
	ILDB	TEMP,(SP)		;COMMAND
	PUSH	P,TEMP
	PUSH	SP,-5(SP)
	PUSH	SP,-5(SP)		;STRING TO USE IF NECESSARY
	PUSHJ	P,BREAKSET
	JRST	BKSLUP			;DO IT -- AGAIN

BKSDUN:	SUB	P,X22
	SUB	SP,[XWD 6,6]
	JRST	@2(P)

COMMENT ⊗Stdbrk ⊗

DSCR STDBRK(CHANNEL);
CAL SAIL
⊗

HERE (STDBRK)
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	MOVE	CHNL,-1(P)
	MOVEI	CDB,D-DMODE		;SO WE CAN USE SIMIO'S OPEN
	MOVEI	D,17			;DUMP MODE
	MOVE	D+1,['SYS   ']
	MOVEI	D+2,0			;NO HEADERS
	XCT	IOOPEN,SIMIO		;DO THE OPEN
	 ERR	 <DSK NOT AVAILABLE?>
	MOVEI	USER,D-FNAME		;SO WE CAN USE SIMIO'S LOOKUP
	MOVE	D,['BKTBL ']
	MOVE	D+1,['BKT   ']		;FUNNY NAME AND EXTENSION
	SETZB	D+2,D+3
	XCT	IOLOOKUP,SIMIO		;DO THE LOOKUP
	ERR	<Standard break table not available>
	MOVE	USER,GOGTAB
	MOVEI 	D,DSPTBL-1(USER)
	HRLI	D,-(=19+=19+=128)	;IOWD SIZE,LOC
	MOVEI	D+1,0			;TERMINATE COMMAND LIST
	XCT	IODIN,SIMIO		;DO THE INPUT
	SKIPA				;ALL WENT WELL
	ERR	<Error reading standard break table>
;; XCT IORELEASE NOW TAKES INHIBIT BITS IN RH OF D
	MOVEI	D,0			;NO INHIBIT BITS TO RELEASE
	XCT	IORELEASE,SIMIO		;RELEASE FILE
	JRST	RESTR

HERE(BRKSP1)				; SPARES *******
HERE(BRKSP2);
	ERR	<DRYROT IN BRK SPARES>
ENDCOM(BRK)
COMPIL(CLS,<CLOSIN,CLOSO,CLOSE>,<SAVE,RESTR,SIMIO,X22>,<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
	MOVEI	D,0
CLSS:	MOVE	CHNL,-1(P)
	MOVE	LPSA,X22
	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>
	  ,<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);
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)
	ROT	TEMP,-=9
	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

ENDCOM(MTP)
COMPIL(USC,<USERCON>,<SAVE,RESTR,GOGTAB>,<USERCON ROUTINE>)
COMMENT ⊗Usercon ⊗

DSCR USERCON(@INDEX,@SETGET,FLAG);
CAL SAIL
PAR INDEX is USER-table displacement (usually obtained from HEAD.REL)
 SETGET is used to communicate USER table values
 FLAG is "OPCODE" input to USERCON
RES The INDEXth USER table entry is accessed (GLUSER table if FLAG negative).
 On exit, SETGET contains old value of this entry.
 If FLAG is odd, the original SETGET value replaces this entry.
⊗

CMU <
GGAS <
IFE ALWAYS, <EXTERNAL GLUSER>
>;GGAS
>;CMU

HERE(USERCON)
	PUSHJ	P,SAVE
	MOVE	LPSA,[XWD 4,4]
	MOVE	A,-1(P)		;THE FLAG
CMU < GGGON
>;CMU
GLOB <
	MOVEI	B,ENDREN
	JUMPL	A,[MOVEI USER,GLUSER
		   MOVEI B,ZAPEND ;USE GLOBAL TABLE
		   JRST .+1]
	SKIPL	C,-3(P)		;THE INDEX
	CAML	C,B
>;GLOB
NOGLOB <
	SKIPL	C,-3(P)		;THE INDEX
	CAIL	C,ENDREN	;CHECK BOUNDS
>;NOGLOB
	ERR	<USERCON: index out of bounds >,7,RESTR
	ADD	C,USER		;POINT AT CORRECT ENTRY
	MOVE	B,(C)		;GET OLD VALUE
	MOVE	D,@-2(P)	;(PERHAPS) NEW VALUE
	TRNE	A,1		;STORE NEW VALUE?
	MOVEM	D,(C)		;YES
	MOVEM	B,@-2(P)	;RETURN OLD VALUE
GLOB <
	MOVE	USER,GOGTAB	;RESET
>;GLOB
	JRST	RESTR
CMU < GGGOFF
>;CMU
ENDCOM(USC)
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,<INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,TTYUP
ENTINT	<INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL>>
  ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.,.SONTP>
	  ,<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
>

HERE (INCHRW)	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:	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)
	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) PUSHJ	P,SAVE
	PUSHJ	P,REDSTR
	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)	PUSHJ	P,SAVE
	PUSHJ	P,REDSTR
	MOVE	LPSA,X11
	TTCALL	4,TEMP
;;#GF# DCS 2-1-72 (2-3) DO LOOP HERE, DON'T USE INS1 LIKE BEFORE
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
;;%##%
	KONVERT(TEMP)
	IDPB	TEMP,TOPBYTE(USER) ;PUT IT AWAY
	TTCALL	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)	PUSHJ	P,SAVE
	MOVE	LPSA,X22	;PARAM (FLAG) AND RETURN
	PUSHJ	P,REDSTR
	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)	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	PUSHJ	P,REDSTR
	TTCALL	4,TEMP
	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) PUSHJ	P,SAVE
	PUSHJ	P,REDSTR	;PREPARE TO MAKE A STRING
	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)
	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
	MOVE	LPSA,X33	;PREPARE TO RETURN
TYIN1:	SETZM	@-1(P)		;ASSUME NO BREAK CHAR
	SKIPL	C,-2(P)		;TABLE #
	CAILE	C,=18
	ERR	<TTYIN: there are only 18 break tables>
	HRRZ	TEMP,USER
	ADD	TEMP,C		;TABLE NO(USER)
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
	MOVE	FF,BRKMSK(C)	;GET MASK FOR THIS TABLE
;;%##% BREAK TABLE CONVERSION
	TRNE	FF,@BRKCVT(USER) ;SPECIFY UC COERCION
	TLOA	C,400000	;YES
	TLZ	C,400000	;NO
;;%##%
	HRRZ	Y,USER
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
	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)
	MOVE	Y,-2(P)		;WHAT TO DO WITH IT
	ADD	Y,USER
	SKIPN	Y,DSPTBL(Y)
	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
	PUSH	P,[TTWCHR]	;GET SOME MORE
	PUSHJ	P,.SONTP	;BE SURE ROOM & ALIGNED
	MOVNI	A,TTWCHR	;REFRESH THE COUNT
	POPJ	P,



HEREFK(TTYUP,.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


ENDCOM(TTY)
EXPO <
COMPIL(PTY)
ENDCOM(PTY)
>;EXPO
NOEXPO <
COMPIL(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,.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
	SKIPL	T,-2(P)		;TABLE # (INTO AC 11)
	CAILE	T,=18
	ERR	<PTYIN: there are only 18 break tables>
	HRRZ	TEMP,USER
	ADD	TEMP,T		;TABLE NO(USER)
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
	MOVE	FF,BRKMSK(T)	;GET MASK FOR THIS TABLE
	HRRZ	Y,USER
;;#PO# !
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
	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)
	MOVE	Y,-2(P)		;WHAT TO DO WITH IT
	ADD	Y,USER
	SKIPN	Y,DSPTBL(Y)
	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

ENDCOM(PTY)
>;NOEXPO

IFN ALWAYS,<
BEND IOSER>
DSCR BEND IOSER
⊗