head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.23.05;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.03.07;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.59.02;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.34.01;  author jwh;  state Exp;
branches ;
next     54.3;

54.3
date     91.08.21.12.41.10;  author jwh;  state Exp;
branches ;
next     54.2;

54.2
date     91.08.21.09.53.38;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.34.28;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.34.13;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.20.21;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.18.48;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.32.44;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.16.28;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.23.01;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.11.08.59;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.55.56;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.16.04.06;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.21.08;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.13.57;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.57.57;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.39.54;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.12.00.59;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.45.52;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.38.21;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.51.50;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.29.11;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.46.36;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.20.45;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.51.27;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.12.01.43;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.22.29;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.59.04;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.43.48;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.11.09.27;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.53.14;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.14.13.42;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.48.57;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.10.22.49;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.11.09.51;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.48.59;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.14.34.15;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.45.07;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.09.00.22;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.16.04.24;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.11.07.04;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.16.17.03;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.09.59.34;  author jws;  state Exp;
branches ;
next     14.2;

14.2
date     87.04.02.15.34.12;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.16.11.09;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.59.43;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.54.04;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.10.20.30;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.11.36.03;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.15.21.22;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.12.29.01;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.14.45.50;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.18.34.28;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.17.24.20;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.20.19.17;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.12.40.46;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.15.18.19;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.17.14.29;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@* match pack
*
	nosyms
	sprint
	mname   matchstr

	src     module matchstr;
	src     export
	src
	src     type
	src       stringarg=string[255];
	src       ttable   =packed array[0..0] of 0..255;
	src
	src     function afterstr(var s1:string;
	src                           c :integer;
	src                           n :integer;
	src                           s2:stringarg):integer;
	src     function beforestr(var s1:string;
	src                            c :integer;
	src                            n :integer;
	src                            s2:stringarg):integer;
	src     function changestr(var s1:string;
	src                            c :integer;
	src                            n :integer;
	src                            s2:stringarg;
	src                            s3:stringarg):integer;
	src     function breakstr(s1:stringarg;
	src                       c :integer;
	src                       s2:stringarg):integer;
	src     function spanstr(s1:stringarg;
	src                      c :integer;
	src                      s2:stringarg):integer;
	src
	src     function utloctal(s:stringarg): integer;
	src
	src     end;
*
* UTLOCTAL added 3/30/87 by jws -- removed dependecy on REALS library
*
	def     matchstr_matchstr
matchstr_matchstr     equ     *
	rts
afunc   equ     26
ams1    equ     24
as1     equ     20
ac      equ     16
an      equ     12
as2     equ     8
aargs   equ     18
	def     matchstr_afterstr
	dc.w    0
matchstr_afterstr  equ     *
	link    a6,#0
	clr.l   afunc(a6)       func:=0
	movea.l as1(a6),a0      a0:=^s1
	moveq   #0,d0
	move.b  (a0),d0         d0:=strlen(s1)
	move.l  an(a6),d2    if n>=0
	blt.s   after1       then
*
* count
*
	move.l  ac(a6),d3       d3:=c
	ble.s   aret    check cursor<=0
	movea.l as2(a6),a1      a1:=^s1
	moveq   #0,d1
	move.b  (a1)+,d1        d1:=strlen(s2)
	beq.s   after0
	bsr.s   scan
agood   move.l  d3,afunc(a6)
	bra.s   aret
*
* count but no string
*
after0  add.l   d2,d3   c:=c+n
	sub.l   d3,d0
	addq.l  #1,d0   c :: len(s1)+1
	bne     agood
	bra     aret
*                             else
* no count given
*
after1  movea.l as2(a6),a1
	moveq   #0,d1
	move.b  (a1)+,d1
	bne.s   after2
*
* no count no string
*
	addq.l  #1,d0           func:=d0+1
	move.l  d0,afunc(a6)

aret    unlk    a6              end
	movea.l (sp)+,a0
	adda.w  #aargs,sp
	jmp     (a0)
*
* no count with string
*
after2  moveq   #1,d2   count 1
	move.l  ac(a6),d3
	ble     aret    cursor out of range?
	bsr.s   scan
	beq     aret    must match at least once
after3  move.l  d3,afunc(a6)
	moveq   #1,d2   reset count
	bsr.s   scan
	bne     after3
	bra     aret
*
scan    equ     *
	subq.l  #1,d2   pre decriment count
*
scan1   movem.l d0-d2/a0-a1,-(sp) save for next call
	bsr     scanloop
	movem.l (sp)+,d0-d2/a0-a1
	beq.s   scanx
	dbra    d2,scan1
scanx   rts
scanloop        equ     *
	sub.l   d3,d0
	addq.l  #1,d0
	blt     sfexit  pos in range ?

	sub     d1,d0   is str2 longer than
	blt     sfexit  remaining str1 ?

	tst.w   d1
	beq.s   ssexit2 str2 is null so match

	movea.l a0,a2   save str1 ptr
	adda.w  d3,a0   start source compare

	move.b  (a1)+,d6        first character
	subq    #2,d1

scl1    cmp.b   (a0)+,d6
scl2    dbeq    d0,scl1
	bne.s   sfexit  found it ?

	movea.l a0,a3   temp str1
	movea.l a1,a4   temp str2

	move.w  d1,d5   remaining str2 bytes
	blt.s   ssexit  str2 is 1 char

scl3    cmpm.b  (a3)+,(a4)+
	dbne    d5,scl3
	bne     scl2
ssexit  move.l  a3,d3
	sub.l   a2,d3
	rts
ssexit2 move.l  d3,d3   set condition code
	rts

sfexit  moveq   #0,d3   cursor to zero
	rts
*
	def     matchstr_beforestr
	dc.w    0
matchstr_beforestr equ     *
	link    a6,#0
	clr.l   afunc(a6)       func:=0
	movea.l as1(a6),a0      a0:=^s1
	moveq   #0,d0
	move.b  (a0),d0         d0:=strlen(s1)
	move.l  an(a6),d2    if n>=0
	blt.s   before1      then
*
* count
*
	move.l  ac(a6),d3       d3:=c
	ble     aret    check cursor<=0
	movea.l as2(a6),a1      a1:=^s1
	moveq   #0,d1
	move.b  (a1)+,d1        d1:=strlen(s2)
	beq.s   before0
	bsr     scan
	beq.s   bgood
	sub.l   d1,d3   move to front of match
bgood   move.l  d3,afunc(a6)
	bra     aret
*
* count but no string
*
before0 sub.l   d2,d3         c:=c-n
	ble     aret    c :: 0
	bra     bgood
*                             else
* no count given
*
before1 movea.l as2(a6),a1
	moveq   #0,d1
	move.b  (a1)+,d1
	bne.s   before2
*
* no count no string
*
	moveq   #1,d0           func:=1
	move.l  d0,afunc(a6)
	bra     aret
*
* no count with string
*
before2 moveq   #1,d2   count 1
	move.l  ac(a6),d3
	ble     aret    cursor out of range?
	bsr     scan
	beq     aret    must match at least once
before3 move.l  d3,afunc(a6)
	sub.l   d1,afunc(a6)    move to front of match
	moveq   #1,d2   reset count
	bsr     scan
	bne     before3
	bra     aret

mf      equ     30
ms1m    equ     28
ms1     equ     24
mc      equ     20
mk      equ     16
ms2     equ     12
ms3     equ     8
mr      equ     22
	def     matchstr_changestr
	dc.w    0
matchstr_changestr equ     *
	link    a6,#0

	clr.l   mf(a6)  function result 0

	move.l  mc(a6),d4      cursor
	ble     chgret

	movea.l ms1(a6),a0
	moveq   #0,d0
	move.b  (a0),d0
	sub.l   d4,d0
	addq.l  #1,d0
	blt     chgret  cursor in range ?

	move.l  mk(a6),d5      counter
	beq     chgzcnt
	ble     chgncnt

*       have count value

	movea.l ms2(a6),a1
	tst.b   (a1)
	beq     chgcnil1

*       have count and s2 and maybe s3
*       replace the next n occurences of s2 with s3

	bra.s   chgl2
chgl1   movem.l d5,-(sp)       save count
	bsr     chgflds
	movem.l (sp)+,d5       get count
	move.l  d4,mf(a6)      set func
	beq     chgret
chgl2   dbra    d5,chgl1
	bra     chgret

*       count but no s2
*       replace next count chars with s3
	moveq   #0,d0
	move.b  (a0),d0
	move.l  d0,d3   final length of s1
	sub.l   d5,d3
	movea.l ms3(a6),a2
	moveq   #0,d2
	move.b  (a2),d2
	add.l   d2,d3
	blt     chgret  count is too big

*       count is zero
*       insert s3 at cursor

nilstr  dc.w    0
*               make ms2 a dummy nilstring
chgzcnt move.l  #nilstr,ms2(a6)
	bsr.s   chgflds
	move.l  d4,mf(a6)
	bra     chgret
*
*       no count
*
chgncnt movea.l ms2(a6),a1
	tst.b   (a1)
	beq.s   chgnil1

*       no count but has s2 might have s3
*       replace all occurences of s2 with s3

	bsr.s   chgflds
	move.l  d4,mf(a6)
	beq     chgret  must change at least one
chgncnt1 bsr.s  chgflds
	move.l  d4,mf(a6)       set func value
	beq     chgret
	bra     chgncnt1

*       no count no s2

chgnil1 movea.l ms3(a6),a2
	tst.b   (a2)
	beq.s   chgnil2

*       no count only s3
*       replace rest of s1 with s3

	move.b  d4,(a0) chop s1 to cursor
	subq.b  #1,(a0)
	bra     chgzcnt add s3
*
* no count no strings
*       delete remainder of s1

chgnil2 move.b  d4,(a0) set s1 length
	subq.b  #1,(a0)
	move.l  d4,mf(a6) set func value
	bra     chgret

*       have count no s2
*       replace count bytes with s3

chgcnil1 sub.l   d5,d0   d0 is #bytes after delete
	blt     chgret

	movea.l ms3(a6),a2 addr and size of s3
	moveq   #0,d2
	move.b  (a2)+,d2

	moveq   #0,d3
	move.b  (a0),d3 will it fit
	sub     d5,d3
	add     d2,d3   final size of s1
	cmp.b   ms1m(a6),d3
	bhi     chgret

	move.l  d5,d7   apparent size of s2

	adda    d4,a0   cursor addr
	lea     0(a0,d5.w),a3   after delete
	bsr     chgf1   do it
	move.l  d4,mf(a6)
	bra     chgret

chgbad  moveq   #0,d4   cursor to zero
	rts
*
*       do one change
*
chgflds movea.l ms1(a6),a0     source string
	moveq   #0,d0
	move.b  (a0),d0        s length
	move.l  d0,d3   final length of s
	sub.l   d4,d0
	addq.l  #1,d0
	blt     chgbad  pos in range ?

	movea.l ms2(a6),a1      old string
	moveq   #0,d1
	move.b  (a1)+,d1        old lenght
	move.l  d1,d7   save it for later

	movea.l ms3(a6),a2      new string
	moveq   #0,d2
	move.b  (a2)+,d2        new length

	sub     d1,d3
	add     d2,d3
	cmp.b   ms1m(a6),d3     will it all fit ?
	bhi     chgbad

	adda.w  d4,a0   start source compare

	tst.b   d1
	beq     chgins          0 length so match

	sub     d1,d0   is old longer than
	blt     chgbad  remaining source ?

	move.b  (a1)+,d6        first character
	subq    #2,d1

chg1    cmp.b   (a0)+,d6
chg2    dbeq    d0,chg1
	bne.s   chgret  found it ?

	movea.l a0,a3   temp source
	movea.l a1,a4   temp old

	move.w  d1,d5   remaining old bytes
	blt.s   chgf0   old is 1 char

chg3    cmpm.b  (a3)+,(a4)+
	dbne    d5,chg3
	bne     chg2

chgf0   subq.l  #1,a0

chgf1   movea.l ms1(a6),a4       string s
	move.b  d3,(a4)
	tst.w   d0
	beq     chgcpy1
	sub.w   d2,d7
	beq.s   chgcpy1
	bgt.s   chgsml
* new string is greater than old
	lea     1(a4,d3.w),a4     end s + 1
	lea     0(a4,d7.w),a3   source
	subq.w  #1,d0   count

chgins1 move.b  -(a3),-(a4)
	dbra    d0,chgins1
	bra.s   chgcpy1

chgcpy  move.b  (a2)+,(a0)+
chgcpy1 dbra    d2,chgcpy

	suba.l  ms1(a6),a0
	move.l  a0,d4           new cursor value
	rts

chgret  unlk    a6
	movea.l (sp)+,a0
	adda.w  #mr,sp
	jmp     (a0)
*
* new string is smaller than old
chgsml  equ     *
	movea.l a3,a4
	suba.w  d7,a4
	subq.w  #1,d0

chgdel1 move.b  (a3)+,(a4)+
	dbra    d0,chgdel1
	bra     chgcpy1

chgins  equ     *
	movea.l a0,a3
	bra     chgf1

bf      equ     20
bs1     equ     16
bc      equ     12
bs2     equ     8
bargs   equ     12

	def     matchstr_breakstr
	dc.w    0
matchstr_breakstr  equ     *
	link    a6,#0
	clr.l   bf(a6)          set func to 0

	move.l  bc(a6),d4       cursor pos
	ble.s   bsret

	movea.l bs1(a6),a0
	movea.l a0,a4   save addr of s1
	moveq   #0,d0
	move.b  (a0),d0       length s1
	beq.s   bsret

	sub.l   d4,d0
	blt.s   bsret

	movea.l bs2(a6),a1    list addr
	moveq   #0,d1
	move.b  (a1)+,d1      list length
	beq.s   bsret

	adda.l  d4,a0   start scan
	subq.w  #1,d1

bloop0  move.b  (a0)+,d2        char to test
	movea.l a1,a2   copy list addr
	move.w  d1,d3   copy list length

bloop1  cmp.b   (a2)+,d2
	dbeq    d3,bloop1
	beq.s   bsxit

	dbra    d0,bloop0
	bra.s   bsret

bsxit   suba.l  a4,a0   calc func value
	subq.l  #1,a0
	move.l  a0,bf(a6)

bsret   unlk    a6
	movea.l (sp)+,a0
	adda.w  #bargs,sp
	jmp     (a0)

	def     matchstr_spanstr
	dc.w    0
matchstr_spanstr   equ     *
	link    a6,#0
	clr.l   bf(a6)  zero function value
	move.l  bc(a6),d4       cursor position
	ble.s   bsret

	movea.l bs1(a6),a0      string addr
	movea.l a0,a4
	moveq   #0,d0
	move.b  (a0),d0         string length
	beq.s   bsret
	sub.l   d4,d0
	blt.s   bsret

	movea.l bs2(a6),a1      list addr
	moveq   #0,d1
	move.b  (a1)+,d1        list length
	beq.s   bsret

	adda.l  d4,a0   start scan
	subq.w  #1,d1

sloop0  move.b  (a0)+,d2
	movea.l a1,a2   copy list addr
	move.l  d1,d3   copy list length

sloop1  cmp.b   (a2)+,d2
	dbeq    d3,sloop1
	bne     bsxit

	dbra    d0,sloop0
	bra     bsxit

*********************************************************************
*
* utloctal added 3/30/87 by jws
*  -- removed dependecy of FILER on REALS library
*
*********************************************************************
*
	refa    sysglobals
	def matchstr_utloctal
matchstr_utloctal  movea.l 4(sp),a0      address of string
	clr.l   d0              result
	move.b  (a0)+,d2        length of string
	beq.s   error           {sb}
oct@@l1  clr.l   d1
	move.b  (a0)+,d1
	cmpi.b  #32,d1          ord(' ') = 32
	bne.s   oct@@l2
	subq.b  #1,d2
	bgt.s   oct@@l1
	bra.s   error           {sb}
oct@@l5  clr.l   d1
	move.b  (a0)+,d1
oct@@l2  subi.w  #48,d1          ord('0') = 48
	blt.s   tstblk
	cmpi.w  #7,d1
	bgt.s   error
	move.l  d0,d3
	andi.l  #$E0000000,d3
	bne.s   error
	asl.l   #3,d0
	add.l   d1,d0
	subq.b  #1,d2
	bgt.s   oct@@l5
oct@@l4  move.l  d0,8(sp)   put function result on the stack
	move.l  (sp)+,(sp)  move the return address up
	rts

tstblk  addi.w #48,d1
tstblk0 cmpi.b #32,d1           test for trailing blanks
	bne.s  error
	subq.b #1,d2
	ble.s  oct@@l4
	move.b (a0)+,d1
	bra.s  tstblk0

error   move.w  #-8,sysglobals-2(a5)
	trap    #10             value range error

	end
@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 580
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 580
* match pack
*
	nosyms
	sprint
	mname   matchstr

	src     module matchstr;
	src     export
	src
	src     type
	src       stringarg=string[255];
	src       ttable   =packed array[0..0] of 0..255;
	src
	src     function afterstr(var s1:string;
	src                           c :integer;
	src                           n :integer;
	src                           s2:stringarg):integer;
	src     function beforestr(var s1:string;
	src                            c :integer;
	src                            n :integer;
	src                            s2:stringarg):integer;
	src     function changestr(var s1:string;
	src                            c :integer;
	src                            n :integer;
	src                            s2:stringarg;
	src                            s3:stringarg):integer;
	src     function breakstr(s1:stringarg;
	src                       c :integer;
	src                       s2:stringarg):integer;
	src     function spanstr(s1:stringarg;
	src                      c :integer;
	src                      s2:stringarg):integer;
	src
	src     function utloctal(s:stringarg): integer;
	src
	src     end;
*
* UTLOCTAL added 3/30/87 by jws -- removed dependecy on REALS library
*
	def     matchstr_matchstr
matchstr_matchstr     equ     *
	rts
afunc   equ     26
ams1    equ     24
as1     equ     20
ac      equ     16
an      equ     12
as2     equ     8
aargs   equ     18
	def     matchstr_afterstr
	dc.w    0
matchstr_afterstr  equ     *
	link    a6,#0
	clr.l   afunc(a6)       func:=0
	movea.l as1(a6),a0      a0:=^s1
	moveq   #0,d0
	move.b  (a0),d0         d0:=strlen(s1)
	move.l  an(a6),d2    if n>=0
	blt.s   after1       then
*
* count
*
	move.l  ac(a6),d3       d3:=c
	ble.s   aret    check cursor<=0
	movea.l as2(a6),a1      a1:=^s1
	moveq   #0,d1
	move.b  (a1)+,d1        d1:=strlen(s2)
	beq.s   after0
	bsr.s   scan
agood   move.l  d3,afunc(a6)
	bra.s   aret
*
* count but no string
*
after0  add.l   d2,d3   c:=c+n
	sub.l   d3,d0
	addq.l  #1,d0   c :: len(s1)+1
	bne     agood
	bra     aret
*                             else
* no count given
*
after1  movea.l as2(a6),a1
	moveq   #0,d1
	move.b  (a1)+,d1
	bne.s   after2
*
* no count no string
*
	addq.l  #1,d0           func:=d0+1
	move.l  d0,afunc(a6)

aret    unlk    a6              end
	movea.l (sp)+,a0
	adda.w  #aargs,sp
	jmp     (a0)
*
* no count with string
*
after2  moveq   #1,d2   count 1
	move.l  ac(a6),d3
	ble     aret    cursor out of range?
	bsr.s   scan
	beq     aret    must match at least once
after3  move.l  d3,afunc(a6)
	moveq   #1,d2   reset count
	bsr.s   scan
	bne     after3
	bra     aret
*
scan    equ     *
	subq.l  #1,d2   pre decriment count
*
scan1   movem.l d0-d2/a0-a1,-(sp) save for next call
	bsr     scanloop
	movem.l (sp)+,d0-d2/a0-a1
	beq.s   scanx
	dbra    d2,scan1
scanx   rts
scanloop        equ     *
	sub.l   d3,d0
	addq.l  #1,d0
	blt     sfexit  pos in range ?

	sub     d1,d0   is str2 longer than
	blt     sfexit  remaining str1 ?

	tst.w   d1
	beq.s   ssexit2 str2 is null so match

	movea.l a0,a2   save str1 ptr
	adda.w  d3,a0   start source compare

	move.b  (a1)+,d6        first character
	subq    #2,d1

scl1    cmp.b   (a0)+,d6
scl2    dbeq    d0,scl1
	bne.s   sfexit  found it ?

	movea.l a0,a3   temp str1
	movea.l a1,a4   temp str2

	move.w  d1,d5   remaining str2 bytes
	blt.s   ssexit  str2 is 1 char

scl3    cmpm.b  (a3)+,(a4)+
	dbne    d5,scl3
	bne     scl2
ssexit  move.l  a3,d3
	sub.l   a2,d3
	rts
ssexit2 move.l  d3,d3   set condition code
	rts

sfexit  moveq   #0,d3   cursor to zero
	rts
*
	def     matchstr_beforestr
	dc.w    0
matchstr_beforestr equ     *
	link    a6,#0
	clr.l   afunc(a6)       func:=0
	movea.l as1(a6),a0      a0:=^s1
	moveq   #0,d0
	move.b  (a0),d0         d0:=strlen(s1)
	move.l  an(a6),d2    if n>=0
	blt.s   before1      then
*
* count
*
	move.l  ac(a6),d3       d3:=c
	ble     aret    check cursor<=0
	movea.l as2(a6),a1      a1:=^s1
	moveq   #0,d1
	move.b  (a1)+,d1        d1:=strlen(s2)
	beq.s   before0
	bsr     scan
	beq.s   bgood
	sub.l   d1,d3   move to front of match
bgood   move.l  d3,afunc(a6)
	bra     aret
*
* count but no string
*
before0 sub.l   d2,d3         c:=c-n
	ble     aret    c :: 0
	bra     bgood
*                             else
* no count given
*
before1 movea.l as2(a6),a1
	moveq   #0,d1
	move.b  (a1)+,d1
	bne.s   before2
*
* no count no string
*
	moveq   #1,d0           func:=1
	move.l  d0,afunc(a6)
	bra     aret
*
* no count with string
*
before2 moveq   #1,d2   count 1
	move.l  ac(a6),d3
	ble     aret    cursor out of range?
	bsr     scan
	beq     aret    must match at least once
before3 move.l  d3,afunc(a6)
	sub.l   d1,afunc(a6)    move to front of match
	moveq   #1,d2   reset count
	bsr     scan
	bne     before3
	bra     aret

mf      equ     30
ms1m    equ     28
ms1     equ     24
mc      equ     20
mk      equ     16
ms2     equ     12
ms3     equ     8
mr      equ     22
	def     matchstr_changestr
	dc.w    0
matchstr_changestr equ     *
	link    a6,#0

	clr.l   mf(a6)  function result 0

	move.l  mc(a6),d4      cursor
	ble     chgret

	movea.l ms1(a6),a0
	moveq   #0,d0
	move.b  (a0),d0
	sub.l   d4,d0
	addq.l  #1,d0
	blt     chgret  cursor in range ?

	move.l  mk(a6),d5      counter
	beq     chgzcnt
	ble     chgncnt

*       have count value

	movea.l ms2(a6),a1
	tst.b   (a1)
	beq     chgcnil1

*       have count and s2 and maybe s3
*       replace the next n occurences of s2 with s3

	bra.s   chgl2
chgl1   movem.l d5,-(sp)       save count
	bsr     chgflds
	movem.l (sp)+,d5       get count
	move.l  d4,mf(a6)      set func
	beq     chgret
chgl2   dbra    d5,chgl1
	bra     chgret

*       count but no s2
*       replace next count chars with s3
	moveq   #0,d0
	move.b  (a0),d0
	move.l  d0,d3   final length of s1
	sub.l   d5,d3
	movea.l ms3(a6),a2
	moveq   #0,d2
	move.b  (a2),d2
	add.l   d2,d3
	blt     chgret  count is too big

*       count is zero
*       insert s3 at cursor

nilstr  dc.w    0
*               make ms2 a dummy nilstring
chgzcnt move.l  #nilstr,ms2(a6)
	bsr.s   chgflds
	move.l  d4,mf(a6)
	bra     chgret
*
*       no count
*
chgncnt movea.l ms2(a6),a1
	tst.b   (a1)
	beq.s   chgnil1

*       no count but has s2 might have s3
*       replace all occurences of s2 with s3

	bsr.s   chgflds
	move.l  d4,mf(a6)
	beq     chgret  must change at least one
chgncnt1 bsr.s  chgflds
	move.l  d4,mf(a6)       set func value
	beq     chgret
	bra     chgncnt1

*       no count no s2

chgnil1 movea.l ms3(a6),a2
	tst.b   (a2)
	beq.s   chgnil2

*       no count only s3
*       replace rest of s1 with s3

	move.b  d4,(a0) chop s1 to cursor
	subq.b  #1,(a0)
	bra     chgzcnt add s3
*
* no count no strings
*       delete remainder of s1

chgnil2 move.b  d4,(a0) set s1 length
	subq.b  #1,(a0)
	move.l  d4,mf(a6) set func value
	bra     chgret

*       have count no s2
*       replace count bytes with s3

chgcnil1 sub.l   d5,d0   d0 is #bytes after delete
	blt     chgret

	movea.l ms3(a6),a2 addr and size of s3
	moveq   #0,d2
	move.b  (a2)+,d2

	moveq   #0,d3
	move.b  (a0),d3 will it fit
	sub     d5,d3
	add     d2,d3   final size of s1
	cmp.b   ms1m(a6),d3
	bhi     chgret

	move.l  d5,d7   apparent size of s2

	adda    d4,a0   cursor addr
	lea     0(a0,d5.w),a3   after delete
	bsr     chgf1   do it
	move.l  d4,mf(a6)
	bra     chgret

chgbad  moveq   #0,d4   cursor to zero
	rts
*
*       do one change
*
chgflds movea.l ms1(a6),a0     source string
	moveq   #0,d0
	move.b  (a0),d0        s length
	move.l  d0,d3   final length of s
	sub.l   d4,d0
	addq.l  #1,d0
	blt     chgbad  pos in range ?

	movea.l ms2(a6),a1      old string
	moveq   #0,d1
	move.b  (a1)+,d1        old lenght
	move.l  d1,d7   save it for later

	movea.l ms3(a6),a2      new string
	moveq   #0,d2
	move.b  (a2)+,d2        new length

	sub     d1,d3
	add     d2,d3
	cmp.b   ms1m(a6),d3     will it all fit ?
	bhi     chgbad

	adda.w  d4,a0   start source compare

	tst.b   d1
	beq     chgins          0 length so match

	sub     d1,d0   is old longer than
	blt     chgbad  remaining source ?

	move.b  (a1)+,d6        first character
	subq    #2,d1

chg1    cmp.b   (a0)+,d6
chg2    dbeq    d0,chg1
	bne.s   chgret  found it ?

	movea.l a0,a3   temp source
	movea.l a1,a4   temp old

	move.w  d1,d5   remaining old bytes
	blt.s   chgf0   old is 1 char

chg3    cmpm.b  (a3)+,(a4)+
	dbne    d5,chg3
	bne     chg2

chgf0   subq.l  #1,a0

chgf1   movea.l ms1(a6),a4       string s
	move.b  d3,(a4)
	tst.w   d0
	beq     chgcpy1
	sub.w   d2,d7
	beq.s   chgcpy1
	bgt.s   chgsml
* new string is greater than old
	lea     1(a4,d3.w),a4     end s + 1
	lea     0(a4,d7.w),a3   source
	subq.w  #1,d0   count

chgins1 move.b  -(a3),-(a4)
	dbra    d0,chgins1
	bra.s   chgcpy1

chgcpy  move.b  (a2)+,(a0)+
chgcpy1 dbra    d2,chgcpy

	suba.l  ms1(a6),a0
	move.l  a0,d4           new cursor value
	rts

chgret  unlk    a6
	movea.l (sp)+,a0
	adda.w  #mr,sp
	jmp     (a0)
*
* new string is smaller than old
chgsml  equ     *
	movea.l a3,a4
	suba.w  d7,a4
	subq.w  #1,d0

chgdel1 move.b  (a3)+,(a4)+
	dbra    d0,chgdel1
	bra     chgcpy1

chgins  equ     *
	movea.l a0,a3
	bra     chgf1

bf      equ     20
bs1     equ     16
bc      equ     12
bs2     equ     8
bargs   equ     12

	def     matchstr_breakstr
	dc.w    0
matchstr_breakstr  equ     *
	link    a6,#0
	clr.l   bf(a6)          set func to 0

	move.l  bc(a6),d4       cursor pos
	ble.s   bsret

	movea.l bs1(a6),a0
	movea.l a0,a4   save addr of s1
	moveq   #0,d0
	move.b  (a0),d0       length s1
	beq.s   bsret

	sub.l   d4,d0
	blt.s   bsret

	movea.l bs2(a6),a1    list addr
	moveq   #0,d1
	move.b  (a1)+,d1      list length
	beq.s   bsret

	adda.l  d4,a0   start scan
	subq.w  #1,d1

bloop0  move.b  (a0)+,d2        char to test
	movea.l a1,a2   copy list addr
	move.w  d1,d3   copy list length

bloop1  cmp.b   (a2)+,d2
	dbeq    d3,bloop1
	beq.s   bsxit

	dbra    d0,bloop0
	bra.s   bsret

bsxit   suba.l  a4,a0   calc func value
	subq.l  #1,a0
	move.l  a0,bf(a6)

bsret   unlk    a6
	movea.l (sp)+,a0
	adda.w  #bargs,sp
	jmp     (a0)

	def     matchstr_spanstr
	dc.w    0
matchstr_spanstr   equ     *
	link    a6,#0
	clr.l   bf(a6)  zero function value
	move.l  bc(a6),d4       cursor position
	ble.s   bsret

	movea.l bs1(a6),a0      string addr
	movea.l a0,a4
	moveq   #0,d0
	move.b  (a0),d0         string length
	beq.s   bsret
	sub.l   d4,d0
	blt.s   bsret

	movea.l bs2(a6),a1      list addr
	moveq   #0,d1
	move.b  (a1)+,d1        list length
	beq.s   bsret

	adda.l  d4,a0   start scan
	subq.w  #1,d1

sloop0  move.b  (a0)+,d2
	movea.l a1,a2   copy list addr
	move.l  d1,d3   copy list length

sloop1  cmp.b   (a2)+,d2
	dbeq    d3,sloop1
	bne     bsxit

	dbra    d0,sloop0
	bra     bsxit

*********************************************************************
*
* utloctal added 3/30/87 by jws
*  -- removed dependecy of FILER on REALS library
*
*********************************************************************
*
	refa    sysglobals
	def matchstr_utloctal
matchstr_utloctal  movea.l 4(sp),a0      address of string
	clr.l   d0              result
	move.b  (a0)+,d2        length of string
	beq.s   error           {sb}
oct@@l1  clr.l   d1
	move.b  (a0)+,d1
	cmpi.b  #32,d1          ord(' ') = 32
	bne.s   oct@@l2
	subq.b  #1,d2
	bgt.s   oct@@l1
	bra.s   error           {sb}
oct@@l5  clr.l   d1
	move.b  (a0)+,d1
oct@@l2  subi.w  #48,d1          ord('0') = 48
	blt.s   tstblk
	cmpi.w  #7,d1
	bgt.s   error
	move.l  d0,d3
	andi.l  #$E0000000,d3
	bne.s   error
	asl.l   #3,d0
	add.l   d1,d0
	subq.b  #1,d2
	bgt.s   oct@@l5
oct@@l4  move.l  d0,8(sp)   put function result on the stack
	move.l  (sp)+,(sp)  move the return address up
	rts

tstblk  addi.w #48,d1
tstblk0 cmpi.b #32,d1           test for trailing blanks
	bne.s  error
	subq.b #1,d2
	ble.s  oct@@l4
	move.b (a0)+,d1
	bra.s  tstblk0

error   move.w  #-8,sysglobals-2(a5)
	trap    #10             value range error

	end
@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.3
log
@
pws2rcs automatic delta on Wed Aug 21 12:27:56 MDT 1991
@
text
@@


54.2
log
@
pws2rcs automatic delta on Wed Aug 21 09:35:48 MDT 1991
@
text
@d1 580
@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@a0 580
* match pack
*
	nosyms
	sprint
	mname   matchstr

	src     module matchstr;
	src     export
	src
	src     type
	src       stringarg=string[255];
	src       ttable   =packed array[0..0] of 0..255;
	src
	src     function afterstr(var s1:string;
	src                           c :integer;
	src                           n :integer;
	src                           s2:stringarg):integer;
	src     function beforestr(var s1:string;
	src                            c :integer;
	src                            n :integer;
	src                            s2:stringarg):integer;
	src     function changestr(var s1:string;
	src                            c :integer;
	src                            n :integer;
	src                            s2:stringarg;
	src                            s3:stringarg):integer;
	src     function breakstr(s1:stringarg;
	src                       c :integer;
	src                       s2:stringarg):integer;
	src     function spanstr(s1:stringarg;
	src                      c :integer;
	src                      s2:stringarg):integer;
	src
	src     function utloctal(s:stringarg): integer;
	src
	src     end;
*
* UTLOCTAL added 3/30/87 by jws -- removed dependecy on REALS library
*
	def     matchstr_matchstr
matchstr_matchstr     equ     *
	rts
afunc   equ     26
ams1    equ     24
as1     equ     20
ac      equ     16
an      equ     12
as2     equ     8
aargs   equ     18
	def     matchstr_afterstr
	dc.w    0
matchstr_afterstr  equ     *
	link    a6,#0
	clr.l   afunc(a6)       func:=0
	movea.l as1(a6),a0      a0:=^s1
	moveq   #0,d0
	move.b  (a0),d0         d0:=strlen(s1)
	move.l  an(a6),d2    if n>=0
	blt.s   after1       then
*
* count
*
	move.l  ac(a6),d3       d3:=c
	ble.s   aret    check cursor<=0
	movea.l as2(a6),a1      a1:=^s1
	moveq   #0,d1
	move.b  (a1)+,d1        d1:=strlen(s2)
	beq.s   after0
	bsr.s   scan
agood   move.l  d3,afunc(a6)
	bra.s   aret
*
* count but no string
*
after0  add.l   d2,d3   c:=c+n
	sub.l   d3,d0
	addq.l  #1,d0   c :: len(s1)+1
	bne     agood
	bra     aret
*                             else
* no count given
*
after1  movea.l as2(a6),a1
	moveq   #0,d1
	move.b  (a1)+,d1
	bne.s   after2
*
* no count no string
*
	addq.l  #1,d0           func:=d0+1
	move.l  d0,afunc(a6)

aret    unlk    a6              end
	movea.l (sp)+,a0
	adda.w  #aargs,sp
	jmp     (a0)
*
* no count with string
*
after2  moveq   #1,d2   count 1
	move.l  ac(a6),d3
	ble     aret    cursor out of range?
	bsr.s   scan
	beq     aret    must match at least once
after3  move.l  d3,afunc(a6)
	moveq   #1,d2   reset count
	bsr.s   scan
	bne     after3
	bra     aret
*
scan    equ     *
	subq.l  #1,d2   pre decriment count
*
scan1   movem.l d0-d2/a0-a1,-(sp) save for next call
	bsr     scanloop
	movem.l (sp)+,d0-d2/a0-a1
	beq.s   scanx
	dbra    d2,scan1
scanx   rts
scanloop        equ     *
	sub.l   d3,d0
	addq.l  #1,d0
	blt     sfexit  pos in range ?

	sub     d1,d0   is str2 longer than
	blt     sfexit  remaining str1 ?

	tst.w   d1
	beq.s   ssexit2 str2 is null so match

	movea.l a0,a2   save str1 ptr
	adda.w  d3,a0   start source compare

	move.b  (a1)+,d6        first character
	subq    #2,d1

