Trailing-Edge
-
PDP-10 Archives
-
DEC_CMS-20_V1.0_SRC
-
cms/sources/lstmgr.bli
There are no other files named lstmgr.bli in the archive.
%TITLE 'Generalized List Manager'
MODULE LSTMGR (IDENT = '1',
%if
%bliss(bliss32)
%then
language(bliss32),
addressing_mode(external=general,
nonexternal=long_relative)
%else
language(bliss36)
%fi
) =
BEGIN
!
! COPYRIGHT (C) 1982 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY:
!
!
! ABSTRACT:
!
!
! ENVIRONMENT:
!
!
! AUTHOR: Bob Wheater, CREATION DATE:
!
! MODIFIED BY:
!
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
hdrpos, ! position at correct header block(internal)
lstadd, ! add an entry to the list
lstbeg, ! go to beginning of the list
lstclr, ! clear out all lists and release all memory
lstcur, ! return address of entry at current pointer
lstdlk, ! de-link an entry from a list
lstend, ! reset current pointer to end of list
lstini, ! Create list and first entry
lstnxt, ! advance to next entry in the list
lstpri, ! backup to prior list entry
lstrel; ! release this list
!
! INCLUDE FILES:
!
library 'XPORT:';
%if %bliss(bliss32) %then
LIBRARY 'sys$library:starlet';
%else
REQUIRE 'jsys:';
%fi
require 'BLISSX:';
require 'LSTUSR:';
require 'BUFUSR:';
!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
literal
debug = %variant eql 1,
k_max_list_id = 40 ; ! max size of list id string
!
! OWN STORAGE:
!
own
a_cur_ent: ref block[k_lst_ent_siz] field (lst_ent),
! current list entry
a_hdr_blk: ref block[k_siz_lst_hdr] field(lst_hdr),
! current header block
a_nxt_ent: ref block[k_lst_ent_siz] field (lst_ent),
! new or next list entry
a_las_hdr: ref block[k_siz_lst_hdr] field(lst_hdr),
! address of last hdr accessed
d_hdr_zon: desc_block, ! desc for hdr zone id
d_rec_lst: desc_block, ! most recently access list id
f_1st_lst_ini: initial(false), ! set when 1st list initialized
rec_lst: vector[ch$allocation(40)], ! space for above id
str_lst_chn: initial(0); ! address of start of list for
! header chain
! NOTES:
!
! OPTIMIZING FEATURES
! 1. ptr to most recently accessed list
! 2. ptr to most recently added entry to list
!
! EXTERNAL REFERENCES:
!
external routine
badbug, ! write error message and abort(ERRMSG)
%if debug %then
lib$put_output, ! debug *****
%fi
zon_bfree, ! free and individual block within a zone(BUFMGR)
zon_get, ! get memory from zone(BUFMGR)
zon_init; ! initial zone(BUFMGR)
%SBTTL 'Position at the correct header block'
ROUTINE hdrpos(ad_list_id) =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine is used to position at the correct header block and is
! only used internally within this module. The rapid access pointers are
! also updated if neccessary.
!
! FORMAL PARAMETERS:
!
! ad_list_id Address of desc pointing to list id string
!
! IMPLICIT INPUTS:
!
! d_rec_lst Descriptor of id for most recently accesssed list
!
! str_lst_chn Head of list pointer
!
! IMPLICIT OUTPUTS:
!
! a_hdr_blk current block
!
! rec_lst buffer
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! true = success
! false = failure (never)
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN
!+
! Now check for a match on most recently accessed list.
! If not find the right list.
!-
%if debug %then
lib$put_output (cat('HDRPOS: Look for ',.ad_list_id));
lib$put_output (cat('HDRPOS: Last accessed list ',d_rec_lst));
%fi
IF $str_neq(string1=.ad_list_id,string2=d_rec_lst,fill=%c' ')
THEN
BEGIN ! search for requested list
!+
! Must search the header chain in order to find the correct
! list. The header chain is linked in the forward direction
! only and resides in dynamic memory.
!-
a_hdr_blk = .str_lst_chn ;
while true do
BEGIN ! search list header chain
%if debug %then
lib$put_output (cat('HDRPOS: Comparing against ',a_hdr_blk[list_nam]));
%fi
IF $str_eql(string1=.ad_list_id,string2=a_hdr_blk[list_nam],fill=32)
THEN
BEGIN ! found match on hdr
! update rapid access pointers
$str_desc_init(descriptor=d_rec_lst,string=(40,ch$ptr(rec_lst))) ;
$str_copy(string=.ad_list_id,target=(40,.d_rec_lst[desc_ptr]));
a_las_hdr = .a_hdr_blk ;
exitloop;
END; ! found match on hdr
! advance to the next entry in the list
IF .a_hdr_blk[hfw_lnk] neq 0
THEN
a_hdr_blk = .a_hdr_blk[hfw_lnk]
ELSE
! list doesn't exist
badbug(lit('Attempt to add an entry to non-existant list')) ;
END; !search list hdr chain
END; ! search for requested list
true
END; ! end of routine hdrpos
%SBTTL 'Add an entry to the list'
GLOBAL ROUTINE lstadd(ad_list_id,add_ent) =
!++
! FUNCTIONAL DESCRIPTION:
!
! The purpose of this routine is to add an entry to the specified
! list.
!
! FORMAL PARAMETERS:
!
! ad_list_id Address of descriptor pointing to a character
! string that uniquely idenifies the list.
!
! add_ent Address of location to store the address of
! the start of this entries user area
!
! IMPLICIT INPUTS:
!
! %(/**/)%
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! true = success
! false = failure
!
! SIDE EFFECTS:
!
! %(/**/)%
!
!--
BEGIN
! peudo-code design
! start:
! point to the start of list chain.
! loop:
! if
! match
! then
! point to current list entry.
! if
! start_list = 0
! then
! obtain new block for starting entry
! zero fw and bw links
! return address of user area(true)
! obtain new block for entry
! write fw_lnk in current
! write bw_lnk in new.
! zero fw_lnk in new.
! update current pointer.
! return address of user area(true).
! else
! if fw_lnk = 0
! then
! exitloop
! use fw_lnk to advance to next link
! endloop:
!
! NOTE: Should reset current pointer after adding last entry.
! check and see if at least one list is initialized
IF not .f_1st_lst_ini
THEN
badbug(lit('List Manager not properly initialized'));
! position at right block
hdrpos(.ad_list_id);
!+
! Common code for rapid access to the list entry
!-
! Make sure previous current list pointer is at the end of the list
! in case the previous call was not a list add entry.
a_las_hdr[cur_ent] = .a_las_hdr[end_ent] ;
! get new block
IF not zon_get(k_fulwd_mem,ad_list_id,k_lst_ent_siz+.a_las_hdr[siz_usr],a_nxt_ent)
THEN
return false ;
!+
! NOTE: the list could be empty as a result of delink of the last
! entry in the list. If that is the case all the pointers
! in the header blk to the list are set to zero.
!-
IF .a_las_hdr[cur_ent] neq 0
THEN
begin ! non-empty list
! update current block links
a_cur_ent = .a_las_hdr[cur_ent] ;
a_cur_ent[fw_lnk] = .a_nxt_ent;
end ; !non-empty list
!update new block links
a_nxt_ent[fw_lnk] = 0;
IF .a_las_hdr[cur_ent] eql 0
THEN
BEGIN ! empty list previously
a_las_hdr[beg_ent] = .a_nxt_ent ;
a_nxt_ent[bw_lnk] = 0 ;
END ! empty list previously
ELSE
! non-empty list
a_nxt_ent[bw_lnk] = .a_cur_ent;
! update block header
a_las_hdr[cur_ent] = .a_nxt_ent;
a_las_hdr[end_enT] = .a_nxt_ent;
! compute the address of user area and output it
.add_ent = .a_nxt_ent + (k_lst_ent_siz * %upval) ;
! successful
true
END; ! end of routine lstadd
%SBTTL 'Set pointer to beginning of list'
GLOBAL ROUTINE lstbeg(ad_list_id,add_ent) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine starts at the beginning of the list and returns the
! address of the first entry.
!
! FORMAL PARAMETERS:
!
!
!
! IMPLICIT INPUTS:
!
! %(/**/)%
!
! IMPLICIT OUTPUTS:
!
! %(/**/)%
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!
!
! SIDE EFFECTS:
!
! %(/**/)%
!
!--
BEGIN
! peudo-code design
! start:
! point to the start of chain.
! loop:
! compare id to list_id.
! if
! match
! then
! obtain start of list value
! update current list position pointer
! return address of user area(true).
! advance to next entry in list_names chain.
! endloop:
!
! to be implemented
false
END; ! end of routine lstbeg
%SBTTL 'Clear out all lists'
GLOBAL ROUTINE lstclr =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine clears out all lists and returns all memory used.
!
! FORMAL PARAMETERS:
!
!
!
! IMPLICIT INPUTS:
!
! %(/**/)%
!
! IMPLICIT OUTPUTS:
!
! %(/**/)%
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!
!
! SIDE EFFECTS:
!
! %(/**/)%
!
!--
BEGIN
! peudo-code design
! start:
! point to start of name_list chain.
! loop:
! free the zone this list belongs to.
! if
! fw_lnk = 0
! then
! leave_loop
! else
! advance to next block,
! endloop:
! free zone containing name_list chain(true).
! to be implemented
false
END; ! end of routine lstclr
%SBTTL 'Obtain current pointer entry'
GLOBAL ROUTINE lstcur(ad_list_id,add_ent) =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine obtains the current entry in the list and returns the
! address of the user area.
!
! FORMAL PARAMETERS:
!
! ad_list_id address of desc for list id
!
! add_ent Address to store the address of the current entry
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! true = success
! false = failure, empty list
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
! position at right block
hdrpos(.ad_list_id);
! find current entry
a_cur_ent = .a_las_hdr[cur_ent];
! is an empy list possible?
IF .a_cur_ent eql 0
THEN
return false;
! compute address of user area to be returned
.add_ent = .a_cur_ent + (k_lst_ent_siz * %upval) ;
true
END;
%SBTTL 'De-link an entry from the list'
GLOBAL ROUTINE lstdlk(ad_list_id) =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine removes the current list entry from the specified list.
!
! FORMAL PARAMETERS:
!
! ad_list_id address of desc point list id string
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! true = success
! false = failure
!
! SIDE EFFECTS:
!
! The current list pointer is set to end of chain upon completion.
!
!--
BEGIN
local
priadr, ! address of prior list entry
nxtadr; ! address of next list entry
! position at correct header
hdrpos(.ad_list_id);
a_cur_ent = .a_las_hdr[cur_ent] ;
priadr = .a_cur_ent[bw_lnk] ;
nxtadr = .a_cur_ent[fw_lnk] ;
!+
! Mark this block as free
!-
IF
not zon_bfree(k_fulwd_mem,ad_list_id,k_lst_ent_siz+.a_las_hdr[siz_usr],
a_cur_ent)
THEN
badbug(lit('Unable to mark block as free (LSTDLK)')) ;
%if debug %then
lib$put_output (lit('Freed memory block successfully')) ;
%fi
! check for special case of removing the last entry
IF
.priadr eql 0 and
.nxtadr eql 0
THEN
BEGIN
a_las_hdr[cur_ent] = 0 ;
a_las_hdr[beg_ent] = 0 ;
a_las_hdr[end_ent] = 0;
return true ;
END;
! block at the head of the chain?
IF .priadr eql 0
THEN
BEGIN ! at head
a_cur_ent = .nxtadr ;
a_cur_ent[bw_lnk] = 0 ;
a_las_hdr[beg_ent] = .a_cur_ent ;
! set current to end of chain
a_las_hdr[cur_ent] = .a_las_hdr[end_ent] ;
! only one entry in chain
IF .a_cur_ent[fw_lnk] eql 0
THEN
BEGIN
a_las_hdr[end_ent] = .a_cur_ent ;
a_las_hdr[cur_ent] = .a_cur_ent ;
END;
%if debug %then
lib$put_output (lit('Returning true on lstdlk from head of chain'));
%fi
return true ;
END; ! at head
! block at end of list?
IF .nxtadr eql 0
THEN
BEGIN ! at end
a_cur_ent = .priadr ;
a_cur_ent[fw_lnk] = 0 ;
a_las_hdr[cur_ent] = .a_cur_ent ;
a_las_hdr[end_ent] = .a_cur_ent ;
! only one entry in list
IF .a_cur_ent[bw_lnk] eql 0
THEN
a_las_hdr[beg_ent] = .a_cur_ent ;
%if debug %then
lib$put_output (lit('Returning true on lstdlk from end of chain')) ;
%fi
return true ;
END; ! at end
! not at either end?
IF
.priadr neq 0 and
.nxtadr neq 0
THEN
BEGIN ! in middle
a_cur_ent = .priadr ;
a_nxt_ent = .nxtadr ;
a_cur_ent[fw_lnk] = .a_nxt_ent ;
a_nxt_ent[bw_lnk] = .a_cur_ent ;
! set current to end of list
a_las_hdr[cur_ent] = .a_las_hdr[end_ent] ;
%if debug %then
lib$put_output (lit('Returning true on lstdlk from middle')) ;
%fi
return true ;
END; ! in middle
false
END; ! end of routine
%SBTTL 'Obtain current pointer entry'
GLOBAL ROUTINE lstend(ad_list_id,add_ent) =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine resets the current pointer of the end of the list.
!
! FORMAL PARAMETERS:
!
! ad_list_id address of desc for list id
!
! add_ent Address to store the address of the current entry
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! true = success
! false = failure, empty list
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
! position at right block
hdrpos(.ad_list_id);
! find current entry
a_cur_ent = .a_las_hdr[end_ent];
a_las_hdr[cur_ent] = .a_cur_ent;
! is an empy list possible?
IF .a_cur_ent eql 0
THEN
return false;
! compute address of user area to be returned
.add_ent = .a_cur_ent + (k_lst_ent_siz * %upval) ;
true
END;
%SBTTL 'Initialize a list'
GLOBAL ROUTINE lstini(siz_usr_area,exp_max_len,ad_list_id,add_ent) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine initializes a new list.
!
! FORMAL PARAMETERS:
!
! siz_usr_area Size of the user area in fullwords.
!
! exp_max_len Expected maximum number of entries in the
! list.
!
! IMPLICIT INPUTS:
!
!
!
! IMPLICIT OUTPUTS:
!
! %(/**/)%
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! true = success
! false = failure, list already exists
!
! SIDE EFFECTS:
!
!
!
!--
BEGIN
! pseudo-code design
! start:
! if
! start of name_list chain = 0
! then
! obtain name_list chain zone.
! write first block.
! else
! point to first list block
! loop:
! if
! fw_lnk = 0
! then
! exitloop
! else
! advance to next blk.
! endloop:
! obtain new block in name_list for chain.
! update last block fw_lnk.
! write new block.
! obtain zone for this list.
! point to start of zone with current pointer
! write this block.
! return address of user area(true).
literal
k_hdr_zon_siz = ! header zone size
3 * ( ! # of blocks expected
k_siz_lst_hdr + ! size of hdr entry(fixed portion)
( 2 * ! # of variable entry/blk
ch$allocation(40))); ! exp length of variable entry
bind
d_list_id = .ad_list_id: desc_block ;
own
a_str_id, ! addres of variable blk
! to store string id
v_lst_zon_siz; ! list zone size
local
a_fwlk; ! save area for address
! of previous blocks
! forward link
! check for prior initialization of another list
IF not .f_1st_lst_ini
THEN
BEGIN ! first list to be initialized
! initialize the zone for header blocks
IF not zon_init(k_fulwd_mem,d_hdr_zon,k_hdr_zon_siz)
THEN
badbug(lit('Unable to initialize zone for list manager')) ;
END ! first list to be initialized
else
begin ! add new list
!+
! Must search the header chain in order to find the correct
! list. The header chain is linked in the forward direction
! only and resides in dynamic memory.
!-
a_hdr_blk = .str_lst_chn ;
DO BEGIN ! search list header chain
IF $str_eql(string1=.ad_list_id,string2=a_hdr_blk[list_nam],fill=32)
THEN
begin
%if debug %then
lib$put_output (lit('New list id match prior list'));
%fi
return false ;
end;
! advance to the next entry in the list, save address to write
! forward link if last block
a_fwlk = a_hdr_blk[hfw_lnk];
a_hdr_blk = .a_hdr_blk[hfw_lnk];
end
until .a_hdr_blk eql 0;
end; ! add new list
!+
! Common code.
!-
! get memory for this header block
IF not zon_get(k_fulwd_mem,d_hdr_zon,k_siz_lst_hdr,a_hdr_blk)
THEN
badbug(lit('List Manager unable to get memory for header control block')) ;
!zero forward link
a_hdr_blk[hfw_lnk] = 0;
! get memory to store list name
IF not zon_get(k_char_mem,d_hdr_zon,.d_list_id[desc_len],a_str_id)
THEN
badbug(lit('List Manager unable to get memory for list name (LSTINI)'));
$str_desc_init(descriptor=a_hdr_blk[list_nam],
string=(.d_list_id[desc_len],.a_str_id));
$str_copy(string=d_list_id,target=a_hdr_blk[list_nam]);
! compute zone size for list
v_lst_zon_siz =
.exp_max_len * ( ! number of entries expected
k_lst_ent_siz + ! size of control portion
.siz_usr_area) ; ! size of the user area
! get zone for list (use list name as zone id)
IF not zon_init(k_fulwd_mem,d_list_id,v_lst_zon_siz)
THEN
badbug(lit('List Manager is unable to get zone for list')) ;
! now get memory for first entry
IF not zon_get(k_fulwd_mem,d_list_id,k_lst_ent_siz+.siz_usr_area,
a_nxt_ent)
THEN
badbug(cat('List Manager unable to get memory for list entry' ,
'(LSTINI)')) ;
! get memory for list zone id string
IF not zon_get(k_char_mem,d_hdr_zon,d_list_id[desc_len],a_str_id)
THEN
badbug(lit('List Manager unable to get memory for list id string'));
! set up desc for this list zone id in header block
$str_desc_init(descriptor=a_hdr_blk[list_zon],
string=(.d_list_id[desc_len],.a_str_id)) ;
$str_copy(string=d_list_id,target=a_hdr_blk[list_zon]) ;
! finish updating the header block
a_hdr_blk[siz_usr] = .siz_usr_area ;
a_hdr_blk[cur_ent] = .a_nxt_ent ;
a_hdr_blk[beg_ent] = .a_nxt_ent ;
a_hdr_blk[end_ent] = .a_nxt_ent ;
! set header info in first block
a_nxt_ent[fw_lnk] = 0 ;
a_nxt_ent[bw_lnk] = 0 ;
!compute return address
.add_ent = .a_nxt_ent + (k_lst_ent_siz * %upval) ;
! set rapid access values
$str_desc_init(descriptor=d_rec_lst,string=(40,ch$ptr(rec_lst))) ;
$str_copy(string=d_list_id,target=d_rec_lst,option=truncate) ;
a_las_hdr = .a_hdr_blk ;
! final processing for new list
IF not .f_1st_lst_ini
THEN
BEGIN ! first list to be initialized
! set up start of header chain pointer
str_lst_chn = .a_hdr_blk ;
! set first list flag
f_1st_lst_ini = true ;
END ! first list to be initialized
else
begin ! add new list
! fill in previous blocks forward link
.a_fwlk = .a_hdr_blk ;
end; ! add new list
%if debug %then
lib$put_output (lit('LSTINI returning TRUE')) ;
%fi
true
END; ! end of routine lstini
%SBTTL 'Advance to next list entry'
GLOBAL ROUTINE lstnxt(ad_list_id,add_ent) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine advances to the next entry in the list and returns
! the address of the user area of that entry.
!
! FORMAL PARAMETERS:
!
! add_ent Address of user area for this entry.
!
! IMPLICIT INPUTS:
!
! %(/**/)%
!
! IMPLICIT OUTPUTS:
!
! %(/**/)%
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!
!
! SIDE EFFECTS:
!
! %(/**/)%
!
!--
BEGIN
! pseudo-code design
! start:
! point to start of name_list chain.
! loop:
! compare requested id to list_id.
! if
! match
! then
! point to current block.
! advance to next using fw_lnk.
! return address of user area(true).
! endloop:
! list not found(false).
! not yet implemented
false
END; ! end of routine lstnxt
%SBTTL 'Backup to last entry'
GLOBAL ROUTINE lstpri(ad_list_id,add_ent) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine backs up to the previous entry in the list and
! returns the address of the user area.
!
! FORMAL PARAMETERS:
!
!
!
! IMPLICIT INPUTS:
!
! %(/**/)%
!
! IMPLICIT OUTPUTS:
!
! %(/**/)%
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! true = success
! false = no prior entry - already a start of list
!
! SIDE EFFECTS:
!
! %(/**/)%
!
!--
BEGIN
! pseudo-code design
! start:
! point to start of name_list chain.
! loop:
! if
! match
! then
! access current block.
! backup using the bw_lnk.
! return address of user area(true).
! endloop:
! list not found(false).
! position at correct header
hdrpos(.ad_list_id);
! find current entry
a_cur_ent = .a_las_hdr[cur_ent];
! now backup
a_nxt_ent = .a_cur_ent[bw_lnk];
IF .a_nxt_ent eql 0
THEN
return false ;
! compute address of user area to be returned
.add_ent = .a_nxt_ent + (k_lst_ent_siz * %upval) ;
! set current to new
a_las_hdr[cur_ent] = .a_nxt_ent ;
true
END; ! end of routine lstpri
%SBTTL 'Release this list'
GLOBAL ROUTINE lstrel(ad_list_id) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine releases the list specified and all its associated
! memory.
!
! FORMAL PARAMETERS:
!
!
!
! IMPLICIT INPUTS:
!
! %(/**/)%
!
! IMPLICIT OUTPUTS:
!
! %(/**/)%
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!
!
! SIDE EFFECTS:
!
! %(/**/)%
!
!--
BEGIN
! psuedo-code design
! start:
! point to start of name_list chain.
! loop:
! compare id to name_list id
! if
! match
! then
! release the zone used by this list.
! de-link header block from name_list chain(true).
! endloop:
! list not found(false).
! not yet implemented
true
END; ! end of routine lstrel
END ! End of module
ELUDOM