title k20mac - Kermit-20 DEFINE macro Implementation
	remark See end of file for history, motivations and notes

	subttl Preliminaries

	search monsym,macsym,cmd,k20unv
	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] ...

	remark cmd storage - all in cmd.mac

	extern cmdbln		; Command buffer length
	extern cmdbuf		; Command buffer
	extern sbk		; COMND% state block
	extern cjfnbk		; GTJFN% block for .cmfil,.cmifi,.cmofi
	extern atmbuf		; Atom buffer
	extern cmder1		; Error return allowing reparse

	remark Timing routines and storage found in K20TIM

	extern statim		; Start timing
	extern endtim		; End timing
	extern elptim		; Compute elapsed times
	extern ewallt		; Elapsed wall time structure
	extern durtim		; Print a time duration

	remark support routines

	extern isnulj		; Is this JFN pointing to NUL:?
	extern frclos		; Force a JFN to close
	extern crlf		; Carriage return line feed
	extern %%jser		; JSYS error handler
	extern errptr		; Error pointer
	extern .set2		; Linkage to SET command in K20MAK
	extern settab		; SET command table in K20PAR

	remark other external storage

	extern mytty		; My currently signed in line

	remark 			; Begin Module Code Proper

	.psect code/ronly	; Pure code, pure Heaven

	subttl DEFINE command parsing

; Moved here from K20PAR with certain portions substantially rewritten

	%table(defswi)			; Macro specific switches
emacro < %key2 <add>, .madd >		; Add a SET parameter to a macro
	%keyf3 <copy>,.dupli,cm%inv	;     What forgetful Tom types...
	%keyf3 <d>,%dupl,<cm%abr!cm%inv> ;Abbreviation of duplicate
	%keyf3 <delete>,.undef,cm%inv 	;     What forgetful Tom types...
%dupl:!	%key2  <duplicate>, .dupli	; Make a copy of a macro
emacro < %key2  <remove>, .mremo >	; Remove a macro's SET parameter
	%key2  <rename>, .renam		; Just change the macro's name
emacro < %key2  <replace>, .mrepl >	; Replace a macro's SET parameter
	%key2  <undefine>,.undef	; Remove the macro
	%tbend

.defin:	entry .defin		; Invoked by main parse in K20PAR
	saveac <q1>		; Just in case
	setzm tbent		; No keyword parsed
	guide <a SET macro named> ; Macro definition
	movei t1, [
	 flddb. .cmswi,,tabswi,<macro maintenance function,>,,[
	 flddb. .cmkey,,mactab,<old macro name to undefine or redefine,>,,[
	 flddb. .cmqst,,,<new macro name for combining SET options,>,,[
	 flddb. .cmfld,,,<new macro name for combining SET options, a single word>,,
	]]]]

	call rfield		; Get the macro name
	ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code.
	cain q1, .cmswi		; Table function?
	 callret tablem		; Hand off to table maintenance

; If this is an existing macro, there is no need to reinsert it

	caie q1, .cmkey		; A keyword (I.E., existing macro?)
	ifskp.			; It is, so just use it
	  movem t2, tbent	; Save the table entry
	  hlrz t1, (t2)		; Pull the address of the keyword
	  hrli t1, (point 7,0)	; Turn into a local pointer
	  movem t1, onamp	; This is the beginning of the string
	  jrst .defi5		; Skip accumulating the cruft
	endif.

; Doesn't appear to be existing, so let's take a snapshot of the atom buffer

	dmove t1, [ point 7,atmbuf   ; Source is the atom buffer
		    point 7,namatm ] ; Destination is a snapshot of it
	movem t2, onamp		; Beginning of candidate name stirng
	call asczcp		; Copy the ASCIZ string over
	movem t3, namlen	; Save the length of what we copied

; BUT!!  They might have put the keyword in double quotes, so check

	movei t1, mactab	; Load the address of the keyword table
	move t2, onamp		; Pointer to proposed macro name
	TBLUK%			; Go have a look
	 %jserr (,cmder1)	; Flame out, allow reparse

	ifxn. t2, tl%exm	; So does it make anything EXACTLY?
	  movem t1, tbent	; Save the table entry
	  hlrz t4, (t1)		; Pick up the keyword address
	  hrli t4, (point 7,0)	; Turn into a local pointer
	  movem t4, onamp	; This is the beginning of the string
	  movei q1, .cmkey	; Say we matched a keyword
	  jrst .defi5		; and skip accumulating cruft
	endif.

; Let them type CR here to undefine the macro, or else jump into the SET
; command parser to let them define a new macro, or redefine an old one.

.defi5:	caie q1, .cmkey		; Exists?
	ifskp.			; Yes, so different guidance
	  guide <to undefine or redefine> ; 
	else.			; Otherwise, doing it from scratch
	  guide <to SET>	; Prompt with guide words.
	endif.			; 

	move t1, sbk+.cmptr	; Get current pointer from comnd state block.
	movem t1, macptr	; Save it as pointer to macro body.

.defi6:	setom definf		; Flag that we're doing a DEFINE.
	movei t1, [flddb. .cmkey,,settab,,,] ; Assume defining
	cain q1, .cmkey
	 movei t1, [flddb. .cmcfm,,,<to undefine this macro,>,,[
		    flddb. .cmswi,,defswi,,,[
		    flddb. .cmkey,,settab,<a SET parameter,>,,]]] ; 
	call rfield		; Parse a keyword or a CR.
	ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code.
	setom undeff		; Assume we're undefining?
	caie t3, .cmswi		; Only uses switches to undefine
	ifskp.			; But must confirm the switch
	  hrrz t1, (t2)		; Pick up secondary parse
	  jrst (t1)		; And go there
	endif.

	cain t3, .cmcfm		; Parsed a CR?  (if so, then undefing)
	 ret			;  Yes, so done.

	setzm undeff		; No, we're defining after all.
	callret .set2		; Go parse SET commands.

	subttl DEFINE command execution

$defin:	entry $defin		; Invoked by K20PAR
	saveac <q1,q2,q3,q4>	; Needs some extra registers
	setzm definf		; Clear define flag
	skipe undeff		; Define or Undefine?
	 jrst $defi7		;  Undefine, go do that.

;[82]	remark Uncomment to Echo back what was typed...
;[82]	move t1, onamp		; Name
;[82]	PSOUT
;[82]	txmsg < = >
;[82]	move t1, macptr		; Text
;[82]	PSOUT

	move t1, macptr		; Load pointer to accumulated text
	move t2, [point 7,expatm] ; And a pointer to the macro text expansion buffer
	call asczcp		; Copy the ASCIZ string over
	movem t3, explen	; Save the length of what we copied

; Here to figure out if we have enough room before we try the insert.
; Assumes all initial pointers started out on word boundaries

; First, we'll do the name, checking to ensure that we are reusing an
; existing keyword, if it exists

	hrrz q1, onamp		; Load the macro name pointer
	caige q1, mactab	; Could be in the macro table?
	ifskp.			; Yes, let's check a little further
	  cail q1, macx		; But not off the end?
	anskp.			; Was outside, so must insert
	  setz q1,		; So no words here because reusing
	else.			; Not an existing keyword
	  move q1, namlen	; Load length of macro name candidate
	  move t2, [point 7,namatm] ; Load pointer to same
	  adjbp q1, t2		; Calculate the ending pointer
	  caie q1, 440700	; On a word boundary?
	   addi q1, ^d1		; No, round up a word
	  tlz q1, -1		; Shut off the pointer part
	  tlz t2, -1		; in both pointers
	  sub q1, t2		; Now have required words
	endif.			; Either way, something useful in t1

; Now the body or expansion, which is somewhat more straightforward

	move q2, explen		; Load length of macro expansion text
	move t2, [point 7,expatm] ; Load pointer to same
	adjbp q2, t2		; Calculate the ending pointer
	caie q2, 440700		; On a word boundary?
	 addi q2, ^d1		; No, round up a word
	tlz q2, -1		; Shut off the pointer part
	tlz t2, -1		; in both pointers
	sub q2, t2		; Now have required words

; Now see if we would go off the end

$defad:	move t1, macbp		; Load the current top of macro text
	tlz t1, -1		; Shut off pointer (assumes always a word boundary)
	add t1, q1		; Add in name length in words (if any)
	add t1, q2		; Add in macro body length in words
	cail t1, macx		; But not off the end?
	 %ermsg (<Macro definition will overflow macro table>,r)

; What about the TBLUK% table?  Is that full?

	hrrz t1, mactab		; Load maximum possible entries
	hlrz t2, mactab		; Load current entry count
	sub t1, t2		; See if any room
	ifle. t1		; Nothing left or phonkey?
	andg. q1		; And we're adding a keyword?
	  %ermsg (<Maximum number of macros already defined>,r)
	endif.

; OK, let's copy everything over (maybe)

	ife. q1			; Reusing a keyword?
	  hrrz q3, onamp	; Yes, get its address
	  hrrz t3, macbp	; Macro text goes directly in
	else.			; Otherwise, copy it in and use that
	  hrrz q3, macbp	; Use word address of keyword location
	  move t1, q1		; Number of words to copy
	  movei t2, namatm	; Source is the name that was in the atom buff
	  move t3, q3		; Destination in macro storage
	  xblt. t1		; And transfer it over
	endif.

	move t1, q2		; Load length of expansion
	movei t2, expatm	; Source is expansion or body text we got
	move q4, t3		; Begin storing where we left off
	xblt. t1		; And pop that over
	hrli t3, (point 7,0)	; Turn into a pointer on a WORD boundaru
	movem t3, macbp		; And store as new top of storage

; Finally either tweak the table or add the entry

	ife. q1			; Existing keyword?
	  skipe t1, tbent	; Do we already have it?
	  ifskp.		; No, go get find it
	    movei t1, mactab	; Yes, let's find the entry
	    hrroi t2, (q3)	; Pointer to keyword that was matched
	    TBLUK%		; See if it's in there (better be!)
	     %jserr (<Search failure for existing macro>,r)
	    ifxe. t2, tl%exm	; Not there?
	      emsg <Could not find the existing macro, "> ;" font crock mode
	      hrroi t1, atmbuf	; Point at what we were looking for
	      PSOUT%		; Type what we got told was in there
	      txmsg <"> 	;" font crock mode
	      hrroi t1, crlf	; Tie off the line
	      PSOUT%
	      ret		; Nothing further we can do, so leave
	    endif.		; End case looking for the macro name
	  endif.		; End case already have the table offset
	  hrrm q4, (t1)		; Stomp in address of new body
	  ret			; That's it, really
	endif.			; End case replacing macro body

