	.title	ESCAPE
	.ident	/BL1.0/
;
;	Programs to define escapes and substitutions
;
	.PSECT	$VARS,LCL,D,RW,CON
SAV1:
LITCNT:	.WORD	0
SAV2:
LITADD:	.WORD	0
SAV3:	.WORD	0
SAV4:	.WORD	0
CHAR1:	.BLKB	1
CHAR2:	.BLKB	1
CHAR3:	.BLKB	10.
	.even
	.PSECT	$TABL,RO,D,LCL,CON
MODTAB:	
	.RAD50	\LCK\
	.BYTE	ES.LCK,1
	.RAD50	\VSP\
	.BYTE	ES.VSP,2
	.RAD50	\HSP\
	.BYTE	ES.HSP,3
	.RAD50	\PSP\
	.BYTE	ES.PSP,0
	.RAD50	\CHR\
	.BYTE	ES.CHR,0
	.WORD	0		; End of table
	.PSECT	$CODE,RO,I,LCL,CON
;
;	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:	JMP	ILCM		; Illegal command error
DFESC::	CLR	LITCNT		; Initialize variables
	CLR	LITADD		; CLEAR POINTERS
	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 ?
	BISB	#CH.ES2,CHTABL(R1) ; Note this char as escape seq. char
	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
	CLR	R1
	CALL	PBYT		; 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
	CLR	(R0)+
	CLR	(R0)+
	CLR	(R0)+
	CLR	(R0)+
ESCOMD:	CLR	R3		; No default
	CALL	ALPGT		; get 2 char sequence
	BCS	70$		; Now get sequence
	MOV	#MODTAB,R0	; table to search
10$:	TSTEQ	(R0),ERR2	; At end of table?
	CMPEQ	R3,(R0)+,20$	; match?
	TST	(R0)+		; NO
	BR	10$		; continue
20$:	MOVB	(R0)+,R3	; get code
	MOVB	(R0),R2		; Get byte number
	BITNEB	R3,CHAR3,ERR2	; Bit already set ?
	BISB	R3,CHAR3	; Set flag byte
	TSTEQ	R2,ESCOMD	; No extra bytes to get ?
	CMPEQ	R3,#ES.LCK,40$	; Lock function ?
	CALL	RCNO		; Get number
	JMP	ERR2		; None is error
	CMP	R3,#177		; Check upper bound ?
	BGT	ERR2		; Too big ?
	CMP	R3,#177600	; Now check low bound
	BLT	ERR2		; Too small ?
	MOVB	R3,CHAR3(R2)	; Save it
	BEQ	ERR2		; Null ??
	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	ERR2
	MOVB	CHAR2,(R3)	; Save char
	SUB	#ESCTAB,R3	; Now is index
	CLC
	ASL	R3		; Word index
	CMPNEB	CHAR1,#'\,46$	; Not end sequence ?
	BIS	#200,R3		; Mark it as end sequence
