STORE   TITLE   "Z80 BCPL Run Time System  -  Section STORE"
        GET     "HEADER"
        LAYOUT
;  The code in this module has been unashamedly stolen from NJO's storage
;  manager for the Cambridge Z80 systems.  It is called from BCPL via
;  the library functions "getvec" and "freevec", which can be found in
;  Section MLIB.
        LAYOUT
        DEF     GETVEC
        DEF     FREEVEC

        REF     MEMLO
        LAYOUT
        RELOCATABLE

        ORG     0

STORE   DEFB    'BCPL'                  ;  Entry flag for BCPL module
        DEFW    STOREE-STORE            ;  Length of module in bytes
        LAYOUT
;  GETVEC
;  ------
;
;    Allocate a vector, the size (in bytes) of which is in HL.  The result
;    is in HL, with the 'Z' flag set on success.


GETVEC  INC     HL                      ;  Get upb ...
        INC     HL                      ;  ... out of size
        RES     0,L                     ;  Force to be even
        LD      C,L                     ;  And store size ...
        LD      B,H                     ;  ... in BC
        LD      HL,MEMLO                ;  Load address of store base

GVEC0   LD      E,(HL)                  ;  Load low byte of entry
        INC     HL                      ;  Increment pointer
        LD      D,(HL)                  ;  Load high byte of entry
        BIT     0,E                     ;  Is it allocated ?
        JP      Z,GVEC2                 ;  No, so check its size

;  If we drop through here, then the block is allocated.  Check for the end
;  of the list (an allocated block of zero length).

        LD      A,E                     ;  Load low byte
        RES     0,A                     ;  Clear bottom bit
        OR      D                       ;  Zero length ?
        JP      NZ,GVEC1                ;  No, so not the end of the world

;  If we drop through here, then we have failed to allocate the vector.
;  We should return an error value, without the Z flag set.

        LD      HL,0                    ;  Return value
        LD      A,20                    ;  Non zero return code
        OR      A                       ;  Reset the Z flag
        RET                             ;  And return

GVEC1   ADD     HL,DE                   ;  Add in length
        JP      GVEC0                   ;  And loop

;  If we come here, then we have found an unallocated block.  Look to see if
;  is the right size, and if so, allocate it.

GVEC2   EX      DE,HL                   ;  Swap pointer and length
        PUSH    HL                      ;  Save length
        OR      A                       ;  Clear carry flag
        SBC     HL,BC                   ;  Compare with length wanted
        JP      NZ,GVEC4                ;  Not correct size

;  If we drop through here, then this is just the right size for our
;  requirements.

        POP     HL                      ;  Restore length
        EX      DE,HL                   ;  Swap length and pointer
        DEC     HL                      ;  Decrement pointer
        SET     0,(HL)                  ;  Mark block as allocated

GVEC3   INC     HL                      ;  Increment address
        INC     HL                      ;  Get address of first data byte
        XOR     A                       ;  Set zero return code
        RET                             ;  And return

;  If we come here, then the block wasn't exactly the right size, so we should
;  see  whether it was big enough.

GVEC4   JP      C,GVEC5                 ;  Too small, so carry on looking

;  If we drop through here, then the block is too large.  This is not the
;  end of the world, since we can extract the relevant part, and leave the
;  rest to be claimed later.

        POP     AF                      ;  Ignore stacked size
        EX      DE,HL                   ;  Set DE to size of remainder
        INC     BC                      ;  Set the "alloc" bit
        LD      (HL),B                  ;  High byte of length field
        DEC     HL                      ;  Decrement pointer
        LD      (HL),C                  ;  Low byte of length field

;  Now, update the size of the next entry, which we mark as being free.

        PUSH    HL                      ;  Save address
        ADD     HL,BC                   ;  Add in the length
        INC     HL                      ;  Get address of remainder
        DEC     DE                      ;  Decrement remainder size
        DEC     DE                      ;  And again
        LD      (HL),E                  ;  Low byte of size
        INC     HL                      ;  Increment pointer
        LD      (HL),D                  ;  High byte of size
        POP     HL                      ;  Restore pointer
        JP      GVEC3                   ;  Join common code to return result

;  If we come here, then the block was too short.  Look to see if the next
;  block is free also, and if so, merge it.

GVEC5   POP     HL                      ;  Get size again
        ADD     HL,DE                   ;  Address of next block
        INC     HL                      ;  Address of low byte
        BIT     0,(HL)                  ;  Is the block free ?
        JP      NZ,GVEC0                ;  No, so go round again

;  If we drop through here, then the next block is free as well, so we can
;  add in its length, and see if the combined block is big enough.

        PUSH    BC                      ;  Save required length
        LD      C,(HL)                  ;  Low byte of length
        INC     HL                      ;  Increment pointer
        LD      B,(HL)                  ;  High byte of length
        EX      DE,HL                   ;  Swap pointers
        LD      D,(HL)                  ;  High byte of length
        DEC     HL                      ;  Increment pointer
        LD      E,(HL)                  ;  Low byte of length
        EX      DE,HL                   ;  Swap length and pointer
        ADD     HL,BC                   ;  Add lengths together
        POP     BC                      ;  Restore the required length
        INC     HL                      ;  Increment, to take account ...
        INC     HL                      ;  ... of the length field
        EX      DE,HL                   ;  Swap length/pointer again
        LD      (HL),E                  ;  Store low byte of length
        INC     HL                      ;  Increment pointer
        LD      (HL),D                  ;  Store high byte of length
        JP      GVEC2                   ;  Retry the operation
        LAYOUT
;  FREEVEC
;  -------
;
;    Mark the vector pointed to by HL as being free.


        ALIGN

FREEVEC LD      A,L                     ;  Low byte of vector
        OR      H                       ;  Is it zero
        RET     Z                       ;  If so, return

        DEC     HL                      ;  Decrement pointer
        DEC     HL                      ;  And again
        RES     0,(HL)                  ;  Reset "alloc" bit
        RET                             ;  And return
        LAYOUT
        ALIGN
        DEFW    0                       ;  End of global list
        DEFW    0                       ;  Higest global referenced
        LAYOUT
STOREE  END