; Otherwise, add <address of macro name,,address of body> to macro keyword table.

	movei t1, mactab	; Stick it in the macro table.
	hrlz t2, q3		; Address of keyword,,
	hrr t2, q4		;  argument (address of body)
	TBADD%			; Inserting it should always work
	 %jserr (<Error storing new macro>,r) ; Must have missed a case, above
	ret

	subttl /UNDEFINE processing

; Come here directly to undefine an existing macro.
; First look it up.  We should ALWAYS find it because we don't come
; here unless we had a keyword match in the first place.

$defi7:	skipe t2, tbent		; Do we already have the keyword?
	ifskp.			; No, go get it
	  movei t1, mactab	; Yes, look up its address in the kwd table.
	  move t2, onamp	; Pointer to macro name.
	  TBLUK%		; See if it's in there (should be)
	   %jserr (<Could not find a macro name that was just parsed>,r)
	  ifxe. t2, tl%exm	;[194] Found an exact match?
	    txmsg <% ">		;[194] ;" No, warn.
	    move t1, onamp
	    PSOUT
	    txmsg < " not found in SET macro table> ;[194] ;" Font crock
	    ret
	  endif.		;[194] 
	  move t2, t1		; The address we just got.
	endif.			; End case didn't already have entry

; Using the table index just obtained, delete the entry.

	movei t1, mactab
	remark t2,		; Either already had it or found it
	TBDEL%			; Delete the old entry.
	 %jserr (<Could not delete a macro name that was just found>,r)
	ret	

	subttl /UNDEFINE parsing

.undef:	confrm			; Confirm the line
	ret			; Done

	remark The reason there is no $UNDEF

; Since the macro has no body, the default action is to remove it.  Thus,
; /UNDEFINE doesn't really do anything other than function as a kind of
; 'syntactic sugar'.

	subttl /DUPLICATE parsing

.dupli:	guide <to a new SET macro named> ; Macro definition
	movei t1, [
	 flddb. .cmqst,,,<new macro name for existing macro,>,,[
	 flddb. .cmfld,,,<new macro name for existing macro, a single word>,,
	]]

	call rfield		; Get the macro name
	dmove t1, [ mactab	; Load the address of the keyword table
	    point 7, atmbuf ]	; And a pointer to the atom buffer
	TBLUK%			; See if it's in there (shouldn't be)
	 %jserr (,cmder1)	; Fail, allow a ^H

	ifxn. t2, tl%exm	; Found an exact match?
	  emsg <The requested new macro name, "> ;" font crock mode
	  hrroi t1, atmbuf	; Point to the atom buffer
	  PSOUT%		; Type the new name which won't work
	  txmsg <" already exists> ;" font crock mode
	  jrst cmder1		; Allow ^H
	endif.

	dmove t1, [point 7, atmbuf  ; Load pointer to new keyword
		   point 7, namatm] ; And a pointer to the macro name buffer
	call asczcp		; Copy the ASCIZ string over
	movem t3, namlen	; Save the length of what we copied

	confrm			; Tie off the line

	movei t1, [.dupli,,$dupli] ;Load our own semantic action
	movem t1, pars1		; Stomp top-level parse, we're taking it from here
	ret			; Return into /DUPLICATE semantic action

	subttl /DUPLICATE semantic action

$dupli:	saveac <q1,q2,q3,q4>	; MUST have same register usage as $defin!! 
	skipe q4, tbent		; Already have the table address?
	ifskp.			; No, go find it
	  movei t1, mactab	; Load the address of the keyword table
	  move t2, onamp	; And the keyword text pointer
	  TBLUK%			; See if it's in there (should be)
	   %jserr (<Error finding the macro name to duplicate>,r)
	  ifxe. t2, tl%exm	; Found an exact match?
	    emsg <Could not find the "> ;" No, bomb
	    hrroi t1, namatm	; Point at what we should have found
	    PSOUT%		; Type it
	    txmsg <" macro in order to duplicate it>
	    hrroi t1, crlf	; Tie off the line
	    PSOUT%
	    ret			; Get out of here
	  else.			; Otherwise, found something
	    move q4, t1		; Save the table entry
	  endif.		; End case looking for the keyword
	endif.			; End case already had it

; Now the calculate the size in words of the new keyword

	move q1, namlen		; Load length of macro expansion text
	move t2, [point 7,namatm] ; Load pointer to same
	adjbp q1, t2		; Calculate the ending pointer
	caie q1, 440700		; On a word boundary?
	 addi q1, ^d1		; No, round up a word
	tlz q1, -1		; Shut off the pointer part
	tlz t2, -1		; in both pointers
	sub q1, t2		; Now have required words

; Take a copy of the expansion text for the macro

	hrrz t1, (q4)		; Get address of text
	hrli t1, (point 7,0)	; Now have our source
	move t2, [ point 7, expatm ] ; Put it in as new expansion
	call asczcp		; Copy the ASCIZ string over
	movem t3, explen	; And store the length

; And figure out how long that was in words

	move q2, t3		; Put the length where $defad wants it
	move t2, [ point 7, expatm ] ; Point to base of expansion
	adjbp q2, t2		; Calculate the ending pointer
	caie q2, 440700		; On a word boundary?
	 addi q2, ^d1		; No, round up a word
	tlz q2, -1		; Shut off the pointer part
	tlz t2, -1		; in both pointers
	sub q2, t2		; Now have required words

; Join $defad at the point of adding something

	callret $defad		; And just add every
	ret

	subttl /REMOVE parsing

emacro <

.mremo:	remark need to parse for the set parameter here
	confrm			; Tie off the line

	movei t1, [.mremo,,$mremo] ;Load our own semantic action
	movem t1, pars1		; Stomp top-level parse, we're taking it from here
	ret			; Return into /RENAME semantic action

>;;emacro

	subttl /REMOVE semantic action

emacro <

$mremo:	saveac <q1,q2,q3,q4>	; Needs a lot of registers

	skipe q4, tbent		; Already have the table address?
	ifskp.			; No, go find it
	  movei t1, mactab	; Load the address of the keyword table
	  move t2, onamp	; And the keyword text pointer
	  TBLUK%			; See if it's in there (should be)
	   %jserr (<Error finding the macro name to edit>,r)
	  ifxe. t2, tl%exm	; Found an exact match?
	    emsg <Could not find the "> ;" No, bomb
	    hrroi t1, namatm	; Point at what we should have found
	    PSOUT%		; Type it
	    txmsg <" macro in order to remove from it>
	    hrroi t1, crlf	; Tie off the line
	    PSOUT%
	    ret			; Get out of here
	  else.			; Otherwise, found something
	    move q4, t1		; Save the table entry
	  endif.		; End case looking for the keyword
	endif.			; End case already had it

	remark			; Toss anything in the macro editor
	seto t1,			; Case IV, deleting process memory
	dmove t2, [ .fhslf,,medpg	; This process, page number of medit psect
	    pm%cnt!fld(edpgs,pm%rpt) ]	; Number of pages to toss
	PMAP%				; Trim our working set
	 %jserr (<Reset unable to remove macro editing pages>,) ; Odd... but continue

	remark			; Set up editing table prototype
	xmovei t3, medorg	; Load base of .psect
	dmove t1, [ 0,,MACMAX	; TBLUK% table has no entries now
			0  ]	; Stomp the 2nd location, just in case
	dmovem t1, (t3)		; Now have an empty table
	xmovei q3, MACMAX+1(t3)	; Now have top of macro text editing area
	dmove t1, q3		; Load information for splitter
	call csplit		; Split the text into keyword names and data	
>;;emacro

	subttl Takes a pointer to macro text and splits it up with COMND%

; t1/	Top of editing area to stash things
; t2/	TBLUK% entry of existing macro

;N.B., assumes editing area is zeroed!!

emacro <

csplit:	saveac <q1, q2, q3, q4>
	move q3, t1		; Save top of macro insertion
	hrli q4, (point 7,0)	; Build a section local pointer
	hrr q4, (t2)		; Get address of macro text

	do.			; Enter loop context
	  call splini		; Initialize for parsing from string
	  move q2, t2		; Put the CMDBUF pointer in a safe place
	  call prepar		; Prepare to parse
	  jumpe t1,endlp.	; Done at end of string
	  move q1, t1		; Save it
	  call dopair		; Do a set pair
	  cain q1, .chlfd	; Line Feed?
	   exit.		; Yes, last command in text
	  loop.			; Next pair
	enddo.			; Exit loop lexical context

	call splfix		; Fix the CSB up
	ret			; Done

>;;emacro

	subttl Do a SET paramater-value pair

; N.B., might not just be a pair, could be secondary parsing
;
; Maybe put the .sigio stuff in when debugging?  Gives real nasty
; error because we can't trap it.

emacro <

ccrlf:	point 7, crlf
	-^d2

