$pascal '92071-1X289 REV.2041  800827'$ 
$heap 0$
$segment$ 
PROGRAM PFS1; 
{ 
* 
*NAME:    PFS1
*SOURCE:  92071-18289 
*RELOC:   92071-16289 
*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.        *
****************************************************************
} 
  
{PFS1 is loaded into memory at the start of the main. 
 The only routine it contains externaled in the main is file_init.
 Its other procedures are local to this segment.  This segment
 will only have to be loaded once each run of PFORM.} 
 {Read in the global constants, variables and types.} 
$include '&PFGBL'$
  
{time uses a library routine to get the current day and time.} 
  
PROCEDURE time $ALIAS '@TIME'$ (VAR str:input_line);external; 
FUNCTION rspar(param_number:integer; VAR string:input_line; 
               string_length:integer):integer;external; 
  
  
{Calls to system resources.}
  
FUNCTION loglu(VAR ises:integer):integer;external;
FUNCTION iftty(VAR lu:integer):integer;external;
PROCEDURE cnumd(VAR int:integer; VAR BUF:string6);external; 
PROCEDURE pname(VAR name:string6);external; 
  
{Non FMP externals contained in the main program are next.} 
  
PROCEDURE namr(VAR parse_buffer:namr_parse_buffer; VAR ibuff:input_line;
               length:integer; VAR istrc:integer);external; 
PROCEDURE error(message:input_line);external; 
FUNCTION getword(address:integer; VAR idcb:dcb; VAR ibuff:buffer; 
                 VAR name:string6; VAR curr_rec:integer):integer; 
                                                         external;
PROCEDURE line_read;$direct$ 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; 
  
PROCEDURE writline(line:input_line);external; 
  
