type.fs (7125B) - raw
1 \ C compiler types 2 ?f<< /lib/str.fs 3 ?f<< /lib/arena.fs 4 ?f<< /lib/meta.fs 5 ?f<< /lib/ll.fs 6 ?f<< /comp/c/tok.fs 7 ?f<< /comp/c/glob.fs 8 9 \ When we parse a type, we can almost never write it directly to "here" because 10 \ there's always the chance that we're in the middle of a code generation op. 11 \ Therefore, we always write to an allocator, in this unit it's an Arena. 12 \ We have 2 arenas, the Permanent arena, which we never reset and the Temporary 13 \ arena, which we clear at the beginning of cc<<. 14 Arena :new const _parena \ Permanent 15 Arena :new const _tarena \ Temporary 16 17 \ Call this in between code gen so that we don't have untimely block allocs. 18 : typereserve _parena Arena :reserve _tarena Arena :reserve ; 19 20 : _err ( -- ) abort" type error" ; 21 : _assert ( f -- ) not if _err then ; 22 23 \ Forward declaration implemented below 24 alias _err typesize ( type -- size-in-bytes ) 25 alias _err printtype ( type -- ) 26 27 $0 const TYPE_VOID 28 $1 const TYPE_CHAR 29 $2 const TYPE_SHORT 30 $3 const TYPE_INT 31 $b const TYPE_UINT 32 33 0 const STORAGE_RS \ Local variables frame on RS 34 1 const STORAGE_PS \ Parameter Stack 35 2 const STORAGE_MEM \ Fixed address in memory 36 3 const STORAGE_NONE \ Fields in structs 37 \ Set by pgen and determines the storage type of new created CDecls 38 STORAGE_MEM value curstorage 39 0 value curstatic \ is current definition "static"? 40 41 : _arena curstorage STORAGE_MEM < curstatic or if _tarena else _parena then ; 42 43 8 stringlist typenames "void" "char" "short" "int" "" "" "" "" 44 45 : cdecl? ( type -- f ) $f > ; 46 47 \ CDecl flags 48 \ b0=is a struct? if 1, this is an "empty" CDecl with the name of the struct. 49 \ First field is nexttype. 50 \ b1=is a funcsig? if 1, type is func return type and name is the name of the 51 \ sig. arguments follow in nexttype. 52 \ b2=has static storage? 53 \ b3=incomplete? If 1, this is an incomplete definition. 54 struct[ CDecl 55 sfield nexttype \ a CDecl is a Linked List 56 sfield type \ a basic type. Can be a link to a CDecl 57 sfield lvl \ indirection levels (*) 58 sfield flags 59 sfield offset \ offset, in bytes, of this element within its list 60 \ if this cdecl is a function, offset contains its address. 61 sfield nbelem \ number of elements in array. 0 if not an array. 62 sfield storage \ one of the STORAGE_* consts 63 sfield args \ funcsig args 64 SZ &+ name \ name associated with this type within its list. 65 66 : :new ( name type -- cdecl ) 67 $100 SZ + _arena Arena :[ 68 here# rot> 0 , , 0 , 0 , 0 , 0 , curstorage , 0 , s, 69 _arena Arena :] drop ; 70 71 : _f? doer , does> ( self 'w ) @ swap flags and bool ; 72 : _f! doer , does> ( f self 'w ) @ over flags or swap to flags ; 73 1 _f? :struct? 1 _f! :struct! 74 2 _f? :funcsig? 2 _f! :funcsig! 75 4 _f? :static? 4 _f! :static! 76 8 _f? :incomplete? 8 _f! :incomplete! 77 : :isarg? ( self -- f ) storage STORAGE_PS = ; 78 : :isvar? ( self -- f ) storage STORAGE_RS = ; 79 : :isglobal? ( self -- f ) storage STORAGE_MEM = ; 80 : _ type dup cdecl? if :struct? else drop 0 then ; 81 : :structdot? ( self -- f ) \ is a direct Struct reference? 82 dup lvl if drop 0 else _ then ; 83 : :structarrow? ( self -- f ) \ is an indirect Struct reference? 84 dup lvl 1 = if _ else drop 0 then ; 85 : :funcptr? ( self -- f ) bi lvl 1 = | type bi cdecl? | :funcsig? and and ; 86 : :constfuncsig? ( self -- f ) bi :funcsig? | :isglobal? and ; 87 : :rettype 88 dup :funcptr? if type :rettype else dup :funcsig? _assert type then ; 89 90 \ Arrays, function signatures and struct ident "naturally" yield references. 91 : :reference? bi+ nbelem bool | :funcsig? or swap :structdot? or ; 92 : :lvl bi lvl | :reference? + ; 93 94 : :halop ( self -- operand ) dup bi offset | storage case ( self offset ) 95 STORAGE_RS = of RSP) swap +) endof 96 STORAGE_PS = of PSP+) endof 97 STORAGE_MEM = of m) endof 98 _err endcase ( self operand ) 99 swap :reference? if &) then ; 100 101 : :typesize ( self -- size ) dup lvl if drop 4 else type typesize then ; 102 103 \ Combined size of all fields in the LL. 104 : :size ( self -- size ) 105 dup :isarg? over :funcsig? or if drop CELLSZ exit then 106 r! 0 swap begin ( res cdecl ) ?dup while \ V1=self 107 tuck dup :typesize ( cdecl res cdecl n ) 108 swap nbelem 1 max * + swap llnext repeat ( res ) 109 r> :struct? if align4 then ; 110 111 : :argssize ( self -- size ) dup :funcsig? _assert args llcnt CELLSZ * ; 112 113 \ Set CDecl's offset to "off", after applying alignment checks. Then, return 114 \ offset + size. 115 : :offset! ( off self -- off+size ) 116 dup :typesize case 117 4 = of over align4# endof 118 2 = of over align2# endof 119 drop 120 endcase 121 2dup to offset :size + ; 122 123 \ Find "name" in CDecl's LL. return 0 if not found 124 : _ 2dup name s= not if llnext dup if _ then then ; 125 : :find ( name self -- cdecl ) llnext dup if _ then nip ; 126 : :find# :find dup _assert ; 127 128 : _.children begin ?dup while dup printtype ." , " llnext repeat ; 129 create _storagechars ," RPMN" 130 : :. ( self -- ) >r \ print without children 131 r@ storage _storagechars + c@ emit spc> 132 r@ offset if '+' emit r@ offset .x? spc> then 133 r@ :struct? if ." struct" else 134 '{' emit r@ type printtype '}' emit 135 r@ lvl for '*' emit next then 136 r@ name c@ if spc> r@ name stype then 137 r@ nbelem if '[' emit r@ nbelem . ']' emit then 138 r@ :funcsig? if '(' emit r@ args _.children ')' emit then rdrop ; 139 \ Because of possibilities of infinite recursion, structs are not fully 140 \ expanded in vanilla :. 141 : :.struct dup :struct? _assert dup :. ." {" llnext _.children '}' emit ; 142 143 : :export ( self -- ) 144 dup :struct? _assert \ we can only export structs 145 dup name NEXTWORD ! struct[ llnext begin ( cdecl ) 146 ?dup while 147 dup name NEXTWORD ! dup nbelem if ( cdecl ) 148 dup type typesize over nbelem * sfield' 149 else ( cdecl ) 150 dup type typesize case 151 1 = of sfieldb endof 152 2 = of sfieldw endof 153 drop sfield endcase then ( cdecl ) 154 llnext repeat ]struct ; 155 : :append ( other self -- ) 2dup :size swap to offset llappend ; 156 ]struct 157 158 \ Typedefs are dictionary entries in the "typedefs" dicts, which contain a 4b 159 \ value representing the type it aliases. 160 create typedefs 0 , 161 162 : addTypedef ( cdecl -- ) typedefs over CDecl name entry , ; 163 : findTypedef ( name -- type-or-0 ) typedefs find dup if @ then ; 164 165 create _symbols 0 , 0 c, \ non-static 166 create _ssymbols 0 , 0 c, \ static 167 168 : addSymbol ( cdecl -- ) 169 curstatic if _ssymbols else _symbols then 170 over CDecl name dup c@ ( cdecl 'dict name len ) 171 ENTRYSZ + 8 + _arena Arena :[ entry , _arena Arena :] drop ; 172 : findSymbol ( name -- cdecl-or-0 ) 173 dup _ssymbols find ?dup if nip @ else _symbols find dup if @ then then ; 174 175 : cctypes$ 0 _ssymbols ! _tarena Arena :reset ; 176 177 : ensurebasetype ( type -- type ) 178 dup cdecl? if CDecl type ensurebasetype then ; 179 : typeunsigned? ( type -- f ) ensurebasetype 8 and bool ; 180 181 :realias printtype ( type -- ) 182 dup cdecl? if CDecl :. else 183 dup typeunsigned? if ." unsigned " then 184 7 and typenames slistiter stype then ; 185 186 create _ 8 nc, 0 1 2 4 0 0 0 0 187 :realias typesize ( type -- size-in-bytes ) 188 dup cdecl? if CDecl :size else 7 and _ + c@ then ;