?? NEWTITLE := 'NOS/VE Global File Management : Assign and Free FDE Entries' ??
MODULE gfm$file_table_manager;
?? RIGHT := 110 ??

{ PURPOSE:
{   This module contains procedures for assigning and freeing file descriptor table entries.
{
{ DESIGN:
{   File descriptors are kept in either mainframe wired or in job fixed. They are kept in
{   an array at a large offset; they are NOT part of the heap. The address of the array and
{   structures used to manage the array are defined in GFC$CONSTANTS.
{   The tables used to manage FDEs are kept in mainframe/wired/job fixed at offset
{   GFC$FDE_CONTROL_TABLE_BASE. A multi-level index structure is used to manage assignment
{   of entries.
{    o A packed array of 65535 booleans (organized as array [0 .. 1023] of words) is used
{      to manage assignment of indivual FDEs. If bit <n> of the array is FALSE, then
{      FDE number <n> is free; if bit <n> is TRUE then FDE number <n> is assigned.
{    o In order to improve search time to find an available entry, a second level
{      index (packed array [0 .. 1023] of booleans) is kept to indicate which words in
{      the lower level table have available entries. If bit <m> of this array is FALSE then
{      word <m> of the lower level table contains free entries.
{    o A first level index is maintained to indicate which words in the second level
{      index have free entries.
{    o A free entry can be located by examining 3 words; first level index word, second level index
{      word, in_use word. A hardware instruction (CNIF - convert_integer_to_float) is used
{      that will give the bit number of the first "zero" bit in a word.
{
{
{ NOTE:
{    o The table structure will support assignment of up to 262K entries. Only 65K are
{      currently used because  SFID.INDEX is only 2 bytes. Increasing this to 3 bytes
{      would cause incompatibilities.
{
{    o Create an SCL variable GFC$TEST_HARNESS to compile a standalone
{      version of this module that can be used for testing.
{

  CONST
    gfc$debug = TRUE;

?? NEWTITLE := 'Global Declarations Referenced by this MODULE', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dpp$put_critical_message
*copyc gfc$constants
*copyc gft$file_descriptor_control
*copyc gft$file_descriptor_entry
*copyc gft$file_desc_entry_p
*copyc gft$system_file_identifier
*copyc lgp$add_entry_to_system_log
*copyc mmp$assign_mass_storage
*copyc mmp$create_scratch_segment
*copyc mmp$free_pages
*copyc oss$mainframe_paged_literal
*copyc ost$status_identifier
*copyc ost$status_condition_number
*copyc ost$time
*copyc ost$heap
?? POP ??

*if $variable(gfc$test_harness declared) <> 'UNKNOWN'
{!!! start harness          * * * * * TEST HARNESS VERSION * * * * * }

*copyc clp$put_job_output
*copyc i#program_error

  PROCEDURE osp$fatal_system_error
    (    s: string ( * );
         p: ^ost$status);

    i#program_error;
  PROCEND osp$fatal_system_error;

  PROCEDURE osp$set_mainframe_sig_lock
    (VAR lock: ost$signature_lock);

    IF lock.lock_id = 0 THEN
      lock.lock_id := 1;
    ELSE
      i#program_error;
    IFEND;
  PROCEND osp$set_mainframe_sig_lock;

  PROCEDURE osp$clear_mainframe_sig_lock
    (VAR lock: ost$signature_lock);

    IF lock.lock_id = 1 THEN
      lock.lock_id := 0;
    ELSE
      i#program_error;
    IFEND;
  PROCEND osp$clear_mainframe_sig_lock;

  VAR
    verify_free_entries: boolean := FALSE,
    free_ok: integer,
    offset_freed: integer,
    pages_freed: integer,
    table_seg: integer,
    osv$page_size: integer,
    zzz_first_index_to_free: integer,
    zzz_last_index_to_free: integer;

{!! end test harness version}

*else
*copyc osp$clear_mainframe_sig_lock
*copyc osp$fatal_system_error
*copyc osp$system_error
*copyc osp$set_mainframe_sig_lock

*copyc osv$page_size
*ifend
?? OLDTITLE ??
?? NEWTITLE := 'FDE Initialization value', EJECT ??
{
{ The following table defines the initial value of a newly assigned FDE. Callers
{ of gfp$assign_fde may depend on values defined in this table. Values in the table
{ specified as "*" normally are filled in by the caller.
{
{


?? FMT (FORMAT := OFF) ??

  VAR
    initial_fde_entry: [READ, oss$mainframe_paged_literal] gft$file_descriptor_entry :=

         [*,                                      {job_lock - not locked
          [FALSE, 0],                             {monitor_interlock
          [FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE], {flags}
 {*}      [0, osc$cyber_180_model_unknown, 1980, 1, 1, 0, 0, 0, 0, 0], {global_file_name
          NIL,                                    {file hash thread
          0,                                      {attached_in_write_count
          0,                                      {attach_count
          0,                                      {open_count
          gfc$fk_unnamed_file,                    {file_kind
          *, {Random 1 .. 250}                    {file_hash
          [0, FALSE, [0, 0]],                     {segment_lock
          0,                                      {asti
          0,                                      {eoi_byte_address
          mmc$eoi_rounded,                        {eoi_state
          16384,                                  {allocation_unit_size
          16384,                                  {transfer_unit_size
          7fffffff(16),                           {file_limit  (!! is this right)
          gfc$qs_job_working_set,                 {queue_status
          0,                                      {queue_ordinal
          pmc$initialize_to_zero,                 {preset_value
          0,                                      {time last modified
          0,                                      {last_segment_number
          [0, 0],                                 {global_task_id
          0,                                      {stack_for_ring
          gfc$fm_transient_segment];              {media


?? FMT (FORMAT := ON) ??

?? OLDTITLE ??
?? NEWTITLE := 'BUILT-IN LIKE FUNCTIONS - min, max', EJECT ??

  FUNCTION [INLINE] max
    (    i: integer;
         j: integer): integer;

    IF i > j THEN
      max := i;
    ELSE
      max := j;
    IFEND;

  FUNCEND max;
?? SKIP := 4 ??

  FUNCTION [INLINE] min
    (    i: integer;
         j: integer): integer;

    IF i < j THEN
      min := i;
    ELSE
      min := j;
    IFEND;

  FUNCEND min;
?? OLDTITLE ??
?? NEWTITLE := 'free_unused_pages', EJECT ??
{
{ This routine is called to free pages assigned to file descriptors that have been freed.
{ Since file descriptors reside in wired/fixed memory, aging will never free the
{ unused pages; the only way pages get freed is to explicitly issue a MMP$FREE_PAGES
{ request to free them.
{

  PROCEDURE [INLINE] free_unused_pages
    (    control_p: ^gft$file_descriptor_control;
         free_word_index: 0 .. 1023);

    VAR
      address_to_free: ^cell,
      b64: bool64,
      end_page: integer,
      first_fde_index_to_free: gft$file_descriptor_index,
      last_fde_index_to_free: gft$file_descriptor_index,
      low_bit_index: integer,
      low_word_index: integer,
      high_bit_index: integer,
      high_word_index: integer,
      max_words_to_search: integer,
      pages_to_free: integer,
      start_page: integer,
      status: ost$status,
      stop: integer,
      word: integer,
      words_p: ^array [0 .. gfc$max_level_2_index] of integer;


{ Calculate number of IN_USE words to search for free entries. The maximum number is
{ determined by the page size and FDE size. It is necessary to search multiple words because
{ more than 64 FDEs may fit in a word.

    max_words_to_search := ((osv$page_size DIV gfc$fde_size) DIV 64) + 1;


{ Calculate the FDE index of the last FDE entry that is in use that has
{ an FDE.INDEX lower than the one just freed. Make sure not to run off the bottom
{ of the array. Terminate the search after checking a few words worth of bits;
{ exact number determined by <max_words_to_search>. Theres no since freeing
{ pages that have already been freed. NOTE: there's no tricky way to find the last "1"
{ bit in a word; keep shifting the word right until it is ODD.

    words_p := #LOC (control_p^.in_use);
    low_word_index := free_word_index - 1;
    stop := max (0, free_word_index - max_words_to_search + 1);
    WHILE (low_word_index >= stop) AND (words_p^ [low_word_index] = 0) DO
      low_word_index := low_word_index - 1;
    WHILEND;
    low_bit_index := 64;
    IF low_word_index >= stop THEN
      word := words_p^ [low_word_index];
      WHILE #SHIFT (#SHIFT (word, -1), 1) = word DO
        word := #SHIFT (word, -1);
        low_bit_index := low_bit_index - 1;
      WHILEND;
    IFEND;
    first_fde_index_to_free := low_bit_index + low_word_index * 64;


{ Calculate the FDE index of the first FDE entry that is in use that has
{ and FDE.INDEX higher than the one just freed. Make sure not to run off the top
{ of the array. Terminate the search after checking a few words worth of bits;
{ exact number determined by <max_words_to_search>.

    high_word_index := free_word_index + 1;
    stop := min (UPPERBOUND (words_p^), free_word_index + max_words_to_search - 1);
    WHILE (high_word_index <= stop) AND (words_p^ [high_word_index] = 0) DO
      high_word_index := high_word_index + 1;
    WHILEND;
    IF high_word_index > stop THEN
      high_bit_index := 0;
    ELSE
      word := -(words_p^ [high_word_index] + 1);
      #UNCHECKED_CONVERSION (word, b64);
      high_bit_index := find_zero_bit (b64);
    IFEND;
    last_fde_index_to_free := high_bit_index + high_word_index * 64 - 1;


{ Calculate addresses to be freed. Round starting and ending address to page boundaries.
{ Dont actually issue the monitor request to free pages unless there are really pages
{ to be freed.

    start_page := gfc$fde_size * first_fde_index_to_free;
    start_page := (start_page + osv$page_size - 1) DIV osv$page_size;

    end_page := gfc$fde_size * (last_fde_index_to_free + 1);
    end_page := end_page DIV osv$page_size;

    pages_to_free := end_page - start_page;

*if $variable(gfc$test_harness declared) <> 'UNKNOWN'
    {!!! start test harness code}
    IF verify_free_entries THEN
      IF words_p^ [free_word_index] <> 0 THEN
        i#program_error;
      IFEND;
      IF zzz_first_index_to_free <> first_fde_index_to_free THEN
        i#program_error;
      IFEND;
      IF zzz_last_index_to_free <> last_fde_index_to_free THEN
        i#program_error;
      IFEND;
      pages_freed := pages_to_free;
      offset_freed := start_page * osv$page_size;
    IFEND;

    pages_to_free := 0; {!!! dont actually issue the mmp$free_pages request}
    {!!! end test harness code
*ifend

    IF pages_to_free > 0 THEN
      address_to_free := #ADDRESS (1, #SEGMENT (control_p), gfc$fde_table_base + start_page * osv$page_size);
      mmp$free_pages (address_to_free, pages_to_free * osv$page_size, osc$wait, status);
    IFEND;

  PROCEND free_unused_pages;
?? OLDTITLE ??
?? TITLE := 'find_zero_bit', EJECT ??
{
{ This tricky little routine returns the bit number of the first "zero" bit in a 64-bit word
{ (or in this case a packed array of 64 booleans). The algorithm uses trick CYBIL code to convert
{ the word to an integer, then convert the integer to a REAL. The exponent portion of
{ the REAL gives the bit number of the first "zero" bit.


  FUNCTION [INLINE] find_zero_bit
    (    s64: bool64): 0 .. 63;

    VAR
      int: integer,
      r: real,
      trick: record
        case boolean of
        = FALSE =
          int: integer,
        = TRUE =
          fill: 0 .. 255,
          bit: 0 .. 255,
        casend,
      recend,
      zero_bit: integer;


{ If the integer is positive, then the first zero bit must be bit 0.

    #UNCHECKED_CONVERSION (s64, int);
    IF int >= 0 THEN
      zero_bit := 0;

{ Otherwise, convert the integer to REAL and get the bit number from the exponent. Note that the bits
{ in the integer are complemented ((-int-1) changes 1's to 0's and 0's to 1's) before converting to
{ real because the exponent actually give the first "one" bit.

    ELSE
      r := $REAL (-int - 1);
      #UNCHECKED_CONVERSION (r, trick.int);
      zero_bit := 64 - trick.bit;
    IFEND;

    find_zero_bit := zero_bit;

  FUNCEND find_zero_bit;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] gfp$assign_fde', EJECT ??

*copyc gfh$assign_fde

  PROCEDURE [XDCL] gfp$assign_fde
    (    residence: gft$table_residence;
         segment_number: ost$segment;
     VAR sfid: gft$system_file_identifier;
     VAR fde_p: gft$file_desc_entry_p);

    VAR
      control_p: ^gft$file_descriptor_control,
      file_entry_index: gft$file_descriptor_index,
      level1: 0 .. 63,
      level2: 0 .. 63,
      seg: ost$segment,
      trick_int: integer,
      zinuse: 0 .. 63;


{ Get a pointer to the control structures for the FDEs. This pointer may be either
{ a pointer to job fixed or to mainframe wired.

    IF residence = gfc$tr_job THEN
      seg := osc$segnum_job_fixed_heap;
    ELSEIF residence = gfc$tr_system THEN
      seg := osc$segnum_mainframe_wired;
    ELSE
      seg := segment_number;
    IFEND;

    control_p := #ADDRESS (1, seg, gfc$fde_control_table_base);


{ Lock the tables to prevent other users from assigning FDEs.

    osp$set_mainframe_sig_lock (control_p^.lock);


{ Scan the level 1 index to find the first level 2 table that has free entries.

    level1 := find_zero_bit (control_p^.index1);


{ If the level 1 index is greater than 15, then tables are full. (Although the table structure will support
{ more entries, it would require an SFID.INDEX > 65K. This breaks compatibility).

    IF level1 > 15 THEN
      fde_p := NIL;
    ELSE

{ Scan reset of the indices to find the index of the FDE to be assigned.

      level2 := find_zero_bit (control_p^.index2 [level1]);
      zinuse := find_zero_bit (control_p^.in_use [level2 + 64 * level1]);


{ Mark the entry as assigned. If the array entry containing the IN_USE bit for the entry just assigned
{ is full (all entries in the block assigned), mark the level 2 index as full. If the array entry
{ containing the level 2 bit is full, mark the level 1 table as full.

      control_p^.in_use [level2 + 64 * level1] [zinuse] := TRUE;

      #UNCHECKED_CONVERSION (control_p^.in_use [level2 + 64 * level1], trick_int);
      IF trick_int = -1 THEN
        control_p^.index2 [level1] [level2] := TRUE;
        #UNCHECKED_CONVERSION (control_p^.index2 [level1], trick_int);
        IF trick_int = -1 THEN
          control_p^.index1 [level1] := TRUE;
        IFEND;
      IFEND;


{ Create the SFID  and FDE_P for the entry just assigned. Note that the hash field must be initialized by the
{ caller.

      file_entry_index := ((level1 * 64) + level2) * 64 + zinuse;
      sfid.file_entry_index := file_entry_index;
      IF residence = gfc$tr_system THEN
        sfid.residence := gfc$tr_system;
      ELSE
        sfid.residence := gfc$tr_job;
      IFEND;
      fde_p := #ADDRESS (1, #SEGMENT (control_p), gfc$fde_table_base + gfc$fde_size * file_entry_index);


{ Initialize the table entry with the default FDE value.

      fde_p^ := initial_fde_entry;
      fde_p^.file_hash := (#FREE_RUNNING_CLOCK (0) MOD 249) + 1;
      sfid.file_hash := fde_p^.file_hash;
    IFEND;

    osp$clear_mainframe_sig_lock (control_p^.lock);

  PROCEND gfp$assign_fde;

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] gfp$free_fde', EJECT ??

*copyc gfh$free_fde

  PROCEDURE [XDCL] gfp$free_fde
    (    fde_p: gft$file_desc_entry_p;
         sfid: gft$system_file_identifier);

    VAR
      control_p: ^gft$file_descriptor_control,
      i: gft$file_descriptor_index,
      identifier: ost$status_identifier,
      int: integer,
      l: integer,
      level1: 0 .. 63,
      level2: 0 .. 63,
      log_status: ost$status,
      logtime: ost$time,
      number: ost$status_condition_number,
      s: string (80),
      zinuse: 0 .. 63;


{ Verify that the FDE_P is valid.
    IF (#SEGMENT (fde_p) <> 1) AND (#SEGMENT (fde_p) <> 3) THEN
      osp$system_error ('GF - Bad FDE_P on FREE', NIL);
    IFEND;
    int := (#OFFSET (fde_p) - gfc$fde_table_base) DIV gfc$fde_size;
    IF (int < 0) OR (int > 65535) OR ((int * gfc$fde_size + gfc$fde_table_base) <> #OFFSET (fde_p)) THEN
      osp$system_error ('GF - Bad FDE_P on FREE', NIL);
    ELSEIF fde_p^.job_lock.locked THEN
      osp$system_error ('GF - freed locked FDE', NIL);
    ELSEIF fde_p^.asti <> 0 THEN
      osp$system_error ('GF - freed FDE with asti <> 0', NIL);
    ELSEIF fde_p^.open_count > 0 THEN { Halt if we attempt to free an FDE with an open_count > 0.
      IF sfid.residence = gfc$tr_job THEN
        identifier := 'DM';
        number := 0;
        STRINGREP (s, l, ' DM: DISCARDING A FILE WITH OPEN COUNT > 0 ', fde_p, ' ', identifier, number);
        lgp$add_entry_to_system_log (pmc$msg_origin_system, s, logtime, log_status);

        dpp$put_critical_message (s, log_status);
      ELSE
        osp$system_error ('GF - open_count > 0 during FREE_FDE', NIL);
      IFEND;
    IFEND;

{ Calculate the indexes to the index levels.
    i := (#OFFSET (fde_p) - gfc$fde_table_base) DIV gfc$fde_size;
    zinuse := i MOD 64;
    i := i DIV 64;
    level2 := i MOD 64;
    i := i DIV 64;
    level1 := i MOD 64;

{ Get a pointer to the control structures for the FDEs. This pointer may be either
{ a pointer to job fixed or to mainframe wired.

    control_p := #ADDRESS (1, #SEGMENT (fde_p), gfc$fde_control_table_base);


{ Lock the tables to prevent other users from assigning FDEs.

    osp$set_mainframe_sig_lock (control_p^.lock);


{ Set each index level to indicate free entries. Its faster to mark each level to
{ show free entries than to actually check

    control_p^.in_use [level2 + 64 * level1] [zinuse] := FALSE;
    control_p^.index2 [level1] [level2] := FALSE;
    control_p^.index1 [level1] := FALSE;


{ Change the file hash in the FDE being freed to cause errors if an attempt is made to
{ reference the entry again. NOTE that the job_lock is not cleared and will contain the GTID
{ of the task that freed the entry until the entry is reused.

    fde_p^.file_hash := gfc$null_file_hash;


{ If the word containing the 'in_use' bit for the entry just freed is all zeros, attempt to
{ free unused pages.

    #UNCHECKED_CONVERSION (control_p^.in_use [level2 + 64 * level1], int);
    IF int = 0 THEN
      free_unused_pages (control_p, level2 + 64 * level1);
    IFEND;

    osp$clear_mainframe_sig_lock (control_p^.lock);

  PROCEND gfp$free_fde;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] gfp$initialize', EJECT ??
{
{ This procedure should be called earily in deadstart. The primary function of this call is to
{ verify that compile time constants are correct. CYBIL does not have the language
{ constructs that would allow this type of checking to be done at compile time.
{ If constants are incorrect, deadstart is aborted with a nice message.
{

  PROCEDURE [XDCL] gfp$initialize;

    IF #SIZE (gft$file_descriptor_entry) > gfc$fde_size THEN
      osp$fatal_system_error ('GF - FDE size is incorrect', NIL);
    IFEND;

  PROCEND gfp$initialize;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] gfp$reassign_fde', EJECT ??

*copyc gfh$reassign_fde

  PROCEDURE [XDCL] gfp$reassign_fde
    (    sfid: gft$system_file_identifier;
         old_fde_p: gft$file_desc_entry_p);

    VAR
      control_p: ^gft$file_descriptor_control,
      fde_p: gft$file_desc_entry_p,
      ignore_status: ost$status;


{ Get a pointer to the control structures for the job FDEs.

    control_p := #ADDRESS (1, osc$segnum_job_fixed_heap, gfc$fde_control_table_base);


{ Validate the SFID. (Note: code doesn't currently set level1 or level2 indexes as INUSE so don't allow
{ file_entry_index > 62).

    IF (sfid.residence <> gfc$tr_job) OR (sfid.file_entry_index > 62) THEN
      osp$system_error ('GF - invalid SFID on recreate', NIL);
    IFEND;

{ If the fde entry is already in use, verify that it is for a previous open of the file.
{ If an asti is already assigned, hang the job.  Some unexpected condition has occurred.
{ If disk space has already been assigned, hang the job if this is not the same file.

    IF control_p^.in_use_bits [sfid.file_entry_index] THEN
      fde_p := #ADDRESS (1, #SEGMENT (control_p), gfc$fde_table_base + gfc$fde_size * sfid.file_entry_index);
      IF (fde_p^.asti <> 0) THEN
        osp$system_error ('Bad clone--asti assigned.', NIL);
      ELSEIF fde_p^.media <> gfc$fm_transient_segment THEN
        IF (old_fde_p^.global_file_name <> fde_p^.global_file_name) THEN
          osp$system_error ('Bad clone--fde in use.', NIL);
        ELSE

{ Disk space has already been assigned for this file; the segment is open more than once.

          RETURN; {----->
        IFEND;
      IFEND;
    ELSE {fde not in use yet

{ Mark the entry as 'INUSE'.

      control_p^.in_use_bits [sfid.file_entry_index] := TRUE;
      fde_p := #ADDRESS (1, #SEGMENT (control_p), gfc$fde_table_base + gfc$fde_size * sfid.file_entry_index);
    IFEND;


{ Initialize the table entry with the default FDE value.

    fde_p^ := old_fde_p^;
    fde_p^.media := gfc$fm_transient_segment;
    fde_p^.eoi_byte_address := 0;
    fde_p^.asti := 0;
    IF fde_p^.file_kind = gfc$fk_job_local_file THEN
      mmp$assign_mass_storage (0, sfid, 0, ignore_status);
    IFEND;

  PROCEND gfp$reassign_fde;

?? OLDTITLE ??

*if $variable(gfc$test_harness declared) <> 'UNKNOWN'
?? NEWTITLE := 'TEST HARNESS', EJECT ??

  PROCEDURE error
    (    i: integer;
         sfid: gft$system_file_identifier);

    VAR
      s: string (80),
      status: ost$status,
      sl: integer;

    STRINGREP (s, sl, 'Expected ', i, ', found ', sfid.file_entry_index);
    clp$put_job_output (s (1, sl), status);
    i#program_error;

  PROCEND error;

  VAR
    fde_p: array [0 .. 66000] of gft$locked_file_desc_entry_p;

  PROGRAM gfp$test_table_manager
    (    params: SEQ ( * );
     VAR status: ost$status);

    VAR
      bits_p: ^packed array [0 .. 65535] of boolean,
      control_p: ^gft$file_descriptor_control,
      word_p: ^array [0 .. 1100] of integer,
      max_words_to_search: integer,
      residence: gft$table_residence,
      p: amt$segment_pointer,
      sfid: gft$system_file_identifier,
      scr_fde_p: gft$locked_file_desc_entry_p,
      low_index,
      high_index,
      free_index,
      stop,
      i,
      j,
      k,
      index: integer;


    osv$page_size := 4096;
    gfp$initialize;
    mmp$create_scratch_segment (amc$cell_pointer, mmc$as_random, p, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    table_seg := #SEGMENT (p.cell_pointer);
    control_p := #ADDRESS (1, table_seg, gfc$fde_control_table_base);

    FOR j := 1 TO 4 DO
      FOR i := 0 TO 65535 DO
        gfp$assign_fde (gfc$tr_job, sfid, fde_p [i]);
        IF (sfid.file_entry_index <> i) OR (fde_p [i] = NIL) THEN
          error (i, sfid);
        IFEND;
      FOREND;

      gfp$assign_fde (gfc$tr_job, sfid, scr_fde_p);
      IF scr_fde_p <> NIL THEN
        error (0, sfid);
      IFEND;

      scr_fde_p := fde_p [12345];
      gfp$free_fde (scr_fde_p);
      gfp$assign_fde (gfc$tr_job, sfid, scr_fde_p);

      IF (sfid.file_entry_index <> 12345) OR (scr_fde_p <> fde_p [12345]) THEN
        error (12345, sfid);
      IFEND;

      FOR i := 1 TO 100000 DO
        k := #FREE_RUNNING_CLOCK (0) MOD 65536;
        scr_fde_p := fde_p [k];
        gfp$free_fde (scr_fde_p);
        gfp$assign_fde (gfc$tr_job, sfid, scr_fde_p);
        IF (sfid.file_entry_index <> k) OR (scr_fde_p <> fde_p [k]) THEN
          error (k, sfid);
        IFEND;
        gfp$assign_fde (gfc$tr_job, sfid, scr_fde_p);
        IF scr_fde_p <> NIL THEN
          error (0, sfid);
        IFEND;
      FOREND;

      IF j = 2 THEN
        FOR i := 65535 DOWNTO 0 DO
          gfp$free_fde (fde_p [i]);
        FOREND;
      ELSE
        FOR i := 0 TO 65535 DO
          gfp$free_fde (fde_p [i]);
        FOREND;
      IFEND;
    FOREND;

    max_words_to_search := ((osv$page_size DIV gfc$fde_size) DIV 64) + 1;
    bits_p := #LOC (control_p^.in_use);
    word_p := #LOC (control_p^.in_use);
    low_index := 0;
    verify_free_entries := TRUE;
    REPEAT
      free_index := ((low_index + 63) DIV 64) * 64;
      FOR k := 0 TO max_words_to_search DO
        high_index := min (65535, free_index + k * 64 + 64 * (max_words_to_search + 1));
        stop := min (65536, free_index + k * 64 + 64);
        WHILE high_index >= stop DO
          test_free (control_p, low_index, free_index + k * 64, high_index, max_words_to_search);
          bits_p^ [high_index] := TRUE;
          high_index := high_index - 1;
        WHILEND;
        j := stop DIV 64;
        FOR i := j TO j + max_words_to_search + 1 DO
          word_p^ [i] := 0;
        FOREND;
      FOREND;
      IF low_index = 2000 THEN {test end points only
        low_index := 60000;
      IFEND;
      bits_p^ [low_index] := TRUE;
      low_index := low_index + 1;
    UNTIL low_index = 65536 - 64;

  PROCEND gfp$test_table_manager;

  PROCEDURE [INLINE] test_free
    (    p: ^cell;
         low_index,
         free_index,
         high_index,
         max_words_to_search: integer);

    VAR
      status: ost$status,
      s: string (100),
      sl: integer;

    zzz_first_index_to_free := max (low_index, (free_index DIV 64) * 64 - (max_words_to_search - 1) * 64);
    zzz_last_index_to_free := min (high_index, (free_index DIV 64) * 64 + max_words_to_search * 64 - 1);

    free_unused_pages (p, free_index DIV 64);
    free_ok := free_ok + 1;

  PROCEND test_free;

?? OLDTITLE ??
*ifend
MODEND gfm$file_table_manager
