{ File:  [17,40]VIEWPROC.PAS     Last edit: 16-SEP-1989 14:48:47 

  History:

     14-Jun-89.  Philip Hannay.  Created from VIEWWK prototype.

     08-Sep-89.  Philip Hannay.  Added support for receipt of PS_GRANT,
         acceptance of duplicate connection requests and grants, and
         creation of VOWN call to indicate "ownership" of cached field
         values.  Echo/send is now filtered to skip the send of a 
         cached value only if that value did not change and the program
         is not the "owner" of the field.  The "ownership" also determines
         if the program responds to a PS_GET query of a field value, as
         only the owner will respond.  This now makes VIEWPROC capable 
         of "full-duplex" for a peer to peer link with no distiction 
         between "form" job and "work" job.  It also reduces duplicate
         message packets when values do not change.
}

{$NOMAIN}
{$OWN}

{[a+,b+,l-,k+,r+] Pasmat }

PROGRAM VIEWPROC;

 %INCLUDE pas$ext:general.typ;

 %INCLUDE pas$ext:string.pkg;
 %include pas$ext:msgpacket.pkg


{ Predefined Pascal procedures for dynamic memory allocation }

Function p$inew(blocksize: word): address; external;
  { Allocate memory block of size BLOCKSIZE, return pointer to start }

Procedure p$dispose(pointer: address; blocksize: word); external;
  { Deallocate memory block of size BLOCKSIZE starting at POINTER }

Function space: word; external;
  { Return the amount of $$HEAP space free (available) }

{ end predefined Pascal procedures }


%include pas$ext:viewproc.con
%include pas$ext:viewproc.typ

Type 

  VI_alpha_array = packed array [VI_status_type] of ch20;

Const 

  VI_alpha_table = VI_alpha_array (
    'operation done okay ',    { VI_success }
    'value not in cache  ',    { VI_not_found }
    'out of cache memory ',    { VI_no_memory }
    'unrecongized message',    { VI_msg_unknown }
    'job not connected   ',    { VI_not_connected }
    'job connection lost ',    { VI_connect_lost }
    'job connection made ',    { VI_connected }
    'job connect denied  ',    { VI_connect_denied }
    'value has changed   ',    { VI_changed }
    'value is unchanged  '     { VI_no_change }
   );      


Const 

  spc6 = '      '; { six spaces }
  success = 1;

  max_job = 20;  
    { max number of jobs that can be connected at one time }

  max_old_detail = 20;  
    { max number of old detail records (job name and last resource_detail
      info that was supplied when a disconnect was done) that are
      retained to aid in future connections }

  cache_block_size = 1024;
    { number of bytes to allocate when field value cache must be extended }

  max_cache_block = 40;
    { max number of cache blocks that can be allocated - thus maximum
      cache size (if dynamic memory available) is MAX_CACHE_BLOCK times
      CACHE_BLOCK_SIZE. }

Type  

  Field_value_ptr = ^Field_value_rec;

  Field_value_rec = record
                    next_value: field_value_ptr;
                    owner: boolean;
                      { set TRUE if this program is the field owner }
                    max_len: integer;  
                      { maximum possible length of field value in bytes }
                    mess: message_packet_type;
                    end;

  Old_detail_rec = record
                   name: ch6;
                   detail: ch10;
                   end;

  Cache_table_rec = record
                    addr: address;
                    inuse: boolean;
                    end;

 
Var  { own }

  Active_job: array [1..max_job] of ch6;
  { The ACTIVE_JOB array retains the names of all jobs that are currently
    connected to this program.  Unused slots are all blank, and all
    active jobs are packed into the lowest subscripts.  Thus the array
    can be searched until the end or until a blank slot is found. }

  Old_detail: array [1..max_old_detail] of old_detail_rec;
  { The OLD_DETAIL array contains the RESOURCE_DETAIL field value that
    was supplied when a job disconnected (PK_RESOURCE/PS_CLOSE).  This 
    detail info is retained, and is supplied to the task if it ever
    reconnects in the future.  This can help supply a "starting" context
    to the connector.  For example, it might be the last field name
    that the operator was in when the disconnect occurred.  This makes it
    seem like the operator never left.  The info is retained as long as
    possible.  If the array is full, the oldest record will be discarded
    when a new record must be placed in array. }

  Cache_table: array [1..max_cache_block] of cache_table_rec;
  { The CACHE_TABLE holds the address and status of allocated cache
    blocks.  We must keep this info, so that we can reinitialize the
    system.  So whenever a new cache block is allocated, we record its
    address in the table, and set INUSE (TRUE).  When cache is
    reinitialized, we retain the blocks, keeping the address,
    but clearing INUSE (FALSE).  We do not bother with a DISPOSE, as
    the task cannot grow smaller, and we do not want to run into
    fragmenation problems.  An address of zero means "unallocated". }

  Field_value_listhead: field_value_ptr;    { first pointer in linked list }
  Field_value_prev: field_value_ptr; { previously used pointer in cache block }
  Field_value_next: field_value_ptr; { next available pointer in cache block }
  Field_value_avail: word;           { space avail in current cache block}


Procedure Vastat(stat: VI_status_type;
                 var str: packed array [lo..hi:integer] of char);
                 external;

{*USER*

Convert a scaler VI_STATUS_TYPE to a type0 or type1 string for printing.
The scaler is passed in STAT and the string is returned in STR.  The
string is "assigned", so the previous contents of the string, if
any, are destroyed. 

*ERROR CODES*

The only errors that can occur are due to programmer
errors.  If such an error occurs, a string of zero 
length will be returned.

}

Procedure Vastat;

var
  hold: ch20;

Begin
hold:= VI_alpha_table[stat];
spad(hold,' ',chr(0));
sassign(str,hold);
end;



Procedure Vcheck(job: ch6; var stat: VI_status_type);
                 external;

{*USER*

See if job named in JOB is one of the jobs in the list of
jobs that are actively connected to this program.  Status
is returned in STAT.

*ERROR CODES*

VI_SUCCESS - Specified job found on connected job list.

VI_NOT_CONNECTED - Specified job not found on list.

}

Procedure Vcheck;

    VAR
      i: integer;
      done: boolean;


    BEGIN
      stat:= VI_not_connected;  { assume not in list until proven otherwise }
      i := 1;
      done := false;
      REPEAT
        IF job = Active_job[i] THEN
          BEGIN
          stat:= VI_success;
          done := true;
          END
        ELSE
          BEGIN
          IF Active_job[i, 1] = ' ' THEN
            BEGIN
            done := true;
            END
          ELSE
            BEGIN
            IF i = Max_job THEN done := true
            ELSE i := i + 1;
            END;
          END;
      UNTIL done = true;
    END;  { Procedure Vcheck }


Procedure Vdjob(nam: ch6; notify: boolean; var stat: VI_status_type);
                 external;

{*USER*

Remove the job named in NAM from our active (connected) job list.
If NOTIFY boolean is true, send a disconnect (PK_RESOURCE/PS_CLOSE)
message to the form.  If name not found on list, ignore, but still send 
disconnect message if NOTIFY is true.  
The call status is returned in STAT.

*ERROR CODES*

VI_SUCCESS - Job was on connected form list, 
             it has been removed.

VI_NOT_CONNECTED - Form job was not found on the connected
                   form list, so no removal was needed.

}

Procedure Vdjob;

Var
  i, sendstat: integer;
  found: boolean;
  holdmsg: message_packet_type;

Begin
{Note that we are not worried about the efficiency of
 our removal, as this call is not frequent. }
found:= false;
for i:= 1 to max_job do
  begin
  { Find form job name in list.  If found, shuffle other
    names down the list, and blank empty slot.  }
  if found 
    then begin
      Active_job[i-1]:= Active_job[i];
      Active_job[i]:= spc6;
      end;
  if Active_job[i] = nam then found:= true;
  end;
