Return to bitmask.fs CVS log

Up to [gforth] / gforth / asm

Mega-Patch; added directories

    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 ;