From de31a2708871e832a7229ffe834bed1b22175f09 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Wed, 30 Jan 2019 13:05:38 +0100 Subject: [PATCH] EVACUA - encode ITS file for evacuation to Unix. --- build/misc.tcl | 9 + doc/programs.md | 1 + src/bawden/evacua.53 | 391 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 401 insertions(+) create mode 100755 src/bawden/evacua.53 diff --git a/build/misc.tcl b/build/misc.tcl index b05aee19..438fa7f4 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -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" diff --git a/doc/programs.md b/doc/programs.md index afec000e..72f25a58 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -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. diff --git a/src/bawden/evacua.53 b/src/bawden/evacua.53 new file mode 100755 index 00000000..9b1f06e2 --- /dev/null +++ b/src/bawden/evacua.53 @@ -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,[,,+1] + blt tt,+-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,[-,,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,[-,,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+) + +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==,(by)> +if2, .next==,> + +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