.title	ESCAPE
	.ident	/BL1.0/
	.list  meb
;
;	Programs to define escapes and substitutions
;
;								AZ (new)
;	NSWC Changes:						     V
;
;		17 Feb 87 - Add .DEFINE DCL command.
;		 1 Dec 87 - Add .DJDE command.
;		22 Dec 87 - Add .FONTS command.
;		 8 Feb 88 - Correct .DJDE, .FONT usage with /RIGHT
;			    Add support for Two Column Index (entry
;			     point PASSON, LITADD & LITCNT global).
;			    Add .DEFINE NUMBER NEXTPAGE command.
;		15 Mar 88 - Allow use of all 256 Extended ASCII characters.
;			    Remove unused commands DEFUN, DEFCHW, and
;			     DEFVSP.
;			    Don't allow n<0 in HSP,n in escape sequences.
;		 5 Apr 88 - Move buffer for .DEFINE DCL to VAXIO.
;								     ^
;								AZ (new)
	.vars
	.WORDA	0		; Chock list
SAV1:				; Current name address in buffer (SUBS)
LITCNT::.WORDA	0						; AZ (::)
SAV2:				; previous name address in buffer (SUBS)
LITADD::.WORDA	0						; AZ (::)
SAV3:	.WORDA	0
SAV4:	.WORDA	0
SAV5:	.WORDA	0
      .if df $A256						; AZ 3/88
CHAR1:	.BLKW	1						; AZ 3/88
CHAR2:	.BLKW	1						; AZ 3/88
CHAR3:	.BLKW	SUBMAX-1					; AZ 3/88
      .endc							; AZ 3/88
      .if ndf $A256						; AZ 3/88
CHAR1:	.BLKB	1
CHAR2:	.BLKB	1
CHAR3:	.BLKB	SUBMAX-1
      .endc							; AZ 3/88
WARN:	.BLKB	1
	.IF DF	$VMS						; AZ (new)
DCLLEN:	.LONG	256						; AZ (new)
	.WORDA	DCLBUF						; AZ (new)
	.ENDC							; AZ (new)
	.even
	
	.const
	.IF DF	$VMS						; AZ (new)
DCLDSC:	.LONG	256						; AZ (new)
	.WORDA	DCLBUF						; AZ (new)
	.ENDC							; AZ (new)
MODTAB:	
	RAD	L,C,K
	.BYTE	ES.LCK,1
	RAD	V,S,P
	.BYTE	ES.VSP,2
	RAD	H,S,P
	.BYTE	ES.HSP,3
	RAD	P,S,P
	.BYTE	ES.PSP,0
	RAD	C,H,R
	.BYTE	ES.CHR,0
	.WORDA	0		; End of table
;
;	display table of formats
;
DSPTAB:	RAD	spc,spc,D
	.WORDA	NM.DEC
LU:	RAD	spc,L,U
	.WORDA	NM.ALP+NM.UC
	RAD	spc,L,L
	.WORDA	NM.ALP
	RAD	spc,L,M
	.WORDA	NM.ALP+NM.MC
	RAD	spc,R,U
	.WORDA	NM.ALP+NM.ROM+NM.UC
	RAD	spc,R,L
	.WORDA	NM.ALP+NM.ROM
	RAD	spc,R,M
	.WORDA	NM.ALP+NM.ROM+NM.MC
	.WORDA	0		; end of table
DJDE$:	.ASCIZ	/<DJDE> /					; AZ (new) 12/87
FONT$:	.ASCIZ	/«FONTS» /					; AZ (new) 12/87
	.code
SAVLAB:	CLR	R5		; Normal subs.
SAVLB1:	CALL	FNDSBS		; Find substitution
	BCC	10$		; Ok, not already defined ?
	TST	(SP)+		; Pop stack
	MOV	#3,R0
	JMP	ILCMD		; Already defined label
10$:	CALL	ENDBF		; START AT END OF BUFFER READY FOR PUT
	MOV	BF.FUL(R3),SAV5	; Save current end of buffer
	MOV	#CHAR1,R2	; Temporary buffer
	CALL	PWRD		; Will be address later
      .if df $A256						; AZ 3/88
20$:	MOVW	(R2)+,R1	; Transfer characters		; AZ 3/88
      .endc							; AZ 3/88
      .if ndf $A256						; AZ 3/88
20$:	MOVB	(R2)+,R1	; Transfer characters
      .endc							; AZ 3/88
	  CALL	PBYT		; Into buffer
	BNE	20$		; Not null ?
30$:	CLC
	RETURN
