From b7733dafea9cbfd89f70702ac1424e1f6124ae9c Mon Sep 17 00:00:00 2001 From: Phil Budne Date: Sat, 21 Aug 2021 12:46:06 -0400 Subject: [PATCH] t[1-7].s: annotate TMG sources (all start with one or more tabs and ") (#230) start of TMG resurrection attempt --- src/cmd/t1.s | 53 +++--- src/cmd/t2.s | 508 ++++++++++++++++++++++++++++----------------------- src/cmd/t3.s | 335 +++++++++++++++++---------------- src/cmd/t4.s | 167 ++++++++--------- src/cmd/t5.s | 76 ++++---- src/cmd/t6.s | 218 +++++++++++----------- src/cmd/t7.s | 90 ++++----- 7 files changed, 770 insertions(+), 677 deletions(-) diff --git a/src/cmd/t1.s b/src/cmd/t1.s index 4e6d9d1..862dbe4 100644 --- a/src/cmd/t1.s +++ b/src/cmd/t1.s @@ -1,4 +1,10 @@ "** 13-120-147.pdf page 5 + " TMG + " console switches: + " bit 0: do not save/dump core!! + " bit 15: trace first recognition or generate instruction & halt + " bit 16: trace all generation instructions + " bit 17: trace all recognition instructions t=0 main: lac 017777 i @@ -23,16 +29,16 @@ main: jms advance; jmp 1f jmp rinterp -0:lac 2f - jms obuild -1:lac owrite - spa - jmp 0b - jms oflush - las - spa - sys exit - sys save +0:lac 2f " get EOS + jms obuild " add to obuf +1:lac owrite " here on retreat + spa " anything in obuf? + jmp 0b " no, put EOS + jms oflush " flush buffered output + las " get switches + spa " high bit set? + sys exit " yes: exit + sys save " no, dump core!!!! 2:o777 @@ -40,22 +46,23 @@ main: "puts out and octal strin g from symtab entry -symoct: +symoct: " BUILTIN: (output last symtab ent in octal?) lac equ add equbot - dac 9f+t - lac 1f - jms twoktab; lac 9f+t i -1:gf .+1 x - lac ii - dac 8 - lac 8 i - add symbot - dac 9f+t + dac 9f+t " save temp pointer + lac 1f " fetch "gf" (execute native code) inst below + jms twoktab; lac 9f+t i " second word is contents of word *temp + " first word of "two word ktab" entry: +1:gf .+1 x " invoke native code (below), and exit + lac ii " fetch instruction pointer + dac 8 " save in auto-increment register 8 + lac 8 i " fetch word after *ii + add symbot " use as offset into symtab + dac 9f+t " save in temp -2:lac 9f+t i - jms putoct - lac onenl +2:lac 9f+t i " fetch symtab word *temp + jms putoct " output octal + lac onenl " output newline jms obuild lac 9f+t i and o600600 diff --git a/src/cmd/t2.s b/src/cmd/t2.s index 53ba357..723abf0 100644 --- a/src/cmd/t2.s +++ b/src/cmd/t2.s @@ -1,96 +1,112 @@ "** 13-120-147.pdf page 7 " recognition stack frame advance + " push stack frame: called in both recognition and generation + " (despite above comment). + " recognition frame size is 6, generation frame size is 4. + " 0: pointer to previous frame + " 1: jmp instr from after "jms advance" (for retreat/return) + " 2: saved ii (inst ptr) + " 3: saved ignore/env + " 4: saved j (always overwritten by nframe in recog. mode) + " 5: saved k + advance:0 - lac frame - dac 8 - lac advance i - dac 8 i - lac ii - dac 8 i - lac ignore - dac 8 i - lac j - dac 8 i - lac k - dac 8 i - lac frame - dac nframe i + lac frame " get frame pointer + dac 8 " save in auto-increment register 8 + lac advance i " get (retreat) instruction after "jms advance" + dac 8 i " save at offset 1 + lac ii " instruction pointer + dac 8 i " save at offset 2 + lac ignore " ignore mask pointer (env in recog. mode?) + dac 8 i " save at offset 3 + lac j " input char pointer + dac 8 i " save at offset 4 + lac k " result pointer + dac 8 i " save at offset 5 + lac frame " save current frame pointer + dac nframe i " at nframe offset zero lac nframe - dac frame - add dffrmsz - dac nframe - dac nframe - jms between; add rbot; add rtop + dac frame " set frame pointer to nframe (new frame) + add dffrmsz " add current frame size + dac nframe " set new new frame pointer + dac nframe " AGAIN??!! + jms between; add rbot; add rtop " check for overflow jms halt - isz advance - jmp advance i + isz advance " skip instruction after jms + jmp advance i " return + + " Here on failure/backup (w/ fflag set to 760000) + " AND at (successful) end of rule + " (exit/indirect bit set on last instr). + " Always restores j/k on failure: + " (no such thing as "failure" in generation mode(?)) retreat: dzm junk - lac gflag + lac gflag " in generation mode? sza - jmp 1f - jms bundlep - dac junk + jmp 1f " yes, skip bundling + jms bundlep " no, bundle + dac junk " save pointer (may be zero if no result) 1:lac frame - dac nframe - lac frame i - dac frame - dac 8 - lac 8 i + dac nframe " reset nframe to current frame pointer + lac frame i " fetch prev. frame pointer from current frame + dac frame " pop current frame + dac 8 " save in (pre) auto-increment register 8 + lac 8 i " restore saved instruction dac 3f "retrun address lac 8 i - dac ii + dac ii " restore saved instruction pointer lac 8 i - dac ignore - lac fflag - sna - jmp 2f + dac ignore " restore saved ignore ("env" in gen mode???) + lac fflag " get failure flag + sna " any bits set? + jmp 2f " no, skip lac 8 i "restore j and k on failure dac j lac 8 i dac k -2:lac junk - sna - jmp 3f +2:lac junk " get bundle/result(s) + sna " got anything? + jmp 3f " no dac nframe i "stass reslts isz nframe -3:jmp +3:jmp " (jump following original "jms advance" call) " bundle up results and return single pointer to them in ac " return 0 if no results "** 13-120-147.pdf page 8 bundlep:0 - lac fflag - sza + lac fflag " check failure flag + sza " clear? jmp 2f "no results on failure - jms nframe0 - dac 9f+t - cma - tad nframe - cma - dac 9f+t+1 - sma - jmp 2f - sad m1 + jms nframe0 " yes: get initial nframe pointer + dac 9f+t " save + cma " get negative, minus one + tad nframe " add current value + cma " get nframe0 - nframe! (-N or zero) + dac 9f+t+1 " save + sma " negative result? + jmp 2f " no, no change + sad m1 " -1 (one result) jmp 3f "only one result, no bundling necessary - lac 9f+t - tad m1 - dac 8 + lac 9f+t " get initial nframe + tad m1 " decrement + dac 8 " save in (pre-)auto-increment reg. 8 -1:lac 8 i - jms kput - isz 9f+t+1 - jmp 1b +1:lac 8 i " fetch result + jms kput " save in ktab + isz 9f+t+1 " increment negative count until zero + jmp 1b " more left, continue lac k "make up result pointer - add l.gk + add l.gk " return as gk instruction jmp bundlep i -2:cla +2:cla " here with no results, return zero jmp bundlep i -3:lac 9f+t i +3:lac 9f+t i " here with one result, fetch it jmp bundlep i t=t+1 "where to find results t=t+1 "negative of result count @@ -98,54 +114,58 @@ t=t+1 "negative of result count " the main interpreter loop " locate original value of nframe for present stack level. nframe0:0 - jms s1get; add d.ii + jms s1get; add d.ii " fetch instr. at saved intruction pointer dac junk - lac junk i + lac junk i " fetch word referenced by instruction dac junk - lac junk i - and opmask - sad l.rw - jmp 1f - lac refrsz + lac junk i " fetch word referenced by that word!! + and opmask " get instruction portion + sad l.rw " is it an "rw" instruction? + jmp 1f " yes. + lac refrsz " no, use recog frame size as offset jmp 2f -1:lac junk i - and o17777 -2:add frame - jmp nframe0 i +1:lac junk i " get contents of word ref'ed by rw instr + and o17777 " get rw instr address portion (offset) +2:add frame " make nframe pointer + jmp nframe0 i " return + " halt on various error conditions: + " various table overflows + " console switch 15 set (trace and halt) + " invalid recognize/generate opcodes halt:0 lac 1f - jms obuild + jms obuild " output "\n?" lac halt - jms putoct + jms putoct " output return address in octal lac onenl - jms obuild - xct rstack+1 -1:.+1;012077;end + jms obuild " output newline + xct rstack+1 " execute retreat jump from initial advance?! +1:.+1;012077;end " "\n?"; end=-1 -- two 0777 EOSes "** 13-120-147.pdf page 9 -rinterp: +rinterp: " recognition mode interpreter las "trace check and d5 sna jmp .+3 lac bugr - jms bug + jms bug " trace - lac fflag - ral - lac ii i - and opmask - sad l.ra - jmp rera - sad l.rb - jmp rerb - szl - jmp retreat - lrs 14 - and o17 - add rbranch - dac .+1 + lac fflag " fetch failure flag + ral " rotate top bit into LINK + lac ii i " fetch current instruction + and opmask " get opcode + sad l.ra " "ra" (conditional branch on LINK set/fail)? + jmp rera " yes + sad l.rb " "rb" (conditional branch on LINK clear/succ)? + jmp rerb " yes + szl " LINK set (failure)? + jmp retreat " yes: retreat!! + lrs 14 " no: shift opcode bits down + and o17 " isolate opcode bits + add rbranch " create indirect jmp thru rbranch tabe + dac .+1 " save as next jmp rbranch: @@ -153,7 +173,7 @@ rbranch: reno rerx rerc - regc + regc " opcode is "rt"! rerf rerw rera @@ -167,104 +187,112 @@ rbranch: reuu reuu -reuu: - jms halt +reuu: " recognition unused operation + jms halt " halt -rerb: - cml -rera: - dzm fflag - snl - jmp goon - jms aget - dac ii - jmp rinterp +rerb: " recognition "rb" instruction + cml " complement LINK bit +rera: " recognition "ra" instruction + dzm fflag " clear failure flag + snl " LINK bit set? + jmp goon " no: continue (w/ exit check) + jms aget " yes: fetch address part + dac ii " save as new instruction pointer + jmp rinterp " go on (w/o exit check) -backup: +backup: " here on failure from "rx", eof, char builtins lac jsav dac j -nuts: - law +nuts: " here on failure from find/prev builtins + " (could possibly be used as a "fail" builtin?) + law " get 0760000 "** 13-120-147.pdf page 10 - dac fflag + dac fflag " set failure flag -reno: -goon: - lac ii i - isz ii - and exitmask +reno: " recognition no(op) instruction +goon: " "go on" on success from recog. builtins, ops + lac ii i " fetch current instruction + isz ii " advance instruction pointer + and exitmask " was exit (indirect) bit set on prev instr? sza - jmp retreat - jmp rinterp + jmp retreat " yes, retreat/return + jmp rinterp " no, go on -rerw: - jms aget - add frame - dac nframe +rerw: " recognition rw instr (nframe0 looks for one!) + jms aget " get address portion of instruction + add frame " use as frame size + dac nframe " set nframe pointer jmp goon -rerc: - jms advance; jmp goon - jms aget - dac ii - jmp rinterp +rerc: " recognition rc (call tmg code) instruction + jms advance; jmp goon " push new frame, continue on retreat + jms aget " get address from instruction + dac ii " use as new instruction pointer + jmp rinterp " go on (w/o exit check) -gegf: -rerf: - jms aget - add ljmp +gegf: " gen. "gf" intr (invoke builtin func) +rerf: " recognition rf inst (invoke builtin func) + jms aget " get address from instruction + add ljmp " make into abs jmp to native code dac .+1 - jmp + jmp " go to native code -rerx: +rerx: " recognition rx instruction (compare lit str) lac j - dac jsav - jms aget + dac jsav " save j (input char pointer) in jsav + jms aget " get address from instruction 1:dac 9f+t - jms lchar - sad o777 - jmp goon - dac 9f+t+1 - jms getj -sad 9f+t+1 - jmp 2f - jmp backup -2:lac 9f+t + jms lchar " get lit character + sad o777 " EOS? + jmp goon " yes, continue (success) + dac 9f+t+1 " no, save char + jms getj " get next input char +sad 9f+t+1 " as expected? + jmp 2f " yes + jmp backup " no: restore j and fail. +2:lac 9f+t " continue matching (increment lit ptr) add o400000 jmp 1b t=t+1 "address of next comparison char t=t+1 "character itself -aget:0 +aget:0 " fetch address portion of current instruction lac ii i and o17777 jmp aget i -regc: - lac ii i - and o757777 - xor exitmask - dac nframe i + " Places copy of instruction with exit bit set on stack. + " Interpreted as a "gc" instruction (see note at gegc). +regc: " recognition "rt" instruction [sic] + lac ii i " fetch instruction word + and o757777 " clear exit bit + xor exitmask " set (toggle) exit bit + dac nframe i " push @nframe "** 13-120-147.pdf page 11 - isz nframe - jmp goon + isz nframe " advance nframe pointer + jmp goon " succeed + " push result in AC at "k" (kbuf) + " called from bundlep and twice from twoktab (two word ktab entry) + " returns w/ AC unmodified, k contains index of new entry kput:0 isz k dac junk1 lac k jms between; add d0; add kmax - jms halt + jms halt " halt on ktab overflow add kbot dac junk lac junk1 dac junk i jmp kput i + " fetch word from current frame using "add offset" following jms. + " Only used by parsedo, to restore k. s0get:0 lac frame xct s0get i @@ -273,6 +301,8 @@ s0get:0 isz s0get jmp s0get i + " fetch word via ptr in current frame using "add offset" following jms. + " Only used by nframe0, w/ "ii" instruction pointer s1get:0 lac frame i xct s1get i @@ -281,6 +311,8 @@ s1get:0 isz s1get jmp s1get i + " set word in current frame using "add offset" following jms. + " Only used by "gk" instruction to set "ii" s0put:0 lmq lac frame @@ -293,119 +325,145 @@ s0put:0 " here is the generaion interpreter " the k table cant move while its active -geno: -ggoon: - lac ii i - isz ii - and exitmask +geno: " gen. noop instruction +ggoon: " "go on" from gen. builtins, ops + lac ii i " fetch prev instr + isz ii " increment + and exitmask " isolate exit bit sza - jmp retreat + jmp retreat " exit bit set, return. ginterp: las "trace check and d6 sna jmp .+3 lac bugg - jms bug + jms bug " trace - lac ii i - lrss 14 - and o7 + lac ii i " fetch current instruction + lrss 14 " shift down to opcode + and o7 " get low 3 of opcode "** 13-120-147.pdf page 12 - add gbranch - dac .+1 + add gbranch " make indirect branch thru gbranch table + dac .+1 " save as next instruction jmp gbranch: jmp .+1 i geno gegx - geuu + geuu " was once "gz" (in bugg tab) gegc gegf gegk gegp gegq -geuu: +geuu: " gen. ununimplemented instruction jms halt -gegx: - lac ii i - and o417777 - jms obuild - jmp ggoon + " pdp-11 analog is .txs? output string +gegx: " gen. "gx" instruction + lac ii i " fetch instruction + and o417777 " extract character address + jms obuild " copy to output + jmp ggoon " continue (checking for exit) -gegq: - jms advance; jmp ggoon + " pdp-11 analog may be .tq: load translation parameter ($1, $2)?? + " manual says: + " A translation rule may have parameters, and if it + " does, their number is declared by a parenthesized + " integer prefixed to its body. +gegq: " gen. "gq" instruction + jms advance; jmp ggoon " push state lac env - add d.ii + add d.ii " get addr of env->ii dac junk - jms aget - add junk i + jms aget " get address portion of gq instruction + add junk i " add value at *env->ii dac junk - lac junk i - dac ii + lac junk i " fetch *(*env->ii + aget()) + dac ii " save param list ptr as instruction pointer? lac env - add d.env + add d.env " get addr env->env dac junk - lac junk i - dac env - jmp ginterp + lac junk i " fetch env->env + dac env " restore env ptr (pop env) + jmp ginterp " go on (w/o exit check) -gegp: - jms advance; jmp ggoon - lac env - add d.ii - dac junk - lac frame i - dac env - jms aget -cma - add junk i - dac ii - jmp ginterp + " pdp-11 analog is .tp? + " execute rule called for by 1 2 ... + " found relative to instruction counter in the k environment -gegk: - lac ii i - jms aget - add kbot +gegp: " gen. "gp" instruction + jms advance; jmp ggoon " push current state + lac env " get saved env pointer + add d.ii " get pointer to saved instruction pointer + dac junk " save in temp + lac frame i " get prev frame pointer + dac env " save as env pointer + jms aget " get address portion of instruction +cma " one's complement negation + one's c. add!! + add junk i " back up env instruction pointer by -aget() dac ii - jms s0put; add d.ii - lac frame + jmp ginterp " go on (w/o exit check) + + " pdp-11 comment @ gk: + " delivered compound translation + " instruction counter is in ktable + " set the k environment for understanding 1, 2 ... + " to designate this frame + " PDP-7 NOTES: only place that sets "env" w/o reading first; + " twoktab stores gk instructions in ktab. +gegk: " gen. "gk" instruction + lac ii i " load instruction (value ignored) + jms aget " get address portion of instruction + add kbot " add to ktab base + dac ii " store as new instruction pointer + jms s0put; add d.ii " set frame saved instruction pointer too + lac frame " get frame pointer "** 13-120-147.pdf page 13 - dac env - jmp ginterp + dac env " save as env pointer + jmp ginterp " go on (w/o exit check) -gegc: - jms advance; jmp ggoon - jms aget - dac ii - jmp ginterp + " NOTE: recognition opcode "rt" (code at label regc!) places + " a copy of itself, with exit bit set on stack, since rt and + " gc use the same opcode, the stacked instruction comes here + " (addr points to "gen" code), so it calls the referenced code. +gegc: " gen. "gc" inst (call tmg coded subroutine) + jms advance; jmp ggoon " push current state + jms aget " get address from instruction + dac ii " use as new instruction pointer + jmp ginterp " go on (w/o exit check) + " trace routine (not a bug!) + " invoked from rinterp if switch 15 or 17 set (mask 05) + " invoked from ginterp if switch 15 or 16 set (mask 06) + " calls halt if switch 15 set (mask 04) bug:0 - dac 1f+2 - lac onenl + dac 1f+2 " save pointer to instruction names + lac onenl " output newline jms obuild - lac ii + lac ii " output instruction address in octal jms putoct - lac ii i - lrs 14 - and o17 - add 1f+2 - dac 1f+2 - lac 1f+2 i - dac 1f+2 - lac 1f - jms obuild - lac ii i - jms putoct - las - and d4 - sza - jms halt - jmp bug i + lac ii i " get instruction + lrs 14 + and o17 " get high four bits (opcode) + add 1f+2 " add to instruction name list pointer + dac 1f+2 " save (into output string!) + lac 1f+2 i " fetch two character instruction name + dac 1f+2 " save back into output string + lac 1f " get pointer to output string + jms obuild " output + lac ii i " get instruction + jms putoct " output in octal + las " get console switches + and d4 " is bit 15 set? + sza " no. + jms halt " yes: halt (output return address, then quit) + jmp bug i " no: continue. -1:0400000 .+1; 040; 0; 040777 +1:0400000 .+1; 040; 0; 040777 " char ptr to XX + " where XX will be instr name diff --git a/src/cmd/t3.s b/src/cmd/t3.s index 96242c0..12b23a2 100644 --- a/src/cmd/t3.s +++ b/src/cmd/t3.s @@ -1,161 +1,172 @@ "** 13-120-147.pdf page 14 + " move characters + " call with source address in AC + " dest addr after "jms move" instruction move: 0 - dac 9f+t - lac move i -1:dac 2f - lac 9f+t - jms lchar - dac 9f+t+1 - jms dchar -2: 0 - lac 9f+t+1 - sad o777 - jmp 3f - lac o400000 - add 9f+t - dac 9f+t - lac o400000 - add 2b - jmp 1b + dac 9f+t " save source addr + lac move i " get dest addr +1:dac 2f " save dest addr after dchar call + lac 9f+t " restore source addr + jms lchar " load char + dac 9f+t+1 " save source char + jms dchar " store char +2: 0 " dest addr + lac 9f+t+1 " examine source char + sad o777 " EOS? + jmp 3f " yes + lac o400000 " get char addr increment + add 9f+t " add to source addr + dac 9f+t " save incremented source addr + lac o400000 " get char addr increment + add 2b " get incremented dest addr + jmp 1b " go back to top of loop (save dest addr) -3:isz move - lac 2b +3:isz move " skip dest addr arg + lac 2b " return dest addr jmp move i t=t+1 "source address t=t+1 "source character + " load character + " takes source character address in AC lchar:0 - dac junk - ral - lac junk i - snl - lrs 9 - and o777 - jmp lchar i + dac junk " save source address + ral " rotate addr up (high bit into link) + lac junk i " fetch source word + snl " link set? + lrs 9 " no: move high 9 down + and o777 " get just 9 bits + jmp lchar i " return + " deposit character + " takes dest addr after jms instruction dchar:0 - lmq - lac dchar i - dac junk - spa - jmp 1f - llss 9 - lac o777 + lmq " save char in MQ + lac dchar i " get dest addr + dac junk " save + spa " high bit set? + jmp 1f " yes: get mask for high 9 + llss 9 " no: shift AC/MQ up 9 (LINK fills MQ low bits) + lac o777 " get mask for low 9 jmp .+2 -1:0777000 - and junk i - omq - dac junk i - isz dchar - jmp dchar i +1:0777000 " get mask for high 9 + and junk i " and dest word w/ mask + omq " or MQ in + dac junk i " deposit in dest word + isz dchar " increment return to skip dest addr + jmp dchar i " return " gets designated character from input + " (reads block from disk if needed) + " does not increment j jget:0 -1:lac j - jms cbetween; add jmin; add jmax - jmp jmore +1:lac j " get input char addr [here also from jmore] + jms cbetween; add jmin; add jmax " in current block? + jmp jmore " no: not in memory, read block cma add jmin - cma - add jbot - jms lchar - jms class; add ignore + cma " get j-jmin + add jbot " make buffer address + jms lchar " fetch character from buffer + jms class; add ignore " char in "ignore" mask? "** 13-120-147.pdf page 15 - jmp jget i - lac j - add o400000 - dac j - jmp 1b + jmp jget i " no: return character + lac j " yes: get source char addr + add o400000 " increment + dac j " save + jmp 1b " try again (may have crossed block boundary) " read more input - filthy code, enough to make disk & " terminal input work. Theae only deliver full count " except at eof or 1 word jmore: -and o377700 - dac jmin - add ljsiz - dac 9f+t - lac jmax - jms cbetween; add jmin; add 9f+t - lac jmin - dac jmax - dac 1f +and o377700 " get char offset for start of block + dac jmin " save as first + add ljsiz " add buf size + dac 9f+t " save in t0 + lac jmax " get current end addr + jms cbetween; add jmin; add 9f+t " in range jmin<=jmax= + jmp rorel ;eq=op;op=op+1 " relop == + jmp rorel ;gt=op;op=op+1 " relop > + tad rand2 ;ad=op;op=op+1 " binop + + jms sub ;sb=op;op=op+1 " binop - + and rand2 ;an=op;op=op+1 " binop & + jmp roor ;or=op;op=op+1 " binop | + xor rand2 ;xo=op;op=op+1 " binop ^ (xor) + jmp rosr ;sr=op;op=op+1 " binop << + jmp rosl ;sl=op;op=op+1 " binop >> + jmp romn ;mn=op;op=op+1 " binop min?? + jmp romx ;mx=op;op=op+1 " binop max?? + lac rand2 ;as=op;op=op+1 " binop ??? (always returns rh operand) - opr ;pl=op;op=op+1 - jmp romi ;mi=op;op=op+1 - cma ;cm=op;op=op+1 - jmp roindir;indir=op;op=op+1 - lac holdlv ;addr=op;op=op+1 + opr ;pl=op;op=op+1 " unary + (noop) + jmp romi ;mi=op;op=op+1 " unary - (negate) + cma ;cm=op;op=op+1 " unary ~ (complement) + jmp roindir;indir=op;op=op+1 " unary indirect (fetch *holdlv) + lac holdlv ;addr=op;op=op+1 " unary addr (return last holdlv) unary:xct obranch+1+pl rorel: "<= 001 @@ -78,6 +78,8 @@ rorel: "<= 001 cma jmp result + " return rand1 minus rand2 + " used by rorel, rosub sub:0 cma tad rand2 @@ -85,79 +87,79 @@ sub:0 jmp sub i roor: - lmq - lac rand2 - omq + lmq " save rand1 in MQ + lac rand2 " get rand2 in AC + omq " or AC and MQ jmp result rosr: - lac rand2 - add l.lrs - cll + lac rand2 " get rh operand + add l.lrs " make long right shift (fills with LINK) + cll " clear link jmp 1f rosl: - lac rand2 - add l.lls - clq -1:dac .+2 - lac rand1 - 0 - jmp result + lac rand2 " get rh operand + add l.lls " make long left shift (fills from MQ) + clq " clear MQ +1:dac .+2 " save shift instruction + lac rand1 " get left hand operand + 0 " perform shift + jmp result " join result processing romn: - jms sub - cma + jms sub " get rand1-rand2 + cma " complement (rand2-rand1-1) jmp .+2 romx: - jms sub - ral - lac rand1 - szl - lac rand2 - jmp result + jms sub " get rand1-rand2 + ral " rotate left (sign bit into LINK) + lac rand1 " get first operand + szl " link clear? + lac rand2 " no, get second operand instead + jmp result " return result -romi: - cma - tad d1 +romi: " unary minus + cma " complement + tad d1 " add one jmp result roindir: - dac holdlv - lac holdlv i + dac holdlv " save as "hold lvalue" + lac holdlv i " fetch value "** 13-120-147.pdf page 25 - jmp result + jmp result " return result -result: - dac junk - dac nframe i +result: " ro result processing + dac junk " save in temp + dac nframe i " store at *nframe++ isz nframe - lac ii i - and stbit - sna - jmp exprtest - lac junk - dac holdlv i - lac ii i - and fibit - sza - jms decnf + lac ii i " fetch original instruction + and stbit " get st(ore?) bit + sna " set? + jmp exprtest " no + lac junk " yes: get result + dac holdlv i " store at *holdlv + lac ii i " fetch original instruction + and fibit " fi(nal?) bit set? + sza " no, skip + jms decnf " yes: discard stacked result + jmp goon " succeed + +exprtest: " here if st(ore?) bit not set + lac ii i " fetch instruction + and fibit " get fi(nal?) bit + sna " set? + jmp goon " no: succeed + jms decnf " yes: poped stacked result + lac nframe i " (redundant?????) + sza " was result zero? + -1 " no: get all ones + cma " complement (zero -> -1, -1 -> zero) + dac fflag " save as failure flag jmp goon -exprtest: - lac ii i - and fibit - sna - jmp goon - jms decnf - lac nframe i - sza - -1 - cma - dac fflag - jmp goon - -decnf:0 +decnf:0 " decrement nframe, return stacked value -1 tad nframe dac nframe diff --git a/src/cmd/t7.s b/src/cmd/t7.s index 9487d36..cc06955 100644 --- a/src/cmd/t7.s +++ b/src/cmd/t7.s @@ -1,8 +1,8 @@ "** 13-120-147.pdf page 26 9:.=.+t -end = -1 - +end = -1 " end of string (two 0777 bytes) + " recognition / generation opcodes: no = 0000000 rx = 0040000; gx = rx rc = 0100000 @@ -16,23 +16,23 @@ rm = 0440000 rs = 0500000 rv = 0540000 - + " literal words ljmp:jmp l.llss:llss l.lrs:lrs l.lls:lls -l.ra:ra -l.rb:rb -l.rw:rw -l.gk:gk -l.gcx:gc x - -x = 020000 -st = 0100 -fi = 0200 -opmask:0740000 -exitmask: x +l.ra:ra " used for comparison +l.rb:rb " used for comparison +l.rw:rw " used for comparison +l.gk:gk " used to create instr in twoktab +l.gcx:gc x " NOT USED? +x = 020000 " exit bit (on all recog/gen instrs) +st = 0100 " store(?) bit on recog op (ro) instrs +fi = 0200 " final(?) bit on recog op (ro) instrs +opmask:0740000 " opcode mask +exitmask: x " exit bit mask + " number lits: m1:0-1 d0:o0:0 d1:o1:1 @@ -43,13 +43,18 @@ d5:o5:5 d6:o6:6 d7:o7:7 d8:o10:8 -asciisp:040 -asciinl:012 -nl:012777 -onenl:nl -bugr:.+1;;;;;;;; +asciisp:040 " ascii space (NOT USED) +asciinl:012 " ascii newline (NOT USED) +nl:012777 " newline + EOS +onenl:nl " pointer to newline+EOS +bugr:.+1;;;;;;;; " ptr to rec. op names ;;; -bugg:.+1;;;;;;;; +bugg:.+1;;;;;;;; " ptr to gen. op names + " NOTE! ginterp ignores high bit of + " opcode (to allow as char indicator + " bit for gx instruction), but bug + " routine does not, so table should + " include two more entries??? o17:017 o60:060 @@ -66,6 +71,7 @@ o17777:017777 o757777:0757777 o600600:0600600 + " variables junk:0 junk1:0 @@ -100,27 +106,29 @@ sbbot:sbbuf fflag:0 gflag:0 -ignore:.+1;0400000;0;0;0;0;0;0;4 -frame:rstack -nframe:rstack+6 +ignore:.+1;0400000;0;0;0;0;0;0;4 " pointer to ignored character set + " default ignore set (NUL and DEL) + " set stored using first (high) 16 of each wd. +frame:rstack " frame pointer +nframe:rstack+6 " next frame pointer env = ignore -d.ii = d2 -d.env = d3 -d.blkmod = d3 -d.j = d4 -d.k = d5 -dffrmsz:6 -framsiz:4 -refrsz = d6 -gefrsz = d4 -ii: start -k:0 +d.ii = d2 " frame offset for instruction pointer +d.env = d3 " frame offset for env/ignore +d.blkmod = d3 " SYMBOL NOT USED +d.j = d4 " frame offset for saved j +d.k = d5 " frame offset for saved k +dffrmsz:6 " current frame size (one of [rg]efrsz) +framsiz:4 " LOCATION NOT USED +refrsz = d6 " recognition frame size +gefrsz = d4 " generation frame size +ii: start " interpreter instruction pointer +k:0 " saved data (ktab) pointer -rsiz = 500 -rmax: rsiz -rbot:rstack -rtop:rstack+rsiz +rsiz = 500 " stack size +rmax: rsiz " stack size as variable +rbot:rstack " pointer to first stack entry +rtop:rstack+rsiz " pointer to last stack entry -owrite:0 -obot:obuf -osiz=64 +owrite:0 " index into obuf +obot:obuf " pointer to first word of output buffer +osiz=64 " output buffer size