Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/setret.mac
There are 16 other files named setret.mac in the archive. Click here to see a list.
; UPD ID= 1343 on 8/2/83 at 4:21 PM by NIXON                            
TITLE	SETRET FOR COBLIB		
SUBTTL	SET-UP AND RETURN ROUTINES	AL BLACKINGTON/CAM/ACK

	SEARCH COPYRT
	SALL

;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, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	LBLPRM		;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP
IFN TOPS20,<SEARCH MACSYM>
IFE TOPS20,<SEARCH MACTEN>

	HISEG
	.COPYRIGHT		;Put standard copyright statement in REL file

;REVISION HISTORY:

;V10 *****

;	15-DEC-74	/ACK	ADDED ROUTINES SET1. AND SET2.

;	5/15/75		/DBT	ADDED BSET1. AND BSET2. FOR BIS
;*****

ENTRY RET.1,RET.2,RET.3
	ENTRY	SET1.		;TO PICK UP ONE PARAMETER AND BREAK IT DOWN.
	ENTRY	SET2.		;TO PICK UP TWO PARAMETERS AND BREAK THEM DOWN.


; 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,
					; INITIALIZE THE SWITCHES AND
					; PRESERVE THE INPUT CODE.

INPUT CONDITIONS:
	(CH)	=	THE INPUT CODE:
				6 ==> SIXBIT
				7 ==> ASCII
				8 ==> EBCDIC

EXIT CONDITIONS:
	SET1.:
		(SW)
			BIT	0	ALWAYS 1
			BIT	1	THE OPERATIONAL SIGN FLAG.
			BITS	2-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

\

SET1.:	HRRZI	SW,	(CH)		;CLEAR ALL SWITCHES AND SAVE THE INPUT CODE.
	TXO	SW,1B0			;SET BIT 0 IN CASE RUNNING IN NON-ZERO SECTION.
	MOVE	IPTR,	(PARM)		;GET THE INPUT PARAMETER.
	TLZE	IPTR,	4000		;CLEAR THE SIGN FLAG.
	TXO	SW,	SW.SGN		;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.
;	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.
	TXO	SW,1B0			;SET BIT 0 IN CASE RUNNING IN NON-ZERO SECTION.
	MOVE	SRCPT,	(PARM)		;GET THE INPUT PARAMETER.
	TLZE	SRCPT,	4000		;CLEAR THE SIGN FLAG.
	TXO	SW,	SW.SGN		;IF IT WAS ON, SET THE SIGN FLAG.
	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.
	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

\

 IFN OPTR-IPTR-1,<PRINTX OPTR NOT = IPTR+1>
SET2.:	DMOVE	IPTR,	(PARM)		;GET THE INPUT POINTER.
					;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.




; 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