; CUUOS.MAC.102, 28-Mar-83 16:16:51, Edit by FORDYCE ;[drf-1] Make CMDB: global title CUuos - CU Utility UUO Package search CUsym %setenv comment ~ Most recent update: 5:38pm Monday, 9 February 1981 This package contains all the support routines for the CUCCA Utility UUO package; the user-interface macros are in CUsym. Chris Ryland CUCCA, June, 1978 Fixed %atmbl definition in CUsym to be number of characters in atom buffer, and fixed %atmbl's in this source to correspond. Ken Rossman July, 1980 Made atomb internal so some picky folks could get at it. Also changed it's name to be %atomb to conform with current CU standards. Ken Rossman February, 1981 ~ ; Various binds $cmdbl== <^d500> ; Length of the command buffer (ditto) subttl Impure Data %impure ; COMND support storage - note that %csb and %atomb are internal internal %csb ; for those hard-core hackers internal %atomb ; ,... %csb: block .cmgjb+1 ; Command State Block fdb: block .cmdef+1 ; Function Descriptor Block %atomb: block %atmbl/5+1 ; Atom buffer cmdb:: block $cmdbl/5+1 ; Command buffer [drf-1] cmidun: block 1 ; True means we've already initialized ; for COMND parsing after a %cmres ; %print package output JFN stack support storage jfnsSz==^d10 ; Size of JFN stack jfnsP: exp .nil ; JFN Stack stack Pointer (null when empty) jfnStk: block jfnsSz ; The stack itself ; %print package padding temporary string area pdArea: block ^d1000/5+1 ; Enough for 1k characters ; UUO table: each UUO (values 1-37) has a corresponding entry in ; uuotab, which is the address of its handler routine. Any unused ; slots are null. Note that users may add entries to this table, ; so it must be in impure storage. define .uuo(uuo, handler) < .org uuotab+.rtjst(uuo,777b8) ;; Go to right place handler ;; Drop in handler address .org ;; Back to where we were > uuotab: ; The table itself repeat 40, < exp 0 ; Initially empty > .uuo %uprin, uprint ; Print UUO .uuo %comnd, ucomnd ; COMND interface UUO .uuo %ucmin, cmini ; COMND initializer UUO .uuo %cmgfg, ucmgfg ; Get COMND flags UUO .uuo %cmgab, ucmgab ; Get COMND atom buffer UUO .uuo %nuuo, newuuo ; Define-new-UUO UUO .uuo %cmres, cmres ; Reset COMND parsing UUO subttl UUO handling - initialization and dispatch %routines ; All of 'em follow this point entry %%uuoi ; Setup routine ; Called from the user's %setup macro at start of execution. %%uuoi: push p, [call uuoh] ; Set up hardware UUO location (41) pop p, 41 ; with call to dispatch routine ret ; All done ; Called (via hardware handling) for each UUO executed. ; The ut trvar's below hold the entire 'user context', except for ; .fp (15) and p (17); when any routine below needs a full user address, ; it should call uaddr. uaddr effectively simulates hardware addressing, ; using the ut values, and the values of p and .fp (which are stored ; on the stack right below ut1, in the order p, .fp; careful! it depends ; on this fact). Anyone needing to return a value in t should store ; that value in ut before returning to this top level dispatcher. ; Note that we now support +n+1 returns, where n is the value of the AC ; field in the UUO executed. E.g., %uprint 1,[...] will return +2; ; error handling is as always: the presence of an ErJmp or ErCal is taken ; into account (e.g., in the previous example, if an ErXXX follows, the ; success return will actually be +3). ; ; UUO-specific handlers should return +1 only on Jsys failure, and +2 ; otherwise (i.e., all ok). uuoh: trvar ; Save all user Tn ac's; we use them ; Also, locals `global' to handlers live here dmovem t1, ut1 ; Save , and dmovem t3, ut3 ; in our locals ldb t3, [pointr(40,^o000740000000)] ; Pick up AC for return offset movem t3, retOff ; Save it for use below ldb t3, [pointr(40,^o777b8)] ; Get opcode we were called with move t4, uuotab(t3) ; And get address of handler jumpe t4, uuohNH ; If null, no such handler; error call (t4) ; Call handler jrst uuohFl ; Failure return; go handle movei t3, p ; Now, pick up value of p in user call uget ; context move t1, 1(t3) ; Get return address move t2, retOff ; Get return offset (+0, +1,...) hlrz t1, (t1) ; Get instruction after UUO andx t1, 777740 ; Only look at instr code and ac caie t1, () ; Is it an erjmp instruction? cain t1, () ; Or an ercal? aos t2 ; Yes, be sure and skip it too addm t2, 1(t3) ; Make return be the appropriate one dmove t1, ut1 ; Success return: restore acs, dmove t3, ut3 ; ... ret ; And give success return ourselves ; ... [uuoh continued on next page] ; ... [uuoh continued from previous page] uuohNH: ; Here when an undefined UUO is invoked. movei t3, p ; Pick up value of p in user call uget ; context hrrz t4, 1(t3) ; Get return address sos t4 ; Bump down to point at offending UUO %ermsg ,, ; Scream and die jrst .-1 ; If continued, complain again uuohFl: ; Here when have to give failure return; handle erjmp and ercal. movei t3, p ; Now, pick up value of p in user call uget ; context move t1, 1(t3) ; Get return address hlrz t1, (t1) ; Get instruction after UUO andx t1, 777740 ; Only look at instr code and ac caie t1, () ; Is it an erjmp instruction? cain t1, () ; Or an ercal? skipa ; Yes, handle %9 jrst [ hrrz t4, 1(t3) ; No, get return address sos t4 ; Back it up to point to failing UUO movx t1, .fhslf ; Get last process error GETER ; to see if we issue an %ermsg %jserr,,< t4 > ; No last error; be helpful and die %ermsg <%e at %o>,, ; Was an error; tell it jrst %9b ] ; If she continues, tell her again caie t1, () ; Is it an erjmp? jrst %3f ; No, go handle ercal hrrz t1, 1(t3) ; Yes, get address of erjmp, move t1, (t1) ; and get full address, call uaddr ; turning it into a real user address movem t1, 1(t3) ; Put it back in as the return address jrst %4f ; and go finish up %3 ; Here to handle an ercal - build little program on stack that ; gets called when we try to return to his program. hrrz t1, 1(t3) ; Get address of ercal, move t1, (t1) ; then full address of routine to call, call uaddr ; turning it into a real user address movei t2, ut4 ; Get address of one less than stack routine hrrz t4, 1(t3) ; Get address of ercal instruction movem t4, 1(t2) ; First word of our routine: where to return hrrzi t4, 1(t2) ; Get address of that first word hrli t4, () ; Turn it into our first instruction movem t4, 2(t2) ; and plop it into our routine hrli t1, () ; Make the last instruction (a jrst to his movem t1, 3(t2) ; ercal'ed routine) and put it in also hrrzi t4, 2(t2) ; Get address of the start of our routine movem t4, 1(t3) ; and make it what gets returned to %4 ; Here to restore ac's, and return (to invoke erjmp/ercal handling) dmove t1, ut1 ; Restore , and dmove t3, ut3 ; to user context ret ; Chug, chug; all done subttl Routines to handle user-context addresses ; GetArg: get value of next argument in arg list, in user context. ; As a side effect, updates the arg list pointer, effectively `eating' ; the current argument. Returns the argument value in t4. getarg: saveac ; Save work reg move t3, argl ; Get arg list's current value move t4, (t3) ; Get current argument movei t3, 1(t3) ; Bump argument list pointer movem t3, argl ; to next arg call getval ; Get value of address in t4 to t4 ret ; All done ; GetVal: given a full address (see UAddr, below) in t4, get the value ; of that address in the user's context into t4. getval: saveac ; Save our work registers move t1, t4 ; Get full address call uaddr ; Convert it to a real address move t3, t1 ; Finally, get its value call uget ; in the user context move t4, t3 ; And return that ret ; UAddr: given a full (i.e., index, indirect, and right half) address ; in t1, compute the equivalent (18-bit) address in the user context. ; Note that we have to worry about t1-t4, .fp and p, which the UUOs ; clobber (they're saved in ut and on the stack below them). uaddr: saveac ; Work register %1 hrri t2, (t1) ; Get Y (the right-half of the address) txnn t1, 17b17 ; Is there an index involved? jrst %2f ; No, don't bother ldb t3, [pointr(t1,^o17b17)] ; Yes, get it call uget ; Turn it into its value addi t2, (t3) ; Add (using addr math) into result %2 txnn t1, 1b13 ; Now, got an indirect bit? jrst [ movei t1, (t2) ; No, just get result in t2 ret ] ; and return this hrrzi t3, (t2) ; Yes, indirect; get value of call uget ; address built so far move t1, t3 ; And redo whole process for jrst %1b ; new address ; UGet: given an 18-bit user address in t3, get the corresponding ; word value into t3. ; NOTE: this is extremely dependent on the implementation of TrVar. uget: caile t3, 17 ; Have we an ac? jrst [ move t3, (t3) ; No, just get its value ret ] ; and we're done cain t3, .fp ; Is this the trvar frame pointer? jrst [ movei t3, ut1 ; Yes, get address of lowest trvar move t3, -1(t3) ; And get old .fp from stack ret ] cain t3, p ; Is this our stack pointer friend? jrst [ movei t3, ut1 ; Yes, get address of lowest trvar movei t3, -3(t3) ; And bump down by amount of overhead ret ] caig t3, t4 ; Is this one of t1-t4? caige t3, t1 ; ... jrst [ move t3, (t3) ; No, just get its value ret ] xct [ move t3, ut1 ; Yes, get appropriate ut move t3, ut2 ; ... move t3, ut3 move t3, ut4 ] -1 (t3) ; Note index!! ret ; USet: given an 18-bit user address in t3, and a value in t2, ; set the corresponding address to the value of t2. ; NOTE: this is extremely dependent on the implementation of TrVar. uset: caile t3, 17 ; Have we an ac? jrst [ movem t2, (t3) ; No, just set its value ret ] ; and we're done cain t3, .fp ; Is this the trvar frame pointer? %ermsg ; Die cain t3, p ; Is this our stack pointer friend? %ermsg ; Yes, die caig t3, t4 ; Is this one of t1-t4? caige t3, t1 ; ... jrst [movem t2, (t3) ; No, just set its value ret ] xct [ movem t2, ut1 ; Yes, set appropriate ut movem t2, ut2 ; ... movem t2, ut3 movem t2, ut4 ] -1 (t3) ; Note index!! ret subttl %uprint UUO top-level ; UPrint: (see the documentation for a complete description of our job) ; Basically, we toodle down the format string, taking action on each `%' ; seen, by calling an appropriate routine, after setting a flag for any ; `@' modifier; any other character is output literally. Also handle ; a width field between the % and the action character (either literal, ; or indirect if `:' seen). uprint: move t3, 40 ; Get the address of the argument list move t4, (t3) ; Get byte ptr to the format string movei t3, 1(t3) ; Point at first argument address movem t3, argl ; Save it for our work later move t1, jfnsP ; Get jfn stack pointer camn t1, [.nil] ; Is the stack empty? skipa t2, [.priou] ; Yes, use normal primary output port move t2, @(t1) ; No, use the top JFN movem t2, ojfn ; Store it for our use hereunder setzm noUpdJ ; Assume we want to update the JFN stack ; ... [uprint continued on next page] ; ... [uprint continued from previous page] ; Top of format-string scan loop %1 ildb t2, t4 ; Get next character from format string jumpe t2, uprdon ; If null, we're done successfully cain t2, "%" ; Got the action trigger? jrst %2f ; Yes, go handle it move t1, ojfn ; No, just print it normally BOUT ; ... erjmp r ; If fails, give failure return movem t1, ojfn ; Save possibly updated byte ptr jrst %1b ; All ok, do next %2 setzm atseen ; We've got an action char; no @ seen yet setz t3, ; Clear our number collector movx t1, 1 ; Sign is currently positive ildb t2, t4 ; Look at next character cain t2, "-" ; Do we have the minus sign for field width? jrst [ movx t1, -1 ; Yes, change sign ildb t2, t4 ; and get next character jrst .+1 ] %6 cail t2, "0" ; Do we have a field width digit? caile t2, "9" ; ... jrst %7f ; No, look for other stuff imuli t3, ^d10 ; Yes, shift current value addi t3, -"0"(t2) ; and add in this digit ildb t2, t4 ; Get next digit (if any) jrst %6b ; Keep collecting %7 imul t3, t1 ; Set sign of result movem t3, fldwid ; Save result as field width (zero if none) cain t2, ":" ; Indirect field width modifier? jrst [ call getArg ; Yes, get the next argument from list to t4 movem t4, fldwid ; and use that as the field width ildb t2, t4 ; Scan past the modifier jrst .+1 ] ; Go on cain t2, "@" ; See if it's an argument modifier jrst [ setom atseen ; Yes, say we've seen it ildb t2, t4 ; And get descriptor char jrst .+1 ] cain t2, "!" ; Is it the start of an embedded comment? jrst %5f ; Yes, go find the end move t1, [-dtblen,,dsctab] ; Make aobjn pointer for searching cail t2, "A" ; Is this an upper-case alpha? caile t2, "Z" ; ... skipa ; No, nothing special iori t2, 40 ; Yes, upper case; make lower %3 hlrz t3, (t1) ; Loop over table: get name cain t3, (t2) ; Is it the same? jrst %4f ; Yes, go handle it aobjn t1, %3b ; No, try next jrst %1b ; Oops; didn't find it; just ignore ; ... [uprint continued on next page] ; ... [uprint continued from previous page] ; Here when have handler address in (t1). %4 hrrz t1, (t1) ; Get address of handler for this skipn fldWid ; Do we have to play field width games? jrst %8f ; No, go on move t2, ojfn ; Save current real 'jfn' movem t2, savJFN ; locally, as we have to fake it move t2, [point 7, pdArea] ; Make current 'jfn' be temporary output movem t2, ojfn ; area for later padding %8 call (t1) ; Handler descriptor is in t1: call it jrst uprfai ; Failure return; do the same skipn fldWid ; Have to play field width games again? jrst %1b ; No, go back to top of print loop call doPad ; Yes, do the actual padding jrst %1b ; and back to top of print loop %5 ildb t2, t4 ; Got start of comment, get next char cain t2, "!" ; Found the end? jrst %1b ; Yes, continue normally jumpe t2, uprdon ; If end of string, all done successfully jrst %5b ; Else, keep looking for end of comment ; Here when done successfully uprdon: call uprjst ; finish up JFN stack munging retskp ; return success ; Here when failed in some way uprfai: call uprjst ; Finish up JFN stack munging ret ; return failure ; Subroutine to finish JFN stack handling after a %print uprjst: skipe noUpdJ ; Do we have to update the JFN stack? ret ; Nope, all done move t1, jfnsP ; Get JFN stack pointer camn t1, [.nil] ; Empty? ret ; Yes, all done move t2, (t1) ; Get address of user's JFN move t3, ojfn ; Get last updated JFN we used movem t3, (t2) ; Update the user's JFN ret ; All done subttl %UPrint descriptor-char dispatch table ; Each entry in this table has the format ; ; the descriptor must be lower case if it's alphabetic. Arrange them ; in (descending) order of frequency of use, please, since we have to ; search the table linearly. dsctab: "d" ,, dprint ; Decimal number "o" ,, oprint ; Octal number "s" ,, sprint ; Asciz string "/" ,, pcrlf ; New line (CRLF) wanted "=" ,, setjfn ; Set output JFN "_" ,, outtab ; Horizontal tab "e" ,, eprint ; Error message "?" ,, ersync ; Error message with synchronization "f" ,, fprint ; Float number "t" ,, tprint ; Date and time "n" ,, nprint ; Date and time of now "j" ,, jprint ; File name of JFN "v" ,, vprint ; Device name "x" ,, sixprt ; Sixbit value "c" ,, cprint ; (Connected) directory name "u" ,, usrpnt ; (Login) user name "h" ,, hprint ; cHaracter "i" ,, iprint ; Like D, but +Inf if negative "%" ,, percnt ; Just another `%' "{" ,, lbrack ; A left angle-bracket "}" ,, rbrack ; A right angle-bracket "^" ,, ffeed ; A Form-Feed dtblen== .-dsctab ; Length of this table subttl doPad - do padding for a %print item that asks for it ; doPad: ; fldWid/ desired width of field currently sitting in pdArea ; negative means left padded (and left truncated if necessary) ; positive means right padded (and right truncated if necessary) ; savJFN/ 'real' output destination ; pdArea/ string to be padded if necessary ; ojfn/ string pointer to end of string (last non-zero byte) doPad: saveac ; Save all our little work registers ; skipge fldWid ; Want left padding? ; jrst ; Yes, go do it ; move t1, [point 7,pdArea] ; No, first compute difference ; move t2, ojfn ; between beginning and ending pointers ; call subBP ; with result in t3 ; %ermsg <%%print UUO: internal error at doPad> ; Failed: scream and die ret subttl DPrint - print a decimal number dprint: saveac ; Save work registers skipe atseen ; Was there an @ modifier? call [ call getarg ; Yes, get value of format into t4 move t3, t4 ; and now into NOUT's format ac txnn t3, fld(777,no%rdx) ; Is the radix defaulting? hrri t3, ^d10 ; Yes, make it decimal retskp ] ; Else, movx t3, ^d10 ; Use simple decimal format call getarg ; Get value of number to print into t4 move t2, t4 ; and into NOUT's number ac move t1, ojfn ; Get output JFN NOUT ; And output the actual number erjmp r ; On failure, give fail return movem t1, ojfn ; Update possibly changed byte ptr retskp ; Else, all ok; give good return subttl IPrint - print a positive decimal number iprint: saveac ; Save work registers skipe atseen ; Was there an @ modifier? call [ call getarg ; Yes, get value of format into t4 move t3, t4 ; and now into NOUT's format ac txnn t3, fld(777,no%rdx) ; Is the radix defaulting? hrri t3, ^d10 ; Yes, make it decimal retskp ] ; Else, movx t3, ^d10 ; Use simple decimal format call getarg ; Get value of number to print into t4 skipge t2, t4 ; and into NOUT's number ac jrst %1f ; Negative - go print +Inf move t1, ojfn ; Get output JFN NOUT ; And output the actual number erjmp r ; On failure, give fail return movem t1, ojfn ; Update possibly changed byte ptr retskp ; Else, all ok; give good return %1 move t1, ojfn ; Get output JFN hrroi t2, [asciz/+Inf/] ; And special value movx t3, 0 ; Asciz output SOUT ; Output it erjmp r ; Give failure return movem t1, ojfn ; Update possibly changed byte pointer retskp ; All ok subttl OPrint - output an Octal number oprint: saveac ; Save work registers skipe atseen ; Was there an @ modifier? call [ call getarg ; Yes, get value of format into t4 move t3, t4 ; and now into NOUT's format ac txnn t3, fld(777,no%rdx) ; Is the radix being defaulted? hrri t3, ^d8 ; Yes, make it octal retskp ] ; Else, movx t3, no%mag!^d8 ; Use default octal format (unsigned) call getarg ; Get value of number to print into t4 move t2, t4 ; and into NOUT's number ac move t1, ojfn ; Get output JFN NOUT ; And output the actual number erjmp r ; On failure, give fail return movem t1, ojfn ; Save possibly updated byte ptr retskp ; Else, all ok; give good return subttl SPrint - print an Asciz string sprint: saveac ; Stash away work ac's call getarg ; Get byte pointer arg into t4 move t1, ojfn ; Now, set up output JFN, move t2, t4 ; string pointer, movx t3, 0 ; (no limit indicator) SOUT ; and put out the string erjmp r ; Give fail return on jsys failure movem t1, ojfn ; Save possibly updated byte ptr retskp ; Else, all is well; give good return subttl PCrlf - print a CRLF pair pcrlf: saveac ; Save work registers move t1, ojfn ; Get output JFN, hrroi t2, [byte (7) .chcrt, .chlfd] ; string to output, movx t3, 0 ; (no limit), SOUT ; and output it erjmp r ; Give fail return on jsys failure movem t1, ojfn ; Save possibly updated byte ptr retskp ; Else, all ok; give good return subttl SetJFN - set up the output JFN for the rest of the %print setjfn: saveac ; Save work register call getarg ; Get JFN itself into t4 movem t4, ojfn ; Make it the JFN from this point on setom t4, noUpdJ ; and don't update the JFN stack when done retskp ; Always give good return subttl OutTab - print a horizontal tab outtab: saveac ; Save work ac's movx t2, .chtab ; Get tab ascii value ; CallRet'd here by anyone wanting to print a single character (in t2) princh: move t1, ojfn ; Get output JFN BOUT ; Output it erjmp r ; If fails, give failure return movem t1, ojfn ; Save possibly updated byte ptr retskp ; Else, all is ok; good return subttl error synchronization for terminal output (%?) ; Rest of this %print will go to hard terminal ersync: saveac setom noUpdJ ; Please don't update the JFN stack top movx t1, .priin ; Clear typeahead cfibf ; ... movx t1, .cttrm ; And wait for previous output to tty movem t1, ojfn ; (which we now make the current output) dobe ; to finish call pcrlf ; Now, output CRLF for attention ret ; Failed; give failure return movx t2, "?" ; All ok, finish with a callret princh ; question mark subttl EPrint - print an error text eprint: saveac ; Save all work ac's skipe atseen ; Do we have an error number? call [ call getarg ; Yes, get it to t4 retskp ] ; Else, movx t4, -1 ; use last error for this fork move t1, ojfn ; Get where to put error message, movei t2, (t4) ; Get (right-half) error code, hrli t2, .fhslf ; process to report on (us), movx t3, 0 ; no limit on length of message, ERSTR ; and output it jrst r ; Failed w/ undefined error number jrst r ; Failed w/ invalid destination movem t1, ojfn ; Save possibly updated byte ptr retskp ; All worked, return OK subttl FPrint - print a floating number fprint: saveac ; Save work registers skipe atseen ; Was there an @ modifier? call [ call getarg ; Yes, get its value into t4 move t3, t4 ; and now into FLOUT's format ac retskp ] ; Else, movx t3, 0 ; use free-format floating format call getarg ; Now, get number to output into t4 move t2, t4 ; and into FLOUT's number ac move t1, ojfn ; Get output JFN FLOUT ; And output the actual number erjmp r ; On failure, give fail return movem t1, ojfn ; Save possibly updated byte ptr retskp ; Else, all ok; give good return subttl TPrint - print a date and time value tprint: saveac ; Save work registers skipe atseen ; Was there an @ modifier? call [ call getarg ; Yes, get its value into t4 move t3, t4 ; and now into ODTIM's format ac retskp ] ; Else, movx t3, 0 ; use normal date/time format call getarg ; Get value of date/time into t4 move t2, t4 ; and into ODTIM's date/time slot move t1, ojfn ; Get output JFN ODTIM ; And output the given time erjmp r ; On failure, give fail return movem t1, ojfn ; Save possibly updated byte ptr retskp ; Else, all ok; give good return subttl NPrint - print the date and time of now nprint: saveac ; Save work registers skipe atseen ; Was there an @ modifier? call [ call getarg ; Yes, get its value into t4 move t3, t4 ; and now into ODTIM's format ac retskp ] ; Else, movx t3, 0 ; use normal date/time format move t1, ojfn ; Get output JFN movx t2, -1 ; Want current date and time ODTIM ; so output it erjmp r ; On failure, give fail return movem t1, ojfn ; Save possibly updated byte ptr retskp ; Else, all ok; give good return subttl JPrint - print the file name associated with a JFN jprint: saveac ; Save work registers skipe atseen ; Was there an @ modifier? call [ call getarg ; Yes, get its value into t4 move t3, t4 ; and now into JFNS's format ac retskp ] ; Else, movx t3, 0 ; use default format call getarg ; Get JFN into t4 move t2, t4 ; and into t2 for JFNS move t1, ojfn ; Get output JFN JFNS ; Output the file name erjmp r ; On failure, give fail return movem t1, ojfn ; Save possibly updated byte ptr retskp ; Else, all ok; give good return subttl VPrint - print a device name vprint: saveac ; Save work ac's call getarg ; Get value of dev designator to t4 move t1, ojfn ; Get destination move t2, t4 ; and device DEVST ; Output it erjmp r ; Failed; return same movem t1, ojfn ; Save possibly updated byte ptr retskp ; All OK subttl SixPrt - print a Sixbit value sixprt: saveac ; Save work ac's call getarg ; Get sixbit value into t4 move t3, [point 6, t4] ; Make byte pointer to it movx q1, 6 ; Get counter for sixbit chars move t1, ojfn ; Get destination for output %1 ildb t2, t3 ; Get next character addi t2, " " ; Make into ascii BOUT ; Output it erjmp r ; Failed; indicate so sojg q1, %1b ; Loop over all six chars movem t1, ojfn ; Save possibly updated byte ptr retskp ; All OK, return good subttl CPrint - print a directory name (default: Connected) cprint: saveac ; Save work ac's skipe atseen ; Is she supplying one? call [ call getarg ; Yes, get it into t4 move t2, t4 ; and into DIRST's slot retskp ] ; Else, call [ GJINF ; get connected dir into t2 ret ] move t1, ojfn ; Get destination to t1, DIRST ; and output the directory name erjmp r ; Failed, pass it on movem t1, ojfn ; Save possibly updated byte ptr retskp ; All OK subttl UsrPnt - print a user name (default: Login) usrpnt: saveac ; Save work ac's skipe atseen ; Is she supplying one? call [ call getarg ; Yes, get it into t4 move t2, t4 ; and into DIRST's slot retskp ] ; Else, call [ GJINF ; get login dir into t1 move t2, t1 ; and into t2 ret ] move t1, ojfn ; Get destination to t1, DIRST ; and output the directory name erjmp r ; Failed, pass it on movem t1, ojfn ; Save possibly updated byte ptr retskp ; All OK subttl HPrint - print a cHaracter hprint: saveac ; Save work ac's call getarg ; Get that character into t4 hrrzi t2, (t4) ; and into t2 callret princh ; And ask princh to do the work ; Percnt - print a `%' percnt: saveac ; Save work ac's movx t2, "%" ; Get character to print callret princh ; and go print it ; LBrack - print a left angle-bracket lbrack: saveac ; Save work ac's movx t2, 074 ; Get character to print callret princh ; and go print it ; RBrack - print a right angle-bracket rbrack: saveac ; Save work ac's movx t2, 076 ; Get character to print callret princh ; and go print it ; FFeed - print a Form-Feed ffeed: saveac ; Save work ac's movx t2, .chffd ; Get character to print callret princh ; and go print it ; PrNull - output a null character (for tying off strings) prnull: saveac ; Save works movx t2, .chnul ; Output a NUL char callret princh ; ... subttl UComnd - COMND Jsys interface main UUO ucomnd: hrrz t2, 40 ; Get address of flddb movei t1, %csb ; and of csb COMND ; Do the COMND function erjmp [movx t1, cm%nop ; If fails badly, pretend we iorm t1, %csb+.cmFlg ; saw a parse error movem t1, ut1 ; Return failure flag in t1 ret ] ; and give failure return txne t1, cm%nop!cm%rpt ; Parse failed or reparse needed? jrst [ movem t1, ut1 ; Yes, set flags ret ] ; and give failure return movem t2, ut2 ; No, return COMND's value and hrrz t2, 40 ; if there's an alternate hrrz t2, (t2) ; FDB, then return t3's skipe t2 ; value movem t3, ut3 ; for her perusal retskp ; and give good return subttl CmIni - Set up things for COMND Jsys work cmini: hrrz t2, 40 ; Get address of arg list movem t2, argl ; Save it for work below skipe cmidun ; Have we already initialized for parsing? jrst cmdoit ; Yes, go do the COMND initialization setom cmidun ; No, say we have, now, though call getarg ; Get the first arg movem t4, %csb+.cmrty ; Make it the ctrl/r buffer pointer ildb t3, t4 ; Get first character of prompt cain t3, "<" ; Is it our funny friend (who should be movem t4, %csb+.cmrty ; flushed)? Yes, update the pointer call getarg ; Get the flags hllzm t4, %csb+.cmflg ; Drop into CSB call getarg ; Get the i/o jfn pair movem t4, %csb+.cmioj ; Put in CSB slot call getarg ; Get address of GTJFN block movem t4, %csb+.cmgjb ; Put into CSB move t1, [point 7, cmdb] ; Set up pointers to movem t1, %csb+.cmbfp ; start of user input, movem t1, %csb+.cmptr ; next field to be parsed, move t1, [point 7, %atomb] ; atom buffer movem t1, %csb+.cmabp ; ... movx t1, $cmdbl ; Set up count of movem t1, %csb+.cmcnt ; space remaining in command buffer, setzm %csb+.cminc ; number of unparsed characters, movx t1, %atmbl ; number of chars in the movem t1, %csb+.cmabc ; atom buffer cmdoit: movei t1, %csb ; Now, all is set: movei t2, [flddb. .cmini] ; initialize COMND ; the parse erjmp r ; Failed: take error (non-skip) return retskp ; All ok, take good return subttl CMRes - Reset the COMND parsing entirely cmres: clearm cmidun ; Just tell cmini we need a full setup retskp ; next time through; all ok subttl UCmGFg - Get COMND flags from CSB ucmgfg: move t1, %csb+.cmflg ; Get flags movem t1, ut1 ; Return them in t1 retskp ; All ok, return good subttl UCmGAB - Get atom buffer contents ucmgab: stkvar ; For saving byte ptr address hrrz t3, 40 ; Get address of byte pointer movem t3, bpaddr ; Save it call uget ; Get its value into t3 move t2, t3 ; and save it in t2 move t1, t3 ; Now, turn the byte pointer's 23-bit call uaddr ; address into an 18-bit address in t1 andx t2, <777700,,0> ; Clean out all but in original hll t1, t2 ; byte pointer, and get it into t1 hrroi t2, %atomb ; Get string pointer of source movx t3, 0 ; No limit SOUT ; Move the buffer to where asked erjmp [move t3, bpaddr ; Failed, save back value of move t2, t1 ; updated byte pointer call uset ; ... ret ] ; and give failure return move t3, bpaddr ; Success, save back updated move t2, t1 ; updated byte pointer (from t1) call uset ; ... retskp ; and return success subttl NewUUO - Define new user UUO newuuo: retskp ; All ok, return good subttl That's all! end ; Local modes: ; Mode: Midas ; Comment Start:; ; Comment Rounding:+1 ; End: