$pascal '92071-1X337 REV.2041  800822'$ 
$heap 0$
$segment$ 
PROGRAM BUS1; 
{ 
* 
*NAME:    BUS1
*SOURCE:  92071-18337 
*RELOC:   92071-16337 
*PGMR:    DAVE NEFF 
* 
****************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY, 1980. ALL RIGHTS      *
* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,        *
* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT *
* THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        *
****************************************************************
} 
  
{BUS1 is loaded into memory at the start of the main. 
 It contains file_init which is called by the main. 
All other routines in this segment are local to this
 segment.}
 {Read in the global constants, variables and types.} 
$include '&BUGBL'$
  
{time uses a library routine to get the current day and time.} 
  
PROCEDURE time $ALIAS '@TIME'$ (VAR str:input_line);external; 
FUNCTION rspar(param_number:integer; VAR string:input_line; 
               string_length:integer):integer;external; 
  
  
{Calls to system resources.}
  
FUNCTION loglu(VAR ises:integer):integer;external;
FUNCTION iftty(VAR lu:integer):integer;external;
PROCEDURE cnumd(VAR int:integer; VAR BUF:string6);external; 
PROCEDURE pname(VAR name:string6);external; 
  
{Non FMP externals contained in the main program are next.} 
  
PROCEDURE namr(VAR parse_buffer:namr_parse_buffer; VAR ibuff:input_line;
               length:integer;VAR istrc:integer);external;
PROCEDURE error(message:input_line);$direct$ external;
FUNCTION getword(address:integer; VAR idcb:dcb; VAR ibuff:buffer; 
                 VAR name:string6; VAR curr_rec:integer):integer; 
                                                        external; 
PROCEDURE putword(word,address:integer; VAR idcb:dcb; VAR ibuff:buffer; 
              VAR name:string6; VAR curr_rec:integer;post:boolean)
                                                                 ;external; 
PROCEDURE fmp_error(VAR ierr:integer; VAR name:string6);
                                                      $direct$ external;
  
PROCEDURE writline(line:input_line);$direct$ external;
PROCEDURE line_read; $direct$ external; 
  
{FMP externals are next.} 
  
PROCEDURE ecrea(VAR idcb:dcb; VAR ierr:integer; VAR name:string6; 
               VAR isz:isize_type; itype,isecu,icrn:integer;
               idcbs:integer;VAR jsize:doubint);external; 
PROCEDURE open(VAR idcb:dcb; VAR ierr:integer; VAR name:string6;
               iopin,isecu,icr:integer);external; 
PROCEDURE readf(VAR idcb:dcb; VAR ierr:integer; VAR ibuff:buffer; 
               ilen:integer; VAR len:integer; num:integer);external;
PROCEDURE writf(VAR idcb:dcb; VAR ierr:integer; VAR ibuff:buffer; 
               ilen,rec_num:integer);external;
PROCEDURE close(VAR idcb:dcb; VAR ierr:integer; itrun:integer);external;
  
{orig_process handles the original system file.  It verifies that 
 it is a system, retrieves constants from the system, and then
 coppies this system into the BUILD output system file. 
   orig_error:             A boolean set true should any error
                           occur in this routine. 
   address:                The array of addresses which tells 
                           the routine which system entries should
                           be retrieved.
  } 
