perm filename IOSER1.TNX[MEW,AIL] blob sn#091939 filedate 1974-03-17 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00006 PAGES VERSION 17-1(0)
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	TENX<CSERR,LPRYER,BREAKSET,SETBREAK,USERCON
 00003 00003	Breakset 
 00007 00004	Setbreak 
 00009 00005	Usercon 
 00011 00006	
 00012 ENDMK
⊗;
TENX<;CSERR,LPRYER,BREAKSET,SETBREAK,USERCON
	;ROUTINES FROM (DEC) IOSER THAT HAD NOWHERE ELSE TO GO
	;SEPARATELY MAINTAINED, BUT COPIED FROM IOSER
COMPIL(CAS,<CSERR,LPRYER>,<GOGTAB>
	  ,<CSERR, LPRYER -- SUPPORT ROUTINES>)
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(CAS)

COMPIL(BRK,<BREAKSET,SETBREAK>
	  ,<SAVE,RESTR,BRKMSK,SIMIO,GOGTAB,X22,X33>
	  ,<BREAKSET, SETBREAK, ROUTINES (EXCEPT STDBRK)>)

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)

ENDCOM(BRK)
COMPIL(USC,<USERCON>,<SAVE,RESTR,GOGTAB>,<USERCON ROUTINES>)
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)
>;TENX