MODULE EXTRACT ( MAIN = EXTRACT, ADDRESSING_MODE (EXTERNAL=LONG_RELATIVE, NONEXTERNAL=LONG_RELATIVE), LANGUAGE (BLISS32), IDENT = 'X0001D' ) = BEGIN ! ! Copyright (c) 1979 ! Digital Equipment Corporation, Maynard, Massachusetts 01754 ! ! This software is furnished under a license for use only on a single ! computer system and may be copied only with the inclusion of the ! above copyright notice. This software, or any other copies thereof, ! may not be provided or otherwise made available to any other person ! except for use on such system and to one who agrees to these license ! terms. Title to and ownership of the software shall at all times ! remain in DEC. ! ! The information in this software is subject to change without notice ! and should not be construed as a commitment by Digital Equipment ! Corporation. ! ! DEC assumes no responsibility for the use or reliability of its ! software on equipment which is not supplied by DEC. !++ ! ! FACILITY: System Update Procedure Utilities ! ! ABSTRACT: ! ! This program compares two SLP update files and removes from file 1 ! any update that is found in its identical form in file 2. Thus, for ! example, bug fixes may be removed from a composite update file by ! running the bug fix file against it, leaving only enhancements ! and conflicts. ! ! ENVIRONMENT: ! ! VAX/VMS Operating System ! !-- ! ! ! AUTHOR: Andrew C. Goldstein, CREATION DATE: 31-Jan-1979 20:54 ! ! MODIFIED BY: ! !** LIBRARY 'SYS$LIBRARY:STARLET.L32'; LIBRARY 'SYS$LIBRARY:CLIMAC.L32'; LIBRARY 'SYS$LIBRARY:TPAMAC.L32'; FORWARD ROUTINE EXTRACT, ! main program GET_UPDATE : NOVALUE, ! get next SLP update from file READ_LINE : NOVALUE, ! read a line from a file FORMAT_COMMAND, ! format a SLP command OUTPUT_TEXT : NOVALUE, ! output update text WRITE_LINE : NOVALUE, ! write line to output file HANDLER; ! facility condition handler MACRO DESCRIPTOR (STRING) = UPLIT (%CHARCOUNT (STRING), UPLIT BYTE (STRING)) %; MACRO ERR_EXIT [] = SIGNAL_STOP (%REMAINING) %; !+ ! ! Module own data ! !- ! ! Format of command data blocks allocated below. ! MACRO RANGE_TOP = 0, 0, 32, 0 %, RANGE_END = 1, 0, 32, 0 %, AUDIT_LEN = 2, 0, 32, 0 %, AUDIT_ADR = 3, 0, 32, 0 %, COMMENT_LEN = 4, 0, 32, 0 %, COMMENT_ADR = 5, 0, 32, 0 %, UPD_SIZE = 6, 0, 32, 0 %, UPD_LINE = 7, 0, 00, 0 %, AUDIT_TEXT = 40, 0, 00, 0 %, COMMENT_TEXT = 73, 0, 00, 0 %, UPD_TEXT =106, 0, 00, 0 %; OWN OUT_LINE : VECTOR [132, BYTE], ! output file line buffer PREV_AUDIT : VECTOR [2], ! descriptor of last compare audit string PREV_TEXT : VECTOR [132, BYTE], ! text buffer of above ! ! Parameters of current SLP command in each file ! RANGE1 : VECTOR [2], ! range of lines deleted AUDIT1 : VECTOR [2], ! descriptor of audit trail COMMENT1 : VECTOR [2], ! descriptor of comment SIZE1, ! number of bytes of text LINE1 : VECTOR [132, BYTE], ! file 1 input line AU_TEXT1 : VECTOR [132, BYTE], ! file 1 audit string CM_TEXT1 : VECTOR [132, BYTE], ! file 1 comment string TEXT1 : VECTOR [100000, BYTE], ! file 1 text buffer RANGE2 : VECTOR [2], ! range of lines deleted AUDIT2 : VECTOR [2], ! descriptor of audit trail COMMENT2 : VECTOR [2], ! descriptor of comment SIZE2, ! number of bytes of text LINE2 : VECTOR [132, BYTE], ! file 2 input line AU_TEXT2 : VECTOR [132, BYTE], ! file 2 audit string CM_TEXT2 : VECTOR [132, BYTE], ! file 2 comment string TEXT2 : VECTOR [100000, BYTE], ! file 2 text buffer ! ! SLP parser output area ! START_LINE, ! starting line number END_LINE, ! ending line number AUDIT_STRING : VECTOR [2], ! descriptor of audit trail COMMENT_STRING : VECTOR [2], ! descriptor of comment ! ! Command parser output area ! FILE1 : VECTOR [2], ! descriptor of input file 1 FILE2 : VECTOR [2], ! descriptor of input file 2 OUTFILE : VECTOR [2], ! descriptor of output file ! ! TPARSE parameter block ! TPARSE_BLOCK : BLOCK [TPA$K_LENGTH0, BYTE] INITIAL (TPA$K_COUNT0), ! ! Request block to get command line from CLI ! GET_COMMAND : $CLIREQDESC (RQTYPE = GETCMD); ! ! Forward reference to TPARSE state tables ! FORWARD CMD_TABLE : VECTOR [0], CMD_KEY : VECTOR [0], SLP_TABLE : VECTOR [0], SLP_KEY : VECTOR [0]; ! ! Junk for opening files ! OWN INRES1 : VECTOR [132, BYTE], ! input file 1 result string INNAM1 : $NAM ( ESA = INRES1, ESS = 132, RSA = INRES1, RSS = 132 ), INFAB1 : $FAB ( DNA = UPLIT BYTE ('.UPD'), DNS = 4, FAC = GET, FOP = SQO, NAM = INNAM1 ), INRAB1 : $RAB ( FAB = INFAB1, UBF = LINE1, USZ = 132 ), INRES2 : VECTOR [132, BYTE], ! input file 2 result string INNAM2 : $NAM ( ESA = INRES2, ESS = 132, RSA = INRES2, RSS = 132, RLF = INNAM1 ), INFAB2 : $FAB ( DNA = UPLIT BYTE ('.UPD'), DNS = 4, FAC = GET, FOP = SQO, NAM = INNAM2 ), INRAB2 : $RAB ( FAB = INFAB2, UBF = LINE2, USZ = 132 ), OUTRES : VECTOR [132, BYTE], ! output file result string OUTNAM : $NAM ( ESA = OUTRES, ESS = 132, RSA = OUTRES, RSS = 132, RLF = INNAM1 ), OUTFAB : $FAB ( FAC = PUT, FOP = (MXV, OFP, SQO), NAM = OUTNAM, ORG = SEQ, RAT = CR, RFM = VAR ), OUTRAB : $RAB ( FAB = OUTFAB, RBF = OUT_LINE ); !+ ! ! Error messages ! ! Macro to generate each error message. ! !- MACRO ERR_MESSAGE (CODE, STRING) = LITERAL %NAME ('ERR_',CODE) = MSG_CODE + FAC_CODE^16; SWITCHES UNAMES; PSECT OWN = $MSG_TEXT; OWN MSG_TEXT : VECTOR [%CHARCOUNT(STRING)+1, BYTE] INITIAL (BYTE (%CHARCOUNT (STRING), STRING)); PSECT OWN = $MSG_INDEX; OWN MSG_INDEX : INITIAL (MSG_TEXT); UNDECLARE MSG_TEXT, MSG_INDEX; SWITCHES NOUNAMES; %ASSIGN (MSG_CODE, MSG_CODE+8) %; ! ! Initialize and label the message sections. ! PSECT OWN = $MSG_TEXT (NOWRITE, ALIGN(0)); OWN MESSAGE_TEXT : VECTOR [0, BYTE]; PSECT OWN = $MSG_INDEX (NOWRITE, ALIGN (2)); OWN MESSAGE_TABLE : VECTOR [0]; COMPILETIME MSG_CODE = 0; ! ! Generate the error messages ! LITERAL FAC_CODE = 69; ! or whatever ERR_MESSAGE (CMD_SYNTAX, 'Command line syntax error'); ERR_MESSAGE (INFILEOPEN, 'Error opening input file '); ERR_MESSAGE (OUTFILEOPEN, 'Error opening output file '); ERR_MESSAGE (OUTCLOSE, 'Error closing output file '); ERR_MESSAGE (SLPSYNTAX, 'SLP syntax error in file '); ERR_MESSAGE (BUFFOVER, 'Compare buffer overflow'); ERR_MESSAGE (READIN, 'I/O error on input file '); ERR_MESSAGE (WRITEOUT, 'I/O error on output file '); PSECT OWN = $OWN$; GLOBAL ROUTINE EXTRACT (START_ADDR, CLI_CALLBACK) = BEGIN !++ ! ! Functional Description: ! ! This is the main routine of the EXTRACT utility. It acquires and ! parses the command line, opens files, and does the main line ! processing. ! ! Calling Sequence: ! standard ! ! Input Parameters: MAP CLI_CALLBACK; ! CLI callback address ! ! Implicit Inputs: ! none ! ! Output Parameters: ! none ! ! Implicit Outputs: ! none ! ! Routines Called: ! none ! ! Routine Value: ! 1 if successful ! assorted error statuses if not ! ! Signals: ! none ! ! Side Effects: ! update file with merged audit trails created ! !-- LABEL MAIN_LOOP; ! main processing loop LOCAL P, ! random pointer MSG_DESC : VECTOR [2], ! message line descriptor PREV_LINE; ! line number of previous line EXTERNAL ROUTINE LIB$PUT_OUTPUT, ! output to console LIB$TPARSE; ! library parsing routine ENABLE HANDLER; ! Begin by parsing the command line and opening the files. ! (.CLI_CALLBACK) (GET_COMMAND, 0, 0); TPARSE_BLOCK[TPA$V_ABBREV] = 1; TPARSE_BLOCK[TPA$V_BLANKS] = 1; TPARSE_BLOCK[TPA$L_STRINGCNT] = .GET_COMMAND[CLI$W_RQSIZE]; TPARSE_BLOCK[TPA$L_STRINGPTR] = .GET_COMMAND[CLI$A_RQADDR]; IF NOT LIB$TPARSE (TPARSE_BLOCK, CMD_TABLE, CMD_KEY) THEN ERR_EXIT (ERR_CMD_SYNTAX); INFAB1[FAB$B_FNS] = .FILE1[0]; INFAB1[FAB$L_FNA] = .FILE1[1]; IF NOT $OPEN (FAB = INFAB1) THEN ERR_EXIT (ERR_INFILEOPEN, INFAB1); IF NOT $CONNECT (RAB = INRAB1) THEN ERR_EXIT (ERR_INFILEOPEN, INRAB1); INFAB2[FAB$B_FNS] = .FILE2[0]; INFAB2[FAB$L_FNA] = .FILE2[1]; IF NOT $OPEN (FAB = INFAB2) THEN ERR_EXIT (ERR_INFILEOPEN, INFAB2); IF NOT $CONNECT (RAB = INRAB2) THEN ERR_EXIT (ERR_INFILEOPEN, INRAB2); OUTFAB[FAB$B_FNS] = .OUTFILE[0]; OUTFAB[FAB$L_FNA] = .OUTFILE[1]; IF NOT $CREATE (FAB = OUTFAB) THEN ERR_EXIT (ERR_OUTFILEOPEN, OUTFAB); IF NOT $CONNECT (RAB = OUTRAB) THEN ERR_EXIT (ERR_OUTFILEOPEN, OUTRAB); ! Initialize running variables. ! PREV_LINE = 0; PREV_AUDIT[0] = 0; PREV_AUDIT[1] = PREV_TEXT; CH$FILL (0, 28, RANGE1); CH$FILL (0, 28, RANGE2); ! Read the first record of each file into the read ahead buffers. ! READ_LINE (INRAB1); READ_LINE (INRAB2); ! Now loop, reading update commands from the primary and compare files. If ! the SLP command in the compare file precedes the primary, we discard it ! and read the compare file until we find one that doesn't. If it follows ! the primary, it is held for future use and we just regurgitate the ! the command from the primary file into the output file. If they match, ! we do the collision processing that this utility is all about. ! MAIN_LOOP: BEGIN WHILE 1 DO BEGIN WHILE .SIZE1 EQL 0 AND .RANGE1[1] EQL 0 DO BEGIN GET_UPDATE (INRAB1, RANGE1); IF .RANGE1[0] EQL -1 THEN LEAVE MAIN_LOOP; END; WHILE .SIZE2 EQL 0 AND .RANGE2[1] EQL 0 AND .RANGE2[0] NEQ -1 DO GET_UPDATE (INRAB2, RANGE2); ! Check for exact match. If they match, discard both primary and secondary ! updates. ! IF .RANGE1[0] EQL .RANGE2[0] AND .RANGE1[1] EQL .RANGE2[1] AND CH$EQL (.SIZE1, TEXT1, .SIZE2, TEXT2) THEN BEGIN RANGE1[1] = 0; SIZE1 = 0; RANGE2[1] = 0; SIZE2 = 0; END ! If we have not detected an match, we advance whatever file is behind. ! If the primary if behind, we output it as is and discard, so the next ! command will be read at the top of the loop. If the secondary is behind, ! check if it overlaps the primary. If not, output a message to that effect. ! Then just flush the secondary. ! ELSE BEGIN IF (IF .RANGE1[1] NEQ 0 THEN .RANGE1[1] ELSE .RANGE1[0]) LSSU .RANGE2[0] THEN BEGIN OUTPUT_TEXT (.SIZE1, TEXT1); PREV_LINE = .RANGE1[0]; PREV_AUDIT[0] = 0; RANGE1[1] = 0; SIZE1 = 0; END ELSE BEGIN IF NOT ( (.RANGE1[0] GEQU .RANGE2[0] AND .RANGE1[0] LEQU .RANGE2[1]) OR (.RANGE2[0] GEQU .RANGE1[0] AND .RANGE2[0] LEQU .RANGE1[1]) ) THEN BEGIN MSG_DESC[0] = 132; MSG_DESC[1] = OUT_LINE; $FAO ( DESCRIPTOR ('Unmatched update in compare file !AD'), MSG_DESC[0], MSG_DESC[0], .INNAM2[NAM$B_RSL], .INNAM2[NAM$L_RSA] ); LIB$PUT_OUTPUT (MSG_DESC[0]); P = CH$FIND_CH (.SIZE2, TEXT2, 0); MSG_DESC[0] = .P - TEXT2; MSG_DESC[1] = TEXT2; LIB$PUT_OUTPUT (MSG_DESC[0]); END; RANGE2[1] = 0; SIZE2 = 0; END; END; END; ! end of file processing loop END; ! end of block MAIN_LOOP ! We have reached the end of the primary input file. Output the end command ! and close up shop. ! TEXT1[0] = '/'; OUTRAB[RAB$W_RSZ] = 1; OUTRAB[RAB$L_RBF] = TEXT1; WRITE_LINE (OUTRAB); IF NOT $CLOSE (FAB = OUTFAB) THEN ERR_EXIT (ERR_OUTCLOSE, OUTFAB); $CLOSE (FAB = INFAB1); $CLOSE (FAB = INFAB2); 1 END; ! end of routine EXTRACT ROUTINE GET_UPDATE (RAB, BUFFER) : NOVALUE = BEGIN !++ ! ! Functional Description: ! ! This routine reads the next SLP update into the specified update ! buffer, parsing the command and accumulating the text. ! ! Calling Sequence: ! standard ! ! Input Parameters: MAP RAB : REF $RAB_DECL; ! RAB of input file to read ! ! Implicit Inputs: ! TPARSE SLP output area ! ! Output Parameters: MAP BUFFER : REF BLOCK; ! command buffer to build update in ! ! Implicit Outputs: ! none ! ! Routines Called: ! READ_LINE : NOVALUE; ! read a record from input file ! FORMAT_COMMAND, ! format a SLP command EXTERNAL ROUTINE LIB$TPARSE; ! library parser ! ! Routine Value: ! none ! ! Signals: ! none ! ! Side Effects: ! none ! !-- LOCAL C, ! size of formatted string BUFFER_END; ! pointer to text at end of buffer ! Start with the record read ahead in the line buffer. If it is a SLP command, ! parse it. Then reformat it into the text buffer area to guarantee SLP ! command uniformity. Otherwise just copy it into the text buffer. Then read ! and copy into the text buffer until another SLP command appears in the line ! buffer. ! BUFFER_END = BUFFER[UPD_TEXT]; ! init text pointer IF .RAB[RAB$W_RSZ] NEQ 0 AND (.(BUFFER[UPD_LINE])<0,8> EQL '-' ! look for SLP command OR .(BUFFER[UPD_LINE])<0,8> EQL '/') THEN BEGIN CH$FILL (0, 24, START_LINE); TPARSE_BLOCK[TPA$V_BLANKS] = 0; TPARSE_BLOCK[TPA$L_STRINGCNT] = .RAB[RAB$W_RSZ]; TPARSE_BLOCK[TPA$L_STRINGPTR] = .RAB[RAB$L_RBF]; IF NOT LIB$TPARSE (TPARSE_BLOCK, SLP_TABLE, SLP_KEY) THEN ERR_EXIT (ERR_SLPSYNTAX, .RAB); IF .START_LINE NEQ 0 THEN BEGIN BUFFER[RANGE_TOP] = .START_LINE; BUFFER[RANGE_END] = .END_LINE; END; IF .AUDIT_STRING[0] NEQ 0 THEN BEGIN BUFFER[AUDIT_LEN] = .AUDIT_STRING[0]; BUFFER[AUDIT_ADR] = BUFFER[AUDIT_TEXT]; CH$MOVE (.AUDIT_STRING[0], .AUDIT_STRING[1], BUFFER[AUDIT_TEXT]); END; BUFFER[COMMENT_LEN] = .COMMENT_STRING[0]; BUFFER[COMMENT_ADR] = BUFFER[COMMENT_TEXT]; CH$MOVE (.COMMENT_STRING[0], .COMMENT_STRING[1], BUFFER[COMMENT_TEXT]); C = FORMAT_COMMAND (BUFFER[RANGE_TOP], BUFFER[AUDIT_LEN], BUFFER[COMMENT_LEN], UPLIT (0, 0)); CH$COPY (.C, OUT_LINE, 0, .C+1, .BUFFER_END); BUFFER_END = .BUFFER_END + .C + 1; END ELSE BEGIN CH$COPY (.RAB[RAB$W_RSZ], .RAB[RAB$L_RBF], 0, .RAB[RAB$W_RSZ]+1, .BUFFER_END); BUFFER_END = .BUFFER_END + .RAB[RAB$W_RSZ] + 1; END; ! The SLP end of edit command appears as a line number of -1. If this has ! happened, stop reading. ! IF .BUFFER[RANGE_TOP] EQL -1 THEN BEGIN BUFFER[UPD_SIZE] = 0; RETURN; END; ! Now read records and copy into the text buffer until another SLP command ! shows up. Parse the SLP command. If has a non-null start line, quit. Else ! reformat the command, include it in the text, and continue processing. ! WHILE 1 DO BEGIN READ_LINE (.RAB); IF .RAB[RAB$W_RSZ] NEQ 0 AND ((.(BUFFER[UPD_LINE])<0,8> EQL '-' ! look for SLP command AND (.BUFFER[RANGE_END] EQL 0 OR (.RAB[RAB$W_RSZ] GEQU 2 AND .(BUFFER[UPD_LINE])<8,8> NEQ ','))) OR .(BUFFER[UPD_LINE])<0,8> EQL '/') THEN BEGIN CH$FILL (0, 24, START_LINE); TPARSE_BLOCK[TPA$V_BLANKS] = 0; TPARSE_BLOCK[TPA$L_STRINGCNT] = .RAB[RAB$W_RSZ]; TPARSE_BLOCK[TPA$L_STRINGPTR] = .RAB[RAB$L_RBF]; IF NOT LIB$TPARSE (TPARSE_BLOCK, SLP_TABLE, SLP_KEY) THEN ERR_EXIT (ERR_SLPSYNTAX, .RAB); IF .START_LINE EQL 0 THEN BEGIN IF .AUDIT_STRING[0] EQL 0 THEN BEGIN AUDIT_STRING[0] = .BUFFER[AUDIT_LEN]; AUDIT_STRING[1] = .BUFFER[AUDIT_ADR]; END; C = FORMAT_COMMAND (BUFFER[RANGE_TOP], BUFFER[AUDIT_LEN], BUFFER[COMMENT_LEN], UPLIT (0, 0)); IF .BUFFER_END + .C + 1 GEQA BUFFER[UPD_TEXT] + 100000 THEN ERR_EXIT (ERR_BUFFOVER); CH$COPY (.C, OUT_LINE, 0, .C+1, .BUFFER_END); BUFFER_END = .BUFFER_END + .C + 1; END ELSE BEGIN BUFFER[UPD_SIZE] = .BUFFER_END - BUFFER[UPD_TEXT]; RETURN; END; END ELSE BEGIN IF .BUFFER_END + .RAB[RAB$W_RSZ] + 1 GEQA BUFFER[UPD_TEXT] + 100000 THEN ERR_EXIT (ERR_BUFFOVER); CH$COPY (.RAB[RAB$W_RSZ], .RAB[RAB$L_RBF], 0, .RAB[RAB$W_RSZ]+1, .BUFFER_END); BUFFER_END = .BUFFER_END + .RAB[RAB$W_RSZ] + 1; END; END; END; ! end of routine GET_UPDATE ROUTINE READ_LINE (RAB) : NOVALUE = BEGIN !++ ! ! Functional Description: ! ! This routine reads the next line from the specified input file. ! ! Calling Sequence: ! standard ! ! Input Parameters: MAP RAB : REF $RAB_DECL; ! RAB to read with ! ! Implicit Inputs: ! none ! ! Output Parameters: ! none ! ! Implicit Outputs: ! line buffer pointed to by RAB ! ! Routines Called: ! SYS$GET ! ! Routine Value: ! none ! ! Signals: ! none ! ! Side Effects: ! none ! !-- ! Just get the record and check for errors. ! IF NOT $GET (RAB = .RAB) THEN ERR_EXIT (ERR_READIN, .RAB); END; ! end of routine READ_LINE ROUTINE FORMAT_COMMAND (RANGE, AUDIT, COMMENT1, COMMENT2) = BEGIN !++ ! ! Functional Description: ! ! This routine formats a SLP command containing the given data. ! ! Calling Sequence: ! standard ! ! Input Parameters: MAP RANGE : REF VECTOR [2], ! start and end line numbers AUDIT : REF VECTOR [2], ! descriptor of audit trail string COMMENT1 : REF VECTOR [2], ! descriptor of comment string COMMENT2 : REF VECTOR [2]; ! descriptor of second comment string ! COMMENT2 is optional and is concatenated if non-null ! ! Implicit Inputs: ! OUTRAB : $RAB_DECL; ! RAB of output file ! ! Output Parameters: ! none ! ! Implicit Outputs: ! OUT_LINE : VECTOR [132, BYTE]; ! buffer to build output record ! ! Routines Called: ! SYS$PUT ! ! Routine Value: ! none ! ! Signals: ! none ! ! Side Effects: ! record written ! !-- LOCAL C, ! character counter FORMAT : REF VECTOR [,BYTE], ! format string pointer OUT_STRING : VECTOR [2]; ! descriptor for FAO output buffer ! ! FAO control strings to generate SLP commands ! BIND NULL_CMD = DESCRIPTOR ('-!+,!+,/!AS/'), INSERT_CMD = DESCRIPTOR ('-!UL,!+,/!AS/'), REPLACE_CMD = DESCRIPTOR ('-!UL,!UL,/!AS/'); ! Select the appropriate format string according to the range values. ! FORMAT = NULL_CMD; ! assume null IF .RANGE[0] NEQ 0 THEN BEGIN FORMAT = INSERT_CMD; ! use insert IF .RANGE[1] NEQ 0 THEN FORMAT = REPLACE_CMD; ! use replace END; ! Now generate the SLP command with FAO ! OUT_STRING[0] = 132; ! buffer length OUT_STRING[1] = OUT_LINE; ! buffer address $FAO ( .FORMAT, OUT_STRING[0], OUT_STRING[0], .RANGE[0], .RANGE[1], AUDIT[0] ); C = .OUT_STRING[0]; ! Append the comment strings, if any are present. ! IF .COMMENT1[0] NEQ 0 OR .COMMENT2[0] NEQ 0 THEN BEGIN (OUT_LINE[.C])<0,16> = ' ; '; C = .C + 2; IF .COMMENT1[0] NEQ 0 THEN BEGIN CH$COPY (1, UPLIT BYTE (' '), .COMMENT1[0], .COMMENT1[1], ' ', 132-.C, OUT_LINE[.C]); C = MINU (.C+.COMMENT1[0]+1, 132); END; IF .COMMENT2[0] NEQ 0 THEN BEGIN CH$COPY (.COMMENT2[0], .COMMENT2[1], ' ', 132-.C, OUT_LINE[.C]); C = MINU (.C+.COMMENT2[0], 132); END; END; RETURN .C; END; ! end of routine FORMAT_COMMAND ROUTINE OUTPUT_TEXT (SIZE, BUFFER) : NOVALUE = BEGIN !++ ! ! Functional Description: ! ! This routine writes the contents of the indicated text buffer to ! the output file. Lines of text are terminated with nulls. ! ! Calling Sequence: ! standard ! ! Input Parameters: MAP SIZE, ! byte count of buffer BUFFER : REF VECTOR [,BYTE]; ! ! Implicit Inputs: MAP OUTRAB : $RAB_DECL; ! RAB for output file ! ! Output Parameters: ! none ! ! Implicit Outputs: ! none ! ! Routines Called: ! WRITE_LINE; ! write line of text to output ! ! Routine Value: ! none ! ! Signals: ! none ! ! Side Effects: ! records written ! !-- LOCAL P, ! text pointer P0; ! another text pointer ! Loop, scanning the text for line end markers. As each is found, write that ! line. Stop when the buffer has been scanned. ! P = .BUFFER; ! init pointer UNTIL .P GEQA .BUFFER + .SIZE DO BEGIN P0 = .P; ! mark start of current line P = CH$FIND_CH (.SIZE-(.P0-.BUFFER), .P0, 0); OUTRAB[RAB$W_RSZ] = .P - .P0; ! set record length OUTRAB[RAB$L_RBF] = .P0; ! and record address WRITE_LINE (OUTRAB); P = .P + 1; ! eat the null END; END; ! end of routine OUTPUT_TEXT ROUTINE WRITE_LINE (RAB) : NOVALUE = BEGIN !++ ! ! Functional Description: ! ! This routine writes the next line to the specified output file. ! ! Calling Sequence: ! standard ! ! Input Parameters: MAP RAB : REF $RAB_DECL; ! RAB to write with ! ! Implicit Inputs: ! line buffer pointed to by RAB ! ! Output Parameters: ! none ! ! Implicit Outputs: ! none ! ! Routines Called: ! SYS$PUT ! ! Routine Value: ! none ! ! Signals: ! none ! ! Side Effects: ! none ! !-- ! Just put the record and check for errors. ! IF NOT $PUT (RAB = .RAB) THEN ERR_EXIT (ERR_WRITEOUT, .RAB); END; ! end of routine WRITE_LINE ROUTINE HANDLER (SIGNAL, MECHANISM) = BEGIN !++ ! ! Functional Description: ! ! This routine is the condition handler for the utility. It receives ! a signal which is the error code of the message to print. If ! a secondary signal argument is present, it is the FAB or RAB ! address of the file in question, from which the file name and ! error status will be output. ! ! Calling Sequence: ! standard ! ! Input Parameters: MAP SIGNAL : REF BLOCK [,BYTE], ! address of signal vector MECHANISM : REF BLOCK [,BYTE]; ! address of mechanism vector ! ! Implicit Inputs: ! none ! ! Output Parameters: ! none ! ! Implicit Outputs: ! none ! ! Routines Called: EXTERNAL ROUTINE LIB$PUT_OUTPUT : ADDRESSING_MODE (GENERAL), ! library output routine LIB$SIGNAL : ADDRESSING_MODE (GENERAL); ! library signal routine ! ! Routine Value: ! SS$_RESIGNAL ! ! Signals: ! none ! ! Side Effects: ! stack unwound, control returned to caller of facility ! !-- LOCAL C, ! string character count P : REF VECTOR [,BYTE], ! string pointer STS, ! RMS status STV, ! RMS status value ERR_CODE : BLOCK [4, BYTE], ! error code being signalled MSG_DESC : VECTOR [2], ! message text descriptor MSG_BUFFER : VECTOR [132, BYTE], ! message text buffer FAB : REF $FAB_DECL, ! local FAB pointer NAM : REF $NAM_DECL; ! local NAM pointer ! Get the signal code. If it is a local error message, do error processing. ! Otherwise, just resignal the error. ! STS = 1; ERR_CODE = .SIGNAL[CHF$L_SIG_NAME] - FAC_CODE^16; IF .ERR_CODE[STS$V_FAC_NO] EQL 0 THEN BEGIN ERR_CODE = .ERR_CODE[STS$V_MSG_NO]; P = .MESSAGE_TABLE[.ERR_CODE]; MSG_DESC[0] = .(.P)<0,8>; MSG_DESC[1] = MSG_BUFFER; CH$MOVE (.(.P)<0,8>, .P+1, MSG_BUFFER); IF .SIGNAL[CHF$L_SIG_ARGS] GEQU 4 THEN BEGIN FAB = .SIGNAL[CHF$L_SIG_ARG1]; STS = .FAB[FAB$L_STS]; STV = .FAB[FAB$L_STV]; IF .FAB[FAB$B_BID] EQL RAB$C_BID THEN FAB = .FAB[RAB$L_FAB]; NAM = .FAB[FAB$L_NAM]; C = .NAM[NAM$B_RSL]; P = .NAM[NAM$L_RSA]; IF .C EQL 0 THEN BEGIN C = .NAM[NAM$B_ESL]; P = .NAM[NAM$L_ESA]; END; IF .C EQL 0 THEN BEGIN C = .FAB[FAB$B_FNS]; P = .FAB[FAB$L_FNA]; END; CH$MOVE (.C, .P, .MSG_DESC[1] + .MSG_DESC[0]); MSG_DESC[0] = .MSG_DESC[0] + .C; END; LIB$PUT_OUTPUT (MSG_DESC[0]); IF NOT .STS THEN LIB$SIGNAL (.STS, .STV); MECHANISM[CHF$L_MCH_SAVR0] = STS$K_ERROR OR STS$M_INHIB_MSG; $UNWIND (); END; SS$_RESIGNAL END; ! end of routine HANDLER !+ ! ! TPARSE State Tables ! !- ! ! Parse command line ! $INIT_STATE (CMD_TABLE, CMD_KEY); $STATE (FIRST, ((FILESPEC),,,,FILE1), ((OPTION),FIRST) ); $STATE (, (TPA$_BLANK), ((OPTION)) ); $STATE (SECOND, ((FILESPEC),,,,FILE2), ((OPTION), SECOND) ); $STATE (LAST, ((OPTION), LAST), (TPA$_EOS, TPA$_EXIT) ); $STATE (OPTION, (TPA$_BLANK), (TPA$_LAMBDA) ); $STATE (, ('/') ); $STATE (, ('OUTPUT') ); $STATE (, ('='), (':') ); $STATE (, ((FILESPEC),,,, OUTFILE) ); $STATE (, (TPA$_BLANK, TPA$_EXIT), (TPA$_LAMBDA, TPA$_EXIT) ); $STATE (FILESPEC, ((FILESPECC)) ); $STATE (FILESPEC1, ((FILESPECC), FILESPEC1), (TPA$_LAMBDA, TPA$_EXIT) ); $STATE (FILESPECC, (TPA$_SYMBOL, TPA$_EXIT), ((QUOTED), TPA$_EXIT), (':', TPA$_EXIT), ('[', TPA$_EXIT), (']', TPA$_EXIT), ('<', TPA$_EXIT), ('>', TPA$_EXIT), ('.', TPA$_EXIT), (';', TPA$_EXIT), ('-', TPA$_EXIT) ); $STATE (QUOTED, ('"') ); $STATE (QUOTED1, ('"', TPA$_EXIT), (TPA$_ANY, QUOTED1) ); ! ! Parse a SLP command ! $INIT_STATE (SLP_TABLE, SLP_KEY); $STATE (, ('/', TPA$_EXIT,, -1, START_LINE), ('-') ); $STATE (, (TPA$_DECIMAL,,,, START_LINE), (TPA$_LAMBDA) ); $STATE (, (','), (';', CHKCOMM), (TPA$_EOS, TPA$_EXIT) ); $STATE (, (TPA$_DECIMAL,,,, END_LINE), (TPA$_LAMBDA) ); $STATE (, (','), (';', CHKCOMM), (TPA$_EOS, TPA$_EXIT) ); $STATE (, ('/'), (';', CHKCOMM), (TPA$_EOS, TPA$_EXIT) ); $STATE (, ((AUDIT),,,, AUDIT_STRING) ); $STATE (, ('/'), (TPA$_EOS, TPA$_EXIT) ); $STATE (, (';'), (TPA$_EOS, TPA$_EXIT) ); $STATE (CHKCOMM, ((COMMENT),,,, COMMENT_STRING), (TPA$_EOS, TPA$_EXIT) ); $STATE (, (TPA$_EOS, TPA$_EXIT) ); $STATE (AUDIT, ((AUDITC), AUDIT), (TPA$_LAMBDA, TPA$_EXIT) ); $STATE (AUDITC, ('/', TPA$_FAIL), (TPA$_ANY, TPA$_EXIT) ); $STATE (COMMENT, (TPA$_ANY, COMMENT), (TPA$_EOS, TPA$_EXIT) ); END ELUDOM