TITLE	SETRET FOR RPGII V1		
SUBTTL	SET-UP AND RETURN ROUTINES	AL BLACKINGTON/CAM/ACK/RBC

;USED TO BE
;COPYRIGHT 1974, 1975, DIGITAL EQUIPMENT CORP., MAYNARD, MA.
;BUT MODIFIED TO RPGII VERSION 1/14/76, BOB CURRIER

;REVISION HISTORY:
;V1 *****
;	15-DEC-74	/ACK	ADDED ROUTINES SET1. AND SET2.
;	5/15/75		/DBT	ADDED BSET1. AND BSET2. FOR BIS
;	1/14/76		/RBC	MODIFIED TO SUPPORT RPGII.
;*****
	SEARCH	RPGPRM		;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP
	BIS==:BIS
	HISEG
ENTRY SET.1,SET.2,SET.3
ENTRY RET.1,RET.2,RET.3
	ENTRY	SET1.		;TO PICK UP ONE PARAMETER AND BREAK IT DOWN.
	ENTRY	SET1A.		;ANOTHER ENTRY POINT FOR SET1.
	ENTRY	SET2.		;TO PICK UP TWO PARAMETERS AND BREAK
				; THEM DOWN.


; THE FOLLOWING ARE ENTRY POINTS FOR SETTING UP PARAMETERS IN AC'S

SET.3:	MOVE 15,2(16)		;3 PARAMETERS DESIRED
SET.2:	MOVE 14,1(16)		;2 PARAMETERS DESIRED
SET.1:	MOVE 13,0(16)		;1 PARANETER  DESIRED
	POPJ 17,


; THE FOLLOWING ARE RETURN POINTS FOR THE SUB-ROUTINES

RET.3:	AOS	(17)		;RETURN TO CALL+3
RET.2:	AOS	(17)		;RETURN TO CALL+2
RET.1:	POPJ	17,		;RETURN TO CALL+1
	SUBTTL	SET1. - SET UP ONE PARAMETER
COMMENT	\
	THIS ROUTINE SETS UP A SINGLE PARAMETER.
CALLS:
	JSP	JAC,	SET1.		;TO PICK UP THE PARAMETERS,
OR	JSP	JAC,	SET1A.		; INITIALIZE THE SWITCHES AND
					; PRESERVE THE INPUT CODE.
INPUT CONDITIONS:
	(CH)	=	THE INPUT CODE:
				6 ==> SIXBIT
				7 ==> ASCII
				8 ==> EBCDIC
EXIT CONDITIONS:
	SET1. & SET1A.:
		(SW)
			BIT	0	THE OPERATIONAL SIGN FLAG.
			BITS	1-17	ZERO.
			BITS	18-35	THE INPUT CODE.
		(CNT)	THE FIELD LENGTH.
		(IPTR)	THE INPUT BYTE POINTER.
		(CH)	THE INPUT BYTE SIZE.
RETURNS:
	IF THE FIELD LENGTH IS ZERO WE RETURN TO CALLER'S CALLER AT CALL+1.
	IF THE FIELD LENGTH IS NON ZERO WE RETURN TO CALLER AT CALL+1.
REGISTERS MODIFIED:
	SW, CH, IPTR, CNT
\
SET1A.:
SET1.:	HRRZI	SW,	(CH)		;CLEAR ALL SWITCHES AND SAVE THE
					; INPUT CODE.
	MOVE	IPTR,	(PARM)		;GET THE INPUT PARAMETER.
	TLZE	IPTR,	4000		;CLEAR THE SIGN FLAG.
	HRLI	SW,	(1B0)		;IF IT WAS ON, SET THE SIGN SWITCH.
	LDB	CNT,	SLPTR1		;GET THE STRING LENGTH.
	TLZN	IPTR,	3777		;CLEAN UP THE BYTE POINTER.
	POPJ	PP,			;RETURN TO CALLER'S CALLER ON A
					; NULL STRING.
	TRNN	SW,	7		;IS THE INPUT EBCDIC.
	MOVEI	CH,	^D9		;YES, THEN IT'S REALLY 9 BITS

					; PER BYTE.
	DPB	CH,	PTIBS.		;PUT IT IN THE BYTE POINTER.
	JRST		(JAC)		;RETURN.


IFE	BIS,<XLIST>
IFN	BIS,<

;	BSET1. IS THE BIS EQUIVALENT OF SET1.
;	BISCH IS THE SAME AS CH
;	SRCPT IS THE SAME AS IPTR
;	SRCCNT IS THE SAME AS CNT

;	INPUT CODES ARE 6/7/9 IE BYTE SIZE

ENTRY	BSET1.,BSET2.

