title k20srv - Kermit-20 High Level Server and Associated Local Commands ; Much of the server code was moved from k20mit to this module as part ; of Edit 194 to address the issue of a very large single source file ; that unexpectedly began generating MCRNEC errors. ; ; Another goal was to make the server code more robust, easier to ; maintain and add new features. If an efficiency gain was obvious, ; then it was taken. ; ; One example of robustness was an attempt to combine the semanic ; action routines of the LOCAL commands with those of the REMOTE ; commands. This allowed for easier debugging with the understanding ; that, if something works as a LOCAL command, some amount of ; confidence could be assumed for at least that part would work as a ; server command. ; ; Thus, the supporting code for the LOCAL and remote commands is also ; here. One example would be the file deleting and directory code. subttl Preliminaries search monsym,macsym,cmd,k20unv ;[194] cmdacs ;Clean up p1-p4 definitions sall ; Tidy listing .directive flblst ; We don't need to see all the ASCIZ bytes... remark common parsing external data extern pars1 ; Data from first parse. extern pars2 ; Data from second parse. extern pars3 ; Data from third parse. extern pars4 ; Data from fourth parse. extern pars5 ;[41] ... extern pars6 ;[218] remark ; COMND% storage from CMD extern cjfnbk ; COMND% GTJFN block (long form) extern atmbuf ; The ubiquitous atom buffer extern atmbln ; Its length remark ; Packet level storage and routines extern xflg ; Sending with X header (probably will be displayed) extern gotx ; Flag for "already got an X-packet". extern gots ; Flag for "already got an S-packet". extern sinit ; Sends an "S" or "I" (initialize parameters) extern iflg ; Sending an "I" packet extern spack ; Send a packet extern spsiz ; Maximimum size packet to send extern spar ; Get the arguments from a Send-Init packet. extern sptot ; Total of sent packets extern rpack ; Receive a packet extern rpsiz ; Maximimum size packet to receive extern $sends ; Entry point of $send for server extern rpar ; Set arguments we'd like honored extern rptot ; Total of recieved packets extern rrinit ; Set up various variables for receiving extern $recvs ; Entry point of $recv for server extern $recvb ; Alternate entry point in $recv for server extern nak ; Negative acknowledgde; bounce a packet extern nnak ; Number of NACK's sent extern pktnum ; Current packet number extern strbuf ; String buffer, used to decode data extern strptr ; Pointer into the above (also used by k20ioc) extern strbz ; Last address of combined string areas (used to zero) extern bctone ; Set if doing single character checksum extern maxdat ; Maximum length of data field extern pktacs ; Place to save RPACK/SPACK ACs. remark ; Data flow routines that feed and drain packets extern source ; Routine that GETCH calls to get data extern dest ; Routine that PUTCH calls to put data remark ch ; Current character extern next ; Next character in stream remark ; JFN related storage extern filjfn ; JFN of open file extern nxtjfn ; Next JFN in wildcarding extern ndxjfn ; Stepping JFN extern logjfn ; Log file JFN (if logging) extern netjfn ; Network or non-controlling TTY JFN extern ttyjfn ; JFN of local terminal (never the same as TTYJFN) remark ; File related routines and storage extern decodf ; Decode a file name extern typfil ; Display a file's contents on the terminal extern typnam ; Type a file's name (special casing .nulio) extern whakfp ; Whack a mapped file page from our address space extern frclos ; Force a JFN to close extern isnulj ; Is this JFN some flavor of NUL:? extern putbuf ; Put a buffer full of data from a packet in a file extern getbuf ; Get a buffer full of data from a file for a packet extern datbuf ; Data field of the packet extern subbp ; 'subtract' two byte pointers extern filbuf ; Buffer to build a file listing entry in extern filbfz ; End of buffer marker (address) extern mxascz ; Crazy long length for moving strings extern movasc ; Routine to move ASCII bytes quickly (hopefully) remark ; N.B., the next three must be in order! extern pagcnt ; .FBBYV, Number of pages in the file and byte size extern bytcnt ; .FBSIZ and byte count extern crdate ; .FBCRV and creation date (these 3 must be adjacent!) remark ; Various interrupt routines and storage extern ccon ; Enable Control-C handling extern ccoff ; Shut Control-C handling off extern caxzof ; Turn file processing interrupts off extern timeit ; Begin timing an activity extern timoff ; Shut off an asynchronous timer extern clrcno ; Clear Control-O extern czseen ; Control-Z seen remark ; Variables for local/non-local communications extern ptyflg ; Set if the 'network' is a pseudo-terminal extern ptytty ; Mapping from PTY number to TTY number extern ttynum ; Number of controlling terminal extern speed ; Speed of physical line (if we have one) extern carier ; Carrier signal if dial up, otherwise, connection status extern mdmlin ; Set if modem-controlled line (I.E., dialup) remark ; Low level communications routines and variables extern inilin ; Initialize the line extern rrslin ; Reset/Restore the communications line. extern rrsl2 ; Really reset (don't allow ^C) extern ttxon ; ^Q a line, if flow control extern statim ; Start timing (a generic command) extern delay ; Time to wait in milliseconds before first send extern odelay ; What it used to be (for saving and restoring) extern ntimou ; Number of timeouts extern stimou ; Send timeout interval extern otimou ; Its previous value, if overriden by transfer extern numtry ; Number of times we'vre tried sending this packet extern maxtry ; Maximum number of times to try extern seolch ; Remote host's End of Line character remark ; Low level Top-20 monitor buffer management extern clrbuf ; Clear all characters in Tops-20 buffers extern clread ; As clrbuf, but lets us see what was in there remark ; Low level I/O counters extern vchrcn ;[211] Virtual characters cleared extern nsici ;[211] Network SIN% count (SIN%'s issued) extern nsitc ;[211] Network SIN% total characters extern nsimx ;[211] Network SIN% maximum length remark ; Server specific routines storage extern srvflg ; If running as a server extern local ; Set if we are not remote extern srvtim ; Server command time out remark ;[189] Timing routines in K20TIM extern statim ;[189] Start timing an interval extern endtim ;[189] Stop timing an interval extern elptim ;[189] Compute elapsed HPTIM% ticks remark ; Error and string macro support extern errptr ; Pointer to error text extern %%jser ; Handler for %jsErr macro extern %%krms ; Same as above, but sends to remote Kermit, too extern %%smsg ; Used to get text from non-zero section extern %kerms ; Addition messages when in protocol extern %wtlog ; Write to transaction log extern scrlft ;[233] Set to -1 to suppress trailing crlf extern tlgjfn ;[233] Transaction log JFN extern setlog ; Open debugging log remark ; Other external variables of interest extern jobtab ;[220] Our job's GETJI% extern expung ; Set if expunging files on delete extern crlf ; Carriage Return/Line Feed extern mycaps ; Capability vector double word extern capas ; Enabled process capabilities extern f$exit ; The exit flag which tells main loop to stop extern allfld ;[252] ; Punctuated all fields for JFNS% .psect code/ronly ; Pure code, pure Heaven subttl Parse tables, used as a kind of table of contents ;N.B., When parsing for .cmtxt and .cmcfm, .cmcfm must come first!!!! remark Parse table for LOCAL commands %table(loctab,G) ;[220] Used as a kind of table of contents %keyf3 , %cwd, %keyf4 , .ycwd, $ycwd, cm%inv %key3 , .ycdup, $ycdup ;[254] %cwd: %key3 , .ycwd, $ycwd %key3 , .ydele, $ydele %key3 , .ydire, $ydire %key3 , .ypwd, $ypwd ;[188] ;[194] %key3 , .yrun, $yrun %key3 , .ydisk, $ydisk ;[194] %keyf3 , %lst, %keyf3 , %lst, %keyf3 , %lst, %keyf4 , .stat, $ysrvt, cm%inv %lst: %key3 , .stat, $ysrvt ;[189] ;[194] %key3 , .ytype, $ytype %tbend cleans(<%cwd,%lst>) remark Parse table for REMOTE commands %table(remtab,G) ;[220] Moved here as a kind of table of contents %keyf4 , .bye, $bye, cm%inv ;[186] Tom can't remember.. %key3 , .xcdup, $xcdup ;[254] %key3 , .xcwd, $xcwd ;[194] %key3 , .rmfil, $xdele ;[194] %key3 , .rmfil, $xdire ;[194] %keyf4 , .xerr, $xerr, cm%inv ;[194] %keyf4 , .finis, $finis, cm%inv ;[186] Tom can't remember.. %key3 , .xhelp, $xhelp ;[120] ;[194] %key3 , .xhost, $xhost ;[105] %key3 , .xpwd, $xpwd ;[188] ;[194] ;;;* %key3 , .???, $??? %key3 , .xdisk, $xdisk ;[194] %keyf3 , %rst, %keyf3 , %rst, %keyf3 , %rst, %keyf4 , .xstat, $xstat, cm%inv %rst: %key3 , .xstat, $xstat ;[189] ;[194] %key3 , .rmfil, $xtype %tbend cleans(<%rst>) subttl BYE command remark Parse the BYE command. .bye: entry .bye ; Can be invoked as top-level by k20par guide (to remote server) ; Parse rest of BYE command. confrm ret remark Execute the BYE command. ; N.B., Uses clread to drain the terminal buffer. However, we are ; SOUT%'ing raw eight bit data, no parity. Maybe this should be ; fixed? However, the previous code didn't do parity, either ; Maybe controlify? $bye: entry $bye ; Can be invoked as top-level by k20par saveac ;[211] Needs some additional storage call statim ;[189] Start timing so k20pdc doesn't choke dmove t1, [ ;[220] point 7, [asciz/L/] ; An "L" for the data field. "G" ] ; Packet type is G. call srvcmd ;[121] Send the command. jrst $byez ; Some error, don't exit. ;[16] From here to end is part of edit 16. movei q1, ^d5 ;[211] ; Waiting a total of 1.25 seconds movei t1, ^d1000 ;[211] ; Wait a second right now DISMS% do. ;[211] Enter loop context call clread ;[211] Get and clear data exit. ;[211] Unless there was an error ifg. t1 ;[211] Any goodies? aos nsici ;[211] Network SIN%'s Issued movn t3, t1 ;[211] Set up for counted SOUT% addm t3, vchrcn ;[211] Subtract from cleared addm t1, nsitc ;[211] And give them to Network SIN% camle t1, nsimx ;[211] Smaller than largest? movem t1, nsimx ;[211] Nope, have a new largest! movei t1, .priou ;[211] This terminal remark t2, ;[211] Raw 8 bit pointer! SOUT% ;[211] Type it %jserr (,) ;[211] ?? endif. ;[211] End case got some data sojle q1, endlp. ;[211] Stop looking if done waiting movei t1, ^d250 ; Sleep a little bit DISMS% loop. ;[211] Try again enddo. ;[211] Exit loop lexical context txmsg < ...> ; Maybe there's more, but... call clrbuf ;[194] can't wait forever for it, nop ;[186] ; throw the rest away. setom f$exit ;[38] Set exit flag. call endtim ;[189] Stop timing call elptim ;[189] Compute elapsed time ; Error exit $byez: setzm f$exit ;[70] Don't exit. ret ;[70] subttl CWD command remark [137] LOCAL CWD command parsing. ; Changed to only parse for a password if it is determined that we ; can't connect without one. Trying the ACESS% more than once can get ; the ACJ or monitor delay code involved. ; ; N.B., The following COMND% oddity. If you are parsing for .cmdir ; and .cmdev (as is done below) and if you are connected to one ; structure and you type only the device name of another structure ; with the same named directory, then COMND% will actually parse a ; .cmdir of that directory on the other structure! define token (c) < ;;[255] Define token ;;[255] All these literals, yuck... >;;token ;;[255] chgsec(code,const) ;;Chained FDB's are not in code, they're in const ycwfdb: flddb. .cmdir,,,,,ycwfd1 ycwfd1: flddb. .cmdev,,,,,ycwfd2 ycwfd2: flddb. .cmtok,,token(<..>),,,ycwfd3 ycwfd3: flddb. .cmcfm,,,,, ;[220] ypwfdb: flddb. .cmcfm,,,,,ypwfd1 ypwfd1: flddb. .cmqst,,,,,ypwfd2 ypwfd2: flddb. .cmtxt,,,,, ;[220] retsec ;;Get back to wherever we came from cleans() .ycwd: entry .ycwd ; Invoked from k20par saveac ; Save some accumulators for interim parse results guide ; Issue guide words. movei t1, ycwfdb ;[220] call rfield ; Parse a directory specification. ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. dmove q2, t2 ;[220] Save these for downstream parsing caie q3, .cmcfm ; Confirmation? ifskp. ; Yes, then use our own logged-in directory move t2, .jilno+jobtab ; number, which always works without a password movei t3, .cmdir ;[220] Lie and say we parsed a directory dmovem t2, pars3 ;[220] Pass to semantic action setzm pars5 ;[220] No password string being passed ret ; We're done endif. caie q3, .cmtok ;[255] Hokey CDUP talisman? ifskp. ;[255] Yes, transmogrify into a cdup movei t3, cdhack ;[255] Used to tweak different parse stream move t2, pars1 ;[255] Load first level parse block address move t1, (t2) ;[255] Load the syntax and semantic hrri t1, $ycdup ;[255] Override semantic action movem t1, (t3) ;[255] Store as a seperate parse block movem t3, pars1 ;[255] Override original parse block jrst .ycdp1 ;[255] And switch parsing over to cdup endif. ;[255] End case ".." hack caie q3, .cmdev ;[220] Parsed a device?? ifskp. ;[193] Yes (can't connect to DECtape) move t1, q2 ;[220] Let's check it call isnulj ;[193] Is it NUL:? anskp. ;[193] It isn't, must be some other odd thing move q2, t1 ;[220] It is, so remember that confrm ;[220] Confirm the line, do not allow .cmqst dmovem q2, pars3 ;[220] Pass both to semantic action setzm pars5 ;[220] No password string being passed ret ;[220] Done, skipping the .cmqst else. ;[220] Here if some other device caie q3, .cmdev ;[220] Are we here because of phonkey .cmdev? anskp. ;[220] No, it's a .cmdir, so that's fine move t1, q2 ;[220] Let's see if it can do files call isdird ;[220] See if this is a directory device ifskp. ;[220] It is, see what kind ldb t3,[pointr(t2,dv%typ)] ;[220] Load type caie t3, .dvdsk ;[220] Structure? anskp. ;[220] Can't connect to DECtape... else. ;[220] Not a disk based directory structure sxtext(t1,) ;[220] Initial part of error message ESOUT% ;[220] Begin whining setzb t3, t4 ;[220] Clear up some storage hrroi t1, t3 ;[220] Writing device name into registers move t2, q2 ;[220] Load device DEVST% ;[220] Write it ifje. r ;[220] Failed?? We just parsed it! dmove t3, [asciz /(error)/] ;[220] Stomp in something else. ;[220] Otherwise, worked movei t2, ":" ;[220] Load terminating device punctuation idpb t2, t1 ;[220] Take on the end, rest of word is .chnul's endif. ;[220] End case DEVST% handling hrroi t1, t3 ;[220] Point to t3 again PSOUT% ;[220] Blat that out, too callret cmder1 ;[220] Allow a reparse, however endif. ;[220] End case acceptable directory analysis call defdir ;[220] Try to default the directory on the structure callret cmder1 ;[220] Couldn't... Allow reparse movei q3, .cmdir ;[220] Pretend they typed the directory endif. ;[193] End case parsed a device remark .cmdir ;[220] At this point, we know the directory exists move t1, q2 ;[220] Load the directory in question call pwconp ;[220] Do we need a password to get to this? ifskp. ;[220] No, so do not parse for a quoted string confrm ;[220] Just confirm the command dmovem q2, pars3 ;[220] Pass directory and parse type to semantic action setzm pars5 ;[220] No password string being passed ret ;[220] And we're done endif. ;[220] remark ;[220] May need a password, so allow a parse for that movei t1, ypwfdb ;[220] Allow a password on the same line call rfield ;[220] See if they want the password right now ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. caie t3, .cmcfm ;[220] Didn't specify anything? ifskp. ;[220] Nope, so we're done with the parse dmovem q2, pars3 ;[220] Pass directory and parse type to semantic action setzm pars5 ;[220] No password string being passed ret ;[220] And get out of here endif. ;[220] End case no string parsed confrm ; Get confirmation. dmovem q2, pars3 ;[220] Pass directory and parse type to semantic action movei t1, atmbuf ;[220] Load address of the atom buffer hrli t1, () ;[220] Turn into a local pointer movem t1, pars5 ;[220] Flag that we are passing in a password ret subttl Vestigial Echoing code comment " ;[220] Removed because it got too hairy on a reparse ifmn. takdep ;[220] Are we in a take file? setz q5, ;[220] We are, flag that else. ;[220] Aren't; so monkey with terminal mode seto q5, ;[220] Let's assume not in a take file remark cm%wkf ;[220] Maybe tweak this? endif. remark ... ifn. q5 ;[220] Not in a take file? skipg t1, ttyjfn ;[220] This terminal anskp. ;[220] We don't have one, don't do this RFMOD% ;[220] Pull its mode word annje. ;[220] Punt the rest if this fails txz t2, tt%osp ;[220] Clear control-O so prompt comes out move q5, t2 ;[220] And save it txz t2, tt%eco ;[220] Turn off echoing. SFMOD% ;[220] Try doing it ... annje. ;[220] Punt the rest if this fails remark ;[220] At this point, echo is off else. ;[220] Otherwise, q5 is zero or should be setz q5, ;[220] If here because of error, disallow endif. ;[220] remark ... ifn. q5 ;[220] Hacking terminal modes? push p, t1 ;[220] Save temporaries around SFMOD% push p, t2 ;[220] it wants t1 and t2 move t1, ttyjfn ;[220] Load terminal JFN move t2, q5 ;[220] and whatever we saved SFMOD% ;[220] Restore TTY to normal echoing. %jserr (,) ;[220] Carry on pop p, t2 ;[220] Restore temporaries SFMOD% used pop p, t1 ;[220] it wanted t1 and t2 endif. ;[220] End case mode detweak ";;comment subttl Default a directory on a structure ;[220] Begin code insertion ; Largely unnecessary, as Tops-20 will do this for domestic structures. defdir: saveac ; Needs two index registers anstkv (q3,dirmxw) ; Place to build the default directory anstkv (q4,dirmxw) ; Place to put currently connected directory movx t1, ; Length of area in words move t2, q3 ; First address in area movei t3, 1(t2) ; Doing a cascade xblt setzm (t2) ; Zero first word xblt. t1 ; Clear the rest of the area hrro t1, q3 ; Build Tops-20 pointer to area move t2, q2 ; Load device DEVST% ; Construct first part of defaulted directory %jserr (,r) move q5, t1 ; Save the final pointer for appending movx t1, ; Length of area in words move t2, q4 ; First address in area movei t3, 1(t2) ; Doing a cascade xblt setzm (t2) ; Zero first word xblt. t1 ; Clear the rest of the area hrro t1, q4 ; Build Tops-20 pointer to area move t2, .jidno+jobtab ; Load currently connected directory DIRST% ; Render as a string %jserr (,r) move t2, q4 ; Load address of connected directory string hrli t2, () ; Turn into a local pointer do. ; Enter loop context to find end of device ildb t3, t2 ; Pick up a byte cain t3, ":" ; Hit the colon? exit. ; We did, break out of the loop ife. t3 ; Sanity check ermsg% (,r) endif. ; End check loop. ; Try next character enddo. ; End loop lexical context move t1, q5 ; Load end of device do. ; Enter loop context to copy over the directory idpb t3, t1 ; Deposit into new device string cain t3, .chrpt ; Hit the right pointy bracket? exit. ; We did, so we're done ildb t3, t2 ; Pick next byte of source connected directory loop. ; Deposit it and get next byte enddo. ; End loop lexical context setz t3, ; Cons up a .chnul idpb t3, t1 ; Tie off the proposed default directory ; Now see if it exists.. movx t1, rc%emo ; Therefore, exact-match, only hrro t2, q3 ; Build Tops-20 pointer to candidate setz t3, ; Not doing any stepping, but... RCDIR% ; See if it exists %jserr (,r) ifxn. t1, rc%nom ; Doesn't exist? We surely can't connect... hrro t1, q3 ; Load pointer to our created directory ESOUT% ; Begin complaining txmsg (< does not exist, so can't be used as a default>) ret ; Return +1 endif. move q2, t3 ; Pretend they asked for this retskp ; Have a default ;[220] End code insertion subttl Update GETJI% information from GJINV% ;[220] Begin code insertion udjinf: entry udjinf ; Also used by k20mit saveac ; Only side-effect storage, not accumulators GJINF% ; Faster than GETJI% and always works remark t1,.jiuno+jobtab ; User number will NEVER change; no SETUID. movem t2, .jidno+jobtab ; Connected directory, which CWD changes remark t3,.jijno+jobtab ; Job number will NEVER change during execution movem t4, .jitno+jobtab ; Update current controlling terminal ret ; Always works, so return +1, always ;[220] End code insertion subttl GETPAS -- Get a password from the terminal or file ; Call: ; ; t1/ Length of password buffer (in characters) ; t2/ Pointer to password buffer ; ; Return: ; ; +1, Some kind of failure ; +2, Got some text: ; ; t1/ Password length (in characters) ; t2/ Updated to end of password ; ; Other accumulators are unmodified ; ; Performs the following: ; ; If invoked from a TAKE file, reads the password from the file, ; using end of line as the ending delimiter. ; ; Otherwise: ; ; 1) Prompts for password, ; 2) Turns off echoing during typein, ; 3) Restores echoing ; 4) Returns with result in buffer ; ; smashes t1-t4, others preserved ; ; Partially rewritten as part of [194] for better security ; In TEXT, not ETEXT because brain damaged RDTTY% can not handle the ; OWGP that PSOUT% has just typed. The RDCBP routine in COMND% only ; allows OWGP's from a non-zero section. Bogus... chgsec(code,text) ;[220] Section zero text, sigh... pwdprm: asciz / Password: / ;[220] Prompt for when requesting passwords retsec ;[220] Back into mainline code getpas: extern takdep, takjfn ;[194] and of our necessaries ifle. t1 ;[194] You're kidding, right? ermsg% (,r) ;[194] endif. ;[194] Useless to go further ;[194] Otherwise, got a positive length saveac ;[194] caile t1, mxpwlc ;[194] Maximum than Tops-20 will do? movx t1, mxpwlc ;[194] Yes, clip it down dmove q1, t1 ;[194] Save the calling parameters idivi t1, ^d5 ;[194] Convert from characters to words ifn. t2 ;[194] Any remainder? addi t1, ^d1 ;[194] Yes, round up a word endif. ;[194] move q3, t1 ;[194] Store final length hrrz t2, q2 ;[194] Load word address of password buffer call scrubp ;[194] Clobber it, first ifmn. takdep ;[194] ;[178] Do specially for TAKE files move t1, takjfn ; Read line from the TAKE file dmove t2, q2 ;[194] Into buffer, clipping maximum movei t4, .CHLFD ; terminate on linefeed. SIN %jserr (,r) ;[194] seto t1, ;[194] Let's investigate the read adjbp t1, t2 ;[194] Decrement the returned byte pointer. ldb t4, t1 ;[194] Load the previous character caie t4, .chcrt ;[194] Better have been a carriage return ret ;[194] It wasn't, so fail the call setz t4, ; Write a zero over the terminating CR. dpb t4, t1 idpb t4, t1 ; And linefeed. move t1, q1 ;[194] Load original length addi t3, ^d2 ;[194] Account for .chcrt and .chlfd we pitched sub t1, t3 ;[194] Subtract what we didn't read, yielding length move t2, q2 ;[194] ; Return pointer to password. retskp ;[194] ;[178] Won!! endif. ;[194] remark ;[194] Otherwise, user has to type something movei t1, .priin ; Get TTY mode word RFMOD %jserr (,r) ;[194] txz t2, tt%osp ;[194] Clear control-O so prompt comes out movem t2, q4 ;[194] And save it txz t2, tt%eco ; Turn off echoing. SFMOD %jserr (,r) ;[194] hrroi t1, pwdprm ;[194] Issue first prompt. PSOUT move t1, q2 ;[194] Load pointer to password buffer hrrz t2, q1 ;[194] Load length of buffer txo t2, rd%bel!rd%crf!rd%sui ;[194] Break on .chcrt or .chlfd, suppress .chcrt hrroi t3, pwdprm ;[194] Prompt if ^R typed RDTTY ifje. r ;[194] Failed?? move t4, t1 ;[194] Save the error move t1, q3 ;[220] Load word length of buffer hrrz t2, q2 ;[220] Load word address of password buffer call scrubp ;[220] Ditch anything that we might have gotten %ermsg (,) ;[194] Begin complaining movei t1, .priin ;[194] Diddle primary input move t2, q4 ;[194] Load original mode word SFMOD% ;[194] Restore terminal to original mode %jserr (,) ;[194] ret ;[220] Fail the call endif. ;[194] block. ;[194] Get a stack frame saveac ;[194] Preserve these over SFMOD% movei t1, .priin ;[194] Diddle primary input move t2, q4 ;[194] Load original mode word SFMOD ; Restore TTY to normal echoing. %jserr (,r) ;[194] retskp ;[194] Otherwise, worked endbk. ;[194] End of block context nop ;[220] Ignore error and carry on setz t3, ;[194] Cons up a .chnul dpb t3, t1 ;[194] ; Write a zero over the terminating linefeed. hrrz t4, t2 ;[194] Pick up the remaining length addi t4, ^d1 ;[194] Account for linefeed we'll toss sub q1, t4 ;[194] Calculate length of password move q2, t1 ;[194] Save updated pointer hllz t4, t2 ;[169] Remember flag bits that were returned. hrroi t1, crlf ;[194] Point to carriage return line feed PSOUT% ;[194] ; Echo the crlf that wasn't echoed. ifxe. t4, rd%btm ;[194] Too long? ermsg% (,) ;[194] Complain move t1, q3 ;[220] Load word length of buffer hrrz t2, q2 ;[220] Load word address of password buffer call scrubp ;[220] Ditch anything that we might have gotten ret ;[220] Fail the call endif. ;[194] dmove t1, q1 ;[194] Load updated results retskp ;[194] And return them subttl Scrub the password buffer ;[194] Begin code insertion ; Call: ; ; t1/ Length of password buffer (in WORDS) ; t2/ Pointer to password buffer ; ; Returns: ; ; +1, always ; Stomps the buffer to all zeros, all AC's preserved scrubp: jumple t1, r ; You're kidding, right? saveac ; Don't touch anything move t4, (t2) ; First of all, does the memory even exist? erjmpr r ; Nope, so nothing to scrub caie t1, ^d1 ; Is the password really short? ifskp. ; Not a great idea, but easy enough to do setzm (t2) ; Scrub the buffer ret ; And we're done endif. remark ; Otherwise, doing two or more words setzb t3, t4 ; Cons up 10 .chnul's dmovem t3, (t2) ; Stomp at least that much caig t1, ^d2 ; Wanted to clear more than two words? ret ; No, then we're done subi t1, ^d2 ; Account for two words cleared xmovei t3, 2(t2) ; Skip already cleared words xblt. t1 ; Clear the rest of the block ret ; Return all nice and tidy ;[194] End code insertion subttl Execute the LOCAL CWD command. ;[171] Rewritten to only prompt for the password when necessary, as ; the Exec CONNECT command does, and to print the name of the ; directory connected to. ; ; First try to connect with no password. This returns immediately on ; error. ; ; [194] The previous sentence is no longer true; a connection attempt ; that fails will put the process to sleep so that it can not stay in ; a loop, trying passwords. Eventually, alerts will come out on the ; CTY. ; ; Thus, we try to guess whether we'll need a password with CHKAC% acabl==<.acjob+1> ; ACCES% argument block length $ycwd: entry $ycwd ;Invoked from k20par saveac ;[194] Used for anonymous stkvars anstkv (q1, ) ;[194] Argument block and password xmovei q2, (q1) ;[194] Base of password buffer skipn t1, pars3 ;[194] Load the directory (if there is one) ermsg% (,r) ;[194] caie t1, .nulio ;[193] Connecting to NUL:? ifskp. ;]193] We are, so do nothing setom .acdir(q1) ;[194] And impossible connected directory jrst $ycwdz ;[193] Continue as if we did something... endif. ;[193] End NUL: special case move t2, pars4 ;[193] Load the parse type cain t2, .cmdev ;[193] Not a device, was it?? jrst cwdeve ;[193] Go handle a bogus connect device setz t2, ;[220] assume no password dmovem t1, .acdir(q1) ;[194] Store in block setom .acjob(q1) ;[194] Do the connect for this job ifmn. pars5 ;[220] Did they already give us a password movx t1, mxpwlw ;[220] Load length of password buffer hrrz t2, pars5 ;[220] Load section local address of where it was parsed move t3, q2 ;[220] and the address of the password buffer xblt. t1 ;[220] Transfer it remark ;[220] This is wrong if the password isn't in atmbuf dmove t1, [ atmbln ;[220] Load length of atom buffer again atmbuf ] ;[220] and the address of atom buffer call scrubp ;[220] Scrub any password text out of it hrrz t2, q2 ;[220] Load address of password buffer hrli t2,() ;[220] Turn into a local pointer movem t2, .acpsw(q1) ;[220] Store in access argument block jrst $ycwdy ;[220] Skip access check and first attempt endif. ;[220] End case password already specified call pwconp ;[194] Can we connect without a password? jrst $ycwdx ;[194] No, go get one movx t1, ac%con!acabl ;[194] Ask for connect function,,arg block length move t2, q1 ;[194] Load address of argument block ACCES ; Try to connect. erjmpr $ycwdx ; If error, go prompt for password. jrst $ycwdz ; Connected OK, exit. ; Handle error by prompting for password and then trying to connect again. $ycwdx: dmove t1, [ exp mxpwlc,] ;[194] Load length and byte size hrr t2, q2 ;[194] Now have an ASCII pointer to password buffer movem t2, .acpsw(q1) ;[194] Store in access argument block call getpas ; Ask for password. ret ;[194] Return failure $ycwdy: movx t1, ac%con!acabl ;[194] Ask for connect function,,arg block length move t2, q1 ;[194] Load address of argument block ACCES ;[194] Failure here will trigger a wait %jserr (,) ;[194] On failure, whine and continue ; At this point, done either way, whether succeeded or not $ycwdz: movx t1, mxpwlw ;[194] Load maximum password length, words move t2, q2 ;[194] Load address of password buffer call scrubp ;[194] Scrub any password text out of it movei t1, "[" ;[194] Begin message PBOUT ;[194] GJINF% ;[194] Get job information movem t2, jobtab+.jidno ;[194] Remember for future reference. came t2, .acdir(q1) ;[194] Did we go where we wanted? ifskp. ;[194] Yes, advise of such txmsg ;[194] Print what we're connected to. else. ;[194] Otherwise, say nothing happened txmsg ;[194] endif. ;[194] movei t1, .priou DIRST erjmpr .+1 ;[194] movei t1, "]" PBOUT hrroi t1, crlf ;[194] Tie off the line PSOUT% ;[194] ret subttl Here to handle some bogus connect device ; t1/ device designator ; t2/ parsed function code cwdeve: move t2, t1 ;[193] Save device designator setzb t3, t4 ;[193] Cons up ten nulls dmovem t3, (q2) ;[193] Scrub the buffer hrroi t1, (q2) ;[193] Point to buffer DEVST% ;[193] Convert devie to a string erjmps .+1 ;[193] Catch and suppress error hrroi t1, (q2) ;[193] Point to buffer ESOUT% ;[194] Begin blatting at user erjmpr .+1 ;[194] Catch and ignore error txmsg <: is not a file structure, so can't connect to it. > ;[193] Rest of the blat dmovem t3,(q2) ;[193] Scrub again ret ;[193] Return from failure subttl Can we do a passwordless connect to a directory? ;[194] Begin code insertion ; ; Call: ; ; t1/ Directory (number) to connect to ; ; Return: ; ; +1, t1/ Has a zero if can't connect ; t2/ Zero if CHKAC% succeed or last error ; t1/ Has last error code if we failed the CHKAC% ; ; +2, t1/ Negative one ; t2/ Zero ; ; Smashes t1-t4 pwconp: anstkv(t4,<.ckapr+1>) ; Allocate an argument block seto t2, ; Request complete file access (everything) dmovem t1, .ckaud(t4) ; Store with directory number in argument block move t1, jobtab+.jidno ; Load currently connected directory move t2, mycaps+1 ; Load my enabled capabilities dmovem t1, .ckacd(t4) ; Store in argument block movx t1, .ckacn ; Checking for connect access move t2, jobtab+.jiuno ; Load my login user number dmovem t1, .ckaac(t4) ; Store in argument block movx t1, <.ckapr+1> ; Load length of block move t2, t4 ; Load address of block CHKAC% ; See if we can do anything ifje. r ; Failed?? move t2, t1 ; Return the error setz t1, ; Say we can't access it else. ; Otherwise, JSYS worked setz t2, ; In which case there is no error code endif. jumpe t1, r ; If zero, then return +1 retskp ; Otherwise, won!! ;[194] End code insertion subttl REMOTE CWD Parsing ;[106] Parsing and execution all for Edit 106 ;N.B., all the extra scrubbing being done here is to try to enhance ; security by getting rid of any password remnants. chgsec(code,const) ;;Chained FDB's are not in code, they're in const xcwfdb: flddb. .cmcfm,,,,,xcwfd1 xcwfd1: flddb. .cmqst,,,,,xcwfd2 xcwfd2: flddb. .cmtxt,,,,, xpwfdb: flddb. .cmcfm,,,,,xpwfd1 xpwfd1: flddb. .cmqst,,,,,xpwfd2 xpwfd2: flddb. .cmtxt,,,,, retsec ;;Get back to wherever we came from cleans() .xcwd: saveac ;[220] Necessary for intermediate parse results remark ;[220] Note, these lengths are for foreign directories dmove t1, [exp fdrmxw,dirbuf] call scrubp ;[194] Scrub the directory buffer dmove t1, [exp fpwmxw,pasbuf] call scrubp ;[194] Scrub the password buffer remark ;[220] First get directory, if specified guide ; Issue guide words. movei t1, xcwfdb ;[220] Allow a quote of the remote directory call rfield ;[220] Parse something dmove q1, t1 ;[220] Store parse results ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[220] Get function code caie q3, .cmcfm ;[241] Was it a bare confirm? ifskp. ;[241] Yes, let's not return gubbish dmove t1, [exp atmbln,atmbuf] call scrubp ;[241] Don't send anything to remote system!! ret ;[241] Return, taking default (with no password) endif. ;[241] End case bare confirm remark ;[220] BUT!! Did they actually type anything?? move t2, [point 7, atmbuf] ;[220] Let's see what they did ildb t1, t2 ;[220] Pick up the first byte cain t1, .chcrt ;[241] Bare carriage return? setz t1, ;[241] Turn into .CHNUL cain t1, .chlfd ;[241] Bare linefeed? setz t1, ;[241] Turn into .CHNUL ife. t1 ;[220] They didn't, so still using default area confrm ;[220] Line needs to be confirmed, however dmove t1, [exp atmbln,atmbuf] call scrubp ;[241] Don't send anything to remote system!! ret ;[220] We're done; not sending a directory endif. ;[220] or its related password movx t1, fdrmxw ;[220] Load maximum length of foreign directory dmove t2, [ atmbuf ;[220] Source is atom buffer dirbuf ] ;[220] Destination is foreign xblt. t1 ;[220] Store for semantic action movei t1, dirbuf ;[220] Load address of foreign directory hrli t1,() ;[220] Turn into a local pointer movem t1, pars3 ;[220] Store for semantic action remark ;[220] Second, get password, one way or another ;;;; remark shut off echoing here like exec? movei t1, xpwfdb ;[220] Allow a quote of the remote directory call rfield ;[220] Parse something dmove q1, t1 ;[220] Store parse results ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[220] Get function code ;;;; remark turn back on, but only if not in take file cain q3, .cmcfm ;[220] Was it a confirm? jrst .xcwd1 ;[220] It was, so specifying password on next line remark ;[220] BUT!! Did they type anything?? move t2, [point 7, atmbuf] ;[220] Let's see what they did ildb t1, t2 ;[220] Pick up the first byte cain t1, .chcrt ;[241] Bare carriage return? setz t1, ;[241] Turn into .CHNUL cain t1, .chlfd ;[241] Bare linefeed? setz t1, ;[241] Turn into .CHNUL ife. t1 ;[220] Did they do a "" for no password? confrm ;[220] They did; still needs to be confirmed dmove t1, [exp atmbln,atmbuf] call scrubp ;[241] Don't send anything to remote system!! ret ;[220] Leave, explicitly not sending a password endif. remark ;[220] Otherwise, nearly done confrm ;[220] Confirm before copying sensitive data movx t1, fpwmxw ;[220] Load maximum length of foreign password dmove t2, [ atmbuf ;[220] Source is atom buffer pasbuf ] ;[220] Destination is foreign password xblt. t1 ;[220] Store for semantic action movei t1, pasbuf ;[220] Load address of foreign password hrli t1,() ;[220] Turn into a local pointer movem t1, pars4 ;[220] Store for semantic action ret ;[220] Successfully completed parse .xcwd1: dmove t1, [ ;[220] No, they did not mxpwlc ;[220] Maximum password length in characters point 7,pasbuf ] ;[220] Point to password buffer call getpas ;[220] Ask for a password. jrst cmder1 ;[220] Handle like a parse error, do not do semantics move t1,[point 7,pasbuf];[241] Point to password buffer ildb t1, t2 ;[241] Pick up the first byte cain t1, .chcrt ;[241] Bare carriage return? setz t1, ;[241] Turn into .CHNUL cain t1, .chlfd ;[241] Bare linefeed? setz t1, ;[241] Turn into .CHNUL ife. t1 ;[241] They didn't, so chuck remnants dmove t1, [exp fpwmxw,pasbuf] call scrubp ;[241] Chuck any gubbish in password buffer dmove t1, [exp atmbln,atmbuf] call scrubp ;[241] Sanitize the atom buffer, also ret ;[241] We're done; sending a directory endif. ;[220] but not its related password move t1,[point 7,pasbuf];[220] Point to password buffer movem t1, pars4 ;[220] Save pointer to it. ret ;[220] Done subttl REMOTE CWD Execution $xcwd: extern strbuf, strptr ; Defined in k20mit call statim ;[189] Start timing so k20pdc doesn't choke setzb t1, t2 ;[220] Cons up some .chnul's dmovem t1, strbuf ;[220] Zero out old stuff dmovem t1, strbuf+2 ;[220] and a bit more of it move t2, [ point 7, strbuf ] ;[220] Point to string buffer movem t2, strptr ;[220] Save current location movei t4, "C" ; CWD generic command letter idpb t4, t2 ;[220] First character of data ibp t2 ; Leave room for length. skipe t1, pars3 ;[220] But!! Did they specify a directory? ifskp. ;[220] They did not, we're done dmove t3, [ ;[220] Force zero length data area .chspc ;[220] Space is ASCII for zero length point 7,strbuf,13 ] ;[220] Point to second character in packet dpb t3, t4 ;[220] Deposit count at head of field. move t1, strptr ;[220] Point to beginning of packet (before "C") movei t2, "G" ;[220] Packet type is generic callret dosrv ;[220] Go send it, handle the reply and return else. ;[220] Otherwise, have a directory to copy setz t3, ;[220] Initialize counter endif. ;[220] End case default area do. ; Enter loop context to copy directory ildb t4, t1 ; Pick up a byte of the directory jumpe t4, endlp. ; Stop at the end of the string idpb t4, t2 ; Deposit it in string buffer aoja t3, top. ; Get some more bytes, weee!! enddo. ; End of loop context ; Note that lengths here apply to UNPREFIXED values. If a length ; turns out to be the same as a prefix character, it will be quoted ; itself. move t4, [point 7, strbuf, 13] ; Deposit count at head of field. addi t3, 40 ; Make it printable. dpb t3, t4 ifmn. pars4 ; Got a password too? movem t2, strptr ; Yes. Save current pointer. ibp t2 ; Save a place for length of this field. setz t3, ; Reset counter for new field. move t1, pars4 ; Load pointer to password do. ; Enter loop context to copy that over ildb t4, t1 ; Get a character from the password jumpe t4, endlp. ; If zero, done. idpb t4, t2 ; Append it aoja t3, top. ; Count it & loop. enddo. ; End loop context idpb t4, t2 ; Make it asciz. addi t3, 40 ; Make count printable. idpb t3, strptr ; Deposit it at head of field. endif. ; End case password supplied ; Point to completed buffer dmove t1, [ point 7, strbuf "G" ] ; Packet type is H. jrst dosrv ; Go send it and handle the reply. subttl LOCAL CDUP Parsing ;[254] Begin code insertion for Parsing and execution for CDUP chgsec(code,const) ;;Chained FDB's are not in code, they're in const ycufdb: flddb. .cmcfm,,,,, retsec ;;Get back to wherever we came from .ycdup: entry .ycdup ; Invoked by k20par saveac ; Necessary for intermediate parse results .ycdp1: guide ;[255] parse linkage from CWD movei t1, ycufdb ; Parsing isn't going to be particularly complex .. call rfield ; Go parse the confirm dmove q1, t1 ; Store the parse results ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code cain q3, .cmcfm ; Was it NOT a bare confirm? ifskp. ; It wasn't! How did we get that?? hrroi t1, atmbuf ; Point to the atom buffer ESOUT% ; Start complaining erjmpr cmder1 ; Catch a bogon and allow reparse txmsg < is not a valid CDUP parameter > ; Finish up the blat callret cmder1 ; Allow a reparse, however endif. ; End case highly bogus non-confirm remark ; Side-effect internal storage in case ^C call udjinf ; Get currently connected directory move t2, .jidno+jobtab ; Load from side-effected main storage movem t2, pars3 ; Pass in to semantic action ret ; Otherwise, done subttl LOCAL CDUP Execution $ycdup: entry $ycdup ; Invoked by k20par saveac ; Need some local fast scratch setzb t1, t2 ; Cons up ten NUL's dmovem t1, dirbuf ; Give the directory buffer a tiny scrub a dub hrroi t1, dirbuf ; Load Tops-20 pointer to directory buffer move t2,pars3 ; Load the currently connected directory DIRST% ; Translate into a string, checking for oddness %jserr (,r) move q2, [point 7,dirbuf] ;Hardware pointer to directory buffer move t1, q2 ; Copy for local usage setz t3, ; Last dot we saw do. ; Enter loop context ildb t2, t1 ; Pick up a byte jumpe t2, endlp. ; Stop if off the end of the string (wierd...) cain t2, .chrpt ; At end of directory specification? exit. ; Yes, so done with the loop cain t2, "." ; Hit a dot?? move t3, t1 ; Yes, remember pointer to the last one seen loop. ; Grovel to the end of the string enddo. ; Exit loop context ife. t3 ; If never saw a dot, at top-level txmsg <[Remaining connected to top-level directory > move t1, q2 ; Load pointer to string PSOUT% ; Type it txmsg <] > ; Tie off the line ret ; Done doing plenty of nothing much... endif. ; End case at top-level ; Otherwise, change directory specification dmove t1, [exp .chrpt,0] ;Load closing punctuation dpb t1, t3 ; Stomp the dot with closing punctuation idpb t2, t3 ; Close off the string ; Convert our masterpiece to internal format movx t1, rc%emo ; Must match this and only this directory move t2, q2 ; Load pointer to munged directory setz t3, ; Not doing any stepping RCDIR% ; See if we can recognize it ifxn. t1, rc%nom!rc%amb!rc%nmd move t1, q2 ; Load pointer to constructed directory ESOUT% ; Start whining erjmpr r ; Ignore error and return txmsg < was not recognized as a valid directory, > dmove t1, [ .priou ; Continue to type on terminal .fhslf,,-1 ] ; This process, last error setz t3, ; Let it blat as much as it wants ERSTR% ; Display last Tops-20 error erjmps .+2 ; Ignore strange return erjmps .+1 ; Ignore stranger return hrroi t1,crlf ; Tie off the line PSOUT% ret ; Done, can't connect to it endif. ; End case couldn't recognize the directory move q3, t3 ; Store the directory number, just in case movx t1, ac%con!3 ; Doing a connect, block is three words long movei t2, t3 ; Argument block begins in AC3 dmove t4, [ exp 0, -1 ] ; No password, this job ACCES% ; Try the connect %jserr (,r) call udjinf ; Update currently connected directory txmsg <[Connected to > ; Inform us of new location move t1, q2 ; Point to what we constructed PSOUT% ; Type it txmsg <] > ; Tie off the line ret ; Done subttl REMOTE CDUP Execution remark REMOTE CDUP parsing .xcdup: guide confrm ; Very complicated parsing ... ret remark REMOTE PWD execution $xcdup: call statim ; Start timing so k20pdc doesn't choke dmove t1, [ ; ;G command is for CDUP point 7, [asciz/G/] ; 'G' command for data field. "G" ] ; Packet type is G. jrst dosrv ;[254] End code Insertion for Parsing and execution for CDUP subttl LOCAL DELETE parsing chgsec(code,const) ;;Parsing and tables go in constants delbk: gj%old!gj%ifg!gj%flg!.gjall ; Flag bits,,generation number. .priin,,.priou ; COMND i/o. repeat 6,<0> ; No defaults, except all generations. delbkl==<.-delbk> ; Length of this GTJFN argument block. ydefdb: flddb. .cmfil retsec .ydele: entry .ydele ; Invoked from k20par movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. CLZFF guide ; Issue guide words. move t1, [delbk,,cjfnbk] ; Insert our file parsing defaults. blt t1, cjfnbk+delbkl movei t1, ydefdb call cfield movem t2, pars3 ; Here's the JFN just parsed. hrrz t1,t2 ;[193] Load the JFN, sans flags call isnulj ;[193] Is this NUL:? ifskp. ;[193] Yes, so let's fix up the parse movem t1, pars3 ;[193] Store the .nulio in there move t2,t1 ;[193] Leave for anybody downstream endif. ;[193] ret subttl [113] LOCAL DELETE execution $ydele: entry $ydele ; Invoked from k20par extern ffunc ; File function being performed hrrz t1, pars3 ; Load parsed JFN call isdird ;[193] Is this a directory device? ifskp. ;[193] If worked, proceed movei t2, delfil ; Address of delete-file code. movem t2, ffunc ; Make it the file function. ifme. expung ;[199] Can only speed up the non-expunge case move t1, pars3 ;[199] Reload the parsed JFN with flags call ffjfgd ;[199] Fix file JFN for fast generational delete callret $ydir1 ;[199] Failed or exact generation; do each file by hand movem t1, pars3 ;[199] Store the updated JFN with flags endif. ;[199] End case not expunging callret $ydir1 ; Go do it like a directory. else. ;[193] Otherwise, not a directory device (or failed) anstkv (t4,^d4) ;[193] Allocate an anonymous stack variable move t2, t1 ;[193] Save the device designator hrro t1, t4 ;[193] Create pointer to stack space DEVST% ;[193] Convert to a string ifje. r ;[193] Failed?? move t3, t1 ;[193] Save error for debugger hrroi t4, badevc ;[193] Load a default else. ;[193] Otherwise, we have a good device dmove t2, [exp ":", .chnul] ;[193] idpb t2, t1 ;[193] Punctuate device idpb t3, t1 ;[193] Tie off the string tlo t4, -1 ;[193] So turn it into a pointer endif. ;[193] End case DEVST% error handling move t1, t4 ;[193] Load pointer to something ESOUT% ;[193] Start complaining txmsg < has no directory to delete files from> ;[193] hrroi t1, crlf ;[193] Newline PSOUT% ;[193] setz t1, ;[193] Cons up a zero exch t1, pars3 ;[193] Get and clear parsed JFN tlz t1, -1 ;[193] Clear any goofy flags RLJFN% ;[193] Punt it erjmpr .+1 ;[193] Catch and ignore error ret ;[193] And get out of here endif. ;[193] End case device check badevc: asciz "Unknown device" subttl REMOTE DELETE, DIRECTORY, TYPE parsing chgsec(code,const) ;;Chained FDB's are not in code, they're in const rmffdb: flddb. .cmqst,,,,,rmffd1 rmffd1: flddb. .cmtxt,,,,, retsec cleans() .rmfil: guide ; Parse the rest of the command. movei t1, rmffdb ;[220] Allow a quote of the remote file specification call cfield ret subttl REMOTE DELETE (Erase) execution $xdele: ifmn. tlgjfn ;[233] Doing transaction logging? block. ;[233] Get a stack frame saveac ;[233] Save even the temporaries setom scrlft ;[233] Suppress the trailing line feed wtlog(,) ;[233] move t1, tlgjfn ;[233] Put the file name name in the log hrroi t2,atmbuf ;[233] It's in the atom buffer setzb t3,t4 ;[233] Don't know how long, stop on a NUL SOUT% ;[233] Out it goes! erjmps .+1 ;[233] Catch and suppress error dmove t2,[ -1,,crlf ;[233] Tops-20 pointer to carriage return line feed -2 ] ;[233] Counted SOUT%'s are faster SOUT% ;[233] Out it goes! erjmps .+1 ;[233] Catch and suppress error endbk. ;[233] Release stack frame, restoring AC's endif. ;[233] call statim ;[189] Start timing so k20pdc doesn't choke movei t4, "E" ; Generic command is E. jrst srvfil subttl DIRECTORY command ; Default wildcard filespec fields for .CMFIL: chgsec(code,const) ;;Tables and fdb's go in const dirbk: gj%old!gj%ifg!gj%flg!.gjall ; Flag bits,,generation number. .priin,,.priou ; COMND i/o. repeat 2,<0> ; Normal defaults for dev: and gen. repeat 2,)> ; *.* for name and type. 0 ; Default protection, 0 ; and account. dirbkl==<.-dirbk> ; Length of this GTJFN argument block. wldfil: remark ;[252] Wild card specification for all files byte (1) 0 (7) .chnul,.chnul,.chnul,.chnul,"*" byte (1) 0 (7) ".","*",".","*",":" wldmax==^d<<<6+1+1+39+6>/5>+1> ;[252] Maximum size file specific from above ydifdb: flddb. .cmcfm,,,,,ydifd1 ydifd1: flddb. .cmdir,,,,,ydifd2 ydifd2: flddb. .cmdev,,,,,ydifd3 ydifd3: flddb. .cmfil,,,,, retsec cleans() .ydire: entry .ydire ; Invoked from k20par saveac ;[252] Needs some registers for things... setzb q1, q2 ;[252] Initialize to known values setzb q3, q4 ;[252] move t1, [dirbk,,cjfnbk] ; Insert our file parsing defaults. blt t1, cjfnbk+dirbkl movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. CLZFF erjmpr .+1 dmove t1, [ .fhslf ;[252] This process LSTRX1 ] ;[252] "Process has not encountered any errors" SETER% ;[252] Clear last error, if any erjmpr ydirer ;[252] System is very ill, go drop dead guide ; Issue guide words. movei t1, ydifdb ;[193] call rfield ;[193] Parse for a file, really move q1, t2 ;[193] Store whatever we got ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[193] Get function code. caie q3, .cmcfm ;[252] Just confirmed? ifskp. ;[252] He did anstkv(q4,wldmax) ;[252] Enough space to build the complete specification movx t1, wldmax ;[252] Load size of space to zero move t2, q4 ;[252] Load address to zero movei t3, 1(t2) ;[252] Cascading zero setzm (t2) ;[252] Whack the first location sosle t1 ;[252] Account for zapped location extend t1,[xblt] ;[252] Whack the rest if any left to do GJINF% ;[252] Get our current job particulars erjmpr ydirer ;[252] Should never fail, but ... hrro t1, q4 ;[252] Build a Tops-20 pointer to the stack DIRST% ;[252] Turn it into a string erjmpr ydirer ;[252] Failed on a valid parse item?? dmove t2, wldfil ;[252] Load the file specification lsh t3, -^d7 ;[252] Skip the colon as DIRST% already put it there repeat ^d4,< ;[252] Unroll the loop (easier logic) idpb t3, t1 ;[252] Deposit a byte of the file specification lsh t3, -^d7 ;[252] Get the next byte in >;; repeat ^d4 ;[252] End of first word repeat ^d2,< ;[252] Unroll the loop (easier logic) idpb t2, t1 ;[252] Deposit a byte of the file specification lsh t2, -^d7 ;[252] Get the next byte in >;; repeat ^d2 ;[252] End of second word move t1, dirbk ;[252] Load GTJFN flags hrro t2, q4 ;[252] Make a Tops-20 pointer to completed specification GTJFN% ;[252] See if Tops-20 will default something nice erjmpr ydirer ;[252] Nope, fail the parse move q1, t1 ;[252] Replace previously parsed item txne q1, gj%unt ;[251] Compensate for misdocumentation ... txo q1, gj%dev ;[251] ... in JSYS_REFERENCE tlz t1, -1 ;[252] Stomp the flags so DVCHR% doesn't choke DVCHR% ;[252] Find out all about it erjmpr ydirer ;[252] How is that possible? We have a valid JFN!! move q2, t2 ;[252] Save device characteristics dmovem q1, pars3 ;[252] Pass parsed item and characteristics movx q3, .cmfil ;[252] Pretend we parsed a file specification movem q3, pars5 ;[252] Pass parse type ret ;[252] All done! endif. ;[252] End case simple confirm cain q3, .cmdir ;[252] A directory will never be NUL: ... ifskp. ;[252] Not a directory, go figure it out move t1, t2 ;[252] Position for investigation cain q3, .cmfil ;[252] A file? (I.E., a JFN?) tlz t1, -1 ;[252] Yes, toss the flags call isnulj ;[252] Is this some flavor of NUL:? ifskp. ;[252] It is, so use the special moniker (.nulio) move q1, t1 ;[252] Replace what we got confrm ;[252] Tie off the line move q2, [dv%out!dv%in!dv%av!fld(.dvnul,dv%typ)!dv%psd!fld(-1,dv%mod)] ;[252] dmovem q1, pars3 ;[252] Pass parsed item and characteristics movx q3, .cmdev ;[252] Pretend we parsed the raw device movem q3, pars5 ;[252] Pass parse type ret ;[252] Done endif. ;[252] End case some flavor of NUL: endif. ;[252] End case checking non-directory case of NUL: caie q3, .cmdev ;[193] Picked up a device? ifskp. ;[193] Yes, let's see if we can work with it move t1, q1 ;[252] Load for DVCHR% DVCHR% ;[252] Find out all about it erjmpr ydirer ;[252] How is that possible? We just parsed it! txnn t2,dv%dir!dv%mdd ;[252] File structure (or DECtape)? jrst ydirer ;[252] No, then surely can't list it move q2, t2 ;[252] Save device characteristics anstkv(q4,^d6) ;[252] 29 characters of device name and files setzb t1, t2 ;[252] Cons up some zeros dmovem t1, ^d0(q4) ;[252] Let's scrub a bit of it dmovem t1, ^d2(q4) ;[252] and a bit more dmovem t1, ^d4(q4) ;[252] and the rest of it hrro t1, q4 ;[193] Create a Tops-20 ASCII pointer move t2, q1 ;[252] Load the DEVST% ;[193] Turn it into a string (I hope) erjmpr ydirer ;[252] Failed on a valid parse item?? dmove t2, wldfil ;[252] Load the file specification repeat ^d5,< ;[252] Unroll the loop (easier logic) idpb t3, t1 ;[252] Deposit a byte of the file specification lsh t3, -^d7 ;[252] Get the next byte in >;; repeat ^d5 ;[252] End of first word repeat ^d2,< ;[252] Unroll the loop (easier logic) idpb t2, t1 ;[252] Deposit a byte of the file specification lsh t2, -^d7 ;[252] Get the next byte in >;; repeat ^d2 ;[252] End of second word move t1, dirbk ;[252] Load GTJFN flags hrro t2, q4 ;[252] Make a Tops-20 pointer to completed specification GTJFN% ;[252] See if Tops-20 will default something nice erjmpr ydirer ;[252] Nope, fail the parse move q1, t1 ;[252] Replace previously parsed item txne q1, gj%unt ;[251] Compensate for misdocumentation ... txo q1, gj%dev ;[251] ... in JSYS_REFERENCE confrm ;[252] Tie off the line dmovem q1, pars3 ;[252] Pass parsed item and characteristics movx q3, .cmfil ;[252] Pretend we parsed a file specification movem q3, pars5 ;[252] Pass parse type ret ;[252] Done endif. ;[252] End case .cmdev caie q3, .cmdir ;[252] Picked up a directory? ifskp. ;[252] Yes, let's see if we can work with it anstkv(q4,wldmax) ;[252] Enough space to build the complete specification movx t1, wldmax ;[252] Load size of space to zero move t2, q4 ;[252] Load address to zero movei t3, 1(t2) ;[252] Cascading zero setzm (t2) ;[252] Whack the first location sosle t1 ;[252] Account for zapped location extend t1,[xblt] ;[252] Whack the rest if any left to do hrro t1, q4 ;[252] Build a Tops-20 pointer to the stack move t2, q1 ;[252] Load parsed directory DIRST% ;[252] Turn it into a string erjmpr ydirer ;[252] Failed on a valid parse item?? dmove t2, wldfil ;[252] Load the file specification lsh t3, -^d7 ;[252] Skip the colon as DIRST% already put it there repeat ^d4,< ;[252] Unroll the loop (easier logic) idpb t3, t1 ;[252] Deposit a byte of the file specification lsh t3, -^d7 ;[252] Get the next byte in >;; repeat ^d4 ;[252] End of first word repeat ^d2,< ;[252] Unroll the loop (easier logic) idpb t2, t1 ;[252] Deposit a byte of the file specification lsh t2, -^d7 ;[252] Get the next byte in >;; repeat ^d2 ;[252] End of second word move t1, dirbk ;[252] Load GTJFN flags hrro t2, q4 ;[252] Make a Tops-20 pointer to completed specification GTJFN% ;[252] See if Tops-20 will default something nice erjmpr ydirer ;[252] Nope, fail the parse move q1, t1 ;[252] Replace previously parsed item txne q1, gj%unt ;[251] Compensate for misdocumentation ... txo q1, gj%dev ;[251] ... in JSYS_REFERENCE tlz t1, -1 ;[252] Stomp the flags so DVCHR% doesn't choke DVCHR% ;[252] Find out all about it erjmpr ydirer ;[252] How is that possible? We have a valid JFN!! move q2, t2 ;[252] Save device characteristics confrm ;[252] Tie off the line dmovem q1, pars3 ;[252] Pass parsed item and characteristics movx q3, .cmfil ;[252] Pretend we parsed a file specification movem q3, pars5 ;[252] Pass parse type ret ;[252] Done endif. ;[252] End case .cmdev caie q3, .cmfil ;[252] Picked up a general file specification ifskp. ;[252] Yes, so let's get a bit more information txne q1, gj%unt ;[251] Compensate for misdocumentation ... txo q1, gj%dev ;[251] ... in JSYS_REFERENCE hrrz t1, q1 ;[252] Load the JFN, no flags DVCHR% ;[252] Find out all about it erjmpr ydirer ;[252] How is that possible? We have a valid JFN!! move q2, t2 ;[252] Save device characteristics confrm ;[252] Tie off the line dmovem q1, pars3 ;[252] Pass parsed item and characteristics movem q3, pars5 ;[252] Pass parse type ret ;[252] Done endif. ;[252] End case general file remark ;[252] Parsed something we don't know about... dmove t1, [ .fhslf ;[252] This process COMNX1 ] ;[252] "Invalid COMND function code" SETER% ;[252] Phoney up a parse error erjmpr ydirer ;[252] Handle an extremely unlikely error jrst ydirer ;[252] Otherwise, go lie about internal inconsistency subttl here on any kind of parse error ydirer: hrroi t1, atmbuf ;[252] Point to unmodified atom buffer ESOUT% ;[252] Start complaining erjmpr .+1 ;[252] Ignore any error it throws txmsg < can not have its directory listed> ;[252] Explanatory blat movx t1, .fhslf ;[252] This process GETER% ;[252] Get the last error ifje. r ;[252] Should NEVER fail, but ... move t4, t1 ;[252] Save error for debuggers movx t2, LSTRX1 ;[252] "Process has not encountered any errors" else. ;[252] Otherwise, worked setz t4, ;[252] Flag no last error tlz t2, -1 ;[252] Get rid of silly handle that we already know... endif. ;[252] Must get resolved? cain t2, LSTRX1 ;[252] Nothing went wrong, actually? ifskp. ;[252] No, so display the last Tops-20 error txmsg <: > ;[252] Introduce the Tops-20 error string movx t1, .priou ;[252] Continue to type on terminal hrli t2, .fhslf ;[252] This process setz t3, ;[252] Let it blat as much as it wants ERSTR% ;[252] Display last Tops-20 error erjmps .+2 ;[252] Ignore strange return erjmps .+1 ;[252] Ignore stranger return endif. ;[252] End case displaying last Tops-20 error hrroi t1, crlf ;[252] Tops-20 pointer to carriage return line feed PSOUT% ;[252] Type it erjmpr .+1 ;[252] Ignore error, we're trying hard enough... movx t1, cz%ncl!.fhslf ;[252] Function is to close any JFN's which are not open CLZFF% ;[252] For this fork, only erjmpr .+1 ;[252] Ignore the error callret cmder1 ;[252] Allow a reparse subttl LOCAL DIRECTORY command execution [111] $ydire: entry $ydire ; Invoked from k20par hrrz t1, pars3 ; Load parsed JFN call isdird ;[193] Is this a directory device? ifskp. ;[193] If worked, proceed setzm ffunc ; Function is "directory". jrst $ydir1 ; Go do the directory else. ;[193] Otherwise, not a directory device (or failed) anstkv (t4,^d4) ;[193] Allocate an anonymous stack variable move t2, t1 ;[193] Reposition the device designator hrro t1, t4 ;[193] Create pointer to stack space DEVST% ;[193] Convert to a string ifje. r ;[193] Failed?? move t3, t1 ;[193] Save error for debugger hrroi t4, badevc ;[193] Load a default else. ;[193] Otherwise, we have a good device dmove t2, [exp ":", .chnul] ;[193] idpb t2, t1 ;[193] Punctuate device idpb t3, t1 ;[193] Tie off the string tlo t4, -1 ;[193] So turn it into a pointer endif. ;[193] move t1, t4 ;[193] Device name ESOUT% ;[193] Begin complaining txmsg < does not have a directory to list files> ;[193] hrroi t1, crlf ;[193] Newline PSOUT% ;[193] setz t1, ;[193] Cons up a zero exch t1, pars3 ;[193] Get and clear parsed JFN tlz t1, -1 ;[193] Clear any goofy flags RLJFN% ;[193] Punt it erjmpr .+1 ;[193] Catch and ignore error ret ;[193] And get out of here endif. ;[193] End case device check $ydir1: move t2, pars3 ; Here's the JFN. setzm filjfn ; Make sure no one thinks this is in use. call dirhdr ; Do the header first. ; File-listing loop do. ;[194] Enter loop lexical context call dmpbuf ; Get some directory listing. call dirlst ; Print it. jumpn t1, top. ;[194] Go back for more. enddo. ;[194] Exit loop lexical context ret ; Till done. subttl Directory Header Set Up ; Call: ; ; t2/ JFN of files to list. ; ; Returns: ; ; +1, always. ; ; Puts the directory listing header into the server buffer. ; Initializes buffer pointers, counters, etc. repeat 0,< ;[250] Don't have this in section zero hdrtxt: asciz / Name Pages Bytes(Size) Creation Date / ;[193] Directory listing header hdrptr: point 7, hdrtxt ;[193] Pointer to heading text -^d62 ;[193] Length of text >;repeat 0 ;[250] nuldev: byte (7) "N","U","L",":",.chnul ;[193] nul4:: point 7, nuldev ; Pointer to fixed "NUL:" string -^d4 ; Length crlfch: .chcrt ;[251] Carriage Return .chlfd ;[251] Line Feed dirhdr: movem t2, ndxjfn ; Save wildcard bits. hrrzm t2, nxtjfn ; Initialize lookahead setzm filcnt ; File counter setom dirfin ; Initialize directory finished flag to assume error ; Put the listing in the server buffer. ifme. ffunc ; Directory listing? hrrz t3,t2 ;[193] Pick up just the JFN, no flags caie t3, .nulio ;[193] Data sink? ifskp. ;[193] Yep, that's easy enough move t1, [point 7, srvbuf, 27] ;[193] Points to ":" tlz t2, -1 ;[193] Shut off the flags (shouldn't be any) movni t3, ^d4 ;[193] What counted SOUT% would have wanted move t4, nuldev ;[193] Load device name in ASCII movem t4, srvbuf ;[193] Drop right into the buffer remark SOUT% ;[193] Bum the JSYS else. ;[193] Otherwise, put real file name in buffer move t1, [point 7, srvbuf] dmove t3, allfld ;[252] Everything, no goofy prefix JFNS erjmps .+1 ;[193] Catch and suppress error smsg (< Name Pages Bytes(Size) Creation Date >) ;;[250] repeat 0,< ;[250] dmove t2, hdrptr ;[193] The standard header call %%smsg ;[216] Print heading. ;[216] erjmps +1 ;[194] Catch and suppress error >;repeat 0 ;[250] move t2, ndxjfn ;[251] Load the JFN and bits movx t3,gj%dev!gj%unt!gj%dir ;[251] Will resolve if any were wildcarded and t3, t2 ;[251] Determine initial wildcard position ifn. t3 ;[251] If any set, then emit first position tdz t2, t3 ;[251] Stomp those specific wildcard flags dmove t3, crlfch ;[251] Seperation sequence idpb t3, t1 ;[251] Carriage return idpb t4, t1 ;[251] Line feed dmove t3, [fld(.jsaof,js%dev)!fld(.jsaof,js%dir)!js%paf ;[251] 0 ] ;[251] Just punctuated device and directory JFNS% ;[251] Indicate resolved location in listing erjmps .+1 ;[251] Catch and suppress error endif. ;[251] End case wildcarded directory endif. ;[193] End special case .nulio else. ;[193] Otherwise, just reset the buffer pointer move t1, [point 7, srvbuf] endif. ;[194] End case file function decision setzm dirfin ; No error, so not finished. movem t1, srvptr ; Preserve string buffer pointer. ret subttl Directory Listing Display Logic ; Constructs directory listing text in a chunk of memory starting at ; SRVBUF and ending at (or slightly after) SRVBZ. Updates SRVPTR. ; ; Returns +1 always, with t1/ -1 if we got some data, t1/ 0 if done. ; ; Keeps global file counter in FILCNT. ; ; Be aware that the routine is doing double duty for ANY file function ; that might need to be executed over a set of files. dirlst: setz t1, skipe dirfin ; Finished? ret ; Yes. move t1, srvptr ; No, there's more to do. dmove t2, crlfch ;[251] Load the line break idpb t2, t1 ;[194] And issue idpb t3, t1 ;[194] it movem t1, srvptr ; Save the buffer pointer. call gtnfil ; Get next file. jrst dirlsz ; If none, done. aos filcnt ; Got one, count it. ;[133] Get detailed size info from FDB. hrrz t2, t1 ;[251] Load JFN with no flags move t1, [byte (7) .chspc,.chspc,.chspc,.chspc,.chspc] ;[193] movem t1, filbuf ;[194] Fill the filename buffer with blanks. move t1, [filbuf,,filbuf+1] blt t1, filbfz-1 remark ;[193] Always put the file name in caie t2, .nulio ;[193] Data sink? ifskp. ;[193] Yes, don't do any of the file stuff move t3, nuldev ;[193] Just the device name movem t3, filbuf ;[193] Store a hardwired name move t1, [ point 7, filbuf, 27] ;[193] Where SOUT% would leave it else. ;[193] Otherwise, an honest file move t1, [point 7, filbuf] ; Now start filling in the fields. movx t3, fld(.jsaof,js%nam)!fld(.jsaof,js%typ)!fld(.jsaof,js%gen)!js%tmp!js%paf setz t4, ;[193] No goofy prefix JFNS erjmps dirlsz ;[193] Failed, get out of here endif. ;[193] End special case NUL: movem t1, filptr ;[193] Store updated pointer ifme. ffunc ; What was the file function? call filinf ;[200] Pull the file information jrst dirlsz ;[200] Or fail the loop caie t2, .nulio ;[193] Was it a directory of NUL:? ifskp. ;[193] Yes, so go make that up call nulist ;[193] Just make up our own entry jrst dirlsz ;[193] Failed, get out of here else. ;[193] Otherwise, this is a real file call filist ;[193] Construct text for this file jrst dirlsz ;[193] Failed, get out of here hllz t3, nxtjfn ;[251] Load current file's stepping flags andx t3,gn%str!gn%dir ;[251] Trigger on structure or device change ifn. t3 ;[251] If either changed, then emit current position dmove t3, crlfch ;[251] Seperation sequence idpb t3, t1 ;[251] Carriage return idpb t4, t1 ;[251] Line feed move t3, t1 ;[251] Get a copy of the pointer setz t4, ;[251] Cons up a NUL idpb t4, t3 ;[251] Tie off string, allowing append block. ;[251] Get another stack context for control flow saveac ;[251] Leave whatever JFN is in t2, alone hrrz t2, ndxjfn ;[251] Load next JFN in sequence, no flags dmove t3, crlfch ;[251] Seperation sequence idpb t3, t1 ;[251] Carriage return idpb t4, t1 ;[251] Line feed dmove t3, [fld(.jsaof,js%dev)!fld(.jsaof,js%dir)!js%paf ;[251] 0 ] ;[251] Just punctuated device and directory JFNS% ;[251] Indicate change in listing erjmps rskp ;[251] +2 return, failed remark ;[251] +1 return, WORKED!! endbk. ;[251] End block context, restoring t2 ifskp. ;[251] +2 failed? move t3, t1 ;[251] Get a copy of the pointer setz t4, ;[251] Cons up a NUL idpb t4, t3 ;[251] Tie off anything we wrote, allowing append jrst dirlsz ;[251] Failed the JFNS%, beat it endif. ;[251] End case JFNS% error handling endif. ;[251] End case printing directory on change endif. ;[193] End .nulio special casing endif. ;[193] End case doing a directory movem t1, filptr ;[193] Store updated pointer setz t3, ; Done with this line, make it asciz. idpb t3, t1 ; Copy the result into the server sending buffer. block. ;[202] Set up a stack frame saveac ;[202] movst gorges on registers move q1, srvptr ;[202] Load server buffer pointer move t2, [point 7, filbuf] ;[202] Load source pointer setzb t3, q2 ;[202] Force section local pointers move t1, [S!mxascz] ;[202] Limit source length, start significance movx t4, [mxascz] ;[202] Limit destination length extend t1, movasc ;[202] Move characters, doing useless translating nop ;[202] Will never +1 because t1 and t4 are equal movem q1, srvptr ;[202] Save updated destination pointer endbk. ;[202] End of stack frame ; Still expect to have file jfn in t2 when we get here. skipn t1, ffunc ;[199] What is the function? ifskp. ;[200] Not doing a directory remark t2, ;[200] Already has the right JFN hll t2, ndxjfn ;[200] Put in the global stepping flags call (t1) ;[200] and go do selected function. endif. ;[200] move t1, srvptr hrrz t2, t1 ; See if buffer full. caige t2, srvbz ;[194] Full? ifskp. ;[194] It is seto t1, ; Return indicating we have data. ret endif. ;[194] jrst dirlst ; Loop for another file ; Done, print summary. dirlsz: move t1, srvptr ; Get the buffer pointer. movei t2, .chspc ;[194] Summary. First a space. BOUT move t2, filcnt ; Then the number of files. movei t3, ^d10 NOUT erjmp .+1 sosn filcnt ; Do singular or plural right. ifskp. ; Was more than one smsg < files > else. ; Otherwise, unary case smsg < file > endif. movem t1, srvptr ; Save pointer. setob t1, dirfin ; Say we're returning data. remark dirfin ; Set finished flag for next time through. ret subttl NUL: device directory listing ;[193] Begin Code Insertion ; Expects t1 to point to a buffer area to write text nuldir: asciz / 0 0(7) Now/ nulfil: ^d25 ; Length of phoney directory entry point 7, nuldir ; Pointer to our phoney directory entry movchr: intern movchr ; Extended opcode is also used elsewhere movslj 0, 0 ; No accumulator; E1 unused .chspc ; Fill with spaces nulist: push p, q1 ; Extend gorges on registers push p, q2 move q1, t1 ; Reposition destination dmove t1, nulfil ; Load source length and pointer move t4, t1 ; Source and destination are the same length setz t3, q2 ; Force section local pointers extend t1, movchr ; Copy the listing over nop ; Will never +1 since t1 == t4 move t1, q1 ; Return final destination pointer remark t4, ; t4 is still zero idpb t4, q1 ; Tie of the string, allowing append pop p, q2 ; Restore registers pop p, q1 retskp ; Return success, pointing to .chnul ;[193] End Code Insertion subttl Real directory listing, including file size and creation date. ; Call: ; ; t1/ Pointer to buffer area ; ; Assumes the following are valid: ; ; pagcnt/ Number of pages (or blocks) in the file ; bytcnt/ Count of bytes in the file and byte size ; crdate/ Creation date and time ; ; In other words that filinf has been called. Note that it is a ; mistake to use this when doing .nulio, even though filinf will ; put reasonable (yet false) data in. The resulting string will ; always be the same, so this is special cased. ;[122] The rest of this routine rewritten to provide nice columnar listing. filist: move t1, filptr ;[193] Load current buffer pointer movei t3, .chspc ; Put a blank over the null left by JFNS. idpb t3, t1 hrrz t2, t1 ; Get address from updated pointer. cail t2, filbuf+4 ; Name stayed within its field? ifskp. ;[194] It did move t1, [point 7, filbuf+4] ; Yes, advance to next field. movx t3, else. ;[194] Otherwise, blew through it movei t2, .chspc ; No, do free format. idpb t2, t1 ; Deposit a blank, advance pointer. movei t3, ^d10 ; No fixed-field stuff on page count. endif. ;[194] ;[133] More detailed info about size: pages, byte count, byte size. hrrz t2, pagcnt ; Number of pages in file. NOUT erjmps r ; Catch and suppress error, returning +1 movei t3, .chspc ; A blank idpb t3, t1 move t2, bytcnt ; Byte count, free format. movei t3, ^d10 NOUT erjmps r ; Catch and suppress error, returning +1 ldb t2, [pointr (pagcnt,fb%bsz)] ;[200] Load the byte size ifn. t2 ;[200] Device may not do byte sizes movei t3, "(" ; Byte size, in parens. idpb t3, t1 movei t3, ^d10 NOUT erjmps r ; Catch and suppress error, returning +1 movei t3, ")" idpb t3, t1 ;[133](end) Closing parens. else. ;[200] Fix string contiguity move t2, t1 ;[200] Get a copy of the pointer movei t3, .chspc ;[200] Load a space idpb t3, t2 ;[200] Overwrite the .chnul endif. ;[200] cail t3, filbuf+11 ;[194] Out of the field? ifskp. ;[194] No, that's great! move t1, [point 7, filbuf+11] else. ;[194] Otherwise, overflowed field movei t2, .chspc ; Put in a blank to separate. idpb t2, t1 endif. skipn t2, crdate ;[200] Pick up creation date, if there is one ifskp. ;[200] There was, let's type it movx t3, ot%4yr ;[200] We're waaaaay past the millenium ODTIM% ;[200] Finally display something erjmps r ;[200] Catch and suppress error, returning +1 endif. ;[200] retskp ;[193] Won subttl REMOTE DIRECTORY execution $xdire: ifmn. tlgjfn ;[233] Doing transaction logging? block. ;[233] Get a stack frame saveac ;[233] Save even the temporaries setom scrlft ;[233] Don't append the crlf! wtlog(,) ;[233] move t1, tlgjfn ;[233] Put the directory name in the log hrroi t2,atmbuf ;[233] It's in the atom buffer setzb t3,t4 ;[233] Don't know how long, stop on a NUL SOUT% ;[233] Out it goes! erjmps .+1 ;[233] Catch and suppress error dmove t2,[ -1,,crlf ;[233] Tops-20 pointer to carriage return line feed -2 ] ;[233] Counted SOUT%'s are faster SOUT% ;[233] Out it goes! erjmps .+1 ;[233] Catch and suppress error endbk. ;[233] Release stack frame, restoring AC's endif. ;[233] call statim ;[189] Start timing so k20pdc doesn't choke movei t4, "D" ; Generic command is D. jrst srvfil subttl REMOTE ERROR parsing ; This is a SECRET command to send an (optionally) null error packet. Shh!! chgsec(code,const) ;;Chained fdb's go in const xerfdb: flddb. .cmcfm,,,,,xerfd1 xerfd1: flddb. .cmqst,,,,,xerfd2 xerfd2: flddb. .cmtxt,,,,, retsec cleans() .xerr: movei t1, xerfdb ;[220] Allow a quote of the remote file specification call rfield ;[220] Try to parse something ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[220] Get function code. cain t3, .cmcfm ;[220] Confirm? ret ;[220] We're done confrm ;[220] Otherwise tie off the line move t1,[point 7,atmbuf];[220] Load pointer to complaint department movem t1, pars3 ;[220] and ask to ship that off ret subttl REMOTE ERROR semantic action $xerr: saveac ;[220] Extra register for possible pointer call statim ;[189] Start timing so k20pdc doesn't choke skipn q1, pars3 ;[220] Wants to send accompanying text ifskp. ;[220] Must be really annoyed... setz t3, ;[220] Let's assume a bogus parse move t2, q1 ;[220] Load the pointer we were passed ildb t3, t2 ;[220] Try to get a character erjmpr .+1 ;[220] Catch and store error for debuggers cain t3, 0 ;[220] Anything there? anskp. ;[220] No, so still sending a null packet else. ;[220] No pointer, or bad pointer or no data movei t1, "E" ; Send an error packet. move t2, pktnum ;[220] Packet number must match setzb t3, t4 ;[220] Yet no data call spack ;[220] Send the packet... nop ;[220] ... and ignore the response ret ;[220] Done with this trivial case endif. ;[220] End argument check remark ;[220] Otherwise, stuff some text in setzb t1, t2 ;[220] Cons up some .chnul's dmovem t1, strbuf ;[220] Zero out old stuff dmovem t1, strbuf+2 ;[220] and a bit more of it move t2, [ point 7, strbuf ] ;[220] Point to string buffer movem t2, strptr ;[220] Save current location move t1, q1 ;[220] Load pointer to error text setz t3, ;[220] Zero the count do. ; Enter loop context to copy the complaint ildb t4, t1 ; Pick up a byte of the wahhh jumpe t4, endlp. ; Stop at the end of the string idpb t4, t2 ; Deposit it in string buffer aoja t3, top. ; Get some more bytes, weee!! enddo. ; End of loop context setz t4, ;[220] Cons up a NUL idpb t4, t2 ;[220] Tie off string but don't count it movei t1, "E" ;[220] Sending an error packet with extra flavoring move t2, pktnum ;[220] Packet number must match remark t3, data count ;[220] Unchanged from do. loop move t4, strptr ;[220] Load beginning of data area call spack ;[220] Send the packet... nop ;[220] ... and ignore the response ret ;[220] Done with the semantic action for ERROR subttl FINISH command ;[28] The FINISH command is edit 28. ; Invoked by K20PAR .finis: entry .finis ;[220] guide (remote server operation) ; Parse rest of FINISH command. confrm ret remark Execute FINISH command. $finis: entry $finis ;[220] call statim ;[189] Start timing so k20pdc doesn't choke move t1, [point 7, [asciz/F/]] ; An "F" for the data field. movei t2, "G" ; Packet type is G. call srvcmd ; Go send the command. nop ; Ignore any failure. ret ; Done. subttl REMOTE HELP remark REMOTE HELP parsing .xhelp: guide confrm ret remark REMOTE HELP execution $xhelp: ifmn. tlgjfn ;[233] Doing transaction logging? block. ;[233] Get a stack frame saveac ;[233] Save even the temporaries wtlog(,) ;[233] endbk. ;[233] Release stack frame, restoring AC's endif. ;[233] call statim ;[189] Start timing so k20pdc doesn't choke call sinfo ; Exchange parameters. ret ;[133] Failed, give up. dmove t1, [point 7, [asciz/H/] ; H command for data field. "G" ] ; Packet type is G. jrst dosrv subttl REMOTE HOST parsing chgsec(code,const) ;;Chained fdb's go in const xhofdb: flddb. .cmqst,,,,,xhofd1 xhofd1: flddb. .cmtxt,,,,, retsec cleans() .xhost: guide movei t1, xhofdb ;[220] Allow a quote of the remote command call cfield ret subttl REMOTE HOST command [105] $xhost: ifmn. takdep ;[176] Allow commands to servers from TAKE file ifmn. local ; This only works if local Kermit. ermsg% (,r) endif. ;[194] End case not remote endif. ;[194] End case allowing from take file call statim ;[189] Start timing so k20pdc doesn't choke dmove t1, [point 7, atmbuf ; And move them from here point 7, strbuf] ; to here. do. ;[194] Enter loop context ildb t4, t1 ; Copy the string. jumpe t4, endlp. ;[194] idpb t4, t2 loop. ;[194] enddo. ;[194] move t3, seolch ; Terminate it with the host's eol character. idpb t3, t2 idpb t4, t2 ; And a null. call ccon ;[169] Enable ^C during this bit. jrst ccoff ;[169] Where to go if ^C happens. call sinfo ; Exchange params. jrst ccoff ;[169] Failed, give up, turn off ^C trap. call ccoff ;[169] move t1, [point 7, strbuf] ; Point to command. movei t2, "C" ; Packet type is C. jrst dosrv ; Go send it and handle the reply. subttl PWD command remark LOCAL PWD (trivial) parsing .ypwd: entry .ypwd guide confrm ret remark LOCAL PWD semanic action $ypwd: entry $ypwd hrroi t1, crlf ; Offset from prompt PSOUT% GJINF% ; Get current job information. movei t1, .priou ; Type on terminal remark t2, ; Already has the connected directory DIRST% ; Translate into a string %jserr (,r) hrroi t1,crlf ; Tie off the line PSOUT% ret subttl REMOTE PWD ;[188] Begin Code Insertion remark REMOTE PWD parsing .xpwd: guide confrm ret remark REMOTE PWD execution $xpwd: call statim ;[189] Start timing so k20pdc doesn't choke dmove t1, [ point 7, [asciz/A/] ; 'A' command for data field. "G" ] ; Packet type is G. jrst dosrv ;[188] End Code Insertion subttl LOCAL SPACE remark LOCAL SPACE (trivial) parsing .ydisk: entry .ydisk guide confrm ret remark LOCAL SPACE semanic action $ydisk: entry $ydisk seto t1, ; local disk usage query. GTDAL% %jserr (,r) dmove q1, t1 txmsg < Quota: > ;[194] caige q1, [^d100000000] ;[194] Where did this number come from? ifskp. ;[194] Really big ... txmsg <+Inf> ;[194] else. ;[194] numout q1 endif. txmsg <, used: > numout q2 txmsg < (pages)> ret subttl REMOTE SPACE remark REMOTE SPACE parsing .xdisk: guide confrm ret remark REMOTE SPACE execution $xdisk: call statim ;[189] Start timing so k20pdc doesn't choke dmove t1, [ point 7, [asciz/U/] ; U command for data field. "G" ] ; Packet type is G. jrst dosrv subttl LOCAL STATISTICS ; Parse rest of STATISTICS command. .stat: entry .stat guide confrm ret remark LOCAL STATUS execution ;[189] All part of edit [189] $ysrvt: entry $ysrvt extern $srvt,statxt ;[194] Our necessary call $srvt ; Format the stuff hrroi t1,statxt ; Point to text it built PSOUT% ; Print it erjmpr r ; Get error, get out of here ret ; Get out of here subttl REMOTE STATUS ;[189] Begin Code Insertion remark REMOTE STATUS parsing .xstat: guide confrm ret remark REMOTE STATUS execution $xstat: ifmn. tlgjfn ;[233] Doing transaction logging? block. ;[233] Get a stack frame saveac ;[233] Save even the temporaries wtlog(,) ;[233] endbk. ;[233] Release stack frame, restoring AC's endif. ;[233] call statim ;[189] Start timing so k20pdc doesn't choke dmove t1, [ point 7, [asciz/Q/] ; 'Q' command for data field. "G" ] ; Packet type is G. jrst dosrv ;[198] End Code Insertion subttl LOCAL TYPE [143] chgsec(code,const) ;;Tables and fdb's go in const typbk: gj%old!gj%ifg!gj%flg ; Flag bits,,most recent generation. .priin,,.priou ; COMND i/o. repeat 6,<0> ; No defaults, except all generations. typbkl==<.-typbk> ; Length of this GTJFN argument block. typfdb: flddb. .cmfil,,,,,typfd1 typfd1: flddb. .cmdev,cm%sdh ;[193] retsec cleans() .ytype: entry .ytype movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. CLZFF erjmpr .+1 ;[194] Catch and ignore any odd error guide ; Issue guide words. move t1, [typbk,,cjfnbk] ; Insert our file parsing defaults. blt t1, cjfnbk+typbkl ; Same as for DELETE. movei t1, typfdb ;[193] call rfield ;[193] Parse something move q1, t2 ;[193] Store whatever we got ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[193] Get function code. caie q3, .cmdev ;[193] Picked up a device? ifskp. ;[193] Yes, let's see if we can work with it anstkv(t4,^d4) ;[193] 20 characters of device name setzm (t4) ;[193] Let's scrub a bit of it hrro t1, t4 ;[193] Create a Tops-20 ASCII pointer DEVST% ;[193] Turn it into a string (I hope) ifje. r ;[193] Failed?? move t3, t1 ;[193] Save error code for debuggers seto q2, ;[193] Cons up an impossible JFN else. ;[193] Otherwise, have a string we can maybe use dmove t2, [ exp ":", 0] ;[193] Load final characters idpb t2, t1 ;[193] Punctuate the device idpb t3, t1 ;[193] Tie off the device string movx t1, ;[193] Short form, want flags hrro t2, t4 ;[193] Recreate a Tops-20 ASCII pointer GTJFN% ;[193] Try to get a handle ifje. r ;[193] Sigh... move t3, t1 ;[193] Save error code for debuggers seto q2, ;[193] Cons up an impossible JFN else. ;[193] Otherwise, worked move q2, t1 ;[193] Put JFN in a COMND% kind of place endif. ;[193] endif. ;[193] End case of DEVST% handling else. ;[193] Otherwise, got a JFN move q2, q1 ;[193] Put JFN in a COMND% kind of place endif. ;[193] End case .cmdev transmogrification skipg t1, q2 ;[193] Load the JFN, unless we couldn't get one move t1, q1 ;[193] Otherwise, load the device move t4, t1 ;[193] Save a handy copy call isnulj ;[193] Is this NUL:? ifskp. ;[193] Yes, so let's fix up the parse move q2, t1 ;[193] Store the .nulio in there else. ;[193] Otherwise, isn't NUL: move t1, t4 ;[193] Load whatever we parsed caie q3, .cmdev ;[193] Did we parse a device? ifskp. ;[193] We did move t1, q1 ;[193] so use that else. ;[193] Otherwise, got a JFN tlz t1, -1 ;[193] So use that endif. DVCHR% ;[198] Let's find out about the device %jserr (,r) ;[193] ldb t3,[pointr t2, dv%typ] ;[193] Pick up the device type cain t3, .dvdsk ;[193] Isn't a disk? anskp. ;[193] It is, so we're fine move t2, t1 ;[193] Load device designator for DEVST% hrroi t1, t3 ;[193] String is going in the registers setzb t3, t4 ;[193] Get 9 characters of device (only need 6) DEVST% ;[193] Get a string representation ifje. r ;[193] Pick up and ignore error move t2, t1 ;[193] Save error code for debuggers dmove t3, [asciz /Unknown/] ;[193] Phoney up something endif. ;[193] skipg t1, q2 ;[193] Load the JFN ifskp. ;[193] If it was a JFN... tlz t1, -1 ;[193] Stomp any flags RLJFN% ;[193] Toss it erjmpr .+1 ;[193] Catch and ignore error endif. ;[193] hrroi t1, t3 ;[193] String is coming from registers ESOUT% ;[193] Begin complaining txmsg <: is not a directory structured device > ;[193] Complete the blat callret cmder1 ;[193] Allow a reparse endif. ;[193] confrm ;[193] Tie off the line movem q2, pars3 ; Here's the JFN just parsed. ret subttl LOCAL TYPE command execution. $ytype: entry $ytype ;[194] Maybe move this? skipg t1, pars3 ; Get the JFN. ret ; Junk, just don't do anything ... saveac ; Save for fast copy of current JFN move q1, t1 ; Save the JFN (and its flags) call isnulj ; BUT!! Is this JFN open on NUL:? ifskp. ; It is, so fix some things up movem t1, filjfn ; Let's say .nulio is 'open' movem t1, nxtjfn ; And that it is our next JFN movem t1, ndxjfn ; Store as our pseudo-stepping JFN hllm q1, ndxjfn ; Also store original flags on NUL: hrrz q1, t1 ; And over the previous JFN and flags else. ; Otherwise, set up for real file stepping. hrrz t1, q1 ;[220] Load just the JFN, no flags call isdird ;[193] But! Did somebody slip something phonkey in? ifskp. ;[193] Nope, this is a directory device movem q1, ndxjfn ; Store JFN and flags hrrzm q1, nxtjfn ; Just the JFN, no flags setzm filjfn ; No file currently open else. ;[193] Otherwise, not NUL:, so we can't use this anstkv(q2,^d4) ;[193] 20 characters of device name setzb t3, t4 ;[193] Cons up some NUL's dmovem t3, 0(q2) ;[193] Let's scrub dmovem t3, 2(q2) ;[193] a dub dub hrroi t1, 0(q2) ;[193] Tops-20 pointer to beginning of buffer hrrz t2, q1 ;[193] Load the JFN, sans flags dmove t3, [fld(.jsaof,js%dev)!js%paf 0 ] ;[193] Just the punctuated device, no prefix JFNS% ;[193] Convert it ifje. r ;[193] Failed?? move t2, t1 ;[193] Save the error for debuggers dmove t3, [ asciz /Unknown:/ ] ;[193] dmovem t3, 0(q2) ;[193] Store some kind of message... endif. hrroi t1, 0(q2) ;[193] Tops-20 pointer to beginning of buffer ESOUT% ;[193] Begin whining txmsg < is not a directory structured device > jrst $ytypz ;[193] Finally get out of here endif. ;[193] End directory device double check endif. ;[193] End NUL: 'directory' special check call ccon ;[169] Allow ^C out of this. jrst $ytypy ;[169] Upon ^C, get out of here do. ; Enter loop context call gtnfil ; Any more files? exit. ; Nope, beat it hrrz q1, t1 ; OK, so save what we're doing now call clrcno ; Clear Control-O, if set hrroi t1, crlf ; Tie off the line PSOUT% movei t1, .priou ; Going to primary output move t2, q1 ; Load the current JFN to do call typnam ; Type the file name exit. ; Stop processing files on error move t1, q1 ; Load JFN caie t1, .nulio ;[193] Not actually typing anything? ifskp. ;[193] No, so that's easy to set up movx t3, ^d8 ;[193] Assume NUL: is always eight bit else. ;[193] Otherwise, a real JFN, maybe? move t2, [1,,.fbbyv] ;Get bytesize. movei t3, t4 GTFDB ifje. r ;[194] Might fail if not disk move t3, t1 ;[194] Save error code for debugger setz t4, ;[194] If failed, say no byte size move t1, q1 ;[194] Reload JFN endif. ;[194] movx t2, of%rd+fld(7,of%bsz) ; Assume 7-bit mode. ldb t3, [pointr (t4,fb%bsz)] ; Extract the bytesize. cain t3, ^d8 ; 8 bit? movx t2, of%rd+fld(^d8,of%bsz) ; Yes, 8-bit. OPENF ; Open the file in appropriate mode. %jserr (,endlp.) endif. ;[193] End .nulio special casing call typfil ; Type the file exit. ; If failed, go no further move t1, q1 ; Close the file. caie t1, .nulio ; Unless there is no need CLOSF %jserr (,endlp.) setz q1, ;[194] Done with this file loop. ;[194] Do the next file enddo. ;[193] End loop context $ytypy: call ccoff ; Turn off ^C call whakfp ; Whack any left over pages nop ; Ignore any error $ytypz: ifn. q1 ; Any JFN left lying around maybe? move t1, q1 ; OK, so load it call frclos ; Force it to close endif. ret ; No more, done. subttl REMOTE TYPE command execution. $xtype:; entry $xtype ifmn. tlgjfn ;[233] Doing transaction logging? block. ;[233] Get a stack frame saveac ;[233] Save even the temporaries setom scrlft ;[233] Don't append the crlf! wtlog(,) ;[233] move t1, tlgjfn ;[233] Put the directory name in the log hrroi t2,atmbuf ;[233] It's in the atom buffer setzb t3,t4 ;[233] Don't know how long, stop on a NUL SOUT% ;[233] Out it goes! erjmps .+1 ;[233] Catch and suppress error dmove t2,[ -1,,crlf ;[233] Tops-20 pointer to carriage return line feed -2 ] ;[233] Counted SOUT%'s are faster SOUT% ;[233] Out it goes! erjmps .+1 ;[233] Catch and suppress error endbk. ;[233] Release stack frame, restoring AC's endif. ;[233] call statim ;[189] Start timing so k20pdc doesn't choke movei t4, "T" ; Generic command is T. jrst srvfil subttl Server Operation ; GETCOM ; ; We come here if we are in server mode. We just wait for a packet of one of ; the following types: ; ; S Send init - just follow the normal path from here ; R Receive init - like a local "send filespec" ; I Init (all-purpose exchange of parameters) ; G Generic command: ; L Logout - the other side is done, log out this job ; F Finish - exit from Kermit ; U Disk Usage query ; T Type a file ; etc ; ; First, issue a message telling the user what to do. ; getcom: entry getcom ;[194] Also invoked from k20par movei t1, [ ;[157] In case line gets XOFF'd while call ttxon ;[157] typing the message, unstick it, jrst getcm2 ] ;[157] and proceed. call timeit ;[157] Set the timer. ifmn. local ;[174] Local mode? txmsg < Entering server mode on TTY> ;[174] Yes, give appropriate message. numout ttynum, 8 skipg t2, speed ;[194] Load speed ifskp. ;[194] If we have one .. txmsg <, > movei t1, .priou ;[194] movei t3, ^d10 ;[194] NOUT% txmsg < baud> endif. ;[194] jrst getcmm ;[174] endif. ;[194] txmsg < Kermit Server running on > ;[186] hrroi t1,sysnam## ;[186] Load local node name PSOUT% ;[186] Type it, not "DEC-20" txmsg < host. Please type your escape sequence to return to your local machine. Shut down the server by typing the BYE command to KERMIT on your local machine.> ;[186] getcmm: txmsg < > getcm2: call timoff ;[157] Turn off timer. call statim ;[189] Give k20pdc something to not choke on setom srvflg ; Flag that we are serving. call inilin ; Initialize the line. call ccon ; Don't let someone ^C without reseting line. jrst xgfin2 ; On control-C, go "finish". setzb t3, t4 ; Set default parameters in case we get some dmovem t3, delay ;[212] No delay in server mode (gets floating value) call spar ; command before first Send-Init or Info. jrst xxwait ; Go wait for a command packet. subttl Server command loop ; Server commands should always jrst back to here, even upon error, ; except for those that specify exit from server mode. xxwait: skipe mdmlin ;[130] Modem line? skipe carier ;[130] Did carrier drop? skipa ;[130] No. jrst xgfin2 ;[130] Yes, go clean up. setom sptot ;[134] Clear packet statistics counters setom rptot ;[134] ... setzm xflg ; Clear the server "type" flag. setzm source ; Ditto for GETCH source. setzm dest ; Ditto for PUTCH destination. setzm ffunc ; And for file function. dmove t1, srvtim ;[212] ; Get the default server packet time out. dmovem t1, stimou ;[212] ; Set it so we don't time out as often. do. ;[194] Enter loop context setom bctone ;[98] Set this so we use type 1 checksum. setzm pktnum ; Initial packet sequence number. call rpack ; Get a packet. ifskp. ;[194] Worked cain t1, "T" ;[194] But!! A TIMER interrupt pseudo packet? anskp. ; On timeout, NAK what we're looking for. cail t1, "A" ;[150] Packet type in range? caile t1, "Z" ;[150] kermsg (,xxwait) ;[150] No. exit. ;[194] Otherwise, goo so break out of the loop else. ;[194] Some kind of error move t2, pktnum ; Load current packet number call nak ; NAK that "packet". loop. ;[194] Go round again. loop. ; (no matter what) endif. ;[194] End packet reception analysis enddo. ;[194] End loop lexical context ; Got a real command. Restore the normal timeout interval and do the command. movem t2, pktnum ; Save packet number. push p, t1 ; We can't use any normal AC's here... push p, t2 ;[212] Ditto floating display value dmove t1, otimou ;[212] Put normal timeout back. dmovem t1, stimou ;[212] pop p, t2 ;[212] Restore this, too pop p, t1 subi t1, "A" ;[194] Get into range (easier to debug) jrst @xxcmd(t1) ;[150] Go do the indicated command. ;[150] Server command dispatch table and error message routines. xxcmd: xxinv ; A - Attributes, shouldn't come now xxinv ; B - EOT, shouldn't come now xhost ; C - Host Command xxinv ; D - Data, shouldn't come now xxwait ; E - Error, just ignore xxinv ; F - File header, shouldn't come now xgen ; G - Generic Command xxunk ; H - Undefined xinfo ; I - Info Packet xxunk ; J - Undefined xxunk ; K - Undefined xxunk ; L - Undefined xxunk ; M - Undefined xxwait ; N - NAK, ignore xxunk ; O - Undefined xxunk ; P - Undefined xxunk ; Q - Undefined xrecv ; R - Receive (GET), server sends xsend ; S - Send, server receives xxwait ; T - (Already handled specially above) xxunk ; U - Undefined xxunk ; V - Undefined xxunk ; W - Undefined xxinv ; X - Text Header, shouldn't come now xxwait ; Y - ACK, ignore xxinv ; Z - EOF, shouldn't come now 0 ; (superstition) ; Routine to issue informative error messages. xxunk: move t4, [point 7, xxumsg] ; Get "unknown command" message. movei t3, xxulen ; And its length jrst xxmsg xxinv: move t4, [point 7, xxbmsg] ; Get "invalid use of..." message. movei t3, xxblen ; And its lentgh. xxmsg: push p, t4 ; Save msg pointer. ibp t4 ; Point past opening quote. idpb t1, t4 ; Deposit the packet type. movei t1, "E" ; Send an Error packet. move t2, pktnum ; This is the packet number. pop p, t4 ; Get original pointer back. call spack ; Send the error packet. nop jrst xxwait ; Go back to command wait. subttl Server commands. ; Server SEND command (i.e. send to me, I'm the server, I receive the files.) ; ; We've just received a Send-Init. ; xsend: setzm numtry ; Packet retry counter. movem t2, pktnum ; Synchronize packet numbers. call spar ; Get the Send-Init parameters. move t4, [point 8, datbuf] ;[190] ;[50] Now send back our own, call rpar ; which we put in the data field of our ACK. movei t1, "Y" ; Set up the ACK. move t2, pktnum ; Packet number. call spack ; Send the packet. jrst xxwait ;* Give up if we can't.(?) call rrinit ;[126] Set things up for receiving. movei state, "F" ; Set the state to file send. call $recvs ;[42] Go look like we're receiving. nop ; jrst xxwait ; Get another command when done. ; Server RECEIVE (or GET) command -- Server sends files. ; ; We've just received a Receive-Init packet, containing a filename. ; (Or a remote TYPE command). T1-T4 contain packet parameters returned ; by RPACK. ; xrecv: move t1, t4 ;[141] Pointer to encoded filespec. move t2, t3 ;[141] Number of characters. call decodf ;[141] Decode it. kermsg (, xxwait) ;[141] Can't? Give message. move t2, t1 ;[141] Decoded OK, point to decoded filespec. ; Entry point when filespec already decoded. xrecv2: movx t1, gj%sht!gj%old!gj%ifg ; Old file and allow wildcarding. GTJFN% ; Get a JFN. %jsker (,xxwait) ; Can't, send error packet and loop. movem t1, ndxjfn ;[111] Got JFN, save wildcard bits here. hrrzm t1, nxtjfn ;[111] Initialize file lookahead. call isnulj ;[193] Is this the NUL: device? ifskp. ;[193] It is, propagate our talisman hrrzm t1, nxtjfn ;[193] Re-initialize file lookahead hrrzm t1, ndxjfn ;[193] Save JFN with whacked wildcard bits endif. ;[193] call gtnfil ;[111] Get next (in this case, first) file. nop ;[111] Could never fail, right? call $sends ; Go send the file(s). nop ; (in case it skips for some reason...) jrst xxwait ; Go back & get another command. ; HOST command. xhost: kermsg (, xxwait) ;[150] Server GENERIC command. Get the subcommand and execute it. xgen: ildb t1, t4 ; Get the first character of the data field. cail t1, "A" ; Validate. caile t1, "Z" kermsg (, xxwait) ; Bad. sos t3 ; Command in range, account for it. subi t1, "A" ;[194] Command in range, change to table offset cain t1, "Q" ;[189] Don't overwrite times on status query!! jrst @xxgcmd(t1) ;[194] Dispatch to it. call @xxgcmd(t1) ;[189] Go do whatever we're supposed to be doing call endtim ;[189] Stop timing call elptim ;[189] Compute elapsed time ret ;[189] ;[150] Server generic command dispatch table. xxgcmd: xgpwd ;[188] ; A - PWD xgundf ; B - Undefined xgcwd ; C - CWD xgdir ; D - Directory xgdel ; E - Erase (delete) xgfin ; F - Finish xgcdup ;[254] ; G - CDUP xghelp ; H - Help xgnyi ; I - Login (not yet implemented) xgnyi ; J - Journal control (nyi) xgnyi ; K - Copy (nyi) xglogo ; L - Logout, Bye xgnyi ; M - Short message xgundf ; N - Undef xgundf ; O - Undef xgnyi ; P - Program invocation (nyi) xgstat ; Q - Server status query xgnyi ; R - Rename (nyi) xgundf ; S - Undef xgtype ; T - Type xgdisk ; U - Disk Usage xgnyi ; V - Variable Set/Query xgnyi ; W - Who (Finger) xgundf ; X - Undef xgundf ; Y - Undef xgundf ; Z - Undef 0 xgundf: move t4, [point 7, xxgums] ; Issue message for undefined command. movei t3, xxguln jrst xxmsg xgnyi: move t4, [point 7, xxgnms] ; Issue msg for unimplemented command. movei t3, xxgnln jrst xxmsg ; Generic commands... ; FINISH. Shut down the server, but don't log out. xgfin: movei t1, "Y" ; Acknowledge packet. setzb t3, t4 ; No data. call spack ; Send the packet. nop ;[56] movei t1,xgfin2 ;[186] Where to go on a time out call timeit ;[186] Start a timer skipg t1, netjfn ;[186] Wait until the packet move t1, ttyjfn ;[186] Unless using local terminal ifmn. ptyflg ;[186] On a pseudo-terminal? move t1,ptytty ;[186] Load PTY's associated TTY DIBE% ;[186] Wait for it to swallow everything %jsErr (,) ;[186] else. ;[186] Otherwise, do it the ordinary way DOBE ;[158] gets all the way out. erjmpr .+1 ;[186] Catch and ignore error endif. ;[186] End case waiting for output done call timoff ;[186] Shut off the timer setom f$exit ;[137] Say we want to go back to command level. xgfin2: call rrslin ;[121] Put line back in interactive state. dmove t1, odelay ;[194] ;[27] Restore normal delay dmovem t1, delay ;[194] ;[27] dmove t1, otimou ;[212] ;[27] and timout interval dmovem t1, stimou ;[212] ;[27] setzm srvflg ;[27] and reset the server flag wtlog (,) ;[244] Log the FINISH. call clenup## ;[244] Close all logs. ret ; Done ; LOGOUT (or BYE) -- Shut down the server and log out. xglogo: movei t1, "Y" ; Acknowledge the command. setzb t3, t4 ; No data. call spack ; Send the packet. nop ; movei t1,xglog1 ;[186] Where to go on a time out call timeit ;[186] Start a timer skipg t1, netjfn ;[186] Wait until the packet move t1, ttyjfn ;[186] Unless using local terminal ifmn. ptyflg ;[186] On a pseudo-terminal? move t1,ptytty ;[186] Load PTY's associated TTY DIBE% ;[186] Wait for it to swallow everything %jsErr (,) ;[186] else. ;[186] Otherwise, do it the ordinary way DOBE ;[158] gets all the way out. erjmpr .+1 ;[186] Catch and ignore error endif. ;[186] End case waiting for output done call timoff ;[186] Shut off the timer xglog1: call rrslin ;[186] Restore the line for interactive use. dmove t1, odelay ;[194] Restore normal delay dmovem t1, delay ;[194] dmove t1, otimou ;[212] and timout interval dmovem t1, stimou ;[212] setzm srvflg ; and reset the server flag. wtlog (,) ;[126] Log the BYE. call clenup## ;[126] Close all logs. setom f$exit ; Just in case we can't logout, set exit flag. seto t1, ; -1 = Myself. LGOUT% ; Log me out. %jsker (,r) ; If this fails, print msg & go back. ; Command to TYPE a file. Just like sending a file, except must send "X" ; packet instead of file header. xgtype: call getarg ; Get the argument. setom xflg ; Send file with X header. ifmn. tlgjfn ;[233] Doing transaction logging? block. ;[233] Get a stack frame saveac ;[233] Save even the temporaries movem t4,tmpjfn ;[233] Save the pointer setom scrlft ;[233] Don't append the crlf! wtlog(,) ;[233] move t1, tlgjfn ;[233] Put the directory name in the log move t2,tmpjfn ;[233] Reload the pointer setzb t3,t4 ;[233] Don't know how long, stop on a NUL SOUT% ;[233] Out it goes! erjmps .+1 ;[233] Catch and suppress error setzm tmpjfn ;[233] Scrub it, not a JFN anyway dxtext (t2,< for local display >) ;[233] block. ;[233] Set up ANOTHER stack context saveac ;[233] Needs plenty registers for intersection jumps xsfm q3 ;[233] Get and store current processor flags move q4, bigsou## ;[233] Load up inter-section transfer address movei q5, .+2 ;[233] And the inter-section return adress xjrstf q3 ;[233] and take a giant step! ret ;[232] Get out of the block, restoring registers endbk. ;[232] End lexical SOUT% block endbk. ;[233] Release stack frame, restoring AC's endif. ;[233] End case transaction logging move t2, t4 ;[141] Point to filespec. jrst xrecv2 ;[141] Do like when we get an R packet. ;[58] Init-Info mechanism added as edit 58. ; ; Get an "I" parameters packet from the user, record the parameters, and send ; our own back in return. This exchange is optional, but should take place ; before any server/user transaction except file transfer, where it is required ; and always takes place via the Send-Init mechanism. ; xinfo: movem t2, pktnum ; Set the parameters we just got. call spar setzm numtry move t4, [point 8, datbuf] ;[190] Respond with ours. call rpar movei t1, "Y" move t2, pktnum call spack nop ; If they don't get it, they'll ask again... jrst xxwait ; GTSCH -- Get String Character ; ; Alternate GETCH routine for getting a character from an ASCIZ string in ; memory. Uses global STRPTR for input string. ; ; Returns: ; +1 if no more characters left in string. ; +2 always, with NEXT containing next character, -1 if no more. ; gtsch: entry gtsch ;[220] ildb t1, strptr ; Get next character. jumpe t1, gtschz ; If zero, must be done. ; Return with character like GETCH. gtschx: movem t1, next ; Put result in NEXT, as GETCH does. retskp ; Done. ; "EOF" return, like GETCH gtschz: setz t1, setom next ret ; PUTSCH ; ; Alternate PUTCH routine. Just writes the character to a string in memory. ; Call with t2/ character to write. ; putsch: entry putsch ;[220] idpb t2, strptr ; Here's the alternate PUTCH routine. retskp ; It always succeeds. ; PUTTCH ; ; Another alternate PUTCH routine. Writes the character to the terminal. ; Call like PUTCH and PUTSCH. ; puttch: entry puttch ;[220] skipn local ;[186] ;[177] But only if local. retskp ;[177] ... push p, t1 movei t1, .priou BOUT erjmp .+1 pop p, t1 retskp subttl Get Argument ; Does the following: ; ; 1) Decodes server command packet ; 2) Sets up pointers to packet ; 3) Gets first argument ; ; Returns +1 always with: ; ; t3/ Length of first argument ; t4/ pointer to first argument getarg: movei t1, putsch ; Address of alternate PUTCH routine. movem t1, dest setzm strbuf ; Clear decoding area. move t1, [strbuf,,strbuf+1] blt t1, strbz move t1, [point 7, strbuf] ; Where to put the decoded string. movem t1, strptr move t1, t4 ; Pointer to data to decode. move t2, t3 ; Length. call putbuf ; Go decode the packet. ifskp. ;[194] Worked, that's promising setzm dest ; Put PUTCH back to normal. else. ;[194] Failed somehow setzm dest ;[194] Stomp whatever's driving PUTCH kermsg (, xxwait) ;[194] endif. ;[194] move t4, [point 7, strbuf] ; Point to decoded string. ildb t3, t4 ; Get CHAR(length) of directory string. caige t3, 40 ;[128] If null, no need to convert. movei t3, 40 ;[128] This also catches funny cases. subi t3, 40 ; UNCHAR of that to make a number. ret ;[107] CWD server command (Connect to directory in DEC-20 parlance). ; ; Changes Working Directory, sends new directory name back in ACK, or else ; error packet if there's a problem. ; ; Arrive here with t4 containing pointer to argument string of form ; ; where is a single character (offset by CHAR), ; and t3 containing the length of the string. ; ;;;;;;;;;;;;;;;; ; ; Issuing the following from VENTI2:: to TOMMYT:: reliably breaks remote K20 ; ;Remote: ; ; @get H:Kermit ; @start ; *set TOPS-20 ; *server ; ;Local: ; ;rem cwd (to directory) "ps:" "" ;rem dir "*.directory.0" ;rem cwd "venti:" "" ; ; Trying to connect to an unmounted structure breaks this with: ; KERMIT (1): HALT: Illegal instruction 0 at 301144 ; ?Undefined operation code, 0:00:58.7 ; ; Also: ; ;?Pushdown overflow at 62430 ;;;;;;;;;;;;;;;; xgcwd: call getarg ; Get the first argument. jumpg t3, xgcwd2 ; If positive, go handle string. jumpe t3, xgcwd5 ; If null, go connect back to own directory. kermsg (,xxwait) ; Negative length??? ; Set up argument block for ACCES xgcwd2: move q1, t4 ; Byte pointer to directory string. adjbp t3, t4 ; Now point to password. ildb t4, t3 ; Get its length. move q2, t3 ; Put pointer in ACCES arg block. subi t4, 40 ; UNCHAR to make it a number. skipge t4 ; Normal kind of number? setz t4, ; No, must have fallen off end, so no pswd. setz t2, ; Zero the length to make directory asciz. dpb t2, t3 ; ... adjbp t4, t3 ; Make sure password is asciz. idpb t2, t4 ;[255] See if the belief is that Tops-20 is really Unix, Windows, DOS or OS/2 ... block. ;[255] Enter block context for better control flow move t2, q1 ;[255] Pick up the pointer ildb t1, t2 ;[255] Pick up first byte (might not be on a word) caie t1, "." ;[255] First part of talisman? ret ;[255] No, so go do it the old fashioned way ildb t1, t2 ;[255] Pick up second byte caie t1, "." ;[255] Second part of talisman? ret ;[255] No, so some kind of gubbish ... ildb t1, t2 ;[255] Pick up third byte jumpe t1, RSKP ;[255] Should be end of string endbk. ;[255] Close out control block ifskp. ;[255] Was it ".."? jrst xgcdup ;[255] Go pretend we got a CDUP endif. ;[255] Otherwise, proceed 'normally' ;[193] Check to see what we might be connecting to xgcwd3: movx t1, rc%emo ;[193] Exact match only move t2, q1 ;[193] Load pointer to the string that got sent setz t3, ;[193] Not doing any directory stepping RCDIR% ;[193] See if it exists ifje. r ;[193] Catch and ignore error move t4, t1 ;[249] May be of interest to debuggers block. ;[249] Enter block context for ease of flow GJINF% ;[249] Get our connected directory erjmpr r ;[249] Should be impossible, BUT ... hrroi t1, cwdbuf ;[249] Write current connected directory here remark t2, ;[249] Now has current connected directory DIRST% ;[249] Turn into a string erjmpr r ;[249] If didn't work, can't do relative ldb t4, t1 ;[249] Load closing punctuation movx t3, "." ;[249] Load the subdirectory punctuation dpb t3, t1 ;[249] Overwrite closing punctuation move t2, q1 ;[249] Load pointer to possible relative directory do. ;[249] Enter loop context ildb t3, t2 ;[249] Pick up a byte from source (the packet) jumpe t3, endlp. ;[249] If NUL, we're done idpb t3, t1 ;[249] Append it to punctuated directory loop. ;[249] Get some more bytes enddo. ;[249] Exit loop lexical context idpb t4, t1 ;[249] Append closing punctuation idpb t3, t1 ;[249] Tie off the string movx t1, rc%emo ;[249] Exact match only hrroi t2, cwdbuf ;[249] Load pointer to new candidate setz t3, ;[249] Not doing any directory stepping RCDIR% ;[249] See if that exists erjmpr r ;[249] No luck... retskp ;[249] Won something endbk. ;[249] End block context ifskp. ;[249] Successful recovery remark ;[249] Nothing special to do, carry on else. ;[249] Otherwise, wasn't a valid relative directory move t3, t1 ;[249] Save any other error movx t1, rc%nom ;[193] On any failure, say no match endif. ;[249] End of absolute RCDIR% recovery attempt endif. ;[193] End RCDIR% error handling ifxe. t1, rc%nom ;[249] If no match is off, then directory exists movem t3, q1 ;[249] Stomp in resolved directory number jrst xgcwd4 ;[249] Carry on and connect endif. ;[249] End case successful match move t1, q1 ;[193] Load pointer to the string that got sent STDEV% ;[193] Translate to a device %jsker (,xxwait) ;[193] Ship error message back in an error packet. move t1, t2 ;[193] Load the device designator DVCHR% ;[193] Get its characteristics %jsker (,xxwait) ;[193] STDEV% just handed it to us... ldb t3, [pointr t2, dv%typ] ;[193] Pick up the device type cain t3, .dvnul ;[193] Want's to do absolutely nothing? jrst xgcwdz ;[193] Fine, then don't do anything dmove t1, [ .fhslf ;[193] Get ready to complain about ourself RCDIX3 ] ;[193] Force "Invalid structure name" SETER% ;[193] Set last error for this process erjmpr .+1 ;[193] Catch and ignore error %erker (,xxwait) ;[193] Go blat and leave ; Access the directory. ** Maybe should also mount structure if necessary? xgcwd4: move t1, [ac%con!<3>] ; Function is Connect, arg block has 2 words. movei t2, q1 ; Address of argument block. seto q3, ; Own job. ACCES %jsker (,xxwait) ; Send any error message in error packet. jrst xgcwdz ; Done connecting, go send ACK. ;...XGCWD, cont'd ; Come here to connect to own directory. xgcwd5: move q1, .jilno+jobtab ;[220] Logged-in directory number. setz q2, ; No password needed seto q3, ; Own job. movei t2, q1 ; Address of arg block. move t1, [ac%con!<3>] ; Function is connect. ACCES ; Connect to own directory. %jsker (,xxwait) ;... ;...XGCWD, cont'd ; Done, send back ACK with directory string in it. xgcwdz: GJINF move t1, [point 7, strbuf] movem t1, strptr DIRST %jsker (,xxwait) movei t1, gtsch ; Indicate routine to be used for getting movem t1, source ; characters. setom next ; Set initial condition. move t1, maxdat ; Get a buffer full of data. call getbuf ; ... jumpn t1, xxwait ; setzm source ; Put GETCH back to normal. move t3, t1 ; Length movei t1, "Y" ; Y for Yes (ACK) setz t2, ; Packet number 0. move t4, [point 8, datbuf] ;[190] Point to string built by getbuf. call spack ; Send the ACK. nop ; Nothing much we can do here... jrst xxwait ; Done. ;[56] Disk USAGE server query added in edit 56. ; ; Assumes reply will fit in data field of ACK packet; does not use ; text header ("X") protocol. Sends as much of reply as will fit. ; xgdisk: seto t1, ; Get disk usage of connected directory. GTDAL% %jsker ,r dmove q1, t1 ; Save the numbers in q1,q2. move t1, [point 7, strbuf] ;[188] String pointer to data field. movem t1, strptr ;[103] smsg () ;[188] Inital part of response move t2, q1 ; Quota, or "+Inf" caige t2, [^d100000000] ;[194] Big? ifskp. ;[194] Yep, really big smsg (<+Inf>) ;[194] So say that differently else. ;[194] Otherwise, comprehensible limit movei t3, ^d10 ; in decimal NOUT% erjmps xgdis2 ;[194] Catch and suppress errpr endif. ;[194] smsg (<, used: >) ;[194] How much we're using of it move t2, q2 ; Pages used, movei t3, ^d10 ; in decimal NOUT% erjmps xgdis2 ;[194] Catch and suppress error smsg (< (pages)>) ; Specify units xgdis2: move t2, strptr ;[103] Check length exch t1, t2 call subbp kermsg (,r) ;[188] setz t4, ;[188] Cons up a .CHNUL idpb t4, t2 ; Done constructing string, make it asciz move q1, spsiz ; Is the string bigger than max size to send? subi q1, 5 caig q1, (t3) ; (it should always fit). move t3, q1 ; Yes, so cut it off at the limit. ;.. ;...XGDISK, cont'd ;[103] Begin Change: Use standard packet filling technique to send this. movei t1, gtsch ; Indicate routine to be used for getting movem t1, source ; characters. setom next ; Set initial condition. move t1, maxdat ; Get a buffer full of data. call getbuf ; ... jumpn t1, xxwait ; move t3, t1 ; Set up length. setzm source ; Put GETCH back to normal. ;[103] End Change. Now send the packet. xgdisz: movei t1, "Y" ; Formulate the ACK setz t2, ; (Packet number should be 0, right?) move t4, [point 8, datbuf] ;[190] The data itself call spack ; Send it off. nop ;* What if it fails? jrst xxwait ; ;[254] CDUP connects to upper (or superior) directory, responds like PWD ; ; N.B., For Unix fans and Windows heros, be aware that the so-called ; working directory is NOT the same thing on Tops-20! It is the ; connected directory, which changes your access rights to that ; directory and possible group memberships. A connected directory ; is also job wide, not process wide. ; ; Uses xgpwd for response xgcdup: saveac ; Need some local fast scratch GJINF% ; Get current job information. %jsker ,r move q4, t2 ; Save currently connected directory move q2, [point 7,dirbuf] ;Hardware pointer to directory buffer move t1, q2 ; Copy for local usage remark t2, ; Already has the connected directory DIRST% ; Translate into a string %jsker ,r move t1, q2 ; Copy for local usage setz t3, ; Last dot we saw do. ; Enter loop context ildb t2, t1 ; Pick up a byte jumpe t2, endlp. ; Stop if off the end of the string (wierd...) cain t2, .chrpt ; At end of directory specification? exit. ; Yes, so done with the loop cain t2, "." ; Hit a dot?? move t3, t1 ; Yes, remember pointer to the last one seen loop. ; Grovel to the end of the string enddo. ; Exit loop context jumpe t3, xgpwd ; If never saw a dot, nothing to do dmove t1, [exp .chrpt,0] ;Load closing punctuation dpb t1, t3 ; Stomp the dot with closing punctuation idpb t2, t3 ; Close off the string ; Convert our masterpiece to internal format movx t1, rc%emo ; Must match this and only this directory move t2, q2 ; Load pointer to munged directory setz t3, ; Not doing any stepping RCDIR% ; See if we can recognize it ifxn. t1, rc%nom!rc%amb!rc%nmd %erker (,r) endif. ; End case couldn't find it move q3, t3 ; Store the directory number, just in case movx t1, ac%con!3 ; Doing a connect, block is three words long movei t2, t3 ; Argument block begins in AC3 dmove t4, [ exp 0, -1 ] ; No password, this job ACCES% ; Try the connect %jsker (,r) call udjinf ; Update currently connected directory callret xgpwd ; Respond exactly like xgpwd ;[254] End Code Insertion ; ;[188] PWD server query; prints working directory. ; ; Assumes reply will fit in data field of ACK packet; does not use ; text header ("X") protocol. Sends as much of reply as will fit. ; ; N.B., For Unix fans and Windows heros, be aware that the so-called ; working directory is NOT the same thing on Tops-20! It is the ; connected directory, which changes your access rights to that ; directory and possible group memberships. A connected directory ; is also job wide, not process wide. ; ; Looks remarkably like xgdisk... xgpwd: GJINF% ; Get current job information. %jsker ,r move t1, [point 7, strbuf] ; String pointer to data field. movem t1, strptr ; Also for packetizer remark t2, ; Already has the connected directory DIRST% ; Translate into a string %jsker ,r remark ^D<6+1+1+39+1=48> ;Maximum directory string length move t2, strptr ; Check the length in case of 'micropacket' exch t1, t2 ; Beginning pointer in t1, final in t2 call subbp ; Subtract to get length kermsg (,r) ;Really unlikely, see above setz t4, ; Cons up a .CHNUL idpb t4, t2 ; Tie off the string move q1, spsiz ; Is the string bigger than max size to send? subi q1, 5 caig q1, (t3) ; (it should always fit). move t3, q1 ; Yes, so cut it off at the limit. movei t1, gtsch ; Indicate routine to be used for getting movem t1, source ; characters. setom next ; Set initial condition. move t1, maxdat ; Get a buffer full of data. call getbuf ; ... jumpn t1, xxwait ; move t3, t1 ; Set up length. setzm source ; Put GETCH back to normal. ; Now send the packet. movei t1, "Y" ; Formulate the ACK setz t2, ; (Packet number should be 0, right?) move t4, [point 8, datbuf] ;[190] The data itself call spack ; Send it off. nop ;* What if it fails? jrst xxwait ;[188] End Code Insertion ; Define 30 bit one word global ASCII pointer to another section extern hlpntr ;[194] One word global ASCII pointer extern srvhlp ;[194] In k20hlp in section one xhlptr==hlpntr!srvhlp ;[194] Forces LINK to do a polish fix up xgstat:ifmn. tlgjfn ;[233] Doing transaction logging? block. ;[233] Get a stack frame saveac ;[233] Save even the temporaries setom scrlft ;[233] Suppress the trailing carriage return wtlog(,) ;[233] endbk. ;[233] Release stack frame, restoring AC's endif. ;[233] call $srvt ;[189] Build the text in a buffer setz t2, ;[189] Cons up a .chnul idpb t2,t1 ;[189] Tied off the 'string' idpb t2,t1 ;[189] Tie it off some more ... move t1,[point 7,statxt];[233] Load pointer to constructed text jrst xghel1 ;[233] Join common code xghelp: ifmn. tlgjfn ;[233] Doing transaction logging? block. ;[233] Get a stack frame saveac ;[233] Save even the temporaries setom scrlft ;[233] Suppress the trailing carriage return wtlog(,) ;[233] endbk. ;[233] Release stack frame, restoring AC's endif. ;[233] move t1, [ xhlptr ] ;[194] Load pointer to general remote help text xghel1: remark ;[233] Common link movem t1, strptr ; Put pointer here, where movei t1, gtsch ; routine for getting chars from a string movem t1, source ; can find it. setom next ; Init char lookahead setom xflg ; Send with X rather than F header. call $sends ; Go send the text like a file nop setzm source ;[121] Put send source back to normal. jrst xxwait ;[116] DIRECTORY server command. ; DIRCH ; ; Alternate GETCH routine for getting characters from a directory listing ; in a memory buffer, and for refilling the buffer when it gets empty. ; dirch: entry dirch ;[186] ildb t1, getptr ; Get character. skipe t1 ; Null? jrst dirchx ; No, return the character. ; No characters in buffer, try to refill. dirch2: call dmpbuf ; If so, reset the buffer pointers, etc. call dirlst ; And try to fill the listing buffer again. jumpe t1, dirchz ; No more, done. move t1, [point 7, srvbuf] ; Get new listing buffer pointer. movem t1, getptr ; Save it for getting characters. ildb t1, getptr ; Get first character of new buffer. jumpe t1, dirchz ; This shouldn't happen... ; Return with character like GETCH. dirchx: movem t1, next retskp ; "EOF" return, like GETCH. dirchz: setz t1, setom next ret subttl XGDIR - Server provides directory listing. sdirb2: gj%old!gj%ifg!.gjall ;[191] Flags,,All generations. .nulio,,.nulio ;[191] No i/o. repeat <^d8>,<0> ;[191] No defaults; nothing ;[190] Prologue rewritten to not store in (write-protected!) code .psect xgdir: call getarg ; Get the first (& only) argument jumpg t3, xgdir2 ; Got something, go do it. ife. t3 ;[190] Got nothing, default the directory anstkv(t4,^d4) ;[190] Create an anonymous stkvar dmove t1,[ exp ascii "*.*.*", 0 ] ;[190] Load default file spec dmovem t1,0(t4) ;[190] Stomp into buffer setzb t1,t2 ;[190] Cons up ten .CHNUL's dmovem t1,2(t4) ;[190] Stomp rest of buffer movei t3,^d5 ;[190] Five characters long hrli t4,(point 7,) ;[190] Now have an ASCII pointer jrst xgdir2 ;[190] Go get a file specification endif. ;[190] End case defaulting directory kermsg (,xxwait) ; Got junk. ; Get JFN on the string we got, supply normal defaults like Exec does. xgdir2: move t2, t4 ; Point to filespec adjbp t3, t4 ; Make it asciz setz t4, idpb t4, t3 move t4, t2 ;[191] Save the string pointer movei t1, sdirbk ; JFN block containing flags & defaults. GTJFN ; Do long form GTJFN. ifje. r ;[191] Catch error caie t1, GJFX32 ;[191] No files matched? %erker (,xxwait) ;[191] No, just send the error movei t1, sdirb2 ;[191] Try not defaulting anything move t2, t4 ;[191] Restore the string pointer GTJFN% ;[191] Attempt another long form GTJFN. %jsker (,xxwait) ;[191] No such luck, just give up endif. ;[191] End GTJFN% recovery call isnulj ;[191] Gave us NUL:? nop ;[191] Didn't, that's fine. remark t1, .nulio ;[191] Did, that's fine, too. ifmn. tlgjfn ;[233] Doing transaction logging? block. ;[233] Get a stack frame saveac ;[233] Save even the temporaries hrrzm t1,tmpjfn ;[233] Give it how %wtlog wants it .. setom scrlft ;[233] Suppress the trailing carriage return wtlog(,tmpjfn) ;[233] Sigh... setzm tmpjfn ;[233] Stomp it, done. endbk. ;[233] Release stack frame, restoring AC's endif. ;[233] move t2, t1 ; Construct heading in string buffer. setzm ffunc ; Function is "directory". call dirhdr move t1, [point 7, srvbuf] ; Point to beginning of text buffer. movem t1, getptr ; This is where we'll get characters from. movei t1, dirch ; And this routine will do the getting. movem t1, source ; ... setom next ; Initialize character lookahead. setom xflg ; This produces some desired effects... call $sends ; Go send the listing like it's a file. nop ; Ignore any skipping... jrst xxwait sdirbk: gj%old!gj%ifg!.gjall ; Flags,,All generations. .nulio,,.nulio ; No i/o. repeat <2>,<0> ; Default device and directory. repeat <2>,)> ;Default name is "*.*" repeat <4>,<0> ; Nothing special for the rest. subttl XGDEL - Server provides file deletion [118] sdelbk: gj%old!gj%ifg!.gjall ; Flags,,All generations. .nulio,,.nulio ; No i/o. repeat <^d8>,<0> ; No other defaults. xgdel: call getarg ; Get the first (& only) argument jumpg t3, xgdel2 ; Got something, go do it. kermsg (,xxwait) ; Get JFN on the string we got, supply normal defaults like Exec does. xgdel2: move t2, t4 ; Point to filespec adjbp t3, t4 ; Make it asciz setz t4, idpb t4, t3 movei t1, sdelbk ; JFN block containing flags & defaults. GTJFN ; Do long form GTJFN. %jsker (,xxwait) ; Send error packet if we can't. call isnulj ;[191] Gave us NUL: nop ;[191] Didn't, that's fine. ifmn. tlgjfn ;[233] Doing transaction logging? block. ;[233] Get a stack frame saveac ;[233] Save even the temporaries hrrzm t1,tmpjfn ;[233] Give it how %wtlog wants it .. setom scrlft ;[233] Suppress the trailing carriage return wtlog(,tmpjfn) ;[233] Sigh... setzm tmpjfn ;[233] Stomp it, done. endbk. ;[233] Release stack frame, restoring AC's endif. ;[233] remark t1, .nulio ;[191] Is, that's fine, too. move t2, t1 ; Construct heading in string buffer. movei t1, delfil ;[194] ; Routine for deleting a file. movem t1, ffunc ; Make it the file function. call dirhdr ; Start things off. move t1, [point 7, srvbuf] ; Point to beginning of text buffer. movem t1, getptr ; This is where we'll get characters from. movei t1, dirch ; And this routine will do the getting. movem t1, source ; ... setom next ; Initialize character lookahead. setom xflg ; This produces some desired effects... call $sends ; Go send the listing like it's a file. nop ; Ignore any skipping... jrst xxwait subttl LOCAL RUN command parsing ; JFN block for RUN command. chgsec(code,const) ;;Tables and chained fdb's go in const runbk: gj%old!gj%ifg!gj%flg ; Flag bits,,most recent generation. .priin,,.priou ; COMND i/o. repeat 3,<0> ; No defaults, except cascii() ; file type. repeat 2,<0> ; No defaults, except runbkl==<.-runbk> ; Length of this GTJFN argument block. yrufdb: flddb. .cmfil yrrfdb: flddb. .cmfil,,,,,yrrfd1 yrrfd1: flddb. .cmcfm,,,,, retsec cleans() ; Parse local RUN command. .yrun: entry .yrun ; Can be invoked as top-level by k20par movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. CLZFF guide ; Issue guide word. move t1, [runbk,,cjfnbk] ; Insert our file parsing defaults. blt t1, cjfnbk+runbkl ; Same as for DELETE. movei t1, yrufdb skipe rufork ; Already have a fork? movei t1, yrrfdb ; Yes, let them rerun it. call rfield ; Parse an existing file specification. ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. caie t3, .cmcfm ;[194] Confirmation? ifskp. ;[194] It is setom pars3 ; Yes, set "jfn" to -1. ret endif. ;[194] saveac ;[220] Will need some extra registers hrrz q1, t2 ;[220] Save the JFN hllz q2, t2 ;[220] Save the flags hrrz t1, t2 ;[220] Load the JFN without the flags call isdird ;[220] Only run files from structures ifskp. ;[220] It is dmove q3, t1 ;[220] Save device information confrm ; Get confirmation ldb t3,[pointr(t2,dv%typ)] ;[220] Pick up device type cain t3, .dvnul ;[220] NUL:? movei q1, .nulio ;[220] Yes, JFN has already been tossed movem q1, pars3 ;[220] Save some kind of JFN dmovem q3, pars4 ;[220] Also device information, if useful ret ;[220] Done endif. ;[220] ;[220] Otherwise, start whining emsg movei t1, .priou ;[220] Contine on terminal move t2, q1 ;[220] Load the JFN, no flags setzb t3, t4 ;[220] Standard formating, no goofy prefix JFNS% ;[220] Type it %jserr(,) ;[220] Odd, but carry on move t1, q1 ;[220] Get the JFN RLJFN% ;[220] Toss it %jserr(,) ;[220] Odd, but carry on callret cmder1 ;[220] Allow a reparse (^H) subttl LOCAL RUN command executon ; Execute local RUN command. ;[220] Begin code insertion chgsec(code,const) ; Code to run from registers nulprg: remark ; Pretend we did a GET% into just the AC's phase 0 ; Runs in accumulators LSTRX1 ;ac0 No last error 0 ;t1 Argument to PSOUT% 0 ;t2 Argument to SETER% nulent: RESET% ;t3 Reset the world erjmpr nulend ;t4 It *CAN* fail, actually.. movei t1,.fhslf ;q1 This process move t2, f ;q2 No last error (RESET% leaves it in an odd way) SETER% ;q3 Set it erjmpr nulend ;p1 Or not hrroi t1,nulmsg ;p2 Load Tops-20 pointer to text message PSOUT% ;p3 Type it erjmpr nulend ;p4 Or not nulend: HALTF% ;p5 Stop jrst nulent ;p6 Or do it again nulmsg: BYTE (7) "N","U","L",":",.chspc ;cx BYTE (7) "O","K",.chcrt,.chlfd,.chnul ;p dephase ; Done with our little NUL: program retsec ; Restore .psect's ;[220] End code insertion $yrun: entry $yrun ;[194] skipg pars3 ; Re-run current fork? jrst $yrun2 ; Yes, do do that. skiple t1, rufork ; No, do we have a current fork to kill? KFORK ; Yes, try to kill it. %jserr (,r) ;[194] setzb t1, t2 ; Take care of capabilities below. CFORK ; Make a fork. %jserr (,r); movem t1, rufork ; Remember the fork handle. move t4, t1 ;[220] Keep the handle handy skipn t2, capas ;[169] Get our capabilities. move t2, mycaps+1 ;[187] Use start up enabled caps, instead andx t2,badmsk ;[186] Don't turn on unsafe bits txz t2, sc%log ;[169] Do not allow inferior to log us out txo t2, sc%gtb ;[169] but with GETAB capability (for Exec), move t3, t2 ;[169] Enable what we've set EPCAP ;[169] ... erjmps .+1 ;[194] ... hrlzs t1 ; Move handle into left half. hrr t1, pars3 ; JFN in right half. hrrz t3, t1 ;[220] Save a copy of the JFN setz t2, ;[220] Nothing special. caie t3, .nulio ;[220] NUL:? ifskp. ;[220] Just give up here move t1, t4 ;[220] Inferior fork handle movei t2, nulprg ;[220] NUL: program SFACS% ;[220] Set the registers %jserr (,r) ;[220] ?? move t2, [1,,nulent] ;[220] Load NUL:'s 'start address' SEVEC% ;[220] Set the entry vector setob t2, t3 ;[220] Don't fault in PA1050 SCVEC% ;[220] Shut off UUO simulation %jserr (,) ;[220] Odd, but continue remark ;[220] Fall through to $yrun2 else. ;[220] Otherwise, it's a real file GET ; Get the file to run. %jserr (,r) hrrz t1, pars3 ; Got the file, now can release its JFN. RLJFN erjmpr .+1 ;[220] Catch and ignore error endif. ;[220] ; Can come straight here to re-run current fork. $yrun2: skipg t1, rufork ; Get fork handle. ermsg% (,r) ; Make sure it's ok. setz t2, ; Primary start address. SFRKV ; Start it up. %jserr (,r) WFORK ; wait for the fork to halt. %jserr (,r) ret subttl SRVCMD - Routine to send a command to a server. ; ; Call with: ; ; t1/ Byte pointer to string. ; First character is Generic Command, subsequent chars are arguments. ; t2/ Packet type, e.g. "G" for Generic, "C" for Host Command. ; ; Returns: ; ; +1 if reply was not received successfully. ; +2 If we got a good response, with ; t1/ packet type of response, "Y", "X", or "S". ; PKTACS/ Block of 4 words containing the data returned by RPACK. ; ; If packet was ACK containing data, this routine prints it. srvcmd: skipe takdep ;[176] Allow commands to servers from TAKE file jrst srvxx srvxx: saveac ; Preserve these work registers. dmove q1, t1 ; Copy arguments into them. skipn local ;[177] Local Kermit? call inilin ;[177] No, set TTY: up for packets. setzm numtry ; Reset retry counter. setzm nnak ; Init some statistics counters setzm ntimou ; ... setom bctone ; Force 1-char checksum. call clrbuf ;[194] Clear out any stacked-up NAKs nop ;[186] Ignore any errors call statim ; Start timing (so k20pdc works) call ccon ; Let them ^C out gracefully jrst srvcmx ; and go here if they do. call setlog ; Set up any debugging log. nop ; Put the command into the data field of the packet, using the normal ; packet-filling technique, prefixing, etc. setzm datbuf ;[190] ; Zero the buffer. srvcma: movei t1, gtsch ; Indicate routine to be used for getting movem t1, source ; characters. movem q1, strptr ; And where it should get them from. setom next ; Set initial condition. move t1, maxdat ; Get a buffer full of data. call getbuf ; ... jumpn t1, srvcmx ; Clean up if this fails. setzm source ; Got it, so put GETCH back to normal. movem t1, gclen ; Save length. jumpn t1, srvcm2 ; Proceed if we got any. ermsg% (, srvcmx) ; Do this otherwise. ; Top of try-again loop. srvcm2: move q1, numtry ; Too many tries? caml q1, maxtry ermsg% (,srvcmx) aos numtry ; Not too many, count this try. move t1, q2 ; Packet type. setz t2, ; Make the packet number zero. move t3, gclen ; Length of data. move t4, [point 8, datbuf] ;[190] Point to data buffer. call spack ; Send it off. jrst @[exp srvcm2, srvcmx](t1) ; Handle nonfatal & fatal failures. setzm gotx ; Assume it'll be an ACK. call rpack ; Look for response. ermsg% (,srvcm2) caie t1, "X" ; X or Y? cain t1, "Y" jrst srvcmz ; Good. caie t1, "S" ; S or I? cain t1, "I" jrst srvcmz ; That's ok too. caie t1, "E" ; Error packet? ifskp. ;[186] Yes, let's see about squawking skipn local ;[186] Local? jrst srvcmx ;[186] No, this will always mess up emsg ;[186] Yes, print it. move t1, t4 ; Get pointer to it, PSOUT% ; and print it. jrst srvcmx ;[70] endif. ;[186] End error pack caie t1, "N" ; NAK? cain t1, "T" ; Or Timeout? jrst srvcm2 ; One of those, go try again. skipn local ;[233] Local? jrst srvcmx ;[235] Nothing to display on remark ;[235] Tell us the offending packet and punt move t2,t1 ;[235] Save the offending character hrroi t1,[ asciz /Invalid response from server: '/] ;[235] ESOUT% ;[235] Begin blat erjmpr .+1 ;[235] Catch and ignore any error move t1,t2 ;[235] Get the character back PBOUT% ;[235] Type it erjmpr .+1 ;[235] Catch and ignore any error hrroi t1,[asciz /' (/] ;[235] And seperate the rest PSOUT% ;[235] Type that erjmpr .+1 ;[235] Catch and ignore any error movei t1,.priou ;[235] Still going to primary output movei t3,^d8 ;[235] ASCII characters are base 8 here NOUT% ;[235] Type it erjmpr .+1 ;[235] Catch and ignore any error hrroi t1,[asciz /) /] ;[235] Close off the line PSOUT% ;[235] Type that erjmpr .+1 ;[235] Catch and ignore any error remark srvcmx ;[235] Falls through ; Exit point for any kind of error, failure, or interruption srvcmx: call ccoff ; Turn off ^C trap. call caxzof ; Turn these interrupts off too. call endtim ;[189] Stop timing call elptim ;[189] Compute elapsed time skipg t1, filjfn ;[193] Any file left open? ifskp. ;[193] Apparently, try to close it. tlz t1,-1 ;[193] Ditch any flags caie t1, .nulio ;[193] No need to close since never opened CLOSF erjmpr .+1 ;[193] Catch and ignore error setzm filjfn ;[193] Whatever it was, it's closed now! endif. ;[193](end) skipn local ;[177] Put controlling TTY back to normal call rrsl2 ;[177] ... (entry point to reslin) setzm source ; Put things back to normal. seto t1, ; Indicate no good response was received. ret ; Return +1. ; Exit here when response received successfully. srvcmz: dmovem t1, pktacs ;[112] Save the ACs returned in RPACK dmovem t3, pktacs+2 ;[112] ... movem t2, pktnum ; Synchronize packet numbers. caie t1, "Y" ;[194] Was the reply an ACK? ifskp. ;[194] It was skipg t2, t3 ;[144] Yes, any characters? anskp. ;[194] No. movei t1, puttch ;[144] Routine to display decoded characters. movem t1, dest ;[144] ... move t1, t4 ;[144] Pointer to data buffer. call putbuf ;[144] Go decode it. nop ;[144] setzm dest ;[144] endif. ;[194] move t1, pktacs ;[112] Get packet type back. call ccoff ; Turn off ^C trap. skipn local ;[177] Put controlling TTY back to normal call rrsl2 ;[177] ... (entry point to reslin) retskp ; Done. subttl SINFO Sends Iniatialization Packet ;[58] SINFO added as part of edit 58. ; ; Call this routine before sending any server command which has a ; nontrivial response. For instance, it should be called before ; requesting a remote directory listing, but need not be called before ; sending a CWD command, which normally responds with a simple ACK. ; ; Action: Sends an info packet with our own parameters, waits for ; ACK with other side's. Uses packet number 0, does not increment the ; packet number. If other side doesn't know about I packets, this ; routine returns as if a an ACK was received containing all default ; values. ; ; Returns: ; +1 on failure, maximum tries exceeded. ; +2 on "success" getting a reply, even if it was an error packet, ; with other sides parameters set. sinfo: entry sinfo saveac ;[128] Save these. setzm numtry ; Give it a try, setzm pktnum ; starting out with a clean slate. setom bctone ;[98] Use 1-char checksum. call clrbuf ;[194] Clear out any piled up NAKs. nop ;[186] Ignore any errors call setlog ; Set up any debugging log. nop movei state, "S" ;[133] This will be a little state switcher. sinfo2: movei t1, "I" ;[100][133] Packet type. setom iflg ;[100] Say we're doing I, not S. call sinit ;[100] Let SINIT send it & get reply. caie t1, "E" ;[194] Other side doesn't know I packet? ifskp. ;[194] Strangely, no setzb t3, t4 ;[133] Then set defaults this way. call spar ;[133] Sets our parameters jrst sinfoz ;[133] And return successfully. endif. ;[194] ;[133] Keep going if it doesn't get thru the first time. cain state, "F" ; Switched into F state? jrst sinfoz ; Yes, so I was ACK'd, done. cain state, "S" ; Still in S state? jrst sinfo2 ; So go round again. sinfox: setzm iflg ; Must have exceeded retry limit. ret ; Fail. sinfoz: setzm iflg ;[100] Done with sending I packet. retskp subttl SRVFIL ; ; Common code to construct a generic one-field command. ; Generic command is single character in t4. Argument is in ATMBUF. ; Puts a 1-character length field at the beginning. ; srvfil: call sinfo ;[128] Exchange parameters with I packet. ret ;[133] Failed, give up. setzm srvbuf ;[194] Zero out old stuff move t1, [srvbuf,,srvbuf+1] ;[194] The whole buffer blt t1, srvbzz ;[194] Not just two words ... dmove t1, [ point 7, atmbuf ;[194] Copy directory name from here point 7, strbuf ] ;[194] to there idpb t4, t2 ; Deposit generic command. ibp t2 ; Leave a space setz t3, ; Initialize counter do. ;[194] Enter loop context ildb t4, t1 ; Get next one. idpb t4, t2 ; Deposit this one. jumpe t4, endlp. ;[194] Stop on a .chnul aoja t3, top. ;[194] Otherwise, count it & loop. enddo. ;[194] Exit loop context ;* jumpe t3, [ ; Make sure there was at least one character. ;* txmsg ;* ret ] srvfi3: move t1, t3 ; Length addi t1, 40 ; CHAR of that. move t2, [point 7, strbuf, 13] ; Deposit count at head of field. dpb t1, t2 move t1, [point 7, strbuf] ; Point to generic command. movei t2, "G" ; Packet type is G. jrst dosrv ; Go do it. subttl DOSRV - Wrapper for SRVCMD ; Call this exactly like SRVCMD. ; ; Send a command to a server and dispatch appropriately depending on the reply. ; dosrv: entry dosrv ;[220] setzm gotx ; Clear flags: "got X packet", setzm gots ; "got S packet". call srvcmd ; Send a generic command. ret ; Didn't get good response. cain t1, "Y" ; Was it an ACK? ret ; Yes, so we're done. ; Come here if we're about to receive a multipacket reply. caie t1, "X" ; Text header? jrst dosrv3 ; No setom gotx ; Yup, flag that we already got it. movei state, "F" ; State state to file receive. skipn t3 ;[173](begin) Any contents? jrst $recvb ; No. remark ;[220] Squeeze out leading and trailing CRLF's block. ;[220] Yes, create a frame to print them saveac ;[220] Save in flight temporaries (particularly t1) move t4, pktacs+3 ;[220] Load pointer text move t3, t4 ;[220] Keep a copy handy ildb t1, t4 ;[220] Pick up a character caie t1, .chcrt ;[220] A carriage return? ifskp. ;[220] It is, let's see if followed by a line feed ildb t1, t4 ;[220] Pick up another character caie t1, .chlfd ;[220] A line feed?? anskp. ;[220] No, so must advance the carriage remark ;[220] Fall out and skip the crlf else. ;[220] Need to get to a clean line hrroi t1, crlf PSOUT% erjmpr r ;[220] If fails, break out of the block, +1 endif. ;[220] Either way, ready to see something move t1, t3 ;[220] Load original pointer PSOUT% ;[220] Type whatever we got handed erjmpr r ;[220] Or not... movni t4, -2 ;[220] Done printing, so back the adjbp t4, t1 ;[220] pointer up so we can have a look ildb t1, t4 ;[220] Pick up a character caie t1, .chcrt ;[220] A carriage return? ifskp. ;[220] It is, let's see if followed by a line feed ildb t1, t4 ;[220] Pick up another character caie t1, .chlfd ;[220] A line feed?? anskp. ;[220] No, so must advance the carriage remark ;[220] Fall out and skip the crlf else. ;[220] Need to get to a clean line hrroi t1, crlf PSOUT% erjmpr r ;[220] If fails, break out of the block, +1 endif. ;[220] Either way, ready to see something remark ;[220] Fall out of the block endbk. ;[220] End block context jrst $recvb ; Go receive whatever is coming. dosrv3: caie t1, "S" ;[194] Or Send-Init? ifskp. ;[194] Got it setom gots ; Yes, flag that we already got it. movei state, "R" ; Set state to receive init. jrst $recvb ; Go receive what's coming. endif. ;[194] ermsg% (,r) subttl Is this a directory device? ;[193] Begin code insertion ; ; Call: ; ; t1/ JFN to test, NO FLAGS! ; ; Returns: ; ; +1, Not a directory based device ; N.B., t1 and t2 may be invalid if DVCHR% failed! ; ; +2, Something we can use as a directory ; ; t1/ device designator ; t2/ device characteristics word ; ; All other accumulators are preserved ; ; NUL: and .nulio directories are expected to be simulated by calling routine isdird: entry isdird ; Called by k20par and maybe k20dsp call isnulj ; Is this some kind of NUL: or .nulio? ifskp. ; It is, so just say yes dmove t1, [ .dvdes!.dvnul,,-1 ; NUL: has no units dv%out!dv%in!dv%av!fld(.dvnul,dv%typ)!dv%psd!fld(-1,dv%mod) ] retskp ; Insist that it is a directory device endif. ; Done with the easy case ; Have to do some work... saveac ; Don't touch the other accumulators DVCHR% ; Get device characteristics ifje. r ; Fail and retrieve error move t4, t1 ; Store the error setob t1, t2 ; Cons up some real junk setz t3, ; This value should never happen else. ; Otherwise, worked setz t4, ; Flag that DVCHR% worked endif. ; End case DVCHR% failure recovery ; Finally pick up the device type ldb t3,[pointr(t2,dv%typ)] cain t3, .dvnul ; NUL:? retskp ; Can always delete or list that (simulated) cain t3, .dvdsk ; Structure? retskp ; Yes, that has directories and files cain t3, .dvdta ; Eh? DECtape?? retskp ; Who put that back in? ; None of the above, try general case ife. t4 ; Did the DVCHR% work? txnn t2, dv%dir ; It did, so does the device have directories? anskp. ; No, so can't return true retskp ; Something new with a directory should work endif. ; Otherwise, they are out of luck ret ; Return doesn't have directories ;[194] End code insertion subttl GTNFIL - Get next file from wild file specification. ; Call: ; ; filjfn/ Current JFN, possibly one of many ; nxtjfn/ Next JFN in sequence (1-file lookahead) ; ndxjfn/ Flags associated with stepping to next specification ; ; Returns: ; ; +1 t1/ 0 (indicating no more) ; +2 t1/ JFN of next file ; ;[111] Rewritten to do 1-file lookahead as part of edit 111. ; ;[194] Partial rewrite to simulate NUL: stepping and also to always ; return zero on plus 1 return, as per specification gtnfil: entry gtnfil ; Also used by k20mit skipg t1, filjfn ;[193] Release the JFN of the previous file. ifskp. ;[193] If we have one ... tlz t1, -1 ;[252] Stomp any flags, just in case cain t1, .nulio ;[193] But!! Is this the sink? anskp. ;[193] Yes, no need to release it RLJFN erjmpr .+1 ;[193] Catch and ignore error endif. ;[193] End case releasing JFN setzm filjfn ; Check to see if we really want to or can get the next file. setz t1, ; Assume no more files. skipn czseen ;[59] If CTRL-Z seen, then get no more files. skipn t1, nxtjfn ; No CTRL-Z. Get next JFN. ret ; None, so we're done. ; Make a separate JFN for the file so that wildcard stepping won't be ; wiped out by anything we do to it, like deleting it, renaming it, etc. hrrz t2, t1 ; Get the filename string. hrroi t1, strbuf cain t2, .nulio ;[193] Data sink? ifskp. ;[193] No, do it the regular way dmove t3, allfld ;[252] dev:name.typ.gen JFNS erjmpr gtnerr ;[194] Bag the whole thing if failed movx t1, gj%old!gj%sht ;Get a new JFN on it. hrroi t2, strbuf GTJFN erjmpr gtnerr ;[194] Bag the whole thing if failed else. ;[193] Otherwise, NUL: dmove t2 , [ BYTE (7) "N","U","L",":", 0 0 ] ;[193] dmovem t2, strbuf ;[193] Put the file name into the buffer setz t4, ;[193] Keep t4 whacked like JFNS movei t1, .nulio ;[193] Load sink endif. ;[193] End special case NUL: hrrzm t1, filjfn ; Save it here, sans flags, if any setzm strbuf ; Scrub the buffer setzm strbuf+1 ; Give it a little more scrubby, just in case ; Get new next JFN. hrrz t1, nxtjfn ;[193] Get the JFN again. caie t1, .nulio ;[193] Data sink? ifskp. ;[193] Yes, so nothing to step setzm nxtjfn ;[193] So flag nothing left setzm ndxjfn ;[193] Nothing to step to remark t1, .nulio ;[193] Fall through with .nulio as JFN else. ;[193] Otherwise, have something to sep hll t1, ndxjfn ; Get wildcard flags into left half. repeat 0,< ;[252] Unnecessary now that debugging is comeplete move t2, t1 ;[252] Save the pair hrroi t1, crlf ;[252] PSOUT% ;[252] move t1, t2 ;[252] Restore the pair call jfnflg## ;[252] Show the flags txmsg <, > ;[252] Space over move t1, t2 ;[252] Restore the pair > ;repeat 0 ;[252] GNJFN ; Get the next JFN. ifje. r ;[194] Failed move t4, t1 ;[194] Save error for interested parties remark t1, ;[194] If no more, then no JFN setzb t1, ndxjfn ;[194] Nothing more to step endif. ;[193] End GNJFN% failure handling movem t1, nxtjfn ; Save result for next time. repeat 0,< ;[252] Unnecessary now that debugging is comeplete txc t1, GJ%GND!GJ%GIV ;[252] GNJFN% clears these, which is fine call jfnflg## ;[252] Show this one move t1, nxtjfn ;[252] Restore for downstream > ;repeat 0 ;[252] endif. ;[193] End .nulio special case ; Return with current JFN move t1, filjfn ; Return JFN of current file in t1. retskp ; Return +2 indicating another file was found. gtnerr: move t4, t1 ;[194] Save error for debuggers ifmn. filjfn ;[194] Any file? hrrz t1, filjfn ;[194] Load JFN, sans flags call frclos ;[194] Force it to close nop ;[194] Ignore any error setzm filjfn ;[194] Whack the remnants endif. ;[194] ifmn. nxtjfn ;[194] Any 'next' JFN left? hrrz t1, nxtjfn ;[194] Yes, load JFN, sans flags call frclos ;[194] Force it to close nop ;[194] Ignore any error setzm nxtjfn ;[194] Whack the remnants endif. ;[194] ifmn. ndxjfn ;[194] Any stepping JFN? hrrz t1, ndxjfn ;[194] Yes, load the JFN, sans flags call frclos ;[194] Force it to close nop ;[194] Ignore any error setzm ndxjfn ;[194] Nothing to step any more endif. ;[194] setz t1, ;[194] No JFN anywhere, anyhow ret ;[194] Returns plus one subttl Fetch File Information ;[200] Begin Code Insertion ; ; Call: ; ; t2/ JFN of file to get information for ; ; Returns: ; ; +1/ Failure, the below are not dependable ; +2/ Succeed, the below contain 'reasonable' values ; ; pagcnt/ Number of pages (or blocks) in the file ; bytcnt/ Count of bytes in the file and byte size ; crdate/ Creation date and time ; ; N.B., Assumes both that the above variables are contiguous ; and that they are in the above order! ; ; To Do: See if can be coupled with isdird nulfdb: fld(^d7,fb%bsz) ; Pretend ASCII file with no pages 0 ; And no bytes filinf: extern pagcnt,crdate ; Size and date storage saveac ; Don't destroy calling context hrrzs t4, t2 ; Save and strip and flags cain t4, .nulio ; OK, is this going to be easy? jrst nulinf ; Special cased NUL: is trivial move t1, t4 ; Load the JFN DVCHR% ; Get the device characteristics %jsErr (,r) ldb t3,[pointr(t2,dv%typ)] ; Load the device type cain t3, .dvnul ; An unconverted NUL: device? jrst nulinf ; Odd, but handle it caie t3, .dvdsk ; Structure? ifskp. ; Of course it is move t1, t4 ; Restore the JFN dmove t2, [3,,.fbbyv ; Get size info from FDB (3 words) pagcnt] ; Put info in PAGCNT,BYTCNT,CRDATE GTFDB% ; which are adjacent in the data area. annje. ; Failed, try alternate way retskp ; Succeeded else. ; Otherwise, use older slower mechanisms move t1, t4 ; Restore the JFN SIZEF% ; Will work on any directory device %jsErr (,r) exch t2,t3 ; Reorder as per above dmovem t2, pagcnt ; Store as per GTFDB% anstkv (t4,<.rsfet+1>) ;Allocate an anonymous stack variable move t2, t4 ; Point to block movx t3, <.rsfet+1> ; Length of same RFTAD% ; Try it this way %jsErr (,r) block. ; Enter block context for better control flow skipe t3,.rscrv(t4) ; Can we use the obvious file creation date? retskp ; Yes, go with that skipe t3,.rswrt(t4) ; OK, maybe the last time it was written? retskp ; Good enough... skipe t3,.rscre(t4) ; No, how about this odd word? retskp ; About as good as the previous remark ; Fall through, +1 endbk. ; End of block context ret ; Failed movem t3, crdate ; Store what we decided to use retskp ; Return success endif. remark ; Special case .nulio (and NUL:) nulinf: dmove t1,nulfdb ; Phoney up some FDB entries dmovem t1, pagcnt ; Store like GTFDB% would GTAD% ; Get current time of day movem t1, crdate ; NUL: is always created right now retskp ; Succeed ;[200] End Code Insertion subttl Fix up a file JFN for fast generational delete ;[199] Begin code insertion ; The following is necessary to leverage the DELNF% JSYS, which will ; result in far faster deletion of a file with multiple generations. ; Otherwise, each and every generation must be handled seperately in a ; loop doing GTJFN%, GNJFN% and DELF%'s ; ; Call: ; ; t1/ flags,,JFN as returned by .cmfil ; ; Assumes the following are true: ; ; 1) That the NUL: device has already been special cased to .nulio ; 2) That we are not being called with resulting .nulio ; 3) That the device in question supports directories ; ; To do: Was this necessary? If doing highest generation, does a ; negative value for generations to keep work? fjfnsf==> ; Want everything but the generation ffjfgd: jxe t1, gj%ver, r ; Nothing to do if didn't wildcard the version ifxn. t1, gj%uhv ; Already doing highest generation? txz t1, gj%ver ; Don't step generations retskp ; Succeed endif. saveac ; Candidate JFN and storage for file name move q1, t1 ; Save the JFN and flags anstkv (q2,mxfilw) ; Storage to build a new name hrro t1, q2 ; Construct Tops-20 ASCII pointer to stack hrrz t2, q1 ; Load JFN, sans flags dmove t3, [exp fjfnsf,0] ;Fast delete JFNS Flags and no prefix JFNS% ; Reconstruct on the stack %jsErr (,r) dmove t2, [exp ".","0"] ; Highest generation and punctuation idpb t2, t1 ; Append the generation punctionation idpb t3, t1 ; Append the highest generation moniker idpb t4, t1 ; Tie off the string ; Load GTJFN% flag bits,,generation number. movx t1, gj%old!gj%ifg!gj%flg!fld(.rhalf,.gjdef) hrro t2, q2 ; Construct Tops-20 ASCII pointer to stack GTJFN% ; Get a brand new JFN on file group %jsErr (,r) hll t1, q1 ; Load just the calling flags txz t1, gj%ver!gj%nhv!gj%ulv ; Shut off wildcarded lowest and next highest txo t1, gj%uhv ; Force highest generation, always exch t1, q1 ; Swap with old flags,,JFN tlz t1, -1 ; Toss its flags RLJFN% ; Toss the JFN ifje. r ; Failed?? cain t1, desx3 ; Wait, did it disappear?? anskp. ; Odd, but that's really fine move t2, t1 ; Otherwise, save the error carry on else. ; Otherwise, worked!! setz t2, ; Signal no error endif. ; Worst case, we drag an extra JFN around move t1, q1 ; Load updated flags and new JFN retskp ; Finally return success ;[199] End code insertion subttl Routine to delete a file [118] extern expung ; Auto expunge flag ; [199] Partially adapted from EFTPST. ; Call: ; ; t2/ flags,,JFN ; ; The flags are the stepping flags for a wildcarded JFN and may ; NOT be associated with the JFN in question. gj%uhv is checked ; to see if the original file specification wildcarded the ; version number. If this is the case and expunge is not on, ; then DELNF% will be used for a substantial performance increase. ; ; Returns: +1, always ; ; The JFN is not released (see below) in order to allow the driving ; loop to release it. Otherwise, in a multi-forking environment, you ; can get into the situation that the JFN is released here and another ; fork is then picked to run which issues a GTJFN%. If the same JFN ; is given, then when driver code resumes, it may wind up releasing ; somebody else's JFN!! ; ; N.B., The "remark t1, df%nrj" is used to acknowledge a documentation ; 'bug' that claims that the DELNF% JSYS will release the JFN unless ; this bit is set. No, it doesn't. ; ; DELNF% does not handle the bit: it NEVER releases JFNs because ; there is no code to do this. So, we pretend to set it even though ; DELNF% does not look at it, never has looked at it and never will ; look at it. ; ; This behavior has been consistent from TENEX days. The problem is ; a Tops-20 Monitor Calls Manual documentation defect which has ; existed since version 3A. delfil: hrrz t1, t2 ;[193] Load the JFN, sans flags caie t1, .nulio ;[193] Data sink? ifskp. ;[193] Yep, that's pretty easy seto t4, ;[199] Flag a phoney delete jrst delepi ;[199] And hit the epilogue endif. ;[199] End .nulio special case remark ;[199] Otherwise, deleting something for real ifme. expung ;[143] Not expunging automatically? txnn t2, gj%uhv ;[199] Yes. Doing all of them? anskp. ;[199] No, then don't whack all of them remark t1, df%nrj ;[199] No flags being used (see above) setz t2, ;[199] Don't keep ANY generations DELNF% ;[199] Chuck all of them; boom! erjmpr delerr ;[199] But didn't ... hrrzs t4, t2 ;[199] Remember number deleted subi t2, ^d1 ;[199] Account for assumed single file ifg. t2 ;[199] Two or more? addm t2, filcnt ;[199] Bump the file count with remainder endif. ;[199] else. ;[199] Otherwise, just do this single file hrli t1, (df%nrj!df%exp) ;[143] Yes, set the bit DELF ; Try to delete it. erjmpr delerr ;[199] But couldn't setz t4, ;[199] Flag special singular case endif. ;[199] End case expunge optimization remark t4, delepi ;[199] Falls through to epilogue with t4 set subttl Delete epilogue code comments on file operation ; Expects t4 to have a file count or a negative talisman delepi: move t1, srvptr ;[199] Build confirmation message. caile t4, ^d1 ;[193] A single file or something odd ifskp. ;[193] Yes, that's easy enough move t2, delfa ;[199] Load singular file delete acknowledge idpb t2, t1 ;[199] Append first character repeat ^d4, < ;[199] And the other four lsh t2, -^d7 ;[199] Shift next character into place idpb t2, t1 ;[199] Append it > ;[199] End loop unroll else. ;[199] Otherwise, DELNF% cleaned up a bunch dmove t2, [ exp ",", .chspc ] ;[199] Comma space over idpb t2, t1 ;[199] append the comma idpb t3, t1 ;[199] and the space move t2, t4 ;[199] Pick up the number done movei t3, ^d10 ;[199] Generations are base 10 NOUT% ;[199] Convert and append %jsErr (,) ;[199] call apptxt ;[199] Append clarifying text endif. ;[199] movem t1, srvptr ; Update the string pointer. setz t2, ;[199] Cons up a .chnul idpb t2, t1 ;[199] Keep it ASCIZ ret ; Done subttl Handle some kind of delete error ; Expects to be called with an erjmpr or similar (NOT ercalr or pushj!) delerr: sos filcnt ; "Uncount" this file, it wasn't deleted. move t4, t1 ;[199] Pass error back, if wanted tlo t4, -1 ;[199] And flag it was an error move t1, srvptr ;[199] Error, record the message dmove t2, [ exp ":", .chspc] ;[199] Load punctuation idpb t2, t1 ;[199] Append it idpb t3, t1 ;[199] hrli t2,.fhslf ;[199] This fork (LH) hrr t2, t4 ;[199] Load 'calling' error setz t3, ;[199] No limit (maybe bad idea?) ERSTR erjmps .+2 ;[199] Ignore strange return erjmps .+1 ;[199] Ignore stranger return dmove t2, crlfch ;[251] Load line terminators idpb t2, t1 ;[199] Tie off idpb t3, t1 ;[199] the line ... movem t1, srvptr ;[199] Update the pointer setz t2, ;[199] Cons up a .chnul idpb t2, t1 ;[199] Keep it ASCIZ ret ;[199] Done with blat subttl ASCII text to efficiently append in arcane ways ;[199] Begin code insertion chgsec(code,text) ;;Text goes in section zero text delfa: remark " [OK] " ; delete file acknowlege byte (1) 0 (7) "]", "K", "O", "[", .chspc gentxt: remark " generations" ; Inflection will always be plural byte (1) 0 (7) "e", "n", "e", "g", .chspc byte (1) 0 (7) "o", "i", "t", "a", "r" byte (1) 0 (7) .chnul, .chnul, .chnul, "s", "n" retsec ;;Back to generating code ; To do: The unrolled right justified ASCIZ ", generations" text can ; be stored with 24 instructions. At what point would the MOVSLJ ; begin to outperform this? I dislike using SOUT% to shuttle ; characters. Ditto NOUT% for numbers... apptxt: remark t1, ; Expects a valid pointer in t1 move t2, gentxt ; Load first part of explanatory text idpb t2, t1 ; Append first character repeat ^d4, < ; And the other four lsh t2, -^d7 ; Shift the next character into place idpb t2, t1 ; Append it > ; End loop unroll move t2, gentxt+1 ; Load next part of explanatory text idpb t2, t1 ; Append first character repeat ^d4, < ; And the other four lsh t2, -^d7 ; Shift next next character into place idpb t2, t1 ; Append it > ; End loop unroll move t2, gentxt+2 ; Load final part of explanatory text idpb t2, t1 ; Append first character lsh t2, -^d7 ; Shift the final character into place idpb t2, t1 ; Append it ret ; Done ;[199] End code insertion subttl DMPBUF - Dump the buffer [115] ;[215] Begin code insertion (moved from k20mit) ; ; ; Call with SRVPTR/ current pointer (to end of string to be dumped) ; Returns +1 with t1/ new pointer. Uses t2. ; ; Dumps the buffer starting from SRVBUF thru present position, ; resets pointer SRVPTR to beginning of SRVBUF. ; ; Certain headers are hardcoded and need no termination. These are all ; up in section 1 and are referenced by one word global ASCII pointers. dmpbuf: entry dmpbuf ;[194] Also used from k20dsp move t1, srvptr ; Get current pointer. move t3, t1 ;[215] Save a copy here, just in case move t4, t1 ;[215] And another copy over here seto t2, ;[215] Just in case first fetch fails ldb t2, t4 ;[215] Pick up current byte erjmpr dmpbfe ;[215] Handle an addressing error jumpe t2, dmpbf2 ;[215] Already tied off, nothing to do seto t2, ;[215] Just in case 2nd fetch fails ildb t2, t4 ;[215] No, how about the NEXT byte, then? erjmpr dmpbfe ;[215] Handle an addressing error jumpe t2, dmpbf2 ;[215] Already tied off, nothing to do dmpbf1: setzb t2, t4 ;[215] Have to tie it off, then idpb t4, t3 ;[215] Make sure string is asciz. erjmpr dmpbfe ;[215] Failed?? dmpbf2: move t1, [point 7, srvbuf] ; Point to buffer movem t1, srvptr ; Save new pointer. ifme. srvflg ;[194] Am I not a server? skipn srvbuf ;[194] No, but is there anything to type? anskp. ;[194] No, so bum the JSYS PSOUT ; If not, print it. endif. ;[194] dmpbf3: setzm srvbuf ; Clear it. move t1, [srvbuf,,srvbuf+1] blt t1, srvbzz move t1, srvptr ; Return pointer in t1. ret ; Here on some addressing error. If t2 is negative, then we failed ; on the read. If it is zero, then we failed on the write. dmpbfe: remark ;[215] Here if an addressing error caige t2, 0 ;[215] Failed the read? %ermsg (,dmpbe3) ;[215] move t4, t1 ;[215] Get error number out of the way caie t4, ILLX02 ;[215] Write-protected page, then? %ermsg (,dmpbe3) ;[215] hlrz t1, t3 ;[215] Pick up the pointer position portion move t2, t1 ;[215] Make a copy so can examine both parts andi t1, 770000 ;[215] Shut off the section andi t2, 007777 ;[215] Keep just the section ;[215] First check just the pointer remark ;[215] There will be only six possible positions cain t1, (.p0736) ;[215] Starting position? jrst dmpbe1 ;[215] Yep, OK cain t1, (.p0706) ;[215] First byte? jrst dmpbe1 ;[215] Yep, OK cain t1, (.p0713) ;[215] Second byte? jrst dmpbe1 ;[215] Yep, OK cain t1, (.p0720) ;[215] Third byte? jrst dmpbe1 ;[215] Yep, OK cain t1, (.p0727) ;[215] Fourth byte? jrst dmpbe1 ;[215] Yep, OK cain t1, (.p0734) ;[215] Fifth byte? jrst dmpbe1 ;[215] Yep, OK %ermsg (,dmpbe3) ;[215] dmpbe1: remark ;[215] Here if thought to be a valid OWG ASCII ptr caie t2, extsec ;[215] In extended text psect? %ermsg (,dmpbe3) ;[215] dmpbe2: remark ;[215] Terminated string or a write error we can handle move t1, t3 ;[215] Reload original pointer ibp t1 ;[215] Pretend the idpb worked jrst dmpbf2 ;[215] Carry on dmpbe3: remark ;[215] Here on error recovery failure move t1, [point 7, srvbuf] ;[215] Just reset movem t1, srvptr ;[215] the bufer pointer jrst dmpbf3 ;[215] And stomp the buffer ;[215] End code insertion subttl Close out Code xlist ; Shut off the listing lit ; Dump the literals list ; Turn the listing back on .endps code subttl Impure data area .psect data cdhack: block 1 ;[255] Used to transmogrify ".." into CDUP tmpjfn: block 1 ;[233] Used for directory/name logging dirbuf: block fdrmxw ;[220] Maximum size foreign directory pasbuf: block fpwmxw ;[220] Maximum size foreign password filptr: point 7, filbuf ; Pointer to file buffer text filcnt: 0 ;[194] ; File counter for directory listings. dirfin: 0 ;[194] ; Flag for directory listing finished. gclen: 0 ; Generic command data field length. rufork: 0 ; Fork number for LOCAL RUN program fork. ;[220] These all get the "x" overwritten ;To do, they get the X overwritten sometimes... xxbmsg: asciz/"x" - Not valid as server command/ ; Another. xxblen==^d33 ;[220] ; Number of characters in xxbmsg. xxgnms: asciz/"x" - Unimplemented generic command/ xxgnln==^d35 ;[220] xxgums: asciz/"x" - Undefined generic command/ xxguln==^d31 ;[220] xxumsg: asciz/"x" - Unknown server command/ ; Server message (fill in the x) xxulen==^d28 ;[220] ; Number of characters in xxumsg. remark Buffer space getptr: 0 ;[220] ; Pointer for emptying... srvptr: 0 ;[194] ; And pointer for filling... srvbuf: xlist ;[194] ;[187] Save the trees!! repeat <1000>,<0> ; Big buffer for server responses. list ;[187] srvbz: xlist ;[194] ;[187] repeat <100>,<0> ; End of buffer, with some padding. list ;[187] srvbzz: 0 ;[220] ;[215] Where the padding ends. cwdbuf: block dirmxw ;[249] ; Area to construct a directory in .endps data end ; Local Modes: ; Mode:MACRO ; Comment Column:32 ; Comment Start:;[255] ; Comment Begin:;[255] ; Auto Fill Mode: 0 ; End: