mirror of
https://github.com/PDP-10/its.git
synced 2026-04-08 14:38:42 +00:00
EVACUA - encode ITS file for evacuation to Unix.
This commit is contained in:
Lars Brinkhoff
@@ -105,6 +105,15 @@ expect ":KILL"
|
||||
respond "*" ":midas bawden;_uptime\r"
|
||||
expect ":KILL"
|
||||
|
||||
# Chaosnet EVACUATE service.
|
||||
respond "*" ":midas sysbin; evacua_bawden; evacua\r"
|
||||
expect ":KILL"
|
||||
respond "*" ":job evacua\r"
|
||||
respond "*" ":load sysbin; evacua bin\r"
|
||||
respond "*" "purify\033g"
|
||||
respond "CHAOS EVACUA" "\r"
|
||||
respond "*" ":kill\r"
|
||||
|
||||
# Mini Chaosnet file server. Version 24 is MINI.
|
||||
respond "*" ":midas sysbin; mini_lmio; minisr 24\r"
|
||||
expect ":KILL"
|
||||
|
||||
@@ -90,6 +90,7 @@
|
||||
- ELIZA, the original psychiatrist game.
|
||||
- EMACS, editor.
|
||||
- ESCE, call the elevator.
|
||||
- EVACUA, encode ITS file for evacuation to Unix.
|
||||
- EXECVT, convert 20x EXE (SSAVE) file to ITS BIN (PDUMP) file.
|
||||
- EXPN/VRFY, query remote SMTP server.
|
||||
- FACTOR, factor integers.
|
||||
|
||||
391
src/bawden/evacua.53
Executable file
391
src/bawden/evacua.53
Executable file
@@ -0,0 +1,391 @@
|
||||
; -*- Midas -*-
|
||||
|
||||
title EVACUATE - Encode ITS file for evacuation to Unix
|
||||
|
||||
a=:1
|
||||
;b=:2
|
||||
;c=:3
|
||||
;d=:4
|
||||
;e=:5
|
||||
t=:6
|
||||
tt=:7
|
||||
t2=:10
|
||||
|
||||
fp=:11 ; last .IOT pointer
|
||||
bc=:12 ; output byte count
|
||||
by=:13 ; current byte/character
|
||||
wd=:14 ; current word
|
||||
ip=:15 ; aobjn to INBUF
|
||||
q=:16 ; current encoding state
|
||||
p=:17
|
||||
|
||||
..bch==:0,,-1
|
||||
chdski==:1
|
||||
cherri==:2
|
||||
chneti==:3
|
||||
chneto==:4
|
||||
|
||||
%fr==:0,,525252
|
||||
%fl==:1,,525252
|
||||
|
||||
call=:pushj p,
|
||||
return=:popj p,
|
||||
save==:push p,
|
||||
rest==:pop p,
|
||||
slose=:.lose %lssys
|
||||
pause=:.break 16,100000
|
||||
|
||||
quit=:call .
|
||||
$quit: skipe debug
|
||||
pause
|
||||
.logout 1,
|
||||
|
||||
define bltdup org,len
|
||||
move tt,[<org>,,<org>+1]
|
||||
blt tt,<org>+<len>-1
|
||||
termin
|
||||
|
||||
define syscall name,args
|
||||
.call [setz ? .1stwd sixbit /name/ ? args(400000)]
|
||||
termin
|
||||
|
||||
define conc foo,bar
|
||||
foo!bar!termin
|
||||
|
||||
popj1: aos (p)
|
||||
cpopj: return
|
||||
|
||||
.insrt dsk:syseng;chsdef >
|
||||
$cpkbp==:440800,,%cpkdt
|
||||
|
||||
.vector pkt(%cpmxw)
|
||||
|
||||
pktin: setz ? sixbit /PKTIOT/
|
||||
movei chneti
|
||||
setzi pkt
|
||||
|
||||
pktout: setz ? sixbit /PKTIOT/
|
||||
movei chneto
|
||||
setzi pkt
|
||||
|
||||
define out ac
|
||||
idpb ac,outbp
|
||||
sosg bc
|
||||
call outfls
|
||||
termin
|
||||
|
||||
define outj ac,loc
|
||||
idpb ac,outbp
|
||||
sojg bc,loc
|
||||
call outfls
|
||||
jrst loc
|
||||
termin
|
||||
|
||||
.scalar outbp
|
||||
|
||||
outfls: movei t,%cpmxc
|
||||
subi t,(bc)
|
||||
jumpe t,cpopj
|
||||
dpb t,[$cpknb pkt]
|
||||
.call pktout
|
||||
slose
|
||||
outbeg: move t,[$cpkbp pkt]
|
||||
movem t,outbp
|
||||
movei bc,%cpmxc
|
||||
return
|
||||
|
||||
outend: call outfls
|
||||
movsi t,(.byte 8 ? %coeof)
|
||||
movem t,pkt+0
|
||||
.call pktout
|
||||
slose
|
||||
syscall finish,[movei chneto]
|
||||
jfcl ; Can get DEVICE NOT READY
|
||||
return
|
||||
|
||||
.vector pdl(lpdl==:100.)
|
||||
.vector twenty(20)
|
||||
|
||||
usrvar: sixbit /OPTION/ ? tlo %opint\%opopc
|
||||
sixbit /MASK/ ? move [%pipdl\%piioc]
|
||||
sixbit /40ADDR/ ? move [twenty,,forty]
|
||||
lusrvar==:.-usrvar
|
||||
|
||||
purify: setzm debug
|
||||
movsi t,(-npure,,0)
|
||||
syscall corblk,[movei %cbndr ? movei %jself ? move t]
|
||||
slose
|
||||
move t,[-<npage-npure>,,npure]
|
||||
syscall corblk,[movei 0 ? movei %jself ? move t]
|
||||
slose
|
||||
.value [asciz ":PDUMP DSK:DEVICE;CHAOS EVACUATE"]
|
||||
go: move t,[-lusrvar,,usrvar]
|
||||
syscall usrvar,[movei %jself ? move t]
|
||||
slose
|
||||
move t,[-<npage-npure>,,npure]
|
||||
syscall corblk,[movei %cbndw ? movei %jself ? move t ? movei %jsnew]
|
||||
slose
|
||||
again: syscall chaoso,[movei chneti ? movei chneto ? movei 5]
|
||||
quit
|
||||
move p,[-lpdl,,pdl-1]
|
||||
move t,[.byte 8 ? %colsn ? 0 ? 0 ? 8]
|
||||
movem t,pkt+0
|
||||
move t,[.byte 8 ? "E ? "V ? "A ? "C]
|
||||
movem t,pkt+%cpkdt+0
|
||||
move t,[.byte 8 ? "U ? "A ? "T ? "E]
|
||||
movem t,pkt+%cpkdt+1
|
||||
.call pktout
|
||||
quit
|
||||
movei tt,30.*60.*5 ; 5 minutes
|
||||
skipe debug
|
||||
movei tt,777777 ; over 2 hours
|
||||
syscall netblk,[movei chneto ? movei %cslsn ? move tt ? movem t]
|
||||
slose
|
||||
caie t,%csrfc
|
||||
quit
|
||||
.call pktin
|
||||
slose
|
||||
ldb t,[$cpkop pkt]
|
||||
caie t,%corfc
|
||||
.lose
|
||||
ldb t,[$cpknb pkt]
|
||||
caige t,8+1+1+5 ; must be at least 5 chars long: "A;B 1"
|
||||
jrst rfcerr
|
||||
adjbp t,[340800,,pkt+%cpkdt]
|
||||
setzi tt,
|
||||
dpb tt,t
|
||||
move t,[340800,,pkt+%cpkdt+2]
|
||||
ildb tt,t ; Mode byte
|
||||
andi tt,%doimg ; Only allow Image mode bit
|
||||
syscall sopen,[moves ercode ? movsi .bai(tt) ? movei chdski ? move t]
|
||||
jrst opnerr
|
||||
movsi t,(.byte 8 ? %coopn)
|
||||
movem t,pkt+0
|
||||
.call pktout
|
||||
quit
|
||||
movsi t,(.byte 8 ? %codat)
|
||||
movem t,pkt+0
|
||||
call outbeg
|
||||
movei ip,inbuf+1
|
||||
movei q,q0
|
||||
jrst loopgo
|
||||
|
||||
rfcerr: movei a,[asciz "Bad RFC"]
|
||||
call clsbeg
|
||||
call outfls
|
||||
quit
|
||||
|
||||
clsbeg: movsi t,(.byte 8 ? %cocls)
|
||||
movem t,pkt+0
|
||||
call outbeg
|
||||
hrli a,440700
|
||||
clsbg1: ildb t,a
|
||||
jumpe t,cpopj
|
||||
outj t,clsbg1
|
||||
|
||||
.scalar ercode
|
||||
|
||||
opnerr: movei a,[asciz "Error: "]
|
||||
call clsbeg
|
||||
syscall open,[movsi .uai ? movei cherri ? [sixbit /ERR/]
|
||||
movei 4 ? move ercode]
|
||||
slose
|
||||
opner1: .iot cherri,t
|
||||
caige t,40
|
||||
jrst opner2
|
||||
outj t,opner1
|
||||
|
||||
opner2: .close cherri,
|
||||
call outfls
|
||||
jrst again
|
||||
|
||||
.vector inbuf(1+<linbuf==:6000>)
|
||||
|
||||
by=:wd-1
|
||||
|
||||
dobuf: hrli ip,(tt)
|
||||
nextwd: move wd,(ip)
|
||||
trnn wd,1
|
||||
jrst 5(q) ; Resume state machine
|
||||
binwd: skipl by,0(q) ; -1 if negative!
|
||||
jrst [ out by ; Reset state machine if needed
|
||||
movei q,q0
|
||||
setoi by,
|
||||
jrst .+1 ]
|
||||
lshc by,4
|
||||
out by
|
||||
repeat 4,[
|
||||
lshc by,8
|
||||
out by
|
||||
] ;repeat 4
|
||||
getwd: aobjn ip,nextwd ; State machine does JSP Q,GETWD
|
||||
jumple fp,eof1
|
||||
move tt,inbuf+linbuf
|
||||
movem tt,inbuf+0
|
||||
movei ip,inbuf+0
|
||||
loopgo: move fp,[-linbuf,,inbuf+1]
|
||||
.iot chdski,fp
|
||||
movei tt,1(ip)
|
||||
subi tt,(fp)
|
||||
jumpl tt,dobuf
|
||||
jumpg tt,eof0 ; zero length file
|
||||
eof1: jumpe fp,eof ; real end of file
|
||||
move wd,-1(fp)
|
||||
setzb ip,fp
|
||||
trne wd,1
|
||||
jrst binwd
|
||||
move t,wd
|
||||
xor t,[ .byte 7 ? ^C ? ^C ? ^C ? ^C ? ^C ]
|
||||
move tt,t
|
||||
subi tt,2
|
||||
xor t,tt
|
||||
jffo t,.+1
|
||||
idivi tt,7 ; TT: # extra chars in last word (0 - 4)
|
||||
addi q,1(tt)
|
||||
imuli tt,7
|
||||
lsh wd,-28.(tt)
|
||||
jrst (q)
|
||||
|
||||
eof: skipge t,0(q)
|
||||
jrst eof0
|
||||
out t
|
||||
eof0: .close chdski,
|
||||
call outend
|
||||
jrst again
|
||||
|
||||
bp0: 350700,,wd
|
||||
bp1: 260700,,wd
|
||||
bp2: 170700,,wd
|
||||
bp3: 100700,,wd
|
||||
bp4: 010700,,wd
|
||||
|
||||
rubtab: repeat 200,[
|
||||
ife .rpcnt-7, 177
|
||||
ifn .rpcnt-7,[
|
||||
ife .rpcnt-12, 215
|
||||
ifn .rpcnt-12,[
|
||||
ife .rpcnt-15, 212
|
||||
ifn .rpcnt-15,[
|
||||
ife .rpcnt-177, 207
|
||||
ifn .rpcnt-177,[
|
||||
ifg .rpcnt-155, -1
|
||||
ifle .rpcnt-155, 200+.rpcnt
|
||||
]]]]] ;repeat 200
|
||||
|
||||
if2, disp5==:disp0
|
||||
if2, qnext5==:qnext0
|
||||
|
||||
repeat 5,[
|
||||
|
||||
.bycnt==.rpcnt
|
||||
if2, .disp==<conc jrst @disp,\<.bycnt+1>,(by)>
|
||||
if2, .next==<conc qnext,\<.bycnt+1>,>
|
||||
|
||||
ife .bycnt-0,[
|
||||
define .load name,reset
|
||||
jsp q,getwd
|
||||
reset
|
||||
jrst name!4
|
||||
jrst name!3
|
||||
jrst name!2
|
||||
jrst name!1
|
||||
name!0: ldb by,bp0
|
||||
termin
|
||||
]
|
||||
ifn .bycnt-0,[
|
||||
define .load name,reset
|
||||
conc name,\.bycnt,:
|
||||
ldb by,bp0+.bycnt
|
||||
termin
|
||||
]
|
||||
|
||||
conc fsm,\.bycnt,:
|
||||
|
||||
.lf==.
|
||||
movei by,15
|
||||
.norm==.
|
||||
out by
|
||||
conc qnext,\.bycnt,:
|
||||
ife .bycnt, q0=:.+1 ; After JSP Q,GETWD
|
||||
.load qnorm,-1
|
||||
.disp
|
||||
|
||||
.rubxx==.
|
||||
skipa tt,[357]
|
||||
.crxx==.
|
||||
movei tt,356
|
||||
out tt
|
||||
.disp
|
||||
|
||||
.cr==.
|
||||
.load qcr,356
|
||||
caie by,12
|
||||
jrst .crxx
|
||||
outj by,.next
|
||||
|
||||
.rub==.
|
||||
.load qrub,357
|
||||
skipge tt,rubtab(by)
|
||||
jrst .rubxx
|
||||
outj tt,.next
|
||||
|
||||
conc disp,\.bycnt,:
|
||||
repeat 200,[
|
||||
ife .rpcnt-12, .lf
|
||||
ifn .rpcnt-12,[
|
||||
ife .rpcnt-15, .cr
|
||||
ifn .rpcnt-15,[
|
||||
ife .rpcnt-177, .rub
|
||||
ifn .rpcnt-177, .norm
|
||||
]]] ;repeat 200
|
||||
|
||||
] ;repeat 5
|
||||
|
||||
intsv0==:t ; Save T
|
||||
intsv9==:t2 ; Through T2
|
||||
intsvn==:intsv9+1-intsv0
|
||||
|
||||
intctl==:400000+intsv0_6+intsvn ; control bits
|
||||
intpc==:-<3+intsvn> ; INTPC(P) is PC before interrupt.
|
||||
intdf1==:intpc-2 ; INTDF1(P) is .DF1 before interrupt.
|
||||
intdf2==:intpc-1 ; INTDF2(P) is .DF2 before interrupt.
|
||||
intrq1==:intpc-4 ; INTRQ1(P) are first word bits.
|
||||
intrq2==:intpc-3 ; INTRQ2(P) are second word bits.
|
||||
intac0==:intpc+1-intsv0 ; INTAC0+C(P) is C before interrupt.
|
||||
|
||||
tsint: intctl,,p
|
||||
%piioc ? 0 ? %piioc ? 0 ? iocint
|
||||
ltsint==:.-tsint
|
||||
|
||||
forty: 0
|
||||
0
|
||||
-ltsint,,tsint
|
||||
0
|
||||
0
|
||||
|
||||
dismis: setz ? sixbit /DISMIS/ ? movsi intctl ? setz p
|
||||
|
||||
iocint: .suset [.rbchn,,t]
|
||||
caie t,chneto ; Network channel?
|
||||
.lose
|
||||
.status chneto,t
|
||||
ldb t,[330500,,t]
|
||||
caie t,12 ; Connection went into bad state?
|
||||
.lose
|
||||
quit
|
||||
|
||||
cnst0:
|
||||
constants
|
||||
repeat <.-cnst0+77>/100, conc cnst,\.rpcnt,=:cnst0+.rpcnt*100
|
||||
|
||||
debug: -1
|
||||
|
||||
npure==:<.+1777>_-12
|
||||
|
||||
loc npure_12
|
||||
|
||||
variables
|
||||
|
||||
npage==:<.+1777>_-12
|
||||
|
||||
end go
|
||||
Reference in New Issue
Block a user