Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 6-exec/execpm.mac
There are 9 other files named execpm.mac in the archive. Click here to see a list.
;[SRI-NIC]SRC:<6-EXEC>EXECPM.MAC.4,  5-Aug-85 12:56:25, Edit by HSS
; [NIC1065] Remove edit 1056 since it broke UNDECLARE
;[SRI-NIC]SRC:<6-EXEC>EXECVR.MAC.1058, 17-Jul-85 13:21:42, Edit by IAN
; [NIC1056] Make PCL command lowercased in the command table to
; distinguish them from built-in commands (which are all caps)
;<5.1.EXEC>EXECPM.MAC.9, 21-Nov-82 01:47:09, Edit by PA0B
;Move .IDDCL here from EXECIN
;<5.1.EXEC>EXECPM.MAC.8, 14-Nov-82 07:36:53, Edit by PA0B
;Clean up the code in SSTVAR a little (mostly remove
;unreferenced STKVAR's, 
;<5.1.EXEC>EXECPM.MAC.7, 12-Nov-82 05:46:07, Edit by PA0B
;Fix TAKLEN debugging code and define a BUG macro if it's
;not already defined so that this module is portable to
;sites that don't have our Exec crash dump crock.
;<5.1.EXEC>EXECPM.MAC.6,  6-Nov-82 05:29:37, Edit by PA0B
;Set PCCIPF properly in PCDO (fix typo), Restore FORK and
;RUNFK in POPECB if necessary (needed on if ^C or error
;during an INVOKE or TYPEIN statement), Check for overly
;decrementing TAKLEN, Give an error if user undeclares
;something that wasn't declared, Add SETINV and CLRINV,
;Don't check PCPRGR (it is unreliable in a multi-forking
;environment).  Note***: there are still potential problems
;at PCMPSI because FORK may contain the wrong thing***,
;Add NPCLIO routine
;<5.1.EXEC>EXECPM.MAC.5, 21-Jul-82 02:57:39, Edit by PA0B
;Still one more check for bogus PSI's in PCMPSI.  I wish I
;I knew where the bogus interrupts were coming from...
;<5.1.EXEC>EXECPM.MAC.4, 12-Jul-82 03:26:20, Edit by PA0B
;Fix up Systat name stuff - don't SETNM% in PCEXC1 (though
;added commented-out code to do it only if top-level PCL
;command, which would be better than what we had if the new
;stuff doesn't work), store pointer to name of top-level
;PCL command in progress (also used by ^T).
;<5.1.EXEC>EXECPM.MAC.3, 16-Jun-82 21:02:57, Edit by PA0B
;In DFCMFE replaced "JRST CJERR" with "CMERRX" so that the
;error message from "Declare Pcl No-Such-File.Pcl" will
;include the name of the missing file.
;<5.1.EXEC>EXECPM.MAC.2, 30-May-82 12:31:50, Edit by PA0B
;Really tolerate spurious interrupt in PCMPSI (replaces previous
;edit), Zero PCWAIT when cleaning up from PCL execution (it was
;sometimes -1 if an error or ^C caused exit from PCL).
;<4.EXEC>EXECPM.MAC.92, 23-Jun-81 13:37:19, Edit by DK32
;Tolerate nonexistent fork going hungry
;<4.EXEC>EXECPM.MAC.91, 26-May-81 10:36:05, Edit by DK32
;Prohibit Save/Environment to PTY12:
; UPD ID= 75, SNARK:<6.EXEC>EXECPM.MAC.6,  22-Oct-81 14:51:27 by CHALL
;MORE 5.1564 - MAKE COMMAND BE "PRESERVE ENVIR" OR "PRESEVE EXEC"
; UPD ID= 86, SNARK:<5.EXEC>EXECPM.MAC.6,  10-Oct-81 19:46:40 by CHALL
;TCO 5.1564 CHANGE PCMSAV TO .PRESE (PRESERVE CMND).
; UPD ID= 70, SNARK:<6.EXEC>EXECPM.MAC.5,  10-Oct-81 20:20:10 by CHALL
;TCO 5.1564 CHANGE PCMSAV TO .PRESE (PRESERVE CMND). REMOVE PCMSVP (SAV/EXE)
; UPD ID= 42, SNARK:<6.EXEC>EXECPM.MAC.4,  22-Aug-81 14:24:17 by CHALL
;TCO X5.1009 PCMXCT: THE CALL TO FIXIO FRAGS AC B, SO RESTORE IT
; UPD ID= 35, SNARK:<6.EXEC>EXECPM.MAC.3,  17-Aug-81 13:27:27 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
; UPD ID= 2026, SNARK:<6.EXEC>EXECPM.MAC.2,  19-May-81 10:26:01 by PURRETTA
;<4.EXEC>EXECPM.MAC.90, 18-Apr-81 13:19:46, Edit by DK32
;Handle Exec output designator in PCMPOS
;<4.EXEC>EXECPM.MAC.89, 30-Mar-81 13:23:57, Edit by DK32
;Save GTJFN block around execution
;<4.EXEC>EXECPM.MAC.88,  6-Mar-81 18:46:14, Edit by DK32
;Save R14 in PSI's, Restore reparse address after Prompt
;<4.EXEC>EXECPM.MAC.87, 25-Feb-81 21:06:29, Edit by DK32
;Prompt, New global symbol replacement login
;<4.EXEC>EXECPM.MAC.86, 27-Jan-81 20:10:08, Edit by DK32
;Don't RLJFNS, Fix synonyms to invisible keywords
;<4.EXEC>EXECPM.MAC.85, 16-Jan-81 13:02:52, Edit by DK32
;Use PCWAIT to control WFORK, Flush JFN stack often
;<4.EXEC>EXECPM.MAC.84,  7-Jan-81 17:50:11, Edit by DK32
;Remove worrying SETZM CUSTMF, Add newline to Save/Exec
;confirmation
;<4.EXEC>EXECPM.MAC.83, 23-Dec-80 16:24:57, Edit by DK32
;All Bliss routines use Exec linkage, Restore reparse
;address after interrupted parse
;<4.EXEC>EXECPM.MAC.82, 18-Dec-80 16:39:50, Edit by DK32
;Fix ^T, Preserved contexts, Use CUSTMF instead of
;fooling with CINITF
;<4.EXEC>EXECPM.MAC.81,  9-Dec-80 20:47:56, Edit by DK32
;Exit Save and ToProgram, Select preserved command if
;Original requested
;<4.EXEC>EXECPM.MAC.80,  5-Dec-80 21:58:59, Edit by DK32
;Save command name for ^T, Handle exceeded quota
;<4.EXEC>EXECPM.MAC.79,  1-Dec-80 15:19:17, Edit by DK32
;Fix Undeclare All to reset GST, Allow for SSAVE failure
;<4.EXEC>EXECPM.MAC.78, 26-Nov-80 20:11:58, Edit by DK32
;Save/Exec
;<4.EXEC>EXECPM.MAC.77, 11-Nov-80 21:54:16, Edit by DK32
;Entry to get memory and return on error
;<4.EXEC>EXECPM.MAC.76, 21-Oct-80 16:38:07, Edit by DK32
;Make sure abbreviation entry is made in correct table,
;Remove Procdefs, Fix non-disk error message
;<4.EXEC>EXECPM.MAC.75,  9-Oct-80 21:00:52, Edit by DK32
;Parse List, Invalidate prompts in Undeclare All
;<4.EXEC>EXECPM.MAC.74,  2-Oct-80 19:38:31, Edit by DK32
;New Declare variable logic, Handle invalidated abbreviations,
;Add NoConfirm to Undeclare, Have Undeclare work only after
;confirmation, Add Undeclare All, Add Parse NoIndirect,
;Writeable prompt strings
;<4.EXEC>EXECPM.MAC.73, 25-Sep-80 21:52:59, Edit by DK32
;Reset command-in-progress, Define I/O fields in ECB
;<4.EXEC>EXECPM.MAC.72, 15-Sep-80 18:17:23, Edit by DK32
;Confirm Save/Environment better
;<4.EXEC>EXECPM.MAC.71,  9-Sep-80 17:43:33, Edit by DK32
;Add PCMWTF, New Undeclare Original logic, Fix Undeclare
;to take multiple names, New Information PCL format,
;Don't raise in Declare Variable
;<4.EXEC>EXECPM.MAC.70,  7-Sep-80 22:33:36, Edit by DK32
;Issue error if PCMGMM fails, Have Declare raise variable names,
;Have Undeclare only convert underscores for Commands,
;Better state check for DoCommand To in progress
;<4.EXEC>EXECPM.MAC.69, 15-Aug-80 16:44:06, Edit by DK32
;Default for Declare Environment is EXEC.ENV, Different
;break masks for commands and variables
;<DK32.CG>EXECPM.MAC.68,  8-Aug-80 15:40:13, Edit by DK32
;ECB contains details on PTY/PCT's, Parse names as fields
;<DK32.CG>EXECPM.MAC.67,  5-Aug-80 16:16:47, Edit by DK32
;PCT's, Fix case folding in Undeclare
;<DK32.CG>EXECPM.MAC.66,  1-Aug-80 14:11:49, Edit by DK32
;Confirm Save/Environment
;<DK32.CG>EXECPM.MAC.65, 29-Jul-80 15:04:00, Edit by DK32
;PCIKIL is PCICFK
;<DK32.CG>EXECPM.MAC.64, 19-Jul-80 21:12:28, Edit by DK32
;Have Declare Synonym FOO FOOBAR make an abbreviation entry,
;Cannot make synonym named ORIGINAL, Change Write Environment to
;Save/Environment
;<DK32.CG>EXECPM.MAC.63, 18-Jul-80 21:08:56, Edit by DK32
;No PDL overflow from recursive synonym, Make $SDEF global, Change
;Synonym to Declare Synonym and Undeclare Synonym, Change Dump to
;Write Environment, Add Undeclare Original-command, Keep abbreviation
;entries consistent, Make Declare Environment singular, Use different
;parameter to SPECFN
;<DK32.CG>EXECPM.MAC.62, 10-Jul-80 09:25:35, Edit by DK32
;Allow any string as a variable name, Set CMIOJ for DoCommand To
;<DK32.CG>EXECPM.MAC.61,  1-Jul-80 13:06:12, Edit by DK32
;Use correct register on return from FIELD
;<DK32.CG>EXECPM.MAC.60, 29-Jun-80 12:30:04, Edit by DK32
;Fix PCMRKT to create table if none yet created
;<DK32.CG>EXECPM.MAC.59, 26-Jun-80 08:33:51, Edit by DK32
;Make declare confirmation optional
;<DK32.CG>EXECPM.MAC.57, 20-Jun-80 02:38:55, Edit by DK32
;Have Declare give ?-error if file not found
;<DK32.CG>EXECPM.MAC.56, 19-Jun-80 22:38:31, Edit by DK32
;Integrate synonyms into PCL, confirm declarations
;<DK32.CG>EXECPM.MAC.55, 19-Jun-80 02:23:34, Edit by DK32
;Fixes to synonym and table handling; Declare Environment
;<DK32.CG>EXECPM.MAC.54, 18-Jun-80 03:45:18, Edit by DK32
;Synonym
;<DK32>EXECPM.MAC.2, 16-Jun-80 20:49:02, Edit by DK32
;New SETNM logic
;<DK32.CG>EXECPM.MAC.49, 16-Jun-80 00:05:08, Edit by DK32
;Merged command keyword tables
;<DK32.CG>EXECPM.MAC.2, 24-Mar-80 04:10:21, Edit by DK32
	SEARCH EXECDE
	TTITLE EXECPM

	FK%INV==1B11		;Fork being INVOKE'd by PCL
	EXTERN ORIFLG,PCLNAM,PCFORK,PCCIPF,PCRNFK

