Google
 

Trailing-Edge - PDP-10 Archives - bb-jr93e-bb - 7,6/ap016/oprpar.x16
There are 2 other files named oprpar.x16 in the archive. Click here to see a list.
TITLE	OPRPAR	PARSING ROUTINE FOR OPR AND ORION
SUBTTL	Murray Berkowitz/PJT	12-SEP-85


;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION  1975,1976,1977,1978,1979,
;1980,1981,1982,1983,1984,1986,1987.  ALL RIGHTS RESERVED.
;		
;     THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;     AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
;     AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS
;     SOFTWARE  OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
;     OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO  TITLE  TO
;     AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;     THE INFORMATION  IN  THIS  SOFTWARE  IS  SUBJECT  TO  CHANGE
;     WITHOUT  NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;     BY DIGITAL EQUIPMENT CORPORATION.
;
;     DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
;     OF  ITS  SOFTWARE  ON  EQUIPMENT  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.

	SEARCH	GLXMAC,ORNMAC
	PROLOG	(OPRPAR)


	OPRVRS==:OPRVRS		;REFERENCE OPR/ORION'S AND
	%%.OPR==:%%.OPR		;ORNMAC'S VERSIONS

	TWOSEG
	RELOC	400000
SUBTTL	Table of Contents

;               TABLE OF CONTENTS FOR OPRPAR
;
;
;                        SECTION                                   PAGE
;    1. Table of Contents.........................................   2
;    2. Revision History..........................................   3
;    3. Entry points..............................................   4
;    4. Storage and constants.....................................   5
;    5. P$INIT  Initialize and set timer (TOPS20 only)............   6
;    6. PARINI  Initialize the database...........................   7
;    7. PARSER  Main entry to parse a command.....................   8
;    8. PARCMD  Do the command parse..............................   9
;    9. VALCMD  Process a valid command field.....................  10
;   10. PARRET  Setup arguments and return........................  11
;   11. PARERR  COMND JSYS  error routine.........................  12
;   12. CHKEOF  Check for end of take file........................  13
;   13. CLSTAK  Close the take file...............................  14
;   14. TAKCLR  Cleanup after take file...........................  14
;   15. ERREXT  Error return from parser..........................  15
;   16. INCORE  Check and setup for incore processing.............  16
;   17. CMDMES  Check and/or setup the command message............  17
;   18. SETPMT  Setup the prompt pointer..........................  18
;   19. RESCN    Rescan routine to setup initial command..........  19
;   20. Dispatch for Parser Save Routines.........................  20
;   21. SAVKEY/SAVSWI Save a switch or keyword....................  21
;   22. SAVFIL  Save a filespec...................................  22
;   23. SAVNUM  Save a number.....................................  23
;   24. SAVZER  Save a COMMA or CONFRM............................  23
;   25. SAVUQS  Save an unquoted string...........................  24
;   26. SAVATM  Save the atom as the argument.....................  24
;   27. SAVRES  Save a 2 word argument............................  25
;   28. SAVDEV  Save routine for a device.........................  26
;   29. SAVTOK  Save routine to save a token......................  27
;   30. SAVNOD  Save node specification...........................  27
;   31. SAVINI  Initialize the returned arguments.................  27
;   32. REPARS  Set up for COMND reparse..........................  28
;   33. FILDEF  Fill in defaults for COMND........................  29
;   34. PDBCPY  Copy a switch table...............................  30
;   35. STBDEL  Delete a local switch table entry.................  30
;   36. TXTINP  Multiple line text input routines.................  31
;   37. GETTXT  Get multiple lines of text........................  32
;   38. TAKFDB  TAKE command tables...............................  33
;   39. TAKDEF  Take default setting..............................  33
;   40. TAKRTN  Special routines for TAKE commands................  34
;   41. WAIFDB  WAIT command tables...............................  35
;   42. P$STAK  Setup TAKE command................................  36
;   43. P$TAKE  Routine to setup a TAKE command...................  37
;   44. P$SETU  Setup the parser block pointer address............  38
;   45. P$CURR  Get the address of the current entry..............  38
;   46. P$PREV  Position to previous parser entry.................  38
;   47. P$NEXT  Bump the pointer to next field....................  39
;   48. P$NFLD  Get header and data for a parser element..........  39
;   49. P$CFM   Check for a confirm in next block.................  40
;   50. P$COMMA Check for a comma in next block...................  41
;   51. P$KEYW  Get a keyword from the parsed data................  42
;   52. P$SWIT  Get a switch from the parsed data.................  43
;   53. P$USER  Get the user id field.............................  44
;   54. P$FLOT  Get the floating point number.....................  45
;   55. P$DIR   Get the directory field...........................  46
;   56. P$TIME  Get the time/date field...........................  47
;   57. P$NUM   Get a number from the parser block................  48
;   58. P$FILE  Get a filespec from the parser block..............  49
;   59. P$FLD   Get a text field from block.......................  50
;   60. P$NODE  Get a node from block.............................  51
;   61. P$SIXF  Get a sixbit field type...........................  52
;   62. P$RNGE  Get a range back..................................  53
;   63. P$TEXT  Get a text address and length.....................  54
;   64. P$DEV   Get a device address and length...................  55
;   65. P$QSTR  Get a quoted string...............................  56
;   66. P$UQSTR Get an unquoted string............................  57
;   67. P$ACCT  Get an account string.............................  58
;   68. P$NPRO  No processing required............................  59
;   69. P$GPDB  Get the PDB address if any data...................  60
;   70. P$PNXT  Get next PDB given a PDB block....................  61
;   71. P$PERR  Get error routine given a PDB block...............  62
;   72. P$PDEF  Get default filler routine given a PDB block......  63
;   73. P$PACT  Get action routine given a PDB block..............  64
;   74. P$INTR  Interrupt support code............................  65
;   75. SETTIM  Setup the timer function..........................  66
;   76. CLRTIM  Clear the timer function..........................  67
;   77. P$TINT  Timer interrupt routine...........................  68
;   78. CNTCHR  Count characters in the buffer....................  69
;   79. REPRMT  Do reprompt of command............................  70
;   80. P$HELP  Routine to display help from file.................  71
SUBTTL	Entry points

	ENTRY	PARSER			;MAIN ENTRY POINT
	ENTRY	P$GPDB			;GET THE PDB BLOCK
	ENTRY	P$PNXT			;GET NEXT PDB GIVEN A PDB BLOCK
	ENTRY	P$PERR			;GET ERROR BLOCK FROM PDB GIVEN A PDB
	ENTRY	P$PDEF			;GET DEFAULT FILLING ROUTINE GIVEN A PDB
	ENTRY	P$PACT			;GET ACTION ROUTINE GIVEN A PDB
	ENTRY	P$NARG			;NEXT ARGUMENT TYPE TO PROCESS
	ENTRY	P$SETU			;SETUP POINTER TO PARSER BLOCKS
	ENTRY	P$CURR			;GET THE CURRENT LOCATION
	ENTRY	P$PREV			;SET THE PREVIOUS TO CURRENT
	ENTRY	P$FLOT			;FLOATING POINT NUMBER
	ENTRY	P$TAKE			;SETUP STATE BLOCK FOR TAKE ROUTINE
	ENTRY	P$INIT			;PARSER INIT
	ENTRY	P$NPRO			;NO PROCESSING REQUIRED
	ENTRY	P$INTR			;PARSER INTERRUPTS
	ENTRY	P$TINT			;TIMER INTERRUPTS
	ENTRY	P$NFLD			;GET NEXT FIELD DATA
	ENTRY	P$DIR			;GET THE DIRECTORY FIELD
	ENTRY	P$NEXT			;GET TO NEXT FIELD
	ENTRY	P$TIME			;GET DATE/TIME
	ENTRY	P$COMMA			;COMMA CHECK
	ENTRY	P$CFM			;CONFIRM CHECK
	ENTRY	P$KEYW			;KEYWORD CHECK
	ENTRY	P$SWIT			;SWITCH CHECK
	ENTRY	P$USER			;USER CHECK
	ENTRY	P$NUM			;NUMBER CHECK
	ENTRY	P$FILE			;FILE SPEC CHECK
	ENTRY	P$IFIL			;INPUT FILE SPEC
	ENTRY	P$OFIL			;OUTPUT FILE SPEC
	ENTRY	P$FLD			;FIELD CHECK
	ENTRY	P$TOK			;TOKEN CHECK
	ENTRY	P$NODE			;NODE CHECK
	ENTRY	P$SIXF			;SIXBIT FIELD CHECK
	ENTRY	P$RNGE			;RANGE OF NUMBERS
	ENTRY	P$TEXT			;TEXT CHECK
	ENTRY	P$DEV			;GET A DEVICE STRING
	ENTRY	P$QSTR			;QUOTED STRING
	ENTRY	P$UQSTR			;UNQUOTED STRING
	ENTRY	P$ACCT			;ACCOUNT STRING

;NON-STANDARD ROUTINES
	ENTRY	P$STAK			;SETUP FOR TAKE
	ENTRY	PDBCPY			;COPY A PDB
	ENTRY	TXTINP			;GET TEXT BLOCK FROM TERMINAL
	ENTRY	P$FIXP			;FIXUP COMMAND POINTER ON ACTION ERROR

	GLOB	<TAKFDB,WAIFDB,BADIFI,TEMFDB>


SUBTTL	Storage and constants

	XLIST				;TURN LISTING OFF
	LIT				;DUMP LITERALS
	LIST				;TURN LISTING ON

	RELOC	0

$DATA	CURRPB,1			;CURRENT PARSER BLOCK ADDRESS
$DATA	PREVPB,1			;PREVIOUS PARSER BLOCK ADDRESS
$DATA	PRMFLG,1			;FLAG FOR "PROCESSING MESSAGES"
$DATA	CURPMT,1			;POINTER TO CURRENT PROMPT
$DATA	CURPTR,1			;POINTER TO START OF LAST FIELD
$DATA	CURPDB,1			;PDB FOR THE DEFAULT FILLER
$DATA	TIMSET,1			;TIMER WAS SET
$DATA	TIMINT,1			;TIMER INTERUPT BREAKOUT
$DATA	TIMCHK,1			;FLAG THAT TIMER CHECKS IN USE
$DATA	TIMDAT,2			;DATA FROM PARSER INIT CALL
$DATA	TIMPC,1				;ADDRESS OF THE PC AT INTERRUPT
$DATA	TIMSTI,1			;TIMER INTERUPT CHARACTER SETUP
$DATA	TIMBLK,3			;PITMR. UUO BLOCK
$DATA	WAKEUP,1			;[102]WAKEUP TIME FOR WAIT COMMAND
$DATA	PRSPTR,1			;BYTE POINTER FOR PARSING
$DATA	PRSCNT,1			;BYTE COUNT FOR PARSING
$DATA	USRPTR,1			;USER BYTE POINTER TO RETURN DATA
$DATA	SBCFLG,1			;NON-ZERO IF SUB-COMMAND PROCESSING
$DATA	SBCUSR,1			;0 IF SUB-COMMAND MODE CLEARED BY USER
$DATA	SBCINI,<1+PB%SIZ>		;INIT BLOCK FOR SUB-COMMANDS

$DATA	PRMTSZ,1			;SIZE OF THE PROMPT
$DATA	OPRTAK,1			;DEFAULT DISPLAY FOR ALL TAKES
$DATA	TXTDAT,.RDBRK+1			;TEXTI ARGUMENT BLOCK
$DATA	TEMPTR,1			;TEMPORARY TEXT POINTER
$DATA	DSPTAK,1			;DISPLAY TAKE COMMAND FLAG
$DATA	PARBLK,PRT.SZ			;PARSER RETURN BLOCK
$DATA	PARINT,1			;PARSER INITIALIZED FLAG
$DATA	CORPAR,1			;INITIAL SETTING FOR CORE PARSE
$DATA	REEPAR,1			;FLAG SAYS WE WERE CALLED FOR REPARSE
$DATA	CMDBLK,.CMGJB+5			;COMMAND STATE BLOCK FOR COMND JSYS
$DATA	BUFFER,BUFSIZ			;INPUT TEXT STORED HERE
$DATA	ATMBFR,ATMSIZ			;ATOM BUFFER FOR COMND JSYS
$GDATA	GJFBLK,GJFSIZ			;GTJFN BLOCK FOR COMND JSYS

;***MIGHT NEED TO ENLARGE OR MAKE DYNAMIC
$DATA	DENTRY,2			;DELETE ENTRY WORDS(S1 AND S2)
$DATA	DFLAGS,1			;DELETE FLAG FOR TEMP SWITCH TAB
$DATA	TEMTAB,TEMTSZ			;SAVE 10 WORDS FOR SWITCH TABLE
$GDATA	TEMFDB,PDB.SZ			;TEMP FDB AREA
$DATA	CMDERR,^D50			;SPACE FOR COMMAND ERROR TEXT
$DATA	CMDEPT,1			;COMMAND ERROR MESSAGE POINTER
$DATA	CMDECT,1			;COMMAND ERROR MESSAGE COUNT
$DATA	CMDRET,PC.SIZ			;COMMAND RETURN DATA
$DATA	ARGSAV,PAR.SZ			;SAVE AREA FOR PARSER ARGUMENTS
$DATA	ERRSAV,1			;MESSAGE ADDRESS ON ERROR
$GDATA	ERRSTG,1			;ADDRESS OF ERROR MESSAGE

;STORAGE FOR $TEXT CHARACTER STORER
$DATA	STRBP,1				;SPACE FOR A BYTE POINTER

;STORAGE FOR PARSER TO EVENT PROCESSOR COMMUNICATION
$DATA	PARDAT,1			;ADDRESS OF PARSER DATA MESSAGE
$GDATA	ARGFRE,1			;POINTER TO FIRST FREE WORD IN ARG SPACE
$DATA	FLAGS,1				;PARSER FLAG WORD
$DATA	ERRSTK,1			;ERROR STACK FOR COMMAND
$DATA	INTEXT,1			;INTERRUPT EXIT

;TAKE STORAGE
$DATA	CMDIFN,1			;STORAGE FOR COMMAND FILE IFN
$DATA	LOGIFN,1			;STORAGE FOR LOGGING FILE IFN
$DATA	CMDJFN,1			;STORAGE FOR COMMAND FILE JFN
$DATA	LOGJFN,1			;STORAGE FOR LOGGING FILE JFN
$DATA	TAKFLG,1			;FLAG TO INDICATE WE ARE IN TAKE COMMAND
$GDATA	TAKFOB,FOB.SZ			;AUTO TAKE FILE FOB
$DATA	FILERR,40			;SPACE FOR ERROR MESSAGE
$DATA	IMOPR,1				;FLAG WHETHER WE ARE ORION

	RELOC
SUBTTL	P$INIT	Initialize and set timer

;THIS ROUTINE WILL SETUP FOR TIMER INTERRUPTS IF POSSIBLE
;AND INIT THE PARSER

;CALL	S1/	LEVEL,, TIMER CHANNEL OR OFFSET
;	S2/	BASE OF INTERRUPT SYSTEM

P$INIT:	SETZM	TIMCHK			;CLEAR TIMCHK SETTING
	DMOVEM	S1,TIMDAT		;SAVE THE VALUES
	$CALL	PARINI			;INIT THE PARSER
	SKIPN	TIMDAT+1		;ANYTHING SPECIFIED?
	$RETT				;NO, RETURN
	SETOM	TIMCHK			;SET TIME CHECK IN EFFECT
TOPS10	<
	HRRZS	TIMDAT+0		;NO GALAXY SUPPORT FOR PSI LEVELS
	HRRZ	S1,TIMDAT+0		;GET OFFSET TO VECTOR BLOCK
	ADD	S1,TIMDAT+1		;PUT VECTOR ADDRESS IN S1
	MOVEI	S2,.PSVOP(S1)		;GET ADDRESS IF OLD PC
	MOVEM	S2,TIMPC		;SAVE
	MOVEI	S2,P$TINT		;INTERRUPT ROUTINE
	MOVEM	S2,.PSVNP(S1)		;SAVE
	MOVEI	S1,TIMBLK		;POINT TO PITMR. UUO BLOCK
	MOVX	S2,.PCTMR		;CONDITION CODE = TIMER
	MOVEM	S2,.PSECN(S1)		;SAVE
	MOVE	S2,TIMDAT+0		;PSI LEVEL,,OFFSET
	HRLZM	S2,.PSEOR(S1)		;SAVE OFFSET,,0
	HLLZM	S2,.PSEPR(S1)		;SAVE PSI LEVEL,,0
	HRLI	S1,(PS.FAC)		;ADD CONDITION
	PISYS.	S1,			;ENABLE TIMER INTERRUPTS
	  JFCL				;IGNORE ERRORS
> ;End TOPS10
TOPS20	<
	MOVX	S2,1B0			;PLACE A BIT IN WORD
	HRRZ	S1,TIMDAT		;GET THE CHANNEL
	MOVN	S1,S1			;MAKE IT NEGATIVE
	LSH	S2,0(S1)		;POSITION THE CHANNEL NUMBER
	MOVEI	S1,.FHSLF		;GET MY HANDLE
	AIC				;ATTACH TO INTERRUPT SYSTEM
	HRRZ	S2,TIMDAT+1		;GET CHANNEL TABLE ADDRESS
	HRRZ	TF,TIMDAT		;GET THE CHANNEL
	ADD	S2,TF			;GET CHANNEL TABEL LOCATION
	HLLZ	S1,TIMDAT		;GET LEVEL VALUE
	HRRI	S1,P$TINT		;TIMER INTERRUPT LOCATION
	MOVEM	S1,(S2)			;SAVE IN CHANNEL TABLE
	HLRZ	S1,TIMDAT+1		;GET LEVTAB ADDRESS
	HLRZ	S2,TIMDAT		;GET LEVTAB LEVEL
	ADDI	S1,-1(S2)		;GET LEVTAB ADDRESS
	MOVE	S2,(S1)			;GET ADDRESS OF PC
	MOVEM	S2,TIMPC		;SAVE THE PC ADDRESS WORD
> ;END TOPS20
	$RETT				;RETURN
SUBTTL	PARINI	Initialize the database

;THIS ROUTINE IS CALLED TO SET UP THE PARSER DATA BASE FOR
;USE IN SUBSEQUENT CALLS TO THE PARSER ENTRY PARRTN

