From a17ba2eec37812ebedfef7eaadc09fea9eeacdb5 Mon Sep 17 00:00:00 2001 From: rswier Date: Mon, 29 Feb 2016 23:21:52 -0500 Subject: [PATCH 01/18] Renamed lease.b to lcase.b lcase.b is a filter program that converts upper to lower case, tabs to spaces, and removes form feed and carriage returns. --- scans/Readme | 2 +- scans/{lease.b => lcase.b} | 0 2 files changed, 1 insertion(+), 1 deletion(-) rename scans/{lease.b => lcase.b} (100%) diff --git a/scans/Readme b/scans/Readme index 30daf4c..ab26203 100644 --- a/scans/Readme +++ b/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 diff --git a/scans/lease.b b/scans/lcase.b similarity index 100% rename from scans/lease.b rename to scans/lcase.b From 223b1384123b2538655f74a3768e9dd6308627a9 Mon Sep 17 00:00:00 2001 From: rswier Date: Tue, 1 Mar 2016 00:32:57 -0500 Subject: [PATCH 02/18] Renamed lease.b to lcase.b lcase.b is a filter program that converts upper to lower case, tabs to spaces, and removes form feed and carriage returns. --- src/cmd/{lease.b => lcase.b} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/cmd/{lease.b => lcase.b} (100%) diff --git a/src/cmd/lease.b b/src/cmd/lcase.b similarity index 100% rename from src/cmd/lease.b rename to src/cmd/lcase.b From 34e1dda60c54eed8d8c1aacfd00feb91329619ea Mon Sep 17 00:00:00 2001 From: Phil Budne Date: Mon, 29 Feb 2016 23:33:41 -0500 Subject: [PATCH 03/18] fix a typo in betwen --- scans/as.s | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/scans/as.s b/scans/as.s index 42a6c1b..8fc5957 100644 --- a/scans/as.s +++ b/scans/as.s @@ -208,7 +208,7 @@ proc1: jmp proc2 jms bufwr jms copyz; buf; 64 - lac lyrand + lac lvrand and o17700 dac bufadd dac 1f @@ -220,7 +220,7 @@ proc1: sys read; buf; 64 proc2: - lac lyrand + lac lvrand and o77 jms betwen; dm1; maxsto dac maxsto @@ -256,12 +256,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 +273,7 @@ Xnumber: 0 lacq tad o60 dac i 8 - iac 2b + lac 2b cll idiv; 10 lacq @@ -334,7 +334,7 @@ betwen: 0 cma tad 2f spa - jmp 2f + jmp 1f lac i betwen dac 3f isz betwen @@ -447,7 +447,7 @@ nf1: lac fname tad d4 dac fname - sys open; frame: 0; 0 + sys open; fname: 0; 0 dac iof sma lac passno @@ -492,20 +492,20 @@ gchar: 0 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 @@ -801,12 +801,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 @@ -924,7 +924,7 @@ o74: 074 o76: 076 namsiz: -2 -namistp: namlst +namlstp: namlst fnamep: fakename lactab: lac .+1 8;8;8;8;8;8;8;8 @@ -977,4 +977,4 @@ namlst: .=.+4 dot: .=.+6 -cmflx: \ No newline at end of file +cmflx: From 1d10561c7edd3b1698fc9805251437a473803b4b Mon Sep 17 00:00:00 2001 From: Phil Budne Date: Tue, 1 Mar 2016 01:40:39 -0500 Subject: [PATCH 04/18] a starting stab at as annotation --- src/cmd/as.s | 924 +++++++++++++++++++++++++++------------------------ 1 file changed, 483 insertions(+), 441 deletions(-) diff --git a/src/cmd/as.s b/src/cmd/as.s index 42a6c1b..af36131 100644 --- a/src/cmd/as.s +++ b/src/cmd/as.s @@ -1,40 +1,41 @@ +"** 05-1-4.pdf page 32 " as - jms init1 + jms init1 " initialize assm1: lac eofflg - sza - jmp assm2 + sza " saw EOF? + jmp assm2 " no. lac passno - sza - jmp finis - jms init2 + sza " pass==0? + jmp finis " no, pass 2: done + jms init2 " pass 1: init for pass2 assm2: - jms gchar - sad d4 - jmp assm1 - sad d5 - jmp assm1 + jms gchar " get character + sad d4 " comma space or tab? + jmp assm1 " yes, ignore + sad d5 " newline or ';'?? + jmp assm1 " yes, ignore lac char - dac savchr + dac savchr " no, push back jms gpair lac rator - jms betwen; d1; d6 - jmp assm3 + jms betwen; d1; d6 " plus, minus, space comma tab or semi? + jmp assm3 " no jms expr lac passno - sza - jms process - isz dot+1 + sza " pass 1? + jms process " no, process on pass 2 + isz dot+1 " increment "." nop lac dot+1 and o17777 - sad dot+1 - jmp assm1 - jms error; >> - dzm dot+1 + sad dot+1 " overflow? + jmp assm1 " no + jms error; >> " '>' error: past end of memory + dzm dot+1 " start again at zero! jmp assm1 assm3: @@ -43,24 +44,25 @@ assm3: jmp assm4 sza jmp assm6 - lac rator - sza - jmp assm6 + lac rator " fetch operator + sza " ":"? + jmp assm6 " no lac rand+1 - jms betwen; dm1; d10 - jmp assm6 - dac name + jms betwen; dm1; d10 " numeric and 0..9? + jmp assm6 " no + dac name " yes, save as name tad fbxp dac lvrand - lac i lvrand - dac name+1 - isz i lvrand - lac o146 - dac name+2 - dzm name+3 - jms tlookup + lac i lvrand " get fbx entry + dac name+1 " save in second word of name + isz i lvrand " increment fbx entry + lac o146 " get 'f' + dac name+2 " save in third word of name + dzm name+3 " clear fourth word + jms tlookup " look it up -1 - dac fbflg +"** 05-1-4.pdf page 33 + dac fbflg " set fbflg to -1 assm4: lac rand+1 tad d4 @@ -68,10 +70,10 @@ assm4: lac rator sza jmp assm5 - lac dot - dac r - lac dot+1 - dac r+1 + lac dot " load dot type + dac r " save as r type + lac dot+1 " get dot value + dac r+1 " save as r value jmp 1f assm5: @@ -84,87 +86,88 @@ assm5: lac r+1 dac i lvrand lac fbflg - sna - jmp assm1 - dzm fbflg + sna " fb flag set? + jmp assm1 " no + dzm fbflg " clear fb flag dzm name+1 - lac o142 + lac o142 " get 'b' dac name+2 jms lookup jmp assm4 assm6: - jms error; x> + jms error; x> " "x" error -- various errors jmp assm1 -init1: 0 +init1: 0 " init for pass 1 lac d1 - sys write; 1f; 2f-1f - dzm passno - lac o56040 + sys write; 1f; 2f-1f " output I, newline + dzm passno " clear passno + lac o56040 " load ". " dac dot-4 - lac o56056 + lac o56056 " load ".." dac cmflx-4 - lac o40040 + lac o40040 " pad ". " and ".." names with spaces dac dot-3 dac dot-2 dac dot-1 dac cmflx-3 dac cmflx-2 dac cmflx-1 - dzm iof + dzm iof " clear input fd jms init jmp i init1 1: - 0111012 + 0111012 " I\n 2: -init2: 0 +init2: 0 " start pass 2 lac d1 - dac passno - sys write; 1f; 2f-1f +"** 05-1-4.pdf page 34 + dac passno " passno = 1 + sys write; 1f; 2f-1f " output II jms init lac o17 - sys creat; 2f + sys creat; 2f " create a.out dac bfo - sys open; 2f; 0 + sys open; 2f; 0 " open a.out for read too! dac bfi dzm bufadd - jms copyz; buf; 64 + jms copyz; buf; 64 " clear buffer jmp i init2 1: - 0111111;012000 + 0111111;012000 " II\n 2: - 0141056;0157165;0164040;040040 + 0141056;0157165;0164040;040040 " a.out -init: 0 +init: 0 " common init for both passes lac i 017777 - dac narg + dac narg " save arg count lac 017777 tad d1 - dac fname + dac fname " point to first file name -1 dac eofflg jms ioinit - dzm savchr - dzm comflg + dzm savchr " clear saved char + dzm comflg " clear line comment flag lac d1 - dac dot - dzm dot+1 - dzm cmflx - lac d4096 + dac dot " set "." type to one?? + dzm dot+1 " clear "." value?? + dzm cmflx " set ".." type to zero?? + lac d4096 " set ".." value to 4K dac cmflx+1 - dzm fbflg + dzm fbflg " clear f/b flag and array jms copyz; fbxp: fbx; 10 - jmp i init + jmp i init " return finis: - lac iof + lac iof " close input file sys close - jms bufwr - lac bfi + jms bufwr " flush output buffer + lac bfi " close a.out input fd sys close - lac bfo + lac bfo " close a.out output fd sys close -1 tad namsiz @@ -175,26 +178,27 @@ finis: tad char dac 1f lac o17 - sys creat; n.out + sys creat; n.out " create "n.out" dac bfi - sys write; namlst; 1: 0 + sys write; namlst; 1: 0 " write name list lac bfi - sys close + sys close " close n.out sys exit +"** 05-1-4.pdf page 35 n.out: - 0156056;0157165;0164040;040040 + 0156056;0157165;0164040;040040 " n.out process: 0 - lac dot+1 + lac dot+1 " get "." value dac lvrand - lac dot - sad d3 - jmp proc4 - sza - jmp proc1 + lac dot " get "." type?? + sad d3 " three? + jmp proc4 " no, give "." error + sza " zero? + jmp proc1 " no -1 - tad cmflx+1 + tad cmflx+1 " '..' - 1 cma tad lvrand dac lvrand @@ -203,25 +207,25 @@ proc1: lac lvrand spa jmp proc4 - and o17700 - sad bufadd - jmp proc2 - jms bufwr - jms copyz; buf; 64 - lac lyrand + and o17700 " mask to block + sad bufadd " same block as buffer? + jmp proc2 " yes, same block + jms bufwr " different block, write out current block + jms copyz; buf; 64 " clear buffer + lac lvrand and o17700 dac bufadd dac 1f lac bfi - sys seek; 1: 0; 0 + sys seek; 1: 0; 0 " seek to current block from file spa jmp proc2 lac bfi sys read; buf; 64 proc2: - lac lyrand - and o77 + lac lvrand + and o77 " get word within block jms betwen; dm1; maxsto dac maxsto tad bufp @@ -231,7 +235,7 @@ proc2: jmp proc3 sad d3 jmp proc5 - lac cmflx+1 + lac cmflx+1 " get ".." value tad r+1 dac r+1 @@ -243,25 +247,26 @@ proc3: proc4: jms error; .> lac d1 - dac dot - dzm dot+1 + dac dot " set '.' type to 1 +"** 05-1-4.pdf page 36 + dzm dot+1 " clear dot value jmp skip proc5: jms error; u> jmp proc3 -bufwr: 0 +bufwr: 0 " write current buffer to a.out file lac bfo 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 " print decimal number? dac 3f lac d1000 dac 2f @@ -273,7 +278,7 @@ Xnumber: 0 lacq tad o60 dac i 8 - iac 2b + lac 2b cll idiv; 10 lacq @@ -283,96 +288,116 @@ Xnumber: 0 jmp i number 3: 0 + " get character from buffer + " call with: + " jms getsc; pointer_pointer + " where pointer_pointer contains a pointer to buffer getsc: 0 - lac i getsc - dac sctalp - isz getsc - lac i sctalp - dac sctal - add o400000 - dac i sctalp - ral - lac i sctal - szl - lrss 9 - and o177 - jmp i getsc + lac i getsc " get pointer pointer + dac sctalp " save + isz getsc " skip pointer pointer + lac i sctalp " fetch pointer + dac sctal " save + add o400000 " toggle high bit of pointer + dac i sctalp " save pointer back + ral " rotate high bit into link reg + lac i sctal " load word from buffer + szl " skip if link zero + lrss 9 " link set: get high char from word + and o177 " strip to 7 bits + jmp i getsc " return + " save characters: word after call is addr of pointer, -count pair + " high bit in pointer used to indicate high or low byte next? putsc: 0 - and o177 - lmq - lac i putsc - dac sctalp - isz putsc - lac i sctalp - dac sctal - add o400000 - dac i sctalp - sma cla - jmp 1f - llss 27 - dac i sctal - lrss 9 - jmp i putsc + and o177 " strip character to 7 bits + lmq " save in MQ + lac i putsc " get address of pointer + dac sctalp " save + isz putsc " skip over pointer to pointer +"** 05-1-4.pdf page 37 + lac i sctalp " get pointer + dac sctal " save + add o400000 " toggle sign bit by adding -0 + dac i sctalp " save pointer + sma cla " skip if minus & clear AC + jmp 1f " AC positive + llss 27 " get char in high 9 bits, zero in low + dac i sctal " store word + lrss 9 " shift char back down + jmp i putsc " return 1: - lac i sctal - omq - dac i sctal - lacq - jmp i putsc + lac i sctal " load target word + omq " or in char from MQ + dac i sctal " save word back + lacq " restore character + jmp i putsc " return sctalp: 0 sctal: 0 + " test if between two values (low,high] + " call with value in AC + " jms betwen; lowptr; highptr + " skip returns if AC in range + " AC returned unmodified + " NOTE! + " the test appears to be non-inclusive + " on the low side, and inclusive on the high side + betwen: 0 - dac 2f - lac i betwen - dac 3f - isz betwen - lac i 3f + dac 2f " save value to test + lac i betwen " load range start addr + dac 3f " save + isz betwen " increment return PC + lac i 3f " load range start + cma " complement + tad 2f " AC = AC - start - 1 + spa " still positive? + jmp 1f " no + lac i betwen " load range end addr + dac 3f " save + isz betwen " skip range high on return + lac i 3f " load range high cma - tad 2f - spa - jmp 2f - lac i betwen - dac 3f - isz betwen - lac i 3f - cma - tad d1 - tad 2f - spa + tad d1 " negate AC (~AC + 1) + tad 2f " add test value + spa " if not positive, don't skip on return!! 1: - isz betwen - lac 2f - jmp i betwen + isz betwen " discard "high" (or skip return)! + lac 2f " restore AC + jmp i betwen " return 2: 0 3: 0 + " zero a block of memory + " call with: + " jms copyz; ptr; count copyz: 0 -1 - tad i copyz - dac 8 - isz copyz - lac i copyz - cma + tad i copyz " get address-1 + dac 8 " store in first "index register" + isz copyz " skip over address + lac i copyz " load count + cma " get -count tad d1 - dac 2f - isz copyz + dac 2f " save + isz copyz " skip over count 1: - dzm i 8 - isz 2f - jmp 1b - jmp i copyz + dzm i 8 " increment index, clear word + isz 2f " increment count, skip if done + jmp 1b " not done, loop + jmp i copyz " done: return +"** 05-1-4.pdf page 38 2: 0 error: 0 - lac passno - sza - jmp 1f - isz error - jmp i error + lac passno " get pass number + sza " pass one? + jmp 1f " no, pass two + isz error " pass one: skip error char + jmp i error " return 1: -1 tad mesp @@ -385,7 +410,7 @@ error: 0 sad d5 jmp 1f lac savchr - sad o12 + sad o12 jmp 1f lac lineno jmp 2f @@ -407,330 +432,337 @@ error: 0 jmp i error skip: - lac rator - sad d5 - jmp assm1 + lac rator " get operator + sad d5 " EOL? + jmp assm1 " yes, start from top 1: - jms gchar - sad d5 - jmp assm1 + jms gchar " loop until ';' or NL seen + sad d5 " EOL? + jmp assm1 " yes, start from top jmp 1b ioinit: 0 - jms copyz; iobuf; 64 + jms copyz; iobuf; 64 " clear iobuf lac iof - sys read; iobufp: iobuf; 64 - sna - jms nextfil - lac iobufp - dac tal - -129 - dac talc - jmp i ioinit + sys read; iobufp: iobuf; 64 " read from input + sna " EOF? + jms nextfil " yes, skip to next file + lac iobufp " load iobuf pointer + dac tal " save + -129 " get -bytecount-1 + dac talc " save as count +"** 05-1-4.pdf page 39 + jmp i ioinit " return -nextfil: 0 +nextfil: 0 " advance to next file lac d1 - dac lineno - lac iof - sza - sys close + dac lineno " reset lineno to 1 + lac iof " load input fd + sza " zero? + sys close " no: close nf1: - lac narg - sad d4 - skp - jmp 1f - dzm eofflg - jmp i nextfil + lac narg " load arg count + sad d4 " ==4? (done) + skp " yes, skip + jmp 1f " no + dzm eofflg " flag eof (set to zero) + jmp i nextfil " return 1: - tad dm4 - dac narg - lac fname - tad d4 - dac fname - sys open; frame: 0; 0 - dac iof - sma - lac passno - sna - jmp nextfil i - lac fname - dac 1f + tad dm4 " subtract 4 + dac narg " store narg + lac fname " get fname pointer + tad d4 " subtract 4 + dac fname " save fname + sys open; fname: 0; 0 " open fname + dac iof " save fd + sma " open ok? + lac passno " yes, load pass number + sna " open failed: skip or open ok, pass 2 + jmp nextfil i " pass 1, open OK, return. + lac fname " load filename pointer + dac 1f " save for write + lac d1 " stdout + sys write; 1; 0; 4 " output filename + lac iof " load fd + sma " open ok? + jmp 1f " yes, continue lac d1 - sys write; 1; 0; 4 - lac iof - sma - jmp 1f - lac d1 - sys write; emes; 2 - sys exit + sys write; emes; 2 " output "? \n" + sys exit " quit. 1: lac d1 - sys write; emes+1; 1 - jmp i nextfil + sys write; emes+1; 1 " output newline after filename + jmp i nextfil " return emes: - 040077;012000 + 040077;012000 " question mark, space, newline gchar: 0 - lac savchr - dzm savchr - sza - jmp gch3 - lac eofflg - sza - jmp 1f - lac o12 - jmp gch3 + lac savchr " load saved char + dzm savchr " clear saved char + sza " was there a saved char? + jmp gch3 " yes, process it + lac eofflg " no: get eof flag + sza " seen eof (zero if true) + jmp 1f " no. + lac o12 " yes: get NL + jmp gch3 " process it 1: - isz talc - skp - jms ioinit - jms getsc; tal - sna - jmp gchar+1 - sad o177 - jmp gchar+1 - sad o12 - skp - jmp 1f - dzm comflc - isz lineno + isz talc " increment (negative count): is it zero? + skp " non-zero: skip + jms ioinit " count was zero: call ioinit + jms getsc; tal " fetch character + sna " is char non-zero? + jmp gchar+1 " no: char is zero, get another +"** 05-1-4.pdf page 40 + sad o177 " is char 0177 + jmp gchar+1 " yes, ignore it + sad o12 " is char newline? + skp " yes + jmp 1f " no + dzm comflg " saw newline: clear comflg + isz lineno " increment line number 1: - sad o42 - dac comflc - dac char - lac comflc - sza - jmp gchar+1 - lac char + sad o42 " is char '"'? + dac comflg " yes, set comflg + dac char " save char + lac comflg " load comflg + sza " comflg clear? + jmp gchar+1 " no: ignore reset of line + lac char " get char gch3: - dac char - jms betwn; d0; o200 - cla - tad lactab - dac .+1 - lac 0 - jmp i gchar + dac char " save char in char + jms betwen; d0; o200 " legal char? + cla " no, clear + tad lactab " add to "lac labtab+1" + dac .+1 " save as next instruction + lac 0 " get character class in AC + jmp i gchar " return gsymb: 0 - jms gchar - dac rator - tad jmpsw1 - dac 1f - lac char - sad o74 - jmp lqot - dac namc - jms gchar - lac char - sad o76 - jmp rqot - dac savchr - lac namc - dac char + jms gchar " get char + dac rator " save class + tad jmpsw1 " add table base instruction + dac 1f " save for later + lac char " what was it? + sad o74 " '<'?? + jmp lqot " yes: process as "left quote" + dac namc " no, save as namc + jms gchar " get another + lac char " what was it? + sad o76 " '>'? + jmp rqot " yes: process "right quote" + dac savchr " no: save as savchr + lac namc " restore first char + dac char " resave as "char" 1: - jmp 0 + jmp 0 " jmpsw1[0] + class +jmpsw1: " indexed by character class + jmp .+1 " base instruction (added to class) + jmp i gsymb " 0: ":" return + jmp i gsymb " 1: "=" return + jmp i gsymb " 2: "+" return + jmp i gsymb " 3: "-" return + jmp gs1 " 4: comma, space, tab + jmp i gsymb " 5: EOL (semi, newline) + jmp gs2 " 6: dot, star, letter + jmp gs3 " 7: digits -jmpsw1: - jmp .+1 - jmp i gsymb - jmp i gsymb - jmp i gsymb - jmp i gsymb - jmp gs1 - jmp i gsymb - jmp gs2 - jmp gs3 - -badchr: - jms error; g> +badchr: " here with bad char (class 8) + jms error; g> " error "g" 1: - jms gchar + jms gchar " discard until newline lac char sad o12 +"** 05-1-4.pdf page 41 skp jmp 1b - dac savchr - jmp gsymb+1 + dac savchr " push newline back + jmp gsymb+1 " restart gsymb -lqot: - jms gchar +lqot: " left quote (<) + jms gchar " get another char lac o40 - dac savchr - lac char - alss 9 - jmp 1f + dac savchr " put a space in savchr + lac char " get quoted character + alss 9 " shift up 9 bits + jmp 1f " join with right quote -rqot: - lac namc +rqot: " right quote (>) + lac namc " get previous(?) char 1: dac rand+1 lac d7 dac rator jmp i gsymb -gs1: - jms gchar - sad d4 - jmp gs1 - lac char +gs1: " here with space, tab, comma + jms gchar " get another char + sad d4 " another space? + jmp gs1 " yes, loop + lac char " no, save for later dac savchr - jmp i gsymb + jmp i gsymb " return -gs2: - lac namep - dac tal1 - -7 - dac tal1c - lac char - jms putsc; tal1 +gs2: " here with dot, star, letter + lac namep " load name buffer pointer + dac tal1 " save in temp pointer + -7 " load negative char count + dac tal1c " save as temp counter + lac char " restore char + jms putsc; tal1 " save it in name buffer -gnam1: +gnam1: " here to collect a name jms gchar - jms betwen; d5; d8 - jmp gnam3 + jms betwen; d5; d8 " alphanumeric? + jmp gnam3 " no, done lac char jms putsc; tal1 isz tal1c jmp gnam1 -gnam2: - jms gchar - jms betwen; d5; d8 - skp - jmp gnam2 +gnam2: " here when 8 characters read, eat the rest + jms gchar " next char + jms betwen; d5; d8 " alphanumeric? + skp " no + jmp gnam2 " yes, loop lac char - dac savchr - jms lookup - jmp i gsymb + dac savchr " push last char back + jms lookup " look up symbol + jmp i gsymb " return -gnam3: - lac char +gnam3: " here before 8 characters + lac char " push last char back dac savchr 1: - lac o40 + lac o40 " pad to 8 with spaces +"** 05-1-4.pdf page 42 jms putsc; tal1 isz tal1c jmp 1b jms lookup jmp i gsymb -gs3: - dzm rand+1 +gs3: " here with digit + dzm rand+1 " clear number lac char - sad o60 - jmp 1f - lac d10 + sad o60 " zero? + jmp 1f " yes + lac d10 " no: process as decimal jmp 2f 1: - lac d8 + lac d8 " leading zero: process as octal 2: - dac num2 + dac num2 " save radix num1: - lac rand+1 - cll - mul -num2: 0 - lacq - tad char - tad dm48 - dac rand+1 - jms gchar - sad d7 - jmp num1 - lac char - dac savchr - lac rand+1 - jms betwen; dm1; d10 - jmp i gsymb + lac rand+1 " get number + cll " clear link + mul " mutiply by radix +num2: 0 " (radix stored here) + lacq " get multiply result + tad char " add char + tad dm48 " subtract '0' + dac rand+1 " save + jms gchar " get another + sad d7 " digit? + jmp num1 " yes: process + lac char " no: get it + dac savchr " push back + lac rand+1 " get number + jms betwen; dm1; d10 " between 0..9? + jmp i gsymb " no, return dac name - tad fbxp - dac name+1 - lac i name+1 - dac name+1 - lac savchr - sad o146 - jmp 1f - sad o142 - skp - jmp i gsymb - dzm name+1 -1: - dac name+2 - dzm name+3 - lac d6 - dac rator - jms lookup - dzm savchr + tad fbxp " make index into "fbx" array + dac name+1 " ???save??? (crushed below) + lac i name+1 " fetch fbx array entry + dac name+1 " save fbx count in name + lac savchr " get break character + sad o146 " was it 'f'? + jmp 1f " yes + sad o142 " 'b'? + skp " yes + jmp i gsymb " not f or b, return + dzm name+1 " 'b': clear loaded fbx entry???? +1: " here with DIGITS[fb] + dac name+2 " save f/b in third word of name + dzm name+3 " clear last word of name + lac d6 " class 6: alpha, dot star + dac rator " save as (ope)rator + jms lookup " lookup (create) symbol entry???? + dzm savchr " clear saved char jmp i gsymb + " symbol lookup/creation + " tlookup doesn't create new entries??? tlookup: 0 jmp 1f lookup: 0 - dzm tlookup + dzm tlookup " NOT a tlookup call 1: +"** 05-1-4.pdf page 43 -1 tad namlstp - dac 8 + dac 8 " get namelist ptr in index reg lac namsiz - dac namc + dac namc " negative namelist size in namc lu1: - lac i 8 - sad name - jmp 1f - lac d5 + lac i 8 " get first word of namelist entry + sad name " match name? + jmp 1f " yes + lac d5 " no, skip next 5 words lu2: tad 8 dac 8 - isz namc - jmp lu1 - lac tlookup - sna - jmp 2f + isz namc " at end of list? + jmp lu1 " no, keep going + lac tlookup " yes, reached end + sna " was tlookup? + jmp 2f " no, was lookup lac fnamep - dac rand+1 - jmp i tlookup + dac rand+1 " set rand+1 (value?) to fakename + jmp i tlookup " return 2: - lac name - dac i 8 + lac name " make new entry + dac i 8 " save word one of name lac 8 dac rand+1 lac name+1 - dac i 8 + dac i 8 " save word two lac name+2 - dac i 8 + dac i 8 " save word three lac name+3 - dac i 8 + dac i 8 " save word four lac d3 - dac i 8 - dzm i 8 - -1 + dac i 8 " set type(?) to three + dzm i 8 " clear value?? + -1 " decrement namsiz tad namsiz dac namsiz - jmp i lookup -1: + jmp i lookup " return +1: " here when first word matched lac i 8 - sad name+1 - jmp 1f - lac d4 + sad name+1 " check second word + jmp 1f " matched, keep going + lac d4 " no match: skip ahead four words jmp lu2 1: lac i 8 - sad name+2 - jmp 1f - lac d3 + sad name+2 " does third word match? + jmp 1f " yes, keep going + lac d3 " no, skip ahead three words jmp lu2 1: lac i 8 - sad name+3 - jmp 1f - lac d2 + sad name+3 " final word match? + jmp 1f " yes + lac d2 " no, skip two words jmp lu2 -1: +1: " name matched -3 - tad 8 - dac rand+1 + tad 8 " get next word minus three + dac rand+1 " return as value +"** 05-1-4.pdf page 44 lac tlookup sza jmp i tlookup @@ -739,37 +771,37 @@ namep: name gpair: 0 jms gsymb - lac rator - sad d4 - jmp gpair+1 - jms betwen; dm1; d6 - jmp gp1 + lac rator " get operator + sad d4 " space tab or comma? + jmp gpair+1 " yes, get another + jms betwen; dm1; d6 " anything but a digit? + jmp gp1 " no-- a digit dzm rand dzm rand+1 jmp i gpair -gp1: +gp1: " here with digit sad d7 lac d4 tad dm4 dac rand jms gsymb lac rator - sad d4 - jmp gp2 - jms betwen; dm1; d6 - skp - jmp i gpair - jms error; x> + sad d4 " whitespace? + jmp gp2 " yes + jms betwen; dm1; d6 " anything but digit? + skp " no, a digit + jmp i gpair " yes, return + jms error; x> " here with digit: give 'x' error jmp skip -gp2: - jms gchar - jms betwen; d5; d8 - jmp gp3 - lac char +gp2: " here after whitespace + jms gchar " get next char + jms betwen; d5; d8 " alphanumeric? + jmp gp3 " no + lac char " yes, push back dac savchr jmp i gpair gp3: - lac char + lac char " push back break char dac savchr jms gsymb jmp i gpair @@ -785,14 +817,15 @@ exp5: dac r+1 exp1: lac rator - jms betwen; d1; d5 - jmp exp3 + jms betwen; d1; d5 " plus, minus, comma, space, tab or comma? + jmp exp3 " no dac orator jms gpair jms grand - lac orator - sad d4 - jmp exp2 + lac orator " get operator back + sad d4 " comma space or tab? +"** 05-1-4.pdf page 45 + jmp exp2 " no jms oper; rand jmp exp1 exp2: @@ -801,12 +834,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 +886,7 @@ opsw: jmp .-1 jmp oplus jmp ominus +"** 05-1-4.pdf page 46 tad r dac r lac r+1 @@ -911,9 +945,10 @@ dm4: -4 o200: 0200 o42: 042 o142: 0142 -o40040: 040040 -o56056: 056056 -o56040: 056040 +o40040: 040040 " space, space +o56056: 056056 " ".." +o56040: 056040 " ". " +"** 05-1-4.pdf page 47 o146: 0146 o17777: 017777 d1000: 1000 @@ -924,22 +959,22 @@ o74: 074 o76: 076 namsiz: -2 -namistp: namlst +namlstp: namlst fnamep: fakename -lactab: lac .+1 +lactab: lac .+1 " character class table (8 unless noted) 8;8;8;8;8;8;8;8 -8;4;5;8;8;8;8;8 +8;4;5;8;8;8;8;8 " TAB=4 NL=5 8;8;8;8;8;8;8;8 8;8;8;8;8;8;8;8 -4;8;8;8;8;8;8;8 -8;8;6;2;4;3;6;8 -7;7;7;7;7;7;7;7 -7;7;0;5;8;1;8;8 -8;6;6;6;6;6;6;6 +4;8;8;8;8;8;8;8 " SP=4 +8;8;6;2;4;3;6;8 " *=6 +=2 ,=4 -=3 .=6 +7;7;7;7;7;7;7;7 " digits=7 +7;7;0;5;8;1;8;8 " :=0 ;=5 ==1 +8;6;6;6;6;6;6;6 " A-Z=6 6;6;6;6;6;6;6;6 6;6;6;6;6;6;6;6 6;6;6;8;8;8;8;8 -8;6;6;6;6;6;6;6 +8;6;6;6;6;6;6;6 " a-z=6 6;6;6;6;6;6;6;6 6;6;6;6;6;6;6;6 6;6;6;8;8;8;8;8 @@ -965,16 +1000,23 @@ r: .=.+2 name: .=.+4 buf: .=.+64 iobuf: .=.+64 -fbx: .=.+10 +fbx: .=.+10 " forward/backward pointers? mes: .=.+20 iof: .=.+1 bfi: .=.+1 bfo: .=.+1 lineno: .=.+1 -fakename: .=.+6 +fakename: .=.+6 " dummy entry returned by tlookup?? namlst: .=.+4 -dot: +dot: " dot type, value .=.+6 -cmflx: \ No newline at end of file +cmflx: " dotdot type, value + + " first four words of name list are symbol (space padded) + " next word is type?? + " 0: initial dotdot type + " 1: initial dot type + " 3: set by "lookup" + " last word is value?? \ No newline at end of file From aeceb8614a81188fae0b486cc6f7c8429d7caebe Mon Sep 17 00:00:00 2001 From: Phil Budne Date: Tue, 1 Mar 2016 01:43:24 -0500 Subject: [PATCH 05/18] move whitespace removal back in word loop --- tools/as7 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tools/as7 b/tools/as7 index 943121b..e9ecdda 100755 --- a/tools/as7 +++ b/tools/as7 @@ -298,14 +298,14 @@ sub process_label { # (: and ; can appear in char literals) # handles multiple ';' separated words per line 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 + # Lose any leading whitespace + $line =~ s{^\s*}{}; + print "parse_line: '$line'\n" if ($debug); while ($line =~ s{^([a-z0-9\.]+):\s*}{}) { # labels From 5aefe63624d0f807b233a00ea0034c4bd29344ce Mon Sep 17 00:00:00 2001 From: Phil Budne Date: Tue, 1 Mar 2016 01:44:04 -0500 Subject: [PATCH 06/18] correct sna comment! --- src/sys/sop.s | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/sys/sop.s b/src/sys/sop.s index 124ee9d..047a1ba 100644 --- a/src/sys/sop.s +++ b/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 From 73c066ae9d25b80519b3d21e9f13c530bbb95c7e Mon Sep 17 00:00:00 2001 From: Warren Toomey Date: Tue, 1 Mar 2016 16:55:03 +1000 Subject: [PATCH 07/18] I've restructured the opr code and the add code using the SimH logic and I fixed up some bugs with the new command interpreter. I'm getting so close to cat.s working! --- tools/a7out | 234 ++++++++++++++++++++++++++++++++-------------------- 1 file changed, 146 insertions(+), 88 deletions(-) diff --git a/tools/a7out b/tools/a7out index b76305f..ff7cf9e 100755 --- a/tools/a7out +++ b/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 ### @@ -40,7 +42,7 @@ while ( defined( $ARGV[0] ) && ( $ARGV[0] =~ m{^-} ) ) { # -b: set a breakpoint if ( $ARGV[0] eq "-b" ) { - $singlestep = 1; shift(@ARGV); + shift(@ARGV); $Breakpoint{ oct( shift(@ARGV) ) } = 1; } } @@ -166,8 +168,7 @@ sub simulate { oct("054") => \&sad, oct("060") => \&jmp, oct("064") => \&eae, - oct("070") => \&iot, - oct("074") => \&special, + oct("074") => \&opr, ); # Loop indefinitely @@ -183,7 +184,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 +198,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 +247,26 @@ 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] ); +# $LINK = 0; +# $AC = $AC + $Mem[$indaddr]; +# if ( $AC & LINKMASK ) { +# $AC++; # End-around carry +# $LINK = LINKMASK; +# } +# $AC = $AC & MAXINT; +# + # 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 +306,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 +329,117 @@ 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 @@ -414,25 +468,25 @@ 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; - # XXX: Do we need to preserve the AC sign? - $AC = $AC >> $step; + $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; @@ -480,17 +534,21 @@ 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; - # 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 ) ) { + if ( open( my $FH, $readorwrite, $filename ) ) { - # Find a place in the @FD array to store this filehandle. 99 is arbitrary + # 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; @@ -573,7 +631,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; From 145725ba4c19c514f47bb5cb47e991af66c76f13 Mon Sep 17 00:00:00 2001 From: Warren Toomey Date: Tue, 1 Mar 2016 16:57:40 +1000 Subject: [PATCH 08/18] Warren's version of a cp command. --- tools/wktcp.s | 111 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 111 insertions(+) create mode 100644 tools/wktcp.s diff --git a/tools/wktcp.s b/tools/wktcp.s new file mode 100644 index 0000000..387e7b8 --- /dev/null +++ b/tools/wktcp.s @@ -0,0 +1,111 @@ +" 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 five words into the buffer from the input file + " Five was chosen arbitrarily + lac infd + sys read; buf; 5 + 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: + ;;;012000 + +writeerror: + " Print an "err write" string on stderr and exit + lac d8 + sys write; nowritestr; 6 + sys exit + +nowritestr: + ;;;;;;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: .=.+5 From e0557be8997bf683d1440f9c226c41ebbafbe83d Mon Sep 17 00:00:00 2001 From: Warren Toomey Date: Tue, 1 Mar 2016 17:20:41 +1000 Subject: [PATCH 09/18] src/cmd/cat.s: lots more comments added to the code. --- src/cmd/cat.s | 124 +++++++++++++++++++++++++------------------------- 1 file changed, 63 insertions(+), 61 deletions(-) diff --git a/src/cmd/cat.s b/src/cmd/cat.s index eb39887..abb566a 100644 --- a/src/cmd/cat.s +++ b/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 - 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,16 +57,16 @@ nofiles: 1: ; 040; ;; Date: Tue, 1 Mar 2016 17:58:01 +1000 Subject: [PATCH 10/18] I found the type in cat.s and now original PDP-7 cat works with a7out! Yay! --- src/cmd/cat.s | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cmd/cat.s b/src/cmd/cat.s index abb566a..f40fd6c 100644 --- a/src/cmd/cat.s +++ b/src/cmd/cat.s @@ -63,14 +63,14 @@ done: and d1 sna cla jmp 1f - jms putc " Print out the character + 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 From a2e8a187b27d23f84b088366815f623fc8b327f2 Mon Sep 17 00:00:00 2001 From: Warren Toomey Date: Tue, 1 Mar 2016 18:28:37 +1000 Subject: [PATCH 11/18] tools/a7out: I took out the code to pretend to deal with binary files, and I did a perltidy to reformat the code. --- tools/a7out | 200 ++++++++++++++++++++++++---------------------------- 1 file changed, 93 insertions(+), 107 deletions(-) diff --git a/tools/a7out b/tools/a7out index ff7cf9e..ca577e8 100755 --- a/tools/a7out +++ b/tools/a7out @@ -37,7 +37,8 @@ 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 @@ -144,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); } } @@ -184,15 +185,15 @@ sub simulate { my $indaddr = ($indirect) ? $Mem[$addr] & MAXADDR : $addr; # If this is a breakpoint, stop now and get a user command - if ( defined( $Breakpoint{$PC} ) ) { - $singlestep = 1; - dprintf( "break at PC %06o\n", $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} ) ) { @@ -248,25 +249,17 @@ sub add { my ( $instruction, $addr, $indaddr ) = @_; dprintf( "add AC (value %06o) with addr %06o (%06o)\n", $AC, $indaddr, $Mem[$indaddr] ); -# $LINK = 0; -# $AC = $AC + $Mem[$indaddr]; -# if ( $AC & LINKMASK ) { -# $AC++; # End-around carry -# $LINK = LINKMASK; -# } -# $AC = $AC & MAXINT; -# + # 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; + my $sum = $AC + $Mem[$indaddr]; + if ( $sum > MAXINT ) { # end around carry + $sum = ( $sum + 1 ) & MAXINT; } - if (((~$AC ^ $sum) & ($AC ^ $sum)) & SIGN) { # overflow? - $LINK= LINKMASK; # set link + if ( ( ( ~$AC ^ $sum ) & ( $AC ^ $sum ) ) & SIGN ) { # overflow? + $LINK = LINKMASK; # set link } - $AC= $sum; - + $AC = $sum; $PC++; } @@ -341,8 +334,8 @@ sub opr { } # law: load word into AC - my $indirect = ( $instruction >> 13 ) & 1; - if ( $indirect) { + my $indirect = ( $instruction >> 13 ) & 1; + if ($indirect) { dprintf( "law %06o into AC\n", $instruction ); $AC = $instruction; $PC++; @@ -350,94 +343,104 @@ sub opr { } # 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'); + 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]); + 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 + $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 & 010000 ) { # cla + dprintf(" cla"); $AC = 0; } - if ($instruction & 004000) { # cli - dprintf(" cli"); $LINK=0; + if ( $instruction & 004000 ) { # cli + dprintf(" cli"); $LINK = 0; } - if ($instruction & 000002) { # cmi - dprintf(" cmi"); $LINK= ($LINK) ? 0 : LINKMASK; + if ( $instruction & 000002 ) { # cmi + dprintf(" cmi"); + $LINK = ($LINK) ? 0 : LINKMASK; } - if ($instruction & 000001) { # cma - dprintf(" cma"); $AC= ($AC ^ MAXINT) & MAXINT; + if ( $instruction & 000001 ) { # cma + dprintf(" cma"); + $AC = ( $AC ^ MAXINT ) & MAXINT; } # Rotate instructions - $i= $instruction & 02030; + $i = $instruction & 02030; # Single rotate right - if ($i == 020) { - dprintf(" rar"); + 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; + if ( $i == 02020 ) { + dprintf(" rtr"); + my $msb = ( $AC & 1 ) << 17; my $newlink = ( $AC & 2 ) ? LINKMASK : 0; - $AC = (( $LINK | $AC ) >> 2) | $msb; + $AC = ( ( $LINK | $AC ) >> 2 ) | $msb; $LINK = $newlink; } # Single rotate left - if ($i == 010) { - dprintf(" ral"); + if ( $i == 010 ) { + dprintf(" ral"); my $newlink = ( $AC & SIGN ) ? LINKMASK : 0; - my $lsb = $LINK ? 1 : 0; - $AC= (($AC << 1) | $lsb) & MAXINT; + my $lsb = $LINK ? 1 : 0; + $AC = ( ( $AC << 1 ) | $lsb ) & MAXINT; $LINK = $newlink; } # Double rotate left - if ($i == 02010) { - dprintf(" rtl"); + 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; + 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; + $PC += 1 + $skip; dprintf("\n"); return; } @@ -471,22 +474,20 @@ sub eae { $instruction &= EAEIMASK; if ( $instruction == 0660500 ) { # lrss: long right shift, signed - # We ignore the MQ as it's not - # used by any user-mode programs + # 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 my $newlink = ( $AC << 1 ) & LINKMASK; - - $AC = (($LINK |$AC) >> $step) & MAXINT; - $LINK= $newlink; + $AC = ( ( $LINK | $AC ) >> $step ) & MAXINT; + $LINK = $newlink; $PC++; return; } if ( $instruction == 0660700 ) { # alss: long left shift, signed - # We don't fill the lsb with LINK yet + # We don't fill the lsb with LINK yet dprintf( "alss %06o AC step %d\n", $AC, $step ); - $AC = ( $AC << $step ) & MAXINT; $PC++; return; @@ -526,6 +527,7 @@ sub sys_close { # 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. @@ -538,7 +540,7 @@ sub sys_open { my $filename = mem2arg($start); # Choose to open read-only or write-only - my $readorwrite= ($Mem[ $PC + 2 ]) ? ">" : "<"; + my $readorwrite = ( $Mem[ $PC + 2 ] ) ? ">" : "<"; dprintf( "open: base %06o, %s file %s\n", $start, $readorwrite, $filename ); # Bump up the PC @@ -595,22 +597,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 @@ -647,13 +639,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 From 2af280233556ef81ca0309edfd832c3a9d13612a Mon Sep 17 00:00:00 2001 From: Warren Toomey Date: Tue, 1 Mar 2016 20:28:24 +1000 Subject: [PATCH 12/18] I've moved these working programs into the src/other folder as they are not strictly tools. --- src/other/wktcat.s | 105 +++++++++++++++++++++++++++++++++++++++ src/other/wktcp.s | 110 +++++++++++++++++++++++++++++++++++++++++ src/other/write_test.s | 61 +++++++++++++++++++++++ 3 files changed, 276 insertions(+) create mode 100644 src/other/wktcat.s create mode 100644 src/other/wktcp.s create mode 100644 src/other/write_test.s diff --git a/src/other/wktcat.s b/src/other/wktcat.s new file mode 100644 index 0000000..0084ddf --- /dev/null +++ b/src/other/wktcat.s @@ -0,0 +1,105 @@ +" Warren's cat program: cat [arg1 arg2 ...] + +main: + " Load the pointer pointer in 017777 to see if we have any arguments + lac 017777 i + sad d4 " Skip if we have more than four argument words + jmp stdinout " Only four argument words, so no arguments + + lac 017777 " Move five words past the argument word count + tad d1 " so that AC points at the first argument + tad d4 + +" This section opens files and copies their contents to standard output +catfiles: + " We start with AC pointing to an argument. Save it at the "name" label + dac name + + " Open the file and get the fd into AC + sys open; name:0; 0; + spa + jmp badfile " Negative fd, exit with an error message + dac fd " Save the file descriptor + +fileloop: + " Read 64 words into the buffer from the input file + lac fd + sys read; buf; 64 + spa " Skip if result was >= 0 + jmp error " 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 stdout + lac d1 + sys write; buf; 1:0 + + " and loop back for more words to read + jmp fileloop + +fileend: + " Close the open file descriptor + lac fd + sys close + + " Subtract 4 from the count of argument words + -4 + tad 017777 i + dac 017777 i + sad d4 " Is the value 4, i.e. no args left? + jmp end " Yes, so exit + + " Still an argument, so move up to the next filename argument + lac name + tad d4 + dac name + jmp catfiles " and loop back to cat this file + +end: + " exit + sys exit + +" This section copies from standard input to standard output +" We cheat by setting the fd value to zero and storing 8 +" into the argc word count, so that when the code hits +" fileend, the word count drops to 4 and we exit. +stdinout: + lac d8 + dac 017777 i " Save 8 into the word count + lac d0 + dac fd " Save file descriptor 0 + jmp fileloop + +" 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" + +error: + " Print an "err read" string on stderr and exit + lac d8 + sys write; noreadstr; 5 + sys exit + +noreadstr: + ;;;012000 + +fd: 0 " fd of the open file +d0: 0 " Constants 0, 1, 4 and 8 +d1: 1 +d4: 4 +d8: 8 " stderr seems to have fd 8 +minus4: 0777774 " Constant -4 + +" Input buffer for read +buf: .=.+64 diff --git a/src/other/wktcp.s b/src/other/wktcp.s new file mode 100644 index 0000000..c8485b8 --- /dev/null +++ b/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: + ;;;012000 + +writeerror: + " Print an "err write" string on stderr and exit + lac d8 + sys write; nowritestr; 6 + sys exit + +nowritestr: + ;;;;;;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 diff --git a/src/other/write_test.s b/src/other/write_test.s new file mode 100644 index 0000000..fae298d --- /dev/null +++ b/src/other/write_test.s @@ -0,0 +1,61 @@ +" Test program for several system calls: open, read, write, close, exit +" Do: +" ./as7 write_test.s > a.out +" ./a7out -d a.out +main: + " Test the lac, dac instructions + lac in + dac out + + " Write hello to fd1 i.e stdout + lac d1 + sys write; hello; 7 + + " Test if the assembler can dac into a mid-line label + lac helloptr + dac 1f + lac d1 + sys write; 1:0; 7 + + " Try to open file fred + sys open; fred; 0; + + " read 5 words into the buffer from stdin: type in 10 or more characters! + lac d0 + sys read; buf; 5 + + " Stop and dump memory, so you can see five words at location 0400 + " Comment out the hlt instruction to test close and exit + hlt + + " close stdin + lac d0 + sys close + + " exit + sys exit + + " We should not get to the halt instruction + hlt + + +" Some memory locations for lac and dac +. = 0100 +in: 023 + +. = 0200 +out: 0 + +" Hello, world\n, two ASCII chars per word +hello: ; ; 040; ; ; ; ; 040040; 040040 + +" Input buffer for read +. = 0400 +buf: 0 + +d0: 0 +d1: 1 From 4914fc5dc857176daf4a0615681f59371a22cbe3 Mon Sep 17 00:00:00 2001 From: Will Senn Date: Tue, 1 Mar 2016 10:17:34 -0600 Subject: [PATCH 13/18] reviewed a*s and the two .b files --- scans/adm.s | 14 ++++++++++-- scans/ald.s | 9 ++++++-- scans/apr.s | 61 +++++++++++++++++++++++++++++++++------------------ scans/as.s | 32 ++++++++++++++++++++------- scans/lease.b | 2 ++ 5 files changed, 85 insertions(+), 33 deletions(-) diff --git a/scans/adm.s b/scans/adm.s index f747395..e5102a2 100644 --- a/scans/adm.s +++ b/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 diff --git a/scans/ald.s b/scans/ald.s index 363e632..12a81fa 100644 --- a/scans/ald.s +++ b/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: ;;;;; 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 diff --git a/scans/apr.s b/scans/apr.s index 464422b..bf8f84b 100644 --- a/scans/apr.s +++ b/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: ;;;;;;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 diff --git a/scans/as.s b/scans/as.s index 42a6c1b..39afc2c 100644 --- a/scans/as.s +++ b/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 @@ -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 @@ -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 @@ -487,18 +494,19 @@ 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 @@ -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 @@ -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 @@ -975,6 +990,7 @@ lineno: .=.+1 fakename: .=.+6 namlst: .=.+4 +"** 05-1-4.pdf page 48 dot: .=.+6 cmflx: \ No newline at end of file diff --git a/scans/lease.b b/scans/lease.b index df6c6df..41c6e37 100644 --- a/scans/lease.b +++ b/scans/lease.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); From 66909ac6fdafd38f30ce2ced010d1c6ca692a669 Mon Sep 17 00:00:00 2001 From: Phil Budne Date: Tue, 1 Mar 2016 09:30:23 -0500 Subject: [PATCH 14/18] fix bugs noted by warren --- tools/as7 | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/tools/as7 b/tools/as7 index e9ecdda..e561fae 100755 --- a/tools/as7 +++ b/tools/as7 @@ -48,10 +48,12 @@ 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, + '..' => 0, + save => 1, # saves core dump & user area! getuid => 2, open => 3, @@ -293,6 +295,10 @@ sub process_label { 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) @@ -301,7 +307,7 @@ sub parse_line { 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*}{}; @@ -318,6 +324,8 @@ sub parse_line { } } + return if (eol()); + if ( $line =~ s{^(\S+)\s*=}{}) { # assignment my $lhs = $1; my $word = parse_expression(); @@ -325,7 +333,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(); From ff4d793ca5f7f85f6f874749fdafb82db7e236b9 Mon Sep 17 00:00:00 2001 From: Phil Budne Date: Tue, 1 Mar 2016 11:22:53 -0500 Subject: [PATCH 15/18] another round of (hopeful) improvements add indirect bit to "sys" definition set initial ".." (output base) to 4096 (not yet honored) add "ptr" output format (binary in paper tape reader format: 3 frames of 6 bits) remove IOT instrictions (system source uses sop.s) always write labels to "n.out" add debug output fix multiply defined error handling (process symbolic labels on both passes) --- tools/as7 | 133 +++++++++++++++++++++++++----------------------------- 1 file changed, 61 insertions(+), 72 deletions(-) diff --git a/tools/as7 b/tools/as7 index e561fae..537c2f1 100755 --- a/tools/as7 +++ b/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 ### @@ -52,7 +51,11 @@ usage() if ( @ARGV < 1 ); # predefine syscall and opcodes as variables %Var = ( '.' => 0, - '..' => 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, @@ -85,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 @@ -134,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 @@ -207,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 @@ -238,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: @@ -253,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 } @@ -274,25 +255,30 @@ 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 { @@ -303,6 +289,7 @@ sub eol { # 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 { while (1) { $line_error = ' '; # clear listing error indicator @@ -315,13 +302,7 @@ sub parse_line { 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()); @@ -342,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); } } @@ -368,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); @@ -378,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) } elsif ($line =~ s{^>(.)}{}) { # >char !! + print "\tfound >x\n" if ($debug); $syllable = ord($1) } elsif ($line =~ s{^([a-z\.][a-z0-9\.]*)}{}) { @@ -409,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); } @@ -432,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; } @@ -457,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 @@ -480,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"); } From 02eeb59977c6640a647fb637dc93ec2178cfc0e2 Mon Sep 17 00:00:00 2001 From: Warren Toomey Date: Wed, 2 Mar 2016 06:14:12 +1000 Subject: [PATCH 16/18] tools/a7out: Added the creat() system call. --- tools/a7out | 66 ++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 48 insertions(+), 18 deletions(-) diff --git a/tools/a7out b/tools/a7out index ca577e8..3ae3066 100755 --- a/tools/a7out +++ b/tools/a7out @@ -454,6 +454,7 @@ sub cal { 3 => \&sys_open, 4 => \&sys_read, 5 => \&sys_write, + 6 => \&sys_creat, 9 => \&sys_close, 14 => \&sys_exit, ); @@ -525,6 +526,29 @@ 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 { @@ -546,25 +570,31 @@ sub sys_open { # Bump up the PC $PC += 3; - # Open the file - if ( open( my $FH, $readorwrite, $filename ) ) { + # Now open the file and return + creatopen($filename, $readorwrite); +} - # 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; - } +# 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); + + # Choose to open write-only + my $readorwrite = ">"; + dprintf( "creat: base %06o, file %s\n", $start, $filename ); + + # Bump up the PC + $PC += 2; + + # Now open the file and return + creatopen($filename, $readorwrite); } # Read system call From 51ab2cee19bd314b2de774d1a9c32ee9472c485f Mon Sep 17 00:00:00 2001 From: Warren Toomey Date: Wed, 2 Mar 2016 06:29:41 +1000 Subject: [PATCH 17/18] Added a top-level makefile so that we can build things quickly. --- Makefile | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 Makefile diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..10d39c8 --- /dev/null +++ b/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/* From 5bda1307c9fb9b190b15ba6c223ad89d16bd922f Mon Sep 17 00:00:00 2001 From: Warren Toomey Date: Wed, 2 Mar 2016 06:30:25 +1000 Subject: [PATCH 18/18] Moved my non-scanned programs into src/other. --- src/other/Readme | 2 + tools/wktcat.s | 116 --------------------------------------------- tools/wktcp.s | 111 ------------------------------------------- tools/write_test.s | 61 ------------------------ 4 files changed, 2 insertions(+), 288 deletions(-) create mode 100644 src/other/Readme delete mode 100644 tools/wktcat.s delete mode 100644 tools/wktcp.s delete mode 100644 tools/write_test.s diff --git a/src/other/Readme b/src/other/Readme new file mode 100644 index 0000000..9b2c5da --- /dev/null +++ b/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. diff --git a/tools/wktcat.s b/tools/wktcat.s deleted file mode 100644 index 6c53f41..0000000 --- a/tools/wktcat.s +++ /dev/null @@ -1,116 +0,0 @@ -" 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 -" -" -" ./a7out a.out z1 z1 -" - -main: - " Load the pointer pointer in 017777 to see if we have any arguments - lac 017777 i - sad d4 " Skip if we have more than four argument words - jmp stdinout " Only four argument words, so no arguments - - lac 017777 " Move five words past the argument word count - tad d1 " so that AC points at the first argument - tad d4 - -" This section opens files and copies their contents to standard output -catfiles: - " We start with AC pointing to an argument. Save it at the "name" label - dac name - - " Open the file and get the fd into AC - sys open; name:0; 0; - spa - jmp badfile " Negative fd, exit with an error message - dac fd " Save the file descriptor - -fileloop: - " Read five words into the buffer from the input file - " Five was chosen arbitrarily - lac fd - sys read; buf; 5 - spa " Skip if result was >= 0 - jmp error " 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 stdout - lac d1 - sys write; buf; 1:0 - - " and loop back for more words to read - jmp fileloop - -fileend: - " Close the open file descriptor - lac fd - sys close - - " Subtract 4 from the count of argument words - lac minus4 - tad 017777 i - dac 017777 i - sad d4 " Is the value 4, i.e. no args left? - jmp end " Yes, so exit - - " Still an argument, so move up to the next filename argument - lac name - tad d4 - dac name - jmp catfiles " and loop back to cat this file - -end: - " exit - sys exit - -" This section copies from standard input to standard output -" We cheat by setting the fd value to zero and storing 8 -" into the argc word count, so that when the code hits -" fileend, the word count drops to 4 and we exit. -stdinout: - lac d8 - dac 017777 i " Save 8 into the word count - lac d0 - dac fd " Save file descriptor 0 - jmp fileloop - -" 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" - -error: - " Print an "err read" string on stderr and exit - lac d8 - sys write; noreadstr; 5 - sys exit - -noreadstr: - ;;;012000 - -fd: 0 " fd of the open file -d0: 0 " Constants 0, 1, 4 and 8 -d1: 1 -d4: 4 -d8: 8 " stderr seems to have fd 8 -minus4: 0777774 " Constant -4 - -" Input buffer for read -buf: 0; 0; 0; 0; 0 diff --git a/tools/wktcp.s b/tools/wktcp.s deleted file mode 100644 index 387e7b8..0000000 --- a/tools/wktcp.s +++ /dev/null @@ -1,111 +0,0 @@ -" 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 five words into the buffer from the input file - " Five was chosen arbitrarily - lac infd - sys read; buf; 5 - 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: - ;;;012000 - -writeerror: - " Print an "err write" string on stderr and exit - lac d8 - sys write; nowritestr; 6 - sys exit - -nowritestr: - ;;;;;;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: .=.+5 diff --git a/tools/write_test.s b/tools/write_test.s deleted file mode 100644 index 6a1ea8e..0000000 --- a/tools/write_test.s +++ /dev/null @@ -1,61 +0,0 @@ -" Test program for several system calls: open, read, write, close, exit -" Do: -" ./as7 write_test.s > a.out -" ./a7out -d a.out -main: - " Test the lac, dac instructions - lac in - dac out - - " Write hello to fd1 i.e stdout - lac d1 - sys write; hello; 7 - - " Test if the assembler can dac into a mid-line label - lac helloptr - dac 1f - lac d1 - sys write; 1:0; 7 - - " Try to open file fred - sys open; fred; 0; 0 - - " read 5 words into the buffer from stdin: type in 10 or more characters! - lac d0 - sys read; buf; 5 - - " Stop and dump memory, so you can see five words at location 0400 - " Comment out the hlt instruction to test close and exit - hlt - - " close stdin - lac d0 - sys close - - " exit - sys exit - - " We should not get to the halt instruction - hlt - - -" Some memory locations for lac and dac -. = 0100 -in: 023 - -. = 0200 -out: 0 - -" Hello, world\n, two ASCII chars per word -hello: ; ; 040; ; ;