%TITLE 'CVTLIS'.MODULE CVTLIS (MAIN = main, IDENT = 'V3.3') = BEGIN!++!! Facility: CVTLIS!! Author: Hunter Goatley>! Copyright © 1994,1998 Hunter Goatley. All rights reserved.!! Date: December 8, 1994! ! Abstract:!A! This program converts DEC's .LIS files from the Source ListingsA! on CD back to the appropriate source files. The following file! types are recognized:!"! Language Type Output file type#! --------- ---- ----------------! MACRO-32 (VAX) .MAR! AMACRO-32 (Alpha) .MAR! BLISS-32 (VAX) .B32! BLISS-32E (Alpha) .B32E! BLISS-64 (Alpha) .B64! MACRO-64 (Alpha) .M64! VAX C (VAX) .C! DEC C (VAX/Alpha) .C! SDL (VAX/Alpha) .SDL! CDU (VAX/Alpha) .CLD! MESSAGE (VAX/Alpha) .MSG! VAX PL/I (VAX) .PLI! DEC PL/I (Alpha) .PLI! VAX Pascal (VAX) .PAS! DEC Pascal (VAX/Alpha) .PAS!F! Highly dependent on the .LIS format produced for the source listings@! CDs. Fortunately, most of the VMS programmers follow rigorous@! source code formats, so this program will successfully convert! most listing files.!! Known restrictions:!C! o For some languages, source file lines that are wrapped by<! the compiler onto multiple listing lines are not put back;! together properly. The following languages are handled:!-! BLISS-32, BLISS-32E, BLISS-64E, MACRO-32,1! AMACRO-32, MACRO-64, DEC PL/I, DEC C (Alpha),! VAX C, DEC C (VAX)!7! Note that some compilers (MESSAGE, for example) just0! truncate long lines instead of wrapping them.!! Modified by:!+! V3.2-1 Hunter Goatley 8-APR-1998 09:197! For AMACRO-32, also skip lines beginning with .!)! V3.2 Hunter Goatley 2-APR-1998 07:248! For BLISS-32E, skip lines beginning with ""7! (they are pointers before %BLS32 compiler messages).:! Also, re-order compiler search list to reflect the fact:! that C is used more in the VMS sources, add support for4! DEC PL/I, add support for auto-folding of wrapped9! lines for DEC C, add support for VAX version of DEC C,)! try to handle wrapped lines for VAX C.!)! V3.1 Hunter Goatley 9-FEB-1996 08:356! Merged in do_axp_macro32() fix from Glenn Everhart.!+! V3.0-1 Hunter Goatley 10-DEC-1994 05:468! Fixed bug that caused the Table of Contents to not be$! skipped in VAX MACRO-32 listings.!)! V3.0 Hunter Goatley 8-DEC-1994 09:39:! BLISS rewrite. Original version written June 13, 1990.!!-- 9LIBRARY 'SYS$LIBRARY:STARLET'; !Pull stuff from STARLETKSWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); FORWARD ROUTINE main, !Main entry point create_file, write_line, do_vax_bliss, do_vax_macro, do_axp_bliss32e, do_axp_bliss64e, do_axp_bliss, do_axp_macro32, do_message, do_sdl, do_cld, do_vax_pli, do_dec_pli, do_vax_pascal, do_dec_pascal, do_pascal, do_vax_dec_c, do_vax_vax_c, do_vax_c, do_dec_c, do_axp_macro64 ; EXTERNAL ROUTINE LIB$GET_FOREIGN, LIB$PUT_OUTPUT, FPARSE; EXTERNAL LITERAL CVTLIS__CREATING, CVTLIS__CONVERTED, CVTLIS__UNKNOWN; MACRO BIND_ASCID (name, string) [] =$ name = %ASCID string : $BBLOCKB %IF NOT %NULL (%REMAINING) %THEN , BIND_ASCID(%REMAINING)%FI %, INIT_SDESC (desc, len, addr) = BEGIN desc [DSC$W_LENGTH] = len;' desc [DSC$B_DTYPE] = DSC$K_DTYPE_T;' desc [DSC$B_CLASS] = DSC$K_CLASS_S; desc [DSC$A_POINTER] = addr; END %; KEYWORDMACRO PUT_FF (RAB) = BEGIN EXTERNAL ROUTINE SYS$PUT;8 rab [RAB$W_RSZ] = .saved_length; !Flush the buffer< rab [RAB$L_RBF] = saved_buffer; !... and zap the saved, SYS$PUT (rab, 0, 0); !... line numberD CH$FILL (0, %ALLOCATION(saved_line_number), saved_line_number); saved_length = 0;1 rab [RAB$W_RSZ] = .ff_record [DSC$W_LENGTH];2 rab [RAB$L_RBF] = .ff_record [DSC$A_POINTER]; SYS$PUT (rab, 0, 0); END %, FLUSH_SAVED_BUFFER (RAB) = BEGIN EXTERNAL ROUTINE SYS$PUT;% rab [RAB$W_RSZ] = .saved_length;$ rab [RAB$L_RBF] = saved_buffer; SYS$PUT (rab, 0, 0);D CH$FILL (0, %ALLOCATION(saved_line_number), saved_line_number); saved_length = 0; END %; BIND+ BIND_ASCID (contents, 'Table of contents', symbols, 'Symbol table',( sbttl, %STRING(%CHAR(9),'.SBTTL'),) lsbttl, %STRING(%CHAR(9),'.sbttl'),. subtitle, %STRING(%CHAR(9),'.SUBTITLE'),& page, %STRING(%CHAR(9),'.PAGE'),$ ff_record, %STRING(%CHAR(12)),! rtnsiz, '; Routine Size: ',6 end_b32, %STRING(';',%CHAR(9),%CHAR(9),%CHAR(9),% %CHAR(9),' PSECT SUMMARY'), end_vax_c, 'Command Line', end_pli, ' COMMAND LINE ', end_dpli, ' COMMAND LINE', end_pas, 'Generated Code',0 end_pas2, 'Pascal Compilation Statistics',& end_axp, 'Machine Code Listing', end_m64, 'Command:'); LITERAL5 vax_macro_id = 0, !The compilers are listed in the6 vax_bliss_id = 1, !... order in which they are most; axp_macro32_id = 2, !... likely to be found. Since most? axp_bliss32e_id = 3, !... of VMS is written in MACRO, BLISS,6 dec_c_id = 4, !... and C, these are listed first to: dec_c_vax_id = 5, !... and C, these are listed first to3 vax_c_id = 6, !... try to optimize the number of4 sdl_id = 7, !... substring searches that must be cdu_id = 8, !... performed. message_id = 9, !... axp_bliss64e_id = 10, axp_macro64_id = 11, dec_pascal_id = 12, vax_pascal_id = 13, vax_pli_id = 14, dec_pli_id = 15, max_compilers = 15;  OWN !C ! The order of the compiler IDs below must match the order of the ! LITERALs defined above. !5 compilers : VECTOR [max_compilers+1, LONG] INITIAL ( %ASCID'VAX MACRO', %ASCID'VAX Bliss-32', %ASCID'AMAC', %ASCID'BLISS-32E', %ASCID'DEC C', %ASCID'DEC C', %ASCID'VAX C ', %ASCID'SDL ',* %ASCID'VMS Command Definition Utility', %ASCID'Message definitions', %ASCID'BLISS-64E', %ASCID'MACRO-64', %ASCID'DEC Pascal', %ASCID'VAX Pascal', %ASCID'VAX PL/I', %ASCID'DEC PL/I'); !/ ! Let's be cheesy and use lots of globals. ! OWN- inrec : VECTOR [1024, BYTE], !Input buffer1 work_buffer : VECTOR [1024, BYTE], !Work buffer# do_ff, !Flag for writing ( line_count, !Count of lines written( saved_length, !Length of saved line< saved_buffer : $BBLOCK[%ALLOCATION(work_buffer)], !Buffer3 saved_line_number : $BBLOCK[7], !The line number( input_buffer_d : $BBLOCK [DSC$K_S_BLN],' lis_filename : $BBLOCK [NAM$C_MAXRSS],( lis_filename_d : $BBLOCK [DSC$K_S_BLN],' out_filename : $BBLOCK [NAM$C_MAXRSS],( out_filename_d : $BBLOCK [DSC$K_S_BLN],$ filename_d : $BBLOCK [DSC$K_S_BLN],$ lis_nam : $NAM (RSA = lis_filename, RSS = NAM$C_MAXRSS),) lis_fab : $FAB (DNM = 'SYS$DISK:[].LIS', NAM = lis_nam, FAC = GET, SHR = GET), lis_rab : $RAB (FAB = lis_fab, RAC = SEQ, UBF = inrec, USZ = %ALLOCATION(inrec)),$ out_nam : $NAM (RSA = out_filename, RSS = NAM$C_MAXRSS),% out_fab : $FAB (DNM = 'SYS$DISK:[]', FAC = PUT, ORG = SEQ, RFM = VAR, RAT = CR, NAM = out_nam, FOP = MXV), out_rab : $RAB (FAB = out_fab, RAC = SEQ); ROUTINE main =BEGIN!+!! Routine: MAIN!! Functional description:!A! The main routine for CVTLIS. This routine opens the .LIS file,?! determines the compiler that generated it, and then calls the2! appropriate action routine to do the conversion.!!- LOCAL vax, compiler; REGISTER status : UNSIGNED LONG;# $INIT_DYNDESC (input_buffer_d); $INIT_DYNDESC (filename_d);I INIT_SDESC (lis_filename_d, %ALLOCATION(lis_filename), lis_filename);I INIT_SDESC (out_filename_d, %ALLOCATION(out_filename), out_filename);O status = LIB$GET_FOREIGN (input_buffer_d, %ASCID'_File: ', input_buffer_d);= IF NOT(.status) OR (input_buffer_d [DSC$W_LENGTH] EQLU 0) THEN= IF (.status EQLU RMS$_NORMAL) !If user entered CTRL-Z, then# THEN !... change the status to0 RETURN (SS$_NORMAL) !... success and exit) ELSE !Otherwise, return the returned# RETURN (.status); !... error9 lis_fab [FAB$B_FNS] = .input_buffer_d [DSC$W_LENGTH];: lis_fab [FAB$L_FNA] = .input_buffer_d [DSC$A_POINTER];? status = $OPEN (FAB = lis_fab); !Try to open the .LIS file IF (.status) THEN4 status = $CONNECT (RAB = lis_rab); !Connect the RAB IF (.status) THEN BEGINC lis_filename_d [DSC$W_LENGTH] = .lis_nam [NAM$B_RSL]; !Name lengthB out_fab [FAB$W_MRS] = .lis_fab [FAB$W_MRS]; !Copy file attributesD status = FPARSE (filename_d, input_buffer_d, 0, 0, %REF(%B'0100')); END; IF (.status) THEN BEGIN !) ! Store the filename in the output FAB. !2 out_fab [FAB$B_FNS] = .filename_d [DSC$W_LENGTH];3 out_fab [FAB$L_FNA] = .filename_d [DSC$A_POINTER]; ! ! Read the first record. ! status = $GET (RAB = lis_rab);@ ! If the first line is just a or is a null record, it was@ ! produced by a VAX compiler (BLISS, PL/1, VAX C, SDL) and the9 ! second record must be read to determine the compiler. ! vax = 0; IF (.status) AND9 (.lis_rab [RAB$W_RSZ] LEQU 1) !If nothing or only one' THEN !... character, then read the BEGIN !... second record# status = $GET (RAB = lis_rab); vax = 1; END; END; !5 ! If there was an error up there, then exit now. ! IF NOT(.status) THEN BEGIN: IF (lis_fab [FAB$W_IFI] NEQU 0) !If the file was opened, THEN !... close it $CLOSE (FAB = lis_fab); RETURN (.status); END; compiler = -1; !G ! Step through the index of compiler identifiers and exit the loop- ! when the matching compiler is located. !% INCR i FROM 0 to MAX_COMPILERS DO BEGIN> BIND compiler_name = .compilers [.i] : $BBLOCK [DSC$K_S_BLN];8 IF NOT(CH$FAIL(CH$FIND_SUB(.lis_rab [RAB$W_RSZ], inrec,B .compiler_name [DSC$W_LENGTH], .compiler_name [DSC$A_POINTER]))) THEN (compiler = .i; EXITLOOP); END; !5 ! Initialize the buffer for saving line numbers. !C CH$FILL (0, %ALLOCATION(saved_line_number), saved_line_number);* do_ff = line_count = saved_length = 0; !D ! Special case. If it's DEC C on VAX, just pretend it's VAX C,* ! as the listing files are identical. !+ IF (.vax) AND (.compiler EQLU dec_c_id) THEN compiler = dec_c_vax_id; !/ ! Now call the appropriate action routine. ! SELECTONE (.compiler) OF SET" [vax_macro_id] : do_vax_macro();" [vax_bliss_id] : do_vax_bliss();% [axp_macro32_id] : do_axp_macro32();' [axp_bliss32e_id] : do_axp_bliss32e(); [dec_c_id] : do_dec_c();" [dec_c_vax_id] : do_vax_dec_c(); [vax_c_id] : do_vax_vax_c(); [sdl_id] : do_sdl(); [cdu_id] : do_cld(); [message_id] : do_message();' [axp_bliss64e_id] : do_axp_bliss64e();% [axp_macro64_id] : do_axp_macro64();$ [dec_pascal_id] : do_dec_pascal();$ [vax_pascal_id] : do_vax_pascal(); [vax_pli_id] : do_vax_pli(); [dec_pli_id] : do_dec_pli();) [OTHERWISE] : status = CVTLIS__UNKNOWN; TES; !, ! Close the input and output files now. !$ IF (.lis_fab [FAB$W_IFI] NEQU 0) THEN $CLOSE (FAB = lis_fab);$ IF (.out_fab [FAB$W_IFI] NEQU 0) THEN $CLOSE (FAB = out_fab); IF (.status) THEN? SIGNAL (CVTLIS__CONVERTED, 2, lis_filename_d, out_filename_d);. RETURN (.status); !Return status to VMSEND; !End of routine %ROUTINE create_file (type_a, ext_a) =BEGIN!+! Routine: CREATE_FILE!! Functional description:!.! This routine creates the output source file.! ! Inputs:!@! type_a - Descriptor address for compiler name to be displayed/! ext_a - Descriptor address for the file type!!- BIND type = .type_a : $BBLOCK, ext = .ext_a : $BBLOCK; LOCAL status;/ out_fab [FAB$L_DNA] = .ext [DSC$A_POINTER];. out_fab [FAB$B_DNS] = .ext [DSC$W_LENGTH];% status = $CREATE (FAB = out_fab); IF (.status) THEN# status = $CONNECT (RAB = out_rab); IF (.status) THEN BEGIN6 out_filename_d [DSC$W_LENGTH] = .out_nam [NAM$B_RSL];4 SIGNAL (CVTLIS__CREATING, 2, type, out_filename_d); status = SS$_NORMAL; END; RETURN (.status);END; :ROUTINE write_line (length, address_a, line_no_offset_a) =BEGIN!+! Routine: WRITE_LINE!! Functional description:!@! This routine is called to write a line of output to the source?! file. This routine handles the joining of continued lines in! the listing files.!! Implicit inputs:!A! do_ff, saved_length, saved_buffer, saved_line_number, and more.!!- BIND" address = .address_a : $BBLOCK,. line_no_offset = .line_no_offset_a : $BBLOCK; LOCAL status;C ! If a line is wrapped in a listing file, the line numbers forA ! both lines are the same. Here, we jump through some hoops! ! to reassemble those lines. !C ! If there is a saved number and this line number is differentD ! from the saved number, then write out the saved line and saveF ! this line. Otherwise, just append this line to the saved line. !6 IF (CH$RCHAR(saved_line_number) NEQU %CHAR(0)) AND1 CH$NEQ (7, saved_line_number, 7, line_no_offset) THEN BEGIN; out_rab [RAB$W_RSZ] = .saved_length; !Write out the saved/ out_rab [RAB$L_RBF] = saved_buffer; !... line& status = $PUT (RAB = out_rab); !...# IF (.do_ff) !Need to do a ?' THEN !If so, then do one and reset BEGIN !... the flag6 out_rab [RAB$L_RBF] = .ff_record [DSC$A_POINTER]; out_rab [RAB$W_RSZ] = 0; $PUT (RAB = out_rab);5 out_rab [RAB$W_RSZ] = .ff_record [DSC$W_LENGTH]; $PUT (RAB = out_rab); do_ff = 0;2 line_count = 0; !Reset the line counter too END; !' ! Now save this line in saved_buffer. !* CH$MOVE (.length, address, saved_buffer); saved_length = .length; END ELSE BEGIN !7 ! Here, the line numbers are the same, so just append ! this line to our saved line. ! CH$MOVE (.length, address,* CH$PLUS (saved_buffer, .saved_length));( saved_length = .saved_length + .length; END;8 line_count = .line_count + 1; !Bump the line counter !A ! Save the line number for this record for later comparison. !3 CH$MOVE (7, line_no_offset, saved_line_number); RETURN (.status);END; ROUTINE do_vax_bliss =BEGIN!+!! Routine: DO_VAX_BLISS!! Functional Description:!<! This subroutine handles the parsing of a .LIS file createdG! by BLISS-32. Parsing stops when the "PSECT SUMMARY" record is found.!!- LOCAL skip_lines, status;: status = create_file (%ASCID'BLISS-32', %ASCID'.B32');* IF NOT(.status) THEN RETURN (.status);3 skip_lines = 2; !Skip the first header lines line_count = 0;2 status = $GET (RAB = lis_rab); !Read a record WHILE (.status) DO BEGIN+ WHILE (.status AND (.skip_lines GTR 0)) DO BEGIN" status = $GET (RAB = lis_rab);! skip_lines = .skip_lines - 1; END;8 IF (.lis_rab [RAB$W_RSZ] GTRU 0) !If something was read THEN BEGIN= IF (.lis_rab [RAB$W_RSZ] EQLU 1) AND !If a line was> (CH$RCHAR(inrec) EQLU %CHAR(12)) !... read, we have a% THEN !... header, so skip it BEGIN0 IF (.line_count LSSU 57) !If not a full page,! THEN !... then write a  PUT_FF (RAB = out_rab);, line_count = 0; !Re-init the line count' skip_lines = 3; !Skip 3 more lines END;  !F ! If we don't have a header and the line begins with a ";", then6 ! we have a listing record that is to be printed ! IF (.skip_lines EQLU 0) AND( (CH$RCHAR(inrec) EQLU %C';') AND' (CH$RCHAR(inrec[3]) LEQU %C'9') THENT BEGINS LOCAL length; % length = .lis_rab [RAB$W_RSZ] - 12;% IF (.length LSS 0) THEN length = 0; 7 status = write_line (.length, inrec [12], inrec [1]);o END;: status = $GET (RAB = lis_rab); !Read the next record END) ELSE ! IF (.lis_rab [RAB$W_RSZ] GTRU 0)f BEGIN !? ! Here, we've encountered the null lines that precede theg? ! MACRO instructions in the listing. Read and ignore alll; ! lines until we encounter a line that looks like theX ! following line:l !; ! "; Routine Size: 512 bytes, Routine Base: ..."  !@ ! At this point, there should be two null records and then@ ! a header record introducing the next routine. Read? ! all records until the line then continue the loop.L ! LOCAL done; done = 0; WHILE NOT(.done) DO BEGINX status = $GET (RAB = lis_rab);( IF NOT(.status) THEN RETURN (.status);& ! Look for record starting with ";".; IF (.lis_rab [RAB$W_RSZ] GTRU .rtnsiz [DSC$W_LENGTH]) AND,! (CH$RCHAR(inrec) EQLU %C';')c THEN done = 1;l END; !% ! Found the end of the routine.l !: ! See if we've encountered end-of-module ("ELUDOM").1 ! Another way is to read until we encoutnert% ! ";PSECT SUMMARY".a !? IF (.lis_rab [RAB$W_RSZ] GEQU .end_b32 [DSC$W_LENGTH]) ANDCC (CH$EQL (.end_b32 [DSC$W_LENGTH], .end_b32 [DSC$A_POINTER],$ .end_b32 [DSC$W_LENGTH], inrec)) THENl BEGIN% flush_saved_buffer (RAB = out_rab);i# RETURN (SS$_NORMAL); !Finished!!  END; lis_rab [RAB$W_RSZ] = 0; !- ! Loop until we're past the null lines.> !+ WHILE (.lis_rab [RAB$W_RSZ] EQLU 0) DO  BEGINS* $GET (RAB = lis_rab); !Read next record !h3 ! It's possible that the page break came between 2 ! the null lines, etc. Check for that here and1 ! skip the header if so (and get the next lined ! after the header)., !s& IF (.lis_rab [RAB$W_RSZ] EQLU 1) AND% (CH$RCHAR(inrec) EQLU %CHAR(12))s THEN1 INCR i FROM 1 TO 4 DO $GET (RAB = lis_rab); END; !WHILE (.lis_rab..... !< ! See if we've hit a header before rejoining the code. !) IF (.lis_rab [RAB$W_RSZ] EQLU 1) AND" (CH$RCHAR(inrec) EQLU %CHAR(12)) THENt skip_lines = 3;d END;- END;g RETURN (.status);aEND; 1ROUTINE do_vax_macro =BEGINO!+! ! Routine: DO_VAX_MACRO!.! Functional Description:!B<! This subroutine handles the parsing of a .LIS file createdA! by MACRO. It skips the table of contents (labeled by "Table of B! contents" in the header record) and processes the file up to the3! symbol table listing (denoted by "Symbol table").s!eC! Form-feeds are inserted before all .SBTTL records (beginning with,! ".SBTTL").,!d!- LOCAL_ skip_lines, multiple_sbttls,e length, offset, status;: status = create_file (%ASCID'MACRO-32', %ASCID'.MAR');* IF NOT(.status) THEN RETURN (.status); skip_lines = 2;T line_count = 0;  multiple_sbttls = 0;2 status = $GET (RAB = lis_rab); !Read a record WHILE (.status) DO BEGIN< IF NOT(CH$FAIL(CH$FIND_SUB(.contents [DSC$W_LENGTH], inrec,9 .contents [DSC$W_LENGTH], .contents [DSC$A_POINTER])))% THENI BEGIN< WHILE (.status) AND (CH$RCHAR(inrec) NEQU %CHAR(12)) DO status = $GET (RAB = lis_rab);6 status = $GET (RAB = lis_rab); !Read next record END;E ! 8 ! If we found the "Symbol table", then we're finished. !; IF NOT(CH$FAIL(CH$FIND_SUB(.symbols [DSC$W_LENGTH], inrec,_7 .symbols [DSC$W_LENGTH], .symbols [DSC$A_POINTER])))b THEN BEGIN( flush_saved_buffer (RAB = out_rab); RETURN (SS$_NORMAL);L END;A v+ WHILE (.status AND (.skip_lines GTR 0)) DOv BEGIN " status = $GET (RAB = lis_rab);! skip_lines = .skip_lines - 1;_ END;: IF (CH$RCHAR(inrec) EQLU %CHAR(12)) !Is 1st char. a ? THEN skip_lines = 2R ELSE BEGIN( length = .lis_rab [RAB$W_RSZ] - 48; IF (.length GEQ 0)h THENb BEGINB !s? ! Check to see if this is a .SBTTL record. If so, write outA< ! a unless this is the second or third in a multiple= ! .SBTTL sequence. For example, DEC has started using thel1 ! following sequence, which this code handles:  !b ! .SBTTL +7 ! .SBTTL The pluses make the table of contents prettyl ! .SBTTL + !e- IF (.length GEQU .sbttl [DSC$W_LENGTH]) ANDS0 (CH$EQL (.sbttl [DSC$W_LENGTH], inrec [48],7 .sbttl [DSC$W_LENGTH], .sbttl [DSC$A_POINTER]) ORn1 CH$EQL (.lsbttl [DSC$W_LENGTH], inrec [48], 7 .lsbttl [DSC$W_LENGTH], .lsbttl [DSC$A_POINTER]))m THEN BEGIN_ IF NOT(.multiple_sbttls) THEN BEGIN PUT_FF (RAB = out_rab); multiple_sbttls = 1;  END;o ENDt ELSE multiple_sbttls = 0; !s: ! Now handle macro expansions. These lines do not have= ! line numbers, so we can check to see if there is a blank < ! word at offset 46. If so, stick a comment character in& ! position 47 and write from there. !p- IF (CH$RCHAR(inrec[46]) EQLU %CHAR(32)) ANDA) (CH$RCHAR(inrec[47]) EQLU %CHAR(32))t THEN BEGIN  !c> ! Not all such lines actually contain macro expansions;= ! they can be object code continuation lines, so check.@ ! to see if there's something on the line besides listing ! stuff.9 !: IF (.lis_rab [RAB$W_RSZ] GTRU 48) !Make sure there's THEN BEGIN8 CH$WCHAR(%C';', inrec[47]); !Store comment character offset = 47; length = .length + 1; END" ELSE !Nothing there, then& length = -1; !... don't write out ENDm ELSE offset = 48; IF (.length GEQ 0) THENA status = write_line (.length, inrec [.offset], inrec [40]);I END; !IF (.length GTR 0). END; !IF (CH$RCHAR(inrec) EQLU %CHAR(12)) status = $GET (RAB = lis_rab);n END; !WHILE (.status)% RETURN (.status);'END; 'LROUTINE do_axp_bliss32e = (do_axp_bliss (%ASCID'BLISS-32E', %ASCID'.B32E'));KROUTINE do_axp_bliss64e = (do_axp_bliss (%ASCID'BLISS-64E', %ASCID'.B64')); &ROUTINE do_axp_bliss (type_a, ext_a) =BEGIN!+!c! Routine: DO_AXP_BLISS!p! Functional Description:!O<! This subroutine handles the parsing of a .LIS file createdF! by BLISS-32E. Parsing stops when a "Machine Code Listing" header is! found.!- LOCALd skip_lines, length, status;+ status = create_file (.type_a, .ext_a);O* IF NOT(.status) THEN RETURN (.status); skip_lines = 2;, do_ff = 0;" status = $GET (RAB = lis_rab); WHILE (.status) DO BEGIN8 IF (.skip_lines NEQU 0) !If processing a header, look& THEN !... for the end of the file BEGIN !@ ! The end of a BLISS-32E module is determined by finding aC ! header that reads "Machine Code Listing". If we find that,F! ! stop processing the file.b !? IF NOT(CH$FAIL(CH$EQL(.end_axp [DSC$W_LENGTH], inrec [32],O7 .end_axp [DSC$W_LENGTH], .end_axp [DSC$A_POINTER]))) THENC BEGIN% flush_saved_buffer (RAB = out_rab); RETURN (SS$_NORMAL); END;/ WHILE (.status AND (.skip_lines GTR 0)) DO  BEGINV status = $GET (RAB = lis_rab); skip_lines = .skip_lines - 1;  END;# END; !IF (.skip_lines NEQU 0) @ IF (CH$RCHAR (inrec) EQLU %CHAR(12)) !Is the first char a ? THENo BEGIN !C ! If we have a before 55 lines of code have been output, A ! then we have a short routine and should print a too. !9 IF (.line_count LSSU 55) !Signal that we need to doG) THEN !... a when the time is do_ff = 1; !... right_ line_count = 0;. skip_lines = 3; !Skip next four records END ELSEN BEGIN8 length = .lis_rab [RAB$W_RSZ] - 14; !Get the lengthD IF (.length LSS 0) THEN length = 0; !If null, then make it null !C ! If this is not a compiler message (indicated by a line that > ! begins with "%BLS"), then write it to the output file.4 ! Also skip all lines that begin with a . !/ IF CH$NEQ (4, UPLIT('%BLS'), 4, inrec) ANDr& ((CH$RCHAR(inrec) NEQU %CHAR(9)) AND% (CH$RCHAR(inrec+1) NEQU %CHAR(9))) THEN 7 status = write_line (.length, inrec [14], inrec [6]);A END;b2 status = $GET (RAB = lis_rab); !Read next record END; !WHILE (.status) DO RETURN (.status);)END; sROUTINE do_axp_macro32 =BEGIN !+!t! Routine: DO_AXP_MACRO32! ! Functional Description:! <! This subroutine handles the parsing of a .LIS file createdA! by MACRO. It skips the table of contents (labeled by "Table ofuB! contents" in the header record) and processes the file up to the3! symbol table listing (denoted by "Symbol table").t! C! Form-feeds are inserted before all .SBTTL records (beginning withe! ".SBTTL").!t!- LOCAL] skip_lines, multiple_sbttls, length, xtraloc,r chopstart,! status;; status = create_file (%ASCID'AMACRO-32', %ASCID'.MAR');>* IF NOT(.status) THEN RETURN (.status); skip_lines = 2;,- multiple_sbttls = do_ff = line_count = 0;u2 status = $GET (RAB = lis_rab); !Read a record WHILE (.status) DO BEGIN4 WHILE (.skip_lines GTR 0) DO !Processing a header? BEGIN !D ! The end of an AMAC MACRO32 module is determined by finding aC ! header that reads "Machine Code Listing". If we find that, ! ! stop processing the file.t !? IF NOT(CH$FAIL(CH$EQL(.end_axp [DSC$W_LENGTH], inrec [32],f7 .end_axp [DSC$W_LENGTH], .end_axp [DSC$A_POINTER]))) OR? NOT(CH$FAIL(CH$EQL(.symbols [DSC$W_LENGTH], inrec [32],7 .symbols [DSC$W_LENGTH], .symbols [DSC$A_POINTER]))) THEN  BEGINr% flush_saved_buffer (RAB = out_rab);a RETURN (SS$_NORMAL); END;# status = $GET (RAB = lis_rab);S" skip_lines = .skip_lines - 1; END;[? IF (CH$RCHAR(inrec) EQLU %CHAR(12)) !Is the first char a ?[ THENS, skip_lines = 2 !Skip next two records ELSEr BEGIN !8 ! If first char is a tab, only chop 11 characters. !* IF (CH$RCHAR(inrec[0]) EQLU %CHAR(9)) THEN BEGINL xtraloc = 0; chopstart = 0; ENDe ELSEe BEGIN  xtraloc = 31;t chopstart = 39;; END;0 length = .lis_rab [RAB$W_RSZ] - .chopstart; ! ! Ignore the record if:i ! ! o the length is negativeF2 ! o there is no line number ( instead)0 ! o it's a compiler message (%AMACRO....)- ! o it's a continued message (-MAC...)  ! IF (.length GEQ 0) AND_/ (CH$RCHAR(inrec[.xtraloc]) NEQU %CHAR(9)) ANDd) CH$NEQ (4, UPLIT('%AMA'), 4, inrec) ANDm% CH$NEQ (4, UPLIT('-MAC'), 4, inrec)_ THEN BEGIN_ !:? ! Check to see if this is a .SBTTL record. If so, write outd< ! a unless this is the second or third in a multiple= ! .SBTTL sequence. For example, DEC has started using thel1 ! following sequence, which this code handles: !_ ! .SBTTL +7 ! .SBTTL The pluses make the table of contents pretty[ ! .SBTTL + !a- IF (.length GEQU .sbttl [DSC$W_LENGTH]) ANDE0 (CH$EQL (.sbttl [DSC$W_LENGTH], inrec [39],7 .sbttl [DSC$W_LENGTH], .sbttl [DSC$A_POINTER]) OR1 CH$EQL (.lsbttl [DSC$W_LENGTH], inrec [39],$7 .lsbttl [DSC$W_LENGTH], .lsbttl [DSC$A_POINTER]))Q THEN BEGINS IF NOT(.multiple_sbttls) THEN BEGIN do_ff = 1;N multiple_sbttls = 1;, END;n END ELSE multiple_sbttls = 0;3 status = write_line (.length, inrec [.chopstart],  inrec [.xtraloc]);a END !IF (.length GEQ 0) ELSE line_count = .line_count + 1;. END; !IF (CH$RCHAR(inrec) EQLU %CHAR(12)) status = $GET (RAB = lis_rab);e END; !WHILE (.status)e RETURN (.status); END; rROUTINE do_message =BEGINp!+!! Routine: DO_MESSAGE!_! Functional Description:!B<! This subroutine handles the parsing of a .LIS file created ! by MESSAGE.E!!- LOCALF skip_lines, multiple_sbttls, length, status;9 status = create_file (%ASCID'MESSAGE', %ASCID'.MSG');C* IF NOT(.status) THEN RETURN (.status); skip_lines = 2;t2 status = $GET (RAB = lis_rab); !Read a record8 WHILE (.status AND (.lis_rab [RAB$W_RSZ] NEQU 0)) DO BEGIN+ WHILE (.status AND (.skip_lines GTR 0)) DO BEGIN# status = $GET (RAB = lis_rab);," skip_lines = .skip_lines - 1; END;R? IF (CH$RCHAR(inrec) EQLU %CHAR(12)) !Is the first char a ?l THENr BEGIN !C ! If we have a before 55 lines of code have been output,dA ! then we have a short routine and should print a too.o !7 IF (.line_count LSSU 55) !Do a if we need to THENI PUT_FF (RAB = out_rab);  line_count = 0;- skip_lines = 2; !Skip next two recordsA END ELSE BEGIN8 length = .lis_rab [RAB$W_RSZ] - 40; !Get the length IF (.length GEQ 0)a THENw BEGINr out_rab [RAB$W_RSZ] = .length;# out_rab [RAB$L_RBF] = inrec [40]; status = $PUT (RAB = out_rab); line_count = .line_count + 1;f END; END;r status = $GET (RAB = lis_rab); ' END; !WHILE (.status AND (.lis_rab....p RETURN (.status);dEND; ROUTINE do_sdl =BEGINl!+!b! Routine: DO_SDL!! Functional Description:!7<! This subroutine handles the parsing of a .LIS file created ! by SDL.h!!!- LOCALa status;5 status = create_file (%ASCID'SDL', %ASCID'.SDL');P* IF NOT(.status) THEN RETURN (.status); line_count = 0;2 status = $GET (RAB = lis_rab); !Read a record WHILE (.status) DO BEGIN5 WHILE (.status AND ((.lis_rab [RAB$W_RSZ] EQLU 0) ORb5 (CH$RCHAR(CH$PLUS(inrec,5)) EQLU %CHAR(32)) ORt) (.lis_rab [RAB$W_RSZ] LSSU 8))) DO] BEGIN6 IF (.line_count GTRU 0) AND (.line_count LSSU 57) THEN  BEGINc PUT_FF (RAB = out_rab); END; line_count = 0;# status = $GET (RAB = lis_rab);d END;_0 out_rab [RAB$W_RSZ] = .lis_rab [RAB$W_RSZ] - 8;0 out_rab [RAB$L_RBF] = .lis_rab [RAB$L_RBF] + 8; status = $PUT (RAB = out_rab);  line_count = .line_count + 1; IF (.status)e THEN # status = $GET (RAB = lis_rab);) END; !WHILE (.status) RETURN (.status);END; cROUTINE do_cld =BEGINB!+! ! Routine: DO_CLD!! Functional Description:! <! This subroutine handles the parsing of a .LIS file created$! by the Command Definition Utility.! !- LOCAL) skip_lines, length, status;5 status = create_file (%ASCID'CDU', %ASCID'.CLD');F* IF NOT(.status) THEN RETURN (.status); line_count = 0;f skip_lines = 3;2 status = $GET (RAB = lis_rab); !Read a record WHILE (.status) DO BEGIN+ WHILE (.status AND (.skip_lines GTR 0)) DO= BEGIN# status = $GET (RAB = lis_rab); " skip_lines = .skip_lines - 1; END; ? IF (.lis_rab [RAB$W_RSZ] EQLU 0) !A null record? If so, we're0 THEN !... finishedB RETURN (SS$_NORMAL);d? IF (CH$RCHAR(inrec) EQLU %CHAR(12)) !Is the first char a ?G THEND BEGIN !C ! If we have a before 55 lines of code have been output, A ! then we have a short routine and should print a too. !7 IF (.line_count LSSU 56) !Do a if we need to THEN  PUT_FF (RAB = out_rab);e line_count = 0;. skip_lines = 4; !Skip next four records END ELSEI BEGIN8 length = .lis_rab [RAB$W_RSZ] - 10; !Get the length IF (.length GEQ 0) THEN  BEGIN) out_rab [RAB$W_RSZ] = .length;# out_rab [RAB$L_RBF] = inrec [10];! status = $PUT (RAB = out_rab); line_count = .line_count + 1;e END; END;i status = $GET (RAB = lis_rab); ' END; !WHILE (.status AND (.lis_rab....t RETURN (.status);pEND; )ROUTINE do_vax_pli =BEGIN)!+!C! Routine: DO_VAX_PLI!(! Functional Description:!E<! This subroutine handles the parsing of a .LIS file created! by the VAX PL/1 compiler.)!E!- LOCAL skip_lines, length, status;: status = create_file (%ASCID'VAX PL/I', %ASCID'.PLI');* IF NOT(.status) THEN RETURN (.status); line_count = 0; ) skip_lines = 4; !Skip first header 2 status = $GET (RAB = lis_rab); !Read a record WHILE (.status) DO BEGIN+ WHILE (.status AND (.skip_lines GTR 0)) DO BEGIN# status = $GET (RAB = lis_rab);l" skip_lines = .skip_lines - 1; END; 6 IF (.lis_rab [RAB$W_RSZ] NEQU 0) !Was something read? THEN !... finishedo BEGIND IF (CH$RCHAR(inrec) EQLU %CHAR(12)) !Start with a ? If so,# THEN !... we're on a header! BEGINo !n@ ! If we have a before 55 lines of code have been output,> ! then we have a short routine and should print a too. !E3 IF (.line_count LSSU 55) !Do a if we need tot THEN PUT_FF (RAB = out_rab);t' line_count = 0; !Reset line counterr) skip_lines = 4; !Skip next four linesi ENDQ ELSE BEGIN  !o6 ! See if we've encountered end-of-file. If so, the% ! record will be " COMMAND LINE ".e !u8 IF (.lis_rab [RAB$W_RSZ] EQLU .end_pli [DSC$W_LENGTH]) THEN RETURN (SS$_NORMAL);: out_rab [RAB$W_RSZ] = (IF (.lis_rab [RAB$W_RSZ] LEQU 11)4 THEN 0 ELSE (.lis_rab [RAB$W_RSZ] - 11));# out_rab [RAB$L_RBF] = inrec + 11;b status = $PUT (RAB = out_rab); line_count = .line_count + 1;E END; END;s6 status = $GET (RAB = lis_rab); !Read the next record' END; !WHILE (.status AND (.lis_rab...._ RETURN (.status);!END; wROUTINE do_dec_pli =BEGIN !+! ! Routine: DO_DEC_PLI!S! Functional Description:!T<! This subroutine handles the parsing of a .LIS file created! by the DEC PL/1 compiler.e!e!- LOCALl skip_lines, length, offset, address,s status;: status = create_file (%ASCID'DEC PL/I', %ASCID'.PLI');* IF NOT(.status) THEN RETURN (.status); line_count = 0; ) skip_lines = 2; !Skip first header 2 status = $GET (RAB = lis_rab); !Read a record WHILE (.status) DO BEGIN+ WHILE (.status AND (.skip_lines GTR 0)) DOd BEGIN# status = $GET (RAB = lis_rab); " skip_lines = .skip_lines - 1; END;T6 IF (.lis_rab [RAB$W_RSZ] NEQU 0) !Was something read? THEN !... finished BEGIND IF (CH$RCHAR(inrec) EQLU %CHAR(12)) !Start with a ? If so,# THEN !... we're on a headero BEGINd' line_count = 0; !Reset line counter * skip_lines = 3; !Skip next three lines ENDb ELSE  BEGINn !n6 ! See if we've encountered end-of-file. If so, the$ ! record will be " COMMAND LINE". !b9 IF (.lis_rab [RAB$W_RSZ] EQLU .end_dpli [DSC$W_LENGTH])o THEN BEGIN) flush_saved_buffer (RAB = out_rab);i% RETURN (SS$_NORMAL); !Finished! END; ! ! Lines can look like:( !D ! " | # /*...."  ! " | # # ...."R ! " # # ...."n ! "(1) compiler message"- ! "blah" (compiler messages too)E0 ! " # text : PROCEDURE OPTIONS(MAIN)" ! "" !G9 IF (CH$RCHAR(inrec) EQLU %CHAR(32)) OR !Begins with < ((CH$RCHAR(inrec) EQLU %CHAR(9)) AND !Or with ) (CH$RCHAR(inrec+1) EQLU %CHAR(32)))u THEN BEGINc4 offset = (IF (CH$RCHAR(inrec+4) EQLU %CHAR(9))3 THEN 13 ELSE IF (CH$RCHAR(inrec) EQLU %CHAR(9))o THEN 9 ELSE 16);6 length = (IF (.lis_rab [RAB$W_RSZ] LEQU .offset)2 THEN 0 ELSE (.lis_rab [RAB$W_RSZ] - .offset)); address = inrec + .offset;< status = write_line (.length, inrec+.offset, inrec+8);# line_count = .line_count + 1;o END; END; END;A6 status = $GET (RAB = lis_rab); !Read the next record' END; !WHILE (.status AND (.lis_rab....  RETURN (.status);pEND; pGROUTINE do_vax_pascal = (do_pascal (%ASCID'VAX Pascal', %ASCID'.PAS'));aGROUTINE do_dec_pascal = (do_pascal (%ASCID'DEC Pascal', %ASCID'.PAS')); #ROUTINE do_pascal (type_a, ext_a) =.BEGING!+!! Routine: DO_PASCAL !! Functional Description:!.<! This subroutine handles the parsing of a .LIS file created! by the VAX Pascal compiler.e! !- LOCALn skip_lines, status;+ status = create_file (.type_a, .ext_a);w* IF NOT(.status) THEN RETURN (.status); line_count = 0; ) skip_lines = 4; !Skip first headerT do_ff = 0;2 status = $GET (RAB = lis_rab); !Read a record WHILE (.status) DO BEGIN+ WHILE (.status AND (.skip_lines GTR 0)) DOD BEGIN !B ! We've reached the end when we find a header reading either< ! "Generated Code" or "Pascal Compilation Statistics". !3 IF NOT(CH$FAIL(CH$EQL(.end_pas [DSC$W_LENGTH],T .end_pas [DSC$A_POINTER],) .end_pas [DSC$W_LENGTH], inrec [32])))L OR. NOT(CH$FAIL(CH$EQL(.end_pas2 [DSC$W_LENGTH], .end_pas2 [DSC$A_POINTER],* .end_pas2 [DSC$W_LENGTH], inrec [32]))) THEN  RETURN (SS$_NORMAL);# status = $GET (RAB = lis_rab);o" skip_lines = .skip_lines - 1; END;f6 IF (.lis_rab [RAB$W_RSZ] NEQU 0) !Was something read? THEN !... finishedr BEGIND IF (CH$RCHAR(inrec) EQLU %CHAR(12)) !Start with a ? If so,# THEN !... we're on a header; BEGIN  ! @ ! If we have a before 55 lines of code have been output,> ! then we have a short routine and should print a too. ! 3 IF (.line_count LSSU 55) !Do a if we need to  THEN do_ff = 1;' line_count = 0; !Reset line counter ) skip_lines = 4; !Skip next four lines ENDt ELSE  BEGINE# IF (.lis_rab [RAB$W_RSZ] GEQU 16)n THEN BEGIN. IF (.do_ff) THEN BEGIN PUT_FF (RAB = out_rab); do_ff = 0;  END; 6 out_rab [RAB$W_RSZ] = .lis_rab [RAB$W_RSZ] - 16;' out_rab [RAB$L_RBF] = inrec [16]; $ status = $PUT (RAB = out_rab);# line_count = .line_count + 1;) END; END; END;6 status = $GET (RAB = lis_rab); !Read the next record' END; !WHILE (.status AND (.lis_rab....A RETURN (.status);oEND; DROUTINE do_vax_dec_c = (do_vax_c (%ASCID'DEC C (VAX)', %ASCID'.C'));>ROUTINE do_vax_vax_c = (do_vax_c (%ASCID'VAX C', %ASCID'.C'));"ROUTINE do_vax_c (type_a, ext_a) =BEGINs!+!t! Routine: DO_VAX_C!f! Functional Description:!S<! This subroutine handles the parsing of a .LIS file created! by the VAX C compiler.!i!- LOCALt skip_lines, length, status;+ status = create_file (.type_a, .ext_a); * IF NOT(.status) THEN RETURN (.status); line_count = 0; ) skip_lines = 4; !Skip first header 2 status = $GET (RAB = lis_rab); !Read a record WHILE (.status) DO BEGIN+ WHILE (.status AND (.skip_lines GTR 0)) DO BEGIN# status = $GET (RAB = lis_rab);d" skip_lines = .skip_lines - 1; END;d6 IF (.lis_rab [RAB$W_RSZ] NEQU 0) !Was something read? THEN !... finished BEGIND IF (CH$RCHAR(inrec) EQLU %CHAR(12)) !Start with a ? If so,# THEN !... we're on a headerN BEGIN !T@ ! If we have a before 55 lines of code have been output,> ! then we have a short routine and should print a too. !)3 IF (.line_count LSSU 55) !Do a if we need tok THEN PUT_FF (RAB = out_rab);' line_count = 0; !Reset line counterI* skip_lines = 3; !Skip next three lines ENDh ELSE BEGIN  !G6 ! See if we've encountered end-of-file. If so, the# ! record will be "Command Line".n !a> IF (.lis_rab [RAB$W_RSZ] EQLU .end_vax_c [DSC$W_LENGTH]) AND' CH$EQL (.end_vax_c [DSC$W_LENGTH],n! .end_vax_c [DSC$A_POINTER],> .end_vax_c [DSC$W_LENGTH], inrec) THEN RETURN (SS$_NORMAL); ! 9 ! Try to handle wrapped lines. VAX C/DEC C doesn't do : ! line wrapping gracefully like Alpha's DEC C does---it9 ! just wraps, period. So: if a line is 132 charactersu< ! long, just read in the next line at the end and call it ! done. !a$ IF (.lis_rab [RAB$W_RSZ] EQLU 132) THEN BEGINt, LOCAL rsize, size, addr : REF $BBLOCK; !T7 ! Save the current user buffer size and address, 7 ! change them to point to the end of the currentR8 ! line, read in the next record, then reset those ! RAB fields. ! # rsize = .lis_rab [RAB$W_RSZ];(" size = .lis_rab [RAB$W_USZ];" addr = .lis_rab [RAB$L_UBF];9 lis_rab [RAB$W_USZ] = .size - .lis_rab [RAB$W_RSZ];: lis_rab [RAB$L_UBF] = .lis_rab [RAB$L_RBF] + .rsize;6 status = $GET (RAB = lis_rab); !Read next record+ IF NOT(.status) THEN RETURN(.status);p: lis_rab [RAB$W_RSZ] = .lis_rab [RAB$W_RSZ] + .rsize;" lis_rab [RAB$W_USZ] = .size;" lis_rab [RAB$L_UBF] = .addr; END;' IF (.lis_rab [RAB$W_RSZ] GEQU 14) ANDa( (CH$RCHAR(inrec[4]) NEQU %CHAR(32)) THEN BEGIN>- IF (CH$RCHAR(inrec[12]) EQLU %CHAR(32))m THEN BEGIN6 out_rab [RAB$W_RSZ] = .lis_rab [RAB$W_RSZ] - 14;' out_rab [RAB$L_RBF] = inrec [14];M$ status = $PUT (RAB = out_rab); END;s# line_count = .line_count + 1;p END; END; END;=6 status = $GET (RAB = lis_rab); !Read the next record' END; !WHILE (.status AND (.lis_rab....( RETURN (.status);rEND; aROUTINE do_dec_c =BEGIN !+!h! Routine: DO_DEC_C!m! Functional Description:!a<! This subroutine handles the parsing of a .LIS file created! by the DEC C compiler.!s!- LOCAL skip_lines, status;= status = create_file (%ASCID'DEC C (Alpha)', %ASCID'.C');C* IF NOT(.status) THEN RETURN (.status); line_count = 0;H) skip_lines = 2; !Skip first header  do_ff = 0;2 status = $GET (RAB = lis_rab); !Read a record WHILE (.status) DO BEGIN+ WHILE (.status AND (.skip_lines GTR 0)) DOL BEGIN !; ! We've reached the end when we find a header reading  ! "Machine Code Listing".( !3 IF NOT(CH$FAIL(CH$EQL(.end_axp [DSC$W_LENGTH],  .end_axp [DSC$A_POINTER],) .end_axp [DSC$W_LENGTH], inrec [32]))) THENr BEGINs% flush_saved_buffer (RAB = out_rab);! RETURN (SS$_NORMAL); END;# status = $GET (RAB = lis_rab);t" skip_lines = .skip_lines - 1; END;e6 IF (.lis_rab [RAB$W_RSZ] NEQU 0) !Was something read? THEN !... finishedA BEGIND IF (CH$RCHAR(inrec) EQLU %CHAR(12)) !Start with a ? If so,# THEN !... we're on a headere BEGINl !u@ ! If we have a before 55 lines of code have been output,> ! then we have a short routine and should print a too. ! 3 IF (.line_count LSSU 55) !Do a if we need toQ THEN do_ff = 1;' line_count = 0; !Reset line counterN) skip_lines = 3; !Skip next four lines ENDI ELSE  BEGINt' LOCAL length, offset, line_no_offset;  ! ; ! If the first character is a TAB, our offset is 9, elset ! the offset is 16. !F. offset = (IF (CH$RCHAR(inrec) EQLU %CHAR(9)) THEN 9 ELSE 16);t7 line_no_offset = (IF (.offset EQLU 9) THEN 2 ELSE 8);u* length = .lis_rab [RAB$W_RSZ] - .offset; IF (.length GEQ 0) THENL status = write_line (.length, inrec[.offset], inrec[.line_no_offset]); END; END;[6 status = $GET (RAB = lis_rab); !Read the next record' END; !WHILE (.status AND (.lis_rab....  RETURN (.status);lEND; PROUTINE do_axp_macro64 =BEGIN!+!F! Routine: DO_AXP_MACRO64!H! Functional Description:! <! This subroutine handles the parsing of a .LIS file createdD! by MACRO-64. It skips the table of contents (labeled by "Table ofB! contents" in the header record) and processes the file up to the3! symbol table listing (denoted by "Symbol table").I!CC! Form-feeds are inserted before all .SBTTL records (beginning with! ".SBTTL").t!e!- LOCAL( skip_lines, multiple_sbttls,  length, status;: status = create_file (%ASCID'MACRO-64', %ASCID'.M64');* IF NOT(.status) THEN RETURN (.status); skip_lines = 2;d- multiple_sbttls = do_ff = line_count = 0;e2 status = $GET (RAB = lis_rab); !Read a record WHILE (.status) DO BEGIN+ WHILE (.status AND (.skip_lines GTR 0)) DOR BEGIN !; ! We've reached the end when we find a header readingR ! "Machine Code Listing".A !3 IF NOT(CH$FAIL(CH$EQL(.end_axp [DSC$W_LENGTH],  .end_axp [DSC$A_POINTER],) .end_axp [DSC$W_LENGTH], inrec [32])))a THENs BEGIN % flush_saved_buffer (RAB = out_rab);C RETURN (SS$_NORMAL); END;# status = $GET (RAB = lis_rab); " skip_lines = .skip_lines - 1; END;e? IF (CH$RCHAR(inrec) EQLU %CHAR(12)) !Is the first char a ?r THENa. skip_lines = 3 !Skip next three records ELSEu BEGINE LOCAL i : REF VECTOR[,BYTE], j : REF VECTOR[,BYTE], char : BYTE,  tabcol, offset;  !C ! The MACRO-64 compiler throws various TABs and things in the ? ! way, so we "detab" the first part of each line to get ae ! common offset. !! i = inrec; j = work_buffer;;? WHILE (.j LSSU work_buffer[48]) DO !Only detab part of itt BEGIN tabcol = 8;i3 WHILE (.tabcol GTRU 0) DO !While in a tab column( BEGIN)" IF (.j GEQU work_buffer[48]) THEN EXITLOOP; char = CH$RCHAR_A (i);7 IF (.char EQLU %CHAR(9)) !If character is ,F" THEN !... replace it with BEGIN !... the right # ofa# DECR tabcol FROM .tabcol TO 1 DO-, CH$WCHAR_A(%CHAR(32), j); !... blanks tabcol = 0; END# ELSE !Otherwise, just copyR BEGIN !... the character CH$WCHAR_A (.char, j);  tabcol = .tabcol - 1; END; END; END; !( ! Copy the rest of the string now. !8 WHILE (.i LEQU inrec [.lis_rab [RAB$W_RSZ] - 1]) DO CH$WCHAR_A (CH$RCHAR_A(i), j);; length = .j - work_buffer; !Length of detabbed recordl offset = 48; length = .length - .offset; IF (.length GEQ 0) THEN  BEGIN  !u> ! Check to see if this is a .SUBTITLE record. If so, write< ! a unless this is the second or third in a multiple@ ! .SUBTITLE sequence. For example, DEC has started using the1 ! following sequence, which this code handles:  !T ! .SUBTITLE +): ! .SUBTITLE The pluses make the table of contents pretty ! .SUBTITLE +o !=, IF (.length GEQU .page [DSC$W_LENGTH]) AND: (CH$EQL (.page [DSC$W_LENGTH], work_buffer [.offset],7 .page [DSC$W_LENGTH], .page [DSC$A_POINTER])) OR > (CH$EQL (.subtitle [DSC$W_LENGTH], work_buffer [.offset],; .subtitle [DSC$W_LENGTH], .subtitle [DSC$A_POINTER]))  THEN BEGINR IF NOT(.multiple_sbttls) THEN BEGIN do_ff = 1;  multiple_sbttls = 1;r END;a END ELSE multiple_sbttls = 0;6 status = write_line (.length, work_buffer [.offset], work_buffer [40]);_ END; !IF (.length GEQ 0). END; !IF (CH$RCHAR(inrec) EQLU %CHAR(12)) status = $GET (RAB = lis_rab);o END; !WHILE (.status)n RETURN (.status);NEND;END !End of module BEGINAELUDOM !End of module˙˙F>?G THEND BEGIN !C ! If we have a before 55 lines of code have been output, A ! then we have a short routine and should print a too. !7 IF (.line_count LSSU 56) !Do a if we need to THEN  PUT_FF (RAB = out_rab);e line_count = 0;. skip_lines = 4; !Skip next four recor