expr.fs (5441B) - raw
1 \ Expression parsing and constexpr resolving 2 ?f<< /comp/c/op.fs 3 ?f<< /comp/c/type.fs 4 ?f<< /comp/c/glob.fs 5 6 : _err ( -- ) tokdbg abort" expr error" ; 7 : _assert ( f -- ) not if _err then ; 8 9 : nb) ( halop sz -- halop ) 10 case 1 = of 8b) endof 2 = of 16b) endof 4 = of 32b) endof abort" nb)" endcase ; 11 12 NULLSTR TYPE_UINT CDecl :new const UintCDecl 13 14 struct[ ExprOp 15 0 const NONE \ Nothing (probably a released W) 16 1 const CONST \ Is a constant (value in arg) 17 2 const W \ Value in W register 18 3 const CDECL 19 4 const PS \ ExprOp pushed to PS, offset in arg 20 5 const ARRAY \ ExprOp is a constant array in a Stack. arg is a pointer to it. 21 6 const REF \ & operator applied to target 22 7 const DEREF \ * operator applied to target 23 24 sfield type 25 sfield arg \ numerical arg, for PS, CONST, ARRAY 26 sfield target \ another ExprOp. for REF, DEREF 27 sfield cdecl 28 sfield lvl \ Current indirection levels to the base type 29 30 \ There can only be one ExprOp using W at once. Whenever a W ExprOp is 31 \ created, it takes the lock. If it's already taken, there's an error. 32 0 value currentW \ link to ExprOp 33 : :Wfree# currentW if abort" W is already taken!" then ; 34 35 : :new ( arg type -- eop ) SZ syspad :[ , , 0 , UintCDecl , 0 , syspad :] ; 36 : :none ( -- eop ) 0 NONE :new ; 37 : :const ( n -- eop ) CONST :new ; 38 : :W ( -- eop ) :Wfree# 0 W :new dup to currentW ; 39 : :isW? ( self -- f ) type W = ; 40 : :hasW? ( self -- f ) 41 dup :isW? if drop 1 else 42 dup target ?dup if nip :hasW? else :isW? then then ; 43 : :release ( self -- ) dup :isW? if 0 to currentW then NONE swap to type ; 44 : :>PS 45 dup :isW? _assert dup :release 46 dup, PS+ PS over to type psoff neg swap to arg ; 47 : :?freeCurrentW ( -- ) currentW ?dup if :>PS then ; 48 : :iscdecl? ( self -- f ) type CDECL = ; 49 : :isarray? ( self -- f ) type ARRAY = ; 50 create _ ," NIWCPA&*" 51 : _:. ( self -- ) 52 dup type _ + c@ emit spc> 53 dup arg .x spc> 54 dup target ?dup if '{' emit _:. '}' emit spc> then 55 dup cdecl CDecl :. spc> lvl . spc> ." W=" currentW bool . ; 56 : :. _:. nl> ; 57 : :W! ( self -- ) :Wfree# dup to currentW W swap to type ; 58 \ Copy meta information (basesz, lvl from "other" ExprOp 59 : :copymeta ( other self -- ) 60 over cdecl over to cdecl 61 swap lvl swap to lvl ; 62 : :cdecl! ( cdecl self -- ) over CDecl :lvl over to lvl to cdecl ; 63 : :& ( self -- eop ) 64 dup type DEREF = if target exit then 65 dup cdecl CDecl :reference? if exit then 66 dup :iscdecl? _assert 67 0 REF :new ( tgt eop ) 2dup :copymeta tuck to target dup to1+ lvl ; 68 : :* ( self -- eop ) 69 0 DEREF :new 2dup :copymeta tuck to target 70 dup lvl if dup to1- lvl else dup cdecl CDecl type over :cdecl! then ; 71 : :cdecl ( cdecl -- eop ) 0 CDECL :new ( cdecl eop ) tuck :cdecl! ; 72 : :basesz cdecl CDecl type typesize ; 73 : :unsigned? cdecl typeunsigned? ; 74 : :nb) ( halop self -- halop ) dup lvl if drop else :basesz nb) then ; 75 \ Never changes W, never pushes to PS 76 : :hal# ( self -- halop ) dup type case ( self ) 77 CONST = of arg i) endof 78 CDECL = of dup cdecl CDecl :halop swap :nb) endof 79 PS = of arg PSP+) endof 80 REF = of target :hal# &) 32b) endof 81 DEREF = of 82 dup target dup :isW? if :release W) &) else :hal# then ( self halop ) 83 A>) @, A) swap :nb) endof 84 abort" :hal# error" endcase ; 85 : :hal$ dup :hal# swap :release ; 86 : :>W ( self -- ) dup :isW? if drop else dup :hal# @, :W! then ; 87 : :>W$ ( self -- ) dup :>W :release ; 88 : :isconst? ( self -- f ) type CONST = ; 89 : :iszero? bi arg 0 = | :isconst? and ; 90 : :isone? bi arg 1 = | :isconst? and ; 91 : :const# dup :isconst? _assert arg ; 92 : :?>W dup :hasW? not if :?freeCurrentW then :>W ; 93 : :?>W$ dup :?>W :release ; 94 : :*n ( n self -- ) over 1 = if 2drop exit then 95 dup :isconst? if dup arg rot * swap to arg else :?>W i) *, then ; 96 : :/n ( n self -- ) over 1 = if 2drop exit then 97 dup :isconst? if dup arg rot / swap to arg else :?>W i) /mod, then ; 98 \ For pointer arithmetics, we apply the "bottom level" logic one level higher. 99 \ That is, when lvl=blvl our "arisz" is 1 (regular arithmetics), when 100 \ lvl=blvl our arisz is "basesz" (we add and subtract by chunks of the 101 \ base type), otherwise it's 4 (we deal with pointers). 102 : :*arisz ( self -- n ) \ pointer arithmetics multiplier 103 dup lvl case 104 0 = of drop 1 endof 105 1 = of :basesz endof 106 2drop 4 endcase ; 107 : :incdec ( incsz self -- ) >r 108 :?freeCurrentW r@ :*arisz * r@ :hal$ dup @, +n, r> :W! ; 109 : :toint ( self -- ) UintCDecl over to cdecl 0 swap to lvl ; 110 create _masks $ff , $ffff , 111 : :typecast ( cdecl self -- ) 112 dup :hasW? if 113 over typesize over cdecl typesize < if 114 over typesize 1- CELLSZ * _masks + @ i) &, then 115 else over typesize over cdecl typesize > if dup :?>W then then 116 over swap to@! cdecl swap ( old new ) 117 over CDecl storage over to CDecl storage 118 swap CDecl offset swap to CDecl offset ; 119 ]struct 120 121 BOPSCNT wordtbl _tbl ( a b -- n ) 122 'w + 'w - 'w * 'w / 'w mod 'w lshift 'w rshift 'w < 123 'w > 'w <= 'w >= 'w = 'w <> 'w and 'w xor 'w or 124 'w and? 'w or? 'w _err 'w _err 'w _err 'w _err 'w _err 'w _err 125 'w _err 'w _err 'w _err 'w _err 'w _err 'w _err 126 127 : applyConstBinop ( left right opid -- eop ) 128 >r swap ExprOp :const# swap ExprOp :const# _tbl r> wexec ExprOp :const ; 129 130 : expr$ psneutral ExprOp currentW ?dup if ExprOp :release then ;