dopair:	saveac <q1,q2>		; Needs to save a few things

	move q1, sbk+.cmioj	; Load current input and output JFN pair
	hrli t1, .sigio		; Set to blow up on a read
	hrr t1, q1		; Let it blat if it wants to
	movem t1, sbk+.cmioj	; Set up our trick wire

	movei t1, [ flddb. .cmkey,,settab ]
	call rflde		; Parse just the SET keyword
	 %ermsg (<Unrecognized SET keyword in macro text>,r) ; Leave
	ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code.
	move q2, t2		; Keep selected item safe

	hlro t1,(q2)		; Show parameter name (keyword
	psout%
	call csbinf		; Maybe type out interesting CSB stuff
	hrrz t4, (q2)		; Get parser and action for parameter valud
	hlrz t1, (t4)		; This is the parser portion

	setom definf		; Fake we're defining
	call (t1)		; Parse the rest of something
	setzm definf		; Out of phoney define

	move t1, q1		; Load saved in and out JFN pair
	movem t1, sbk+.cmioj	; Restore to the SBK

	hrroi t1, atmbuf	; Point to what we parsed
	PSOUT%
	call csbinf
	
	hrroi t1, crlf
	psout
	ret

>;;emacro

	subttl Display Useful CSB Information

emacro <

csbinf:	skipg t4, sbk+.cminc	; Anything left to parse?
	ifskp.			; It appears so
	  cain t4, ^d1		; One dinky character?
	anskp.			; Yep; don't let's bother with that
	  movei t1, .priou	; Going to terminal
	  movei t2, .chtab	; Space over
	  BOUT%			; Do it
	   erjmps .+1		; Catch and suppress error
	  move t2, t4
	  movei t3, ^d10
	  NOUT%
	   erjmps .+1		; Catch and suppress error
	  movei t2, ","		; Quote it to be sure
	  BOUT%			; Do it
	  movei t2, "'"		; Quote it to be sure
	  BOUT%			; Do it
	   erjmps .+1		; Catch and suppress error
	  move t2, sbk+.cmptr	; Point to rest of text
	  movn t3, t4		; Counted SOUT%
	  SOUT%			; See what's left
	   erjmpr .+1		; Catch and ignore error
	  movei t2, "'"		; Quote it to be sure
	  BOUT%			; Do it
	   erjmps .+1		; Catch and suppress error
	  movei t2, .chtab	; Space over
	  BOUT%			; Do it
	   erjmps .+1		; Catch and suppress error
	else.			; Otherwise, just tab over
	  movei t1, .chtab	; Space over
	  PBOUT%
	  PBOUT%
	endif.
	ret	
>;;emacro

	subttl .SIGIO Input handler

emacro <
; N.B., This code doesn't work.  It will *NEVER* work unless a
;    significant change is made to Tops-20.
;
;    .SIGIO is unfortunately hard wired to be multiplexed on channel
;    19 (along with address break), which is Inferior Fork Termination
;    (.ICIFT).  Tops-20 very reasonably does not allow a fork to catch
;    its own termination.
;
;    I would have thought a more obvious approach would have been to
;    implement .SIGIO in a similar fashion to the .TICTI/.TICTO
;    terminal codes (interrupt on type-in/output detected), the
;    difference being that if you didn't handle .SIGIO, it's goes
;    'upstairs' like other panic channels.
;
;    For debugging, using .SIGIO still helps because if you mess up
;    the pointers in the CSB, then the fork will terminate and you can
;    investigate with DDT instead of going into a terminal wait.

repeat 0,<			; See above, can't use this, ever
	extern pc3		; Globalized in K20SUB

sitrap:	intern sitrap		; K20SUB needs the address in CHNTAB

	aos sintn		; Count a signal just because ...
	push p, t1		; Save an accumulator
	push p, t2		; And another one
	push p, t3		; One more!!!

	move t1, pc3		; Pick up our interrupted location
	ifxe. t1, pc%usr	; We are only breaking out of a JSYS
	  hrrz t2, t1		; PC is where the JSYS will return
	  subi t2, ^d1		; So fix it to look at the JSYS
	  hllz t3, (t2)		; Isolate the left half word
	  txz t3, 777		; Want just the opcode
	  came t3, [ COMND% ]	; Trying to parse something?
	anskp.			; Nope, we're done
	  txo t1, pc%usr	; Force user mode
	  movem t1, pc3		; Change DEBRK% action
	  movx t1, cm%nop	; Force a parse failure
	else.			; Otherwise, leave everything alone
	  setz t1,		; And no flag fix up
	endif.

sitepi:	pop p, t3		; Signal trap epilogue
	pop p, t2		; Restores ac2 and ac3 immediately
	orm t1, (p)		; Or in any flags before restore
	pop p, t1		; Restore modified or unmodified

	DEBRK%			; Done
>;;End Repeat 0
>;;emacro

	subttl Turn .sigio interrupts on and off

emacro <
repeat 0,<			; See above, will never work
	extern sigchb		; Defined in K20SUB

dosigh:	.fhslf			; This process
	sigchb			; .SIGIO channel bit

tsigon:	dmove t1, dosigh	; Turn on the signal I/O handler
	AIC%			; Enable to catch it
	 %jserr (<Unable to enable I/O signaling>,) ; Odd, but carry on
	ret

sigoff:	dmove t1, dosigh	; Turn off the signal I/O handler
	DIC%			; Enable to catch it
	 %jserr (<Unable to disable I/O signaling>,) ; Odd, but carry on
	ret
>;;End Repeat 0
>;;emacro

	subttl COMND% Command State Block Initialization/Fix Up

emacro <
splini:	remark			; Split initialization
	remark			; Tweak the csb to parse from string
	dmove t2,[point 7,cmdbuf ;Point to beginning of command buffer
		   cmdbln*5  ]	; Max characters in command buffer
	dmovem t2, sbk+.cmptr	; Stomp both in; beginning of parse
	setzm sbk+.cminc	; No unparsed characters, yet...
	ret

splfix:	remark			; Done parsing, fix the CSB back up
	dmove t1,[point 7,cmdbuf ;Point to beginning of command buffer
		   cmdbln*5  ]	; Max characters in command buffer
	dmovem t1, sbk+.cmptr	; Stomp both in; nothing left to parse
	setzm sbk+.cminc	; No unparsed characters anymore
	setzb t1, t2		; Cons up ten .CHNUL's
	dmovem t1, cmdbuf	; Scrub the command buffer an itty bit
	hllm t1, sbk		; Zero the CSB flags.
	ret

>;;emacro

	subttl Prepare CSB and CMDBUF to parse from string

; Expects
;
;  q4/	Pointer to macro text
;  q2/	Pointer to command buffer
;
; Returns:
;
; t1/	Terminating character
;
;	CMDBUF filled
;	CSB conditioned

emacro <

prepar:	do.			; Enter loop context
	  ildb t1, q4		; Get a character from the macro text
	  jumpe t1, endlp.	; Exit routine on end of string
	  cain t1, .chcrt	; A carriage return?
	   movei t1, .chlfd	; Turn into what COMND% wants ...
	  idpb t1, q2		; Copy the character into the command buffer
	  aos sbk+.cminc	; Account for character to be parsed
	  sos sbk+.cmcnt	; Account for character storage used
	  cain t1, .chlfd	; A line feed?
	   exit.		;  Last command on line
	  cain t1, ","		; Hit a comma?
	   exit.		;  Yes, SET pair seperator
	  loop.			; Process next character
	enddo.			; End loop lexical context

	ret			; And done
>;;emacro

	subttl msplit - Takes a macro text and splits it up

; t1/	Top of editing area to stash things
; t2/	TBLUK% entry of existing macro
;
; First attempt, abandoned for using COMND% based approach
;
;N.B., assumes editing area is zeroed!!

emacro <
repeat 0,<
msplit:	saveac <q1, q2, q3, q4>
	move q3, t1		; Save top of macro insertion
	hrli q4, (point 7,0)	; Build a section local pointer
	hrr q4, (t2)		; Get address of macro text

	do.			; Enter main loop context
	  move q1, q3		; This will be a SET keyword
	  hrrz t2, q1		; Pointer starts there
	  hrli t2, (point 7,0)	; Build a section local pointer
	  setz t3,		; No beginning of keyword, yet
	  do.			; Enter keyword identification loop
	    ildb t1, q4		; Pick up a byte of keyword
	    block.		; Enter block context for easier control flow
	      jumpe t1, rskp	; End of string?  That's odd
	      cain t1, .chspc	; Space?
	       retskp		;  End of keyword
	      cain t1, .chtab	; Tab?
	       retskp		;  End of keyword
	      cain t1, .chlpa	; Left parenthesis?
	       retskp		; COMND% will break on that
	      ret		; None of the above
	    endbk.		; Exit block context
	    ifskp.		; Hit a break character
	      jumpn t3, endlp.	; If started significance, this a break, so leave
	      loop.		; Nope, swallow it and get another
	    else.		; Otherwise, signicant
	      idpb t1, t2	; Deposit in keyword area
	      aoja t3, top.	; Flag start of significance
	    endif.
	  enddo.		; End keyword indentification loop
	  ife. t1		; Should not hit end of string after keyword
	    move t1, q3		; Load updated top of text area
	    ret			; And stop
	  endif.
	  caie t2, 440700	; On a word boundary?
	   addi t2, ^d1		; No, round up a word
	  hrrz q2, t2		; This will be the SET parameter
	  move q3, q2		; Also new top of storage
	  setzb t3, t4		; Haven't seen any characters, yet
	  do.			; Enter value identification loop
	    ildb t1, q4		; Pick up a byte of keyword
	    block.		; Enter block context for easier control flow
	      cain t1, .chspc	; Space?
	       retskp		;  Reset value length counter
	      cain t1, .chtab	; Tab?
	       retskp		;  Reset value length counter
	      cain t1, .chrpa	; Right parenthesis?
	       retskp		;  Reset value length counter
	      ife. t1		; .chnul??
	        seto t4,	; Flag end of keyword value
	        ret		; But count it
	      endif.
	      caie t1, ","	; Value terminator?
	      ifskp.		; Yes, we have the value for this keyword
	        seto t4,	; Flag end of keyword value
	        ret		; But count it
	      endif.
	      ret		; Some other character, count it
	    endbk.		; End block context
	    ifskp.		; +2 means hit a seperator character
	      setz t3,		; Reset the counter
	      loop.		; And get another character
	    else.		; Otherwise, count towards a keyword
	      jumpn t4, endlp.	; Break loop on end of keyword value
	      aoja t3, top.	; Count the character and loop
	    endif.		; End of block exit handling
	  enddo.		; End search loop
	  ife. t3		; Never found a value?
	    addi q3, ^d1	; Leave a word of .chnul's
	  else.			; Otherwise have to play with pointers
	    move t1, q2		; Destination is top of storage
	    hrli t1,(point 7,0)	; Turn into a word based pointer
	    movn t2, t3		; Load negatve keyword length
	    subi t2, ^d1	; Don't copy the comma or .chnul
	    adjbp t2, q4	; Back up to beginning of keyword
	    do.			; And copy the keyword over
	      ildb t4, t2	; Pick up a byte from macro text
	      idpb t4, t1	; And put into edit area
	      sojg t3, top.	; Do all of them
	    enddo.
	    caie t1, 440700	; Ended on a word boundary?
	     addi t1, ^d1	; No, round up a word
	    hrrz q3, t1		; Set new top of storage
	  endif.

	  movei t1, medorg	; Address of keyword table
	  hrlz t2, q1		; Load address of keyword text
	  hrr t2, q2		; Identified value
	  TBADD%		; Cross our fingers and insert
	   %jserr (<Unable to insert SET keyword and value>,) ;Carry on
	  ldb t1, q4		; Load stopping character
	  jumpe t1, endlp.	; End of macro text, done
	  loop.			; Look for next keyword value pair
	enddo.			; End of split loop

	move t1, q3		; Load updated top of text area
	ret
>;;repeat 0
>;;emacro

	subttl /RENAME parsing

.renam:	guide <to a new SET macro named> ; Macro definition
	movei t1, [
	 flddb. .cmqst,,,<new macro name for existing macro,>,,[
	 flddb. .cmfld,,,<new macro name for existing macro, a single word>,,
	]]

	call rfield		; Get the new name for the macro

	dmove t1, [ mactab	; Load the address of the keyword table
	    point 7, atmbuf ]	; And a pointer to the atom buffer
	TBLUK%			; See if it's in there (shouldn't be)
	 %jserr (,cmder1)	; Fail, allow a ^H

	ifxn. t2, tl%exm	; Found an exact match?
	  emsg <The requested new macro name, "> ;" font crock mode
	  hrroi t1, atmbuf	; Point to the atom buffer
	  PSOUT%		; Type the new name which won't work
	  txmsg <" already exists> ;" font crock mode
	  jrst cmder1		; Allow ^H
	endif.

	dmove t1, [point 7, atmbuf  ; Load pointer to new keyword
		   point 7, namatm] ; And a pointer to the macro name buffer
	call asczcp		; Copy the ASCIZ string over
	movem t3, namlen	; Save the length of what we copied

	confrm			; Tie off the line

	movei t1, [.renam,,$renam] ;Load our own semantic action
	movem t1, pars1		; Stomp top-level parse, we're taking it from here
	ret			; Return into /RENAME semantic action

	subttl /RENAME semantic action

