Google
 

Trailing-Edge - PDP-10 Archives - BB-Y390S-BM_1990 - lngsrc/oprpar.mac
There are 36 other files named oprpar.mac in the archive. Click here to see a list.
TITLE	OPRPAR	PARSING ROUTINE FOR OPR AND ORION
SUBTTL	Murray Berkowitz/PJT	1-Jan-82


;
;
;        COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982
;                    DIGITAL EQUIPMENT CORPORATION
;
;     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)

	PAREDT==:116

	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	Revision History

COMMENT \
2	OPRPAR	8-Sept-78	Fix INCORE parsing and Add P.ENDT. Also
				Release JFNS in file save routines
3	OPRPAR	12-Sept-78	Add GETTXT AND TXTINP Routines from OPR
4	OPRPAR	15-Sept-78	Have OPRPAR take a pointer for Incore parsing
5	OPRPAR	29-Sept-78	Add P$KEYW ..etc for Analyzing Parsed Blocks
6	OPRPAR	15-Oct-78	Fix PARSER to accept address in PAR.CM
7	OPRPAR	30-Oct-78	Fix .CMDEV Save Routines as well as
				add P$DEV to Get Device Data
				add P$QSTR to get Quoted String
10	OPRPAR	15-Nov-78	Fix GETTXT Routine to put out correct prompt
11	OPRPAR	15-Nov-78	Add Unquoted String and Accounting Routine to
				the Parser.
12	OPRPAR	5-Dec-78	Fix P$NODE on the -10 to accept field as SIXBIT
13	OPRPAR	26-Dec-78	Fix INCORE to accept all Byte Pointers
14	OPRPAR	28-Dec-78	Fix GETTXT bug. Did not put null on end
15	OPRPAR	4-JAN-79	Allow non-dispatch keywords and
				change KEYTAB to ORNKEY
				change SWITAB To ORNSDP
				Add S1 value on action false return to
				PRT.EC of return block
16	OPRPAR	8-JAN-79	SETUP CURPDB FOR CURRENT PDB
17	OPRPAR	24-JAN-79	ADD P$COMMA TO CHECK FOR A COMMA
20	OPRPAR	26-JAN-79	ADD P$TIME TO RETURN UDT FOR TIME/DATE
21	OPRPAR	29-JAN-79	CHANGE BUMPPB TO P$NEXT TO BUMP TO NEXT FIELD
22	OPRPAR	6-FEB-79	ADD P$DIR TO GET DIRECTORY INFO
23	OPRPAR	7-FEB-79	CREATE P$NFLD TO RETURN FIELD HEADER IN S1,
				ADDRESS OF BLOCK IN S2, AND PB TO NEXT FIELD
24	OPRPAR	9-Feb-79	Correct byte Pointers for SAVTOK and SETPMT.
				Check temp table size when moving data
25	OPRPAR	23-Feb-79	Add Timer and Interrupt support into OPRPAR
				and define P$INIT,P$INTR, AND P$TINT
26	OPRPAR	5-Mar-79	Add P$STAK to setup JFN for TAKE Command for
				Take Commands not using TAKFDB
27	OPRPAR	7-MAR-79	Correct memory bug with ERRSAV
30	OPRPAR	13-MAR-79	Fix Timer Bug
31	OPRPAR	16-MAR-79	Add new ERRPDB support, Call ERROR and DEFAULT
				Filling with CMDRET block and move DEFAULT
				Filling before call to S%CMND
32	OPRPAR	20-Mar-79	Remove ac M from OPRPAR and Create PARDAT to
				Hold address of the page
33	OPRPAR	11-Apr-79	Clear the Timer if set in CLRTIM using TIMSET
				as the flag instead of TIMINT
34	OPRPAR	13-Apr-79	Add P$FLOT for Floating Point data
35	OPRPAR	19-Apr-79	Fix Save for Unquoted String to check if null
				Input
36	OPRPAR	26-Apr-79	Clear all Take Flags on Take error
37	OPRPAR	26-Apr-79	Clear Reparse flag at VALC.4, used
				wrong AC
40	OPRPAR	6-May-79	use F%REL to close Take file on the -20
				Reset the buffer pointers in CMDBLK
				ON A SUCCESSFUL PARSE.
41	OPRPAR	15-May-79	Reset .CMCNT on good command
42	OPRPAR	25-May-79	Have the ERROR routines continue on if return
				true assuming that the caller has updated the
				PDB of where to go next
43	OPRPAR	30-May-79	Add a WAIT command that will sleep for a
				period of time and/or an interrupt
44	OPRPAR	12-Jun-79	Add P$SETU, P$CURR and P$PREV and eliminate
				PB from being used
45	OPRPAR	14-Jun-79	Change the default for Take files to be DSK:
				instead of SYS:
46	OPRPAR	21-Jun-79	Strip sequence numbers on TAKE files and
				add PRT.CF to the return block for the command
				Flag word incase user wishes to see the COMND
				Block
47	OPRPAR	24-Jun-79	Add support for new PDB macros which only expand
				what is needed
50	OPRPAR	29-Jun-79	Add another word to the calling block for the
				ACTION routines which contains the address of
				the saved data. The ERROR and PREFILL routines
				will also have this value but will contain the
				address of the last saved argument or zero
51	OPRPAR	2-Jul-79	Allow line sequence numbers for take files on
				the -20 and breakout file open and close for
				take files as separate routines
52	OPRPAR	13-Jul-79	Fix Reparse Bug

53	OPRPAR	24-Jul-79	Fix -10 Take Bug.. forgot a $RETT

54	OPRPAR	18-Sept-79	Support a RESCAN on an incore parse if the
				incore flag is -1.
55	OPRPAR	19-Sept-79	Change WAITRN on the -10 to use SLEEP UUO
56	OPRPAR	20-Sept-79	Add support for P.CEOF EOF on INCORE parse.
57	OPRPAR	13-Oct-79	Add P$HELP routine
60	OPRPAR	24-Oct-79	Add reparse flag for parser for interrupt
61	OPRPAR	27-Oct-79	Fix GETTXT to work with usersupplied block
				entry.	Change CLRTIM and SETTIM to use
				absolute times instead of clearing all
				outstanding interrupts.
62	OPRPAR	28-Oct-79	Add P$TAKE to setup for take command
63	OPRPAR	3-Nov-79	Fix a bug in P$STAK
64	OPRPAR	21-Nov-79	Always return buffer address on return
				from parser.
65	OPRPAR	29-Nov-79	Fix a bug in P$HELP
66	OPRPAR	10-Jan-80	Change Rescan routine on TOPS10 to
				preserve any typeahead and replace
				standard TOPS10 break characters with
				a <CRLF>
67	OPRPAR	14-May-80	Merge edits 63-65 which where made
				in TOPS20 sources
70	OPRPAR	5-Nov-80	Correct spelling of 'during'
71	OPRPAR	15-Dec-80	Zero out display flag in TAKE command if failed
				to open file.  This is alright since we do not
				allow nested takes.
72	OPRPAR	23-Dec-80	TWOSEG OPRPAR so that MOUNT can load it into the
				high segment with the library.
73	6/15/81  Add a cleanup section to P$TAKE so any failure causes all
	to be cleaned up and released.
	Initialize CMDRET correctly in PARINI
74	9/23/81  @STBD.2 save the suppress def. help mess. flag in the
	correct word (TEMFDB+1+.CMFNP).
75	10/26/81 Allow ERREXT to output atom buffer that failed to parse.
76	11/18/81  Fix the help processing.  Allow spaces and tabs at the
	end of a help specification.  Only display the exact field specified.
77	2/26/82  Fix the problem with entered line disappearing when
	interrupted for output.
100	6/3/82 Insert fix from PCO OPR-006. OPR and ORION crashes after
	an OPR SEND with a long text string. GCO 4.2.1359
101	6/24/82  Clear TIMINT in one and only one place, in the literal
	after the SKIPE TIMINT in PARS.2.  GCO 4.2.1396
116	5/19/86 Change the way P$INTR determines if the operator is typing
	a command upon an IPCF interrupt. This will prevent commands'
	responses from being occasionally delayed.
\
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

	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	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
$DATA	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

	RELOC
SUBTTL	P$INIT	Initialize and set timer (TOPS20 only)

;THIS ROUTINE WILL SETUP FOR TIMER INTERRUPTS IF POSSIBLE(20 ONLY)
;AND INIT THE PARSER

;CALL	S1/	LEVEL,, TIMER CHANNEL OR OFFSET
;	S2/	BASE OF INTERRUPT SYSTEM OR <LEVTAB,,CHNTAB>

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
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
	SETOM	TIMCHK			;SET TIME CHECK IN EFFECT
	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
