ModHand

; Copyright 1996 Acorn Computers Ltd
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
;     http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.
;
        TTL     => ModHand - the Relocatable Module Handler

ExtraRMANeeded * 24*1024 ; Amount you get extra on top of what you configured


; Test version, incorporating multiple incarnation attempt

; The module handler needs to know the structure of the HPD, and nodes.
; See RMTidy in particular.

;**************************************************************
;
; Module chain structure: ModuleList points at a (singly-linked) list of
; nodes with following fields:

                        ^  0
Module_chain_Link       #  4    ; the link to the next module info block
Module_code_pointer     #  4    ; pointer to the module.
Module_Hardware         #  4    ; hardware base for podules; 0 for soft loaders
Module_incarnation_list #  4    ; pointer to list of incarnation specifiers
Module_ROMModuleNode    #  4    ; pointer to ROM module node if in ROM (main, podule, extn), else zero

ModInfo                 *  @

; The incarnation list is a list of sub-nodes, one for each incarnation.

                        ^  0
Incarnation_Link        #  4   ; link to next incarnation
Incarnation_Workspace   #  4   ; 4 private bytes for this life
Incarnation_Postfix     #  0   ; postfix string starts here

; Incarnations are distinguished by their postfix, which is separated
; from the module name by a special character:

Postfix_Separator       *  "%"

;**************************************************************

; Handler initialisation.
; registers preserved

; ROM module descriptor format

                        ^       0
ROMModule_Link          #       4               ; pointer to next node
ROMModule_Name          #       4               ; pointer to module name (either directly in ROM, or in an RMA block)
ROMModule_BaseAddress   #       4               ; start of module, if directly accessible
ROMModule_Version       #       4               ; BCD version number, decimal point between bits 15,16 eg "1.23" => &00012300
ROMModule_PoduleNumber  #       4               ; podule number (0..3 = normal podule, -1 = main ROM, -2..-n = extension ROM)
ROMModule_ChunkNumber   #       4               ; chunk number if in podule or extension ROM, unused (?) if in main ROM
ROMModule_OlderVersion  #       4               ; pointer to node holding the next older version of this module, 0 if none
ROMModule_NewerVersion  #       4               ; pointer to node holding the next newer version of this module, 0 if none
ROMModule_CMOSAddrMask  #       4               ; CMOS address of frugal bit (bits 0..15) and bit mask (16..23)
                                                ; and 'initialised' flag in bit 24 (bits 25..31 = 0)
ROMModule_Initialised   *       ROMModule_CMOSAddrMask + 3
ROMModule_Size          #       4               ; size of module
ROMModule_NodeSize      #       0

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

UnplugCMOSTable                         ; in reverse order
        =       Unplug17CMOS
        =       Unplug16CMOS, Unplug15CMOS
        =       Unplug14CMOS, Unplug13CMOS
        =       Unplug12CMOS, Unplug11CMOS
        =       Unplug10CMOS, Unplug9CMOS
        =       Unplug8CMOS, Unplug7CMOS
        =       FrugalCMOS+1, FrugalCMOS+0
        =       MosROMFrugalCMOS+3, MosROMFrugalCMOS+2
        =       MosROMFrugalCMOS+1
UnplugCMOSTableEnd                      ; used for backwards indexing
        =       MosROMFrugalCMOS+0
        =       0
        ALIGN

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

ModuleInit   ENTRY "r0-r12"                             ; call here on system startup

        MOV     r0, #HeapReason_Init                    ; first initialise the heap
        MOV     r1, #RMAAddress
        LDR     r3, [r1, #:INDEX: hpdend]               ; saved for us during init.
        SWI     XOS_Heap

; first initialise the podule manager - this must be the second module (ie the 1st after UtilityModule)

        ADRL    r6, SysModules_Info+4
        LDR     r1, [r6, #-4]
        ADD     r1, r6, r1
        LDR     r14, [r1, #-4]
        TEQ     r14, #0
        MOVNE   r0, #ModHandReason_AddArea
        SWINE   XOS_Module

; now for each module in the main ROM, create a node for it

        ASSERT  ROMModule_Link = 0

        LDR     r9, =ROMModuleChain                     ; pointer to 'previous' node
        MOV     r8, #0                                  ; initial head ptr is zero
        STR     r8, [r9]                                ; set up null list
        MOV     r3, #-1                                 ; podule -1 is main ROM
        MOV     r10, #0                                 ; chunk number 0 to start
10
        LDR     r7, [r6, #-4]                           ; get size of this module
        TEQ     r7, #0                                  ; if zero
        BEQ     %FT20                                   ; then no more main rom modules

        LDR     r4, [r6, #Module_Title]                 ; r4 = offset to module name
        ADD     r4, r6, r4                              ; r4 -> module name
        LDR     r5, [r6, #Module_HelpStr]               ; r5 = help offset
        TEQ     r5, #0                                  ; if no help string
        ADDEQ   r5, r6, #Module_HelpStr                 ; then use help offset as string (null string)
        ADDNE   r5, r6, r5                              ; otherwise point to help string

        ADR     r11, UnplugCMOSTable
        SUBS    r14, r10, #FirstUnpluggableModule       ; subtract number of first module that has an unplug bit
        MOVCS   r1, r14, LSR #3                         ; get byte number
        ANDCS   r14, r14, #7                            ; get bit number
        ADDCS   r14, r14, #16                           ; bit mask stored in bits 16 onwards
        RSBCSS  r1, r1, #(UnplugCMOSTableEnd-UnplugCMOSTable) ; invert table offset, and check in range
        LDRCSB  r11, [r11, r1]                          ; load table value if in range
        MOVCS   r12, #1
        ORRCS   r11, r11, r12, LSL r14                  ; merge with bit mask
        MOVCC   r11, #0                                 ; otherwise zero

        BL      AddROMModuleNode
        BVS     %FT50                                   ; if failed then can't add any more ROMs!

        MOV     r9, r2                                  ; this node is now previous one
        ADD     r6, r6, r7                              ; go on to next module
        ADD     r10, r10, #1                            ; chunk number +=1
        B       %BT10

; now do podule ROMs

20
        MOV     r3, #0                                  ; start at podule 0
21
        MOV     r10, #0                                 ; for each podule start at chunk 0
        CMP     r3, #-1
        MOVGT   r12, #0                                 ; if real podule then start at CMOS bit number 0 for this podule
                                                        ; else carry on from where we're at
22
        MOV     r0, r10
        SWI     XPodule_EnumerateChunksWithInfo
        BVS     %FT40                                   ; bad podule or some such
        CMP     r0, #0                                  ; no more chunks?
        BEQ     %FT45                                   ; then step to next podule
        CMP     r2, #OSType_Module
        MOVNE   r10, r0
        BNE     %BT22

; now claim a block to copy module title into

        MOV     r7, r1                                  ; pass size in r7
        Push    "r0, r3, r4"
        MOV     r3, #0
23
        LDRB    r14, [r4, r3]                           ; find length of title string
        ADD     r3, r3, #1                              ; increment length (include zero at end)
        TEQ     r14, #0
        BNE     %BT23

        BL      ClaimSysHeapNode
        Pull    "r0, r3, r14"                           ; restore chunk no., podule no., old ptr to title
        BVS     %FT50                                   ; if error then no more ROMs (doesn't matter that error ptr is naff)

        MOV     r4, r2                                  ; save pointer to block
24
        LDRB    r1, [r14], #1                           ; now copy string into block
        STRB    r1, [r2], #1
        TEQ     r1, #0
        BNE     %BT24

        MOV     r14, #(1 :SHL: 16)                      ; bit mask ready to shift
        CMP     r3, #-1
        BLT     %FT30

; doing podule ROM

 [ IO_Type = "IOMD"

        ASSERT  ?PoduleFrugalCMOS = 8                   ; ensure we're using the correct Hdr:CMOS
        CMP     r12, #7                                 ; if bit number <= 7
        CMPLS   r3, #8                                  ; then if podule number <= 8
        ADDCC   r11, r3, #PoduleFrugalCMOS              ;      then use one of the 8 PoduleFrugalCMOS bytes
        MOVEQ   r11, #NetworkFrugalCMOS                 ;      elif podule number = 8 then use network card CMOS
        MOVHI   r11, #0                                 ; otherwise no CMOS
        ORRLS   r11, r11, r14, LSL r12                  ; OR in bit mask
        B       %FT36
 |
        ASSERT  ?PoduleFrugalCMOS >= 4
        CMP     r3, #4                                  ; if podule number < 4
        CMPCC   r12, #8                                 ; and bit number < 8
        ADDCC   r11, r3, #PoduleFrugalCMOS              ; then compute CMOS address
        ORRCC   r11, r11, r14, LSL r12                  ; and OR in bit mask
 ]
        B       %FT35

; doing extension ROM
30
        CMP     r12, #16                                ; 2 bytes of CMOS for extension ROMs
        MOVCC   r1, #ExtnUnplug1CMOS                    ; form CMOS address in r1
        ADDCC   r1, r1, r12, LSR #3
        ANDCC   r11, r12, #7                            ; get bit mask
        ORRCC   r11, r1, r14, LSL r11                   ; and OR in
35
        MOVCS   r11, #0                                 ; if out of range then no CMOS
36
        ADD     r12, r12, #1                            ; increment bit
        BL      AddROMModuleNode
        BVS     %FT50

        MOV     r10, r0                                 ; go onto next chunk
        MOV     r9, r2                                  ; this node is now previous one
        B       %BT22

40
        CMP     r3, #0                                  ; are we doing extension ROMs
        BMI     %FT50                                   ; if so, then stop if we get an error
45
        TEQ     r3, #0                                  ; if doing extension ROMs
        SUBMI   r3, r3, #1                              ; then go backwards
        BMI     %BT21
        ADD     r3, r3, #1                              ; go onto next podule
        CMP     r3, #16                                 ; more podules than you could ever fit
        MOVEQ   r3, #-2                                 ; if got to end, try extension ROMs
        MOVEQ   r12, #0                                 ; start by using bit 0 of CMOS
        B       %BT21

; now go down ROM module chain, initialising things

50
        LDR     r12, =ROMModuleChain
        LDR     r12, [r12]
55
        TEQ     r12, #0                                 ; if no more modules
        BEQ     %FT90                                   ; then skip

        LDR     r3, [r12, #ROMModule_CMOSAddrMask]      ; get CMOS for LOCATION version
        ANDS    r2, r3, #&FF
        MOVNE   r1, r2
        MOVNE   r0, #ReadCMOS                           ; if there is a CMOS address
        SWINE   XOS_Byte                                ; then read it
        TST     r2, r3, LSR #16                         ; test bit
        BNE     %FT80                                   ; [LOCATION unplugged, so don't initialise here]

        MOV     r11, r12                                ; start with current one

; now find the newest version that isn't unplugged

; first find the newest version

60
        LDR     r14, [r11, #ROMModule_NewerVersion]
        TEQ     r14, #0                                 ; if there is a newer version
        MOVNE   r11, r14                                ; then link to it
        BNE     %BT60                                   ; and loop

; now work backwards until we find a version that isn't unplugged - there must be one, since LOCATION version is not unplugged

65
        TEQ     r11, r12                                ; back to LOCATION version?
        BEQ     %FT68                                   ; [yes, so use that version]
        LDR     r3, [r11, #ROMModule_CMOSAddrMask]      ; get CMOS for CODE version
        ANDS    r2, r3, #&FF
        MOVNE   r1, r2
        MOVNE   r0, #ReadCMOS                           ; if there is a CMOS address
        SWINE   XOS_Byte                                ; then read it
        TST     r2, r3, LSR #16                         ; test bit
        LDRNE   r11, [r11, #ROMModule_OlderVersion]     ; CODE is unplugged, so try next older version
        BNE     %BT65

68
        LDR     r7, [r12, #ROMModule_PoduleNumber]      ; get podule number (for LOCATION version)
        CMP     r7, #-1                                 ; is it an extension ROM
        BGE     %FT70                                   ; if not then initialise newer one

; it's an extension ROM, so only initialise if it's the newest, and hasn't yet been initialised

        TEQ     r11, r12
        LDREQB  r10, [r11, #ROMModule_Initialised]      ; only initialise if this is zero and r11=r12
        TEQEQ   r10, #0
        BNE     %FT80                                   ; don't initialise

; not an extension ROM, so initialise the newest version (r11) of this module

70
 [ DebugROMInit
        SWI     XOS_WriteS
;;;        =       "About to initialise module ",0
        =       "init mod ",0
        LDR     r0, [r11, #ROMModule_Name]
        SWI     XOS_Write0
        SWI     XOS_NewLine
 ]
        BL      InitialiseROMModule
 [ DebugROMErrors                                       ; print errors in ROM module init for debugging
        BVC     %FT80
        SWI     XOS_WriteS
;;;        =       "Error in ROM module init: ",0
        =       " error: ",0
        ALIGN
        ADDVC   r0, r0, #4
        SWIVC   XOS_Write0
        SWIVC   XOS_NewLine
 ]
80
        LDR     r12, [r12, #ROMModule_Link]
        B       %BT55

90
 [ DebugROMInit
        SWI     XOS_WriteS
        =       "mod init done",0
        SWI     XOS_NewLine
 ]
        MOV     r1, #RMASizeCMOS
        MOV     r0, #ReadCMOS
        SWI     XOS_Byte
        MOV     r0, #0
        LDR     r0, [r0, #Page_Size]
        MUL     r3, r0, r2
        ADD     r3, r3, #ExtraRMANeeded
        MOV     r0, #ModHandReason_Claim
        SWI     XOS_Module
        MOV     r0, #ModHandReason_Free
        SWI     XOS_Module
        EXIT

;******************************************************************************************************
;
;       InitialiseROMModule - Initialise a ROM module
;
; in:   r11 -> ROM module node for CODE version
;       r12 -> ROM module node for LOCATION version
;
; out:  All registers preserved
;

InitialiseROMModule ENTRY "r0-r12"
        MOV     r14, #1
        STRB    r14, [r11, #ROMModule_Initialised]      ; indicate it's been initialised
        LDR     r2, [r11, #ROMModule_ChunkNumber]
        LDR     r3, [r11, #ROMModule_PoduleNumber]
        LDR     r4, [r11, #ROMModule_Name]
        LDR     r6, [r11, #ROMModule_BaseAddress]
        LDR     r7, [r12, #ROMModule_PoduleNumber]
        ADRL    r1, crstring
        MOV     lr, pc                                  ; ADRS lr, %FT10
        ADD     lr, lr, #%FT20-%FT10                    ; ADRS lr, %FT20
10
        Push    "r0-r7,r9,lr"
        LDR     r1, [r11, #ROMModule_Size]
        MOV     r5, r11                                 ; r5 -> ROM module node
        B       APMInitEntry
20
        STRVS   r0, [sp]                                ; if error, preserve r0
        EXIT

;******************************************************************************************************
;
;       AddROMModuleNode - Create a ROM module node and link it with the chain
;
; in:   R3 = podule number
;       R4 -> module name
;       R5 -> module help string
;       R6 -> module base if directly executable, otherwise zero
;       R7 = module size
;       R8 = 0
;       R9 -> previous node
;       R10 = chunk number
;       R11 = CMOS address (in bits 0..15) and bit mask (in bits 16..23) for unplugging (0 if none)
;
; out:  R2 -> node created
;       All other registers preserved, except if error (when R0 -> error)
;

AddROMModuleNode ENTRY "r0,r1,r3-r12"
        MOV     r3, #ROMModule_NodeSize                 ; claim a rom module node
        BL      ClaimSysHeapNode                        ; r0,r1 corrupted, r2 -> block
        STRVS   r0, [stack]
        EXIT    VS

        STR     r8, [r2, #ROMModule_Link]               ; set link for this node to 0
        STR     r7, [r2, #ROMModule_Size]               ; store size in node
        STR     r4, [r2, #ROMModule_Name]               ; store pointer to title string
        STR     r6, [r2, #ROMModule_BaseAddress]        ; store base address
        MOV     r0, r5
        BL      GetVerNoFromHelpString                  ; read version number in BCD into r1
        STR     r1, [r2, #ROMModule_Version]            ; store version number
        LDR     r3, [stack, #2*4]                       ; reload podule number
        STR     r3, [r2, #ROMModule_PoduleNumber]       ; store podule number
        STR     r10, [r2, #ROMModule_ChunkNumber]       ; store chunk number
        STR     r11, [r2, #ROMModule_CMOSAddrMask]      ; store CMOS address and mask

; now check if module is a copy of one already on the list

        MOV     r10, #0                                 ; next oldest node
        MOV     r11, #0                                 ; next newest node
        CMP     r3, #-1                                 ; if in main ROM, no need to look for duplicates
        BEQ     %FT40

        MOV     r1, r4                                  ; make r1 -> additional module's name
        MOV     r4, #0                                  ; zero terminator for Module_StrCmp
        MOV     r12, #0                                 ; search from start of chain
        BL      FindROMModule
        TEQ     r12, #0                                 ; did we find it?
        BEQ     %FT40                                   ; no, then module is unique

        TEQ     r6, #0                                  ; set r6 to 1 if extra is directly executable, otherwise 0
        MOVNE   r6, #1
        CMP     r3, #-1                                 ; set r3 to 1 if extra is an extension ROM, otherwise 0
        MOVGE   r3, #0
        MOVLT   r3, #1
        LDR     r1, [r2, #ROMModule_Version]            ; reload version number of extra node
        BL      CompareVersions                         ; compare r2 version with r12 version
        BCC     %FT30                                   ; extra one is older than this one, so search down older chain

; extra one is newer than this one, so search down newer chain

20
        MOV     r10, r12                                ; old = this
        LDR     r12, [r12, #ROMModule_NewerVersion]     ; this = newer(this)
        MOVS    r11, r12                                ; new = this
        BEQ     %FT40                                   ; if no newer then that's it!
        BL      CompareVersions
        BCS     %BT20

; extra one is older than this one, so search down older chain

30
        MOV     r11, r12                                ; new = this
        LDR     r12, [r12, #ROMModule_OlderVersion]     ; this = older(this)
        MOVS    r10, r12                                ; old = this
        BEQ     %FT40
        BL      CompareVersions
        BCC     %BT30

40
        STR     r10, [r2, #ROMModule_OlderVersion]      ; older(extra)=old
        STR     r11, [r2, #ROMModule_NewerVersion]      ; newer(extra)=new
        TEQ     r10, #0                                 ; if old <> 0
        STRNE   r2, [r10, #ROMModule_NewerVersion]      ; then newer(old)=extra
        TEQ     r11, #0                                 ; if new <> 0
        STRNE   r2, [r11, #ROMModule_OlderVersion]      ; then older(new)=extra

        STR     r2, [r9]                                ; point previous node at this one
        CLRV
        EXIT

CompareVersions ENTRY
        LDR     r14, [r12, #ROMModule_Version]          ; r14 = version(this)
        CMP     r1, r14
        EXIT    NE                                      ; exit with this condition codes, unless equal
        LDR     r14, [r12, #ROMModule_BaseAddress]
        TEQ     r14, #0                                 ; set r14 to 1 if this one is directly executable, otherwise 0
        MOVNE   r14, #1
        CMP     r6, r14
        EXIT    NE                                      ; directly executables are "newer"
        LDR     r14, [r12, #ROMModule_PoduleNumber]
        CMP     r14, #-1                                ; set r14 to 1 if ext. ROM, otherwise 0
        MOVGE   r14, #0
        MOVLT   r14, #1
        CMP     r3, r14                                 ; extension ROMs are "newer" than anything else
        EXIT                                            ; if equal in all other respects, the later one is "newer"

;******************************************************************************************************
;
;       FindROMModule - Find a named module in the ROM module list
;
; in:   R1 -> name to match
;       R4 = potential additional termintor for R1 string
;       R12 -> node before 1st node to be checked (0 => search from start)
;
; out:  R12 -> found node, or 0 if no match
;       If match, then R1 -> terminator of R1 string, otherwise preserved
;       All other registers preserved
;

FindROMModule ENTRY
        TEQ     r12, #0                                 ; if zero passed in on entry
        LDREQ   r12, =ROMModuleChain                    ; then search from start of chain
10
        LDR     r12, [r12, #ROMModule_Link]             ; go to next module
        TEQ     r12, #0                                 ; any more modules?
        EXIT    EQ                                      ; no, then exit
        Push    "r1, r3"
        LDR     r3, [r12, #ROMModule_Name]              ; point to name of module on chain
        BL      Module_StrCmp                           ; compare names
        STREQ   r1, [sp]                                ; if match, then patch stacked r1
        Pull    "r1, r3"
        BNE     %BT10                                   ; if different then try next one
        EXIT

; start of module handler SWI

     GBLA  mhrc
mhrc SETA 0

     MACRO
$l   ModuleDispatchEntry $entry
$l   B      Module_$entry
     ASSERT ModHandReason_$entry = mhrc
mhrc SETA   mhrc + 1
     MEND

ModuleHandler ROUT

     CMP      r0, #(NaffSWI - (.+12))/4     ; Range check
     ADDLO    pc, pc, r0, LSL #2            ; dispatch
     B        NaffSWI

     ModuleDispatchEntry Run
     ModuleDispatchEntry Load
     ModuleDispatchEntry Enter
     ModuleDispatchEntry ReInit
     ModuleDispatchEntry Delete
     ModuleDispatchEntry RMADesc
     ModuleDispatchEntry Claim
     ModuleDispatchEntry Free
     ModuleDispatchEntry Tidy
     ModuleDispatchEntry Clear
     ModuleDispatchEntry AddArea
     ModuleDispatchEntry CopyArea
     ModuleDispatchEntry GetNames
     ModuleDispatchEntry ExtendBlock
     ModuleDispatchEntry NewIncarnation
     ModuleDispatchEntry RenameIncarnation
     ModuleDispatchEntry MakePreferred
     ModuleDispatchEntry AddPoduleModule
     ModuleDispatchEntry LookupName
     ModuleDispatchEntry EnumerateROM_Modules
     ModuleDispatchEntry EnumerateROM_ModulesWithInfo

NaffSWI                                     ; Set V and return
        ADR     R0, ErrorBlock_BadModuleReason
      [ International
BumDealInModule_Translate
        Push    "lr"
        BL      TranslateError
        Pull    "lr"
      ]
BumDealInModule
        B       SLVK_SetV

     MakeErrorBlock BadModuleReason

;*************************************************************

Module_Run      ROUT
       TEQP     PC, #SVC_mode               ; interrupts on
       Push    "R9, lr"
       BL       Load_Module
       BVS      LoadFailed
  ;     BL       EnvStringSkipName - done in load
EnterIt
 ; R9 now ptr to node, R10 ptr to command string to set up.
 ; Enters preferred incarnation.

       LDR      R12, [R9, #Module_incarnation_list]
       ADD      R12, R12, #Incarnation_Workspace

       LDR      R9, [R9, #Module_code_pointer]
       LDR      R11, [R9, #Module_Start]
       TEQ      R11, #0
       Pull    "R9, lr", EQ
       ExitSWIHandler EQ

       Push    "R1-R3"
       MOV      R1, R10
       MOV      R0, #FSControl_StartApplication
       MOV      R2, R9
       LDR      R3, [R9, #Module_Title]     ; prefix with module title
       ADD      R3, R3, R9

       SWI      XOS_FSControl
       BVS      CantGoIntoModule

       LDR      stack, =SVCSTK
       MOV      R0, R10
       TEQP     pc, #0
       MOV      r0, r0                      ; NOP because we've changed mode

       TST      R11, #ARM_CC_Mask           ; check for B startit, etc.
       MOVNE    R11, #0
       ADD      PC, R9, R11

CantGoIntoModule
       Pull    "R1-R3"
LoadFailed
       Pull    "R9, lr"
       B        BumDealInModule

;*************************************************************

Module_Load     ROUT
        TEQP    PC, #SVC_mode               ; interrupts on
        Push    "R9, lr"
        BL      Load_Module
        Pull    "R9, lr"
        B       SLVK_TestV

;*************************************************************

Module_Enter    ROUT
       Push    "R9, lr"                     ; ready for EnterIt
       Push    "R0-R4"
       BL       lookup_commoned

       STRVS    R0, [stack]
       Pull    "R0-R4, R9, lr", VS
       BVS      BumDealInModule

       BLGT     PreferIncarnation
       Pull    "R0-R4"
       MOV      R10, R2                     ; envstring pointer
       B        EnterIt

;*************************************************************

Module_ReInit   ROUT
       Push    "R0-R4, R9, lr"

       BL       lookup_commoned
       BVS      %FT01

       ADDEQ    R3, R9, #Module_incarnation_list
       LDREQ    R12, [R9, #Module_incarnation_list]

 ;    R12 -> incarnation node, R3  -> previous incarnation

       MOV      R10, #1                     ; fatal die
       BL       CallDie
       BVS      %FT03

       SUB      R10, R1, #1
       BL       EnvStringSkipName

       BL       CallInit
       BLVS     LoseModuleSpace_if_its_the_only_incarnation
       STRVC    R12, [R3, #Incarnation_Link]
03     STRVS    R0, [stack]
       Pull    "R0-R4, R9, lr"
        B       SLVK_TestV


01     LDR      R11, [R0]
       LDR      R2, =ErrorNumber_RMNotFound
       CMP      R11, R2
       BEQ      %FT02
05
       SETV
       B        %BT03

02     MOV      R0, #0
       BL       AddModuleIfInROM
       B        %BT03

;*************************************************************

Module_Delete   ROUT
       Push    "R0-R4, R9, lr"
       BL       lookup_commoned
       BVS      %FT01

       ADDEQ    R3, R9, #Module_incarnation_list
       LDREQ    R12, [R9, #Module_incarnation_list]

 ;    R12 -> incarnation node, R3  -> previous incarnation

       BL       KillIncarnation
01     STRVS    R0, [stack]
       Pull    "R0-R4, R9, lr"
        B       SLVK_TestV

;*************************************************************

Module_Free      ROUT
Module_RMADesc
         Push   "R0, R1, lr"

         SUB     R0, R0, #(ModHandReason_RMADesc-HeapReason_Desc)
 ASSERT HeapReason_Desc-HeapReason_Free=ModHandReason_RMADesc-ModHandReason_Free
         MOV     R1, #RMAAddress
         SWI     XOS_Heap
         STRVS   R0, [stack]
         Pull   "R0, R1, lr"
        B       SLVK_TestV

;*************************************************************

Module_Claim  ROUT
         Push   "R0, R1, lr"
         BL      RMAClaim_Chunk
         STRVS   R0, [stack]
         Pull   "R0, R1, lr"
        B       SLVK_TestV

;*************************************************************
; Garbage collect the RMA. We know there's always one module,
; and some RMA space.

 [ RMTidyDoesNowt                               ; on Medusa we do nothing, because we would always fail
                                                ; due to FSLock being Captain Scarlet
Module_Tidy *   SLVK
 |
Module_Tidy      ROUT
         Push   "R0-R6, R9, lr"

         TEQP    PC, #SVC_mode

         MOV     r0, #0
         LDR     r0, [r0, #Curr_Active_Object]
         MOV     r1, #RMAAddress
         LDR     r2, [r1, #:INDEX:hpdend]
         SUBS    r0, r0, r1
         CMPGT   r2, r0
         ADRGTL  r0, ErrorBlock_CantKill
       [ International
         BLGT    TranslateError
       |
         SETV    GT
       ]

         BLVC    Genocide                   ; warn all of impending calamity
         BVS     ExitRMTidy

; now for the great adventure. R2 is old contents of ModuleList
; First build a list of block addresses, together with address of pointer to
; block, in ascending order.

         LDR     R2, =ScratchSpace
         STR     R9, [R2], #4               ; save original module list
         MOV     R3, R2

; in loop, R0 is block address, R1 is pointer to pointer to block
; R2 is ptr to list start
; R3 is list limit

01      ADD      R1, R9, #Module_code_pointer
        LDR      R0, [R1]
        BL       %FT10                      ; insert pair

        LDR      R1, [R9, #Module_incarnation_list]
02      ADD      R1, R1, #Incarnation_Workspace
        LDR      R0, [R1]
        CMP      R0, #0
        BLNE     %FT10                      ; insert workspace block if there
        LDR      R1, [R1, #-Incarnation_Workspace]
        CMP      R1, #0
        BNE      %BT02

        LDR      R9, [R9, #Module_chain_Link] ; next module
        CMP      R9, #0
        BNE      %BT01

; Now iterate over claimed blocks, to discard non-heap pointers.

        MOV      R5, R2                     ; currblock ptr

; if hpdfree <> hpdsize then
;    doblock (hpdsize, hpdfree=Nil -> hpdbase, hpdfree)

        MOV      R12, #RMAAddress
        LDR      R4, [R12, #:INDEX: hpdfree]
        CMP      R4, #Nil
        ADDNE    R4, R4, #:INDEX: hpdfree   ; convert to heapstart offset

        CMP      R4, #hpdsize
        BEQ      %FT04
        MOV      R0, #hpdsize
        CMP      R4, #Nil
        LDREQ    R1, [R12, #:INDEX: hpdbase]
        MOVNE    R1, R4
        BL       ScanAllocBlock
        CMP      R4, #Nil
        BEQ      BlocksScanned

;  while hpdfree <> Nil
;     doblock (hpdfree+fresize, step(hpdfree)=Nil -> hpdbase, hpdfree)

04      ADD      R4, R4, R12
        LDR      R1, [R4, #frelink]
        LDR      R0, [R4, #fresize]
        SUB      R4, R4, R12

        ADD      R0, R0, R4
        CMP      R1, #Nil
        ADDNE    R4, R4, R1
        MOVNE    R1, R4
        LDREQ    R1, [R12, #:INDEX: hpdbase]
        BL       ScanAllocBlock
        BNE      %BT04

BlocksScanned
        MOV      R3, R5                     ; new list end

; copy blocks, relocate ptrs
; R2, R3 list limits
; R12 heap start

        ADD      R0, R12, #hpdsize          ; get addr for first block
StripBlocks
        CMP      R2, R3
        BEQ      %FT09                      ; nowt to copy
        LDR      R1, [R2], #8
        CMP      R1, #0
        BEQ      StripBlocks
        LDR      R4, [R1]                   ; block size
        CMP      R1, R0
        ADDEQ    R0, R4, R0
        BEQ      StripBlocks

; R1 address of first block, R0 address to copy to - gopher it!
; R4 size
        LDR      R5, [R2, #-4]              ; pointer to
        ADD      R0, R0, #4
        STR      R0, [R5]                   ; relocate ptr
        SUB      R0, R0, #4

CopyBlock
        LDR      R5, [R1], #4
        STR      R5, [R0], #4
        SUBS     R4, R4, #4
        BGT      CopyBlock
        B        StripBlocks

09
; Update Hpd
        SUB      R0, R0, R12                ; convert to offset
        STR      R0, [R12, #:INDEX: hpdbase]

        MOV      R0, #Nil
        STR      R0, [R12, #:INDEX: hpdfree] ; no free list.

 ; for restarting, we need
 ; R1 -> prevmod to R9
 ; R9 -> the whinger, R12 -> incarnation list, R2 stop point
 ; R4 -> dead module list
 ; R3 -> previnc

        MOV      R9, #Module_List           ; "module" that's linked at end
        LDR      R4, =ScratchSpace
        LDR      R4, [R4]                   ; dead list
        MOV      R2, #0                     ; persuade it to step module
        MOV      R12, #0                    ; immediately.
        BL       RestartModuleStructure
        BVS      ExitRMTidy

        MOV      R0, #1
        MOV      R1, #-16*1024*1024
        SWI      XOS_ChangeDynamicArea
        CLRV

ExitRMTidy
        STRVS    R0, [stack]
        Pull    "R0-R6, R9, lr"
        B       SLVK_TestV

;-------------------------------------------------------------------------
; RMTidy support routines

; Insertion routine. (R0, 1) is pair to insert, R2 list start, R3 list end.
; Uses R10, 11, 4

10      MOV      R11, R2           ; take curr posn ptr

        SUB      R0, R0, #4        ; genuine internal heap pointer value
11      CMP      R11, R3           ; list ended?
        BEQ      %FT13
        LDR      R4, [R11], #8
        CMP      R4, R0            ; or right posn?
        BLO      %BT11

        SUB      R11, R11, #8      ; where we will store new entry to
        SUB      R4, R3, #4        ; R4 is OS_Word to move from.
12      LDR      R10, [R4], #-4    ; now copy between R11 and R3 up 8.
        STR      R10, [R4, #12]
        CMP      R4, R11
        BHS      %BT12

13      ADD      R3, R3, #8        ; update list end
        STMIA    R11, {R0, R1}     ; new entry in
        ADD      R0, R0, #4        ; and back to link.
        MOV      PC, lr

;-------------------------------------------------------------------
ScanAllocBlock    ROUT
 ; R0 block start
 ; R1 block end
 ; R12 heap start
 ; R3  list end
 ; R5  current list entry

 ; poke out list entries that aren't proper heap pointers

        Push     "R0, R1, R7, R8"
        MOV       R8, #0
        ADD       R0, R0, R12     ; convert to addressi
        ADD       R1, R1, R12

01      CMP       R5, R3
        BGE       %FT02
        LDR       R7, [R5], #8

        CMP       R7, R0          ; while entry at R5 LT R0 pokeout
        STRLT     R8, [R5, #-8]
        BLT       %BT01

        SUBGT     R5, R5, #8

        LDR       R7, [R0]
        ADD       R0, R0, R7      ; next block
        CMP       R0, R1          ; step block until end
        BLT       %BT01
02
        Pull     "R0, R1, R7, R8"
        MOVS      PC, lr

        LTORG

;-----------------------------------------------------------------------------

Genocide ROUT ; non-fatally kill de lot of em, stiff the module chain
              ; corrupts R1-R5, R9, R10, R12
              ; returns R9 = original module chain

         Push   "lr"
         MOV     R4, #0                     ; chain so far

FindChainEnd
         MOV     R1, #Module_List             ; prevnode
         LDR     R9, [R1, #Module_chain_Link] ; currnode
         CMP     R9, #0
         BNE     %FT01
         MOV     R9, R4
         Pull   "PC"

01       LDR     R11, [R9, #Module_chain_Link] ; lastnode?
         CMP     R11, #0
         MOVNE   R1, R9                     ; step chain
         MOVNE   R9, R11
         BNE     %BT01

         LDR     R2, [R9, #Module_incarnation_list] ; keep chain head
         ADD     R3, R9, #Module_incarnation_list
02       LDR     R12, [R3, #Incarnation_Link]       ; currinc
         CMP     R12, #0
         BNE     %FT03
         STR     R12, [R1, #Module_chain_Link]      ; remove from chain
         STR     R2, [R9, #Module_incarnation_list] ; replace incarnations
         STR     R4, [R9, #Module_chain_Link]       ; make into dead head
         MOV     R4, R9
         B       FindChainEnd

03       MOV     R10, #0                    ; not fatal indicator
 [ {FALSE} ; debug RMTidy
        Push    "r0"
        LDR     r0, [r9, #Module_code_pointer]
        LDR     r14, [r0, #Module_Title]
        ADD     r0, r0, r14
        SWI     XOS_WriteS
        =       "RMTidy: killing '", 0
        ALIGN
        SWI     XOS_Write0
        SWI     XOS_WriteS
        =       "'", 10, 13, 0
        ALIGN
        Pull    "r0"
 ]
         BL      CallDie
         BVC     %BT02

; Copy the error in case overwritten

        MOV     R5,R0                           ; Error block
        LDR     R0,=GeneralMOSBuffer                ; R0-> stashed error
        LDR     LR,[R5],#4
        STR     LR,[R0],#4                      ; Copy error number
05      LDRB    LR,[R5],#1
        STRB    LR,[R0],#1
        CMP     LR,#' '                         ; End of string?
        BGE     %BT05                           ; No then more
        LDR     R0,=GeneralMOSBuffer            ; R0-> stashed error
        SETV

         MOV     R5, R12
         MOV     R12, R2
         MOV     R2, R5     ; r12 now incarnation to start, R2 stop point
         BL      RestartModuleStructure
                ; somebody winged, so try and restore consistency before error.
         Pull   "PC"

;------------------------------------------------------------------------------

RestartModuleStructure ROUT

 ; R1 -> prevmod to R9
 ; R9 -> the whinger, R12 -> incarnation list, R2 stop point
 ; R4 -> dead module list
 ; R3 -> previnc

         Push   "R0, lr"

11       CMP     R2, R12
         BNE     %FT12                      ; more incarnations to do

         CMP     R4, #0
         Pull   "R0, PC", EQ, ^

         MOV     R1, R9
14       MOV     R9, R4
         LDR     R4, [R4, #Module_chain_Link]
         MOV     R2,#0                      ; indicate reinit all incarnations
         LDR     R12, [R9, #Module_incarnation_list]
         STR     R2,  [R9, #Module_incarnation_list]
         ADD     R3, R9, #Module_incarnation_list ; previnc ptr

         STR     R2, [R9, #Module_chain_Link]     ; relink next
         STR     R9, [R1, #Module_chain_Link]
         B       %BT11                            ; start incarnations

12       LDR     R11, [R12, #Incarnation_Link]    ; get next in case problems
         ADRL    R10, crstring                    ; no environment
         BL      CallInit                         ; frees node if error
         BVC     %FT15

         STR     R0, [stack]
         LDR     R0, [stack, #4]
         ORR     R0, R0, #V_bit
         STR     R0, [stack, #4]
         Push   "R2"
         MOV     R2, R1                     ; prevnode
         BL      LoseModuleSpace_if_its_the_only_incarnation
         Pull   "R2"

         CMP     R9, #0                     ; did we just discard that module?
         BEQ     %BT14                      ; yup - next one

15       LDRVC   R0,  [R3, #Incarnation_Link]
         STRVC   R0,  [R12,#Incarnation_Link]
         STRVC   R12, [R3, #Incarnation_Link]
         MOVVC   R3, R12

         MOV     R12, R11
         B       %BT11                      ; next incarnation
 ] ; endif <RMTidyDoesNowt>

;****************************************************************************

Module_Clear ENTRY "r0-r3"
        TEQP    pc, #SVC_mode                           ; interrupts on
        MOV     r3, #0                                  ; position in chain

; now find entry in chain to kill : one with successor = R3

MHC_GetEndOne
        MOV     r2, #Module_List                        ; prevnode for killing
        LDR     r0, [r2, #Module_chain_Link]
        CMP     r0, r3
        PullEnv EQ
        ExitSWIHandler EQ
MHC_StepOn
        LDR     r1, [r0, #Module_chain_Link]
        CMP     r1, r3
        MOVNE   r2, r0
        MOVNE   r0, r1
        BNE     MHC_StepOn

        LDR     r11, [r0, #Module_ROMModuleNode]        ; don't kill if it's a ROM module (note that this would also
        CMP     r11, #1                                 ; account for squeezed ROM modules, so the invincible bit in the
        LDRCC   r11, [r0, #Module_code_pointer]         ; die entry is not strictly necessary any more, but never mind!)
        LDRCC   r11, [r11, #Module_Die]                 ; Check for invincible module
        CMPCC   r11, #&80000000                         ; (die entry has top bit set)
        MOVCS   r3, r0                                  ; step if not about to delete
                                                        ; - don't assassinate ROM modules.
        BLCC    KillAndFree
        BVC     MHC_GetEndOne

        LDR     r3, [r2, #Module_chain_Link]
        STR     r0, [stack]
        LDR     r0, [stack, #4*4]
        ORR     r0, r0, #V_bit
        STR     r0, [stack, #4*4]
        B       MHC_GetEndOne

;*************************************************************
; AddArea:
; Entry;  R1 -> module in memory to add, leaving it in place.
; Return: registers preserved, V set if problem
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Module_AddArea   ROUT
         Push   "R9, lr"
         TEQP    PC, #SVC_mode               ; interrupts on
         ADRL    R10, crstring               ; null environment
         BL      ModuleIn_CheckForDuplicate  ; altentry to Load_Module
         Pull   "R9, lr"
        B       SLVK_TestV

;*************************************************************
; CopyArea
;    R1 -> area of memory to add to the module list,
;          copying into the RMA
;    R2 =  size of the area.

Module_CopyArea  ROUT
         Push   "R0-R5, R9, lr"
         TEQP    PC, #SVC_mode

  ; R1 address, R2 size
         BL      CheckHeader
         BVS     AreaFail

         MOV     R10, R1

         LDR     R1, [R10, #Module_Title]
         ADD     R1, R1, R10
         BL      LookUp_Module               ; check for duplicate
         BLNE    KillAndFree
         STRVS   R0, [stack]
         Pull   "R0-R5, R9, lr", VS
         BVS     SLVK_TestV

; R10 points at area
         LDR     R3, [stack, #4*2]           ; get size back
         BL      RMAClaim_Chunk
         ADRVSL  R0, ErrorBlock_MHNoRoom
       [ International
         BLVS    TranslateError
       ]
         BVS     AreaFail

         MOV     R9, R2                      ; new module pointer

; copy R3 bytes from R10 to R2
01       LDR     R1, [R10], #4
         STR     R1, [R2], #4
         SUBS    R3, R3, #4
         BHI     %BT01                       ; was BPL, which is wrong!

         ADRL    R10, crstring               ; no environment string
         MOV     R11, #0                     ; not podular
         BL      LinkAndInit

AreaFail
         STRVS   R0, [stack]
         Pull   "R0-R5, R9, lr"
        B       SLVK_TestV

;*************************************************************
; Enumerate modules
; Entry:  R0 Reason code
;         R1 module number
;         R2 incarnation number
; Exit:   R1, R2 updated to refer to next existing module
;         R3 -> module code
;         R4    private word contents
;         R5 -> postfix string

Module_GetNames  ROUT
         TEQP    PC, #SVC_mode               ; interrupts on
         MOV     R11, R1
         MOV     R12, R2
         MOV     R10, #Module_List
01       LDR     R10, [R10, #Module_chain_Link]
         CMP     R10, #0
         BEQ     %FT10                       ; no more modules
         SUBS    R11, R11, #1
         BPL     %BT01
         LDR     R3, [R10, #Module_code_pointer]
         ADD     R10, R10, #Module_incarnation_list
02       LDR     R10, [R10, #Incarnation_Link]
         CMP     R10, #0
         BEQ     %FT11                       ; no more incarnations
         SUBS    R12, R12, #1
         BPL     %BT02
         LDR     R4, [R10, #Incarnation_Workspace]
         ADD     R5, R10, #Incarnation_Postfix
         LDR     R10, [R10, #Incarnation_Link]
20       CMP     R10, #0
         ADDNE   R2, R2, #1
         MOVEQ   R2, #0
         ADDEQ   R1, R1, #1
         ExitSWIHandler

10       ADR     R0, ErrorBlock_NoMoreModules
       [ International
         B       BumDealInModule_Translate
       |
         B       BumDealInModule
       ]
         MakeErrorBlock NoMoreModules

11       CMP     r2, #0
         LDREQ   r4, =&DEADDEAD
         MOVEQ   r10, #0
         BEQ     %BT20         ; fudge for modules that go bang in init/die
         ADR     R0, ErrorBlock_NoMoreIncarnations
       [ International
         B       BumDealInModule_Translate
       |
         B       BumDealInModule
       ]
         MakeErrorBlock NoMoreIncarnations
         LTORG

;*************************************************************

Module_ExtendBlock ROUT
         Push   "R0, r1, R3, lr"

         ADD     R3, R3, #15
         BIC     R3, R3, #15

         MOV     R0, #HeapReason_ExtendBlock
         BL      DoRMAHeapOpWithExtension

         STRVS   R0, [stack]
         Pull   "R0, r1, R3, lr"
         B       SLVK_TestV

;*************************************************************
; New Incarnation
;    R1 -> module%newpostfix

Module_NewIncarnation ROUT
         Push   "R0-R4, R9, lr"
         TEQP    PC, #SVC_mode
         BL      LookUp_Module
         BEQ     CheckTheROM
         CMP     R12, #0
         BEQ     Incarnation_needed
         BGT     Incarnation_exists
         MOV     R9, R0                      ; node pointer
         MOV     R0, R1                      ; postfix
         MOV     R10, R1
         BL      EnvStringSkipName           ; envstring ptr in R10
         BL      Add_Incarnation
01       STRVS   R0, [stack]
         Pull   "R0-R4, R9, lr"
         B      SLVK_TestV

CheckTheROM
         MOV     R0, #Postfix_Separator      ; passed string must have postfix
         BL      AddModuleIfInROM
         B       %BT01

Incarnation_needed
         Pull   "R0-R4, R9, lr"
         ADR     R0, ErrorBlock_PostfixNeeded
       [ International
         B       BumDealInModule_Translate
       |
         B       BumDealInModule
       ]
         MakeErrorBlock PostfixNeeded

Incarnation_exists
         Pull   "R0-R4, R9, lr"
         ADR     R0, ErrorBlock_IncarnationExists
       [ International
         B       BumDealInModule_Translate
       |
         B       BumDealInModule
       ]
         MakeErrorBlock IncarnationExists

;*************************************************************
; Rename Incarnation
; R1 -> current module title
; R2 -> new postfix.

Module_RenameIncarnation ROUT
         Push   "R0-R4, R9, lr"
         BL      lookup_commoned
         BVS     %FT01

; R12 -> incarnation node    (0 for not specified)
; R3  -> previous incarnation

         MOV     R11, R12
         MOV     R0, R9                      ; check incarnation
         LDR     R1, [stack, #4*2]           ; not already there
 [ Fix12
         Push    R3                          ; preserve pointer to
         BL      FindIncarnation
         Pull    R3                          ; previous incarnation
 |
         BL      FindIncarnation
 ]
         BNE     %FT03                       ; already exists
         MOV     R12, R11

         CMP     R12, #0
         ADDEQ   R3, R9, #Module_incarnation_list
         LDREQ   R12, [R9, #Module_incarnation_list]
         MOV     R11, R3

         ADD     R1, R12, #Incarnation_Postfix
         BL      %FT10                       ; old postfix length -> R0
         MOV     R10, R0
         LDR     R1, [stack, #4*2]           ; new postfix
         BL      %FT10                       ; new length - > R0
         SUB     R3, R0, R10

         MOV     R2, R12                     ; incarnation node
         MOV     R0, #HeapReason_ExtendBlock
         BL      DoSysHeapOpWithExtension
         BVS     %FT01

         STR     R2, [R11, #Incarnation_Link] ; relink
         ADD     R2, R2, #Incarnation_Postfix
         LDR     R1, [stack, #4*2]
02       LDRB    R0, [R1], #1
         CMP     R0, #" "
         MOVLE   R0, #0
         STRB    R0, [R2], #1
         BGT     %BT02
01       STRVS   R0, [stack]
         Pull   "R0-R4, R9, lr"
         B      SLVK_TestV

03       ADR     R0, ErrorBlock_IncarnationExists
       [ International
         Push   "LR"
         BL     TranslateError
         Pull   "LR"
       |
         SETV
       ]
         B       %BT01

10       MOV     R0, #0
11       LDRB    R3, [R1, R0]
         CMP     R3, #" "
         ADDGT   R0, R0, #1
         BGT     %BT11
         MOV     PC, lr

;*************************************************************
; MakePreferred
;   R1 -> name

Module_MakePreferred ROUT
        Push    "R0-R4, R9, lr"
        BL      lookup_commoned
        BVS     %FT01
        BLGT    PreferIncarnation       ; only prefer it if found!
01
 [ Fix13
        STRVS   R0, [sp, #0]
 ]
        Pull    "R0-R4, R9, lr"
        B       SLVK_TestV

;*************************************************************
; AddPoduleModule
;
; in:   R1 -> envstring
;       R2 = chunk number
;       R3 = podule number
;
; out:  All registers preserved

Module_AddPoduleModule ENTRY
        TEQP    pc, #SVC_mode                   ; interrupts on
        BL      APMEntry
        PullEnv
        B       SLVK_TestV

APMEntry ENTRY "r0-r7,r9"
        MOV     r0, r2
        SWI     XPodule_EnumerateChunksWithInfo ; out: r1=size, r2=type, r4->name, r5->help string, r6=module address if in ROM
        BVS     %FT99
        CMP     r2, #OSType_Module
        BNE     %FT98

        MOV     r7, r3
        MOV     r5, #0                          ; indicate not a ROM module (although strictly speaking, it is!)
APMInitEntry
        Push    "r1"                            ; size
        MOV     r1, r4
        BL      LookUp_Module                   ; check for duplicate
        BLNE    KillAndFree
        Pull    "r3"                            ; get size back
        BVS     %FT99

        MOVS    r1, r6                          ; if module address non-zero, then it's a directly executable ext. ROM
        BNE     %FT10                           ; and don't claim a block, or read the chunk

        BL      RMAClaim_Chunk
        BVS     %FT99
        LDR     r0, [stack, #4*2]
        LDR     r3, [stack, #4*3]
        SWI     XPodule_ReadChunk
        MOV     r1, r2                          ; r1 = address of module
10
        LDR     r2, [r1, #-4]                   ; r2 = size
        BLVC    CheckHeader
        BVS     %FT97                           ; free space too (doesn't matter that it fails for extension ROM)

        MOV     r9, r1
        LDR     r10, [stack, #4]                ; envptr

        MOVS    r3, r7                          ; if not a podule (r7 < 0)
        MOVMI   r11, #0                         ; then use hardware address zero
        BMI     %FT20
        Push    "r1"                            ; else compute hardware address from 'fake' podule number
        SWI     XPodule_HardwareAddresses       ; get raw hardware address for podule r3 into r0 (r1 = combined)
        Pull    "r1"
        BVS     %FT97
        MOV     r11, r0                         ; move into r11
20
        BL      LinkAndInit
        STRVC   r5, [r9, #Module_ROMModuleNode] ; store zero or pointer to ROM module node (if no error in init)
99
        STRVS   r0, [stack]
        EXIT

98
        ADR     r0, ErrorBlock_ChunkNotRM
      [ International
        BL      TranslateError
      ]
96
        SETV
        B       %BT99
        MakeErrorBlock ChunkNotRM

97
        MOV     r2, r1                          ; free claimed RMA space
        MOV     r1, #RMAAddress
        Push    "r0"
        MOV     r0, #HeapReason_Free
        SWI     XOS_Heap
        Pull   "r0"
        B       %BT96

        LTORG

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; LookupName
;    Take module name, return info on it suitable for use with Enumeration
;      (e.g. to get all incarnations of it)
;  In :   R1 -> name
;  Out:   R1 module number          \  of THIS module; first enumerate
;         R2 incarnation number     /  call will give back this module
;         R3 -> module code
;         R4    private word contents
;         R5 -> postfix string

Module_LookupName ROUT
         Push   "R0-R4, R9, lr"
         BL      lookup_commoned
         BVC     %FT01
         STR     R0, [stack]
         Pull   "R0-R4, R9, lr"
         B      SLVK_SetV

01       MOV     R1, #0               ; module number
         MOV     R0, #Module_List

; R9  -> module chain node
; R12 -> incarnation node    (0 for not specified, -1 for not found)

         LDREQ   R12, [R9, #Module_incarnation_list]  ; preferred inc.

02       LDR     R0, [R0]
         CMP     R0, R9
         ADDNE   R1, R1, #1
         BNE     %BT02
         ADD     R0, R0, #Module_incarnation_list
         MOV     R2, #0
03       LDR     R0, [R0]
         CMP     R0, R12
         ADDNE   R2, R2, #1
         BNE     %BT03
         LDR     R3, [R9, #Module_code_pointer]
         LDR     R4, [R12, #Incarnation_Workspace]
         ADD     R5, R12, #Incarnation_Postfix
         LDR     r0, [sp], #5*4            ; Load r0, skip r1-r4
         Pull   "R9, lr"
         ExitSWIHandler

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; EnumerateROM_Modules and EnumerateROM_ModulesWithInfo
;
;  In :   R1 = module number
;         R2 = -1    => ROM
;            = other => Podule R2
;
;  Out:   R1 = incremented: next call will return next module
;         R2 = preserved
;         R3 -> name
;         R4 = -1 => unplugged
;            =  0 => inserted but not currently in the module chain
;            =  1 => active
;            =  2 => running
;         R5 =  chunk number of podule RM
;         If R0 = ModHandReason_EnumerateROM_ModulesWithInfo then
;          R6 = BCD version number of module (decimal point between top and bottom half-words)

Module_EnumerateROM_Modules ROUT
Module_EnumerateROM_ModulesWithInfo ROUT
        LDR     r12, =ROMModuleChain
        MOV     r10, r1                                 ; module count
10
        LDR     r12, [r12, #ROMModule_Link]             ; follow link to next module
        TEQ     r12, #0                                 ; if no more modules
        ADREQL  r0, ErrorBlock_NoMoreModules
      [ International
        Push    "lr",EQ
        BLEQ    TranslateError
        Pull    "lr",EQ
      ]
        BEQ     SLVK_SetV                               ; then report error
        LDR     r11, [r12, #ROMModule_PoduleNumber]
        CMP     r2, #-1                                 ; if searching for podule -1, then this one must be ">="
        BEQ     %FT30
        BGT     %FT20                                   ; searching from normal podules onwards

; searching from extension ROMs onwards

        CMP     r11, r2                                 ; so if r11 > r2 then not there yet
        BGT     %BT10

; searching from normal podules onwards

20
        CMP     r11, #-1                                ; if found one is extension ROM
        BLT     %FT30                                   ; then will be OK
        CMP     r11, r2                                 ; else is only OK if r11 >= r2
        BLT     %BT10
30
        CMP     r11, r2                                 ; check for equality
        MOVNE   r1, #0                                  ; if not correct podule then this is the one to return
        BNE     %FT50

        SUBS    r10, r10, #1                            ; decrement module count
        BCS     %BT10                                   ; not there yet, so go back
50
        Push    "r0-r2, lr"
        LDR     r10, [r12, #ROMModule_CMOSAddrMask]     ; get CMOS address and mask
        ANDS    r2, r10, #&FF                           ; extract address
        MOVNE   r1, r2                                  ; if there is a CMOS address
        MOVNE   r0, #ReadCMOS
        SWINE   XOS_Byte                                ; then read it
        TST     r2, r10, LSR #16                        ; test bit
        Pull    "r0-r2"
        Push    "r8, r9"
        MOVNE   r4, #-1                                 ; indicate unplugged
        BNE     %FT90

; not unplugged, so check for module in module list

        MOV     r4, #Module_List
60
        LDR     r4, [r4, #Module_chain_Link]
        TEQ     r4, #0                                  ; module not active
        BEQ     %FT90
        LDR     r11, [r4, #Module_ROMModuleNode]        ; get active module's pointer to ROM module node
        TEQ     r11, r12                                ; if it matches
        BNE     %BT60
        LDR     r10, [r4, #Module_code_pointer]         ; get pointer to code
        MOV     r11, #0
        LDR     r11, [r11, #Curr_Active_Object]
        LDR     r4, [r10, #-4]                          ; node size of code
        ADD     r4, r4, r10
        CMP     r11, r10
        CMPCS   r4, r11
        MOVHI   r4, #2                                  ; indicate running
        MOVLS   r4, #1                                  ; indicate just active
90
        LDR     r2, [r12, #ROMModule_PoduleNumber]      ; reload podule number
        CMP     r2, #-1                                 ; if not main ROM
        LDRNE   r5, [r12, #ROMModule_ChunkNumber]       ; then load chunk number
        LDR     r3, [r12, #ROMModule_Name]              ; load pointer to name
        ADD     r1, r1, #1                              ; move module number onto next one
        TEQ     r0, #ModHandReason_EnumerateROM_ModulesWithInfo
        LDREQ   r6, [r12, #ROMModule_Version]
        Pull    "r8, r9, lr"                            ; restore registers
        ExitSWIHandler                                  ; and exit

;*************************************************************
; Support routines.
;
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Load_Module
;     takes filename pointer in R1, and loads and initialises the given file.
;     Returns R9 as a pointer to the node claimed
;     and  V/current error set if fails

Load_Module ROUT

        Push   "R0-R5, lr"

        MOV     r0, #OSFile_ReadInfo
        SWI     XOS_File
        BVS     modfailxit              ; return FileSwitch error
        CMP     r0, #object_file
        BNE     HeNotFile

        BIC     R2, R2, #&FF            ; low byte ignored by me.
        CMP     R2, #Module_LoadAddr
        BNE     NotAModule

; it's a module, so try and claim.
        MOV     R10, R1                 ; keep string pointer
        MOV     R3, R4                  ; size of vector needed
        BL      RMAClaim_Chunk
        BVS     modfailxit

02      MOV     R9, R2                  ; keep a copy of node ptr.
        MOV     R1, R10
        MOV     R3, #0                  ; load to R2 posn
        MOV     R0, #OSFile_Load
        SWI     XOS_File
        BVS     modfailxit              ; return FileSwitch error

50      MOV     R11, #0                 ; not loaded from hardware.

; R9 address, R9!-4 size
        MOV     R1, R9
        LDR     R2, [R9, #-4]
        BL      CheckHeader
        BVS     Duplicate_Immortal      ; actually means naff header field

; now we've got it, see if any other modules have the same name.

        LDR     R1, [R9, #Module_Title]
        ADD     R1, R1, R9
        BL      LookUp_Module
        BEQ     %FT01                   ; no module at all
        CMP     R12, #0
        BNE     nopostfixwanted         ; postfix given: bad name
        BL      KillAndFree
        BVS     Duplicate_Immortal

; now claim a link
; R9 module pointer, R10 environment

01      BL      EnvStringSkipName
        BL      LinkAndInit             ; takes R2 prevnode from lookup

        STRVS   R0, [stack]
        Pull   "R0-R5, pc"

Duplicate_Immortal                      ; free space claimed for loading
        STR     R0, [stack]
        MOV     R2, R9
        MOV     R0, #HeapReason_Free
        MOV     R1, #RMAAddress
        SWI     XOS_Heap
        Pull   "R0-R5, lr"
        ORRS    PC, lr, #V_bit

        MakeErrorBlock MHNoRoom

nopostfixwanted
        ADR     R0, ErrorBlock_ModulePostfix
      [ International
        BL      TranslateError
      ]
        B       modfailxit

        MakeErrorBlock ModulePostfix

        MakeErrorBlock NotMod

NotAModule
        ADR     R0, ErrorBlock_NotMod
      [ International
        BL      TranslateError
      ]
modfailxit
        STR     R0, [stack]
        Pull   "R0-R5, lr"
        ORRS    PC, lr, #V_bit

HeNotFile
        MOV     r2, r0
        MOV     r0, #OSFile_MakeError
        SWI     XOS_File
        B       modfailxit

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ModuleIn_CheckForDuplicate
; Altentry to Load_Module for AddArea: module already in, initialise it.

ModuleIn_CheckForDuplicate
         Push   "R0-R5, lr"
         MOV     R9, R1           ; move module ptr to handy place
         B       %BT50

;*************************************************************
; AddModuleIfInROM
; in: R1 -> name
;     R0 = Postfix_Separator => called from AddNewIncarnation when module is not active
;                               find newest version in ROM, and initialise it in its own location (even if unplugged)
;                               then rename the base incarnation of it to specified postfix
;
;        = 0                 => called from ReInit when module is not active
;                               plug in all versions of module, and initialise newest one in its own location
;
; out: R5-R8 preserved
;      Other registers may be corrupted
;

AddModuleIfInROM ENTRY "r5-r8"
        MOV     r4, r0
        MOV     r12, #0                                 ; search entire ROM set
        MOV     r7, r1                                  ; save pointer to beginning of name
        BL      FindROMModule
        TEQ     r12, #0
        BNE     %FT10
        BL      MakeNotFoundError                       ; in:  r1 -> module name 'foo'
                                                        ; out: r0 -> "Module 'foo' not found" error, V=1
        EXIT

10
        MOV     r6, r1                                  ; save pointer to terminator of module name
15
        LDR     r14, [r12, #ROMModule_OlderVersion]     ; find oldest version
        TEQ     r14, #0
        MOVNE   r12, r14
        BNE     %BT15

20
        TEQ     r4, #0                                  ; if doing AddIncarnation rather than ReInit
        BNE     %FT30                                   ; then don't plug module in
        MOV     r5, #&FF                                ; set up byte mask (and indicate found)
        LDR     r1, [r12, #ROMModule_CMOSAddrMask]
        AND     r3, r5, r1, LSR #16                     ; get bit mask
        ANDS    r1, r1, r5
        BEQ     %FT30                                   ; if no CMOS, then look for another module
        MOV     r0, #ReadCMOS
        SWI     XOS_Byte
        EXIT    VS
        TST     r2, r3                                  ; test if module unplugged
        BEQ     %FT30                                   ; if not, then don't write to CMOS (so RMReInit works when FSLock enabled)
        BIC     r2, r2, r3                              ; otherwise clear bit
        MOV     r0, #WriteCMOS
        SWI     XOS_Byte
        EXIT    VS
30
        LDR     r14, [r12, #ROMModule_NewerVersion]
        TEQ     r14, #0
        MOVNE   r12, r14
        BNE     %BT20

        TEQ     r4, #0                                  ; if AddIncarnation then check that name terminator is "%"
        LDRNEB  r14, [r6], #1                           ; load next character (and skip it)
        TEQNE   r14, #Postfix_Separator
        BEQ     %FT40
        ADRL    r0, ErrorBlock_PostfixNeeded
      [ International
        BL      TranslateError
      |
        SETV
      ]
        EXIT

40
        MOV     r11, r12
        BL      InitialiseROMModule                     ; in both cases initialise newest version
                                                        ; (in AddIncarnation case it may still be unplugged)
        EXIT    VS

        TEQ     r4, #0                                  ; if ReInit then we've finished (V=0 from above)
        EXIT    EQ

        SUB     r8, r6, r7                              ; length of module name including '%'
        ADD     r8, r8, #4+1+3                          ; allow for 'Base<0>' and round up to whole number of words
        BIC     r8, r8, #3
        SUB     stack, stack, r8

        MOV     r0, stack
50
        LDRB    r14, [r7], #1                           ; copy name, including '%'
        STRB    r14, [r0], #1
        TEQ     r7, r6
        BNE     %BT50

        ADR     r1, base_postfix
60
        LDRB    r14, [r1], #1                           ; copy 'Base<0>'
        STRB    r14, [r0], #1
        TEQ     r14, #0
        BNE     %BT60

        MOV     r0, #ModHandReason_RenameIncarnation
        MOV     r1, stack                               ; pointer to '<module>%Base<0>'
        MOV     r2, r6                                  ; pointer to 'newinc'
        SWI     XOS_Module
        ADD     stack, stack, r8                        ; junk name
        EXIT

;*************************************************************
; LinkAndInit :
;     module pointer in R9
;     module list position in R2 : added at end if posn not found
;     environment string pointer in R10
;    "hardware" in R11
;     returns module node pointer in R9

LinkAndInit ENTRY "r2, r3"
        MOV     r3, #ModInfo
        BL      ClaimSysHeapNode
        EXIT    VS

        STR     r9, [r2, #Module_code_pointer]
        STR     r11, [r2, #Module_Hardware]
        MOV     r9, r2                                  ; keep node pointer

        MOV     r0, #0
        STR     r0, [r2, #Module_ROMModuleNode]         ; assume not a ROM module
        STR     r0, [r2, #Module_incarnation_list]      ; terminate list
        ADR     r0, base_postfix
        BL      Add_Incarnation                         ; add Base incarnation
        BVS     %FT01

        Pull    "r2"
        ADR     r0, Module_List
05
        LDR     r1, [r0]
        CMP     r1, #0
        CMPNE   r0, r2
        MOVNE   r0, r1
        BNE     %BT05

; add module to chain end - give ROM modules priority.

        STR     r1, [r9, #Module_chain_Link]
        STR     r9, [r0, #Module_chain_Link]
        Pull    "r3, pc"                                ; V clear from EQ compare with 0

01
        Push    "r0"
        LDR     r2, [r9, #Module_code_pointer]
        MOV     r1, #RMAAddress
        MOV     r0, #HeapReason_Free
        SWI     XOS_Heap
        MOV     r2, r9                                  ; node pointer
        BL      FreeSysHeapNode
        Pull    "r0, r2, r3, lr"
        ORRS    pc, lr, #V_bit

base_postfix
        =       "Base",0                                ; postfix used for 1st incarnation
        ALIGN

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Add_Incarnation
;       takes postfix pointer in R0 (terminated by <= space
;       module node pointer in R9
;       envstring in R10
;   Adds an incarnation node, reinitialises the module

Add_Incarnation  ROUT
         Push   "R0-R3, lr"

         MOV     R3, #Incarnation_Postfix      ; node size needed
01       LDRB    R1, [R0], #1
         ADD     R3, R3, #1
         CMP     R1, #" "
         BGT     %BT01
         BL      ClaimSysHeapNode
         STRVS   R0, [stack]
         Pull   "R0-R3, PC", VS

         LDR     R0, [stack]
         ADD     R3, R2, #Incarnation_Postfix
02       LDRB    R1, [R0], #1
         CMP     R1, #" "
         STRGTB  R1, [R3], #1
         BGT     %BT02
         MOV     R1, #0
         STRB    R1, [R3]

         MOV     R3, #0
         STR     R3, [R2, #Incarnation_Workspace] ; zero private word
         MOV     R12, R2
         BL      CallInit
;         BLVS    FreeIncarnation done by CallInit
         STRVS   R0, [stack]

         LDRVC   R3, [R9, #Module_incarnation_list]
         STRVC   R3, [R2, #Incarnation_Link]
         STRVC   R2, [R9, #Module_incarnation_list]
         Pull   "R0-R3, PC"

;*************************************************************
CallInit         ROUT
;    take R9  -> module node
;         R12 -> incarnation node
;         R10 -> envstring
;    set R11 appropriately
;    initialise module with R10 given

        Push   "R0-R6, R11, R12, lr"

 [ SqueezeMods
        BL      CheckForSqueezedModule                  ; unsqueeze module if squeezed
        BVS     %FT02
 ]

  ; see if we need to set up a module swi node

        BL      CheckForSWIEntries
        LDR     R12, [stack, #4*(6+2)]
        BNE     %FT03

  ; the module really does have a SWI chunk. Add node to hashtable.

        MOV     R4, R0
        MOV     R11, R1
        MOV     R3, #ModSWINode_Size
        BL      ClaimSysHeapNode
        BVS     %FT02
        STR     R9,  [R2, #ModSWINode_MListNode]
        STR     R4,  [R2, #ModSWINode_CallAddress]
        STR     R11, [R2, #ModSWINode_Number]
        ModSWIHashvalOffset R11
        LDR     R6, [R11, #ModuleSWI_HashTab]!  ;  link into table.
        STR     R6, [R2, #ModSWINode_Link]
        STR     R2, [R11]

03  ; now prepared to look at module

        LDR     R3, [R9, #Module_code_pointer]

 [ StrongARM
        LDR     R4, [R9, #Module_ROMModuleNode]
        CMP     R4, #0
        BNE     %FT04                           ;It's a ROM module, so it already knows it's code
        Push    "r0-r2"
        LDR     r4, [r3, #-4]                   ;Read the length of the module from the RMA.
        MOV     r0, r3                          ;start address
        MOV     r2, r4                          ;length
        MOV     r1, #&B9                        ;Service_ModulePreInit ; a chance to patch things
        SWI     XOS_ServiceCall
        MOV     r0, #1                          ;It's a ranged synchronisation
        MOV     r1, r3                          ;Start address
        ADD     r2, r3, r4                      ;End address
        SWI     XOS_SynchroniseCodeAreas
        Pull    "r0-r2"
04
 ]

        LDR     R4, [R3, #Module_Init]
        CMP     R4, #0
        Pull   "R0-R6, R11, R12, PC", EQ      ; V clear

        ADD     R12, R12, #Incarnation_Workspace
        MOV     R11, #0
        ADD     R5, R9, #Module_incarnation_list - Incarnation_Link
01      LDR     R5, [R5, #Incarnation_Link]
        CMP     R5, #0                        ; count incarnations
        ADDNE   R11, R11, #1
        BNE     %BT01
        CMP     R11, #0
        LDREQ   R11, [R9, #Module_Hardware]

  ; R11, R12 now set: initialise

        MOV     lr, PC                        ; pseudo BL
        ADD     PC, R3, R4                    ; call 'im

        Pull   "R0-R6, R11, R12, lr", VC
        BICVCS  PC, lr, #V_bit

02      LDR     R12, [stack, #4*(6+2)]
        BL      FreeIncarnation
        BL      FreeSWIEntry
        STR     R0, [stack]
        Pull   "R0-R6, R11, R12, PC"           ; V set return

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Enter with module pointer in R1
;              "    size    in R2

CheckHeader ROUT
        Push   "R3, lr"
        LDR     R3, [R1, #Module_HC_Table]
        BL      %FT11
        LDR     R3, [R1, #Module_HelpStr]
        BL      %FT11
        LDR     R3, [R1, #Module_Title]
        BL      %FT11
        LDR     R3, [R1, #Module_Service]
        BL      %FT10
        LDR     R3, [R1, #Module_Die]
        BIC     R3, R3, #&80000000              ; ignore top-bit (means cannot be RMCleared)
        BL      %FT10
        LDR     R3, [R1, #Module_Init]
        TST     R3, #&80000000
        BLEQ    %FT10                           ; only check init offset if an unsqueezed module
        Pull   "R3, lr"
        BICS    PC, lr, #V_bit

10      TST     R3, #3
        BNE     %FT99
11      CMP     R3, R2
        MOVLO   PC, lr
99
        Pull   "R3, lr"
        ADR     R0, ErrorBlock_BadRMHeaderField
      [ International
        Push    "lr"
        BL      TranslateError
        Pull    "lr"
      ]
        ORRS    PC, lr, #V_bit
        MakeErrorBlock BadRMHeaderField

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Enter with module node pointer in R9
; Sets R12 to module code pointer, R0 SWI code offset, R1 to SWI number
; Only returns SWIs extant if no incarnations of module yet

CheckForSWIEntries ROUT
         LDR     R12, [R9, #Module_incarnation_list]
         CMP     R12, #0
         LDREQ   R12, [R9, #Module_code_pointer]
         LDREQ   R1, [R12, #Module_SWIChunk]
         BICEQ   R1, R1, #Auto_Error_SWI_bit
         TSTEQ   R1, #Module_SWIChunkSize-1
         TSTEQ   R1, #&FF000000
         MOVNE   PC, lr                         ; naff chunk number.
         CMP     R1, #0
         LDRNE   R0, [R12, #Module_SWIEntry]
         CMPNE   R0, #0
         BEQ     %FT01
         TST     R0, #3
         MOVNE   PC, lr
         Push   "R5"
         LDR     R5, [R12, #-4]
         CMP     R5, R0
         Pull   "R5"
01       BICLSS  PC, lr, #Z_bit                 ; NE return
         ADD     R0, R0, R12
         ORRS    PC, lr, #Z_bit                 ; EQ for success

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Takes R9 pointer to module node; frees any module SWI hashtab node

FreeSWIEntry ROUT
         Push   "R0-R4, R12, lr"
         BL      CheckForSWIEntries
         Pull   "R0-R4, R12, PC", NE, ^
         MOV     R3, R1                ; copy of SWIno
         ModSWIHashval R1
         LDR     R2, [R1], #-ModSWINode_Link

  ; R1 predecessor, R2 currnode, R0 call address, R3 SWIno
  ; look down chain until find right call address and number
01       CMP     R2, #0
         Pull   "R0-R4, R12, PC", EQ, ^
         LDR     R4, [R2, #ModSWINode_CallAddress]
         CMP     R4, R0
         LDREQ   R4, [R2, #ModSWINode_Number]
         CMPEQ   R4, R3
         MOVNE   R1, R2
         LDRNE   R2, [R2, #ModSWINode_Link]
         BNE     %BT01
         LDR     R4, [R2, #ModSWINode_Link]
         STR     R4, [R1,#ModSWINode_Link]
         BL      FreeSysHeapNode
         Pull   "R0-R4, R12, PC",,^

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

FreeIncarnation  ROUT
  ; copy error, free any workspace, incarnation link.
  ;   R12 incarnation pointer
         Push   "R0-R2, lr"
         BL      Module_CopyError
         STR     R0, [stack]
         LDR     R2, [R12, #Incarnation_Workspace]
         CMP     R2, #0
         MOV     R0, #HeapReason_Free
         MOV     R1, #RMAAddress
         SWINE   XOS_Heap
         MOV     R2, R12
         BL      FreeSysHeapNode
         Pull   "R0-R2, PC",,^

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; KillAndFree:
;      R0 -> module
;      R2 -> prevmodule
;  Kills all incarnations, frees all space.

KillAndFree      ROUT
         Push   "R2, R3, R9, R12, lr"
         MOV     R9, R0
         ADDS    R3, R9, #Module_incarnation_list  ; ensure V clear
01       LDR     R12, [R9, #Module_incarnation_list]
         BL      KillIncarnation
         Pull   "R2, R3, R9, R12, PC", VS
         CMP     R9, #0
         BNE     %BT01                      ; more incarnations yet
         Pull   "R2, R3, R9, R12, PC"

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; KillIncarnation
;     R9  module ptr
;     R12 incarnation ptr
;     R3  previous incarnation
;     R2  previous module
; Exit: R9 zeroed if module completely gone
;
KillIncarnation  ROUT
         Push   "R0-R2, R10, lr"
         MOV     R10, #1                     ; fatal die
         CMP     r12, #0                     ; fudge for 0 incarnations:
         BLNE    CallDie                     ; tidy up anyway
         STRVS   R0, [stack]
         Pull   "R0-R2, R10, PC", VS

         MOV     R2, R12
         BL      FreeSysHeapNode                ; free incarnation node
01       LDR     R0, [R9, #Module_incarnation_list]
         CMP     R0, #0                      ; last incarnation?
         LDREQ   R2, [stack, #2*4]
         BLEQ    DelinkAndFreeModule
         MOVEQ   R9, #0
         Pull   "R0-R2, R10, PC",,^

LoseModuleSpace_if_its_the_only_incarnation
         Push   "R0-R2, R10, lr"
         B       %BT01

;*************************************************************
; CallDie
;    take R9  -> module node
;         R12 -> incarnation node
;         R3  -> previous incarnation
;         R10 =  fatality
; check against CAO
; delink incarnation, issue die, deal with workspace.

CallDie ROUT
         Push   "R0-R6, R11, R12, lr"

         MOV     R11, #0
         LDR     R11, [R11, #Curr_Active_Object]

 ; check killability

         LDR     R0,  [R9, #Module_code_pointer]
         BL      %FT10                        ; is_CAO?
         BLT     %FT04                        ; code block is CAO

 ; check if workspace block could be CAO: may have handler in there

         LDR     R0, [R12, #Incarnation_Workspace]
         BL      %FT20                        ; check block before getting size
         BVS     ModuleIsntCAO                ; not heap block - we don't
         BL      %FT10                        ; know what's going on.
         BGE     ModuleIsntCAO                ; not CAO

04       CMP     R10, #0                      ; fatal?
         BNE     CantKill
         LDR     R0, [R12, #Incarnation_Workspace]
         BL      %FT20
         BVS     ModuleIsntCAO                ; soft die of non-heap module OK
CantKill
         ADR     R0, ErrorBlock_CantKill
       [ International
         BL      TranslateError
       ]
01       STR     R0, [stack]
         LDR     R3, [stack, #4*3]
         LDR     R12, [stack, #4*(6+2)]
         STR     R12, [R3, #Incarnation_Link] ; relink
         Pull   "R0-R6, R11, R12, lr"
         ORRS    PC, lr, #V_bit
         MakeErrorBlock CantKill

ModuleIsntCAO
         MOV     R11, #0                     ; set R11 to incarnation number.
         LDR     R0, [R9, #Module_incarnation_list]
03       CMP     R0, R12
         ADDNE   R11, R11, #1
         LDRNE   R0, [R0, #Incarnation_Link]
         BNE     %BT03

         LDR     R0, [R12, #Incarnation_Link]
         STR     R0, [R3, #Incarnation_Link] ; delink
         ADD     R12, R12, #Incarnation_Workspace
         LDR     R1, [R9, #Module_code_pointer]
         LDR     R0, [R1, #Module_Die]
         BIC     R0, R0, #&80000000          ; knock out invincibility bit
         CMP     R0, #0                      ; WARNING: don't try to combine these 2 instructions in a BICS, V is used below
         MOV     lr, PC
         ADDNE   PC, R1, R0                  ; call.
         BVS     %BT01
         BL      FreeSWIEntry

         CMP     R10, #0                     ; soft die?
         BEQ     %FT02

         LDR     R12, [stack, #4*(6+2)]
         LDR     R2, [R12, #Incarnation_Workspace]
         CMP     R2, #0
         MOVNE   R1, #RMAAddress
         MOVNE   R0, #HeapReason_Free
         SWINE   XOS_Heap
         MOV     R0, #0
         STR     R0, [R12, #Incarnation_Workspace]   ; orgone
02
         Pull   "R0-R6, R11, R12, lr"
         BICS    PC, lr, #V_bit

; check if block @ R0 contains address R11
10       LDR     R1, [R0, #-4]
         ADD     R1, R1, R0
         CMP     R0, R11
         CMPLS   R11, R1
         MOV     PC, lr                      ; return LT for Yes

; check block @ R0 is a valid RMA heap block
20
         Push   "R0-R3, lr"
         MOV     R2, R0
         MOV     R0, #HeapReason_ExtendBlock
         MOV     R1, #RMAAddress
         MOV     R3, #0
         SWI     XOS_Heap
         Pull   "R0-R3, PC"                 ; V set if not.

;*************************************************************
; DelinkAndFreeModule
;       R9 -> Module
;       R2 -> prevmodule

DelinkAndFreeModule ROUT
        Push    "R0-R2, lr"

;   loop here to find predecessor; make death re-entrant
        MOV     R0, #Module_List
01
        LDR     R1, [R0, #Module_chain_Link]
        CMP     R1, R9
        MOVNE   R0, R1
        BNE     %BT01

        LDR     R1, [R9, #Module_chain_Link]
        STR     R1, [R0, #Module_chain_Link] ; delinked

        LDR     R2, [R9, #Module_code_pointer]
        MOV     R1, #RMAAddress
        MOV     R0, #HeapReason_Free
        SWI     XOS_Heap

        MOV     R2, R9
        BL      FreeSysHeapNode

        Pull   "R0-R2, PC",,^

;*************************************************************************
;  common lookup for reinit, enter, die

lookup_commoned ROUT
       BIC      lr, lr, #I_bit
       TEQP     PC, #SVC_mode
       Push    "lr"
       BL       LookUp_Module               ; node ptr in R0
       BEQ      %FT01                       ; not found
       CMP      R12, #0
       BLT      %FT02                       ; incarnation not found
       MOV      R9, R0
       Pull    "PC"
01
       ADR      R0, ErrorBlock_RMNotFound
       Push    "r1-r6"
       MOV      r3, #0
       LDR      r3, [r3, #IRQsema]
       CMP      r3, #0
       BNE      %FT03
     [ International
       MOV      R4, R1
       BL       TranslateError_UseR4
       Push     "r0"
     |
       BL       GetOscliBuffer
       Push     r5
       LDR      r2, [r0], #4
       STR      r2, [r5], #4
       BL       rmecopystr
copynfrmname
       LDRB     r2, [r1], #1
       CMP      r2, #32
       STRGTB   r2, [r5], #1
       BGT      copynfrmname

       BL       rmecopystr
       STRB     r2, [r5]                   ; terminate
     ]
       Pull    "r0-r6"


03
       Pull    "lr"
       ORRS     PC, lr, #V_bit
       MakeErrorBlock  RMNotFound
02
       ADR      R0, ErrorBlock_IncarnationNotFound
     [ International
       BL      TranslateError
     ]
       B        %BT03
       MakeErrorBlock  IncarnationNotFound

MakeNotFoundError                         ; r1 -> module name
       Push     lr
       B        %BT01

;*************************************************************
; Lookup_Module
; Entry:  R1  -> module name
; Exit:   R0  -> module chain node   (0 for not found)
;         R1  -> postfix of name
;         R12 -> incarnation node    (0 for not specified, -1 for not found)
;         R2  -> previous module      for potential delinking
;         R3  -> previous incarnation  "      "         "
;         NE for found/EQ for not


LookUp_Module ROUT
         Push   "R4, R5, lr"
         TEQP    PC, #SVC_mode               ; interrupts on
         LDR     R2, =Module_List
01       LDR     R0, [R2, #Module_chain_Link]
         CMP     R0, #0
         Pull   "R4, R5, PC", EQ             ; return if not found
         LDR     R4, [R0, #Module_code_pointer]
         LDR     R3, [R4, #Module_Title]
         ADD     R3, R3, R4                  ; got ptr to title
         MOV     R4, #Postfix_Separator      ; allowed terminator for StrCmp
         BL      Module_StrCmp               ; compare with abbreviation.
         MOVNE   R2, R0
         BNE     %BT01                       ; loop if not found
         LDRB    R4, [R1], #1                ; get terminator
         CMP     R4, #Postfix_Separator
         BEQ     %FT02

   ; now a quick fudge to spot recursive ModHand calls during module death.
         LDR     R12, [R0, #Module_incarnation_list]
         CMP     R12, #0
         MOVEQ   R12, #-1                    ; no incarnations!
         MOVNE   R12, #0                     ; no postfix/incarnation specified
         CMP     PC, #0
         Pull   "R4, R5, PC"                 ; back with NE

02       LDRB    R4, [R1]
         CMP     R4, #" "
         Pull   "R4, R5, lr", LE
         ORRLES  PC, lr, #Z_bit              ; not found: naff postfix
         Push   "R1"                         ; updated value to return
         BL      FindIncarnation
         MOVEQ   R12, #-1                    ; failed to find postfix.
         CMP     PC, #0                      ; force NE
         Pull   "R1, R4, R5, PC"             ; back with NE

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; FindIncarnation
;    R0 is node pointer, need to loop to find incarnation ($R1)
;    Return EQ if not found,
;           NE => R12 -> incarnation, R3 -> previnc

FindIncarnation  ROUT
         Push   "lr"
         ADD     R3, R0, #Module_incarnation_list  ; previnc
03       LDR     R12, [R3, #Incarnation_Link]
         CMP     R12, #0
         Pull   "PC", EQ                     ; failed to find postfix.
 [ Fix9
         Push   "R3,R4"
         ADD     R3, R12, #Incarnation_Postfix
         MOV     R4, #0                      ; no special terminator
         BL      Module_StrCmp
         Pull   "R3,R4"
 |
         Push   "R3"
         ADD     R3, R12, #Incarnation_Postfix
         BL      Module_StrCmp
         Pull   "R3"
 ]
         MOVNE   R3, R12
         BNE     %BT03
         CMP     PC, #0                      ; force NE
         Pull   "PC"

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
;       Module_StrCmp
;
; Do a string comparison, given pointers in R1, R3.
; Ignore case, allow $R1 to be an abbreviation of $R3
; Strings are terminated by ctrl-char, or ASC(R4) for $R1
;
; out:  EQ => match found, R1 -> terminator of R1 string
;       NE => match not found, R1 preserved
;       R3 corrupted in all cases
;

Module_StrCmp ENTRY "r1,r2,r5-r7"
        MOV     r2, #0
01
        LDRB    r7, [r1], #1
        LDRB    r5, [r3], #1
        CMP     r7, r4
        CMPNE   r7, #32
        CMPLE   r5, #32
        BLE     %FT02
        UpperCase r7, r6
        UpperCase r5, r6
        CMP     r7, r5
        ADDEQ   r2, r2, #1
        BEQ     %BT01
        CMP     r2, #0
        MOV     r2, #Z_bit
        TEQP    r2, pc                          ; invert EQ/NE
        CMPEQ   r7, #"."                        ; success if abbreviation
        EXIT    NE
        CMP     r5, #" "                        ; reject abbreviation
        EXIT    LT                              ; after full match
        ADD     r1, r1, #1
02
        SUB     r1, r1, #1
        CMP     r2, #0                          ; reject 0-length match
        MOV     r2, #Z_bit
        TEQP    r2, pc                          ; invert EQ/NE
        STREQ   r1, [stack]                     ; r1 -> terminator
        EXIT                                    ; return with success

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

EnvStringSkipName ROUT
         Push   "R0"
01       LDRB    R0, [R10], #1
         CMP     R0, #" "
         BGT     %BT01
02       LDREQB  R0, [R10], #1
         CMP     R0, #" "
         BEQ     %BT02
         SUB     R10, R10, #1
         Pull   "R0"
         MOV     PC, lr

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; PreferIncarnation
;    R9  -> module node
;    R12 -> incarnation node
;    R3  -> previous incarnation
PreferIncarnation
         Push   "R0"
         LDR     R0,  [R12, #Incarnation_Link]
         STR     R0,  [R3,  #Incarnation_Link]
         LDR     R0,  [R9,  #Module_incarnation_list]
         STR     R0,  [R12, #Incarnation_Link]
         STR     R12, [R9,  #Module_incarnation_list]
         Pull   "R0"
         MOV     PC, R14

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

Module_CopyError ROUT
; grab an oscli buffer for the error,
; rather than having a permanent module buffer
       Push     "R0, R2, R5, R6, lr"
       BL        GetOscliBuffer

       STR       R5, [stack]
       LDR       R2, [R0], #4
       STR       R2, [R5], #4
01     LDRB      R2, [R0], #1
       STRB      R2, [R5], #1
       CMP       R2, #0
       BNE       %BT01
       Pull     "R0, R2, R5, R6, PC"

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;  Claim chunk from RMA : increase RMA if can,
;  force size to multiple of 16 -4 to keep alignment OK

RMAClaim_Chunk   ROUT
         MOV     R0, #HeapReason_Get
         Push   "R0, R3, lr"

         ADD     R3, R3, #15+4               ; now force size to 16*n-4
         BIC     R3, R3, #15                 ; so heap manager always has
         SUB     R3, R3, #4                  ;  4-word aligned blocks

         B       IntoRMAHeapOp

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

DoRMAHeapOpWithExtension
         Push   "R0, R3, lr"

IntoRMAHeapOp
         MOV     R1, #RMAAddress
         SWI     XOS_Heap
         Pull   "R0, R3, PC", VC

         LDR     r14, [r0]                   ; look at error number
         TEQ     r14, #ErrorNumber_HeapFail_Alloc
         STRNE   r0, [stack]
         Pull   "r0, r3, PC", NE            ; can only retry if ran out of room

         Push    r3                         ; in case extension
         LDR     r1, [stack, #4]
         CMP     r1, #HeapReason_ExtendBlock
         BNE     notRMAextendblock
         Push   "r5, r6"
         LDR     r1, [r2, #-4]               ; pick up block size
         ADD     r5, r1, r2                  ; block end +4
         SUB     r5, r5, #4                  ; TMD 02-Aug-93: block size includes size field (optimisation was never taken)
         MOV     r6, #RMAAddress
         LDR     r6, [r6, #:INDEX:hpdbase]
         ADD     r6, r6, #RMAAddress         ; free space
         CMP     r5, r6                      ; does block butt against end?
         ADDNE   r3, r3, r1                  ; max poss size needed
         Pull   "r5, r6"

  ; note that this doesn't cope well with a block at the end preceded by a
  ; free block, but tough.

notRMAextendblock
         MOV     r1, #RMAAddress
         LDR     R0, [R1, #:INDEX: hpdbase]
         LDR     R1, [R1, #:INDEX: hpdend]
         SUB     R1, R1, R0                  ; bytes free
         SUB     R1, R3, R1                  ; bytes needed

         Pull    r3
         ADD     R1, R1, #8                  ; safety factor

         MOV     R0, #1                      ; try and expand RMA.
         SWI     XOS_ChangeDynamicArea
         Pull   "R0"                         ; heap reason code back
         MOV     R1, #RMAAddress
         SWIVC   XOS_Heap
01
         ADRVSL  R0, ErrorBlock_MHNoRoom
       [ International
         Push   "LR",VS
         BLVS    TranslateError
         Pull   "LR",VS
       ]
         Pull   "r3, PC"

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Data

crstring =       13
         ALIGN

;*****************************************************************************
; *Unplug code.

Unplug_Code ENTRY "r7-r9"
        CMP     r1, #0
        BNE     ZapTheModule

; If name not given, list unplugged modules

;       MOV     r1, #0                          ; start with module 0 (r1 is already zero indicating no parameters to command!)
        MOV     r2, #-1                         ; start with main ROMs
        MOV     r7, #0                          ; flag indicating whether we've had any unplugged modules already
10
        MOV     r0, #ModHandReason_EnumerateROM_ModulesWithInfo
        SWI     XOS_Module
        BVS     %FT30                           ; no more, so finish off
        CMP     r4, #-1                         ; is it unplugged?
        BNE     %BT10                           ; no, then go for another one

        MOV     r8, r1                          ; save module and podule numbers
        MOV     r9, r2
        TEQ     r7, #0                          ; if already printed header message
        BNE     %FT20                           ; then skip
      [ International
        BL      WriteS_Translated
        =       "Unp:Unplugged modules are:", 10, 13, 0
        ALIGN
      |
        ADR     r0, AreUnpluggedMessage
        SWI     XOS_Write0
      ]
        EXIT    VS
        MOV     r7, #1
20
        MOV     r0, r3
        SWI     XOS_Write0
        EXIT    VS
        CMP     r2, #-1
        BEQ     %FT25                           ; if a main ROM, then no blurb after name (and V=0)
      [ International
        MOV     r4, r2
      |
        ADRGT   r4, podbra                      ; is a podule module
        ADRLT   r4, extnbra                     ; is an extn rom module
      ]
        MVNLT   r2, r2                          ; so invert number
        SUB     r0, r0, r3                      ; length of module name
        RSB     r0, r0, #24                     ; number of spaces to pad out to column 24 (may be -ve)
21
        SWI     XOS_WriteI + " "                ; always print at least one space
        EXIT    VS
        SUBS    r0, r0, #1
        BGT     %BT21
      [ :LNOT: International
        MOV     r0, r4
        SWI     XOS_Write0
        EXIT    VS
      ]
        SUB     sp, sp, #3*4                    ; make buffer on stack
        MOV     r0, r2
        MOV     r1, sp
        MOV     r2, #3*4
        SWI     XOS_ConvertCardinal4
      [ International
        CMP     r4,#-1
        MOV     r4,r0                           ; r4 -> number
        BLT     %FT23
        BL      WriteS_Translated_UseR4
        =       "Podule:(Podule %0)",0
        ALIGN
        B       %FT24
23
        BL      WriteS_Translated_UseR4
        =       "Extn:(Extn ROM  %0)",0
        ALIGN
24
        ADD     sp, sp, #3*4                    ; restore stack
      |
        SWIVC   XOS_Write0
        ADD     sp, sp, #3*4                    ; restore stack
        SWIVC   XOS_WriteI + ")"
      ]
25
        SWIVC   XOS_NewLine
        MOVVC   r1, r8                          ; restore module and podule number
        MOVVC   r2, r9
        BVC     %BT10
        EXIT

30
        CMP     r7, #0                          ; NB will clear V in any case
      [ International
        BNE     %FT31
        BL      WriteS_Translated
        =       "NoUnp:No modules are unplugged", 10, 13, 0
        ALIGN
31
        EXIT
      |
        ADREQ   r0, NoUnpluggedMessage
        SWIEQ   XOS_Write0
        EXIT                                    ; exit with V=0 unless error in Write0

AreUnpluggedMessage
        =       "Unplugged modules are:", 10, 13, 0
NoUnpluggedMessage
        =       "No modules are unplugged", 10, 13, 0
podbra
        =       "("
rommposp
        =       "Podule ", 0
extnbra
        =       "("
rommposer
        =       "Extn ROM ", 0
        ALIGN
      ]

ZapTheModule
        MOV     r9, #0                          ; indicate unplug, not insert
UnplugInsertEntry
        MOV     r12, #0                         ; search from start of chain
        MOV     r7, r0                          ; name pointer
        MOV     r4, #0                          ; no extra terminator
        MOV     r5, #0                          ; indicate no versions found yet

        MOV     r6, #0                          ; indicate no version found that was initialised
        MOV     r1, r7
        BL      SkipToSpace                     ; leaves r1 pointing to 1st space or control char
        BL      SkipSpaces                      ; leaves r1 -> 1st non-space, r0 = 1st non-space char
        CMP     r0, #&7F
        CMPNE   r0, #" "                        ; if a ctrl char, then
        MOVLS   r8, #&80000000                  ; indicate to unplug all versions
        BLS     %FT40
        CMP     r0, #"-"
        ADDEQ   r1, r1, #1
        MOVEQ   r8, #-1
        MOVNE   r8, #1
        MOV     r0, #1 :SHL: 31                 ; check terminator is control char or space
        SWI     XOS_ReadUnsigned
        EXIT    VS
        MUL     r8, r2, r8                      ; apply sign
40
        MOV     r1, r7
        BL      FindROMModule
        TEQ     r12, #0
        BEQ     %FT60                           ; no versions of this module found, so report error

42
        LDR     r14, [r12, #ROMModule_OlderVersion]     ; find oldest version of this module
        TEQ     r14, #0
        MOVNE   r12, r14
        BNE     %BT42

45
        TEQ     r8, #&80000000                  ; if not doing any old podule
        LDRNE   r14, [r12, #ROMModule_PoduleNumber]
        TEQNE   r14, r8                         ; and podule number doesn't match
        BNE     %FT50                           ; then skip this one

        LDRB    r14, [r12, #ROMModule_Initialised] ; if this version of CODE was initialised then keep pointer to it
        TEQ     r14, #0
        MOVNE   r6, r12                         ; save pointer to it
        MOV     r5, #&FF                        ; set up byte mask (and indicate found)
        LDR     r1, [r12, #ROMModule_CMOSAddrMask]
        AND     r3, r5, r1, LSR #16             ; get bit mask
        ANDS    r1, r1, r5
        BEQ     %FT50                           ; if no CMOS, then look for another module
        MOV     r0, #ReadCMOS
        SWI     XOS_Byte
        EXIT    VS
        TEQ     r9, #0
        ORREQ   r2, r2, r3                      ; set unplug bit
        BICNE   r2, r2, r3                      ; or clear it as appropriate
        MOV     r0, #WriteCMOS
        SWI     XOS_Byte
        EXIT    VS
50
        LDR     r14, [r12, #ROMModule_NewerVersion] ; go to next newer version
        TEQ     r14, #0
        MOVNE   r12, r14
        BNE     %BT45

60
        TEQ     r5, #0                          ; if we've seen any versions, then don't report error
        BNE     %FT70
        ADR     r0, ErrorBlock_RMNotFoundInROM
      [ International
        BL      TranslateError
      |
        SETV
      ]
        EXIT

70
        CMP     r9, #1                          ; if doing unplug not insert
        CMPNE   r6, #0                          ; and we found a match on an initialised version (else V=0)
 [ 1 = 1
;RCM's fix for MED-04173
        EXIT    EQ

; see if module is active, by checking for module in module list
        MOV     r0, #Module_List
60
        LDR     r0, [r0, #Module_chain_Link]
        TEQ     r0, #0                          ; module not active
        BEQ     %FT90
        LDR     r1, [r0, #Module_ROMModuleNode] ; get active module's pointer to ROM module node
        TEQ     r1, r12                         ; if it matches
        BNE     %BT60

        MOV     r0, #ModHandReason_Delete       ; then tell him he's dead
        LDR     r1, [r6, #ROMModule_Name]
        SWI     XOS_Module
90
 |
        MOVNE   r0, #ModHandReason_Delete       ; then tell him he's dead
        LDRNE   r1, [r6, #ROMModule_Name]
        SWINE   XOS_Module
 ]
        EXIT

RMInsert_Code ALTENTRY
        MOV     r9, #1                          ; indicate insert, not unplug
        B       UnplugInsertEntry

        MakeErrorBlock RMNotFoundInROM

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

        END