$renam:	saveac <q1,q2,q3,q4>	; Doesn't link with $define
	skipe q4, tbent		; Do we already have the keyword address?
	ifskp.			; Nope, go get it
	  movei t1, mactab	; Load the address of the keyword table
	  move t2, onamp	; And the keyword text pointer we started with
	  TBLUK%		; See if it's in there (it betterbe)
	   %jserr (<Error finding the macro name to rename>,r)
	  ifxe. t2, tl%exm	; Found an exact match?
	    emsg <Could not find the "> ;" No, bomb
	    hrroi t1, namatm	; Point at what we should have found
	    PSOUT%		; Type it
	    txmsg <" macro in order to duplicate it>
	    hrroi t1, crlf	; Tie off the line
	    PSOUT%
	    ret			; Get out of here
	  else.			; Otherwise, have something
	    move q4, t1		; Save the table entry
	  endif.		; End case looking for macro name
	endif.			; End case already had the keyword address

; Calculate the size of the new macro name in words

	move q1, namlen		; Load length of macro name in characters
	move t2, [point 7,namatm] ; Load pointer to same
	adjbp q1, t2		; Calculate the ending pointer
	caie q1, 440700		; On a word boundary?
	 addi q1, ^d1		; No, round up a word
	tlz q1, -1		; Shut off the pointer part
	tlz t2, -1		; in both pointers
	sub q1, t2		; Now have required words to transfer new name

; But!! Would putting it in the table take us over the end?

	move t1, macbp		; Load the current top of macro text
	tlz t1, -1		; Shut off pointer (its always a word boundary)
	add t1, q1		; Add in the new name's length in words
	cail t1, macx		; Not off the end, I hope?
	 %ermsg (<Macro definition will overflow macro table>,r)

; Ok, so safe to pop the name into the macro table

	hrrz q3, macbp		; Use word address of keyword location
	move t1, q1		; Number of words to copy
	movei t2, namatm	; Source is the name that was in the atom buffer
	move t3, q3		; Destination is in macro storage
	xblt. t1		; And transfer it over
	hrli t3, (point 7,0)	; Turn final address into a word aligned pointer
	movem t3, macbp		; Set new top of macro storage

; Now build the TBLUK% table entry to insert

	hrlz q2, q3		; Keyword is what we just copied in
	hrr q2, (q4)		; But the macro text remains the same

; First, remove the old keyword so we don't have to check the table entry count

	movei t1, mactab	; Load the address of the macro table
	move t2, q4		; And the address of the keyword entry
	TBDEL%			; Remove (should always work since just found it)
	 %jserr (<Rename can not remove previous macro name>,r) ;??

; Finally insert ours; should work because previously checked

	movei t1, mactab	; Load the address of the macro table
	move t2, q2		; And our new keyword entry
	TBADD%			; Enter it in the TBLUK% table
	 %jserr (<Rename can not add the new macro name>,r)

	ret

	subttl DEFINE macro table maintenance functions

; Begin code insertion

	%table(tabswi)			; Table maintenance switches
	%key3 <compact>, .mcomp, $mcomp	; Garbage collect
	%key3 <dump>, .mdump, $mdump	; Write a macros in binary format
	%keyf4 <intialize>, .mrese, $mrese, cm%inv ; (sleepy Tom...)
	%key3 <map>, .mmap, $mmap	; Directly use macros from binary file
	%key3 <reset>, .mrese, $mrese	; Whack everything
	%key3 <save>, .msave, $msave	; Save macros in ASCII format
	%key3 <summary>, .msumm, $msumm	; Summary of table usage
	%tbend

tablem:	hrrz t4, (t2)		; Get the command routine addresses.
	movem t4, pars1		; Stomp top-level parse, we're taking it from here
	hlrz t1, (t4)		; Get the syntax routine
	callret (t1)		; Call it and carry on

	subttl Parse the /DUMP switch

; Tries for a device first as this is more efficient for NUL: and
; catches more errors earlier and more easily.

; Default command filespec fields for .CMFIL:

