chiark - git - mdw - ssr/blob - StraySrc/Libraries/Sapphire/sail/s/value

   1 ;
   2 ; value.s
   3 ;
   4 ; Table drive expression evaluator for TermScript
   5 ;
   6 ; © 1995 Straylight
   7 ;
   8
   9 ;----- Standard Header ------------------------------------------------------
  10
  11                 GET     libs:header
  12                 GET     libs:swis
  13
  14                 GET     libs:stream
  15
  16 ;----- External dependencies ------------------------------------------------
  17
  18 ;----- Main code ------------------------------------------------------------
  19
  20                 AREA    |Termscript$$Code|,CODE,READONLY
  21
  22 ; --- val_readExp ---
  23 ;
  24 ; On entry:     R7, R8, R9 == lookahead token
  25 ;               R10 == pointer into tokenised buffer
  26 ;               R11 == evaluation stack pointer
  27 ;               R12 == anchor pointer
  28 ;
  29 ; On exit:      R7, R8, R9 == lookahead token
  30 ;               R0, R1 == result of expression
  31 ;               R10 == moved on to first char after expression
  32 ;
  33 ; Use:          Reads an expression for the current point in the tokenised
  34 ;               file, and returns it's result. The implementation is
  35 ;               table driven and should be very fast.
  36
  37                 EXPORT  val_readExp
  38 val_readExp     ROUT
  39
  40 10val_readExp   BL      val__operand
  41                 BLCS    val__operator
  42                 BCS     val_readExp
  43
  44                 ; --- Now work out the result ---
  45
  46                 BL      val__copyRest           ;Copy rest of tokens over
  47
  48
  49                 LTORG
  50
  51 ; --- val__operand ---
  52 ;
  53 ; On entry:     R7, R8, R9 == lookahead token
  54 ;               R10 == pointer into tokenised buffer
  55 ;               R11 == evaluation stack pointer
  56 ;               R12 == anchor pointer
  57 ;
  58 ; On exit:      R0 corrupted
  59 ;               R7, R8, R9 == lookahead token
  60 ;               R10 modified appropriately
  61 ;               CS if operand found,
  62 ;               CC otherwise
  63 ;
  64 ; Use:          Reads an operand from the input, and does appropriate
  65 ;               stack like things with it.
  66
  67 val__operand    ROUT
  68
  69                 STMFD   R13!,{R14}              ;Stack registers
  70 00val__operand  CMP     R9,#'&'                 ;Start a hex number?
  71                 BEQ     %10val__operand         ;Yes -- jump ahead
  72                 CMP     R9,#'%'                 ;Start of a binary number?
  73                 BEQ     %20val__operand         ;Yes -- jump ahead
  74                 CMP     R9,#'!'                 ;An indirection operand?
  75                 CMPNE   R9,#'?'
  76                 CMPNE   R9,#'$'
  77                 BEQ     %40val__operand         ;Yes -- jump ahead
  78                 CMP     R9,#'+'                 ;Unary operator then?
  79                 CMPNE   R9,#'-'
  80                 BEQ     %50val__operand         ;Yes -- jump ahead
  81                 CMPNE   R9,#'('                 ;A nice bracket?
  82                 BEQ     %60val__operand         ;Yes -- jump ahead
  83                 SUB     R14,R9,#'0'             ;Set up for a range check
  84                 CMP     R14,#10                 ;Is it a digit?
  85                 MOVCC   R0,#0                   ;Yes -- set up accumulator
  86                 BCC     %30val__operand         ;Yes -- deal with that
  87                 B       %70val__operand         ;Assume it's an identifier
  88
  89                 ; --- Read a hex number ---
  90
  91 10val__operand  BL      getToken                ;Get another token
  92                 MOV     R0,#0                   ;The number so far
  93                 SUB     R14,R9,#'A'             ;Check if it's a letter
  94                 CMP     R14,#6                  ;But only A-F
  95                 ADDCC   R14,R14,#10             ;If so, add 10 on
  96                 SUBCS   R14,R9,#'0'             ;Otherwise check for digit
  97                 CMPCS   R14,#10                 ;Make sure it's OK
  98                 BCC     %12val__operand         ;And jump head
  99                 MOV     R0,#err_badHex          ;Point to error message
 100                 B       error_report            ;And return the error
 101
 102 11val__operand  SUB     R14,R9,#'A'             ;Check if it's a letter
 103                 CMP     R14,#6                  ;But only A-F
 104                 ADDCC   R14,R14,#10             ;If so, add 10 on
 105                 SUBCS   R14,R9,#'0'             ;Otherwise check for digit
 106                 CMPCS   R14,#10                 ;Make sure it's OK
 107                 BCS     %35val__readSimple      ;No -- that's it then
 108
 109 12val__operand  ADD     R0,R14,R0,LSL #4        ;Multiply by 16 and add digit
 110                 BL      getToken                ;Load a character
 111                 B       %11val__readSimple      ;Keep on reading more
 112
 113                 ; --- Read a binary number ---
 114
 115 20val__operand  BL      getToken                ;Get another token
 116                 MOV     R0,#0                   ;The number so far
 117                 SUB     R14,R9,#'0'             ;Set up for a range check
 118                 CMP     R14,#1                  ;Is it a digit
 119                 BLS     %22val__readSimple      ;Yes -- jump ahead
 120                 MOV     R0,#err_badBinary       ;Point to error message
 121                 B       error_report            ;And return the error
 122
 123 21val__operand  SUB     R14,R9,#'0'             ;Set up for a range check
 124                 CMP     R14,#1                  ;Is it a digit
 125                 BHI     %35val__readSimple      ;Nope -- jump ahead then
 126
 127 22val__operand  ADC     R0,R0,R0                ;Multiply by 2
 128                 BL      getToken                ;Load a character
 129                 B       %21val__readSimple      ;Keep on reading more
 130
 131                 ; --- Read a decimal number ---
 132
 133 30val__operand  SUB     R14,R9,#'0'             ;Set up for a range check
 134                 CMP     R14,#10                 ;Is it a digit
 135                 BCS     %35val__readSimple      ;Nope -- jump ahead then
 136
 137 32val__operand  ADD     R0,R0,R0,LSL #2         ;Multiply by 5
 138                 ADD     R0,R14,R0,LSL #1        ;And then by 2 (* 10)
 139                 BL      getToken                ;Load the next token
 140                 B       %30val__readSimple      ;Keep on reading more
 141
 142                 ; --- Finished reading a number ---
 143
 144 35val__operand  BL      val__stackNumber        ;Put a number on the stack
 145                 B       %90val__operand         ;Jump ahead
 146
 147                 ; --- Read an indirection operator ---
 148
 149 40val__operand  MOV     R0,#0                   ;Get the offset ready
 150                 BL      val__stackNumber        ;Put it on the stack
 151                 BL      val__stackToken         ;And put operator on too
 152                 BL      getToken                ;Get the next token
 153                 B       %00val__operand         ;Need another operand
 154
 155                 ; --- Deal with unary signs ---
 156
 157 50val__operand  CMP     R9,#'-'                 ;Is is a unary minus
 158                 BLEQ    val__stackToken         ;Yes -- put it on the stack
 159                 BL      getToken                ;Get another token
 160                 B       %00val__operand         ;Need another operand
 161
 162                 ; --- We have just read a '(' ---
 163
 164 60val__operand  BL      val__stackToken         ;Stackit immediately
 165                 BL      getToken                ;Get another token
 166                 B       %00val__operand         ;Need another operand
 167
 168                 ; --- Assume it's an identifier then ---
 169
 170 70val__operand  ADR     R1,sail_misc            ;Point to a nice block
 171                 MOV     R0,#vType_integer       ;The current variable type
 172
 173 75val__operand  SUBS    R14,R9,#'_'             ;Is it an underscore?
 174                 SUBNE   R14,R9,#'0'             ;Or a number?
 175                 CMP     R14,#10
 176                 SUBCS   R14,R9,#'A'             ;Or a capital letter?
 177                 CMPCS   R14,#26
 178                 SUBCS   R14,R9,#'a'             ;Or a lowercase letter?
 179                 CMPCS   R14,#26
 180                 STRCCB  R9,[R1],#1              ;Yes -- store it away
 181                 BLCC    getToken                ;Read the next byte
 182                 BCS     %95val_readLvalue       ;Ouch -- not an identifier
 183
 184                 CMP     R9,#'$'                 ;Is it a dollar sign?
 185                 MOVEQ   R0,#vType_string        ;It's a string now
 186                 CMPNE   R9,#'%'                 ;Or a percentage?
 187                 STREQB  R9,[R2],#1              ;Yes -- store it then
 188                 CMPNE   R9,#' '                 ;Just check for a space
 189
 190                 BNE     %75val_readLvalue       ;Go round for more
 191
 192                 MOV     R14,#0                  ;The terminator
 193                 STRB    R14,[R1],#0             ;Store that in the var name
 194                 BL      getToken                ;Read the next token ready
 195
 196                 ; --- The identifier name is in the buffer ---
 197
 198                 ADR     R1,sail_misc            ;Point to the name
 199                 BL      var_find                ;Try to find the variable
 200                 MOVCC   R0,#err_unknown         ;Not there, get the error
 201                 BCC     error_report            ;And report a possible error
 202
 203                 LDR     R1,[R0,#0]              ;Load out the variable type
 204                 LDR     R0,[R0,#4]              ;Load out the value
 205                 CMP     R1,#vType_integer       ;Is it an integer?
 206                 BLEQ    val__stackInteger       ;Yes -- stack it
 207                 BLNE    val__stackString        ;No -- it's a string then
 208
 209 90val__operand  LDMFD   R13!,{R14}              ;Load back registers
 210                 ORRS    PC,R14,#C_flag          ;We found an operand
 211
 212 95val__operand  LDMFD   R13!,{R14}              ;Load back registers
 213                 BICS    PC,R14,#C_flag          ;No operand was found
 214
 215                 LTORG
 216
 217 ; --- val__operator ---
 218 ;
 219 ; On entry:     R7, R8, R9 == lookahead token
 220 ;               R10 == pointer into tokenised buffer
 221 ;               R11 == evaluation stack pointer
 222 ;               R12 == anchor pointer
 223 ;
 224 ; On exit:      R7, R8, R9 == lookahead token
 225 ;               R10 modified appropriately
 226 ;               CS if operator found,
 227 ;               CC otherwise
 228 ;
 229 ; Use:          Reads an operator from the input, and does appropriate
 230 ;               stack like things with it.
 231
 232                 ROUT
 233
 234 val__operator   STMFD   R13!,{R14}              ;Stack registers
 235 00val__operator CMP     R9,#')'                 ;Is it a close bracket?
 236                 BEQ     %10val__operator        ;Yes -- jump ahead
 237                 ; --- Make sure we recognise it ---
 238
 239                 CMP     R9,#'!'                 ;An indirection operator?
 240                 CMPNE   R9,#'?'
 241                 CMPNE   R7,#tClass__andOp
 242                 CMPNE   R7,#tClass__orOp
 243                 CMPNE   R7,#tClass__addOp
 244                 CMPNE   R7,#tClass__multOp
 245                 CMPNE   R7,#tClass__relOp
 246                 BNE     %95val__operator        ;Nope -- just return
 247                 BL      val__stackToken         ;Stack this token
 248                 BL      getToken                ;Get another one
 249                 B       %90val__operator        ;And return success
 250
 251                 ; --- We have read a ')' ---
 252
 253                 BL      val__stackToken         ;Stack this token
 254                 BL      getToken                ;Get another one
 255                 B       %00val__operator        ;We expect another operator
 256
 257 90val__operator LDMFD   R13!,{R14}              ;Load back registers
 258                 ORRS    PC,R14,#C_flag          ;We found an operand
 259
 260 95val__operator LDMFD   R13!,{R14}              ;Load back registers
 261                 BICS    PC,R14,#C_flag          ;No operand was found
 262
 263                 LTORG
 264
 265 ;----- Workspace ------------------------------------------------------------
 266
 267 val__precTable  DCD     val__andOp-val__precTable
 268                 DCD     0
 269                 DCD     0
 270                 DCD     0
 271                 DCD     val__multOp-val__precTable
 272                 DCD     val__orOp-val__precTable
 273                 DCD     0
 274                 DCD     val__relOp-val__precTable
 275                 DCD     val__addOp-val__precTable
 276                 DCD     0
 277
 278                 ; --- The precedence tables ---
 279                 ;
 280                 ; Each byte indicates whether or not the given type of
 281                 ; toke has a higher or lower precedence than another type.
 282                 ; The order of the bytes is:
 283                 ;
 284                 ; and,-,-,-,mult,or,-,-,rel,add,-
 285
 286 val__andOp      DCB      0, 0, 0, 0,-1, 1, 0, 0,-1,-1, 0
 287 val__multOp     DCB      1, 0, 0, 0, 1, 1, 0, 0, 1, 1, 0
 288 val__orOp       DCB     -1, 0, 0, 0,-1, 0, 0, 0,-1,-1, 0
 289 val__relOp      DCB      1, 0, 0, 0,-1, 1, 0, 0, 0,-1, 0
 290 val__addOp      DCB      1, 0, 0, 0,-1, 1, 0, 0, 1, 0, 0
 291
 292 ;----- That's all, folks ----------------------------------------------------
 293
 294                 END