perm filename IOSER[S,AIL]15 blob sn#090713 filedate 1974-03-12 generic text, type T, neo UTF8
00100	COMMENT ⊗   VALID 00034 PAGES VERSION 17-1(30)
00200	RECORD PAGE   DESCRIPTION
00300	 00001 00001
00400	 00007 00002	HISTORY
00500	 00013 00003	Indices, Bits for IOSER 
00600	 00016 00004	Simio, Ioinst, Lpryer, Cserr 
00700	 00024 00005	Getchn 
00800	 00027 00006	Filnam 
00900	 00031 00007	Flscan 
01000	 00033 00008	Open 
01100	 00038 00009	
01200	 00044 00010	Release 
01300	 00049 00011	Lookup, Enter 
01400	 00052 00012	Fileinfo 
01500	 00054 00013	Out 
01600	 00057 00014	Input 
01700	 00066 00015	Realin, Realscan 
01800	 00068 00016	Intin, Intscan 
01900	 00070 00017	DSCR NUMIN
02000	 00073 00018	NUMIN -- CONTD.
02100	 00076 00019	SCAN (CALLED BY NUMIN AND STRIN)
02200	 00080 00020	   Character table for SCAN (Realscan,Intscan,Realin,Intin)
02300	 00082 00021	DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
02400	 00084 00022	Arryout, Wordout 
02500	 00089 00023	Arryin, Wordin 
02600	 00097 00024	Linout 
02700	 00100 00025	Breakset 
02800	 00104 00026	Setbreak 
02900	 00106 00027	Stdbrk 
03000	 00108 00028	Close, Closin, Closo
03100	 00110 00029	Mtape 
03200	 00112 00030	 Useti, Useto, Rename 
03300	 00114 00031	Usercon 
03400	 00116 00032	Ttyuuo functions 
03500	 00120 00033	
03600	 00132 00034	Ptyuuo functions 
03700	 00140 ENDMK
03800	⊗;
     

00100	COMMENT ⊗HISTORY
00200	AUTHOR,REASON
00300	021  102100000036  ⊗;
00400	
00500	
00600	COMMENT ⊗
00650	VERSION 17-1(30) 2-22-74 BY RHT FEAT %BG% ADD BREAKSET MODE "F"
00700	VERSION 17-1(29) 2-1-74 BY RHT BUG #QY# USBSTS NEEDED PATCHING
00800	VERSION 17-1(28) 2-1-74 
00900	VERSION 17-1(27) 1-12-74 BY RHT MAKE COUNT RIGHT IN INOUT
01000	VERSION 17-1(26) 1-12-74 
01100	VERSION 17-1(25) 1-12-74 BY RHT FIX COMPIL FOR SAITTY
01200	VERSION 17-1(24) 1-11-74 BY RHT TTYINL STUFF
01300	VERSION 17-1(23) 1-11-74 BY RHT MERGE IN CMU CHANGES
01400	VERSION 17-1(22) 1-11-74 
01500	VERSION 17-1(21) 1-11-74 
01600	VERSION 17-1(20) 1-11-74 
01700	VERSION 17-1(19) 1-11-74 
01800	VERSION 17-1(18) 12-15-73 BY RFS FIX BUGS QC,QD.
01900	VERSION 17-1(17) 12-10-73 BY JRL REMOVE LAST REFERENCES TO PGNNO
02000	VERSION 17-1(16) 12-10-73 
02100	VERSION 17-1(15) 12-10-73 
02200	VERSION 17-1(14) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
02300	VERSION 17-1(13) 12-8-73 BY RFS MAKE ALTMODE 33 FOR EXPORT SYSTEMS
02400	VERSION 17-1(12) 12-5-73 BY RHT BUG #PO#
02500	VERSION 17-1(11) 12-5-73 
02600	VERSION 17-1(10) 12-5-73 
02700	VERSION 17-1(9) 12-3-73 BY RFS REMOVE ALL III DISPLAY STUFF
02800	VERSION 17-1(8) 12-2-73 BY RHT FIX INPUT
02900	VERSION 17-1(7) 12-2-73 BY RLS EDIT
03000	VERSION 17-1(6) 12-2-73 BY RHT ALSO SOME WRD SPARES
03100	VERSION 17-1(5) 12-2-73 BY RHT FEAT %AV% CHNCDB.  ALSO SPARES ADDED TO OPN & BRK
03200	VERSION 17-1(4) 12-2-73 
03300	VERSION 17-1(3) 12-1-73 BY RLS BUG #PM#  DONT LOSE A CHAR IN INPUT
03400	VERSION 17-1(2) 12-1-73 BY RLS ADD SETPL FUNCTION
03500	VERSION 17-1(1) 7-27-73 BY JRL CHANGE OPEN TO FACT THAT RELEASE NOW TAKES TWO ARGUMENTS
03600	VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 ****
03700	VERSION 16-2(45) 5-7-73 BY JRL CHANGE PTYALL TO HANDLE LARGER BUFFERS
03800	VERSION 16-2(44) 3-21-73 BY JRL ADD COMPIL(SAIDM3)
03900	VERSION 16-2(43) 2-25-73 BY RHT BUG #LP# GO TO OUT OF PROCESS SHOULDNT LOOP!
04000	VERSION 16-2(42) 2-14-73 BY RHT BUG #LM# TYPO IN PITBND
04100	VERSION 16-2(41) 1-9-73 BY RHT REPAIR COMPIL FOR SAIPIT
04200	VERSION 16-2(40) 12-2-72 BY RHT MODIFY PIT STUFF FOR NEW INFOTAB &DATAB
04300	VERSION 16-2(39) 12-1-72 BY JRL CHANGE LEAP INDEX USED TO CALL FRELS WITHIN BEXIT
04400	VERSION 16-2(38) 11-28-72 BY RHT ADD CLEANUPS TO BEXIT CODE
04500	VERSION 16-2(37) 9-24-72 BY JRL LIBRARY REQUESTS
04600	VERSION 16-2(36) 9-21-72 BY JRL ADD DADDY CURSCB ETC TO DUM
04700	VERSION 16-2(35) 8-31-72 BY JRL RELEASE VALUE SETS CORRECTLY IN STKUWD
04800	VERSION 16-2(34) 8-27-72 BY RHT CHANGE SPOT IN WHICH STKUWD SAVES RETN
04900	VERSION 16-2(33) 8-23-72 BY JRL ADD FORGET CONTEXT CODE TO BEXIT
05000	VERSION 16-2(32) 8-14-72 BY RHT EVAL NOW NAMED APPLY
05100	VERSION 16-2(31) 7-22-72 BY RHT ADD KILL LIST TO BEXIT
05200	VERSION 16-2(30) 7-12-72 BY DCS BUG #IN# PTYALL INVALID REMCHR PROBLEM
05300	VERSION 16-2(29) 7-3-72 BY DCS MANY THINGS
05400	VERSION 16-2(28) 6-7-72 BY DCS BUG #HO# RETURN BOTH ADDRESSES FROM ..ARCOP FOR .MES2
05500	VERSION 16-2(27) 5-24-72 BY RHT CHANGE STKUWD TO LOOK AT PPDA
05600	VERSION 16-2(26) 5-15-72 BY JRL ARRPDP BUG AGAIN
05700	VERSION 16-2(24) 5-11-72 BY DCS BUG #HC# BETTER EXPO OUTSTR
05800	VERSION 16-2(23) 5-11-72 BY DCS BUG #HA# IMPRV. ERR. ENB, FIX MUDDY FEET IN EXPO
05900	VERSION 16-2(22) 5-11-72 BY DCS BUG #GT# ALLOW LARGE OCTAL PPNS
06000	VERSION 15-6(17-21) 5-4-72 
06100	VERSION 15-6(17) 3-7-72 BY DCS FIX OUTSTR(NULL) GARBAGING
06200	VERSION 15-6(7-16) 2-20-72 
06300	VERSION 15-6(6) 2-18-72 BY RHT CREATE THE NEW WORLD
06400	VERSION 15-2(5) 2-6-72 BY DCS BUG #FQ# (WD-ARRY)(IN-OUT) WORD COUNT KEPT RIGHT, IOERR OK, DUMP MODE OK
06500	VERSION 15-2(4) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR
06600	VERSION 15-2(3) 2-1-72 BY DCS BUG #GF# INCHWL BREAKS ON MORE THINGS, TELLS WHAT THEY ARE
06700	VERSION 15-2(2) 1-25-72 BY DCS BUG #GD# Fix non-standard buffer size setup in OPEN
06800	VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
06900	
07000	⊗;
     

00100	COMMENT ⊗Indices, Bits for IOSER ⊗
00200		LSTON	(IOSER)
00300	
00400	IFN ALWAYS,<BEGIN IOSER>
00500	DSCR IOSER -- IOSER GENERAL DISCUSSION
00600	 ;SEE GOGOL FOR MORE DETAILS
00700	 ; FORMAT OF CDBs
00800	 DMODE	←← 0	;DATA MODE
00900	 DNAME	←← 1	;DEVICE
01000	 BFHED	←← 2	;HEADER POINTERS
01100	 OBPNT	←← 3	;OUTPUT BUFFER POINTER
01200	 OBP	←← 4	;OUTPUT BYTE POINTER
01300	 OCOWNT	←← 5	;OUTPUT BYTE COUNT
01400	 ONAME	←← 6	;OUTPUT FILE NAME -- FOR INFORMATION ONLY
01500	 OBUF	←← 7	;OUTPUT BUFFER LOCATION
01600	 IBPNT	←←10	;SAME STUFF FOR INPUT
01700	 IBP	←←11
01800	 ICOWNT	←←12
01900	 INAME	←←13
02000	 IBUF	←←14
02100	 ICOUNT	←←15	;INPUT DATA COUNT LIMIT ADDRESS
02200	 BRCHAR	←←16	;XWD TTYDEV FLAG, INPUT BREAK CHAR ADDR
02300	 TTYDEV  ←←16	;LH -1 IF DEVICE IS A TTY -- USED BY OUT
02400	 ENDFL	←←17	;INPUT END OF FILE FLAG ADDR
02500	 ERRTST	←←20	;USER ERROR BITS SPECIFICATION WORD
02600	 LINNUM  ←←21		;ADDR OF LINE NUMBER WORD (SETPL FUNCTION)
02700	 PAGNUM  ←←22		;ADDR OF PAGE NUMBER WORD (SETPL FUNCTION)
02800	 SOSNUM  ←←23		;ADDR OF SOS NUMBER WORD  (SETPL FUNCTION)
02900	
03000	 ; SIMIO INDICES
03100	
03200	 ?IOSTATUS	←←0
03300	 ?IOIN		←←1	;SEE EXPLANATIONS IN SIMIO ROUTINE
03400	 ?IODIN		←←2
03500	 ?IOOUT		←←3
03600	 ?IODOUT	←←4
03700	 ?IOCLOSE	←←5
03800	 ?IORELEASE	←←6
03900	 ?IOINBUF	←←7
04000	 ?IOOUTBUF	←←10
04100	 ?IOSETI		←←11
04200	 ?IOSETO		←←12
04300	;;%##% A NEW GOODIE
04400	?SETIOSTS	←←13
04500	 ?IOOPEN		←←14
04600	 ?IOLOOKUP	←←15
04700	 ?IOENTER	←←16
04800	 ?IORENAME	←←17
04900	⊗
05000	COMPIL(SIM,<SIMIO,CSERR,LPRYER>,<GOGTAB>
05100		  ,<SIMIO, CSERR, LPRYER -- SUPPORT ROUTINES>)
     

00100	COMMENT ⊗Simio, Ioinst, Lpryer, Cserr ⊗
00200	
00300	DSCR SIMIO
00400	CAL XCT INDEX,SIMIO
00500	PAR AC field is index into instruction table (see below)
00600	 CHNL contains I/O channel number
00700	 other params can be gleaned from instruction table
00800	RES an I/O instruction is executed. Routine skips if I/O instr did.
00900	 If the INDEX is LEQ 12, and if the instruction skips (error or EOF),
01000	 status is presented in LH of user's EOF vbl (@ENDFL(CDB)), so he
01100	 can test it, or an error message is provided (depending on user-
01200	 enabling). This simplifies many I/O routines.
01300	SID NONE
01400	DES This routine makes I/O instructions re-entrant. The problem is
01500	 that the channel cannot be referenced indirectly.
01600	⊗
01700	
01800	↑↑SIMIO:	PUSHJ	P,.+1		;SAVE PC OF XCT
01900		PUSH	P,C		;SAVE C
02000		MOVE	C,-1(P)		;ASSUME SKIP RETURN
02100		LDB	C,[POINT 4,-1(C),12] ;INDEX OF XCT
02200		JUMPE	C,USTST		;WANT STATUS BITS ONLY
02300		CAIL	C,13		;NOW SPLIT HIGH AND LOW INDICES
02400		 JRST	 ALTIO		;SKIP RETURN CHECK ONLY
02500	;;%##% CHECK TO NOT SCREW STANDARD DEC LOSERS
02600	EXPO <
02700		CAIN	C,IOIN	;
02800		JRST	ISIOU	;
02900		CAIE	C,IOOUT	;IN OR OUT ?
03000		JRST	NOTIOU	;NOPE
03100	ISIOU:	SKIPG	@USBTST(C)	;CHECK FOR NO BUFFERS (& MORE AT CMU)
03200		JRST	USFUNY		;NO BUFFERS, ETC.
03300	>;EXPO
03400	NOTIOU:MOVE	C,IOINST(C)	;GET INSTRUCTION
03500		DPB	CHNL,[POINT 4,C,12]	;CHANNEL NUMBER
03600		XCT	C		;DO OPERATION
03700		 JRST	 USOUT		;ALL KOSHER, NO EOF OR ERR
03800	USTST:	MOVE	C,[GETSTS C]	;WHA-
03900		DPB	CHNL,[POINT 4,C,12] ; T HAPPEN-
04000		XCT	C		;	  ED?
04100	;;%##%	SAVE STATUS BITS
04200		MOVEM	C,FSTATS(USER)
04300	CMU <
04400	USERF:
04500	>;CMU
04600		TRZ	C,10000		;IOACT BIT, USER LOOKUP CHECK BIT
04700		HRLZM	C,@ENDFL(CDB)	;GIVE USER THE BITS
04800		TDNN	C,ERRTST(CDB)	;ANY HE CAN'T HANDLE?
04900		JUMPA	CHNL,USSKIP	;NOPE, JUST SKIP-RETURN
05000		ERR	<I-O DEVICE ERROR ON CHANNEL >,7 ;JUMPA TO PROVIDE CHANNEL AC
05100	USSKIP:	AOS	-1(P)		;SKIP-RETURN
05200	USOUT:	POP	P,C		;RESTORE C
05300		POPJ	P,		;DONE
05400	
05500	ALTIO:	MOVE	C,IOINST(C)	;GET INSTR
05600		DPB	CHNL,[POINT 4,C,12]
05700		XCT	C		;DO IT
05800		JRST	USOUT		;NO SKIP
05900		JRST	USSKIP		;SKIP
06000	EXPO <
06100	USFUNY:	
06200	CMU <	SKIPE	@USBTST(C)	;FUNNY DEVICE?
06300		JRST	REALTM		; YES.
06400	>;CMU
06500		JUMP	CHNL,		;FOR THE ERR MSG
06600		ERR	<NO BUFFERS ASSIGNED FOR I-O CHAN >,7
06700		JRST	USSKIP
06800	CMU,<	COMMENT ⊗	THIS NONSENSE IS A SPECIAL MODE FOR
06900		THE CMU SPEECH DEVICES.  ESSENTIALLY, IT DOES EVERTHING
07000		AS NORMAL, EXCEPT THAT IT PICKS UP THE TIMING ERR AND
07100		RUN-OUT-OF BUFFERS BIT OF THE
07200		I/O  STATUS FROM THE STATUS WORD IN THE BUFFER HEADER,
07300		INSTEAD OF USING THE BIT FROM THE GETSTS.	⊗
07400	TIMERR←←100000		;TIMING ERR BIT FOR SPEECH DEVICES
07500	ROBERR←←200000		;RUN-OUT-OF-BUFFER ERR
07600	
07700	REALTM:	PUSH	P,D		;NEED ANOTHER AC
07800		CAIE	C,IOIN		;INPUTTING?
07900		JRST	REALOT		; NO
08000		MOVSI	C,(<IN>)
08100		DPB	CHNL,[POINT 4,C,12]	;CHAN #
08200		XCT	C			;DO THE INPUT
08300		JRST	REALOK			;NO ERR, SO FAR
08400		MOVE	C,[GETSTS C]	
08500		DPB	CHNL,[POINT 4,C,12]	;LOOKS FAMILIAR
08600		XCT	C
08700		TRZA	C,TIMERR!ROBERR		;TURN OFF THE ONES FROM THE GETSTS
08800	REALOK:	MOVEI	C,0
08900		HRRZ	D,IBPNT(CDB)		;ADDRESS OF THE NEW BUFFER
09000		IOR	C,-1(D)			;THE BITS FROM THE BUFFER
09100	REALRT:	POP	P,D			;RESTORE THE AC
09200		TRNN	C,760000		;ERR OR EOF?
09300		JRST	USOUT			; NO
09400		JRST	USERF			; YES, GO LOOK AT IT
09500	
09600	REALOT:	MOVE	C,[GETSTS C]
09700		DPB	CHNL,[POINT 4,C,12]
09800		XCT	C
09900		TRNN	C,ROBERR		;STOPPED FOR A ROB?
10000		JRST	REAL5			; NO
10100		HRRI	D,(C)			;GET THE BITS
10200		TRZ	D,760000		;TURN OFF THE ERRS
10300		HRLI	D,(<SETSTS>)
10400		DPB	CHNL,[POINT 4,D,12]
10500		XCT	D
10600	REAL5:	MOVSI	D,(<OUT>)
10700		DPB	CHNL,[POINT 4,D,12]
10800		XCT	D
10900		JRST	REALRT
11000		JRST	REALRT			;IGNORE NOW, CATCH THE NEXT TIME THRU
11100	
11200	>;CMU
11300	
11400	USBTST←.-1
11500		XWD	CDB,IBUF	;1
11600	;;#QY# ! RHT 2-1-74 NEEDED A DUMMY HERE. 
11700		777777			;@ THRU THIS  WILL BE ILL MEM REF
11800		XWD	CDB,OBUF	;3
11900	>;EXPO
12000	
12100	
12200	DSCR INSTRUCTION TABLE
12300	⊗
12400	IOINST←.-1		;IOSTATUS ←← 0  GET STATUS
12500		IN		;IOIN     ←← 1  BUFFERED INPUT
12600		IN D		;IODIN	  ←← 2  DUMP MODE INPUT
12700		OUT		;IOOUT	  ←← 3  BUFFERED OUTPUT
12800		OUT D		;IODOUT	  ←← 4  DUMP MODE OUTPUT
12900		CLOSE (D)	;IOCLOSE  ←← 5  CLOSE I,O, OR BOTH
13000	;; ALLOW USE OF INHIBIT BITS IN RELEASE
13100		RELEASE	(D)	;IORELEASE←← 6
13200		INBUF (A)	;IOINBUF  ←← 7
13300		OUTBUF (A)	;IOOUTBUF ←←10
13400		USETI (A)	;IOSETI	  ←←11
13500		USETO (A)	;IOSETO	  ←←12
13600	;;%##% A NEW GOODIE
13700		SETSTS  (A)	; SET IO STATUS
13800		OPEN DMODE(CDB)	  ;IOOPEN	  ←←14
13900		LOOKUP FNAME(USER);IOLOOKUP←←15
14000		ENTER FNAME(USER);IOENTER  ←←16
14100		RENAME FNAME(USER);IORENAME←←17
14200	
14300	HERE(CSERR)	MOVE	USER,GOGTAB
14400		POP	P,UUO1(USER)	;STANDARD PLACE
14500		ERR	<CASE INDEX OVERFLOW, VALUE IS >,13
14600		JRST	@UUO1(USER)	;RETURN OK
14700	
14800	HERE (LPRYER) ERR	<DATUM OF ARRAY NOT THERE>,1
14900		POPJ	P,
15000	
15100	ENDCOM(SAV)
15200	COMPIL(CHN,<GETCHN,NOTOPN,GETCHAN>,<GOGTAB>,<GETCHN, NOTOPN, GETCHAN>)
     

