From 6b9cf5348fd7d12c8f02191ad2d4034662cd0178 Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Tue, 20 Dec 2016 15:46:23 -0800 Subject: [PATCH] Added USQ. Resolves #318. Source from AR3: SRA; USQ 61. --- README.md | 1 + build/build.tcl | 4 + src/sysen3/usq.61 | 578 ++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 583 insertions(+) create mode 100644 src/sysen3/usq.61 diff --git a/README.md b/README.md index 4cbbd298..7575da5d 100644 --- a/README.md +++ b/README.md @@ -223,6 +223,7 @@ A list of [known ITS machines](doc/machines.md). - TYPE8, type 8-bit file. - UNTALK, split-screen comm-link program. - UPTIME, Chaosnet uptime server. + - USQ, unsqueeze/uncram a file. - XHOST, tool for replacing host nicnames with real hostnames. - WHAT, humorous quips to various "what" questions. - WHO%, list index/uname/jname/%time in sorted list. diff --git a/build/build.tcl b/build/build.tcl index e2a31255..f6bd7e8d 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -1060,6 +1060,10 @@ expect ":KILL" respond "*" ":midas sys;ts type8_sysen3;type8\r" expect ":KILL" +# USQ +respond "*" ":midas sys2;ts usq_sysen3;usq\r" +expect ":KILL" + # HOST respond "*" ":midas sys3;ts host_sysnet;host\r" expect ":KILL" diff --git a/src/sysen3/usq.61 b/src/sysen3/usq.61 new file mode 100644 index 00000000..dc919508 --- /dev/null +++ b/src/sysen3/usq.61 @@ -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= +return= + +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,_-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//] + 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 \ No newline at end of file