$pascal '92070-1X289 REV.2001 800514'$
$heap 0$
$segment$ 
PROGRAM PFS1; 
{ 
* 
*NAME:    PFS1
*SOURCE:  92070-18289 
*RELOC:   92070-16289 
*PGMR:    DAVE NEFF 
* 
****************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY, 1979. 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. 
 Then header_printout, def_labls, and file_init are called, 
 and then PFS2 is loaded. PFS1 is never loaded back into
 memory once PFS2 is loaded.} 
 {Read in the global constants, variables and types.} 
$include 'PFGBL'$ 
{init_msg defines the output buffer values for instructions.} 
{init_msg could be largely replaced by using string constants. The time 
 string would still have to be inserted at run time.  String constants
 are not used here currently largely bec
ause the PASCAL compiler has 
 problems (heap stack collisions) when dealing with many string 
 constants.}
  
{time uses a library routine to get the current day and time.} 
PROCEDURE time $ALIAS '@TIME'$ (VAR str:input_line);external; 
  
{Calls to system resources.}
{runst is an interface which retrieves the run string from entry
 points in the PASAL library.}
  
PROCEDURE runst(VAR bufr:input_line;
                VAR tlog:integer);external; 
FUNCTION loglu(VAR ises:integer):integer;external;
FUNCTION iftty(VAR lu:integer):integer;external;
PROCEDURE cnumd(VAR int:integer; VAR BUF:fname);external; 
  
{Non FMP externals contained in the main program are next.} 
PROCEDURE split_namr(VAR iline:input_line; VAR len:integer; 
                     VAR name:fname; VAR security,cartride,start_char,
                     namr_type:integer);external; 
FUNCTION andi(i1,i2:integer):integer;external;
  
PROCEDURE writline(VAR line:input_line);external; 
  
PROCEDURE header_printout;
  VAR 
    i:integer;                 {Used for a counter in moving the time 
                                string into a message string.}
    tline1:input_line;         {The string which is used to 
                                enter the time string into.}
    tline2:input_line;         {The string passed to the @TIME routine.}
  
    msg:ARRAY [1..10] OF input_line; {The messages.}
  
  
  {Begin the initialization.} 
  
  BEGIN 
    msg[1]:=
'************************************************************************'; 
    msg[2]:=
'*                                                                      *'; 
    msg[3]:=
'*                      FORMAT PROM IMAGE                               *'; 
    tline1:=msg[2]; 
    time(tline2); 
    FOR i:=1 TO 26 DO 
      tline1[i+21]:=tline2[i];
    msg[4]:=tline1; 
    msg[5]:=msg[2]; 
    msg[6]:=
'*     PFORM constructs memory image files of PROM modules              *'; 
    msg[7]:=
'*     given the system file, snapshot file, and program                *'; 
    msg[08]:= 
'*     files to be stored on the PROM module.                           *'; 
    msg[09]:= 
'*     Type /A to abort the PFORM at any time.                          *'; 
    msg[10]:=msg[2];
    FOR i:=1 TO 10 DO writline(msg[i]); 
  END; {header_printout}
{rsparse accepts the run string, and returns a namr string and
 the namr type as returned by  split_namr. istrc should point 
 to the first character of the namr string, and will be modified
 so it points to the first character of the next namr string.}
  
PROCEDURE rsparse(VAR rstring,namr:input_line; VAR len,istrc,ntype:integer; 
                  VAR name:fname);
  VAR 
    schar,i,isec,icr:integer; 
  BEGIN 
    i:=0; 
  
    {Loop until end of string or comma is found.} 
  
    WHILE (istrc<=len) AND (rstring[istrc]<>',') DO 
      BEGIN 
        i:=i+1; 
        namr[i]:=rstring[istrc];
        istrc:=istrc+1; 
      END;
  
    schar:=1; 
  
    {Insert a comma for calls to split_namr, and possible 
     future calls to rsparse (certain cases below).}
  
    namr[i+1]:=','; 
    IF (i=0) THEN ntype:=0 ELSE 
  
      {Find out the type of the namr string just copied to namr.} 
  
      split_namr(namr,i,name,isec,icr,schar,ntype); 
  
      {If it was an integer, return its ASCII equivalent in name.}
  
      IF ntype=1 THEN cnumd(isec,name); 
  
    {Point after the comma if one is there.}
  
    IF rstring[istrc]=',' THEN
      istrc:=istrc+1; 
  END;{rsparse} 
  
