COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	EQU
C00004 00003	STRNGC Service routines -- SOURCE and DEST
C00008 00004	DEST:
C00014 00005	COMPIL(CAT,<CAT,CATCHR,CHRCAT,CHRCHR,CAT.RV>
C00021 00006	DSCR .SONTP(STRING SINTEGER CNT)
C00024 00007	COMPIL(OUT,<OUT>,<SAVE,RESTR,GETCHN,SIMIO,NOTOPN,X11,X22>
C00028 ENDMK
C⊗;
EQU
	DMOVEM	RF-2,DTEMPM
	HRRZ	RF-2,-3(SP)		;#CHARS(1)
	MOVE	RF-1,-2(SP)		;BP(1)
	HRRZ	RF+1,-1(SP)		;#CHARS(2)
	MOVE	RF+2,(SP)		;BP(2)
	CAIN	RF-2,(RF+1)		;SAIL STRINGS MUST BE SAME LENGTH TO BE EQU
	EXTEND	RF-2,[CMPSE]
	 TDZA	1,1
	SETO	1,
	DMOVE	RF-2,DTEMPM
	ADJSP	SP,-4
	POPJ	P,

SUBSR
	SOS	TEMP,-1(P)		;NEW LENGTH-1
	ADD	TEMP,-2(P)		;PLUS START CHAR #
	MOVEM	TEMP,-1(P)		;EQUALS NEW END CHAR #
					;FALL INTO SUBST
SUBST
	HRRZ	TEMP,-1(SP)		;OLD LENGTH
	SETZM	.SKIP.
	SKIPG	USER,-1(P)		;END CHAR #
	 TDZA	TEMP,TEMP		;WAS NEG, WILL BE SET TO ZERO
	CAILE	USER,(TEMP)		;NEW END MUST NOT EXCEED OLD END
	 JRST	[MOVEI	USER,(TEMP)
		HLLOS	.SKIP.
		JRST	.+1]
	SOSGE	TEMP,-2(P)		;START CHAR # -1
	 JRST	SB1			;LENGTH OF RESULT IS (TEMP)
	CAIL	TEMP,(USER)		;NEW LENGTH MUST BE POSITIVE
	 JRST	[SETZB	USER,-1(SP)	;RESULT IS NULL
	    SB1:HRROS	.SKIP.
		JRST	SBRT]		;WE KNOW NEW LENGTH AND B.P.
	SUBI	USER,(TEMP)		;NEW LENGTH
	ADJBP	TEMP,(SP)
	MOVEM	TEMP,(SP)
SBRT:	HRRM	USER,-1(SP)
	ADJSP	P,-3
	JRST	@3(P)

;STRNGC Service routines -- SOURCE and DEST
;SOURCE:
;<** B => source space
;<** .LIST(B) => first descriptor of next nest to move, or 0 (space done)
;Q2 is negative iff SGLIGN is on
;
;strings look like
; -------------------------------
; | NEXT in space |   length    |
; -------------------------------
; |   char # (rel. to space)    |
; -------------------------------
;
; 1. Move to next space, if necessary -- this one done. No-skip if no more.
; 2. Create BP to start of nest, save.  Save first space-relative count.
; 3. Move down list, identify end of nest -- convert all descriptor
;    counts to nest-relative counts
; 4. Update .LIST
; 5. Skip (found a nest) Return:
;    FF -- total # chars in nest
;    A -- BP to source string (nest)
;<   E -- =>first in nest -- last link in nest zeroed
; 6. Non-skip (no more nests) Return.
; 7. Don't change C!!!

SOURCE:	SKIPN	E,.LIST(B)
	 JRST	[SKIPN B,.NEXT(B)
		   POPJ P,		;no-skip, return
		   JRST SOURCE]
	MOVE	A,1(E)		;A←chr #
	HRLI	B,440700	;B←0 BP for space
	ADJBP	A,B		;A←BP to nest
	HRLI	E,(E)
	MOVN	FF,1(E)		;-(nest start char)
	HRRZ	D,(E)		;length of first in nest
	SUB	D,FF		;nest end char +1

	MOVE	T,1(E)
	SUB	T,REMCHR(USER)	;T←max char # that will fit in dest
	SETZM	1(E)		;Adjust 1st descr. location count to nest-rel.
	JRST	SRCBOT
;** FF is -(nest start char)
;** A is BP to start of nest
;** D is Nest end char +1
;<<** E is => first elt of nest,, => current elt.
;** First nest descriptor already count-relative adjusted
;Loop until a descriptor is not in the nest
SRCLUP:	HRRZ	TEMP,(Q1)	;length(next)
	ADD	TEMP,1(Q1)	;end chr +1
	CAMG	D,1(Q1)		;Is next string part of nest?
	 JRST	[JUMPL	Q2,NONEST	;No.  If SGLIGN then must stop.
		CAMN	D,1(Q1)		;Is next string adjacent to nest
		CAMLE	TEMP,T		; and will it fit in dest?
		 JRST	NONEST		;No.
		JRST	SRC.1]		;Known to extend the nest
	CAMGE	D,TEMP		;Adjust nest-end location, if new string
SRC.1:	 MOVE	 D,TEMP		; extends beyond old nest
	ADDM	FF,1(Q1)	;Adjust location count to nest-relative.
	HRRI	E,(Q1)		;Will be last descriptor in nest at NONEST
SRCBOT:	HLRZ	Q1,(E)		;Addr of next string
	JUMPN	Q1,SRCLUP

NONEST:	HRRZM	Q1,.LIST(B)	;Update list
	HRRZS	(E)		;Clear last elt in nest
	HLRZ	E,E		;Return ptr. to 1st
	ADD	FF,D		;Length of nest
	AOS	(P)		;Skip return
	POPJ	P,

;DEST:
;** B inviolate
;<** C => dest space
;** TOPBYTE(USER) is free in current dest space
;** REMCHR(USER) is -(number remaining) in current dest space
;<** E is  =>first in nest -- last elt. is zeroed
;** FF is nest size in chars
;** A is nest source byte pointer
;Q2 is negative iff SGLIGN is on

; 1. Adjust to FW bdry if SGLIGN
; 2. Find room, this dest space or next -- error if out of spaces.
; 3. Adjust REMCHR
; 4. Move nest, adjust TOPBYTE
; 5. Recreate BP for each descriptor

DEST:	MOVE	D,FF		;SAVE LENGTH
DEST1:	JUMPGE	Q2,NOLIGN
	PUSHJ	P,INSET			;Inset aligns TOPBYTE to full word
	ADJBP	D,TOPBYTE(USER)		;D better not be zero!
	SETZM	(D)			;clear out last word
	MOVE	D,FF			;and get nest length back

NOLIGN:	ADDB	D,REMCHR(USER)		;Standard room test
	JUMPLE	D,ISROOM
;!HOOK! If you decided to move the DEST being left (in DSTSET, see below),
; Do it now.  Move it to (C)+OFFSET(USER).
NOROOM:	PUSHJ	P,WASTE			;Count waste in space being left
	HRRZ	C,.NEXT(C)		;Since we are moving strings "down",
	JUMPE	C,[ERR <DRYROT -- No more room for strings -- very strange>]
					; running out of already existent
	PUSHJ	P,DSTSET		; space is a fatal error.
	JRST	DEST1			;Try again, C, REMCHR, TOPBYTE are adjusted.

ISROOM:	SKIPG	D,TOPBYTE(USER)
	 SUB	D,[<POINT 7,1>-<POINT 7,0,34>]	;change from 440700 to 010700
	CAME	D,A			;Avoid moving the nest to its previous
	 JRST	 MV			; location (expensive NO-OP).
	MOVE	D,FF
	ADJBP	D,TOPBYTE(USER)		;Dont move nest, but update TOPBYTE
	JRST	 MVDON

MV:	MOVE	TEMP,C			;save
	MOVE	C,FF			;count
	EXTEND	FF,[MOVSO]		;FF,A to C,D
	 ERR	<DRYROT MOVSO>,1
	MOVE	C,TEMP

MVDON:	EXCH	D,TOPBYTE(USER)
	MOVEI	A,40		;flag for non-const. string
FIXTOP:	MOVE	T,1(E)		;count rel. to nest
	ADJBP	T,D		;form BP
	JUMPG	Q2,.+3
	TLNN	T,700000	;If SGLIGN then
	 ADD	T,[<POINT 7,1>-<POINT 7,0,34>]	;change from 010700 TO 440700
;!HOOK!	ADD	T,OFFSET(USER)	;activate when space-moving becomes reality.
;; !! But topbyte fix is messed up some by this, watch it.
	MOVEM	T,1(E)
	MOVEI	T,(E)		;save current
	HLRZ	E,(E)		;next in nest
	HRLM	A,(T)		;flag non-const.
	JUMPN	E,FIXTOP
	POPJ	P,


;DSTSET:
;<** C => destination space
;Result: TOPBYTE(USER) is destination byte pointer -- to beginning of space
;	 REMCHR(USER) is -(size of space in characters)
DSTSET:	HRLI	C,(<POINT 7,0>)
	MOVEM	C,TOPBYTE(USER)
	MOVN	TEMP,.SIZE(C)
	IMULI	TEMP,5
	MOVEM	TEMP,REMCHR(USER)
;!HOOK! This is probably the best place to decide, perhaps to minimize
; checkerboarding or memory use, that the DEST just prepared should be
; moved to a new location.  This move will not happen until the space
; has been filled, and all descriptors for it adjusted.  Decide where
; to move the block, then put the difference between its future location
; and its current one into OFFSET(USER).  The DEST routine will use this
; to adjust all descriptor byte pointers.
	POPJ	P,

;When leaving a DEST for a new one, keep track of the unfilled space
; within that space.
WASTE:	PUSH	P,TEMP+1
	MOVN	TEMP,REMCHR(USER)	;Unused characters this space
	IDIVI	TEMP,5			;Just rough estimate.
	POP	P,TEMP+1
	ADDM	TEMP,SGCWASTE(USER)
	POPJ	P,
COMPIL(CAT,<CAT,CATCHR,CHRCAT,CHRCHR,CAT.RV>
	  ,<SAVE,RESTR,X22,X33,STRNGC,INSET,GOGTAB,CONFIG,PUTCH>
	  ,<CAT -- CONCATENATION ROUTINE>)

;;#GI# DCS 2-5-72 OPTIMIZE CAT SOME MORE, REMOVE TOPSTR
DSCR "STRING"←CAT("STR1","STR2");
CAL SAIL
DES CALL GENERATED BY COMPILER FOR & OPERATOR
⊗
	
HERE (CAT.RV)
	DMOVE	TEMP,-1(SP)
	EXCH	TEMP,-3(SP)
	EXCH	TEMP+1,-2(SP)
	DMOVEM	TEMP,-1(SP)

HERE (CAT)
	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)		;SAVE FOR STRNGC ERR MESSAGE
	HRRZ	TEMP,-1(SP)
	JUMPE	TEMP,RETFRS		;SECOND IS NULL
	HRRZ	TEMP,-3(SP)
	JUMPE	TEMP,RETSEC		;FIRST IS NULL
CATGO:	DMOVEM	A,RACS+A(USER)		;SAVE A,B
	DMOVEM	D,RACS+D(USER)		;SAVE D,E
	MOVEM	RF,RACS+RF(USER)	;SAVE F-REGISTER

CATGO1:	HRRZ	E,-3(SP)		;LENGTH(FIRST)
	ADJBP	E,-2(SP)		;BP TO END
	CAMN	E,TOPBYTE(USER)	;(TOPBYTE=440700 AND FIRST AT TOP) UNLIKELY
	 JRST	ONLY1		;FIRST IS AT TOP
	SKIPG	LPSA,(SP)
	 SUB	LPSA,[<POINT 7,1>-<POINT 7,0,34>]	;GET RID OF 440700
	CAMN	TEMP,LPSA
	 JRST	ADJRET		;ALREADY CAT (BUT NEED ALIGNMENT CHECK)

; TWO STRINGS TO MOVE

MOVTWO:	HRRZ	A,-3(SP)	;#CHARS(1)
	ADD	A,-1(SP)	;FINAL LENGTH
	MOVEI	A,(A)		;ALLOW ROOM FOR POSSIBLE INSET
	ADDM	A,REMCHR(USER)	;#CHARS(NEW) - REMAINING #CHARS
	SKIPLE	REMCHR(USER)	;ENOUGH ROOM?
	 PUSHJ	P,STRNGC	;NO, GO MAKE SOME
	SKIPE	SGLIGN(USER)	;IF ALIGNING,
	 PUSHJ	P,INSET		; ALIGN
	HRRZ	D,-3(SP)	;#CHARS(1)
	MOVE	E,TOPBYTE(USER)	;WILL BE RESULT BP
	HRROM	A,-3(SP)	;LENGTH OF RESULT
	MOVE	B,E		;TOPBYTE
	EXCH	B,-2(SP)	;TRADE WITH FIRST BP
	MOVEI	A,(D)		;#CHARS(1)
	EXTEND	A,[MOVSO]	;COPY FIRST STRING
	 ERR	<DRYROT MOVSO>,1
	HRRZ	A,-1(SP)	;#CHARS(2)
	JRST	CATB		;AND GO COPY 2ND


;  ONLY ONE STRING TO MOVE

ONLY1:	SKIPE	SGLIGN(USER)	;CHECK ALIGNMENT?
;;#GY# SEE JUST BELOW
	JSP	LPSA,CHKLGN	;YES, DON'T RETURN IF MISALIGNED
;;#GY#
;;#QE#	DCS 12-30-73 Avoid problems when STRNGC expands
	HRRZ	A,-1(SP)	;#CHARS(2)
	ADDM	A,REMCHR(USER)	; - REMAINING CHARS
	SKIPLE	REMCHR(USER)	;ROOM?
	 JRST	[PUSHJ	P,STRNGC	;no, collect, then start from scratch
		MOVNS	A		;since new string space may void
		ADDM	A,REMCHR(USER)	;the ONLY1 condition.
		JRST	CATGO1]		;CATGO1 is new for this fix.
;;#QE#
	ADDM	A,-3(SP)	;NEW #CHARS
				;TOPBYTE ALREADY IN E

;  MOVE 2D

CATB:	MOVE	B,(SP)		;2D BYTE POINTER
	MOVEI	D,(A)		;SAME LENGTH FOR DEST AS SRC
	EXTEND	A,[MOVSO]
	 ERR	<DRYROT MOVSO>,1
	MOVEM	E,TOPBYTE(USER)	;PUT THIS AWAY, BY ALL MEANS
REST.4:
	DMOVE	A,RACS+A(USER)
ADJRT1:	DMOVE	D,RACS+D(USER)
RETFRS:	ADJSP	SP,-2		;REMOVE NON-RESULT
	JRST	@UUO1(USER)	;RETURN

RETSEC:	DMOVE	LPSA,-1(SP)
	DMOVEM	LPSA,-3(SP)
	JRST	RETFRS

;;#GY# DCS 5-11-72 ASSURE FULL-WORD ALIGN IF SGLIGN AND ALREADY CATTED
ADJRET:	SKIPE	SGLIGN(USER)	;IF NEED ALIGNMENT, MUST CHECK IT
	 JSP	 LPSA,CHKLGN	;DON'T RETURN IF NOT ALIGNED
OKLG:	HRRZ	TEMP,-1(SP)	;COUNT OF 2D
	ADDM	TEMP,-3(SP)	;INCREASE COUNT OF FIRST
	JRST	ADJRT1		;RESTORE E

CHKLGN:	MOVE	TEMP,-2(SP)	;Check the position field of first arg --
	TLNN	TEMP,300000	;44, 01 are aligned, 35,27,17,10 not.  Bits
	 JRST	 (LPSA)		; 1 and 2 are both off only for 44 and 01.
	 JRST	 MOVTWO		;Not aligned, move both
;;#GY#

DSCR "STRING"←CHRCAT(CHAR,"STR")
⊗
HERE (CHRCAT)
	HRRZ	TEMP,-1(SP)	;CHECK OTHER STRING NULL
	JUMPE	TEMP,ITSNUL
	PUSH	SP,-1(SP)	;MAKE ROOM FOR ONE UNDERNEATH
	PUSH	SP,-1(SP)
	DMOVE	TEMP,[ONECH: 1
		      POINT 7,RACS+6(USER),28] ;CONSTANT IN
	DMOVEM	TEMP,-3(SP)
	JRST	CATCGO		;GO DO SPECIAL CAT

DSCR "STRING"←CATCHR("STR",CHAR)
⊗
HERE (CATCHR)
	HRRZ	TEMP,-1(SP)
	JUMPE	TEMP,ITSNUL
	PUSH	SP,ONECH	;PUT ONE-CHAR DESCRIPTOR ON
	PUSH	SP,ONECH+1	;TOP
CATCGO:	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)	;RETURN ADDRESS
	POP	P,RACS+6(USER)	;PUT IT SOMEWHERE SAFE
	JRST	CATGO		;EVERYBODY'S NON-NULL
	
