(*---------------------------------------------------------------------------
    :Program.    Strings.asm
    :Author.     Bernd Preusing
    :Address.    Gerhardstr. 16  D-2200 Elmshorn
    :Phone.      04121/22486
    :Shortcut.   [bep]
    :Version.    1.0
    :Date.       31-Oct-88
    :Copyright.  PD
    :Language.   68000 Assembler
    :Translator. Profimat
    :Imports.    ---
    :UpDate.     ---
    :Contents.   makes Strings.obj 3 to 30 times faster
    :Remark.     assemble pc relativ !!
    :Bugs.	 HIGH of all ARRAYs OF CHAR must be <=7FFEH, there is
 		 not always a check for it.
---------------------------------------------------------------------------*)
	CODE
	DC.L 1  ; Kennung: .obj-File
	DC.W 1	; mod
	DC.B 'Strings'
	DS.B 25,0
	DC.W $0DDE,$013D,$0113

; CodeSize
	DC.L	ENDE-Prog
; VarSize
	DC.L	2
; ConstSize
	DC.L	Jumps-Consts
; Jumps
	DC.L	7
; Modules
	DC.L	4

Consts:

Jumps:
	DC.W	$4EF9,0,Compare-204
	DC.W	$4EF9,0,Copy-204
	DC.W	$4EF9,0,Delete-204
	DC.W	$4EF9,0,Insert-204
	DC.W	$4EF9,0,Occurs-204
	DC.W	$4EF9,0,Length-204
	DC.W	$4EF9,0,Proc000-204

ModuleIds:
	DC.W 1	; mod
	DC.B 'Arts'
	DS.B 28,0
	DC.W $0DDE,$013E,$068D
ArtsBs_ EQUR Prog-16

	DC.W 0	; none
	DS.B 32,0
	DC.W $0000,$0000,$0000

	DC.W 0	; none
	DS.B 32,0
	DC.W $0000,$0000,$0000

	DC.W 0	; none
	DS.B 32,0
	DC.W $0000,$0000,$0000


dataPtr EQUR Prog-20

Prog:
Proc000:
	BRA     ModInit

Length:
	MOVE.L  8(A7),D0 ; HIGH = len-1
	MOVE.w  D0,D1
	MOVEA.L 4(A7),A3 ; str
	cmpi.l	#$00007FFE,d0	; damit 100% sicher
	bls.s	L000001		; Vergleich ohne Vorzeichen!
	trap	#14
L000001:
	tst.b   (A3)+
	dbeq    D1,L000001	; warum gibt es kein LONG-DBcc ??
	sub.w	D1,D0	  ; Länge in D0.L
	MOVEA.L (A7)+,A0
	ADDQ.L  #8,A7
	JMP     (A0)

; Cap hier als interne Prozedur, wandelt nun auch alle internatinalen Zeichen!!
;
CapD1:	; D1 => D1
	cmpi.b	#'a',d1
	bcs.s	CapOk
	cmpi.b	#'z',d1
	bls.s	CapLetter
	cmpi.b	#$E0,d1	; nun Umlaute etc. C0..DE, E0..FE
	bcs.s	CapOk
	cmpi.b	#$FE,d1
	bhi.s	CapOk
CapLetter:
	andi.b	#$5F,d1	; Großbuchstabe
CapOk:
	rts

; caseSens: 4(A7)d7  Adrtoken: 6(A7)A6  HIGHtoken: 10(A7)
; from: 14(A7)d6  ADRstr: 16(A7)a3  HIGHstr: 20(A7)d3
; len: d4  ch: d5  pos:d2  endfor: d3
; forpos: d6 (from nicht mehr gebraucht) occ: d0  help: d2
Occurs:
; am Source orientiert, damit RETURN-Verhalten exakt gleich
; register laden
	move.l	20(A7),D3	; HIGH(str)
	move.l	16(A7),A3	; str
	move.l	6(A7),A6	; token
	move.b	4(A7),D7	; caseSens 0=FALSE
	move.w	14(A7),D6	; from
	ext.l	d6

; if token[0]=0C then return from end
	move.l	d6,d0
	tst.b	(A6)
	beq	OccursOk

	MOVE.L  10(A7),d4
	cmpi.l	#$00007FFE,d4
	bls.s	OccLenOk
	trap	#14
OccLenOk:
	move.l	d4,d0
	MOVE.L  A6,a0
OccLen1:
	tst.b	(a0)+
	dbeq	d0,OccLen1
	sub.w	d0,d4		; length(token)

; if (from>HIGHstr) OR ((len-1)>HIGHstr) OR (from<0) then return last end
	cmp.l	d3,d6
	BGT.s   OccursLast
	move.l	d4,d1
	SUBQ.l  #1,D1 ; len-1
	CMP.L   D3,D1
	BGT.s   OccursLast
	TST.w   d6
	Blt.s	OccursLast

; for pos:=0 to from do if str[pos]=0C then return last end end
	move.w	d6,d2 ; = Anzahl-1
OccursLp1:
	tst.b	(a3)+
	dbeq	d2,OccursLp1
	beq.s	OccursLast
	subq.l	#1,a3	; wieder auf pos stellen

; if caseSens then ch:=token[0] else ch:=cap(token[0]) end
	move.b	(A6)+,d1 ; token[0]
	tst.b	d7
	bne.s	OccursCase1
	bsr.s	CapD1
OccursCase1:
	move.b	d1,d5	; ch:=..

; for pos:=from to highstr-len+1 do
	sub.l	d4,d3	; highstr-len ; pos==from==d6
	addq.l	#1,d3	; +1 = endfor
OccursFor:
	CMP.l   d3,d6
	BGT.s   OccursLast
; if str[pos]=0c then return last end
	tst.b	(a3)
	beq.s	OccursLast	; d0 ist -1
;   if str[pos]=ch then
;    if casesens then
	tst.b	d7
	beq.s	OccursCase2
	cmp.b	(a3)+,d5
	bra.s	OccursNo2
OccursCase2:
	move.b	(a3)+,d1
	bsr	CapD1
	cmp.b	d5,d1
OccursNo2:
	BNE.s   OccursNext
	MOVEq	#1,d0	; occ:=1
	move.l	A6,a2	; alte strpos und tokenpos behalten
	move.l	a3,a1
; loop
L000027:
; if occ>=len then return pos end
	CMP.W   D4,d0
	BLT.s   L000028
	MOVE.l  d6,D0
	BRA.s   OccursOk	; return pos
; if str[pos+occ]#token[occ] then exit end
L000028:
	tst.b	d7
	beq.s	OccursCase3
	cmpm.b	(a2)+,(a1)+
	bra.s	OccursNo3
OccursCase3:
	move.b	(a2)+,d1
	bsr	CapD1
	move.b	d1,d2
	move.b	(a1)+,d1
	bsr	CapD1
	cmp.b	d2,d1
OccursNo3:
	bne.s	OccursNext
	ADDQ.l  #1,d0
	BRA.S   L000027

OccursNext:
	ADDQ.L  #1,d6
	BVC.s   OccursFor

OccursLast:
	MOVEQ   #-1,D0

OccursOk:
	MOVEA.L (A7)+,A0
	LEA     20(A7),A7
	JMP     (A0)


; 4(A7)a3: ADRtoken  8(A7): HIGHtoken  12(A7): at.w d7
; 14(A7)a2: ADRstr  18(A7)d2: HIGHstr
; len.w d6 tokenlen.w d5  lastpos.w d4
Insert:
;
; 0.: at<0 then return
; 1.: evtl bis at mit spaces auffüllen
; 1.5.: tokenlen bestimmen
; 2.: evtl hinter at platz schaffen
; 3.: token einfügen
; 4.: letztes auf 0c setzen

	move.l	14(A7),a2
	move.l	a2,a0
        move.l	18(A7),d2

	MOVE.w  D2,D1
	move.w	d2,d6
InsLen1:
	tst.b   (A0)+
	dbeq    D1,InsLen1
	sub.w	D1,D6
; a0 jetzt hinter 0 oder hinter ende str
	subq.l	#1,a0

	move.w	12(A7),d7	; at
; if at=last then at:=strlength
	cmpi.w	#-1,d7
	bne.s	Ins2
	move.w	d6,d7		; at:=strlength, sicher >= 0
        bra.s	Ins3
; elsif at<first then return
Ins2:	blt	InsertOk	; at<-1: return
; elsif at>strlength then
	cmp.w	d6,d7
	ble.s	Ins3
;  if at>highstr then at:=highstr+1 end
	cmp.w	d2,d7
	ble.s	Ins2a
	move.w	d2,d7
	addq.w	#1,d7
Ins2a:
;  for i:=strlength to at-1 do str[i]:=' ' end;
	move.w	d7,d1
	sub.w	d6,d1
	bra.s	Ins2c
Ins2b:	move.b	#' ',(a0)+
Ins2c:	dbra	d1,Ins2b
;  if at<=highstr then str[at]:=0c end
	cmp.w	d2,d7
	bgt.s	Ins2d
	clr.b	(a0)
Ins2d:
; strlen:=at
	move.w	d7,d6
; end elsifs
Ins3:
; a0 steht nun auf 0c bzw. HIGH(str)
; d5:=tokenlen
	move.l	4(a7),a3
	move.l	a3,a1
	move.l	8(a7),d5
	MOVE.w  D5,D1
InsLen2:
	tst.b   (A1)+
	dbeq    D1,InsLen2
	sub.w	D1,D5
; a3 jetzt hinter 0 oder hinter ende str
; if tokenlen>0 then (bis ende)
	ble.s	InsertOk
; lastpos:=strlen+tokenlen-1
	move.w	d6,d4
	subq.w	#1,d4
	add.w	d5,d4
	trapv		; na ja, wenigstens etwas Sicherheit
; if lastpos>highstr then lp:=highstr end
	cmp.w	d2,d4
	ble.s	Ins4
	move.w	d2,d4
Ins4:
; if at<strlen then macheplatz
	cmp.w	d6,d7
	bge.s	Ins5
	move.l	a2,a0
	adda.w	d4,a0 ; + lastpos
	addq.l	#1,a0 ; wg. move -(),-()
	move.l	a0,a1
	suba.w	d5,a1 ; +lastpos-tokenlen
	move.w	d4,d0
	sub.w	d7,d0
	sub.w	d5,d0 ; d0:=lastpos-(at+tokenlen)  = Anz Verschieb-1
Ins4a:	move.b	-(a1),-(a0)
	dbra	d0,Ins4a
Ins5:
; if tokenlen>(maxstrlen-at) then tokenlen:=maxstrlen-at
	move.w	d2,d0
	sub.w	d7,d0
	addq.w	#1,d0
	cmp.w	d0,d5
	ble.s	Ins5a
	move.w	d0,d5
; (els)if lastpos<highstr then str[lastpos+1]:=0c end
Ins5a:
	cmp.w	d2,d4
	bge.s	Ins6
	clr.b	1(A2,d4.w)
Ins6:
; for i:=0 to tokenlen-1 do str[i+at]:=token[i] end
	adda.w	d7,a2
	subq.w	#1,d5	; tokenlen-1
Ins6a:	move.b	(a3)+,(a2)+
	dbra	d5,Ins6a
InsertOk:
	MOVEA.L (A7)+,A0
	LEA     18(A7),A7
	JMP     (A0)


; length: 4(A7)d7   start: 6(A7)d6    ADRstr: 8(A7)a3   HIGHstr: 12(A7)
;
Delete:
	move.w	4(A7),d7
	move.w	6(a7),d6
	TST.W   d7
	BLe.s   DelOk
	TST.W   d6
	Blt.s	DelOk
; gehe auf start, length ist >0
	move.l	8(a7),a3
	move.l	12(a7),d5
	sub.w	d6,d5		; max. restlänge-1
	blt.s	DelOk		; start muß <= HIGH(str) sein!
DelLp1:	tst.b	(a3)+
	dbeq	d6,DelLp1
	beq.s	DelOk		; str zu kurz
	clr.b	-(a3)		; 0 dranhängen (oder zwischen)
	cmp.w	d7,d5
	ble.s	DelOk		; nichts mehr zu verschieben, fertig
; rest verschieben
	move.l	a3,a2
	adda.w	d7,a2	; +length
DelLp2:	move.b	(a2)+,(a3)+
	dbeq	d5,DelLp2
DelOk:
	MOVEA.L (A7)+,A0
	LEA     12(A7),A7
	JMP     (A0)

; length: 4(A7)d7   start: 6(A7)d6  ADRsource: 8(A7)a3  HIGHsource: 12(A7)d3
; ADRstr: 16(A7)a2  HIGHstr: 20(A7)d2
Copy:
	move.l	16(a7),a2
	move.l	20(a7),d2
	clr.b	(a2)		; erstmal str löschen
	move.l	12(a7),d3	; highsource
	move.w	6(a7),d6	; start
	bmi.s	CopyOk		; start<0
	ext.l	d6
	cmp.l	d3,d6
	bgt.s	CopyOk		; start>highsource
	move.w	4(a7),d7
	ble.s	CopyOk		; length<=0
