github.com/DoctorWkt.pdp7-unix
1
0
Fork 0
mirror of https://github.com/DoctorWkt/pdp7-unix.git synced 2026-01-26 04:02:27 +00:00
Code Issues Releases Wiki Activity

Merge branch 'master' of https://github.com/DoctorWkt/pdp7-unix

Browse Source
This commit is contained in:
Tom Everett
2016-03-05 10:31:19 -07:00
parent 263dd699e6 0a5fc29c8c
commit f33cfd2de8
6 changed files with 942 additions and 191 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
src/cmd/ds.s
View File

@@ -363,28 +363,30 @@ putname: 0
jmp putname i
octal: 0
lmq
lac d5
tad octal i
cma
dac c
lmq " Move the negative argument into the MQ
" as we will use shifting to deal with the
" number by shifting groups of 3 digits.
lac d5 " By adding 5 to the negative count and
tad octal i " complementing it, we set the actual
cma " loop count up to 6 - count. So, if we
dac c " want to print 2 digits, we lose 6 - 2 = 4 digits
1:
llss 3
isz c
jmp 1b
lac octal i
dac c
llss 3 " Lose top 3 bits of the MQ
isz c " Do we have any more to lose?
jmp 1b " Yes, keep looping
lac octal i " Save the actual number of print digits into c
dac c " as a negative number.
1:
" ecla llss 3
llss 3
tad o60
cla
llss 3 " Shift 3 more bits into AC
tad o60 " Add AC to ASCII '0'
jms putc " and print out the digit
isz c " Any more characters to print out?
jmp 1b " Yes, loop back
law 040 " Print out a space
jms putc
isz c
jmp 1b
law 040
jms putc
isz octal
jmp octal i
isz octal " Move return address 1 past the argument
jmp octal i " and return from subroutine
error: 0
-1

46
src/other/octal_test.s Normal file
View File

@@ -0,0 +1,46 @@
" Octal test: This code borrowed from ds.s to test the llss
" instruction. It should print out num in octal followed by
" a space.
lac num
jms octal; -3
sys exit
octal: 0
lmq " Move the negative argument into the MQ
" as we will use shifting to deal with the
" number by shifting groups of 3 digits.
lac d5 " By adding 5 to the negative count and
tad octal i " complementing it, we set the actual
cma " loop count up to 6 - count. So, if we
dac c " want to print 2 digits, we lose 6 - 2 = 4 digits
1:
llss 3 " Lose top 3 bits of the MQ
isz c " Do we have any more to lose?
jmp 1b " Yes, keep looping
lac octal i " Save the actual number of print digits into c
dac c " as a negative number.
1:
cla
llss 3 " Shift 3 more bits into AC
tad o60 " Add AC to ASCII '0'
dac buf " and print out the digit
lac fd1
sys write; buf; 1
isz c " Any more characters to print out?
jmp 1b " Yes, loop back
lac o40 " Print out a space
dac buf
lac fd1
sys write; buf; 1
isz octal " Move return address 1 past the argument
jmp octal i " and return from subroutine
fd1: 1
d5: 5
o40: 040
o60: 060
num: 0126
buf: 0
c: .=.+1

344
src/other/sh.s Normal file
View File

@@ -0,0 +1,344 @@
" -*-fundamental-*-
" sh -- a shell
" started by p budne 3/4/2016
" with code from cat.s, init.s, and looking at the v1 (pdp-11) shell
" BUG: XXX second char of second word being incremented?????
start:
" XXX take command line argument (script file to open), suppress prompt??
" NOTE!!! v0 init.s doesn't set up the argv at the top of memory,
" so the v0 shell may not have taken command line arguments!!!
" if non-interactive, "dzm prompt", jump to newcom
interactive:
-1
sys intrp " make shell uninterruptable
sys getuid
sma " <0?
jmp newline " no, a mundane
lac hash " yes: superuser
dac prompt " change prompt
newline:
lac d1; sys write; prompt; 1 " output prompt
newcom:
dzm argc " clear arg count
dzm char " clear saved char
dzm infile " clear input redirect file name
dzm outfile " clear output redirect file name
lac iopt " reset output pointer
dac opt
dac nextarg
newarg:
-8 " save 8 chars
dac bcount
dzm redirect
lac opt " save start for print (TEMP)
dac 8f
dac nextarg
jms blank " skip whitespace
sad o12 " newline?
jmp eol " yes
sad lt " input redirect?
jmp redirin
sad gt " output redirect?
jmp redirout
jmp 3f
redirin: " saw <
dac redirect " flag redirect
lac infilep
dac opt
dac 8f " TEMP
jmp newchar " v1 behavior? no whitespace eater
redirout: " saw >
dac redirect " flag redirect
lac outfilep
dac opt
dac 8f " TEMP
" v1 behavior? no whitespace eater
" fall
newchar:
jms getc
sad o40 " space?
jmp ws " yes
sad o12
jmp ws
3: jms putc " save
isz bcount " loop unless full
jmp newchar
" here after 8 chars: discard until terminator seen
discard:
jms getc
dac char
sad o4
jmp eof
sad o12
jmp eoname
sad o40
jmp eoname
jmp discard
" here with EOF in command
eof:
sys exit " quit, for now?
" name ended (short) with whitespace or newline
" pad out last name to 8 with spaces
ws:
dac char
1: lac o40
jms putc " no: copy into argv
isz bcount " loop until full
jmp 1b
" saw end of name
eoname:
lac redirect
sza
jmp 1f " last name was a redirect file, skip increment
isz argc " increment argc
lac nextarg
tad d4 " advance nextarg
dac nextarg
1f:
" TEMP output each name on a line:
lac d1; sys write; 8:0; 4
lac d1; sys write; nl; 1
lac nextarg
dac opt
dac 8b " TEMP
lac char
sad o12
jmp eol
-maxargs
tad argc
sza
jmp newarg
" here at end of line (or too many args)
eol:
" XXX check for "chdir", execute "in-process"
" XXX if not, fork (child code below)
" XXX parent wait for child (unless &)
jmp newline
child:
cla
sad infile
jmp 1f
sys close " close fd 0
sys open; infile; 0 " open redirected
spa
jmp inerror
cla " XXX should still be zero!
1: sad outfile
jmp 1f
lac d1
sys close " close fd 1
" XXXXXXXXXX use creat!!!?
sys open; outfile; 1 " open redirected
spa
jmp outerror
" here to exec filename at argv, code adapted from init.s
" right now always look in "system" directory.
" but on error, check local directory?
1: sys unlink; exectemp
sys link; system; argv0; exectemp
spa
jmp nofile
sys open; exectemp; 0
spa
jmp error
sys unlink; exectemp
jmp 1f
nofile: " not found in "system"
sys open; argv0; 0 " try cwd
spa
jmp cmderr
1:
law bootloc-1 " Copy the code at the boot label below
dac 9 " up to high memory
law boot-1
dac 8
1:
lac 8 i
dac 9 i
sza " Stop copying when we hit the 0 marker
jmp 1b
jmp bootloc " and then jump to the code
boot:
lac d2 " Load fd2 (the opened shell file)
lmq " Save the fd into MQ
sys read; userbase; userlen " read executable in
lacq " Get the fd back and close the file
sys close
jmp userbase " and jump to the beginning of the executable
0 " 0 marks the end of the code, used by the copy loop
bootlen=.-boot " length of bootstrap
inerror:
law infile
jmp error
outerror:
law outfile
skp
cmderr:
law argv0
error: " here for error in child
dac 1f
lac d1 " XXX stdout may be redirected!!!!
sys write qmsp; 1
lac d1
sys write; 1: 0; 4
lac d1
sys write; nl; 1
" XXX smes to shell???
sys exit
" end code from init.s
" ================
blank: 0
1: jms getc
sad o40
jmp 1b
jmp blank i
" give skip return if AC *NOT* a command delimiter
delim: 0
sad o12
jmp delim i
isz delim
jmp delim i
" ****************************************************************
" from cat.s
getc: 0
lac ipt " Load the pointer to the next word in the buffer
sad eipt
jmp 1f " We've reached the end of the buffer, so read more
dac 2f " Save the pointer
add o400000 " Flip the msb and save into ipt
dac ipt
ral " Move the msb into the link register
lac 2f i " Load the word from the buffer
szl " Skip if this is the second character in the word
lrss 9 " It's the first char, shift down the top character
and o177 " Keep the lowest 7 bits
sna
jmp getc+1 " Skip a NUL characters and read another one
jmp getc i " Return the character from the subroutine
1:
cla " Buffer is empty, read another 64 characters
sys read; ibuf; 64
sna
jmp 1f " No characters were read in
tad iipt " Add the word count to the base of the buffer
dac eipt " and store in the end buffer pointer
lac iipt " Reset the ipt to the base of the buffer
dac ipt
jmp getc+1 " and loop back to get one character
1:
lac o4 " No character, return with ctrl-D
jmp getc i " return from subroutine
putc: 0
and o177 " Keep the lowest 7 bits and save into 2f+1
dac 2f+1
lac opt " Save the pointer to the empty buffer
dac 2f " position to 2f
add o400000 " Flip the msb and save back into opt
dac opt " This also has the effect of incrementing
" the opt pointer every second addition!
spa " If the bit was set, we already have one
jmp 1f " character at 2f+1. If no previous character,
lac 2f i " merge the old and new character together
xor 2f+1
jmp 3f " and go to the "save it in buffer" code
1:
lac 2f+1 " Move the character up into the top half
alss 9
3:
dac 2f i " Save the word into the buffer
jmp putc i " No, so return (more room still in the buffer)
2: 0;0 " Current input and output word pointers
ipt: 0 " Current input buffer base
eipt: 0 " Pointer to end of data read in input buffer
iipt: ibuf
ibuf: .=.+64
" end from cat.s
" ****************************************************************
" constants
d1: 1
d2: 2
o4:d4: 4
o12:nl: 012 " newline
o40:sp: 040 " space
o74:lt: 074
o76:gt: 076
o177: 0177 " ASCII mask
o400000: 0400000 " Msb toggle bit
hash: <#> " superuser prompt
qmsp: <? > "
system:
<sy>;<st>;<em>; 040040
exectemp:
<ex>;<ec>;<te><mp> " temporary link for file being exec'ed
" TEMP FOR DEBUG:
star: <*> "
" ################ variables
prompt: <@> " v1 prompt
pid: 0 " "other" pid
char: 0 " white space char
redirect: 0 " last file was a redirect (lt or gt)
bcount: 0 " byte counter for current filename
iopt: argc-4 " initial value for nextarg, opt
nextarg: 0 " next slot in argv to fill
opt: 0 " "output pointer" (may point to in/outfile)
infilep: infile
outfilep: outfile
outfile: .=.+4 " buffer for output redirect file name
infile: .=.+4 " buffer for input redirect file name
" == high memory
userbase=010000
userlen=userbase-bootloc " max executable
argptr=017777 " last word points to argc + argv data
" leave room for maxargs items of 4 words each
maxargs=8
argc=argptr-maxargs-maxargs-maxargs-maxargs
" 4 word blocks follow argc:
argv0=argc+1
" "bootstrap" (reads executable into userbase) below argc:
bootloc=argc-bootlen " location of bootstrap

209
src/other/wktls.s
View File

