From:	MERC::"uunet!WKUVX1.BITNET!DSJ-Mgr" 21-DEC-1992 09:30:02.65
To:	galaxy::gleeve
CC:	
Subj:	OCTOBER92.COMM

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 8.1
$!   On  6-OCT-1992 12:24:54.64   By user GOATHUNTER   (@WKUVX1.BITNET)
$!
$! The VMS_SHARE software that created this archive
$!    was written by  Andy Harper, Kings College London UK
$!    -- September 1992
$!
$! Credit is due to these people for their original ideas:
$!    James Gray, Michael Bednarek
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. [.COMM]COMM_SERVER.FOR;1
$!       2. [.COMM]SERVER_SEND.FOR;1
$!       3. [.COMM]SUB_TEST.FOR;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_UNPACK_TEMP","SYS$SCRATCH:."+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if .not. f$trnlnm("SHARE_UNPACK_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto start
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$unpack: subroutine ! P1=filename, P2=checksum, P3=attributes
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'"
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn' File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-UNPACK, Unpacking file ''P1'"
$ n=P1
$ if P3 .nes. "" then $ n=f
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='n'
PROCEDURE GetHex LOCAL x1,x2;x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,
ERASE_CHARACTER(1))-1;RETURN 16*x1+x2;ENDPROCEDURE;
PROCEDURE SkipPartsep LOOP EXITIF INDEX(ERASE_LINE,"-+-+-+-+-+-+-+-+")=1;
ENDLOOP;ENDPROCEDURE;
PROCEDURE ExpandChar CASE CURRENT_CHARACTER FROM ' ' TO 'z' ["`"]
:ERASE_CHARACTER(1);COPY_TEXT(ASCII(GetHex));[" "]:ERASE_CHARACTER(1);[
OUTRANGE,INRANGE]:MOVE_HORIZONTAL(1);ENDCASE;ENDPROCEDURE;
PROCEDURE ProcessLine s:=ERASE_CHARACTER(1);LOOP EXITIF CURRENT_OFFSET>=LENGTH(
CURRENT_LINE);ExpandChar;ENDLOOP;IF s="V" THEN APPEND_LINE;ENDIF;ENDPROCEDURE;
PROCEDURE AdvanceLine MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);
ENDPROCEDURE;PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=
END_OF(b);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep;
ELSE ProcessLine;AdvanceLine;ENDIF;ENDLOOP;ENDPROCEDURE;SET(FACILITY_NAME,
"UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,OFF);t:="0123456789ABCDEF";f:=
GET_INFO(COMMAND_LINE,"file_name");b:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,
GET_INFO(COMMAND_LINE,"output_file"));QUIT;
$ if p3 .eqs. "" then $ goto dl
$ open/write fdl &f
$ write fdl "RECORD"
$ write fdl P3
$ close fdl
$ w "-I-CONVRFM, Converting record format to ", P3
$ convert/fdl=&f &f-1 &P1
$dl: delete 'f'*
$ if P2 .eqs. "" then $ goto ckskip
$ checksum 'P1'
$ if checksum$checksum .nes. P2 then $ -
  e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ exit
