* Jim Power     launcher
* Compatible on all ST(E) because using
* TOS 1.04 GEMDOS part:   V.015

* Programmed entirely by P. Putnik

* AUTO run without reset of ST !
* running from hard drive
* Game exit to Desktop, pos saving
* 1MB RAM needed...


* Installing GEMDOS 0.15 in high RAM
* above it leave place for original TOS save
* some 150-180KB (with drivers)
* and fast init it (no floppy boot ...)
* later move hard disk driver to...

* Doing with GOS 5 ,

* Recommended assembler:   Devpac 3 .
* Optimisations off  .

* Launcher stage 1:  reserving TOP RAM - lovering memtop, phystop, screen base...

* Values for this game:
GameScrB       equ  $78000    *For games working with 512KB
AltRamPos    equ  $80000
MainInb        equ  $FFF40
SwapLen        equ  $7FCF8   * in fact save len

GameRest    equ   $7FD20

SysStor    equ    $FFF80     *Place for storing TOS system - 128 bytes

begin        *Beginning of program

    pea    hwdet(pc)
    move.w    #38,-(sp)
    trap    #14
    addq.l    #6,sp

    lea    machin(pc),a1
    cmp.b    #3,(a1)  *TT TOS vers.
    beq.s    fourMB   * At least so much must have Falc and TT
    cmp.b    #4,(a1)  *Falcon TOS vers.
    beq.s    fourMB

* Check Physical RAM

    move.b    7(a1),d1
    cmp.b    #1,d1  * Is only 512K ?
    beq.s    noENR
    bra.s    writPR

fourMB    moveq    #8,d1
writPR    move.b    d1,physRam   * Write it for later

* Low RAM usage check and exit if too much is used :

    cmp.b    #4,d1   * 2MB or more ?
    bcc.s    lowRamOK   * Skip it if 2MB RAM, as TOSsave will go
* to bigger space, over 1MB ...

    lea    hwpal(pc),a1
    cmp.l    #FreeMem-DeskCopy-48,a1  *Place available to store TOS
    bcs.s    lowRamOK
*    bra.s    lowRamOK

    lea    lowRamTM(pc),a0
toPMex    bsr    pmess

    move.w    #1,-(sp)
    trap    #1
    addq.l    #2,sp

    clr.w    -(sp)
    trap    #1    *Exit

noENR    lea    RAMne(pc),a0
    bra.s    toPMex

physRam         dc.w    0    *


    move.l      4(sp),a2   *basepage adr.
    lea    $77FF8,sp
    clr.l    (sp)
    move.l    a2,4(sp)

NewPhyst     equ  $80000    *For 512K games
    move.b    #1,machin+2    * 'Set' TOS RAM size to half MB
    move.l      a2,basep
    move.l    4(a2),d2   *memtop

    move.l    d2,memt
    move.l     #NewPhyst,d1
    sub.l    #$8000,d1   *This is new memtop
    move.l     d1,4(a2)     * Correct in basebage

* Conditional settings in subrutine following :
    pea     lowmsuv(pc)
    move.w     #38,-(sp)
    trap    #14
    addq.l    #6,sp

 * Now TOP RAM is reserved, TOS sees only 512KB of RAM !

* Launcher stage 2:  storing  stack pointers, MFP, screen

* Get current screen resolution:

    move.w    #4,-(sp)
    trap    #14
    addq.l    #2,sp
* Falcon patch:
    cmp.w    #3,d0   *Allow only  0-2 !
    bcs.s    store_res
    clr.w    d0

store_res     move.w    d0,DeskRes

    dc.w     $A00A       * Hide mouse
    clr.w     -(sp)   *set low res
    pea     GameScrB
    pea    GameScrB
     move.w    #5,-(sp)
    trap    #14
    lea    12(sp),sp

*   relative pos,   what

*     0    USP
*      4    Desktop screen resolution at prg start !
*    6    SSP
*    10    Palette, 32 bytes
*    42    MFP state, 24 bytes
*    66    ?

mfpof    equ  42

* Must run following in Supervisor mode

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

    lea    SysStor+10,a6   *palette store pos

* Save desktop palette:

    lea    $FFFF8240.w,a1
    moveq    #15,d1
.palc    move.w    (a1)+,(a6)+
    dbf    d1,.palc

* Saving MFP state.....

*    move.l    a6,a5   * keep address ..
* Save MFP registers :

    lea    $FFFFFA01.w,a1
    moveq    #23,d2   *24 registers, up to $FFFA2F
.mfpsl    move.b    (a1),(a6)+
    addq.l    #2,a1
    dbf    d2,.mfpsl

*Timer B and C needs accurate reading:
* Other 2 is off in TOS....

*So we read them some time and take
*Max value:

   * To speed it up we can test both in same time !

    lea    $FFFFFA21.w,a1
    lea    $FFFFFA23.w,a2
    move.w    #3777,d7   *Determines time for read
    clr.b    d2
    clr.b    d4

retimbl    move.b    (a1),d1
    cmp.b    d1,d2
    bcc.s    renotbb

rebiggerb    move.b    d1,d2
renotbb    move.b    (a2),d3
    cmp.b    d3,d4
    bcc.s    renotbc

rebiggerc    move.b    d3,d4
renotbc    dbf    d7,retimbl

    move.b    d2,-8(a6)      * Timer B Data reg
    move.b    d4,-7(a6)      * Timer C Data reg.

* TOS values are normally:  Timer B: $41 (PAL mode), Timer C:  $C0 

* Launcher stage 3:   storing TOS, desktop, this prg active part in
* upper RAM for later restore

* it looks that best is that we do HW test and pic show at this point !!

    bsr    clearkb
    move.l    #GameScrB,screnb   *screen pos. for pic show
    pea    hwpal(pc)
    move.w #6,-(sp)
    trap  #14
    addq.l    #6,sp
    move.w  #37,-(sp)
    trap  #14
    addq.l  #2,sp

tomap    bsr    machipr    *HW detect.
    lea    cheatt(pc),a0
    bsr    pmess

*Little pause to see it:
    move.w    #1177,d7

dell1    move.w  #37,-(sp)
    trap  #14
    addq.l  #2,sp

* Allow abort with keypress:
    pea    $600ff
    trap    #1
    addq.l    #4,sp
    tst.b    d0
    beq.s    wait_k
    cmp.b    #"M",d0
    beq    megastes
    cmp.b    #"m",d0
    beq    megastes

    cmp.b    #"1",d0
    beq.s    set_inf1
    cmp.b    #"2",d0
    beq.s    set_inf2
    cmp.b    #"3",d0
    beq.s    set_inf3
    cmp.b    #"4",d0
    beq.s    set_inf4

    cmp.b    #" ",d0    
    beq.s    toPicsh

wait_k    dbf    d7,dell1
    bra.s    toPicsh

set_inf1    clr.w    cheats
    bra    show_hw
set_inf2    clr.w    cheats+2
    bra    show_hw

set_inf3    clr.w    cheats+4
    bra    show_hw

set_inf4    clr.w    cheats+6
    bra    show_hw

    cmp.b   #3,machin
    beq.s    loadg     * Skip picshow on TT
    cmp.b   #4,machin
    bne.s    steph   *to ST(E) show

* Falcon Pic show:

    jsr    falcpic
    bra.s      loadg

steph         jsr    photoc    *Call Photochrome pic show rut., on (M)ST(E)

*gimme my blue letters :-)  :
    pea    hwpal(pc)
    move.w #6,-(sp)
    trap  #14
    addq.l    #6,sp

*now set stack pointers in picshow area
    lea    hwpal(pc),sp
    lea    -200(sp),a1
    move.l    a1,usp

    lea    SysStor,a6   
    move.l    a1,(a6)+     *Store USP
    move.w    DeskRes(pc),(a6)+

    move.l    sp,(a6)   *SSP

* Header build support #2 :

    lea    MainInb,a2
    lea    64(a2),a1

    move.l    #SwapLen,(a2)+    *hp 8
    move.l    #FreeMem,(a2)+     *hp 12
    move.l    #SysStor,(a2)+       *hp 16
    move.l    #GameRest,(a2)+   *hp 20
*    move.l    #GameStat,(a2)+    *hp 24
    move.l    #$45DE+GameStat-ramdc2,(a2)+    *hp 24
    move.l    #$45DE+backingam-ramdc2,(a2)+

    move.w    #$C3C2,(a2)+   *Keys     *hp 32
