SUBT    > Sys.ArithSet

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;                A R I T H M E T I C   F U N C T I O N S
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Integer. ADD/RSB are inline functions done by Trans

; function times (a, b : integer) : integer;

iMulInt POP2    ara, arb
        ABSARGS ara, arb
        MULT    arc, ara, arb
        RESULT  arc
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function sqr (a : integer) : integer;

; An integer must have top 16 bits all 0 or all 1 to be squareable -> 32 bits

iXX2Int POP     ara
        TEQ     ara, #0
        RSBMI   ara, ara, #0
 [ arm2
        MOVS    arc, ara, LSR #16
        MUL     arc, ara, arb
 |
        MOV     arb, ara
        MULT    arc, ara, arb
 ]
        PUSH    arc
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function div (a, b : integer) : integer;

iDivInt POP2    ara, arb
        ABSARGS ara, arb
        BEQ     eDivZero
        DIVREM  arc, ara, arb
        RESULT  arc
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function mod (a, b : integer) : integer;

iModInt POP2    ara, arb
        MOV     ars, #0
        MOV     temp, arb
        TEQ     ara, #0
        RSBMI   ara, ara, #0
        MOVMI   ars, #bit31
        CMP     arb, #0
        BLE     eBadMod
        DIVREM  arc, ara, arb
        TST     ars, #bit31
        CMPNE   ara, #0
        SUBNE   ara, temp, ara  ; Only do if rem <> 0 and a was -ve
        PUSH    ara
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Floating point. Exceptions will be trapped eventually

; function compare (a, b : real) : flags;

