; 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
GBLL LongVars
LongVars SETL {TRUE} ; Long system variables (>255 chars)
GBLL QuickIndex
QuickIndex SETL {TRUE} ; Quick index to binary chop on lookup
GBLL DebugSysVars
DebugSysVars SETL {FALSE}
;-----------------------------------------------------------------------------------
;
; This file covers:
; System variables:
; InitVariables
; OS_ReadVarVal
; OS_SetVarVal
; GSTrans:
; OS_GSInit
; OS_GSRead
; OS_GSTrans
; OS_BinaryToDecimal
; These have been grouped because GSTrans makes direct use of the system variables'
; structures and OS_BinaryToDecimal is used by readvarval.
;
; The system variables are stored as a one way sorted alphabetically linked list hanging
; off the zero-page location VariableList:
;
[ QuickIndex
; VariableList---->sorted table of pointers to variable blocks
|
; VariableList---->1st variable--->2nd variable--....-->last variable--->||
]
;
; The end is indicated by the link having the value 0.
;
; Each variable is stored in one block in the system heap. The format of each block is:
;
; Bytes Use
[ :LNOT: QuickIndex
; 4 Link. Points to next variable in the list. 0 indicates no more.
]
; N+1 Variable's name (length N with 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
; 1 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
; 1 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, =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"
GSVarGetWSpace
ADD R12, R12, #GSNameBuff
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
ORRS PC, LR, #V_bit
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"
GSVarGetWSpace
ADD R12, R12, #GSNameBuff
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"
GSVarGetWSpace
ADD R2, R12, #GSNameBuff+1 ; This code copied from OsWord0EAlpha
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, #?GSNameBuff-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
MOV R0, #0
LDR R0, [R0, #ReturnCode]
B ReadNumSysVar
SetRC Push "lr"
BL SetNumSysVar
LDR R4, =ReturnCode
STR R2, [R4]
LDR R4, =RCLimit
LDR R4, [R4]
CMP R2, R4
Pull "lr", LS
BICLSS PC, lr, #V_bit
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 MOV R0, #0
LDR R0, [R0, #RCLimit]
ReadNumSysVar
Push "lr"
GSVarGetWSpace
ADD R1, R12, #GSNameBuff
MOV R2, #256
SWI XOS_BinaryToDecimal
MOV R0, R1
Pull "PC"
SetRCL Push "lr"
BL SetNumSysVar
LDR R4, =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, =GSNameBuff+GSVarWSpace
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, =GSNameBuff+GSVarWSpace
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
TEQP pc, #SVC_mode
[ 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
; -----------------------------------------------------------------------------
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
TEQP pc, #SVC_mode
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
GSVarGetWSpace
ADD R12, R12, #GSNameBuff
MOV R11, #0
20 LDRB R1, [R0], #1
STRB R1, [R12], #1
ADD R11, R11, #1
CMP R11, #255
CMPNE R1, #13
CMPNE R1, #10
CMPNE R1, #0
BEQ GSREAD_AngleBraDaftSoIsnt
CMP R1, #">"
BNE %BT20
; Check for number first
MOV R1, #0
STRB R1, [R12, #-1] ; terminate it
SUB R1, R12, R11 ; pointer to name or number
Push "R0"
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
[ LongVars
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
|
BLO GSREAD_GotVarAsString
BHI GSREAD_GotMacroVar
; Got number var
LDRB R3, [R0], #1 ; number - build value
ORR R1, R1, R3, LSL #8
LDRB R3, [R0], #1
ORR R1, R1, R3, LSL #16
]
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
[ Fix16
; TMD 25-Sep-89: Fix termination here
10
CMP R1, #" "
LDREQB R1, [R0], #1
BEQ %BT10
SUB R0, R0, #1
|
10 LDRB R1, [R0], #1
CMP R1, #" "
BEQ %BT10
]
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
[ LongVars
[ GS_BufferNotStack
MOVS R12, R2, ASL #32-GS_StackLimitPos
|
ANDS r12, r2, #&00ffffff
]
|
TST R2, #&FF
]
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"
TEQP PC, #SVC_mode ; 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
BGE %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.
; Variable storage format is dead simple - linear list!
; It's not even ordered in any fashion.
; List has fixed section of system vars that cannot die.
; Node format : Link, Name bytes, 0 terminator (so Write0able), type byte,
; then 4 bytes for numeric
; or length byte, value bytes for string/macro.
; then a CR if it's a macro variable.
[ QuickIndex
VNameOff * 0
|
VarLink * 0
VNameOff * 4
]
; 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)
ReadVarValue ROUT
TEQP PC, #SVC_mode ; enable interupts (mode remains unchanged)
Entry "r0,r1"
MOV r11, r4
BL VarFindIt ; name=r0,context=r3 -> name found in node=r3,r4=after namein,r12=prev
BEQ RVVNotFound
; 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)
[ LongVars
LDRNEB r10, [r11], #1
LDRNEB lr, [r11], #1
ORRNE r10, r10, lr, ASL #8
LDRNEB lr, [r11], #1
ORRNE r10, r10, lr, ASL #16
|
LDRNEB r10, [r11], #1
]
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
[ LongVars
ADD r0, r11, #3 ; skip length
|
ADD r0, r11, #1 ; 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
;***************************************************************************
; The convert number to string SWI
; In : R0 signed 32-bit integer
; R1 pointer to buffer
; R2 max buffer length
; Out : R0, R1 unmodified
; R2 actual chars given
; V Set if buffer overflow
; Format : - if negative, leading zeros stripped.
CvtToDecimal ROUT
Push "R0, R3-R5"
MOV R12, R2
MOV R2, #0
CMP R0, #0
BPL %FT01
SUBS R12, R12, #1
BMI %FT10
MOV R11, #"-"
STRB R11, [R1]
MOV R2, #1
RSB R0, R0, #0
; now do digits.
01 RSB R0, R0, #0 ; get negative so minint works.
ADR R3, TenTimesTable
MOV R10, #9 ; max entry
MOV R4, #0 ; non-0 had flag
02 LDR R11, [R3, R10, LSL #2]
MOV R5, #-1 ; digit value
03 ADDS R0, R0, R11
ADD R5, R5, #1
BLE %BT03
SUB R0, R0, R11
CMP R5, #0
CMPEQ R4, #0
BNE %FT04 ; put digit
05 SUBS R10, R10, #1
BPL %BT02 ; next digit
CMP R4, #0
BEQ %FT04 ; R5 must be 0
Pull "R0, R3-R5"
ExitSWIHandler
04 SUBS R12, R12, #1
BMI %FT10 ; naff Exit
ADD R5, R5, #"0"
MOV R4, #-1
STRB R5, [R1, R2]
ADD R2, R2, #1
B %BT05
10
ADR R0, BufferOFloError
[ International
Push "lr"
BL TranslateError
Pull "lr"
]
Pull "R3" ; discard R0 in
Pull "R3-R5"
B SLVK_SetV
TenTimesTable
& 1
& 10
& 100
& 1000
& 10000
& 100000
& 1000000
& 10000000
& 100000000
& 1000000000
; *****************************************************************************
; 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)
[ LongVars
[ 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
TEQP pc, #SVC_mode
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
SUB stack, stack, #256
MOV r0, r1 ; ptr to expression
MOV r1, stack
MOV r2, #256
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)
[ QuickIndex
; R12 index of 1st entry in QuickIndex >= the entry we're interested in
|
; Variable name OK, find where in list we want to insert it
LDR r12, =VariableList
LDR r11, [r12]
CMP r11, #0
B %FT08
06
MOV r3, r0
ADD r4, r11, #VNameOff
07
LDRB r5, [r3], #1
LDRB r6, [r4], #1
CMP r5, r6 ; can't hit terminator :
BEQ %BT07 ; not same as any on list
MOVHI r12, r11
LDRHI r11, [r12, #VarLink]
CMPHI r11, #0
08
BHI %BT06
; r12 now ready as pointer to prev
]
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
; For both string and number give ourselves a stack frame
SUB stack, stack, #256
MOV r2, #256
BLO SetVarVal_AssignStringToCode
; 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
; 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
[ QuickIndex
; r12 = insertion point
|
; r12 = prev
]
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, #VNameOff + 1 ; Add one for the type byte
MOV r1, r0
10
LDRB lr, [r1], #1
ADD r3, r3, #1
CMP lr, #" "
BHI %BT10
; Deal with number and string type
CMP r10, #VarType_Number
ADDLO r3, r3, #50 ; 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)
[ QuickIndex
; r12 -> insertion point
|
; r12 -> prev node
]
Push "r0,r2"
BL ClaimSysHeapNode
BVS SetVarVal_VarNoRoom
Pull "r0,r1"
; Got a heap block - fill it in
; Copy name
ADD r4, r2, #VNameOff
25
LDRB lr, [r0], #1
CMP lr, #" "
MOVLS lr, #0
STRB lr, [r4], #1
BHI %BT25
; 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
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
SetVarVal_CopyR1BytesToR4
B %FT35
30
LDRB lr, [r5], #1
STRB lr, [r4], #1
35
SUBS r1, r1, #1
BHS %BT30
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
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
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
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)
[ QuickIndex
; r12 = insertion point
|
; r12 -> prevP
]
[ 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"
]
[ QuickIndex
LDR r11, =VariableList
LDR r10, [r11]
MOV r5, r2
TEQ r6, #0
BEQ SetVarVal_Insertion
[ DebugSysVars
SWI XOS_WriteS
= "-straight replace-",0
]
SUB r2, r6, #VNameOff
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
]
MOV r3, #44 ; 10 nodes and 1 for the count
BL ClaimSysHeapNode
BVS SetVarVal_NoRoomForIndex
MOV r10, r2
MOV r4, #0
B SetVarVal_DoInsertNewBlock
SetVarVal_PossibleExtend
[ DebugSysVars
SWI XOS_WriteS
= "-extend index-",0
]
LDR r4, [r10]
LDR lr, [r10, #-4] ; Block length
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
MOV r2, r10
MOV r3, #40 ; room for 10 more nodes
BL DoSysHeapOpWithExtension
BVS SetVarVal_NoRoomForIndex
MOV r10, r2
SetVarVal_DoInsertNewBlock
STR r10, [r11]
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
]
|
; Remove old node and place new node in its place
TEQ r6, #0
LDRNE lr, [r6, #-VNameOff]
LDREQ lr, [r12]
STR lr, [r2]
STR r2, [r12]
; If old node present then junk it
SUBNE r2, r6, #VNameOff
BLNE FreeSysHeapNode
]
; 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
[ QuickIndex
LDR r11, =VariableList
LDR r10, [r11]
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
SUB r2, r3, #VNameOff
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
ASSERT VNameOff = 0
LDRHI r3, [r10, r12, ASL #2]
MOVLS r3, #0
|
; Unlink node from chain
SUB r3, r3, #VNameOff
LDR r11, [r3, #VarLink]
STR r11, [r12, #VarLink]
MOV R2, R3 ; node ptr.
BL FreeSysHeapNode
ADD R3, R12, #VNameOff ; our best guess at a context ptr
]
SetVarVal_TestVExit
MOV stack, r9
STRVS r0, [stack]
PullEnv
B SLVK_TestV
SetVarValBadExit_Translate
BL TranslateError
SETV
B SetVarVal_TestVExit
SetVarVal_DisasterExpandingString
SetVarVal_NoRoomForIndex
MOV r2, r5
BL FreeSysHeapNode
SetVarVal_VarNoRoom
ADR r0, ErrorBlock_VarNoRoom
B SetVarValBadExit_Translate
SetVarVal_DisasterExpandingBadString
Push "r0" ; Save bad string error
MOV r2, r5
BL FreeSysHeapNode
Pull "r0"
SETV
B SetVarVal_TestVExit
MakeErrorBlock BadVarType
MakeErrorBlock BadVarNam
MakeErrorBlock VarTooLong
MakeErrorBlock BadMacVal
MakeErrorBlock VarNoRoom
|
SetVarValue ROUT
Push "R1, R2, R4, lr"
CheckSpaceOnStack 512, SVStackFull, r12
SUB stack, stack, #256 ; buffer space
CMP R2, #0
BMI SetVarVal_GotValueToBuffer ; deletion
; now range check type
CMP R4, #VarType_Code
BEQ SetVarVal_GotValueToBuffer
CMP R4, #VarType_Expanded
BGT SetVarVal_TypeNaff
; now get the value, before destroying anything
BEQ SetVarVal_AssignExpanded ; evaluate an expression
CMP R4, #VarType_Number
MOVEQ R2, #3 ; numbers use type byte as one byte.
BEQ SetVarVal_GotValueToBuffer
BGT SetVarVal_ValidateMacroValue
; string : GSTRANS it.
Push "R0"
MOV R0, R1 ; source ptr.
ADD R1, stack, #4
MOV R2, #255
SWI XOS_GSTrans
BVS VarBadStrErr
Pull "R0"
BCC SetVarVal_GotValueToBuffer
SetVarVal_GotValueToBufferButItsTooLong
LDR lr, [Stack, #4*3+256] ; V set no. 3): value too long
ORR lr, lr, #V_bit ; Poke V into stacked lr!
STR lr, [Stack, #4*3+256]
SetVarVal_GotValueToBuffer
; now got R1 pointer to value, R2 = value length
BL VarFindIt
BEQ SetVarVal_NodeNotFound
; Check whether we're assigning a Code value to a Code variable
LDRB R10, [R4] ; get type
CMP R10, #VarType_Code
BNE %FT30
LDR R10, [Stack, #4*2+256]
CMP R10, #VarType_Code
BNE SetVarVal_AssignNonCodeToCode
30
; We are assigning a code value to a code variable
; OR any value to a non-code variable
; deleting?
CMP R2, #0
BMI SetVarVal_GotToJunkOldNode ; just delete it.
; Assigning....
LDR R11, [R3, #-(VNameOff+4)] ; real no of bytes in heap node
SUB R11, R11, #VNameOff+4+2
ADD R11, R11, R3
SUB R11, R11, R4 ; take off bytes in name
CMP R11, R2
BGT SetVarVal_NodeReadyToCopyInValue
; let's copy the name, in case orig source wildcarded.
LDR R0, =GSVarWSpace+GSNameBuff
MOV R10, R3
15 LDRB R11, [R10], #1
STRB R11, [R0], #1
CMP R11, #0
BNE %BT15
LDR R0, =GSVarWSpace+GSNameBuff
SetVarVal_GotToJunkOldNode
; got to delete old node (too small). R12 previous, R3-VNameOff is this.
SUB R3, R3, #VNameOff
LDR R11, [R3, #VarLink]
STR R11, [R12, #VarLink] ; chain updated
Push "R0-R2"
MOV R2, R3 ; node ptr.
BL FreeSysHeapNode
Pull "R0-R2" ; node gone
ADD R3, R12, #VNameOff ; our best guess at a context ptr
CMP R2, #0 ; delete?
BMI SetVarValueTestExit ; yup - exit.
SetVarVal_MakeNewNode
; here, R2 is value length, R0 ptr to name. Validate name while finding length
MOV R10, #0
16 LDRB R11, [R0, R10]
ADD R10, R10, #1
CMP R11, #"#"
CMPNE R11, #"*"
BEQ SetVarVal_BadVarName ; error no. 1)
CMP R11, #32
BGT %BT16
CMP R10, #1
BEQ SetVarVal_BadVarName ; 0 char name also naff
; now got R10 name length. Calculate node size
ADD R11, R10, R2
ADD R11, R11, #VNameOff+2 ; link+name terminator+type
Push "R0-R3"
MOV R3, R11
BL ClaimSysHeapNode ; corrupts R12
MOV R4, R2
Pull "R0-R3"
BVS SetVarSysHeapFull
; now need to find correct alphabetic position on chain.
LDR R12, =VariableList
LDR R11, [R12]
; R4 node to insert, R12 prevnode, R11 nextnode
Push "R5, R6"
31 CMP R11, #0
BEQ %FT33
ADD R11, R11, #VNameOff
MOV R10, #-1
32 ADD R10, R10, #1
LDRB R5, [R0, R10]
LDRB R6, [R11, R10]
CMP R5, R6 ; can't hit terminator :
BEQ %BT32 ; not same as any on list
SUB R11, R11, #VNameOff
MOVGT R12, R11
LDRGT R11, [R12, #VarLink]
BGT %BT31
33
; Link node into list
STR R11, [R4, #VarLink]
STR R4, [R12, #VarLink] ; new entry in
Pull "R5, R6"
; Copy name to node
ADD R4, R4, #VNameOff
18 LDRB R11, [R0], #1
STRB R11, [R4], #1
CMP R11, #32
BGT %BT18
MOV R11, #0
STRB R11, [R4, #-1]
SetVarVal_NodeReadyToCopyInValue
; now easy: just copy new value in. R2 bytes, from (R1).R4 points to type
LDR R10, [stack, #2*4+256] ; get original type back
STRB R10, [R4], #1 ; put type in
CMP R10, #VarType_Macro
SUBEQ R2, R2, #1 ; fudge macro terminators
CMP R10, #VarType_Code
ADDEQ R4, R4, #3 ; align for code.
BICEQ R4, R4, #3
CMP R10, #VarType_Number
MOVEQ R2, #4
CMPNE R10, #VarType_Code ; no length for numbers, sysvars
STRNEB R2, [R4], #1
CMP R10, #VarType_Macro
ADDEQ R2, R2, #1
05 SUBS R2, R2, #1
BMI SetVarValueTestExit ; finished
LDRB R10, [R1, R2]
STRB R10, [R4, R2]
B %BT05
SetVarSysHeapFull
ADR r0, ErrorBlock_VarNoRoom ; VS no. 2)
B SetVarValueBadExit_256Translate
MakeErrorBlock VarNoRoom
SetVarVal_ValidateMacroValue
MOV R2, #0
13 CMP R2, #255
BGT SetVarVal_GotValueToBufferButItsTooLong
LDRB R10, [R1, R2] ; it's a macro: check for bad chars.
ADD R2, R2, #1
CMP R10, #31
BGT %BT13
CMP R10, #13
CMPNE R10, #10
CMPNE R10, #0
BEQ SetVarVal_GotValueToBuffer
ADR r0, ErrorBlock_BadMacVal
B SetVarValueBadExit_256Translate
MakeErrorBlock BadMacVal
SetVarVal_BadVarName
ADR r0, ErrorBlock_BadVarNam ; VS no. 2)
B SetVarValueBadExit_256Translate
MakeErrorBlock BadVarNam
SetVarVal_NodeNotFound
CMP R2, #0 ; no node for it, test whether deletion
BPL SetVarVal_MakeNewNode
ADRL r0, ErrorBlock_VarCantFind ; V set no. 1)
B SetVarValueBadExit_256Translate
SetVarVal_AssignNonCodeToCode
CMP R2, #0
BMI SetVarValueTestExit ; deletion's a NOP, when wrong type given
LDR R10, [stack, #2*4+256] ; get original type back
CMP R10, #VarType_Number
BNE %FT25
MOV R10, R0
LDRB R0, [R1], #1
LDRB R2, [R1], #1
ORR R0, R0, R2, LSL #8
LDRB R2, [R1], #1
ORR R0, R0, R2, LSL #16
LDRB R2, [R1], #1
ORR R0, R0, R2, LSL #24
ADD R1, stack, #0
MOV R2, #256
SWI XOS_BinaryToDecimal
MOV R0, R10 ; force string value.
25 ADDS R4, R4, #4 ; skip type, add 3 , clear V
MOV lr, PC
BIC PC, R4, #3 ; complete align and call
; set thunk must take R1 ptr to value, R2 value length
BVS SetVarValueBadExit_256
SetVarValueTestExit
ADD stack, stack, #256
LDR R10, [stack, #2*4]
TEQ R10, #VarType_Code
MOVEQ R1,R0
MOVEQ R0,#0
SWIEQ XOS_SynchroniseCodeAreas ; 'fraid so
MOVEQ R0,R1
Pull "R1, R2, R4, lr"
TST lr, #V_bit
ADRNE R0, ErrorBlock_VarTooLong
[ International
Push "lr",NE
BLNE TranslateError
Pull "lr",NE
]
ExitSWIHandler
MakeErrorBlock VarTooLong
SetVarVal_AssignExpanded
Push "R0"
MOV R0, R1 ; ptr to expression
ADD R1, stack, #4
MOV R2, #256
SWI XOS_EvaluateExpression
BVS NarffExpression
CMP R1, #0 ; integer?
MOVEQ R4, #VarType_Number
MOVNE R4, #VarType_String
BNE %FT40
ADD R1, stack, #8
STR R2, [R1]
MOV R2, #3
40
Pull "R0"
STR R4, [stack, #2*4+256] ; update original type
B SetVarVal_GotValueToBuffer
NarffExpression
ADD stack, stack, #256+4 ; discard an r0 and buffer
Pull "R1, R2, r4, lr"
B SLVK_SetV
SetVarVal_TypeNaff
ADR R0, ErrorBlock_BadVarType ; V set no. 4)
B SetVarValueBadExit_256Translate
MakeErrorBlock BadVarType
VarBadStrErr
Pull "R1"
SetVarValueBadExit_256Translate
BL TranslateError
SetVarValueBadExit_256
ADD stack, stack, #256
B SetVarValueBadExit
SVStackFull
ADRL r0, ErrorBlock_StackFull
BL TranslateError
SetVarValueBadExit
Pull "R1, R2, R4, lr"
B SLVK_SetV
]
; *****************************************************************************
; Utility routines.
; -----------------------------------------------------------------------------
;
; VarFindIt
;
; In
; r0 -> (wildcard) name of varibale to find
; r3 = context pointer
;
; Out
; r3 = name pointer
; r4 = pointer after name terminator
[ QuickIndex
; r12 = insertion point (1st node >= this node)
|
; r12 = address of previous node
]
; NE if found, EQ if not found
;
[ QuickIndex
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, =VariableList
LDR r9, [r9]
TEQ r9, #0
LDRNE r8, [r9]
MOVEQ r8, #0
TEQ r3, #0
BEQ %FT20
[ DebugSysVars
SWI XOS_WriteS
= "-scan-",0
]
; r3 non-zero - scan list for entry
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
MOVHS r10, pc ; 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]
MOVLS r4, r11
MOVHI r3, #0
TEQLSP pc, r10
[ DebugSysVars
SWI XOS_WriteS
= "-complete-",0
SWI XOS_NewLine
]
MOV r12, r6
MOV lr, pc
TEQP lr, #Z_bit
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]
ASSERT VNameOff = 0
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
|
VarFindIt Entry "r10,r11"
; validate R3 by looking down the chain to see if we find it.
; Crude, but effective!
CMP R3, #0
BEQ %FT03
SUB R3, R3, #VNameOff ; step back to chain ptr
LDR R11, =VariableList
LDR R11, [R11]
02 CMP R11, #0
CMPNE R11, R3
LDRNE R11, [R11, #VarLink]
BNE %BT02
CMP R11, #0
03 LDREQ R3, =VariableList
01 MOV R12, R3 ; keep previous for creation
LDR R3, [R3, #VarLink] ; step on
CMP R3, #0
EXIT EQ ; failed
ADD R4, R3, #VNameOff
BL WildMatch ; trashes r10,r11
BNE %BT01
ADDS R3, R3, #VNameOff ; get node ptr and set NE
EXIT ; and back with got.
]
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
LTORG
END