* Program file Cruncher
* Copyright 1989 By M.S.Powell (usqb015@uk.ac.liv)
* Permission granted to examine and modify this source for; personal use,
* no profit and as long as this header is left intact.
* Written on Devpac v1.22 by Hisoft

* Examine command line

	move.l	4(sp),a5

	lea	129(a5),a5
	cmp.b	#'-',(a5)
	bne.s	nxtfield
	addq.l	#1,a5
chkqual	move.b	(a5)+,d0
	cmp.b	#$d,d0
	beq	invalid
	cmp.b	#' ',d0
	beq.s	nxtfield
	cmp.b	#'D',d0
	bne.s	notd
	move	#1,delete
notd	cmp.b	#'H',d0
	bne.s	noth
	move	#1,hold
noth	cmp.b	#'U',d0
	bne.s	notu
	move	#1,uncrunch
notu	cmp.b	#'I',d0
	bne.s	chkqual
	move	#1,ignore
	bra.s	chkqual

nxtfield
	cmp.b	#' ',(a5)
	bne.s	getname1
	addq.l	#1,a5
	bra.s	nxtfield
getname1
	cmp.b	#$d,(a5)
	beq	invalid
	move.l	a5,sourcenamepnt
getname1loop
	move.b	(a5)+,d0
	cmp.b	#$d,d0
	beq.s	fndend1
	cmp.b	#' ',d0
	bne.s	getname1loop
fndend1	subq.l	#1,a5
	move.l	a5,sourcenameend
	bra.s	intro

invalid	clr	cmndlnokay

* Intro procedure

intro	lea	mainmess(pc),a0
	bsr	print

	tst	cmndlnokay
	bne.s	clokay

	lea	instructions(pc),a0
	bsr	print
	bra	finished

clokay	pea	dta(pc)		set dta buffer
	move	#$1a,-(sp)
	trap	#1
	addq.l	#6,sp

	clr	-(sp)			Search for source file
	move.l	sourcenamepnt(pc),-(sp)
	move	#$4e,-(sp)
	trap	#1
	addq.l	#8,sp
	move	d0,error
	beq	nextfile

	lea	nomatch(pc),a0
	bsr	print
	bra	finished

* Main loop

nextfile
	lea	dta+30(pc),a0
	move.l	sourcenameend(pc),a1
	move.l	sourcenamepnt(pc),a2
look_for_name_start
	move.b	-(a1),d0
	cmp.b	#'\',d0
	beq.s	addname
	cmp.b	#':',d0
	beq.s	addname
	cmp.l	a2,a1
	bge.s	look_for_name_start

addname	moveq	#0,d1
	addq.l	#1,a1
anamlp	move.b	(a0)+,d0
	move.b	d0,(a1)+
	beq.s	done_name
	cmp.b	#'.',d0
	bne.s	anamlp
	moveq	#1,d1
	move.l	a1,sourcenameext
	bra.s	anamlp
done_name
	tst	d1
	bne.s	do_it
	move.l	a1,sourcenameext
do_it	bra	do_your_stuff
return
	tst	error
	beq.s	noerror

	tst	ignore
	beq.s	finished

noerror	move	#$4f,-(sp)
	trap	#1
	addq.l	#2,sp
	tst	d0
	beq.s	nextfile

finished
	tst	hold
	beq.s	nohold

	lea	pressany(pc),a0	
	bsr	print
	bsr.s	anykey

nohold	move	error(pc),-(sp)		Return error code to calling
	move	#$4c,-(sp)		program
	trap	#1	

anykey	pea	$20002
	trap	#13
	addq.l	#4,sp
	rts

prchar	move	d0,-(sp)
	pea	$30002
	trap	#13
	addq.l	#6,sp
	rts

	
* Main loop body

do_your_stuff
	move.l	sp,stack

	lea	reading(pc),a0
	bsr	print
	bsr	printfilename

	move.l	sp,a6
	sub.l	#4096,a6	a6=top of free memory
	move.l	dta+26(pc),d6	d6=file length
	cmp.l	#28,d6
	blt.s	not_a_program

	lea	buffer(pc),a0
	add.l	d6,a0
	cmp.l	a6,a0
	bgt	outofmemory