@@ -1,33 +1,130 @@
" Warren's version of ls. Simply print out the names in the current directory
" Warren's version of ls. ls [-l]
"
" When -l is used, you see
"
" inum [dls][r-][w-][r-][w-] nlink uid size name
"
" with numbers in octal. All filenames need to be 8 characters
" long or less, or ls will crash.
main:
sys open; curdir; 0 " Open up the currect directory
lac 017777 i " Load the pointer pointer in 017777
sad d4 " to see if we have any arguments
jmp 1f " No arguments, so no long option
lac fd1
dac longopt " Yes an argument, set the long option
1:
sys open; curdir; 0 " Open up the current directory
spa
sys exit " Unable, so die now
dac fd " Save the fd
sys exit " Unable, so die now
dac fd " Save the fd
fileloop:
" Read 64 words into the buffer from the input file
lac fd
lac fd " Read 64 words into the buffer from the input file
sys read; buf; 64
spa " Skip if result was >= 0
jmp fileend " Result was -ve, so error result
sna " Skip if result was >0
jmp fileend " Result was zero, so nothing left to read
" Save the count of words read in
dac count
dac count " Save the count of words read in
lac ibufptr " Point bufptr at the base of the buffer
dac bufptr
" Each directory entry is eight words. We need to print out
" the filename which is in words 2 to 5.
printloop:
" the filename which is in words 2 to 5. Word 1 is the inum.
entryloop:
lac longopt " Are we printing out in long format?
sna
jmp 1f " No, don't print out the inode number
isz bufptr " Move up to the filename
lac d1
sys write; bufptr:0; 4 " Write a filename out to stdout
lac d1
lac bufptr " Print out the inode number as 5 digits
jms octal; -5
1: isz bufptr " Move up to the filename
lac longopt " Are we printing out in long format?
sna
jmp printname " No, jump to printname
lac bufptr
dac statfile " Copy the pointer to the status call
lac statbufptr " Get the file's details into the statbuf
sys status; statfile:0; 0
spa
jms fileend
" Ugly code. Improvements welcome!
lac s.perm " See if this is a directory
and isdirmask
sna
jmp 1f
lac fd1
sys write; d; 1 " Yes, print a d
jmp 2f
1: lac s.perm " Not a dir, see if its a large file
and largemask
sna
jmp 1f
lac fd1
sys write; l; 1 " Yes, print an l
jmp 2f
1: lac fd1
sys write; minus; 1 " Not a dir, not large, print an s
2: lac s.perm " Readable by owner?
and ureadmask
sna
jmp 1f
lac fd1
1: sys write; r; 1 " Yes, print an r
jmp 2f
sys write; minus; 1 " No, print a - sign
2: lac s.perm " Writable by owner?
and uwritemask
sna
jmp 1f
lac fd1
sys write; w; 1 " Yes, print a w
jmp 2f
1: lac fd1
sys write; minus; 1 " No, print a - sign
2: lac s.perm " Readable by other?
and oreadmask
sna
jmp 1f
lac fd1
sys write; r; 1 " Yes, print an r
jmp 2f
1: lac fd1
sys write; minus; 1 " No, print a - sign
2: lac s.perm " Writable by other?
and owritemask
sna
jmp 1f
lac fd1
sys write; w; 1 " Yes, print a w
jmp 2f
1: lac fd1
sys write; minus; 1 " No, print a - sign
2: lac fd1
sys write; space; 1 " Print a space
lac s.nlinks " Print the number of links out
jms octal; -2
lac s.uid " Print the user-id out
jms octal; -3
lac s.size " Print the size out
jms octal; -5
printname:
lac fd1
sys write; bufptr:0; 4 " Write the filename out to stdout
lac fd1
sys write; newline; 1 " followed by a newline
lac bufptr " Add 7 to the bufptr
@@ -37,23 +134,87 @@ printloop:
tad count " Decrement the count of words by 8
dac count
sza " Anything left in the buffer to print?
jmp printloop " Yes, stuff left to print
jmp entryloop " Yes, stuff left to print
jmp fileloop " Nothing in the buffer, try reading some more
fileend:
" Close the open file descriptor and exit
lac fd
lac fd " Close the open file descriptor and exit
sys close
sys exit
curdir: <. 040; 040040; 040040; 040040 " i.e. "."
newline: 012000
fd: 0
d1: 1 " stdout fd
" Octal print code: This code borrowed from ds.s
octal: 0
lmq " Move the negative argument into the MQ
" as we will use shifting to deal with the
" number by shifting groups of 3 digits.
lac d5 " By adding 5 to the negative count and
tad octal i " complementing it, we set the actual
cma " loop count up to 6 - count. So, if we
dac c " want to print 2 digits, we lose 6 - 2 = 4 digits
1:
llss 3 " Lose top 3 bits of the MQ
isz c " Do we have any more to lose?
jmp 1b " Yes, keep looping
lac octal i " Save the actual number of print digits into c
dac c " as a negative number.
1:
cla
llss 3 " Shift 3 more bits into AC
tad o60 " Add AC to ASCII '0'
dac cbuf " and print out the digit
lac fd1
sys write; cbuf; 1
isz c " Any more characters to print out?
jmp 1b " Yes, loop back
lac fd1 " Print out a space
sys write; space; 1
isz octal " Move return address 1 past the argument
jmp octal i " and return from subroutine
longopt: 0 " User set the -l option when this is 1
fd: 0 " File descriptor for the directory
fd1: 1 " File descriptor 1
d4: 4
d5: 5
d7: 7
count: 0
o40: 040
o60: 060
count: 0 " Count of # of directory words read in
cbuf: 0 " Used to print out in the octal routing
c: .=.+1 " Loop counter for printing octal digits
" Input buffer for read
ibufptr: buf " Constant pointer to the buffer
buf: .=.+64
buf: .=.+64 " Directory buffer
statbufptr: statbuf " Pointer to the statbuf
statbuf: " Status buffer fields below
s.perm: 0
s.blk1: 0
s.blk2: 0
s.blk3: 0
s.blk4: 0
s.blk5: 0
s.blk6: 0
s.blk7: 0
s.uid: 0
s.nlinks: 0
s.size: 0
s.uniq: 0
largemask: 200000 " large file, bigger than 4096 words
isdirmask: 000020 " is a directory
ureadmask: 000010 " user read
uwritemask: 000004 " user write
oreadmask: 000002 " other read
owritemask: 000001 " other write
d: 0144 " ASCII characters: d, l, s, r, w, -, space, \n
l: 0154
s: 0163
r: 0162
w: 0167
minus: 055
space: 040
newline: 012
curdir: <. 040; 040040; 040040; 040040 " i.e. "."

26
tools/3dump Executable file
View File

@@ -0,0 +1,26 @@
#!/usr/bin/perl
#
# Dump a binary PDP-7 file where a word is encoded as three bytes,
# with sixbits are stored big-endian in each of the three byte.
#
use strict;
use warnings;
die("Usage: $0 binaryfile\n") if (@ARGV==0);
open(my $IN, "<", $ARGV[0]) || die("Can't open $ARGV[0]: $!\n");
while (1) {
# Convert three bytes into one 18-bit word
my $result= read($IN, my $three, 3);
last if ($result != 3); # Not enough bytes read
my ($b1, $b2, $b3)= unpack("CCC", $three);
my $word= (($b1 & 077) << 12) | ($b2 << 6) | $b3;
my $c1= ($word >> 9) & 0777;
$c1= ($c1 < 0200) ? chr($c1) : " ";
my $c2= $word & 0777;
$c2= ($c2 < 0200) ? chr($c2) : " ";
printf("%06o %s%s\n", $word, $c1, $c2)
}
close($IN);
exit(0);