BSET1.:	HRRZI	SW,	(BISCH)		;CLEAR ALL SWITCHES AND SAVE THE
					; INPUT CODE.
	MOVE	SRCPT,	(PARM)		;GET THE INPUT PARAMETER.
	TLZE	SRCPT,	4000		;CLEAR THE SIGN FLAG.
	HRLI	SW,	(1B0)		;IF IT WAS ON, SET THE SIGN SWITBISCH.
	LDB	SRCCNT,	BSLPT1		;GET THE STRING LENGTH.
	TLZN	SRCPT,	3777		;CLEAN UP THE BYTE POINTER.
	POPJ	PP,			;RETURN TO CALLER'S CALLER ON A
					; NULL STRING.
	DPB	BISCH,	BPTIBS		;PUT BYTE SIZE IN THE BYTE POINTER.
	JRST		(JAC)		;RETURN.

>	;END OF BIS
LIST
	SUBTTL	SET2. - SET UP TWO PARAMETERS.
COMMENT	\
	THIS ROUTINE SETS UP TWO PARAMETERS.
CALL:
	JSP	JAC,	SET2.
INPUT CONDITIONS:
	RH(PARM)	POINTS AT THE FIRST PARAMETER.
EXIT CONDITIONS:
	(IPTR)	=	THE INPUT BYTE POINTER.
	(OPTR)	=	THE OUTPUT BYTE POINTER WITH A NULL S FIELD.
	(CNT)	=	THE SIZE OF BOTH FIELDS.
RETURNS:
	@CALL+1	IF THE SIZE OF THE FIELDS IS ZERO.
	CALL+2	OTHERWISE.
REGISTERS MODIFIED:
	IPTR, OTPR, CNT
\
SET2.:	MOVE	IPTR,	(PARM)		;GET THE INPUT POINTER.
	MOVE	OPTR,	1(PARM)		;GET THE OUTPUT POINTER.
	LDB	CNT,	SLPTR2		;GET THE FIELD LENGTH.
	JUMPE	CNT,	@(JAC)		;RETURN THROUGH CALL+1 ON A
					; NULL STRING.
	TLZ	OPTR,	7777		;CLEAN UP THE BYTE POINTER.
	JRST		1(JAC)		;RETURN TO CALL+2.
;POINTERS TO VARIOUS FIELDS IN THE PARAMETERS.
SLPTR1:	POINT	11,IPTR,17	;POINTS AT THE LENGTH FIELD FOR ONE
				; PARAMETER ROUTINES.
SLPTR2:	POINT	11,OPTR,17	;POINTS AT THE LENGTH FIELD FOR TWO
				; PARAMETER ROUTINES.
	INTERN	PTIBS.
	INTERN	PTOBS.
	INTERN	PACFL.
PTIBS.:	POINT	6,IPTR,11	;POINTS AT THE S FIELD OF IPTR.
PTOBS.:	POINT	6,OPTR,11	;POINTS AT THE S FIELD OF OPTR.
PACFL.:	POINT	4,PARM,12	;POINTS AT THE AC FIELD OF THE AC
				; CONTAINING THE POINTER TO THE PARAMETERS.



IFE	BIS,<XLIST>
IFN	BIS,<

; BSET2. IS THE BIS EQUIVALENT OF SET2.
;
;	IT SETS UP SRCPT, DSTPT, SRCCNT, AND DSTCNT

BSET2.:	MOVE	SRCPT,	(PARM)		;GET THE INPUT POINTER.
	MOVE	DSTPT,	1(PARM)		;GET THE OUTPUT POINTER.
	LDB	SRCCNT,	BSLPT2		;GET THE FIELD LENGTH.
	JUMPE	SRCCNT,	@(JAC)		;RETURN THROUGH CALL+1 ON A
					; NULL STRING.
	MOVE	DSTCNT,	SRCCNT		;SOURCE AND DESTINATION SAME SIZE
	TLZ	DSTPT,	7777		;CLEAN UP THE BYTE POINTER.
	JRST		1(JAC)		;RETURN TO CALL+2.
;POINTERS TO VARIOUS FIELDS IN THE PARAMETERS.
BSLPT1::	POINT	11,SRCPT,17	;POINTS AT THE LENGTH FIELD FOR ONE
				; PARAMETER ROUTINES.
BSLPT2::	POINT	11,DSTPT,17	;POINTS AT THE LENGTH FIELD FOR TWO
				; PARAMETER ROUTINES.
	INTERN	BPTIBS
	INTERN	BPTOBS
BPTIBS:	POINT	6,SRCPT,11	;POINTS AT THE S FIELD OF SRCPT.
BPTOBS:	POINT	6,DSTPT,11	;POINTS AT THE S FIELD OF DSTPT.

>

	END