$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 8.3
$!   On 12-APR-1993 08:16:10.00   By user GOATHUNTER (@WKUVX1.BITNET)
$!
$! The VMS_SHARE software that created this archive
$!    was written by  Andy Harper, Kings College London UK
$!    -- December 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. FID.DESC;1
$!       2. FID_TEST.C;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 = "!"
$ if f$getsyi("CPU") .gt. 127 then $ goto start
$ 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$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:
$ x=f$search(P1)
$ if x .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped"
$ delete 'f'*
$ exit
$file_absent:
$ 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(s,p)LOCAL x1,x2;x1:=INDEX(t,SUBSTR(s,p,1))-1;x2:=INDEX(t,
SUBSTR(s,p+1,1))-1;RETURN 16*x1+x2;ENDPROCEDURE;
PROCEDURE SkipPartsep LOOP EXITIF MARK(NONE)=END_OF(b);EXITIF INDEX(ERASE_LINE,
"-+-+-+-+-+-+-+-+")=1;ENDLOOP;ENDPROCEDURE;PROCEDURE ProcessLine LOCAL c,s,l,b,
n,p;c := ERASE_CHARACTER(1);s := ERASE_LINE;IF c = "X" THEN SPLIT_LINE; ENDIF;
MOVE_HORIZONTAL(-1);l := LENGTH(s);p := 1;LOOP EXITIF p > l;c := SUBSTR(s,p,1);
p := p+1;CASE c FROM ' ' TO '`' ['`']: COPY_TEXT(ASCII(GetHex(s,p))); p:=p+2;[
' ']: p:=p+1;[INRANGE,OUTRANGE]: COPY_TEXT(c);ENDCASE;ENDLOOP;ENDPROCEDURE;
PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=END_OF(b);
IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep;ELSE ProcessLine;
MOVE_HORIZONTAL(1);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'*
$ checksum 'P1'
$ if checksum$checksum .nes. P2 then $ -
  e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ exit
$ endsubroutine
$start:
$!
$ create 'f'
XThis`20file`20features`20code`20previously`20published`20in`20the`20March/Apri
Vl`201993`20issue`20
Xof`20Digital`20Systems`20Journal.`20It`20was`20first`20published`20as`20part
V`20of`20George`20
XMerriman's`20article`20"Improve`20I/O`20Performance`20With`20OpenVMS`20File
V`20
XIndentifiers,"`20which`20ran`20on`20page`2012.`20For`20some`20OpenVMS`20applic
Vations,`20the`20
Xoverhead`20cost`20of`20directory`20processing`20outweighs`20the`20advantages
V`20of`20the`20
Xhierarchical`20directory`20structure.`20You`20can`20use`20OpenVMS`20file`20ide
Vntifiers`20and`20
XRMS`20temporary`20files`20to`20avoid`20this`20costly`20directory`20processing.
V
X
$ call unpack FID.DESC;1 206389010 ""
$!
$ create 'f'
X#include`20stdio`09`09`09`20`20`20`20/*`20standard`20I/O`20*/
X#include`20rms`09`09`09`20`20`20`20/*`20loads`20RMS`20control`20block`20defini
Vtions`20*/
X#include`20fiddef`09`09`09`20`20`20`20/*`20loads`20FID`20structure`20definitio
Vn`20*/
X#include`20dvidef`09`09`09`20`20`20`20/*`20loads`20$GETDVI`20definitions`20*/
X#include`20descrip`09`09`20`20`20`20/*`20loads`20VMS`20descriptor`20definition
Vs`20*/
X
X#define`20DEV_NAME`20"FILE_DEV"`09`20`20`20`20/*`20logical`20for`20disk`20devi
Vce`20*/
X#define`20FILE_NAME`20"TEST.DAT"`09`20`20`20`20/*`20name`20for`20file`20in`20h
Veader`20record`20*/
X#define`20TEST_REC`20"This`20is`20a`20test"`20`20`20/*`20text`20of`20test`20re
Vcord`20*/
X
X/*`20some`20convenient`20VMS`20type`20definitions`20*/
Xtypedef`20unsigned`20char`20BYTE;
Xtypedef`20unsigned`20short`20WORD;
X
X/*`20define`20RMS`20structures`20as`20types`20*/
Xtypedef`20struct`20FAB`20RMS_FAB;
Xtypedef`20struct`20RAB`20RMS_RAB;
Xtypedef`20struct`20NAM`20RMS_NAM;
Xtypedef`20struct`20fiddef`20VMS_FID;
X
X/*`20define`20item`20list`20type`20*/
Xtypedef`20struct`20vms_itemlist_3`20`7B
X`20`20`20`20WORD`20buf_len;
X`20`20`20`20WORD`20code;
X`20`20`20`20unsigned`20buffer;
X`20`20`20`20WORD`20*ret_len;
X`20`20`20`20`7D`20VMS_ITEMLIST_3;
X
X/*`20define`20IOSB`20type`20*/
Xtypedef`20struct`20vms_iosb`20`7B
X`20`20`20`20WORD`20code;
X`20`20`20`20WORD`20length;
X`20`20`20`20unsigned`20info;
X`20`20`20`20`7D`20VMS_IOSB;
X
X
X/******`20variable`20declarations`20******/
X
X/*`20the`20RMS`20control`20blocks`20*/
Xstatic`20RMS_FAB`20fab;
Xstatic`20RMS_NAM`20nam;
Xstatic`20RMS_RAB`20rab;
X
X/*`20buffer`20for`20reading`20back`20the`20test`20record`20*/
Xstatic`20char`20read_buf`5B256`5D;
X
X/*`20saved`20FID`20and`20device`20info`20*/
Xstatic`20VMS_FID`20sav_fid;
Xstatic`20char`20sav_dvi`5BNAM$C_DVI`5D;
X
X/*`20$GETDVI`20data`20declarations`20*/
Xstatic`20VMS_ITEMLIST_3`20dvi_itm`5B2`5D;`09/*`20item`20list`20*/
Xstatic`20VMS_IOSB`20dvi_iosb;`09`09/*`20IOSB`20*/
Xstatic`20WORD`20dvi_len;`09`09`09/*`20return`20length`20*/
Xstatic`20char`20dvi_str`5B64`5D;`09`09/*`20returned`20physical`20device`20name
V`20*/
Xstatic`20$DESCRIPTOR(dev_d,`20DEV_NAME);`09/*`20device`20logical`20name`20*/
X
X/*`20descriptor`20and`20buffer`20for`20returned`20file`20name`20*/
Xstatic`20char`20fname_buf`5B256`5D;
Xstatic`20$DESCRIPTOR(fname_d,`20fname_buf);
Xstatic`20WORD`20fname_len;
X
Xmain()
X`7B
Xint`20sys_stat;
X
X
X/******`20CREATE`20A`20PERMANENT`20TEMPORARY`20FILE`20*******/
X
X/*`20set`20up`20item`20list`20for`20SYS$GETDVI`20and`20get`20physical`20name
V`20of`20device`20*/
Xdvi_itm`5B0`5D.code`20=`20DVI$_DEVNAM;
Xdvi_itm`5B0`5D.buf_len`20=`20sizeof(dvi_str);
Xdvi_itm`5B0`5D.buffer`20=`20`26dvi_str;
Xdvi_itm`5B0`5D.ret_len`20=`20`26dvi_len;
Xdvi_itm`5B1`5D.code`20=`20dvi_itm`5B1`5D.buf_len`20=`200;
X
Xsys_stat`20=`20sys$getdviw`20(
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`200,`09`20`20`20`20/*`20efn`20*/
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`200,`09`20`20`20`20/*`20channel`20*
V/
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`26dev_d,`09`20`20`20`20/*`20devi
Vce`20name`20*/
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`26dvi_itm,`20`20`20`20/*`20item
V`20list`20*/
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`26dvi_iosb,`20`20`20/*`20IOSB
V`20*/
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`200,`09`20`20`20`20/*`20AST`20addre
Vss`20*/
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`200,`09`20`20`20`20/*`20AST`20param
V`20*/
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`200);`09`20`20`20`20/*`20null`20arg
Vument`20*/
Xif`20(!(sys_stat`20`26`201))`20`7Bsys$exit(sys_stat);`7D
Xif`20(!(dvi_iosb.code`20`26`201))`20`7Bsys$exit(dvi_iosb.code);`7D
X
X/*`20cleanup`20and`20sanity`20check`20of`20device`20name`20length`20*/
X/*`20the`20trailing`20colon`20MUST`20be`20removed`20*/
X`09`20if`20((dvi_len`20>`2015)
X`09`7C`7C`20(dvi_len`20==`200))
X`20`20`20`20sys$exit(0);
Xif`20(dvi_str`5Bdvi_len`20-`201`5D`20=`20':')
X`20`20`20`20dvi_len`20-=`201;
X
X/*`20set`20up`20FAB`20block`20*/
Xfab`20=`20cc$rms_fab;`09`09`09/*`20initialize`20the`20FAB`20*/
Xfab.fab$l_nam`20=`20`26nam;`09`09`09/*`20link`20to`20NAM`20block`20*/
Xfab.fab$l_fop`20=`20FAB$M_TMP`09`09/*`20specify`20temporary`20file`20*/
X`09`09`7C`20FAB$M_NAM;`09`09/*`20and`20NAM`20block`20input`20*/
Xfab.fab$b_fac`20=`20FAB$M_PUT;`09`09/*`20write`20access`20*/
Xfab.fab$l_fna`20=`20FILE_NAME;`09`09/*`20specify`20file`20name`20*/
Xfab.fab$b_fns`20=`20strlen(FILE_NAME);
X
X/*`20set`20up`20NAM`20block`20*/
Xnam`20=`20cc$rms_nam;`09`09`09/*`20initialize`20NAM`20block`20*/
X
X/*`20the`20nam$t_dvi`20field`20is`20a`20counted`20string:`20the`20first`20byte
V`20is`20the`20*/
X/*`20length`20of`20the`20device`20name`20string,`20which`20starts`20with`20the
V`20second`20byte`20*/
Xmemcpy(`26nam.nam$t_dvi`5B1`5D,`20dvi_str,`09/*`20specify`20dev`20name`20*/
X`09`20`20`20`20dvi_len);
Xnam.nam$t_dvi`5B0`5D`20=`20dvi_len;`09`09/*`20and`20length`20*/
X
X/*`20set`20up`20RAB`20block`20*/
Xrab`20=`20cc$rms_rab;`09`09`09/*`20initialize`20RAB`20block`20*/
Xrab.rab$l_fab`20=`20`26fab;`09`09`09/*`20link`20to`20FAB`20*/
Xrab.rab$l_rbf`20=`20TEST_REC;`09`09/*`20point`20to`20test`20record`20*/
Xrab.rab$w_rsz`20=`20strlen(TEST_REC);`09/*`20test`20record`20size`20*/
X
X/*`20create`20the`20file`20*/
Xsys_stat`20=`20SYS$CREATE(`26fab,`20NULL,`20NULL);
Xif`20(!(sys_stat`20`26`201))`20`7Bsys$exit(sys_stat);`7D
X
X/*`20display`20the`20file`20information`20*/
Xprintf("The`20file`20was`20created`20on`20%15s`20with`20FID`20%d,%d,%d`5Cn",
X`09`20`20`20`20`26nam.nam$t_dvi`5B1`5D,`20nam.nam$w_fid`5B0`5D,
X`09`20`20`20`20nam.nam$w_fid`5B1`5D,`20nam.nam$w_fid`5B2`5D);
X
X/*`20save`20the`20FID`20and`20DVI`20information`20*/
Xmemcpy(`26sav_fid,`20`26nam.nam$w_fid,`20sizeof(sav_fid));
Xmemcpy(`26sav_dvi,`20`26nam.nam$t_dvi,`20sizeof(sav_dvi));
X
X/*`20connect`20the`20record`20stream`20*/
Xsys_stat`20=`20SYS$CONNECT(`26rab,`20NULL,`20NULL);
Xif`20(!(sys_stat`20`26`201))`20`7Bsys$exit(sys_stat);`7D
X
X/*`20write`20the`20test`20record`20*/
Xsys_stat`20=`20SYS$PUT(`26rab,`20NULL,`20NULL);
Xif`20(!(sys_stat`20`26`201))`20`7Bsys$exit(sys_stat);`7D
X
X/*`20close`20the`20file`20*/
Xsys_stat`20=`20SYS$CLOSE(`26fab,`20NULL,`20NULL);
Xif`20(!(sys_stat`20`26`201))`20`7Bsys$exit(sys_stat);`7D
X
X
X
X/*********`20OPEN`20THE`20FILE`20FOR`20READ`20ACCESS`20*******/
X
X/*`20get`20and`20display`20the`20file`20name`20*/
Xdev_d.dsc$a_pointer`20=`20`26sav_dvi`5B1`5D;
Xdev_d.dsc$w_length`20=`20sav_dvi`5B0`5D;
Xsys_stat`20=`20LIB$FID_TO_NAME(`26dev_d,`20`26sav_fid,`20`26fname_d,`20`26fnam
Ve_len);
Xif`20(!(sys_stat`20`26`201))`20`7Bsys$exit(sys_stat);`7D
Xfname_buf`5Bfname_len`5D`20=`20'`5C0';
Xprintf("The`20returned`20file`20name`20is`20%s`5Cn",`20fname_buf);
X
X/*`20set`20up`20FAB`20block`20*/
Xfab`20=`20cc$rms_fab;`09`09/*`20initialize`20*/
Xfab.fab$l_fop`20=`20FAB$M_NAM;`09/*`20specify`20NAM`20block`20input`20*/
Xfab.fab$l_nam`20=`20`26nam;`09`09/*`20link`20in`20NAM`20block`20*/
Xfab.fab$b_fac`20=`20FAB$M_GET;`09/*`20read`20access`20*/
X
X/*`20set`20up`20NAM`20block`20*/
Xnam`20=`20cc$rms_nam;`09`09/*`20initialize`20*/
X/*`20set`20up`20saved`20device`20and`20FID`20information`20*/
Xmemcpy(`26nam.nam$w_fid,`20`26sav_fid,`20sizeof(nam.nam$w_fid));
Xmemcpy(`26nam.nam$t_dvi,`20`26sav_dvi,`20sizeof(nam.nam$t_dvi));
X
X/*`20set`20up`20the`20RAB`20block`20*/
Xrab`20=`20cc$rms_rab;`09`09`09`20`20`20`20/*`20initialize`20the`20RAB`20*/
Xrab.rab$l_fab`20=`20`26fab;`09`09`09`20`20`20`20/*`20link`20to`20FAB`20*/
Xrab.rab$l_ubf`20=`20read_buf;`09`09`20`20`20`20/*`20point`20to`20read`20buffer
V`20*/
Xrab.rab$w_usz`20=`20sizeof(read_buf)`20-`201;`09`20`20`20`20/*`20allow`20for
V`20terminating`20'`5C0'`20*/
X
X/*`20open`20the`20file`20*/
Xsys_stat`20=`20SYS$OPEN(`26fab,`20NULL,`20NULL);
Xif`20(!(sys_stat`20`26`201))`20`7Bsys$exit(sys_stat);`7D
X
X/*`20connect`20the`20record`20stream`20*/
Xsys_stat`20=`20SYS$CONNECT(`26rab,`20NULL,`20NULL);
Xif`20(!(sys_stat`20`26`201))`20`7Bsys$exit(sys_stat);`7D
X
X/*`20read`20a`20record`20*/
Xsys_stat`20=`20SYS$GET(`26rab,`20NULL,`20NULL);
Xif`20(!(sys_stat`20`26`201))`20`7Bsys$exit(sys_stat);`7D
X
Xread_buf`5Brab.rab$w_rsz`5D`20=`20'`5C0';`09`09`20`20`20`20/*`20terminate`20th
Ve`20string`20*/
Xprintf("The`20record`20returned`20is:`20%s`5Cn",`20read_buf);
X
X/*`20close`20the`20file`20*/
Xsys_stat`20=`20SYS$CLOSE(`26fab,`20NULL,`20NULL);
Xif`20(!(sys_stat`20`26`201))`20`7Bsys$exit(sys_stat);`7D
X
X
X/*******`20DELETE`20THE`20FILE`20WITH`20THE`20$ERASE`20FUNCTION`20******/
X
X/*`20set`20up`20FAB`20block`20*/
Xfab`20=`20cc$rms_fab;`09`09/*`20initialize`20*/
Xfab.fab$l_fop`20=`20FAB$M_NAM;`09/*`20specify`20NAM`20block`20input`20*/
Xfab.fab$l_nam`20=`20`26nam;`09`09/*`20link`20in`20NAM`20block`20*/
X
X/*`20set`20up`20NAM`20block`20*/
Xnam`20=`20cc$rms_nam;`09`09/*`20initialize`20*/
X/*`20set`20up`20saved`20device`20and`20FID`20information`20*/
Xmemcpy(`26nam.nam$w_fid,`20`26sav_fid,`20sizeof(nam.nam$w_fid));
Xmemcpy(`26nam.nam$t_dvi,`20`26sav_dvi,`20sizeof(nam.nam$t_dvi));
X
X/*`20delete`20the`20file`20*/
Xsys_stat`20=`20SYS$ERASE(`26fab,`20NULL,`20NULL);
Xif`20(!(sys_stat`20`26`201))`20`7Bsys$exit(sys_stat);`7D
X
X`7D
$ call unpack FID_TEST.C;1 122427941 ""
$ v=f$verify(v)
$ exit