scl1    cmp.b   (a0)+,d6
scl2    dbeq    d0,scl1
	bne.s   sfexit  found it ?

	movea.l a0,a3   temp str1
	movea.l a1,a4   temp str2

	move.w  d1,d5   remaining str2 bytes
	blt.s   ssexit  str2 is 1 char

scl3    cmpm.b  (a3)+,(a4)+
	dbne    d5,scl3
	bne     scl2
ssexit  move.l  a3,d3
	sub.l   a2,d3
	rts
ssexit2 move.l  d3,d3   set condition code
	rts

sfexit  moveq   #0,d3   cursor to zero
	rts
*
	def     matchstr_beforestr
	dc.w    0
matchstr_beforestr equ     *
	link    a6,#0
	clr.l   afunc(a6)       func:=0
	movea.l as1(a6),a0      a0:=^s1
	moveq   #0,d0
	move.b  (a0),d0         d0:=strlen(s1)
	move.l  an(a6),d2    if n>=0
	blt.s   before1      then
*
* count
*
	move.l  ac(a6),d3       d3:=c
	ble     aret    check cursor<=0
	movea.l as2(a6),a1      a1:=^s1
	moveq   #0,d1
	move.b  (a1)+,d1        d1:=strlen(s2)
	beq.s   before0
	bsr     scan
	beq.s   bgood
	sub.l   d1,d3   move to front of match
bgood   move.l  d3,afunc(a6)
	bra     aret
*
* count but no string
*
before0 sub.l   d2,d3         c:=c-n
	ble     aret    c :: 0
	bra     bgood
*                             else
* no count given
*
before1 movea.l as2(a6),a1
	moveq   #0,d1
	move.b  (a1)+,d1
	bne.s   before2
*
* no count no string
*
	moveq   #1,d0           func:=1
	move.l  d0,afunc(a6)
	bra     aret
*
* no count with string
*
before2 moveq   #1,d2   count 1
	move.l  ac(a6),d3
	ble     aret    cursor out of range?
	bsr     scan
	beq     aret    must match at least once
before3 move.l  d3,afunc(a6)
	sub.l   d1,afunc(a6)    move to front of match
	moveq   #1,d2   reset count
	bsr     scan
	bne     before3
	bra     aret

mf      equ     30
ms1m    equ     28
ms1     equ     24
mc      equ     20
mk      equ     16
ms2     equ     12
ms3     equ     8
mr      equ     22
	def     matchstr_changestr
	dc.w    0
matchstr_changestr equ     *
	link    a6,#0

	clr.l   mf(a6)  function result 0

	move.l  mc(a6),d4      cursor
	ble     chgret

	movea.l ms1(a6),a0
	moveq   #0,d0
	move.b  (a0),d0
	sub.l   d4,d0
	addq.l  #1,d0
	blt     chgret  cursor in range ?

	move.l  mk(a6),d5      counter
	beq     chgzcnt
	ble     chgncnt

*       have count value

	movea.l ms2(a6),a1
	tst.b   (a1)
	beq     chgcnil1

*       have count and s2 and maybe s3
*       replace the next n occurences of s2 with s3

	bra.s   chgl2
chgl1   movem.l d5,-(sp)       save count
	bsr     chgflds
	movem.l (sp)+,d5       get count
	move.l  d4,mf(a6)      set func
	beq     chgret
chgl2   dbra    d5,chgl1
	bra     chgret

*       count but no s2
*       replace next count chars with s3
	moveq   #0,d0
	move.b  (a0),d0
	move.l  d0,d3   final length of s1
	sub.l   d5,d3
	movea.l ms3(a6),a2
	moveq   #0,d2
	move.b  (a2),d2
	add.l   d2,d3
	blt     chgret  count is too big

*       count is zero
*       insert s3 at cursor

nilstr  dc.w    0
*               make ms2 a dummy nilstring
chgzcnt move.l  #nilstr,ms2(a6)
	bsr.s   chgflds
	move.l  d4,mf(a6)
	bra     chgret
*
*       no count
*
chgncnt movea.l ms2(a6),a1
	tst.b   (a1)
	beq.s   chgnil1

*       no count but has s2 might have s3
*       replace all occurences of s2 with s3

	bsr.s   chgflds
	move.l  d4,mf(a6)
	beq     chgret  must change at least one
chgncnt1 bsr.s  chgflds
	move.l  d4,mf(a6)       set func value
	beq     chgret
	bra     chgncnt1

*       no count no s2

chgnil1 movea.l ms3(a6),a2
	tst.b   (a2)
	beq.s   chgnil2

*       no count only s3
*       replace rest of s1 with s3

	move.b  d4,(a0) chop s1 to cursor
	subq.b  #1,(a0)
	bra     chgzcnt add s3
*
* no count no strings
*       delete remainder of s1

chgnil2 move.b  d4,(a0) set s1 length
	subq.b  #1,(a0)
	move.l  d4,mf(a6) set func value
	bra     chgret

*       have count no s2
*       replace count bytes with s3

chgcnil1 sub.l   d5,d0   d0 is #bytes after delete
	blt     chgret

	movea.l ms3(a6),a2 addr and size of s3
	moveq   #0,d2
	move.b  (a2)+,d2

	moveq   #0,d3
	move.b  (a0),d3 will it fit
	sub     d5,d3
	add     d2,d3   final size of s1
	cmp.b   ms1m(a6),d3
	bhi     chgret

	move.l  d5,d7   apparent size of s2

	adda    d4,a0   cursor addr
	lea     0(a0,d5.w),a3   after delete
	bsr     chgf1   do it
	move.l  d4,mf(a6)
	bra     chgret

chgbad  moveq   #0,d4   cursor to zero
	rts