00100	COMMENT ⊗Getchn ⊗
00200	
00300	DSCR Getchn, Getchan
00400	
00500	PAR A -- addr of ASCII for routine name
00600	 CHNL -- I/O channel number from SAIL call
00700	RES -- CHNL contains actual I/O channel number (diff for shared TTY)
00800	 CDB contains ptr to  actual CDB table for that channel
00900	SID A(lh) is changed
01000	DES normally just sets up CHNL and CDB
01100	 if error occurs (channel out of bounds, already open), a fatal message
01200	  is printed, using the address in A to get the routine name.
01300	 This routine is called by most I/O routines, having saved ACs and 
01400	  fetched CHNL.
01500	⊗
01600	
01700	GETCHN:
01800		HRLI	A,(<PUUO 3,0>)	;PREPARE FOR ERR MESS
01900		TRZE	CHNL,777760	;CHECK FOR VALID CHANNEL NO
02000		 JRST	 NOTVALID	;INVALID CHANNEL NUMBER
02100		SKIPE	CDB,@CDBLOC(USER) ;IS CHANNEL OPEN? (CDBLOC SET BY ALLOC)
02200		POPJ	P,
02300	
02400	NOTOPN:	
02500		XCT	A		;PRINT ROUTINE NAME
02600		ERR	<: CHANNEL OR FILE NOT OPEN>
02700	
02800	
02900	NOTVALID:
03000		XCT	A		;ROUTINE NAME
03100		ERR	<: CHANNEL NUMBER INVALID>
03200	
03300	
03400	DSCR INTEGER←GETCHAN;
03500	CAL SAIL
03600	⊗
03700	
03800	HERE (GETCHAN)
03900		MOVE	USER,GOGTAB
04000		ADD	USER,[XWD A,CHANS]	;MAKE @ WORD
04100		MOVEI	A,1			;START AT CHANNEL 1
04200	CHLUP:	SKIPN	@USER			;IF CHANNEL IS FREE,
04300		POPJ	P,			; RETURN
04400		CAIGE	A,17			;CYCLE TO 0?
04500		AOJA	A,CHLUP			;NO, TRY NEXT
04600		MOVEI	A,0			;TRY 0
04700		SKIPE	@USER			;FREE?
04800		HRROI	A,-1			;NOPE
04900		POPJ	P,			;DONE
05000	
05100	ENDCOM(CHN)
05200	COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
     

00100	COMMENT ⊗Filnam ⊗
00200	
00300	DSCR FILNAM
00400	CAL PUSHJ
00500	PAR file name string on SP stack
00600	 of form FILENAME<.EXT><[PROJ,PROG]>
00700	RES FNAME(USER) : SIXBIT /filename/
00800	 EXT(USER): SIXBIT /extension,,0/
00900	 0
01000	 PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
01100	SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
01200	⊗
01300	
01400	↑↑FILNAM:
01500		SUB	SP,X22		;ADJUST STACK
01600		FOR II←1,3 <
01700		SETZM	FNAME+II(USER)>
01800		MOVEI	X,FNAME(USER)	;WHERE TO PUT IT
01900		PUSHJ	P,FLSCAN	;GET FILE NAME
02000		JUMPE	Y,FLDUN	;FILE NAME ONLY
02100		CAIE	Y,"."		;EXTENSION?
02200		JRST	FLEXT		;NO, CHECK PPN
02300		MOVEI	X,FNAME+1(USER)
02400		PUSHJ	P,FLSCAN
02500	FLEXT:	JUMPE	Y,FLDUN	;NO PPN SPECIFIED
02600		CAIE	Y,"["
02700		JRST	FLERR		;INVALID CHARACTER
02800	CMU <		;HANDLE PPNS VIA UUO, MAYBE
02900		HRRZS	1(SP)	;LENGTH PART
03000			;SNEAK A LOOK AT FIRST CHAR
03100		SKIPN	1(SP)	;IS THERE A FIRST CHAR?
03200		JRST	FLERR	; NO.
03300		MOVE	X,2(SP)
03400		ILDB	X,X
03500		CAIL	X,"0"
03600		CAILE	X,"7"
03700		SKIPA		; NOT OCTAL DIGIT
03800		JRST	OCTPPN
03900		PUSH	P,A	;NEED MORE ROOM
04000		PUSH	P,B
04100		SETZM	A	;CLEAR THE AREA
04200		SETZM	B
04300		SETZM	C
04400		MOVEI	D,=13+1	;MAX #CHARS+1
04500		MOVE	X,[POINT 7,A]	;DUMP THEM THERE
04600	FLN2:	SOSGE	1(SP)
04700		JRST	FLERRC	;RAN OUT OF STRING
04800		ILDB	Y,2(SP)	;THE NEXT CHAR
04900		CAIN	Y,"]"	;THE END?
05000		JRST	GOTRB	; YES
05100		JUMPLE	D,FLERRC	;WE DON'T WANT ANY MORE CHARACTERS
05200		IDPB	Y,X	;STICK THE CHAR THERE
05300		SOJA	D,FLN2	;GET ANOTHER
05400	
05500	GOTRB:	MOVEI	X,A	;THATS WHERE THE UUO WILL FIND THEM
05600		CALLI	X,-2		;CMUDEC UUO
05700		JRST	FLERRC	;SOMETHING WRONG
05800		MOVEM	X,FNAME+3(USER)	;SAVE IT
05900	
06000		AOS	-2(P)		;INDICATE SUCCESS
06100	FLERRC:	POP	P,B
06200		POP	P,A
06300		POPJ	P,
06400	OCTPPN:
06500	>;CMU
06600		PUSHJ	P,[
06700	
06800		RJUST:	SETZM	PROJ(USER)
06900			MOVEI	X,PROJ(USER)
07000			PUSHJ	P,FLSCAN	;GET PROJ OR PROG IN SIXBIT
07100	IFN SIXSW,<
07200			MOVE	X,PROJ(USER)
07300			IMULI	D,-6		;SHIFT FACTOR
07400			LSH	X,(D)		;RIGHT-JUSTIFY THE PROJ OR PROG
07500	>;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
07600		
07700	IFE SIXSW,<
07800			MOVEI	X,0
07900	;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
08000			MOVE	D,PROJ(USER)	;WAS A HLLZ
08100	;;
08200		FBACK:	MOVEI	C,0
08300			LSHC	C,6		;GET A SIXBIT CHAR
08400			CAIL	C,'0'
08500			CAILE	C,'7'
08600			JRST	FLERR		;INVALID OCTAL
08700			LSH	X,3
08800			IORI	X,-'0'(C)
08900			JUMPN	D,FBACK
09000	>;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
09100		FPOP:	POPJ	P,]
09200	
09300		HRLZM	X,FNAME+3(USER)
09400		CAIE	Y,","
09500		JRST	FLERR		;INVALID CHAR
09600		PUSHJ	P,RJUST		;JUSTIFY(AND CONVERT IF EXPORT) PROG #
09700		HRRM	X,FNAME+3(USER)
09800		CAIN	Y,"]"
09900	FLDUN:	AOS	(P)		;SUCCESSFUL
10000	FLERR:	POPJ	P,		;DONE, NOT NECESSARILY RIGHT
10100	
10200	ENDCOM(FIL)
10300	COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
     

00100	COMMENT ⊗Flscan ⊗
00200	
00300	DSCR FLSCAN
00400	CAL PUSHJ
00500	PAR X -- addr of destination SIXBIT
00600	 1(SP), 2(SP) -- input string
00700	RES sixbit for next filename, etc in word addressed by X
00800	 break (punctuation) char in Y (0 if string exhausted)
00900	 D,X, input string adjusted
01000	SID only those AC changes listed above (Y, for instance)
01100	⊗
01200	
01300	↑↑FLSCAN:  
01400		HRRZS	1(SP)		;WANT ONLY LENGTH PART
01500		MOVEI	D,6		;MAX NUMBER PICKED UP
01600		SETZM	(X)		;ZERO DESTINATION
01700		HRLI	X,440600	;BYTE POINTER NOW
01800	FLN1:	MOVEI	Y,0		;ASSUME NO STRING LEFT
01900		SOSGE	1(SP)		;TEST 0-LENGTH STRING
02000		 POPJ	 P,
02100		ILDB	Y,2(SP)		;GET BYTE
02200		CAIE	Y,"."		;CHECK VALID BREAK CHAR
02300		CAIN	Y,"["
02400		POPJ	P,
02500		CAIE	Y,"]"
02600		CAIN	Y,","
02700		POPJ	P,
02800		JUMPE	D,FLN1		;NEED NO MORE CHARS
02900		TRZN	Y,100		;MOVE 100 BIT TO 40 BIT
03000		TRZA	Y,40		; TO CONVERT TO SIXBIT
03100		TRO	Y,40		; (NO CHECKING)
03200		IDPB	Y,X		;PUT IT AWAY
03300		SOJA	D,FLN1		;CONTINUE
03400	
03500	ENDCOM(FLS)
03600	COMPIL(OPN,<OPEN,RELEASE,SETPL,CHNCDB>
03700		  ,<GETCHN,SAVE,RESTR,CORGET,FLSCAN,SIMIO,X33,X22,X11,CORREL>
03800		  ,<OPEN RELEASE AND SETPL FUNCTIONS>)
03900	
     

00100	COMMENT ⊗Open ⊗
00200	
00300	DSCR OPEN(CHAN,"DEV",MODE,IBFS,OBFS,@INCNT,@INBRCHR,@INEOF);
00400	CAL SAIL
00500	⊗
00600	COMMENT ⊗
00700	Allocate IBFS input and OBFS output buffers on channel CHAN for
00800	 device DEV(SAIL/GOGOL string). Store INCNT, and the INBCHR and INEOF 
00900	 addresses in a newly allocated CDB (channel data block). Store 
01000	 all necessary information to carry out I/O on this channel
01100	 in the CDB. Mark the channel open.
01200	⊗
01300	
01400	.OPN:
01500	HERE (OPEN)
01600	; FIRST RELEASE IF ALREADY OPEN
01700		PUSH	P,-7(P)
01800	; RELEAS NOW TAKES TWO ARGS
01900		PUSH	P,[0]
02000		PUSHJ	P,RELEASE	;SIMPLE
02100	
02200	; NEXT SAVE AC'S, SET UP USER REGISTER, OBTAIN A CDB
02300	
02400		PUSHJ	P,SAVE		;SAVE ACS
02500		MOVEI	C,IOTLEN	;SIZE
02600		PUSHJ	P,CORGET	;OBTAIN A BLOCK
02700		 JRST	 BADOPN		;CAN'T GET IT
02800		MOVE	CDB,B		;CDB ptr to CHANNEL TABLE
02900		MOVEI	LPSA,0		;NOW GET READY IN CASE OF ERROR
03000		SUB	SP,X22
03100	
03200	; FILL IT WITH NON-CONTROVERSIAL THINGS
03300	
03400		POP	P,TEMP		;RETURN ADDRESS
03500		POP	P,ENDFL(CDB)	;END OF FILE FLAG ADDRESS
03600		POP	P,BRCHAR(CDB)	;BREAK CHAR ADDRESS
03700		POP	P,ICOUNT(CDB)	;INPUT COUNT ADDRESS
03800		POP	P,OBUF(CDB)	;NUMBER OF OUTPUT BUFFERS
03900		POP	P,IBUF(CDB)	;NUMBER OF INPUT BUFFERS
04000		POP	P,Z		;DATA MODE
04100		POP	P,CHNL		;DATA CHANNEL
04200		CHKCHN	CHNL,<OPEN>	;ASSURE VALID
04300	;;#HA# DCS 5-11-72 IMPROVE ERROR ENABLE. ALSO, IN EXPO SYSTEM,
04400	;;		   AVOID REFERENCES TO PGNNO, WHICH IS same as ERRTST!
04500		HRRZI	X,750000	;ERROR BITS POSSIBLY ENABLED  -- WAS A HRROI
04600	;;#HA#
04700		ANDCM	X,Z		;ERROR BITS ACTUALLY ENABLED ARE 0
04800		MOVEM	X,ERRTST(CDB)	;SAVE ENABLATIONS
04900		TRZ	Z,750000	;REMOVE IRRELEVANT BITS
05000	ILLMOD ←← 777777
05100	CMU <
05200	ILLMOD ←← 377776		;BIT 400000 FOR SPECIAL DEVICE (CMU)
05300					;BIT 000001 FOR KEEPING NULLS
05400		TLZE	Z,10000	;IOACTIVE BIT TO BE SET ON OPEN ??? (LDE)
05500		TRO	Z,10000	;YES
05600	>;CMU
05700		TLNE	Z,ILLMOD	;CHECK VALIDITY SOMEWHAT
05800		 ERR	 <OPEN: INVALID DATA MODE>,1
05900		MOVEM	Z,DMODE(CDB)	;STORE MODE
06000	
06100	; GET DEVICE NAME
06200	
06300		MOVEI	X,DNAME(CDB) ;WHERE SIXBIT'S TO GO
06400		PUSHJ	P,FLSCAN	;GET DEVICE NAME
06500	;;%##% ONLY GIVE ERROR MESSAGE IF NOT ASKED NOT TO
06600		JUMPN	Y,[
06700			SKIPN	@ENDFL(CDB)	;FLAGGED??
06800			ERR	<INVALID DEVICE NAME FOR OPEN>,1
06900			JRST	.+1
07000			]
07100	
07200	;IF TTY, MARK TTYDEV FOR OUT
07300	
07400		HLRZ	TEMP,DNAME(CDB)	;GET LH DEVICE NAME
07500		MOVSI	Z,400000	;BIT TO MARK WITH
07600	;;%##% DO A DEVCHR NOW
07700	;;	CAIE	TEMP,'TTY'	;IF TTY OR PTY,
07800		CAIN	TEMP,'PTY'	; ,
07900		JRST	MRKTYB		;MARK AS A TTY
08000		MOVE	TEMP,DNAME(CDB)	;PICK UP DEVICE AGAIN (FULL SIXBIT)
08100		CALL6	(TEMP,DEVCHR)	;GET CHARACTERISTICS
08200		TLNE	TEMP,10		;A TTY???
08300	MRKTYB:	 IORM	 Z,TTYDEV(CDB); IT'S A TTY
08400	;;%##%
08500	
08600	; NOW SET HEADER PTRS IN CDB
08700	
08800		HRRZI	Z,-1		;TO TEST RIGHT HALF
08900		SETZM	BFHED(CDB)	;CLEAR HEADER POINTER
09000		LDB	E,[POINT 4,DMODE(CDB),35] ;DATA MODE
09100		CAIL	E,15		;DUMP MODE?
09200		 JRST	 AGNN		; YES, NO BUFFER HEADER WORD
09300		MOVEI	TEMP,OBPNT(CDB)	;IF OUTPUT, SET POINTER
09400		TDNE	Z,OBUF(CDB)	;ANY OUTPUT BUFFERS?
09500		 HRLM	 TEMP,BFHED(CDB)
09600		MOVEI	TEMP,IBPNT(CDB)	;SAME FOR INPUT
09700		TDNE	Z,IBUF(CDB)	;ANY INPUT BUFFERS?
09800		 HRRM	 TEMP,BFHED(CDB)
09900	
10000	; NOW OPEN THE FILE, GET THE BUFFERS,ETC.
10100	
10200	AGNN:	XCT	IOOPEN,SIMIO		; OPEN CHAN,MODE
10300		 JRST	 [SKIPE @ENDFL(CDB) ;DOES USER WANT TO KNOW?
10400				 JRST	NORELO ;YES, RELEASE CDB, ERASE ALL OF ATTEMPT
10500				 JRST	RTRY]
     

