github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-17 00:33:22 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/sysen2/record.31
Lars Brinkhoff 36d0a0c2f5 RECORD - save TV display contents as text file.
2018-07-30 20:35:40 +02:00

785 lines
15 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;-*-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 ;<tty>
.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
Reference in New Issue View Git Blame Copy Permalink