ITSNUL:	ADJSP	SP,-2
	JRST	PUTCH		;ZAP

DSCR "STRING"←CHRCHR(CHAR,CHAR)
⊗
HERE (CHRCHR)
	MOVE	USER,GOGTAB
	MOVEM	RF,RACS+RF(USER)
	PUSH	P,A
	MOVEI	A,2		;NEED 2 CHARS
	ADDB	A,REMCHR(USER)
	JUMPLE	A,.+2
	 PUSHJ	 P,STRNGC	;THE USUAL
	MOVE	A,-3(P)		;CHAR 1
	EXCH	A,(P)		;GET BACK SAVED
	PUSHJ	P,PUTCH		;A STRING
	AOS	-1(SP)		;2 CHARACTER STRING
	MOVE	TEMP,-1(P)	;CHAR 2
	IDPB	TEMP,TOPBYTE(USER);A 2-CHAR STRING
	ADJSP	P,-3
	JRST	@3(P)		;QUICK AS A BUNNY

;;#GI#

ENDCOM (CAT)
DSCR .SONTP(STRING S;INTEGER CNT)
DES 	This routine returns (on sp) a string EQU to S (may be S)
	which is aligned with TOPBYT & ensures that there are at least
	an additional CNT chars left in the current string space.
SID 	updates REMCHR.  Sets USER to GOGTAB, mangles TEMP
	may call STRNGC
⊗
HERE(.SONTP)

BEGIN 	SONTP

	MOVE	USER,GOGTAB
	MOVEM	A,RACS+A(USER)
	SKIPG	A,TOPBYTE(USER)
	 SUB	A,[<POINT 7,1>-<POINT 7,0,34>]	;I HATE 440700
	MOVE	TEMP,-1(SP)	;LENGTH
	ADJBP	TEMP,(SP)	;END OF ARG
	CAME	TEMP,A
	 JRST	NOTONT		;DRAT
	MOVE	TEMP,-1(P)
	ADDB	TEMP,REMCHR(USER)
	JUMPG	TEMP,NOFIT	;CNT DOES NOT FIT
XIT:	ADJSP	P,-2
	MOVE	A,RACS+A(USER)
	JRST	@2(P)

NOTONT:	HRRZ	TEMP,-1(SP)	;STRING IS NOT ON TOP. IS THERE ROOM FOR STRING
	ADD	TEMP,-1(P)	;PLUS CNT
	ADDB	TEMP,REMCHR(USER)	;IN STRING SPACE?
	JUMPLE	TEMP,COPY	;YES
NOFIT:	HRRZ	A,-1(SP)	;NO
	ADD	A,-1(P)		;GET ENOUGH FOR BOTH
	PUSHJ	P,STRNGC
	MOVN	A,A		;WE DIDNT USE THE SPACE YET
	ADDM	A,REMCHR(USER)	;SO RETURN IT
	JRST	.SONTP