iCmpRea SUB     sp, sp, #8*2    ; Prevent Wb if possible
        LDFD    fb, [sp, #8]    ; a rel b
        LDFD    fa, [sp, #0]
        CMF     fa, fb
        MOV     pc, link ; Do something to arga when we get back (in Trans)

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function plus (a, b : real) : real;

iAddRea SUB     sp, sp, #8      ; Prevent Wb if possible
        LDFD    fa, [sp, #0]
        LDFD    fb, [sp, #-8]
        ADFD    fa, fa, fb
        STFD    fa, [sp, #-8]
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function minus (a, b : real) : real;

iSubRea SUB     sp, sp, #8      ; Prevent Wb if possible
        LDFD    fa, [sp, #0]
        LDFD    fb, [sp, #-8]
        RSFD    fa, fa, fb
        STFD    fa, [sp, #-8]
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function times (a, b : real) : real;

iMulRea SUB     sp, sp, #8      ; Prevent Wb if possible
        LDFD    fa, [sp, #0]
        LDFD    fb, [sp, #-8]
        MUFD    fa, fa, fb
        STFD    fa, [sp, #-8]
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function sqr (a : real) : real;

iXX2Rea LDFD    fa, [sp, #-8]
        MUFD    fa, fa, fa
        STFD    fa, [sp, #-8]
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function div (a, b : real) : real;

iDivRea SUB     sp, sp, #8      ; Prevent Wb if possible
        LDFD    fa, [sp, #-8]
        LDFD    fb, [sp, #-8]
        RDFD    fa, fa, fb
        STFD    fa, [sp, #-8]
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function sin (a : real) : real;

iSin    LDFD    fa, [sp, #-8]
        SIND    fa, fa
        STFD    fa, [sp, #-8]
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function cos (a : real) : real;

iCos    LDFD    fa, [sp, #-8]
        COSD    fa, fa
        STFD    fa, [sp, #-8]
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function arctan (a : real) : real;

iArctan LDFD    fa, [sp, #-8]
        ATND    fa, fa
        STFD    fa, [sp, #-8]
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function exp (a : real) : real;

iExp    LDFD    fa, [sp, #-8]
        EXPD    fa, fa
        STFD    fa, [sp, #-8]
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function ln (a : real) : real;

iLn     LDFD    fa, [sp, #-8]
        LGND    fa, fa
        STFD    fa, [sp, #-8]
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function sqrt (a : real) : real;

iSqrt   LDFD    fa, [sp, #-8]
        SQTD    fa, fa
        STFD    fa, [sp, #-8]
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function trunc (a : real) : integer;

iTrunc  SUB     sp, sp, #8      ; Prevent Wb if possible
        LDFD    fa, [sp, #0]
        FIXDZ   arga, fa
        PUSH    arga
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function round (a : real) : integer;
; begin
;   if x >= 0 then round := trunc (x + 0.5)
;             else round := trunc (x - 0.5)
; end;

iRound  SUB     sp, sp, #8      ; Prevent Wb if possible
        LDFD    fa, [sp, #0]
        FIXD    arga, fa
        PUSH    arga
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; function float (a : integer) : real;

iFnFloat
        POP     arga
        FLTD    fa, arga
        STFD    fa, [sp, #0]
        ADD     sp, sp, #8      ; Prevent Wb if possible
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Float (TOS-1) arg; move TOS arg (which is real) out of the way first

iFloat2 LDMDB   sp!, {t0, t1, t2}
        FLTD    fa, t0
        STFD    fa, [sp, #0]
        ADD     sp, sp, #8      ; Prevent Wb if possible
        STMIA   sp!, {t1, t2}
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;                   S T R I N G   C O M P A R I S O N S
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &6C - Op_EQ_Str

; In : count = length of strings - 1

iStrEQ ROUT

        POP2    t2, t3

10      LDRB    t0, [t2, count]
        LDRB    t1, [t3, count]
        CMP     t0, t1
        BNE     FalseResult
        SUBS    count, count, #1
        BPL     %BT10

        B       TrueResult

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &6D - Op_NE_Str

iStrNE ROUT

        POP2    t2, t3

10      LDRB    t0, [t2, count]
        LDRB    t1, [t3, count]
        CMP     t0, t1
        BNE     TrueResult
        SUBS    count, count, #1
        BPL     %BT10

        B       FalseResult

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &6F - Op_GE_Str

iStrGE ROUT

        POP2    t2, t3

10      LDRB    t0, [t2, count]
        LDRB    t1, [t3, count]
        CMP     t0, t1
        BLT     FalseResult
        SUBS    count, count, #1
        BPL     %BT10

        B       TrueResult

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &70 - Op_LT_Str

iStrLT ROUT

        POP2    t2, t3

10      LDRB    t0, [t2, count]
        LDRB    t1, [t3, count]
        CMP     t0, t1
        BGE     FalseResult
        SUBS    count, count, #1
        BPL     %BT10

        B       TrueResult

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &71 - Op_GT_Str

iStrGT ROUT

        POP2    t2, t3

10      LDRB    t0, [t2, count]
        LDRB    t1, [t3, count]
        CMP     t0, t1
        BLE     FalseResult
        SUBS    count, count, #1
        BPL     %BT10

        B       TrueResult

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &6E - Op_LE_Str

iStrLE ROUT

        POP2    t2, t3

10      LDRB    t0, [t2, count]
        LDRB    t1, [t3, count]
        CMP     t0, t1
        BGT     FalseResult
        SUBS    count, count, #1
        BPL     %BT10

        B       TrueResult

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;                          S E T   S T U F F
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL codes &2A,&2C - Set_Elem_B/I. Generate set [a] on TOS

iSetElement

        POP     arga
 [ debset
 SWI Newline
 STRIM "Generating Set ["
 DREG arga
 STRIM "]"
 ]
        MOV     temp, arga
        B       SetGenCommon


; BL codes &2B,&2D - Set_Subr_B/I. Generate set [a..b] on TOS, [] if a > b

iSetSubrange

        POP2    temp, arga
 [ debset
 SWI Newline
 STRIM "Generating Set ["
 DREG temp
 STRIM ".."
 DREG arga
 STRIM "]"
 ]

SetGenCommon ROUT

; Clear out the result set

        MOV     t3, #0
        ADD     count, sp, #32
09      STR     t3, [count, #-4]!
        CMP     sp, count
        BNE     %BT09

        CMP     temp, arga
 [ debset
 BLE %FT69
 SWI Newline
 STRIM "Set is []"
69
 ]
        ADDGT   sp, sp, #32
        MOVGT   pc, link

        MOV     t0, temp, LSR #5        ; t0 in 0..7
        MOV     t1, arga, LSR #5        ; t1 in 0..7

; Create middle range (whole words full of ones) of set

        MVN     t3, #0
        ADD     t2, sp, t0, LSL #2
        ADD     count, sp, t1, LSL #2
10      STR     t3, [t2], #4
        CMP     t2, count
        BLT     %BT10

        ADR     r0, SetTable

; Mask low end of set

        ANDS    t2, temp, #31
        LDRNE   t3, [r0, t2, LSL #2]
        LDRNE   t2, [sp, t0, LSL #2]
        ANDNE   t3, t2, t3
        STRNE   t3, [sp, t0, LSL #2]

; Mask high end of set

        AND     t2, arga, #31
        LDR     t3, [r0, t2, LSL #2]
        LDR     t2, [sp, t1, LSL #2]
        MVN     t3, t3, LSL #1
        AND     t3, t2, t3
        STR     t3, [sp, t1, LSL #2]
 [ debset
 SWI Newline
 STRIM "Set is ["
 MOV count, #0
42 LDR arga, [sp, count]
 DREG arga
 ADDS count, count, #4
 CMP count, #32
 BNE %BT42
 STRIM "]"
 ]

        INCSP   32
        RETURN


SetTable ; Table of masks to use in forming sets

        GBLA    cnt
cnt     SETA    0
        WHILE   cnt <> 32
        &       &FFFFFFFF :SHL: cnt
cnt     SETA    cnt+1
        WEND

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &68 - Op_EQ_Set. Compare the two sets on TOS for equality (or not)

iSetEQ ROUT

        DECSP   64
        ADD     temp, sp, #32

        MOV     count, #32-4

10      LDR     t0, [sp, count]
        LDR     t1, [temp, count]
        CMP     t0, t1
        BNE     FalseResult
        SUBS    count, count, #4
        BPL     %BT10

TrueResult
        MOV     arga, #troo
        PUSH    arga
        RETURN

; BL code &69 - op_NE_Set

iSetNE ROUT

        DECSP   64
        ADD     temp, sp, #32

        MOV     count, #32-4

10      LDR     t0, [sp, count]
        LDR     t1, [temp, count]
        CMP     t0, t1
        BNE     TrueResult
        SUBS    count, count, #4
        BPL     %BT10

FalseResult
        MOV     arga, #falsch
        PUSH    arga
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &6A - op_LE_Set. u <= v means u is a subset of v

iSetLE  SUB     arga, sp, #64
        SUB     temp, sp, #32
        DECSP   64
        BL      SetCmpCommon
        BNE     FalseResult
        BEQ     TrueResult

; BL code &6B - op_GE_Set. u >= v means v is a subset of u

iSetGE  SUB     arga, sp, #32
        SUB     temp, sp, #64
        DECSP   64
        BL      SetCmpCommon
        BNE     FalseResult
        BEQ     TrueResult

SetCmpCommon ROUT

        MOV     count, #32-4

10      LDR     t0, [temp, count]
        LDR     t1, [arga, count]
        BICS    t0, t1, t0      ; t1 AND NOT t0
        MOVNE   pc, link        ; FALSE == NE in flags
        SUBS    count, count, #4
        BPL     %BT10

        TEQ     r0, r0          ; TRUE == EQ                 (EORS ?, r0, r0 !)
        MOV     pc, link

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL codes &81,&83 - Op_In_Bce/Int. a IN set

iInSet  DECSP   32
        LDR     arga, [sp, #-4]
        CMP     arga, #255
        MOVHI   arga, #falsch
        STRHI   arga, [sp, #-4]
        MOVHIS  pc, link

        LDRB    t0, [sp, arga, LSR #3]  ; Load corresponding byte from the set
        MOV     t1, #1
        AND     arga, arga, #7
        TST     t0, t1, LSL arga        ; Mask with the corresponding bit
        MOV     arga, #troo
        MOVEQ   arga, #falsch
        STR     arga, [sp, #-4]
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &E0 - CheckSet. Check that the set on TOS is a subset of [a..b]

; In : temp = lower, arga = upper

iSetCheck
 [ debset
 SWI Newline
 STRIM "Checking set against ["
 DREG temp
 STRIM ".."
 DREG arga
 STRIM "]"
 ]
        STASH   link
        BL      SetGenCommon    ; Generate [a..b] on TOS
        DECSP   32
        SUB     arga, sp, #32
        MOV     temp, sp
        BL      SetCmpCommon    ; Check that s <= [a..b]
        BNE     eSetRange
        GRAB    pc

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;                      A R R A Y   A C C E S S
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &42 - Array_Acc

; In : count = number of indices

; NB. baseptr, descptr pulled explicitly now (20-Feb-86) for new compiler

; Desciptors are lists of entries of the form
; component_size / low_bound / high_bound
;       0             4            8

        ^       0
desccompsize  # 4
desclow       # 4
deschigh      # 4
totaldescsize # 0

iArrayAccess
        STASH   "idash, baseptr, descptr, indexptr, addr, link"

        SUB     sp, sp, count, LSL #2   ; Decrement stack over indices
        MOV     indexptr, sp
 [ debarr
 SWI Newline
 STRIM "Array access with"
 DREG count
 STRIM " indices, "
 ]

        LDMDB   sp!, {baseptr, descptr}
 ASSERT baseptr < descptr
        MOV     addr, #0                ; addr is offset within array
 [ debarr
 STRIM " base ="
 DREG baseptr
 STRIM " desc @"
 DREG descptr
 ]

10      LDR     r0, [descptr, #desclow] ; low_bound (n)
        LDR     idash, [indexptr], #4   ; index (n), step onto next index
 [ debarr
 STRIM "index ="
 DREG idash
 ]
        SUB     idash, idash, r0        ; Offset from base
        LDR     r0, [descptr, #desccompsize] ; Get component size (n)
 [ debarr
 STRIM " csz ="
 DREG r0
 ]

; addr := index_offset * component_size + addr

 [ arm2
        MLA     addr, idash, r0, addr
 |
20      MOVS    r0, r0, LSR #1 ; New code - borrowed from MULT + more optimal
        ADDCS   addr, addr, idash
        ADD     idash, idash, idash
        BNE     %BT20
 ]

        SUBS    count, count, #1
        ADDNE   descptr, descptr, #totaldescsize
        BNE     %BT10                   ; Loop over indices

        ADD     addr, addr, baseptr
        PUSH    addr
 [ debarr
 STRIM ", final address ="
 DREG addr
 SWI Newline
 ]
        GRABS   "idash, baseptr, descptr, indexptr, addr, pc"

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Array access with a single index - 12S + 1N cycles better than above

iArrayAccessOne ROUT

        STASH   "idash, baseptr, descptr, link"
        LDMDB   sp!, {baseptr, descptr, idash}
 ASSERT baseptr < descptr
 [ debarr
 SWI Newline
 STRIM "Array access, one index : base ="
 DREG baseptr
 STRIM " desc @"
 DREG descptr
 STRIM "index ="
 DREG idash
 ]

        LDR     r0, [descptr, #desclow] ; low_bound
        SUB     idash, idash, r0        ; idash := index - low_bound
        LDR     r0, [descptr, #desccompsize] ; Get component size
 [ debarr
 STRIM " csz ="
 DREG r0
 ]

; baseptr := index_offset * component_size + baseptr

 [ arm2
        MLA     baseptr, idash, r0, baseptr
 |
20      MOVS    r0, r0, LSR #1 ; New code - borrowed from MULT + more optimal
        ADDCS   baseptr, baseptr, idash
        ADD     idash, idash, idash
        BNE     %BT20
 ]

        PUSH    baseptr
 [ debarr
 STRIM ", final address ="
 DREG baseptr
 SWI Newline
 ]
        GRABS   "idash, baseptr, descptr, pc"

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &51 - Chk_ArrAcc. Check indices against array bounds and access it

iCheckArray ROUT

        STASH   "idash, baseptr, descptr, indexptr, addr, link"

        SUB     sp, sp, count, LSL #2   ; Decrement stack over indices
        MOV     indexptr, sp
 [ debarr
 SWI Newline
 STRIM "Check_Array access with"
 DREG count
 STRIM " indices, "
 ]

        LDMDB   sp!, {baseptr, descptr}
 ASSERT baseptr < descptr
        MOV     addr, #0                ; addr is offset within array
 [ debarr
 STRIM " base ="
 DREG baseptr
 STRIM " desc @"
 DREG descptr
 ]

10      LDR     idash, [indexptr], #4   ; index (n), step onto next index
 [ debarr
 STRIM ", index ="
 DREG idash
 ]
        LDR     r0, [descptr, #deschigh] ; high_bound (n)
 [ debarr
 STRIM " ub ="
 DREG r0
 ]
        CMP     idash, r0
        BGT     eIndexLarge
        LDR     r0, [descptr, #desclow] ; low_bound (n)
 [ debarr
 STRIM " lb ="
 DREG r0
 ]
        SUBS    idash, idash, r0
        BMI     eIndexSmall

        LDR     r0, [descptr, #desccompsize] ; Get component size (n)
 [ debarr
 STRIM " csz ="
 DREG r0
 ]

; addr := index_offset * component_size + addr

 [ arm2
        MLA     addr, idash, r0, addr
 |
20      MOVS    r0, r0, LSR #1 ; New code - borrowed from MULT + more optimal
        ADDCS   addr, addr, idash
        ADD     idash, idash, idash
        BNE     %BT20
 ]

        SUBS    count, count, #1
        ADDNE   descptr, descptr, #totaldescsize
        BNE     %BT10                   ; Loop over indices

        ADD     addr, addr, baseptr
        PUSH    addr
 [ debarr
 STRIM ", final address ="
 DREG addr
 SWI Newline
 ]
        GRABS   "idash, baseptr, descptr, indexptr, addr, pc"

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &4D - Debug_Name

; In : t1 -> procedure name

iDebugName
        STRIM   " ("
        MOV     R0, t1
        SWI     Write0
        STRIM   ") "
        MOV     pc, link

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &4E - Debug_Line

; In : r0 is the line number

iDebugLine
        STASH   link
        STRIM   " ["
        MOV     temp, #is_debug
        BL      R0decimal
        STRIM   "] /"
        DREG    sp
        STRIM   " "
        GRAB    pc

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;                    A S S O R T E D   E X T E N S I O N S
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &E2 - PrX_Plot

; extension procedure plot (PlotOption, x, y : integer);

 [ {FALSE}
iPlot   SWI     WriteI+do_plot          ; Plot
        LDMDB   sp!, {r0, t0, t1}
        SWI     WriteC                  ; PlotOption
        MOV     r0, t0                  ; x
        SWI     WriteC
        MOV     r0, t0, LSR #8
        SWI     WriteC
        MOV     r0, t1                  ; y
        SWI     WriteC
        MOV     r0, t1, LSR #8
        SWI     WriteC
        RETURN
 |
iPlot   LDMDB   sp!, {r0, r1, r2}       ; PlotOption, x, y
        SWI     OS_Plot
        RETURN
 ]

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &E3 - PrX_Vdu

; extension procedure vdu (byte1, byte2, ... byteN : integer);

; In : count = number of parameters. byte1 lowest on stack

iVdu ROUT

        SUB     temp, sp, count, LSL #2

10      LDRB    r0, [temp], #4
        SWI     WriteC
        CMP     sp, temp
        BNE     %BT10

        SUB     sp, sp, count, LSL #2
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &E4 - PrX_Mode

; extension procedure mode (ModeNumber : integer);

iMode   SWI     WriteI+do_mode
        POP     r0
        SWI     WriteC
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &E5 - PrX_Sound

; extension procedure sound (channel, amplitude, pitch, duration : integer);

iSound  LDMDB   sp!, {t0, t1, t2, t3}
        MOV     t0, t0, LSL #16         ; Pack integers down into halfwords
        MOV     t1, t1, LSL #16
        ORR     t0, t1, t0, LSR #16
        MOV     t2, t2, LSL #16
        MOV     t3, t3, LSL #16
        ORR     t2, t3, t2, LSR #16
        STMIA   sp, {t0, t2}

        MOV     oswA, #7
        MOV     oswXY, sp
        SWI     Word
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &E6 - PrX_Envelp

; extension procedure envelope (param1, param2, ... param14 : integer);

iEnvelope ROUT

        DECSP   4*14
        MOV     count, #1               ; First byte already in place

11      LDRB    t0, [sp, count, LSL #2] ; Pack integers down into bytes
        STRB    t0, [sp, count]
        ADD     count, count, #1
        CMP     count, #14
        BNE     %BT11

        MOV     oswA, #8
        MOV     oswXY, sp
        SWI     Word
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &E7 - PrX_Oscli

; extension procedure oscli (command : string); 

; In : count = length of string

iOscli ROUT

        POP     arga
        CMP     count, #0 ; If null string then do nothing
        MOVEQS  pc, link

        STASH   "R0, t1, t2, link"
        LV      R0, straccptr   ; R0 -> string to fire at oscli
        MOV     t1, count

10      LDRB    t2, [arga, t1]  ; Copy to stracc so we can append CR
        STRB    t2, [R0, t1]
        SUBS    t1, t1, #1
        BPL     %BT10

        MOV     t2, #CR
        STRB    t2, [R0, count]

        SWI     Cli
        GRABS   "R0, t1, t2, pc"

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &E8 - PrXSettime

; extension procedure settime (TimeVal : integer);

iSetTime
        MOV     oswA, #1        ; Read the machine time, and
        MOV     oswXY, sp       ; correct internally when reading with 'time'
        SWI     Word

        DECSP   4
        LDMIA   sp, {t0, t1}    ; t0 = time we're setting, t1 = machine time
        SUBS    t0, t1, t0      ; start_time := machine_time - newtime
        SV      t0, starttime
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &E9 - FnX_Time

; extension function time : integer; { Reads time elapsed since settime }

iTime   MOV     oswA, #1
        MOV     oswXY, sp
        SWI     Word

        LDR     t0, [sp]
        LV      t1, starttime
        SUBS    t0, t0, t1
        STR     t0, [sp], #4    ; time := machine_time - start_time
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &EA - FnX_Adval

; extension function adval (channel : integer) : integer;

iAdval  POP     osbX

        MOV     osbY, osbX, LSR #8
        MOV     osbA, #&80
        SWI     Byte

        MOV     osbY, osbY, LSL #24
        AND     osbX, osbX, #&FF
        ORR     osbX, osbX, osbY, LSR #16
        PUSH    osbX
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &EB - FnX_Inkey

; extension function inkey (delay : integer) : integer;

iInkey  POP     osbX

        MOV     osbY, osbX, LSR #8
        MOV     osbA, #&81
        SWI     Byte

        AND     osbX, osbX, #255                ; Really defensive, like mun
        MOVS    osbY, osbY, LSL #24
        MOVNE   osbX, #&FF                      ; If Y = -1 then resultis -1
        ORR     osbX, osbX, osbY, ASR #16
        PUSH    osbX
        RETURN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; BL code &EC - FnX_Point

; extension function point (x, y : integer) : integer;

iPoint  LDMDB   sp!, {t0, t1}
        MOV     t1, t1, LSL #16         ; Pack integers down into halfwords
        MOV     t0, t0, LSL #16
        ORR     t0, t1, t0, LSR #16
        STR     t0, [sp]

        MOV     oswA, #9
        MOV     oswXY, sp
        SWI     Word

        LDRB    t0, [sp, #4]
        MOV     t0, t0, LSL #24
        MOV     t0, t0, ASR #24
        PUSH    t0
        RETURN

        LNK     Sys.File