Trailing-Edge
-
PDP-10 Archives
-
BB-J724A-SM_1980
-
sources/macros.p11
There are 14 other files named macros.p11 in the archive. Click here to see a list.
.SBTTL MACROS - SOME USEFUL PDP-11 MACROS
;
; THESE MACROS ARE INTENDED TO IMPROVE THE READABILITY
; OF THE CODE AND MAKE MODEL-INDEPENDENT CODE EASIER
; TO WRITE.
;
;
.REPT 0
COPYRIGHT (c) 1980, 1979
DIGITAL EQUIPMENT CORPORATION, maynard, mass.
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
TRANSFERRED.
THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
CORPORATION.
DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
.ENDR
;
;
;
; Revision History
;
; 3(001) 18-Apr-79 JW Add the PION/PIOFF macros
;
; 3(002) 3-MAY-79 BS ADD MACROS TO TRANSLATE EBCDIC TO ASCII
;
;
;
;
VMACRO=002
;
;
VEDIT=VEDIT+VMACRO
;
;
;PJMP IS USED IN PLACE OF THE LAST PAIR OF INSTRUCTIONS IN A SUBROUTINE
; WHEN THEY ARE JSR PC, FOLLOWED BY RTS PC. PJMP IS USED INSTEAD OF
; JSR PC, SO THAT SOMEONE READING THE CODE WILL UNDERSTAND THAT
; A SUBROUTINE IS BEING CALLED.
;
.MACRO PJMP WHERE
JMP WHERE
.ENDM PJMP
.MACRO PBRNCH WHERE
BR WHERE
.ENDM PBRNCH
;MACROS TO SIMULATE COMPLEX INSTRUCTIONS FOR SIMPLE PDP11'S
; AND NEW INSTRUCTIONS FOR OLD PDP11'S
.IF LT <PDP11-30>
;MACRO TO SIMULATE SOB ON SIMPLE PDP11'S
;
.MACRO SOB CNT,WHERE
DEC CNT
.IF DIF WHERE,.
.IFT
BNE WHERE
.IFF
BNE .-2
.ENDC ;.IF DIF WHERE,.
.ENDM SOB
;
;
;MACRO TO DO AN XOR FOR OLD, SIMPLE PDP11'S
;
.IF NE,<PDP11-03>
.MACRO XOR2 A02,B02,B12,B22,C02,C12,C22
MOV A02,C02
BIC B02,C12
BIC A02,B12
BIS C22,B22
.ENDM XOR2
.MACRO XOR1 A01,B01,B11,B21
XOR2 A01,B01,B11,B21,-(SP),(SP),(SP)+
.ENDM XOR1
.MACRO XORERR AV,BV,DB
.IF B DB
.ERROR 74000; XOR SOURCE ('AV') NOT A REGISTER ???
.IFF
.ERROR <74000+AV*100+BV>; XOR WITH DEST DB IS NOT SUPPORTED ????
.ENDC
HALT
.ENDM XORERR
.MACRO XOR A,B
.NTYPE QA,A
.IF NE QA&^C7
XORERR \QA
.IFF
.NTYPE QB,B
QC=QB&70
QD=QB&7
.IF LE <QD-5>
.IF LE <QC-10>
XOR1 A,B,B,B
.IFF
.IF GE <QC-60>
XOR1 A,B,B,B
.IFF
.IF EQ <QC-20>
.IIF EQ QD, XOR1 A,(R0),(R0),(R0)+
.IIF EQ QD-1, XOR1 A,(R1),(R1),(R1)+
.IIF EQ QD-2, XOR1 A,(R2),(R2),(R2)+
.IIF EQ QD-3, XOR1 A,(R3),(R3),(R3)+
.IIF EQ QD-4, XOR1 A,(R4),(R4),(R4)+
.IIF EQ QD-5, XOR1 A,(R5),(R5),(R5)+
.IFF
.IF EQ <QC-30>
.IIF EQ QD, XOR1 A,@(R0),@(R0),@(R0)+
.IIF EQ QD-1, XOR1 A,@(R1),@(R1),@(R1)+
.IIF EQ QD-2, XOR1 A,@(R2),@(R2),@(R2)+
.IIF EQ QD-3, XOR1 A,@(R3),@(R3),@(R3)+
.IIF EQ QD-4, XOR1 A,@(R4),@(R4),@(R4)+
.IIF EQ QD-5, XOR1 A,@(R5),@(R5),@(R5)+
.IFF
.IF EQ <QC-40>
.IIF EQ QD, XOR1 A,-(R0),(R0),(R0)
.IIF EQ QD-1, XOR1 A,-(R1),(R1),(R1)
.IIF EQ QD-2, XOR1 A,-(R2),(R2),(R2)
.IIF EQ QD-3, XOR1 A,-(R3),(R3),(R3)
.IIF EQ QD-4, XOR1 A,-(R4),(R4),(R4)
.IIF EQ QD-5, XOR1 A,-(R5),(R5),(R5)
.IFF
.IIF EQ QD, XOR1 A,@-(R0),@(R0),@(R0)
.IIF EQ QD-1, XOR1 A,@-(R1),@(R1),@(R1)
.IIF EQ QD-2, XOR1 A,@-(R2),@(R2),@(R2)
.IIF EQ QD-3, XOR1 A,@-(R3),@(R3),@(R3)
.IIF EQ QD-4, XOR1 A,@-(R4),@(R4),@(R4)
.IIF EQ QD-5, XOR1 A,@-(R5),@(R5),@(R5)
.ENDC ;40/50
.ENDC ;30
.ENDC ;20
.ENDC ;60/70
.ENDC ;00,10
.IFF
.IIF EQ <QB-06>, XORERR \QA,\QB,B
.IIF EQ <QB-07>, XORERR \QA,\QB,B
.IIF EQ <QB-16>, XOR1 A,2(SP),2(SP),(SP)
.IIF EQ <QB-17>, XORERR \QA,\QB,B
.IIF EQ <QB-26>, XORERR \QA,\QB,B
.IF EQ <QB-27>
MOV B,.+14
XOR1 A,.+12,.+6,#0
.ENDC ;27
.IIF EQ <QB-36>, XOR1 A,@2(SP),@2(SP),@(SP)+
.IIF EQ <QB-37>, XOR1 A,B,B,B
.IIF EQ <QB-46>, XORERR \QA,\QB,B
.IIF EQ <QB-47>, XORERR \QA,\QB,B
.IIF EQ <QB-56>, XORERR \QA,\QB,B
.IIF EQ <QB-57>, XORERR \QA,\QB,B
.IIF EQ <QB-66>, XOR1 A,2+B,2+B,B
.IIF EQ <QB-67>, XOR1 A,B,B,B
.IIF EQ <QB-76>, XORERR \QA,\QB,B
.IIF EQ <QB-77>, XOR1 A,B,B,B
.ENDC
.ENDC
.ENDM XOR
.ENDC ;.IF NE,<PDP11-03>
.ENDC;.IF LT <PDP11-30>
;
; MACROS TO LOAD AND STORE PS REGISTER. THESE ARE SINGLE
; INSTRUCTIONS ON THE PDP-11/03 AND PDP-11/34.
;
.MACRO MTPS NEWPS
.IF EQ,<<PDP11-03>*<PDP11-34>>
.IFT
XX=.
CLR NEWPS
XXX=.
.=XX
.NTYPE XX,NEWPS
.WORD 106400+XX
.=XXX
.IFF
MOV NEWPS,@#PS
.ENDC ;.IF EQ,<<PDP11-03>*<PDP11-34>>
.ENDM MTPS
.MACRO MFPS DESTI
.IF EQ,<<PDP11-03>*<PDP11-34>>
.IFT
XX=.
CLR DESTI
XXX=.
.=XX
.NTYPE XX,DESTI
.WORD 106700+XX
.=XXX
.IFF
MOV @#PS,DESTI
.ENDC ;.IF EQ,<<PDP11-03>*<PDP11-34>>
.ENDM MFPS
;
;
; MACROS TO TURN INTERRUPTS ON AND OFF
;
.MACRO PIOFF
MFPS -(SP)
MTPS #BR7
.ENDM
.MACRO PION
MTPS (SP)+
.ENDM
;
; MACROS TO COMPUTE BCC. THESE MACROS USE THE KG11-A IF IT
; IS AVAILABLE.
;
; MACRO TO LOAD THE BCC REGISTER. LOADING WITH ZERO CLEARS THE
; REGISTER.
;
.MACRO KGLOAD VALUE
.IF NE,FTKG11
.IFF
.IF DIF <#0>,<VALUE>
MOV #KG.SEN!KG.CLR!KG.DDB!3,@#KG.STS ;CLEAN OUT KG11
MOV VALUE,@#KG.DTA ;LOAD WITH DATA ( VALUE )
MOV #KG.SEN!1,@#KG.STS ;AND SET TO CRC-16
.IFF
MOV #KG.SEN!KG.CLR!1,KG.STS ;CLEAR AND SET TO CRC-16
.ENDC;.IF DIF <#0>,<X>
.IFT
.IF DIF <#0>,<VALUE>
MOV VALUE,KGSIMW ;LOAD BCC REGISTER WITH DATA ( VALUE )
.IFF
CLR KGSIMW ;INITIALIZE BCC ACCUMULATION REG
.ENDC ;.IF DIF,<#0>,<VALUE>
.ENDC ;.IF NE,FTKG11
.ENDM KGLOAD
;
; MACRO TO SAVE THE CURRENT BCC
;
.MACRO KGSAVE DESTI
.IF NE,FTKG11
.IFF
MOV @#KG.BCC,DESTI ;SAVE THE BCC REGISTER
.IFT
MOV KGSIMW,DESTI ;SAVE THE BCC REGISTER
.ENDC ;.IF NE,FTKG11
.ENDM KGSAVE
;
; MACRO TO ACCUMULATE A CHARACTER INTO THE BCC
;
.MACRO KGACUM CHAR
.IF NE,FTKG11
.IFF
MOV CHAR,@#KG.DTA ;INCLUDE THIS CHARACTER IN THE BCC
.IFT
MOVB CHAR,-(SP) ;PUT CHARACTER ON THE STACK
JSR PC,KGSIMA ;INCLUDE IT IN THE BCC
.ENDC ;.IF NE,FTKG11
.ENDM KGACUM
;
;
; MACRO TO TEST THE BCC REGISTER. Z IS SET IF THE BCC IS OK.
;
.MACRO KGTEST
.IF NE,FTKG11
.IFF
TST @#KG.BCC ;DOES THE CRC CHECK?
.IFT
TST KGSIMW ;DOES THE CRC CHECK?
.ENDC ;.IF NE,FTKG11
.ENDM KGTEST
;
;MACROS TO SAVE AND RESTORE REGISTERS
.MACRO SAVE A
.IRP X,<A>
MOV X,-(SP) ;PUSH X ONTO STACK
.ENDM
.ENDM
.MACRO RESTORE A
.IRP X,<A>
MOV (SP)+,X ;POP X FROM STACK
.ENDM
.ENDM
;MACRO TO PROVIDE CHK11 WITH TTY SERVICE
CK.TTK=1
.MACRO .CKTTS
.IF NE CK.TTK
CK.TTK=0
;HERE TO TYPE A MESSAGE STRING
;
; CALL JSR PC,CKTTXT ;R0 CONTAINS ADDR OF TXT
; ON EXIT R0 POINTS TO THE EVEN LOCATION FOLLOWING THE TEXT
;
CKTTXT: SAVE <R1>
10$: MOVB (R0)+,R1 ;GET THE NEXT CHARACTER
BEQ 20$ ;BRANCH IF END (NULL)
JSR PC,CKTCHR ;TYPE CHAR
BR 10$ ;GET NEXT CHAR
20$: INC R0 ;
BIC #B0,R0 ;POINT TO EVEN LOC
CKTRR1: RESTORE <R1>
RTS PC ;RETURN TO CALLER
;HERE TO TYPE A CARRIAGE RETURN AND LINE FEED
;
; CALL JSR PC,CKCRLF
;
CKCRLF: JSR R0,CKTSTR
.ASCIZ <15><12>
.EVEN
RTS PC
;HERE TO TYPE A STRING PRECEEDED BY A CR/LF
;
; CALL JSR R0,CKTCRL
; .ASCIZ \TEXT\
; .EVEN
;
CKTCRL: JSR PC,CKCRLF ;FIRST TYPE A CR/LF
;HERE TO TYPE A MESSAGE ON THE CTY
; CALL JSR R0,CKTSTR ;CALL TYPE ROUTINE
; .ASCIZ \TEXT\
; .EVEN
;
CKTSTR: JSR PC,CKTTXT ;GO TYPE STRING
RTS R0
;TYPE BLANK AND AN OCTAL NUMBER
;
; SIMILIAR TO CKTOCT
;
CKTBOC: SAVE <R1>
MOV #040,R1
JSR PC,CKTCHR
BR CKTOC1
;HERE TO TYPE AN OCTAL NUMBER
;
; CALL JSR PC,CKTOCT ;WITH ARG IN R0
;
CKTOCT: SAVE <R1>
CKTOC1: SAVE <R0>
JSR PC,CKTOC2
CKTRR0: RESTORE <R0>
BR CKTRR1
;RECURSIVE BINARY TO ASCIC CONVERSION
CKTOC2: SAVE <R0>
ROR R0
ROR R0
ROR R0
BIC #160000,R0
BEQ 20$
JSR PC,CKTOC2
20$: RESTORE <R1>
BIC #^C7,R1
BIS #60,R1
;HERE TO TYPE A SINGLE CHARACTER
;
; CALL JSR PC,CKTCHR ;WITH CHAR IN R1
;
CKTCHR: CMPB R1,#40 ;DOES THIS NEED FILLER ?
BHIS 20$
CMPB R1,#11 ;IS CHAR A TAB (11)
BNE 10$ ;BRANCH IF NOT A TAB
JSR R0,CKTSTR ;GIVE SPACES FOR IT
.BYTE 40,40,40,0 ;SUBSTITUTE SPACES FOR TAB
RTS PC
10$: JSR PC,12$ ;TYPE CHAR FIRST THEN PAD IT WITH 4 NULLS
12$: JSR PC,20$
CLR R1
20$: MOVB R1,CTOCHR ;TYPE CHAR
30$: TSTB CTOSTS ;TEST FOR STILL BUSY
BPL 30$
RTS PC
;HERE TO GET A SINGLE CHAR FROM THE KEYBOARD
;
; RETURN WITH CHARACTER IN R1
;
CKGCHR: TST CTICHR ;CLEAR BUFFER
10$: TSTB CTISTS ;WAIT FOR CHAR
BPL 10$ ;
MOVB CTICHR,R1 ;
BIC #^C177,R1 ;KEEP ONLY INTERESTING BITS
BR CKTCHR ;TYPE IT BACK TO HIM
.ENDC
.ENDM .CKTTS
;
;
;
;
.REPT 0
The following macros implement an easily-definable (and therefore
easily modifiable) set of translate tables for the DN60 code.
There are three user-visible macros, namely CHAR which defines an
ASCII character (or its octal representation) as being equivalent to
some EBCDIC code (represented in hexadecimal); EBCTAB which generates
the resulting EBCDIC to ASCII translate table and ASCTAB which generates
the ASCII to EBCDIC table. All the rest of the macros below are internal
to one or other of these three. The following list shows the macro name,
who calls it, and what it does.
CHAR user defines E.xxx and A.yyy symbols to store character mapping;
also defines DExxx and DAyyy macros to hold descriptions of
the characters (only if FTTRLS is non-zero)
OCT CHAR converts the hexadecimal first argument of the CHAR macro into
octal (note there are two versions, one for MACDLX edit 667
or thereabouts and one for MACDLX 1031 and later)
OCT1 OCT (old MACDLX version only) converts each hexadecimal digit into
its octal equivalent
STOR CHAR creates a symbol E.xxx=yyy where xxx is the EBCDIC code
and yyy is the ASCII code; also creates A.yyy=xxx (for
the other translate table); if either symbol was already
defined, prints a warning that it was changing its value.
ASSGN CHAR used to do a symbol assignment where the source symbol has
to be made up of two parts concatenated together
DESTOR CHAR defines a macro DExxx to contain the comment line of information
about the EBCDIC character xxx (only if FTTRLS is non-zero)
DASTOR CHAR defines a macro DAyyy to contain the comment line of information
about the ASCII character yyy (only if FTTRLS is non-zero)
EBCTAB User generates the EBCDIC to ASCII table; if FTTRLS is non-zero
it prints the character-by-character description of the table
contained in the comment macros DExxx; if FTTRLS is zero, it
prints only .BYTE statements with the octal values. The table
is printed from 0-377, but stored in memory in such a way that
the first half is 200-377 and the second half (with the tag) is
0-177, thus permitting
MOVB char,Rx
MOVB EBCASC(Rx),Ry.
ESTOR EBCTAB used to generate the .BYTE v1,v2,v3,v4,v5,v6,v7,v8 line if
and FTTRLS is zero; it converts its entry symbols into others
ASCTAB with values of 0 if the entry symbol was undefined and
the entry symbol's value if the entry symbol was defined,
then calls ESTR1 to actually produce the .BYTE statement.
ESTR1 ESTOR counts up the number of characters in the values for the
.BYTE statement and generates one of three .BYTE statements
with the appropriate number of tabs to line up the comment
correctly. If FTTRLS is zero, forces the .BYTE statement
to print.
ECNT ESTR1 counts up the number of characters in all the value parameters
for the .BYTE statement
EBENT EBCTAB Generates the appropriate comment line if FTTRLS is non-zero;
if the current symbol is defined, it prints the value and the
description of the ASCII character it corresponds to.
If the current code is not defined, it prints that fact.
COMNT EBCTAB if FTTRLS is non-zero, generates a comment line to separate
groups of 16 descriptions (for readability).
CAT COMNT used to generate a concatenated comment line.
ASCTAB User similar to EBCTAB but generates ASCII to EBCDIC table;
since it is only 128. bytes long it has nothing funny about
its arrangement in memory (i.e. tag at beginning followed
by data).
ASENT similar to EBENT but for ASCII table (only if FTTRLS is
non-zero
HEXPR DESTOR, this is the start of the hexadecimal printing macro; it is
DASTOR, used only if FTTRLS is non-zero (because it is very expensive
and at assembly time) to cause the appropriate hexadecimal values
EBENT to be included on the comment lines printed for each entry in
the translate table. It merely sets a counter (N) to four, which
is the nesting level of the next macro (H2) and calls it.
H2 HEXPR this macro calls itself recursively, each time adding another
and argument (which is the next higher order hexadecimal digit
H2 of the number being converted) and pushing the previous ones
one place to the right. When it has reached its maximum nesting
level (N=0) it calls HX with the four arguments it has
produced. The caller of HEXPR must first define a suitable HX;
in our case DESTOR and DASTOR define a HX which merely defines
the DExxx or DAyyy macro (with the appropriate other information
already included). Note that there are two versions of
this macro also; the old MACDLX doesn't always process .MEXIT
correctly from deeply nested macros.
.ENDR;.REPT 0
;
;
;
.MACRO CHAR HEX,LIST,DESC,PREFIX,OFFSET,OCTAL
OCT ...CHR,HEX
...TMP=...CHR
.IF B,<OCTAL>
.IRPC ENTRY,LIST
...ENT=''ENTRY
.IIF NB <OFFSET>,...ENT=...ENT+OFFSET
STOR \...CHR,\...ENT
...CHR=...CHR+1
.ENDR;.IRPC ENTRY,LIST
.IFF;.IF B,<OCTAL>
.IRP ENTRY,<LIST>
...ENT=ENTRY
.IIF NB <OFFSET>,...ENT=...ENT+OFFSET
STOR \...CHR,\...ENT
...CHR=...CHR+1
.ENDR;.IRP ENTRY,<LIST>
.ENDC;.IF B,<OCTAL>
.IF NE,FTTRLS
.IF NB,<DESC>
...CHR=...TMP-1 ;;get original hexadecimal start code
.IRP ENTRY,<DESC>
...CHR=...CHR+1
ASSGN ...VAL,E.,\...CHR
DASTOR \...VAL,<ENTRY>,<PREFIX>,\...CHR
.ENDR;.IRP ENTRY,<DESC>
...CHR=...TMP-1
.IRP ENTRY,<DESC>
...CHR=...CHR+1
ASSGN ...VAL,E.,\...CHR
DESTOR \...CHR,<ENTRY>,<PREFIX>,\...VAL
.ENDR;.IRP ENTRY,<DESC>
.IFF;.IF NB,<DESC>
...CHR=...TMP-1 ;;get old EBCDIC start code back
.IRPC ENTRY,LIST
...CHR=...CHR+1
ASSGN ...VAL,E.,\...CHR
DASTOR \...VAL,<ENTRY>,<PREFIX>,\...CHR
.ENDR;.IRPC ENTRY,LIST
...CHR=...TMP-1
.IRPC ENTRY,LIST
...CHR=...CHR+1
ASSGN ...VAL,E.,\...CHR
DESTOR \...CHR,<ENTRY>,<PREFIX>,\...VAL
.ENDR;.IRPC ENTRY,LIST
.ENDC;.IF NB,<DESC>
.ENDC;.IF NE,FTTRLS
.ENDM CHAR
.IF DF,NEWDLX ;;if MACDLX 1031 or later
.MACRO OCT DST,HX ;;use this only if new MACDLX
...TMP=10
.RADIX 16
DST=0'HX
.RADIX ...TMP
.ENDM OCT
.IFF;.IF DF,NEWDLX
.MACRO OCT DST,HX ;;use this with old MACDLX
...CN1=0 ;;character count
.IRPC C,HX ;;loop through argument
...CN1=...CN1+1 ;;count each hex digit
.ENDR;.IRPC C,HX
...CN1=...CN1-1 ;;decrement count by one
;; so we can get multiplier for
;; leftmost digit
...MUL=1 ;;start out with 1
.REPT ...CN1
...MUL=...MUL*16. ;;implement powers the hard way
.ENDR;.REPT ...CN1
DST=0 ;;set destination to 0
.IRPC C,HX ;;get digit
OCT1 ...TM1,C,<0123456789ABCDEF> ;;get value for it
DST=DST+<...TM1*...MUL> ;;account for it
...MUL=...MUL/16. ;;and decrement multiplier
.ENDR;.IRPC C,HX
.ENDM OCT
.MACRO OCT1 DST,CHR,STRNG ;;convert single hex digit
...TM2=0
.IRPC DGT,STRNG
.IF IDN,<DGT>,<CHR>
DST=...TM2
.ENDC;.IF IDN,<DGT>,<CHR>
...TM2=...TM2+1
.ENDR;.IRPC C,STRNG
.ENDM OCT1
.ENDC;.IF DF,NEWDLX
.MACRO STOR NUM,CHR
.IF DF,E.'NUM
.IF NE,<E.'NUM-CHR>
.PRINT E.'NUM ;replacing old value of "'CHR'" for EBCDIC 'NUM
.ENDC;.IF NE,<E.'NUM-CHR>
.ENDC;.IF DF,E.'NUM
E.'NUM=CHR
.IF DF,A.'CHR
.IF NE,<A.'CHR-NUM>
.PRINT A.'CHR ;replacing old value of "'NUM'" for ASCII 'CHR
.ENDC;.IF NE,<A.'CHR-NUM>
.ENDC;.IF DF,A.'CHR
A.'CHR=NUM
.ENDM STOR
.MACRO ASSGN A,B,C
A=B'C
.ENDM ASSGN
.MACRO DESTOR NUM,DESCR,PRFX,VAL
.MACRO HX A,B,C,D
.IF NB,<DESCR>
.MACRO DE'NUM
.LIST
; EBCDIC 'NUM' ('C'D) = 'PRFX'DESCR' = ASCII 'VAL'
.NLIST
.ENDM DE'NUM
.ENDC;.IF NB,<DESCR>
.ENDM HX
HEXPR \NUM
.ENDM DESTOR
.MACRO DASTOR NUM,DESCR,PRFX,VAL
.MACRO HX A,B,C,D
.IF NB,<DESCR>
.MACRO DA'NUM
.LIST
; ASCII 'NUM' = 'PRFX'DESCR' = EBCDIC 'VAL' ('C'D)
.NLIST
.ENDM DA'NUM
.ENDC;.IF NB,<DESCR>
.ENDM HX
HEXPR \VAL
.ENDM DASTOR
.MACRO EBCTAB TAG
...TMP=0
...PC=.
.=.+128.
.IF NB,<TAG>
.LIST
TAG: ;EBCDIC to ASCII translate table
.NLIST
.ENDC;.IF NB,<TAG>
.REPT 32.
.IF EQ,<...TMP&17>
.IIF NE,FTTRLS, COMNT ...TMP,<0123456789ABCDEF>
.IIF EQ,<200-...TMP>,.=...PC
.ENDC;.IF EQ,<...TMP&17>
...SAV=...TMP ;save beginning
.REPT 8.
.IIF NE,FTTRLS, EBENT \...TMP
...TMP=...TMP+1
.ENDR;.REPT 8.
ESTOR E,\<...SAV+0>,\<...SAV+1>,\<...SAV+2>,\<...SAV+3>,\<...SAV+4>,\<...SAV+5>,\<...SAV+6>,\<...SAV+7>,\...SAV,\...SAV+7
.ENDR;.REPT 32.
.=...PC+256.
.ENDM EBCTAB
.MACRO ESTOR P,A,B,C,D,E,F,G,H,START,END
AA=0
.IIF DF,P'.'A,AA=P'.'A
BB=0
.IIF DF,P'.'B,BB=P'.'B
CC=0
.IIF DF,P'.'C,CC=P'.'C
DD=0
.IIF DF,P'.'D,DD=P'.'D
EE=0
.IIF DF,P'.'E,EE=P'.'E
FF=0
.IIF DF,P'.'F,FF=P'.'F
GG=0
.IIF DF,P'.'G,GG=P'.'G
HH=0
.IIF DF,P'.'H,HH=P'.'H
ESTR1 \AA,\BB,\CC,\DD,\EE,\FF,\GG,\HH,START,END
.ENDM ESTOR
.MACRO ESTR1 A,B,C,D,E,F,G,H,START,END
.Q=0
ECNT .Q,<A,B,C,D,E,F,G,H>
.Q=.Q+23.
.IF LE,.Q-31.
.IIF EQ,FTTRLS,.LIST
.BYTE A,B,C,D,E,F,G,H ;'START'-'END'
.IIF EQ,FTTRLS,.NLIST
.IFF;.IF LE,.Q-31.
.IF LE,.Q-39.
.IIF EQ,FTTRLS,.LIST
.BYTE A,B,C,D,E,F,G,H ;'START'-'END'
.IIF EQ,FTTRLS,.NLIST
.IFF;.IF LE,.Q-39.
.IIF EQ,FTTRLS,.LIST
.BYTE A,B,C,D,E,F,G,H ;'START'-'END'
.IIF EQ,FTTRLS,.NLIST
.ENDC;.IF LE,.Q-39.
.ENDC;.IF LE,.Q-31.
.ENDM ESTR1
.MACRO ECNT SYM,VAL
.IRP V,<VAL>
.IRPC C,V
SYM=SYM+1
.ENDR;.IRPC C,V
.ENDR;.IRP V,<VAL>
.ENDM ECNT
.MACRO EBENT NUM
.IF DF,E.'NUM
DE'NUM
.IFF;.IF DF,E.'NUM
.MACRO HX A,B,C,D
.LIST
; EBCDIC 'NUM' ('C'D) IS UNDEFINED
.NLIST
.ENDM HX
HEXPR \NUM
.ENDC;.IF DF,E.'NUM
.ENDM EBENT
.MACRO COMNT VAL,STRNG
...TM1=VAL'/16.
...CN1=0
.IRPC CHR,STRNG
.IF EQ,<...CN1-...TM1>
CAT <;Hex characters beginning with >,CHR
.ENDC;.IF EQ,<...CN1-...TM1>
...CN1=...CN1+1
.ENDR;.IRPC CHR,STRNG
.ENDM COMNT
.MACRO CAT A,B,C
.LIST
A'B'C
.NLIST
.ENDM CAT
.MACRO ASCTAB TAG
...TMP=0
.LIST
TAG: ;ASCII to EBCDIC translate table
.NLIST
.REPT 16.
...SAV=...TMP
.REPT 8.
.IIF NE,FTTRLS, ASENT \...TMP
...TMP=...TMP+1
.ENDR;.REPT 8.
ESTOR A,\<...SAV+0>,\<...SAV+1>,\<...SAV+2>,\<...SAV+3>,\<...SAV+4>,\<...SAV+5>,\<...SAV+6>,\<...SAV+7>,\...SAV,\...SAV+7
.ENDR;.REPT 16.
.ENDM ASCTAB
.MACRO ASENT NUM
.IF DF,A.'NUM
DA'NUM
.IFF;.IF DF,A.'NUM
.LIST
; ASCII 'NUM' IS UNDEFINED
.NLIST
.ENDC;.IF DF,A.'NUM
.ENDM ASENT
.MACRO HEXPR ARG
N=4
H2 \ARG&17,\ARG/20&7777
.ENDM HEXPR
.IF DF,NEWDLX
.MACRO H2 V1,V2,C1,C2,C3,C4
.IF EQ,N
HX C1,C2,C3,C4
.MEXIT
.ENDC;.IF EQ,N
N=N-1
.IF LT <V1>-10
H2 \<V2&17>,\<V2/20>,\V1,C1,C2,C3
.MEXIT
.ENDC;.IF LT 10-V1
.IIF EQ,10-V1, H2 \<V2&17>,\<V2/20>,8,C1,C2,C3
.IIF EQ,11-V1, H2 \<V2&17>,\<V2/20>,9,C1,C2,C3
.IIF EQ,12-V1, H2 \<V2&17>,\<V2/20>,A,C1,C2,C3
.IIF EQ,13-V1, H2 \<V2&17>,\<V2/20>,B,C1,C2,C3
.IIF EQ,14-V1, H2 \<V2&17>,\<V2/20>,C,C1,C2,C3
.IIF EQ,15-V1, H2 \<V2&17>,\<V2/20>,D,C1,C2,C3
.IIF EQ,16-V1, H2 \<V2&17>,\<V2/20>,E,C1,C2,C3
.IIF EQ,17-V1, H2 \<V2&17>,\<V2/20>,F,C1,C2,C3
.ENDM H2
.IFF;.IF DF,NEWDLX
.MACRO H2 V1,V2,C1,C2,C3,C4
T=V1
.IIF EQ,N,T=37
.IIF EQ,N,HX C1,C2,C3,C4
N=N-1
.IIF LT <T>-10,H2 \<V2&17>,\<V2/20>,\T,C1,C2,C3
.IIF EQ,10-T, H2 \<V2&17>,\<V2/20>,8,C1,C2,C3
.IIF EQ,11-T, H2 \<V2&17>,\<V2/20>,9,C1,C2,C3
.IIF EQ,12-T, H2 \<V2&17>,\<V2/20>,A,C1,C2,C3
.IIF EQ,13-T, H2 \<V2&17>,\<V2/20>,B,C1,C2,C3
.IIF EQ,14-T, H2 \<V2&17>,\<V2/20>,C,C1,C2,C3
.IIF EQ,15-T, H2 \<V2&17>,\<V2/20>,D,C1,C2,C3
.IIF EQ,16-T, H2 \<V2&17>,\<V2/20>,E,C1,C2,C3
.IIF EQ,17-T, H2 \<V2&17>,\<V2/20>,F,C1,C2,C3
.ENDM H2
.ENDC;.IF DF,NEWDLX