From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 10-AUG-1989 16:49
To:	MRGATE::"ARISIA::EVERHART"
Subj:	VMS_SHARE (7.1-004) 4/8

Message-Id:  <8908102010.AA00293@crdgw1.ge.com>
Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu, 10 AUG 89 11:48:09 PDT
Received: from NSFnet-Relay.AC.UK by KL.SRI.COM with TCP; Thu, 10 Aug 89 11:31:14 PDT
Received: from oak.cc.kcl.ac.uk by NSFnet-Relay.AC.UK   via Janet with NIFTP
           id aa09531; 10 Aug 89 18:18 BST
Date: 		Thu, 10 AUG 89 18:18:04 GMT
From: UDAA055%oak.cc.kcl.ac.uk@NSFnet-Relay.AC.UK
To: info-vax <@NSFnet-Relay.AC.UK:info-vax@kl.sri.com>
Subject:        VMS_SHARE (7.1-004) 4/8
Sender: "JANET UDAA055@UK.AC.KCL.CC.OAK" <UDAA055%oak.cc.kcl.ac.uk@NSFnet-Relay.AC.UK>
Mailer:         Janet_Mailshr V3.4 (23-May-1989)

-+-+-+-+-+-+-+-+ START OF PART 4 -+-+-+-+-+-+-+-+
X  Copy_Line( "$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )");
X  Copy_Line( "$!");
X  Copy_Line( "$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:");
X
X  filecount := 0;
X  nextfile := Start_File_List;
X  LOOP
X     POSITION(nextfile);
X     EXITIF MARK(NONE) = END_OF(CURRENT_BUFFER);
X
X     file := SUBSTR(CURRENT_LINE,1,INDEX(CURRENT_LINE," ")-1);
X     MOVE_VERTICAL(1);
X     nextfile := MARK(NONE);
X
X     POSITION(Xbuffer);
X     filecount := filecount + 1;
X     Copy_Line( FAO("$!!     !3UL. !AS", filecount, file));
X
X     IF DEBUG_state
X        THEN
X          Inform("I","DBGPROADFIL","Adding name """ + file + """ to prologue
V");
X     ENDIF;
X
X  ENDLOOP;
X  POSITION(Xbuffer);
X
X  Copy_Line( "$!");
X  Copy_Line( "$set=""set""");
X  Copy_Line( "$set symbol/scope=(nolocal,noglobal)");
X  Copy_Line( "$f=f$parse(""SHARE_TEMP"",""SYS$SCRATCH:.TMP_""+f$getjpi("""",
V""PID""))");
X  Copy_Line( "$e=""write sys$error  """"%"+FAC_unpack+""""", """);
X  Copy_Line( "$w=""write sys$output """"%"+FAC_unpack+""""", """);
X  Copy_Line( "$ if f$trnlnm(""SHARE_LOG"") then $ w = ""!""");
X  Copy_Line( "$ if f$getsyi(""version"") .ges. ""V4.4"" then $ goto START");
X  Copy_Line( "$ e ""-E-OLDVER, Must run at least VMS 4.4""");
X  Copy_Line( "$ v=f$verify(v)");
X  Copy_Line( "$ exit 44");
X  Copy_Line( "$UNPACK: SUBROUTINE ! P1=filename, P2=checksum");
X  Copy_Line( "$ if f$search(P1) .eqs. """" then $ goto file_absent");
X  Copy_Line( "$ e ""-W-EXISTS, File ''P1' exists. Skipped.""");
X  Copy_Line( "$ delete/nolog 'f'*");
X  Copy_Line( "$ exit");
X  Copy_Line( "$file_absent:");
X  Copy_Line( "$ if f$parse(P1) .nes. """" then $ goto dirok");
X  Copy_Line( "$ dn=f$parse(P1,,,""DIRECTORY"")");
X  Copy_Line( "$ w ""-I-CREDIR, Creating directory ''dn'.""");
X  Copy_Line( "$ create/dir 'dn'");
X  Copy_Line( "$ if $status then $ goto dirok");
X  Copy_Line( "$ e ""-E-CREDIRFAIL, Unable to create ''dn'. File skipped.""")
V;
X  Copy_Line( "$ delete/nolog 'f'*");
X  Copy_Line( "$ exit");
X  Copy_Line( "$dirok:");
X  Copy_Line( "$ w ""-I-PROCESS, Processing file ''P1'.""");
X  COPY_TEXT( "$ define/user sys$output nl:");`009! suppress TPU 'lines read'
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Create_Prologue_Unpacker(Xbuffer)
X
X  Reuse_Buffer(Xbuffer);
X
X  Copy_Line("$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'");
X
X  Pack_TPU( "PROCEDURE Unpacker" );
X  Pack_TPU( "ON_ERROR" );`009`009`009`009! Trap SEARCH error
X  Pack_TPU( "ENDON_ERROR;" );
X
X  Pack_TPU( "SET(FACILITY_NAME,"""+FAC_unpack+""");" );`009! SETUP
X  Pack_TPU( "SET(SUCCESS,OFF);" );
X  Pack_TPU( "SET(INFORMATIONAL,OFF);" );
X  Pack_TPU( "f:=GET_INFO(COMMAND_LINE,""file_name"");" );
X  Pack_TPU( "buff:=CREATE_BUFFER(f,f);" );
X `032
X  Pack_TPU( "p:=SPAN("" "")@r&LINE_END;" );
X  Pack_TPU( "POSITION(BEGINNING_OF(buff));" );
X  Pack_TPU( "LOOP" );`009`009`009`009`009! Trailing blank removal
X  Pack_TPU( "   EXITIF SEARCH(p,FORWARD)=0;" );
X  Pack_TPU( "   POSITION(r);" );
X  Pack_TPU( "   ERASE(r);" );
X  Pack_TPU( "ENDLOOP;" );
X
X  Pack_TPU( "POSITION(BEGINNING_OF(buff));" );
X  Pack_TPU( "g:=0;" );
X  Pack_TPU( "LOOP" );`009`009`009`009`009! Unwrap lines
X  Pack_TPU( "  EXITIF MARK(NONE)=END_OF(buff);" );
X  Pack_TPU( "  x:=ERASE_CHARACTER(1);" );
X  Pack_TPU( "  IF g = 0 THEN" );
X  Pack_TPU( "    IF x=""X"" THEN MOVE_VERTICAL(1);ENDIF;" );
X  Pack_TPU( "    IF x=""V"" THEN APPEND_LINE;");
X  Pack_TPU( "      MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;"
V );
X  Pack_TPU( "    IF x=""+"" THEN g:=1;ERASE_LINE;ENDIF;" );
X  Pack_TPU( "  ELSE" );
X  Pack_TPU( "    IF x=""-"" THEN g:=0;ENDIF; ");
X  Pack_TPU( "    ERASE_LINE;" );
X  Pack_TPU( "  ENDIF;" );
X  Pack_TPU( "ENDLOOP;" );
X
X  Pack_TPU( "p:=""" + Quote_Flag + """;" );
X  Pack_TPU( "POSITION(BEGINNING_OF(buff));" );
X  Pack_TPU( "LOOP" );`009`009`009`009`009! Restore escaped chars
X  Pack_TPU( "  r:=SEARCH(p,FORWARD);" );
X  Pack_TPU( "  EXITIF r=0;" );
X  Pack_TPU( "  POSITION(r);" );
X  Pack_TPU( "  ERASE(r);" );
X  Pack_TPU( "  COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));" );
X  Pack_TPU( "ENDLOOP;" );
X
X  Pack_TPU( "o:=GET_INFO(COMMAND_LINE,""output_file"");" );
X  Pack_TPU( "WRITE_FILE(buff,o);" );
X
X  Pack_TPU( "ENDPROCEDURE;" );
X
X  Pack_TPU( "Unpacker;");`009`009`009`009! procedure call
X  Pack_TPU( "EXIT;" );    SPLIT_LINE;`009`009`009! EXIT code
X
X  COPY_TEXT("$ delete/nolog 'f'*");
X
XENDPROCEDURE;
X`012
XPROCEDURE Create_Prologue_Trail(Xbuffer)
X
X  Reuse_Buffer(Xbuffer);
X
X  Copy_Line( "$ CHECKSUM 'P1'");
X  Copy_Line( "$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT");
X  Copy_Line( "$ e ""-E-CHKSMFAIL, Checksum of ''P1' failed.""");
X  Copy_Line( "$ ENDSUBROUTINE");
X  COPY_TEXT( "$START:");
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Create_File_Header(Xbuffer);
X
X  Reuse_Buffer(Xbuffer);
X  COPY_TEXT("$ create/nolog 'f'");
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Create_File(Xbuffer, Filename)
XLOCAL r;
X
XON_ERROR
X  Inform("E","FILRDERR", "Error reading from file " + FileName);
XENDON_ERROR;
X
X  Reuse_Buffer(Xbuffer);
X  READ_FILE(FileName);
X
X  IF DEBUG_state
X    THEN
X      r := GET_INFO(Xbuffer,"RECORD_COUNT");
X      Inform("I","DBGRDFIL",FAO("!UL line!%S read from file !AS",r,FileName)
V);
X  ENDIF;
X
XENDPROCEDURE;
X
X
XPROCEDURE Create_File_Trailer(Xbuffer, Filename, Checksum);
X
X  Reuse_Buffer(Xbuffer);
X  COPY_TEXT("$ CALL UNPACK " + Filename + " " + Checksum);
X
XENDPROCEDURE;
X
X
XPROCEDURE Create_Epilogue(Xbuffer);
X
X  Reuse_Buffer(Xbuffer);
X  Copy_Line("$ v=f$verify(v)");
X  COPY_TEXT("$ EXIT");
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! + PART SPLITTING ROUTINES                                            +
X! +                                                                    +
X! +    Find_Break(Xbuffer,Max_Size)                                    +
X! +       This routine uses a fast binary search algorithm to find the +
X! +       first line in the given buffer which straddles a given break +
X! +       point - I.E. where the size of the buffer up to and including+
X! +       that line would just go over the 'Max_Size' value (bytes).   +
X! +       This allows us to quickly determine where a buffer should be +
X! +       split when chopping up the info into several small parts.    +
X! +                                                                    +
X! +    Insert_Part_Separator(Part,Xendbuf,Xstartbuf,Split_status)      +
X! +       This routine is responsible for choosing the correct part    +
X! +       separator flag to insert at the beginning and end of parts.  +
X! +       Determination is controlled by two factors:-                 +
X! +                                                                    +
X! +         First by the 'split-status' parameter, which determines if +
X! +         a part break is permitted at this time (its not if, for    +
X! +         example, we are currently in the middle of the TPU code    +
X! +         which does the unpacking!) and, if it is, whether DCL      +
X! +         $GOTO's and labels are useable at the breaks.              +
X! +                                                                    +
X! +         Second, the type of part separator is determined by looking+
X! +         at the data in the buffer immediately following the break  +
X! +         point. If it starts with '$' then we are splitting the     +
X! +         buffer at the DCL code which is part of the unpacking      +
X! +         control thus we can use $GOTO and a label.  If not, then   +
X! +         we are in the midst of user data and should use the        +
X! +         special flag lines                                         +
X! +                                                                    +
X! +    Add_to_part(Xbuffer,split-status)                               +
X! +       This takes a buffer of information and adds as much of it    +
X! +       as possible into the current part buffer, in order to fill   +
X! +       it to its maximum size.  The remainder of the buffer is      +
X! +       then copied into the part buffer in similar fashion, and     +
X! +       we repeat until the supply of information is exhausted. Each +
X! +       time the part buffer fills up it is flushed out to disk.     +
X! +       Part 1 is treated separately as the attention message at the +
X! +       head of the part needs to be updated later with the actual   +
X! +       number of parts created. We therefore keep it around until   +
X! +       the end in a separate buffer and flush it to disk at the end.+
X! +                                                                    +
X! +    Flush_buffer(Xbuffer,Part)                                      +
X! +       Flushes the specified buffer to disk if not empty. The name  +
X! +       of the file used is constructed from the original share      +
X! +       file template and the current part number.                   +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X`012                                              `032
XPROCEDURE Find_Break(Xbuffer,Max_Size)
XLOCAL Low, High, Size, Line_Size, mb, New_Line, Cur_Line;
X
X  IF DEBUG_State
X    THEN
X      Inform("I","DBGFNDBRKMAX","Max free bytes =" + STR(Max_Size));
X  ENDIF;
X
X  Low      := 0;
X  High     := GET_INFO(Xbuffer,"record_count") - 1;
X  Cur_Line := 0;
X
X  mb := BEGINNING_OF(Xbuffer);
X  POSITION(mb);
X
X  ! Special case of an empty buffer
X  IF mb = END_OF(Xbuffer) THEN RETURN(0); ENDIF;
X
X  ! Special case check to ensure at least one line fits in available space
X  IF LENGTH(CURRENT_LINE)+3 > Max_Size THEN RETURN(0); ENDIF;
X
X
X  LOOP
X
X     New_Line := (Low+High) / 2;
X     MOVE_VERTICAL(New_Line-Cur_Line);
X     Cur_Line := New_Line;
X
X     Size:=LENGTH(CREATE_RANGE(mb,MARK(NONE),NONE))+3*Cur_Line;
X     Line_Size := LENGTH(CURRENT_LINE) + 3;
X
X     IF DEBUG_state
X       THEN
X         Inform("I","DBGFNDBRKRNG",FAO("Search range = !UL-!UL",Low,High));
X         Inform("I","DBGFNDBRKCURL",FAO("(!UL) ""!AS""",Cur_line,CURRENT_LIN
VE));
X         Inform("I","DBGFNDBRKSIZE",FAO("Size=!UL, line=!UL",Size,Line_Size)
V);
X     ENDIF;
X
X     EXITIF (Size < Max_Size) AND (Size+Line_Size >= Max_Size);
X
X     IF Size < Max_Size
X       THEN
X         Low := Cur_Line + 1;
X       ELSE
X         High := Cur_Line - 1;
X     ENDIF;
X
X  ENDLOOP;
X
X  MOVE_HORIZONTAL(-1);
X  RETURN( CREATE_RANGE( mb, MARK(NONE), NONE ) );
X
XENDPROCEDURE;
X`012
XPROCEDURE Insert_Part_Separator(Part, Xendbuf, Xstartbuf, SPLIT_status)
XLOCAL end_text,start_text;
X
X   IF SPLIT_status = SPLIT_disallowed
X     THEN
X       Inform("F","CANTSPLIT","Part split tried where disallowed");
X       EXIT;
X   ENDIF;
X
X   POSITION( BEGINNING_OF(Xstartbuf) );
X
X   IF (CURRENT_CHARACTER = "$") AND (SPLIT_status = SPLIT_permit_goto)
X      THEN`009`009`009! Executable DCL code insert GOTO/label pair
X         end_text  := FAO(FAO_end_goto, Part+1);
X         start_text:= FAO(FAO_start_label, Part+1);
X      ELSE`009`009`009! User data, insert recognizable separators
X         end_text  := FAO(FAO_end_part, Part);
X         start_text:= FAO(FAO_start_part, Part+1);
X   ENDIF;       `032
X
X   Copy_Line(start_text);      MOVE_VERTICAL(-1);
X   POSITION(END_OF(Xendbuf));  COPY_TEXT(end_text);
X
XENDPROCEDURE;
X`012
XPROCEDURE Add_To_Part(Xbuffer, SPLIT_status)
XLOCAL Size_Xbuffer, Size_part_buf;
X
X  LOOP
X
X    Size_Xbuffer  := Size_Buffer(Xbuffer);
X    Size_part_buf := Size_Buffer(part_buf);`032
X
X    IF DEBUG_state THEN
X       Inform( "I","DBGADPTMAX" ,FAO("     Max_bytes    = !UL",Max_Bytes));
X       Inform( "I","DBGADPTXSIZ",FAO("     Size xbuffer = !UL",Size_Xbuffer)
V);
X       Inform( "I","DBGADPTPSIZ",FAO("     Size part_buf= !UL",Size_part_buf
V));
X    ENDIF;
X
X    EXITIF Size_Xbuffer <= Max_Bytes-Size_part_buf-Reserved;
X
X    PartNo := PartNo + 1;
X    xbuf_range := Find_Break(Xbuffer,Max_Bytes-Size_part_buf-Reserved);
X    POSITION( END_OF(part_buf) );
X    IF xbuf_range <> 0`032
X      THEN
X        Move_Info(xbuf_range, part_buf);
X    ENDIF;
X    Insert_Part_Separator(PartNo, part_buf, Xbuffer, SPLIT_status);
X         `032
X    IF PartNo = 1
X       THEN
X          Move_Info(part_buf, pt1_buf);
X       ELSE
X          Write_Part(part_buf, PartNo);  ERASE(part_buf);
X    ENDIF;
X
X  ENDLOOP;
X
X  Move_Info(Xbuffer, part_buf);
X
XENDPROCEDURE;
X
X
X
XPROCEDURE Flush_Buffer(Xbuffer,Part)
X
X  IF Size_Buffer(Xbuffer) > 0
X     THEN
X        Write_Part(Xbuffer,Part);
X  ENDIF;
X
XENDPROCEDURE;
X`012
X! +--------------------------------------------------------------------+
X! +   MAIN PROGRAM                                                     +
X! +                                                                    +
X! +   This is the main control loop of the program, responsible for    +
X! +   picking up the parameters, creating the prologue and epilogue of +
X! +   the share file, setting up global constants and variables etc.   +
X! +                                                                    +
X! +   It also contains the main loop which goes around each of the     +
X! +   specified files to be packed into the share file.                +
X! +                                                                    +
X! +--------------------------------------------------------------------+
X
X
X
XInit_Constants;
XInit_Tables;
X
XSET(SUCCESS,OFF);`009`009! Suppress non-error messages
XSET(FACILITY_NAME, FAC_name);`009! identify ourself in errors
X
Xinfo_buf  := CREATE_BUFFER("`123info`125", GET_INFO(COMMAND_LINE, "FILE_NAME
V"));
Xpart_buf  := CREATE_BUFFER("`123part`125");
Xpt1_buf   := CREATE_BUFFER("`123part_1`125");
Xwork_buf  := CREATE_BUFFER("`123work`125");
X
X
X! PICK UP PARAMETERS FROM THE OUTSIDE WORLD
XPOSITION( info_buf);
XUsername   := CURRENT_LINE;      MOVE_VERTICAL(1);
XIF DEBUG_state
X  THEN
X    Inform("I","DBGPAR", "Params: Creator = """ + Username + """");
XENDIF;
X
XMax_Blocks:= INT(CURRENT_LINE); MOVE_VERTICAL(1);
XIF DEBUG_state
X  THEN
X    Inform("I","DBGPAR", "Params: Max_Blocks = " + STR(Max_Blocks));
XENDIF;
X
X
XShare_File:= CURRENT_LINE;      MOVE_VERTICAL(1);
XIF DEBUG_state
X  THEN
+-+-+-+-+-+-+-+-  END  OF PART 4 +-+-+-+-+-+-+-+-

