.MCALL	.MODULE
.MODULE	SETLAN,VERSION=12,COMMENT=<Setup NRC Routines>

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  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 except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
;
; Author:  David Fingerhut    November 1984
;
;19-Nov-1990	JFW	surround error messages with ;+;ERROR ...;-
.SBTTL Constants

CHAINS	=	500			;Start of chain area
FNTLEN	=	5			;Length of FONT name
KBDLEN	=	5			;Length of Keyboard name
.SBTTL	Pure area
	.PSECT PURE
SPLCH1:	.RAD50	/SY /			;Program to chain to
	.RAD50	/SPL/
	.RAD50	/IT /
	.RAD50	/SAV/
	.WORD	0			;For RSTS compatability
	.WORD	0			;Don't chain back
	.BLKW	3
	.ASCII	"PI"
SUFF:	.ASCII	"X.SYS/B:"

SPLCH2:	.ASCII	"=PI"
SUFF1:	.ASCIZ	"X.SYS"
CHEND:	.EVEN

USA:	.ASCIZ	/USA/
.SBTTL Impure area
	.PSECT	IMPURE

FNTBLK:	.BLKW	512.			;Buffer for font table
TYPDAT::.WORD	0			;TYPE/DATA current flags
TTYPE	=	1			;TYPE
TDATA	=	2			;DATA

FONT:	.ASCIZ	/USA /			;Font name area
KBD:	.ASCIZ	/USA /			;Keyboard name area
ESCLAN:	.ASCII	<33>/(/			;Escape sequence for
FSCS:	.ASCIZ	/B/			;  LANG command on PRO
	.PSECT	CODE
.SBTTL	DATA	- Handle DATA and TYPE commands
;+
; DATA - Handle DATA and TYPE
;
; Input: R2 = FLAG word for the command 
;	   If FLSET is set, the command was TYPE
;	   If FLRST is set, the command was DATA
;	 R3 = offset into SETTAB of DATA/TYPE switch byte
;
; If DATA command, resets S$KBDT in SETTAB and sets the kbd language to
; 	the corresponding DATA table.
; If TYPE command, sets S$KBDT in SETTAB and sets the kbd language to
;       the corresponding TYPE table.
;
;-

DATA::
	MOV	PC,R0		;R0 <> 0; Use the SETSET (SETS$S) setup table
	CALL	PISET		;Set DATA or TYPE in SETTAB
	MOV	#TDATA,TYPDAT	;Assume DATA
	BIT	#FLSET,R2	;Is it TYPE?
	BEQ	5$		;Branch if not
	MOV	#TTYPE,TYPDAT	;Indicate TYPE
5$:	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#SETS$S,#PIBLK
				;Read the SETS table
	MOV	#BLKBUF,R1	;R1 -> current table
	ADD	#S$KBLA,R1	;R1 -> current KBD name
	MOV	#4,R0		;R0 = length of name
	MOV	#KBD,R3		;R3 -> area to store name in
15$:	MOVB	(R1)+,(R3)+	;Move a byte
	SOB	R0,15$		;All of them
	MOV	#KBD,R1		;R1 -> KBD name
	CALL	SETKBD		;Set the KBD	

	RETURN
.SBTTL	LANG	- Handle LANG command
;+
;LANG - Handle the LANG command.
;
; SETUP KEYBOARD LANG:code
;	 Sets Keyboard to the specified language.
; SETUP VIDEO LANG:code
;	 Sets FONT to the specified language.
; SETUP [TERMINAL] LANG:code
;	 Does both of the above.
; SETUP PRINTER LANG:code
;	 Sets the printer to the specified language.
;-

LANG::
	BIT	#FL.PRM,FLAGWD	;Is there a parameter?
	BNE	20$		;Branch if so
;+
;ERROR
10$:	.ERR	#ERRARE,#IVV,LEVEL=F,RETURN=NO,ASCII=#PBUF
;	<-F-Invalid value>
;-

20$:	CALL	GETCOM		;Get the country from the command string
	BIT	#DE.PRI,DESTIN	;Is this for the printer?
	BNE	25$		;Branch if so
	BIT	#PR.PC,TERMWD	;Is this a PRO?
	BNE	40$		;Branch if so

25$:	MOV	#LANTXT,R2	;R2 -> table of countries
	CALL	TBSRC		;Search the table for the country
	BCS	10$		;Branch if country not found
	BIT	#FL.AMB,FLAGWD	;Ambiguous country name?
	BEQ	30$		;Branch if not
;+
;ERROR
	.ERR	#ERRARE,#ABC,LEVEL=F,RETURN=NO,ASCII=#PBUF
;	<-F-Ambiguous command>
;-

30$:	MOV	LANADD(R1),R1	;R1 -> escape sequence for the country
	CALL	OUTSTR		;Send it
	BR	60$		;Thats all for an 11.
	
40$:	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#SETS$S,#PIBLK
				;Read current SETUP table
	MOV	#PBUF,R1	;R1 -> user specified FONT (for TYPE)
	MOV	#S$KBDT,R2	;R2 = offset to DATA/TYPE byte
	MOV	#TTYPE,TYPDAT	;Assume TYPE
	TSTB	BLKBUF(R2)	;Is it TYPE?
	BNE	45$		;Branch if so
	MOV	#TDATA,TYPDAT	;Set DATA
45$:	BIT	#<DE.KBD!DE.TER>,DESTIN ;Is it for KEYBOARD?
	BEQ	50$		;Branch if not
	MOV	#PBUF,R1	;R1 -> Desired KBD
	CALL	SETKBD		;Set the keyboard

50$:	BIT	#<DE.VDO!DE.TER>,DESTIN ;Is it for VIDEO?
	BEQ	60$		;Branch if not
	CALL	SETFNT		;Set the FONT and send esc sequence

60$:	RETURN
.SBTTL	RETAIN	- Handle RETAIN command
;+
; RETAIN
;
; Retain the FONT and keyboard translation tables currently selected in the 
; SETFIX area prior to using SPLIT to truncate PIx.SYS.
;
;-

RETAIN::
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#SETS$S,#PIBLK
					;Read in current setup table
	MOV	#S$VDLA,R1		;R1 = offset for current font
	MOV	#FONT,R2		;R2 -> Font storage area
	MOV	#FNTLEN,R0		;R0 = length of FONT name
	ADD	#BLKBUF,R1		;R1 -> buffer	
10$:	MOVB	(R1)+,(R2)+		;Move in a byte
	SOB	R0,10$			;all of it	
	MOV	#S$KBLA,R1		;R1 = offset for current keyboard
	MOV	#KBD,R2			;R2 -> Keyboard storage area
	MOV	#KBDLEN,R0		;R0 = lenth of KBD name
	ADD	#BLKBUF,R1
20$:	MOVB	(R1)+,(R2)+		;Move in a byte
	SOB	R0,20$			;All of it

	MOV	#FONT.X,SETOF		;Request the FONT directory
	CALL	GETTAB			;REQDAT -> FONT directory
	MOV	REQDAT,R2		;R2 -> first entry in directory
	MOV	#FONT,R3		;R3 -> current FONT

	CALL	CMPCNT			;Compare the 2 countries
	BCS	35$			;Branch if no match
	JMP	60$			;skip retain for fonts

35$:	MOV	#4,R0			;R0 = length of font name
40$:	MOVB	(R3)+,(R2)+		;Move current font name into first
	SOB	R0,40$			; directory entry.

	WRITW	#IOAREA,#FPICHN,#BLKBUF,#512.,REQBLK,#PISYS
					;Write out new font directory

	MOV	#FNTBLK,R4		;R4 -> buffer for empty font table
	MOV	#FONT,R1		;R1 -> name in first directory entry
	CALL	GETFNT			;Read empty font table into FNTBLK
					;R4 -> "empty" font table
	MOV	REQBLK,-(SP)		;Save block number 
	MOV	#FONT.L,SETOF		;Request length of a font table
	CALL	GETTAB			;Get the length

	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#FONT$S,#PIBLK
					;Read the current font table
	MOV	#BLKBUF,R2		;R2 -> current font table
	MOV	REQBKL,R0		;R0 = length of a font table (REQBKL
					; was set from the GETTAB above)
50$:	MOVB	(R2)+,(R4)+		;Move the current font table into
	SOB	R0,50$			; "empty" font table location.
	WRITW	#IOAREA,#FPICHN,#FNTBLK,#512.,(SP)+
					;Write out the "empty" font table

60$:	MOV	#TDATA,TYPDAT		;Retain the DATA keyboard table
	MOV	#LENKBD,R1		;R1 -> Second kbd directory entry
	ASL	R1			;R1 -> third kbd directory entry
	CALL	RETKBD			;Retain DATA keyboard table
	MOV	#TTYPE,TYPDAT		;Retain the TYPE keyboard table
	MOV	#LENKBD,R1		;Second kbd directory entry
	CALL	RETKBD			;Retain TYPE keyboard table

	CALL	SPLITP			;Split off the unnecessary tables
					;SPLITP doesn't return
.SBTTL	RETKBD	- Retain the TYPE or DATA keyboard

;+
; RETKBD - RETAIN one of the current keyboard tables.
;
; Input:	R1 = byte offset into directory for table.  This will be
;		LENKBD if we're doing the TYPE table, and 2*LENKBD if we're
;		doing the DATA table.
;		TYPDAT has been preset for the type of kbd table to retain
;		KBD is the name of the current keyboard.
;	
;-

RETKBD::
; Read the kbd directory to find out if the appropriate entry already contains
; the keyboard we want to retain.
	MOV	#KBTB.X,SETOF		;Request the KBD directory
	CALL	GETTAB			;REQDAT -> KBD directory
	ADD	R1,REQDAT		;REQDAT ->1st or 2nd entry in directory
	MOV	REQDAT,R2		;R2 -> first entry in directory
	MOV	#KBD,R3			;R3 -> current KBD

	CALL	CMPCNT			;Compare the 2 countries
	BCS	10$			;Branch if no match
	JMP	60$			;all done

; Read into FNTBLK the keyboard corresponding to the directory entry that
; we want to clobber with the one we want to retain.
10$:	MOV	#1,R0			;Assume we're doing TYPE
	CMP	#TTYPE,TYPDAT		;Are we doing TYPE?
	BEQ	20$			;Branch if so
	INC	R0			;We're doing DATA
20$:	MOV	#FNTBLK,R4		;R4 -> buffer for empty KBD table
	CALL	GETKBD			;Read 2nd or 3rd KBD table into FNTBLK
					;R4 -> "empty" KBD table
	MOV	REQBLK,-(SP)		;Save block number 

; Get the length of a kbd table so we know how much to move.
	MOV	#KBTB.L,SETOF		;Request length of a KBD table
	CALL	GETTAB			;Get the length
	MOV	REQBKL,-(SP)		;Save length of a KBD table
	MOV	R4,R2			;R2 -> "empty" KBD table

; Read into BLKBUF the kbd table we want to retain.
	MOV	#KBD,R1			;R1 -> Current KBD 
	MOV	#BLKBUF,R4		;R4 -> buffer for current KBD table
	CLR	R0			;Indicate we want to do a search
	CALL	GETKBD			;Read in KBD R4 will -> KBD table.
	
; Copy the kbd table we want to retain (which is now in BLKBUF) on top of
; the keyboard table we read above (which is not in FNTBLK) and write FNTBLK
; back out.
	MOV	(SP)+,R0		;Restore length of a kbd table
30$:	MOVB	(R4)+,(R2)+		;Move the current font table into
	SOB	R0,30$			; "empty" KBD table location.
	WRITW	#IOAREA,#FPICHN,#FNTBLK,#512.,(SP)+

; Now update the 2nd or 3rd directory entry (name only) to reflect the kbd
; table we just wrote out.
	MOV	#KBTB.X,SETOF		;Get the KBD directory again
	CALL	GETTAB			;REQDAT -> KBD directory
	MOV	REQDAT,R2		;R2 -> directory
	ADD	#LENKBD,R2		;Skip to second entry (TYPE)
	CMP	#TTYPE,TYPDAT		;Are we doing TYPE?
	BEQ	40$			;Branch if so
	ADD	#LENKBD,R2		;Skip to third entry (DATA)
40$:	MOV	#4,R0			;R0 = length of KBD name
50$:	MOVB	(R3)+,(R2)+		;Move current KBD name into first
	SOB	R0,50$			; directory entry.

	WRITW	#IOAREA,#FPICHN,#BLKBUF,#512.,REQBLK,#PISYS
					;Write out new KBD directory
					;Write out the "empty" KBD table
60$:	RETURN
.SBTTL	SPLITP	- Split off unused tables from PI
;+
; SPLITP
; Splits PIx.SYS into 2 parts at the boundary specified in PISET.  
; The second part containing the tables is lost.
;
;-

SPLITP::
	MOV	#SPLIT,SETOF		;Request the SPLIT block boundary	
	CALL	GETTAB			;Get the block number in REQBKL

	LOOKUP	#IOAREA,#0,#SPLCH1	;Make sure the file is there
	.CLOSE	#0

	MOV	#CHAINS,R0		;R1 -> location for chain info
	MOV	#SPLCH1,R2		;R2 -> info for chain area
	MOV	#20.,R3			;R3 = number of bytes to move
20$:	MOVB	(R2)+,(R0)+		;Move "SY SPLIT SAV 0000PI"
	SOB	R3,20$			;Move each byte in

	MOV	#SUFF,R2		;R2 -> info for chain area
	MOV	#8.,R3			;R3 = number of bytes to move
	BIT	#FL.XM,FLAGWD		;Is this XM?
	BNE	24$			;Branch if so
	INC	R2			;Skip "X"	
	DEC	R3			;Move one less byte
24$:	MOVB	(R2)+,(R0)+		;Move "(X).SYS/B:"
	SOB	R3,24$			;Move each byte in

	MOV	REQBKL,R1		;R1 = value to be converted
	CLR	R2			;Suppress zero
	CALL	$CBOMG			;Convert binary octal to ascii

	MOV	#SPLCH2,R2		;R2 -> info for chain area
	MOV	#3,R3			;R3 = number of bytes to move
30$:	MOVB	(R2)+,(R0)+		;Move "=PI"
	SOB	R3,30$			;Move each byte in

	MOV	#SUFF1,R2		;R2 -> info for chain area
	MOV	#5,R3			;R3 = number of bytes to move
	BIT	#FL.XM,FLAGWD		;Is this XM?
	BNE	40$			;Branch if so
	INC	R2			;Skip the "X"
	DEC	R3			;Move one less byte
40$:	MOVB	(R2)+,(R0)+		;Move "(X).SYS"
	SOB	R3,40$			;Move each byte in
	CLR	@R0			;Terminate with null

	.CLOSE	#FPICHN			;Close PIx.SYS
	.CLOSE	#PICHN			;Close PI

	.CHAIN				;Chain to SPLIT and don't return
	
.SBTTL	SETKBD	- Set a current NRC set
;+
; SETKBD
; Sets a specified Keyboard as current.  Moves the table into the current 
; Keyboard table and sets the ASCII string in SETTAB.
; The table moved depends on TYPDAT. If the current setting is TYPE, the
; TYPE keyboard is loaded, otherwise the DATA keyboard.
; Input:  R1 -> ASCII name of Keyboard.
;
;-

SETKBD::
	CALL	$SAVAL		;Save all Regs
	MOV	#BLKBUF,R4	;R4 -> buffer to read kbd table into
	CLR	R0		;Indicate we're looking for a name
	CALL	GETKBD		;Read the table
	SPFUN	#IOAREA,#PICHN,#FN$UPD,R4,#USEHAN,#KBTB$S,#PIBLK
				;Write the NRC
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#SETS$S,#PIBLK
				;Read the current setup table
	MOV	#S$KBLA,R3	;R3 = offset for KEYBOARD ascii field
	ADD	#BLKBUF,R3	;Point to KEYBOARD ascii field
	MOV	#4,R2		;Count to 4 bytes
44$:	MOVB	(R1)+,(R3)+	;Move in a byte
	SOB	R2,44$		;Do all 4 bytes
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#USEHAN,#SETS$S,#PIBLK
				;Write it back out		
	RETURN	
.SBTTL	GETKBD	- Get a KBD table
;+
; GETKBD
; Reads a kbd table into memory.
;
; Input: R1 -> ASCII name of KBD
; 	 R4 -> buffer to read the kbd table into
;	 IF R0 NE 0, then R0 = directory entry number (beyond the first)
;	 of desired KBD.  For example, if R0 = 1 coming into this routine,
;	 then the keyboard table corresponding to the second directory entry
;	 will be read into memory.
;
; Output: R4 -> KBD table.
; 	Registers changed:  R3,R5
;-

GETKBD::
	JSR	R2,$SAVVR	;Save R0-R2
	MOV	R0,-(SP)	;Save entry number we want
	MOV	#KBTB.X,SETOF	;Read in the KBD directory
	CALL	GETTAB		;Read it into BLKBUF
	MOV	REQDAT,R2	;R2 -> KBD directory
	MOV	#LENKBD,R5	;R5 = length of a directory entry

	MOV	(SP)+,R0	;R0 = directory entry we want
	BEQ	10$		;Branch if we're looking for a name
5$:	ADD	R5,R2		;Skip to the right entry
	SOB	R0,5$		;Skip to the one we want
	BR	20$		;Skip the search routine

10$:	CALL	SEADIR		;Find the matching entry
20$:	MOV	KBXTAB(R2),R1	;R1 -> KBD table
	MOV	R1,-(SP)	;Save table location
	BIC	#777,R1		;Clear out words
	MOV	R1,-(SP)	;Save location 
	SWAB	R1		;Make it a block count
	ASR	R1		;Shift out low byte
	MOV	R1,REQBLK	;Save block number for writing back out
	READW	#IOAREA,#FPICHN,R4,#512.,R1,#PISYS
				;Read in the table
	MOV	R4,R0		;R0 -> buffer containing KBD 
	MOV	(SP)+,R1	;Restore location
	MOV	(SP)+,R4	;R4 -> KBD table
	SUB	R1,R4		;R4 = offset into buffer of table
	ADD	R0,R4		;R4 = absolute location of KBD table 

	RETURN
.SBTTL	SETFNT	- Set a current FONT
;+
; SETFNT
; Sets a specified FONT as current.  Moves the table into the current FONT
; table and sets the ASCII string in SETTAB.  It also moves the final SCS
; character from the font directory into the area in current setup table
; then sends the appropriate escape sequence.
;
; Input:  R1 -> ASCII name of FONT.
;
;-

SETFNT::
	CALL	$SAVAL		;Save all Regs
	MOV	#BLKBUF,R4	;R4 -> buffer for the font table
	CALL	GETFNT		;Read the table.  R4 will point to table.
				;SCS character will be put in FSCS.
	SPFUN	#IOAREA,#PICHN,#FN$UPD,R4,#USEHAN,#FONT$S,#PIBLK
				;Write the FONT
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#SETS$S,#PIBLK
				;Read the SETS table
	MOV	#S$VDLA,R3	;R3 = offset for FONT ascii field
	ADD	#BLKBUF,R3	;Point to FONT ascii field
	MOV	#4,R2		;Count to 4 bytes
44$:	MOVB	(R1)+,(R3)+	;Move in a byte
	SOB	R2,44$		;Do all 4 bytes
	
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#USEHAN,#SETS$S,#PIBLK
				;Write it back out	
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#CURR$S,#PIBLK
				;Read the current table
	MOV	#S$VDF,R3	;R3 = offset for SCS character
	ADD	#BLKBUF,R3	;Point to SCS field
	MOVB	FSCS,@R3	;Move in the SCS character
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#USEHAN,#CURR$S,#PIBLK
				;Write it back out	
	MOV	#ESCLAN,R1	;R1 -> escape sequence for countries
	CALL	OUTSTR		;Send it
	RETURN	
.SBTTL	GETFNT - Get a font table
;+
; GETFNT 
; Reads a font table into memory.  It also moves the final SCS character into 
; FSCS.
;
; Input:  R1 -> ASCII name of FONT.
;	  R4 -> buffer to read the font table into	  
;
; Output:  R4 -> FONT table.
;	   REQBLK = block number of PIx.SYS where blocks came from
; 	   
; 	Registers changed:  R3,R5
;-

GETFNT::
	JSR	R2,$SAVVR	;Save R0-R2
	MOV	#FONT.X,SETOF	;Read in the NRC fonts directory
	CALL	GETTAB		;Read it into BLKBUF
	MOV	REQDAT,R2	;R2 -> font country
	MOV	#LENFNT,R5	;R5 = length of a directory entry
	CLR	TYPDAT		;Don't worry about DATA/TYPE
	CALL	SEADIR		;Find the matching entry - R2 -> entry
	MOVB	FNTSCS(R2),FSCS	;Move in the final SCS character
	MOV	FNTTAB(R2),R1	;R1 -> Font table
	MOV	R1,-(SP)	;Save table location
	BIC	#777,R1		;Clear out words
	MOV	R1,-(SP)	;Save location 
	SWAB	R1		;Make it a block count
	ASR	R1		;Shift out low byte
	MOV	R1,REQBLK	;Save block number
	READW	#IOAREA,#FPICHN,R4,#512.,R1,#PISYS
				;Read in the table
	MOV	R4,R0		;R0 -> buffer containing font
	MOV	(SP)+,R1	;Restore location
	MOV	(SP)+,R4	;R4 -> font table
	SUB	R1,R4		;R4 = offset into buffer of table
	ADD	R0,R4		;R4 = absolute location of font table 
	RETURN
.SBTTL SEADIR - Search a font or kbd directory

;+
; SEADIR - Search a directory for a font or kbd name.
; Input:  R1 -> country name to be found
;	  R2 -> start of directory
;	  R5 =  length of a directory entry
;	  TYPDAT = type of entry to look for. (DATA or TYPE).
;	  
;	  
; Output: R2 -> matching directory entry
; 	  Registers changed:  R0,R3
;
; Note:  This routine does not return if no match is found.
;-

SEADIR::
	MOV	R1,R3		;R3 -> user country
10$:	TST	TYPDAT		;Are we looking for a specific TYPE/DATA?
	BEQ	20$		;Branch if not
	MOV	R2,-(SP)	;Save start of directory entry
	ADD	#KBVAR,@SP	;R2 -> type for this entry
	BIT	TYPDAT,@(SP)+	;Is this the right type?
	BEQ	30$		;Branch if not - no match
20$:	CALL	CMPCNT		;Compare the two countries (R2,R3)
	BCC	40$		;Branch if match
30$:	ADD	R5,R2		;Point to next country name
	TSTB	(R2)		;End of directory
	BNE	10$		;Branch if not
;+
;ERROR
	.ERR	#ERRARE,#IVV,LEVEL=F,RETURN=NO,ASCII=R1
;	<-F-Invalid value>
;-

40$:	RETURN
.SBTTL  CMPCNT - Compare 2 country names 
;+
; CMPCNT - Compare 2 country names
; Input:  R2 -> first country name 
; 	  R3 -> second country name
; Both country names end with a null byte or after 4 characters, whichever 
; comes first.
; Output: c bit clear - match
;	  c bit set - no match
; Registers changed:  R0
;-

CMPCNT::
	MOV	R2,-(SP)	;Save R2
	MOV	R3,-(SP) 	;Save R3
	MOV	#4,R0		;R0 = maximum number of bytes to test
10$:	CMPB	(R2),(R3)	;Compare a byte
	BNE	85$		;Return NO MATCH
	TSTB	(R2)+		;End of first string?
	BNE	20$		;Branch if not
	TSTB	(R3)		;End of first and second string?
	BEQ	80$		;If so, return MATCH
20$:	TSTB	(R3)+		;Move to next character of second string.
	SOB	R0,10$		;Test next character
80$:	CLC			;Return MATCH
	BR	90$

85$:	SEC			;Return NO MATCH
90$:	MOV	(SP)+,R3	;Restore R3
	MOV	(SP)+,R2	;Restore R2
	
	RETURN

	.END