Trailing-Edge - PDP-10 Archives - decuslib20-11 - decus/20-192/cusym.mac
There are no other files named cusym.mac in the archive.
	Universal CUsym - Useful macros and definitions

	search monsym, macsym

Comment ~

    This file contains a whole set of symbol and macro definitions
to augment Monsym and Macsym.  Included are the standard register
definitions, macros for interfacing to the UUO package (which supports
standard I/O, simple uses of the COMND Jsys, etc.), and generally any
macro which has been found to be useful and which is missing from
Monsym and Macsym (a working knowledge of which is assumed).  NOTE:
you should have a good feel for the contents of MACSYM.MEM and the
DEC Macro coding standards document before using this package.

    A word about naming conventions: all names in this module are
of the form %symbol; this will hopefully sidestep any name conflicts
with a SEARCHing program.  DEC has reserved names with % and . in
them, but their use of % is restricted to other than the first char-
acter, so we're safe.  (Actually, a few of our Useful Symbols, below,
use a "." as their first character, which is also DEC-reserved,
but they're simple and few enough to cause no problems.)  Also,
a few of the 'hidden' symbols used herein (e.g., the stack, or global
symbols in the support package) begin with "%%".

					Chris Ryland
					CUCCA, June, 1978

Rewrote %cmTok so that the token string is in the same format as all
of the other argument strings for the UUOs.  (e.g. %cmTok <*>)

					Ken Rossman
					July, 1980
	subttl Register support

; Register definitions (conform to the DEC coding standard)
; These must be used exclusively, unless specifically redefined
; at the start of a module with the %DefAC macro (see below).

p=:17				; Stack pointer
cx=:16				; Call/Return temporary
.sac=:16			; CU/MacSym utility reg
f=:0				; Flag register (preserved)
t1=:1				; General temp and Jsys registers:
t2=:2				;  never preserved
t3=:3				;  ...
t4=:4				;
q1=:5				; First set of preserved regs
q2=:6				;  (must be preserved by callee
q3=:7				;   across a call)
p1=:10				; Second set of preserved regs
p2=:11				;  (ditto)
p3=:12				;
p4=:13				;
p5=:14				;
p6=:15				; NB: not useable with TrVar MacSym facility
.fp=:15				; Frame pointer for TrVar facility

; %DefAC
;    Define an alternate name for one of the registers; this macro should
; be used if any registers are re-defined, and the new definition should
; be made in terms of one of the definitions above.  This macro purges
; the old name, thus preventing multiple names for one register.

define %defac(new, old) <
      ifg old-15, <printx ? Invalid redefinition of AC old>
      ifl old-1,  <printx ? Invalid redefinition of AC old>
	purge old,old
	define old <%'old'%>
	subttl	Useful symbols

.prjfn=<.priin,, .priou>	; Symbol for usual primary JFN pair
.null==0			; General nothing value
.nil==0				; General nothing pointer
.True==1			; General boolean truth value
.False==0			;  and its complement

; Lengths of various Jsys control blocks; ommitted from MONSYM, sadly.

.acln==.acjob+1			; Length of ACCES arg block
.ckln==.ckapr+1			; Length of CHKAC arg block
.cmln==.cmgjb+1			; Length of Command State Block
.cmfln==.cmdef+1		; Length of Function Descriptor Block
.cdln==.cddac+1			; Length of CRDIR arg block
.cjln==.cjslo+1			; Length of CRJOB arg block
.jiln==.jistm+1			; Length of GETJI arg block
.gjln==.gjatr+1			; Length of (long form) GTJFN arg block
.ipln==.ipcas+1			; Length of ipcf packet descriptor block
.rsln==.rscre+1			; Length of SFTAD arg block
.rdln==.rdbkl+1			; Length of TEXTI arg block
	subttl UUO Package OPDEFs and Interface symbols

opdef %uprin [1b8]		; Print UUO
opdef %comnd [2b8]		; COMND interface UUO
opdef %ucmin [3b8]		; COMND initializer UUO
opdef %cmgfg [4b8]		; Get COMND flags UUO
opdef %cmgab [5b8]		; Get COMND atom buffer UUO
opdef %nuuo [6b8]		; Add-new-UUO UUO
opdef %cmres [7b8]		; COMND reset UUO
opdef %prPush [10b8]		; JFN-stack push (%print package) UUO
opdef %prPop [11b8]		; JFN-stack pop (ditto) UUO

; length of COMND interface UUO atom buffer:

%atmbl==^d250			; in characters

	extern %csb, %atomb	; command state block, for you hackers
	subttl	setup environment macros

; %SetUp & %SetEnv
;    %SetEnv is a macro that must be used as the first thing after your
; Title and Search CUsym statements; it sets up the CUsym, MonSym, and
; MacSym environments properly.  Its use is envisioned as:
;	title Baz - tweak the frob's runtime
;	search CUsym			; (No MAC: needed!)
;	%setenv				; Set up our environment
;	 ...
;    %SetUp is a macro that you should use as the first executable
; action in your program; it Resets the execution environment, sets up
; a stack, clears the flag register F, sets up for UUO calls, sets up for
; COMND parsing (resetting) (and starts off your code in %Pure mode).

define %setenv <
	search monsym,macsym
	.require sys:macrel	;; MacSym support package
	.request mac:curel	;; CUsym support package
	%.fbt.==1		;; Reset internal flag counter
	%%llst			;; Set up local label environment

define %setup(stksiz) <
	%pure			;; This is code
	setz f,			;; Clear all flags
	reset			;; Get world to known state
	%stack stksiz		;; Set up our stack
	call %%uuoi##		;; Set up for UUOs
	%cmres			;; Reset all COMND work
	subttl	Storage declaration macros

