;-*-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