glm94/pdp7-unix
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

I've written more of mkfs7 but not tested it yet.

Browse Source
This commit is contained in:
Warren Toomey
2016-03-10 12:46:00 +10:00
parent 7fd9aee9c7
commit d1b995e771
1 changed files with 351 additions and 218 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tools/mkfs7
+256 -123
View File
@@ -7,6 +7,9 @@
use strict; use strict;
use warnings; use warnings;
use Data::Dumper; use Data::Dumper;
use Getopt::Long qw(GetOptions);
Getopt::Long::Configure qw(gnu_getopt);
# Constants # Constants
use constant NUMBLOCKS => 8000; # Number of blocks on a surface use constant NUMBLOCKS => 8000; # Number of blocks on a surface
@@ -14,9 +17,9 @@ use constant WORDSPERBLK => 64; # 64 words per block
use constant NUMINODEBLKS => 710; # Blocks 1 to 710 for i-nodes use constant NUMINODEBLKS => 710; # Blocks 1 to 710 for i-nodes
use constant FIRSTINODEBLK => 1; # First i-node block number use constant FIRSTINODEBLK => 1; # First i-node block number
use constant INODESIZE => 12; # Size of an i-node use constant INODESIZE => 12; # Size of an i-node
use constant INODESPERBLK => WORDSPERBLK/INODESIZE; use constant INODESPERBLK => WORDSPERBLK / INODESIZE;
use constant DIRENTSIZE => 8; # Size of an directory entry use constant DIRENTSIZE => 8; # Size of an directory entry
use constant DIRENTSPERBLK => WORDSPERBLK/DIRENTSIZE; use constant DIRENTSPERBLK => WORDSPERBLK / DIRENTSIZE;
use constant ROOT_UID => -1; # Native root user-id use constant ROOT_UID => -1; # Native root user-id
use constant MAXINT => 0777777; # Biggest unsigned integer use constant MAXINT => 0777777; # Biggest unsigned integer
@@ -38,6 +41,7 @@ use constant I_USED => 0400000;
use constant I_LARGE => 0200000; use constant I_LARGE => 0200000;
use constant I_SPECIAL => 0000040; use constant I_SPECIAL => 0000040;
use constant I_DIRECTORY => 0000020; use constant I_DIRECTORY => 0000020;
use constant I_FILE => 0000000;
use constant I_OWNERREAD => 0000010; use constant I_OWNERREAD => 0000010;
use constant I_OWNERWRITE => 0000004; use constant I_OWNERWRITE => 0000004;
use constant I_WORLDREAD => 0000010; use constant I_WORLDREAD => 0000010;
@@ -49,12 +53,11 @@ use constant D_NAME => 1;
use constant D_UNIQ => 5; use constant D_UNIQ => 5;
use constant D_NUMWORDS => 8; # Eight words in a direntry use constant D_NUMWORDS => 8; # Eight words in a direntry
# Globals # Globals
my $debug=0; my $debug = 0;
my @Block; # Array of blocks and words in each block my @Block; # Array of blocks and words in each block
my $nextblknum= NUMINODEBLKS+1; # Next free block number my $nextblknum = NUMINODEBLKS + 1; # Next free block number
my $nextinum= 1; # i-num 0 is never used my $nextinum = 1; # i-num 0 is never used
my @Dirstack; # Stack of directories. Each value is a ref my @Dirstack; # Stack of directories. Each value is a ref
# to a [ blocknum, offset, inum ] array which # to a [ blocknum, offset, inum ] array which
# is the next free position in the directory # is the next free position in the directory
@@ -63,72 +66,74 @@ my @Dirstack; # Stack of directories. Each value is a ref
sub dprint { sub dprint {
print(@_) if ($debug); print(@_) if ($debug);
} }
sub dprintf { sub dprintf {
printf(@_) if ($debug); printf(@_) if ($debug);
} }
# Given a size in words, allocate and return a set of block numbers # Given a size in words, allocate and return a set of block numbers
# for the entity # for the entity
sub allocate_blocks { sub allocate_blocks {
my $numwords= shift; my $numwords = shift;
my @blklist; my @blklist;
my $numblocks= int( ($numwords+WORDSPERBLK-1) / WORDSPERBLK ); my $numblocks = int( ( $numwords + WORDSPERBLK - 1 ) / WORDSPERBLK );
die("Not enough blocks\n") if (($nextblknum+$numblocks) >= NUMBLOCKS); die("Not enough blocks\n") if ( ( $nextblknum + $numblocks ) >= NUMBLOCKS );
foreach my $b (1 .. $numblocks) { foreach my $b ( 1 .. $numblocks ) {
push(@blklist, $nextblknum++); push( @blklist, $nextblknum++ );
} }
dprint("Allocated blocks for size $numwords: $blklist[0] .. $blklist[-1]\n"); dprint(
return(@blklist); "Allocated blocks for size $numwords: $blklist[0] .. $blklist[-1]\n");
return (@blklist);
} }
# Allocate and return either the specified i-node or the next # Allocate and return either the specified i-node or the next
# available one if there is no argument # available one if there is no argument
sub allocate_inode { sub allocate_inode {
my $inum= shift; my $inum = shift;
return($nextinum++) if (!defined($inum)); return ( $nextinum++ ) if ( !defined($inum) );
die("i-num $inum already allocated\n") if ($inum< $nextinum); die("i-num $inum already allocated\n") if ( $inum < $nextinum );
$nextinum= $inum+1; $nextinum = $inum + 1;
return($inum); return ($inum);
} }
# Given a list of block numbers, allocate a set of indirect blocks # Given a list of block numbers, allocate a set of indirect blocks
# and install block pointers into the indirect blocks. Return the # and install block pointers into the indirect blocks. Return the
# list of indirect block numbers. # list of indirect block numbers.
sub build_indirect_blocks { sub build_indirect_blocks {
my @blklist= @_; my @blklist = @_;
my $blkcount= @blklist; my $blkcount = @blklist;
# Divide the number of data blocks by WORDSPERBLK and round up, so # Divide the number of data blocks by WORDSPERBLK and round up, so
# we know how many indirect blocks to allocate. # we know how many indirect blocks to allocate.
my $indcount= int(($blkcount+WORDSPERBLK-1)/WORDSPERBLK); my $indcount = int( ( $blkcount + WORDSPERBLK - 1 ) / WORDSPERBLK );
# Get enough indirect blocks # Get enough indirect blocks
my @indlist= allocate_blocks($indcount); my @indlist = allocate_blocks($indcount);
# Now fill in the pointers # Now fill in the pointers
my $indblock= $indlist[0]; my $indblock = $indlist[0];
my $offset= 0; my $offset = 0;
foreach my $datablock (@blklist) { foreach my $datablock (@blklist) {
$Block[$indblock][$offset++]= $datablock; $Block[$indblock][ $offset++ ] = $datablock;
if ($offset == WORDSPERBLK) { if ( $offset == WORDSPERBLK ) {
$offset=0; $indblock++; $offset = 0;
$indblock++;
} }
} }
# Return the indirect block numbers # Return the indirect block numbers
dprint("Built indirect blocks $indlist[0] .. $indlist[-1]\n"); dprint("Built indirect blocks $indlist[0] .. $indlist[-1]\n");
return(@indlist); return (@indlist);
} }
# Return blocknumber and offset for a specific i-node # Return blocknumber and offset for a specific i-node
sub get_inode_block_offset { sub get_inode_block_offset {
my $inum= shift; my $inum = shift;
my $blocknum= FIRSTINODEBLK + int($inum/INODESPERBLK); my $blocknum = FIRSTINODEBLK + int( $inum / INODESPERBLK );
my $offset= INODESIZE * ($inum%INODESPERBLK); my $offset = INODESIZE * ( $inum % INODESPERBLK );
dprint("inum $inum => block $blocknum offset $offset\n"); dprint("inum $inum => block $blocknum offset $offset\n");
return($blocknum, $offset); return ( $blocknum, $offset );
} }
# Given an i-node number (possibly undef), permission, filetype, uid, size # Given an i-node number (possibly undef), permission, filetype, uid, size
@@ -136,33 +141,34 @@ sub get_inode_block_offset {
# with the data. If the i-node number is undef, allocate an i-node number. # with the data. If the i-node number is undef, allocate an i-node number.
# Return the i-node number used. # Return the i-node number used.
sub fill_inode { sub fill_inode {
my ($inum, $perms, $filetype, $uid, $size, @blklist)= @_; my ( $inum, $perms, $filetype, $uid, $size, @blklist ) = @_;
die("Too many blocks\n") if (@blklist>7); die("Too many blocks\n") if ( @blklist > 7 );
# Deal with the root user-id # Deal with the root user-id
$uid= MAXINT if ($uid==ROOT_UID); $uid = MAXINT if ( $uid == ROOT_UID );
# Calculate the block number and word offset for this # Calculate the block number and word offset for this
$inum= allocate_inode() if (!defined($inum)); $inum = allocate_inode() if ( !defined($inum) );
my ($blocknum, $offset)= get_inode_block_offset($inum); my ( $blocknum, $offset ) = get_inode_block_offset($inum);
# Fill in the easy fields # Fill in the easy fields
$Block[$blocknum][$offset+I_UID]= $uid; $Block[$blocknum][ $offset + I_UID ] = $uid;
$Block[$blocknum][$offset+I_SIZE]= $size; $Block[$blocknum][ $offset + I_SIZE ] = $size;
$Block[$blocknum][$offset+I_NLKS]= 1; $Block[$blocknum][ $offset + I_NLKS ] = 1;
my $i= $offset; my $i = $offset;
foreach my $datablocknum (@blklist) { foreach my $datablocknum (@blklist) {
$Block[$blocknum][$i+I_DISKPS]= $datablocknum; $Block[$blocknum][ $i + I_DISKPS ] = $datablocknum;
} }
# Deal with the flags and see if it's a large file # Deal with the flags and see if it's a large file
my $flags = $perms | $filetype | I_USED; my $flags = $perms | $filetype | I_USED;
$flags |= I_LARGE if ($size> WORDSPERBLK * I_NUMBLKS); $flags |= I_LARGE if ( $size > WORDSPERBLK * I_NUMBLKS );
$Block[$blocknum][$offset+I_FLAGS]= $flags; $Block[$blocknum][ $offset + I_FLAGS ] = $flags;
dprintf("fill inum %d: flags %06o uid %06o size %d\n", $inum, $flags, $uid, $size); dprintf( "fill inum %d: flags %06o uid %06o size %d\n",
return($inum); $inum, $flags, $uid, $size );
return ($inum);
} }
# Convert an ASCII string into an array of 18-bit word values # Convert an ASCII string into an array of 18-bit word values
@@ -183,13 +189,13 @@ sub ascii2words {
# Add an extra block to an i-node. NOTE: for now, we don't change the size # Add an extra block to an i-node. NOTE: for now, we don't change the size
# in the i-node. # in the i-node.
sub add_block_to_inode { sub add_block_to_inode {
my ($blknum, $inum) = @_; my ( $blknum, $inum ) = @_;
my ($iblock, $offset)= get_inode_block_offset($inum); my ( $iblock, $offset ) = get_inode_block_offset($inum);
foreach my $i (1 .. I_NUMBLKS) { foreach my $i ( 1 .. I_NUMBLKS ) {
next if ($Block[$iblock][$offset+$i]!=0); # Skip in-use blocks next if ( $Block[$iblock][ $offset + $i ] ); # Skip in-use blocks
$Block[$iblock][$offset+$i]= $blknum; $Block[$iblock][ $offset + $i ] = $blknum;
return; return;
} }
die("Unable to add extra block to i-node $inum\n"); die("Unable to add extra block to i-node $inum\n");
@@ -199,41 +205,41 @@ sub add_block_to_inode {
# Add a name and an i-node number to the current directory in the # Add a name and an i-node number to the current directory in the
# directory stack. # directory stack.
sub add_direntry { sub add_direntry {
my ($name, $inum)= @_; my ( $name, $inum ) = @_;
dprint("Adding $name inode $inum to current directory\n"); dprint("Adding $name inode $inum to current directory\n");
# Get the block and offset to the next empty slot in the directory # Get the block and offset to the next empty slot in the directory
my $dirref= $Dirstack[-1]; my $dirref = $Dirstack[-1];
if (!defined($dirref)) { if ( !defined($dirref) ) {
print("Empty dirstack, we must be building the root dir\n"); dprint("Empty dirstack, we must be building the root dir\n");
return; return;
} }
my $blocknum= $dirref->[0]; my $blocknum = $dirref->[0];
my $offset= $dirref->[1]; my $offset = $dirref->[1];
# Convert the name into four words # Convert the name into four words
my @wlist= ascii2words($name); my @wlist = ascii2words($name);
# Fill in the directory entry # Fill in the directory entry
$Block[$blocknum][$offset+D_INUM]= $inum; $Block[$blocknum][ $offset + D_INUM ] = $inum;
$Block[$blocknum][$offset+D_NAME]= pop(@wlist); $Block[$blocknum][ $offset + D_NAME ] = pop(@wlist);
$Block[$blocknum][$offset+D_NAME+1]= pop(@wlist); $Block[$blocknum][ $offset + D_NAME + 1 ] = pop(@wlist);
$Block[$blocknum][$offset+D_NAME+2]= pop(@wlist); $Block[$blocknum][ $offset + D_NAME + 2 ] = pop(@wlist);
$Block[$blocknum][$offset+D_NAME+3]= pop(@wlist); $Block[$blocknum][ $offset + D_NAME + 3 ] = pop(@wlist);
# Move up to the next position in the directory. # Move up to the next position in the directory.
$dirref->[1] += D_NUMWORDS; $dirref->[1] += D_NUMWORDS;
# If we have filled the directory up, allocate another block to it # If we have filled the directory up, allocate another block to it
if ($dirref->[1] == WORDSPERBLK) { if ( $dirref->[1] == WORDSPERBLK ) {
my $nextblock= allocate_blocks(WORDSPERBLK); my $nextblock = allocate_blocks(WORDSPERBLK);
$dirref->[0]= $nextblock; $dirref->[0] = $nextblock;
$dirref->[1]= 0; $dirref->[1] = 0;
# And add this new block to the directory's i-node # And add this new block to the directory's i-node
add_block_to_inode($nextblock, $dirref->[2]); add_block_to_inode( $nextblock, $dirref->[2] );
} }
} }
@@ -241,131 +247,258 @@ sub add_direntry {
# directory. Link it to the previous directory in the directory stack. # directory. Link it to the previous directory in the directory stack.
# Allocate blocks and i-nodes for it. Add a "dd" entry as well. # Allocate blocks and i-nodes for it. Add a "dd" entry as well.
sub make_dir { sub make_dir {
my ($dirname, $perms, $uid, $inum)= @_; my ( $dirname, $perms, $uid, $inum ) = @_;
# Get an i-node number or validate the one we got # Get an i-node number or validate the one we got
$inum= allocate_inode($inum); $inum = allocate_inode($inum);
# Get a block for this directory # Get a block for this directory
my $dirblock= allocate_blocks(WORDSPERBLK); my $dirblock = allocate_blocks(WORDSPERBLK);
# Add this to the previous directory # Add this to the previous directory
# and fill the i-node with the details # and fill the i-node with the details
add_direntry($dirname, $inum); add_direntry( $dirname, $inum );
fill_inode($inum, $perms, I_DIRECTORY, $uid, 0, $dirblock); fill_inode( $inum, $perms, I_DIRECTORY, $uid, 0, $dirblock );
# Make this the top directory on the dirstack # Make this the top directory on the dirstack
dprint("Pushing dir block $dirblock inum $inum to dirstack\n"); dprint("Pushing dir block $dirblock inum $inum to dirstack\n");
push(@Dirstack, [$dirblock, 0, $inum]); push( @Dirstack, [ $dirblock, 0, $inum ] );
# Add a "dd" entry to this directory # Add a "dd" entry to this directory
add_direntry("dd", DD_INUM); add_direntry( "dd", DD_INUM );
dprintf("Made directory %s perms %06o uid %d in i-node %d\n\n", dprintf( "Made directory %s perms %06o uid %d in i-node %d\n\n",
$dirname, $perms, $uid, $inum); $dirname, $perms, $uid, $inum );
} }
# Read a word from a file in paper tape binary format. # Read a word from a file in paper tape binary format.
# Return -1 on EOF # Return -1 on EOF
sub read_word { sub read_word {
my $FH = shift; my $FH = shift;
# Convert three bytes into one 18-bit word # Convert three bytes into one 18-bit word
return(-1) if ( read( $FH, my $three, 3 ) != 3 ); # Not enough bytes read return (-1) if ( read( $FH, my $three, 3 ) != 3 ); # Not enough bytes read
my ( $b1, $b2, $b3 ) = unpack( "CCC", $three ); my ( $b1, $b2, $b3 ) = unpack( "CCC", $three );
return ((($b1 & 077) << 12 ) | return ( ( ( $b1 & 077 ) << 12 ) | ( ( $b2 & 077 ) << 6 ) | ( $b3 & 077 ) );
(($b2 & 077) << 6 ) |
($b3 & 077));
} }
# Given a filename, perms, user-id and an external file, add a file to the # Given a filename, perms, user-id and an external file, add a file to the
# filesystem. Add an entry to this file in the current directory on # filesystem. Add an entry to this file in the current directory on
# the dirstack. # the dirstack.
sub add_file { sub add_file {
my ($name, $perms, $uid, $extfile) = @_; my ( $name, $perms, $uid, $extfile ) = @_;
dprintf("Adding file %s perms %06o uid %d extfile %s\n", dprintf( "Adding file %s perms %06o uid %d extfile %s\n",
$name, $perms, $uid, $extfile); $name, $perms, $uid, $extfile );
# Open the external file # Open the external file
open(my $IN, "<", $extfile) || die("Can't open $extfile: $!\n"); open( my $IN, "<", $extfile ) || die("Can't open $extfile: $!\n");
# Determine if this is ASCII or binary # Determine if this is ASCII or binary
my $isbinary=0; my $isbinary = 0;
my $c = getc($IN); my $c = getc($IN);
seek($IN, 0, 0); seek( $IN, 0, 0 );
$isbinary=1 if ((ord($c) & 0300) == 0200); $isbinary = 1 if ( ( ord($c) & 0300 ) == 0200 );
# Read the whole file into a buffer, converting from ASCII or sixbit encoding # Read the whole file into a buffer, converting from ASCII or sixbit encoding
my @buf; my @buf;
my $size; my $size;
while (1) { while (1) {
if ( $isbinary ) { if ($isbinary) {
# Convert three bytes into one 18-bit word # Convert three bytes into one 18-bit word
my $result = read_word($IN); my $result = read_word($IN);
last if ($result == -1); last if ( $result == -1 );
$buf[$size++] = $result; $buf[ $size++ ] = $result;
} } else {
else {
# Convert two ASCII characters into one 18-bit word # Convert two ASCII characters into one 18-bit word
my $c1 = getc($IN); my $c1 = getc($IN);
last if ( !defined($c1) ); # No character, leave the loop last if ( !defined($c1) ); # No character, leave the loop
my $word = ord($c1) << 9; my $word = ord($c1) << 9;
my $c2 = getc($IN); my $c2 = getc($IN);
$word |= ord($c2) if (defined($c2)); $word |= ord($c2) if ( defined($c2) );
$buf[$size++] = $word; $buf[ $size++ ] = $word;
} }
} }
# Allocate enough blocks for the file # Allocate enough blocks for the file
my @blklist= allocate_blocks($size); my @blklist = allocate_blocks($size);
# If it's too big, allocate indirect blocks # If it's too big, allocate indirect blocks
my $large=0; my $large = 0;
my @indblocks; my @indblocks;
if (@blklist > I_NUMBLKS) { if ( @blklist > I_NUMBLKS ) {
$large=1; $large = 1;
@indblocks= build_indirect_blocks(@blklist); @indblocks = build_indirect_blocks(@blklist);
} }
# Allocate and fill in the i-node # Allocate and fill in the i-node
my $inum= allocate_inode(); my $inum = allocate_inode();
if ($large) { if ($large) {
fill_inode($inum, $perms, 0, $uid, $size, @indblocks); fill_inode( $inum, $perms, I_FILE, $uid, $size, @indblocks );
} else { } else {
fill_inode($inum, $perms, 0, $uid, $size, @blklist); fill_inode( $inum, $perms, I_FILE, $uid, $size, @blklist );
} }
# and add the entry in the directory # and add the entry in the directory
add_direntry($name, $inum); add_direntry( $name, $inum );
dprint("Done adding file $name as inum $inum\n\n"); dprint("Done adding file $name as inum $inum\n\n");
} }
# Given a name, perms, uid and i-number # Given a name, perms, uid and i-number
# add a special file to the filesystem # add a special file to the filesystem
sub add_special { sub add_special {
my ($name, $perms, $uid, $inum) = @_; my ( $name, $perms, $uid, $inum ) = @_;
# Allocate and fill in the i-node # Allocate and fill in the i-node
my $inum= allocate_inode($inum); $inum = allocate_inode($inum);
fill_inode($inum, $perms, I_SPECIAL, $uid, 0); fill_inode( $inum, $perms, I_SPECIAL, $uid, 0 );
# Add the entry in the directory # Add the entry in the directory
add_direntry($name, $inum); add_direntry( $name, $inum );
dprint("Done adding special file $name inum $inum\n\n"); dprint("Done adding special file $name inum $inum\n\n");
} }
# Parse the perms word from the proto file.
# Return filetype and perms as a number.
sub parse_perms {
my $permstring = shift;
my ( $filetype, $perms ) = ( I_FILE, 0 );
die("perms word $permstring is not 5 characters long\n")
if ( length($permstring) != 5 );
$filetype = I_DIRECTORY if ( $permstring =~ m{^d} );
$filetype = I_SPECIAL if ( $permstring =~ m{^i} );
$perms |= I_OWNERREAD if ( $permstring =~ m{^.r} );
$perms |= I_OWNERWRITE if ( $permstring =~ m{^..w} );
$perms |= I_WORLDREAD if ( $permstring =~ m{^...r} );
$perms |= I_WORLDWRITE if ( $permstring =~ m{^....w} );
return ( $filetype, $perms );
}
# Open the named proto file and parse it
sub parse_proto_file {
my $file = shift;
open( my $IN, "<", $file ) || die("Can't one $file: $!\n");
while (<$IN>) {
chomp;
# Skip comments
s{#.*}{};
# Get the words on the line;
my @words = split( /\s+/, $_ );
# Skip if no words on this line
# but lose any empty word
next if ( @words == 0 );
shift(@words) if ( $words[0] eq '' );
# If the first word is a $, then pop a directory from the stack
if ( $words[0] eq '$' ) {
pop(@Dirstack);
next;
}
# Get the filetype and permissions
my ( $type, $perms ) = parse_perms( $words[1] );
if ( $type eq I_DIRECTORY ) {
my ( $name, $permstr, $uid, $inum ) = @words;
make_dir( $name, $perms, $uid, $inum );
next;
}
if ( $type eq I_FILE ) {
my ( $name, $permstr, $uid, $extfile ) = @words;
add_file( $name, $perms, $uid, $extfile );
next;
}
if ( $type eq I_SPECIAL ) {
my ( $name, $permstr, $uid, $inum ) = @words;
add_special( $name, $perms, $uid, $inum );
next;
}
}
close($IN);
}
# Convert an 18-bit word into a scalar which has three sixbit
# values in three bytes. Set the msb in the first byte
sub word2three {
my $val = shift;
my $b1 = ( ( $val >> 12 ) & 077 ) | 0x80;
my $b2 = ( $val >> 6 ) & 077;
my $b3 = $val & 077;
return ( pack( "CCC", $b1, $b2, $b3 ) );
}
# Dump the image to the output file
sub dump_image {
my ( $format, $output ) = @_;
open( my $OUT, ">", $output ) || die("Can't write to $output: $!\n");
# list: Octal output with block comments
if ( $format eq "list" ) {
foreach my $blocknum ( 0 .. NUMBLOCKS - 1 ) {
printf( $OUT "Block %d (%06o)\n", $blocknum, $blocknum )
if ($debug);
foreach my $line ( 0 .. 7 ) {
foreach my $offset ( 0 .. 7 ) {
printf( $OUT "%06o ",
$Block[$blocknum][ 8 * $line + $offset ] || 0
);
}
print( $OUT "\n" ) if ($debug);
}
print( $OUT "\n" ) if ($debug);
}
}
# ptr: Each word into three bytes, a sixbit in each one
if ( $format eq "ptr" ) {
foreach my $blocknum ( 0 .. NUMBLOCKS - 1 ) {
foreach my $offset ( 0 .. WORDSPERBLK ) {
print( $OUT word2three( $Block[$blocknum][$offset] || 0 ) );
}
}
}
# simh: Each word into four bytes, little endian
if ( $format eq "simh" ) {
foreach my $blocknum ( 0 .. NUMBLOCKS - 1 ) {
foreach my $offset ( 0 .. WORDSPERBLK ) {
my $word = $Block[$blocknum][$offset] || 0;
my $packedword = pack( "CCCC",
( $word >> 24 ) & 0xff,
( $word >> 16 ) & 0xff,
( $word >> 8 ) & 0xff,
$word & 0xff );
print( $OUT $packedword );
}
}
}
close($OUT);
}
# Keep this near the GetOptions call to make it easy to add documentation!
sub usage {
die("Usage: $0 [--debug] [--format=list|ptr|simh] [--out file] protofile\n");
}
### MAIN PROGRAM ### MAIN PROGRAM
$debug=1; my ( $format, $output ) = ( "list", "image.fs" );
make_dir("dd", 014, -1, 2);
make_dir("system", 014, -1, 3); GetOptions(
add_file("init", 014, -1, "proto"); 'debug|d' => \$debug,
pop(@Dirstack); 'format|f=s' => \$format,
add_special("ttyin", 014, -1, 6); 'output|o=s' => \$output,
add_special("keyboard", 014, -1, 7); ) or usage();
add_special("pptin", 014, -1, 8);
add_special("ttyout", 014, -1, 10); usage() if ( @ARGV < 1 );
add_special("display", 014, -1, 11); parse_proto_file( $ARGV[0] );
add_special("pptout", 014, -1, 12); dump_image( $format, $output );
add_file("as", 014, -1, "b.c"); exit(0);
add_file("a7out", 014, -1, "a7out");
add_file("oflow", 014, -1, "a7out");