46$:	MOVB	R3,CHAR3(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,#377		; 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:	CMP	R1,#40		; Not a character?
	BLE	ERR1		; Yes
	CMP	R1,#177		; Not a character?
	BGE	ERR1		; Yes
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:	TSTNE	LITCNT,10$	; LITERAL ALREADY FOUND?
	CALL	GETLIT		; TRY FIRST TO FIND LITERAL
	BCS	30$		; NONE		
	MOV	R2,LITADD	; ADDRESS OF LITERAL
	MOV	R1,LITCNT	; SIZE		
10$:	MOVB	@LITADD,R1	; GET CHAR	
	INC	LITADD		; POINTS TO NEXT VALUE
	DEC	LITCNT		; DECREMENT # CHAR REMAINING
20$:	CLC			; SUCCESS	
	RETURN			;		
30$:	CALL	RCNO		; TRY FOR NUMBER
	JMP	40$		; NONE		
	MOV	R3,R1		; NUMBER FOUND	
	BR	20$		; RETURN WITH SUCCESS
40$:	SEC			; FAILURE	
	RETURN			;		

;
;	reset substitute
;
SUBMAX	= 10.		; Maximum number of chars allowed
RSSUB::	MOV	#BUFADD+2,R2	; first header address is herer
	MOV	#3,R4		; number of headers
10$:	MOV	(R2)+,R3	; Header
	CALL	CLRBF		; clear it
	SOB	R4,10$		; till done
	RETURN
;
;	DEFINE SUBSTITUTE COMMANDS
;
SUBERR:	JMP	ILCM		; ILLEGAL COMMAND
DFMAC::	CLRB	SUBSTK		; reset substitution  stack
	MOV	#SAV1,R0
	CLR	(R0)+		; Clear
	CLR	(R0)+		; Clear
	CLR	(R0)+		; Clear
	CLR	(R0)+		; Clear
	MOV	#CHAR1,R2	; Start of temporary buffer
	MOV	#SUBMAX,R4	; Max number of char
10$:	CALL	CCIN		; get input data
	CMPEQB	R1,#TAB,10$	; skip tabs
	CMPEQB	R1,#SPC,10$	; skip spaces
	BLT	SUBERR		; no label
	MOV	R1,-(SP)	; save delimiter
20$:	CALL	CCIN		; get next char
	CMP	R1,#SPC		; printable character?
	BLE	SUBERR		; no embedded spaces etc. allowed
	CMPEQ	R1,(SP),30$	; done?
	CMPEQ	R2,#CHAR1,25$	; First char?
	CMPNEB	#GC.LC,GCTABL(R1),25$ ; Not lower case ?
	SUB	#40,R1		; Make it upper
25$:	MOVB	R1,(R2)+	; Save in temporary buffer
	SOB	R4,20$		; Continue till done, or overflow
	BR	SUBERR		; Too many chars!
30$:	TST	(SP)+		; pop delimiter
	CMPEQ	R4,#SUBMAX,SUBERR	; No characters ?
	CLRB	(R2)+		; Clear next byte
	MOV	BUFADD+2,R3	; SUBSTITUTE BUFFER
	CALL	BEGBF		; Start at beginning of buffer
	CALL	GWRD		; Get starting address
	BCC	31$		; Inited?
	CALL	CLRBF
	CLR	R1
	CALL	PWRD		; First word is zero
	BR	35$		; Start saving substitution
31$:	CALL	FNDBF		; Find it
	MOV	SAV1,SAV2	; Stash previous one
	MOV	BF.FUL(R3),SAV1	; Save current pointer address
	CALL	GWRD		; Next index
	MOV	R1,R4		; Save it
	MOV	#CHAR1,R2	; Input char buffer
32$:	CALL	GBYT		; Get 1 char of name
	TSTNE	R1,33$		; Not end of symbol?
	TSTNEB	(R2),100$	; Only partially identical?
	JMP	ILSAD		; ERROR - Symbol already defined
100$:	TSTNE	SAV3,34$	; Already found partial?
	MOV	SAV1,SAV3
	MOV	SAV2,SAV4
33$:	CMPEQB	R1,(R2)+,32$	; Match ?
34$:	MOV	R4,R1
	BNE	31$		; Not end of buffer?
35$:	CALL	ENDBF		; START AT END OF BUFFER READY FOR PUT
	MOV	BF.FUL(R3),-(SP) ; CURRENT TABLE SIZE
	MOV	#CHAR1,R2	; Temporary buffer
	CLR	R1
	CALL	PBYT		; Will be address later
37$:	CALL	PBYT		; null will be count later
	MOVB	(R2)+,R1	; Next byte to save
	BNE	37$		; Save it
40$:	CALL	PBYT		; save 1 char
	CALL	CCIN		; char for macro
	CMPNEB	R1,#CR,40$	; done?
	CLR	R1		; fill in with null
	CALL	PBYT		; into buffer
	TSTEQ	SAV3,45$	; No partial identical buffer?
	MOV	SAV4,R1		; Buffer before partial ident one
	CALL	FNDBF
	MOV	(SP),R1		; Current buffer address goes into it
	CALL	PWRD
	MOV	(SP)+,R1	; Current buffer address
	CALL	FNDBF
	MOV	SAV3,R1		; Points to partial ident
	BR	46$
45$:	MOV	SAV1,R1		; Pointer address
	CALL	FNDBF		; find it
	MOV	(SP)+,R1	; Beginning of current entry
46$:	CALL	PWRD		; Save pointer address
	CALL	ENDBF		; go to end of buffer
	MOV	BF.FUL(R3),R2	; end of buffer
	MOV	BUFADD+4,R3	; next stack header
	MOV	R2,BF.MAX(R3)	; fill in max
	MOV	BUFADD+6,R3	; next stack header
	MOV	R2,BF.MAX(R3)	; fill in max
	RETURN
60$:	TST	(SP)+		; pop delimiter
70$:	MOV	(SP)+,R1	; old index
	CALL	RSTBF		; reset to beginning
	JMP	ILCM		; ILLEGAL COMMAND
	.END
