home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
OSK
/
EFFO
/
pd6.lzh
/
LIB
/
TILE
/
structures.f83
< prev
Wrap
Text File
|
1989-12-23
|
4KB
|
115 lines
\
\ STRUCTURE DEFINITIONS
\
\ Copyright (c) 1989 by Mikael R.K. Patel
\
\ Computer Aided Design Laboratory (CADLAB)
\ Department of Computer and Information Science
\ Linkoping University
\ S-581 83 LINKOPING
\ SWEDEN
\
\ Email: mip@ida.liu.se
\
\ Started on: 30 June 1988
\
\ Last updated on: 26 November 1989
\
\ Dependencies:
\ (forth) none
\
\ Description:
\ Allows aggregates of data to be described as structures.
\
\ Copying:
\ This program is free software; you can redistribute it and\or modify
\ it under the terms of the GNU General Public License as published by
\ the Free Software Foundation; either version 1, or (at your option)
\ any later version.
\
\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
\ GNU General Public License for more details.
\
\ You should have received a copy of the GNU General Public License
\ along with this program; see the file COPYING. If not, write to
\ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
.( Loading Structure definitions...) cr
vocabulary structures
structures definitions
0 field +size ( struct -- size) private
4 field +initiate ( struct -- initiate) private
: as ( -- struct)
' >body ( Quote next symbol and access body)
[compile] literal ; immediate ( If compiling generate a literal)
: this ( -- ptr)
last >body ; ( Access the body of the last symbol)
: initiate ( ptr struct -- )
+initiate @ ?dup ( Access initiate. code pointer)
if >r else drop then ; ( If available perform initialization)
: make ( struct -- ptr)
here dup >r ( Save pointer to instance)
over +size @ allot ( Access size and allocate memory)
swap initiate r> ; ( Perform initialization)
: new ( -- ptr)
[compile] as ( Take the next symbol, "as")
?compile make ; immediate ( And "make" an instance)
: sizeof ( -- size)
' >body +size @ ( Access size of structure)
[compile] literal ; immediate ( And make literal if compiling)
: assign ( a b -- )
[compile] sizeof ( Access size and assign instance)
?compile cmove ; immediate
: struct.type ( -- struct offset0)
create here 0 0 , 0 , ( Allocate initial struct information)
does> create make drop ; ( Create a new instance)
: bytes ( offset1 n -- offset2)
over field + ; ( Create an access field of "n" bytes)
: align ( offset1 -- offset2)
dup 1 and + ; ( Align field offset to even address)
: field ( bytes -- )
create , nil , ( Create a predefined field type)
does> @ bytes ; private ( At run-time create field names)
: struct ( -- )
[compile] sizeof bytes ; ( Create a structure sized field name)
( Initial set of field names)
1 field byte ( -- )
2 field word ( -- )
4 field long ( -- )
4 field ptr ( -- )
4 field enum ( -- )
: struct.init ( struct offset3 -- )
align over +size ! ( Assign size of structure type)
here swap +initiate ! ] ; ( And pointer to initialization code)
: struct.does ( -- )
[compile] does> ( Do what does-does)
; immediate compilation
: struct.end ( [] or [struct offset3] -- )
compiling ( Check compilation status)
if [compile] ; ( If compiling then end definition)
else swap +size ! then ; immediate ( Else assign size of structure type)
forth only