;
;	DEFINE NUMBER ITEM
;
DFNIT::	CALL	FNDITM		; Get item
	CALL	GWRD		; Get number
	MOV	R1,-(SP)	; Save number
	CALL	SAVLAB		; Get label
	MOV	(SP)+,R1	; Restore
SAVNM:	MOVB	#1,@BF.ADD(R3)	; Set for number conversion
	CALL	PWRD		; Save number in buffer
	JMP	SBEND		; And set up rest of links
;
;	DEFINE NUMBER LEVEL
;
DFNHL::	CALL	SAVLAB		; Save label
	CALL	PASEND
	CLR	-(SP)		; end of numbers
	MOV	#CHPTN,R2	; POINT TO CHAPTER/LEVEL TABLE
	MOVB	LEVEL,R4	; Level number
	CMPB	R4,UNILV	; Unitary level number
	BLE	10$		; Not unitary ??
	INDXA	R4		; Set index
	ADD	R4,R2		; Now points to correct one
	BR	50$
10$:	MOV	APNDN,R1	; Current appendix number
	BEQ	20$		; IF EQ NONE
	BIS	APNDSP,R1	; format
	MOV	R1,-(SP)	; appendix to convert
	BR	30$		; Continue with rest of levels
20$:	TSTNEB	(R2),50$	; Chapter oriented document?
30$:	TST	(R2)+		; Skip chapter number
50$:	MOV	(R2)+,R1	; Current chapter or level number
	BEQ	60$		; Last one?
	BIS	CHPDSP-CHPTN-$WORDL(R2),R1	; set display format
	MOV	R1,-(SP)	; save for conversion
	BR	50$		; more
60$:	CMPNEB	LEVEL,#1,65$	; Not first level?
	CMPB	LEVEL,UNILV	; Unitary level number
	BGT	65$		; Unitary ??
	TSTNE	APNDN,65$	; Chapter oriented?
	TSTNE	CHPTN,65$	; Chapter oriented?
	TSTNEB	$TRZER,65$	; No trailing zeroes ?
	MOV	#NM.DEC,-(SP)	; Last digit is 0
65$:	MOVB	#PD,$SEPR	; digit separator
	CALL	PAGCV		; convert numbers
	JMP	SBEND
;
;	DEFINE NUMBER PAGE
;
DFNPG::	CLR	R6		; Zero means "This page"	; AZ (new) 2/88
DF2:	CALL	GETLAB		; Get or define label		; AZ (lbl) 2/88
	MOVB	#3,@BF.ADD(R3)	; Set for number conversion
	MOV	BF.FUL(R3),-(SP); Get index
	CALL	GETPAG		; Stash page number
	CALL	LINFAK
	MOV	#PAGCHR,R1	; Set up to fill in later
	CALL	PBYT
	MOV	R6,R1						; AZ (new) 2/88
	CALL	PBYT						; AZ (new) 2/88
	MOV	(SP)+,R1	; Link back
	CALL	PWRD		; Save link
	TSTNE	BF.HED(R3),10$	; Header exists ?
	CALL	CBYT		; Chock it
	CALL	OUTLIN		; And output it
10$:	JMP	SBEND
;								; AZ (new) 2/88
;	DEFINE NUMBER NEXTPAGE					; AZ (new) 2/88
;								; AZ (new) 2/88
DFNXP::	MOV	#1,R6		; +1 means "Next page"		; AZ (new) 2/88
	BR	DF2						; AZ (new) 2/88
;
;	DEFINE NUMBER LIST
;
DFNLS::	CALL	SAVLAB		; Save label
	CALL	PASEND		; Exit if second pass
	MOV	@LSTKP,R1	; Get current list element number
	JMP	SAVNM
;
;	DEFINE NUMBER CHAPTER
;
DFNCH::
DFNAP::	CALL	SAVLAB		; Save label
	CALL	PASEND		; Exit if second pass
	MOV	APNDN,R1	; Current appendix number
	BEQ	40$		; IF EQ NONE
	BIS	APNDSP,R1	; format
	BR	50$		; Continue with rest of levels
40$:	MOV	CHPTN,R1
	BEQ	50$		; none ?
	BIS	CHPDSP,R1	; set display format
50$:	JMP	SAVNM		; Convert number
;
;	Define subscripts
;
DFSUP::	MOV	#UPTAB,R4	; Subscript buffer
	BR	DFSUP1
DFSUB::	MOV	#DNTAB,R4	; Superscript buffer	
DFSUP1:	MOV	#SUPSIZ,R5	; Maximum number of chars
	MOV	R4,SAV3		; Save address
	CLRB	(R4)+		; Count=0
	MOVB	#ES.NUL,(R4)+	; Null for escape