if notify
  then begin
    { now send off BYE }
    holdmsg.id:= pk_resource;
    holdmsg.sub:= [ps_close];
    sclear(holdmsg.resource_name);
    sclear(holdmsg.resource_owner);
    sclear(holdmsg.resource_detail);
    sndmsg(nam,holdmsg,sendstat);
    { ignore send failure - we aren't talking to it anyway }
    end;
if found then stat:= VI_success else stat:= VI_not_connected;
end;  { Procedure Vdjob }


Procedure Vput(var msg: message_packet_type; sender: boolean;
               force: boolean; var own: boolean; var stat: VI_status_type);
               external;

{*USER*

Look through our existing cache of field values to see if the
field value contained in MSG already exists.  If it does, compare 
the values, then
update cache with the new value, and finally return the appropriate
VI_CHANGED or VI_NO_CHANGE in STAT to indicate if the values differed or not.

If the field value is not in cache, but FORCE is TRUE, add it, 
and return VI_CHANGED.   If the field value is not in cache, and FORCE
is FALSE, then ignore value and return VI_NOT_FOUND.  The FORCE boolean
thus controls whether a new entry is made or not in cache if the
an existing entry is not found in cache.

If SENDER is true, the caller plans to send out the message.  Thus
if the caller is the owner of the field, we shall update the FIELD_STATUS 
value, and check if it changed from the previous value.  If the caller
is not the owner, then we ignore the FIELD_STATUS value and leave the
one in cache as is.  If SENDER is false,
then the caller is receiving this message, and so if we are the owner, we
ignore the FIELD_STATUS, keeping the one we already have.  If we are not
the owner, we update the FIELD_STATUS value as it must be from the owner,
and check if it changed from the previous value.

If the field is "owned" by this program, return OWN as TRUE, else
return it as FALSE.  Naturally, it must be in cache to be "owned".

The FIELD_NAME and FIELD_VALUE fields of MSG must be correct before
making this call.  The FIELD_STATUS field need only be correct before
making this call if UPSTAT is true.  All other fields of MSG need not
be current for this call.

The message (MSG) variable will normally remain unchanged upon 
return from VSEND.  The only change that can happen, is that the
message length (in MSG.FIELD_VALUE) will be adjusted to reflect the
length of the field value already in cache.  If needed the value
will be padded with blanks.  This is done, since the first VSEND,
which resulted in the field value being placed in cache, also determines
the "official" field length that will be use in subsequent sends.


*ERROR CODES*

VI_CHANGED - Field value was placed in cache, and either the
            supplied value was different that the value 
            already in cache, or this is the first time the
            value has been placed in cache and the FORCE
            boolean was TRUE.

VI_NO_CHANGE - Field value was placed in cache, and the 
               supplied value was the same as the value
               already in cache.  

VI_NOT_FOUND - Field value was not found in cache, and since
               the FORCE boolean is FALSE, no entry was made
               for the field in cache.

VI_NO_MEMORY - Field value was not already in cache, and
               the FORCE boolean was TRUE, however, we were 
               unable to place the supplied field value in 
               cache as there was no more memory available 
               in cache.

}

Procedure Vput;

Var
  p: field_value_ptr;
  i, next_entry, pos, len, mlen: integer;
  found, changed, update: boolean;
  w: word;

Begin
{WRITELN('VPUT: ENTER VPUT');}
own:= false;  { assume field not "owned" by this program }
p:= field_value_listhead;
found:= false;
while (p <> nil) and (not(found)) do
  if p^.mess.field_name = msg.field_name
    then found:= true else p:= p^.next_value;
{ Look in cache for existing entry. }
if (p <> nil)
  then begin
    { Field value already in cache.  Compare and then update.  Note that
      we use the maximum field value length (MAX_LEN) when the existing 
      entry was first entered as the upper limit on field value length.
      If the field value of this entry is longer, we will truncate it so as
      to not corrupt cache. }
    {WRITELN('VPUT: FIELD ALREADY IN CACHE');}
    own:= p^.owner;  { return ownership boolean }
    len:= ord(p^.mess.field_value[0]);
    mlen:= ord(msg.field_value[0]);
    { New entry value length MLEN cannot be greater than cache entry max 
      value length MAX_LEN. }
    if mlen > p^.max_len then mlen:= p^.max_len;
    changed:= false;
    { Terminator is considered part of the value, check if changed, 
      and if so, update it. }
    if p^.mess.field_term <> msg.field_term 
      then begin
        changed:= true;
        p^.mess.field_term:= msg.field_term;
        end;
    { Check the FIELD_STATUS value.  If we are sending (SENDER is TRUE),
      and if we are the owner, then we update and check field status.
      Likewise, if we are receiving (SENDER is FALSE) and we are NOT
      the owner, then we update and check field status.  IE. The owner
      controls the field status value. }
      if ((sender) and (own)) or ((not(sender)) and (not(own)))
        then begin
          if p^.mess.field_term <> msg.field_term
            then begin
              changed:= true;
              p^.mess.field_term:= msg.field_term;
              end;
          end;
    { See if value changed from before.  Trailing blanks if any will
      be ignored.  If the field value of the current entry must be 
      truncated to fit the maximum defined in the existing entry, then
      those truncated characters will be ignored.  NOTE that the compare
      is case dependent, and will return "changed" if upper/lower case
      state changes. }
    pos:= 1;
    update:= false;
    while (pos <= mlen) and (pos <= len) and (not(update)) do 
      if p^.mess.field_value[pos] <> msg.field_value[pos] 
        then update:= true else pos:= pos+1;
    if (not(update)) and (len <> mlen)
      then begin
        { We checked for exact match using shortest of the two
          strings lengths and there was no change.  Now check for 
          special cases.  POS points to next character to check in
          longer of the two strings.  If longer string has just
          trailing blanks (not nulls), then we consider them the same. }
        if len > mlen
          then begin
            { existing entry longer, check for trailing blanks }
            while (pos <= len) and (not(update)) do 
              if p^.mess.field_value[pos] <> ' '
                then update:= true else pos:= pos+1;
            end
          else begin
            { new entry longer, check for trailing blanks }
            while (pos <= mlen) and (not(update)) do 
              if msg.field_value[pos] <> ' '
                then update:= true else pos:= pos+1;
            end;
        end;
    if update
      then begin
        { field changed, update value }
        changed:= true;
        p^.mess.field_value[0]:= chr(mlen);
        for i:= 1 to mlen do p^.mess.field_value[i]:= msg.field_value[i];
        {WRITELN('VPUT: FIELD VALUE UPDATED WITH NEW VALUE, LEN IS ',MLEN:1);}
        end;
{WRITELN('VPUT: FIELD NAME IS "',P^.MESS.FIELD_NAME,'"');}
{IF CHANGED THEN WRITELN('VPUT: FIELD CHANGED') }
{ELSE WRITELN('VPUT: FIELD DID NOT CHANGE');}
    if changed then stat:= VI_changed else stat:= VI_no_change;
    end
  else begin
    { No existing entry, if FORCE is true, add a new entry to cache.  
      If we do not have enough free space in the current cache block, 
      allocate a new cache block.  Note that this first entry will
      fix the space allocated this entry, and so the field value must
      be of maximum size.  Thereafter, any entries longer than this
      field value size will be truncated. }
    if force = true
      then begin
{WRITELN('VPUT: NO EXISTING ENTRY IN CACHE, ADD IT');}
        { figure out how big of cache entry this guy will need is -
          it is message packet length, plus 2 byte NEXT_VALUE next cache
          entry pointer, plus 1 byte OWNER boolean, plus 1 byte filler,
          plus 2 byte MAX_LEN overall cache entry
          length, plus 1 byte to accomodate any word alignment on
          string.}
        len:= msglen(msg) + 7;
        { make sure LEN is even as our cache entries must be word
          aligned, if not add a byte }
        if (len mod 2 <> 0) then len:= len + 1;
{WRITELN('VPUT: ENTRY LENGTH COMPUTES TO ',LEN:1,', ',LEN:-3,' OCTAL');}
{WRITELN('VPUT: CACHE FREE SPACE IS ',FIELD_VALUE_AVAIL:-6,' OCTAL');}
        if len > field_value_avail
          then begin
            { We do not have enough space in the current cache block, so we
              allocate a new cache block. }
{WRITELN('VPUT: ALLOCATE NEW CACHE BLOCK');}
            { find next available entry in cache block table }
            next_entry:= 0;
            for i:= 1 to max_cache_block
              do if (next_entry = 0 ) and (cache_table[i].inuse = false)
                   then next_entry:= i;
            if next_entry = 0
              then begin
                { no more room in cache table - cannot get more memory }
                field_value_next:= nil;
                end
              else begin
                { NEXT_ENTRY points to a cache table entry that is not
                  in use (thus is available).  See if it already has an 
                  allocated cache block assigned}
                if cache_table[next_entry].addr <> 0
                  then begin
                    { block already allocated, use it }
                    field_value_next:= 
                      loophole(field_value_ptr,cache_table[next_entry].addr);
                    end
                  else begin
                    { new cache block needs to be allocated from memory }
                    Field_value_next:= 
                      loophole(field_value_ptr, p$inew(cache_block_size));
                    end;
                end;
            if field_value_next = nil
              then begin
                { no room in cache table or unable to allocate more
                  dynamic memory }
                field_value_avail:= 0 
                end
              else begin
                { new block allocated, save info in cache table }
                field_value_avail:= cache_block_size;
                cache_table[next_entry].addr:= loophole(word,field_value_next);
                cache_table[next_entry].inuse:= true;
                end;
            end;
        if field_value_next <> nil
          then begin
            { A slot is available.  Set the link pointer in the previously used
              slot pointing to this available slot, and then put this new field
              value into this available slot. }
            { Note that we update the previous value to point to this new value
              only if there was a previous value.  If this is the first value,
              then FIELD_VALUE_PREV will be NIL, and we must update 
              FIELD_VALUE_LISTHEAD to point to this first slot. }
            if field_value_prev = nil
              then field_value_listhead:= field_value_next
              else field_value_prev^.next_value:= field_value_next;
{WRITELN('VPUT: CACHE POINTER IS ',LOOPHOLE(WORD,FIELD_VALUE_NEXT):-6);}
            with field_value_next^ do
              begin
              next_value:= nil;  { this is now end of list }
              owner:= false;  { we are not owner unless VOWN is called later }
              { maximum field value length allowed is now fixed by the 
                field value length of this first entry. }
              max_len:= ord(msg.field_value[0]);
              mess.id:= msg.id;
              mess.sub:= msg.sub;
              mess.field_name:= msg.field_name;
              { First time in cache, we use the FIELD_STATUS as supplied.
                Only the owner can change FIELD_STATUS, but at this point,
                ownership has not yet been declared.  If ownership is
                subsequently declared, we are not affected. }
              mess.field_status:= msg.field_status;
              { terminator value is always updated }
              mess.field_term:= msg.field_term;
              for i:= 0 to max_len do
                mess.field_value[i]:= msg.field_value[i];
{WRITELN('VPUT: STORED FIELD NAME IS "',MESS.FIELD_NAME,'"');}
{WRITELN('VPUT: MAX FIELD VALUE LENGTH IS ',MAX_LEN:1);}
              end; {with}
            { Now we adjust pointers.  FIELD_VALUE_PREV now points to the
              newly filled slot.  We compute the value of the FIELD_VALUE_NEXT
              pointer by adding the length of the slot to the current pointer
              value.  We also subtract the lenght of the newly used slot from
              the FIELD_VALUE_AVAIL free space byte count.  Note that at this
              point FIELD_VALUE_NEXT could become NIL (zero).  However, so
              should FIELD_VALUE_AVAIL.  Since we use FIELD_VALUE_AVAIL to
              determine if we should try and allocate a new cache block,
              we don't have to worry about FIELD_VALUE_NEXT being NIL, as
              it will become non-NIL when a new cache block is successfully
              allocated. }
            field_value_prev:= field_value_next;
            w:= loophole(word,field_value_next);
            w:= w + len;
            field_value_next:= loophole(field_value_ptr,w);
            field_value_avail:= field_value_avail - len;
            stat:= VI_changed;
            end
          else begin
            { ran out of memory for cache }
{WRITELN('VPUT: NO MORE MEMORY AVAILABLE FOR CACHE EXPANSION');}
            stat:= VI_no_memory;
            end;
        end
      else begin
        { No value found in cache, and FORCE is FALSE, so we simply
          ignore the message and return status "not found". }
{WRITELN('VPUT: NO ENTRY MADE IN CACHE');}
        stat:= VI_not_found;
        end;
    end;
end; { Procedure Vput }


Procedure Vget(var msg: message_packet_type; var own: boolean;
               var stat: VI_status_type);
               external;

{*USER*

Look through our existing cache of field values to see if the field 
value named in MSG.FIELD_NAME exists.  If it does, get the current value
and load it into MSG.FIELD_VALUE.  Also copy the current FIELD_STATUS
value and return VI_SUCCESS in STAT.  If the field is not found in cache,
return VI_NOT_FOUND in STAT.

If the field is "owned" by this program, return OWN as TRUE, else return
OWN as FALSE;

Other fields in MSG need not be current when VGET is called.

*ERROR CODES*

VI_SUCCESS - Specified field value was found in cache, and
             its current value retrieved.

VI_NOT_FOUND - Specified field value was not found in cache.
               No changes made to MSG variable.

}

Procedure Vget;

Var
  i: integer;
  p: field_value_ptr;
  found: boolean;

Begin
own:= false;  { assume not "owned" unless found otherwise }
{ Look in cache for existing entry. }
p:= field_value_listhead;
found:= false;
while (p <> nil) and (not(found)) do
  if p^.mess.field_name = msg.field_name
    then found:= true else p:= p^.next_value;
if (p <> nil)
  then begin
    { Field value found in cache.  Fill in MSG fields.  Use length found
      in MESS.FIELD_VALUE. }
    own:= p^.owner;
    for i:= 0 to ord(p^.mess.field_value[0]) do 
      msg.field_value[i]:= p^.mess.field_value[i];
    msg.field_status:= p^.mess.field_status;
    msg.field_term:= p^.mess.field_term;
    stat:= VI_success;
    end
  else begin
    { No existing entry, do nothing }
    stat:= VI_not_found;
    end;
end; { Procedure Vget }


Procedure Vecho(var msg: message_packet_type; var stat: VI_status_type);
                external;

{*USER*

Echo (send) the message packet in MSG to all currently connected forms. 
This insures that all forms show the current value.  Note that the
echo goes also to the form that orignially sent us the update.  The
reason for this, is that there may have been some other echoed values
sent to the form that were processed by the form AFTER the operator
made the current udpate.  This will restore the field value to 
the one the operator made.  This insures that the "last" entry on
any connected form "wins".

STAT will always be returned as IV_SUCCESS
regardless of whether any messages were actually sent. 

*ERROR CODES*

IV_SUCCESS - Sends have been done to all connected forms.  
             If a send fails for a connected form, it will be
             dropped from the list of connected forms.  If
             there were no connected forms, no sends were needed.


}

Procedure Vecho;

Var
  i, sendstat: integer;
  done: boolean;
  holdstat: VI_status_type;

Begin
{WRITELN('VECHO: SEND FIELD VALUE TO ALL CONNECTED FORMS');}
i:= 1;
done:= false;
while (i <= max_job) and (not(done)) do
  begin
  if Active_job[i,1] = ' '
    then begin
      done:= true;
      end
    else begin
      sndmsg(Active_job[i],msg,sendstat);
      if sendstat <> success 
        then begin
          { Send failed, remove form job from active list.  Note that we
            do not bother sending a "disconnect" message, since the send
            already failed, and another one will do the same.   Note also
            that we leave "I" pointing where it was since the VDJOB 
            routine will have removed the disconnected form and shuffled
            down the next form into its place. }
          Vdjob(Active_job[i],false,holdstat);
          end
        else begin
          { go on to the next connected form }
          i:= i + 1;
          end;
      end;
  end; {while}
stat:= VI_success;
end;  { Procedure Vecho }


Procedure Vinit(var stat: VI_status_type);
                external;

{*USER*

VINIT is used to intialize the VIEWPORT interface.  The VIEWPORT interface
uses a global data area that is reserved for its exclusive use.  This area,
which is not directly accesible by the user, remains transparent to the
user.  However, it must be intialized for use by the VIEWPORT interface.

VINIT must be called once before any other VIEWPORT interface (Vxxxxx) calls
are made.  The status returned in STAT must be VI_SUCCESS.  If the 
status is not VI_SUCCESS, a problem (normally programmer error) has
occurred, and the intialization is not complete.

The VIEWPORT interface can be reinitialized by calling VRESET.  DO NOT
call VINIT again as it can be executed only once.

VINIT is the one of four commonly used VIEWPORT interface calls (VINIT,
VSEND, VRECV and VDISC).  It will use the other VIEWPORT interface calls
for its work, making it uneccesary for the normal user to call any other
VIEWPORT interface calls.

*ERROR CODES*

VI_SUCESS - Initialization is complete.

VI_NO_MEMORY - Initialization failed.  Unable to allocate
               the memory needed for the field value cache area.

}

Procedure Vinit;

var
  i: integer;

Begin
{ show that no forms are connected }
for i:= 1 to max_job do Active_job[i]:= spc6;
{ clear out old resource detail info }
for i:= 1 to max_old_detail do old_detail[i].name:= spc6;
{ Allocate first cache block of memory for our field value cache. 
  Set list head pointer to nil, set next available pointer to first
  byte of memory block. }
for i:= 1 to max_cache_block do 
  begin
  { clear cache table - ADDR to zero (unallocated), and 
    INUSE to false (available) }
  cache_table[i].addr:= 0;
  cache_table[i].inuse:= false;
  end;
Field_value_listhead:= nil;
Field_value_prev:= nil;
Field_value_next:= loophole(field_value_ptr, p$inew(cache_block_size));
if field_value_next = nil
  then begin
    { cache block allocation attempt failed }
    field_value_avail:= 0;
    stat:= VI_no_memory;
    end
  else begin
    { First cache block allocated okay - record its address in cache table
      and mark it in use.  Also set FIELD_VALUE_AVAIL to the size of the
      block.  FIELD_VALUE_AVAIL tells us how much of the current cache
      block is available for use. }
    cache_table[1].addr:= loophole(word,field_value_next);
    cache_table[1].inuse:= true;
    field_value_avail:= cache_block_size;
    stat:= VI_success;
    end;
end;  { Procedure Vinit }


Procedure Vrecv(var nam: ch6; var msg: message_packet_type; 
                var stat: VI_status_type);
                external;

{*USER*

VRECV is used to 
process a message MSG received from a form NAM.  The processing status
code is returned in STAT. 

VRECV is the one of four commonly used VIEWPORT interface calls (VINIT,
VSEND, VRECV and VDISC).  It will use the other VIEWPORT interface calls
for its work, making it uneccesary for the normal user to call any other
VIEWPORT interface calls.

After receiving a message from a form program (whether connected or not),
of the type PK_RESOURCE or PK_FIELD_VALUE, the user should call VRECV
supplying the message and form program name.  VRECV will then handle
the message as needed.  

The form name (NAM) will remain unchanged.
The message (MSG) variable will normally remain unchanged upon 
return from VRECV.  The only change that can happen, is that the
message length (in MSG.FIELD_VALUE) will be adjusted to reflect the
length of the field value already in cache.  If needed the value
will be padded with blanks.  This is done, since the first VSEND,
which resulted in the field value being placed in cache, also determines
the "official" field length that will be use in subsequent sends.
After the call, the user may
then do any additional processing desired based on the returned status
in STAT.  In some cases, no further processing will be needed.


*ERROR CODES*

VI_SUCCESS - (PK_FIELD_VALUE/PS_GET) 
             The requested field value was retrieved from
             cache and sent to the form job named in NAM.
             Normally, no further processing by the 
             user is needed.

             (PK_RESOURCE/PS_CLOSE)
             The form job named in NAM has been removed
             from the connected form list.  If form job
             as not on the list, nothing is done.  Normally,
             no further processing is needed by the user
             unless the user wishes to monitor connection
             activity.

VI_CONNECTED - (PK_RESOURCE/PS_OPEN)
               The job named in NAM has been sent all
               current field values from cache, and a 
               confirmation that the "connect request"
               has been "granted".  The form job is now
               on the "connected job list".  Normally,
               no further processing is needed by the user
               unless the user wishes to monitor connection
               activity.

              (PK_RESOURCE/PS_GRANT)
               The job named in NAM has sent all current field values 
               from cache, and this is now the confirmation that the
               "connect request" has been "granted".  The form job is 
               now on the "connected job list".  Normally,
               no further processing is needed by the user
               unless the user wishes to monitor connection
               activity.  Note that the connection is granted
               unconditionally.  It is up to the caller to determine
               if it wants the connection.  If the caller does not
               want the connection, this message should be ignored
               and a disconnect request (PK_RESOURCE/PS_CLOSE) should 
               be sent in reply.  

VI_CONNECT_DENIED - (PK_RESOURCE/PS_OPEN) 
                    Connection request was rejected, and 
                    form job named in NAM notified of the
                    fact.  There was no more space available
                    for another form in "connected form list".
                    Normally, no further processing is needed 
                    by the user unless the user wishes to 
                    monitor connection activity.

                    (PK_RESOURCE/PS_GRANT)
                    Connection grant from the job name in NAM could
                    not be honored because there was no more space 
                    available for another job in "connected job list".
                    Normally, no further processing is needed 
                    by the user unless the user wishes to 
                    monitor connection activity.  A PK_RESOURCE/PS_CLOSE
                    was automatically sent to inform the attempting connector
                    that we cannot connect.

VI_CONNECT_LOST - (PK_RESOURCE/PS_OPEN) 
                  Connection request was in the process of
                  being done when an error occurred that
                  indicated the form job was no longer 
                  receiving messages.  The processing was
                  aborted, and the form job WAS NOT added
                  to the connected form list.
                  Normally, no further processing is needed 
                  by the user unless the user wishes to 
                  monitor connection activity.

VI_CHANGED - (PK_FIELD_VALUE/PS_PUT)
             Field value was updated in cache, and the
             supplied value was different than the value 
             already in cache.

VI_NO_CHANGE - (PK_FIELD_VALUE/PS_PUT)
               Field value was updated in cache, and the 
               supplied value was the same as the value
               already in cache.  

VI_NOT_FOUND - (PK_FIELD_VALUE/PS_PUT)
               Field value was not in cache, and there was
               no value to compare or update.  Field value
               was ignored.  This normally means that this
               field is not controlled (initialized) by
               the user, but by some other user.  The user
               often is not interested in this field and
               can just discard it.  However, it does allow
               the user a means to see what other users are
               doing, and can montior those values of
               interest.

               (PK_FIELD_VALUE/PS_GET)
               Field value requested by form program was
               not found in cache.  Must be some other
               user's responsibility.  Message ignored.
               Normally, the user will discard this message.

VI_NO_MEMORY - (PK_FIELD_VALUE/PS_PUT)
               Field value was not already in cache, and
               furthermore, we were unable to place the
               supplied field value in cache as there was
               no more memory available in cache.

VI_NOT_CONNECTED - The form job name (NAM) is not in the list
                   of connected forms.  This message has been
                   ignored, and a disconnect command sent to
                   the form job name.  The user will normally
                   ignore and discard this message.  The only
                   message that can be accepted from a form
                   job that is not connected is a "connect
                   request" message.

VI_MSG_UNKNOWN - The message supplied in MSG was not recognized
                 (handled) by VRECV.  The sending form job
                 is on the connected form list.  VRECV did
                 nothing with the message.  The user may 
                 ignore or process the message as desired.

*WIZARD*

The user can choose to route all received message through VRECV, or
route only the PK_RESOURCE and PK_FIELD_VALUE messages thorugh VRECV.
There is some extra overhead for routing all messages through VRECV,
so it is recommended that a fliter be applied, and only PK_RESOURCE
and PK_FIELD_VALUE messages be given to VRECV for processing.

If all messages are routed through, the VI_MSG_UNKNOWN and VI_NOT_CONNECTED
return statii should be interpreted as "not handled here, ignored".

}

Procedure Vrecv;

Label 
  999;

Var
  holdstat: VI_status_type;
  i, next, sendstat: integer;
  holdmsg: message_packet_type;
  found, blank: boolean;
  p: field_value_ptr;
  owned: boolean;

Begin
stat:= VI_msg_unknown;  { assume unrecognized until recognized }
if not((msg.id = pk_resource) and (msg.sub * [ps_open,ps_grant] <> []))
  then begin
    { Make sure message is from a connected form.  If it is not,
      ignore it.  Only exception is a "connect request" from an
      unconnected job }
{WRITELN('VRECV: SEE IF MESSAGE FROM CONNECTED FORM');}
    Vcheck(nam,holdstat);
    if not(holdstat = VI_success)
      then begin
        { Unconnected job.  Ignore message. }
{WRITELN('VRECV: VCHECK SHOWS UNCONNECTED JOB, FORCE DISCONNECT');}
        stat:= VI_not_connected;
        goto 999;
        end;
    end;
case msg.id of
  pk_field_value:
    begin
{WRITELN('VRECV: FIELD VALUE PACKET');}
    if ps_put in msg.sub
      then begin
{WRITELN('VRECV: WITH PS_PUT - PUT FIELD IN CACHE');}
        { field value received from form, if value found in cache,
          update that value and indicate if it changed or not.  If not
          in cache, put it in. }
        Vput(msg,false,true,owned,stat);
        if not(stat in [VI_changed,VI_no_change]) then goto 999;
        if (owned) and (stat = VI_changed)
          then begin
            { Since we "own" the field (its in our cache), and it has
              changed, we echo field the new field value to all 
              connected forms }
{WRITELN('VRECV: OUR FIELD, ECHO FIELD VALUE TO OTHERS');}
            Vecho(msg,holdstat);
            end;
        end;  { if ps_put in }
    if ps_get in msg.sub
      then begin
{WRITELN('VRECV: WITH PS_GET - GET CURRENT VALUE FROM CACHE');}
        { The job asked for our current field value.  Get the value from
          cache, and if we are the owner, send it back.  
          If value not in cache or we are not the owner, it must be
          another user's responsibility, and just ignore the request. }
        holdmsg:= msg;
        Vget(holdmsg,owned,stat);
        if (stat = VI_success) and (owned)
          then begin
            { Field value was found in cache and placed in HOLDMSG.  Now
              send it back to the requestor if we are the owner. }
{WRITELN('VRECV: FOUND FIELD VALUE IN CACHE, SEND IT TO REQUESTOR ONLY');}
            holdmsg.sub:= [ps_put];
            if ps_ack_requested in msg.sub 
              then holdmsg.sub:= holdmsg.sub + [ps_ack];
            sndmsg(nam,holdmsg,sendstat);
            { ignore send failure - nothing we do about it - if the form died,
              it's no longer concerned about a field value }
            end;
        end;  { if ps_get in }
    end;  { pk_field_value }
  pk_resource:
    begin
{WRITELN('VRECV: PK_RESOURCE MESSAGE PACKET');}
    if ps_close in msg.sub
      then begin
        { A form job is disconnecting.  Remove it from our active form
          list and send disconnect (PK_RESOURCE/PS_CLOSE) message.  Save
          the resource detail info for future connections. }
{WRITELN('VRECV: WITH PS_CLOSE, - DISCONNECT FROM FORM');}
        Vdjob(nam,true,holdstat);
        found:= false;
        i:= 1;
        while (i <= max_old_detail) and (not(found)) do
          if (old_detail[i].name = nam) or (old_detail[i].name[1] = ' ')
            then found:= true else i:= i+1;
        if not(found)
          then begin
            { make some room by kicking out the oldest connection }
            i:= 1;
            while (i < max_old_detail) do 
              begin
              old_detail[i]:= old_detail[i+1];
              i:= i+1;
              end;
            i:= max_old_detail;
            end;
        { "I" now points to available slot in OLD_DETAIL }
        old_detail[i].name:= nam;
        old_detail[i].detail:= msg.resource_detail;
        stat:= VI_success;
        end;  { if ps_close in }
    if ps_open in msg.sub
      then begin
        { A form job requests a connection.  We are happy to comply as
          long as we have not exceeded our maximum connections.  Note
          that we accept duplicate connection, and go through the
          paces - maybe we missed a close, or task is resynching, or
          the we a full duplex connection where task A sends the first
          connect request to task B, and then after B sends updates
          and grants the connection, it does the connect request to A
          to get the updates from A. }
{WRITELN('VRECV: WITH PS_OPEN - UPDATE FORM AND GRANT CONNECTION');}
        next:= 1;
        found:= false;
        while (next <= max_job) and (not(found)) do
          begin
          { search for first empty slot or duplicate }
          if Active_job[next] = nam
            then begin
              { found duplicate, look no further }
              found:= true;
              end
            else begin
              { look for blank, if not, advance to next name }
              if Active_job[next,1] = ' ' then found:= true else next:= next+1;
              end;
          end;
        if not(found)
          then begin
            { No room at the connection inn.  Send a "deny" response }
{WRITELN('VRECV: CONNECTION DENIED, COULD NOT FIND ACTIVE JOB SLOT');}
            holdmsg:= msg;
            holdmsg.sub:= [ps_deny];
            if ps_ack_requested in msg.sub 
              then holdmsg.sub:= holdmsg.sub + [ps_ack];
            sndmsg(nam,holdmsg,sendstat);
            if sendstat = success
              then begin
                { connection request denied with no problem }
                stat:= VI_connect_denied;
                end
              else begin
                { connection lost }
                stat:= VI_connect_lost;
                end;
            end
          else begin
            { Empty slot found in connection list.  Send out updates,
              followed by a "grant" response.  Note that we only send
              non-null and non-blank fields as newly shown form has
              all fields blanked as default.  Likewise, we only send
              those field that we "own". }
{WRITELN('VRECV: UPDATE FORM WITH CURRENT CACHED VALUES');}
            p:= field_value_listhead;
            while p <> nil do
              begin
              with p^ do
                begin
                blank:= true;
                i:= 1;
                if (p^.owner = true)
                  then begin
                    { we own the field, so we send it if it is non-blank }
                    while (blank) and (i <= ord(p^.mess.field_value[0])) do
                      if p^.mess.field_value[i] = ' ' 
                        then i:= i + 1 else blank:= false;
                    end;
                if not(blank)
                  then begin
                    { field value is not null (empty) or all blanks, send
                      out update to form }
{WRITELN('VRECV: SEND OUT UPDATE, POINTER IS ',LOOPHOLE(WORD,P):-6);}
                    holdmsg.id:= mess.id;
{WRITELN('VRECV: ORD OF MESS ID IS ',ORD(MESS.ID):1);}
                    holdmsg.sub:= mess.sub;
{WRITELN('VRECV: FIELD NAME IS "',MESS.FIELD_NAME,'"');}
                    holdmsg.field_name:= mess.field_name;
                    holdmsg.field_status:= mess.field_status;
                    holdmsg.field_term:= mess.field_term;
{WRITELN('VRECV: FIELD VALUE LEN IS ',ORD(MESS.FIELD_VALUE[0]):1);}
                    for i:= 0 to ord(mess.field_value[0]) do
                      holdmsg.field_value[i]:= mess.field_value[i];
                    sndmsg(nam,holdmsg,sendstat);
                    if sendstat <> success
                      then begin
                        { fatal send error - abort connect attempt }
                        stat:= VI_connect_lost;
                        goto 999;
                        end;
                    end;
                end; {with}
              { go to next value }
              p:= p^.next_value;
              end; {while}
{WRITELN('VRECV: "CONNECTION GRANTED" SENT TO FORM');}
            holdmsg:= msg;
            holdmsg.sub:= [ps_grant];
            if ps_ack_requested in msg.sub 
              then holdmsg.sub:= holdmsg.sub + [ps_ack];
            sclear(holdmsg.resource_name);
            sclear(holdmsg.resource_owner);
            sclear(holdmsg.resource_detail);
            { See if there is any detail information from a previous
              connection.  If there is, send that along. }
            for i:= 1 to max_old_detail do
              if old_detail[i].name = nam 
                then holdmsg.resource_detail:= old_detail[i].detail;
            sndmsg(nam,holdmsg,sendstat);
            if sendstat = success
              then begin
                { restart went fine, add connected task to our active list }
                Active_job[next]:= nam;
                stat:= VI_connected;
                end
              else begin
                { connection lost }
                stat:= VI_connect_lost;
                end;
            end;
        end;  { if ps_open in }
    if ps_grant in msg.sub
      then begin
        { A job requests a connection.  We are happy to comply as
          long as we have not exceeded our maximum connections.  Note
          that we check for the connection already in our list, do
          not object to a duplication. }
        next:= 1;
        found:= false;
        while (next <= max_job) and (not(found)) do
          begin
          { search for first empty slot or duplicate }
          if Active_job[next] = nam
            then begin
              { found duplicate, look no further }
              found:= true;
              end
            else begin
              { look for blank, if not, advance to next name }
              if Active_job[next,1] = ' ' then found:= true else next:= next+1;
              end;
          end;
        if not(found)
          then begin
            { No room at the connection inn.  Send a "disconnect" response }
{WRITELN('VRECV: CONNECTION DENIED, COULD NOT FIND ACTIVE JOB SLOT');}
            holdmsg:= msg;
            holdmsg.sub:= [ps_close];
            if ps_ack_requested in msg.sub 
              then holdmsg.sub:= holdmsg.sub + [ps_ack];
            sndmsg(nam,holdmsg,sendstat);
            if sendstat = success
              then begin
                { connection request denied with no problem }
                stat:= VI_connect_denied;
                end
              else begin
                { connection lost }
                stat:= VI_connect_lost;
                end;
            end
          else begin
            { Empty slot found in connection list.  Record the
              connection and return success }
            Active_job[next]:= nam;
            stat:= VI_connected;
            end;
        end;  { if ps_grant in }
    end; { pk_resource }
  otherwise;
  end; { case }
999:
end;    { Procedure Vrecv }



Procedure Vsend(var msg: message_packet_type; snd: boolean;
                var stat: VI_status_type);
                external;

{*USER*

Process a message MSG to be sent to all connected forms.  Regardless
of whether there are any connected forms, update cache if needed to reflect the
sent value.  Return processing status in STAT.  If the boolean SND is
TRUE, the message is to be sent immediately to all connected forms.  If
the boolean SND is FALSE, there are more messages coming (more VSEND calls),
and so the message may be buffered and sent later with the subsequent
messages.  Two constants are defined in VIEWPORT.PKG for use in SND.
They are VB_STILL_MORE (FALSE) and VB_SEND_NOW (TRUE).  It is recomended
that they be used instead of TRUE and FALSE in the VSEND call, 
as they are more descriptive.

VSEND is the one of four commonly used VIEWPORT interface calls (VINIT,
VSEND, VRECV and VDISC).  It will use the other VIEWPORT interface calls
for its work, making it uneccesary for the normal user to call any other
VIEWPORT interface calls.

Whenever the user wishes to initialize or update a field value 
to reflect a new value (using PK_FIELD_VALUE/PS_PUT),
the VSEND routine should be used.  Not only will the current value be
updated (or added) in the field value cache, but the value will be sent
to all form jobs in the "connected form list".

Messages other that a field value update (PK_FIELD_VALUE/PS_PUT) will
be accepted, and sent to all form jobs in the "connected form list".
These messages will not result in any updating of cache.  However, 
a PK_RESOURCE/PS_CLOSE (disconnect command)  will result in the 
same action as the VDISC call, that is, all form jobs will be 
removed from the connected form list.

When sending a series of messages (multiple VSENDs), use the SND boolean
to increase processing efficiency by letting VSEND buffer messages 
until the SND boolean is set TRUE (VB_SEND_NOW).  Setting SND to
FALSE (VB_STILL_MORE) tells VSEND that it can buffer the message if
possible to allow more efficient sending with other subsequent messages.
When the user uses VB_STILL_MORE (FALSE), he or she should take care
to insure that a VB_SEND_NOW (TRUE) VSEND is issued in a timely manner,
otherwise the message may not be sent when expected by the programmer.

The message (MSG) variable will normally remain unchanged upon 
return from VSEND.  The only change that can happen, is that the
message length (in MSG.FIELD_VALUE) will be adjusted to reflect the
length of the field value already in cache.  If needed the value
will be padded with blanks.  This is done, since the first VSEND,
which resulted in the field value being placed in cache, also determines
the "official" field length that will be use in subsequent sends.


*ERROR CODES*

VI_SUCCESS - (all message but PK_RESOURCE/PS_CLOSE, and
              PK_FIELD_VALUE/PS_PUT)
             The message in MSG was sent to all form jobs
             in the connected form list.  If there were
             a send error to a form job, that form job was
             dropped off the list.  If there were no form
             jobs on the list (no forms connected), the
             message was not sent to anyone.

             (PK_RESOURCE/PS_CLOSE)
             The message in MSG was sent to all form jobs
             in the connected form list.  In addition, since
             this is a "disconnect" request, all form jobs
             were removed from the "connected form list".
             This action is the same action as the VDISC
             call.

VI_CHANGED - (PK_FIELD_VALUE/PS_PUT)
             Field value was placed in cache, and either the
             supplied value was different that the value 
             already in cache, or this is the first time the
             value has been placed in cache.

VI_NO_CHANGE - (PK_FIELD_VALUE/PS_PUT)
               Field value was placed in cache, and the 
               supplied value was the same as the value
               already in cache.  

VI_NO_MEMORY - (PK_FIELD_VALUE/PS_PUT)
               Field value was not already in cache, and
               furthermore, we were unable to place the
               supplied field value in cache as there was
               no more memory available in cache.

*WIZARD*

Marginal performance improvments can be made by monitoring from connections,
and skipping the VSEND call when there are no forms connected.
However, even when there are no forms connected, the PK_FIELD_VALUE/PS_PUT
field update messages must still be processed to keep the field value
cache up to date.  Since most of the VSEND calls will be
for processing the PK_FIELD_VALUE/PS_PUT messages, it is recommended
that VSEND be called regardless of whether any forms are connected
to the user's task.

At this time, the SND parameter is ignored, and messages are always
sent immediately.  At some future time, "packed" messages will appear
and we will use those to pack multiple messages into a single
physical message packet for improved throughput and reduced 
system overhead.

}

Procedure Vsend;

Label 
  999;

Var
  holdstat: VI_status_type;
  i, sendstat: integer;
  holdmsg: message_packet_type;
  owned, send_it: boolean;

Begin
stat:= VI_success;  { assume success }
send_it:= true;  { assume we are to send it out to connected jobs }
{ do any processing before message send }
case msg.id of
  pk_field_value:
    begin
{WRITELN('VSEND: PK_FIELD_VALUE MESSAGE PACKET');}
    if ps_put in msg.sub
      then begin
        { field value to be sent to form, cache field value if not
          already in cache, cancel flag if field value changed,
          and echo to all connected forms }
{WRITELN('VSEND: WITH PS_PUB, UPDATE CACHE IF NEEDED');}
        Vput(msg,true,true,owned,stat);
        if not(stat in [VI_changed,VI_no_change]) then goto 999;
        { if the value did not change, and we do not own the field,
          we do not send the value out to other connected jobs, as it
          would be redundant }
        if (not(owned)) and (stat = VI_no_change) then send_it:= false;
        end;
    end;  { pk_field_value }
  otherwise;
  end; { case }
{ echo (send) message to all connected jobs if SEND_IT is true }
{WRITELN('VSEND: SEND MESSAGE TO ALL CONNECTED FORMS');}
if send_it then Vecho(msg,holdstat);
{ now any post processing that must be done after send }
if (msg.id = pk_resource) and (ps_close in msg.sub)
  then begin
    { We detect the "disconnect" command and clear our connected
      form list.  This is the same action as VDISC. }
    for i:= 1 to max_job do Active_job[i]:= spc6;
    end;
999:
end;    { Procedure Vsend }
              

Procedure Vown(var msg: message_packet_type; snd: boolean;
               var stat: VI_status_type);
               external;

{*USER*

VOWN is used to declare those fields that the caller will "own".
Field "ownership" implies that the owner is responsible for controlling
the field and making sure that all connected tasks are kept up to
date with the latest changes.  The "owner" of a field makes the ultimate
determination of a fields value, and can modify that value unconditionally
as desired.

Ownership of a field controls the "echo" that is done when a new field
value is received.  This echo lets other programs receive the new field
value when it is changed by one program, keeping them all up to date.
There can only be one owner of a field.  If there are
two owners, a echo loop where one owner will echo the other owner's echo
without stop.  

Ownership of a field will also "force" a message to be sent even if the
value in cache has not changed, since it is a assumed the "owner" knows
what it wants.

A message submitted to VOWN will be sent out normally to all 
connected programs as it is 
submitted to VSEND for cache entry and sending.  The only difference 
is that the cache entry will be marked as "owned" by the calling program.  

The processing status is returned in STAT.  If the boolean SND is
TRUE, the message is to be sent immediately to all connected jobs.  If
the boolean SND is FALSE, there are more messages coming (more VSEND/VOWN
calls),
and so the message may be buffered and sent later with the subsequent
messages.  Two constants are defined in VIEWPORT.PKG for use in SND.
They are VB_STILL_MORE (FALSE) and VB_SEND_NOW (TRUE).  It is recomended
that they be used instead of TRUE and FALSE in the VSEND call, 
as they are more descriptive.

VOWN is the one of five commonly used VIEWPORT interface calls (VINIT,
VSEND, VRECV, VOWN and VDISC).  It will use the other VIEWPORT interface calls
for its work, making it uneccesary for the normal user to call any other
VIEWPORT interface calls.

The only accepted messages are field values updates (PK_FIELD_VALUE/PS_PUT).
Submission of any other message will be rejected.  The rules of cache
entry creation are the same as those of VSEND, as VSEND is used for the
cache entry creation.  VOWN needs to be called only once for a "owned"
field.  Multiple calls for the same field will accepted, however, remember
that only the first VOWN/VSEND defines the field size in cache.


*ERROR CODES*

VI_CHANGED - (PK_FIELD_VALUE/PS_PUT)
             Field value was placed in cache, and either the
             supplied value was different that the value 
             already in cache, or this is the first time the
             value has been placed in cache.

VI_NO_CHANGE - (PK_FIELD_VALUE/PS_PUT)
               Field value was placed in cache, and the 
               supplied value was the same as the value
               already in cache.  

VI_NO_MEMORY - (PK_FIELD_VALUE/PS_PUT)
               Field value was not already in cache, and
               furthermore, we were unable to place the
               supplied field value in cache as there was
               no more memory available in cache.

VI_MSG_UNKNOWN - (PK_FIELD_VALUE/PS_PUT)
                 Message was not of type PK_FIELD/PS_PUT.  
                 Ignored.

*WIZARD*

The actual behavior of this routine is to call VSEND to insure that the
cache entry is created, and then find the cache entry and set the
"ownership" boolean.  Since the ownership boolean is not set until after
the VSEND, the message will be sent ONLY IF the VI_CHANGED status
is returned.  If the status comes back VI_NO_CHANGED, the VSEND will
be invoked again, this time guarateeing the send since the "ownership"
boolean is now set.  In most cases, since ownership will be defined
at program initialization, only a single VSEND will be called with the
cache entry created during that call.

At this time, the SND parameter is ignored, and messages are always
sent immediately.  At some future time, "packed" messages will appear
and we will use those to pack multiple messages into a single
physical message packet for improved throughput and reduced 
system overhead.

}

Procedure Vown;

Label 
  999;

Var
  p: field_value_ptr;
  found: boolean;

Begin
if (msg.id = pk_field_value) and (ps_put in msg.sub)
  then stat:= VI_success  { assume success }
  else stat:= VI_msg_unknown;  { error - not an acceptable message type }
if stat = VI_success
  then begin
    { Send of the message using VSEND.  If required, the cache entry will
      be created. }
    VSEND(msg,snd,stat);
    if not(stat in [VI_changed,VI_no_change]) then goto 999;
    { now find the cache entry, and set the "ownership" boolean true }
    p:= field_value_listhead;
    found:= false;
    while (p <> nil) and (not(found)) do
      if p^.mess.field_name = msg.field_name
        then found:= true else p:= p^.next_value;
    if (p <> nil)
      then begin
        { entry found as expected }
        p^.owner:= true;
        { if cache entry already existed, and value was unchanged, resend
          to make sure message is sent out (now that we are the owner). }
        if stat = VI_no_change then VSEND(msg,snd,stat);
        end
      else begin
        { entry not found - cannot be - return a "memory" error }
        stat:= VI_no_memory;
        end;
    end;
999:
end;    { Procedure Vown }

              

Procedure Vdisc(nam: ch6; det: ch10; var stat: VI_status_type);
                external;

{*USER*

Disconnect from one or all form jobs currently in "connected form list".  This
is done by sending a "disconnect" (PK_RESOURCE/PS_CLOSE) to the task(s).
If the task name in NAM is all blank (or all null, which is a cleared string),
the disconnect message will be sent to all tasks currently connected.
If the task name in NAM is non-blank and non-null, the disconnect message will
be sent ONLY to the specified task.

The value supplied in DET will be used for the RESOURCE_DETAIL field of
the message.  The return processing status will be returned in STAT.

VDISC is the one of four commonly used VIEWPORT interface calls (VINIT,
VSEND, VRECV and VDISC).  It will use the other VIEWPORT interface calls
for its work, making it uneccesary for the normal user to call any other
VIEWPORT interface calls.

This call is normally made when the user is trying to recover from
an error (resyncronize), or doing an orderly abort.

*ERROR CODES*

VI_SUCCESS - If single job was specified, it was on the 
             connected job list, and was sent a disconnect
             message and removed from the list.  If no specific
             job specified, all jobs on the connected job 
             list were sent a disconnect message and removed
             from the list.

VI_NOT_CONNECTED - The specific job specified was not 
                   found on the connected job list.  However,
                   a disconnect message was still sent
                   to the job if it was in the system.

}

Procedure Vdisc;

Var
  holdmsg: message_packet_type;

Begin
holdmsg.id:= pk_resource;
holdmsg.sub:= [ps_close];
sclear(holdmsg.resource_name);
sclear(holdmsg.resource_owner);
sassign(holdmsg.resource_detail,det);
if (slen(nam) = 0) or (nam = '      ')
  then begin
    { send to all connected jobs }
    VSEND(holdmsg,true,stat);
    end
  else begin
    { send to specific job }
    vdjob(nam,true,stat);
    end;
end;



Procedure Vreset(var stat: VI_status_type);
                 external;

{*USER*

VRESET is used to reintialize the VIEWPORT interface.  The VIEWPORT interface
uses a global data area that is reserved for its exclusive use.  This area,
which is not directly accesible by the user, remains transparent to the
user.  However, it must be intialized for use by the VIEWPORT interface.
This was already done once with VINIT.  Thereafter, we must use VRESET
to reinitialize the interface.

Since all connected job and cache info is lost, we will
disconnect from any connected jobs prior to the reinitialization.

REMEMBER, VINIT must be called the first time to initialize cache and
other internal variables, while VRESET is called any subsequent times
that a "re-initialization" is desired.

*ERROR CODES*

VI_SUCCESS - Re-Initialization is complete.

}

Procedure Vreset;

var
  i: integer;
  job: ch6;
  det: ch10;

Begin
{ do an overall disconnect }
sclear(job);
sclear(det);
vdisc(job,det,stat);
{ show that no forms are connected }
for i:= 1 to max_job do Active_job[i]:= spc6;
{ we keep the old resource detail info in OLD_DETAIL as it is a "ring-buffer"
  type table }
{ We mark all allocated blocks of memory in the CACHE_TABLE as "available". }
for i:= 1 to max_cache_block do cache_table[i].inuse:= false;
{ Reset cache list pointers, with FIELD_VALUE_NEXT pointing to the beginning
  of the first cache block listed in CACHE_TABLE }
Field_value_listhead:= nil;
Field_value_prev:= nil;
Field_value_next:= loophole(field_value_ptr, cache_table[1].addr);
cache_table[1].inuse:= true;
field_value_avail:= cache_block_size;
stat:= VI_success;
end;  { Procedure Vreset }



Procedure Vcon(nam: ch6; det: ch10; var stat: VI_status_type);
                external;

{*USER*

Request a connection to the job specified in NAM.  The info in DET
will be put in the RESOURCE_DETAIL field of the connect request.

The job named in NAM will be added to our "connected" job list, so that
its messages will be recognized by this program.  However, the 
"connection" is not considered complete until the "connection granted"
message (PK_RESOURCE/PS_GRANT) is received.  Upon receipt of this
message, we know that all current field values "owned" by the job named 
in NAM have been sent to us.

The processing status will be returned in STAT.

If the returned status is VI_CONNECTED, the job named in NAM has been
added to the connected job list.  The caller must still monitor the
connection process to determine that the connection is "complete".
Normally, this is the receipt of a PK_RESOURCE/PS_GRANT message from
the job.  Receipt of this message indicates that the connected job
has sent us all field values and that we are not "in synch".
Prior to this point, the values in cache may not be all up to date.

The caller should determine what is a reasonable time to wait for
the connection to be "complete".  If after that time, the connection
is not "complete", a disconnect should be done using VDISC.
The following is an example of code that does a "connect" request
and detects "complete" or "timeout" of the connection process.

.lit

( MSG_FLAG is flag that will set if a mesasge
  packet is received, TIMER_FLAG is used for
  timeout - both flags must be in same group
  since we use a STLO for the stop, TIMEOUT, 
  COMPLETE and ERR are booleans that reflect
  the outcome of the connection process. 
  Note that we check for directive errors
  using DIRERR on "critical" directives
  whose failure would hang the program. )
timeout:= false;
complete:= false;
err:= false;
( clean out any old messages from MILSRV, reset
  message receipt flag )
repeat
  sassign(job,'MILSRV');
  rcvmsg(job,recv_msg,stat);
  until stat < 0;
clef(msg_flag);
( request connection )
Vcon('MILSRV','HI THERE  ',vstat);
if vstat = VI_connected
  then begin
    ( connect request sent okay, process responses
      until connect "complete" or "timeout" where
      timeout is 30 seconds without receiving a
      response from requested job )
    mrkt(timer_flag,30,seconds);
    err:= direrr('MRKT1',$dsw);
    repeat
      ( reset message receipt flag prior to receive
        message attempt )
      clef(msg_flag);
      ( receive messages only from MILSRV )
      sassign(job,'MILSRV');
      rcvmsg(job,recv_msg,stat);
      if stat >= 0
        then begin
          ( message received, process, and if not
            complete (PS_GRANT), reset timer )
          process_msg(complete);
          if not(complete)
            then begin
              ( we must cancel previous marktime is
                still running )
              cnmt(timer_flag);
              mrkt(timer_flag,30,seconds);
              err:= direrr('MRKT2',$dsw);
              end;
          end
        else begin
          ( no message from MILSRV, check TIMER_FLAG,
            and if set, declare "timeout", otherwise stop
            and wait for new messages to arrive )
          if rdef(timer_flag) then timeout:= true;
          err:= direrr('RDEF1',$dsw);
          if not(err or timeout) then stlo([msg_flag,time_flag]);
          end;
      until (complete) or (timeout) or (err);
    end
  else begin
    ( VCON failed - task not known to system, or no
      more room in connected job list )
    writeln('VCON ERROR');
    err:= true;
    end;
( since we could have received messages from other tasks
  during this time, we set MSG_FLAG to insure that we
  check for other messages before stopping )
stse(msg_flag);

.eli

The preceding example is a "full function" restart.  The only feature
it does not have is the ability to handle messages from other tasks
during the connection process.  You can see that you could add
this functionality if needed, by blending this code into your regular
message handling routines.  

A simpler and less robust
connection process could be done by simply doing the VCON call and
setting a "connection valid" boolean false.  Later, when the
connection is completed (PS_GRANT received), the "connection valid"
would be set, indicating that the connection is "complete" and the
field values can be used.  In many cases, this would be acceptable
as the connections may be simple and made only at program startup
or program reconfiguration.

*ERROR CODES*

VI_CONNECTED - The connect request was sent to the specified
               job, and that job was added to the connected
               job list.

VI_NOT_CONNECTED - The connect request could not be sent
                   becuase there was no room left in the
                   connected job list.

VI_CONNECT_LOST - The connect request could not be sent due
                  because job name specified was not known to 
                  the system, or other message send error.

*WIZARD*

The job name specified in NAM is added to the connected job list
prior to the connection being "complete" (PS_GRANT received).  This
is done since we must accept field value messages prior
to receipt of the PS_GRANT message and adjust cache if needed to
reflect those values.

Normally, if a connection is denied, the PS_CLOSE message will be sent
to us, and the job will be removed from the connected job list.
However, it is important the the caller understand that this may not
always occur, and must be prepared to handle cases where the
connection is not "complete".

}


Procedure Vcon;

Var
  holdmsg: message_packet_type;
  next, sendstat: integer;
  found: boolean;

Begin
{ First we must see if we have room in the connected job list }
next:= 1;
found:= false;
while (next <= max_job) and (not(found)) do
  begin
  { search for first empty slot or duplicate }
  if Active_job[next] = nam
    then begin
      { found duplicate, look no further }
      found:= true;
      end
    else begin
      { look for blank, if not, advance to next name }
      if Active_job[next,1] = ' ' then found:= true else next:= next+1;
      end;
  end;
if found
  then begin
    { slot found okay, send the request }
    holdmsg.id:= pk_resource;
    holdmsg.sub:= [ps_open];
    sassign(holdmsg.resource_name,'VIEWPORT  ');
    sclear(holdmsg.resource_owner);
    sassign(holdmsg.resource_detail,det);
    sndmsg(nam,holdmsg,sendstat);
    if sendstat = success
      then begin
        { connection request sent with no problem, record job name in
          connected job list and return success }
        Active_job[next]:= nam;
        stat:= VI_connected;
        end
      else begin
        { send failed (task not in system or the like), return a
          status of connection lost }
        stat:= VI_connect_lost;
        end;
    end
  else begin
    { Empty slot not found in connection list.  No need to send request,
      return status of connection lost }
    stat:= VI_not_connected;
    end;
end;  { procedure vcon }
