Arthur2

; 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