; %Pure, %Impure, %Routine
;    Use these macros to declare what sort of storage follows them: either
; %pure code (or read-only data) or %impure data (read-write).  Thus, before
; beginning a new logical section of code or data, always use one of them
; to declare what follows (if you don't use them, you may be surprised!).
; It goes without saying that %Pure should precede all code (which is NEVER
; impure).  Using this pair of macros is a good way of keeping impure data,
; which belongs to a routine, physically (on the written page, that is)
; together with the routine.
;    The alias %routine for %pure exists for purely mnemonic purposes; its
; use is suggested, as in:
;		%routine
;	openit:	stkvar	<fee,<foo,,5>>

define %pure <

define %impure <

define %routin <
	subttl	General-purpose macros

; %Stack
;    This macro creates the stack area, and loads P with the stack pointer.
; Its argument, the stack height, is optional, and defaults reasonably.

define %stack(length<200>) <

	array %%pdl [length]	;; Get a stack
	move p, [iowd length, %%pdl] ;; and set up our pdl pointer

; %Version
;    This macro builds a standard DEC version word from its arguments.
; In order, its arguments are the major version, the edit number, the
; minor version, and the customer version.  Omitted fields default to
; zero.

define %version(ver<0>, edit<0>, minor<0>, cust<0>) <
	exp  byte (3) cust  (9) ver  (6) minor  (18) edit

; %Clear
;    This macro takes three args, two of which are optional.  The first,
; non-optional, argument is the starting address of the area to be cleared.
; The next is the number of locations to clear, which defaults to one.
; The last argument is the desired filler, which defaults to zero.

define %clear (area, length, fill) <
   ifb <fill>, <setzm area>
   ifnb<fill>, <
	movx .sac, <fill>
	movem .sac, area
   if1, <ifnb <length>, <exp 0, 0, 0>>
   if2, <
      ifb <length>, <%%%clr==1>
      ifnb<length>, <%%%clr==<length>>
      ifg <%%%clr-1>, <
	   hrli .sac, area
	   hrri .sac, <1>+area
	   blt .sac, <%%%clr-1>+area
	subttl	macros used for common primary I/O

; Note that since these macros use %print, that any string argument
; shouldn't include `%'s, or things may get very confusing.
; Also note that %typnum's first argument, the address of the number,
; must conform to the %print argument standard (q.v.).

define %typecr(string) <
	%print <'string'%/>

define %crtype(string) <
	%print <%/'string'>

define %typnum(num, cols<0>, rdx<^d10>) <
	%print <%@d>, <
		exp [no%lfl!fld(cols,no%col)!fld(rdx,no%rdx)], num

define %crlf <
	%print <%/>

define %tab <
	%print <%_>
	subttl	Jsys support macros

; %JSerr
;    Macro to be used after a Jsys that either returns +1 on error or
; always returns +1 (i.e., all but two of the Jsysi); %JSerr types the
; user's error message (if given) or the Jsys error that caused it to
; be invoked (if no message is given); it then either halts (if no
; address is supplied) or goes to the address (if given).
; (Note: this is similar to the MacSym
; macro JSERR, but it only works after a Jsys, since it is invoked by
; an erjmp; %JSerr has the advantage, though, that it ALWAYS works
; after a Jsys, which JSERR doesn't.)
;    Note also that both %Jserr and %ErMsg, if they halt and are continued,
; will simply return to the point after the invocation of the %Jserr or
; %ErMsg.
;    Both of these macros, since they use %print, can produce customized
; error messages (eg, %jsErr <CUsym: Bad command %s [%e]>,,<ptrToS> will
; print an error-synchronized message, with a string argument and the
; monitor error message in brackets, and then halt).

define	%jserr (msg, addr, args) <
	 ercal [
   ifnb<msg>, <	%print <%?'msg'%/>, <args> > ;; Use his message if present
   ifb <msg>, <	%print <%?%e%/>	>	;; Else, just last error
   ifnb<addr>, <pop p, (p)		;; Finally, if asks, throw away
		jrst addr>		;;  return for ercal, and go there
   ifb <addr>, <HALTF			;; Else, just die quietly
		ret>			;;  and if continues, continue her code
			]		;; End of code

; %ErMsg
;    This macro, which, in contrast to %JSerr, is designed to be used in
; a non-Jsys skip context, will print a message (if given) or the last
; fork error (if not given); finally, it either jumps to an address (if
; given), or halts (if not given).  See %Jserr comments for more info.

define %ermsg (msg, addr, args) <
	 call [
   ifnb<msg>, <	%print <%?'msg'%/>, <args> > ;; Use his message if present
   ifb <msg>, <	%print <%?%e%/> >	;; Else, just last error
   ifnb<addr>, <pop p, (p)		;; Finally, if asks, throw away
		jrst addr>		;;  return address and go there
   ifb <addr>, <HALTF			;; If not, just die quietly; if
		ret >			;;  continues, return to after %error
			]		;; End of code
	subttl	Local Label support macros

; Local labels
;    The intent of this set of macros is to provide a facility usually
; available in good assemblers (hint, hint): local labels.  The idea,
; due to Knuth, is that instead of agonizing over choosing a label for
; each little local motion within some code, you simply plant one of
; nine local labels, of the form %N, and refer to the next local label
; %N by %NF, and the previous local label %N by %NB - a simple example
; of all this is:
;	some:	stkvar <from,to>
;		txne t1,gj%old		; Does he want an old file?
;		jrst %1f		; Yes, go handle it
;		txz t1,gj%fou		; No, reset this
;		setom from		;  and set 'from' flag
;	%1	call foo		; Continue with processing
;		 jrst %1b		; Failed: try it again
;		...			;  etc etc
;    These macros (internally) use symbols of the form %n% and %n%m,
; where n ranges from 1 to 9, and m from 0 to 777, so be wary.

define blll(list) <		;; Used to build all these macros
   irp list, <			;; for 1, 2, 3, ... 9
	blld(list)		;; Build %n macro
	bllf(list)		;; Build %nF macro
	bllb(list)		;; Build %nB macro
	purge blll, blld, bllf, bllb ;; Get rid of all these constructors

define blld(n) <		;; Build the %n macro
   define %'n<			;;  this it is
	%'n'%==%'n'%+1		;; Bump it to next
   ifg %'n'%-777, <printx %'n: used too much!>
%cat(%'n'%,\%'n'%):! >		;; Plant label of form %n%m (supp'ed)

define bllf(n) <		;; Build the %nF macro
   define %'n'F
      <%cat(%'n'%,\<%'n'%+1>)>	;; Just a ref to next local symbol

define bllb(n) <		;; Build the %nB macro
   define %'n'B
      <%cat(%'n'%,\%'n'%)>	;; Ref to previous local symbol

define %%llst	<		;; Local symbol initialize macro
>				;; (only called from %setenv)

; %Cat
;    Useful macro that just returns its two arguments (as text strings),
; concatenated.

define %cat(a,b) <a'b>

blll <1,2,3,4,5,6,7,8,9>	; Expand all these nice macros
	subttl COMND Jsys support macros

; %Ptr
;    Build a standard ASCIZ pointer to a literal string.

define %ptr(str)
   <<point 7, [asciz\str\]>>

; %Table
;    This macro is used to start a keyword table definition; suggested
; use is as in the following example (this also illustrates %key and
; %tbend):
; cmtb:	%table				; Keywords for frotz program
;	%key Mumble,domum,cm%inv	;  mumble command (invisible)
;	%key Noodle,donood		;  noodle command
;	%key Zork,dungeo		;  invoke dungeon command
;	%tbend				; End of this keyword table

define %table <
	%%tbst== .		;; Plant start of table
	exp 0			;;  and leave a hole for %tbend to fill

define %tbend <
	%%tbnd==.-1		;; Get address of last entry in table
	.org %%tbst		;; Move back to start
	xwd %%tbnd-%%tbst, %%tbnd-%%tbst;;  and build table header
	.org			;; Finally, get back to the way we were

; %Key
;    This macro takes three arguments: an (alphanumerics only!) name, the
; data to be associated with the name, and an (optional) flag value.  It
; creates either a flag-less keyword (the normal case), or, if flags are
; given, a keyword with flags in the first word (and cm%fw set).  Thus,
; the result is a TBLUK table entry, suitable for use by the .CMkey COMND
; Jsys function.  Note that all %Key words in a table must be bracketted
; by %Table and %TbEnd macros (see above).

define %key (name, data, flags) < ;; Flags are optional
   ifb <flags>, <
	xwd [asciz\name\],data	;; No-flags case
   ifnb<flags>, <
	xwd [<flags>!cm%fw	;; Flags: first word holds them,
	     asciz\name\], data	;;  second is start of name
; %Flddb
;    This macro is useful for building function descriptor blocks
; that don't contain just literal strings for the help and default
; components; otherwise, it's the same as the MONSYM flddb. macro.

define %flddb (typ, flgs, data, hlpm, defm, lst) <
	..xx==<fld(typ,cm%fnc)>+flgs+<z lst>
   ifnb<hlpm>, <..xx==cm%hpp!..xx>
   ifnb<defm>, <..xx==cm%dpp!..xx>
	exp ..xx
   ifnb<data>, <data>
   ifb <data>, <exp 0>
   ifnb<hlpm>, <hlpm>
   ifb <hlpm>, <ifnb <defm>, <exp 0>>
   ifnb<defm>, <defm>

; %Handlr, %PrsAdr, %EvlAdr
;   Macros to support structured parse/evaluation;  %Handlr builds a
; structure comprised of the parse routine address and evaluation
; routine address, for a given keyword (it should be in a literal in
; the %Key macro);  %PrsAdr and %EvlAdr are the DEFSTR structures
; for accessing these two elements of a structure, respectively.
;   An example of all this:
;	  :
;	%cmkey comtab, <command,> ; Get a top-level keyword
;	 %merrep restart, repars; Usual error handling
;	hrrz t2, (t2)		; Pick up data value from keyword
;	load t2, %evladr, (t2)	; Get evaluation routine
;	movem t2, evaler	; Save its address
;	load t2, %prsadr, (t2)	; Now, get parse routine
;	call (t2)		; And call it
;	 %jmerrep restart, repars, restart ; Handle errors
;	  :			; Continue
; ; Pure data for main parse
;	%table			; Main command table
;	%key bletch, [%handlr(bletcm, doblet)] ; Bletch mode
;	%key mumble, [%handlr(mumbcm, domumbl)] ; Mumble mode
;	%tbend
;	  :

define %handlr (p, e) <		; P: Parse routine, E: Eval routine
	xwd p, e

defstr %prsadr,0,17,18		; Parse routine address
defstr %evladr,0,35,18		; Evaluation routine address
; %CMxxx macros to invoke .CMxxx COMND functions.
; See CUUOS.DOC for information about using these.

define %cmini (prompt, flags, iojfn, gjfblk) <
	%ucmin [
   ifb <prompt>, <[%ptr(<>)]>
   ifnb<prompt>, <[%ptr<'prompt'>]>
   ifb <flags>,  <[.null]>
   ifnb<flags>,  <[flags]>
   ifb <iojfn>,  <[.prjfn]>
   ifnb<iojfn>,  <iojfn>
   ifb <gjfblk>, <[.null]>
   ifnb<gjfblk>, <[gjfblk]>

define %cmkey (keytab, help, defalt, flags) <
	%comnd [flddb. (.cmkey, flags, keytab,<help>,<defalt>)]

define %cmnum (radx, help, defalt, flags) <
	%comnd [flddb. (.cmnum, flags, radx,<help>,<defalt>)]

define %cmnoi (guide) <
	%comnd [flddb. (.cmnoi, ,%ptr(guide))]

define %cmswi (swtab, help, defalt, flags) <
	%comnd [flddb. (.cmswi, flags, swtab,<help>,<defalt>)]

define %cmifi (help, defalt, flags) <
	%comnd [flddb. (.cmifi, flags, ,<help>,<defalt>)]

define %cmofi (help, defalt, flags) <
	%comnd [flddb. (.cmofi, flags, ,<help>,<defalt>)]

define %cmfil (help, defalt, flags) <
	%comnd [flddb. (.cmfil, flags, ,<help>,<defalt>)]

define %cmfld (help, defalt, flags) <
	%comnd [flddb. (.cmfld, flags, ,<help>,<defalt>)]

define %cmcfm (help, flags) <
	%comnd [flddb. (.cmcfm, flags, ,<help>)]

define %cmdir (data, help, defalt, flags) <
	%comnd [flddb. (.cmdir, flags, data,<help>,<defalt>)]
define %cmusr (help, defalt, flags) <
	%comnd [flddb. (.cmusr, flags, ,<help>,<defalt>)]

define %cmcma (help, flags) <
	%comnd [flddb. (.cmcma, flags, ,<help>)]

define %cmflt (help, defalt, flags) <
	%comnd [flddb. (.cmflt, flags, ,<help>,<defalt>)]

define %cmdev (help, defalt, flags) <
	%comnd [flddb. (.cmdev, flags, ,<help>,<defalt>)]

define %cmtxt (help, defalt, flags) <
	%comnd [flddb. (.cmtxt, flags, ,<help>,<defalt>)]

; Note that the Time-and-Date flags belong to the first argument,
; since they're part of the data to the function.

define %cmtad (tadblk, help, defalt, flags) <
	%comnd [flddb. (.cmtad, flags, tadblk,<help>,<defalt>)]

define %cmqst (help, defalt, flags) <
	%comnd [flddb. (.cmqst, flags, ,<help>,<defalt>)]

define %cmuqs (brktab, help, defalt, flags) <
	%comnd [flddb. (.cmuqs, flags, brktab,<help>,<defalt>)]

; %CMtok - parse a token.  The token as given should be a string inside
; the usual '<>' delimiters, as in %cmtok <*>.

define %cmtok (token, help, defalt, flags) <
	%comnd [flddb. (.cmtok, flags, <%ptr<token>>,<help>,<defalt>)]

define %cmnux (radix, help, defalt, flags) <
	%comnd [flddb. (.cmnux, flags, radix,<help>,<defalt>)]

define %cmact (help, defalt, flags) <
	%comnd [flddb. (.cmact, flags, ,<help>,<defalt>)]

define %cmnod (help, defalt, flags) <
	%comnd [flddb. (.cmnod, flags, ,<help>,<defalt>)]
; Macros to help with error- and reparse-handling after a %CMxxx incantation.
;  %pret
;	Handle a parse error or reparse by just returning non-skip.
;  %errep errlab, replab
;	Handle an error by going to errlab, and a reparse by going to replab.
;  %merrep errlab, replab
;	Handle an error by giving an error message and going to errlab, and a
;	reparse by going to replab.	
; Macros to help with error- and reparse-handling after a parse
; subroutine call (which is expected to return skip on success, and
; non-skip on failure); three sorts of errors can be expected from
; such subroutines: parse error, reparse needed, other type of failure
; (usually a semantic problem).  Thus, these macros have three dispatch
; addresses, corresponding to these three errors.  Note that the method
; used here assumes that if neither the parse error or reparse flags
; are set in the command state block, then the error is of type `other'.
;  %jerrep errlab, replab, othrlb
;	Handle a skip-return error condition as described above.
;  %jmerrep errlab, replab, othrlb
;	Handle a skip-return error condition as described above,
;	printing an error message on a parse error.
; Note! t1 is clobbered by %errep, %merrep, %jerrep, %jmerrep.

define %pret <
	 erjmp r			;; Just return on error

define %errep (errlab, replab) <
	 erjmp [txne t1, cm%rpt	;; Was it a `reparse needed' error?
		 jrst replab	;; Yes, go handle
		jrst errlab ]	;; No, handle error instead
define %merrep (errlab, replab) <
	 erjmp [txne t1, cm%rpt	;; Was it a `reparse needed' error?
		 jrst replab	;; Yes, go handle
		%ermsg (,errlab) ] ;; No, give nasty message and go handle

define %jerrep (errlab, replab, othrlb) <
	 jrst [	%cmgfg t1	;; Get parse flags into t1
		txne t1, cm%rpt	;; Was it a `reparse needed' error?
		 jrst replab	;; Yes, go handle
		txne t1, cm%nop	;; No, was it a parse failure?
		 jrst errlab	;; Yes, handle it
		jrst othrlb ]	;; No, must be some other kind

define %jmerrep (errlab, replab, othrlb) <
	 jrst [	%cmgfg t1	;; Get parse flags into t1
		txne t1, cm%rpt	;; Was it a `reparse needed' error?
		 jrst replab	;; Yes, go handle
		txne t1, cm%nop	;; No, was it a parse failure?
		 %ermsg (,errlab) ;; Yes, give nasty message and go handle
		jrst othrlb ]	;; No, must be other sort of error
	subttl	Flag-handling macros

; General flag-handling:
;    All of the following flag-handling macros use register F, the preserved
; flag register.  F is assumed to be the flag register for any program that
; uses these macros.  Note that %SetUp clears F, thus initializing flag
; management.

; %Flags
;    This macro takes a list of flag names, and assigns a flag value to
; each name (within a 36-bit word). If more than 36 flags are defined in a
; program, it complains.

define %flags (fl) <
   irp fl, <
      ife %.fbt., <printx %Flags: flag 'fl': 37th flag!>
	fl==%.fbt.		;; Assign flag value
	%.fbt.==<%.fbt._1>	;; And set up for next flag

; %TrnOn & %TrnOff
;    These macros take a flag quantity (one or more flags ORed together),
; and turn them on or off, respectively (with no skipping).
; %TrOnS & %TrOfS
;    Like %TrnOn and %TrnOff, but skip always afterwards.
; %SkpOn & %SkpOff
;    These macros take a flag quantity, and will skip if ALL the flags are
; on or off, respectively.
; %AnyOn & %AnyOff
;    These macros take a flag quantity, and will skip if ANY of the flags
; are on or off, respectively.

define %trnon (flags) <
	txo f, <flags>

define %trnoff (flags) <
	txz f, <flags>

define %trOnS (flags) <
	txoa f, <flags>

define %trOfS (flags) <
	txza f, <flags>

define %skpon (flags) <
	call [	setcm f, f	;; Complement flags reg
		txnn f, <flags>	;; Are all on?
		 aos (p)		;; Yes, skip
		setcm f, f	;; No; restore flags
		ret ]

define %skpoff (flags) <
	txne f, <flags>

define %anyon (flags) <
	txnn f, <flags>

define %anyoff (flags) <
	call [	setcm f, f	;; Complement flags reg
		txne f, <flags>	;; Are any of the flags on?
		 aos (p)	;; (ie, any off?) yes, skip
		setcm f, f	;; No, but get back flags
		ret ]
	subttl CUuos (CUCCA utility UUOs) interface

; Formatted-print macro: output the arguments according to the format
; string.  %PrSkp returns skipping (+2 instead of +1, but handling
; a following erjmp/ercal properly).
; A note about arguments: the argument list is really nothing more
; than a sequence of addresses, so if you choose to use addressing
; forms such as address(index), be sure and use the <z address(index)>
; form so that macro will be happy with the address.  The same applies
; to address forms such as <z @(t1)>, etc.

define %print (fmt, arglst) <
	%uprint [
		point 7,[asciz ~'fmt'~]

define %prskp (fmt, arglst) <
	%uprint 1, [		; print, but return +2
		point 7,[asciz ~'fmt'~]

; Local modes:
; Comment Rounding:+1
; Mode:Macro
; Comment Start:; 
; End: