; 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.
;
; > asm.ModuleWrap
;
; This provides the wrapping for turning a C application into a module.
;
; Changes: PJC: 15-Aug-91: Fixed Application_Code so that if an error occurs when
; Filer_Action executes the wimpslot command, R0 isn't corrupted
; Also added "GET Hdr:Variables"
; ADH: 28-Apr-2000: UsePathForHelpMessages switch added - makes RAM modules work;
; exports private word pointer as 'module_private_word_ptr'.
GET s.AppName ; defines the name of this module
GET Hdr:ListOpts
GET Hdr:Macros
GET Hdr:System
GET Hdr:ModHand
GET Hdr:EnvNumbers
GET Hdr:Proc
GET Hdr:FSNumbers
GET Hdr:NewErrors
GET Hdr:Services
GET Hdr:ResourceFS
GET Hdr:MsgTrans
GET Hdr:Variables
GET Hdr:UpCall
IMPORT |_Lib$Reloc$Off|
IMPORT |_clib_initialisemodule|
IMPORT |_clib_entermodule|
IMPORT |_clib_finalisemodule|
^ 0
old_exit_handler # 4
old_exit_workspace # 4
module_to_operate_on # 4
enter_and_kill_strsize * :INDEX: @
;sl RN 10
;fp RN 11
; This structure is used during application start and end.
; The information here enables the emulation of a module
; initialisation and finalisation for the purposes of the
; C run-times. The stack bit of the structure is used both
; for initialisation and finalisation and stops the
; embarasing situation of not being able to finalise due
; to not being able to allocate some memory for a short
; term stack. The disadvantage is that this gives an extra
; 300 byte overhead per invocation of a module.
^ 0
af_old_exit_handler # 4
af_old_exit_workspace # 4
af_private_word_address # 4
af_allow_finalisation # 4
application_finalise_strsize * :INDEX: @
AREA |!!!Module$$Header|,CODE,READONLY
Module_BaseAddr
DCD ModuleWrap_Start - Module_BaseAddr
DCD ModuleWrap_Init - Module_BaseAddr ; for ResourceFS stuff
DCD ModuleWrap_Die - Module_BaseAddr
DCD ModuleWrap_Service - Module_BaseAddr
DCD ModuleWrap_TitleString - Module_BaseAddr
DCD ModuleWrap_HelpString - Module_BaseAddr
DCD ModuleWrap_CommandTable - Module_BaseAddr
DCD 0
DCD 0
DCD 0
DCD 0
[ International_Help <> 0
DCD Message_FileName - Module_BaseAddr
|
DCD 0
]
ModuleWrap_CommandTable
[ :DEF:FilerAct
DCB "Filer_Action", 0
|
DCB "Desktop_", ApplicationName, 0
]
ALIGN
DCD Application_Code - Module_BaseAddr
DCD &00ff0000 :OR: International_Help
DCD Application_Syntax - Module_BaseAddr
DCD Application_Help - Module_BaseAddr
; Table termination
DCD 0
[ :DEF:FilerAct
[ International_Help <> 0
Message_FileName DCB "Resources:Resources.FilerAct.Messages",0
Application_Syntax DCB "SFACFAC",0
Application_Help DCB "HFACFAC",0
|
Application_Syntax
DCB "Syntax:", 9, "*Filer_Action", 13, 0
Application_Help
DCB "The Filer_Action module runs the background "
DCB "Filer operations", 0
]
|
[ International_Help <> 0
[ :DEF: UsePathForHelpMessages
Message_FileName DCB ApplicationName,":Messages",0
|
Message_FileName DCB "Resources:Resources.",ApplicationName,".Messages",0
]
Application_Syntax DCB ApplicationName,"Syntax",0
Application_Help DCB ApplicationName,"Help",0
|
Application_Syntax
DCB "Syntax:",9,"*Desktop_", ApplicationName, 13, 0
Application_Help
DCB "The !", ApplicationName, " module runs the "
DCB ApplicationName, " desktop application", 13, 0
]
]
ModuleWrap_HelpString
[ :DEF:FilerAct
DCB "Filer_Action", 9
|
DCB "!", ApplicationName, 9
[ :LEN: ApplicationName < 7
DCB 9
]
]
DCB ApplicationVersion, 0
[ :DEF:FilerAct
ModuleWrap_TitleString DCB "Filer_Action", 0
|
ModuleWrap_TitleString DCB "!", ApplicationName, 0
]
ALIGN
space * 32
strcpy_advance Entry "r1,r2"
10 LDRB r2, [r1], #1
STRB r2, [r0], #1
TEQ r2, #0
BNE %BT10
EXIT
; Command processor
Application_Code Entry "r0"
[ :DEF:FilerAct
; Drop slot size
ADR r0, SlotSizeCommand
SWI XOS_CLI
STRVS r0, [sp]
EXIT VS
]
; Is base active?
MOV r0, #ModHandReason_LookupName
ADRL r1, ModulePercentBase
SWI XOS_Module
BVS %FT99 ; !<App>%Base doesn't exist - bad noozz
TEQ r4, #0
BNE %FT05
; !<App>%Base is inactive - enter that
MOV r0, #ModHandReason_Enter
ADRL r1, ModulePercentBase
LDR r2, [sp] ; Pointer to parameters
SWI XOS_Module
B %FT99 ; VS or VC its bad noozz - we shouldn't have returned
05 ; Base is active
; Find first/create a numbered module
; Copy the skeleton !<App>%Wnnnnnn onto the stack so we can poo on it
SUB sp, sp, #ModulePercentNumbered_Size
MOV r0, sp
ADRL r1, ModulePercentNumbered
BL strcpy_advance
MOV r6, #0
10
MOV r0, r6
ADD r1, sp, #ModulePercentNumbered_NumberOffset
MOV r2, #ModulePercentNumbered_Size - ModulePercentNumbered_NumberOffset
SWI XOS_ConvertCardinal4
ADDVS sp, sp, #ModulePercentNumbered_Size
BVS %FT99
MOV r0, #ModHandReason_LookupName
MOV r1, sp
SWI XOS_Module
BVC %FT20
LDR r1, [r0]
LDR r14, =ErrorNumber_IncarnationNotFound
TEQ r1, r14
ADDNE sp, sp, #ModulePercentNumbered_Size
BNE %FT99 ; Exit if not an incarnation not found error
; Create the incarnation
MOV r0, #ModHandReason_NewIncarnation
MOV r1, sp
SWI XOS_Module
BVC %FT30
ADD sp, sp, #ModulePercentNumbered_Size
B %FT99
20
; If this module is active, move onto the next
TEQ r4, #0
ADDNE r6, r6, #1
BNE %BT10
; Drop through into the 'do a numbered incarnation' code.
; This case (numbered incarnation being inactive) shouldn't
; happen, but if it does this is the right thing to do.
30
; Enter and kill it afterwards
MOV r0, #ModHandReason_Claim
MOV r3, #ModulePercentNumbered_Size
SWI XOS_Module
ADDVS sp, sp, #ModulePercentNumbered_Size
BVS %FT99
; Copy the name onto the bit of RMA we've just got
MOV r0, r2
MOV r1, sp
BL strcpy_advance
; Drop the string from the stack now we no longer need it
ADD sp, sp, #ModulePercentNumbered_Size
; Move the pointer to somewhere out of the way
MOV r4, r2
; Get the struct
MOV r0, #ModHandReason_Claim
MOV r3, #enter_and_kill_strsize
SWI XOS_Module
BVS %FT98
; Fill in the string pointer
STR r4, [r2, #module_to_operate_on]
MOV r4, r2
; Dummy a new application starting before changing the exit handler
MOV r0, #UpCall_NewApplication
ADRL r2, Module_BaseAddr
SWI XOS_UpCall
BVS %FT97
MOV r2, r4
; Swap to our exit handler
MOV r0, #ExitHandler
ADRL r1, exit_and_kill_afterwards_handler
; r2 already contains wsp
SWI XOS_ChangeEnvironment
BVS %FT97
STR r1, [r4, #old_exit_handler]
STR r2, [r4, #old_exit_workspace]
; Enter the module
MOV r0, #ModHandReason_Enter
LDR r1, [r4, #module_to_operate_on]
LDR r2, [sp]
SWI XOS_Module
96 ; If we commence execution here, then the enter failed, in which
; case we must unhitch our exit handler and free the rest of the
; junk we've allocated
STR r0, [sp]
MOV r0, #ExitHandler
LDR r1, [r4, #old_exit_handler]
LDR r2, [r4, #old_exit_workspace]
SWI XOS_ChangeEnvironment
LDR r0, [sp]
97 ; Error exit - free struct pointed to by r4
MOV r2, r4
LDR r4, [r2, #module_to_operate_on]
STR r0, [sp]
MOV r0, #ModHandReason_Free
SWI XOS_Module
LDR r0, [sp]
98 ; Error exit - free thing pointed to by r4
STR r0, [sp]
MOV r0, #ModHandReason_Free
MOV r2, r4
SWI XOS_Module
LDR r0, [sp]
SETV
99 ; Error finish off
STR r0, [sp]
EXIT
LTORG
ModulePercentBase
[ :DEF:FilerAct
DCB "Filer_Action"
|
DCB "!", ApplicationName
]
PercentBase
DCB "%"
Base DCB "Base", 0
ALIGN ; Make sure this end of this string is aligned
ModulePercentNumbered
[ :DEF:FilerAct
DCB "Filer_Action", "%W"
|
DCB "!", ApplicationName, "%W"
]
ModulePercentNumbered_NumberOffset * .-ModulePercentNumbered
DCB "nnnnnnnnn", 0
ALIGN ; This ensures the hole is a whole number of word big
ModulePercentNumbered_Size * .-ModulePercentNumbered
ALIGN
[ :DEF:FilerAct
SlotSizeCommand
DCB "*WimpSlot -min 40k -max 40k", 0
ALIGN
]
exit_and_kill_afterwards_handler
; Restore the exit handler specified in the workspace
MOV r0, #ExitHandler
LDR r1, [r12, #old_exit_handler]
LDR r2, [r12, #old_exit_workspace]
SWI OS_ChangeEnvironment
; Set CAO to 4 - this module is getting stuffed whether it
; likes it or not
MOV r0, #CAOPointer
MOV r1, #4
MOV r2, #0
MOV r3, #0
SWI OS_ChangeEnvironment
; Perform the operation on the module
MOV r0, #ModHandReason_Delete
LDR r1, [r12, #module_to_operate_on]
SWI OS_Module
; Free our workspace: string, then workspace
MOV r0, #ModHandReason_Free
LDR r2, [r12, #module_to_operate_on]
SWI OS_Module
MOV r2, r12
SWI OS_Module
; Exit
MOV r0, #0
MOV r1, #0
MOV r2, #0
SWI OS_Exit
; Enter module
InitialisationStackSize * 1024
sl_offset DCD |_Lib$Reloc$Off|
ModuleWrap_Start ROUT
; Pop up into SVC mode to get some stack
SWI XOS_EnterOS
BVS %FT99
; Store command string somewhere handy
MOV r9, r0
; Install the finalise exit handler
MOV r0, #ModHandReason_Claim
MOV r3, #application_finalise_strsize
SWI XOS_Module
BVS %FT99
; Evaluate the stack limit
MOV sl, sp, LSR #20
MOV sl, sl, ASL #20
; Store finalise RMA piece address in r4
MOV r4, r2
STR r12, [r4, #af_private_word_address]
MOV lr, #0
STR lr, [r4, #af_allow_finalisation]
; Switch exit handler to ours
MOV r0, #ExitHandler
ADRL r1, application_finalisation
SWI XOS_ChangeEnvironment
BVS %FT97
; Store the old exit handler in the RMA piece
STR r1, [r4, #af_old_exit_handler]
STR r2, [r4, #af_old_exit_workspace]
; Store the command line and private word address on the stack
Push "r9,r12"
; Store the magic stack limit things
LDMIA sl, {r1, r2}
Push "r1,r2,r4,sl"
; Initialise the application
MOV r0, #1 ; Initialise re-entrantly
BL |_clib_initialisemodule|
; Restore the magic stack limit things
Pull "r1,r2,r4,sl"
STMIA sl, {r1,r2}
; If error rebalance stack and generate it
ADDVS sp, sp, #8
SWIVS OS_GenerateError
MOV lr, #1
STR lr, [r4, #af_allow_finalisation]
; Get the command line and private word from the stack
Pull "r0,r1"
; Drop back into user mode
MOV r12, #3
MRS r12, CPSR
TST r12, #2_11100
TEQEQP pc, #Z_bit ; keeps EQ
MSRNE CPSR_c, #USR32_mode ; acts as NOP for TEQP :)
MOV r12, r1
; put a copy of the private word into the data for the
; app to get hold of if necessary
LDR r0, [r12] ; r0 -> workspace
LDR lr, module_private_word_ptr_adcon
LDR r0, [r0, #8] ; r0 = client static offset
STR r12, [lr, r0]
; call the application
BL |_clib_entermodule|
; Exit if the application returned, otherwise
; the application will have exited anyway.
MOV r0, #0
MOV r1, #0
MOV r2, #0
SWI OS_Exit
97 ; Exit in error - junk the finalisation heap piece
MOV r5, r0
MOV r0, #ModHandReason_Free
MOV r2, r4
SWI XOS_Module
MOV r0, r5
99 ; Exit in error - we didn't manage to get any stack
SWI OS_GenerateError
module_private_word_ptr_adcon
DCD module_private_word_ptr
; This is the application finalisation routine. It should free up
; the static workspace.
application_finalisation ROUT
; Switch to the original exit handler to avoid deadly cycles
MOV r0, #ExitHandler
LDR r1, [r12, #af_old_exit_handler]
LDR r2, [r12, #af_old_exit_workspace]
SWI OS_ChangeEnvironment
; Switch to SVC mode to get some stack
; As we're going to bomb out to the OS anyway, who cares about
; which mode we bomb out in?
SWI OS_EnterOS
LDR r4, [r12, #af_allow_finalisation]
; Construct the stack limit
MOV sl, sp, LSR #20
MOV sl, sl, ASL #20
; Store r12 to free the af structure
Push "r12"
; Save the magic stack limit things
LDMIA sl, {r1,r2}
Push "r1,r2"
LDR r12, [r12, #af_private_word_address]
MOV r0, r12
LDR r12, [r12]
LDMIB r12, {fp, r12}
STMIA sl, {fp, r12}
LDR r14, sl_offset
ADD sl, sl, r14
MOV fp, #0
TEQ r4, #0
BLNE |_clib_finalisemodule| ; BL<cond> 32-bit OK
; Restore the magic stack limit things
Pull "r1,r2"
STMIA sl, {r1,r2}
; Now we've cleaned up the C bits, lets clean up ourselves
Pull "r2"
; Zero the private word
LDR r0, [r2, #af_private_word_address]
MOV r1, #0
STR r1, [r0]
; Junk the fh structure
MOV r0, #ModHandReason_Free
SWI OS_Module
MOV r0, #0
MOV r1, #0
MOV r2, #0
SWI OS_Exit
[ :LNOT::DEF:REMOVE_RAMLOAD_CHECK
module_linkaddr
DCD Module_BaseAddr
module_ramload_error
DCD &800e0a
DCB "RAMLoadC", 0
ALIGN
]
ModuleWrap_Error
Push "r7, lr"
MOV r1, #0
MOV r2, #0
ADRL r4, ModuleWrap_TitleString
MOV r5, #0
MOV r6, #0
MOV r7, #0
SWI XMessageTrans_ErrorLookup
Pull "r7, pc"
; Initialise module
ModuleWrap_Init
[ :LNOT::DEF:REMOVE_RAMLOAD_CHECK
ADRL r0, Module_BaseAddr
LDR r1, module_linkaddr
CMP r0, r1
ADRNE r0, module_ramload_error
BNE ModuleWrap_Error
]
Push "lr"
[ :DEF:FilerAct
; initialise FilerAct$Path if not already done
ADR R0, FilerActPath
MOV R2, #-1
MOV R3, #0
MOV R4, #VarType_Expanded
SWI XOS_ReadVarVal ; returns R2=0 if doesn't exist
CMP R2, #0 ; clears V as well!
ADREQ R0, FilerActPath
ADREQ R1, PathDefault
MOVEQ R2, #?PathDefault
MOVEQ R3, #0
MOVEQ R4, #VarType_String
SWIEQ XOS_SetVarVal
CLRV
]
; If there are NO instantiations yet, this must be the first
[ :LNOT::DEF:FilerAct
BL countinstantiations
ADRLT r0, resourcefsfiles
SWILT XResourceFS_RegisterFiles ; ignore errors
CLRV ; (ResourceFS may not yet be present)
]
Pull "pc"
[ :DEF:FilerAct
FilerActPath DCB "FilerAct$Path", 0
PathDefault DCB "Resources:$.Resources.FilerAct.", 0
ALIGN
]
; Finalise module
ModuleWrap_Die
; Don't allow ourselves to die if there is workspace hanging around.
; This means the module is running as an application.
LDR r0, [r12]
TEQ r0, #0
ADRNE r0, ErrorBlock_MustQuitApplicationFirst
BNE ModuleWrap_Error
; If this is the only instantiation, call ResourceFS_DeregisterFiles
; Ignore errors, as ResourceFS may no longer be around
Push "lr"
[ :LNOT::DEF:FilerAct
BL countinstantiations ; LT => we're the only one
ADRLT r0, resourcefsfiles
SWILT XResourceFS_DeregisterFiles
]
CLRV
Pull "pc"
ErrorBlock_MustQuitApplicationFirst
DCD 0
DCB "AppQuit", 0
ALIGN
; Count how many instantiations there are of this module
; Then compare with 1 (ie. LT => 0 instantiations, EQ => 1 etc.)
countinstantiations
Push "r0-r7, lr"
MOV r0, #ModHandReason_LookupName
ADRL r1, ModuleWrap_TitleString ; looks up instantiation 0
SWI XOS_Module ; error => no instantiations
MOV r6, r1 ; remember module number
MOVVS r7, #0
MOVVC r7, #1 ; r7 = module count
count1 MOVVC r0, #ModHandReason_GetNames
SWIVC XOS_Module ; updates r1, r2
ADDVS r1, r6, #1 ; no more if error
CMP r1, r6
ADDEQ r7, r7, #1
BEQ count1
CMP r7, #1 ; LT => 0, EQ => 1
Pull "r0-r7, pc"
; Service call handler
;
;Ursula format
;
ASSERT Service_Memory < Service_Reset
ASSERT Service_Reset < Service_ResourceFSStarting
;
ModuleWrap_ServTab
DCD 0 ;flags
DCD ModuleWrap_UService - Module_BaseAddr
DCD Service_Memory
DCD Service_Reset
[ :LNOT::DEF:FilerAct
DCD Service_ResourceFSStarting
]
DCD 0 ;terminator
DCD ModuleWrap_ServTab - Module_BaseAddr ;anchor
ModuleWrap_Service
MOV r0, r0 ;magic instruction
ModuleWrap_UService
[ :LNOT::DEF:FilerAct
CMP r1, #Service_ResourceFSStarting
BEQ svc_resourcefsstarting
]
CMP r1, #Service_Reset
BEQ svc_reset
CMP r1, #Service_Memory
MOVNE pc, lr
; Claim the service_memory if its our memory it's stealing
STMFD sp!, {lr}
ADRL r14, Module_BaseAddr
CMP r2, r14
MOVEQ r1, #0
LDMFD sp!, {pc}
; Free workspace of all instantiations and kill all non base instantiations
; Note. Assumes Base is last module to get service call. Don't see how I
; can get around this.
svc_reset
Push "r0-r5, lr"
LDR r2, [r12]
CMP r2, #0 ; Speed optimisation
Pull "r0-r5, pc",EQ
MOV r0, #ModHandReason_Free
SWI XOS_Module ; Free workspace and flag pw
STR r12, [r12] ; with its own address
MOV r0, #ModHandReason_LookupName
ADRL r1, ModulePercentBase
SWI XOS_Module ; Find module no. and workspace ptr
Pull "r0-r5, pc",VS
CMP r12, r4 ; = flagged workspace ptr?
Pull "r0-r5, pc",NE ; No, return.
MOV r2, #0 ; Set base pw to 0 so we don't
STR r2, [r12] ; kill base
svc_reset1
MOV r0, #ModHandReason_GetNames
SWI XOS_Module ; Get next instantiation
Pull "r0-r5, pc",VS
CMP r4, #0 ; Base
BEQ svc_reset4 ; => don't kill it
MOV r2, #0 ; Reset instantion no. as kill will
STR r2, [r4] ; invalidate it. Clear pw.
MOV r4, r1
SUB sp, sp, #ModulePercentNumbered_Size
MOV r0, sp ; Copy <App>%<Base> to stack
ADRL r1, ModuleWrap_TitleString
svc_reset2
LDRB lr, [r1], #1
CMP lr, #&20
MOVCC lr, #'%'
STRB lr, [r0], #1
BCS svc_reset2
svc_reset3
LDRB lr, [r5], #1
STRB lr, [r0], #1
CMP lr, #&20
BCS svc_reset3
MOV r0, #ModHandReason_Delete
MOV r1, sp
SWI XOS_Module ; Die
ADD sp, sp, #ModulePercentNumbered_Size
MOV r1, r4
B svc_reset1
svc_reset4
CMP r2, #0 ; End of instantions?
BNE svc_reset1
Pull "r0-r5, pc"
GBLS GetRoundObjAsm
[ :LNOT::DEF:FilerAct
svc_resourcefsstarting
Push "r0, lr"
ADR r0, resourcefsfiles
MOV lr, pc ; lr -> return address
MOV pc, r2 ; r2 -> code to call
Pull "r0, pc" ; (r3 = workspace pointer)
resourcefsfiles
GetRoundObjAsm SETS " GET s.ResFiles"
|
GetRoundObjAsm SETS " "
]
$GetRoundObjAsm
[ :LNOT::DEF:FilerAct
DCD 0 ; provide terminator automatically
]
AREA ModuleWrapData,DATA
EXPORT module_private_word_ptr
module_private_word_ptr
DCD 0
END