PROCEDURE orig_process(VAR orig_error:boolean; VAR address:address_array);
  CONST 
    bad_sys_error='NOT A SYSTEM IMAGE'; 
    sys_not_for_snap_error='SYSTEM NOT FOR SNAP'; 
  
    {This constant will always be in word 3 of a system image.} 
    {This word corresponds to a JMP 3,I.} 
    jump3_i=-22525; 
  VAR 
    i,                    {Loop index.} 
    length,               {Record length returned by readf (128).}
    sys_csw,              {System id checksum from the system 
                           image.}
    common_csw:integer;   {Common checksum word from the system 
                           image.}
  
  BEGIN 
  
    orig_error:=false;
    {Make sure its a system by checking word 3 of the original
     system file to see if it is a JMP 3,I, and checking to see 
     if it is type 1. cur_sys_rec is zeroed here to 
     insure a disk read takes place when orig_process is
     called more than once.}
  
    cur_sys_rec:=0; 
  
    {Do not change order here.  The getword call should only
     occur if the file is type 1.  PASCAL code generation 
     assures this.} 
    IF (ierr<>1) OR (getword(2,prog_dcb,prog_dcb.buff,origsystem,cur_sys_rec) 
        <>jump3_i) THEN 
      BEGIN 
  
        error(bad_sys_error); 
        orig_error:=true; 
      END 
    ELSE
      BEGIN 
  
        {Assume it is a system image.  Get needed values from it.}
        {The order here is important, and should minimize needed
         disk accesses.}
  
        sys_csw:=getword(address[2],prog_dcb,prog_dcb.buff, 
                     origsystem,cur_sys_rec); 
        common_csw:=getword(address[8],prog_dcb,prog_dcb.buff,
                     origsystem,cur_sys_rec); 
  
        IF (sys_csw<>sys_id_csw) OR (common_csw<>sys_com_csw) THEN
          BEGIN 
  
            {System not for snap.  Give error.} 
  
            error(sys_not_for_snap_error);
            orig_error:=true; 
          END 
        ELSE
          BEGIN 
  
            num_ids:=getword(address[3],prog_dcb,prog_dcb.buff, 
                         origsystem,cur_sys_rec); 
            id_addr:=getword(address[4],prog_dcb,prog_dcb.buff, 
                         origsystem,cur_sys_rec); 
            num_mats:=getword(address[5],prog_dcb,prog_dcb.buff,
                         origsystem,cur_sys_rec); 
            mat_addr:=getword(address[6],prog_dcb,prog_dcb.buff,
                         origsystem,cur_sys_rec); 
            matv_addr:=address[7];
  
            {Pick up the system size, in pages, including common.}
            sys_len:=getword(address[9],prog_dcb,prog_dcb.buff, 
                                 origsystem,cur_sys_rec); 
  
            sec_addr:=address[10];
  
            {Redefine the address of $BOOT to be a more 
             sensible name than address[1].}
  
            start_addr:=address[1]; 
  
            {Copy the original system to the BUILD system.} 
  
            cur_sys_rec:=0; 
            prog_len:=sys_len*recds_per_k;
            WHILE (ierr>=0) AND (cur_sys_rec<prog_len) DO 
              BEGIN 
  
                cur_sys_rec:=cur_sys_rec+1; 
  
                {Get a record from original system.}
  
                readf(prog_dcb,ierr,prog_dcb.buff,recd_len,length,
                      cur_sys_rec); 
                writf(sys_dcb,ierr,prog_dcb.buff,recd_len,cur_sys_rec); 
  
                {No fmp errors should ever occur here since we know 
                 sys_file was correctly made, and origsystem is 
                 a system image.} 
               END; 
          END;
      END;
  
    {Close the original system file.} 
  
    close(prog_dcb,ierr,0); 
  END; {orig_process} 
{read_sys entry gets one system entry from the SNAP file,converts 
     types, and gets the size of the label field for the next entry.} 
{     file_name:            The name of the snapshot file, passed 
                            by name for efficiency. 
      idcb:                 The dcb of the snapshot file, passed by 
                            name for efficiency.
      ibuff:                The buffer associated with the snapshot 
                            dcb, passed by name for efficiency. 
      current_label:        The label found in the snapshot entry 
                            just read, passed by name since it is 
                            returned to search_se.
      curr_address:         The address found in the snapshot entry 
                            just read, passed by name since it is 
                            returned to search_se.} 
  
PROCEDURE read_sys_entry(VAR file_name:string6;VAR idcb:dcb;
                         VAR ibuff:buffer;VAR current_labl:varl_labl; 
                         VAR curr_address:integer); $direct$
  CONST 
    two_spaces=8224;     {Two ascii spaces in one word.}
  VAR 
    i,                         {Loop counter.}
    length,                    {Record length returned by readf.} 
    num_words,                 {Number of words in current record.} 
    record_size:integer;       {Maximum snapshot record size expected.} 
  BEGIN 
  
    {Compute maximum record size expected.} 
  
    record_size:=max_words+3; 
  
    {Get a record.} 
  
    readf(idcb,ierr,ibuff,record_size,length,0);
  
    {Get the length of the label field in words.} 
  
    num_words:=ibuff[1];
    IF ierr<0 THEN fmp_error(ierr,file_name) ELSE 
      BEGIN 
  
        {Get the current label in the snapshot record.} 
  
        FOR i:=1 TO num_words DO
          current_labl.ints[i]:=ibuff[i+1]; 
  
        {Fill rest of buffer with spaces to insure
         correct matching on the compare in search_sys_entry.}
  
        FOR i:=num_words+1 TO max_words DO
          current_labl.ints[i]:=two_spaces; 
  
        {Get the actual record size.} 
  
        record_size:=num_words+3; 
  
        {Get the actual current address the label referrs to.}
  
        curr_address:=ibuff[record_size]; 
      END;
  END;{read_sys_entry}
  