PARINI:	SETZM	IMOPR			;ASSUME WE'RE NOT ORION
	MOVNI	S1,1			;-1 FOR US
	MOVEI	S2,JI.JNO		;FUNCTION CODE
	$CALL	I%JINF			;GET OUR JOB
	PUSH	P,S2			;SAVE
	MOVEI	S1,SP.OPR		;SPECIAL PID INDEX
	$CALL	C%RPRM			;GET ORION'S PID
	JUMPF	PARI.0			;CAN'T
	$CALL	C%PIDJ			;TRANSLATE TO A JOB NUMBER
	JUMPF	PARI.0			;SHOULDN'T FAIL
	CAMN	S1,(P)			;ORION PARSING COMMANDS?
	SETOM	IMOPR			;YES, REMEMBER WHO WE ARE
PARI.0:	POP	P,S2			;TRIM STACK
	SETOM	PARINT			;REMEMBER PARSER INITIALIZED
	HRROI	S1,[ASCIZ /PARSER>/]	;GET POINTER TO PROMPT STRING
	MOVEM	S1,CMDBLK+.CMRTY	;PUT RE-TYPE PROMPT POINTER IN STATE BLOCK
	PUSHJ	P,P$7BIT		;SET USER BYTE POINTER TO 7-BIT
	MOVX	S1,DEFPTR		;GET PARSE BYTE POINTER
	MOVEM	S1,PRSPTR		;SAVE
	MOVEI	S1,44			;BITS PER WORD
	LOAD	S2,PRSPTR,BP.SIZ	;GET BYTE SIZE FROM POINTER
	IDIVI	S1,(S2)			;COMPUTE BYTES PER WORD
	MOVEM	S1,PRSCNT		;SAVE
	MOVE	S1,PRSPTR		;GET BYTE POINTER BACK
	HRRI	S1,BUFFER		;GET POINTER TO INPUT TEXT BUFFER
	MOVEM	S1,CMDBLK+.CMPTR	;SAVE POINTER TO COMMAND STRING
	MOVEM	S1,CMDBLK+.CMBFP	;SAVE POINTER TO START-OF-BUFFER
	MOVEI	S1,.PRIIN		;SET PRIMARY INPUT
	MOVEM	S1,CMDJFN
	MOVEI	S1,.PRIOU		;SET PRIMARY OUTPUT
	MOVEM	S1,LOGJFN
	MOVEI	S1,REPARS		;GET RE-PARSE ADDRESS
	MOVEM	S1,CMDBLK+.CMFLG	;SAVE RE-PARSE ADDRESS
	SETZM	CMDBLK+.CMINC		;INITIALIZE # OF CHARACTERS AFTER POINTER
	MOVEI	S1,BUFSIZ		;BUFFER SIZE IN WORDS
	IMUL	S1,PRSCNT		;COMPUTE TOTAL BYTES IN BUFFER
	MOVEM	S1,CMDBLK+.CMCNT	;SAVE INITIAL # OF FREE CHARACTER POSITIONS
	MOVE	S1,PRSPTR		;GET BYTE POINTER
	HRRI	S1,ATMBFR		;GET POINTER TO ATOM BUFFER
	MOVEM	S1,CMDBLK+.CMABP	;SAVE POINTER TO LAST ATOM INPUT
	MOVEI	S1,ATMSIZ		;BUFFER SIZE
	IMUL	S1,PRSCNT		;COMPUTE TOTAL BYTES IN BUFFER
	MOVEM	S1,CMDBLK+.CMABC	;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
	MOVEI	S1,GJFBLK		;GET ADDRESS OF GTJFN BLOCK
	MOVEM	S1,CMDBLK+.CMGJB	;SAVE IN COMMAND STATE BLOCK
	SETZM	ERRSAV			;CLEAR THE ERROR SAVE MESSAGE PAGE
	MOVEI	S1,CMDBLK		;GET THE COMMAND STATE BLOCK
	MOVEM	S1,CMDRET+CR.FLG	;SAVE IN FLAG WORD
	SETZM	CMDRET+CR.RES		;CLEAR RESULT FIELD
	SETZM	CMDRET+CR.COD		;CLEAR THE FIELD CODE
	MOVE	S1,ARGSAV+PAR.TB	;GET THE TABLE ADDRESS
	AOS	S1			;POSITION TO THE PDB
	MOVEM	S1,CMDRET+CR.PDB	;SAVE AS THE CURRENT PDB
	$RET				;RETURN

SUBTTL	PARSER	Main entry to parse a command

;THIS ROUTINE HAS THE FOLLOWING CONVENTIONS
;
;CALL:		S1/ SIZE OF THE ARGUMENT BLOCK
;		S2/ ADDRESS OF THE ARGUMENT BLOCK
;
;RETURN TRUE:	S1/LENGTH OF ARGUMENT BLOCK
;		S2/ ADDRESS OF THE BLOCK
;
;RETURN FALSE:	S1/LENGTH OF RETURN BLOCK
;		S2/ ADDRESS OF RETURN BLOCK


PARSER:	$CALL	.SAVET			;Save the temporaries
	CAIE	S1,0
	CAILE	S1,PAR.SZ		;WITHIN PROPER BOUNDS
	JRST	[MOVEI	S2,[ASCIZ/Invalid parser block size/]
		PJRST ERREXT]		;SETUP RETURN BLOCK
	SETOM	REEPAR			;ASSUME REPARSE
	JUMPL	S1,PARS.2		;ARE WE?
	SETZM	REEPAR			;NO, CLEAR THE FLAG
	HRLZ	S2,S2			;SOURCE OF THE ARGUMENTS LH
	HRRI	S2,ARGSAV		;DESTINATION
	BLT	S2,ARGSAV-1(S1)		;MOVE THE DATA
PARS.1:	CAIE	S1,PAR.SZ		;DONE ALL ARGUMENTS?
	  JRST	[SETZM	ARGSAV(S1)	;NO, CLEAR THE FIELD
		AOJA	S1,PARS.1]	;CHECK FOR ALL
PARS.2:	SKIPN	PARINT			;INITIALIZED?
	$CALL	PARINI			;NO, THEN DO IT
	$CALL	INCORE			;CHECK IF INCORE PROCESSING
	$CALL	CMDMES			;SET UP COMMAND MESSAGE BLOCK
	SKIPN	S1,ARGSAV+PAR.PM	;PROMPT PROVIDED?
	MOVEI	S1,[ASCIZ/PARSER>/]	;NO USE THE DEFAULT
	$CALL	SETPMT			;SET THE PROMPT
	MOVE	S2,ARGSAV+PAR.TB	;ADDRESS OF THE TABLES
	AOS	S2			;POSITION TO THE FDB
	MOVEM	S2,CMDRET+CR.PDB	;SAVE AS THE CURRENT PDB
	SKIPN	REEPAR			;DOING REPARSE
	SKIPE	CORPAR			; OR CORE PARSE BEING DONE?
	  PJRST	REPARSE			;YES, TREAT IT AS A REPARSE
	SKIPE	TIMINT			;WAS THERE A TIMER INTERRUPT
	JRST	[SETZM	TIMINT		;Yes, clear the timer interrupt flag
		LOAD	T1,.CMFNP(S2),CM%FNC  	;GET THE FUNCTION CODE
		CAIN	T1,.CMINI	;NOT .CMINI SKIP REPROMPT
		$CALL	REPRMT		;REPROMPT
		JRST	REPARSE]	;AND REPARSE
	$FALL	PARCMD			;PARSE THE COMMAND
SUBTTL	PARCMD	Do the command parse

;THIS ROUTINE WILL DO ANY DEFAULT FILLING AND THEN CALL
;S%CMND TO PARSE THE COMMAND

PARCMD:	SKIPE	DFLAGS			;ANY ENTRY TO DELETE
	$CALL	STBDEL			;DELETE  THE ENTRY
	PUSHJ	P,P$7BIT		;SET USER BYTE POINTER TO 7-BIT
	$CALL	FILDEF			;FILL IN ANY DEFAULTS IF NEEDED
	JUMPF	ERREXT			;ERROR..RETURN
	PUSHJ	P,SUBCMD		;DO ANY SUB-COMMAND PROMPTING
	JUMPF	PARERR			;RETURN ON FAILURE
	LOAD	S2,CMDRET+CR.PDB,RHMASK	;GET THE CURRENT PDB
	MOVE	S1,CMDBLK+.CMPTR	;GET CURRENT BUFFER POINTER
	MOVEM	S1,CURPTR		;SAVE CURRENT POINTER
	MOVEI	S1,CMDBLK		;ADDRESS OF THE COMMAND BLOCK
	$CALL	S%CMND			;CALL COMND TO PARSE COMMAND
	MOVE	T1,CR.FLG(S2)		;GET THE RETURNED FLAGS
	MOVEM	T1,PARBLK+PRT.CF	;SAVE THE COMMAND FLAGS
	JUMPF	PARERR			;PARSER ERROR ROUTINE
	HRLZ	T2,S2			;SOURCE IN LEFT HALF
	HRRI	T2,CMDRET		;SOMMAND RETURN BLOCK
	BLT 	T2,CMDRET-1(S1)		;SAVE THE DATA
	TXNE	T1,CM%INT		;INTERRUPT OCCUR
	JRST	ERRINT			;ERROR INTERRUPT RETURN
	TXNN	T1,CM%NOP		;VALID COMMAND ENTERED
	JRST	VALCMD			;YES, CHECK IT OUT
PARC.1:	LOAD	S1,CR.PDB(S2),LHMASK	;GET STARTING PDB
	$CALL	P$PERR			;GET THE ERROR PDB
	JUMPF	PARERR			;NONE..ERROR..
	MOVE	T1,S1			;SAVE THE ERROR BLOCK
	TLZE	T1,400000		;PARSER ERROR PDB?
	   JRST	[STORE	T1,CMDRET+CR.PDB,RHMASK ;SAVE AS NEXT PDB
		JRST	PARCMD]		;ANY RETRY THE PARSE
	MOVEI	S1,PC.SIZ		;GET THE ARGUMENT BLOCK
	MOVEI	S2,CMDRET		;GET BLOCK ADDRESS
	$CALL	(T1)			;USE THE ERROR ROUTINE
	JUMPT	PARCMD			;GOOD RETURN .. PARSE THE COMMAND
	SKIPE	S2			;IF S2 HAS ERROR SET..SKIP
	   PJRST ERREXT			;ERROR CODE..GO TO EXIT
	$CALL	S%ERR			;SET UP THE ERROR RETURN
	MOVE	S2,S1			;ADDRESS OF MESSAGE IN S2
	PJRST	ERREXT			;PARSER ERROR RETURN

SUBTTL	SUBCMD	Process a sub-command request


SUBCMD:	SETZM	SBCFLG			;NO SUB-COMMAND PROCESSING YET
	LOAD	S1,CMDRET+CR.PDB,RHMASK	;GET THE CURRENT PDB
	JUMPE	S1,.RETT		;RETURN IF FIRST TIME
	PUSHJ	P,P$GPDB		;GET THE PDB
	JUMPF	.RETT			;NO SUB-COMMAND PROMPT
	CAILE	S2,PB%PMT		;IS THERE A PROMPT WORD?
	SKIPN	S1,PB%PMT(S1)		;GET THE VALUE AND RETURN
	$RETT				;NO SUB-COMMAND PROMPT
	MOVEM	S1,ARGSAV+PAR.PM	;SAVE PROMPT STRING HERE FOR CALLER
	PUSHJ	P,SETPMT		;SET THE PROMPT
	MOVE	S1,[SUBINI,,SBCINI]	;SET UP BLT
	BLT	S1,SBCINI+1+PB%SIZ-1	;COPY
	LOAD	S1,CMDRET+CR.PDB,RHMASK	;GET CURRENT PDB AGAIN
	SUBI	S1,1			;ADJUST
	MOVEM	S1,SBCINI+1+PB%ERR	;SAVE
	MOVEI	S1,SBCINI		;POINT TO INIT BLOCK
	MOVEM	S1,ARGSAV+PAR.TB	;SAVE FOR REPARSE
	SETOM	SBCFLG			;FLAG SUB-COMMAND IN PROGRESS
	SETOM	SBCUSR			;USER MUST CLEAR TO EXIT SUB-COMMAND
	$RETT				;RETURN

SUBINI:	$INIT	(SUBCMD)		;DUMMY ARGUMENT
SUBTTL	VALCMD	Process a valid command field


;THIS ROUTINE WILL GET CONTROL ON A SUCCESSFUL PARSE FROM COMMAND

VALCMD:	SKIPL	T1,CMDRET+CR.COD	;GET THE PARSED FIELD CODE
	CAILE	T1,.CMNOD		;WITHIN RANGE OF VALID FUNCTIONS
	STOPCD	(IFC,HALT,,<Invalid function code from COMMAND>)
	MOVE	S1,ARGFRE		;ADDRESS OF NEXT PLACE TO SAVE
	MOVEM	S1,CMDRET+CR.SAV	;SAVE THE ELEMENT
	MOVX	S1,PC.SIZ		;SIZE OF THE BLOCK
	MOVEI	S2,CMDRET		;COMMAND RETURN BLOCK
	$CALL	@PARTAB(T1)		;SAVE THE DATA FROM COMMAND
	LOAD	S1,CMDRET+CR.PDB,RHMASK	;GET THE USED PDB BYE COMMAND
	$CALL	P$PACT			;ANY ACTION ROUTINE
	JUMPF	VALC.1			;NO, CONTINUE ON
	MOVE	T2,S1			;SAVE ROUTINE IN T2
	MOVX	S1,PC.SIZ		;SIZE OF THE BLOCK
	MOVEI	S2,CMDRET		;COMMAND RETURN BLOCK
	$CALL	(T2)			;PROCESS THE ROUTINE
	JUMPF	VALC.3			;BAD RETURN..SET UP ERROR
VALC.1:	MOVE	T1,CMDRET+CR.COD	;GET THE CODE FIELD
	MOVE	T2,CMDRET+CR.RES	;DATA FROM COMMAND PARSE
	LOAD	S1,CMDRET+CR.PDB,RHMASK	;GET THE USED PDB FROM PARSE
	$CALL	P$PNXT			;IS THERE A NEXT FIELD?
	JUMPT	VALC.2			;GO USE IT
	CAXE	T1,.CMKEY		;YES, WAS IT A KEYWORD?
	CAXN	T1,.CMSWI		;OR A SWITCH?
	SKIPA				;YES,
	JRST	PARRET			;NO NEXT..RETURN
	HRRZ	S1,(T2)			;<R15>YES, GET NEXT PDB FROM DSPTAB
	MOVE	S1,(S1)			;<R15>NOT FROM PDB
	HRRZS	S1			;PASS ONLY THE RIGHT HALF
	JUMPE	S1,PARRET		;NONE..RETURN WITH MESSAGE
VALC.2:	AOS	S1			;BUMP TO FDB OVER THE HEADER
	STORE	S1,CMDRET+CR.PDB,RHMASK ;SAVE THE NEXT BLOCK
	JRST	PARCMD			;GO FINISH THE COMMAND
VALC.3:	MOVX	T2,P.REPA		;REPARSE FLAG SET
	TDNE	T2,FLAGS		;WAS IT SET??
	JRST	VALC.4			;YES, SETUP FOR REPARSE
	SKIPN	S2			;IF S2 HAS ERROR SET..SKIP
	MOVEI	S2,[ASCIZ/Action routine error aborted command/]
	MOVX	T2,P.ACTE		;ACTION ROUTINE ERROR
	IORM	T2,FLAGS		;SAVE IN THE FLAGS
	MOVEM	S1,PARBLK+PRT.EC	;SAVE ANY CODE FOR CALLER
	PJRST	ERREXT			;ERROR RETURN
VALC.4:	ANDCAM	T2,FLAGS		;CLEAR REPARSE FLAG
	JRST	REPARS			;FORCE THE REPARSE

SUBTTL	PARRET	Setup arguments and return
PARRET:	MOVE	S1,ARGFRE		;LAST FREE LOCATION
	ANDI	S1,777			;MAKE AN OFFSET
	MOVE	T3,PARDAT		;GET ADDRESS OF PARSER DATA MESSAGE
	SKIPE	COM.CM(T3)		;ALREADY SETUP TEXT
	JRST	PARR.2			;YES, DO NOT MOVE TEXT
	MOVEM	S1,COM.CM(T3)		;POINTER FOR MESSAGE TEXT
	MOVE	T1,PRSPTR		;SOURCE BYTE POINTER
	HRRI	T1,BUFFER		;SOURCE TEXT OF COMMAND
	HRRZ	T2,ARGFRE		;DESTINATION POINTER
	AOS	T2			;LEAVE ROOM FOR HEADER
	ADD	T2,USRPTR		;DESTINATION BYTE POINTER
PARR.0:	ILDB	S1,T1			;GET A BYTE
PARR.1:	IDPB	S1,T2			;SAVE A BYTE
	JUMPN	S1,PARR.0		;NON-ZERO..KEEP CHECKING
	HRRZI	S1,1(T2)		;GET NEXT LOCATION AND CLEAR LH
	ANDI	S1,777			;MAKE INTO LENGTH (OFFSET)
PARR.2:	STORE	S1,.MSTYP(T3),MS.CNT	;SAVE NEW LENGTH
	MOVE	S2,ARGFRE		;GET START OF TEXT ADDRESS
	ANDI	S2,777			;USE AS LENGTH
	SUBI	S1,(S2)			;GET LENGTH OF BLOCK
	STORE	S1,@ARGFRE,AR.LEN	;SAVE ARGUMENT LENGTH
	MOVX	S1,P.NPRO		;NO PROCESSING REQUIRED
	TDNN	S1,FLAGS		;WAS IT SET
	JRST	PARR.3			;NO, SEND TO ORION TO PROCESS
	MOVX	S1,CM.NPR		;NO PROCESSING REQUIRED
	IORM	S1,.OFLAG(T3)		;SAVE IN THE MESSAGE FLAGS
PARR.3:	MOVX	S1,COM.AL		;GET ARGUMENT LENGTH
	MOVEM	S1,.OARGC(T3)		;SAVE IN MESSAGE
	SETZ	S1,			;CLEAR S1
	EXCH	S1,FLAGS		;GET THE CURRENT FLAGS AND RESET
	SKIPE	DSPTAK			;DISPLAY TAKE COMMANDS
	TXO	S1,P.DSPT		;SET DISPLAY TAKE FLAG
	MOVEM	S1,PARBLK+PRT.FL	;SAVE THE FLAGS
	MOVEM	T3,PARBLK+PRT.CM	;SAVE THE COMMAND MESSAGE
	MOVX	S1,CM%INT		;GET COMMAND FLAG
	ANDCAM	S1,CMDBLK+.CMFLG	;CLEAR FLAG ON GOOD RETURN
	$CALL	CLRTIM			;CLEAR THE TIMER
	MOVE	S1,PRSPTR		;GET BYTE POINTER
	HRRI	S1,BUFFER		;INCLUDE ADDRESS
	MOVEM	S1,CMDBLK+.CMPTR	;SAVE POINTER TO COMMAND STRING
	MOVEI	S1,BUFSIZ		;GET BUFFER SIZE
	IMUL	S1,PRSCNT		;COMPUTE CHARACTER COUNT
	MOVEM	S1,CMDBLK+.CMCNT	;SAVE IN COMMAND BLOCK
	MOVEI	S1,BUFFER		;RETURN ADDRESS OF BUFFER
	MOVEM	S1,PARBLK+PRT.MS
	MOVEI	S1,PRT.SM		;SMALL SIZE MESSAGE
	MOVEI	S2,PARBLK		;PARSER RETURN BLOCK
	$RETT				;RETURN
SUBTTL	PARERR	COMND JSYS  error routine
;	  IF END OF FILE REACHED ON A TAKE FILE, THE NEXT COMMAND
;	  IS SIMPLY PROCESSED.  ELSE AN ERROR MESSAGE IS ISSUED AND
;	  THE PROGRAM IS RESTARTED.
;
;CALL:		JRST PARERR

PARERR:	SKIPE	CORPAR			;DOING A CORE PARSE?
	JRST	PARE.6			;YES?
	SKIPN	TAKFLG			;PROCESSING A TAKE FILE ?
	JRST	PARE.1			;NO, GET THE ERROR
	$CALL	CHKEOF			;CHECK FOR END OF FILE
	JUMPF	PARE.1			;NO, PROCESS THE ERROR
	$CALL	CLSTAK			;CLOSE THE TAKE FILE
	JUMPT	PARE.3			;CLEANUP AND RETURN
	JRST	PARE.4			;ERROR CLOSING TAKE FILE
PARE.1:	$CALL	S%ERR			;DO ANY ERROR TYPEOUT
	MOVE	S2,S1			;ADDRESS OF MESSAGE IN S2
	PJRST	ERREXT			;ERROR RETURN
PARE.3:	$CALL	TAKCLR			;CLEAR THE TAKE INDICATORS
	JRST	PARE.5			;GIVE END OF TAKE ERROR..
PARE.4:	$CALL	TAKCLR			;CLEAR THE TAKE INDICATORS
	MOVEI	S2,[ASCIZ/Error closing TAKE command file/]
	PJRST	ERREXT			;ERROR RETURN
PARE.5:	MOVX	S1,P.ENDT		;END OF THE TAKE FILE
	IORM	S1,FLAGS		;TURN ON THIS FLAG
	SETOM	INTEXT			;MARK AS INTERRUPT EXIT
	MOVEI	S2,[ASCIZ/End of file during TAKE command/]
	PJRST	ERREXT			;DO ERROR PROCESSING AND RETURN FALSE
PARE.6:	TXNE	T1,CM%NOP		;VALID COMMAND ENTERED
	JRST	PARE.1			;NO, GENERATE THE ERROR
	MOVX	S1,P.CEOF		;CORE PARSE END OF FILE
	IORM	S1,FLAGS		;SET THE FLAGS
	MOVEI	S2,[ASCIZ/End of string during incore parse/]
	SETOM	INTEXT			;MARK AS INTERRUPT EXIT
	PJRST	ERREXT			;EXIT
SUBTTL	CHKEOF	Check for end of take file

;CHECK IF END OF FILE ON TAKE FILE

TOPS20	<
CHKEOF:	HLRZ	S1,CMDBLK+.CMIOJ	;GET INPUT FILE JFN FOR TAKE FILE
	GTSTS				;GET THE FILE'S STATUS
	TXNN	S2,GS%EOF		;AT END OF FILE ?
	$RETF				;RETURN FALSE
	$RETT				;RETURN TRUE
> ;End TOPS20


TOPS10	<
CHKEOF:	CAXE	S1,EREOF$		;END OF FILE ERROR??
	$RETF				;NO, LOSE
	$RETT				;YES,
> ;End TOPS10

SUBTTL	CLSTAK	Close the take file
SUBTTL	TAKCLR	Cleanup after take file


CLSTAK:	MOVE	S1,CMDIFN		;GET IFN FOR THE TAKE FILE
	$CALL	F%REL			;RELEASE THE FILE
	 $RETIF				;Return the error on failure
	MOVE	S1,LOGIFN		;Release the logging file
	CAIE	S1,.NULIO
	$CALL	F%REL
	 $RETIF				;Return the error on failure
	$RETT

TAKCLR:	MOVEI	S1,.PRIIN		;Set primary input
	MOVEM	S1,CMDJFN
	MOVEI	S1,.PRIOU		;Set primary output
	MOVEM	S1,LOGJFN
	SETZM	DSPTAK			;CLEAR DISPLAY TAKE FLAG
	SETZM	TAKFLG			;MARK THAT TAKE FILE NOT BEING PROCESSED
	MOVX	S1,P.CTAK		;CLEAR IN TAKE FILE
	ANDCAM	S1,FLAGS		;CLEAR THE FLAG VALUE
	$RET				;RETURN
SUBTTL	ERREXT	Error return from parser

ERRINT: MOVX	S1,CM%INT		;GET INTERRUPT FLAG
	ANDCAM	S1,CMDBLK+.CMFLG	;CLEAR THE FLAG VALUE
	TXNE	T1,CM%NOP		;ALSO HAVE NO PARSE LIT?
	JRST	PARC.1			;YES, TREAT AS NO PARSE
	MOVX	S1,P.INTE		;INTERRUPT EXIT
	IORM	S1,FLAGS		;SAVE IN FLAG WORD
	SETOM	INTEXT			;INTERRUPT EXIT
	MOVEI	S2,[ASCIZ/Interrupt during command parse/]
ERREXT:	MOVEM	S2,ERRSTG		;SAVE THE STRING ADDRESS
	$CALL	CLRTIM			;CLEAR THE TIMER
	MOVE	T3,PARDAT		;GET PAGE ADDRESS
	SKIPE	ARGSAV+PAR.CM		;COMMAND MESSAGE PROVIDED
	JRST	ERRE.3			;YES, JUST SET S1 WITH FLAGS
	SKIPE	S1,ERRSAV		;IS THERE A PAGE ALREADY
	JRST	ERRE.1			;ALREADY SET..FREE THE PAGE
	MOVEM	T3,ERRSAV		;SAVE PAGE ADDRESS
	JRST	ERRE.2			;CONTINUE ON
ERRE.1:	$CALL	M%RPAG			;RELEASE THE PAGE
	MOVEM	T3,ERRSAV		;SAVE ADDRESS OF PAGE TO REUSE
ERRE.2:	SKIPE	INTEXT			;INTERRUPT EXIT PROCESSING
	JRST	ERRE.4			;YES, SKIP MESSAGE SETUP
ERRE.3:	MOVSI	T1,(POINT 7,0)		;SETUP BYTE POINTER
	HRRI	T1,CMDERR		;BUFFER FOR DATA
	MOVEM	T1,CMDEPT		;SAVE THE POINTER
	MOVEI	T1,^D50*5		;SIZE OF BUFFER
	MOVEM	T1,CMDECT		;SAVE THE COUNT
	MOVE	S2,PRSPTR		;BYTE POINTER
	HRRI	S2,ATMBFR		; TO ATOM BUFFER
	$TEXT	(ERRRTN,<^T/@ERRSTG/: "^Q/S2/"^0>)
	MOVEI	S2,CMDERR		;SETUP ERROR POINTER
ERRE.4:	SETZ	S1,			;CLEAR FLAG WORD
	EXCH	S1,FLAGS		;GET THE CURRENT FLAGS AND RESET
	TXO	S1,P.ERRO		;ERROR FLAG SET
	MOVEM	S1,PARBLK+PRT.FL	;SAVE THE FLAGS
	MOVEM	S2,PARBLK+PRT.EM	;SAVE THE ERROR MESSAGE
	MOVEM	T3,PARBLK+PRT.CM	;SAVE COMMAND MESSAGE..AS IS
	MOVEI	S1,BUFFER		;ADDRESS OF COMMAND TEXT
	MOVEM	S1,PARBLK+PRT.MS	;SAVE THE MESSAGE
	MOVEI	S1,PRT.SZ		;SIZE OF THE BLOCK
	MOVEI	S2,PARBLK		;ADDRESS OF THE BLOCK
	SETZM	INTEXT			;CLEAR INTERRUPT EXIT FLAG
	$RETF				;RETURN FALSE

ERRRTN:	SOSGE	CMDECT			;DECREMENT COUNT
	$RETF				;TOO MUCH TRUNCATE BUFFER
	IDPB	S1,CMDEPT		;SAVE THE BYTE
	$RETT				;RETURN TRUE


SUBTTL	INCORE	Check and setup for incore processing

;THIS ROUTINE WILL VALIDATE THE INCORE ARGUMENT AND MAKE THE
;NECESSARY CHANGES TO PROCESS A COMMAND IN CORE

INCORE:	SETZM	CORPAR			;RESET CORE PARSE FLAG
	SKIPN	TAKFLG			;PROCESSING A TAKE COMMAND
	SKIPN	S1,ARGSAV+PAR.SR	;IS THERE A SOURCE POINTER
	JRST	INCO.4			;NO, DO NORMAL PROCESSING
	MOVE	T1,[.NULIO,,.NULIO]	;SET UP NULL I/O FOR COMND
	STORE	T1,CMDBLK+.CMIOJ	;SAVE IN THE COMMAND STATE BLOCK
	MOVE	T2,PRSPTR		;SETUP DESTINATION POINTER
	HRRI	T2,BUFFER		;GET BUFFER ADDRESS
	SETZM	T3			;CLEAR A COUNT
	CAMN	S1,[-1]			;CHECK FOR RESCAN ON INCORE PARSE
	JRST	INCO.7			;YES, DO RESCAN
	MOVE	S2,S1			;COPY POINTER
	TLCE	S2,-1			;LH 0?
	TLCN	S2,-1			;OR -1
	HLL	S2,USRPTR		;YES--SETUP A BYTE POINTER
INCO.1:	ILDB	T4,S2			;GET A BYTE
	JUMPE	T4,INCO.2		;NULL..END OF DATA
	IDPB	T4,T2			;SAVE THE BYTE
	AOJA	T3,INCO.1		;BUMP THE COUNT
INCO.2:	IDPB	T4,T2			;SAVE THE NULL
INCO.3:	MOVEM	T3,CORPAR		;SAVE BYTE COUNT
	MOVEM	T3,CMDBLK+.CMINC	;SAVE THE CHARACTER COUNTS
	MOVE	S1,PRSPTR		;GET BYTE POINTER
	HRRI	S1,BUFFER		;INCLUDE ADDRESS
	MOVEM	S1,CMDBLK+.CMPTR	;SAVE POINTER TO COMMAND STRING
	MOVEM	S1,CMDBLK+.CMBFP	;SAVE POINTER TO START-OF-BUFFER
	$RET				;RETURN

INCO.4:	MOVX	T1,P.CTAK		;COMMAND FROM TAKE FILE
	SKIPE	TAKFLG			;DOING A TAKE?
	IORM	T1,FLAGS		;YES, TURN IT ON IN FLAGS
	HRLZ	T1,CMDJFN		;Get input JFN
	HRR	T1,LOGJFN		;Get output JFN
INCO.5:	STORE	T1,CMDBLK+.CMIOJ	;Save for COMND
	SKIPE	TIMINT			;WAS THERE A TIMER INTERRUPT
	$RET				;YES, LEAVE STATE ALONE
	SETZM	CMDBLK+.CMINC		;CLEAR COUNT OF CHAR IN BUFFER
	MOVE	S1,PRSPTR		;GET BYTE POINTER
	HRRI	S1,BUFFER		;POINT TO TEXT
	MOVEM	S1,CMDBLK+.CMBFP	;SAVE POINTER TO START-OF-BUFFER
	$RET				;RETURN
INCO.7:	$CALL	RESCN			;DO THE RESCAN
	MOVE	T3,S1			;GET THE COUNT
	JRST	INCO.3			;FINISH OFF THE INCORE FLAGS

SUBTTL	CMDMES	Check and/or setup the command message

;THIS ROUTINE WILL VALIDATE THE COMMAND MESSAGE ARGUMENT FIELD
;IF PRESENT. IF NOT, IT WILL CREATE A PAGE AND SETUP THE MESSAGE

CMDMES:	SKIPN	T3,ARGSAV+PAR.CM	;ANY COMMAND MESSAGE SUPPLIED?
	JRST	CMDM.1			;NO, SETUP THE PAGE
	MOVEM	T3,PARDAT		;SAVE ADDRESS OF PARSER DATA
	LOAD	T1,.MSTYP(T3),MS.CNT	;GET THE LENGTH
	AOS	T1			;BUMP IT BY 1
	MOVEM	T1,COM.PB(T3)		;SAVE IN THE MESSAGE
	ADDI	T1,(T3)			;MAKE AN ADDRESS
	MOVEM	T1,ARGFRE		;SAVE AS POINTER TO FREE AREA
	$RET				;RETURN

CMDM.1:	SKIPE	T3,ERRSAV		;NO SAVED MESSAGE
	JRST	CMDM.3			;USE SAVED PAGE
	DMOVE	T1,S1			;SAVE THE ARGUMENT BLOCK
	$CALL	M%GPAG			;GET A PAGE FOR COMMAND
	MOVEM	S1,PARDAT		;SAVE THE PAGE ADDRESS
CMDM.2:	MOVEI	T1,COM.SZ		;SIZE OF THE COMMAND HEADER
	MOVEM	T1,COM.PB(S1)		;SAVE AS PARSER BLOCK POINTER
	ADDI	T1,(S1)			;CONVERT TO FULL ADDRESS
	MOVEM	T1,ARGFRE		;SAVE AS START OF ARGUMENT AREA
	MOVX	T1,.OMCMD		;GET THE COMMAND MESSAGE TYPE
	STORE	T1,.MSTYP(S1),MS.TYP	;SAVE TYPE IN MESSAGE
	$RET				;RETURN
CMDM.3:	MOVEM	T3,PARDAT		;SAVE THE PAGE ADDRESS
	SETZM	ERRSAV			;CLEAR THE SAVED ADDRESS HOLDER
	$RET				;RETURN..***MIGHT NEED TO CLEAR
					;BY CALLING .ZPAGE
SUBTTL	SETPMT	Setup the prompt pointer

;THIS ROUTINE WILL SET UP THE PROPER PPROMPT STRING FOR COMND.
;THE DEFAULT STRING IS PARSER> ELSE THE
;POINTER GIVEN IN THE PARSER CALL WILL BE USED.

SETPMT:	TLCE	S1,-1			;LH 0?
	TLCN	S1,-1			;OR -1
	HLL	S1,USRPTR		;YES--SETUP A BYTE POINTER
	MOVEM	S1,CMDBLK+.CMRTY	;SAVE THE PROMPT FOR COMMAND
	MOVEM	S1,CURPMT		;SAVE THE CURRENT PROMPT
	SETZ	T1,			;CLEAR S2
SETP.1:	ILDB	S2,S1			;GET A BYTE
	SKIPE	S2			;WAS IT NULL?
	AOJA	T1,SETP.1		;NO, COUNT IT
	MOVEM	T1,PRMTSZ		;SAVE PROMPT SIZE
	$RETT				;RETURN TRUE
SUBTTL	RESCN	 Rescan routine to setup initial command


;This routine will read the characters from the previous command
;line and place them in the command buffer for reparsing.
;
;For TOPS10 the buffer will always be terminated by a <CRLF>
;regardless of the actual break character used to terminate
;the line at command level.

;RETURN	S1/	COUNT OF CHARACTERS


TOPS20 <
RESCN:	MOVEI	S1,.RSINI		;Make characters available
	RSCAN
	 ERJMP	[$FATAL <Rescan JSYS failed, ^E/[-2]/>]
	MOVEI	S1,.RSCNT		;Get the number of characters available
	RSCAN
	 ERJMP	[$FATAL <Rescan JSYS failed, ^E/[-2]/>]
	MOVE	T1,S1			;Put count in T1
	MOVE	T3,T1			;ALSO SAVE  IT IN T3
RESCN1:	SOJL	T1,RESCN2		;Exit when count exhausted
	$CALL	K%BIN			;Read a byte
	IDPB	S1,T2			;Store in rescan buffer
	JRST	RESCN1			;Back to get the rest
> ;End TOPS20 conditional

TOPS10 <

;Line break set definition for TOPS10
;<ESC><^Z><DC1-DC4><DLE><FF><VT> and <LF>

	LINBRK==^B00001100000111110001110000000000

RESCN:	MOVEI	T3,1			;Initialize count
	RESCAN	1			;Anything to be had?
	JRST	RESCN1			;Yes..get it
	JRST	RESCN2			;No..just return
RESCN1:	$CALL	K%BIN			;YES, get it
	IDPB	S1,T2			;Store it
	CAIL	S1,.CHLFD		;Possible break character?
	CAILE	S1,.CHESC
	 AOJA	T3,RESCN1		;No..get next character
	MOVEI	S2,1			;Get a bit to use for test
	LSH	S2,0(S1)
	TXNN	S2,LINBRK		;Is it a break character?
	 AOJA	T3,RESCN1		;No..get next character
	CAIN	S1,.CHLFD		;Yes..was it line feed?
	 JRST	RESCN2			;Yes..terminate the buffer
	MOVEI	S1,.CHCRT		;No..replace it with <CRLF>
	DPB	S1,T2
	MOVEI	S1,.CHLFD
	IDPB	S1,T2
	AOJA	T3,RESCN2		;Bump count for extra character
