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

Merge https://github.com/DoctorWkt/pdp7-unix

Browse Source
This commit is contained in:
Tom Everett
2016-03-01 13:42:14 -07:00
parent fadbb12c9f 5bda1307c9
commit c3549ee0cc
17 changed files with 1051 additions and 772 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
Makefile Normal file
View File

@@ -0,0 +1,11 @@
# Top level makefile to build the utilities etc,
AS= tools/as7
all: utilities
utilities:
$(AS) src/cmd/cat.s > bin/cat
rm -f n.out
clean:
rm -f bin/*

2
scans/Readme
View File

@@ -46,7 +46,7 @@ init.s pages 47-51 of 07-13-19.pdf
cas.s: pages 1-17 of 04-cas.pdf
ind.b: page 2 of 08-rest.pdf
lease.b: page 4 of 08-rest.pdf
lcase.b: page 4 of 08-rest.pdf
adm.s pages 2-11 of 05-1-4.pdf
ald.s pages 13-17 of 05-1-4.pdf

14
scans/adm.s
View File

@@ -1,3 +1,4 @@
"** 05-1-4.pdf page 2
" adm
lac 017777 i
@@ -54,12 +55,13 @@ floop1:
tad d4
dac name
sys open; name; ..; 0
sys open; name: ..; 0
spa
jmp ferror
dac fi
-1
"** 05-1-4.pdf page 3
tad name
dac 8
r4
@@ -121,6 +123,7 @@ eof:
dac buf+3 " final check sum
jms putcard
jmp floop
"** 05-1-4.pdf page 4
getword: 0
lac ipt
@@ -182,6 +185,7 @@ putcard: 0
jmp floop
"** 05-1-4.pdf page 5
ferror:
lac name
dac 1f
@@ -189,7 +193,7 @@ ferror:
sys write; 1:..; 4
lac d1
sys write; 1f; 1
fmp floop1
jmp floop1
1: 077012
hangup:
@@ -249,6 +253,7 @@ flush: 0
law tbuf
dac opt
dzm noc
"** 05-1-4.pdf page 6
jmp flush i
gcard: 0
@@ -304,6 +309,7 @@ putw: 0
1: 0
putc: 0
"** 05-1-4.pdf page 7
and o177
dac opt i
-0141
@@ -364,6 +370,7 @@ connect: 0
and ilock
sna
jmp 1b
"** 05-1-4.pdf page 8
law 041
dac echoch
law 0102
@@ -425,6 +432,7 @@ retry:
jms transch
isz c2
jmp 1b
"** 05-1-4.pdf page 9
" put out etx character
2:
@@ -486,6 +494,7 @@ retry:
lac opch
sad o122
jmp i message
"** 05-1-4.pdf page 10
lac distlg
sna
jmp discon
@@ -547,6 +556,7 @@ d14: 14
o400000: 0400000
o577777: 0577777
o200500: 0200500
"** 05-1-4.pdf page 11
o122: 0122
o3: 3
o2: 2

9
scans/ald.s
View File

@@ -1,3 +1,4 @@
"** 05-1-4.pdf page 13
" ald
law 17
@@ -60,6 +61,7 @@ cloop:
tad buf+2
cma
dac c1
"** 05-1-4.pdf page 14
law buf+3
dac 10
1:
@@ -86,7 +88,7 @@ cloop:
holcard: 0
jms rawcard
lac 1f
dac buff
dac buf
lac 1f+1
dac buf+1
lac 1f+2
@@ -121,6 +123,7 @@ bincard: 0
xor 1f+2
dac 9 i
isz c
"** 05-1-4.pdf page 15
jmp 1b
jmp bincard i
1: 0;0;0
@@ -160,7 +163,7 @@ badcksum:
lac d1
sys write; m1; m1s
jms wait
cmp cloop
jmp cloop
badseq:
lac d1
@@ -182,6 +185,7 @@ timeout:
m1:
<ba>;<d 040; <ch>;<ec>;<ks>;<um>; 012
"** 05-1-4.pdf page 16
m1s = .-m1
m2:
@@ -242,6 +246,7 @@ sum: .=.+1
obuf: .=.+2048
noc: .=.+1
opt: .=.+1
"** 05-1-4.pdf page 17
systime: .=.+1
crread: .=.+1
crchar: .=.+1

61
scans/apr.s
View File

@@ -1,3 +1,4 @@
"** 05-1-4.pdf page 19
" apr
lac 017777 i
@@ -60,9 +61,10 @@ floop1:
dac 017777 i
lac name
tad d4
"** 05-1-4.pdf page 20
dac name
sys open; name; ..; 0
sys open; name: ..; 0
spa
jmp ferror
dac fi
@@ -72,7 +74,7 @@ ferror:
lac name
dac 1f
lac d1
sys write; 1;..; 4
sys write; 1:..; 4
lac d1
sys write; 1f; 1
jmp floop1
@@ -99,6 +101,13 @@ cloop:
jmp pass2
sad o10
jmp bksp
" -------------- sad o11
" jmp tab "tab:
" "isz eol
" "lac col
" "ell: >div; 5
" "jmp tab
" "jmp ell
sad o15
jmp cret
sad o40
@@ -121,6 +130,7 @@ inb2:
dac t
dac crflg
lac ch
"** 05-1-4.pdf page 21
dac t i
isz col
jmp cloop
@@ -134,7 +144,7 @@ bksp:
jmp cloop
cret:
czm col
dzm col
jmp cloop
pass2:
@@ -182,6 +192,7 @@ p2loop:
lac t i
sad o44
jmp dol
"** 05-1-4.pdf page 22
sad o41
law 045
sad o77
@@ -243,6 +254,7 @@ p2test:
getc: 0
lac ipt
"** 05-1-4.pdf page 23
sad eipt
jmp 1f
dac 2f
@@ -278,6 +290,7 @@ hangup:
abort:
lac d1
sys write; m2; m2s
jmp stop
nofiles:
lac d1
@@ -303,6 +316,7 @@ m3s = .-m3
m4:
<di>;<sc>;<on>;<ne>;<ct>;<ed>;012
m4s = .-m4
"** 05-1-4.pdf page 24
stop:
dpof
@@ -317,7 +331,7 @@ noc: 0
carrier: 0100000
ilock: 040000
totime: 300
disflg: 0
disflg: 0 " 2: both cases
casetab:
2;2;2;2;2;2;2;2
@@ -327,9 +341,9 @@ casetab:
2;1;2;2;2;0;0;2
2;2;2;2;2;0;2;2
2;2;2;2;2;2;2;2
2;2;2;2;2;2;2;1
0;0;0;0;0;0;0;0
0;0;0;0;0;0;0;0
2;2;2;2;2;2;2;1 " 0 - 100 case
0;0;0;0;0;0;0;0 " 1 - 200 case
0;0;0;0;0;0;0;0 " 2 - 300 case
0;0;0;0;0;0;0;0
0;0;0;0;0;0;2;1
2;1;1;1;1;1;1;1
@@ -341,15 +355,15 @@ gcard: 0
lac gcard i
isz gcard
sna
jmp gcard i
irss 9
sad o45
jmp 1f
jms putc
jmp gcard+1
1:
-1
tad gcard i
jmp gcard i "circled with 3f written in and to the right:
lrss 9 "3: lac noc
sad o45 "sna
jmp 1f "jmp gcard i
jms putc "sad d80
jmp gcard+1 "jmp gcard i
1: "law 040
-1 "jms putc
tad gcard i "jmp 3b
cma
dac 2f
isz gcard
@@ -364,6 +378,7 @@ gcard: 0
done:
lac noc
sna
"** 05-1-4.pdf page 25
jmp 1f
sad d72
jmp 1f
@@ -425,6 +440,7 @@ connect: 0
dac dpwrite
tad d1
dac dpchar
"** 05-1-4.pdf page 26
dzm dpstat i
las
dac opch
@@ -449,14 +465,14 @@ message: 0
dac stsch
retry:
lac dpstat i
lac dpstat i "* lac dpstat crossed through and dpstart written in
and carrier
sza
jmp retry
dprs
and ilock
sna
jmp hangup
and ilock "* arrow to note carrier drops + iloc
sna "* carrier = 0
jmp hangup "* ilock = 1
lac d1
dac dpwrite i
sys time
@@ -485,7 +501,7 @@ retry:
" echo the sequence character
lac echoch
jms transch
"** 05-1-4.pdf page 27
" if there is a buffer pointer
" put out 160 words of data
-1
@@ -546,6 +562,7 @@ retry:
and o177
sza
jmp error
"** 05-1-4.pdf page 28
" and exit
lac seqch
@@ -607,6 +624,7 @@ recvch: 0
checktim: 0
lac systime i
"** 05-1-4.pdf page 29
cma
tad rctim
spa
@@ -668,6 +686,7 @@ echoch: .=.+1
seqch: .=.+1
tbuf: .=.+144
rbuf: .=.+64
"** 05-1-4.pdf page 30
rctim: .=.+1
sum: .=.+1
ch: .=.+1

48
scans/as.s
View File

@@ -1,3 +1,4 @@
"** 05-1-4.pdf page 32
" as
jms init1
@@ -60,6 +61,7 @@ assm3:
dzm name+3
jms tlookup
-1
"** 05-1-4.pdf page 33
dac fbflg
assm4:
lac rand+1
@@ -121,6 +123,7 @@ init1: 0
init2: 0
lac d1
"** 05-1-4.pdf page 34
dac passno
sys write; 1f; 2f-1f
jms init
@@ -181,7 +184,7 @@ finis:
lac bfi
sys close
sys exit
"** 05-1-4.pdf page 35
n.out:
0156056;0157165;0164040;040040
@@ -208,7 +211,7 @@ proc1:
jmp proc2
jms bufwr
jms copyz; buf; 64
lac lyrand
lac lvrand
and o17700
dac bufadd
dac 1f
@@ -220,7 +223,7 @@ proc1:
sys read; buf; 64
proc2:
lac lyrand
lac lvrand
and o77
jms betwen; dm1; maxsto
dac maxsto
@@ -243,6 +246,7 @@ proc3:
proc4:
jms error; .>
lac d1
"** 05-1-4.pdf page 34
dac dot
dzm dot+1
jmp skip
@@ -256,12 +260,12 @@ bufwr: 0
sys seek; bufadd: 0; 0
isz maxsto
lac bfo
sys write; bufp: buf; maxstp: -1
sys write; bufp: buf; maxsto: -1
-1
dac maxsto
jmp i bufwr
Xnumber: 0
:number: 0
dac 3f
lac d1000
dac 2f
@@ -273,7 +277,7 @@ Xnumber: 0
lacq
tad o60
dac i 8
iac 2b
lac 2b
cll
idiv; 10
lacq
@@ -304,6 +308,7 @@ putsc: 0
lac i putsc
dac sctalp
isz putsc
"** 05-1-4.pdf page 37
lac i sctalp
dac sctal
add o400000
@@ -334,7 +339,7 @@ betwen: 0
cma
tad 2f
spa
jmp 2f
jmp 1f
lac i betwen
dac 3f
isz betwen
@@ -365,6 +370,7 @@ copyz: 0
isz 2f
jmp 1b
jmp i copyz
"** 05-1-4.pdf page 38
2: 0
error: 0
@@ -426,6 +432,7 @@ ioinit: 0
dac tal
-129
dac talc
"** 05-1-4.pdf page 39
jmp i ioinit
nextfil: 0
@@ -447,7 +454,7 @@ nf1:
lac fname
tad d4
dac fname
sys open; frame: 0; 0
sys open; fname: 0; 0
dac iof
sma
lac passno
@@ -487,25 +494,26 @@ gchar: 0
jms getsc; tal
sna
jmp gchar+1
"** 05-1-4.pdf page 40
sad o177
jmp gchar+1
sad o12
skp
jmp 1f
dzm comflc
dzm comflg
isz lineno
1:
sad o42
dac comflc
dac comflg
dac char
lac comflc
lac comflg
sza
jmp gchar+1
lac char
gch3:
dac char
jms betwn; d0; o200
jms betwen; d0; o200
cla
tad lactab
dac .+1
@@ -548,6 +556,7 @@ badchr:
jms gchar
lac char
sad o12
"** 05-1-4.pdf page 41
skp
jmp 1b
dac savchr
@@ -609,6 +618,7 @@ gnam3:
dac savchr
1:
lac o40
"** 05-1-4.pdf page 42
jms putsc; tal1
isz tal1c
jmp 1b
@@ -670,6 +680,7 @@ tlookup: 0
lookup: 0
dzm tlookup
1:
"** 05-1-4.pdf page 43
-1
tad namlstp
dac 8
@@ -731,6 +742,7 @@ lu2:
-3
tad 8
dac rand+1
"** 05-1-4.pdf page 44
lac tlookup
sza
jmp i tlookup
@@ -792,6 +804,7 @@ exp1:
jms grand
lac orator
sad d4
"** 05-1-4.pdf page 45
jmp exp2
jms oper; rand
jmp exp1
@@ -801,12 +814,12 @@ exp2:
dac srand
lac r+1
dac srand+1
jmp expb
jmp exp5
exp3:
sad d5
jmp exp4
jms error; x>
smp skip
jmp skip
exp4:
jms pickup
jmp i expr
@@ -853,6 +866,7 @@ opsw:
jmp .-1
jmp oplus
jmp ominus
"** 05-1-4.pdf page 46
tad r
dac r
lac r+1
@@ -914,6 +928,7 @@ o142: 0142
o40040: 040040
o56056: 056056
o56040: 056040
"** 05-1-4.pdf page 47
o146: 0146
o17777: 017777
d1000: 1000
@@ -924,7 +939,7 @@ o74: 074
o76: 076
namsiz: -2
namistp: namlst
namlstp: namlst
fnamep: fakename
lactab: lac .+1
8;8;8;8;8;8;8;8
@@ -975,6 +990,7 @@ lineno: .=.+1
fakename: .=.+6
namlst:
.=.+4
"** 05-1-4.pdf page 48
dot:
.=.+6
cmflx:
cmflx:

0
scans/lease.b → scans/lcase.b
View File

924
src/cmd/as.s
View File

File diff suppressed because it is too large Load Diff

130
src/cmd/cat.s
View File

@@ -10,17 +10,17 @@
dac name
loop:
sys open; name:0; 0; " Open file, get fd back
sys open; name:0; 0 " Open file, get fd back
spa
jmp badfile " Negative fd, exit with an error message
dac fi " save file descriptor in fi
dac fi " Save file descriptor in fi
1:
jms getc " get a character in AC
jms getc " Get a character in AC
sad o4
jmp 1f
jms putc " write the character on stdout
jmp 1b
jmp 1f " Break the loop when we get a ctrl-D
jms putc " Write the character on stdout
jmp 1b " and loop back
1:
lac fi " Close the file descriptor in fi
@@ -57,93 +57,95 @@ nofiles:
1: <no>; 040; <fi>;<le>;<s 012
done:
lac noc
lac noc " Is the number of characters left zero?
sna
sys exit
sys exit " Yes, exit
and d1
sna cla
jmp 1f
jms putc
jmp done
jms putc " Store the character in the buffer
jmp done " and loop back
1:
lac noc
rcr
dac 1f
lac noc " Get the number of characters in the buffer
rcr " Divide by two to convert to words
dac 1f " Save in the write's word count below
lac fo " Load fd 1, stdout
sys write; iopt+1; 1
sys write; iopt+1; 1:.. " Write the leftover buffer and exit
sys exit
getc: 0
lac ipt
lac ipt " Load the pointer to the next word in the buffer
sad eipt
jmp 1f
dac 2f
add o400000
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
lac 2f i
szl
lrss 9
and o177 " keep the lowest 7 bits
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
jmp getc i " return from subroutine
jmp getc+1 " Skip a NUL characters and read another one
jmp getc i " Return the character from the subroutine
1:
lac fi
lac fi " Buffer is empty, read another 64 characters
sys read; iipt+1; 64
sna
jmp 1f
tad iipt
dac eipt
lac iipt
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
jmp getc+1 " and loop back to get one character
1:
lac o4
lac o4 " No character, return with ctrl-D
jmp getc i " return from subroutine
putc: 0
and o177 " keep the lowest 7 bits
and o177 " Keep the lowest 7 bits and save into 2f+1
dac 2f+1
lac opt
dac 2f
add o400000
dac opt
spa
jmp 1f
lac 2f i
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
jmp 3f " and go to the "save it in buffer" code
1:
lac 2f+1
lac 2f+1 " Move the character up into the top half
alss 9
3:
dac 2f i
isz noc
lac noc
dac 2f i " Save the word into the buffer
isz noc " Add 1 to the char count, never skipping
lac noc " Have we reached 128 characters, 64 words?
sad d128
skp
jmp putc i
lac fo " load fd 1, stdout
sys write; iopt+1; 64
jmp putc i " No, so return (more room still in the buffer)
lac fo " Load fd1 (i.e stdout)
sys write; iopt+1; 64 " and write out the 64 words in the buffer
lac iopt
dac opt
dzm noc
jmp putc i
dac opt " Set opt pointing back to base of buffer
dzm noc " Set the number of chars in the buffer to 0
jmp putc i " and return
2: 0;0
ipt: 0
eipt: 0
iipt: .+1; .=.+64 " 64 word input buffer
fi: 0
opt: .+2
iopt: .+1; .=.+64 " 64 word output buffer
noc: 0
fo: 1 " output file descriptor, fd 1 is stdout
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: .+1; .=.+64 " 64 word input buffer and pointer to it
fi: 0 " Input file descriptor
opt: .+2 " Current output buffer base
iopt: .+1; .=.+64 " 64 word output buffer and pointer to it
noc: 0 " Number of output characters
fo: 1 " Output file descriptor, fd 1 is stdout
d1: 1 " octal and decimal constants
d1: 1 " Octal and decimal constants
o4:d4: 4
d8: 8
o400000: 0400000
o177: 0177
d128: 128
o400000: 0400000 " Msb toggle bit
o177: 0177 " ASCII mask
d128: 128 " 128 words in the output buffer

2
src/cmd/lease.b → src/cmd/lcase.b
View File

@@ -1,3 +1,4 @@
/* ** 08-rest.pdf page 4 */
main $(
auto ch;
extrn read, write;
@@ -8,6 +9,7 @@ main $(
ch = ch + 040;
if (ch==015) goto loop;
if (ch==014) goto loop;
/* -->------------------------> if (ch == 0177) goto loop; */
if (ch==011)
$( ch = 040040;
write(040040);

2
src/other/Readme Normal file
View File

@@ -0,0 +1,2 @@
This directory holds other source code for PDP-7 Unix, e.g. rewritten versions
of utilities that did not come from the original scans.

19
tools/wktcat.s → src/other/wktcat.s
View File

@@ -1,14 +1,4 @@
" Warren's cat program: cat [arg1 arg2 ...]
"
" Because the a7out simulator currently doesn't deal with ASCII files,
" here is how you can test it:
" ./as7 wktcat.s > a.out
"
" ./a7out a.out > z1
" <type some lines and end in ctrl-D>
"
" ./a7out a.out z1 z1
" <the text you typed in will be displayed twice>
main:
" Load the pointer pointer in 017777 to see if we have any arguments
@@ -32,10 +22,9 @@ catfiles:
dac fd " Save the file descriptor
fileloop:
" Read five words into the buffer from the input file
" Five was chosen arbitrarily
" Read 64 words into the buffer from the input file
lac fd
sys read; buf; 5
sys read; buf; 64
spa " Skip if result was >= 0
jmp error " Result was -ve, so error result
sna " Skip if result was >0
@@ -57,7 +46,7 @@ fileend:
sys close
" Subtract 4 from the count of argument words
lac minus4
-4
tad 017777 i
dac 017777 i
sad d4 " Is the value 4, i.e. no args left?
@@ -113,4 +102,4 @@ d8: 8 " stderr seems to have fd 8
minus4: 0777774 " Constant -4
" Input buffer for read
buf: 0; 0; 0; 0; 0
buf: .=.+64

110
src/other/wktcp.s Normal file
View File

@@ -0,0 +1,110 @@
" Warren's cp program: cp arg1 arg2
main:
" Load the pointer pointer in 017777 to see if we have any arguments
lac 017777 i
sad d12
jmp 1f " We have 12 words, so we have 2 arguments
jmp argserror " Otherwise, print an error and exit
1: lac 017777 " Move five words past the argument word count
tad d5 " so that AC points at the first argument
" Save the pointer to the file name
dac name
" Open the input file and get the fd into AC
sys open; name:0; 0;
spa
jmp badfile " Negative fd, exit with an error message
dac infd " Save the file descriptor
lac 017777 " Move nine words past the argument word count
tad d9 " so that AC points at the second argument
dac name
dac name2
" Open the ouput file and get the fd into AC
sys open; name2:0; 1;
spa
jmp badfile " Negative fd, exit with an error message
dac outfd " Save the file descriptor
fileloop:
" Read 64 words into the buffer from the input file
lac infd
sys read; buf; 64
spa " Skip if result was >= 0
jmp readerror " 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 1f
" Write five words from the buffer to the output file
lac outfd
sys write; buf; 1:0
spa " Skip if result was >= 0
jmp writeerror " Result was -ve, so error result
" and loop back for more words to read
jmp fileloop
fileend:
" Close the open file descriptors
lac infd
sys close
lac outfd
sys close
sys exit
" This code comes from the real cat.s
badfile:
lac name " Get the pointer to the filename
dac 1f " Store it in 1f below
lac d8 " Load fd 8 which is stderr
sys write; 1:0; 4 " Write the name, max 4 words
lac d8 " Then write " ?\n"
sys write; 1f; 2
sys exit " and exit
1: 040; 077012 " String literal: " ?\n"
readerror:
" Print an "err read" string on stderr and exit
lac d8
sys write; noreadstr; 5
sys exit
noreadstr:
<er>;<r 040;<re>;<ad>;012000
writeerror:
" Print an "err write" string on stderr and exit
lac d8
sys write; nowritestr; 6
sys exit
nowritestr:
<er>;<r 040;<wr>;<it>;<e 012
argserror:
" Print an "bad args" string on stderr and exit
lac d8
sys write; badargs; 5
sys exit
badargs:
<ba>;<d 040;<ar>;<gs>;012000
infd: 0 " fd of the input file
outfd: 0 " fd of the output file
d5: 5
d9: 9
d8: 8 " stderr seems to have fd 8
d12: 12
" Input buffer for read
buf: .=.+64

6
tools/write_test.s → src/other/write_test.s
View File

@@ -18,7 +18,7 @@ main:
sys write; 1:0; 7
" Try to open file fred
sys open; fred; 0; 0
sys open; fred; 0;
" read 5 words into the buffer from stdin: type in 10 or more characters!
lac d0
@@ -50,8 +50,8 @@ out: 0
hello: <He>; <l 0154; 0157 ,>; 040; <wo>; <rl>; <d 012
helloptr: hello
" fred as a string, NUL terminated
fred: 0146162; 0145144; 0
" fred as a four word filename
fred: <fr>; <ed>; 040040; 040040
" Input buffer for read
. = 0400

2
src/sys/sop.s
View File

@@ -25,7 +25,7 @@ sma = 0740100 " OPR: skip on minus AC
sza = 0740200 " OPR: skip on zero AC
snl = 0740400 " OPR: skip on non-zero link
skp = 0741000 " OPR: skip unconditionally
sna = 0741200 " OPR: skip on negative AC
sna = 0741200 " OPR: skip on non-zero AC
szl = 0741400 " OPR: skip on zero link
rtl = 0742010 " OPR: rotate two left
rtr = 0742020 " OPR: rotate two right

332
tools/a7out
View File

@@ -27,6 +27,8 @@ use constant MAXPOSINT => 0377777; # Biggest signed integer
use constant MAXADDR => 017777; # Largest memory address
use constant LINKMASK => 01000000; # Mask for LINK register
use constant EAESTEP => 077; # EAE step count mask
use constant EAEIMASK => 0777700; # EAE instruction mask
use constant SIGN => 0400000; # Sign bit
### Main program ###
@@ -35,12 +37,13 @@ while ( defined( $ARGV[0] ) && ( $ARGV[0] =~ m{^-} ) ) {
# -d: debug mode
if ( $ARGV[0] eq "-d" ) {
$debug = 1; shift(@ARGV);
$debug = 1;
shift(@ARGV);
}
# -b: set a breakpoint
if ( $ARGV[0] eq "-b" ) {
$singlestep = 1; shift(@ARGV);
shift(@ARGV);
$Breakpoint{ oct( shift(@ARGV) ) } = 1;
}
}
@@ -142,7 +145,7 @@ sub set_arguments {
my $c1 = substr( $str, $i, 1 ) || "";
my $c2 = substr( $str, $i + 1, 1 ) || "";
#printf("Saving %06o to %06o\n", (ord($c1) << 9 ) | ord($c2), $addr);
#printf("Saving %06o to %06o\n", (ord($c1) << 9 ) | ord($c2), $addr);
$Mem[ $addr++ ] = ( ord($c1) << 9 ) | ord($c2);
}
}
@@ -166,8 +169,7 @@ sub simulate {
oct("054") => \&sad,
oct("060") => \&jmp,
oct("064") => \&eae,
oct("070") => \&iot,
oct("074") => \&special,
oct("074") => \&opr,
);
# Loop indefinitely
@@ -183,18 +185,21 @@ sub simulate {
my $indaddr = ($indirect) ? $Mem[$addr] & MAXADDR : $addr;
# If this is a breakpoint, stop now and get a user command
$singlestep = 1 if ( defined( $Breakpoint{$PC} ) );
if ( defined( $Breakpoint{$PC} ) ) {
$singlestep = 1;
dprintf( "break at PC %06o\n", $PC );
}
get_user_command() if ($singlestep);
dprintf( "PC %06o: ", $PC );
#dprintf("PC %06o: instr %06o, op %03o, in %o, addr %06o indaddr %06o\n",
# $PC, $instruction, $opcode, $indirect, $addr, $indaddr );
#dprintf("PC %06o: instr %06o, op %03o, in %o, addr %06o indaddr %06o\n",
# $PC, $instruction, $opcode, $indirect, $addr, $indaddr );
# Simulate the instruction. Each subroutine updates the $PC
if ( defined( $Oplist{$opcode} ) ) {
$Oplist{$opcode}->( $instruction, $addr, $indaddr );
} else {
printf( STDERR "Unknown instruction 0%o at location 0%o\n",
printf( STDERR "Unknown instruction 0%06o at location 0%06o\n",
$instruction, $PC );
exit(1);
}
@@ -243,14 +248,18 @@ sub tad {
sub add {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "add AC (value %06o) with addr %06o (%06o)\n",
$PC, $AC, $indaddr, $Mem[$indaddr] );
$LINK = 0;
$AC = $AC + $Mem[$indaddr];
if ( $AC & LINKMASK ) {
$AC++; # End-around carry
$LINK = LINKMASK;
$AC, $indaddr, $Mem[$indaddr] );
# This logic shamelessly borrowed from SimH
# https://github.com/simh/simh/blob/master/PDP18B/pdp18b_cpu.c
my $sum = $AC + $Mem[$indaddr];
if ( $sum > MAXINT ) { # end around carry
$sum = ( $sum + 1 ) & MAXINT;
}
$AC = $AC & MAXINT;
if ( ( ( ~$AC ^ $sum ) & ( $AC ^ $sum ) ) & SIGN ) { # overflow?
$LINK = LINKMASK; # set link
}
$AC = $sum;
$PC++;
}
@@ -290,7 +299,7 @@ sub dzm {
# Index and skip if zero
sub isz {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "isz %06o\n", $Mem[$indaddr] );
dprintf( "isz %06o (value %06o)\n", $indaddr, $Mem[$indaddr] );
$Mem[$indaddr]++;
$Mem[$indaddr] &= MAXINT;
$PC += ( $Mem[$indaddr] == 0 ) ? 2 : 1;
@@ -313,79 +322,127 @@ sub jms {
$PC = $indaddr;
}
# Special instructions
sub special {
my $instruction = shift;
# OPR instructions
sub opr {
my ( $instruction, $addr, $indaddr ) = @_;
# Deal with each one in turn
# hlt
# hlt: halt simulation
if ( $instruction == 0740040 ) {
printf( STDERR "PC %06o: program halted\n", $PC );
dump_memory( 0, MAXADDR, 0 ) if ($debug);
exit(1);
}
if ( $instruction == 0741100 ) { # spa: skip on positive AC
dprintf( "spa AC %06o\n", $AC );
# Because we are dealing with 18 bits, compare the range
$PC += ( ( $AC >= 0 ) && ( $AC <= MAXPOSINT ) ) ? 2 : 1;
return;
}
if ( $instruction == 0741200 ) { # sna: skip on non-zero AC
dprintf( "sna AC %06o\n", $AC );
$PC += ( $AC != 0 ) ? 2 : 1;
return;
}
if ( $instruction == 0740200 ) { # sza: skip on zero AC
dprintf( "sza AC %06o\n", $AC );
$PC += ( $AC == 0 ) ? 2 : 1;
return;
}
if ( $instruction == 0741400 ) { # szl: Skip when $LINK is zero
dprintf( "szl LINK %0o\n", $LINK );
$PC += ( $LINK == 0 ) ? 2 : 1;
return;
}
if ( $instruction == 0740400 ) { # snl: Skip when $LINK not zero
dprintf( "snl LINK %0o\n", $LINK );
$PC += ( $LINK != 0 ) ? 2 : 1;
return;
}
if ( $instruction == 0741000 ) { # ska: skip always
dprintf("skp\n");
$PC += 2;
return;
}
# ral: rotate left or rcr: clear link then rotate left
if ( ( $instruction == 0740010 ) || ( $instruction == 0744010 ) ) {
$LINK = 0 if ( $instruction == 0744010 );
$AC = $AC << 1 + ($LINK) ? 1 : 0;
$LINK = $AC & LINKMASK;
$AC = $AC & MAXINT;
$PC++;
return;
}
# rar: rotate right or rcr: clear link then rotate right
if ( ( $instruction == 0740020 ) || ( $instruction == 0744020 ) ) {
$LINK = 0 if ( $instruction == 0744020 );
my $newlink = ( $AC & 1 ) ? LINKMASK : 0;
$AC = ( $LINK | $AC ) >> 1;
$LINK = $newlink;
$PC++;
return;
}
# law: load word into AC
if ( ( $instruction >= 0760000 ) && ( $instruction <= MAXINT ) ) {
my $indirect = ( $instruction >> 13 ) & 1;
if ($indirect) {
dprintf( "law %06o into AC\n", $instruction );
$AC = $instruction;
$PC++;
return;
}
printf( STDERR "PC %06o: unknown instruction %06o\n", $PC, $instruction );
exit(1);
# List of skip opcode names for the next section
my @skipop = (
'', 'sma', 'sza', 'sza sma',
'snl', 'snl sma', 'snl sza', 'snl sza sma',
'skp', 'spa', 'sna', 'sna spa',
'szl', 'szl spa', 'szl sna', 'szl sna spa'
);
# This logic shamelessly borrowed from SimH
# https://github.com/simh/simh/blob/master/PDP18B/pdp18b_cpu.c
my $skip = 0;
my $i = ( $instruction >> 6 ) & 017; # decode IR<8:11>
dprintf( "L.AC %d.%06o %s", ($LINK) ? 1 : 0, $AC, $skipop[$i] );
$skip = 1 if ( ( $i == 1 ) && ( $AC & SIGN ) != 0 ); # sma
$skip = 1 if ( ( $i == 2 ) && ( $AC & MAXINT ) == 0 ); # sza
$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 )
&& ( $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 )
&& ( ( $AC & MAXINT ) != 0 )
&& ( ( $AC & SIGN ) == 0 ) ); # sna & spa
$skip = 1 if ( ( $i == 014 ) && ( $LINK == 0 ) ); # szl
$skip = 1
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 )
&& ( $LINK == 0 )
&& ( $AC != 0 )
&& ( $AC != 0 ) ); # szl & sna & spa
# Clear operations
if ( $instruction & 010000 ) { # cla
dprintf(" cla"); $AC = 0;
}
if ( $instruction & 004000 ) { # cli
dprintf(" cli"); $LINK = 0;
}
if ( $instruction & 000002 ) { # cmi
dprintf(" cmi");
$LINK = ($LINK) ? 0 : LINKMASK;
}
if ( $instruction & 000001 ) { # cma
dprintf(" cma");
$AC = ( $AC ^ MAXINT ) & MAXINT;
}
# Rotate instructions
$i = $instruction & 02030;
# Single rotate right
if ( $i == 020 ) {
dprintf(" rar");
my $newlink = ( $AC & 1 ) ? LINKMASK : 0;
$AC = ( $LINK | $AC ) >> 1;
$LINK = $newlink;
}
# Double rotate right
if ( $i == 02020 ) {
dprintf(" rtr");
my $msb = ( $AC & 1 ) << 17;
my $newlink = ( $AC & 2 ) ? LINKMASK : 0;
$AC = ( ( $LINK | $AC ) >> 2 ) | $msb;
$LINK = $newlink;
}
# Single rotate left
if ( $i == 010 ) {
dprintf(" ral");
my $newlink = ( $AC & SIGN ) ? LINKMASK : 0;
my $lsb = $LINK ? 1 : 0;
$AC = ( ( $AC << 1 ) | $lsb ) & MAXINT;
$LINK = $newlink;
}
# Double rotate left
if ( $i == 02010 ) {
dprintf(" rtl");
my $newlink = ( $AC & 0200000 ) ? LINKMASK : 0;
my $lsb = ( $AC & SIGN ) ? 1 : 0;
my $twolsb = $LINK ? 2 : 0;
$AC = ( ( $AC << 2 ) | $twolsb | $lsb ) & MAXINT;
$LINK = $newlink;
}
# Impossible left and right rotates: 02030 or 00030. Do nothing!
# Note: We didn't do the oas instruction above.
$PC += 1 + $skip;
dprintf("\n");
return;
}
# cal: used for system calls
@@ -397,6 +454,7 @@ sub cal {
3 => \&sys_open,
4 => \&sys_read,
5 => \&sys_write,
6 => \&sys_creat,
9 => \&sys_close,
14 => \&sys_exit,
);
@@ -414,25 +472,23 @@ sub cal {
sub eae {
my ( $instruction, $addr, $indaddr ) = @_;
my $step = $instruction & EAESTEP;
$instruction &= EAEIMASK;
if ( $instruction == 0660500 ) { # lrss: long right shift, signed
# We ignore the MQ as it's not
# used by any user-mode programs
dprintf( "lrss %06o AC step %d\n", $AC, $step );
# Save the AC's sign into LINK
$LINK = ( $AC << 1 ) & LINKMASK;
# XXX: Do we need to preserve the AC sign?
$AC = $AC >> $step;
my $newlink = ( $AC << 1 ) & LINKMASK;
$AC = ( ( $LINK | $AC ) >> $step ) & MAXINT;
$LINK = $newlink;
$PC++;
return;
}
if ( $instruction == 0660711 ) { # alss: long left shift, signed
if ( $instruction == 0660700 ) { # alss: long left shift, signed
# We don't fill the lsb with LINK yet
dprintf( "alss %06o AC step %d\n", $AC, $step );
# Save the AC's sign into LINK
$LINK = ( $AC << 1 ) & LINKMASK;
# XXX: Do we need to preserve the AC sign?
$AC = ( $AC << $step ) & MAXINT;
$PC++;
return;
@@ -470,8 +526,32 @@ sub sys_close {
return;
}
# Common code for creat and open
sub creatopen {
my ($filename, $readorwrite)= @_;
# Open the file
if ( open( my $FH, $readorwrite, $filename ) ) {
# 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;
last;
}
}
} else {
# No filehandle, so it's an error
dprintf("open failed: $!\n");
$AC = MAXINT;
}
}
# Open system call
sub sys_open {
# Open seems to have 2 arguments: PC+1 is a pointer to the filename.
# PC+2 seems to be 1 for write, 0 for read.
# Some programs seem to have a third argument always set to 0.
@@ -480,31 +560,41 @@ sub sys_open {
# Get the start address of the string
my $start = $Mem[ $PC + 1 ];
# Convert this to a sensible ASCII filename
my $filename = mem2arg($start);
# Choose to open read-only or write-only
my $readorwrite = ( $Mem[ $PC + 2 ] ) ? ">" : "<";
dprintf( "open: base %06o, %s file %s\n", $start, $readorwrite, $filename );
# Bump up the PC
$PC += 3;
# Now open the file and return
creatopen($filename, $readorwrite);
}
# Creat system call
sub sys_creat {
# Open seems to have 1 arguments: 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
# Get the start address of the string
my $start = $Mem[ $PC + 1 ];
# Convert this to a sensible ASCII filename
my $filename = mem2arg($start);
dprintf( "open: base %06o, file %s\n", $start, $filename );
# Open the file
if ( open( my $FH, "<", $filename ) ) {
# Choose to open write-only
my $readorwrite = ">";
dprintf( "creat: base %06o, file %s\n", $start, $filename );
# 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;
last;
}
}
return;
} else {
# No filehandle, so it's an error
dprintf("open failed: $!\n");
$AC = MAXINT;
return;
}
# Bump up the PC
$PC += 2;
# Now open the file and return
creatopen($filename, $readorwrite);
}
# Read system call
@@ -537,22 +627,12 @@ sub sys_read {
$count = 0;
foreach my $addr ( $start .. $end ) {
# It's a terminal, so convert from ASCII
if ( -t $FH ) {
my $c1 = getc($FH);
last if ( !defined($c1) ); # No character, leave the loop
my $c2 = getc($FH) || ""; # No character, make it a NUL
$Mem[$addr] =
( ord($c1) << 9 ) | ord($c2); # Pack both into one word
$count++;
} else {
# otherwise (for now) read in one line and convert to octal
my $line = <$FH>;
last if ( !defined($line) ); # No line, leave the loop
chomp($line);
$Mem[$addr] = oct($line) & MAXINT;
$count++;
}
my $c1 = getc($FH);
last if ( !defined($c1) ); # No character, leave the loop
my $c2 = getc($FH) || ""; # No character, make it a NUL
$Mem[$addr] =
( ord($c1) << 9 ) | ord($c2); # Pack both into one word
$count++;
}
# No error
@@ -573,7 +653,7 @@ sub sys_write {
my $end = ( $start + $count - 1 ) & MAXADDR;
die("sys_write: bad start/end addresses $start $end\n")
if ( $end < $start );
dprintf( "write: %d words from %o to fd %d\n", $count, $start, $fd );
dprintf( "write: %d words from %06o to fd %d\n", $count, $start, $fd );
# Bump up the PC
$PC += 3;
@@ -589,13 +669,7 @@ sub sys_write {
my $FH = $FD[$fd];
foreach my $addr ( $start .. $end ) {
# It's a terminal, so convert to ASCII
# otherwise (for now) print in octal
if ( -t $FH ) {
print( $FH word2ascii( $Mem[$addr] ) );
} else {
printf( $FH "%06o\n", $Mem[$addr] );
}
print( $FH word2ascii( $Mem[$addr] ) );
}
# No error

151
tools/as7
View File

@@ -4,7 +4,7 @@
# and convert them into PDP-7 machine code
#
# (c) 2016 Warren Toomey, GPL3
# Tweaked by Phil Budne (line, expression parsing, "list" format)
# Tweaked by Phil Budne (line, expression parsing, "list", "ptr" formats)
#
use strict;
use warnings;
@@ -31,12 +31,11 @@ my $lineno; # current line number
## command line options
my $debug = 0; # Run in debug mode
my $symbols = 0; # dump symbols
my $format = 'a7out'; # output format
# keep this near the GetOptions call to make it easy to add documentation!
sub usage {
die("Usage: $0 [--debug] [--format=a7out|list ] file1.s [file2.s ...]\n")
die("Usage: $0 [--debug] [--format=a7out|list|ptr ] file1.s [file2.s ...]\n")
}
### Main program ###
@@ -48,10 +47,16 @@ GetOptions(
usage() if ( @ARGV < 1 );
# predefine syscall and opcodes as variables
# start with the location counter at zero
# predefine syscall and opcodes as variables
%Var = (
'.' => 0,
'..' => 4096, # output base addr?
# as.s does not have an initial symbol table
# (except for the above), so there must have been a
# user "ops" file
save => 1, # saves core dump & user area!
getuid => 2,
open => 3,
@@ -83,9 +88,8 @@ usage() if ( @ARGV < 1 );
# List of instruction names and machine code values
# These come from https://raw.githubusercontent.com/simh/
# simtools/master/crossassemblers/macro7/macro7.c
# PLB: replace with symbols in "sop.s"?
sys => 0000000, # cal instruction (trap thru 020)
sys => 0020000, # "cal i" instruction (trap indirect thru 020)
i => 0020000, # indirect bit
# memory reference instructions
@@ -132,42 +136,7 @@ usage() if ( @ARGV < 1 );
llss => 0660600, # long left shift, signed
alss => 0660700, # AC left shift, signed
# I/OT instructions
iot => 0700000, # base i/o transfer instruction
clsf => 0700001, # skip if RT clock overflow
iof => 0700002, # interrupts off (disable PIC)
ion => 0700042, # interrupts on (enable PIC)
iton => 0700062, # interrupt and trap on
clof => 0700004, # clear clock flag, disable clock
clon => 0700044, # clear clock flag, enable clock
rsf => 0700101, # skip if PTR flag set
rrb => 0700112, # clear PTR flag, OR buffer with AC
rcf => 0700102, # clear PTR flag
rsa => 0700104, # select PTR in alphanumeric mode
rsb => 0700144, # select PTR in binary mode
psf => 0700201, # skip if PTP flag set
pcf => 0700202, # clear PTP flag
psa => 0700204, # punch PTP in alphanumeric mode
psb => 0700244, # punch PTP in binary mode
ksf => 0700301, # skip if KBD flag set
krb => 0700312, # read KBD buffer
iors => 0700314, # input/output read status
tsf => 0700401, # skip if if TTY output flag set
tcf => 0700402, # clear TTY output flag
tls => 0700406, # load TTY output buffer and select
tts => 0703301, # Test Teleprinter and Skip
skp7 => 0703341, # skip if processor is PDP-7!
caf => 0703302, # Clear All Flags
crsf => 0706701, # skip if CDR is ready
crrb => 0706712, # read CDR buffer
crsa => 0706704, # select CDR alphanumeric mode
crsb => 0706744, # select CDR binary mode
# PLB: removed I/OT instructions: kernel uses sop.s
# Operate Instructions
@@ -205,7 +174,7 @@ usage() if ( @ARGV < 1 );
# Group 2 operate
law => 0760000, # load accumulator with (instruction)
lam => 0777777, # (load accumulator minus)
# lam => 0777777, # (load accumulator minus)
);
# Parse all the files
@@ -236,9 +205,23 @@ elsif ($format eq 'list') {
printf("%-8.8s %#06o\n", $key, $Label{$key});
}
}
elsif ($format eq 'ptr') { # dump absolute memory in PTR binary
for my $loc ( 0 .. $#Mem ) {
my $m = $Mem[$loc] || 0;
printf("%c%c%c", ($m >> 12) & 077, ($m >> 6) & 077, $m & 077);
}
}
else {
die("unknown format $format");
}
# as.s writes a binary file named n.out, ours is ascii
open (my $NOUT, ">n.out") || die "n.out";
foreach my $key (sort keys %Label) {
printf $NOUT "%-8.8s %#06o\n", $key, $Label{$key};
}
close($NOUT);
exit($errors);
# report an assmebly error:
@@ -251,7 +234,7 @@ sub err {
$errors = 1; # exit status
if ($stage == 2) {
print STDERR "$file:$lineno: $msg\n";
print "$file:$lineno: $msg\n" if (! -t STDOUT);
print "$file:$lineno: $msg\n" if (! -t STDOUT && $format ne 'ptr');
}
return 0; # expression value
}
@@ -272,52 +255,58 @@ sub parse_file {
}
# process a label and set its value to the location counter
# only called on pass 1;
# if called on pass 2, should check if values are identical
# OK for symbolic label to be entered twice, so long as it's the same value
# (ie; both passes)
sub process_label {
my $label = shift;
my $loc = $Var{'.'};
# It's a relative label, save its current value in a list
if ( $label =~ m{^\d+$} ) {
push( @{ $Rlabel{$label} }, $Var{'.'} );
printf( "Pushing %#o for relative label %s\n", $Var{'.'}, $label ) if ($debug);
return;
}
print "process_label $label\n" if ($debug);
# It's a textual label, check if it's been defined before
if ( defined( $Label{$label} ) ) {
err('M', "Label $label defined multiple times\n");
if ( $label =~ m{^\d+$} ) { # numeric (relative) label?
if ($stage == 1) {
push( @{ $Rlabel{$label} }, $loc );
printf( "Pushing %#o for label %s\n", $loc, $label ) if ($debug);
}
} # numeric label
else { # symbolic label
# error to have different values
if ( defined( $Label{$label} ) && $Label{$label} != $loc ) {
err('M', "Label $label multiply defined");
}
else {
$Label{$label} = $loc;
printf( "Set label %s to %#o\n", $label, $loc ) if ($debug);
}
}
# Otherwise, save its value
$Label{$label} = $Var{'.'};
printf( "Set label %s to %#o\n", $label, $Label{$label} ) if ($debug);
}
sub eol {
return $line eq '' || $line =~ m{^"}; # empty or comment
}
# Blame Phil for this....
# parses global $line based on prefixes, nibbling of a bit at a time
# (: and ; can appear in char literals)
# handles multiple ';' separated words per line
# allows " in character literals (tho none appear in listings)
sub parse_line {
# Lose any leading whitespace
$line =~ s{^\s*}{};
while (1) {
$line_error = ' '; # clear listing error indicator
return if ($line eq '' || $line =~ m{^"}); # empty or comment: quit
return if (eol());
# Lose any leading whitespace
$line =~ s{^\s*}{};
print "parse_line: '$line'\n" if ($debug);
while ($line =~ s{^([a-z0-9\.]+):\s*}{}) { # labels
my $label = $1;
# First pass: parse the labels
# (could check for same value on pass 2)
if ( $stage == 1 ) {
process_label($1);
}
process_label($1);
}
return if (eol());
if ( $line =~ s{^(\S+)\s*=}{}) { # assignment
my $lhs = $1;
my $word = parse_expression();
@@ -325,7 +314,7 @@ sub parse_line {
$Var{$lhs} = $word;
printf("\t%06o %s\n", $word, $line_error) if ($stage == 2 && $format eq 'list');
}
else { # bare expression
else { # bare expression (not assignment)
# Get its value on pass two and save to memory
# Also save the input line that altered memory
my $word = parse_expression();
@@ -334,7 +323,7 @@ sub parse_line {
$Mem[$location] = $word;
$Mline[$location] = $origline;
$origline = '';
if ($format eq 'list') {
if ($format eq 'list' and defined($word)) {
printf( "%06o: %06o %s\n", $location, $word, $line_error);
}
}
@@ -360,7 +349,7 @@ sub parse_expression {
my $syllable = 0;
my $op = '|';
$line =~ s{^\s+}{};
$line =~ s{^\s+}{}; # as.s accepts ",' as whitespace too!
if ($line eq '' || $line =~ m{^[";]}) { # EOL ; and " terminate expr
printf("\tparse_expression => %#o\n", $word) if ($debug);
@@ -370,19 +359,24 @@ sub parse_expression {
print " '$line'\n" if ($debug);
if ($line =~ s{^-}{}) {
print "\tfound -\n" if ($debug);
$op = '-';
}
elsif ($line =~ s{^\+}{}) {
print "\tfound +\n" if ($debug);
$op = '+';
}
if ($line =~ s{^<(.)}{}) { # <char
print "\tfound <x\n" if ($debug);
$syllable = ord($1) << 9;
}
elsif ($line =~ s{^(.)>}{}) { # char>
print "\tfound x>\n" if ($debug);
$syllable = ord($1)
}
elsif ($line =~ s{^>(.)}{}) { # >char !!
print "\tfound >x\n" if ($debug);
$syllable = ord($1)
}
elsif ($line =~ s{^([a-z\.][a-z0-9\.]*)}{}) {
@@ -401,10 +395,12 @@ sub parse_expression {
} # pass 2
} # symbol
elsif ( $line =~ s{^(\d+)([fb])}{} ) { # relative label
printf "\tfound relative: $1$2\n" if ($debug);
$syllable = find_relative_label( $1, $2 ) if ($stage == 2);
}
elsif ( $line =~ s{^(\d+)}{} ) {
elsif ( $line =~ s{^(\d+)}{} ) { # constant
my $value = $1;
printf "\tfound constant: $value\n" if ($debug);
if ( $value =~ m{^0} ) {
$syllable = oct($value);
}
@@ -424,8 +420,9 @@ sub parse_expression {
# he says, "will usually know what's wrong.
err('?', "huh? '$line'");
$line = ''; # abort processing
return $word;
return undef;
}
if ($op eq '+') {
$word += $syllable;
}
@@ -449,7 +446,7 @@ sub find_relative_label {
# Error check: no labels at all
if ( !defined( $Rlabel{$label} ) ) {
return err('U', "relative label $label not defined\n");
return err('U', "relative label $label never defined");
}
# Get the list of possible locations for this label
@@ -472,5 +469,5 @@ sub find_relative_label {
return ($reflocation) if ( $reflocation < $curlocation );
}
}
return err('U', "No relative label $label");
return err('U', "undefined relative reference $label$direction");
}