.title	ESCAPE
	.ident	/BL1.0/
;
;	Programs to define escapes and substitutions
;
	.PSECT	$TEMP,GBL,D,RW,OVR
	.WORD	0		; Chock list
SAV1:				; Current name address in buffer (SUBS)
LITCNT:	.WORD	0
SAV2:				; previous name address in buffer (SUBS)
LITADD:	.WORD	0
SAV3:	.WORD	0
SAV4:	.WORD	0
CHAR1:	.BLKB	1
CHAR2:	.BLKB	1
CHAR3:	.BLKB	SUBMAX+1
WARN:	.BLKB	1
	.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
;
;	Define subscripts
;
DFSUP::	MOV	#UPMOV,SAV3	; Subscript buffer
	BR	DFSUP1
DFSUB::	MOV	#DNMOV,SAV3	; Superscript buffer	
DFSUP1:	MOV	#CH.HD1,SAV4	; Maximum number of chars
DFSUP2:	CLR	LITCNT
	CLR	LITADD		; Set up no literal yet
1$:	CALL	LITNO		; Get literal
	BCS	10$		; Done ?
	MOVB	R1,@SAV3	; Save char
	INC	SAV3		; Next address
	DEC	SAV4		; Count data trans.
	BGT	1$		; Continue ?
	JMP	ILCM
10$:	CLRB	@SAV3
	RETURN
;
;	Define variable spacing
;
DFVSP::	MOV	#VARESC,SAV3	; Buffer to fill
	MOV	#2*CH.HD1,SAV4	; 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:	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 ?
	CMPEQB	CHAR1,$SFLSW,4$	; Unlock ?
	CMPNEB	CHAR2,$LFLSW,5$	; not Lock ?
4$:	BISB	#CH.ES2,CHTABL(R1) ; Note this char as escape seq. char
5$:	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		
	BR	LITNO		; Now check 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
;
RSSUB::	MOV	#SUBF0,R3	; first header address is herer
	CALL	CLRBF		; clear it
	RETURN
SUBERR:	JMP	ILCM		; ILLEGAL COMMAND
;
;	parse substitution/command label
;
FNDSBS:	MOV	#CHAR1,R2	; Start of temporary buffer
	MOV	#SUBMAX,R4	; Max number of char
	MOV	R4,R1		; Number of bytes to clear
	CLRB	WARN		; No warning initially
	MOV	#SAV1,R0
5$:	CLRB	(R0)+		; Clear
	SOB	R1,5$		; Till done
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
	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,GCTABL(R1),25$ ; Not lower case ?
	SUB	#40,R1		; Make it upper
25$:	TSTEQ	R5,29$		; Not commands ?
	CMPEQ	R2,#CHAR1,26$	; First char?
	CMPNEB	R1,#SPC,26$	; printable character?
	CMPEQB	R1,-1(R2),20$	; 2 spaces in row ?
	BR	29$		; Include space
26$:	CMPNEB	#GC.UC,GCTABL(R1),SUBERR ; Not letter ?
29$:	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 ?
	BISB	R5,CHAR1
	CLRB	(R2)+		; Clear next byte
	MOV	#SUBF0,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?
	SEC			; Symbol defined already
	RETURN
100$:	INCB	WARN		; Warn the user
	TSTNE	SAV3,34$	; Already found partial?
	MOV	SAV1,SAV3
	MOV	SAV2,SAV4
33$:	CMPEQB	R1,(R2)+,32$	; Match ?
	TSTNEB	-1(R2),34$	; Not partially identical ?
	INCB	WARN		; Set up warning message
34$:	MOV	R4,R1
	BNE	31$		; Not end of buffer?
35$:	CLC			; Ok not already defined
	RETURN
;
;	DEFINE COMMAND
;
DFCOM::	MOV	#200,R5		; Command flag
	BR	DFMAC1
;
;	DEFINE SUBSTITUTE COMMANDS
;
DFMAC::	CLR	R5
DFMAC1:	CALL	FNDSBS		; Find substitution
	BCC	10$		; Ok, not already defined ?
	CALL	BEGBF		; Set buffer back to beginning
	JMP	ILSAD		; ERROR - Symbol already defined
10$:	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	BEGBF		; go to end of buffer
	TSTNEB	WARN,50$	; No warning ?
	RETURN
50$:	MOV	#44.,R0		; Message number
	JMP	ILCMA		; Give error message
;
;	DELETE command
;
DELCOM::MOV	#200,R5		; Set up for command
	BR	DELSB1
;
;	DELETE substitution
;
DELSUB::CLR	R5		; Set up for substitution
DELSB1:	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$:	CALL	BEGBF		; Go back to beginning
	RETURN
	.END