COPY:	DMOVEM	A,RACS+A(USER)
	DMOVEM	D,RACS+D(USER)
	SKIPE	SGLIGN(USER)
	 PUSHJ	P,INSET
	HRRZ	A,-1(SP)	;LENGTH
	MOVE	B,(SP)		;SOURCE
	MOVEI	D,(A)		;LENGTH
	MOVE	E,TOPBYTE(USER)	;DEST
	MOVEM	E,(SP)		;RECORD IT
	EXTEND	A,[MOVSO]
	 ERR	<DRYROT MOVSO>,1
	MOVEM	E,TOPBYTE(USER)
	DMOVE	A,RACS+A(USER)
	DMOVE	D,RACS+D(USER)
	JRST	XIT
BEND SONTP

COMPIL(OUT,<OUT>,<SAVE,RESTR,GETCHN,SIMIO,NOTOPN,X11,X22>
	  ,<STRING OUTPUT ROUTINE>)
COMMENT ⊗Out ⊗

DSCR OUT(CHANNEL,"STRING");
CAL SAIL
⊗
COMMENT ⊗
Simply places all characters of string in output buffer for channel.
Close file if device is TTY    ⊗

.OUT.:
HERE (OUT)	PUSHJ	P,SAVE		;ACS, GET USER, SAVE RETURN FOR ERROR
	MOVE	LPSA,X22
	MOVE	CHNL,-1(P)	;CHANNEL NUMBER
	LOADI7	A,<OUT>
	PUSHJ	P,GETCHN	;VALIDATE AND GET CDB, ETC.
	HRRE	A,-1(SP)	;#CHARS
	MOVE	B,(SP)
	ADJSP	SP,-2