*
*       do one change
*
chgflds movea.l ms1(a6),a0     source string
	moveq   #0,d0
	move.b  (a0),d0        s length
	move.l  d0,d3   final length of s
	sub.l   d4,d0
	addq.l  #1,d0
	blt     chgbad  pos in range ?

	movea.l ms2(a6),a1      old string
	moveq   #0,d1
	move.b  (a1)+,d1        old lenght
	move.l  d1,d7   save it for later

	movea.l ms3(a6),a2      new string
	moveq   #0,d2
	move.b  (a2)+,d2        new length

	sub     d1,d3
	add     d2,d3
	cmp.b   ms1m(a6),d3     will it all fit ?
	bhi     chgbad

	adda.w  d4,a0   start source compare

	tst.b   d1
	beq     chgins          0 length so match

	sub     d1,d0   is old longer than
	blt     chgbad  remaining source ?

	move.b  (a1)+,d6        first character
	subq    #2,d1

chg1    cmp.b   (a0)+,d6
chg2    dbeq    d0,chg1
	bne.s   chgret  found it ?

	movea.l a0,a3   temp source
	movea.l a1,a4   temp old

	move.w  d1,d5   remaining old bytes
	blt.s   chgf0   old is 1 char

chg3    cmpm.b  (a3)+,(a4)+
	dbne    d5,chg3
	bne     chg2

chgf0   subq.l  #1,a0

chgf1   movea.l ms1(a6),a4       string s
	move.b  d3,(a4)
	tst.w   d0
	beq     chgcpy1
	sub.w   d2,d7
	beq.s   chgcpy1
	bgt.s   chgsml
* new string is greater than old
	lea     1(a4,d3.w),a4     end s + 1
	lea     0(a4,d7.w),a3   source
	subq.w  #1,d0   count

chgins1 move.b  -(a3),-(a4)
	dbra    d0,chgins1
	bra.s   chgcpy1

chgcpy  move.b  (a2)+,(a0)+
chgcpy1 dbra    d2,chgcpy

	suba.l  ms1(a6),a0
	move.l  a0,d4           new cursor value
	rts

chgret  unlk    a6
	movea.l (sp)+,a0
	adda.w  #mr,sp
	jmp     (a0)
*
* new string is smaller than old
chgsml  equ     *
	movea.l a3,a4
	suba.w  d7,a4
	subq.w  #1,d0

chgdel1 move.b  (a3)+,(a4)+
	dbra    d0,chgdel1
	bra     chgcpy1

chgins  equ     *
	movea.l a0,a3
	bra     chgf1

bf      equ     20
bs1     equ     16
bc      equ     12
bs2     equ     8
bargs   equ     12

	def     matchstr_breakstr
	dc.w    0
matchstr_breakstr  equ     *
	link    a6,#0
	clr.l   bf(a6)          set func to 0

	move.l  bc(a6),d4       cursor pos
	ble.s   bsret

	movea.l bs1(a6),a0
	movea.l a0,a4   save addr of s1
	moveq   #0,d0
	move.b  (a0),d0       length s1
	beq.s   bsret

	sub.l   d4,d0
	blt.s   bsret

	movea.l bs2(a6),a1    list addr
	moveq   #0,d1
	move.b  (a1)+,d1      list length
	beq.s   bsret

	adda.l  d4,a0   start scan
	subq.w  #1,d1

bloop0  move.b  (a0)+,d2        char to test
	movea.l a1,a2   copy list addr
	move.w  d1,d3   copy list length

bloop1  cmp.b   (a2)+,d2
	dbeq    d3,bloop1
	beq.s   bsxit

	dbra    d0,bloop0
	bra.s   bsret

bsxit   suba.l  a4,a0   calc func value
	subq.l  #1,a0
	move.l  a0,bf(a6)

bsret   unlk    a6
	movea.l (sp)+,a0
	adda.w  #bargs,sp
	jmp     (a0)

	def     matchstr_spanstr
	dc.w    0
matchstr_spanstr   equ     *
	link    a6,#0
	clr.l   bf(a6)  zero function value
	move.l  bc(a6),d4       cursor position
	ble.s   bsret

	movea.l bs1(a6),a0      string addr
	movea.l a0,a4
	moveq   #0,d0
	move.b  (a0),d0         string length
	beq.s   bsret
	sub.l   d4,d0
	blt.s   bsret

	movea.l bs2(a6),a1      list addr
	moveq   #0,d1
	move.b  (a1)+,d1        list length
	beq.s   bsret

	adda.l  d4,a0   start scan
	subq.w  #1,d1

sloop0  move.b  (a0)+,d2
	movea.l a1,a2   copy list addr
	move.l  d1,d3   copy list length

sloop1  cmp.b   (a2)+,d2
	dbeq    d3,sloop1
	bne     bsxit

	dbra    d0,sloop0
	bra     bsxit

*********************************************************************
*
* utloctal added 3/30/87 by jws
*  -- removed dependecy of FILER on REALS library
*
*********************************************************************
*
	refa    sysglobals
	def matchstr_utloctal
matchstr_utloctal  movea.l 4(sp),a0      address of string
	clr.l   d0              result
	move.b  (a0)+,d2        length of string
	beq.s   error           {sb}
oct@@l1  clr.l   d1
	move.b  (a0)+,d1
	cmpi.b  #32,d1          ord(' ') = 32
	bne.s   oct@@l2
	subq.b  #1,d2
	bgt.s   oct@@l1
	bra.s   error           {sb}
oct@@l5  clr.l   d1
	move.b  (a0)+,d1
oct@@l2  subi.w  #48,d1          ord('0') = 48
	blt.s   tstblk
	cmpi.w  #7,d1
	bgt.s   error
	move.l  d0,d3
	andi.l  #$E0000000,d3
	bne.s   error
	asl.l   #3,d0
	add.l   d1,d0
	subq.b  #1,d2
	bgt.s   oct@@l5
oct@@l4  move.l  d0,8(sp)   put function result on the stack
	move.l  (sp)+,(sp)  move the return address up
	rts

tstblk  addi.w #48,d1
tstblk0 cmpi.b #32,d1           test for trailing blanks
	bne.s  error
	subq.b #1,d2
	ble.s  oct@@l4
	move.b (a0)+,d1
	bra.s  tstblk0

error   move.w  #-8,sysglobals-2(a5)
	trap    #10             value range error

	end
@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.2
log
@Added matchstr_utloctal (stolen from asm_octal in ALLREALS)
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@d33 3
d37 3
a39 1

d531 48
@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Auto bump revision for PAWS 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
