$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_nummax_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_sizenumeric) 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_size0) 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}