;PROCEDURE match( patterns : string255;	{these patterns		   }
;		 delim    : char;	{separated by this delimiter}
;		 source   : string255;	{against this source string}
;	       var status : boolean );	{returning this flag	   }
;{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;LAST EDITED: 03/03/84 rep
;
;RETURNS:
;	'status' true if any of the patterns appear in the source string.
;
;
;DECLARE:
;    TYPE  string0 = string 0;
;	  string255 = string 255;
;
; CALL AS:
;	match ( 'YES!yes!NO!no', '!', ans,flag );
;	match ( $s, '!', ans,flag );
;
; Required:
;	function vlength();		from ASL.REL
;	procedure setlength();		Pascal/Z supplied extension.
;	function index();		Pascal/Z supplied extension.
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
;TYPE
;  nodeptr = ^node;
;  node    = record
;     data : STRING 18;	{ MATCH MAXIMUM OF 18 CHARACTERS PER ARGUMENT }
;     next : nodeptr
;  end;
;VAR
;  i   : integer;
;  a,
;  root: nodeptr;
;{$C-,F-,R-,S-,M-}
C	SET	          0
F	SET	          0
R	SET	          0
S	SET	          0
M	SET	          0

	NAME	MATCH
	ENTRY	MATCH

;{ vlength - returns length of ANY length string. super fast! }
;FUNCTION vlength ( VAR s: string0 ): integer; external;
	EXT	VLENGTH
;
;{ setlength - forces the length of string 's' to length 'n' }
;PROCEDURE setlength ( VAR s: string0; n: integer ); external;
	EXTD	L171,SETLENGT
;
;{ index - returns the position of pattern in source else 0 }
;FUNCTION index ( source,pattern: string255 ): integer; external;
	EXTD	L173,INDEX   

MATCH:
	ENTR	D,2,6
;  root := NIL;
	MOV	-4(IX),A
	MOV	-5(IX),A
;  append(patterns,delim);
	PUSH	IX
	POP	H
	LXI	B,522
	DADD	B
	PUSH	H
	LXI	H,255
	PUSH	H
	MOV	H,A
	LXI	B,266
	PUSH	IX
	DADX	B
	MOV	L,0(IX)
	POP	IX
	INR	H
	PUSH	H
	LXI	H,2
	PUSH	H
	CALL	L137
;  i := 0;
	MOV	0(IX),A
	MOV	-1(IX),A
;  WHILE i<vlength(patterns) DO
L200
	MOV	L,-1(IX)
	MOV	H,0(IX)
	PUSH	H
	PUSH	IX
	POP	H
	LXI	B,522
	DADD	B
	PUSH	H
	CALL	VLENGTH
	POP	H
	LESS	D,0
;    BEGIN
	JNC	L199
;      new(a);			{allocate a new variable}
	PUSH	IX
	POP	H
	DCX	H
	DCX	H
	LXI	B,21
	CALL	L126
;      a^.next := root;		{ground it to the tree}
	MOV	L,-5(IX)
	MOV	H,-4(IX)
	XCHG
	MOV	H,-2(IX)
	MOV	L,-3(IX)
	LXI	B,-19
	DADD	B
	MOV	M,D
	DCX	H
	MOV	M,E
;      root := a;		{and run up the tree}
	MOV	L,-3(IX)
	MOV	H,-2(IX)
	MOV	-4(IX),H
	MOV	-5(IX),L
;      setlength(a^.data,0);	{ data := '';	}
	MOV	H,-2(IX)
	MOV	L,-3(IX)
	PUSH	H
	MOV	H,A
	MOV	L,A
	PUSH	H
	CALL	L171
;      i := i+1;
	MOV	L,-1(IX)
	MOV	H,0(IX)
	INX	H
	MOV	0(IX),H
	MOV	-1(IX),L
;      WHILE NOT((i>vlength(patterns)) OR (patterns[i]=delim)) DO
L254
	MOV	L,-1(IX)
	MOV	H,0(IX)
	PUSH	H
	PUSH	IX
	POP	H
	LXI	B,522
	DADD	B
	PUSH	H
	CALL	VLENGTH
	POP	H
	GRET	D,0
	JC	L259
	MOV	L,-1(IX)
	MOV	H,0(IX)
	XCHG
	LXI	H,522
	ADDR	IX
	MOV	D,A
	MOV	E,M
	MOV	H,A
	LXI	B,266
	PUSH	IX
	DADX	B
	MOV	L,0(IX)
	POP	IX
	DSB1	D,0
;        BEGIN
	JZ	L253
;          append(a^.data,patterns[i]);
	MOV	H,-2(IX)
	MOV	L,-3(IX)
	PUSH	H
	LXI	H,18
	PUSH	H
	MOV	L,-1(IX)
	MOV	H,0(IX)
	XCHG
	LXI	H,522
	ADDR	IX
	MOV	D,A
	MOV	E,M
	INR	D
	PUSH	D
	LXI	H,2
	PUSH	H
	CALL	L137
;          i := i+1
	MOV	L,-1(IX)
	MOV	H,0(IX)
;        END
	INX	H
	MOV	0(IX),H
	MOV	-1(IX),L
;    END;
	JMP	L254
L253
L256	EQU	L253
L257	EQU	L256
L259	EQU	L257
	JMP	L200
L199
;  a := root;
	MOV	L,-5(IX)
	MOV	H,-4(IX)
	MOV	-2(IX),H
	MOV	-3(IX),L
;  status := false;
	MOV	H,9(IX)
	MOV	L,8(IX)
	MOV	M,A
;  WHILE (a<>NIL) AND (status=false) DO
L329
	MOV	L,-3(IX)
	MOV	H,-2(IX)
	MOV	D,A
	MOV	E,A
	DSB1	D,0
	JZ	L328
	LXI	H,9
	ILOD	H,1,0
	MOV	A,L
	CMPI	D,0
	MOV	A,H
;    BEGIN
	JNZ	L328
;      status := (index(source,a^.data)<>0);
	PUSH	IX
	POP	H
	LXI	B,265
	DADD	B
	SPSH	S,255
	MOV	H,-2(IX)
	MOV	L,-3(IX)
	SPSH	S,255
	CALL	L173
	MOV	H,A
	MOV	L,A
	DSB1	D,0
	JRZ	L349
	INR	A
L349
	MOV	L,A
	XRA	A
	MOV	H,A
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	MOV	M,E
;      a := a^.next
;    END
	LXI	H,-2
	ILOD	H,2,-19
	MOV	-2(IX),H
	MOV	-3(IX),L
;END{match};
	JMP	L329
L328
	EXIT	D,515,6
