Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - mit/exec/execpm.mac
There are 9 other files named execpm.mac in the archive. Click here to see a list.
;125 Fix PCL line-positioning bug
;715 add PCL features
;713 add literals label
;712 CMU PCL 5(100) release version
;<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
;The Programmable Command Language Macro Interface
;
; Copyright (C) 1980, Carnegie-Mellon University
;

	SEARCH EXECDE
	TTITLE EXECPM

PCLF,<				;715

;Execution Context Block
;   Note:This definition had better match the definition in EXECPD. 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 NOP:
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
	GTFLDT D		;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
	CAIN P3,0		;Clear it?
	 ANDCAM D,PCFLAG
	CAIE P3,0		;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!CF%GRP!CF%EOL!CF%NS
	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,[POINTR B,DV%TYP]	;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
	ETYPE < [Enter source, end with Escape or ^Z]%_>
	MOVX 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
	MOVX 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 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
	SETO B,			;Count the characters
	ILDB C,A
	CAIL C,"a"		;And fold to upper case
	 TRZ C,40
	DPB C,A
	ADDI B,1
	JUMPN C,.-5
	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,(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. 
;
;   ACCEPTS:	A/	Class of object
;		B/	Address of ASCIZ name
;		C/	-1 if known duplicate, 0 if original
;		D/	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
	MOVX 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:	MOVX A,.FHSLF		;Get the error code
	GETER
	HRRZ B,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,(ASCPTR)
	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:	MOVX A,10		;Add 8 words at a time
	CALL PCMEKT		;Expand keyword table
	JRST CMDFO3		;Try the insert again

CMDFO2:	HRRZ A,DFONAM
	HRLI A,(ASCPTR)
	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:	MOVX A,10		;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,(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
;
;   ACCEPTS:	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,(B)		;Get its current length
	ADDI A,(C)		;Make room for more commands
	HLL A,(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,(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
;
;  ACCEPTS:	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
	HLRZ D,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
;
;  ACCEPTS:	A/	Address of header of table
;		B/	Address of inserted or deleted entry
PCMRAI:	MOVX D,1		;Insertion: Add one word to affected entries
	ABSKP
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
	CAIE C,0		;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
	GTFLDT D		;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
	CAIN P3,0		;Clear it
	 ANDCAM D,PCFLAG
	CAIE P3,0		;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:	MOVX 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
	CAIN Q2,0		;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"		;Is it lower case?
	 CAILE C,"z"
	  ABSKP			;No
	   TRZ C,40		;Fold to upper case
	JUMPGE Q2,UDFRAN	;If command,
	CAIN C,"_"		;Is it source-level equivalent for hyphen?
	 MOVX 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
	CAIE A,0		;Succeeded?
	 RET			;Yes, return normally
	HRROI A,[ASCIZ/variable/] ;No, assume it was "Undeclare variable"
	CAIGE Q2,0		;Was it "Undeclare command"?
	 HRROI A,[ASCIZ/command/] ;Yes
	CAILE Q2,0		;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
	TXNN B,177B6		;Is it an abbreviation entry?
	 ADDI C,1		;Yes, string is in next word
	MOVE A,C		;Pass as parameter
	HRLI C,(ASCPTR)		;Make byte pointer
	SETZ B,			;Count the characters
	ILDB D,C
	CAIE D,0
	 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
;
;   ACCEPTS:	A/	Class of object
;		B/	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,(ASCPTR)		;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]		;ASSUME NO NO
	MOVX B,PCFQDC		;GET QUIET-DECLARATION BIT
	TDNE B,PCFLAG		;IS IT SET?
	 HRROI A,[ASCIZ/no/]	;YES, NO CONFIRMATION
	ETYPE < set default declare /%1Mconfirm%_>
	RET
; Preserve (PCL) COMMAND

;	PRESERVE (PCL) ENVIRONMENT (in file) filespec
;	PRESERVE (PCL) EXEC (in file) filespec
;(USED TO BE:)
;	SAVE/ENVIRONMENT (in file) filespec
;	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
	T state,,.PREST		;7 like "EXEC" except FLDDB.s not changed
	TEND

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

.PRENV:	STKVAR <WRTJFN>		;7 make it local
	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,[POINTR B,DV%TYP]	;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

.PREST: SETOM CVAL0		;7 flag "preserve state"
.PREXC:	STKVAR <WRTJFN>		;7 make it local
	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
	SKIPE CVAL0		;7 preserve state?
	 JRST .PREX1		;7 yes, skip this stuff
	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
.PREX1:				;7 add local label
	MOVE A,CSBUFP		;Get file name into buffer
	MOVE B,WRTJFN
	SETZ C,
	JFNS%
	SETOM CUSTMF		;Indicate customized Exec
	MOVX 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
	CAIE A,0		;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
	CAIG A,0		;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
	CAIL A,0		;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,(ASCPTR)		;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,(ASCPTR)		;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)
	MOVX 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
;7 is this supposed to be ^D512?
	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,(ASCPTR)		;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:	MOVX 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::MOVX 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
				;Procdefs are gone
DELETE,<JN ECBPRC,(Q1),POPTCX	;If not procdef, no actual arguments
	LOAD A,ECBCTA,(Q1)
	LOAD B,ECBALS,(Q1)
	CAIE A,0
	 CALL RETBUF		;Free actual argument list
	SETONE ECBPOS,(Q1)	;Invalidate the pointer
;	JRST POPDTD		;Go pop I/O stack
POPTCX:
       >			;end DELETE
	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
;125 This resets the cursor position to what it was when the command started.
;125 That's wrong 99% of the time, since it ignores the output from the
;125 command.  There might be a need to reset something here in some special
;125 cases, but I don't understand the code well enuff to figure it out.
;125 In any case, I haven't noticed any bad side-effects of leaving this out.
;125	MOVE A,COJFN		;Reset monitor's idea
;125	LOAD B,ECBPOS,(Q1)	;of where the cursor is
;125	CAIL B,0		;Is it valid?
;125	 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
	MOVX 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.
;
;   ACCEPTS:	A/	address of first FLDDB in chain, or zero for a .CMINI
;		B/	address of word into which COMND%'s returned R2 should
;			    be stored, or pointer to prompt string of .CMINI
;		C/	flag saying whether a reparse can be tolerated (low bit
;			    on) and whether to allow indirect files (bit 34
;			    on); for .CMINI, nonzero o indicate echoing
;   RETURNS:	A/	-2 for reparse, or
;			-1 for CM%NOP, or
;			address of sucessful FLDDB.
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,(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
	HRRZ C,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
	GTFLDT A		;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)
	MOVX 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
	HLLZ B,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 (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
	MOVX C,1		;Test low bit
	TDNN C,(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
	 ERNOP			;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. 
;
;   ACCEPTS:	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:	CAIN B,0		;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
;
;   ACCEPTS:	A,B/	GTJFN arguments
;   RETURNS:	A/	JFN or -1 (failed)
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
;
;   ACCEPTS:	A,B/	GETMEM arguments
;   RETURNS:	A/	address of memory block or zero (failure)	
PCMGME::CALL GETMEM
	 SETZ B,
	MOVE A,B
	RET
;Convert string to integer
;
;  ACCEPTS:	A/	length of string
;		B/	pointer to string
;  RETURNS:	A/	value
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
;
;   ACCEPTS:	A/	number
;		B/	pointer to string
;   RETURNS:	A/	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,
	MOVX D,20		;Assume plenty of room
	EXTEND A,[CVTBDO "0"]
	 NOP
	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. 
;
;   ACCEPTS:	A/	fork handle
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

LITSPM:				;713 debugging aid: lieterals label
       >			;715 end PCL
	END