	opt o+
*	opt a+		; pc relatif
	
esc=27
dos=1
bios=13
xbios=14
clavier=$fffffc02
palette=$ffff8240

save:	macro \1
	movem.l \1,-(sp)
	endm

load:	macro \1
	movem.l (sp)+,\1
	endm

appel:	macro	; short
	move.w #\2,-(sp)
	trap #\1
	add.w #\3,sp
	endm

wait:	macro
	appel dos,7,2
	endm

init:	macro
	move.l a7,a5
	move.l 4(a5),a5
	move.l $c(a5),d0
	add.l $14(a5),d0
	add.l $1c(a5),d0
	add.l #$250,d0
	move.l d0,d1
	add.l a5,d1
	and.l #-2,d1
	sub.l #16,d1
	move.l d1,a7
	move.l d0,-(sp)
	move.l a5,-(sp)
	clr.w -(sp)
	appel dos,$4a,12
	endm

supervisor:	macro
	clr.l -(sp)
	appel dos,$20,6
	endm
		***************************
 section TEXT
*	supervisor

sec_trk=10			; nb sec / trk
byte_sec=512		; nb octets / secteur
nb_trk=80			; de 1 a 82

device=0			; 1 pour B:

	lea $10.w,a1	; illegal error !
	move.l (a1),d1	; save old
	lea MC68000(pc),a0
	move.l a0,(a1)
	movec cacr,d0
	and #$fefe,d0
	movec d0,cacr	; inhibe caches PRG & DATA : Falcon ?
MC68000:	move.l d1,(a1)	; restore old (tant pis pour la pile)

	clr.b $ffff8260.w	; pour TT ( resolution : 0 )
	move.l $432.w,a6	; ad. load
	add.w #4*200,a6	; 200 mots longs
	lea ad_load(pc),a0
	move.l a6,(a0)	; pour apres
	move.l a6,a7	; pile

	bclr #0,$484.w	; clic_off

********* LE PROGRAMME PRINCIPAL

	bsr fade_out

	lea start_sec(pc),a0
	move.l #$00020000,(a0)+	; optimise move #2,(a0)+;move #0,(a0)+
			; ssec=2 strk=0 (9 secteurs)
	move #1,(a0)	; + 1 piste
	bsr.s lit_reloc_run

	lea start_sec(pc),a0
	move.l #$00010002,(a0)+	; optimise move #1,(a0)+;move #2,(a0)+
			; ssec=1 strk=2 (10 secteurs)
*	move #71,(a0)+	; long maxi:399360 octets disk(78 trks)
*	move #$1284,(a0)	; uncrypt
	move.l #$004b1284,(a0)+	; $0048 : normal version ; $004b : wax

	bsr.s lit_reloc_run	; on ne revient jamais

***** ROUTINE QUI LIT, RELOC, EXEC
long_tempo:	moveq #$20,d2
awaits:	dbf d2,awaits
short_tempo:rts

lit_reloc_run:

	move #$2700,sr
	lea $ffff8606.w,a6		; dma-mode
	lea $ffff8604.w,a5		; dma-data
	lea ad_load(pc),a0		; ruse
	move.b 3(a0),$ffff860d.w	; ad. chargement
	move.b 2(a0),$ffff860b.w
	move.b 1(a0),$ffff8609.w

	move start_sec(pc),d0		; secteur
	move start_trk(pc),d1		; piste

	move nb_piste(pc),d6		; +1 (1/2 piste pr‚c‚dente)
	addq #1,d6
	mulu #sec_trk,d6
	sub d0,d6			; +1-1 (dbf)

load_trks:	
****
read_sector:move #$90,(a6)		; read
	move #$190,(a6)

	move #$90,(a6)
	move #1,(a5)		; 1x512 octets

	move #$84,(a6)
	move d0,(a5)		; No. secteur

	bsr.s short_tempo

	move #$80,(a6)
	move #$80,(a5)		; read sector
				; motor on
	bsr.s long_tempo

fdc_ready:	btst #5,$fffffa01.w
	bne.s fdc_ready

	moveq #$18,d2		; RNF ou CRC error ?
	and.w (a5),d2
	bne.s read_sector