stedma    move.w    #$1400,(a2)+   * Force joystick mode  + DMA if  *hp  34
    clr.l    (a2)+   *Forced Timer regs    *hp  36
    clr.l    (a2)+             *hp 40
    move.w    #5,(a2)+     *Flag for GOS5 at $C0100, hp 44

clr_maininb    clr.w    (a2)+
    cmp.l    a2,a1
    bne.s    clr_maininb   *Clear rest for future good


* Now  set  0.15R  v5  to loc  $C0100  :
* it means that GOS self goes to $C0800
* at $C0100 are rutines, GOS basepage is at $C0700
* so, for rutines is ~1500 bytes available

* Usually  need new SP to avoid overlap
    lea    $7FFF8,sp

* Yet to add load from common DIR C:\GAMEX ...

* Load  it
    clr.w    -(a7)
    lea    d15n(pc),a1
    tst.b    falcfl
    beq.s    pushnam
    lea    d15fn(pc),a1
pushnam    pea    (a1)
    move.w    #$3D,-(a7)
    trap    #1
    addq.l    #8,a7
    move.w    d0,d7
    bmi    exitu

d15loc    equ    $C0800
d15srl    equ    $C0100  * subrutines here
*    pea    d15loc-28   *28 bytes lover due header
    pea    head
    pea    51000    *len ++
    move.w    d7,-(a7)
    move.w    #$3F,-(a7)
    trap    #1
    lea    12(sp),sp

    move.w    d7,-(a7)
    move.w    #$3E,-(a7)
    trap    #1
    addq.l    #4,a7

* Packed is

    lea    d15srl,a4   * header off
    lea    head+32,a1
    bsr    depak3

* No relocation here

* Saving  area from adr 8 to  hwpal  in  high RAM

DeskCopy    equ    $D7008   * about 158KB  available
* what must be enough for TOS 2.06 with hard ddriver, buffers
* best to run with TOS ext, with minimalized hard disk driver buffer

      lea    8.w,a5
    lea    DeskCopy,a6   * We have enough place...

    cmp.b    #4,physRam
    bcs.s    only1M
    lea    $102008,a6

only1M    move.l    a6,swapDpos+2   * Write for TOS restorer

    lea    hwpal(pc),a1
    move.l    a1,d0
    divu    #48,d0     *get loop count
    move.w    d0,swapln+2    *Set same len for TOS restore *swap part

.cod    movem.l      (a5)+,d1-d7/a0-a4   *48 bytes at once
     movem.l    d1-d7/a0-a4,(a6)    
    lea    48(a6),a6
    dbf    d0,.cod    
* Little overshot, no problems...

*  Stage 4:  preparing setting Exit to Desktop in stored mem.  :

* We need only  regular exit TOS call at certain point...
* Copy code in free area $FFD00 - $FFFFF

FreeMem    equ    $FFD20       *For 512KB games, 1MB total RAM

    lea    GamexCtrl(pc),a1
    lea    FreeMem,a2
    move.w    #127,d2      *There is 768 bytes place !
* But top is reserved for storing state, palette etc....
* so copying only 512 bytes ....

.cou    move.l    (a1)+,(a2)+
    dbf    d2,.cou

* Parameters must be set by GOS installer before running it !
* Using  space in virtual basepage of  GemDOS (GOS in RAM)
* for transferring parameters

* offsets to begin of GOS - here at $C0800

ppDrivO     equ    -$D0   * Negative values, so use with plus
* if Devpac will like it !

curDrivO    equ    -$CC   * 4 bytes higher
jumpAdrO  equ    -$CA   * 2 bytes higher

* reserve some bytes here : from -$C6 to -$AE
pexecFileO equ    -$AE   * 14 bytes for it
curPathO       equ    -$A0   * enough space for long paths !
* in case of PP driver 160-32 bytes = 128 !


* Get cur drive:

    move.w    #25,-(sp)
    trap    #1
    addq.l    #2,sp
    move.w    d0,d15loc+curDrivO

* Cur path:

    clr.w    -(sp)
    pea    d15loc+curPathO
    move.w    #71,-(sp)
    trap    #1
    addq.l    #8,sp

* Special settings if PP hd driver present :

    * Move driver up :
    clr.l    d15loc+ppDrivO   *preclear flag

    move.l    $472.w,a1
    cmp.l    #"PPHD",-8(a1)   * See XBRA sign
    bne    must_inshdd

    lea    -12(a1),a1   * XBRA here

*    lea    d15loc+$38,a5   * here are vectors of installed GOS
* Changed - read vectors self from alt GOS sysvar area :

    lea    gosOld(pc),a5   * here put 3 vectors
    move.l    a5,d5   * save addres for later

*  Correct old vectors in XBRAs and in driver core too !

* while doing it save from XBRAs :
    lea    forOldv(pc),a3   * here will go 3 longs

    lea    $B7180,a2
    move.w    #1800,d2   *for some 6KB
.mod    move.l    (a1)+,(a2)+
    dbf    d2,.mod

* Create param list for GOS :
* Instead, write directly in sysvar/vector area :

* Get area address using header :

    move.l    d15loc-26,a6   * code len
    add.l    #$C0800,a6  * at GOS workspace, newz

    lea    $B7180+12,a4
    move.l    $472(a6),(a5)  * Save old GOS vect for further write.
    move.l    a4,$472(a6)
* Correct XBRA, but first save old one :
    move.l    -4(a4),(a3)+
    move.l    (a5)+,-4(a4)   * Put there GOS-es
    move.l    $472.w,d1
    move.l    $476.w,d2
    sub.l    d1,d2
    add.l    d2,a4
    move.l    $476(a6),(a5)
    move.l    a4,$476(a6)
* Correct XBRA :
    move.l    -4(a4),(a3)+
    move.l    (a5)+,-4(a4)
    move.l    $476.w,d1
    move.l    $47E.w,d2
    sub.l    d1,d2
    add.l    d2,a4
    move.l    $47E(a6),(a5)
    move.l    a4,$47E(a6)
* Correct XBRA :
    move.l    -4(a4),(a3)
    move.l    (a5),-4(a4)

* To correct in driver core need to find old vectors
    lea    $B7180,a2   * Base to seek
    lea    $1500(a2),a1   * end loc, for some 6KB

    lea    -8(a3),a3
    bra.s    seekOldl

nomat1    addq.l    #2,a2
    bra.s    seekent

nomat2    subq.l    #2,a2
    subq.l    #4,a3
    bra.s    seekent

nomat3    subq.l    #6,a2
    subq.l    #8,a3

seekent    cmp.l    a2,a1
    bcs    setDrvbits

    move.l    (a2),d2
    cmp.l    (a3),d2
    bne.s    nomat1
    addq.l    #4,a2
    addq.l    #4,a3
    move.l    (a2),d2
    cmp.l    (a3),d2
    bne.s    nomat2
    addq.l    #4,a2
    addq.l    #4,a3
    move.l    (a2),d2
    cmp.l    (a3),d2
    bne.s    nomat3

* 3 successive match - it is it
    subq.l    #8,a2
    move.l    d5,a5
    move.l    (a5)+,(a2)+
    move.l    (a5)+,(a2)+
    move.l    (a5),(a2)

    move.l    $4C2.w,$4C2(a6)   *drvbits

* Set and init Buffer Control Blocks :
    move.l    $47E.w,d1
    move.l    $4B2.w,d2
    sub.l    d1,d2
    add.l    d2,a4
    move.l    a4,$4B2(a6)     *BCB #1

    lea          $AF100,a2   * Buffers here
    move.l    #$FFFF0000,d3

    move.l    a4,a0
    lea     20(a0),a1
    move.l      a1,(a0)+
    move.l      d3,(a0)+
    clr.l    (a0)+
    clr.l    (a0)+
    move.l      a2,(a0)
    lea           8192(a2),a2
    clr.l    (a1)+
    move.l      d3,(a1)+
    clr.l    (a1)+
    clr.l    (a1)+
    move.l      a2,(a1)
    lea           8192(a2),a2

    move.l    $4B2.w,d1
    move.l    $4B6.w,d2
    sub.l    d1,d2
    add.l    d2,a4
    move.l    a4,$4B6(a6)     *BCB #2

    move.l    a4,a0
    lea     20(a0),a1
    move.l      a1,(a0)+
    move.l      d3,(a0)+
    clr.l    (a0)+
    clr.l    (a0)+
    move.l      a2,(a0)
    lea           8192(a2),a2
    clr.l    (a1)+
    move.l      d3,(a1)+
    clr.l    (a1)+
    clr.l    (a1)+
    move.l      a2,(a1)
    bra    toGosS
* There will need to copy vectors, sysvars to place as
* no GOS init will be done !

forOldv    ds.l    3   * Place for 3 vectors

gosOld    ds.l    3



* Here new system for Hddriver, AHDI - good for ACSI, IDE and SCSI !

* Setting Hddriver to loc , with buffers of course ...

    cmp.b    #2,machin
    bcc.s    itsTos24

* Case of TOS 1.0x :

    bsr    oldTOSboo   * Boot ACSI and IDE ...

    tst.w    d7
    bmi    exitu

    move.w    #$1ABD,d3   * Flag that no DMAr in XBIOS
    bra    notF2

* Get current driver type by PUN :

    move.l    $516.w,a1
    clr.l    d7
    move.b    4(a1),d7    * Drive type - for part C, and all in regular case

* Only for Falcon, TT, TOS 2.06 :

    move.w    d7,-(sp)
    pea    stbitm   * buffer for
    move.w    #1,-(sp)
    clr.l    -(sp)   * Bootsector we want
    move.w    #$2A,-(sp)
    trap    #14
    lea    14(sp),sp
    tst.w    d0
    bne    exitu

* Test checksum :
    bsr    ches1234
    cmp.w    #$1234,d0
    bne    exitu

    move.l    #$444D4172,d3   * DMAr - flag for supported

* Now execute it :

* First change Trap #1 :

* Correct for Falc if is :

    tst.b    falcfl
    beq.s    notF2
    move.w    #8,stafr1+2
    move.l    #69300,a2   * Free RAM reported
    lea    $AF100,a1    * Basepage for driver

    cmp.b    #4,physRam
    bcs.s    setmyTr1
    move.l    #129300,a2   * Free RAM reported
    lea    $186000,a1    * Basepage for driver
* Must be same as in GXUTIL !!!!! otherwise crash with AHDI !

    move.l    a2,give3hk+2
    move.l    a1,mytr1Hl1+2
    move.l    a1,mytr1Hl2+2

* Need different params for Falcon, lot of RAM !!!!
* But so far it is good , I guess

    move.l    $84.w,orgTr1+2
    move.l    #myTr1,$84.w

    move.l    #$3,$4C2.w   * Set only floppies

* Fill with GOS values, of course !  :

* New variant - pick values from sysvar area directly
* as we have it up, ready !

    move.l    d15loc-26,a6   * code len
    add.l    #$C0800,a6  * at GOS workspace, newz

    move.l    $472(a6),$472.w
    move.l    $476(a6),$476.w
    move.l    $47E(a6),$47E.w   * 3 HD vectors
*    move.l    $4C2(a6),$4C2.w   * no sense, it's 0
    move.l    $4B2(a6),$4B2.w
    move.l    $4B6(a6),$4B6.w  * BCBs - must !
    move.l    $516(a6),$516.w   * PUN is not set in GOS
*    move.l    $4C6(a6),$4C6.w  * Diskbuf, for case
    move.l    $5A0(a6),$5A0.w  * Cookie pointer
* in GOS52 (G52) is proper set of cookies for Falcon : _CPU, _MCH, _IDT
* it is a must for correct work with Hddriver !

    move.w    d7,d4
    asl.w    #5,d7  * for what ?
    move.w    #$80,d5
    jsr    (a0)    * Install Hddriver or AHDI in Highness  :-)

* Little pause,  to see what those drivers show on screen :-)
    moveq    #28,d7
paull    move.w  #37,-(sp)
    trap  #14
    addq.l  #2,sp
    dbf    d7,paull

* Buffer Control Blocks may be screwed, need to set  ???
* Try without fixing it .....

* Driver installed,  pick BCB addresses from vars !

* Now put variables on place  :  

    move.l    d15loc-26,a6   * code len
    add.l    #$C0800,a6  * at GOS workspace, newz

    move.l    $472.w,$472(a6)
    move.l    $476.w,$476(a6)
    move.l    $47E.w,$47E(a6)
    move.l    $4C2.w,$4C2(a6)
    move.l    $4B2.w,$4B2(a6)
    move.l    $4B6.w,$4B6(a6)
    move.l    $516.w,$516(a6)   * PUN, must
* it must be in driver self
*    move.l    $4C6.w,$4C6(a6)  * Diskbuf, for case

    move.l    $5A0.w,$5A0(a6)  * Cookie pointer
* a must - Hddriver will not work without !

* Now  may run game :

    lea    sta2(pc),a1
    lea    $60000,a2
    move.w    #1151,d2
co1l    move.l    (a1)+,(a2)+
    dbf    d2,co1l

    lea    ramdc2(pc),a1
    lea    $80100,a2
    move.w    #154,d2
co1l2    move.l    (a1)+,(a2)+
    dbf    d2,co1l2

    lea    cheats(pc),a1
    lea    $2C4.w,a2
    move.l    (a1)+,(a2)+
    move.l    (a1)+,(a2)+   * Copy 8 bytes

* Must move up:
    lea     $77700,a4  
    move.l    a4,a3 *save adr.
    lea       coup(pc),a1
    move.w    #276,d2 *whole mc len/4-1
mouc    move.l    (a1)+,(a4)+
      dbf     d2,mouc  
      jmp (a3)

cheats   dc.w  255,255,255,255    * 0 means cheat !


* Copy TOS MFP values in file I/O handler :
    lea    SysStor+42,a1    
    lea    $C0100,a0
    moveq    #0,d0
    move.w    6(a0),d0
    add.l    d0,a0

    jsr    (a0)

rungame    *

    lea    $400,a7
    move.w    #$2700,sr

* Write needed changes, patches :

    lea    ramdc(pc),a1
    lea    $603B6,a2
    moveq    #44,d2
co2l    move.l    (a1)+,(a2)+
    dbf    d2,co2l

    lea    $6030E,a1
    move.w    #$4EF9,(a1)+
    move.l    #$603B6,(a1)

    lea    $60030,a1
    move.w    #$4EF9,(a1)+
    move.l    #$80100+ramd2act-ramdc2,(a1)

* Gamex key compare link : - later

*    lea    $63E.w,a1
*    move.w    #$4EF9,(a1)+
*    move.l    #$3F404+gamex-ramdc,(a1)

    JMP    $60000   * Start game

machin    dc.b  0,0,0,0,0,0,0,0,0,0   *TOS V Major, TOS v minor, RAM size, HW
    * MSTE clock at start,  MSTE clock set,  Lang code, Real RAM size
exitu     clr.w -(sp)
    trap #1


gxf           dc.w   $0100
falcfl    dc.w    0

    * ingame file I/O intermed. code

* using GOS5  

* Need only to serve parameters and call code below GOS :
* But in first call must set path :

* Flag for path set required is :  drive not = 0 (A)
* it is already set above, so need only to clear it after
* first load !

* parameters:  filename - pointer at gemd+pexecFileO
*          offset from filebegin (for fseek) - value at gemd+jumpAdrO
*          bytes to load - value at gemd+jumpAdrO+4
*          where to load - value at gemd+jumpAdrO+8

gemd    equ    $C0800

* input  a0-block address

* offset 0 - start sector, w
* offset 2 - count, w
* offset 4 - address , l

    clr.l    d0
    move.w    (a6)+,d0
    lsl.l    #6,d0
    lsl.l    #3,d0
    move.l    d0,gemd+jumpAdrO   * offset

    clr.l    d0
    move.w    (a6)+,d0
    lsl.l    #6,d0
    lsl.l    #3,d0    
    move.l    d0,gemd+jumpAdrO+4   *  size

    move.l    (a6)+,gemd+jumpAdrO+8    * where

* DIR is already set (or about to set) , so need only filename :

* PC relative !  :

* Better copy name there, as space is ready !
    lea    fnam(pc),a0
    lea    gemd+pexecFileO,a1
    move.l    (a0)+,(a1)+
* SP at wrong area, need to change before call !  :

    lea    gspsto(pc),a1
    move.l    sp,(a1)
    lea    $C0000,sp

* Get rutine address:

    lea    $C0100,a0
    moveq    #0,d0
    move.w    4(a0),d0
    add.l    d0,a0

    jsr    (a0)

    move.l    gspsto(pc),sp

    clr.w    d15loc+curDrivO   * Flag that no path set more needed
    jmp    $603A6   * Back to game

*    clr.l    d0
*    rts

fnam    dc.b "JPT",0

gspsto    dc.l    0

    nop       * spacer

ramdc2    * For both floppies , joined !!!
    clr.l    d0
    move.w    (a6)+,d0
    lsl.l    #6,d0
    lsl.l    #3,d0
    move.l    d0,gemd+jumpAdrO   * offset

    clr.l    d0
    move.w    (a6)+,d0
    lsl.l    #6,d0
    lsl.l    #3,d0    
    move.l    d0,gemd+jumpAdrO+4   *  size

    move.l    (a6)+,gemd+jumpAdrO+8    * where

* DIR is already set (or about to set) , so need only filename :

* PC relative !  :

* Better copy name there, as space is ready !
    lea    fnam2(pc),a0
    lea    gemd+pexecFileO,a1
    move.l    (a0)+,(a1)+
* SP at wrong area, need to change before call !  :

    lea    gspsto2(pc),a1
    move.l    sp,(a1)
    lea    $C0000,sp

* Get rutine address:

    lea    $C0100,a0
    moveq    #0,d0
    move.w    4(a0),d0
    add.l    d0,a0

    jsr    (a0)

    move.l    gspsto2(pc),sp

    clr.w    d15loc+curDrivO   * Flag that no path set more needed
* Doing depacking :

    move.l    -4(a6),a0
    jsr    $48AA.w


    clr.w    $532A.w
    clr.b    $5329.w
    clr.b    $5326.w
     movem.l    (sp)+,d0-d7/a0-a6


fnam2    dc.b "JPT",0

gspsto2    dc.l    0

    nop       * spacer

ramd2act    * Ramdisk 2 activator :

    move.w    #$2700,sr
    lea    ramdc2(pc),a1
    lea    $45DE.w,a2
    move.w    #150,d1
.rda    move.l    (a1)+,(a2)+
    dbf    d1,.rda

* Gamex keydet. activating :

    lea    $4B86.w,a1
    move.w    #$4EF9,(a1)+
*    lea    gamex(pc),a2
*    move.l    a2,(a1)
    move.l    #$45DE+gamex-ramdc2,(a1)

    jmp    $400.w

*Game exit code:  *

    cmp.b   #$C3,d0   * For F9,
    beq.s    gamex_w

gamnoex         bclr   #0,$5328.w
    jmp    $4B8C.w


gamex_w   *Exiting game with storing state

* Code for game state store when exit is requested:

GameSto    * The code itself. Must be PC relative !!!

* Presumable we are in supervisor mode....
* For games not running in SV need some switch, workaround...
* will see later....

*     0    USP
*      4    Cur screen resolution - almost always 0 !
*    6    SSP
*    10    Palette, 32 bytes
*    42    MFP state, 24 bytes
*    66    Screen base
*    70    IKBD joy status, 8 bytes
*    80    SR,  2 bytes
*     84    PSG status, 14 bytes
*    100    IKBD mouse status, 8 bytes
*    108    STE DMA , 8 bytes

ikbdof      equ    70
ikbdm_of    equ      100
srofs      equ    80
psgofs       equ    84
stedmaof    equ      108    

* Store CPU regs, SR, stack pointers
    movem.l    d0-d7/a0-a6,-(sp)
    lea    GameStat(pc),a6
    move.w    sr,80(a6)

    move.l    usp,a1
    move.l    a1,(a6)+     *Store USP
    move.b    $FFFF8260.w,d1
    and.w    #$3,d1
    move.w    d1,(a6)+   * Res. Usually 0

    move.l    sp,(a6)+  *SSP


* Saving PSG state:
    lea    $FFFF8800.w,a1
    lea    GameStat+psgofs(pc),a2
    moveq    #0,d2
.psgl    move.b    d2,(a1)
    move.b    (a1),(a2)+
    addq.b    #1,d2
    cmp.b    #14,d2
    bne.s    .psgl

* Save palette:

    lea    $FFFF8240.w,a1
    moveq    #15,d1
.palc    move.w    (a1)+,(a6)+
    dbf    d1,.palc

* Saving MFP state.....

* Save MFP registers :

    lea    $FFFFFA01.w,a1
    moveq    #23,d2   *24 registers, up to $FFFA2F
.mfpsl    move.b    (a1),(a6)+
    addq.l    #2,a1
    dbf    d2,.mfpsl

*Timer A, C and D need accurate reading:
* we presume that timer B is intact (for now)

*So we read them some time and take
*Max value:

   * To speed it up we can test all 3 in same time !

    lea    $FFFFFA1F.w,a1   *Timer A data
    lea    $FFFFFA23.w,a2   *Timer C data
    lea    $FFFFFA25.w,a3   *Timer D data

    move.w    #6777,d7   *Determines time for read
    clr.b    d2
    clr.b    d4
    clr.b    d6

gatimbl    move.b    (a1),d1
    cmp.b    d1,d2
    bcc.s    ganotba
    move.b    d1,d2

ganotba    move.b    (a2),d3
    cmp.b    d3,d4
    bcc.s    ganotbc
    move.b    d3,d4

ganotbc    move.b    (a3),d5
    cmp.b    d5,d6
    bcc.s    ganotbd
    move.b    d5,d6

    dbf    d7,gatimbl

    move.b    d2,-9(a6)      * Timer A Data reg
    move.b    d4,-7(a6)      * Timer C Data reg.
    move.b    d6,-6(a6)    * Timer D Data reg.

* Screen Base:
    move.b    $FFFF8201.w,(a6)+   * High byte
    move.b    $FFFF8203.w,(a6)+   * Mid byte

*  IKBD status  will store  after  setting  TOS workable - in restoring it....

* so, may  jump to  TOS restore:

    jmp    FreeMem

unlf    dc.w   0



depak3    clr.l d0
    moveq    #6,d4
    moveq    #$3f,d5   *for masking bits 5-0

* Bit meaning:  7 - if set it's back referrer , if 0 then bits
* 6-0 give count of literals to copy
* if all bits are 0 it is terminator

* When bit 7 set, bit 6: if 1 then long distance back given by 2 following byte
*  bit 6: when 0  then short distance given by following 1 byte
*  bits 5-0  count of bytes referred.
*  By short refer.  0 means 3, 1 means 4, etc  up to 66 .
*  By long refer.  0 means 4, 1 means 5, etc  up to 67 .

main3     clr.w d0 *prep for dbf
    move.b (a1)+,d0
    bmi.s back3
    beq.s nom3 *end
    subq.w #1,d0 *compens dbf
litc     move.b (a1)+,(a4)+
    dbf d0,litc
    bra.s main3

nom3    rts

back3    move.b d0,d2
    and.w d5,d2 *d5=$3f
* Test is long or short referrer:
    btst    d4,d0   *test bit 6
    bne.s  longr
    addq.w #2,d2 *compens    
displl    move.b (a1)+,d0 * displac
calcadr    move.l a4,a2
    sub.l d0,a2
baksl    move.b (a2)+,(a4)+
    dbf d2,baksl
    bra.s main3

longr    addq.w #3,d2 *compens
    move.b (a1)+,d0 * displac
    lsl.w  #8,d0   *MSB
    bra.s   displl

* End of C3 depak


myTr1      *special for booting, installing hard driver above phystop

    * no need to care about calling from user mode

* function # is at sp+8  by  68030

stafr1    lea    6(sp),a0
* or 8 by Falcon !!! above !

    cmp.w    #72,(a0)    * Is Malloc ?
    beq.s    myMalloc
    cmp.w    #74,(a0)    * Is Mshrink ?
    beq.s    myMshrnk
orgTr1    jmp    $FC92D8   ****to regular Trap #1, will be set !

myMalloc    * if free amount asked, give back ~69300
    cmp.l    #$FFFFFFFF,2(a0)
    beq.s    give3hk
* Likely no need to check amount asked ....
mytr1Hl1    move.l    #$AF100,d0   * Free area

give3hk    move.l    #69300,d0

mytr1Hl2    cmp.l    #$AF100,4(a0)   * my mem block ?
    bne.s    msh_err
    clr.l    d0

msh_err    moveq    #-40,d0

****** End of myTrap #1

     lea    stbitm,a0
     move.l   a0,a1
     clr.l        d0
     move.w    #255,d1
chstl     add.w    (a1)+,d0
      dbf     d1,chstl

*  Subrutines for ACSI and IDE bootsector load
* in case of older TOS version :


* First ACSI :
    moveq    #0,d6  * Start with target #0 
AcsiBooS      lea          stbitm,a1
    moveq     #0,d1
    moveq     #1,d2
    bsr          dmaread
    tst.w        d0
    beq.s    AcsiChs
    add.b    #$20,d6
    bne.s    AcsiBooS

    bra    tryIDE

AcsiChs    bsr.s    ches1234
    cmp.w    #$1234,d0
    bne    tryIDE

    moveq    #0,d7   * Code for ACSI boot done

flock equ $43e
gpip equ $fffffa01
drivbits equ $4c2
diskbuf equ $4c6

cac   equ $ffff8604  *Control Access Register
scr   equ cac
dmamode   equ $ffff8606
dmahigh   equ $ffff8609
dmamid   equ $ffff860b
dmalow   equ $ffff860d
hz200   equ $4bc  *word

dmaread   *d6 - target # 0-7, but bits 5-7!!! step $20 !
*a1 - dest address for read
*d1 - start sector number
*d2 - sector count

    lea dmamode.w,a6
    lea cac.w,a5
    st flock.w
    pea (a1)
    move.b 3(sp),dmalow.w
    move.b 2(sp),dmamid.w
    move.b 1(sp),dmahigh.w
    addq.l #4,sp

*  move.w #$0098,(a6)
    move.w #$0198,(a6)
    move.w #$0098,(a6)

    move.w d2,(a5)  * Sector counter register

    move.w #$0088,(a6)

    move.b #8,d0   *Read command
    or.b   d6,d0   *
    swap   d0
    move.w #$008a,d0  *single byte access

    bsr wcbyte
    bne dma_err

    move.l d1,d0  *High block #
    move.w #$008a,d0
    bsr wcbyte
    bne dma_err
    move.l d1,d0  *Mid block
    lsr.w #8,d0
    swap d0
    move.w #$008a,d0
    bsr wcbyte
    bne dma_err  
    move.l d1,d0  *Low block #
    swap d0
    move.w #$008a,d0
    bsr wcbyte
    bne dma_err

    move.l d2,d0  *Block count low
*   and.w #$00FF,d0
    swap d0
    move.w #$008a,d0
    bsr wcbyte
    bne.s dma_err

    move.l #$0000000a,(a5)  *DMA on

    move.w #400,d4
    bsr wwait
    bne.s dma_err

    move.w #$008a,(a6)
    move.w (a5),d0
    and.w #$00ff,d0

    bne dma_err

    bra.s dma_ok  *noerr

wcbyte     move.l d0,(a5)
    moveq #10,d4

wwait     add.w hz200.w,d4
ww_1    btst.b #5,gpip
    beq.s  w_end
    cmp.w  hz200.w,d4
    bne.s  ww_1
    moveq #-1,d4
w_end    rts

dma_err   moveq #-1,d0
    move.w #$0080,(a6)
    tst.b d0
    sf flock.w

dma_ok     move.w #$0080,(a6)
    clr.l d0   
    tst.b d0
    sf flock.w

tryIDE    * IDE boot

*IDE port Adress area: $f00000-$f0003d

datar equ $fff00000
param equ $fff00005
seccn equ $fff00009
stars equ $fff0000d
zylow equ $fff00011
zyhig equ $fff00015
headn equ $fff00019
comst equ $fff0001d

stat2 equ $fff00039
akadr equ $fff0003d

h200l equ $4ba  *200Hz counter long

*Check is IDE port present:
ideppres    movea.l    8.w,a0
    movea.l    a7,a1
    move.l    #berrh,8.w
    tst.b    stat2

*here continues if IDE port present:
    movea.l    a1,a7
    move.l    a0,8.w

*Load bootsector with some time-out...

* Detect is regular drive present, ready :

    move.b #$00,headn  *master
    clr.b stat2  *IRQ mode set...

  *Timeout about 1 sec
    move.l #200,d3
    add.l h200l.w,d3

tim1     move.b comst,d0
    and.b #$C9,d0
    cmp.b #$40,d0
    beq.s idere1

    cmp.l h200l.w,d3
    bne.s tim1

ideexit     *timeout or no IDE port or error or not exec.
    move.w    #-33,d7   * Return negative

     lea    comst,a3
     bsr     loadboo
     tst.b    gpip.w
     tst.b    d0
     bne.s    ideexit

*Checksum test:

    bsr    ches1234
    cmp.w    #$1234,d0
    bne.s    ideexit
    moveq    #$10,d7   * IDE master code

berrh    movea.l    a1,a7
    move.l    a0,8.w
    bra    ideexit
*It is bus error sit.- no IDE port in machine

    move.b  #1,-16(a3)  *Start sector,  CHS mode
    clr.b -12(a3)   *zylow
    clr.b  -8(a3)       *zyhig
    move.b #1,-20(a3)        *seccn
    lea    datar,a1
    lea    stbitm,a0

    move.b     #$20,(a3)  *read command  

wrdy    move.w    #400,d3  *about 2 sec time-out
    add.w     hz200.w,d3
    cmp.w     hz200.w,d3
    beq.s      timo

    btst     #3,(a3)  *data request active ?
    beq.s     wrdyr1

* Read sector
    moveq     #63,d2
readl    move.w     (a1),(a0)+  
    move.w     (a1),(a0)+  
    move.w     (a1),(a0)+
    move.w     (a1),(a0)+ *8 bytes in one loop part
    dbf    d2,readl

    move.b     (a3),d0  *error test
    btst     #0,d0
    beq.s    IdebOK
timo    moveq     #3,d0  *just reset Z flag

IdebOK    moveq    #0,d0


d15n     dc.b  "D15R_H5.FIC",0
d15fn    dc.b  "D15R_F5.FIC",0

lowmsuv     *Supervisor mode needed for set some sysvars...
    move.l    $42E.w,d5   *Old Phystop
    move.l    #NewPhyst,$42E.w
* See is Memtop sysvar $8000 bytes below Phystop :
* By Falcon is usually $7E00 bytes below

    move.l    $436.w,d3
    move.l    d5,d4
    sub.l    d3,d4
    move.l    #$8000,d3
    sub.l    d4,d3    * add diff

    sub.l    #NewPhyst,d5    *Get diff.
    sub.l     d5,$436.w    *Correct Memtop sysvar

    sub.l    d3,$436.w    * By Falcon if....

*    Get os_end :

    move.l     $4F2.w,a1
    move.l      12(a1),a1   *seek until this addr
    lea      $800,a2     *from here seek

* Seek basepage value, followed by free RAM for... :

    move.l    basep(pc),d1
    move.l    memt(pc),d2
    sub.l    d1,d2   *free RAM for

bvseekl     cmp.l    (a2),d1
          bne.s    bvseendt

* if found test freeram value matching :

    cmp.l    4(a2),d2
    beq.s    bvgotit

bvseendt    addq.l    #2,a2
        cmp.l    a2,a1
    bgt.s    bvseekl

bvgotit   * decrease  free RAM value by diff. :

    sub.l     d5,4(a2)
* Dirty hack, but works !

    * By stoopid Falcon it is $200 bytes higher !!!!
*    cmp.b    #4,machin+3
*    bne.s    corr_2
    sub.l    d3,4(a2)


* If no RAM for GX skip Signature writing :

*    tst.b    gxf
*    beq.s    fin_lowm

* Header build support  #1:
    move.l    $42E.w,a2
    move.l    #"PPGX",(a2)+
    move.l    #MainInb,(a2)
fin_lowm    rts

DeskRes    dc.w    0
basep    dc.l      0
memt    dc.l      $78000    *preset for case...
uspstor    dc.l    0

GamexCtrl     *Code for controlling game exit ....
   * Must be PC relative !!

RamSwap     *This swaps  2 RAM halves

* Areas   are     8-$7FD00  and   $80008 - $FFD00
* If game uses RAM $7FD00-$7FFFF we need some
* space to store that 768 bytes .....   problem ???

    move.w    #$2700,sr   

* MFP restoring flow:

* disable all MFP interrups
* allow little time that CPU finish

* Clear IE registers
    clr.b    $FFFFFA07.w
    clr.b    $FFFFFA09.w
* Clear Pending  regs
    clr.b    $FFFFFA0B.w
    clr.b    $FFFFFA0D.w
