diff --git a/README.md b/README.md index 0f9e5847..3755bf65 100644 --- a/README.md +++ b/README.md @@ -246,6 +246,7 @@ A list of [known ITS machines](doc/machines.md). - RMTDEV, MLDEV for non-ITS hosts. - SALV, old file system tool for KA and KL. - SCANDL, TTY OUTPUT SPY. + - SCRAM, encypt/decrypt file. - SEND, REPLY, replacements for DDT :SEND. - SENDS, Chaosnet SEND server. - SENSOR, sends censor. diff --git a/build/build.tcl b/build/build.tcl index e6807806..78a5d99d 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -1374,6 +1374,10 @@ expect ":KILL" respond "*" ":midas sys2;ts usq_sysen3;usq\r" expect ":KILL" +# SCRAM +respond "*" ":midas sys2;ts scram_rwk;scram\r" +expect ":KILL" + # HOST respond "*" ":midas sys3;ts host_sysnet;host\r" expect ":KILL" diff --git a/src/rwk/empty.361 b/src/rwk/empty.361 new file mode 100644 index 00000000..231637c9 --- /dev/null +++ b/src/rwk/empty.361 @@ -0,0 +1,1236 @@ +;-*- midas -*- + +subttl basic RWK UUO's + +.qmtch==1 + +a=1 ;temporary +b=2 ;temporary +c=3 ;temporary +d=4 +e=5 +f=6 +chr=10 ;character being read +ea=11 ;effective address of UUO's +opc=12 ;op code of UUO's +ac=13 +u1=14 ;uuo temporary 1 +u2=15 ;uuo temporary 2 +u3=16 ;uuo temporary 3 +sp=17 ;stack pointer + +ifndef ttyp,ttyp==-1 ;assume we want the TTY opened +ifndef tyic,tyic==1 ;tty input channel +ifndef tyoc,tyoc==2 ;tty output channel +ifndef dski,dski==3 ;dsk output channel +ifndef dsko,dsko==4 ;dsk output channel +ifndef clic,clic==5 ;CLI output channel +ifndef usrc,usrc==7 ;user input and utility channel +ifndef uout,uout==10 ;usr output and fucked channel +ifndef ufdie,ufdie=0 ;needed early, so put it here +ifndef ufsiot,ufsiot=0 ;needed early, so put it here + + +opcode=.bp <777_33 0,0> ;opcode field +accum=.bp <0 17,0> ;accumulator field +index=.bp <0 0,(17)> ;index register + +cnt==4000 ;control +cnti==5000 ;control immediate +errret==3000 ;error return +argi==1000 ;immediate argument +val==2000 ;value return + +ifndef pdleng,[pdleng==50] ;length of PDL +ifndef patchl,[patchl==100] ;length of patch area + + + +ifndef uuoloc,[uuoloc=100] +ifndef infuuo,[infuuo==0] + +ifndef infuuo,infuuo==0 +ifndef tyintp,tyintp==0 +ifndef piclip,piclip==0 +ifndef pirltp,pirltp==0 + +intp==infuuo\tyintp\piclip\pirltp + +ifndef fgetp,fgetp==0 ;routine to read file names + +;; here are the vars. for use with the load-check feature (ldchkp) + +ifndef ldchkp,ldchkp==0 ;non-zero if we want load-check feature + +ifn ldchkp,[ +ifndef mvsldu,mvsldu==150. ;minimum fair share is 40% +ifndef mvsusr,mvsusr==18. ;maximum no. of users is 15. +ifndef usr$$$,usr$$$==20 ;charge per user +ifndef lod$$$,lod$$$==1 +ifndef mvlmax,mvlmax==350. ;max points overall +] + +;; interdependencies go here -- this must be LAST in the conditionals set-up + +ifn infuuo,[ufdie==-1 +ufsiot==-1 +intp==-1 +] + +ifndef loss,loss=<.lose 1400> + + +;;The following two macros were swiped from the DRAGON. I retain comments... + ;I HAVE IBM DISEASE + ;FOLLOWING MACRO SAVES LOAC THROUGH HIGHAC INCLUSIVE ON PDL + ;P MAY BE AMONG THOSE SAVED, BUT MUST BE NEITHER LOWAC NOR HIGHAC + ;CLOBBERS LOWAC + +DEFINE SAVE LOWAC,HIGHAC + PUSH sp, + MOVSI ,+1 + HRRI ,1(sp) + ADD sp,[-,,-] + SKIPL sp + loss + BLT ,(sp) +TERMIN + + ;UNDO A SAVE (THIS IS WHY HIGHAC SHOULD NOT BE P) + +DEFINE RESTOR LOWAC,HIGHAC + MOVSI ,-<->(sp) + HRRI , + BLT , + SUB sp,[-+1,,-+1] +TERMIN + + +define terpri chan=tyoc ;terpri on channel + tyo chan,[^M] + tyo chan,[^J] +termin + +define text *string* +!.length |string|,,[asciz |string|]!termin + +define ascnt *string* +![text /string/]!termin + +define type *string* + sioto tyoc, +termin + +define death *string* + die +termin + +define print chan=tyoc,*string* + sioto chan, +termin + +define tabdef name + define name cruft + cruft + termin + +define a!name more + name [define name cruft + cruft + more] + termin + termin +termin + + + +define do stuff,else,\label +define ddoo exit + jrst [stuff +jrst label] +!else! + +label:: +termin + +ddoo + +termin + +define do.lab cruft +cruft!!termin + +define do.bod cruft +cruft!!termin + +define adotab label,stuf + +do.lab [define do.lab cruft +cruft]label!!termin + +do.bod [define do.bod cruft +cruft]stuf!!termin + +termin + +define dotab + +define foo fo1,fo2 +irp x,,#[fo1],y,,#[fo2] +x: y +termin +termin + +foo do.lab,do.bod +termin + + +define seval a,b ;get value of symbol B in A + move a,[squoze 0,/b/] + .eval a, + loss +termin + +define eval a,b + seval a,b + hrl a,a ;move to left + hrri a,a ;destination is a + .getloc a, ;get it into a +termin ;done! + +DEFINE SYSCAL A,B,C= + .CALL [SETZ ? SIXBIT/A/ ? B ? setz++c] TERMIN + + +call=pushj sp, + +define ret + popj sp, +termin + +define loop ix=0,beg,end,stuf,\label1,label2 +define lloop exit + + move ix,[beg-end,,beg] +label1:: + stuf + aobjn ix,label1 +label2:: +termin + +lloop [jrst label2] +termin + +define prtval *prtstr,valstr + vlpr [,,[asciz /valstr/]] +termin + +.begin rwkuuo ;My very own system calls! + +tabdef utab + +uuonum==1 + +define uuodef name,op,oper +ifndef uf!name,[uf!name==0] +ifn uf!name,{define uuodex [op1=[pushj sp,]] + autab [.m"name=<.-uuotab>_33 + op1 u!name] + termin} +.also [ oper + uuodex op] + termin + + + + +loc 40 +UUO: 0 ;traping UUO goes here. + JSR UUOH ;go handle UUO's +ifn intp, -intlng,,tsint ;abjon ptr to interrupt table + +loc uuoloc + +.m"intspc=100*100+5 +ifn intp,[ +tsint: .m"intspc,,sp +ifn tyintp,[0 ? 1_tyic ? 0 ? 0 ? ttyint] +ifn infuuo,[%piioc ? 0 ? 0 ? 0 ? ignore + 0 ? -1,,0 ? 0 ? 0 ? rwkuuo"infuuo"dhandl] +ifn piclip,[%picli ? 0 ? 0 ? 0 ? cliget] +ifn pirltp,[%pirlt ? 0 ? %pirlt ? -1 ? realt] ;don't allow recursive + ;real-time interrupts...if we get them we must + ;be screwed +intlng==.-tsint + +ignore: +ifn ufsioto,[ type /AGot an unknown IOC interrupt. Continuing +/] + +disbye: syscal dismis,[cnti,,.m"intspc ;just go back to what you were doing + sp] + loss + +.m"dismis=jrst disbye + + +] + + +uuoh: 0 ;saved PC + push sp,uuo ;and our UUO + push sp,uuoh ;save the PC + save ea,u3 ;save our AC's + ldb opc,[opcode uuo] ;get the opcode + cail opc,utabl ;is it legal? +ifn ufdie, die [text /BAD USER UUO/] ;nope +ife ufdie, .lose + ldb ac,[accum uuo] ;yep + hrrz ea,uuo ;get the effective address + xct uuotab(opc) ;and dispatch on it + restor ea,u3 ;restore our AC's + pop sp,uuoh ;restore UUOH + pop sp,uuo ;and restore our UUO -- We're done with this + ;one. (hence if we die in a UUO the UUO is the + ;last UUO done. Otherwise it is 0 (maybe might + ;make it always last UUO, never reset to 0? + jrst @uuoh ;return + + +uuodef huh,jrst,[ +uhuh: type /AType ? for list of commands. +/ + move sp,[-pdleng,,pdl] + jrst @qitadr +QITADR: rwkend +] +uuodef usioti,,[ +usioti: hrli u1,440700 ;ascii string pointer + hrr u1,(ea) ;get address of string + + hlrz u2,(ea) ;get length of string + + syscal siot,[ac ;ac has output channel + u1 + u2] + loss ;lost. + + popj sp, ;return +] + +uuodef tyo,[ +utyo: movei u2,1 ;preset length to 1 + hrli u3,070700 ;ascii string pointer to last 7 bits + hrr u3,ea ;get the effective address + + syscal siot,[ac ? u3 ? u2] ;do it + loss ;nope, lost somehow + + ret +] + +uuodef sioto,,[ +usioto: hrli u1,440700 ;ascii string pointer + hrr u1,(ea) ;get address of string + + hlrz u2,(ea) ;get length of string + movem u2,siotl ;move it to memory so it can be cleared + syscal siot,[ac ;ac has channel + u1 + siotl] + loss ;lost. + + popj sp, ;return +siotl: 0 +] + +uuodef tyi,,[ +utyi: syscal iot,[ac ;ac has channel + (ea)] ;to loc pointed to by EA + loss ;lost + popj sp, ;return + +] + +uuodef vlpr,,[ +prloc: 0 +vlloc: 0 +uvlpr: hlrz u1,(ea) ;get ptr to string to print + hrrz u2,(ea) ;and ptr to string to value + movem u1,prloc ;and save them + movem u2,vlloc + sioto tyoc,@prloc ;print it + .value @vlloc ; and value it + popj sp, ;and return if we ever get back + +] + +uuodef die,jrst,[ +udie: caie ea,0 ;if typing + sioto tyoc,(ea) ; type it + skipe debug ;are we debuggin? + .value ;yes, just return + .logout 1, + loss ;how the hell did this happen? +] + +uuodef jload,,[ +ujload: hrlz u1,ea ;from + hrri u1,bload ;to BLOAD + blt u1,eload ;until ELOAD + syscal open,[cnti,,.uii ;open load file + argi,,dski ;on DSKI channel + dev + fn1 + fn2 + dir] + loss ;lost + + syscal load,[argi,,%jself ;load self + argi,,dski ;from dsk + [0,,-1] ;all +] + loss + loss ;if we get here something lost! + +BLOAD: +dev: 0 +fn1: 0 +fn2: 0 +eload: +dir: 0 +] + +;; convert 6-bit to ascii. Input in AC, output by excecuting EA. +;; typical EA's are IDPB AC,[440700,,] and TYO TYOC,AC + + +uuodef 6toa,,[ +U6toa: movei u3,6 ;for six bits + move u2,[440600,,(ac)] ;byte pointer into AC + +u6toa1: ildb u1,u2 ;get the first byte + addi u1,40 ;make it ascii + + push sp,(ac) ;save ac he gave us so we can use it as scource + movem u1,(ac) ;use it + xct ,(ea) ;and excecute his output instruction + pop sp,(ac) ;and get his AC back + + sojn u3,u6toa1 ;and loop till done + + ret ;and we're all done +] + +uuodef rd6,,[ +urd6: +uread6: movei u3,6 ;at most 6 of them + move u2,[440600,,(ac)] ;moved 6 bits at a time into our accumulator + setzm (ac) ;clear our given AC + +;** NOTE ** U3, EA, AND AC ARE ILLEGAL AS AC FIELDS for this UUO + +read6a: push sp,(ac) ;what we have so far + xct (ea) ;do it + move u1,(ac) ;get it into a know ac + pop sp,(ac) ;and get back our current val + + cain u1,^Q ;if it's ^Q + jrst [xct (ea) ;get a new char + jrst read6b] ;and sneak it passed other tests + cain u1,^M ;if carraige return + jrst read6t ;we're all done + cain u1,^C ;same for ^C + jrst read6t + cain u1,"," ;same for , + jrst read6t + cain u1,40 ;same for space + jrst read6t + skipn file6p ;are we reading for a file? + jrst read6b ; nope, go to it + cain u1,";" ; if it's a semi + jrst read6t + cain u1,":" ;or a : + jrst read6t ;we're all done + +read6b: caige u1,140 ;if it's small + subi u1,40 ;convert it so numbers work out right + + caile u3, ;if we're beyond, don't write it out + idpb u1,u2 ;and write it to our dest + + skipe file6p ;if we're looking at file-names, find end char + do [sos u3 ;count em anyway + jrst read6a] ; don't give up + + sojn u3,read6a ;and loop until done + setom t.char ;note that we ended from too many chars + ret ;and we're all done! + +read6t: movem u1,t.char ;save our final char for posterity + ret ;and we're all done + +file6p: 0 ;non-zero if we want : and ; to terminate 6bit +t.char:0 ;this gets the terminating character or -1 if + ;it terminates because of going over 6 chars +] + +;;; has an instruction to get the next character. +;;; the specified AC gets the result. the ea must put the char in the same +;;; ac as is being used for the result +;;; AC, EA, U2 may not be clobbered by the instruction + +uuodef rda,,[ +uread1: setzm (ac) ;clear our given ac + movei u2,12 ;get a 10 + +red10a: push sp,(ac) ;push what we have so far + xct (ea) ;and get next char + move u1,(ac) ;get it into a know ac + pop sp,(ac) ;restore our AC + + caige u1,60 ;is it too small? + ret ; yes, we're at end, return + caile u1,71 ;is it too big? + ret ; yes, we're at end, return + + imulm u2,(ac) ;and multiply the AC by it + subi u1,60 ;make it a number + addm u1,(ac) ;and add in our number + jrst red10a ;go get more +] + +;; convert decimal to ascii. Input in AC, output by excecuting EA. +;; typical EA's are IDPB AC,[440700,,] and TYO TYOC,AC + +uuodef deca,,[ + +udeca: move u1,(ac) ;get number in U1 + +decpnt: idivi u1,10. ;figure first digit + push sp,u2 ;push remainder + skipe u1 ;done? + pushj sp,decpnt ;no compute next one + +decpn1: pop sp,u1 ;yes, take out in opposite order + addi u1,60 ;make ascii + push sp,(ac) ;save his AC so we can use it as output source + movem u1,(ac) ;use it + xct (ea) ;and execute his output instruction + pop sp,(ac) ;and give it back + popj sp, ;and return for the next one. +] + +;;; Convert number to ascii rep of octal +;;; Take number in ac, ea has output instruction + +uuodef 8toa,,[ + +u8toa: move u1,(ac) ;get number in U1 + +octpnt: idivi u1,10 ;figure first digit + push sp,u2 ;push remainder + skipe u1 ;done? + pushj sp,octpnt ;no compute next one + +octpn1: pop sp,u1 ;yes, take out in opposite order + addi u1,60 ;make ascii + push sp,(ac) ;save his AC so we can use it as output source + movem u1,(ac) ;use it + xct ,(ea) ;and execute his output instruction + pop sp,(ac) ;and give it back + popj sp, ;and return for the next one. +] + +uuodef rnd,,[ +urnd: push sp,a ;generate a random number + push sp,b + push sp,c + + eval a,jtmu ;get system resource word + add a,ooff ;add in an offset + add a,mtoop ;and our + and a,[377777,,-1] ;make positive + idiv a,mlen ;mod size of pointer fields? + hrlz b,b ;and put in left half + hrri b,b ;and get result in b + .getloc b, ;get that + add b,onum + and b,[377777,,-1] ;make positive + movem a,ooff ;save old one + eval a,nnsked ;number of times null job schedualed + ;this should vary more when load light, to make + ;up for others varying less + add b,a ;and include this in our randomness + idivi b,(ea) ;mod number of entries + movem b,onum ;save old one + movem c,rndloc ;return our value. Save it in RNDLOC for debug + pop sp,c + pop sp,b + pop sp,a + move u1,rndloc + movem u1,(ac) ;and return in right accumulator + ret + +rndloc: 0 +] + +uuodef fget,,[ + +.m"dev: 'DSK ' +.m"DIR: 'USERS ' +.m"FN1: -1 +.m"FN2: -1 + + +ufget: + push sp,a + push sp,b + push sp,rwkuuo"file6p ;save for posterity + setom rwkuuo"file6p ;read it in file format + +floop: XCT (EA) ;Get a name + +;; typically EA is a [rd6 a,[tyi tyic,a]] + + move b,rwkuuo"t.char6 ;get termination character + cain b,72 ; colon? + do [movem a,.m"dev ;note the device + jrst floop] ;and get more + cain b,40 ;is it a space? + do [movem a,.m"fn1 ;save it out + jrst floop] ;and go for more + + cain b,73 ;is it a semicolon? + do [movem a,.m"dir ; save it + jrst floop] ;and go for more + jumpe a,fgot ;have we got it? + + movem a,.m"fn2 ;save it out +fgot: pop sp,rwkuuo"file6p ;and restore our state + pop sp,b + pop sp,a + ret +] + + +.m"debug: 0 ;is in main block so user can reference +tyo1c: 1 ;will be reset to one on every tyo +calerr: 0 ;error return code +patch: block patchl ;patching area + +pdl: [.status tyoc,a +ifn ufsiot,[skipn a, + type /PDL underflow/] + loss] + block pdleng ;PDL area + +onum: 0 +ooff: 0 +mtoop: 0 +mlen: 0 + +ifn infuuo,[ + +;;inferior hacking stuff + +.begin infuuo +c1.cnt: %pival+%pic.z+%pibrk+%pidcl +c1.ded: %pi1pr+%pib42+%pipar +class2: %pitrp+%pifet+%pitty+%pidis+%piilo+%piioc+%pioob+%pimpv+%pimar +c1.2: %pi1pr+%pibrk+%pib42+%pipar+%pival+%pic.z+%pitrp+%pifet+%pitty+%pidis+%piilo+%piioc+%Pioob+%pimpv+%pimar+%pidcl + +TTYFLG: 0 ;nonzero if we have given away our TTY + +dhandl:.dtty ;get back the TTY + skip + syscal usrvar,[argi,,usrc ;get his interrupts + ['PIRQC '] + val,,a] + loss + syscal usrvar,[argi,,usrc ;get mask for type 2 interrupts + ['MASK '] + val,,b] + loss + and b,class2 ;b<-class two which are enabled + tdz a,b ;remove them from our interrupt word + and a,c1.2 ;remove class 3 interrupts + move b,a ;get a copy + tdz a,c1.cnt ;remove ones we'll handle + jumpn a,infuuo"fatal ;go handle fatal variety + trne b,%pibrk ;is the a .BREAK + jrst infuuo"break ;go handle + trne b,%pival ;is this a .VALUE? + jrst infuuo"value ;go handle + tdne b,[%pic.z+%pidcl] ;control-Z ? + skipa + jrst [type /ABug in Inferior Interrupt HandlerA/ + loss] + syscal usrvar,[argi,,usrc ;reset his PIRQC + ['APIRQC'] + b] + loss +goback: syscal dismis,[cnti,,.m"intspc + sp + argi,,retloc] + loss +retloc: type /AReturned from InferiorA/ + setzm ttyflg ;remember we have it back for good + ret + +define usrmem usrc,dest,a,b + syscal corblk,[cnti,,%cbwrt ;may as well get write if we can + argi,,0 ;no XORing in my program! + argi,,%jself + argi,,377 ;mega moby page + argi,,usrc ;from usrc channel job + a] ;at location a + loss + move dest,(b)<377*2000> ;and get it +termin + +define uread usrc,loc + .access usrc,loc + syscal iot,[argi,,usrc + loc] + loss +termin + +define uwrite usrc,loc,dat + .access usrc,loc + syscal iot,[argi,,usrc + dat] + loss +termin + +define addrup ind,rh,index,\foo,foo1 + jumpe index,foo1 ;if non-zero index + uread usrc,index ;get value of index + add rh,index ;and add it in +foo1:: jumpn ind,[uread usrc,rh ;if we're indirecting + jrst foo] ;do the indirection +foo:: +termin + +define pagmak a + andi a,-1 ;clear left half + lshc a,-12 ;split off page number from rest + lsh ,12-44 ;and make remainder +termin + +break: syscal usrvar,[argi,,usrc ;turn off the interrupt + ['APIRQC'] + [%pibrk]] + loss + syscal usrvar,[argi,,usrc ;get location of break + ['UPC '] + val,,a] + loss + subi a,1 ;back up to the .BREAK + move e,a ;move to where we have two adjacent ac's + pagmak e ;a <- page#, f <- loc in page + usrmem usrc,a,e,f ;a <- contents of memory + ldb b,[accum a] ;b <- accumulator + ldb c,[index a] ;c <- index + hlr d,a ;clear d, getting left half of a + andi d,(@) ;and with indirect bit + andi a,-1 ;a <- address field + + cain b,12 ;is it a .BREAK 12, ? + jrst brk12 ;yes + caie b,16 ;is it garbage? + jrst unbrk ;go handle unknown break + type /AInferior finishedA/ + .uclose usrc, ;it must have been asking to die since we + ;told it we wern't a DDT + jrst infdon + +define .M"JCL *lcj* +move a,[text /lcj/] +movem a,rwkuuo"infuuo"jclptr +termin + +jclptr: 0 + +brk12: addrup d,a,c ;ind,addr,ix + move e,a ;move to where we have room + move c,a ;and hold in C for error messages + pagmak e ;e <- page #, f <- loc in page + usrmem usrc,a,e,f ;get from his memory the location pointed to + jumpl a,[hlrz a,a ;if writing + caie a,400005 ; if clearing JCL + jrst [setzm jclptr ;clear it and + jrst infdon] ;be done + type /ABarf: Inferior trying to write! +/ ;complain + jrst infdon] ;and be done + hlrz b,a ;get operation + hrrz d,a ;and address + trne d,200000 ;is it block mode? + jrst [type /Barf: Inferior trying to use block mode .BREAK 12, +.BREAK 12,/ + jrst addprt] ;go print out err message + cail b,brktbl ;is it out-of-range? + jrst unbrk1 + xct brktb(b) + +addprt: 8toa c,[tyo tyoc,c] ;type address + sioto tyoc,[text "/ "] ;"open" location with form + 8toa b,[tyo tyoc,b] ;and type contents + type /,,/ ;in halfword mode + 8toa d,[tyo tyoc,d] ;so we can read it easier + terpri tyoc ;CRLF + jrst infdon ;and give up + +unbrk1: type /Barf: Inferior trying to use a .BREAK 12, I can't handle. +.BREAK 12,/ + jrst addprt + +brktb: jrst unbrk1 + jrst unbrk1 + jrst unbrk1 + jrst symptr + jrst unbrk1 + jrst getjcl +brktbl==.-brktb + +symptr: caig d,17 ;is it an AC? + jrst [uwrite uout,d,[0] ;yep, do it the dangerous way + jrst infcnt] + move e,d ;get more space to work in and save d for error + pagmak e ;compute page in a and word in f + syscal corblk,[cnti,,%cbndw ;need write access + argi,,0 + argi,,%jself + argi,,377 + e] + jrst jclovf ;go gripe + add f,<377_22> ;make absolute in our space + setzm (f) ;and set the appropriate word to 0 + jrst infcnt ;and continue + +getjcl: move e,d ;get more space and save d for error + pagmak e + syscal corblk,[cnti,,%cbndw ;need write access + argi,,0 ;no XORing, please + argi,,%jself ;map into ourself + argi,,376 ;at the highest possible location + argi,,usrc ;our inferior's + e] ;page which is contained in A + jrst jclovf + aos e ;get next page too + hlrz a,jclptr ;get length pointer of JCL + addi a,4 + idivi a,5 ;(ptr+4)/5==length in words + add a,f ;the final loc + cail a,2000 ;overflow? + jrst [syscal corblk,[cnti,,%cbndw ;need writing + argi,,0 ;barf, no XOR, please + argi,,%jself + argi,,377 ;very moby + argi,,usrc ;our very inferior inferior + e] ;and the next page + jrst jclovf ;complain of indigestion + jrst jcljcl] ;go write JCL + +;a -- absolute ending address +;b -- operation +;c -- effective address of .BREAK +;d -- right half of contents of ea of .break +;e -- page number in inferior of JCL buffer +;f -- loc in that page + +jcljcl: addi a,<376_12> ;make end addr. point into our page map + addi f,<376_12> ;make the dest. address point into our map + hrr e,f ;and put in right half for blt + hrl e,jclptr ;get our source for the BLT from the JCLPTR + blt e,-1(a) ;and perform the transfer + skipe ttyflg ;if it had the tty + jrst infcnt + jrst infdon ;else just dismiss + +infcnt: setom ttyflg ;remember where the TTY went + .atty usrc, ;give it to him + jrst [.dtty ;get it back + .atty usrc, ;and try again + loss ;nope, we're screwed somehow + jrst infcn1] ;good, one with the show + + call start + +infcn1: syscal dismis,[cnti,,.m"intspc + sp] + loss + +jclovf: type /AInferior tried to read into pure or non-existant memory +.BREAK 12,/ + jrst addprt ;tell him about loss + +unbrk: type /Inferior gave an unknown .BREAK +.BREAK / + +addrtp: 8toa b,[tyo tyoc,b] ;type out the address stuff + tyo tyoc,[","] ;type out the comma + caie d,0 ;indirect? + tyo tyoc,["@"] ;type it + + caie a,0 ;rh nonzero? + 8toa a,[tyo tyoc,a] + + jumpn c,[tyo tyoc,["("] ;type the ( + 8toa c,[tyo tyoc,c] ;type the index + tyo tyoc,[")"] + jrst ubrk1] + +ubrk1: type / >>> / + addrup d,a,c ;compute effective address + 8toa a,[tyo tyoc,a] ;and print it + terpri tyoc + jrst infdon + +value: syscal usrvar,[argi,,usrc ;turn off the interrupt + ['APIRQC'] + [%PIVAL]] + loss + type /AInferior .VALUE'd....I don't understand that so I'm continuingA/ + jrst infdon + +fatal: type /Ainferior got a fatal interruptA/ + .uclose usrc, + jrst infdon + +infdon: setzm ttyflg ;remember we have it back for good + syscal dismis,[cnti,,.m"intspc + sp] + loss + +start: syscal usrvar,[argi,,usrc ;copy his old state + ['OPTION'] + val,,a] + loss + tlz a,optcmd+optbrk ;clear the OPTCMD bit (+ the OPTBRK since LISP + ;demands it!) + skipe jclptr ;if there is JCL + tlo a,optcmd+optbrk ;set it again + syscal usrvar,[argi,,usrc ;and set it up + ['OPTION'] + a] ;write it back again + loss + + syscal usrvar,[argi,,usrc ;GO! + ['USTP '] + argi,,0] + loss + + ret + +.m"TTYGO: + call start + setom ttyflg ;remember we gave it away + .atty usrc, ;give up the TTY and wait for return + skipe ttyflg ;what? + .hang ;until return of TTY + .dtty ;make SURE that we have the TTY + ret + ret + +.M"nttygo: + syscal usrvar,[argi,,usrc + ['USTP '] + argi,,0] + loss + ret + +myunam: 0 +ifndef .m"usrc,.m"usrc==7 +istrt: 0 + +define .m"infcr chan,name,fn1,fn2,sname,f.loss=loss,page=-1,handle=.m"rwkuuo"infuuo"dhandl + push sp,a ;save a for local use + .status usrc,a ;look at the channel + caie a,0 ;if there is nothing open + .uclose usrc, ;kill it + + syscal open,[cnti,,0 ;create a job + argi,,usrc + ['USR '] + rwkuuo"infuuo"myunam + [sixbit /name/]] + loss + syscal open,[cnti,,.uio ;and an output channel to it (ugh!) + argi,,uout + ['USR '] + rwkuuo"infuuo"myuname + [sixbit /name/]] + loss + + syscal open,[cnti,,.uii ;open a file to load into it + argi,,dski + [sixbit /DSK /] + [sixbit /FN1/] + [sixbit /FN2/] + [sixbit /SNAME/]] + f.loss + + syscal load,[argi,,usrc ;load it + argi,,dski] + loss + + syscal iot,[argi,,dski ;get starting address + argi,,a] ;in a + loss + andi a,-1 ;ignore the JRST part + + syscal close,[argi,,dski] ;close it + loss + + movem a,rwkuuo"infuuo"istrt ;and save the ADDR in ISTRT + + syscal usrvar,[argi,,usrc ;make it start there + ['UPC '] + a] ;a has address + loss + + syscal usrvar,[argi,,usrc ;get what bit to enable + ['INTB '] + val,,a] + loss + + syscal usrvar,[argi,,%jself ;and enable it + ['IMSK2 '] + a] + loss + pop sp,a + +termin +.m"infkil: + push sp,a ;get A free + .status usrc,a ;is there an inferior? + jumpe a,[type /AThere is no inferior open.A/ + pop sp,a ;restore A + ret] ;and give up. + pop sp,a ;restoer a + setzm ttyflg ;remember we have it back for good + .uclose usrc, ;kill it + type /AInferior KilledA/ ;say it + ret ;return + +.end infuuo +] + +uuotab: loss + utab +utabl==.-uuotab + consta ;dump out constants table + +popj.1: aos (sp) ;increment return address + popj sp, ;and return +.m"popj1=jrst popj.1 ;and define our symbol + +ifn fgetp,[ + +.m"dev: 'DSK ' +.m"DIR: 'USERS ' +.m"FN1: -1 +.m"FN2: -1 + + +.m"fget: + push sp,a + push sp,b + push sp,rwkuuo"file6p ;save for posterity + setom rwkuuo"file6p ;read it in file format +floop: rd6 a,[tyi tyic,a] ;read in the name + + move b,rwkuuo"t.char6 ;get termination character + cain b,72 ; colon? + do [movem a,.m"dev ;note the device + jrst floop] ;and get more + cain b,40 ;is it a space? + do [movem a,.m"fn1 ;save it out + jrst floop] ;and go for more + + cain b,73 ;is it a semicolon? + do [movem a,.m"dir ; save it + jrst floop] ;and go for more + jumpe a,fgot ;have we got it? + + movem a,.m"fn2 ;save it out +fgot: pop sp,rwkuuo"file6p ;and restore our state + pop sp,b + pop sp,a + ret +] +ifn ldchkp,[ +.m"%sllog==1 ;bit to indicate not-logged-in +.m"%sldil==2 ;bit to indicate coming in from a dialup line +.m"%sload==4 ;bit to indicate over-stepping a load boundary +.m"%slcls==10 ;bit to indicate closed +.m"%sldet==20 ;we've been detached + +.m"loadch: ;a routine to check the system load + ;right half of A gets load units + ;left half gets flags for dialup lines, + ;detached tree, or not logged in + + push sp,b ;save our temporaries + push sp,c + push sp,e + + setz a, ;clear a to receive our results + + .suset [.runame,,uname] ;check our UNAME.... + hllz e,uname ;look at left half of uname for '___' + camn e,[-1,,0] ;are we logged in? + tlo a,%SLLOG ;no, note the fact + + .suset [.rcnsl,,ttynum] ;we have to check for detached or dialups + move e,ttynum ;get our tty num + caig e, ;do we have one? + tlo a,%SLDET ;no, note the fact + + movei b,1 ;let's figure out which we are + lsh b,(e) ;as a bit in the word + tdne b,dilmsk ;are we a dialup? + tlo a,%SLDIL ;yes, note the fact + +;; charge for FAIR SHARE + + eval e,SLOADU ;Get inverse fair share + subi e,100 ;shrink it down (it never gets below 100, I + ;believe...) + move b,.M"mxsldu ;if not low enough + + movei c,(e) ;get copy to work with + subi c,(b) ;subtract out the maximum + caile c, ;still OK? + call lcalc ;nope, gotta charge extra and set a bit + + imul e,.m"lodchg ;compute the charge + add a,e ;add it in + +;; charge for LUSERS + + eval e,SUSRS ;Load also depends on how many users + move b,.M"MXSUSR ;if we're over our limit, + + movei c,(e) ;get a copy of our limit to work on + subi c,(b) ;subtract out the actual + caile c, ;still OK? + call lcalc ;do the calculations and set the bit + + imul e,.m"usrchg ;compute the charge + add a,e ;add it in + + .rtime e, ;get time + camge e,t.open ;if before 8:00 am + jrst oopen ;it's OK + camle e,t.clos ;if it's after 8:00 pm + jrst oopen ;it's OK + + .ryear b, ;get date stuff + ldb e,[.bp (003400),b] ;this byte + cain e,0 ;if zero + jrst oopen ;it's SUNDAY, let him go. + cain e,6 ;if not SATURDAY + jrst oopen ;OK! + call holdyp ;is it a holiday? + jrst nopen ; tell him we're closed! + +oopen:: +gobak: hrrz b,a ;get our points (separate from bits) + caml b,mxlmax ;OK! (or IS it....check out the total points) + tlo a,%SLOAD ;too high......note the fact + pop sp,e ;restore our AC's + pop sp,c + pop sp,b + ret ;and return it + +nopen: tlo a,%SLCLS + jrst gobak + +lcalc: tlo a,%SLOAD ;no, note the fact we're over + imuli c,10000 ;scale up the quantity + idivi c,(b) ;fraction more than max + addi c,10000 ;+ 1 + imuli e,(c) ;times the total quantity + idivi e,10000 ;and scale back down + ret + +holdyp: movsi e,-hldys ;aobjn ptr + .rdate b, ;get the year + +holdy1: camn b,(e)hldy ;is it a holiday? + popj1 ;yes, skip + aobjn e,holdy1 ;no, loop? + ret ;no, not a holiday + +hldy: '780417' ;Patriot's Day + '780530' ;Memorial Day + '780704' ;Independence Day + '781225' ;Christmas + '790101' ;New Year's Day + +hldys==.-hldy + +t.open: sixbit /080000/ ;opening time +t.clos: sixbit /200000/ ;closing time + + + +.m"MXSLDU: MVSLDU ;Fair share less than 100/MVSLDU*100% means + ;system is heavily loaded +.m"MXSUSR: MVSUSR ;More than MVSUSR users means system is heavily + ;loaded + +.m"MXLMAX: MVLMAX ;trip point for point total + +.m"usrchg: usr$$$ ;how much to charge for users in load figure +.m"lodchg: lod$$$ ;how much to charge for system load in load + ;figure + +uname: 0 ;save the UNAME here to check for login etc. +dilmsk: 1_4+1_5+1_6+1_7 +ttynum: 0 ;save our TTY number here to check for dialup +] +.m"go: move sp,[-pdleng,,pdl] +ifn ttyp,[syscal open,[cnti,,.uii + argi,,tyic + [sixbit /TTY/]] + loss + syscal open,[cnti,,<.uao+%tjdis> + argi,,tyoc + [sixbit /TTY/]] + loss +] + +ifn infuuo,[ + .suset [.runame,,rwkuuo"infuuo"myunam] ;get our name +] + +ifn intp,[.suset [.roption,,a] ;get current .OPTION var + ior a,[(optint+optopc)] + .suset [.soption,,a] ;and set it for new interrupts and back up pc + syscal usrvar,[argi,,%jself ;enable IOC errors to ignored them + ['IMASK '] + [%piioc]] + loss +] +ifn ufrnd,[ + move a,[squoze 0,/toop/] ;output buffer pointers + .eval a, + loss + movem a,mtoop ;and save + move a,[squoze 0,/tintp/];end of output pointers, slower moving inpointr + .eval a, + loss + sub a,mtoop ;and save length of that region + movem a,mlen ;in mleng +] + +.m"RWKEND==. +.end rwkuuo + +;;and the rest of the system goes here. + + diff --git a/src/rwk/files.12 b/src/rwk/files.12 new file mode 100644 index 00000000..fca5e13f --- /dev/null +++ b/src/rwk/files.12 @@ -0,0 +1,416 @@ + +.BEGIN RFN ;-*-MIDAS-*- + +SUBTTL Routines for parsing and printing filenames + +;Basic conventions: + +;We assume that there are accumulators A, B, C, D and E, not necessarily +;consecutive, and that the stack is in P. +;No routine clobbers ACs other than the +;ones it is documented to clobber, and none touches even temporarily +;any AC other than A, B, C, D, E and P. +;All code generated is pure. +;The main routines, RFN, PFN, PFNBRF and PFNMCH, never skip. + +;This file contains two routines, RFN to read filenames and PFN to print. +;Both expect a b.p. for ILDB'ing or IDPB'ing the text, in D. +;Both expect a pointer to a filename block in A. +;A filename block consists of four words, which hold th +;left-justified sixbit DEVICE, FN1, FN2 and SNAME in that order. + +;The RFN routine assumes that the user has defined the label RSIXTP +;(RSIX-Terminator-P) which should expect a character in B +;and skip if it should terminate a filename, or start a switch. +;It will not be called with control characters. +;Thus, you might want it to skip when given ",", "_" or "/". +;PFN similarly assumes that there is a routine PSIXTP will will +;skip for a character in B that needs a ^Q printed in front of it. +;Normally, RSIXTP and PSIXTP can be the same routine. + +;If you want switches to be processed in filenames, +;set $$SWITCH to 1 and define the label SWITCH as a routine to read a switch. +;It will be called with the first character of the switch in B. +;It can read more characters off D, or by calling RFN"RUC +;If it skips, RFN assumes that the character in B should be reprocessed. +;A slash is followed by a single switch, while parentheses enclose +;any number of switches. However, neither slash nor "(" will be +;recognized unless RSIXTP skips for it. This gives the caller +;run-time control of whether switches are to be processed. + +;If $$MNAME is set, the user must define MNAME to point to +;a word holding this machine's name in SIXBIT. RFN"RMNAME initializes it. +;If $$PFNBRF is set, the user must define MSNAME to point to +;a word holding the "default" SNAME (the one not to be mentioned). + +;These symbols should be defined by the user to select parts of this file: +IFNDEF $$RFN,$$RFN==0 ;Include RFN, the routine for reading filenames. +IFNDEF $$SWITCH,$$SWITCH==0 ;Include routines for processing "/" and "(-)" switches. +IFNDEF $$PFN,$$PFN==0 ;Include PFN, the routine for printing filenames. +IFNDEF $$PFNBRF,$$PFNBRF==0 ;Include routine to print filenames briefly. +IFNDEF $$RUC,$$RUC==0 ;1 => don't define RUC; use a user-supplied definition. +IFNDEF $$MNAME,$$MNAME==0 ;1 => assume MNAME is defined and holds this machine's name. + +IFN $$SWITCH,$$RFN==1 +IFN $$PFNBRF,$$PFNBRF==1 + +ifndef $$sixp,$$sixp==0 ;default to no special terminators +ifndef $$altp,$$altp==0 ;nonzero => altmode prints defaults +ifn $$altp,$$pfn==1 ;altmode requires that we be able to print + +ifndef p,p==sp ;alternate name for P +.AUXIL ;Don't mention all our internal symbols in crefs. + +;PRINT VERSION NUMBER +.TYO6 .IFNM1 +.TYO 40 +.TYO6 .IFNM2 +PRINTX/ INCLUDED IN THIS ASSEMBLY. +/ + +DEFINE SYSCAL NAME,ARGS +.CALL [SETZ ? SIXBIT/NAME/ ? ARGS ((SETZ))] +TERMIN + +IFN $$RFN,[ ;Routines for reading filenames. + +;Read a file spec off the b.p. in D into the file block that A points at. +;A filename block has four words, which get the device name, sname, fn1 and fn2. +;The terminating character is left in B. +;In E's left half we return flags indicating which of the four names were +;specified: 1,, for the device; 2,, for the FN1; 4,, for the FN2; 10,, for the SNAME. + +DEV==0 ;Indices into the filename block. +FN1==1 +FN2==2 +SNM==3 + +ifn $$altp,[ +devloc: 0] + +RFN: PUSH P,A + PUSH P,C + MOVE C,A ;Put the filename block addr in C since RSIXG returns in A. + PUSH P,FN1(C) ;Save default FN1, FN2 for ^X, ^Y. + PUSH P,FN2(C) +ifn $$altp,[movem c,devloc] ;save location of file block for restarting +restrt: SETZ E, ;Number of names stored yet is 0. +RFN0: PUSHJ P,RUC + +ifn $$altp,[cain b,33 ;altmode? + jrst alttyp] ;yes, go print out our defaults + +RFN2: PUSHJ P,RSIXG ;Read one filename. + JRST RFN1 + PUSHJ P,RFNN ;If it's not null, store it. + +RFN1: +ifn $$altp,[cain b,33 ;altmode? + jrst alttyp] ;yes, go print out our defaults + CAIE B,72 ;Check char that ended name, ":" + CAIN B,"73 ;or ";" + JRST RFN0 + CAIN B,40 ;If was space, : or ;, read another name. + JRST RFN0 +IFN $$SWITCH,[ + CAIN B,57 ;"/" -- If stopped on "/" or "(", call switch rtn. + JRST RFNSL ;Read 1 switch. + CAIN B,50 ;"(" + JRST RFNPAR ;Read many switches until ). +];IFN $$SWITCH + CAIE B,^X + CAIN B,^Y ;If was ^X or ^Y, + JRST RFNX ;use the default FN1 or FN2 as next name. + SUB P,[2,,2] + POP P,C + POP P,A + POPJ P, + +;STORE THE NAME IN A. +RFNN: CAIN B,72 ;":" + JRST RFNC ;: => USE AS DEVICE. + CAIN B,73 ;";" + JRST RFNS ;; => USE AS SNAME. + AOJA E,RFNT(E) ;ELSE USE AS NEXT NAME IN NORMAL SEQUENCE. + +;Table for storing a name normally. +;N'th entry used for N'th name. +RFNT: JRST RFNF1 ;1st name, set FN1 + JRST RFNF2 ;Second, set FN2. + JRST RFNC ;Third, set device. + JRST RFNS ;Fourth, set sname. + SOS E ;Fifth one, ignore, and don't let count advance past 5. + POPJ P, ;So this word isn't part of the dispatch. + + +ifn $$altp,[ +alttyp: type /$ +/ + push sp,d + move a,devloc ;restore saved filename block + move d,[tyo tyoc,b] ;type it out + call pfn + type / / + pop sp,d + jrst restrt ;go back and try again with our new defaults +] +IFN $$SWITCH,[ ;Code for processing switches, when a "/" or "(" is seen. + +RFNPAR: PUSHJ P,RUC ;Get next char. Is it a ")"? +RFNPA1: CAIN B,51 ;")" + JRST RFN0 ;Paren ends switches. + CAIE B,0 + CAIN B,^M + JRST RFN1 ;CR ends spec even in switch list. + PUSHJ P,SWITCH ;Try to gobble the switch. + JRST RFNPAR ;Char in I used up, get another. + JRST RFNPA1 ;Char in I not part of switch; is it ")"? + +RFNSL: PUSHJ P,RUC + CAIE B,0 + CAIN B,^M ;/ ENDS SPEC. + JRST RFN1 + PUSHJ P,SWITCH ;Otherwise, process it as switch. + JRST RFN0 ;No skip => char in B was gobbled by switch. + JRST RFN2 ;Skip => let next RSIXG gobble the char now in B. + +];IFN $$SWITCH + +;Here to store the word in A as the SNAME. +RFNS: MOVEM A,SNM(C) ;Set the sname. + TLO E,1_SNM ;Say the sname has been specified in this filespec. + MOVS A,DEV(C) ;Get the device, + TLNE E,1_DEV ;If dev was just spec'd, don't override the spec'd one. + POPJ P, + LSH A,-6 ;Else check 1st 2 chars, + CAIE A,'AI ' ;see if dev is one known to use the sname. + CAIN A,'ML ' + POPJ P, ;If it is, nothing else to do. + CAIN A,'DM ' + POPJ P, + CAIE A,'PK ' + CAIN A,'PK ' + POPJ P, + CAIE A,'CL ' + CAIN A,'JO ' + POPJ P, +RFNS1: MOVSI A,'DSK ' ;OTHERWISE SET THE DEVICE TO DSK: + +;Here to store the word in A as the device name. +RFNC: MOVEM A,DEV(C) ;Set the dev name, + TLO E,1_DEV ;and say the device name was explicitly specified. + POPJ P, + +;Here to store the word in A as the FN1. +RFNF1: MOVEM A,FN1(C) ;Set the FN1, say was spec'd. + TLO E,1_FN1 + POPJ P, + +;Here to store the word in A as the FN2. +RFNF2: MOVEM A,FN2(C) ;Set the FN2, say was spec'd. + TLO E,1_FN2 + POPJ P, + +;Here to process a ^X or ^Y, by taking the stacked default FN1 or FN2 and using it as input. +RFNX: ADDI B,(P) ;POINT TO THE STACKED DEFAULT FN1 OR FN2 + MOVE A,-^Y(B) ;AND GET IT. + PUSHJ P,RFNN ;STORE IT NORMALLY. + JRST RFN0 ;GET NEXT NAME. + +;Subroutines for filename reading. + +IFE $$RUC,[ +;Read char into B from b.p. in D and convert to upper case. +;Filename reading does all its input via RUC. +;If $$RUC is set, we assume that the user has defined RUC, +;and call the user's definition. +RUC: xct d ;D has op to put char in b + CAIge B,140 + POPJ P, + caie b,177 ;don't modify rubout + SUBI B,40 + popj p, +];IFE $$RUC + +;Read SIXBIT word into A from source in D, leaving terminating char in B. +;Expects first character in B already. +;Terminates on a Space or control character or Rubout. +;Skips if the word was non-null. +RSIX: PUSH P,C + MOVE C,[440640,,A] ;Extra bit in b.p. set says RSIX, not RSIXG. + JRST RSIXG1 + +;Similar but stop on :, ;, and any characters which RSIXTP skips for. +;We assume that the user has defined RSIXTP to accept a character in B +;and skip or not, clobbering no ACs. +RSIXG: PUSH P,C + MOVE C,[440600,,A] ;BP FOR STORING THE SIXBIT. +RSIXG1: SETZ A, ;NO CHARS SO . +RSIX0: CAIn B,177 + jrst [setz b, ;no char + came c,[440600,,a] ;don't over-rubout + jrst [dpb b,c ;clear out the old char + add c,[060000,,0] ;back up a char + jrst rsix4] ;and get another char to work with + jrst rsix4] + + CAIN B,^Q + JRST RSIX2 ;^Q QUOTES A CHAR WHICH WOULD TERMINATE. + + CAIG B,40 + JRST RSIX1 ;SPACE OR CTL CHAR => STOP. + CAIGE B,100 ;(IF THIS SKIPS, ALL LATER TESTS WOULD FAIL ANYWAY) + TLNE C,40 + JRST RSIX3 ;RSIX WAS CALLED, ALL OTHER CHARS NORMAL. + CAIE B,72 ;":" + CAIN B,73 ;";" -- RSIXG, STOP ON : AND ;. + JRST RSIX1 +ifn $$sixp,[PUSHJ P,RSIXTP] ;only if we want to bother + JRST RSIX3 +RSIX1: SKIPL C ;TERMINATE: SKIP IF GOT >= 1 CHAR. + AOS -1(P) + POP P,C + POPJ P, + +RSIX2: PUSHJ P,RUC ;^Q => READ THE QUOTED CHAR. +RSIX3: SUBI B,40 ;INSERT NORMAL CHAR IN THE 6BIT. + TLNE C,77^4 ;IGNORE CHARS AFTER THE FIRST 6. + IDPB B,C +rsix4: PUSHJ P,RUC + JRST RSIX0 + + +];IFN $$RFN + +IFN $$PFN,[ ;Routines for printing filenames. + +;Convert the filenames in the filename block which A points at +;to ASCII, depositing it down the destination in D, followed by a ^@ +;which D is not advanced over. +;A filename block is four words containing the device, fn1, fn2 and sname. + +;It is assumed that PSIXTP (PSIX-Terminator-P) is defined as a +;routine which, given a character in B, skips if a ^Q should be +;printed before that character. Space, colon and semicolon get ^Q'd +;in any case. Thus, you can usually make PSIXTP and RSIXTP the same. + +;PFNMCH is the same as PFN except that if the device is DSK +;it prints the name of this machine (from MNAME) instead. + +IFN $$MNAME,[ + +PFNMCH: PUSH P,B + PUSH P,C + MOVE C,DEV(A) + CAME C,[SIXBIT/DSK/] + MOVE C,MNAME + JRST PFN1 +] + +PFN: PUSH P,B + PUSH P,C + MOVE C,DEV(A) ;Print device name, colon, and space. +PFN1: PUSHJ P,PSIXF + MOVEI B,72 ;":" + xct d + MOVEI B,40 + xct d + MOVE C,SNM(A) ;Print sname, semicolon, and space. + PUSHJ P,PSIXF + MOVEI B,73 ;";" + xct d + MOVEI B,40 + xct d + MOVE C,FN1(A) ;Print fn1 and space. + PUSHJ P,PSIXF + MOVEI B,40 + xct d + MOVE C,FN2(A) ;Print fn2. + PUSHJ P,PSIXF + +;;the next have been commented out because it isn't needed: The user can do it +;; if he wants, since he gets his destination operation back again. But if it +;; is a TYO it will lose to go putting out stray nulls + +; SETZ B, ;Store terminating ^@ but don't advance D over it. +; MOVE C,D +; IDPB B,C + POP P,C + POP P,B + POPJ P, + +;Print SIXBIT word in C down destination in D, +;putting ^Q's before appropriate characters. +;Clobbers C. +PSIXF: LDB B,[360600,,C] ;Extract first character + LSH C,6 ;and flush it. + ADDI B,40 + CAIE B,72 ;":" + CAIN B,73 ;";" + JRST PSIXF1 + CAIN B,40 + JRST PSIXF1 +ifn $$sixp,[PUSHJ P,PSIXTP] + JRST PSIXF2 +PSIXF1: PUSH P,B + MOVEI B,^Q + xct d + POP P,B +PSIXF2: xct d + JUMPN C,PSIXF ;ALL THE REST BLANK => DONE. + POPJ P, + +];IFN $$PFN + +IFN $$PFNBRF,[ ;Routine to print filenames, as briefly as possible. + +;PFNBRF is called like PFN, but it omits names which have their default values. +;It is assumed that MSNAME is defined to be the address of a word +;holding the "default" SNAME. +PFNBRF: PUSH P,B + PUSH P,C + MOVE C,DEV(A) ;Print device name, colon, and space. +IFN $$MNAME,CAME C,MNAME + CAMN C,[SIXBIT /DSK/] + JRST PFNBR1 + JUMPE C,PFNBR1 + PUSHJ P,PSIXF + MOVEI B,72 ;":" + xct d + MOVEI B,40 + xct d +PFNBR1: SKIPE C,SNM(A) ;Print sname, semicolon, and space. + CAMN C,MSNAME + JRST PFNBR2 + PUSHJ P,PSIXF + MOVEI B,73 ;";" + xct d + MOVEI B,40 + xct d +PFNBR2: MOVE C,FN1(A) ;Print fn1 and space. + PUSHJ P,PSIXF + SKIPN FN2(A) + JRST PFNBR3 + MOVEI B,40 + xct d + MOVE C,FN2(A) ;Print fn2. + PUSHJ P,PSIXF +PFNBR3: +; SETZ B, ;Store terminating ^@ but don't advance D over it. +; MOVE C,D +; IDPB B,C + POP P,C + POP P,B + POPJ P, + +];IFN $$PFNBRF + +IFN $$MNAME,[ ;Routine to initialize MNAME. + +RMNAME: SYSCAL SSTATU,[REPEAT 6,[? %CLOUT,,MNAME]] + .LOSE %LSSYS + POPJ P, + +];IFN $$MNAME + +.END RFN diff --git a/src/rwk/scram.42 b/src/rwk/scram.42 new file mode 100644 index 00000000..aaa9994b --- /dev/null +++ b/src/rwk/scram.42 @@ -0,0 +1,193 @@ +dsklen==1000*5 +kybufl==100 + +uf6toa==-1 +ufsiot==-1 +ufdie==-1 +uftyi==-1 +uftyo==-1 +ufrd6==-1 +fgetp==-1 + + +.insrt rwk;empty > + + +$$altp==-1 ;include altmode typeing of defaults +$$rfn==-1 ;include reading of file names +$$pfn==-1 ;include printing of file names + + jrst go1 ;skip stuff in files +.insrt rwk;files > + + +go1: type /CSCRAMBLE version / ;notify who we are + move a,versio + 6toa a,[tyo tyoc,a] + + .suset [.rsname,,sname] ;get default sname + type /AEnter your input file: / + + syscal ttyset,[argi,,tyic + [424242,,424242] + [424202,,424242]] + loss + .suset [.rsname,,dir] + +finget: movei a,device ;get pointer to file block + move d,[tyi tyic,b] ;d gets operation to read into b + call rfn"rfn + syscal open,[cnti,,.uai + argi,,dski + device + ...fn1 + ...fn2 + sname] + do [type / +Sorry, that file does not seem to be there....try again. +/ + jrst finget] + type / +Please enter an output file for my results (TTY: for the TTY) +/ +foutgt: movei a,device ;a gets pointer to file block + move d,[tyi tyic,b] ;d gets operation to get chars + call rfn"rfn ;and read the name + syscal open,[cnti,,.uao + argi,,dsko + device + ['_SCRAM'] + ['OUTPUT'] + sname] + do [type / +For some reason that does not seem to be a legit output file +Please try again. +/ + jrst foutgt] + + type / +Enter your key-phrase. +/ + move c,[440700,,keybuf] + loop a,0,kybufl,[ + tyi tyic,b + cain b,3 + exit + cain b,15 + exit + idpb b,c] + movem c,keyend + syscal ttyset,[argi,,tyic + [020202,,020202] + [020202,,020202]] + loss + type / +Is this to be an ENCODE operation? / + tyi tyic,a + caie a,131 ;is it Y? + cain a,171 ;or y? + do [type /Yes +/ + jrst start] + type /No +/ + move a,[sub e,d] ;the reverse operation + movem a,instr + +start: syscal ttyset,[argi,,tyic + [424242,,424242] + [424242,,424242]] + loss + type / +Starting...... +/ + +morcop: skipn ttyp ;are we reading from TTY? + do [move a,[440700,,dskbuf] ;no...get buffer full from disk + movei b,dsklen + + syscal siot,[argi,,dski + a + b] + jrst [type /AScrewed on input somehow; I dunno, was partly done...A/ + syscal close,[argi,,dski] + .lose 1000 + syscal close,[argi,,dsko] + .lose 1000 + ret] +] ;end of do + + movei d,dsklen ;lets figure out how many were moved + cain b,0 ;is it the end? + + skipn ttyp ;if we're not reading from TTY + sub d,b ;we do things a whole buffer at a time! + ;look MA, no random +1 or -1 's! (ITS WINS!!) + setz a, + subi a,(d) + lsh a,22 + + skipn ttyp ;if we are not reading from the TTY + movem d,count ;save the count in the buffer + + move c,[440700,,dskbuf] + move f,keyptr +codlop: skipe ttyp ;if reading from TTY + do [tyi tyic,e ;get it by reading + aos count ;count the chars in the buffer + cain e,3 ;if it is a ^C + jrst [setom b, ;pretend our count wasn't counted out + jrst codend] ;go finish up +][ ildb e,c] ;else from buffer + ildb d,f ;get key + XCT instr + dpb e,c + camn f,keyend + do [move f,[440700,,keybuf] + movem f,keyptr] + aobjn a,codlop + + movem f,keyptr + move d,count +codend: move c,[440700,,dskbuf] + syscal siot,[argi,,dsko + c + d] + jrst [type /AI was writing it out and lost somehow. Are the disks full?A/ + syscal close,[argi,,dski] + .lose 1000 + syscal close,[argi,,dsko] + .lose 1000 + ret] + cain b,0 ;zero? Are we really done? + jrst morcop ; nope, copy some more + syscal close,[argi,,dski] + skip ;ignore + syscal renmwo,[argi,,dsko + ...fn1 + ...fn2] + skip ;ignore failure...it might not be DSK + + syscal close,[argi,,dsko] + .lose 1000 + die [text /ADone! +/] + +ttyp: 0 ;non-zero if input is from TTY +keyend: 0 +keyptr: 440700,,keybuf +instr: add e,d ;instruction to do for encode/decode +count: 0 +dskbuf: block dsklen/5 +keybuf: block /5 + + +device: 'DSK ' +...FN1: '@ ' +...FN2: '> ' +sname: ' ' + +versio: .fnam2 + + end go + \ No newline at end of file