mirror of
https://github.com/PDP-10/its.git
synced 2026-01-28 12:59:20 +00:00
Eric Swenson
committed by
Lars Brinkhoff
Lars Brinkhoff
parent
ffcc79dd16
commit
6b9cf5348f
578
src/sysen3/usq.61
Normal file
578
src/sysen3/usq.61
Normal file
@@ -0,0 +1,578 @@
|
||||
;-*- Midas -*- GZ@MIT-MC, March, 1983
|
||||
TITLE USQ - Unsqueeze/uncram files
|
||||
F==0
|
||||
T1==1
|
||||
T2==2
|
||||
T3==3
|
||||
T4==4
|
||||
A=5
|
||||
B=6 ;Current input byte
|
||||
C=7 ;Number of bits left in file.
|
||||
D=10
|
||||
E=11
|
||||
|
||||
T=12 ;First unused byte in memory
|
||||
IBP=13 ;Input byte pointer
|
||||
CS=14 ;Checksum
|
||||
L=15 ;Last character
|
||||
|
||||
IntAC=16
|
||||
|
||||
P=17
|
||||
|
||||
EOF==400
|
||||
DLE==220
|
||||
ID1==166 ;First ID byte
|
||||
SQID2==377 ;Second ID byte for SQ'ed files
|
||||
oCRID2==367 ;Second ID byte for old CRAM'ed files
|
||||
CRID2=357 ;Second ID byte for CRAM'ed files
|
||||
|
||||
inch==1
|
||||
outch==inch
|
||||
tyoch==2
|
||||
tyich==3
|
||||
|
||||
call=<pushj p,>
|
||||
return=<popj p,>
|
||||
|
||||
pdllen==60.
|
||||
.vector pdl(pdllen)
|
||||
|
||||
Jclbuf: block 40
|
||||
^C_35
|
||||
|
||||
.vector Tree(400)
|
||||
|
||||
IDev: sixbit/DSK/
|
||||
IFn1: 0
|
||||
IFn2: sixbit/>/
|
||||
ISnm: 0
|
||||
|
||||
ODev: sixbit/DSK/
|
||||
OFn1: 0
|
||||
OFn2: sixbit/USQ/
|
||||
OSnm: 0
|
||||
|
||||
define syscal op,args
|
||||
.call [setz ? sixbit/op/ ? args ((setz))]
|
||||
termin
|
||||
|
||||
tsiot: setz
|
||||
sixbit/SIOT/
|
||||
%Climm,,tyoch
|
||||
T2
|
||||
T1 ((setz))
|
||||
|
||||
define type &string
|
||||
movei T1,<.length string>
|
||||
move T2,[440700,,[ascii string]]
|
||||
.call tsiot
|
||||
.Lose %LsSys
|
||||
termin
|
||||
|
||||
define jerr &string
|
||||
jrst [type string
|
||||
jrst Die]
|
||||
termin
|
||||
|
||||
f%type==1 ;This is a TYPEsq
|
||||
f%com==2 ;Output COM file
|
||||
f%bin==4 ;Output BIN file
|
||||
f%asc==10 ;Output Ascii file
|
||||
f%tty==20 ;Output to TTY
|
||||
f%crm==40 ;Doing a CRAM'ed file
|
||||
f%rpt==100 ;Do DLE-repeat stuff
|
||||
f%z==200 ;Allow ^Zs inside (ascii) file
|
||||
|
||||
Tsint: loc 42
|
||||
-Tsintl,,Tsint
|
||||
loc Tsint
|
||||
P
|
||||
0 ? 1_tyich ? 0 ? 1_tyich ? Flush
|
||||
Tsintl==.-Tsint
|
||||
|
||||
Flush: movei IntAC,tyich
|
||||
.ityic IntAC,
|
||||
jrst flush0
|
||||
caie IntAC,^G
|
||||
cain IntAC,^S
|
||||
jrst flush1
|
||||
flush0: syscal dismis,[p]
|
||||
.Lose %LsSys
|
||||
|
||||
flush1: .reset outch,
|
||||
syscal ttyfls,[%clbit,,1 ? %climm,,tyich]
|
||||
.Lose %LsSys
|
||||
.iot outch,IntAC
|
||||
Jrst Die
|
||||
|
||||
RSIXTP: trne F,f%type
|
||||
return
|
||||
caie A,"/
|
||||
cain A,",
|
||||
aos (p)
|
||||
return
|
||||
|
||||
SWITCH: cain A,"A
|
||||
jrst [tro F,f%asc ? return]
|
||||
cain A,"B
|
||||
jrst [tro F,f%bin ? return]
|
||||
cain A,"C
|
||||
jrst [tro F,f%com ? return]
|
||||
cain A,"T
|
||||
jrst [tro F,f%tty ? return]
|
||||
cain A,"Z
|
||||
jrst [tro F,f%z ? return]
|
||||
type "AIllegal switch -- /"
|
||||
.iot tyoch,A
|
||||
jrst Die
|
||||
|
||||
SwiChk: trnn F,f%bin\f%com
|
||||
return
|
||||
trne F,f%asc\f%tty
|
||||
jrst SwiCh1
|
||||
trne F,f%bin
|
||||
trnn F,f%com
|
||||
return
|
||||
SwiCh1: type "AIncompatible switches"
|
||||
jrst Die
|
||||
|
||||
$$RFN==1
|
||||
$$SWITCH==1
|
||||
.insrt dsk:syseng;rfn >
|
||||
|
||||
FType: move T1,(A)
|
||||
call 6Type
|
||||
.iot tyoch,[":]
|
||||
move T1,3(A)
|
||||
call 6Type
|
||||
.iot tyoch,[";]
|
||||
move T1,1(A)
|
||||
call 6Type
|
||||
.iot tyoch,[40]
|
||||
move T1,2(A)
|
||||
6Type: setz T2,
|
||||
rotc T1,6
|
||||
addi T2,40
|
||||
.iot tyoch,T2
|
||||
jumpn T1,6Type
|
||||
return
|
||||
|
||||
.scalar OutPtr
|
||||
|
||||
.scalar Memt ;End of memory
|
||||
|
||||
OSize: 0 ;Output file size (for CRAM'ed files)
|
||||
|
||||
NextTr: Tree ;Next tree for CRAM'ed files
|
||||
|
||||
TrInit: trne F,f%crm
|
||||
jrst CRInit
|
||||
sojl C,ErrEof
|
||||
ildb E,IBP ;Number of nodes
|
||||
sojl C,ErrEof
|
||||
ildb T1,IBP
|
||||
lsh T1,8
|
||||
addb E,T1
|
||||
caile E,256.
|
||||
jerr "ABad node count in file."
|
||||
imuli T1,4 ;Account for # words taken by tree
|
||||
sub C,T1
|
||||
jumpl C,ErrEof
|
||||
imuli C,8 ;Convert to bit count
|
||||
jumpe E,[movei T1,-1#EOF ? movem T1,NextTr ? return]
|
||||
setz D,
|
||||
SqTree: call sqnode
|
||||
move A,T1
|
||||
call sqnode
|
||||
hrl T1,A
|
||||
movem T1,Tree(D)
|
||||
aoj D,
|
||||
came D,E
|
||||
jrst SqTree
|
||||
cpopj: return
|
||||
|
||||
sqnode: ildb T1,IBP
|
||||
ildb T2,IBP
|
||||
lsh T2,34
|
||||
ash T2,-24
|
||||
add T1,T2
|
||||
jumpl T1,cpopj
|
||||
caml T1,E
|
||||
jerr "ABad tree pointer."
|
||||
movei T1,Tree(T1)
|
||||
return
|
||||
|
||||
|
||||
CRInit: sojl C,ErrEof
|
||||
ildb E,IBP
|
||||
imuli C,8.
|
||||
setzm Tree ;Clear Tree for error checking later
|
||||
move T1,[Tree,,Tree+1]
|
||||
blt T1,Tree+377
|
||||
CRTree: call inchr ;Read the trees
|
||||
movei D,Tree(A)
|
||||
call crnode
|
||||
sojge E,CRTree
|
||||
call inchr ;Get first char
|
||||
move L,A
|
||||
move T1,Tree(L)
|
||||
movem T1,NextTr
|
||||
return
|
||||
|
||||
crnode: trnn C,7
|
||||
ildb B,IBP
|
||||
sojl C,ErrEof
|
||||
rot B,-1
|
||||
jumpge B,[call inchr ;Leaf
|
||||
setca A,
|
||||
hrrm A,(D)
|
||||
return]
|
||||
caml T,Memt ;Else branch, allocate a cell for it
|
||||
jrst [movei T1,2000
|
||||
addm T1,Memt
|
||||
.suset [.sMemt,,Memt]
|
||||
jrst .+1]
|
||||
hrrm T,(D) ;Save pointer to branch node
|
||||
move D,T
|
||||
aoj T,
|
||||
push p,D
|
||||
call crnode ;Get car
|
||||
pop p,D
|
||||
movss (D) ;Put it on the left
|
||||
jrst crnode ;And put cdr on the right
|
||||
|
||||
inchr: subi C,8
|
||||
jumpl C,ErrEof
|
||||
ildb A,IBP
|
||||
movei T2,7
|
||||
and T2,C
|
||||
movn T1,T2
|
||||
rot B,(T1)
|
||||
lshc A,-8(T2)
|
||||
lsh B,-34
|
||||
exch A,B
|
||||
return
|
||||
|
||||
|
||||
getch: hrre A,NextTr
|
||||
jumpe A,[type "AAttempt to access an undefined tree."
|
||||
jrst Die]
|
||||
jumpl A,getch2 ;Predetermined
|
||||
getch1: trnn C,7
|
||||
ildb B,IBP
|
||||
sojl C,ErrEof
|
||||
rot B,-1
|
||||
hrre T1,(A)
|
||||
skipl B
|
||||
hlre T1,(A)
|
||||
move A,T1
|
||||
jumpge A,getch1
|
||||
getch2: setca A,
|
||||
trnn F,f%crm
|
||||
return
|
||||
move T1,Tree(A)
|
||||
movem T1,NextTr
|
||||
return
|
||||
|
||||
ZCnt: 0
|
||||
|
||||
putch: trnn F,f%bin\f%com
|
||||
caie A,^Z
|
||||
jrst putch1
|
||||
aos ZCnt
|
||||
return
|
||||
|
||||
putch1: skipn ZCnt
|
||||
jrst putch2
|
||||
trnn F,f%z
|
||||
return ;Wants to ignore stuff after first ^Z
|
||||
push p,A
|
||||
movei A,^Z
|
||||
call putch2
|
||||
sose ZCnt
|
||||
jrst .-2
|
||||
pop p,A
|
||||
putch2: trne F,f%tty\f%type
|
||||
jrst [.iot outch,A ? return]
|
||||
came T,Memt
|
||||
jrst putch3
|
||||
movei T1,2000
|
||||
addb T1,Memt
|
||||
movei T1,1(T1)
|
||||
.suset [.sMemt,,T1]
|
||||
putch3: idpb A,T
|
||||
return
|
||||
|
||||
|
||||
Begin: move p,[-pdllen,,pdl-1]
|
||||
syscal open,[%clbit,,.uao\%tjdis ? %climm,,tyoch ? [sixbit/TTY/]]
|
||||
.Lose %LsFil
|
||||
movei F,f%rpt ;Assume do DLE stuff
|
||||
.suset [-4,,[.rHsname,,B ? .rXuname,,IFn1 ? .rMemt,,Memt
|
||||
.rXjname,,A ]]
|
||||
movem B,ISnm
|
||||
movem B,OSnm
|
||||
ldb T1,[360600,,A]
|
||||
cain T1,'T
|
||||
tro F,f%type
|
||||
.break 12,[..rJCL,,Jclbuf]
|
||||
skipn Jclbuf
|
||||
jrst NoJcl
|
||||
ldb T1,[261600,,Jclbuf]
|
||||
cain T1,<ascii/?î/>_-26
|
||||
jrst Help
|
||||
IFile: movei B,IDev
|
||||
move D,[440700,,Jclbuf]
|
||||
call RFN"rfn
|
||||
syscal open,[%clbit,,.uii ? %climm,,inch ? IDev ? IFn1 ? IFn2 ? ISnm]
|
||||
jrst [movei A,IDev ? call FType ? type " - file not found."
|
||||
jrst Die]
|
||||
; syscal rfname,[%climm,,inch ? %clout,,IDev
|
||||
; %clout,,IFn1 ? %clout,,IFn2 ? %clout,,ISnm]
|
||||
; .Lose %LsFil
|
||||
syscal fillen,[%climm,,inch ? %clout,,L]
|
||||
.Lose %LsFil
|
||||
jumpe L,ErrEof ;Flush COM header if any
|
||||
.iot inch,T1
|
||||
camn T1,[sixbit/DSK8/]
|
||||
sosa L
|
||||
.access inch,[0]
|
||||
jumpe L,ErrEof ;Get 1st word now to look at the ID.
|
||||
.iot inch,FBuf
|
||||
move IBP,[441000,,FBuf]
|
||||
ildb T1,IBP
|
||||
caie T1,ID1
|
||||
jrst IDErr
|
||||
ildb T1,IBP
|
||||
cain T1,SQID2
|
||||
jrst OFile
|
||||
tro F,f%crm
|
||||
cain T1,CRID2
|
||||
jrst OFile
|
||||
trz F,f%rpt
|
||||
cain T1,oCRID2
|
||||
jrst OFile
|
||||
IDErr: type "AThis file was not SQ'ed or CRAM'ed!"
|
||||
jrst Die
|
||||
|
||||
OFile: move T1,IFn1
|
||||
movem T1,OFn1
|
||||
move T1,[sixbit/UNCRAM/]
|
||||
trne F,f%crm
|
||||
movem T1,OFn2
|
||||
movei B,ODev
|
||||
cain A,",
|
||||
call RFN"rfn
|
||||
call SwiChk
|
||||
;Output defaults to home dir now.
|
||||
; move T1,[sixbit/DSK/]
|
||||
; skipn OSnm
|
||||
; move T1,IDev
|
||||
; skipn ODev
|
||||
; movem T1,ODev
|
||||
; move T1,ISnm
|
||||
; skipn OSnm
|
||||
; movem T1,OSnm
|
||||
Snarf: movei T,FBuf(L)
|
||||
camg T,Memt
|
||||
jrst Snarf1
|
||||
movei T1,1777(T)
|
||||
trz T1,1777
|
||||
movem T1,Memt
|
||||
.suset [.sMemt,,T1]
|
||||
Snarf1: move T1,[004400,,FBuf]
|
||||
movei T2,-1(L)
|
||||
syscal siot,[%climm,,inch ? T1 ? T2]
|
||||
.Lose %LsFil
|
||||
.close inch,
|
||||
Header: move IBP,[241000,,FBuf] ;IBP=byte pointer
|
||||
movei C,-1(L) ;C=Byte count
|
||||
imuli C,4
|
||||
ildb CS,IBP ;Checksum
|
||||
ildb T2,IBP
|
||||
lsh T2,8
|
||||
add CS,T2
|
||||
trnn f,f%crm
|
||||
jrst FName
|
||||
sojl C,ErrEof
|
||||
ildb T1,IBP ;Sector max
|
||||
sojl C,ErrEof
|
||||
ildb T2,IBP
|
||||
lsh T2,8
|
||||
add T1,T2
|
||||
aoj T1,
|
||||
imuli T1,128.
|
||||
movem T1,OSize
|
||||
FName: type "AOriginal name = "
|
||||
FName1: sojl C,ErrEof
|
||||
ildb A,IBP
|
||||
jumpe A,FName2
|
||||
.iot tyoch,A
|
||||
jrst FName1
|
||||
FName2: trne F,f%tty\f%type
|
||||
.iot tyoch,[^M]
|
||||
call TrInit ;Set up tree(s) and bit i/o
|
||||
trne F,f%type\f%tty
|
||||
jrst TTYIni
|
||||
|
||||
DSKIni: soj T, ;Set up output pointer
|
||||
hrli T,010700
|
||||
trne F,f%bin\f%com
|
||||
hrli T,041000
|
||||
movem T,OutPtr
|
||||
hllm T,Memt ;Make Memt into BP to last avail byte
|
||||
sos Memt
|
||||
camn T,Memt
|
||||
jrst [move T1,2000
|
||||
addb T1,Memt
|
||||
aoj T1,
|
||||
.suset [.sMemt,,T1]
|
||||
jrst .+1]
|
||||
trne F,f%com
|
||||
aoja T,[move T1,[sixbit/DSK8/] ? movem T1,(T) ? jrst Data]
|
||||
jrst Data
|
||||
|
||||
TTYIni: syscal open,[%clbit,,.uao ? %climm,,outch ? [sixbit/TTY/]]
|
||||
.Lose %LsFil
|
||||
syscal open,[%clbit,,.uai ? %climm,,tyich ? [sixbit /TTY/]]
|
||||
.Lose %LsFil
|
||||
syscal ttyset,[%climm,,tyich ? [424242,,424242] ? [434242,,424242]]
|
||||
.Lose %LsSys
|
||||
.suset [-2,,[.sOption,,[optint,,] ? .sMSK2,,[1_tyich]]]
|
||||
;jrst Data
|
||||
|
||||
Data: setz E,
|
||||
trnn f,f%crm
|
||||
jrst DataIn
|
||||
DataRp: move A,L
|
||||
DataOu: trnn f,f%crm
|
||||
caie A,EOF
|
||||
skipa
|
||||
jrst Finish
|
||||
sub CS,A
|
||||
call putch
|
||||
sosn OSize
|
||||
jrst Finish
|
||||
move L,A
|
||||
DataIn: sojge E,DataRp
|
||||
call getch
|
||||
trne f,f%rpt
|
||||
caie A,DLE
|
||||
jrst DataOu
|
||||
call getch
|
||||
sosl E,A
|
||||
jrst DataIn
|
||||
movei A,DLE
|
||||
jrst DataOu
|
||||
|
||||
Finish: jumpg E,[type "AWarning -- file ended in the middle of a repeat."
|
||||
jrst .+1]
|
||||
trne CS,177777
|
||||
jrst [type "AWarning -- bad checksum in file."
|
||||
jrst .+1]
|
||||
trne F,f%tty\f%type
|
||||
jrst Die
|
||||
move B,OutPtr
|
||||
movei C,(T) ;C= #words in use
|
||||
subi C,(B)
|
||||
trnn F,f%bin\f%com
|
||||
jrst ASav
|
||||
hrli B,004400
|
||||
movei E,.uio
|
||||
setz T1,
|
||||
BSav: tlnn T,700000 ;Round out word
|
||||
jrst Sav
|
||||
idpb T1,T
|
||||
jrst BSav
|
||||
|
||||
ASav: move T1,T
|
||||
lsh T1,-36
|
||||
idivi T1,7 ;T1 has # bytes missing in last word
|
||||
imuli C,5
|
||||
sub C,T1
|
||||
hrli B,010700
|
||||
movei E,.uao
|
||||
|
||||
Sav: move T1,OFn2
|
||||
came T1,[sixbit/</]
|
||||
camn T1,[sixbit/>/]
|
||||
jrst Sav1
|
||||
syscal open,[%clbit,,.uii ? %climm,,outch ? ODev ? OFn1 ? OFn2 ? OSnm]
|
||||
jrst Sav1
|
||||
syscal rfname,[%climm,,outch
|
||||
%clout,,ODev ? %clout,,OFn1 ? %clout,,OFn2 ? %clout,,OSnm]
|
||||
.Lose %LsFil
|
||||
.close outch,
|
||||
syscal open,[%clbit,,.uai ? %climm,,tyich ? [sixbit/TTY/]]
|
||||
.Lose %LsFil
|
||||
Ask: type "AFile "
|
||||
movei A,ODev
|
||||
call FType
|
||||
type " already exists. "
|
||||
Ask1: type "Do you want to delete it (Y or N)?"
|
||||
.iot tyich,T1
|
||||
caie T1,"Y
|
||||
cain T1,"y
|
||||
jrst Yes
|
||||
caie T1,"N
|
||||
cain T1,"n
|
||||
jrst No
|
||||
cain T1,^L
|
||||
jrst SClear
|
||||
.iot tyoch,[^G]
|
||||
.iot tyoch,[^M]
|
||||
.iot tyoch,[^J]
|
||||
jrst Ask1
|
||||
SClear: .iot tyoch,[^P]
|
||||
.iot tyoch,["C]
|
||||
jrst Ask
|
||||
|
||||
No: .iot tyoch,["o] ;Loser
|
||||
jrst Die
|
||||
|
||||
Yes: .iot tyoch,["e]
|
||||
.iot tyoch,["s]
|
||||
Sav1: syscal open,[%clbtw,,E ? %climm,,outch
|
||||
ODev ? OFn1 ? OFn2 ? OSnm]
|
||||
.Lose %LsFil
|
||||
syscal rfname,[%climm,,outch ? %clout,,ODev
|
||||
%clout,,OFn1 ? %clout,,OFn2 ? %clout,,OSnm]
|
||||
.Lose %LsFil
|
||||
type "AWriting "
|
||||
movei A,ODev
|
||||
call FType
|
||||
syscal siot,[%climm,,outch ? B ? C]
|
||||
.Lose %LsFil
|
||||
.close outch,
|
||||
Die: .break 16,120000
|
||||
|
||||
ErrEof: type "APremature end of file."
|
||||
jrst Die
|
||||
|
||||
NoJcl:
|
||||
Help: trne F,f%type
|
||||
jrst THelp
|
||||
type "A:USQ input file [,output file] [/A or /C or /T or /B or /Z]
|
||||
|
||||
/Z means ^Z's are allowed in the file.
|
||||
|
||||
Other switches specify the OUTPUT file format:
|
||||
/A (the default) means an ascii file, /C means a COM file, /T means ascii
|
||||
output to terminal, /B means a random binary file.
|
||||
|
||||
Output file defaults to your home directory with the same name as the input
|
||||
and the file type of USQ or UNCRAM, depending on whether the input file was
|
||||
SQ'ed or CRAM'ed."
|
||||
jrst Die
|
||||
THelp: type "A:TYPESQ input file
|
||||
Unsqueezes the input file and types it out."
|
||||
jrst Die
|
||||
|
||||
VARIAB
|
||||
|
||||
junk: CONSTA
|
||||
|
||||
FBuf: 0
|
||||
|
||||
end begin
|
||||
Reference in New Issue
Block a user