perm filename SAISCN.FAI[S,AIL]3 blob sn#128055 filedate 1974-11-02 generic text, type T, neo UTF8
COMPIL(SCN,<SCAN,BKTCHK>,<INSET,SAVE,RESTR,X44,STRNGC,BRKMSK,CORGET>,<SCAN ROUTINE>)
HERE (SCAN)	PUSHJ	P,SAVE
	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVE	LPSA,X44
	SOS	C,-3(P)		;PTR TO STRING TO BE SCANNED
	HRRZ	A,(C)		;#CHARS IN INPUT STRING
	JUMPE	A,NULSCN	;IF NO CHARS TO SCAN
	MOVE	B,1(C)		;INPUT BYTE POINTER
	MOVEI	Z,0
	MOVE	X,-2(P)		;TABLE #
	MOVEI	TEMP,-1		;ERROR IF BLOCK NOT THERE OR NOT INIT'ED
	PUSHJ	P,BKTCHK	;CHECK OUT TABLE #
	 JRST	ENDSCN		;ERROR OF SOME SORT
SCNNX:	MOVE	D,BRKMSK(CHNL)	;HAS BITS ON FOR THIS TABLE
	TRNE	D,@BRKCVT(CDB)	;WANT CONVERSION?
	TLOA	C,400000	; YES
	TLZ	C,400000	; NO
	SETZM	@-1(P)		;BREAK CHAR WORD
	MOVE	Y,CDB
	ADD	Y,[XWD	X,BRKTBL];RLC+BRKTBL(CDB)
	ADD	CHNL,CDB	;RELOCATE 1 TO 18
	TRNN	D,@BRKOMT(CDB)	;COPY IF OMIT CHARS
	JUMPGE	C,NOCPY		;OR IF DOING CONVERSION
	ADDM	A,REMCHR(USER)	;WE MUST COPY THE STRING
	SKIPLE	REMCHR(USER)	;THE "OUT OF SPACE DANCE"
	PUSHJ	P,STRNGC
	PUSH	SP,A
	PUSH	SP,TOPBYTE(USER) ;RESULT BYTE POINTER
	MOVE	B,1(C)		;GET BYTE POINTER BACK
SCNLUP:	SOJL	A,SCNDUN	;STRING EXHAUSTED
	ILDB	X,B		;GET A CHAR
	JUMPGE	C,NOCNVS	;ONLY CONVERT IF WANTED
	CAIL	X,"a"
	CAILE	X,"z"
	JRST	.+2
	TRZ	X,40		;MAKE IT UPPER CASE
NOCNVS:	TDNE	D,@Y		;TDNE D,BRKTBL+RLC(X)
	 JRST	 SCNSPC		;OMIT OR BREAK
	IDPB	X,TOPBYTE(USER)
	AOJA	Z,SCNLUP
SCNSPC:	HLLZ	TEMP,@Y		;NOW SEE IF WE 
	TDNN	TEMP,D		;OMIT OR BREAK
	 JRST	 SCNLUP		; OMIT
SCNBRK:	MOVEM	X,@-1(P)	;SET BREAK CHAR WORD
SCNDUN:	SKIPN	TEMP,DSPTBL(CHNL) ;WHAT DO WE DO WITH BRCHAR?
	 JRST	 ENDSCN		; NOTHING
	JUMPL	TEMP,SCNAPN	;APPEND TO END OF STRING
SCNRET:	SOS	B		;LEAVE FOR NEXT TIME
	REPEAT	4,<IBP B
>
	JUMPL	A,ENDSCN	;STRING WAS EXHAUSTED
	AOJA	A,ENDSCN	;PUT ONE BACK
SCNAPN:
	JUMPL	A,ENDSCN	;SCANNED OFF END, NOTHING LEFT TO APPEND
	IDPB	X,TOPBYTE(USER)
	ADDI	Z,1
ENDSCN:	MOVE	TEMP,Z		;#CHARS IN NEW STRING
	SUB	TEMP,-1(SP)	;NUMBER RESERVED BUT NOT USED
	ADDM	TEMP,REMCHR(USER);UNRESERVE THEM
	HRROM	Z,-1(SP)	;NOT A CONSTANT, NEW STRING SIZE
	JUMPGE	A,.+2		;IF EXHAUSTED, USE 0
	MOVEI	A,0
	HRRM	A,(C)		;UPDATE OLD COUNT
	MOVEM	B,1(C)		;UPDATED ORIGINAL BYTE POINTER
	JRST	RESTR		;POPJ	P,
NULSCN:	SETZM	@-1(P)		;NO BREAKS
	PUSH	SP,A		;NULL STRING RESULT
	PUSH	SP,A		;
	JRST	RESTR
NOCPY:	PUSH	SP,(C)		;COPY COUNT WRD FROM INPUT (WILL MUNCH)
	PUSH	SP,1(C)		;BYTE POINTER TO START
SCNLP2:	SOJL	A,ENDSC2	;COUNT DOWN
	ILDB	X,B		;GET NEXT CHAR
	TDNN	D,@Y		;IS BREAK CHAR ON (KNOW NOT OMIT)
	AOJA	Z,SCNLP2	;JUST REGULAR
	MOVEM	X,@-1(P)	;IT WAS THE BREAK CHAR
SCNDN2:	SKIPN	TEMP,DSPTBL(CHNL) ; FIGURE OUT WHAT TO DO WITH BRK CHR
	JRST	ENDSC2		;NICHTS
	JUMPL	TEMP,SCNAP2	;APPEND IT
	ADD	B,[070000,,0]	;BACK UP BYTE POINTER
	JFCL	.+1		;SO OVERFL STAYS HAPPY
	JUMPG	B,.+3
	SUB	B,[430000,,1]	;BACK UP ONE WORD WHEN NECESSARY
	JFCL	.+1		;SO OVERFL STAYS HAPPY
	AOJA	A,ENDSC2	;& WE HAVE ONE MORE LEFT
SCNAP2:	ADDI	Z,1		;APPEND ONE MORE CHAR TO RESULT
ENDSC2:	HRRM	Z,-1(SP)	;
	CAIGE	A,0		;NEVER PUT NEG COUNT
	MOVEI	A,0		;THERE YOU GO
	HRRM	A,(C)		;FIX INPUT BYTE CNT
	MOVEM	B,1(C)		;NEW INPUT BYTE PTR
	JRST	RESTR		;ALL DONE
HERE(BKTCHK)
	JUMPE	X,.BKCKZ
	ADDI	X,=17		;TABLE # NOW IN RANGE 0 THROUGH 71
	SKIPN	BKTPRV(USER)	;PRIVILEGED?
	CAIL	X,=18		;LOWEST FOR ORDINARY USERS
	CAILE	X,=71		;MAX FOR EVERYBOCY
	 JRST	[MOVE	X,X
		ERR	<BKTCHK: Breaktable out of range: >,7
		JRST	CPOPJ]
	IDIVI	X,=18
	MOVEI	CHNL,1(Y)	;CHNL NOW IN RANGE 1 TO 18
	MOVE	Y,X		;SAVE FOR POSSIBLE ERROR MESSAGE
	ADD	X,USER		;RELOCATE GROUP NUMBER
	SKIPN	CDB,BKTPTR(X)	;POINTER TO COREGET BLOCK
	 JRST	.BKCKN		;BLOCK NOT THERE
	TRNN	TEMP,-1		;NEED INITIALIZATION?
	 JRST	CPOPJ1		;NO
	HRRZ	X,BKJFFO(CDB)	;INITIALIZATION BITS
	TDNN	X,BRKMSK(CHNL)	;WAS IT INIT'ED?
	 JRST	[.BKCKE: IMULI	Y,=18	;RECONSTUCT THE NUMBER SO WE CAN DISPLAY IT
			 ADD	Y,CHNL
			 SUBI	Y,=18
			 ERR	<BKTCHK: Uninitialized break table: >,7
			JRST	CPOPJ]
CPOPJ1:	AOS	(P)		;SUCCESS, SKIP RETURN
CPOPJ:	POPJ	P,
.BKCKN:	JUMPGE	TEMP,.BKCKE	;IF INIT REQ'D AND BLOCK NOT THERE, ERROR
	PUSH	P,CHNL		;SAVE 1 TO 18
	PUSH	P,X		;SAVE LOCATION FOR POINTER
	MOVEI	C,BRKDUM+1	;AMOUNT TO GET
	PUSHJ	P,CORGET
	 ERR	<BKTCHK: CORGET failed>
	MOVE	CDB,B		;ADDR OF BLOCK
	SETZM	(B)		;CLEAN IT OUT
	HRLI	B,(B)		;
	HRRI	B,1(B)
	BLT	B,BRKDUM(CDB)	;
	POP	P,X
	POP	P,CHNL
	MOVEM	CDB,BKTPTR(X)	;SAVE FOR FUTURE REFERENCE
	JRST	CPOPJ1		;SUCCESS
.BKCKZ:	SETZ	CHNL,		;CHEAT ON "RANGE 1 TO 18"
	MOVEI	X,1(USER)
	SKIPN	CDB,BKTPTR(X)	;POINTER FOR CORGET BLOCK, TABLES 1 TO 18
	 JRST	.BKCKN+1	;CORGET BLOCK NOT THERE: FETCH, FIDO
	JRST	CPOPJ1		;SUCCESS
ENDCOM(SCN)