\ Database design by Glen B. Haydon
decimal 1024 constant B/BUF   \ define an old word from fig-forth
\ 8 utility Forth words------------------------------
variable REC#   ( holds the current recorder number )
variable OPEN   ( points to current file descriptor )

: LAYOUT ( leave bytes/record-2, and bytes/block-1 )
    OPEN @                          ( addr of open )
    file-rec/buf                    ( addr' = 2 move down addr )
    2@ ;                            ( get addr, addr' parameters )
( Now that you replaced hard-coded constant with field name, )
( you see that it leaves  #rec/buf and "rec% %size". )

: READ ( n-th record, on stack, is made current )
                                    ( n --)
    0 MAX                           ( n )
    DUP OPEN @ file-size @        ( recno max-recno )
    < 0= IF ." FILE ERROR " QUIT THEN ( bail out on invalid rec# )
    REC# ! ;                        ( n )  \ save current recorder  number
( Thus, this word simply checks that rec# is within limits: )
: read ( n ) dup 0  open @ file-size @ within 0= abort" file error" ;
(                ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( See underlined, use exceptions where possible. They didn't exist back then. )

: RECORD ( rec# -- addr ) ( leave address of n-th record )
    LAYOUT */MOD ( rem quot = offset into the record, offset into the file )
    OPEN @ file-origin @ + ( block# ) BLOCK + ;
: ADDRESS ( rec# -- addr ) dup rec# !  RECORD ;
 ( make record current, read in, leave address )

\ 3 defining Forth words------------------------------
: DFIELD CREATE ( create a data field )
    OVER , +    ( leaves file count for this definition )
        DOES>   ( leaves address )
    @ ADDRESS + ;
( definition effect: offset length -- offset' )
( run time effect: -- addr )

: TFIELD CREATE ( create a text field )
    OVER , DUP , + ( leaves fiel count for this definiton )
        DOES>   ( leaves: addr, count )
    20 ADDRESS + SWAP ;
( definition effect: offset length -- offset' )
( run time effect: ... ??? see below )
( "20 address +" is suspicious, buffer overrun? )
( This should probably be "... does> 2@ address + swap", )
( because that way the word does leave "addr-len" pair, )
( and reuses stored information, as intended. )
( Yes, this _is_ buffer overrun, it is to be "... 2@ ..." )

struct%
  cell field file-origin
  cell field file-size ( in records )
  cell field file-rec/buf ( number of records per storage block )
  cell field file-rec-length ( record length )
end-struct file%

: FILE          ( create a named storage allocation )
    CREATE ,    ( origin block )
      1+ ,      ( number of records in file )
      DUP B/BUF OVER / * , ( # _bytes_ - NOT BYTES, RECORDS - per block )
      ,
      DOES> OPEN ! ;        ( when file name used, point to )
                            ( its descriptor parameters.    )


\ Double precision arithmetic  words------------------------------
\ Inited words------------------------------
0 2 DFIELD TAG                 ( id field )
30 TFIELD names              ( name field )
struct%
  cell% field tag
  char% 28 * field names ( "28" because we want it to fit 32 octets, low-level hack )
end-struct% rec%

rec% %size  200 ( number of records )  400 ( starting block )  FILE demo           ( file name )
( Here "file" consumes 3 cells. )
( And NOW we provide them explicitly. )
( Note, how this improves readability even if you remove all comments. )
( Actually, you can embed "%size" into "file" and have notation like "200 400 rec% file", )
( I think that it is better than above. )

( Style: Forth follows Lisp in the style in using "-" instead of "_". )
: input-name ( addr len rec# ) ( wait for name then store it in record )
    record names 28  ROT MIN CMOVE UPDATE ;
: show-name ( rec# ) record names  TYPE ; ( print name field )

: .REC ( rec# ) record  CR  dup tag @ 3 .r  2 spaces names 28 type ;

: clear-record ( rec# ) record rec% %size erase UPDATE ;

( No output is empty file, no need to special-case: )
: output  open @ file-size @  0 ?DO FORTH I .REC LOOP ENDIF cr ;

( "update" should be called _after_ you did actual update: )
: tag++ ( rec# ) record TAG 1 swap +! UPDATE ;
: rec_flush     .REC FLUSH ;

: input
    tag#+ input_name rec_flush ;
( no idea what it should do )

: dump_out 0 READ ADDRESS HEX 80 DUMP DECIMAL ;
( you must mean this: )
: dump ( rec# ) record rec% %size dump ;

demo
clear.data
output