; 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 => MoreSWIs
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; SubstituteArgs
; in: R0 -> arglist (space delimited args, terminated by 10,13,0)
; R1 -> buffer
; R2 = bufflen
; R3 -> string to mangle
; R4 = no of chars in $R3
; out: R2 = no of chars in buffer
XOS_SubstituteArgs_code
Push "r5,lr"
MOV r5, #0
SWI XOS_SubstituteArgs32
Pull "r5,lr"
B SLVK_TestV
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; SubstituteArgs32
; in: R0 -> arglist (space delimited args, terminated by 10,13,0)
; R1 -> buffer
; R2 = bufflen
; R3 -> string to mangle
; R4 = no of chars in $R3
; R5 = flags
; top bit set => don't append unused part of line
; out: R2 = no of chars in buffer
XOS_SubstituteArgs32_code ROUT
WritePSRc SVC_mode, R12 ; enable IRQs
NOP
Push "R0-R8, lr"
ADD R8, R4, R3
; try and get parameter positions.
; Items starting with " can have spaces in
MOV R6, #0 ; parameter number
LDR R12, =MacExStartPtrs
LDR R4, =MacExEndPtrs
35 LDRB R5, [R0], #1
CMP R5, #" "
BEQ %BT35
MOV R2, #" "
CMP R5, #""""
MOVEQ R2, #"""" ; quoted param
CMP r6, #10 ; "rest of line" item?
MOVEQ r2, #-1 ; terminate on EOL only
SUB R0, R0, #1
STR R0, [R12, R6, LSL #2]
CMP r5, #""""
ADDEQ R0, R0, #1
36 LDRB R5, [R0], #1
BL suba_chktrm
CMPNE R5, R2
BNE %BT36
CMP R5, #""""
LDREQB R5, [R0]
CMPEQ R5, #"""" ; check for "" in string
ADDEQ R0, R0, #1
BEQ %BT36
CMP R2, #""""
SUBNE R0, R0, #1
STR R0, [R4, R6, LSL #2]
ADD R6, R6, #1
CMP R6, #11 ; Parameters 0-9 and a "rest" set.
BNE %BT35
; Keep track of highest param used, so can tack any unused stuff on end.
; R3 points at string to get chars from
; R12 at start ptrs
; R4 at end ptrs
MOV R6, #0 ; count.
MOV R7, #0 ; highest param used.
LDR R2, [stack, #4*2]
37 BL suba_getchar
BEQ %FT41
CMP R5, #"%"
BEQ %FT44
38 BL suba_addchar
B %BT37
PCnotparm
ADD R5, R5, #"0"
MOV R11, R5
MOV R5, #"%"
BL suba_addchar
MOV R5, R11
B %BT38
44 BL suba_getchar
MOVEQ R5, #"%"
BEQ %FT40
CMP R5, #"%"
BEQ %BT38
CMP R5, #"*"
BEQ DoStarParams
SUBS R5, R5, #"0"
BMI PCnotparm
CMP R5, #9
BGT PCnotparm
; itsa parameter! Get ptrs from R12, R4
CMP R5, R7
ADDGE R7, R5, #1
LDR R11, [R4, R5, LSL #2]
CopyToR11FromParamR5
LDR R10, [R12, R5, LSL #2] ; start ptr
39 LDRB R5, [R10], #1
CMP R10, R11
BGT %BT37
BL suba_addchar
B %BT39
DoStarParams ; had %* : find limits to copy between
BL suba_getchar
BEQ PCStarTerminates
SUBS R5, R5, #"0"
BMI PCStarNoDigit
CMP R5, #9
MOVLE R7, #11 ; flag * used
LDRLE R11, [R4, #10*4] ; always to EOL
BLE CopyToR11FromParamR5
PCStarNoDigit
ADD R5, R5, #"0"
MOV R11, R5
MOV R5, #"%"
BL suba_addchar
MOV R5, #"*"
BL suba_addchar
MOV R5, R11
B %BT38
PCStarTerminates
MOV R5, #"%"
BL suba_addchar
MOV R5, #"*"
40 BL suba_addchar
41 CMP r7, #11
LDREQ r12, [r4, #10*4] ; no more to copy
BEQ %FT42
LDR r0, [stack, #4*5]
CMP r0, #0
LDRPL R12, [R12, R7, LSL #2] ; ptr to rest of command line : copy
LDRMI r12, [r4, #10*4] ; caller wants no appending.
42 LDRB R5, [R12], #1
BL suba_addchar
BL suba_chktrm
BNE %BT42
STR R6, [stack, #4*2]
Pull "R0-R8, lr"
ExitSWIHandler
suba_addchar
EntryS
ADD R6, R6, #1
CMP R6, R2
STRNEB R5, [R1], #1
EXITS NE
PullEnv
ADRL R0, ErrorBlock_BuffOverflow
[ International
BL TranslateError
]
STR R0, [stack]
Pull "R0-R8, lr"
B SLVK_SetV
suba_getchar
CMP R3, R8
LDRNEB R5, [R3], #1
MOV PC, lr
suba_chktrm
CMP R5, #13
CMPNE R5, #10
CMPNE R5, #0
MOV PC, lr
LTORG
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Take R0 as pointer to null-terminated string, print it
; with line breaks before words that won't fit on the current line.
; CR forces a newline. TAB=tab to next column of 8. CHR$31 = hard space
; <27,n> => substitute nth dictionary entry:
; dictionary is pointed at by r1, consists of a list of null-terminated
; strings, with preceding length bytes.
; 0th dictentry => use string at r2.
XOS_PrettyPrint_code ROUT
; Inside here, r1 is the current string pointer
; R3 is the linelength to format to
; R4 is the current position in the line.
; r6 is the return addr in word counting
; r7 is the r1 restore value in reading word length
; r8 is used in dictionary selection in getbytepp
; r9 is the stack restoration level for exiting.
; r11 is the dictionary pointer (0 means use MOS dict)
; r12 is the special token pointer
WritePSRc SVC_mode, r11
Push "r0-r9, lr"
BL ReadWindowWidth ; read linelength
MOV R3, R0
MOV R0, #165 ; read output cursor
SWI XOS_Byte
ORR R4, R1, #&80000000 ; no leading space even if in line.
LDMFD stack, {r1, r11, r12} ; reload strptr, dictptr, tokptr
CMP r11, #0
ADREQL r11, MOSdictionary
MOV r9, stack
; loop over all words
01 BL getwordlength
CMP R2, #0
BNE %FT03
BL getbytepp
B %FT21 ; null word - test for done
03
CMP R4, #0
ADDGT R2, R2, #1 ; allow for separator
ADD R0, R2, R4
BIC R0, R0, #&80000000 ; clear R4 flag
CMP R0, R3
BLE %FT10
CMP R4, #0
SUBGT R2, R2, #1 ; remove leading space length
MOV R4, #0 ; if word too long to fit, do newline
SWI XOS_NewLine
BVS exitpp
10 CMP R4, #0
BIC R4, R4, #&80000000 ; clear "no leading space" flag
ADD R4, R4, R2
SUBGT R2, R2, #1
SWIGT XOS_WriteI+" " ; output separator if not 1st on line
BVS exitpp
04 BL getbytepp
CMP R0, #31 ; hard space?
MOVEQ R0, #" "
SWI XOS_WriteC
BVS exitpp
SUBS R2, R2, #1
BNE %BT04
21 CMP R0, #13
MOVEQ R4, #0
SWIEQ XOS_NewLine
BVS exitpp
CMP R0, #TAB
BEQ %FT20
CMP R0, #0
BNE %BT01
exitpp MOV stack, r9
STRVS r0, [stack]
Pull "r0-r9,lr"
B SLVK_TestV
; TAB had: align to next multiple of 8
20 BIC R4, R4, #&80000000
; first want to get next word length, to see if it's worth doing
ADD R5, R4, #8
BIC R5, R5, #7
SUB R5, R5, R4 ; spaces for this tab
24 BL getwordlength
CMP R2, #0
BNE %FT23 ; got the word
BL getbytepp
CMP R0, #13
BEQ %BT21 ; TAB, CR - whalley!
CMP R0, #TAB
SUBNE R5, R5, #1 ; leading spaces, junk ignored
ADDEQ R5, R5, #8 ; multiple tabs OK tho.
CMP r0, #0 ; terminator?
BNE %BT24 ; only case to allow zero-length word
SUB r1, r1, #1 ; we know this rewinds OK
23 ADD R0, R4, R5
ADD R0, R0, R2
CMP R0, R3
MOVGT R0, #13 ; next tab stop too far : newline
BGT %BT21
22 SWI XOS_WriteI+" "
BVS exitpp
ADD R4, R4, #1
SUBS r5, r5, #1
BNE %BT22
ORR R4, R4, #&80000000 ; set top bit to disable leading space
B %BT01
getwordlength
MOV r6, lr
MOV r10, r9 ; first copy context
MOV r2, stack
MOV r7, r1
copycontextpp
CMP r9, r2
LDRNE r0, [r9, #-4]!
Push r0, NE
BNE copycontextpp
MOV r2, #0 ; word length
02 BL getbytepp
CMP R0, #31
CMPNE R0, #" "+1
ADDGE r2, r2, #1
BGE %BT02
MOV r1, r7
MOV stack, r9
MOV r9, r10
MOV pc, r6
getbytepp LDRB r0, [r1], #1
CMP r0, #TokenEscapeChar
BEQ gettokenpp
CMP r0, #0
MOVNE pc, lr
CMP stack, r9
MOVHS pc, lr
Pull r1 ; back to previous token
B getbytepp
gettokenpp
LDRB r0, [r1], #1 ; tokno
Push r1 ; save context
CMP r0, #0
MOVEQ r1, r12
BEQ getbytepp
MOV r1, r11
gtoklp SUBS r0, r0, #1
LDRNEB r8, [r1]
ADDNE r1, r1, r8
BNE gtoklp
ADD r1, r1, #1
B getbytepp
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ReadWindowWidth ROUT ; read "number of chars printable after Newline
; before we're on the next line"
MOV R0, #VduExt_WindowWidth
ReadVduVarForSam
Push "R0, R1, lr" ; R1 reserves space
MOV R0, #-1
STR R0, [stack, #4] ; overwrite R1 value
MOV R0, sp
MOV R1, sp
SWI XOS_ReadVduVariables
LDR R0, [sp], #8
LDR pc, [sp], #4
;*****************************************************************************
; R0 -> envstring, R1 -> 5 byte time
WriteEnv_SWICode ROUT ; for debugger use
CMP R0, #0
BEQ %FT01
LDR R10, =EnvString
MOV R11, R0
02 LDRB R12, [R11], #1
CMP R12, #" "
MOVLT R12, #0
STRB R12, [R10], #1
BGE %BT02
01 CMP R1, #0
ExitSWIHandler EQ
LDR R10, =ZeroPage+EnvTime
MOV R11, #4
03 LDRB R12, [R1, R11]
STRB R12, [R10, R11]
SUBS R11, R11, #1
BPL %BT03
ExitSWIHandler
;*****************************************************************************
; LET RdArgs() BE
; R0 ptr to key defn string
; R1 ptr to command line to decode
; R2 ptr to workspace
; R3 size of workspace
; Returns R3 size left
; Flags used in initial args decoding
AFlag * 1:SHL:8 ; flags shifted up a byte; avoid looking like chars.
KFlag * 1:SHL:9
SFlag * 1:SHL:10
EFlag * 1:SHL:11
GFlag * 1:SHL:12
UnsetBase * &FF000000 ; only if all bits set (cannot be RAM address)
PresentFlag * &7FFFFFFF
AbsentFlag * 0
; Type flags
EndType * 0
FlagType * 1
KeywordType * 2
ItemType * 3
RdArgs_SWICode ROUT
WritePSRc SVC_mode, R10
Push "R4, R8, R9, lr"
MOV R10, R2 ; R10 points at next available word
MOV R12, R0
01 MOV R11, #UnsetBase
SUBS R3, R3, #4
BMI %FT99 ; insufficient space
STR R11, [R10], #4
02 LDRB R11, [R12], #1
CMP R11, #"/"
BNE %FT03
LDRB R11, [R12], #1
UpperCase R11, R9
CMP R11, #"A"
MOVEQ R11, #AFlag
CMP R11, #"K"
MOVEQ R11, #KFlag
CMP R11, #"S"
MOVEQ R11, #SFlag
CMP R11, #"E"
MOVEQ R11, #EFlag
CMP R11, #"G"
MOVEQ R11, #GFlag
CMP R11, #256
LDRGE R9, [R10, #-4]
ORRGE R9, R11, R9
STRGE R9, [R10, #-4]
03
CMP R11, #","
BEQ %BT01
CMP R11, #" "
BGE %BT02
; Initialisation complete: all flags set, R10 implies number of args.
MOV R8, R10
10 BL RdItem
BVS %FT90
CMP R12, #KeywordType
BNE %FT11
ADD R11, R2, R4, LSL #2 ; keyword ptr
BL RdItem
BVS %FT90
CMP R12, #ItemType
BNE %FT98
BL SetKeyword
BVS %FT90
B %BT10
11 CMP R12, #ItemType
BNE %FT12
; next positional arg := itemptr
MOV R11, R2
20 CMP R11, R8
BEQ %FT98 ; no more positional args
LDR R12, [R11], #4
CMP R12, #UnsetBase
BLO %BT20
TST R12, #KFlag :OR: SFlag
BNE %BT20
SUB R11, R11, #4
BL SetKeyword
BVS %FT90
B %BT10
12 CMP R12, #EndType
BNE %BT10
; postscan to check all /a args set.
MOV R12, R2
30 CMP R12, R8
BEQ %FT31
LDR R11, [R12], #4
CMP R11, #UnsetBase
BLO %BT30
TST R11, #AFlag
BNE %FT98 ; bum args error
MOV R11, #AbsentFlag
STR R11, [R12, #-4] ; force "not present"
B %BT30
31
Pull "R4, R8, R9, lr"
ExitSWIHandler
98 ADR R0, ErrorBlock_BadParameters
[ International
BL TranslateError
]
B %FT90
99 ADRL R0, ErrorBlock_BuffOverflow
[ International
BL TranslateError
]
90
Pull "R4, R8, R9, lr"
B SLVK_SetV
EXPORT ErrorBlock_BadParameters
MakeErrorBlock BadParameters
MakeErrorBlock ArgRepeated
ALIGN
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; RdItem: strips next item from command line
; In: R1 -> cmd line
; Out: R1 updated
; R12 contains type
; R4 contains ptr for Item, argno for Flag/Keyword
; VS means buffer full
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
RdItem ROUT
Push "R1, R7, R8, lr"
MOV R8, #0 ; not demanding new arg
01 LDRB R12, [R1], #1
CMP R12, #" "
BEQ %BT01
BGE %FT33
MOV R12, #EndType
CLRV
Pull "R1, R7, R8, PC"
33
CMP R12, #""""
BEQ ohnoitsquotedargumentsagain
CMP R12, #"-" ; options?
BNE %FT02 ; nope - boring item
05 BL GetArg
LDRVS R1, [stack]
BVS %FT02 ; not recognised - boring item
STR R1, [stack] ; new restore value.
MRS R12, CPSR
Push R12 ; save EQ/NE
LDR R12, [R2, R4, LSL #2]
CMP R12, #UnsetBase
BHS %FT34
ADR R0, ErrorBlock_ArgRepeated
[ International
BL TranslateError
|
SETV
]
ADD stack, stack, #4 ; discard PSR
Pull "R1, R7, R8, PC"
34
ANDS R12, R12, #SFlag
BNE %FT35
MOV R12, #KeywordType
ADD stack, stack, #4 ; discard PSR
CLRV
Pull "R1, R7, R8, PC"
35
MOV R12, #PresentFlag
STR R12, [R2, R4, LSL #2]
; now deal with flag elision: if nextchar valid keyword char, rescan
Pull R12
TST R12, #Z_bit
BEQ %FT20 ; GetArg returned NE, so not single char abbr
Push "R2, R3"
LDRB R2, [R1]
BL CheckR2OKChar
Pull "R2, R3"
MOVEQ R8, #1 ; MUST get another arg
BEQ %BT05
20 MOV R12, #FlagType
CLRV
Pull "R1, R7, R8, PC"
02 CMP R8, #0
BEQ %FT39
ADR R0, ErrorBlock_BadParameters
[ International
BL TranslateError
|
SETV
]
Pull "R1, R7, R8, PC"
39
; copy arg until <" "
MOV R7, #" "
SUB R1, R1, #1
06 MOV R4, R10
03 LDRB R12, [R1], #1
CMP R12, R7
CMPNE R12, #" "-1
BLE %FT04
10
SUBS R3, R3, #1
STRPLB R12, [R10], #1
BPL %BT03
23
ADRL R0, ErrorBlock_BuffOverflow
[ International
BL TranslateError
|
SETV
]
Pull "R1, R7, R8, PC"
04 CMP R7, #""""
BNE %FT07
CMP R12, #""""
BNE %FT08
LDRB R12, [R1], #1
CMP R12, #""""
BEQ %BT10
07 MOV R12, #0 ; terminate
SUBS R3, R3, #1
BMI %BT23
STRB R12, [R10], #1
MOV R12, #ItemType
SUB R1, R1, #1
STR R1, [stack]
CLRV
Pull "R1, R7, R8, PC"
ohnoitsquotedargumentsagain
MOV R7, #""""
B %BT06
08 ADRL R0, ErrorBlock_BadString
[ International
BL TranslateError
|
SETV
]
Pull "R1, R7, R8, PC"
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; GetArg
; Look through keys: allow only full match on first pass, then
; single char abbreviation on second pass
; Return V set if not key, EQ if single letter abbreviation
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
GetArg ROUT
; In: R0 ptr to keystring
; R1 ptr to potential option.
; Out: VS if nomatch or
; R1 updated
; R4 argument number
Push "R0-R3, R5-R6, lr"
MOV R6, #-1 ; pass number
20 MOV R4, #0
01 LDRB R2, [R0], #1
CMP R2, #" "
BEQ %BT01
02 BL CheckR2OKChar
BNE %FT03 ; matched in full
LDRB R3, [R1], #1
UpperCase R2, R5
UpperCase R3, R5
CMP R2, R3
LDREQB R2, [R0], #1
BEQ %BT02
CMP R6, #0
BLT %FT04
; 2nd pass: allow abbreviation
; IF single char abbreviation THEN success ELSE skip
LDR R2, [stack, #4]
SUB R2, R1, R2 ; length of match+1
CMP R2, #2
SUBEQ R1, R1, #1
BEQ %FT13 ; success
; skip to next keyword
04 LDRB R2, [R0], #1
CMP R2, #" "
BLT %FT05
CMP R2, #","
ADDEQ R4, R4, #1
CMPNE R2, #"="
BNE %BT04
LDR R1, [stack, #4]
B %BT01
03 ; NE on first pass: check input string terminated OK
LDRB R2, [R1] ; check for end of input word
BL CheckR2OKChar
BNE %FT13 ; yaay! full & correct match
SUB R0, R0, #1
B %BT04
05 ADDS R6, R6, #1
LDMLEFD stack, {R0, R1}
BLE %BT20
SETV
Pull "R0-R3, R5-R6, PC" ; back with failure
13 STR R1, [stack, #4]
CLRPSR V_bit, R0 ; clrV (just)
Pull "R0-R3, R5-R6, PC" ; back with success
CheckR2OKChar ROUT
CMP R2, #"A"
RSBGES R3, R2, #"Z"
BGE %FT50
CMP R2, #"a"
RSBGES R3, R2, #"z"
BGE %FT50
CMP R2, #"0"
RSBGES R3, R2, #"9"
BGE %FT50
CMP R2, #"_"
MOV PC, lr
50 CMP R0, R0 ; set EQ
MOV PC, lr
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
SetKeyword ROUT
; R11 ptr at keyword flags
; R4 ptr to value
Push "R0-R2, R5, R6, lr"
LDR R0, [R11]
TST R0, #EFlag :OR: GFlag
STR R4, [R11] ; result will always be here anyway
BEQ %FT01
SUB R5, R10, R4 ; length of value
ADD R3, R3, R5 ; increase free space
ADD R2, R5, #11 ; round up to nearest word, then 1
BIC R2, R2, #3
MOV R6, stack ; STR stack, [stack, -R2]! is unpredictable
STR R6, [stack, -R2]! ; reserve stack frame
ADD R2, stack, #4 ; input value ptr
03 LDRB R6, [R4, R5]
STRB R6, [R2, R5]
SUBS R5, R5, #1
BPL %BT03 ; copy the value
TST R0, #EFlag
MOV R0, R2
BNE %FT02
ADD R1, R4, #2 ; free space pointer
SUBS R3, R3, #2
MOV R2, R3
BMI %FT04
ORR R2, R2, #1:SHL:31
SWI XOS_GSTrans
05 SUB R3, R3, R2
ADD R10, R1, R2 ; update freespace pointer
STRB R2, [R1, #-2]
MOV R2, R2, LSR #8
STRB R2, [R1, #-1]
BCS %FT04
90 LDR stack, [stack, #0] ; unwind frame (and don't let AAsm use
STRVS R0, [stack] ; postindexed!!!)
Pull "R0-R2, R5, R6,PC"
04 ADRL R0, ErrorBlock_BuffOverflow
[ International
BL TranslateError
|
SETV
]
B %BT90
02 ADD R1, R4, #3 ; free space pointer
SUBS R3, R3, #3 ; adjust for type (1 byte) + length (2 bytes)
BMI %BT04
MOV R2, R3
SWI XOS_EvaluateExpression
BVS %BT90
TEQ R1, #0, 2 ; if non-zero, then string, so update length
MOVNE R14, #1 ; set type byte to definitely non-zero
STRNEB R14, [R4]
BNE %BT05 ; (C=0 so no buffer overflow, V=0 from SWI)
STRB R1, [R4] ; set type byte to zero (=> integer)
SUBS R3, R3, #5
BMI %BT04
STRB R2, [R4, #1]
MOV R2, R2, LSR #8
STRB R2, [R4, #2]
MOV R2, R2, LSR #8
STRB R2, [R4, #3]
MOV R2, R2, LSR #8
STRB R2, [R4, #4]
ADD R10, R4, #5
B %BT90
01
CLRV
Pull "R0-R2, R5, R6,PC"
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ReadRAMFSLimits
; Return R0 start, R1 end (i.e. 1st byte out of area)
ReadRAMFSLimits_Code ROUT
Push "lr"
MOV r0, #ChangeDyn_RamFS
SWI XOS_ReadDynamicArea ; out: r0 = base, r1 = current size
Pull "lr"
ADDVC r1, r1, r0 ; if no error, make r1 -> after end
ORRVS lr, lr, #V_bit ; if error, then set V_bit on return
ExitSWIHandler
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ExitAndDie
; r0-r2 parameters for Exit
; r3 pointer to module name
TerminateAndSodOff ROUT
Push "r0-r2"
LDR r10, =ZeroPage
[ ZeroPage = 0
STR r10, [r10, #Curr_Active_Object]
|
MOV r14, #0
STR r14, [r10, #Curr_Active_Object]
]
MOV r1, r3
MOV r0, #ModHandReason_Delete
SWI XOS_Module
Pull "r0-r2"
SWI XOS_Exit
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; AddCallBack entry to callback vector
; r0 address to call
; r1 workspace ptr
AddCallBack_Code ROUT
Push "r0-r3, lr"
[ ChocolateSysHeap
ASSERT ChocolateCBBlocks = ChocolateBlockArrays + 0
LDR r3,=ZeroPage+ChocolateBlockArrays
LDR r3,[r3,#0]
BL ClaimChocolateBlock
MOVVS r3, #12
BLVS ClaimSysHeapNode
|
MOV r3, #12
BL ClaimSysHeapNode
]
BVS %FT99
Pull "r0, r1"
LDR r10, =ZeroPage
WritePSRc SVC_mode+I_bit, r3 ; IRQs off while holding context.
LDR r3, [r10, #CallBack_Vector]
[ {TRUE}
STR r3, [r2, #0]
STMIB r2, {r0, r1}
STR r2, [r10, #CallBack_Vector]
Pull "r2, r3, lr"
|
STR r3, [r2], #4
STMIA r2, {r0, r1}
SUB r2, r2, #4
STR r2, [r10, #CallBack_Vector]
Pull "r2, r3, lr"
MOV r10, #0
]
LDRB r11, [r10, #CallBack_Flag]
ORR r11, r11, #CBack_VectorReq
STRB r11, [r10, #CallBack_Flag]
B SLVK
99 STR r0, [stack]
Pull "r0-r3, lr"
B SLVK_SetV
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; RemoveCallBack - Entry for SWI OS_RemoveCallBack
;
; Removes an entry on the callback vector before it has been called
;
; in: r0 = address that would have been called
; r1 = workspace ptr
;
; out: -
;
RemoveCallBack ROUT
Push "r2-r4"
SavePSR r10 ; save old I bit
10
WritePSRc SVC_mode+I_bit, r11 ; disable IRQs while looking at list
LDR r11, =ZeroPage
LDR r2, [r11, #CallBack_Vector]! ; r11 -> prev, r2 -> this
20
TEQ r2, #0
Pull "r2-r4", EQ
ExitSWIHandler EQ
LDMIA r2, {r3,r4,r12} ; r3 -> next, r4 = addr, r12 = ws
TEQ r4, r0 ; check if correct address
TEQEQ r12, r1 ; and correct ws ptr
MOVNE r11, r2 ; if not, then prev:=this
MOVNE r2, r3 ; and this:=next
BNE %BT20 ; and loop
STR r3, [r11] ; prev.link := next
RestPSR r10 ; safe now to restore IRQ status
Push "r0, r1, lr" ; now free this node
[ ChocolateSysHeap
ASSERT ChocolateCBBlocks = ChocolateBlockArrays + 0
LDR r1,=ZeroPage+ChocolateBlockArrays
LDR r1,[r1,#0]
BL FreeChocolateBlock
BLVS FreeSysHeapNode
|
BL FreeSysHeapNode ; and then start again (NB we must
; restart from head of list again, as
; enabling IRQs could have changed list
]
STRVS r0, [sp, #0]
Pull "r0, r1, lr"
BVC %BT10
Pull "r2-r4" ; had an error while releasing block
ORR lr, lr, #V_bit
ExitSWIHandler
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; SWI OS_Confirm
; If pointer visible, change pointer shape and look at mouse keys too.
; Flush mouse buffer first.
; Wait until key pressed.
; Returns: (lowercased) character in r0 (if mouse scanned, LH button = 'y',
; other buttons = 'n')
; C set for Escape condition
; EQ set if r0 = 'y'
[ International
confirm_yn DCB "YesNo:yn",0 ; Token to lookup message for Yes/No
|
confirm_yn DCB "yn"
]
ptr_confirm DCB "ptr_confirm",0 ; Wimp's confirm pointer sprite shape
confirm_scale DCD 1,1,1,1 ; Scaling factor for sprite op
Confirm_Code ROUT
WritePSRc SVC_mode, r10 ; enable IRQs
Push "r0-r7, lr"
; Lookup the symbols for Y/N
ADR r0, confirm_yn
[ International
BL FindToken ; Lookup in messages, use default if error
]
LDRB r1, [r0], #1 ; Y character
LDRB r2, [r0], #1 ; N character
ORR r1, r1, r2, LSL #8
Push "r1" ; Y=[sp], N=[sp+1]
; Save current pointer selected
MOV r0, #106
MOV r1, #255 ; read pointer state
SWI XOS_Byte
BVS confirm_error
BIC r2, r1, #&80
MOV r10, r1
TST r10, #15 ; Pointer enabled?
BEQ confirm_waitloop ; Jump if not
; Find Wimp's "ptr_confirm" sprite, searching first RMA then ROM
SWI XWimp_BaseOfSprites
MOVVS r10, #0 ; If error then don't use mouse
BVS confirm_waitloop ; And jump to poll keyboard
MOV r11, r0 ; Save -> ROM sprites, r1 -> RMA sprites
ADR r2, ptr_confirm ; -> sprite name
MOV r0, #&128 ; Read sprite info
SWI XOS_SpriteOp
BVC %FT10 ; Jump if sprite in RMA
ADR r2, ptr_confirm ; -> sprite name
MOV r1, r11 ; -> ROM sprites
MOV r0, #&128 ; Read sprite info
SWI XOS_SpriteOp
MOVVS r10, #0 ; If error then don't use mouse
BVS confirm_waitloop ; And jump to poll keyboard
; Set pointer shape from the sprite area found (r1)
10 MOV r7, #0 ; No pixel translation
ADR r6, confirm_scale ; pointer scaling factor (1:1)
MOV r5, #0 ; y hot spot offset
MOV r4, #0 ; x hot spot offset
MOV r3, #&23 ; No palette, shape 3
ADR r2, ptr_confirm ; -> sprite name
MOV r0, #&124 ; Set pointer shape
SWI XOS_SpriteOp ; Ignore errors
MOV r0, #21
MOV r1, #9
SWI XOS_Byte ; flush mouse buffer
MOV r0, #&C4
MOV r1, #0
MOV r2, #255
SWI XOS_Byte ; read current repeat rate.
LDR r0, =ZeroPage
LDR r0, [r0, #MetroGnome]
ADD r11, r1, r0 ; time to wait for
confirm_mouserepeat
SWI XOS_Mouse
CMP r2, #0 ; any buttons down?
BEQ confirm_waitloop
CMP r3, r11
BMI confirm_mouserepeat
confirm_waitloop
MOV r0, #129
MOV r1, #1
MOV r2, #0
SWI XOS_Byte ; scan for key
BVS confirm_error
CMP r2, #255
BNE confirm_gotkey
TST r10, #15
BEQ confirm_waitloop ; no mouse scan wanted.
SWI XOS_Mouse
BVS confirm_error
CMP r2, #0
BEQ confirm_waitloop
TST r2, #4 ; LH button?
LDRNEB r1, [sp] ; Yes
LDREQB r1, [sp, #1] ; No
confirm_gotkey
CMP r2, #&1B ; ESCAPE or normal char read ?
ORREQ r11, r1, #&100
MOVNE r11, r1
LowerCase r11, r1
TSTS r10, #15 ; Was pointer changed?
MOV r1, r10
MOV r0, #106
SWINE XOS_Byte ; Yes then restore shape
Pull "r10" ; r10=YN
AND r10, r10, #&ff ; Retain Y byte
Pull "r0-r7, lr"
BIC lr, lr, #C_bit :OR: Z_bit ; SKS. Punter lr has VClear
AND r0, r11, #&FF
TST r11, #&100 ; ESCAPE condition ? (SKS)
ORRNE lr, lr, #C_bit
CMP r0, r10
ORREQ lr, lr, #Z_bit
B SLVK
confirm_error
ADD sp, sp, #4 ; Drop YN
STR r0, [stack]
Pull "r0-r7, lr"
B SLVK_SetV
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In r0 = continuation crc (0 to start)
; r1 -> start of core
; r2 -> end of core
; r3 = increment (typically 1, 2 or 4), but can be -ve
; Out r0 = crc so far
CRC_Code ROUT
[ {TRUE}
WritePSRc SVC_mode, r10 ; Could take a long time
Push "r3, r14"
TEQ r3, #0 ; is increment 0? - if so, it's silly
BEQ %FT80 ; so return error, rather than going on forever
MOV r10, r1
MOV r12, #&A000 ; CRC EOR pattern = &A001
ORR r12, r12, #&0001
10
CMP r10, r2 ; Finished ?
BEQ %FA90 ; Must be exact end, allows -ve offset
LDRB r14, [r10], r3
EOR r0, r0, r14 ; EOR the data with current crc lo
CMP r10, r2 ; length might be odd so check again
MOVEQ r11, #8 ; if equal then only do 8 bits
BEQ %FT20
LDRB r14, [r10], r3
EOR r0, r0, r14, LSL #8 ; EOR the data with current crc hi
MOV r11, #16 ; do 16 bits
20
MOVS r0, r0, LSR #1 ; acc >>= 1; CS/CC
EORCS r0, r0, r12 ; CS -> eor, CC -> ok
SUBS r11, r11, #1 ; 8 bits per byte
BNE %BT20
B %BT10
80
ADRL r0, ErrorBlock_BadParameters ; return "Bad parameters" error
[ International
BL TranslateError
]
Pull "r3, r14"
B SLVK_SetV
90
Pull "r3, r14"
ExitSWIHandler
|
WritePSRc SVC_mode, r10 ; Could take a long time
Push "r3, r4, lr"
MOV r10, r1
MOV r12, #&A000 ; CRC EOR pattern = &A001
ORR r12, r12, #&0001
MOV r14, #1 ; A single bit to be shifted
10 CMP r10, r2 ; Finished ?
BEQ %FA90 ; Must be exact end, allows -ve offset
LDRB r4, [r10], r3
MOV r11, #0 ; Go round the bits
20 TST r4, r14, LSL r11 ; Is data bit = carry ?; NE/EQ
BEQ %FT30
MOVS r0, r0, LSR #1 ; acc >>= 1; CS/CC
EORCC r0, r0, r12 ; NE, CC -> eor, NE, CS -> ok
B %FT40
30 MOVS r0, r0, LSR #1 ; acc >>= 1; CS/CC
EORCS r0, r0, r12 ; EQ, CS -> eor, EQ, CC -> ok
40 ADD r11, r11, #1 ; 8 bits per byte
CMP r11, #8
BLO %BT20
B %BT10
90 Pull "r3, r4, lr"
ExitSWIHandler
]
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
END