***	
	addq #1,d0
	cmp #sec_trk,d0		; 10 secteurs/ piste
	ble.s pas_fin_piste
	moveq #1,d0			; secteur 1
	addq #1,d1			; une piste de plus
****
change_piste:
	move #$86,(a6)		; ecrit No. piste
	move d1,(a5)

	bsr.s short_tempo

	move #$80,(a6)		; commande step
	move #$13,(a5)

	bsr long_tempo

fdc_ready2:	btst #5,$fffffa01.w
	bne.s fdc_ready2

	moveq #$10,d4		; RNF error ?
	and.w (a5),d4

	bne.s change_piste

****
pas_fin_piste:
	dbf d6,load_trks		; d6 = nb. secteurs … lire

	move #$2300,sr

***** Fin du chargement

	move uncrypt(pc),d0	; ruse pour voir le signe en (pc)
	beq.s fin

	bsr.s fade_out

** UNCRYPT
	move start_sec+4(pc),d0	; nb. pistes-1
	addq #1,d0		; on en avait d‚ja lu une
	mulu #sec_trk*byte_sec,d0
	move.l ad_load(pc),a0
	move.l a0,a1
	add.l d0,a1
decrypt:	eor.l #$31081992,(a0)+
	cmp.l a1,a0
	blt.s decrypt

***  ARRETE LE LECTEUR

*dmascnt=$ffff8604 (a5)
*dmamode=$ffff8606 (a6)		; Hardware-Register
srcmd=$80 	 		; S‚lection du Command-Register

	move.w #srcmd,(a6)	; S‚lection du Statusreg. 
test:	move.w #$50,d5
wt2:	dbf d5,wt2
	move.w (a5),d0	; Lire FDC-Reg. ou DMA-Sectorcount 
	btst #7,d0		; Motor-on positionn‚
	bne.s test

** FIN
fin:	move.l ad_load(pc),a0

	move.l 2(a0),d0	; TEXT
	add.l 6(a0),d0	; DATA
	
	move.l d0,d3	; longeur TEXT+DATA = ad rela debut BSS
	move.l 10(a0),d4	; LONGEUR BSS
	
*	add.l 14(a0),d0	; SYMBOLES
	add.w #$1c,a0	; bra.s
	
	move.l a0,d1	; ad debut a additionner
	move.l a0,a2	; ad. que l'on modifie
	add.l d0,a0		; debut table de reloc
	move.l (a0)+,d0
	beq.s fin_reloc
	add.l d0,a2
	
reloc1:	add.l d1,(a2)
sup_254:	moveq #0,d0
	move.b (a0)+,d0
	beq.s fin_reloc
	cmp.b #1,d0
	beq.s reloc2
	add.l d0,a2
	bra.s reloc1
reloc2:	add.w #254,a2
	bra.s sup_254

fin_reloc:	move.l d1,a0
	add.l d3,a0		; ad debut BSS
clear:	clr.b (a0)+
	subq.l #1,d4
	bne.s clear

	move.l ad_load(pc),a0
	jsr (a0)
	rts	

*** FADE-OUT
fade_out:	moveq #7-1,d7	; nb fades (7 -> 0)
next_fade:	moveq #16-1,d6	; nb teintes couleurs
	lea palette.w,a0
next_coul:	move #$0700,d0
	moveq #3-1,d5	; nb composantes : R V B
	moveq #8,d4		; nb decalages
next_compo:	and.w #%0000011101110111,(a0)	; pous STE
	move.w (a0),d1
	and d0,d1
	beq.s deja_nul
	lsr.w d4,d1
	subq #1,d1
	lsl.w d4,d1
	not d0
	and d0,(a0)		; efface compo
	not d0
	or d1,(a0)		; nouvelle
deja_nul:	lsr.w #4,d0		; d‚cale motif de travail
	subq #4,d4
	dbf d5,next_compo
	addq #2,a0
	dbf d6,next_coul

	moveq #3-1,d6
sync:	appel xbios,$25,2
	dbf d6,sync

	dbf d7,next_fade
	rts

****************************
ad_load:	dc.l 0
start_sec:	dc.w 0
start_trk:	dc.w 0
nb_piste:	dc.w 0
uncrypt:	dc.w 0
	dc.b 'G&W 3/93'
* section BSS
* even
*load:	ds.l 10000
 END