> ;End TOPS10 conditional

RESCN2:	SETZ	S1,			;Terminate buffer with a null
	IDPB	S1,T2
	MOVE	S1,T3			;Return count in S1
	$RETT

SUBTTL	Dispatch for Parser Save Routines

;THE ROUTINES ON THE NEXT FEW PAGES SAVE THE OUTPUT OF THE PARSER IN
;A FORM USABLE BY THE EVENT PROCESSOR.  THE ACTUAL DATA STRUCTURE IS
;DOCUMENTED IN PARSER.RNO


;THIS IS THE DISPATCH TABLE FOR THE VARIOUS SAVE ROUTINES, ONE FOR
;EACH TYPE OF FIELD THE COMND JSYS CAN PARSE. THESE ROUTINES ARE CALLED
;ON EACH SUCCESSFUL RETURN FROM THE COMND JSYS
;ALL ROUTINES ARE CALLED WITH
; S1/ LENGTH OF BLOCK
; S2/ ADDRESS OF COMND INFO

PARTAB:	SAVKEY				;KEYWORD (.CMKEY)
	SAVNUM				;NUMBER  (.CMNUM)
	.POPJ				;NOISE WORD (.CMNOI) (NO PROCESSING)
	SAVSWI				;SWITCH (.CMSWI)
	SAVFIL				;INPUT FILE SPEC (.CMIFI)
	SAVOFI				;OUTPUT FILE SPEC (.CMOFI)
	SAVFIL				;GENERAL FILE SPEC (.CMFIL)
	SAVATM				;ARBITRARY FIELD (.CMFLD)
	SAVZER				;CONFIRM (.CMCFM)
	SAVRES				;DIRECTORY (.CMDIR)
	SAVUSR				;USER NAME (.CMUSR)
	SAVZER				;COMMA (.CMCMA)
	SAVINI				;INITIALIZATION (.CMINI)
	SAVRES				;FLOATING POINT NUMBER (.CMFLT)
	SAVDEV				;DEVICE NAME (.CMDEV)
	SAVATM				;TEXT TO CARRAIGE RETURN (.CMTXT)
	SAVRES				;DATE AND TIME (.CMTAD)
	SAVATM				;QUOTED STRING (.CMQST)
	SAVUQS				;UNQUOTED STRING (.CMUQS)
	SAVTOK				;TOKEN (.CMTOK)
	SAVNUM				;NUMBER (ARBITRARY TERMINATOR) (.CMNUX)
	SAVATM				;(.CMACT)
	SAVNOD				;NODE NAME (.CMNOD)
SUBTTL	SAVKEY/SAVSWI Save a switch or keyword


;THIS ROUTINE WILL SAVE THE SWITCH OR KEYWORD VALUE IN THE
;COMMAND MESSAGE. THE FIRST WORD WILL BE HEADER AND SECOND WORD
;WILL BE THE DATA VALUE

SAVKEY:
SAVSWI:	LOAD	T1,CR.COD(S2)		;GET THE FUNCTION CODE
	STORE	T1,@ARGFRE,PF.TYP	;SAVE TYPE IN HEADER
	MOVEI	T1,PFD.D1+1		;LENGTH OF FIELD
	STORE	T1,@ARGFRE,PF.LEN	;SAVE LENGTH IN HEADER
	AOS	ARGFRE			;BUMP THE POINTER
	MOVE	T1,CR.RES(S2)		;GET RESULT FROM COMND
	LOAD	S1,CMDRET+CR.PDB,RHMASK	;GET THE USED PDB FROM PARSE
	HRRZ	T1,(T1)			;GET RESULT(INDIRECT ADDRESS)
	$CALL	P$PNXT			;IS THERE A NEXT FIELD?
	SKIPT				;YES, USE CURRENT DATA
	HLRZ	T1,(T1)			;NO,,GET CODE FROM COMND
	MOVEM	T1,@ARGFRE		;SAVE THE VALUE IN BLOCK
	AOS	ARGFRE			;BUMP THE POINTER
	$RET				;RETURN
SUBTTL	SAVFIL	Save a filespec

;THIS ROUTINE WILL SAVE A FILESPEC IN THE FORM OF A GALAXY FD
;AS DESCRIBED IN GLXMAC

TOPS20	<
SAVOFI:	MOVE	T1,[111100,,1]		;OUTPUT ALL UP TO PROTECTION
	SKIPA				;OUTPUT THE FILE
SAVFIL:	MOVE	T1,[111110,,1]		;OUTPUT ALL UP TO PROTECTION
	DMOVE	T3,S1			;SAVE THE ARGUMENT BLOCKS
	MOVE	T2,ARGFRE		;START OF THE BLOCK
	HRROI	S1,PFD.D1(T2)		;POINTER TO START OF DATA
	MOVE	S2,CR.RES(S2)		;GET THE JFN
	JFNS				;MAKE JFN INTO A STRING
	IBP	S1			;STEP PAST NULL AT END OF STRING
	HRRZI	S2,1(S1)		;POINT S2 AT FIRST FREE ARGUMENT
	EXCH	S2,ARGFRE		;UPDATE THE POINTER
	HRRZS	S1			;MAKE AN ADDRESS ONLY
	SUBI	S1,-1(S2)		;GET LENGTH OF THE FD
	STORE	S1,PFD.HD(T2),PF.LEN	;SAVE LENGTH OF ARGUMENT
	LOAD	S1,CR.COD(T4)		;GET THE COMND TYPE
	STORE	S1,PFD.HD(T2),PF.TYP	;SAVE THE HEADER WORD
	MOVE	S1,[GJFBLK,,GJFBLK+1]	;SET UP TO CLEAR GTJFN BLOCK
	SETZM	GJFBLK			;CLEAR FIRST WORD
	BLT	S1,GJFBLK+GJFSIZ-1	;CLEAR THE BLOCK
	MOVE	S1,CR.RES(T4)		;GET THE JFN
	RLJFN				;RELEASE THE JFN
	 JRST	[MOVEI	S2,[ASCIZ/Error releasing command file JFN/]
		 $RETF]			;RETURN FALSE
	$RET				;RETURN
> ;End TOPS20

TOPS10	<

SAVOFI:
SAVFIL:	MOVE	T1,ARGFRE		;WHERE TO COPY TO
	HRL	T1,CR.RES(S2)		;WHERE TO COPY FROM
	MOVE	T4,CR.RES(S2)		;GET THE RESULT
	LOAD	T2,.FDLEN(T4),FD.LEN	;GET THE LENGTH OF FD
	STORE	T2,@ARGFRE,PF.LEN	;SAVE LENGTH OF BLOCK
	ADDI	T2,-1(T1)		;GET THE ENDING ADDRESS OF FD
	BLT	T1,(T2)			;MOVE THE FD
	LOAD	T4,CR.COD(S2)		;GET THE CODE OF FUNCTION
	STORE	T4,@ARGFRE,PF.TYP	;SAVE CODE AND LENGTH
	MOVEI	T3,1(T2)		;COMPUTE NEXT FREE LOCATION
	EXCH	T3,ARGFRE		;UPDATE IT
	MOVE	S1,[GJFBLK,,GJFBLK+1]	;SET UP TO CLEAR GTJFN BLOCK
	SETZM	GJFBLK			;CLEAR FIRST WORD
	BLT	S1,GJFBLK+GJFSIZ-1	;CLEAR THE BLOCK
	$RET				;RETURN
> ;End TOPS10

SUBTTL	SAVUSR	Save a PPN


; THIS ROUTINE WILL SAVE A PPN AND OPTIONALLY A PPN MASK
SAVUSR:	MOVE	T1,CR.COD(S2)		;GET COMND TYPE
	STORE	T1,@ARGFRE,PF.TYP	;SAVE
	LOAD	T1,CR.PDB(S2),RHMASK	;GET LAST PDB USED BY COMMAND
	MOVE	T1,.CMDAT(T1)		;GET WORD CONTAINING OPTIONAL DATA
	MOVEI	T2,PFD.D1+1		;DEFAULT SIZE OF BLOCK
	TXNE	T1,CM%WLD!CM%WLA	;WILDCARDING?
	MOVEI	T2,PFD.D2+1		;YES--IT'S A LITTLE BIGGER
	STORE	T2,@ARGFRE,PF.LEN	;SAVE LENGTH
	AOS	ARGFRE			;BUMP TO NEXT LOCATION
	MOVE	T2,CR.RES(S2)		;GET PPN WORD
	MOVEM	T2,@ARGFRE		;SAVE
	AOS	ARGFRE			;BUMP TO NEXT LOCATION
	TXNN	T1,CM%WLD!CM%WLA	;WILDCARDING?
	POPJ	P,			;NO--JUST RETURN
	MOVE	T2,1(T1)		;ELSE GET PPN MASK
	MOVEM	T2,@ARGFRE		;SAVE
	AOS	ARGFRE			;BUMP TO NEXT LOCATION
	POPJ	P,			;RETURN
SUBTTL	SAVNUM	Save a number

;THIS ROUTINE WILL SAVE A NUMBER BLOCK WITH THE NUMBER
;IN THE FIRST DATA WORD AND THE RADIX IN THE SECOND

SAVNUM:	LOAD	T2,CR.COD(S2)		;GET THE COMND TYPE
	STORE	T2,@ARGFRE,PF.TYP	;SAVE THE FUNCTION CODE
	MOVEI	T2,PFD.SZ		;SIZE OF THE BLOCK
	STORE	T2,@ARGFRE,PF.LEN	;SAVE THE HEADER
	AOS	ARGFRE			;BUMP TO NEXT LOCATION
	MOVE	T2,CR.RES(S2)		;GET THE DATA FIELD
	STORE	T2,@ARGFRE		;SAVE THE NUMBER IN BLOCK
	AOS	ARGFRE			;BUMP TO NEXT LOCATION
	LOAD	T2,CR.PDB(S2),RHMASK	;LAST PDB USED BY COMMAND
	LOAD	T2,.CMDAT(T2)		;GET THE RADIX
	STORE	T2,@ARGFRE		;SAVE THE RADIX
	AOS	ARGFRE			;BUMP TO NEXT LOCATION
	$RET				;RETURN


SUBTTL	SAVZER	Save a COMMA or CONFRM

;THIS ROUTINE WILL SAVE THE FUNCTION VALUE AND A LENGTH OF 1

SAVZER:	LOAD	T1,CR.COD(S2)		;GET THE FUNCTION CODE
	STORE	T1,@ARGFRE,PF.TYP	;SAVE THE TYPE CODE
	MOVEI	T1,PFD.D1		;SIZE OF THE BLOCK
	STORE	T1,@ARGFRE,PF.LEN	;SAVE THE VALUE
	AOS	ARGFRE			;BUMP TO NEXT LOCATION
	$RET				;RETURN


SUBTTL	SAVUQS	Save an unquoted string

;THIS ROUTINE WILL BUILD BLOCK WITH TEXT FROM UNQUOTED STRING FUNCTION

SAVUQS:	MOVE	T2,ARGFRE		;POINTER TO FREE LOCATION
	ADDI	T2,1			;BUMP BY 1 PASSED HEADER
	ADD	T2,USRPTR		;MAKE INTO A BYTE POINTER
	MOVE	T1,CURPTR		;USE THE BUFFER POINTER FIELD
	CAME	T1,CMDBLK+.CMPTR	;WERE THEY EQUAL AT THE START
	JRST	SAVU.1			;SAVE A NULL AND RETURN
	SETZ	T3,0			;MAKE A NULL
	JRST	SAVU.2			;SAVE THE NULL AND RETURN
SAVU.1:	ILDB	T3,T1			;GET A CHARACTER FROM THE SOURCE
	CAMN	T1,CMDBLK+.CMPTR	;AT END OF FIELD?
	JRST	SAVU.2			;YES, FINISH OFF TEXT
	IDPB	T3,T2			;SAVE  IT IN THE DESTINATION
	JRST	SAVU.1			;LOOP TILL HIT END OF TEXT
SAVU.2:	IDPB	T3,T2			;SAVE THE BYTE
	JRST	SAVA.2			;FINISH OFF TEXT

SUBTTL	SAVATM	Save the atom as the argument

;THIS SAVE ROUTINE WILL COPY DATA FROM THE ATOM BUFFER
;TO THE COMMAND MESSAGE
;THIS ROUTINE IS USED BY .CMFLD, .CMTXT, .CMQST

SAVATM:	MOVE	T2,ARGFRE		;POINTER TO FREE LOCATION
	ADDI	T2,1			;BUMP BY 1 PASSED HEADER
	ADD	T2,USRPTR		;MAKE INTO A BYTE POINTER
	MOVE	T1,PRSPTR		;MAKE SOURCE BYTE POINTER
	HRRI	T1,ATMBFR		;SOURCE OF DATA
SAVA.1:	ILDB	T3,T1			;GET A CHARACTER FROM THE SOURCE
	IDPB	T3,T2			;SAVE  IT IN THE DESTINATION
	JUMPN	T3,SAVA.1		;LOOP IF MORE ...NON-ZERO
SAVA.2:	HRRZI	T2,1(T2)		;GET NEXT LOCATION AND CLEAR LH
	MOVE	T1,T2			;SAVE VALUE IN T1
	SUB	T2,ARGFRE		;GET LENGTH OF BLOCK
	STORE	T2,@ARGFRE,PF.LEN	;SAVE THE LENGTH
	LOAD	T2,CR.COD(S2)		;GET THE CODE VALUE
	STORE	T2,@ARGFRE,PF.TYP	;SAVE AS HEADER FOR BLOCK
	EXCH	T1,ARGFRE		;UPDATE THE FREE POINTER
	$RET				;RETURN
SUBTTL	SAVRES	Save a 2 word argument

;THIS ROUTINE WILL CREATE A BLOCK WITH ONE DATA ELEMENT IN IT
;TO STORE THE RESULT RETURNED BY COMND

SAVRES:	LOAD	T2,CR.COD(S2)		;GET CODE IN LEFT HALF
	STORE	T2,@ARGFRE,PF.TYP	;SAVE TYPE IN HEADER
	MOVEI	T2,PFD.D2		;SIZE OF THE BLOCK
	STORE	T2,@ARGFRE,PF.LEN	;SAVE THE HEADER VALUE
	AOS	ARGFRE			;BUMP TO NEXT LOCATION
	MOVE	T2,CR.RES(S2)		;GET THE RESULT
	STORE	T2,@ARGFRE		;SAVE THE VALUE
	AOS	ARGFRE			;BUMP TO NEXT LOCATION
	$RET				;RETURN
SUBTTL	SAVDEV	Save routine for a device

;THIS ROUTINE WILL STORE A STRING IN THE BLOCK FOR .CMDEV

TOPS20	<
SAVDEV:	LOAD	T1,CR.PDB(S2),RHMASK	;GET PDB USED
	TXNN	T1,CM%PO		;WAS IT PARSE ONLY
	JRST	SAVATM			;YES, PROCESS AS SAVE ATOM
	DMOVE	T1,S1			;SAVE THE CALLING ARGUMENTS
	HRRO	S1,ARGFRE		;GET POINTER FOR STRING
	ADDI	S1,1			;SKIP OVER THE HEADER
	MOVE	S2,CR.RES(S2)		;GET THE DEVICE DESIGNATOR
	DEVST				;CONVERT TO A STRING
	STOPCD	(DDC,HALT,,<Device designator conversion error>)
	HRRZI	S2,1(S1)		;GET NEXT LOCATION AND CLEAR LEFT HALF
	MOVE	T3,S2			;SAVE THE LOCATION
	SUB	S2,ARGFRE		;GET THE LENGTH
	STORE	S2,@ARGFRE,PF.LEN	;SAVE THE LENGTH IN BLOCK
	LOAD	S2,CR.COD(T2)		;GET THE FUNCTION CODE
	STORE	S2,@ARGFRE,PF.TYP	;SAVE TYPE IN BLOCK
	EXCH	T3,ARGFRE		;UPDATE FREE POINTER
	$RETT				;RETURN TRUE
> ;End TOPS20
TOPS10	<
SAVDEV==SAVATM
> ;End TOPS10

SUBTTL	SAVTOK	Save routine to save a token

;THIS ROUTINE WILL SAVE A TOKEN IN THE COMMAND MESSAGE

SAVTOK:	LOAD	T2,CR.PDB(S2),RHMASK	;PDB USED BY COMMAND
	MOVE	T1,.CMDAT(T2)		;DATA USED BY COMND
	TLCE	T1,-1			;LH 0?
	TLCN	T1,-1			;OR -1
	HLL	T1,USRPTR		;YES--SETUP A BYTE POINTER
	MOVE	T2,ARGFRE		;GET DESTINATION POINTER
	ADDI	T2,1			;BUMP BY 1 PASSED HEADER
	ADD	T2,USRPTR		;MAKE DESTINATION POINTER
	PJRST	SAVA.1			;USE SAVE ATOM ROUTINE


SUBTTL	SAVNOD	Save node specification

;THIS ROUTINE WILL SAVE ANODE SPECIFICATION IN THE COMMAND
;MESSAGE

TOPS20	<
SAVNOD:	PJRST	SAVATM			;SAVE THE ATOM FOR TOPS-20
> ;End TOPS20

TOPS10	<
SAVNOD:	PJRST	SAVRES			;SAVE AS NUMBER WITH NO RADIX
> ;End TOPS10

SUBTTL	SAVINI	Initialize the returned arguments

;THIS ROUTINE IS CALLED TO INITIALIZE THE SAVE ROUTINES FOR THE PARSER
;IT IS THE FUNCTION DEPENDENT ROUTINE FOR THE .CMINI FUNCTION

SAVINI:	SKIPE	SBCFLG			;DOING SUB-COMMAND INITIALIZATION?
	JRST	SAVIN1			;YES--DO THINGS DIFFERENTLY
	SETZM	SBCUSR			;MAKE SURE WE START OFF CLEAN
	MOVE	S1,PARDAT		;GET PAGE ADDRESS
	MOVE	T1,COM.PB(S1)		;GET PARSER START OFFSET
	ADDI	T1,(S1)			;CONVERT TO FULL ADDRESS
	MOVEM	T1,ARGFRE		;SAVE AS START OF ARGUMENT AREA
	POPJ	P,			;AND RETURN
SAVIN1:	MOVE	S1,CURPTR		;GET CURRENT BYTE POINTER
	MOVEM	S1,CMDBLK+.CMPTR	;RESET SINCE COMND WIPES IT
	POPJ	P,			;RETURN
SUBTTL	REPARS	Set up for COMND reparse

;THIS ROUTINE IS GOTTEN TO BY THE COMND JSYS CHANGING THE PC WHEN
;A USER RUBS OUT ACROSS A FIELD. IT JUST CLEARS OUT THE TEMPORARY
;STORAGE USED BY COMND AND RESTARTS THE PARSER

REPARS:	$CALL	@.CMINI+PARTAB		;TELL SAVE ROUTINES TO FORGET IT
	MOVX	S1,P.NPRO		;GET THE NO PROCESS FLAGS
	ANDCAM	S1,FLAGS		;CLEAR FLAG TO BE SAFE
	MOVE	S1,[GJFBLK,,GJFBLK+1]	;SET UP TO CLEAR GTJFN BLOCK
	SETZM	GJFBLK			;CLEAR FIRST WORD
	BLT	S1,GJFBLK+GJFSIZ-1	;CLEAR THE BLOCK
	MOVE	S1,ARGSAV+PAR.TB	;GET THE ORIGINAL TABLES FROM CALL
	AOS	S1			;POSITION TO THE FDB
	LOAD	T1,.CMFNP(S1),CM%FNC	;GET THE FUNCTION CODE
	CAIE	T1,.CMINI		;MAKE SURE NOT A .CMINI
	JRST	REPA.1			;NOT .CMINI.... O.K.
	$CALL	P$PNXT			;GET NEXT PDB
	AOS	S1			;BUMP TO ACTUAL PDB
REPA.1:	STORE	S1,CMDRET+CR.PDB,RHMASK	;SAVE THE NEW PDB
	JRST	PARCMD			;JUST RESTART PARSER

SUBTTL	FILDEF	Fill in defaults for COMND

;THIS ROUTINE WILL FILL IN DEFAULTS BEFORE THE PDB IS PROCESSED
;
;CALL	S1/	SIZE OF BLOCK
;	S2/	ADDRESS OF THE BLOCK
;
;RETURN	TRUE:	CHECK NEXT ALTERNATE AND RETURN
;
;RETURN FALSE:	S1/	ERROR CODE IF ANY
;		S2/	ADDRESS OF THE STRING


FILDEF:	LOAD	S1,CMDRET+CR.PDB,RHMASK	;GET CURRENT PDB
FILD.1:	MOVEM	S1,CURPDB		;SAVE THE CURRENT PDB
	$CALL	P$PDEF			;IS THERE A DEFAULT ROUTINE
	JUMPF	FILD.2			;NO, TRY NEXT PDB
	MOVE	T2,S1			;SAVE THE ACTION ROUTINE
	MOVEI	S1,PC.SIZ		;SIZE OF THE BLOCK
	MOVEI	S2,CMDRET		;COMMAND RETURN BLOCK
	$CALL	(T2)			;CALL THE DEFAULT FILLER
	JUMPT	FILD.2			;O.K..CONTINUE ON
	SKIPN	S2			;IF S2 HAS ERROR SET..SKIP
	MOVEI	S2,[ASCIZ/Error during default filling routine/]
	MOVX	T2,P.DERR		;DEFAULT ROUTINE ERROR
	IORM	T2,FLAGS		;SAVE IN THE FLAGS
	MOVEM	S1,PARBLK+PRT.EC	;SAVE ANY CODE FOR CALLER
	$RETF				;RETURN FALSE
FILD.2:	MOVE	S1,CURPDB		;GET THE CURRENT PDB
	LOAD	S1,.CMFNP(S1),CM%LST	;GET THE ADDR OF NEXT PDB IN LIST
	JUMPN	S1,FILD.1		;LOOP ON NEXT ONE
	$RETT				;RETURN
SUBTTL	PDBCPY	Copy a switch table

;THIS ROUTINE IS CALLED AS A SPECIAL ROUTINE TO COPY
;THE CURRENT SWITCH TABLE TO TEMFDB SO THAT THE TABLE
;ENTRIES CAN BE DELETED AS USED.


	C.SWIT==1B0			;FLAG FOR SWITCH


PDBCPY:	MOVE	T3,S2			;SAVE THE ARGUMENT BLOCK POINTER
	LOAD	S1,CR.PDB(T3),RHMASK	;GET THE LAST USED PDB
	MOVE	T2,CR.RES(T3)		;GET RESULT IN T2
	$CALL	P$PACT			;GET THE ACTION ROUTINE ADDRESS
	TXNN	S1,C.SWIT		;SPECIAL SWITCH SET
	JRST	PDBC.1			;NO, ALREADY SETUP TEMP
	HRRZ	T1,CR.PDB(T3)		;CURRENT FDB ADDRESS
	SUBI	T1,1			;INCLUDE THE HEADER FOR THE PDB
	HRLZS	T1,T1			;NOW PLACE IN THE LEFT HALF
	HRRI	T1,TEMFDB		;NEW FDB AREA
	BLT	T1,TEMFDB+PDB.SZ-1	;MOVE THE PDB
	MOVEI	S1,TEMFDB+1		;GET THE CURRENT PDB
	$CALL	P$GPDB			;GET THE PDB ADDRESS
	MOVX	T1,C.SWIT		;GET SPECIAL SWITCH
	ANDCAM	T1,PB%RTN(S1)		;CLEAR THE BIT IN PDB
	HRLZ	T1,TEMFDB+1+.CMDAT	;GET TABLE ADDRESS
	HRRI	T1,TEMTAB		;GET TEMPORARY TABLE
	HRRZ	T2,@TEMFDB+1+.CMDAT	;GET COUNT OF TABLE
	CAILE	T2,TEMTSZ		;WITHIN TABLE SIZE
	STOPCD	(STS,HALT,,<Shared switch table size (in TEMTSZ) too small for table of size in T2>)
	BLT	T1,TEMTAB(T2)		;MOVE THE TABLE
	MOVEI	T1,TEMTAB		;ADDRESS OF TABLE
	MOVEM	T1,TEMFDB+.CMDAT+1	;SAVE DATA IN TABLE
	MOVE	T4,CR.RES(T3)		;GET THE RESULT
	HRRZ	T1,CR.PDB(T3)		;GET USED PDB FOR PARSE
	SUB	T4,.CMDAT(T1)		;GET OFFSET
	MOVEI	T2,TEMTAB(T4)		;GET NEW OFFSET
PDBC.1:	MOVEI	T1,TEMTAB		;TABLE ADDRESS IN T1
	DMOVEM	T1,DENTRY		;SAVE ARGUMENTS
	SETOM	DFLAGS			;TURN ON DELETE FLAG
	$RET				;RETURN

SUBTTL	STBDEL	Delete a local switch table entry

;THIS ROUTINE IS CALLED BY THE MAIN PARSER TO DELETE
;THE CURRENT SWITCH VALUE FROM THE TEMFDB TABLE.
;IF ALL ENTRIES ARE GONE IT WILL TURN OF THE DEFAULT HELP
;TEXT TO COMMAND.

STBDEL:	SETZM	DFLAGS			;CLEAR THE FLAG
	DMOVE	S1,DENTRY		;GET DELETE AC'S
	HLRZ	T2,0(S1)		;GET USED COUNT
	MOVE	T1,T2			;PLACE IN T1
	SOSGE	T1			;DECREMENT..SKIP IF NOT ZERO
	$RETF				;FALSE RETURN
	ADD	T2,S1			;COMPUTE END OF TABLE
	CAILE	S2,(S1)			;ENTRY IN TABLE
	CAMLE	S2,T2			;MAKE SURE
	STOPCD	(TDE,HALT,,<Table delete error>)
	HRLM	T1,0(S1)		;SAVE COUNT
	JUMPE	T1,STBD.2		;TABLE EMPTY
	HRLI	S2,1(S2)		;COMPACT TABLE
	BLT	S2,-1(T2)		;MOVE THE TABLE
STBD.1:	SETZM	0(T2)			;CLEAR EMPTY WORD AT END
	$RETT				;RETURN TRUE
STBD.2:	MOVX	S1,CM%SDH		;SUPPRESS DEFAULT HELP MESSAGE
	IORM	S1,TEMFDB+1+.CMFNP	;TURN ON IN TABLE
	JRST	STBD.1			;FINISH UP TABLE OPERATION

SUBTTL	TXTINP	Multiple line text input routines

;THIS ROUTINE WILL CHECK IF THE PRIMARY OUTPUT IS TO THE
;TERMINAL AND IF SO DISPLAY A TEXT STRING. THE ROUTINE
;WILL THEN BRANCH TO GETTXT TO INPUT THE DATA



TXTINP:	HRRZ	T1,CMDBLK+.CMIOJ	;GET THE OUTPUT DESIGNATOR
	CAIN	T1,.PRIOU		;NOT TO THE TERMINAL
	$TEXT	(T%TTY,<Enter text and terminate with ^^Z>)
	JRST	GETTXT			;GET THE TEXT
SUBTTL	GETTXT	Get multiple lines of text

;THIS ROUTINE WILL ACCEPT TEXT AND TERMINATE ON A ^Z OR
;RETURN TO THE ORIGINAL COMMAND IF RUBOUT TO BEGINNING
;OF THE BUFFER.



GETTXT:	MOVE	T1,ARGFRE		;GET NEXT FREE LOCATION
	MOVE	T2,T1			;SAVE IN T2
	SOS	T2			;DECREMENT T2
	LOAD	T3,PFD.HD(T2),PF.TYP	;GET FIELD TYPE
	CAIE	T3,.CMCFM		;CHECK IF CONFIRM TYPED
	JRST	GETE.0			;NO - ERROR IN BLOCK
	MOVE	T1,T2			;OVERLAY CONFIRM BLOCK
	STORE	T1,ARGFRE		;SAVE AS CURRENT POINTER
	ADDI	T1,1			;BUMP IT BY 1 FOR HEADER
	MOVE	T2,T1			;SAVE ADDRESS IN T2
	ADD	T1,PRSPTR		;MAKE A BYTE POINTER
	MOVEM	T1,TXTDAT+.RDDBP	;POINTER TO SAVE INPUT
	MOVEM	T1,TXTDAT+.RDBFP	;POINTER TO BEGINNING OF BUFFER
	SUB	T2,PARDAT		;ARGFRE-START OF MESSAGE
	ADDI	T2,BUFSIZ-100		;COMPUTE REMAINING LENGTH-100
	IMUL	T2,PRSCNT		;NUMBER OF CHARACTERS PER WORD
	MOVEM	T2,TXTDAT+.RDDBC	;MAXIMUM SIZE OF INPUT
	LOAD	T1,CMDBLK+.CMIOJ	;GET JFNS FROM COMMAND
	MOVEM	T1,TXTDAT+.RDIOJ	;SAVE IN TEXT ARGUMENT BLOCK
	MOVX	T1,RD%JFN+RD%RND	;USING JFNS AND BREAKOUT ON
					;RUBOUT TO BEGINNING OF BUFFER
	MOVEM	T1,TXTDAT+.RDFLG	;SAVE THE FLAGS
	MOVEI	T1,[EXP 1B26,0,0,0]	;BREAK TABLE FOR INPUT
	MOVEM	T1,TXTDAT+.RDBRK	;SAVE IN ARGUMENT BLOCK
	ZERO	TXTDAT+.RDRTY		;NO RETRY POINTER
	MOVEI	T1,.RDBRK		;SIZE OF THE BLOCK
	MOVEM	T1,TXTDAT+.RDCWB	;SAVE LENGTH IN BLOCK
	MOVEI	S1,TXTDAT		;ADDRESS OF THE BLOCK
	$CALL	K%TXTI			;INPUT THE DATA
	JUMPF	GETE.1			;ERROR RETURN - RETURN
	MOVX	S1,RD%BFE		;BACK OVER BUFFER BEGINNING
	TDNE	S1,TXTDAT+.RDFLG	;WAS THIS THE REASON
	PJRST	GETT.1			;YES - RESET THE COMMAND DATA
	MOVX	S1,RD%BTM		;BREAK TERMINATE INPUT
	TDNE	S1,TXTDAT+.RDFLG	;WAS THIS THE REASON
	PJRST	GETT.3			;YES - FINISH STRING AND RETURN
	PJRST	GETE.2			;TOO MUCH TEXT - TRUNCATED

GETT.1:	SETZ	S1,			;SETUP A NULL
	MOVNI	S2,2			;ADJUST POINTER BACK TWO
	MOVE	S2,CMDBLK+.CMPTR	;GET NEW POINTER
	SUBI	S2,1			;BACK UP 1 WORD
	IBP	S2			;BUMP UP ONE BYTE
	IBP	S2			;ONE MORE
	IBP	S2			;ONE MORE  SAME AS BACKING UP 2
	IDPB	S1,S2			;REPLACE CR WITH NULL
	IDPB	S1,S2			;REPLACE LF WITH NULL
	MOVEI	S1,BUFSIZ-2		;SIZE OF BUFFER
	IMUL	S1,PRSCNT		;COMPUTE CHARACTER COUNT
	SUB	S1,CMDBLK+.CMCNT	;GET CHARACTERS IN BUFFER
	MOVEM	S1,CMDBLK+.CMINC	;SAVE IN COMMAND BLOCK
	MOVE	S1,PRSPTR		;GET BYTE POINTER
	HRRI	S1,BUFFER		;POINT TO TEXT
	MOVEM	S1,CMDBLK+.CMBFP	;RESET START OF TEXT BUFFER
	MOVEM	S1,CMDBLK+.CMPTR	;SAVE THE TEXT POINTER
	MOVEI	S1,BUFSIZ		;BUFFER SIZE
	IMUL	S1,PRSCNT		;COMPUTE CHARACTER COUNT
	MOVEM	S1,CMDBLK+.CMCNT	;RESET THE COUNT
	MOVX	S1,P.REPA		;SET FOR REPARSE
	IORM	S1,FLAGS		;SAVE FOR PARSER FLAGS
GETT.2:	HRRZ	T1,CMDBLK+.CMIOJ	;GET OUTPUT DESIGNATOR
	CAIN	T1,.PRIOU		;IS IT TERMINAL OUTPUT
	$TEXT	(T%TTY,<^Q/CURPMT/^T/BUFFER/^A>)
	$RETF				;EXIT ACTION ROUTINE - repARSE

GETT.3:	SETZ	S1,			;CLEAR S1 FOR NULL
	DPB	S1,TXTDAT+.RDDBP	;REPLACE BREAK WITH NULL
	MOVE	S1,CMDBLK+.CMPTR	;BYTE POINTER OF STRING
	MOVEM	S1,TEMPTR		;SAVE IN TEMPTR
	MOVE	T2,ARGFRE		;ARGUMENT HEADER
	AOS	T2			;POINT TO THE TEXT
	$TEXT	(GETOUT,<^T/(T2)/>)	;ADD TO THE BUFFER
	MOVEI	S1,0			;GET A NULL
	IDPB	S1,TEMPTR		;SAVE THE NULL
	HRRZ	S1,TXTDAT+.RDDBP	;LAST USED ADDRESS
	ADDI	S1,1			;BUMP TO NEXT FREE
	MOVE	S2,S1			;SAVE IN S2
	SUB	S2,ARGFRE		;GET USED LENGTH
	STORE	S2,@ARGFRE,PF.LEN	;SAVE LENGTH IN HEADER
	MOVEI	S2,.CMTXT		;TEXT TYPE IN LEFT HALF
	STORE	S2,@ARGFRE,PF.TYP	;SAVE TYPE IN MESSAGE
	EXCH	S1,ARGFRE		;RESET NEXT FREE LOCATION
	MOVEI	S2,.CMCFM		;CONFIRM BLOCK
	STORE	S2,@ARGFRE,PF.TYP	;SAVE TYPE IN MESSAGE
	MOVEI	S2,1			;ONLY ONE WORD
	STORE	S2,@ARGFRE,PF.LEN	;SAVE LENGTH IN HEADER
	AOS	ARGFRE			;BUMP TO NEXT
	$RETT				;RETURN TRUE


GETE.0:	MOVEI	S2,[ASCIZ/Bad argument in message  -  expected confirm/]
	$RETF				;RETURN FALSE
GETE.1:	MOVEI	S2,[ASCIZ/Error during text input/]
	$RETF
GETE.2:	HRR	T1,CMDBLK+.CMIOJ	;GET THE OUTPUT DESIGNATOR
	CAIN	T1,.PRIOU		;NOT TO THE TERMINAL
	$WARN	(Message truncated - text exceeded buffer capacity)
	JRST	GETT.3			;FINISH OFF THE MESSAGE


GETOUT:	IDPB	S1,TEMPTR		;SAVE THE CHARACTER
	$RETT				;RETURN TRUE
SUBTTL	P$FIXP	Fixup Pointer to command buffer


;Fixup pointer to command buffer when an action routine detects
;an error in the argument.

P$FIXP:	$CALL	.SAVET			;FREE UP SOME REGISTERS
	HRRZ	T4,CR.FLG(S2)		;GET ADDRESS OF COMMAND BLOCK
	MOVE	T2,.CMABP(T4)		;GET BYTE POINTER TO ATOM BUFFER
FIXI.1:	ILDB	T3,T2			;GET A CHARACTER
	JUMPE	T3,.RETT		;RETURN ON NULL
	MOVNI	T1,1			;BACK UP THE BYTE POINTER
	ADJBP	T1,.CMPTR(T4)		;...
	MOVEM	T1,.CMPTR(T4)		;STORE NEW ONE
	AOS	.CMCNT(T4)		;INCREMENT CHARACTER COUNT
	JRST	FIXI.1			;LOOP
SUBTTL	TAKFDB	TAKE command tables

DEFINE	NEXTF(FOO),<TEMFDB>		;LOCAL NEXT MACRO FOR AUTO TAKE

TAKFDB: $NOISE(TAK001,<commands from>)

