; 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 => Arthur2
; GET $.Hdr.Variables - got at start
MACRO
$l GSVarGetWSpace
$l LDR R12, =GSVarWSpace
MEND
;mjs performance enhancements for Ursula (ChocolateSysVars)
;
GBLL SysVars_QuickContext
GBLL SysVars_StickyNodes
SysVars_QuickContext SETL {TRUE} :LAND: ChocolateSysVars ;avoid abysmal O(n*n) enumeration of vars
SysVars_StickyNodes SETL {TRUE} :LAND: ChocolateSysVars ;attempt to avoid lots of SysHeap operations,
;especially grows and shrinks
SysVars_Vindex_NStart * 256 ;initial no. of vars supported by index
SysVars_Vindex_NBump * 32 ;additional no. of vars each time index size is bumped up
[ SysVars_QuickContext
;
;format of block anchored at VariableList
;
^ 0
SysVars_LastContext # 4 ;last var table index for last context ptr returned, or -1 if invalid
SysVars_VTableOffset # 0
;
;immediately followed by table data as in old code:
; 1 word = total number of variables (N)
; N words = ptrs to variable blocks (sorted table)
;
]
[ SysVars_StickyNodes
SysVars_StickyNode_UnitSize * 32 ;quantise node size to multiples of this many bytes
;(must be multiple of 8, and power of 2)
SysVars_StickyNode_Log2US * 5 ;Log2 of unit size
SysVars_StickyNode_MaxSize * 320 ;maximum size of node that may stick (be retained on removal as active node)
;
;There are currently 10 words allocated in kernel workspace for sticky pointers
ASSERT SysVars_StickyNode_UnitSize*10 = SysVars_StickyNode_MaxSize
]
GBLL DebugSysVars
DebugSysVars SETL {FALSE}
;-----------------------------------------------------------------------------------
;
; This file covers:
; System variables:
; InitVariables
; OS_ReadVarVal
; OS_SetVarVal
; GSTrans:
; OS_GSInit
; OS_GSRead
; OS_GSTrans
; These have been grouped because GSTrans makes direct use of the system variables'
; structures.
;
; The system variables are stored as a one way sorted alphabetically linked list hanging
; off the zero-page location VariableList:
;
; VariableList---->sorted table of pointers to variable blocks (QuickIndex) - format as above
;
; The end is indicated by the link having the value 0.
;
; Each variable is stored in one block in the system heap (block will be word aligned). The
; format of each block is:
;
; No. Bytes Use
; N+1 Variable's name (length N, plus terminator).
; 1 Variable's type:
; 0 string
; 1 number
; 2 macro
; 3 expanded (not valid within sysvar structure)
; 16 code
; M data - depends on the variable's type
;
; The structure of the data is as follows:
;
; Type 0 - string
; Bytes Use
; 3 Length (N)
; N the bytes of the string - may contain any characters
;
; Type 1 - number
; Bytes Use
; 4 its value (not necessarily word aligned)
;
; Type 2 - macro
; Bytes Use
; 3 Length (N)
; N the bytes of the string - must be a valid GSTransable string
; including terminator
;
; Type 16 - code
; Bytes Use
; x Sufficient to word align...
; 4 Write entry
; 4 Read entry
; N The rest of the code
InitVariables ROUT
Push "lr"
; Blank the sysvar list
MOV R0, #0
LDR R12, =ZeroPage+VariableList
STR R0, [R12]
; Set up the preset system variables
ADR R0, SystemVarList ; R0 pointer to name
01 MOV R1, R0
LDRB R2, [R1], #1
CMP R2, #0
Pull "PC", EQ
02 LDRB R3, [R1], #1
CMP R3, #0
BNE %BT02
LDRB R4, [R1], #1 ; get type
ADD R1, R1, #3
BIC R1, R1, #3
LDR R2, [R1], #4
SWI XOS_SetVarVal
ADD R0, R1, R2
B %BT01
LTORG
; System vars have Thunks :
; read thunk returns R0 ptr to string, R2 length. R1 corruptible
; set thunk takes R1 ptr to value, R2 length. Value is always a string.
; Can corrupt R1, R2, R4, R10-12
; The list of nodes to copy into RAM :
; name, 0 , type, ALIGN, size of value, value
SystemVarList ROUT
= "Sys$$Time", 0, VarType_Code
ALIGN
& sv2-.-4
LDR PC, %FT01
LDR PC, %FT02
01
& SetTimeVar
02
& ReadTimeVar
sv2 = "Sys$$Year", 0, VarType_Code
ALIGN
& sv3-.-4
LDR PC, %FT03
LDR PC, %FT04
03
& SetYear
04
& ReadYear
sv3 = "Sys$$Date", 0, VarType_Code
ALIGN
& sv4-.-4
LDR PC, %FT05
LDR PC, %FT06
05
& SetDate
06
& ReadDate
sv4 = "Sys$$ReturnCode", 0, VarType_Code
ALIGN
& sv5-.-4
LDR PC, %FT07
LDR PC, %FT08
07
& SetRC
08
& ReadRC
sv5 = "Sys$$RCLimit", 0, VarType_Code
ALIGN
& sv6-.-4
LDR PC, %FT09
LDR PC, %FT10
09
& SetRCL
10
& ReadRCL
sv6 = "Alias$.", 0, VarType_String
ALIGN
& sv7-.-4
= "Cat ", 10
sv7 = "Sys$$DateFormat", 0, VarType_String
ALIGN
& sv8-.-4
[ {TRUE}
= "%24:%mi:%se %dy-%m3-%ce%yr", 10
|
= "%w3,%dy %m3 %ce%yr.%24:%mi:%se", 10
]
sv8 = 0
SysTimeFormat
= "%24:%mi:%se", 0
SysDateFormat
= "%w3,%dy %m3", 0
SysYearFormat
= "%ce%yr", 0
ALIGN
; Now the code for our system variables.
ReadTimeVar
ADR R0, SysTimeFormat
B ReadTimeFormatted
SetTimeVar ROUT
CMP R2, #&FE
BHI TimeVarTooLong
Push "R0, lr"
LDR R12, =SysVarWorkSpace
MOV R11, #8
STRB R11, [R12], #1
MOV R10, #0
STRB R10, [R12, R2]
MOV R10, R2
01 SUBS R10, R10, #1
LDRPLB R11, [R1, R10]
STRPLB R11, [R12, R10]
BPL %BT01
SUB R1, R12, #1
MOV R0, #15
SWI XOS_Word
STRVS R0, [R13]
Pull "R0, PC"
TimeVarTooLong
ADRL R0, ErrorBlock_VarTooLong
[ International
B TranslateError
|
RETURNVS
]
ReadYear
ADR R0, SysYearFormat
B ReadTimeFormatted
SetYear ROUT
CMP R2, #4
BHI TimeVarTooLong
Push "R0, lr"
Push "R1,R2"
ADR R0, SetYearPrefixFormat
BL ReadTimeFormatted
ADD R12, R0, R2 ; R12 -> position to copy year to
Pull "R1,R2"
BVS %FT02
MOV R10, #0
STRB R10, [R12, R2]
MOV R10, R2
01 SUBS R10, R10, #1
LDRPLB R11, [R1, R10]
STRPLB R11, [R12, R10]
BPL %BT01
SUB R1, R0, #1
MOV R0, #15
STRB R0, [R1]
SWI XOS_Word
02 STRVS R0, [R13]
Pull "R0, PC"
ReadDate
ADR R0, SysDateFormat
B ReadTimeFormatted
SetDate ROUT
CMP R2, #&F8
BHI TimeVarTooLong
Push "R0, lr"
LDR R12, =SysVarWorkSpace
MOV R11, #15
STRB R11, [R12], #1
MOV R10, #0
STRB R10, [R12, R2]
MOV R10, R2
01 SUBS R10, R10, #1
LDRPLB R11, [R1, R10]
STRPLB R11, [R12, R10]
BPL %BT01
ADD R1, R12, R2
ADR R0, SetDateSuffixFormat ; append year to supplied date
Push "R12"
BL ReadTimeFormattedAtR1
Pull "R12"
SUB R1, R12, #1
MOV R0, #15
SWI XOS_Word
STRVS R0, [R13]
Pull "R0, PC"
; in: R0 = format string
; out: R0 -> time string (0 terminated)
; R2 = length of string (excluding terminator)
; R1 corrupt
ReadTimeFormatted ROUT
Push "R3,R4,LR"
LDR R12, =SysVarWorkSpace
ADD R2, R12, #1
01 MOV R4, R0
SUB R13, R13, #8
MOV R1, R13
MOV R0, #3
STRB R0, [R1]
MOV R0, #14
SWI XOS_Word
BVS %FT02
MOV R0, #-1
MOV R1, R13
MOV R3, #?SysVarWorkSpace-1
SWI XTerritory_ConvertDateAndTime
02 ADD R13, R13, #8
SUBVC R2, R1, R0
Pull "R3,R4,PC"
; in: R0 = format string
; R1 -> output buffer
; out: R0 -> time string (0 terminated)
; R1 corrupt
; R2 = length of string (excluding terminator)
ReadTimeFormattedAtR1
Push "R3,R4,LR"
MOV R2, R1
B %BT01
ReadRC ROUT
LDR R0, =ZeroPage
LDR R0, [R0, #ReturnCode]
B ReadNumSysVar
SetRC Push "lr"
BL SetNumSysVar
LDR R4, =ZeroPage+ReturnCode
STR R2, [R4]
LDR R4, =ZeroPage+RCLimit
LDR R4, [R4]
CMP R2, R4
BHI %FT03
CLRV
Pull "PC"
03 ADRGT R0, ErrorBlock_RCExc
ADRLT R0, ErrorBlock_RCNegative
[ International
BL TranslateError
|
SETV
]
Pull "PC"
SetYearPrefixFormat
= "%w3,%dy %m3 ", 0
SetDateSuffixFormat
= " %ce%yr", 0
ALIGN
MakeErrorBlock RCExc
MakeErrorBlock RCNegative
ReadRCL LDR R0, =ZeroPage
LDR R0, [R0, #RCLimit]
ReadNumSysVar
Push "lr"
LDR R12, =SysVarWorkSpace
MOV R1, R12
MOV R2, #256
SWI XOS_BinaryToDecimal
MOV R0, R1
Pull "PC"
SetRCL Push "lr"
BL SetNumSysVar
LDR R4, =ZeroPage+RCLimit
CMP R2, #0 ; can't set -ve RCLimit
RSBMIS R2, R2, #0
MOVMI R2, #0 ; BIC of MININT
STR R2, [R4]
Pull "PC"
LTORG
SetNumSysVar ROUT ; R1 ptr to string, R2 string length
Push "lr"
SUBS R2, R2, #1
ADDMI R2, R2, #1 ; give 0 in R2 for bad length.
Pull "PC", MI
LDR R12, =SysVarWorkSpace
03 LDRB R10, [R1], #1 ; copy into a buffer so we can terminate it.
STRB R10, [R12], #1
SUBS R2, R2, #1
BPL %BT03
MOV R10, #13
STRB R10, [R12], #1
LDR R1, =SysVarWorkSpace
LDRB R10, [R1]
MOV R12, #0
CMP R10, #"-"
MOVEQ R12, #-1
CMPNE R10, #"+"
ADDEQ R1, R1, #1
MOV R0, #0
SWI XOS_ReadUnsigned
CMP R12, #0
RSBMI R2, R2, #0
Pull "PC"
;*****************************************************************************
; GSINIT, GSREAD, GSTRANS
; To enable GSTrans nesting to stand a chance of working don't flatten the
; stack every FSINIT. Instead, pick up the stack pointer (any value is OK)
; and wrap at 255. Stack overflow occurs if you increment the pointer to
; where it started for this GSINIT, and stack underflow occurs if you
; decrement the pointer when it is currently equal to stack limit.
; The stack limit is held in the environment value, R2.
; The stack is empty ascending.
GBLL GS_BufferNotStack
GS_BufferNotStack SETL {TRUE}
; some semi-arbitrary flags
GS_NoQuoteMess * 1 :SHL: 31 ; flags passed in from user
GS_NoVBarStuff * 1 :SHL: 30
GS_Spc_term * 1 :SHL: 29 ; clear if user requested terminate on space
GS_In_String * 1 :SHL: 28 ; set if waiting for closing "
GS_ReadingString * 1 :SHL: 27 ; set if reading chars from a string var.
GS_Macroing * 1 :SHL: 26 ; set if reading chars from a macro
[ GS_BufferNotStack
ASSERT GS_StackPtr_Lim = &80
GS_StackLimitBits * 7
GS_StackLimitPos * 19 ; The bit position of the LSB of the byte
; which holds the stack limit
; bits 0-18 hold the string length for string transfers
|
; bits 24-25 are unused
; bits 0-23 hold the string length for string transfers
]
; After GSINIT, R2 has these flags, and if expanding a count in the low byte
GSINIT ROUT
; In : R0 pointer to string to expand
; R2 has flags :
; Bit 29 set means space is a terminator
; Bit 30 set means | characters will not be molested
; Bit 31 set means don't mess with quotes
; Out : R0, R2 are values to pass back in to GSREAD
; R1 is the first non-blank character
; EQ means char is CR or LF, i.e. string is empty.
; Enable interupts as we've no right to have them disabled here
WritePSRc SVC_mode, R1
[ GS_BufferNotStack
AND R2, R2, #GS_NoQuoteMess :OR: GS_NoVBarStuff :OR: GS_Spc_term
; get caller's flags
]
; If no tokens to expand then don't reset evaluation stack
; This prevents conflict with modules opening messages files at lower levels
Push "r0"
10 LDRB r1, [r0], #1
CMP r1, #13
CMPNE r1, #10
CMPNE r1, #0
Pull "r0",EQ
BEQ %FT20 ; Jump if end of string, nothing to expand
TEQ r1, #"<" ; Possibly something to expand?
BNE %BT10 ; No then try next
Pull "r0"
; Expansion may be necessary so flatten evaluation stack
[ GS_BufferNotStack
GSVarGetWSpace
LDRB R1, [R12, #GS_StackPtr]
AND R1, R1, #(GS_StackPtr_Lim-1) ; Ensure we remain in range
STRB R1, [R12, #GS_StackPtr]
ORR R2, R2, R1, LSL #GS_StackLimitPos
|
MOV R1, #0
GSVarGetWSpace
STRB R1, [R12, #GS_StackPtr] ; no stacked R0s
]
20
[ GS_BufferNotStack
|
AND R2, R2, #GS_NoQuoteMess :OR: GS_NoVBarStuff :OR: GS_Spc_term
; get caller's flags
]
EOR R2, R2, #GS_Spc_term ; and invert for convenience
01 LDRB R1, [R0], #1
CMP R1, #" "
BEQ %BT01
TST R2, #GS_NoQuoteMess
CMPEQ R1, #""""
SUBNE R0, R0, #1 ; dec if went too far
ORREQ R2, R2, #GS_In_String ; set flag if in string
CMP R1, #13
CMPNE R1, #10
CMPNE R1, #0
ORREQ lr, lr, #Z_bit ; and move EQ/NE to return pc
BICNE lr, lr, #Z_bit
ExitSWIHandler
LTORG
; -----------------------------------------------------------------------------
GSREAD ROUT
; In : R0, R2 from last GSREAD/GSINIT
; Out : R1 character, R0, R2 updated.
; VS => "Bad String" error
; CS => string ended (in which case R1 = terminator)
; enable interupts as (a) they'll get enabled by a <thing> entry
; and (b) GSREAD may take some time
WritePSRc SVC_mode, R10
BIC lr, lr, #C_bit
MOV R10, #0
TST R2, #GS_ReadingString
BNE GSREAD_RStringGetNextByte ; take byte from stringvar
GSREAD_XPandGetNextByte
LDRB R1, [R0], #1
CMP R1, #13
CMPNE R1, #10
CMPNE R1, #0
BEQ GSREAD_XPandGotToEnd
CMP R1, #" "
BEQ GSREAD_XPandGotSpace
BLT GSREAD_BadStringError ; bad string : control code in string
CMP R1, #""""
BEQ GSREAD_XPandGotQuote
CMP R1, #"|"
TSTEQ R2, #GS_NoVBarStuff
BEQ GSREAD_WorkOutBarChar
CMP R1, #"<"
BNE GSREAD_ReturnWithChar ; OS_Exit with valid character
; got to try and get a variable value.
Push "R0, R2, lr"
LDRB R1, [R0]
CMP R1, #">"
CMPNE R1, #" "
BEQ GSREAD_AngleBraDaftSoIsnt ; <> and < > are silly.
; Copy angle bracketed thing checking for correct termination
; OS_SetVarValue requires system variable names to be space or control
; terminated, so we shall discard anything which violates that rule
GSVarGetWSpace
ADD R12, R12, #GSNameBuff
MOV R11, #0
20 LDRB R1, [R0], #1
STRB R1, [R12], #1
ADD R11, R11, #1
CMP R1, #">"
BEQ %FT25
CMP R11, #?GSNameBuff
CMPNE R1, #" "
TSTNE R1, #&E0 ; i.e. EQ if <32
BNE %BT20
B GSREAD_AngleBraDaftSoIsnt
25
; Check for number first
MOV R1, #0
STRB R1, [R12, #-1] ; terminate it
SUB R1, R12, R11 ; pointer to name or number
Push "R0"
MOV R0, #10
SWI XOS_ReadUnsigned ; check for number
Pull "R0"
BVS GSREAD_AngledThingAintNumber ; silly - has to be name
LDRB R1, [R1] ; check terminated by the null
CMP R1, #0
BNE GSREAD_AngledThingAintNumber
MOV R1, R2 ; character value
ADD stack, stack, #4 ; discard old R0 value.
Pull "R2, lr"
B GSREAD_ReturnWithChar ; exit-R1's the char value.
GSREAD_AngledThingAintNumber
; R0, R2, lr on stack
Push "R0, R3, R4, R10" ; corrupted by VarFindIt
MOV R3, #0 ; context ptr
SUB R0, R12, R11 ; name ptr
BL VarFindIt
Pull "R0, R3, R4, R10", EQ ; not found mate
BEQ GSREAD_AngledThingNotThere ; return null expansion
; well, we've found it - better stack old R0
Pull "R0"
GSVarGetWSpace
[ GS_BufferNotStack
LDRB r1, [r12, #GS_StackPtr]
LDR r2, [sp, #4*4] ; r3,r4,r10,r0,r2,lr on stack, hence r2 retrieved
MOV r2, r2, ASL #32-(GS_StackLimitPos+GS_StackLimitBits)
SUB r2, r2, #1:SHL:(32-GS_StackLimitBits)
TEQ r1, r2, LSR #32-GS_StackLimitBits
BEQ GSREAD_CantNestMore
|
LDRB R1, [R12, #GS_StackPtr]
CMP R1, #GS_StackPtr_Lim
BHS GSREAD_CantNestMore
]
ADD R12, R12, #GS_Stack
STR R0, [R12, R1, LSL #2]
ADD R1, R1, #1
[ GS_BufferNotStack
AND R1, R1, #(GS_StackPtr_Lim-1)
]
STRB R1, [R12, #GS_StackPtr-GS_Stack]
MOV R0, R4
LDRB R1, [R0], #1 ; type
CMP R1, #VarType_Code
BEQ GSREAD_CallCodeVar
CMP R1, #VarType_Number
LDRB R1, [R0], #1
LDRB R3, [R0], #1
ORR R1, R1, R3, LSL #8
LDRB R3, [R0], #1
ORR R1, R1, R3, LSL #16
BLO GSREAD_GotVarAsString
BHI GSREAD_GotMacroVar
LDRB R3, [R0], #1
ORR R1, R1, R3, LSL #24
MOV R0, R1
ADD R1, R12, #GSNameBuff-GS_Stack
MOV R2, #256
SWI XOS_BinaryToDecimal
MOV R0, R1
MOV R1, R2
; it's a string variable, by now.
GSREAD_GotVarAsString
Pull "R3, R4, R10"
ADD stack, stack, #4 ; discard that R0
Pull "R2, lr"
CMP R1, #0
BEQ ZeroLengthVar
ORR R2, R2, R1 ; old flags+new count
ORR R2, R2, #GS_ReadingString
LDRB R1, [R0], #1
B GSREAD_ReturnWithChar
GSREAD_GotMacroVar
; Macro - R0 is now the ptr to the macro value.
Pull "R3, R4, R10"
ADD stack, stack, #4
Pull "R2, lr"
ORR R2, R2, #GS_Macroing
B GSREAD_XPandGetNextByte ; loop, transforming chars.
GSREAD_CantNestMore
Pull "R3, R4, R10" ; no room to stack pointer, so don't expand
GSREAD_AngledThingNotThere
ADD stack, stack, #4 ; skip R0 - return null string
Pull "R2, lr"
B GSREAD_XPandGetNextByte ; get next char
GSREAD_AngleBraDaftSoIsnt
Pull "R0, R2, lr"
MOV R1, #"<"
B GSREAD_ReturnWithChar ; failed to get sensible variable
GSREAD_XPandGotToEnd
TST R2, #GS_In_String ; got CR or LF
BNE GSREAD_BadStringError ; bad string
TST R2, #GS_Macroing
GSREAD_GotToAnEnd
ORREQ lr, lr, #C_bit ; got terminator
ExitSWIHandler EQ
; Nest out by one level
GSVarGetWSpace
LDRB R11, [R12, #GS_StackPtr]
[ GS_BufferNotStack
SUB R11, R11, #1
AND R11, R11, #(GS_StackPtr_Lim-1)
MOV r2, r2, ROR #GS_StackLimitPos+GS_StackLimitBits
TEQ r11, r2, LSR #32-GS_StackLimitBits
MOV r2, r2, ROR #32-(GS_StackLimitPos+GS_StackLimitBits)
|
SUBS R11, R11, #1
]
BICEQ R2, R2, #GS_Macroing
STRB R11, [R12, #GS_StackPtr]
ADD R12, R12, #GS_Stack
LDR R0, [R12, R11, LSL #2]
B GSREAD_XPandGetNextByte ; return to prevstring
GSREAD_XPandGotSpace
TST R2, #(GS_In_String :OR: GS_Spc_term :OR: GS_Macroing)
; got space : check termination
BEQ GSREAD_GotToAnEnd ; terminates
GSREAD_ReturnWithChar
ORR R1, R1, R10 ; valid character
ExitSWIHandler
GSREAD_XPandGotQuote
TST R2, #GS_In_String
BEQ GSREAD_ReturnWithChar ; if not in string, " is valid.
LDRB R1, [R0], #1
CMP R1, #"""" ; "" in string?
BEQ GSREAD_ReturnWithChar ; yup
; TMD 25-Sep-89: Fix termination here
10
CMP R1, #" "
LDREQB R1, [R0], #1
BEQ %BT10
SUB R0, R0, #1
ORR lr, lr, #C_bit ; got terminator (second ")
ExitSWIHandler ; and out
GSREAD_WorkOutBarChar
LDRB R1, [R0], #1 ; got |, do traditional escaping
CMP R1, #"|"
CMPNE R1, #""""
CMPNE R1, #"<"
BEQ GSREAD_ReturnWithChar ; || gives |, |" gives ", |< gives <
CMP R1, #"?"
MOVEQ R1, #&7F ; delete
BEQ GSREAD_ReturnWithChar ; valid ch
CMP R1, #"!"
MOVEQ R10, #&80
BEQ GSREAD_XPandGetNextByte ; tbs char
CMP R1, #" "
BLT GSREAD_BadStringError ; OS_Control character is naff
CMP R1, #&7F ; CTRL-delete is delete
EORGT R1, R1, #&20 ; softkey
BGE GSREAD_ReturnWithChar ; now valid ch
CMP R1, #"`" ; CTRL-` = CTRL-_
MOVEQ R1, #"_"
CMP R1, #"@"
ANDGE R1, R1, #&1F ; transform if @<=ch<delete
B GSREAD_ReturnWithChar
GSREAD_RStringGetNextByte
SUB R2, R2, #1 ; we're reading a string
[ GS_BufferNotStack
MOVS R12, R2, ASL #32-GS_StackLimitPos
|
ANDS r12, r2, #&00ffffff
]
LDRNEB R1, [R0], #1 ; and this is already expanded
ExitSWIHandler NE ; so finished
ZeroLengthVar
GSVarGetWSpace
LDRB R0, [R12, #GS_StackPtr] ; pull an R0 from our stack
SUB R0, R0, #1
[ GS_BufferNotStack
AND R0, R0, #(GS_StackPtr_Lim-1)
]
STRB R0, [R12, #GS_StackPtr]
ADD R12, R12, #GS_Stack
LDR R0, [R12, R0, LSL #2]
BIC R2, R2, #GS_ReadingString
B GSREAD_XPandGetNextByte
GSREAD_BadStringError
ADR R0, BadStrErr
[ International
Push "lr"
BL TranslateError
Pull "lr"
]
ORR lr, lr, #V_bit :OR: C_bit
ExitSWIHandler
BadStrErr
MakeErrorBlock BadString
GSREAD_CallCodeVar
ADD R0, R0, #3 + 4 ; 3 to ALIGN, 4 to get to read entry
MOV lr, PC ; get link
BIC PC, R0, #3 ; call entrypoint to Read Thunk
MOV R1, R2
B GSREAD_GotVarAsString
; ---------------------------------------------------------------------------
GSTRANS ROUT ; enables interrupts
; In : R0 ptr to input string
; R1 ptr to Out buffer
; R2 max number of chars, with flags at top.
; Out : R0 points at terminator
; R1 unchanged
; R2 Number of chars got,
; C set if too many chars
; V set if bad string.
BIC lr, lr, #C_bit
Push "R1, R3-R5, lr"
WritePSRc SVC_mode, R3 ; enable ints.
MOV R3, R1
MOV R4, R1 ; two copies of start ptr
BIC R5, R2, #&E0000000
ADD R5, R5, R1 ; 1st byte we can't write to.
SWI XOS_GSInit
01 CMP R3, R5
BHS %FT03 ; no rheum for byte.
SWI XOS_GSRead
BVS %FT02 ; bad string
STRB R1, [R3], #1
BCC %BT01
04 SUB R2, R3, R4 ; no chars got
SUB R2, R2, #1
Pull "R1, R3-R5, lr"
ExitSWIHandler
02 SUB R2, R3, R4
Pull "R1, R3-R5, lr"
B SLVK_SetV ; bad string: error set by GSRead
03 SUB R2, R3, R4
Pull "R1, R3-R5, lr"
ORR lr, lr, #C_bit ; buffer overflow
ExitSWIHandler
;****************************************************************************
; Read/Write variables
; Also the binary->decimal SWI.
; All the var SWIs enable interrupts - they all take quite a while.
; First the lookup SWI, ReadVarValue
; In:
; R0 -> name; maybe wildcarded (* and #)
; R1 -> buffer
; R2 = buffer max length
; R3 = 0 or pointer to name returned from previous ReadVarVal
; R4 = VarType_Expanded or something else
; Out:
; Not found:
; R0 -> VarCantFind error
; R1 unaltered
; R2 = 0
; R3,r4 trashed
; VSet
; Found, r2 < 0 and r4 <> VarType_Expanded on entry:
; R0, R1 unaltered
; R2 = NOT length of value
; R3 -> name of variable (0-terminated)
; R4 = type of result
; Found, r2 < 0 and r4 = VarType_Expanded on entry:
; R0, R1 unaltered
; R2 = -ve
; R3 -> name of variable (0-terminated)
; R4 = type of result
; Found, r2 >= 0 on entry:
; R0, R1 unaltered
; R2 no chars got
; R3 -> name of variable. Can be passed to this SWI to continue enumeration
; of wildcard.
; R4 type of result (VarType_String, VarType_Number, VarType_Macro)
; VSet if buffer overflowed (R0->error block)
[ Oscli_QuickAliases
; R0 in = -1 is special case: skip call to VarFindIt (r5,r6,r7 in supply r3,r4,r12)
]
ReadVarValue ROUT
WritePSRc SVC_mode, r11 ; enable interupts (mode remains unchanged)
Entry "r0,r1"
MOV r11, r4
[ Oscli_QuickAliases
CMP r0, #-1
BNE rvv_noqaspecialentry
MOV r3,r5
MOV r4,r6
MOV r12,r7
B rvv_qaspecialentry
rvv_noqaspecialentry
]
BL VarFindIt ; name=r0,context=r3 -> name found in node=r3,r4=after namein,r12=prev
BEQ RVVNotFound
[ Oscli_QuickAliases
rvv_qaspecialentry
]
; Regardless of expanded or not - always call the code to get value
LDRB lr, [r4], #1
TEQ lr, #VarType_Code
BEQ ReadVarVal_CallCode
; Check whether expanded value wanted and pick up found variable's type
TEQ r11, #VarType_Expanded
MOV r11, r4
MOV r4, lr
BEQ ReadVarVal_ExpandedWanted
; Unexpanded value wanted....
; If number then want 4 bytes, else however many there are in the varval
TEQ r4, #VarType_Number
MOVEQ r10, #4
ReadVarVal_CopyStringVarToUserBuffer
; R1 -> user buffer
; R2 = user buffer size
; R3 -> name of sysvar found
; R4 = sysvar type to return
; R10 = length to transfer to user buffer (EQ only)
; R11 -> length byte(s) of sysvar (NE only)
; -> bytes string to transfer (EQ only)
LDRNEB r10, [r11], #1
LDRNEB lr, [r11], #1
ORRNE r10, r10, lr, ASL #8
LDRNEB lr, [r11], #1
ORRNE r10, r10, lr, ASL #16
ReadVarVal_CopyR10BytesToUserBuffer
; R1 -> user buffer
; R2 = user buffer size
; R3 -> name of sysvar found
; R4 = type byte to be returned
; R10 = bytes to be copied
; R11 -> bytes to be copied
CMP R10, R2
BGT ReadVarVal_BufWillOFlow
VarNoOFlo
; Guaranteed the the buffer won't overflow now
MOV R2, R10 ; bytes he's gonna get
; now copy R10 bytes into buffer
02 SUBS R10, R10, #1
LDRPLB R12, [R11, R10]
STRPLB R12, [R1, R10]
BPL %BT02
ReadVarVal_OKExit
PullEnv
ExitSWIHandler
ReadVarVal_BufWillOFlow
; Have determined that the buffer will overflow, so generate an error
; and shorten down to the buffer's size
ADR r0, BufferOFloError
[ International
BL TranslateError
]
STR r0, [stack, #Proc_LocalStack + 0*4]
LDR lr, [stack, #Proc_LocalStack + 2*4]
ORR lr, lr, #V_bit ; set for return
STR lr, [stack, #Proc_LocalStack + 2*4]
; ensure NOT length returned in r2 when returning with r2<0 on entry
CMP r2, #0
MVNMI r10, r10
MOVPL r10, r2
B VarNoOFlo
BufferOFloError
MakeErrorBlock BuffOverflow
ReadVarVal_CallCode
Push "r0-r2" ; read sysvar : r4 points after type
ADD r11, r4, #3 + 4 ; 3 to align and 4 to get to read entry
MOV lr, pc ; construct link
BIC pc, r11, #3 ; call read code in var
MOV r11, r0 ; ptr to value
MOV r10, r2 ; no of chars.
Pull "r0-r2"
; error may be returned from reading the var val
MOVVS r0, r11
BVS ReadVarVal_TestVExit
MOV r4, #VarType_String
B ReadVarVal_CopyR10BytesToUserBuffer
ReadVarVal_ExpandedWanted
; Request for expanded value....
; Check for number, string or macro
CMP R4, #VarType_Number
BLT ReadVarVal_CopyStringVarToUserBuffer
BEQ ReadVarVal_FoundNumber
; macro - gstrans it. R1 buffer ptr, r2 max chars, R11+1 ptr to value.
; Macros have a terminator after their value, to allow GSTRANS.
CMP r2, #0 ; if negative, then don't call GSTrans because bits 29..31 have
MVNMI r10, r2 ; return r2 out by this method
BMI ReadVarVal_BufWillOFlow ; a special meaning - just branch back to the normal overflow code
ADD r0, r11, #3 ; skip length
SWI XOS_GSTrans
BVS ReadVarVal_TestVExit
BCC ReadVarVal_OKExit
ADR R0, BufferOFloError
[ International
BL TranslateError
]
B ReadVarVal_SetVExit
ReadVarVal_FoundNumber
; Found a number - extract its value and convert to string
LDRB R0, [R11], #1 ; number - convert to string.
LDRB R12, [R11], #1
ORR R0, R0, R12, LSL #8
LDRB R12, [R11], #1
ORR R0, R0, R12, LSL #16
LDRB R12, [R11]
ORR R0, R0, R12, LSL #24
; got number in R0, buffptr in R1, max chars in R2
SWI XOS_BinaryToDecimal
MOV r4, #VarType_String
ReadVarVal_TestVExit
STRVS r0, [stack, #Proc_LocalStack + 0*4]
PullEnv
B SLVK_TestV
RVVNotFound
[ International
MOV r4, r0
ADR r0, RVVNFError
BL TranslateError_UseR4
|
ADR R0, RVVNFError
]
MOV r2, #0 ; indicate not found.
ReadVarVal_SetVExit
STR r0, [stack, #Proc_LocalStack + 0*4]
PullEnv
B SLVK_SetV ; general error return
RVVNFError
MakeErrorBlock VarCantFind
; *****************************************************************************
; SWI OS_SetVarVal : create/update/destroy a variable.
; In: R0 pointer to name (can be wildcarded for update/delete)
; ctrl/char or space terminated
; R1 pointer to value. String values must be CR or LF terminated.
; R2 negative means destroy the variable. +ve is update/create
; R3 name pointer or 0
; R4 type.
;
; Evaluation of value : this depends on the type.
; VarType_String : GSTRANS the given value
; VarType_Number : Value is a 4 byte (signed) integer
; VarType_Macro : Copy value (may be GSTRANSed on use)
; VarType_Expanded : the value is a string which should be evaluated as an
; expression. Variable is then numeric or string
; VarType_LiteralString : Copy the given value as a string
;
; VarType_Code : R2 is the length of the code to copy in, including
; padding to align the code.
; Can only delete sysvars if R4 = VarType_Code
; Out: R3 new name pointer (so can delete all occurrences of f*, etc.
; slightly more efficiently).
; R4 type created for expressions
; V set for :
; 1) bad name (creation of wildcarded names is banned)
; 2) Bad string from GSTRANS
; 3) Bad macro value (control codes not allowed)
; 4) Bad expression from ReadExpression
; 5) Can't find (for deletion)
; 6) Not enough room to create/update it (system heap full)
; 7) Value too long (variables are limited to 256 bytes in length)
; 8) Bad type (update/create)
[ DebugSysVars
SysVar_Write0 Entry "r0,r1"
MOV r1, r0
10
LDRB r0, [r1], #1
CMP r0, #" "
EXIT LO
SWI XOS_WriteC
B %BT10
]
SetVarValue
; enable IRQs
WritePSRc SVC_mode, r10
Entry "r0,r1,r2,r4,r5,r6,r9"
[ DebugSysVars
SWI XOS_WriteS
= "SetVarVal ",0
BL SysVar_Write0
SWI XOS_NewLine
]
MOV r9, stack
MOV r10, r4
CMP r2, #0
BMI SetVarVal_DeleteIt
; Range check type
CMP r10, #VarType_Code
CMPNE r10, #VarType_LiteralString
ADRHIL r0, ErrorBlock_BadVarType
BHI SetVarValBadExit_Translate
; Always expand a VarType_Expanded:
TEQ r10, #VarType_Expanded
BNE SetVarVal_AintExpanded
; Process VarType_Expanded
MOV r0, stack, LSR #20 ; SVC stack base assumed on 1M boundary
SUB r0, sp, r0, LSL #20 ; amount of stack left
CMP r0, #LongCLISize + 2048 ; insist on 2k left after long buffer
MOVHS r2, #LongCLISize ; ok, got a long buffer
MOVLO r2, #256 ; stack full-ish, use a 256 buffer and hope it's big enough
SUB stack, stack, r2
MOV r0, r1 ; ptr to expression
MOV r1, stack
SWI XOS_EvaluateExpression
BVS SetVarVal_TestVExit
TEQ r1, #0 ; integer?
MOVNE r10, #VarType_LiteralString
MOVEQ r10, #VarType_Number
STREQ r2, [stack]
MOVEQ r2, #4
STR r10, [r9, #3*4] ; r4 out
MOV r1, stack
LDR r0, [r9, #0*4]
SetVarVal_AintExpanded
; Setting a variable
BL VarFindIt
BNE SetVarVal_NodeAlreadyExists
; Node missing....
; Check variable name has no wildcards
SUB r4, r0, #1
05
LDRB lr, [r4, #1]!
CMP lr, #"#"
CMPNE lr, #"*"
CMPNE lr, #" "
BHI %BT05
CMP lr, #"#"
CMPNE lr, #"*"
CMPNE r4, r0
ADREQL r0, ErrorBlock_BadVarNam
BEQ SetVarValBadExit_Translate ; error no. 1)
; R12 index of 1st entry in QuickIndex >= the entry we're interested in
MOV r3, #0 ; To indicate absence of current
B SetVarVal_CreateNode
SetVarVal_NodeAlreadyExists
MOV r0, r3 ; If already there use that's name in case supplied name wildcarded
LDRB lr, [r4]
TEQ lr, #VarType_Code
BNE SetVarVal_CreateNode
TEQ r10, #VarType_Code
BEQ SetVarVal_CreateNode
; Assign non code value to code node
CMP r10, #VarType_Number
BHI SetVarVal_AssignToCodeDoIt
BLO SetVarVal_AssignStringToCode
SUB stack, stack, #256 ; buffer
MOV r2, #256
; Assign a number to the code variable
LDRB r0, [r1], #1
LDRB lr, [r1], #1
ORR r0, r0, lr, LSL #8
LDRB lr, [r1], #1
ORR r0, r0, lr, LSL #16
LDRB lr, [r1], #1
ORR r0, r0, lr, LSL #24
MOV r1, stack
SWI XOS_BinaryToDecimal
B SetVarVal_AssignToCodeDoIt
SetVarVal_AssignStringToCode
MOV r0, stack, LSR #20 ; SVC stack base assumed on 1M boundary
SUB r0, sp, r0, LSL #20 ; amount of stack left
CMP r0, #LongCLISize + 2048 ; insist on 2k left after long buffer
MOVHS r2, #LongCLISize ; ok, got a long buffer
MOVLO r2, #256 ; stack full-ish, use a 256 buffer and hope it's big enough
SUB stack, stack, r2
; Expand string to stack frame then do it
MOV r0, r1
MOV r1, stack
SWI XOS_GSTrans
BVS SetVarVal_TestVExit
ADRCSL r0, ErrorBlock_VarTooLong
BCS SetVarValBadExit_Translate
SetVarVal_AssignToCodeDoIt
ADDS r4, r4, #3 + 1 ; skip type, add 3 for ALIGN , clear V
MOV lr, PC
BIC PC, R4, #3 ; complete align and call
B SetVarVal_TestVExit
SetVarVal_CreateNode
; Create a node
;
; r0 -> name (already confirmed non-wildcarded)
; r1 -> value
; r2 = length (where appropriate)
; r3 = this or 0
; r10 = type
; r12 = insertion point
MOV r5, r1
MOV r6, r3
; first work out the length of those things we can work the length of
; Header and name...
MOV r3, #0 ;accumulator for length of things we know
MOV r1, r0
10
LDRB lr, [r1], #1
ADD r3, r3, #1
CMP lr, #" "
BHI %BT10
;r3 is now name length +1 for terminator
ADD r3, r3, #1 ;add in 1 for the type byte
; Deal with number and string type
CMP r10, #VarType_Number
ADDLO r3, r3, #64 ; only an initial guess for the string type
ADDEQ r3, r3, #4
MOVEQ r2, #4
BLS SetVarVal_GotInitialLength
CMP r10, #VarType_Code
ADDEQ r3, r3, #3 ; ALIGN
BICEQ r3, r3, #3
ADDEQ r3, r3, r2 ; code
BEQ SetVarVal_GotInitialLength
TEQ r10, #VarType_LiteralString
BEQ %FT20
; Macro - strlen and check the value is vaguely OK
MOV r2, r5
15
LDRB lr, [r2], #1
CMP lr, #" "
BHS %BT15
TEQ lr, #0 ; must terminate with NUL, CR or LF
TEQNE lr, #10
TEQNE lr, #13
ADRNE r0, ErrorBlock_BadMacVal
BNE SetVarValBadExit_Translate
SUB r2, r2, r5
20
ADD r3, r3, r2
ADD r3, r3, #3 ; for the length bytes
SetVarVal_GotInitialLength
; r0 -> node's name
; r2 = value length (Number, Macro and Code)
; r3 = node length needed (maybe initial guess for Strings)
; r5 -> value (r1 in)
; r6 -> name of node to be replaced (0 if no node being replaced)
; r10 = value's type (String, Number, Macro or Code)
; r12 -> insertion point
Push "r0-r2"
[ SysVars_StickyNodes
ADD r3,r3,#SysVars_StickyNode_UnitSize-1
BIC r3,r3,#SysVars_StickyNode_UnitSize-1 ;so we don't fight sticky routines over sizes
BL SysVars_ClaimVNode
|
BL ClaimSysHeapNode
]
Pull "r0-r2",VS
BVS SetVarVal_VarNoRoom
; Got a heap block - fill it in
; Copy name
MOV r4, r2
LDR r0,[sp]
25
LDRB lr, [r0], #1
CMP lr, #" "
MOVLS lr, #0
STRB lr, [r4], #1
BHI %BT25
LDR r1,[sp,#8]
ADD sp,sp,#12 ; balances push r0-r2 above - value length (entry r2) now in r1
; Variable's type
TEQ r10, #VarType_LiteralString
MOVEQ lr, #VarType_String
MOVNE lr, r10
STRB lr, [r4], #1
TEQ r10, #VarType_String
BEQ SetVarVal_FillInString
TEQ r10, #VarType_Code
ADDEQ r4, r4, #3
BICEQ r4, r4, #3
Push "r4",EQ ; Remember start of code block for code variables
TEQNE r10, #VarType_Number
BEQ SetVarVal_CopyR1BytesToR4
; For macro type fill in a length
TEQ r10, #VarType_Macro
SUBEQ r1, r1, #1 ; ghastly fudge to avoid display of terminator
STRB r1, [r4], #1
MOV r1, r1, ROR #8
STRB r1, [r4], #1
MOV r1, r1, ROR #8
STRB r1, [r4], #1
MOV r1, r1, ROR #16
ADDEQ r1, r1, #1 ; undo ghastly fudge
B %FT35
30
LDRB lr, [r5], #1
STRB lr, [r4], #1
35
SetVarVal_CopyR1BytesToR4
SUBS r1, r1, #1
BHS %BT30
TEQ r10, #VarType_Code
BNE SetVarVal_NewNodeReady
Pull "r1" ; Grab pointer to start of code block
Push "r0,r2"
MOV r0,#1
MOV r2,r4
SWI XOS_SynchroniseCodeAreas
Pull "r0,r2"
B SetVarVal_NewNodeReady
SetVarVal_FillInString
; Here's the real smart bit of code
; The idea is this:
; Instead of GSTransing, we GSInit and GSRead ourselves. When the
; block gets full expand it and carry on. At the end the block is shrunk to fit.
ADD r4, r4, #3 ; for the length bytes
MOV r11, r4 ; preserve location of string start for when we've done
MOV r0, r5 ; r1 in
MOV r5, r2
MOV r2, #0
SWI XOS_GSInit
BVS SetVarVal_DisasterExpandingString
B %FT45
40
SWI XOS_GSRead
BVS SetVarVal_DisasterExpandingBadString
BCS SetVarVal_StringFinishedExpanding
STRB r1, [r4], #1
CMP r4, r3
BLO %BT40
; Run out of room in this block - stretch it
Push "r0-r2"
MOV r0, #HeapReason_ExtendBlock
MOV r2, r5
MOV r3, #64 ;should be a multiple of StickyNode_UnitSize if SysVars_StickyNodes TRUE
[ SysVars_StickyNodes
BL SysVars_ExpandOrShrinkVNode
|
BL DoSysHeapOpWithExtension
]
STRVS r0, [sp]
SUBVC lr, r2, r5
ADDVC r4, r4, lr
ADDVC r11, r11, lr
MOVVC r5, r2
Pull "r0-r2"
BVS SetVarVal_DisasterExpandingString
45
LDR r3, [r5, #-4] ; The heap block's size
[ SysVars_StickyNodes
SUB r3, r3, #8 ; the amount we're allowed to use
|
SUB r3, r3, #4 ; the amount we're allowed to use
]
ADD r3, r3, r5 ; the block's end
B %BT40
SetVarVal_StringFinishedExpanding
; Shorten block to required size
MOV r0, #HeapReason_ExtendBlock
[ SysVars_StickyNodes
Push "r4"
ADD r4, r4, #SysVars_StickyNode_UnitSize-1
BIC r4, r4, #SysVars_StickyNode_UnitSize-1 ;so we don't fight over sticky sizes
SUB r3, r4, r3
Pull "r4"
MOV r2, r5
BL SysVars_ExpandOrShrinkVNode
|
SUB r3, r4, r3
MOV r2, r5
BL DoSysHeapOpWithExtension
]
BVS SetVarVal_DisasterExpandingString
; Relocate pointers
SUB lr, r2, r5
ADD r4, r4, lr
ADD r11, r11, lr
; Work out ultimate size and store it
SUB lr, r4, r11
STRB lr, [r11, #-3]
MOV lr, lr, LSR #8
STRB lr, [r11, #-2]
MOV lr, lr, LSR #8
STRB lr, [r11, #-1]
SetVarVal_NewNodeReady
; r2 -> new node
; r6 -> old node's name (or is 0 if no old node)
; r12 = insertion point
[ DebugSysVars
Push "r0,r1,r2"
SUB sp, sp, #12
MOV r0, r2
MOV r1, sp
MOV r2, #12
SWI XOS_ConvertHex8
SWI XOS_Write0
SWI XOS_WriteI+" "
MOV r0, r6
MOV r1, sp
MOV r2, #12
SWI XOS_ConvertHex8
SWI XOS_Write0
SWI XOS_WriteI+" "
MOV r0, r12
MOV r1, sp
MOV r2, #12
SWI XOS_ConvertHex8
SWI XOS_Write0
SWI XOS_WriteI+" "
ADD sp, sp, #12
Pull "r0,r1,r2"
]
LDR r11, =ZeroPage+VariableList
LDR r10, [r11]
[ SysVars_QuickContext
TEQ r10,#0
ADDNE r10,r10,#SysVars_VTableOffset
]
MOV r5, r2
TEQ r6, #0
BEQ SetVarVal_Insertion
[ DebugSysVars
SWI XOS_WriteS
= "-straight replace-",0
]
MOV r2, r6
[ SysVars_StickyNodes
BL SysVars_FreeVNode
|
BL FreeSysHeapNode
]
B SetVarVal_Replace
SetVarVal_Insertion
[ DebugSysVars
SWI XOS_WriteS
= "-insert-",0
]
TEQ r10, #0
BNE SetVarVal_PossibleExtend
[ DebugSysVars
SWI XOS_WriteS
= "-create index-",0
]
[ SysVars_QuickContext
; SysVars_Vindex_NStart nodes, 1 word for the count, plus data before table
MOV r3, #SysVars_Vindex_NStart*4
ADD r3, r3, #4+SysVars_VTableOffset
|
MOV r3, #(10*4)+4 ; 10 nodes and 1 word for the count
]
BL ClaimSysHeapNode ; this is not a variable node (its the index)
BVS SetVarVal_NoRoomForIndex
[ SysVars_QuickContext
MOV r10,#-1
STR r10, [r2, #SysVars_LastContext] ; initialise last context as invalid
]
MOV r10, r2
MOV r4, #0
B SetVarVal_DoInsertNewBlock
SetVarVal_PossibleExtend
[ DebugSysVars
SWI XOS_WriteS
= "-extend index-",0
]
LDR r4, [r10]
[ SysVars_QuickContext
LDR lr, [r10, #-(4+SysVars_VTableOffset)] ; Block length, from heap block
SUB lr, lr, #4+4+SysVars_VTableOffset ; 4 for heap adjustment, 4 for entry count word, plus name buffer
|
LDR lr, [r10, #-4] ; Block length, from heap block
SUB lr, lr, #4+4 ; 4 for heap adjustment and 4 for entry count word
]
CMP lr, r4, ASL #2
BHI SetVarVal_DoInsert ; we've got room with this block
[ DebugSysVars
SWI XOS_WriteS
= "-do extend-",0
]
MOV r0, #HeapReason_ExtendBlock
[ SysVars_QuickContext
SUB r2, r10, #SysVars_VTableOffset
MOV r3, #SysVars_Vindex_NBump*4 ; room for SysVars_Vindex_NBump more nodes
|
MOV r2, r10
MOV r3, #40 ; room for 10 more nodes
]
BL DoSysHeapOpWithExtension ;not a variable node (expanding index)
BVS SetVarVal_NoRoomForIndex
MOV r10, r2
SetVarVal_DoInsertNewBlock
STR r10, [r11]
[ SysVars_QuickContext
ADD r10,r10,#SysVars_VTableOffset
]
SetVarVal_DoInsert
[ DebugSysVars
SWI XOS_WriteS
= "-doinsert-",0
]
ADD r0, r10, r12, ASL #2 ; insertion point
ADD r1, r10, r4, ASL #2 ; rover
B SetVarVal_DoInsertEnd
SetVarVal_DoInsertStart
LDR lr, [r1], #-4
STR lr, [r1, #8]
SetVarVal_DoInsertEnd
CMP r1, r0
BHS SetVarVal_DoInsertStart
ADD r4, r4, #1
STR r4, [r10]
SetVarVal_Replace
[ DebugSysVars
SWI XOS_WriteS
= "-doreplace-",0
]
STR r5, [r10, r12, ASL #2]
[ DebugSysVars
SWI XOS_WriteS
= "-done-",0
]
; All done
B SetVarVal_TestVExit
SetVarVal_DeleteIt
BL VarFindIt
; Error if not found
ADREQL r0, ErrorBlock_VarCantFind ; V set no. 1)
BEQ SetVarValBadExit_Translate
; Check if found vartype code that the supplied vartype was code too
LDRB lr, [r4]
TEQ lr, #VarType_Code
BNE %FT80
TEQ r10, #VarType_Code
BNE SetVarVal_TestVExit
80
LDR r11, =ZeroPage+VariableList
LDR r10, [r11]
[ SysVars_QuickContext
ADD r10,r10,#SysVars_VTableOffset
]
LDR r4, [r10]
ADD r0, r10, r12, ASL #2 ; rover
ADD r1, r10, r4, ASL #2 ; end
B SetVarVal_DoRemoveEnd
SetVarVal_DoRemoveStart
LDR lr, [r0, #4]!
STR lr, [r0, #-4]
SetVarVal_DoRemoveEnd
CMP r0, r1
BLO SetVarVal_DoRemoveStart
MOV r2, r3
[ SysVars_StickyNodes
BL SysVars_FreeVNode
|
BL FreeSysHeapNode
]
; Reduce number of nodes
SUB r4, r4, #1
STR r4, [r10]
; Construct best guess context ptr to be prev node (if present)
TEQ r12, #1
SUBHI r12, r12, #1
LDRHI r3, [r10, r12, ASL #2]
MOVLS r3, #0
SetVarVal_TestVExit
MOV stack, r9
STRVS r0, [stack]
PullEnv
B SLVK_TestV
SetVarValBadExit_Translate
[ International
BL TranslateError
]
SetVarValBadExit_NoTranslate
SETV
B SetVarVal_TestVExit
SetVarVal_DisasterExpandingString
SetVarVal_NoRoomForIndex
MOV r2, r5
BL FreeSysHeapNode ;forget stickiness (return node to heap is best here)
SetVarVal_VarNoRoom
ADR r0, ErrorBlock_VarNoRoom
B SetVarValBadExit_Translate
SetVarVal_DisasterExpandingBadString
Push "r0" ; Save bad string error
MOV r2, r5
BL FreeSysHeapNode ;forget stickiness (return node to heap is best here)
Pull "r0"
SETV
B SetVarVal_TestVExit
MakeErrorBlock BadVarType
MakeErrorBlock BadVarNam
MakeErrorBlock VarTooLong
MakeErrorBlock BadMacVal
MakeErrorBlock VarNoRoom
; *****************************************************************************
; Utility routines.
; -----------------------------------------------------------------------------
;
; VarFindIt
;
; In
; r0 -> (wildcard) name of variable to find
; r3 = context pointer
;
; Out
; r3 = name pointer
; r4 = pointer after name terminator
; r12 = insertion point (1st node >= this node)
; NE if found, EQ if not found
;
VarFindIt Entry "r0,r1,r2,r5,r6,r7,r8,r9,r10,r11"
; validate R3 by looking down the list to see if we find it.
; Crude, but effective!
[ DebugSysVars
SWI XOS_WriteS
= "VarFindIt(",0
BL SysVar_Write0
]
LDR r9, =ZeroPage+VariableList
LDR r9, [r9]
TEQ r9, #0
[ SysVars_QuickContext
LDRNE r12,[r9,#SysVars_LastContext]
MOVEQ r12,#-1 ;r12 = var table index for last context, or -1 if notvalid/notthere
ADDNE r9,r9,#SysVars_VTableOffset
]
LDRNE r8, [r9]
MOVEQ r8, #0
TEQ r3, #0
BEQ %FT20
[ DebugSysVars
SWI XOS_WriteS
= "-scan-",0
]
; r3 non-zero - scan list for entry
[ SysVars_QuickContext
;massive short cut - see if context is the last context we returned
CMP r12, r8 ;if not valid, or higher than current number of vars, forget it
BHI %FT04
LDR lr, [r9, r12, ASL #2]
CMP lr, r3
BEQ %FT70
04
;no such luck - scan list anyway
]
ADD r12, r8, #1
B %FT10
05
LDR lr, [r9, r12, ASL #2]
CMP lr, r3
BEQ %FT70 ; continue scan down list
10
SUBS r12, r12, #1
BHI %BT05
20
[ DebugSysVars
SWI XOS_WriteS
= "-wildcheck-",0
]
; not found in scan - check for name being wildcarded
MOV r10, r0
25
LDRB lr, [r10], #1
TEQ lr, #"*"
TEQNE lr, #"#"
BEQ %FT65
CMP lr, #" "
BHI %BT25
[ DebugSysVars
SWI XOS_WriteS
= "-bchop-",0
]
; Name not wildcarded - do binary chop search
ORRS r7, r8, r8, LSR #1
ORR r7, r7, r7, LSR #2
ORR r7, r7, r7, LSR #4
ORR r7, r7, r7, LSR #8
ORR r7, r7, r7, LSR #16
BICS r7, r7, r7, LSR #1 ; least 2^n <= number of entries
MOV r6, #0
B %FT60
40
ADD r5, r6, r7
CMP r5, r8
BHI %FT55
MOV r1, r0
LDR r4, [r9, r5, ASL #2]
45
LDRB r2, [r1], #1
CMP r2, #" "
MOVLS r2, #0
LDRB r3, [r4], #1
CMP r3, #" "
MOVLS r3, #0
UpperCase R2,LR
UpperCase R3,LR
CMP r3, r2
BNE %FT50
CMP r3, #0
BNE %BT45
50
MRSHS r10, CPSR ; preserve last HS result we got
MOVHS r11, r4
MOVLO r6, r5
55
MOVS r7, r7, LSR #1
60
BNE %BT40
; We always want the element above.
; If r6<r8 then we want the preserved result
; else we want the result HI
ADD r6, r6, #1
CMP r6, r8
LDRLS r3, [r9, r6, ASL #2]
[ SysVars_QuickContext
ASSERT SysVars_LastContext = SysVars_VTableOffset - 4
STRLS r6, [r9, #-4] ;save var table index for context we're returning, in LastContext
]
MOVLS r4, r11
MOVHI r3, #0
MSRLS CPSR_f, r10
[ DebugSysVars
SWI XOS_WriteS
= "-complete-",0
SWI XOS_NewLine
]
MOV r12, r6
TOGPSR Z_bit, lr
EXIT
65
[ DebugSysVars
SWI XOS_WriteS
= "-listscan-",0
SWI XOS_NewLine
]
; Scan down list looking for wildmatch
MOV r12, #0
70
ADD r12, r12, #1
CMP r12, r8
BHI %FT90 ; end of list reached
LDR r4, [r9, r12, ASL #2]
BL WildMatch ; trashes r10,r11
BNE %BT70
80
[ DebugSysVars
SWI XOS_WriteS
= "-complete-",0
SWI XOS_NewLine
]
; Found
; r4->name end
; r12 = entry number
LDR r3, [r9, r12, ASL #2]
[ SysVars_QuickContext
ASSERT SysVars_LastContext = SysVars_VTableOffset - 4
STR r12, [r9, #-4] ;save var table index for context we're returning, in LastContext
]
MOVS r12, r12 ; set NE
EXIT
90
; Not found
[ DebugSysVars
SWI XOS_WriteS
= "-not found-",0
SWI XOS_NewLine
]
MOV r12, #1
MOVS r3, #0
EXIT
WildMatch ROUT
; In : R0 is wildcard spec ptr, R4 is name ptr.
; Wild Terminators are any ch <=" ", name terminator 0
; Wildcards are *, #
; Out : EQ/NE for match (EQ if matches)
; R4 points after name terminator for found
; R0 preserved, R10, 11 corrupted
Push "R0-R3"
MOV R11, #0 ; this is the wild backtrack pointer
MOV R3, #0 ; and this is the name backtrack ptr.
01 LDRB R1, [R0], #1 ; nextwild
CMP R1, #"*"
BEQ %FT02 ; IF nextwild = "*"
LDRB R2, [R4], #1 ; nextname
CMP R2, #0
BEQ %FT03
UpperCase R1, R10
UpperCase R2, R10
CMP R1, R2 ; IF nextwild=nextname
CMPNE R1, #"#" ; OR nextwild = # (terminator checked already)
BEQ %BT01 ; THEN LOOP (stepped already)
MOV R0, R11 ; try backtrack
MOVS R4, R3 ; if * had at all
BNE %FT02
CMP PC, #0 ; set NE
04 Pull "R0-R3" ; return NE (failed)
MOV PC, lr
03 CMP R1, #" " ; name terminated : has wildcard?
BHI %BA04 ; note HI has NE set.
CMP R1, R1 ; set EQ
Pull "R0-R3"
MOV PC, lr
02 MOV R11, R0 ; wild backtrack ptr is char after *
LDRB R1, [R0], #1 ; step wild
CMP R1, #"*"
BEQ %BT02 ; fujj **
UpperCase R1, R10
05 LDRB R2, [R4], #1 ; step name
CMP R2, #0 ; terminator?
BEQ %BT03
UpperCase R2, R10
CMP R1, R2
CMPNE R1, #"#" ; match if #
BNE %BT05
MOV R3, R4 ; name backtrack ptr is char after match
B %BT01 ; LOOP
[ Oscli_QuickAliases
;routines to speed up alias checking for OS_CLI
;VarFindIt_QA - similar to VarFindIt
;
; In
; r3 -> non-wildcarded, already upper-cased name of var to find
; will be of form ALIAS$<whatever>
;
; Out
; r5 = name pointer (equivalent to r3 for VarFindIt
; r6 = pointer after name terminator (equivalent to r4 for VarFindIt)
; r7 = insertion point (equivalent to r12 for VarFindIt)
; NE if found, EQ if not found
;
VarFindIt_QA ROUT
Push "r0,r1,r2,r3,r4,r8,r9,r10,r11,LR"
MOV r0, r3
LDR r9, =ZeroPage+VariableList
LDR r9, [r9]
TEQ r9,#0
BEQ %FT99 ;exit with EQ (not found)
[ SysVars_QuickContext
ADD r9,r9,#SysVars_VTableOffset
]
LDR r8, [r9]
; do binary chop search
ORRS r7, r8, r8, LSR #1
ORR r7, r7, r7, LSR #2
ORR r7, r7, r7, LSR #4
ORR r7, r7, r7, LSR #8
ORR r7, r7, r7, LSR #16
BICS r7, r7, r7, LSR #1 ; least 2^n <= number of entries
MOV r6, #0
B %FT60
40
ADD r5, r6, r7
CMP r5, r8
BHI %FT55
MOV r1, r0
LDR r4, [r9, r5, ASL #2]
45
LDRB r2, [r1], #1
CMP r2, #" "
MOVLS r2, #0
LDRB r3, [r4], #1
CMP r3, #" "
MOVLS r3, #0
UpperCase R3,LR
CMP r3, r2
BNE %FT50
CMP r3, #0
BNE %BT45
50
MRSHS r10, CPSR ; preserve last HS result we got
MOVHS r11, r4
MOVLO r6, r5
55
MOVS r7, r7, LSR #1
60
BNE %BT40
; We always want the element above.
; If r6<r8 then we want the preserved result
; else we want the result HI
ADD r6, r6, #1
CMP r6, r8
LDRLS r5, [r9, r6, ASL #2]
; don't want to save context in this version of routine
MOV r7, r6
MOVLS r6, r11
MOVHI r5, #0
MSRLS CPSR_f, r10
TOGPSR Z_bit, lr
99
Pull "r0,r1,r2,r3,r4,r8,r9,r10,r11,PC"
] ;Oscli_QuickAliases
[ SysVars_StickyNodes
;
; SysVars_ClaimVNode
;
; entry: R3 = size required
; exit: R2 = address of allocated node, or V set for error
;
; if R3 > max sticky size, just delegates to ClaimSysHeapNode
; if R3 <= max sticky size, rounds up to next unit size, and attempts to pick
; up sticky node of that size - if not found, gets one from heap (now of size that can
; stick on free)
;
SysVars_ClaimVNode ROUT
Push "r0,r1,r3,LR"
CMP r3,#SysVars_StickyNode_MaxSize
BHI %FT80 ;too big for sticky node
ADD r3,r3,#SysVars_StickyNode_UnitSize-1
BIC r3,r3,#SysVars_StickyNode_UnitSize-1 ;round up to unit size
LDR r1,=ZeroPage+SysVars_StickyPointers
LDR r2,[r1,r3,LSR #(SysVars_StickyNode_Log2US-2)] ;sticky pointer for this size
CMP r2,#0 ;also clears V
BEQ %FT80
MOV LR,#0
STR LR,[r1,r3,LSR #(SysVars_StickyNode_Log2US-2)] ;used it
[ mjsSysHeapNodesTrace
Push "r0-r2"
LDR r0,=ZeroPage
LDR r1,[r0,#mjsSHNT_vcs_total]
ADD r1,r1,#1
STR r1,[r0,#mjsSHNT_vcs_total]
Pull "r0-r2"
]
Pull "r0,r1,r3,PC"
80 BL ClaimSysHeapNode
STRVS r0,[SP]
[ mjsSysHeapNodesTrace
Push "r0-r2"
LDR r0,=ZeroPage
LDR r1,[r0,#mjsSHNT_vch_total]
ADD r1,r1,#1
STR r1,[r0,#mjsSHNT_vch_total]
Pull "r0-r2"
]
Pull "r0,r1,r3,PC"
;
; SysVars_FreeVNode
;
; entry: R2 = address of node to free (must be valid)
; exit: -
; OR V set, error
;
; - checks size of node (uses internal knowledge of Heap blocks - naughty!)
; - if size is a sticky size, and the corresponding sticky pointer is 0, retains it,
; else delegates to FreeSysHeapNode
;
SysVars_FreeVNode
Push "r0,r1,r3,LR"
LDR r1,[r2,#-4] ;pick up OS_Heap's size word
SUB r1,r1,#8 ;sticky sizes will be 8 less than heap sizes
CMP r1,#SysVars_StickyNode_MaxSize ;is it too big?
BHI %FT80
TST r1,#SysVars_StickyNode_UnitSize-1 ;is it a multiple of unit size
BNE %FT80
LDR r3,=ZeroPage+SysVars_StickyPointers
LDR LR,[r3,r1,LSR #(SysVars_StickyNode_Log2US-2)] ;sticky pointer for this size
CMP LR,#0
STREQ r2,[r3,r1,LSR #(SysVars_StickyNode_Log2US-2)] ;stick!
80
[ mjsSysHeapNodesTrace
Push "r0-r2"
LDR r0,=ZeroPage
LDREQ r1,[r0,#mjsSHNT_vfs_total]
LDRNE r1,[r0,#mjsSHNT_vfh_total]
ADD r1,r1,#1
STREQ r1,[r0,#mjsSHNT_vfs_total]
STRNE r1,[r0,#mjsSHNT_vfh_total]
Pull "r0-r2"
]
BLNE FreeSysHeapNode
STRVS r0,[SP]
Pull "r0,r1,r3,PC"
;
; SysVars_ExpandOrShrinkVNode
;
; entry: R2 = address of block
; R3 = change of size required in bytes (signed integer)
; exit: R2 = address of block, which may have changed (block moved/copied)
; OR V set, error returned
;
; - checks size of node (uses internal knowledge of Heap blocks - naughty!)
; - assumes all VNodes currently less than MaxSize and of sticky size *must* be stickily
; allocated nodes (so that maximum current size that could be presumed by client is heap
; size minus 8, rather than minus 4)
; - if new size is small enough to be a sticky node, attempts to return a sticky node,
; without doing an OS_Heap grow or shrink, else delegates to DoSysHeapOpWithExtension
;
SysVars_ExpandOrShrinkVNode
Push "r0,r1,r3-r6,LR"
LDR r5,[r2,#-4] ;pick up OS_Heap's size word
SUB r5,r5,#4 ;usable sizes are 4 less than heap sizes
ADD r4,r5,r3 ;putative new size
CMP r4,#SysVars_StickyNode_MaxSize ;is it too big?
BHI %FT90
SUB r6,r5,#4 ;sticky sizes will be 8 less than heap sizes
SUB r4,r4,#4
ADD r4,r4,#SysVars_StickyNode_UnitSize-1
BIC r4,r4,#SysVars_StickyNode_UnitSize-1 ;round up to unit size
CMP r4,r6 ;same as current size?
BEQ %FT55
LDR r1,=ZeroPage+SysVars_StickyPointers
LDR LR,[r1,r4,LSR #(SysVars_StickyNode_Log2US-2)] ;sticky pointer for this size
CMP LR,#0
BEQ %FT40
MOV r3,#0
STR r3,[r1,r4,LSR #(SysVars_StickyNode_Log2US-2)] ;used it
MOV r5,r2
MOV r2,LR
B %FT50
40
MOV r5,r2
MOV r3,r4
BL SysVars_ClaimVNode
BVS %FT95
50 ;copy min(r6,r4) bytes (multiple of 8) from old node at r5 to new node at r2
CMP r4,r6
MOVLO r6,r4
MOV r3,r2
MOV LR,r5
52
LDMIA LR!,{r0,r1}
STMIA r3!,{r0,r1}
SUBS r6,r6,#8
BGT %BT52
MOV r6,r2
MOV r2,r5
BL SysVars_FreeVNode
MOV r2,r6
BVS %FT95
55
[ mjsSysHeapNodesTrace
Push "r0-r2"
LDR r0,=ZeroPage
LDR r1,[r0,#mjsSHNT_vxs_total]
ADD r1,r1,#1
STR r1,[r0,#mjsSHNT_vxs_total]
Pull "r0-r2"
]
CLRV
Pull "r0,r1,r3-r6,PC"
90
[ mjsSysHeapNodesTrace
Push "r0-r2"
LDR r0,=ZeroPage
LDR r1,[r0,#mjsSHNT_vxh_total]
ADD r1,r1,#1
STR r1,[r0,#mjsSHNT_vxh_total]
Pull "r0-r2"
]
MOV r0,#HeapReason_ExtendBlock
BL DoSysHeapOpWithExtension
95
STRVS r0,[SP]
Pull "r0,r1,r3-r6,PC"
] ;SysVars_StickyNodes
LTORG
END