home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / pointer.seq < prev    next >
Encoding:
Text File  |  1991-04-16  |  3.3 KB  |  73 lines
  1. \ POINTER.SEQ   External memory allocation and management   by Tom Zimmer
  2.  
  3. \ What I need in F-PC is a way to allocate memory from a physical memory
  4. \ area, while providing a runtime way to assure no fracturing of physical
  5. \ memory occurs.
  6.  
  7. FILES DEFINITIONS
  8.  
  9. VARIABLE POINTER.SEQ
  10.  
  11. FORTH DEFINITIONS
  12.  
  13. \ BODY          +0             +2      +4            +6
  14. \               [ phy_pointer ][ link ][ size_bytes ][.....
  15.  
  16. : POINTER       ( dbl_bytes | name -- )         \ make a pointer "name"
  17.                 ( -- paragraph )                \ it's location
  18.                 160 0 DMAX                      \ at least 160 bytes
  19.                 CREATE 0 ,                      \ initialize to unallocated
  20.                 HERE  PHEAD @ ,  PHEAD !        \ link into chain
  21.                 DPARAGRAPH ,                    \ lay in size in paragraphs
  22.                 DOES> DUP>R @ 0=
  23.                 IF      ?CS: R@ 4 + @ 0 #PARS @ 0 D+ $FFFF 0 DMIN DROP
  24.                         SETBLOCK 0=
  25.                         IF      ?CS: #PARS @ + R@ ! \ install physical seg
  26.                                 R@ 4 + @ #PARS +!   \ adj total paragraphs
  27.                         THEN
  28.                 THEN    R> @ ;                  \ return physical paragraph
  29.  
  30.  RESOLVES <POINTER>             \ resolve forward reference to POINTER
  31.  
  32. : %UNPOINTER    ( cfa -- )      \ deallocate pointer given the cfa
  33.                 >BODY DUP>R @ 0<>                       \ only if non-zero
  34.                 IF      R@ @ R@ 4 + @ BOUNDS OVER
  35.                         #PARS @ SWAP ?CS: - - CMOVE-PARS
  36.                         PHEAD @
  37.                         BEGIN   DUP
  38.                         WHILE   DUP 2- @ R@ @ U>        \ if pointer is above
  39.                                 IF      R@ 4 + @ NEGATE OVER 2- +!
  40.                                                         \ adjust phy position
  41.                                 THEN
  42.                                 @
  43.                         REPEAT  DROP                    \ discard phead end
  44.                         0 R@ !                          \ clear this pointer
  45.                         R@ 4 + @ NEGATE #PARS +!        \ reduce total #pars
  46.                         ?CS: #PARS @ SETBLOCK DROP      \ adjust memory usage
  47.                 THEN    R>DROP ;
  48.  
  49. : UNPOINTER>    ( name -- )     \ deallocate a pointer name following
  50.                 ' STATE @
  51.                 IF      COMPILE (LIT) X, COMPILE %UNPOINTER
  52.                 ELSE    %UNPOINTER
  53.                 THEN    ; IMMEDIATE
  54.  
  55. : 0POINTERS     ( -- )                  \ initialize the FAR arrays
  56.                 PHEAD @                         \ beginning of pointer chain
  57.                 BEGIN   DUP                     \ while not a list end
  58.                 WHILE   0 OVER 2- !             \ clear pointer
  59.                         @                       \ indirect to next ptr
  60.                 REPEAT  DROP
  61.                 0 #PARS ! ;                     \ clear number of paragraphs
  62.                                                 \ used
  63.  
  64. : %SIZEOF!      ( dbl_bytes cfa -- )    \ set the size of pointer "cfa"
  65.                 >R DPARAGRAPH R> >BODY 4 + ! ;
  66.  
  67. : SIZEOF!>      ( dbl_bytes | name -- ) \ set size of the following pointer
  68.                 ' STATE @
  69.                 IF      COMPILE (LIT) X, COMPILE %SIZEOF!
  70.                 ELSE    %SIZEOF!
  71.                 THEN    ; IMMEDIATE
  72.  
  73.