        SUBT    > <wini>arm.NewEmulate.EmuBody - Main body of 6502 emulator

 [ fullbbc
        TTL     BBC Model B emulator for Archimedes/Arthur 1.20/RISC OS
 |
        TTL     6502 Second Processor emulator for Archimedes/Arthur 1.20/RISC OS
 ]

        GET     &.Hdr.ListOpts
        GET     &.Hdr.Macros
        GET     &.Hdr.System
        GET     &.Hdr.ModHand
        GET     &.Hdr.File
        GET     &.Hdr.Proc
        GET     &.Hdr.Services
        GET     &.Hdr.Variables
        GET     &.Hdr.EnvNumbers
        GET     &.Hdr.Wimp
        GET     &.Hdr.NewErrors
        GET     &.Hdr.UpCall
        GET     &.Hdr.a1keys
        GET     &.Hdr.a500keys

        GET     &.Hdr.ROMCache

        GET     &.Hdr.Debug

        GET     Version

 [ debug
Proc_Debug SETL True
 ]

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

                GBLL    modulespace     ; Whether we use RMA for 6502 + data
modulespace     SETL    False           ; or in absolute application space
                                        ; True doesn't seem to work anymore

; Some things have to go in module space anyway, eg. ROM cache

aplBase         *       &8000

                GBLS    machine
 [ fullbbc
machine         SETS    "BBC"
RamLimit        *       64*1024
 |
  [ turbo
machine         SETS    "Turbo"
RamLimit        *       256*1024
  |
machine         SETS    "Tube"
RamLimit        *       64*1024
  ]
 ]


; Convenient opposites of defined symbols

                GBLL    aplspace
aplspace        SETL    :LNOT: modulespace

                GBLL    tube
tube            SETL    :LNOT: fullbbc

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Conditional bits

; Whether indexing wraps from &FFxx to &00xx when using AX, AY, IY, JMIX
; Needs to be TRUE for 2p Elite to work
        GBLL wrap
 [ fullbbc
wrap    SETL False              ; Remapped via table
 |
wrap    SETL True               ; Must be hand-wrapped
 ]


; Whether CMOS opcodes are allowed - disassembler always does them though
; Current BBC 'OS' uses them for efficiency in places, eg. BITAX
; and it may be nice to run BASIC IV in the Host ...
                GBLL    cmos
cmos            SETL    True


; Whether the 6502 stack is constrained to page 01 to save zp or vector corrupt
; Try setting this to True sometime ...
                GBLL    wrapstack
wrapstack       SETL    False


; Whether a 6502 language ROM image is bolted to the end of the code
                GBLL    haslang
haslang         SETL    True

DefaultBASICSocket * 12         ; Especially for WordWise. Yuk Yuk Yuk


; Whether we demand correctness in assembly
                GBLL    asserting
asserting       SETL    True


; Whether to 'debug' each opcode fetch
                GBLL    opfetchdebug
 [ debug
opfetchdebug    SETL    True
 |
opfetchdebug    SETL    False
 ]

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Register allocation

; r0-r3 are work registers

OtherFlags RN r4                ; D and I bits currently

mpf     RN r5                   ; Multi-porpoise flag &FFFFFF00 for ADC SBC ASL

A       RN r6                   ; 6502 'registers'
X       RN r7
Y       RN r8
S       RN r9                   ; 6502 SP + &0100

P       RN r10                  ; 6502 PC + MR

MR      RN r11                  ; -> base of 6502 space
JV      RN r12                  ; -> Base of opcode table. Can be restored
                                ; easily when wp'd. Also not needed outside
                                ; 6502 code execution routines

;sp      RN r13                 ; FD stack in USR mode and also SVC/IRQ entries

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ASCII characters

TAB     *       9
LF      *       10
CR      *       13
space   *       " "
delete  *       &7F

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; OSByte numbers

Byte_RxRate        * &07
Byte_TxRate        * &08
Byte_SetFlashMark  * &09
Byte_SetFlashSpace * &0A
Byte_DisableEvent  * &0D
Byte_EnableEvent   * &0E
Byte_FlushBuffers  * &0F

Byte_ReflectKeyboardStatus * &76
Byte_ScanKeyboard  * &79
Byte_ClearESCAPE   * &7C
Byte_ADVAL         * &80
Byte_ReadCharUnderCursor * &87
Byte_ReadFRED      * &92
Byte_WriteFRED     * &93
Byte_ReadJIM       * &94
Byte_WriteJIM      * &95
Byte_ReadSHEILA    * &96
Byte_WriteSHEILA   * &97
Byte_ReadOutputCursor * &A5
Byte_ByteVars      * &A6
Byte_BASICSocket   * &BB
Byte_KeyboardStatus * &CA
Byte_QItems        * &DA
Byte_TUBEPresence  * &EA
Byte_ResetAction   * &F7
Byte_LastResetType * &FD

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        MACRO
        assert  $condition
 [ $condition
        MEXIT
 |
  [ asserting
 ! 1, "ASSERT fails: $condition"
  |
 ! 0, "ASSERT fails: $condition"
  ]
 ]
        MEND

        MACRO
$label  SetBorder $bgr
$label
        Push    "r0, r1"
        MOV     r0, #VIDC
        LDR     r1, =&40000000 :OR: $bgr
        STR     r1, [r0]
        Pull    "r0, r1"
        MEND

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Module workspace layout

                ^       0               ; Don't make wp relative so we can
                                        ; ensure we've got wp valid before use

; Old handlers save area. Keep in ADR range

oldErrorhandler  #      4               ; NB. Order for LDMIA
oldErrorwspace   #      4
oldErrorBuffer   #      4
oldEscapehandler #      4
oldEscapewspace  #      4
oldCbackhandler  #      4
oldCbackwspace   #      4
oldCbackbuffer   #      4
oldEventhandler  #      4
oldEventwspace   #      4

callbackBuffer  #       16*4
saveArea        #       16*4            ; Dump for potentially all registers

; Common word size stuff

OSOrigin_copy    #      4               ; Copy of the OSOrigin

whereIsStar      #      4               ;    0 -> no star command
                                        ; <> 0 -> 6502 address of star command
whereToExecuteIt #      4               ;    0 -> no code to run
                                        ; <> 0 -> 6502 address to go to
lastWhereToExecuteIt #    4             ;    0 -> no code to run
                                        ; <> 0 -> 6502 address to go to

; Common byte size stuff

