        TTL  => Arthur2

;        GET  $.Hdr.Variables  - got at start

VarType_System * &10                  ; internal type.

        MACRO
$l      GSVarGetWSpace
$l      LDR R12, =GSVarWSpace
        MEND

InitVariables  ROUT
        Push  "lr"
        MOV    R0, #0
        LDR    R12, =VariableList
        STR    R0, [R12]
        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_System
        ALIGN
        &      sv2-.-4
        LDR    PC, %FT01
        LDR    PC, %FT02
01
        &    SetTimeVar
02
        &    ReadTimeVar

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

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

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

sv5     =     "Sys$RCLimit", 0, VarType_System
        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

        ALIGN

; Now the code for our system variables.

ReadTimeVar
        Push  "lr"       ; Subr to read hh:mm:ss from clock
        BL     ReadClock
        ADD    R0, R0, #16
        MOV    R2, #8
        Pull  "PC"
SetTimeVar ROUT
        Push  "R0, lr"
        GSVarGetWSpace
        ADD    R12, R12, #GSNameBuff
        MOV    R11, #8
        STRB   R11, [R12], #1
        MOV    R10, #7
01      LDRB   R11, [R1, R10]
        STRB   R11, [R12, R10]
        SUBS   R10, R10, #1
        BPL    %BT01
        SUB    R1, R12, #1
        MOV    R0, #15
        SWI    XOS_Word
        Pull  "R0, PC"

ReadYear
        Push  "lr"       ; Subr to read yyyy from clock
        BL     ReadClock
        ADD    R0, R0, #11
        MOV    R2, #4
        Pull  "PC"
SetYear ROUT
        MOV    R2, #3    ; no chars -1
        MOV    R4, #11   ; offset -1
