parser_expr.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; math expression parser
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5
   6 ;; set this to the address of error routine
   7 ;; note that you cannot return from it, you HAVE to abort everything
   8 ;; also note that machine stack is undefined, and SP should be set
   9 ;; to some initial value
  10 ;; "undefined" means that machine stack can contain alot of garbage,
  11 ;; but will never be underflowed
  12 ;;
  13 ;; this function is called with error code in A
  14 EXPR_ERROR_CB: defw 0
  15
  16 ;; error codes
  17 ;; expected number, but got something incomprehensible
  18 EXPR_ERR_NUMBER_EXPECTED equ 1
  19 ;; expected string, but got something incomprehensible
  20 EXPR_ERR_STRING_EXPECTED equ 2
  21 ;; expected ")", but got something strange
  22 EXPR_ERR_RPAREN_EXPECTED equ 3
  23 ;; expected ")", but got something strange
  24 EXPR_ERR_DIVISION_BY_ZERO equ 4
  25
  26 ;; offset your own error codes with this
  27 EXPR_ERR_USERDEF equ 5
  28
  29
  30 PARSE_EXPR_ERROR_A:
  31   ld    hl,(EXPR_ERROR_CB)
  32   jp    (hl)
  33
  34 PARSE_EXPR_ERROR_INT:
  35   ld    a,EXPR_ERR_NUMBER_EXPECTED
  36   jr    PARSE_EXPR_ERROR_A
  37
  38 PARSE_EXPR_ERROR_STR:
  39   ld    a,EXPR_ERR_STRING_EXPECTED
  40   jr    PARSE_EXPR_ERROR_A
  41
  42 PARSE_EXPR_ERROR_0DIV:
  43   ld    a,EXPR_ERR_DIVISION_BY_ZERO
  44   jr    PARSE_EXPR_ERROR_A
  45
  46 PARSE_EXPR_ERROR_RPAREN:
  47   ld    a,EXPR_ERR_RPAREN_EXPECTED
  48   jr    PARSE_EXPR_ERROR_A
  49
  50
  51 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  52 ;;
  53 ;; parse an integer expression
  54 ;; IN:
  55 ;;   IY: text buffer
  56 ;; OUT:
  57 ;;   IY: text buffer after the expression
  58 ;;   HL: expression value
  59 ;;   everything other (including all alternate registers) is dead
  60 ;;
  61 ;; priorities:
  62 ;;   unaries
  63 ;;   * / %
  64 ;;   + -
  65 ;;   << >>
  66 ;;
  67 PARSE_INT_EXPR:
  68   call  PARSER_SKIP_BLANKS
  69   jp    z,PARSE_EXPR_ERROR_INT
  70   ; sign for the first argument
  71   ld    c,#FF   ; use this, as we need bit 1 to be set
  72   call  BZ80ASM.SIGN
  73   jr    nz,.ccnum
  74   ld    c,a
  75   inc   iy
  76 .ccnum:
  77   push  bc
  78   ; get first operand
  79   call  .addsub
  80   ; do negate if necessary
  81   pop   bc
  82   ; check for negate
  83   bit   1,c     ; '+' has bit 1 set, '-' hasn't
  84   jr    nz,.shlshr_next
  85   ; negate HL
  86   or    a
  87   ld    de,0
  88   ex    de,hl
  89   sbc   hl,de
  90 ;; << >>
  91 .shlshr_next:
  92   ; check for operation
  93   call  PARSER_SKIP_BLANKS
  94   ret   z       ; exit on EOL
  95   ; (ix+0) and (ix+1) should be equal
  96   cp    (ix+1)
  97   ret   nz
  98   cp    '<'     ; %0011_1100
  99   jr    z,.doshift
 100   cp    '>'     ; %0011_1110
 101   ret   nz
 102 .doshift:
 103   ; get second operand
 104   push  hl
 105   push  af      ; A holds operation
 106   inc   iy      ; skip operation
 107   inc   iy      ; skip operation
 108   call  .addsub
 109   pop   af
 110   pop   de
 111   ld    c,a
 112   ; HL: number to shift
 113   ; DE: amount
 114   ;  C: operation
 115   ld    a,d
 116   or    a
 117   jr    nz,.shift_too_far
 118   ld    a,e
 119   cp    16
 120   jr    nc,.shift_too_far
 121   ld    b,a
 122 .doshift_loop:
 123   bit   1,c
 124   jr    z,.do_shl
 125   ; shr
 126   srl   h
 127   rr    l
 128   jr    .shift_next_iter
 129 .do_shl:
 130   ; shl
 131   sla   l
 132   rl    h
 133 .shift_next_iter:
 134   djnz  .doshift_loop
 135   jr    .shlshr_next
 136 .shift_too_far:
 137   ld    hl,0
 138   jr    .shlshr_next
 139
 140 ;; + -
 141 .addsub:
 142   ; get first operand
 143   call  .muldiv
 144 .addsub_next:
 145   ; check for operation
 146   call  PARSER_SKIP_BLANKS
 147   ret   z       ; exit on EOL
 148   cp    '+'     ; %0010_1011
 149   jr    z,.doaddsub
 150   cp    '-'     ; %0010_1101
 151   ret   nz
 152 .doaddsub:
 153   ; get second operand
 154   push  hl
 155   push  af      ; A holds operation
 156   inc   iy      ; skip operation
 157   call  .muldiv
 158   pop   af
 159   pop   de
 160   bit   1,a
 161   jr    z,.dosub
 162   add   hl,de
 163   jr    .addsub_next
 164 .dosub:
 165   or    a
 166   sbc   hl,de
 167   jr    .addsub_next
 168
 169 ;; * / %
 170 .muldiv:
 171   ; get first operand
 172   call  .term
 173 .muldiv_next:
 174   ; check for operation
 175   call  PARSER_SKIP_BLANKS
 176   ret   z       ; exit on EOL
 177   cp    '*'     ; %0010_1010
 178   jr    z,.domuldiv
 179   cp    '/'     ; %0010_1111
 180   jr    z,.domuldiv
 181   cp    '%'     ; %0010_0101
 182   ret   nz
 183 .domuldiv:
 184   ; get second operand
 185   push  hl
 186   push  af      ; A holds operation
 187   inc   iy      ; skip operation
 188   call  .term
 189   pop   af
 190   pop   de
 191   bit   2,a
 192   jr    z,.domul
 193   ex    af,af'  ; save operation
 194   ; div or mod
 195   ld    a,e
 196   or    d
 197   jp    z,PARSE_EXPR_ERROR_0DIV
 198   ld    bc,hl
 199   call  PARSER_UDIV_BC_DE
 200   ; was it div or mod?
 201   ex    af,af'
 202   cp    '%'
 203   jr    z,.muldiv_next  ; remainder already in hl
 204   ; division
 205   ld    hl,bc
 206   jr    .muldiv_next
 207 .domul:
 208   ld    bc,hl
 209   call  PARSER_UMUL_BC_DE
 210   jr    .muldiv_next
 211
 212 ;; parse term, also process unaries and parens
 213 .term:
 214   call  PARSER_SKIP_BLANKS
 215   jp    z,PARSE_EXPR_ERROR_INT
 216   inc   iy      ; skip operation
 217   ld    c,')'
 218   cp    '('
 219   jr    z,.term_lparen
 220   cp    '['
 221   ld    c,']'
 222   jr    z,.term_lparen
 223   cp    '~'
 224   jr    z,.term_ubitnot
 225   ; this must be number
 226   dec   iy      ; undo skip
 227   call  PARSE_NUMBER
 228   ; here we can check labels
 229   jp    c,PARSE_EXPR_ERROR_INT
 230   ret
 231
 232   ;; "("
 233 .term_lparen:
 234   ;; C contains matching rparen
 235   push  bc
 236   call  PARSE_INT_EXPR
 237   call  PARSER_SKIP_BLANKS
 238   jp    z,PARSE_EXPR_ERROR_RPAREN
 239   pop   bc
 240   cp    c
 241   jp    nz,PARSE_EXPR_ERROR_RPAREN
 242   inc   iy
 243   ret
 244
 245   ;; "~"
 246 .term_ubitnot:
 247   call  .term
 248   ld    a,h
 249   cpl
 250   ld    h,a
 251   ld    a,l
 252   cpl
 253   ld    l,a
 254   ret
 255
 256
 257 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 258 ;;
 259 ;; HL=BC*DE
 260 ;;
 261 ;; BC,DE,A,flags: dead
 262 ;;
 263 PARSER_UMUL_BC_DE:
 264   ; DEHL=BC*DE
 265   ld    hl,0
 266   ld    a,16
 267 .loop:
 268   add   hl,hl
 269   rl    e
 270   rl    d
 271   jr    nc,.skip
 272   add   hl,bc
 273   jr    nc,.skip
 274   inc   de
 275 .skip:
 276   dec   a
 277   jr    nz,.loop
 278   ret
 279
 280
 281 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 282 ;;
 283 ;; performs BC/DE
 284 ;; OUT:
 285 ;;   BC: quotient
 286 ;;   HL: remainder
 287 ;;
 288 ;; DE,A,flags: dead
 289 ;;
 290 PARSER_UDIV_BC_DE:
 291   ld    hl,0
 292   ld    a,16
 293 .loop:
 294   sll   c
 295   rl    b
 296   adc   hl,hl
 297   sbc   hl,de
 298   jr    nc,.skip
 299   add   hl,de
 300   dec   c
 301 .skip:
 302   dec   a
 303   jr    nz,.loop
 304   ret
 305
 306
 307 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 308 ;;
 309 ;; parse a string expression
 310 ;;
 311 ;; IN:
 312 ;;   IY: text buffer
 313 ;; OUT:
 314 ;;   HL: string buffer start
 315 ;;    E: parsed string length
 316 ;;   everything other (including all alternate registers) is dead
 317 ;;
 318 PARSE_STR_EXPR:
 319   call  PARSER_SKIP_BLANKS
 320   jp    z,PARSE_EXPR_ERROR_STR
 321   cp    34
 322   jr    z,.strok
 323   cp    39
 324   jp    nz,PARSE_EXPR_ERROR_STR
 325 .strok:
 326   ld    c,a  ; terminator
 327   inc   iy
 328   ld    hl,ACCS
 329   push  hl
 330 .strloop:
 331   ld    a,(iy)
 332   or    a
 333   jp    z,PARSE_EXPR_ERROR_STR
 334   inc   iy
 335   cp    c
 336   jr    z,.strdone
 337   ld    (hl),a
 338   inc   hl
 339   jr    .strloop
 340 .strdone:
 341   pop   de
 342   or    a
 343   sbc   hl,de
 344   ex    de,hl
 345   ret
 346
 347 ;; string accumulator
 348 ACCS: defs 256,0
 349
 350
 351 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 352 ;; skip blanks
 353 ;; returns current char in A
 354 ;; sets zero flag on EOL
 355 ;; IN:
 356 ;;   IY: text buffer
 357 ;; OUT:
 358 ;;   IY: text buffer at non-blank or EOL
 359 ;;    A: non-blank or EOL char
 360 ;;   zero flag is set on EOL
 361 ;;
 362 PARSER_SKIP_BLANKS:
 363   ld    a,(iy)
 364   or    a
 365   ret   z
 366   cp    13
 367   ret   z
 368   inc   iy
 369   cp    33
 370   jr    c,PARSER_SKIP_BLANKS
 371   dec   iy
 372   ; reset zero flag
 373   or    a
 374   ret