Return to bitmask.fs CVS log

Up to [gforth] / gforth / asm

Annotation of gforth/asm/bitmask.fs, revision 1.1

1.1     ! pazsan      1: \ bitmask.fs Generic Bitmask compiler                                  13aug97jaw
        !             2: 
        !             3: \ This file is copyritghted by JW-Datentechnik GmbH, Munich.
        !             4: \ You have the right to use it together with GForth EC.
        !             5: \ This file may copied and redistributed if it is not altered.
        !             6: \ This is distributed without any warranty.
        !             7: \ Send comments, suggestions, additions and bugfixes to: wilke@jwdt.com
        !             8: 
        !             9: \ This is a tool for building up assemblers.
        !            10: \ In modern CPU's instrutions there are often some bitfields that
        !            11: \ sepcify a register, a addressing mode, an immediate value.
        !            12: \ A value in an instruction word might be represented in one bitfield
        !            13: \ or several bitfields.
        !            14: \ If you code it yourself, you have to think about the right shifting
        !            15: \ operators. E.g. if you want to store a 2-bit value at bit position 3
        !            16: \ you would code: ( value opcode -- opcode ) swap 3 lshift or
        !            17: \ If the value is stored at bit-position 2-3 and 5-6 it gets more difficult:
        !            18: \ ( value opcode -- opcode ) swap dup 3 and 2 lshift rot or swap 3 and 5 lshift or
        !            19: \ This is no fun! This can be created automatically by: "maskinto %bitfield".
        !            20: \ This compiles some code like above into the current definition.
        !            21: \ This code has the same stack-effect then our examples.
        !            22: \ Additional things compiled: A check whether the value could be represented
        !            23: \ by the bitfield, the area of the bitfield is cleared in the opcode.
        !            24: 
        !            25: \ Code Compliance:
        !            26: \
        !            27: \ This is for 32 bit and 64 bit systems and for GForth only.
        !            28: \ 
        !            29: 
        !            30: \ Revision Log:
        !            31: \
        !            32: \ 13aug97 Jens Wilke   Creation
        !            33: 
        !            34: decimal
        !            35: 
        !            36: : ?bitexceed ( u1 u2 -- u1 )
        !            37: \G if u1 is greater than u2 the value could not be represented in the bitfield
        !            38:   over u< ABORT" value exceeds bitfield!" ;
        !            39: 
        !            40: : bitset# ( u -- )
        !            41: \G returns the number of bits set in a cell
        !            42:   0 swap 64 0 DO dup 1 and IF swap 1+ swap THEN 1 rshift LOOP drop ;
        !            43: 
        !            44: : max/bits ( u -- u2 )
        !            45: \G returns the highes number that could be represented by u bits
        !            46:   1 swap lshift 1- ;
        !            47: 
        !            48: Variable mli   \ masked last i
        !            49: Variable mst   \ masked state
        !            50: 
        !            51: : (maskinto) ( n -- )
        !            52:   0 mst !
        !            53:   0 mli !
        !            54:   [ -1 bitset# ] literal 0
        !            55:   DO   mst @
        !            56:        IF      dup 1 and 0=
        !            57:                IF I mli @ - ?dup 
        !            58:                   IF   postpone dup max/bits mli @ lshift
        !            59:                        postpone literal postpone and postpone rot 
        !            60:                        postpone or postpone swap
        !            61:                   THEN
        !            62:                   I mli ! 0 mst !
        !            63:                THEN
        !            64:        ELSE    dup 1 and
        !            65:                IF I mli @ - ?dup
        !            66:                   IF postpone literal postpone lshift THEN
        !            67:                   I mli ! 1 mst !
        !            68:                THEN
        !            69:        THEN
        !            70:        1 rshift 
        !            71:   LOOP drop 
        !            72:   postpone drop ;
        !            73: 
        !            74: : maskinto ( <mask> )
        !            75:   name s>number drop
        !            76:   \ compile: clear maskarea
        !            77:   dup invert 
        !            78:   postpone literal postpone and postpone swap
        !            79:   \ compile: make check
        !            80:   dup bitset# max/bits
        !            81:   postpone literal postpone ?bitexceed
        !            82:   (maskinto) ; immediate
        !            83: 
        !            84: \ : test maskinto %110010 ;