DFSUP2:	CLR	LITCNT
1$:	CALL	LITNO		; Get literal
	BCS	10$		; Done ?
	MOVB	R1,(R4)+	; Save char
	SOB	R5,1$		; Continue ?
	MOV	#50.,R0		; Definition too long
	JMP	ILCMA
10$:	SUB	SAV3,R4		; Number of bytes
	DEC	R4		; Account for count
	MOVB	R4,@SAV3	; Save count
	RETURN
;
;	Set units
;
;DFUNI::CALL	(R4)		; Get units		; AZ 3/88 (; to end)
;	BCC	10$		; Number ?
;	  MOV	#1,R3		; Default
;10$:	MOV	R3,HUNIT	; Save the units
;	CALL	(R4)		; Get units
;	BCC	20$		; Number ?
;	  MOV	#1,R3		; Default
;20$:	MOV	R3,VUNIT	; Save the units
;	RETURN
;
;	Define character width
;
;DFCHW::CALL	RCNO		; Get font number	; AZ 3/88 (; to end)
;	BCC	1$		; Number ?
;	  CLR	R3		; Default font
;1$:	CMP	R3,#FNTSIZ	; Check if too big
;	BLO	2$		; OK ?
;	  MOV	#8.,R0		; Param too big or negative
;	  JMP	ILCMA		; Illegal
;2$:	MOV	R3,R4
;	ASH	#7,R4		; Shift to left
;	ADD	CHWTAB,R4	; Add on table base
;5$:	CALL	RCNO		; Get width
;	BCC	6$		; Number ?
;	  RETURN
;6$:	CALL	GETLIT
;	BCS	30$		; None ?
;	TSTEQ	R1,30$		; Zero count ?
;	MOV	R0,R2		; Literal address into R2
;10$:	MOVB	(r2)+,R0	; Get character
;	CMP	R0,#SPC		; Check if space
;	BLT	15$		; non printable ?
;	BGT	14$		; Not space ?
;	MOVB	R3,NXS(R4)	; Set NXS also
;	MOVB	R3,BS(R4)	; And backspace
;14$:	ADD	R4,R0
;	MOVB	R3,(R0)		; Save size
;15$:	SOB	R1,5$		; Till done
;	BR	DFCHW		; Try again
;30$:	MOV	#7.,R0		; Missing params
;	JMP	ILCMA		; Illegal command error
;
;	Define variable spacing
;
;DFVSP::MOV	#VARESC,R4	; Buffer to fill	; AZ 3/88 (; to end)
;	CALL	RCNO		; Get count
;	MOVB	R3,(R4)+	; And save it
;	MOV	R4,SAV3		; Save address
;	CLRB	(R4)+		; Initial count zero
;	MOV	#VARSIZ,R5	; Size of buffer
;	BR	DFSUP2		; Now fill buffer
;
;	Variable spacing command
;
VARSP::	BISB	#SW.TDS,$VARSP	; Enable variable spacing
	RETURN
NVSP::	BICB	#SW.TDS,$VARSP	; Disable variable spacing
	RETURN
;
;	RESET ESCAPE COMMAND
;
RSESC::	MOV	#ESCTAB,R0	; Table to clear
	MOV	#16.,R1		; Number of entries
10$:	CLRB	(R0)+		; Clear 1 entry
	SOB	R1,10$		; Till done ?
	CLR	ESMSK		; Clear current escape mask
	MOV	#ESCBF,R3	; ESCAPE TABLE	
	JMP	CLRBF		; CLEAR IT OUT	
;
;	DEFINE ESCAPE COMMANDS
;
ILSAD:	MOV	#3,R0		; Symbol already defined error
	JMP	ILCMA
ESCERR:	MOV	#7.,R0		; Missing params
	JMP	ILCMA		; Illegal command error
DFESC::	CLR	LITCNT		; Initialize variables
	CALL	LITNO		; GET INPUT first escape char
	BCS	ESCERR		; ERROR/NO INPUT ?
	MOVB	R1,CHAR1	; Save first char
	CALL	LITNO		; GET CHAR TO COMPARE second escape char
	BCS	ESCERR		; ERROR/NO INPUT ?
	MOVB	R1,CHAR2	; Save second char
	MOV	#ESCBF,R3	; ESCAPE BUFFER
	CALL	BEGBF		; Start at beginning of buffer
10$:	CALL	GBYT		; Get first char
	BCS	15$		; Done at end of table?
	MOV	R1,R2		; Save count
	DEC	R2
	CALL	GBYT		; First escape char
	CMPNEB	R1,CHAR1,12$	; Not the same ?
	DEC	R2
	CALL	GBYT		; Second escape char
	CMPEQB	R1,CHAR2,ILSAD	; Second char the same ?
12$:	MOV	BF.FUL(R3),R1	; Get current location
	ADD	R2,R1		; Next location
	CALL	FNDBF		; Find it
	BR	10$		; And try again
15$:	CALL	ENDBF		; Go to end of buffer
	MOV	BF.FUL(R3),-(SP) ; CURRENT TABLE SIZE
	CALL	CBYT		; null will be count later
	MOVB	CHAR1,R1	; First char
	CALL	ESCCHR		; SAVE IT	
	MOVB	CHAR2,R1	; Second char
	CALL	ESCCHR		; SAVE IT	
;
;	Here parse auxiliary commands
;
	MOV	#CHAR3,R0	; Clear temporary buffer
	MOV	#ES.NUL,CHAR3	; Setup null
	CLR	(R0)+
	CLR	(R0)+
ESCOMD:	CLR	R3		; No default
	CALL	ALPGT		; get 3 char sequence
	BCC	5$		; Got sequence ?
	JMP	70$		; Now get sequence
5$:	MOV	#MODTAB,R0	; table to search
10$:	TSTEQ	(R0),25$	; Branch if at end of table	; AZ 3/88
	CMPEQ	R3,(R0)+,20$	; match?			; AZ 3/88 (:)
	CMPB	(R0)+,(R0)+	; NO
	BR	10$		; continue
20$:	MOVB	(R0)+,R3	; get code
	MOVB	(R0),R2		; Get byte number
	BITNEB	R3,CHAR3,25$	; Branch if bit already set	; AZ 3/88
	BISB	R3,CHAR3	; Set flag byte			; AZ 3/88 (:)
	TSTEQ	R2,ESCOMD	; No extra bytes to get ?
	ADD	#CHAR3,R2	; Points to output byte
	CMPEQ	R3,#ES.LCK,40$	; Lock function ?
	CALL	RCNO		; Get number
	BCC	30$		; Number ?
25$:	  JMP	ERR2		; None is error			; AZ 3/88 (:)
30$:	CMP	R3,#127.	; Check upper bound ?
	BGT	25$		; Branch if too big		; AZ 3/88
	CMP	R3,#-128.	; Now check low bound		; AZ 3/88 (:)
	BLT	25$		; Branch if too small		; AZ 3/88
	CMPEQ	R2,#CHAR3+2,32$	; Branch if doing VSP		; AZ 3/88 new
	TST	R3		; HSP value can't be < 0	; AZ 3/88 new
	BLT	25$		; Branch if it is invalid	; AZ 3/88 new
32$:	MOVB	R3,(R2)		; Save it
	BR	ESCOMD		; Next command
40$:	MOV	#ESCTAB,R3	; Table to search
41$:	TSTEQB	(R3),45$	; End of table ?
	CMPNEB	(R3)+,CHAR2,41$	; No match ?
	DEC	R3		; Point to char match
45$:	CMP	R3,#ESCTAB+16.	; Past end of table ?
	BHIS	25$		;				; AZ 3/88
	MOVB	CHAR2,(R3)	; Save char			; AZ 3/88 (:)
	SUB	#ESCTAB,R3	; Now is index
	CMPNEB	CHAR1,#BCKSL,60$	; Not end sequence ?
	BIS	#^o200,R3		; Mark it as end sequence
60$:	MOVB	R3,(R2)		; Save byte
	BR	ESCOMD		; Next command
70$:	MOV	#CHAR3,R2	; Save commands
	MOVB	(R2)+,R1	; Get first byte
	MOVB	R1,R4		; Save for later
	CALL	ESCSAV		; Save it
	MOVB	(R2)+,R1	; Next byte
	BITEQB	#ES.LCK,R4,81$	; No lock ?
	CALL	ESCSAV		; Save it
81$:	MOVB	(R2)+,R1	; Next byte
	BITEQB	#ES.VSP,R4,82$	; No vert. space ?
	CALL	ESCSAV		; Save it
82$:	MOVB	(R2)+,R1	; Next byte
	BITEQB	#ES.HSP,R4,83$	; No horiz space ?
	CALL	ESCSAV		; Save it
83$:
;
;	Here parse for escape sequence definition
;
SEQENC:	CALL	LITNO		; GET NEXT CHAR	
	BCS	30$		; NO MORE	
	CALL	ESCSAV		; SAVE IT	
	BR	SEQENC		; GET MORE	