* Read in file

	lea	buffer(pc),a3
	clr	-(sp)
	move.l	sourcenamepnt(pc),-(sp)
	move	#$3d,-(sp)
	trap	#1
	addq.l	#8,sp
	tst.l	d0
	bmi	fileerror

	move	d0,d7
	pea	(a3)		Read first 2 bytes, to check if it is
	pea	2.w		a valid GEMDOS program
	move	d0,-(sp)
	move	#$3f,-(sp)
	trap	#1
	lea	12(sp),sp
	tst.l	d0
	bmi	fileerror
	cmp	#$601a,(a3)
	beq.s	a_prog

not_a_program
	lea	notprog(pc),a0
	bsr	print
	bra	exit

a_prog	pea	2(a3)
	move.l	d6,-(sp)
	move	d7,-(sp)
	move	#$3f,-(sp)
	trap	#1
	lea	12(sp),sp
	tst.l	d0
	bmi	fileerror

	move	d7,-(sp)
	move	#$3e,-(sp)
	trap	#1
	addq.l	#4,sp

* Check if file is already crunched

	lea	buffer+$1c(pc),a0
	lea	header+$1c(pc),a1
	move	#lengthoftable-header-$1c-1,d0
chklp	cmpm.b	(a0)+,(a1)+
	dbne	d0,chklp
	bne	crunchfile

* If file is already crunched, then uncrunch it

	tst	uncrunch
	bne.s	uncrunchit

	lea	crunched(pc),a0
	bsr	print
	bra	exit

uncrunchit
	lea	uncrunching(pc),a0
	bsr	print

	lea	buffer+(lengthoftable-header)(pc),a0
	lea	buffer-lengthoftable(a0),a3
	move.l	(a0)+,a4
	add.l	a3,a4
	move.l	(a0)+,a5
	add.l	a4,a5

	move.l	(a0)+,d0
	move.l	(a3),d1
	and.l	#$ffffff,d1
	lea	0(a4,d1.l),a0
	move.l	a0,a2
	lea	0(a5,d0.l),a1
	cmp.l	a6,a1
	bgt	outofmemory
	move.l	a1,a6
moveup1	move.b	-(a5),-(a1)
	cmp.l	a5,a0
	bne.s	moveup1
	move.l	a6,a5
	move.l	a1,a6

uncrunchloop1
	move.l	(a3)+,d1
	move.l	d1,d2
	rol.l	#8,d2
	and.l	#$ffffff,d1
	moveq	#0,d3
	move	(a3)+,d3
	bne.s	not103
	move.l	#65536,d3
not103	add.l	d0,d1
	sub.l	d3,d0
	lea	0(a4,d1.l),a0
	cmp.l	a6,a0
	beq.s	nomove12
movebitdown1
	move.b	(a6)+,(a2)+
	cmp.l	a6,a0
	bne.s	movebitdown1
nomove12
	subq	#1,d3
makeblock1
	move.b	d2,(a2)+
	dbra	d3,makeblock1
	tst.l	d0
	bne.s	uncrunchloop1

	move.l	a5,a3
	sub.l	a4,a3

	tst	delete
	beq	writefile
	move.l	sourcenameext(pc),a0
	move.b	#'.',-1(a0)
	move.b	#'U',(a0)+
	move.b	#'C',(a0)+
	move.b	#'R',(a0)+
	bra	writefile

* Crunch a file
	
crunchfile
	tst	uncrunch
	beq.s	okaycf

	lea	notcrunched(pc),a0
	bsr	print
	bra	exit

okaycf	lea	crunching(pc),a0
	bsr	print

	move.l	a6,a5
	sub.l	d6,a5
	move.l	a6,a4
	lea	0(a3,d6.l),a3
moveprogup
	move.b	-(a3),-(a4)
	cmp.l	a4,a5
	bne.s	moveprogup
	
	lea	buffer(pc),a4
	lea	-6(a6),a2
	move.l	2(a4),d7
	add.l	6(a4),d7
	add.l	$a(a4),d7	d7=total original length

	move.l	a5,a0
p1lp	moveq	#0,d0
	move.b	(a0),d0
	cmp.b	1(a0),d0
	bne.s	notsam
	cmp.b	2(a0),d0
	bne.s	notsam
	cmp.b	3(a0),d0
	bne.s	notsam
	cmp.b	4(a0),d0
	bne.s	notsam
	cmp.b	5(a0),d0
	bne.s	notsam
	cmp.b	6(a0),d0
	bne.s	notsam

	lea	7(a0),a1
fndend	cmp.l	a6,a1
	bgt.s	endprog
	cmp.b	(a1)+,d0
	beq.s	fndend
endprog	move.l	a0,d1
	sub.l	a5,d1
	ror.l	#8,d0
	or.l	d0,d1
	subq.l	#1,a1
	move.l	a1,d2
	sub.l	a0,d2
nextbit	cmp.l	#65536,d2
	ble.s	lastbit
	move.l	d1,(a4)+
	add.l	#65536,d1
	clr	(a4)+
	sub.l	#65536,d2
	bra.s	nextbit
lastbit	move.l	d1,(a4)+
	move	d2,(a4)+
	cmp.l	a5,a4
	bge	outofmemory
	lea	-1(a1),a0

notsam	addq.l	#1,a0
	cmp.l	a2,a0
	blt.s	p1lp

	lea	buffer+4(pc),a3
	cmp.l	a3,a4		Is table empty?
	blt	hopeless
	move.l	a4,-(sp)
	moveq	#0,d1
	move	-(a4),d1
	bne.s	not0
	move.l	#65536,d1
not0	move.l	-4(a4),d2
	and.l	#$ffffff,d2
	add.l	d1,d2
	lea	0(a5,d2.l),a2
	cmp.l	a4,a3
	beq.s	lastblock
crunchloop
	move.l	-(a4),d2
	and.l	#$ffffff,d2
	lea	0(a5,d2.l),a1
	moveq	#0,d1
	move	-(a4),d1
	bne.s	not01
	move.l	#65536,d1
not01	move.l	-4(a4),d2
	and.l	#$ffffff,d2
	add.l	d1,d2
	lea	0(a5,d2.l),a0
	cmp.l	a1,a0
	beq.s	nomove
removeblock
	move.b	-(a1),-(a2)
	cmp.l	a1,a0
	bne.s	removeblock
nomove	cmp.l	a4,a3
	bne.s	crunchloop

lastblock
	move.l	-(a4),d1
	and.l	#$ffffff,d1
	lea	0(a5,d1.l),a1
	cmp.l	a5,a1
	beq.s	nomove1
removelastblock
	move.b	-(a1),-(a2)
	cmp.l	a5,a1
	bne.s	removelastblock
nomove1	move.l	a2,a5

	move.l	(sp)+,a4

* Add uncrunch program

done	move.l	a4,a3
	move.l	a5,a2	attach crunched prog to end of table
moveprog
	move.b	(a2)+,(a3)+
	cmp.l	a2,a6
	bne.s	moveprog

	move.l	a3,d0
	sub.l	a4,d0
	move.l	d0,lengthofprog

	move.l	a4,d0
	lea	buffer(pc),a2
	sub.l	a2,d0
	move.l	d0,lengthoftable

	moveq	#0,d1
getlengthloop
	addq.l	#4,a2
	moveq	#0,d0
	move	(a2)+,d0
	bne.s	not02
	move.l	#65536,d0
not02	add.l	d0,d1
	cmp.l	a2,a4
	bne.s	getlengthloop
	move.l	d1,totallength

	lea	header(pc),a4
	sub.l	a4,a3
	move.l	a3,d0
	add.l	#1023,d0
	and.l	#$fffc00,d0
	add.l	#1023,d6
	and.l	#$fffc00,d6
	cmp.l	d0,d6
	ble	hopeless
	lea	-$1c(a3),a0
	move.l	a0,2(a4)
	sub.l	a0,d7
	move.l	d7,$a(a4)

	tst	delete
	beq.s	writefile
	move.l	sourcenameext(pc),a0
	move.b	#'.',-1(a0)
	move.b	#'C',(a0)+
	move.b	#'R',(a0)+
	move.b	#'N',(a0)+

writefile
	lea	writing(pc),a0
	bsr	print
	bsr	printfilename

	clr	-(sp)
	move.l	sourcenamepnt(pc),-(sp)
	move	#$3c,-(sp)
	trap	#1
	addq.l	#8,sp
	tst.l	d0
	bmi	fileerror

	move	d0,-(sp)
	pea	(a4)
	pea	(a3)
	move	d0,-(sp)
	move	#$40,-(sp)
	trap	#1
	lea	12(sp),sp
	tst.l	d0
	bmi	fileerror

	move	#$3e,-(sp)
	trap	#1
	addq.l	#4,sp
	tst.l	d0
	bmi	fileerror

exit	move.l	stack(pc),sp
	bra	return



* Error routines

outofmemory
	lea	outmem(pc),a0
	bsr.s	print
	move	#-39,error
	bra.s	exit

fileerror
	move	d0,error
	lea	generror(pc),a0
	bsr.s	print
	bra.s	exit

hopeless
	lea	nohope(pc),a0
	bsr.s	print
	bra.s	exit

print	pea	(a0)
	move	#9,-(sp)
	trap	#1
	addq.l	#6,sp
	rts

printfilename
	move.l	sourcenamepnt(pc),a5	Print file name
prnamlp	move.b	(a5)+,d0
	beq.s	donenameprint
	bsr	prchar
	bra.s	prnamlp
donenameprint
	moveq	#13,d0
	bsr	prchar
	moveq	#10,d0
	bra	prchar

find_target_file_ext
	lea	dta+30(pc),a0
lookext	move.b	(a0)+,d0
	beq.s	fndext
	cmp.b	#'.',d0
	bne.s	lookext

fndext	move.b	#'.',-1(a0)
	rts


* Various data

mainmess
	dc.b	27,'vProgram file cruncher V3.2',13,10,13,10
	dc.b	'Copyright 4/9/1988 By M.S.Powell',13,10,0
instructions
	dc.b	13,10,'Usage:',13,10,13,10
	dc.b	'crunch [h][d][u] <pathname> ',13,10,13,10
	dc.b	'h hold screen before exiting',13,10
	dc.b	'd disable deletion of original file',13,10
	dc.b	'u uncrunch files',13,10,0

nomatch	dc.b	13,10,'No files match pathname',13,10,0
reading	dc.b	13,10,'Reading ',0
writing	dc.b	'Writing ',0

crunched
	dc.b	'File already crunched',13,10,0
notprog
	dc.b	'Not a GEMDOS program file',13,10,0
notcrunched
	dc.b	'File not crunched',13,10,0
uncrunching
	dc.b	'Uncrunching...',13,10,0
crunching
	dc.b	'Crunching...',13,10,0

outmem	dc.b	'Out of memory',13,10,0
nohope	dc.b	'File uncrunchable',13,10,0
generror
	dc.b	'A file error has occured',13,10,0
pressany
	dc.b	13,10,'Press any key ',0
	even

stack	dc.l	0
error	dc.w	0
cmndlnokay
	dc.w	1

delete	dc.w	0
hold	dc.w	0
uncrunch
	dc.w	0
ignore	dc.w	0

sourcenamepnt
	dc.l	0
sourcenameend
	dc.l	0
sourcenameext
	dc.l	0

	even

dta	ds.b	44


* GEMDOS header

header	dc.w	$601a
	dc.l	0,0,0,0,0,0
	dc.w	$ffff

* Uncrunch routine

uncrunchprog
	clr.l	-(sp)
	move	#32,-(sp)
	trap	#1
	addq.l	#6,sp
	move.l	d0,-(sp)

	move	$8240.w,-(sp)

	lea	start(pc),a3
	move.l	lengthoftable(pc),a4
	add.l	a3,a4
	move.l	lengthofprog(pc),a5
	add.l	a4,a5

	move.l	totallength(pc),d0
	move.l	(a3),d1
	and.l	#$ffffff,d1
	lea	0(a4,d1.l),a0
	move.l	a0,a2
	lea	0(a5,d0.l),a1
	move.l	a1,a6
moveup	move.b	-(a5),-(a1)
	cmp.l	a5,a0
	bne.s	moveup
	move.l	a6,a5
	move.l	a1,a6

uncrunchloop
	move	d5,$8240.w
	add	#$89,d5
	and	#$777,d5
	or	#$333,d5
	move.l	(a3)+,d1
	move.l	d1,d2
	rol.l	#8,d2
	and.l	#$ffffff,d1
	moveq	#0,d3
	move	(a3)+,d3
	bne.s	not03
	move.l	#65536,d3
not03	add.l	d0,d1
	sub.l	d3,d0
	lea	0(a4,d1.l),a0
	cmp.l	a6,a0
	beq.s	nomove2
movebitdown
	move.b	(a6)+,(a2)+
	cmp.l	a6,a0
	bne.s	movebitdown
nomove2	subq	#1,d3
makeblock
	move.b	d2,(a2)+
	dbra	d3,makeblock
	tst.l	d0
	bne.s	uncrunchloop

* move relocate program to end of text

doneuncrunch
	move.l	a5,d0
	addq.l	#1,d0
	and	#$fffe,d0
	move.l	d0,a1
	move.l	d0,a2
	lea	relocate(pc),a0
	move	#start-relocate-1,d0
movereloc
	move.b	(a0)+,(a1)+
	dbra	d0,movereloc
	jmp	(a2)

relocate
	move	(sp)+,$8240.w
	move.l	8(sp),a0	a0=start of base page
	lea	$100(a0),a1	a1=start of text area
	move.l	a1,a2
	move.l	a0,(a0)+	base address of TPA
	move.l	$436.w,(a0)+	end of TPA+1
	move.l	a1,(a0)+	base address of text
	move.l	2(a4),(a0)+	length of text
	add.l	2(a4),a1
	move.l	a1,(a0)+	base address of data
	move.l	6(a4),(a0)+	length of data
	add.l	6(a4),a1
	move.l	a1,(a0)+	base address of bss
	move.l	$a(a4),(a0)+	length of bss
	move.l	a1,-(sp)
	move.l	$a(a4),-(sp)
	add.l	$e(a4),a1	a1=address of relocation data
	tst	$1a(a4)
	bpl.s	relocpres
	sub.l	a1,a1		a1=0 if no reloc. data
relocpres
	lea	$1c(a4),a4
	move.l	a2,a3		a3=start of text
	clr.b	(a5)
movetextdown
	move.l	(a4)+,(a2)+
	cmp.l	a5,a4
	blt.s	movetextdown
	moveq	#0,d7
	cmp.l	d7,a1
	beq.s	execute

* Relocate text

	move.l	a3,a6		a6=start of text

	move.l	a6,d0
	move.l	(a1)+,d1
	beq.s	execute
	add.l	d1,a6
	add.l	d0,(a6)
	moveq	#1,d2
	move.l	#$fe,d3
	moveq	#0,d1
reloclp	move.b	(a1)+,d1
	beq.s	execute
	cmp.b	d2,d1
	beq.s	disp
	add.l	d1,a6
	add.l	d0,(a6)
	bra.s	reloclp
disp	add.l	d3,a6
	bra.s	reloclp

execute	move.l	(sp)+,d5	d5=length of bss
	move.l	(sp)+,a4	a4=start of bss
	move	#32,-(sp)
	trap	#1
	addq.l	#6,sp

	lea	start_bss_clearer(pc),a0
	move.l	d5,d6
	add.l	a4,d6
	addq.l	#1,d6
	and	#$fffe,d6
	move.l	d6,a5
	move.l	a5,a6
	move.l	(a0)+,(a5)+
	move.l	(a0)+,(a5)+
	jmp	(a6)

start_bss_clearer
	move.b	d7,(a4)+
	cmp.l	a6,a4
	blt.s	start_bss_clearer
runit	jmp	(a3)
end

lengthoftable	dc.l	0
lengthofprog	dc.l	0
totallength	dc.l	0
start	
buffer
	