emulatorActive  #       1               ; 0 -> inactive
hadStarCommand  #       1               ; 0 -> had no startup *command
oldfx247state   #       1               ; To restore on exit
callbackCause   #       1               ; Bitset of reasons to be cheerful
breakKeyState   #       1               ; 0 -> key up, 1 -> been down
                                        ; Also interlock on callback generation

           AlignSpace

 [ fullbbc
; BBC word size stuff

NRoms           *       16              ; A la BBC maximum
RomAddrTable    #       NRoms*4         ; Word array
RomSizeTable    #       NRoms*4         ; Word array

ROMDirectory    #       4               ; ROM FS dirname we enumerate
ROMPrefix       #       4

SystemVIARegs   #       16

wpvar_osbytevars_pB0 #  4               ; Address of OSByteVars + &B0

CRTC_6845ScreenAddr #   4               ; R12,13 combined address
CRTC_6845CursorAddr #   4               ; R14,15 combined address

CRTC_ScreenAddr #       4               ; 6502 address derived from 6845 value
CRTC_ScreenSize #       4               ; In bytes
CRTC_BytesPerCharRow #  4
ARMScreenMemory #       4               ; Lowest address in ARM screen memory
TotalScreenSize #       4
ARMScreenStart  #       4               ; Current start of displayed memory
GapModeBuffer   #       4

ScreenReadRoutine  #    4
ScreenWriteRoutine #    4
PaletteRoutine     #    4


; BBC byte size stuff

RomStateTable   #       NRoms           ; Byte array
SidewaysState   #       1               ; Whether RAM or ROM, dirty or clean
BASICSocket     #       1
ROMLatchCopy    #       1

VideoULA_CReg   #       1
CRTC_AddrReg    #       1
UserTimerLow    #       1

PaletteLogical  #       1               ; OSWord control block
PalettePhysical #       1
                #       3               ; Paranoia in case OSWord gets keen

ModeNumber       #      1               ; Current ARM mode number
CRTC_ModeReg     #      1               ; CRTC R9 + VideoULA combination
CRTC_XCharFactor #      1
CRTC_CursorFlag  #      1
ScrBRow          #      1
ArmAddressFactor #      1               ; amount to multiply by to convert
                                        ; 6502 rows to ARM rows
           AlignSpace   4, 4-1
ScreenStartCB   #       5               ; offset 1 from here is word aligned

keyOptions      #       1
oldfx202state   #       1               ; To restore on exit
adcChannel      #       1               ; Noted when EOC event gets to us

 |

; Tube byte size stuff

inosfile        #       1
 ]

           AlignSpace   16

TempString      #       256

ourstack        #       4*128           ; Might be enough
initstack       #       0               ; Initial sp (use FD stack)

errorBuffer     #       4+4+256         ; ErrPC + ErrNumber + ErrString


 [ debug
            AlignSpace  64
ReadLineBuffer  #       256
Key1State       #       4
Key2State       #       4
debuglevel      #       4               ; 0 -> no debug here
 ]

 [ @ > 4096
 ! 1, "Emulator global workspace is out of LDR range by ":CC:(:STR:(@-4096)):CC:" bytes"
 ]

 [ modulespace
                   AlignSpace   256
  [ fullbbc
                        #       256*4   ; Table of real addresses == 6502 ones
emulatorspaceoffset     #       RamLimit
                        #       32*1024 ; Extra 'shawowy' areas in 0..31K

MRvar_osbytevars_pB0    *       wpvar_osbytevars_pB0 - emulatorspaceoffset
; large -ve offset from MR to a variable!

  |
emulatorspaceoffset     #       RamLimit
                        #       4       ; Prevent data abort if JMI &FFFF etc
  ]
 ]

Emulator_WorkspaceSize * @

 [ True
 ! 0, "Emulator workspace is ":CC:(:STR:@):CC:" bytes"
 ]


 [ aplspace
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Layout of apl when we are using it

  [ fullbbc
   [ debug
StaticEmulatorSpace *   &10000
   |
StaticEmulatorSpace *   aplBase + 256*4 + &100
   ]
                        ^       -4*2 -256*4     ; Really MR relative
MRvar_osbytevars_pB0    #       4
wp_restore              #       4       ; Way off the base of 6502 space
                        #       256*4   ; Table of real addresses == 6502 ones
; -ve index this way into MR relative variables
 assert :INDEX: @ = 0
; +ve index this way into 6502 space
                        #       RamLimit
                        #       32*1024 ; Extra 'shawowy' areas in 0..31K
  |
   [ debug
StaticEmulatorSpace *   &10000
   |
StaticEmulatorSpace *   aplBase + &100
   ]
                ^       -4              ; Really MR relative
wp_restore      #       4               ; Just off the base of 6502 space
 assert :INDEX: @ = 0
                #       RamLimit
                #       4               ; Prevent data abort if JMI &FFFF etc.
  ]

StaticEmulatorEnd * (:INDEX: @) + StaticEmulatorSpace
 ]

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Causes of callback

nothingCausedCallback * 0
breakCausedCallback   * 1 :SHL: 0
escapeCausedCallback  * 1 :SHL: 1
adcCausedCallback     * 1 :SHL: 2

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        MACRO
$label  GetMR   $reg, $cc
        LCLS    reg2
 [ "$reg" = ""
reg2    SETS    "MR"
 |
reg2    SETS    "$reg"
 ]
 [ modulespace
$label  ADD$cc  $reg2, wp, #emulatorspaceoffset
 |
$label  LDR$cc  $reg2, =StaticEmulatorSpace
 ]
 [ False
 DREG $reg, "$reg (MR) loaded: "
 ]
        MEND


        MACRO