TAK001:	$IFILE(TAK002,<input filespec>,<$PREFILL(TAKDEF),$ACTION(TAKRTN),$ERROR(BADIFI)>)

TAK002:	$KEYDSP	(TAK010,<$DEFAULT(<NOW>),$ALTER(TAK003)>)

TAK003:	$FTAD	(TAK005,<$ALTER(TAK004)>)

TAK004:	$SWITCH	(,TAK020,<$ALTER(TAK009)>)

TAK005:	$SWITCH	(,TAK030,<$ACTION(C.SWIT+PDBCPY),$ALTER(TAK009)>)

TAK009:	$CRLF	(<$ACTION(TAKE)>)

TAK010:	$STAB
	ORNDSP(TAK130,DAILY,DLY)
	ORNDSP(TAK140,EVERY,WKY)
	ORNDSP(TAK004,NOW,NOW)
	$ETAB

TAK020:	$STAB
	ORNSDP	(TAK009,<DISPLAY>,DSP)
	ORNSDP	(TAK009,<NODISPLAY>,NDP)
	$ETAB

TAK030:	$STAB
	ORNSDP(NEXTF(TAK005),<FAILSOFT>,FSF)
	ORNSDP(TAK150,<REASON:>,RSN)
	$ETAB

TAK130:	$NOISE(TAK132,<at>)
TAK132:	$TIME(TAK005)

TAK140:	$KEY(TAK145,TAK142)
TAK142:	$STAB
	KEYTAB(2,FRIDAY)
	KEYTAB(5,MONDAY)
	KEYTAB(3,SATURDAY)
	KEYTAB(4,SUNDAY)
	KEYTAB(1,THURSDAY)
	KEYTAB(6,TUESDAY)
	KEYTAB(0,WEDNESDAY)
	$ETAB

TAK145:	$NOISE(TAK146,<at>)
TAK146:	$TIME(TAK005)

TAK150:	$CTEXT(TAK009,<reason text (same line) followed by confirm>)

BADIFI: SETZM	S2			;CLEAR THE ERROR CODE
	$RETF				;BAD INPUT FILE
SUBTTL	TAKDEF	Take default setting

TOPS20	<
TAKDEF:	MOVE	S1,[GJFBLK,,GJFBLK+1]	;SET UP TO CLEAR BLOCK
	SETZM	GJFBLK			;CLEAR FIRST WORD
	BLT	S1,GJFBLK+GJFSIZ-1	;CLEAR THE BLOCK
	MOVX	S1,GJ%OLD		;FILE MUST EXIST
	MOVEM	S1,GJFBLK+.GJGEN	;INTO FLAGS WORD
	MOVE	S1,[XWD .NULIO,.NULIO]	;SUPPLY NO JFNS
	MOVEM	S1,GJFBLK+.GJSRC	;INTO BLOCK
	HRROI	S1,[ASCIZ/SYSTEM/]	;POINT AT DEFAULT FILE NAME
	MOVEM	S1,GJFBLK+.GJNAM	;SAVE FOR GTJFN
	HRROI	S1,[ASCIZ/CMD/]		;DEFAULT EXTENSION
	MOVEM	S1,GJFBLK+.GJEXT	;SAVE IN GTJFN BLOCK
	HRROI	S1,[ASCIZ/DSK/]		;GET THE DEFAULT STRUCTURE
	MOVEM	S1,GJFBLK+.GJDEV	;SAVE THE DEVICE
	$RET				;AND RETURN
> ;End TOPS20
TOPS10	<
TAKDEF:	MOVE	S1,[GJFBLK,,GJFBLK+1]	;SET UP TO CLEAR BLOCK
	SETZM	GJFBLK			;CLEAR FIRST WORD
	BLT	S1,GJFBLK+GJFSIZ-1	;CLEAR THE BLOCK
	MOVE	S1,[SIXBIT/SYSTEM/]	;GET FILE NAME
	STORE	S1,GJFBLK+.FDNAM	;SAVE IN DEFAULT BLOCK
	MOVSI	S1,'CMD'		;GET DEFAULT EXTENSION
	STORE	S1,GJFBLK+.FDEXT	;SAVE IN BLOCK
	MOVSI	S1,'DSK'		;GET STRUCTURE NAME
	STORE	S1,GJFBLK+.FDSTR	;SAVE THE STRUCTURE
	$RET				;AND RETURN
> ;End TOPS10

SUBTTL	TAKRTN	Special routines for TAKE commands

;INCLUDED HERE ARE THE SPECIAL ROUTINES NEEDED FOR THE
;PROPER SETUP FOR TAKE COMMANDS. THESE ROUTINES ARE
;CALLED AS SPECIAL ACTION ROUTINES BY THE PARSER


TAKRTN:	PUSH	P,S1			;SAVE SACRED AC
	PUSH	P,S2			;AND ANOTHER
	MOVE	T1,CR.SAV(S2)		;GET FD ADDRESS
	MOVEM	T1,TAKFOB+FOB.FD	;SAVE
	MOVE	T3,.FDLEN(T1)		;PRESERVE LENGTH WORD
	MOVEI	T2,.FDNAT		;NATIVE MODE FILE
	STORE	T2,.FDLEN(T1),FD.TYP	;SAVE
	MOVEI	T2,7			;7-BIT BYTES
	MOVEM	T2,TAKFOB+FOB.CW	;SAVE IN CONTROL WORD
	MOVEI	S1,FOB.SZ		;FOB SIZE
	MOVEI	S2,TAKFOB		;FOB ADDRESS
	$CALL	F%IOPN			;OPEN FILE FOR INPUT
	JUMPF	TAKR.1			;CHECK ERRORS
	PUSH	P,S1			;SAVE IFN
	MOVNI	S2,1			;WANT ACTUAL FD
	$CALL	F%FD			;GET IT
	MOVSI	T1,(S1)			;POINT TO STORAGE
	LOAD	T2,.FDLEN(S1),FD.LEN	;GET ACTUAL LENGTH
	MOVE	S2,-1(P)		;GET SAVED ADDRESS OF CMD BLOCK
	HRR	T1,CR.SAV(S2)		;GET COMMAND FILESPEC STORAGE
	ADD	T2,CR.SAV(S2)		;COMPUTE END BLT ADDRESS
	BLT	T1,-1(T2)		;COPY ACTUAL FILESPEC
	MOVE	S1,CR.SAV(S2)		;GET FD ADDRESS
	MOVEM	T3,.FDLEN(S1)		;RESTORE LENGTH WORD
	POP	P,S1			;GET IFN BACK
	$CALL	F%RREL			;RELEASE IFN
	POP	P,S2			;RESTORE ACS
	POP	P,S1			; ...
	$RETT				;AND RETURN

TAKR.1:	$TEXT	(<-1,,FILERR>,<^E/S1/^0>) ;GET ERROR TEXT
	MOVEI	S2,FILERR		;POINT TO IT
	POP	P,(P)			;TRIM STACK
	POP	P,S1			;RESTORE S1
	$RETF				;PROPAGATE ERROR


TAKE:	SKIPE	IMOPR			;ORION DOING AN INTERNAL TAKE?
	$RETT				;YES--CAN DO NO MORE HERE
;	SETOM	TAKFLG			;SET FLAG FOR PROCESSING TAKE
	MOVE	T4,PARDAT		;GET THE PAGE ADDRESS
	MOVE	S1,COM.PB(T4)		;GET POINTER TO PARSER BLOCK
	ADDI	S1,(T4)			;GET OFFSET FOR PARSER DATA
	$CALL	P$SETU			;SETUP THE POINTER
	$CALL	P$KEYW			;GET THE NEXT FIELD
	JUMPF	TAKE.1			;ERROR..RETURN
	CAIE	S1,.KYTAK		;IS IT A TAKE COMMAND
	PJRST	TAKE.1			;INVALID TAKE COMMAND
	$CALL	P$IFIL			;IS IT AN INPUT FILE SPEC ???
	JUMPF	TAKE.2			;NO, ERROR
	MOVE	T2,S1			;ADDRESS OF THE BLOCK
	$CALL	P$KEYW			;GET THE NEXT FIELD
	JUMPF	TAK.1			;DID WE FIND A KEY WORD ?
	CAIN	S1,.KYWKY		;YES, IS IT A WEEKLY TAKE ?
	  JRST	TAK.4			;YES, SEND TO ORION/CLEAN UP
	CAIN	S1,.KYDLY		;NO, THEN IS IT A DAILY TAKE ?
	  JRST	TAK.4			;YES, SEND TO ORION/CLEAN UP
TAK.1:	$CALL	P$TIME			;NO, AN $FTAD TAKE FIELD ?
	JUMPT	TAK.4			;DID WE FIND A IT ??
	$CALL	P$CFM			;NO, MUST BE AN IMMEDIATE TAKE
	JUMPT	TAK.3			;DO WE HAVE A CONFIRM ?
	$CALL	TAKDSP			;NO, CHECK TAKE DISPLAY SWITCHES
	$RETIF				;FALSE..PASS ERRORS UP
	$CALL	P$CFM			;CHECK FOR A CONFIRM
	JUMPF	TAKE.1			;ERROR...RETURN
TAK.3:	SKIPE	TAKFLG			;PROCESSING A TAKE COMMAND
	JRST	TAKE.6			;NESTING IS ILLEGAL
	SETOM	TAKFLG			;NOW DOING A TAKE COMMAND
	MOVX	T1,P.DSPT		;GET FLAG TO DISPLAY COMMAND
	ANDCAM	T1,FLAGS		;CLEAR THE FLAG
	SKIPE	OPRTAK			;DISPLAY TAKE OUTPUT
	IORM	T1,FLAGS		;SET THE FLAG
	MOVX	S1,P.TAKE		;SAY WE ARE DOING TAKE COMMAND
	IORM	S1,FLAGS
	MOVE	S1,T2			;COMMAND FD TO S1
	SETZM	S2			;NO LOGGING FD
	$CALL	P$TAKE			;OPEN THE FILES
	JUMPF	TAKE.3			;OPEN ERROR ON FILE
	$RETT				;RETURN TRUE

TAK.4:	$RETT				;NOTHING TO CLEAN UP IF SENDING TO ORION

TAKDSP:	$CALL	P$SWIT			;CHECK FOR A SWITCH
	JUMPF	TAKE.4			;NO, GIVE ERROR RETURN
	CAIE	S1,.SWDSP		;DISPLAY COMMAND OUTPUT
	JRST	TAKD.1			;TRY OTHER FLAGS
	SETOM	DSPTAK			;SET DISPLAY TAKE COMMANDS
	$RETT				;RETURN TRUE
TAKD.1:	CAIE	S1,.SWNDP		;NO DISPLAY
	JRST	TAKE.4			;INVALID ARGUMENT..ERROR
	SETZM	DSPTAK			;CLEAR TAKE DISPLAY
	$RETT				;RETURN

TAKE.1:	MOVEI	S2,[ASCIZ/Invalid TAKE command/]
	JRST	TAKERR			;TAKE ERROR EXIT
TAKE.2:	MOVEI	S2,[ASCIZ/No input file specified in TAKE command/]
	JRST	TAKERR			;TAKE ERROR EXIT