*Clear  in Service regs :
    clr.b    $FFFFFA0F.w
    clr.b    $FFFFFA11.w


*Some little delay
* Until find not better solution ... ?
     move.l   #3984,d1
.del    subq.l    #1,d1
    bne.s   .del

* Swapping only  used Sys area, after it just copy left game area
* to top RAM !!!

* no need for swap, in fact .....

* First copy game up, then TOS down, then rest of game up
* 256KB max at once

ramswp    lea     8.w,a5
    lea    AltRamPos+8,a6
    move.w    #5460,d0     

    movem.l      (a5)+,d1-d7/a0-a4   *48 bytes at once
     movem.l    d1-d7/a0-a4,(a6)    
    lea    48(a6),a6
     *48 bytes in one cycle

    tst.b    d0
    bne.s    ramsw_loop
 *Little fade/flash :
    move.w    $FFFF8240.w,d1
    addq.w    #1,d1
    cmp.w    #$0FFF,d1
    bcs.s    .colup
    clr.w    d1
.colup    move.w    d1,$FFFF8240.w

ramsw_loop    dbf    d0,ramswl

* game up to $3FFF8  copied

    lea    8.w,a6
swapDpos    lea    DeskCopy,a5   * May change
swapln    move.w    #0,d0

.cod2    movem.l      (a5)+,d1-d7/a0-a4   *48 bytes at once
     movem.l    d1-d7/a0-a4,(a6)    
    lea    48(a6),a6
    dbf    d0,.cod2    

* Now only copy remaining of game in high RAM
    lea    $3FFF8,a5   *src
    lea    AltRamPos+$3FFF8,a6   *dest

    move.w    #5445,d0      *for rest, to $7FD00 !
.cou    movem.l      (a5)+,d1-d7/a0-a4   *48 bytes at once
     movem.l    d1-d7/a0-a4,(a6)    
    lea    48(a6),a6
    dbf    d0,.cou    

* May be little overshot, so set locations min 24 bytes over !


* Now need to restore stack pointers, screen, MFP, PSG ....

*   relative pos,      what  in SysStor

*     0    USP
*      4    Desktop screen resolution at prg start !
*    6    SSP
*    10    Palette, 32 bytes
*    42    MFP state....

    lea    SysStor,a1
    move.l    (a1)+,a4
    move.l    a4,usp
    move.w    (a1)+,d7   *Resolution
    move.l    (a1)+,sp

*Set palette pointer Sysvar:  
    move.l    a1,$45A.w   *Colorptr - will set palette in first Vblank

* Here deal with MFP....

    lea    $FFFFFA01.w,a1
    lea    SysStor+mfpof,a2
    moveq    #23,d2   *24 registers
mfprl    move.b    (a2)+,(a1)
    addq.l    #2,a1
    dbf    d2,mfprl

    move.w    #$2300,sr

*Signal and silencing possible tone
    lea forvs(pc),a6
    lea $ffff8800.w,a0
    moveq #0,d0
sounl    move.b d0,(a0)
    move.b (a6)+,2(a0)
    addq.b #1,d0
    cmp.b #14,d0
    blt.s sounl

* Flush IKBD ACIA buffer - may be blocked
aciafl        btst    #0,$FFFFFC00.w
    beq.s    aciaempt
    tst.b     $FFFFFC02.w
    bra.s     aciafl

    move.l   #3984,d1
.del    subq.l    #1,d1
    bne.s   .del

    pea  ikbdres(pc)    *Back regular IKBD mode
    move.w  #1,-(sp)
    move.w  #25,-(sp)
    trap  #14
    addq.l  #8,sp

* Set screen
    move.w    d7,-(sp)
    pea     GameScrB
    pea    GameScrB
     move.w    #5,-(sp)
    trap    #14
    lea    12(sp),sp
* Write for sure :
    lea    NewPhyst,a2
    move.l    #"PPGX",(a2)+
    move.l    #MainInb,(a2)

ToDesktop    clr.w    -(sp)
    trap    #1    *Regular exit

ikbdres      dc.b     $80,1
*joysta      dc.b     $90,0    


forvs   *Sound pattern, simple
  dc.b 66,2
  dc.b 125,2,80,2
  dc.b 1 *Noise perlen -here not used
  dc.b %11111000 *Mixer control
  dc.b 16,16,16
  dc.b 0,22,0

    bclr      #1,$484.w   * Key repeat off !!! Important for TOS dependant
 *Check TOS version - may be not built inm, but running in RAM !
       move.l    $4F2.w,d1
   *      clr.b    d1  *on round address always
       move.l    d1,a1
      move.b    2(a1),d0  *TOS ver major
      move.b    3(a1),d1  *TOS ver minor

* Following is necessary to correct if run in low RAM
* in  area   below   launcher
* otherwise Trap #1 will write in code !!!!
*    move.l    $28(a1),gemdap  * Actual GEMDOS proc.

* Writing TOS version for later outprint
    lea  machin(pc),a2
    move.b   d0,(a2)+   *TOS V
    move.b   d1,(a2)+   *TOS v
    move.b   29(a1),4(a2)   *Lang code

*'Detecting' TOS RAM size, just by $42E

    move.l     $42E,d2
    swap     d2
    lsr.w    #3,d2   *shift so that 512KB will be 1
    move.b     d2,(a2)+

*If TOS is 4 or 3 , skip next tests...

    cmp.b    #4,d0
    beq      isfalc
    cmp.b         #3,d0
    beq           istt

* Physical RAM size by MemCTRL sysvar, or by Chip read ...

    clr.l    d3
*Instead orgphystop look MMU control register shadow $424
    move.b     $424.w,d3
    move.l        d3,d2
    and.b         #1,d2
    move.l        d3,d1
    and.b         #4,d1
    lsr.b           #2,d1
    add.b         d1,d2  *512K multiplier - 1 or 2 or 0

    move.l         d3,d4
    and.b          #2,d4
    move.l        d3,d1
     and.b          #8,d1
    lsr.b            #2,d1
    add.b          d1,d4  *2M mult.  2 or 4 or 0
    lsr.b    #1,d4  *now 1 or 2

    clr.l    d3
    tst.b    d2
    beq.s    seem2
    move.l    #$40000,d3  *256KB
    lsl.l    d2,d3  *mult by 2 or 4  
seem2    clr.l    d2
    tst.b    d4
    beq.s    keepms
    move.l    #$100000,d2  *1MB
    lsl.l    d4,d2
    add.l    d2,d3

keepms    swap     d3
    lsr.w    #3,d3   *shift so that 512KB will be 1
    move.b     d3,4(a2)

*Detecting machine HW - is STE, MSTE ?

*Is MSTE ?
    move.l    sp,a3
    lea    buser1(pc),a1
    move.l    8.w,backorb-buser1+2(a1)
    move.l    a1,8.w
    move.b    $FFFF8E21.w,d1   *  read from HW reg
*Will do bus error if not Mega STE
    move.b   #3,(a2)+   *Code for MSTE

* d1  -  bit 0 = cache on/off   ,  bit 1 (?) = 8/16MHz    
*     btst    #1,d1
*    sne    (a2)
    move.b  #$FC,$FFFF8E21.w

* After this may set 16MHz by need, or even back to 8...
*    addq.l   #1,a2
*    move.b  #$FF,$FFFF8E21.w
*    st    (a2)
    bra.s    backorb
buser1    lea    buser2(pc),a1
    move.l    a1,8.w
    tst.b    $FFFF8924.w  *Microwire for STE detect
    move.b   #2,(a2)   *Code for STE
    bra.s    restosp

buser2    move.b    #1,(a2)

restosp    move.l  a3,sp
backorb    move.l    #0,8.w    *here comes original buserror vector

istt     move.b   #5,(a2)   *HW code
        bra    mc68030

isfalc    move.b   #4,(a2)   *HW code    

*PMMU moving
newpos equ $3FE000

    lea     pmmuop(pc),a1    
    move.b    #0,(a1)
    clr.l    d0
    movec    cacr,d0
    move.w    #$20A,d0
    movec    d0,cacr
    lea    $700.w,a0

    lea     newpos,a1
    move.w    #$100,d0
