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