! Mouses paper tape punch spooler 2-FEB-80 %begin %conststring(3) spooler name = "pp" %constinteger pt demon = 112 %constinteger max copies = 10 %constinteger buffmax = 1023; ! MUST BE 2\\N-1 %constinteger max files = 42; ! SYSTEM CONSTANT %recordformat parmfm(%shortinteger dsno,dact,ssno,sact, %c %integer p1,p2,p3,p4,p5,p6) %OWNrecord(parmfm) p, p2 %OWNstring(29)%name s %ownstring(9) date, time, cdate %ownstring(29) file; %OWNinteger file index, current id %OWNinteger spooler; ! PACKED FORM OF NAME %constinteger vt=11, ff=12, cr = 13 %owninteger ownername,limit %OWNinteger rubbish, error1, error2, copies, active, delete, paused %owninteger binary = 0 %constinteger mask = b'0011111000000001' %OWNbyteintegerarray discbuff(0:511); %OWNinteger inbuff %OWNinteger outbuff %OWNinteger bufflim %owninteger ibp,obp %OWNshortinteger sym, last sym, next state %OWNinteger j ! States %constinteger message=1 %constinteger command = 2 %constinteger accept = 3 %constinteger next file = 4 %constinteger header = 5 %constinteger data in = 6 %constinteger flush = 7 %constinteger trailer = 8 %constinteger close = 9 %switch state(message:close) ! Commands %constinteger pause = 1 %constinteger continue = 2 %constinteger restart = 3 %constinteger cancel = 4 %constinteger stop = 5 %constinteger option = 6 %switch com(pause:option) %routine poff(%integer n, %record(parmfm)%name p) p_sact = n; svc(16,p) %end %routine report(%string(31) s) %record(parmfm) p string(addr(p_p1)) = s p_dsno = 0 svc(120,p) %end %string(29)%fn unpacked(%record(parmfm)%name r) %record(parmfm) p p_p1 = r_p1; p_p2 = r_p2; p_p3 = r_p3; p_p4 = r_p4 svc(18,p) %result = string(addr(p_sact)) %end %integerfn packed(%string(29) s) %record(parmfm) p string(addr(p_sact)) = s.":" svc(17,p) %result = p_p2 %end %routine attach spooler %record(parmfm) p p_p1 = spooler; p_p2 = accept p_dact = 2; svc(22,p) %end %integerfn system buffer address %record(parmfm) p svc(110,p) %if p_p1 < 0 %start report("claim buffer failed") *=0 %finish %result = p_p1<<16 %end %routine accept file %record(parmfm) p %integer id p_dact = 4; svc(22, p); !CLAIM FILE id = p_p1; !FILE ID error1 = 1 %and %return %if p_p6 # 0 p_p1 = id; p_dact = 5; svc(22,p); ! TAKE error1 = p_P6 report("accept:".string(addr(p_p1))) %if error1 # 0 %end %routine get next file %record(parmfm) p active = 1 p_dact = 8; svc(22, p); !Request a file error2 = p_p6 active = 0 %and %return %if error2 = -108; ! none left %if error2 >= 0 %start current id = p_p1 p_dact = 6; p_p1 = current id; svc(22, p); !Identify error2 = p_p6; -> FAIL %if error2 < 0 file = unpacked(p) p_dact = 7; p_p1 = current id; svc(22, p); !Locate p_dact = 4; svc(20,p); ! OPEN SEQUENTIAL INPUT file index = p_p5 error2 = p_p6 %return %if error2 >= 0 %finish FAIL: report("Get: ".string(addr(p_p1))) %end %routine close input %record(parmfm) p p_dact = 11 p_p5 = file index svc(20,p) %if p_p6 # 0 %start report("close: ".string(addr(p_p1))) %finish %end %routine reset input %record(parmfm) p p_dact = 12 p_p5 = file index svc(20,p) %if p_p6 # 0 %start report("reset: ".string(addr(p_p1))) %finish %end %routine delete file %record(parmfm) p p_dact = 9; p_p1 = current id; svc(22, p); !Delete %end %routine get block(%integer next, alt) %record(parmfm) p p_dact = 7; p_p4 = inbuff; p_p5 = file index; svc(20,p) next state = next next state = alt %if p_p6 < 0 %or delete # 0; ! eof %end %routine put block(%integer next) %record(parmfm) p %integer length length = obp-outbuff; obp = outbuff p_p2 = length p_p1 = outbuff p_sact = next svc(pt demon,p) %end %routine clear(%integer n) %if obp + n > bufflim %start obp = bufflim-n+1 byteinteger(obp-1) = nl %finish %end %routine psym(%integer sym) %if obp = bufflim+1 %start report("Caption too big") %return %finish byteinteger(obp) = sym; obp = obp+1 %end %routine set dt %record(parmfm) p svc(7, p) date = string(addr(p_p1)) time = string(addr(p_p4)) %end %CONSTINTEGER SOH = 1 %CONSTINTEGER STX = 2 %CONSTINTEGER EOT = 4 %ROUTINE PPV(%STRING(255) PARM) ! ROUTINE TO PUNCH OUT READABLE FORM OF CHARACTER WHOSE ASCII CODE ! IS SUPPLIED AS 'S'. INTENDED FOR PAPER-TAPE!! ! LOGICALLY THE BOUNDS OF 'HEX' ARE (32*6:95*6+5) %CONSTBYTEINTEGERARRAY HEX(192:575)= %C X'00', X'00', X'00', X'00', X'00', X'00', X'00', X'B8', X'B8', X'00', X'01', X'00', X'00', X'01', X'38', X'38', X'00', X'00', X'00', X'50', X'F8', X'50', X'00', X'00', X'10', X'F0', X'10', X'F0', X'10', X'00', X'98', X'58', X'D0', X'C8', X'00', X'00', X'48', X'B0', X'80', X'B0', X'48', X'00', X'00', X'18', X'00', X'01', X'01', X'00', X'00', X'70', X'88', X'88', X'00', X'00', X'88', X'88', X'70', X'00', X'01', X'00', X'00', X'50', X'20', X'50', X'00', X'00', X'00', X'20', X'70', X'20', X'00', X'00', X'60', X'E0', X'00', X'00', X'01', X'00', X'00', X'20', X'20', X'20', X'00', X'00', X'60', X'60', X'00', X'00', X'01', X'00', X'00', X'40', X'20', X'10', X'00', X'00', X'70', X'88', X'88', X'70', X'00', X'00', X'90', X'F8', X'80', X'00', X'01', X'00', X'90', X'C8', X'A8', X'90', X'00', X'00', X'50', X'88', X'A8', X'50', X'00', X'00', X'40', X'60', X'50', X'F8', X'40', X'00', X'B8', X'A8', X'A8', X'48', X'00', X'00', X'70', X'A8', X'A8', X'40', X'00', X'00', X'08', X'C8', X'38', X'08', X'00', X'00', X'50', X'A8', X'A8', X'50', X'00', X'00', X'10', X'A8', X'A8', X'70', X'00', X'00', X'68', X'68', X'00', X'00', X'01', X'00', X'68', X'E8', X'00', X'00', X'01', X'00', X'00', X'20', X'50', X'88', X'00', X'00', X'00', X'50', X'50', X'50', X'00', X'00', X'00', X'88', X'50', X'20', X'00', X'00', X'10', X'C8', X'28', X'10', X'00', X'00', X'E8', X'A8', X'A8', X'F8', X'00', X'00', X'F0', X'28', X'28', X'F0', X'00', X'00', X'F8', X'A8', X'A8', X'50', X'00', X'00', X'70', X'88', X'88', X'88', X'00', X'00', X'F8', X'88', X'88', X'70', X'00', X'00', X'F8', X'A8', X'A8', X'A8', X'00', X'00', X'F8', X'28', X'28', X'08', X'00', X'00', X'70', X'88', X'88', X'A8', X'E8', X'00', X'F8', X'20', X'20', X'F8', X'00', X'00', X'88', X'F8', X'88', X'00', X'01', X'00', X'48', X'88', X'88', X'78', X'00', X'00', X'F8', X'20', X'50', X'88', X'00', X'00', X'F8', X'80', X'80', X'80', X'00', X'00', X'F8', X'10', X'20', X'10', X'F8', X'00', X'F8', X'10', X'20', X'40', X'F8', X'00', X'70', X'88', X'88', X'88', X'70', X'00', X'F8', X'28', X'28', X'10', X'00', X'00', X'70', X'88', X'A8', X'48', X'B0', X'00', X'F8', X'28', X'28', X'D0', X'00', X'00', X'10', X'A8', X'A8', X'A8', X'40', X'00', X'08', X'08', X'F8', X'08', X'08', X'00', X'78', X'80', X'80', X'78', X'00', X'00', X'18', X'60', X'80', X'60', X'18', X'00', X'78', X'80', X'40', X'80', X'78', X'00', X'88', X'50', X'20', X'50', X'88', X'00', X'08', X'10', X'E0', X'10', X'08', X'00', X'88', X'C8', X'A8', X'98', X'88', X'00', X'F8', X'88', X'88', X'00', X'01', X'00', X'10', X'20', X'40', X'00', X'01', X'00', X'88', X'88', X'F8', X'00', X'01', X'00', X'00', X'10', X'F8', X'10', X'00', X'00', X'C0', X'80', X'80', X'C0', X'00', X'00' ! %CONSTINTEGER FF=12; ! FORM-FEED CODE %SHORTINTEGER I,J,S, H %FOR J = 1,1,LENGTH(PARM) %CYCLE S = CHARNO(PARM,J) S = S-32 %IF S>95; ! LOWER CASE ALPHABET %IF 32<=S<=95 %START; ! IF A VALID PRINTING CHARACTER I = S*6 %FOR I = I, 1, I+5 %CYCLE H = HEX(I) PSYM(SOH!H) %UNLESS H = 1 %REPEAT %ELSE %IF S=NL %OR S=FF %START PSYM(SOH ! 0); PSYM(SOH ! 0) PSYM(SOH ! 255); PSYM(SOH ! 255) PSYM(SOH ! 0); PSYM(SOH ! 0) %ELSE PSYM(SOH ! 255) %FOR I = 1,1,6 %FINISH %FINISH %REPEAT %END %INTEGERFN PARITY(%INTEGER SYM) %CONSTBYTEINTEGERARRAY EP(0:15) = %C 0,128,128,0,128,0,0,128, 128,0,0,128,0,128,128,0 %RESULT = (EP(SYM&15)!!EP(SYM>>4)) ! SYM %END %routine set(%integer size, %string(63) what) %integer j,l,s l = length(what) %for j = 1, 1, size %cycle %if j > l %then s = ' ' %else s = charno(what, j) psym(s) %repeat %end %routine runout(%integer n) psym(0) %and n = n-1 %while n > 0 %end %routine set header %string(255) s %integer j %conststring(1) snl =" " set dt runout(20) s = snl." ".file." ".date." ".time." ".snl ppv(s); psym(stx) runout(150) %end %routine set trailer %conststring(7)%array why(1:2) = "RESTART", "DELET" %integer j %if delete # 0 %start runout(50); ppv("output ".why(delete)."ed by operator") %finish runout(20) psym(eot) runout(200) %end ! =============start here============= ! ! initialisation outbuff = system buffer address reprime: spooler = packed(spooler name) attach spooler inbuff = addr(discbuff(0)) bufflim = outbuff+buffmax active = 0; rubbish = 0; delete = 0; paused = 0 %cycle; ! main loop poff(0,p) -> state(p_dact) %if message <= p_dact <= close report("bad dact") %continue state(command): -> com(p_p2) %if pause <= p_p2 <= option ->reprime %if p_p2 = 7; !potter is sick report("Faulty command"); %continue com(pause): paused = 1; %continue com(restart): %if active # 0 %and paused = 0 %start copies = copies+1 delete = 1 %continue %finish com(continue): paused = 0; -> more %if active # 0 -> start next file; ! just in case com(cancel): copies = 0; delete = 2; %continue com(stop): paused = -1; %continue com(option): %if string(addr(p_p3)) = "BINARY" %start binary = 1; %continue %finish %if string(addr(p_p3)) = "NOBINARY" %start binary = 0; %continue %finish report("Bad option ".string(addr(p_p3))) %continue state(message):report("PP kicked") state(accept): accept file %continue %if error1 # 0 %or active # 0 %or paused # 0 start next file: state(next file): copies = 1 get next file %continue %unless error2 = 0 %and active # 0 next copy: state(header): ibp = inbuff+512; obp = outbuff last sym = 0 set header; ! ** Maximum of 1023 characters ** MORE: state(data in): %continue %if paused > 0 %while obp # bufflim+1 %cycle %if ibp = inbuff+512 %start ibp = inbuff get block(data in,flush) -> state(next state) %finish sym = byte integer(ibp); ibp = ibp+1 %if binary = 0 %start %continue %if sym = 0 %or sym = 255 %continue %if sym = eot %if sym = NL %start %if last sym # CR %start ibp = ibp-1 sym = CR; last sym = CR %finish %else last sym = sym %finish sym = parity(sym) %finish psym(sym) %repeat put block(next state) %continue flush it: state(flush): %if obp # 0 %start put block(trailer) %continue %finish state(trailer): set trailer put block(close) %continue state(close): copies = copies - 1 %if copies > 0 %start reset input; -> next copy %finish close input; delete file paused = |paused| -> start next file %if paused = 0 %repeat %endofprogram