{search_se recieves an array of labels and returns an array of addresses.}
{An address entry of 0 means that the label was not found.} 
{     name:                  The name of the snapshot file, passed by 
                             name for efficiency. 
      idcb:                  The dcb of the shapshot file.
      ibuff:                 The buffer of the dcb associated with the
                             snapshot file. 
      address:               The array of addresses returned by the 
                             routine. 
      labls:                 The array of labels passed to the routine. 
      num_labls:             The number of labels in the label array
                             labls. 
      num_entries:           The actual number of label entries in the
                             snapshot file. 
      found_all:             True when all passed lables were found.} 
  
PROCEDURE search_se(VAR name:string6;VAR idcb:dcb;VAR ibuff:buffer; 
                  VAR address:address_array;VAR labls:labl_array; 
                  num_labls,num_entries:integer; VAR found_all:boolean);
                                                              $direct$
  VAR 
    curr_address,           {The address of the snapshot entry just 
                             read, returned by read_sys_entry.} 
    i,j,                    {Indexes used for counting.}
    num_found:integer;      {A counter which keeps track of the 
                             number of labels found so far.}
    curr_labl:varl_labl;    {The label of the snapshot entry just 
                             read, returned by read_sys_entry.} 
  BEGIN 
  
    {Zero all passed addresses.}
  
    FOR i:=1 TO num_labls DO address[i]:=0; 
    num_found:=0; 
    i:=0; 
  
    {Search the snapshot file until all passed labels have
     been found, or until an FMP error occurs, or until the 
     entire snapshot file has been searched (whichever comes
     first.}
  
    WHILE (i<num_entries) AND (num_found<num_labls) AND NOT abort DO
      BEGIN 
  
        {Get a record, its label, and address field values.}
  
        read_sys_entry(name,idcb,ibuff,curr_labl,curr_address); 
        i:=i+1; 
        {Loop through, comparing the current label with all entries 
         of the label array passed.}
  
        FOR j:=1 TO num_labls DO
          IF labls[j].chars=curr_labl.chars THEN
            BEGIN 
              address[j]:=curr_address; 
              num_found:=num_found+1; 
            END;
      END;
    IF num_found<num_labls THEN found_all:=false
      ELSE found_all:=true; 
  END;{search_se} 
  
 {PROCEDURE def_labls defines the lables which are to be found
 in the snapshot file.} 
{     num_lb:            Actual number of labels to search for in 
                         the snapshot file. Passed by name since
                         it is used by search_se. 
      labl:              The array of labels which is returned by 
                         this procedure, therefore passed by name.} 
  
PROCEDURE def_labls(VAR num_lb:integer; VAR labl:labl_array); $direct$
  BEGIN 
    num_lb:=10; 
    labl[1].chars:='$BOOT'; {Contains ID address of startup program.} 
    labl[2].chars:='$CKSM'; {Contains the system checksum word.}
    labl[3].chars:='$ID# '; {Contains the number of id segments.} 
    labl[4].chars:='$IDA '; {Contains the address of start of id segments.} 
    labl[5].chars:='$MAT#'; {Contains the maximum number of MAT entries.} 
    labl[6].chars:='$MATA'; {Pointer to start  of MAT entries.} 
    labl[7].chars:='$MATV'; {Contains number of defined MATs.}
    labl[8].chars:='$SCCK'; {Contains the system common checksum.}
    labl[9].chars:='$USER'; {Contains the page number of the first possible 
                             user partition.} 
    labl[10].chars:='$XECM'; {Contains system security code.} 
  
  END;{def_labls} 
  
  {snap_process retrieves needed labels from the snap file.}
  {  snap_error:          True when any errors occur in this routine. 
     labls:               Array of labels defined by def_labls. This, 
                          and the addresses paramater are passed so 
                          these arrays need not be globally defined.
     addresses:           Array of addresses corresponding 1 to 1 to
                          the array of labels.} 
  PROCEDURE snap_process(VAR snap_error:boolean; VAR labls:labl_array;
                         VAR addresses:address_array);
    LABEL 99; 
    CONST 
      ilen=20;                {Length of snapshot header.}
      ill_snap_error='ILLEGAL SNAPSHOT';
  
    VAR 
      all_found:boolean;      {True when all labels from snap found.} 
  
      snapbuff:buffer;        {Packing buffer for read.}
  
      checksum,               {Header of snapshot's checksum.}
      file_type,              {The type of the snapshot file.}
      i,                      {A loop counter.} 
      length,                 {Returned by readf calls.}
      num_sys_entries         {Number of labels in shapshot.} 
      :integer; 
    BEGIN 
  
      file_type:=ierr;
      snap_error:=false;
  
      IF file_type=0 THEN 
        BEGIN 
  
          {Don't try to read the header, but merely 
           return illegal snapshot error.}
  
          error(ill_snap_error);
          snap_error:=true; 
          goto 99;
        END;
  
      {Define the needed labels.} 
  
      def_labls(num_labls,labls); 
  
      {Get the snapshot header.}
  
      readf(snap_dcb,ierr,snapbuff,ilen,length,1);
  
      IF ierr<0 THEN
        fmp_error(ierr,snap_file) 
      ELSE
        BEGIN 
  
          {Get needed values from snap, validate checksum.} 
  
          num_sys_entries:=snapbuff[1]; 
          sys_id_csw:=snapbuff[9];
          sys_com_csw:=snapbuff[10];
          sys_common_sz:=(snapbuff[6]-snapbuff[4]) DIV page_size; 
  
          checksum:=0;
          FOR i:=1 TO 19 DO checksum:=checksum+snapbuff[i]; 
  
          {Check for checksum error.} 
  
          IF (checksum<>snapbuff[ilen]) OR (file_type<>3) THEN
            BEGIN 
  
              snap_error:=true; 
              error(ill_snap_error);
            END 
          ELSE
            BEGIN 
  
              {Get addresses of lables needed from snap.} 
  
              search_se(snap_file,snap_dcb,snapbuff,addresses,labls,
                              num_labls,num_sys_entries,all_found); 
  
              IF NOT all_found THEN 
                BEGIN 
                  error(ill_snap_error);
                  snap_error:=true; 
                END;
              END;
        END;
    99: 
    END; {snap_process} 
  
{header_printout outputs the header at the start of each run
 of BUILD.} 
PROCEDURE header_printout; $direct$ 
  CONST 
    msg3= 
'*                     BUILD SYSTEM IMAGE                               *'; 
    msg6f1='*     ';
    msg6f3= 
'constructs a bootable system image file given              *'; 
    msg7= 
'*     a generated system file, its snapshot, and programs to be        *'; 
    msg8= 
'*     loaded into memory.  Type /A to abort the build at any           *'; 
    msg9= 
'*     time, /E to end.                                                 *'; 
  TYPE
  
    one_two=(one,two);
    {special string is a record used to get around the TYPING of PASCAL.} 
  
    special_string= 
      RECORD
        CASE one_two OF 
        one:
            (field1:PACKED ARRAY [1..6] OF char;
             field2:fname;
             field3:PACKED ARRAY [13..72] OF char); 
        two:
            (whole_string:input_line) 
        END;
  VAR 
    i:integer;                 {Used for a counter in moving the time 
                                string into a message string.}
    msg4,                      {The string which is used to 
                                enter the time string into.}
    tline:special_string;     {The string passed to the @TIME routine.} 
  
  
  BEGIN 
  
  
    msg4.whole_string:=head2;  {Initialize message four.} 
    {Get the date and time.}
  
    time(tline.whole_string); 
  
    {Insert the time string into the proper field.} 
  
    FOR i:=1 TO 26 DO 
      msg4.whole_string[i+21]:=tline.whole_string[i]; 
  
    {Make tline contain a string using the actual program name.}
  
    tline.field1:=msg6f1; 
    tline.field2:=build_prompt.file_name; 
  
    {Replace : with a space.} 
  
    tline.field2[6]:=space1;
    tline.field3:=msg6f3; 
  
    {Output the header.}
  
    writline(head1);
    writline(head2);
    writline(msg3); 
    writline(msg4.whole_string);
    writline(head2);
    writline(tline.whole_string); 
    writline(msg7); 
    writline(msg8); 
    writline(msg9); 
    writline(head2);
  END; {header_printout}
  
{file_init handles all run string specifiable namrs.
 It opens input and list files, prompts for namrs not 
 specified in the run string, and performs initial
 processing on the run string paramaters.  Much of
 this processing takes place through the routines local 
 to this segment.}
  
PROCEDURE file_init; $direct$ 
  LABEL 99; 
  CONST 
    max_possible_memory=
     'Available disk space constrains the system to be under '; 
    pages=' pages.';
    sys_prompt='Bootable system file (namr) ? ';
    snp_prompt='Snapshot file (namr) ? '; 
    ori_prompt='Original system file (namr) ? ';
    runstring_bad_type='BAD PARAMATER TYPE IN THE RUN STRING';
  VAR 
  
    addresses:address_array;      {Array of addresses retrieved from
                                   the snapshot file.}
    first_pass,                   {True on the first pass of the loops
                                   that prompt and read user replies, 
                                   and false on subsequent passes.} 
    orig_error,                   {True when orig_process returns 
                                   an error, false otherwise.}
    snap_error:boolean;           {True when snap_process returns 
                                   an error, false otherwise.}
  
    outfile_size:doubint;         {Actual size of output file 
                                   created.}
  
    sub_namr:input_line;          {Sub-namr denoting output and input files.} 
  
    {integer type declarations.}
  
    i,                             {Loop index.}
    inlu,                          {Default input logical unit number.} 
    ises,                          {Dummy paramater for loglu, indicates
                                    if session is used or not.} 
    orig_crn,                      {Crn of original system.}
    orig_secu,                     {Security of original system.} 
    outlu,                         {Default output logical unit number.}
    snap_crn,                      {Snapshot file cartridge.} 
    snap_secu:integer;             {Snapshot security code.}
  
   {Size buffer for creat.} 
    isize:isize_type; 
  
    labls:labl_array;             {Array of lables to retrieve from 
                                   the snapshot.} 
  BEGIN 
  
  
    {Initialize mem_size to 256 k.  This is so the BUILD
     output file is still around if a /E was typed before 
     the memory size was specified.}
  
    mem_size:=max_mem_size; 
  
    {Get the RP'd program name for later use.}
  
    pname(build_prompt);
    build_prompt.words_two_three[6]:=':'; 
  
    {Set the command file input error handling default.}
  
    error_path:=uncond_abort; 
  
    {Get the lu number of the scheduling terminal.} 
  
    log_lu:=loglu(ises);
  
    {Convert to ASCII, needed by reset and rewrite.}
  
    cnumd(log_lu,login_lu); 
  
  
    {Call rspar to return the full file namr as a namr type.
     This allows correct opening using reset and rewrite.}
    {rspar is a PASCAL library routine documented in the user's guide.} 
  
    IF rspar(1,sub_namr,line_length)=0 THEN 
      BEGIN 
  
        {No input file was given.  Default to the terminal lu.} 
        inlu:=log_lu; 
        interactive:=true;
  
        input_file:=login_lu; 
        reset(ifile,login_lu.file_name);
      END 
    ELSE
      BEGIN 
  
        {The user did give some file. Parse the paramater.} 
  
        istrc:=1; 
  
        namr(namr_buffer,sub_namr,line_length,istrc); 
  
        WITH namr_buffer DO 
          BEGIN 
  
            IF types.param1=numeric THEN
              {Get an ASCII representation of the passed lu.} 
              BEGIN 
  
                inlu:=param1.int1;
                cnumd(inlu,input_file); 
                reset(ifile,sub_namr);
                IF iftty(inlu)=-1 THEN interactive:=true; 
              END 
  
            ELSE IF types.param1=ascii THEN 
              BEGIN 
  
                {A transfer file was given as the ifile.} 
                {When echo_read is true, every line read from 
                 the input file or LU is echoed to the output NAMR.}
  
                echo_read:=true;
                input_file:=param1; 
                reset(ifile,sub_namr);
              END;
          END; {WITH} 
      END;
  
    {Get the next sub-namr for possible use by rewrite.}
  
    IF rspar(2,sub_namr,line_length)=0 THEN 
      BEGIN 
  
        {No list file namr was given.  Default to the 
         log lu.} 
  
        outlu:=log_lu;
        terminal_outfile:=true; 
        output_file:=login_lu;
        rewrite(ofile,output_file.file_name); 
      END 
    ELSE
      BEGIN {Opening list file.}
  
        {Parse the namr.} 
  
        istrc:=1; 
        namr(namr_buffer,sub_namr,line_length,istrc); 
        WITH namr_buffer DO 
          BEGIN 
  
            IF types.param1=numeric THEN
              BEGIN 
  
                {Convert the number to ascii for rewrite.}
  
                outlu:=param1.int1; 
                cnumd(outlu,output_file); 
                IF iftty(outlu)=-1 THEN terminal_outfile:=true; 
              END;
            IF types.param1=ascii THEN
              BEGIN 
  
                echo_read:=true;
                output_file:=param1;
                rewrite(ofile,sub_namr);
                IF interactive THEN 
                  BEGIN 
  
                    {When echo_write is true, every line written to the 
                     output NAMR is also written to the input namr.}
  
                    echo_write:=true; 
                    rewrite(ifile,login_lu.file_name);
                  END;
              END 
            ELSE IF (types.param1=numeric) AND (inlu<>outlu)
               AND interactive AND (NOT terminal_outfile) THEN
              BEGIN {Assume it is a tt ifile, lp ofile case.} 
                    {Obviously, this assumption may be incorrect, but 
                     it will only cause echoing to the output device
                     which shouldn't cause problems.} 
  
                echo_write:=true; 
                echo_read:=true;
                rewrite(ofile,output_file.file_name); 
  
                {Everything written to output_file is echoed to 
                 input_file.} 
  
                rewrite(ifile,input_file.file_name);
              END ELSE rewrite(ofile,sub_namr); 
            {Echo the run string to any list file.} 
  
            IF NOT terminal_outfile THEN
              BEGIN 
                i:=rspar(-1,sub_namr,line_length);
                writeln(ofile,sub_namr);
                writeln(ofile); 
              END;
          END; {WITH statement.}
      END;  {Opening list file.}
  
    {Printout the header message.}
    header_printout;
  
    {Get the BUILD output file namr.} 
  
  
    {If file namr given, create BUILD output file.} 
    {Initially, make the size the largest that is possibly
     needed.  It will be truncated to the actual required size
     when closing it.}
  
    isize[1]:=-1; 
    isize[2]:=0;
  
    ierr:=0;
    IF rspar(3,sub_namr,line_length)<>0 THEN
      BEGIN 
  
        istrc:=1; 
        namr(namr_buffer,sub_namr,line_length,istrc); 
        IF namr_buffer.types.param1=ascii THEN
          BEGIN 
  
           {Asign the parse buffer values to global values for
            use by fmp calls in the future (not just the create).}
  
           sys_file:=namr_buffer.param1;
           sys_secu:=namr_buffer.param2.int;
           sys_crn:=namr_buffer.param3.int; 
           ecrea(sys_dcb,ierr,sys_file,isize,1,sys_secu,sys_crn,0,
                                                      outfile_size);
         END
        ELSE
          BEGIN 
            error(runstring_bad_type);
            IF NOT interactive THEN goto 99;
          END;
      END ELSE namr_buffer.types.param1:=null;
  
    {Check to see if all went well, if not, try to recover.}
    {In the next 3 loops which prompt for files not specified 
     in the run string, it is important to remember the ierr
     return by create and open.  open returns the file type 
     in ierr upon successful open, and a negative error otherwise.
     creat, returns the number of sectors in the file.  Hence 
     when ierr remains zero, the error was not FMP related. 
     This explains the directions of the inequality tests,
     and the exclusion of the ierr=0 case in the terminating
     condition.}
  
    first_pass:=true; 
    WHILE ((namr_buffer.types.param1<>ascii) OR (ierr<0)) DO
      BEGIN 
  
        {Output any appropriate error messages here.} 
  
        IF ierr<0 THEN
          BEGIN 
            fmp_error(ierr,sys_file); 
            IF NOT interactive THEN goto 99;
          END;
  
        IF (namr_buffer.types.param1<>ascii) AND NOT first_pass THEN
          BEGIN 
  
            {Output bad paramater error.} 
  
            error(bad_type);
            ierr:=0;
            IF NOT interactive THEN goto 99;
          END;
  
        {Prompt for and process output file namr.}
        IF terminal_outfile THEN prompt(ofile,sys_prompt) 
          ELSE write(ofile,sys_prompt); 
        IF echo_write THEN prompt(ifile,sys_prompt);
        line_read;
        IF abort OR build_ended THEN goto 99; 
  
  
        IF namr_buffer.types.param1=ascii THEN
          BEGIN 
            {Try to create the BUILD system output file here.}
            {First define some globals as above.} 
  
            sys_file:=namr_buffer.param1; 
            sys_secu:=namr_buffer.param2.int; 
            sys_crn:=namr_buffer.param3.int;
            ecrea(sys_dcb,ierr,sys_file,isize,1,sys_secu,sys_crn,0, 
                                                       outfile_size); 
          END ELSE ierr:=0; 
        first_pass:=false;
      END;
  
    {Determine the maximum possible memory size due to disk constraints.} 
    {Convert file size from sectors to blocks.} 
  
    outfile_size:=outfile_size DIV 2; 
  
    {Determine number of pages the system can contain.} 
  
    max_mem_size:=outfile_size DIV recds_per_k; 
  
    {Account for roundoff error.} 
  
    roundoff_blocks:=outfile_size MOD recds_per_k;
  
    {Tell the user how big his system can be.}
  
    writeln(ofile,max_possible_memory,max_mem_size:6,pages);
    IF echo_write THEN
      writeln(ifile,max_possible_memory,max_mem_size:6,pages);
    IF (namr_buffer.types.param1=ascii) AND (ierr>=0) THEN made_sys_file:=true; 
    {Try to get info about the snap file namr.} 
  
    ierr:=0;
    IF rspar(4,sub_namr,line_length)<>0 THEN
      BEGIN 
  
        {Try to open the snap file.}
  
        istrc:=1; 
        namr(namr_buffer,sub_namr,line_length,istrc); 
  
        IF (namr_buffer.types.param1=ascii) THEN
          BEGIN 
  
            {Open with shared access.}
            snap_file:=namr_buffer.param1;
            snap_secu:=namr_buffer.param2.int;
            snap_crn:=namr_buffer.param3.int; 
            open(snap_dcb,ierr,snap_file,1,snap_secu,snap_crn); 
  
            {Process the snap file here if no errors.}
  
            IF ierr>=0 THEN 
              BEGIN 
                snap_process(snap_error,labls,addresses); 
                IF snap_error AND NOT interactive THEN goto 99; 
              END;
          END 
        ELSE {A namr was given, but it was not ascii.}
          BEGIN 
            error(runstring_bad_type);
            IF NOT interactive THEN goto 99;
          END;
      END ELSE namr_buffer.types.param1:=null;
  
    {Try to recover from any errors here.}
  
    first_pass:=true; 
    WHILE ((namr_buffer.types.param1<>ascii) OR (ierr<0) OR snap_error) DO
      BEGIN 
  
        {Output appropriate error messages.}
  
        IF ierr<0 THEN
          BEGIN 
            fmp_error(ierr,snap_file);
            IF NOT interactive THEN goto 99;
          END;
  
        IF (namr_buffer.types.param1<>ascii) AND NOT first_pass THEN
          BEGIN 
            error(bad_type);
            ierr:=0;
            IF NOT interactive THEN goto 99;
          END;
  
        {Prompt for a snap file namr.}
  
        IF terminal_outfile THEN prompt(ofile,snp_prompt) 
          ELSE write(ofile,snp_prompt); 
        IF echo_write THEN prompt(ifile,snp_prompt);
        line_read;
        IF abort OR build_ended THEN goto 99; 
  
  
        {Open it if possible.}
  
        IF (namr_buffer.types.param1=ascii) THEN
          BEGIN 
  
            snap_file:=namr_buffer.param1;
            snap_secu:=namr_buffer.param2.int;
            snap_crn:=namr_buffer.param3.int; 
            open(snap_dcb,ierr,snap_file,1,snap_secu,snap_crn); 
  
            {IF good open, get needed lables from snap.}
  
            IF ierr>=0 THEN 
              BEGIN 
                snap_process(snap_error,labls,addresses); 
                IF snap_error AND NOT interactive THEN goto 99; 
              END;
          END ELSE ierr:=0; 
        first_pass:=false;
      END;
  
     {Try to get original system file information from the run string.} 
  
     ierr:=0; 
     IF rspar(5,sub_namr,line_length)<>0 THEN 
       BEGIN
  
         {If a file namr was given, try to open it.}
  
         istrc:=1;
         namr(namr_buffer,sub_namr,line_length,istrc);
  
  
         IF (namr_buffer.types.param1=ascii) THEN 
           BEGIN
  
             {Open original type, shared access.} 
  
             origsystem:=namr_buffer.param1;
             open(prog_dcb,ierr,origsystem,1,namr_buffer.param2.int,
                                         namr_buffer.param3.int); 
  
             {ierr will return the type of the file upon proper 
              opening.  This should be type 1 since that is what
              the generator creates.  Orig_process does further 
              checking to insure the file is in fact a system.} 
  
             IF ierr>=0 THEN
               BEGIN
                 orig_process(orig_error,addresses);
                 IF orig_error AND NOT interactive THEN goto 99;
               END; 
           END
         ELSE {A number was given.  Reject it.} 
           BEGIN
             error(runstring_bad_type); 
             IF NOT interactive THEN goto 99; 
           END; 
       END ELSE namr_buffer.types.param1:=null; 
  
     {Try to recover if all did not go well.} 
  
     first_pass:=true;
     WHILE ((namr_buffer.types.param1<>ascii) OR (ierr<0) OR orig_error) DO 
       BEGIN
  
         {Output any appropriate error messages.} 
  
         IF ierr<0 THEN 
           BEGIN
             fmp_error(ierr,origsystem);
             IF NOT interactive THEN goto 99; 
           END; 
  
         IF (namr_buffer.types.param1<>ascii) AND NOT first_pass THEN 
           BEGIN
             error(bad_type); 
             ierr:=0; 
             IF NOT interactive THEN goto 99; 
           END; 
         {Prompt for, get, open, and if possible, process 
          the system file namr.}
  
         IF terminal_outfile THEN prompt(ofile,ori_prompt)
           ELSE write(ofile,ori_prompt);
         IF echo_write THEN prompt(ifile,ori_prompt); 
         line_read; 
         IF abort OR build_ended THEN goto 99;
  
         IF (namr_buffer.types.param1=ascii) THEN 
             BEGIN
  
               {Try to open original system file.}
               origsystem:=namr_buffer.param1;
               orig_secu:=namr_buffer.param2.int; 
               orig_crn:=namr_buffer.param3.int;
  
               open(prog_dcb,ierr,origsystem,1,orig_secu,orig_crn); 
  
               IF ierr>=0 THEN
                 BEGIN
                   orig_process(orig_error,addresses);
                   IF orig_error AND NOT interactive THEN goto 99;
                 END; 
             END ELSE ierr:=0;
           first_pass:=false; 
       END; 
  
    {Get the command file input error handling option.} 
  
    IF rspar(6,sub_namr,line_length)=0 THEN error_path:=uncond_abort
    ELSE
      BEGIN 
  
        {Some option was given, get it, and set the error_path.}
  
        istrc:=1; 
  
        namr(namr_buffer,sub_namr,line_length,istrc); 
  
        WITH namr_buffer.param1 DO
          IF command='CO' THEN error_path:=uncond_continue
            ELSE IF command='EN' THEN error_path:=uncond_end
              ELSE error_path:=uncond_abort;
     END; 
  
  
    {At this point, the original system file has been 
     been completely processed.  This file is close, the snap and 
     build image file are open, and the build image file (sys_file) 
     contains a copy of the original system.} 
99: 
  END;.{file_init,BUS1}