From 36d0a0c2f5047a491997a21a98066b40f961ced9 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Mon, 30 Jul 2018 15:40:33 +0200 Subject: [PATCH] RECORD - save TV display contents as text file. --- build/misc.tcl | 4 + doc/programs.md | 1 + src/sysen2/record.31 | 784 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 789 insertions(+) create mode 100755 src/sysen2/record.31 diff --git a/build/misc.tcl b/build/misc.tcl index 324db238..5fb99414 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -921,6 +921,10 @@ respond "*" ":link sys1; ts imprin, sys1; ts imprnt\r" respond "*" ":link sys1; ts ardprn, sys1; ts imprnt\r" respond "*" ":link sys1; ts tekprn, sys1; ts imprnt\r" +# Save TV display as text file. +respond "*" ":midas sys2; ts record_sysen2; record\r" +expect ":KILL" + # Maze War respond "*" ":midas /t sysbin;_imsrc; maze\r" respond "with ^C" "MOUSE==1\r\003" diff --git a/doc/programs.md b/doc/programs.md index c6f9ed85..71c53c8b 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -183,6 +183,7 @@ - QB, the game of Qubic. - QUOTE, prints out a random quote. - REATTA, reattaches disowned jobs to terminal. +- RECORD, save TV display contents as text file. - REDRCT, redirect IP routing. - RIPDEV, replacement for MLDEV for no-longer-existing machines. - RMAIL, mail reading client. diff --git a/src/sysen2/record.31 b/src/sysen2/record.31 new file mode 100755 index 00000000..ed3eefdd --- /dev/null +++ b/src/sysen2/record.31 @@ -0,0 +1,784 @@ +;-*-Midas-*- + TITLE Character Analyzer + +;OUTPUTS ON TV'S + +;tv's have 455. vertical lines of 576. dots (262080. bits out 'o 262144). + +;organized as 9 64.-bit words (equiv to 18. 32.-bit words) per line. +;the pdp10 accesses half of such a word (or two 16.-bit chunks) at once. +;these 32. bits are packed left justified into the 36. bits. + +;tvend (or the last word of the tv-memory) has two functions: +;bit 200000 when on, complements the black/white output. +;bits 177760 is a counter for which 64.-bit word the frame is to start on. +;for winnage the number ought to be a multiple of 9. + +;Characters are 10. lines high and 5 points wide (right and top justified). +;Line-pitch is 12. TV-lines, Character-pitch is 6 TV-points. +;That's 96. chrs/line exactly and 37. and 11./12. lines (3552. chrs). + +A=1 +B=2 +C=3 +D=4 +E=5 +F=6 +G=7 + +T=10 +U=11 +V=12 +W=13 +X=14 +Y=15 +Z=16 + +P=17 + +TVPAGE==370 ;last ten pages in memory +TV==TVPAGE*2000 ;address of beg of tv buffer +TVEND==TVPAGE*2000+10*2000-1 ;black/white bit and frame start number + +TYOC==2 +DTYOC==3 +DSKC==4 ;for now +NULLP==1 ;GDFA +BEG: MOVE P,[-20,,PDL] + .SUSET [.RHSNAME,,HSNAME] + MOVE A,[-10,,TVPAGE] + MOVEI B,0 + .CALL CORMAP ;map in tv pages. + .LOSE %LSSYS + .OPEN TYOC,[%TJSIO+.UAO,,'TTY/] ;char unit out (superimage mode) + .LOSE %LSFIL + .OPEN DTYOC,[%TJDIS+.UAO,,'TTY/] ;char unit out, disp + .LOSE %LSFIL + SETZM TTYNUM' + PUSHJ P,READNM ;get file name if any + SKIPN B,TTYNUM ;if ttynum is 0, don't need to hack .TVCREG + JRST START + tlo b,400000 ; + .call [setz ? 'tvwher ? b ? movem b ? setzm b] + .lose %lssys + .suset [.rtvcreg,,a] ;get our tvcreg + tlz a,1774 ;mask out our buffer number + lsh b,2 + tso a,b ;put in his + .suset [.stvcreg,,a] ;set it (isn't memory mapping fun?) + jrst start + +readnm: .break 12,[..rjcl,,jcl] ;get job control language + move c,[440700,,jcl] + movei f,FILE1 +scanon: move d,[440600,,g] ;first file name ? + setz g, +cntrlp: ildb a,c + skipn a + popj p, + cain a," ;:RECORD FOO;HIS SCREENT56 RECORDS T56 INSTEAD + jrst param + CAIN A,^Q + JRST QUOTED + caig a,40 + jrst cntrlp +goblop: CAIN A,^Q + JRST QUOTED + cain a,": + jrst colons + cain a,"; + jrst semico + caig a,40 + jrst spacer ;space + caige a,140 + subi a,40 ;number + idpb a,d + ildb a,c + jrst goblop + +QUOTED: ILDB A,C + CAIL A,"` + SUBI A,40 ;lower case -> UPPER CASE + CAIL A,40 + CAILE A,"_ + .VALUE [ASCIZ |:You can quote it to death, it still ain't SIXBIT. +:KILL |] + SUBI A,40 ;convert to sixbit + IDPB A,D + ILDB A,C + JRST GOBLOP + +spacer: skipn g + jrst scanon + movem g,(f) + movei f,FILE2 + jrst scanon + +semico: movem g,HSNAME + jrst scanon + +colons: MOVEM G,DEVICE ;oh, really? + jrst scanon + +param: ildb a,c ;ignore for now (the slash) + cain a,"t + jrst param ;flush the T in T53... + cain a,"T + jrst param + cail a,"0 + caile a,"7 + jrst spacer + subi a,"0 + move b,ttynum + imuli b,10 + add b,a + movem b,ttynum + jrst param + +CORMAP: SETZ + 'CORBLK + 1000,,600000 + 1000,,-1 + A + 1000,,-2 + SETZ B + +DEVICE: SIXBIT /DSK/ +HSNAME: SIXBIT /HSNAME/ +FILE1: SIXBIT /RECORD/ +FILE2: SIXBIT />/ + +start: setzm tvend + pushj p,tvread ;read the pad + movei a,200000 + xorm a,tvend + pushj p,spew ;dump it on dsk as RECORD > + movei a,200000 + xorm a,tvend + .logout + .break 16,124000 + +makcod: pushj p,chrmap ;make up map + jrst wrtcod ;write out code + +demo: pushj p,alpha ;all ASCII chrs + jrst start ;test with full screen + +opndsk: .CALL [ SETZ + SIXBIT /OPEN/ + [.UAO,,DSKC] + DEVICE + FILE1 + FILE2 + SETZ HSNAME] + .LOSE %LSFIL + popj p, + +klear: .iot dtyoc,[^P] + .iot dtyoc,["C] + .iot dtyoc,[^P] + .iot dtyoc,["T] + popj p, + +;stuff for getting various codes + +spray: pushj p,.+1 ;do next twice + movei t,5 ;two lines of five characters +sprlp: .iot tyoc,a + sojg t,sprlp +carret: .iot dtyoc,[^M] ;return the carriage! + popj p, + +alpha: pushj p,klear + pushj p,anolp ;fill screen with ASCII + pushj p,carret + pushj p,anolp +alplop: move x,tv+18.*18.+17. ;last word middle of second txt line + hrrz x,x + jumpe x,alplop + movei a,1 + .sleep a, +fstcpy: movei x,tv+12.*18. + hrli x,-12.*18.*34. + move b,[move a,(x)] + move c,[movem a,12.*18.(x)] + move d,[aobjn x,b] + move e,[popj p,] + jrst b + +anolp: movei a,40+1 ;don't start with space +alphlp: .iot tyoc,a + aos a + caige a,177 + jrst alphlp + popj p, + +linot: movei t,30. ;5 characters worth +zaplp: jumpl u,stars ;test left-most bit + .iot tyoc,[".] ;bit was 0 + skipa +stars: .iot tyoc,["@] ;bit was 1 + .iot tyoc,[" ] ;spacer + lsh u,1 ;move to next bit + sojg t,zaplp + jrst carret + +dochr: pushj p,klear ;analyze one character + pushj p,spray + movei t,10. ;wait a while + .sleep t, +dotot: movei z,tv ;analyze two text lines + movei v,24. ;that is 24 TV-lines +dotlp: move u,(z) + pushj p,linot ;do one TV-line + addi z,18. ;advance to next TV-line + sojg v,dotlp + popj p, + +cycle: movei a,1 ;do all characters +cyclp: pushj p,dochr + aos a + movei t,60. + .sleep t, + cail a,177 + popj p, + jrst cyclp + +;stuff for building character code table + +chrsee: pushj p,klearb ;clear area in top left of screen. + .iot tyoc,a ;output the character + pushj p,carret + .iot tyoc,["@] ;glitch on next line + .call [ setz ? 'finish ? 401000,,tyoc] ;wait for chars to really get there. + .lose %lssys + skipn tv+18.*18 + jrst .-1 ;wait for chars to REALLY get there. +chrlis: movei z,tv ;pointer + move f,[440600,,u] ;byte ptr to assembly place + movei t,10. ;12. tv-lines of which 10. are used + movei u,0 + movei v,0 +chrlop: move c,(z) ;get from screen + rot c,6 + andi c,37 ;look only at last 5 of the 6 bits + idpb c,f + addi z,18. ;to next tv-line + sojg t,chrlop + popj p, ;code in u,v + +klearb: movei t,tv + movei u,24. + setzm (t) + addi t,18. + sojg u,.-2 + .iot dtyoc,[^P] + .iot dtyoc,["T] ;home cursor + popj p, + +chrmap: hrlzi a,-200 ;map out all characters + movei w,chrtbl +chrmlp: pushj p,chrsee + movem u,0(w) + movem v,1(w) + addi w,2 + aobjn a,chrmlp + setzm chrtbl + setzm chrtbl+1 + popj p, + +wrtcod: pushj p,opndsk + movei w,chrtbl ;write out all codes + movei v,200 +wrtlop: pushj p,twout + .iot dskc,[^M] + .iot dskc,[^J] + addi w,2 + sojg v,wrtlop + .close dskc, + .break 16,160000 + +twout: move f,0(w) ;write two octal words in digits + pushj p,octout + move f,1(w) +octout: movei g,12. ;number in f + .iot dskc,[^I] +octlp: movei e,6 + lshc e,3 + .iot dskc,e + sojg g,octlp + .iot dskc,[^M] + .iot dskc,[^J] + popj p, + +;stuff for reading a pad + +decode: lsh a,-4 ;fill in last 4 bits + lshc a,4 ;and gobble next words + lsh b,-10 ;fill in last 8 bits + lshc b,10 ;and gobble next words + ;a has 36, b has 36, c has 24 bits. + move d,[440600,,a] + movei x,16. ;do in 16 6-bit chunks +ildlp: ildb e,d ;get one + idpb e,f ;dump one out + sojg x,ildlp + popj p, + +deline: movei y,6 ;6 3-word scoops +delilp: move a,0(z) + move b,1(z) + move c,2(z) + addi z,3 + pushj p,decode ;sort out into 16 6-bit chunks + sojg y,delilp + popj p, + +detxt: movei a,10. ;12. tv-lines per txt-line + movem a,tvslin + move f,[440600,,linbuf] ;where to put decoded bits +detlp: pushj p,deline ;decode one TV-line + sosle tvslin + jrst detlp + addi z,18.*2 ;space over unused tv-lines + popj p, ;have now repacked one txt-line + +codgen: move e,[440600,,a] ;where to put result + movei a,0 + movei b,0 + movei d,10. ;12 tv-lines of which 10. are used +codglp: ldb c,f ;get 6 bits + andi c,37 ;use last 5 of the 6 bits + idpb c,e ;save 'em up + addi f,16. ;advance to next line + sojg d,codglp + popj p, ;two-word code in a,b + +lokup: movem a,wrdone ;put at end of table + movem b,wrdtwo + movei c,chrtbl ;look up code in a,b + jumpn a,t + jumpn b,t + movei a,40 ;blank or space + popj p, + +match: move a,c + subi a,chrtbl ;found it + lsh a,-1 ;divide by two + caie a,200 ;last one ? + popj p, + aos bumchr ;add to bum chr count + pushj p,crfind ;now do hairy test instead + skipe a,f ;first one ? + cain a,200 ;last one ? + movei a,40 ;too bad + popj p, + +crfind: movei d,chrtbl ;find best match + movei e,5 ;max mismatch allowed + movei f,0 ;in case nothing is a close match +crflup: move c,e + move a,wrdone + xor a,0(d) ;bits wrong in word one + pushj p,bitcnt ;count bits + jrst chrlos ;too bad + move a,wrdtwo + xor a,1(d) ;bits wrong in word two + pushj p,bitcnt ;count bits + jrst chrlos ;too bad + sub e,c + move f,d + subi f,chrtbl + lsh f,-1 + caig e,1 + popj p, ;done if only one bit off +chrlos: addi d,2 + jrst crflup + +bitcnt: jumpe a,bclred ;count bits + movn b,a ;complement and add 1 + and b,a ;clr all but right-most bit + xor a,b ;now reset same bit in a + sojg c,bitcnt + popj p, ;too many bits +bclred: aos (p) + popj p, + +tvread: pushj p,fstlop ;set up fast search in acs + move a,[440700,,chrbuf] ;place to put decoded output + movem a,bufbyt ;byte pointer to buffer + movem a,lstful ;last non-empty line + movei z,tv + movei a,37. ;txt-lines per page + movem a,lincnt + setzm tv+13. ;clear busy zapped word +tvrelp: pushj p,detxt ;convert a line + pushj p,outxt ;uncode and spew out + sosle lincnt + jrst tvrelp + move a,lstful ;ptr to last non-empty line + movem a,bufbyt + setzm a + idpb a,bufbyt ;mark the end + idpb a,bufbyt ;mark the end + popj p, ;have now translated full pad + +outxt: movei a,96. ;characters per line + movem a,chrlin + move y,bufbyt ;last non-space + movem y,bufstn ;start of this line + move x,[440600,,linbuf] ;byte ptr to packed bits +outlp: ibp x ;advance byt ptr + move f,x ;copy byt ptr + pushj p,codgen ;gen two word code + pushj p,lokup ;look it up + move b,bufbyt ;save for exl case + cain a,^Q ;if ^Q or ^@, quote it so null wins (unquoted ^@ ->eof) + jrst quotit + jumpe a,quotit +outlp1: idpb a,bufbyt ;output it + caie a,40 ;space ? + move y,bufbyt + sosle chrlin + jrst outlp + cain a,"! ;was last chr an exl ? + jrst norend ;leave it + movem y,bufbyt ;reset to last non space + pushj p,carry + camn y,bufstn ;anything on this line ? + popj p, ;no + move y,bufbyt + movem y,lstful ;last non-empty line + popj p, + +quotit: movei y,^Q + idpb y,bufbyt + jrst outlp1 + +carry: movei a,^M ;put in carriage + idpb a,bufbyt + movei a,^J ;put in line feed + idpb a,bufbyt + popj p, + +norend: movem b,bufbyt ;omitt exl + popj p, + +fstlop: move g,[addi c,2] + move t,[camn a,0(c)] + move u,[came b,1(c)] + move v,[jrst g] + move w,[jrst match] + popj p, + +spew: pushj p,opndsk + move w,[440700,,chrbuf] ;spew out what it thinks is there +spewlp: ildb a,w + cain a,^Q ;is it a quoted char? + jrst [ildb a,w ? jrst spewl1] + jumpe a,spewen +spewl1: camn a,cntchr ;is it control prefix? + PUSHJ P,cntxt ;yes + .iot dskc,a + jrst spewlp + +cntxt: ildb a,w ;HERE WE CLOBBERRED THE CONTROL-PREFIX WITH THE CHAR THAT FOLLOWED + CAIN A,"? ;IT'S A RUBOUT, PUT ONE THERE + JRST [MOVEI A,[177] ? POPJ P,] + CAIL A,"@ + CAILE A,"_ ;ITEM THAT FOLLOWED WAS NOT LEGIT, SO DON'T CONTROLLIFY + JRST [.IOT DSKC,CNTCHR ? POPJ P,] + subi a,100 ;IT'S A CONTROL CHAR, SO CHANGE TWO CHARS TO ONE. + POPJ P, + +spewen: .close dskc, + popj p, + +bufstn: 0 ;first chr on this line +lstful: 0 ;byte ptr to last non-empty line +bumchr: 0 ;bad characters seen +tvslin: 0 ;tv-line counter +chrlin: 0 ;chr on line counter +lincnt: 0 ;line on page counter +cntchr: 13 ; is almost always prefix to a control-char. +bufbyt: 0 ;pointer to buffer of characters + +chrbuf: block 37.*20. ;place to assemble output + +linbuf: block 16.*12. ;buffer for one tv-line of bits + +;chr code is 12.*6 bit of which 10.*5 are used. + +chrtbl: ;table of codes for 128. ASCII chrs +IFN NULLP, 000000161616 ;IF CENTER-DOT = 0 (CURRENTLY SCREWS UP ASCIZ OUTPUT.) +IFE NULLP, 0 + 000000000000 + 000404040425 + 160400000000 + 000000152222 + 221500000000 + 000000162136 + 213620200000 + 000000041221 + 000000000000 + 000000003701 + 010000000000 + 000000061016 + 100600000000 + 000000371212 + 121200000000 + 000020201004 + 122100000000 + 002112041221 + 211600000000 + 001601020412 + 211600000000 + 000416250404 + 040400000000 + 000404370404 + 370000000000 + 000016253725 + 160000000000 + 000000122525 + 120000000000 + 001402011721 + 211600000000 + 000017202020 + 170000000000 + 000036010101 + 360000000000 + 000016212121 + 000000000000 + 000021212116 + 000000000000 + 002121372112 + 120400000000 + 003701011701 + 013700000000 + 000016332533 + 160000000000 + 000402370204 + 103710040000 + 000004103710 + 040000000000 + 000004023702 + 040000000000 + 000102370437 + 102000000000 + 000404122112 + 040400000000 + 000204100402 + 001600000000 + 001004020410 + 001600000000 + 000037003700 + 370000000000 + 000000211204 + 000000000000 + + 000000000000 + 000000000000 + 000404040404 + 000400000000 + 121212000000 + 000000000000 + 000012371212 + 371200000000 + 041625241605 + 251604000000 + 003731020410 + 232300000000 + 001024241025 + 221500000000 + 141430000000 + 000000000000 + 000102040404 + 020100000000 + 002010040404 + 102000000000 + 000425160416 + 250400000000 + 000004043704 + 040000000000 + 000000000000 + 141430000000 + 000000003700 + 000000000000 + 000000000000 + 141400000000 + 000001020410 + 200000000000 + 001621232531 + 211600000000 + 000414040404 + 041600000000 + 001621010204 + 103700000000 + 001621010601 + 211600000000 + 000206122237 + 020200000000 + 003720360101 + 211600000000 + 000610203621 + 211600000000 + 003701020204 + 040400000000 + 001621211621 + 211600000000 + 001621211701 + 021400000000 + 000000141400 + 141400000000 + 000000141400 + 141430000000 + 000002041004 + 020000000000 + 000000370037 + 000000000000 + 000010040204 + 100000000000 + 001621020404 + 000400000000 + + 001621272527 + 201600000000 + 001621213721 + 212100000000 + 003621213621 + 213600000000 + 001621202020 + 211600000000 + 003611111111 + 113600000000 + 003720203620 + 203700000000 + 003720203620 + 202000000000 + 001621202023 + 211600000000 + 002121213721 + 212100000000 + 001604040404 + 041600000000 + 000101010101 + 211600000000 + 002122243024 + 222100000000 + 002020202020 + 203700000000 + 002133252121 + 212100000000 + 002121312523 + 212100000000 + 001621212121 + 211600000000 + 003621213620 + 202000000000 + 001621212125 + 221500000000 + 003621213624 + 222100000000 + 001621201601 + 211600000000 + 003704040404 + 040400000000 + 002121212121 + 211600000000 + 002121212112 + 120400000000 + 002121212125 + 332100000000 + 002121120412 + 212100000000 + 002121120404 + 040400000000 + 003701023710 + 203700000000 + 070404040404 + 040407000000 + 000020100402 + 010000000000 + 340404040404 + 040434000000 + 041221000000 + 000000000000 + 000000000000 + 000000370000 + + 060603000000 + 000000000000 + 000000160117 + 211700000000 + 002020362121 + 213600000000 + 000000162120 + 201700000000 + 000101172121 + 211700000000 + 000000162136 + 201600000000 + 000611103410 + 101000000000 + 000000162121 + 211701160000 + 002020362121 + 212100000000 + 000004000404 + 040400000000 + 000001000101 + 010121160000 + 002020212234 + 222100000000 + 000404040404 + 040400000000 + 000000322525 + 252500000000 + 000000263121 + 212100000000 + 000000162121 + 211600000000 + 000000362121 + 213620200000 + 000000162121 + 211701010000 + 000000263120 + 202000000000 + 000000172016 + 013600000000 + 000404370404 + 040300000000 + 000000212121 + 211600000000 + 000000212121 + 120400000000 + 000000212125 + 251200000000 + 000000211204 + 122100000000 + 000000212121 + 120410200000 + 000000370216 + 103700000000 + 010202020402 + 020201000000 + 040404040404 + 040404040000 + 201010100410 + 101020000000 + 152600000000 + 000000000000 + 020504040404 + 042410000000 + +wrdone: 0 ;place to put thing to match against +wrdtwo: 0 ;ditto + +jcl: block 20 + +pdl: block 40 + +pat: +patch: block 40 + + end beg