00100	
00200	COMMENT ⊗
00300	ERMAN'S IMPROVED BUFFER GETTER   ---  DEC. 1970
00400	 If a buffer size is specified (lh #buf word), allocate that size, else the
00500	standard size (determined via a dummy XXXBUF, clever soul that LDE is).
00600	"NOTICE WITH AWE THAT NO CORE IS EVER WASTED, AS IN THE INFERIOR OLD WAY" (sic).
00700	⊗
00800		MOVEI	Z,0		;FOR DUMMY (AND REAL) OUTBUF
00900		PUSHJ	P,GETBFS	;GET CORE, DO THE OUTBUFS (OR SIMULATIONS)
01000		ADDI	CDB,OBUF-OBPNT+1 ;RELOCATE FOR INPUT IN CDB
01100		MOVEI	Z,-1
01200		PUSHJ	P,GETBFS	;GET CORE, DO INBUFS
01300		SUBI	CDB,OBUF-OBPNT+1;RE-RELOCATE
01400	CMU <	;FUNNY INPUT DEVICE
01500		SKIPL	DMODE(CDB)		;DID HE SPECIFY TO GET ERRS FROM
01600						; BUFFER HEADER?
01700		JRST	STNIT			;     NO.
01800		HRLZI	TEMP,400000
01900		SKIPE	IBUF(CDB)		;INPUT BUFFERS?
02000		JRST	[IORM	TEMP,IBUF(CDB)	; YES
02100			 JRST	STNIT]
02200		SKIPE	OBUF(CDB)		;OR OUTPUT BUFFERS?
02300		JUMPA	CHNL,[IORM	TEMP,OBUF(CDB)	; YES
02400				JRST	STNIT]
02500		ERR<OPEN: SPEECH DEV BUT NO BUFFERS, CHAN >,7
02600	>;CMU
02700	
02800	; FINISH OUT -- SET EOF FLAG IF DESIRED
02900	
03000	STNIT:	;SETOM	JOBFF		;ONE MUST KNOW WHAT HE IS DOING TO USE
03100		MOVEM	CDB,@CDBLOC(USER) ;STORE CDB ADDR IN CHANS TABLE
03200		SETZM	@ENDFL(CDB)	;MARK OPEN SUCCESSFUL
03300		JRST	RESTR		;RESTORE ACS, RETURN
03400	
03500	BADOPN:	HRRZ	TEMP,JOBREN	;NEXT START WILL ASK ALLOC
03600		HRRM	TEMP,JOBSA	;QUESTION
03700		ERR	<TOO MANY CHANNELS OR I/O BUFFERS REQUESTED>,1,<(TEMP)>
03800	
03900	RTRY:	TERPRI	<OPEN: DEVICE NOT AVAILABLE>
04000		TERPRI	<TYPE "R" TO RETRY, "X" TO GO ON WITHOUT>
04100		PRINT	<?>
04200		PUUO	TEMP
04300		CAIN	TEMP,"R"	;TRY AGAIN?
04400		 JRST	 AGNN		;YES
04500	;;%##%
04600		SETOM	@ENDFL(CDB)	;MARK A LOSER
04700		JRST	 NORELO
04800	;;%##%
04900	
05000	GETBFS:	SETZM	ONAME(CDB)	;CLEAR FILE NAME
05100		HRRZ	Y,OBUF(CDB)	;NUMBER OF BUFFERS
05200		HLRZ	D,OBUF(CDB)	;SIZE
05300	EXPO <
05400		HRRZS	OBUF(CDB)	;MARK FOR SPECIAL TEST
05500	>;EXPO
05600		JUMPE	Y,GBUFRT	;NO BUFFERS
05700		JUMPE	D,GETDES	;WANTS DEFAULT SIZE
05800		ANDI	D,7777		;MAX BUFFER SIZE
05900		HRLZ	A,D		;SIZE IN LH
06000		PUSHJ	P,GETCOR	;GET THE CORE (SURPRISE!)
06100		SETZM	OCOWNT(CDB)	;IN CASE NO ACTUAL INBUF (OUTBUF) DONE
06200		CAIL	E,15		;DUMP MODE?
06300		 JRST	 GBUFRT		; YES, DON'T ACTUALLY FUDGE UP BUFFERS
06400	NOEXPO <;USE UINBF, UOUTBF
06500	;;#GD# 01-25-72 DCS (1-2) set up JOBFF, Fix XCT, bad count
06600		MOVEM	B,JOBFF		;B FROM CORGET HAS BUFFER AREA ADDRESS
06700		SUBI	D,2		;GETCOR INCREMENTED
06800	;;#GD#
06900		HRRZ	C,Y
07000		MOVE	A,[UINBF C]
07100		JUMPN	Z,.+2
07200		MOVE	A,[UOUTBF C]
07300		DPB	CHNL,[POINT 4,A,12]
07400	;;#GD# 01-25-72 DCS (2-2) (was XCT CHNL, clearly wrong)
07500		XCT	A		;DO THE ALLOCATIONS
07600	;;#GD#
07700		POPJ	P,
07800	>;NOEXPO
07900	EXPO <
08000		ADDI	B,1		;SECOND WORD
08100	BUFC1:	HRR	A,B
08200		SOJLE	Y,BUFC2
08300		ADD	B,D		;NEXT ONE
08400		MOVEM	A,(B)		;MAKE POINT TO PREV
08500		JRST	BUFC1
08600	
08700	BUFC2:	MOVE	B,OBUF(CDB)	;BACK TO FIRST
08800		MOVEM	A,1(B)		;LINK IT TOO
08900		HRLI	A,400000	;RING-USE BIQ
09000		MOVEM	A,OBPNT(CDB)	;BUFFER PTR
09100		POPJ	P,
09200	>;EXPO
09300	
09400	GETCOR:	ADDI	D,2		;+2 FOR ACCOUNTING
09500		MOVE	C,D
09600		IMUL	C,Y		;TOTAL CORE NEEDED
09700		PUSHJ	P,CORGET	;GRAB IT
09800		ERR	<OPEN: NOT ENUFF CORE FOR BUFFERS>
09900		HRRZM	B,OBUF(CDB)	;SAVE SO CAN RELEASE
10000		POPJ	P,
10100	
10200	GETDES:	MOVEI	A,1		;1 DUMMY BUFFER
10300		CAIL	E,15		;GOOD OLD DUMP MODE?
10400		 JRST	 [MOVEI D,202	;ASSUME THIS, SINCE INBUF/OUTBUF WON'T
10500			  JRST GDIT]	; WORK IN DUMP MODE
10600		MOVEI	TEMP,BRKDUM-1(USER)
10700		MOVEM	TEMP,JOBFF
10800		PUSHJ	P,GETIOB	;DUMMY IN/OUBUF
10900		LDB	D,[POINT 17,BRKDUM(USER),17] ;GET THE SIZE
11000	GDIT:	PUSHJ	P,GETCOR	;GET THE CORE
11100		SETZM	OCOWNT(CDB)	;CLEAR BYTE COUNT
11200		CAIL	E,15		;DUMP MODE?
11300		JRST	GBUFRT		;YES, NO BUFFER STRUCTURE
11400		MOVEM	B,JOBFF
11500		MOVE	A,Y		;NUMBER OF BUFFERS
11600		PUSHJ	P,GETIOB	;NOW FOR REAL
11700	GBUFRT:	SETOM	JOBFF		;FOR SPITE
11800		POPJ	P,
11900	
12000	GETIOB:	SKIPN	Z
12100		XCT	IOOUTBUF,SIMIO	;DO OUTBUF
12200		SKIPE	Z
12300		XCT	IOINBUF,SIMIO	;INBUF
12400		POPJ	P,
12500	SUBTTL	RELEASE
     

00100	COMMENT ⊗Release ⊗
00200	
00300	DSCR RELEASE(CHANNEL NO,INHIBIT BITS);
00400	CAL SAIL
00500	DES THIS USES THE DEFAULT PARAMETER MECHANISM, 0 DEFAULT FOR INHIBIT BITS
00600	⊗
00700	
00800	COMMENT ⊗
00900	Release channel, i/o buffers, channel table if channel is open
01000	Adjust special TTY stuff to reflect lossage if TTY channel
01100	⊗
01200	
01300	
01400	HERE(RELEASE)
01500	.RELS:
01600		SETOM	JOBFF		;MARK INVALID
01700		PUSHJ	P,SAVE		;SAVE REGS, GET USER, SAVE RETURN
01800	;; FOLLOWING WAS MOVE LPSA,X22
01900		MOVE	LPSA,X33
02000	;; FOLOWING WAS CHNL,-1(P)
02100		MOVE	CHNL,-2(P)	;CHANNEL #
02200		CHKCHN	CHNL,<RELEASE> ;VALIDATE
02300		SKIPN	CDB,@CDBLOC(USER) ;GET ADDR FROM CHANS TABLE-- CHANNEL OPEN?
02400		 JRST	 RESTR		;CHANNEL NOT OPEN, FORGET IT
02500		SETZM	@CDBLOC(USER)	;CLEAR CHANS TABLE ENTRY
02600	;; INHIBIT BITS;
02700		HRRZ	D,-1(P)		;THE DEFAULT OR USER SPECIFIED INHIBIT BITS
02800		XCT	IORELEASE,SIMIO	;RELEASE CHAN,0
02900		HRRZ	B,IBUF(CDB)	;RELEASE ANY INPUT
03000		PUSHJ	P,BUFREL	; BUFFERS
03100		HRRZ	B,OBUF(CDB)	;ALSO OUTPUT
03200		PUSHJ	P,BUFREL	; BUFFERS
03300	NORELO:	HRRZ	B,CDB		;WHERE TO RELEASE
03400		PUSHJ	P,CORREL	;GIVE CDB BACK
03500		JRST	RESTR		;RESTORE AND RETURN
03600	
03700	BUFREL:	JUMPN	B,CORREL	;RELEASE IF ANY TO RELEASE
03800		POPJ	P,		;ELSE RETURN
03900	
04000	
04100	DSCR SETPL(CHANNEL,@LINNUM,@PAGNUM,@SOSNUM)
04200	CAL SAIL
04300	⊗
04400	
04500	HERE(SETPL)
04600		PUSHJ	P,SAVE
04700		MOVE	CHNL,-4(P)	;GET CHANNEL
04800		PUSHJ	P,GETCHN	;VALIDATE, LOAD CDB
04900		POP	P,TEMP		;RETURN ADDRESS (GET OUT OF WAY)
05000		POP	P,SOSNUM(CDB)
05100		SETZM	@SOSNUM(CDB)
05200		POP	P,PAGNUM(CDB)
05300		SETZM	@PAGNUM(CDB)
05400		POP	P,LINNUM(CDB)	;LINE NUMBER
05500		SETZM	@LINNUM(CDB)
05600		MOVE	LPSA,X11	;REMOVE CHANNEL NUMBER FROM STACK
05700		JRST	RESTR
05800	
05900	;;%AV% -- rht
06000	DSCR CHNCDB(CHANNEL);
06100	CAL SAIL
06200	DES RETURNS INTEGER = INPHDR,,OUTHDR
06300		(ACTUALLY COULD BE GOTTEN FROM CDB BY USER, BUT THIS
06400		PROMISSES MORE STABILITY)
06500	⊗
06600	
06700	HERE(CHNCDB)
06800		PUSHJ	P,SAVE		;
06900		MOVE	CHNL,-1(P)	;GET CHANNEL NUMBER
07000		PUSHJ	P,GETCHN	;CHECK & LOAD CDB
07100		MOVEI	1,DMODE(CDB)	;GET VALUE
07200		MOVEM	1,RACS+1(USER)	;SO RESTR WINS
07300		MOVE	LPSA,X22	;
07400		JRST RESTR		;RETURN
07500	
07600	HERE(OPNSP1)			;PERHAPS PUT GETSTS HERE
07700	;;%##% GOBBLED DOWN TWO SPARE HERES HERE FOR STATUS ROUTINES THAT FOLLOW
07800		ERR <DRYROT IN OPEN SPARES>
07900	
08000	ENDCOM (OPN)
08100	;;%##%
08200	COMPIL(STS,<GETSTS,SETSTS>
08300		,<SAVE,RESTR,SIMIO,GOGTAB,GETCHN,X11,X33,X22>
08400		,<GETSTS AND SETSTS>)
08500	
08600	
08700	COMMENT ⊗GETSTS,SETSTS⊗
08800	
08900	DSCR STATUS←GETSTS(CHANNEL);
09000	CAL SAIL
09100	⊗
09200	
09300	.STS:
09400	HERE(GETSTS)
09500		PUSHJ	P,SAVE
09600		LOADI7	A,<GETSTS>
09700		MOVE	CHNL,-1(P)	;CHANNEL #
09800		PUSHJ	P,GETCHN
09900		XCT	IOSTATUS,SIMIO	;DO THE UUO
10000		JFCL
10100		MOVE	A,FSTATS(USER)	;THE RESULT
10200		MOVEM	A,RACS+A(USER)	;SO RESTR WORKS
10300		MOVE	LPSA,X22
10400		JRST	RESTR
10500	
10600	DSCR SETSTS(CHANNEL,STATURS);
10700	CAL SAIL
10800	⊗
10900	
11000	HERE(SETSTS)
11100		PUSHJ	P,SAVE
11200		LOADI7	A,<SETSTS>
11300		MOVE	CHNL,-2(P)
11400		PUSHJ	P,GETCHN
11500		MOVE	A,-1(P)		;INTENDED STATUS BITS
11600		XCT	SETIOSTS,SIMIO	;XECUTE THE INST
11700		JFCL			;SHOULDN'T SKIP
11800		MOVE	LPSA,X33
11900		JRST	RESTR		;GO RESTORE
12000	
12100	ENDCOM(STS)
12200	COMPIL(LOK,<LOOKUP,ENTER,FILEINFO>
12300		  ,<SAVE,RESTR,GETCHN,FILNAM,SIMIO,X33,X22,GOGTAB>
12400		  ,<LOOKUP, ENTER, AND FILEINFO ROUTINES>)
     

00100	COMMENT ⊗Lookup, Enter ⊗
00200	
00300	DSCR LOOKUP(CHANNEL,"FILE NAME",@FAILURE FLAG);
00400	CAL SAIL
00500	⊗
00600	
00700	Comment ⊗
00800	LOOKUP or ENTER file FILENAME on channel CHANNEL, where FILENAME has
00900		a format acceptable to FILNAM above. If successful,
01000		FAILURE!FLAG (called by reference) is zeroed. It is
01100		otherwise set to -1 in LH, error code in RH.
01200	⊗
01300	
01400	
01500	.LOK:
01600	HERE (LOOKUP) PUSHJ	P,SAVE
01700		LOADI7	A,<LOOKUP>
01800		PUSH	P,[XCT	IOLOOKUP,SIMIO]	;LOOKUP CH,FILE
01900		MOVEI	B,INAME			;TO STORE FILE NAME
02000		JRST	LOKENT			;DO THE OPERATION
02100	
02200	DSCR ENTER(CHANNEL,"FILE NAME",@FAILURE FLAG);
02300	CAL SAIL
02400	⊗
02500	
02600	HERE (ENTER)
02700		PUSHJ	P,SAVE
02800		LOADI7	A,<ENTER>
02900		PUSH	P,[XCT IOENTER,SIMIO]	;ENTER CH,FILE
03000		MOVEI	B,ONAME			;TO STORE FILE NAME
03100	LOKENT:
03200		MOVE	LPSA,X33		;PARAM ADJUST FOR RESTR
03300		MOVE	CHNL,-3(P)		;GET CHANNEL #
03400		PUSHJ	P,GETCHN		;VALIDATE
03500		SETZM	@-2(P)			;ASSUME SUCCESS
03600		PUSHJ	P,FILNAM		;GET FILE
03700		 JRST	 BADSPC			; NO GOOD, REPORT ERROR
03800		ADD	B,CDB			;ADDR OF FILE NAME HOLDER
03900		MOVEW	(<(B)>,<FNAME(USER)>)	;STORE IT
04000		POP	P,X			;INSTRUCTION TO DO
04100		MOVE	Y,[JRST ELERR]		;FAILURE
04200		MOVE	Z,[JRST RESTR]		;SUCCESS
04300	ENF1:	JRST	X			;ENTER/LOOKUP
04400	
04500	BADSPC:	POP	P,(P)			;REMOVE IO INSTRUCTION
04600		HRRZ	TEMP,ERRTST(CDB)	;GET USER-ENABLE BITS
04700		TRNE	TEMP,10000		;ENABLED FOR HANDLING BAD FILE SPECS?
04800		ERR	<LOOKUP OR ENTER: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
04900		SKIPA	TEMP,[=8]		;ALWAYS REPORT NO GOOD LOOKUP/ENTER
05000	ELERR:	HRRZ	TEMP,FNAME+1(USER)	;WHY DID IT BLOW?
05100		HRROM	TEMP,@-1(P)		;TELL THE USER
05200		JRST	RESTR
     

00100	COMMENT ⊗Fileinfo ⊗
00200	
00300	DSCR FILEINFO(INTEGER ARRAY INFO[1:6]);
00400	CAL SAIL
00500	⊗
00600	
00700	Comment ⊗ This routine gives the user the entire 6 word block
00800	  from the last LOOKUP, ENTER, or RENAME operation done by SAIL.⊗
00900	
01000	HERE (FILEINFO)
01100		MOVE	USER,GOGTAB
01200		POP	P,UUO1(USER)		;GET RID OF IT, MARK LAST SAIL CALL
01300		POP	P,LPSA			;ARRAY ADDRESS WHERE INFO IS TO GO
01400		SKIPGE	-2(LPSA)		;MAKE SURE IT'S NOT A STRING ARRAY
01500		 ERR	 <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
01600		MOVE	TEMP,-1(LPSA)		;TOTAL ARRAY SIZE WORD
01700		CAML	TEMP,[XWD 1,6]		;MUST BE 1-D, AT LEAST 6 WORDS
01800		CAMLE	TEMP,[XWD 1,-1]		;BUT NOT 2-D
01900		 ERR	 <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
02000		MOVEI	TEMP,5(LPSA)		;BLT TERMINATOR
02100		HRLI	LPSA,FNAME(USER)	;SOURCE OF VALUABLE INFORMATION
02200		BLT	LPSA,(TEMP)		;GIVE!
02300		JRST	@UUO1(USER)		;GONE
02400	
02500	ENDCOM (LOK)
02600	COMPIL(OUT,<OUT>,<SAVE,RESTR,GETCHN,SIMIO,NOTOPN,X11,X22>
02700		  ,<STRING OUTPUT ROUTINE>)
     

00100	COMMENT ⊗Out ⊗
00200	
00300	DSCR OUT(CHANNEL,"STRING");
00400	CAL SAIL
00500	⊗
00600	COMMENT ⊗
00700	Simply places all characters of string in output buffer for channel.
00800	Close file if device is TTY    ⊗
00900	
01000	.OUT.:
01100	HERE (OUT)	PUSHJ	P,SAVE		;ACS, GET USER, SAVE RETURN FOR ERROR
01200		MOVE	LPSA,X22
01300		MOVE	CHNL,-1(P)	;CHANNEL NUMBER
01400		LOADI7	A,<OUT>
01500		PUSHJ	P,GETCHN	;VALIDATE AND GET CDB, ETC.
01600		HRRE	Z,-1(SP)	;#CHARS
01700		POP	SP,D
01800		SUB	SP,X11
01900		MOVE	B,OBP(CDB)
02000		MOVE	A,OCOWNT(CDB)
02100		JRST	.OUT1
02200	
02300	
02400	.OUT:	SOJLE	A,OUT1		;NEED OUTPUT??
02500	.OUT2:	ILDB	X,D		;GET A CHAR
02600		IDPB	X,B		;PUT IT AWAY
02700	.OUT1:	SOJGE	Z,.OUT		;LOOP
02800	OUTDUN:	MOVEM	B,OBP(CDB)	;PUT BP AWAY
02900		MOVEM	A,OCOWNT(CDB)	;COUNT AWAY
03000		SKIPGE	TTYDEV(CDB)	;TTY?
03100		XCT	IOOUT,SIMIO	; YES, FORCE OUTPUT
03200		JRST	RESTR
03300		JRST	RESTR
03400	
03500	OUT1:	LDB	TEMP,[POINT 4,DMODE(CDB),35] ;MODE
03600		CAIL	TEMP,15		;DUMP?
03700		 JRST	 DMPO		;YES
03800		MOVEM	B,OBP(CDB)	;PUT REAL BP AWAY
03900		XCT	IOOUT,SIMIO	;DO THE OUTPUT
04000		JFCL			;ERRORS HANDLED IN SIMIO
04100		MOVE	B,OBP(CDB)	;NEW BP
04200		MOVE	A,OCOWNT(CDB)	;NEW COUNT
04300		JRST	.OUT2		;CONTINUE
04400	
04500	; SPECIAL DUMP-MODE OUTPUT STUFF
04600	
04700	DMPO:	PUSH	P,D
04800		HRRZ	D,OBUF(CDB)	;PTR TO BUFFER AREA
04900		SUBI	D,1		;ADDR-1 FOR IOWD
05000		HRLI	D,-=128		;-WORD COUNT
05100		MOVEI	D+1,0
05200		XCT	IODOUT,SIMIO	;OUT D,
05300		JFCL			;ERRORS HANDLED IN SIMIO
05400	OKO:	HRRZ	B,D		;SAVE ADDR
05500		HRLI	D,1(D)		;BLT WORD
05600		HRRI	D,2(D)
05700		SETZM	-1(D)
05800		BLT	D,=128(B)	;CLEAR BUFFER
05900		POP	P,D		;RESTORE INPUT BYTE POINTER
06000		AOS	@ENDFL(CDB)	;SPECIAL TREATMENT
06100		HRLI	B,700		;POINT 7,-1(1ST WORD),35
06200		MOVEM	B,OBP(CDB)
06300		MOVEI	A,5*=128	;CHAR COUNT
06400		MOVEM	A,OCOWNT(CDB)
06500		JRST	.OUT2		;AFTER OUTPUT SIMULATION, GO ON
06600	
06700	ENDCOM(OUT)
06800	COMPIL(INP,<INPUT>
06900		  ,<SAVE,.SKIP.,INSET,RESTR,SIMIO,GETCHN,STRNGC,BRKMSK,X33,NOTOPN,GOGTAB
07000	>
07100		  ,<STRING INPUT ROUTINE>)
     

00100	COMMENT ⊗Input ⊗
00200	
00300	DSCR  "STRING"←INPUT(CHANNEL,BREAK TABLE NUMBER);
00400	CAL SAIL
00500	SID NO ACS SAVED BY INPUT!!!!!!
00600	⊗
00700	
00800	.IN.:
00900	HERE (INPUT)	
01000		MOVE	USER,GOGTAB	;GET TABLE POINTER
01100	;;%##% FOR BENEFIT OF ERR ROUTINE
01200		MOVE	TEMP,(P)
01300		MOVEM	TEMP,UUO1(USER)
01400	;;%##%
01500		MOVEM	RF,RACS+RF(USER);SAVE F-REGISTER
01600		SKIPE	SGLIGN(USER)
01700		PUSHJ	P,INSET
01800		MOVE	CHNL,-2(P)	;CHANNEL #
01900		LOADI7	A,<IN>		;ROUTINE NAME
02000		PUSHJ	P,GETCHN	;SET UP, VALIDATE
02100		LDB	E,[POINT 4,DMODE(CDB),35] ;DATA MODE
02200		CAIGE	E,15		;DUMP MODE?
02300		SETZM	@ENDFL(CDB)	;NO, HELP USER ASSUME NO EOF,ERR
02400		SETZM	@BRCHAR(CDB)	;ASSUME NO BREAK CHAR
02500	CMU <
02600		SETZM	.SKIP.
02700	>;CMU
02800		HRRZ	A,@ICOUNT(CDB)	;MAX COUNT FOR INPUT STRING
02900		ADDM	A,REMCHR(USER)
03000		SKIPLE	REMCHR(USER)	;ENOUGH ROOM?
03100		PUSHJ	P,STRNGC	;NO, TRY TO GET SOME
03200		SKIPL	C,-1(P)		;GET TABLE #, CHECK IN BOUNDS
03300		CAILE	C,=18
03400		ERR	<IN: THERE ARE ONLY 18 BREAK TABLES>
03500		HRRZ	TEMP,USER
03600		ADD	TEMP,C		;TABLE NO(USER)
03700		MOVEI	Z,1		;FOR TESTING LINE NUMBERS
03800		SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
03900		 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
04000		MOVN	B,A		;NEGATE MAX CHAR COUNT
04100		PUSH	SP,[0]		;LEAVE ROOM FOR FIRST STR WORD
04200		PUSH	SP,TOPBYTE(USER)	;SECOND STRING WORD
04300		MOVE	FF,BRKMSK(C)	;GET MASK FOR THIS TABLE
04400		HRRZ	Y,USER
04500		ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
04600		JUMPE	B,DONE1		; BECAUSE THE AOJL WON'T
04700	CMU <
04800		MOVS	C,DMODE(CDB)	;FUNNY MODE BITS TO RH
04900	>;CMU
05000		TRNE	FF,@BRKCVT(USER) ;DOING UC COERCION?
05100		TLOA	C,400000	;YES
05200		TLZ	C,400000	;NO
05300		
05400	.IN:	SOSG	ICOWNT(CDB)	;BUFFER EMPTY?
05500		JRST	DOINP		;YES, GET MORE
05600	IN1:	
05700		ILDB	D,IBP(CDB)	;GET NEXT CHARACTER
05800		TDNE	Z,@IBP(CDB)	;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
05900		JRST	INLINN		;YES, GO SEE WHAT TO DO
06000	IN2:
06100	NOCMU <
06200		JUMPE	D,.IN		;ALWAYS IGNORE 0'S
06300	>;NOCMU
06400	CMU <
06500		JUMPE	D,[ TRNN  C,1	;REALLY IGNORE NULL??
06600			    JRST  .IN	;YES
06700			    JRST  .+1	;NOPE
06800			   ]
06900	>;CMU
07000	;;%##%	COERCING ??
07100		JUMPGE	C,NOCV.I	;NOT COERCIING ??
07200		CAIL	D,"a"		;ONLY COERCE LOWER CASE
07300		CAILE	D,"z"		;
07400		JRST	.+2		;FAST SKIP
07500		TRZ	D,40		;MAKE UC
07600	NOCV.I:	TDNE	FF,@Y		;MUST WE DO SOMETHING SPECIAL?
07700		JRST	INSPC		;YES, HANDLE
07800	
07900	MOVEC:	IDPB	D,TOPBYTE(USER)	;LENGTHEN STRING
08000		AOJL	B,.IN		;GET SOME MORE
08100		JRST	DONE1
08200	
08300	INSPC:	HLLZ	TEMP,@Y		;IGNORE OR BREAK?
08400		TDNN	TEMP,FF		;  (CHOOSE ONE)
08500		JRST	.IN		;IGNORE
08600	
08700	;  BREAK -- STORE BREAK CHAR, FINISH OFF
08800	
08900	DONE:	MOVEM	D,@BRCHAR(CDB)	;STORE BREAK CHAR
09000		MOVE	Y,-1(P)	;TABLE # AGAIN
09100		ADD	Y,USER		;RELOCATE
09200		SKIPN	Y,DSPTBL(Y)	;WHAT TO DO WITH BREAK CHAR?
09300		JRST	DONE1		;SKIP IT
09400		JUMPL	Y,APPEND	;ADD TO END OF INPUT STRING
09500	
09600	RETAIN:	SOS	IBP(CDB)		;BACK UP TO GET IT NEXT TIME
09700		FOR II←1,4 <
09800		IBP	IBP(CDB)>
09900		AOS	ICOWNT(CDB)
10000		JRST	DONE1
10100	
10200	APPEND:	IDPB	D,TOPBYTE(USER)	;PUT ON END
10300		AOJA	B,DONE1		;ONE MORE TO COUNT
10400	
10500	INEOF1: POP	P,D+1		;LEFT OVER FROM DUMP MODE ROUT
10600	
10700	;  DONE -- MARK STRING COUNT WORD
10800	
10900	DONE1:	ADDM	B,REMCHR(USER)	;GIVE UP THOSE NOT USED
11000		ADD	B,@ICOUNT(CDB)	;HOW MANY DID WE ACTUALLY GET?
11100	;;#GI# DCS 2-5-72 REMOVE TOPSTR
11200		HRROM	B,-1(SP)	;MARK RESULT, NON-CONSTANT
11300	;;#GI#
11400		MOVE	RF,RACS+RF(USER);GET F-REGISTER BACK
11500		SUB	P,X33		;REMOVE INPUT PARAMETER, RETURN ADDRESS
11600		JRST	@3(P)		;RETURN
11700	
11800	;  CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
11900	;  TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
12000	;  NOT A LINE NUMBER FOR NEXT TIME
12100	; GET A NEW BUFFER
12200	
12300	DOINP:
12400	CMU <
12500		AOS	.SKIP.
12600	>;CMU
12700		CAIL	E,15		;DUMP MODE?
12800		 JRST	 DMPI		; YES
12900		XCT	IOIN,SIMIO	;IN CHAN,0
13000		 JRST	 IN1		;ALL OK, CONTINUE
13100		 JRST	 DONE1		;ERROR OR EOF, QUIT
13200	
13300	; DUMP MODE SIMULATION OF SAME
13400	DMPI:	PUSH	P,D+1
13500		HRRZ	D,IBUF(CDB)	;PTR TO BUFFER AREA
13600		SUBI	D,1
13700		HRLI	D,-=128
13800		MOVEI	D+1,0
13900		XCT	IODIN,SIMIO	;IN CHAN,D
14000		 JRST	OKI
14100		 JRST	INEOF1		;REMOVE D,QUIT
14200	OKI:	POP	P,D+1
14300		AOS	@ENDFL(CDB)	;SPECIAL TREATMENT
14400		HRLI	D,700
14500		MOVEM	D,IBP(CDB)
14600		MOVEI	A,5*=128
14700		MOVEM	A,ICOWNT(CDB)
14800		JRST	IN1		;DONE SIMULATING, RETURN
14900	
15000	INLINN:
15100		MOVE	TEMP,-1(P)	;GET LINE NUMBER DISPOSITION FLAG,
15200		ADD	TEMP,USER	;RLC+TABLE
15300		SKIPGE	TEMP,LINTBL(TEMP) ;LINTBL+RLC+TABLE
15400		 JRST	 GIVLIN	; WANTS IT NEXT TIME OR SOMETHING
15500	
15600		JSP	TEMP,EATLIN	;TOSS IT OUT, AND 
15700		JRST	.IN		; CONTINUE
15800	
15900	EATLIN:
16000		AOS	IBP(CDB)	;FORGET IT ENTIRELY
16100		MOVNI	A,5		;INDICATE SKIPPING SIX
16200		ADDB	A,ICOWNT(CDB)	;IN COUNT
16300					;OVERFLOW BUFFER?
16400		JUMPG	A,(TEMP)	;NO, CONTINUE
16500		CAIL	E,15
16600		 ERR	 <CAN'T HANDLE THIS FILE IN DUMP MODE>
16700		XCT	IOIN,SIMIO	;YES, GET TAB FROM NEXT BUFFER
16800		 JRST	OKLN		;GOT IT, CONTINUE
16900		 JRST	DONE1
17000	
17100	OKLN:	SOSG	ICOWNT(CDB)	;IF ONLY ONE CHAR,
17200		JRST	[MOVEI TEMP,20000	;THEN EOF COMES NEXT
17300			 IORM  TEMP,@ENDFL(CDB)
17400			 JRST  DONE1]	;ALL DONE
17500		IBP	IBP(CDB)	;GET OVER TAB FINALLY
17600	;;#PM  12-1-73 RLS  DONT LOSE A CHARACTER IN THE (NEW) BUFFER 
17700		AOS	ICOWNT(CDB)	;INCREMENT COUNT
17800	;;#PM
17900		JRST	(TEMP)		;AND CONTINUE
18000	
18100	
18200	GIVLIN:	TRNE	TEMP,-1		;WANT LINE NO IN BRCHAR WORD?
18300		 JRST	 GVLLN		;NO, WANTS IT NEXT TIME.
18400		SKIPL	TEMP,@IBP(CDB)	;NEGATED LINE NO
18500		MOVNS	TEMP
18600		MOVEM	TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
18700		JSP	TEMP,EATLIN	;GO EAT UP LINE NUMBER AND
18800		JRST	DONE1		;FINISH UP
18900	GVLLN:
19000		SETOM	@BRCHAR(CDB)	;TELL THE USER
19100		AOS	ICOWNT(CDB)	;REVERSE THE SOSLE
19200		MOVEI	Y,1		;TURN OFF LINE NUMBER 
19300		ANDCAM	Y,@IBP(CDB)	;  BIT
19400		MOVSI	Y,070000	;BACK UP BYTE POINTER
19500		ADDM	Y,IBP(CDB)
19600		JRST	DONE1		;FINISH OFF IN BAZE OF GORY
19700	
19800	ENDCOM(INP)
19900	COMPIL(NUM,<REALIN,REALSCAN,INTIN,INTSCAN>
20000		  ,<SIMIO,SAVE,RESTR,X22,X33,GETCHN,NOTOPN,.CH.,.MT.,.TEN.>
20100		  ,<LOU PAUL'S NUMBER INPUT AND CONVERSION ROUTINES>)
     

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

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

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

00100	;NUMIN -- CONTD.
00200	
00300	NUMIN:	MOVE CHNL,-2(P)
00400		LOADI7 A,<IN>
00500		PUSHJ P,GETCHN;		SET UP FOR INPUT
00600		SETZM @ENDFL(CDB);	CLEAR EOF AND BREAK FLAGS
00700		SETZM @BRCHAR(CDB)
00800		MOVE LPSA,[JSP X,NCH]
00900		MOVEI Z,1;		FOR LINE NUMBER TEST
01000		PUSHJ P,SCAN
01100		MOVEM D,@BRCHAR(CDB);	FIX UP BREAK CHARACTER
01200		SOS	IBP(CDB)		;BACK UP TO GET IT NEXT TIME
01300		FOR II←1,4 <
01400		IBP	IBP(CDB)>
01500		AOS	ICOWNT(CDB)
01600		POPJ P,
01700	
01800	; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
01900	NCH:	SOSG ICOWNT(CDB);	DECREMENT CHARACTER COUNT
02000		JRST NCH2
02100	NCH1:	ILDB D,IBP(CDB);	LOAD BYTE
02200		TDNE Z,@IBP(CDB);	CHECK FOR LINE NUMBER
02300		JRST NCH5
02400		JRST (X);		RETURN
02500	
02600	NCH2:	XCT IOIN,SIMIO;		INPUT
02700		JRST NCH1		;ALL OK
02800	NCH7:	MOVEI D,200		;EOF OR DATA ERROR.
02900		JRST (X)
03000	
03100	NCH5:	AOS IBP(CDB);		WE HAVE A LINE NUMBER
03200		MOVNI D,5;		MOVE OVER IT
03300		ADDB D,ICOWNT(CDB)
03400		SKIPLE D;		NOTHING LEFT
03500		JRST NCH;		DO ANOTHER INPUT
03600		XCT IOIN,SIMIO
03700	
03800	NCH6:	SOSG ICOWNT(CDB);	REMOVE TAB
03900		JRST NCH7		;NONE THERE OR ERROR
04000		IBP IBP(CDB)
04100		JRST NCH
04200	
04300	;SETUP FOR STRING INPUT (REALSCAN, INTSCAN)
04400	STRIN:	MOVE LPSA,[JSP X,NCHA]
04500		HRRZ Z,-3(P)
04600		HRRZ Z,-1(Z)
04700		HRRZS -3(P)		;SO CAN INDIRECT THROUGH IT.
04800		PUSHJ P,SCAN
04900		HRRZ X,-3(P)
05000		SOS (X)			;BACK UP BYTE POINTER
05100		FOR II←1,4<
05200		IBP (X)>
05300		AOJ Z,
05400		HRRM Z,-1(X)
05500		MOVEM D,@-2(P)		;STORE BREAK CHARACTER
05600		POPJ P,
05700	
05800	;READ A CHARACTER ROUTINE FOR STRINGS.
05900	NCHA:	SOJL Z,NCH7
06000		ILDB D,@-4(P)
06100		JRST (X)
06200	
     

00100	;SCAN (CALLED BY NUMIN AND STRIN)
00200	
00300	SCAN:	JOV .+1
00400		SETO TEMP,		;FLAG REGISTER.
00500		SETZ	Y,
00600		SETZB A,C;		NUMBER		EXPOENT
00700	MORE:	XCT LPSA;		THIS GETS A CHARACTER IN D,200 IF FO EOF
00800		AHEAD(DIG1,STACK,STACK,STACK,STACK,STACK,DONE)
00900	STACK:	LSHC X,-3;		PUSH SYMBOL ONTO STACK "AC Y"
01000		JRST MORE
01100	
01200	DIG1:	SETZ TEMP,;		FLAG REG.
01300		ASTERN(INT1,FRA1,SIG1,SIG2,EXP1,INT1)
01400	
01500	SIG1:	TRO TEMP,4;		NEGATIVE SIGN
01600	SIG2:	ASTERN(INT1,ERR2,ERR5,ERR5,EXP1,INT1)
01700	
01800	EXP1:	MOVEI A,1
01900		ASTERN(EXP2,ERR2,SIG3,SIG4,ERR1,EXP2)
02000	
02100	SIG3:	MOVNS A
02200	SIG4:	ASTERN(EXP2,ERR2,ERR5,ERR5,ERR1,EXP2)
02300	
02400	FRA1:	TRO TEMP,1;		DECIMAL POINT
02500		SOJ C,
02600		ASTERN(INT1,ERR2,SIG5,SIG6,ERR1,INT1)
02700	
02800	SIG5:	TRO TEMP,4;		NEGATIVE SIGN
02900	SIG6:	ASTERN(INT1,ERR2,ERR5,ERR5,ERR1,INT1)
03000	
03100	EXP2:	HLRE FF,TAB(D);		FIRST DIGIT
03200	EXP5:	XCT LPSA;		GET NEXT CHARACTER
03300	EXP9:	HLRE B,TAB(D)
03400		JUMPL B,EEXP;		NEGATIVE IF NOT A DIGIT
03500		IMULI FF,12
03600		ADD FF,B
03700		JRST EXP5
03800	
03900		XCT LPSA
04000	;;#QD# SEE DONE5: BELOW
04100	EEXP:	AHEAD(EXP9,ERR2,DONE5,DONE5,ERR1,EN,EN)
04200	EN:	TRNE TEMP,4;		SIGN OF EXPONENT
04300		MOVNS FF
04400		ADD C,FF;		FIX UP EXPONENT
04500		JOV ERR3
04600	
04700	;#QD# CHANGE ALL 'ERR5'S IN AHEAD MACROS DO 'DONE5'S, TO AVOID SNARFING EXTRA
04800	;SIGNS ..... RFS 12-15-73 (TWO PLACES BELOW AND ONE ABOVE ALSO)
04900	DONE5:
05000	DONE:	ANDI D,177
05100		JUMPGE TEMP,.+2
05200		SETO D,
05300		POPJ P,
05400	
05500	INT1:	HLRE A,TAB(D);		FIRST DIGIT
05600		TRNE TEMP,4
05700		MOVNS A;		NEGATE IF NECESSARY
05800	INT2:	XCT LPSA;		GET NEXT CHARACTER
05900	INT5:	HLRE B,TAB(D)
06000		JUMPL B,EON;		NEGATIVE IF NOT A NUMBER
06100		TRNE TEMP,1;		IF PASSED DECIMAL POINT THEN DEC EXP BY ONE
06200		SOJ C,
06300		TRNE TEMP,2;		IF ENOUGH DIGITS THEN INC EXP BY ONE
06400	INT3:	AOJA C,INT2
06500		MOVE X,A
06600		IMULI A,12
06700		TRNE TEMP,4;		NEGATE DIGIT IS SIGN NEGATIVE
06800		MOVNS B
06900		ADD A,B
07000		JOV INT4;		CHECK FOR OVERFLOW
07100		JRST INT2;		IF SO USE LAST VALUE
07200	
07300	INT4:	TRO TEMP,2
07400		MOVE A,X
07500		JRST INT3
07600	
07700		XCT LPSA
07800	EON:	AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)
07900	
08000	DP1:	TROE TEMP,1
08100		JRST ERR2
08200		XCT LPSA
08300	;#QD# (SEE DONE5: ABOVE)
08400		AHEAD(INT5,ERR2,DONE5,DONE5,EXP6,DONE,DONE)
08500	
08600	EXP6:	SETZ TEMP,
08700		XCT LPSA
08800		AHEAD(EXP2,ERR2,EXP7,EXP8,ERR1,ERR1,ERR1)
08900	
09000	EXP7:	TRO TEMP,4
09100	EXP8:	XCT LPSA
09200	;#QD# (SEE DONE5: ABOVE)
09300		AHEAD(EXP2,ERR2,DONE5,DONE5,ERR1,ERR1,ERR1)
09400	
09500	ERR1:	ERR(<NUMIN: IMPROPER EXPONENT>,1,RZ)
09600	
09700	ERR2:	ERR(<NUMIN: MISPLACED DECIMAL POINT>,1,RZ)
09800	
09900	ERR3:	ERR(<NUMIN: EXPONENT OUT OF BOUND>,1,RZ)
10000	
10100	ERR5:	ERR(<NUMIN: MISPLACED SIGN>,1,RZ)
10200	
10300	ERROV:	ERR(<NUMIN: NUMBER OUT OF BOUND>,1,RZ)
10400	
10500	RZ:	SETZ A,
10600		JRST DONE
     

00100	;   Character table for SCAN (Realscan,Intscan,Realin,Intin)
00200	TAB:	FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
00300	>
00400		FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
00500	>
00600		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
00700	>
00800	;#QC# MAKE 32 (CONTROL Z) IGNORED
00900		FOR A IN (5,5,0,5,5,5,5,5)<XWD -1,A
01000	>
01100		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
01200	>
01300		FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
01400	>
01500		FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
01600	>
01700		FOR A IN (5,5,5,5,5,5)<XWD -1,A
01800	>
01900		FOR A IN (4,5,5,5,5,5,5,5)<XWD -1,A
02000	>
02100		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02200	>
02300		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02400	>
02500		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02600	>
02700		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
02800	>
02900		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03000	>
03100		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03200	>
03300		FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
03400	>
03500		XWD -1,6
03600	
03700	ENDCOM(NUM)
03800	COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)
     

