$pascal '92071-1X338 REV.2041  800729'$ 
$heap 0$
$segment$ 
PROGRAM BUS2; 
{ 
* 
*NAME:    BUS2
*SOURCE:  92071-18338 
*RELOC:   92071-16338 
*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.        *
****************************************************************
} 
  
{BUS2 is loaded into memory after a RP command is detected, and 
 before exiting (to handle any last RP command).} 
 {Read in the global constants, variables and types.} 
$include '&BUGBL'$  
  
{Non FMP externals contained in the main program are next.} 
  
PROCEDURE namr(VAR buffer:namr_parse_buffer; VAR iline:input_line;
               length:integer;VAR istrc:integer);external;
PROCEDURE error(message:input_line);$direct$ external;
PROCEDURE set_error_path;$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;
  
  
{FMP externals are next.} 
  
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);external; 
  
{The relink routine returns errors in the a and b registers.} 
PROCEDURE abreg(VAR a,b:integer);external;
  
  
{The remaining procedures are written in assembly language, 
 and should be relocated with this segment.}
  
  
{Loader library routine for relinking type 6 files.}
PROCEDURE relink $ALIAS 'RLINK'$ (VAR snapshot,prog:dcb;
                                  VAR symbols:table_addr; bufflen:integer); 
                                                                external; 
  
{RLINK wants a pointer to the symbol table buffer, but I want to
 pass it a static array local to rp_process.  Since PASCAL pointers 
 point to types (not variables), and are only initialized by the
 heap management routine ,new, I need a routine to initialize a 
 pointer to point to a static variable.  POINT does this.}
  
PROCEDURE pointer_init $ALIAS 'POINT'$ (VAR pointer:table_addr; 
                                        VAR variable:symbuff);external; 
  
{The remaining procedures are local to this segment,except rp_process.} 
  
{warning is called to output a message when a warning is detected.
 All warnings are nonfatal of course, so no boolean need be passed. 
    message:          The string to be typed as the warning.} 
PROCEDURE warning(message:input_line);$direct$
  CONST 
    star_warning='*WARNING - '; 
  BEGIN 
  
    {The message string may be truncated to 60 characters for 
     the same reason as in routine error.}
  
    writeln(ofile,star_warning,message:60); 
    IF echo_write THEN writeln(ifile,star_warning,message:60);
  END;
{no_part_error is called by rp_process and sz_process when the
 routines detect there is no free or big enough partitions.}
{  err_code:             When negative, there are no free partitions
                         left, when zero, none are big enough for 
                         the program size passed to best_part. }
  
PROCEDURE no_part_error(VAR err_code:integer); $direct$ 
  CONST 
    large_enough='LARGE ENOUGH FOR PROGRAM';
  BEGIN 
    IF err_code<=0 THEN 
      BEGIN 
  
        {Output first part of this string.} 
  
        write(ofile,no_free_part);
        IF echo_write THEN write(ifile,no_free_part); 
        IF NOT interactive THEN set_error_path; 
        IF err_code<0 THEN
          BEGIN 
  
            {No free partitions at all remain. Output 
             the no_free_part error message.} 
  
            writeln(ofile); 
            IF echo_write THEN writeln(ifile);
          END 
        ELSE IF err_code=0 THEN 
          BEGIN 
  
            {Some free partitions remain, but none
             are big enough for the current program size.}
  
            writeln(ofile,large_enough);
            IF echo_write THEN writeln(ifile,large_enough); 
          END;
      END;
  END; {no_part_error}
  
{mem_remaining displays the amount of memory remaining after a
 program has been RPed, or its size has been modified when automatic
 partition construction has been specified.  It is
 called by rp_process and sz_process, and uses the global variables 
 cur_idseg and rem_memory.} 
PROCEDURE mem_remaining; $direct$ 
  CONST 
    pages_remaining=' pages of memory remaining.';
  VAR 
    remaining:integer;      {The amount which remains (tentatively--
                             it could be changed by a SZ command).} 
  BEGIN 
    remaining:=rem_memory-(cur_idseg.id.size_less_1+1); 
    writeln(ofile,remaining:3,pages_remaining); 
    IF echo_write THEN writeln(ifile,remaining:3,pages_remaining);
  END; {mem_remaining}
  
{display_asigment is the analogue of mem_remaining for the non
 automatic partitioning case.  It uses the globally defined 
 information in min_prog_size,cur_idseg, sys_common_sz, 
 and cur_mat_number to construct its message. 
 These globals must be correct before calling this routine.}
PROCEDURE display_asignment; $direct$ 
  CONST 
    prog_req='The minimum partition size required by this program is';
    prog_load_sz1='Its current size is';
    prog_load_sz2=' of which';
    prog_load_sz3=' pages are system common.';
    pages=' pages.';
    prog_asignment='The program is currently assigned to partition';
  VAR 
    whole_size:integer;       {The entire size of the program, including
                               system common.}
  BEGIN 
  
    {Check the last command.  The SZ command only 
     prints out a part of these messages.}
  
    IF user_command.chars='RP' THEN 
      BEGIN 
  
        writeln(ofile,prog_req,min_prog_size:3,pages);
        IF echo_write THEN writeln(ifile,prog_req,min_prog_size:3,
                                   pages);
        whole_size:=cur_idseg.id.size_less_1+1; 
        write(ofile,prog_load_sz1); 
        IF echo_write THEN write(ifile,prog_load_sz1);
        IF cur_idseg.id.system_common THEN
          BEGIN 
  
            {The program uses system common.  Adjust the whole size.} 
  
            whole_size:=whole_size+sys_common_sz; 
            writeln(ofile,whole_size:3,prog_load_sz2,sys_common_sz:3, 
                        prog_load_sz3); 
            IF echo_write THEN writeln(ifile,whole_size:3,prog_load_sz2,
                                 sys_common_sz:3,prog_load_sz3);
          END 
        ELSE
          BEGIN 
  
            {No system common is used, so the size is its actual size.} 
  
            writeln(ofile,whole_size:3,pages);
            IF echo_write THEN writeln(ifile,whole_size:3,pages); 
          END;
      END;
  
    {This string is output in any case.}
  
    writeln(ofile,prog_asignment,cur_mat_number:4,'.'); 
    IF echo_write THEN writeln(ifile,prog_asignment,cur_mat_number:4,'.');
  END; {display_asignment}
  
{best_part is an integer function which returns the best free 
 MAT address.  If there are no big enough partitions, best_part 
 will be zero, and if there are no remaining free partitions, best_part 
 will be -1.  best_part is called only when there is no 
 automatic partition construction.  Both rp_process and sz_process
 call this routine, and when a partition is found, cur_mat_number 
 will hold the number of this optimal partition.
   prog_size_minus1:        The size of the program, less 1,
                            which is used to determine the
                            optimal partition.} 
  
FUNCTION best_part(prog_size_minus1:five_bits):integer; 
  VAR 
    part_free:boolean;     {True when some partitions remain undefined, 
                            false otherwise.} 
    cur_best_part,         {Holds the number of the best partition
                            so far.}
    cur_id_addr,           {Holds an id segment address.} 
    cur_mat_addr,          {Holds a MAT address.} 
    cur_slack_in_best,     {Stores the slack in the best choice 
                            so far.}
    cur_slack,             {The free space behind the partition 
                            being checked for optimality.}
    i,                     {Loop index.}
    part_size_minus1,      {The partition size minus1 obtained
                            from the MAT being scanned.}
    slack_in_best_part:integer;{Best partition's slack.}
  BEGIN 
  
    {Initialize the slack variable to denote
     a worse than possible case.} 
  
    slack_in_best_part:=32; 
  
    i:=0; 
    cur_best_part:=0; 
    part_free:=false; 
    WHILE (i<num_matvs) AND (slack_in_best_part<>0) DO
      BEGIN 
  
        {Get id segment address word of the MAT.} 
  
        cur_mat_addr:=mat_addr+(i*mat_length);
        i:=i+1; 
        cur_id_addr:=getword(cur_mat_addr,sys_dcb,
                         sys_dcb.buff,sys_file,cur_sys_rec);
        IF cur_id_addr=0 THEN 
          BEGIN 
  
            {MAT is not in use.  Get its size, and see if 
             it is a better choice than the previous one.}
  
            part_free:=true;
            part_size_minus1:=getword(cur_mat_addr+1,sys_dcb, 
                             sys_dcb.buff,sys_file,cur_sys_rec);
            cur_slack:=part_size_minus1-prog_size_minus1; 
            IF (cur_slack>=0) AND (cur_slack
               <slack_in_best_part) THEN
              BEGIN 
  
                {This MAT is a better choice than the previous.}
  
                cur_best_part:=i; 
                slack_in_best_part:=cur_slack;
              END;
          END;
      END;
    IF NOT part_free THEN 
      {No free MATs at all remain. Return -1.}
      best_part:=-1 
      ELSE best_part:=cur_best_part;
  END;  {best_part} 
  
{Procedure undef_handler is called by the relink routine
 (RLINK) when undefined symbols were encountered.  The
 relink still took place.}
{   start_addr:           Address where the fixup table 
                          begins (inside of symbols, contained
                          in rp_process). 
    top_addr:             Last valid address of the fixup table.} 
PROCEDURE undef_handler $ALIAS 'UNRER'$ (VAR start_addr:table_addr; 
                                           top_addr:integer); 
  CONST 
    undefined_exts='UNDEFINED EXTERNAL REFERENCES'; 
  TYPE
  
    {symbol_entry is a type used for accessing each symbol
     table entry.  It reflects the structure of the table.} 
  
    symbol_entry= 
       RECORD 
         fixup_table:^integer;
         value:integer; 
         length:integer;
         symbol:varl_labl;
       END; 
  
  
     {entry_addr is a pointer to a symbol entry.} 
  
     entry_addr=
        RECORD
          CASE boolean OF 
            true: 
              (addr:^symbol_entry); 
            false:
              (int:integer) 
         END; 
  VAR 
    entry:entry_addr;       {A pointer used for accessing 
                             each table entry.} 
  BEGIN 
  
    {Output the warning message.} 
  
    warning(undefined_exts);
  
    {Assign local pointer to point to start of table.}
  
    entry.int:=start_addr.int;
  
    {Scan through the table, outputting undefined symbols.} 
  
    WHILE entry.int<top_addr DO 
      BEGIN 
        IF entry.addr^.value=-1 THEN
          BEGIN 
  
            {Symbol is undefined. Output it.} 
  
  
            writeln(ofile,entry.addr^.symbol.chars:(entry.addr^.length*2)); 
            IF echo_write THEN
              writeln(ifile,entry.addr^.symbol.chars:(entry.addr^.length*2)); 
          END;
  
        {In any case, point to the next symbol table entry.}
  
        entry.int:=entry.int+entry.addr^.length+3;
      END;
  END; {undef_handler}
  
{rp_process handles all RP commands.  It outputs the ID of any
 previous RP command into the ID segment, makes the MAT for 
 this previous program, and stores the program into the BUILD system. 
 It then handles the present RP command (if there is one) 
 by parsing the string, opening the file, getting its ID, 
 checking to make sure enough memory or a large enough partition
 remains, and relinking the program (if necessary). 
 The ID segment itself will be output 
 in the next call to rp_process.  This is so the modifiers correctly
 apply to the right id segment (cur_idseg).}
  
PROCEDURE rp_process; $direct$
  LABEL 1,  {Exit from rp_process, close file on error.}
        2;  {Exit from rp_process, file was never opened, so don't close.}
  CONST 
    cant_rp_program='CAN NOT RP A SEGMENTED PROGRAM'; 
    no_free_id='NO FREE ID SEGMENT';
    bad_file='CORRUPTED PROGRAM FILE';
    incorrect_type='INCORRECT FILE TYPE'; 
    prog_already_loaded='PROGRAM ALREADY LOADED'; 
    ill_snap_error='ILLEGAL SNAPSHOT';
    change_in_common='SYSTEM COMMON CHANGED'; 
    overflow_of_symbols='OVERFLOW OF SYMBOL TABLE USED FOR RELINKING';
    can_not_relink='CAN NOT RELINK PROGRAM';
    rpl_checksum_change='RPL CHECKSUM DOES NOT MATCH';
  VAR 
    post:boolean;              {Tells putword to post the 
                                buffer on the disk when true. 
                                When false, putword will only 
                                post the buffer when it detects 
                                a record boundary. Also used as 
                                a dummy boolean passed to error 
                                when the error never aborts or ends 
                                BUILD.} 
     a,b,                      {Returned from abreg}
     cur_id_addr,              {Holds an id segment address.} 
     cur_mat_addr,             {Holds a MAT address.} 
     first_record,             {First record of BUILD image file used 
                                for the starting value of the records in
                                the transfer of the type 6 program.}
     i,                        {Loop index.}
     length,                   {returned by readf.} 
     new_mat_number,           {Used to find the best partition and 
                                recover from the error conditions.} 
     starting_page:integer;    {Starting page number of the partition 
                                 being constructed or used.}
     newname:string6;          {Newname option specified in RP
                                command string, this is its name.}
     symbols:symbuff;          {Buffer used by relink routine.} 
     symbols_addr:table_addr;  {Pointer to symbol table buffer
                                required by RLINK.} 
  BEGIN 
  
    {Behave differently on first call to this routine.} 
  
    IF first_rp_process THEN
      BEGIN 
        first_rp_process:=false;
        cur_id_number:=1; 
      END 
    ELSE IF NOT rp_error THEN 
      BEGIN 
  
        {The RP command has been specified before, and its id 
         has possibly been modified by options.  When the 
         command was first processed, we made sure there was
         enough memory (auto_partitioning) or a large enough
         partition for the program.  Each option was checked
         for errors independantly.  Hence all that remains
         to do is construct the best partition (if auto_partitioning
         is true), put the id in the BUILD system image, and
         initialize the MAT for the program.  The actual
         program is stored on the second call to rp_process, since
         its ID may have been modified by subsequent RP options.} 
  
        IF auto_partitioning THEN 
          BEGIN 
  
            {Put the starting page of the partition in the MAT.}
  
            cur_mat_addr:=mat_addr+(mat_length*(cur_mat_number-1)); 
            starting_page:=mem_size-rem_memory; 
  
            {Put the partition size in the proper MAT.} 
  
            putword(cur_idseg.id.size_less_1,cur_mat_addr+1,sys_dcb,
                    sys_dcb.buff,sys_file,cur_sys_rec,false); 
            putword(starting_page,cur_mat_addr+2,sys_dcb,sys_dcb.buff,
                    sys_file,cur_sys_rec,true); 
  
            {Update the remaining memory count.}
  
            rem_memory:=rem_memory-(cur_idseg.id.size_less_1+1);
  
            {Update the number of mats defined so far.} 
            num_matvs:=cur_mat_number;
  
            {If the user last typed /E, set $MATV to contain
             the correct number of defined partitions.} 
  
            IF build_ended THEN 
              putword(num_matvs,matv_addr,sys_dcb,sys_dcb.buff, 
                      sys_file,cur_sys_rec,true); 
          END ELSE
            BEGIN 
  
              {Get the starting page number of the current
               partition from its MAT entry.} 
  
              cur_mat_addr:=mat_addr+(cur_mat_number-1)*mat_length; 
  
              starting_page:=getword(cur_mat_addr+2,sys_dcb,sys_dcb.buff, 
                                     sys_file,cur_sys_rec); 
            END;
  
        {Next, perform those functions on MATS and ids which must 
         be performed whether auto partitioning was selected or not.
         Note that cur_mat_number is correct regardless of the value
         of auto_partitioning, and is set sz_process, the previous
         call to rp_process (below), as well as the auto partition path.} 
  
        cur_id_addr:=id_addr + (idseg_length*(cur_id_number-1));
  
        {Make the MAT point to the proper id.}
  
        putword(cur_id_addr,cur_mat_addr,sys_dcb,sys_dcb.buff,
                sys_file,cur_sys_rec,true); 
  
        {Put the correct partition number in the id.} 
        {Note that cur_mat_number is set by the call to best_part 
         in the rp_process routine (below) as well as in the
         sz_process command.  Because of the SZ command, the
         type 6 file is not put in the BUILD image until the
         second call to rp_process.}
  
        cur_idseg.id.partition_number:=cur_mat_number;
  
        {Write the ID into the system.} 
  
        post:=false;
        FOR i:=1 to idseg_length DO 
          BEGIN 
            IF i=idseg_length THEN post:=true;
            putword(cur_idseg.ints[i],cur_id_addr,sys_dcb,sys_dcb.buff, 
                      sys_file,cur_sys_rec,post); 
            cur_id_addr:=cur_id_addr+1; 
          END;
  
        {Copy the type 6 file into the BUILD system image.} 
  
        first_record:=starting_page*recds_per_k;
  
        {Don't transfer the header, do transfer the last program
         record.  prog_len is the record length less the header.} 
  
        FOR i:=2 TO prog_len+1 DO 
          BEGIN 
  
            {Read a record from the file.}
            {About the only possible FMP error here is a disk error,
             which is not recoverable (typically).} 
  
            readf(prog_dcb,ierr,prog_dcb.buff,recd_len,length,i); 
  
            IF ierr<0 THEN fmp_error(ierr,prog_name)
              ELSE
                 {Put it in the BUILD output file.} 
                {Note that sys_dcb.buff is not used, so cur_sys_rec 
                 will still correctly refer to the info in its sys_dcb.buff.} 
  
                writf(sys_dcb,ierr,prog_dcb.buff,recd_len,(i-1+first_record));
                IF ierr<0 THEN fmp_error(ierr,sys_file);
          END;
  
        close(prog_dcb);
        {Update the cur_id_number counter to denote the next free 
         id.} 
  
        cur_id_number:=cur_id_number+1; 
  
      END;
    {Now, we perform those functions on the supplied user reply 
    (input_line) which can be performed on the first, each subsequent,
    but not the last, time through.  In other words, only the 
    previous portion of rp_process is executed on the last call 
    to this routine, a condition distinguished by the build_ended 
    boolean.} 
  
   IF NOT build_ended THEN
     BEGIN {} 
  
       {In this part of the routine, all the errors possibly associated 
        with the RP command are detected.  In order, these checks are 
            1. Check to see if there are any free ID segments.
            2. FMP errors on opening. 
            3. Insure it is type 6. 
            4. Insure it is non segmented (no disks known to BUILD).
            5. Check for name conflicts in previously RP'd programs.
            6. If automatic partition construction is in effect, make 
               sure enough memory remains for the program. The size 
               command (sz) also does this check, so a subroutine is
               provided for this check (best_part). Otherwise,
               if there is no automatic partitioning, insure that a 
               big enough, free, partition remains for the program. 
               The SZ command could alter the final choice, however,
               and does the same check using the same routine.
  
         The failure of any of these checks causes exit from the
         routine.  If along with these checks, this routine also
         performs several functions on the id.  These functions 
         are: 
           1. Set the in memory bit in the status word for the program's
              ID segment. 
           2. The type six file is relinked, if necessary, using the
              loader library relink routine, owned locally by this
              segment.
  
         The file is actually stored in memory during the next
         call to rp_process unless the current call to rp_process 
         results in an rp_error.  This is due to the possible modifying 
         command which might follow this RP command.} 
  
         rp_error:=false; 
  
         IF cur_id_number>num_ids THEN
           BEGIN
  
             {No more ids left.  Give error message.} 
  
             error(no_free_id); 
             rp_error:=true;
             goto 2;
           END; 
         IF NOT rp_error THEN 
           BEGIN
             {Parse the rest of the string, getting name, and newname 
              (if specified).}
  
             namr(namr_buffer,inline,line_length,istrc);
  
             {Assign the first paramater (file name)
              to a local string6 type. This is required 
              since PASCAL forbids passing actual paramaters
              of PACKED RECORD type.} 
  
             prog_name:=namr_buffer.param1; 
  
             IF namr_buffer.types.param1<>ascii THEN
               BEGIN
  
                 {Give them the bad paramater type error.}
  
                 error(bad_type); 
                 {Don't try to make a MAT or ID next time through 
                  rp_process.}
  
                 rp_error:=true;
                 goto 2;
               END; 
           END; 
         WITH namr_buffer DO
           BEGIN
             {Open the file once, checking its type.} 
  
             open(prog_dcb,ierr,prog_name,0,param2.int,param3.int); 
  
             {Report errors due to bad open or incorrect file type.}
  
             IF ierr<0 THEN 
               BEGIN
                 fmp_error(ierr,prog_name); 
                 rp_error:=true;
                 goto 2;
               END
             ELSE IF ierr<>6 THEN 
               BEGIN
  
                 {Output the bad type of file error.} 
  
                 error(incorrect_type); 
                 rp_error:=true;
                 goto 1;
               END; 
  
            {Close the file, regardless of errors or not.}
  
            close(prog_dcb);
  
            {If no error before, reopen the file exclusively using type 1 
             access.} 
  
  
            open(prog_dcb,ierr,prog_name,4,param2.int,param3.int);
  
  
            IF ierr<0 THEN
              BEGIN 
  
                fmp_error(ierr,prog_name);
                rp_error:=true; 
                goto 1; 
              END;
            {Get the header.} 
  
            readf(prog_dcb,ierr,prog_dcb.buff,recd_len,length,1); 
  
            IF ierr<0 THEN
              BEGIN 
                fmp_error(ierr,prog_name);
                rp_error:=true; 
                goto 1; 
              END;
  
            {Reject the file if it is segmented.} 
  
            IF prog_dcb.id.number_of_segments>0 THEN
              BEGIN 
                error(cant_rp_program); 
                rp_error:=true; 
                goto 1; 
              END;
  
            {See if the program has been loaded for this system.} 
  
            WITH prog_dcb DO
              IF ((ext.system_checksum<>sys_id_csw) OR
               ((id.system_common) AND (ext.system_common_checksum<>
                sys_com_csw))) THEN 
                  BEGIN 
  
                    {Initialize a pointer to point to the symbol
                     table buffer.} 
  
                    pointer_init(symbols_addr,symbols); 
  
                    {The program must be relinked.  Call a loader 
                     library routine to do this.} 
  
                    relink(snap_dcb,prog_dcb,symbols_addr,symbuff_length);
  
                    {Errors returned in a and b registers.} 
  
                    abreg(a,b); 
  
                    {Handle errors.}
  
                    IF b<>0 THEN {There were errors.} 
                      BEGIN {*} 
  
                        rp_error:=true; 
                        CASE b OF 
                          1: fmp_error(a,prog_name);
                          2: fmp_error(a,snap_file);
                          3:  CASE a OF 
                                -5: error(overflow_of_symbols); 
                                 3: BEGIN 
                                      error(ill_snap_error);
                                      IF NOT interactive AND (error_path<>
                                                              uncond_end) 
                                        THEN abort:=true; 
                                      END;
                               14: error(change_in_common); 
                               16: warning(rpl_checksum_change);
                               13: error(bad_file); 
                             OTHERWISE
                               {Will flow here in a=7 case which
                                was already dealt with by undef_handler.} 
                             END; 
                          4:  CASE a OF 
                                7:  {undef_handler was called, but
                                     report the RPL checksum error.}
                                    warning(rpl_checksum_change); 
                               END; {Case a OF} 
                        END; {CASE b OF}
  
                        {Tell user he can't relink for the previously 
                         output reason.}
                        IF (a<>16) AND (a<>7) THEN
                          BEGIN 
                            error(can_not_relink);
                            goto 1; 
                          END 
                        ELSE {Not an actual RP error, just a
                                 relink warning.} 
                             rp_error:=false; 
                      END; {*}
                  END;
              END; {WITH namr_buffer block.}
  
  
  
         {Zero link word.}
  
         prog_dcb.id.list_link:=0;
  
         {Set lu 1 as the scheduling lu.} 
  
         prog_dcb.id.terminal_lu:=1;
  
         {Save the the program's length in records. 
          Do not include the header in this size.}
  
         prog_len:=prog_dcb.ext.last_prog_rec-1;
  
  
         {Calculate the minimum partition required by 
          the program for the SZ command range check.}
  
         min_prog_size:=prog_len DIV recds_per_k; 
  
         IF (prog_len MOD recds_per_k) <>0 THEN 
           {Round up to the next page.} 
           min_prog_size:=min_prog_size+1;
  
         {Set the in memory bit in the id.} 
  
         prog_dcb.id.memory_resident:=true; 
  
         {If no errors so far, check for name conflict with 
           previously RP'd files.}
  
         {Parse the string to get the newname.} 
  
         namr(namr_buffer,inline,line_length,istrc);
         IF namr_buffer.types.param1=ascii THEN 
             {A newname was specified.  Put it in the id.}
             prog_dcb.id.name:=namr_buffer.param1.five_char 
         ELSE IF namr_buffer.types.param1<>null THEN
           BEGIN
  
             {A bad paramater type was given.}
  
             error(bad_type); 
             rp_error:=true;
             goto 1;
           END
         ELSE {Overlay name in ID with file name.}
             prog_dcb.id.name:=prog_name.five_char; 
         {Check for name conflicts.}
  
         i:=1;
         WHILE (i<cur_id_number) DO 
           BEGIN
  
             cur_id_addr:=id_addr+((i-1)*idseg_length); 
             IF (prog_dcb.buff[13]=getword(cur_id_addr+12,sys_dcb,
                sys_dcb.buff,sys_file,cur_sys_rec)) AND 
                (prog_dcb.buff[14]=getword(cur_id_addr+13,sys_dcb,
                sys_dcb.buff,sys_file,cur_sys_rec)) AND 
                (prog_dcb.buff[15]=getword(cur_id_addr+14,sys_dcb,
                sys_dcb.buff,sys_file,cur_sys_rec)) THEN
                  BEGIN 
                    rp_error:=true; 
                    error(prog_already_loaded); 
                    goto 1; 
                  END;
             i:=i+1;
           END; 
         {Check for a big enough partition or enough
          memory.}
  
         IF auto_partitioning THEN
           BEGIN
  
             IF ((prog_dcb.id.size_less_1+1)>rem_memory) THEN 
               BEGIN
                 error(not_enough_mem); 
                 rp_error:=true;
                 goto 1;
               END
             ELSE IF cur_mat_number>num_mats THEN 
               BEGIN
  
                 error(no_free_part); 
                 rp_error:=true;
                 goto 1;
               END; 
             {cur_mat_number must correspond to the proper id 
              contained in cur_idseg.}
  
             cur_mat_number:=cur_mat_number+1;
           END
         ELSE {Not automatic partitioning.} 
           BEGIN
  
             {Make sure a big enough partition
              exists.  The sz_process routine 
              does the same check before allowing 
              an increased size.  cur_mat_number
              will still be the valid best partition
              whether the SZ option is used or not
              upon the next call to rp_process
              (see above).} 
  
             new_mat_number:=best_part(prog_dcb.id.size_less_1);
  
             IF new_mat_number<=0 THEN
               BEGIN
  
                 rp_error:=true;
                 no_part_error(new_mat_number); 
                 IF NOT interactive THEN set_error_path;
                 goto 1;
               END
             ELSE cur_mat_number:=new_mat_number; 
           END; 
  
         {If there are no errors, make the cur_idseg
          reflect this correct, new id segment, still contained 
          in prog_dcb.buff.  Much information 
          is used between procedures inside this global 
          record. Also output information about this RP.} 
  
         cur_idseg.id:=prog_dcb.id; 
         IF auto_partitioning THEN mem_remaining
         ELSE display_asignment;
      1: IF rp_error THEN close(prog_dcb);
     END; {}
  2:
  END;{rp_process.} 
  
{sz_process handles the SZ command.  It is in this segment since
 it uses the best_part routine.}
  
PROCEDURE sz_process; $direct$
  CONST 
    too_small='SPECIFIED SIZE IS SMALLER THAN MINIMUM REQUIRED';
  VAR 
    sz_error:boolean;     {True when an error occurred processing 
                           the size command.} 
    new_mat_number,       {The new mat number given the 
                           new size information.} 
    new_size:integer;     {The specified size.} 
  BEGIN 
  
    sz_error:=false;
  
    {See if the command is valid in this context.}
  
    IF first_rp_process OR rp_error THEN error(bad_command) 
    ELSE
      BEGIN 
  
        {Parse the string to pick up the new size.} 
  
        namr(namr_buffer,inline,line_length,istrc); 
        new_size:=namr_buffer.param1.int1;
  
        {Compensate for system common (if used).} 
  
        IF cur_idseg.id.system_common THEN {Uses common.} 
           new_size:=new_size-sys_common_sz;
  
        {Check for a bad paramater.}
        IF namr_buffer.types.param1<>numeric THEN 
          BEGIN 
  
            {An integer was not passed, give bad param type error.} 
  
            error(bad_type);
            sz_error:=true; 
          END 
        ELSE IF (new_size>32) OR (new_size<1) THEN
          BEGIN 
  
            {Paramater is out of range.}
  
            error(bad_range); 
            sz_error:=true; 
          END 
        ELSE IF (new_size<min_prog_size) THEN 
          BEGIN 
  
            {Size is smaller than minimum required.}
  
            error(too_small); 
            sz_error:=true; 
          END 
        ELSE
          BEGIN 
  
            {No errors so far. See if there is a big
             enough partition left.}
  
  
            {In auto_partitioning case, check to make sure
             enough memory remains.}
  
            IF auto_partitioning AND (new_size>rem_memory) THEN 
              BEGIN 
  
                error(not_enough_mem);
                sz_error:=true; 
              END 
            ELSE IF NOT auto_partitioning THEN
              BEGIN 
                new_mat_number:=best_part(new_size-1);
  
                IF new_mat_number<=0 THEN 
                  BEGIN 
                    no_part_error(new_mat_number);
                    IF NOT interactive THEN set_error_path; 
                    sz_error:=true; 
                  END 
                ELSE
                  BEGIN 
  
                    {If this new size changed the partition 
                     asignment, tell the user. Note that the
                     condition only can occur in the non automatic
                     partition asignment case.} 
  
                    IF (new_mat_number<>cur_mat_number) THEN
                        cur_mat_number:=new_mat_number; 
                 END; 
              END;
          END;
        IF NOT sz_error THEN
          BEGIN 
            cur_idseg.id.size_less_1:=new_size-1; 
  
            IF auto_partitioning THEN mem_remaining 
              ELSE display_asignment; 
          END;
       END; 
   END;. {sz_process,BUS2}