Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE	RELITN
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
	ENTRY	REL$L,REL$

REL$L:	AOS	-1(P)	;PASS LEN RATHER THAN POS
REL$:
	ST.POS=T1
	ST.IBP=T0	;T0=T1+1

	EXCH	SVP,-2(P)	;ADDR OF RETURN ARRAY
	EXCH	ST.POS,-1(P)	;POSITION TO ADJUST TO
	SAVE <ST.IBP>
	SUBI	ST.POS,1	;POS-POS REQUIRES ADJUSTMENT BY ONE TO GET THINGS RIGHT
	HRRZ	ST.IBP,1(SVP)	;LEN
	SUB	ST.IBP,ST.POS
	IFE CHECK,<
	TLNE	ST.IBP,777777	;HALF-WORD MAXES ON MAX & LEN
	ERROR	UOF$##>
	MOVEM	ST.IBP,1(SVP)

	IFE BND.CH,<
	HRRZ	ST.IBP,2(SVP)	;MAXLEN
	SUB	ST.IBP,ST.POS
	IFE CHECK,<
	TLNE	ST.IBP,777777	;HALF-WORD MAXES ON MAX & LEN
	ERROR	UOF$##>
	MOVEM	ST.IBP,2(SVP)>

	IFE ANYSIZ,<
	LDB	ST.IBP,[BPSIZ2,,0]
	IDIV	ST.POS,CPW$##(ST.IBP)>
	IFN ANYSIZ,<
	IDIVI	ST.POS,CPW>	;SETS UP ST.IBP
	ADDM	ST.POS,0(SVP)	;UPDATE BYTEP BY WORDS
	JUMPLE	ST.IBP,REL$C
REL$1:	IBP	0(SVP)
	SOJG	ST.IBP,REL$1
REL$E:
	RESTOR	<ST.IBP>
	EXCH	SVP,-2(P)
	EXCH	ST.POS,-1(P)
	POPJ	P,
REL$C:	JUMPE	ST.IBP,REL$E
	IFE CHECK,<
	ERROR	SLI$##>		;NOTED BUT ALLOWED
	IFE ANYSIZ,<
	LDB	ST.POS,[BPSIZ2,,0]
	ADD	ST.IBP,CPW$##(ST.POS)>
	IFN ANYSIZ,<
	ADDI	ST.IBP,CPW>	;MOVES MOD5 UP A LEVEL
	JRST	REL$1
	PRGEND

;	******************

	TITLE	CANON$
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

	ENTRY	CANON$
CANON$:
	ADDI	R0,TYP.X1
	JRST	@R0		;DATA TYPE INDEXED TABLE (IMMED. FOLLOWS)

TYP.X1:
	JRST	STR.SP		;FOR INTERNAL USE AND STRING PTR CONSTANT
	JRST	STR.C		;LOGICAL TREAT AS DATA-VARYING STRING
	JRST	STR.5		;INTEGER IS LEN=5
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	JRST	STR.5		;REAL IS LEN=5
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	JRST	STR.10		;DP IS LEN=10
	JRST	STR.10		;COBOL COMP-2
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	JRST	STR.SP		;COMPLEX IS STRING PTR
	JRST	STR.SP		;BYTE DESCRIPTOR IS STR PTR
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	JRST	STR.Z		;ASCIZ

STR.SP:	MOVE	R0,0(R1)	; SET UP USER'S (UBS)
	MOVE	R1,1(R1)	;THE LEN & MAX
	IFE BND.CH,<
	TLNN	R1,777777	;WILL EQUATE 0 (NO SKIP) TO MAX
	TLO	R1,777777>	;AFFECT OF ORING LEFT SIDE
	POPJ	P,

STR.C:	MOVE	R0,R1	;BUILD (UBS) FROM USER'S STR. PTR
	HRLI	R0,IPOSIZ
	MOVE	R1,-1(R1)	;CNT IS BEFORE WORD PTED. AT BY ARG
	IFE BND.CH,<
	TLNN	R1,777777	;WILL EQUATE 0 (NO SKIP) TO MAX
	TLO	R1,777777>	;AFFECT OF ORING LEFT SIDE
	POPJ	P,

STR.Z:	SAVE <C1>
	HRLI	R1,IPOSIZ	;BYTE PTR TO ---Z STRING
	PUSH	P,R1		;WILL NEED LATER
	SETZ	R0,
STR.Z1:	ILDB	C1,R1
	SKIPE	C1
	AOJA	R0,STR.Z1
	IFN BND.CH, <HRRZ	R1,R0>
	IFE BND.CH, <HRRO	R1,R0>
	POP	P,R0		;THE BP
	RESTOR	<C1>
	POPJ	P,

STR.10:	MOVE	R0,R1
	HRLI	R0,IPOSIZ
	IFN BND.CH, <MOVEI	R1,12>
	IFE BND.CH, <MOVE	R1,[12,,12]>	;LEN AND MAX
	POPJ	P,
STR.5:	MOVE	R0,R1
	HRLI	R0,IPOSIZ
	IFN BND.CH, <MOVEI	R1,5>
	IFE BND.CH, <MOVE	R1,[5,,5]>	;DITTO FOR SING. PREC.
	POPJ	P,
	PRGEND

;	*******************

	TITLE	RAX$
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	RAX$
RAX$:				;RESTORE ALL AND EXIT
	POPALL
	POPJ	P,
	PRGEND

;	******************

	TITLE	CB.SV$
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	CB.SV$,CB.FA$
CB.SV$:				;CMBSTR SAV REGS AND ARG SET UP
	SAVALL
	JRST	0(R1)
CB.FA$:	SETZ	R0,
	SETZ	R1,
	RETURN
	PRGEND

;	****************

	TITLE	FC.SV$
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	FC.SV$
FC.SV$:				;FNDCHAR SAVE REGS AND ARG SET UP
	SAVALL
	MOVEI	MODE,RETUBS	;WILL BE CHECKED BY FNDCHR EXIT CODE
	MOVEI	BASP,@1(AP)
	MOVE	MASK,@2(AP)
	JRST	0(R1)
	PRGEND

;	*****************

	TITLE	FS.SV$
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	FS.SV$
FS.SV$:				;DITTO FOR FNDSTR.
	SAVALL
	MOVEI	CAP,1(AP)	;SET UP CURR ARG PTR
	MOVEI	MODE,RETUBS ! MORE.1
	JRST	0(R1)
	PRGEND

;	***************

	TITLE	CS.SV$
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	CS.SV$
CS.SV$:				;DITTO FOR CMPSTR.
	SAVALL
	MOVE	MODE,@2(AP)
	JRST	0(R1)
	END