pmmml    move.b    (a0)+,(a1)+
    dbf    d0,pmmml
    lea    pmmuop+2(pc),a0
    pmove.d    crp,(a0)
    move.l     #newpos,4(a0)
    pmove.d    (a0),crp
    lea    pmmuop+10(pc),a1
    move.l    #$FF8707,(a1)
    pmove.l    (a1),tt0

    move.w    #$809,d7   * Instr cache on, data off
    movec    d7,cacr
    move.w    d7,d2
    and.w    #1,d2
    lsr.w    #7,d7
    and.w    #2,d7
    or.w    d7,d2
    lea    falccach(pc),a1
    move.b    d2,(a1)+
    move.b    #$CF,(a1)   * Validity flag !

    and.b    #%11011110,$FFFF8007.w
*    or.b    #%00000001,$FFFF8007.w   * STEB, 8MHz, Blitter irrelevant

mc68030    st    falcfl     * Flag for long stack frame mostly !

pmmuop  ds.b         32
falccach    dc.w    0


machipr  *Outprints machine parameters

    lea hwpos(pc),a0
    bsr  pmess
    lea mait(pc),a0
    bsr  pmess

    lea  machin+3(pc),a1
    cmp.b  #1,(a1)
    bne.s   isstem
    lea   hwst(pc),a0
    bra.s  hwoup

isstem    cmp.b  #2,(a1)
    bne.s   ismstem
    lea   hwste(pc),a0
    bra.s  hwoup

ismstem    cmp.b  #3,(a1)
    bne.s   isfalcm
    lea   hwmste(pc),a0
    bsr    pmess

    *Outprint CPU clock too if MSTE:
    lea  machin+4(pc),a1
    tst.b    (a1)
    bne.s   sho16   *if begin clock 16 then print 16 only
    addq.l   #1,a1
    tst.b   (a1)
    beq.s   sho8   *if begin and end is 8 show 8 only
* Show 8>16
    lea   hwm816m(pc),a0
    bra.s  hwoup
sho16    lea   hwm16m(pc),a0
    bra.s  hwoup
sho8    lea   hwm8m(pc),a0
    bra.s  hwoup

isfalcm    cmp.b  #4,(a1)
    bne.s   seeistt
    lea   hwfalc(pc),a0
     bra.s    hwoup

seeistt    cmp.b   #5,(a1)
    bne.s    seetv
    lea        hwtt(pc),a0

hwoup     bsr     pmess

seetv    *TOS version outprint

    lea tosvit(pc),a0
    bsr  pmess

    lea   tosvp+1(pc),a2
    lea  machin(pc),a1
    move.b  (a1)+,d0   *Major
    add.b #"0",d0
    move.b   d0,(a2)

    move.b  (a1),d1   *Minor
    cmp.b  #$62,d1    *is TOS 1.62 ?
    beq.s  t162s

    add.b  #"0",d1
    moveq #"0",d0
    bra.s   tosvpri

t162s    moveq #"6",d0
    moveq  #"2",d1

tosvpri    addq.l  #2,a2
    move.b  d0,(a2)+
    move.b  d1,(a2)
    lea   tosvp(pc),a0
    bsr  pmess

*TOS RAM size outprint
    lea ramit(pc),a0
    bsr  pmess    
    lea  machin+2(pc),a1
    cmp.b  #1,(a1)
    bne.s   not512
    lea   rams512(pc),a0
    bra.s  ramsoup

not512   *needs some calc...
    moveq   #0,d1
    move.b (a1),d1
    lsr.b #1,d1
    scs   d6   *Flag for half MB at end
    lea  ramsiu+1(pc),a1  *Some aligning...
    tst.b   d6
    beq.s   bratoa
    lea  ramsiu(pc),a1
bratoa    bsr  toasc

    tst.b  d6
    beq.s  ramsta
    move.b #".",(a1)+
    move.b #"5",(a1)
ramsta    lea  ramsiu(pc),a0

ramsoup  bsr.s  pmess

* ST RAM size outprint
    lea  machin+3(pc),a1
    cmp.b       #5,(a1)
    beq.s    end_hwpr
    cmp.b      #4,(a1)
    beq.s    end_hwpr

    lea ramst(pc),a0
    bsr  pmess    
    lea  machin+7(pc),a1
    cmp.b    #1,(a1)
    bne.s    not512rs
    lea         rams512(pc),a0
    bra.s     ramsouprs

not512rs   *needs some calc...
    moveq   #0,d1
    move.b (a1),d1
    lsr.b #1,d1
    scs   d6   *Flag for half MB at end
    lea       ramsiu+1(pc),a1  *Some aligning...
    tst.b     d6
    beq.s   bratoars
    lea       ramsiu(pc),a1
bratoars    bsr       toasc

    tst.b    d6
    beq.s  ramstars
    move.b #".",(a1)+
    move.b #"5",(a1)
ramstars    lea  ramsiu(pc),a0

ramsouprs  bsr.s  pmess

    lea   gamext(pc),a0
    bsr  pmess


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

toasc    *cover values from 1 to 14

    divu #10,d1
    move.b d1,d2
    swap  d1
    add.b #"0",d2   *10s of MB
    cmp.b #"0",d2
    bne.s   putdig1
    move.b #" ",d2
putdig1    move.b d2,(a1)+
    add.b #"0",d1   *1s of MB
    move.b d1,(a1)+


hwst dc.b  "   ST",0
hwste  dc.b "  STE",0
hwmste dc.b "Mega STE",0
hwfalc   dc.b " Falcon",0
hwtt      dc.b  "   TT",0

hwm8m  dc.b 13,10," 8 MHz",0
hwm16m  dc.b 13,10," 16 MHz",0
hwm816m  dc.b 13,10,"8>16 MHz",0

tosvp  dc.b  " 1.00",0

rams512 dc.b " 512 KB",0     *  ,27,"H",0

ramsiu  dc.b  "    MB",0  

hwpos  dc.b    27,"E",27,"Y",48,32,0

homec  dc.b  27,"H",0   *Cursor back to top left

* Info texts:

mait  dc.b  "Machine: ",0
ramit  dc.b  13,10,"TOS RAM:",0
ramst  dc.b  ", ST RAM:",0
tosvit  dc.b  13,10,"TOS ver: ",0

gamext  dc.b   13,10,13,10,"GAMEX: key F9",27,"H",0

lowRamTM   dc.b  13,10,"Too much low RAM occupied !",0
RAMne   dc.b  13,10,"Min RAM: 1MB !",0
*noGXp    dc.b  13,10,13,10,"For Gamex min 1MB RAM !",27,"H",0



hwpal   *Palette with white 0 and all other as blue
   *because of medres/lowres switch bug

   dc.w   $666,$116,$116,$116,$116,$116,$116,$116
   dc.w   $116,$116,$116,$116,$116,$116,$116,$116

* Adding Mega STE machine settings as option :

megastes    *see machine

    lea    machin+3(pc),a2
    cmp.b    #3,(a2)
    beq.s    itsMSTE

    cmp.b    #4,(a2)
    beq    itsFalc

    bra    show_hw

* Mega STE
 * Only setting 8/16MHz, together with cache off/on

    bsr    clearkb     * Clear ikbd buffer for sure

    lea    mstest(pc),a0
    bsr    pmess

    tst.b    machin+5   * Clock ?
    bne.s    its16m1
    lea    mste8mt(pc),a0   * Change txt on screen
    bsr    pmess
    clr.b    mstetems

its16m1    move.w    #7,-(sp)
    trap    #1
    addq.l    #2,sp

    cmp.b    #"1",d0
    beq.s    msteset8
    cmp.b    #"2",d0
    beq.s    msteset16

    cmp.b    #" ",d0
    beq.s    msteexit

    cmp.b    #13,d0
    beq.s    mstesetexit
    bra.s    its16m1

msteset8    lea    mste8mt(pc),a0   * Change txt on screen
    bsr    pmess
    moveq    #0,d1
mstecls    move.b    d1,mstetems    
    bra.s    its16m1

msteset16    lea    mste16mt(pc),a0   * Change txt on screen
    bsr    pmess
    st    d1
    bra.s    mstecls

mstesetexit   * We are in supervisor mode
    move.b    #$FC,d1
    tst.b    mstetems    
    beq.s    set8caoff
    move.b    #$FF,d1
set8caoff        move.b    d1,$FFFF8E21.w
    addq.b    #1,d1
    seq    machin+5

msteexit        bra    show_hw

mstetems        dc.b    255,0   *Must preset to on !

mstest     dc.b   27,"E","     Mega STE CPU clock setting",13,10
    dc.b  13,10,"Press:   1 for 8 MHz,   2 for 16 MHz",13,10
    dc.b  "Enter  for  set and exit",13,10
    dc.b   "Space exits without change",13,10

    dc.b   13,10,13,10,"CPU clock: 16 MHz",0

