; 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.
;
        SUBT    System wide macro definitions => &.Hdr.Macros

OldOpt  SETA    {OPT}
        OPT     OptNoList+OptNoP1List

; ***********************************
; ***    C h a n g e   L i s t    ***
; ***********************************

; Date       Name  Description
; ----       ----  -----------
; 28-Sep-87  TMD   Modified CallAVector, VDWS for new soft-load version
; 29-Sep-87  TMD   Modified CallAVector again
; 05-Sep-87  SKS   Removed $hat option from Push
; 22-Oct-87  TMD   Modified CallAVector yet again
; 17-Dec-87  NDR   Modified Swap macro (conditional added)
; 15-Jan-88  BC    Fixed Byte and Word so that the actual parms may be expr.
; 04-Feb-88  SKS   Fixed BYTEWS macro. AAsm thinks :LOR is ok ?!
; 10-Mar-88  NDR   Implemented XError macro
; 11-Mar-88  NDR   Improved XError macro
; 19-Apr-88  SKS   Fixed BYTEWS macro. Added Immediate macro
; 21-Apr-88  SKS   Took debugging out of Immediate macro!. Fixed it to produce
;                  less rubbish in error cases
; 11-May-88  SKS   Added Command_LastName to Command macro
; 16-May-88  SKS   Added optimising addr macro. My apologies to anyone it
;                  screws up! Removed pre-OS 1.20 changes from list.
; 24-May-88  TMD   Added offset to AlignSpace.
; 31-May-88  SKS   addr now does register relative symbols too (need AAsm 1.48)
; 01-Jun-88  SKS   addr now understands different amounts of verbosity
; 03-Jun-88  SKS   make wsaddr to get round absolute problems
; 11-Jun-88  SKS   tweaked |#|
; 18-Jul-88  BC    Made PHPSEI & PLP use a register argument
; ------------------------- RISC OS 2.00 release ------------------------------
; 18-Oct-88  SKS   added AlignForModule macro
; 22-Feb-89  BC    Added file type definition macros
;  8-Sep-89  NDR   Added AddFSError
; 31-Oct-89  JSR   Added StringContains
; 06-Nov-89  BC    Added RRX macro (like ASR, ASL, ROR etc.)
; 22-Nov-89  NDR   Added GetIf macro
; 18-Jan-90  GJS   Added list of macros at the top for reference
; 06-Feb-90  TMD   Corrected date of the line above (said -89)
;                  Corrected syntax messages of AddFile and AddFileDescending; added description of AddFileDescending
; 26-Jul-90  BC    Improved ROR to accept (and modulo) large arguments, and fault zero
; 18-Sep-90  GJS   Added ADDL macro - Add immediate Rn, Rn, #number, which may take more than one instruction
; 11-Mar-90  OSS   Added MakeInternatErrorBlock - puts the tag rather than the string in the error block.
; 21-Mar-91  ECN   Added $tag to MakeInternatErrorBlock
; 10-Apr-91  DDV   Changed NOP to not used a MOVNV, simply does a MOV r0, r0
; 21-Apr-91  RM    Added ChkKernelVersion calls OS_ReadSysInfo to stop
;                  modules from being soft-loaded on 2.00.
; 19-Dec-91  BC    Added SWIChunk to do better SWI chunk allocation and checking
; ------------------------- RISC OS 3.00/3.10 release -------------------------
; 24-Dec-92  BC    Changed the nature of SWI chunk allocation macros
;                  Chunk, ChunkM, InitialiseSWIFile, BlankLineInSWIFile, TerminateSWIFile
; 04-Jan-93  BC    Moved processor specific macros (BSR, CLC, CLRPSR, CLRV, PHPSEI, PLP,
;                  RETURN, RETURNS, SCPSR, SEC, SETPSR, SETV, TOGPSR) to the CPU files
; 15-Jul-93  BC    Fixed speeling error in Upper/LowerCase and added extra parameter
; 27-Aug-93  NK    Added AddError2 Macro to set bits 30 and 23 of error number - this is
;                  then detected by the wimp as a program error.
; 11 Oct-93  NK    Changed AddError2 to do exactly what AddError does!
; 24-Nov-93  AMG   Discovered that upper/lowercase had changed. (Change made by ECN in
;                  OXO sources and comment lost on merging with Medusa sources). Create new
;                  uk_lowercase and uk_uppercase macros with original functionality of the
;                  macros. Add assembly-time comments to new and affected macros.
;                  These comments should be removed in time, once everyone who uses
;                  uppercase/lowercase has had a chance to decide whether to switch to
;                  the uk_ versions.
; 29-Mar-94  BC    Added JumpAddress, LD and ST (from EcoMacros).
;
; *********************************************
; ***  List of macros in alphabetical order ***
; *********************************************
;        AddError $name,$text,$value                            Create an error structure
;        AddError2 $name,$text,$value                           Create an error structure with alt. error number.
;        AddFSError      $class, $baseerr, $fsname, $fsnumber   Create a filing-system error structure
;$Value  AddFile  $FileType,$FileTypeName,$PostValue            Generate a File type label, incrementing current number
;$Value  AddFileDescending  $FileType,$FileTypeName,$PostValue  Generate a File type label, decrementing current number
;$label  ADDL    $reg, $var                                     Long range ADD $reg, $reg, #value
;$label  ADDR    $reg, $dest, $cond                             Long range ADR - but use addr if possible
;$label  addr    $reg, $object, $cc                             Better long range ADR
;        AddSWI  $SWIName,$value                                Generate a SWI label
;$label  AlignSpace $value, $offset                             Align workspace to a boundary and offset
;$label  AlignForModule                                         Alignment for a module
;$label  ASCII_LowerCase $reg, $wrk                             Lowercase A-Z ONLY, no warnings
;$label  ASCII_UpperCase $reg, $wrk                             Uppercase A-Z ONLY, no warnings
;$label  ASL     $reg, $val, $cc                                Generate an ASL instruction
;$label  ASR     $reg, $val, $cc                                Generate an ASR instruction
;$label  BADDR   $reg, $dest, $cond                             Same as ADDR
;        BlankLineInSWIFile
;$label  Byte    $value, $count                                 Add a byte of workspace
;$label  CallAVector $cond                                      Call a vector
;$label  ChkKernelVersion                                       Call OS_ReadSysInfo(1) to stop modules from being soft loaded on 2.00.
;$n      Chunk           $v,$c,$s,$o                            Create a SWI chunk
;$n      ChunkM          $v,$c                                  Create a Message chunk
;        Command $cmd, $max, $min, $optbits, $cmdlabel          Generate a *command block
;$label  ColourConv $in,$out,$tmpR,$tmpG,$tmpB,$red_shift,$red_bits,$green_shift,$green_bits,$blue_shift,$blue_bits,$alpha  Convert &BBGGRR00 colours to various formats
;$label  DEC     $reg,$by                                       Decrement a register (by a value)
;$label  DECS    $reg,$by                                       Decrement a register (by a value) settng PSR
;$label  DivRem  $rc, $ra, $rb, $rtemp, $norem                  Get DIV and optional REM of two values
;$label  DoCallTable $jumpreg, $tablename, $work                Call a routine in a jump table
;$label  DoFastJumpTable $jumpreg, $trash                       Call a routine in a jump table
;$label  DoJumpTable $jumpreg, $tablename, $work1, $work2       Call a routine in a jump table
;$label  DoSVCCallTable $jumpreg, $tablename                    Call a routine in a jump table
;$label  DoSVCJumpTable $jumpreg, $tablename                    Call a routine in a jump table
;$label  Error   $errno, $errstr                                Generate an immediate error
;$label  ExitSWIHandler $cond                                   Exit macro for SWI handlers
;        GetIf   $filename, $cc                                 Get a file conditional on an assembly-time flag
;        Immediate $var                                         Set flag if value is immediate
;$label  INC     $reg,$by                                       Increment a register (by a value)
;$label  INCS    $reg,$by                                       Increment a register (by a value) setting the PSR
;        InfoWord $max, $min, $optbits                          Set the info word for a module command table
;        InitialiseSWIFile
;        JumpAddress $reg,$destination,$forward                 Set a viable (BAL to) return address
;$label  LD      $reg,$var,$cc                                  Load byte or word
;$label  LDHA    $dest, $array, $index, $temp, $cond            Load unsigned halfword from array: LDRH $dest, [$array, $index, LSL #1]
;$label  LDSHA   $dest, $array, $index, $temp, $cond, $teq0     Load signed halfword from array, with optional TEQ $dest, #0
;$label  LDW     $dest, $addr, $temp1, $temp2                   Load word from unknown alignment
;$label  LowerCase $reg, $wrk, $nowarning                       Lowercase A-Z and top-bit set chars
;$label  LSL     $reg, $val, $cc                                Generate an LSL instruction
;$label  LSR     $reg, $val, $cc                                Generate an LSR instruction
;$label  MakeErrorBlock $name, $noalign                         Create an error block
;$label  MakeInternatErrorBlock $name, $noalign                 Create an internationalised error block
;$label  MakeStarSet $name                                      Create a *Set command for a filetype
;$label  MULTIPLY $rc, $ra, $rb                                 Multiply numbers together
;$label  NOP                                                    A do-nothing instruction
;$label  Overlap $master, $slave                                ???
;$label  Pull    $reglist, $cond, $hat                          Pull registers from the stack
;$label  Push    $reglist, $cond, $hat                          Push registers onto the stack
;$label  ROR     $reg, $val, $cc                                Generate an ROR instruction
;$label  RRX     $reg, $cc                                      Generate an RRX instruction
;$var    SETBCD  $val                                           Convert $var to BCD and assign to variable
;$label  ST      $reg,$var,$cc                                  Store word or byte
;$label  STRIM   $string                                        Output an immediate string
;$Answer StringContains $string,$substring                      Assembly-time INSTR function
;$label  Swap    $ra, $rb, $cc                                  Swap two registers
;        TerminateFile
;$label  uk_LowerCase $reg, $wrk                                Lowercase A-Z ONLY
;$label  uk_UpperCase $reg, $wrk                                Uppercase A-Z ONLY
;$label  UpperCase $reg, $wrk, $nowarning                       Uppercase a-z & top bit set chars
;$label  Word    $value, $count                                 Add word to workspace
;$label  WRLN    $string                                        WriteLn a string
;$label  wsaddr    $reg, $object, $cc                           ???
;$label  XError     $errsym, $c1, $c2                           Generate an error from an error block
;$var    |#|     $bytes                                         Allocate workspace downwards rather than upwards
;
; *******************************************************************
; *******************************************************************
; ***                                                             ***
; ***  All MACRO definitions MUST be kept in ALPHABETICAL order!  ***
; ***                                                             ***
; *******************************************************************
; *******************************************************************
;
; **********************************************
; ***  AddError - Create an error structure  ***
; **********************************************
        MACRO
$label  AddError $name,$text,$value
$label
   [    "$value" = ""
ErrorNumber_$name # 1
   |
ErrorNumber_$name * $value
   ]
        GBLS ErrorString_$name
ErrorString_$name SETS "$text"
        MEND

; **********************************************
; ***  AddError2 - Create an error structure ***
; **********************************************

        MACRO
$label  AddError2 $name,$text,$value
$label
   [    "$value" = ""
ErrorNumber_$name # 1
   |
ErrorNumber_$name * $value
   ]
        GBLS ErrorString_$name
ErrorString_$name SETS "$text"
        MEND


;        MACRO
;        AddError2 $name,$text,$value
;        LCLA      value
;   [    "$value" = ""
;value   SETA      @
;                  # 1
;   |
;value   SETA      $value
;   ]
;ErrorNumber_$name * value :OR: &40800000
;        GBLS ErrorString_$name
;ErrorString_$name SETS "$text"
;        MEND

; *************************************************************
; ***  AddFSError - Create a filing-system error structure  ***
; *************************************************************
        MACRO
$label  AddFSError      $class, $baseerr, $fsname, $fsnumber
$label
        LCLA    value
value   SETA    &10000 + $fsnumber*&100 + ErrorNumber_$baseerr._Pre
        LCLS    string
string  SETS    ErrorString_$baseerr._Pre :CC: "$fsname" :CC: ErrorString_$baseerr._Post
        LCLS    string2
string2 SETS    "&":CC:(:STR:value)
        AddError        $class$baseerr, "$string", $string2
        MEND

; **********************************************************************
; ***  AddFile - Generate FileType name labels assuming ^ type defs  ***
; **********************************************************************
;          Generates a label of the form "FileType_Text" with the
;       value &FFF, or "FileType_PostScript" with the value &FF5.
;       Also generates a global string variable (GBLS) of the form
;       "FileTypeText_FFF" with the value "Text    ", or
;       "FileTypeText_FF5" with the value "PoScript".  If the second
;       argument is given then it will be used as the text value, if
;       not then the FileType will be used.
        MACRO
$Value  AddFile  $FileType,$FileTypeName,$PostValue
  [     ("$FileType" = "") :LOR: (("$Value" <> "") :LAND: ("$PostValue" <> ""))
        !       1, "Syntax: [<value>] AddFile <File Type> [< File Type Name>]"
        !       1, "    Or: AddFile <File Type> [< File Type Name> [<value>]]"
        MEXIT
  ]
  [     ("$Value" = "") :LAND: ("$PostValue" = "")
FileType_$FileType # 1
  |
  [     "$Value" = ""
FileType_$FileType * $PostValue
  |
FileType_$FileType * $Value
  ]
  ]
  [     FileType_$FileType > &FFF
        !       1, "Value out of range"
  ]
        LCLS    Number
Number  SETS    (:STR: FileType_$FileType) :RIGHT: 3
        GBLS    FileTypeText_$Number
  [     "$FileTypeName" = ""
FileTypeText_$Number SETS ("$FileType" :CC: "        ") :LEFT: 8
  |
FileTypeText_$Number SETS ("$FileTypeName" :CC: "        ") :LEFT: 8
  ]
        MEND

; *******************************************************************************
; ***  AddFileDescending - Generate FileType decrementing the current number  ***
; *******************************************************************************
        MACRO
$Value  AddFileDescending  $FileType,$FileTypeName,$PostValue
  [     ("$FileType" = "") :LOR: (("$Value" <> "") :LAND: ("$PostValue" <> ""))
        !       1, "Syntax: [<value>] AddFileDescending <File Type> [< File Type Name>]"
        !       1, "    Or: AddFileDescending <File Type> [< File Type Name> [<value>]]"
        MEXIT
  ]
  [     ("$Value" = "") :LAND: ("$PostValue" = "")
        #       -1
FileType_$FileType # 1
        #       -1
  |
  [     "$Value" = ""
FileType_$FileType * $PostValue
  |
FileType_$FileType * $Value
  ]
  ]
  [     FileType_$FileType > &FFF
        !       1, "Value out of range"
  ]
        LCLS    Number
Number  SETS    (:STR: FileType_$FileType) :RIGHT: 3
        GBLS    FileTypeText_$Number
  [     "$FileTypeName" = ""
FileTypeText_$Number SETS ("$FileType" :CC: "        ") :LEFT: 8
  |
FileTypeText_$Number SETS ("$FileTypeName" :CC: "        ") :LEFT: 8
  ]
        MEND

; ***********************************************
; ***  ADDL - add immediate value var to reg  ***
; ***********************************************
        MACRO
$label  ADDL    $reg, $var
        LCLA    count
        LCLA    varcopy
        LCLA    value
varcopy SETA    $var
count   SETA    0
        WHILE   varcopy > 0
      [ varcopy :AND: 3 = 0
varcopy SETA    varcopy :SHR: 2
count   SETA    count + 2
      |
value   SETA    (varcopy :AND: 255) :SHL: (count)
        ADD     $reg, $reg, #&$value
varcopy SETA    varcopy :SHR: 8
count   SETA    count + 8
      ]
        WEND
        MEND

; ********************************************************
; ***  ADDR - Put address of $dest in $reg; $dest > .  ***
; ***  !!! Please use addr wherever possible !!!       ***
; ********************************************************
        MACRO
$label  ADDR    $reg, $dest, $cond
$label  ADR$cond.L $reg, $dest
        MEND

; **********************************************************
; ***  addr - Optimising ADR/ADRL for addressing object  ***
; ***  backwards from current pc or register relative    ***
; ***  symbol. Symbol MUST be defined on first pass      ***
; **********************************************************
                GBLA    addr_verbose
addr_verbose    SETA    0
        MACRO
$label  addr    $reg, $object, $cc
        LCLA    value
value   SETA    .-$object+8
        Immediate &$value
 [ immediate
$label  ADR$cc  $reg, $object
  [ addr_verbose :AND: 1 <> 0
 ! 0,"addr saved a word"
  ]
 |
$label  ADR$cc.L $reg, $object
  [ addr_verbose :AND: 2 <> 0
 ! 0,"addr didn't save a word"
  ]
 ]
        MEND

; ***********************************************************
; ***  AddSWI - Generate SWI labels assuming ^ type defs  ***
; ***  Also assumes the global variable SWIClass is set   ***
; ***********************************************************
        GBLS    SWIClass
        MACRO
        AddSWI  $SWIName,$value
  [     "$value" = ""
$SWIClass._$SWIName # 1
  |
$SWIClass._$SWIName * $value
  ]
X$SWIClass._$SWIName * $SWIClass._$SWIName + Auto_Error_SWI_bit
        MEND

; ********************************************************************************
; ***  AlignSpace - Align workspace to given power-of-two boundary and offset  ***
; ********************************************************************************
        MACRO
$label  AlignSpace $value, $offset
 [ "$value" = ""
$label  #       3 :AND: ($offset-:INDEX: @)
 |
$label  #       (($value)-1) :AND: ($offset-:INDEX: @)
 ]
        MEND


; *******************************************************************
; ***  AlignForModule - Align label as if ALIGN 16 when RMLoaded  ***
; *******************************************************************
        MACRO
$label  AlignForModule
        ALIGN   16,12                   ; So $label at offset 0 when RMLoaded
$label
        MEND

; ***********************************************************************
; ***  Lowercasing macro. Needs temp register; only lowercases A-Z !  ***
; ***********************************************************************
        MACRO
$label  ASCII_LowerCase $reg, $wrk
$label  CMP     $reg, #"A"
        RSBGES  $wrk, $reg, #"Z"        ; inverse compare
        ADDGE   $reg, $reg, #"a"-"A"
        MEND

; ***********************************************************************
; ***  Uppercasing macro. Needs temp register; only uppercases a-z !  ***
; ***********************************************************************
        MACRO
$label  ASCII_UpperCase $reg, $wrk
$label  CMP     $reg, #"a"
        RSBGES  $wrk, $reg, #"z"        ; inverse compare
        SUBGE   $reg, $reg, #"a"-"A"
        MEND

; *****************************************************************
; ***  myASL - Generate an instruction which ASLs its argument  ***
; *****************************************************************
        MACRO
$label  myASL     $reg, $val, $cc
$label  MOV$cc  $reg, $reg, ASL #$val
        MEND

; *****************************************************************
; ***  myASL - Generate an instruction which ASRs its argument  ***
; *****************************************************************
        MACRO
$label  myASR     $reg, $val, $cc
$label  MOV$cc  $reg, $reg, ASR #$val
        MEND

; *********************************************************
; ***  BADDR - Put address of $dest in $reg; $dest < .  ***
; *********************************************************
        MACRO
$label  BADDR   $reg, $dest, $cond
$label  ADR$cond.L $reg, $dest
        MEND

; ****************************************************
; ***  BlankLineInFile - Helps with the            ***
; ***  generation of Hdr:SWIs and Hdr:Types        ***
; ***  cf InitialiseSWIFile, and TerminateSWIFile  ***
; ****************************************************
        MACRO
        BlankLineInFile
        [               "Name_Generator" <> ""
        =               "", 10
        ]
        MEND

; **************************************
; ***  Byte - Add byte to workspace  ***
; **************************************
        MACRO
$label  Byte    $value, $count
  [     "$label" = ""
    [   "$count" = ""
$value  # 1
  |
$value  # ($count)
    ]
  |
    [   "$value" = ""
$label  # 1
    |
$label  # ($value)
    ]
  ]
        MEND

; *********************
; ***  CallAVector  ***
; *********************
        MACRO
$label  CallAVector $cond
     [ AssemblingArthur
$label  B$cond   CallVector
     |
      [ Module
$label  B$cond  %FT10
        Push    "R8,R9"
        MOV     R8, PC
        AND     R8, R8, #3              ; just get mode bits
        EOR     R8, R8, #SVC_mode       ; eored with SVC mode
        TEQP    R8, PC
        MOV     R0, R0
        Push    R14
        MOV     R9, R10
        SWI     XOS_CallAVector
        Pull    R14
        TEQP    R8, PC
        MOV     R0, R0
        Pull    "R8,R9"
        MOV     PC, R14
10
      |
$label  LDR$cond PC, =CallVecAddr
       [ "$cond" = ""
        LTORG     ; Can't conditionally execute constants ! Use your own LTORG
       ]
      ]
     ]
        MEND

; ****************************************************
; ***  ChkKernelVersion - Call OS_ReadSysInfo (1)  ***
; ***  Stops modules from working on 2.00 kernel   ***
; ****************************************************
        MACRO
$label  ChkKernelVersion
$label  Push    "r0-r3"
        MOV     r0,#1
        SWI     XOS_ReadSysInfo
        Pull    "r0-r3"
        MEND

; ********************************************************
; ***  Chunk - Allocates and checks SWI chunk numbers  ***
; ********************************************************
        MACRO                                           ; See Hdr:ISV-SWIs for use
$name   Chunk           $value,$company,$string,$nameok
        LCLS            spaces
spaces  SETS            "                                                     "
        LCLS            swi
swi     SETS            "$company" :CC: "_" :CC: "$name" :CC: "SWI"
$swi    #               1                               ; Generate the chunk number
        ASSERT          (&$value :AND: &1FFFF) = (&40 * $swi)
        [               Name_Clash
        [               "$string" = ""
swi     SETS            "SWI_String_" :CC: "$name"
        |
swi     SETS            "SWI_String_" :CC: "$string"
        ]
        [               :DEF: $swi                      ; True if name clashes
        [               "$nameok" = ""
        !               0, "Name clash with " :CC: $swi :CC: " found!"
        ]
        |               ; Name clash found
        GBLS            $swi                            ; Use symbol table to check for unique name
$swi    SETS            "$company" :CC: "_" :CC: "$name"
        [               "$nameok" = "NameOK"
        !               0, "Name clash expected but not found!"
        ]
        ]               ; Name clash found
        ]               ; Name clash checking enabled
        [               (Name_Generator = "$company"):LOR:(Name_Generator = "*")
swi     SETS            "$name" :CC: "SWI" :CC: "_Name"
        =               "                                GBLS    "
        =               "$swi"
        =               10
swi     SETS            "$company" :CC: "_" :CC: "$name" :CC: "SWI"
        [               "$company" = "Acorn"
        =               ("$name" :CC: "SWI" :CC: "$spaces") :LEFT: 31
        =               " EQU     &"
        =               :STR: $swi
        =               10
        ]
        =               ("$name" :CC: "SWI_Base" :CC: "$spaces") :LEFT: 31
        =               " EQU     &"
swi     SETS            "&" :CC: "$value"
        =               :STR: $swi
        =               10
swi     SETS            (("$name" :CC: "SWI" :CC: "_Name" :CC: "$spaces") :LEFT: 31) :CC: " SETS    """""""""""""""""
        [               "$string" = ""
swi     SETS            "$swi" :CC: "$name" :CC: """"""""""
        |
swi     SETS            "$swi" :CC: "$string" :CC: """"""""""
        ]
        [               "$nameok" = "NameOK"
swi     SETS            (("$swi" :CC: "$spaces") :LEFT: 64) :CC: "; Possible name clash"
        |
swi     SETS            "$swi"
        ]
        =               "$swi"
        =               10, 10
        ]               ; Making a file
        MEND

; *************************************************************
; ***  ChunkM - Allocates and checks Message chunk numbers  ***
; *************************************************************
        MACRO                                           ; See Hdr:ISV-SWIs for use
$name   ChunkM          $value,$company
        LCLS            spaces
spaces  SETS            "                                                     "
        LCLS            swi
swi     SETS            "$company" :CC: "_" :CC: "$name" :CC: "Messages"
$swi    #               1
        ASSERT          (&$value :AND: &1FFFF) = (&40 * $swi)
        [               (Name_Generator = "$company") :LOR: (Name_Generator = "*")
swi     SETS            "$company" :CC: "_" :CC: "$name" :CC: "Messages"
        [               "$company" = "Acorn"
        =               ("$name" :CC: "Message" :CC: "" :CC: "$spaces") :LEFT: 31
        =               " EQU     &"
        =               :STR: $swi
        =               10
        ]
        =               ("$name" :CC: "Message" :CC: "_Base" :CC: "$spaces") :LEFT: 31
        =               " EQU     &"
swi     SETS            "&" :CC: "$value"
        =               :STR: $swi
        =               10, 10
        ]               ; Making a file
        MEND

; ***************************************************
; ***  Command - Generates a help/syntax/command  ***
; ***  block for a Module star command table      ***
; ***  Needs a variable Module_BaseAddr set       ***
; ***************************************************
        GBLA    Command_LastName ; Offset to command string within module
        MACRO
$label  Command $cmd, $max, $min, $optbits, $cmdlabel
$label
        LCLA    temp
        LCLS    cmdlab
 [ "$optbits" = ""
temp    SETA    0
 |
temp    SETA    $optbits
 ]
 [ "$cmdlabel" = ""
cmdlab  SETS    "$cmd"
 |
cmdlab  SETS    "$cmdlabel"
 ]
Command_LastName SETA .-Module_BaseAddr
        DCB     "$cmd", 0
        ALIGN
        DCD     $cmdlab._Code  -Module_BaseAddr
        DCD     ($min) + (($max) :SHL: 16) + temp
        DCD     $cmdlab._Syntax-Module_BaseAddr
        DCD     $cmdlab._Help  -Module_BaseAddr
        MEND

; **************************************************************************
; ***  ColourConv - Convert a palette entry (&BBGGRRxx) to any sensible  ***
; ***  true-colour pixel format.                                         ***
; ***  'shift' args denote bottom bit of relevant channel in output      ***
; ***  'bits' args denote number of bits in channel                      ***
; ***  'alpha' is optional constant to set alpha/transfer channel to     ***
; **************************************************************************

        MACRO
$label  ColourConv $in,$out,$tmpR,$tmpG,$tmpB,$red_shift,$red_bits,$green_shift,$green_bits,$blue_shift,$blue_bits,$alpha
        ASSERT  ($in <> $tmpR) :LAND: ($in <> $tmpG)
        ASSERT  ($tmpR <> $tmpG) :LAND: ($tmpR <> $tmpB) :LAND: ($tmpG <> $tmpB)
        ASSERT  ($out <> $tmpB)
$label  AND     $tmpR,$in,#((1<<$red_bits)-1)<<(16-$red_bits)     ; Extract R
        AND     $tmpG,$in,#((1<<$green_bits)-1)<<(24-$green_bits) ; Extract G
      [ $red_shift >= (16-$red_bits)                              ; Reposition R
        MOV     $tmpR,$tmpR,LSL #$red_shift-(16-$red_bits)
      |
        MOV     $tmpR,$tmpR,LSR #(16-$red_bits)-$red_shift
      ]
        AND     $tmpB,$in,#((1<<$blue_bits)-1)<<(32-$blue_bits)   ; Extract B
      [ $green_shift >= (24-$green_bits)                          ; Merge in G
        ORR     $out,$tmpR,$tmpG,LSL #$green_shift-(24-$green_bits)
      |
        ORR     $out,$tmpR,$tmpG,LSR #(24-$green_bits)-$green_shift
      ]
      [ $blue_shift >= (32-$blue_bits)                            ; Merge in B
        ORR     $out,$out,$tmpB,LSL #$blue_shift-(32-$blue_bits)
      |
        ORR     $out,$out,$tmpB,LSR #(32-$blue_bits)-$blue_shift
      ]
      [ "$alpha" <> ""
        ORR     $out,$out,#$alpha                                 ; Set alpha
      ]
        MEND

; ********************************************************
; ***  DEC - Decrements a register, default is by one  ***
; ********************************************************
        MACRO
$label  DEC     $reg,$by
        [ "$by" = ""
$label  SUB     $reg,$reg,#1
        |
$label  SUB     $reg,$reg,#$by
        ]
        MEND

; ***************************************************************************
; ***  DECS - Decrements a register setting the flags, default is by one  ***
; ***************************************************************************
        MACRO
$label  DECS    $reg,$by
        [ "$by" = ""
$label  SUBS    $reg,$reg,#1
        |
$label  SUBS    $reg,$reg,#$by
        ]
        MEND

; **********************************************************
; ***  DivRem - Unsigned integer division and remainder  ***
; ***  rc := ra DIV rb; ra := ra REM rb                  ***
; ***  rb preserved, rtemp corrupt                       ***
; ***  omits remainder (-> ra corrupt) if "$norem" <> "" ***
; ***  rb can be a constant if it starts with '#'        ***
; **********************************************************
        MACRO
$label  DivRem  $rc, $ra, $rb, $rtemp, $norem
$label
     [ NoARMVE
        MOV     $rtemp, $rb
        CMP     $rtemp, $ra, LSR #1
01
        MOVLS   $rtemp, $rtemp, LSL #1
        CMPLS   $rtemp, $ra, LSR #1
        BLS     %BT01
        MOV     $rc, #0
02
        CMP     $ra, $rtemp
        SUBCS   $ra, $ra, $rtemp
        ADC     $rc, $rc, $rc
        MOV     $rtemp, $rtemp, LSR #1
        CMP     $rtemp, $rb
        BCS     %BT02
     ELIF ("$rb" :LEFT: 1) == "#"
        MOV     $rtemp, $rb
        UDIV    $rc, $ra, $rtemp
      [ "$norem" == ""
        MLS     $ra, $rtemp, $rc, $ra
      ]
     |
        UDIV    $rc, $ra, $rb
      [ "$norem" == ""
        MLS     $ra, $rb, $rc, $ra
      ]
     ]
        MEND

; *********************
; ***  DoCallTable  ***
; *********************
        MACRO
$label  DoCallTable $jumpreg, $tablename, $work
$label  Push    "$work, pc"
        ADR     $work, $tablename
        LDR     lr, [$work, $jumpreg, LSL #2]
        ADD     $work, $work, lr
        STR     $work, [stack, #4]
        MOV     lr, pc ; ADR lr, %FT99 with correct mode bits
        Pull    "$work, pc"
;                0      4
        ASSERT $jumpreg <> $work
        ASSERT $jumpreg <> lr
        ASSERT $jumpreg <> pc
99 ; Return here from called routine
        MEND

; ******************************************************************************
; ***  DoFastJumpTable - Probably the fastest jump table mechanism for PIC,  ***
; ***  - a mere 4S + 2N cycles.  Jump table directly follows the macro, and  ***
; ***  is a list of offsets done by eg.  DCD routine_address-table-4. Needs  ***
; ***  only one register temp (Use lr mostly).                               ***
; ******************************************************************************
        MACRO
$label  DoFastJumpTable $jumpreg, $trash
$label  LDR     $trash, [pc, $jumpreg, LSL #2]
        ADD     pc, pc, $trash
        MEND

; ***********************************************************
; ***  DoJumpTable - Jump table preserving all registers  ***
; ***********************************************************
        MACRO
$label  DoJumpTable $jumpreg, $tablename, $work1, $work2
$label  Push    "$work1, $work2, pc"    ; pc is just a dummy reg here
        ADR     $work1, $tablename
        LDR     $work2, [$work1, $jumpreg, LSL #2]
        ADD     $work1, $work1, $work2
        STR     $work1, [stack, #8]
        Pull    "$work1, $work2, pc"
;                0       4       8
        ASSERT $jumpreg <> $work1
        ASSERT $jumpreg <> $work2
        ASSERT $jumpreg <> pc
        MEND

; ************************
; ***  DoSVCCallTable  ***
; ************************
        MACRO
$label  DoSVCCallTable $jumpreg, $tablename
$label  ADR     SVCWK1, $tablename
        LDR     SVCWK0, [SVCWK1, $jumpreg, LSL #2]
        MOV     lr, pc                  ; ADR lr, %FT99 with correct mode bits
        ADD     pc, SVCWK1, SVCWK0
        ASSERT $jumpreg <> lr
        ASSERT $jumpreg <> pc
99 ; Return here from called routine
        MEND

; ****************************************************
; ***  DoSVCJumpTable - Jump table using SVC mode  ***
; ***  temporary registers. Use with caution!      ***
; ****************************************************
        MACRO
$label  DoSVCJumpTable $jumpreg, $tablename
$label  ADR     SVCWK1, $tablename
        LDR     SVCWK0, [SVCWK1, $jumpreg, LSL #2]
        ADD     pc, SVCWK1, SVCWK0
        ASSERT $jumpreg <> lr
        ASSERT $jumpreg <> pc
        MEND

; *********************************************
; ***  Error - Generate an immediate error  ***
; *********************************************
        MACRO
$label  Error   $errno, $errstr
$label  ADR     R0, %FT01
        SWI     OS_GenerateError
01
        &       $errno
        =       "$errstr", 0
        ALIGN
        MEND

; *************************************************************
; ***  ExitSWIHandler - Exit for SWI handlers.              ***
; ***  Jump to 17M in the Sam-hacked Brazil, for installed  ***
; ***  handlers.  Do it directly if really in system        ***
; *************************************************************

SWIHandlerExit * 17*1024*1024
CallVecAddr    * SWIHandlerExit+4
        MACRO
$label  ExitSWIHandler $cond
        [ AssemblingArthur
$label  B$cond   SLVK
        |
        [ Module
$label  LDR$cond PC, =BranchToSWIExit
        |
$label  MOV$cond PC, #SWIHandlerExit
        ]
        ]
        MEND

; ****************************************************
; ***  FileType - Allocates and checks File Types  ***
; ****************************************************
        MACRO                                           ; See Hdr:ISV-Types for use
$name   FileType        $value,$company,$string
        #               -1
        [               "$string" = ""
$name   FileTypeD       $value, $company
        |
$name   FileTypeD       $value, $company, "$string"
        ]
        MEND

; ***************************************************************
; ***  FileTypeD - Allocates and checks DUPLICATE File Types  ***
; ***************************************************************
        MACRO                                           ; See Hdr:ISV-Types for use
$name   FileTypeD       $value,$company,$string
        LCLS            spaces
spaces  SETS            "                                                     "
        LCLS            type
        LCLS            actual
type    SETS            "$company" :CC: "_" :CC: "$name"
$type   #               1                               ; Generate the actual file type
        #               -1
        ASSERT          (&$value ) = ($type)
        [               "$string" = ""
        [               :LEN: "$name" <= 8
actual  SETS            "$name"
        |
actual  SETS            "FT_" :CC: "$value"
        ]
        |
        ASSERT          :LEN: "$string" <= 8
actual  SETS            "$string"
        ]
        [               Name_Clash
type    SETS            "|FileType_String_" :CC: actual :CC: "|"
        [               :DEF: $type                     ; True if name clashes
        LCLS            other
other   SETS            $type
        !               0, "*** " :CC: "$company" :CC: "_" :CC: "$name" :CC: " &" :CC: "$value" :CC: " """ :CC: actual :CC: """ CLASHES WITH " :CC: $type :CC: " &" :CC: ((:STR: $other) :RIGHT: 3) :CC: " ***"
        ]               ; Name clash found
        GBLS            $type
$type   SETS            "$company" :CC: "_" :CC: "$name"
        ]               ; Name clash checking enabled
        [               (Name_Generator = "$company"):LOR:(Name_Generator = "*")
type    SETS            "$name" :CC: "_FileType_Name"
        =               "                                GBLS    "
        =               "$type"
        =               10
        [               ((("$name" :CC: "_FileType" :CC: "$spaces") :LEFT: 32) :RIGHT: 1) = " "
        =               ("$name" :CC: "_FileType" :CC: "$spaces") :LEFT: 32
        |
        =               "$name" :CC: "_FileType" :CC: " "
        ]
        =               "EQU     &"
type    SETS            "$company" :CC: "_" :CC: "$name"
        =               :STR: $type
        =               10
        [               ((("$name" :CC: "_FileType_Name" :CC: "$spaces") :LEFT: 32) :RIGHT: 1) = " "
type    SETS            (("$name" :CC: "_FileType_Name" :CC: "$spaces") :LEFT: 32)
        |
type    SETS            "$name" :CC: "_FileType_Name" :CC: " "
        ]
type    SETS            "$type" :CC: "SETS    """"""""" :CC: actual :CC: """"""""""
type    SETS            "$type"
        =               "$type"
        =               10, 10
        ]               ; Making a file
        MEND

; ********************************************
; ***  GetIf - Conditional GET macro       ***
; ***  Call it as follows:                 ***
; ***     GetIf   <filename>, <condition>  ***
; ***     $GetConditionally                ***
; ********************************************
        GBLS    GetConditionally
        MACRO
        GetIf   $filename, $cc
      [ $cc
GetConditionally SETS " GET $filename"
      |
GetConditionally SETS "; no GET required"
      ]
        MEND

; ******************************************
; ***  Immediate - set flag if value is  ***
; ***  a valid immediate field value     ***
; ******************************************
        GBLL    immediate
        MACRO
        Immediate $var
immediate SETL  {FALSE}
        LCLA    count
        LCLA    varcopy
varcopy SETA    $var
        WHILE   count <= 30
 [ ((varcopy:SHL:count) + (varcopy:SHR:(32-count))) :AND: (:NOT: &FF) = 0
immediate SETL  {TRUE}
        MEXIT
 ]
count   SETA    count + 2
        WEND
        MEND

; ********************************************************
; ***  INC - Increments a register, default is by one  ***
; ********************************************************
        MACRO
$label  INC     $reg,$by
        [ "$by" = ""
$label  ADD     $reg,$reg,#1
        |
$label  ADD     $reg,$reg,#$by
        ]
        MEND

; ***************************************************************************
; ***  INCS - Increments a register setting the flags, default is by one  ***
; ***************************************************************************
        MACRO
$label  INCS    $reg,$by
        [ "$by" = ""
$label  ADDS    $reg,$reg,#1
        |
$label  ADDS    $reg,$reg,#$by
        ]
        MEND

; ****************************************************************
; ***  InfoWord - Generates the Info word for a command table  ***
; ****************************************************************
        MACRO
$label  InfoWord $max, $min, $optbits
$label
 [ "$optbits" = ""
        DCD     ($min) + (($max) :SHL: 16)
 |
        DCD     ($min) + (($max) :SHL: 16) + $optbits
 ]
        MEND

; ***********************************************
; ***  InitialiseSWIFile - Helps with the     ***
; ***  generation of Hdr:SWIs                 ***
; ***  cf BlankLineInFile, and TerminateFile  ***
; ***********************************************
        MACRO
        InitialiseSWIFile
        [               "Name_Generator" <> ""
        =               "        SUBT    Specific SWI definitions ==> Hdr:SWIs", 10
        =               "", 10
        =               "OldOpt  SETA    {OPT}", 10
        =               "        OPT     OptNoList+OptNoP1List", 10
        =               "", 10
        =               "        ; Generated from Hdr:ISV-SWIs", 10
        =               "        ; For the vendor """, "$Name_Generator", """", 10
        =               "", 10
        ]
        MEND

; ***********************************************
; ***  InitialiseTypesFile - Helps with the   ***
; ***  generation of Hdr:Types                ***
; ***  cf BlankLineInFile, and TerminateFile  ***
; ***********************************************
        MACRO
        InitialiseTypesFile
        [               "Name_Generator" <> ""
        =               "        SUBT    Specific File Type definitions ==> Hdr:FileTypes", 10
        =               "", 10
        =               "OldOpt  SETA    {OPT}", 10
        =               "        OPT     OptNoList+OptNoP1List", 10
        =               "", 10
        =               "        ; Generated from Hdr:ISV-Types", 10
        =               "        ; For the vendor """, "$Name_Generator", """", 10
        =               "", 10
        ]
        MEND

; ************************************************************
; ***  JumpAddress - loads a register with a full address  ***
; ***                to jump to (flags and all).           ***
; ************************************************************
        MACRO
        JumpAddress $reg,$destination,$forward
        MOV $reg, pc ; Get all the mode bits etc.
        [ "$forward" = ""
        [ ($destination-.) <> 4
        ADD $reg, $reg, #($destination-.-4)
        ]
        |
        ADD $reg, $reg, #($destination-.-4)
        ]
        MEND

; ***********************************************
; ***  LD - Load a byte or a word by knowing  ***
; ***       how big the store definition was  ***
; ***********************************************
        MACRO
$label  LD      $reg,$var,$cc
        [       ?$var = 1
$label  LDR$cc.B $reg, $var
        |
        [       ?$var = 2
        ASSERT  :LNOT: NoARMv4
$label  LDR$cc.H $reg, $var
        |
        [       ?$var = 4
$label  LDR$cc  $reg, $var
        |
        [       ?$var = 8
        ASSERT  :LNOT: NoARMP
$label  LDR$cc.D $reg, $var
        |
        !       0, "What do you think you're doing??"
        !       0, "Size of " :CC: "$var" :CC: " is " :CC: :STR: ?$var
        ]
        ]
        ]
        ]
        MEND

; ***************************************************
; ***  LDHA - Load unsigned halfword from array   ***
; ***  This macro essentially implements:         ***
; ***  LDRH$cond $dest, [$array, $index, LSL #1]  ***
; ***  Shorter code is produced if $temp = $array ***
; ***  Unsafe to use if reading                   ***
; ***  $array+($index<<1)+2 would cause an abort  ***
; ***  $array must be halfword aligned!           ***
; ***************************************************
        MACRO
$label  LDHA  $dest, $array, $index, $temp, $cond
$label
        ASSERT $dest <> $temp
        ASSERT $dest <> $array
  [ NoARMv4
        ; We can't rely on ARMv4 features (i.e. LDRH)
    [ NoUnaligned
        ; We can't use unaligned loads. Use LDRB instead.
      [ $temp = $array
        LDR$cond.B  $dest, [$array, $index, LSL #1]!
      |
        ADD$cond    $temp, $array, $index, LSL #1
        LDR$cond.B  $dest, [$temp]
      ]
        LDR$cond.B  $temp, [$temp, #1]
        ORR$cond    $dest, $dest, $temp, LSL #8
    |
        ; We can use an unaligned load
        LDR$cond    $dest, [$array, $index, LSL #1]
        MOV$cond    $dest, $dest, LSL #16
        MOV$cond    $dest, $dest, LSR #16
    ]
  |
        ; We can just use LDRH
        ; Except LDRH with a shifted offset is only supported by Thumb2 :(
        ADD$cond    $temp, $array, $index, LSL #1
        LDR$cond.H  $dest, [$temp]
  ]
        MEND

; ***************************************************
; ***  LDSHA - Load signed halfword from array    ***
; ***  This macro essentially implements:         ***
; ***  LDRSH$cond $dest, [$array, $index, LSL #1] ***
; ***  Shorter code is produced if $temp = $array ***
; ***  Unsafe to use if reading                   ***
; ***  $array+($index<<1)+2 would cause an abort  ***
; ***  $array must be halfword aligned!           ***
; ***  If $teq0 = "S" then the result will be     ***
; ***  compared with 0 (via the S bit or via TEQ, ***
; ***  i.e. the V flag won't be disturbed)        ***
; ***************************************************
        MACRO
$label  LDSHA $dest, $array, $index, $temp, $cond, $teq0
$label
        ASSERT $dest <> $temp
        ASSERT $dest <> $array
        ASSERT ("$teq0" = "") :LOR: ("$teq0" = "S")
  [ NoARMv4
        ; We can't rely on ARMv4 features (i.e. LDRSH)
    [ NoUnaligned
        ; We can't use unaligned loads. Use LDRB instead.
      [ $temp = $array
        LDR$cond.B  $dest, [$array, $index, LSL #1]!
      |
        ADD$cond    $temp, $array, $index, LSL #1
        LDR$cond.B  $dest, [$temp]
      ]
        LDR$cond.B  $temp, [$temp, #1]
        MOV$cond    $temp, $temp, LSL #24
        ORR$cond.$teq0 $dest, $dest, $temp, ASR #16
    |
        ; We can use an unaligned load
        LDR$cond    $dest, [$array, $index, LSL #1]
        MOV$cond    $dest, $dest, LSL #16
        MOV$cond.$teq0 $dest, $dest, ASR #16
    ]
  |
        ; We can just use LDRSH
        ; Except LDRSH with a shifted offset is only supported by Thumb2 :(
        ADD$cond    $temp, $array, $index, LSL #1
        LDR$cond.SH $dest, [$temp]
      [ "$teq0" <> ""
        TEQ$cond    $dest, #0
      ]
  ]
        MEND

; ****************************************************
; ***  LDW - Load word from unknown alignment      ***
; ***  $dest and $addr are allowed to match,       ***
; ***  otherwise all registers must differ.        ***
; ***  Now safe to use where $addr+4 would abort.  ***
; ***  No longer restricts register numbers.       ***
; ****************************************************
        MACRO
$label  LDW     $dest, $addr, $temp1, $temp2
$label
    [ NoARMv6 :LOR: NoUnaligned
        ; Mustn't use v6-only features. May or may not need to run on v6 processors.
        ; Optimised for Cortex-A8 if SupportARMv6, or for XScale if not
        ANDS    $temp1, $addr, #3
      [ SupportARMv6
        BIC     $temp2, $addr, #3
        LDREQ   $dest, [$addr]
        LDMNEIA $temp2, {$dest, $temp2}
        MOVNE   $temp1, $temp1, LSL #3
      |
        LDMNEIA $addr, {$dest, $temp2}
        MOVNE   $temp1, $temp1, LSL #3
        LDREQ   $dest, [$addr]
      ]
      [ $dest < $temp2
        MOVNE   $dest, $dest, LSR $temp1
      |
        MOVNE   $temp2, $temp2, LSR $temp1
      ]
        RSBNE   $temp1, $temp1, #32
      [ $dest < $temp2
        ORRNE   $dest, $dest, $temp2, LSL $temp1
      |
        ORRNE   $dest, $temp2, $dest, LSL $temp1
      ]
    |
        ; OK to use v6-only features
        LDR     $dest, [$addr]
    ]
        MEND

; *******************************************
; ***  LowerCase - Needs a temp register  ***
; *******************************************
        MACRO
$label  LowerCase $reg, $wrk, $nowarning
$label  CMP     $reg, #"A"
        RSBGES  $wrk, $reg, #"Z"        ; inverse compare
        CMPLT   $reg, #&c0
        RSBGES  $wrk, $reg, #&d6
        CMPLT   $reg, #&d8
        RSBGES  $wrk, $reg, #&de
        ADDGE   $reg, $reg, #"a"-"A"
        !       0, "You have used the lowercase macro. This alters top bit characters"
        !       0, "as well as A-Z. Change to uk_lowercase if you only want A-Z."
        !       0, "Use the Territory Manager for any International-aware code."
        MEND

; *****************************************************************
; ***  myLSL - Generate an instruction which LSLs its argument  ***
; *****************************************************************
        MACRO
$label  myLSL     $reg, $val, $cc
$label  MOV$cc  $reg, $reg, LSL #$val
        MEND

; *****************************************************************
; ***  myLSR - Generate an instruction which LSRs its argument  ***
; *****************************************************************
        MACRO
$label  myLSR     $reg, $val, $cc
$label  MOV$cc  $reg, $reg, LSR #$val
        MEND

; ************************
; ***  MakeErrorBlock  ***
; ************************
        MACRO
$label  MakeErrorBlock $name, $noalign
        ALIGN
$label
ErrorBlock_$name
        DCD     ErrorNumber_$name
        DCB     ErrorString_$name
        DCB     0
    [   "$noalign" = ""
        ALIGN
    ]
        MEND

; ********************************
; ***  MakeInternatErrorBlock  ***
; ********************************
; OSS This is a plug in replacement for MakeErrorBlock. The only difference is that it puts
; the error tag ($name, the macro parameter) in as the error text instead of the string.
; ECN Added $tag for those of us who don't want huge tag names
        MACRO
$label  MakeInternatErrorBlock $name, $noalign, $tag
        ALIGN
$label
ErrorBlock_$name
        DCD     ErrorNumber_$name
    [   "$tag" = ""
        DCB     "$name"
    |
        DCB     "$tag"
    ]
        DCB     0
    [   "$noalign" = ""
        ALIGN
    ]
        MEND

; *****************************************************
; ***  MakeStarSet - Generates code like            ***
; ***  StarSetText DCB "Set File$Type_FFF Text", 0  ***
; *****************************************************
        MACRO
$label  MakeStarSet $name
        LCLS    Label
        [       "$label" <> ""
$label
        |
StarSet$name
        ]
        LCLS    Value
Value   SETS    "FileType_$name"                ; "FileType_Text"
Value   SETS    (:STR: $Value) :RIGHT: 3        ; "FFF"
        DCB     "Set File$Type_$Value "
Value   SETS    "FileTypeText_$Value"           ; "FileTypeText_FFF"
        DCB     $Value, 0                       ; Read text value out
        MEND

; **********************************
; ***  MULTIPLY - rc := ra * rb  ***
; ***  NB. ra, rb corrupt        ***
; **********************************
        MACRO
$label  MULTIPLY $rc, $ra, $rb
$label  MUL     $rc, $rb, $ra ; sexy 2u version with regs in the right order
        MEND

; ***********************************************
; ***  NOP - No operation, used after a TEQP  ***
; ***********************************************
        MACRO
$label  NOP
$label  MOV     R0, R0
        MEND

; **************************************************************
; ***  Overlap - For assigning different labels to the same  ***
; ***  buffer.  Both labels have the correct ?Name value.    ***
; **************************************************************
        GBLA    OvrlpV
OvrlpV  SETA    0
        MACRO
$label  Overlap $master, $slave
        [       "$label" = ""
OvrlpV  SETA    OvrlpV + 1
        LCLS    reg
reg     SETS    "OvReg" :CC: :STR: OvrlpV
$reg    RN      :BASE:$master
        ^       :INDEX:$master, $reg
$slave  #       ?$master
        |
        !       0, "You what?"
        ]
        MEND

; *****************************************
; ***  Pull registers given in reglist  ***
; *****************************************
        MACRO
$label  Pull    $reglist, $cond, $hat
 [ {UAL}
  [ "$hat"=""
$label  POP$cond {$reglist}
  |
$label  LDMFD$cond  r13!, {$reglist}$hat
  ]
 |
        ; loop to find "-" or "," in reglist - if
        ; not we can optimise a single-register
        ; load to be faster on SA, ARM9.
        ; fails (loudly) if RLIST directive in use
        LCLS   temps
        LCLL   onereg
temps   SETS   "$reglist"
onereg  SETL   "$hat" = ""
        WHILE  onereg :LAND: :LEN: temps > 0
        [ temps :LEFT: 1 = "," :LOR: temps :LEFT: 1 = "-"
onereg  SETL   {FALSE}
        ]
temps   SETS   temps :RIGHT: (:LEN: temps - 1)
        WEND
        [ onereg
$label  LDR$cond $reglist, [r13], #4
        |
$label  LDM$cond.FD r13!, {$reglist}$hat
        ]
 ]
        MEND

; *****************************************
; ***  Push registers given in reglist  ***
; *****************************************
        MACRO
$label  Push   $reglist, $cond
 [ {UAL}
$label  PUSH$cond {$reglist}
 |
        LCLS   temps
        LCLL   onereg
temps   SETS   "$reglist"
onereg  SETL   {TRUE}
        WHILE  onereg :LAND: :LEN: temps > 0
        [ temps :LEFT: 1 = "," :LOR: temps :LEFT: 1 = "-"
onereg  SETL   {FALSE}
        ]
temps   SETS   temps :RIGHT: (:LEN: temps - 1)
        WEND
        [ onereg
$label  STR$cond $reglist, [r13, #-4]!
        |
$label  STM$cond.FD r13!, {$reglist}
        ]
 ]
        MEND

; *****************************************************************
; ***  myROR - Generate an instruction which RORs its argument  ***
; *****************************************************************
        MACRO
$label  myROR     $reg, $val, $cc
$label
        LCLA    modval
modval  SETA    ($val) :AND: &1F
        [       modval = 0
        !       0, "No code generated for ""ROR ":CC:"$reg":CC:", 0, ":CC:"$cc"""
        |
        MOV$cc  $reg, $reg, ROR #modval
        ]
        MEND

; *****************************************************************
; ***  myRRX - Generate an instruction which RRXs its argument  ***
; *****************************************************************
        MACRO
$label  myRRX     $reg, $cc
$label  MOV$cc  $reg, $reg, RRX
        MEND

; *****************************************************************************
; ***  SETBCD - Convert a number to BCD and store it in a numeric variable  ***
; *****************************************************************************
        MACRO
$var    SETBCD  $val
        LCLA    in
        LCLA    out
        LCLA    pos
in      SETA    $val
out     SETA    0
pos     SETA    0
        WHILE   in>0
out     SETA    out + ((in :MOD: 10) :SHL: pos)
pos     SETA    pos + 4
in      SETA    in/10
        WEND
$var    SETA    out
        MEND

; ************************************************
; ***  ST - Store a byte or a word by knowing  ***
; ***       how big the store definition was   ***
; ************************************************
        MACRO
$label  ST      $reg,$var,$cc
        [       ( ?$var = 1 ) :LOR: ( ?$var = 4 )
        [       ?$var = 1
$label  STR$cc.B $reg, $var
        |
$label  STR$cc  $reg, $var
        ]
        |
        !       0, "What do you think your doing??"
        !       0, "Size of " :CC: "$var" :CC: " is " :CC: :STR: ?$var
        ]
        MEND


; ***************************************
; ***  STRIM - String immediate out.  ***
; ***************************************
        MACRO
$label  STRIM   $string
        [ :LEN: "$string" = 1
$label  SWI     XOS_WriteI+"$string"
        |
$label  SWI     XOS_WriteS
        DCB     "$string", 0
        ALIGN
        ]
        MEND

; **********************************************************
; ***  StringContains                                    ***
; ***  Label StringContains "string1","string2"          ***
; ***  Sets Label to {TRUE} if string1 contains string2  ***
; ***  or {FALSE} otherwise                              ***
; **********************************************************

        MACRO
$Answer StringContains $string,$substring
      [ (:LEN: "$string") < (:LEN: "$substring")
$Answer SETL    {FALSE}
      |
      [ ("$string" :LEFT: (:LEN:"$substring")) = "$substring"
$Answer SETL    {TRUE}
      |
        LCLS    temp
temp    SETS    ("$string" :RIGHT: ((:LEN: "$string") - 1))
$Answer StringContains  "$temp","$substring"
      ]
      ]
        MEND

; ***********************************
; ***  Swap - Swap two registers  ***
; ***********************************
        MACRO
$label  Swap    $ra, $rb, $cc
$label  EOR$cc  $ra, $ra, $rb
        EOR$cc  $rb, $ra, $rb
        EOR$cc  $ra, $ra, $rb
        MEND

; ******************************************************
; ***  TerminateFile - Helps with the                ***
; ***  generation of Hdr:SWIs and Hdr:Types          ***
; ***  cf BlankLineInSWIFile, and InitialiseSWIFile  ***
; ******************************************************
        MACRO
        TerminateFile
        [               "Name_Generator" <> ""
        =               "        OPT     OldOpt", 10
        =               "", 10
        =               "        END", 10
        ]
        MEND

; ***********************************************************************
; ***  Lowercasing macro. Needs temp register; only lowercases A-Z !  ***
; ***********************************************************************
        MACRO
$label  uk_LowerCase $reg, $wrk
$label  CMP     $reg, #"A"
        RSBGES  $wrk, $reg, #"Z"        ; inverse compare
        ADDGE   $reg, $reg, #"a"-"A"
        !       0, "You have used the uk_lowercase macro. This ONLY alters 'A-Z'."
        !       0, "Use the Territory Manager for any International-aware code."
        MEND

; ***********************************************************************
; ***  Uppercasing macro. Needs temp register; only uppercases a-z !  ***
; ***********************************************************************
        MACRO
$label  uk_UpperCase $reg, $wrk
$label  CMP     $reg, #"a"
        RSBGES  $wrk, $reg, #"z"        ; inverse compare
        SUBGE   $reg, $reg, #"a"-"A"
        !       0, "You have used the uk_uppercase macro. This ONLY alters 'a-z'."
        !       0, "Use the Territory Manager for any International-aware code."
        MEND

; ******************************************
; ***  UpperCase - Needs temp register!  ***
; ******************************************
        MACRO
$label  UpperCase $reg, $wrk, $nowarning
$label  CMP     $reg, #"a"
        RSBGES  $wrk, $reg, #"z"        ; inverse compare
        CMPLT   $reg, #&e0
        RSBGES  $wrk, $reg, #&f6
        CMPLT   $reg, #&f8
        RSBGES  $wrk, $reg, #&fe
        SUBGE   $reg, $reg, #"a"-"A"
        !       0, "You have used the uppercase macro. This alters top bit characters"
        !       0, "as well as a-z. Change to uk_uppercase if you only want a-z."
        !       0, "Use the Territory Manager for any International-aware code."
        MEND

; ***************************************************************
; ***  VoidTypesUntil - Skip over some file type allocations  ***
; ***************************************************************
        MACRO
$label  VoidTypesUntil    $newbase
        [       "$label" = ""
        LCLA    value
value   SETA    &$newbase
   ;     ASSERT  @ > value
        [       :LNOT: (@ > value)
        !       0, "@ = " :CC: (:STR: @) :CC: " - NewBase = " :CC: (:STR: value)
        ]
        [       @ = value
        !       1, "VoidTypesUntil is redundent"
        |
        ^       value
        ]
        |
        !       0, "No lable on VoidTypesUntil MACRO invocations please!"
        ]
        MEND


; **************************************
; ***  Word - Add word to workspace  ***
; **************************************
        MACRO
$label  Word    $value, $count
  [     ( ( :INDEX: @ ) :AND: 3 ) <> 0
        #       4 - ( ( :INDEX: @ ) :AND: 3 )
  ]
  [     "$label" = ""
    [   "$count" = ""
      [ "$value" = ""
      |
$value  #       4
      ]
    |
$value  #       ($count) * 4
    ]
  |
    [   "$value" = ""
$label  #       4
    |
$label  #       ($value) * 4
    ]
  ]
        MEND

; ********************************
; ***  WRLN - WriteLn a string ***
; ********************************
        MACRO
$label  WRLN    $string
$label  SWI     XOS_WriteS
        DCB     "$string", 10,13, 0
        ALIGN
        MEND

; ****************
; ***  wsaddr  ***
; ****************
        MACRO
$label  wsaddr    $reg, $object, $cc
        LCLA    value
value   SETA    :INDEX: $object
        Immediate &$value
 [ immediate
$label  ADR$cc  $reg, $object
  [ addr_verbose :AND: 1 <> 0
 ! 0,"wsaddr saved a word"
  ]
 |
$label  ADR$cc.L $reg, $object
  [ addr_verbose :AND: 2 <> 0
 ! 0,"wsaddr didn't save a word"
  ]
 ]
        MEND

; ********************************************************
; ***  XError - Generate an error from an error block  ***
; ********************************************************
        MACRO
$label  XError     $errsym, $c1, $c2
$label  ADR$c1$c2  R0,ErrorBlock_$errsym
        SETV       $c1
        MEND

; ****************************************************************************
; ***  |#| - macro for allocating workspace downwards rather than upwards  ***
; ****************************************************************************
        MACRO
$var    |#|     $bytes
 [ "$bytes" = ""
        !       1, "Syntax: [<variable>] |#| <bytes>"
        MEXIT
 ]
        #       -($bytes)
 [ "$var" <> ""
$var    #       $bytes          ; Declare correct size
        #       -($bytes)
 ]
        MEND


; ************ This section was sourced from the hdr.CVars files that
; ************ appeared to populate several source components
;
; hdr.CVars
;
; Define macros for Assembler source.
;

;**************************************************************************
; ExternVar $var
;
; Declare external C variables.
;
        MACRO
        IMPORTVar $var

        IMPORT  $var
$var._Indirect  DCD     $var
        MEND

;**************************************************************************
; GlobalVar $var
;
; Declare external C variables.
;
        MACRO
        EXPORTVar $var

        EXPORT  $var
$var._Indirect  DCD     $var
        MEND

;**************************************************************************
; LocalVar $var
;
; Access local static variables.
;
        MACRO
        LocalVar $var

$var._Indirect  DCD     $var
        MEND

;**************************************************************************
; StaticBaseFromSL $reg, $cc
;
; Set $reg to point to the base of the static data area using SL set up
; from C call.
;
        MACRO
$label  StaticBaseFromSL $reg, $cc

$label  LDR$cc  $reg, [sl, #-536]
        MEND

;**************************************************************************
; StaticBaseFromSP $reg, $cc
;
; Set $reg to point to the base of the static data area using stack frame
; placed at Mb boundary below SP by C call.
;
        MACRO
$label  StaticBaseFromSP $reg, $cc

$label  MOV$cc  $reg, sp, LSR #20
        MOV$cc  $reg, $reg, LSL #20
        LDR$cc  $reg, [$reg, #4]
        MEND

;**************************************************************************
; StaticBaseFromWP $reg, $cc
;
; Set $reg to point to the base of the static data area using private word
; contents only ie. workspace pointer.
;
        MACRO
$label  StaticBaseFromWP $reg, $pw, $cc

$label  LDR$cc  $reg, [$pw, #8]
        MEND

;**************************************************************************
; LDRVar $reg, $base, $var, $cc
;
; Load the contents of an external C variable.
;
        MACRO
$label  LDRVar  $reg, $base, $var, $cc

$label  LDR$cc  $reg, $var._Indirect
        ASSERT  $reg <> $base
        LDR$cc  $reg, [$base, $reg]
        MEND

;**************************************************************************
; STRVar $reg, $base, $var, $w1, $cc
;
; Set the contents of an external C variable.
;
        MACRO
$label  STRVar  $reg, $base, $var, $w1, $cc

$label  LDR$cc  $w1, $var._Indirect
        ASSERT  $w1 <> $base
        ASSERT  $w1 <> $reg
        STR$cc  $reg, [$base, $w1]
        MEND

;**************************************************************************
; ADRVar $reg, $base, $var, $cc
;
; Set $reg to point to the static variable $var.
;
        MACRO
$label  ADRVar  $reg, $base, $var, $cc

$label  LDR$cc  $reg, $var._Indirect
        ASSERT  $reg <> $base
        ADD$cc  $reg, $base, $reg
        MEND

        OPT OldOpt
        END