PROCEDURE file_init;
  VAR 
    {input_line type declarations.} 
    namr:input_line;               {Namr is used to help parse the run
                                    string, so we need the proper type
                                    for split_namr.}
  
    {integer type declarations.}
    i,                             {Loop index.}
    inlu,                          {Default input logical unit number.} 
    ises,                          {Dummy parameter for loglu, indicates
                                    if session is used or not.} 
    outlu,                         {Default output logical unit number.}
    tlog,                          {Length of the run string.}
    tstrc:integer;                 {Temporary starting character
                                    for split_namr.}
  
  BEGIN 
  
    {Get the run string which started PFORM.} 
  
    runst(inline,tlog); 
    istrc:=1; 
  
    {Get the lu number of the scheduling terminal.} 
    log_lu:=loglu(ises);
  
    {Convert to ASCII, needed by reset and rewrite.}
  
    cnumd(log_lu,login_lu); 
    {First two split_namr calls skip past the RU and PFORM string.} 
  
    split_namr(inline,tlog,name,outlu,icrn,istrc,namr_type);
    split_namr(inline,tlog,name,outlu,icrn,istrc,namr_type);
    rsparse(inline,namr,tlog,istrc,namr_type,input_file); 
    namr_type:=andi(3,namr_type); 
  
    interactive:=false; 
  
    {A NAMR type of 0 implies no string was parsed, a type of 
     1 implies the string was an integer, and a type of 3 means 
     the string started in ascii characters.} 
    IF namr_type=0 THEN {No ifile file was specified.}
      BEGIN 
  
        inlu:=log_lu; 
        interactive:=true;
  
        {reset requires an ASCII NAMR string.}
        reset(ifile,login_lu);
        input_file:=login_lu; 
      END 
    ELSE IF namr_type=3 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;
        reset(ifile,namr);
      END 
      ELSE
        BEGIN 
  
          {Assume some valid lu was given in the run string.} 
  
          reset(ifile,input_file);
          tstrc:=1; 
          split_namr(namr,tlog,name,inlu,icrn,tstrc,namr_type); 
          IF iftty(inlu)=-1 THEN interactive:=true; 
        END;
  
    terminal_outfile:=false;
    {Get the second parameter-if there is one.} 
    namr:=' ';
    rsparse(inline,namr,tlog,istrc,namr_type,output_file);
    namr_type:=andi(3,namr_type); 
    {If the namr is an integer, get it for the tt lp case checking.}
    IF namr_type=1 THEN 
      BEGIN 
        tstrc:=1; 
        {This call will return the LU number as an iteger in outlu
         which is used in checking for the TT LP case.} 
  
        split_namr(namr,tlog,name,outlu,icrn,tstrc,namr_type);
        IF (iftty(outlu)=-1) THEN terminal_outfile:=true; 
      END;
    IF namr_type=3 THEN {A text file was specified for output.} 
      BEGIN 
        echo_read:=true;
        rewrite(ofile,namr);
        IF interactive THEN 
          BEGIN 
  
            {When echo_write is true, every line written to the 
             output NAMR is also written to the input namr.}
            echo_write:=true; 
            rewrite(ifile,login_lu);
          END;
      END 
        ELSE IF namr_type=0 THEN
          BEGIN 
  
            {No second namr string was given, so
             Default to the session lu for output.} 
  
            outlu:=log_lu;
            terminal_outfile:=true; 
            rewrite(ofile,login_lu);
            output_file:=login_lu;
          END 
        ELSE IF (namr_type=1) 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_write:=true; 
            echo_read:=true;
            rewrite(ofile,output_file); 
  
            {Everything written to output_file is echoed to 
             input_file.} 
  
            rewrite(ifile,input_file);
          END ELSE rewrite(ofile,output_file);
      END; {file_init}
  
 {PROCEDURE def_labls defines the lables which are to be found
 in the snapshot file.} 
{     num_lb:            Actual number of labels to search for in 
                         the snapshot file. Passed by name since
                         it is used by search_se. 
      labl:              The array of labels which is returned by 
                         this procedure, therefore passed by name.} 
  
PROCEDURE def_labls(VAR num_lb:integer; VAR labl:labl_array); 
  BEGIN 
    num_lb:=5;
    labl[1]:='$CKSM '; {Pointer to system checksum word.} 
    labl[2]:='$IDA  '; {Pointer to address of id segment list.} 
    labl[3]:='$ID#  '; {Address of number of id segments.}
    labl[4]:='$LUT# '; {Address of number of LUT entries.}
    labl[5]:='$LUTA '; {Pointer to address of start of LUT's.}
  END;.{def_labls,PFS1}