TAKE.3:	MOVE	S2,PARDAT		;GET THE PAGE ADDRESS
	MOVE	S1,COM.PB(S2)		;GET POINTER TO PARSER BLOCK
	ADDI	S1,(S2)			;GET OFFSET FOR PARSER DATA
	$CALL	P$SETU			;SET UP THE PARSE POINTER
	$CALL	P$KEYW			;SKIP THE NEXT FIELD
	$CALL	P$IFIL			;GET THE CURRENT PARSE BLOCK
	JUMPF	TAKE.5			;IS IT AN INPUT FILE BLOCK ???
	$TEXT	(T%TTY,<? Can't open TAKE command file: "^F/@S1/"^0>); YES ...
	SETOM	S2			;DON'T OUTPUT ANYTHING ELSE
	JRST	TAKERR			;AND RETURN
TAKE.4:	MOVEI	S2,[ASCIZ/Invalid argument in TAKE command/]
	JRST	TAKERR			;TAKE ERROR EXIT
TAKE.5:	MOVEI	S2,[ASCIZ/Can't find TAKE command FD parse block/]
	JRST	TAKERR			;TAKE ERROR EXIT
TAKE.6:	MOVEI	S2,[ASCIZ/TAKE command is illegal in a command file/]
	$FALL	TAKERR			;TAKE ERROR EXIT
TAKERR:	SETZM	TAKFLG			;CLEAR THE TAKE FLAG ON ERROR
	SETZM	DSPTAK			;ALWAYS ZERO DISPLAY FLAG
	$RETF				;RETURN FALSE

SUBTTL	WAIFDB	WAIT command tables

;This Command will sleep for a specified amount of time and wait
;and/or wait for an interrupt to proceed.

WAIFDB: $NOISE(WAI010,<for>)

WAI010:	$NUMBER(WAI020,^D10,<Number of seconds to wait between 1 and 60>)

WAI020:	$NOISE(WAI030,<seconds>)


WAI030:	$CRLF(<$ACTION(WAITRN)>)


WAITRN:	MOVE	T4,PARDAT		;GET THE PARSER PAGE ADDRESS
	MOVE	S1,COM.PB(T4)		;OFFSET TO PARSER DATA
	ADDI	S1,(T4)			;SETUP PB PROPERLY
	$CALL	P$SETU			;SETUP THE POINTER
	$CALL	P$KEYW			;CHECK FOR A KEYWORD
	JUMPF	WAITE1			;ERROR .. NO WAIT KEYWORD
	CAIE	S1,.KYWAI		;WAS IT WAIT?
	PJRST	WAITE1			;NO, ERROR
WAIT.1:	$CALL	P$NUM			;WAS IT A NUMBER
	JUMPF	WAITE1			;NO GENERATE AN ERROR
	MOVE	T3,S1			;SAVE THE TIME
	CAIG	S1,^D60			;60 SECOND LIMIT ON SLEEP
	SKIPG	S1			;VALID TIME
	PJRST	WAITE2			;INVALID WAIT VALUE
WAIT.2:	$CALL	P$NPRO			;NO PROCESSING FLAG AND RETURN
	MOVE	S1,T3			;GET THE TIME
WAIT.3: SKIPG	S1			;[102]IF A NEGATIVE NUMBER,
	MOVEI	S1,1			;[102]SLEEP FOR A SECOND
	CAILE	S1,^D60			;[102]IF MORE THAN A MINUTE
	MOVEI	S1,^D60			;[102]SLEEP FOR A MINUTE
	PUSH	P,S1			;[102]SAVE SECONDS TO SLEEP
	$CALL	.SC2UD			;[102]CONVERT TO UDT FRACTION
	MOVEM	S1,WAKEUP		;[102]SAVE IT
	$CALL	I%NOW			;[102]GET CURRENT TIME
	ADDM	S1,WAKEUP		;[102]THIS IS THE WAKEUP TIME
	POP	P,S1			;[102]GET SLEEP TIME BACK
	JRST	WAIT.5			;[102]ENTER SLEEP LOOP

WAIT.4:	$CALL	I%NOW			;[102]GET CURRENT TIME
	CAML	S1,WAKEUP		;[102]TIME TO WAKE UP?
	$RETT				;[102]YES
	SUB	S1,WAKEUP		;[102]GET DIFFERENCE
	MOVMS	S1			;[102]MAKE IT POSITIVE
	$CALL	.UD2SC			;[102]CONVERT UDT FRACTION TO SECONDS
WAIT.5:
TOPS10 <SLEEP	S1,>			;[102]SLEEP
TOPS20 <
	IMULI	S1,^D1000		;[102]CONVERT SECONDS TO MILLISECONDS
	DISMS				;[102]ELSE SLEEP FOR SPECIFIED SECONDS
	 JFCL				;[102]USE A LOCATION
> ;END TOPS20 CONDITIONAL
	JRST	WAIT.4			;[102]GO SEE IF TIME TO WAKE UP

WAITE1:	MOVEI	S2,[ASCIZ/Invalid WAIT command/]
	$RETF				;RETURN FALSE
WAITE2:	MOVEI	S2,[ASCIZ/Wait time must be a positive number between 1 and 60/]
	$RETF				;RETURN FALSE
SUBTTL	P$STAK	Setup TAKE command

;THIS COMMAND WILL ACCEPT A JFN FOR THE TAKE FILE TO BE USED
;AND UPDATE THE NECESSARY OPRPAR DATA BASE TO MAKE ALL OTHER
;FUNCTION WORK CORRECTLY
;
;CALL	S1/	JFN (IFN ON TOPS10) FOR THE COMMAND FILE
;

TOPS10 <
P$STAK:	SETOM	TAKFLG			;SET FLAG FOR PROCESSING TAKE
	MOVEM	S1,CMDIFN		;SAVE THE IFN
	MOVEM	S1,CMDJFN		;SAVE AS JFN ALSO
	$RETT
> ;End TOPS10

TOPS20 <
P$STAK:	$CALL	.SAVET			;Preserve temporaries
	STKVAR	<<CMDFD,^D20>>		;Get some space to build FD
	MOVE	S2,S1			;Put JFN in S2
	MOVSI	S1,^D20			;Setup FD header
	MOVEM	S1,CMDFD
	HRROI	S1,1+CMDFD		;Point to storage for string
	MOVX	T1,1B2+1B5+1B8+1B11+1B14+JS%PAF ;Request all fields
	JFNS
	 ERJMP	.RETF
	MOVE	S1,S2			;Close the file
	CLOSF
	 ERJMP	.RETF
	MOVEI	S1,CMDFD		;Point to the file spec
	SETZM	S2			;No logging file wanted
	PJRST	P$TAKE			;Setup for TAKE
> ;End TOPS20


SUBTTL	P$TAKE	Routine to setup a TAKE command

;THIS ROUTINE ACCEPTS TWO FDS FOR THE TAKE COMMAND TO BE
;USED AND WILL OPEN THE FILES AND UPDATE THE DATA BASE TO
;MAKE ALL OTHER FUNCTIONS OPERATE CORRECTLY

;CALL	S1/	ADDRESS OF COMMAND FILE FD
;	S2/	ADDRESS OF LOG FILE FD

; On failure, release all IFN's and return false


P$TAKE:	STKVAR	<<CMDFOB,FOB.MZ>,<LOGFOB,FOB.MZ>>
	MOVEM	S1,FOB.FD+CMDFOB	;Save address of command FD
	MOVEM	S2,FOB.FD+LOGFOB	;Save address of logging FD
	MOVX	S1,FLD(7,FB.BSZ)+FLD(1,FB.LSN)
	MOVEM	S1,FOB.CW+CMDFOB	;Strip LSN and open as ascii
	MOVEI	S1,FOB.MZ		;Size of the FOB
	MOVEI	S2,CMDFOB		;Address of the FOB
	$CALL	F%IOPN			;Open the file
	 $RETIF				;Return the error on failure
	MOVEM	S1,CMDIFN		;Save the IFN
	SETOM	TAKFLG			;Remember we are doing a TAKE
TOPS20 <
	MOVEI	S2,FI.CHN		;Get the JFN for TOPS20
	$CALL	F%INFO
	 $RETIF				;Return the error on failure
					;  The error must indicate bad IFN
	MOVEM	S1,CMDJFN		;Save proper file index
	TXO	S1,CO%NRJ+CZ%NUD	;Close but don't release JFN
	CLOSF
	 JRST	P$TAK3			;Should never happen
	MOVE	S1,CMDJFN		;Reclaim the JFN
	MOVX	S2,FLD(7,OF%BSZ)+OF%RD	;Reopen in proper mode
	OPENF
	 JRST	P$TAK3			;Should never happen
	SKIPA				;Already saved JFN
> ;End TOPS20
	MOVEM	S1,CMDJFN		;Save the proper  file index
	SKIPG	FOB.FD+LOGFOB		;Logging file wanted?
	 JRST	[MOVEI S1,.NULIO	;No, then set nulio
		 MOVEM S1,LOGIFN
		 MOVEM S1,LOGJFN
		 JRST  P$TAK1]

	MOVX	S1,FLD(7,FB.BSZ)	;Open log file as ascii
	MOVEM	S1,FOB.CW+LOGFOB
	MOVEI	S1,FOB.MZ
	MOVEI	S2,LOGFOB
	$CALL	F%OOPN
	JUMPF	P$TAK4			;Return error after cleanup
	MOVEM	S1,LOGIFN		;Save the IFN
TOPS20 <
	MOVEI	S2,FI.CHN		;Get the JFN for TOPS20
	$CALL	F%INFO
	JUMPF	P$TAK4			;Return error after cleanup
	MOVEM	S1,LOGJFN		;Save the JFN
	TXO	S1,CO%NRJ+CZ%NUD	;Close but don't release JFN
	CLOSF
	 JRST	P$TAK2			;Should never happen
	MOVE	S1,LOGJFN		;Reclaim proper JFN
	MOVX	S2,FLD(7,OF%BSZ)+OF%WR	;Reopen in proper mode
	OPENF
	 JRST	P$TAK2			;Should never happen
	SKIPA				;Already saved JFN
> ;End TOPS20
	MOVEM	S1,LOGJFN		;Save the logging JFN
P$TAK1:	MOVE	S1,CMDIFN		;Return command IFN
	MOVE	S2,LOGIFN		; and logging IFN
	$RETT

;  Cleanup after failure

P$TAK2:	MOVE	S1,LOGJFN		;Want to release log file
	$CALL	F%REL			;And don't care about errors

P$TAK3:	MOVX	S1,ERUSE$		;Error code

P$TAK4:	EXCH	S1,CMDIFN		;Get the command file IFN
					;  Saving S1 just in case
	$CALL	F%REL			;Close and release it
					;Don't care about false returns
	MOVE	S1,CMDIFN		;Remember S1 if worth remembering
	SETZM	CMDIFN			;Forget about it
	SETZM	LOGIFN			;Forget about it
	SETZM	TAKFLG			;No takes either
	$RETF				;Tell the user tuff luck
SUBTTL	P$SETU	Setup the parser block pointer address

;THIS ROUTINE WILL TAKE THE ADDRESS AND USE IT FOR THE POINTER TO
;THE PARSER BLOCK
;
;CALL	S1/	PARSER BLOCK ADDRESS
;
;RETURN	TRUE:	ALWAYS

P$SETU:	MOVEM	S1,CURRPB		;SAVE AS THE CURRENT POINTER
	SETZM	PREVPB			;CLEAR PREVIOUS POINTER
	$RETT



SUBTTL	P$CURR	Get the address of the current entry

;THIS ROUTINE WILL RETURN THE ADDRESS OF CURRENT ENTRY TO
;BE PARSED

;RETURN	TRUE:	S1/	ADDRESS OF CURRENT PARSER ADDRESS


P$CURR:	MOVE	S1,CURRPB		;GET THE CURRENT PARSER POINTER
	$RETT				;RETURN TRUE


SUBTTL	P$PREV	Position to previous parser entry

;THIS ROUTINE WILL CHANGE THE PARSER BLOCK TO THE PREVIOUS
;ENTRY THAT WAS PROCESSED.
;IT WILL ONLY GO BACK ONE BLOCK.
;
;RETURN TRUE:	S1/	ADDRESS OF PREVIOUS.. NOW CURRENT
;
;RETURN FALSE:	NO PREVIOUS ENTRY


P$PREV:	SKIPN	S1,PREVPB		;GET THE PREVIOUS POINTER
	$RETF				;RETURN FALSE .. NONE SET
	MOVEM	S1,CURRPB		;SAVE AS THE CURRENT
	$RETT				;RETURN TRUE
SUBTTL	P$NEXT	Bump the pointer to next field

;THIS ROUTINE WILL BUMP TO NEXT DATA FIELD AND RETURN TRUE.
;S1 AND S2 WILL HAVE THE DATA TO RETURN TO THE CALLER

P$NEXT:	MOVE	TF,CURRPB		;GET THE CURRENT PB
	MOVEM	TF,PREVPB		;SAVE AS THE PREVIOUS POINTER
	LOAD	TF,@CURRPB,PF.LEN	;GET THE LENGTH
	ADDM	TF,CURRPB		;ADD TO CURRENT LOCATION
	$RETT				;RETURN TRUE



SUBTTL	P$NFLD	Get header and data for a parser element

;THIS ROUTINE WILL RETURN THE ARGUMENT TYPE FOR THE CURRENT ENTRY
;AND THE ADDRESS OF THE CURRENT ENTRY
;
;RETURNS TRUE:	S1/	ARGUMENT TYPE
;		S2/	ADDRESS OF BLOCK
;
;RETURNS FALSE:		;NO MORE ARGUMENTS .. NOT IMPLEMENTED YET

P$NFLD:	MOVE	S2,CURRPB		;GET THE CURRENT PB
	LOAD	S1,PFD.HD(S2),PF.TYP	;GET THE TYPE FIELD
	PJRST	P$NEXT			;BUMP TO NEXT ONE


P$NARG:	MOVE	S2,CURRPB		;GET THE CURRENT PB
	LOAD	S1,PFD.HD(S2),PF.TYP	;GET THE TYPE FIELD
	$RETT				;RETURN
SUBTTL	P$xBIT	Set 7 or 8 bit byte pointer


; THIS ROUTINE WILL SET THE BYTE POINTER FOR PARSING.
; RETURN TRUE:	S1/PREVIOUS BYTE POINTER
; RETURN FALSE:	NOT IMPLEMENTED YET

P$8BIT::SKIPA	S1,[POINT 8,0]		;8-BIT
P$7BIT::MOVSI	S1,(POINT 7,0)		;7-BIT
	SKIPA				;ENTER COMMON CODE
P$DBIT::MOVX	S1,DEFPTR		;DEFAULT POINTER
P$XBIT::EXCH	S1,USRPTR		;SWAP
	$RETT				;RETURN
SUBTTL	P$CFM	Check for a confirm in next block

;THIS ROUTINE WILL CHECK THE NEXT FIELD FOR A CONFIRM
;RETURN	TRUE:	ON CONFIRM AND UPDATE PB
;
;RETURN FALSE:	S1/CODE FOUND

P$CFM:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMCFM		;WAS IT A CONFIRM
	$RETF				;NO, RETURN FALSE
	PJRST	P$NEXT			;ADVANCE PB AND RETURN
SUBTTL	P$COMMA	Check for a comma in next block

;THIS ROUTINE WILL CHECK THE NEXT FIELD FOR A COMMA
;RETURN	TRUE:	ON COMMA AND UPDATE PB
;
;RETURN FALSE:	S1/CODE FOUND

P$COMMA: $CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMCMA		;WAS IT A COMMA
	$RETF				;NO, RETURN FALSE
	PJRST	P$NEXT			;ADVANCE PB AND RETURN
SUBTTL	P$KEYW	Get a keyword from the parsed data

;THIS ROUTINE WILL TRY TO GET A KEYWORD FROM THE NEXT ELEMENT
;IN THE PARSER DATA BLOCK POINTED TO BY PB
;
;RETURNS TRUE:	S1/	KEYWORD FOUND
;
;RETURNS FALSE:	S1/	DATA TYPE FOUND

P$KEYW:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMKEY		;WAS IT A KEYWORD
	$RETF				;NO RETURN WITH TYPE FOUND
GETVAL:	MOVE	S1,PFD.D1(S2)		;GET THE DATA
	PJRST	P$NEXT			;RETURN AND ADVANCE PB


SUBTTL	P$SWIT	Get a switch from the parsed data

;THIS ROUTINE WILL TRY TO GET A SWITCH FROM THE NEXT ELEMENT
;IN THE PARSER DATA BLOCK POINTED TO BY PB
;
;RETURNS TRUE:	S1/	SWITCH FOUND
;
;RETURNS FALSE:	S1/	DATA TYPE FOUND

P$SWIT:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMSWI		;WAS IT A SWITCH
	$RETF				;NO RETURN WITH TYPE FOUND
	MOVE	S1,PFD.D1(S2)		;GET THE DATA
	PJRST	P$NEXT			;RETURN AND ADVANCE PB


SUBTTL	P$USER	Get the user id field

;THIS ROUTINE WILL RETURN USER NUMBER OR PPN FOR THE
;.CMUSR FUNCTION
;
;RETURNS TRUE:	S1/	USER NUMBER OR PPN
;
;RETURN	FALSE	S1/	DATA TYPE FOUND
;

P$USER:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMUSR		;IS IT USER ID?
	$RETF				;NO, RETURN FALSE
	PJRST	GETVAL			;YES, GET AND RETURN VALUE
SUBTTL	P$FLOT	Get the floating point number

;THIS ROUTINE WILL RETURN A FLOATING POINT NUMBER FOR THE .CMFLT
;FUNCTION

;
;RETURNS TRUE:	S1/	FLOATING POINT NUMBER
;
;RETURN	FALSE	S1/	DATA TYPE FOUND
;

P$FLOT:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMFLT		;IS IT A FLOATING POINT NUMBER?
	$RETF				;NO, RETURN FALSE
	PJRST	GETVAL			;YES, GET AND RETURN VALUE
SUBTTL	P$DIR	Get the directory field

;THIS ROUTINE WILL RETURN DIRECTORY NUMBER OR PPN FOR THE
;.CMDIR FUNCTION
;
;RETURNS TRUE:	S1/	DIRECTORY NUMBER OR PPN
;
;RETURN	FALSE	S1/	DATA TYPE FOUND
;

P$DIR:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMDIR		;IS IT DIRECTORY NUMBER?
	$RETF				;NO, RETURN FALSE
	PJRST	GETVAL			;YES, GET AND RETURN VALUE
SUBTTL	P$TIME	Get the time/date field

;THIS ROUTINE WILL RETURN THE TIME/DATE FROM THE
;.CMTAD FUNCTION
;
;RETURNS TRUE:	S1/	TIME/DATE IN UDT
;
;RETURN	FALSE	S1/	DATA TYPE FOUND
;

P$TIME:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMTAD		;IS IT TIME/DATE?
	$RETF				;NO, RETURN FALSE
	PJRST	GETVAL			;YES, GET AND RETURN VALUE
SUBTTL	P$NUM	Get a number from the parser block

;ON RETURN TRUE:	S1/	NUMBER
;			S2/	RADIX
;
;ON RETURN FALSE:	S1/	DATA TYPE FOUND

P$NUM:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMNUM		;CHECK IF A NUMBER
	CAIN	S1,.CMNUX		; OR TERMINATED BY NON-DIGIT?
	SKIPA				;YES TO EITHER
	$RETF				;LOSER
	DMOVE	S1,PFD.D1(S2)		;S1:= NUMBER, S2:= RADIX
	PJRST	P$NEXT			;ADVANCE TO NEXT FIELD AND RETURN
SUBTTL	P$FILE	Get a filespec from the parser block

;ON RETURN TRUE:	S1/	ADDRESS OF FD
;			S2/	LENGTH OF FD AND HEADER
;
;ON RETURN FALSE:	S1/	DATA TYPE FOUND

P$FILE:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMFIL		;CHECK IF A GENERAL FILE
	$RETF				;NO, RETURN FALSE
	JRST	GETFD			;GET THE FD

P$IFIL:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMIFI		;CHECK IF A INPUT FILE
	$RETF				;NO, RETURN FALSE
	JRST	GETFD			;GET AN FD


P$OFIL:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMOFI		;CHECK IF A OUTPUT FILE
	$RETF				;NO, RETURN FALSE
GETFD:	MOVE	S1,CURRPB		;GET ADDRESS OF THE BLOCK
	LOAD	S2,PFD.HD(S1),PF.LEN	;LENGTH OF THE FD AND HEADER
	PJRST	P$NEXT			;ADVANCE TO NEXT FIELD
SUBTTL	P$FLD	Get a text field from block

;ON RETURN TRUE:	S1/	ADDRESS OF FIELD
;			S1/	LENGTH OF THE BLOCK
;
;ON RETURN FALSE:	S1/	DATA TYPE FOUND



P$FLD:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMFLD		;IS IT A FIELD?
	$RETF				;NO, RETURN FALSE
GETF.1:	MOVE	S1,CURRPB		;ADDRESS OF THE DATA
	LOAD	S2,PFD.HD(S1),PF.LEN	;GET THE LENGTH
	PJRST	P$NEXT			;BUMP TO NEXT FIELD


P$TOK:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMTOK		;IS IT A TOKEN
	$RETF				;NO, RETURN FALSE
	PJRST	GETF.1			;SETUP DATA AND RETURN

SUBTTL	P$NODE	Get a node from block

;ON RETURN TRUE:	S1/	NODE NAME OR NUMBER
;
;ON RETURN FALSE:	S1/	DATA TYPE FOUND


P$NODE:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMNOD		;WAS IT A NODE TYPE
	$RETF				;NO, RETURN FALSE
	MOVE	S1,PFD.D1(S2)		;GET THE DATA
TOPS20	<
	TLNN	S1,770000		;CHECK IF SIXBIT..DATA IN FIRST
					;6 BITS
> ;End TOPS20
	PJRST	P$NEXT			;ADVANCE THE PB PTR AND RETURN
GETN.0:	MOVE	T1,PRSPTR		;BYTE POINTER
	HRRI	T1,PFD.D1(S2)		;GET THE ADDRESS
	MOVE	T2,[POINT 6,T3]		;SAVE IN T3
	SETZM	T3			;CLEAR T3
GETN.1:	ILDB	S1,T1			;GET A BYTE
	JUMPE	S1,GETN.2		;END OF STRING..JUMP
	CAIG	S1,172			;LOWER CASE Z
	CAIGE	S1,141			;LOWER CASE A
	  SKIPA				;NO NEED TO CONVERT
	SUBI	S1,40			;CONVERT TO UPPER CASE
	SUBI	S1,"A"-'A'		;CONVERT TO SIXBIT
	TLNE	T2,770000		;ENOUGH SAVED??
	IDPB	S1,T2			;NO, SAVE IT AWAY
	JRST	GETN.1			;LOOP FOR MORE
GETN.2:	MOVE	S1,T3			;PLACE NODE NAME IN S1
	PJRST	P$NEXT			;ADVANCE THE POINTER



SUBTTL	P$SIXF	Get a sixbit field type

;ON RETURN TRUE:	S1/ SIXBIT FIELD
;
;ON RETURN FALSE:	S1/ DATA TYPE FOUND

P$SIXF:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMFLD		;IS IT A FIELD TYPE
	$RETF				;NO, RETURN FALSE
	PJRST	GETN.0			;PROCESS THE FIELD AND RETURN
SUBTTL	P$RNGE	Get a range back

;ON RETURN TRUE:	S1/ LOW RANGE
;			S2/ HIGH RANGE
;
;ON RETURN FALSE:	S1/ DATA TYPE FOUND

P$RNGE:	$CALL	P$NUM			;GET A NUMBER
	$RETIF				;ERROR..RETURN
	MOVE	T4,S1			;SAVE NUMBER
	$CALL	P$TOK			;TRY FOR A TOKEN
	JUMPF	GETR.1			;ERROR..RETURN
	$CALL	P$NUM			;GET HIGH RANGE
	$RETIF				;ERROR..RETURN
	MOVE	S2,S1			;PLACE NUMBER IN S2 FOR HIGH
	MOVE	S1,T4			;SETUP LOW VALUE
	$RETT				;RETURN TRUE
GETR.1:	MOVEI	S1,0			;0 THE LOW RANGE
	MOVE	S2,T4			;PUT NUMBER AS HIGH RANGE
	$RETT				;RETURN TRUE

SUBTTL	P$TEXT	Get a text address and length

;ON RETURN TRUE:	S1/	ADDRESS OF TEXT BLOCK
;			S2/	NUMBER OF WORDS OF TEXT
;
;ON RETURN FALSE:	S1/	DATA TYPE FOUND

P$TEXT:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMTXT		;IS IT TEXT
	$RETF				;NO, RETURN FALSE
	LOAD	S2,PFD.HD(S2),PF.LEN	;GET THE LENGTH IN S2
	MOVE	S1,CURRPB		;ADDRESS OF THE HEADER
	PJRST	P$NEXT			;BUMP TO THEE NEXT FIELD
SUBTTL	P$DEV	Get a device address and length

;ON RETURN TRUE:	S1/	ADDRESS OF DEVICE BLOCK
;			S2/	NUMBER OF WORDS OF DEVICE BLOCK
;
;ON RETURN FALSE:	S1/	DATA TYPE FOUND

P$DEV:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMDEV		;IS IT TEXT
	$RETF				;NO, RETURN FALSE
	LOAD	S2,PFD.HD(S2),PF.LEN	;GET THE LENGTH IN S2
	MOVE	S1,CURRPB		;ADDRESS OF THE HEADER
	PJRST	P$NEXT			;BUMP TO THEE NEXT FIELD
SUBTTL	P$QSTR	Get a quoted string

;ON RETURN TRUE:	S1/	ADDRESS OF TEXT BLOCK
;			S2/	NUMBER OF WORDS
;
;ON RETURN FALSE:	S1/	DATA TYPE FOUND

P$QSTR:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMQST		;IS IT TEXT
	$RETF				;NO, RETURN FALSE
	LOAD	S2,PFD.HD(S2),PF.LEN	;GET THE LENGTH IN S2
	MOVE	S1,CURRPB		;ADDRESS OF THE HEADER
	PJRST	P$NEXT			;BUMP TO THEE NEXT FIELD
SUBTTL	P$UQSTR	Get an unquoted string

;ON RETURN TRUE:	S1/	ADDRESS OF TEXT BLOCK
;			S2/	NUMBER OF WORDS
;
;ON RETURN FALSE:	S1/	DATA TYPE FOUND

P$UQSTR: $CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMUQS		;IS IT TEXT
	$RETF				;NO, RETURN FALSE
	LOAD	S2,PFD.HD(S2),PF.LEN	;GET THE LENGTH IN S2
	MOVE	S1,CURRPB		;ADDRESS OF THE HEADER
	PJRST	P$NEXT			;BUMP TO THEE NEXT FIELD
SUBTTL	P$ACCT	Get an account string

;ON RETURN TRUE:	S1/	ADDRESS OF TEXT BLOCK
;			S2/	NUMBER OF WORDS
;
;ON RETURN FALSE:	S1/	DATA TYPE FOUND

P$ACCT:	$CALL	P$NARG			;GET THE TYPE ELEMENT
	CAIE	S1,.CMACT		;IS IT TEXT
	$RETF				;NO, RETURN FALSE
	LOAD	S2,PFD.HD(S2),PF.LEN	;GET THE LENGTH IN S2
	MOVE	S1,CURRPB		;ADDRESS OF THE HEADER
	PJRST	P$NEXT			;BUMP TO THEE NEXT FIELD
SUBTTL	P$NPRO	No processing required


;Set No Processing Required in the Parser Flags

P$NPRO:		MOVX	S1,P.NPRO	;NO PROCESSING REQUIRED
	IORM	S1,FLAGS		;SAVE IN FLAGS OF PARSER
	$RETT				;RETURN TRUE
SUBTTL	P$GPDB	Get the PDB address if any data


;THIS ROUTINE WILL GET THE ADDRESS OF THE PDB FOR THE BLOCK
;
;CALL	S1/	ADDRESS OF THE FDB
;
;RETURN TRUE:	S1/ ADDRESS OF THE PDB DATA
;		S2/ LENGTH OF THE PDB
;
;RETURN FALSE:	 NO NEXT PDB



P$GPDB:	SUBI	S1,1			;POINT TO THE HEADER FOR PDB
	SKIPN	(S1)			;PDB O.K.
	STOPCD	(IPP,HALT,,<Invalid PDB Header in Parse Block>)
	LOAD	TF,PB%HDR(S1),PB.FDB	;GET THE LENGTH OF THE FDB
	LOAD	S2,PB%HDR(S1),PB.PDB	;GET THE LENGTH OF THE PDB
	CAMN	S2,TF			;ARE THEY THE SAME
	$RETF				;RETURN FALSE .. NONE SPECIFIED
	ADD	S1,TF			;POSITION TO THE PDB
	SUB	S2,TF			;GET LENGTH OF THE PDB
	$RETT				;RETURN TRUE


SUBTTL	P$PNXT	Get next PDB given a PDB block

;THIS ROUTINE WILL RETURN INFORMATION FROM A PDB

;CALL	S1/	ADDRESS OF THE PDB
;
;RETURN	TRUE:	S1/	ADDRESS OF THE NEXT PDB
;
;RETURN FALSE:	NO NEXT PDB

P$PNXT:	$CALL	P$GPDB			;GET THE PDB DATA
	$RETIF				;ERROR..RETURN
	CAIG	S2,PB%NXT		;IS THERE A NEXT FIELD
	$RETF				;NO, RETURN FALSE
	SKIPE	S1,PB%NXT(S1)		;GET THE VALUE AND RETURN
	$RETT				;YES, O.K.
	$RETF				;RETURN FALSE
SUBTTL	P$XSBC	Sub-command mode routines


; Test for sub-command mode and return table header and prompt
; Call:		No arguments
; TRUE return:	S1/ table header, S2/ Prompt string
; FALSE return:	Not in sub-command mode

P$TSBC::SKIPN	SBCUSR			;IN SUB-COMMAND MODE?
	$RETF				;NO
	MOVE	S1,ARGSAV+PAR.TB	;GET TABLE HEADER
	MOVE	S2,ARGSAV+PAR.PM	;GET PROMPT STRING
	$RETT				;RETURN


; Exit sub-command mode
; Call:		No arguments
; TRUE return:	Sub-command mode terminated
; FALSE return:	Not in sub-command mode

P$XSBC::SKIPN	SBCUSR			;IN SUB-COMMAND MODE?
	$RETF				;NO
	SETZM	SBCUSR			;ZERO
	$RETT				;AND RETURN
SUBTTL	P$PERR	Get error routine given a PDB block

;THIS ROUTINE WILL RETURN INFORMATION FROM A PDB

;CALL	S1/	ADDRESS OF THE PDB
;
;RETURN	TRUE:	S1/	ADDRESS OF THE ERROR ROUTINE
;
;RETURN FALSE:	NO ERROR PDB

P$PERR:	$CALL	P$GPDB			;GET THE PDB DATA
	$RETIF				;ERROR..RETURN
	CAIG	S2,PB%ERR		;IS THERE AN ERROR FIELD
	$RETF				;NO, RETURN FALSE
	SKIPE	S1,PB%ERR(S1)		;GET THE VALUE AND RETURN
	$RETT				;YES, O.K.
	$RETF				;RETURN FALSE
SUBTTL	P$PDEF	Get default filler routine given a PDB block

;THIS ROUTINE WILL RETURN INFORMATION FROM A PDB

;CALL	S1/	ADDRES OF THE PDB
;
;RETURN	TRUE:	S1/	ADDRESS OF THE DEFAULT FILLER ROUTINE
;
;RETURN FALSE:	NO DEFAULT FILLER PDB

P$PDEF:	$CALL	P$GPDB			;GET THE PDB DATA
	$RETIF				;ERROR..RETURN
	CAIG	S2,PB%DEF		;IS THERE A DEFAULT FIELD
	$RETF				;NO, RETURN FALSE
	SKIPE	S1,PB%DEF(S1)		;GET THE VALUE AND RETURN
	$RETT				;YES, O.K.
	$RETF				;RETURN FALSE
SUBTTL	P$PACT	Get action routine given a PDB block

;THIS ROUTINE WILL RETURN INFORMATION FROM A PDB

;CALL	S1/	ADDRESS OF THE PDB
;
;RETURN	TRUE:	S1/	ADDRESS OF THE ACTION ROUTINE
;
;RETURN FALSE:	NO NEXT PDB

P$PACT:	$CALL	P$GPDB			;GET THE PDB DATA
	$RETIF				;ERROR..RETURN
	CAIG	S2,PB%RTN		;IS THERE A ACTION ROUTINE
	$RETF				;NO, RETURN FALSE
	SKIPE	S1,PB%RTN(S1)		;GET THE VALUE AND RETURN
	$RETT				;YES, O.K.
	$RETF				;RETURN FALSE
SUBTTL	P$INTR	Interrupt support code

;THIS ROUTINE WILL DETERMINE IF A BREAKOUT FROM  THE PARSER
;SHOULD BE DONE AND IF SO RESET THE PC

P$INTR:	SKIPE	TAKFLG			;IN A TAKE COMMAND?
	$RETT				;YES, JUST RETURN
	MOVE	S1,@TIMPC		;GET THE PC
	$CALL	S%INTR			;FLAG THE INTERRUPT
	JUMPF	.RETT			;NOT IN COMMAND
	MOVEI	S2,BUFSIZ		;GET COMMAND BUFFER SIZE
	IMUL	S2,PRSCNT		;COMPUTE CHARACTER COUNT
	CAME	S1,S2			;BUFFER EMPTY
	JRST	INTR.2			;CHECK THE TIMER

;COVER A ^U ..DO THE RESET IF AT THE PROMPTS

	MOVEI	S2,BUFSIZ		;GET SIZE OF BUFFER
	IMUL	S2,PRSCNT		;COMPUTE CHARACTER COUNT
	MOVEM	S2,CMDBLK+.CMCNT	;RESET THE COUNT
	SETZM	CMDBLK+.CMINC		;NO, SAVE THE COUNT
	MOVE	S1,PRSPTR		;GET BYTE POINTER BACK
	HRRI	S1,BUFFER		;GET POINTER TO INPUT TEXT BUFFER
	MOVEM	S1,CMDBLK+.CMPTR	;SAVE THE POINTER
TOPS10<	PUSHJ	P,SETTMX>		;CAUSE TRAP OUT OF S%CMND
TOPS20	<
	MOVEI	S1,S%EXIT		;ADDRESS OF RETURN PC
	MOVEM	S1,@TIMPC		;SAVE THE NEW PC
> ;END TOPS20
	$RETT				;RETURN
INTR.2:	SKIPE	TIMCHK			;TIMER TRAPS IN USE?
	$CALL	SETTIM			;SET THE TIMER
	$RETT				;RETURN
SUBTTL	SETTIM	Setup the timer function

;THIS ROUTINE WILL SETUP A TIMER TO WAKEUP THE PARSER
;AFTER N SECONDS TO CHECK THE STATE WHEN A BREAKOUT WAS
;NOT DONE

SETTMO:	MOVE	S1,[PS.TMS+^D250]	;INTERRUPT (ALMOST) IMMEDIATELY
	PUSHJ	P,SETTIM		;SET THE TIMER TRAP
	SETZM	TIMSET			;AVOID RECURSION
	POPJ	P,			;AND RETURN

SETTMX:	SKIPA	S1,[PS.TMS+^D250]	;INTERRUPT (ALMOST) IMMEDIATELY
SETTIM:
TOPS10	<
	MOVEI	S1,^D30			;# SECONDS
	MOVEM	S1,TIMSET		;REMEMBER IN CASE WE HAVE TO CLEAR IT
	PITMR.	S1,			;ENABLE TIMER INTERRUPTS
	  JFCL				;FAILED
>
TOPS20	<
	$CALL	I%NOW			;GET THE CURRENT TIME
	MOVE	S2,S1			;PUT TIME IN S2
	ADDI	S2,^D3*^D30		;REQUEST INTERRUPT IN 30 SECONDS
	MOVEM	S2,TIMSET		;REMEMBER IN CASE WE HAVE TO CLEAR IT
	MOVSI	S1,.FHSLF		;GET THE FORK HANDLE
	HRRI	S1,.TIMDT		;GET TIMER FUNCTION
	HRRZ	T1,TIMDAT		;GET THE TIMER CHANNEL
	TIMER				;DO THE FUNCTION
	ERJMP	.+1			;TRAP ERROR
> ;END TOPS20
	$RETT				;RETURN
SUBTTL	CLRTIM	Clear the timer function

;THIS ROUTINE WILL CLEAR THE TIMER IF PROCESS HAS ALREADY AWOKEN

CLRTIM:	SKIPN	S2,TIMSET		;TIMER INTERRUPT SET?
	$RETT				;NO, JUST RETURN
TOPS10	<
	MOVEI	S1,0			;CLEAR (ACTUALLY 1 TICK)
	PITMR.	S1,			;SET CLOCK REQUEST
	  JFCL				;FAILED
>
TOPS20	<
	MOVSI	S1,.FHSLF		;GET THE FORK HANDLE
	HRRI	S1,.TIMDD		;GET TIMER FUNCTION
	HRRZ	T1,TIMDAT		;GET THE INTERRUPT CHANNEL
	TIMER				;DO THE FUNCTION
	ERJMP	.+1			;TRAP ERROR
> ;END TOPS20
	SETZM	TIMSET			;CLEAR THE TIMER FLAG
	$RETT				;RETURN
SUBTTL	P$TINT	Timer interrupt routine

;THIS ROUTINE IS GIVEN CONTROL ON A TIMER INTERRUPT

P$TINT:	$BGINT	1			;LEVEL NUMBER
TOPS20	<
	SKIPE	TIMSTI			;TIMER STORE CHARACTER
	JRST	TINT.1			;CHECK IT OUT
> ;END TOPS20
	SKIPN	TIMCHK			;TIMER SETUP
	$DEBRK				;NO, JUST EXIT
	SKIPN	TIMSET			;WAS TIMER SET
	$DEBRK				;NO JUST EXIT
	SETZM	TIMSET			;CLEAR TIMER FLAG
	MOVE	S1,@TIMPC		;GET THE PC
	$CALL	S%INTR			;STILL IN COMMAND
	SKIPT				;YES, GET OUT NOW
	$DEBRK				;NO .. RETURN
TOPS10	<
	MOVE	S1,[3,,[EXP .TOTYP,<-1>,<[ASCIZ//]>]]
	TRMOP.	S1,			;FORCE RETYPE OF CURRENT LINE
	  JFCL				;CAN DO NOTHING HERE
	PUSHJ	P,SETTMO		;CAUSE ANOTHER INTERRUPT NOW
> ;END TOPS10
TOPS20	<
	SETOM	TIMSTI			;SETUP TERMINAL WAKEUP
	HRLZI	S1,.TICCB		;SETUP THE CHARACTER
	HRR	S1,TIMDAT		;GET THE CHANNEL
	ATI				;ATTACH IT
	MOVX	S1,RT%DIM		;GET DEFERRED TERMINAL INTERRUPTS
	HRRI	S1,.FHSLF		;FOR MY PROCESS
	RTIW				;READ THE VALUES.. T1 HAS MASK
	MOVX	S1,ST%DIM		;SET DEFERRED WAKEUP CHARACTERS
	HRRI	S1,.FHSLF		;FOR MY PROCESS
	TXO	T1,1B<.CHCNB>		;TURN ON CONTROL B
	STIW				;SET THE MASK
	HLRZ	S1,CMDBLK+.CMIOJ	;GET THE JFN
	MOVEI	S2,.CHCNB		;CTRL/B
	STI				;SET THE CHARACTER
	$DEBRK				;RETURN ..WAIT FOR CHARACTER
TINT.1:	SETZM	TIMSTI			;CLEAR THE FLAG
	MOVEI	S1,.TICCB		;SETUP CONTROL B
	DTI				;DETACH IT
	$CALL	CNTCHR			;GET THE POSITION
> ;END TOPS20
	MOVEI	T1,BUFSIZ		;GET SIZE OF BUFFER
	IMUL	T1,PRSCNT		;COMPUTE CHARACTER COUNT
	MOVEM	T1,CMDBLK+.CMCNT	;RESET THE COUNT
	MOVEM	S1,CMDBLK+.CMINC	;NO, SAVE THE COUNT
	MOVE	S1,PRSPTR		;GET BYTE POINTER BACK
	HRRI	S1,BUFFER		;GET POINTER TO INPUT TEXT BUFFER
	MOVEM	S1,CMDBLK+.CMPTR	;SAVE THE POINTER
	MOVE	S1,@TIMPC		;GET THE PC
	$CALL	S%INTR			;FLAG THE INTERRUPT
	MOVEI	S1,S%EXIT		;GET THE PC
	MOVEM	S1,@TIMPC		;SAVE THE PC
	SETOM	TIMINT			;SETUP INTERRUPT FLAG
	$DEBRK				;DEBRK
SUBTTL	CNTCHR	Count characters in the buffer

;THIS ROUTINE WILL COUNT THE CHARACTERS IN THE COMMAND INPUT
;BUFFER UP TO THE NULL.
;
;RETURN	S1/	COUNT OF CHARACTERS

CNTCHR:	MOVE	S2,PRSPTR		;SETUP BYTE POINTER
	HRRI	S2,BUFFER		;TO THE TEXT
	SETZM	S1			;CLEAR COUNTER
CNTC.1:	ILDB	T1,S2			;GET A BYTE
	JUMPE	T1,.RETT		;NULL?..RETURN
	AOJA	S1,CNTC.1		;NO, GET NEXT ONE
SUBTTL	REPRMT	Do reprompt of command

;THIS ROUTINE WILL DO A REPROMPT BY PLACING A ^R IN THE TERMINALS
;INPUT BUFFER


REPRMT:
TOPS20	<
	$CALL	GETT.2			;REPROMPT THE STRING
	$RETT				;RETURN
> ;End TOPS20

TOPS10	<
	$RETT				;RETURN
> ;End TOPS10
SUBTTL	P$HELP	Routine to display help from file


P$HELP::PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	DMOVE	P1,S1			;SAVE ARGS INCASE OF ERROR
	PUSHJ	P,.HELPF##		;CALL THE LIBRARY HELP PROCESSOR
	$RETIT				;RETURN IF NO ERRORS
	CAIN	S1,ERNHA$		;NO HELP AVAILABLE?
	JRST	HELP.1			;YES
	CAIN	S2,ERFNF$		;FILE NOT FOUND?
	JRST	HELP.2			;YES
	$TEXT	(,<% ^E/S1/>)		;COMPLAIN
	$RETF				;RETURN
HELP.1:	MOVEI	S2,[ITEXT (< for "^T/(P2)/">)]
	SKIPN	P2			;HAVE A SEARCH STRING?
	MOVEI	S2,[ITEXT (<>)]		;NO
	$TEXT	(,<% ^E/S1/^I/(S2)/>)
	$RETF				;RETURN
HELP.2:	$TEXT	(,<% Help file ^F/(P1)/ not found>)
	$RETF				;RETURN
SUBTTL	End


	XLIST				;TURN LISTING OFF
	LIT				;DUMP LITERALS
	LIST				;TURN LISTING ON

	END