TOPS10	<
	MOVE	S1,TIMDAT+1		;ADDRESS OF VECTOR
	ADDI	S1,.PSVOP		;PC ADDRESS WORD
	MOVEM	S1,TIMPC		;SAVE ADDRES WORD
> ;End TOPS10
	$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:	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
	HRROI	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*NCHPW		;GET # OF CHARACTERS IN BUFFER AREA
	MOVEM	S1,CMDBLK+.CMCNT	;SAVE INITIAL # OF FREE CHARACTER POSITIONS
	HRROI	S1,ATMBFR		;GET POINTER TO ATOM BUFFER
	MOVEM	S1,CMDBLK+.CMABP	;SAVE POINTER TO LAST ATOM INPUT
	MOVEI	S1,ATMSIZ*NCHPW		;GET # OF CHARACTERS IN ATOM 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
	PJRST	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:	$CALL	FILDEF			;FILL IN ANY DEFAULTS IF NEEDED
	   JUMPF	ERREXT		;ERROR..RETURN
	SKIPE	DFLAGS			;ANY ENTRY TO DELETE
	$CALL	STBDEL			;DELETE  THE ENTRY
	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	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
	$STOP(IFC,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
	HRLI	T1,(POINT 7,0)		;SOURCE BYTE POINTER
	HRRI	T1,BUFFER		;SOURCE TEXT OF COMMAND
	HRRZ	T2,ARGFRE		;DESTINATION POINTER
	AOS	T2			;LEAVE ROOM FOR HEADER
	HRLI	T2,(POINT 7,0)		;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
	HRROI	S1,BUFFER		;RESET COMMAND POINTER TO STRING
	MOVEM	S1,CMDBLK+.CMPTR	;SAVE POINTER TO COMMAND STRING
	MOVEI	S1,BUFSIZ*NCHPW		;GET # OF CHARACTERS IN BUFFER AREA
	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
	$TEXT	(ERRRTN,<^T/@ERRSTG/: "^T/ATMBFR/"^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
	HRLI	T2,(POINT 7,0)		;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
	$CALL	MAKPTR			;MAKE THE POINTER FROM S1 AND PUT IN S2
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
	HRROI	S1,BUFFER		;GET BUFFER POINTER
	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
	HRROI	S1,BUFFER		;GET POINTER TO INPUT TEXT BUFFER
	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:	$CALL	MAKPTR			;MAKE A POINTER FROM S1 AND RETURN IN S2
	MOVEM	S2,CMDBLK+.CMRTY	;SAVE THE PROMPT FOR COMMAND
	MOVEM	S2,CURPMT		;SAVE THE CURRENT PROMPT
	SETZ	T1,			;CLEAR S2
SETP.1:	ILDB	S1,S2			;GET A BYTE
	SKIPE	S1			;WAS IT NULL?
	AOJA	T1,SETP.1		;NO, COUNT IT
	MOVEM	T1,PRMTSZ		;SAVE PROMPT SIZE
	$RETT				;RETURN TRUE


;THIS ROUTINE WILL MAKE A BYTE POINTER FROM ARGUMENT IN S1
;AND RETURN POINTER IN S2

MAKPTR:	HLLZ	S2,S1			;GET THE LEFT HALF AND CHECK FOR POINTER
	TLCE	S2,-1			;LEFT HALF = 0
	TLCN	S2,-1			; OR -1
	  HRLI	S2,(POINT 7,0)		;YES, SETUP A BYTE POINTER
	HRR	S2,S1			;GET THE REST OF THE DATA
	$RET				;RETURN
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)
	SAVRES				;USER NAME (.CMUSR)
	SAVZER				;COMMA (.CMCMA)
	SAVINI				;INITIALIZATION (.CMINI)
					;THIS IS CALLED TO INITIALIZE SAVE STUFF
	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	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
	HRLI	T2,(POINT 7,0)		;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
	HRLI	T2,(POINT 7,0)		;MAKE INTO A BYTE POINTER
	HRLZI	T1,(POINT 7,0)		;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
	   $STOP(DDC,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	T1,CR.PDB(S2),RHMASK	;PDB USED BY COMMAND
	LOAD	S1,.CMDAT(T1)		;DATA USED BY COMND
	MOVE	T1,S2			;SAVE S2
	$CALL	MAKPTR			;MAKE A POINTER..RETURNED IN S2
	EXCH	T1,S2			;POINTER IN T1 AND BLOCK ADDRESS IN S2
	MOVE	T2,ARGFRE		;GET DESTINATION POINTER
	ADDI	T2,1			;BUMP BY 1 PASSED HEADER
	HRLI	T2,(POINT 7,0)		;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:	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
	$RET				;AND 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
	$STOP(STS,<SHARED SWITCH TABLE SIZE OF ^D/[TEMTSZ]/ TOO SMALL FOR TABLE OF SIZE ^D/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
	$STOP	(TDE,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
	HRLI	T1,(POINT 7,0)		;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
	IMULI	T2,NCHPW		;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*NCHPW-2	;SIZE OF BUFFER
	SUB	S1,CMDBLK+.CMCNT	;GET CHARACTERS IN BUFFER
	MOVEM	S1,CMDBLK+.CMINC	;SAVE IN COMMAND BLOCK
	HRROI	S1,BUFFER		;POINTER TO THE BUFFER
	MOVEM	S1,CMDBLK+.CMBFP	;RESET START OF TEXT BUFFER
	MOVEM	S1,CMDBLK+.CMPTR	;SAVE THE TEXT POINTER
	MOVEI	S1,BUFSIZ*NCHPW		;SIZE OF THE BUFFER
	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	TAKFDB	TAKE command tables

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

TAK001:	$FILE(TAK002,<input filespec>,<$PREFILL(TAKDEF),$ACTION(TAKRTN),$ERROR(BADIFI)>)
TAK002:	$SWITCH(,TAK003,<$ALTER(TAK004)>)

TAK003:	$STAB
	ORNSDP	(TAK004,<DISPLAY>,DSP)
	ORNSDP	(TAK004,<NODISPLAY>,NDP)
	$ETAB

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


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:	SKIPN	TAKFLG			;PROCESSING A TAKE COMMAND
	$RET				;NO, JUST RETURN
	MOVEI	S1,0			;CLEAR FLAG AC
	MOVEI	S2,[ASCIZ/TAKE command is illegal in a command file/]
	$RETF				;FALSE RETURN TO ABORT COMMAND


TAKE:	SETOM	TAKFLG			;SET FLAG FOR PROCESSING TAKE
	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
	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$FILE			;IS IT A FILE SPEC
	JUMPF	TAKE.2			;NO, ERROR
	MOVE	T2,S1			;ADDRESS OF THE BLOCK
	$CALL	P$CFM			;CHECK FOR CONFIRM
	JUMPT	TAK.1			;YES, DON'T CHECK SWITCHES
	$CALL	TAKDSP			;CHECK TAKE DISPLAY SWITCHES
	$RETIF				;FALSE..PASS ERRORS UP
	$CALL	P$CFM			;CHECK FOR A CONFIRM
	JUMPF	TAKE.1			;ERROR...RETURN
TAK.1:	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

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:	MOVEI	S2,[ASCIZ/Can't open TAKE command file/]
	JRST	TAKERR			;TAKE ERROR EXIT
TAKE.4:	MOVEI	S2,[ASCIZ/Invalid argument in TAKE command/]
	JRST	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
WAITSL: SKIPG	S1			;IF A NEGATIVE NUMBER,
	MOVEI	S1,1			;SLEEP FOR A SECOND
	CAILE	S1,^D60			;IF MORE THAN A MINUTE
	MOVEI	S1,^D60			;SLEEP FOR A MINUTE

TOPS10 <
	SLEEP	S1,			;SLEEP
	   JFCL				;IGNORE ERRORS
	$RETT				;RETURN AFTER SLEEPING
> ;End TOPS10 CONDITIONAL

TOPS20 <
	IMULI	S1,^D1000		;CONVERT SECONDS TO MILLISECONDS
	DISMS				;ELSE SLEEP FOR SPECIFIED SECONDS
	 JFCL				;USE A LOCATION
	$RETT				;RETURN TO CALLER
> ;End TOPS20 CONDITIONAL
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$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:	HRLI	T1,(POINT 7,)		;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.
	$STOP(IPP,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$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
TOPS20	<
;**;[116]Replace 7 lines with 7 lines at P$INTR:+6L  JCR  5/19/86
	MOVEI	S1,.PRIIN		;[116]Pick up the source designator
	SIBE%				;[116]Check the input buffer
	JRST INTR.2			;[116]Not empty, set timer
	MOVE S1,CMDBLK+.CMPTR		;[116]Get pointer to the next field
	CAMN S1,CMDBLK+.CMBFP		;[116]Check with start of buffer
	SKIPE CMDBLK+.CMINC		;[116]Any more characters to parse?
	JRST INTR.2			;[116]Yes, set the timer

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

	MOVEI	T1,NCHPW*BUFSIZ		;GET SIZE OF BUFFER
	MOVEM	T1,CMDBLK+.CMCNT	;RESET THE COUNT
	SETZM	S1,CMDBLK+.CMINC	;NO, SAVE THE COUNT
	HRROI	S1,BUFFER		;POINTER TO NEXT FIELD
	MOVEM	S1,CMDBLK+.CMPTR	;SAVE THE POINTER
> ;End TOPS20
TOPS10	<
INTR.1:	MOVEI	S2,BUFSIZ*NCHPW		;GET COMMAND BUFFER SIZE
	CAME	S1,S2			;BUFFER EMPTY
	JRST	INTR.2			;CHECK THE TIMER
> ;End TOPS10
	MOVEI	S1,S%EXIT		;ADDRESS OF RETURN PC
	MOVEM	S1,@TIMPC		;SAVE THE NEW PC
	$RETT				;RETURN
INTR.2:	SKIPN	TIMCHK			;TIMER TRAPS IN USE
	$RETT				;NO, JUST RETURN
	$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

SETTIM:

TOPS20	<
	$CALL	I%NOW			;GET THE CURRENT TIME
	MOVE	S2,S1			;PUT TIME IN S2
	ADDI	S2,^D3*^D60		;REQUEST INTERRUPT IN 60 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	SETT.1			;TRAP ERROR
	$RETT				;RETURN
SETT.1:	$TEXT(,<
?Timer Setup Failed for ^E/s1/>)
	$RETT				;RETURN
> ;End TOPS20
TOPS10	<
	$RETT
> ;End TOPS10
SUBTTL	CLRTIM	Clear the timer function

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

CLRTIM:

TOPS20	<
	SKIPN	S2,TIMSET		;TIMER INTERRUPT SET?
	$RETT				;NO, JUST RETURN
	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
	SETZM	TIMSET			;CLEAR THE TIMER FLAG
	$RETT				;RETURN
> ;End TOPS20
TOPS10	<
	$RETT
> ;End TOPS10
SUBTTL	P$TINT	Timer interrupt routine

;THIS ROUTINE IS GIVEN CONTROL ON A TIMER INTERRUPT

TOPS20	<
P$TINT:	$BGINT	1			;LEVEL NUMBER
	SKIPE	TIMSTI			;TIMER STORE CHARACTER
	JRST	TINT.1			;CHECK IT OUT
	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
	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
	MOVEI	T1,NCHPW*BUFSIZ		;GET SIZE OF BUFFER
	MOVEM	T1,CMDBLK+.CMCNT	;RESET THE COUNT
	MOVEM	S1,CMDBLK+.CMINC	;NO, SAVE THE COUNT
	HRROI	S1,BUFFER		;POINTER TO NEXT FIELD
	MOVEM	S1,CMDBLK+.CMPTR	;SAVE THE POINTER
TINT.2:	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
> ;End TOPS20

TOPS10	<
P$TINT:	$BGINT	1			;LEVEL NUMBER
	$DEBRK				;NO, JUST EXIT
> ;End TOPS10
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:	HRLI	S2,(POINT 7,)		;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

;Local storage for P$HELP

	STRLEN==^D80/5			;Max length of a string
	TXTLEN==^D80/5			;Length of text buffer
	BYTCLC==TXTLEN*5-1		;MAXIMUM BYTES FOR TEXT LESS
					; ONE FOR THE NULL

DEFINE	$TDATA(NAME,SIZE) <
	..TRR==10			;;REMEMBER RADIX
	RADIX	8
	..NV==1				;;INIT THE FRAME COUNT
	.TRV1<NAME,SIZE>		;;ALLOCATE FIRST ARG

	DEFINE $TDATA(NAM,SIZ) <
		.TRV1<NAM,SIZ>>> 	;;REDEFINE $TDATA CALLS


DEFINE	$TRVAR <
	IFDEF ..NV,<
	PUSHJ	P,.TRSET		;;Call the allocator
	XWD	..NV,..NV		;;Set length argument
	PURGE	..TRR,..NV>>		;;Purge the symbols


 $TDATA	HLPIFN,1			;STORAGE FOR HELP FILE IFN
 $TDATA	HLPFOB,FOB.MZ			;RESERVE AREA FOR FOB
 $TDATA	HLPCNT,1			;NUMBER OF STRINGS FOUND
 $TDATA	SRCSTR,STRLEN			;CURRENT SEARCH DATA
 $TDATA HLPSTR,STRLEN			;HELP STRING
 $TDATA	SCHARG,1			;SEARCH ARGUMENT
 $TDATA	BYTECT,1			;NUMBER OF BYTES REMAINING
 $TDATA	BYTEBP,1			;POINTER TO LAST BYTE STORED
 $TDATA	HLPTXT,TXTLEN			;START OF TEXT

;Flag definitions for P$HELP  (T4 is flag AC)

	FL.DSP==1B0			;Display this line
	FL.DSS==1B1			;Display scratch flag
	FL.EOF==1B2			;End of file seen
	FL.CRL==1B3			;We just saw CRLF
	FL.WLD==1B4			;We saw an "*" for this field
	FL.NUL==1B5			;We were called with a null string
	FL.QUA==1B6			;We saw a "/" for this field
;P$HELP  is  a subroutine to search for specified help text entry
;        in the system help file and  output  it  to  the  user's
;        terminal. (Via the default text output routine the user
;	 specified in their library initialization)

;Call:			S1/	Address of Help file FD
;			S2/	Pointer to search string


;True return:		No returned arguments
;			Help text has been displayed

;False return:		Error message has been displayed

;The possible error conditions that may be returned are:

;		1) No Help file available
;		2) Specified keyword not found
;		3) IO error reading Help file

	ENTRY	P$HELP

P$HELP:	$SAVE	<T1,T2,T3,T4,P1>
	$TRVAR				;ALLOCATE LOCAL STORAGE
	SETZM	BYTECT			;CLEAR REMAINING BYTE COUNT
	SETZM	HLPTXT			;CLEAR FIRST WORD OF TEXT
	MOVEM	S1,FOB.FD+HLPFOB	;SAVE ADDRESS OF FD
	TLCE	S2,777777		;Make real pointer
	TLCN	S2,777777
	 HRLI	S2,(POINT 7)
	MOVEM	S2,SCHARG		;SAVE STRING POINTER
	MOVX	S1,FLD(7,FB.BSZ)+FLD(1,FB.LSN)
	MOVEM	S1,FOB.CW+HLPFOB	;SETUP BYTESIZE
	MOVEI	S1,FOB.MZ		;SETUP FOR OPEN
	MOVEI	S2,HLPFOB
	$CALL	F%IOPN			;OPEN THE HELP FILE
	JUMPF	[MOVEI	S2,HLPFNF	;POINT TO ERROR TEXT
		 SETOM	HLPIFN		;SET FILE NOT OPEN FLAG
		JRST	HELPRT]
	MOVEM	S1,HLPIFN		;SAVE THE IFN
	SETOM	S2			;GET ACTUAL FILE NAME
	$CALL	F%FD
	MOVEM	S1,FOB.FD+HLPFOB	;SAVE IN CASE OF ERROR
	MOVE	S1,SCHARG		;GET POINTER TO DESIRED HELP
	MOVE	S2,[POINT 7,HLPSTR]	;STORE IN A SAFE PLACE
	SETZ	P1,			;Say we have no pointer yet
HELP.1:	ILDB	T1,S1			;Get a character
	CAIE	T1," "			;Have a space?
	CAIN	T1,11			;Or a tab?
	JRST	[SKIPN	P1		;Yes, have one previously?
		MOVE	P1,S2		;No, save current location
		JRST	HELP.2]		;Go save it
	CAIG	T1," "			;Good character?
	JRST	HELP.3			;No, go finish
	SETZ	P1,			;Real character, say no pointer

;  Save current character

HELP.2:	IDPB	T1,S2			;Save it
	JRST	HELP.1			;Go for more

HELP.3:	SKIPE	P1			;Any adjustment?
	MOVE	S2,P1			;Yes, get real pointer
	SETZ	T1,			;TERMINATE STRING WITH A NULL
	IDPB	T1,S2
	$CALL	GETHLP			;CALL MAIN WORKING CODE
					;AS A SUBROUTINE.
	SKIPF				;ANYTHING FAIL?
	SETZ	S2,0			;NO, SO CLEAR ERROR MESSAGE
HELPRT:	SETZ	S1,0			;ALWAYS RETURN ERROR BLOCK
					;ADDRESS REGISTER
	DMOVE	T1,S1			;RELOCATE ERROR ARGUMENTS
	SKIPE	S2			;ALL OK?
	$TEXT	(,^I/0(S2)/)		;NO, DISPLAY ERROR
	SKIPL	S1,HLPIFN 		;GET THE IFN IF ANY
	$CALL	F%REL			;RELEASE THE FILE
	SKIPN	S2,T2			;STATUS
	$RETT
	$RETF

HLPFNF:	ITEXT<%Help file "^F/@FOB.FD+HLPFOB/" not found>
;GETHLP is herein defined as a subroutine only for the purpose of
;       clarifying  the  code.  The  subroutine  does  all of the
;       "work" involved  in  searching  the  data  file  for  the
;       specified ASCII string and displaying it on the terminal.

;Call:		No calling arguments. T3 contains address of
;		dynamic page

;True return:	No arguments returned

;False return:	S2 contains address of error message

GETHLP:	SETZM	HLPCNT			;COUNT NUMBER OF ENTRIES
	SETZM	T4			;CLEAR THE FLAGS
	MOVE	S1,SCHARG		;Get calling pointer
	ILDB	S2,S1			;Get the first byte
	CAIN	S2,.CHNUL		;Null string?
	TXO	T4,FL.DSP!FL.NUL	;YES, display and remember
	CAIN	S2,"/"			;Qualifier?
	JRST	[TXO T4,FL.QUA		;YES, remember it
		 ILDB	S2,S1		;Get the next byte
		 JRST	.+1]
	CAIN	S2,"*"			;Wild card?
	TXO	T4,FL.WLD		;YES, match all
HELP.A:	TXNE	T4,FL.EOF		;End of file?
	JRST	HELP.C			;YES, return
	$CALL	GETBYT			;Get a byte from help file
	 JUMPF	HELP.C			;Assume EOF
	CAIE	S2,"*"			;Want to check display?
	JRST	HELP.B			;No, skip this
	SKIPE	HLPCNT			;Yes, but displayed any entry yet?
	 JRST	[TXNE	T4,FL.WLD	;Yes, but are we displaying all?
		JRST	.+1		;Yes, continue displaying
		JRST	HELP.C]		;No, terminate searching
	$CALL	HLPCHK			;No display yet or all, go and check
	JRST	HELP.A
HELP.B:	CAIN	S2,"!"			;Is this a comment?
	 JRST	[$CALL	HLPCOM		;Yes
		 JRST	HELP.A]
	CAIN	S2,"@"			;Indirecting?
	 JRST	[$CALL	HLPIND		;Yes
		 JRST	HELP.A]
	CAIN	S2,"/"			;Qualifier?
	 JRST	[$CALL	HLPQUA		;Yes
		 JRST	HELP.A]
	TXNE	T4,FL.DSP		;Are we displaying?
	AOS	HLPCNT			;YES, remember it
	$CALL	HLPEOL			;Process this line
	JRST	HELP.A			;Do the next line
HELP.C:	SKIPE	HLPCNT			;ANY HELP FOUND?
	JRST	HELP.D			;YES, FORCE OUT LAST LINE
	MOVEI	S2,HLPNHA		;NO, RETURN AN ERROR
	$RETF

HELP.D:	MOVEI	S2,.CHNUL		;Get a null
	$CALL	PUTBYT
	$TEXT	(,^T/HLPTXT/^A)		;Force out the buffer
	$RETT

HLPNHA:	ITEXT<%No help available for "^Q/SCHARG/">
;Routine to process a help file line
HLPQUA:	PJRST	HLPEOL			;Process this line

HLPCOM:	TXZE	T4,FL.DSP+FL.DSS	;Clear and check display flag
	 TXO	T4,FL.DSS		;Remember it was set
HLPLIN:	$CALL	GETBYT			;Read a byte from file
	 JUMPF	HLPEOF			;Check for error or EOF
HLPEOL:	TXNE	T4,FL.DSP		;Want to display?
	$CALL	PUTBYT			;Yes
	CAIE	S2,.CHCRT		;Was it a Carriage return?
	JRST	HLPLIN			;NO, loop until we find one
	$CALL	GETBYT			;Read another byte
	 JUMPF	HLPEOF			;Check for error or EOF
	TXNE	T4,FL.DSP		;Want to display?
	$CALL	PUTBYT			;Yes
	CAIE	S2,.CHLFD		;Was it a line feed?
	JRST	HLPLIN			;NO, loop until we find CRLF
	TXZE	T4,FL.DSS		;Need to restore display flag?
	 TXO	T4,FL.DSP		;YES, set it again
	TXO	T4,FL.CRL		;Say we just say CRLF
	$RETT				;Return


HLPIND:	$CALL	HLPCOM			;Treat indirect as a comment
	$RETT




HLPEOF:	TXO	T4,FL.EOF		;Set end of file
	CAIN	S1,EREOF$		;Really end of file?
	$RETF				;YES, just return
HLPERR:	MOVEI	S2,HLPERF		;NO, error reading file
	$RETF

HLPERF:	ITEXT<?Error reading help file "^F/@FOB.FD+HLPFOB/">
;HLPCHK	is called when an "*" is seen in column 1 of the help file
;	It checks to see if the remaining keyword text should
;	be displayed.

HLPCHK:	TXNE	T4,FL.WLD		;Wild field?
	 JRST	[TXO	T4,FL.DSP	;Yes
		 $RETT]
	MOVE	T1,[POINT 7,SRCSTR]	;Point to storage
	TXZ	T4,FL.DSP		;Clear display flag
HLPC.A:	$CALL	GETBYT			;Get a byte from help file
	 JUMPF	HLPEOF			;Check for error or EOF
	IDPB	S2,T1			;Store the byte
	CAIE	S2,.CHCRT		;Was it a carriage return?
	JRST	HLPC.A			;NO, get the next byte
	MOVEI	S2,.CHNUL		;YES, replace it with a null
	DPB	S2,T1
	$CALL	GETBYT			;Insist on CRLF
	 JUMPF	HLPEOF			;Check for error or EOF
	CAIE	S2,.CHLFD
	$RETF				;Oops..the help file is bad
HLPC.B:	HRROI	S1,HLPSTR		;Point to desired string
	HRROI	S2,SRCSTR		;Point to help string
	$CALL	S%SCMP			;See if they match
	SKIPE	S1			;Do they match?
	TXNE	S1,SC%SUB		; or almost match?
	TXO	T4,FL.DSP		;YES, display subsequent help
	TXNE	S1,SC%LSS		;Looked at enough?
	TXO	T4,FL.EOF		;YES, End the search
	$RETT
;Subroutine to get a byte from the help file.

;Call:		T4/ FL.DSP if byte is to be displayed

;Return: TRUE	S2/ Byte from file
;	 FALSE	S1/ Error code (Most likely end of file)

GETBYT:	MOVE	S1,HLPIFN		;Point to the file
	$CALL	F%IBYT			;Get the byte
	CAIE	S2,.CHLFD		;Line feed or Form feed?
	CAIN	S2,.CHFFD
	$RET				;YES, just return
	TXZ	T4,FL.CRL		;NO, clear CRLF seen
	$RET

;Subroutine  to output data to our preallocated page. If overflow
;        occurs the page is immediately output, the pointers  are
;        reset, and the page is reused.

;Call:		S2 contains ASCII byte

;Return:	Always to .+1

PUTBYT:	SOSGE	BYTECT			;ANY ROOM LEFT?
	JRST	PUTOUT			;NOPE
	IDPB	S2,BYTEBP		;YUP, PLANT THE CHARACTER
	$RET

PUTOUT:	PUSH	P,S1			;SAVE THE CHARACTER REGISTER
	PUSH	P,S2
	$TEXT	(,^T/HLPTXT/^A) 	;TYPE THE DATA
	MOVEI	S1,BYTCLC		;RESET THE COUNT
	MOVEM	S1,BYTECT		;..
	MOVE	S2,[POINT 7,HLPTXT]	;AND THE BP
	MOVEM	S2,BYTEBP
	POP	P,S2
	POP	P,S1
	JRST	PUTBYT
SUBTTL	End


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

	END