Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #define bcall(x) rst 28h \ .dw x
- saveSScreen = 86ECh
- scrap=saveSScreen
- outhead=8000h
- stackhead = 8002h
- .db $BB,$6D
- .org $9D95
- ld hl,test
- ld bc,test_end-test
- call shuntingyard
- call rpn
- ld hl,scrap
- bcall(450Ah)
- bcall(452Eh)
- ret
- shuntingyard:
- ld de,scrap
- ld (outhead),de
- ld d,(scrap/256)+3
- ld (stackhead),de
- _:
- ld a,(hl)
- call +_
- cpi
- jp pe,-_
- ld hl,scrap+768
- ld de,(stackhead)
- or a
- sbc hl,de
- ld b,h
- ld c,l
- ld hl,(outhead)
- ex de,hl
- jr z,$+3
- ldir
- dec de
- xor a
- ld (de),a
- ret
- _:
- cp '.'
- jp z,num_dec
- cp 30h
- jr c,+_
- cp 3Ah
- jp c,num
- _:
- cp '('
- jp nz,+_
- ex de,hl
- ld hl,(stackhead)
- dec hl
- ld (hl),','
- dec hl
- ld (hl),a
- ld (stackhead),hl
- ex de,hl
- ret
- _:
- cp ')'
- jp nz,checkunops
- push hl
- push bc
- ld hl,scrap+768
- ld de,(stackhead)
- sbc hl,de
- jp z,ERR_Unmatched_lparens
- ld b,h
- ld c,l
- ex de,hl
- ld de,(outhead)
- ;BC is the size of the stack. Use this in case there is a missing ')' so we don't read garbage.
- ;basically search for the matching '(' while piping out the stack to the output.
- outerloop:
- ld a,(hl)
- cp '('
- jr z,parens_found
- ld a,','
- _:
- cp (hl)
- ldi
- jp po,ERR_Unmatched_lparens
- jr z,outerloop
- jp -_
- parens_found:
- inc hl
- inc hl
- ld (outhead),de
- ld (stackhead),hl
- pop bc
- pop hl
- ret
- checkunops:
- checkbinops:
- ;; if the token is an operator, then:
- ;; while there is an operator at the top of the operator stack with
- ;; greater than or equal to precedence and the operator is left associative:
- ;; pop operators from the operator stack, onto the output queue.
- ;; push the read operator onto the operator stack.
- ;;
- ;;
- push bc
- ex de,hl
- call getprecedence
- ld a,c
- pop bc
- ex de,hl
- jp c,search_function
- ;now C is the precedence, with lower bit = 1 if left-associative
- push bc
- push hl
- ld de,(stackhead)
- ld hl,scrap+768
- sbc hl,de
- ld b,h
- ld c,l
- ld hl,(outhead)
- ex de,hl
- jr z,pushop
- ;a is the precedence against which to compare
- _:
- push hl
- push bc
- push af
- ld a,(hl)
- call getprecedence
- jr c,+_
- pop hl
- ld a,h ;incoming
- cp c
- jr nz,$+4
- rra \ nop
- pop bc
- pop hl
- ;======================================================
- jr nc,pushop
- .echo "The following code only works until we have to add >1 byte tokens."
- ldi
- ldi
- jp pe,-_
- jp $+6
- _:
- pop af
- pop bc
- pop hl
- pushop:
- ld (outhead),de
- pop de
- dec hl
- ld (hl),','
- dec hl
- ld a,(de)
- ld (stackhead),hl
- ld (hl),a
- ex de,hl
- pop bc
- ret
- search_function:
- jp ERR_Func_Not_Found
- getprecedence:
- ld hl,binops
- ld b,(binops_end-binops)/2
- _:
- cp (hl)
- inc hl
- ld c,(hl)
- ret z
- inc hl
- djnz -_
- scf
- ret
- binops:
- .db 4, $01
- .db '=',$50
- .db '|',$60
- .db '&',$70
- .db '-',$81 ;right associative
- .db '+',$80 ;left associative
- .db '/',$83 ;right associative
- .db '*',$82 ;left associative
- .db '^',$85 ;right associative
- binops_end:
- num:
- ld de,(outhead)
- _:
- ldi
- jp po,+_
- ld a,(hl)
- cp '.'
- jr z,num_dec+4
- cp 30h
- jr c,+_
- cp 3Ah
- jr c,-_
- _:
- ld a,','
- ld (de),a
- inc de
- ld (outhead),de
- dec hl
- inc bc
- ret
- num_dec:
- ld de,(outhead)
- _:
- ldi
- jp po,+_
- ld a,(hl)
- cp 30h
- jr c,+_
- cp 3Ah
- jr c,-_
- _:
- cp '.'
- jp z,ERR_Syntax_00
- ld a,','
- ld (de),a
- inc de
- ld (outhead),de
- dec hl
- inc bc
- ret
- ERR_Syntax_00: ;Too many decimal points.
- ERR_Func_Not_Found:
- ERR_Unmatched_lparens:
- ret
- rpn:
- ret
- test:
- ; .db "(3.1415926535)"
- .db "(3.142+6/2-7)*3^6*3"
- test_end:
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement