$pascal '92071-1X339 REV.2041  800808'$ 
$heap 0$
$segment$ 
PROGRAM BUS3; 
{ 
* 
*NAME:    BUS3
*SOURCE:  92071-18339 
*RELOC:   92071-16339 
*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.        *
****************************************************************
} 
  
{BUS3 is loaded into memory after any phase 3 command but RP is 
 detected.  These commands include SZ,PT,PA, etc.}
 {Read in the global constants, variables and types.} 
$include '&BUGBL'$  
  
{FMP call declarations.}
  
PROCEDURE purge(VAR idcb:dcb; VAR ierr:integer; VAR name:string6; 
                VAR isecu,icrn:integer);external; 
PROCEDURE fmp_close $ALIAS 'CLOSE'$(VAR idcb:dcb);external; 
PROCEDURE eclos(VAR idcb:dcb; VAR ierr:integer; itrun:doubint);external;
  
{System resources declarations.}
PROCEDURE cnumd(VAR int:integer; string:string6);external;
{Non FMP externals contained in the main program are next.} 
  
PROCEDURE namr(VAR buffer:namr_parse_buffer; VAR inline:input_line; 
               length:integer; VAR istrc:integer);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 error(message:input_line)$direct$;external; 
PROCEDURE writline(line:input_line); $direct$ external; 
  
{Calls to system, or system resources.} 
PROCEDURE exec(ecode,place_holder:integer);external;
PROCEDURE prtn(prams:prtn_prams);external;
  
  
{warning is called to output a message when a warning is detected.
 All warnings are nonfatal of course, so no boolean need be set.} 
{    message:         String which describes 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; {warning}
  
{handle_error handles certain forms of PASCAL errors, such as 
 an FMP -6 on a command file.  This is the only case which
 should, in theory, actually ever be trapped.}
{    err_type:        Describes the class of the error condition. 
     err_number:      Some classes of errors have an associated 
                      number, passed in this paramater. 
     err_line:        Some classes of errors occur at a specific
                      source line, and the line number is passed here.
     err_file:        Some errors pass the PASCAL file name identifier
                      as a paramater (i.e. fmp).  Note that this
                      paramater contains the internal (i.e. variable
                      name) representation of the file name, not
                      its actual external representation (i.e. namr). 
     err_flen:        Number of significant characters associated 
                      with err_file.} 
PROCEDURE handle_error (err_type: error_type; 
             err_number, err_line: integer; VAR err_file: input_line; 
             err_flen:integer); 
 CONST
  runtime='PASCAL RUNTIME SYSTEM CODE # ';
  at_line=' AT LINE ';
  segl='SEGMENT LOAD FAILURE IN ';
  io_error='PASCAL IO SYSTEM CODE # ';
 VAR
   error_file:string6;      {The name of the file in error.}
   ises,                  {Dummy param for loglu call.} 
   i:integer; 
 BEGIN
  
   {The file name is not always good. Try to detect 
    this case and prevent garbage from being displayed.}
  
   IF err_flen=0 THEN error_file.file_name:='      '
     ELSE 
       FOR i:= 1 TO 6 DO error_file.file_name[i]:=err_file[i];
  
   {Convert the file name from the internal representation
    (ifile or ofile) to its external name the user sees.} 
  
   IF error_file.file_name='IFILE ' THEN error_file:=input_file 
     ELSE IF error_file.file_name='OFILE ' THEN error_file:=output_file;
  
  {The error might be related to ifile or ofile.  In this 
   case, the attempt to write the error message could in
   turn result in another call to handle_error, which would 
   then yield an infinite loop of errors.  These next 
   few lines do a pretty good job of preventing this
   problem, but the result is that these errors will only 
   show up on the scheduling terminal.} 
  
  
  {Ignore any warnings.}
  IF err_type<>warn THEN
    BEGIN 
  
      echo_write:=false;
      close(ifile); 
      close(ofile); 
      rewrite(ofile,login_lu.file_name);
      CASE err_type OF
        fmp:
          fmp_error(err_number,error_file); 
        seg:
          BEGIN 
  
            {Output segment load error.}
  
            writeln(ofile,star_error,segl,error_file.file_name);
          END;
        io: 
  
          BEGIN 
  
            {These errors have their own code.} 
            {Output the general case error message.}
            writeln(ofile,star_error,io_error,err_number:3);
          END;
        run:
  
          BEGIN 
  
           {Runtime errors also  have their own code.}
           write(ofile,star_error,runtime,err_number:3);
           writeln(ofile,at_line,err_line:5); 
         END; 
       END; {Case Statement.} 
  
     {Abort the program with exec call. 
      First give the abortion message.} 
  
     writeln(ofile,build_prompt.five_char,aborted); 
  
     {Cleanup stray files.} 
  
     IF made_sys_file THEN
       purge(sys_dcb,ierr,sys_file,sys_secu,sys_crn); 
  
     {Close the snap.}
  
     fmp_close(snap_dcb); 
  
     {Return abort with prtn (recoverable by scheduling program 
      via rmpar).}
  
     prtn('ABORTED   ');
  
     {Exit with an exec call.}
  
      exec(6,0);
    END; {Fatal runtime error checks.}
 END;{handle_error} 
  
{cleanup_files is the last routine called by BUILD.  It closes
 the BUILD system and snap file, and purges the BUILD file
 if the run was aborted (/A).}
  
PROCEDURE cleanup_files; $direct$ 
  BEGIN 
   IF abort AND made_sys_file THEN
     purge(sys_dcb,ierr,sys_file,sys_secu,sys_crn); 
   IF abort THEN
     BEGIN
  
       {Output message.}
       writeln(ofile,build_prompt.five_char,aborted); 
       IF echo_write THEN writeln(ifile,build_prompt.five_char,aborted);
  
       {Set up abort return.} 
  
       prtn('ABORTED   ');
     END
   ELSE 
     BEGIN
  
       {Set up the end return.} 
  
       prtn('ENDED     ');
  
       {Close the BUILD output file.} 
  
       eclos(sys_dcb,ierr,((max_mem_size-mem_size)*recds_per_k) + 
                                                 roundoff_blocks);
  
       {Output the messages.} 
  
       IF made_sys_file THEN
         BEGIN
  
           writeln(ofile,build_prompt.five_char,cmpleted);
           IF echo_write THEN writeln(ifile,build_prompt.five_char, 
                                             cmpleted); 
           writeln(ofile,bootable_sys_image,sys_file.file_name,'.');
           IF echo_write THEN writeln(ifile,bootable_sys_image, 
                                             sys_file.file_name,'.'); 
         END; 
      END;
  
    {Close the snapshot.} 
  
    fmp_close(snap_dcb);
  
    {Close pascal opened files.}
  
    close(ifile); 
    close(ofile); 
  END; {cleanup_files}
  
{ss_process changes the system security code into a new value.} 
PROCEDURE ss_process; $direct$
  BEGIN 
  
    namr(namr_buffer,inline,line_length,istrc); 
  
  
    WITH namr_buffer DO 
     IF NOT ((types.param1=numeric) OR (types.param1=ascii)) THEN 
       error(bad_type)
       ELSE {Put the new code into the system.} 
         putword(param1.int1,sec_addr,sys_dcb,sys_dcb.buff, 
                 sys_file,cur_sys_rec,true);
  END; {ss_process} 
  
{st_process defines the last rp'ed program as the startup program,
 and places its rmpar params into its id.  Any previously defined 
 startup program is processed by zeroing its rmpar paramater field.}
  
PROCEDURE st_process; $direct$
  VAR 
    post:boolean;               {Tells putword to post to disk.}
    i,                          {Loop index for changing rampar params.}
    cur_id_addr:integer;        {Address of the current ID segment.}
  BEGIN 
  
    IF first_rp_process OR rp_error THEN error(bad_command) 
      ELSE
        BEGIN 
  
          {Calculate the address of the next free id.}
  
          cur_id_addr:=id_addr+(cur_id_number-1)*idseg_length;
  
          {Put the address at $BOOT.} 
  
          putword(cur_id_addr,start_addr,sys_dcb,sys_dcb.buff,
                  sys_file,cur_sys_rec,true); 
  
          post:=false;
          IF start_specified THEN {Zero out previous RMPAR paramaters.} 
            FOR i:=1 TO 5 DO
              BEGIN 
                IF i=5 THEN post:=true; 
                putword(0,last_start_id_addr+i,sys_dcb,sys_dcb.buff,
                        sys_file,cur_sys_rec,post); 
              END;
  
          start_specified:=true;
          last_start_id_addr:=cur_id_addr;
  
          {Now fill in the correct, new, RMPAR paramaters.} 
  
          FOR i:=1 TO 5 DO
            BEGIN 
              namr(namr_buffer,inline,line_length,istrc); 
  
              {Shove in ID regardless of type.} 
  
              cur_idseg.ints[1+i]:=namr_buffer.param1.int1; 
            END;
        END;
  END;  {st_process}
  
{question_process outputs the help facility in response to a ??.} 
PROCEDURE question_process; $direct$
  CONST 
    msg1= 
' Commands which are valid in the present context are as follows:'; 
    msg2= 
'   SS,newcode          Change the system security code to newcode.'; 
    msg3= 
'   PT                  Display a partition table which describes the'; 
    msg4= 
'                       size, location, and occupant of all partitions.'; 
    msg5= 
'   RP,prog,[newname]   Construct an id segment for the program (using';
    msg6= 
'                       newname if specified), relink the program if';
    msg7= 
'                       necessary, and load the program into memory.';
    msg8= 
'   /R                  Restart BUILD at the partition definition phase.';
    msg9= 
'                       All partition and ID tables are zeroed.'; 
    msg10=
'   /E                  End the BUILD process.';
    msg11=
'   /A                  Abort the BUILD process.  The output file made';
    msg12=
'                       by BUILD is purged.'; 
    msg13=
'   The remaining commands modify the last RPed program (if any).'; 
    msg14=
'   PR[IORITY],n        The program is to be of priority n.'; 
    msg15=
'   PA[RTITION],n       Load the program into partition n.';
    msg16=
'   ST[ART][,p1]..[,p5] The program is to be the startup program';
    msg17=
'                       with the specified optional RMPAR paramaters.'; 
    msg18=
'   SZ,nn               Size of the program including system common (if'; 
    msg19=
'                       used) in K words.  When specified, this overrides'; 
    msg20=
'                       the size as defined to the loader.';
 BEGIN
  
   {Output the instructions, conditional upon the context.} 
   writline(msg1);
   writline(msg2);
   writline(msg3);
   writline(msg4);
   writline(msg5);
   writline(msg6);
   writline(msg7);
   writline(msg8);
   writline(msg9);
   writline(msg10); 
   writline(msg11); 
   writline(msg12); 
   {Skip a space for cosmetic reasons.} 
  
   writeln(ofile);
   IF echo_write THEN writeln(ifile); 
  
   {Output information about the RP modifiers.} 
  
   writline(msg13); 
   writline(msg14); 
   IF NOT auto_partitioning THEN writline(msg15); 
   writline(msg16); 
   writline(msg17); 
   writline(msg18); 
   writline(msg19); 
   writline(msg20); 
  END;
  
{pt_process outputs the occupants and sizes of all partitions 
 defined so far in the BUILD process.}
PROCEDURE pt_process;$direct$ 
  CONST 
    header= 
'PRTN NUM  LOW PAGE  LENGTH  OCCUPANT'; 
    no_parts_defined='No partitions have been defined so far.'; 
    none='<NONE>';
   VAR
     cur_id_addr,             {Address of current id pointed to by
                               the current MAT.}
     cur_mat_addr,            {Address of current MAT being scanned.} 
     last_mat_number,         {Last sequential mat to scan.}
     length,                  {Length of current partition.}
     low_page,                {Starting page number of current partition.}
     mat_number:integer;      {Current mat number being scanned.} 
     occupant:string6;        {Name of occupant of partition.}
  BEGIN 
  
    IF (auto_partitioning AND (first_rp_process OR (rp_error AND
       (num_matvs=0)))) THEN
      BEGIN 
  
        {Automatic partitioning was selected, but no
         partitions have been defined.  Output an 
         indication of this fact to the user.}
  
        writeln(ofile,no_parts_defined);
        IF echo_write THEN writeln(ifile,no_parts_defined); 
      END 
    ELSE
      BEGIN 
        {Output the header.}
  
        writeln(ofile,header);
        IF echo_write THEN writeln(ifile,header); 
  
        {Initialize the loop starting and ending values.} 
  
        IF auto_partitioning AND NOT rp_error THEN
          last_mat_number:=num_matvs+1
          ELSE last_mat_number:=num_matvs;
        mat_number:=0;
        WHILE (mat_number<last_mat_number) DO 
          BEGIN 
  
            cur_mat_addr:=mat_addr+mat_number*mat_length; 
            mat_number:=mat_number+1; 
  
            {Get information about the partition size.} 
  
            IF (mat_number<>cur_mat_number) OR (NOT auto_partitioning) THEN 
              BEGIN 
  
                {Must look at the MAT on disk to get the information.}
                cur_id_addr:=getword(cur_mat_addr,sys_dcb,
                                  sys_dcb.buff,sys_file,cur_sys_rec); 
                length:=getword(cur_mat_addr+1,sys_dcb, 
                                  sys_dcb.buff,sys_file,cur_sys_rec) + 1; 
                low_page:=getword(cur_mat_addr+2,sys_dcb, 
                                  sys_dcb.buff,sys_file,cur_sys_rec); 
              END;
            IF (mat_number=cur_mat_number) AND NOT rp_error THEN
              BEGIN 
  
                {The needed information is mostly in memory.  Handle
                 this case specially since the next disk update occurs
                 on the next rp_process call.}
                IF auto_partitioning THEN 
                  BEGIN 
  
                    {Get the MAT information from in memory 
                     information.}
                    cur_id_addr:=0; 
                    length:=cur_idseg.id.size_less_1+1; 
                    low_page:=mem_size-rem_memory;
                  END;
  
                {The program name is in the in memory id.}
  
                occupant.five_char:=cur_idseg.id.name;
                occupant.file_name[6]:=space1;
              END 
              ELSE {Must go to disk to get the info 
                    since mat_number<>cur_mat_number.}
                BEGIN 
  
                  cur_id_addr:=getword(cur_mat_addr,sys_dcb,
                                  sys_dcb.buff,sys_file,cur_sys_rec); 
                  length:=getword(cur_mat_addr+1,sys_dcb, 
                                  sys_dcb.buff,sys_file,cur_sys_rec) + 1; 
                  low_page:=getword(cur_mat_addr+2,sys_dcb, 
                                  sys_dcb.buff,sys_file,cur_sys_rec); 
  
                  IF cur_id_addr=0 THEN occupant.file_name:=none
                  ELSE WITH occupant DO 
                    BEGIN 
  
                      int1:=getword(cur_id_addr+12,sys_dcb, 
                                sys_dcb.buff,sys_file,cur_sys_rec); 
                      int2:=getword(cur_id_addr+13,sys_dcb, 
                                sys_dcb.buff,sys_file,cur_sys_rec); 
                      int3:=getword(cur_id_addr+14,sys_dcb, 
                                sys_dcb.buff,sys_file,cur_sys_rec); 
                      file_name[6]:=space1; 
                    END;
               END; 
  
             {Output information about this partition.} 
  
             writeln(ofile,mat_number:8,low_page:10,length:8,space2,
                        occupant.file_name);
             IF echo_write THEN 
               writeln(ifile,mat_number:8,low_page:10,length:8,space2,
                        occupant.file_name);
          END;
      END;
  END; {pt_process} 
  
{pa_process inserts a program into a specified partition as 
 indicated by a PA command.  The PA command is only acceptable
 if automatic partition construction was not requested.}
PROCEDURE pa_process; $direct$
  CONST 
    in_use='PARTITION IN USE';
    too_small='PARTITION IS TOO SMALL'; 
  VAR 
    cur_mat_addr,       {The mat address of the specified partition.} 
    cur_id_addr,        {The id address field for the specified 
                         partition.}
    part_size_minus1:   {The partition size less 1 from the MAT.} 
            integer;
  BEGIN 
  
    IF auto_partitioning OR first_rp_process OR rp_error
      THEN error(bad_command) 
      ELSE
        BEGIN 
  
          {Pick up the specified partition.}
  
          namr(namr_buffer,inline,line_length,istrc); 
          IF namr_buffer.types.param1<>numeric THEN 
            error(bad_type) 
            ELSE IF (namr_buffer.param1.int1<1) OR
                    (namr_buffer.param1.int1>num_matvs) THEN
                   error(bad_range) 
              ELSE WITH namr_buffer DO
                BEGIN 
  
                  {No errors so far.  Pick up a few words from
                   the MAT associated with the partition number.} 
  
                  cur_mat_addr:=mat_addr + mat_length*(param1.int1-1);
  
                  cur_id_addr:=getword(cur_mat_addr,sys_dcb,
                                sys_dcb.buff,sys_file,cur_sys_rec); 
                  IF (cur_id_addr<>0) AND (param1.int1<>cur_mat_number) THEN
                    {The partition is in use.}
  
                    error(in_use) 
                  ELSE IF param1.int1<>cur_mat_number THEN
                    BEGIN 
  
                      part_size_minus1:=getword(cur_mat_addr+1,sys_dcb, 
                                     sys_dcb.buff,sys_file,cur_sys_rec);
  
                      IF part_size_minus1<cur_idseg.id.size_less_1 THEN 
                        {The partition is too small.} 
                        error(too_small)
                      ELSE {No errors.  Merely change the value 
                            of cur_mat_number to reflect this 
                            asignment.} 
                        cur_mat_number:=param1.int1;
                   END; 
                END;
        END;
  END; {pa_process} 
  
{pr_process changes the priority field of the last RPed program's ID.}
PROCEDURE pr_process; $direct$
  BEGIN 
    IF rp_error OR first_rp_process THEN error(bad_command) 
      ELSE
        BEGIN 
  
          {Pick up the new priority.} 
  
          namr(namr_buffer,inline,line_length,istrc); 
  
          IF namr_buffer.types.param1<>numeric THEN 
            error(bad_type) 
          ELSE IF namr_buffer.param1.int1<1 THEN
            error(bad_range)
            ELSE cur_idseg.id.priority:=namr_buffer.param1.int1;
        END;
  END;.{pr_process,BUS3}