$ckskip: e "-W-CHKSUMSKIP, checksum validation unavailable for ''P1'"
$ endsubroutine
$start:
$!
$ create 'f'
X`09PROGRAM`20COMM_SERVER
XC`09Author:`20J.`20Crum
XC`09Date`20`20:`206/25/91
XC`09This`20program`20is`20run`20as`20a`20detached`20process.
XC`09It`20receives`20device`20communication`20requests`20from`20other`20process
Ves,
XC`09acting`20as`20a`20communication`20server`20for`20a`20shared`20device`20suc
Vh`20as`20a
XC`09PLC`20(Programmable`20Logic`20Controller)`20or`20other`20device`20which
V`20requires
XC`09frequent`20short`20messages.
XC`09The`20inter-process`20communication`20is`20performed`20via`20the`20lock
XC`09manager`20routines,`20using`20a`20common`20resource.`20`20This`20program
XC`09requires`20SYSLCK`20privilege.
XC`09This`20example`20program`20is`20set`20up`20to`20access`20device`20logical
V`20name`20PLC_12.
XC`09This`20name`20should`20be`20assigned`20to`20the`20physical`20or`20Lat`20po
Vrt`20to`20which
XC`09the`20device`20is`20connected.`20`20This`20name`20is`20also`20used`20by
V`20the`20VMS`20Lock
XC`09Management`20routines`20as`20the`20resource`20name.
X
XC`09To`20compile`20and`20link:
XC`09$`20FORTRAN`20COMM_SERVER
XC`09$`20LINK`20COMM_SERVER
XC`09Assign`20the`20logical`20for`20the`20device:
XC`09$`20ASSIGN/SYSTEM/EXEC`20LTA200:`20PLC_12`09!For`20example
XC`09To`20run`20this`20program`20as`20a`20detached`20process:
XC`09$`20RUN`20COMM_SERVER/DETACHED/PRIVILEGE=SYSLCK/PROCESS=COMM_SERVER_12
X
X`09IMPLICIT`09INTEGER*4`20(A-Z)
X
X`09INCLUDE`20`09'($LCKDEF)'`20`20`20`20`20`20`20`20`20`20`20`20`20!Lock`20mana
Vger`20definitions
X`09INCLUDE`20`09'($SSDEF)'`20`20`20`20`20`20`20`20`20`20`20`20`20`20!Status
V`20values
X`09CHARACTER*20`09DEVICE_NAME`20/'PLC_12'/`20`20!Resource`20name`20and
X`09`09`09`09`09`09!logical`20name`20of`20TT`20port.
X`09STRUCTURE`09/STATUS/`09`09!Layout`20of`20lock`20status`20block
X`09`20`20INTEGER*2`09CONDITION`09`09!VMS`20condition`20value
X`09`20`20INTEGER*2`09%FILL`09`09`09!Reserved`20to`20DEC
X`09`20`20INTEGER*4`09LOCKID`09`09`09!Lock`20ID`20longword
X`09`20`20BYTE`09`09VAL_BLOCK(16)`09`09!Lock`20value`20block
X`09END`20STRUCTURE
X
X`09RECORD`09`09/STATUS/`20`20`20`20`20`20LCKSTB`09!Record`20for`20lock`20statu
Vs`20block
X`09COMMON`09`09/LCKCOM/`20`20`20`20`20`20LCKSTB`09!Share`20status`20block
X`09VOLATILE`09LCKCOM`09`09`09!Prevent`20compiler`20optimization
X
X`09INTEGER*4`09FLAG1,FLAG2`09`09!Flags`20for`20$ENQ
X`09INTEGER*4`09ISTAT
X
X`09EXTERNAL`09BLOCKING,COMPLETION`09!AST`20entry`20points
X
XC`09INTEGER*2`09LAT_IOST(4)`09`09!For`20LAT`20QIO`20example`20below
XC`09EXTERNAL`09IO$_TTY_PORT,IO$M_LT_CONNECT
X
XC`09First`20we`20open`20an`20I/O`20channel`20for`20communication`20to`20the
V`20device.
XC`09In`20this`20example,`20we`20don't`20do`20actual`20device`20I/O,`20but`20it
V`20might`20look
XC`09something`20like`20the`20commented`20lines`20below.`20`20Of`20course,`20yo
Vu`20would
XC`09need`20to`20add`20error`20checking`20to`20the`20system`20service`20calls,
V`20and`20you
XC`09may`20want`20to`20specify`20an`20exit`20handler`20to`20clean`20up`20the
V`20LAT`20connection
XC`09at`20program`20exit,`20if`20applicable.
X
XC`09ISTAT=SYS$ASSIGN('PLC_12',CHANNEL,,)`20`20`20!Get`20channel`20for`20i/o.
XC`09LAT_FUNC=(%LOC(IO$_TTY_PORT)`20.OR.`20%LOC(IO$M_LT_CONNECT))`20!LAT`20QIO
V`20funct.
XC`09ISTAT=SYS$QIOW(,%VAL(CHANNEL),%VAL(LAT_FUNC),LAT_IOST,,,,,,,,)
X
XC`09Set`20up`20the`20flag`20bits`20for`20both`20the`20initial`20EX`20lock`20an
Vd`20the`20subsequent
XC`09lock`20conversions.`20`20If`20all`20processes`20performing`20communication
V`20run
XC`09with`20the`20same`20UIC,`20the`20LCK$M_SYSTEM`20bit`20is`20optional.`20
V`20If`20it`20is`20not
XC`09used,`20the`20program`20does`20not`20require`20SYSLCK`20priv.
X
X`09FLAG1`20=`20LCK$M_SYSTEM`20.OR.`20LCK$M_VALBLK`09!Flag`20bits`20for`20initi
Val`20lock.
X`09FLAG2`20=`20LCK$M_CONVERT`20.OR.`20LCK$M_VALBLK`20!Flag`20bits`20for`20lock
V`20conversions.
X`09ISTAT`20=`20SYS$CLREF(%VAL(33))`09!Clear`20E.F.`20used`20by`20completion
V`20AST.
X
XC`09Obtain`20an`20initial`20EX-mode`20lock`20on`20the`20resource,`20specifying
V
XC`09the`20blocking`20AST`20"BLOCKING",`20which`20will`20execute`20when`20anoth
Ver
XC`09process`20requests`20a`20lock`20on`20the`20resource`20name`20in`20DEVICE_N
VAME.
X
X`09ISTAT`20=`20SYS$ENQW(%VAL(34),%VAL(LCK$K_EXMODE),LCKSTB,
X`20`20`20`20`20*`09`20%VAL(FLAG1),DEVICE_NAME,,,,BLOCKING,,)
X
X`09IF(ISTAT`20.NE.`20SS$_NORMAL)THEN`09`09!If`20error`20in`20enqueue,
X`09`20`20CALL`20LOG_ERROR(ISTAT)`20`09`09!Log`20it.
X`09ELSE`20IF`20(LCKSTB.CONDITION`20.NE.`20SS$_NORMAL)THEN`09!If`20error`20retu
Vrned,
X`09`20`20ISTAT=LCKSTB.CONDITION`09`09!Log`20it`20instead.
X`09`20`20CALL`20LOG_ERROR(ISTAT)
X`09END`20IF
X
X`09DO`20I`20=`201,16
X`09`20`20LCKSTB.VAL_BLOCK(I)`20=`200`09`09!Initialize`20value`20block
X`09END`20DO
X
XC`09This`20is`20the`20main`20loop,`20where`20we`20wait`20for`20the`20blocking
V`20AST`20to
XC`09complete,`20then`20we`20obtain`20another`20EX-mode`20lock`20and`20wait`20f
Vor`20the
XC`09blocking`20AST`20to`20complete,`20then`20we`20obtain`20another`20EX-mode
V`20lock
XC`09and...`20well,`20you`20get`20the`20idea.`09Note`20that`20the`20ENQ`20call
V`20is
XC`09asynchronous,`20and`20the`20completion`20AST`20"COMPLETION"`20is`20execute
Vd
XC`09as`20soon`20as`20the`20EX-mode`20lock`20is`20obtained.
X
X`09DO`20WHILE(.TRUE.)`09`09!Loop`20forever
X`09`20`20ISTAT=SYS$WAITFR(%VAL(33))`09!Wait`20for`20blocking`20AST`20completio
Vn
X`09`20`20ISTAT=SYS$CLREF(%VAL(33))`09!Clear`20ef`20set`20by`20blocking`20AST
X
X`09`20`20ISTAT=SYS$ENQ(,%VAL(LCK$K_EXMODE),LCKSTB,%VAL(FLAG2),
X`20`20`20`20`20*`09`20`20`20,,COMPLETION,,BLOCKING,,)`09!Convert`20to`20EX`20l
Vock`20again.
X
X`09`20`20IF(ISTAT`20.NE.`20SS$_NORMAL)THEN`20!If`20error`20in`20enqueue,
X`09`20`20`20`20CALL`20LOG_ERROR(ISTAT)`09!Log`20it.
X`09`20`20ELSE`20IF`20(LCKSTB.CONDITION`20.NE.`20SS$_NORMAL)THEN`20`20`20`20!If
V`20error`20returned,
X`09`20`20`20`20ISTAT=LCKSTB.CONDITION`09!Log`20it`20instead.
X`09`20`20`20`20CALL`20LOG_ERROR(ISTAT)
X`09`20`20END`20IF
X
X`09END`20DO
X
X`09END
X
XC-----------------------------------------------------------------------------
V
X
X`09SUBROUTINE`20BLOCKING
XC`09This`20AST`20is`20executed`20when`20another`20process`20requests`20a`20non
V-NL`20mode
XC`09lock`20on`20the`20resource.`20`20It`20converts`20the`20current`20EX`20lock
V`20to`20a`20NL
XC`09lock`20to`20allow`20the`20other`20process`20to`20claim`20the`20resource
V`20and`20obtain
XC`09its`20lock`20value`20block.
X
X`09IMPLICIT`09INTEGER*4`20(A-Z)
X
X`09INCLUDE`20`09'($LCKDEF)'
X`09INCLUDE`20`09'($SSDEF)'
X`09STRUCTURE`09/STATUS/`09`09!Layout`20of`20lock`20status`20block
X`09`20`20INTEGER*2`09CONDITION`09`09!VMS`20condition`20value
X`09`20`20INTEGER*2`09%FILL`09`09`09!Reserved`20to`20DEC
X`09`20`20INTEGER*4`09LOCKID`09`09`09!Lock`20ID`20longword
X`09`20`20BYTE`09`09VAL_BLOCK(16)`09`09!Lock`20value`20block
X`09END`20STRUCTURE
X
X`09RECORD`09`09/STATUS/`09LCKSTB`09!Record`20for`20lock`20status`20block
X`09COMMON`09`09/LCKCOM/LCKSTB`09`09!Share`20status`20block
X`09VOLATILE`09LCKCOM`09`09`09!Prevent`20compiler`20optimization
X
X`09INTEGER*4`09FLAG
X
X`09FLAG`20=`20LCK$M_CONVERT`20.OR.`20LCK$M_VALBLK`09!Flag`20bits`20for`20conve
Vrsion
X
X`09ISTAT`20=`20SYS$ENQW(%VAL(33),%VAL(LCK$K_NLMODE),LCKSTB,
X`20`20`20`20`20*`09`20`20%VAL(FLAG),,,,,,,)`09!Other`20program`20requested`20l
Vock,`20cnv`20to`20NL`20mode
X
X`09IF(ISTAT`20.NE.`20SS$_NORMAL)THEN`09!If`20error`20in`20enqueue,
X`09`20`20CALL`20LOG_ERROR(ISTAT)`20`09!Log`20it.
X`09ELSE`20IF`20(LCKSTB.CONDITION`20.NE.`20SS$_NORMAL)THEN`09`20`20!If`20error
V`20returned,
X`09`20`20ISTAT=LCKSTB.CONDITION`09!Log`20it`20instead.
X`09`20`20CALL`20LOG_ERROR(ISTAT)
X`09END`20IF
X
X`09RETURN
X`09END
X
XC-----------------------------------------------------------------------------
V
X
X`09SUBROUTINE`20COMPLETION
XC`09This`20routine`20fires`20upon`20completion`20of`20the`20conversion`20back
V`20to`20exclusive
XC`09mode,`20and`20performs`20the`20requested`20communication`20with`20the`20de
Vvice.
X
X`09IMPLICIT`09INTEGER*4`20(A-Z)
X
X`09INCLUDE`20`09'($LCKDEF)'
X`09INCLUDE`20`09'($SSDEF)'
X
X`09STRUCTURE`09/STATUS/`09`09!Layout`20of`20lock`20status`20block
X`09`20`20INTEGER*2`09CONDITION`09`09!VMS`20condition`20value
X`09`20`20INTEGER*2`09%FILL`09`09`09!Reserved`20to`20DEC
X`09`20`20INTEGER*4`09LOCKID`09`09`09!Lock`20ID`20longword
X`09`20`20BYTE`09`09VAL_BLOCK(16)`09`09!Lock`20value`20block
X`09END`20STRUCTURE
X
X`09RECORD`09`09/STATUS/`20`20`20`20LCKSTB`09!Record`20for`20lock`20status`20bl
Vock
X`09COMMON`09`09/LCKCOM/`20`20`20`20LCKSTB`09!Share`20status`20block
X`09VOLATILE`09LCKCOM`09`09`09!Prevent`20compiler`20optimization
X
X`09INTEGER*4`09FLAG,ISTAT,JSTAT
X
X`09CHARACTER*23`09TIME_STR`09`09!Time`20stamp`20buffer
X
X`09IF(LCKSTB.VAL_BLOCK(1)`20.NE.`200)THEN`09!If`20data`20received,
X
XC`09The`20next`20CALL`20should`20be`20to`20a`20routine`20which`20will`20perfor
Vm`20the`20actual
XC`09device`20communication`20required.`09This`20example`20shows`20one-way
XC`09communication,`20but`20it`20could`20be`20two-way,`20with`20the`20returned
V`20message
XC`09being`20placed`20in`20the`20lock`20value`20block.
X
X`09`20`20CALL`20DEV_COMM(LCKSTB.VAL_BLOCK,ISTAT)`20!Send`20msg`20to`20device.
X
X`09`20`20IF(ISTAT.LT.0)THEN`09`09`09!If`20error`20in`20dev.`20communication,
X`09`20`20`20`20CALL`20LOG_ERROR(ISTAT)`09`09!Log`20it`20to`20the`20log`20file.
V
X`09`20`20END`20IF
X
X`09`20`20DO`20I`20=`201,16
X`09`20`20`20`20LCKSTB.VAL_BLOCK(I)`20=`200`09`09!Initialize`20value`20block
X`09`20`20END`20DO
X`09END`20IF
X
X`09RETURN
X`09END
X
XC-----------------------------------------------------------------------------
V-
XC`09Dummy`20routines`20to`20be`20replaced`20with`20real`20ones.
X
X`09SUBROUTINE`20LOG_ERROR(ISTAT)
X
XC`09This`20routine`20should`20be`20modified`20to`20report`20or`20log`20errors
V`20as`20they
XC`09occur.
X
X`09RETURN
X`09END
XC------
X`09SUBROUTINE`20DEV_COMM(BUFFER,ISTAT)
X`09IMPLICIT`20INTEGER*4`20(A-Z)
X`09BYTE`20BUFFER(16)
X`09CHARACTER*23`20DATE_TIME
X
XC`09This`20is`20where`20we`20communicate`20with`20the`20device.
XC`09In`20this`20example,`20we`20just`20write`20the`20first`20message`20byte
V`20to`20a
XC`09file`20with`20a`20date/time`20stamp.
X
X`09CALL`20LIB$DATE_TIME(DATE_TIME)
X`09OPEN(UNIT=25,FILE='SERVER.OUT',TYPE='UNKNOWN',ACCESS='APPEND')
X`09WRITE(UNIT=25,FMT=10)DATE_TIME,BUFFER(1)
X10`09FORMAT(1X,A,'`20BUFFER(1)=',I5)
X`09CLOSE(UNIT=25)
X
X`09ISTAT=1
X`09RETURN
X`09END
$ call unpack [.COMM]COMM_SERVER.FOR;1 285458300 ""
$!
$ create 'f'
X`09SUBROUTINE`20SERVER_SEND(DEVICE_NAME,BUFFER,STATUS)
XC`09Author:`20J.`20Crum
XC`09Date`20`20:`202/19/90
XC`09This`20routine`20sends`20a`20message`20to`20the`20communication`20server
V`20process
XC`09for`20the`20device`20specified`20in`20DEVICE_NAME.
X
X`09IMPLICIT`09INTEGER*4`20(A-Z)
X`09INCLUDE`20`09'($LCKDEF)'
X`09INCLUDE`20`09'($SSDEF)'
X`09CHARACTER*20`09DEVICE_NAME`09`09!Device`20logical`20name
X
X`09STRUCTURE`09/STATUS/`09`09!Layout`20of`20lock`20status`20block
X`09`20`20INTEGER*2`09CONDITION`09`09!VMS`20condition`20value
X`09`20`20INTEGER*2`09%FILL`09`09`09!Reserved`20to`20DEC
X`09`20`20INTEGER*4`09LOCKID`09`09`09!Lock`20ID`20longword
X`09`20`20BYTE`09`09VAL_BLOCK(16)`09`09!Lock`20value`20block
X`09END`20STRUCTURE
X
X`09BYTE`09`09BUFFER(16)
X`09INTEGER*4`09FLAG,STATUS,LOOPS
X`09LOGICAL`20`09STARTED`20/.FALSE./
X
X`09COMMON`09`09/LOCK_SAVE/`09STARTED,FLAG
X
X`09RECORD`09`09/STATUS/`09STATBLK`20!Device`20lock`20status`20block
X
X
X`09IF(.NOT.`20STARTED)THEN`09!If`20this`20is`20the`20first`20call`20to`20this
V`20routine,
X`09`20`20FLAG`20=`20LCK$M_SYSTEM`20.OR.`20LCK$M_VALBLK`20`20!Build`20initial
V`20flag.
X`09`09`09`09!Initially`20queue`20a`20null`20lock`20on`20resource
X`09`20`20ISTAT`20=`20SYS$ENQW(,%VAL(LCK$K_NLMODE),STATBLK,%VAL(FLAG),
X`20`20`20`20`20*`09`20`20`20DEVICE_NAME,,,,,,)
X
X`09`20`20STARTED`20=`20.TRUE.`09`09!Remember`20we`20have`20initialized`20the
V`20lock,
X`09`20`20FLAG`20=`20LCK$M_CONVERT`20.OR.`20LCK$M_VALBLK`20`20!Build`20convert
V`20flag.
X`09END`20IF
X
XC`09Now`20we`20get`20an`20EX`20lock`20on`20the`20server's`20resource,`20which
V`20gives`20us
XC`09access`20to`20the`20lock`20value`20block.
X
X`09ISTAT`20=`20SYS$ENQW(,%VAL(LCK$K_EXMODE),STATBLK,%VAL(FLAG),
X`20`20`20`20`20*`09`20,,,,,,)`09`09`09!Get`20EX`20lock`20on`20server's`20resou
Vrce
X
X`09IF(ISTAT`20.NE.`20SS$_NORMAL)THEN`09!If`20error`20in`20enqueue,
X`09`20`20CALL`20LIB$SIGNAL(%VAL(ISTAT))`09!Display`20error`20message,
X`09`20`20STATUS`20=`20ISTAT`09`09!and`20return`20error`20status.
X`09`20`20RETURN
X`09END`20IF
X
X`09IF`20(STATBLK.CONDITION`20.NE.`20SS$_NORMAL)THEN`20`20!If`20error`20in`20st
Vatus,
X`09`20`20CALL`20LIB$SIGNAL(%VAL(STATBLK.CONDITION))`20`20!Display`20error`20me
Vssage,
X`09`20`20STATUS`20=`20STATBLK.CONDITION`09`09`20`20`20`20!and`20return`20error
V`20status.
X`09`20`20RETURN
X`09END`20IF
X
X`09LOOPS`20=`200`09`09`09!Init.`20loop`20counter.
X
XC`09If`20we`20intercepted`20a`20message`20from`20another`20client`20(or`20if
V`20we
XC`09received`20our`20own`20message),`20enter`20this`20loop`20to`20give`20the
V`20server
XC`09process`20a`20chance`20to`20handle`20it`20while`20we`20wait`20our`20turn.
X
X`09DO`20WHILE(STATBLK.VAL_BLOCK(1)`20.NE.`200`20.AND.`20LOOPS`20.LT.`20100)
X`09`20`20ISTAT=SYS$ENQW(,%VAL(LCK$K_NLMODE),STATBLK,%VAL(FLAG),
X`20`20`20`20`20*`09`20,,,,,,)`09`09`09!Convert`20to`20NL`20mode`20to`20send
V`20value`20block
X`09`20`20CALL`20LIB$WAIT(0.05)`09`09!Wait`20a`20little`20while...
X`09`20`20LOOPS`20=`20LOOPS`20+`201`09`09!Count`20loop`20iterations.
X`09`20`20ISTAT=SYS$ENQW(,%VAL(LCK$K_EXMODE),STATBLK,%VAL(FLAG),
X`20`20`20`20`20*`09`20,,,,,,)`09`09`09!Convert`20to`20EX`20mode`20again.
X`09END`20DO
X
X`09IF(LOOPS`20.GE.`20100)THEN`09`09!If`20we`20can't`20get`20an`20available`20v
Value
X`09`20`20STATUS`20=`20-3`09`09`09!block`20in`20100`20tries,`20return`20bad
X`09`20`20RETURN`09`09`09!status`20to`20caller.
X`09END`20IF
X
XC`09Now`20we`20have`20an`20available`20lock`20value`20block,`20so`20let's`20pu
Vt`20our`20stuff`20into
XC`09it`20and`20release`20it`20back`20to`20the`20server`20process`20by`20conver
Vting`20the`20lock
XC`09to`20NL`20mode.`20`20That`20was`20easy.
X
X`09DO`20I`20=`201,16
X`09`20`20STATBLK.VAL_BLOCK(I)`20=`20BUFFER(I)`20!Put`20request`20buffer`20into
V`20value`20block.
X`09END`20DO
X
X`09ISTAT=SYS$ENQ(,%VAL(LCK$K_NLMODE),STATBLK,%VAL(FLAG),,,,,,,)`20!Cnv`20to
V`20NL
X
X`09IF(ISTAT`20.NE.`20SS$_NORMAL)THEN`09!If`20error`20in`20enqueue,
X`09`20`20CALL`20LIB$SIGNAL(%VAL(ISTAT))`09!Display`20error`20message,
X`09`20`20STATUS`20=`20ISTAT`09`09!and`20return`20error`20status`20to`20caller.
V
X`09`20`20RETURN
X`09END`20IF
X
X`09IF`20(STATBLK.CONDITION`20.NE.`20SS$_NORMAL)THEN`20`20!If`20error`20in`20st
Vatus,
X`09`20`20CALL`20LIB$SIGNAL(%VAL(STATBLK.CONDITION))`20`20!Display`20error`20me
Vssage,
X`09`20`20STATUS`20=`20STATBLK.CONDITION`09`20!and`20return`20error`20status
V`20to`20caller.
X`09`20`20RETURN
X`09END`20IF
X
X`09STATUS=1`09`09`09!Everything`20worked,`20return`20status`20=`201.
X`09RETURN
X
X`09END
$ call unpack [.COMM]SERVER_SEND.FOR;1 757782103 ""
$!
$ create 'f'
X`09PROGRAM`20SUB_TEST
XC`09This`20program`20is`20used`20to`20test`20subroutine`20SERVER_SEND
XC`09To`20compile`20and`20link:
XC`09FORTRAN`20SUB_TEST
XC`09FORTRAN`20SERVER_SEND
XC`09LINK`20SUB_TEST,SERVER_SEND
X
X`09CHARACTER*20`09DEVICE_NAME`20/'PLC_12'/
X`09BYTE`09`09BUFFER(16)
X`09INTEGER*4`09STATUS
X`09CHARACTER*23`09DATE_TIME
X
X`09CALL`20LIB$DATE_TIME(DATE_TIME)
X`09TYPE`20*,DATE_TIME`09`09!Display`20starting`20time
X
X`09BUFFER(1)`20=`200
X10`09BUFFER(1)`20=`20BUFFER(1)`20+`201
X`09CALL`20SERVER_SEND(DEVICE_NAME,BUFFER,STATUS)
X`09IF(BUFFER(1)`20.LT.`20100)GO`20TO`2010
X
X`09CALL`20LIB$DATE_TIME(DATE_TIME)
X`09TYPE`20*,DATE_TIME`09`09!Display`20time`20after`20100`20test`20loops.
X`09END
$ call unpack [.COMM]SUB_TEST.FOR;1 929630526 ""
$ v=f$verify(v)
$ exit