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

Makefile

@@ -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/*

scans/Readme

@@ -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

scans/adm.s

@@ -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

scans/ald.s

@@ -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

scans/apr.s

@@ -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
+   2;2;2;2;2;2;2;1	" 0 - 100 case
-   0;0;0;0;0;0;0;0
+   0;0;0;0;0;0;0;0	" 1 - 200 case
-   0;0;0;0;0;0;0;0
+   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
+   jmp gcard i	"circled with 3f written in and to the right:
-   irss 9
+   lrss 9	"3: lac noc
-   sad o45
+   sad o45	"sna
-   jmp 1f
+   jmp 1f	"jmp gcard i
-   jms putc
+   jms putc	"sad d80
-   jmp gcard+1
+   jmp gcard+1  "jmp gcard i
-1:
+1:            	"law 040
-   -1
+   -1         	"jms putc
-   tad gcard i
+   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
+   and ilock	"* arrow to note carrier drops + iloc
-   sna
+   sna		"* carrier = 0
-   jmp hangup
+   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

scans/as.s

@@ -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:

src/cmd/cat.s

@@ -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
+     jmp 1f			" Break the loop when we get a ctrl-D
-   jms putc			" write the character on stdout
+   jms putc			" Write the character on stdout
-   jmp 1b
+   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
+   jms putc			" Store the character in the buffer
-   jmp done
+   jmp done			" and loop back
 1:
-   lac noc
+   lac noc			" Get the number of characters in the buffer
-   rcr
+   rcr				" Divide by two to convert to words
-   dac 1f
+   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
+     jmp 1f			" We've reached the end of the buffer, so read more
-   dac 2f
+   dac 2f			" Save the pointer
-   add o400000
+   add o400000			" Flip the msb and save into ipt
    dac ipt
-   ral
+   ral				" Move the msb into the link register
-   lac 2f i
+   lac 2f i			" Load the word from the buffer
-   szl
+   szl				" Skip if this is the second character in the word
-   lrss 9
+     lrss 9			" It's the first char, shift down the top character
-   and o177			" keep the lowest 7 bits
+   and o177			" Keep the lowest 7 bits
    sna
-     jmp getc+1
+     jmp getc+1			" Skip a NUL characters and read another one
-   jmp getc i			" return from subroutine
+   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
+     jmp 1f			" No characters were read in
-   tad iipt
+   tad iipt			" Add the word count to the base of the buffer
-   dac eipt
+   dac eipt			" and store in the end buffer pointer
-   lac iipt
+   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
+   lac opt			" Save the pointer to the empty buffer
-   dac 2f
+   dac 2f			" position to 2f
-   add o400000
+   add o400000			" Flip the msb and save back into opt
-   dac opt
+   dac opt			" This also has the effect of incrementing
-   spa
+				" the opt pointer every second addition!
-     jmp 1f
+
-   lac 2f i
+   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
+   dac 2f i			" Save the word into the buffer
-   isz noc
+   isz noc			" Add 1 to the char count, never skipping
-   lac noc
+   lac noc			" Have we reached 128 characters, 64 words?
    sad d128
      skp
-   jmp putc i
+   jmp putc i			" No, so return (more room still in the buffer)
-   lac fo			" load fd 1, stdout
+   lac fo			" Load fd1 (i.e stdout)
-   sys write; iopt+1; 64
+   sys write; iopt+1; 64	" and write out the 64 words in the buffer
    lac iopt
-   dac opt
+   dac opt			" Set opt pointing back to base of buffer
-   dzm noc
+   dzm noc			" Set the number of chars in the buffer to 0
-   jmp putc i
+   jmp putc i			" and return
 
-2: 0;0
+2: 0;0				" Current input and output word pointers
-ipt: 0
+ipt: 0				" Current input buffer base
-eipt: 0
+eipt: 0				" Pointer to end of data read in input buffer
-iipt: .+1; .=.+64		" 64 word input buffer
+iipt: .+1; .=.+64		" 64 word input buffer and pointer to it
-fi: 0
+fi: 0				" Input file descriptor
-opt: .+2
+opt: .+2			" Current output buffer base
-iopt: .+1; .=.+64		" 64 word output buffer
+iopt: .+1; .=.+64		" 64 word output buffer and pointer to it
-noc: 0
+noc: 0				" Number of output characters
-fo: 1				" output file descriptor, fd 1 is stdout
+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
+o400000: 0400000		" Msb toggle bit
-o177: 0177
+o177: 0177			" ASCII mask
-d128: 128
+d128: 128			" 128 words in the output buffer

src/cmd/lcase.b

@@ -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);

src/other/Readme

@@ -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.

src/other/wktcat.s

@@ -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
+   " Read 64 words into the buffer from the input file
-   " Five was chosen arbitrarily
    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

src/other/wktcp.s

@@ -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

src/other/write_test.s

@@ -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 as a four word filename
-fred: 0146162; 0145144; 0
+fred: <fr>; <ed>; 040040; 040040
 
 " Input buffer for read
 . = 0400

src/sys/sop.s

@@ -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

tools/a7out

@@ -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;
     }
 }
@@ -166,8 +169,7 @@ sub simulate {
         oct("054") => \&sad,
         oct("060") => \&jmp,
         oct("064") => \&eae,
-        oct("070") => \&iot,
+        oct("074") => \&opr,
-        oct("074") => \&special,
     );
 
     # Loop indefinitely
@@ -183,7 +185,10 @@ 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 );
 
@@ -194,7 +199,7 @@ sub simulate {
         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] );
+        $AC, $indaddr, $Mem[$indaddr] );
-    $LINK = 0;
+
-    $AC   = $AC + $Mem[$indaddr];
+    # This logic shamelessly borrowed from SimH
-    if ( $AC & LINKMASK ) {
+    # https://github.com/simh/simh/blob/master/PDP18B/pdp18b_cpu.c
-        $AC++;    # End-around carry
+    my $sum = $AC + $Mem[$indaddr];
-        $LINK = LINKMASK;
+    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
+# OPR instructions
-sub special {
+sub opr {
-    my $instruction = shift;
+    my ( $instruction, $addr, $indaddr ) = @_;
 
-    # Deal with each one in turn
+    # hlt: halt simulation
-    # hlt
     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;
+        my $newlink = ( $AC << 1 ) & LINKMASK;
-
+        $AC = ( ( $LINK | $AC ) >> $step ) & MAXINT;
-        # XXX: Do we need to preserve the AC sign?
+        $LINK = $newlink;
-        $AC = $AC >> $step;
         $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
+    # Choose to open write-only
-    if ( open( my $FH, "<", $filename ) ) {
+    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
+    # Bump up the PC
-        foreach my $fd ( 0 .. 99 ) {
+    $PC += 2;
-            if ( !defined( $FD[$fd] ) ) {
+
-                $FD[$fd] = $FH;
+    # Now open the file and return
-                $AC = $fd;
+    creatopen($filename, $readorwrite);
-                last;
-            }
-        }
-        return;
-    } else {
-        # No filehandle, so it's an error
-        dprintf("open failed: $!\n");
-        $AC = MAXINT;
-        return;
-    }
 }
 
 # 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++;
-        }
     }
 
     # 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] );
-        }
     }
 
     # No error

tools/as7

@@ -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    => 0020000,		# "cal i" instruction (trap indirect thru 020)
-    sys    => 0000000,		# cal instruction (trap 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
+    # PLB: removed I/OT instructions: kernel uses sop.s
-    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
 
     # 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,51 +255,57 @@ sub parse_file {
 }
 
 # process a label and set its value to the location counter
-# only called on pass 1;
+# OK for symbolic label to be entered twice, so long as it's the same value
-# if called on pass 2, should check if values are identical
+# (ie; both passes)
 sub process_label {
     my $label = shift;
+    my $loc = $Var{'.'};
 
-    # It's a relative label, save its current value in a list
+    print "process_label $label\n" if ($debug);
-    if ( $label =~ m{^\d+$} ) {
+
-        push( @{ $Rlabel{$label} }, $Var{'.'} );
+    if ( $label =~ m{^\d+$} ) { # numeric (relative) label?
-        printf( "Pushing %#o for relative label %s\n", $Var{'.'}, $label ) if ($debug);
+	if ($stage == 1) {
-        return;
+	    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);
+	}
+    }
 }
 
-    # It's a textual label, check if it's been defined before
+sub eol {
-    if ( defined( $Label{$label} ) ) {
+    return $line eq '' || $line =~ m{^"}; # empty or comment
-	err('M', "Label $label defined multiple times\n");
-    }
-    # Otherwise, save its value
-    $Label{$label} = $Var{'.'};
-    printf( "Set label %s to %#o\n", $label, $Label{$label} ) if ($debug);
 }
 
 # 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);
 	}
-	}
+
+	return if (eol());
 
 	if ( $line =~ s{^(\S+)\s*=}{}) { # assignment
 	    my $lhs = $1;
@@ -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");
 }