        TTL     => Arthur3

; the IF command

IF_Code    ROUT
   Push   "R2, lr"
   LDR     R2, =GeneralMOSBuffer
01 LDRB    R1, [R0], #1
   STRB    R1, [R2], #1
   CMP     R1, #10
   CMPNE   R1, #13
   CMPNE   R1, #0
   BEQ     NoTHEN
   CMP     R1, #" "
   BNE     %BT01
   LDRB    R1, [R0]
   CMP     R1, #"t"
   CMPNE   R1, #"T"
   BNE     %BT01
   LDRB    R1, [R0, #1]
   CMP     R1, #"h"
   CMPNE   R1, #"H"
   BNE     %BT01
   LDRB    R1, [R0, #2]
   CMP     R1, #"e"
   CMPNE   R1, #"E"
   BNE     %BT01
   LDRB    R1, [R0, #3]
   CMP     R1, #"n"
   CMPNE   R1, #"N"
   BNE     %BT01
   LDRB    R1, [R0, #4]
   CMP     R1, #" "
   CMPNE   R1, #13
   CMPNE   R1, #10
   CMPNE   R1, #0
   BNE     %BT01
   MOV     R1, #13
   STRB    R1, [R2, #-1]
   ADD     R0, R0, #4  ; skip THEN
   Push   "R0"
   LDR     R0, =GeneralMOSBuffer
   MOV     R2, #-1    ; integers only mate
   SWI     XOS_EvaluateExpression
   BVS     WantInteger
   Pull   "R1"
   CMP     R2, #0
   BEQ     %FT02     ; false
   LDR     R2, =GeneralMOSBuffer
03 LDRB    R0, [R1], #1
   STRB    R0, [R2], #1
   CMP     R0, #10
   CMPNE   R0, #13
   CMPNE   R0, #0
   BEQ     %FT04
   CMP     R0, #" "
   BLEQ    %FT05
   BNE     %BT03
04 MOV     R0, #13
   STRB    R0, [R2, #-1]
   LDR     R0, =GeneralMOSBuffer
07 SWI     XOS_CLI
06
   Pull   "R2, PC"

05 LDRB    R0, [R1]
   CMP     R0, #"e"
   CMPNE   R0, #"E"
   MOVNE   PC, lr
   LDRB    R0, [R1, #1]
   CMP     R0, #"l"
   CMPNE   R0, #"L"
   MOVNE   PC, lr
   LDRB    R0, [R1, #2]
   CMP     R0, #"s"
   CMPNE   R0, #"S"
   MOVNE   PC, lr
   LDRB    R0, [R1, #3]
   CMP     R0, #"e"
   CMPNE   R0, #"E"
   MOVNE   PC, lr
   LDRB    R0, [R1, #4]
   CMP     R0, #" "
   CMPNE   R1, #13
   CMPNE   R1, #10
   CMPNE   R1, #0
   MOV     PC, lr

02 LDRB    R0, [R1], #1
   CMP     R0, #10
   CMPNE   R0, #13
   CMPNE   R0, #0
   BEQ     %BT06
   CMP     R0, #" "
   BLEQ    %BT05
   BNE     %BT02
   ADD     R0, R1, #4
   B       %BT07

NoTHEN     ROUT
   ADR     R0, %FT01
IfError
   Pull   "R2, lr"
   ORRS    PC, lr, #V_bit
01
   &       ErrorNumber_Syntax
   =      "There is no THEN", 0
   ALIGN

WantInteger ROUT
   CMP     R1, #0
   Pull   "R1"
   Pull   "R2, lr", EQ      ; integer returned, so leave expranal error there
   ORREQS  PC, lr, #V_bit
   ADR     R0, %FT01
   B       IfError
01
   &       ErrorNumber_Syntax
   =      "Expression is a string", 0
   ALIGN

;************************************************************************
; the expression analysis SWI

; truth values
Expr_True  *  -1
Expr_False *   0

; Type symbols

type_Integer  * 0
type_String   * 1
type_Operator * 2

; operators :
; single char syms have their ascii value
op_Bra     * "("   ; 40
op_Ket     * ")"   ; 41
op_Times   * "*"   ; 42
op_Plus    * "+"   ; 43
op_Minus   * "-"   ; 45
op_Divide  * "/"   ; 47
op_LT      * "<"   ; 60
op_EQ      * "="   ; 61
op_GT      * ">"   ; 62

; now fill in some gaps

op_NE      * 44    ; <>
op_STR     * 46    ; STR
op_GE      * 48    ; >=
op_LE      * 49    ; <=
op_RShift  * 50    ; >>
op_LShift  * 51    ; <<
op_AND     * 52    ; AND
op_OR      * 53    ; OR
op_EOR     * 54    ; EOR
op_NOT     * 55    ; NOT
op_Right   * 56    ; RIGHT
op_Left    * 57    ; LEFT
op_MOD     * 58    ; MOD
op_Bottom  * 59
op_VAL     * 63    ; VAL
op_LRShift * 64    ; >>>
op_LEN     * 65    ; LEN

; so 40-65 inclusive is filled.

        MACRO
$label  ePush  $reglist, $pulllist
$label  STMFD  R11!, {$reglist}
        CMP    R11, R10
        BLE    StackOFloErr
        MEND

        MACRO
$label  ePull  $reglist, $writeback
      [ "$writeback" = ""
        LDMFD  R11!, {$reglist}
      |
        LDMFD  R11, {$reglist}
      ]
        MEND

;*************************************************************************
; SWI EvalExp.
; In  : R0 -> string
;       R1 -> buffer
;       R2 maxchars
; Out : R0 unchanged.
;       IF R1 = 0, R2 is an integer
;       IF R1<>0, buffer has a string, length in R2.
;       V set if bad expression, buffer overflow
;*************************************************************************

ExprBuffOFlo ROUT
    ADRL     R0, ErrorBlock_BuffOverflow
    STR      R0, [stack]
    Pull    "R0-R4, lr"
    B        SLVK_SetV

ReadExpression ROUT
    Push    "R0-R4, lr"
    TEQP     PC, #SVC_mode   ; interrupts on, ta.
    LDR      R12, =ExprWSpace
    STR      R13, ExprSVCstack
    ADR      R1, ExprBuff
    MOV      R2, #256
    ORR      R2, R2, #(1 :SHL: 30) :OR: (1 :SHL: 31)
    SWI      XOS_GSTrans   ; No | transformation, no " or space termination.
                           ; so can never go wrong!
    BCS      ExprBuffOFlo
    MOV      R0, #13
    STRB     R0, [R1, R2]

    LDR      R11, =ExprStackStart
    LDR      R10, =ExprStackLimit
    MOV      R0, #0
    STRB     R0, exprBracDif
    MOV      R0, #type_Operator
    MOV      R2, #op_Bottom
    STRB     R2, tos_op
    STMFD    R11!, {R0, R2}    ; push "bottom"
  
; All set : now chug round items.

01  BL       GetFactor
    CMP      R0, #type_Operator
    BNE      %BT01

    CMP      R2, #op_Ket
    BNE      %FT02
    LDRB     R3, exprBracDif
    CMP      R3, #0
    BEQ      BadBraErr
    SUB      R3, R3, #1
    STRB     R3, exprBracDif

03  LDRB     R3, tos_op
    CMP      R3, #op_Bra
    BLNE     compile_top_op
    BNE      %BT03
    ePull   "R0, R2"
    CMP      R0, #type_Operator
    BEQ      MissingOpErr
    CMP      R0, #type_String
    BLEQ     Pull_String
    Push    "R0, R2"
    ePull   "R0, R2"
    CMP      R0, #type_Operator
    BNE      MissingOrErr     ; discard "("
    ePull   "R0, R2", No
    CMP      R0, #type_Operator
    BNE      MissingOrErr
    STRB     R2, tos_op      ; reset tosop
    Pull    "R0, R2"
    CMP      R0, #type_String
    BLEQ     Push_String
    ePush   "R0, R2"         ; move temp result down.
    B        %BT01
    
02  CMP      R2, #op_Bra
    LDREQB   R3, exprBracDif
    ADDEQ    R3, R3, #1
    STREQB   R3, exprBracDif   ; bracdif +:= 1

 ;  WHILE lp (tos.op) > rp (itemtype) DO compile.top.op ()
    ADR      R4, rightprectab-op_Bra
    LDRB     R4, [R4, R2]
04  ADR      R0, leftprectab-op_Bra
    LDRB     R3, tos_op
    LDRB     R0, [R0, R3]
    CMP      R0, R4
    BLGT     compile_top_op
    BGT      %BT04

    MOV      R0, #type_Operator
    ePush   "R0, R2"      ;  push (operator)
    STRB     R2, tos_op
    CMP      R2, #op_Bottom
    BNE      %BT01

; check proper expr, return it.
; should have bum/result/bum on stack.
    ePull   "R0, R2"   ; this one's forced to be bottom
    ePull   "R0, R2"
    CMP      R0, #type_Operator
    BEQ      MissingOpErr
    CMP      R0, #type_String
    BLEQ     Pull_String
    Push    "R0, R2"
    ePull   "R0, R2"
    CMP      R0, #type_Operator  ; if an operator's there, it has to be bottom
    Pull    "R1, R2"
    BNE      MissingOpErr

    Pull    "R0, R3, R4"  ; original R1, R2 -> R3, R4
    CMP      R1, #type_Integer
    Pull    "R3, R4, lr", EQ
    ExitSWIHandler EQ
    CMP      R4, R2
    BGE      ExprBuffOK
    MOV      R2, R4       ; no chars to move.
    ADRL     R0, BufferOFloError
    LDR      lr, [stack, #4*2]
    ORR      lr, lr, #V_bit
    STR      lr, [stack, #4*2]
ExprBuffOK
    MOV      R1, R3
    LDR      R4, =exprSTRACC   ; get ptr to it.
    Push    "R2"
06  SUBS     R2, R2, #1
    LDRPLB   R3, [R4, R2]
    STRPLB   R3, [R1, R2]
    BPL      %BT06
    Pull    "R2-R4, lr"
    ExitSWIHandler

leftprectab
;    Bra  Ket  Time Plus NE   Minu STR  Divi GE   LE   RShi LShift
   = 2,   1,   8,   7,   6,   7,   9,   8,   6,   6,   6,   6
;    AND  OR   EOR  NOT  Righ Left MOD  Bott LT   EQ   GT   VAL LRSh
   = 5,   4,   4,   9,   9,   9,   8,   1,   6,   6,   6,   9,  6
;    LEN
   = 9

rightprectab
;    Bra  Ket  Time Plus NE   Minu STR  Divi GE   LE   RShi LShift
   = 11,  0,   7,   6,   5,   6,   10,  7,   5,   5,   5,   5
;    AND  OR   EOR  NOT  Righ Left MOD  Bott LT   EQ   GT   VAL LRSh
   = 4,   3,   3,   10,  10,  10,  7,   1,   5,   5,   5,   10, 5
;    LEN
   = 10

    ALIGN

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

compile_top_op ROUT
 ; preserves the flags
      Push  "R2-R4, lr"
      ePull "R0, R2"
      CMP    R0, #type_Operator
      BEQ    MissingOpErr    ; everybody needs a rhs op
      CMP    R0, #type_String
      BLEQ   Pull_String
      ePull "R3, R4"         ; must be tosop
      CMP    R3, #type_Operator
      BNE    MissingOrErr

      SUB    R4, R4, #op_Bra
      ADR    R3, Operator_Dispatch
      LDR    R4, [R3, R4, LSL #2]
      ADD    PC, R3, R4

DispatchReturn
      ePull "R3, R4", No  ; pull with no writeback
      CMP    R3, #type_Operator
      BNE    MissingOrErr
      STRB   R4, tos_op
      CMP    R0, #type_String
      BLEQ   Push_String
      ePush "R0, R2"     ; temp val -> stack

      GRABS "R2-R4, PC"

; the routines in this table are entered with one operand popped, 
; any other op on stack ready to pop.
; Return with temp val set up (R0, R2 and maybe exprSTRACC)
; Can use R0, R2-R4 as reqd

Operator_Dispatch
      &    Bra_Code - Operator_Dispatch
      &      0  ;  Ket_Code - Operator_Dispatch - can't happen
      &  Times_Code - Operator_Dispatch
      &   Plus_Code - Operator_Dispatch
      &     NE_Code - Operator_Dispatch
      &  Minus_Code - Operator_Dispatch
      &    STR_Code - Operator_Dispatch
      & Divide_Code - Operator_Dispatch
      &     GE_Code - Operator_Dispatch
      &     LE_Code - Operator_Dispatch
      & RShift_Code - Operator_Dispatch
      & LShift_Code - Operator_Dispatch
      &    AND_Code - Operator_Dispatch
      &     OR_Code - Operator_Dispatch
      &    EOR_Code - Operator_Dispatch
      &    NOT_Code - Operator_Dispatch
      &  Right_Code - Operator_Dispatch
      &   Left_Code - Operator_Dispatch
      &    MOD_Code - Operator_Dispatch
      &     0   ; Bottom_Code - Operator_Dispatch - can't happen
      &     LT_Code - Operator_Dispatch
      &     EQ_Code - Operator_Dispatch
      &     GT_Code - Operator_Dispatch
      &    VAL_Code - Operator_Dispatch
      & LRShift_Code- Operator_Dispatch
      &     LEN_Code- Operator_Dispatch

;**************************************************************************
; dispatch  routines

;--------------------------------------------------------------------------
; monadic operators

VAL_Code    ROUT  ; VAL string (VAL integer is NOP)
       CMP  R0, #type_String
       BLEQ StringToInteger
       B    DispatchReturn

STR_Code    ROUT  ; STR integer (STR string is NOP)
       CMP  R0, #type_Integer
       BLEQ IntegerToString
       B    DispatchReturn

LEN_Code    ROUT  ; LEN string
       CMP  R0, #type_Integer
       BLEQ IntegerToString
       MOV  R0, #type_Integer   ; and R2 is length!
       B    DispatchReturn

NOT_Code     ROUT  ; NOT integer
       CMP   R0, #type_String
       BLEQ  StringToInteger
       MOV   R0, #-1
       EOR   R2, R2, R0
       MOV   R0, #type_Integer
       B     DispatchReturn
                           
;--------------------------------------------------------------------------
; potentially monadic

Plus_Code     ROUT  ; integer+integer ; + integer ; string+string
       ePull "R3, R4"
       CMP    R3, #type_Operator
       BEQ    %FT01
       CMP    R0, #type_String
       BEQ    %FT02
       CMP    R3, #type_String
       BLEQ   PullStringToInteger  ; in R4
       ADD    R2, R2, R4
       B      DispatchReturn

02     CMP    R3, #type_String
       BEQ    %FT03
       BL     StringToInteger
       ADD    R2, R2, R4
       B      DispatchReturn

03     ADD    R0, R2, R4
       CMP    R0, #255
       BGT    StrOFloErr
       LDR    R3, =exprSTRACC
       Push  "R0"         ; new length
       ADD    R0, R3, R0
       ADD    R3, R3, R2
  ; copy R2 bytes from --(R3) to --(R0)
04     SUBS   R2, R2, #1
       LDRGEB R4, [R3, #-1]!
       STRGEB R4, [R0, #-1]!
       BGE    %BT04
; R0-exprSTRACC is no of chars in stacked string
       LDR    R3, =exprSTRACC
       SUB    R0, R0, R3
05     SUBS   R0, R0, #1
       LDRGEB R2, [R11], #1
       STRGEB R2, [R3], #1
       BGE    %BT05
       ADD    R11, R11, #3
       BIC    R11, R11, #3  ; realign stack
       Pull  "R2"
       MOV    R0, #type_String
       B      DispatchReturn
  
01
       ePush "R3, R4"    ; monadic
       CMP    R0, #type_String
       BLEQ   StringToInteger
       B      DispatchReturn

Minus_Code    ROUT  ; integer-integer ; -integer
       ePull "R3, R4", No
       CMP    R3, #type_Operator
       BEQ    %FT01
       BL     TwoIntegers
       SUB    R2, R4, R2
       B      DispatchReturn

01     CMP    R0, #type_String
       BLEQ   StringToInteger
       RSB    R2, R2, #0
       B      DispatchReturn

;---------------------------------------------------------------------------
; integer pair only : maths

Times_Code   ROUT  ; integer*integer
       BL    TwoIntegers
       MOV   R3, R2
       MULTIPLY R2, R3, R4   ; get R3*R4->R2
       B     DispatchReturn

MOD_Code     ROUT  ; integer MOD integer
       Push "R5"
       MOV   R5, #&80000000
       B     DivModCommon

Divide_Code  ROUT  ; integer/integer
       Push "R5"
       MOV   R5, #0
DivModCommon
       BL     TwoIntegers    ; want R4/R2
       CMP    R2, #0
       Pull  "R5", EQ
       BEQ    DivZeroErr
       RSBMI  R2, R2, #0
       EORMIS R5, R5, #1
       EORMI  R5, R5, #1      ; oops-wanted MOD, ignore this sign
       CMP    R4, #0
       EORMI  R5, R5, #1
       RSBMI  R4, R4, #0
       DivRem R3, R4, R2, R0   ; R3 := R4 DIV R2; R4 := R4 REM R2
       MOVS   R5, R5, LSL #1  ; CS if MOD, NE if -ve
       MOVCS  R2, R4
       MOVCC  R2, R3
       RSBNE  R2, R2, #0
       MOV    R0, #type_Integer
       Pull  "R5"
       B      DispatchReturn

;---------------------------------------------------------------------------
; integer pair only : logical

AND_Code     ROUT  ; integer AND integer
       BL    TwoIntegers
       AND   R2, R2, R4
       B     DispatchReturn

OR_Code      ROUT  ; integer OR integer
       BL    TwoIntegers
       ORR   R2, R2, R4
       B     DispatchReturn

EOR_Code     ROUT  ; integer EOR integer
       BL    TwoIntegers
       EOR   R2, R2, R4
       B     DispatchReturn

;----------------------------------------------------------------------------
; mixed operands

Right_Code  ROUT  ; string RIGHT integer
       CMP    R0, #type_Integer
       BLNE   StringToInteger
       MOV    R4, R2
       ePull "R0, R2"
       CMP    R0, #type_String
       BNE    %FT01
       BL     Pull_String
02   ; string in stracc, R2 chars available, R4 chars wanted.
       CMP    R2, R4
       BLO    DispatchReturn ; ignore if R4 -ve or bigger than available
       LDR    R0, =exprSTRACC
       ADD    R3, R0, R2
       SUB    R3, R3, R4  ; mov from R3 to R0, R4 bytes
03     LDRB   R2, [R3], #1
       SUBS   R4, R4, #1
       STRGEB R2, [R0], #1
       BGE    %BT03
       LDR    R2, =exprSTRACC
       SUB    R2, R0, R2  ; get length back.
       MOV    R0, #type_String
       B      DispatchReturn

01     CMP    R0, #type_Operator
       BEQ    MissingOpErr
       BL     IntegerToString
       B      %BT02

Left_Code     ROUT  ; string LEFT integer
       CMP    R0, #type_Integer
       BLNE   StringToInteger
       MOV    R4, R2
       ePull "R0, R2"
       CMP    R0, #type_String
       BNE    %FT01
       BL     Pull_String
02     CMP    R4, R2
       MOVLO  R2, R4    ; only use new length if +ve and < current length
       B      DispatchReturn

01     CMP    R0, #type_Operator
       BEQ    MissingOpErr
       BL     IntegerToString
       B      %BT02

;-----------------------------------------------------------------------
; relational operators

EQ_Code      ROUT  ; integer = integer ; string = string
       BL    Comparison
       MOVEQ R2, #Expr_True
       MOVNE R2, #Expr_False
       B     DispatchReturn

NE_Code      ROUT  ; integer<>integer ; string<>string
       BL    Comparison
       MOVNE R2, #Expr_True
       MOVEQ R2, #Expr_False
       B     DispatchReturn

GT_Code      ROUT  ; integer > integer ; string>string
       BL    Comparison
       MOVGT R2, #Expr_True
       MOVLE R2, #Expr_False
       B     DispatchReturn

LT_Code      ROUT  ; integer < integer ; string<string
       BL    Comparison
       MOVLT R2, #Expr_True
       MOVGE R2, #Expr_False
       B     DispatchReturn

GE_Code      ROUT  ; integer >= integer ; string>=string
       BL    Comparison
       MOVGE R2, #Expr_True
       MOVLT R2, #Expr_False
       B     DispatchReturn

LE_Code      ROUT  ; integer <= integer ; string<=string
       BL    Comparison
       MOVLE R2, #Expr_True
       MOVGT R2, #Expr_False
       B     DispatchReturn

;--------------------------------------------------------------------------
; shift operators

RShift_Code  ROUT  ; integer >> integer
       BL    TwoIntegers
       CMP   R2, #0
       RSBLT R2, R2, #0
       BLT   NegRShift
NegLShift
       CMP   R2, #32
       MOVGE R2, R4, ASR #31  ; sign extend all through
       MOVLT R2, R4, ASR R2
       B     DispatchReturn

LRShift_Code  ROUT  ; integer >>> integer
       BL    TwoIntegers
       CMP   R2, #0
       RSBLT R2, R2, #0
       BLT   NegRShift
       CMP   R2, #32
       MOVGE R2, #0
       MOVLT R2, R4, LSR R2
       B     DispatchReturn

LShift_Code  ROUT  ; integer << integer
       BL    TwoIntegers
       CMP   R2, #0
       RSBLT R2, R2, #0
       BLT   NegLShift
NegRShift
       CMP   R2, #32
       MOVGE R2, #0
       MOVLT R2, R4, LSL R2
       B     DispatchReturn

;---------------------------------------------------------------------------
; Support routines :

TwoIntegers   ROUT
      Push   "lr"
      CMP     R0, #type_String
      BLEQ    StringToInteger
      ePull  "R3, R4"
      CMP     R3, #type_Operator
      BEQ     MissingOpErr
      CMP     R3, #type_String
      BLEQ    PullStringToInteger
      Pull   "PC"

Comparison    ROUT
     Push    "lr"
     ePull   "R3, R4"
     CMP      R3, #type_Operator
     BEQ      MissingOpErr
     CMP      R0, #type_String
     BEQ      %FT01
     CMP      R3, #type_String
     BLEQ     PullStringToInteger
     CMP      R4, R2
     Pull    "PC"

01   CMP      R3, #type_String
     BEQ      %FT02
     BL       StringToInteger
     CMP      R4, R2
     Pull    "PC"

02   MOV      R3, R11
     ADD      R11, R11, R4
     ADD      R11, R11, #3
     BIC      R11, R11, #3
;    $R3, length R4 against $exprSTRACC, length R2
     Push    "R1, R2, R4, R5"
     CMP      R2, R4
     MOVGT    R2, R4   ; minm length -> R2
     LDR      R0, =exprSTRACC
03   SUBS     R2, R2, #1
     BLT      %FT04
     LDRB     R1, [R0], #1
     LDRB     R5, [R3], #1
     CMP      R5, R1
     BEQ      %BT03
     MOV      R0, #type_Integer
     Pull    "R1, R2, R4, R5, PC"

04
     Pull    "R1, R2, R4, R5"
     CMP      R4, R2
     MOV      R0, #type_Integer
     Pull    "PC"

StringToInteger ROUT
    Push       "R1, R3, R4, lr"
    LDR         R1, =exprSTRACC
    ADD         R3, R1, R2     ; end pointer to check all string used.
    MOV         R0, #13
    STRB        R0, [R1, R2]   ; force terminator in
01  LDRB        R0, [R1], #1
    CMP         R0, #" "
    BEQ         %BT01
    MOV         R4, #0
    CMP         R0, #"-"
    MOVEQ       R4, #-1
    CMPNE       R0, #"+"
    SUBNE       R1, R1, #1
    MOV         R0, #10
    SWI         XOS_ReadUnsigned
02  LDRB        R0, [R1], #1
    CMP         R0, #" "
    BEQ         %BT02
    SUB         R1, R1, #1
    CMP         R1, R3
    BNE         BadIntegerErr
    MOV         R0, #type_Integer
    CMP         R4, #0
    RSBNE       R2, R2, #0
    Pull       "R1, R3, R4, PC"

IntegerToString ROUT
       Push    "R1, lr"
       MOV      R0, R2
       LDR      R1, =exprSTRACC
       MOV      R2, #255
       SWI      XOS_BinaryToDecimal
       MOV      R0, #type_String
       Pull    "R1, PC"

PullStringToInteger ROUT     ; corrupts exprSTRACC
    Push       "R0, R2, lr"
    MOV         R2, R4
    BL          Pull_String
    BL          StringToInteger
    MOV         R4, R2
    MOV         R3, #type_Integer
    Pull       "R0, R2, PC"

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

GetFactor ROUT
; return type in R0
; if operator, R2 has op_xxx
; if integer/string, it has been pushed
; R1 updated, R2 corrupted.

10    LDRB   R0, [R1], #1
      CMP    R0, #" "
      BEQ    %BT10

      CMP    R0, #13
      BNE    %FT11
      MOV    R2, #op_Bottom
      MOV    R0, #type_Operator
      MOV    PC, lr

31    CMP   R0, #"@"-1       ; chars >= "@" are OK
      BGT   %FT32
      CMP   R0, #" "         ; chars <= " " always terminate
      MOVLE PC, lr
      Push "R2, R3"
      ADR   R2, terminatename_map-"!"
      LDRB  R3, [R2, R0]      ; termination map for " " < char < "@"
      CMP   R3, #0
      Pull "R2, R3"
      MOVEQ PC, lr
32    STRB  R0, [R3], #1
      MOV   PC, lr       ; return with GT for OK, LE for naff

terminatename_map       ; 1 means character allowed
;     ! " # $ % & ' ( ) * + , - . / 0 1 2 3 4 5 6 7 8 9 : ; < = > ?
   =  1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1
      ALIGN

11    CMP    R0, #"&"        ; hex number?
      CMPNE  R0, #"0"
      RSBGTS R2, R0, #"9"
      BGE    %FT03          ; got to get a number.

      CMP    R0, #""""
      BEQ    %FT04          ; string.

  ; look for operator
      Push  "R3"
      ADR    R2, operator_table
20    LDRB   R3, [R2], #1
      CMP    R3, #0       ; end of table?
      BEQ    %FT30
      CMP    R0, R3
      BEQ    %FT21
22    LDRB   R3, [R2], #1
      CMP    R3, #0
      BNE    %BT22
      ADD    R2, R2, #1   ; skip op_xxx
      B      %BT20
21
      Push  "R1"
24    LDRB   R3, [R2], #1
      CMP    R3, #0
      BEQ    %FT23
      LDRB   R0, [R1], #1
      CMP    R0, R3
      BEQ    %BT24
      Pull  "R1"
      LDRB   R0, [R1, #-1]
      B      %BT22
23
      Pull  "R3"    ; junk R1
      Pull  "R3"
      LDRB   R2, [R2]
      MOV    R0, #type_Operator
      MOV    PC, lr     ; got an operator.

30    LDR    R3, =exprSTRACC
 ; assume variable name : try and read it.
      Push  "lr"
      BL     %BT31   ; check R0 for allowed in name, insert.
      BLE    NaffItemErr
33    LDRB   R0, [R1], #1
      BL     %BT31
      BGT    %BT33
      SUB    R1, R1, #1
      MOV    R0, #13
      STRB   R0, [R3], #1
 ; potential name in exprSTRACC
      Push  "R1, R4"
      LDR    R0, =exprSTRACC
      MOV    R2, #-1         ; just test for existence first
      MOV    R3, #0
      MOV    R4, #0          ; no expansion
      SWI    XOS_ReadVarVal
      CMP    R2, #0
      BEQ    NaffItemErr
      LDR    R1, =exprSTRACC ; overwrite name with value
      MOV    R0, R1          ; overwritten by VSet return 
      MOV    R2, #255
      MOV    R3, #0
      CMP    R4, #VarType_Macro
      MOVEQ  R4, #VarType_Expanded
      SWI    XOS_ReadVarVal
      BVS    StrOFloErr
      CMP    R4, #VarType_Number
      LDREQ  R2, [R1]
      MOVEQ  R0, #type_Integer
      BLNE   Push_String
      MOVNE  R0, #type_String
      ePush "R0, R2"
      Pull  "R1, R4, lr"
      Pull  "R3"
      MOV    PC, lr

operator_table
      =  "("    , 0, op_Bra
      =  ")"    , 0, op_Ket
      =  "+"    , 0, op_Plus
      =  "-"    , 0, op_Minus
      =  "*"    , 0, op_Times
      =  "/"    , 0, op_Divide
      =  "="    , 0, op_EQ
      =  "<>"   , 0, op_NE
      =  "<="   , 0, op_LE
      =  "<<"   , 0, op_LShift
      =  "<"    , 0, op_LT
      =  ">="   , 0, op_GE
      =  ">>>"  , 0, op_LRShift
      =  ">>"   , 0, op_RShift
      =  ">"    , 0, op_GT
      =  "AND"  , 0, op_AND
      =  "OR"   , 0, op_OR
      =  "EOR"  , 0, op_EOR
      =  "NOT"  , 0, op_NOT
      =  "RIGHT", 0, op_Right
      =  "LEFT" , 0, op_Left
      =  "MOD"  , 0, op_MOD
      =  "STR"  , 0, op_STR
      =  "VAL"  , 0, op_VAL
      =  "LEN"  , 0, op_LEN
      =  0
      ALIGN

03    SUB    R1, R1, #1    ; point at string start
      Push  "lr"
      MOV    R0, #10
      SWI    XOS_ReadUnsigned
      BVS    BumNumber
      MOV    R0, #type_Integer
      ePush "R0, R2"
      Pull  "PC"

ExprErrCommon
BumNumber
      LDR   R13, ExprSVCstack
      STR   R0, [stack]
      Pull "R0-R4, lr"
      MOV   R1, #0        ; haven't put anything in buffer
      B     SLVK_SetV
BadStringErr
      ADRL  R0, ErrorBlock_BadString
      B     ExprErrCommon
Bra_Code
BadBraErr
      ADR   R0, ErrorBlock_BadBra
      B     ExprErrCommon
      MakeErrorBlock BadBra
StackOFloErr
      ADR   R0, ErrorBlock_StkOFlo
      B     ExprErrCommon
      MakeErrorBlock StkOFlo
MissingOpErr
      ADR   R0, ErrorBlock_MissOpn
      B     ExprErrCommon
      MakeErrorBlock MissOpn
MissingOrErr
      ADR   R0, ErrorBlock_MissOpr
      B     ExprErrCommon
      MakeErrorBlock MissOpr
BadIntegerErr
      ADR   R0, ErrorBlock_BadInt
      B     ExprErrCommon
      MakeErrorBlock BadInt
StrOFloErr
      ADR   R0, ErrorBlock_StrOFlo
      B     ExprErrCommon
      MakeErrorBlock StrOFlo
NaffItemErr
      ADR   R0, ErrorBlock_NaffItm
      B     ExprErrCommon
      MakeErrorBlock NaffItm
DivZeroErr
      ADR   R0, ErrorBlock_DivZero
      B     ExprErrCommon
      MakeErrorBlock DivZero

04    LDR    R2, =exprSTRACC
05    LDRB   R0, [R1], #1
      CMP    R0, #13
      CMPNE  R0, #10
      CMPNE  R0, #0
      BEQ    BadStringErr
      CMP    R0, #""""
      BEQ    %FT06
07    STRB   R0, [R2], #1  ; can't overflow - comes from buffer
      B      %BT05

06    LDRB   R0, [R1], #1
      CMP    R0, #""""
      BEQ    %BT07
      SUB    R1, R1, #1
      LDR    R0, =exprSTRACC
      SUB    R2, R2, R0    ; length to R2
      Push  "lr"
      BL     Push_String
      ePush "R0, R2"
      Pull  "PC"

Push_String  ROUT
      Push  "R2, R3"
      SUBS   R2, R2, #1
      BMI    %FT02
      BIC    R2, R2, #3
      LDR    R0, =exprSTRACC
01    LDR    R3, [R0, R2]
      ePush "R3"
      SUBS   R2, R2, #4
      BGE    %BT01
02
      Pull  "R2, R3"
      MOV    R0, #type_String
      MOV    PC, lr

Pull_String ROUT
      CMP    R2, #0
      MOVEQ  PC, lr
      Push  "R0, R2, R3"
      LDR    R0, =exprSTRACC
01
      ePull "R3"
      STR    R3, [R0], #4
      SUBS   R2, R2, #4
      BGT    %BT01
      Pull  "R0, R2, R3"
      MOV    PC, lr

      LTORG

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

; Configure and Status

; The configuration table : some types and macros first.

ConType_NoParm  * 1
ConType_Field   * 2
ConType_Special * 3
ConType_Size    * 4

; Type Special has another table :
; code to set it
; code to show it
; string to print for Configure listing.
; Keep table position as offset from table entry

     MACRO
     Config_Special   $name
     =       ConType_Special, "$name", 0
     ALIGN
     &       Config_$name._table - .
     MEND

; Table offset :
Config_Special_SetCode  * 0
Config_Special_ShowCode * 4
Config_Special_String   * 8

; Type NoParm  : *con. name
; put $value into bits $bitoff to $bitoff+$fwidth in byte $byteoff

     MACRO
     Config_NoParm   $name, $bitoff, $fwidth, $bytoff, $value
     =       ConType_NoParm, "$name", 0
     ALIGN
     =       $bitoff, $fwidth, $bytoff, $value
     MEND

; Type Field   : *con. name number
; read value & put into bits $bitoff to $bitoff+$fwidth in byte $byteoff

     MACRO                                       
     Config_Field   $name, $bitoff, $fwidth, $bytoff
     =       ConType_Field, "$name", 0
     ALIGN
     =       $bitoff, $fwidth, $bytoff, 0
     MEND

; Type Size   : *con. name number|nK
; read value & put into bits $bitoff to $bitoff+$fwidth in byte $byteoff

     MACRO                                       
$l   Config_Size   $name, $bitoff, $fwidth, $bytoff
     =       ConType_Size, "$name", 0
     ALIGN
$l   =       $bitoff, $fwidth, $bytoff, 0
     MEND

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; now the table

Config_Table
      Config_Special   Baud
AlternateBoot
      Config_NoParm    Boot,        4, 0, DBTBCMOS, 1
AlternateNoBoot
      Config_NoParm    NoBoot,      4, 0, DBTBCMOS, 0
AlternateCaps
      Config_NoParm    Caps,        3, 2, StartCMOS, 4
AlternateNoCaps
      Config_NoParm    NoCaps,      3, 2, StartCMOS, 2
ExpandShCaps
      Config_NoParm    ShCaps,      3, 2, StartCMOS, 1
EndListCapsFrig
      Config_Field     Data,        5, 2, DBTBCMOS
      Config_Field     Delay,       0, 7, KeyDelCMOS
ExpandDir
      Config_NoParm    Dir,         6, 0, StartCMOS, 0
ExpandNoDir
      Config_NoParm    NoDir,       6, 0, StartCMOS, 1
      Config_Field     DumpFormat,  0, 4, TutuCMOS
fsf   Config_Size      FontSize,    0, 7, FontCMOS
      Config_Special   Ignore
      Config_Field     Language,    0, 7, LanguageCMOS
AlternateLoud
      Config_NoParm    Loud,        1, 0, DBTBCMOS, 1
      Config_Special   Mode
      Config_Field     MonitorType, 2, 3, VduCMOS
      Config_Special   MouseStep
      Config_Field     Print,       5, 2, PSITCMOS
AlternateQuiet
      Config_NoParm    Quiet,       1, 0, DBTBCMOS, 0
      Config_Size      RamFsSize,   0, 6, RAMDiscCMOS
      Config_Field     Repeat,      0, 7, KeyRepCMOS
      Config_Size      RMASize,     0, 6, RMASizeCMOS
      Config_Size      ScreenSize,  0, 6, ScreenSizeCMOS
ScreenSizeFrig
AlternateScroll
      Config_NoParm    Scroll,      3, 0, DBTBCMOS, 0
AlternateNoScroll
      Config_NoParm    NoScroll,    3, 0, DBTBCMOS, 1
      Config_Size      SpriteSize,  0, 6, SpriteSizeCMOS
      Config_Field     Sync,        0, 0, VduCMOS         ; an Arfur one
      Config_Size      SystemSize,  0, 5, SysHeapCMOS
      Config_Special   TV
      =  0

NoDirString =  "No"
DirString   =  "Directory", 0
ShCapsString = "ShiftCaps", 0

      ALIGN

ExpandFrig * 8    ; see code that shows NoParm options.
ExpandTab
      &  ExpandDir    - ExpandFrig-.
      &  DirString    - .-1          ; another printing fudge!
      &  ExpandNoDir  - ExpandFrig-.
      &  NoDirString  - .-1
      &  ExpandShCaps - ExpandFrig-.
      &  ShCapsString - .-1
      &  0

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

      MACRO
      Config_Special_Table $name, $text
Config_$name._table
      B     Config_$name._setcode
      B     Config_$name._showcode
      =    "$text", 0
      ALIGN
      MEND

      ALIGN
      Config_Special_Table Baud, "<D>"
      Config_Special_Table TV, "[<D> [[,] <D>]]"
      Config_Special_Table Mode, "<D>"
      Config_Special_Table Ignore, "[<D>]"
      Config_Special_Table MouseStep, "<D>"

;*****************************************************************************
; Lookup : R0 -> option
;   Exit : R2 -> table entry, EQ for not found
;          R0 stepped on

FindOption   ROUT
       Push "R1, R3-R5, lr"
       ADRL  R2, Config_Table+1
04     MOV   R1, #0                         ; offset
01     LDRB  R3, [R0, R1]
       LDRB  R4, [R2, R1]
       CMP   R3, #32
       CMPLE R4, #32
       BLE   %FT02
       UpperCase R3, R5
       UpperCase R4, R5
       CMP   R3, R4
       ADDEQ R1, R1, #1
       BEQ   %BT01
       CMP   R3, #"."
       MOV   R3, #Z_bit
       TEQP  R3, pc                        ; invert EQ/NE
       CMPNE R1, #0
       ADDNE R1, R1, #1                     ; skip .
       BNE   %FT02
03     LDRB  R1, [R2], #1
       CMP   R1, #0
       BNE   %BT03
       ADD   R2, R2, #7                     ; skip infoword
       BIC   R2, R2, #3
       LDRB  R1, [R2], #1
       CMP   R1, #0
       BNE   %BT04
       Pull "R1, R3-R5, PC"                 ; failure exit

02     ADD   R0, R0, R1                     ; point at char after option
       SUBS  R2, R2, #1
       Pull "R1, R3-R5, PC"                 ; return with success

;****************************************************************************
;          
; Configure
; IF noparms OR parm=. THEN list options : issue service call : finish listing
;                      ELSE lookup parm1 : doit
;    IF notfound THEN issue service

Configure_Help ROUT
         Push  "R0, lr"
         ADR    R0, %FT01
         MOV    R1, #Status_Keyword_Flag
         B      KeyHelpCommon
01
         = "*Configure <item> [<parameter>] sets the CMOS RAM options.", 13
         = "*Status displays the current options.", 13
         = "Items implemented in modules are:", 0
         ALIGN

Configure_Code   ROUT
         Push   "lr"
         CMP     R1, #0       ; noparms?
;         LDRNEB  R1, [R0]
;         CMPNE   R1, #"."     ; or . ?
         MOVEQ   R3, #0
         BEQ     ListAll     ; go listem.
         BL      FindOption
         BEQ     %FT01
         LDRB    R4, [R2], #1
03       LDRB    R1, [R2], #1
         CMP     R1, #0
         BNE     %BT03
         ADD     R2, R2, #3
         BIC     R2, R2, #3
         LDR     R1, [R2]
         CMP     R4, #ConType_Size
         BEQ     ReadSizeParm

         CMP     R4, #ConType_Field
       ASSERT ConType_Special > ConType_Field
; if special dispatch it
         ADDGT   R1, R1, R2                      ; point at node
         ADDGT   PC, R1, #Config_Special_SetCode  ; call it
; if noparm get value
         MOVLT   R2, R1, LSR #24
         BLEQ    ReadNumParm
         BVS     BadConParm
BaudEntry
         BL      ConfigCheckEOL
         Pull   "PC", VS
IgnoreEntry
         MOV     R0, R1                      ; info word

         BL      ReadByte                  ; current byte into R1

         MOV     R3, R0, LSR #8
         AND     R3, R3, #&FF      ; get fwidth
         MOV     R4, #2
         MOV     R4, R4, LSL R3
         SUB     R4, R4, #1        ; get mask/maximum value
         CMP     R2, R4
         BHI     ConParmTooBig

         AND     R3, R0, #&FF      ; get bitoff
         MOV     R2, R2, LSL R3    ; move into position
         MOV     R4, R4, LSL R3    ; and the mask!

         BIC     R1, R1, R4        ; clear bits
         ORR     R2, R1, R2        ; new byte

         MOV     R1, R0, LSR #16   ; get bytoff
         AND     R1, R1, #&FF
         MOV     R0, #162
         SWI     XOS_Byte            ; and set it. Assume this clears V!

         Pull   "PC"

BadConParm
         MOV     R0, #1
         B       ConfigGenErr
BadConParmError
         &       ErrorNumber_Syntax
         =      "Numeric parameter needed", 0
         ALIGN

ConParmTooBig
         MOV     R0, #2
         B       ConfigGenErr
ConParmTooBigError
         &       ErrorNumber_Syntax
         =      "Configure parameter too big", 0
         ALIGN
01
         MOV     R12, #Module_List
conoptloop
         LDR     R12, [R12]
         CMP     R12, #0
         BEQ     conoptservice
         LDR     R1, [R12, #Module_code_pointer]
         LDR     R2, [R1, #Module_HC_Table]
         CMP     R2, #0
         BEQ     conoptloop
         MOV     R4, #Status_Keyword_Flag
         BL      FindItem
         BCC     conoptloop            ; next module
         ADD     R0, R0, R3            ; point at commtail
         LDR     R12, [R12, #Module_incarnation_list] ; preferred life
         ADDS    R12, R12, #Incarnation_Workspace      ; clear V
         Push   "R1-R6"

StKey_SkipSpaces
         LDRB    R4, [R0], #1
         CMP     R4, #" "
         BEQ     StKey_SkipSpaces
         SUB     R0, R0, #1

         MOV     lr, PC
         ADD     PC, R1, R5            ; call im
         Pull   "R1-R6"
         Pull   "PC", VC
ConfigGenErr
         CMP     R0, #3
         BHI     ExitConfig
         ADREQL  R0, Config2manyparms
         CMP     R0, #2
         ADREQ   R0, ConParmTooBigError
         CMP     R0, #1
         ADRLO   R0, BadConOptError
         ADREQ   R0, BadConParmError
ExitConfig
         Pull   "lr"
         ORRS    PC, lr, #V_bit

conoptservice
         MOV     R1, #Service_UKConfig
         BL      Issue_Service
         CMP     R1, #0
         BNE     BadConOpt
         CMP     R0, #0
         BGE     ConfigGenErr
         Pull   "PC"              ; TBS means OK: note CMP has cleared V

BadConOpt
         MOV     R0, #0
         B       ConfigGenErr
BadConOptError
         &       ErrorNumber_Syntax
         =      "Bad configure option", 0
         ALIGN

ReadNumParm
         LDRB    R2, [R0], #1
         CMP     R2, #" "
         BEQ     ReadNumParm
         Push   "R1, lr"
         SUB     R1, R0, #1
         SWI     XOS_ReadUnsigned
         Pull   "R1, PC", VS
         MOV     R0, R1
         LDRB    R1, [R0]
         CMP     R1, #" "
         SETV    GT
         Pull   "R1, PC"

ReadSizeParm     ROUT
         Push   "R1, R8"
         MOV     R8, R2
02       LDRB    R2, [R0], #1
         CMP     R2, #" "
         BEQ     %BT02
         SUB     R1, R0, #1
         SWI     XOS_ReadUnsigned
         Pull   "R1, R8", VS
         BVS     BadConParm
         MOV     R0, R1
         LDRB    R1, [R0]
         CMP     R1, #" "
         BLE     %FT01
         CMP     R1, #"k"
         CMPNE   R1, #"K"
         Pull   "R1, R8", NE
         BNE     BadConParm
         ADRL    R0, fsf
         CMP     R8, R0
         MOVNE   R8, #0
         LDRNE   R8, [R8, #Page_Size]
         MOVEQ   R8, #4*1024            ; lucky it's a pagesize!
         ADRL    R0, PageShifts-1
         LDRB    R0, [R0, R8, LSR #12]
         SUB     R0, R0, #10            ; *1024
         MOV     R8, R8, LSR #10        ; /1024
         SUB     R8, R8, #1
         ADD     R2, R2, R8
         BIC     R2, R2, R8             ; round up to nearest pagesize
         MOV     R2, R2, LSR R0         ; divide parm by pagesize
01
         Pull   "R1, R8"
         B       BaudEntry

;*****************************************************************************
; Status
; list all options matched : allow . and <terminator> to match all
; issue service

Status_Code      ROUT
         Push   "lr"
         CMP     R1, #0       ; noparms?
;         LDRNEB  R1, [R0]
;         CMPNE   R1, #"."     ; or . ?
         MOVEQ   R3, #1
         BEQ     ListAll     ; go listemall
         CMP     R1, #1
         BNE     %FT01
         BL      FindOption
         BEQ     %FT01
         MOV     R3, #2
         BL      ListOneConfig
         Pull   "PC"

01       MOV     R6, #Module_List
statoptloop
         LDR     R6, [R6]
         CMP     R6, #0
         BEQ     statoptservice
         LDR     R1, [R6, #Module_code_pointer]
         LDR     R2, [R1, #Module_HC_Table]
         CMP     R2, #0
         BEQ     statoptloop
         MOV     R4, #Status_Keyword_Flag
         BL      FindItem
         BCC     statoptloop          ; next module
         MOV     R0, #1
         LDR     R12, [R6, #Module_incarnation_list]
         ADD     R12, R12, #Incarnation_Workspace
         Push   "R0-R6"
         MOV     lr, PC
         ADD     PC, R1, R5            ; call im
         Pull   "R0-R6, PC"

statoptservice
         MOV     R1, #Service_UKStatus
         BL      Issue_Service
         CMP     R1, #0
         Pull   "PC", EQ
         ADR     R0, %FT03
         Pull   "lr"
         ORRS    PC, lr, #V_bit
03
         &       ErrorNumber_Syntax
         =      "Bad status option", 0
         ALIGN

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

; routine to list everything : on entry R3 = 0 means entered from configure
;                                          = 1   "     "      "   status
;                                       lr stacked for return

ListAll  ROUT

         MOV     R0,#117               ; Read current VDU status
         SWI     XOS_Byte              ; Won't fail
         Push   "R1"

         SWI     XOS_WriteS
         =       14, "Configuration ", 0 ; paged mode on.
         ALIGN
         Pull   "r1, pc", VS            ; Wrch can fail
         CMP     R3, #0
         ADREQ   R0, %FT06
         ADRNE   R0, %FT08
         SWI     XOS_Write0
         Pull   "r1, pc", VS

         ADRL    R2, Config_Table
02       ADRL    R4, AlternateCaps
         CMP     R4, R2
         CMPEQ   R3, #1
         BEQ     FrigCapsList
         LDRB    R4, [R2]
         CMP     R4, #0
         BLNE    ListOneConfig
         Pull   "r1, pc", VS
         BNE     %BT02

10       ADRL    R0, dotstring       ; match all
         Push   "R3, R7"
         MOV     R7, #Module_List
listallmloop
         LDR     R7, [R7]
         CMP     R7, #0
         BEQ     listallservice
         LDR     R1, [R7, #Module_code_pointer]
         LDR     R2, [R1, #Module_HC_Table]
         CMP     R2, #0
         BEQ     listallmloop
listalltryfind
         MOV     R4, #Status_Keyword_Flag
         BL      FindItem
         BCC     listallmloop        ; next module
         LDR     R0, [stack]          ; pick up R3
         LDR     R12, [R7, #Module_incarnation_list]
         ADD     R12, R12, #Incarnation_Workspace
         Push   "R0-R6"
         MOV     lr, PC
         ADD     PC, R1, R5            ; call im
         Pull   "R0-R6"
         ADD     R2, R2, #16           ; step to next field
         ADRL    R0, dotstring
         B       listalltryfind
06
         =      "options:", 10,13, 10,0
08
         =      "status:", 10,13, 10,0
         ALIGN

listallservice
         Pull   "R3, R7"
         CMP     R3, #0
         MOVEQ   R1, #Service_UKConfig
         MOVNE   R1, #Service_UKStatus
         MOV     R0, #0               ; indicate list wanted
         BL      Issue_Service
         CMP     R3, #0
         ADRNE   R0, statuslastline
         ADREQ   R0, configlastline
         SWI     XOS_Write0
         Pull   "R1"
         Pull   "PC", VS        ; return error if set
         TST     R1,#5
         SWIEQ   XOS_WriteI+15  ; paged mode off
         Pull   "PC"

statuslastline
         =       10,13, "Use *Configure to set the options.", 10,13,0
configlastline
         =       10,13, "Where:", 10,13
         =       "D is a decimal number, " ;, 10,13
         =       "a hexadecimal number preceded by &, ", 10,13
         =       "or the base followed by underscore, followed", 10,13
         =       "by digits in the given base.", 10,13
         =       "Items within [ ] are optional.", 10,13
         =       "Use *Status to display the current settings.", 10,13, 0
         ALIGN

FrigCapsList
         MOV     R3, #2
         BL      ListOneConfig
         Pull   "R1, PC", VS
         MOV     R3, #1
         ADRL    R2, EndListCapsFrig
         B       %BT02

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

; routine to list one item :
; R3 = 0 means entered from configure
;    = 1   "     "      "   status
;    = 2   "     "      "   status <item>
; R2 points at the item, stepped to next on exit
; Preserves flags

ListOneConfig    ROUT
         Push   "lr"
         LDRB    R4, [R2]
         CMP     R4, #ConType_Field
         CMPNE   R4, #ConType_Size
         CMPNE   R3, #0
         BNE     %FT20

         ADD     R0, R2, #1
         SWI     XOS_Write0
         BVS     ExitShow
         SUB     R1, R0, R2     ; get length
         ADD     R2, R0, #3     ; skip terminator
         BIC     R2, R2, #3     ; and align

         CMP     R4, #ConType_NoParm
         BEQ     %FT07
04       SWI     XOS_WriteI+" "
         BVS     ExitShow
         ADD     R1, R1, #1
         CMP     R1, #12
         BLS     %BT04

         CMP     R3, #0
         BNE     %FT30

         CMP     R4, #ConType_Size
         ADREQ   R0, %FT42
         BEQ     %FT43

         CMP     R4, #ConType_Field
       ASSERT ConType_Special > ConType_Field
         ADREQ   R0, %FT05
         LDRGT   R0, [R2]
         ADDGT   R0, R0, R2                      ; point at node
         ADDGT   R0, R0, #Config_Special_String  ; point at string
43       SWI     XOS_Write0
07       ADD     R2, R2, #4
ExitShow SWIVC   XOS_NewLine
11
         Pull   "lr"
         BICVCS  PC, lr, #V_bit
         ORRS    PC, lr, #V_bit
05
         =      "<D>", 0
42
         =      "<D>[K]", 0
; status bits :

20       ADD     R0, R2, #1        ; got to do *status on a NoParm or Special
21       LDRB    R1, [R0], #1
         CMP     R1, #0           ; step past name
         BNE     %BT21
         ADD     R0, R0, #3
         BIC     R0, R0, #3        ; align
         LDR     R1, [R0]         ; get info word.
         CMP     R4, #ConType_Special
         ADDEQ   R1, R1, R0        ; point at node
         ADDEQ   PC, R1, #Config_Special_ShowCode

; if CRbytevalue = infowordvalue then print something

         MOV     R4, R0           ; hang on to it
         MOV     R0, R1
         BL      GetValue
         MOV     R1, R1, LSR #24   ; value.
         CMP     R0, R1
         BNE     %FT10           ; check for *Status <Item>
; first see if expansion needed
         ADRL    R0, ExpandTab
22       LDR     R1, [R0], #8
         CMP     R1, #0
         BEQ     %FT23
         ADD     R1, R1, R0        ; get real address
         CMP     R1, R2
         BNE     %BT22
         LDR     R2, [R0, #-4]!
14       ADD     R2, R2, R0        ; new string
23       ADD     R2, R2, #1
; now write chars with space between lowercase then upper
         MOV     R1, #1           ; indicate uppercase last
24       LDRB    R0, [R2], #1
         CMP     R0, #0
         BEQ     %FT25
         CMP     R0, #"Z"         ; uppercase if LE
         CMPLE   R1, #0
         SWILE   XOS_WriteI+" "
         BVS     ExitShow
         CMP     R0, #"Z"
         MOVLE   R1, #1
         MOVGT   R1, #0
         SWI     XOS_WriteC
         BVC     %BT24

25       ADDVC   R2, R4, #4
         B       ExitShow

30       LDR     R0, [R2], #4       ; got to do *status for Field
         CMP     R4, #ConType_Size
         MOV     R4, R2
         BL      GetValue
         BEQ     %FT31
         BL      PrintR0
         B       ExitShow
31
         Push   "R8, R9"
         ADRL    R8, fsf+4
         CMP     R4, R8
         MOVNE   R8, #0
         LDRNE   R8, [R8, #Page_Size]
         MOVEQ   R8, #4*1024
         ADRL    R9, PageShifts-1
         LDRB    R9, [R9, R8, LSR #12]
         SUB     R9, R9, #10
         MOV     R0, R0, LSL R9    ; size in K
         CMP     r0, #0
         ADREQL  r8, ScreenSizeFrig
         CMPEQ   r8, r2
         SWIEQ   XOS_ReadSysInfo           ; proper screen size
         MOVEQ   r0, r0, LSR #10
         Pull   "R8, R9"
         BL      PrintR0
         SWIVC   XOS_WriteI+"K"
         B       ExitShow

10       CMP     R3, #2
         ADDNE   R2, R4, #4
         BNE     %BT11
; R0 is the value set : can corrupt R3 as this is the do-one entry
         MOV     R3, R0
         ADRL    R0, AlternateTab  ; look for option really set
12       LDR     R1, [R0], #8       ; better find a match!
         ADD     R1, R1, R0         ; get real address
         CMP     R1, R2
         BNE     %BT12
         LDR     R2, [R0, #-4]!
         ADD     R2, R2, R0        ; translation table
         LDR     R0, [R2, R3, LSL #2]
         B       %BT14           ; go printit

AlternateTab
      &  AlternateBoot - ExpandFrig-.
      &  %FT91 -.
      &  AlternateNoBoot - ExpandFrig-.
      &  %FT91 -.
      &  AlternateCaps - ExpandFrig-.
      &  %FT92 -.
      &  AlternateNoCaps - ExpandFrig-.
      &  %FT92 -.
      &  ExpandShCaps - ExpandFrig-.
      &  %FT92 -.
      &  ExpandDir - ExpandFrig-.
      &  %FT93 -.
      &  ExpandNoDir - ExpandFrig-.
      &  %FT93 -.
      &  AlternateLoud - ExpandFrig-.
      &  %FT95 -.
      &  AlternateQuiet - ExpandFrig-.
      &  %FT95 -.
      &  AlternateScroll - ExpandFrig-.
      &  %FT96 -.
      &  AlternateNoScroll - ExpandFrig-.
      &  %FT96 -.

91
      &  AlternateNoBoot -%BT91
      &  AlternateBoot   -%BT91
92
      &  ShCapsString    -%BT92-1
      &  ShCapsString    -%BT92-1
      &  AlternateNoCaps -%BT92
      &  AlternateNoCaps -%BT92
      &  AlternateCaps   -%BT92
      &  AlternateCaps   -%BT92
      &  AlternateCaps   -%BT92
      &  AlternateCaps   -%BT92
93
      &  DirString   -%BT93-1
      &  NoDirString -%BT93-1
95
      &  AlternateQuiet -%BT95
      &  AlternateLoud  -%BT95
96
      &  AlternateScroll   -%BT96
      &  AlternateNoScroll -%BT96
        
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

ReadByte ROUT   ; read byte from CMOS RAM : info word in R0, byte -> R1
         Push   "R0, R2, lr"
         MOV     R1, R0, LSR #16   ; get bytoff
         AND     R1, R1, #&FF
         MOV     R0, #161
         SWI     XOS_Byte
         MOV     R1, R2
         Pull   "R0, R2, PC"

GetValue ROUT   ; take infoword in R0, return value in R0
         Push   "R1-R2, lr"
         BL      ReadByte        ; now extract the value
         AND     R2, R0, #&FF      ; get bitoff
         MOV     R1, R1, LSR R2    ; throw away low bits
         MOV     R0, R0, LSR #8
         AND     R0, R0, #&FF      ; get fwidth
         MOV     R2, #2
         MOV     R2, R2, LSL R0
         SUB     R2, R2, #1        ; get mask
         AND     R0, R1, R2
         Pull   "R1-R2, PC",,^


PrintR0 Push    "R1, R2, lr"
        SUB     sp, sp, #32
        MOV     r1, sp
        MOV     r2, #32
        SWI     XOS_ConvertInteger4
        SWIVC   XOS_Write0
        ADD     sp, sp, #32
        Pull   "R1, R2, PC"

NoString =     "No ", 0
         ALIGN

ConfigCheckEOL  ROUT
        LDRB    R3, [R0], #1
        CMP     R3, #" "
        BEQ     ConfigCheckEOL
        CMP     R3, #13
        CMPNE   R3, #10
        CMPNE   R3, #0
        MOVEQ   PC, lr
        Push   "lr"
        ADR     R0, Config2manyparms
        Pull   "PC"
Config2manyparms
        &       ErrorNumber_Syntax
        =      "Too many parameters"

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

IgnoreBitoff *  1

Config_TV_setcode ROUT
         LDRB    R2, [R0], #1
         CMP     R2, #" "
         BEQ     Config_TV_setcode
         SUB     R1, R0, #1
         SWI     XOS_ReadUnsigned
         BVS     %FT01
         CMP     R2, #3
         SUBGT   R0, R2, #252
         CMPGT   R0, #3
         BHI     BadConOpt
         CMP     R2, #3
         ANDGT   R2, R2, #7       ; top bit set in field means 252-255
         Push   "R2"
         MOV     R0, #0
03       LDRB    R2, [R1], #1
         CMP     R2, #" "
         BEQ     %BT03
         CMP     R2, #","
         CMPEQ   R0, #0
         MOVEQ   R0, #","
         BEQ     %BT03
         SUB     R1, R1, #1
         Push   "R0"
         MOV     R0, #10
         SWI     XOS_ReadUnsigned
         Pull   "R0"
         BVC     %FT04
         CMP     R0, #0
         Pull   "R0", NE
         BNE     BadConOpt
04       CMP     R2, #1
         Pull   "R0"
         BHI     ConParmTooBig
         ORR     R2, R2, R0, LSL #1
01       MOV     R0, R1
         LDR     R1, %FT02
         B       BaudEntry
02
        =        4, 3, MODETVCMOS, 0

Config_TV_showcode
        MOV     R4, R0
        SWI     XOS_WriteS
        =      "TV         ", 0
        ALIGN
        MOV     R0, #161
        MOV     R1, #MODETVCMOS
        SWIVC   XOS_Byte
        MOV     R2, R2, LSL #24
        MOVVC   R0, R2, ASR #29  ; get signed TV shift
        ANDVC   R0, R0, #&FF
        BLVC    PrintR0
        SWIVC   XOS_WriteI+","
        MOVVC   R0, R2, LSR #28
        ANDVC   R0, R0, #1       ; interlace bit
        BLVC    PrintR0
        ADD     R2, R4, #4
        B       ExitShow

Config_Ignore_setcode ROUT
         LDRB    R2, [R0], #1
         CMP     R2, #" "
         BEQ     Config_Ignore_setcode
         SUB     R1, R0, #1
         SWI     XOS_ReadUnsigned
         MOV     R0, R1
         Push   "R2"
         ADR     lr, %FT03
         Push    lr         ; return reg for BaudEntry
         MOVVS   R2, #1
         MOVVC   R2, #0      ; if number had clear noignore
         LDR     R1, %FT01
         B       BaudEntry  ; pseudo-BL
03
         Pull   "R2"        ; set to 0 if noignore, but we don't care!
         LDR     R1, %FT02
         B       IgnoreEntry
01
        =       IgnoreBitoff, 0, PSITCMOS, 0
02
        =       0, 7, PigCMOS, 0

Config_Ignore_showcode
        MOV     R4, R0
        MOV     R0, #161
        MOV     R1, #PSITCMOS
        SWI     XOS_Byte
        TST     R2, # 1 :SHL: IgnoreBitoff
        ADRNE   R0, NoString
        SWINE   XOS_Write0
        BVS     ExitShow
        SWI     XOS_WriteS
        =      "Ignore", 0
        ALIGN
        BVS     ExitShow
        ADDNE   R2, R4, #4
        BNE     ExitShow
        MOV     R1, #PigCMOS
        SWI     XOS_Byte
        SWI     XOS_WriteS
        =      "     ", 0
        ALIGN
        MOV     R1, #PigCMOS
        SWIVC   XOS_Byte
        MOVVC   R0, R2
        BLVC    PrintR0
        ADD     R2, R4, #4
        B       ExitShow

Config_Mode_setcode  ROUT
         BL      ReadNumParm
         BVS     BadConParm
         CMP     R2, #maxmode
  ASSERT maxmode < 32
         BHI     ConParmTooBig
         BL      ConfigCheckEOL
         BVS     ExitConfig
         Push   "R2"
         MOV     R2, R2, LSR #4 ; get 16-31 bit
         LDR     R1, %FT02    ; set up info word
         ADR     lr, %FT03
         Push   "lr"
         B       IgnoreEntry
03       LDR     R1, %FT01
         Pull   "R2"
         AND     R2, R2, #15
         B       IgnoreEntry
01
        =     0, 3, MODETVCMOS, 0
02
        =     1, 0, VduCMOS, 0
        ASSERT ModeExtraBit = 2

Config_Mode_showcode
        MOV     R4, R0
        SWI     XOS_WriteS
        =      "Mode       ", 0
        ALIGN
        BLVC    Read_Configd_Mode
        BLVC    PrintR0
        ADD     R2, R4, #4
        B       ExitShow

Read_Configd_Mode
        Push   "lr"
        MOV     R0, #161
        MOV     R1, #MODETVCMOS
        SWI     XOS_Byte
        AND     R0, R2, #15     ; well, it's close enough for now.
        Push   "R0"
        MOV     R0, #161
        MOV     R1, #VduCMOS
        SWI     XOS_Byte
        AND     R2, R2, #ModeExtraBit
        Pull    R0
        ORR     R0, R0, R2, LSL #3
        Pull   "PC"

Config_Baud_setcode  ROUT
        BL    ReadNumParm
        BVS   BadConParm
        CMP   R2, #8
        BGT   ConParmTooBig
        SUBS  R2, R2, #1
        MOVMI R2, #6
        LDR   R1, %FT01    ; set up info OS_Word
        B     BaudEntry
01
        =     2, 2, PSITCMOS, 0

Config_Baud_showcode
        MOV     R4, R0
        SWI     XOS_WriteS
        =      "Baud       ", 0
        ALIGN
        LDRVC   R0, %BT01      ; get infoword
        BLVC    GetValue
        ADDVC   R0, R0, #1
        BLVC    PrintR0
        ADD     R2, R4, #4
        B       ExitShow

Config_MouseStep_setcode ROUT
         LDRB    R2, [R0], #1
         CMP     R2, #" "
         BEQ     Config_MouseStep_setcode
         CMP     R2, #"-"
         Push   "R2"
         SUBNE   R1, R0, #1
         SWI     XOS_ReadUnsigned
         Pull   "R0"
         BVS     BadConParm
         CMP     R0, #"-"
         RSBEQ   R2, R2, #0
         CMP     R2, #0
         BEQ     BadConOpt
         CMP     R2, #-128
         BLT     BadConOpt
         CMP     R2, #127
         BGT     ConParmTooBig
         MOV     R0, R1
         LDR     R1, %FT02
         B       BaudEntry
02
        =        0, 7, MouseStepCMOS, 0

Config_MouseStep_showcode ROUT
        MOV     R4, R0
        SWI     XOS_WriteS
        =      "MouseStep  ", 0
        ALIGN
        MOV     R0, #161
        MOV     R1, #MouseStepCMOS
        SWIVC   XOS_Byte
        BVS     %FT01
        MOVS    R2, R2, LSL #24
        MOVNE   R0, R2, ASR #24  ; get sign extended byte
        MOVEQ   R0, #1
        BL      PrintR0
01      ADD     R2, R4, #4
        B       ExitShow


        LNK     SWINaming