{FMP externals are next.} 
  
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 close(VAR idcb:dcb; VAR ierr:integer; itrun: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 elocf(VAR idcb:dcb; VAR ierr:integer; VAR irec,irb:doubint; 
               VAR ioff:integer; VAR jsec:doubint);external;
  
{orig_process insures that the original system file is
 indeed a system, retrieves some constant values from the 
 system image, and coppies this system into a scratch file. 
 The original system is not modified.}
{   orig_error:           True if any error occurs in this
                          procedure.} 
PROCEDURE orig_process(VAR orig_error:boolean);$direct$ 
  LABEL 99; 
  CONST 
    bad_sys_error='NOT A SYSTEM IMAGE'; 
    sys_not_for_snap_error='SYSTEM NOT FOR SNAP'; 
  
    {This constant will always be in word 3 of a system image.} 
    {This word corresponds to a JMP 3,I.} 
    jump3_i=-22525; 
  VAR 
    common_csw,           {Checksum word from the system image.}
    ioff,                 {Placeholder of elocf.} 
    length,               {Record length returned by readf (128).}
    num,                  {Used for generating a file name.  Crets
                           is not used since its files are frequently 
                           purged by PK and crets calls.} 
    sys_csw,              {System id checksum from the system 
                           image.}
    words_in_system:integer;  {Number of words in unmapped system 
                           image.}
    scratch_size:isize_type; {Length of scratch file.}
  
    irec,                    {Next record from elocf.}
    irb,                     {Relative block number from elocf.}
    jsec:doubint;            {Sectors in file from elocf.}
  
  BEGIN 
  
    orig_error:=false;
    {Make sure its a system by checking word 3 of the original
     system file to see if it is a JMP 3,I, and checking to see 
     if it is type 1. rec_in_sys_dcb is zeroed here to
     insure a disk read takes place when orig_process is
     called more than once.}
  
    rec_in_sys_dcb:=0;
  
    {Do not change the order here.  The getword call should not 
     occur if the file type (ierr) is not 1.  PASCAL code 
     generation techniques assure this.}
    IF (ierr<>1) OR (getword(2,file_dcb,file_dcb.buff,origsystem, 
        rec_in_sys_dcb)<>jump3_i) THEN
      BEGIN 
  
        error(bad_sys_error); 
        orig_error:=true; 
      END 
    ELSE
      BEGIN 
  
        {Assume it is a system image.  Get needed values from it.}
  
        {The order here is important, and should minimize needed
         disk accesses.}
  
        sys_csw:=getword(address[2],file_dcb,file_dcb.buff, 
                     origsystem,rec_in_sys_dcb);
        IF mapped_system THEN 
          common_csw:=getword(address[11],file_dcb,file_dcb.buff, 
                     origsystem,rec_in_sys_dcb);
  
        IF (sys_csw<>sys_id_csw) OR (mapped_system AND
           (common_csw<>sys_com_csw)) THEN
          BEGIN 
  
            {System not for snap.  Give error.} 
  
            error(sys_not_for_snap_error);
            orig_error:=true; 
          END 
        ELSE
          BEGIN 
  
            id_num:=getword(address[3],file_dcb,file_dcb.buff,
                         origsystem,rec_in_sys_dcb);
            id_addr:=getword(address[4],file_dcb,file_dcb.buff, 
                         origsystem,rec_in_sys_dcb);
            lut_num:=getword(address[5],file_dcb,file_dcb.buff, 
                         origsystem,rec_in_sys_dcb);
            lut_addr:=getword(address[6],file_dcb,file_dcb.buff,
                         origsystem,rec_in_sys_dcb);
            sec_addr:=address[7]; 
  
            IF mapped_system THEN 
              BEGIN 
  
                mat_num:=getword(address[8],file_dcb,file_dcb.buff, 
                                 origsystem,rec_in_sys_dcb);
                mat_addr:=getword(address[9],file_dcb,file_dcb.buff,
                                 origsystem,rec_in_sys_dcb);
                matv_addr:=address[10]; 
                {The number of defined mats will typically be 
                 zero unless the original system was the output 
                 of BUILD.} 
                matv_num:=getword(matv_addr,file_dcb,file_dcb.buff, 
                                  origsystem,rec_in_sys_dcb); 
                pages_in_system:=getword(address[12],file_dcb,file_dcb.buff,
                                    origsystem,rec_in_sys_dcb); 
                {Determine the number of records in the system image.}
                {There are 8 records per 1K word page.} 
  
                sys_len:=pages_in_system * 8; 
              END 
            ELSE
              BEGIN 
                words_in_system:=getword(0,file_dcb,file_dcb.buff,
                                  origsystem,rec_in_sys_dcb); 
  
               {Generator puts positive word count here, but
                boot loader needs negative count.  This 
                next check is in case the generator is changed, 
                or a modified system file of PFORM is used as 
                an original system file on a subsequent pass.}
                IF words_in_system<0 THEN 
                  words_in_system:=-words_in_system;
  
                {Calculate the number of records required to
                 contain this system image.}
                sys_len:=words_in_system DIV recd_len;
  
                {Account for possible remainder.} 
  
                IF (words_in_system MOD recd_len)<>0 THEN 
                  sys_len:=sys_len+1; 
              END;
  
            {Redefine the address of $BOOT to be a more 
             sensible name than address[1].}
  
            start_addr:=address[1]; 
  
  
            {Create a scratch system file which will be modified.}
            {First get size of input system.} 
  
            elocf(file_dcb,ierr,irec,irb,ioff,jsec);
  
            {Calculate size of file in records.}
  
            irec:=jsec DIV 2; 
  
            scratch_size[1]:=irec;
            scratch_size[2]:=0; 
            made_sys_file:=true;
  
            {Create a system file, and keep trying using a different
             num if an FMP -2 error (duplicate file name).} 
  
            num:=10000;  {cnumd blank fills.} 
            {Assume not enough room error to start loop.} 
            ierr:=-33;
            WHILE ((ierr=-2) OR (ierr=-33)) AND (num<19999) DO
              BEGIN 
  
                {Create a name.}
  
                cnumd(num,sys_file);
  
                sys_file.command:='SY'; 
                ecrea(sys_dcb,ierr,sys_file,scratch_size,1,sys_secu,
                                                               sys_crn);
                IF ierr=-2 THEN num:=num+1; 
  
                {If not enough room on the cartridge, then ierr 
                 is -33. In this case, try agains setting sys_crn 
                 to 0 if it isn't already. This will place the
                 scratch file on the first cartridge in the users 
                 list which has enough space.}
  
                IF (ierr=-33) AND (sys_crn<>0) THEN 
                  sys_crn:=0
                ELSE IF (ierr=-33) AND (sys_crn=0) THEN 
  
                  {Not enough room on any cartridge, don't
                   retry the crets.}
                     num:=20000;
              END;
            IF ierr<0 THEN
              BEGIN 
                fmp_error(ierr,sys_file); 
                made_sys_file:=false; 
  
                {No way to recover from this error. All cartridges
                 are full, or all scratch file names are used up.}
  
                abort:=true;
              END 
              ELSE
  
                {Copy the system image into the scratch file.}
                {Since we checked the size of the system image, 
                 and created the scratch file of the same size, 
                 no fmp errors should occur on writes, but it could 
                 on reads if the system file was truncated.}
  
                FOR irb:=1 TO irec DO 
                  BEGIN 
  
                    {Copy a record from file to file.}
  
                    readf(file_dcb,ierr,file_dcb.buff,recd_len,length,irb); 
                    IF ierr<0 THEN
                      BEGIN 
                        fmp_error(ierr,origsystem); 
                        abort:=true;
                        goto 99;
                      END 
                    ELSE
                      BEGIN 
                        {The PROM boot loader needs a negative word count 
                         of the system length in word 1, but the generator
                         puts a positive word count there. Fix this 
                         problem now unless it was maybe fixed by the 
                         generator, or a previous run of PFORM.}
  
                          IF (irb=1) AND NOT mapped_system AND
                            (file_dcb.buff[1]>0) THEN 
                             file_dcb.buff[1]:=-file_dcb.buff[1]; 
                          writf(sys_dcb,ierr,file_dcb.buff,recd_len,irb); 
                          IF ierr<0 THEN
                            BEGIN 
  
                              fmp_error(ierr,sys_file); 
                              abort:=true;
                              goto 99;
                            END;
                        END;
  
                      {rec_in_sys_dcb must be corrected for the next
                       call to getword or putword.} 
                      rec_in_sys_dcb:=sys_len;
                  END;
             END; 
       END; 
   99:  close(file_dcb,ierr,0); 
  END; {orig_process} 
{read_sys entry gets one system entry from the SNAP file,converts 
     types, and gets the size of the label field for the next entry.} 
{     file_name:            The name of the snapshot file, passed 
                            by name for efficiency. 
      idcb:                 The dcb of the snapshot file, passed by 
                            name for efficiency.
      ibuff:                The buffer associated with the snapshot 
                            dcb, passed by name for efficiency. 
      current_label:        The label found in the snapshot entry 
                            just read, passed by name since it is 
                            returned to search_se.
      curr_address:         The address found in the snapshot entry 
                            just read, passed by name since it is 
                            returned to search_se.} 
  
PROCEDURE read_sys_entry(VAR file_name:string6;VAR idcb:dcb;
                         VAR ibuff:buffer;VAR current_labl:varl_labl; 
                         VAR curr_address:integer); $direct$
  CONST 
    two_spaces=8224;     {Two ascii spaces in one word.}
  VAR 
    i,                         {Loop counter.}
    length,                    {Record length returned by readf.} 
    num_words,                 {Number of words in current record.} 
    record_size:integer;       {Maximum snapshot record size expected.} 
  BEGIN 
  
    {Compute maximum record size expected.} 
  
    record_size:=max_words+3; 
  
    {Get a record.} 
  
    readf(idcb,ierr,ibuff,record_size,length,0);
  
    {Get the length of the label field in words.} 
  
    num_words:=ibuff[1];
    IF ierr<0 THEN fmp_error(ierr,file_name) ELSE 
      BEGIN 
  
        {Get the current label in the snapshot record.} 
  
        FOR i:=1 TO num_words DO
          current_labl.ints[i]:=ibuff[i+1]; 
  
        {Fill rest of buffer with spaces to insure
         correct matching on the compare in search_sys_entry.}
  
        FOR i:=num_words+1 TO max_words DO
          current_labl.ints[i]:=two_spaces; 
  
        {Get the actual record size.} 
  
        record_size:=num_words+3; 
  
        {Get the actual current address the label referrs to.}
  
        curr_address:=ibuff[record_size]; 
      END;
  END;{read_sys_entry}
  
{search_se recieves an array of labels and returns an array of addresses.}
{An address entry of 0 means that the label was not found.} 
{     name:                  The name of the snapshot file, passed by 
                             name for efficiency. 
      idcb:                  The dcb of the shapshot file.
      ibuff:                 The buffer of the dcb associated with the
                             snapshot file. 
      address:               The array of addresses returned by the 
                             routine. 
      labls:                 The array of labels passed to the routine. 
      num_labls:             The number of labels in the label array
                             labls. 
      num_entries:           The actual number of label entries in the
                             snapshot file. 
      found_all:             True when all passed lables were found.} 
  
PROCEDURE search_se(VAR name:string6;VAR idcb:dcb;VAR ibuff:buffer; 
                  VAR address:address_array;VAR labls:labl_array; 
                  num_labls,num_entries:integer; VAR found_all:boolean);
                                                              $direct$
  VAR 
    curr_address,           {The address of the snapshot entry just 
                             read, returned by read_sys_entry.} 
    i,j,                    {Indexes used for counting.}
    num_found:integer;      {A counter which keeps track of the 
                             number of labels found so far.}
    curr_labl:varl_labl;    {The label of the snapshot entry just 
                             read, returned by read_sys_entry.} 
  BEGIN 
  
    {Zero all passed addresses.}
  
    FOR i:=1 TO num_labls DO address[i]:=0; 
    num_found:=0; 
    i:=0; 
  
    {Search the snapshot file until all passed labels have
     been found, or until an FMP error occurs, or until the 
     entire snapshot file has been searched (whichever comes
     first.}
  
    WHILE (i<num_entries) AND (num_found<num_labls) AND NOT abort DO
      BEGIN 
  
        {Get a record, its label, and address field values.}
  
        read_sys_entry(name,idcb,ibuff,curr_labl,curr_address); 
        i:=i+1; 
        {Loop through, comparing the current label with all entries 
         of the label array passed.}
  
        FOR j:=1 TO num_labls DO
          IF labls[j].chars=curr_labl.chars THEN
            BEGIN 
              address[j]:=curr_address; 
              num_found:=num_found+1; 
            END;
      END;
    IF num_found<num_labls THEN found_all:=false
      ELSE found_all:=true; 
  END;{search_se} 
  
 {PROCEDURE def_labls defines the lables which are to be found
 in the snapshot file.} 
{     labl:              The array of labels which is returned by 
                         this procedure, therefore passed by name.} 
  
PROCEDURE def_labls(VAR labl:labl_array); $direct$
  BEGIN 
    labl[1].chars:='$BOOT'; {Contains ID address of startup program.} 
    labl[2].chars:='$CKSM'; {Pointer to system checksum word.}
    labl[3].chars:='$ID# '; {Pointer to number of id segments.} 
    labl[4].chars:='$IDA '; {Pointer to address of start of id segments.} 
    labl[5].chars:='$LUT#'; {Address of number of LUT entries.} 
    labl[6].chars:='$LUTA'; {Pointer to address of start of LUT's.} 
    labl[7].chars:='$XECM'; {Contains system security code.}
    num_unmapped_labels:=7; 
    {The remaining labels only have meaning when the original system
     is mapped.}
    IF mapped_system THEN 
      BEGIN 
        num_mapped_labels:=5; 
        labl[8].chars:='$MAT#'; {Contains number of mat entries}
        labl[9].chars:='$MATA'; {Contains starting address of mats} 
        labl[10].chars:='$MATV'; {Contains number of defined mats.} 
        labl[11].chars:='$SCCK'; {Pointer to system common checksum.} 
        labl[12].chars:='$USER'; {Contains number of pages in system image} 
      END;
  
  END;{def_labls} 
  
  {snap_process retrieves needed labels from the snap file.}
  {   snap_error:           True if any error occurs in this
                            procedure.} 
  PROCEDURE snap_process(VAR snap_error:boolean); $direct$
    LABEL 99; 
    CONST 
      ilen=20;                {Maximum length of snapshot header (L-20).} 
      ill_snap_error='ILLEGAL SNAPSHOT';
  
    VAR 
      all_found:boolean;      {True when all labels from snap found.} 
  
      snapbuff:buffer;        {Packing buffer for read.}
  
      labls:labl_array;       {Will store symbols which must be 
                               retrieved from the snap file.} 
      checksum,               {Header of snapshot's checksum.}
      file_type,              {Type of snapshot file.}
      i,                      {A loop counter.} 
      length,                 {Returned by readf calls.}
      num,                    {Number supplied to crets.} 
      num_sys_entries         {Total number of labels in shapshot.} 
      :integer; 
    BEGIN 
  
      file_type:=ierr;
      snap_error:=false;
  
      IF file_type=0 THEN 
        BEGIN 
  
          {Don't hang a read to get the header.}
  
          error(ill_snap_error);
          snap_error:=true; 
          goto 99;
        END;
  
      {Get the snapshot header.}
  
      readf(snap_dcb,ierr,snapbuff,ilen,length,1);
  
      IF ierr<0 THEN
        fmp_error(ierr,snap_file) 
      ELSE
        BEGIN 
  
          {A snap header for an unmapped system has 12 words, but 
           for a mapped system it has 20.  Hence right now I can
           tell if the system was mapped or not.} 
  
          IF ilen=length THEN mapped_system:=true 
            ELSE mapped_system:=false;
  
          {Define the needed labels.} 
  
          def_labls(labls); 
  
          {Get needed values from snap, validate checksum.} 
  
          num_sys_entries:=snapbuff[1]; 
  
          {The snapshot header format varies between mapped and 
           unmapped systems.  Also varying is the sort of information 
           I care about in each case.  The next IF structure
           reflects these concerns.}
  
          IF mapped_system THEN 
            BEGIN 
              sys_id_csw:=snapbuff[9];
              sys_com_csw:=snapbuff[10];
              sys_common_sz:=(snapbuff[6]-snapbuff[4]) DIV page_size; 
            END 
          ELSE {We have an unmapped system.}
            BEGIN 
  
              sys_id_csw:=snapbuff[11]; 
              fwbg:=snapbuff[4];
              bgbp:=snapbuff[7];
            END;
  
          {Validate the checksum.}
          checksum:=0;
          FOR i:=1 TO (length-1) DO checksum:=checksum+snapbuff[i]; 
  
          {Check for checksum error.} 
  
          IF (checksum<>snapbuff[length]) OR (file_type<>3) THEN
            BEGIN 
  
              {Bad header or wrong file type.}
              snap_error:=true; 
              error(ill_snap_error);
            END 
          ELSE
            BEGIN 
  
              {Get addresses of lables needed from snap.} 
  
              IF mapped_system THEN 
                num_labls:=num_mapped_labels+num_unmapped_labels
              ELSE num_labls:=num_unmapped_labels;
  
              search_se(snap_file,snap_dcb,snapbuff,address,labls,
                              num_labls,num_sys_entries,all_found); 
  
              IF NOT all_found THEN 
                BEGIN 
                  error(ill_snap_error);
                  snap_error:=true; 
                END;
              END;
        END;
    99: 
    END; {snap_process} 
  
{This procedure outputs the header at the start of each 
 run of PFORM.} 
PROCEDURE header_printout; $direct$ 
  CONST 
    msg3= 
'*                     FORMAT PROM IMAGE                                *'; 
    msg6f1='*     ';
    msg6f3= 
'constructs memory image files of PROM modules              *'; 
    msg7= 
'*     given the snapshot file, the system file, and program            *'; 
    msg8= 
'*     files to be stored on the PROM module.  Type /A to abort         *'; 
    msg9= 
'*     the formatting at any time, and /E to end.                       *'; 
  TYPE
  
    {special string is a record used to get around the TYPING of PASCAL.} 
  
    special_string= 
      RECORD
        CASE boolean OF 
        true: 
            (field1:PACKED ARRAY [1..6] OF char;
             field2:fname;
             field3:PACKED ARRAY [13..72] OF char); 
        false:
            (whole_string:input_line) 
        END;
  VAR 
    i:integer;                 {Used for a counter in moving the time 
                                string into a message string.}
    msg4,                      {The string which is used to 
                                enter the time string into.}
    tline:special_string;     {The string passed to the @TIME routine.} 
  
  
  BEGIN 
  
  
    msg4.whole_string:=head2;  {Initialize message four.} 
    {Get the date and time.}
  
    time(tline.whole_string); 
  
    {Insert the time string into the proper field.} 
  
    FOR i:=1 TO 26 DO 
      msg4.whole_string[i+21]:=tline.whole_string[i]; 
  
    {Make tline contain a string using the actual program name.}
  
    tline.field1:=msg6f1; 
    tline.field2:=pform_prompt.file_name; 
  
    {Replace : with a space.} 
  
    tline.field2[6]:=space1;
    tline.field3:=msg6f3; 
  
    {Output the header.}
  
    writline(head1);
    writline(head2);
    writline(msg3); 
    writline(msg4.whole_string);
    writline(head2);
    writline(tline.whole_string); 
    writline(msg7); 
    writline(msg8); 
    writline(msg9); 
    writline(head2);
  END; {header_printout}
  
{file_init handles all run string specifiable paramaters. 
 It opens input and list files, and prompts for any needed
 information which was not given in the run string. 
 This procedure calls routines local to this segment to 
 process various of the files once they have been opened.}
PROCEDURE file_init; $direct$ 
  LABEL 99; 
  CONST 
    prom_prompt='PROM image file (namr) ? ';
    snp_prompt='Snapshot file (namr) ? '; 
    sys_prompt='Original system file (namr) ? ';
    bad_run_param='BAD PARAMATER TYPE IN RUN STRING'; 
  VAR 
  
    first_pass,                   {True on the first pass of the prompt 
                                   loops, false on subsequent passes.}
    orig_error,                   {True when orig_process returns 
                                   an error, false otherwise.}
    snap_error:boolean;           {True when snap_process returns 
                                   an error, false otherwise.}
  
    sub_namr:input_line;          {Sub-namr denoting output and input files.} 
  
    {integer type declarations.}
  
    i,                             {Loop index.}
    inlu,                          {Default input logical unit number.} 
    ises,                          {Dummy paramater for loglu, indicates
                                    if session is used or not.} 
    outlu,                         {Default output logical unit number.}
    snap_crn,                      {Snapshot file cartridge.} 
    snap_secu:integer;             {Snapshot security code.}
  
  BEGIN 
    {Get the RP'd program name for later use.}
  
    pname(pform_prompt);
    pform_prompt.words_two_three[6]:=':'; 
  
    {Set up the default error path until the run string paramaters
     have been successfully processed.} 
  
    error_path:=uncon_abort;
  
    {Get the lu number of the scheduling terminal.} 
  
    log_lu:=loglu(ises);
  
    {It is the first pass of PFORM.}
  
    first_pform:=true;
  
    {Convert to ASCII, needed by reset and rewrite in some cases.}
  
    cnumd(log_lu,login_lu); 
  
    {Call rspar to pick up the input file namr. This is a PASCAL
     library routine documented in the user manual.}
  
    IF rspar(1,sub_namr,line_length)=0 THEN 
      BEGIN 
  
        {No input file was given.  Default to the terminal lu.} 
        inlu:=log_lu; 
        interactive:=true;
  
        input_file:=login_lu; 
        reset(ifile,login_lu.file_name);
      END 
    ELSE
      BEGIN 
  
        {The user did give some file. Parse the paramater.} 
  
        istrc:=1; 
  
        namr(namr_buffer,sub_namr,line_length,istrc); 
  
        WITH namr_buffer DO 
          BEGIN 
  
            IF types.param1=numeric THEN
              {Get an ASCII representation of the passed lu.} 
              BEGIN 
  
                inlu:=param1.int1;
                cnumd(inlu,input_file); 
                reset(ifile,sub_namr);
                IF iftty(inlu)=-1 THEN interactive:=true; 
              END 
  
            ELSE IF types.param1=ascii THEN 
              BEGIN 
  
                {A transfer file was given as the ifile.} 
                {When echo_read is true, every line read from 
                 the input file or LU is echoed to the output NAMR.}
  
                echo_read:=true;
                input_file:=param1; 
                reset(ifile,sub_namr);
              END;
          END; {WITH} 
      END;
  
    {Get the next sub-namr for possible use by rewrite.}
  
    IF rspar(2,sub_namr,line_length)=0 THEN 
      BEGIN 
  
        {No list file namr was given.  Default to the 
         log lu.} 
  
        outlu:=log_lu;
        terminal_outfile:=true; 
        output_file:=login_lu;
        rewrite(ofile,output_file.file_name); 
      END 
    ELSE
      BEGIN {Opening list file.}
  
        {Parse the namr.} 
  
        istrc:=1; 
        namr(namr_buffer,sub_namr,line_length,istrc); 
        WITH namr_buffer DO 
          BEGIN 
  
            IF types.param1=numeric THEN
              BEGIN 
  
                {Convert the number to ascii for rewrite.}
  
                outlu:=param1.int1; 
                cnumd(outlu,output_file); 
                IF iftty(outlu)=-1 THEN terminal_outfile:=true; 
              END;
            IF types.param1=ascii THEN
              BEGIN 
  
                echo_read:=true;
                output_file:=param1;
                rewrite(ofile,sub_namr);
  
                IF interactive THEN 
                  BEGIN 
  
                    {When echo_prompt is true, every line written to the
                     output NAMR is also written to the input namr
                     from this point on.} 
  
                    echo_prompt:=true;
                    rewrite(ifile,login_lu.file_name);
                  END;
              END 
            ELSE IF (types.param1=numeric) AND (inlu<>outlu)
               AND interactive AND (NOT terminal_outfile) THEN
              BEGIN {Assume it is a tt ifile, lp ofile case.} 
                    {Obviously, this assumption may be incorrect, but 
                     it will only cause echoing to the output device
                     which shouldn't cause problems.} 
  
                echo_prompt:=true;
                echo_read:=true;
                rewrite(ofile,output_file.file_name); 
  
                {Everything written to output_file is echoed to 
                 input_file.} 
  
                rewrite(ifile,input_file.file_name);
              END ELSE rewrite(ofile,sub_namr); 
  
            {Echo the entire run string to any list file.}
  
            IF NOT terminal_outfile THEN
              BEGIN 
                i:=rspar(-1,sub_namr,line_length);
                writeln(ofile,sub_namr);
                writeln(ofile); 
              END;
          END; {WITH statement.}
      END;  {Opening list file.}
  
  
    {Printout the header message.}
    header_printout;
  
    {Get the PFORM output file namr.} 
  
    IF rspar(3,sub_namr,line_length)<>0 THEN
      BEGIN 
        {The user gave some paramater. Parse it.} 
  
         istrc:=1;
         namr(namr_buffer,sub_namr,line_length,istrc);
  
        IF namr_buffer.types.param1=ascii THEN
          BEGIN 
  
            {Asign the parse buffer values to global values for 
             use by fmp calls in the future (not just the creat).}
  
            prom_file:=namr_buffer.param1;
            prom_secu:=namr_buffer.param2.int;
            prom_crn:=namr_buffer.param3.int; 
          END 
        ELSE
          BEGIN 
            error(bad_run_param); 
            IF NOT interactive THEN goto 99;
          END;
      END ELSE namr_buffer.types.param1:=null;
  
    {Check to see if all went well, if not, try to recover.}
  
    first_pass:=true; 
    WHILE (namr_buffer.types.param1<>ascii) DO
      BEGIN 
  
        {Output any appropriate error messages here.} 
  
  
        IF NOT first_pass THEN
          BEGIN 
  
            {Output bad paramater error.} 
  
            error(bad_type);
            IF NOT interactive THEN goto 99;
          END;
  
        {Prompt for and process output file namr.}
        IF terminal_outfile THEN prompt(ofile,prom_prompt)
          ELSE write(ofile,prom_prompt);
        IF echo_prompt THEN prompt(ifile,sys_prompt); 
        line_read;
        IF abort OR pform_ended THEN goto 99; 
  
        IF namr_buffer.types.param1=ascii THEN
          BEGIN 
            {Define some globals as above.} 
  
            prom_file:=namr_buffer.param1;
            prom_secu:=namr_buffer.param2.int;
            prom_crn:=namr_buffer.param3.int; 
          END;
        first_pass:=false;
      END;
  
    {Try to get info about the snap file namr.} 
  
    ierr:=0;
    IF rspar(4,sub_namr,line_length)<>0 THEN
      BEGIN 
        istrc:=1; 
        namr(namr_buffer,sub_namr,line_length,istrc); 
  
        {Try to open the snap file.}
  
        IF (namr_buffer.types.param1=ascii) THEN
          BEGIN 
  
            {Open with shared access.}
            snap_file:=namr_buffer.param1;
            snap_secu:=namr_buffer.param2.int;
            snap_crn:=namr_buffer.param3.int; 
            open(snap_dcb,ierr,snap_file,1,snap_secu,snap_crn); 
  
            {Process the snap file here if no errors.}
  
            IF ierr>=0 THEN 
              BEGIN 
                snap_process(snap_error); 
                IF snap_error AND NOT interactive THEN goto 99; 
              END;
          END 
        ELSE
          BEGIN 
            error(bad_run_param); 
            IF NOT interactive THEN goto 99;
          END;
      END ELSE namr_buffer.types.param1:=null;
  
    {Try to recover from any errors here.}
  
    first_pass:=true; 
    WHILE (namr_buffer.types.param1<>ascii) OR (ierr<0) OR snap_error DO
      BEGIN 
  
        {Output appropriate error messages.}
  
        IF ierr<0 THEN
          BEGIN 
            fmp_error(ierr,snap_file);
            IF NOT interactive THEN goto 99;
          END;
  
        IF (namr_buffer.types.param1<>ascii) AND NOT first_pass THEN
          BEGIN 
            error(bad_type);
            ierr:=0;
            IF NOT interactive THEN goto 99;
          END;
  
        {Prompt for a snap file namr.}
  
        IF terminal_outfile THEN prompt(ofile,snp_prompt) 
          ELSE write(ofile,snp_prompt); 
        IF echo_prompt THEN prompt(ifile,snp_prompt); 
        line_read;
        IF abort OR pform_ended THEN goto 99; 
  
  
        {Open it if possible.}
  
        IF (namr_buffer.types.param1=ascii) THEN
          BEGIN 
  
            snap_file:=namr_buffer.param1;
            snap_secu:=namr_buffer.param2.int;
            snap_crn:=namr_buffer.param3.int; 
            open(snap_dcb,ierr,snap_file,1,snap_secu,snap_crn); 
  
            {IF good open, get needed lables from snap.}
  
            IF ierr>=0 THEN 
              BEGIN 
                snap_process(snap_error); 
                IF snap_error AND NOT interactive THEN goto 99; 
              END;
          END ELSE ierr:=0; 
        first_pass:=false;
      END;
  
     {Try to get original system file information from the run string.} 
  
     ierr:=0; 
     IF rspar(5,sub_namr,line_length)<>0 THEN 
       BEGIN
  
         {A fifth param was given.  Parse it.}
  
         istrc:=1;
         namr(namr_buffer,sub_namr,line_length,istrc);
  
         {If a file namr was given, try to open it.}
  
         IF (namr_buffer.types.param1=ascii) THEN 
           BEGIN
  
             {Open original type, shared access.} 
  
             origsystem:=namr_buffer.param1;
             open(file_dcb,ierr,origsystem,1,namr_buffer.param2.int,
                                             namr_buffer.param3.int); 
  
             {ierr will return the type of the file upon proper 
              opening.  This should be type 1 since that is what
              the generator creates.  Orig_process does further 
              checking to insure the file is in fact a system.} 
  
             IF ierr>=0 THEN
               BEGIN
                 orig_process(orig_error);
                 IF orig_error AND NOT interactive THEN goto 99;
               END; 
           END
         ELSE 
           BEGIN
             error(bad_run_param);
             IF NOT interactive THEN goto 99; 
           END; 
       END ELSE namr_buffer.types.param1:=null; 
  
     {Try to recover if all did not go well.} 
  
     first_pass:=true;
     WHILE (namr_buffer.types.param1<>ascii) OR (ierr<0) OR orig_error DO 
       BEGIN
  
         {Output any appropriate error messages.} 
  
         IF ierr<0 THEN 
           BEGIN
             fmp_error(ierr,origsystem);
             IF NOT interactive THEN goto 99; 
           END; 
  
         IF (namr_buffer.types.param1<>ascii) AND NOT first_pass THEN 
           BEGIN
             error(bad_type); 
             ierr:=0; 
             IF NOT interactive THEN goto 99; 
           END; 
         {Prompt for, get, open, and if possible, process 
          the system file namr.}
  
         IF terminal_outfile THEN prompt(ofile,sys_prompt)
           ELSE write(ofile,sys_prompt);
         IF echo_prompt THEN prompt(ifile,sys_prompt);
         line_read; 
         IF abort OR pform_ended THEN goto 99;
  
         IF (namr_buffer.types.param1=ascii) THEN 
             BEGIN
  
               {Try to open original system file.}
               origsystem:=namr_buffer.param1;
  
               open(file_dcb,ierr,origsystem,1,namr_buffer.param2.int,
                                               namr_buffer.param3.int); 
  
               IF ierr>=0 THEN
                 BEGIN
                   orig_process(orig_error);
                   IF orig_error AND NOT interactive THEN goto 99;
                 END
             END ELSE ierr:=0;
           first_pass:=false; 
       END; 
  
    {Get the error exit path option in case of command file 
     input.  This is done first so the option applies to
     all errors.} 
  
    IF rspar(6,sub_namr,line_length)=0 THEN error_path:=uncon_abort 
    ELSE
      BEGIN 
  
        {Parse the sub namr, and set the error_path global accordingly.}
  
        istrc:=1; 
        namr(namr_buffer,sub_namr,line_length,istrc); 
  
         WITH namr_buffer.param1 DO 
           IF command='EN' THEN error_path:=uncon_end 
             ELSE if command='CO' THEN error_path:=uncon_continue 
               ELSE error_path:=uncon_abort;
       END; 
  
    {At this point, the original system file has been 
     been completely processed.  This file is close, the snap and 
     pform image file are open, and the pform image file (sys_file) 
     contains a copy of the original system.} 
99: 
  END;.{file_init,&PFS1}