00100	DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
00200	⊗
00300	
00400	↑↑.CH.:	4
00500		7
00600		16
00700		33
00800		66
00900		153
01000		777777777775
01100		777777777772
01200		777777777763
01300		777777777746
01400		777777777713
01500		777777777626
01600	↑↑.MT.:	240000000000
01700		310000000000
01800		234200000000
01900		276570200000
02000		216067446770
02100		235613266501
02200		314631463147
02300		243656050754
02400		321556135310
02500		253630734215
02600		346453122767
02700		317542172553
02800	↑↑.TEN.:	1
02900		=10
03000		=100
03100		=1000
03200		=10000
03300		=100000
03400		=1000000
03500		=10000000
03600		=100000000
03700		=1000000000
03800		=10000000000
03900	
04000	ENDCOM(TBB)
04100	IFN ALWAYS,<
04200		BEND
04300	>;IFN ALWAYS
04400	COMPIL(WRD,<ARRYOUT,WORDOUT,ARRYIN,WORDIN>
04500		  ,<GETCHN,SAVE,RESTR,GOGTAB,SIMIO,X22,X33,X44,NOTOPN>
04600		  ,<ARRYIN, ARRYOUT, WORDIN, AND WORDOUT>)
     

00100	COMMENT ⊗Arryout, Wordout ⊗
00200	
00300	DSCR ARRYOUT(CHANNEL,@STARTING LOC,EXTENT);
00400	CAL SAIL
00500	⊗
00600	
00700	HERE (ARRYOUT)
00800		PUSHJ	P,SAVE
00900		MOVE	LPSA,[XWD 4,4]
01000	ARO:	MOVE	CHNL,-3(P)
01100		LOADI7	A,<ARRYOUT>
01200		PUSHJ	P,GETCHN
01300	;;%##% CONSIDER THIS
01400	CMU <
01500		SETZM	@ENDFL(CDB)	;CLEAR ERROR FLAG
01600	>;CMU
01700		LDB	TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
01725	CMU <
01730	;;=B4= 1 OF 13 -- FOR CMU SPECIAL MODES.
01740		MOVEI	Z,1		;ASSUME NOT IMP MODE
01755		CAIN	TEMP,3		;IS THE MODE 3?
01770		 TRZA	Z,-1		; YES - CMU 32-BIT IMP MODE.
01777					; WE WILL USE Z BOTH AS SIGNAL AND AS
01780					; A GUARANTEED 0 THAT CAN BE USED FOR A DPB
01790		CAIN	TEMP,4		; (THIS ONE IS CMU-IMAGE MODE)
01792		 JRST	OUTRAY		; THEN OKAY, NOT DUMP MODE EITHER.
01793	;;=B4=
01795	>;CMU
01800		CAIGE	TEMP,10		;MAKE SURE AT LEAST BINARY MODE
02300		 ERR	 <ARRYOUT: mode must be '14,'10, or '17, not >,6
02400		MOVE	0,[XCT IODOUT,SIMIO] ;IN CASE DUMP MODE
02500		CAIL	TEMP,15
02600		 JRST	 ARYDMP		;COMMON DUMP MODE ROUTINE
02700	
02800	OUTRAY:	MOVE	A,-2(P)		;STARTING LOC
02900		SKIPGE	B,-1(P)		;EXTENT
03000		ERR	<ARRYOUT: negative word count, value is>,6
03100	
03200	;;#FQ# DCS 2-6-72 (1-4) COUNT NO LONGER HELD EXCESSIVE
03300	
03400	WOUT2:	SKIPG	E,OCOWNT(CDB)	;# WORDS LEFT IN BUFFER
03500		JRST	WOUT5		;BETTER GET ANOTHER BUFFER
03600		JUMPE	B,RESTR		;NOTHING LEFT TO DO
03625	CMU <
03630	;;=B4= 2 OF 13
03643		CAIN	Z,0		;IMP MODE?
03661		LSH	E,-2		;DIVIDE BY 4 TO GET WORD COUNT
03666	;;=B4=
03679	>;CMU
03700		IBP	OBP(CDB)	;MAKE SURE PTRS TO FIRST WORD
03720	CMU <
03725	;;=B4= 3 OF 13
03740		CAIN	Z,0		;IMP MODE?
03760		DPB	Z,[POINT 6,OBP(CDB),5]
03765	;;=B4=
03780	>;CMU
03800		MOVE	C,OBP(CDB)	;"TO" ADDR
03900		HRRZI	D,(C)		;FOR BLT TERMINATION CALCULATION
04000		HRLI	C,(A)		;"FROM" ADDR
04100		CAIGE	B,(E)		;ENUFF IN BUFFER?? (NOTICE THAT CAIGE
04200					;AS OPPOSED TO CAIG WILL FORCE AN OUTPUT
04300					;IF WE JUST FILL THE BUFFER)
04400		JRST	WOUT3		;YES
04500		ADDI	D,-1(E)		;FINAL ADDR
04600		BLT	C,(D)		;DO IT!
04700		ADDI	A,(E)		;UPDATE PTR
04800		SUBI	B,(E)		;AND COUNT
04900		SETZM	OCOWNT(CDB)
05000		HRRM	D,OBP(CDB)
05100	WOUT5:	XCT	IOOUT,SIMIO	;DO THE OUTPUT
05200		JFCL			;ERRORS HANDLED ALREADY
05300		JRST	WOUT2		;TRY NEXT CHUNK
05400	
05500	WOUT3:	JUMPLE	B,RESTR		;NOTHING TO MOVE
05600		SUBI	B,1
05700		ADD	D,B		;END OF BLOCK
05800		BLT	C,(D)		;MOVE IT
05900		SUBI	E,1(B)		;FIX LENGTH
05920	CMU <
05925	;;=B4= 4 OF 13
05940		CAIN	Z,0		;IMP MODE?
05960		 LSH	E,2		;MULTIPLY BY 4 FOR BYTE COUNT
05965	;;=B4=
05980	>;CMU
06000		MOVEM	E,OCOWNT(CDB)	;
06100		ADDM	B,OBP(CDB)	;FIX BYTE POINTER
06200	;;#FQ# (1-4)
06300		JRST	RESTR		;LEAVE LIKE A TREE AND MAKE
06400	
06500	DSCR WORDOUT(CHAN,VALUE);
06600	CAL SAIL
06700	⊗
06800	
06900	HERE (WORDOUT)			;WRITE ONE WORD
07000		PUSHJ	P,SAVE
07100		MOVE	LPSA,X33
07200		MOVE	CHNL,-2(P)
07300		LOADI7	A,<WORDOUT>
07400		PUSHJ	P,GETCHN
07500	;;%##% CONSIDER THIS
07600	CMU <
07700		SETZM	@ENDFL(CDB)	;CLEAR ERROR FLAG
07800	>;CMU
07900		LDB	A,[POINT 4,DMODE(CDB),35];DATA MODE
08000		CAIL	A,15		;A DUMP MODE?
08100		 JRST	 DMPWO		;WO IS ME, YES
08200	;;#FQ# DCS 2-6-72 (2-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
08300	WDO:	SOSL	OCOWNT(CDB)	;BUFFER FULL?
08400		 JRST	 WOKO		;NO
08500		XCT	IOOUT,SIMIO	;YES, WRITE IT
08600		 JFCL			; ERRORS HANDLED ELSEWHERE
08700		JRST	WDO		;GO BACK AND DO IT RIGHT
08800	WOKO:	MOVE	TEMP,-1(P)	;THING TO BE WRITTEN
08900		IDPB	TEMP,OBP(CDB)	;WRITE IT
09000		JRST	RESTR
09100	
09200	DMPWO:	MOVE	LPSA,[XWD 7,7]	;ACCOUNT FOR EVERYTHING
09300		MOVEI	TEMP,-1(P)	;PNT TO WORD TO BE WRITTEN
09400		PUSH	P,-2(P)		;CHANNEL
09500		PUSH	P,TEMP		;ADDR OF WORD
09600		PUSH	P,[1]		;COUNT
09700		PUSHJ	P,ARO		;JOIN THE ROUTINE (RETAD JUST FOR STACK SYNCH)
09800	;;#FQ# (2-4)
     

