$pascal '92071-1X336 REV.2041  800611'$ 
$heap 0$
PROGRAM BUILD;
{ 
*NAME:   BUILD
*SOURCE: 92071-18336
*RELOC:  92071-16336
*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.        *
****************************************************************} 
  
{BUILD is a utility for the RTE-L/20 which configures a memory image
 file is a bootable memory only (non disk) system.
Read in global constants, types, and variables.}
  
 $include 'BUGBL'$
  
{External procedure definitions. Calls to FMP.} 
  
PROCEDURE readf(VAR idcb:dcb; VAR ierr:integer; VAR ibuff:buffer; 
                ilen:integer;  VAR len,num:integer);external; 
PROCEDURE writf(VAR idcb:dcb; VAR ierr:integer; VAR ibuff:buffer; 
          ilen,rec_num:integer);external; 
{Although open is not used in the main, it is used by all of
 the segments.  Declare it here to make the segments smaller, 
 and cut down on segment load time, at no cost of total program 
 size.} 
PROCEDURE open(VAR idcb:dcb; VAR ierr:integer; VAR file_name:string6);
                                                             external;
{Similarly, all segments use namr, so declare it here.} 
PROCEDURE namr(VAR buffer:namr_parse_buffer; VAR inline:input_line; 
               length:integer; VAR istrc:integer);external; 
  
{Declare calls to system resources.}
FUNCTION ifbrk:integer;external;
  
{The remaining external procedures are in the segments.}
{See the segment source listings for documentation on the calling 
 and return sequences.} 
PROCEDURE handle_error(err_type: error_type; {Set of error cases} 
             err_number,err_line:  integer; VAR err_file: input_line; 
             err_flen:integer); external; 
  
PROCEDURE file_init;$direct$ external;
PROCEDURE def_partitions;$direct$ external; 
PROCEDURE get_command$direct$;external; 
PROCEDURE cleanup_files;$direct$ external;
PROCEDURE ss_process;$direct$ external; 
PROCEDURE question_process;$direct$ external; 
PROCEDURE pt_process;$direct$ external; 
PROCEDURE sz_process;$direct$ external; 
PROCEDURE st_process;$direct$ external; 
PROCEDURE pa_process;$direct$ external; 
PROCEDURE rp_process;$direct$ external; 
PROCEDURE pr_process;$direct$ external; 
  
{This procedure handles the segment loads.} 
{@SGLD is a PASCAL library routine.}
  
PROCEDURE segload $ALIAS '@SGLD'$ (segment:fname);external; 
  
{segment_load uses segload and information about the segment
 structure contained in set types to ease the segmentation process.}
{   called_routine:       Enumerated type which indicates the 
                          name of the routine which is to be
                          called immediately after segment_load.} 
PROCEDURE segment_load(called_routine:all_routines); $direct$ 
  BEGIN 
  
    {Changing the various case conditions, and possibly the 
     all_routines type (when adding or deleting routines),
     is all that is required when changing the segmentation 
     structure.}
  
    CASE called_routine OF
      fileinit: 
          IF segnum<>1 THEN 
            BEGIN 
              segload('BUS1  ');
              segnum:=1;
             END; 
      rpprocess,szprocess:
          IF segnum<>2 THEN 
            BEGIN 
              segload('BUS2  ');
              segnum:=2;
            END;
      paprocess,ssprocess,questionprocess,ptprocess,
      stprocess,handleerror,cleanupfiles,prprocess: 
          IF segnum<>3 THEN 
            BEGIN 
              segload('BUS3  ');
              segnum:=3;
            END;
        getcommand,defpartitions: 
          IF segnum<>4 THEN 
            BEGIN 
              segload('BUS4  ');
              segnum:=4;
            END;
    END; {CASE} 
  END; {segment_load} 
  
{break_program is a boolean function which is mapped onto the system
 library routine ifbrk.  The routine merely calls ifbrk, and
 sets break_program true or false accordingly.   It also sets abort 
 true should the break flag be set.}
FUNCTION break_program:boolean; $direct$
  BEGIN 
    IF ifbrk=0 THEN break_program:=false
    ELSE
      BEGIN 
        break_program:=true;
        abort:=true;
      END;
  END;
  
{set_error_path defines the appropriate error path when an error
 is detected, and input is from a command file.}
PROCEDURE set_error_path; $direct$
  BEGIN 
  
    CASE error_path OF
      uncond_abort:  abort:=true; 
      uncond_end:    build_ended:=true; 
      OTHERWISE 
    END;
  END; {set_error_path} 
{fmp_error is called whenever FMP returns an error code in ierr.} 
{     ierr:        FMP error code, passed by value, 
      name:        Name of file which had an associated error.} 
  
PROCEDURE fmp_error(ierr:integer;VAR name:string6); $direct$
  CONST 
    fmp='FMP '; 
    on_file=' ON FILE: '; 
  BEGIN 
    writeln(ofile,star_error,fmp,ierr:5,on_file,
                    name.file_name);
    IF echo_write THEN writeln(ifile,star_error,fmp,ierr:5,on_file, 
                              name.file_name);
    IF NOT interactive THEN set_error_path; 
  
  END; {fmp_err}
  
{pascl_errors catches all pascal runtime system generated errors. 
 It is in a segment since the actual error handling routine (handle_error)
 aborts the program. The PASCAL runtime call uses .ENTR convention.}
  
PROCEDURE pascl_error $ALIAS '@PREP'$ (err_type: error_type;
             err_number,err_line: integer; VAR err_file:input_line; 
             err_flen:integer); 
  BEGIN 
  
    {Overlay any other segment.  This is the last segload.} 
  
    segment_load(handleerror);
  
    {Call actual error handler.}
    handle_error(err_type,err_number,err_line,err_file,err_flen); 
  END;{pascl_error} 
  
{cnvrt_addr accepts an integer address and returns the record 
 number (recnum) and its offset (starting at 1 for address 0) 
 assuming the file concerned is a memory image, with no header.}
{    addr:     integer address, passed by value,
     recnum:   integer record numeer associated with address, returned, 
               so passed by name, 
     offset:   integer offset within the record associated with 
               the address, returned, so passed by name.     }
  
PROCEDURE cnvrt_addr(addr:integer; VAR recnum,offset:integer); $direct$ 
  BEGIN 
    recnum:=(addr DIV recd_len)+1;
    offset:=(addr MOD recd_len)+1;
  END; {cnvrt_addr} 
  
{getword is a function which is passed an address, and some parameters
 about the memory image file (no header),and returns the value stored 
 at the passed address. The parameter curr_rec is used to prevent needless
 disk reads (when the current buffer contains the needed word).}
{     address:    Address of word to be retrieved, passed by value, 
      idcb:       dcb of the memory image file the word is in, passed 
                  by name to achieve efficient parameter passing, 
      ibuff:      buffer associated with the above dcb. Type 1
                  file access bypasses the idcb. Passed by name 
                  for efficiency, 
      name:       file name where information exists. Used to pass
                  fmp_error the name when errors occur. Passed
                  by name,
      curr_rec:   The current record number which had the information 
                  currently in ibuff, used to prevent needless disk reads.
                  Passed by name since it may be modified.} 
  
FUNCTION getword(address:integer;VAR idcb:dcb; VAR ibuff:buffer;
                 VAR name:string6;VAR curr_rec:integer):integer;
  VAR 
  
    {integer type declarations.}
    ierr,                    {FMP error code identifier.} 
    len,                     {Number of characters actually read by a readf.} 
    offset,                  {Buffer offset of the desired word in the record.} 
    recd:integer;            {Record number which contains the desired word.} 
  
  BEGIN 
    cnvrt_addr(address,recd,offset);
    IF recd<>curr_rec THEN
      BEGIN 
  
        {Its a miss. Get the correct record.} 
  
        readf(idcb,ierr,ibuff,recd_len,len,recd); 
        IF ierr<0 THEN fmp_error(ierr,name) 
          ELSE curr_rec:=recd;
      END;
    IF ierr>=0 THEN getword:=ibuff[offset]; 
  END; {getword}
  
{putword stores the word at the passed address into the appropriate 
 memory image file (no header). The word is actually stored onto the
 disk when the boolean ship is true, or when a record boundary is reached.} 
{     word:       Integer to be stored at the specified address, passed 
                  by value, 
      address:    Integer address where word is to be stored, passed by 
                  value,
      idcb:       dcb of the memory image file the word is in,passed
                  by name,
      ibuff:      buffer associated with the above dcb. 
      name:       File name where the information is to be stored. Used 
                  to pass fmp_error the name when errors occur. Passed
                  by name,
      curr_rec:   The current record number which had the information 
                  currently in ibuff, used to prevent needless disk reads.
      ship:       A boolean passed by value, when true, ibuff is written
                  to the disk, when false, ibuff is only written to the 
                  disk if the offset is a record boundary.} 
  
PROCEDURE putword(word,address:integer; VAR idcb:dcb; VAR ibuff:buffer; 
                  VAR name:string6; VAR curr_rec:integer; ship:boolean);
  VAR 
    {integer type declarations.}
    ierr,                         {FMP error code returned here.} 
    len,                          {Actual number of characters read 
                                   by a readf call.}
    offset,                       {Buffer offset of word to store.} 
    recd:integer;                 {Record number associated with address.}
  
  BEGIN 
    cnvrt_addr(address,recd,offset);
    IF recd<>curr_rec THEN
      BEGIN 
  
        {Its a miss. Get the correct record.} 
  
        readf(idcb,ierr,ibuff,recd_len,len,recd); 
        IF ierr<0 THEN fmp_error(ierr,name) 
          ELSE curr_rec:=recd;
      END;
    IF ierr>=0 THEN 
      BEGIN 
        ibuff[offset]:=word;
        IF ship OR (offset=recd_len) THEN 
          BEGIN 
            writf(idcb,ierr,ibuff,recd_len,recd); 
            IF ierr<0 THEN fmp_error(ierr,name);
          END;
      END;
  END; {putword}
  
  
{writline writes certain strings to the files.} 
{     inline:    The input line to be written. Passed by name for 
                 sake of efficiency.} 
PROCEDURE writline(VAR inline:input_line); $direct$ 
  BEGIN 
    writeln(ofile,inline);
    IF echo_write THEN writeln(ifile,inline); 
  END; {writline} 
  
{error is the routine which prints out most of the error messages.
   message:                The passed message.
   bool:                   A boolean which is set true if 
                           BUILD is not runing interactively.}
PROCEDURE error(message:input_line); $direct$ 
  BEGIN 
  
    {Output the error.  The entire message string is not output to
     prevent possible overflows.  The entire message should be seen,
     however, since all errors have under 63 characters.} 
  
    writeln(ofile,star_error,message:63); 
    IF echo_write THEN writeln(ifile,star_error,message:63);
    IF NOT interactive THEN set_error_path; 
  END; {error}
  
  {The main program now begins.}
  
  BEGIN 
  
    {Load the segment containing the file initialization routine.}
  
    segment_load(fileinit); 
  
    {Define the PASCAL file variables IFILE and OFILE, depending
     upon the run string. Prompt for any files not given in run string. 
     Open the files, and check for error conditions concerning the snap and 
     system files.} 
  
    IF NOT break_program THEN file_init;
  
    {Define the partitions. The restart (/R command) returns
     the flow to a different point.}
  
    segment_load(defpartitions);
  
    {The loop is in case a /R is typed while defining partitions.}
  
    restart_partitioning:=true; 
  
    WHILE restart_partitioning AND NOT (abort OR build_ended OR 
                                        break_program) DO 
      def_partitions; 
  
    first_rp_process:=true; 
  
    {Loop here until aborted or ended.} 
  
    WHILE NOT (abort OR build_ended OR break_program) DO
      BEGIN 
  
        {Call get_command.  The routine merely outputs the
         build prompt, and calls line_read to get the 
         string.  The string will be in the global inline,
         and its parsed representation will be in namr_buffer.
         This is a routine so many library routines are in
         the segment, not in the main.} 
  
        segment_load(getcommand); 
        get_command;
        {Save the command for use by best_part.}
  
        user_command.chars:=namr_buffer.param1.command; 
        WITH namr_buffer DO 
        IF types.param1<>ascii THEN 
  
          error(bad_type) 
       ELSE 
        {Handle the command cases.} 
  
        IF param1.command='SS' THEN 
          BEGIN 
            segment_load(ssprocess);
            ss_process; 
          END 
        ELSE IF param1.command='/R' THEN
          BEGIN 
            segment_load(defpartitions);
            restart_partitioning:=true; 
  
            {The while loop is in case the user types /R during 
             the partition definition phase.} 
  
            WHILE restart_partitioning DO 
              def_partitions; 
          END 
        ELSE IF param1.command='??' THEN
          BEGIN 
            segment_load(questionprocess);
            question_process; 
          END 
        ELSE IF param1.command='PT' THEN
          BEGIN 
            segment_load(ptprocess);
            pt_process; 
          END 
        ELSE IF param1.command='RP' THEN
          BEGIN 
            segment_load(rpprocess);
            rp_process; 
          END 
        ELSE IF param1.command='PR' THEN
          BEGIN 
            segment_load(prprocess);
            pr_process; 
          END 
        ELSE IF param1.command='SZ' THEN
          BEGIN 
            segment_load(szprocess);
            sz_process; 
          END 
        ELSE IF param1.command='ST' THEN
          BEGIN 
            segment_load(stprocess);
            st_process; 
          END 
        ELSE IF param1.command='PA' THEN
          BEGIN 
            segment_load(paprocess);
            pa_process; 
          END 
        ELSE IF NOT (abort OR build_ended) THEN 
          error(bad_command); 
      END;
    IF build_ended THEN 
      BEGIN 
  
       {Call rp_process to take care of the last RP command 
        (when specified.} 
  
        segment_load(rpprocess);
        rp_process; 
      END;
  
    {Close files, purge the BUILD image if aborted, and output
     the completion messages.}
  
    segment_load(cleanupfiles); 
    cleanup_files;
  
  END. {BUILD}