struct-bit-slot-spec

Vocabulary

classes.struct

Definition

IN: classes.struct

TUPLE: struct-bit-slot-spec < struct-slot-spec bits signed? ;

Methods

USING: accessors alien classes.struct
classes.struct.bit-accessors classes.struct.private kernel ;

M: struct-bit-slot-spec (reader-quot)
    [ [ offset>> ] [ bits>> ] bi bit-reader ]
    [ [ signed?>> ] [ bits>> ] bi sign-extender ] bi compose
    [ >c-ptr ] prepose ;


USING: accessors alien classes.struct
classes.struct.bit-accessors classes.struct.private kernel ;

M: struct-bit-slot-spec (writer-quot)
    [ offset>> ] [ bits>> ] bi bit-writer [ >c-ptr ] prepose ;


USING: accessors classes.struct classes.struct.private kernel
math ;

M: struct-bit-slot-spec compute-slot-offset
    [ offset<< ] [ bits>> + ] 2bi ;


USING: accessors alien.c-types classes.struct
compiler.cfg.builder.alien.boxing compiler.cfg.hats
cpu.architecture kernel layouts math sequences ;

M:: struct-bit-slot-spec load-struct-component
    ( src offset rep field -- dst )
    field offset>> 8 mod
    :> start field bits>> :> bits start bits + 8 align 8 /i
    <iota> 0 ^^load-integer [| dst index |
        src offset index + int-rep uchar ^^load-memory-imm
        :> byte index 8 * start - :> shift byte shift 0 <
        [ shift neg ^^shr-imm ] [ shift ^^shl-imm ] if
        dst swap ^^or
    ] reduce bits cell-bits < [
        cell-bits bits - ^^shl-imm cell-bits bits -
        field signed?>> [ ^^sar-imm ] [ ^^shr-imm ] if
    ] when ;


USING: accessors alien.c-types classes.struct
compiler.cfg.builder.alien.boxing compiler.cfg.hats
compiler.cfg.instructions cpu.architecture kernel math
math.order sequences ;

M:: struct-bit-slot-spec store-struct-component
    ( value src offset rep field -- )
    field offset>> 8 mod
    :> start field bits>> :> bits start bits + 8 align 8 /i
    <iota> [| index |
        start index 8 * - 0 max :> low start bits + index 8 * -
        8 min :> high 1 high low - shift 1 - low shift
        :> mask src offset index +
        int-rep uchar ^^load-memory-imm mask bitnot ^^and-imm
        :> old index 8 * start - :> shift value shift 0 <
        [ shift neg ^^shl-imm ] [ shift ^^shr-imm ] if
        mask ^^and-imm old swap ^^or src offset index +
        int-rep uchar ##store-memory-imm,
    ] each ;