00100	COMMENT ⊗Arryin, Wordin ⊗
00200	
00300	DSCR ARRYIN(CHAN,@STARTING LOC,EXTENT);
00400	CAL SAIL
00500	⊗
00600	
00700	HERE (ARRYIN)
00800		PUSHJ	P,SAVE
00900		MOVE	LPSA,X44
01000	ARI:	MOVE	CHNL,-3(P)
01100		LOADI7	A,<ARRYIN>
01200		PUSHJ	P,GETCHN
01300		SETZM	@ENDFL(CDB)	;ASSUME NO END OF FILE
01400		LDB	TEMP,[POINT 4,DMODE(CDB),35] ;CHECK DUMP MODE
01425	CMU <
01427	;;=B4= 5 OF 13
01430		MOVEI	Z,1		;ASSUME NOT IMP MODE
01435		CAIN	TEMP,3		;IS THE MODE 3?
01440		 TRZA	Z,-1		; YES - CMU 32-BIT IMP MODE.
01455		CAIN	TEMP,4		;IF ONE OF THE SPECIAL CMU MODES,
01457		 JRST	INARY		; THEN OKAY, NOT DUMP MODE EITHER
01470	;;=B4=
01490	>;CMU
01500		CAIGE	TEMP,10
02000		 ERR	 <ARRYIN: mode must be '10 or '14 or '17, not >,6
02100		MOVE	0,[XCT IODIN,SIMIO] ;IN CASE DUMP MODE
02200		CAIL	TEMP,15
02300		 JRST	 ARYDMP		;USE COMMON ROUTINE
02400	
02500	;;#FQ# DCS 2-6-72 (3-4) COUNT NO LONGER HELD EXCESSIVE
02600	INARY:	MOVE	A,-2(P)		;STARTING LOC
02700		SKIPGE	B,-1(P)		;EXTENT
02800		ERR	<ARRYIN: negative word count, value is >,6
02900	WIN3:	JUMPE	B,RESTR		;NOTHING LEFT TO DO
03000		SKIPG	E,ICOWNT(CDB)	;#LEFT IN BUFFER
03100		JRST	WIN5
03125	CMU <
03130	;;=B4= 6 OF 13
03150		CAIN	Z,0		;IMP MODE?
03175		 LSH	E,-2		;DIVIDE BY 4 TO GET WORD COUNT
03180	;;=B4=
03187	>;CMU
03200		IBP	IBP(CDB)	;MAKE SURE PTS TO NEXT
03300		HRL	C,IBP(CDB)	;ADDR OF FIRST WORD TO READ
03400		MOVEI	D,(A)		;FOR BLT TERMINATION
03500		HRR	C,A		;"TO" ADDRESS
03600		CAIG	B,(E)		;ENOUGH HERE?
03700		JRST	WIN4		;YES
03800		ADDI	D,-1(E)		;NO, FINISH THIS BUFFER
03900		BLT	C,(D)
04000		ADD	A,E		;FIX INPUT POINTER
04100		SUB	B,E		;FIX INPUT COUNT
04200	WIN5:	XCT	IOIN,SIMIO	;DO INPUT
04300		JRST	WIN3		;OK, GO AHEAD
04400		JRST	WIEOF1		;EOF OR ERROR, LEAVE
04500	
04600	WIN4:	ADDI	D,-1(B)		;FINISH UP
04700		BLT	C,(D)
04800		SUB	E,B		;FIX UP COUNT
04825	CMU <
04830	;;=B4= 7 OF 13
04850		CAIE	Z,0		;IMP MODE?
04862		 JRST	.+3
04875		LSH	E,2		;MULTIPLY BY 4 FOR BYTE COUNT
04881		DPB	Z,[POINT 6,IBP(CDB),5]
04886	;;=B4=
04887	>;CMU
04900		SUBI	B,1		;PREPARE TO CORRECT BP
05000		MOVEM	E,ICOWNT(CDB)	;UPDATE WORDS LEFT
05100		ADDM	B,IBP(CDB)	; POINTER
05200	;;#FQ# (3-4)
05300		JRST	RESTR		;LEAVE
05400	
05500	WIEOF1:	MOVE	TEMP,-1(P)	;#WORDS WANTED -1
05600		SUBM	TEMP,B		;#INPUT IN RH
05700	WIN2:	HRRM	B,@ENDFL(CDB)	;#INPUT IN RH, ERR OR EOF BITS IN LH
05800		JRST	RESTR
05900	
06000	DSCR VALUE←WORDIN(CHAN);
06100	CAL SAIL
06200	⊗
06300	
06400	HERE (WORDIN)			;READ ONE WORD -- USE ARRYIN
06500		PUSHJ	P,SAVE
06600		MOVE	LPSA,X22
06700		LOADI7	A,<WORDIN>
06800		MOVE	CHNL,-1(P)	;CHANNEL NUMBER
06900		PUSHJ	P,GETCHN
07000	;;#FQ# DCS 2-6-72 (4-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
07100		LDB	TEMP,[POINT 4,DMODE(CDB),35];DATA MODE
07200		CAIL	TEMP,15		;DUMP MODE?
07300		 JRST	 DUMPWI		; YES
07400		SETZM	@ENDFL(CDB)
07500	WI:	SOSL	ICOWNT(CDB)
07600		 JRST	 WOKI		;ALL OK
07700		XCT	IOIN,SIMIO
07800		 JRST	 WI		;OK, GO BACK TO KEEP COUNT RIGHT
07900		 TDZA	 A,A		;RETURN 0, WITH ERROR
08000	WOKI:	ILDB	A,IBP(CDB)	;OK, RETURN NEXT WORD
08100		MOVEM	A,RACS+1(USER)	;RESULT
08200		JRST	RESTR
08300	
08400	DUMPWI:	MOVE	LPSA,[XWD 6,6]
08500		MOVEI	TEMP,RACS+1(USER);RESULT GOES HERE
08600		PUSH	P,-1(P)		;CHANNEL
08700		PUSH	P,TEMP		;ADDRESS
08800		PUSH	P,[1]		;1 WORD TRANSFER
08900		PUSHJ	P,ARI		;WON'T RETURN, JUST SYNCH STACK
09000	;;#FQ# (4-4)
09100	
09200	ARYDMP:	
09300		MOVN	TEMP,-1(P)		;-WORD COUNT
09400		JUMPGE	TEMP,[ERR <DUMP MODE WORD COUNT NOT POSITIVE, VALUE IS >,6]
09500		SOS	D,-2(P)			;STARTING ADDR - 1
09600		HRL	D,TEMP			;IOWD -COUNT,STARTING ADDR -1
09700		MOVEI	D+1,0			;TERMINATE THE READ
09800		MOVE	A,[JRST RESTR] ;IF IT SUCCEEDS
09900		MOVE	B,[JRST RESTR] ;IF IT FAILS (EOF OR ERR, ALREADY HANDLED)
10000		JRST	0		;GO DO DUMP I/O
10100	
10200	HERE(WRDSP1)
10300	HERE(WRDSP2)
10400	HERE(WRDSP3)
10500	
10600		ERR	<DRYROT WRD SPARES>
10700	
10800	ENDCOM(WRD)
10900	COMPIL(THR,<INOUT>,<SIMIO,SAVE,RESTR,GETCHN>
11000		,<THROUGH I/O ROUTINE>)
11100	
11200	
11300	COMMENT ⊗ INOUT ⊗
11400	
11500	DSCR INOUT(INCHAN,OUTCHAN,EXTENT);
11600	CAL  SAIL
11700	⊗
11800	
11900	HEREFK (INOUT,.INOUT)
12000		PUSHJ	P,SAVE		;SAVE AC'S,GET GOGTAB
12100		MOVE	LPSA,[XWD 6,6]
12200		MOVE	CHNL,-2(P)	;OUTPUT CH NUMBER
12300		LOADI7	A,<INOUT (OUTPUT SIDE)>
12400		PUSHJ	P,GETCHN
12500		SETZM	@ENDFL(CDB)	;CLEAR ERROR INDICATOR
12600		LDB	TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
12616	CMU <
12621	;;=B4= 8 OF 13
12632		MOVEI	Z,1
12648		CAIN	TEMP,3		;IS THE MODE 3
12664		 TRZA	Z,-1		; YES!!!
12666		CAIN	TEMP,4		;OR CMU IMAGE MODE?
12667		 JRST	.+4		;UGLY, BE CAREFUL OF CODE CHANGES!
12669	;;=B4=
12680	>;CMU
12700		CAIL	TEMP,10		;MUST BE BINARY MODE
12800		CAILE	TEMP,14		;AND NOT DUMP MODE
12900		ERR	<INOUT (OUTPUT SIDE): ILLEGAL DATA MODE:>,6
13000		PUSH	P,CDB		;SAVE - 
13100		PUSH	P,CHNL		;WELL DO IT AGAIN
13200		MOVE	CHNL,-5(P)		;SEE...
13300		LOADI7	A,<INOUT (INPUT SIDE)>
13400		PUSHJ	P,GETCHN	;DO YOUR THING
13500		SETZM	@ENDFL(CDB)	;CLEAR ERROR INDICATOR
13600		LDB	TEMP,[POINT 4,DMODE(CDB),35]
13616	CMU <
13621	;;=B4= 9 OF 13
13632		MOVEI	Y,1
13648		CAIN	TEMP,3		;IS THE MODE 3
13664		 TRZA	Y,-1		;YES!!!
13666		CAIN	TEMP,4		;OR CMU IMAGE MODE
13668		 JRST	.+4		;CAREFUL OF RELATIVE JUMPS!
13669	;;=B4=
13680	>;CMU
13700		CAIL	TEMP,10
13800		CAILE	TEMP,14
13900		ERR	<INOUT (INPUT SIDE): ILLEGAL DATA MODE:>,6
14000		SKIPGE	B,-3(P)		;# OF WORDS
14100		HRLOI	B,377777	;ARBITRARILY LARGE NUMBER OF WDS
14200	TH1:	JUMPE	B,RESTR		;NO MORE TO DO
14300		SKIPG	E,ICOWNT(CDB)	;#OF WORDS IN BUFFER
14400		JRST	TH5		;BETTER GET SOME MORE
14420	CMU <
14425	;;=B4= 10 OF 13
14440		CAIN	Y,0		;IMP MODE?
14460		 LSH	E,-2		;DIVIDE BY 4 TO GET WORD COUNT
14465	;;=B4=
14480	>;CMU
14500		IBP	IBP(CDB)	;MAKE SURE POINT TRIGHT
14600		HRL	C,IBP(CDB)	;INPUT POINTER
14700		EXCH	CHNL,(P)	;NOW FREEN OUTPUT STUFF
14800		EXCH	CDB,-1(P)
14900		SKIPG	OCOWNT(CDB)	;SOME LEFT
15000		XCT	IOOUT,SIMIO
15100		SKIPA
15200		JRST	THERR
15300		IBP	OBP(CDB)
15400		HRR	C,OBP(CDB)	;OUTPUT POINTER
15500		CAML	E,B		;FIND # OF WORDS
15600		MOVE	E,B		;TO BLIT
15650	NOCMU <
15655	;;=B4= 11 OF 13
15700		CAML	E,OCOWNT(CDB)	;=MIN(B,ICOWNT,OCOWNT)
15800		MOVE	E,OCOWNT(CDB)
15805	>;NOCMU
15850	CMU <
15855		CAMGE	E,OCOWNT(CDB)	;=MIN(B,ICOWNT,OCOWNT)
15860		JRST	.+4
15865		MOVE	E,OCOWNT(CDB)
15875		CAIN	Z,0		;IMP MODE?
15887		LSH	E,-2		;DIVIDE BYTE COUNT BY 4
15890	;;=B4=
15893	>;CMU
15900		MOVEI	D,(C)		;MAKE BLT TERMINATOR
16000		ADDI	D,-1(E)		;FINAL ADDRESS
16100		BLT	C,(D)		;CHOMP CHOMP
16200		SUB	B,E		;WE'VE DONE THESE
16300		MOVEI	A,-1(E)		;TO UPDATE BYTE POINTER
16400		ADDM	A,OBP(CDB)	;TOLD YOU SO
16414	CMU <
16419	;;=B4= 12 OF 13
16428		CAIE	Z,0		;IMP MODE?
16442		 JRST	.+3
16456		LSH	E,2		;MULTIPLY BY 4 FOR BYTE COUNT
16470		DPB	Z,[POINT 6,OBP(CDB),5]
16475	;;=B4=
16484	>;CMU
16500		SUBM	E,OCOWNT(CDB)	;UPDATE WORD COUNT
16600		MOVNS	OCOWNT(CDB)	;CLEVER,EH?
16700	TH6:	EXCH	CHNL,(P)	;BACK TO INPUT SETUP
16800		EXCH	CDB,-1(P)
16900		ADDM	A,IBP(CDB)	;UPDATE INPUT PTR
16914	CMU <
16919	;;=B4= 13 OF 13
16928		CAIE	Y,0		;IMP MODE?
16942		 JRST	.+3
16956		LSH	E,2		;MULTIPLY BY 4 FOR BYTE COUNT
16970		DPB	Y,[POINT 6,IBP(CDB),5]
16975	;;=B4=
16984	>;CMU
17000		SUBM	E,ICOWNT(CDB)	;UPDATE WORD COUNT
17100		MOVNS	ICOWNT(CDB)	;SUBTRACTION WAS BACKWARDS
17200		JRST	TH1		;MORE OF SAME
17300	TH5:	XCT	IOIN,SIMIO	;DO SOME INPUT
17400		JRST	TH1		;NOW GO PLAY
17500	THERR:	SKIPGE	TEMP,-3(P)	;# THE GUY WANTED
17600		HRLOI	TEMP,377777	;IT WAS A FUDGE
17700		SUB	TEMP,B		;SUBTRACT #LEFT TO GET
17800		HRRM	TEMP,@ENDFL(CDB);#HE GOT
17900		JRST	RESTR
18000	
18100	ENDCOM(THR)
18200	COMPIL(LIN,<LINOUT>,<SIMIO,SAVE,RESTR,GETCHN,X33>,<LINOUT ROUTINE>)
     

00100	COMMENT ⊗Linout ⊗
00200	
00300	DSCR LINOUT(CHANNEL,VALUE);
00400	CAL SAIL
00500	⊗
00600	
00700	HERE (LINOUT)
00800		PUSHJ	P,SAVE
00900		MOVE	CHNL,-2(P)	;CHANNEL
01000		LOADI7	A,<LINOUT>
01100		PUSHJ	P,GETCHN	;CHANNEL DATA
01200		MOVE	TEMP,OBP(CDB)	;ADJUST TO FULL WORD
01300		HRRZ	A,OCOWNT(CDB)	;DON'T FORGET COUNT
01400	LINOLP:	TLNN	TEMP,760000	;LINED UP?
01500		 JRST	 OKLIGN		; YES
01600		IBP	TEMP		;0 WILL BE THERE
01700		SOJA	A,LINOLP
01800	
01900	OKLIGN:	MOVEM	TEMP,OBP(CDB)
02000		MOVEM	A,OCOWNT(CDB)	;REPLACE UPDATED THINGS
02100		CAIGE	A,=10		;ENOUGH ROOM FOR 2 WORDS?
02200		 XCT	 IOOUT,SIMIO	;NO, OUTPUT
02300		 JFCL			;IN CASE OUTPUT HAPPENED
02400	
02500		SKIPGE	B,-1(P)		;GET LINE NUMBER
02600		 JRST	 [MOVNS B
02700			  MOVNI A,5	;ONLY PUT OUT 5 CHARS
02800			  JRST NOCONV]	;WAS GIVEN TO US IN TOTO
02900		MOVNI	A,6		;PUT OUT TAB AFTER
03000		MOVE	C,[<ASCII /00000/>/2] ;TO MAKE 5
03100		EXCH	B,C
03200		PUSH	P,LNBAK		;RETURN ADDR
03300	LNCONV:	IDIVI	C,=10
03400		IORI	D,"0"
03500		DPB	D,[POINT 7,(P),6]
03600		SKIPE	C		;THE RECURSIVE PRINTER
03700		PUSHJ	P,LNCONV
03800		HLL	C,(P)		;ONE CHAR, LEFT JUST
03900		LSHC	B,7
04000	LNBAK:	POPJ	P,.+1
04100		LSH	B,1
04200		TRO	B,1
04300	NOCONV:	AOS	C,OBP(CDB)	;MOVE OUT A WORD
04400		MOVEM	B,(C)
04500		ADDM	A,OCOWNT(CDB)	;UPDATE COUNT
04600		MOVEI	B,11
04700		CAME	A,[-5]
04800		 IDPB	 B,OBP(CDB)	;OUTPUT A TAB
04900	NOTAB:	MOVE	LPSA,X33
05000		JRST	RESTR		;THAT'S IT
05100	
05200	ENDCOM(LIN)
05300	COMPIL(BRK,<BREAKSET,SETBREAK,STDBRK>
05400		  ,<SAVE,RESTR,BRKMSK,SIMIO,GOGTAB,X22,X33>
05500		  ,<BREAKSET, SETBREAK, STDBRK ROUTINES>)
     