; gehe auf start source
	move.l	8(a7),a3
	move.w	d6,d5
CopyLp1:
	tst.b	(a3)+
	dbeq	d5,CopyLp1
	beq.s	CopyOk		; start>length(source)
	subq.l	#1,a3		; a3 auf start
; minimum (highstr,highsource-start,length-1) ermitteln
	clr.b	d0
	subq.w	#1,d7		; dec(length)
	sub.w	d6,d3
	cmp.w	d3,d7
	ble.s	Copy2
	move.w	d3,d7
Copy2:	cmp.w	d2,d7
	blt.s	Copy3
	move.w	d2,d7
	moveq	#1,d0		; flag: highstr ist minimum
; jetzt kopieren
Copy3:	move.b	(a3)+,(a2)+
	dbeq	d7,Copy3
; evtl letzten auf 0C
	beq.s	CopyOk
	tst.b	d0		; 1: highstr war minimum  0: ist noch Platz
	bne.s	CopyOk
	clr.b	(a2)
CopyOk:
	MOVEA.L (A7)+,A0
	LEA     20(A7),A7
	JMP     (A0)

; caseSens: 4(A7)d7.h   ADRtoken: 6(A7)a3   HIGHtoken: 10(A7)d4 length: 14(A7)d6
; start: 16(A7)d7  ADRstr: 18(A7)a2   HIGHstr: 22(A7)d2
; a d5 in token   b d7.w in str   c d3 endeb  ch1:d1 ch2:d6
Compare:
	clr.l	d0
	move.l	4(a7),d7	; casesens in vorzeichen d7.l !!
	move.w	16(a7),d7
	bmi	CompOk		; start<0
	move.w	14(a7),d6
	bmi	CompOk
	clr.l	d5
	move.w	d7,d3
	add.w	d6,d3		; c:=start+length
	trapv
; length(str)
	move.l	18(a7),a2
	move.l	a2,a1
	move.l	22(a7),d2
	cmpi.l	#$00007FFF,d2
	bls.s	CompNTrap
	trap	#14
CompNTrap:
	move.w	d2,d1
CompLp1:
	tst.b	(a1)+
	dbeq	d1,CompLp1
	sub.w	d1,d2		; d2=length(str)
	cmp.w	d3,d2
	bge.s	Comp2
	move.w	d2,d3
Comp2:
; str auf start stellen
	adda.w	d7,a2

	move.l	6(A7),a3
	move.l	10(a7),d4	; high(token)
	cmpi.l	#$00007FFF,d4
	bls.s	CompLoop
	trap	#14
CompLoop:
; if b>=c then
	cmp.w	d3,d7
	blt.s	CompElse
; if a>high(token) or token[a]=0c then return 0
	cmp.w	d4,d5
	bgt.s	CompOk
	tst.b	(a3)
	beq.s	CompOk
	bra.s	CompReta1	; return a+1
CompElse:
	cmp.w	d4,d5		; if a>hightoken
	bgt.s	CompRetMa1	; ret -(a+1)
CompEnd:
; ch2:=token[a]
	tst.l	d7		; casesens positiv=false, also CAP
	bpl.s	CompNoCase
	move.b	(a3)+,d6
	move.b	(a2)+,d1
	bra.s	CompCaseEnd
CompNoCase:
	move.b	(a3)+,d1
	bsr	CapD1
	move.b	d1,d6
	move.b	(a2)+,d1
	bsr	CapD1
CompCaseEnd:
; if ch>ch2 then
	cmp.b	d6,d1
	bhi.s	CompRetMa1	; return -(a+1)  (a,b werden erst später geINCt)
; elsif ch1<ch2 then
	bcs.s	CompReta1	; return -(a+1)
; elsif ch1=0c then
	tst.b	d1
	beq.s	CompOk		; return 0
	addq.w	#1,d5	; inc(a)
	addq.w	#1,d7	; inc(b)
	bra.s	CompLoop

CompRetMa1:
	addq.w	#1,d5
	trapv
	neg.w	d5
	bra.s	CompRet

CompReta1:
	addq.w	#1,d5
	trapv
CompRet:
	ext.l	d5
	move.l	d5,d0
CompOk:
	MOVEA.L (A7)+,A0
	LEA     22(A7),A7
	JMP     (A0)

ModInit: ; lassen wir fast(!) so, Arts können die anderen initialisieren!
	RTS
ENDE:
	END