30$:	MOV	(SP)+,R1	; point to start of sequence
	MOV	#ESCBF,R3
	MOV	BF.FUL(R3),R2	; Current location
	SUB	R1,R2		; Minus previous one
	DEC	R2		; Now is number of bytes
	CMP	R2,#^o377	; too big?
	BHI	ERR3		; yes
	CALL	FNDBF		; find this location
	MOV	R2,R1		; escape count
	CALL	PBYT		; fill it in
	RETURN
;
;	Saves characters in escape table
;
ESCCHR:
      .if df $A256						; AZ 3/88
	BIC	#^C<M$CHR>,R1					; AZ 3/88
	BITEQB	#M$PRT,R1,ERR1					; AZ 3/88
      .endc							; AZ 3/88
      .if ndf $A256						; AZ 3/88
	CMP	R1,#^o40	; Not a character?
	BLE	ERR1		; Yes
	CMP	R1,#^o177	; Not a character?
	BGE	ERR1		; Yes
      .endc							; AZ 3/88
ESCSAV:	MOV	#ESCBF,R3	; BUFFER	
	CALL	PBYT		; PUT CHAR INTO BUFFER
	BCS	ERR1		; ERROR		
	RETURN
ERR1:	TST	(SP)+
ERR2:	MOV	(SP)+,R1	; INDEX TO LAST LOCATION
ERR3:	MOV	#ESCBF,R3
	CALL	RSTBF		; RESTORE TOP OF TABLE
	JMP	ILCM		; ILLEGAL COMMAND
;
;	Gets characters entered as literals or numbers
;
LITNO:	MOV	R3,-(SP)	; Save R3
1$:	TSTNE	LITCNT,10$	; LITERAL ALREADY FOUND?
	CALL	GETLIT		; TRY FIRST TO FIND LITERAL
	BCS	30$		; NONE		
	MOV	R0,LITADD	; ADDRESS OF LITERAL
	MOV	R1,LITCNT	; SIZE		
	BR	1$		; Now check size
10$:	MOVB	@LITADD,R1	; GET CHAR	
	INC	LITADD		; POINTS TO NEXT VALUE
	DEC	LITCNT		; DECREMENT # CHAR REMAINING
20$:	MOV	(SP)+,R3	; Restore
	TST	R1		; Set status C=0
	RETURN			;		
30$:	CALL	RCNO		; TRY FOR NUMBER
	BCS	40$		; NONE ?		
	MOV	R3,R1		; NUMBER FOUND	
	BR	20$		; RETURN WITH SUCCESS
40$:	MOV	(SP)+,R3	; Restore
	CLR	R1		; Set none
	SEC			; FAILURE	
	RETURN			;		
;
;	reset substitute
;
RSSUB::	BITNE	#PASSW,$SWTCH,SUBERR; 2 pass ?
	MOV	#SUBF0,R3	; first header address is herer
	CALL	CLRBF		; clear it
	JMP	CWRD		; Clear first word
;
;	Error exits
;
SUBERR:	MOV	#4,R0		; Bad params
	JMP	ILCMD
SUBER1:	MOV	#7,R0		; Missing params
	JMP	ILCMD
SUBER2:	MOV	#51.,R0		; Label or literal too long
	JMP	ILCMD
;
;	parse substitution command label
;
FNDSBS:	MOV	#5.,R1		; Number of words to clear
	MOV	#SAV1,R0	; First address to clear
5$:	CLR	(R0)+		; Clear
	SOB	R1,5$		; Till done
	CLRB	WARN		; No warning initially
	MOV	#CHAR1,R2	; Start of temporary buffer
	MOV	#SUBMAX+1,R4	; Max number of char
10$:	CALL	CCIN		; get input data
	CMPEQB	R1,#TAB,10$	; skip tabs
	CMPEQB	R1,#SPC,10$	; skip spaces
	BLT	SUBER1		; no label
	MOV	R1,-(SP)	; save delimiter
20$:	CALL	CCIN		; get next char
	CMPEQ	R1,(SP),30$	; done?
	TSTNE	R5,22$		; commands ?
	CMP	R1,#SPC		; Check for spaces
	BLE	SUBERR		; Space or Tab error ?
	CMPEQ	R2,#CHAR1,25$	; First char?
22$:	CMPNEB	#GC.LC,(R0),25$ ; Not lower case ?
	SUB	#^o40,R1	; Make it upper
25$:	TSTEQ	R5,29$		; Not commands ?
	CMPEQ	R2,#CHAR1,26$	; First char?
	CMPNEB	R1,#SPC,26$	; printable character?
      .if df $A256						; AZ 3/88
	CMPEQB	R1,-2(R2),20$	; 2 spaces in row ?		; AZ 3/88
      .endc							; AZ 3/88
      .if ndf $A256						; AZ 3/88
	CMPEQB	R1,-1(R2),20$	; 2 spaces in row ?
      .endc							; AZ 3/88
	BR	29$		; Include space
26$:	CMPEQB	#GC.LC,(R0),29$	; Letter ?
	CMPEQB	#GC.UC,(R0),29$	; Letter ?
	JMP	SUBERR 		; Not letter ?
      .if df $A256						; AZ 3/88
29$:	MOVW	R1,(R2)+	; Save in temporary buffer	; AZ 3/88
      .endc							; AZ 3/88
      .if ndf $A256						; AZ 3/88
29$:	MOVB	R1,(R2)+	; Save in temporary buffer
      .endc							; AZ 3/88
	SOB	R4,20$		; Continue till done, or overflow
	JMP	SUBER2		; Too many chars!
30$:	TST	(SP)+		; pop delimiter
	CMPNE	R4,#SUBMAX+1,40$	; Characters ?
	JMP	SUBER1		; No characters ?
      .if df $A256						; AZ 3/88
40$:	BISW	R5,CHAR1					; AZ 3/88
	CLRW	(R2)+		; Clear next byte		; AZ 3/88
      .endc							; AZ 3/88
      .if ndf $A256						; AZ 3/88
40$:	BISB	R5,CHAR1
	CLRB	(R2)+		; Clear next byte
      .endc							; AZ 3/88
	MOV	#SUBF0,R3	; SUBSTITUTE BUFFER
	CALL	BEGBF		; Start at beginning of buffer
	CALL	GWRD		; Get starting address
	BNE	50$		; Got it ?
	CLC			; No ?
	RETURN
50$:	CALL	FNDBF		; Find it
	BCC	55$		; Ok ?
54$:	CALL	HLTER
55$:	MOV	SAV1,SAV2	; Stash previous one
	MOV	BF.FUL(R3),SAV1	; Save current pointer address
	CALL	GWRD		; Next index
	BCS	54$		; Bad index
	MOV	R1,R4		; Save it
	MOV	#CHAR1,R2	; Input char buffer
60$:	CALL	GBYT		; Get 1 char of name
	BCS	54$		; Bad byte
	CMPEQB	R1,#SPC,60$	; Is it space ?
	BITNE	R1,#M$PRT,115$	; Printable ?			; AZ 3/88
	TSTNEB	(R2),100$	; Only partially identical?
	SEC			; Symbol defined already
	RETURN
100$:	TSTNE	R5,110$		; Command ?
	INCB	WARN		; Warn the user
110$:	TSTNE	SAV3,116$	; Already found partial?
	MOV	SAV1,SAV3
	MOV	SAV2,SAV4
      .if df $A256						; AZ 3/88
115$:	CMPW	R1,(R2)+					; AZ 3/88
	BEQL	60$		; Match ?			; AZ 3/88
	CMPEQB	-2(R2),#SPC,115$	; Is it space ?		; AZ 3/88
	TSTNEB	-2(R2),116$	; Not partially identical ?	; AZ 3/88
      .endc							; AZ 3/88
      .if ndf $A256						; AZ 3/88
115$:	CMPEQB	R1,(R2)+,60$	; Match ?
	CMPEQB	-1(R2),#SPC,115$	; Is it space ?
	TSTNEB	-1(R2),116$	; Not partially identical ?
      .endc							; AZ 3/88
	TSTNE	R5,116$		; Command ?
	INCB	WARN		; Set up warning message
116$:	MOV	R4,R1
	BEQ	120$		; End of buffer?
	JMP	50$		; Not end of buffer
120$:	CLC			; Ok not already defined
	RETURN
;
;	DEFINE ITEM
;
DFITM::	CALL	GETLAB		; Get or define label
	MOV	#NM.DEC,-(SP)	; And get initial number
	CALL	ALPGT		; get 2 char sequence
	BCS	40$		; None ?
	MOV	#DSPTAB,R2	; table to search
10$:	TSTNE	(R2),20$	; Not at end of table?
	MOV	#4,R0
	JMP	ILCMD		; Bad params
20$:	CMPEQ	R3,(R2)+,30$	; match?
	TST	(R2)+		; NO
	BR	10$		; continue
30$:	MOV	(R2),(SP)	; Add in extra bits
40$:	CALL	RCNO		; Get initial number
	BCC	45$		; Default ?
	CALL	ALPGT2		; Get alpha param
	BCC	45$		; Got one ?
	MOV	#1,R3		; Default is 1
45$:	CMP	R3,#4000.	; Too big ?
	BLO	60$		; No ?
50$:	MOV	#8.,R0		; Param too big or negative
	JMP	ILCMD		; Yes
60$:	ADD	R3,(SP)		; And save it
	MOV	(SP)+,R1	; Save it	
	MOV	#SUBF0,R3	; In substitute buffer
	JMP	SAVNM
;
;	Create label in first pass
;		get label in second pass
;
GETLAB:	.if df	$PASS
	BITEQ	#PASSW,$SWTCH,5$; Not 2 pass ?
	BITNEB	#SW.DIS,$OUTSW,5$; First pass ?
	JMP	FNDITM
	.endc
5$:	JMP	SAVLAB		; Find substitute
;
;	NUMBER ITEM
;
FNDITM:	CLR	R5
	CALL	FNDSBS
	BCC	NOSUBS		; No substitute found
	CMPNEB	R1,#1,NOSUBS	; Not item
	RETURN
NOSUBS:	MOV	#49.,R0		; Undefined substitute error
	JMP	ILCMD
NMITM::	CALL	FNDITM		; Get substitute	
	MOV	BF.FUL(R3),R5	; Save address
	CALL	GWRD		; Get number
	MOV	R1,R3		; Save it
	BIC	#^c<NM.MSK>,R3	; Clear format bits
	BIC	#NM.MSK,R1	; Clear data bits
	MOV	R1,R4		; Save format
	CALL	RCNR		; Get increment or dec
	BCC	30$		; Found number ?
	CALL	ALPGT2		; Get alpha param
	BCC	30$		; Got one ?
	MOV	#1,R3		; Default is 1
30$:	CMP	R3,#4000.	; Check if too big
	BLO	40$		; Ok ?
35$:	MOV	#8.,R0		; Param too big or negative
	JMP	ILCMD
40$:	ADD	R3,R4
	MOV	#SUBF0,R3	; Get buffer
	MOV	R5,R1		; Get address
	CALL	FNDBF		; Go back to number
	MOV	R4,R1		; Number
	JMP	PWRD		; Save it	
;
;	DEFINE COMMAND
;
      .if df $A256						; AZ 3/88
DFCOM::	MOV	#^x8000,R5		; Command flag		; AZ 3/88
      .endc							; AZ 3/88
      .if ndf $A256						; AZ 3/88
DFCOM::	MOV	#^o200,R5		; Command flag
      .endc							; AZ 3/88
	BR	DFMAC1		; Save command label
;								; AZ (new)
	.IF DF	$VMS						;      V
;
;	Define DCL (get value of DCL symbol)
;
DFDCL::	CALL	SKPLIN
	CALL	SAVLAB
	MOVAL	DCLBUF,R9
10$:	CALL	CCIN
	CMPEQB	R1,#CR,20$
	MOVB	R1,(R9)+
	BR	10$
20$:	SUBL3	#DCLBUF,R9,DCLLEN
	PUSHAL	DCLLEN
	PUSHAL	DCLDSC
	PUSHAL	DCLLEN
	CALLS	#3,G^LIB$GET_SYMBOL
	BLBC	R0,SBEND
	MOVQ	DCLLEN,R9
	TSTL	R9
	BEQ	SBEND
30$:	MOVB	(R10)+,R1
	CALL	PBYT
	SOBGTR	R9,30$
	BR	SBEND
;								;      ^
	.ENDC							; AZ (new)	
;
;	DEFINE SUBSTITUTE COMMANDS
;
DFMAC::	CLR	R5
DFMAC1:	CALL	SKPLIN
	CALL	SAVLB1		; Save label
	TSTEQ	R5,20$		; Not command ?
5$:	CALL	CCIN		; Get first char
	CMPEQ	R1,$NFLSW,20$	; Is it command flag ?
	CMPEQ	R1,#SPC,5$	; Or space
	CMPEQ	R1,#TAB,5$	; Or tab
	BR	30$		; Now check if end
10$:	CALL	PBYT		; save 1 char
20$:	CALL	CCIN		; char for macro
30$:	CMPNEB	R1,#CR,10$	; not done?
SBEND:	CALL	PASEND		; Exit if second pass
	CALL	ENDBF		; End of buffer
	CALL	CBYT		; into buffer
	TSTEQ	SAV3,10$	; No partial identical buffer?
	MOV	SAV4,R1		; Buffer before partial ident one
	CALL	FNDBF
	MOV	SAV5,R1		; Current buffer address goes into it
	CALL	PWRD
	MOV	SAV5,R1		; Current buffer address
	CALL	FNDBF
	MOV	SAV3,R1		; Points to partial ident
	BR	20$
10$:	MOV	SAV1,R1		; Pointer address
	CALL	FNDBF		; find it
	MOV	SAV5,R1		; Beginning of current entry
20$:	CALL	PWRD		; Save pointer address
	TSTEQB	WARN,50$	; No Warning ?
	BITNE	#WARSW,$SWTCH,50$; No warning by switch ?
	MOV	#44.,R0		; Message number
	JMP	ILCMD		; Give error message
50$:	RETURN
;
;	Routines to handle multiple passes
;		PASEND - exits on pass 2
;		SKPLIN - skips input on pass 2
;
PASEND:	MOV	#SUBF0,R3	; Buffer header
	.if df	$PASS
	BITEQ	#PASSW,$SWTCH,5$; Not 2 pass ?
	BITNEB	#SW.DIS,$OUTSW,5$; First pass ?
	TST	(SP)+		; Pop stack
	.endc
5$:	RETURN			; None
SKPLIN:	.if df	$PASS
	BITEQ	#PASSW,$SWTCH,5$; Not 2 pass ?
	BITNEB	#SW.DIS,$OUTSW,5$; First pass ?
1$:	CALL	CCIN		; Get char
	CMPNE	R1,#CR,1$	; Not CR ?
	TST	(SP)+		; Pop stack
	.endc
5$:	RETURN
;
;	DELETE command
;
DELCOM::MOV	#^o200,R5		; Set up for command
	BR	DELSB1
;
;	DELETE substitution
;
DELSUB::CLR	R5		; Set up for substitution
DELSB1:	BITNE	#PASSW,$SWTCH,70$; 2 pass ?
	CALL	FNDSBS		; Find the substitution
	BCC	50$		; None ?
	MOV	SAV1,R1		; Address of last label
	CALL	FNDBF		; Get it
	CALL	GWRD		; Get size
	MOV	R1,R2		; Kill label
	MOV	SAV2,R1		; get previous one
	CALL	FNDBF
	MOV	R2,R1		; Now zap substitution
	CALL	PWRD		; By bypassing it !!!
50$:	RETURN
70$:	JMP	ILCM
ILCMD:	.if df	$PASS
	BITEQ	#PASSW,$SWTCH,10$ ; 1 Pass only ?
	BITNEB	#SW.DIS,$OUTSW,10$ ; First of 2 passes ?
	JMP	KILCM		; Kill this command
	.endc
10$:	JMP	ILCMB		; Output error
;
;	Setup command
;
SETUP::	CLR	LITCNT
1$:	CALL	LITNO		; Get leteral or number
	BCC	10$		; End of setup codes ?
	RETURN
10$:	CALL	FOUT
	BR	1$
;								; AZ (new) 12/87
;	FONTS command						       V
;
FONTS::	MOV	#FONT$,LITADD
	MOV	#8,LITCNT
	BR	DJFON
;								; AZ (new) 12/87
;	DJDE command						;      V
;
DJDE::	MOV	#DJDE$,LITADD
	MOV	#7,LITCNT
;
DJFON:	BLBS	X9700$,PASSON	; Was /X9700 qualifier used?	; AZ (2/88)
	JMP	COMNT		; If not, treat this as comment.;      V
;
;	At this point LITADD must contain the address of the
;	literal to pass on, and LITCNT its length.  After this
;	literal is passed on, literals and ascii codes will be
;	copied from the command line, then a <CR><LF> will end
;	the line.
;
PASSON:: MOV	LMARG,-(SP)	; Save real left margin
	MOV	RMARG,-(SP)	; Save real right margin
	MOV	RIGSHI,-(SP)	; Save /RIGHT value		; AZ (2/88)
	CLR	LMARG		; Set left margin to zero
	MOV	#136,RMARG	; Set right margin to 136
2$:	CALL	LITNO		; Get one character of literal
	BCS	10$		; Branch if no more literals
	CALL	FOUT		; Output the character
	BR	2$		; Loop until complete
10$:	MOV	#CR,R1		; Complete--now
	CALL	FOUT		;   copy a CR and
	MOV	#LF,R1		;   LF and end the
	CALL	FOUT		;   line on the
	CALL	OUTPUT		;   output file
	MOV	(SP)+,RIGSHI	; Restore /RIGHT value		; AZ (2/88)
	MOV	(SP)+,RMARG	; Restore real right margin
	MOV	(SP)+,LMARG	; Restore real left margin
	RETURN							;      ^
;								; AZ (new) 12/87
	.END