Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/albstb.mac
There are 7 other files named albstb.mac in the archive. Click here to see a list.
; UPD ID= 1383 on 9/23/83 at 11:16 AM by KILGORE
TITLE ALBSTB FOR LIBOL
SUBTTL ALPHANUMERIC CONVERSION TABLES FOR BIS.
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) 1975, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
;REVISION HISTORY:
;V10 *****
; 6-JUL-75 /ACK EXTRACTED THIS MODULE FROM EASTBL.
;*****
SEARCH LBLPRM ;DEFINE ASSEMBLY PARAMETERS.
%%LBLP==:%%LBLP
SEARCH CHREQV ;DEFINE THE CHARACTER SET EQUIVALENCES.
SEARCH NUMEQV ;DEFINE THE NUMERIC EQUIVALENCES.
SEARCH FLGDF ;DEFINE THE FLAGS.
LDGCH.==:LDGCH.
SPCCH.==:SPCCH.
IBNCH.==:IBNCH.
VALCH.==:VALCH.
SALL
HISEG
.COPYRIGHT ;Put standard copyright statement in REL file
; ALP.XX TABLES
;
; THESE ARE USED BY:
;
; EDIT - TO PROCESS ALPHA EDITS AND NON-EDITED BLANK WITH ZERO
; MOVES. THE N FLAG IS SET WHEN ANY NON-ZERO CHARACTER
; IS ENCOUNTERED.
;
; CD.XX - FOR THE CONVERTED MOVES
;
; ALPHAS - USES THE 6/7/9TO7 TABLES TO DETECT ALPHAS
; THE M FLAG IS SET WHEN A NON-ALPHA CHARACTER IS SEEN
;
; NOTE.1: for XDML, a component of DBMS-20 V.6.1, the 7<=>9 bit conversion
; tablea must be available in ALBSTB.REL, with the tags ALP.79 (7->9) and
; ALP.97 (7<-9). It is expected that ALBSTB.REL can be extracted from the
; current COBOL link-time library (COBLIB, C74LIB, LIBOL, etc.), for use by
; XDML. Please note this when making any changes to this file.
; BASIC ALP.XX GENERATION MACRO
DEFINE ALP.TB(SRC,DST,MCHKST)
< .XCREF
BTBMAC(SRC,DST) ;GENERATE MACROS
DEFINE MCHK<MCHKST> ;DEFINE M FLAG USAGE
%CHAR==0
DEFINE SYMBL
< IFDIF <SRC><DST>,<SYM%==ALPSYM(\%CHAR)>
IFIDN <SRC><DST>,<SYM%==%CHAR>
ZERO ;IS IT ZERO - IF NOT SIGSET
IFALSE VAL,<SIGSET>
MCHK ;SET M FLAG IF NECESSARY
%CHAR==%CHAR+1
>
TBLSIZ
REPEAT VAL,<
SYMBL
SYM1==SYM%
SYMBL
XWD SYM1,SYM%
>
.CREF
>
; DEFINE THE ALP.X6 TABLES
; SIXBIT IS ENCOMPASSED BY THE ASCII
ENTRY ALP.76
ALP.76::
ENTRY ALP.66
ALP.66=:.+20
ALP.TB (A,S,<>) ;ASCII TO SIXBIT CONVERSION
ENTRY ALP.96
ALP.96::
ALP.TB (E,S,<>) ;EBCDIC TO SIXBIT
;NOW THE ALP.X7 TABLES
ENTRY ALP.77
ALP.77::
ENTRY ALP.67
ALP.67=.+20
ALP.TB (A,A,< IFALSE ALPHAB(\%CHAR),<MSET>>) ;ASCII TO ASCII
ENTRY ALP.97 ;*** see NOTE.1 above
ALP.97::
ALP.TB (E,A,< IFALSE ALPHAB(\%CHAR),<MSET>>) ;EBCDIC TO ASCII
; NOW THE ALP.X9 TABLES
ENTRY ALP.79 ;*** see NOTE.1 above
ALP.79::
ENTRY ALP.69
ALP.69=.+20
ALP.TB (A,E,<>) ;ASCII TO EBCDIC
ENTRY ALP.99
ALP.99::
ALP.TB (E,E,<>) ;EBCDIC TO EBCDIC
; DEFINE THE ASCII LOWER CASE TO UPPER CASE CONVERSION TABLE
ENTRY ALP.7U
ALP.7U:
ALP.TB (A,U,<>) ;ASCII LOWER TO UPPER CONVERSION
;DEFINE THE EBCDIC TO UPPER CASE ASCII CONVERSION TABLE
ENTRY ALP.9U
ALP.9U:
ALP.TB (E,U,< IFALSE ALPHAB (\%CHAR),<MSET>>) ;EBCDIC TO UPPER ASCII
;These tables are used only for ALPHABETIC tests.
ENTRY ALPS.6,ALPS.7,ALPS.9
;In all these tables, the half word is zero if OK, abort bit if not
;Abort if not space, "A" through "Z", or "a" through "z"
ALPS.7:
REPEAT 20,<XWD T.ABRT,T.ABRT> ;0 THRU 37
ALPS.6:
XWD 0,T.ABRT ;SPACE,,41
REPEAT 17,<XWD T.ABRT,T.ABRT> ;42 THRU 77
XWD T.ABRT,0 ;100,,A
REPEAT 14,<XWD 0,0> ;B THRU Y
XWD 0,T.ABRT ;Z,,133
REPEAT 2,<XWD T.ABRT,T.ABRT> ;134 THRU 137
XWD T.ABRT,0 ;140,,a
REPEAT 14,<XWD 0,0> ;b THRU y
XWD 0,T.ABRT ;z,,173
;174 THRU 177 IS FIRST PART OF ALPS.9
ALPS.9:
REPEAT 40,<XWD T.ABRT,T.ABRT> ;0 THRU 77
XWD 0,T.ABRT ;SPACE,,101
REPEAT 37,<XWD T.ABRT,T.ABRT> ;102 THRU 177
XWD T.ABRT,0 ;200,,a
REPEAT 4,<XWD 0,0> ;b THRU i
REPEAT 3,<XWD T.ABRT,T.ABRT> ;212 THRU 217
XWD T.ABRT,0 ;220,,j
REPEAT 4,<XWD 0,0> ;k THRU r
REPEAT 4,<XWD T.ABRT,T.ABRT> ;232 THRU 241
REPEAT 4,<XWD 0,0> ;s THRU z
REPEAT 13,<XWD T.ABRT,T.ABRT> ;252 THRU 277
XWD T.ABRT,0 ;300,,A
REPEAT 4,<XWD 0,0> ;B THRU I
REPEAT 3,<XWD 0,0> ;312 THRU 317
XWD T.ABRT,0 ;320,,J
REPEAT 4,<XWD 0,0> ;K THRU R
REPEAT 4,<XWD T.ABRT,T.ABRT> ;332 THRU 341
REPEAT 4,<XWD 0,0> ;S THRU Z
IFE ANS82,<
REPEAT 13,<XWD T.ABRT,T.ABRT> ;352 THRU 377
>
IFE ANS82,<
;352 THRU 377 IS FIRST PART OF ALPU.7
>
;These tables are used only for ALPHABETIC-LOWER and ALPHABETIC-UPPER tests.
IFN ANS82,< ENTRY ALPL.7,ALPL.9,ALPU.7,ALPU.9
;In all these tables, the half word is zero if OK, abort bit if not
;Upper case test, abort if not space or "A" through "Z"
ALPU.7:
REPEAT 20,<XWD T.ABRT,T.ABRT> ;0 THRU 37
XWD 0,T.ABRT ;SPACE,,41
REPEAT 17,<XWD T.ABRT,T.ABRT> ;42 THRU 77
XWD T.ABRT,0 ;100,,A
REPEAT 14,<XWD 0,0> ;B THRU Y
XWD 0,T.ABRT ;Z,,133
REPEAT 2,<XWD T.ABRT,T.ABRT> ;134 THRU 137
;140 THRU 177 IS FIRST PART OF ALPL.7
;Upper case test, abort if not space or "A" through "Z"
ALPL.7:
REPEAT 20,<XWD T.ABRT,T.ABRT> ;0 THRU 37
XWD 0,T.ABRT ;SPACE,,41
REPEAT 37,<XWD T.ABRT,T.ABRT> ;42 THRU 137
XWD T.ABRT,0 ;140,,a
REPEAT 14,<XWD 0,0> ;b THRU y
XWD 0,T.ABRT ;z,,173
REPEAT 2,<XWD T.ABRT,T.ABRT> ;174 THRU 177
;Lower case test, abort if not space or "a" through "z"
ALPL.9:
REPEAT 40,<XWD T.ABRT,T.ABRT> ;0 THRU 77
XWD 0,T.ABRT ;SPACE,,101
REPEAT 37,<XWD T.ABRT,T.ABRT> ;102 THRU 177
XWD T.ABRT,0 ;200,,a
REPEAT 4,<XWD 0,0> ;b THRU i
REPEAT 3,<XWD T.ABRT,T.ABRT> ;212 THRU 217
XWD T.ABRT,0 ;220,,j
REPEAT 4,<XWD 0,0> ;k THRU r
REPEAT 4,<XWD T.ABRT,T.ABRT> ;232 THRU 241
REPEAT 4,<XWD 0,0> ;s THRU z
REPEAT 13,<XWD T.ABRT,T.ABRT> ;252 THRU 277
;300 THRU 377 IS FIRST PART OF ALPU.9
;Upper case test, abort if not space or "A" through "Z"
ALPU.9:
REPEAT 40,<XWD T.ABRT,T.ABRT> ;0 THRU 77
XWD 0,T.ABRT ;SPACE,,101
REPEAT 77,<XWD T.ABRT,T.ABRT> ;102 THRU 277
XWD T.ABRT,0 ;300,,A
REPEAT 4,<XWD 0,0> ;B THRU I
REPEAT 3,<XWD 0,0> ;312 THRU 317
XWD T.ABRT,0 ;320,,J
REPEAT 4,<XWD 0,0> ;K THRU R
REPEAT 4,<XWD T.ABRT,T.ABRT> ;332 THRU 341
REPEAT 4,<XWD 0,0> ;S THRU Z
REPEAT 13,<XWD T.ABRT,T.ABRT> ;352 THRU 377
>
END ;ALBSTB.MAC