; -*- Midas -*- title LPDEV -- Foreign Lineprinter Device ; Things to do: ; ; LPT:; --- use directory to name the printer to use? This ; kludge with the trailing digits doesn't really cut it. What do we ; do about eventually specifying fonts etc.? Put -that- in the ; digits following the device name? ; ; Should have a :LP command that eats a filename and perhaps some ; switches? ; ; Handle "<" and ">" filenames by gensyming up a number? What ; happens if the guy opens "LP7:> >"? What good does "<" do him ; anyway? I guess the idea is to compensate for the fact that EMACS ; likes to offer "FOO >" as the default filename, so perhaps we can ; do something better than just a gensym... ; Modification history: ; ; Alan 12/13/89 Updated DEVTBL. Flushed all the old aliases. ; ; Alan 7/17/89 LCS printers should spool through Zermatt now. ; ; Alan 7/13/89 ITSLPT conversion done. Raw mode broken. Listing ; the queue works. Deleting and commands don't. ; The server runs only on Reagan at the moment. ; ; Current open errors: ; NSDV Device name not found in DEVTBL ; NAPK Server is gone from hosttable ; NADV Server doesn't answer ; BDLK Server never heard of that printer ; NRDV Server got error accessing the printer ; BDDV Operation not supported (MLINK, etc.) ; NSMD Mode not supported (image mode directory, ; reading non-magic names, etc.) ; ; Alan 7/11/89 Started extensive modifications to spool through ; Lisp Machines using the ITSLPT protocol I just ; designed. Raw mode is now broken. Listing the ; queue doesn't work yet. Deleting things doesn't ; work yet. Commands don't work yet. ; ; Alan 5/26/89 All AI Lab printers now spool thought Hephaestus ; (The last working AI Lab Chaosnet Unix...) ; ; Maeda 24-May-89 LP7 and LR7 now spool through Hermes. ; ; MAP 20-Jan-89 LCS now spools through KNIPT. ; ; Alan 1/17/89 When a hostname in the table here disappears from ; the host table (as NUTMEG just did), we now return ; %EBDLK error (LINK TO NON-EXISTENT FILE). ; Flushed BYELIB because it was broken. ; ; MAP 25-Apr-88 Added SPAM as LR5: ; ; Alan 8/30/87 Salami moved from 5 to 4. Appropriate adjustments. ; ; Alan 7/16/87 Setting 10 bit when opening now puts you in "Raw ; mode" so that you can talk to the printer in its ; native tongue (usually PostScript). ; ; SWA 5/12/87 Moved LCS spooling over from BORAX-CHAOS to NUTMEG ; ; SWA 3/26/87 Added LP2: as alias for LR2:, LR4: as an alias for LP4: ; I also found that Adobe's Transcript software ; bombs with certain input files that ITS sends. ; I will have to fix this at the UNIX end of things, ; but I thought I'd document the lossage here. ; (this currently affects LR5: and LP3:). ; ; SWA 3/25/87 Created the following entries: ; LR9: (for "The Wall Street Journal") ; LP5: (for "GI") ; LR5: (for "SALAMI") ; LP4: (for "OVAL") ; LP3: (for "HAM") ; LR3: (for "CHARMIN") ; LR2: (for "PULP") ; ; Alan 10/8/86 Moved LP8: to HEPHAESTUS. ; Created LR8: for The-Washington-Post (on HERMES). ; Alan 10/7/86 Now returns %ENSMD if asked to supply image mode ; directory or MFD. (To keep FILE job from crashing...) ; (Note that although ACT1 printer is now gone, it ; remains in the tables here.) ; Alan 8/7/86 Created ACT: device to use ACT1 printer (on PREP). ; Alan 6/3/86 Moved LP8: to GUTENBERG. Made all host names be ; domain style. LPTEST: now uses AI. ; Alan 1/16/86 Arranged for name of local host to appear as part ; of the filename. This way when you list the queue, ; or look at a header or trailer page, you can tell ; what machine the file was sent from. ; Alan 12/6/85 DAILY-PLANET (LP8:) moved from HTVAX to HERMES. ; Alan 11/23/85 Reading LP7:.CMD. FOO sends the command "foo" to ; the LGP-CONTROL server. The device name LPTEST: is ; recognized to connect back to MC to facilitate ; debugging. ; Alan 11/12/85 "MIT|" => "AI|" throughout. ; Alan 11/8/85 DAILY-PLANET moved to HTVAX. Bug fixes. ; Alan 10/28/85 Added support for 8th and 9th floor printers. ; Changed device naming scheme to put digit last. ; Alan 9/4/85 Changed contact name strings. ; Alan 7/26/85 7LR device prints on laserwriter. Added DEVTRN ; routine to translate device names into printer ; service names. Added support for DELETE. ; Gumby 21/5/85 Trailer page is now more useful ; Alan 5/20/85 Added RFDATE and SFDATE to make EMACS Write File ; command happy. ; Alan 3/16/85 Restored backspace hacks since CJL went to the ; trouble to support it! ; Alan 2/20/85 Added USRNAM routine to make a better guess at the ; user's user-name. ; Alan 2/4/85 Flushed usage of backspace to cause clever ; overstriking, since the simple server we use ; stopped supporting backspace. ; Alan 1/1/85 Now uses JOBSTS to maintain filenames as set by ; RENMWO. Also now outputs a trailer page to give ; the LN01 something to eat if it feels like it... ; Alan 12/27/84 Installed 7LP on SYSEN1; ; Accumulators a=:1 b=:2 c=:3 d=:4 e=:5 t=:6 tt=:7 x=:10 y=:11 z=:12 ct=:16 ; Always contains state of BOJ connection p=:17 ; Channels ttyo==:1 ; for debugging boj==:2 ; for talking to the user chai==:3 ; input from the network chao==:4 ; output to the network utilch==:5 ; utility channel clich==:6 ; CLI channel ; Flags %f==:0,,525252 ; Flags in RH(0) ;; OPEN mode preserved in place: %foout==:000001 ; Output %foblk==:000002 ; Block mode %foimg==:000004 ; Image mode %foraw==:000010 ; Raw mode %foout==:%doout ? %foblk==:%doblk ? %foimg==:%doimg ;; Others: %fdbug==:000100 ; Being debugged as an OJB server under DDT %fdata==:000200 ; GET has returned a non-data packet %fval==: 000400 ; BOJ interrupts clear this "valid" bit %fiot==: 001000 ; User last seen in an IOT %fsiot==:002000 ; User last seen in a SIOT %fclos==:004000 ; User has closed his output channel %fabrt==:010000 ; Abort rather than Close on output ; Instructions call=:pushj p, return=:popj p, save=:push p, rest=:pop p, pause=:.break 16,100000 tyo=:.iot ttyo, quit=:call . $quit: trne %fdbug pause .logout 1, ; Macros define syscall name,args .call [setz ? sixbit /name/ ? args(400000)] termin define report &text& call [ trnn %fdbug return call $report .length text ascii text] termin $repor: exch t,(p) save tt move tt,0(t) movei t,1(t) hrli t,440700 tyo [^P] tyo ["A] syscall siot,[movei ttyo ? t ? tt] .lose %lssys tyo [^P] tyo ["A] rest tt rest t return .insrt dsk:syseng;format > .scalar outstr ; Usually contains JRST CHAOUT define format &text&,locs pushj p,[ pushj p,fmtin .frmt.==-1 irp loc,,[locs] push p,loc .frmt.==.irpcnt termin hrroi a,[ascii text] movei b,.length text movni c,.frmt.+1 jrst format"format] termin fmtin: push p,a push p,b push p,c call @-3(p) pop p,c pop p,b pop p,a pop p,(p) popj p, ; ; for byelib: ; byelib"f==13 ; byelib"cnt==15 ; byelib"linch==6 ; byelib"idxch==7 ; byelib"odxch==8 ; .insrt dsk:syseng;byelib > lpdl==:50. .vector pdl(lpdl) go: setzb 0,ct ; clear flags and state move t,[jrst chaout] movem t,outstr move p,[-lpdl,,pdl-1] .suset [.roption,,a] tlnn a,%opddt jrst noddt tro %fdbug tlo a,%opojb .open ttyo,[.uao\%tjdis,,'tty ? setz ? setz] .lose %lssys .value [asciz ""] noddt: tlo a,%opint\%opopc move tt,[-4,,[ .soption,,a .smask,,[%pipdl\%piioc] .smsk2,,[1_chai\1_boj] .sdf2,,[1_boj] ]] .suset tt report "Ready..." .open boj,[.bai,,'boj ? setz ? setz] quit move tt,[-loargs,,oargs] .call jobcal quit tlne t,%jgcls ; Why does this happen? quit move a,t call devtrn jrst oensdv call rfclpt jrst oenadv format "SET-PRINTER ~A",lptnam movei e,1 call lptack jrst oebdlk jrst @otable(a) oerror: .lose otable: offset -. %joopn:: open ; .open %joiot:: oerror ; .iot (?) %jolnk:: mlink ; mlink %jorst:: oerror ; .reset (?) %jorch:: oerror ; .rchst (?) %joacc:: oerror ; .access (?) %jornm:: delrnm ; .fdele (delete or rename) %jorwo:: oerror ; .fdele (renmwo) (?) %jocal:: oerror ; .call (?) offset 0 delrnm: skipe oxfn1 jrst rename jrst delete ifn 0,[ delete: report "Delete" call rfcdel jrst oenadv ;; Should read the reply and barf if nothing deleted... .call jobrt0 quit quit ] oensdv: movsi tt,%ensdv ? jrst obarf oenadv: movsi tt,%enadv ? jrst obarf oenrdv: movsi tt,%enrdv ? jrst obarf oensmd: movsi tt,%ensmd ? jrst obarf oebdlk: movsi tt,%ebdlk ? jrst obarf oensfl: movsi tt,%ensfl ? jrst obarf oenapk: movsi tt,%enapk ? jrst obarf oebddv: movsi tt,%ebddv obarf: .call joberr quit quit delete==:oebddv rename==:oebddv mlink==:oebddv .scalar xuname .scalar uname .scalar jname .scalar qdate open: move tt,[-3,,[ .rxuname,,xuname .runame,,uname .rjname,,jname ]] .uset boj,tt syscall rqdate,[movem qdate] setom qdate hrrz t,omode trne t,#<%foraw\%foout\%foblk\%foimg> ; All we support at the moment. jrst oensmd movem t,stsmod ; Remember as OPEN mode dpb t,[060300,,stssts] ; Remember in status bits tro (t) ; Set mode in the flags. irp foo,,[dev,dir,fn1,fn2] move tt,o!foo movem tt,sts!foo termin .call jobsts ; Set the status .lose %lssys syscall sstatu,[repeat 6,[ ? movem stshst]] .lose %lssys call bufini ; Initialize buffer trne %foout jrst output input: trne %foimg\%foblk ; 36 bits? jrst [ .open boj,[.bao,,'boj ? setz ? setz] quit jrst input1] .open boj,[.uao,,'boj ? setz ? setz] quit input1: move t,ofn1 camn t,[sixbit /.CMD./] jrst cmdlst move tt,ofn2 camn t,[sixbit /.FILE./] came tt,[sixbit /(DIR)/] jrst oensmd dirlst: trne %foimg ; We don't support image mode directories jrst oensmd call lptset format "LIST-QUEUE GOODBYE " call lptak1 jrst oenrdv jrst input2 cmdlst: jrst oensmd ; Not implemented yet... input2: .call jobrt0 quit .suset [.sdf2,,[0]] ; Enable BOJ interrupts call inch call ioclos move a,t jrst inlop1 inloop: andi t,177 caie t,^M jrst inlop2 idpb t,bufbp sosg bufrm call bufout movei t,^J inlop2: idpb t,bufbp sosg bufrm call bufout inlop1: call inch call ioclos came t,a jrst inloop movei t,^L idpb t,bufbp sosg bufrm call bufout jrst bojeof trycli: move b,t ; Preserve reply in B syscall open,[movsi .uao ? movei clich ? [sixbit /CLI/] move uname ? [sixbit /HACTRN/]] .lose ; leave a corpse... move t,[jrst outcli] movem t,outstr format "Your output (~S:~S;~S ~S) may not have been sent to ~A.~ ",[stsdev,stsdir,stsfn1,stsfn2,lptnam] caie b,"R cain b,"F jrst trycl1 tryurk: format "~%The server on ~A violated protocol ~ after accepting the output.",srvhst jrst trybug trycl1: format "~%The error recieved from the server on ~A was:~@ ",srvhst call inch jrst tryurk move a,t trylop: call inch jrst tryurk camn t,a jrst tryend andi t,177 trylf: .iot clich,t caie t,^M jrst trylop movei t,^J jrst trylf tryend: caie b,"R trybug: format "~%This -may- indicate a bug that should be reported.~%" quit outcli: syscall siot,[movei clich ? move a ? move b] .lose %lssys return output: call lptset format "OPEN " call lptak1 jrst oenrdv .call jobrt0 quit .suset [.sdf2,,[0]] ; Enable BOJ interrupts outptl: call bufin skipg b,bufct jrst outpt2 format "DATA ~D ",b move a,bufbp call chaout jrst outptl outpt2: trne %foraw jrst outpt3 format "DATA-DELIMITED ~5%That was ~S: ~S: ~S; ~S ~S~ ",[stshst,stsdev,stsdir,stsfn1,stsfn2,a] ; save a ; save b ; call byelib"getmsg ; format " ~5%That was ~S: ~S: ~S; ~S ~S~%~A ; ",[stshst,stsdev,stsdir,stsfn1,stsfn2,a] ; rest b ; rest a outpt3: trne %fabrt jrst [ format "ABORT GOODBYE " jrst outpt4 ] format "CLOSE GOODBYE " outpt4: movei e,2 ; data, close, (ignore goodbye) call lptack call trycli trnn %fclos .hang quit lbuffer==:2000 .vector buffer(lbuffer+1) ; BOJ buffer .scalar bufbp ; Byte pointer into BUFFER .scalar bufrm ; Room in buffer in bytes for output .scalar bufct ; Count of bytes in buffer for input .scalar bufhak ; Aobjn pointer for -next- buffer refill ; CALL BUFINI: Initialize buffer for input or output bufini: move tt,[440700,,buffer] movem tt,bufbp movei tt,5*lbuffer movem tt,bufrm setzm bufct move tt,[-lbuffer,,buffer] movem tt,bufhak return ; CALL BUFIN: Get a buffer full of data from the user and initialize for ; input. bufin: report "Inputting" move tt,buffer+ movem tt,buffer+0 ; Old last word becomes new first word move tt,[440700,,buffer] movem tt,bufbp ; Restore buffer pointer move t,bufhak .iot boj,t tlce t,700000 jrst bufin2 movei tt,5* ; Don't allow last word to be read yet movem tt,bufct move tt,[1-lbuffer,,buffer+1] movem tt,bufhak return bufin2: trnn %foimg\%foblk jrst bufin3 movei tt,-buffer(t) jumpe tt,bufin4 imuli tt,5 ldb z,[010700,,-1(t)] caie z,^C jrst bufin4 ldb z,[100700,,-1(t)] caie z,^C soja tt,bufin4 subi tt,3 ldb z,[170700,,-1(t)] caie z,^C aoja tt,bufin4 ldb z,[260700,,-1(t)] caie z,^C jrst bufin4 soja tt,bufin4 bufin3: ldb tt,[410300,,t] movei t,-buffer(t) imuli t,5 add tt,t bufin4: movem tt,bufct ; set byte count move tt,[-lbuffer,,buffer] movem tt,bufhak return ; CALL BUFOUT: Give buffer to user and reinitialize for more output bufout: save a trne %foimg\%foblk ; Dispatch on byte size jrst 36out 7out: report "Outputting (7)" movei a,5*lbuffer subm a,bufrm exch a,bufrm ; A: # bytes to output, reset room skipn tt,a jrst bfoutx tlo tt,400000 add ct,tt ; update state, indicate correction in A move tt,[440700,,buffer] movem tt,bufbp syscall siot,[movei boj ? tt ? a] .lose %lssys tlz ct,400000 ; correction off bfoutx: rest a return 36out: report "Outputting (36)" movei t,5*lbuffer sub t,bufrm idivi t,5 ; T: # words to output skipn tt,t jrst bfoutx movn a,t hrl a,a hrri a,buffer ; A: aobjn into buffer tlo tt,400000 add ct,tt ; update state, indicate correction in A .iot boj,a tlz ct,400000 ; correction off move tt,bufbp sub tt,t movem tt,bufbp ; reset buffer pointer move tt,buffer(t) movem tt,buffer+0 ; save trailing characters imuli t,5 addm t,bufrm ; reset room rest a return .scalar iot.ct ; Saved CT at last IOT .scalar iot.a ; Saved A at last IOT ; JRST BOJEOF: Output last buffer to user and give him EOF. bojeof: trnn %foimg\%foblk jrst bjeof1 movei c,^C idpb c,bufbp sosg bufrm jrst bjeof1 idpb c,bufbp sosg bufrm jrst bjeof1 idpb c,bufbp sosle bufrm idpb c,bufbp bjeof1: call bufout eoflp: trne %fval ; Do we understand the situation? .hang ; Yes: Twiddle thumbs report "EOF check" tro %fval ; Set valid flag trnn %fiot\%fsiot ; User last seen in IOT or SIOT? jrst eoflp ; No: Loop move a,iot.ct ; Get saved count tlzn a,400000 ; Correction needed? jrst gotct ; No hlre b,iot.a ; Correction in words in 36 bit mode trnn %foimg\%foblk movn b,iot.a ; Correction in bytes in 7 bit mode add a,b ; Make correction gotct: subm ct,a ; A: Number of words we have given user ; since he (S)IOT'd. hlre b,iotptr ; Find out how many words he was asking for trnn %foblk ; on that occasion. movn b,iotptr add a,b ; A: number of additional words he would be ; left waiting for. trnn %fval ; Still valid after looking at ARGS? jrst eoflp jumpe a,eoflp ; He got what he wanted trnn %fsiot ; SIOT and block mode just return trne %foblk jrst wakeup trne %foimg ; .UII gets IOC if you IOT beyond EOF jrst eofioc trnn %fval ; Still valid after all this? jrst eoflp ;; Suppose he PCLSRs and does a SIOT instead? He gets a ^C. .iot boj,[-1,,3] jrst eoflp wakeup: .call jobrt0 jrst eoflp jrst eoflp eofioc: movei t,2 ; EOF error. This should have a symbolic name. trnn %fval ; still valid after all this? jrst eoflp ;; Suppose he PCLSRs and does a SIOT instead? He gets an error anyway. .call jobioc .lose %lssys jrst eoflp netwrk"$$hstmap==:1 netwrk"$$hostnm==:1 netwrk"$$symlook==:1 netwrk"$$chaos==:1 netwrk"$$hst3==:1 .insrt dsk:syseng;netwrk > ; CALL PREPPY: Return chaosnet address of server. ; A (val): address preppy: save b movei a,ffpage movei b,utilch call netwrk"hstmap .lose move a,srvhst call netwrk"hstlook jrst oenapk rest b return lsrtns"$$ulnm==:0 ; Don't need last name searching lsrtns"$$ulnp==:0 ; or the abbreviated version .insrt dsk:syseng;lsrtns > .vector lsrbuf(50.) ; Anybody have a 250. character name? ; CALL FULNAM: To look up XUNAME's full name. ; A (val): byte pointer to ASCIZ string ; Skips if a name can be found. fulnam: save b movei a,utilch move b,[ffpage-400,,ffpage] ; Use as much as you want... call lsrtns"lsrmap jrst flnmlz movei a,utilch move b,xuname ; Hack this user call lsrtns"lsrunm jrst flnmlz movei a,lsrtns"i$name ; Get his full name call lsrtns"lsritm jrst flnmlz move b,[440700,,lsrbuf] ; Permute it into here call lsrtns"lsrnam .lose move a,[440700,,lsrbuf] ; Return it aos -1(p) flnmlz: .close utilch, rest b return ; CALL USRNAM: To guess a user name based on UNAME and XUNAME ; A (val): sixbit user name usrnam: move a,uname ; Probably use UNAME camn a,xuname ; Same? return ; Yes: Return it. move tt,uname move t,uname xor t,xuname jrst usrnm2 usrnm1: lsh t,6 lsh tt,6 usrnm2: tlnn t,770000 ; Find first difference jrst usrnm1 usrnm3: setzi t, lshc t,6 ; T: next difference cail t,'0 ; Digit? caile t,'9 jrst usrnm4 ; No: use XUNAME jumpe tt,[return] ; Yes: return UNAME if last one jrst usrnm3 ; else look at next difference usrnm4: move a,xuname return .insrt dsk:syseng;chsdef > $cpkbp==:440800,,%cpkdt .vector opkt(%cpmxw) ; Output Packet .vector ipkt(%cpmxw) ; Input Packet .scalar opktbp ; Byte pointer into OPKT .scalar ipktbp ; Byte pointer into IPKT .scalar chast ; Current state of connection .scalar opktrm ; Room left in OPKT in bytes .scalar charm ; Room left for sending packets .scalar ipktct ; Count of available bytes in IPKT .scalar chact ; Count of available packets ; .CALL PKTIN: Receive packet into IPKT pktin: setz sixbit /pktiot/ movei chai setzi ipkt ; .CALL PKTOUT: Transmit packet in OPKT pktout: setz sixbit /pktiot/ movei chao setzi opkt ; CALL CHASTS: Update status of network connection chasts: syscall whyint,[movei chai movem t ; %WYCHA movem chast ; %CS... movem t] ; available,,room .lose %lssys hlrm t,chact hrrm t,charm return ; Handle interrupt on network connection chaint: report "Chaos interrupt" call chasts .call dismis .lose %lssys ; CALL CHABEG: Open network connection and prepare OPKT for RFC chabeg: save a syscall chaoso,[movei chai ? movei chao ? movei 3] .lose %lssys call preppy dpb a,[$cpkda opkt] movei tt,%corfc dpb tt,[$cpkop opkt] move tt,[$cpkbp opkt] movem tt,opktbp movei tt,%cpmxc movem tt,opktrm setzm ipktct rest a return ; CALL GET: Get next packet and set up for input ; T (val): opcode ; Skips if this is just another data packet get: call chasts ; Make sure CHACT is valid skipg chact .hang .call pktin .lose %lssys ldb tt,[$cpknb ipkt] movem tt,ipktct move tt,[$cpkbp ipkt] movem tt,ipktbp ldb t,[$cpkop ipkt] caie t,%codat ; Data packet? troa %fdata ; No: Don't skip (remember it) trze %fdata ; Yes: Were we expecting one? (remember it) return ; No: Don't skip aos (p) ; Yes: Skip return ; CALL INCH: Read a character from network ; Skips unless opcode changed. ; T (val): character or new opcode inch1: call get return inch: sosge ipktct jrst inch1 ildb t,ipktbp aos (p) return ; CALL OUTCH: Write a character to network ; T (arg): character ; ; CALL PUT: Send packet and reinitialize for more output outch: idpb t,opktbp sosle opktrm return put: move tt,[$cpkbp opkt] movem tt,opktbp movei tt,%cpmxc subm tt,opktrm exch tt,opktrm jumpe tt,[return] dpb tt,[$cpknb opkt] .call pktout .lose %lssys return ; CALL CHAOUT: Write a string to network ; A: source BP ; B: source length chaout: jumple b,[return] outst1: ildb t,a idpb t,opktbp sosg opktrm call put sojg b,outst1 return .scalar lptnam ; Printer name ("Pravda" for LP7:) .scalar srvhst ; Host ("Reagan" for LP7:) reagan: asciz "Reagan" block 5 ; For patching. zermat: asciz "Zermatt" block 5 ; For patching. pigpen: asciz "Pigpen" block 5 ; For patching. ; these are the definitions of the printers that exist devtbl: lp9srv,,lp9srv lr9srv,,lr9srv lp8srv,,lp8srv lr8srv,,lr8srv lp7srv,,lp7srv lr7srv,,lr7srv lp6srv,,lp6srv lr6srv,,lr6srv lp5srv,,lp5srv lr5srv,,lr5srv lp4srv,,lp4srv lr4srv,,lr4srv lp3srv,,lp3srv lr3srv,,lr3srv lp2srv,,lp2srv lr2srv,,lr2srv tstsrv,,tstsrv ldevtbl==:.-devtbl lp9srv: sixbit /LP9/ reagan,,[asciz "National-Enquirer"] 0,,0 lr9srv: sixbit /LR9/ reagan,,[asciz "The-Wall-Street-Journal"] 0,,0 lp8srv: sixbit /LP8/ reagan,,[asciz "Daily-Planet"] 0,,0 lr8srv: sixbit /LR8/ reagan,,[asciz "The-Washington-Post"] 0,,0 lp7srv: sixbit /LP7/ reagan,,[asciz "Pravda"] 0,,0 lr7srv: sixbit /LR7/ reagan,,[asciz "Le-Monde"] 0,,0 lp6srv: sixbit /LP6/ zermat,,[asciz "Celery"] 0,,0 lr6srv: sixbit /LR6/ zermat,,[asciz "Oval"] 0,,0 lp5srv: sixbit /LP5/ zermat,,[asciz "GI"] 0,,0 lr5srv: sixbit /LR5/ zermat,,[asciz "Spam"] 0,,0 lp4srv: sixbit /LP4/ zermat,,[asciz "Turkey"] 0,,0 lr4srv: sixbit /LR4/ zermat,,[asciz "Salami"] 0,,0 lp3srv: sixbit /LP3/ zermat,,[asciz "Ham"] 0,,0 lr3srv: sixbit /LR3/ zermat,,[asciz "Charmin"] 0,,0 lp2srv: sixbit /LP2/ zermat,,[asciz "Pulp"] 0,,0 lr2srv: sixbit /LR2/ zermat,,[asciz "XPress"] 0,,0 tstsrv: sixbit /LPTEST/ pigpen,,[asciz "Le-Monde"] 0,,%foraw\%fabrt ; CALL DEVTRN: Translate device name to service description. ; Skips if device name was found. devtrn: movsi t,-ldevtbl dvtrn1: hlrz tt,devtbl(t) move tt,(tt) came tt,odev aobjn t,dvtrn1 jumpge t,[return] hrrz t,devtbl(t) move tt,(t) movem tt,odev hlrz tt,1(t) movem tt,srvhst hrrz tt,1(t) movem tt,lptnam tdo 2(t) aos (p) return ; CALL RFCLPT: Connect to ITSLPT server. rfclpt: save a save b call chabeg format "ITSLPT" call put ; Flush the buffer to send RFC movei tt,%codat ; and before changing opcode dpb tt,[$cpkop opkt] movei tt,10.*30. ; 10 seconds trne %fdbug ; Unless debugging movei tt,10.*60.*30. ; 10 minutes syscall netblk,[movei chao movei %csrfs move tt movem t] .lose %lssys rest b rest a cain t,%csopn aos (p) return ; CALL LPTAK1: Read ack ; CALL LPTACK: Read acks ; Skips on success ; E (arg): Number of acks to look for (at least 1) lptack: call put ; Flush out any buffered output lptak5: call lptak2 return sojg e,lptak5 aos (p) return lptak1: call put ; Flush out any buffered output lptak2: call inch return cain t,"A aos (p) return ; CALL LPTSET: Set properties for output. lptset: format "SET TITLE ~S: ~S: ~S; ~S ~S~ ",[stshst,stsdev,stsdir,stsfn1,stsfn2] call usrnam format "SET UNAME ~S",a call fulnam jrst nofull format "SET NAME ~A (Sent by ~S ~S)",[a,uname,jname] jrst didnam nofull: format "SET NAME ~S (Sent by ~S ~S)",[xuname,uname,jname] didnam: movei e,3 call lptack .lose return tsint: loc 42 -ltsint,,tsint loc tsint intacs,,p %piioc ? 0 ? %piioc ? 0 ? iocint 0 ? 1_boj ? %piioc ? 1_boj ? bojint 0 ? 1_chai ? 0 ? 1_chai ? chaint ltsint==:.-tsint intacs==:400002+t_6 ; 3 things plus T and TT ; .CALL DISMIS: Dismiss an interrupt dismis: setz sixbit /dismis/ movsi intacs setz p ; Handle IOC interrupt iocint: .suset [.rbchn,,t] caie t,chao ; Better be network lossage cain t,chai skipa syscall lose,[movei 0 ? movei .] call ioclos ; CALL IOCLOS: Crap out maximally on the poor user. ; Never returns, the CALL is just for tracing. ioclos: tro %fval trne %fclos ; Are we supposed to be closed? quit movei t,3 ; Non-recoverable data error .call jobioc .lose %lssys trne %fval ; Keep doing it if he comes back again. .hang jrst ioclos ; Handle interrupt on the BOJ channel bojint: report "BOJ interrupt" trz %fiot\%fsiot\%fval move tt,[-largs,,args] .call jobcal jrst disint tlne t,%jgcls ; .close jrst close jrst @caltbl(t) caldie: .lose caltbl: offset -. %joopn:: caldie ; .open (?) %joiot:: iot ; .iot %jolnk:: caldie ; mlink (?) %jorst:: calwtd ; .reset %jorch:: rchst ; .rchst %joacc:: calwtd ; .access %jornm:: caldie ; .fdele (delete or rename) (?) %jorwo:: renmwo ; .fdele (renmwo) %jocal:: docall ; .call offset 0 close: report "Close" trnn %foout ; User outputting? quit ; No: Just die tro %fclos ; Yes: Set a flag .call dismis ; and finish up at main program level .lose %lssys iot: report "IOT" tlnn t,%jgsio troa %fiot tro %fsiot movem a,iot.a movem ct,iot.ct disint: .call dismis .lose %lssys .vector vals(5) ; For values returned from .CALLs ; ATSIGN -insists- on being able to RENMWO... renmwo: report "Rename while open" .call jobrt0 jrst disint move tt,xfn1 movem tt,stsfn1 move tt,xfn2 movem tt,stsfn2 .call jobsts .lose %lssys .call dismis .lose %lssys rchst: report "Read channel status" move tt,stsdev movem tt,vals+0 move tt,stsfn1 movem tt,vals+1 move tt,stsfn2 movem tt,vals+2 move tt,stsdir movem tt,vals+3 setom vals+4 move tt,[-5,,vals] .call jobret jfcl .call dismis .lose %lssys docall: .suset [.ssname,,calnam] move t,calnam camn t,[sixbit /lnkedp/] jrst lnkedp camn t,[sixbit /rfdate/] jrst rfdate camn t,[sixbit /sfdate/] jrst sfdate report "Random .CALL" calwtd: report "%EBDDV" movsi tt,%ebddv .call joberr jfcl .call dismis .lose %lssys lnkedp: report "Linked?" setzm vals+0 ; We are never a link move tt,[-1,,vals] .call jobret jfcl .call dismis .lose %lssys rfdate: report "Read date" move tt,qdate movem tt,vals+0 move tt,[-1,,vals] .call jobret jfcl .call dismis .lose %lssys sfdate: report "Set date" .call jobrt0 jrst disint move tt,arg2 movem tt,qdate .call dismis .lose %lssys ; .CALL JOBCAL: Get system call and arguments ; TT (arg): aobjn to args area ; T (val): opcode jobcal: setz sixbit /jobcal/ movei boj move tt setzm t ; .CALL JOBRET: Return values from system call ; TT (arg): aobjn to values jobret: setz sixbit /jobret/ movei boj movei 1 setz tt ; .CALL JOBRT0: Return no values from system call jobrt0: setz sixbit /jobret/ movei boj setzi 1 ; .CALL JOBERR: Return error from system call ; TT (arg): ,,0 joberr: setz sixbit /jobret/ movei boj setz tt ; .CALL JOBSTS: Set device status jobsts: setz sixbit /jobsts/ movei boj move stssts move stsdev move stsfn1 move stsfn2 move stsdir setz stsmod ; .CALL JOBIOC: Cause IOC error ; T (arg): error code jobioc: setz sixbit /jobioc/ movei boj setz t constants variables ; Device status stssts: 22 ; RH of .STATUS value stsmod: 0 ; OPEN mode stshst: 0 ; local host stsdev: 0 ; device stsdir: 0 ; directory stsfn1: 0 ; first name stsfn2: 0 ; second name oargs:: ;; Arguments provided to initial OPEN, MLINK, DELETE or RENAME oxfn1: 0 ; OX... Second set of filenames ofn1: 0 ; O... First set of filenames ofn2: 0 odir: 0 odev: 0 oxfn2:: omode: 0 ; 18 bit open mode in right half oxdir: 0 optr: 0 ; String arguments if given. oxptr: 0 loargs==:.-oargs args:: ;; Arguments provided to subsequent calls xfn1:: ; RENMWO first file name acesptr:: ; ACCESS pointer iotptr:: ; IOT pointer calnam: 0 ; .CALL sixbit name calbts: 0 ; .CALL control bits callen: 0 ; .CALL argument count arg1: 0 ; .CALL arg 1 arg2: 0 ; .CALL arg 2 xfn2:: ; RENMWO second file name arg3: 0 ; .CALL arg 3 arg4: 0 ; .CALL arg 4 arg5: 0 ; .CALL arg 5 xptr:: ; RENMWO string argument arg6: 0 ; .CALL arg 6 largs==:.-args ffpage==:<.+1777>_-12 ; First free page end go