dmpbk:	gj%flg!gj%fou!gj%new!fld(.gjnhg,.rhalf)  ; .GJGEN
	.priin,,.priou		; .GJSRC (ignored if COMND%)
	0			; .GJDEV (do not default the device)
	0			; .GJDIR (do not default the directory)
	0			; .GJNAM (do not default the name)
	eascii (<BIN>)		; .GJEXT (default extension is .BIN)
	0			; .GJPRO (use system default protection)
	0			; .GJACT (use job's current account)
dmpbkl==<.-dmpbk>		; Length of this GTJFN argument block.

.mdump:	saveac <q1,q2,q3,q4>	; Protect some registers
	movx t1, cz%ncl!.fhslf	; Release non-open JFN's on reparse
	CLZFF%
	 erjmpr .+1		; Catch and ignore errors
	guide <macros to binary file>
	move t1, [dmpbk,,cjfnbk] ; Insert our file parsing defaults.	
	blt t1, cjfnbk+dmpbkl

	movei t1, [		; Catch bare device
	    flddb. .cmfil,,,<binary file to save macros to>,,[
	    flddb. .cmdev,cm%sdh,,,,]]
	call rfield		; Ask them to supply the file
	ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code.
	move q2, t2		; Save parsed data (device or JFN)

	move t1, q2		; Load parse item for DVCHR%
	caie q1, .cmdev		; Typed a bare device?
	 tlz t1, -1		; Shut off flags so DVCHR% doesn't choke
	DVCHR%			; and find out about it
	 %jserr (<Unable to determine characteristics of dump argument>,r)
	ldb q3, [pointr t2, dv%typ] ; Pick up the device type

	caie q1, .cmdev		; Typed a bare device?
	ifskp.			; Yes, see what it is
	  caie q3, .dvnul	; NUL:?
	  ifskp.		; Yes, we can simulate that
	    confrm		; Confirm the selection
	    movx t1,<gj%gnd!gj%giv!.nulio> ;Use special designator and flags
	    movem t1, pars2	; Store the JFN and (phoney) flags
	    ret			; Done with this special case
	  endif.		; Any other device is NOT VALID

	  caie q3, .dvdsk	; Bare device?
	  ifskp.		; Yes, but needs a file name
	    emsg <The >		; First part of blat
	    move t2, q2		; Load whatever we parsed
	    movei t1, .priou	; Output to the terminal
	    DEVST%		; Write the device name into the AC's
	     %jserr (<Unable to translate ouput device designator>,cmder1)
	    sxtext (t1,<: structure needs a file specification>)
	    PSOUT%		; Finish the informative blat
	    jrst cmder1		; Allow reparse
	  endif.		; Any other device is NOT VALID

	  jrst .mdmpe		; Otherwise, handle as a general parse error
	endif.			; End case .cmdev

	remark .cmfil		; Everything else is a file

	caie q3, .dvnul		; A JFN on NUL:??
	ifskp.			; Yes, we can simulate that
	  confrm		; Confirm the selection
	  move t1, q2		; Load parsed JFN
	  call isnulj		; Convert it to a special JFN, releasing original
	   ermsg% (<Unable to convert a known NUL: JFN>,cmder1) ; Allow ^H
	  movem t1, pars2	; Store the JFN and original parse flags
	  ret			; Done with this second special NUL: case
	endif.

	caie q3, .dvdsk		; Was this a structure?
	 jrst .mdmpe		; No, any other device is NOT VALID

	confrm			; Otherwise, fine; confirm selection
	movem q2, pars2		; Store the JFN and flags
	ret			; Done with the parse

	remark Here for common parse errors

.mdmpe:	emsg <The >		; Begin whining
	movei t1, .priou	; Output to terminal, always
	caie q1, .cmdev		; Device?
	ifskp.			; Yes, use DEVST%
	  move t2, q2		; Load whatever we parsed
	  DEVST%		; Write the device name into the AC's
	   %jserr (<Unable to translate device designator>,cmder1)
	else.			; Otherwise, DEVST% will choke on the JFN
	  hrrz t2, q2		; Load just the JFN
	  dmove t3, [		; Just want the device name, no punctuation
		fld(.jsaof,js%dev)
		0  ]		; No odd prefix, whatever that is
	  JFNS%			; Convert to something readable
	   %jserr (<Unable to translate JFN based device designator>,cmder1)
	endif.			; Either way, error should be more informative

	txmsg <: device does not have binary dumping capabilities>
	hrroi t1, crlf		; Newline
	PSOUT%			; Tie off the blat
	 erjmpr .+1		; Catch and ignore that error, too

	caie q1, .cmfil		; Had we parsed a file, actually?
	ifskp.			; Yes, then have a little clean up to do
	  hrrz t1, q2		; Load our poor JFN, sans flags
	  RLJFN%		; Toss it; can't use it
	   erjmpr cmder1	; Ignore error and beat it
	endif.

	jrst cmder1		; Allow ^H

	subttl Execute the /DUMP switch

$mdump:	saveac <q1,q2,q3,q4>	; Wants a few accumulators

	move q1, pars2		; Load the JFN and flags
	hrrz t1, q1		; Look at just the JFN
	cain t1, .nulio		; Special cased?
	ifskp.			; No, have to really open the file
	  movx t2, <fld(^d36,of%bsz)!fld(.gsnrm,of%mod)!of%wr>
	  OPENF%		; Try to create the file
	   %jserr (<Unable to create binary file, failing>,$mdmpe)
	endif.			; End case file not on NUL:

	subttl Set up to dump the macros into binary file

; N.B., Although the mapping direction seems non-intuitive here,
; what's actually happening is that we are reserving space in the
; output file to populate as we will.  If we don't touch a page, it
; won't exist in the file, effectively showing up as a 'hole'.

	remark PMAP% Case IV: deleting process memory
	seto t1,			; Don't want anything in gc .psect
	dmove t2, [ .fhslf,,gcpag	; This process, page number of gc psect
	    pm%cnt!fld(gcpgs,pm%rpt) ]	; Number of pages to toss
	PMAP%				; Kick them all into oblivion
	 %jserr (<Unable to pre-condition mapping area, failing>,$mdmpe)

	remark PMAP% Case I: Mapping File Pages to a Process
	hrlz t1, q1			; 'Input' file, page zero
	camn t1, [.nulio,,0]		; NUL:?
	ifskp.				; No, do the page map for real
	  dmove t2, [ .fhslf,,gcpag	; This process, page number of gc psect
	    pm%wr!pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to reserve
	  PMAP%				; And get ready to drop data into them
	   %jserr (<Unable to condition mapping area, failing>,$mdmpe)
	endif.				; End setting up a real file

	remark				; Set up loop context
	remark q1,			; Has JFN and flags
	movx q2, gcpgs			; Load pages in table psect

	dmove q3, [ macorg		; Source is the macros .psect
		    gcorg ]		; Destination is garbage collection .psect

	subttl Loop to map out pages appropriately

	do.				; Enter loop context
	  move t1, q3			; Load current macros address
	  lsh t1, -^d9			; Turn into a page number
	  hrli t1, .fhslf		; This process
	  RPACS%			; Find out what's in there
	  ifje. r			; Catch and ignore error
	    setz t2,			; Assume the page doesn't exist
	  endif.
	  ifxn. t2, pa%pex		; Does the page exist?
	  andxn. t2, pa%rd		; *AND* ... Can we read it?
	    movei t1, ^d512		; Yep, load the eternal page size
	    dmove t2, q3		; Load source and destination address
	    xblt. t1			; And put into the macros psect
	  endif.
	  sojle q2, endlp.		; Exit when nothing left to do
	  dadd q3, [exp ^d512,^d512 ]	; Step to next set of addresses
	  loop.
	enddo.				; Exit loop lexical context

	remark				; Loop exit post processing

	remark PMAP% Case IV: deleting process memory (but not really)
	seto t1,			; Don't want anything in gc .psect
	dmove t2, [ .fhslf,,gcpag	; This process, page number of gc psect
	    pm%cnt!fld(gcpgs,pm%rpt) ]	; Number of pages to remove
	PMAP%				; Kick them all over to DDMP
	 %jserr (<Unable to flush binary pages to disk>,$mdmpe)

	remark Binary file Epilogue

	hrrz t1, q1			; Load the file JFN
	cain t1, .nulio			; NUL:?
	ifskp.				; No, a real file
	  txo t1, co%nrj		; Keep the JFN
	  CLOSF%			; Close the file, mostly
	   %jsErr (<Unable to close binary dump file>, $mdmpe)
	  hrli t1, .fbsiz		; Set the number of macros as bytes
	  seto t2,			; Changing all the bits in the word
	  hlrz t3, mactab		; Load current macro count
	  CHFDB%			; Set that for the curious
	   %jsErr (<Unable to set macro count of binary dump file>,)
	  hrrz t1, q1			; Load the JFN one last time
	  RLJFN%			; And toss it
	   %jsErr (<Unable to release ouput binary dump file JFN>,)
	endif.				; End case not NUL:

	txmsg <Wrote: >
	callret $msumm			; Give us some summary information
	remark ret			; $msumm returns for us

	subttl Error handling

$mdmpe:	remark				; Here to handle errors
	seto t1,			; Case IV, deleting process memory
	dmove t2, [ .fhslf,,gcpag	; This process, page number of gc psect
	    pm%cnt!fld(gcpgs,pm%rpt) ]	; Number of pages to toss
	PMAP%				; Trim our working set
	 %jserr (<Binary map unable to clean up gargage collector>,)

	skipe t1, q1			; Didn't have a JFN?
	 call frclos			;  We did, go get rid of it
	  nop				; Ignore any goofy error
	ret				; Done

	subttl Parse the /MAP switch

; Tries for a device first as this is more efficient for NUL: and
; catches more errors earlier and more easily.

; Default command filespec fields for .CMFIL:

mapbk:	gj%flg!gj%old		; Must be existing file.
	repeat 4,<0>		; Normal defaults for dev:<dir>name.
	eascii (<BIN>)		; Default extension is .BIN.
	0			; Default protection,
	0			;  and account.
mapbkl==<.-mapbk>		; Length of this GTJFN argument block.

.mmap:	saveac <q1,q2,q3,q4>	; Protect some registers
	movx t1, cz%ncl!.fhslf	; Release non-open JFN's on reparse
	CLZFF%
	 erjmpr .+1		; Catch and ignore errors
	guide <binary macros file>
	move t1, [mapbk,,cjfnbk] ; Insert our file parsing defaults.	
	blt t1, cjfnbk+mapbkl

	movei t1, [		; Catch bare device
	    flddb. .cmfil,,,<Kermit binary macro file to read>,,[
	    flddb. .cmdev,cm%sdh,,,,]]
	call rfield		; Ask them to supply the file
	ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code.
	move q2, t2		; Save parsed data (device or JFN)

	move t1, q2		; Load parse item for DVCHR%
	caie q1, .cmdev		; Typed a bare device?
	 tlz t1, -1		; Shut off flags so DVCHR% doesn't choke
	DVCHR%			; and find out about it
	 %jserr (<Unable to determine characteristics of map argument>,r)
	ldb q3, [pointr t2, dv%typ] ; Pick up the device type

	caie q1, .cmdev		; Typed a bare device?
	ifskp.			; Yes, see what it is
	  caie q3, .dvnul	; NUL:?
	  ifskp.		; Yes, we can simulate that
	    confrm		; Confirm the selection
	    movx t1,<gj%gnd!gj%giv!.nulio> ;Use special designator and flags
	    movem t1, pars2	; Store the JFN and (phoney) flags
	    ret			; Done with this special case
	  endif.		; Any other device is NOT VALID

	  caie q3, .dvdsk	; Bare device?
	  ifskp.		; Yes, but needs a file name
	    emsg <The >		; First part of blat
	    move t2, q2		; Load whatever we parsed
	    movei t1, .priou	; Output to terminal
	    DEVST%		; Write the device name into the AC's
	     %jserr (<Unable to translate input device designator>,cmder1)
	    emsg <: structure needs a file specification>
	    jrst cmder1		; Allow reparse
	  endif.		; Any other device is NOT VALID

	  jrst .mmape		; Handle as a general parse error
	endif.			; End case .cmdev

	remark .cmfil		; Everything else is a file

	caie q3, .dvnul		; A JFN on NUL:??
	ifskp.			; Yes, we can simulate that
	  confrm		; Confirm the selection
	  move t1, q2		; Load parsed JFN
	  call isnulj		; Convert it to a special JFN, releasing original
	   ermsg% (<Unable to convert a known NUL: JFN>,cmder1) ; Allow ^H
	  movem t1, pars2	; Store the JFN and original parse flags
	  ret			; Done with this second special NUL: case
	endif.

	caie q3, .dvdsk		; Was this a structure?
	 jrst .mmape		; No, any other device is NOT VALID

	confrm			; Otherwise, fine; confirm selection
	movem q2, pars2		; Store the JFN and flags
	ret			; Done with the parse

	remark Here for common parse errors

.mmape:	emsg <The >		; Begin whining

	movei t1, .priou	; Output to terminal, always
	caie q1, .cmdev		; Device?
	ifskp.			; Yes, use DEVST%
	  move t2, q2		; Load whatever we parsed
	  DEVST%		; Write the device name into the AC's
	   %jserr (<Unable to translate device designator>,cmder1)
	else.			; Otherwise, DEVST% will choke on the JFN
	  hrrz t2, q2		; Load just the JFN
	  dmove t3, [		; Just want the device name, no punctuation
		fld(.jsaof,js%dev)
		0  ]		; No odd prefix, whatever that is
	  JFNS%			; Convert to something readable
	   %jserr (<Unable to translate JFN based device designator>,cmder1)
	endif.			; Either way, error should be more informative

	txmsg <: device does not have binary mapping capabilities>
	hrroi t1, crlf		; Newline
	PSOUT%			; Tie off the blat
	 erjmpr .+1		; Catch and ignore that error, too

	caie q1, .cmfil		; Had we parsed a file, actually?
	ifskp.			; Yes, then have a little clean up to do
	  hrrz t1, q2		; Load our poor JFN, sans flags
	  RLJFN%		; Toss it; can't use it
	   erjmpr cmder1	; Ignore error and beat it
	endif.

	jrst cmder1		; Allow ^H

	subttl Execute the /MAP switch

$mmap:	saveac <q1,q2,q3,q4>	; Wants a few accumulators
	setzb q1, q2		; Zero local JFN and input file size (pages)

	move q1, pars2		; Load the JFN and flags
	hrrz t1, q1		; Look at just the JFN
	cain t1, .nulio		; Special cased?
	 jrst $mmapn		;  Yes, go do it

	subttl Set up and check to map a real binary file

	SIZEF%			; Find out about the file
	 %jserr (<Binary map unable to determine file size>,r) ; Go no further
	jumpe t2, $mmapn	; No macros written?  Assume empty, then
	jumpe t3, $mmapn	; Empty file?  Treat as NUL: case
	
	caile t2, macmax	; Too many macros?
	 %ermsg (<Too many macros in binary file, ignoring>,$mmape)
	caile t3, macpgs	; Too large?
	 %ermsg (<Binary file is too large, ignoring>,$mmape)
	move q2, t3		; Save binary file size (in pages)
				; Read-Only, force open even if PMAP%'ed
	movx t2, <fld(^d36,of%bsz)!fld(.gsnrm,of%mod)!of%rd!of%rdu>
	OPENF%			; Try to open the file
	 %jserr (<Unable to open binary file, ignoring>,$mmape)
	
	remark PMAP% Case IV, deleting process memory
	seto t1,			; Don't want anything in gc .psect
	dmove t2, [ .fhslf,,gcpag	; This process, page number of gc psect
	    pm%cnt!fld(gcpgs,pm%rpt) ]	; Number of pages to toss
	PMAP%				; Kick them all into oblivion
	 %jserr (<Unable to condition mapping area, ignoring>,$mmape)

	remark PMAP% Case IV, deleting process memory
	seto t1,			; Don't want anything in macros .psect
	dmove t2, [ .fhslf,,macpag	; This process, page number of macros psect
	    pm%cnt!fld(macpgs,pm%rpt) ]	; Number of pages to toss
	PMAP%				; Kick them all into oblivion
	 %jserr (<Unable to condition macro area, resetting all macros>,$mmapi)

	remark PMAP% Case I: Mapping File Pages to a Process
	hrlz t1, q1			; File JFN, starting from page zero
	movx t2, <.fhslf,, gcpag> 	; Put them into the *garbage collection* area
	move t3, q2			; Get page count
	caie t3, ^d1			; Only a single page?
	 txo t3, pm%cnt			;  No, turn on repeat (slower, even for 1 page)
	txo t3, pm%rd!pm%pld		; Get them all in fast
	PMAP%				; And do the I/O
	 %jserr (<Unable to map binary macros, resetting all macros>,$mmapi)

	subttl Loop to copy pages appropriately

; Do we have to check the file page if there's nothing there or the memory?

	move t4, q2			; Load size as a count
	dmove q3, [ gcorg		; Source is garbage collection .psect
		    macorg ]		; Destination is the macros .psect

	do.				; Enter loop context
	  move t1, q3			; Load current gc address
	  lsh t1, -^d9			; Turn into a page number
	  hrli t1, .fhslf		; This process
	  RPACS%			; Find out what's in there
	  ifje. r			; Catch and ignore error
	    setz t2,			; Assume the page doesn't exist
	  endif.
	  ifxn. t2, pa%pex		; Does the page exist?
	  andxn. t2, pa%rd		; *AND* ... Can we read it?
	    movei t1, ^d512		; Yep, load the eternal page size
	    dmove t2, q3		; Load source and destination address
	    xblt. t1			; And put into the macros psect
	  endif.
	  sojle t4, endlp.		; Exit when nothing left to do
	  dadd q3, [exp ^d512,^d512 ]	; Step to next set of addresses
	  loop.				; And go around again
	enddo.				; Exit loop lexical context

	remark Binary input file Epilogue
	
	remark Toss the file pages we mapped into the garbage collector
	dmove t1, [ -1			; Case IV, deleting process memory
		    .fhslf,,gcpag ]	; This process, page number of gc psect
	move t3, q2			; Get page count
	caie t3, ^d1			; Only a single page?
	 txo t3, pm%cnt			;  No, turn on repeat (slower, even for 1 page)
	PMAP%				; Get rid of them so we can close the file
	 %jserr (<Binary map unable to unmap file>,) ; Odd... but carry on
	skipn iniflg##			;[237] Don't blat if starting up
	 call $msumm			; Give us some summary information

	remark $mmape			; Falls through to close the JFN

	subttl Error handling, NUL: mapping special case and Initialization

$mmape:	remark			; Here if some other error
	skipe t1, q1		; Didn't have a JFN?
	 call frclos		;  We did, go get rid of it
	  nop			; Ignore any goofy error
	ret			; But leave the current macro table alone

$mmapn:	call $mmapi		; Whack everything (types summary)
	call $mmape		; Toss any JFN's
	ret			; That was easy enough

$mmapi:	remark			; Here to initialize for mapping
	call $mrese		; Whack the macros .psect
	remark			; Toss anything in garbage collector
	seto t1,			; Case IV, deleting process memory
	dmove t2, [ .fhslf,,gcpag	; This process, page number of gc psect
	    pm%cnt!fld(gcpgs,pm%rpt) ]	; Number of pages to toss
	PMAP%				; Trim our working set
	 %jserr (<Binary map unable to remove gargage collector>,) ; Odd... but continue
	ret			; Done

	subttl Here to whack all the macros

	remark parse the rest of /RESET

.mrese:	confrm			; Just confirm
	ret			; Then return so we can get on with it


	subttl Execute the /RESET

$mrese:	seto t1,			; Case IV, deleting process memory
	dmove t2, [ .fhslf,,macpag	; This process, page number of macros psect
	    pm%cnt!fld(macpgs,pm%rpt) ]	; Number of pages to toss
	PMAP%				; Kick them all into oblivion
	ifje. r			; Failed??
	  move t4, t1		; Save the error code
	  movx t1, maclen-1	; Whack the buffer the old fashioned way
	  setzm macorg		; Stomp the first location to zero
	  dmove t2, [ macorg	; Then transfering the first word
		      macorg+1 ] ;To the second
	  xblt. t1		; It's turtles all the way down!
	   nop			; Ignore the error, we're trying hard enough
	  %ermsg (<Couldn't remove macro pages, so zeroed them>,)
	endif.			; Not promising, but carry on

	setzm onamp		; No previous pointer
	dmove t1, [ 0,,MACMAX	; TBLUK% table has no entries now
			0  ]	; Stomp the 2nd location, just in case
	dmovem t1, mactab	; Now have an empty table
	move t1,[point 7, macbuf] ; Point to beginning of macro storage
	movem t1, macbp		; Stomp into the new table
emacro <
	remark			; Toss anything in the macro editor
	seto t1,			; Case IV, deleting process memory
	dmove t2, [ .fhslf,,medpg	; This process, page number of medit psect
	    pm%cnt!fld(edpgs,pm%rpt) ]	; Number of pages to toss
	PMAP%				; Trim our working set
	 %jserr (<Reset unable to remove macro editing pages>,) ; Odd... but continue
>;; emacro
	remark $msumm		; They can do a /summary
				;   if they want to know
	ret

	subttl Parse the /SAVE switch

; Tries for a device first as this is more efficient for NUL: and
; catches more errors earlier and more easily.

; Default command filespec fields for .CMFIL:

savbk:	gj%flg!gj%fou!gj%new!fld(.gjnhg,.rhalf)  ; .GJGEN
	.priin,,.priou		; .GJSRC (ignored if COMND%)
	0			; .GJDEV (do not default the device)
	0			; .GJDIR (do not default the directory)
	0			; .GJNAM (do not default the name)
	eascii (<CMD>)		; .GJEXT (default extension is .CMD)
	0			; .GJPRO (use system default protection)
	0			; .GJACT (use job's current account)
savbkl==<.-savbk>		; Length of this GTJFN argument block.

.msave:	saveac <q1,q2,q3,q4>	; Protect some registers
	movx t1, cz%ncl!.fhslf	; Release non-open JFN's on reparse
	CLZFF%
	 erjmpr .+1		; Catch and ignore errors
	guide <macros to ASCII file>
	move t1, [savbk,,cjfnbk] ; Insert our file parsing defaults.	
	blt t1, cjfnbk+savbkl

	movei t1, [		; Catch bare device
	    flddb. .cmfil,,,<file to write macros to>,,[
	    flddb. .cmdev,cm%sdh,,,,]]
	call rfield		; Ask them to supply the file
	ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code.
	move q2, t2		; Save parsed data (device or JFN)

	move t1, q2		; Load parse item for DVCHR%
	caie q1, .cmdev		; Typed a bare device?
	 tlz t1, -1		; Shut off flags so DVCHR% doesn't choke
	DVCHR%			; and find out about it
	 %jserr (<Unable to determine characteristics of SAVE argument>,r)
	move q4, t1		; Store the device designator 
	ldb q3, [pointr t2, dv%typ] ; Pick up the device type

	caie q1, .cmdev		; Typed a bare device?
	ifskp.			; Yes, see what it is
	  caie q3, .dvtty	; A terminal?
	  ifskp.		; Yes, maybe show the user what we'd write
	    hrrz t1, q4		; Load the terminal number
	    camn t1, mytty	; Not mine?
	    ifskp.		; Nope, disallow it
	      emsg <You are not logged into >
	      movei t1, .priou	; Text is coming out on the terminal
	      move t2, q2	; Load the device designator
	      DEVST%		; Convert device to string
	       %jserr (<Unable to convert parsed device to string>,r)
	      txmsg <:>
	      jrst cmder1	; Allow ^H
	    endif.
	    confrm		; Confirm the selection
	    movx t1,<gj%gnd!gj%giv!.priou> ;Use special designator and flags
	    movem t1, pars2	; Store the JFN and (phoney) flags
	    ret			; Done with this special case
	  endif.		; Any other device is NOT VALID

	  caie q3, .dvnul	; NUL:?
	  ifskp.		; Yes, we can simulate that
	    confrm		; Confirm the selection
	    movx t1,<gj%gnd!gj%giv!.nulio> ;Use special designator and flags
	    movem t1, pars2	; Store the JFN and (phoney) flags
	    ret			; Done with this special case
	  endif.		; Any other device is NOT VALID

	  caie q3, .dvdsk	; Bare device?
	  ifskp.		; Yes, but needs a file name
	    emsg <The >		; First part of blat
	    move t2, q2		; Load whatever we parsed
	    movei t1, .priou	; Output to the terminal
	    DEVST%		; Write the device name into the AC's
	     %jserr (<Unable to translate ouput device designator>,cmder1)
	    sxtext (t1,<: structure needs a file specification>)
	    jrst cmder1		; Allow reparse
	  endif.		; Any other device is NOT VALID

	  jrst .msve		; Otherwise, handle as a general parse error
	endif.			; End case .cmdev

	remark .cmfil		; Everything else is a file

	caie q3, .dvtty		; A JFN on a terminal?
	ifskp.			; Yes, maybe show the user what we'd write
	  hrrz t1, q4		; Load the terminal number
	  came t1, mytty	; Mine?
	  ifskp.		; Yep
	    hrrz t1, q2		; Load the JFN
	    RLJFN%		; Punt it, we won't be using it
	     erjmpr .+1		; Just strange...
	  else.			; Nope, disallow it
	    emsg <You are not logged into >
	    movei t1, .priou	; Text is coming out on the terminal
	    hrrz t2, q2		; Load just the JFN
	    dmove t3, [		; DEVST% will choke on a JFN...
	      fld(.jsaof,js%dev) ;Just want the device name, no punctuation
		0  ]		; No odd prefix, whatever that is
	    JFNS%		; Convert to something readable
	     %jserr (<Unable to translate JFN based terminal designator>,cmder1)
	    txmsg <:>
	    hrrz t1, q2		; Load the JFN
	    RLJFN%		; Chuck it, we can't use it
	     erjmpr .+1		; Just strange...
	    jrst cmder1		; Allow ^H
	  endif.

	  confrm		; Confirm the selection
	  movx t1,<gj%gnd!gj%giv!.priou> ;Use special designator and flags
	  movem t1, pars2	; Store the JFN and (phoney) flags
	  ret			; Done with this special case
	endif.			; Any other terminal is NOT valid

	caie q3, .dvnul		; A JFN on NUL:??
	ifskp.			; Yes, we can simulate that
	  confrm		; Confirm the selection
	  move t1, q2		; Load parsed JFN
	  call isnulj		; Convert it to a special JFN, releasing original
	   ermsg% (<Unable to convert a known NUL: JFN>,cmder1) ; Allow ^H
	  movem t1, pars2	; Store the JFN and original parse flags
	  ret			; Done with this second special NUL: case
	endif.

	caie q3, .dvdsk		; Was this a structure?
	 jrst .msve		; No, any other device is NOT VALID

	confrm			; Otherwise, fine; confirm selection
	movem q2, pars2		; Store the JFN and flags
	ret			; Done with the parse

	remark Here for common parse errors

.msve:	emsg <The >		; Begin whining

	movei t1, .priou	; Output to terminal, always
	caie q1, .cmdev		; Device?
	ifskp.			; Yes, use DEVST%
	  move t2, q2		; Load whatever we parsed
	  DEVST%		; Write the device name into the AC's
	   %jserr (<Unable to translate device designator>,cmder1)
	else.			; Otherwise, DEVST% will choke on the JFN
	  hrrz t2, q2		; Load just the JFN
	  dmove t3, [		; Just want the device name, no punctuation
		fld(.jsaof,js%dev)
		0  ]		; No odd prefix, whatever that is
	  JFNS%			; Convert to something readable
	   %jserr (<Unable to translate JFN based device designator>,cmder1)
	endif.			; Either way, error should be more informative

	txmsg <: device is not valid for saving macros>
	hrroi t1, crlf		; Newline
	PSOUT%			; Tie off the blat
	 erjmpr .+1		; Catch and ignore that error, too

	caie q1, .cmfil		; Had we parsed a file, actually?
	ifskp.			; Yes, then have a little clean up to do
	  hrrz t1, q2		; Load our poor JFN, sans flags
	  RLJFN%		; Toss it; can't use it
	   erjmpr cmder1	; Ignore error and beat it
	endif.

	jrst cmder1		; Allow ^H

	subttl Execute the /SAVE switch

; Not that fast.  If you want fast, use /DUMP

$msave:	saveac <q1,q2,q3,q4>	; Wants a few accumulators

	hlrz q2, mactab		; Load the macro count
	ife. q2			; BUT!!  Anything to save, really?
	  txmsg <% No macros to save
>				; Give a mild scolding
	  jrst $msve		; And go flush the JFN
	endif.

	move q1, pars2		; Load the JFN and flags
	hrrz t1, q1		; Look at just the JFN
	cain t1, .nulio		; Special cased?
	ifskp.			; No, we're going to have to open it
	  cain t1, .priou	; Unless it is primary output
	anskp.			; It is, don't bother
	  movx t2, <fld(^d7,of%bsz)!fld(.gsnrm,of%mod)!of%wr>
	  OPENF%		; Try to create the file
	   %jserr (<Unable to create save file>,$msve)
	endif.

	remark t1,		; Either way, t1 has something SOUT% can use
	setz t4,		; For uncounted SOUT%, always stop on a NUL
	movei q3, mactab+1	; Start at the beginning of the table

	do.			; Enter loop context
	  dxtext (t2,<define >)	; Issue the command (NOTE TRAILING SPACE!!)
	  SOUT%			; Start out with that
	   %jserr (<Unable to write initial define>,$msve)
	  hlrz t2, (q3)		; Address of macro name
	  hrli t2, (point 7,0)	; Turn into a section local pointer
	  setz t3,		; Uncounted, stop on a NUL
	  SOUT%			; Write that
	   %jserr (<Unable to write macro name>,$msve)
	  movei t2, .chspc	; Seperate macro name and body
	  BOUT%			; Emit the space
	  hrrz t2, (q3)		; Address of macro body
	  hrli t2, (point 7,0)	; Turn into a section local pointer
	  setz t3, 		; Uncounted, stop on a NUL
	  SOUT%			; Write that
	   %jserr (<Unable to write macro body>,$msve)
	  remark		; All have CRLF
	  sojle q2, endlp.	; At end?  Then stop
	  aoja q3, top.		; Otherwise, do next table entry
	enddo.			; End loop lexical context

	cain t1, .nulio		; Not writing to NUL:?
	ifskp.			; Nope, then we should have a byte count
	  cain t1, .priou	; Unless it's primary output
	anskp.			; That won't have one, either
	  RFPTR%		; See how much we've written
	   %jsErr (<Unable to read size of save file>, $msve)
	  move q3, t2		; Save the (non-negative) byte count
	  CLOSF%		; Completely close the (disk) file
	   %jsErr (<Unable to close save file>, $msve)
	else.			; Neither NUL: nor TTY: will have byte counts
	  seto q3,		; Flag that
	endif.
	
	txmsg <Wrote: >
	movei t1, .priou	; Typing to terminal
	hlrz t2, mactab		; Number of macros
	movei t3, ^d10		; All numbers are in base ten
	move t4, t2		; Save the count
	NOUT%
	 erjmps +1		; Catch and suppress error
	txmsg < macro>		; Assume singular
	cain t4, ^d1		; BUT!  Non-plural or zero?
	ifskp.			; Nope, have to inflect because we're grammatical
	  movei t1, "s"		; Pluralizer
	  PBOUT%		; Properly inflect
	   erjmps +1		; Catch and suppress error
	endif.

	ifge. q3		; Could we count the data?
	  txmsg <, >		; Yes, so type it
	  movei t1, .priou	; Typing to terminal
	  move t2, q3		; Number of characters written
	  NOUT%
	   erjmps +1		; Catch and suppress error
	  txmsg < character>	; Assume singular
	  cain t4, ^d1		; BUT!  Non-plural or zero?
	  ifskp.		; Nope, have to inflect because we're grammatical
	    movei t1, "s"	; Pluralizer
	    PBOUT%		; Properly inflect
	     erjmps +1		; Catch and suppress error
	  endif.
	endif.

	hrroi t1, crlf		; Tie off the line
	PSOUT%

	ret			; Finally done

	subttl Error handling

$msve:	remark				; Here to handle errors
	skipe t1, q1			; Didn't have a JFN?
	 call frclos			;  We did, go get rid of it
	  nop				; Ignore any goofy error
	ret				; Done

	subttl Provide summary information

.msumm:	confrm			; Tie off the line
	ret

$msumm:	txmsg <Macros: >
	movei t1, .priou	; This terminal
	hlrz t2, mactab		; Load macro keyword table entries
	move t4, t2		; Tuck that away for later
	movei t3, ^d10		; It's in base ten
	NOUT%			; Type it
	 %jserr (,)		;  Dubious, but carry on
	txmsg < used, >
	movei t1, .priou	; This terminal
	hrrz t2, mactab		; Load maximum macro keyword table entries
	sub t2, t4		; Yields remaining
	NOUT%			; Type that
	 %jserr (,)		;  Sigh... Carry on
	txmsg < remaining.
Available storage: >
	call $mchrs		; Get us some other table numbers
	move t2, t1		; Load total storage
	move t4, t1		; Save a copy
	movei t1, .priou	; This terminal
	movei t3, ^d10		; Base ten
	NOUT%			; Convert to external and display
	 erjmpr .+1		; Catch and ignore error
	txmsg < character>	; Assume (rare) singular case)
	movei t1,"s"		;[203] Load inflection
	caie t4,^d1		;[203] Singular case?
	 PBOUT%			;[203]  No, must inflect it

	hrroi t1, crlf
	PSOUT%
	ret

	subttl Provide some table information to caller

; Returns:
;
;  t1/	characters available in macro table

$mchrs:	entry $mchrs		; Called by k20dsp
	saveac <t2,t3>		; Be extra tidy

	movei t1, macx		; Load end of macro table
	move t2, macbp		; Load end of macro expansions
	hlrz t3, t2		; Load the byte pointer
	caie t3, 440700		; On a word boundary?
	 addi t2,^d1		; No, round up a word
	tlz t2, -1		; Shut off the byte pointer
	sub t1, t2		; Calculate remaining words
	imuli t1, ^d5		; Have total characters
	ret

	subttl Garbage collection

	remark Parsing

.mcomp:	confrm			; Tie off the line
	ret			; Then get going on processing

	remark Semantic action

	extern ehptim		; Display elapsed processor ticks

$mcomp:	remark			; Garbage collection prologue
	saveac <q1,q2,q3,q4>	; Will need some registers for control
	txmsg <Before: >	; Set up for some blat
	call $msumm		; Display macro table usage

	call statim		; Record start time garbage collection run
	movx t1, .hprnt		; Request current CPU time used
	HPTIM%			; by this process
	 %jserr (,r)		; Fail and don't do anything more
	move q4, t1		; Store that

	remark Set up loop context

	remark			; First copy current macro .psect to the GC
	hlrz q1, mactab		; Save count of current entries
	ife. q1			; Wait a second, is there anything to do?
	  txmsg <% No macros, nothing to compact
>				; Some minor scolding blat
	  ret			; That all, we're done
	endif.

	movx t1, maclen		; Length of both .psect's
	dmove t2, [ macorg	; Source is first word of macro psect
		    gcorg  ]	; Destination is first word of gc psect
	xblt. t1		; Copy entire macros psect to gc psect
	 nop			;  Ignore any skip nonsense
	call $mrese		; Now completely destroy the macros psect

	movei t1, ^d1		; Account for the header word
	add t1, q1		; Only put back the TBLUK% entries
	dmove t2, [ gcorg  	; Source is first word of gc psect (previous mactab
		    macorg ]	; Destination is first word of macro psect
	xblt. t1		; Only copy the in use part of the table
	 nop			;  Ignore any skip nonsense

	movei q2, macorg+1	; First slot in macro table
	dmove t1, [ gcorg  	; Load first address of garbage collection
		    macorg ]	; End first slot of macro table
	camg t1, t2		; macros should be before garbage collection
	 exch 1, t2		; But they're not (??)
	sub t1, t2		; Calculate address offset between tables
	move q3, t1		; Store that

	remark Get down to some serious byte banging

; The garbage collection algorythm is trivial.  We've copyed the entire
; macros psect to the gc psect, stomped the macros psect and then only
; copied the used entries in the keyword table back.
;
; Here, using the keyword table as a basis, we copy over each keyword
; and text that is pointed to by an entry and fix the pointers
; accordingly.  Anything that doesn't get copied is orphaned data and
; is no longer necessary.  Once this is done, we toss the gc psect.

	do.			; Enter loop
	  call mkeycp		; Copy the keyword (macro name)
	  call mtxtcp		; Copy the text of the macro over
	  addi q2, ^d1		; Step to next slot in macro table
	  sojg q1, top.		; And do the remaining
	enddo.			; End loop lexical context

	remark Compact epilogue, displays more data

	movx t1, .hprnt		; Request current CPU time 
	HPTIM%			; 	now that we're done
	 %jserr (,r)		; Fail and don't do anything more
	camge t1, q4		; Did it wrap around
	 exch t1, q4		;  It did, fix that
	subm t1, q4		; Get and store the difference in HP ticks

	call endtim		; Take a snapshot from right now
	call elptim		; Calculates elapsed time

	txmsg <After:  >	; Give interesting post blat
	call $msumm		; Display macro table usage

	movei t2, ewallt	; Load pointer to elapsed wall time
	dmove t3, .datus(t2)	; Load elapsed HPTIM% double word
	or t3, t4		; Will print if either high or low order
	ifn. t3			; Did this take any time, actually?
	  move q3, t3		; It did, so save as a talisman
	  txmsg <Elapsed: >	; Seperate from characters cleared
	  movei t1, .priou	; Going to terminal
	  call durtim		; Nicely print the duration
	   nop			; Ignore any goofy return
	else.			; Else did nothing
	  setz q3,		; So flag this
	endif.			; End case positive elapsed time

; Note a small hack for ehptim: it now takes a pointer to a signed
; double word instead a signed single word.  It happens that we have
; the value in q4, that q3 is free, that there will never be any high
; order and that ehptim does not modify either one.  Thus, we pass
; it a pointer to that double word accumulator pair and everything
; works fine.  For the moment...  Until something changes...

	ifg. q4			; Any CPU time taken?
	  ifn. q3		; Displayed any elapsed time?
	    txmsg <, >		; Yes, space over
	  endif.
	  txmsg <CPU:  >	; Introduce processor blat
	  movei t1, .priou	; Going to terminal
	  movei t2, mecpu	; Load pointer to macro elapsed CPU
	  remark .datet		;[221] Don't touch!!  This should ALWAYS be zero
	  setz q3,		;[221] Clear double word of HP ticks (q3 untouched)
	  dmovem q3, .datus(t2)	;[221] Store elapsed DK10
	  movei q4, .datus(t2)	;[221] Now point to it
	  exch t2, q4		;[221] Pass in pointer to DK10 ticks, actually
	  setz t3,		;[221] Don't suppress leading seconds
	  call ehptim		; Display elapsed HP ticks
	   nop			;[221] Ignore non-fatal +1
	endif.			; End CPU display

	hrroi t1, crlf		; Tie off the line
	PSOUT%

	remark				; Now that we're done, don't need the gc psect
	seto t1,			; Case IV, deleting process memory
	dmove t2, [ .fhslf,,gcpag	; This process, page number of gc psect
	    pm%cnt!fld(gcpgs,pm%rpt) ]	; Number of pages to toss
	PMAP%				; Trim our working set
	 %jserr (<Post compact unable to trim working set>,) ; Odd... but continue

	ret			; Don't forget to finally return

	chgsec(code,data)	;;Some temporary storage
mecpu:	XList			; Save a few trees
	  repeat dtilen,<Z>	;;Allocate a time structure
	List			; Turn the listing back on

	retsec			;;Restore .PSECT assumptions


	subttl String copy measurement, 9:10pm  Thursday, 21 July 1920

; A question had sometimes come up for debate as to whether the string
; instructions gave any real speed up, the concern being whether the
; set up cost of conditioning the register file and restoring it was
; worth using them.
;
; Three cases were set up, the first being a typical ildb/idpb loop
; with the second being a use of movst to move the string until a nul
; was detected.  The third was a mixture; the keywords being moved
; with a loop and the macro expansions being moved with the movst.
; This was expected to be have the best performance as macro names
; (I.E., keywords) are typically not very long.
;
; 11 macros were defined, using a total of 80 characters of macro name
; space and 1365 characters of macro text space.  The results are
; suprising:
;
;     Case	Elapsed	 CPU	All
;	1	1.360	1.320	  times
;      *2	 .340	 .320	    are in
;	3	1.020	 .980	      milliseconds
;
; By a considerable margin, using solely the movst won.  This is why
; it is used exclusively, below.  Going forward, other cases may be
; identified in Kermit where it can be used.

	extern asczcp		; Extended instruction to move ASCIZ

	subttl Routine to copy keyword (macro name) data

; Expects:
;
;  q2/	Address of current keyword entry
;  q3/	Word offset between tables
;
;  Returns:
;
;   +1,	always

mkeycp:	remark			; Copy the keyword (macro name)
	hlrz t1, (q2)		; Pick up keyword address
	add t1, q3		; add in offset
	hrli t1, (point 7,0)	; Now have a source pointer
	move t2, macbp		; Point to our (scrubbed) macro table
	hrlm t2, (q2)		; Stomp in as the new keyword address
	call asczcp		; Copy the ASCIZ string
	hlrz t4, t2		; Load the destination pointer portion
	cain t4, 440700		; On a word boundary? (1 in 5 chance)
	ifskp.			; Nope, fix
	  addi t2, ^d1		; Round up a word
	  hrli t2, 440700	; Stomp in the right magic
	endif.			; Ready for any future usage
	movem t2, macbp		; Point to our (scrubbed) macro table
	ret			; All is well, return

	subttl Routine to copy macro text (macro expansion) data

; Expects:
;
;  q2/	Address of current keyword entry
;  q3/	Word offset between tables
;
;  Returns:
;
;   +1,	Always

	extern asczcp		; Extended instruction to move ASCIZ

mtxtcp:	remark			; Copy the text of the macro over
	hrrz t1, (q2)		; Pick up expansion address
	add t1, q3		; add in offset
	hrli t1, (point 7,0)	; Now have a source pointer
	move t2, macbp		; Point to our (scrubbed) macro text table
	hrrm t2, (q2)		; Stomp in as the new text address
	call asczcp		; Maybe will even save some cpu time
	hlrz t4, t2		; Load the destination pointer portion
	cain t4, 440700		; On a word boundary? (1 in 5 chance)
	ifskp.			; Nope, fix
	  addi t2, ^d1		; Round up a word
	  hrli t2, 440700	; Stomp in the right magic
	endif.			; Ready for any future usage
	movem t2, macbp		; And update global storage
	ret			; All is well, return

	.endps code
	
	subttl Additional writable storage areas

	.psect data
onamp:	0			;[77] Previous NAMP.
tbent:	0			; TBLUK% entry of existing keyword
sintn:	0			; Number of signal I/O traps we've seen

	extern namlen,namatm,explen,expatm

	remark definf,undeff	; Must be whacked on every parse
definf:: 0	 		;[77] DEFINE flag nonzero if parsing DEFINE.
undeff:: 0	 		;[77] UNDEFF flag nonzero if DEFINE x <cr>.
macptr:: 0			;[77] Pointer to start of macro text in CSB.

	.endps data

	subttl Macros storage areas

;N.B, Do NOT put anything into this .PSECT without updating the
;    calculations for maclen in k20unv!!!

	.psect macros,macorg	; Storage for macros

; The TBLUK% table, with one predefined macro for Columbia's IBM
; system.  Users can remove this definition by typing "define ibm", or
; they can replace it.  KERMIT-20 maintainers can remove it for their
; site by replacing the contents of MACTAB (first word) with
; 0,,MACMAX, or can change it to be anything they like.
;
; Kept for historical reasons and for any take files that depend on it.
;
; Be aware that the calculations for .psect size account for the IBM
; keyword and the cooresponding macro body.  If you do change this to
; be something else, then take a look at calculations in k20unv that are
; driven off of macmax.
;
; You need only change the slop calculations that are done with adslop.
;
; mactab MUST be the first location in the .psect!!  Garbage collection
; depends on this.

mactab:	intern mactab		;[194] 
	1,,macmax		;[77] Macro keyword TBLUK format table.
	ibmkey,,ibmmac		; Where is my 3276??
	block macmax-1		;[77] Macro keyword table.
mactbx: block 1		;[214]	; Tiny bit of slop

; This pointer has to be in here so that /MAP restores them.  No
; TBADD% should ever overwrite it because the maximum count (in the
; right halfword of TBLUK% table) can not be exceeded.

macbp:	point 7, m1stf		; First free location in macro (expansion) table

; Both macro names and bodies are allocated out of the same block of
; storage, which allows for more flexible management, Note that the
; macro buffer MUST be the last item in the .PSECT in order to get the
; benefit of guard page two, which follows.

macbuf:	remark			; Here are the macros
ibmkey:! asciz /IBM/		; Macro name
ibmmac:! asciz/parity mark, duplex half, handshake xon
/				; Yummy half duplex!!
m1stf:!	.xcref m1stf		; Don't need this in the cross reference
	suppress m1stf		; Nor in the symbol table listing
	block mnblen		; Space for the names
	block mtblen		; Space for the expansions
macx:	block 1			;[77] End of macro text buffer, with padding.

if2  <	purge m1stf  >		; Not needed after second pass
	.endps macros

	.psect gc,gcorg		; psect for garbage collections
	block maclen		; same size as for macros
	.endps gc

emacro <
	.psect medit,medorg	; psect for macro editing
	block maclen		; same size as for macros
	.endps medit		; Probably far too large
>;;emacro

	subttl History and Motivation

; The is all part of edit 203

;PS:<TIMREK>KERMIT.MAC.288, 27-Oct-83 18:55:44, Frank
;[77] Add DEFINE command for SET macros.  Remove hardwired SET IBM.

; The DEFINE command for SET macros is quite old, having been added by
; Frank da Cruz as part of edit 77 on 27-Oct-83.  It predates the
; availability of extended sections and read-only .psects (perhaps
; even .psects themselves)
;
; It's fine for what it does, meaning loading up a bunch of macros
; from a KERMIT.INI file, and clearly functioned fine for years, if
; not decades.
;
; However, during the DECnet NRT work, it became increasingly
; aggressively used, which revealed some limitations:
;
; DEFINE assumed that you are always creating a macro and thus copies
; whatever is in the atom buffer into the name table.  This means
; that, in addition to not freeing up any name or macro space,
; undefining a macro would actually use *more* name space.
;
; Because this copy happened during the parse and not after the
; command had been confirmed, if the user started defining a macro,
; changed his mind and typed a ^U, space in the name table would still
; be usurped for each and every reparse.
;
; Thus, during the process of either learning the DEFINE command or
; trying different parameters, the user could run out of space without
; actually having accomplished anything.  There was no remedy to this
; except to exit and run a fresh copy of Kermit.
;
; The out of space check was not reliable.  First, it checked to see
; if the macro name and text space was already full at the beginning
; of the parse.  These checks simply looked to see if the macro name
; and table space had started to go past the marked end of tables.
; Overwrites were prevented by having a certain amount of slop for the
; definition to expand into.
;
; However, once the check was passed, Kermit did no further checking,
; meaning the user could blithly continue typing, overwriting whatever
; happened to be after the tables.  This, coupled with the reparse
; phenomena previously described could produce some pretty quirky
; behavior, if not downright crashes.
;
; Another non-critical limitation was that there was was no way to
; make modifications to a macro once it was defined.  Any change meant
; that you had to basically type the whole macro in again.
;
; As a practical matter, while SET macros could be read in via the
; execution of a TAKE file, there was no way to write them out.  
;
; Fixing the problems above and adding the extra functionality proved
; so massive an addition that all the code got moved into this
; seperate module.
;
; That being said, the original logic is largely kept, the bulk of the
; code being extra functionality.

	subttl Random Notes

; Using a quoted strings allows an easy define of a name that is
; similar to an existing name by not selecting from the keyword table.
;
; Better, it allows for consistent use of escape recognition when
; specifying the SET commands.

	.xcmsy			;[194] Ditch MACSYM junk

	end