MoreSWIs

; Copyright 1996 Acorn Computers Ltd
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
;     http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.
;
        TTL     => MoreSWIs

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;  SubstituteArgs
;    in:  R0 -> arglist (space delimited args, terminated by 10,13,0)
;         R1 -> buffer
;         R2 =  bufflen
;         R3 -> string to mangle
;         R4 =  no of chars in $R3
;    out: R2 =  no of chars in buffer

XOS_SubstituteArgs_code
        Push    "r5,lr"
        MOV     r5, #0
        SWI     XOS_SubstituteArgs32
        Pull    "r5,lr"
        B       SLVK_TestV

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;  SubstituteArgs32
;    in:  R0 -> arglist (space delimited args, terminated by 10,13,0)
;         R1 -> buffer
;         R2 =  bufflen
;         R3 -> string to mangle
;         R4 =  no of chars in $R3
;         R5 = flags
;               top bit set => don't append unused part of line
;    out: R2 =  no of chars in buffer

XOS_SubstituteArgs32_code ROUT

      WritePSRc SVC_mode, R12   ; enable IRQs
      NOP
      Push   "R0-R8, lr"
      ADD     R8, R4, R3

; try and get parameter positions.
; Items starting with " can have spaces in

      MOV   R6, #0       ; parameter number
      LDR   R12, =MacExStartPtrs
      LDR   R4, =MacExEndPtrs