SetYD   Push  "R0-R2, lr"
        BL     ReadClock
        MOV    R10, #15
        STRB   R10, [R0, #-1]
        ADD    R0, R0, R4
        LDR    R1, [stack, #4]
        LDR    R2, [stack, #8]
01      LDRB   R10, [R1, R2]
        STRB   R10, [R0, R2]
        SUBS   R2, R2, #1
        BPL    %BT01
        SUB    R1, R0, R4
        SUB    R1, R1, #1
        MOV    R0, #15
        SWI    XOS_Word
        Pull  "R0-R2, PC"

ReadClock
        Push  "lr"
        GSVarGetWSpace       ; Subr to read ddd, nn mmm from clock
        ADD    R1, R12, #GSNameBuff+1
        MOV    R0, #0
        STRB   R0, [R1]
        MOV    R0, #14
        SWI    XOS_Word
        MOV    R0, R1
        MOV    R2, #10      ; no. of chars.
        Pull  "PC"
SetDate MOV    R2, #9
        MOV    R4, #0
        B      SetYD

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
        SETV
        Pull  "PC"
        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"

SetNumSysVar   ROUT ; R1 ptr to string, R2 string length
        Push  "lr"
        SUBS   R2, R2, #1
        ADDMI  R2, R2, #1     ; give 0 in R2 for crap.
        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

; 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

; 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.

        MOV     R1, #0
        GSVarGetWSpace
        STRB    R1, [R12, #GS_StackPtr]     ; no stacked R0s
        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)

        BIC   lr, lr, #C_bit
        MOV   R10, #0
        TST   R2, #GS_ReadingString
        BNE   %FT01                         ; take byte from stringvar
02      LDRB  R1, [R0], #1
        CMP   R1, #13
        CMPNE R1, #10
        CMPNE R1, #0
        BEQ   %FT03
        CMP   R1, #" "
        BEQ   %FT04
        BLT   %FT05                 ; bad string : control code in string
        CMP   R1, #""""
        BEQ   %FT07
        CMP   R1, #"|"
        TSTEQ R2, #GS_NoVBarStuff
        BEQ   %FT09
        CMP   R1, #"<"
        BNE   %FT08                 ; 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   %FA21               ; <> and < > are silly.
        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  %FA21
        CMP  R1, #">"
        BNE  %BT20
        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  %FT22                    ; silly - has to be name
        LDRB R1, [R1]                 ; check terminated by the null
        CMP  R1, #0
        BNE  %FT22
        MOV  R1, R2                   ; character value
        ADD   stack, stack, #4        ; discard old R0 value.
        Pull "R2, lr"
        B    %FT08                    ; exit-R1's the char value.

22      ; 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    %FT33                   ; return null expansion
; well, we've found it - better stack old R0
        Pull  "R0"
        GSVarGetWSpace
        LDRB   R1, [R12, #GS_StackPtr]
        CMP    R1, #GS_StackPtr_Lim
        BHS    %FA32
        ADD    R12, R12, #GS_Stack
        STR    R0, [R12, R1, LSL #2]
        ADD    R1, R1, #1
        STRB   R1, [R12, #GS_StackPtr-GS_Stack]
        MOV    R0, R4
        LDRB   R1, [R0], #1          ; type
        CMP    R1, #VarType_System
        BEQ    %FA99
        CMP    R1, #VarType_Number
        LDRB   R1, [R0], #1
        BLO    %FA30
        BHI    %FT31
        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.
30      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      %FT08

31      ; 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     %BT02                ; loop, transforming chars.

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

21      Pull "R0, R2, lr"
        MOV  R1, #"<"
        B    %FT08                 ; failed to get sensible variable

03      TST   R2, #GS_In_String      ; got CR or LF
        BNE   %FT05                 ; bad string
        TST   R2, #GS_Macroing
06      ORREQ lr, lr, #C_bit          ; got terminator
        ExitSWIHandler EQ
        GSVarGetWSpace
        LDRB  R11, [R12, #GS_StackPtr]
        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     %BT02                ; return to prevstring

04      TST   R2, #(GS_In_String :OR: GS_Spc_term :OR: GS_Macroing)
                                   ; got space : check termination
        BEQ   %BT06                ; terminates
08      ORR   R1, R1, R10            ; valid character
        ExitSWIHandler

07      TST  R2, #GS_In_String
        BEQ  %BT08                 ; if not in string, " is valid.
        LDRB R1, [R0], #1
        CMP  R1, #""""              ; "" in string?
        BEQ  %BT08                 ; yup
10      LDRB R1, [R0], #1
        CMP  R1, #" "
        BEQ  %BT10
        ORR  lr, lr, #C_bit          ; got terminator (second ")
        ExitSWIHandler             ; and out

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

01      SUB    R2, R2, #1            ; we're reading a string
        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
        STRB   R0, [R12, #GS_StackPtr]
        ADD    R12, R12, #GS_Stack
        LDR    R0, [R12, R0, LSL #2]
        BIC    R2, R2, #GS_ReadingString
        B      %BT02
05
        ADR    R0, BadStrErr
        ORR    lr, lr, #V_bit :OR: C_bit
        ExitSWIHandler

BadStrErr
        MakeErrorBlock BadString

99      ADD    R0, R0, #3         ; got to read sysvar : R0 points after type
        BIC    R0, R0, #3         ; ALIGN
        MOV    lr, PC            ; get link
        ADD    PC, R0, #4         ; call entrypoint to Read Thunk
        MOV    R1, R2
        B      %BA30

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.

VarLink  *  0
VNameOff *  4

; First the lookup SWI, ReadVarValue
; In  : R0 ptr to name maybe wildcarded (* and #)
;       R1 ptr to buffer
;       R2 buffer max length
;       R3 name pointer or 0.
;       R4 dont care or VarType_Expanded

; Out : R0, R1 unaltered
;       R2 no chars got
;       R3 new context ptr. This has to be a pointer to the real name found, 
;          so we know what we really got.
;       R4 type byte
;       V set if can't find (R2=0), or buffer overflowed

ReadVarValue ROUT
      Push    "R4, lr"
      BL       VarFindIt
      MOV      R11, R4
      Pull    "R4, lr"
      BEQ      RVVNotFound
      CMP      R4, #VarType_Expanded
      BEQ      %FT04
      LDRB     R4, [R11], #1      ; get type
      CMP      R4, #VarType_System
      BEQ      %FA03
      CMP      R4, #VarType_Number
      MOVEQ    R10, #4
05    LDRNEB   R10, [R11], #1
; so got R1 ptr to buffer, R11 ptr to value
;        R2 max no of bytes
;        R10 actual no of bytes
24    CMP      R10, R2
      BLE      VarNoOFlo
      ADR      R0, BufferOFloError
      ORR      lr, lr, #V_bit     ; set for return
      MOV      R10, R2
VarNoOFlo
      MOV      R2, R10           ; bytes he's gonna get
; now copy R10 bytes into buffer
02    SUBS     R10, R10, #1
      ExitSWIHandler  MI        ; good return
      LDRB     R12, [R11, R10]
      STRB     R12, [R1, R10]
      B        %BT02

BufferOFloError
      MakeErrorBlock BuffOverflow

RVVNotFound
        ADR     R0, RVVNFError
        MOV     R2, #0                  ; indicate not found.
        B       SLVK_SetV               ; "not found" return

RVVNFError
      MakeErrorBlock VarCantFind

03    Push    "R0-R2, lr"        ; read sysvar : R11 points after type
      ADD      R11, R11, #3
      BIC      R11, R11, #3       ; ALIGN
      MOV      lr, PC            ; construct link
      ADD      PC, R11, #4        ; call read code in var
      MOV      R11, R0           ; ptr to value
      MOV      R10, R2           ; no of chars.
      Pull    "R0-R2, lr"
      MOV      R4, #VarType_String
      B        %BT24


04    LDRB     R4, [R11], #1       ; expanded var wanted:check real type
      CMP      R4, #VarType_System
      BEQ      %BA03             ; always get string from sysvars
      CMP      R4, #VarType_Number
      BLT      %BT05             ; itsa string - easy
      BEQ      %FA07
; macro - gstrans it. R1 buffer ptr, r2 max chars, R11+1 ptr to value.
; Macros have a terminator after their value, to allow GSTRANS.

        Push    "R0, lr"
        ADD     R0, R11, #1             ; skip length
        SWI     XOS_GSTrans
        STRVS   R0, [stack]
        Pull    "R0, lr"
        BVS     SLVK_TestV

        ExitSWIHandler CC

        ADR     R0, BufferOFloError
        B       SLVK_SetV


07    Push    "R0, lr"
      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
      STRVS    R0, [stack]
      Pull    "R0, lr"
      MOV      R4, #VarType_String
        B       SLVK_TestV

;***************************************************************************

; 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
      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)
;       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_System   : R2 is the length of the code to copy in, including
;                     padding to align the code.
;                     Can only delete sysvars if R4 = VarType_System

; 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)

SVStackFull
        ADRL    r0, ErrorBlock_StackFull

SetVarValueBadExit
        Pull    "R1, R2, R4, lr"
        B       SLVK_SetV


SetVarValue ROUT

        Push    "R1, R2, R4, lr"
        CheckSpaceOnStack  512, SVStackFull, r12
        SUB     stack, stack, #256      ; buffer space

        CMP     R2, #0
        BMI     %FT10                   ; deletion

; now range check type
        CMP     R4, #VarType_System
        BEQ     %FT10
        CMP     R4, #VarType_Expanded
        BLS     VarTypeOK

        ADR     R0, ErrorBlock_BadVarType ; V set no. 4)
        B       SetVarValueBadExit_256

        MakeErrorBlock BadVarType


VarBadStrErr
        Pull    "R1"

SetVarValueBadExit_256
        ADD     stack, stack, #256
        B       SetVarValueBadExit


VarTypeOK
; now get the value, before destroying anything
        BEQ      %FT20                 ; evaluate an expression
        CMP      R4, #VarType_Number
        MOVEQ    R2, #3                 ; numbers use type byte as one byte.
        BEQ      %FT10
        BGT      %FT11
; 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      %FT10

14      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]

; now got R1 pointer to value, R2 = value length
10      BL       VarFindIt
        BEQ      %FT02
        LDRB     R10, [R4]              ; get type
        CMP      R10, #VarType_System
        BNE      %FT30
        LDR      R10, [Stack, #4*2+256]
        CMP      R10, #VarType_System
        BNE      %FT01
30      CMP      R2, #0
        BMI      %FT03                    ; just delete it.
        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      %FT04
; 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

; got to delete old node (too small). R12 previous, R3-VNameOff is this.
03      SUB      R3, R3, #VNameOff
        LDR      R11, [R3, #VarLink]
        STR      R11, [R12, #VarLink]     ; chain updated
        Push    "R0-R2"
        MOV      R0, #HeapReason_Free
        LDR      R1, =SysHeapStart
        MOV      R2, R3                   ; node ptr.
        SWI      XOS_Heap
        Pull    "R0-R2"                   ; node gone
        ADD      R3, R12, #VNameOff       ; our best guess at a context ptr
        CMP      R2, #0                   ; delete?
        BMI      SetVarValueTestExit      ; yup - exit.

; here, R2 is value length, R0 ptr to name. Validate name while finding length
19      MOV      R10, #0
16      LDRB     R11, [R0, R10]
        ADD      R10, R10, #1
        CMP      R11, #"#"
        CMPNE    R11, #"*"
        BEQ      %FA17                    ; error no. 1)
        CMP      R11, #32
        BGT      %BT16
        CMP      R10, #1
        BEQ      %FA17                    ; 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      STR      R11, [R4, #VarLink]
        STR      R4, [R12, #VarLink]     ; new entry in
        Pull    "R5, R6"
        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]

04 ; 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_System
        ADDEQ    R4, R4, #3              ; align for code.
        BICEQ    R4, R4, #3
        CMP      R10, #VarType_Number
        MOVEQ    R2, #4
        CMPNE    R10, #VarType_System   ; 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_256

        MakeErrorBlock VarNoRoom


11      MOV     R2, #0
13      CMP     R2, #255
        BGT     %BT14
        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     %BT10

        ADR     r0, ErrorBlock_BadMacVal
        B       SetVarValueBadExit_256

        MakeErrorBlock BadMacVal


17      ADR     r0, ErrorBlock_BadVarNam ; VS no. 2)
        B       SetVarValueBadExit_256

        MakeErrorBlock BadVarNam


02      CMP      R2, #0        ; no node for it, test whether deletion
        BPL      %BT19

        ADRL    r0, ErrorBlock_VarCantFind ; V set no. 1)
        B       SetVarValueBadExit_256


01      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
        Pull    "R1, R2, R4, lr"
        TST      lr, #V_bit
        ADRNE    R0, ErrorBlock_VarTooLong
        ExitSWIHandler

        MakeErrorBlock VarTooLong

20
        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        %BT10


NarffExpression
        ADD     stack, stack, #256+4    ; discard an r0 and buffer
        Pull    "R1, R2, r4, lr"
        B       SLVK_SetV

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


VarFindIt ROUT
; R0 name ptr, R3 potential context ptr
; Out : R3 name ptr, R4 ptr after name terminator
;       R12 is the address of the previous node
;       NE for found, EQ for not.
;  Enables interrupts (this may take some time, guys)

        TEQP     PC, #SVC_mode                 ; ints enabled.
        Push    "lr"

; 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
        Pull    "PC", EQ                  ; failed
        ADD      R4, R3, #VNameOff
        BL       WildMatch
        BNE      %BT01
        ADDS     R3, R3, #VNameOff         ; get node ptr and set NE
        Pull    "PC"                     ; 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

; *****************************************************************************
; Arthur Utility commands

SysModules_Info ROUT     ; start of ROM modules chain
           &   FSModule-UtilityMod


UtilityMod &   StartSuper-UtilityMod
           &   0            ; no initialisation
           &   Util_Die-UtilityMod
           &   0            ; no services ta
           &   UtilModTitle-UtilityMod
           &   UtilHelpStr-UtilityMod
           &   UtilHelpTab-UtilityMod

Module_BaseAddr SETA UtilityMod


Util_Die   ROUT
           CMP   R10, #0
           MOVEQ PC, lr      ; non-fatal : can cope
           ADR   R0, %FT01
           ORRS  PC, lr, #V_bit
01
           &     ErrorNumber_CantKill
           =    "Deleting the utility module is foolish", 0


UtilModTitle =  "UtilityModule", 0

UtilHelpStr  =  "MOS Utilities", 9, "$VersionNo", 0

UtilHelpTab
           Command   Break,       0,  0   ; just help
           Command   Configure, 255,  0, Help_Is_Code_Flag
           Command   Commands,    0,  0, Help_Is_Code_Flag
           Command   Echo,      255,  0
           Command   Error,     255,  1
           Command   Eval,      255,  1
           Command   FileCommands,0,  0, Help_Is_Code_Flag
           Command   GOS,     0,  0
           Command   IF,        255,  2
           Command   Ignore,      1,  0
           Command   Modules,     0,  0, Help_Is_Code_Flag
           Command   PowerOn,     0,  0   ; just help
           Command   Reset,       0,  0   ; just help
           Command   RMClear,     0,  0
           Command   RMEnsure,  255,  2
           Command   RMFaster,    1,  1
           Command   RMKill,      1,  1
           Command   RMLoad,    255,  1
           Command   RMReInit,  255,  1
           Command   RMRun,     255,  1
           Command   RMTidy,      0,  0
           Command   ROMModules,  0,  0
           Command   Set,       255,  2
           Command   SetEval,   255,  2
           Command   SetMacro,  255,  2
           Command   Show,        1,  0        ; *show = *show *
           Command   Status,    255,  0
           Command   Syntax,      0,  0
           Command   Time,        0,  0
           Command   Unplug,      1,  0
           Command   Unset,       1,  1
           =   0

Configure_Syntax     * Module_BaseAddr
Commands_Code        * Module_BaseAddr
Commands_Syntax      * Module_BaseAddr
Syntax_Code          * Module_BaseAddr
Syntax_Syntax        * Module_BaseAddr
Echo_Syntax          * Module_BaseAddr
Status_Syntax        * Module_BaseAddr
FileCommands_Code    * Module_BaseAddr
FileCommands_Syntax  * Module_BaseAddr
Reset_Code           * Module_BaseAddr
Reset_Syntax         * Module_BaseAddr
Break_Code           * Module_BaseAddr
Break_Syntax         * Module_BaseAddr
PowerOn_Code         * Module_BaseAddr
PowerOn_Syntax       * Module_BaseAddr

RMFaster_Code
           Push "lr"
           MOV R1, R0
           MOV R0, #ModHandReason_LookupName
           SWI XOS_Module
           Pull "PC", VS
           CMP   R3, #ROM
           BLT   RMFast_notinROM
           MOV   R1, R3
           LDR   R2, [R1, #-4]
           MOV   R0, #ModHandReason_CopyArea
           SWI   XOS_Module
           Pull  PC

RMFast_notinROM
           ADRL R0, ErrorBlock_RMNotFoundInROM
           Pull lr
           ORRS PC, lr, #V_bit

RMKill_Code
           MOV R6, #ModHandReason_Delete

Rmcommon   Push "lr"
           MOV r1, r0
           MOV r0, r6
           SWI   XOS_Module
           Pull "PC"

RMLoad_Code
           MOV R6, #ModHandReason_Load
           B   Rmcommon

RMRun_Code
           MOV R6, #ModHandReason_Run
           B   Rmcommon

RMTidy_Code
           MOV R6, #ModHandReason_Tidy
           B   Rmcommon

RMClear_Code
           MOV R6, #ModHandReason_Clear
           B   Rmcommon

RMReInit_Code
           MOV R6, #ModHandReason_ReInit
           B   Rmcommon

Modules_Help   ROUT
          Push  "lr"
          ADRL   R0, modules_help1
          MOV    r1, #0
          SWI    XOS_PrettyPrint
          Pull  "PC", VS
          MOV    R1, #Module_List
03        LDR    R1, [R1]
          CMP    R1, #0
          BEQ    %FT05
          LDR    R0, [R1, #Module_code_pointer]
          BL     PrintTitle
          BVC    %BT03
05        MOVVC  R0, #0
          Pull  "PC"

PrintTitle ; of module at R0 : corrupts R0
        Push  "R1, lr"
        LDR    R1, [R0, #Module_HelpStr]
        CMP    R1, #0
        ADREQ  R0, NoRIT
        ADDNE  R0, R1, R0
        SWI    XOS_PrettyPrint
        SWIVC  XOS_NewLine
        Pull  "R1, PC"

Modules_Code ROUT
        Push   "R7, lr"

        SWI     XOS_WriteS
        =      "No. Position Workspace Name", 10, 13, 0
        ALIGN
        Pull   "R7, PC", VS

        MOV     R1, #0
        MOV     R2, #0
        MOV     R6, #0
        MOV     R7, #0
06      MOV     R0, #ModHandReason_GetNames
        SWI     XOS_Module
        Pull   "R7, lr", VS
        BICVSS  PC, lr, #V_bit           ; back, clearing V

        Push   "R1, R2"
        CMP     R6, #0
        MOVNE   R1, #0
        BNE     %FT02
        ADD     R7, R7, #1
        MOV     R0, R7
        LDR     R1, =GeneralMOSBuffer
        MOV     R2, #256
        SWI     XOS_ConvertCardinal2
        SUB     R1, R1, R0          ; characters in buffer
02      CMP     R1, #3
        SWILT   XOS_WriteI+" "
        BVS     %FT03
        ADDLT   R1, R1, #1
        BLT     %BT02
03
        Pull   "R1, R2"
        BVS     %FT04
        CMP     R6, #0
        SWIEQ   XOS_Write0
        SWIVC   XOS_WriteI+" "
        MOV     R0, R3
        BLVC    HexR0LongWord
        SWIVC   XOS_WriteI+" "
        MOV     R0, R4
        BLVC    HexR0LongWord
        SWIVC   XOS_WriteI+" "
        SWIVC   XOS_WriteI+" "
        BLVC    %FT01         ; title out
        SWIVC   XOS_NewLine
        BVC     %BT06
04
        Pull   "R7, PC"
01
        Push   "lr"
        LDR     R0, [R3, #Module_Title]
        CMP     R0, #0
        ADDNE   R0, R3, R0
        ADREQ   R0, NoRIT
        SWI     XOS_Write0
        Pull   "PC", VS
        CMP     R6, #0
        CMPEQ   R2, #0
        MOV     R6, R2
        Pull   "PC", EQ       ; only one incarnation
        SWI     XOS_WriteI + Postfix_Separator
        MOV     R0, R5
        SWIVC   XOS_Write0
        Pull   "PC"

NoRIT   =   "<Untitled>", 0
starstr =   "*", 13
        ALIGN

Show_Code ROUT
        Push     "lr"

        Push     "R0-R2"
        MOV       R0, #117               ; Read current VDU status
        SWI       XOS_Byte              ; Won't fail
        STR       R1, [stack, #8]       ; push R1!
        Pull     "R0, R1"
        SWI       XOS_WriteI+14         ; paged mode on.
        Pull      "r1, pc", VS          ; Wrch can fail

        CMP    R1, #0        ; *show only?
        ADREQ  R0, starstr
        LDR    R1, =EnvString
        MOV    R3, #0
01      MOV    R4, #0        ; no expansion
        MOV    R2, #256
        SWI    XOS_ReadVarVal
        BVS    ShowExit      ; don't think it can overflow.

        Push  "R0"
        MOV    R0, R3
        SWI    XOS_Write0
        BVS    ShowBang
        CMP    R4, #VarType_String
        BEQ    skipvalprt
        SWI    XOS_WriteS
        =      " (", 0
        ALIGN
        BVS    ShowBang
        CMP    R4, #VarType_Number
        MOVEQ  R2, #256
        LDREQ  R0, [R1]
        SWIEQ  XOS_BinaryToDecimal
        ADREQ  R0, %FT02
        ADRHI  R0, %FT03
        SWIVC  XOS_Write0
        SWIVC  XOS_WriteI+")"
        BVS    ShowBang
skipvalprt
        SWI    XOS_WriteS
        =      " : ", 0
        ALIGN
        BVS    ShowBang
        MOV    R5, #-1
05      ADD    R5, R5, #1
        CMP    R5, R2
        BEQ    %FT06
        LDRB   R0, [R1, R5]
        CMP    R0, #&7F
        MOVEQ  R0, #"?"-"@"
        CMP    R0, #31
        ADDLE  R0, R0, #"@"
        SWILE  XOS_WriteI+"|"
        BVS    ShowBang

        CMP    R0, #"|"
        CMPNE  R0, #""""
        CMPNE  R0, #"<"
        SWINE  XOS_WriteC
        BVS    ShowBang
        BNE    %BT05

        CMP    R4, #VarType_Macro
        SWINE  XOS_WriteI+"|"
        SWIVC  XOS_WriteC
        BVC    %BT05
ShowBang
        Pull  "R1, R2, lr"          ; discarded R0
        ORR    lr, lr, #V_bit
        Push  "R2, lr"
ShowExit
        Pull  "R1"
        TST    R1, #5
        SWIEQ  XOS_WriteI+15  ; paged mode off
        Pull  "lr"
        MOVS   PC, lr

06      SWI    XOS_NewLine
        BVS    ShowBang
        Pull  "R0"
        B      %BT01
02
        =      "Number", 0
03
        =      "Macro", 0

Set_Code ROUT
        MOV    R4, #VarType_String
01
        Push  "lr"
        SUB    sp, sp, #256
        MOV    R1, R0
        MOV    R0, sp
        MOV    R3, #0
02      LDRB   R2, [R1], #1
        STRB   R2, [R0, R3]
        CMP    R2, #" "
        ADDNE  R3, R3, #1
        BNE    %BT02
        MOV    R2, #13
        STRB   R2, [R0, R3]
03      LDRB   R2, [R1], #1
        CMP    R2, #" "
        BEQ    %BT03
        SUB    R1, R1, #1
        MOV    R2, #1
        MOV    R3, #0
        SWI    XOS_SetVarVal
        ADD    sp, sp, #256
        Pull  "PC"

        LTORG

SetMacro_Code MOV    R4, #VarType_Macro
        B  %BT01

SetEval_Code MOV    R4, #VarType_Expanded
        B  %BT01

Unset_Code ROUT
        Push  "lr"
        MOV    R2, #-1
        MOV    R3, #0
01      SWI    XOS_SetVarVal
        BVC    %BT01
        Pull  "lr"
        BICS   PC, lr, #V_bit

Echo_Code ROUT
        Push  "lr"
        MOV    R2, #GS_NoQuoteMess
        SWI    XOS_GSInit
01      SWI    XOS_GSRead
        BVS    %FT02
        MOVCC  R3, R0
        MOVCC  R0, R1
        SWICC  XOS_WriteC
        BVS    %FT02
        MOVCC  R0, R3
        BCC    %BT01
        SWI    XOS_NewLine
02
        Pull  "PC"

Commands_Help  ROUT
        Push  "R0, lr"         ; keep buffer pointer
        ADRL   R0, commands_helpstr
        MOV    R1, #0
KeyHelpCommon                  ; also used by *Configure
        Push   r1
        MOV    r1, #0
        SWI    XOS_PrettyPrint
        Pull   r1
        BVS    %FT10
        Pull   r3              ; buffer pointer
        MOV    r0, #0
        ADRL   R2, SysCommsModule
        BL     OneModuleK
        BVS    %FT10
        MOV    R6, #Module_List
12      LDR    R6, [R6]
        CMP    R6, #0
        BEQ    %FT10
        LDR    R2, [R6, #Module_code_pointer]
        BL     OneModuleK
        BVC    %BT12
10      MOVVC  R0, #0
        Pull  "PC"

FileCommands_Help
        Push  "R0, lr"
        ADRL   R0, fscommands_helpstr
        MOV    R1, #FS_Command_Flag
        B      KeyHelpCommon

; take module code pointer in r2
;                    flags in r1
;    HelpBufferSize buffer in r3
;          string to print in r0

OneModuleK     ROUT
        Push  "r2-r6, lr"
        LDR    R4, [R2, #Module_HC_Table]
        CMP    R4, #0
        Pull  "r2-r6, PC", EQ       ; no table
        ORR    R3, R3, #&80000000   ; buffer position ptr and flag
        MOV    R5, #0               ; buffer offset

        ADD    R2, R2, R4           ; point at table start.
03      MOV    R6, R2
        LDRB   R4, [R2]
        CMP    R4, #0
        BEQ    %FT06

04      LDRB   R4, [R6], #1
        CMP    R4, #0
        BNE    %BT04
        ADD    R6, R6, #3
        BIC    R6, R6, #3           ; align
        LDR    R4, [R6, #0]         ; code offset
        CMP    r1, #-1              ; fudge?
        BEQ    %FT78
        CMP    R4, #0
        ADDEQ  R2, R6, #16
        BEQ    %BT03
        LDRB   R4, [R6, #7]
        BIC    R4, R4, #Help_Is_Code_Flag :SHR: 24
        CMP    R4, R1, LSR #24      ; move flags into bottom byte
79      ADDNE  R2, R6, #16
        BNE    %BT03
        TST    R3, #&80000000
        BEQ    %FT05
        SWI    XOS_NewLine
        SWIVC  XOS_NewLine
        BVS    %FT77
        CMP    r0, #0
        Push   r1, NE
        MOVNE  r1, #0
        SWINE  XOS_PrettyPrint
        Pull   r1, NE
        BNE    %FT77
        MOV    r4, r0
        LDR    r0, [stack]
        BL     PrintTitle
        MOVVC  r0, r4
77
        Pull  "r2-r6, PC", VS
        BIC    R3, R3, #&80000000
        CMP    R5, #HelpBufferSize-20
        BGT    %FT99
05      LDRB   R4, [R2], #1
        STRB   R4, [R3, R5]
        CMP    R4, #0
        ADDNE  R5, R5, #1
        BNE    %BT05
        MOV    R4, #TAB
        STRB   R4, [R3, R5]
        ADD    R5, R5, #1
        ADD    R2, R2, #3+16
        BIC    R2, R2, #3
        B      %BT03

78      CMP    r4, #0
        B      %BT79

06      TST    R3, #&80000000
        Pull  "r2-r6, PC", NE
        Push  "R0"
        MOV    R0, #0
        SUB    R5, R5, #1
        STRB   R0, [R5, R3]
        MOV    R0, R3
        SWI    XOS_PrettyPrint
        STRVS  r0, [stack]
        Pull  "R0, r2-r6, PC"
99
        Push  "R0" 
        MOV    R0, R3
        SWI    XOS_PrettyPrint
        SWIVC  XOS_NewLine
        STRVS  r0, [stack]
        Pull   r0
        MOV    R5, #0
        BVC    %BT05
        Pull  "r2-r6, PC"

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

GOS_Code
        Push    lr
        MOV     r2, r0
        addr    R1, UtilModTitle
        MOV     R0, #ModHandReason_Enter
        SWI     XOS_Module
        Pull    pc


        LNK    MoreComms
