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   ; (iy+0) and (iy+1) should be equal
  96   cp    (iy+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   inc   iy      ; skip operation part
 105   ld    bc,.addsub
 106   call  .go_down_bc
 107   ld    c,a
 108   ; HL: number to shift
 109   ; DE: amount
 110   ;  C: operation
 111   ld    a,d
 112   or    a
 113   jr    nz,.shift_too_far
 114   ld    a,e
 115   cp    16
 116   jr    nc,.shift_too_far
 117   ld    b,a
 118 .doshift_loop:
 119   bit   1,c
 120   jr    z,.do_shl
 121   ; shr
 122   srl   h
 123   rr    l
 124   jr    .shift_next_iter
 125 .do_shl:
 126   ; shl
 127   sla   l
 128   rl    h
 129 .shift_next_iter:
 130   djnz  .doshift_loop
 131   jr    .shlshr_next
 132 .shift_too_far:
 133   ld    hl,0
 134   jr    .shlshr_next
 135
 136 ;; + -
 137 .addsub:
 138   ; get first operand
 139   call  .muldiv
 140 .addsub_next:
 141   ; check for operation
 142   call  PARSER_SKIP_BLANKS
 143   ret   z       ; exit on EOL
 144   cp    '+'     ; %0010_1011
 145   jr    z,.doaddsub
 146   cp    '-'     ; %0010_1101
 147   ret   nz
 148 .doaddsub:
 149   ; get second operand
 150   ld    bc,.muldiv
 151   call  .go_down_bc
 152   bit   1,a
 153   jr    z,.dosub
 154   add   hl,de
 155   jr    .addsub_next
 156 .dosub:
 157   or    a
 158   sbc   hl,de
 159   jr    .addsub_next
 160
 161 ;; * / %
 162 .muldiv:
 163   ; get first operand
 164   call  .term
 165 .muldiv_next:
 166   ; check for operation
 167   call  PARSER_SKIP_BLANKS
 168   ret   z       ; exit on EOL
 169   cp    '*'     ; %0010_1010
 170   jr    z,.domuldiv
 171   cp    '/'     ; %0010_1111
 172   jr    z,.domuldiv
 173   cp    '%'     ; %0010_0101
 174   ret   nz
 175 .domuldiv:
 176   ; get second operand
 177   ld    bc,.term
 178   call  .go_down_bc
 179   ld    bc,hl
 180   bit   2,a
 181   jr    z,.domul
 182   ex    af,af'  ; save operation
 183   ; div or mod
 184   ld    a,e
 185   or    d
 186   jp    z,PARSE_EXPR_ERROR_0DIV
 187   call  PARSER_UDIV_BC_DE
 188   ; was it div or mod?
 189   ex    af,af'
 190   cp    '%'
 191   jr    z,.muldiv_next  ; remainder already in hl
 192   ; division
 193   ld    hl,bc
 194   jr    .muldiv_next
 195 .domul:
 196   call  PARSER_UMUL_BC_DE
 197   jr    .muldiv_next
 198
 199 ;; parse term, also process unaries and parens
 200 .term:
 201   call  PARSER_SKIP_BLANKS
 202   jp    z,PARSE_EXPR_ERROR_INT
 203   inc   iy      ; skip operation
 204   ld    c,')'
 205   cp    '('
 206   jr    z,.term_lparen
 207   cp    '['
 208   ld    c,']'
 209   jr    z,.term_lparen
 210   cp    '~'
 211   jr    z,.term_ubitnot
 212   ; this must be number
 213   dec   iy      ; undo skip
 214   call  PARSE_NUMBER
 215   ; here we can check labels
 216   jp    c,PARSE_EXPR_ERROR_INT
 217   ret
 218
 219   ;; "("
 220 .term_lparen:
 221   ;; C contains matching rparen
 222   push  bc
 223   call  PARSE_INT_EXPR
 224   call  PARSER_SKIP_BLANKS
 225   jp    z,PARSE_EXPR_ERROR_RPAREN
 226   pop   bc
 227   cp    c
 228   jp    nz,PARSE_EXPR_ERROR_RPAREN
 229   inc   iy
 230   ret
 231
 232   ;; "~"
 233 .term_ubitnot:
 234   call  .term
 235   ld    a,h
 236   cpl
 237   ld    h,a
 238   ld    a,l
 239   cpl
 240   ld    l,a
 241   ret
 242
 243   ;; call subroutine at BC
 244   ;; AF: preserved
 245   ;; HL: preserved
 246   ;; DE: subroutine result
 247   ;; i.e. HL is op0, DE is op1
 248 .go_down_bc:
 249   push  hl
 250   push  af      ; A holds operation
 251   inc   iy      ; skip operation
 252   ld    hl,.go_down_bc_ret
 253   push  hl
 254   push  bc
 255   ret
 256 .go_down_bc_ret:
 257   pop   af
 258   pop   de
 259   ex    de,hl
 260   ret
 261
 262
 263 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 264 ;;
 265 ;; HL=BC*DE
 266 ;;
 267 ;; BC,DE,A,flags: dead
 268 ;;
 269 PARSER_UMUL_BC_DE:
 270   ; DEHL=BC*DE
 271   ld    hl,0
 272   ld    a,16
 273 .loop:
 274   add   hl,hl
 275   rl    e
 276   rl    d
 277   jr    nc,.skip
 278   add   hl,bc
 279   jr    nc,.skip
 280   inc   de
 281 .skip:
 282   dec   a
 283   jr    nz,.loop
 284   ret
 285
 286
 287 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 288 ;;
 289 ;; performs BC/DE
 290 ;; OUT:
 291 ;;   BC: quotient
 292 ;;   HL: remainder
 293 ;;
 294 ;; DE,A,flags: dead
 295 ;;
 296 PARSER_UDIV_BC_DE:
 297   ld    hl,0
 298   ld    a,16
 299 .loop:
 300   sll   c
 301   rl    b
 302   adc   hl,hl
 303   sbc   hl,de
 304   jr    nc,.skip
 305   add   hl,de
 306   dec   c
 307 .skip:
 308   dec   a
 309   jr    nz,.loop
 310   ret
 311
 312
 313 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 314 ;;
 315 ;; parse a string expression
 316 ;;
 317 ;; IN:
 318 ;;   IY: text buffer
 319 ;; OUT:
 320 ;;   HL: string buffer start
 321 ;;    E: parsed string length
 322 ;;   everything other (including all alternate registers) is dead
 323 ;;
 324 PARSE_STR_EXPR:
 325   call  PARSER_SKIP_BLANKS
 326   jp    z,PARSE_EXPR_ERROR_STR
 327   cp    34
 328   jr    z,.strok
 329   cp    39
 330   jp    nz,PARSE_EXPR_ERROR_STR
 331 .strok:
 332   ld    c,a  ; terminator
 333   inc   iy
 334   ld    hl,ACCS
 335   push  hl
 336 .strloop:
 337   ld    a,(iy)
 338   or    a
 339   jp    z,PARSE_EXPR_ERROR_STR
 340   inc   iy
 341   cp    c
 342   jr    z,.strdone
 343   ld    (hl),a
 344   inc   hl
 345   jr    .strloop
 346 .strdone:
 347   pop   de
 348   or    a
 349   sbc   hl,de
 350   ex    de,hl
 351   ret
 352
 353 ;; string accumulator
 354 ACCS: defs 256,0
 355
 356
 357 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 358 ;; skip blanks
 359 ;; returns current char in A
 360 ;; sets zero flag on EOL
 361 ;; IN:
 362 ;;   IY: text buffer
 363 ;; OUT:
 364 ;;   IY: text buffer at non-blank or EOL
 365 ;;    A: non-blank or EOL char
 366 ;;   zero flag is set on EOL
 367 ;;
 368 PARSER_SKIP_BLANKS:
 369   ld    a,(iy)
 370   or    a
 371   ret   z
 372   cp    13
 373   ret   z
 374   inc   iy
 375   cp    33
 376   jr    c,PARSER_SKIP_BLANKS
 377   dec   iy
 378   ; reset zero flag
 379   or    a
 380   ret