koreth%panarthea.ebay@sun.com (Steven Grimm) (07/24/89)
Submitted-by: usqb015@liverpool.ac.uk (Mark Powell) Posting-number: Volume 2, Issue 63 Archive-name: crunch [Binary and docs are in comp.binaries.atari.st. -sg] * 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