;The Programmable Command Language Macro Interface
;
; Copyright (C) 1980, Carnegie-Mellon University
;

; Execution Context Block
; This definition had better match the definition in EXECPD
; Note: Some of the names do NOT match exactly those in EXECPD;
;	this is because of the deficiency in DEFSTR which requires
;	all the names to be unique in the first FIVE characters.

DEFSTR (ECBNXT,0,35,18)		;Link to next (older) context block
DEFSTR (ECBPRC,0,17,18)		;Current routine's GST address, 0 if Procdef
DEFSTR (ECBPOS,1,35,36)		;Terminal file position
DEFSTR (ECBPC,2,17,18)		;PC
DEFSTR (ECBFP,2,35,18)		;FP
DEFSTR (ECBSP,3,17,18)		;SP
DEFSTR (ECBSTK,3,35,18)		;Base of execution stack
DEFSTR (ECBCNT,4,35,18)		;Number of fork-controlling PTY/ITY
DEFSTR (ECBCJT,4,17,18)		;JFN on that PDI
DEFSTR (ECBDNT,5,35,18)		;Number of DoCommand-output PTY/ITY
DEFSTR (ECBDJT,5,17,18)		;JFN on that PDI
DEFSTR (ECBDOT,6,17,18)		;Operand designator for DoCommand output
DEFSTR (ECBGSC,7,35,18)		;Address of command's GST entry
DEFSTR (ECBPFL,8,35,18)		;List of parsed JFNs
DEFSTR (ECBCMN,9,35,36)		;Command name in SIXBIT
DEFSTR (ECBPSV,5+5,0,1)		;Preserved context
DEFSTR (ECBECO,5+5,3,1)		;Echo off
DEFSTR (ECBOPM,5+6,35,36)	;Original prompt pointer
DEFSTR (ECBORA,5+7,35,18)	;Original reparse address
ECBCSB==15			;Command State Block at invocation
ECBCJB==ECBCSB+.CMGJB+1		;GTJFN block at invocation
ECBCBF==ECBCJB+.GJBFP+1		;Command Buffer at invocation
ECBLEN==ECBCBF+CBUFL

DEFSTR (GSTPSV,0,0,1)		;Preserved object
DEFSTR (GSTCLS,0,4,3)		;Class of object
DEFSTR (GSTTXT,0,35,18)		;Address of text
DEFSTR (GSTNMA,2,35,18)		;Address of name

GSCCLC==0			;Object class of Command
GSCCLP==1			;Procedure
GSCCLV==2			;Variable
GSCCLF==3			;Typed procedure
GSCCLS==4			;Synonym

;Break mask for PCL name purposes
;PCL routine names are alphanumeric, with both hyphen and underscore
;PCL variable names are alphanumeric, with underscore and no hyphen

PCLRTN:	BRMSK. (FLDB0.,FLDB1.,FLDB2.,FLDB3.,<_>,)
PCLVAR:	BRMSK. (FLDB0.,FLDB1.,FLDB2.,FLDB3.,<_>,<->)

;The BUG macro.  At CMU it is defined in EXECDE.  Elsewhere, it is
;a NOOP:

IFNDEF BUG,<
	DEFINE BUG <>
	   >
; Define PCL construct
;
;	DECLARE	ENVIRONMENT (from file) file,file,file,...
;		INTEGER-VARIABLE (named) name
;		PCL-ROUTINES (from file) file,file,file,...
;		STRING-VARIABLE (named) name
;		SYNONYM (to new name) NewName (old command named) OldName
;

.DECLA::MOVX A,PCFCFM		;Set current confirmation mode
	ANDCAM A,PCFLAG		;Assume quiet operation
	MOVX B,PCFQDC		;Get present policy
	TDNN B,PCFLAG		;Confirm?
	IORM A,PCFLAG		;Yes
	NOISE (for PCL)
	SKIPN PCLSTF		;Initialized?
	CALL PCINIT		;Do it now

.DEFPO:	MOVEI B,[FLDDB. .CMKEY,,$CDEF,,,[
		 FLDDB. .CMSWI,,$SDEF,,,]]
	CALL FLDSKP		;Get switch or keyword
	 CMERRX
	LDB D,[331100,,(C)]	;See which was parsed
	CAIE D,.CMSWI		;A switch?
	JRST .DEFPK		;No, a keyword
	CALL GETKEY		;Get the data word
	MOVX D,PCFCFM		;Alter this bit
	SKIPN P3		;Clear it?
	ANDCAM D,PCFLAG
	SKIPE P3		;Set it?
	IORM D,PCFLAG
	JRST .DEFPO		;Parse another field

.DEFPK:	CALL GETKEY		;Get the keyword data
	JRST (P3)		;Go to processing routine

$SDEF::	TABLE
	T Confirm,,1		;Set confirmation bit
	T Noconfirm,,0		;Clear confirmation bit
	TEND

$CDEF:	TABLE
	T Environment,,.DEFEV
	T Integer-Variable,,.DEFIV
	T PCL-Routines,,.DEFRT
	T String-Variable,,.DEFSV
	T Synonym,,.DEFSY
	TEND

.DEFRT: TDZA Q1,Q1		;Defining a PCL routine
.DEFEV: SETO Q1,		;Defining an environment
DFCMEN:	STKVAR <DEFENV,<DEFNAM,10>>
	MOVEM Q1,DEFENV		;Save switch
	NOISE (from file)
	MOVEI A,[ASCIZ/PCL/]	;Default extension
	HRLI A,-2		;Return on error
	SKIPE DEFENV		;Is it an environment?
	MOVE A,[[ASCIZ/EXEC/],,[ASCIZ/ENV/]] ;Provide both defaults
	MOVX B,GJ%OLD!GJ%IFG!1B15!1B16!1B17
	HLRZ B,B		;Switch halves
	CALL SPECFN		;Read in a list of file specs
	 JRST DFCMFE		;Something went amiss
	SKIPE JBUFP		;Anything in JFN list?
	SKIPN INIFH1		;Anything there?
	RET			;No
DFCMNF:	CALL NXFILE		;Get next file off stack
	 JRST [	SKIPE INIFH1	;Was that the end?
		JRST DFCMNF	;No, it just reported an error
		RET]		;Yes, all done
	HRRZ Q2,@INIFH1		;Get the JFN
	MOVEI A,(Q2)		;See if it is a file
	DVCHR%
	LDB B,[221100,,B]	;Get DV%TYP
	CAIE B,.DVDSK		;Is it a file?
	ERROR <Input from non-disk not yet implemented>
	MOVEI A,(Q2)		;Now look at the file
	MOVX B,FLD(7,OF%BSZ)+OF%RD
	SKIPE DEFENV		;Environment file?
	MOVX B,FLD(^D36,OF%BSZ)+OF%RD ;Read words then
	OPENF%
	 ERCAL CJERRE		;Failed
	SKIPE DEFENV		;Is it an environment?
	JRST DFCMEV		;Yes

DFCMGF:	MOVE B,[2,,.FBBYV]	;See how long it is
	MOVEI C,C
	GTFDB%
	LOAD C,FB%BSZ,C		;See if length given in characters
	CAIN C,^D36		;Words?
	IMULI D,5		;Make it characters
	MOVEI A,(Q2)		;Read the file
	MOVE B,PCCWKE		;Into a convenient area
	HRLI B,(POINT 7,0,35)
	MOVNI C,(D)		;Just what it has
	SIN%
	 ERJMP [PUSH P,B	;Save the ending pointer
		MOVX A,.FHSLF	;See what the error was
		GETER%
		CAME B,[.FHSLF,,IOX4] ;End of file?
		CALL CJERRE	;No, abort
		POP P,B		;Acceptable
		JRST .+1]
	TXO A,CO%NRJ		;Retain JFN for GNJFN%
	CLOSF%			;Done with the file
	 JWARN
	SETZ A,			;Terminate it
	IDPB A,B
	JRST DFCMNC		;Go compile it

DFCMFE:	MOVE A,ERCOD		;Get back error code
	CAIE A,GJFX33		;No file specified?
	CMERRX			;Don't understand it
	SKIPE DEFENV		;Is it an environment?
	ERROR <File must be specified>
	CONFIRM			;It had better be a confirmation
	CALL DFCMTI		;Read in the source
	JRST DFCMNC		;And go compile it

; %( There may be some who say that this should use COMND,
;    through FIELD.  They may be right )%

DFCMTI:	STKVAR <<TBLK,.RDBRK+1>> ;Get argument block
	TYPE < [Enter source, end with Escape or ^Z]
>
	MOVEI A,.RDDBC		;Initialize argument block
	MOVEM A,.RDCWB+TBLK
	MOVX A,RD%JFN+RD%BRK	;Providing JFN's, break on Esc or ^Z
	MOVEM A,.RDFLG+TBLK
	MOVE A,[.PRIIN,,.PRIOU]	;Use whatever is in fashion
	MOVEM A,.RDIOJ+TBLK
	MOVE A,PCCWKE		;Read into source buffer
	HRLI A,(POINT 7,0,35)
	MOVEM A,.RDDBP+TBLK
	MOVEI A,5*10K		;Allow plenty of space
	MOVEM A,.RDDBC+TBLK
	MOVEI A,TBLK		;Now read the source
	TEXTI
	 JRST JERR		;Issue standard error message
	SETZ A,			;Clean out the terminator
	DPB A,.RDDBP+TBLK
	CALL LM			;Get to left margin
	RET			;All done, clean off the stack

DFCMNC:	MOVE A,PCCWKE
	HRLI A,(POINT 7,0,35)
	CALL PCCCPL		;Compile and define PCL routines
	JRST DFCMNG		;Common completion

DFCMEV:	CALL PCIGEV		;Define environment from JFN in A
	MOVE A,Q2		;Get back JFN
	TXO A,CO%NRJ		;Close file but leave JFN
	CLOSF			;for GNJFN
	 JWARN

DFCMNG:	SKIPE INIFH1		;Exit right away if input from terminal
	CALL GNFIL		;Step to next file, perhaps by GNJFN%
	 JRST [	CALLRET UNMAP]	;None, clean up and finish
	JRST DFCMNF		;Get next file another way

DFRDDP:	ERROR <Duplicate>

.DEFIV:	TDZA Q1,Q1		;Set switch to define integer
.DEFSV:	SETO Q1,		;Set switch to define string
	NOISE (named)
	MOVEI B,[FLDBK. .CMFLD,,,<Name of variable>,,PCLVAR]
	CALL FLDSKP		;Get a name
	 CMERRX
	CONFIRM
	MOVE A,CMABP		;Point to name
	SETO B,			;See how long it is
	ILDB C,A
	ADDI B,1
	JUMPN C,.-2
	HRLI A,(B)		;Make stringvalue to name
	HRRI A,ATMBUF
	MOVE B,Q1		;Pass type
	CALL PCIDFV		;Define the variable
	RET

.DEFSY:	NOISE (to new name)
	WORDX <new command name>
	 CMERRX <Invalid command name>
	CALL BUFFF		;Buffer it
	PUSH P,A		;Save pointer
	SETZ B,			;Count the characters
.DFSY0:	ILDB C,A
;	CAIL C,"A"		;[NIC1056]
;	  CAILE C,"Z"		;[NIC1056]
;	    SKIPA		;[NIC1056]
;	   TRO C,40		;[NIC1056] UC --> lc
	DPB C,A
	SKIPE C
	  AOJA B,.DFSY0
	HRLM B,(P)		;Make stringvalue to synonym name
	NOISE (to old command named)
	SKIPN PCFLDB		;Is the FLDDB initialized?
	CALL PCMCKT		;Make keyword table and build FLDDB
	HLLZS PCFLDB		;Clear out link
	MOVEI B,PCFLDB		;Find old command name
	CALL FLDSKP
	 CMERRX <Unrecognized command>
	CONFIRM
	HLRZ B,(B)		;Get address of command name
	MOVE A,0(B)		;Get first word of command name
	LSH A,-^D28		;Isolate first 8 bits
	CAIN A,1		;Is this really a word of data bits?
	ADDI B,1		;Yes, name starts in next word
	POP P,A			;Get back stringvalue to new name
	CALL PCIDFS		;Define synonym
	RET
; Define a single command, procedure, synonym, or variable
; Called to place name in command keyword table, and to
; give confirming message.
;	R1 = Class of object
;	R2 = Address of ASCIZ name
;	R3 = -1 if known duplicate, 0 if original
;	R4 = Address of ASCIZ target name if synonym

PCMDFO::STKVAR <DFOCLS,DFONAM,DFODPL,DFOTGT,DFOENT>
	MOVEM A,DFOCLS		;Save class
	MOVEM B,DFONAM		;Save name
	MOVEM C,DFODPL		;Save duplicate flag
	JUMPL C,CMDFO2		;Just give message if replacement
	CAIN A,GSCCLC		;Command?
	JRST CMDFO1		;Yes
	CAIE A,GSCCLS		;Synonym?
	JRST CMDFO2		;No
	MOVEM D,DFOTGT		;Save target address
	JUMPE D,CMDFO7		;No target, Undeclare it
	HRROI A,(B)		;Yes, make pointer to synonym name
	HRROI B,(D)		;And pointer to target name
	STCMP%			;Compare them
	TXNN A,SC%SUB		;Is synonym a substring of the target?
	JRST CMDFO1		;No, make new entry
	MOVEI A,1		;There must be a word available
	CALL PCMRKT		;Ensure it before looking up the target entry
	MOVE A,PCFLDB+.CMDAT	;Point to keyword table
	HRRO B,DFOTGT		;Point to target name
	TBLUK%			;Find target entry
	TXNE B,TL%NOM!TL%AMB	;Is it there?
	ERROR <Synonym does not refer to command>
	MOVE B,DFONAM		;Point to name block again
	SUBI B,1		;Back up to spare word
	MOVX C,CM%FW+CM%INV!CM%ABR ;Make an invisible abbreviation
	MOVEM C,(B)		;With the name string following
	HRLI A,(B)		;Now make the keyword table entry
	MOVEM A,DFOENT		;Pointing to the existing command's entry
	JRST CMDFO6		;Skip default case

CMDFO7:	SKIPN PCFLDB		;Is the FLDDB initialized?
	CALL PCMCKT		;Make keyword table
	MOVE A,PCFLDB+.CMDAT	;Point to command table
	HRRO B,DFONAM		;Point to command to kill
	TBLUK%			;Find entry
	TXNE B,TL%NOM!TL%AMB	;Is it there?
	ERROR <Command to be removed not found>
	MOVE B,A		;Remove this entry
	MOVE A,PCFLDB+.CMDAT	;From this table
	TBDEL%
	CALL PCMRAD		;Relocate abbreviation entries to match
	JRST CMDFO2		;Confirm it

CMDFO1:	HRL B,DFONAM		;Make command keyword entry
	HRRI B,[PCDO]		;Pointing to PCL entry point
	MOVEM B,DFOENT

CMDFO6:	SKIPN PCFLDB		;Is the FLDDB initialized
	CALL PCMCKT		;Make keyword table and build FLDDB

CMDFO3:	MOVE A,PCFLDB+.CMDAT	;Put command in keyword table
	MOVE B,DFOENT		;This is the new entry
	TBADD%
	 ERJMP CMDFO4		;Error
	MOVE B,A		;Must relocate all abbreviations
	MOVE A,PCFLDB+.CMDAT	;Point to the table header
	CALL PCMRAI		;Relocate
	JRST CMDFO2		;Success

