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

;mjs performance enhancements for Ursula (ChocolateSysVars)
;
                          GBLL    SysVars_QuickContext
                          GBLL    SysVars_StickyNodes
SysVars_QuickContext      SETL    {TRUE} :LAND: ChocolateSysVars   ;avoid abysmal O(n*n) enumeration of vars
SysVars_StickyNodes       SETL    {TRUE} :LAND: ChocolateSysVars   ;attempt to avoid lots of SysHeap operations,
                                                                   ;especially grows and shrinks

SysVars_Vindex_NStart     * 256   ;initial no. of vars supported by index
SysVars_Vindex_NBump      *  32   ;additional no. of vars each time index size is bumped up

  [ SysVars_QuickContext
;
;format of block anchored at VariableList
;
                     ^   0
SysVars_LastContext  #   4                    ;last var table index for last context ptr returned, or -1 if invalid
SysVars_VTableOffset #   0
;
;immediately followed by table data as in old code:
;  1 word   = total number of variables (N)
;  N words  = ptrs to variable blocks (sorted table)
;
  ]

  [ SysVars_StickyNodes
SysVars_StickyNode_UnitSize *  32             ;quantise node size to multiples of this many bytes
                                              ;(must be multiple of 8, and power of 2)
SysVars_StickyNode_Log2US   *   5             ;Log2 of unit size
SysVars_StickyNode_MaxSize  * 320             ;maximum size of node that may stick (be retained on removal as active node)
;
;There are currently 10 words allocated in kernel workspace for sticky pointers
      ASSERT  SysVars_StickyNode_UnitSize*10 = SysVars_StickyNode_MaxSize
  ]

        GBLL    DebugSysVars
DebugSysVars SETL {FALSE}


;-----------------------------------------------------------------------------------
;
; This file covers:
;   System variables:
;     InitVariables
;     OS_ReadVarVal
;     OS_SetVarVal
;   GSTrans:
;     OS_GSInit
;     OS_GSRead
;     OS_GSTrans
; These have been grouped because GSTrans makes direct use of the system variables'
; structures.
;
; The system variables are stored as a one way sorted alphabetically linked list hanging
; off the zero-page location VariableList:
;
; VariableList---->sorted table of pointers to variable blocks (QuickIndex) - format as above
;
; The end is indicated by the link having the value 0.
;
; Each variable is stored in one block in the system heap (block will be word aligned). The
; format of each block is:
;
; No. Bytes     Use
; N+1           Variable's name (length N, plus terminator).
; 1             Variable's type:
;                       0       string
;                       1       number
;                       2       macro
;                       3       expanded (not valid within sysvar structure)
;                       16      code
; M             data - depends on the variable's type
;
; The structure of the data is as follows:
;
; Type 0 - string
; Bytes         Use
; 3             Length (N)
; N             the bytes of the string - may contain any characters
;
; Type 1 - number
; Bytes         Use
; 4             its value (not necessarily word aligned)
;
; Type 2 - macro
; Bytes         Use
; 3             Length (N)
; N             the bytes of the string - must be a valid GSTransable string
;                       including terminator
;
; Type 16 - code
; Bytes         Use
; x             Sufficient to word align...
; 4             Write entry
; 4             Read entry
; N             The rest of the code

InitVariables  ROUT
        Push    "lr"

        ; Blank the sysvar list
        MOV     R0, #0
        LDR     R12, =ZeroPage+VariableList
        STR     R0, [R12]

        ; Set up the preset system variables
        ADR     R0, SystemVarList       ; R0 pointer to name
01      MOV     R1, R0
        LDRB    R2, [R1], #1
        CMP     R2, #0
        Pull    "PC", EQ
02      LDRB    R3, [R1], #1
        CMP     R3, #0
        BNE     %BT02
        LDRB    R4, [R1], #1            ; get type
        ADD     R1, R1, #3
        BIC     R1, R1, #3
        LDR     R2, [R1], #4
        SWI     XOS_SetVarVal
        ADD     R0, R1, R2
        B       %BT01

        LTORG

; System vars have Thunks :
; read thunk returns R0 ptr to string, R2 length. R1 corruptible
; set thunk takes R1 ptr to value, R2 length. Value is always a string.
; Can corrupt R1, R2, R4, R10-12

; The list of nodes to copy into RAM :
; name, 0 , type, ALIGN, size of value, value

SystemVarList  ROUT
        =       "Sys$$Time", 0, VarType_Code
        ALIGN
        &       sv2-.-4
        LDR     PC, %FT01
        LDR     PC, %FT02
01
        &       SetTimeVar
02
        &       ReadTimeVar

sv2     =       "Sys$$Year", 0, VarType_Code
        ALIGN
        &       sv3-.-4
        LDR     PC, %FT03
        LDR     PC, %FT04
03
        &       SetYear
04
        &       ReadYear

sv3     =       "Sys$$Date", 0, VarType_Code
        ALIGN
        &       sv4-.-4
        LDR     PC, %FT05
        LDR     PC, %FT06
05
        &       SetDate
06
        &       ReadDate

sv4     =       "Sys$$ReturnCode", 0, VarType_Code
        ALIGN
        &       sv5-.-4
        LDR     PC, %FT07
        LDR     PC, %FT08
07
        &       SetRC
08
        &       ReadRC

sv5     =       "Sys$$RCLimit", 0, VarType_Code
        ALIGN
        &       sv6-.-4
        LDR     PC, %FT09
        LDR     PC, %FT10
09
        &       SetRCL
10
        &       ReadRCL

sv6     =       "Alias$.", 0, VarType_String
        ALIGN
        &       sv7-.-4
        =       "Cat ", 10

sv7     =       "Sys$$DateFormat", 0, VarType_String
        ALIGN
        &       sv8-.-4

        [ {TRUE}
        =       "%24:%mi:%se %dy-%m3-%ce%yr", 10
        |
        =       "%w3,%dy %m3 %ce%yr.%24:%mi:%se", 10
        ]

sv8     =       0

SysTimeFormat
        =       "%24:%mi:%se", 0
SysDateFormat
        =       "%w3,%dy %m3", 0
SysYearFormat
        =       "%ce%yr", 0

        ALIGN

; Now the code for our system variables.

ReadTimeVar
        ADR     R0, SysTimeFormat
        B       ReadTimeFormatted
SetTimeVar ROUT
        CMP     R2, #&FE
        BHI     TimeVarTooLong
        Push    "R0, lr"
        LDR     R12, =SysVarWorkSpace
        MOV     R11, #8
        STRB    R11, [R12], #1
        MOV     R10, #0
        STRB    R10, [R12, R2]
        MOV     R10, R2
01      SUBS    R10, R10, #1
        LDRPLB  R11, [R1, R10]
        STRPLB  R11, [R12, R10]
        BPL     %BT01
        SUB     R1, R12, #1
        MOV     R0, #15
        SWI     XOS_Word
        STRVS   R0, [R13]
        Pull    "R0, PC"

TimeVarTooLong
        ADRL    R0, ErrorBlock_VarTooLong
      [ International
        B       TranslateError
      |
        RETURNVS
      ]

ReadYear
        ADR     R0, SysYearFormat
        B       ReadTimeFormatted
SetYear ROUT
        CMP     R2, #4
        BHI     TimeVarTooLong
        Push    "R0, lr"
        Push    "R1,R2"
        ADR     R0, SetYearPrefixFormat
        BL      ReadTimeFormatted
        ADD     R12, R0, R2             ; R12 -> position to copy year to
        Pull    "R1,R2"
        BVS     %FT02
        MOV     R10, #0
        STRB    R10, [R12, R2]
        MOV     R10, R2
01      SUBS    R10, R10, #1
        LDRPLB  R11, [R1, R10]
        STRPLB  R11, [R12, R10]
        BPL     %BT01
        SUB     R1, R0, #1
        MOV     R0, #15
        STRB    R0, [R1]
        SWI     XOS_Word
02      STRVS   R0, [R13]
        Pull    "R0, PC"

ReadDate
        ADR     R0, SysDateFormat
        B       ReadTimeFormatted
SetDate ROUT
        CMP     R2, #&F8
        BHI     TimeVarTooLong
        Push    "R0, lr"
        LDR     R12, =SysVarWorkSpace
        MOV     R11, #15
        STRB    R11, [R12], #1
        MOV     R10, #0
        STRB    R10, [R12, R2]
        MOV     R10, R2
01      SUBS    R10, R10, #1
        LDRPLB  R11, [R1, R10]
        STRPLB  R11, [R12, R10]
        BPL     %BT01
        ADD     R1, R12, R2
        ADR     R0, SetDateSuffixFormat ; append year to supplied date
        Push    "R12"
        BL      ReadTimeFormattedAtR1
        Pull    "R12"
        SUB     R1, R12, #1
        MOV     R0, #15
        SWI     XOS_Word
        STRVS   R0, [R13]
        Pull    "R0, PC"


; in: R0 = format string
; out: R0 -> time string (0 terminated)
;      R2 = length of string (excluding terminator)
;      R1 corrupt
ReadTimeFormatted ROUT
        Push    "R3,R4,LR"
        LDR     R12, =SysVarWorkSpace
        ADD     R2, R12, #1
01      MOV     R4, R0
        SUB     R13, R13, #8
        MOV     R1, R13
        MOV     R0, #3
        STRB    R0, [R1]
        MOV     R0, #14
        SWI     XOS_Word
        BVS     %FT02
        MOV     R0, #-1
        MOV     R1, R13
        MOV     R3, #?SysVarWorkSpace-1
        SWI     XTerritory_ConvertDateAndTime