$label  GetWS   $wpreg, $cc, $mrreg
        LCLS    wpreg2
 [ "$wpreg" = ""
wpreg2  SETS    "wp"
 |
wpreg2  SETS    "$wpreg"
 ]
        LCLS    mrreg2
 [ "$mrreg" = ""
mrreg2  SETS    "MR"
 |
mrreg2  SETS    "$mrreg"
 ]
 [ modulespace
$label  SUB$cc  $wpreg2, $mrreg2, #emulatorspaceoffset
 |
$label  LDR$cc  $wpreg2, [$mrreg2, #wp_restore]
 ]
 [ False
 DREG $reg, "$reg (WS) loaded: "
 ]
        MEND

; *********************** Module code starts here *****************************

        LEADR   Module_LoadAddr

Module_BaseAddr

        DCD     Emulator_StartEntry   -Module_BaseAddr
        DCD     Emulator_InitEntry    -Module_BaseAddr
        DCD     Emulator_DieEntry     -Module_BaseAddr
        DCD     Emulator_ServiceEntry -Module_BaseAddr
        DCD     Emulator_TitleString  -Module_BaseAddr
        DCD     Emulator_HelpString   -Module_BaseAddr
        DCD     Emulator_CommandTable -Module_BaseAddr
 [ fullbbc
        DCD     Module_SWIApplicationBase + ROMCacheSWI * Module_SWIChunkSize
        DCD     ROMCache_SWICode      -Module_BaseAddr
        DCD     ROMCache_SWITable     -Module_BaseAddr
        DCD     0                       ; SWI name decode code
 |
        DCD     0                       ; SWI base
        DCD     0                       ; SWI code
        DCD     0                       ; SWI name table
        DCD     0                       ; SWI name decode code

; Places where Glue gets useful info from

        DCD     Emulator_TitleString  -Module_BaseAddr
        DCD     Emulate_HelpString    -Module_BaseAddr
        DCD     Emulate_Command       -Module_BaseAddr
        DCD     Emulate_CommandWaffle -Module_BaseAddr
 ]

Emulator_TitleString
        DCB     "$machine.6502Emulator", 0      ; Allow 31 char title
 [ tube
        %       Emulator_TitleString+31+1-.
 ]


Emulator_HelpString
        DCB     "6502 Emulator"
        DCB     TAB
        DCB     "$Version ($CurrentDate) ("
Emulate_HelpString
        DCB     "$machine emulation)", 0        ; Allow 31 char emulation name
 [ tube
        %       Emulate_HelpString+31+1+1-.     ; Allow for rh ')' too

        ALIGN           ; Not normally needed, but we require it for planting
                        ; command table entry
 ]

Emulator_CommandTable

 [ fullbbc
        Command AllocateROM, 2, 1
        Command CacheROM,    2, 1
        Command DIPState,    1, 1
        Command LinkROM,     2, 1
        Command ListROMs,    0, 0
        Command MakeRAM,     1, 1
        Command MakeROM,     1, 1
        Command SwapROMs,    2, 2
 ]
 [ debug
        DCB     "DLevel", 0
        ALIGN
        DCD     DebugLevel_CommandCode  -Module_BaseAddr
        DCW     0 ; Min
        DCW     1 ; Max
        DCD     DebugLevel_CommandSyntax-Module_BaseAddr
        DCD     DebugLevel_CommandHelp  -Module_BaseAddr
 ]

Emulate_Command ; Must be the last command in the table for patching

        DCB     "Emulate$machine", 0    ; Allow 31 char command
 [ tube
        %       Emulate_Command+31+1-.
 ]
        ALIGN
        DCD     Emulator_CommandCode    -Module_BaseAddr
        DCW     0   ; Min
 [ tube
        DCW     255 ; Max - allow large command tail
 |
        DCW     0 ; Max - No arg permitted
 ]
        DCD     Emulator_CommandSyntax  -Module_BaseAddr
        DCD     Emulator_CommandHelp    -Module_BaseAddr

        DCB     0                       ; End of command table


Emulator_CommandHelp    ; Identical now
Emulator_CommandSyntax
        DCB     "The 6502 emulator runs "
Emulate_CommandWaffle
        DCB     "BASIC and other BBC programs", 0 ; Allow 255 char waffle
 [ tube
        %       Emulate_CommandWaffle+255+1-.
 ]

 [ tube
RunPath6502Name  DCB   "Run6502$Path", CR
RunPath6502Value DCB   "<Run$Path>", CR ; Default to user's current Run$Path
 ]
        ALIGN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In    r0-r6 trashable

Emulator_InitEntry ENTRY "r7-r10"

        LDR     r2, [r12]               ; Hard init ?
        CMP     r2, #0
        BNE     %FT10                   ; Skip claim if soft

        MOV     r0, #ModHandReason_Claim
        LDR     r3, =Emulator_WorkspaceSize
        SWI     XOS_Module
        EXIT    VS                      ; 'No room in RMA' is acceptable msg
        STR     r2, [r12]

10      MOV     wp, r2                  ; Dereference always

        MOV     r0, #0                  ; I am currently very INactive
        STRB    r0, [wp, #emulatorActive ]
 [ debug
        LDR     r0, =0
        STR     r0, [wp, #debuglevel]
 ]

 [ tube
; Set a few Arthur OSByte variables - might confuse others, but unlikely!

        MOV     r0, #Byte_BASICSocket   ; BASIC ROM is in its initial slot
        MOV     r1, #DefaultBASICSocket
        MOV     r2, #0
        SWI     XOS_Byte

        MOV     r0, #Byte_TUBEPresence  ; TUBE present
        MOV     r1, #&FF
        MOV     r2, #0
        SWI     XOS_Byte

; Set variable up iff it doesn't exist

        addr    r0, RunPath6502Name
        MOV     r2, #-1                 ; r0 -> name
        MOV     r3, #0
        SWI     XOS_ReadVarVal          ; VSet misleading here
        ADDS    r2, r2, #0              ; -ve -> variable exists
        BMI     %FT60                   ; VClear

        addr    r0, RunPath6502Name
        ADD     r1, r0, #RunPath6502Value - RunPath6502Name
        MOV     r2, #0
        MOV     r3, #0
        MOV     r4, #VarType_Macro      ; Follow the Run$Path variable
        SWI     XOS_SetVarVal           ; unless punter says otherwise
60
 ]

 [ fullbbc
        MOV     r0, #0                  ; Only set at init time
        STRB    r0, [wp, #keyOptions]

  [ modulespace
        BL      PowerOnReset            ; Once-off init - *RMReInit to redo
  ]
        BLVC    InitialiseROMCache
 ]

        BLVC    InitResetCommon
        EXIT

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; r0-r6 trashable

Emulator_DieEntry ENTRY "MR"

        LDR     wp, [r12]

        LDRB    r0, [wp, #emulatorActive ] ; Emulator active ?
        TEQ     r0, #0
        BNE     %FT90                   ; [if so, refuse to die]

 [ fullbbc
        BL      FreeAllSockets          ; Can't survive RMTidy
 ]
        EXITS                           ; Assumes VClear in entry lr


90      ADR     r0, ErrorBlock_6502Active
        SETV
        EXIT

        MakeErrorBlock 6502Active

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Emulator_ServiceEntry ROUT

 [ aplspace
        CMP     r1, #Service_Memory
        BEQ     Emulator_Service_Memory
 ]
        TEQ     r1, #Service_Reset*4,2      ; EQ,CC if so
        CMPNE   r1, #Service_NewApplication ; EQ,CS if so
        MOVNES  pc, lr_svc              ; VClear

        BCS     Emulator_NewApplication

; .............................................................................

Emulator_Reset ENTRY "r0"

        LDR     wp, [r12]

        LDRB    r0, [wp, #emulatorActive ] ; Was I active ?
        TEQ     r0, #0
        MOV     r0, #0                  ; Confirmation that I am dead
        STRB    r0, [wp, #emulatorActive ]

        MOVNE   r0, #Byte_ResetAction   ; If so, reset this, as it's not
        LDRNEB  r1, [wp, #oldfx247state] ; reset by Arthur till power-on!
        MOVNE   r2, #0
        SWINE   XOS_Byte

        BL      InitResetCommon
        EXITS

; .............................................................................
; Someone else is about to take over, so give up gracefully

Emulator_NewApplication ENTRY

        LDR     wp, [r12]

        BL      PrepareToExit
        EXITS

 [ aplspace
; .............................................................................
; If we are currently using apl (CAO is us) then refuse memory move

Emulator_Service_Memory

        addr    r12, Module_BaseAddr
        CMP     r2, r12
        ADRHSL  r12, Emulator_ModuleEnd ; Need not include OS and language
        CMPHS   r12, r2                 ; as CAO can never be there
        MOVHS   r1, #Service_Serviced   ; Claim service - CAO is us
        MOVS    pc, lr_svc              ; VClear
 ]

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; We might now be run from out of MOS ROM or downloaded from a podule ROM
; so we now have to worry about semaphore fulkups: doesn't yet matter ...

InitResetCommon ENTRY "r0-r2"

 [ debug
        MOV     r14, #0
        STR     r14, [wp, #Key1State]
        STR     r14, [wp, #Key2State]
 ]
        CLRV                            ; Ensure caller is happy, he may
        EXIT                            ; call us with VSet (eg. no rom:)

 [ fullbbc
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Entered in some mode or other, probably IRQ

        AlignForModule

TickerCode ENTRY

        LDRB    r14, [wp, #SystemVIARegs + VIA_IFR] ; Set T0 interrupt
        TST     r14, #IFR_T0_bit                    ; Status, not requesting
        ORREQ   r14, r14, #IFR_T0_bit
        STREQB  r14, [wp, #SystemVIARegs + VIA_IFR] ; Save time if set already
        EXITS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Monitor UpCalls to see if media change requested

UpCallCode ROUT

        TEQ     r0, #UpCall_MediaNotPresent
        TEQNE   r0, #UpCall_MediaNotKnown
        MOVEQ   r0, #UpCall_Invalid     ; Stop NRaine esquire from getting it
        MOVS    pc, lr                  ; Pass it on

 ]

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Had *command to enter emulator, so start up via module handler

Emulator_CommandCode ENTRY

        MOV     r2, r0                  ; Pass command tail back for GetEnv
        MOV     r0, #ModHandReason_Enter
        addr    r1, Emulator_TitleString
        SWI     XOS_Module
        EXIT

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Main entry point - entered in USR mode, r12 -> private word

FailToStart
        ADR     r0, ErrorBlock_6502NotEnoughMemory


AbortOutOfHere                          ; Called if exception
        SWI     OS_GenerateError

        SWI     OS_WriteI+7
        SWI     OS_Exit                 ; Paranoia

        MakeErrorBlock 6502NotEnoughMemory


Emulator_StartEntry ROUT

 [ aplspace
        SWI     XOS_GetEnv              ; r0 := command line^, r1 := mem limit

        LDR     r14, =StaticEmulatorEnd
        CMP     r1, r14
        BLO     FailToStart             ; [Not enough apl memory for emulation]

; Try to give memory back if we have more than exactly the right amount
; so we may be able to run in a task window SOMEDAY (ie not now !!!)

        SUBNE   r0, r14, #aplBase       ; Size we really need to run in
        MOVNE   r1, #-1                 ; Don't alter next slot size
        SWINE   XWimp_SlotSize          ; Who cares if it's not there or
                                        ; being unresponsive ?
 ]

        LDR     wp, [r12]
        ADD     sp, wp, #initstack      ; FD stack

        GetMR                           ; Ensure this is valid
 [ aplspace
        STR     wp, [MR, #wp_restore]   ; Put this in now we've got enough apl
 ]


; Note the command tail for subsequent execution in the 6502 process

        SWI     XOS_GetEnv              ; r0 := command line^, r1 := mem limit

        MOV     r1, r0                  ; Find star command to execute
        BL      SkipOverNameAndSpaces   ; Command line of the form:
        MOVLO   r1, #0                  ;     'Tube6502Emulator xxx yyy'
        BLO     %FT30                   ; [null command tail]

        ADD     r2, MR, #&0100          ; Base of 6502 stack good enough
25      LDRB    r0, [r1], #1            ; to plonk this string
        TEQ     r0, #0
        MOVEQ   r0, #CR
        STRB    r0, [r2], #1
        BNE     %BT25
        MOV     r1, #&0100

30      STR     r1, [wp, #whereIsStar]
  [ debug
        DREG    r1, "set star address to "
  ]
        TEQ     r1, #0                  ; Keep flag for later, may silence exit
        MOVNE   r1, #-1
        STRB    r1, [wp, #hadStarCommand]


 [ fullbbc
        MOV     r0, #Byte_KeyboardStatus ; Save some punter state
        MOV     r1, #0
        MOV     r2, #&FF
        SWI     XOS_Byte
        STRB    r1, [wp, #oldfx202state]
 ]

        MOV     r0, #Byte_ResetAction
        MOV     r1, #4_2222             ; Disable all Break effects
        MOV     r2, #0
        SWI     XOS_Byte
        STRB    r1, [wp, #oldfx247state]

 [ aplspace :LAND: fullbbc
; Start/Restart 6502 machine from Power On state as apl may have been destroyed
        BL      PowerOnReset
 ]

 [ aplspace :LAND: tube
; Ensure we have a kosher language as apl may have been destroyed
        BL      BangLanguage            ; Sets whereToExecuteIt
 ]

 [ fullbbc :LAND: True
        MOV     r2, #NRoms-1            ; Ensure ROMS cached now, not at init
        MOV     r1, #0                  ; No filename -> cache if linked
50      MOV     r0, r2
        SWI     XROMCache_Cache
        MOVVS   r0, r2
        SWIVS   XROMCache_Uncache       ; Ensure unlinked if error in cacheing
        SUBS    r2, r2, #1
        BPL     %BT50
 ]


 [ debug
        MOV     r0, #EventV
        ADRL    r1, DebugEventCode
        MOV     r2, wp

        LDR     r14, [wp, #debuglevel]
        TST     r14, #debug_handlers
        BEQ     %FT00
        DREG    r1,"Claiming (Debug) EventV: ",cc
        DREG    r2,","
00
        SWI     XOS_Claim
 ]


; Install our error, escape, event and callback handlers,
; remembering the caller's to restore on exit.

        MOV     r14, #nothingCausedCallback
        STRB    r14, [wp, #callbackCause]

        MOV     r14, #1                   ; Disable Break key callbacks
        STRB    r14, [wp, #breakKeyState] ; as that'd longjump over init code

        BL      SetNewHandlers
 [ debug
        LDR     r14, [wp, #debuglevel]
        TST     r14, #debug_handlers
        BEQ     %FT00

        DLINE   "Old handlers to restore on emulator exit:"
        DREG    r1,"ErrorHandler  := "
        DREG    r2,"ErrorWSpace^  := "
        DREG    r3,"ErrorBuffer   := "
        DREG    r4,"EscapeHandler := "
        DREG    r5,"EscapeWSpace^ := "
        DREG    r6,"CBackHandler  := "
        DREG    r7,"CBackWSpace^  := "
        DREG    r8,"CBackBuffer   := "
        DREG    r9,"EventHandler  := "
        DREG   r10,"EventWSpace^  := "
00
 ]
        ADD     r14, wp, #oldErrorhandler
 assert oldErrorwspace   = oldErrorhandler + 4*1
 assert oldErrorBuffer   = oldErrorhandler + 4*2
 assert oldEscapehandler = oldErrorhandler + 4*3
 assert oldEscapewspace  = oldErrorhandler + 4*4
 assert oldCbackhandler  = oldErrorhandler + 4*5
 assert oldCbackwspace   = oldErrorhandler + 4*6
 assert oldCbackbuffer   = oldErrorhandler + 4*7
 assert oldEventhandler  = oldErrorhandler + 4*8
 assert oldEventwspace   = oldErrorhandler + 4*9
        STMIA   r14, {r1-r10}


        MOV     r0, #Byte_EnableEvent
        MOV     r1, #Event_Keyboard
        SWI     XOS_Byte

 [ fullbbc
        MOVVC   r0, #Byte_EnableEvent
        MOVVC   r1, #Event_ADCConvert
        SWIVC   XOS_Byte

        MOVVC   r0, #Byte_EnableEvent
        MOVVC   r1, #Event_VSync
        SWIVC   XOS_Byte


        MOVVC   r0, #TickerV
        addr    r1, TickerCode, VC
        MOVVC   r2, wp
  [ debug
        LDR     r14, [wp, #debuglevel]
        TST     r14, #debug_handlers
        BEQ     %FT00

        DREG    r1,"Claiming TickerV: ",cc
        DREG    r2,","
00
  ]
        SWI     XOS_Claim


        MOVVC   r0, #UpCallV
        addr    r1, UpCallCode, VC
; ***^  MOVVC   r2, wp
  [ debug
        LDR     r14, [wp, #debuglevel]
        TST     r14, #debug_handlers
        BEQ     %FT00

        DREG    r1,"Claiming UpCallV: ",cc
        DREG    r2,","
00
  ]
        SWI     XOS_Claim


; Change mode to give:
; (a) a visual indication of something happening;
; (b) more CPU power!

        SWI     XOS_WriteI+22
        SWIVC   XOS_WriteI+0
        SWI     XOS_WriteS
        DCB     LF,CR
        DCB     "BBC Model B emulator initialising ...", LF,CR, 0
        ALIGN
 ]


RestartAfter6502Reset ; Start/Restart 6502 machine from RESET state

        MOV     r14, #&FF                   ; We are now about to run!
        STRB    r14, [wp, #emulatorActive ] ; Note that I do this BEFORE
                                            ; destroying r12 nowadays
        GetMR

; If bound language does automatic old text recovery, all the better.
; If we are using apl, we cannot guarantee that the contents of the 6502
; space are ok, but we won't be deliberately obstructive by wiping it out
; in the Tube emulation, but we will copy the bound language down in that case.

        BL      BangOS                  ; Ensure OS ok for when we restart

        LDR     r14, [wp, #lastWhereToExecuteIt] ; Put in a restart address
        STR     r14, [wp, #whereToExecuteIt]

 [ fullbbc
        BL      InitialiseMMU           ; Set up memory mapping
                                        ; MUST be done after loading the OS in
                                        ; as we need Trap in &FCxx,&FDxx,&FExx!

; Reset CRTC, Video ULA, NOT the System VIA

        MOV     r0, #0
        STR     r0, [wp, #CRTC_6845ScreenAddr]
        STR     r0, [wp, #CRTC_6845CursorAddr]
        STRB    r0, [wp, #CRTC_CursorFlag]      ; Default is ON
        STRB    r0, [wp, #ModeNumber]
        MOV     r0, #&3000
        STR     r0, [wp, #CRTC_ScreenAddr]
        MOV     r0, #&5000
        STR     r0, [wp, #CRTC_ScreenSize]
        MOV     r0, #3
        STRB    r0, [wp, #ScreenStartCB+0]

        MOV     r0, #&FF                ; Invalid value - forces change
        STRB    r0, [wp, #VideoULA_CReg]
        STRB    r0, [wp, #ROMLatchCopy]

        MOV     r0, #Byte_SetFlashSpace ; Stop Arthur flashing - NB. Order !!!
        MOV     r1, #0
        SWI     XOS_Byte

        MOV     r0, #Byte_SetFlashMark
        MOV     r1, #0
        SWI     XOS_Byte

        LDR     r14, [wp, #wpvar_osbytevars_pB0] ; Make MR relative copy too
        STR     r14, [MR, #MRvar_osbytevars_pB0]
 ]

        MOV     r14, #nothingCausedCallback
        STRB    r14, [wp, #callbackCause]

        MOV     r14, #0                 ; Allow Break key to do callback
        STRB    r14, [wp, #breakKeyState]

        MOV     OtherFlags, #I_bit_6502 ; Not decimal mode, no IRQ allowed yet
        MOV     mpf, #&FFFFFF00         ; mpf := &FFFFFF00
        ADRL    JV, OpcodeTable         ; r12 := JV

        ADD     r0, MR, #&10000
        LDR     r0, [r0, #-4]           ; Load reset address from &FFFC,D
        MOV     r0, r0, LSL #16         ; Bye-Bye IRQ address
        ADD     P, MR, r0, LSR #16      ; Starting 6502 PC (Probably ~&F800)

 [ debug
        LDR     r14, [wp, #debuglevel]
        TST     r14, #debug_startup
        BEQ     %FT00

        MOV     r14, r0, LSR #16
        DREG    r14, "Starting 6502 code; PC=",,Word
00
 ]
        B       Execute6502             ; Start to execute 6502 code ...

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Error handler whilst emulating. Entered in USR mode, wp passed in r0

; All other registers may have been trashed due to exception

ErrorHandlerCode ROUT

        MOV     wp, r0                  ; Leave r0 == wp^
        ADD     sp, wp, #initstack      ; FD stack.May have had exception

 [ tube
        BL      DelinkFromFSVectors     ; Get our ass off that there vector
 ]
        BL      SetNewHandlers          ; Pure paranoia

        MOV     r2, wp                  ; Preserve for below

        ADD     r14, wp, #saveArea      ; Restore state
        LDMIA   r14, {r4-r12}           ; r12 := JV, MR valid

 [ fullbbc
                                        ; Bung external errors in the stack
        ADD     P, MR, #&0100           ; We will execute here in a minute
 |
        ADD     P, MR, #&0200           ; 6502 cli_loop/external error buffer
        ADD     P,  P, #&0036           ; We will execute here in a minute
 ]
        MOV     r1, P

        MOV     r14, #0                 ; Put a 6502 BRK instruction
        STRB    r14, [r1], #1           ; in the buffer

; r2 MUST be copy of wp here as that ain't valid no more like (it's JV now)

        ADD     r0, r2, #errorBuffer    ; Stupid processor can't cope !
        ADD     r0, r0, #4              ; First word is a return pc (ignore it)

        LDR     r14, [r0], #4           ; Get error word. We only know about
        TST     r14, #&80000000         ; Exception ?
        BNE     %FT50

        STRB    r14, [r1], #1           ; Copy error number (byte)

10      LDRB    r14, [r0], #1           ; Copy error string
        STRB    r14, [r1], #1
        TEQ     r14, #0
        BNE     %BT10

        B       Execute6502             ; Execute the 6502 BRK ...



50 ; It was an exception, so get out - raise to parent

        GetWS                           ; Tends to help things

        BL      PrepareToExit

        ADD     r0, wp, #errorBuffer    ; Point at the error block
        ADD     r0, r0, #4              ; Skip stored pc
        B       AbortOutOfHere

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Changes of ESCAPE state are given asynchronously by the OS.
; We are entered with r11_b6 as the new ESCAPE status. r11 may be corrupted
; r12 on entry = MR (non-1)
; To avoid callback being used, set r12 ~= 1 on exit

; Note that 6502 (esp. Tube) programs that enable Escape EVENTS won't get them!

        AlignForModule

 [ tube
EscapeHandlerCode ROUT

        TST     r11, #(1 :SHL: 6)
        MOVEQ   r11, #0
        MOVNE   r11, #&FF
        STRB    r11, [r12, #&FF]        ; Store ESCAPE state in 6502 space &FF

; ***^  MOV     r12, #0                 ; No callback wanted: r12 ~= 1
        MOVS    pc, lr

 |

EscapeHandlerCode ROUT

        TST     r11, #(1 :SHL: 6)
; ***^  MOVEQ   r12, #0                 ; No callback wanted: r12 ~= 1
        MOVEQS  pc, lr                  ; ESCAPE being cleared is boring

        MOV     r11, #&FF
        STRB    r11, [r12, #&FF]        ; Store ESCAPE state in 6502 space &FF
                                        ; Will be cleared by 6502 process

        GetWS   ,,r12                   ; Need to derive from r12 (MR here)
        LDRB    r11, [wp, #callbackCause] 
        ORR     r11, r11, #escapeCausedCallback
        STRB    r11, [wp, #callbackCause]

 [ debug :LAND: True
 SetBorder &00C ; bgR
 ]
        MOV     r12, #1                 ; Get a callback so we can clear the
        MOVS    pc, lr                  ; ESCAPE condition on the Arthur side
 ]

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In    wp valid (and ~= 1, so no callback), privileged mode, IRQ disabled

        AlignForModule

EventHandlerCode ROUT

        TEQ     r0, #Event_Keyboard
 [ tube
        MOVNES  pc, lr                  ; Exit if wrong event.
 |
        BEQ     %FT80

        TEQ     r0, #Event_VSync*4,2    ; EQ,CC if so
        CMPNE   r0, #Event_ADCConvert   ; EQ,CS if so
        MOVNES  pc, lr                  ; Exit if wrong event

        BCS     %FT50

; VSync event

        LDRB    r0, [wp, #SystemVIARegs + VIA_IFR] ; Set CA1 (VSYNC) interrupt
        TST     r0, #IFR_VSYNC_bit                 ; Status, not requesting
        ORREQ   r0, r0, #IFR_VSYNC_bit
        STREQB  r0, [wp, #SystemVIARegs + VIA_IFR] ; Save time if set already

        MOV     r0, #Event_VSync
        MOVS    pc, lr                  ; No callback required. r12 ~= 1


; ADC conversion event

50      STRB    r1, [wp, #adcChannel]   ; Remember channel that just converted

        LDRB    r0, [wp, #callbackCause]
        ORR     r0, r0, #adcCausedCallback
        STRB    r0, [wp, #callbackCause]

 [ debug :LAND: True
 SetBorder &0C0 ; bGr
 ]
        MOV     r12, #1                 ; Callback please
        MOV     r0, #Event_ADCConvert
        MOVS    pc, lr
 ]

; Keyboard up/down event

; In    r1 = key down = 1, key up = 0
;       r2 = key number
;       r3 = 0 -> a500, 1.. -> a1

80      CMP     r1, #1
        MOVNES  pc, lr                  ; [ignore key up events]

        CMP     r3, #0                  ; a500 ?
        MOVEQ   r0, #a500key_Break
        MOVNE   r0, #a1key_Break

        CMP     r0, r2
        MOVNE   r0, #Event_Keyboard
        MOVNES  pc, lr

        LDRB    r0, [wp, #breakKeyState]
        TEQ     r0, #0
        MOVNE   r0, #Event_Keyboard     ; Already been down, waiting for cback
        MOVNES  pc, lr                  ; or callback disabled

        STRB    r1, [wp, #breakKeyState] ; Raising callback from this event

        LDRB    r0, [wp, #callbackCause]
        ORR     r0, r0, #breakCausedCallback
        STRB    r0, [wp, #callbackCause]

 [ debug :LAND: True
 SetBorder &C00 ; Bgr
 ]
        MOV     r12, #1                 ; Callback please
        MOV     r0, #Event_Keyboard
        MOVS    pc, lr

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In    wp valid, privileged mode, IRQ disabled
;       User mode registers in callbackBuffer

CallbackHandlerCode ROUT

10      LDRB    r11, [wp, #callbackCause] ; Note that we reload each time as
                                          ; things we do may reeable IRQ and
                                          ; register new callbacks with us

        TST     r11, #escapeCausedCallback
        BNE     %FT50

        TST     r11, #adcCausedCallback
        BNE     %FT60

        TST     r11, #breakCausedCallback ; This must be the lowest priority!
        BNE     %FT70

; Return to emulator

        MOV     r11, #nothingCausedCallback
        STRB    r11, [wp, #callbackCause]

        ADD     r0, wp, #callbackBuffer
        LDR     lr, [r0, #15*4]
        LDMIA   r0, {r0-r14}^
        MOVS    pc, lr                  ; Continue execution where we left off


; ESCAPE condition caused callback

50      BIC     r11, r11, #escapeCausedCallback
        STRB    r11, [wp, #callbackCause]

        MOV     r0, #Byte_ClearESCAPE   ; Clear ESCAPE condition (not ACK)
        SWI     XOS_Byte
        B       %BT10                   ; [loop processing callback causes]


; ADC conversion event caused callback

; Need to handle this way rather than by causing EOC interrupt as that's
; already been processed by the I/O Podule software; so just tell BBC machine
; the results of any conversion. However, 6502 software won't get EOC events.

; Alternatively we could do more page 02 traps for read/write

60      BIC     r11, r11, #adcCausedCallback
        STRB    r11, [wp, #callbackCause]

        MOV     r0, #Byte_ADVAL         ; Read converted value on last channel
        LDRB    r3, [wp, #adcChannel]   ; Needed for below too
        MOV     r1, r3
        SWI     XOS_Byte                ; Won't fail, or wouldn't have got EOC

        GetMR   r0
        ADD     r0, r0, #&0200
        ADD     r0, r0, #&00B6-1        ; Update 6502 MOS's copies too
        STRB    r3, [r0, #&02BE-(&02B6-1)] ; Last channel converted
        STRB    r1, [r0, r3]!           ; LSB
        STRB    r2, [r0, #&02BA-&02B6]  ; MSB
        B       %BT10                   ; [loop processing callback causes]


; Break key depression caused callback

70      MOV     r11, #nothingCausedCallback
        STRB    r11, [wp, #callbackCause]

        TEQP    pc, #0                  ; Reenable IRQs, go back to User mode

        MOV     r0, #Byte_FlushBuffers  ; Flush all buffers (not banked reg)
        MOV     r1, #0
        SWI     XOS_Byte

; Change mode to give:
; (a) a visual indication of something happening;
; (b) more CPU power!

 [ tube
        MOV     r0, #Byte_ReadCharUnderCursor
        SWI     XOS_Byte
        SWI     XOS_WriteI+22           ; On Tube emulator we need to clear
        MOVVC   r0, r2
        SWIVC   XOS_WriteC              ; screen on Break
 ]

 [ fullbbc
        SWI     XOS_WriteI+22
        SWIVC   XOS_WriteI+0

        SWI     XOS_WriteS
        DCB     LF,CR
        DCB     "BBC Model B emulator reinitialising ...", LF,CR, 0
        ALIGN
 ]

        B       RestartAfter6502Reset


        LTORG

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Error, escape, event and callback handlers are set up
; throughout emulator execution

; In    wp valid

; Out   r1-r10 = old handlers

SetNewHandlers ROUT

        addr    r1, ErrorHandlerCode
        MOV     r2, wp
        ADD     r3, wp, #errorBuffer

        addr    r4, EscapeHandlerCode
        GetMR   r5

        addr    r6, CallbackHandlerCode
        MOV     r7, wp
        ADD     r8, wp, #callbackBuffer

        addr    r9, EventHandlerCode
        MOV     r10, wp

; .............................................................................
; In    r1  -> ErrorHandler
;       r2  =  wp^ for above
;       r3  -> ErrorBuffer
;       r4  -> EscapeHandler
;       r5  =  wp^ for above (MR in our case)
;       r6  -> CallbackHandler
;       r7  =  wp^ for above
;       r8  -> CallbackBuffer
;       r9  -> EventHandler
;       r10 =  wp^ for above
;       wp valid

; Out   r1-r10 = corresponding old values

SEEHandlers ENTRY "r0-r3"

 [ debug
        LDR     r14, [wp, #debuglevel]
        TST     r14, #debug_handlers
        BEQ     %FT00

        DLINE   "Setting handlers:"
        DREG    r1,"ErrorHandler  := "
        DREG    r2,"ErrorWSpace^  := "
        DREG    r3,"ErrorBuffer   := "
        DREG    r4,"EscapeHandler := "
        DREG    r5,"EscapeWSpace^ := "
        DREG    r6,"CBackHandler  := "
        DREG    r7,"CBackWSpace^  := "
        DREG    r8,"CBackBuffer   := "
        DREG    r9,"EventHandler  := "
        DREG   r10,"EventWSpace^  := "
00
 ]
        SWI     XOS_IntOff              ; Must perform atomic update else
                                        ; wrong handlers can get wrong events

        MOV     r0, #ErrorHandler
        SWI     XOS_ChangeEnvironment
        STMIB   sp, {r1-r3}             ; Return old values

        MOV     r0, #EscapeHandler
        MOV     r1, r4
        MOV     r2, r5
        SWI     XOS_ChangeEnvironment
        MOV     r4, r1
        MOV     r5, r2

        MOV     r0, #CallBackHandler
        MOV     r1, r6
        MOV     r2, r7
        MOV     r3, r8
        SWI     XOS_ChangeEnvironment
        MOV     r6, r1
        MOV     r7, r2
        MOV     r8, r3

        MOV     r0, #EventHandler
        MOV     r1, r9
        MOV     r2, r10
        SWI     XOS_ChangeEnvironment
        MOV     r9, r1
        MOV     r10, r2

        SWI     XOS_IntOn
        EXITS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In    wp valid

RestoreHandlers ENTRY "r1-r10"

        ADD     r14, wp, #oldErrorhandler
 assert oldErrorwspace   = oldErrorhandler + 4*1
 assert oldErrorBuffer   = oldErrorhandler + 4*2
 assert oldEscapehandler = oldErrorhandler + 4*3
 assert oldEscapewspace  = oldErrorhandler + 4*4
 assert oldCbackhandler  = oldErrorhandler + 4*5
 assert oldCbackwspace   = oldErrorhandler + 4*6
 assert oldCbackbuffer   = oldErrorhandler + 4*7
 assert oldEventhandler  = oldErrorhandler + 4*8
 assert oldEventwspace   = oldErrorhandler + 4*9
        LDMIA   r14, {r1-r10}

        BL      SEEHandlers
        EXIT

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In    wp valid

; Can be called from all sorts of nasty places, eg. exit from exceptions

PrepareToExit ENTRY

        LDRB    r14, [wp, #emulatorActive ]
        TEQ     r14, #0
        EXITS   EQ                      ; We weren't active

        BL      RestoreHandlers

        MOV     r0, #Byte_ResetAction
        LDRB    r1, [wp, #oldfx247state]
        MOV     r2, #0
        SWI     XOS_Byte

 [ fullbbc
        MOV     r0, #Byte_KeyboardStatus
        LDRB    r1, [wp, #oldfx202state]
        MOV     r2, #0
        SWI     XOS_Byte

        MOV     r0, #Byte_ReflectKeyboardStatus
        SWI     XOS_Byte
 ]

 [ debug
        MOV     r0, #EventV
        ADRL    r1, DebugEventCode
        MOV     r2, wp
        LDR     r14, [wp, #debuglevel]
        TST     r14, #debug_handlers
        BEQ     %FT00

        DREG    r1,"Releasing (Debug) EventV: ",cc
        DREG    r2,","
00
        SWI     XOS_Release
 ]

        MOV     r0, #Byte_DisableEvent
        MOV     r1, #Event_Keyboard
        SWI     XOS_Byte

 [ fullbbc
        MOV     r0, #Byte_DisableEvent
        MOV     r1, #Event_ADCConvert
        SWI     XOS_Byte

        MOV     r0, #Byte_DisableEvent
        MOV     r1, #Event_VSync
        SWI     XOS_Byte


        MOV     r0, #TickerV
        addr    r1, TickerCode
        MOV     r2, wp                  ; r2 may be corrupt if VS from release
  [ debug
        LDR     r14, [wp, #debuglevel]
        TST     r14, #debug_handlers
        BEQ     %FT00

        DREG    r1,"Releasing TickerV: ",cc
        DREG    r2,","
00
  ]
        SWI     XOS_Release


        MOV     r0, #UpCallV
        addr    r1, UpCallCode
        MOV     r2, wp                  ; r2 may be corrupt if VS from release
  [ debug
        LDR     r14, [wp, #debuglevel]
        TST     r14, #debug_handlers
        BEQ     %FT00

        DREG    r1,"Releasing TickerV: ",cc
        DREG    r2,","
00
  ]
        SWI     XOS_Release
 ]

 [ tube
        BL      DelinkFromFSVectors     ; Ensure we're off vectors
 ]

        MOV     r14, #0                 ; Emulator no longer active
        STRB    r14, [wp, #emulatorActive]
        EXITS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Move OS into place

; In    wp, MR valid

BangOS ENTRY "r0-r3"

        ADRL    r1, OSLength
        LDMIA   r1!, {r2, r3}           ; Find length of OS code, Dest^ in 6502
        STR     r3, [wp, #OSOrigin_copy]

 [ debug
        LDR     r14, [wp, #debuglevel]
        TST     r14, #debug_startup
        BEQ     %FT00

        DREG    r3,"Copying OS to 6502 address ",cc
        DREG    r2,", length "
00
 ]
        ADD     r3, r3, MR              ; r1 -> OS code to copy now

10      SUBS    r2, r2, #4
        LDRPL   r0, [r1, r2]
        STRPL   r0, [r3, r2]
        BPL     %BT10

        EXITS

 [ haslang
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Move bound language into place

; In    wp valid

; Stored blocks are of the form :

; +--+--+--+--+--+--+--+--+
; | 20 bit rlink | 12b wct| + n data blocks to copy
; +--+--+--+--+--+--+--+--+
; 31           12 11      0

BangLanguage ENTRY "r0-r5"

        ADRL    r1, OSLength            ; Source link^ at emulator code end
        LDR     r2, [r1]                ; Length of OS code
        ADD     r2, r2, #8              ; Plus 8 for (addr,len) pair

        LDR     r5, [r1, r2]!           ; Get the offset from the module base
        LDR     r3, [r1, #4]            ; 6502 origin of code
        STR     r3, [wp, #whereToExecuteIt] ; Note address for OS to read later
        STR     r3, [wp, #lastWhereToExecuteIt]

 [ debug
        LDR     r14, [wp, #debuglevel]
        TST     r14, #debug_startup
        BEQ     %FT00

        DREG    r3,"Copying language to 6502 address "
00
 ]
        GetMR   r4
        ADD     r3, r4, r3              ; Real dest^

        addr    r4, Module_BaseAddr     ; Need to add in the Emulator origin
                                        ; ie where it is when it's loaded

10      ADD     r5, r5, r4              ; Point to next info word

30      LDR     r4, [r5]                ; Get next info word
        MOV     r2, r4, LSL #20         ; Get the count out
        ADD     r1, r5, #4              ; Point to first data word in the block

20      LDR     r0, [r1], #4            ; Get a word
        STR     r0, [r3], #4            ; Put a word
        SUBS    r2, r2, #(1 :SHL: 20)   ; Finished this block ?
        BNE     %BT20

        MOVS    r4, r4, LSR #12         ; Get the relative link offset
        BNE     %BT10                   ; Loop if link wasn't Nil

        EXITS

 | ; No language

BangLanguage ENTRY

        MOV     r14, #0                 ; TOS restart address for if no
        STR     r14, [wp, #whereToExecuteIt] ; language to start up
        STR     r14, [wp, #lastWhereToExecuteIt]
        EXITS
 ]

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SkipOverNameAndSpaces ROUT

        Push    lr
        BL      SkipToSpace
        Pull    lr

; .............................................................................
; Out   CCodes set on CMP r0, #space

SkipSpaces ROUT

10      LDRB    r0, [r1], #1
        CMP     r0, #space      ; Leave r1 -> ~space
        BEQ     %BT10
        SUB     r1, r1, #1
        MOV     pc, lr          ; r0 = first ~space

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SkipToSpace ENTRY "r0"

10      LDRB    r0, [r1], #1
        CMP     r0, #delete
        CMPNE   r0, #space      ; Leave r1 -> space or CtrlChar
        BHI     %BT10
        SUB     r1, r1, #1
        EXIT

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; strlenXS
; ========
;
; Find the length of a string (exclusive of terminator, so can't HeapGet (0))

; In    r1 -> CtrlChar/space terminated string

; Out   r3 = number of chars (can be used as size for Heap)

strlenXS ENTRY "r0"

        MOV     r3, #0
10      LDRB    r0, [r1, r3]
        CMP     r0, #delete             ; Order, you git ! EQ -> ~HI
        CMPNE   r0, #space              ; CtrlChar, space, delete
        ADDHI   r3, r3, #1
        BHI     %BT10
        EXITS

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; strcatXS
; ========
;
; Concatenate two strings

; In    r1, r2 -> CtrlChar/space terminated strings

; Out   new string in r1 = "r1" :CC: "r2" :CC: 0

strcatXS ENTRY "r1-r3"

        MOV     r3, #space

05      LDRB    r14, [r1], #1           ; Find where to stick the appendage
        CMP     r14, #delete            ; Order, you git !
        CMPNE   r14, #r3
        BHI     %BT05
        SUB     r1, r1, #1              ; Point back to the term char

10      LDRB    r14, [r2], #1           ; Copy from *r2++
        CMP     r14, #delete            ; Order, you git !
        CMPNE   r14, r3                 ; Any char <= r3 is a terminator
        MOVLS   r14, #0                 ; Terminate dst with 0
        STRB    r14, [r1], #1           ; Copy to *r1++
        BHI     %BT10

        EXITS

; .............................................................................
;
; strcpyXS
; ========
;
; Copy a string and terminate with 0

; In    r1 -> dest area, r2 -> CtrlChar/space terminated src string

strcpyXS ALTENTRY

        MOV     r3, #space
        B       %BT10

; .............................................................................

strcpy ALTENTRY

        MOV     r3, #space-1
        B       %BT10

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        LTORG

        GBLS    nextfile
 [ fullbbc
nextfile SETS   "Host"
 |
nextfile SETS   "Tube"
 ]
        LNK     Emu$nextfile
