Google
 

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