Google
 

Trailing-Edge - PDP-10 Archives - BB-H506D-SM_1983 - cobol/source/alf.mac
There are 5 other files named alf.mac in the archive. Click here to see a list.
TITLE	ALF FOR LIBOL
SUBTTL	 CHECK STRING FOR ALPHABETICS ONLY	/ACK



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


;REVISION HISTORY:

;V10 *****

;	13-DEC-74	/ACK	CREATION.

;	5/12/75	/DBT	ADD BIS CODE
;*****

	SEARCH	LBLPRM		;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP
	EBCMP.==:EBCMP.
	BIS==:BIS

	EXTERN	EASTB.		;FORCE EASTBL TO BE LOADED.

	HISEG

COMMENT	\

	THIS ROUTINE CHECKS A STRING TO SEE IF IT CONTAINS ONLY ALPHABETIC
CHARACTERS.

CALL:
	MOVEI	16,PARAMETER ADDRESS
	PUSHJ	17,ALF.6/ALF.7/ALF.9

PARAMETERS:
	BITS	0-5	BYTE POINTER RESIDUE FOR INPUT FIELD.
	BIT	6	IGNORED (1 IF THE FIELD IS SIGNED.)
	BITS	7-17	SIZE OF THE INPUT FIELD.
	BITS	18-35	ADDRESS OF THE FIRST CHARACTER OF THE INPUT FIELD.

RETURNS:
	CALL+1	IF THE STRING LENGTH IS ZERO OR CONTAINS A NON
		ALPHABETIC CHARACTER.
	CALL+2	IF THE STRING CONTAINS ONLY ALPHABETIC CHARACTERS.

REGISTERS USED:
	CH, MASK, JAC, IPTR, CNT, SW

\
	ENTRY	ALF.6		;IF THE STRING IS SIXBIT.
	ENTRY	ALF.7		;IF THE STRING IS ASCII.
IFN EBCMP.,<
	ENTRY	ALF.9		;IF THE STRING IS EBCDIC.
>

IFE	BIS,<

;LOCAL AC DEFINITIONS:

	MASK==TAC4

	EXTERN	RET.1		;RETURNS TO CALL+1
	EXTERN	RET.2		;RETURNS TO CALL+2
	EXTERN	SET1.		;PICKS UP THE PARAMETERS.
	EXTERN	TYPCD.		;TABLE OF CHARACTER TYPE CODES.
	EXTERN	ALFMS.		;TABLE OF ALPHABETIC TYPE CODE MASKS.

ALF.6:	JSP	CH,	ALF	;ENTER HERE IF THE INPUT IS SIXBIT,
ALF.7:	JSP	CH,	ALF	; HERE IF IT IS ASCII AND
IFN EBCMP.,<
ALF.9:	JSP	CH,	ALF	; HERE IF IT IS EBCDIC.
>

ALF:	SUBI	CH,	ALF.6-5		;FIND OUT WHAT THE INPUT LOOKS LIKE.
	MOVE	MASK,	ALFMS.-6(CH)	;SELECT THE APPROPRIATE MASK.
	JSP	JAC,	SET1.		;GO SET UP THE PARAMETERS.
					;NOTE:  IF THE STRING LENGTH IS ZERO
					; WE RETURN TO CALL+1, NOT HERE.

ALF1:	ILDB	CH,	IPTR		;GET A CHAR.
	AND	MASK,	TYPCD.(CH)	;GET ITS ALPHABETIC FLAG.
	JUMPE	MASK,	RET.1		;RETURN TO CALL+1 IF IT'S NOT ALPHABETIC.
	SOJG	CNT,	ALF1		;LOOP IF THERE ARE MORE CHARS,
	JRST		RET.2		;OTHERWISE RETURN TO CALL+2 - ALL ALPHABETIC.

>
IFN	BIS,<

	EXTERN	RET.1		;RETURNS TO CALL+1
	EXTERN	RET.2		;RETURNS TO CALL+2
	EXTERN	BSET1.		;PICKS UP THE PARAMETERS.

ALF.6:	JSP	BISCH,	ALF	;ENTER HERE IF THE INPUT IS SIXBIT,
ALF.7:	JSP	BISCH,	ALF	; HERE IF IT IS ASCII AND
IFN EBCMP.,<
	BLOCK	1
ALF.9:	JSP	BISCH,	ALF	; HERE IF IT IS EBCDIC.
>

ALF:	SUBI	BISCH,	ALF.6-5		;FIND OUT WHAT THE INPUT LOOKS LIKE.
	JSP	JAC,	BSET1.		;GO SET UP THE PARAMETERS.
					;NOTE:  IF THE STRING LENGTH IS ZERO
					; WE RETURN TO CALL+1, NOT HERE.

ALF1:
	MOVE	DSTCNT,SRCCNT		;MAKE SRC AND DST SIZES SAME
	SETZ	DSTPT,			;NO OUTPUT HOWEVER
	TLO	B.FLAG,BFLG.S		;TURN SIGNIFICANCE ON
	EXTEND	B.FLAG,ALFE0-6(BISCH)	;GO
	JRST	ERROR			;TROUBLE
	TLNN	B.FLAG,BFLG.M		;M FLAG WILL BE SET FOR NON-ALPH
	AOS	(PP)			;GOOD - NO ALPHAS
	POPJ	PP,			;BAD

ALFE0:	MOVST	ALPS.6##
	MOVST	ALPS.7##
	0
	MOVST	ALPS.9##

ERROR:	OUTSTR	[ASCIZ	'?LIBOL ALF.N ERROR
']
	POPJ	PP,		;SOMETHING IS WRONG HERE

>
	END		;ALF