{ File: [17,40]VIEWPROC.PAS Last edit: 3-AUG-1989 11:15:57 History: 14-Jun-89. Philip Hannay. Created from VIEWWK prototype. } {$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 } 'form not connected ', { VI_not_connected } 'form connection lost', { VI_connect_lost } 'form connection made', { VI_connected } 'form connect denied ', { VI_connect_denied } 'value has changed ', { VI_changed } 'value is unchanged ' { VI_no_change } ); Const spc6 = ' '; { six spaces } success = 1; max_formjob = 10; { max number of forms that can be connected at one time } max_old_detail = 20; { max number of resource detail info retained from previous connections } cache_block_size = 1024; { number of bytes to allocate when field value cache must be extended } Type Field_value_ptr = ^Field_value_rec; Field_value_rec = record next_value: field_value_ptr; 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; Var { own } Active_formjob: array [1..max_formjob] of ch6; Old_detail: array [1..max_old_detail] of old_detail_rec; 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 form named in JOB is one of the form jobs in the list of form jobs that are actively connected to the work job. Status is returned in STAT. *ERROR CODES* VI_SUCCESS - Specified form job found on connected form list. VI_NOT_CONNECTED - Specified form 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_formjob[i] THEN BEGIN stat:= VI_success; done := true; END ELSE BEGIN IF Active_formjob[i, 1] = ' ' THEN BEGIN done := true; END ELSE BEGIN IF i = Max_formjob THEN done := true ELSE i := i + 1; END; END; UNTIL done = true; END; { Procedure Vcheck } Procedure Vdform(nam: ch6; notify: boolean; var stat: VI_status_type); external; {*USER* Remove the form named in NAM from our active (connected) form 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 - Form 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 Vdform; 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_formjob 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_formjob[i-1]:= active_formjob[i]; active_formjob[i]:= spc6; end; if active_formjob[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 Vdform } Procedure Vput(var msg: message_packet_type; upstat: boolean; force: 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 UPSTAT is true, update the FIELD_STATUS value also, if false, do not update. The value of FIELD_STATUS does not affect the return state of STAT. 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, pos, len, mlen: integer; found, changed, do_update: boolean; w: word; Begin {WRITELN('VPUT: ENTER VPUT');} 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');} 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; { 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. } changed:= false; do_update:= false; pos:= 1; while (pos <= mlen) and (pos <= len) and (not(changed)) do if p^.mess.field_value[pos] <> msg.field_value[pos] then changed:= true else pos:= pos+1; if (not(changed)) 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(changed)) do if p^.mess.field_value[pos] <> ' ' then changed:= true else pos:= pos+1; do_update:= true; end else begin { new entry longer, check for trailing blanks } while (pos <= mlen) and (not(changed)) do if msg.field_value[pos] <> ' ' then changed:= true else pos:= pos+1; if changed then do_update:= true; end; end else begin { field lengths were the same, so not changed, skip update } if changed then do_update:= true; end; { Now update cache entry. Note that we update FIELD_STATUS value only if UPSTAT boolean is true. Normally, only updates from work program update the FIELD_STATUS. Note that we update the field value only if DO_UPDATE boolean is true. Note that in the case of a longer existing entry that had trailing blanks, we do the update to the shorter length. In general, this should give us field lengths that match the form fields, increasing our efficiency some. } {WRITELN('VPUT: FIELD NAME IS "',P^.MESS.FIELD_NAME,'"');} {IF CHANGED THEN WRITELN('VPUT: FIELD CHANGED') } {ELSE WRITELN('VPUT: FIELD DID NOT CHANGE');} if do_update then begin 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; if upstat then p^.mess.field_status:= msg.field_status; { terminator value is always updated } p^.mess.field_term:= msg.field_term; 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 2 byte MAX_LEN overall cache entry length, plus 1 byte to accomodate any word alignment on string.} len:= msglen(msg) + 5; { 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');} Field_value_next:= loophole(field_value_ptr, p$inew(cache_block_size)); if field_value_next = nil then field_value_avail:= 0 else field_value_avail:= cache_block_size; 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 } { 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; if upstat then mess.field_status:= msg.field_status else mess.field_status:= 0; { 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 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. 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 { 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. } 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_formjob) and (not(done)) do begin if active_formjob[i,1] = ' ' then begin done:= true; end else begin sndmsg(active_formjob[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 VDFORM routine will have removed the disconnected form and shuffled down the next form into its place. } Vdform(active_formjob[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 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. 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_formjob do active_formjob[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. } 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 field_value_avail:= 0; stat:= VI_no_memory; end else begin 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* Process a message MSG received from a form NAM. Return processing status code 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 form 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 form list". Normally, no further processing is needed by the user unless the user wishes to monitor connection activity. 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. 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; Begin stat:= VI_msg_unknown; { assume unrecognized until recognized } if not((msg.id = pk_resource) and (ps_open in msg.sub)) 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 form } {WRITELN('VRECV: SEE IF MESSAGE FROM CONNECTED FORM');} Vcheck(nam,holdstat); if not(holdstat = VI_success) then begin { Unconnected formjob. Maybe hasn't gotten the word yet. Tell it BYE again } {WRITELN('VRECV: VCHECK SHOWS UNCONNECTED JOB, FORCE DISCONNECT');} Vdform(nam,true,holdstat); 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, ignore. } Vput(msg,false,false,stat); if not(stat in [VI_changed,VI_no_change]) then goto 999; if stat = VI_changed then begin { if field value changed, then cancel any associated message flag } { ### } { Since we "own" the field (its in our cache), we echo 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 form asked for our current field value. Get the value from cache and send it back. If value not in cache, it must be another user's responsibility, and just ignore the request. } holdmsg:= msg; Vget(holdmsg,stat); if stat = VI_success then begin { Field value was found in cache and placed in HOLDMSG. Now send it back to the requestor. } {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');} Vdform(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. } {WRITELN('VRECV: WITH PS_OPEN - UPDATE FORM AND GRANT CONNECTION');} next:= 1; found:= false; while (next <= max_formjob) and (not(found)) do begin { search for first empty slot } if active_formjob[next,1] = ' ' then found:= true else next:= next+1; end; if not(found) then begin { No room at the connection inn. Send a "deny" response } {WRITELN('VRECV: CONNECTION DENIED, COULD NOT FIND ACTIVE FORMJOB 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. } {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; while (blank) and (i <= ord(p^.mess.field_value[0])) do if p^.mess.field_value[i] = ' ' then i:= i + 1 else blank:= false; 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_formjob[next]:= nam; stat:= VI_connected; end else begin { connection lost } stat:= VI_connect_lost; end; end; end; { if ps_open 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; Begin stat:= VI_success; { assume success } { 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,false,true,stat); if not(stat in [VI_changed,VI_no_change]) then goto 999; if stat = VI_changed then begin { if field value changed, then cancel any associated message flag } { ### } end; end; end; { pk_field_value } otherwise; end; { case } { echo (send) message to all connected forms } {WRITELN('VSEND: SEND MESSAGE TO ALL CONNECTED FORMS');} 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_formjob do active_formjob[i]:= spc6; end; 999: end; { Procedure Vsend } Procedure Vdisc(var stat: VI_status_type); external; {*USER* Disconnect from all form jobs currently in "connected form list". This is done by sending a "disconnect" (PK_RESOURCE/PS_CLOSE) to all from jobs. Return processing status 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 - The "disconnect" command (PK_RESOURCE/PS_CLOSE) was sent to all form jobs in the connected form list. The "connected form list" was then cleared of all form jobs. } Procedure Vdisc; Var holdmsg: message_packet_type; Begin {WRITELN('VDISC: DISCONNECT FROM ALL CONNECTED FORMS');} holdmsg.id:= pk_resource; holdmsg.sub:= [ps_close]; sclear(holdmsg.resource_name); sclear(holdmsg.resource_owner); sclear(holdmsg.resource_detail); VSEND(holdmsg,true,stat); end;