Trailing-Edge
-
PDP-10 Archives
-
BB-FT68G-SM
-
exec/execpm.mac
There are 9 other files named execpm.mac in the archive. Click here to see a list.
; 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). REMOVE PCMSVP (SAV/EXE)
; UPD ID= 50, SNARK:<5.EXEC>EXECPM.MAC.4, 22-Aug-81 14:22:13 by CHALL
;TCO 5.1072 PCMXCT- THE CALL TO FIXIO FRAGS AC B, SO RESTORE IT
; UPD ID= 42, SNARK:<5.EXEC>EXECPM.MAC.3, 17-Aug-81 09:39:40 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
;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.,<_>,<->)
; 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?
JRST CJERR ;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
SETO B, ;Count the characters
ILDB C,A
CAIL C,"a" ;And fold to upper case
TRZ C,040
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,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" ;Is it lower case?
CAILE C,"z"
TRNA ;No
TRZ C,040 ;Fold to upper case
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
RET
.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
; Preserve PCL environment
;
; PRESERVE (PCL environment on file) filespec
;(USED TO BE:)
; SAVE/ENVIRONMENT (on file) filespec
;
.PRESE::STKVAR <WRTJFN>
NOISE (PCL environment 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 ;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
REPEAT 0,<
; Save PCL Exec
;
; SAVE/EXEC (on file) filespec
;
;REMOVED (ACH - 10/2/81) IF IT'S EVER PUT BACK IN, CHANGE THE SYNTAX SO
;IT'S NOT A SAVE COMMAND
PCMSVP::STKVAR <WRTJFN>
NOISE (on 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
> ;END REPEAT 0
; 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,<VARNAM,8>,VARLEN,VARPTR,VARVAL>
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 A,(B) ;Make stringvalue
HRRI A,ATMBUF
MOVEM A,VARVAL
JRST SETVR2
SETVR1: DECX <number> ;Get value
CMERRX
MOVEM B,VARVAL
CONFIRM
SETVR2: MOVE A,VARPTR ;Get pointer to variable name
MOVE B,VARSTR ;Get type
MOVE C,VARVAL ;Get new value
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
MOVE A,PCCURC ;Current context in effect
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
CALL FIXIO
MOVE B,PCCURC ;Get the current execution context again
PCEXC1: LOAD A,ECBCMN,(B) ;Get command name
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
POPIOS: SOS TAKLEN
CALL FIXIO
POPECB: SETZ 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 PCSFRE ;Wipe away the string space
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
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
SKIPLE A,FORK ;Stop the fork
FFORK% ;So it is settled down for fork-termination
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
; 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
; 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
END