;;#WZ# JFR 6-17-76 TRAP OUT WITH NO PLACE TO PUT STRING
.OUT2:	SKIPN	E,OBP(CDB)
	 JRST	[ERRSPL	1,[[ASCIZ/
OUT: No buffer. Channel @D file @F:  @F  @F/]
			PWORD	CHNL
			PWORD	DNAME(CDB)
			PWORD	INAME(CDB)
			PWORD	ONAME(CDB)]
		JRST	RESTR]
;;#WZ# ↑
	MOVE	D,OCOWNT(CDB)

.OUT:	SUBM	A,OCOWNT(CDB)	;COUNT DOWN BUFFER
	MOVNS	OCOWNT(CDB)
	CAILE	D,(A)		;IF MORE LEFT IN BUFFER THAN STRING
	 MOVEI	D,(A)		; THEN PRETEND BUFFER IS SHORTER
	EXTEND	A,[MOVSO]
	 JRST	OUT1		;STRING WAS LONGER THAN BUFFER
OUTDUN:	MOVEM	E,OBP(CDB)	;PUT BP AWAY
	SKIPGE	TTYDEV(CDB)	;TTY?
	XCT	IOOUT,SIMIO	; YES, FORCE OUTPUT
	JRST	RESTR
	JRST	RESTR

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

; SPECIAL DUMP-MODE OUTPUT STUFF

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

ENDCOM(OUT)