CMDFO4:	MOVEI A,.FHSLF		;Get the error code
	GETER
	HRRZS B			;Clean it up
	CAIN B,TADDX1		;Table full?
	JRST CMDFO5		;Yes
	CAIE B,TADDX2		;Duplicate?
	JRST JERRE		;No, inexplicable error
	SETOM DFODPL		;Tell the user in the message, also
	MOVE A,PCFLDB+.CMDAT	;Now find the original entry
	HRRZ B,DFONAM
	HRLI B,(POINT 7,0)
	TBLUK
	TXNN B,TL%EXM		;Exact match?
	ERROR <TBLUK error replacing command>
	MOVE B,DFOENT		;Replace the entry
	MOVEM B,(A)
	JRST CMDFO2		;All set

CMDFO5:	MOVEI A,8		;Add 8 words at a time
	CALL PCMEKT		;Expand keyword table
	JRST CMDFO3		;Try the insert again

CMDFO2:	HRRZ A,DFONAM
	HRLI A,(POINT 7,0)
	HRROI B,[ASCIZ//]	;Assume new definition
	SKIPE DFODPL		;Is it a duplicate?
	HRROI B,[ASCIZ/, old definition replaced/] ;Yes
	MOVE C,DFOCLS		;Get object class
	CAIN C,GSCCLS		;Synonym?
	JRST [	SKIPN DFOTGT	;Yes, is there a target?
		ADDI C,1	;No, use different confirmation
		JRST .+1]
	MOVX D,PCFCFM		;Get confirm-current declaration bit
	TDNE D,PCFLAG		;Confirm it?
	XCT [	ETYPE <[Command %1M defined%2M]%_>
		ETYPE <[Procedure %1M defined%2M]%_>
		ETYPE <[Variable %1M defined%2M]%_>
		ETYPE <[Procedure %1M defined%2M]%_>
		ETYPE <[Synonym %1M defined%2M]%_>
		ETYPE <[Command %1M removed]%_> ](C)
	RET
; Create writeable command keyword table

PCMCKT:	MOVEI A,8		;Add this many commands
PCMCKN:	MOVEI B,CTBL1		;Point to the standard table
	SKIPE PCFLDP		;Is there a preserved table?
	MOVE B,PCFLDP+.CMDAT	;Yes, use it instead
	PUSH P,B		;Save base of original table
	PUSH P,A		;Save addition count
	HLRZ B,(B)		;Get words used in original
	ADDI A,1(B)		;Add to desired extension, plus header
	CALL GTBUFX		;Get permanent block that size
	MOVEM A,PCFLDB+.CMDAT	;Point to it
	POP P,C			;Get back extension count
	POP P,B			;Point to table again
	HLRZ D,(B)		;Get original size
	ADD C,D			;New table has this many entries
	HLL C,(B)		;This many of which (will) have data
	MOVEM C,0(A)		;Make header word
	CALL PCMKKT		;Copy the entries
	MOVX A,<FLD(.CMKEY,CM%FNC)+CM%HPP>
	MOVEM A,PCFLDB		;Build function descriptor block
	HRROI A,[ASCIZ/Command,/]
	MOVEM A,PCFLDB+.CMHLP
	RET

; Require command keyword table size
; Call with A=Number of additional commands

PCMRKT::SKIPN PCFLDB		;Is there a writeable keyword table?
	JRST PCMCKN		;No, create table just the right size
	MOVE B,PCFLDB+.CMDAT	;Get the table
	HRRZ C,(B)		;Get its size
	HLRZ D,(B)		;Get number of words in use
	ADDI D,(A)		;Must have at least this many left
	CAIL C,(D)		;Is size less than requirements?
	RET			;No, current size is satisfactory;
	SUBI D,(C)		;Get number of words to add
	MOVE A,D
;	CALLRET PCMEKT		;Expand by that many words

; Expand command keyword table by number of words in A

PCMEKT:	MOVE B,PCFLDB+.CMDAT	;Get the table
	HRRZ C,0(B)		;Get its current length
	ADDI A,(C)		;Make room for more commands
	HLL A,0(B)		;Get its current used size
	PUSH P,A		;Save it
	MOVEI A,1(A)		;Get one more for the header
	CALL GTBUFX		;Get permanent storage block
	POP P,0(A)		;Fill it in with its new size
	PUSH P,A		;Save start of new table
	MOVE B,PCFLDB+.CMDAT	;From old table
	CALL PCMKKT		;Copy the entries
	POP P,A			;Get back start of new table
	EXCH A,PCFLDB+.CMDAT	;Install copy as keyword table
	MOVE B,A		;Free old table
	HRRZ A,(A)		;Get its length
	ADDI A,1		;Including the header
	CALLRET RETBUF

;Copy keywords
;  A/ Address of header word of new table
;  B/ Address of header word of old table

PCMKKT:	PUSH P,A		;Save start of new table
	PUSH P,B		;and old table
	HLRZ C,(A)		;Get number of words to copy
PCMKK1:	MOVE D,1(B)		;Get the entry
	MOVEM D,1(A)		;Store in new table
	HLRZS D			;Point to argument word(s)
	MOVE D,(D)		;Get the (first) word
	TXNE D,177B6		;Is the first byte zero
	JRST PCMKK2		;No, no flag bits
	TXNN D,CM%ABR		;Abbreviation?
	JRST PCMKK2		;Not an abbreviation
	HRRZ D,1(B)		;Get the target entry address
	SUB D,(P)		;Make relative within old table
	ADD D,-1(P)		;Make absolute within new table
	HRRM D,1(A)		;This is the target entry address now
PCMKK2:	ADDI A,1
	ADDI B,1
	SOJG C,PCMKK1
	ADJSP P,-2		;Throw away the table addresses
	RET


;Relocate abbreviations in table
;Called when entry has been inserted or deleted, to correct any
;abbreviations to that entry or any later entry.
;	CALL PCMRAD	Relocate after deletion
;	CALL PCMRAI	Relocate after insertion
;  A/ Address of header of table
;  B/ Address of inserted or deleted entry

PCMRAI:	MOVEI D,1		;Insertion: Add one word to affected entries
	TRNA
PCMRAD:	SETO D,			;Deletion: Subtract one word from them
	STKVAR <ABBRRL,ABBREN,ABBRCT>
	MOVEM D,ABBRRL		;Save relocation value
	MOVEM B,ABBREN		;Save inserted/deleted entry
	SETZM ABBRCT		;No abbreviations invalidated yet
	HLRZ C,(A)		;Get length of table
	MOVEI B,1(A)		;Work on each entry
PCMRA1:	HLRZ D,(B)		;Get address of argument word(s)
	MOVE D,(D)		;Get (first) word of argument
	TXNE D,177B6		;Is first byte zero?
	JRST PCMRA3		;No, no flags
	TXNN D,CM%ABR		;Abbreviation?
	JRST PCMRA3		;Not a valid abbreviation, leave it as is
	HRRZ D,(B)		;Get the target entry address
	CAMGE D,ABBREN		;Is it before the change?
	JRST PCMRA3		;Yes, it is still correct
	SKIPGE ABBRRL		;Was it a deletion?
	CAME D,ABBREN		;Was it exactly the target entry?
	JRST PCMRA2		;Not the target after a deletion
	HLLZS (B)		;Kill the entry value to invalidate it
	AOS ABBRCT		;Count invalidated entries
	JRST PCMRA3		;Target is now meaningless
PCMRA2:	ADD D,ABBRRL		;Relocate it one word one way or the other
	HRRM D,(B)		;Replace the target address
PCMRA3:	ADDI B,1
	SOJG C,PCMRA1
	SKIPN ABBRCT		;Were any abbreviations invalidated?
	RET			;No, all done
PCMRA4:	MOVEI B,1(A)		;Look at the entries
PCMRA5:	HRRZ C,(B)		;Get the data address
	SKIPE C			;Is it invalidated?
	AOJA B,PCMRA5		;Keep looking
	TBDEL%			;Delete it
	CALL PCMRAD		;Relocate after deletion
	SOSE ABBRCT		;One invalidated entry flushed, any more?
	JRST PCMRA4		;Yes, repeat
	RET
;Undefine PCL construct
;
;	UNDECLARE COMMAND (named) name
;		  ORIGINAL-COMMAND (named) name
;		  PROCEDURE (named) name
;		  SYNONYM (named) name
;		  VARIABLE (named) name
;

.UNDEC::MOVX A,PCFCFM		;Set current confirmation mode
	ANDCAM A,PCFLAG		;Assume quiet operation
	MOVX B,PCFQDC		;Get present policy
	TDNN B,PCFLAG		;Confirm?
	IORM A,PCFLAG		;Yes
	NOISE (from PCL)
	SKIPN PCLSTF		;Initialized?
	CALL PCINIT		;Do it now

UDFPRS:	MOVEI B,[FLDDB. .CMKEY,,$CUDEF,,,[
		 FLDDB. .CMSWI,,$SDEF,,,]]
	CALL FLDSKP
	 CMERRX
	LDB D,[331100,,(C)]	;See what was parsed
	CAIE D,.CMSWI		;A switch?
	JRST UDFKEY		;No, a keyword
	CALL GETKEY		;Get the data word
	MOVX D,PCFCFM		;Alter this bit
	SKIPN P3		;Clear it
	ANDCAM D,PCFLAG
	SKIPE P3		;Set it?
	IORM D,PCFLAG
	JRST UDFPRS

UDFKEY:	CALL GETKEY		;Get the keyword data
	CALLRET (P3)		;Handle it: Command, Procedure, or Variable

$CUDEF:	TABLE
	T All,,.UDFAL
	T Command,,.UDFOB
	T Original-Command,,.UDFOC
	T Procedure,,.UDFOP
	T Synonym,,.UDFOB
	T Variable,,.UDFVR
	TEND

.UDFAL:	NOISE (customizations)
	CONFIRM
	SKIPE PCCURC		;Is anything active?
	ERROR <Illegal within PCL command>
	SKIPE PCFLDP		;Are there preserved commands?
	ERROR <Illegal with preserved commands>	;%(****TEMP****)%
	SETZM PCTXFR		;Forget all permanent storage
	SETZM PCSFRE		;Forget all temporary storage
	SETZM PCLPMT		;Forget prompts
	SETZM PCLPMT+3
	SKIPN PCFLDB		;Is there a writeable keyword table?
	JRST UDFAL1		;No
	MOVE B,PCFLDB+.CMDAT	;Point to it
	HRRZ A,(B)		;Get its length
	ADDI A,1		;Include the header
	CALL RETBUF
	SETZM PCFLDB		;Invalidate writeable keyword table
UDFAL1:	SETZM PCLPMT		;Forget the customized prompts
	MOVE A,[PCLPMT,,PCLPMT+1]
	BLT A,PCLPMT+5
	SETZM PCLGST
	SETZM PCLSTF		;Forget we are initialized
	RET

.UDFOP:	MOVEI Q2,1		;Procedure
	JRST UDFCOM
.UDFVR:	TDZA Q2,Q2		;Variable
.UDFOB:	SETO Q2,		;Command
UDFCOM:	NOISE (named)
	MOVEI B,[FLDBK. .CMFLD,,,<Name>,,PCLRTN] ;Ready for command/procedure
	SKIPN Q2		;Variable?
	MOVEI B,[FLDBK. .CMFLD,,,<Name>,,PCLVAR] ;Yes, different break set
	CALL FLDSKP		;Get a name
	 CMERRX
	CONFIRM
	MOVE A,CMABP		;See how long it is
	SETO B,
UDFRAI:	ILDB C,A
;	CAIL C,"A"		;[NIC1056]
;	  CAILE C,"Z"		;[NIC1056]
;	    SKIPA		;[NIC1056]
;	   TRO C,40		;[NIC1056] UC --> lc
	JUMPGE Q2,UDFRAN	;If command,
	CAIN C,"_"		;Is it source-level equivalent for hyphen?
	MOVEI C,"-"		;Yes, replace it with standard representation
UDFRAN:	DPB C,A
	ADDI B,1
	JUMPN C,UDFRAI
	HRLI A,(B)		;Make a stringvalue
	HRRI A,ATMBUF
	CALL PCIUDF		;Kill it
	SKIPE A			;Succeeded?
	RET			;Yes, return normally
	HRROI A,[ASCIZ /variable/] ;No, assume it was "Undeclare variable"
	SKIPGE Q2		;Was it "Undeclare command"?
	HRROI A,[ASCIZ /command/] ;Yes
	SKIPLE Q2		;Check for "Undeclare procedure"
	HRROI A,[ASCIZ /procedure/]
	HRROI B,ATMBUF		;Get name user specified
	ERROR <No such %1\ as "%2\">

.UDFOC:	NOISE (named)
	SKIPN PCFLDB		;Is the FLDDB initialized?
	CALL PCMCKT		;Make keyword table and build FLDDB
	HLLZS PCFLDB		;Clear out link
	MOVEI B,PCFLDB		;Find original command name
	CALL FLDSKP
	 CMERRX <Unrecognized command>
	CONFIRM
	HRRZ C,(B)		;Point to data word
	HRRZ C,(C)		;Get the entry point
	CAIN C,PCDO		;Is it a PCL command?
	ERROR <Not an original command>
	HLRZ C,(B)		;Point to the command name string
	MOVE B,(C)		;Look at first word
	TLNN B,774000		;Is it an abbreviation entry?
	ADDI C,1		;Yes, string is in next word
	MOVE A,C		;Pass as parameter
	HRLI C,(POINT 7,0)	;Make byte pointer
	SETZ B,			;Count the characters
	ILDB D,C
	SKIPE D
	AOJA B,.-2
	HRL A,B			;Make stringvalue
	SETZ B,			;No target
	CALLRET PCIDFS		;Define entry
; Undefine a single command, procedure, or variable
; Called to remove name from command keyword table
;	R1 = Class of object
;	R2 = Address of ASCIZ name

PCMUDF::CAIN A,GSCCLC		;Command?
	JRST UDFCM1		;Yes
	CAIE A,GSCCLS		;Synonym?
	RET			;No
UDFCM1:	MOVE A,PCFLDB+.CMDAT	;Find present definition
	HRLI B,(POINT 7,0)	;For this name
	PUSH P,B		;Save the pointer
	TBLUK%
	TXNN B,TL%EXM		;Exact match?
	JRST [	ADJSP P,-1	;No, don't understand why
		RET]
	MOVE B,A		;Delete this entry
	MOVE A,PCFLDB+.CMDAT
	TBDEL%
	MOVEI A,CTBL1		;Find original definition
	EXCH B,(P)		;Save entry address, recover name pointer
	TBLUK
	TXNN B,TL%EXM		;Exact match?
	JRST UDFCM2		;No, must shuffle abbreviations
	MOVE B,(A)		;Get the original definition
	MOVE A,PCFLDB+.CMDAT	;Reinsert the original definition
	TBADD
	ADJSP P,-1		;No need for entry address
	RET			;All done

UDFCM2:	MOVE A,PCFLDB+.CMDAT	;Fix the table
	POP P,B			;Get back address of deleted entry
	CALLRET PCMRAD		;Relocate abbreviations
;"Information default declare"

.IDDCL::HRROI A,[0]		;CM156 ASSUME NO NO
	MOVX B,PCFQDC		;CM156 GET QUIET-DECLARATION BIT
	TDNE B,PCFLAG		;CM156 IS IT SET?
	HRROI A,[ASCIZ /no/]	;CM156 YES, NO CONFIRMATION
	ETYPE < Set default Declare /%1Mconfirm%_> ;CM156
	RET			;CM156
; Preserve (PCL) COMMAND

;	PRESERVE (PCL) ENVIRONMENT (in file) filespec
;and	PRESERVE (PCL) EXEC (in file) filespec
;(USED TO BE:)
;	SAVE/ENVIRONMENT (in file) filespec
;and	SAVE/EXEC (in file) filespec

.PRESE::NOISE <PCL>
	KEYWD $PRESE
	 T Environment,,.PRENV
	 JRST CERR
	JRST (P3)		;GO PROCESS THE COMMAND

$PRESE:	TABLE
	T Environment,,.PRENV
	T Exec,,.PREXC
	TEND

;Preserve (PCL) environment
;
;	PRESERVE (PCL environment on file) filespec
;(USED TO BE:)
;	SAVE/ENVIRONMENT (on file) filespec

.PRENV::STKVAR <WRTJFN>
	NOISE (in file)
	MOVE A,[[ASCIZ/EXEC/],,[ASCIZ/ENV/]] ;Default name and type
	CALL COUTFN		;Get name
	 JRST CERR
	MOVEM A,WRTJFN		;Save JFN
	CONFIRM
	MOVE A,WRTJFN		;See if it is a disk file
	DVCHR%
	LDB B,[221100,,B]	;Get DV%TYP
	CAIE B,.DVDSK		;Is it a disk?
	ERROR <Output to non-disk not permitted>
	MOVE A,WRTJFN		;Open the file
	MOVX B,FLD(^D36,OF%BSZ)+OF%APP
	CALL $OPENF		;Open the file
	CALL PCIWEV		;Write environment
	MOVE A,CSBUFP		;Get file name into buffer
	MOVE B,WRTJFN
	SETZ C,
	JFNS%
	MOVE A,CSBUFP		;Point to it
	ETYPE < %1M Saved>	;Confirm it
	RET			;All done, let cleanup close it
; Preserve (PCL) Exec
;
;	PRESERVE (PCL) EXEC (in file) filespec
;(USED TO BE:)
;	SAVE/EXEC (on file) filespec

.PREXC::STKVAR <WRTJFN>
	NOISE (in file)
	MOVE A,[[ASCIZ/EXEC/],,[ASCIZ/EXE/]] ;Default name and type
	CALL COUTFN		;Get name
	 JRST CERR
	MOVEM A,WRTJFN		;Save JFN
	CONFIRM
	CALL PCIPSV		;Mark all symbols as preserved
	MOVE A,[PCFLDB,,PCFLDP]	;Move field descriptor block
	BLT A,PCFLDP+.CMHLP	;To preserve it
	SETZM PCFLDB		;Invalidate user field descriptor block
	MOVE A,CSBUFP		;Get file name into buffer
	MOVE B,WRTJFN
	SETZ C,
	JFNS%
	SETOM CUSTMF		;Indicate customized Exec
	MOVSI A,.FHSLF		;Build save parameters
	HRR A,WRTJFN
	MOVX B,FLD(-FREEPN,SS%NNP)+SS%CPY+SS%UCA+SS%RD+SS%EXE+SS%WR
	SETZ C,
	SSAVE%			;Save the image
	 ERJMP CJERRE
	MOVE A,CSBUFP
	ETYPE < %1M Saved%_>	;Confirm it
	RET
; List defined PCL objects
; Called from Information command.

.PCLOB::SKIPN PCLSTF		;Initialized?
	CALL PCINIT		;No, do it now
	CALL PCIINF		;Get information
	SKIPE A			;Was there any?
	UETYPE @A		;Yes, write it out
	RET			;All done
; Display one global variable
; Called from Information command
.PCLVR::SKIPN PCLSTF		;Initialized?
	CALL PCINIT		;No, do it now
	NOISE (Named)
	MOVEI B,[FLDBK. .CMFLD,,,<Variable name>,,PCLVAR]
	CALL FLDSKP
	 CMERRX
	CALL BUFFF
	CONFIRM
	CALL PCIDGS		;Get something to type
	SKIPG A			;Was there anything?
	ERROR <No such variable>
	UTYPE @A		;Type it out
	RET
; Set PCL variable
; Called from Set command

SINVAR::TDZA Q1,Q1		;Set switch
SSTVAR::SETO Q1,
	STKVAR <VARSTR,VARPTR>
	MOVEM Q1,VARSTR		;Remember which type
	SKIPN PCLSTF		;Initialized?
	CALL PCINIT		;No, do it now
	NOISE (named)
	MOVEI B,[FLDBK. .CMFLD,,,<variable name>,,PCLVAR]
	CALL FLDSKP
	 CMERRX
	CALL BUFFF		;Buffer it
	MOVEM A,VARPTR
	NOISE (to)
	SKIPN VARSTR		;A string?
	JRST SETVR1		;No
	LINEX <string>		;Read rest of line
	 CMERRX
	CONFIRM
	MOVE A,CMABP		;Count it
	CALL BCOUNT
	HRLI C,(B)		;Make stringvalue
	HRRI C,ATMBUF
	JRST SETVR2

SETVR1:	DECX <number>		;Get value
	 CMERRX
	MOVEM B,C
	CONFIRM

SETVR2:	MOVE A,VARPTR		;Get pointer to variable name
	MOVE B,VARSTR		;Get type
	CALL PCISGS		;Set it
	JUMPG A,R		;Done
	SKIPL A			;Which error?
	ERROR <No such variable>
	ERROR <Variable not of that type>
; All generated-command invocations come here directly from
; command input to begin a command.  It creates an Execution
; Context Block and calls CGIRUN to initialize the procedure-state variables
; to allow execution of the requested procedure's code.
; It returns to the calling command input routine with the command state
; (CBUF, SBLOCK, CJFNBK) saved away for possible PARSEs.  On return, the
; current input JFN is the .NULIO designator, which RFIELD will recognize
; later as the PCL code.

PCDO:	MOVE A,TAKLEN		;SEE HOW MANY TAKES IN PROGRESS
	CAIL A,TAKLNX		;MAKE SURE ROOM FOR ANOTHER
	ERROR <Command files nested too deeply>	;No
	SKIPN PCLSTF		;Initialized?
	CALL PCINIT		;No, do it now
	MOVE B,COMAND		;Point to entry in the Keyword table
	HLRZ A,(B)		;Point to the string which matched
	HRLI A,(POINT 7,0)	;Make it a string pointer
	CALL BCOUNT		;Get its length
	HRLI B,(B)		;Make a stringvalue
	MOVE A,COMAND
	HLR B,(A)
	PUSH P,B		;Save name
	MOVE A,B
	SETZ B,			;Only nonsuperceded entries
	SKIPE PCLDCO		;Is this an original command?
	SETO B,			;Yes, require preserved entry
	CALL PCIFGS		;Find global symbol
	JUMPL A,PCDOEX		;No such name
	LOAD B,GSTCLS,(A)	;Get class
	CAIN B,GSCCLS		;Synonym?
	JRST PCDOSY		;Yes, handle it
	MOVE P1,A		;Save GST address
	MOVEI A,ECBLEN		;Get space for execution context block
	CALL GTBUFX		;Use permanent storage
	STOR P1,ECBGSC,(A)	;Save GST address in ECB
	STOR P1,ECBPRC,(A)	;Also current routine
	MOVE P1,A		;Save ECB address
	POP P,B			;Get back name
	MOVE A,P1		;Pass ECB
	CALL PCIRUN		;Initialize ECB for procedure execution
	JUMPE A,PCDOER		;No such procedure
	SKIPE A,PCCURC		;Top-level PCL command?
	 JRST PCDO2		;No
	MOVX A,1		;Yes, flag we haven't confirmed it
	MOVEM A,PCCIPF		; yet (for ^T)
	SKIPE A,PCLNAM		;Is there a current PCL name?
	 JRST [ CALL PIOFF	;Yes, be paranoid
		CALL STREM	;Release the string
		SETZM PCLNAM	;Don't release it again later
		CALL PION	;^C is ok again
		JRST .+1]	;Join common code
	MOVE B,COMAND		;Point to entry in the Keyword table
	HLRZ A,(B)		;Point to the string which matched
	HRLI A,(POINT 7,0)	;Make it a string pointer
	CALL XBUFFS		;Save command name
	MOVEM A,PCLNAM		;Store pointer to it
	MOVE A,PCCURC		;Get back current context
PCDO2:	STOR A,ECBNXT,(P1)	;So I can get back
	LOAD A,ECBGSC,(P1)	;Point to global symbol entry
	LOAD A,GSTPSV,(A)	;Get whether it is preserved
	STOR A,ECBPSV,(P1)	;Remember whether it is a preserved execution
	MOVEM P1,PCCURC		;New current context
	MOVEI A,ECBCSB(P1)	;Save Command State Block
	HRLI A,SBLOCK		;Which caused this invocation
	BLT A,ECBCSB+.CMGJB(P1)	;In case its context forces a reparse
	MOVE A,CMRTY		;Save prompt pointer
	STOR A,ECBOPM,(P1)
	MOVE A,REPARA		;Save reparse address
	STOR A,ECBORA,(P1)
	MOVEI A,ECBCBF(P1)	;Save for Command Buffer
	HRLI A,CBUF
	BLT A,ECBCBF+CBUFL-1(P1)
	MOVEI A,.CHLFD		;Fake end of line
	DPB A,CMPTR		;So .CMINI works
;	JE ECBPRC,(P1),PCDOPF	;If procdef, don't bother with terminal
	MOVE A,COJFN		;Fake .CMINI into thinking
	RFPOS%			;Terminal is at left margin
	STOR B,ECBPOS,(P1)	;Save current screen location
	HLLZS B			;To eliminate annoying CR
	SFPOS%			;During parameter parsing
	SKIPE PCSFRE		;Need to initialize string space?
	JRST PCDOPF		;No
	MOVSI A,PCSTRL*512	;Initialize string space
	MOVEM A,PCSTRS
	MOVEI A,PCSTRS
	MOVEM A,PCSFRE

PCDOPF:	MOVE B,COMAND		;Point to the name again
	HLRO A,(B)		;Point to the string
	CALL GETSIX		;Turn it to sixbit
	 NOP			;Truncate if too long
	STOR A,ECBCMN,(P1)	;Save the name
	HRR A,COJFN		;Now define new I/O level
	HRLI A,.NULIO		;As NUL:,,previous output
	MOVE B,TAKDEF		;Use default bits
	CALL PUSHIO
	RET			;Go back to start up the procedure

PCDOSY:	ADJSP P,-2		;Throw away synonym name and return from PCDO
	LOAD B,GSTTXT,(A)	;Get address of target name
	HRLI B,(POINT 7,0)	;Make it a string pointer
	MOVE A,PCFLDB+.CMDAT	;Point to command table
	TBLUK			;Find the real command
	TXNN B,TL%EXM		;Is it there?
	ERROR <Synonym does not refer to known command>
	MOVEM A,COMAND		;This is the actual command used
	JRST CIN2		;Go dispatch it

PCDOER:	MOVEI A,ECBLEN		;Return the ECB
	MOVEI B,(P1)
	CALL RETBUF
PCDOEX:	ERROR <Internal error - no such command procedure>
; Command Generator
; Called from EXECSU-FIELD when a COMND% hits an end-of-file, and the
; file turned out to be .NULIO.
; This routine will, with the intercession of EXECPI, invoke the PCL
; Executer to execute (or to continue to execute) the instructions
; of an already-compiled command procedure.  That procedure will either
; terminate or execute a Perform statement (it may do more, but these
; are the only cases of concern to this routine).  In the former case
; it will return +1 to EXECSU, indicating that no more command bytes
; will be generated from this stored command invocation; in the latter
; case it will append the string provided by the user's Perform statement
; to the Command Buffer after CMPTR, update CMINC, and return +2 to EXECSU
; so that the same COMND% may be successfully reexecuted with the new input.
;
; Returns +1 if nothing put in buffer
;	  +2 if Performed command appended to command buffer
; Alters no registers in either case

PCMXCT::SKIPN PCCURC		;Is any procedure being performed?
	RET			;No, use probably said "TAKE NUL:"
	SAVEAC <A,B,C,D,Q1>	;Save what BLISS36C linkage-type won't
	MOVE B,PCCURC		;Point to current execution context
	LOAD A,ECBDOT,(B)	;Get Exec output operand designator
	CAIN A,777777		;Is it there?
	JRST PCEXC1		;No
	SOS TAKLEN
	SKIPG TAKLEN		;;Overly decremented?
	IFNSK.			;;
	  BUG			;;Yes, make a dump
	  AOS TAKLEN		;;Fix it
	ENDIF.			;;
	CALL FIXIO
	MOVE B,PCCURC		;Get the current execution context again

PCEXC1:
;;	LOAD A,ECBCMN,(B)	;Get command name
;;	OPSTR <SKIPN>,ECBNXT,(B) ;Top-level PCL command?
;;	SETNM%			;Tell system
	LOAD A,ECBGSC,(B)	;Point to command's GST entry
	LOAD A,GSTNMA,(A)	;Point to command's name
	HRLI A,(POINT 7,0)	;Make it a pointer
	MOVEM A,COMAND		;This command is now in progress (again)
	HRLI A,CJFNBK		;Save GTJFN block
	HRRI A,ECBCJB(B)
	BLT A,ECBCJB+.GJBFP(B)
	MOVE A,CMPTR		;and prepare to fill the command buffer
	PUSH P,A		;Preserve it
	CALL PCEXCT		;Invoke the executer
	POP P,CMPTR		;Restore pointer
	CAMN A,[-3]		;Exit to program?
	JRST PCMXC2		;Yes
	JUMPLE A,PCMPOP		;Done if procedure simply finished
	ADDM A,CMINC		;This many valid unparsed characters now
	MOVN C,A		;Set up for trace
	MOVE A,COJFN
	MOVE B,CMPTR
	MOVX D,PCFTRC		;Trace generated commands?
	TDNE D,PCFLAG
	SOUT%			;Yes, type string out
	MOVE A,PCCURC		;Reload GTJFN block
	HRLI B,ECBCJB(A)
	HRRI B,CJFNBK
	BLT B,CJFNBK+.GJBFP
	LOAD B,ECBDOT,(A)	;Get Exec output operand designator
	CAIN B,777777		;Is there one?
	RETSKP			;No, return
	LOAD A,ECBDNT,(A)	;Get PTY/ITY number
	TXO A,.TTDES		;Make a terminal designator out of it
	HRLI A,.NULIO		;Input stays as usual
	MOVEM A,CMIOJ		;Use this for COMND I/O
	MOVE B,TAKDEF		;Use default bits
	CALL PUSHIO		;Make a temporary I/O level
	RETSKP			;Allow RFIELD to parse the command
PCMXC2:	CALL PCMPOP		;All done with PCL execution
	CALL $CONTI		;Make sure a program is there
	JRST ..CONT		;Just continue the current program
; Terminate one execution context on completion or error.
; This involves returning the entire system context to the
; way it was when the command was started, including the I/O
; stack, the Exec's COMND% tables, and the terminal cursor position.
; Entry at PCMPOE merely frees the ECB storage and pops the ECB list.
; Entry at PCMPOS does everything except popping the I/O stack for the
; execution context (if DoCommand To was in progress, however, it just
; pops that I/O level and returns, since the real context is further
; down the I/O stack).

PCMPOS::MOVEI A,1		;Clean everything but I/O stack
	JRST PCMPO1
PCMPOE: TDZA A,A		;Just clean up ECB
PCMPOP::SETO A,			;Clean up everything
PCMPO1:	SAVEAC <A,B,Q1,Q2>
	MOVE Q2,A		;Save flag
	MOVE Q1,PCCURC		;Point to current context
REPEAT 0,<			;Procdefs are gone
	JN ECBPRC,(Q1),POPTCX	;If not procdef, no actual arguments
	LOAD A,ECBCTA,(Q1)
	LOAD B,ECBALS,(Q1)
	SKIPE A
	CALL RETBUF		;Free actual argument list
	SETONE ECBPOS,(Q1)	;Invalidate the pointer
;	JRST POPDTD		;Go pop I/O stack
POPTCX:
>

	JUMPLE Q2,POPCSB	;Is this just CIOREL?
	LOAD A,ECBDOT,(Q1)	;Yes, get Exec output operand designator
	CAIN A,777777		;Is there one?
	JRST POPCSB		;No
	SETO A,			;Invalidate it
	STOR A,ECBDOT,(Q1)	;So the ECB will be eliminated next time
	RET

POPCSB:	JUMPE Q2,POPECB		;Skip this if caller did it
	MOVE A,ECBCSB+.CMFLG(Q1) ;Get flags and reparse address
	MOVEM A,SBLOCK+.CMFLG	;Restore it always
	HRRZ A,CIJFN		;Check current input
	CAIE A,.NULIO		;Was I doing a Parse?
	JRST POPECB		;Yes, don't do this twice
	HRLI A,ECBCSB(Q1)	;Restore command state block
	HRRI A,SBLOCK		;to caller's terminal context
	BLT A,SBLOCK+.CMGJB
	LOAD A,ECBOPM,(Q1)	;Restore prompt pointer
	MOVEM A,CMRTY
	LOAD A,ECBORA,(Q1)	;and reparse address
	MOVEM A,REPARA
	HRLI A,ECBCBF(Q1)	;Also restore command buffer
	HRRI A,CBUF
	BLT A,CBUF+CBUFL-1
	MOVE A,COJFN		;Reset monitor's idea
	LOAD B,ECBPOS,(Q1)	;of where the cursor is
	SKIPL B			;Is it valid?
	SFPOS%			;Yes, set it

POPDTD:	JUMPG Q2,POPECB		;Skip this if caller popped stack
	LOAD A,ECBDOT,(Q1)	;Get Exec output operand designator
	CAIN A,777777		;Is there one?
	JRST POPIOS		;No
	SOS TAKLEN
	SKIPG TAKLEN		;;Overly decremented?
	IFNSK.			;;
	  BUG			;;Yes, make a dump
	  AOS TAKLEN		;;Fix it
	ENDIF.			;;

POPIOS:	SOS TAKLEN
	SKIPG TAKLEN		;;Overly decremented?
	IFNSK.			;;
	  BUG			;;Yes, make a dump
	  AOS TAKLEN		;;Fix it
	ENDIF.			;;
	CALL FIXIO

POPECB:	SETO A,			;Don't kill a program fork
	CALL PCICLP		;Get rid of JFN's
	MOVE B,PCCURC		;Point to current context
	LOAD A,ECBNXT,(B)	;Previous context
	MOVEM A,PCCURC		;It is now current
	MOVEI A,ECBLEN		;Now free it
	CALL RETBUF
	SETZM PCPRGR		;Reset so normal programs work
	SETZM CIPF		;Command no longer in progress
	SKIPE PCCURC		;Was that the last execution context?
	RET			;No
	SETZM PCCIPF		;Yes, flag no PCL command in progress now
	SETZM PCWAIT		;Don't skip WFORK% for next program run
	SETZM PCSFRE		;Wipe away the string space
	SKIPL A,PCFORK		;Saved value of FORK (-1 unless error during
				; INVOKE or TYPEIN statement)
	 MOVEM A,FORK		;Yes, restore correct value
	SETOM PCFORK		;Say no saved value of FORK
	SKIPL A,PCRNFK		;Saved value of RUNFK?
	 MOVEM A,RUNFK		;Restore it, too
	SETOM PCRNFK		;Say no saved value of RUNFK
	SETO A,			;And free the execution stack and string space
	MOVE B,[.FHSLF,,PCSTKP]	;from the drum
	MOVX C,PM%CNT+FLD(PCSTKL+PCSTRL,PM%RPT)
	PMAP%
	RET			;All done
; Do a COMND% to parse the arguments of the command procedure
;
; The COMND% is performed on the Command Buffer as it existed when
; the current command procedure was invoked; the COMND% will likely
; append to the buffer, and it is saved in the context block again
; afterwards.  Further, when the COMND% is done the I/O stack is
; likewise restored to the original state, so that EOF and error
; routines in EXECSU are not surprised.
;
; Arguments are:
;   R1: address of first FLDDB in chain, or zero for a .CMINI
;   R2: address of word into which COMND%'s returned R2 should be stored,
;	or pointer to prompt string of .CMINI
;   R3: flag saying whether a reparse can be tolerated (low bit on) and
;       whether to allow indirect files (bit 34 on); for .CMINI, nonzero
;	to indicate echoing
; Returns in R1 the address of the successful FLDDB, or -1 for CM%NOP,
; or -2 for reparse.

PCMPRS::PUSH P,16		;Save linkage register
	PUSH P,A		;Save arguments
	PUSH P,B
	PUSH P,C
	MOVE Q1,PCCURC		;Point to context block
	HRLI A,ECBCSB(Q1)	;Restore invoker's Command State Block
	HRRI A,SBLOCK
	BLT A,SBLOCK+.CMGJB
	HRLI A,ECBCBF(Q1)	;and Command Buffer
	HRRI A,CBUF
	BLT A,CBUF+CBUFL-1
	SOS TAKLEN		;RESTORE CALLER'S IO
	SKIPG TAKLEN		;;Overly decremented?
	IFNSK.			;;
	  BUG			;;Yes, make a dump
	  AOS TAKLEN		;;Fix it
	ENDIF.			;;
	CALL FIXIO
	MOVE A,COJFN
	LOAD B,ECBPOS,(Q1)	;Where screen was last time
	SFPOS%
	MOVEI A,PCMRPA		;Ready for reparse
	HRRM A,CMFLG
	MOVX A,CM%XIF		;Assume indirect files allowed
	ANDCAM A,CMFLG
	MOVX B,1B34		;See if caller agrees
	TDNN B,0(P)		;Does he?
	IORM A,CMFLG		;No, do not recognize atsign as indirection
	MOVEM P,PCRPAS		;Save P in case of reparse
	MOVE B,-2(P)		;Point to function
	JUMPE B,PRSINI		;Do a .CMINI
	CALL FIELD		;Interpret field in caller's command
	MOVEM B,@-1(P)		;Return R2 to Interface
	HRRZS C			;Get FLDDB address
	TXNE A,CM%NOP		;No Parse?
	JRST [	SETO C,		;Set return value appropriately
		JRST PRSRST]
	LOAD A,ECBECO,(Q1)	;Get echo status
	JUMPE A,PRSRST		;Echo on, clean up
	LDB A,[POINTR ((C),CM%FNC)] ;Get function code
	CAIE A,.CMCFM		;Confirmation?
	JRST PRSRST		;No, done with context
	MOVE A,.CHLFD		;Fix the buffer
	DPB A,CMPTR		;so nobody tries to redo it
	ETYPE <%_>		;Do carriage return since it wasn't echoed
	CALL DOECHO		;Turn echoing on again
	SETZ A,
	STOR A,ECBECO,(Q1)
PRSRST:	PUSH P,C		;Save return value
	MOVEI A,REPARS		;Restore normal reparse address
	HRRM A,CMFLG
	HRLI A,.NULIO		;Push back to my context
	HRR A,COJFN
	CALL PUSHIO
	MOVEI A,ECBCSB(Q1)	;Save the command state again
	HRLI A,SBLOCK
	BLT A,ECBCSB+.CMGJB(Q1)
	MOVEI A,ECBCBF(Q1)
	HRLI A,CBUF
	BLT A,ECBCBF+CBUFL-1(Q1)
	MOVEI A,.CHLFD		;Fake end of line
	DPB A,CMPTR		;So .CMINI works
	MOVE A,COJFN		;Fake .CMINI into thinking
	RFPOS%			;terminal is at left margin
	STOR B,ECBPOS,(Q1)	;Save screen position
	HLLZS B			;to eliminate annoying CR
	SFPOS%			;during parsing
	LOAD A,ECBGSC,(Q1)	;Point to command's GST entry
	LOAD A,GSTNMA,(A)	;Point to command's name
	HRLI A,(POINT 7,0)	;Make it a pointer
	MOVEM A,COMAND		;This command is again in progress
	POP P,A			;Recover return value
	ADJSP P,-3		;Forget arguments
	POP P,16		;Restore linkage register
	RET			;Do completion for field descriptor

PRSINI:	SKIPE 0(P)		;Echo off?
	CALL NOECHO		;Turn it off
	CALL FIXIO		;Make sure we know it's a terminal
	MOVE A,-1(P)		;Point to prompt string
	CALL READ1		;Do the .CMINI
	LOAD A,ECBORA,(Q1)	;Restore reparse address
	MOVEM A,REPARA		;Since we won't be doing it that way
	JRST PRSRST		;All done

; COMND% reparses come here first when command procedure is asking
; for something.  I must clean up and erase the context so that
; things will work again.

PCMRPA:	MOVE P,PCRPAS		;Get back P from before call to FIELD
	MOVEI C,1		;Test low bit
	TDNN C,0(P)		;Will the user catch a reparse?
	JRST PRSXIT		;No, clean up and quit
	MOVNI C,2		;Return value -2
	JRST PRSRST		;Reset and return to caller

PRSXIT:	CALL PCMPOE		;Do clean up ECB only
	MOVEI A,REPARS		;Reset reparse address
	HRRM A,CMFLG
	JRST REPARS		;Go do normal stuff
; Common error exit for PCL
; Called direct from internal routine with pointer to error text on stack.

PCMXER::PUSH P,A		;Save error pointer
	CALL PCMPOP		;Forget this context
	POP P,A			;Recover error
PCMCER::UERR (A)		;Go to common error

; Common command parsing error exit for PCL
; Called direct from argument parsing with pointer to error text on stack

PCMPER::PUSH P,A		;Save error
	CALL PCMPOP		;Forget this context
	POP P,A
	UCMERR (A)		;Go to common error
; Enter here from PSI system when the program controlling PTY/PDI goes hungry

PCMPSI::PUSH P,A		;Save a register
	SKIPN PCCURC		;Inside PCL?
	 JRST BOGPSI		;No, bad PSI
	SKIPG A,FORK		;Have a fork?
	 JRST BOGPSI		;Also bogus
;	SKIPN PCPRGR		;Do we think we're controlling a program?
	TMNN FK%INV,SLFTAB(A)	;CM156 If not controlled by PCL
	 JRST BOGPSI		;That's bogus, too
	FFORK%			;So it is settled down for fork-termination
	 ERJMP .+1		;It may have disappeared mysteriously
	SETOM PCWAIT		;Don't do WFORK
	HRRZ A,PCTAB+LV.PCL	;See where I was interrupted
	CAIE A,WFORKX		;Do I need to change the PC
	CAIN A,WFORKX+1		;to terminate a wait?
	JRST [	MOVX A,PC%USR	;Yes, modify processor flags
		IORM A,PCTAB+LV.PCL ;So WFORK% drops out
		JRST .+1]
	POP P,A
	DEBRK			;Nothing to do, really

BOGPSI:	POP P,A
	DEBRK%			;Here on bogus PTY-hungry PSI.  We don't
				; just jump to the DEBRK% above to make
				; debugging easier
; Enter here from PSI system when the user program types out to the control PTY

PCMPSO::PUSH P,A		;Save used registers
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,Q1
	PUSH P,16
	CALL PCIPSO		;Process the interrupt
	POP P,16
	POP P,Q1
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	DEBRK
;Routine to check if a JFN is a PCL I/O JFN (ie, a jfn of a PTY/PDS
;used by the Exec for INVOKE or DOCOMMAND.
;
;Takes:
;	A/	jfn
;Returns:
;	+1	yes (JFN is in use by PCL)
;	+2	no
;Clobbers:
;	A,B
;
NPCLIO::
	MOVE B,PCCURC		;Get pointer to current ECB
NPCLOP:	SKIPN B			;Run out of ECB's?
	 RETSKP			;Yes, JFN must not be PCL's
	OPSTR <CAMN A,>,ECBCJT,(B) ;No, is JFN for INVOKE's PTY/PDS?
	 RET			;Yes
	OPSTR <CAMN A,>,ECBDJT,(B) ;Is JFN for DOCOMMAND?
	 RET			;Yes
	LOAD B,ECBNXT,(B)	;Get next ECB
	JRST NPCLOP		;Loop	
; Get a JFN for a file
; Argument R1 and R2 are set up
; Returns JFN or -1

PCMGJS::CALL GTJFS
	 SETO A,		;Failure
	RET			;Return JFN to caller
; Get memory

PCMGMM::CALL GETMEM		;Use general space allocator
	 ERROR <Exec free pool exhausted>
	MOVE A,B		;Use standard value register
	RET

; Get memory and return zero on error

PCMGME::CALL GETMEM
	 SETZ B,
	MOVE A,B
	RET
; Convert string to integer
;  R1 = Length of string
;  R2 = Pointer to string
;  Returns value in R1

PCMSTI::PUSH P,D		;Save register to be changed
	PUSH P,Q1
	EXTEND A,[CVTDBO -"0"]
	 SETZB D,Q1		;Error, return zero
	MOVE A,Q1		;Return number
	POP P,Q1
	POP P,D
	RET

; Convert integer to string
;   R1 = Number
;   R2 = Pointer to string
; Returns R1 = Pointer to last character of string

PCMITS::PUSH P,D		;Save registers
	PUSH P,Q1
	MOVE Q1,B		;Set pointer
	MOVE B,A		;Set number
	SETZ A,
	MOVEI D,20		;Assume plenty of room
	EXTEND A,[CVTBDO "0"]
	 TRN
	MOVE A,Q1		;Return final pointer
	POP P,Q1
	POP P,D
	RET
; Set program name

PCMSPN::
	MOVE B,A		;Switch arguments
	MOVE A,FORK
	MOVEM A,RUNFK		;Set this up for later
	CALL SFKNAM
	RET

PCMWTF::TLO Z,RUNF		;Say fork is running
	CALL WAITA		;Resume fork and wait for it to finish
	TLZ Z,RUNF		;No longer running
	RET

;Set and clear the "fork is INVOKE'd" flag.  Take fork handle in A

SETINV::MOVX B,FK%INV		;Get INVOKE'd flag
	IORM B,SLFTAB(A)	;Set it in the fork table
	RET

CLRINV::MOVX B,FK%INV		;Get INVOKE'd flag
	ANDCAM B,SLFTAB(A)	;Clear it from fork table
	RET

	END