02      ADD     R13, R13, #8
        SUBVC   R2, R1, R0
        Pull    "R3,R4,PC"

; in: R0 = format string
;     R1 -> output buffer
; out: R0 -> time string (0 terminated)
;      R1 corrupt
;      R2 = length of string (excluding terminator)
ReadTimeFormattedAtR1
        Push    "R3,R4,LR"
        MOV     R2, R1
        B       %BT01

ReadRC  ROUT
        LDR     R0, =ZeroPage
        LDR     R0, [R0, #ReturnCode]
        B       ReadNumSysVar
SetRC   Push    "lr"
        BL      SetNumSysVar
        LDR     R4, =ZeroPage+ReturnCode
        STR     R2, [R4]
        LDR     R4, =ZeroPage+RCLimit
        LDR     R4, [R4]
        CMP     R2, R4
        BHI     %FT03
        CLRV
        Pull    "PC"
03      ADRGT   R0, ErrorBlock_RCExc
        ADRLT   R0, ErrorBlock_RCNegative
      [ International
        BL      TranslateError
      |
        SETV
      ]

        Pull    "PC"
SetYearPrefixFormat
        =       "%w3,%dy %m3 ", 0
SetDateSuffixFormat
        =       " %ce%yr", 0
        ALIGN

        MakeErrorBlock RCExc
        MakeErrorBlock RCNegative

ReadRCL LDR     R0, =ZeroPage
        LDR     R0, [R0, #RCLimit]
ReadNumSysVar
        Push    "lr"
        LDR     R12, =SysVarWorkSpace
        MOV     R1, R12
        MOV     R2, #256
        SWI     XOS_BinaryToDecimal
        MOV     R0, R1
        Pull    "PC"
SetRCL  Push    "lr"
        BL      SetNumSysVar
        LDR     R4, =ZeroPage+RCLimit
        CMP     R2, #0                  ; can't set -ve RCLimit
        RSBMIS  R2, R2, #0
        MOVMI   R2, #0                  ; BIC of MININT
        STR     R2, [R4]
        Pull    "PC"

        LTORG

SetNumSysVar    ROUT ; R1 ptr to string, R2 string length
        Push    "lr"
        SUBS    R2, R2, #1
        ADDMI   R2, R2, #1              ; give 0 in R2 for bad length.
        Pull    "PC", MI
        LDR     R12, =SysVarWorkSpace
03      LDRB    R10, [R1], #1           ; copy into a buffer so we can terminate it.
        STRB    R10, [R12], #1
        SUBS    R2, R2, #1
        BPL     %BT03
        MOV     R10, #13
        STRB    R10, [R12], #1
        LDR     R1, =SysVarWorkSpace
        LDRB    R10, [R1]
        MOV     R12, #0
        CMP     R10, #"-"
        MOVEQ   R12, #-1
        CMPNE   R10, #"+"
        ADDEQ   R1, R1, #1
        MOV     R0, #0
        SWI     XOS_ReadUnsigned
        CMP     R12, #0
        RSBMI   R2, R2, #0
        Pull    "PC"


;*****************************************************************************
; GSINIT, GSREAD, GSTRANS

; To enable GSTrans nesting to stand a chance of working don't flatten the
; stack every FSINIT. Instead, pick up the stack pointer (any value is OK)
; and wrap at 255. Stack overflow occurs if you increment the pointer to
; where it started for this GSINIT, and stack underflow occurs if you
; decrement the pointer when it is currently equal to stack limit.
; The stack limit is held in the environment value, R2.
; The stack is empty ascending.
        GBLL    GS_BufferNotStack
GS_BufferNotStack SETL {TRUE}

; some semi-arbitrary flags
GS_NoQuoteMess   * 1 :SHL: 31   ; flags passed in from user
GS_NoVBarStuff   * 1 :SHL: 30
GS_Spc_term      * 1 :SHL: 29   ; clear if user requested terminate on space
GS_In_String     * 1 :SHL: 28   ; set if waiting for closing "
GS_ReadingString * 1 :SHL: 27   ; set if reading chars from a string var.
GS_Macroing      * 1 :SHL: 26   ; set if reading chars from a macro
 [ GS_BufferNotStack
        ASSERT  GS_StackPtr_Lim = &80
GS_StackLimitBits * 7
GS_StackLimitPos * 19           ; The bit position of the LSB of the byte
                                ; which holds the stack limit
; bits 0-18 hold the string length for string transfers
 |
; bits 24-25 are unused
; bits 0-23 hold the string length for string transfers
 ]

; After GSINIT, R2 has these flags, and if expanding a count in the low byte

; The flags GS_ReadingString and GS_Macroing returned by GSREAD are used by
; ReadExpression in Arthur3.

GSINIT  ROUT
;  In  : R0 pointer to string to expand
;        R2 has flags :
;          Bit 29 set means space is a terminator
;          Bit 30 set means | characters will not be molested
;          Bit 31 set means don't mess with quotes

;  Out : R0, R2 are values to pass back in to GSREAD
;        R1 is the first non-blank character
;        EQ means char is CR or LF, i.e. string is empty.

        ; Enable interupts as we've no right to have them disabled here
        WritePSRc SVC_mode, R1

 [ GS_BufferNotStack
        AND     R2, R2, #GS_NoQuoteMess :OR: GS_NoVBarStuff :OR: GS_Spc_term
                                        ; get caller's flags
 ]

; If no tokens to expand then don't reset evaluation stack
; This prevents conflict with modules opening messages files at lower levels

        Push    "r0"
10      LDRB    r1, [r0], #1
        CMP     r1, #13
        CMPNE   r1, #10
        CMPNE   r1, #0
        Pull    "r0",EQ
        BEQ     %FT20                   ; Jump if end of string, nothing to expand

        TEQ     r1, #"<"                ; Possibly something to expand?
        BNE     %BT10                   ; No then try next
        Pull    "r0"

; Expansion may be necessary so flatten evaluation stack

 [ GS_BufferNotStack
        GSVarGetWSpace
        LDRB    R1, [R12, #GS_StackPtr]
        AND     R1, R1, #(GS_StackPtr_Lim-1)     ; Ensure we remain in range
        STRB    R1, [R12, #GS_StackPtr]
        ORR     R2, R2, R1, LSL #GS_StackLimitPos
 |
        MOV     R1, #0
        GSVarGetWSpace
        STRB    R1, [R12, #GS_StackPtr] ; no stacked R0s
 ]

20
 [ GS_BufferNotStack
 |
        AND     R2, R2, #GS_NoQuoteMess :OR: GS_NoVBarStuff :OR: GS_Spc_term
                                        ; get caller's flags
 ]
        EOR     R2, R2, #GS_Spc_term    ; and invert for convenience

01      LDRB    R1, [R0], #1
        CMP     R1, #" "
        BEQ     %BT01
        TST     R2, #GS_NoQuoteMess
        CMPEQ   R1, #""""
        SUBNE   R0, R0, #1              ; dec if went too far
        ORREQ   R2, R2, #GS_In_String   ; set flag if in string
        CMP     R1, #13
        CMPNE   R1, #10
        CMPNE   R1, #0
        ORREQ   lr, lr, #Z_bit          ; and move EQ/NE to return pc
        BICNE   lr, lr, #Z_bit
        ExitSWIHandler

        LTORG

; -----------------------------------------------------------------------------


GSREAD  ROUT
;  In  : R0, R2 from last GSREAD/GSINIT
;  Out : R1 character, R0, R2 updated.
;        VS => "Bad String" error
;        CS => string ended (in which case R1 = terminator)

        ; enable interupts as (a) they'll get enabled by a <thing> entry
        ; and (b) GSREAD may take some time
        WritePSRc SVC_mode, R10

        BIC     lr, lr, #C_bit
        MOV     R10, #0
        TST     R2, #GS_ReadingString
        BNE     GSREAD_RStringGetNextByte         ; take byte from stringvar

GSREAD_XPandGetNextByte
        LDRB    R1, [R0], #1
        CMP     R1, #13
        CMPNE   R1, #10
        CMPNE   R1, #0
        BEQ     GSREAD_XPandGotToEnd
        CMP     R1, #" "
        BEQ     GSREAD_XPandGotSpace
        BLT     GSREAD_BadStringError   ; bad string : control code in string
        CMP     R1, #""""
        BEQ     GSREAD_XPandGotQuote
        CMP     R1, #"|"
        TSTEQ   R2, #GS_NoVBarStuff
        BEQ     GSREAD_WorkOutBarChar
        CMP     R1, #"<"
        BNE     GSREAD_ReturnWithChar   ; OS_Exit with valid character

; got to try and get a variable value.
        Push    "R0, R2, lr"
        LDRB    R1, [R0]
        CMP     R1, #">"
        CMPNE   R1, #" "
        BEQ     GSREAD_AngleBraDaftSoIsnt  ; <> and < > are silly.

        ; Copy angle bracketed thing checking for correct termination
        ; OS_SetVarValue requires system variable names to be space or control
        ; terminated, so we shall discard anything which violates that rule
        GSVarGetWSpace
        ADD     R12, R12, #GSNameBuff
        MOV     R11, #0
20      LDRB    R1, [R0], #1
        STRB    R1, [R12], #1
        ADD     R11, R11, #1
        CMP     R1, #">"
        BEQ     %FT25
        CMP     R11, #?GSNameBuff
        CMPNE   R1, #" "
        TSTNE   R1, #&E0                ; i.e. EQ if <32
        BNE     %BT20
        B       GSREAD_AngleBraDaftSoIsnt

25
        ; Check for number first
        MOV     R1, #0
        STRB    R1, [R12, #-1]          ; terminate it
        SUB     R1, R12, R11            ; pointer to name or number
        Push    "R0"
        MOV     R0, #10
        SWI     XOS_ReadUnsigned        ; check for number
        Pull    "R0"
        BVS     GSREAD_AngledThingAintNumber   ; silly - has to be name
        LDRB    R1, [R1]                ; check terminated by the null
        CMP     R1, #0
        BNE     GSREAD_AngledThingAintNumber
        MOV     R1, R2                  ; character value
        ADD     stack, stack, #4        ; discard old R0 value.
        Pull    "R2, lr"
        B       GSREAD_ReturnWithChar   ; exit-R1's the char value.

GSREAD_AngledThingAintNumber
        ; R0, R2, lr on stack
        Push    "R0, R3, R4, R10"       ; corrupted by VarFindIt
        MOV     R3, #0                  ; context ptr
        SUB     R0, R12, R11            ; name ptr
        BL      VarFindIt
        Pull    "R0, R3, R4, R10", EQ   ; not found mate
        BEQ     GSREAD_AngledThingNotThere  ; return null expansion
; well, we've found it - better stack old R0
        Pull    "R0"
        GSVarGetWSpace
 [ GS_BufferNotStack
        LDRB    r1, [r12, #GS_StackPtr]
        LDR     r2, [sp, #4*4]          ; r3,r4,r10,r0,r2,lr on stack, hence r2 retrieved
        MOV     r2, r2, ASL #32-(GS_StackLimitPos+GS_StackLimitBits)
        SUB     r2, r2, #1:SHL:(32-GS_StackLimitBits)
        TEQ     r1, r2, LSR #32-GS_StackLimitBits
        BEQ     GSREAD_CantNestMore
 |
        LDRB    R1, [R12, #GS_StackPtr]
        CMP     R1, #GS_StackPtr_Lim
        BHS     GSREAD_CantNestMore
 ]
        ADD     R12, R12, #GS_Stack
        STR     R0, [R12, R1, LSL #2]
        ADD     R1, R1, #1
 [ GS_BufferNotStack
        AND     R1, R1, #(GS_StackPtr_Lim-1)
 ]
        STRB    R1, [R12, #GS_StackPtr-GS_Stack]
        MOV     R0, R4
        LDRB    R1, [R0], #1            ; type
        CMP     R1, #VarType_Code
        BEQ     GSREAD_CallCodeVar
        CMP     R1, #VarType_Number
        LDRB    R1, [R0], #1

        LDRB    R3, [R0], #1
        ORR     R1, R1, R3, LSL #8
        LDRB    R3, [R0], #1
        ORR     R1, R1, R3, LSL #16

        BLO     GSREAD_GotVarAsString
        BHI     GSREAD_GotMacroVar
        LDRB    R3, [R0], #1
        ORR     R1, R1, R3, LSL #24
        MOV     R0, R1
        ADD     R1, R12, #GSNameBuff-GS_Stack
        MOV     R2, #256
        SWI     XOS_BinaryToDecimal
        MOV     R0, R1
        MOV     R1, R2

; it's a string variable, by now.
GSREAD_GotVarAsString
        Pull    "R3, R4, R10"
        ADD     stack, stack, #4        ; discard that R0
        Pull    "R2, lr"
        CMP     R1, #0
        BEQ     ZeroLengthVar
        ORR     R2, R2, R1              ; old flags+new count
        ORR     R2, R2, #GS_ReadingString
        LDRB    R1, [R0], #1
        B       GSREAD_ReturnWithChar

GSREAD_GotMacroVar
        ; Macro - R0 is now the ptr to the macro value.
        Pull    "R3, R4, R10"
        ADD     stack, stack, #4
        Pull    "R2, lr"
        ORR     R2, R2, #GS_Macroing
        B       GSREAD_XPandGetNextByte ; loop, transforming chars.

GSREAD_CantNestMore
        Pull    "R3, R4, R10"           ; no room to stack pointer, so don't expand
GSREAD_AngledThingNotThere
        ADD     stack, stack, #4        ; skip R0 - return null string
        Pull    "R2, lr"
        B       GSREAD_XPandGetNextByte ; get next char

GSREAD_AngleBraDaftSoIsnt
        Pull    "R0, R2, lr"
        MOV     R1, #"<"
        B       GSREAD_ReturnWithChar   ; failed to get sensible variable

GSREAD_GotToEndCheckInString
        TST     R2, #GS_In_String       ; got CR or LF
        BNE     GSREAD_BadStringError   ; bad string
GSREAD_GotToAnEnd
        ORR     lr, lr, #C_bit          ; got terminator
        ExitSWIHandler

GSREAD_XPandGotToEnd
        TST     R2, #GS_Macroing
        BEQ     GSREAD_GotToEndCheckInString
        ; Nest out by one level
        GSVarGetWSpace
        LDRB    R11, [R12, #GS_StackPtr]
 [ GS_BufferNotStack
        SUB     R11, R11, #1
        AND     R11, R11, #(GS_StackPtr_Lim-1)
        MOV     r2, r2, ROR #GS_StackLimitPos+GS_StackLimitBits
        TEQ     r11, r2, LSR #32-GS_StackLimitBits
        MOV     r2, r2, ROR #32-(GS_StackLimitPos+GS_StackLimitBits)
 |
        SUBS    R11, R11, #1
 ]
        BICEQ   R2, R2, #GS_Macroing
        STRB    R11, [R12, #GS_StackPtr]
        ADD     R12, R12, #GS_Stack
        LDR     R0, [R12, R11, LSL #2]
        B       GSREAD_XPandGetNextByte ; return to prevstring

GSREAD_XPandGotSpace
        TST     R2, #(GS_In_String :OR: GS_Spc_term :OR: GS_Macroing)
                                        ; got space : check termination
        BEQ     GSREAD_GotToAnEnd       ; terminates

GSREAD_ReturnWithChar
        ORR     R1, R1, R10             ; valid character
        ExitSWIHandler

GSREAD_XPandGotQuote
        TST     R2, #GS_In_String
        BEQ     GSREAD_ReturnWithChar   ; if not in string, " is valid.
        LDRB    R1, [R0], #1
        CMP     R1, #""""               ; "" in string?
        BEQ     GSREAD_ReturnWithChar   ; yup


; TMD 25-Sep-89: Fix termination here

10
        CMP     R1, #" "
        LDREQB  R1, [R0], #1
        BEQ     %BT10
        SUB     R0, R0, #1
        ORR     lr, lr, #C_bit          ; got terminator (second ")
        ExitSWIHandler                  ; and out

GSREAD_WorkOutBarChar
        LDRB    R1, [R0], #1            ; got |, do traditional escaping
        CMP     R1, #"|"
        CMPNE   R1, #""""
        CMPNE   R1, #"<"
        BEQ     GSREAD_ReturnWithChar   ; || gives |, |" gives ", |< gives <
        CMP     R1, #"?"
        MOVEQ   R1, #&7F                ; delete
        BEQ     GSREAD_ReturnWithChar   ; valid ch
        CMP     R1, #"!"
        MOVEQ   R10, #&80
        BEQ     GSREAD_XPandGetNextByte ; tbs char
        CMP     R1, #" "
        BLT     GSREAD_BadStringError   ; OS_Control character is naff
        CMP     R1, #&7F                ; CTRL-delete is delete
        EORGT   R1, R1, #&20            ; softkey
        BGE     GSREAD_ReturnWithChar   ; now valid ch
        CMP     R1, #"`"                ; CTRL-` = CTRL-_
        MOVEQ   R1, #"_"
        CMP     R1, #"@"
        ANDGE   R1, R1, #&1F            ; transform if @<=ch<delete
        B       GSREAD_ReturnWithChar

GSREAD_RStringGetNextByte
        SUB     R2, R2, #1              ; we're reading a string
  [ GS_BufferNotStack
        MOVS    R12, R2, ASL #32-GS_StackLimitPos
  |
        ANDS    r12, r2, #&00ffffff
  ]
        LDRNEB  R1, [R0], #1            ; and this is already expanded
        ExitSWIHandler NE               ; so finished
ZeroLengthVar
        GSVarGetWSpace
        LDRB    R0, [R12, #GS_StackPtr] ; pull an R0 from our stack
        SUB     R0, R0, #1
 [ GS_BufferNotStack
        AND     R0, R0, #(GS_StackPtr_Lim-1)
 ]
        STRB    R0, [R12, #GS_StackPtr]
        ADD     R12, R12, #GS_Stack
        LDR     R0, [R12, R0, LSL #2]
        BIC     R2, R2, #GS_ReadingString
        B       GSREAD_XPandGetNextByte

GSREAD_BadStringError
        ADR     R0, BadStrErr
      [ International
        Push    "lr"
        BL      TranslateError
        Pull    "lr"
      ]
        ORR     lr, lr, #V_bit :OR: C_bit
        ExitSWIHandler

BadStrErr
        MakeErrorBlock BadString

GSREAD_CallCodeVar
        ADD     R0, R0, #3 + 4          ; 3 to ALIGN, 4 to get to read entry
        MOV     lr, PC                  ; get link
        BIC     PC, R0, #3              ; call entrypoint to Read Thunk
        MOV     R1, R2
        B       GSREAD_GotVarAsString

; ---------------------------------------------------------------------------


GSTRANS ROUT                    ; enables interrupts
; In   : R0 ptr to input string
       ; R1 ptr to Out buffer
       ; R2 max number of chars, with flags at top.

; Out  : R0 points at terminator
       ; R1 unchanged
       ; R2 Number of chars got,
       ;  C set if too many chars
       ;  V set if bad string.

        BIC     lr, lr, #C_bit
        Push    "R1, R3-R5, lr"
        WritePSRc SVC_mode, R3          ; enable ints.

        MOV     R3, R1
        MOV     R4, R1                  ; two copies of start ptr
        BIC     R5, R2, #&E0000000
        ADD     R5, R5, R1              ; 1st byte we can't write to.
        SWI     XOS_GSInit
01      CMP     R3, R5
        BHS     %FT03                   ; no rheum for byte.
        SWI     XOS_GSRead
        BVS     %FT02                   ; bad string
        STRB    R1, [R3], #1
        BCC     %BT01
04      SUB     R2, R3, R4              ; no chars got
        SUB     R2, R2, #1
        Pull    "R1, R3-R5, lr"
        ExitSWIHandler

02      SUB     R2, R3, R4
        Pull    "R1, R3-R5, lr"
        B       SLVK_SetV               ; bad string: error set by GSRead

03      SUB     R2, R3, R4
        Pull    "R1, R3-R5, lr"
        ORR     lr, lr, #C_bit          ; buffer overflow
        ExitSWIHandler

;****************************************************************************
; Read/Write variables
; Also the binary->decimal SWI.
; All the var SWIs enable interrupts - they all take quite a while.

; First the lookup SWI, ReadVarValue
; In:
;   R0 -> name; maybe wildcarded (* and #)
;   R1 -> buffer
;   R2 = buffer max length
;   R3 = 0 or pointer to name returned from previous ReadVarVal
;   R4 = VarType_Expanded or something else

; Out:
;  Not found:
;   R0 -> VarCantFind error
;   R1 unaltered
;   R2 = 0
;   R3,r4 trashed
;   VSet
;  Found, r2 < 0 and r4 <> VarType_Expanded on entry:
;   R0, R1 unaltered
;   R2 = NOT length of value
;   R3 -> name of variable (0-terminated)
;   R4 = type of result
;  Found, r2 < 0 and r4 = VarType_Expanded on entry:
;   R0, R1 unaltered
;   R2 = -ve
;   R3 -> name of variable (0-terminated)
;   R4 = type of result
;  Found, r2 >= 0 on entry:
;   R0, R1 unaltered
;   R2 no chars got
;   R3 -> name of variable. Can be passed to this SWI to continue enumeration
;      of wildcard.
;   R4 type of result (VarType_String, VarType_Number, VarType_Macro)
;   VSet if buffer overflowed (R0->error block)

 [ Oscli_QuickAliases
;  R0 in = -1 is special case: skip call to VarFindIt (r5,r6,r7 in supply r3,r4,r12)
 ]

ReadVarValue ROUT
        WritePSRc SVC_mode, r11         ; enable interupts (mode remains unchanged)
        Entry   "r0,r1"

        MOV     r11, r4

  [ Oscli_QuickAliases
        CMP     r0, #-1
        BNE     rvv_noqaspecialentry
        MOV     r3,r5
        MOV     r4,r6
        MOV     r12,r7
        B       rvv_qaspecialentry
rvv_noqaspecialentry
  ]

        BL      VarFindIt               ; name=r0,context=r3 -> name found in node=r3,r4=after namein,r12=prev
        BEQ     RVVNotFound

  [ Oscli_QuickAliases
rvv_qaspecialentry
  ]
        ; Regardless of expanded or not - always call the code to get value
        LDRB    lr, [r4], #1
        TEQ     lr, #VarType_Code
        BEQ     ReadVarVal_CallCode

        ; Check whether expanded value wanted and pick up found variable's type
        TEQ     r11, #VarType_Expanded
        MOV     r11, r4
        MOV     r4, lr
        BEQ     ReadVarVal_ExpandedWanted

        ; Unexpanded value wanted....

        ; If number then want 4 bytes, else however many there are in the varval
        TEQ     r4, #VarType_Number
        MOVEQ   r10, #4

ReadVarVal_CopyStringVarToUserBuffer
        ; R1 -> user buffer
        ; R2 = user buffer size
        ; R3 -> name of sysvar found
        ; R4 = sysvar type to return
        ; R10 = length to transfer to user buffer (EQ only)
        ; R11 -> length byte(s) of sysvar (NE only)
        ;     -> bytes string to transfer (EQ only)
        LDRNEB  r10, [r11], #1
        LDRNEB  lr, [r11], #1
        ORRNE   r10, r10, lr, ASL #8
        LDRNEB  lr, [r11], #1
        ORRNE   r10, r10, lr, ASL #16

ReadVarVal_CopyR10BytesToUserBuffer
        ; R1 -> user buffer
        ; R2 = user buffer size
        ; R3 -> name of sysvar found
        ; R4 = type byte to be returned
        ; R10 = bytes to be copied
        ; R11 -> bytes to be copied

        CMP     R10, R2
        BGT     ReadVarVal_BufWillOFlow

VarNoOFlo
        ; Guaranteed the the buffer won't overflow now
        MOV     R2, R10                 ; bytes he's gonna get
; now copy R10 bytes into buffer
02      SUBS    R10, R10, #1
        LDRPLB  R12, [R11, R10]
        STRPLB  R12, [R1, R10]
        BPL     %BT02

ReadVarVal_OKExit
        PullEnv
        ExitSWIHandler

ReadVarVal_BufWillOFlow
        ; Have determined that the buffer will overflow, so generate an error
        ; and shorten down to the buffer's size
        ADR     r0, BufferOFloError
    [ International
        BL      TranslateError
    ]
        STR     r0, [stack, #Proc_LocalStack + 0*4]
        LDR     lr, [stack, #Proc_LocalStack + 2*4]
        ORR     lr, lr, #V_bit     ; set for return
        STR     lr, [stack, #Proc_LocalStack + 2*4]

        ; ensure NOT length returned in r2 when returning with r2<0 on entry
        CMP     r2, #0
        MVNMI   r10, r10
        MOVPL   r10, r2
        B       VarNoOFlo

BufferOFloError
        MakeErrorBlock BuffOverflow

ReadVarVal_CallCode
        Push    "r0-r2"                 ; read sysvar : r4 points after type
        ADD     r11, r4, #3 + 4         ; 3 to align and 4 to get to read entry
        MOV     lr, pc                  ; construct link
        BIC     pc, r11, #3             ; call read code in var
        MOV     r11, r0                 ; ptr to value
        MOV     r10, r2                 ; no of chars.
        Pull    "r0-r2"

        ; error may be returned from reading the var val
        MOVVS   r0, r11
        BVS     ReadVarVal_TestVExit

        MOV     r4, #VarType_String
        B       ReadVarVal_CopyR10BytesToUserBuffer

ReadVarVal_ExpandedWanted
        ; Request for expanded value....

        ; Check for number, string or macro
        CMP     R4, #VarType_Number
        BLT     ReadVarVal_CopyStringVarToUserBuffer
        BEQ     ReadVarVal_FoundNumber

; macro - gstrans it. R1 buffer ptr, r2 max chars, R11+1 ptr to value.
; Macros have a terminator after their value, to allow GSTRANS.

        CMP     r2, #0                  ; if negative, then don't call GSTrans because bits 29..31 have
        MVNMI   r10, r2                 ; return r2 out by this method
        BMI     ReadVarVal_BufWillOFlow ; a special meaning - just branch back to the normal overflow code

        ADD     r0, r11, #3             ; skip length
        SWI     XOS_GSTrans
        BVS     ReadVarVal_TestVExit
        BCC     ReadVarVal_OKExit

        ADR     R0, BufferOFloError
      [ International
        BL      TranslateError
      ]
        B       ReadVarVal_SetVExit


ReadVarVal_FoundNumber
        ; Found a number - extract its value and convert to string
        LDRB    R0, [R11], #1           ; number - convert to string.
        LDRB    R12, [R11], #1
        ORR     R0, R0, R12, LSL #8
        LDRB    R12, [R11], #1
        ORR     R0, R0, R12, LSL #16
        LDRB    R12, [R11]
        ORR     R0, R0, R12, LSL #24

        ; got number in R0, buffptr in R1, max chars in R2
        SWI     XOS_BinaryToDecimal

        MOV     r4, #VarType_String

ReadVarVal_TestVExit
        STRVS   r0, [stack, #Proc_LocalStack + 0*4]
        PullEnv
        B       SLVK_TestV

RVVNotFound
 [ International
        MOV     r4, r0
        ADR     r0, RVVNFError
        BL      TranslateError_UseR4
 |
        ADR     R0, RVVNFError
 ]
        MOV     r2, #0                  ; indicate not found.

ReadVarVal_SetVExit
        STR     r0, [stack, #Proc_LocalStack + 0*4]
        PullEnv
        B       SLVK_SetV               ; general error return

RVVNFError
        MakeErrorBlock VarCantFind


; *****************************************************************************
; SWI OS_SetVarVal : create/update/destroy a variable.

; In:   R0 pointer to name (can be wildcarded for update/delete)
;             ctrl/char or space terminated
;       R1 pointer to value. String values must be CR or LF terminated.
;       R2 negative means destroy the variable. +ve is update/create
;       R3 name pointer or 0
;       R4 type.
;
;  Evaluation of value : this depends on the type.
;  VarType_String   : GSTRANS the given value
;  VarType_Number   : Value is a 4 byte (signed) integer
;  VarType_Macro    : Copy value (may be GSTRANSed on use)
;  VarType_Expanded : the value is a string which should be evaluated as an
;                     expression. Variable is then numeric or string
;  VarType_LiteralString : Copy the given value as a string
;
;  VarType_Code     : R2 is the length of the code to copy in, including
;                     padding to align the code.
;                     Can only delete sysvars if R4 = VarType_Code

; Out:  R3 new name pointer (so can delete all occurrences of f*, etc.
;          slightly more efficiently).
;       R4 type created for expressions
;       V set for :
;          1) bad name  (creation of wildcarded names is banned)
;          2) Bad string from GSTRANS
;          3) Bad macro value (control codes not allowed)
;          4) Bad expression from ReadExpression
;          5) Can't find (for deletion)
;          6) Not enough room to create/update it (system heap full)
;          7) Value too long (variables are limited to 256 bytes in length)
;          8) Bad type (update/create)


 [ DebugSysVars
SysVar_Write0 Entry "r0,r1"
        MOV     r1, r0
10
        LDRB    r0, [r1], #1
        CMP     r0, #" "
        EXIT    LO
        SWI     XOS_WriteC
        B       %BT10

 ]

SetVarValue
        ; enable IRQs
        WritePSRc SVC_mode, r10

        Entry   "r0,r1,r2,r4,r5,r6,r9"

 [ DebugSysVars
        SWI     XOS_WriteS
        =       "SetVarVal ",0
        BL      SysVar_Write0
        SWI     XOS_NewLine
 ]

        MOV     r9, stack
        MOV     r10, r4

        CMP     r2, #0
        BMI     SetVarVal_DeleteIt

        ; Range check type
        CMP     r10, #VarType_Code
        CMPNE   r10, #VarType_LiteralString
        ADRHIL  r0, ErrorBlock_BadVarType
        BHI     SetVarValBadExit_Translate

        ; Always expand a VarType_Expanded:
        TEQ     r10, #VarType_Expanded
        BNE     SetVarVal_AintExpanded

        ; Process VarType_Expanded

        MOV     r0, stack, LSR #20      ; SVC stack base assumed on 1M boundary
        SUB     r0, sp, r0, LSL #20     ; amount of stack left
        CMP     r0, #LongCLISize + 2048 ; insist on 2k left after long buffer
        MOVHS   r2, #LongCLISize        ; ok, got a long buffer
        MOVLO   r2, #256                ; stack full-ish, use a 256 buffer and hope it's big enough
        SUB     stack, stack, r2

        MOV     r0, r1                  ; ptr to expression
        MOV     r1, stack
        SWI     XOS_EvaluateExpression
        BVS     SetVarVal_TestVExit
        TEQ     r1, #0   ; integer?
        MOVNE   r10, #VarType_LiteralString
        MOVEQ   r10, #VarType_Number
        STREQ   r2, [stack]
        MOVEQ   r2, #4
        STR     r10, [r9, #3*4]         ; r4 out
        MOV     r1, stack
        LDR     r0, [r9, #0*4]

SetVarVal_AintExpanded

        ; Setting a variable
        BL      VarFindIt
        BNE     SetVarVal_NodeAlreadyExists

        ; Node missing....

        ; Check variable name has no wildcards
        SUB     r4, r0, #1
05
        LDRB    lr, [r4, #1]!
        CMP     lr, #"#"
        CMPNE   lr, #"*"
        CMPNE   lr, #" "
        BHI     %BT05
        CMP     lr, #"#"
        CMPNE   lr, #"*"
        CMPNE   r4, r0
        ADREQL  r0, ErrorBlock_BadVarNam
        BEQ     SetVarValBadExit_Translate     ; error no. 1)

        ; R12 index of 1st entry in QuickIndex >= the entry we're interested in
        MOV     r3, #0                  ; To indicate absence of current
        B       SetVarVal_CreateNode

SetVarVal_NodeAlreadyExists
        MOV     r0, r3                  ; If already there use that's name in case supplied name wildcarded
        LDRB    lr, [r4]
        TEQ     lr, #VarType_Code
        BNE     SetVarVal_CreateNode
        TEQ     r10, #VarType_Code
        BEQ     SetVarVal_CreateNode

        ; Assign non code value to code node
        CMP     r10, #VarType_Number
        BHI     SetVarVal_AssignToCodeDoIt

        BLO     SetVarVal_AssignStringToCode

        SUB     stack, stack, #256      ; buffer
        MOV     r2, #256

        ; Assign a number to the code variable
        LDRB    r0, [r1], #1
        LDRB    lr, [r1], #1
        ORR     r0, r0, lr, LSL #8
        LDRB    lr, [r1], #1
        ORR     r0, r0, lr, LSL #16
        LDRB    lr, [r1], #1
        ORR     r0, r0, lr, LSL #24
        MOV     r1, stack
        SWI     XOS_BinaryToDecimal

        B       SetVarVal_AssignToCodeDoIt

SetVarVal_AssignStringToCode

        MOV     r0, stack, LSR #20      ; SVC stack base assumed on 1M boundary
        SUB     r0, sp, r0, LSL #20     ; amount of stack left
        CMP     r0, #LongCLISize + 2048 ; insist on 2k left after long buffer
        MOVHS   r2, #LongCLISize        ; ok, got a long buffer
        MOVLO   r2, #256                ; stack full-ish, use a 256 buffer and hope it's big enough
        SUB     stack, stack, r2

        ; Expand string to stack frame then do it
        MOV     r0, r1
        MOV     r1, stack
        SWI     XOS_GSTrans
        BVS     SetVarVal_TestVExit
        ADRCSL  r0, ErrorBlock_VarTooLong
        BCS     SetVarValBadExit_Translate

SetVarVal_AssignToCodeDoIt

        ADDS    r4, r4, #3 + 1          ; skip type, add 3 for ALIGN , clear V
        MOV     lr, PC
        BIC     PC, R4, #3              ; complete align and call

        B       SetVarVal_TestVExit


SetVarVal_CreateNode
        ; Create a node
        ;
        ; r0 -> name (already confirmed non-wildcarded)
        ; r1 -> value
        ; r2 = length (where appropriate)
        ; r3 = this or 0
        ; r10 = type
        ; r12 = insertion point

        MOV     r5, r1
        MOV     r6, r3

        ; first work out the length of those things we can work the length of

        ; Header and name...
        MOV     r3, #0                  ;accumulator for length of things we know
        MOV     r1, r0
10
        LDRB    lr, [r1], #1
        ADD     r3, r3, #1
        CMP     lr, #" "
        BHI     %BT10

;r3 is now name length +1 for terminator
        ADD     r3, r3, #1              ;add in 1 for the type byte

        ; Deal with number and string type
        CMP     r10, #VarType_Number
        ADDLO   r3, r3, #64             ; only an initial guess for the string type
        ADDEQ   r3, r3, #4
        MOVEQ   r2, #4
        BLS     SetVarVal_GotInitialLength

        CMP     r10, #VarType_Code
        ADDEQ   r3, r3, #3              ; ALIGN
        BICEQ   r3, r3, #3
        ADDEQ   r3, r3, r2              ; code
        BEQ     SetVarVal_GotInitialLength

        TEQ     r10, #VarType_LiteralString
        BEQ     %FT20

        ; Macro - strlen and check the value is vaguely OK
        MOV     r2, r5
15
        LDRB    lr, [r2], #1
        CMP     lr, #" "
        BHS     %BT15
        TEQ     lr, #0                  ; must terminate with NUL, CR or LF
        TEQNE   lr, #10
        TEQNE   lr, #13
        ADRNE   r0, ErrorBlock_BadMacVal
        BNE     SetVarValBadExit_Translate
        SUB     r2, r2, r5
20
        ADD     r3, r3, r2
        ADD     r3, r3, #3              ; for the length bytes

SetVarVal_GotInitialLength
        ; r0 -> node's name
        ; r2 = value length (Number, Macro and Code)
        ; r3 = node length needed (maybe initial guess for Strings)
        ; r5 -> value (r1 in)
        ; r6 -> name of node to be replaced (0 if no node being replaced)
        ; r10 = value's type (String, Number, Macro or Code)
        ; r12 -> insertion point

        Push    "r0-r2"
  [ SysVars_StickyNodes
        ADD     r3,r3,#SysVars_StickyNode_UnitSize-1
        BIC     r3,r3,#SysVars_StickyNode_UnitSize-1  ;so we don't fight sticky routines over sizes
        BL      SysVars_ClaimVNode
  |
        BL      ClaimSysHeapNode
  ]
        Pull    "r0-r2",VS
        BVS     SetVarVal_VarNoRoom

        ; Got a heap block - fill it in

        ; Copy name

        MOV     r4, r2
        LDR     r0,[sp]
25
        LDRB    lr, [r0], #1
        CMP     lr, #" "
        MOVLS   lr, #0
        STRB    lr, [r4], #1
        BHI     %BT25

        LDR     r1,[sp,#8]
        ADD     sp,sp,#12               ; balances push r0-r2 above - value length (entry r2) now in r1

        ; Variable's type
        TEQ     r10, #VarType_LiteralString
        MOVEQ   lr, #VarType_String
        MOVNE   lr, r10
        STRB    lr, [r4], #1

        TEQ     r10, #VarType_String
        BEQ     SetVarVal_FillInString

        TEQ     r10, #VarType_Code
        ADDEQ   r4, r4, #3
        BICEQ   r4, r4, #3
        Push    "r4",EQ ; Remember start of code block for code variables
        TEQNE   r10, #VarType_Number
        BEQ     SetVarVal_CopyR1BytesToR4

        ; For macro type fill in a length
        TEQ     r10, #VarType_Macro
        SUBEQ   r1, r1, #1              ; ghastly fudge to avoid display of terminator
        STRB    r1, [r4], #1
        MOV     r1, r1, ROR #8
        STRB    r1, [r4], #1
        MOV     r1, r1, ROR #8
        STRB    r1, [r4], #1
        MOV     r1, r1, ROR #16
        ADDEQ   r1, r1, #1              ; undo ghastly fudge

        B       %FT35
30
        LDRB    lr, [r5], #1
        STRB    lr, [r4], #1
35
SetVarVal_CopyR1BytesToR4
        SUBS    r1, r1, #1
        BHS     %BT30

        TEQ     r10, #VarType_Code
        BNE     SetVarVal_NewNodeReady

        Pull    "r1" ; Grab pointer to start of code block
        Push    "r0,r2"
        MOV     r0,#1
        MOV     r2,r4
        SWI     XOS_SynchroniseCodeAreas
        Pull    "r0,r2"
        B       SetVarVal_NewNodeReady

SetVarVal_FillInString
        ; Here's the real smart bit of code

        ; The idea is this:
        ; Instead of GSTransing, we GSInit and GSRead ourselves. When the
        ; block gets full expand it and carry on. At the end the block is shrunk to fit.

        ADD     r4, r4, #3              ; for the length bytes
        MOV     r11, r4                 ; preserve location of string start for when we've done
        MOV     r0, r5                  ; r1 in
        MOV     r5, r2
        MOV     r2, #0
        SWI     XOS_GSInit
        BVS     SetVarVal_DisasterExpandingString
        B       %FT45

40
        SWI     XOS_GSRead
        BVS     SetVarVal_DisasterExpandingBadString
        BCS     SetVarVal_StringFinishedExpanding
        STRB    r1, [r4], #1
        CMP     r4, r3
        BLO     %BT40

        ; Run out of room in this block - stretch it
        Push    "r0-r2"
        MOV     r0, #HeapReason_ExtendBlock
        MOV     r2, r5
        MOV     r3, #64                 ;should be a multiple of StickyNode_UnitSize if SysVars_StickyNodes TRUE
  [ SysVars_StickyNodes
        BL      SysVars_ExpandOrShrinkVNode
  |
        BL      DoSysHeapOpWithExtension
  ]
        STRVS   r0, [sp]
        SUBVC   lr, r2, r5
        ADDVC   r4, r4, lr
        ADDVC   r11, r11, lr
        MOVVC   r5, r2
        Pull    "r0-r2"
        BVS     SetVarVal_DisasterExpandingString

45
        LDR     r3, [r5, #-4]           ; The heap block's size
  [ SysVars_StickyNodes
        SUB     r3, r3, #8              ; the amount we're allowed to use
  |
        SUB     r3, r3, #4              ; the amount we're allowed to use
  ]
        ADD     r3, r3, r5              ; the block's end
        B       %BT40

SetVarVal_StringFinishedExpanding

        ; Shorten block to required size
        MOV     r0, #HeapReason_ExtendBlock
  [ SysVars_StickyNodes
        Push    "r4"
        ADD     r4, r4, #SysVars_StickyNode_UnitSize-1
        BIC     r4, r4, #SysVars_StickyNode_UnitSize-1  ;so we don't fight over sticky sizes
        SUB     r3, r4, r3
        Pull    "r4"
        MOV     r2, r5
        BL      SysVars_ExpandOrShrinkVNode
  |
        SUB     r3, r4, r3
        MOV     r2, r5
        BL      DoSysHeapOpWithExtension
  ]
        BVS     SetVarVal_DisasterExpandingString

        ; Relocate pointers
        SUB     lr, r2, r5
        ADD     r4, r4, lr
        ADD     r11, r11, lr

        ; Work out ultimate size and store it
        SUB     lr, r4, r11
        STRB    lr, [r11, #-3]
        MOV     lr, lr, LSR #8
        STRB    lr, [r11, #-2]
        MOV     lr, lr, LSR #8
        STRB    lr, [r11, #-1]

SetVarVal_NewNodeReady
        ; r2 -> new node
        ; r6 -> old node's name (or is 0 if no old node)
        ; r12 = insertion point

 [ DebugSysVars
        Push    "r0,r1,r2"
        SUB     sp, sp, #12
        MOV     r0, r2
        MOV     r1, sp
        MOV     r2, #12
        SWI     XOS_ConvertHex8
        SWI     XOS_Write0
        SWI     XOS_WriteI+" "
        MOV     r0, r6
        MOV     r1, sp
        MOV     r2, #12
        SWI     XOS_ConvertHex8
        SWI     XOS_Write0
        SWI     XOS_WriteI+" "
        MOV     r0, r12
        MOV     r1, sp
        MOV     r2, #12
        SWI     XOS_ConvertHex8
        SWI     XOS_Write0
        SWI     XOS_WriteI+" "
        ADD     sp, sp, #12
        Pull    "r0,r1,r2"
 ]
        LDR     r11, =ZeroPage+VariableList
        LDR     r10, [r11]
  [ SysVars_QuickContext
        TEQ     r10,#0
        ADDNE   r10,r10,#SysVars_VTableOffset
  ]
        MOV     r5, r2
        TEQ     r6, #0
        BEQ     SetVarVal_Insertion

 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-straight replace-",0
 ]

        MOV     r2, r6
  [ SysVars_StickyNodes
        BL      SysVars_FreeVNode
  |
        BL      FreeSysHeapNode
  ]
        B       SetVarVal_Replace

SetVarVal_Insertion
 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-insert-",0
 ]
        TEQ     r10, #0
        BNE     SetVarVal_PossibleExtend

 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-create index-",0
 ]

  [ SysVars_QuickContext
        ; SysVars_Vindex_NStart nodes, 1 word for the count, plus data before table
        MOV     r3, #SysVars_Vindex_NStart*4
        ADD     r3, r3, #4+SysVars_VTableOffset
  |
        MOV     r3, #(10*4)+4           ; 10 nodes and 1 word for the count
  ]
        BL      ClaimSysHeapNode        ; this is not a variable node (its the index)
        BVS     SetVarVal_NoRoomForIndex
  [ SysVars_QuickContext
        MOV     r10,#-1
        STR     r10, [r2, #SysVars_LastContext]    ; initialise last context as invalid
  ]
        MOV     r10, r2
        MOV     r4, #0
        B       SetVarVal_DoInsertNewBlock

SetVarVal_PossibleExtend
 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-extend index-",0
 ]
        LDR     r4, [r10]
  [ SysVars_QuickContext
        LDR     lr, [r10, #-(4+SysVars_VTableOffset)] ; Block length, from heap block
        SUB     lr, lr, #4+4+SysVars_VTableOffset     ; 4 for heap adjustment, 4 for entry count word, plus name buffer
  |
        LDR     lr, [r10, #-4]          ; Block length, from heap block
        SUB     lr, lr, #4+4            ; 4 for heap adjustment and 4 for entry count word
  ]
        CMP     lr, r4, ASL #2
        BHI     SetVarVal_DoInsert      ; we've got room with this block

 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-do extend-",0
 ]

        MOV     r0, #HeapReason_ExtendBlock
  [ SysVars_QuickContext
        SUB     r2, r10, #SysVars_VTableOffset
        MOV     r3, #SysVars_Vindex_NBump*4     ; room for SysVars_Vindex_NBump more nodes
  |
        MOV     r2, r10
        MOV     r3, #40                 ; room for 10 more nodes
  ]
        BL      DoSysHeapOpWithExtension        ;not a variable node (expanding index)
        BVS     SetVarVal_NoRoomForIndex

        MOV     r10, r2

SetVarVal_DoInsertNewBlock
        STR     r10, [r11]
  [ SysVars_QuickContext
        ADD     r10,r10,#SysVars_VTableOffset
  ]
SetVarVal_DoInsert
 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-doinsert-",0
 ]
        ADD     r0, r10, r12, ASL #2    ; insertion point
        ADD     r1, r10, r4, ASL #2     ; rover
        B       SetVarVal_DoInsertEnd

SetVarVal_DoInsertStart
        LDR     lr, [r1], #-4
        STR     lr, [r1, #8]

SetVarVal_DoInsertEnd
        CMP     r1, r0
        BHS     SetVarVal_DoInsertStart

        ADD     r4, r4, #1
        STR     r4, [r10]

SetVarVal_Replace
 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-doreplace-",0
 ]
        STR     r5, [r10, r12, ASL #2]
 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-done-",0
 ]

        ; All done
        B       SetVarVal_TestVExit

SetVarVal_DeleteIt
        BL      VarFindIt

        ; Error if not found
        BEQ     SVVNotFound
        ; Check if found vartype code that the supplied vartype was code too
        LDRB    lr, [r4]
        TEQ     lr, #VarType_Code
        BNE     %FT80

        TEQ     r10, #VarType_Code
        BNE     SetVarVal_TestVExit
80
        LDR     r11, =ZeroPage+VariableList
        LDR     r10, [r11]
  [ SysVars_QuickContext
        ADD     r10,r10,#SysVars_VTableOffset
  ]
        LDR     r4, [r10]
        ADD     r0, r10, r12, ASL #2    ; rover
        ADD     r1, r10, r4, ASL #2     ; end
        B       SetVarVal_DoRemoveEnd
SetVarVal_DoRemoveStart
        LDR     lr, [r0, #4]!
        STR     lr, [r0, #-4]
SetVarVal_DoRemoveEnd
        CMP     r0, r1
        BLO     SetVarVal_DoRemoveStart
        MOV     r2, r3
  [ SysVars_StickyNodes
        BL      SysVars_FreeVNode
  |
        BL      FreeSysHeapNode
  ]

        ; Reduce number of nodes
        SUB     r4, r4, #1
        STR     r4, [r10]

        ; Construct best guess context ptr to be prev node (if present)
        TEQ     r12, #1
        SUBHI   r12, r12, #1
        LDRHI   r3, [r10, r12, ASL #2]
        MOVLS   r3, #0


SetVarVal_TestVExit
        MOV     stack, r9
        STRVS   r0, [stack]
        PullEnv
        B       SLVK_TestV

SVVNotFound
 [ International
        MOV     r4, r0
        ADRL    r0, ErrorBlock_VarCantFind
        BL      TranslateError_UseR4
 |
        ADRL    r0, ErrorBlock_VarCantFind
        SETV
 ]
        B       SetVarVal_TestVExit

SetVarValBadExit_Translate
 [ International
        BL      TranslateError
 ]
SetVarValBadExit_NoTranslate
        SETV
        B       SetVarVal_TestVExit

SetVarVal_DisasterExpandingString
SetVarVal_NoRoomForIndex
        MOV     r2, r5
        BL      FreeSysHeapNode         ;forget stickiness (return node to heap is best here)
SetVarVal_VarNoRoom
        ADR     r0, ErrorBlock_VarNoRoom
        B       SetVarValBadExit_Translate

SetVarVal_DisasterExpandingBadString
        Push    "r0"                    ; Save bad string error
        MOV     r2, r5
        BL      FreeSysHeapNode         ;forget stickiness (return node to heap is best here)
        Pull    "r0"
        SETV
        B       SetVarVal_TestVExit

        MakeErrorBlock BadVarType
        MakeErrorBlock BadVarNam
        MakeErrorBlock VarTooLong
        MakeErrorBlock BadMacVal
        MakeErrorBlock VarNoRoom


; *****************************************************************************
; Utility routines.

; -----------------------------------------------------------------------------
;
; VarFindIt
;
; In
;    r0 -> (wildcard) name of variable to find
;    r3 = context pointer
;
; Out
;    r3 = name pointer
;    r4 = pointer after name terminator
;    r12 = insertion point (1st node >= this node)
;    NE if found, EQ if not found
;
VarFindIt Entry "r0,r1,r2,r5,r6,r7,r8,r9,r10,r11"

; validate R3 by looking down the list to see if we find it.
; Crude, but effective!

 [ DebugSysVars
        SWI     XOS_WriteS
        =       "VarFindIt(",0
        BL      SysVar_Write0
 ]

        LDR     r9, =ZeroPage+VariableList
        LDR     r9, [r9]
        TEQ     r9, #0
  [ SysVars_QuickContext
        LDRNE   r12,[r9,#SysVars_LastContext]
        MOVEQ   r12,#-1                           ;r12 = var table index for last context, or -1 if notvalid/notthere
        ADDNE   r9,r9,#SysVars_VTableOffset
  ]
        LDRNE   r8, [r9]
        MOVEQ   r8, #0
        TEQ     r3, #0
        BEQ     %FT20

 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-scan-",0
 ]
        ; r3 non-zero - scan list for entry

  [ SysVars_QuickContext
        ;massive short cut - see if context is the last context we returned
        CMP     r12, r8                 ;if not valid, or higher than current number of vars, forget it
        BHI     %FT04
        LDR     lr, [r9, r12, ASL #2]
        CMP     lr, r3
        BEQ     %FT70
04
        ;no such luck - scan list anyway
  ]

        ADD     r12, r8, #1
        B       %FT10
05
        LDR     lr, [r9, r12, ASL #2]
        CMP     lr, r3
        BEQ     %FT70                   ; continue scan down list
10
        SUBS    r12, r12, #1
        BHI     %BT05

20
 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-wildcheck-",0
 ]
        ; not found in scan - check for name being wildcarded

        MOV     r10, r0
25
        LDRB    lr, [r10], #1
        TEQ     lr, #"*"
        TEQNE   lr, #"#"
        BEQ     %FT65
        CMP     lr, #" "
        BHI     %BT25

 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-bchop-",0
 ]

        ; Name not wildcarded - do binary chop search
        ORRS    r7, r8, r8, LSR #1
        ORR     r7, r7, r7, LSR #2
        ORR     r7, r7, r7, LSR #4
        ORR     r7, r7, r7, LSR #8
        ORR     r7, r7, r7, LSR #16
        BICS    r7, r7, r7, LSR #1      ; least 2^n <= number of entries
        MOV     r6, #0

        B       %FT60
40
        ADD     r5, r6, r7
        CMP     r5, r8
        BHI     %FT55

        MOV     r1, r0
        LDR     r4, [r9, r5, ASL #2]

45
        LDRB    r2, [r1], #1
        CMP     r2, #" "
        MOVLS   r2, #0
        LDRB    r3, [r4], #1
        CMP     r3, #" "
        MOVLS   r3, #0
        UpperCase R2,LR
        UpperCase R3,LR
        CMP     r3, r2
        BNE     %FT50
        CMP     r3, #0
        BNE     %BT45

50
        MRSHS   r10, CPSR               ; preserve last HS result we got
        MOVHS   r11, r4
        MOVLO   r6, r5
55
        MOVS    r7, r7, LSR #1
60
        BNE     %BT40

        ; We always want the element above.
        ; If r6<r8 then we want the preserved result
        ; else we want the result HI
        ADD     r6, r6, #1
        CMP     r6, r8
        LDRLS   r3, [r9, r6, ASL #2]
  [ SysVars_QuickContext
        ASSERT  SysVars_LastContext = SysVars_VTableOffset - 4
        STRLS   r6, [r9, #-4]           ;save var table index for context we're returning, in LastContext
  ]
        MOVLS   r4, r11
        MOVHI   r3, #0
        MSRLS   CPSR_f, r10

 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-complete-",0
        SWI     XOS_NewLine
 ]
        MOV     r12, r6
        TOGPSR  Z_bit, lr
        EXIT

65
 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-listscan-",0
        SWI     XOS_NewLine
 ]
        ; Scan down list looking for wildmatch
        MOV     r12, #0
70
        ADD     r12, r12, #1
        CMP     r12, r8
        BHI     %FT90                   ; end of list reached
        LDR     r4, [r9, r12, ASL #2]
        BL      WildMatch               ; trashes r10,r11
        BNE     %BT70

80
 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-complete-",0
        SWI     XOS_NewLine
 ]
        ; Found
        ; r4->name end
        ; r12 = entry number
        LDR     r3, [r9, r12, ASL #2]
  [ SysVars_QuickContext
        ASSERT  SysVars_LastContext = SysVars_VTableOffset - 4
        STR     r12, [r9, #-4]          ;save var table index for context we're returning, in LastContext
  ]
        MOVS    r12, r12                ; set NE
        EXIT

90
        ; Not found
 [ DebugSysVars
        SWI     XOS_WriteS
        =       "-not found-",0
        SWI     XOS_NewLine
 ]
        MOV     r12, #1
        MOVS    r3, #0
        EXIT

WildMatch ROUT
; In  : R0 is wildcard spec ptr, R4 is name ptr.
;       Wild Terminators are any ch <=" ", name terminator 0
;       Wildcards are *, #
; Out : EQ/NE for match (EQ if matches)
;       R4 points after name terminator for found
;       R0 preserved, R10, 11 corrupted

        Push    "R0-R3"
        MOV     R11, #0                 ; this is the wild backtrack pointer
        MOV     R3, #0                  ; and this is the name backtrack ptr.
01      LDRB    R1, [R0], #1            ; nextwild
        CMP     R1, #"*"
        BEQ     %FT02                   ; IF nextwild = "*"
        LDRB    R2, [R4], #1            ; nextname
        CMP     R2, #0
        BEQ     %FT03
        UpperCase R1, R10
        UpperCase R2, R10
        CMP     R1, R2                  ; IF nextwild=nextname
        CMPNE   R1, #"#"                ;   OR nextwild = #  (terminator checked already)
        BEQ     %BT01                   ; THEN LOOP (stepped already)
        MOV     R0, R11                 ; try backtrack
        MOVS    R4, R3                  ; if * had at all
        BNE     %FT02
        CMP     PC, #0                  ; set NE
04      Pull    "R0-R3"                 ; return NE (failed)
        MOV     PC, lr

03      CMP     R1, #" "                ; name terminated : has wildcard?
        BHI     %BA04                   ; note HI has NE set.
        CMP     R1, R1                  ; set EQ
        Pull    "R0-R3"
        MOV     PC, lr

02      MOV     R11, R0                 ; wild backtrack ptr is char after *
        LDRB    R1, [R0], #1            ; step wild
        CMP     R1, #"*"
        BEQ     %BT02                   ; fujj **
        UpperCase R1, R10
05      LDRB    R2, [R4], #1            ; step name
        CMP     R2, #0                  ; terminator?
        BEQ     %BT03
        UpperCase R2, R10
        CMP     R1, R2
        CMPNE   R1, #"#"                ; match if #
        BNE     %BT05
        MOV     R3, R4                  ; name backtrack ptr is char after match
        B       %BT01                   ; LOOP


  [ Oscli_QuickAliases

;routines to speed up alias checking for OS_CLI

;VarFindIt_QA - similar to VarFindIt
;
; In
;    r3 -> non-wildcarded, already upper-cased name of var to find
;          will be of form ALIAS$<whatever>
;
; Out
;    r5 = name pointer (equivalent to r3 for VarFindIt
;    r6 = pointer after name terminator (equivalent to r4 for VarFindIt)
;    r7 = insertion point (equivalent to r12 for VarFindIt)
;    NE if found, EQ if not found
;
VarFindIt_QA ROUT
        Push    "r0,r1,r2,r3,r4,r8,r9,r10,r11,LR"
        MOV     r0, r3
        LDR     r9, =ZeroPage+VariableList
        LDR     r9, [r9]
        TEQ     r9,#0
        BEQ     %FT99                   ;exit with EQ (not found)
  [ SysVars_QuickContext
        ADD     r9,r9,#SysVars_VTableOffset
  ]
        LDR     r8, [r9]

        ; do binary chop search
        ORRS    r7, r8, r8, LSR #1
        ORR     r7, r7, r7, LSR #2
        ORR     r7, r7, r7, LSR #4
        ORR     r7, r7, r7, LSR #8
        ORR     r7, r7, r7, LSR #16
        BICS    r7, r7, r7, LSR #1      ; least 2^n <= number of entries
        MOV     r6, #0

        B       %FT60
40
        ADD     r5, r6, r7
        CMP     r5, r8
        BHI     %FT55

        MOV     r1, r0
        LDR     r4, [r9, r5, ASL #2]

45
        LDRB    r2, [r1], #1
        CMP     r2, #" "
        MOVLS   r2, #0
        LDRB    r3, [r4], #1
        CMP     r3, #" "
        MOVLS   r3, #0
        UpperCase R3,LR
        CMP     r3, r2
        BNE     %FT50
        CMP     r3, #0
        BNE     %BT45

50
        MRSHS   r10, CPSR               ; preserve last HS result we got
        MOVHS   r11, r4
        MOVLO   r6, r5
55
        MOVS    r7, r7, LSR #1
60
        BNE     %BT40

        ; We always want the element above.
        ; If r6<r8 then we want the preserved result
        ; else we want the result HI
        ADD     r6, r6, #1
        CMP     r6, r8
        LDRLS   r5, [r9, r6, ASL #2]

        ; don't want to save context in this version of routine

        MOV     r7, r6
        MOVLS   r6, r11
        MOVHI   r5, #0
        MSRLS   CPSR_f, r10

        TOGPSR  Z_bit, lr
99
        Pull    "r0,r1,r2,r3,r4,r8,r9,r10,r11,PC"


  ] ;Oscli_QuickAliases

  [ SysVars_StickyNodes
;
; SysVars_ClaimVNode
;
; entry: R3 = size required
; exit:  R2 = address of allocated node, or V set for error
;
; if R3  > max sticky size, just delegates to ClaimSysHeapNode
; if R3 <= max sticky size, rounds up to next unit size, and attempts to pick
;    up sticky node of that size - if not found, gets one from heap (now of size that can
;    stick on free)
;
SysVars_ClaimVNode ROUT
        Push    "r0,r1,r3,LR"
        CMP     r3,#SysVars_StickyNode_MaxSize
        BHI     %FT80                                         ;too big for sticky node
        ADD     r3,r3,#SysVars_StickyNode_UnitSize-1
        BIC     r3,r3,#SysVars_StickyNode_UnitSize-1          ;round up to unit size
        LDR     r1,=ZeroPage+SysVars_StickyPointers
        LDR     r2,[r1,r3,LSR #(SysVars_StickyNode_Log2US-2)] ;sticky pointer for this size
        CMP     r2,#0                                         ;also clears V
        BEQ     %FT80
        MOV     LR,#0
        STR     LR,[r1,r3,LSR #(SysVars_StickyNode_Log2US-2)] ;used it
  [ mjsSysHeapNodesTrace
        Push    "r0-r2"
        LDR     r0,=ZeroPage
        LDR     r1,[r0,#mjsSHNT_vcs_total]
        ADD     r1,r1,#1
        STR     r1,[r0,#mjsSHNT_vcs_total]
        Pull    "r0-r2"
  ]
        Pull    "r0,r1,r3,PC"
80      BL      ClaimSysHeapNode
        STRVS   r0,[SP]
  [ mjsSysHeapNodesTrace
        Push    "r0-r2"
        LDR     r0,=ZeroPage
        LDR     r1,[r0,#mjsSHNT_vch_total]
        ADD     r1,r1,#1
        STR     r1,[r0,#mjsSHNT_vch_total]
        Pull    "r0-r2"
  ]
        Pull    "r0,r1,r3,PC"

;
; SysVars_FreeVNode
;
; entry: R2 = address of node to free (must be valid)
; exit:  -
;        OR V set, error
;
; - checks size of node (uses internal knowledge of Heap blocks - naughty!)
; - if size is a sticky size, and the corresponding sticky pointer is 0, retains it,
;   else delegates to FreeSysHeapNode
;
SysVars_FreeVNode
        Push    "r0,r1,r3,LR"
        LDR     r1,[r2,#-4]                                   ;pick up OS_Heap's size word
        SUB     r1,r1,#8                                      ;sticky sizes will be 8 less than heap sizes
        CMP     r1,#SysVars_StickyNode_MaxSize                ;is it too big?
        BHI     %FT80
        TST     r1,#SysVars_StickyNode_UnitSize-1             ;is it a multiple of unit size
        BNE     %FT80
        LDR     r3,=ZeroPage+SysVars_StickyPointers
        LDR     LR,[r3,r1,LSR #(SysVars_StickyNode_Log2US-2)] ;sticky pointer for this size
        CMP     LR,#0
        STREQ   r2,[r3,r1,LSR #(SysVars_StickyNode_Log2US-2)] ;stick!
80
  [ mjsSysHeapNodesTrace
        Push    "r0-r2"
        LDR     r0,=ZeroPage
        LDREQ   r1,[r0,#mjsSHNT_vfs_total]
        LDRNE   r1,[r0,#mjsSHNT_vfh_total]
        ADD     r1,r1,#1
        STREQ   r1,[r0,#mjsSHNT_vfs_total]
        STRNE   r1,[r0,#mjsSHNT_vfh_total]
        Pull    "r0-r2"
  ]
        BLNE    FreeSysHeapNode
        STRVS   r0,[SP]
        Pull    "r0,r1,r3,PC"

;
; SysVars_ExpandOrShrinkVNode
;
; entry: R2 = address of block
;        R3 = change of size required in bytes (signed integer)
; exit:  R2 = address of block, which may have changed (block moved/copied)
;        OR V set, error returned
;
; - checks size of node (uses internal knowledge of Heap blocks - naughty!)
; - assumes all VNodes currently less than MaxSize and of sticky size *must* be stickily
;   allocated nodes (so that maximum current size that could be presumed by client is heap
;   size minus 8, rather than minus 4)
; - if new size is small enough to be a sticky node, attempts to return a sticky node,
;   without doing an OS_Heap grow or shrink, else delegates to DoSysHeapOpWithExtension
;
SysVars_ExpandOrShrinkVNode
        Push    "r0,r1,r3-r6,LR"
        LDR     r5,[r2,#-4]                                   ;pick up OS_Heap's size word
        SUB     r5,r5,#4                                      ;usable sizes are 4 less than heap sizes
        ADD     r4,r5,r3                                      ;putative new size
        CMP     r4,#SysVars_StickyNode_MaxSize                ;is it too big?
        BHI     %FT90
        SUB     r6,r5,#4                                      ;sticky sizes will be 8 less than heap sizes
        SUB     r4,r4,#4
        ADD     r4,r4,#SysVars_StickyNode_UnitSize-1
        BIC     r4,r4,#SysVars_StickyNode_UnitSize-1          ;round up to unit size
        CMP     r4,r6                                         ;same as current size?
        BEQ     %FT55
        LDR     r1,=ZeroPage+SysVars_StickyPointers
        LDR     LR,[r1,r4,LSR #(SysVars_StickyNode_Log2US-2)] ;sticky pointer for this size
        CMP     LR,#0
        BEQ     %FT40
        MOV     r3,#0
        STR     r3,[r1,r4,LSR #(SysVars_StickyNode_Log2US-2)] ;used it
        MOV     r5,r2
        MOV     r2,LR
        B       %FT50
40
        MOV     r5,r2
        MOV     r3,r4
        BL      SysVars_ClaimVNode
        BVS     %FT95
50      ;copy min(r6,r4) bytes (multiple of 8) from old node at r5 to new node at r2
        CMP     r4,r6
        MOVLO   r6,r4
        MOV     r3,r2
        MOV     LR,r5
52
        LDMIA   LR!,{r0,r1}
        STMIA   r3!,{r0,r1}
        SUBS    r6,r6,#8
        BGT     %BT52
        MOV     r6,r2
        MOV     r2,r5
        BL      SysVars_FreeVNode
        MOV     r2,r6
        BVS     %FT95
55
  [ mjsSysHeapNodesTrace
        Push    "r0-r2"
        LDR     r0,=ZeroPage
        LDR     r1,[r0,#mjsSHNT_vxs_total]
        ADD     r1,r1,#1
        STR     r1,[r0,#mjsSHNT_vxs_total]
        Pull    "r0-r2"
  ]
        CLRV
        Pull    "r0,r1,r3-r6,PC"
90
  [ mjsSysHeapNodesTrace
        Push    "r0-r2"
        LDR     r0,=ZeroPage
        LDR     r1,[r0,#mjsSHNT_vxh_total]
        ADD     r1,r1,#1
        STR     r1,[r0,#mjsSHNT_vxh_total]
        Pull    "r0-r2"
  ]
        MOV     r0,#HeapReason_ExtendBlock
        BL      DoSysHeapOpWithExtension
95
        STRVS   r0,[SP]
        Pull    "r0,r1,r3-r6,PC"

  ] ;SysVars_StickyNodes

        LTORG

        END