Trailing-Edge
-
PDP-10 Archives
-
decuslib20-11
-
decus/20-192/cuuos.mac
There are no other files named cuuos.mac in the archive.
; <IMPORTS.COLUMBIA.MACRO>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<n> 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<n> 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<n> should store
; that value in ut<n> 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 <ut1,ut2,ut3,ut4,retOff,ojfn,fldWid,savJFN,atseen,argl,noUpdJ>
; Save all user Tn ac's; we use them
; Also, locals `global' to handlers live here
dmovem t1, ut1 ; Save <t1, t2>, and
dmovem t3, ut3 ; <t3, t4> 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, (<erjmp>) ; Is it an erjmp instruction?
cain t1, (<ercal>) ; 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 <UUO package: Unassigned UUO at %o>,,<t4> ; 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, (<erjmp>) ; Is it an erjmp instruction?
cain t1, (<ercal>) ; 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<UUO package: no ErJmp/ErCal after failing UUO at %o>,,<
t4 > ; No last error; be helpful and die
%ermsg <%e at %o>,, <t4> ; Was an error; tell it
jrst %9b ] ; If she continues, tell her again
caie t1, (<erjmp>) ; 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, (<push p,>) ; Turn it into our first instruction
movem t4, 2(t2) ; and plop it into our routine
hrli t1, (<jrst>) ; 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 <t1, t2>, and
dmove t3, ut3 ; <t3, t4> 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 <t3> ; 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 <t1,t3> ; 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<n> and on the stack below them).
uaddr: saveac <t2,t3> ; 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<n>
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 <UUO package: you're trying to clobber .FP> ; Die
cain t3, p ; Is this our stack pointer friend?
%ermsg <UUO package: you're trying to clobber P> ; 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<n>
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 <descriptor char,,handler>;
; 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 <t1,t2,t3,t4> ; 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 <t1,t2,t3,t4> ; 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 <t1,t2,t3,t4> ; 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 <t1,t2,t3,t4> ; 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 <t1,t2,t3,t4> ; 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 <t1,t2,t3> ; 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 <t4> ; 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 <t1,t2> ; 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 <t1,t2>
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 <t1,t2,t3,t4> ; 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 <t1,t2,t3,t4> ; 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 <t1,t2,t3,t4> ; 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 <t1,t2,t3,t4> ; 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 <t1,t2,t3,t4> ; 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 <t1,t2,t4> ; 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 <t1,t2,t3,t4,q1> ; 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 <t1,t2,t3,t4> ; 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 <t1,t2,t3,t4> ; 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 <t1,t2,t4> ; 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 <t1,t2> ; Save work ac's
movx t2, "%" ; Get character to print
callret princh ; and go print it
; LBrack - print a left angle-bracket
lbrack: saveac <t1,t2> ; 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 <t1,t2> ; Save work ac's
movx t2, 076 ; Get character to print
callret princh ; and go print it
; FFeed - print a Form-Feed
ffeed: saveac <t1,t2> ; 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 <t1,t2> ; 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 <bpaddr> ; 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 <p,s> 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: