$pascal '92071-1X290 REV.2041  800808'$ 
$heap 0$
$segment$ 
PROGRAM PFS2; 
{ 
* 
*NAME:    PFS2
*SOURCE:  92071-18290 
*RELOC:   92071-16290 
*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.        *
****************************************************************
} 
  
{PFS2 is loaded into memory after all of the required input files 
 have been processed by file_init.  It contains def_partitions, 
 crn_init_process, and lu_process.  It will typically 
 only be loaded into core once each new PROM module is formatted.}
 {Read in the global constants, variables and types.} 
$include '&PFGBL'$
  
{Declarations to system recources routines.}
  
PROCEDURE cnumd(VAR int:integer; VAR buff:string6); external; 
  
{Declaration of FMP routines.}
  
PROCEDURE ecrea(VAR idcb:dcb; VAR ierr:integer; VAR name:string6; 
               VAR isz:isize_type; itype,isecu,icrn:integer);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;
{Non FMP externals contained in the main program are next.} 
  
PROCEDURE line_read;$direct$external; 
PROCEDURE error(message:input_line);external; 
PROCEDURE writline(line:input_line);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);external; 
  
{part_header_printout outputs the header for the partition definition 
 phase of PFORM.} 
  
PROCEDURE part_header_printout(VAR pages_in_system:integer); $direct$ 
  CONST 
    msg3= 
'*     The partition layout of the  RTE-XL system will now be           *'; 
    msg4f1='*     defined.  ';
    msg4f3='  requires the first';
    msg4f5=' pages of memory.      *';
    msg5= 
'*     This phase will be completed automatically when all memory or    *'; 
    msg6= 
'*     partition tables have been defined.  A /C also completes this    *'; 
    msg7= 
'*     phase, and a /R will restart this phase of the PROM formatting.  *'; 
  TYPE
    special_string= 
       RECORD 
         CASE boolean OF
           true:
            (field1:PACKED ARRAY [1..16] OF char; 
             field2:fname;
             field3:PACKED ARRAY [23..42] OF char;
             field4:fname;
             field5:PACKED ARRAY [49..line_length] OF char);
           false: 
            (whole_string:input_line) 
         END; 
  VAR 
    tline:special_string;           {Used to insert words into message.}
    system_size:string6;            {Contains ascii representation of 
                                     the system size in pages.} 
  
  BEGIN 
  
    {Define the fields of tline for the message output.}
  
    tline.field1:=msg4f1; 
    tline.field2:=origsystem.file_name; 
    tline.field3:=msg4f3; 
    tline.field5:=msg4f5; 
  
    {Convert system size in pages into ASCII.}
  
    cnumd(pages_in_system,system_size); 
  
    tline.field4:=system_size.file_name;
  
  
    {Output the messages.}
  
    writline(head1);
    writline(head2);
    writline(msg3); 
    writline(tline.whole_string); 
    writline(msg5); 
    writline(msg6); 
    writline(msg7); 
    writline(head2);
  END; {part_header_printout} 
{def_partitions is where the partition tables get intitialized.  It assumes 
 that the system file is open, the needed labels have been found
 from the snap, and that all tables are initially undefined.} 
  
PROCEDURE def_partitions; $direct$
  LABEL 1,99; 
  CONST 
    phys_memory_size='Physical memory size in K words (nnn) ? ';
    partition='Partition '; 
    len_in_pages=' length in pages (nn) ? ';
    pages_remaining=' pages of memory remaining.';
    mats_remaining=' partition tables remain undefined.'; 
  VAR 
    post:boolean;         {Tells putword when to write the buffer 
                           to the disk.}
    cur_mat_addr,         {Current address of MAT.} 
    cur_mat_num,          {Number of current MAT being scanned or 
                           defined.}
    cur_part_number,      {Current partition number, which is cur_mat_num 
                           plus one.} 
    cur_part_size,        {Size in K of partition being configured.}
    cur_part_start_page,  {First page number of current partition}
    i,                    {A loop counter.} 
    last_id_addr,         {Address of the last entry in the last
                           ID segment.} 
    last_mat_addr,        {Address of the last entry in the last
                           MAT entry.}
    rem_memory,           {K of memory which remains undefined at 
                           the current point in time.}
    start_page:integer;   {Starting page of first new user partition.}
  
  BEGIN 
  
    {Initialize a few global variables.}
  
    restart_partitioning:=false;
    completed_phase:=false; 
    slash_control:=false; 
    max_partition_size:=0;
  
    {Initialize local variables.} 
  
    start_page:=pages_in_system;
    last_mat_addr:=mat_addr+(mat_num*mat_length-1); 
    cur_mat_num:=0; 
    last_id_addr:=id_addr+(id_num*idseg_length-1);
  
  
    {Find out the minimum memory requirements for the original system.} 
  
    IF last_command.command='/R' THEN 
      BEGIN 
        {The user must have intentionally typed /R.  This allows
         him to completely redefine all partitions and ids. Hence 
         the minimum memory size is the value of $USER, which is
         already stored in start_page.} 
  
        {We might as well zero all ids and mats at this point 
         for insurance.}
  
        post:=false;
        FOR i:=id_addr TO last_id_addr DO 
          BEGIN 
  
            IF i=last_id_addr THEN post:=true;
            putword(0,i,sys_dcb,sys_dcb.buff,sys_file,rec_in_sys_dcb,post); 
          END;
        post:=false;
        FOR i:=mat_addr TO last_mat_addr DO 
          BEGIN 
  
            IF i=last_mat_addr THEN post:=true; 
            putword(0,i,sys_dcb,sys_dcb.buff,sys_file,rec_in_sys_dcb,post); 
          END;
      END ELSE
        BEGIN 
  
          {This is the first time the routine has been called.  Find
           out the minimum memory requirements for the system.} 
  
          IF (matv_num>0) THEN
            BEGIN 
  
              {The original system file was not the initial output
               of the generator.  Assume it was run through the 
               PFORM utility.  At this point, we must scan through
               the MATs to find out the maximum 
               partition size, and to find out the minimum memory required
               by the original system.} 
  
              start_page:=pages_in_system;
              WHILE (cur_mat_num<matv_num) DO 
                BEGIN 
  
                  cur_mat_addr:=mat_addr+(cur_mat_num*mat_length);
                  cur_part_size:=getword(cur_mat_addr+1,sys_dcb,sys_dcb.buff, 
                                        sys_file,rec_in_sys_dcb); 
                  IF cur_part_size>max_partition_size THEN
                    max_partition_size:=cur_part_size;
  
                   start_page:=start_page+1+cur_part_size;
                  cur_mat_num:=cur_mat_num+1; 
                END;
           END ELSE {System is unmodified output of generator.} 
                BEGIN 
                  cur_id_num:=1;
                  cur_mat_addr:=mat_addr; 
                  cur_id_addr:=id_addr; 
                  start_page:=pages_in_system;
                END;
        END;
  
    {Print out the header for this phase.}
  
    part_header_printout(start_page); 
  
    {Get physical memory size in K words.}
  
    namr_buffer.types.param1:=null; 
  
    WHILE (physical_memory_size<start_page) OR (namr_buffer.types.param1
          <>numeric) DO 
      BEGIN 
  
        IF terminal_outfile THEN prompt(ofile,phys_memory_size) 
          ELSE write(ofile,phys_memory_size); 
        IF echo_prompt THEN prompt(ifile,phys_memory_size); 
  
        {Get the reply.}
  
        line_read;
  
        IF completed_phase THEN goto 1; 
        IF slash_control THEN goto 99;
  
        {Make sure an integer was returned.}
  
        IF (namr_buffer.types.param1<>numeric) THEN 
          BEGIN 
  
            {Output bad paramater type error.}
  
            error(bad_type);
            IF NOT interactive AND (abort OR pform_ended) THEN goto 99; 
          END ELSE physical_memory_size:=namr_buffer.param1.int1; 
  
  
        {If integer returned, make sure it is within range.}
  
        IF (physical_memory_size<start_page)  AND 
            (namr_buffer.types.param1=numeric) THEN 
          BEGIN 
  
            {Output paramater out of range error.}
  
            error(bad_range); 
            IF NOT interactive AND (abort OR pform_ended) THEN goto 99; 
  
            {Insure the prompt is repeated.}
  
            namr_buffer.types.param1:=null; 
          END 
        ELSE rem_memory:=physical_memory_size-start_page; 
      END;
  
    cur_part_start_page:=start_page;
  
    {Loop here until all partitions have been defined.} 
  
    WHILE  (cur_mat_num<mat_num) AND (rem_memory>0) DO
      BEGIN 
  
        {Output remaining memory message.}
  
        writeln(ofile,rem_memory:3,pages_remaining);
        IF echo_prompt THEN writeln(ifile,rem_memory:3,pages_remaining);
  
        {Skip a line.}
  
        writeln(ofile); 
        IF echo_prompt THEN writeln(ifile); 
  
        {Prompt for size of current partition.} 
  
        cur_part_number:=cur_mat_num+1; 
        IF terminal_outfile THEN
          prompt(ofile,partition,cur_part_number:3,len_in_pages)
        ELSE
          write(ofile,partition,cur_part_number:3,len_in_pages);
        IF echo_prompt THEN prompt(ifile,partition,cur_part_number:3, 
                                    len_in_pages);
  
        {Get his reply.}
        line_read;
  
        IF completed_phase THEN goto 1; 
        IF slash_control THEN goto 99;
  
        cur_part_size:=namr_buffer.param1.int1; 
        IF (namr_buffer.types.param1<>numeric)  THEN
          BEGIN 
  
            error(bad_type);
            IF NOT interactive AND (abort OR pform_ended) THEN goto 99; 
          END 
        ELSE IF ((cur_part_size<1) OR (cur_part_size> 
                32) OR (cur_part_size>rem_memory)) THEN 
          BEGIN 
  
            {Output paramater out of range error.}
  
            error(bad_range); 
            IF NOT interactive AND (abort OR pform_ended) THEN goto 99; 
          END 
        ELSE
          BEGIN 
  
            {Make the MAT entry.} 
  
            cur_mat_addr:=mat_addr+cur_mat_num*mat_length;
  
            {Must zero id seg address in case a /R was typed.}
            putword(0,cur_mat_addr,sys_dcb,sys_dcb.buff,sys_file, 
                    rec_in_sys_dcb,false);
            putword(cur_part_size-1,cur_mat_addr+1,sys_dcb,sys_dcb.buff,
                    sys_file,rec_in_sys_dcb,false); 
            putword(cur_part_start_page,cur_mat_addr+2,sys_dcb,sys_dcb.buff,
                    sys_file,rec_in_sys_dcb,true);
  
            {Update values.}
  
            rem_memory:=rem_memory-cur_part_size; 
            cur_mat_num:=cur_mat_num+1; 
            cur_part_start_page:=cur_part_start_page+cur_part_size; 
            IF cur_part_size>max_partition_size THEN
              max_partition_size:=cur_part_size;
            END;
      END;
  
1:
  {Output the messages completing this phase, and starting
   the next one.} 
  
  {Tell user how much memory remains.}
  
  writeln(ofile,rem_memory:3,pages_remaining);
  IF echo_prompt THEN writeln(ifile,rem_memory:3,pages_remaining);
  
  
  matv_num:=cur_mat_num;
 {Set $MATV to contain the number of defined partitions.} 
  
 putword(matv_num,matv_addr,sys_dcb,sys_dcb.buff,sys_file,
         rec_in_sys_dcb,true);
  {If some program was specified as the startup program, then 
   zero $BOOT in case no program is the startup program on the
   next pass through.}
  
  IF start_specified THEN 
    BEGIN 
  
      start_specified:=false; 
      putword(0,start_addr,sys_dcb,sys_dcb.buff,sys_file, 
              rec_in_sys_dcb,true); 
    END;
  
  {Adjust pages_in_system and sys_len for the BUILD output
   file case.  The /R command can not be used any more at this point.}
  
   pages_in_system:=start_page; 
   sys_len:=pages_in_system * recds_per_k;
  
  {Tell the user how many undefined MAT entries remain.}
  
  writeln(ofile,(mat_num-cur_mat_num):3,mats_remaining);
  writeln(ofile); 
  IF echo_prompt THEN 
    BEGIN 
      writeln(ifile,(mat_num-cur_mat_num):3,mats_remaining);
      writeln(ifile); 
    END;
  
99: 
   END; {def_partitions}
  
  
{process_prom_file uses the driver params to find the length of the prom file 
 to be created, creates the file specified by the namr, handles 
 errors, and fills the output file with -1.}
 {   file_error:             True when some FMP error occurs
                             during the prom file processing. 
     overflow_error:         True if the system image is larger 
                             than the space on the PROM.} 
PROCEDURE process_prom_file(VAR file_error,overflow_error:boolean); $direct$
CONST 
  {Define prom_file related error message.} 
  not_enough_mem='NOT ENOUGH MEMORY FOR SYSTEM IMAGE';
VAR 
  i,                           {A loop index.}
  start_neg_rec:integer;       {The record number from which the
                                filling of the output file with -1
                                begins on.  This number 
                                is 1 if the user isn't booting
                                from the output file, otherwize, it 
                                the first record past the end of
                                the system length.} 
   prom_size:isize_type;       {Length of prom image file in records.}
  BEGIN 
  
    made_prom_file:=false;
    overflow_error:=false;
    file_error:=false;
  
    {Calculate the first directory track.}
    first_dir_track:=num_tracks-1;
  
  
    {Calculate the record number corresponding
     to the beginning of the first directory track.}
  
    first_fde_rec:=first_dir_track*recs_per_track+1;
    last_prom_file_rec:=first_fde_rec-1;
  
  
    {See if the memory is already full due to a system
     image which would overlay with the directory track.
     In this case, no directory entries or cartridge
     initialization entries are made.}
  
    IF (bootable_current_file AND (sys_len>=first_fde_rec)) THEN
       no_directory:=true 
      ELSE no_directory:=false; 
  
    {Calculate the length of the output file.}
  
    prom_file_len:=num_tracks*recs_per_track; 
    {See if there is enough memory in the prom for the system.} 
  
    IF bootable_current_file AND (sys_len>prom_file_len) THEN 
      BEGIN 
  
        {Memory size is determined by the driver parameters 
         at generation time.  This error might possibly be recovered
         from by specifying a different lu number, but it may be
         necessary to generate a new system using different prom
         card driver parameters.} 
  
  
        {Output the NOT ENOUGH MEMORY error.} 
  
        error(not_enough_mem);
        IF NOT interactive AND (error_path<>uncon_end) THEN 
          abort:=true;
  
        overflow_error:=true; 
  
        {Change boot booleans if they were set.  This allows
         recovery from this error by typing NO to the boot prompt.} 
  
        IF bootable_current_file THEN 
          BEGIN 
            boot:=false;
            bootable_current_file:=false; 
          END;
      END 
    ELSE
      BEGIN 
  
        {There is plenty of memory, create the output file.}
  
        prom_size[1]:=prom_file_len;
        prom_size[2]:=0;
  
        {Create the output file.} 
  
        ecrea(prom_dcb,ierr,prom_file,prom_size,1,prom_secu,prom_crn);
        IF ierr<0 THEN
          BEGIN 
            fmp_error(ierr,prom_file);
  
            file_error:=true; 
  
            IF NOT interactive AND (error_path<>uncon_end) THEN 
              abort:=true;
          END 
        ELSE
          BEGIN 
  
            {Fill the  prom_file with -1 so garbage is not burned on
             the prom (between programs bumped, and in the directory
             track.}
  
            IF bootable_current_file THEN start_neg_rec:=sys_len+1
               ELSE start_neg_rec:=1; 
            {First fill the output buffer with -1.} 
            FOR i:=1 TO recd_len DO prom_dcb.buff[i]:=-1; 
            cur_prom_file_rec:=start_neg_rec; 
  
            WHILE (cur_prom_file_rec<=prom_file_len) AND NOT abort DO 
              BEGIN 
                writf(prom_dcb,ierr,prom_dcb.buff,recd_len,cur_prom_file_rec);
  
                 IF ierr<0 THEN 
                   BEGIN
                     fmp_error(ierr,prom_file); 
                     abort:=true; 
                   END; 
                cur_prom_file_rec:=cur_prom_file_rec+1; 
              END;
  
            {Initialize the globals which must be done on 
             each PFORM pass.}
            made_prom_file:=true; 
            make_fill_file:=true; 
            cur_prom_file_rec:=1; 
            cur_file_rec:=0;
  
            {Set cur_fde_num to point past the cartridge entry.}
            cur_fde_num:=2; 
          END;
      END;
  END;{process_prom_file} 
  
{lu_process is a routine which deals with the lu and prom_file
 prompt.} 
  
PROCEDURE lu_process; $direct$
  LABEL 1,99; 
CONST 
  
  {Define the header for this phase.} 
  
  mes1= 
'*     The disk attributes of the current PROM logical unit will be     *'; 
  mes2= 
'*     defined during this next phase of the PROM formatting.           *'; 
  
  {Define the error messages associated with this process.} 
  
  duplicate_lu='DUPLICATE PROM LU'; 
  no_dvt='NO DVT FOR SPECIFIED LU'; 
  bad_interface_type='INTERFACE TYPE FOR LU IS NOT 36B';
  too_many_lus='MORE PROM IMAGE FILES IO SELECT CODES'; 
  bad_driver_param='BAD DRIVER PARAMETER IN DVT'; 
  boot_prompt='Boot system off PROM card (YES,NO) ? ';
  lu_prompt='PROM device logical unit (nn) ? '; 
  file_prompt='PROM image file (namr) ? ';
TYPE
  ift6= 
   PACKED RECORD
     CASE boolean OF
       true:(int:integer);
       false:(av:two_bits;
              interface_type:six_bits;
              xx:two_bits;
              select_code:six_bits) 
      END;
VAR 
  first_pass,            {True on the first pass only of the repeat_cycle 
                          loop.}
  lu_error,              {True when an error occured involving
                          the PROM lu number.}
  prom_file_error,       {True when an error occured involving
                          the creation of the prom file.} 
  overflow_error,        {True when the system image is to be 
                          booted from prom, but the specified lu
                          does not imply enough prom storage.}
  repeat_cycle:boolean;  {True when the three prompts must be 
                          repeated, false otherwise.} 
  
  ift_word_6:ift6;       {Will contain ift word 6.} 
  dvt_addr,              {The DVT address associated with a PROM lu.} 
  i,                     {A loop index.}
  ift_addr:integer;      {The address of the IFT associated with the
                          above DVT.} 
  BEGIN 
  
    {Output the header for this phase.} 
  
    writline(head1);
    writline(head2);
    writline(mes1); 
    writline(mes2); 
    writline(head2);
    {Check to see if the maximum number of files have been made.} 
  
    IF lu_count=max_io_cards THEN 
      BEGIN 
  
        {More PROM files have been made than there are slots in 
         the backplane. Notify the user, and automatically end
         the formatting process.} 
  
        error(too_many_lus);
  
        {This is not a fatal abortive error, but override the specified 
         error option to force an end exit here.} 
  
        abort:=false; 
        pform_ended:=true;
        goto 99;
      END;
  
    {This is the start of the loop which cycles through upon
     errors due to a bad prom lu.  When such errors occur, the
     three prompts given in this routine are repeated to allow
     recovery.} 
  
    repeat_cycle:=true; 
    first_pass:=true; 
    prom_file_error:=true;
    bootable_current_file:=false; 
    lu_error:=true; 
    overflow_error:=false;
    WHILE repeat_cycle AND NOT (abort OR pform_ended) DO
      BEGIN 
  
        {Get the prom image file namr next.  Unfortunately, we can't
         create the file until the lu has been given since the file size
         is implied by the driver paramaters.  This order of prompting
         was chosen because of consistancy with the order of prompts
         for information not in the run string.  The information is 
         already known should it be the first pform pass.}
  
  
        WHILE prom_file_error AND NOT first_pform DO
          BEGIN 
  
            IF terminal_outfile THEN prompt(ofile,file_prompt)
              ELSE write(ofile,file_prompt);
            IF echo_prompt THEN prompt(ifile,file_prompt);
  
            {Get the reply and parse it.} 
  
            line_read;
  
  
            IF abort OR pform_ended THEN goto 99; 
  
            IF namr_buffer.types.param1<>ascii THEN 
              BEGIN 
                error(bad_type);
  
                {prom_file error should still be true.} 
  
                IF NOT interactive THEN 
                  BEGIN 
  
                    {Override the default error condition here
                     to prevent error cascading.} 
  
                    IF error_path<>uncon_abort THEN 
                      abort:=true;
                    goto 99;
                  END;
              END 
            ELSE {Save the name,crn,and security code.} 
              BEGIN 
  
                prom_file:=namr_buffer.param1;
                prom_secu:=namr_buffer.param2.int;
                prom_crn:=namr_buffer.param3.int; 
  
                {If lu_error is false, we know this is
                 not the first pass through the cycle, and
                 we know that the user previously specified 
                 a good prom number.  Hence process the 
                 file in such a case.}
  
                IF NOT lu_error THEN
                  BEGIN 
                    process_prom_file(prom_file_error,overflow_error);
                    IF NOT (prom_file_error OR overflow_error) THEN 
                      goto 99;
                  END 
                ELSE {Make sure the loop is not repeated here.} 
                  prom_file_error:=false; 
              END;
          END;
  
        {If the user has never said YES to the boot system prompt,
         prompt for that information now.}
  
        namr_buffer.types.param1:=null; 
        WHILE (namr_buffer.types.param1<>ascii) AND (first_pass OR
          overflow_error) AND NOT boot DO 
          BEGIN 
  
            {Prompt to find out if they want to boot.}
  
            IF terminal_outfile THEN prompt(ofile,boot_prompt)
              ELSE write(ofile,boot_prompt);
            IF echo_prompt THEN 
              prompt(ifile,boot_prompt);
            line_read;
  
            IF abort OR pform_ended THEN goto 99; 
            IF namr_buffer.types.param1<>ascii THEN 
              BEGIN 
  
                error(bad_type);
                IF NOT interactive AND (abort OR pform_ended) THEN goto 99; 
              END;
            IF namr_buffer.param1.command='YE' THEN 
              BEGIN 
                boot:=true; 
                bootable_current_file:=true;
              END;
          END;
  
       {The prom lu number and the output file namr string
        are processed in the following loop.  These commands
        are processed together because the prom number is 
        very related to output file processing since the size 
        of the output file comes from the driver parameters.} 
  
       {The overflow error may be recoverable by specifying a 
        new lu.  This next line accounts for this possibility.} 
  
       IF overflow_error THEN lu_error:=true; 
       WHILE  lu_error AND NOT (prom_file_error 
             AND NOT first_pform) DO
         BEGIN {%}
  
           {Assume no prom file errors occur so the loop is repeated
            on all lu_errors.}
  
           prom_file_error:=false;
  
           {Prompt for lu number of PROM module.} 
  
           IF terminal_outfile THEN prompt(ofile,lu_prompt) 
             ELSE write(ofile,lu_prompt); 
           IF echo_prompt THEN
             prompt(ifile,lu_prompt); 
  
           {Get the reply and parse it.}
  
           line_read; 
           IF abort OR pform_ended THEN goto 99;
  
           IF namr_buffer.types.param1<>numeric THEN
             BEGIN
               error(bad_type); 
               IF NOT interactive AND (abort OR pform_ended) THEN goto 99 
                 ELSE goto 1; 
             END
           ELSE prom_lu:=namr_buffer.param1.int1; 
           IF ((prom_lu<=0) OR (prom_lu>lut_num)) THEN
             BEGIN
  
               {Output the paramater out of range error.} 
  
               error(bad_range);
               IF NOT interactive AND (abort OR pform_ended) THEN goto 99 
                 ELSE goto 1; 
             END; 
  
           {Check for possible lu errors.}
           {First check for duplicate PROM lu error.} 
  
           i:=1;
           WHILE i<=lu_count DO 
             IF lus[i]=prom_lu THEN 
               BEGIN
                 error(duplicate_lu); 
                 IF NOT interactive AND (abort OR pform_ended)
                   THEN goto 99 
                     ELSE goto 1; 
               END
             ELSE i:=i+1; 
           {Check to see if the LUT has an entry for
            the specified lu.}
           {Get the LUT entry.} 
  
           dvt_addr:=getword(((prom_lu-1)+lut_addr),
                       sys_dcb,sys_dcb.buff,sys_file, 
                       rec_in_sys_dcb); 
           IF (dvt_addr=0) THEN 
             BEGIN
  
               {No DVT for prom_lu.}
  
               error(no_dvt); 
              END 
            ELSE
              BEGIN {%%}
  
                {Get the address of the interface table.} 
  
                ift_addr:=getword(dvt_addr+4,sys_dcb, 
                                  sys_dcb.buff,sys_file,
                                  rec_in_sys_dcb);
  
                {Get the number of tracks on the PROM 
                 from the DVT.} 
  
                num_tracks:=getword(dvt_addr+27,sys_dcb,
                                    sys_dcb.buff,sys_file,
                                    rec_in_sys_dcb);
  
                {Get the number of records per track.}
  
                recs_per_track:=getword(dvt_addr+28,sys_dcb,
                                        sys_dcb.buff,sys_file,
                                        rec_in_sys_dcb);
               {Calculate the number of sectors per 
                track, and the number of words per track.}
  
                sect_per_track:=recs_per_track * 2; 
  
                {Calculate the number of file directory 
                 entries per track.}
  
                fdir_entries_per_track:=(recs_per_track * 
                               recd_len) DIV fdir_length; 
  
                {Get the interface type from the interface
                 table.}
  
                ift_word_6.int:=getword((ift_addr+5), 
                                   sys_dcb,sys_dcb.buff,
                                   sys_file,rec_in_sys_dcb);
  
                IF ift_word_6.interface_type<>ift_type THEN 
                  BEGIN 
  
                    {Not correct interface type.} 
  
                     error(bad_interface_type); 
                  END 
                    {Check for bad driver parameters.}
                    ELSE IF (recs_per_track<=0) OR (recs_per_track>128) 
                         OR (num_tracks<=1) OR (num_tracks>1024) OR 
                         (recs_per_track*num_tracks>maxint) THEN
                      BEGIN 
  
                        {The destination system has screwy
                         driver parameters for a PROM card
                         type interface. Abort the run.}
  
                        error(bad_driver_param);
                      END 
                        ELSE
                          BEGIN 
  
  
                            lu_error:=false;
                            {Process the output file namr.} 
  
                            process_prom_file(prom_file_error,
                                              overflow_error);
                            IF NOT (prom_file_error OR overflow_error)
                              THEN
                              BEGIN 
                                repeat_cycle:=false;
                                lu_count:=lu_count+1; 
                                lus[lu_count]:=prom_lu; 
                              END;
                          END;
              END; {%%} 
         END; {%} 
    1: first_pass:=false; 
  
       {The first_pform boolean is kept mainly to prevent the 
        the above prompt for PROM file namr the first time through
        (originally retrieved from the run string, or a prompt in 
         file_init).  We want the above prompt to be given on 
        prom file errors, so set the boolean false here.} 
  
       first_pform:=false;
      END; {repeat_cycle} 
99: 
  END; {lu_process} 
  
{part4_header outputs the header message before starting phase
 4 of PFORM.} 
PROCEDURE part4_header;$direct$ 
  CONST 
    msg1='*     PROM image file ';
    msg2=' may now be formatted.  Type ?? for help.  *';
  TYPE
    special_string=RECORD 
      CASE boolean OF 
        true: 
          (field1:PACKED ARRAY [1..22] OF char; 
           field2:string6;
           field3:PACKED ARRAY [29..line_length] OF char);
        false:
          (whole_string:input_line);
      END;
  VAR 
    line:special_string;
  BEGIN 
    {Output the instructions for this phase.} 
    writline(head1);
    writline(head2);
    line.field1:=msg1;
    line.field2:=prom_file; 
    line.field3:=msg2;
    writline(line.whole_string);
    writline(head2);
  END; {part4_header} 
  
{dir_init_process initializes the directory track for the 
 current prom image file being constructed.  It does
 not actually modify the prom image file, rather it constructs
 an in memory cartridge directory entry.  This entry is posted
 to disk before processing the next prom image file (or exiting).}
PROCEDURE dir_init_process; $direct$
  LABEL 1,99; 
  CONST 
    cart_ref_num='Cartridge reference number (nnnn) ? ';
    cart_labl='Cartridge label ( ASCII ) ? '; 
    direct_at='K.  DIRECTORY AT TRACK ';
    header1=
'NAME    TYPE      LENGTH    PROM   TRACK  SECTOR   REMAINING'; 
    header2=
'                 (BLOCKS)  NUMBER                   BLOCKS'; 
    lu='LU';
    m_size=',  MEMORY SIZE '; 
    no_direct='K.  NO DIRECTORY.';
    period='. ';
  VAR 
    k_on_prom,            {Size of prom image file in K words.} 
    i:integer;            {A loop index.} 
  BEGIN 
  
    {Determine the prom image file size in K words.}
  
    k_on_prom:=prom_file_len DIV 8; 
  
    {Round up if necessary.}
  
    IF ((sys_len MOD 8)>0) THEN k_on_prom:=k_on_prom+1; 
  
    {If this PROM disk is to have no directory track, skip
     most of the process.}
  
    IF no_directory THEN
      BEGIN 
  
        {Output the header.}
        part4_header; 
  
        {Output the no directory message.}
  
        writeln(ofile,lu,prom_lu:4,m_size,k_on_prom:3,no_direct); 
        IF echo_prompt THEN writeln(ifile,lu,prom_lu:4, 
                        m_size,k_on_prom:3,no_direct);
        cur_prom_file_rec:=sys_len+1; 
        goto 1; 
      END;
  
    {Get the cartridge reference number.} 
  
    namr_buffer.types.param1:=null; 
    WHILE namr_buffer.types.param1<>numeric DO
      BEGIN 
        IF terminal_outfile THEN prompt(ofile,cart_ref_num) 
          ELSE write(ofile,cart_ref_num); 
        IF echo_prompt THEN 
          prompt(ifile,cart_ref_num); 
        line_read;
        IF abort OR pform_ended THEN goto 99; 
  
        IF namr_buffer.types.param1<>numeric THEN 
          BEGIN 
  
            error(bad_type);
            IF NOT interactive THEN  goto 99; 
          END 
        ELSE {Put the crn in its directory entry.}
          cart_dir.cartridge.cartridge_reference_number:= 
                                 namr_buffer.param1.int1; 
      END;
  
      {Get the cartridge label.}
      WHILE namr_buffer.types.param1<>ascii DO
        BEGIN 
  
          {Prompt for cartridge label.} 
  
          IF terminal_outfile THEN prompt(ofile,cart_labl)
            ELSE write(ofile,cart_labl);
          IF echo_prompt THEN 
            prompt(ifile,cart_labl);
          line_read;
  
          IF abort OR pform_ended THEN goto 99; 
  
          IF namr_buffer.types.param1<>ascii THEN 
            BEGIN 
  
              error(bad_type);
              IF NOT interactive AND (abort OR pform_ended) THEN goto 99; 
            END 
          ELSE {Put the label into the cartridge entry.}
          WITH cart_dir.cartridge DO
            BEGIN 
  
              {Note that the high bit (15) of the first word
               must be set so the next two lines can not be interchanged
               (rearranged) do to the variant record structure used.} 
  
              cartridge_label:=namr_buffer.param1.file_name;
              high_bit:=true; 
  
              {Initialize the rest of the entry.} 
  
              first_avail_track:=0; 
              next_avail_sector:=0; 
              sector_skip:=0; 
              cpu_use:=0; 
              sectors_per_track:=sect_per_track;
              low_directory_track:=first_dir_track; 
              neg_number_directory_tracks:=-1;
  
              {The prom will always look full to FMP.}
  
              next_avail_track:=first_dir_track;
  
              {Zero the bad track identifiers.} 
  
              FOR i:=1 TO 6 DO bad_tracks[i]:=0;
  
              {Initialize the current file directory entry counter
               to point past the entry for the cartridge.}
  
              cur_fde_num:=2; 
              {Output the header for the next phase.} 
              part4_header; 
              writeln(ofile,lu,prom_lu:4,m_size,k_on_prom:3,
                 direct_at,first_dir_track:3,period); 
              IF echo_prompt THEN writeln(ifile,lu,prom_lu:4,m_size,
                       k_on_prom:3,direct_at,first_dir_track:3,period); 
  
            END;
          IF bootable_current_file THEN 
            WITH directory.files DO 
              BEGIN 
  
                {Initialize track and sector pointers, and the
                 directory entry.}
  
                cur_track:=0; 
                cur_sector:=0;
                name:=origsystem.file_name; 
                file_type:=1; 
                starting_track:=cur_track;
                starting_sector:=cur_sector;
                file_size_times_2:=sys_len*2; 
                record_length:=recd_len;
  
                {All files default to a positive security code
                 to prevent inadvertand FMP writf calls to PROM.} 
                IF sys_secu=0 THEN
                  security_code:=1010 
                ELSE security_code:=sys_secu; 
              END;
        END;
  
      {Output the rest of the header.}
  1:  writline(header1);
      writline(header2);
  
 99:
    END;.{dir_init_process,&PFS2} 
                  