468
tools/a7out
View File

@@ -6,6 +6,7 @@
#
use strict;
use warnings;
use Fcntl qw(:seek);
use DateTime;
use Data::Dumper;
@@ -15,6 +16,7 @@ my $singlestep = 0; # Are we running in single-step mode?
my %Breakpoint; # Hash of defined breakpoints
my @Mem; # 8K 18-bit words of main memory
my @FD; # Array of open filehandles
my @ISBINARY; # Array of filehandle flags: ASCII or binary files?
# Registers
my $PC = 010000; # Program counter
@@ -141,6 +143,7 @@ sub set_arguments {
# Truncate and/or space pad the argument
my $str = sprintf( "%-8s", substr( $_, 0, 8 ) );
# XXX: use ascii2words
# Store pairs of characters into memory
for ( my $i = 0 ; $i < length($str) ; $i += 2 ) {
my $c1 = substr( $str, $i, 1 ) || "";
@@ -176,9 +179,9 @@ sub simulate {
# List of opcodes that DON'T auto-increment
# locations 10-17 when we have the indirect bit
my %NoIncr = (
oct("000") => 1, # cal
oct("064") => 1, # eae
oct("074") => 1 # opr
oct("000") => 1, # cal
oct("064") => 1, # eae
oct("074") => 1 # opr
);
# Loop indefinitely
@@ -190,13 +193,16 @@ sub simulate {
my $indirect = ( $instruction >> 13 ) & 1;
my $addr = $instruction & MAXADDR;
# Auto-increment locations 010 to 017 if $indirect
# and this is an instruction that does increment
if ($indirect && ($addr >= 010) && ($addr <= 017) &&
!defined($NoIncr{$opcode})) {
$Mem[$addr]++;
$Mem[$addr] &= MAXINT;
}
# Auto-increment locations 010 to 017 if $indirect
# and this is an instruction that does increment
if ( $indirect
&& ( $addr >= 010 )
&& ( $addr <= 017 )
&& !defined( $NoIncr{$opcode} ) )
{
$Mem[$addr]++;
$Mem[$addr] &= MAXINT;
}
# Work out what any indirect address would be
my $indaddr = ($indirect) ? $Mem[$addr] & MAXADDR : $addr;
@@ -215,7 +221,8 @@ sub simulate {
# Simulate the instruction. Each subroutine updates the $PC
if ( defined( $Oplist{$opcode} ) ) {
$Oplist{$opcode}->( $instruction, $addr, $indaddr );
} else {
}
else {
printf( STDERR "Unknown instruction 0%06o at location 0%06o\n",
$instruction, $PC );
exit(1);
@@ -229,12 +236,13 @@ sub simulate {
sub dump_memory {
my ( $start, $end, $yeszero ) = @_;
foreach my $i ( $start .. $end ) {
# Convert the word into possibly two ASCII characters
my $c1= ($Mem[$i] >> 9) & 0777;
$c1= ($c1 < 0200) ? chr($c1) : " ";
my $c2= $Mem[$i] & 0777;
$c2= ($c2 < 0200) ? chr($c2) : " ";
printf( STDERR "%06o: %06o %s%s\n", $i, $Mem[$i], $c1, $c2)
# Convert the word into possibly two ASCII characters
my $c1 = ( $Mem[$i] >> 9 ) & 0777;
$c1 = ( $c1 < 0200 ) ? chr($c1) : " ";
my $c2 = $Mem[$i] & 0777;
$c2 = ( $c2 < 0200 ) ? chr($c2) : " ";
printf( STDERR "%06o: %06o %s%s\n", $i, $Mem[$i], $c1, $c2 )
if ( $yeszero || $Mem[$i] != 0 );
}
}
@@ -261,7 +269,7 @@ sub tad {
dprintf( "tad AC (value %06o) with addr %06o (%06o)\n",
$AC, $indaddr, $Mem[$indaddr] );
$AC = $AC + $Mem[$indaddr];
$LINK = ($LINK ^ $AC) & LINKMASK;
$LINK = ( $LINK ^ $AC ) & LINKMASK;
$AC = $AC & MAXINT;
$PC++;
}
@@ -380,18 +388,21 @@ sub opr {
$skip = 1 if ( ( $i == 1 ) && ( $AC & SIGN ) != 0 ); # sma
$skip = 1 if ( ( $i == 2 ) && ( $AC & MAXINT ) == 0 ); # sza
$skip = 1 if ( ( $i == 3 )
$skip = 1
if ( ( $i == 3 )
&& ( ( ( $AC & MAXINT ) == 0 ) || ( ( $AC & SIGN ) != 0 ) ) )
; # sza | sma
$skip = 1 if ( ( $i == 4 ) && ($LINK) ); # snl
$skip = 1 if ( ( $i == 5 ) && ( $LINK || ( $AC >= SIGN ) ) ); # snl | sma
$skip = 1 if ( ( $i == 6 ) && ( $LINK || ( $AC == 0 ) ) ); # snl | sza
$skip = 1 if ( ( $i == 7 )
$skip = 1
if ( ( $i == 7 )
&& ( $LINK || ( $AC >= SIGN ) || ( $AC == 0 ) ) ); # snl | sza | sma
$skip = 1 if ( $i == 010 ); # skp
$skip = 1 if ( ( $i == 011 ) && ( ( $AC & SIGN ) == 0 ) ); # spa
$skip = 1 if ( ( $i == 012 ) && ( ( $AC & MAXINT ) != 0 ) ); # sna
$skip = 1 if ( ( $i == 013 )
$skip = 1
if ( ( $i == 013 )
&& ( ( $AC & MAXINT ) != 0 )
&& ( ( $AC & SIGN ) == 0 ) ); # sna & spa
$skip = 1 if ( ( $i == 014 ) && ( $LINK == 0 ) ); # szl
@@ -399,17 +410,20 @@ sub opr {
if ( ( $i == 015 ) && ( $LINK == 0 ) && ( $AC < SIGN ) ); # szl & spa
$skip = 1
if ( ( $i == 016 ) && ( $LINK == 0 ) && ( $AC != 0 ) ); # szl & sna
$skip = 1 if ( ( $i == 017 )
$skip = 1
if ( ( $i == 017 )
&& ( $LINK == 0 )
&& ( $AC != 0 )
&& ( $AC != 0 ) ); # szl & sna & spa
# Clear operations
if ( $instruction & 010000 ) { # cla
dprintf(" cla"); $AC = 0;
dprintf(" cla");
$AC = 0;
}
if ( $instruction & 004000 ) { # cli
dprintf(" cli"); $LINK = 0;
dprintf(" cli");
$LINK = 0;
}
if ( $instruction & 000002 ) { # cmi
dprintf(" cmi");
@@ -470,9 +484,20 @@ sub opr {
# Extended arithmetic element instructions
sub eae {
my ( $instruction, $addr, $indaddr ) = @_;
my $step = $instruction & EAESTEP;
my $maskedinstr= $instruction & EAEIMASK;
my $step = $instruction & EAESTEP;
my $maskedinstr = $instruction & EAEIMASK;
if ( $instruction == 0653323 ) { # idiv: integer division
my $divisor= $Mem[ $PC+1 ];
dprintf( "div AC %06o AC by %06o (decimal %d by %d)\n", $AC, $divisor, $AC, $divisor );
# Prevent division by zero :-)
my $quotient = ($divisor) ? $AC / $divisor : 0;
my $remainder = ($divisor) ? $AC % $divisor : 0;
$MQ= $quotient;
$AC= $remainder;
$PC+=2;
return;
}
if ( $maskedinstr == 0660500 ) { # lrss: long right shift, signed
# We ignore the MQ as it's not
# used by any user-mode programs
@@ -487,18 +512,18 @@ sub eae {
}
if ( $maskedinstr == 0660700 ) { # alss: AC left shift, signed
dprintf( "alss AC %06o step %d\n", $AC, $step );
$AC = ( $AC << $step ) & MAXINT;
$AC = ( $AC << $step ) & MAXINT;
$LINK = ( $AC << 1 ) & LINKMASK;
$PC++;
return;
}
if ( $maskedinstr == 0660600 ) { # llss: long left shift, signed
dprintf( "llss AC %06o step %d\n", $AC, $step );
foreach my $i (1 .. $step) {
my $MQmsb= ($MQ & SIGN) ? 1 : 0;
$AC= (($AC << 1) | $MQmsb) & MAXINT;
$MQ= (($MQ << 1) | (($LINK) ? 1 : 0)) & MAXINT;
}
foreach my $i ( 1 .. $step ) {
my $MQmsb = ( $MQ & SIGN ) ? 1 : 0;
$AC = ( ( $AC << 1 ) | $MQmsb ) & MAXINT;
$MQ = ( ( $MQ << 1 ) | ( ($LINK) ? 1 : 0 ) ) & MAXINT;
}
$PC++;
return;
}
@@ -509,23 +534,57 @@ sub eae {
return;
}
if ( $instruction == 0652000 ) { # lmq: load MC from AC
dprintf( "lmq AC %06o into MQ\n", $AC);
$MQ= $AC;
dprintf( "lmq AC %06o into MQ\n", $AC );
$MQ = $AC;
$PC++;
return;
}
if ( $instruction == 0641002 ) { # lacq: load AC from MQ
dprintf( "lacq MQ %06o into AC\n", $MQ);
$AC= $MQ;
dprintf( "lacq MQ %06o into AC\n", $MQ );
$AC = $MQ;
$PC++;
return;
}
if ( $instruction == 0640002 ) { # lacq: OR AC with MQ
dprintf( "omq MQ %06o and AC %06o\n", $MQ, $AC);
$AC |= $MQ;
dprintf( "omq MQ %06o and AC %06o\n", $MQ, $AC );
$AC |= $MQ;
$PC++;
return;
}
if ( $instruction == 0653122 ) { # mul: unsigned multiply
# This logic shamelessly borrowed from SimH
# https://github.com/simh/simh/blob/master/PDP18B/pdp18b_cpu.c
my $MB= $Mem[ $PC+1 ];
my $eae_ac_sign;
dprintf("mul AC %06o by %06o (decimal %d by %d)\n", $AC, $MB, $AC, $MB);
if (($instruction & 0004000) && ($AC & SIGN)) { # IR<6> and minus?
$eae_ac_sign = $LINK; # set eae_ac_sign
} else {
$eae_ac_sign = 0; # if not, unsigned
}
$MQ = $MQ ^ MAXINT if ($eae_ac_sign); # EAE AC sign? ~MQ
my $oldlink= $LINK;
$LINK = 0; # Clear link
my $result= $AC * $MB;
$AC= ($result >> 18) & MAXINT;
$MQ= $result & MAXINT;
## foreach my $SC (1 .. $instruction & 077) { # Loop for SC times
## $AC = $AC + $MB
## if ($MQ & 1); # MQ<17>? add
## $MQ = ($MQ >> 1) | (($AC & 1) << 17);
## $AC = $AC >> 1; # Shift AC'MQ right
## }
if ($eae_ac_sign ^ $oldlink) { # Result negative?
$AC = $AC ^ MAXINT;
$MQ = $MQ ^ MAXINT;
}
$PC+=2;
return;
}
printf( STDERR "PC %06o: Unknown eae instruction %06o\n",
$PC, $instruction );
exit(1);
@@ -537,32 +596,33 @@ sub cal {
# Syscalls that we can simulate
my %Syscallist = (
# 1: save
2 => \&sys_getuid,
3 => \&sys_open,
4 => \&sys_read,
5 => \&sys_write,
6 => \&sys_creat,
# 7 seek
# 8 tell
9 => \&sys_close,
# 10 link
# 1: save
2 => \&sys_getuid,
3 => \&sys_open,
4 => \&sys_read,
5 => \&sys_write,
6 => \&sys_creat,
7 => \&sys_seek,
# 8 tell
9 => \&sys_close,
# 10 link
11 => \&sys_unlink,
12 => \&sys_setuid,
# 13 rename
# 13 rename
14 => \&sys_exit,
15 => \&sys_time,
16 => \&sys_intrp,
17 => \&sys_chdir,
18 => \&sys_chmod,
19 => \&sys_chown,
# 20 badcal
# 21 syslog
# 22 badcal
# 23 capt
# 24 rele
# 20 badcal
# 21 syslog
# 22 badcal
# 23 capt
# 24 rele
25 => \&sys_status,
# 26 badcal
# 26 badcal
27 => \&sys_smes,
28 => \&sys_rmes,
29 => \&sys_fork,
@@ -571,7 +631,8 @@ sub cal {
# Simulate the syscall. Each syscall updates the $PC
if ( defined( $Syscallist{$addr} ) ) {
$Syscallist{$addr}->();
} else {
}
else {
printf( STDERR "PC %06o: Unknown syscall %d\n", $PC, $addr );
exit(1);
}
@@ -579,20 +640,21 @@ sub cal {
# Exit system call
sub sys_exit {
dprintf("exit system call, pid %06o\n", $$);
dprintf( "exit system call, pid %06o\n", $$ );
exit(0);
}
# Getuid system call
sub sys_getuid {
$AC= $< & MAXINT;
dprintf("getuid system call, uid %06o\n", $AC);
$AC = $< & MAXINT;
dprintf( "getuid system call, uid %06o\n", $AC );
$PC += 1;
return;
}
# Setuid system call
sub sys_setuid {
# For now, do nothing
dprint("setuid system call\n");
$PC += 1;
@@ -601,6 +663,7 @@ sub sys_setuid {
# Intrp system call
sub sys_intrp {
# For now, do nothing
dprint("intrp system call\n");
$PC += 1;
@@ -611,9 +674,9 @@ sub sys_intrp {
sub sys_fork {
# Fork and get the child's process-id back, or zero if we are the child
my $pid= fork();
$AC= $pid & MAXINT;
dprintf( "fork, got id %06o\n", $AC);
my $pid = fork();
$AC = $pid & MAXINT;
dprintf( "fork, got id %06o\n", $AC );
# The parent returns back to PC+1, the child returns to PC+2
$PC += ($pid) ? 1 : 2;
@@ -625,6 +688,7 @@ sub sys_fork {
# sys exit, that's going to wake wait() up and do the
# rmes anyway.
sub sys_smes {
# For now, do nothing
dprintf("smes system call\n");
$PC += 1;
@@ -634,9 +698,9 @@ sub sys_smes {
# Rmes system call. We simply call wait and
# return the process-id in AC
sub sys_rmes {
my $pid= wait();
my $pid = wait();
dprintf("rmes system call, got pid $pid\n");
$AC= $pid & MAXINT;
$AC = $pid & MAXINT;
$PC += 1;
return;
}
@@ -653,27 +717,43 @@ sub sys_close {
# That filehandle is not open, set an error -1 in octal
if ( !defined( $FD[$fd] ) ) {
dprint("close: fd $fd is not open\n");
dprintf("close: fd $fd is not open\n");
$AC = MAXINT;
return;
}
close( $FD[$fd] );
$FD[$fd] = undef;
$AC = 0;
$FD[$fd] = undef;
$ISBINARY[$fd] = 0; # For next time
$AC = 0;
return;
}
# Open something which could be a file or a directory
# Convert directories into files. Return the file handle.
# Convert directories into files. Return the file handle and
# if the file is ASCII or binary.
sub opensomething {
my ($readorwrite, $filename )= @_;
my $tempfile= "/tmp/a7out.$$";
my ( $readorwrite, $filename ) = @_;
my $tempfile = "/tmp/a7out.$$";
my $FH;
# If this is not a directory, simply open and return the FH
if (! -d $filename) {
open( $FH, $readorwrite, $filename ) || return(undef);
return($FH);
# If this is not a directory, open it and return the FH
if ( !-d $filename ) {
open( $FH, $readorwrite, $filename ) || return (undef);
# Opened for writing, so for now this is not binary
return ( $FH, 0) if ($readorwrite eq ">");
# Determine if the file is pure ASCII or contains 18-bit
# words encoded in 24-bit groups. We test the msb of the
# first character in the file. If it's on then it's a
# binary file and not ASCII.
# XXX: This means that we have to seek back to the beginning,
# which may be a problem on things like stdin.
my $ch = getc($FH);
my $isbinary = ( defined($ch) && ( ord($ch) & 0x80 ) ) ? 1 : 0;
binmode($FH) if ($isbinary);
seek( $FH, 0, SEEK_SET );
return ( $FH, $isbinary );
}
# It's a directory. The on-disk format for this was:
@@ -684,45 +764,59 @@ sub opensomething {
# The code creates a temporary file and fills in the i-node numbers
# and space padded filenames from the directory. The file is closed
# opened read-only and unlinked, and the open filehandle is returned.
opendir(my $dh, $filename) || return(undef);
open( $FH, ">", $tempfile) || return(undef);
opendir( my $dh, $filename ) || return (undef);
open( $FH, ">", $tempfile ) || return (undef);
dprintf("Converting directory $filename\n");
my @list= sort(readdir($dh));
my @list = sort( readdir($dh) );
foreach my $name (@list) {
# Get the file's i-node number
my (undef,$inode)= stat($name);
# ARGH! For now we are still read/writing ASCII files, so there's
# no way to represent a proper 18-bit value. For now I'll pad
# with spaces to create the record
printf( $FH " %-8s ", substr( $name, 0, 8 ) );
# Get the file's i-node number and write it
my ( undef, $inode ) = stat($name);
print( $FH word2three($inode) );
# Convert the name into 8 characters, space padded
my $spaceword = sprintf( "%-8s", substr( $name, 0, 8 ) );
# Convert to four words and write each as three bytes
foreach my $word ( ascii2words($spaceword) ) {
print( $FH word2three($word) );
}
# Now write three zero words to pad to eight in total
print( $FH word2three(0) );
print( $FH word2three(0) );
print( $FH word2three(0) );
}
closedir($dh);
close($FH);
open( $FH, "<", $tempfile) || return(undef);
open( $FH, "<", $tempfile ) || return (undef);
binmode($FH);
#exit(0);
unlink($tempfile);
return($FH);
return ( $FH, 1 );
}
# Common code for creat and open
sub creatopen {
my ($filename, $readorwrite)= @_;
my ( $filename, $readorwrite ) = @_;
# Open the file
my $FH= opensomething($readorwrite, $filename );
if ( $FH ) {
my ( $FH, $isbinary ) = opensomething( $readorwrite, $filename );
if ($FH) {
# Find a place in the @FD array to store this filehandle.
# 99 is arbitrary
foreach my $fd ( 0 .. 99 ) {
if ( !defined( $FD[$fd] ) ) {
$FD[$fd] = $FH;
$AC = $fd;
$FD[$fd] = $FH;
$ISBINARY[$fd] = $isbinary;
$AC = $fd;
last;
}
}
} else {
}
else {
# No filehandle, so it's an error
dprintf("open failed: $!\n");
$AC = MAXINT;
@@ -739,7 +833,7 @@ sub sys_open {
# Get the start address of the string
# Convert this to a sensible ASCII filename
my $start = $Mem[ $PC + 1 ];
my $start = $Mem[ $PC + 1 ];
my $filename = mem2arg($start);
# Choose to open read-only or write-only
@@ -750,11 +844,12 @@ sub sys_open {
$PC += 3;
# Now open the file and return
creatopen($filename, $readorwrite);
creatopen( $filename, $readorwrite );
}
# Creat system call
sub sys_creat {
# Creat seems to have 1 argument: PC+1 is a pointer to the filename.
# Some programs seem to have a second argument always set to 0.
# AC is the opened fd on success, or -1 on error
@@ -773,7 +868,7 @@ sub sys_creat {
$PC += 2;
# Now open the file and return
creatopen($filename, $readorwrite);
creatopen( $filename, $readorwrite );
}
# Read system call
@@ -806,12 +901,23 @@ sub sys_read {
$count = 0;
foreach my $addr ( $start .. $end ) {
my $c1 = getc($FH);
last if ( !defined($c1) ); # No character, leave the loop
my $c2 = getc($FH); # No character, make it a NUL
$c2= "" if (!defined($c2));
$Mem[$addr] =
( ord($c1) << 9 ) | ord($c2); # Pack both into one word
if ( $ISBINARY[$fd] ) {
# Convert three bytes into one 18-bit word
my $result = read( $FH, my $three, 3 );
last if ( $result != 3 ); # Not enough bytes read
my ( $b1, $b2, $b3 ) = unpack( "CCC", $three );
$Mem[$addr] = ( ( $b1 & 077 ) << 12 ) | ( $b2 << 6 ) | $b3;
}
else {
# Convert two ASCII characters into one 18-bit word
my $c1 = getc($FH);
last if ( !defined($c1) ); # No character, leave the loop
my $c2 = getc($FH); # No character, make it a NUL
$c2 = "" if ( !defined($c2) );
$Mem[$addr] =
( ord($c1) << 9 ) | ord($c2); # Pack both into one word
}
$count++;
}
@@ -822,6 +928,7 @@ sub sys_read {
# Write system call
sub sys_write {
# Write seems to have arguments: AC is the file descriptor, PC+1 is
# the pointer to the buffer and PC+2 is the number of words to write
@@ -844,11 +951,19 @@ sub sys_write {
return;
}
# Write each word out
# Write each word out either in binary or in ASCII
my $FH = $FD[$fd];
foreach my $addr ( $start .. $end ) {
# First see if any "non-ASCII" bits are set in the word.
# If so, then this is a binary file
my $word= $Mem[$addr];
$ISBINARY[$fd]=1 if ($word & 0600600);
print( $FH word2ascii( $Mem[$addr] ) );
if ($ISBINARY[$fd]) {
print( $FH word2three($word) );
} else {
print( $FH word2ascii($word) );
}
}
# No error
@@ -858,6 +973,7 @@ sub sys_write {
# Chmod system call
sub sys_chmod {
# Chmod gets the permission bits in AC and a pointer
# to the file's name in PC+1. s2.s has these instruction for chmod:
# lac u.ac; and o17 so only the lowest 4
@@ -867,108 +983,113 @@ sub sys_chmod {
# 02 read for non-owner
# 04 write for owner
# 10 read for owner
my $mode=0;
$mode|= 0002 if ($AC & 01);
$mode|= 0004 if ($AC & 02);
$mode|= 0220 if ($AC & 04);
$mode|= 0440 if ($AC & 010);
my $start = $Mem[ $PC + 1 ];
my $mode = 0;
$mode |= 0002 if ( $AC & 01 );
$mode |= 0004 if ( $AC & 02 );
$mode |= 0220 if ( $AC & 04 );
$mode |= 0440 if ( $AC & 010 );
my $start = $Mem[ $PC + 1 ];
my $filename = mem2arg($start);
dprintf( "chmod %06o file %s\n", $mode, $filename);
dprintf( "chmod %06o file %s\n", $mode, $filename );
# Do the chmod on the file
my $result= chmod($mode, $filename);
my $result = chmod( $mode, $filename );
# Set AC to -1 if no files were changed, else 0
$AC= ($result == 0) ? MAXINT : 0;
$AC = ( $result == 0 ) ? MAXINT : 0;
$PC += 2;
return;
}
# Chown system call
sub sys_chown {
# Chown gets the numeric user-id in AC and a pointer
# to the file's name in PC+1.
# Get the start address of the string
# Convert this to a sensible ASCII filename
my $start = $Mem[ $PC + 1 ];
my $start = $Mem[ $PC + 1 ];
my $filename = mem2arg($start);
dprintf( "chown file %s to uid %06o\n", $filename, $AC);
dprintf( "chown file %s to uid %06o\n", $filename, $AC );
# Do the chown, leave group-id untouched. Get number of files changed
my $result= chown($AC, -1, $filename);
my $result = chown( $AC, -1, $filename );
# Set AC to -1 if no files were changed, else 0
$AC= ($result == 0) ? MAXINT : 0;
$AC = ( $result == 0 ) ? MAXINT : 0;
$PC += 2;
return;
}
# Chdir system call
sub sys_chdir {
# Chdir gets the directory name in PC+1
# Return 0 on success, -1 on error
# Convert this to a sensible ASCII filename
my $start = $Mem[ $PC + 1 ];
my $start = $Mem[ $PC + 1 ];
my $filename = mem2arg($start);
dprintf( "chdir %s\n", $filename);
dprintf( "chdir %s\n", $filename );
# Bump up the PC
$PC += 2;
# Do nothing on chdir to "dd"
return(0) if ($filename eq "dd");
return (0) if ( $filename eq "dd" );
# Do the chdir
return( chdir($filename) ? 0 : MAXINT);
return ( chdir($filename) ? 0 : MAXINT );
}
# Unlink system call
sub sys_unlink {
# Unlink gets the file name in PC+1
# Return 0 on success, -1 on error
# Convert this to a sensible ASCII filename
my $start = $Mem[ $PC + 1 ];
my $start = $Mem[ $PC + 1 ];
my $filename = mem2arg($start);
dprintf( "unlink %s\n", $filename);
dprintf( "unlink %s\n", $filename );
# Bump up the PC and do the unlink
$PC += 2;
return( unlink($filename) ? 0 : MAXINT);
return ( unlink($filename) ? 0 : MAXINT );
}
# Time system call
sub sys_time {
# Dennis' draft says: The call sys time returns in
# the AC and MQ registers the number of sixtieths of
# a second since the start of the current year.
# Get two Datetime objects set to now
my $dt = DateTime->now;
my $dt = DateTime->now;
my $yearstart = DateTime->now;
# Set one object back to the beginning of the year
$yearstart->set( month => 1);
$yearstart->set( day => 1);
$yearstart->set( hour => 0);
$yearstart->set( minute => 0);
$yearstart->set( second => 0);
$yearstart->set( month => 1 );
$yearstart->set( day => 1 );
$yearstart->set( hour => 0 );
$yearstart->set( minute => 0 );
$yearstart->set( second => 0 );
# Get the duration in sixtieths of a second
my $duration = $dt->subtract_datetime_absolute($yearstart);
my $duration = $dt->subtract_datetime_absolute($yearstart);
my $sixtieths = $duration->seconds() * 60;
# Set MQ to the high 18 bits and AC to the low 18 bits
$MQ = $sixtieths >> 18;
$AC = $sixtieths & 0777777;
dprintf( "time %06o %06o\n", $MQ, $AC);
dprintf( "time %06o %06o\n", $MQ, $AC );
$PC += 1;
return;
}
# Status system call
sub sys_status {
# This seems to called as follows:
# law statbuf
# sys status; scrname; dd
@@ -991,37 +1112,87 @@ sub sys_status {
# Get the start address of the string
# Convert this to a sensible ASCII filename
my $start = $Mem[ $PC + 1 ];
my $start = $Mem[ $PC + 1 ];
my $filename = mem2arg($start);
dprintf( "status file %s statbuf %06o\n", $filename, $AC );
# Get the file's details
my (undef,undef,$mode,$nlink,$uid,undef,undef,$size)= stat($filename);
my ( undef, undef, $mode, $nlink, $uid, undef, undef, $size ) =
stat($filename);
# Set up the statbuf if we got a result
if ($nlink) {
$Mem[ $AC+8 ]= $uid & MAXINT;
$Mem[ $AC+9 ]= $nlink & MAXINT;
$Mem[ $AC+10 ]= $size & MAXINT; # Yes, I know, not words
$Mem[ $AC + 8 ] = $uid & MAXINT;
$Mem[ $AC + 9 ] = $nlink & MAXINT;
$Mem[ $AC + 10 ] = $size & MAXINT; # Yes, I know, not words
my $perms = 0;
$perms = 01 if ( $mode & 02 ); # World writable
$perms |= 02 if ( $mode & 04 ); # World readable
$perms |= 04 if ( $mode & 0200 ); # Owner writable
$perms |= 010 if ( $mode & 0400 ); # Owner readable
$perms |= 020 if ( -d $filename ); # Directory
$perms |= 0200000 if ( $size > 4096 ); # Large file
$Mem[$AC] = $perms;
my $perms=0;
$perms= 01 if ($mode & 02); # World writable
$perms|= 02 if ($mode & 04); # World readable
$perms|= 04 if ($mode & 0200); # Owner writable
$perms|= 010 if ($mode & 0400); # Owner readable
$perms|= 020 if ( -d $filename); # Directory
$perms|= 0200000 if ($size > 4096); # Large file
$Mem[ $AC ] = $perms;
# Set AC to zero as we got something, else return -1
$AC= 0;
} else {
$AC= MAXINT;
$AC = 0;
}
else {
$AC = MAXINT;
}
$PC += 3;
return;
}
# Seek syscall
sub sys_seek {
# Seek takes three arguments: AC is the fd, PC+1 is a signed count
# and PC+1 is how to seek: 0=from start, 1=from curptr, 2=from end
# of file. Return AC=0 if OK, -1 on error.
my $fd= $AC;
my $FH= $FD[$fd];
my $offset= $Mem[ $PC + 1 ];
# XXX For now, we always do SEEK_SET.
# If it's a binary file, we have to seek 3 bytes for every word,
# but for an ASCII file that's 2 bytes per word.
$offset *= ($ISBINARY[$fd]) ? 3 : 2;
my $result= seek($FH, $offset, SEEK_SET);
# Set the AC result
$AC= ($result)? 0: MAXINT;
$PC += 3;
return;
}
# 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 ) );
}
# Convert an ASCII string into an array of 18-bit word values
# where two characters are packed into each word. Put NUL in
# if the string has an odd number of characters. Return the array
sub ascii2words {
my $str = shift;
my @words;
for ( my $i = 0 ; $i < length($str) ; $i += 2 ) {
my $c1 = substr( $str, $i, 1 ) || "\0";
my $c2 = substr( $str, $i + 1, 1 ) || "\0";
push( @words, ( ord($c1) << 9 ) | ord($c2) );
}
return (@words);
}
# Convert an 18-bit word into two ASCII characters and return them.
# Don't return NUL characters
sub word2ascii {
@@ -1102,7 +1273,8 @@ sub get_user_command {
my $leave;
if ( defined($cmd) && defined( $Cmdlist{$cmd} ) ) {
$leave = $Cmdlist{$cmd}->( $addr, $endaddr );
} else {
}
else {
printf( "%s: unknown command\n", $cmd || "" );
cmd_help();
}