Return to struct.fs CVS log | Up to [gforth] / gforth / compat |
Added documentation for structures and object.fs Changed representation of structures from "size align" to "align size", and renamed 1 cells: to cell% etc. added %size and %alignment fixed search bug added command-line option --die-on-signal
1: \ data structures (like C structs) 2: 3: \ This file is in the public domain. NO WARRANTY. 4: 5: \ This program uses the following words 6: \ from CORE : 7: \ : 1- + swap invert and ; DOES> @ immediate drop Create rot dup , >r 8: \ r> IF ELSE THEN over chars aligned cells 2* here - allot 9: \ from CORE-EXT : 10: \ tuck pick nip 11: \ from BLOCK-EXT : 12: \ \ 13: \ from DOUBLE : 14: \ 2Constant 15: \ from EXCEPTION : 16: \ throw 17: \ from FILE : 18: \ ( 19: \ from FLOAT : 20: \ faligned floats 21: \ from FLOAT-EXT : 22: \ dfaligned dfloats sfaligned sfloats 23: \ from MEMORY : 24: \ allocate 25: 26: : nalign ( addr1 n -- addr2 ) 27: \ addr2 is the aligned version of addr1 wrt the alignment size n 28: 1- tuck + swap invert and ; 29: 30: : dofield ( -- ) 31: does> ( name execution: addr1 -- addr2 ) 32: @ + ; 33: 34: : dozerofield ( -- ) 35: immediate 36: does> ( name execution: -- ) 37: drop ; 38: 39: : create-field ( align1 offset1 align size "name" -- align2 offset2 ) 40: create rot dup , ( align1 align size offset1 ) 41: + >r nalign r> ; 42: 43: : field ( align1 offset1 align size "name" -- align2 offset2 ) 44: \ name execution: addr1 -- addr2 45: 2 pick >r \ this uglyness is just for optimizing with dozerofield 46: create-field 47: r> if \ offset<>0 48: dofield 49: else 50: dozerofield 51: then ; 52: 53: : end-struct ( align size "name" -- ) 54: over nalign \ pad size to full alignment 55: 2constant ; 56: 57: \ an empty struct 58: 1 chars 0 end-struct struct 59: 60: \ type descriptors, all ( -- align size ) 61: 1 aligned 1 cells 2constant cell% 62: 1 chars 1 chars 2constant char% 63: 1 faligned 1 floats 2constant float% 64: 1 dfaligned 1 dfloats 2constant dfloat% 65: 1 sfaligned 1 sfloats 2constant sfloat% 66: cell% 2* 2constant double% 67: 68: \ memory allocation words 69: : %alignment ( align size -- align ) 70: drop ; 71: 72: : %size ( align size -- size ) 73: nip ; 74: 75: : %align ( align size -- ) 76: drop here swap nalign here - allot ; 77: 78: : %allot ( align size -- addr ) 79: tuck %align 80: here swap allot ; 81: 82: : %allocate ( align size -- addr ior ) 83: nip allocate ; 84: 85: : %alloc ( size align -- addr ) 86: %allocate throw ;