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