35    LDRB  R5, [R0], #1
      CMP   R5, #" "
      BEQ   %BT35
      MOV   R2, #" "
      CMP   R5, #""""
      MOVEQ R2, #""""       ; quoted param
      CMP   r6, #10         ; "rest of line" item?
      MOVEQ r2, #-1         ; terminate on EOL only
      SUB   R0, R0, #1
      STR   R0, [R12, R6, LSL #2]
      CMP   r5, #""""
      ADDEQ R0, R0, #1
36    LDRB  R5, [R0], #1
      BL    suba_chktrm
      CMPNE R5, R2
      BNE   %BT36
      CMP   R5, #""""
      LDREQB R5, [R0]
      CMPEQ R5, #""""   ; check for "" in string
      ADDEQ R0, R0, #1
      BEQ   %BT36
      CMP   R2, #""""
      SUBNE R0, R0, #1
      STR   R0, [R4, R6, LSL #2]
      ADD   R6, R6, #1
      CMP   R6, #11           ; Parameters 0-9 and a "rest" set.
      BNE   %BT35

; Keep track of highest param used, so can tack any unused stuff on end.
; R3 points at string to get chars from
; R12 at start ptrs
; R4 at end ptrs

      MOV    R6, #0          ; count.
      MOV    R7, #0          ; highest param used.
      LDR    R2, [stack, #4*2]
37    BL     suba_getchar
      BEQ    %FT41
      CMP    R5, #"%"
      BEQ    %FT44
38    BL     suba_addchar
      B      %BT37

PCnotparm
      ADD    R5, R5, #"0"
      MOV    R11, R5
      MOV    R5, #"%"
      BL     suba_addchar
      MOV    R5, R11
      B      %BT38

44    BL     suba_getchar
      MOVEQ  R5, #"%"
      BEQ    %FT40
      CMP    R5, #"%"
      BEQ    %BT38
      CMP    R5, #"*"
      BEQ    DoStarParams
      SUBS   R5, R5, #"0"
      BMI    PCnotparm
      CMP    R5, #9
      BGT    PCnotparm

; itsa parameter! Get ptrs from R12, R4
      CMP    R5, R7
      ADDGE  R7, R5, #1
      LDR    R11, [R4, R5, LSL #2]
CopyToR11FromParamR5
      LDR    R10, [R12, R5, LSL #2]  ; start ptr
39    LDRB   R5, [R10], #1
      CMP    R10, R11
      BGT    %BT37
      BL     suba_addchar
      B      %BT39

DoStarParams ; had %* : find limits to copy between
      BL     suba_getchar
      BEQ    PCStarTerminates
      SUBS   R5, R5, #"0"
      BMI    PCStarNoDigit
      CMP    R5, #9
      MOVLE  R7, #11                  ; flag * used
      LDRLE  R11, [R4, #10*4]         ; always to EOL
      BLE    CopyToR11FromParamR5
PCStarNoDigit
      ADD    R5, R5, #"0"
      MOV    R11, R5
      MOV    R5, #"%"
      BL     suba_addchar
      MOV    R5, #"*"
      BL     suba_addchar
      MOV    R5, R11
      B      %BT38

PCStarTerminates
      MOV    R5, #"%"
      BL     suba_addchar
      MOV    R5, #"*"
40    BL     suba_addchar
41    CMP    r7, #11
      LDREQ  r12, [r4, #10*4]        ; no more to copy
      BEQ    %FT42
      LDR    r0, [stack, #4*5]
      CMP    r0, #0
      LDRPL  R12, [R12, R7, LSL #2]  ; ptr to rest of command line : copy
      LDRMI  r12, [r4, #10*4]        ; caller wants no appending.
42    LDRB   R5, [R12], #1
      BL     suba_addchar
      BL     suba_chktrm
      BNE    %BT42

      STR    R6, [stack, #4*2]
      Pull  "R0-R8, lr"
      ExitSWIHandler

suba_addchar
      EntryS
      ADD    R6, R6, #1
      CMP    R6, R2
      STRNEB R5, [R1], #1
      EXITS  NE

      PullEnv

      ADRL   R0, ErrorBlock_BuffOverflow
    [ International
      BL     TranslateError
    ]
      STR    R0, [stack]
      Pull  "R0-R8, lr"
      B     SLVK_SetV

suba_getchar
      CMP    R3, R8
      LDRNEB R5, [R3], #1
      MOV    PC, lr

suba_chktrm
      CMP   R5, #13
      CMPNE R5, #10
      CMPNE R5, #0
      MOV   PC, lr

      LTORG

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Take R0 as pointer to null-terminated string, print it
; with line breaks before words that won't fit on the current line.
; CR forces a newline. TAB=tab to next column of 8. CHR$31 = hard space
; <27,n> => substitute nth dictionary entry:
;  dictionary is pointed at by r1, consists of a list of null-terminated
;  strings, with preceding length bytes.
; 0th dictentry => use string at r2.

XOS_PrettyPrint_code ROUT

; Inside here, r1 is the current string pointer
;              R3 is the linelength to format to
;              R4 is the current position in the line.
;              r6 is the return addr in word counting
;              r7 is the r1 restore value in reading word length
;              r8 is used in dictionary selection in getbytepp
;              r9 is the stack restoration level for exiting.
;              r11 is the dictionary pointer (0 means use MOS dict)
;              r12 is the special token pointer

          WritePSRc SVC_mode, r11

          Push   "r0-r9, lr"

          BL      ReadWindowWidth    ; read linelength
          MOV     R3, R0
          MOV     R0, #165           ; read output cursor
          SWI     XOS_Byte
          ORR     R4, R1, #&80000000 ; no leading space even if in line.
          LDMFD   stack, {r1, r11, r12}   ; reload strptr, dictptr, tokptr
          CMP     r11, #0
          ADREQL  r11, MOSdictionary
          MOV     r9, stack

; loop over all words
01        BL      getwordlength
          CMP     R2, #0
          BNE     %FT03
          BL      getbytepp
          B       %FT21                ; null word - test for done
03
          CMP     R4, #0
          ADDGT   R2, R2, #1           ; allow for separator
          ADD     R0, R2, R4
          BIC     R0, R0, #&80000000   ; clear R4 flag
          CMP     R0, R3
          BLE     %FT10
          CMP     R4, #0
          SUBGT   R2, R2, #1          ; remove leading space length
          MOV     R4, #0              ; if word too long to fit, do newline
          SWI     XOS_NewLine
          BVS     exitpp

10        CMP     R4, #0
          BIC     R4, R4, #&80000000  ; clear "no leading space" flag
          ADD     R4, R4, R2
          SUBGT   R2, R2, #1
          SWIGT   XOS_WriteI+" "    ; output separator if not 1st on line
          BVS     exitpp

04        BL      getbytepp
          CMP     R0, #31           ; hard space?
          MOVEQ   R0, #" "
          SWI     XOS_WriteC
          BVS     exitpp
          SUBS    R2, R2, #1
          BNE     %BT04

21        CMP     R0, #13
          MOVEQ   R4, #0
          SWIEQ   XOS_NewLine
          BVS     exitpp

          CMP     R0, #TAB
          BEQ     %FT20
          CMP     R0, #0
          BNE     %BT01

exitpp    MOV     stack, r9
          STRVS   r0, [stack]
          Pull   "r0-r9,lr"
          B      SLVK_TestV

; TAB had: align to next multiple of 8
20        BIC     R4, R4, #&80000000
   ; first want to get next word length, to see if it's worth doing
          ADD     R5, R4, #8
          BIC     R5, R5, #7
          SUB     R5, R5, R4           ; spaces for this tab

24        BL      getwordlength
          CMP     R2, #0
          BNE     %FT23              ; got the word
          BL      getbytepp
          CMP     R0, #13
          BEQ     %BT21              ; TAB, CR - whalley!
          CMP     R0, #TAB
          SUBNE   R5, R5, #1         ; leading spaces, junk ignored
          ADDEQ   R5, R5, #8         ; multiple tabs OK tho.
          CMP     r0, #0             ; terminator?
          BNE     %BT24              ; only case to allow zero-length word
          SUB     r1, r1, #1         ; we know this rewinds OK

23        ADD     R0, R4, R5
          ADD     R0, R0, R2
          CMP     R0, R3
          MOVGT   R0, #13           ; next tab stop too far : newline
          BGT     %BT21
22        SWI     XOS_WriteI+" "
          BVS     exitpp
          ADD     R4, R4, #1
          SUBS    r5, r5, #1
          BNE     %BT22
          ORR     R4, R4, #&80000000 ; set top bit to disable leading space
          B       %BT01

getwordlength
          MOV     r6, lr
          MOV     r10, r9            ; first copy context
          MOV     r2, stack
          MOV     r7, r1
copycontextpp
          CMP     r9, r2
          LDRNE   r0, [r9, #-4]!
          Push    r0, NE
          BNE     copycontextpp

          MOV     r2, #0             ; word length
02        BL      getbytepp
          CMP     R0, #31
          CMPNE   R0, #" "+1
          ADDGE   r2, r2, #1
          BGE     %BT02
          MOV     r1, r7
          MOV     stack, r9
          MOV     r9, r10
          MOV     pc, r6

getbytepp LDRB    r0, [r1], #1
          CMP     r0, #TokenEscapeChar
          BEQ     gettokenpp
          CMP     r0, #0
          MOVNE   pc, lr
          CMP     stack, r9
          MOVHS   pc, lr
          Pull    r1                ; back to previous token
          B       getbytepp

gettokenpp
          LDRB    r0, [r1], #1      ; tokno
          Push    r1                ; save context
          CMP     r0, #0
          MOVEQ   r1, r12
          BEQ     getbytepp
          MOV     r1, r11
gtoklp    SUBS    r0, r0, #1
          LDRNEB  r8, [r1]
          ADDNE   r1, r1, r8
          BNE     gtoklp
          ADD     r1, r1, #1
          B       getbytepp

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

ReadWindowWidth ROUT    ; read "number of chars printable after Newline
                        ;       before we're on the next line"
        MOV     R0, #VduExt_WindowWidth
ReadVduVarForSam
        Push   "R0, R1, lr"      ; R1 reserves space
        MOV     R0, #-1
        STR     R0, [stack, #4]  ; overwrite R1 value
        MOV     R0, sp
        MOV     R1, sp
        SWI     XOS_ReadVduVariables
        LDR     R0, [sp], #8
        LDR     pc, [sp], #4

;*****************************************************************************
; R0 -> envstring, R1 -> 5 byte time

WriteEnv_SWICode ROUT ; for debugger use
        CMP     R0, #0
        BEQ     %FT01
        LDR     R10, =EnvString
        MOV     R11, R0
02      LDRB    R12, [R11], #1
        CMP     R12, #" "
        MOVLT   R12, #0
        STRB    R12, [R10], #1
        BGE     %BT02

01      CMP     R1, #0
        ExitSWIHandler EQ
        LDR     R10, =ZeroPage+EnvTime
        MOV     R11, #4
03      LDRB    R12, [R1, R11]
        STRB    R12, [R10, R11]
        SUBS    R11, R11, #1
        BPL     %BT03
        ExitSWIHandler

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

; LET RdArgs() BE
;  R0 ptr to key defn string
;  R1 ptr to command line to decode
;  R2 ptr to workspace
;  R3 size of workspace
; Returns R3 size left

; Flags used in initial args decoding

AFlag       *  1:SHL:8     ; flags shifted up a byte; avoid looking like chars.
KFlag       *  1:SHL:9
SFlag       *  1:SHL:10
EFlag       *  1:SHL:11
GFlag       *  1:SHL:12
UnsetBase   *  &FF000000   ; only if all bits set (cannot be RAM address)

PresentFlag *  &7FFFFFFF
AbsentFlag  *  0

; Type flags

EndType     *   0
FlagType    *   1
KeywordType *   2
ItemType    *   3

RdArgs_SWICode ROUT

      WritePSRc SVC_mode, R10

      Push   "R4, R8, R9, lr"
      MOV     R10, R2             ; R10 points at next available word
      MOV     R12, R0
01    MOV     R11, #UnsetBase
      SUBS    R3, R3, #4
      BMI     %FT99               ; insufficient space
      STR     R11, [R10], #4
02    LDRB    R11, [R12], #1
      CMP     R11, #"/"
      BNE     %FT03
      LDRB    R11, [R12], #1
      UpperCase R11, R9
      CMP     R11, #"A"
      MOVEQ   R11, #AFlag
      CMP     R11, #"K"
      MOVEQ   R11, #KFlag
      CMP     R11, #"S"
      MOVEQ   R11, #SFlag
      CMP     R11, #"E"
      MOVEQ   R11, #EFlag
      CMP     R11, #"G"
      MOVEQ   R11, #GFlag
      CMP     R11, #256
      LDRGE   R9, [R10, #-4]
      ORRGE   R9, R11, R9
      STRGE   R9, [R10, #-4]
03
      CMP     R11, #","
      BEQ     %BT01
      CMP     R11, #" "
      BGE     %BT02

; Initialisation complete: all flags set, R10 implies number of args.
      MOV     R8, R10

10    BL      RdItem
      BVS     %FT90
      CMP     R12, #KeywordType
      BNE     %FT11
      ADD     R11, R2, R4, LSL #2           ; keyword ptr
      BL      RdItem
      BVS     %FT90
      CMP     R12, #ItemType
      BNE     %FT98
      BL      SetKeyword
      BVS     %FT90
      B       %BT10

11    CMP     R12, #ItemType
      BNE     %FT12

; next positional arg := itemptr

      MOV     R11, R2
20    CMP     R11, R8
      BEQ     %FT98               ; no more positional args
      LDR     R12, [R11], #4
      CMP     R12, #UnsetBase
      BLO     %BT20
      TST     R12, #KFlag :OR: SFlag
      BNE     %BT20
      SUB     R11, R11, #4
      BL      SetKeyword
      BVS     %FT90
      B       %BT10

12    CMP     R12, #EndType
      BNE     %BT10

; postscan to check all /a args set.
      MOV     R12, R2
30    CMP     R12, R8
      BEQ     %FT31
      LDR     R11, [R12], #4
      CMP     R11, #UnsetBase
      BLO     %BT30
      TST     R11, #AFlag
      BNE     %FT98          ; bum args error
      MOV     R11, #AbsentFlag
      STR     R11, [R12, #-4]     ; force "not present"
      B       %BT30

31
      Pull   "R4, R8, R9, lr"
      ExitSWIHandler

98    ADR     R0, ErrorBlock_BadParameters
    [ International
      BL      TranslateError
    ]
      B       %FT90

99    ADRL    R0, ErrorBlock_BuffOverflow
    [ International
      BL      TranslateError
    ]
90
      Pull   "R4, R8, R9, lr"
      B      SLVK_SetV

      MakeErrorBlock BadParameters
      MakeErrorBlock ArgRepeated
      ALIGN

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; RdItem: strips next item from command line
; In:  R1 -> cmd line
; Out: R1 updated
;      R12 contains type
;      R4 contains ptr for Item, argno for Flag/Keyword
; VS means buffer full
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

RdItem    ROUT
      Push  "R1, R7, R8, lr"
      MOV    R8, #0              ; not demanding new arg
01    LDRB   R12, [R1], #1
      CMP    R12, #" "
      BEQ    %BT01
      BGE    %FT33
      MOV    R12, #EndType
      CLRV
      Pull  "R1, R7, R8, PC"
33
      CMP    R12, #""""
      BEQ    ohnoitsquotedargumentsagain

      CMP    R12, #"-"      ; options?
      BNE    %FT02          ; nope - boring item
05    BL     GetArg
      LDRVS  R1, [stack]
      BVS    %FT02          ; not recognised - boring item
      STR    R1, [stack]    ; new restore value.
      MRS    R12, CPSR
      Push   R12            ; save EQ/NE
      LDR    R12, [R2, R4, LSL #2]
      CMP    R12, #UnsetBase
      BHS    %FT34
      ADR    R0, ErrorBlock_ArgRepeated
    [ International
      BL     TranslateError
    |
      SETV
    ]
      ADD    stack, stack, #4 ; discard PSR
      Pull  "R1, R7, R8, PC"
34
      ANDS   R12, R12, #SFlag
      BNE    %FT35
      MOV    R12, #KeywordType
      ADD    stack, stack, #4 ; discard PSR
      CLRV
      Pull  "R1, R7, R8, PC"
35
      MOV    R12, #PresentFlag
      STR    R12, [R2, R4, LSL #2]

; now deal with flag elision: if nextchar valid keyword char, rescan
      Pull   R12
      TST    R12, #Z_bit
      BEQ    %FT20          ; GetArg returned NE, so not single char abbr
      Push  "R2, R3"
      LDRB   R2, [R1]
      BL     CheckR2OKChar
      Pull  "R2, R3"
      MOVEQ  R8, #1        ; MUST get another arg
      BEQ    %BT05
20    MOV    R12, #FlagType
      CLRV
      Pull  "R1, R7, R8, PC"

02    CMP    R8, #0
      BEQ    %FT39
      ADR    R0, ErrorBlock_BadParameters
    [ International
      BL     TranslateError
    |
      SETV
    ]
      Pull  "R1, R7, R8, PC"
39
   ; copy arg until <" "

      MOV    R7, #" "
      SUB    R1, R1, #1
06    MOV    R4, R10
03    LDRB   R12, [R1], #1
      CMP    R12, R7
      CMPNE  R12, #" "-1
      BLE    %FT04
10
      SUBS   R3, R3, #1
      STRPLB R12, [R10], #1
      BPL    %BT03
23
      ADRL   R0, ErrorBlock_BuffOverflow
    [ International
      BL     TranslateError
    |
      SETV
    ]
      Pull  "R1, R7, R8, PC"

04    CMP    R7, #""""
      BNE    %FT07
      CMP    R12, #""""
      BNE    %FT08
      LDRB   R12, [R1], #1
      CMP    R12, #""""
      BEQ    %BT10
07    MOV    R12, #0            ; terminate
      SUBS   R3, R3, #1
      BMI    %BT23
      STRB   R12, [R10], #1
      MOV    R12, #ItemType
      SUB    R1, R1, #1
      STR    R1, [stack]
      CLRV
      Pull  "R1, R7, R8, PC"

ohnoitsquotedargumentsagain
      MOV    R7, #""""
      B      %BT06

08    ADRL   R0, ErrorBlock_BadString
    [ International
      BL     TranslateError
    |
      SETV
    ]
      Pull  "R1, R7, R8, PC"

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; GetArg
; Look through keys: allow only full match on first pass, then
;  single char abbreviation on second pass
; Return V set if not key, EQ if single letter abbreviation
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

GetArg    ROUT
; In:  R0 ptr to keystring
;      R1 ptr to potential option.
; Out: VS if nomatch or
;      R1 updated
;      R4 argument number

      Push   "R0-R3, R5-R6, lr"
      MOV     R6, #-1             ; pass number
20    MOV     R4, #0

01    LDRB    R2, [R0], #1
      CMP     R2, #" "
      BEQ     %BT01

02    BL      CheckR2OKChar
      BNE     %FT03             ; matched in full
      LDRB    R3, [R1], #1
      UpperCase R2, R5
      UpperCase R3, R5
      CMP     R2, R3
      LDREQB  R2, [R0], #1
      BEQ     %BT02

      CMP     R6, #0
      BLT     %FT04

; 2nd pass: allow abbreviation
; IF single char abbreviation THEN success ELSE skip
      LDR     R2, [stack, #4]
      SUB     R2, R1, R2          ; length of match+1
      CMP     R2, #2
      SUBEQ   R1, R1, #1
      BEQ     %FT13               ; success

; skip to next keyword
04    LDRB    R2, [R0], #1
      CMP     R2, #" "
      BLT     %FT05
      CMP     R2, #","
      ADDEQ   R4, R4, #1
      CMPNE   R2, #"="
      BNE     %BT04
      LDR     R1, [stack, #4]
      B       %BT01

03  ; NE on first pass: check input string terminated OK
      LDRB    R2, [R1]            ; check for end of input word
      BL      CheckR2OKChar
      BNE     %FT13               ; yaay! full & correct match
      SUB     R0, R0, #1
      B       %BT04

05    ADDS    R6, R6, #1
      LDMLEFD stack, {R0, R1}
      BLE     %BT20
      SETV
      Pull   "R0-R3, R5-R6, PC"   ; back with failure

13    STR     R1, [stack, #4]
      CLRPSR  V_bit, R0           ; clrV (just)
      Pull   "R0-R3, R5-R6, PC"   ; back with success

CheckR2OKChar ROUT
      CMP     R2, #"A"
      RSBGES  R3, R2, #"Z"
      BGE     %FT50
      CMP     R2, #"a"
      RSBGES  R3, R2, #"z"
      BGE     %FT50
      CMP     R2, #"0"
      RSBGES  R3, R2, #"9"
      BGE     %FT50
      CMP     R2, #"_"
      MOV     PC, lr
50    CMP     R0, R0            ; set EQ
      MOV     PC, lr

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

SetKeyword    ROUT
; R11 ptr at keyword flags
; R4 ptr to value
      Push   "R0-R2, R5, R6, lr"
      LDR     R0, [R11]
      TST     R0, #EFlag :OR: GFlag
      STR     R4, [R11]           ; result will always be here anyway
      BEQ     %FT01
      SUB     R5, R10, R4         ; length of value
      ADD     R3, R3, R5          ; increase free space
      ADD     R2, R5, #11         ; round up to nearest word, then 1
      BIC     R2, R2, #3

      MOV     R6, stack            ; STR stack, [stack, -R2]! is unpredictable
      STR     R6, [stack, -R2]!    ; reserve stack frame

      ADD     R2, stack, #4        ; input value ptr
03    LDRB    R6, [R4, R5]
      STRB    R6, [R2, R5]
      SUBS    R5, R5, #1
      BPL     %BT03               ; copy the value

      TST     R0, #EFlag
      MOV     R0, R2
      BNE     %FT02
      ADD     R1, R4, #2          ; free space pointer
      SUBS    R3, R3, #2
      MOV     R2, R3
      BMI     %FT04
      ORR     R2, R2, #1:SHL:31
      SWI     XOS_GSTrans
05    SUB     R3, R3, R2
      ADD     R10, R1, R2        ; update freespace pointer
      STRB    R2, [R1, #-2]
      MOV     R2, R2, LSR #8
      STRB    R2, [R1, #-1]
      BCS     %FT04

90    LDR     stack, [stack, #0]  ; unwind frame (and don't let AAsm use
      STRVS   R0, [stack]         ;   postindexed!!!)
      Pull   "R0-R2, R5, R6,PC"

04    ADRL    R0, ErrorBlock_BuffOverflow
    [ International
      BL      TranslateError
    |
      SETV
    ]
      B       %BT90

02    ADD     R1, R4, #3        ; free space pointer
      SUBS    R3, R3, #3        ; adjust for type (1 byte) + length (2 bytes)
      BMI     %BT04
      MOV     R2, R3
      SWI     XOS_EvaluateExpression
      BVS     %BT90
      TEQ     R1, #0, 2         ; if non-zero, then string, so update length
      MOVNE   R14, #1           ; set type byte to definitely non-zero
      STRNEB  R14, [R4]
      BNE     %BT05             ; (C=0 so no buffer overflow, V=0 from SWI)
      STRB    R1, [R4]          ; set type byte to zero (=> integer)
      SUBS    R3, R3, #5
      BMI     %BT04
      STRB    R2, [R4, #1]
      MOV     R2, R2, LSR #8
      STRB    R2, [R4, #2]
      MOV     R2, R2, LSR #8
      STRB    R2, [R4, #3]
      MOV     R2, R2, LSR #8
      STRB    R2, [R4, #4]
      ADD     R10, R4, #5
      B       %BT90

01
      CLRV
      Pull   "R0-R2, R5, R6,PC"


; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ReadRAMFSLimits
; Return R0 start, R1 end (i.e. 1st byte out of area)

ReadRAMFSLimits_Code ROUT
        Push    "lr"
        MOV     r0, #ChangeDyn_RamFS
        SWI     XOS_ReadDynamicArea     ; out: r0 = base, r1 = current size
        Pull    "lr"
        ADDVC   r1, r1, r0              ; if no error, make r1 -> after end
        ORRVS   lr, lr, #V_bit          ; if error, then set V_bit on return
        ExitSWIHandler

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ExitAndDie
; r0-r2 parameters for Exit
; r3 pointer to module name

TerminateAndSodOff ROUT

        Push    "r0-r2"
        LDR     r10, =ZeroPage
      [ ZeroPage = 0
        STR     r10, [r10, #Curr_Active_Object]
      |
        MOV     r14, #0
        STR     r14, [r10, #Curr_Active_Object]
      ]
        MOV     r1, r3
        MOV     r0, #ModHandReason_Delete
        SWI     XOS_Module
        Pull    "r0-r2"
        SWI     XOS_Exit

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; AddCallBack entry to callback vector
; r0 address to call
; r1 workspace ptr

AddCallBack_Code  ROUT

      Push   "r0-r3, lr"
  [ ChocolateSysHeap
      ASSERT  ChocolateCBBlocks = ChocolateBlockArrays + 0
      LDR     r3,=ZeroPage+ChocolateBlockArrays
      LDR     r3,[r3,#0]
      BL      ClaimChocolateBlock
      MOVVS   r3, #12
      BLVS    ClaimSysHeapNode
  |
      MOV     r3, #12
      BL      ClaimSysHeapNode
  ]
      BVS     %FT99
      Pull   "r0, r1"
      LDR     r10, =ZeroPage
      WritePSRc SVC_mode+I_bit, r3      ; IRQs off while holding context.
      LDR     r3, [r10, #CallBack_Vector]
 [ {TRUE}
      STR     r3, [r2, #0]
      STMIB   r2, {r0, r1}
      STR     r2, [r10, #CallBack_Vector]
      Pull   "r2, r3, lr"
 |
      STR     r3, [r2], #4
      STMIA   r2, {r0, r1}
      SUB     r2, r2, #4
      STR     r2, [r10, #CallBack_Vector]
      Pull   "r2, r3, lr"
      MOV     r10, #0
 ]
      LDRB    r11, [r10, #CallBack_Flag]
      ORR     r11, r11, #CBack_VectorReq
      STRB    r11, [r10, #CallBack_Flag]
      B       SLVK

99      STR     r0, [stack]
        Pull    "r0-r3, lr"
        B       SLVK_SetV

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
;       RemoveCallBack - Entry for SWI OS_RemoveCallBack
;
;       Removes an entry on the callback vector before it has been called
;
; in:   r0 = address that would have been called
;       r1 = workspace ptr
;
; out:  -
;

RemoveCallBack ROUT
        Push    "r2-r4"
        SavePSR r10                     ; save old I bit
10
        WritePSRc SVC_mode+I_bit, r11   ; disable IRQs while looking at list
        LDR     r11, =ZeroPage
        LDR     r2, [r11, #CallBack_Vector]! ; r11 -> prev, r2 -> this
20
        TEQ     r2, #0
        Pull    "r2-r4", EQ
        ExitSWIHandler EQ

        LDMIA   r2, {r3,r4,r12}         ; r3 -> next, r4 = addr, r12 = ws
        TEQ     r4, r0                  ; check if correct address
        TEQEQ   r12, r1                 ; and correct ws ptr
        MOVNE   r11, r2                 ; if not, then prev:=this
        MOVNE   r2, r3                  ; and this:=next
        BNE     %BT20                   ; and loop

        STR     r3, [r11]               ; prev.link := next
        RestPSR r10                     ; safe now to restore IRQ status

        Push    "r0, r1, lr"            ; now free this node
  [ ChocolateSysHeap
        ASSERT  ChocolateCBBlocks = ChocolateBlockArrays + 0
        LDR     r1,=ZeroPage+ChocolateBlockArrays
        LDR     r1,[r1,#0]
        BL      FreeChocolateBlock
        BLVS    FreeSysHeapNode
  |
        BL      FreeSysHeapNode         ; and then start again (NB we must
                                        ; restart from head of list again, as
                                        ; enabling IRQs could have changed list
  ]
        STRVS   r0, [sp, #0]
        Pull    "r0, r1, lr"
        BVC     %BT10

        Pull    "r2-r4"                 ; had an error while releasing block
        ORR     lr, lr, #V_bit
        ExitSWIHandler

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; SWI OS_Confirm

; If pointer visible, change pointer shape and look at mouse keys too.
;                     Flush mouse buffer first.
; Wait until key pressed.
; Returns: (lowercased) character in r0 (if mouse scanned, LH button = 'y',
;                                        other buttons = 'n')
; C set for Escape condition
; EQ set if r0 = 'y'

 [ International
confirm_yn      DCB "YesNo:yn",0        ; Token to lookup message for Yes/No
 |
confirm_yn      DCB "yn"
 ]
ptr_confirm     DCB "ptr_confirm",0     ; Wimp's confirm pointer sprite shape
confirm_scale   DCD 1,1,1,1             ; Scaling factor for sprite op
Confirm_Code ROUT
        WritePSRc SVC_mode, r10         ; enable IRQs
        Push   "r0-r7, lr"

; Lookup the symbols for Y/N

        ADR     r0, confirm_yn
 [ International
        BL      FindToken               ; Lookup in messages, use default if error
 ]
        LDRB    r1, [r0], #1            ; Y character
        LDRB    r2, [r0], #1            ; N character
        ORR     r1, r1, r2, LSL #8
        Push    "r1"                    ; Y=[sp], N=[sp+1]

; Save current pointer selected

        MOV     r0, #106
        MOV     r1, #255                ; read pointer state
        SWI     XOS_Byte
        BVS     confirm_error
        BIC     r2, r1, #&80
        MOV     r10, r1
        TST     r10, #15                ; Pointer enabled?
        BEQ     confirm_waitloop        ; Jump if not

; Find Wimp's "ptr_confirm" sprite, searching first RMA then ROM

        SWI     XWimp_BaseOfSprites
        MOVVS   r10, #0                 ; If error then don't use mouse
        BVS     confirm_waitloop        ; And jump to poll keyboard

        MOV     r11, r0                 ; Save -> ROM sprites, r1 -> RMA sprites
        ADR     r2, ptr_confirm         ; -> sprite name
        MOV     r0, #&128               ; Read sprite info
        SWI     XOS_SpriteOp
        BVC     %FT10                   ; Jump if sprite in RMA

        ADR     r2, ptr_confirm         ; -> sprite name
        MOV     r1, r11                 ; -> ROM sprites
        MOV     r0, #&128               ; Read sprite info
        SWI     XOS_SpriteOp
        MOVVS   r10, #0                 ; If error then don't use mouse
        BVS     confirm_waitloop        ; And jump to poll keyboard

; Set pointer shape from the sprite area found (r1)

10      MOV     r7, #0                  ; No pixel translation
        ADR     r6, confirm_scale       ; pointer scaling factor (1:1)
        MOV     r5, #0                  ; y hot spot offset
        MOV     r4, #0                  ; x hot spot offset
        MOV     r3, #&23                ; No palette, shape 3
        ADR     r2, ptr_confirm         ; -> sprite name
        MOV     r0, #&124               ; Set pointer shape
        SWI     XOS_SpriteOp            ; Ignore errors

        MOV     r0, #21
        MOV     r1, #9
        SWI     XOS_Byte                ; flush mouse buffer

        MOV     r0, #&C4
        MOV     r1, #0
        MOV     r2, #255
        SWI     XOS_Byte                ; read current repeat rate.
        LDR     r0, =ZeroPage
        LDR     r0, [r0, #MetroGnome]
        ADD     r11, r1, r0             ; time to wait for

confirm_mouserepeat
        SWI     XOS_Mouse
        CMP     r2, #0                  ; any buttons down?
        BEQ     confirm_waitloop

        CMP     r3, r11
        BMI     confirm_mouserepeat

confirm_waitloop
        MOV     r0, #129
        MOV     r1, #1
        MOV     r2, #0
        SWI     XOS_Byte                ; scan for key
        BVS     confirm_error
        CMP     r2, #255
        BNE     confirm_gotkey

        TST     r10, #15
        BEQ     confirm_waitloop        ; no mouse scan wanted.

        SWI     XOS_Mouse
        BVS     confirm_error
        CMP     r2, #0
        BEQ     confirm_waitloop

        TST     r2, #4                  ; LH button?
        LDRNEB  r1, [sp]                ; Yes
        LDREQB  r1, [sp, #1]            ; No

confirm_gotkey
        CMP     r2, #&1B                ; ESCAPE or normal char read ?
        ORREQ   r11, r1, #&100
        MOVNE   r11, r1
        LowerCase r11, r1

        TSTS    r10, #15                ; Was pointer changed?
        MOV     r1, r10
        MOV     r0, #106
        SWINE   XOS_Byte                ; Yes then restore shape

        Pull   "r10"                    ; r10=YN
        AND     r10, r10, #&ff          ; Retain Y byte
        Pull   "r0-r7, lr"
        BIC     lr, lr, #C_bit :OR: Z_bit ; SKS. Punter lr has VClear
        AND     r0, r11, #&FF
        TST     r11, #&100              ; ESCAPE condition ? (SKS)
        ORRNE   lr, lr, #C_bit
        CMP     r0, r10
        ORREQ   lr, lr, #Z_bit
        B       SLVK

confirm_error
        ADD     sp, sp, #4              ; Drop YN
        STR     r0, [stack]
        Pull    "r0-r7, lr"
        B       SLVK_SetV


; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; In    r0 = continuation crc (0 to start)
;       r1 -> start of core
;       r2 -> end of core
;       r3 = increment (typically 1, 2 or 4), but can be -ve

; Out   r0 = crc so far

CRC_Code ROUT

        [ {TRUE}
        WritePSRc SVC_mode, r10         ; Could take a long time

        Push    "r3, r14"
        TEQ     r3, #0                  ; is increment 0? - if so, it's silly
        BEQ     %FT80                   ; so return error, rather than going on forever

        MOV     r10, r1
        MOV     r12, #&A000             ; CRC EOR pattern = &A001
        ORR     r12, r12, #&0001
10
        CMP     r10, r2                 ; Finished ?
        BEQ     %FA90                   ; Must be exact end, allows -ve offset

        LDRB    r14, [r10], r3
        EOR     r0, r0, r14             ; EOR the data with current crc lo
        CMP     r10, r2                 ; length might be odd so check again
        MOVEQ   r11, #8                 ; if equal then only do 8 bits
        BEQ     %FT20

        LDRB    r14, [r10], r3
        EOR     r0, r0, r14, LSL #8     ; EOR the data with current crc hi
        MOV     r11, #16                ; do 16 bits

20
        MOVS    r0, r0, LSR #1          ; acc >>= 1; CS/CC
        EORCS   r0, r0, r12             ; CS -> eor, CC -> ok
        SUBS    r11, r11, #1            ; 8 bits per byte
        BNE     %BT20
        B       %BT10

80
        ADRL    r0, ErrorBlock_BadParameters    ; return "Bad parameters" error
 [ International
        BL      TranslateError
 ]
        Pull    "r3, r14"
        B       SLVK_SetV

90
        Pull    "r3, r14"
        ExitSWIHandler
        |
        WritePSRc SVC_mode, r10         ; Could take a long time

        Push    "r3, r4, lr"
        MOV     r10, r1
        MOV     r12, #&A000             ; CRC EOR pattern = &A001
        ORR     r12, r12, #&0001
        MOV     r14, #1                 ; A single bit to be shifted

10      CMP     r10, r2                 ; Finished ?
        BEQ     %FA90                   ; Must be exact end, allows -ve offset

        LDRB    r4, [r10], r3
        MOV     r11, #0                 ; Go round the bits

20      TST     r4, r14, LSL r11        ; Is data bit = carry ?; NE/EQ
        BEQ     %FT30

        MOVS    r0, r0, LSR #1          ; acc >>= 1; CS/CC
        EORCC   r0, r0, r12             ; NE, CC -> eor, NE, CS -> ok
        B       %FT40

30      MOVS    r0, r0, LSR #1          ; acc >>= 1; CS/CC
        EORCS   r0, r0, r12             ; EQ, CS -> eor, EQ, CC -> ok

40      ADD     r11, r11, #1            ; 8 bits per byte
        CMP     r11, #8
        BLO     %BT20

        B       %BT10

90      Pull    "r3, r4, lr"
        ExitSWIHandler
        ]

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

        END