perm filename SAIBRK.FAI[S,AIL] blob sn#191950 filedate 1975-12-15 generic text, type T, neo UTF8
SEARCH HDRFIL
COMPIL(BRK,<BREAKSET,SETBREAK,STDBRK,GETBREAK,RELBREAK>
 ,<SAVE,RESTR,BRKMSK,BKTCHK,SIMIO,GOGTAB,X22,X33,OPEN,LOOKUP,ARRYIN,RELEASE,.SKIP.,X11,CORGET,CORREL>
	  ,<BREAKSET, SETBREAK, STDBRK ROUTINES>)
HERE(BREAKSET)
	PUSHJ	P,SAVE		;SAVE ACS AND THINGS
	MOVE	LPSA,X33
	SUB	SP,X22
	MOVE	X,-2(P)		;TABLE #
	MOVSI	TEMP,-1		;GET BLOCK IF NOT THERE, NO NEED TO INIT
	PUSHJ	P,BKTCHK	;CHECK OUT TABLE #
	 JRST	RESTR		;ERROR RETURN
	MOVE	B,BRKMSK(CHNL)	;BITS FOR THIS TABLE
	IORM	B,BKJFFO(CDB)	;MARK THIS TABLE RESERVED & INIT'ED
	HLLZS	B		;LEFT HALF ONLY
	ADD	CHNL,CDB	;RELOCATE RANGE 1-18
	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
	XWD	UCASE,SKIPCH	;K,,S
	XWD	BRKLIN,RESTR	;L,,D
	XWD	ILLSET,ERMAN	;-,,E
	XWD	NOLINS,LCASE	;N,,F
	XWD	OMIT,ILLSET	;O,,-
ILLSET:	ERR	<ILLEGAL COMMAND TO BREAKSET>,1
	JRST	RESTR
XCLUDE:	MOVE	C,[IORM B,(D)]	;EXCLUSION MEANS YOU FIRST SET TO ONE
	JRST	INCL		;GO DO IT
OMIT:	MOVSS	B		;OMIT HAS BIT IN RH
	HRRZ	A,1(SP)		;SET BIT ONLY IF HAVE SOME OMIT CHARS
	IORM	B,BRKOMT(CDB)	;ASSUME HAVE SOME
	CAIN	A,0		;HAVE ANY
	ANDCAM	B,BRKOMT(CDB)	;NO
INCL:	MOVSI	D,-200
	HRRI	D,BRKTBL(CDB)	;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,(CDB)		;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(CHNL)	;  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(CHNL)
	JRST	RESTR
PENDCH:	SETOM	DSPTBL(CHNL)	;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(CHNL)
	JRST	RESTR
UCASE:	MOVSS	B	;INTO RIGHT HLF
	IORM	B,BRKCVT(CDB)
	JRST	RESTR
LCASE:	MOVSS	B
	ANDCAM	B,BRKCVT(CDB)
	JRST	RESTR
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)
HERE (STDBRK)
	PUSH	P,-1(P)			;CHANNEL
	PUSH	SP,STDBDV
	PUSH	SP,STDBDV+1
	PUSH	P,[14]			;MODE 14
	PUSH	P,[2]			;INPUT BUFFERS
	PUSH	P,[0]			;OUTPUT BUFFERS
	PUSH	P,[0]			;COUNT
	PUSH	P,[0]			;BRCHAR
	PUSH	P,[.SKIP.]		;EOF
	SETZM	.SKIP.
	PUSHJ	P,OPEN			;OPEN CHANNEL
	SKIPE	.SKIP.			;ERROR?
	  ERR	<Can't open STDBRK channel>,1,STDEXT
	PUSH	P,-1(P)
	PUSH	SP,STDBFL
	PUSH	SP,STDBFL+1
	PUSH	P,[.SKIP.]
	SETZM	.SKIP.
	PUSHJ	P,LOOKUP
	SKIPE	.SKIP.
	  ERR	<Can't lookup STDBRK file>,1,STDEXT
	PUSH	P,-1(P)			;CHANNEL
	MOVE	USER,GOGTAB
	MOVEI	X,1		;ORDINARY USER TABLE #
	SKIPE	BKTPRV(USER)	;PRIVILEGED?
	 MOVEI	X,0		;YES
	MOVSI	TEMP,-1		;GET BLOCK IF NOT THERE, NO NEED TO INIT
	PUSHJ	P,BKTCHK	;CHECK OUT SITUATION
	 JRST	STDEXT		;ERROR OF SOME SORE
	PUSH	P,CDB		;WHERE TO PUT IT
	PUSH	P,[BRKDUM]	;HOW MUCH TO READ
	PUSHJ	P,ARRYIN		;READ IN ARRAY
	PUSH	P,-1(P)			;CHANNEL
	PUSH	P,[0]			;CLOSE INHIBIT
	PUSHJ	P,RELEASE		;RELEASE THE FILE
STDEXT:
	SUB	P,X22			;CLEAR STACK
	JRST	@2(P)
NOTENX<
STDBFL:
	BKTFIL
STDBDV: =3
	POINT 7,[ASCIZ/SYS/]
>;NOTENX
TENX<
STDBFL:
	BKTFIL				;DEFINED IN HEAD
STDBDV: =3
	POINT 7,[ASCIZ/DSK/],-1
>;TENX
HERE (GETBREAK)
	PUSHJ	P,SAVE
	SKIPN	BKTPRV(USER)		;PRIVILEGED?
	 JRST	GTBK03			;NO
	MOVSI	D,-4			;YES, SEARCH ALL 4 GROPS
	HRRI	D,BKTPTR(USER)		;START AT FIRST GROUP
	SETZ	A,			;INITIALIZE RESULT
	JRST	GTBK04
GTBK03:	MOVSI	D,-3			;ORDINARY USER, SEARCH LAST 3
	HRRI	D,BKTPTR+1(USER)
	MOVEI	A,=18			;INITIALIZE RESULT
GTBK04:
	SETZ	C,			;INITIAL RESULT
GTBK02:	SKIPN	CDB,(D)			;POINTER TO GROUP OF 18 TABLES
	 JRST	GTBK18			;NO POINTER, SO WHOLE BLOCK OF 18 FREE
	SETCM	B,BKJFFO(CDB)		;GET RESERVATION WORD
	JUMPE	B,GTBK01		;JUMP IF ALL 18 ARE RESERVED AND INIT'ED
	JFFO	B,.+1			;FIND FIRST UNRESERVED TABLE
	CAILE	C,=17			;CHECK ONLY RESERVATIONS, NOT INIT'S
	 JRST	GTBK01			;ALL 18 RESERVED
	ADD	A,C			;FOUND ONE
	ADDI	C,1
GTBKRT:	HLLZ	B,BRKMSK(C)		;RESERVE THIS TABLE
	IORM	B,BKJFFO(CDB)
	MOVSS	B			;BIT INTO RIGHT HALF
	ANDCAM	B,BKJFFO(CDB)		;NOT INIT'ED
	ANDCAM	B,BRKCVT(CDB)
	ANDCAM	B,BRKOMT(CDB)
	ADDI	C,(CDB)			;RELOCATE 1 TO 18
	SETZM	LINTBL(C)
	SETZM	DSPTBL(C)
	MOVEI	CDB,BRKTBL(CDB)		;FWA OF CHAR TAB
	HRLI	CDB,-200		;AOBJN COUNT
	HRLI	B,(B)			;BIT IN EACH HALF
	ANDCAM	B,(CDB)			;ZAP!
	AOBJN	CDB,.-1
GTBKF2:	SUBI	A,=17			;ADJUST FOR INITIAL OFFSET
	MOVEM	A,RACS+A(USER)		;RESULT
	MOVE	LPSA,X11
	JRST	RESTR			;DONE
GTBK01:	ADDI	A,=18
	AOBJN	D,GTBK02		;TRY NEXT GROUP OF 18
GTBKF:	MOVNI	A,1			;FAILURE
	JRST	GTBKF2
GTBK18:	MOVE	X,A			;TABLE NUMBER
	SUBI	X,=17			;CORRECT
	MOVSI	TEMP,-1			;CALL CORGET, NO INIT CHECK
	PUSHJ	P,BKTCHK
	 JRST	GTBKF			;ERROR RETURN
	MOVE	C,CHNL
	JRST	GTBKRT
HERE (RELBREAK)
	PUSHJ	P,SAVE
RLBK01:	MOVE	X,-1(P)			;TABLE #
	ADDI	X,=17		;NEG TAB NUMS FOR PRIV USERS CAUSE PROBS
	SKIPN	BKTPRV(USER)	;PRIVILEGED?
	CAIL	X,=18		;LOWEST FOR ORDINARY USER
	CAILE	X,=71		;MAX FOR EVERYBODY
	 JRST	RLBKRT		;RELEASE ALWAYS WORKS
	IDIVI	X,=18
	MOVEI	A,1(Y)			;A NOW IN RANGE 1 TO 18
	ADD	X,USER			;RELOCATE GROUP NUMBER
	SKIPN	B,BKTPTR(X)		;B GETS POINTER TO CORRECT GROUP OF TABLES
	 JRST	RLBKRT			;NON-FATAL ERROR
	MOVE	TEMP,BRKMSK(A)		;BITS FOR THE TABLE
	ANDCAB	TEMP,BKJFFO(B)		;UNRESERVE
	JUMPN	TEMP,RLBKRT		;IF STILL SOME RESERVED
	SETZM	BKTPTR(X)		;THIS GROUP DEFUNCT
	PUSHJ	P,CORREL		;RELEASE BLOCK POINTED TO BY  B
RLBKRT:	MOVE	LPSA,X22	
	JRST	RESTR
ENDCOM(BRK)
END