mste8mt    dc.b    27,"Y",39,43," 8",0        
mste16mt    dc.b    27,"Y",39,43,"16",0

itsFalc    * Set bus - CPU, Blitter clock, STE emul., CPU instr and Data cache

    bsr    clearkb     * Clear ikbd buffer for sure

    lea    falconst(pc),a0
    bsr    pmess

* Falcon bus settings:
* FF8007   Bit 0 = CPU clock,  Bit 2 = Blitter clock,  Bit 5 = STE bus emul when = 0 !

    move.b    $FFFF8007.w,d7
    btst    #0,d7
    bne.s    fas1
    lea    falcc8mt(pc),a0   * Change txt on screen
    bsr    pmess
    clr.b    falset1

fas1    btst    #2,d7
    bne.s    fas2
    lea    falcb8mt(pc),a0   * Change txt on screen
    bsr    pmess
    clr.b    falset1+1

fas2    btst    #5,d7
    bne.s    fas3
    lea    falcsten(pc),a0   * Change txt on screen
    bsr    pmess
    clr.b    falset1+2

fas3    move.b    falccach(pc),d7
    btst    #0,d7    *Instr cache
    bne.s    fas4
    lea    falcincf(pc),a0   * Change txt on screen
    bsr    pmess
    clr.b    falset1+3

fas4    btst    #1,d7    *Data cache
    bne.s    fas5
    lea    falcdcf(pc),a0   * Change txt on screen
    bsr    pmess
    clr.b    falset1+4

    move.w    #7,-(sp)
    trap    #1
    addq.l    #2,sp

    cmp.b    #"1",d0
    beq.s    falsetc8
    cmp.b    #"2",d0
    beq.s    falsetc16

    cmp.b    #"3",d0
    beq.s    falsetb8
    cmp.b    #"4",d0
    beq.s    falsetb16

    cmp.b    #"5",d0
    beq    falsetsteoff
    cmp.b    #"6",d0
    beq    falsetsteon

    cmp.b    #"7",d0
    beq    falsetinof
    cmp.b    #"8",d0
    beq    falsetinon

    cmp.b    #"9",d0
    beq    falsetdaof
    cmp.b    #"0",d0
    beq    falsetdaon

    cmp.b    #" ",d0
    beq    msteexit    *same exit

    cmp.b    #13,d0
    beq    falsetexit
    bra.s    fas5

falsetc8    lea    falcc8mt(pc),a0   * Change txt on screen
    bsr    pmess
    moveq    #0,d1
fal1cls    move.b    d1,falset1    
    bra.s    fas5

falsetc16    lea    falcc16mt(pc),a0   * Change txt on screen
    bsr    pmess
    st    d1
    bra.s    fal1cls

falsetb8    lea    falcb8mt(pc),a0   * Change txt on screen
    bsr    pmess
    moveq    #0,d1
fal1bls    move.b    d1,falset1+1    
    bra    fas5

falsetb16    lea    falcb16mt(pc),a0   * Change txt on screen
    bsr    pmess
    st    d1
    bra.s    fal1bls

falsetsteoff    lea    falcstef(pc),a0   * Change txt on screen
    bsr    pmess
    st    d1      * When set, then is off !!!
fal1ste    move.b    d1,falset1+2    
    bra    fas5

falsetsteon    lea    falcsten(pc),a0   * Change txt on screen
    bsr    pmess
    moveq    #0,d1
    bra.s    fal1ste

falsetinof        lea    falcincf(pc),a0   * Change txt on screen
    bsr    pmess
    moveq    #0,d1
fal1inc    move.b    d1,falset1+3    
    bra    fas5

falsetinon     lea    falcincn(pc),a0   * Change txt on screen
    bsr    pmess
    st    d1
    bra.s    fal1inc

falsetdaof        lea    falcdcf(pc),a0   * Change txt on screen
    bsr    pmess
    moveq    #0,d1
fal1dac    move.b    d1,falset1+4    
    bra    fas5

falsetdaon     lea    falcdcn(pc),a0   * Change txt on screen
    bsr    pmess
    st    d1
    bra.s    fal1dac

falsetexit       *activate changes :

    lea    falset1(pc),a3
    moveq    #0,d3
    moveq    #0,d4
    tst.b    (a3)   * CPU clock
    beq.s    fnot1
    bset    #0,d3

fnot1    addq.l    #1,a3
    tst.b    (a3)   * Blitter clock
    beq.s    fnot2
    bset    #2,d3

fnot2    addq.l    #1,a3
    tst.b    (a3)   * STE bus emul
    beq.s    fnot3
    bset    #5,d3

fnot3    addq.l    #1,a3
    tst.b    (a3)   * Instr. cache
    beq.s    fnot4
    bset    #0,d4

fnot4    addq.l    #1,a3
    tst.b    (a3)   * Data cache
    beq.s    fnot5
    bset    #1,d4

fnot5      * Now set HW regs :

    move.b    $FFFF8007.w,d2
    and.b    #%11011010,d2   * Mask required bits
    or.b    d3,d2
    move.b    d2,$FFFF8007.w
*    move.b    d3,$FFFF8007.w

    move.b    d4,falccach
    move.b    d4,d3
    and.w    #1,d3
    lsl.w    #7,d4
    and.w    #$0100,d4
    or.w    d3,d4
    or.w    #$0808,d4   * Clear order prepare
    movec    d4,cacr

    bra    show_hw

falconst     dc.b   27,"E","     Falcon bus and cache settings",13,10
    dc.b  13,10,"Press: 1 for 8 MHz, 2 for 16 MHz CPU",13,10
    dc.b   "     3 for 8 MHz, 4 for 16 MHz Blitter",13,10
    dc.b   "     5 for not STE, 6 for STE bus",13,10
    dc.b   "     7 for instr. cache off, 8 for on",13,10
    dc.b   "     9 for data cache off, 0 for on",13,10

    dc.b  "Enter  for  set and exit",13,10
    dc.b   "Space exits without change",13,10

    dc.b   13,10,13,10,"CPU clock:     16 MHz"
    dc.b   13,10,"Blitter clock: 16 MHz"
    dc.b   13,10,"STE bus:       off"
    dc.b   13,10,"Instr. cache:   on"
    dc.b   13,10,"Data  cache:    on",0

falcc8mt    dc.b    27,"Y",43,47," 8",0        
falcc16mt    dc.b    27,"Y",43,47,"16",0

falcb8mt    dc.b    27,"Y",44,47," 8",0        
falcb16mt    dc.b    27,"Y",44,47,"16",0

falcstef    dc.b    27,"Y",45,47,"off",0        
falcsten    dc.b    27,"Y",45,47," on",0

falcincf    dc.b    27,"Y",46,47,"off",0        
falcincn    dc.b    27,"Y",46,47," on",0

falcdcf    dc.b    27,"Y",47,47,"off",0        
falcdcn    dc.b    27,"Y",47,47," on",0


falset1    dc.b    255,255,255,255,255,0

* Clearing KB buffer :

clearkb    move.w    #11,-(sp)   *Cconis
    trap    #1
    addq.l    #2,sp
    tst.l    d0
    beq.s    nocha

    move.w    #7,-(sp)   *Crawcin
    trap    #1
    addq.l    #2,sp
    bra.s    clearkb

nocha    rts

cheatt   dc.b  27,"H","Press 1 for unlimited lives",13,10
    dc.b  "  2 for unlimited Time",13,10
    dc.b  "  3 for unlimited Bombs",13,10
    dc.b  "  4 for unlimited Keys",13,10
    dc.b  "Space for continue",0


sta2    incbin    "JPS2"   * Gamestart exec.

picfn    dc.b    "JIMPOWER.PCH",0    * Unpacked Photochrome pic with
* 32K colors (and little flickering)

screnb  ds.l    1

   include  "PCHTOF3.S"   * Rutine
* for converting Photochrome to Falcon "True Color" format

  include  "PHOTUS.S"    * Photochrome display rut.
* for STE, ST

 section data

  section  bss

* Space for Falcon conversion :
head   ds.b  6   *PCH header here...
stbitm  ds.b  32000
stpal    ds.b  $4B20
stbm2    ds.b 32000
stpal2    ds.b  $4B20
convtbl  ds.b  8192

* PP, Dec. 2009.