From 21896d5513cda3054e11b46a00303a7d01a4cab3 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Sat, 28 Jan 2017 20:40:51 +0100 Subject: [PATCH] FILE - Chaosnet file server. Also FILEI/FILEO. --- README.md | 1 + build/build.tcl | 9 + src/eak/file.2 | 257 ++ src/syseng/file.591 | 8585 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 8852 insertions(+) create mode 100755 src/eak/file.2 create mode 100755 src/syseng/file.591 diff --git a/README.md b/README.md index 28cc2cee..c0018c42 100644 --- a/README.md +++ b/README.md @@ -137,6 +137,7 @@ A list of [known ITS machines](doc/machines.md). - FCDEV, talk to LispM file server. - FDIR, fast directory listing. - FED, font editor. + - FILE, Chaosnet file server. - FIND, search for files. - FRETTY, display list of free TTYs. - FTPS, FTP Server. diff --git a/build/build.tcl b/build/build.tcl index 5ad6d4ff..a051b7f9 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -995,6 +995,15 @@ respond "*" ":midas sys1;ts charfc_sysen3;charfc\r" expect ":KILL" respond "*" ":link sys1;ts charfs,sys1;ts charfc\r" +# file +respond "*" ":midas device;chaos file_syseng;file\r" +expect ":KILL" + +# filei, fileo +respond "*" ":midas device;chaos filei_eak;file\r" +expect ":KILL" +respond "*" ":link device;chaos fileo,device;chaos filei\r" + # 11sim respond "*" ":midas /t sys1;ts pdp11_syseng;11sim\r" respond "end input with ^C" "45p==0\r" diff --git a/src/eak/file.2 b/src/eak/file.2 new file mode 100755 index 00000000..ab367faa --- /dev/null +++ b/src/eak/file.2 @@ -0,0 +1,257 @@ +;;; -*-MIDAS-*- + +title Simple chaosnet file server + +.insrt syseng;$call macro +.insrt eak;macros > +.insrt system;chsdef > + +r=:e+1 ; AC for LOSE +call=:pushj p, +return=:popj p, + +cnich==:1 ; Chaosnet input channel +cnoch==:2 ; Chaosnet output channel +hstch==:3 ; HOSTS2 disk channel +dskch==:4 ; file channel +errch==:5 ; for ERR: device + +; The offical contact name is "FILExx". + +var debug ; nonzero if debugging +var pktbuf(%cpmxw) ; packet buffer +lpdl==100 ; length of stack +var pdl(lpdl) ; stack + +go: move p,[-lpdl,,pdl-1] ; setup stack + move t,[jsr tsint] + movem t,42 ; Any IOC error means we should go away, + ; connection gone + .suset [.smask,,[%piioc]] + $call chaoso,[#cnich,#cnoch,#8] ; window size of 8 + jsp r,lose + + ;; zero packet for luck + setzm pktbuf+0 + move t,[pktbuf,,pktbuf+1] + blt t,pktbuf+%cpmxw-1 + + ;; Construct and send the LSN packet. + + movei t,%colsn ; opcode = LSN + dpb t,[pktbuf+$cpkop] + move t,[.byte 8 ? "F ? "I ? "L ? "E ] + movem t,pktbuf+%cpkdt+0 + move t,[.byte 8 ? "I ] + camn 0,[sixbit /fileo/] + move t,[.byte 8 ? "O ] + movem t,pktbuf+%cpkdt+1 + movei t,5 + dpb t,[pktbuf+$cpknb] + .call pktiot + jsp r,lose + + ;; Wait for the RFC to come. + + movei a,5*30. ; 5 second timeout + skipe debug + movsi a,177777 ; or infinite if debug mode + $call netblk,[#cnoch,#%cslsn,a][b] ; wait for RFC + jsp r,lose + caie b,%csrfc ; RFC received state + jsp r,lose + + ;; Read RFC. + + $call pktiot,[#cnich,#pktbuf] ; read RFC packet + jsp r,lose + ldb e,[pktbuf+$cpknb] ; no. of data bytes + caig e,6 ; if more than 6 then we have an argument + jrst [ move a,[440700,,[asciz "No filename specified."]] + jrst cls2 + ] + + ;; Convert 8 bit argument to 7 bit ASCIZ + +var fname(8) + move a,[241000,,pktbuf+%cpkdt+1] + move b,[440700,,fname] + subi e,6 +l1: ildb t1,a + idpb t1,b + sojg e,l1 + movei t1,0 + idpb t1,b + + ;; Parse argument as filename. + +var fsix(4) + move t,[sixbit /dsk/] + movem t,fsix+0 + move t,[sixbit />/] + movem t,fsix+2 + movei b,fsix + move d,[440700,,fname] + call rfn"rfn + + camn 0,[sixbit /fileo/] + jrst fileo + +filei: ;; Open file. + + $call open,[#dskch,fsix+0,fsix+1,fsix+2,fsix+3][?a][#.uai] + jrst cls + + ;; Open connection. + + call opn + + ;; Copy data from file to connection. + + movei t,%codat ; opcode = DAT + dpb t,[pktbuf+$cpkop] +filei1: move a,[441000,,pktbuf+%cpkdt] + movei b,%cpmxc + $call siot,[#dskch,a,b][?a] + jrst cls + ;; should convert to LM ascii here. + movei t,%cpmxc + sub t,b + jumpe t,filei2 + dpb t,[pktbuf+$cpknb] + .call pktiot + jsp r,lose + jumpe b,filei1 +filei2: + + ;; Transfer complete. Close file, EOF connection. + + .close dskch, + movei t,0 + dpb t,[pktbuf+$cpknb] + movei t,%coeof + dpb t,[pktbuf+$cpkop] + .call pktiot + jsp r,lose + $call finish,[#cnoch] ; wait for data and EOF to get sent + jsp r,lose + + ;; Close connection. + + movei t,%cocls + dpb t,[pktbuf+$cpkop] + .call pktiot + jsp r,lose + jrst logout + + +fileo: ;; Open file. + + $call open,[#dskch,fsix+0,[sixbit/_FILE_/],[sixbit/OUTPUT/],fsix+3][?a][#.uao] + jrst cls + + ;; Open connection. + + call opn + + ;; Copy chaosnet data to file. + +fileo1: $call pktiot,[#cnich,#pktbuf] + fileo3 + ldb t,[pktbuf+$cpkop] + caie t,%codat + jrst fileo2 + move a,[441000,,pktbuf+%cpkdt] + ldb b,[pktbuf+$cpknb] + ;; should convert to LM ascii here. + $call siot,[#dskch,a,b][?a] + jrst cls + jrst fileo1 +fileo2: caie t,%coeof + jrst fileo3 + $call renwo,[#dskch,fsix+1,fsix+2] + jsp r,lose + .close dskch, + +fileo3: ;; Close connection. + + movei t,%cocls + dpb t,[pktbuf+$cpkop] + .call pktiot + jsp r,lose + jrst logout + + +opn: movei t,0 + dpb t,[pktbuf+$cpknb] + movei t,%coopn ; opcode = OPN + dpb t,[pktbuf+$cpkop] + .call pktiot + jsp r,lose + return + +;;; Here with error code in A. +cls: movei c,0 + $call open,[#errch,[sixbit /err/],#4,a] + jrst cls1 + move a,[441000,,pktbuf+%cpkdt] + movei b,%cpmxc + $call siot,[#errch,a,b] + jsp r,lose + movei c,%cpmxc-3 ; -3 to remove for CRLF ^L + sub c,b + jumpge c,.+2 + movei c,0 + .close errch, +cls1: dpb c,[pktbuf+$cpknb] + movei t,%cocls + dpb t,[pktbuf+$cpkop] + .call pktiot + jsp r,lose + jrst logout + +;;; Here with B.P. to ASCIZ error in A. +cls2: move b,[441000,,pktbuf+%cpkdt] + movei c,0 +cls3: ildb t,a + jumpe t,cls1 + idpb t,b + aoja c,cls3 + + +; JSP R,LOSE to lose. +lose: skipn debug ; don't lose if not debugging + .logout 1, ; just go away mad + $call lose,[#%lssys,#-2(r)] ; lose! + + +; IOC error interrupts to here +tsint: 0 ? 0 + .logout + .value + jrst .-2 + +; JRST LOGOUT when done. +logout: skipe debug ; don't go away if debugging + .value + .logout 1, + + +pktiot: setz + sixbit /pktiot/ + 1000,,cnoch + 401000,,pktbuf + + +$$rfn==1 +.insrt syseng;rfn + +rsixtp: return ; no filename terminators + + constants + variables + +loc <.+1777>&776000 +hstpag==:./2000 + +end go diff --git a/src/syseng/file.591 b/src/syseng/file.591 new file mode 100755 index 00000000..fd48b89a --- /dev/null +++ b/src/syseng/file.591 @@ -0,0 +1,8585 @@ +;;; -*- Mode: MIDAS -*- + +;;; PDP-10 Chaosnet file server + +;;; The source file for this program is kept in the following places +;;; on the MIT Chaosnet: +;;; +;;; AI: SYSENG; FILE > +;;; OZ:SS:FILE.MID +;;; SCRC:FILE.MID +;;; SPEECH:SSY:FILE.MID +;;; XX:SRC:FILE.MID +;;; +;;; Send mail regarding this program to BUG-FILE at MIT-MC + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; **** +;; **** Changes that have been made: +;; **** +;; +;; Wednesday, 21 July 1982 --Gren +;; +;; If OPEN/DELETE/RENAME/CHANGE-PROPERTIES fails for access +;; violation, will try and CONNECT no password then try again +;; (see TRYCON - Must immediately proceed the failing JSYS). +;; +;; Conditionally assembling the Chaosnet-user-Capability checking, +;; since you could always just login as Anonymous, which has it. +;; See the $$CCUC +;; +;; Make a DIRECTORY command not return ?NO FILES MATCH THIS +;; SPECIFICATION as an error, but just give an empty list. +;; +;; Thursday, 29 July 1982 --Gren +;; +;; Make GTJFN errors "NO SUCH FILENAME", "NO SUCH FILE TYPE", and +;; "NO SUCH VERSION NUMBER" come back as FNF, but with the original +;; error text. +;; +;; If you get auto-CONNECTed to a directory, you will disconnect +;; back to your home dir after done with whatever file. See the +;; CNCTED flag. +;; +;; Noticed this was already done (taken from SHOULD list): +;; +;; "COMRFO should quote embedded spaces, colons, semicolons, ideally." +;; +;; Friday, 30 July 1982 --Gren +;; +;; Instead of hassling you about logging in all the time, you will +;; be logged in as ANONYMOUS if it all possible, and only pestered +;; if it can't be done. The LOGIN command then does the same as an +;; ACCESS +;; +;; Wednesday, 4 August 1982 --Gren +;; +;; Better yet than just logging you in as ANONYMOUS by default, it +;; tries to log you in as , and only if that fails does +;; it try ANONYMOUS. The directory also has files of the form +;; hostname.PASSWORD, which are analagous to ANONYMOUS.USERFILE. +;; Note that these dirs have NOT-TTY-LOGINABLE set, so only the +;; FILE server or other detached creatures can use them. You may +;; not explicitly give a N-T-L account with LOGIN - It is rejected. +;; +;; "COMPFN should become more robust." - I poked at it some. Looks +;; fine to me. Have yet to try it out tho. +;; +;; In COMPFN, FN2 now defaults to ">" (it was left 0 before, and +;; would choke). +;; +;; Saturday, 21 August 1982 --Gren +;; Make the DIRECTORY command default FN1 and FN2 to "*" so that +;; just saying "DIR" or "DIR FOO" will work. +;; +;; +;; Monday, 23 August 1982 --Gren +;; Added support for SUBMIT OPEN option, conditionalized with the +;; $$SUBM flag. +;; +;; Tuesday, 14 September 1982 --Gren +;; Response to an OPEN is now: +;; ... QFASLPCHARACTERP"writer" ... +;; where "writer" is the last writer of the file, in Lisp-READable +;; format, with "'s and /'s quoted. +;; +;; Thursday, 16 September 1982 --Gren +;; Fixed some of the COMPLETE code so it wouldn't blow up and +;; cause the program to die horribly, and merged in Moon's time +;; fixes. +;; +;; 9/20/82 Moon Merged Gren's version and the Symbolics version +;; into one +;; +;; Monday, 27 September 1982 --Gren +;; Added support for ENABLE-CAPABILITIES. +;; +;; 9/27/82 Moon Fix bugs in cross-device/directory rename checking on +;; ITS. Make CWD and ENABLE-CAPABILITIES work on Tenex +;; Fix command name comparison so CREATE-LINK is not +;; mis-parsed as CREATE-DIRECTORY +;; Add CREATE-LINK command for ITS +;; +;; Saturday, 2 October 1982 --Gren +;; Have ENABLE/DISABLE commands take arguments of which privs to +;; toggle (currently only WHEEL, OPERATOR, or ALL), and have both +;; return the state of your privs as ... +;; +;; 10/9/82 Moon Send new standard 3-letter error codes +;; Put error messages in upper and lower case +;; Include disk free space in directory list, for Tenex +;; (TOPS-20 should probably do it the way ITS does) +;; +;; Sunday, 10 October 1982 --Gren +;; Scrapped assorted experimental OZ things, put in some 20X +;; directory space listing stuff. +;; +;; Tuesday, 12 October 1982 --Gren +;; Doing SETNMs now for clarity's sake, added NLI LispM suicide +;; timout code, and conditionalized logging of activity, for +;; debugging porpoises ($$LOG). +;; +;; Thursday, 14 October 1982 --Gren +;; TWENEX returns freespace for all structures in directory stream +;; as STRUCTURE1:free1 STRUCTURE2:free2 ... +;; +;; Friday, 15 October 1982 --Gren +;; Conditionized out suicide stuff for now, since there don't seem +;; to be any interrupt channels to do it on, and it's no solution +;; anyway. $$SUE +;; +;; 18 Oct 82 Moon +;; Made it work again for ITS +;; Added INHIBIT-LINKS option for OPEN (ignored by systems without links) +;; Made OPEN options 10 characters instead of 5 +;; IFN 0'ed GTDAL in 20X directory header, commented why +;; Got upset stomach from reading code in mixed case +;; Fixed ITS error messages +;; +;; Tuesday, 19 October 1982 --Gren +;; Put back in fixed GTDAL, Meta-C'd entire buffer. +;; +;; 10/21/82 Moon +;; Fix IOC errors to send proper 3-letter code. +;; Fix ITS error messages which I broke on 18 Oct. +;; Remodularize the error-message code to be more host-independent +;; +;; 10/26/82 MT +;; For 20X rel 5: use FB%NDL instead of FB%UND, if it's defined. +;; +;; Thursday, 28 October 1982 --Gren +;; Get writes to a specific version of a file go through a scratch +;; file, so there is no chance of clobbering the old copy. +;; +;; Saturday, 30 October 1982 --Gren +;; Try to DWIM if you DIRECTORY a without the *'s. +;; +;; Monday, 1 November 1982 --Gren +;; Put the directory-listing stuff on a separate GTJFN routine +;; (COMGDJ - uses Long Form) to avoid that DWIM kludge. +;; +;; Tuesday, 9 November 1982 --Gren +;; Change all ERJMP JSYSER's to ERCAL JSYSER's and include the +;; address of JSYS error along with the error string. JSYSER +;; should only be called via ERCAL since it expects TOS to be +;; the PC and such. If you want to do like JRST JSYSER, JRST +;; to COMFER instead. [Inoperative!] +;; +;; Saturday, 13 November 1982 --Gren +;; Switch file-overwriting back to the old catch-OPNX27-error +;; scheme, make sure JFNs released when erroring, fix delete/ +;; temporary-file dual usage of DATRFJ. Ran out of usable bits +;; in DATSTA LH! +;; +;; Monday, 15 November 1982 --Ian +;; Various bug fixes having to do with when to release leftover +;; JFNs (now only done at close time). Returning number-of- +;; LM-characters-received on a CLOSE reply. No more $$SUE. +;; +;; Tuesday, 16 November 1982 --Ian +;; Centralized most of the Closing/Releasing of JFNs at RELDJF +;; and RELRJF +;; +;; 11/17/82 Moon -- fixed bugs I noticed +;; $$LOG should not be on by default +;; NOTNEW was not always initialized before calling COMGJF/COMGJG +;; COMOPN needs to release any JFNs held even if ST.ACT is not set +;; TRYCON thought A was 1 and also broke ERCAL +;; RLJFN fails if the JFN is open, so try CLOSF and RLJFN both +;; Fix errors in TNX/ITS conditionalization, Tenex timebombs +;; Use BUG 3-letter code for all unexpected errors +;; Make SYSBUG bug-tracing message not be as mysterious to users +;; +;; 11/19/82 Moon +;; Fix TRYCON more. +;; Don't call RELDJF when not supposed to, at CNGERR +;; +;; 12/1/82 Moon +;; If closing in abort mode, set CZ%ABT to suppress generation-retention-count +;; Send an async mark if data packet discarded for any reason +;; Send OPEN reply only after all done, in case interrupt accidentally +;; left enabled, so data packets don't arrive early (especially +;; when transaction-logging is turned on, making COMSND slow) +;; +;; 12/4/82 Moon +;; Fix clobbering of error code introduced by centralized closing of JFNS +;; +;; (some time) Gren (I assume) +;; OZ INQUIR data base has user groups +;; Default version for directory to * when user is not a Lisp machine +;; (unfortunately this was done in such a way that it can only work on OZ) +;; +;; 12/29/82 Moon +;; Recognize BIN files +;; Remove timebombs put in by previous modification +;; +;; 1/5/83 Moon +;; Put more wheel/operator capability required 20X error codes into ERRTAB +;; +;; 2/15/83 Moon +;; Revise error reporting. Include octal PC for all file-system bugs. +;; Normal expected errors from the file system are reported +;; via PUSHJ P,FILERR (on 10X/20X this is ERCAL JSYSER or PUSHJ P,JSYSER +;; usually, however JSYSER and FILERR are the same). +;; For ITS, ERRCOD must have been set up (via .CALL error return value) +;; PUSHJ P,SYSBUG is used for unexpected errors from the file system. +;; In DEBUG mode, even non-bug error messages include the octal PC. +;; You can also patch the JRST at BUGPAT to a JFCL to get this. +;; Also fix commands that use IDX without initializing it. +;; +;; 5/18/83 Moon v.508 +;; Probe opening allowed for files that are off-line on Twenex +;; +;; Monday, 23 May 1983 --Ian +;; Fix another case for directory-empty: GJFX19 (No such file type) +;; is what you get if you directory "*.BAR" and there are no matching +;; files. +;; +;; 5 June 1983 Moon +;; Tops-20 needs to access other structure in COMPLETE command +;; +;; Wednesday, 8 June 1983 CSTACY +;; Fix INQUIR kludges, use proper LSRTNS routines. +;; +;; 9 June 83 Moon v.514 +;; ACCCHK in COMPLETE command for Tops-20 +;; +;; 14 June 83 Moon v.515 +;; Do ACCESS to foreign structures once, at login time, instead +;; of all over the place. This avoids the problem that there were +;; lots of places that forgot to call ACCCHK. +;; +;; 16 June 83 Moon v.516 +;; Return truenames from RENAME command (not finished for ITS yet) +;; +;; 13 July 83 Moon v.519 +;; Don't return bogus file dates from ITS files that have never +;; been referenced. +;; More ACCESS/CONNECT fixes for Twenex +;; +;; 19 July 1983, GZ, v.519 +;; Process LOGICALS.CMD on login, under $$LNM switch (off except on OZ). +;; +;; 19 July 83 Moon v.520 +;; Merge my changes and GZ's changes +;; EXPUNGE command ignored by ITS +;; DELETED open option ignored by ITS +;; HOMEDIR, FILE-SYSTEM-INFO commands +;; Directory of FOO > on ITS matches only files with all-numeric FN2 +;; +;; 23 August 83 Ian / Moon v.524 +;; Missing ERCAL after RCDIR in EXPUNGE command +;; +;; Sunday, 4 September 1983 --Ian (524) +;; COMPFN defaults FN2 to ">" if STARF2/ 0 else "*" (for the sake +;; of directory listings) +;; +;; 9/6/83 Moon v.526 +;; New OPEN options: ESTIMATED-LENGTH, PROBE-DIRECTORY, +;; IF-EXISTS, IF-DOES-NOT-EXIST (except for rename and rename-and-delete) +;; For ITS, the latter two aren't implemented yet +;; +;; 9 September 1983 --Ian (527,531) +;; Fixed 20X EXPUNGE not to need filename and to handle +;; wildcarded directories; Fix EXPUNGE code which somehow +;; reverted to a non-working test version (11-Sep) +;; +;; 9/12/83 Moon +;; Put back kludges needed to make EXPUNGE work on Tenex +;; +;; 9/19/83 Marty v533 +;; Turned on $$LNM for all Top-20 versions. +;; +;; 9/23/83 Moon v.534 +;; SFUSX6 gives a CSP error (mainly of use for Tenex) +;; Undefined 10X/20X error codes don't give a blank error message! +;; +;; 3 October 1983 --Ian +;; OZ Inquire support. +;; +;; 10/21/83 Moon +;; Add IF-EXISTS TRUNCATE (sets file length but doesn't return disk pages!) +;; Replace DATDEL, DATRFJ, and ST.OVW with DATDSP, to implement +;; IF-EXISTS RENAME and IF-EXISTS RENAME-AND-DELETE +;; Don't send bogus months in dates (can exist in ITS dates sometimes) +;; Still can send bogus days, though, but I think that's okay for +;; the moment. Dates should really be transmitted as universal times. +;; IF-EXISTS, IF-DOES-NOT-EXIST still not implemented for ITS +;; +;; 10/27/83 Moon v.543 +;; Merge SCRC and OZ versions +;; Fix typo in HOMEDIR command when no Inquir entry found +;; +;; 10/31/83 Moon v.545 +;; Ian's changes of 3 October broke users not registered in INQUIR on OZ +;; Ian's changes since last assembled on ITS broke ITS assembly +;; +;; 11/28/83 Moon v.547 +;; PROBE-DIRECTORY bugs: release JFN, return truename, work on TOPS-20 +;; +;; 12/06/83 Marty v. 546 (v. 548) +;; Make Tops-20 abort all open connections upon logout. +;; +;; 12/13/83 Moon v.549 +;; Code was all scrambled in EXPUNGE command somehow +;; +;; 12/21/83 Moon v.551 +;; IF-EXISTS SUPERSEDE ignored on ITS since system 243.369 sends it +;; Real implementation of IF-EXISTS, IF-DOES-NOT-EXIST for ITS still not done +;; +;; 1/4/84 Moon v.555 +;; PROPERTIES command +;; +;; 1/16/84 Moon v.556 +;; Merge the following changes from UTexas +;; +;; 12/13/83 C.Dawson (UTexas) v. 10547 +;; Fix lossage when number of structures on system is exactly +;; equal to monitor's STRN. In this case, the GETAB table will +;; NOT contain a structure named STRnnn, and this can't be checked +;; for loop termination. +;; +;; 12/13/83 B. Brown (UTexas) v. 20547 +;; Set session remark to "CHAOS SERVER" at startup. Useful for +;; Exec's who discriminate among various flavors of detached jobs. +;; +;; 1/29/84 Moon v.557 +;; Lisp machine has gotten more picky about only accepting well-formed +;; dates, so put in more checks for bogus dates in date printer. +;; +;; 2/21/84 Moon v.558 +;; Allow superseding a Tops-20 offline or archived file +;; +;; 20 June 1984 --Ian +;; For OZ, make the session-remark "CHAOS SERVER hostname" so FINGER +;; can show it. +;; +;; Monday, 9 July 1984, CJL +;; For TWENEX, If the RETENA is nonzero, for opens that would normally +;; bomb out will "File is off-line", a file retrieval is automatically +;; run, and the open is retried. For OZ, RETENA is set to -1. +;; Someday I hope there will be some way to change the value of RETENA +;; so this feature can be enabled and disabled at runtime. Insrts also +;; to LIB: instead of SYSTEM:, on OZ +;; +;; 9/7/84 MMcM v.567 +;; :CHARACTERS :DEFAULT re-OPENF should respect PRESERVE-DATES. +;; Anonymous and archive retrieval changes weren't properly conditionalized. +;; 19-Nov-84, GZ, v.568 +;; Adopt to hakinq library changes (OZ only). +;; Enable self at PURIFY so can dump file. +;; +;; 31 January 1985 --Ian v.569 +;; Set XUNAME on ITS to name logging in as, fixed accumulated +;; ITS-assembly problems. +;; +;; 23-Feb-85, GZ, v.570 +;; Add FILE-BYTE-SIZE open option on TNX +;; +;; 4/8/85, Alan, v.571 (ITS) +;; Set HSNAME on ITS. +;; +;; 5/02/85, CStacy (apparently), v.572 (ITS) +;; God only knows what he did. +;; +;; 20-May-86, COLE, v.571 (20X) (renamed v.573 after the fact on OZ) +;; FILE now computes byte size even when not in binary mode +;; +;; 2-July-86, SRA, v.574 +;; Make session remark hack work for XX, without all the host +;; table mapping crud fer gossake. Added XX conditional. +;; Make OZ and XX conditional IFNDEFs work in domainland. +;; Merge OZ, XX, AI versions together again. +;; +;; 5-Oct-86 JTW v.575 +;; Set file byte size only on BINARY WRITE operations (undo 571, +;; really). Fix incompatability with Symbolics Rel-7 which wants +;; to set character files to 8-bit bytes. +;; +;; 8-Dec-86 GLR v.576 +;; Make open for output return filelength if file is old +;; 8-Dec-86 GLR v.582 +;; hack filepos to work for output files -- this has timing screws in it +;; 8-Dec-86 GLR v.586 +;; increase NIMPUR -- so it compiles on ITS +;; +;; 12/19/86 Alan v.587 (ITS) +;; Fixed code in ITS directory creation that tried to assure that only +;; people with directories can create directories. I'll bet this is +;; what CStacy did in v.572. +;; +;; 6/2/88 Alan v.591 (20X) +;; Return .FBTP1 .FBSS1 .FBTP2 .FBSS2 file properties. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +IFNDEF ITS,[ +IFE .OSMID-SIXBIT/ITS/,ITS==1 +.ELSE ITS==0 +];IFNDEF ITS +IFNDEF 10X,[ +IFE .OSMID-SIXBIT/TENEX/,10X==1 +.ELSE 10X==0 +];IFNDEF 10X +IFNDEF 20X,[ +IFE .OSMID-SIXBIT/TWENEX/,20X==1 +.ELSE 20X==0 +];IFNDEF 20X +IFNDEF TNX, TNX==1-ITS + +IFN ITS, TITLE FILE JOB FOR ITS +IFN 20X, TITLE FILE JOB FOR TOPS-20 +IFN 10X, TITLE FILE JOB FOR TENEX + + +IFE <<-<.SITE >>*<-<.SITE >>>, OZ==1 +.ELSE OZ==0 + +IFN OZ, PRINTX /(OZ's munched on version) +/ + +IFE <<-<.SITE >>*<-<.SITE >>>, XX==1 +.ELSE XX==0 + +IFN XX, PRINTX /(XX'S slightly munched on version) +/ + +DEFINE INFORM A,B,C,D,E,F,G +PRINTX /A!B!C!D!E!F!G +/ +TERMIN + +DEFINE CONC A,B,C,D,E,F,G +A!B!C!D!E!F!G!TERMIN + +IFN ITS,[ +NIMPUR==2 ;Number of low impure pages (ran over by 1 word) +PURBEG==NIMPUR*2000 +] ;END IFN ITS +IFN TNX,[ +.DECSAV +NIMPUR==4 ;Number of low impure pages +PURBEG==NIMPUR*1000 +JOBSYM=116 ;Pointer to symbol table, in our own core +NSYMPG==3 ;Number of pages left for symbol table +IFN OZ,[ +NSYMPG==4 ;doesn't quite fit otherwise +IPAGE==400 ;map in inquire database here +];End OZ +];END IFN TNX + +;AC definitions +F=0 ;FLAGS ET AL. + +;;; AC's 1 thru 3 (and sometimes 4) are used for Tops-20 JSYS' +;;; On Tenex, the GETER JSYS will smash AC's 4-10 as well. + +T=4 ;SUPER TEMPORARIES +TT=5 + +A=6 ;NOT SO SUPER TEMPORARIES, BUT FOR GENERAL USE +B=7 +C=10 +D=11 + +IDX=12 ;INDEX INTO TABLES POINTING TO FILE CURRENTLY BEING HACKED + ; LOW ORDER BIT 0=INPUT, 1=OUTPUT +BP=13 ;POINTER INTO PACKET +BYTE=14 ;CURRENT BYTE BEING HACKED +FHN=15 ;CURRENT FILE HANDLE +BC=16 ;BYTE COUNT REMAINING IN CONTROL PACKET + +P=17 ;PDL POINTER, OF COURSE (THIS BETTER BE 17 FOR TOPS-20) + +IFN ITS,[ +;Get CHAOS definitions +.INSRT SYSTEM;CHSDEF +] ;END IFN ITS + +IFN 20X,[ + LOC 140 +IFE OZ\XX,[ +.INSRT SYSTEM:CHSDEF +];NOT OZ\XX +IFN OZ\XX,[ +.INSRT MID:CHSDEF +];OZ\XX +] ;END IFN 20X + +IFN 10X,[ + LOC 140 +.INSRT FILDEF +] ;END IFN 10X + +%CPMXW== 126. ;Note: we want max over ALL systems here ... +%CPMXC== 488. + +;IFNDEF CHPMXW, CHPMXW==%CPMXW-%CPKDT +;IFNDEF CHPMXC, CHPMXC==%CPMXC + +;; Flag bits +F.FHN==:1_0 ;IF SET THERE WAS A VALID FILE HANDLE IN THE CONTROL REQUEST +F.NWL==:1_1 ;COMEUS HAS SEEN A NEWLINE +F.PRB==:1_2 ;DOING A PROBE +F.QFP==:1_3 ;QFASLP +F.FN1==:1_4 ;Guess.... +F.FN2==:1_5 +F.DEV==:1_6 +F.DIR==:1_7 +IFN TNX,[ +F.SPAC==:1_8 ;A space has been seen while building error code +F.NRJ==:1_9 ;Don't release JFN in CLOSIT +F.ENA==:1_10. ;Enable after login +] ;END IFN TNX +F.DEF==:1_11. ;:CHARACTERS :DEFAULT +IFN OZ,[ +F.LSP==:1_12. ;Coming from a LispMachine +];OZ +F.PDR==:1_13. ;PROBE-DIRECTORY + +;; Flag bits in LH(F) controlling file creation options for OPEN +F.CRE==:1_18. ;Create file if does not exist (for overwrite/append) +F.SUP==:1_19. ;Supersede even if ask for newest version +F.APP==:1_20. ;Append to file +F.OVW==:1_21. ;Overwrite file +F.NEW==:1_22. ;File must be new, error if already exists +F.REN==:1_23. ;Rename existing file +F.RND==:1_24. ;Rename and delete existing file +F.TRU==:1_25. ;Truncate existing file and overwrite + +IFN ITS,[ + +DEFINE SYSCAL OP,ARGS + .CALL [SETZ ? SIXBIT /OP/ ? ARGS ((SETZ))] +TERMIN + +;; I/O CHANNELS +UTILCH==0 ;UTILITY CHANNEL: PROBES, TTY + +;;; The CHAOS channels must be contiguous +CTRLI==1 ;CONTROL CONNECTION INPUT +CTRLO==2 ;CONTROL CONNECTION OUTPUT + +ERRCH==17 ;Error channel + +;; REMAINING CHANNELS FOR USE FOR REAL I/O +;; GROUP 1: +;; 3, DATA CONNECTION IN. 4, DATA CONNECTION OUT +;; 11, INPUT FILE. 12, OUTPUT FILE + +;; GROUP 2: +;; 5, DATA CONNECTION IN. 6, DATA CONNECTION OUT +;; 13, INPUT FILE. 14, OUTPUT FILE + +;; GROUP 3: +;; 7, DATA CONNECTION IN. 10, DATA CONNECTION OUT +;; 15, INPUT FILE. 16, OUTPUT FILE + +;; EXTRA ENTRY FOR PROBING + +CHACHN: 3 ? 4 ? 5 ? 6 ? 7 ? 10 ? -1 + +CHALOW==:1 +CHAHIG==:10 + +CHABIT: 10 ? 20 ? 40 ? 100 ? 200 ? 400 + +DATCHN: 11 ? 12 ? 13 ? 14 ? 15 ? 16 ? UTILCH + +MAXIDX==6 ;NUMBER OF INFORMATION CHANNELS. N/2 INPUT, N/2 OUTPUT + ;LOW ORDER BIT 0=INPUT, 1=OUTPUT +] ;END IFN ITS + +IFN TNX,[ +GDACC= ;Gotta add this to MIDAS's symbol table. + +PRILE1: 0 ;Three locations for storage of old PC at interrupt time +PRILE2: 0 +PRILE3: 0 + +LV1ACS: BLOCK 20 ;Room for the ACs +LV1SAC: 0 ;Routine to be JSR'ed to to save AC's at level 1 + MOVEM 0,LV1ACS + MOVE 0,[1,,LV1ACS+1] + BLT 0,LV1ACS+17 + MOVE 0,LV1ACS + JRST @LV1SAC + +MAXIDX==16. + +CHABIT: IRPS BITPOS,,[0,1,2,3,4,5,23,24,25,26,27,28,29,30,31,32,33] + 1_<35.-BITPOS!.> + TERMIN + +CHAICN: 0,,1 + 2,,3 + 4,,5 + 23.,,24. + 25.,,26. + 27.,,28. + 29.,,30. + 31.,,32. + 33.,,33. + ;; Channels 34. and 35. are reserved by monitor for toplevel job! + +CHAJFN: BLOCK MAXIDX+1 +] ;END IFN TNX + +;;; Impure tables + +;;; Per data-connection tables + +DATFHN: BLOCK MAXIDX+1 ;File handle +DATSTA: BLOCK MAXIDX+1 ;Status +DATBYT: BLOCK MAXIDX+1 ;Byte-size +DATBPW: BLOCK MAXIDX+1 ;Bytes per word +DATBUF: BLOCK MAXIDX+1 ;Buffer +DATBPT: BLOCK MAXIDX+1 ;Buffer pointer +DATBCT: BLOCK MAXIDX+1 ;Buffer count +DATIOC: BLOCK MAXIDX+1 ;Storage over IOC errors +DATLEN: BLOCK MAXIDX+1 ;File bytes remaining (Text) +DATRCV: BLOCK MAXIDX+1 ;LM bytes received (Text) +DATSYA: BLOCK MAXIDX+1 ;Synch mark routine +DATSYN: BLOCK MAXIDX+1 ;Synch mark routine arg +DATLWD: BLOCK MAXIDX+1 ;Last word +DATICN: BLOCK MAXIDX+1 ;IOC error continuation address +IFN ITS,[ +DATDEV: BLOCK MAXIDX+1 ;Device +DATFN1: BLOCK MAXIDX+1 ;First filename +DATFN2: BLOCK MAXIDX+1 ;Second filename +DATSNM: BLOCK MAXIDX+1 ;Sname (directory) +];ITS +IFN TNX,[ +DATJFN: BLOCK MAXIDX+1 ;JFN +DATDSP: BLOCK MAXIDX+1 ;Disposition of file when closed + ;RH is JFN of file being replaced + ;LH is flag bits: +DD.SUP==:1 ;Supersede old file by renaming to JFN in RH +DD.REN==:2 ;Rename old file, then rename new file +DD.RND==:4 ;Same as DD.REN, but delete old file too +DD.ABT==:10 ;Close in abort mode, delete the new file +DD.OPN==:20 ;File in RH is open (to lock it), remember to close it +DATFBS: BLOCK MAXIDX+1 ;File byte size +];TNX + +;Status contains: +ST%CLO==:0 ;Closed state (initial state) +ST%OPN==:1 ;Open state +ST%ASY==:2 ;Asynchronous marked state +ST%SYN==:3 ;Synchronous marked state +ST%EOF==:4 ;Eof state + + +ST.SYN==:(1_22) ;Synchronous mark (expected, on input; needed, on output) +ST.BIN==:(1_23) ;Binary mode +ST.UNC==:(1_24) ;The last asynchronous error is uncontinuable +ST.DEL==:(1_25) ;Deleted files are ok +IFN TNX,[ +ST.TEM==:(1_26) ;Temporary file +] ;END IFN TNX +ST.OUT==:(1_27) ;COMGJF wants file for output +ST.RAW==:(1_30) ;Raw: no character translation whatsoever +ST.SUI==:(1_31) ;Super-image: don't treat rubouts specially +ST.DIR==:(1_32) ;This channel is in use for directory hackery +ST.ACT==:(1_43) ;This channel is active (sign bit!) +IFN TNX,[ +ST.PON==:(1_33) ;COMGJF should do parse only +];TNX +ST.NOK==:(1_34) ;New file ok for completion, also used by COMPR4 +ST.FST==:(1_35) ;Fast directory listing option +ST.ALD==:(1_36) ;Directories only listing option (ALL-DIRECTORIES) +ST.PDT==:(1_37) ;Don't update access dates, etc. +ST.SUB==:(1_40) ;Submit this file as batch +ST.PRO==:(1_40) ;Doing PROPERTIES rather than DIRECTORY (same as ST.SUB!!) +ST.INL==:(1_41) ;Inhibit links +IFN 20X,[ +ST.RET==:(1_42) ;WE RETRIEVED THIS FILE +];20X + +;Opcodes: +CO%SYN==:%CODAT+1 ;Synchronous mark +CO%ASY==:%CODAT+2 ;Asynchronous mark +CO%NOT==:%CODAT+3 ;Notification +CO%BDT==:%CODAT\100 ;Binary data +CO%TXT==:%CODAT ;Text opcode +CO%EOF==:%COEOF ;EOF opcode + +%CLEND==400000 + +; Packets +CTLPKI: BLOCK %CPMXW ;control in +CTLPKO: BLOCK %CPMXW ;control out +REAPKT: BLOCK %CPMXW +WRIPKT: BLOCK %CPMXW +ASYPKT: BLOCK %CPMXW + +;;; Random impure data +DEBUG: 0 ;-1 if debugging, +1 means dump ourselves if error (-20 only) + ;Set to zero if you purify, unless you change that +CHPMXW: %CPMXW-%CPKDT ; Left as-is for ITS, but adjusted for TOPS-20 +CHPMXC: %CPMXC + +IFN TNX,[ +IFE OZ\XX,[ +IFNDEF $$SUBM, $$SUBM==1 ;Allowing people to SUBMIT files to us? +IFNDEF $$CCUC, $$CCUC==1 ;Check Chaosnet-User-Capability? +IFNDEF $$LOG, $$LOG==0 ;Write log files +IFNDEF $$LNM, $$LNM==0 ;Parse logical-name definitions file at login time +];Not OZ\XX +IFN OZ\XX,[ +IFNDEF $$SUBM, $$SUBM==1 +IFNDEF $$CCUC, $$CCUC==0 +IFNDEF $$LOG, $$LOG==0 +IFNDEF $$LNM, $$LNM==0 +];OZ\XX + +ANONUM: 0 ;ANONYMOUS's user# + +IFN 20X,[ +DEVDEG: 0 ;[UTexas] for saving device designator +STRNAM: BLOCK 5 ;For converting sixbit structures to ascii +CNCTED: 0 ;are you foreignly connected? +CONFNM: BLOCK 10. ;Made by JFNS (for trying to CONNECT) +RETENA: 0 ;AUTOMATIC FILE RETRIEVALS ENABLED? +$$LNM==1 ;Process LOGICALS.CMD on login? +];20X + +IFNDEF .SFCHA,$$CCUC==0 ;Only if MIDAS knows about Chaos capability do we care +IFE 20X,$$CCUC==0 ;No chaos checking on 10X +IFE 20X,$$SUBM==0 ;Or batch (of QUASAR sort) + +IF1,[ +IFN $$SUBM, INFORM Ability to submit batch jobs included +IFN $$CCUC, INFORM Checking of chaosnet-user capability included +IFN $$LOG, INFORM Log-file writing included +IFN $$LNM, INFORM Reading of LOGICALS.CMD file included +];IF1 + +TMPFIL: BLOCK 20 ;Temporary filename, for overwriting. +DMPACS: BLOCK 20 ;Save ACs when we dump ourselves + +OZ$LOG==OZ*$$LOG +];TNX +IFE OZ,OZ$LOG==0 + +PDLEN==170 +PDL: -PDLEN,,.+1 ;Size carefully chosen to give 1K impure + BLOCK PDLEN +FHNOUT: BLOCK 1 ;WORD TO OUTPUT FILE HANDLE FROM + 0 +PTCVER: 0 ;Protocol version number +IFN ITS, MACNAM: 0 ;The machine we are on +CLODAT: 0 ;Temporary storage by CLOSE operation +CLOLEN: 0 +ERRCOD: 0 ;Error code returned by .CALL OPEN +SYSBGF: 0 ;Flag set to force 3-letter code to BUG +ERRLEN==:100. +ERRBUF: BLOCK ERRLEN/5 +IFN ITS, SSYDF2: 0 ;Temporary storage of old DF2 word + +TRANID: 0 ;Transaction ID + 0 +PKTLOC: CTLPKO ;COMCTL (et al.) use this as packet address +USERID: 0 ;User ID, set by LOGIN. Must be non-zero to do OPEN's +DIRPDL: 0 ;Saved stack for unwinding directory output + +IFN ITS,[ +STARF2: 0 ;Non-0 want "*" for default FN2, else ">" +HSNAME: 0 ;User HSNAME, sets files' authors +DIRLCK: 0 ;Only one channel can use DIRBUF +WRITER: BLOCK 2 +] ;END IFN ITS +IFN TNX,[ +RESLEN==:200 +RESBLK: BLOCK RESLEN/5 +CTLJFN: 0 +WILDIR: 0 ;Temporary for EXPFNM +NOTNEW: 0 ;Flag for COMGJF - No GJ%NEW, please (ran out + ;of bits for doing this in DATSTA, foo) + ;0 => ST.OUT => GF%FOU and GJ%NEW + ;1 => no GJ%FOU + ;-1 => GJ%OLD (ignore ST.OUT) + +INQBLK: +GTJBLK: ;For long call GTJFN for completion +CRDBLK: ;Argument block for CRDIR +DIRINF: BLOCK 50 ;For GTDIR info (in LOGIN command) and GTFDB +JFNSTR: BLOCK 30. ;For building JFN's, 149 chars should be ok +INQBLL==.-INQBLK +USRNUM: BLOCK 1 +UDRNUM: BLOCK 1 ;Your home dir# +CWDNUM: BLOCK 1 ;dir# you have explicitly connected to +DWNTIM: BLOCK 1 +IFN 10X, BLOCK 1 +TIMINF: BLOCK 1 +SAVEBP: BLOCK 1 +WRITER: BLOCK 40./5 + +JFNBLK: .GJDEF ;Can be changed to .GJALL later + .NULIO,,.NULIO + 0 ;Connected structure + 0 ;Connected directory + -1,,[Ascii /*/] ;Default FILENAME, + -1,,[Ascii /*/] ;EXTENSION, + 0 ;Default protection, + 0 ;and account. + 0 ;Not used (.GJJFN) + +IFN $$SUBM,[ +.QOCQE==37 +.QCFIL==10 +.QCQUE==24 +.OTBAT==4 + +QUTILB: .MURSP ;Get PID of... + .SPQSR ;QUASAR... +QSRPID: 0 ; + +MSendB: 0 ;Arg block for the SUBMIT MSEND +YerPID: 0 ;Your PID + 0 ;QUASAR's PID + 1000,,QSRPAG ;1 page from here (saved, then restored). +];$$SUBM + +IFN $$LNM,[ +strbsz==200. +strbuf: block strbsz/5 +atmbuf: block strbsz/5 + +cmdblk: 0,,lnm10 + 0,,.nulio ;.CMIOJ + 440700,,[0] ;.CMRTY - no prompt + 440700,,strbuf ;.CMBFP + 440700,,strbuf ;.CMPTR + strbsz ;.CMCNT + strbsz ;.CMINC + 440700,,atmbuf ;.CMABP + strbsz ;.CMABC + 0 ;.CMGJB +];$$LNM + +IFN $$SUBM,[ +QPBLK: 0,,.QOCQE ;Create Queue Entry + 0 ? 0 ;Unused header words. + 0 ;Unused flag word + 2 ;Two arg blocks... + 2,,.QCQUE ;[#1] 2-word block: QUE type is... + .OTBAT ;BATCH + 0,,.QCFIL ;[#2] n word block... a filespec. + BLOCK 12. +];$$SUBM + +IFN OZ\XX,[ +KSITE: BLOCK 10. ;Your site, like /MIT-LISPM-12/ +Remark: Block 20. ;Session remark, "CHAOS SERVER " + KSITE +HostN: 0 ;Host number... hoo summoned us? +] + +IFN OZ,[ +GOTINQ: 0 ;Non-0 if have Inquire mapped in. +INQADR: 0 ;Address of user's Inquire entry (or 0 if none) +TimeOn: 0 ;Suicide TIMER is on. +DownpT: 0 ;System is going down, and channel 33 is in use. +LispMf: 0 ;Non-0 if connected from a LispM +LogJFN: 0 ;JFN for hangers-on log +IFN $$LOG,[ +TriJFN: 0 ;Trickle file JFN +Trikle: Block 20 ;Trickle filename +];$$LOG +];OZ +];END IFN TNX + +IMPLOC==. +LOC PURBEG + +;;; Pure tables +IFN ITS,[ +CTLOUT: SETZ + SIXBIT /PKTIOT/ + %CLIMM,,CTRLO + %CLIMM+%CLEND,,CTLPKO + +CTLINP: SETZ + SIXBIT /PKTIOT/ + %CLIMM,,CTRLI + %CLIMM+%CLEND,,CTLPKI +] ;END IFN ITS + +IFN OZ,[ ;NETWRK is pure code +.INSRT MID:MACROS + +HOSTSP==100 ;Map HOSTS2 at this page. +$$CHAOS==1 ;We only want chaosnet. +$$HSTMAP==1 ;Map/unmap file utils; +$$HOSTNM==1 +$$SYMLOOK==1 +NETWRK"E=IDX +IFN NETWRK"E-, .ERR NETWRK wants E to be D+1 +.INSRT MID:NETWRK + +%%T==T ? %%TT==TT ;HAKINQ expects AC4 to be available +T=C ? TT=D ;and since T=4, it loses very badly. +$$MAP==1 +$$READ==1 +$$XLATE==1 +$$NPNAME==1 +.INSRT MID:HAKINQ +T=%%T ? TT=%%TT +];OZ + +;;; Macros +DEFINE CERR CODE,TEXT + JSP D,COMERR + SKIPA + '!CODE,,[ASCIZ \F TEXT\] + TERMIN + +DEFINE AERR CONTIN,CODE,TEXT + JSP D,ASYERR + JRST .+3 + '!CODE,,[ASCIZ \F TEXT\] + CONTIN + TERMIN + +DEFINE IOCERR ADR + JSP D,ICCERR + SKIPA + ADR + TERMIN + +;;; Main program. Startup, initialization, control connection main loop + +FILE: +IFN ITS,SETZB F,DIRLCK +IFN TNX,SETZ F, + MOVE P,PDL +IFN ITS,[ + .SUSET [.ROPTION,,T] + TLO T,OPTINT\OPTOPC ;TURN ON NEW STYLE INTERRUPTS + .SUSET [.SOPTION,,T] + .SUSET [.SDF1,,[%PIDBG+%PIDWN]] ;DEFER SYS DOWN, SYS DEBUG + .SUSET [.SMASK,,[%PIIOC+%PIDBG+%PIDWN]] ;ENABLE INTERRUPTS + .CALL [ SETZ ;GET OUT MACHINE'S NAME + SIXBIT /SSTATU/ + MOVEM A ? MOVEM B ? MOVEM T ? MOVEM T ? MOVEM T + SETZM MACNAM] + .LOSE %LSSYS + SKIPLE A ;GET INITIAL HIT OF DOWN/DEBUG INTERRUPTS + .SUSET [.SIPIRQC,,[%PIDWN]] + SKIPE B + .SUSET [.SIPIRQC,,[%PIDBG]] + .CALL [ SETZ ;ASSIGN CHAOSNET CONTROL CHANNELS + SIXBIT /CHAOSO/ + %CLIMM,,CTRLI + %CLIMM,,CTRLO + %CLIMM,,5 ((SETZ))] + .LOGOUT 1, + MOVEI T,%COLSN ;LISTEN FOR OUR CONTACT NAME + DPB T,[CTLPKO+$CPKOP] + MOVE T,[.BYTE 8 ? "F ? "I ? "L ? "E] + MOVEM T,CTLPKO+%CPKDT + MOVEI T,4 + DPB T,[CTLPKO+$CPKNB] + .CALL CTLOUT ;OUTPUT THE LISTEN + .LOSE %LSSYS + MOVEI T,30.*30. ;30. SEC TIMEOUT + SKIPGE DEBUG ;UNLESS DEBUGGING + HRLOI T,177777 + .CALL [ SETZ ;WAIT FOR A RESPONSE OR TIMEOUT + SIXBIT /NETBLK/ + %CLIMM,,CTRLO + %CLIMM,,%CSLSN + T + SETZM TT] + .LOSE %LSSYS + CAIE TT,%CSRFC ;RFC RECEIVED? + .VALUE + .CALL CTLINP ;READ RFC PACKET + .LOSE %LSSYS + LDB T,[CTLPKI+$CPKOP] + CAIE T,%CORFC + .VALUE + MOVE P,PDL + PUSHJ P,CHKPVR ;CHECK PROTOCOL VERSION NUMBER + .VALUE ;ALREADY WILL HAVE SENT CLS IF NO GOOD + MOVEI T,%COOPN ;SEND OPN BACK + DPB T,[CTLPKO+$CPKOP] + .CALL CTLOUT + .LOSE %LSSYS + SKIPGE DEBUG ;DEBUGGING? + JRST CTLLOP ;YES, SO DON'T TRY TO LOGIN + LDB T,[$CPKSA CTLPKI] ;GET SOURCE HOST ADDRESS + MOVE TT,[SIXBIT /000C00/] ;CONVERT HOST NUMBER TO SIXBIT + DPB T,[220300,,TT] + LSH T,-3 + DPB T,[300300,,TT] + LSH T,-3 + DPB T,[360300,,TT] + .SUSET [.RUIND,,T] ;INCORPORATE USER INDEX ALSO + DPB T,[000300,,TT] + LSH T,-3 + DPB T,[060300,,TT] + LSH T,-3 + DPB T,[170100,,TT] ;C77 + 1 = K00 TO AVOID DUPLICATIONS + MOVE T,TT ;SAVE COPY FOR XUNAME + MOVEI A,100(TT) ;DON'T LOOP FOREVER, ONLY 100 TIMES +CHALS1: CAIN A,(TT) + .VALUE ;I DON'T THINK THIS CAN HAPPEN, BUT IT DOES ANYWAY + .CALL [SETZ + SIXBIT /LOGIN/ + TT ? [SIXBIT /CHAOS/] ? SETZ T] + AOJA TT,CHALS1 ;ERROR, PERHAPS NEED TO TRY OTHER UNAME + .SUSET [.SJNAME,,[SIXBIT /FILE/]] + .CALL [SETZ ? 'DETACH ? MOVEI %JSELF ? ANDI 3 ] + .LOSE %LSSYS ;MAKE SELF SYSTEM-DAEMON FOR FAST RESPONSE + +CTLLOP: MOVE P,PDL ;IN CASE OF ERROR, RESTORE PDL + SETZ F, ;CLEAR FLAGS + .SUSET [.SDF1,,[0]] ;ALLOW SYS DOWN, SYS DEBUG INTERRUPTS NOW + .CALL CTLINP ;GET NEXT CONTROL PACKET, HANG IF NECESSARY + .LOSE %LSSYS + .SUSET [.SDF1,,[%PIDBG+%PIDWN]] ;DEFER THESE INTS WHILE PROCESSING + LDB T,[CTLPKI+$CPKOP] + CAIL T,%CODAT ;THIS A DATA PACKET? + JRST COMMAN ;YES, OK, GO DO A COMMAND FROM IT + CAIE T,%COEOF ;LISP MACHINE WANT TO CLOSE THE CONNECTION? + JRST CTLLOP ;HMMM, BAD PACKET, IGNORE IT FOR NOW +CTLERR: +CTLDON: .LOGOUT 1, ;Go away immediately, do not RENMWO any output files +] ;END IFN ITS + +IFN TNX,[ + RESET ;Reset the Universe + MOVEI 1,.FHSLF ;Setup our interrupt vector + MOVE 2,[LEVTAB,,CHNTAB] + SIR + MOVEI 1,.FHSLF ;Turn on interrupt system + EIR + MOVEI 1,.FHSLF ;Enable interesting interrupts + MOVE 2,[000747,,000004] + AIC +IFN 20X,[ + MOVE 1,[SIXBIT /CHPMXT/] ; Get max packet size + SYSGT + TLNE 1,-1 + JRST [ MOVE 1,[SIXBIT /LHOSTN/] ; Old flavor monitor + SYSGT + CAIE 1,54 ; XX ? + SKIPA 1,300 ; no - size is 300 + MOVEI 1,488. ; yes - size is max + JRST .+1 ] + MOVEM 1,CHPMXC ; Set max # chars + LSH 1,-2 + MOVEM 1,CHPMXW ; Set max # words +] + MOVE 1,[SIXBIT /FILE/] +IFN 10X,SETNM +IFN 20X,[ + MOVE 2,1 + SETSN + JFCL +IFE OZ\XX,[ + SETO 1, ;THIS JOB + MOVEI 2,.SJSRM ;SET SESSION REMARK + HRROI 3,[ASCIZ /CHAOS SERVER/] + SETJB ;DO IT + ERJMP .+1 ;OR DON'T +];IFE OZ\XX +];20X + HRLZI 1,(GJ%SHT) ;Short GTJFN to get the control channel + HRROI 2,[ASCIZ \CHA:.FILE\] + GTJFN + ERCAL CTLDON + HRRZM 1,CTLJFN ;JFN for control channel + MOVE 2,[100000,,OF%RD\OF%WR] + OPENF ;Listen for connection + ERCAL CTLDON + MOVEI 2,.MOPKR + MOVEI 3,CTLPKI + MTOPR + ERCAL CTLDON + MOVE P,PDL + PUSHJ P,CHKPVR ;CHECK PROTOCOL VERSION NUMBER + JRST CTLDN0 ;ALREADY WILL HAVE SENT CLS IF NO GOOD + MOVE 1,CTLJFN + MOVEI 2,.MOOPN ;Accept the connection + MTOPR + ERCAL CTLDON + PUSHJ P,TIMIN1 ;Turn on timer interrupts +IFN OZ,[ + SETOM RETENA ;CHEAP WAY TO ENABLE FILE RETRIEVALS + MOVEI A,HOSTSP + PUSHJ P,NETWRK"HSTMAP ;Map in HOSTS2 database + JRST CTLLOP ; oops +];IFN OZ +IFN OZ\XX,[ + LDB B,[$CPKSA+CTLPKI] ;SOURCE ADDRESS + Movem B,HostN ;Save for later. +];IFN OZ\XX +IFN OZ,[ + PUSHJ P,NETWRK"HSTSRC ;Look up name of who's knocking + JRST CTLLOO + HRRO 2,A ;-1,,(A) in AC2 + HRROI 1,KSITE ;Get the host-name in KNAME + SETZ 3, + SOUT +];IFN OZ +IFN XX,{ ;There's a perfectly good jsys, + MOVEI 1,.CHNNS ;why map host tables? + HRROI 2,KSITE + MOVE 3,HostN + CHANM% + ERJMP [HRROI 1,KSITE ;Lookup failed, use octal number + MOVE 2,B + MOVEI 3,8 + NOUT% + ERJMP .+1 ;this shouldn't ever fail + JRST .+1] +};IFN XX +IFN OZ\XX,[ + HRROI 1,REMARK + HRROI 2,[ASCIZ "CHAOS SERVER "] + SETZ 3, + SOUT + HRROI 2,KSITE + SOUT + SETO 1, ;THIS JOB + MOVEI 2,.SJSRM ;SET SESSION REMARK + HRROI 3,REMARK + SETJB ;DO IT + ERJMP .+1 ;OR DON'T +];IFN OZ\XX +IFN OZ,[ + HLRZ A,1(D) ;Address of system-name + ADD A,NETWRK"HSTADR + MOVE T,(A) + CAMN T,[ASCII /LISPM/] + JRST [ TRO F,F.LSP ;We are a LispMachine + MOVEI 1,.FHSLF + SETO 3, + EPCAP ;Enable!! + JRST CTLLOO ] + Movei 1,.GJALL ;Known not to be a Lisp machine, use * as default vers + Movem 1,JFNBLK+.GJGEN +IFN $$LOG,[ + Setom LispMf + GJINF + Move T,3 + Hrroi 1,Trikle + Hrroi 2,[Asciz "SS:"] + Setz 3, + SOUT + Hrroi 2,KSite + SOUT +; Hrroi 2,[Asciz "-JOB-"] +; SOUT +; Move 2,T +; Movei 3,10. +; NOUT +; Jfcl + Hrroi 2,[Asciz ".LOG"] + Setz 3, + SOUT + Movsi 1,(GJ%SHT\GJ%FOU) + Hrroi 2,Trikle + GTJFN + Jrst CTLLOO ;No biggie (if it fails) + Movem 1,TriJFN + Move 2,[70000,,OF%WR] + OPENF + Jrst [Move 1,TriJFN + RLJFN + Jfcl + Setzm TriJFN + Jrst CTLLOO] + Seto 2, ;Now + Setz 3, + ODTIM + Hrroi 2,[Asciz " Log started +"] + Setz 3, + SOUT +];$$LOG +CTLLOO: PUSHJ P,NETWRK"HSTUNMAP ;We don't need those pages anymore +];OZ + +CTLLOP: MOVE P,PDL ;For safety, reset the world + SETZ F, + SETO A, ;Allow timer interrupts + EXCH A,TIMINF ;See if timer went off + SKIPE A + PUSHJ P,DWNCHK ;It did, do check now + MOVE 1,CTLJFN ;Wait for a control packet + MOVEI 2,.MOPKR + MOVEI 3,CTLPKI + MTOPR + ERCAL CTLERR ;Flush ourselves if any error +IFN OZ$LOG,[ + Skipn 1,TriJFN + Jrst CTLLOR + Seto 2, + Setz 3, + ODTIM + Hrroi 2,[Asciz " <== +"] ? Setz 3, + SOUT + + Skipe TimeOn ;Activity! Turn off pending + Jrst [Move 1,[.FHSLF,,.TIMAL] ;suicide interrupt (actually + TIMER ;turn them all off) + Setzm TimeOn + Jrst .+1] +CTLLOR: +];OZ$LOG + SETZM TIMINF ;No longer allow timer interrupts + LDB T,[CTLPKI+$CPKOP] + CAIL T,%CODAT ;THIS A DATA PACKET? + JRST COMMAN ;YES, OK, GO DO A COMMAND FROM IT + CAIE T,%COEOF ;LISP MACHINE WANT TO CLOSE THE CONNECTION? + JRST CTLLOP ;HMMM, BAD PACKET, IGNORE IT FOR NOW + PUSHJ P,CTLDON ;Does not return. + +CTLDON: SKIPG DEBUG ;Dump ourselves + JRST CTLDN0 + MOVEM 0,DMPACS + MOVE 0,[1,,DMPACS+1] + BLT 0,DMPACS+17 + MOVE 1,[GJ%SHT+GJ%FOU+GJ%NEW] +IFN 20X,HRROI 2,[ASCIZ \PS:DEAD-FILEJOB.EXE\] +IFN 10X,HRROI 2,[ASCIZ \DSK:DEAD-FILEJOB.SAV\] + GTJFN + JRST CTLDN0 + HRLI 1,.FHSLF + MOVE 2,[777760,,20] + SAVE +CTLDN0: +IFN OZ$LOG,[ + Skipn 1,TriJFN + Jrst ZZZ + Seto 2, + Setz 3, + ODTIM + Hrroi 2,[Asciz " Closing log file - EOF received"] + Setz 3, + SOUT + CLOSF + Jfcl +ZZZ: +];OZ$LOG +IFN 10X,[ ;Tenex LGOUT doesn't do this itself + MOVEI IDX,MAXIDX-1 ;Last output channel +CTLDN1: HRRZ 1,DATSTA(IDX) + JUMPE 1,CTLDN2 ;ST%CLO + MOVE 1,DATJFN(IDX) + HRLI 1,(CO%NRJ) ;Close file, but keep around JFN + CLOSF + ERJMP CTLDN2 ;Ain't much else we can do... + DELF ;Delete the file and release JFN + ERJMP CTLDN2 +CTLDN2: SUBI IDX,2 + JUMPGE IDX,CTLDN1 +];IFN 10X +IFN 20X,[ + MOVEI 1,.FHSLF + HRLI 1,(CZ%ABT+CZ%NUD) ;Abort all output operations + + ; don't update disk copy of directory + CLZFF ; and close all files + ERJMP .+1 ;oh well, we tried. +];IFN 20X + MOVNI 1,1 ;-1 means log us out + SKIPL DEBUG ;If debugging, just stop, will die if top-level + LGOUT ;Bye-bye + HALTF + JRST .-1 + +CTLERR: MOVEI 1,.FHSLF + PUSHJ P,$GETER + PUSHJ P,CTLDON ;Punt if no err + MOVE 1,[441000,,CTLPKO+%CPKDT] + MOVSI 3,-%CPMXC + ERSTR + PUSHJ P,CTLDON + JFCL +CTLER1: SETZ BC, +IFN 10X,IDPB BC,1 ;Put in null at end + MOVE 1,[441000,,CTLPKO+%CPKDT] + ILDB 2,1 + CAIE 2,0 + AOJA BC,.-2 ;Get real size + MOVEI T,%COLOS ;Send LOS packet + DPB T,[$CPKOP+CTLPKO] + DPB BC,[$CPKNB+CTLPKO] + MOVE 1,CTLJFN + MOVEI 2,.MOPKS + MOVEI 3,CTLPKO + MTOPR + ERCAL CTLDON + PUSHJ P,CTLDON +] ;END IFN TNX + +;;; Called c(D)+1 has code,,pointer-to-asciz-string +COMERR: MOVEI A,[ASCIZ \ERROR \] ;INDICATE AN ERROR TO THE REQUESTOR + PUSHJ P,COMCTL + HLLZ A,1(D) ;GET ERROR CODE + PUSHJ P,COMSXO + MOVEI BYTE,40 + PUSHJ P,COMCHO + HRRZ A,1(D) ;NOW OUTPUT THE ERROR STRING + PUSHJ P,COMSTO + PUSHJ P,COMSND + JRST CTLLOP + +MINPTC==0 +MAXPTC==1 + +;;; Check protocol version number +CHKPVR: MOVE BP,[441000,,CTLPKI+%CPKDT] + LDB BC,[CTLPKI+$CPKNB] + PUSHJ P,COMRD5 ;SHOULD BE FILE + TDZA A,A + PUSHJ P,COMDCI ;GET NUMBER INTO A + MOVEM A,PTCVER + CAIL A,MINPTC + CAILE A,MAXPTC + SKIPA + JRST POPJ1 + MOVEI A,[ASCIZ \PROTOCOL VERSION \] + PUSHJ P,COMCTL + MOVE A,PTCVER + PUSHJ P,COMDCO + MOVEI A,[ASCIZ \ NOT SUPPORTED\] + PUSHJ P,COMSTO + MOVEI T,%COCLS + JRST COMSN1 + +;;; Here to handle a command over the control connection +COMBAD: CERR BUG,[Illegal request format] + +COMMAN: +IFN OZ$LOG,[ + SKIPN TRIJFN + JRST XXX2 + LDB A,[$CPKNB+CTLPKI] ;Byte-count + MOVE B,[441000,,CTLPKI+%CPKDT] + PUSHJ P,PKTPRT +XXX2: +];OZ$LOG + MOVE BP,[441000,,CTLPKI+%CPKDT] + LDB BC,[CTLPKI+$CPKNB] + PUSHJ P,COMRD5 ;Get transaction ID + JRST CTLLOP ;Error, ignore this request (what else?) + MOVEM A,TRANID + TRZ F,F.FHN ;NO FILE HANDLE SEEN YET + MOVEI B,5 ;MAXIMUM FILE-HANDLE SIZE + SETZ FHN, + MOVE A,[440700,,FHN] ;ACCUMULATE FILE HANDLE +COMFHL: SOJL BC,COMBAD ;BAD CONTROL PACKET: PROTOCOL VIOLATION + ILDB BYTE,BP ;GET THE NEXT CHARACTER + CAIN BYTE,40 ;SPACE TERMINATES FILE HANDLE + JRST COMMA1 ;KEEP PROCESSING + IDPB BYTE,A + SOJG B,COMFHL ;ONLY READ FIRST 5 CHARACTERS + PUSHJ P,COMEUS ;EAT UNTIL SPACE SEEN + JRST COMBAD ;NON-SKIP, HIT END OF PACKET OR NEWLINE, ERROR +COMMA1: JUMPE FHN,COMMA2 ;DON'T HAVE A FILE HANDLE AFTER ALL + TRO F,F.FHN + MOVEI IDX,MAXIDX-1 ;LOOP OVER ALL INDICIES +COMMA3: CAMN FHN,DATFHN(IDX) ;MATCH? + JRST COMMA2 ;YUP, LEAVE IDX IN IDX + SOJGE IDX,COMMA3 + CERR BUG,[Unknown file handle] + +COMMA2: PUSHJ P,COMR10 ;READ 10 CHARACTERS INTO A AND B + JFCL + JUMPE A,[CERR BUG,[Null command name]] + MOVSI T,-COMTAL ;AOBJN POINTER +COMCO1: CAMN A,COMTAB(T) ;MATCH? + CAME B,COMTAB+1(T) + AOJA T,COMCO2 ;NO, TRY NEXT + HRRZS T ;YES, RUN THE COMMAND + LSH T,-1 + JRST @COMDSP(T) + +COMCO2: AOBJN T,COMCO1 + CERR UKC,[Unknown command] + +;;; Command table +COMTAB: ASCII \DATA-CONNE\ ;DATA-CONNECTION + ASCII \UNDATA-CON\ ;UNDATA-CONNECTION + ASCII \OPEN\ ? 0 ;OPEN + ASCII \CLOSE\ ? 0 ;CLOSE + ASCII \FILEPOS\ ;FILEPOS + ASCII \DELETE\ ;DELETE + ASCII \RENAME\ ;RENAME + ASCII \CONTINUE\ ;CONTINUE + ASCII \SET-BYTE-S\ ;SET-BYTE-SIZE + ASCII \LOGIN\ ? 0 ;LOGIN + ASCII \DIRECTORY\ ;DIRECTORY + ASCII \COMPLETE\ ;COMPLETE + ASCII \CHANGE-PRO\ ;CHANGE-PROPERTIES + ASCII \CREATE-DIR\ ;CREATE-DIRECTORY + ASCII \EXPUNGE\ ;EXPUNGE + ASCII \HOMEDIR\ ;HOMEDIR + ASCII \FILE-SYSTE\ ;FILE-SYSTEM-INFO + ASCII \PROPERTIES\ ;PROPERTIES +IFN ITS,ASCII \CREATE-LIN\ ;CREATE-LINK +IFN TNX,[ + ASCII \CWD\ ? 0 ;CHANGE WORKING DIRECTORY (CONNECT) +IFN 20X,ASCII \ACCESS\ ;ACCESS DIRECTORY + ASCII \ENABLE-CAP\ ;ENABLE-CAPABILITIES + ASCII \DISABLE-CA\ ;DISABLE-CAPABILITIES +];TNX +COMTAL==<.-COMTAB>/2 + +COMDSP: COMDCN + COMUDC + COMOPN + COMCLO + COMFIL + COMDEL + COMREN + COMCON + COMSBS + COMLOG + COMDIR + COMCPL + COMCNG + COMCRD + COMEXP + COMHOM + COMFSI + COMPRO +IFN ITS,COMCRL +IFN TNX,[ + COMCWD +IFN 20X,COMACD + COMENA + COMDIS +];TNX +IFN .-COMDSP-COMTAL, .ERR COMDSP and COMTAB lengths disagree + +;;; Subroutines + +;Read the next token from the stream. Reads the first 5 bytes, and throws away the rest. +; Destroys T, TT, and BYTE; result in A. Tail recurses to COMEUS +COMR10: MOVEI T,10. ;ALLOW 10 CHARACTERS INTO A AND B + TDZA B,B +COMRD5: MOVEI T,5 + TRZ F,F.NWL + SETZ A, + MOVE TT,[440700,,A] ;ACCUMULATE TOKEN IN A +COMR5A: SOJL BC,CPOPJ ;END OF PACKET, HAVE TOKEN + ILDB BYTE,BP ;GET THE NEXT CHARACTER + CAIN BYTE,215 ;NEWLINE TERMINATES + JRST COMEUN + CAIN BYTE,40 ;SPACE TERMINATES THE TOKEN + JRST COMEUR + IDPB BYTE,TT + SOJG T,COMR5A ;ONLY READ FIRST 5 CHARACTERS +; JRST COMEUS ;FALL INTO COMEUS + +;Eats until end of stream, space, or newline seen +; Non-skip return if end of packet or newline seen, skip return if space seen +COMEUS: SOJL BC,COMEUP ;IF END OF STREAM, RETURN + ILDB BYTE,BP ;NEXT BYTE +COMEUA: CAIN BYTE,215 ;NEWLINE + JRST COMEUN + CAIE BYTE,40 ;SPACE + JRST COMEUS ;NOPE, KEEP GOING +COMEUR: AOS (P) ;SKIP RETURN +COMEUP: TRZA F,F.NWL +COMEUN: TRO F,F.NWL +CPOPJ: POPJ P, + +;Single byte output +;Must preserve TT +COMCHO: CAML BC,CHPMXC + CERR BUG,[Too much information to fit in a packet] + IDPB BYTE,BP + AOJA BC,CPOPJ + +;;; For TOPS-20, output from RESBLK, where lots of interesting things get returned +IFN TNX, COMRES: SKIPA A,[440700,,RESBLK] +;String out, string address in A, COMST0 if already byte pointer +COMSTO: HRLI A,440700 ;MAKE A A STRING POINTER +COMST0: ILDB BYTE,A ;GET NEXT CHARACTER +COMST1: JUMPE BYTE,CPOPJ ;TERMINATE ON NULL + XCT CHR2LM(BYTE) ;CONVERT TO LISP MACHINE CHARACTER SET + PUSHJ P,COMCHO ;NON-SKIP, JUST OUTPUT + JRST COMST0 + JRST COMST0 ;IGNORE RUBOUT ESCAPE, SHOULDN'T HAPPEN HERE + MOVEI BYTE,115 ;POSSIBLY STRAY RETURN, OUTPUT M TO BE SAFE NOW + PUSHJ P,COMCHO + ILDB BYTE,A ;AND ABSORB FOLLOWING LINE FEED + CAIE A,12 + JRST COMST1 + MOVEI BYTE,215 ;CARRIAGE RETURN FOR CRLF + DPB BYTE,BP ;REPLACE M IN PACKET + JRST COMST0 + +;Decimal output, value in A, destroys A and B +COMDCO: JUMPL A,CPOPJ ;IGNORE NEGATIVE NUMBERS + PUSH P,[-1] ;FLAG BOTTOM OF STACK +COMDO0: IDIVI A,10. + PUSH P,B + JUMPN A,COMDO0 +COMDO1: POP P,BYTE + JUMPL BYTE,CPOPJ ;DO UNTIL NO MORE DIGITS + ADDI BYTE,"0 + PUSHJ P,COMCHO + JRST COMDO1 + +;Octal output, value in A, destroys A +COMOCO: PUSH P,[-1] ;FLAG BOTTOM OF STACK +COMOO0: PUSH P,A + ANDI A,7 ;SAVE BOTTOM DIGIT + EXCH A,(P) + LSH A,-3 + JUMPN A,COMOO0 +COMOO1: POP P,BYTE + JUMPL BYTE,CPOPJ ;DO UNTIL NO MORE DIGITS + ADDI BYTE,"0 + PUSHJ P,COMCHO + JRST COMOO1 + +;Sixbit output, sixbit in A, destroys A and B. Quotes funny characters. +COMSXO: MOVE B,A +COMSO0: JUMPE B,CPOPJ ;TERMINATE WHEN NO MORE BYTES + SETZ A, + LSHC A,6 ;GET NEXT BYTE + JUMPE A,COMSOQ ;QUOTE LEADING SPACES + CAIE A,': ;AND : OR ; + CAIN A,'; + JRST COMSOQ +COMSO1: MOVEI BYTE,40(A) ;MAKE ASCII + PUSHJ P,COMCHO ;OUTPUT THE BYTE + JRST COMSO0 + +COMSOQ: MOVEI BYTE," + PUSHJ P,COMCHO + JRST COMSO1 + +;Output date/time from A +COMDTO: PUSH P,D + MOVEI D,COMCHO ;Output char in BYTE to command response + JRST COMDT0 + +DIRDTO: PUSH P,D + MOVEI D,DIRCHO ;Output char in BYTE to directory listing +COMDT0: +IFN TNX,[ +;; Internal date/time in A -- convert to ITS format + MOVE 2,A + AOSN A ;If -1, then use 0 + SETZ 2, + SETZ 4, + ODCNV ;Convert internal date/time to printable format + ERCAL SYSBUG + HRRZ A,4 ;Local time in seconds + LSH A,1 ;Number of half-seconds since midnight + HLRZ T,2 ;The year + SUBI T,1900. + DPB T,[330700,,A] + AOS 2 + DPB 2,[270400,,A] ;The month + HLRZ T,3 ;The day + AOS T + DPB T,[220500,,A] +] ;END IFN TNX +IFN ITS,[ + HLRZ B,A + ANDI B,177777 + CAIN B,-1 + MOVEI A,0 ;Unknown => start of century +] + PUSH P,A + LDB A,[270400,,0 (P)] ;MONTH 3.9-3.6 + CAIG A,12. + CAIG A,0 + MOVEI A,1 ;Lisp machine barfs if month is bogus + IDIVI A,10. + MOVEI BYTE,"0(A) + PUSHJ P,(D) + MOVEI BYTE,"0(B) + PUSHJ P,(D) + MOVEI BYTE,"/ + PUSHJ P,(D) + LDB A,[220500,,0 (P)] ;DAY 3.5-3.1 + CAIG A,31. + CAIG A,0 + MOVEI A,1 ;Lisp machine barfs at bogus days now, too + IDIVI A,10. + MOVEI BYTE,"0(A) + PUSHJ P,(D) + MOVEI BYTE,"0(B) + PUSHJ P,(D) + MOVEI BYTE,"/ + PUSHJ P,(D) + LDB A,[330700,,0 (P)] ;YEAR 4.7-4.1 + IDIVI A,100. + MOVE A,B ;Ignore overflow if 3-digit year (garbage) + IDIVI A,10. + MOVEI BYTE,"0(A) + PUSHJ P,(D) + MOVEI BYTE,"0(B) + PUSHJ P,(D) + MOVEI BYTE,40 + PUSHJ P,(D) + HRRZ A,(P) ;TIME + LSH A,-1 ;Half-seconds since midnight, HOW RANDOM! + CAIL A,86400. + MOVEI A,0 ;I suppose the Lisp machine probably checks this too + IDIVI A,60. ;Get number of seconds + PUSH P,B ;Save them + IDIVI A,60. ;Get number of minutes + PUSH P,B ;Save them +REPEAT 3,[ ;Output each of the sections with intervening colons + IDIVI A,10. + MOVEI BYTE,"0(A) + PUSHJ P,(D) + MOVEI BYTE,"0(B) + PUSHJ P,(D) +IFN .RPCNT-2,[ + MOVEI BYTE,": + PUSHJ P,(D) + POP P,A +] ;End IFN +] ;End REPEAT + POP P,A + POP P,D + POPJ P, + +;Setup for returning a control packet +COMCTL: MOVE BP,[441000,,%CPKDT] + ADD BP,PKTLOC + SETZ BC, + PUSH P,A + MOVEI A,TRANID ;Get current transaction ID + PUSHJ P,COMSTO ;This heads all replies + MOVEI BYTE,40 + PUSHJ P,COMCHO + TRNN F,F.FHN ;FILE HANDLE? + JRST COMCT0 + MOVE A,DATFHN(IDX) ;YES, GET THE FILE HANDLE + MOVEM A,FHNOUT + MOVEI A,FHNOUT ;AND LEAD WITH IT + PUSHJ P,COMSTO +COMCT0: POP P,A + MOVEI BYTE,40 + PUSHJ P,COMCHO ;LEADING SPACE + JRST COMSTO ;OUTPUT THE APPROPRIATE COMMAND AND RETURN + +;Send or expect synchronous mark. For output files, A is pointer to routine to be run +; when mark arrives. NOTE: this routine will not work recursivly +COMSSY: +IFN ITS,[ + .SUSET [.SPICLR,,[0]] ;To prevent timing screws, turn off all interrupts +] ;END IFN ITS +IFN TNX,[ + MOVEI 1,.FHSLF ;Disable interrupts temporarily to prevent timing lossage + DIR +] ;END IFN TNX + MOVE T,DATSTA(IDX) + TLO T,ST.SYN ;Send synchronous mark + JRST @SSYDSP(T) ;Dispatch on current state + +SSYDSP: SSYCLO ;Closed + SSYOPN ;Open + SSYASY ;Async marked + SSYSYN ;Sync marked + SSYEOF ;EOF state + +;Sync marked state means that the mark has arrived already. Run the routine here and now. +; A gets replaced with the channel status +SSYSYN: EXCH T,A ;Meanings are reversed + TLZ A,ST.SYN ;No longer marked +IFN ITS,[ + .SUSET [.SDF2,,[-1]] ;Defer all channel interrupts + .SUSET [.SPICLR,,[-1]] ;Reenable things like IOC et al +] ;END IFN ITS + PUSHJ P,(T) ;Call routine + MOVEM A,DATSTA(IDX) ;May have changed channel state +IFN TNX,[ +;; Since on Tops-20 there is no way to defer only a certain set of interrupts, they +;; will all be left defered. This is a total loss. + MOVEI 1,.FHSLF ;Turn interrupt back on + EIR + MOVEI 1,.FHSLF + MOVE 2,CHABIT(IDX) + AIC ;Reenable interrupts on this channel +; MOVEI 1,.FHSLF +; MOVE 2,CHABIT(IDX) + IIC ;Force interrupt on channel to start ball rolling +] ;END IFN TNX +IFN ITS,[ + .SUSET [.SDF2,,SSYDF2] ;Restore old DF2 value + MOVE T,CHABIT(IDX) + TRNN IDX,1 ;This an output idx? + JRST SSYSY0 ;Nope, need to cause interrupt to get ball rolling + ANDCAM T,SSYDF2 ;This interrupt is no longer deffered + .SUSET [.SDF2,,SSYDF2] +;;; NOTE: Due to the fact that some packets may be sitting in the buffers but not +;;; interrupting (if we dismissed the interrupt with packets lying around), we +;;; better cause an interrupt to let them get processed +SSYSY0: .SUSET [.SIIFPIR,,T] +] ;END IFN ITS + POPJ P, + +;Closed or in EOF state +SSYCLO: +SSYEOF: TRNN IDX,1 ;An input channel? + JRST SSYAS0 ;Yes, cause an interrupt to get the ball rolling + JRST SSYOPN + +;Async marked means that interrupts (for output channels) have been deffered. +SSYASY: +IFN ITS,[ + TRNN IDX,1 ;This an output channel? + JRST SSYAS0 ;Nope, so no need to undefer + MOVE TT,CHABIT(IDX) ;Get mask bit + ANDCAM TT,SSYDF2 ;Undefer + .SUSET [.SDF2,,SSYDF2] + +SSYAS0: MOVE TT,CHABIT(IDX) + .SUSET [.SIIFPIR,,TT] ;Cause interrupt to happen right now +] ;END IFN ITS +IFN TNX,[ + MOVEI 1,.FHSLF + MOVE 2,CHABIT(IDX) + AIC ;Reenable interrupts on this channel +SSYAS0: MOVEI 1,.FHSLF + MOVE 2,CHABIT(IDX) + IIC ;Force interrupt on channel to start ball rolling +] ;END IFN TNX +; JRST SSYOPN ;Fall into SSYOPN + +;Open just needs to set bit +SSYOPN: MOVEM T,DATSTA(IDX) + MOVEM A,DATSYA(IDX) ;A is pointer to action to be taken upon receipt/transmission +IFN ITS,[ + .SUSET [.SPICLR,,[-1]] ;Reenable the world +] ;END IFN ITS +IFN TNX,[ + MOVEI 1,.FHSLF + EIR ;Turn the interrupt system back on +] ;END IFN TNX + POPJ P, + +;;; Send the control packet that has been built in CTLPKO +COMSND: MOVEI T,CO%TXT +COMSN1: DPB T,[$CPKOP+CTLPKO] + DPB BC,[$CPKNB+CTLPKO] +IFN ITS,[ + .CALL [ SETZ + SIXBIT /PKTIOT/ + %CLIMM,,CTRLO + %CLIMM+%CLEND,,CTLPKO] + .LOSE %LSSYS + POPJ P, +] ;END IFN ITS +IFN TNX,[ + MOVE 1,CTLJFN + MOVEI 2,.MOPKS + MOVEI 3,CTLPKO + MTOPR + ERCAL CTLERR +IFN $$LOG,[ + SKIPN 1,TRIJFN + POPJ P, + SETO 2, + SETZ 3, + ODTIM + HRROI 2,[ASCIZ " ==> +"] ? SETZ 3, + SOUT + LDB A,[$CPKNB CTLPKO] + MOVE B,[441000,,CTLPKO+%CPKDT] + PUSHJ P,PKTPRT +];$$LOG + POPJ P, +] ;END IFN TNX + +IFN ITS,[ +;File name reader. Returns in DAT???(IDX) +COMPFN: MOVSI TT,'DSK ;Default device is DSK + MOVEM TT,DATDEV(IDX) + SETZM DATSNM(IDX) ;Default directory is last-used + SETZM DATFN1(IDX) ;No default FN1 + MOVSI TT,(SIXBIT />/) + SKIPE STARF2 + MOVSI TT,(SIXBIT /*/) + MOVEM TT,DATFN2(IDX) + TRZ F,F.FN1+F.FN2+F.DEV+F.DIR +COMPF0: PUSHJ P,COMSYL ;Read next sixbit frob, BYTE has terminator + JUMPE A,COMPF1 + CAIN BYTE,": + JRST [ MOVEM A,DATDEV(IDX) ? TRO F,F.DEV ? JRST COMPF0 ] + CAIN BYTE,"; + JRST [ MOVEM A,DATSNM(IDX) ? TRO F,F.DIR ? JRST COMPF0 ] + SKIPN DATFN1(IDX) + JRST [ MOVEM A,DATFN1(IDX) ? TRO F,F.FN1 ? JRST COMPF1 ] + MOVEM A,DATFN2(IDX) + TRO F,F.FN2 +COMPF1: CAIN BYTE,215 ;Terminate on newline + JRST COMEUN + JRST COMPF0 +] ;END IFN ITS + +IFN TNX,[ +;;Look for a full file specification +COMGJF: MOVE 2,BP ;Source of filename + PUSHJ P,COMEUS ;Find end of filename + JRST [TRZN F,F.NWL ;Must be terminated with a newline + JRST COMBAD + JRST .+2] + JRST .-2 ;Terminated by space, so keep searching + SETZ 1, + DPB 1,BP ;Insure terminating NULL +COMGJG: PUSH P,2 ;Save BP in case we need to re-try something. + MOVE 1,[GJ%SHT+.GJDEF] ;Setup flags to GTJFN + TLNE D,ST.OUT + SKIPGE NOTNEW + TLOA 1,(GJ%OLD) ;Input or know-to-be-existing file... + JRST [ TLO 1,(GJ%NEW) + SKIPG NOTNEW + TLO 1,(GJ%FOU) + JRST .+1 ] + TLNE D,ST.DIR + JRST [ TLO 1,(GJ%IFG) + JRST COMGJ1] ;Allow wild cards for directory + TLNE D,ST.TEM ;Temporary file? + TLO 1,(GJ%TMP) +COMGJ1: TLNE D,ST.DEL ;Permit deleted file? + TLO 1,(GJ%DEL) + TLNE D,ST.PON + JRST [ TLO 1,(GJ%OFG) + TLZ 1,(GJ%OLD) + JRST .+1] ;Parse only if so desired +COMGJ2: GTJFN + SKIPA ;JSYS error, return it to user + AOS -1(P) + POP P,2 ;Leave AC2 pointing to the filename... + POPJ P, + +COMGDJ: MOVE 2,BP ;Source of filename + PUSH P,2 + PUSHJ P,COMEUS ;Find end of filename + JRST [TRZN F,F.NWL ;Must be terminated with a newline + JRST COMBAD + JRST .+2] + JRST .-2 ;Terminated by space, so keep searching + SETZ 1, + DPB 1,BP ;Insure terminating NULL + MOVSI 1,(GJ%OLD\GJ%IFG) + TLNE D,ST.DEL ;Permit deleted file? + TLO 1,(GJ%DEL) + TLNE D,ST.PON ;Parse-only? + TLC 1,(GJ%OFG\GJ%OLD\GJ%IFG) + HLLM 1,JFNBLK + MOVEI 1,JFNBLK + JRST COMGJ2 +] ;END IFN TNX + +;Read a syllable +COMSYL: SETZ A, + MOVE TT,[440600,,A] +COMSY3: SOJL BC,COMBAD ;If no more bytes then done + ILDB BYTE,BP + CAIE BYTE,^Q ;Allow ^V to quote too, for the sake of + CAIN BYTE,^V ;20's on which ^Q is an interrupt character. + SKIPA + JRST COMSY1 ;Not quoted char + SOJL BC,COMBAD + ILDB BYTE,BP + JRST COMSY2 + +COMSY1: CAIE BYTE,": ;Colon, semicolon and space and control chars end syllable + CAIN BYTE,"; + JRST CPOPJ + CAIN BYTE,215 + JRST COMEUN + CAIN BYTE,40 ;Space ends syllable if not quoted + JRST CPOPJ +COMSY2: CAIGE BYTE,40 ;Control chars end syllable even if ^Q'd. + POPJ P, + CAIGE BYTE,140 ;Skip if "lower case" + SUBI BYTE,40 + TLNE TT,770000 + IDPB BYTE,TT + JRST COMSY3 + +COMOCI: SKIPA T,[8] +;;; Decimal number reader +COMDCI: MOVEI T,10. ;Read in BASE 10 +COMNUI: SETZ A, +COMNU0: SOJL BC,CPOPJ + ILDB BYTE,BP + CAIL BYTE,"0 + CAIL BYTE,"0(T) + JRST COMEUA + IMULI A,(T) + ADDI A,-"0(BYTE) + JRST COMNU0 + +;;; Sixbit input. Raise case of letters. Terminate on space or non-sixbit. +COMSXI: MOVEI T,6. ;Maximum of 6 chars + MOVE TT,[440600,,A] ;Collect in A + SETZ A, +COMSI0: SOJL BC,CPOPJ ;Return if nothing more to read + ILDB BYTE,BP + CAIL BYTE,"a + CAILE BYTE,"z + SKIPA + SUBI BYTE,"a-"A + SUBI BYTE,40 ;Convert to sixbit + JUMPLE BYTE,CPOPJ ;Return if it's a non-sixbit character or space + CAILE BYTE,77 + POPJ P, + SOJL T,COMSI0 ;Don't stick in if no more room + IDPB BYTE,TT + JRST COMSI0 + +;;; Date input +IFN ITS,[ ;This only allows MM/DD/YY HH:MM:SS +COMDTI: SETZ A, + PUSHJ P,COMDT1 + DPB T,[270400,,A] ;Month 3.9-3.6 + PUSHJ P,COMDT1 + DPB T,[220500,,A] ;Day 3.5-3.1 + PUSHJ P,COMDT1 + DPB T,[330700,,A] ;Year 4.7-4.1 + CAIN BYTE,215 ;If no newline, then no time + JRST COMEUN + PUSHJ P,COMDT1 ;Hours + MOVE B,T + PUSHJ P,COMDT1 ;Minutes + IMULI B,60. + ADD B,T + PUSHJ P,COMDT1 ;Seconds + IMULI B,60. + ADD B,T + LSH B,1 ;Half seconds + HRR A,B + POPJ P, + +COMDT1: SETZ T, +COMDT2: SOJL BC,CPOPJ + ILDB BYTE,BP + CAIL BYTE,"0 + CAILE BYTE,"9 + POPJ P, + IMULI T,10. + ADDI T,-"0(BYTE) + JRST COMDT2 +] ;END IFN ITS + +IFN TNX,[ +COMDTI: MOVE 1,BP ;Source of date + PUSHJ P,COMEUS ;Find end + JRST [TRZN F,F.NWL ;Must be terminated with a newline + JRST COMBAD + JRST .+2] + JRST .-2 ;Terminated by space, so keep searching + SETZ 2, + DPB 2,BP ;Insure terminating NULL + IDTIM + ERCAL JSYSER + MOVE A,2 + POPJ P, +] ;END IFN TNX + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; For a JSYS that might get an access violation, try it, and if it +;;; fails, see if you can CONNECT no password, and if so, try the +;;; JSYS again. +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +IFN 20X,[ +TRYCON: PUSH P,1 ;Save arg in AC1 which might be clobbered by error. + PUSH P,A ;Save temp + HRRZ A,-2(P) ;Get return addr, which should be addr of JSYS + XCT (A) + ERJMP [CAIN 1,DELFX1 ;DELF errors (delete access required) + JRST CONECT + CAIN 1,RNAMX8 ;RNAMF errors (write or owner on source) + JRST CONECT + CAIE 1,OPNX3 ;OPENF errors (read, write, execute, + CAIN 1,OPNX4 ;or append access required). + JRST CONECT + CAIE 1,OPNX5 + CAIN 1,OPNX6 + JRST CONECT + CAIN 1,CFDBX3 ;CHFDB error (write or owner access) + JRST CONECT + JRST CONLUZ ] ;Not an error we know. + POP P,A ;We win. Clean the stack, + POP P,1 + AOS (P) ;and skip-return past the JSYS (and its + JRST POPJ1 ;trailing error jump) + +CONECT: PUSH P,2 + HRROI 1,CONFNM + MOVEM 1,RESBLK+.ACDIR + HRRZ 2,DATJFN(IDX) ;JFN + MOVE 3,[.JSAOF_33.+.JSAOF_30.+JS%PAF] + JFNS ;Get DEV: into CONFNM + ERJMP CONLZ1 + SETZM RESBLK+.ACPSW ;No password ... + SETOM RESBLK+.ACJOB ;This job. + + MOVE 1,[AC%CON+3] ;AC%CONnext to dir, 3 word arg block. + MOVEI 2,RESBLK ;Address of block. + ACCES + ERJMP CONLZ1 + SETOM CNCTED + POP P,2 ;Clean the stack... + POP P,A ;and return to the JSYS + POP P,1 + POPJ P, + +CONLZ1: POP P,2 ;CONECT failed +CONLUZ: AOS -2(P) ;Address of instruction after JSYS + HLRZ A,@-2(P) + CAIN A,(ERCAL) ;Simulate ERCAL + JRST [ HRRZ A,@-2(P) + AOS -2(P) ;Return address for ERCAL + MOVEM A,-1(P) + POP P,A + POPJ P, ] + CAIN A,(ERJMP) ;Simulate ERJMP + JRST [ HRRZ A,@-2(P) + MOVEM A,-2(P) + JRST .+1 ] + POP P,A + SUB P,[1,,1] ;Return error code, not saved 1 + POPJ P, + +DISCON: SKIPN CNCTED + POPJ P, + SKIPN 1,CWDNUM ;If you are in an explicit CONNECT + MOVE 1,UDRNUM ;state, then return there, else it + MOVEM 1,RESBLK+.ACDIR ;an implicit one, so return to home + SETZM RESBLK+.ACPSW ;dir. + SETOM RESBLK+.ACJOB + MOVE 1,[AC%CON+3] + MOVEI 2,RESBLK + ACCES + ERJMP CPOPJ + SETZM CNCTED + POPJ P, +];20X + +;;; Create a new data connection +COMDCN: TRZN F,F.FHN ;MUST NOT HAVE A FILE HANDLE + TRZE F,F.NWL ;NEWLINE TERMINATES COMMAND? + JRST COMBAD ;ILLEGAL REQUEST FORMAT + PUSHJ P,COMRD5 ;READ THE NEXT TOKEN, WHICH SHOULD BE THE INPUT FILE HANDLE + JRST COMBAD + PUSH P,A ;SAVE ON STACK + PUSHJ P,COMRD5 ;NEXT TOKEN AS WELL + TRZE F,F.NWL ;BETTER HAVE GOTTEN TO END OF PACKET + JRST COMBAD ;NOT END OF PACKET, BUT DIDN'T WANT ANY MORE CRUFT + MOVEI IDX,MAXIDX-2 ;CHECK FOR A FREE DATA CONNECTION +COMDC2: SKIPN DATFHN(IDX) ;BOTH FILE HANDLE'S NULL MEANS A FREE ONE + SKIPE DATFHN+1(IDX) + JRST COMDC1 ;NOT FREE, CONTINUE SEARCHING + MOVEM A,DATFHN+1(IDX) ;OUTPUT FILE HANDLE + POP P,DATFHN(IDX) ;AND INPUT FILE HANDLE + MOVEM A,FHNOUT ;FILE HANDLE TO RFC TO: USE THE OUTPUT SIDE +IFN ITS,[ + .CALL [ SETZ + SIXBIT /CHAOSO/ + %CLIN,,CHACHN+1(IDX) + %CLIN,,CHACHN(IDX) + %CLIMM+%CLEND,,15.] + JRST [ SETZM DATFHN(IDX) ;IDX's not really in use + SETZM DATFHN+1(IDX) + CERR NER,[Not enough Chaosnet channels]] + MOVEI A,FHNOUT ;POINT TO IT + SETZ BC, + MOVE BP,[441000,,CTLPKO+%CPKDT] + PUSHJ P,COMSTO ;STRING-OUT TO PACKET, POINTER TO STRING IN A + MOVEI T,%CORFC + DPB T,[CTLPKO+$CPKOP] ;RFC + DPB BC,[CTLPKO+$CPKNB] ;NUMBER OF BYTES + LDB T,[CTLPKI+$CPKSA] + DPB T,[CTLPKO+$CPKDA] + .CALL [ SETZ + SIXBIT /PKTIOT/ + %CLIN,,CHACHN(IDX) + %CLIMM+%CLEND,,CTLPKO] + .LOSE %LSSYS + MOVE T,CHABIT(IDX) ;Get input channel bit + IOR T,CHABIT+1(IDX) ;And output channel bit + .SUSET [.SIMSK2,,T] ;Enable interrupts on these channels +] ;END IFN ITS +IFN TNX,[ + HRROI 1,JFNSTR ;Build output string + HRROI 2,[ASCIZ \CHA:\] + SETZB 3,4 + SOUT + ERCAL SYSBUG + LDB 2,[CTLPKI+$CPKSA] ;Source address + MOVEI 3,8. + NOUT + ERCAL SYSBUG + MOVEI 2,". + IDPB 2,1 + HRROI 2,FHNOUT + SOUT ;Now have: CHA:. + ERCAL SYSBUG + HRLZI 1,(GJ%SHT) ;Short GTJFN to get the channel + HRROI 2,JFNSTR + GTJFN + ERCAL SYSBUG + HRRZM 1,CHAJFN(IDX) ;This is this idx's input and output JFN + HRRZM 1,CHAJFN+1(IDX) + MOVE 2,[100000,,OF%RD\OF%WR] + OPENF ;Listen for connection + ERCAL SYSBUG + MOVE 1,CHAJFN(IDX) ;Set input window size + MOVEI 2,.MOSWS + MOVEI 3,15 + MTOPR + ERCAL SYSBUG + MOVE 1,CHAJFN(IDX) ;Assign interrupt channel + MOVEI 2,.MOACN + MOVE 3,IDX + LSH 3,-1 + MOVE 3,CHAICN(3) ;Output,,Input channels + MTOPR + ERCAL SYSBUG + MOVEI 1,.FHSLF ;Activate the interrupt channel + MOVE 2,CHABIT(IDX) + AIC + SETZM DATJFN(IDX) + SETZM DATDSP(IDX) +] ;END IFN TNX + + MOVEI A,[ASCIZ \DATA-CONNECTION\] + PUSHJ P,COMCTL ;SEND RESPONSE + PUSHJ P,COMSND ;SEND THE CONTROL PACKET + JRST CTLLOP ;RETURN TO MAIN CONTROL CONNECTION WAIT + +COMDC1: SUBI IDX,2 + JUMPGE IDX,COMDC2 ;LOOP IF MORE CHANNELS TO CHECK + CERR NER,[Not enough I/O channels] + +;;; Destroys a data connection +COMUDC: TRNE F,F.FHN ;Must have a file handle + TRZE F,F.NWL ;Not terminated by newline + JRST COMBAD + JUMPGE BC,COMBAD ;But that's all there is + TRO IDX,1 ;Point to top of two channel pair + SKIPGE DATSTA(IDX) ;Channel active? + PUSHJ P,CLOSIT ;Yes, close it + SETZM DATSTA(IDX) ;Make sure channel is deactivated + TRZ IDX,1 ;Now point to bottom of pair + SKIPGE DATSTA(IDX) ;What about this on. Is it active? + PUSHJ P,CLOSIT ;Yes, close it + SETZM DATSTA(IDX) ;Make sure channel is deactivated + MOVEI A,[ASCIZ \UNDATA-CONNECTION\] + PUSHJ P,COMCTL ;Setup control packet + PUSHJ P,CHNFLS ;Flush the chaos channels + PUSHJ P,COMSND ;Send it + JRST CTLLOP ;Return to main loop + + +;;; Flush chaos net channels pointed to by IDX. IDX assumed to point +;;; to the input (even) side. +CHNFLS: +IFN ITS,[ + MOVE T,CHABIT(IDX) + IOR T,CHABIT+1(IDX) + .SUSET [.SAMSK2,,T] ;Turn off interrupts for the two chaos channels of interest + .CALL [ SETZ + SIXBIT /CLOSE/ ;Close the chaos channels + %CLIN+%CLEND,,CHACHN(IDX)] + .LOSE %LSSYS + .CALL [ SETZ + SIXBIT /CLOSE/ + %CLIN+%CLEND,,CHACHN+1(IDX)] + .LOSE %LSSYS +] ;END IFN ITS +IFN TNX,[ + MOVEI 1,.FHSLF + MOVE 2,CHABIT(IDX) + DIC ;Disable the interrupt channel + HRRZ 1,CHAJFN(IDX) ;Close and release JFN + CLOSF + JFCL +] ;END IFN TNX + SETZM DATFHN(IDX) ;Make this pair available for a new data connection + SETZM DATFHN+1(IDX) + POPJ P, + +;;; LOGIN command +COMLOG: TRZN F,F.FHN ;No file handle + TRZE F,F.NWL ;No newline + JRST COMBAD +IFN ITS,[ + PUSHJ P,COMSXI ;Read user id in sixbit + MOVEM A,USERID ;Remember for later + MOVEI A,[ASCIZ \LOGIN \] + PUSHJ P,COMCTL + SKIPE A,USERID + PUSHJ P,GETNAM ;Output uname, hsname and personal name + .SUSET [.SSNAME,,HSNAME] ;Initialize default directory + .SUSET [.SHSNAM,,HSNAME] ; and home directory + .SUSET [.SXUNAM,,USERID] ; and user name +] ;END IFN ITS +IFN TNX,[ + SKIPN ANONUM + JRST [MOVSI 1,(RC%EMO) + HRROI 2,[ASCIZ "ANONYMOUS"] + RCUSR + TLNE 1,(RC%NOM) + SETO 3, + MOVEM 3,ANONUM ;Anonymous's user# + JRST .+1] + JUMPLE BC,CTLDN0 ;Really logout if no arguments + MOVE 2,BP ;Save copy of byte pointer + PUSHJ P,COMEUS ;Eat until space, newline, or end + JUMPL BC,COMBAD ;End of packet is no good + SETZ T, ;Deposit null to terminate string + DPB T,BP +IFN OZ,[ + Push P,2 + Skipn GOTINQ ;Inquire database here? + Jrst [Movei A,IPAGE ;No, so map it in now. + Pushj P,HAKINQ"MAPIN + Jrst BADINQ + Setom GOTINQ + Move A,(P) + Jrst .+2] + Move A,2 + Pushj P,HAKINQ"XLATE ;Lookup and turn into user# + Jrst BADINQ + Movem A,INQADR ;Save address of inquire entry + Movem B,USRNUM ;and user# + Pop P,2 + Jrst COMLCC + +BADINQ: Setzm INQADR ;0 means we have no Inquire information. + Pop P,2 +];OZ Inquire login + MOVSI 1,(RC%EMO) ;Exact match + RCUSR + ERJMP .+2 + TLNE 1,(RC%NOM) ;Matched? + CERR UNK,[User not known] + MOVEM 3,USRNUM ;Save user number +COMLCC: +IFN 20X,[ +IFN $$CCUC,[ ;and then only if turned on at assembly time + MOVEI 1,.FHSLF ;Must enable for GTDIR + RPCAP + MOVE 3,2 + EPCAP + MOVEI 1,0 + MOVE 2,USRNUM + RCDIR ;Get dir number + MOVE 1,3 + MOVEI 2,DIRINF ;Discover user's capabilities + MOVEI 3,0 + SETZM DIRINF + GTDIR + ERCAL SYSBUG + MOVEI 1,.SFCHA ;See if Chaosnet checking is on + TMON + ERJMP COMLG1 ;Not even implemented - skip check + JUMPE 2,COMLG1 ;It's off - skip the check + MOVE 1,DIRINF+.CDPRV ;Check for Chaos net privilege + TRNN 1,SC%CHA + CERR LIP,[No Chaosnet privileges] +COMLG1: +] ;END IFN $$CCUC +] ;END IFN 20X + PUSHJ P,ANONPW + JRST COMLGP ;Need a password, rats. + HRROI 2,JFNSTR + SETZB 3,T ;No account given + JRST COMLG4 + +COMLGP: MOVE 1,USRNUM ;Recover your old usernumber. + MOVE 2,BP ;Beginning of password string + ILDB 3,2 ;Get and save first char + TRZ F,F.ENA + CAIN 3,"* ;Is first letter * ? + TROA F,F.ENA ;Enable + SKIPA 2,BP ;Remember unbumped version + MOVE BP,2 ;Update BP to skip * +IFN 10X, MOVE 3,BP ;Keep a copy to do uppercasing + PUSHJ P,COMEUS ;Find next terminating character + JFCL +IFN 10X,[ ;Tenex LOGIN expects uppercase? +COMLGU: CAMN 3,BP ;Until end of this string + JRST COMLG0 + ILDB T,3 ;Get a character of the password + CAIL T,"a ;and force it to be uppercase + CAILE T,"z + CAIA + SUBI T,40 + DPB T,3 ;Store back the uppercased char + JRST COMLGU +COMLG0: +];END IFN 10X + SETZ T, + DPB T,BP ;Terminate password with null byte + MOVE 3,BP ;This is account string + PUSHJ P,COMEUS ;Then find end of string + JUMPGE BC,COMBAD + SETZ T, + DPB T,BP ;Terminate with null byte + IDPB T,BP ;In case no acct string given + MOVE T,3 + ILDB T,T +IFN 20X,[ + SKIPN T + SETZ 3, ;Use default if empty string +];20X +COMLG4: +IFN 10X,[ + JUMPN T,COMLG3 + PUSH P,2 ;Save password string + MOVEI 1,DIRINF ;Where to put account designator if string + MOVE 2,USRNUM + GDACC + SETZ 1, ;Doesn't seem to have a default, will get error + MOVE 3,1 ;Number or byte pointer + POP P,2 ;Get back password +COMLG3: MOVE 1,USRNUM +];10X + SKIPGE DEBUG + JRST [ PUSHJ P,$HELLO ;If debugging, don't do real login, or enable + JRST COMLG2] + PUSHJ P,$LOGIN + PUSHJ P,JSYSER +IFN OZ,[ ;This doesn't do what we want, alas. +IFN 0,[ + TRNE F,F.LSP + JRST [MOVEI 1,.FHSLF ;((IFF LISPMACHINE)) -- + RPCAP ;Now that you're logged in, read your + MOVE 3,2 ;capabilities, and limit yourself to + EPCAP ;them. + JRST .+1] +];IFN 0 +];OZ +COMLG2: MOVEI A,[ASCIZ \LOGIN \] ;Success reply + PUSHJ P,COMCTL + PUSHJ P,GETNAM +] ;END IFN TNX + PUSHJ P,COMSND ;Completion reply + JRST CTLLOP ;Then we are done + +;;; Auto-login (as Q.SITE or failing that, ANONYMOUS) +;;; This was not thought out. It needs to be redone. + +IFN OZ,[ +AUTLOG: CERR NLI,[Not logged in] +IFN 0,[ +AUTLOG: PUSHJ P,SITEPW ;try to login as + JRST ANNLOG ;Urg, no password file. + HRROI 2,JFNSTR + PUSHJ P,$LOGIN + SKIPA ;double urg, it's WRONG!! + POPJ P, ;ahhh... + +ANNLOG: SETZM USRNUM + PUSHJ P,ANONPW ;Can we can login as Anonymous w/o Password? + CERR NLI,[Can't defaultly log you in - no password file] + HRROI 2,JFNSTR + PUSHJ P,$LOGIN ;Login then, + CERR NLI,[Can't defaultly log you in - incorrect password file] +];IFN 0 + POPJ P, +];OZ + +IFN TNX,[ +;;; Log you in as user#(USERNUM), and turn on what privs you have (or else +;;; leave them all on - See the F.ENA flag in F) - Also, set USERID to +;;; reflect loggedinness. Set subsystem name to "FILE". + +$LOGIN: LOGIN ;Login with specified parameters + POPJ P, ; LOSSAGE + AOS (P) ;Will take success return + GJINF ;Directory# in AC2 + MOVEM 1,USRNUM + MOVEM 2,UDRNUM + TRZN F,F.ENA ;If you want to be priv, don't limit + JRST $HELLO ; yourself, but keep full privs. + MOVEI 1,.FHSLF + RPCAP + MOVE 3,2 + EPCAP ;Enable what capabilities you have. +$HELLO: SETOM USERID ;Means we are logged in +;Now attempt to access all structures +IFN 20X,[ + PUSH P,C + PUSH P,D + MOVE 1,[SIXBIT /DEVNAM/] + SYSGT + HRRZ D,2 ;Table# + MOVEI C,1 ;Should be 1st device name. +ACCST1: HRLZ 1,C + HRR 1,D ;Offset,,table# + GETAB + JFCL +;;[UTexas] The following won't work if # of strs is maximum allowed by monitor +;; HLRZ 2,1 ;If no more devices, it's SIXBIT/STRnnn/ +;; CAIN 2,(SIXBIT /STR/) +;; JRST ACCST9 + MOVE 3,[440700,,DIRINF] +ACCST2: SETZ 2, ;Turn sixbit structure name into asciz + ROTC 1,6 ;string. + ADDI 2,40 + IDPB 2,3 + JUMPN 1,ACCST2 + MOVEI 1,": + IDPB 1,3 + MOVEI 1,"< + IDPB 1,3 + MOVE 1,3 ;Set directory name from our user name + MOVE 2,USRNUM + DIRST + ERJMP ACCST9 + MOVEI 3,"> + IDPB 3,1 ;Terminate user directory + SETZ 3, ;Null to terminate string + IDPB 3,1 +;;Start of UTexas change + PUSH P,1 ;Save BP + HRROI 1,DIRINF ;Set up to get device designator + STDEV + ERJMP [POP P,1 + JRST ACCST9] + MOVE 1,2 ;Set up device designator + DVCHR ;Check device type + ERJMP [POP P,1 + JRST ACCST9] + POP P,1 ;Restore BP + LDB 3,[221100,,2] ;Get DV%TYP + CAIE 3,.DVDSK ;Is it a disk? + JRST ACCST9 ;No, done +;;End of UTexas changes + HRRZ 2,1 ;Get argument block after dir name + ADDI 2,1 ;First unused word after dir that is + MOVE 1,[440700,,DIRINF] ;Directory name string + MOVEM 1,0(2) ;Store as first word of arg block + SETZM 1(2) ;No password supplied + SETOM 2(2) ;And for this job + MOVE 1,[200000,,3] ;Setup for ACCES call + ACCES ;Attempt the Access + ERJMP .+1 ;So what if it fails +ACCST8: AOJA C,ACCST1 ;Step to next structure. +ACCST9: POP P,D + POP P,C + +IFN $$LNM,[ ;Maybe Process LOGICALS.CMD +lnm: move 2,USRNUM + hrli 2,540000 ;Make into directory # + hrroi 1,strbuf + DIRST + erjmp lnm11 + move 2,[440700,,[asciz/LOGICALS.CMD/]] + ildb 3,2 + idpb 3,1 + jumpn 3,.-2 + hrroi 2,strbuf + movsi 1,(gj%sht\gj%old) + GTJFN + erjmp lnm11 + hrlm 1,cmdblk+.CMIOJ + move 2,[.dpb 7,.bp of%bsz,of%rd] + OPENF + erjmp [hlrz 1,cmdblk+.CMIOJ + RLJFN + erjmp lnm11 + jrst lnm11] +lnm1: movei 1,strbsz + movem 1,cmdblk+.CMABC + move 1,[440700,,atmbuf] + movem 1,cmdblk+.CMABP + movei 1,cmdblk + movei 2,[.cmini_9,,0 ? 0 ? 0 ? 0 ? 0] + COMND + erjmp lnm10 + movei 2,[.cmkey_9,,0 ? [1,,1 ? [asciz/DEFINE/],,0] ? 0 ? 0 ? 0] + COMND + erjmp lnm10 + tlne 1,(cm%nop) + jrst lnm1 + ;Some people like to put in the noise words in the command file + movei 2,[.cmnoi_9,,0 ? 440700,,[asciz/logical name/] ? 0 ? 0 ? 0] + COMND + erjmp lnm10 + tlne 1,(cm%nop) + jrst lnm1 + movei 2,[<(cm%po)\.cmdev_9>,,[.cmtok_9,,0 ? 440700,,[asciz/*/] ? 0 ? 0 ? 0] + 0 ? 0 ? 0 ? 0] + COMND + erjmp lnm10 + tlne 1,(cm%nop) + jrst lnm1 + hlrz 3,(3) + movei 4,.CLNJA ;"def *" means delete all logical names + cain 3,.cmtok_9 + jrst lnm4 ;Yup + move 3,cmdblk+.CMABC ;Else find end of the device name + move 4,cmdblk+.CMABP + ildb 2,4 + soj 3, + jumpn 2,.-2 + movem 3,cmdblk+.CMABC ;Will put equivalent name after the device + movem 4,cmdblk+.CMABP + movei 2,[.cmnoi_9,,0 ? 440700,,[asciz/as/] ? 0 ? 0 ? 0] + COMND + erjmp lnm10 + tlne 1,(cm%nop) + jrst lnm1 + movei 2,[.cmcfm_9,,[.cmtxt_9,,0 ? 0 ? 0 ? 0 ? 0] ? 0 ? 0 ? 0 ? 0] + COMND + erjmp lnm10 + tlne 1,(cm%nop) + jrst lnm1 + hlrz 3,(3) + movei 4,.CLNJ1 ;"def name:" means just delete the name + cain 3,.cmcfm_9 + jrst lnm5 ;Yup + movei 4,.CLNJB ;Else have a name to define +lnm4: movei 2,[.cmcfm_9,,0 ? 0 ? 0 ? 0 ? 0] + COMND + erjmp lnm10 + tlne 1,(cm%nop) + jrst lnm1 +lnm5: move 1,4 + move 2,[440700,,atmbuf] + move 3,cmdblk+.CMABP + CRLNM + erjmp .+1 + jrst lnm1 + +lnm10: hlrz 1,cmdblk+.CMIOJ + CLOSF + erjmp lnm11 +lnm11: +];$$LNM +];20X + POPJ P, +];TNX + +;;; HOMEDIR command + +COMHOM: TRZN F,F.FHN ;No file handle + TRZE F,F.NWL ;No newline + JRST COMBAD +IFN ITS,[ + PUSHJ P,COMSXI ;Read user id in sixbit + PUSH P,A ;Save uname + PUSHJ P,GETINQ ;Get inquir entry address in B + SETZ B, ;Not found + POP P,A + SETZ C, ;Now find HSNAME for local host. + MOVEI D,ERRCH + PUSHJ P,LSRTNS"LSRHSN ;D gets the sixbit HSNAME. + JFCL + MOVEI A,[ASCIZ \HOMEDIR \] + PUSHJ P,COMCTL + MOVE A,D ;HSNAMEP + PUSHJ P,COMSXO + MOVEI BYTE,"; + PUSHJ P,COMCHO + PUSHJ P,UNGINQ + PUSHJ P,COMSND + JRST CTLLOP +];ITS +IFN TNX,[ + MOVE 2,BP ;BP to start of user name + PUSHJ P,COMEUS ;Eat until space, newline, or end + SKIPGE BC + IBP BP ;No delimiter + SETZ T, ;Deposit null to terminate string + DPB T,BP +IFE OZ,[ + MOVSI 1,(RC%EMO) ;Exact match + RCUSR + ERCAL SYSBUG ;Monitor internal errors I guess + TLNE 1,(RC%NOM) ;Matched? + CERR UNK,[User not known] + PUSH P,3 ;Save user number + MOVEI A,[ASCIZ \HOMEDIR \] ;Always succeeds if we get here + PUSHJ P,COMCTL + MOVSI 1,(GJ%OLD\GJ%SHT) +IFN 20X,HRROI 2,[ASCIZ /SYS:PEOPLE.DATA/] +IFN 10X,HRROI 2,[ASCIZ /PEOPLE.DATA/] + PUSH P,[0] + GTJFN + JRST COMHM3 + MOVEM 1,(P) ;Save jfn + MOVE 2,[440000,,OF%RD] + OPENF + JRST COMHM3 + HRRZ 3,-1(P) ;User number + RIN + JUMPE 2,COMHM3 ;No information on this user + HLRZ 3,2 + HRRZS 2 + SFPTR + JRST COMHM3 + CAILE 3,INQBLL + MOVEI 3,INQBLL + MOVN 3,3 + MOVE 2,[444400,,INQBLK] + SIN ;Get all data on the person + MOVE A,[440600,,INQBLK+1] ;Byte counts + MOVE B,[440700,,INQBLK+4] ;String starts + SETZ C, ;Current field. + MOVEI T,$DNAME + PUSHJ P,GETFLD ;Output directory name followed by a CR +COMHM2: SKIPE 1,(P) ;Release inquir file + CLOSF + JFCL + PUSHJ P,COMSND + JRST CTLLOP + +COMHM3: HRROI 1,RESBLK ;No inquir entry, default to user's name + MOVE 2,-1(P) ;User number +IFN 20X,TLO 2,40000 + DIRST + JFCL + PUSHJ P,COMRES + JRST COMHM2 +];Regular TOPS-20 +IFN OZ,[ + Push P,2 ;Save copy of BP + Skipn GOTINQ ;Inquire database here? + Jrst [Movei A,IPAGE ;No, so map it in now. + Pushj P,HAKINQ"MAPIN + Jrst NoSUsr + Setom GOTINQ + Jrst .+1] + Move A,(P) + Pushj P,HAKINQ"XLATE ;Lookup and turn into user# + Jrst NoSUsr + Move 3,B + Adjsp P,-1 + Jrst UserNo + +NoSUsr: Movsi 1,(RC%EMO) + Pop P,2 + RCUSR + Erjmp .+2 + Tlne 1,(RC%NOM) + CERR UNK,[User not known] +UserNo: Hrroi 1,RESBLK + Move 2,3 + Hrli 2,540000 ;PS: LH + DIRST + Nop + Movei A,[Asciz "HOMEDIR "] + Pushj P,COMCTL + Pushj P,COMRES + Pushj P,COMSND + Pushj P,CLOINQ + Jrst CTLLOP +];OZ HOMEDIR from new Inquire +];TNX + +IFN ITS,[ +;;; INQUIR hacking +$$ULNM==0 +$$ULNP==0 +$$UNAM==0 +$$HSNM==1 + +LSRTNS"E==T +LSRPGS==200 ;Pages for LSRTNS hacking +NLSPGS==20 ;Reserve 20 of them + +.INSRT SYSENG;LSRTNS > + +;;; Output UNAMEHSNAMEPERNAMGROUP +GETNAM: PUSH P,B + PUSH P,C + PUSH P,D + PUSH P,A + PUSHJ P,GETINQ + JRST [SETZ B, ;No entry there + MOVE A,(P) ;UNAME + PUSH P,B + PUSHJ P,COMSXO + JRST GETNM1] ;And go compute HSNAME. + MOVE A,(P) ;UNAME in A, core addr still in B. + PUSH P,B ;Save INQUIRE entry address + PUSHJ P,COMSXO ;Output UNAME. +GETNM1: MOVEI BYTE,40 + PUSHJ P,COMCHO ;SP. + MOVE A,-1(P) ;Username + MOVE B,(P) ;INQUIR entry + SETZ C, ;Now find HSNAME for local host. + MOVEI D,ERRCH + PUSHJ P,LSRTNS"LSRHSN ;D gets the sixbit HSNAME. + JFCL + MOVE A,D ;Get answer. + MOVEM A,HSNAME + PUSHJ P,COMSXO ;Output HSNAME or nothing. + MOVEI BYTE,215 + PUSHJ P,COMCHO ;NL. + MOVEI A,LSRTNS"I$NAME + MOVE B,(P) ;INQUIRE entry + PUSHJ P,LSRTNS"LSRITM ;Get personal name. + JRST [ MOVE A,[440700,,[ASCIZ /???/]] + JRST .+1 ] + PUSHJ P,COMST0 ;Output PERNAM or nothing. + MOVEI BYTE,215 + PUSHJ P,COMCHO ;NL + MOVEI A,LSRTNS"I$GRP + POP P,B ;INQUIRE entry + PUSHJ P,LSRTNS"LSRITM ;Get Group affiliation. + JRST [ MOVE A,[440700,,[ASCIZ /-/]] + JRST .+1 ] + PUSHJ P,COMST0 ;Output GROUP. +UNMAPL: PUSHJ P,UNGINQ + POP P,A + POP P,D + POP P,C + POP P,B + POPJ P, + +;Get INQUIR entry for uname on the stack, and skip return with inquir entry address in B +GETINQ: MOVEI A,UTILCH ;Channel for LSRTNS + MOVE B,[-NLSPGS,,LSRPGS] + PUSHJ P,LSRTNS"LSRMAP + JRST [CERR NER,[Cannot map INQUIR database]] ;Random error + MOVEI A,UTILCH ;Channels for INQUIR database + MOVE B,-1(P) ;B gets sixbit UNAME. + JRST LSRTNS"LSRUNM ;Map in the LSRTNS entry + +;Flush inquir data base +UNGINQ: MOVE B,[-NLSPGS,,LSRPGS] + .CALL [ SETZ ;Done with these + SIXBIT /CORBLK/ + %CLIMM,,0 + %CLIMM,,%JSELF + SETZ B] + JFCL + .CLOSE UTILCH, + .CLOSE ERRCH, + POPJ P, +] ;END IFN ITS + +IFN TNX,[ +;;; INQUIR hacking +;;; Output USERNAMEDIRECTORYPERSONAL NAMEGROUP + +IFE OZ,[ +$DNAME==0 +$HNAME==1 +$GROUP==14 + +GETNAM: HRROI 1,RESBLK + MOVE 2,USRNUM + DIRST + JFCL + MOVEI 2,0 + IDPB 2,1 + PUSHJ P,COMRES ;Output user name + MOVEI BYTE,40 + PUSHJ P,COMCHO + MOVSI 1,(GJ%OLD\GJ%SHT) +IFN 20X,HRROI 2,[ASCIZ /SYS:PEOPLE.DATA/] +IFN 10X,HRROI 2,[ASCIZ /PEOPLE.DATA/] + PUSH P,[0] + GTJFN + JRST GETNM3 + MOVEM 1,(P) ;Save jfn + MOVE 2,[440000,,OF%RD] + OPENF + JRST GETNM3 + HRRZ 3,USRNUM + RIN + JUMPE 2,GETNM3 ;No information on this user + HLRZ 3,2 + HRRZS 2 + SFPTR + JRST GETNM3 + CAILE 3,INQBLL + MOVEI 3,INQBLL + MOVN 3,3 + MOVE 2,[444400,,INQBLK] + SIN ;Get all data on the person + MOVE A,[440600,,INQBLK+1] ;Byte counts + MOVE B,[440700,,INQBLK+4] ;String starts + SETZ C, ;Current field. + MOVEI T,$DNAME + PUSHJ P,GETFLD + MOVEI T,$HNAME + PUSHJ P,GETFLD +IFN OZ,[ ;Only OZ has groups, but OZ doesn't use this code anymore + MOVEI T,$GROUP + PUSHJ P,GETFLD +];OZ +GETNM2: POP P,1 + JUMPE 1,CPOPJ + CLOSF + JFCL + POPJ P, + +GETFLD: CAMN C,T + JRST GETFL1 + ILDB 1,A +GETFL0: SKIPG 1 + AOJA C,GETFLD + ILDB 2,B + SOJA 1,GETFL0 + + +GETFL1: ILDB T,A +GETFL2: SKIPG T + AOJA C,GETFL3 + ILDB BYTE,B + PUSHJ P,COMCHO + SOJA T,GETFL2 + +GETFL3: MOVEI BYTE,215 + JRST COMCHO +];Non-OZ TOPS-20 Inquire lookup stuff + +IFN OZ,[ +GETNAM: Skipn INQADR ;We have Inquire information? + Jrst GETNM3 ; Nope. +IFN 0,[ + Move A,INQADR ;Address of start of entry + ADD A,HAKINQ"SRDAT ;point to data portion +repeat hakinq"%uname,[ ;Find uname + ildb 1,A + jumpn 1,.-1 + ] + Pushj P,COMSTO +] +.ELSE [ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + Hrroi 1,RESBLK ;** Flush + Move 2,USRNUM ;** this + DIRST ;** when + Nop ;** LMs + Pushj P,COMRES ;** no + Move A,INQADR ;** longer + Add A,HAKINQ"SRDAT ;** compare +repeat hakinq"%dname,[ ;** usernames + Ildb 1,A ;** + Jumpn 1,.-1 ;** + ] +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +] + Movei Byte,40 + Pushj P,COMCHO + Pushj P,COMST0 ;(cheat, 'cause directory's next) + Movei Byte,215 + Pushj P,COMCHO + Move B,A ;Yet MORE cheating, 'cause personal-name + Hrroi A,RESBLK ;comes next + Pushj P,HAKINQ"NPNAME ;(translate into human form) + Jfcl + Pushj P,COMRES ;Output from RESBLK + Movei Byte,215 + Pushj P,COMCHO + Movei 2,HAKINQ"%GROUP-HAKINQ"%PNAME ;Number of fields we need to skip + Sojl 2,COMLGG + Ildb 1,B + Jumpn 1,.-1 + Jrst .-3 + +COMLGG: Ildb Byte,B ;First character of group. + Skipe Byte ;No group? + Pushj P,COMCHO ; Yes, so output character. + Movei Byte,215 + Pushj P,COMCHO ;then all done. + +CLOINQ: Skipn GOTINQ ;If have Inquire database open + Popj P, ; (we don't) + Call HAKINQ"MAPOUT ;then unmap + Skipa ; (failed??) + Setzm GOTINQ ; and mark as disposed of. + Popj P, +];OZ Inquire lookup. + +;;; No INQUIR information +GETNM3: +IFN OZ,[ ;OZ forgot to send this already + HRROI 1,RESBLK ;User name + MOVE 2,USRNUM + DIRST + JFCL + PUSHJ P,COMRES + MOVEI BYTE,40 + PUSHJ P,COMCHO +];OZ + HRROI 1,RESBLK ;Directory name + MOVE 2,USRNUM +IFN 20X,TLO 2,40000 + DIRST + JFCL + PUSHJ P,COMRES + MOVEI BYTE,215 + PUSHJ P,COMCHO + MOVEI A,[ASCIZ /???/] + PUSHJ P,COMSTO + MOVEI BYTE,215 + PUSHJ P,COMCHO +IFE OZ, JRST GETNM2 +IFN OZ, Jrst CLOINQ + + +;;; Before auto-logging as ANONYMOUS, try to login as Q.yourhostname, +;;; which is easier to track. The password is in yourhostname.PASSWORD. + +IFN OZ,[ +IFN 0,[ +SITEPW: SKIPE KLOGIN + JRST SITEP2 + HRROI 1,KLOGIN + HRROI 2,[ASCIZ /Q./] + SETZ 3, + SOUT + HRROI 2,KSITE + SOUT ;Q.hostname in KSITE +SITEP2: MOVSI 1,(RC%EMO) + HRROI 2,KLOGIN + RCUSR + ERJMP CPOPJ ;make sure it exists. + TLNE 1,(RC%NOM) + POPJ P, ; nope. oh well... + MOVEM 3,USRNUM + SKIPE KPASSF + JRST SITEP3 + HRROI 1,KPASSF + HRROI 2,[ASCIZ /PS:/] + SETZ 3, + SOUT + HRROI 2,KSITE + SOUT + HRROI 2,[ASCIZ /.PASSWORD/] + SOUT +SITEP3: HRROI 2,KPASSF + JRST GETPSW +];IFN 0 +];OZ + +;;; Check out the possibilities of an Anonymous login. If the file seen +;;; below exists, then it contains the password for the Anon account. We +;;; skip-return with password in JFNSTR if we find it, else non-skip. The +;;; user# is stored in USRNUM. + +ANONPW: MOVE 1,ANONUM + CAMN 1,[-1] + POPJ P, + SKIPE USRNUM ;If logging in normally, (we already got the USRNUM + CAMN 1,USRNUM ;just return, unless want to be "Anonymous". + SKIPA + POPJ P, + MOVEM 1,USRNUM +IFN 20X,HRROI 2,[ASCIZ /SYSTEM:ANONYMOUS.USERFILE/] +.ELSE HRROI 2,[ASCIZ /ANONYMOUS.USERFILE/] +GETPSW: MOVSI 1,(GJ%OLD\GJ%SHT) + GTJFN + POPJ P, ;File not there - Must specify password. + PUSH P,1 ;Save JFN + MOVE 2,[070000,,OF%RD] + OPENF + JRST [ POP P,1 ;Clean stack, + RLJFN ;release JFN, + JFCL + POPJ P, ] ;and fail-return + MOVE 3,[440700,,JFNSTR] + MOVEI 4,39. +COMLA1: BIN + ERJMP COMLA2 + CAIG 2,40 + JRST COMLA2 + IDPB 2,3 + SOJG 4,COMLA1 +COMLA2: SETZ 2, + IDPB 2,3 ;Make the password string ASCIZ + POP P,1 ;Get back JFN, + CLOSF ;and close the Anonymous userfile. + JFCL + MOVE 1,USRNUM + JRST POPJ1 ;Skip-return -> We win, have Anonymous's password. +];IFN TNX + +;;; Open a file +COMOPN: SKIPN USERID ;Has the user logged in? +IFN OZ, PUSHJ P,AUTLOG +.ELSE CERR NLI,[Not logged in] + TRZ F,F.PRB\F.DEF\F.PDR + TLZ F,(F.CRE\F.SUP\F.APP\F.OVW\F.NEW\F.REN\F.RND\F.TRU) + TRNN F,F.FHN ;MUST HAVE A FILE HANDLE FOR NORMAL OPEN + JRST OPNPRB ;ELSE MUST BE A PROBE + SKIPGE DATSTA(IDX) ;THIS CHANNEL CURRENTLY ACTIVE? + PUSHJ P,CLOSIT ;YES, CLOSE IT +IFN TNX,[ + PUSHJ P,RELDJF ;Dispose of any left-over JFNs this channel is holding + PUSHJ P,RELRJF ;if it err'ed out of a previous open +];TNX +OPNPR0: SETZB D,DATSTA(IDX) ;START OUT FRESH, D WILL CONTAIN NEW LH OF DATSTA + MOVEI T,16. ;DEFAULT DATBYT + MOVEM T,DATBYT(IDX) + MOVEI T,2. ;NUMBER OF BYTES PER WORD + MOVEM T,DATBPW(IDX) +IFN TNX,[ + MOVEI T,36. ;Default file byte size + MOVEM T,DATFBS(IDX) +];TNX + SETZM DATRCV(IDX) ;Start at zero bytes received. +OPNOPT: TRNE F,F.NWL ;NEW LINE TERMINATED OPEN COMMAND? + JRST OPNFNM ;YES, DEFAULT OPTIONS, PARSE FILENAME + PUSHJ P,COMR10 ;GET NEXT TOKEN INTO A,B + JUMPL BC,COMBAD +OPNOLP: MOVSI T,-OPNLEN ;LENGTH OF OPEN OPTION TABLE +OPNOL1: CAMN A,OPNTAB(T) ;MATCH? + CAME B,OPNTAB+1(T) + AOBJN T,[AOJA T,OPNOL1] + JUMPGE T,[CERR UUO,[Unknown OPEN option]] + HRRZS T + LSH T,-1 + XCT OPNACT(T) ;PERFORM APPROPRIATE ACTION + JRST COMBAD ;ERROR + JRST OPNOPT + +OPNTAB: ASCII \READ\ ? 0 ;Read + ASCII \WRITE\ ? 0 ;Write + ASCII \PROBE\ ? 0 ;Probe + ASCII \CHARACTER\ ;Character mode + ASCII \BINARY\ ;Binary mode + ASCII \DEFAULT\ ;Default mode + ASCII \BYTE-SIZE\ ;Byte size specification + ASCII \RAW\ ? 0 ;Raw mode (the bytes as they come) + ASCII \SUPER-IMAG\ ;Super-image -- don't treat rubouts specially + ASCII \SUPER\ ? 0 ;Documented as SUPER-IMAGE but some people send SUPER + ASCII \PRESERVE-D\ ;Preserve-dates + ASCII \INHIBIT-LI\ ;Inhibit-links (ignored except on ITS) + ASCII \DELETED\ ;Deleted files are ok (ignored on ITS) +IFN TNX,[ + ASCII \TEMPORARY\ ;Temporary file + ASCII \FILE-BYTE-\ ;file-byte-size +IFN $$SUBM,[ + ASCII \SUBMIT\ +];$$SUBM +] ;END IFN TNX + ASCII \ESTIMATED-\ ;estimated-length + ASCII \PROBE-DIRE\ ;probe-directory + ASCII \IF-EXISTS\ + ASCII \IF-DOES-NO\ ;if-does-not-exist +OPNLEN==<.-OPNTAB>/2 + +OPNACT: TRNE IDX,1 + TRNN IDX,1 + TROA F,F.PRB + TLZA D,ST.BIN + TLOA D,ST.BIN + JRST [ TRO F,F.DEF + TLO D,ST.BIN + JRST OPNOPT] + JRST OPNBYS + TLOA D,ST.RAW + TLOA D,ST.SUI + TLOA D,ST.SUI + TLOA D,ST.PDT + TLOA D,ST.INL + TLOA D,ST.DEL +IFN TNX,[ + TLOA D,ST.TEM + JRST OPNFBS +IFN $$SUBM,[ + JRST OPNSUB +];$$SUBM +] ;END IFN TNX + JRST OPNELN + TROA F,F.PDR + JRST OPNIFE + JRST OPNIDN +IFN <.-OPNACT>-OPNLEN, .ERR OPNTAB and OPNACT not same length + +OPNBYS: TRNE F,F.NWL ;BETTER NOT HAVE A NEWLINE + JRST COMBAD + PUSHJ P,COMDCI ;READ A NUMBER FROM THE STREAM + JUMPL BC,COMBAD ;MUST HAVE STUFF LEFT + SKIPLE A ;BYTE-SIZE MUST BE BETWEEN 0 AND 16. + CAILE A,16. + CERR IBS,[Illegal byte size] + MOVEM A,DATBYT(IDX) ;SAVE THE BYTE SIZE +ifn tnx,[ + MOVEM A,DATFBS(IDX) ;Save here too +] + MOVE B,A + MOVEI A,36. + IDIV A,B + MOVEM A,DATBPW(IDX) ;REMEMBER BYTES PER WORD + JRST OPNOPT ;AND CONTINUE + +IFN TNX,[ +OPNFBS: TRNN IDX,1 + JRST COMBAD + TRNE F,F.NWL + JRST COMBAD + PUSHJ P,COMDCI + JUMPL BC,COMBAD + SKIPLE A ;File byte size must be between 1 and 36. + CAILE A,36. + CERR IBS,[Illegal file byte size] + MOVEM A,DATFBS(IDX) ;Save it + JRST OPNOPT ;and continue +];TNX + +OPNELN: TRNE F,F.NWL ;BETTER NOT HAVE A NEWLINE + JRST COMBAD + PUSHJ P,COMDCI ;READ A NUMBER FROM THE STREAM + JUMPL BC,COMBAD ;MUST HAVE STUFF LEFT + JRST OPNOPT ;Ignore the estimated length and continue + +OPNIFE: TRNE F,F.NWL ;Better not have a newline + JRST COMBAD + PUSHJ P,COMR10 ;Get IF-EXISTS mode into A and B + JUMPL BC,COMBAD + MOVSI T,-IFETBL +OPNIF1: CAMN A,IFETAB(T) + CAME B,IFETAB+1(T) + JRST [ ADDI T,2 + AOBJN T,OPNIF1 + CERR UUO,[Unknown IF-EXISTS option] ] + IOR F,IFETAB+2(T) + JRST OPNOPT + +IFN TNX,[ +IFN $$SUBMIT,[ +OPNSUB: MOVE A,USRNUM + CAMN A,ANONUM + CERR UUO,[Can't SUBMIT when logged in as Anonymous] + TLO D,ST.SUB + JRST OPNOPT +];$$SUBMIT +];IFN TNX + +IFETAB: ASCII /SUPERSEDE/ ? F.SUP +IFN TNX,[ ;not implemented for ITS yet + ASCII /APPEND/ ? F.APP + ASCII /OVERWRITE/ ? F.OVW + ASCII /TRUNCATE/ ? F.TRU + ASCII /RENAME/ ? F.REN + ASCII /RENAME-AND/ ? F.RND ;RENAME-AND-DELETE + ASCII /ERROR/ ? 0 ? F.NEW +];TNX +IFETBL==<.-IFETAB>/3 + +OPNIDN: TRNE F,F.NWL ;Better not have a newline + JRST COMBAD + PUSHJ P,COMRD5 ;Get IF-DOES-NOT-EXIST mode into A + JUMPL BC,COMBAD + CAMN A,[ASCII/ERROR/] + JRST OPNOPT ;ERROR is the default +IFN TNX,[ ;not implemented for ITS yet + CAME A,[ASCII/CREAT/] +];TNX + JRST [ CERR UUO,[Unknown IF-DOES-NOT-EXIST option] ] + TLO F,(F.CRE) + JRST OPNOPT + +OPNPRB: MOVEI IDX,MAXIDX ;SPECIAL PROBE INDEX + TRO F,F.PRB ;DOING A PROBE + TRNN F,F.NWL ;IF NO OPTIONS, THAT'S OK + JRST OPNPR0 ;Now process options +OPNFNM: HLLM D,DATSTA(IDX) +IFN ITS,[ + PUSHJ P,COMPFN ;PARSE THE FILENAME + SKIPE T,DATSNM(IDX) ;KEEP STICKY DEFAULT DIRECTORY + .SUSET [.SSNAME,,T] + TRNE IDX,1 ;OUTPUT INDEX? + JRST OPNOUT ;YES, HAS TO HAPPEN SOMEWHAT DIFFERENTLY + MOVEI T,.UAI ;ASSUME TEXT MODE + TLNE D,ST.BIN ;UNLESS REALLY BINARY + MOVEI T,.UII + TLNE D,ST.PDT + TRO T,10 + TLNE D,ST.INL + TRO T,20 + TRNE F,F.PDR ;PROBE-DIRECTORY MODE + JRST [ MOVE TT,[SIXBIT/.FILE./] + MOVEM TT,DATFN1(IDX) + MOVE TT,[SIXBIT/(DIR)/] + MOVEM TT,DATFN2(IDX) + JRST .+1 ] + .CALL [ SETZ + SIXBIT /OPEN/ + %CLERR,,ERRCOD + %CLBTW,,T ;Appropriate mode + %CLIN,,DATCHN(IDX) + %CLIN,,DATDEV(IDX) + %CLIN,,DATFN1(IDX) + %CLIN,,DATFN2(IDX) + %CLIN+%CLEND,,DATSNM(IDX)] + PUSHJ P,FILERR + .CALL [ SETZ ;GET TRUENAME TO RETURN TO USER + SIXBIT /RFNAME/ + %CLIN,,DATCHN(IDX) + %CLOUT,,DATDEV(IDX) + %CLOUT,,DATFN1(IDX) + %CLOUT,,DATFN2(IDX) + %CLOUT+%CLEND,,DATSNM(IDX)] + JFCL ;WELL, IT SHOULDN'T BUT... + TLNN D,ST.BIN ;Don't try to QFASLP for text files + JRST OPNFN0 + MOVEI T,1 ;READ THE FIRST WORD OF THE FILE FOR QFASLP + MOVE TT,[444400,,B] ;ONE BYTE INTO B + .CALL [ SETZ + SIXBIT /SIOT/ + %CLIN,,DATCHN(IDX) + %CLIN,,TT + %CLIN+%CLEND,,T] + SETZ B, ;HMMM.... + CAMN B,[SIXBIT/QFASL/] ;QFASL OR QBIN FILE? + JRST OPNQFA ;YES + TRZ B,77_4 ;ALLOW ANY VERSION BELOW 100 + CAMN B,[.BYTE 16. ? 170023 ? 0] ;BIN FILE? +OPNQFA: TROA F,F.QFP ;YES + JRST [TRNN F,F.DEF ;CHARACTERS DEFAULT? + JRST .+1 ;NO + TLZ D,ST.BIN ;YES, NOT BINARY THEN + HLLM D,DATSTA(IDX) + TRNE F,F.PRB + JRST .+1 + JRST OPNACF] ;And need to reopen in case it matters + TRNE F,F.PRB ;This a probe? + JRST OPNFN0 ;Yup, don't bother setting the access pointer back + .CALL [ SETZ ;RESET POINTER TO BEGINNING OF FILE + SIXBIT /ACCESS/ + %CLIN,,DATCHN(IDX) + %CLIMM+%CLEND,,0] + JRST OPNACF ;ACCESS can fail on things like job devices + JRST OPNFN0 + +OPNACF: .CALL [ SETZ + SIXBIT /CLOSE/ + %CLIN+%CLEND,,DATCHN(IDX)] + JFCL ;It can't fail... + MOVEI T,.UAI ;ACCESS failed, so do it the slow way (reopen file) + TLNE D,ST.BIN ;UNLESS REALLY BINARY + MOVEI T,.UII + .CALL [ SETZ + SIXBIT /OPEN/ + %CLERR,,ERRCOD + %CLBTW,,T ;Appropriate mode + %CLIN,,DATCHN(IDX) + %CLIN,,DATDEV(IDX) + %CLIN,,DATFN1(IDX) + %CLIN,,DATFN2(IDX) + %CLIN+%CLEND,,DATSNM(IDX)] + PUSHJ P,FILERR + JRST OPNFN0 + +OPNOUT: MOVEI T,.UAO ;ASSUME TEXT MODE + TLNE D,ST.BIN ;UNLESS REALLY BINARY + MOVEI T,.UIO + .CALL [ SETZ + SIXBIT /OPEN/ + %CLERR,,ERRCOD ;Error code + %CLBTW,,T ;Appropriate mode + %CLIN,,DATCHN(IDX) + %CLIN,,DATDEV(IDX) + %CLIN,,[SIXBIT \_LSPM_\] + %CLIN,,[SIXBIT \OUTPUT\] + %CLIN+%CLEND,,DATSNM(IDX)] + PUSHJ P,FILERR + SETZM DATLEN(IDX) ;Due to ITS lossage must keep our own length for output files +] ;END IFN ITS + +IFN TNX,[ + SETZM DATDSP(IDX) ;No delete or rename when closed (so far) + TRNE F,F.PDR + JRST OPNPDR ;PROBE-DIRECTORY + TRNE IDX,1 + TLO D,ST.OUT ;COMGJF wants output file + SETZM NOTNEW + TLNE F,(F.SUP\F.APP\F.OVW\F.NEW\F.TRU\F.REN\F.RND) + AOS NOTNEW ;Don't create a new version + TLNE F,(F.APP\F.OVW\F.TRU) + TLNE F,(F.CRE) + CAIA + SETOM NOTNEW ;Must have an old file to append to or write over + PUSHJ P,COMGJF ;Get JFN in AC1 + SKIPA + JRST GTRLFL + TLNN F,(F.NEW) + CAIE 1,GJFX27 ;File already exists (new file required) + PUSHJ P,JSYSER ;Error: return it to the user + + ;We have an existing file + SETOM NOTNEW + PUSHJ P,COMGJG ;Try opening again, as an old file... + PUSHJ P,JSYSER ; Oh well... + TLNE F,(F.APP\F.OVW\F.TRU) + JRST GTRLFL ;Use the old file + MOVE T,1 ;Supersede the old file + HRLI T,DD.SUP+DD.OPN ;Remember that we need to close it first + TLNE F,(F.REN) ;Set flags for rename/delete of old file + TLO T,DD.REN + TLNE F,(F.RND) + TLO T,DD.RND + MOVEM T,DATDSP(IDX) + TLNN D,ST.BIN + SKIPA 2,[070000,,OF%RD+OF%PLN+OF%RTD] ;Input/ASCII/no line numbers! + MOVE 2,[440000,,OF%RD+OF%RTD] ;Input, 36-bit + OPENF ;Open file, to lock it. + ERCAL [ MOVSI T,DD.OPN + ANDCAM T,DATDSP(IDX) + CAIE 1,OPNX30 ;"CAN'T OPEN WHEN ARCHIVED" + CAIN 1,OPNX31 ;"FILE OFFLINE" + POPJ P, ;Ignore these errors and supersede without locking + JRST JSYSER ] ;Probably invalid simultaneous access + + HRROI 1,TMPFIL ;Then make a temporary file in the same + HRRZ 2,DATDSP(IDX) ;directory you want the final one... + MOVE 3,[110000,,JS%PAF] + JFNS ;dev: + HRROI 2,[ASCIZ /-TEMPORARY-FILE-./] + SETZ 3, + SOUT + PUSH P,1 + GTAD + MOVE 2,1 + POP P,1 + MOVEI 3,8. + NOUT + JFCL + HRROI 2,[ASCIZ /.-1/] + SETZ 3, + SOUT + + SETZM NOTNEW + HRROI 2,TMPFIL ;and we will write to that one instead. + PUSHJ P,COMGJG + PUSHJ P,JSYSER +GTRLFL: HRRZM 1,DATJFN(IDX) ;JFN for this index + TRNN IDX,1 + JRST [TLNN D,ST.BIN + SKIPA 2,[070000,,OF%RD+OF%PLN];Input/ASCII, no line numbers! + MOVE 2,[440000,,OF%RD] ;Input, 36-bit + JRST .+4] + TLNN D,ST.BIN + SKIPA 2,[070000,,OF%WR] ;Output, ASCII + MOVE 2,[440000,,OF%WR] ;Output, 36-bit + TLNE F,(F.APP) + TRC 2,OF%WR+OF%APP ;Open for append instead + TLNE F,(F.OVW) + TRO 2,OF%RD ;Open for both read and write => don't truncate + TLNE D,ST.PDT + TRO 2,OF%PDT +IFN 20X,PUSHJ P,TRYCON + OPENF ;Open the file + ERCAL OPNJER ;Here if some error + + SETZM DATLEN(IDX) ;Will keep track of file lengths ourself + TRNN IDX,1 ;Output file, don't do QFASL-P check + TLNN D,ST.BIN ;Don't try to QFASLP for text files + JRST OPNFN0 + MOVE 1,DATJFN(IDX) + BIN ;Read byte for QFASL-P + ERJMP OPNNBN ;EOF, not binary + CAMN 2,[SIXBIT/QFASL/] ;QFASL OR QBIN FILE? + JRST OPNQFA ;YES + TRZ 2,77_4 ;ALLOW ANY VERSION BELOW 100 + CAMN 2,[.BYTE 16. ? 170023 ? 0] ;BIN FILE? +OPNQFA: TROA F,F.QFP ;YES + JRST OPNNBN ;NO +OPNNB0: TRNE F,F.PRB ;If a probe, no need to set file pointer back + JRST OPNFN0 + SETZ 2, ;Set pointer back to beginning of file + SFPTR + JRST OPNACF ;For files that can't be set back, just reopen + JRST OPNFN0 + +;Analyze OPENF failure +OPNJER: +IFN 20X,[ + TRNE F,F.PRB ;If probe, don't care if file is unavailable + JRST OPNJE1 ;SO SKIP THIS STUFF + CAIE 1,OPNX31 ;IS THE FILE OFFLINE? + JRST JSYSER ;NO, SIGNAL THE ERROR + SKIPN RETENA ;ARE AUTOMATIC RETRIEVALS ENABLED? + JRST JSYSER ;NO, SIGNAL THE ERROR + TLNE D,ST.RET ;HAVE WE ALREADY TRIED RETRIEVING THIS FILE? + JRST JSYSER ;YES, SIGNAL THE ERROR + MOVE 1,DATJFN(IDX) ;JFN OF FILE TO BE RETRIEVED + HRRZI 2,.ARRFR ;ARCF RETRIEVAL FUNCTION CODE + MOVE 3,[AR%WAT] ;WE WANNA WAIT FOR THE RETRIEVAL + ARCF% ;RETRIEVE THE FILE + ERJMP .+1 ;IGNORE ANY ERRORS + TLO D,ST.RET ;INDICATE THAT WE HAVE TRIED RETRIEVING FILE + MOVE 1,DATJFN(IDX) ;JFN OF FILE + JRST GTRLFL ;AND RETRY OPENING THE FILE + +OPNJE1: +];20X + MOVSI 2,-LERRTB + HLRZ 3,ERRTAB(2) + CAIE 3,(1) + AOBJN 2,.-2 + JUMPGE 2,JSYSER + HRRZ 3,ERRTAB(2) + CAIE 3,'NAV + JRST JSYSER + POP P,3 ;Flush return PC + ;Fall into OPNNBN + +OPNNBN: TRNN F,F.DEF ;CHARACTERS DEFAULT? + JRST OPNNB0 ;NO + TLZ D,ST.BIN ;YES, NOT BINARY THEN + HLLM D,DATSTA(IDX) + TRNE F,F.PRB + JRST OPNNB0 + JRST OPNACF ;And need to reopen in case it matters + +OPNACF: MOVE 1,DATJFN(IDX) + HRLI 1,(CO%NRJ) ;Don't release the JFN + CLOSF + ERCAL SYSBUG + HRRZS 1 + TLNN D,ST.BIN + SKIPA 2,[070000,,OF%RD+OF%PLN] ;Input, ASCII, no line numbers! + MOVE 2,[447400,,OF%RD] ;Input, dump mode + TLNE D,ST.PDT + TRO 2,OF%PDT + OPENF ;Re-open file + ERCAL JSYSER ;Shouldn't happen, but... +];END IFN TOP20 +OPNFN0: MOVEI A,[ASCIZ \OPEN \] + PUSHJ P,COMCTL + SKIPE PTCVER + JRST OPNFN3 + TRNE F,F.PDR + JRST [ MOVEI BYTE,"1 + PUSHJ P,COMCHO + JRST .+2 ] + PUSHJ P,COMVRS + MOVEI BYTE,40 + PUSHJ P,COMCHO +OPNFN3: +IFN ITS,[ + .CALL [ SETZ + SIXBIT /RFDATE/ + %CLIN,,DATCHN(IDX) + %CLOUT+%CLEND,,A] + SETZ A, ;ASSUME 0 IF CALL FAILS +] ;END IFN ITS +IFN TNX,[ + MOVE 1,DATJFN(IDX) + MOVEI 2,A ;Return values starting in A + MOVEI 3,1 ;Want one values (last write date) + SETZ A, + RFTAD + ERCAL ERRPDR +] ;END IFN TNX + PUSHJ P,COMDTO ;OUTPUT DATE/TIME FROM A + MOVEI BYTE,40 + PUSHJ P,COMCHO +IFN ITS,[ + TRNN IDX,1 ;RETURN 0 LENGTH FOR OUTPUT FILES + .CALL [ SETZ + SIXBIT /FILLEN/ + %CLIN,,DATCHN(IDX) + %CLOUT+%CLEND,,A] ;SIZE IN 36 BIT BYTES + SETZ A, ;HMM... +] ;END IFN ITS +IFN TNX,[ + SETZ A, + TRNE IDX,1 + skipge notnew ;GLR output file + caia ; that already exists -- calculate length + JRST OPNFN1 ;Output file, return 0 length + MOVE 1,DATJFN(IDX) + MOVE 2,[2,,.FBBYV] ;Read two words: byte size info, and number of bytes + MOVEI 3,T ;Return info in T and TT + SETZB T,TT + GTFDB + ERCAL ERRPDR + MOVE A,TT + LDB TT,[300600,,T] ;Get byte size + HRLZI T,ST.BIN + TDNN T,DATSTA(IDX) ;If binary mode, do calculation + JRST [CAIN TT,7 ;ASCII mode, was original byte size 7 bits? + JRST OPNFN1 ;Yes, then A contains exact number of bytes + IMULI A,5 ;Else fudge multiplying by number of bytes per word + JRST .+1] ;And do harder calculation + MOVEI T,36. + IDIVI T,(TT) ;And calculate number of bytes per word + ADDI A,-1(T) ;Roundoff correctly + IDIVI A,(T) ;A gets number of words in the file +] ;END IFN TNX + HRLZI T,ST.BIN ;BINARY MODE MULTIPLIES BY APPROPRIATE AMOUNT + TDNN T,DATSTA(IDX) + JRST OPNFN1 ;A HAS ACTUAL LENGTH + IMUL A,DATBPW(IDX) +OPNFN1: MOVEM A,DATLEN(IDX) + PUSHJ P,COMDCO ;OUTPUT IN DECIMAL + MOVEI A,[ASCIZ \ NIL\] ;ASSUME NOT QFASL + TRZE F,F.QFP + MOVEI A,[ASCIZ \ T\] + PUSHJ P,COMSTO ;STRING-OUT THE APPROPRIATE RESPONSE + MOVEI A,[ASCIZ \ NIL\] ;ASSUME NOT CHARACTERS + HRLZI T,ST.BIN + TDNN T,DATSTA(IDX) + MOVEI A,[ASCIZ \ T\] + PUSHJ P,COMSTO +OPNFN2: MOVEI A,[ASCIZ / "/] ;SEND AUTHOR + PUSHJ P,COMSTO +IFN TNX,[ + MOVE 1,DATJFN(IDX) + HRLI 1,.GFLWR + HRROI 2,WRITER + GFUST + ERJMP OPNFN4 + MOVE A,[440700,,WRITER] +];20X +IFN ITS,[SYSCAL RAUTH,[DATCHN(IDX) + %CLOUT,,WRITER] + JRST OPNFN4 + MOVE A,[440600,,WRITER] +];ITS +OPNF2L: ILDB BYTE,A + JUMPE BYTE,OPNFN4 +IFN ITS,ADDI BYTE,40 ;Factor for 6bit -> 7bit + CAIE BYTE,"" + CAIN BYTE,"/ + JRST [PUSH P,BYTE + MOVEI BYTE,"/ + PUSHJ P,COMCHO + POP P,BYTE + JRST .+1] + PUSHJ P,COMCHO + JRST OPNF2L + +OPNFN4: MOVEI BYTE,"" + PUSHJ P,COMCHO + MOVEI BYTE,215 ;A NEWLINE + PUSHJ P,COMCHO + PUSHJ P,COMRFO ;OUTPUT THE REAL FILENAMES + MOVEI BYTE,215 + PUSHJ P,COMCHO + TRZN F,F.PRB + JRST OPNFPS ;IF NOT A PROBE, THEN WE ARE DONE + PUSHJ P,COMSND ;PROBE: REPLY QUICKLY +IFN ITS,[ + .CALL [ SETZ ;A PROBE, SO CLOSE THE CHANNEL, AS WE ARE DONE WITH IT + SIXBIT /CLOSE/ + %CLIN+%CLEND,,DATCHN(IDX)] + JFCL ;HMM...OH WELL +] ;END IFN ITS +IFN TNX,[ + MOVE 1,DATJFN(IDX) ;A probe, so close channel + CLOSF + JRST [ MOVE 1,DATJFN(IDX) ;Might not be open + RLJFN + JFCL + JRST .+1 ] + SETZM DATJFN(IDX) +] ;END IFN TNX + SETZM DATSTA(IDX) ;MAKE SURE WORLD KNOWS CHANNEL IS CLOSED + JRST CTLLOP + +OPNFPS: PUSHJ P,BUFALO ;ALLOCATE A BUFFER + MOVEI T,ST%OPN ;STATE IS NOW OPEN + HRRM T,DATSTA(IDX) + HRLZI T,ST.ACT ;CHANNEL IS NOW ACTIVE + IORM T,DATSTA(IDX) + PUSHJ P,COMSND +IFN ITS,[ + MOVE T,CHABIT(IDX) + .SUSET [.SIMSK2,,T] ;ENABLE INTERRUPTS ON THE CHAOS CHANNEL + ANDCAM T,SSYDF2 ;Update saved copy of DS2 + .SUSET [.SADF2,,T] + .SUSET [.SIIFPIR,,T] ;Start the ball rolling with an interrupt +] ;END IFN ITS +IFN TNX,[ + MOVEI 1,.FHSLF + MOVE 2,CHABIT(IDX) + AIC ;Enable interrupts on this channel + MOVEI 1,.FHSLF + MOVE 2,CHABIT(IDX) + IIC ;Force interrupt on channel to start ball rolling +] ;END IFN TNX + JRST CTLLOP ;WAIT FOR MORE WORK + +IFN ITS,[ +;Send version number over +COMVRS: MOVE TT,DATFN2(IDX) ;RETURN FN2 AS VERSION + ;SEND THE VERSION NUMBER IN DECIMAL OR -1 IF NOT A NUMBER + ;IF PARTIAL NUMBER SEND THAT + MOVEI A,0 ;SET IF ANY DIGITS OUTPUT +COMVR0: MOVEI T,0 + LSHC T,6 + MOVEI BYTE,40(T) + CAIL BYTE,"0 + CAILE BYTE,"9 + JRST COMVR1 + PUSHJ P,COMCHO + MOVEI A,1 + JUMPN TT,COMVR0 +COMVR1: JUMPN A,CPOPJ + MOVEI BYTE,"- + PUSHJ P,COMCHO + MOVEI BYTE,"1 + PUSHJ P,COMCHO + POPJ P, + +;Output filespec to the control stream from DATxxx +COMRFO: MOVE A,DATDEV(IDX) ;DEVICE NAME + CAMN A,[SIXBIT /DSK/] ;If DSK, then send machine name + MOVE A,MACNAM + PUSHJ P,COMSXO + MOVEI A,[ASCIZ \: \] ;COLON TERMINATES DEVICE + PUSHJ P,COMSTO +COMRF2: SKIPN A,DATSNM(IDX) ;THEN SNAME + JRST .+4 + PUSHJ P,COMSXO + MOVEI A,[ASCIZ \; \] ;SEMICOLON TERMINATES SNAME + PUSHJ P,COMSTO + TRNE F,F.PDR + POPJ P, + SKIPN A,DATFN1(IDX) ;FIRST FILENAME + JRST [ SKIPN A,DATFN2(IDX) + POPJ P, + MOVEI BYTE," + PUSHJ P,COMCHO + JRST COMSXO ] + PUSHJ P,COMSXO + SKIPN A,DATFN2(IDX) ;FINALLY, SECOND FILENAME + POPJ P, + MOVEI BYTE,40 ;SPACE ENDS FN1 + PUSHJ P,COMCHO + JRST COMSXO ;TAIL RECURSIVE CALL TO SIXBIT OUTPUT + +;Version of COMRFO which omits the default device entirely rather than plugging in the host +COMRF1: MOVE A,DATDEV(IDX) ;DEVICE NAME + CAMN A,[SIXBIT /DSK/] ;If DSK, then send nothing + JRST COMRF2 + JRST COMRFO +] ;END IFN ITS + +IFN TNX,[ +COMRFO: SKIPA 3,[111110,,JS%PAF] ;Device, directory, filename, file type, version +COMVRS: MOVE 3,[000010,,0] ;Only return generation + TRNE F,F.PDR + TLZ 3,001110 ;Probe-directory gives only device and directory + HRROI 1,RESBLK ;Output to canonical place + MOVE 2,DATJFN(IDX) + JFNS + ERCAL SYSBUG + JRST COMRES ;Output result block to control packet + +;;; 10X/20X PROBE-DIRECTORY +OPNPDR: TRNN F,F.PRB + JRST COMBAD + PUSHJ P,PRSDIR ;Return JFN in 1, directory number in 3 + PUSHJ P,OPNPD1 ;Error + HRRZM 1,DATJFN(IDX) ;Really got some JFN, hang onto it + SETZM DATLEN(IDX) + JRST OPNFN0 + +OPNPD1: CAIE 1,GJFX32 ;Directory empty (no files match specification) + CAIN 1,GJFX19 ;No such file type + JRST POPJ1 + CAIE 1,GJFX24 ;Both Tenex and TOPS-20 can give GJFX24 randomly + CAIN 1,GJFX20 ;I think only Tenex gives GJFX20 + JRST POPJ1 + JRST JSYSER ;Some other error - Complain. + +ERRPDR: TRNN F,F.PDR + JRST SYSBUG + POPJ P, +] ;END IFN TNX + +;PUSHJ P, for errors that are bugs in the system or in this program +SYSBUG: SETOM SYSBGF ;Set flag and drop into normal routine +;Handle failing .CALLs or JSYSes +FILERR: PUSHJ P,OPNERP ;Setup error packet + PUSHJ P,COMSND ;Send the packet + JRST CTLLOP ;Then wait for more work + +IFN TNX,JSYSER=FILERR + +OPNERP: MOVEI A,[ASCIZ \ERROR \] + PUSHJ P,COMCTL ;Start off error packet, open failed error code +IFN TNX,[ + MOVEI 1,.FHSLF + PUSHJ P,$GETER ;Get last error that happened + PUSHJ P,CTLERR + HRRZM 2,ERRCOD ;The number of the error +];TNX + MOVE D,ERRCOD ;Send 3 letter code for this error + PUSHJ P,ERR3 + PUSH P,A ;Save 3-letter code + MOVSS A + PUSHJ P,COMSXO ;Output the 3-letter code + MOVEI A,[ASCIZ \ F \] ;Fatal error + PUSHJ P,COMSTO + PUSHJ P,ERRMSG ;Send the error message + POP P,A ;Restore 3-letter code + CAIE A,'BUG ;If it's a bug, include octal PC +BUGPAT: JRST [ SKIPN DEBUG ;Always include PC if in debugging mode + POPJ P, ;or if BUGPAT is patched to JFCL + JRST .+1 ] + MOVEI A,[ASCIZ \ (at \] + PUSHJ P,COMSTO + HRRZ A,-1(P) ;Caller of FILERR + SUBI A,2 ;Address of errored JSYS or other call + PUSHJ P,COMOCO + MOVEI A,[ASCIZ/ inside FILE server)/] + PUSHJ P,COMSTO + POPJ P, + +;Move 3-letter code for error in D to A +ERR3: MOVEI A,'BUG ;Any errors not in our table must be file server bugs + AOSN SYSBGF + POPJ P, + MOVSI TT,-LERRTB ;Search table for appropriate 3 letter code +ERR3A: HLRZ T,ERRTAB(TT) + CAME T,D + AOBJN TT,ERR3A + HRRZ A,ERRTAB(TT) + POPJ P, + +;Transmit error message to command packet, D has error code. +IFN ITS,[ +ERRMSG: .SUSET [.SPICLR,,[0]] ;ERR device can be used at interrupt level + .CALL [ SETZ ;Now open ERR device to get error message + SIXBIT /OPEN/ + %CLBIT,,.UAI + %CLIMM,,ERRCH + %CLIN,,[SIXBIT /ERR/] + %CLIMM,,4 + %CLIN+%CLEND,,D] + .LOSE %LSSYS +ERRMS1: .IOT ERRCH,BYTE + JUMPLE BYTE,ERRMS2 ;EOF + CAIN BYTE,15 ;CR turns into Return + MOVEI BYTE,215 + CAIL BYTE,40 ;Other control characters are ignored + PUSHJ P,COMCHO + JRST ERRMS1 + +ERRMS2: .CLOSE ERRCH, + .SUSET [.SPICLR,,[-1]] ;Done with use of any shared resources + POPJ P, +];ITS + +IFN TNX,[ +ERRMSG: MOVEI 1,.FHSLF ;ERRBUF can be used at interrupt level + DIR + MOVE 2,D + HRLI 2,.FHSLF + HRROI 1,ERRBUF ;Output to canonical place, error in AC2 + SETZM ERRBUF + MOVEI 3,ERRLEN-1 ;Maximum number of bytes we can handle + ERSTR + JFCL ;Undefined error number?? + JFCL ;Won't fit -- too bad + SKIPE ERRBUF + JRST ERRMS1 + HRROI 1,ERRBUF + HRROI 2,[ASCIZ/Undefined system error code /] + MOVEI 3,0 + SOUT + HRRZ 2,D + MOVEI 3,8 + NOUT + JFCL +ERRMS1: +IFN 10X,[ + SETZ 3, + IDPB 3,1 ;Put in null +];IFN 10X + MOVEI A,ERRBUF + PUSHJ P,COMSTO ;Output the error string + MOVEI 1,.FHSLF ;Okay turn interrupts back on + EIR + POPJ P, +];END IFN TNX + +;;; Close a data channel +COMCLO: TRNN F,F.FHN ;HAVE A FILE HANDLE? + JRST COMBAD ;NOPE, ERROR + JUMPGE BC,COMBAD ;NO OPTIONS TO THE CLOSE COMMAND + SKIPL T,DATSTA(IDX) ;CHANNEL ACTIVE? + CERR BUG,[Channel not open] + TLNE T,ST.DIR ;Was it a directory listing? + JRST COMCLD + MOVEI A,[ASCIZ \CLOSE \];SUCCESSFUL RESPONSE + PUSHJ P,COMCTL ;SETUP CONTROL PACKET +IFN ITS,[ + .CALL [ SETZ + SIXBIT /RFDATE/ + %CLIN,,DATCHN(IDX) + %CLOUT+%CLEND,,CLODAT] + SETZM CLODAT ;ASSUME 0 IF CALL FAILS +] ;END IFN ITS +IFN TNX,[ + MOVE 1,DATJFN(IDX) + MOVEI 2,A ;Return values starting in A + MOVEI 3,1 ;Want one value (last write date) + RFTAD + ERCAL SYSBUG + MOVEM A,CLODAT +] ;END IFN TNX + TRNE IDX,1 ;Input file? + JRST CLOLE0 ;Nope, output, use calculated length +IFN ITS,[ + .CALL [ SETZ + SIXBIT /FILLEN/ + %CLIN,,DATCHN(IDX) + %CLOUT+%CLEND,,A] ;SIZE IN 36 BIT BYTES + SETZ A, ;HMM... +] ;END IFN ITS +IFN TNX,[ + SETZ A, + MOVE 1,DATJFN(IDX) + MOVE 2,[2,,.FBBYV] ;Read two words: byte size info, and number of bytes + MOVEI 3,T ;Return info in T and TT + GTFDB + ERCAL SYSBUG + MOVE A,TT + LDB TT,[300600,,T] ;Get byte size + HRLZI T,ST.BIN + TDNN T,DATSTA(IDX) ;If binary mode, do calculation + JRST [CAIN TT,7 ;ASCII mode, was original byte size 7 bits? + JRST CLOLE1 ;Yes, then A contains exact number of bytes + JRST .+1] ;And do harder calculation + MOVEI T,36. + IDIVI T,(TT) ;And calculate number of bytes per word + ADDI A,-1(T) + IDIVI A,(T) ;A gets number of words in the file +] ;END IFN TNX + HRLZI T,ST.BIN ;BINARY MODE MULTIPLIES BY 2, TEXT MODE BY 5 + TDNN T,DATSTA(IDX) + SKIPA T,[5] ;TEXT: 5 + MOVEI T,2 ;BINARY: 2 + IMULI A,(T) + JRST CLOLE1 + +CLOLE0: MOVE A,DATLEN(IDX) ;Actual number of bytes in file + HRLZI T,ST.BIN + TDNN T,DATSTA(IDX) ;If not binary mode then this is the number we want + JRST CLOLE1 + MOVE T,DATBPW(IDX) + ADDI A,-1(T) ;In order to round up + IDIVI A,(T) ;Calculate number of words in file + IMULI A,(T) ;Then calculate number of bytes rounded up +; JRST CLOLE1 + +CLOLE1: MOVEM A,CLOLEN +IFN ITS, PUSHJ P,CLOSIT ;Close the channel +IFN TNX, PUSHJ P,CLONRJ ;Close, but don't release JFN + SKIPE PTCVER + JRST CLOLE2 + PUSHJ P,COMVRS + MOVEI BYTE,40 + PUSHJ P,COMCHO +CLOLE2: MOVE A,CLODAT + PUSHJ P,COMDTO ;OUTPUT DATE/TIME FROM A + MOVEI BYTE,40 + PUSHJ P,COMCHO + MOVE A,CLOLEN ;FILE LENGTH + PUSHJ P,COMDCO ;OUTPUT IN DECIMAL + MOVEI BYTE,40 + PUSHJ P,COMCHO + MOVE A,DATRCV(IDX) + PUSHJ P,COMDCO + ;; Don't send QFASL info + MOVEI BYTE,215 ;A NEWLINE + PUSHJ P,COMCHO + PUSHJ P,COMRFO ;OUTPUT THE REAL FILENAMES + MOVEI BYTE,215 + PUSHJ P,COMCHO +CLOLED: MOVEI A,CPOPJ ;Routine to call in case mark already received + PUSHJ P,COMSSY ;Send/receive synchronous mark + PUSHJ P,COMSND ;Send control response + HRLZI T,ST.SYN ;Wait for mark to go out, or mark to come in +IFN ITS,[ ; (for output, mark supposed to be here already!) + TDNE T,DATSTA(IDX) + .HANG +] ;END IFN ITS +IFN TNX,[ + PUSHJ P,RELDJF + ;; Nothing winning like .HANG, so use small sleeps + PUSHJ P,$HANG + TDNE T,DATSTA(IDX) +] ;END IFN TNX + SETZM DATSTA(IDX) ;Done with channel now, deactivate it + JRST CTLLOP + +IFN TNX,[ +$HANG: TIME ;Don't wait forever + IMULI 2,30. ;Just 30 seconds + ADD 1,2 + MOVE TT,1 +$HANG1: XCT @(P) + CAIA + JRST POPJ1 + MOVEI 1,1 + DISMS + TIME + CAMG 1,TT + JRST $HANG1 + MOVE 1,[441000,,CTLPKO+%CPKDT] + HRROI 2,[ASCIZ/Timed out waiting for synchronous mark on close/] + SETZ 3, + Sout + IDPB 3,1 + JRST CTLER1 +];TNX + +IFN TNX, CLONRJ: TROA F,F.NRJ +CLOSIT: +IFN TNX, TRZ F,F.NRJ + MOVE T,DATSTA(IDX) + TLNE T,ST.DIR ;Directory command? + JRST CLODIR ;Yes, finish up specially + TRNN IDX,1 ;Output file? + JRST CLOSE0 ;Nope, proceed + HRRZ T,DATSTA(IDX) + CAIN T,ST%OPN ;Write out in-core buffer if channel state is OPEN + PUSHJ P,WRIFOR +IFN ITS,[ + SKIPN DATFN1(IDX) ;Has file been DELEWO'ed? + JRST CLOSE1 ;Yes, don't RENMWO or set author + .CALL [ SETZ + SIXBIT /RENMWO/ + %CLIN,,DATCHN(IDX) + %CLIN,,DATFN1(IDX) + %CLIN+%CLEND,,DATFN2(IDX)] + CERR CRF,[Cannot rename output file to real names] + .CALL [ SETZ + SIXBIT /SAUTH/ + %CLIN,,DATCHN(IDX) + %CLIN+%CLEND,,HSNAME] + JFCL ;Unusual, but not fatal +CLOSE1: .CALL [ SETZ ;GET TRUENAME TO RETURN TO USER + SIXBIT /RFNAME/ + %CLIN,,DATCHN(IDX) + %CLOUT,,DATDEV(IDX) + %CLOUT,,DATFN1(IDX) + %CLOUT,,DATFN2(IDX) + %CLOUT+%CLEND,,DATSNM(IDX)] + JFCL ;WELL, IT SHOULDN'T BUT... +] ;END IFN ITS +IFN TNX,[ +CLOSE0: MOVE 1,DATJFN(IDX) + HRLI 1,(CO%NRJ) ;Close file, but keep around JFN + MOVSI TT,DD.ABT + TDNE TT,DATDSP(IDX) + TLO 1,(CZ%ABT) ;If going to delete, close in abort mode + CLOSF + ERCAL SYSBUG ;Ain't much else we can do... + + TDNE TT,DATDSP(IDX) ;Delete? + JRST [MOVE 1,DATJFN(IDX) ; Yes + HRLI 1,(DF%NRJ) + DELF + ERCAL JSYSER + PUSHJ P,RELRJF ;Not going to rename to real name + JRST CLOSE2] + + MOVE 1,DATDSP(IDX) + TLNE 1,DD.OPN ;Before we can RNAMF this temporary + JRST [ HRLI 1,(CO%NRJ) ;file, it must be closed. + CLOSF + ERCAL SYSBUG + JRST .+1 ] + + MOVE TT,DATSTA(IDX) + HRRZ 1,DATFBS(IDX) + CAIN 1,36. ;Wants fullword? + JRST CLSIT0 ;Yes, no conversison necessary + TLNE TT,ST.BIN ;Is this a binary... + TRNN IDX,1 ; ... WRITE operation? + JRST CLSIT0 ;No, so don't hack the file size + MOVE T,DATLEN(IDX) ;Number of transmission bytes in file + MOVE 3,DATBPW(IDX) ;(do it this way in case lhs is used) + IDIVI T,(3) ;T=number of words + MOVE 3,DATBYT(IDX) + IMULI TT,(3) ;TT=number of bits left over + MOVEI 2,36. ;Convert it all to the file byte size + IDIVI 2,(1) + IMULI T,(2) + MOVE 2,TT + ADDI 2,-1(1) + IDIVI 2,(1) + ADD T,2 + HRRZ 1,DATJFN(IDX) ;Set the byte count + HRLI 1,.FBSIZ\(CF%NUD) ;(minimize the non-atomicity...) + SETO 2, + MOVE 3,T + CHFDB + ERCAL SYSBUG + HRLI 1,.FBBYV ;And now the byte size + MOVSI 2,(FB%BSZ) + SETZ 3, + MOVE T,DATFBS(IDX) + DPB T,[.BP FB%BSZ,3] + CHFDB + ERCAL SYSBUG +CLSIT0: + + MOVE TT,DATDSP(IDX) + TLNN TT,DD.REN\DD.RND ;Get rid of existing file? + JRST CLOSE1 + + HRROI 1,RESBLK ;Get a name to rename it to + HRRZ 2,TT + MOVE 3,[111000,,JS%PAF] + JFNS ;dev:name + ERCAL SYSBUG + HRROI 2,[ASCIZ /.REPLACED-FILE/] + SETZ 3, + SOUT + MOVE 1,[GJ%FOU+GJ%NEW+GJ%SHT+.GJDEF] ;Setup flags to GTJFN + HRROI 2,RESBLK + GTJFN + ERCAL SYSBUG + PUSH P,1 + + HRROI 1,RESBLK ;Make a copy of the JFN so we can rename it + HRRZ 2,TT + MOVE 3,[111110,,JS%PAF] ;Device, directory, filename, file type, version + JFNS + ERCAL SYSBUG + MOVE 1,[GJ%OLD+GJ%SHT+.GJDEF] ;Setup flags to GTJFN + HRROI 2,RESBLK + GTJFN + ERCAL SYSBUG + POP P,2 + RNAMF + ERCAL SYSBUG + MOVE 1,2 + HRLI 1,(DF%NRJ) + TLNE TT,DD.RND + DELF + ERCAL SYSBUG + HRRZS 1 + RLJFN + JFCL +CLOSE1: MOVSI TT,DD.SUP + TDNN TT,DATDSP(IDX) ;Rename over existing file? + JRST CLOSE2 ; No. + + MOVE 1,DATJFN(IDX) ;Old name... + HRRZ 2,DATDSP(IDX) ;...New name + RNAMF + ERCAL JSYSER + HRRZ 1,DATDSP(IDX) + MOVEM 1,DATJFN(IDX) +CLOSE2: SETZM DATDSP(IDX) ;Mark JFN in RH as released. + TRNN F,F.NRJ + PUSHJ P,RELDJF + +] ;END IFN TNX +IFN ITS, CLOSE0: +CLODON: MOVE T,DATSTA(IDX) ;Get channel status +IFN TNX,[ +IFN $$SUBM,[ + TLNN T,ST.SUB + JRST SUBM2 + SKIPE A,QSRPID + JRST SUBM1 +SUBM0: MOVEI 1,3 ;Get QUASAR's PID. + MOVEI 2,QUTILB + MUTIL + JRST [MOVEI A,^D3000 ;Sleep for three seconds + DISMS + JRST SUBM0] + MOVE TT,QSRPID + MOVEM TT,MSENDB+2 ;Save QUASAR's pid in MSEND block. +SUBM1: MOVE TT,[QPBLK,,QSRLOC] ;Blit in the args + BLT TT,QSRLOC+19 + HRROI 1,QSRLOC+8. + MOVE 2,DATJFN(IDX) + MOVE 3,[111110,,JS%PAF] + JFNS + HRRZ 1,1 ;A has last word written. + SUBI 1,QSRLOC+6 ;Number of words plus 1. + HRLM 1,QSRLOC+7 ;Length of block#2 + ADDI 1,7 + HRLM 1,QSRLOC ;Total length of block. + SKIPN YERPID + SKIPA 1,[IP%CFV\IP%CPD] ;Page-long and make us a PID. + MOVEI 1,IP%CFV ;Just page-long send + MOVEM 1,MSENDB+.IPCFL + MOVEI 1,4 + MOVEI 2,MSENDB + MSEND + CERR BUG,[Can't submit file] +SUBM2: +];$$SUBM +];TNX + MOVEI TT,(T) + CAIN TT,ST%OPN ;Was the channel open? + HRRI T,ST%CLO ;Yes, then close it + MOVEM T,DATSTA(IDX) + PUSHJ P,BUFDAL ;DEALLOCATE THE CORE BUFFER +IFN ITS,[ + .CALL [ SETZ + SIXBIT /CLOSE/ + %CLIN+%CLEND,,DATCHN(IDX)] + JFCL ;HMMMM...."I GUESS WE'LL SURVIVE" +] ;END IFN ITS + POPJ P, + +IFN TNX,[ +RELDJF: SKIPN 1,DATJFN(IDX) ;Release data-file JFN, and mark as such. + POPJ P, + HRLI 1,(CZ%ABT) ;Try closing since RLJFN fails if it's open + CLOSF + JFCL +RELDJ1: MOVE 1,DATJFN(IDX) ;Here when not open, to not clobber error code + RLJFN + JFCL + SETZM DATJFN(IDX) + POPJ P, + +RELRJF: HRRZ 1,DATDSP(IDX) + JUMPE 1,CPOPJ + HRLI 1,(CZ%ABT) + CLOSF + JFCL +RELRJ1: HRRZ 1,DATDSP(IDX) ;Here when not open, to not clobber error code + JUMPE 1,CPOPJ + RLJFN + JFCL + SETZM DATDSP(IDX) + POPJ P, +];TNX + +;;; FILEPOS: for input files only +COMFIL: TRNN F,F.NWL ;Can't have a newline + TRNN F,F.FHN ;And must have a file handle + JRST COMBAD + SKIPGE DATSTA(IDX) ;IDX must be active + caia ;GLR And ok if it is write + CERR BUG,[Illegal file handle for FILEPOS] + + trne idx,1 ;GLR if output, + pushj p,wrifor ;GLR send out the leftover characters in buffer + + JUMPL BC,COMBAD ;Also need an argument + PUSHJ P,COMDCI ;Read the arg in decimal + JUMPGE BC,COMBAD ;Better be the end + HRLZI T,ST.BIN ;Is this a binary channel? + TDNN T,DATSTA(IDX) + JRST FILNBN ;Nope, filepos is in A + IDIV A,DATBPW(IDX) ;A is number of words in, B is number of bytes after that + DPB B,[360600,,A] ;Need to save this for interrupt routine +FILNBN: MOVEM A,DATSYN(IDX) ;Location reserved for synchronous routines + MOVEI A,FILSYN ;Routine to call + PUSHJ P,COMSSY ;Setup for the sync mark + MOVEI A,[ASCIZ \FILEPOS\] + PUSHJ P,COMCTL + PUSHJ P,COMSND + HRLZI T,ST.SYN ;Wait for mark to go out +IFN ITS,[ + TDNE T,DATSTA(IDX) + .HANG +] ;END IFN ITS +IFN TNX,[ + ;; Nothing winning like .HANG, so use small sleeps + PUSHJ P,$HANG + TDNE T,DATSTA(IDX) +] ;END IFN TNX + JRST CTLLOP ;Ok, all done, go back for more + +;;; Here after sync mark gets sent. Called from interrupt and main program level +FILSYN: MOVE T,DATSYN(IDX) ;Get word (byte in text mode) address to ACCESS to + TLZ T,770000 ;Clear sub-word +IFN ITS,[ + .CALL [ SETZ + SIXBIT /ACCESS/ + %CLIN,,DATCHN(IDX) + %CLIN+%CLEND,,T] + AERR CPOPJ,WKF,[Cannot set pointer] +] ;END IFN ITS +IFN TNX,[ + MOVE 1,DATJFN(IDX) + MOVE 2,T ;Where pointer is to get set to + SFPTR + AERR CPOPJ,FOR,[Cannot set pointer] ;COULD BE WKF ALSO--- +] ;END IFN TNX + SETZM DATBPT(IDX) ;No state is left + SETZM DATBCT(IDX) + SETZM DATLWD(IDX) + HRRI A,ST%OPN ;Channel is now in open state + TRNE IDX,1 ;Output channel? + POPJ P, ;Yes, then we are done + LDB T,[360600,,DATSYN(IDX)] ;Get number of bytes into first word + JUMPE T,CPOPJ ;If none, then just return. + PUSHJ P,REABUF ;Else read in the next bufferful + SKIPG T,DATBCT(IDX) ;Any bytes to hack? + POPJ P, ;Nope, just return, EOF will be sent next interrupt + LDB TT,[360600,,DATSYN(IDX)] + SUBI T,(TT) ;Calculate number of bytes that will remain in buffer + JUMPLE T,FILSY0 ;If it's gonna be 0 or negative, then EOF + MOVEM T,DATBCT(IDX) ;Else this is the new count + IBP DATBPT(IDX) ;Step the pointer to the appropriate spot + SOJG TT,.-1 + POPJ P, + +FILSY0: SETZM DATBPT(IDX) + SETZM DATBCT(IDX) + SETZM DATLWD(IDX) + POPJ P, + +;;; SET-BYTE-SIZE +COMSBS: JUMPL BC,COMBAD ;End of packet, losing format + TRZE F,F.NWL ;Can't have new line either + JRST COMBAD + SKIPGE T,DATSTA(IDX) ;This channel active? + TLNN T,ST.BIN ;And a binary channel? + CERR WKF,[SET-BYTE-SIZE only allowed for binary file] + PUSHJ P,COMDCI ;Read new byte size in decimal + JUMPL BC,COMBAD + TRZE F,F.NWL + JRST COMBAD + HRLM A,DATBYT(IDX) ;Remember new byte size + TRNE IDX,1 ;Need to set a filepos? + JRST SBSNFP ;Nope, ignore rest of packet + PUSHJ P,COMDCI ;Else read the filepos + IDIV A,DATBPW(IDX) ;A is number of words in, B is number of bytes after that + ; of current position in file + DPB B,[360600,,A] ;Need to save this for interrupt routine + MOVEM A,DATSYN(IDX) +SBSNFP: MOVEI A,SBSSYN ;Routine to call + PUSHJ P,COMSSY ;Setup for the sync mark + MOVEI A,[ASCIZ \SET-BYTE-SIZE\] + PUSHJ P,COMCTL + PUSHJ P,COMSND + HRLZI T,ST.SYN ;Wait for mark to go out +IFN ITS,[ + TDNE T,DATSTA(IDX) + .HANG +] ;END IFN ITS +IFN TNX,[ + ;; Nothing winning like .HANG, so use small sleeps + PUSHJ P,$HANG + TDNE T,DATSTA(IDX) +] ;END IFN TNX + JRST CTLLOP ;Ok, all done, go back for more + +;;; Here upon receipt of synchronous mark +SBSSYN: HLRZS TT,DATBYT(IDX) ;Set up new byte size as current byte size + TRNN IDX,1 ;If reading from file do filepos and return + JRST FILSYN + SKIPE DATBPT(IDX) ;If a byte pointer is around, change its byte size + DPB TT,[360600,,DATBPT(IDX)] + HRRI A,ST%OPN ;Channel is now in open state + MOVEI T,36. ;Calculate and remember number of bytes per word + IDIVI T,(TT) + MOVEM T,DATBPW(IDX) + POPJ P, ;Then we are done + +;;; DELETE, RENAME and other sundry file operations + +;;; DELETE +COMDEL: TRNN F,F.FHN ;Did we have a file handle? + JRST DELFIL ;Nope, filename must be specified + JUMPGE BC,COMBAD ;Must be end of command string here +IFN ITS,[ + .CALL [ SETZ + SIXBIT /DELEWO/ + %CLIN+%CLEND,,DATCHN(IDX)] + JFCL ;Can't fail, can it?? + SETZM DATFN1(IDX) ;Flag file as deleted +] ;END IFN ITS +IFN TNX,[ + MOVSI TT,DD.ABT + IORM TT,DATDSP(IDX) ;Flag for deletion later +] ;END IFN TNX + MOVEI A,[ASCIZ \DELETE\] + PUSHJ P,COMCTL + PUSHJ P,COMSND + JRST CTLLOP + +DELFIL: TRZN F,F.NWL ;Newline? + JRST COMBAD ;Nope, bad command format + MOVEI IDX,MAXIDX ;Use the temporary channel for this +IFN ITS,[ + PUSHJ P,COMPFN ;Parse the filename to be deleted + TRZN F,F.NWL ;Check for correct format + JRST COMBAD + SKIPE T,DATSNM(IDX) ;Keep sticky default directory + .SUSET [.SSNAME,,T] + .CALL [ SETZ + SIXBIT /DELETE/ + %CLERR,,ERRCOD ;Error code + %CLIN,,DATDEV(IDX) + %CLIN,,DATFN1(IDX) + %CLIN,,DATFN2(IDX) + %CLIN+%CLEND,,DATSNM(IDX)] + PUSHJ P,FILERR ;File error, tell about it +] ;END IFN ITS +IFN TNX,[ + SETZ D, ;COMGJF wants input file + PUSHJ P,COMGJF ;Get JFN + PUSHJ P,JSYSER ;Error, return it to the user + HRRZM 1,DATJFN(IDX) ;Save JFN +IFN 20X,PUSHJ P,TRYCON + DELF + ERCAL JSYSER +] ;END IFN TNX + MOVEI A,[ASCIZ \DELETE\] + PUSHJ P,COMCTL + PUSHJ P,COMSND + JRST CTLLOP + + +;;; RENAME +COMREN: TRZN F,F.NWL ;Both formats require newline + JRST COMBAD + TRNN F,F.FHN ;Use an open file? + JRST RENFIL ;Nope, need two filenames +IFN ITS,[ + PUSH P,DATDEV(IDX) + PUSH P,DATSNM(IDX) + PUSHJ P,COMPFN ;Parse the filename + TRZN F,F.NWL ;Must be terminated by newline + JRST COMBAD + POP P,B ;Old directory + POP P,A ;Old device + PUSHJ P,RNMCHK + TRNE IDX,1 ;An output file? + JRST RENCOM ;Yes, using a temp name anyway, just proceed + .CALL [ SETZ + SIXBIT /RENMWO/ + %CLERR,,ERRCOD ;Error code + %CLIN,,DATCHN(IDX) + %CLIN,,DATFN1(IDX) + %CLIN+%CLEND,,DATFN2(IDX)] + PUSHJ P,FILERR + MOVEI A,[ASCIZ \RENAME\] + PUSHJ P,COMCTL + MOVEI BYTE,215 ;A NEWLINE + PUSHJ P,COMCHO + .CALL [ SETZ ;GET TRUENAME TO RETURN TO USER + SIXBIT /RFNAME/ + %CLIN,,DATCHN(IDX) + %CLOUT,,DATDEV(IDX) + %CLOUT,,DATFN1(IDX) + %CLOUT,,DATFN2(IDX) + %CLOUT+%CLEND,,DATSNM(IDX)] + JFCL ;WELL, IT SHOULDN'T BUT... + PUSHJ P,COMRFO ;OUTPUT THE REAL FILENAMES + PUSHJ P,COMSND + JRST CTLLOP + +;Here, the real filenames are not known yet. +RENCOM: MOVEI A,[ASCIZ \RENAME\] + PUSHJ P,COMCTL + PUSHJ P,COMSND + JRST CTLLOP + +] ;END IFN ITS +IFN TNX,[ + HRLZI D,ST.OUT ;COMGJF wants output file + SETZM NOTNEW + PUSHJ P,COMGJF ;Get a JFN for the file + PUSHJ P,JSYSER + MOVE 2,DATDSP(IDX) ;2 gets "current" (may not have that name yet really) + TLNN 2,DD.SUP + MOVE 2,DATJFN(IDX) + PUSHJ P,RENTNM ;Build return packet + HRLI 1,DD.SUP + PUSH P,1 ;Save new name + PUSHJ P,RELRJF ;Dispose of old DATDSP file name + POP P,DATDSP(IDX) ;Defer processing until file gets closed + PUSHJ P,COMSND + JRST CTLLOP +];END IFN TNX + +RENFIL: MOVEI IDX,MAXIDX ;A phony IDX to use +IFN ITS,[ + PUSHJ P,COMPFN ;Parse the from filename + TRZN F,F.NWL ;Must have trailing newline + JRST COMBAD + SKIPE T,DATSNM(IDX) ;Keep sticky default directory + .SUSET [.SSNAME,,T] +IRPS WHAT,,[DATDEV,DATFN1,DATFN2,DATSNM] + PUSH P,WHAT(IDX) +TERMIN + PUSHJ P,COMPFN ;Parse the next filespec + TRZN F,F.NWL + JRST COMBAD + MOVE A,-3(P) ;DATDEV + MOVE B,0(P) ;DATSNM + PUSHJ P,RNMCHK + .CALL [ SETZ + SIXBIT /RENAME/ + %CLERR,,ERRCOD + %CLIN,,A + %CLIN,,-2(P) + %CLIN,,-1(P) + %CLIN,,B + %CLIN,,DATFN1(IDX) + %CLIN+%CLEND,,DATFN2(IDX)] + PUSHJ P,FILERR ;Report file error + SUB P,[4,,4] ;Not really necessary, but get rid of pushed cruft + JRST RENCOM + +RNMCHK: MOVE T,DATDEV(IDX) ;Both devices must be the same. + CAMN T,MACNAM + MOVE T,[SIXBIT/DSK/] + CAMN A,MACNAM + MOVE A,[SIXBIT/DSK/] + CAME A,T + JRST [ CERR RAD,[Cannot rename across devices] ] + SKIPN B + .SUSET [.RSNAME,,B] + SKIPN DATSNM(IDX) + MOVEM B,DATSNM(IDX) ;dir of second file defaults to the first one's. + CAMN B,DATSNM(IDX) + POPJ P, ;They must also be the same. + CERR RAD,[Cannot rename across directories] +] ;END IFN ITS + +IFN TNX,[ + SETZ D, ;Get input file first + PUSHJ P,COMGJF ;Get JFN for file + PUSHJ P,JSYSER ;Can't get JFN, so return + MOVEM 1,DATDSP(IDX) ;Save source JFN + TLO D,ST.OUT ;Next file is 'output' file + SETZM NOTNEW + PUSHJ P,COMGJF + PUSHJ P,RELINF ;Can't get output JFN, so release input JFN (doesn't return) + MOVE 2,DATDSP(IDX) + PUSHJ P,RENTNM ;Build response packet presuming success + MOVE 2,1 + MOVE C,1 ;Remember target in case of error + MOVE 1,DATDSP(IDX) +IFN 20X,[ + MOVEM 1,DATJFN(IDX) ;Implicit arg to TRYCON + PUSHJ P,TRYCON +];20X + RNAMF + ERCAL [MOVE 1,C + RLJFN + JFCL + IFN 20X,SETZM DATJFN(IDX) + JRST RELINF] + MOVE 1,C + RLJFN + JFCL +IFN 20X,SETZM DATJFN(IDX) + PUSHJ P,COMSND + JRST CTLLOP + +RELINF: PUSHJ P,RELRJ1 ;Release DATDSP(IDX) + JRST JSYSER + +;Store target truename from JFN in 1, and source truename from 2 +;into success packet, to be sent later if we succeed. Preserves 1. +RENTNM: PUSH P,1 + PUSH P,2 + MOVEI A,[ASCIZ \RENAME\] + PUSHJ P,COMCTL + MOVEI BYTE,215 + PUSHJ P,COMCHO + HRROI 1,RESBLK ;Target truename + MOVE 2,-1(P) + MOVE 3,[111110,,JS%PAF] ;Device, directory, filename, file type, version + JFNS + ERCAL SYSBUG + PUSHJ P,COMRES + MOVEI BYTE,215 + PUSHJ P,COMCHO + HRROI 1,RESBLK ;Source truename + POP P,2 + MOVE 3,[111110,,JS%PAF] ;Device, directory, filename, file type, version + JFNS + ERCAL SYSBUG + PUSHJ P,COMRES +POP1J: POP P,1 + POPJ P, +];END IFN TNX + +;;; CONTINUE command. Continue processing after a recoverable asynchronous error +COMCON: JUMPGE BC,COMBAD ;Better not have any more stuff + TRNN F,F.FHN ;Need a file handle + JRST COMBAD + SKIPL A,DATSTA(IDX) ;Channel must be active +CONCCC: CERR BUG,[Channel cannot continue] + MOVEI T,ST%ASY ;Must be in async mark state + CAIN T,(A) + TLNE A,ST.UNC ;And must be continuable + JRST CONCCC + HRRI A,ST%OPN ;Ok, so fix up + MOVEM A,DATSTA(IDX) + MOVEI A,[ASCIZ \CONTINUE\] + PUSHJ P,COMCTL ;Send completion response + PUSHJ P,COMSND +IFN ITS,[ + .CALL [ SETZ ;Continue the interrupted I/O operation + SIXBIT /SIOT/ + %CLIN,,DATCHN(IDX) + %CLIN,,DATBPT(IDX) + %CLIN+%CLEND,,DATBCT(IDX)] + JRST CONERR ;Another IOC error, didn't really fix the problem + .SUSET [.SPICLR,,[0]] ;Don't allow interrupts, and the continuation better not + ; do anything that causes them! +] ;END IFN ITS +IFN TNX,[ + PUSHJ P,DOSIO ;Continue I/O operation + JRST CONERR + MOVEI 1,.FHSLF + DIR +] ;END IFN TNX + MOVE A,DATSTA(IDX) + PUSHJ P,@DATICN(IDX) + MOVEM A,DATSTA(IDX) +IFN ITS,[ + .SUSET [.SPICLR,,[-1]] + MOVE T,CHABIT(IDX) + ANDCAM T,SSYDF2 ;Update saved copy of DF2 (can't hurt even if not masked) + TRNE IDX,1 ;Undefer interrupts if necessary + .SUSET [.SADF2,,T] + .SUSET [.SIIFPIR,,T] ;Cause interrupt to start the ball rolling +] ;END IFN ITS +IFN TNX,[ + MOVEI 1,.FHSLF ;Turn interrupt system back on + EIR + MOVEI 1,.FHSLF + MOVE 2,CHABIT(IDX) + AIC ;Reenable interrupts on this channel + IIC ;Force interrupt on channel to start ball rolling +] ;END IFN TNX + JRST CTLLOP ;Then done + +CONERR: +IFN ITS,[ + .SUSET [.SPICLR,,[0]] ;Using shared resources, prevent timing screws +] ;END IFN ITS +IFN TNX,[ + MOVEI 1,.FHSLF + DIR +] ;END IFN TNX + PUSH P,DATICN(IDX) ;Save important stuff over the IOC error emission + MOVE A,DATSTA(IDX) ;ICCERR wants status in A + MOVEI D,DATICN-1(IDX) ;And continuation in c(1(D)) + PUSHJ P,[PUSHJ P,ICCERR] ;*K*L*U*D*G*E* + POP P,DATICN(IDX) +IFN ITS,[ + .SUSET [.SPICLR,,[-1]] +] ;END IFN ITS +IFN TNX,[ + MOVEI 1,.FHSLF + EIR +] ;END IFN TNX + JRST CTLLOP ;Then done + +IFN TNX,[ +DOSIO: MOVE 1,DATJFN(IDX) + MOVE 2,DATBPT(IDX) + MOVN 3,DATBCT(IDX) + JUMPE 3,DOSIO1 + TRNE IDX,1 + JRST DOSIOO ;Output + SIN + ERJMP .+1 +DOSIO1: PUSHJ P,ITSBP ;Turn BP in AC2 into an ITS standard byte pointer + MOVEM 2,DATBPT(IDX) + MOVNM 3,DATBCT(IDX) + SKIPN 3 ;Means we didn't make it all out + AOS (P) + POPJ P, +DOSIOO: SOUT + ERJMP DOSIO1 + JRST DOSIO1 + +ITSBP: PUSH P,T + LDB T,[360600,,2] ;PP field of BP in AC2 + JUMPN T,ITSBP0 ;Some bits left, so is ok + MOVEI T,44 ;Make agree with ITS -- point off left of next word + DPB T,[360600,,2] + AOS 2 +ITSBP0: POP P,T + POPJ P, +] ;END IFN TNX + +;;; Directory command +DATNDR==:DATBYT ;Next directory, 0 = start, -1 = done +IFN ITS,[ +DATDRP==:DATBPW ;File being processed (index to UFD) +.INSRT SYSTEM;FSDEFS +] ;END IFN ITS +IFN TNX,[ +DATDRN==:DATBPW ;Directory number being processed +] + +COMPRO: TRZA F,F.DIR +COMDIR: TRO F,F.DIR + SKIPN USERID +IFN OZ, PUSHJ P,AUTLOG +.ELSE CERR NLI,[Not logged in] + TRNN F,F.FHN ;Must have file handle + CERR BUG,[Must have a file handle] + TRNE IDX,1 ;Input index? + CERR BUG,[Channel wrong direction] + SKIPGE DATSTA(IDX) + PUSHJ P,CLOSIT ;Close open channel + SETZM DATSTA(IDX) + MOVSI D,ST.DIR + TRZN F,F.DIR + TLO D,ST.PRO +DIROPT: TRNE F,F.NWL ;End of options? Or no file handle in PROPERTIES + JRST DIRFNM + TLNE D,ST.PRO + JRST COMPR1 ;PROPERTIES command with a file handle + PUSHJ P,COMRD5 ;Get token + JUMPL BC,COMBAD +DIROLP: MOVEI T,DIRLEN-1 +DIROL1: CAME A,DIRTAB(T) + SOJGE T,DIROL1 + JUMPL T,[CERR UUO,[Unknown DIRECTORY option]] + XCT DIRACT(T) + JRST COMBAD + JRST DIROPT + +DIRTAB: ASCII \DELET\ ;Allow deleted files as well + ASCII \FAST\ + ASCII \NO-EX\ + ASCII \DIREC\ + Ascii \SORTE\ +DIRLEN==.-DIRTAB + +DIRACT: TLOA D,ST.DEL + TLOA D,ST.FST + SKIPA + TLOA D,ST.ALD + SKIPA + +;PROPERTIES command with a file handle +COMPR1: PUSHJ P,COMRD5 ;Get file handle + JFCL + JUMPGE BC,COMBAD ;Shouldn't have anything left over + MOVEI B,MAXIDX-1 ;LOOP OVER ALL INDICES +COMPR2: CAMN A,DATFHN(B) ;MATCH? + JRST COMPR3 ;YUP + SOJGE B,COMPR2 + CERR BUG,[Unknown file handle argument to PROPERTIES] +COMPR3: +IFN TNX,[ + MOVE 1,DATJFN(B) + TLZ D,ST.NOK + JRST SVDFLG + +;PROPERTIES command with a file name joins +COMPR4: TLO D,ST.DEL\ST.NOK ;ST.NOK means we have a JFN to get rid of + PUSHJ P,COMGJF ;Get JFN in AC1 + PUSHJ P,JSYSER + JRST SVDFLG +];TNX + +IFN ITS,[ + MOVE B,DATCHN(B) + .CALL [ SETZ ;Need device and directory names + SIXBIT /RFNAME/ + %CLIN,,B + %CLOUT,,DATDEV(IDX) + %CLOUT,,DATFN1(IDX) + %CLOUT,,DATFN2(IDX) + %CLOUT+%CLEND,,DATSNM(IDX)] + PUSHJ P,SYSBUG + JRST COMPR5 + +;PROPERTIES command with a file name joins +COMPR4: .CALL [ SETZ + SIXBIT /OPEN/ + %CLERR,,ERRCOD + %CLBTW,,.UAI+30 ;preserve dates, inhibit links + %CLIN,,DATCHN(IDX) + %CLIN,,DATDEV(IDX) + %CLIN,,DATFN1(IDX) + %CLIN,,DATFN2(IDX) + %CLIN+%CLEND,,DATSNM(IDX)] + PUSHJ P,FILERR + MOVE B,DATCHN(IDX) +COMPR5: MOVEM B,DATFN1(IDX) ;Save channel number in weird place + JRST COMPR6 +];ITS + +DIRFNM: +IFN ITS,[ + TLNN D,ST.PRO + SETOM STARF2 ;We want * for default FN2 + PUSHJ P,COMPFN ;Parse the filename spec + SETZM STARF2 + SKIPE T,DATSNM(IDX) ;KEEP STICKY DEFAULT DIRECTORY + .SUSET [.SSNAME,,T] + TLNE D,ST.PRO + JRST COMPR4 + MOVSI T,(SIXBIT/*/) + SKIPN DATFN1(IDX) + MOVEM T,DATFN1(IDX) +COMPR6: PUSHJ P,LCKDIR ;Get DIRLCK + PUSHJ P,GETMFD ;Read in the MFD + PUSHJ P,[ HLRZ A,DATDEV(IDX) ;Archive devices just say they cannot work. + TRZ A,77 + CAIE A,(SIXBIT /AR/) + JRST [ SETZM DIRLCK ? JRST FILERR ] + MOVEI A,[ASCIZ \ERROR \] + PUSHJ P,COMCTL ;Start off error packet, open failed error code + MOVEI A,[ASCIZ \WKF F CANNOT LIST ARCHIVE DEVICE\] + PUSHJ P,COMSTO + PUSHJ P,COMSND + JRST CTLLOP ] + +;The following might be nice, but the directory format of archives is evidently +;not 100% compatible since we get an MPV trying to look at the descriptors. +;So we give an error if we try to take the directory of an archive. +;Note that it is necessary to read in the MFD even if the sname is not wildcarded, +;since the MFD is needed to decode file authors. + +IFN 0,[ PUSHJ P,[ HLRZ A,DATDEV(IDX) ;Kludge around for archives + TRZ A,77 + CAIE A,(SIXBIT/AR/) + JRST [ SETZM DIRLCK ? JRST FILERR ] ;Device doesn't exist? + PUSH P,DATDEV(IDX) + MOVSI A,'DSK + MOVEM A,DATDEV(IDX) + PUSHJ P,GETMFD + JRST [ POP P,DATDEV(IDX) ? SETZM DIRLCK ? JRST FILERR ] + POP P,DATDEV(IDX) + POPJ P, ] +];IFN 0 + +;; Allocate space for directory mapping + MOVEI T,DIRBUF/2000 + PUSHJ P,PAGALO + SETZM DATDRP(IDX) +] ;END IFN ITS + +IFN TNX,[ + TLNE D,ST.PRO + JRST COMPR4 + TLNE D,ST.ALD + JRST [ TLO D,ST.PON ;Do parse only + SETZM DATDRN(IDX) + JRST .+1] + PUSHJ P,COMGDJ ;Get directory JFN, with wildcards + JRST DIREMP + +SVDFLG: MOVEM 1,DATJFN(IDX) ;Save it, +DRNFIL: +] ;END IFN TNX +IFN ITS,[ + PUSHJ P,DIRSI2 ;See if dir exists. + PUSHJ P,FILERR ;Failure. +];ITS + SETZM DATNDR(IDX) ;Success, or hard to tell. Will start listing next time around + HLLM D,DATSTA(IDX) ;Save status bits + MOVEI A,[ASCIZ \DIRECTORY\] + TLNE D,ST.PRO + MOVEI A,[ASCIZ \PROPERTIES\] + PUSHJ P,COMCTL + JRST OPNFPS ;Finish up like open + +IFN TNX,[ +;GTJFN error code in 1 +DIREMP: SETZM DATJFN(IDX) ;Make sure cleared out from last time. + CAIE 1,GJFX32 ;Directory empty (no files match specification) + CAIN 1,GJFX19 ;No such file type + JRST DRNFIL ;Yes, give directory stream with no files in it + CAIE 1,GJFX24 ;Both Tenex and TOPS-20 can give GJFX24 randomly + CAIN 1,GJFX20 ;I think only Tenex gives GJFX20 + JRST DRNFIL + PUSHJ P,JSYSER ;Some other error - Complain. +];TNX + +IFN ITS,[ +;Skip if requesting either multiple directories or a single directory which exists. +;Do not skip if requesting a single directory which does not exist. +;If requesting a single directory which exists, +;we also read it in, so you can omit doing so later. +DIRSI2: MOVE TT,DATSNM(IDX) ;Get directory requested +DIRSI0: JUMPE TT,DIRSI1 ;Simple case, no directory wildcards + SETZ T, + LSHC T,6 + CAIE T,'* ;A wildcard specifier? + JRST DIRSI0 + JRST POPJ1 + +;; Simple case, only one directory +;; Try to read it in now; if we fail, report an error now. +DIRSI1: MOVE A,DATSNM(IDX) + MOVSI T,ST.ALD + TDNE T,DATSTA(IDX) ;Just wants directory names, not contents, => skip. + JRST POPJ1 + PUSHJ P,GETUF1 + POPJ P, + JRST POPJ1 +];ITS + +;;; Come here from REABUF when need some more input from a directory listing +;;; T has byte pointer to store into, TT has byte count +REDRBF: PUSH P,A + PUSH P,B ;Save some ac's + PUSH P,BC + PUSH P,BP + +;; Directory loop, try to fill buffer with all info on one file, if we run out of room, +;; we back up the pointer to before the current file and return with that + MOVE BP,T + MOVE BC,TT + MOVE D,DATSTA(IDX) + SKIPN DATNDR(IDX) ;First time? + PUSHJ P,DIRHED ;Yes, print header + PUSH P,BP ;Save byte pointer + PUSH P,BC ;and counter + MOVEM P,DIRPDL ;Save stack pointer + +REDRB0: PUSHJ P,DIRFIL ;Do one file + JRST REDBF1 ;No file to do + MOVEM BP,-1(P) ;Save updated byte pointer + MOVEM BC,(P) ;and count + JRST REDRB0 + +;; Done filling buffer, restore state and return +REDBF1: MOVE P,DIRPDL + POP P,TT ;Restore byte count + POP P,T ;and pointer + POP P,BP + POP P,BC + POP P,B + POP P,A + JRST REABF3 ;Return to main body of code + +;;; Come here from COMCLO for directory channel +COMCLD: PUSHJ P,CLOSIT + MOVEI A,[ASCIZ \CLOSE\] + PUSHJ P,COMCTL + JRST CLOLED + +;;; Come here from CLOSIT when done with a directory channel +CLODIR: +IFN ITS,[ + MOVE TT,DATFN1(IDX) + TLNE T,ST.PRO + CAME TT,DATCHN(IDX) + JRST CLODI1 + .CALL [ SETZ ;If we opened a file, close it + SIXBIT/CLOSE/ + SETZ DATCHN(IDX) ] + JFCL +CLODI1: MOVEI T,MFDBUF/2000 + PUSHJ P,PAGDAL + MOVEI T,DIRBUF/2000 + PUSHJ P,PAGDAL + SETZM DIRLCK + MOVE T,DATSTA(IDX) ;Restore channel status +];END IFN ITS +IFN TNX,[ + TLNE T,ST.PRO + TLNN T,ST.NOK + JRST CLODI1 + MOVE 1,DATJFN(IDX) ;If we got a JFN, release it + RLJFN + ERJMP .+1 +CLODI1: +];TNX + MOVEI TT,(T) + CAIN TT,ST%OPN ;Was the channel open? + HRRI T,ST%CLO ;Yes, then close it + MOVEM T,DATSTA(IDX) + JRST BUFDAL ;Deallocate the core buffer and return + +IFN ITS,[ +;; Lock the lock for the MFD and UFD pages and associated variables +LCKDIR: SKIPE T,DIRLCK + CAIN IDX,(T) + SKIPA + CERR NER,[Can't have more than one directory open at a time] + HRROM IDX,DIRLCK ;Something random + POPJ P, + +;; Map in the MFD +GETMFD: MOVEI T,MFDBUF/2000 + PUSHJ P,PAGALO + .CALL [ SETZ + SIXBIT /OPEN/ + %CLERR,,ERRCOD + %CLBTW+%CLIMM,,.UII + %CLIMM,,UTILCH + %CLIN,,DATDEV(IDX) + %CLIN,,[SIXBIT /M.F.D./] + %CLIN,,[SIXBIT /(FILE)/] + %CLIN+%CLEND,,DATSNM(IDX)] + POPJ P, + MOVEI T,2000 + MOVE TT,[444400,,MFDBUF] + .CALL [ SETZ + SIXBIT /SIOT/ + %CLERR,,ERRCOD + %CLIMM,,UTILCH + %CLIN,,TT + %CLIN+%CLEND,,T] + SETZM MFDBUF+MDCHK ;Normally 'M.F.D. + .CLOSE UTILCH, + JFCL + MOVE T,MFDBUF+MDCHK + CAMN T,[SIXBIT /M.F.D./] + AOS (P) + POPJ P, +];ITS + +;;; Printing routines +IFN ITS,[ +;;; Print directory header info +DIRHED: MOVEI A,[ASCIZ \DONT-REAP NOT-BACKED-UP AUTHOR CREATION-DATE REFERENCE-DATE\] + TLNE D,ST.PRO + JRST DIRSCL ;PROPERTIES command has abbreviated header + PUSHJ P,DIRCLF ;Empty pathname for special information + TLNE D,ST.FST\ST.ALD ;Fast option? + JRST DIRHDE ;Yes, skip rest of heading + MOVEI A,[ASCIZ \SETTABLE-PROPERTIES DONT-REAP NOT-BACKED-UP AUTHOR CREATION-DATE REFERENCE-DATE\] + PUSHJ P,DIRSCL + MOVEI T,2000*36. + MOVEI A,[ASCIZ \BLOCK-SIZE\] + PUSHJ P,DIRDEC + PUSHJ P,DIRFSI + PUSHJ P,DIRCLF +DIRHDE: JRST DIRCLF + +;;; Print one file +DIRFIL: SKIPGE DATDRP(IDX) ;Anything left at all to do? + POPJ P, ;No + SKIPE DATNDR(IDX) ;Initialized? + JRST DIRFL1 + PUSHJ P,DIRINI ;No, do so + JRST DIRFIL + +DIRFL1: PUSHJ P,DIR1FL ;Directory of one file + PUSHJ P,DIRNFL ;Step to next file +POPJ1: AOS (P) + POPJ P, + +DIRINI: MOVE TT,DATSNM(IDX) ;Get directory requested +DIRIN1: JUMPE TT,DIRSIM ;Simple case, no directory wildcards + SETZ T, + LSHC T,6 + CAIE T,'* ;A wildcard specifier? + JRST DIRIN1 + +;; The directory has some wildcards, figure out which ones to do +CNT==:1 ;Temporary AC's for sort +LST==:2 +DIRWLD: SETO LST, ;LIST _ NIL + SETZ CNT, ;COUNT _ 0 + SKIPA D,MFDBUF+MDNAMP +DIRWL1: ADDI D,LMNBLK + CAIL D,2000 + JRST DIRWL2 ;End of MFD, go sort + SKIPN TT,MFDBUF(D) + JRST DIRWL1 + MOVE B,DATSNM(IDX) + PUSHJ P,DIRMAT ;Star match + JRST DIRWL1 ;No good, try next + MOVEM LST,MFDBUF+1(D) + MOVEI LST,MFDBUF(D) ;LIST _ CONS(D,LIST) + AOJA CNT,DIRWL1 + +;;; Attempt star matching, pattern in B, test in TT. Clobbers A,T,TT +DIRMAT: CAME B,[SIXBIT /*/] ;Just * matches all +DIRMT1: CAMN B,TT ;The same now? + JRST POPJ1 ;A winner + SETZB A,T + LSHC A,6 + LSHC T,6 + CAIE A,(T) ;Same character + CAIN A,'* ;Or * in patter + JRST DIRMT1 ;Yes, go on + POPJ P, ;No, a loser + +;;; Have all the matching entries linked thru LST, sort them +DIRWST: CAIN CNT,1 ;At end of list? + JRST DRWSTR ;Yes, return it + PUSH P,CNT ;Save count + LSH CNT,-1 + PUSHJ P,DIRWST ;Recurse for first section + POP P,CNT + PUSH P,A ;Save value + ADDI CNT,1 + LSH CNT,-1 + PUSHJ P,DIRWST ;Recurse for second section + POP P,B ;Get first value + MOVEI C,D-1 ;Where to accumulate list + +;; Merge two sublists +DIRWSM: JUMPL B,DRWST1 ;No first arg, maybe use second + JUMPL A,DRWSTB ;No second, use first + MOVE T,(A) ;Get second name + MOVE TT,(B) ;Get first name +;; Do magnitude comparison + JUMPL T,DRWSM2 ;T neg? + JUMPL TT,DRWSTA ;No, and TT neg => TT greater + JRST DRWSMC ;Both pos, just compare + +DRWSM2: JUMPGE TT,DRWSTB ;T neg and TT pos => T greater + EXCH T,TT ;Both negative, reverse comparison +DRWSMC: CAML T,TT + JRST DRWSTA ;1st greater => take it + +DRWSTB: MOVEM B,1(C) + MOVEI C,(B) + MOVE B,1(C) + JRST DIRWSM + +DRWSTA: MOVEM A,1(C) ;Enter 1st at head + MOVEI C,(A) ;Transfer it to tail + MOVE A,1(C) ;Get next one + JRST DIRWSM ;And continue + +DRWST1: JUMPGE A,DRWSTA ;Use 2nd if any + SETOM 1(C) + MOVE A,D + POPJ P, + +DRWSTR: MOVEI A,(LST) ;A _ CAR(LIST) + MOVE LST,1(LST) ;LIST _ CDR(LIST) + SETOM 1(A) ;RPLACD(A,NIL) + POPJ P, ;RETURN(A) + +;; Simple case, only one directory +DIRSIM: SETOM DATNDR(IDX) ;Flag that there is no next directory + MOVE T,DATSTA(IDX) + MOVE A,DATSNM(IDX) + TLNE T,ST.ALD + JRST [ MOVEM A,DATFN1(IDX) ;Someplace to store directory name + AOS DATDRP(IDX) + POPJ P,] ;Directories only, skip mapping ufd +;In this special case, we already read in the directory +;when the directory command was processed. So don't call DIRMAP now. + MOVE D,DIRBUF+UDNAMP ;Initialize pointer to first file + TLNN T,ST.PRO + JRST DIRNF1 ;Then advance to next file + MOVEI D,2000-LUNBLK ;Make dummy file block for PROPERTIES command + .CALL [ SETZ + 'FILBLK + %CLIN,,DATFN1(IDX) + %CLOUT,,DIRBUF+0(D) + %CLOUT,,DIRBUF+1(D) + %CLOUT,,DIRBUF+2(D) + %CLOUT,,DIRBUF+3(D) + %CLOUT+%CLEND,,DIRBUF+4(D)] + JRST DIRDIE + JRST DIRNF4 + +DIRWL2: SKIPL A,LST ;If there is anything there, + PUSHJ P,DIRWST ;sort it + MOVEM A,DATNDR(IDX) ;DATNDR _ SORT(LIST) + +;; Step to next directory +DIRNDR: SKIPG A,DATNDR(IDX) ;Next directory link + JRST [ SETOM DATDRP(IDX) ;Flag that no files are left to do + POPJ P,] ;Single return for no more + MOVE T,1(A) + MOVEM T,DATNDR(IDX) + MOVE A,(A) ;Sixbit directory name + +;; Start going on directory in A +DIRMAP: MOVSI T,ST.ALD + TDNE T,DATSTA(IDX) + JRST [ MOVEM A,DATFN1(IDX) ;Someplace to store directory name + AOS DATDRP(IDX) + POPJ P,] ;Directories only, skip mapping ufd + PUSHJ P,GETUF1 + JRST DIRDIE + MOVE D,DIRBUF+UDNAMP ;Initialize pointer to first file + JRST DIRNF1 ;Then advance to next file + +;;; Here if we can't get a directory. Give an error over the connection and punt. +DIRDIE: PUSH P,PKTLOC ;Direct data to the async packet + MOVEI T,ASYPKT + MOVEM T,PKTLOC + MOVE A,DATSTA(IDX) + HRRI A,ST%ASY ;Channel now in ASYNC-MARKED state + TLO A,ST.UNC ;Not continuable + MOVEM A,DATSTA(IDX) + TRO F,F.FHN ;Force outputting of a file handle + PUSH P,[DIRDIE+2] + PUSHJ P,OPNERP + PUSHJ P,ICCERP + POP P,PKTLOC + SETOM DATDRP(IDX) + POPJ P, + +;;; Map in directory in A +GETUFD: MOVEI T,DIRBUF/2000 ;Allocate space for directory mapping + PUSHJ P,PAGALO +GETUF1: .CALL [ SETZ + SIXBIT /IOPUSH/ + %CLIN+%CLEND,,DATCHN(IDX) ] + PUSHJ P,SYSBUG + .CALL [ SETZ + SIXBIT /OPEN/ + %CLERR,,ERRCOD + %CLBTW+%CLIMM,,.UII + %CLIN,,DATCHN(IDX) + %CLIN,,DATDEV(IDX) + %CLIN,,[SIXBIT /.FILE./] + %CLIN,,[SIXBIT /(DIR)/] + %CLIN+%CLEND,,A] + JRST GETUF2 + MOVEI T,2000 + MOVE TT,[444400,,DIRBUF] + .CALL [ SETZ + SIXBIT /SIOT/ + %CLERR,,ERRCOD + %CLIN,,DATCHN(IDX) + %CLIN,,TT + %CLIN+%CLEND,,T] + SETZM DIRBUF+UDNAME + .CALL [ SETZ + SIXBIT /CLOSE/ + %CLIN+%CLEND,,DATCHN(IDX)] + JFCL + SKIPE DIRBUF+UDNAME + AOS (P) +GETUF2: .CALL [ SETZ + SIXBIT /IOPOP/ + %CLIN+%CLEND,,DATCHN(IDX) ] + PUSHJ P,SYSBUG + POPJ P, + +;;; Step to next file +DIRNFL: MOVE D,DATDRP(IDX) + MOVSI T,ST.ALD + TDNE T,DATSTA(IDX) + JRST [ JUMPE D,DIRNDR ;If directory already done, move to next + POPJ P,] ;Else continue with it +DIRNF0: ADDI D,LUNBLK +DIRNF1: TLNE D,-1 + HLRZS D ;D now points to next file to do + CAIL D,2000 ;Off the end? + JRST DIRNDR ;Yes, step to next directory + MOVE B,DATFN1(IDX) ;Match FN1 + MOVE TT,DIRBUF+UNFN1(D) + PUSHJ P,DIRMAT + JRST DIRNF0 + MOVS B,DATFN2(IDX) ;Newest or oldest version requested? + CAIE B,(SIXBIT//) + JRST DIRNF2 + MOVE B,DATFN2(IDX) ;Match FN2 + MOVE TT,DIRBUF+UNFN2(D) + PUSHJ P,DIRMAT + JRST DIRNF0 +DIRNF4: MOVEM D,DATDRP(IDX) + POPJ P, + +;;; Next file when only want newest or oldest version of each file. +;;; Matching -only- files with numeric versions seems to be what people want. +;;; We used to include every file with a non-numeric FN2, to be conservative. +;;; DATDRP(IDX) is either the index of the file, or the index +;;; of the next file group in the LH and garbage in the RH. +DIRNF2: MOVE TT,DIRBUF+UNFN2(D) + PUSHJ P,DIRNMP ;Is this a group of versions? + JRST DIRNF0 ;No, just a single file, skip it + MOVE A,DIRBUF+UNFN1(D) ;Yes, find end of the group + MOVEI B,(D) +DIRNF3: ADDI B,LUNBLK + CAIGE B,2000 + CAME A,DIRBUF+UNFN1(B) + JRST DIRNF5 + MOVE TT,DIRBUF+UNFN2(B) + PUSHJ P,DIRNMP + CAIA + JRST DIRNF3 +DIRNF5: HRL D,B ;File to look at next time + MOVS TT,DATFN2(IDX) ;Want oldest of these or newest? + CAIN TT,(SIXBIT/>/) + SKIPA C,[CAMGE TT,A] + MOVE C,[CAMLE TT,A] + MOVE A,DIRBUF+UNFN2(D) ;Get right-adjusted version of first file + TRNN A,77 + JUMPN A,[ LSH A,-6 + JRST .-1 ] + MOVEI T,(D) +DIRNF6: ADDI T,LUNBLK + CAIL T,(B) ;More versions in group? + JRST DIRNF4 ;No, D points at best one found + MOVE TT,DIRBUF+UNFN2(T) ;Get right-adjusted version of this file + TRNN TT,77 + JUMPN TT,[ LSH TT,-6 + JRST .-1 ] + XCT C ;Skip if TT is better than A + JRST DIRNF6 ;A,D is still best version + MOVE A,TT ;New best version + HRRI D,(T) ;New file to put in dir listing + JRST DIRNF6 + +;Skip if sixbit in TT is purely numeric +DIRNMP: MOVEI T,0 + LSHC T,6 + CAIL T,'0 + CAILE T,'9 + POPJ P, + JUMPN TT,DIRNMP + JRST POPJ1 + +;;; Process one file +DIR1FL: MOVE TT,DATSTA(IDX) + TLNE TT,ST.ALD + JRST DIR1AD + MOVE T,DIRBUF+UNRNDM(D) + TLNE T,UNIGFL ;This file deleted? + TLNE TT,ST.DEL\ST.PRO ;Yes, list anyway? + SKIPA A,DATDEV(IDX) + POPJ P, ;No, don't output anything + PUSHJ P,DIRSXO + MOVEI A,[ASCIZ \: \] + PUSHJ P,DIRSTR + MOVE A,DIRBUF+UDNAME + PUSHJ P,DIRSXO + MOVEI A,[ASCIZ \; \] + PUSHJ P,DIRSTR + MOVE D,DATDRP(IDX) ;Get pointer to file + MOVE A,DIRBUF+UNFN1(D) + PUSHJ P,DIRSXO + MOVEI BYTE,40 + PUSHJ P,DIRCHO + MOVE A,DIRBUF+UNFN2(D) + PUSHJ P,DIRSXO + PUSHJ P,DIRCLF + MOVSI TT,ST.FST + TDNE TT,DATSTA(IDX) ;Fast option? + JRST DIR1FE ;Yes, skip rest + MOVE T,DIRBUF+UNRNDM(D) + TLNE T,UNLINK ;Is this file a link? + JRST DIR1LN ;Yes, special processing + TLNN T,UNIGFL ;* file? + JRST DIR1F1 ;No, ordinary + MOVEI A,[ASCIZ \DELETED\] + PUSHJ P,DIRSCL +DIR1F1: TLNN T,UNREAP + JRST DIR1F2 + MOVEI A,[ASCIZ \DONT-REAP\] + PUSHJ P,DIRSCL +DIR1F2: TLNE T,UNDUMP + JRST DIR1F3 + MOVEI A,[ASCIZ \NOT-BACKED-UP\] + PUSHJ P,DIRSCL +DIR1F3: LDB T,[UNPKN DIRBUF+UNRNDM(D)] + MOVEI A,[ASCIZ \PHYSICAL-VOLUME\] + PUSHJ P,DIRDEC + MOVEI T,2000*36. + MOVEI A,[ASCIZ \BLOCK-SIZE\] + PUSHJ P,DIRDEC + PUSHJ P,DIRLN0 ;Length in blocks into T + MOVSI TT,ST.PRO + TDNE TT,DATSTA(IDX) + PUSHJ P,DIR1F5 ;PROPERTIES command, dir may have changed + PUSH P,T ;Save it + MOVEI A,[ASCIZ \LENGTH-IN-BLOCKS\] + PUSHJ P,DIRDEC + POP P,T ;Length in blocks + LDB TT,[UNWRDC DIRBUF+UNRNDM(D)] ;Word count of last block + SKIPE TT + SUBI T,1 + LSH T,10. + ADDI T,(TT) ;Word count now in T + PUSH P,T + LDB T,[UNBYTE DIRBUF+UNREF(D)] ;Byte size info + TRZE T,400 + JRST [ IDIVI T,100 ;400+100xS+C + JRST DIR1F4] + TRZE T,200 + JRST [ IDIVI T,20 ;200+20xS+C + JRST DIR1F4] + SUBI T,36. + JUMPGE T,[IDIVI T,4 ;44+4xS+C + JRST DIR1F4] + MOVMS T ;44-S + SETZ TT, ;C=0 +DIR1F4: PUSH P,TT ;Save number of extra bytes + PUSH P,T ;Save byte size + MOVEI A,[ASCIZ \BYTE-SIZE\] + PUSHJ P,DIRDEC + MOVEI T,36. + IDIV T,(P) ;Number of words per byte + IMUL T,-2(P) ;Times number of words + SUB T,-1(P) ;Less number of extra bytes + SUB P,[3,,3] + MOVEI A,[ASCIZ \LENGTH-IN-BYTES\] + PUSHJ P,DIRDEC + +DIR1FD: MOVE T,DIRBUF+UNDATE(D) + MOVEI A,[ASCIZ \CREATION-DATE\] + PUSHJ P,DIRDAT + HLLZ T,DIRBUF+UNREF(D) + MOVEI A,[ASCIZ \REFERENCE-DATE\] + PUSHJ P,DIRDAT + LDB T,[UNAUTH DIRBUF+UNREF(D)] + CAIN T,777 ;No author? + JRST DIR1FE + SUB T,MFDBUF+MDNUDS + ASH T,1 + SKIPN T,MFDBUF+2000(T) ;Get sixbit directory name + JRST DIR1FE + MOVEI A,[ASCIZ \AUTHOR\] + PUSHJ P,DIRIND + MOVE A,T + PUSHJ P,DIRSXO + PUSHJ P,DIRCLF +DIR1FE: JRST DIRCLF + +DIR1F5: .CALL [ SETZ + 'FILLEN + %CLIN,,DATFN1(IDX) + %CLOUT,,T ;Length in bytes + %CLOUT+%CLEND,,TT] ;Byte size + JRST DIRDIE + MOVEI A,36. + IDIVM A,TT + IDIV T,TT ;Length in words + ADDI T,1777 + LSH T,-10. + POPJ P, + +;; Link info output +DIR1LN: MOVEI A,[ASCIZ \LINK-TO\] + PUSHJ P,DIRIND + PUSHJ P,DIRDSC ;Get link descriptor + PUSHJ P,DIRLXO + MOVEI BYTE,"; + PUSHJ P,DIRCHO + MOVEI BYTE,40 + PUSHJ P,DIRCHO + PUSHJ P,DIRLXO + MOVEI BYTE,40 + PUSHJ P,DIRCHO + PUSHJ P,DIRLXO + PUSHJ P,DIRCLF + JRST DIR1FD ;Return to main body + +;;; Output link atom b.p. in A +DIRLXO: MOVEI T,6 ;End on six characters +DIRLX0: ILDB BYTE,A + JUMPE BYTE,CPOPJ + CAIN BYTE,'; ; ; ends + POPJ P, + CAIN BYTE,': ; : quotes + ILDB BYTE,A + ADDI BYTE,40 + PUSHJ P,DIRCHO + SOJG T,DIRLX0 + POPJ P, + +;;; Get length in blocks into T +DIRLN0: PUSHJ P,DIRDSC ;Get ufd descriptor + MOVEI T,0 +DIRLN1: ILDB B,A + JUMPE B,CPOPJ ;End by 0 + CAILE B,UDTKMX ;1-UDTKMX + JRST DIRLN2 + ADDI T,(B) ;Take N + JRST DIRLN1 + +DIRLN2: CAIGE B,UDWPH + AOJA T,DIRLN1 ;Take 1 + CAIN B,UDWPH ;Write place holder + JRST DIRLN1 + IBP A + IBP A + AOJA T,DIRLN1 + +;;; Get file descriptor into A. Clobbers B +DIRDSC: LDB A,[UNDSCP DIRBUF+UNRNDM(D)] ;Get link descriptor + IDIVI A,UFDBPW + ADD A,[ 440600,,DIRBUF+UDDESC + 360600,,DIRBUF+UDDESC + 300600,,DIRBUF+UDDESC + 220600,,DIRBUF+UDDESC + 140600,,DIRBUF+UDDESC + 060600,,DIRBUF+UDDESC](B) + POPJ P, + +;;; Directory output, just listing all directories. +;;; DATDRP is the directory name while it is pending, 0 while waiting for the next one. +DIR1AD: MOVE A,DATDEV(IDX) + PUSHJ P,DIRSXO + MOVEI A,[ASCIZ \: \] + PUSHJ P,DIRSTR + MOVE A,DATFN1(IDX) + PUSHJ P,DIRSXO + MOVEI A,[ASCIZ \; \] + PUSHJ P,DIRSTR + PUSHJ P,DIRCLF + PUSHJ P,DIRCLF + SETZM DATDRP(IDX) + POPJ P, + +;;; SIXBIT output from A +DIRSXO: MOVE B,A +DIRSO0: JUMPE B,CPOPJ + SETZ A, + LSHC A,6 + JUMPE A,DIRSOQ + CAIE A,': + CAIN A,'; + JRST DIRSOQ +DIRSO1: MOVEI BYTE,40(A) + PUSHJ P,DIRCHO + JRST DIRSO0 + +DIRSOQ: MOVEI BYTE," + PUSHJ P,DIRCHO + JRST DIRSO1 +] ;END IFN ITS + +IFN TNX,[ +DIRHED: +IFN 20X,MOVEI A,[ASCIZ \NOT-BACKED-UP AUTHOR CREATION-DATE REFERENCE-DATE BYTE-SIZE LENGTH-IN-BYTES PROTECTION GENERATION-RETENTION-COUNT ACCOUNT TEMPORARY DELETED DONT-DELETE DONT-REAP\] +IFN 10X,MOVEI A,[ASCIZ \NOT-BACKED-UP AUTHOR CREATION-DATE REFERENCE-DATE BYTE-SIZE LENGTH-IN-BYTES PROTECTION GENERATION-RETENTION-COUNT ACCOUNT TEMPORARY DELETED DONT-DELETE\] + TLNE D,ST.PRO + JRST DIRSCL ;PROPERTIES command has abbreviated header + PUSHJ P,DIRCLF ;Empty pathname for special information + TLNE D,ST.FST\ST.ALD ;Fast option? + JRST DIRHDE ;Yes, skip rest of heading + MOVEI A,[ASCIZ \SETTABLE-PROPERTIES NOT-BACKED-UP AUTHOR CREATION-DATE REFERENCE-DATE BYTE-SIZE LENGTH-IN-BYTES PROTECTION GENERATION-RETENTION-COUNT ACCOUNT TEMPORARY DELETED DONT-DELETE\] +IFN 20X,[ + PUSHJ P,DIRSTR + MOVEI A,[ASCIZ \ DONT-REAP\] +];20X + PUSHJ P,DIRSCL + PUSHJ P,DIRFSI + PUSHJ P,DIRCLF +DIRHDE: PUSHJ P,DIRCLF + AOS DATNDR(IDX) + POPJ P, + +DIRFIL: SKIPN DATJFN(IDX) ;Still have a file? + POPJ P, ;No, cannot fill in anything + MOVSI TT,ST.ALD + TDNE TT,DATSTA(IDX) + JRST DIRALD + HRROI 1,RESBLK + HRRZ 2,DATJFN(IDX) + MOVE 3,[111110,,JS%PAF] + JFNS + PUSHJ P,DIRRES + PUSHJ P,DIRCLF + MOVSI TT,ST.FST + TDNE TT,DATSTA(IDX) ;Fast option? + JRST DIRFLE ;Yes, skip rest + HRRZ 1,DATJFN(IDX) +IFN 20X,MOVSI 2,.FBLEN +.ELSE, MOVSI 2,.FBUSW+1 + MOVEI 3,DIRINF + GTFDB + ERCAL JSYSER + MOVE T,DIRINF+.FBCTL ;Get control bits + MOVSI TT,-NDBITS +DIRFLL: TDNN T,DIRBIT(TT) + JRST DIRFL1 + MOVE A,DIRBST(TT) + PUSHJ P,DIRSCL +DIRFL1: AOBJN TT,DIRFLL + HRRZ T,DIRINF+.FBPRT + MOVEI A,[ASCIZ \PROTECTION\] + PUSHJ P,DIROCT + LDB T,[<.BP FB%RET> DIRINF+.FBBYV] + MOVEI A,[ASCIZ \GENERATION-RETENTION-COUNT\] + PUSHJ P,DIRDEC + LDB T,[<.BP FB%BSZ> DIRINF+.FBBYV] + MOVEI A,[ASCIZ \BYTE-SIZE\] + PUSHJ P,DIRDEC + MOVE T,DIRINF+.FBSIZ + MOVEI A,[ASCIZ \LENGTH-IN-BYTES\] + PUSHJ P,DIRDEC + MOVEI T,1000*36. + MOVEI A,[ASCIZ \BLOCK-SIZE\] + PUSHJ P,DIRDEC + LDB T,[<.BP FB%PGC> DIRINF+.FBBYV] + MOVEI A,[ASCIZ \LENGTH-IN-BLOCKS\] + PUSHJ P,DIRDEC + MOVE T,DIRINF+.FBWRT ;Really time of last write + MOVEI A,[ASCIZ \CREATION-DATE\] + PUSHJ P,DIRDAT + MOVEI A,[ASCIZ \REFERENCE-DATE\] + SKIPE T,DIRINF+.FBREF + PUSHJ P,DIRDAT + MOVEI A,[ASCIZ \NOT-BACKED-UP\] + SKIPN DIRINF+.FBBK0 + PUSHJ P,DIRSCL + MOVSI T,(AR%NAR) + MOVEI A,[ASCIZ \DONT-REAP\] + TDNE T,DIRINF+.FBBBT + PUSHJ P,DIRSCL + HRRZ 1,DATJFN(IDX) +IFN 20X,[ + HRLI 1,.GFLWR ;Really last writer + HRROI 2,RESBLK + GFUST + MOVEI A,[ASCIZ \AUTHOR\] + PUSHJ P,DIRRCL + +IRP NAM,,[FBTP1,FBSS1,FBTP2,FBSS2] + MOVEI A,[ASCIZ \NAM\] + SKIPE T,DIRINF+.!NAM + PUSHJ P,DIROCT +TERMIN + +] +IFN 10X,[ + HRROI 1,RESBLK + HLRZ 2,DIRINF+.FBUSE ;Author + DIRST + JRST .+3 + MOVEI A,[ASCIZ \AUTHOR\] + PUSHJ P,DIRRCL + HRROI 1,RESBLK + HRRZ 2,DIRINF+.FBUSE ;Last reader + DIRST + JRST .+3 + MOVEI A,[ASCIZ \READER\] + PUSHJ P,DIRRCL +] + HRROI 1,RESBLK + HRRZ 2,DATJFN(IDX) + MOVEI 3,JS%ACT + JFNS + MOVEI A,[ASCIZ \ACCOUNT\] + PUSHJ P,DIRRCL + +;; Done with this file, output blank line +DIRFLE: MOVE 1,DATJFN(IDX) + GNJFN + SETZM DATJFN(IDX) +DIRFE1: PUSHJ P,DIRCLF + AOS DATNDR(IDX) +POPJ1: AOS (P) ;Skip return for full file + POPJ P, + +DIRALD: SKIPE 2,DATDRN(IDX) ;Have a directory number already? + JRST DIRAL1 + PUSHJ P,DIRSTP + POPJ P, +DIRAL1: HRROI 1,RESBLK + DIRST + JRST DIRAL2 +IFN 10X,[ + MOVEI A,[ASCIZ /DSK: + PUSHJ P,DIRSTR +];10X + MOVEI A,RESBLK + PUSHJ P,DIRSTR +IFN 10X,[ ;< + MOVEI BYTE,"> + PUSHJ P,DIRCHO +];10X + PUSHJ P,DIRCLF +DIRAL2: PUSHJ P,DIRSTP + SETZM DATDRN(IDX) + JRST DIRFE1 + +DIRSTP: HRROI 1,RESBLK + MOVE 2,DATJFN(IDX) +IFN 10X,MOVSI 3,(JS%DIR) +.ELSE MOVE 3,[JS%DEV+JS%DIR+JS%PAF] + JFNS + MOVSI 1,(RC%AWL) + HRROI 2,RESBLK + SKIPE 3,DATDRN(IDX) + TLO 1,(RC%STP) + RCDIR + MOVEM 3,DATDRN(IDX) + MOVE 2,3 ;Return in 2 + TLNN 1,(RC%NMD\RC%NOM) + JRST POPJ1 + PUSHJ P,RELDJF + POPJ P, + +DIRBIT: FB%TMP + FB%DEL +IFN 20X,[ + FB%DIR + FB%NOD + FB%OFF +IFDEF FB%NDL,FB%NDL ; Twenex release 5 has new name and value +.ELSE [ + IFDEF FB%UND,FB%UND + .ELSE FB%PRM + ] +];20X +.ELSE 400,,0 +NDBITS==:.-DIRBIT + +DIRBST: [ASCIZ \TEMPORARY\] + [ASCIZ \DELETED\] +IFN 20X,[ + [ASCIZ \DIRECTORY\] + [ASCIZ \DONT-DUMP\] + [ASCIZ \OFFLINE\] +];20X + [ASCIZ \DONT-DELETE\] + +;;; Output string in A, then RESBLK, then newline +DIRRCL: PUSHJ P,DIRIND + PUSHJ P,DIRRES + JRST DIRCLF +] ;END IFN TNX + +;;; Output indicator +DIRIND: PUSHJ P,DIRSTR + MOVEI BYTE,40 + JRST DIRCHO + +;;; Output date in T with indicator in A +DIRDAT: PUSHJ P,DIRIND + MOVE A,T + PUSHJ P,DIRDTO + JRST DIRCLF + +;;; Output octal number in T for property indicator in A +;;; NOTE: This function knows about returning from its caller +DIROCT: SKIPA B,[8] +DIRDEC: MOVEI B,10. + PUSHJ P,DIRIND + PUSHJ P,DIRNUM + JRST DIRCLF + +;;; Just output number in T base in B +DIRNUM: PUSH P,[-1] + JUMPGE T,DIRNM0 + MOVEI BYTE,"- + PUSHJ P,DIRCHO + MOVNS T + TLZ T,400000 +DIRNM0: IDIVI T,(B) + PUSH P,TT + JUMPN T,DIRNM0 +DIRNM1: POP P,BYTE + JUMPL BYTE,CPOPJ + ADDI BYTE,"0 + PUSHJ P,DIRCHO + JRST DIRNM1 + +DIRSCL: PUSHJ P,DIRSTR +DIRCLF: MOVEI A,[.BYTE 7 ? ^M ? ^J] + JRST DIRSTR + +IFN TNX,DIRRES: SKIPA A,[440700,,RESBLK] +DIRSTR: HRLI A,440700 +DIRST1: ILDB BYTE,A ;Get next character + JUMPE BYTE,CPOPJ ;Terminate on null + PUSHJ P,DIRCHO + JRST DIRST1 + +DIRCHO: SOJLE BC,REDBF1 ;Unwind when buffer filled + IDPB BYTE,BP + POPJ P, + +;;; FILE-SYSTEM-INFO command +;;; The info had better all fit in one packet, or all hell will break loose! + +COMFSI: MOVEI A,[ASCIZ \FILE-SYSTEM-INFO \] + PUSHJ P,COMCTL + MOVEI BYTE,215 + PUSHJ P,COMCHO + SUBI BC,CHPMXC + MOVNS BC ;So DIRCHO will act like COMCHO +IFN 20X,MOVEI IDX,MAXIDX + PUSHJ P,DIRFSI + SUBI BC,CHPMXC + MOVNS BC + PUSHJ P,COMSND + JRST CTLLOP + +DIRFSI: +IFN 10X,[ + MOVEI A,[ASCIZ\DISK-SPACE-DESCRIPTION \] + PUSHJ P,DIRSTR + HRLOI 1,.DVDES+.DVDSK ;DSK: DESIGNATOR + GDSKC ;1 gets pages used, 2 gets pages left + ADD 1,2 + MOVEI B,10. + MOVE T,2 + PUSHJ P,DIRNUM + MOVEI A,[ASCIZ\ disk pages free out of \] + PUSHJ P,DIRSTR + MOVE T,1 + PUSHJ P,DIRNUM + MOVEI A,[ASCIZ\ (\] + PUSHJ P,DIRSTR + MOVE T,1 + SUB T,2 + IMULI T,100. + IDIV T,1 + PUSHJ P,DIRNUM + MOVEI A,[ASCIZ\% full)\] + JRST DIRSTR +];10X +IFN 20X,[ + MOVEI A,[ASCIZ\DISK-SPACE-DESCRIPTION \] + PUSHJ P,DIRSTR + HRRZ 2,DATJFN(IDX) + JUMPE 2,FRESTR ;Not really anything here, no JFN. + MOVSI 1,(RC%EMO) + RCDIR + TLNE 1,(RC%NOM) + JRST FRESTR ;No match, presumably wildcard was used. + MOVE 1,3 + GTDAL ;Get directory allocation. + MOVEI B,10. + MOVE T,2 ;Permanent quota + PUSHJ P,DIRNUM + MOVEI A,[ASCIZ / used, /] + PUSHJ P,DIRSTR + CAML 3,[377777,,0] + JRST [MOVEI A,[ASCIZ /+INF/] + PUSHJ P,DIRSTR + JRST .+3] + MOVE T,3 + PUSHJ P,DIRNUM + MOVEI A,[ASCIZ / allowed. /] + PUSHJ P,DIRSTR +FRESTR: MOVE 1,[SIXBIT /DEVNAM/] + SYSGT + HRRZ D,2 ;Table# + MOVEI C,1 ;Should be 1st device name. +GSTRNM: HRLZ 1,C + HRR 1,D ;Offset,,table# + GETAB + JFCL +;;This won't work if # of structures = STRN! +;; HLRZ 2,1 ;If no more devices, it's SIXBIT/STRnnn/ +;; CAIN 2,(SIXBIT /STR/) +;; JRST [ MOVEI A,[ASCIZ/ disk pages free./] +;; JRST DIRSTR ] + MOVE 3,[440700,,STRNAM] +ST6TO7: SETZ 2, ;Turn sixbit structure name into asciz + ROTC 1,6 ;string. + ADDI 2,40 + IDPB 2,3 + JUMPN 1,ST6TO7 + SETZ 2, + IDPB 2,3 ;Null terminate. +;;Start of UTexas change + HRROI 1,STRNAM ;Set up to get device designator + STDEV + ERJMP ENDSTR + MOVE 1,2 ;Set up device designator + MOVEM 1,DEVDEG ;Save device designator for later + DVCHR ;Check device type + ERJMP ENDSTR + LDB 3,[221100,,2] ;Get DV%TYP + CAIE 3,.DVDSK ;Is it a disk? + JRST ENDSTR ;No +;;End of UTexas change + MOVEI BYTE,40 + PUSHJ P,DIRCHO + PUSHJ P,DIRCHO + MOVEI A,STRNAM + PUSHJ P,DIRSTR + MOVEI BYTE,": ;STRUCTURE:nnnnn + PUSHJ P,DIRCHO + MOVEI BYTE,40 + PUSHJ P,DIRCHO + MOVE 1,DEVDEG ;[UTexas] Restore device designator + GDSKC + MOVE T,2 ;Free + MOVEI B,10. + PUSHJ P,DIRNUM +GNSTRN: AOJA C,GSTRNM ;Step to next structure. + +ENDSTR: MOVEI A,[ASCIZ/ disk pages free./] + JRST DIRSTR +];20X +IFN ITS,[ + MOVEI A,[ASCIZ \PHYSICAL-VOLUME-FREE-BLOCKS\] + PUSHJ P,DIRSTR + MOVE T,[SQUOZE 0,NQS] + .EVAL T, + .LOSE %LSSYS + MOVSI C,-1 + TLC C,-1(T) ;AOBJN pointer + MOVE T,[SQUOZE 0,QSFT] + .EVAL T, + .LOSE %LSSYS + PUSH P,T + MOVE T,[SQUOZE 0,QPKID] + .EVAL T, + .LOSE %LSSYS + PUSH P,T + MOVEI B,10. +DIRFR0: MOVE TT,(P) ;QPKID + ADDI TT,(C) ;(Q) + MOVSS TT + HRRI TT,T + .GETLOC TT, + JUMPL T,DIRFR1 + MOVEI BYTE,", + TRNN C,-1 + MOVEI BYTE,40 + PUSHJ P,DIRCHO + PUSHJ P,DIRNUM + MOVEI BYTE,": + PUSHJ P,DIRCHO + MOVE TT,-1(P) ;QSFT + ADDI TT,(C) ;(Q) + MOVSS TT + HRRI TT,T + .GETLOC TT, + PUSHJ P,DIRNUM +DIRFR1: AOBJN C,DIRFR0 + SUB P,[2,,2] + POPJ P, +];ITS + +;;; Filename completion command +COMCPL: SKIPN USERID +IFN OZ, PUSHJ P,AUTLOG +.ELSE CERR NLI,[Not logged in] + SETZ D, ;Clear options here +CPLOPT: TRNE F,F.NWL ;End of options? + JRST CPLFNM + PUSHJ P,COMRD5 ;Get token + JUMPL BC,COMBAD +CPLOLP: MOVEI T,CPLLEN-1 +CPLOL1: CAME A,CPLTAB(T) + SOJGE T,CPLOL1 + JUMPL T,[CERR UUO,[Unknown COMPLETE option]] + XCT CPLACT(T) + JRST COMBAD + JRST CPLOPT + +CPLTAB: ASCII \DELET\ + ASCII \READ\ + ASCII \WRITE\ + ASCII \OLD\ + ASCII \NEW-O\ +CPLLEN==.-CPLTAB + +CPLACT: TLOA D,ST.DEL + TLZA D,ST.OUT + TLOA D,ST.OUT + TLZA D,ST.NOK + TLOA D,ST.NOK + +IFN TNX,[ +;;; Local storage +DEFDEV==RESBLK +DEFDIR==DEFDEV+1 +DEFNAM==DEFDIR+1 +DEFTYP==DEFNAM+1 +DEFSTR==DEFTYP+1 + +;Parse only GTJFN doesn't quite work on Tenex +;So, if we get no such device or no such directory, flush that all together and +;hope the system defaults help. +IFN 10X,[ +CPLFIX: MOVEI BYTE,215 + DPB BYTE,BP ;Put back old end of line + MOVE BP,3 ;Get old byte pointer + MOVE BC,4 +CPLFX1: SOJL BC,CPLFX2 + ILDB BYTE,BP + JUMPN BYTE,CPLFX3 +CPLFX2: PUSHJ P,JSYSER ;End and no special character + +CPLFX3: CAIN BYTE,^V + JRST [ IBP BP + SOJA BC,CPLFX1] + CAIE BYTE,(1) ;One we want + JRST CPLFX1 +] + +CPLFNM: +IFN 10X,MOVE 3,BP ;Save current byte pointer +.ALSO MOVE 4,BC + TLO D,ST.PON + PUSHJ P,COMGJF ;Get JFN for default +IFE 10X, PUSHJ P,JSYSER +.ELSE [ JRST [ CAIN 1,GJFX16 ;No such device + JRST [ MOVEI 1,": + JRST CPLFIX] + CAIN 1,GJFX17 ;No such directory < + JRST [ MOVEI 1,"> + JRST CPLFIX] + IRPS STR,,[DEV DIR NAME TYP] + SETZM DEF!STR ;Forget the damned defaults + TERMIN + JRST CPLFN1] +];10X + MOVE 2,1 ;Setup for JFNS + MOVEI 1,DEFSTR ;Some string space + SETZ A, + MOVSI 3,100000 ;Device initially... +IRPS STR,,[DEV DIR NAM TYP] + MOVEI 1,1(1) ;Make sure pointing to fresh word... + HRLI 1,440700 + MOVEM 1,DEF!STR ;Save pointer to this section. + JFNS + IDPB A,1 + LSH 3,-3 ;Shift down file-part field... +TERMIN + HRROI 1,1(1) + PUSH P,1 + MOVSI 3,000010 ;Generation field... + JFNS + POP P,1 + HRLI 1,440700 + ILDB 1,1 + CAIN 1,"* + TLO D,ST.DIR ;Remember if should have wild default + MOVE 1,2 + RLJFN ;Done with this JFN + JFCL +CPLFN1: SETZM GTJBLK + MOVE A,[GTJBLK,,GTJBLK+1] + BLT A,GTJBLK+.GJBFP ;Clear out long call GTJFN block + MOVEM BP,DEFSTR ;Save user's string + PUSHJ P,COMEUS ;Find end of it + JRST [TRZN F,F.NWL ;Must be terminated with a newline + JRST COMBAD + JRST .+2] + JRST .-2 ;Terminated by space, so keep searching + MOVEI 1,33 ;Put in escape to get completion + DPB 1,BP + SETZ 1, + IDPB 1,BP + +;;; Now have defaults and user's string. If this is an input file, the idea is to +;;; keep trying GTJFN without allowing new files and various default conditions +;;; until we manage to win. + TLNN D,ST.OUT + SKIPA C,[-NCPLMT,,CPLMTH] ;Completion method routines + HRROI C,CPLOUT ;Completion for output + TLNN D,ST.NOK ;New file ok? + ADD C,[1,,0] ;No, skip last method + +;;; Here to try next method +CPLLUP:.GJTYP==.GJEXT ;Nothing is consistent +IRPS STR,,[DEV DIR NAM TYP] + MOVE 1,DEF!STR + MOVEM 1,GTJBLK+.GJ!STR +TERMIN + MOVE 1,[.NULIO,,.NULIO] + MOVEM 1,GTJBLK+.GJSRC + MOVEI 1,2 ;Two extra words + MOVEM 1,GTJBLK+.GJF2 + HRROI 1,JFNSTR + MOVEM 1,GTJBLK+.GJCPP + MOVEI 1,30.*5 + MOVEM 1,GTJBLK+.GJCPC + MOVSI 1,(GJ%OLD\GJ%FLG\GJ%XTN) + TLNE D,ST.DEL + TLO 1,(GJ%DEL) + TLNE D,ST.DIR + IOR 1,[GJ%IFG+.GJALL] + XCT (C) + MOVEM 1,GTJBLK+.GJGEN + MOVEI 1,GTJBLK + MOVE 2,DEFSTR + GTJFN + JRST CPLNXT ;Failed, try next method + MOVE 3,[111110,,JS%PAF] ;Device, directory, filename, file type, version + +;;; Now, if the user didn't really type the generation number, don't give it back + SKIPL GTJBLK+.GJGEN ;GJ%FOU supplied? + JRST [ TLNE 1,(GJ%UHV) ;No, highest existing = 0 + JRST .+2 + JRST .+3] + TLNE 1,(GJ%NHV) ;Yes, next higher = 0 + TLZ 3,(JS%GEN) + MOVE 2,1 ;Jfn + HRROI 1,JFNSTR + JFNS + MOVE 1,2 + RLJFN + JFCL + MOVEI A,[ASCIZ \OLD\] + MOVSI 1,(GJ%OLD) + TDNN 1,GTJBLK+.GJGEN + MOVEI A,[ASCIZ \NEW\] + JRST CPLDON + +CPLNXT: AOBJN C,CPLLUP ;Keep trying and finally return typescript as is + LDB 1,GTJBLK+.GJCPP + SETZ 2, + CAIN 1,33 ;Clear altmode from user's typescript + DPB 2,GTJBLK+.GJCPP + MOVEI A,[ASCIZ \NIL\] +CPLDON: PUSH P,A + MOVEI A,[ASCIZ \COMPLETE \] + PUSHJ P,COMCTL + POP P,A + PUSHJ P,COMSTO + MOVEI BYTE,215 + PUSHJ P,COMCHO + MOVEI A,JFNSTR + PUSHJ P,COMSTO + MOVEI BYTE,215 + PUSHJ P,COMCHO + PUSHJ P,COMSND + JRST CTLLOP + +CPLMTH: JFCL + SETZM GTJBLK+.GJEXT + SETZM GTJBLK+.GJNAM + PUSHJ P,CPLNBT + TLZ 1,(GJ%OLD) +NCPLMT==.-CPLMTH + +CPLOUT: TLC 1,(GJ%FOU\GJ%OLD\GJ%NEW) + +CPLNBT: SETZM GTJBLK+.GJNAM + SETZM GTJBLK+.GJEXT + POPJ P, + +];END OF COMPLETION COMMAND FOR TNX + +IFN ITS,[ +;;; ITS COMPLETION COMMAND + +CPLFNM: MOVEI IDX,MAXIDX ;Use probe variables for filename parsing etc. + HLLM D,DATSTA(IDX) ;Save status bits + SETZM DATSNM(IDX) + SETZM DATFN2(IDX) + PUSHJ P,COMPFN ;Parse the filename spec for the default + IRPS SYL,,[SNM FN1 FN2] + MOVE TT,DAT!SYL(IDX) ;Save the defaults + MOVEM TT,DEF!SYL' + TERMIN + SETZM DATSNM(IDX) + SETZM DATFN2(IDX) + PUSHJ P,COMPFN ;Parse the user's string + PUSHJ P,LCKDIR ;Get DIRLCK + ;; First, find the directory + SKIPN A,DATSNM(IDX) ;Start from any specified directory + MOVE A,DEFSNM ;None, start from default + SKIPN A + MOVE A,HSNAME ;If no default, use default default: user's homedir + PUSHJ P,GETUFD ;Read in the directory + CAIA + JRST CPLFN3 + ;; Directory doesn't exist, try completion on it + PUSHJ P,GETMFD ;Read in the MFD + JRST CPLFN9 ;Can't do much without any dirs + PUSHJ P,CMPLT0 + SKIPA D,MFDBUF+MDNAMP +CPLFN1: ADDI D,LMNBLK + CAIL D,2000 + JRST CPLFN2 + MOVE A,MFDBUF(D) + PUSHJ P,CMPLT1 + JRST CPLFN1 + +CPLFN2: MOVE A,CMPLTW ;Result of directory completion + MOVEM A,DATSNM(IDX) ;Return it whether or not directory exists + PUSHJ P,GETUFD + JRST CPLFN9 ;Directory doesn't exist, stop now +CPLFN3: MOVEM A,DATSNM(IDX) + ;; Now scan the directory. First we plug in the defaults and complete. + ;; If that yields an existent file, or this is for output, take that as + ;; the result. Otherwise complete without plugging in the defaults. + ;; If that yields an existent file, take it. Otherwise take the results + ;; of plugging in the defaults and completing if new-file is okay. + ;; We don't distinguish defaulting FN1 and defaulting FN2. + SKIPN A,DATFN1(IDX) + MOVE A,DEFFN1 + SKIPN B,DATFN2(IDX) + JRST [ MOVE B,DEFFN2 ;Note, never take ">" from the defaults + CAMN B,[SIXBIT/>/] + SETZ B, + JRST .+1 ] + PUSHJ P,CPLDIR + JRST [ MOVSI T,ST.OUT ;No existent file, doing output? + TDNN T,DATSTA(IDX) + JRST CPLFN4 ;No, try without defaults + JRST CPLFN7 ] ;Matches non-existent file + JRST CPLFN7 ;Matches possibly-existent file + +CPLFN4: PUSH P,A ;Save results of completion with default + PUSH P,B + MOVE A,DATFN1(IDX) ;Try again without defaults + MOVE B,DATFN2(IDX) + PUSHJ P,CPLDIR + JRST [ MOVSI T,ST.NOK ;That didn't work either, new file okay? + TDNN T,DATSTA(IDX) + JRST CPLFN9 ;No, no completions found + POP P,B ;Yes, take the completion-with-defaults + POP P,A + JRST .+2 ] + SUB P,[2,,2] +; A and B now have the result of the completion. Determine NEW/OLD status. +CPLFN7: MOVEM A,DATFN1(IDX) + MOVEM B,DATFN2(IDX) + SKIPA D,DIRBUF+UDNAMP ;See if completed file really exists +CPLF7A: ADDI D,LUNBLK + CAIL D,2000 + JRST CPLF7B + CAME A,DIRBUF+UNFN1(D) + JRST CPLF7A + CAMN B,DIRBUF+UNFN2(D) + JRST CPLF7C + JUMPE B,CPLF7C ;The file exists + CAME B,[SIXBIT/>/] + CAMN B,[SIXBIT//] ;FN2 of < or > always matches + CAMN B,[SIXBIT/") + MOVE B,CMPLTW ;Yes, is it all numeric? +CPLDR7: MOVEI A,0 ;If so, we won't count it since it's a version not a type + LSHC A,6 + CAIL A,'0 + CAILE A,'9 + JRST CPLDR6 ;Blank FN2 matches a single filetype + JUMPN B,CPLDR7 + TDZA B,B ;Result remains blank +CPLDR6: MOVE B,CMPLTW ;Completed FN2 +CPLDR5: MOVE A,C ;Completed FN1 + SKIPL CMPLTF ;Any completions found? + AOS (P) ;Yes, take skip return + POPJ P, + +CMPLTA==CLODAT ;Trying to keep the impure down to one page +CMPLTM==CLOLEN + +;;; Completion of sixbit words +;;; Set up to complete the word in A +;;; After calling this, call CMPLT1 any number of times then pick +;;; up your result out of CMPLTW, which is either the original argument +;;; (in which case CMPLTF is negative), or else is the shortest existent +;;; extension of that. +CMPLT0: MOVEM A,CMPLTA ;Word to match + SETO T, + TDNE A,T + JRST [ LSH T,-6 + JRST .-1 ] + SETCAM T,CMPLTM ;Mask for fixed characters + SETOM CMPLTF' ;No completions found yet + MOVEM A,CMPLTW' ;Word found so far (result of completion) + SETCAM T,CMPLTX' ;Mask for valid characters in that + POPJ P, + +;;; Use the sixbit in A as a possible completion. +CMPLT1: MOVE TT,A + XOR TT,CMPLTA + TDNE TT,CMPLTM ;Does it match the fixed characters? + POPJ P, ;No. + AOSE CMPLTF ;First completion found? + JRST CMPLT2 ;No + MOVEM A,CMPLTW ;Yes, save as result + SETO T, ;and compute its length + TDNE A,T + JRST [ LSH T,-6 + JRST .-1 ] + SETCAM T,CMPLTX + POPJ P, + +CMPLT2: MOVE TT,A ;Two completions, take their common prefix + XOR TT,CMPLTW + MOVE T,CMPLTX + TDNE TT,T + JRST [ LSH T,6 + JRST .-1 ] + MOVEM T,CMPLTX + ANDM T,CMPLTW + POPJ P, +];ITS + +;;; Property changing command +COMCNG: SKIPN USERID +IFN OZ, PUSHJ P,AUTLOG +.ELSE CERR NLI,[Not logged in] + TRZN F,F.NWL ;Should be newline + JRST COMBAD + TRNN F,F.FHN ;Use an open file? + JRST CNGFIL ;Nope, need a filename + PUSHJ P,CNGLOP + PUSHJ P,FILERR ;Failed + JRST CNGDN1 + +CNGFIL: MOVEI IDX,MAXIDX ;Use dummy IDX +IFN ITS,[ + PUSHJ P,COMPFN + .CALL [ SETZ + SIXBIT /OPEN/ + %CLERR,,ERRCOD + %CLBIT,,.UAI + %CLIN,,DATCHN(IDX) + %CLIN,,DATDEV(IDX) + %CLIN,,DATFN1(IDX) + %CLIN,,DATFN2(IDX) + %CLIN+%CLEND,,DATSNM(IDX)] + PUSHJ P,FILERR +] +IFN TNX,[ + MOVSI D,ST.DEL + PUSHJ P,COMGJF + PUSHJ P,JSYSER + MOVEM 1,DATJFN(IDX) ;Save jfn +] + PUSHJ P,CNGLOP + CAIA + JRST CNGDON +IFN ITS,[ + .CALL [ SETZ + SIXBIT /CLOSE/ + %CLIN+%CLEND,,DATCHN(IDX)] + JFCL +];ITS +IFN TNX,PUSHJ P,RELDJ1 ;Failed, release file + PUSHJ P,FILERR + +;;; Done changing things, close the file, etc. +CNGDON: +IFN ITS,[ + .CALL [ SETZ + SIXBIT /CLOSE/ + %CLIN+%CLEND,,DATCHN(IDX)] + JFCL +];ITS +IFN TNX,PUSHJ P,RELDJ1 +CNGDN1: MOVEI A,[ASCIZ \CHANGE-PROPERTIES\] + PUSHJ P,COMCTL + PUSHJ P,COMSND + JRST CTLLOP + +CNGLOP: JUMPLE BC,POPJ1 ;Done when end or just blank line + TRZ F,F.NWL + PUSHJ P,COMR10 ;Get property name + JRST COMBAD +CNGOLP: MOVEI C,CNGLEN +CNGOL1: SOJL C,[CERR UKP,[Unknown property]] + CAMN A,CNGTAB-1(C) + CAME B,CNGTAB(C) + SOJA C,CNGOL1 + HRRZ T,CNGACT(C) ;Get routine + PUSHJ P,(T) +IFN 20X,[ + SKIPL CNGACT(C) ;If sign (flag) bit on, then we want + JRST CNGLOP ;to do something else besides this + HRRZ T,CNGALT(C) ;operation, so look in the parallel + PUSHJ P,(T) ;table for de poop. +];20X + JRST CNGLOP + + +;;; NOTE: If you change this, be sure to update the list of settable properties at +;;; the start of DIRHED. +CNGTAB: +IFN 20X+ITS, ASCII \DONT-REAP\ ;DONT-REAP + ASCII \NOT-BACKED\ ;NOT-BACKED-UP + ASCII \AUTHOR\ ;AUTHOR + ASCII \CREATION-D\ ;CREATION-DATE + ASCII \REFERENCE-\ ;REFERENCE-DATE +IFN TNX,[ + ASCII \BYTE-SIZE\ ;BYTE-SIZE + ASCII \LENGTH-IN-\ ;LENGTH-IN-BYTES + ASCII \PROTECTION\ ;PROTECTION + ASCII \GENERATION\ ;GENERATION-RETENTION-COUNT + ASCII \ACCOUNT\ ;ACCOUNT + ASCII \TEMPORARY\ ;TEMPORARY + ASCII \DELETED\ ;DELETED + ASCII \DONT-DELET\ ;DONT-DELETE +] +CNGLEN==.-CNGTAB + +IFN ITS,[ +CNGACT: SIXBIT /SREAPB/ ? -1,,CNGBIT ;DONT-REAP + SIXBIT /SDMPBT/ ? 0,,CNGBIT ;NOT-BACKED-UP + SIXBIT /SAUTH/ ? CNGAUT ;AUTHOR + SIXBIT /SFDATE/ ? CNGDAT ;CREATION-DATE + SIXBIT /SRDATE/ ? CNGDAT ;REFERENCE-DATE + +CNGBIT: HLRE A,CNGACT(C) + PUSH P,A ;Get sense of boolean + PUSHJ P,COMRD5 + JFCL + CAMN A,[ASCII /NIL/] + SETCMM (P) + POP P,A + +;; Perfor system call for this routine, argument in A +CNGCAL: MOVE B,CNGACT-1(C) + .CALL [ SETZ + SIXBIT /CALL/ + %CLERR,,ERRCOD + %CLIN,,B + %CLIN,,DATCHN(IDX) + %CLIN+%CLEND,,A] + JRST CNGERR + POPJ P, + +CNGAUT: PUSHJ P,COMSXI ;Read sixbit author name + JRST CNGCAL + +CNGDAT: PUSHJ P,COMDTI ;Read a date + JRST CNGCAL +] ;END IFN ITS + +IFN TNX,[ +CNGACT: +IFN 20X,-1 ? .ARNAR,,CNGABT ;DONT-REAP + -1 ? .FBBK0,,CNGBIT ;NOT-BACKED-UP + SFUST ? 400000\.SFLWR,,CNGSTR ;AUTHOR (Sign bit means dualistic) + -1 ? 400000\.FBWRT,,CNGDAT ;CREATION-DATE + -1 ? .FBREF,,CNGDAT ;REFERENCE-DATE + FB%BSZ ? .FBBYV,,CNGDEC ;BYTE-SIZE + -1 ? .FBSIZ,,CNGDEC ;LENGTH-IN-BYTES +IFN 20X,[77,,-1] .ELSE [0,,-1] ? .FBPRT,,CNGOCT ;PROTECTION + FB%RET ? .FBBYV,,CNGDEC ;GENERATION-RETENTION-COUNT + SACTF ? CNGSTR ;ACCOUNT + FB%TMP ? .FBCTL,,CNGBIT ;TEMPORARY + FB%DEL ? .FBCTL,,CNGBIT ;DELETED +IFDEF FB%NDL,FB%NDL ; Twenex release 5 has new name and value +.ELSE [ + IFDEF FB%UND,FB%UND + .ELSE FB%PRM + ] + .FBCTL,,CNGBIT ;DONT-DELETE + +IFN 20X,[ +CNGALT: 0 ? 0 + 0 ? 0 + SFUST ? .SFAUT,,CNGST1 ;real 20X AUTHOR + -1 ? .FBCRV,,CNGDA1 ;real 20x CREATION-DATE + ;there had better not be any more sign bits! +];20X + + +CNGBIT: PUSHJ P,COMRD5 + CAMN A,[ASCII \NIL\] + TDZA A,A + SETO A, +CNGFDB: HRRZ 1,DATJFN(IDX) + HLL 1,CNGACT(C) + TLZ 1,400000 ;Remove that flag bit. + MOVE 2,CNGACT-1(C) ;Mask + MOVE 3,A ;New value +IFN 20X,PUSHJ P,TRYCON + CHFDB + ERJMP CNGERR + POPJ P, + +IFN 20X,[ +CNGABT: PUSHJ P,COMRD5 ;Modify archival information via ARCF + CAMN A,[ASCII \NIL\] + SKIPA 3,[.ARCLR] + MOVEI 3,.ARSET + HRRZ 1,DATJFN(IDX) + HLRZ 2,CNGACT(C) + ARCF + ERJMP CNGERR + POPJ P, +];20X + +CNGDAT: PUSHJ P,COMDTI + JRST CNGFDB + +IFN 20X,[ +CNGDA1: HRRZ 1,DATJFN(IDX) + HLL 1,CNGALT(C) + MOVE 2,CNGALT-1(C) ;Mask + MOVE 3,A ;Old value (had better still be there) + PUSHJ P,TRYCON + CHFDB + ERJMP .+1 ;OK if we fail. + POPJ P, +];20X + +CNGDEC: PUSHJ P,COMDCI + JRST CNGRFD + +CNGOCT: PUSHJ P,COMOCI +;;Here if right justified +CNGRFD: MOVE T,CNGACT-1(C) ;Mask + JFFO T,.+1 + SETCM T,CNGACT-1(C) + LSH T,(TT) + MOVNS TT + LSH T,(TT) + JFFO T,.+2 + JRST CNGFDB ;No shifting necessary + MOVEI T,36. + SUBI T,(TT) + LSH A,(T) + JRST CNGFDB + +CNGSTR: MOVE 2,BP + MOVEM 2,SAVEBP + PUSHJ P,COMEUS ;Find end + SKIPA + JRST .-2 ;Terminated by space, so keep searching + SETZ 1, + DPB 1,BP ;Insure terminating NULL + HRRZ 1,DATJFN(IDX) + HLL 1,CNGACT(C) + TLZ 1,400000 ;Make sure that flag bit is off... + XCT CNGACT-1(C) + ERJMP CNGERR + POPJ P, + +IFN 20X,[ +CNGST1: HRRZ 1,DATJFN(IDX) + HLL 1,CNGALT(C) + MOVE 2,SAVEBP + XCT CNGALT-1(C) + ERJMP .+1 ;OK if we fail... + POPJ P, +];20X +];END IFN TNX + +;;; Error, take error return from CNGLOP +CNGERR: SUB P,[1,,1] ;Flush return to CNGLOP + POPJ P, + +;;; Expunge directory command +COMEXP: SKIPN USERID +IFN OZ, PUSHJ P,AUTLOG +.ELSE CERR NLI,[Not logged in] + SETZ D, ;Clear options here + MOVEI IDX,MAXIDX ;Use the temporary channel for this +EXPOPT: TRNE F,F.NWL ;End of options? + JRST EXPFNM + PUSHJ P,COMRD5 ;Get token + JUMPL BC,COMBAD +IFN ITS,CERR UUO,[Unknown EXPUNGE option] +IFN TNX,[ +EXPOLP: MOVEI T,EXPLEN-1 +EXPOL1: CAME A,EXPTAB(T) + SOJGE T,EXPOL1 + JUMPL T,[CERR UUO,[Unknown EXPUNGE option]] + XCT EXPACT(T) + JRST COMBAD + JRST EXPOPT + +EXPTAB: ASCII \TEMPO\ ;TEMPORARY +EXPLEN==.-EXPTAB + +EXPACT: SKIPA + +EXPFNM: TLO D,ST.ALD ;Allow wildcards + PUSHJ P,PRSDIR ;Return JFN in 1, directory number in 3 + PUSHJ P,JSYSER + RLJFN ;Don't need that JFN anymore. + JFCL + PUSH P,[0] ;Initial sum of freed pages. +EXPFN0: MOVEM 3,WILDIR + MOVE 1,3 ;Directory# + GTDAL + ERCAL JSYSER + PUSH P,2 ;Returns allocated pages in AC2 +IFN 10X,[ + HRRZ 1,WILDIR ;Directory number + DELDF ;Expunge (never skips, and blows it on ERCAL) +];10X +IFN 20X,[ + SETZ 1, + MOVE 2,WILDIR + DELDF ;Expunge. + ERCAL JSYSER +];20X + MOVE 1,WILDIR + GTDAL ;Get new allocation + ERCAL JSYSER + POP P,1 ;Old allocation + SUB 1,2 ;1/ pages freed + ADDM 1,(P) ;Accumulate. +IFN 20X,[ + MOVSI 1,(RC%STP\RC%AWL) ;Step to next directory + HRROI 2,RESBLK ;Pointer to directory string + MOVE 3,WILDIR ;Old dir# + RCDIR + ERCAL JSYSER + TLNN 1,(RC%NMD\RC%NOM) ;No More Directories? + JRST EXPFN0 ; Yes more, so go do next. +];20X +];TNX +IFN ITS,[ ;Always returns success +EXPFNM: PUSHJ P,COMPFN ;PARSE THE FILENAME + PUSH P,[0] ;No space is ever reclaimed +];ITS + MOVEI A,[ASCIZ \EXPUNGE \] + PUSHJ P,COMCTL + POP P,A + PUSHJ P,COMDCO + MOVEI BYTE,215 ;NLNL + PUSHJ P,COMCHO +IFN TNX,PUSHJ P,COMRES +IFN ITS,[ + MOVE A,DATSNM(IDX) + PUSHJ P,COMSXO + MOVEI BYTE,"; + PUSHJ P,COMCHO +];ITS + MOVEI BYTE,215 + PUSHJ P,COMCHO + PUSHJ P,COMSND + JRST CTLLOP + +IFN TNX,[ +;Return JFN in 1, directory number in 3 (skip on success) +;Allows wildcard directories on Tops-20 if ST.ALD is set +;Failure takes non-skip return with error code in 1, or blows out +PRSDIR: TLO D,ST.PON ;Parse only: don't care if there are no files in dir + PUSHJ P,COMGDJ ;Get JFN + POPJ P, + PUSH P,1 ;Save JFN + HRROI 1,RESBLK + MOVE 2,(P) +IFN 10X,MOVSI 3,(JS%DIR) ;Tenex wants directory with no delimiters +.ELSE MOVE 3,[110000,,JS%PAF] ;Just want device and directory + JFNS + ERCAL SYSBUG + HRRZS (P) ;Kill flags in LH(JFN) +IFN 20X,[ + MOVSI 1,(RC%AWL) ;Recognize directory, allowing wildcards + TLNN D,ST.ALD + MOVSI 1,(RC%EMO) +];20X +IFN 10X,MOVSI 1,(RC%EMO) ;Tenex's RC%AWL is too slow, even when no wildcards present + HRROI 2,RESBLK + RCDIR ;Get dir# (initial if wildcard) + ERJMP PRSDI2 ;Syntax error + TLNE 1,(RC%NOM) + JRST PRSDI1 + POP P,1 + JRST POPJ1 + +PRSDI1: MOVEI 1,.FHSLF ;Fake error return from RCDIR + MOVEI 2,GJFX17 + SETER +PRSDI2: MOVEI 1,.FHSLF ;Get last error + PUSHJ P,$GETER + MOVEI 2,GJFX17 ;If no error code, use No Such Directory + POP P,1 ;Release the parse-only JFN + RLJFN + JFCL + HRRZ 1,2 ;Return just error number + POPJ P, +];TNX + +IFN TNX,[ +;;; Enable your capabilities. +COMENA: SKIPN USERID +IFN OZ, PUSHJ P,AUTLOG +.ELSE CERR NLI,[Not logged in] + SETZ D, ;Mask of priv bits. +COMEN1: JUMPLE BC,DOENA ;Jump if no options left + PUSHJ P,COMRD5 + JFCL + MOVEI T,ENALEN-1 ;Number of ENABLE options +COMEN2: CAME A,ENATAB(T) ;Match? + SOJGE T,COMEN2 ; No, keep checking. + JUMPL T,[CERR UUO,[Unknown ENABLE/DISABLE option]] + XCT ENAACT(T) + JRST COMEN1 + +ENATAB: ASCII /ALL/ + ASCII /OPERA/ + ASCII /WHEEL/ +ENALEN==.-ENATAB + +ENAACT: SETO D, + TRO D,SC%OPR + TRO D,SC%WHL + +DOENA: MOVEI 1,.FHSLF + RPCAP ;Get your capabilities. + IOR 3,D ;Turn on requested bits. + EPCAP + MOVEI A,[ASCIZ /ENABLE-CAPABILITIES/] +DOEN1: PUSHJ P,COMCTL + MOVEI 1,.FHSLF + RPCAP ;Possible in 2, enabled in 3. + MOVSI T,-NPRIVS ;Return state of your priviledges. +DOEN2: HRRZ TT,PRVTAB(T) + TRNN 2,(TT) + JRST DOEN3 ; You don't have this priv. + MOVEI BYTE,40 + PUSHJ P,COMCHO + HLRZ A,PRVTAB(T) + PUSHJ P,COMSTO ;You do, so send the name and then T if + MOVEI BYTE,40 ;it's on, else NIL. + PUSHJ P,COMCHO + MOVEI A,[ASCIZ /NIL/] ;This priv is disabled... + TRNE 3,(TT) + MOVEI A,[ASCIZ /T/] ;(and this is is enabled) + PUSHJ P,COMSTO +DOEN3: AOBJN T,DOEN2 + MOVEI BYTE,215 + PUSHJ P,COMCHO + PUSHJ P,COMSND + JRST CTLLOP + +PRVTAB: [ASCIZ /WHEEL/],,SC%WHL ;Privs whose status we + [ASCIZ /OPERATOR/],,SC%OPR ;will return + [ASCIZ /CONFIDENTIAL-INFORMATION-ACCESS/],,SC%CNF + [ASCIZ /MAINTENANCE/],,SC%MNT + [ASCIZ /IPCF/],,SC%IPC + [ASCIZ /ENQ-DEQ/],,SC%ENQ + [ASCIZ /ARPANET-WIZARD/],,SC%NWZ + [ASCIZ /ABSOLUTE-ARPANET-SOCKETS/],,SC%NAS +NPRIVS==.-PRVTAB + +COMDIS: SKIPN USERID +IFN OZ, PUSHJ P,AUTLOG +.ELSE CERR NLI,[Not logged in] + MOVEI 1,.FHSLF + RPCAP + MOVE D,3 ;What you have on now. +COMDI1: JUMPLE BC,DODIS ;Jump if no options left + PUSHJ P,COMRD5 + JFCL + MOVEI T,ENALEN-1 +COMDI2: CAME A,ENATAB(T) + SOJGE T,COMDI2 ; No, keep checking. + JUMPL T,[CERR UUO,[Unknown ENABLE/DISABLE option]] + XCT DISACT(T) + JRST COMDI1 + +DISACT: TRZ D,SC%WHL+SC%OPR + TRZ D,SC%WHL + TRZ D,SC%OPR + +DODIS: MOVEI 1,.FHSLF + RPCAP + MOVE 3,D + EPCAP + MOVEI A,[ASCIZ /DISABLE-CAPABILITIES/] + JRST DOEN1 + +];TNX (ENABLE AND DISABLE COMMANDS) + +;;; Connect/access directory commands +IFN 20X,[ +COMCWD: PUSH P,[[ASCIZ/CWD/]] + PUSH P,[AC%CON] ;Just want to connect + JRST .+3 +COMACD: PUSH P,[[ASCIZ/ACCESS/]] + PUSH P,[AC%OWN] ;Want ownership access to a directory +];20X +IFN 10X,COMCWD: +IFN TNX,[ + SKIPN USERID +IFN OZ, PUSHJ P,AUTLOG +.ELSE CERR NLI,[Not logged in] + JUMPLE BC,CWDIRF ;No good + MOVE 2,BP ;Save byte ref copy + PUSHJ P,COMEUS ;Eat till end of line, hopefully + JUMPL BC,CWDIRF ;Should be a password following + SETZ T, ;Tie it off + DPB T,BP + MOVE 3,2 ;Get start of fellow + ILDB 3,3 ;See if null + JUMPE 3,[GJINF ;Sure enough, get user number into 1 + MOVE 2,1 ;Do an RCDIR on that + JRST .+1] + MOVSI 1,(RC%EMO) ;See if it exists + RCDIR + ERCAL JSYSER + TLNE 1,(RC%NOM) ;Did it? + CERR DNF,[No such directory] + MOVEM 3,RESBLK+.ACDIR ;Save directory number + MOVEM BP,RESBLK+.ACPSW ; and password start + MOVE 3,BP ;See if password is null + ILDB 3,3 + SKIPN 3 + SETZM RESBLK+.ACPSW ;Don't include a pointer if null password + SETOM RESBLK+.ACJOB ;-1 means current job + PUSHJ P,COMEUS ;Scan until end of password + SETZ T, ; and tie it off as usual + DPB T,BP +IFN 20X,[ + POP P,1 ;Get back connect/access code + HRRI 1,3 ;3 elements + MOVEI 2,RESBLK ; here + ACCES +];20X +IFN 10X,[ + HRRZ 1,RESBLK+.ACDIR ;Directory number and no options + MOVE 2,RESBLK+.ACPSW ;String pointer to password + CNDIR +];10X + ERCAL JSYSER ;Give an error return here +IFN 20X,POP P,A ;Name of command for success reply +IFN 10X,MOVEI A,[ASCIZ \CWD\] + PUSHJ P,COMCTL + MOVEI BYTE,215 ;ACCESSdirectory name + PUSHJ P,COMCHO + HRROI 1,RESBLK ;Build full directory specification + MOVE 2,RESBLK+.ACDIR ;Get directory number + DIRST + JFCL ;Ignore errors + PUSHJ P,COMRES ;Send the directory spec + PUSHJ P,COMSND + JRST CTLLOP ;All done + +CWDIRF: CERR BUG,[Illegal request format (no directory name)] +];END IFN TNX + +;;; Create directory + +COMCRD: SKIPN USERID +IFN OZ, PUSHJ P,AUTLOG +.ELSE CERR NLI,[Not logged in] + +IFN TNX,[ +IFN 10X,[ + MOVE T,[-777,,1] ;MUST FIND A FREE DIRECTORY SLOT +CRDFND: HRROI 1,JFNSTR + HRRZ 2,T + DIRST + SKIPA + AOBJN T,CRDFND + JUMPGE T,[CERR CCD,[No free directory slots]] + HRRZM T,CRDBLK+.CDNUM + MOVSI 2,(CD%NUM) +];IFN 10X +.ELSE SETZ 2, ;DEFAULT OPTIONS + SETZM CRDBLK+.CDMOD ;JUST IN CASE +CRDOPT: TRNE F,F.NWL ;NEW LINE TERMINATED OPEN COMMAND? + JRST CRDNAM + PUSHJ P,COMRD5 ;GET NEXT TOKEN + JUMPL BC,COMBAD +CRDOLP: MOVEI T,CRDLEN-1 ;LENGTH OF OPTION TABLE +CRDOL1: CAME A,CRDTAB(T) ;MATCH? + SOJGE T,CRDOL1 ;NOPE, KEEP ON + JUMPL T,[CERR UUO,[Unknown CREATE-DIRECTORY option]] + ASH T,1 + MOVE TT,CRDACT(T) ;GET BIT TO SET + IOR 2,TT + XCT CRDACT+1(T) ;CALL PARSER + JRST COMBAD ;PARSING ERROR + MOVEM A,CRDBLK(TT) ;STICK INTO PARAMETER BLOCK + JRST CRDOPT + +CRDTAB: ASCII \PASSW\ + ASCII \WORKI\ + ASCII \CAPAB\ + ASCII \FILES\ + ASCII \REPEA\ + ASCII \PERMA\ + ASCII \FILE-\ + ASCII \PROTE\ + ASCII \GENER\ + ASCII \USER-\ + ASCII \DIREC\ + ASCII \SUBDI\ + ASCII \ACCOU\ +CRDLEN==.-CRDOPT + +CRDACT: CD%PSW+.CDPSW ? PUSHJ P,CRDPSW + CD%LIQ+.CDLIQ ? PUSHJ P,CRDLIQ + CD%PRV+.CDPRV ? PUSHJ P,CRDPRV + CD%MOD+.CDMOD ? PUSHJ P,CRDDIR + CD%MOD+.CDMOD ? PUSHJ P,CRDRLM + CD%LOQ+.CDLOQ ? PUSHJ P,CRDLOQ + CD%FPT+.CDFPT ? PUSHJ P,CRDFPT + CD%DPT+.CDDPT ? PUSHJ P,CRDDPT + CD%RET+.CDRET ? PUSHJ P,CRDRET + CD%UGP+.CDUGP ? PUSHJ P,CRDUGP + CD%DGP+.CDDGP ? PUSHJ P,CRDDGP + CD%SDQ+.CDSDQ ? PUSHJ P,CRDSDQ + CD%DAC+.CDDAC ? PUSHJ P,CRDDAC + +CRDPSW: +CRDDAC: MOVE A,BP + PUSHJ P,COMEUS + JFCL + SETZ B, + DPB B,BP + JRST POPJ1 + +CRDLIQ: CRDLOQ: CRDRET: +CRDSDQ: PUSHJ P,COMDCI + JRST POPJ1 + +CRDPRV: PUSHJ P,COMOCI + JRST POPJ1 + +CRDDIR: MOVE A,CRDBLK+.CDMOD + TLO A,(CD%DIR) + JRST POPJ1 + +CRDRLM: MOVE A,CRDBLK+.CDMOD + TLO A,(CD%RLM) + JRST POPJ1 + +CRDFPT: +CRDDPT: PUSHJ P,COMOCI + HLL A,500000 + JRST POPJ1 + +IFN 10X,[ +CRDUGP: +CRDDGP: SETZ B, +CRDGRP: PUSHJ P,COMDCI + MOVEI C,1 + LSH 1,(A) + IORI B,C + TRNN F,F.NWL + JRST CRDGRP + JRST POPJ1 +];10X +.ELSE [ +CRDUGP: SKIPA A,[JFNSTR] +CRDDGP: MOVEI A,JFNSTR+11. + PUSH P,A + MOVE B,A + HRLI B,-10. +CRDGRP: AOBJP B,[CERR BUG,[Too many directory groups]] + PUSHJ P,COMDCI + MOVEM A,(B) + TRNN F,F.NWL + JRST CRDGRP + POP P,A + SUBI B,-1(A) + HRRM B,(A) + JRST POPJ1 +];NOT 10X + +CRDNAM: +IFN 20X,[ + MOVE 1,BP + PUSHJ P,COMEUS +];20X +.ELSE [ +CRDNM1: SOJL BC,COMBAD + ILDB BYTE,BP + CAIE BYTE,"< + JRST CRDNM1 + MOVE 1,BP +CRDNM2: SOJL BC,COMBAD + ILDB BYTE,BP + CAIE BYTE,"> + JRST CRDNM2 +];NOT 20X + SETZ T, + DPB T,BP + HRRI 2,CRDBLK + SETZ 3, ;NO PASSWORD + CRDIR + ERCAL JSYSER + +];IFN TNX + +IFN ITS,[ + TRNN F,F.NWL ;MUST END IN NEWLINE + JRST COMBAD + .CALL [ SETZ + SIXBIT /OPEN/ + %CLERR,,ERRCOD + %CLBTW+%CLIMM,,.UAI + %CLIMM,,UTILCH + %CLIN,,[SIXBIT /DSK/] + %CLIN,,[SIXBIT /.FILE./] + %CLIN,,[SIXBIT /(DIR)/] + %CLIN+%CLEND,,USERID] + JRST [ MOVEI A,%ENSDR + JRST CRDNM4 ] + .CLOSE UTILCH, + MOVEI IDX,MAXIDX ;Use the temporary channel for this + PUSHJ P,COMPFN ;PARSE THE FILENAME + .CALL [ SETZ + SIXBIT /OPEN/ + %CLERR,,ERRCOD + %CLBTW+%CLIMM,,.UII + %CLIN,,DATCHN(IDX) + %CLIN,,DATDEV(IDX) + %CLIN,,[SIXBIT /..NEW./] + %CLIN,,[SIXBIT /(UDIR)/] + %CLIN+%CLEND,,DATSNM(IDX)] + SKIPA A,ERRCOD + MOVEI A,%ENSFL ;NO ERROR IF DIR ALREADY EXISTS + CAIE A,%ENSFL +CRDNM4: PUSHJ P,FILERR ;WRONG ERROR => CANNOT CREATE DIR +];IFN ITS + MOVEI A,[ASCIZ \CREATE-DIRECTORY\] + PUSHJ P,COMCTL + PUSHJ P,COMSND + JRST CTLLOP ;All done + +IFN ITS,[ +COMCRL: TRZN F,F.NWL ;Newline? + JRST COMBAD ;Nope, bad command format + MOVEI IDX,MAXIDX ;Use the temporary channel for this + PUSHJ P,COMPFN ;Parse the filename for the link + TRZN F,F.NWL ;Check for correct format + JRST COMBAD + PUSH P,DATDEV(IDX) ;Save link name + PUSH P,DATFN1(IDX) + PUSH P,DATFN2(IDX) + PUSH P,DATSNM(IDX) + MOVE T,BC ;Compensate for incompetently-defined protocol + IDIVI T,4 ;by appending NL to end of command + ADD T,BP + IBP T + SOJGE TT,.-1 + MOVEI TT,215 + DPB TT,T + AOS BC + PUSHJ P,COMPFN ;Parse the name to link to + TRZN F,F.NWL ;Check for correct format + JRST COMBAD + JUMPG BC,COMBAD + .CALL [ SETZ + SIXBIT /MLINK/ + %CLERR,,ERRCOD ;Error code + %CLIN,,-3(P) + %CLIN,,-2(P) + %CLIN,,-1(P) + %CLIN,,0(P) + %CLIN,,DATFN1(IDX) + %CLIN,,DATFN2(IDX) + %CLIN+%CLEND,,DATSNM(IDX)] + PUSHJ P,FILERR ;File error, tell about it + SUB P,[4,,4] + MOVEI A,[ASCIZ \CREATE-LINK\] + PUSHJ P,COMCTL + PUSHJ P,COMSND + JRST CTLLOP +] ;END IFN ITS + +;;; Core buffer allocator +BUFALO: MOVEI T,BUFBAS(IDX) ;Index + SETZM DATBPT(IDX) ;Pointer is zero, meaning virgin buffer + SETZM DATBCT(IDX) ;No room left in buffer + SETZM DATLWD(IDX) ;No last word +IFN ITS,PUSHJ P,PAGALO + LSH T,10. ;Make into address +IFN TNX,[ + SETMM (T) ;Access page to create it + SETMM 1000(T) ;Both half-pages +] ;END IFN TNX + MOVEM T,DATBUF(IDX) ;Remember base of buffer + POPJ P, + +IFN ITS,[ +PAGALO: .CALL [ SETZ + SIXBIT /CORBLK/ + %CLIMM,,%CBNDW+%CBNDR ;Write and read access + %CLIMM,,%JSELF ;Into own job + %CLIN,,T ;c(T) is page number + %CLIMM+%CLEND,,%JSNEW] ;Fresh page + CERR NER,[System virtual memory full] + POPJ P, +] ;END IFN ITS + +;;; Core buffer deallocator +BUFDAL: MOVEI T,BUFBAS(IDX) + SETZM DATBPT(IDX) + SETZM DATBCT(IDX) + SETZM DATLWD(IDX) ;No last word + SETZM DATBUF(IDX) +IFN ITS,PUSHJ P,PAGDAL +IFN TNX,[ + MOVNI 1,1 ;-1 means unmapping a page + MOVE 2,T ;Page number in right half + ADD 2,T ;in half-pages + HRLI 2,.FHSLF ;Process handle in left half +IFN 20X,[ + MOVE 3,[SETZ 2] ;Remove 2 half-pages + PMAP + ERCAL CTLERR +];20X +IFN 10X,[ + SETZ 3, ;Delete page + PMAP + ERCAL CTLERR + AOS T ;Other half page + PMAP + ERCAL CTLERR +];10X +] ;END IFN TNX + POPJ P, + +IFN ITS,[ +PAGDAL: .CALL [ SETZ + SIXBIT /CORBLK/ + %CLIMM,,0 ;Delete page + %CLIMM,,%JSELF + %CLIN+%CLEND,,T] + .LOSE %LSSYS + POPJ P, +] ;END IFN ITS + +;;; IOC error and asynchronous mark transmitters +;;; Both of these routines get called with all interrupts deffered and therefore can use a +;;; shared packet +;;; A contains DATSTA(IDX) +;;; This must be called so that a POPJ returns to "top level". + +;;; c(D)+1 contains error code,,pointer to asciz string +;;; c(D)+2 has return address +ASYERR: PUSH P,PKTLOC ;Direct data to the async packet + MOVEI T,ASYPKT + MOVEM T,PKTLOC + HRRI A,ST%ASY ;Channel now in ASYNC-MARKED state + TLO A,ST.UNC ;But uncontinuable + MOVEM A,DATSTA(IDX) + TRO F,F.FHN ;Force outputting of a file handle + MOVEI A,[ASCIZ \ERROR \] + PUSHJ P,COMCTL ;This will output a transaction ID, which will be ignored + HLLZ A,1(D) ;Get error code + PUSHJ P,COMSXO + MOVEI BYTE,40 + PUSHJ P,COMCHO + HRRZ A,1(D) ;Now output the error string + PUSHJ P,COMSTO + MOVEI T,CO%ASY + DPB T,[$CPKOP+ASYPKT] + DPB BC,[$CPKNB+ASYPKT] +IFN ITS,[ + MOVEI T,CTRLO ;Perhaps have to send this over the control connection + TRNN IDX,1 ;Except if we are already sending data, use IDX's channel + MOVE T,CHACHN(IDX) + .CALL [ SETZ + SIXBIT /PKTIOT/ + %CLIN,,T + %CLIMM+%CLEND,,ASYPKT] + .LOSE %LSSYS + TRNN IDX,1 ;if more packets might come in, defer interrupts + JRST ASYRET + MOVE T,CHABIT(IDX) ;Defer interrupts on this channel until continued + IORM T,SSYDF2 ;Update saved copy of DF2 + .SUSET [.SIDF2,,T] +] ;END IFN ITS +IFN TNX,[ + MOVE 1,CTLJFN + TRNN IDX,1 + MOVE 1,CHAJFN(IDX) + MOVEI 2,.MOPKS + MOVEI 3,ASYPKT + MTOPR + ERCAL CTLERR + MOVEI 1,.FHSLF + MOVE 2,CHABIT(IDX) + DIC +] ;END IFN TNX +ASYRET: POP P,PKTLOC + MOVE A,DATSTA(IDX) ;Insure A stays set up correctly + JRST @2(D) + +;;; c(D)+1 contains continuation address +ICCERR: PUSH P,PKTLOC ;Direct data to the async packet + MOVEI T,ASYPKT + MOVEM T,PKTLOC + HRRI A,ST%ASY ;Channel now in ASYNC-MARKED state + TLZ A,ST.UNC ;They are continuable + MOVEM A,DATSTA(IDX) + HRRZ T,1(D) ;Get continuation address + MOVEM T,DATICN(IDX) ;Remember in case user end asks us to go on + TRO F,F.FHN ;Force outputting of a file handle + MOVEI A,[ASCIZ \ERROR \] + PUSHJ P,COMCTL ;Start off error packet, open failed error code +IFN ITS,[ + .CALL [ SETZ + 'STATUS + %CLIN,,DATCHN(IDX) + %CLOUT+%CLEND,,C ] + .LOSE %LSSYS + HLRZ D,C ;Get just the IOC error + ANDI D,37000 + PUSHJ P,ERR3 ;Get the 3-letter code + HLRZ D,C ;Put error code in standard place +];END IFN ITS +IFN TNX,[ + MOVEI 1,.FHSLF + PUSHJ P,$GETER ;Get last error that happened + PUSHJ P,CTLERR + HRRZM 2,D ;The number of the error + PUSHJ P,ERR3 ;Get the 3-letter code +];TNX + MOVSS A + PUSHJ P,COMSXO + MOVEI A,[ASCIZ \ R \] ;Recoverable error (probably) + PUSHJ P,COMSTO + PUSHJ P,ERRMSG ;Output the error message now + PUSHJ P,ICCERP ;Send packet + POP P,PKTLOC + SUB P,[1,,1] ;Flush the old return address + POPJ P, ;And return to "superior" of routine that had error + +;;; Send IOC error packet +ICCERP: MOVEI T,CO%ASY + DPB T,[$CPKOP+ASYPKT] + DPB BC,[$CPKNB+ASYPKT] + +IFN ITS,[ + MOVEI T,CTRLO ;Perhaps have to send this over the control connection + TRNN IDX,1 ;Except if we are already sending data, use IDX's channel + MOVE T,CHACHN(IDX) + .CALL [ SETZ + SIXBIT /PKTIOT/ + %CLIN,,T + %CLIMM+%CLEND,,ASYPKT] + .LOSE %LSSYS + TRNN IDX,1 ;If more packets might come in, defer interrupts + JRST ICCRET + MOVE T,CHABIT(IDX) ;Defer interrupts on this channel until continued + IORM T,SSYDF2 ;Update saved copy of DF2 + ; Runs at interrupt level -- the interrupt top-level + ; will setup the saved defer word before dismissing. +] ;END IFN ITS + +IFN TNX,[ + MOVE 1,CTLJFN + TRNN IDX,1 + MOVE 1,CHAJFN(IDX) + MOVEI 2,.MOPKS + MOVEI 3,ASYPKT + MTOPR + ERCAL CTLERR + MOVEI 1,.FHSLF + MOVE 2,CHABIT(IDX) + DIC +] ;END IFN TNX + +ICCRET: MOVE A,DATSTA(IDX) ;Insure A stays set up correctly + POPJ P, + +;;; Recieved a new packet. Write it to the appropriate file. IDX set up, but packet +;;; not read from system. Since we can only get one interrupt at a time, we can use a +;;; common packet buffer for the data until/unless we get an IOC error in which case +;;; the data must be saved in the allocated buffer. +WRIONE: +IFN ITS,[ + .CALL [ SETZ + SIXBIT /PKTIOT/ + %CLIN,,CHACHN(IDX) + %CLIMM+%CLEND,,WRIPKT] + .LOSE %LSSYS ;HMM...THIS BETTER NOT HAPPEN +] ;END IFN ITS +IFN TNX,[ + MOVE 1,CHAJFN(IDX) + MOVEI 2,.MOPKR + MOVEI 3,WRIPKT + MTOPR + ERCAL CTLERR +] ;END IFN TNX + SKIPL A,DATSTA(IDX) ;CHANNEL ACTIVE? + JRST WRIBAD ;HMMM...CHANNEL NOT ACTIVE, IGNORE THE PACKET + LDB T,[WRIPKT+$CPKOP] ;GET THE OPCODE + CAIN T,CO%SYN ;Synchronous mark, process it (ignoring channel state) + JRST WRIOSY + JRST @WRIDSP(A) ;ACTIONS TO FOLLOW DEPEND UPON CHANNEL STATE + +;Dispatch table +WRIDSP: WRICLO ;CHANNEL CLOSED + WRIOPN ;CHANNEL OPEN, NORMAL PROCESSING + WRIASY ;ASYNCHRONOUS MARKED + WRISYN ;SYNCHRONOUS MARKED STATE + WRIEOF ;EOF STATE + +;Channel closed, at eof, or sync or asynch mark. Interrupts shouldn't happen +; Channel cannot stay in synchronous mark state for any amount of time, so this shouldn't +; happen either +;These are all reasons a data packet can get thrown away +WRICLO: AERR WRILUZ,BUG,[Data packet being discarded because channel closed] +WRIASY: AERR WRILUZ,BUG,[Data packet being discarded because channel async-marked] +WRISYN: AERR WRILUZ,BUG,[Data packet being discarded because channel sync-marked] +WRIEOF: AERR WRILUZ,BUG,[Data packet being discarded because channel at eof] +WRIBAD: AERR WRILUZ,BUG,[Data packet being discarded because channel not active] + +WRILUZ: TLNN A,ST.SYN ;Expecting sync mark? + AOS (P) ;Nope, don't take any more interrupts + POPJ P, ;Return and perform appropriate action + +;Channel in open state, only one allowed to receive a new packet +WRIOPN: CAIN T,CO%BDT ;BINARY DATA + JRST WRIBIN + CAIN T,CO%TXT ;TEXT DATA + JRST WRITXT + CAIN T,CO%EOF ;END OF FILE? + JRST WRIOEO + AERR WRILUZ,BUG,[Illegal packet opcode] + +;Synchronous mark received +WRIOSY: TLZE A,ST.SYN ;WAS ONE EXPECTED + JRST WRISY0 ;YES, THROW IT AWAY AND PREPARE FOR MORE DATA + HRRI A,ST%SYN ;ELSE PUT CHANNEL INTO SYNC MARKED STATE + MOVEM A,DATSTA(IDX) +IFN ITS,[ + MOVE T,CHABIT(IDX) ;Defer interrupts on this channel until mark processed + IORM T,SSYDF2 ;Update saved DF2 + .SUSET [.SIDF2,,T] +] ;END IFN ITS +IFN TNX,[ + MOVEI 1,.FHSLF + MOVE 2,CHABIT(IDX) + DIC +] ;END IFN TNX + AOS (P) + POPJ P, ;RETURN AND DISMISS INTERRUPT + +WRISY0: TLZ A,ST.SYN ;Make sure sync mark is no longer expected + PUSHJ P,@DATSYA(IDX) ;Call routine to handle receipt of sync mark + MOVEM A,DATSTA(IDX) ;Routine may have altered status + POPJ P, + +;EOF received +WRIOEO: PUSHJ P,WRIFOR ;FORCE OUT ANY REMAINING BUFFERS + HRRI A,ST%EOF ;PUT CHANNEL IN EOF STATE + MOVEM A,DATSTA(IDX) + POPJ P, ;RETURN AND DISMISS INTERRUPT + +;Text data received +;Note: ITS SIOT is much faster if you always send a multiple of 5 characters +;so that everything stays on word boundaries. So we will move any residual +;part word down to the front of the buffer and save it for next time, setting +;DATBCT to the number of characters saved and DATBPT to point after them. +WRITXT: TLNE A,ST.BIN ;FILE OPEN IN BINARY MODE? +WRIIDO: AERR WRILUZ,BUG,[Illegal data opcode] + SETZ BC, + MOVE BP,DATBUF(IDX) ;USE BUFFER TO HOLD BYTES + HRLI BP,440700 ;7 BIT BYTES + SKIPE DATBPT(IDX) + MOVE BP,DATBPT(IDX) ;POINT AFTER OLD STUFF IN BUFFER + LDB T,[WRIPKT+$CPKNB] ;NUMBER OF BYTES + ADDM T,DATRCV(IDX) + MOVE TT,[441000,,WRIPKT+%CPKDT] +;;; Note: Assumption is that even if the packet consisted of all newlines the buffer could +;;; not be overflowed. If this is not the case, then something else has to be hacked +;;; here. +WRITX1: SOJL T,WRITX0 ;DONE WHEN NO MORE BYTES + ILDB BYTE,TT ;ELSE GET NEXT BYTE + TLNN A,ST.RAW ;If raw mode, don't translate + XCT CHR210(BYTE) ;Convert to PDP-10 code + SKIPA ;Non-skip means character not processed + JRST WRITX1 ;Skip means character has been processed + IDPB BYTE,BP + AOJA BC,WRITX1 + +WRITX0: JUMPE BC,CPOPJ ;If no bytes to write out (0 length packet), return and dismis + ADDM BC,DATLEN(IDX) ;Keep track of number of bytes written + MOVE BP,DATBUF(IDX) ;Write starting from beginning of buffer + HRLI BP,440700 + ADD BC,DATBCT(IDX) ;Include characters left over from last time + MOVE T,BC ;Round down to multiple of a word + IDIVI T,5 + IMULI T,5 + SUB BC,T ;Number of characters that will be left over + MOVEM BC,DATIOC(IDX) +IFN ITS,[ + .CALL [ SETZ + SIXBIT /SIOT/ + %CLIN,,DATCHN(IDX) + %CLIN,,BP + %CLIN+%CLEND,,T] + JFCL ;Here if IOC error +] ;END IFN ITS +IFN TNX,[ + MOVE 1,DATJFN(IDX) + MOVE 2,BP + MOVN 3,T + JUMPE 3,.+3 + SOUT + ERJMP .+1 + MOVN T,3 + MOVE BP,2 +] ;END IFN TNX + MOVEM T,DATBCT(IDX) ;Save the byte count remaining within the word-aligned part + MOVEM BP,DATBPT(IDX) ;and the byte pointer to not-yet-output chars + JUMPE T,WRITX2 ;If everything SIOT'ed, go handle residue + IOCERR WRITX2 ;Else IOC error, continuation when fixed up after SIOT done + +WRITX2: SKIPN BC,DATIOC(IDX) ;Get number characters to be saved for next time + JRST [ SETZM DATBPT(IDX) ? POPJ P, ] ;No characters + CAIL BC,5 + PUSHJ P,CTLERR ;This can't happen + MOVEM BC,DATBCT(IDX) + MOVE T,DATBPT(IDX) + ;; Don't need to make BP agree with ITS on TOPS-20, since this IBP equalizes them + IBP T ;Points to first byte to be saved for next time + MOVE TT,(T) ;Move that word down to the front + MOVE BP,DATBUF(IDX) ;Make a byte pointer to after them + HRLI BP,440700 + IBP BP + SOJG BC,.-1 + MOVEM BP,DATBPT(IDX) + MOVEM TT,(BP) + POPJ P, + +;Binary data received +WRIBIN: TLNN A,ST.BIN ;MUST BE A BINARY MODE FILE + JRST WRIIDO + SKIPE T,DATBPT(IDX) ;ARE WE IN THE MIDDLE OF A PREVIOUS OPERATION? + JRST WRIBI0 ;YES, SO CONTINUE PROCESSING IT + HRRZ T,DATBYT(IDX) + CAIE T,16. ;16 BIT BYTE MODE? + JRST WRIBI1 ;NOPE, SO NEED SPECIAL HANDLING ANYWAY + LDB T,[WRIPKT+$CPKNB] ;NUMBER OF BYTES + MOVEI D,(T) ;COPY INTO D + LSH T,-1 ;Number of bytes getting written + ADDM T,DATLEN(IDX) + LSH T,-1 ;NUMBER OF PDP-10 WORDS, ROUNDED DOWN + MOVE TT,[444400,,WRIPKT+%CPKDT] +IFN ITS,[ + .CALL [ SETZ ;WRITE THE DATA DIRECTLY FROM THE PACKET + SIXBIT /SIOT/ + %CLIN,,DATCHN(IDX) + %CLIN,,TT ;POINTER + %CLIN+%CLEND,,T] + SKIPA ;IOC error + JUMPE T,WRIBI2 ;WROTE OUT ALL THE DATA, PROCEED +] ;END IFN ITS +IFN TNX,[ + MOVE 1,DATJFN(IDX) + MOVE 2,TT ;Pointer + MOVN 3,T ;Negative count -- output this many bytes + JUMPE 3,.+3 + SOUT + ERJMP .+2 + JRST [PUSHJ P,ITSBP + MOVE TT,2 ;Get updated pointer + JRST WRIBI2] + MOVN T,3 + MOVE TT,2 +] ;END IFN TNX + MOVE B,DATBUF(IDX) ;SAVE PACKET IN IDX BUFFER + MOVEI C,(B) ;COPY FOR TERMINATION CONDITION + HRLI B,WRIPKT + BLT B,%CPMXW-1(C) ;SAVE ALL OF PACKET + SUBI C,WRIPKT ;OFFSET FOR BYTE POINTER + ADD TT,C + MOVEM TT,DATBPT(IDX) ;SAVE POINTER + MOVEM T,DATBCT(IDX) ;AND SAVE COUNT + IOCERR WRIBI5 ;GIVE THE IOC ERROR, CONTINUATION + +WRIBI5: MOVE TT,DATBPT(IDX) ;IOC ERROR RECOVERY PUTS FINAL BP HERE + SETZM DATBPT(IDX) ;No longer need pointer + MOVE D,DATBUF(IDX) ;SAVED PACKET, AND NEED TO GET BYTE COUNT BACK + LDB D,[$CPKNB (D)] + +WRIBI2: TRNN D,3 ;DID WE GET AN ODD NUMBER OF BYTES? + POPJ P, ;NOPE, THEN DONE WITH PACKET +;Here if 16 bit byte mode, but have an odd number of bytes. Next packet will have to do +; it slowly + LSH D,-2 ;NUMBER OF WORDS - 1 + IBP TT ;POINT AT NEXT BYTE TO BE DONE + MOVE T,(TT) ;GET THE BYTE + MOVE TT,DATBUF(IDX) ;ADDRESS IN WHICH TO SAVE + MOVEM T,(TT) ;SAVE THE WORD CONTAINING THE BYTE IN THE BUFFER + HRLI TT,242000 ;A POINTER TO IT + MOVEM TT,DATBPT(IDX) + MOVEI T,1 ;ONE BYTE REMAINS + MOVEM T,DATBCT(IDX) + POPJ P, ;THEN WE ARE DONE + +;Here if non-16bit byte mode but no bytes left over from last time, byte size in T +WRIBI1: SETZM DATBCT(IDX) ;Make sure byte count is 0 + HRLI T,440000 ;Prototype byte pointer + DPB T,[300600,,T] ;Deposit correct byte size into pointer + HRR T,DATBUF(IDX) ;Pointer to buffer +;;; Fall into WRIBI0 + +;Here if had some bytes left over from last time, T has the pointer to last byte written +WRIBI0: LDB BC,[WRIPKT+$CPKNB] ;COUNT OF BYTES IN PACKET + LSH BC,-1 ;16 bit mode only has half as many + ADDM BC,DATLEN(IDX) ;Keep track of number of more bytes to write + MOVEI C,(BC) ;Save number of bytes + ADD C,DATBCT(IDX) ;Add in number of bytes left over + HRRZ TT,DATBUF(IDX) ;Pointer for SIOT (used later) + HRLI TT,444400 + JUMPE BC,WRIBI6 ;If no bytes in packet, finish up here and now + HRRI B,(T) ;THIS IS THE FIRST WORD TO SIOT OUT OF + MOVE BP,[442000,,WRIPKT+%CPKDT] +WRIBI4: SOJL BC,WRIBI3 ;LOOP OVER ALL BYTES + ILDB BYTE,BP + IDPB BYTE,T + JRST WRIBI4 + +WRIBI3: HRRZ D,DATBPW(IDX) + CAIGE C,(D) ;Enough bytes to make up a word? + JRST WRIBI6 ;Nope + MOVE D,T ;Must increment byte pointer in case last byte was written + IBP D + SUBI D,(B) + HRRZI B,(D) ;Get rid of byte pointer part +IFN ITS,[ + .CALL [ SETZ + SIXBIT /SIOT/ + %CLIN,,DATCHN(IDX) + %CLIN,,TT + %CLIN+%CLEND,,B] + SKIPA ;IOC error + JUMPE B,WRIBI6 ;Done writing successfully, so go on + MOVEM TT,DATBPT(IDX) + MOVEM B,DATBCT(IDX) +] ;END IFN ITS +IFN TNX,[ + MOVE 1,DATJFN(IDX) + MOVE 2,TT + MOVN 3,B + JUMPE 3,.+3 + SOUT + ERJMP .+2 + JRST [PUSHJ P,ITSBP + MOVE TT,2 ;Rest of code needs updated pointer + JRST WRIBI6] + MOVEM 2,DATBPT(IDX) + MOVNM 3,DATBCT(IDX) +] ;END IFN TNX + HLL C,T ;Save final byte pointer + MOVEM C,DATIOC(IDX) ;Remember total number of bytes in buffer for continuation + IOCERR WRIBI7 ;IOC ERROR, CONTINUATION TO WRIBI7 + +WRIBI7: MOVE TT,DATBPT(IDX) ;Restore byte pointer, IOC error handler leaves final ptr here + HRRZ C,DATIOC(IDX) ;Restore total number of bytes that were in buffer + HLLZ T,DATIOC(IDX) ;Also restore left half of final byte pointer + +;Here after IOC error fixed or after normal completion of output operation +WRIBI6: SETZM DATBPT(IDX) ;Assume no bytes left + IDIV C,DATBPW(IDX) ;Remainder is number of bytes left over in last word + JUMPE D,CPOPJ ;We assumed correctly, no extra words + HRR T,DATBUF(IDX) ;Pointer to buffer + IBP TT ;Point at next byte to go out + MOVE C,(TT) ;Get the last word which has extra bytes in it + MOVEM C,(T) ;Store as first word in buffer + MOVEM T,DATBPT(IDX) ;New byte pointer + MOVEM D,DATBCT(IDX) ;And character count + POPJ P, + +;;; Force out any data remaining in the buffer. Called from main program level. +;;; This is -NOT- for continuing from IOC errors, which is done by a different routine. +;;; It is for writing out a residual half-word in binary mode, or for +;;; writing out residual part-word characters in text mode. +WRIFOR: SKIPN T,DATBPT(IDX) ;Any bytes in buffer? + POPJ P, ;Nope, then done right now + MOVE TT,DATSTA(IDX) ;Binary mode? + TLNN TT,ST.BIN + JRST [ MOVE TT,DATBUF(IDX) ;Pointer to beginning of buffer + HRLI TT,440700 + MOVE T,DATBCT(IDX) ;Number of bytes now in buffer + JRST WRIFR1 ] + HRRZS T ;Get rid of byte position and size info + MOVE TT,DATBUF(IDX) ;To build byte pointer + HRLI TT,444400 + SUBI T,1(TT) ;First calculate actual number of words to SIOT + MOVMS T +WRIFR1: +IFN ITS,[ + .CALL [ SETZ + SIXBIT /SIOT/ + %CLIN,,DATCHN(IDX) + %CLIN,,TT + %CLIN+%CLEND,,T] + JFCL ;IOC errors will get handled in the wash + MOVEM T,DATBCT(IDX) ;This will be 0 if no IOC error + MOVEM TT,DATBPT(IDX) + JUMPN T,CPOPJ ;If got IOC error, return now + SETZM DATBPT(IDX) ;Else leave pointer zeroed out + POPJ P, +] ;END IFN ITS +IFN TNX,[ + MOVE 1,DATJFN(IDX) + MOVE 2,TT + MOVN 3,T + JUMPE 3,.+3 + SOUT + ERJMP .+2 + JRST [SETZM DATBPT(IDX) + POPJ P,] + MOVEM TT,DATBPT(IDX) + MOVNM T,DATBCT(IDX) + POPJ P, +] ;END IFN TNX + +;;; Here to send one packet over a data conneciton. IDX is set up. Called with interrupts +;;; off so that the shared packet buffer may be used +REAONE: MOVE A,DATSTA(IDX) ;Get channel state + TLZE A,ST.SYN ;Is a synchronous mark required on this channel? + JRST REASSY ;Yes, send it (ignoring channel state) + JRST @READSP(A) ;Actions to follow depend upon channel state + +;Dispatch table +READSP: REACLO ;Channel closed + REAOPN ;Channel open, normal processing + REAASY ;Asynchronous marked (should never happen) + REASYN ;Synchronous marked state + REAEOF ;EOF state + +;Channel closed, at eof, or sync or asynch mark. Interrupts shouldn't happen +; Channel cannot stay in synchronous mark state for any amount of time, so this shouldn't +; happen either +REACLO: +REAASY: +REASYN: +REAEOF: AOS (P) + POPJ P, + +;Here to send sync mark +REASSY: MOVEI T,CO%SYN ;Synchronous mark opcode + HRRI A,ST%SYN ;Now in sync mark state + PUSHJ P,REAEPK ;Output the packet, but return here + JFCL + PUSHJ P,@DATSYA(IDX) ;Call the routine to process the synchronous mark + MOVEM A,DATSTA(IDX) + POPJ P, + +;Here to send an empty packet, opcode is in T +REAEPK: DPB T,[$CPKOP+REAPKT] ;Deposit in packet + SETZ T, + DPB T,[$CPKNB+REAPKT] ;Packet contains no information other than opcode +IFN ITS,[ + .CALL [ SETZ + SIXBIT/PKTIOT/ + %CLIN,,CHACHN(IDX) + %CLIMM+%CLEND,,REAPKT] + .LOSE %LSSYS +] ;END IFN ITS +IFN TNX,[ + MOVE 1,CHAJFN(IDX) + MOVEI 2,.MOPKS + MOVEI 3,REAPKT + MTOPR + ERCAL CTLERR +] ;END IFN TNX + MOVEM A,DATSTA(IDX) ;Remember to save new status word + AOS (P) ;Skip return + POPJ P, + +;Here when hit EOF. Put channel into EOF state and send EOF packet +REAOEO: HRRI A,ST%EOF ;EOF state + MOVEI T,%COEOF ;Send eof packet +IFN ITS,[ + JRST REAEPK +] ;END IFN ITS +IFN TNX,[ + MOVE 1,CHAJFN(IDX) + MOVEI 2,.MOEOF + MTOPR + ERCAL CTLERR + MOVEM A,DATSTA(IDX) + AOS (P) + POPJ P, +] ;END IFN TNX + +;Here to send more data over the data connection +REAOPN: TLNE A,ST.BIN ;Binary mode? + JRST REABIN ;Yes, requires different code + SKIPG DATBCT(IDX) ;Any bytes left in buffer? + PUSHJ P,REABUF ;Nope, fill up buffer + SKIPG T,DATBCT(IDX) ;Did we get any bytes? + JRST REAOEO ;Nope, put channel into EOF state and send an EOF packet + MOVE TT,DATBPT(IDX) ;Pointer into buffer + SETZ BC, ;No bytes in packet + MOVE BP,[441000,,REAPKT+%CPKDT] ;Pointer to start of data in packet +REATXT: ILDB BYTE,TT ;Get next byte from file + TLNN A,ST.RAW ;Raw mode means don't translate + XCT CHR2LM(BYTE) ;Check if any special processing is needed + AOJA BC,REATX0 ;None needed, just output character + JRST REATX1 ;Special processing is done, so just punt the byte + JRST REATX4 ;Skipped twice, a rubout escape. + MOVEI BYTE,"M ;CR, store as M for now in case no LF + IDPB BYTE,BP + ADDI BC,1 + SOJLE T,REATX5 ;and absorb following linefeed if any +REATX6: ILDB BYTE,TT + CAIN BYTE,12 + JRST [ MOVEI BYTE,215 + DPB BYTE,BP + JRST REATX1] + ADD TT,[070000,,] ;Not a line feed, put it back + AOJA T,REATX1 ;Treat stray CR as CRLF + +REATX5: PUSHJ P,REABUF ;Get next buffer, first char follows a CR + SKIPG T,DATBCT(IDX) + JRST REATXS ;End of file + MOVE TT,DATBPT(IDX) + JRST REATX6 + +REATX4: TLNE A,ST.SUI ;Super-image mode means just send rubouts + AOJA BC,[MOVEI BYTE,177 ? JRST REATX0] + SOJLE T,REATX2 ;Jump if end of file-buffer +REATX3: ILDB BYTE,TT ;Get the byte that follows the rubout + XCT CHRQLM(BYTE) ;Convert. Will need no special processing + ADDI BC,1 +REATX0: IDPB BYTE,BP ;Store the byte +REATX1: CAML BC,CHPMXC ;Have we written the maximum number of bytes? + SOJA T,REATXS ;Yes, send the packet and return (account for byte as well) + SOJG T,REATXT ;If more characters in buffer just go on + PUSHJ P,REABUF ;Read a new bufferful + SKIPG T,DATBCT(IDX) ;Did we get any more data? + JRST REATXS ;Nope, just send what we have so far + MOVE TT,DATBPT(IDX) ;Else get the byte pointer + JRST REATXT ;And proceed with the transmission + +REATX2: PUSHJ P,REABUF ;Get next buffer, first char is quoted with rubout + SKIPG T,DATBCT(IDX) + JRST REATXS ;Oops, end of file in bad place, ignore the stray rubout + MOVE TT,DATBPT(IDX) + JRST REATX3 + +;Here to store T and TT and send the packet +REATXS: MOVEM T,DATBCT(IDX) ;Save byte count + MOVEM TT,DATBPT(IDX) ;And pointer + JUMPE BC,CPOPJ ;Don't bother transmitting if the packet is null + MOVEI T,CO%TXT ;Data opcode + TLNE A,ST.BIN ;Except if binary mode + TRO T,100 ;This is the correct opcode + DPB T,[REAPKT+$CPKOP] + DPB BC,[REAPKT+$CPKNB] +IFN ITS,[ + .CALL [ SETZ + SIXBIT /PKTIOT/ + %CLIN,,CHACHN(IDX) + %CLIMM+%CLEND,,REAPKT] + .LOSE %LSSYS +] ;END IFN ITS +IFN TNX,[ + MOVE 1,CHAJFN(IDX) + MOVEI 2,.MOPKS + MOVEI 3,REAPKT + MTOPR + ERCAL CTLERR +] ;END IFN TNX + POPJ P, ;Packet has been transmitted, so return + +;Here to read in binary mode +REABIN: HRRZ T,DATBYT(IDX) ;Get byte size + SKIPG DATBCT(IDX) ;If bytes in the buffer + CAIE T,16. ; or if not 16 bit bytes, use slow mode + JRST REABIS + MOVE T,CHPMXW ;Maximum number of words in a packet + MOVE TT,[444400,,REAPKT+%CPKDT] +IFN ITS,[ + .CALL [ SETZ ;Read data into the packet + SIXBIT /SIOT/ + %CLIN,,DATCHN(IDX) + %CLIN,,TT + %CLIN+%CLEND,,T] + JRST REABI0 ;Ioc error +] ;END IFN ITS +IFN TNX,[ + MOVE 1,DATJFN(IDX) + MOVE 2,TT + MOVN 3,T ;Negative count is number of bytes we want + SIN + ERCAL REAIOC ;Skips if IOC error as opposed to EOF + SKIPA + JRST REABI0 + MOVN T,3 + MOVE TT,2 +] ;END IFN TNX + CAMN T,CHPMXW ;Did we get any data at all? + JRST REAOEO ;Nope, EOF: send EOF packet, change channel state, and return + MOVE BC,CHPMXW ;Calculate actual number of bytes read + SUBI BC,(T) + LSH BC,2 + SETZB T,TT ;Don't get faked into thinking stuff is buffered + JRST REATXS ;Send the packet + +;Here on IOC error +REABI0: MOVE B,DATBUF(IDX) ;SAVE PACKET IN IDX BUFFER + MOVEI C,(B) ;COPY FOR TERMINATION CONDITION + HRLI B,REAPKT + BLT B,%CPMXW-1(C) ;SAVE ALL OF PACKET + SUBI C,WRIPKT ;OFFSET FOR BYTE POINTER + ADD TT,C + MOVEM TT,DATBPT(IDX) ;SAVE POINTER + MOVEM T,DATBCT(IDX) ;AND SAVE COUNT + IOCERR REABI1 ;GIVE THE IOC ERROR, CONTINUATION + +;IOC error continuation +REABI1: MOVE BC,CHPMXW ;Calculate actual number of bytes read + SUB BC,DATBCT(IDX) + LSH BC,1 + MOVEI T,CO%BDT ;Data opcode + DPB T,[REAPKT+$CPKOP] + DPB BC,[REAPKT+$CPKNB] +IFN ITS,[ + .CALL [ SETZ + SIXBIT /PKTIOT/ + %CLIN,,CHACHN(IDX) + %CLIMM+%CLEND,,DATBUF(IDX)] + .LOSE %LSSYS +] ;END IFN ITS +IFN TNX,[ + MOVE 1,CHAJFN(IDX) + MOVEI 2,.MOPKS + MOVEI 3,DATBUF(IDX) + MTOPR + ERCAL CTLERR +] ;END IFN TNX + POPJ P, ;Packet has been transmitted, so return + +;Slow binary mode. Read block into buffer and use ILDB/IDPB loop to fill packet +REABIS: SKIPG DATBCT(IDX) ;Any bytes left in buffer? + PUSHJ P,REABUF ;Nope, fill up buffer + SKIPG T,DATBCT(IDX) ;Did we get any bytes? + JRST REAOEO ;Nope, put channel into EOF state and send an EOF packet + MOVE TT,DATBPT(IDX) ;Pointer into buffer + SETZ BC, ;No bytes in packet + MOVE BP,[442000,,REAPKT+%CPKDT] ;Pointer to start of data in packet +REABS0: ILDB BYTE,TT ;Get next byte from file + IDPB BYTE,BP ;Store the byte + ADDI BC,2 ;Two more bytes + CAML BC,CHPMXC ;Have we written the maximum number of bytes? + SOJA T,REATXS ;Yes, send the packet and return + SOJG T,REABS0 ;If more characters in buffer just go on + HRRZ T,DATBYT(IDX) ;This 16 bit byte mode? + CAIN T,16. + JRST REABS1 ;Yup, send a small packet and do the rest quickly + PUSHJ P,REABUF ;Read a new bufferful + SKIPG T,DATBCT(IDX) ;Did we get any more data? + JRST REATXS ;Nope, just send what we have so far + MOVE TT,DATBPT(IDX) ;Else get the byte pointer + JRST REABS0 ;And proceed with the transmission + +REABS1: SETZB T,TT ;Make sure we go through fast path next time + JRST REATXS + + +;;; Routine to fill up in-core buffer +;;; Destroy's: B, C, D, T, TT +REABUF: MOVE T,DATBUF(IDX) ;Pointer to the buffer + HRLI T,440700 ;Assume 7 bit bytes + TLNE A,ST.BIN ;Binary mode? + HRLI T,444400 ;Yes, really 36 bit bytes + MOVEM T,DATBPT(IDX) ;Byte pointer if no IOC error + MOVEI TT,2000*5 ;This is correct number of bytes for text mode + TLNE A,ST.BIN ;But is it binary mode? + MOVEI TT,2000 ;Yes, then this is correct byte count + MOVEI B,(TT) ;Count expected maximally + TLNN A,ST.BIN ;Can't have saved word in binary mode + SKIPN D,DATLWD(IDX) ;Do we have a saved last word? + JRST REABF6 ;Nope, proceed normally + SETZM DATLWD(IDX) ;No more last word + MOVEM D,(T) ;Save the word as first buffer word + ADDI T,1 ;Increment pointer + SUBI TT,5 ;Read 5 fewer bytes +REABF6: TLNE A,ST.DIR ;Directory listing? + JRST REDRBF ;Yes, handled specially +IFN ITS,[ + .CALL [ SETZ + SIXBIT /SIOT/ + %CLIN,,DATCHN(IDX) + %CLIN,,T + %CLIN+%CLEND,,TT] + JRST REABF1 ;IOC error +] ;END IFN ITS +IFN TNX,[ + MOVE 1,DATJFN(IDX) + MOVE 2,T + MOVN 3,TT ;Negative count is number of bytes we want + SIN + ERCAL REAIOC ;Skips if IOC error as opposed to EOF, sets up T and TT + SKIPA + JRST REABF1 + MOVN TT,3 + MOVE T,2 +] ;END IFN TNX +REABF3: SUBI B,(TT) ;Actual number of bytes read + TLNN A,ST.BIN ;Binary mode? + JRST REABF4 ;Nope, no special processing + HRRZ D,DATBYT(IDX) + DPB D,[300600,,DATBPT(IDX)] ;Correct size bytes + MOVEI C,36. ;Have number of 36 bit words, need number of real bytes + IDIVI C,(D) + IMULI B,(C) ;Calculate actual number of bytes read +REABF4: MOVEM B,DATBCT(IDX) ;Remember count +IFN TNX,[ + POPJ P, ;No need to do trailing control-C checking here +] ;END IFN TNX +IFN ITS,[ + SKIPE B ;Return right away if we read nothing + TLNE A,ST.BIN ;If binary mode then done + POPJ P, +IFN ITS,[ +;; TT has number of bytes we tried to read, T has pointer to last byte hacked (almost...) +;; Due to gross ITS lossage, check for initial special case of 440700,, and +;; fix it + HLRZ TT,T + CAIN TT,440700 + SUB T,[430000,,1] +] ;END IFN ITS + CAIE TT,(B) ;If we got less than we wanted, we hit EOF + JRST READLC +;; We got a full bufferload, but we may have hit EOF! So, must save last word and tack +;; it on next time when we'll know for sure whether we got to EOF + MOVE TT,(T) ;Get the last word + TRO TT,1 ;Force it to be non-zero by setting bit 35 (argghh!) + MOVEM TT,DATLWD(IDX) ;Save the "Last word" + SUBI B,5 + MOVEM B,DATBCT(IDX) + POPJ P, + +;; Search backwards removing trailing eof chars from the last word +;; T has BP to last byte read, B has count of bytes +READLC: LDB TT,T ;Get last character + CAIE TT,^C + CAIN TT,^L + SOJG B,[ ADD T,[070000,,] + JUMPGE T,READLC + SUB T,[430000,,1] + JRST READLC] + JUMPE B,REABUF ;Get another bufferful if no valid bytes found + MOVEM B,DATBCT(IDX) ;Store number of bytes in buffer + POPJ P, ;Then return +] ;END IFN ITS + +REABF1: POP P,DATIOC(IDX) ;Save address of our caller + HRLM B,DATIOC(IDX) ;Also save total number of bytes to be read + MOVEM T,DATBPT(IDX) ;Pointer + MOVEM TT,DATBCT(IDX) ;Remaining bytes to read + IOCERR REABF2 + +REABF2: PUSH P,DATIOC(IDX) ;Restore adr of our caller + HLRZ B,DATIOC(IDX) ;Total number of bytes expected + MOVE TT,DATBCT(IDX) ;Need bytes left to read + JRST REABF3 + +IFN TNX,[ +REAIOC: MOVE T,2 ;Updated byte pointer + MOVN TT,3 ;Updated count + MOVEI 1,.FHSLF ;Get last error + PUSHJ P,$GETER + JFCL + HRRZS 2 ;Only error number + CAIE 2,IOX4 ;EOF, so non-skip + AOS (P) + MOVE 2,T ;Callers expect these results in 2 and 3 + MOVN 3,TT + POPJ P, + +$GETER: +IFN 10X,[ + PUSH P,4 + PUSH P,5 + PUSH P,6 + PUSH P,7 + PUSH P,10 +] + GETER + ERJMP .+2 +IFN 10X,[ + AOS -5(P) + POP P,10 + POP P,7 + POP P,6 + POP P,5 + POP P,4 +] +.ELSE AOS (P) + POPJ P, + +] ;END IFN TNX + +;Interrupt table +IFN ITS,[ +INTTAB: + LOC 42 + -INTLEN,,INTTAB +LOC INTTAB + 17,,P + %PIIOC ? 0 ? %PIIOC+%PIDBG+%PIDWN ? 177777 ? IOCINT + %PIDBG ? 0 ? %PIDBG+%PIDWN ? 0 ? DBGINT + %PIDWN ? 0 ? %PIDBG+%PIDWN ? 0 ? DWNINT +REPEAT MAXIDX,[ + 0 ? 1_<.RPCNT+3> ? %PIDBG+%PIDWN ? 177777 ? CHAINT+<2*.RPCNT> +] + +INTLEN==.-INTTAB + +;;; Here on receipt of channel interrupt from one of the chaosnet channels. +;;; Figure out which one, and perform the appropriate actions. All AC's saved by system. +;;; All other channel interrupts deffered +CHAINT: MOVEI IDX,0 ;IDX will contain index that got interrupt + JRST CHAIN0 + MOVEI IDX,1 + JRST CHAIN0 + MOVEI IDX,2 + JRST CHAIN0 + MOVEI IDX,3 + JRST CHAIN0 + MOVEI IDX,4 + JRST CHAIN0 + MOVEI IDX,5 +; JRST CHAIN0 +CHAIN0: PUSHJ P,CHALOP ;Handle this IDX + MOVE T,SSYDF2 ;Cause correct DF2 when dismissed + MOVEM T,-20(P) ;Correct offset: all AC's, the old PC + .CALL [ SETZ + SIXBIT /DISMIS/ + %CLBTW,,INTTAB + %CLIN+%CLEND,,P] + .LOSE %LSSYS + +;Here with IDX properly set up +CHALOP: .CALL [ SETZ ;Find out why the interrupt happened + SIXBIT /WHYINT/ + %CLIN,,CHACHN(IDX) + %CLOUT,,T ;%WYCHA + %CLOUT,,T ;State + %CLOUT+%CLEND,,TT] ;#in packets available ,, #out packets available + .LOSE %LSSYS ;Hmm... + JRST CHAIND(T) ;Dispatch on state +] ;END IFN ITS + +;Dispatch table for channel state +CHAIND: JRST CHACLS ;Closed, so close down the channel (protocol violation!!) + JRST CHALSN ;Listen!! + JRST CHARFC ;RFC received!!(!!) + JRST CHARFS ;RFC SENT!!!!!! (This is getting out of hand...) + JRST CHAOPN ;Open ("Better, better") + JRST CHALOS ;Hmm...LOS received + JRST CHAINC ;Incomplete [poor Lisp Machine died....] + + +CHARFS: POPJ P, +CHALSN: +CHARFC: + +CHALOS: +CHAINC: +CHACLS: +;;; Hmmm...Lisp Machine went down or forgot us. Go away if it was a channel in active +;;; use. If not, it is possible that it was a channel that failed to open correctly, +;;; in which case it was just timing out. That's probably ok. + TRZ IDX,1 ;Check input and output + SKIPL DATSTA(IDX) + SKIPGE DATSTA+1(IDX) + PUSHJ P,CTLDON ;If either channel in use, Lisp Machine must have gone away. + JRST CHNFLS ;Flush channels, then return + +CHAOPN: TRNE IDX,1 ;Reading or writing? + JRST CHAOPO ;Writing, handle slightly differently + TRNN TT,-1 ;Any output packets available? + POPJ P, ;Nope, then done...just return + PUSHJ P,REAONE ;Handle the packet + JRST CHALOP ;Loop if no error + POPJ P, ;Else return + +CHAOPO: TLNN TT,-1 ;Any packets to read? + POPJ P, ;Nope + PUSHJ P,WRIONE + JRST CHALOP + POPJ P, ;Error, return right away + + +IFN ITS,[ +;;; IOC error handler + +IOCINT: .SUSET [.RBCHN,,T] ;Get channel that had error + CAIL T,CHALOW + CAILE T,CHAHIG + JRST IOCDAT ;Not CHAOS channel, must be data error + PUSHJ P,CTLDON ;Else something happened to Lisp Machine, we are done + +IOCDAT: AOS -17(P) ;Setup to return to location after call which caused error + .CALL [ SETZ + SIXBIT /DISMIS/ + %CLBTW,,INTTAB + %CLIN+%CLEND,,P] + .LOSE %LSSYS + +;;; System going down and system being debugged inform user then exit to CTLLOP +DBGINT: PUSHJ P,DWNIN1 ;Set up to return notification + MOVEI A,[ASCIZ/system being debugged./] + SKIPN C + MOVEI A,[ASCIZ/system no longer being debugged./] +DWNIN2: PUSHJ P,COMSTO +DWNIN9: .CLOSE ERRCH, + MOVEI T,CO%NOT + PUSHJ P,COMSN1 + JRST CTLLOP + +DWNIN1: MOVE BP,[441000,,%CPKDT+CTLPKO] + SETZ BC, + .CALL [ SETZ ? 'SSTATU ? MOVEM B ? SETZM C ] + .LOSE %LSSYS + POPJ P, + +DWNINT: PUSHJ P,DWNIN1 + MOVEI A,[ASCIZ/system revived./] + JUMPL B,DWNIN2 + MOVEI A,[ASCIZ/system going down in /] + PUSHJ P,COMSTO + IDIVI B,30. + IDIVI B,60. ;B minutes until down, C seconds + SKIPN A,B + JRST DWNIN3 + PUSHJ P,COMDCO + MOVEI A,[ASCIZ/ minutes, /] + PUSHJ P,COMSTO +DWNIN3: MOVE A,C + PUSHJ P,COMDCO + MOVEI A,[ASCIZ/ seconds./] + PUSHJ P,COMSTO + .OPEN ERRCH,[.UAI,,'SYS ? SIXBIT/DOWN/ ? SIXBIT/MAIL/] + JRST DWNIN9 + MOVEI BYTE,215 +DWNIN4: CAMGE BC,CHPMXC + CAIGE BYTE,40 + CAIA + PUSHJ P,COMCHO + .IOT ERRCH,BYTE + JUMPL BYTE,DWNIN9 ;EOF + CAIN BYTE,15 + MOVEI BYTE,215 + JRST DWNIN4 +] ;END IFN ITS + +IFN TNX,[ +LEVTAB: 0,,PRILE1 + 0,,PRILE2 + 0,,PRILE3 + +CHNTAB: 3,,INTID0 ;Interrupt IDX 0 (channel 0) + 3,,INTID1 ;Interrupt IDX 1 + 3,,INTID2 + 3,,INTID3 + 3,,INTID4 + 3,,INTID5 ;Interrupt IDX 5 (channel 6) + 0 ;Arithmetic overflow + 0 ;Floating overflow + 0 ;Reserved for D.E.C. + 1,,CTLERR ;PDL overflow + 1,,CTLERR ;EOF + 1,,CTLERR ;Data error + 1,,CTLERR ;Disk full or quota exceeded + 0 ? 0 ;Reserved + 1,,CTLERR ;Illegal instruction + 1,,CTLERR ;Illegal read + 1,,CTLERR ;Illegal write + 0 ;Reserved + 1,,CTLERR ;Inferior termination or freeze + 1,,CTLERR ;System resources exhausted + 0 ;Reserved + 0 ;Reference to non-existant page + 3,,INTID6 ;Interrupt IDX 6 (channel 23.) + 3,,INTID7 + 3,,INTID8 + 3,,INTID9 + 3,,INTIDA ;Interrupt IDX 10. (channel 27.) + 3,,INTIDB + 3,,INTIDC ;IDX 12. + 3,,INTIDD ;IDX 13. + 3,,INTIDE ;IDX 14. + 3,,INTIDF ;IDX 15. + 3,,TIMINT ;Timer interrupt + 0 ? 0 ;34. and 35. reserved by monitor if + ; the job runs at toplevel + +INDEX=0 +IRPS NAME,,[0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F] +INTID!NAME: JSR LV1SAC ;Save AC's + MOVEI IDX,INDEX + JRST CHAIN0 +INDEX=INDEX+1 +TERMIN + +CHAIN0: PUSHJ P,CHALOP +INTDEB: MOVE 0,[LV1ACS+1,,1] + BLT 0,17 + MOVE 0,LV1ACS + DEBRK + +;Here with IDX properly set up +CHALOP: MOVE 1,CHAJFN(IDX) + GDSTS ;This gets state in 2, and number of input packets in 3 + ERCAL CTLERR + MOVE T,2 + HRLZ TT,3 + MOVE 1,CHAJFN(IDX) + MOVEI 2,.MOAWS + MTOPR + ERCAL CTLERR + HRR TT,3 + JRST CHAIND(T) ;Dispatch on state + +;Timer interrupt +TIMINT: JSR LV1SAC + PUSHJ P,TIMIN1 + JRST INTDEB ;Dismiss interrupt + +;;;Here to initialize the timer +TINTVL==2*60.*1000. ;Every two minutes +TIMRKS: 30. ? 15. ? 10. ? 5. ? 1. ? -30. ;Times at which to notify + +TIMIN1: SKIPL TIMINF ;Ok for timer interrupt? + JRST [ AOS TIMINF ;No, note that one went off + JRST SETTIM] ;And skip downtime check for now + PUSHJ P,DWNCHK + JRST SETTIM + +DWNCHK: +IFN 10X,MOVE 1,[SIXBIT /SYSTAT/] +.ELSE MOVE 1,[SIXBIT /DWNTIM/] + SYSGT + HRRZ A,2 ;Table number + MOVE 1,A +IFN 10X,HRLI 1,27 + GETAB + SETZ 1, + JUMPE 1,NODWNT + MOVE C,1 + GTAD + SUB C,1 ;Get time until shutdown + TLNE C,-1 ;More than a day? + JRST NODWNT +IFN 10X,IDIVI C,60. ;Into minutes +.ELSE [ + IMULI C,24.*60. + HLRZS C +] + SETZ D, + CAMG C,TIMRKS(D) ;Find range of time + AOJA D,.-1 + JUMPE D,NODWNT ;More than maximum time + CAMN D,DWNTIM ;Same as last notification? + POPJ P, ;Yes + MOVEM D,DWNTIM +IFN 10X,SETOM DWNTIM+1 + PUSHJ P,DWNIN1 + MOVEI A,[ASCIZ /system going down in /] + PUSHJ P,COMSTO + MOVE A,C + PUSHJ P,COMDCO + MOVEI A,[ASCIZ / minute/] + PUSHJ P,COMSTO + MOVEI BYTE,"s + CAIE C,1 + PUSHJ P,COMCHO + MOVEI BYTE,". + PUSHJ P,COMCHO + JRST DWNIN2 + +NODWNT: SKIPN DWNTIM + POPJ P, +IFN 10X,[ + AOSN DWNTIM+1 ;Tenex cancels shutdown just before shutting down + POPJ P, ;So don't say it's cancelled until it's cancelled twice +];10X + SETZM DWNTIM + PUSHJ P,DWNIN1 ;Set up to return notification + MOVEI A,[ASCIZ/shutdown cancelled./] + PUSHJ P,COMSTO +DWNIN2: MOVEI T,CO%NOT + JRST COMSN1 + +DWNIN1: MOVE BP,[441000,,%CPKDT+CTLPKO] + SETZ BC, + POPJ P, + +;; Setup timer interrupt +SETTIM: +IFN 20X,[ + MOVE 1,[.FHSLF,,.TIMEL] ;Tick the timer + MOVE 2,[TINTVL] + MOVEI 3,33. ;On channel 33 + TIMER + JFCL +];IFN 20X +.ELSE [ +IFNDEF IIT,IIT=JSYS 630 + MOVEI 1,.FHSLF ;This fork + MOVEI 2,4 ;On channel 33. + MOVE 3,[TINTVL] + IIT ; Set to trigger it +];10X + POPJ P, + + +;;; Print the contents of a Chaosnet packet. A has the byte-count, +;;; and B a BP to the data area. + +IFN $$LOG,[ + +PktPrt: Move 1,TriJFN + Movei 2,^I + BOUT + Setz 3, +PP0:: Sojl A,PP1 + Ildb 2,B + Cain 2,215 + Jrst [Hrroi 2,[Asciz ""] + SOUT + Jrst PP0] + BOUT + Jrst PP0 +PP1: Hrroi 2,[Asciz " +"] ? SOUT + Popj P, + +];$$LOG +];END IFN TNX + +;;; Character translation tables + +;Byte is a pdp10 character to be sent to Lisp machine. +;This table used when not preceded by rubout escape. +;Skip once to ignore it, twice if this is rubout escape, three times for CR. +CHR2LM: REPEAT 10, JFCL ;0 through 7, leave alone + REPEAT 3, ADDI BYTE,200 ;10 through 12 turn into backspace, tab, linefeed + JFCL ;13 stays as uparrow + ADDI BYTE,200 ;14 form + JSP BYTE,[JRST 3(BYTE)] ;15 skip three times for carriage return + REPEAT 177-16, JFCL ;16-176 unchanged + JSP BYTE,[JRST 2(BYTE)] ;177 skip twice for quoting special character +IFN .-CHR2LM-200, .ERR CHR2LM table not 200 long + +;This table used when preceded by rubout escape. +CHRQLM: REPEAT 10, ADDI BYTE,200 ;0-7 => 200-207 + REPEAT 3,JFCL ;10-12 self + ADDI BYTE,200 ;13 => 213 + REPEAT 2, JFCL ;14, 15 self + REPEAT 177-16, ADDI BYTE,200 ;16-176 => 216-376 + JFCL ;177 self +IFN .-CHRQLM-200, .ERR CHRQLM table not 200 long + +;BYTE is a lisp-machine character to be put into pdp10 buffer via BP and BC +;Skip to ignore it. +CHR210: REPEAT 10, JFCL ;0 through 7, leave alone + REPEAT 3, PUSHJ P,CHRQ10 ;10, 11, 12 hidden under backspace, tab, lf + JFCL ;13 stays as uparrow + REPEAT 2, PUSHJ P,CHRQ10 ;14, 15 hidden under form, cr + REPEAT 177-16, JFCL ;No change to 16 through 176 + REPEAT 11, PUSHJ P,CHRQ10 ;177-207 quoted + REPEAT 3, SUBI BYTE,200 ;Scale down to PDP-10 equivalents for 210 - 212 + PUSHJ P,CHRQ10 ;213 quoted + SUBI BYTE,200 ;Scale down to PDP-10 equivalent for 214 + PUSHJ P,[MOVEI BYTE,15 ;Insert for newline + IDPB BYTE,BP + ADDI BC,1 + MOVEI BYTE,12 + POPJ P,] + REPEAT 377-216, PUSHJ P,CHRQ10 ;216-376 quoted + SKIPA ;377 ignored +IFN .-CHR210-400, .ERR CHR210 table not 400 long + +CHRQ10: TLNE A,ST.SUI ;Super-image mode + POPJ P, ;Just output byte with no quoting in super-image mode + HRLM BYTE,(P) ;Output this byte preceded by 177 to quote it + MOVEI BYTE,177 + IDPB BYTE,BP + ADDI BC,1 + HLRZ BYTE,(P) + POPJ P, + +;Error code table + +IFN ITS,[ +ERRTAB: %ERODV,,'ACC ;ACCESS ERROR--DEVICE WRITE-LOCKED + %ELCDV,,'ACC ;ACCESS ERROR--LOCAL DEVICE ONLY + %EMCHN,,'ACC ;ACCESS ERROR--DEVICE NOT ASSIGNABLE TO THIS PROCESSOR + %ETMDR,,'CCD ;CANNOT CREATE DIRECTORY--MFD FULL + %ETMLK,,'CIR ;CIRCULAR LINK + %ETMTR,,'CIR ;CIRCULAR "LINK"--TOO MANY TRANSLATIONS + %ENSDV,,'DEV ;DEVICE NOT FOUND + %ENSDR,,'DNF ;DIRECTORY NOT FOUND + %ENSFL,,'FNF ;FILE NOT FOUND + %ENAFL,,'LCK ;FILE LOCKED + %EBDLK,,'LNF ;LINK TO NONEXISTENT FILE + %ENRDV,,'NAV ;EXISTS BUT NOT AVAILABLE--DEVICE NOT READY + %ENAPK,,'NAV ;--PACK NOT MOUNTED + %ENADV,,'NAV ;--DEVICE NOT AVAILABLE + %ENACR,,'NER ;NOT ENOUGH RESOURCES--NO CORE AVAILABLE + %EFLDR,,'NMR ;NO MORE ROOM--DIRECTORY FULL + %EFLDV,,'NMR ;NO MORE ROOM--DEVICE FULL (SHOULD BE NER SOMETIMES!) + %EEXFL,,'REF ;RENAME TO EXISTING FILE + %ENSMD,,'WKF ;WRONG KIND OF FILE--MODE NOT AVAILABLE + %EBDDV,,'WKF ;WRONG KIND OF DEVICE + + ;IOC errors. These don't seem to have symbolic names. + 1000,,'MSC ;DEVICE HUNG OR REPORTING NON-DATA ERROR + 2000,,'FOR ;END OF FILE + 3000,,'DAT ;NON-RECOVERABLE DATA ERROR + 4000,,'DEV ;NON-EXISTENT SUB-DEVICE (?) + ;5000,,'BUG ;OVER IOPOP + ;6000,,'BUG ;OVER IOPUSH + 7000,,'WKF ;USR OP CHNL DOES NOT HAVE USR OPEN + ;10000,,'BUG ;CHNL NOT OPEN + 11000,,'NMR ;DEVICE FULL + 12000,,'WKF ;CHNL IN ILLEGAL MODE ON IOT + 13000,,'DAT ;ILLEGAL CHR AFTER CNTRL P ON TTY DISPLAY (?) + 14000,,'NMR ;DIRECTORY FULL +LERRTB==.-ERRTAB +];ITS + +IFN TNX,[ +ERRTAB: GJFX29,,'ACC ;ACCESS ERROR--DEVICE NOT AVAILABLE TO THIS JOB + ACESX7,,'ACC ;ACCESS ERROR--DIRECTORY IS FILES-ONLY + CFDBX2,,'ACC ;ACCESS ERROR--INVALID TO CHANGE SPEC'D BITS + CFDBX3,,'ACC ;ACCESS ERROR--WRITE OR OWNER ACCESS REQUIRED + CRDIX1,,'ACC ;ACCESS ERROR--WHEEL/OPERATOR REQUIRED + DELFX1,,'ACC ;ACCESS ERROR--DELETE ACCESS REQUIRED + OPNX12,,'ACC ;--LIST ACCESS REQUIRED + OPNX25,,'ACC ;--DEVICE WRITE-LOCKED + CAPX1,,'ACC ;--WHEEL/OPERATOR + CAPX2,,'ACC ;--WHEEL/OPERATOR/MAINTENANCE + DELDX1,,'ACC ;--WHEEL/OPERATOR + WHELX1,,'ACC ;--WHEEL/OPERATOR + GTDIX1,,'ACC ;--WHEEL/OPERATOR + MTOX7,,'ACC ;--WHEEL/OPERATOR + CNDIX2,,'ACC ;--WHEEL/OPERATOR +IFDEF ACJX01,[ ;MIT addition: access control job + ACJX01,,'ACC +] + GJFX35,,'ATD ;INCORRECT ACCESS TO DIRECTORY + ACESX3,,'ATD ;INCORRECT ACCESS TO DIRECTORY--PASSWORD REQUIRED + OPNX3,,'ATF ;ACCESS TO FILE--READ + OPNX4,,'ATF ;ACCESS TO FILE--WRITE + OPNX5,,'ATF ;ACCESS TO FILE--EXECUTE + OPNX6,,'ATF ;ACCESS TO FILE--APPEND + OPNX15,,'ATF ;ACCESS TO FILE--READ/WRITE + RNAMX3,,'ATF ;ACCESS TO FILE--RENAME DESTINATION + RNAMX8,,'ATF ;ACCESS TO FILE--RENAME SOURCE + CRDI10,,'CCD ;CANNOT CREATE DIR--MAX DIR NUM EXCEEDED + CRDI13,,'CCD ;--EXCEEDS WORKING QUOTA + CRDI14,,'CCD ;--EXCEEDS PERMANENT QUOTA + CRDI15,,'CCD ;--EXCEEDS SUBDIRECTORY QUOTA + CRDI16,,'CCD ;--INVALID USER GROUP + CRDI17,,'CCD ;--ILLEGAL LOGIN SUBDIR UNDER FILES-ONLY + CRDI20,,'CCD ;--CANNOT CREATE DIR WITH NOT-HELD CAPABILITY + CRDI21,,'CCD ;--WORKING SPACE TOO SMALL + CRDI22,,'CCD ;--SUBDIR QUOTA TOO SMALL + CRDI24,,'CCD ;--INVALID SUBDIR QUOTA + CRDIX4,,'CCD ;--SUPERIOR DIRECTORY FULL +IFDEF CRDX01,[ ;MIT addition: more CRDIR errors with inconsistent names + CRDX01,,'CCD ;--SUPERIOR MAY NOT HAVE LOGIN SUBDIRECTORIES + CRDX02,,'CCD ;--CREATE-LOGIN-SUBDIRECTORIES CAP REQUIRED + CRDX03,,'CCD ;--DIRECTORY MUST BE FILES-ONLY +];CRDX01 + SFUSX6,,'CSP ;CAN'T SET PROPERTY--NO SUCH USER + GJFX39,,'CIR ;CIRCULAR "LINK"--LOGICAL NAME LOOP + CRDIX2,,'DAE ;DIR ALREADY EXISTS--ILLEGAL TO CHANGE DIR NUMBER + IOX5,,'DAT ;DATA ERROR + OPNX16,,'DAT ;DATA ERROR--INDEX BLOCK BAD + GJFX16,,'DEV ;DEVICE NOT FOUND + DELX13,,'DND ;DONT-DELETE SET--PERPETUAL + GJFX17,,'DNF ;DIRECTORY NOT FOUND + CRDI23,,'DNF ;SUPERIOR DIRECTORY NOT FOUND (CRDIR) + GJFX27,,'FAE ;FILE ALREADY EXISTS + GJFX18,,'FNF ;FILE NOT FOUND--NO SUCH NAME + GJFX19,,'FNF ;FILE NOT FOUND--NO SUCH TYPE + GJFX20,,'FNF ;FILE NOT FOUND--NO SUCH VERSION + GJFX24,,'FNF ;FILE NOT FOUND + GJFX52,,'FNF ;FILE NOT FOUND--END OF TAPE REACHED WHILE SEARCHING + OPNX2,,'FNF ;FILE NOT FOUND--DOES NOT EXIST + GJFX10,,'IPS ;INVALID PATHNAME SYNTAX--NON-NUMERIC VERSION + GJFX11,,'IPS ;--MORE THAN ONE VERSION NUMBER + GJFX33,,'IPS ;--FILENAME NOT SPECIFIED + GJFX4,,'IPS ;--INVALID CHARACTER + GJFX6,,'IPS ;--DEVICE FIELD MISPLACED + GJFX7,,'IPS ;--DIRECTORY FIELD MISPLACED + GJFX8,,'IPS ;--GREATER THAN MISPLACED + GJFX9,,'IPS ;--MORE THAN ONE NAME + GJFX40,,'IPS ;--UNDEFINED ATTRIBUTE + GJFX5,,'IPS ;--FIELD LONGER THAN 39 CHARS + CFDBX4,,'IPV ;INVALID PROPERTY VALUE + LGINX4,,(SIXBIT/IP?/) ;INVALID PASSWORD + CRDIX6,,'LCK ;FILE LOCKED--DIRECTORY FILE IS MAPPED + CRDIX7,,'LCK ;--FILES OPEN IN DIR + CRDI18,,'LCK ;--LOGIN DIR + CRDI19,,'LCK ;--CONNECTED DIR + OPNX9,,'LCK ;--INVALID SIMULTANEOUS ACCESS + RNMX10,,'LCK ;FILE LOCKED--RENAME SOURCE IS OPEN + LGINX1,,'LIP ;LOGIN PROBLEM--INVALID ACCOUNT + LGINX2,,'LIP ;--FILES-ONLY + LGINX3,,'LIP ;--DIRECTORY FUKT + GJFX28,,'NAV ;NOT AVAILABLE--DEVICE NOT ONLINE + OPNX7,,'NAV ;--ASSIGNED TO OTHER JOB + OPNX8,,'NAV ;--NOT ONLINE + DELX11,,'NAV ;--CAN'T DELETE WHEN ARCHIVED + OPNX30,,'NAV ;--CAN'T OPEN WHEN ARCHIVED + OPNX31,,'NAV ;--FILE OFFLINE + CRDI12,,'NAV ;STRUCTURE IS NOT MOUNTED +IFDEF IOX35,[ ;20X Release 5 addition + IOX35,,'NAV ;Disk structure damaged--cannot allocate space +];IOX35 + LGINX6,,'NER ;NOT ENOUGH RESOURCES--NO JOB SLOTS + CRDIX3,,'NER ;NOT ENOUGH RESOURCES--JSB FULL + OPNX17,,'NER ;NOT ENOUGH RESOURCES--NO ROOM FOR LONG FILE PAGE TABLE + GJFX22,,'NER ;NOT ENOUGH RESOURCES--JSB FULL + GJFX3,,'NER ;NOT ENOUGH RESOURCES--NO JFN SLOTS + ACESX2,,'NER + IOX12,,'NER ;--SWAP SPACE FULL + MONX01,,'NER + MONX02,,'NER ;--JSB FULL + MONX04,,'NER ;--SWAP SPACE FULL + MONX05,,'NER ;--NO RESIDENT FREE SPACE + RNMX13,,'NER + GJFX23,,'NMR ;NO MORE ROOM--DIRECTORY FULL + IOX11,,'NMR ;NO MORE ROOM--QUOTA EXCEEDED OR DISK FULL + OPNX10,,'NMR ;NO MORE ROOM--STRUCTURE FULL + OPNX23,,'NMR ;NO MORE ROOM--QUOTA EXCEEDED + RNAMX4,,'NMR ;NO MORE ROOM--QUOTA EXCEEDED IN RENAME DESTINATION +IFDEF IOX34,[ ;20X Release 5 addition + IOX34,,'NMR ;Disk structure completely full +];IOX34 + RNAMX1,,'RAD ;RENAME ACROSS DIRECTORIES--ACROSS DEVICES ACTUALLY + RNMX12,,'REF ;RENAME TO EXISTING FILE--SELF + RNAMX2,,'REF ;--FILE NOT CLOSED + GJFX38,,'WKF ;WRONG KIND OF FILE--OUTPUT-ONLY DEVICE + OPNX13,,'WKF ;--"INVALID ACCESS REQUESTED" (Read of a dir gives this) + OPNX14,,'WKF ;--"INVALID MODE REQUESTED" + GJFX31,,'WNA ;WILDCARD NOT ALLOWED--INVALID WILDCARD DESIGNATOR + GJFX34,,'WNA ;--INVALID QUESTION MARK + +LERRTB==.-ERRTAB +];TNX + 0,,'BUG ;If run off end of table + +PAT: +PATCH: BLOCK 100 + +;;; Start here to install +PURIFY: SETZM DEBUG +IFN ITS,[ + MOVE T,[-,,NIMPUR] + .CALL [ SETZ ? 'CORBLK ? MOVEI %CBNDR ? MOVEI %JSELF ? T ? SETZI %JSELF ] + .LOSE %LSSYS + .VALUE [ASCIZ/:PDUMP DSK:DEVICE;CHAOS FILE/] +];END IFN ITS +IFN TNX,[ + HLRO 1,JOBSYM ;Find end of symbol table + MOVNS 1 + ADD 1,JOBSYM + HRRZS 1 + CAIG 1,PURPND*1000 + JRST PURIF1 + HRROI 1,[ASCIZ/Not enough space left for symbol table/] + PSOUT + HALTF + +PURIF1: MOVEI 1,.FHSLF + MOVE 2,[1,,FILE] + SEVEC + SETOB 2,3 + EPCAP + MOVSI 1,(GJ%SHT+GJ%FOU+GJ%NEW) +RADIX 10. +IFN 20X,HRROI 2,[CONC [ASCIZ /SYSTEM:CHAOS.FILE.],\.FVERS,/] +IFN 10X,HRROI 2,[CONC [ASCIZ /DSK:CHAOS.FILE;],\.FVERS,/] +RADIX 8 + GTJFN + HALTF + HRLI 1,.FHSLF + MOVEI 2,[ -NIMPUR,,520000 ;Low impure copy on write + -,,120000+NIMPUR ;Pure pages + 0 ] ;End + SSAVE + HRROI 1,[ASCIZ/Saved. +/] + PSOUT + HALTF +] ;END IFN TNX + + CONSTANTS + +IFN ITS,[ +MFDBUF==:.\1777+1 +PURPND==:MFDBUF/2000 +DIRBUF==:MFDBUF+2000 +BUFBAS==:/2000 +];END IFN ITS + +IFN TNX,[ +PURPND==:<<.+777>/1000>+NSYMPG +IFN $$SUBM,[ +QSRPAG==:PURPND +QSRLOC==:QSRPAG*1000 +BUFBAS==:/2000 +];$$SUBM +.ELSE BUFBAS==:/2000 +];TNX + +BUFLOC==:BUFBAS*2000 + +PURLOC==. +LOC IMPLOC + VARIABLES +IMPLOC==. +IFG .-PURBEG,[ +INFORM Impure is ,\<.-PURBEG>, words too long! +.FATAL Too much impure, increase NIMPUR +] + +IF2,[ + INFORM END OF IMPURE=,\IMPLOC + INFORM START OF PURE=,\PURBEG + INFORM END OF PURE=,\PURLOC +IFN TNX,[ +IFN $$SUBM,[ + INFORM QUASAR IPCP LOC=,\QSRLOC +];$$SUBM +];TNX + INFORM FIRST BUFFER LOC=,\BUFLOC +];IF2 + +IFN TNX, LOC PURLOC ;SEEMS TO CONTROL SYMBOL TABLE LOCATION + + END FILE