00100	COMMENT ⊗Breakset ⊗
00200	
00300	DSCR BREAKSET(TABLE #,"STRING",WAY);
00400	CAL SAIL
00500	⊗
00600	
00700	HERE (BREAKSET)
00800		PUSHJ	P,SAVE		;SAVE ACS AND THINGS
00900		MOVE	LPSA,X33
01000		SUB	SP,X22
01100		SKIPLE	A,-2(P)		;TABLE #
01200		CAILE	A,=18
01300		ERR	<THERE ARE ONLY 18 BREAK TABLES>
01400		HLLZ	B,BRKMSK(A)	;BREAK MASK FOR THIS TABLE
01500		ADD	A,USER
01600		MOVE	C,[ANDCAM B,(D)]  ;USUAL CLEARING INSTR
01700		LDB	X,[POINT 4,-1(P),35] ;COMMAND
01800		TRZN	X,10		  ;LEFT OR RIGHT HALF OF TABLE?
01900		SKIPA	X,BKCOM(X)	  ;RIGHT HALF
02000		HLRZ	X,BKCOM(X)	  ;LEFT HALF
02100		JRST	(X)		  ;DISPATCH
02200	
02300	BKCOM:	XWD	XCLUDE,PASLINS	;X,,P
02400		XWD	INCL,PENDCH	;I,,A
02500		XWD	ILLSET,RETCH	;-,,R
02600	;;%##% ADD BREAK MODE FOR COERCIONS
02700		XWD	UCASE,SKIPCH	;K,,S
02800		XWD	BRKLIN,RESTR	;L,,D
02900		XWD	ILLSET,ERMAN	;-,,E
02950	;;%BG% ! ADD WAY TO UNDO "K"
03000		XWD	NOLINS,LCASE	;N,,F
03100		XWD	OMIT,ILLSET	;O,,-
03200	
03300	ILLSET:	ERR	<ILLEGAL COMMAND TO BREAKSET>,1
03400		JRST	RESTR
03500	
03600	XCLUDE:	SKIPA	C,[IORM B,(D)]	;YES, SET ALL TO 1 TO INITIALIZE
03700	OMIT:	MOVSS	B		;OMIT, PUT BIT IN RH
03800	INCL:	MOVSI	D,-200
03900		HRRI	D,BRKTBL(USER)	;RELOCATABLE IOWD
04000	BRKLUP:	XCT	C		;CLEAR (OR SET) PROPER (HALF OF PROPER) TABLE
04100		AOBJN	D,BRKLUP
04200		MOVE	C,[IORM B,BRKTBL(D)]	;USUAL SETTING INSTR
04300		CAIN	X,XCLUDE	;BY EXCEPTION?
04400		MOVE	C,[ANDCAM B,BRKTBL(D)] ;YES, WANT TO TURN OFF BITS
04500		ADDI	C,(USER)	;RELOCATE IT
04600		HRRZ	A,1(SP)		;LENGTH OF STRING
04700		MOVE	X,2(SP)		;BYTE POINTER
04800		JRST	BRKL2
04900	BRKL1:	ILDB	D,X		;GET A CHAR
05000		XCT	C		;DO RIGHT THING TO RIGHT BIT
05100	BRKL2:	SOJGE	A,BRKL1
05200		JRST	RESTR
05300	
05400	PASLINS: TDZA	B,B		;PASS LINE NOS. SINE COMMENT
05500	NOLINS:	MOVEI	B,-1		;INFORM IN THAT IT SHOULD 
05600		MOVEM	B,LINTBL(A)	;  DELETE LINE NOS.
05700		JRST	RESTR
05800	
05900	BRKLIN:	SKIPA	B,[-1]		;MARK BREAK ON LINE NOS. FOR THIS TBL
06000	ERMAN:	MOVSI	B,-1		;LH NEG SIGNALS ERMAN'S SCHEME
06100		MOVEM	B,LINTBL(A)
06200		JRST	RESTR
06300	
06400	PENDCH:	SETOM	DSPTBL(A)	;APPEND TO END OF INPUT
06500		JRST	RESTR
06600	
06700	SKIPCH:	TDZA	B,B		;CHAR NEVER APPEARS IN INPUT STRING
06800	RETCH:	MOVEI	B,-1		;RETAIN FOR NEXT TIME
06900		MOVEM	B,DSPTBL(A)
07000		JRST	RESTR
07100	
07200	;;%##%
07300	UCASE:	MOVSS	B	;INTO RIGHT HLF
07400		IORM	B,BRKCVT(USER)
07500		JRST	RESTR
07512	
07525	;;%BG% =A1=
07700	LCASE:	MOVSS	B
07800		ANDCAM	B,BRKCVT(USER)
07900		JRST	RESTR
     

00100	COMMENT ⊗Setbreak 
00200	
00300	  TBL IS AS IN BREAKSET
00400	  BRKSTRNG IS USED FOR ANY "I" OR "X" APPEARING IN MODESTRNG
00500	  OMITSTRNG (IF NOT NULL) IS USED TO SET THE "OMIT" SIDE OF THE TABLE
00600	  MODESTRNG CAN CONTAIN ANY OF THE VALID BREAKSET "MODE" CHARACTERS
00700	     I,X,O,N,R,A,P, or S.
00800	This function is not attainable by the user unless he declares it.
00900	⊗
01000	
01100	DSCR SETBREAK(TABLE,"BREAKSTRING","OMITSTRING",MODESTRING");
01200	CAL SAIL
01300	⊗
01400	
01500	HERE (SETBREAK)
01600		HRRZ	TEMP,-3(SP)		;DO OMIT STRING, IF PRESENT
01700		JUMPE	TEMP,NO.O		;NULL STRING DOESN'T COUNT
01800		PUSH	P,-1(P)			;TABLE #
01900		PUSH	SP,-3(SP)		;OMIT CHARACTERS
02000		PUSH	SP,-3(SP)
02100		PUSH	P,["O"]			;OMIT!
02200		PUSHJ	P,BREAKSET		;DO THAT
02300	NO.O:	HRRZS	-1(SP)			;COUNT OF # OF COMMANDS
02400	BKSLUP:	SOSGE	-1(SP)		;DONE?
02500		 JRST	 BKSDUN			; YES
02600		PUSH	P,-1(P)			;TABLE #
02700		ILDB	TEMP,(SP)		;COMMAND
02800		PUSH	P,TEMP
02900		PUSH	SP,-5(SP)
03000		PUSH	SP,-5(SP)		;STRING TO USE IF NECESSARY
03100		PUSHJ	P,BREAKSET
03200		JRST	BKSLUP			;DO IT -- AGAIN
03300	
03400	BKSDUN:	SUB	P,X22
03500		SUB	SP,[XWD 6,6]
03600		JRST	@2(P)
03700	
     

00100	COMMENT ⊗Stdbrk ⊗
00200	
00300	DSCR STDBRK(CHANNEL);
00400	CAL SAIL
00500	⊗
00600	
00700	HERE (STDBRK)
00800		PUSHJ	P,SAVE
00900		MOVE	LPSA,X22
01000		MOVE	CHNL,-1(P)
01100		MOVEI	CDB,D-DMODE		;SO WE CAN USE SIMIO'S OPEN
01200		MOVEI	D,17			;DUMP MODE
01300		MOVE	D+1,['SYS   ']
01400		MOVEI	D+2,0			;NO HEADERS
01500		XCT	IOOPEN,SIMIO		;DO THE OPEN
01600		 ERR	 <DSK NOT AVAILABLE?>
01700		MOVEI	USER,D-FNAME		;SO WE CAN USE SIMIO'S LOOKUP
01800		MOVE	D,['BKTBL ']
01900		MOVE	D+1,['BKT   ']		;FUNNY NAME AND EXTENSION
02000		SETZB	D+2,D+3
02100		XCT	IOLOOKUP,SIMIO		;DO THE LOOKUP
02200		ERR	<Standard break table not available>
02300		MOVE	USER,GOGTAB
02400		MOVEI 	D,DSPTBL-1(USER)
02500		HRLI	D,-(=19+=19+=128)	;IOWD SIZE,LOC
02600		MOVEI	D+1,0			;TERMINATE COMMAND LIST
02700		XCT	IODIN,SIMIO		;DO THE INPUT
02800		SKIPA				;ALL WENT WELL
02900		ERR	<Error reading standard break table>
03000	;; XCT IORELEASE NOW TAKES INHIBIT BITS IN RH OF D
03100		MOVEI	D,0			;NO INHIBIT BITS TO RELEASE
03200		XCT	IORELEASE,SIMIO		;RELEASE FILE
03300		JRST	RESTR
03400	
03500	HERE(BRKSP1)				; SPARES *******
03600	HERE(BRKSP2);
03700		ERR	<DRYROT IN BRK SPARES>
03800	ENDCOM(BRK)
03900	COMPIL(CLS,<CLOSIN,CLOSO,CLOSE>,<SAVE,RESTR,SIMIO,X22>,<CLOSE ROUTINES>)
     

00100	COMMENT ⊗Close, Closin, Closo
00200	  CLOSE(CHAN)     
00300	
00400	CLOSIN closes only the input side
00500	CLOSO closes only the output side
00600	
00700	⊗
00800	DSCR CLOSIN(CHAN)
00900	CAL SAIL
01000	⊗
01100	
01200	HERE (CLOSIN) PUSHJ	P,SAVE		;CLOSE INPUT ONLY
01300		MOVEI	D,1
01400		JRST	CLSS
01500	
01600	DSCR CLOSO(CHANNEL);
01700	CAL SAIL
01800	⊗
01900	HERE (CLOSO)	
02000		PUSHJ	P,SAVE		;CLOSE OUTPUT ONLY
02100		MOVEI	D,2
02200		JRST	CLSS
02300	DSCR CLOSE(CHANNEL);
02400	CAL SAIL
02500	⊗
02600	.CLS:
02700	HERE (CLOSE)				;CLOSE BOTH
02800		PUSHJ	P,SAVE		;SAVE ACS AND THINGS
02900		MOVEI	D,0
03000	CLSS:	MOVE	CHNL,-1(P)
03100		MOVE	LPSA,X22
03200		CHKCHN	CHNL,<CLOSE>	;VERIFY OK CHANNEL
03300		SKIPN	CDB,@CDBLOC(USER) ;GET CDB
03400		 JRST	 RESTR		;NOT OPEN, DON'T CLOSE
03500		XCT	IOCLOSE,SIMIO	;CLOSE CHAN,SPEC
03600		SETZM	INAME(CDB)
03700		SETZM	ONAME(CDB)	;NO FILE NAMES OPEN
03800		JRST	RESTR		;RETURN
03900	
04000	ENDCOM(CLS)
04100	COMPIL(MTP,<MTAPE,USETI,USETO,RENAME>
04200		  ,<SAVE,RESTR,GETCHN,SIMIO,FILNAM,X22,X33,X44>
04300		  ,<MTAPE, USETI, USETO, RENAME ROUTINES>)
     

00100	COMMENT ⊗Mtape ⊗
00200	
00300	DSCR MTAPE(CHANNEL,MODE);
00400	CAL SAIL
00500	⊗
00600	
00700	.MTP:
00800	HERE (MTAPE)
00900		PUSHJ	P,SAVE
01000		MOVE	LPSA,X33
01100		MOVE	CHNL,-2(P)		;CHANNEL NUMBER
01200		LOADI7	A,<MTAPE>
01300		PUSHJ	P,GETCHN
01400		LDB	C,[POINT 5,-1(P),35]	;PART OF COMMAND CHAR
01500	EXPO <
01600		MOVEI	B,101
01700		CAIN	C,11			;MTAPE "I" DOES SPECIAL THINGS.
01800		 JRST	 MTAPQ			;GO SET IBM COMPABILITY MODE
01900	>;EXPO
02000	;;%##%	ALLOW MTAPE(NULL) TO DO A MTAPE 0 -- WAIT
02100		MOVEI	B,0
02200		JUMPE	C,MTAPQ			;THIS IS DEFINITELY NOT A NO-OP
02300		MOVE	A,OPTAB			;COMMAND BITS
02400		MOVE	B,OPTAB+1		;MORE
02500		TRZE	C,30			;COMPRESS TABLE
02600		ADDI	C,5
02700		LSH	C,2			;EACH COMMAND IS 4 BITS
02800		ROTC	A,(C)			;GET RIGHT COMMAND
02900		ANDI	B,17			;DO IF SYSTEM DOESN'T
03000		JUMPE	B,[ERR	<MTAPE: ILLEGAL CODE>,1
03100			JRST	RESTR]
03200	MTAPQ:	HRLI	B,(<MTAPE>)		;CREATE MTAPE OPERATION
03300		DPB	CHNL,[POINT 4,B,12]
03400	;%##%	TRNE	B,-1			;IS THERE AN OPERATION?
03500		XCT	B			;YES, DO IT
03600		JRST	RESTR
03700	
03800	OPTAB:	BYTE (4) 16,17,0,0,3,6,7,13,10	;A,B,,,E,F,R,S,T
03900		BYTE (4) 11,0,1			;U,,W
     

00100	COMMENT ⊗ Useti, Useto, Rename ⊗
00200	
00300	DSCR USETI,USETO(CHANNEL,BLOCK #);
00400	CAL SAIL
00500	⊗
00600	
00700	HERE (USETI)
00800	↑↑.USETI:
00900		SKIPA	LPSA,[XCT IOSETI,SIMIO]	;USETI
01000	HERE (USETO)
01100	↑↑.USETO:
01200		MOVE	LPSA,[XCT IOSETO,SIMIO] ;USETO
01300		PUSHJ	P,SAVE
01400		MOVE	CHNL,-2(P)
01500		LOADI7	A,<USET>
01600		PUSHJ	P,GETCHN
01700		MOVE	A,-1(P)			;VALUE TO USETO
01800		MOVE	LPSA+1,[JRST .+2]	;BE ABLE TO GET BACK
01900		JRST	LPSA			;GO TO USETI/O
02000		MOVE	LPSA,X33
02100		JRST	RESTR
02200	
02300	DSCR RENAME(CHANNEL,"NEW NAME",PROTECTION,@FAILURE FLAG);
02400	CAL SAIL
02500	⊗
02600	
02700	HERE (RENAME)
02800	↑↑.RENAME:
02900		PUSHJ	P,SAVE
03000		SETZM	@-1(P)
03100		MOVE	LPSA,X44
03200		LOADI7	A,<RENAME>
03300		MOVE	CHNL,-3(P)
03400		PUSHJ	P,GETCHN
03500		PUSHJ	P,FILNAM	;PARSE FILENAME SPEC
03600		 JRST	 BDSPC		;SPECIFICATION NO GOOD
03700		MOVE	TEMP,-2(P)
03800		ROT	TEMP,-=9
03900		MOVEM	TEMP,FNAME+2(USER)
04000		XCT	IORENAME,SIMIO	;DO THE RENAME
04100		 JRST	 RNERR		;NO GOOD
04200		JRST	RESTR
04300	BDSPC:	HRRZ	TEMP,ERRTST(CDB)	;SEE IF
04400		TRNE	TEMP,10000		;WILLING TO HANDLE ERROR
04500		ERR	<RENAME: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
04600		SKIPA	TEMP,[=8]		;ALWAYS REPORT CODE
04700	RNERR:	HRRZ	TEMP,FNAME+1(USER)	;RETURN HORSESHIT NUMBER
04800		HRROM	TEMP,@-1(P)		;TO THE USER
04900		JRST	RESTR
05000	
05100	ENDCOM(MTP)
05200	COMPIL(USC,<USERCON>,<SAVE,RESTR,GOGTAB>,<USERCON ROUTINE>)
     

00100	COMMENT ⊗Usercon ⊗
00200	
00300	DSCR USERCON(@INDEX,@SETGET,FLAG);
00400	CAL SAIL
00500	PAR INDEX is USER-table displacement (usually obtained from HEAD.REL)
00600	 SETGET is used to communicate USER table values
00700	 FLAG is "OPCODE" input to USERCON
00800	RES The INDEXth USER table entry is accessed (GLUSER table if FLAG negative).
00900	 On exit, SETGET contains old value of this entry.
01000	 If FLAG is odd, the original SETGET value replaces this entry.
01100	⊗
01200	
01300	CMU <
01400	GGAS <
01500	IFE ALWAYS, <EXTERNAL GLUSER>
01600	>;GGAS
01700	>;CMU
01800	
01900	HERE(USERCON)
02000		PUSHJ	P,SAVE
02100		MOVE	LPSA,[XWD 4,4]
02200		MOVE	A,-1(P)		;THE FLAG
02300	CMU < GGGON
02400	>;CMU
02500	GLOB <
02600		MOVEI	B,ENDREN
02700		JUMPL	A,[MOVEI USER,GLUSER
02800			   MOVEI B,ZAPEND ;USE GLOBAL TABLE
02900			   JRST .+1]
03000		SKIPL	C,-3(P)		;THE INDEX
03100		CAML	C,B
03200	>;GLOB
03300	NOGLOB <
03400		SKIPL	C,-3(P)		;THE INDEX
03500		CAIL	C,ENDREN	;CHECK BOUNDS
03600	>;NOGLOB
03700		ERR	<USERCON: index out of bounds >,7,RESTR
03800		ADD	C,USER		;POINT AT CORRECT ENTRY
03900		MOVE	B,(C)		;GET OLD VALUE
04000		MOVE	D,@-2(P)	;(PERHAPS) NEW VALUE
04100		TRNE	A,1		;STORE NEW VALUE?
04200		MOVEM	D,(C)		;YES
04300		MOVEM	B,@-2(P)	;RETURN OLD VALUE
04400	GLOB <
04500		MOVE	USER,GOGTAB	;RESET
04600	>;GLOB
04700		JRST	RESTR
04800	CMU < GGGOFF
04900	>;CMU
05000	ENDCOM(USC)
     

00100	COMMENT ⊗Ttyuuo functions ⊗
00200	
00300	DSCR TTYUUO FUNCTIONS
00400	CAL SAIL
00500	⊗
00600	
00700	Comment ⊗
00800	INTEGER PROCEDURE INCHRW;
00900	 RETURN A CHAR FROM TTCALL 0,
01000	
01100	INTEGER PROCEDURE INCHRS;
01200	 RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (TTCALL 2,)
01300	
01400	STRING PROCEDURE INCHWL;
01500	 WAIT FOR A LINE, THEN RETURN IT (TTCALL 4, FOLLOWED BY TTCALL 0'S)
01600	
01700	STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
01800	 FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0, 
01900		STR←LINE (TTCALL 5, FOLLOWED BY TTCALL 0'S)
02000	
02100	STRING PROCEDURE INSTR(INTEGER BRCHAR);
02200	 RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (TTCALL 0'S)
02300	
02400	STRING PROCEDURE INSTRL(INTEGER BRCHAR);
02500	 WAIT FOR ONE LINE, THEN DO INSTR (TTCALL 4, FOLLOWED BY INSTR)
02600	
02700	STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
02800	 FLAG←-1, STR←NULL IF NO LINES, ELSE FLAG←0, 
02900	  STR←INSTR(BRCHAR)
03000	
03100	
03200	PROCEDURE OUTCHR(INTEGER CHAR);
03300	 OUTPUT CHAR (TTCALL 1)
03400	
03500	PROCEDURE OUTSTR(STRING STR);
03600	 OUTPUT STR (TTCALL 3)
03700	
03800	
03900	PROCEDURE CLRBUF;
04000	 CLEARS INPUT BUFFER (TTCALL 11,)
04100	
04200	TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
04300	 TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
04400	 ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
04500	 TTYINL DOES A WAIT FOR LINE FIRST.
04600	 FULL BREAKSET CAPABILITIES EXCEPT FOR 
04700	 "R" MODE (AND OF COURSE, LINE NUM. STUFF)
04800	
04900		TITLE	TTYUUO
05000	⊗
05100	
05200	;;%##% ADD TTYUP TO ALL THIS
05300	COMPIL(TTY,<INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,TTYUP
05400	ENTINT	<INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL>>
05500	  ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.,.SONTP>
05600		  ,<TELETYPE FUNCTIONS>)
05700	;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
05800	; .SKIP. EXTERNAL ABOVE
05900	;;#GF#
06000	
06100	EXPO <
06200	IFE ALWAYS,<
06300	EXTERN OTSTRBF
06400	>;IFE ALWAYS
06500	>;EXPO
06600	
06700	;;%##% FOR TTYUP THING
06800	DEFINE KONVERT(AC) <
06900		SKIPN	TTYCVT(USER)
07000		JRST	.+5
07100		CAIL	AC,"a"
07200		CAILE	AC,"z"
07300		JRST	.+2
07400		TRZ	AC,40	;FORCE TO BE LOWER CASE
07500	>
     

00100	
00200	HERE (INCHRW)	TTCALL	A
00300	;;%##%
00400		MOVE	USER,GOGTAB
00500		KONVERT	(A)
00600		POPJ	P,
00700	
00800	HERE (INCHRS)	TTCALL	2,A		;SKIP IF CHAR WAITING
00900		MOVNI	A,1		;ELSE RETURN -1
01000	;;%##%
01100		MOVE	USER,GOGTAB
01200		KONVERT(A)
01300		POPJ	P,
01400	
01500	HERE (OUTCHR)	TTYUUO	1,-1(P)		;OUTPUT THE PARAMETER
01600		SUB	P,X22		;REMOVE PARAMETER
01700		JRST	@2(P)
01800	
01900	HERE (OUTSTR)
02000	;;#FO# 11-18-71 DCS (1-2)
02100	EXPO <
02200	;;#FO#
02300	;;#HC# 5-11-72 DCS MAKE OUTSTR BETTER IN EXPO VERSION (DUE TO LDE)
02400	;;#MM# 5-25-73 ! MAKE SURE ITS LOADED BEFORE WE USE IT
02500		MOVE 	USER,GOGTAB
02600		EXCH	A,-1(SP)		;LENGTH OF STRING
02700		HRRZS	A			; REALLY
02800		EXCH	B,(SP)			;PTR TO THE STRING
02900		PUSH	P,C			;NEED ANOTHER AC
03000		JUMPLE	A,OU.OUT		;DON'T DO ANYTHING
03100	OSLOOP:	MOVE	C,A
03200		SUBI	A,14*5-1		;# CHARS/CHOMP
03300		SKIPLE	A			;LOTS LEFT??
03400		MOVEI	C,14*5-1		; YES,
03500	;;%##% BETTER PLACE THAN SGACS
03600		MOVE	LPSA,[POINT 7,OTSTRBF];AS GOOD A PLACE AS ANY
03700		ILDB	TEMP,B
03800		SKIPE	TEMP			;NULL??
03900		IDPB	TEMP,LPSA		; NO
04000		SOJG	C,.-3
04100		MOVEI	TEMP,0			;A NULL FOR THE END
04200		IDPB	TEMP,LPSA
04300		TTCALL	3,OTSTRBF		;RAISON D'ETRE
04400		JUMPG	A,OSLOOP
04500	OU.OUT:	POP	SP,B
04600		POP	SP,A
04700		POP	P,C
04800		POPJ	P,
04900	;;#HC#
05000	;;#FO# 11-18-71 DCS (2-2) MAKE OUTSTR WORK EFFICIENTLY USING TTYMES (STANFO ONLY)
05100	>;EXPO
05200	NOEXPO <
05300		HLRZ	TEMP,(SP)		;SIZE/POSITION FIELDS OF BP
05400		TRZ	TEMP,7777		;CLEAR SIZE FIELD
05500		OR	TEMP,-1(SP)		;POSITION, COUNT IN RH FOR DDTOUT
05600		TRNN	TEMP,7777		;IF NULL STRING, QUIT
05700		 JRST	 QUIT
05800		HRLM	TEMP,(SP)
05900		MOVE	TEMP,[SIXBIT /TTY/]	;DEVICE FOR TTYMES
06000		MOVEM	TEMP,-1(SP)
06100		MOVEI	TEMP,-1(SP)		;POINT AT SPEC
06200		CALLI	TEMP,400047		;WRITE FIRST CHAR FOR LENGTH CHARS
06300	;THIS IS THE SPECIAL TTYMES UUO AS PROVIDED BY HELLIWELL
06400		 JFCL				;IT HAS BEEN KNOW TO SKIP-RETURN
06500	QUIT:	SUB	SP,X22			;REMOVE THE ARGUMENT
06600	>;NOEXPO
06700	;;#FO#
06800		POPJ	P,			;DONE
06900	
07000	TTWCHR←←=100	;MAX NUMBER OF CHARS ON TTY INPUT
07100	CMU <		;EXCEPT WE HAVE LARGER INPUT BUFFERS
07200	TTWCHR←←=140
07300	>;CMU
07400	REDSTR:	SKIPE	SGLIGN(USER)
07500		PUSHJ	P,INSET
07600		MOVEI	A,TTWCHR
07700		ADDM	A,REMCHR(USER)
07800		SKIPLE	REMCHR(USER)
07900		PUSHJ	P,STRNGC
08000		MOVNI	A,TTWCHR
08100		PUSH	SP,[0]		;NULL STRING IF NOTHING DONE
08200		PUSH	SP,TOPBYTE(USER)
08300		POPJ	P,
08400	
08500	FINSTR:	CAIN	TEMP,15	;REMOVE LFD IF CR BROKE IT
08600		TTCALL	TEMP
08700	FINS1:	ADDM	A,REMCHR(USER)	;NUMBER NOT USED
08800		ADDI	A,TTWCHR		;NUMBER USED
08900	;;#GI# DCS 2-5-72 REMOVE TOPSTR
09000	;;%##% ALLOW FOR ITERATIVE GETTING OF TTWCHR CHARS
09100		HRROS  -1(SP)		; TO STRING COUNT WORD
09200		ADDM	A,-1(SP)	;UPDATE COUNT WORD
09300	;;#GI#
09400		JRST	RESTR
09500	
09600	HERE (INSTR) PUSHJ	P,SAVE
09700		PUSHJ	P,REDSTR
09800		MOVE	B,-1(P)		;BREAK CHAR
09900		MOVE	LPSA,X22	;# TO REMOVE
10000	
10100	INS1:	PUUO	0,TEMP		;NEXT CHAR
10200	;;%##%
10300		KONVERT	(TEMP)		;**** CONVERT BEFORE TEST BREAKEDNESS *****
10400	INS2:	CAMN	TEMP,B		;BREAK?
10500		 JRST	 FINSTR		; YES, ALL DONE
10600		IDPB	TEMP,TOPBYTE(USER) ;PUT IT AWAY AND
10700	;;%  %  LDE  BETTER NOT READ IN TOO MANY CHARACTERS
10800		AOJL	A,INS1		; IF ROOM, GO BACK FOR MORE
10900		PUSHJ	P,CHRMOR	;MAKE ROOM, THEN GO BACK
11000		JRST	INS1		;
11100	
11200	HERE (INCHWL)	PUSHJ	P,SAVE
11300		PUSHJ	P,REDSTR
11400		MOVE	LPSA,X11
11500		TTCALL	4,TEMP
11600	;;#GF# DCS 2-1-72 (2-3) DO LOOP HERE, DON'T USE INS1 LIKE BEFORE
11700	INS3:	CAIE	TEMP,12
11800	NOCMU <	;WE WILL JUST BREAK ON CR OR LF, THANK YOU
11900	EXPO <
12000		CAIN	TEMP,33		;NORMAL ALTMODE.
12100	>;EXPO
12200	NOEXPO <
12300		CAIN	TEMP,175
12400	>;NOEXPO
12500		 JRST	 DNSTR
12600		CAIE	TEMP,15		;CR?
12700		TRNE	TEMP,600	;CONTROL BITS ON?
12800	>;NOCMU
12900	CMU <	CAIE	TEMP,15		;CR?
13000		CAIN	TEMP,12		; OR LF?
13100	>;CMU
13200		 JRST	 DNSTR		;YES
13300	;;%##%
13400		KONVERT(TEMP)
13500		IDPB	TEMP,TOPBYTE(USER) ;PUT IT AWAY
13600		TTCALL	TEMP		;GET ANOTHER AND
13700	;;%##%  RHT -- MADE A BIT BETTER (ALLOW FOR GETTING MORE ROOM)
13800		AOJL	A,INS3		;GO HANDLE IT (IF STILL HAVE ROOM)
13900		PUSHJ	P,CHRMOR	;GET ROOM FOR MORE CHARS
14000		JRST	INS3		;GO HANDLE
14100	
14200	DNSTR:	MOVEM	TEMP,.SKIP.	;SET BREAK CHAR
14300		JRST	FINSTR
14400	;;#GF#
14500	
14600	HERE (INCHSL)	PUSHJ	P,SAVE
14700		MOVE	LPSA,X22	;PARAM (FLAG) AND RETURN
14800		PUSHJ	P,REDSTR
14900		SETOM	@-1(P)		;ASSUME FAILED
15000		TTCALL	5,TEMP		;ARE THERE CHARS?
15100		JRST	FINSTR		;NO
15200		SETZM	@-1(P)		;YES, GET THEM
15300	;;#GF# DCS 2-1-72 (3-3)
15400		JRST	INS3		;USE INCHWL'S LOOP, NOT INSTR'S
15500	;;#GF#
15600	
15700	HERE (INSTRL)	PUSHJ	P,SAVE
15800		MOVE	LPSA,X22
15900		PUSHJ	P,REDSTR
16000		TTCALL	4,TEMP
16100		MOVE	B,-1(P)
16200		JRST	INS2
16300	
16400	HERE (INSTRS)	PUSHJ	P,SAVE
16500		MOVE	LPSA,X33
16600		PUSHJ	P,REDSTR
16700		SETOM	@-2(P)
16800		TTCALL	5,TEMP
16900		JRST	FINSTR
17000		SETZM	@-2(P)
17100		MOVE	B,-1(P)
17200		JRST	INS2
17300	
17400	HERE (CLRBUF)	TTCALL	11,
17500		POPJ	P,
17600	
17700	HERE (TTYINS) PUSHJ	P,SAVE
17800		PUSHJ	P,REDSTR	;PREPARE TO MAKE A STRING
17900		MOVE	LPSA,X33
18000		SETOM	@-1(P)		;ASSUME NO CHARS
18100		TTCALL	5,D		;SEE IF LINES WAITING
18200		 JRST	FINS1		;NONE WAINTING
18300	;;%##% WILL DO INCHRW UUO IN LOOP
18400		MOVE	B,[TTCALL D]
18500		JRST	TYIN1		;GO AHEAD
18600	
18700	HERE (TTYINL)
18800		PUSHJ	P,SAVE
18900		TTCALL	4,D		;WAIT FOR A LINE
19000		MOVE	B,[ TTCALL 4,D]
19100		JRST	TYIN
19200	
19300	HERE (TTYIN)	PUSHJ	P,SAVE
19400		TTCALL	D		;GET A CHAR
19500		MOVE	B,[TTCALL D]	;FOR LOOP
19600	
19700	TYIN:	PUSHJ	P,REDSTR	;PREPARE STACK,A,STRNGC FOR A STRING
19800		MOVE	LPSA,X33	;PREPARE TO RETURN
19900	TYIN1:	SETZM	@-1(P)		;ASSUME NO BREAK CHAR
20000		SKIPL	C,-2(P)		;TABLE #
20100		CAILE	C,=18
20200		ERR	<TTYIN: there are only 18 break tables>
20300		HRRZ	TEMP,USER
20400		ADD	TEMP,C		;TABLE NO(USER)
20500		MOVEI	Z,1		;FOR TESTING LINE NUMBERS
20600		SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
20700		 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
20800		MOVE	FF,BRKMSK(C)	;GET MASK FOR THIS TABLE
20900	;;%##% BREAK TABLE CONVERSION
21000		TRNE	FF,@BRKCVT(USER) ;SPECIFY UC COERCION
21100		TLOA	C,400000	;YES
21200		TLZ	C,400000	;NO
21300	;;%##%
21400		HRRZ	Y,USER
21500		ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
21600		JRST	TTYN1
21700	;;%##%
21800	TTYN:	XCT	B		;1 CHAR
21900	TTYN1:
22000	;;%##%
22100		JUMPGE	C,TT.NUC	;COERCE BECAUSE OF BRK TBL ?
22200		CAIL	D,"a"		;ONLY IF LC
22300		CAILE	D,"z"
22400		JRST	TT.TSB		;GO TEST BREAK
22500		TRZ	D,40		;MAKE UC
22600		JRST	TT.TSB
22700	TT.NUC:	KONVERT(D)		;MAY TURN TO UC BECAUSE OF TTY
22800	TT.TSB:
22900	;;%##%
23000		TDNE	FF,@Y		;BREAK OR OMIT?
23100		JRST	TTYSPC		; YES, FIND OUT WHICH
23200	TTYC:	IDPB	D,TOPBYTE(USER)	;PUT IT AWAY
23300	;;%##% BE SURE DONT EAT MORE AT A TIME THAN CAN BLOAT
23400		AOJL	A,TTYN		;COUNT AND CONTINUE
23500	TTNMOR:	PUSHJ	P,CHRMOR	;ALLOW FOR MORE CHARS
23600		JRST	TTYN		;GO GO GO
23700	
23800	TTYSPC:	HLLZ	TEMP,@Y		;WHICH?
23900		TDNN	TEMP,FF
24000		JRST	TTYN		;OMIT
24100		MOVEM	D,@-1(P)
24200		MOVE	Y,-2(P)		;WHAT TO DO WITH IT
24300		ADD	Y,USER
24400		SKIPN	Y,DSPTBL(Y)
24500		JRST	FINS1		;DONE, NO SAVE
24600		JUMPL	Y,TTYAPP	;APPEND
24700		ERR	<TTYIN: cannot retain break char>,1,FINS1
24800	TTYAPP:	IDPB	D,TOPBYTE(USER)	;COUNT THE BREAK CHAR
24900		ADDI	A,1		;ONE MORE HAPPY CHAR
25000		JRST	FINS1
25100	
25200	;;%##% ALLOW FOR ANOTHER CHUNK OF CHARS
25300	
25400	CHRMOR:	ADDI	A,TTWCHR	;A ← NUMBER CHARS USED
25500		ADDM	A,-1(SP)	;UPDATE COUNT
25600		PUSH	P,[TTWCHR]	;GET SOME MORE
25700		PUSHJ	P,.SONTP	;BE SURE ROOM & ALIGNED
25800		MOVNI	A,TTWCHR	;REFRESH THE COUNT
25900		POPJ	P,
26000	
26100	
26200	
26300	HEREFK(TTYUP,.TTYUP)
26400	;;%##%  FLAGS TTY TRANSLATION TO UPPER CASE & RETURNS OLD FLAG
26500		MOVE 	USER,GOGTAB
26600		MOVE	A,-1(P)
26700		EXCH	A,TTYCVT(USER)
26800		SUB	P,X22
26900		JRST	@2(P)		;RETURN
27000	
27100	
27200	ENDCOM(TTY)
27300	EXPO <
27400	COMPIL(PTY)
27500	ENDCOM(PTY)
27600	>;EXPO
27700	NOEXPO <
27800	COMPIL(PTY,<PTYGET,PTYREL,PTIFRE,PTOCNT,PTCHRW,PTCHRS
27900	ENTINT <PTOCHS,PTOCHW,PTOSTR,BACKUP,LODED,PTYALL,PTYSTR,PTYIN>
28000	ENTINT <PTYSTL,PTYGTL>>
28100		  ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,.SKIP.>
28200		  ,<PTY ROUTINES>)
     

00100	COMMENT ⊗Ptyuuo functions ⊗
00200	
00300		OPDEF	PTYUUO	[711B8]
00400	
00500	DSCR PTYUUO FUNCTIONS
00600	CAL SAIL
00700	⊗
00800	COMMENT ⊗
00900	BEGIN "PTYSPC"
01000	INTEGER PROCEDURE PTYGET;
01100	PROCEDURE PTYREL(INTEGER LINE);
01200	INTEGER PROCEDURE PTIFRE(INTEGER LINE);
01300	INTEGER PROCEDURE PTOCNT(INTEGER LINE);
01400	INTEGER PROCEDURE PTCHRS(INTEGER LINE);
01500	PROCEDURE PTOCHS(INTEGER LINE,CHAR);
01600	PROCEDURE PTOCHW(INTEGER LINE,CHAR);
01700	PROCEDURE PTOSTR(INTEGER LINE; STRING INFORMATION);
01800	PROCEDURE LODED(STRING TRYAGAIN);
01900	STRING PROCEDURE PTYALL(INTEGER LINE);
02000	PROCEDURE BACKUP;
02100	STRING PROCEDURE PTYSTR(INTEGER LINE,BRCHAR);
02200	STRING PROCEDURE PTYIN(INTEGER LINE,BKTBL; REFERENCE INTEGER BRCHAR);
02300	
02400	END "PTYSPC"
02500	
02600	⊗
02700	
02800	
02900	HERE (PTYGET)
03000		SETOM	.SKIP.
03100		MOVEI	A,0
03200		PTYUUO	A
03300		SETZM	.SKIP.
03400		POPJ	P,
03500	
03600	HERE (PTYREL)
03700		POP	P,(P)
03800		EXCH	A,(P)
03900		PTYUUO	1,A
04000		POP	P,A
04100		JRST	@2(P)
04200	
04300	HERE (PTYGTL) PUSH	P,(P)	;ANOTHER COPY OF RETURN ADDRESS.
04400		PTYUUO	13,-2(P);POINT AT PTY LINE NUMBER
04500		MOVE	A,-1(P)	;RESULT.
04600		SUB	P,X33
04700		JRST	@3(P)	;AND RETURN.
04800	
04900	HERE (PTYSTL) PTYUUO 14,-2(P);POINTED AT LINE NUMBER!
05000		SUB	P,X33
05100		JRST	@3(P)
05200	
05300	HERE (PTIFRE)
05400		MOVE	TEMP,[PTYUUO 2,0]
05500		JRST	%PTY1
05600	
05700	HERE (PTOCNT)
05800		SKIPA	TEMP,[PTYUUO 3,0]
05900	
06000	HERE (PTCHRW)
06100		MOVE	TEMP,[PTYUUO 5,0]
06200	%PTY1:	POP	P,(P)
06300		EXCH	0,(P)
06400		XCT	TEMP
06500		POP	P,0
06600		JRST	@2(P)
06700	
06800	HERE (PTCHRS)
06900		POP	P,(P)
07000		EXCH	0,(P)
07100		PTYUUO	4,0
07200		MOVNI	A,1
07300		POP	P,0
07400		JRST	@2(P)
07500	
07600	HERE (PTOCHS)
07700		SKIPA	TEMP,[PTYUUO 6,0]
07800	
07900	HERE (PTOCHW)
08000		MOVE	TEMP,[PTYUUO 7,0]
08100		SETOM	.SKIP.
08200		POP	P,(P)
08300		EXCH	A,(P)
08400		EXCH	0,-1(P)
08500		XCT	TEMP
08600		SETZM	.SKIP.
08700		POP	P,A
08800		POP	P,0
08900		JRST	@3(P)
09000	
09100	HERE (LODED)
09200		MOVEI	TEMP,0
09300		EXCH	TEMP,(P)
09400		PUSH	P,TEMP
09500		SKIPA	TEMP,[PTYUUO 15,-1(SP)]
09600	
09700	HERE (PTOSTR)
09800		MOVE	TEMP,[PTYUUO  11,-1(SP)]
09900		PUSH	P,TEMP
10000		MOVE	USER,GOGTAB
10100		PUSHJ	P,INSET
10200		PUSH	SP,[1]
10300		PUSH	SP,[POINT 7,[0]]
10400		PUSHJ	P,CAT
10500		POP	P,TEMP
10600		POP	P,(P)
10700		POP	P,-1(SP)
10800		XCT	TEMP
10900		SUB	SP,X22
11000		JRST	@2(P)
11100	
11200	HERE (BACKUP)
11300		TTYUUO	10,
11400		POPJ	P,
11500	
11600	HERE (PTYALL)
11700		PUSHJ	P,SAVE
11800		MOVE	0,-1(P)	;LINE NUMBER
11900		PTYUUO	3,0
12000		JUMPE	A,[PUSH SP,[0]
12100			   PUSH SP,[0]
12200			   JRST ALLQ]
12300		MOVEI	A,=450
12400		ADDM	A,REMCHR(USER)
12500		SKIPL	REMCHR(USER)
12600		PUSHJ	P,STRNGC
12700		PUSHJ	P,INSET
12800		PUSH	SP,-1(P)	;PTY LINE NUMBER
12900		PUSH	SP,TOPBYTE(USER)	;AND BYTE POINTER.
13000		PTYUUO	10,-1(SP)	;AND ASK FOR ALL THAT IS THERE.
13100		MOVEI	B,0
13200		MOVE	C,(SP)		;BYTE POINTER.
13300	;;#IN# 7-11-72 DCS TOPBYTE INVALIDLY UPDATED (ONE TOO FAR)
13400	SOMMOR:	MOVE	LPSA,C		;LAG BY ONE		#IN#
13500		ILDB	0,C		;GET CHAR
13600		JUMPE	0,ALLDUN
13700		AOJA	B,SOMMOR
13800	ALLDUN:	CAILE	B,=445
13900		 ERR	 <PTYALL OVERFLOW -- IT JUST CAN'T HAPPEN!!!!>
14000		HRROM	B,-1(SP)	;SAVE AS RESULT.
14100		MOVEM	LPSA,TOPBYTE(USER);THIS IS WHERE TO START ENXT ITEM. #IN#
14200	;;#IN#
14300		SUBI	B,=156		;-ESTIMATE
14400		ADDM	B,REMCHR(USER)	;AND UPDATE FREE COUTN.
14500	ALLQ:	MOVE	LPSA,X22
14600		JRST	RESTR
14700	
14800	%REDSTR:SKIPE	SGLIGN(USER)
14900		PUSHJ	P,INSET
15000		MOVEI	A,=100
15100		ADDM	A,REMCHR(USER)
15200		SKIPLE	REMCHR(USER)
15300		PUSHJ	P,STRNGC
15400		MOVNI	A,=100
15500		PUSH	SP,[0]		;NULL STRING IF NOTHING DONE
15600		PUSH	SP,TOPBYTE(USER)
15700		POPJ	P,
15800	
15900	%FINSTR:	CAIN	TEMP,15	;REMOVE LFD IF CR BROKE IT
16000	;;#PO# ! RHT THIS USED TO BE CDB (=11) & MUNGED 12
16100	;; USE C & D INSTEAD
16200		PTYUUO	5,C		;HE USED TO SAY CDB
16300	%FINS1:	ADDM	A,REMCHR(USER)	;NUMBER NOT USED
16400		ADDI	A,=100		;NUMBER USED
16500		HRROM	A,-1(SP)	; AND TO STRING COUNT WORD
16600		JRST	RESTR
16700	
16800	HERE (PTYSTR)
16900		PUSHJ	P,SAVE
17000		PUSHJ	P,%REDSTR
17100	;;#PO#
17200		MOVE	C,-2(P)
17300		MOVE	B,-1(P)		;BREAK CHAR
17400		MOVE	LPSA,X33	;# TO REMOVE
17500	;;#PO# (2 LINES)
17600	%INS1:	PTYUUO	5,C		;NEXT CHAR
17700	%INS2:	CAMN	D,B		;BREAK?
17800		 JRST	 %FINSTR		; YES, ALL DONE
17900	;;#PO#
18000		IDPB	D,TOPBYTE(USER) ;PUT IT AWAY AND
18100		AOJA	A,%INS1		; GO BACK FOR MORE
18200	
18300		JRST	%INS2
18400	
18500	HERE (PTYIN) PUSHJ	P,SAVE
18600	;;#PO# (2 LINES)
18700		MOVE	C,-3(P)
18800		PTYUUO	5,C
18900	
19000	%TYIN:	PUSHJ	P,%REDSTR		;PREPARE STACK,A,STRNGC FOR A STRING
19100		MOVE	LPSA,[XWD 4,4]		;PREPARE TO RETURN
19200	%TYIN1:	SETZM	@-1(P)		;ASSUME NO BREAK CHAR
19300		SKIPL	T,-2(P)		;TABLE # (INTO AC 11)
19400		CAILE	T,=18
19500		ERR	<PTYIN: there are only 18 break tables>
19600		HRRZ	TEMP,USER
19700		ADD	TEMP,T		;TABLE NO(USER)
19800		MOVEI	Z,1		;FOR TESTING LINE NUMBERS
19900		SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
20000		 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
20100		MOVE	FF,BRKMSK(T)	;GET MASK FOR THIS TABLE
20200		HRRZ	Y,USER
20300	;;#PO# !
20400		ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(USER)
20500		JRST	%TTYN1
20600	;;#PO# !
20700	%TTYN:	PTYUUO	5,C
20800	%TTYN1:	TDNE	FF,@Y		;BREAK OR OMIT?
20900		JRST	%TTYSPC		; YES, FIND OUT WHICH
21000	;;#PO# !
21100	%TTYC:	IDPB	D,TOPBYTE(USER)	;PUT IT AWAY
21200		AOJL	A,%TTYN		;COUNT AND CONTINUE
21300		JRST	%FINS1		;DONE
21400	%TTYSPC: HLLZ	TEMP,@Y		;WHICH?
21500		TDNN	TEMP,FF
21600		JRST	%TTYN		;OMIT
21700	;;#PO# !
21800		MOVEM	D,@-1(P)
21900		MOVE	Y,-2(P)		;WHAT TO DO WITH IT
22000		ADD	Y,USER
22100		SKIPN	Y,DSPTBL(Y)
22200		JRST	%FINS1		;DONE, NO SAVE
22300		JUMPL	Y,%TTYAPP	;APPEND
22400		ERR	<PTYIN: cannot retain break char>,1,%FINS1
22500	;;#PO#
22600	%TTYAPP: IDPB	D,TOPBYTE(USER)	;COUNT THE BREAK CHAR
22700		ADDI	A,1		;ONE MORE HAPPY CHAR
22800		JRST	%FINS1
22900	
23000	ENDCOM(PTY)
23100	>;NOEXPO
23200	
23300	IFN ALWAYS,<
23400	BEND IOSER>
23500	DSCR BEND IOSER
23600	⊗
23700