Google
 

Trailing-Edge - PDP-10 Archives - 704rmsf2 - 10,7/rms10/rmssrc/cpatop.mac
There are 7 other files named cpatop.mac in the archive. Click here to see a list.
TITLE	CPATOP	COMND style parsing for TOPS-10 and TOPS-20
SUBTTL	Murray Berkowitz/PJT	Oct 13, 1979


;
;
;                COPYRIGHT (c) 1975,1976,1977,1978,1979
;                    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	CPASYM,CMDPAR
	PROLOG	(CPATOP)

	RELOC
SUBTTL	Table of Contents

;               TABLE OF CONTENTS FOR OPRPAR
;
;
;                        SECTION                                   PAGE
;    1. Table of Contents.........................................   2
;    2. PARSER ENTRY POINTS.......................................   3
;    3. PARSER DATA BASE AND CONSTANTS............................   4
;    4. P$INIT  PARSER INIT ROUTINE...............................   5
;    6. PARSE$  PARSER ENTRY POINT................................   7
;    7. PARCMD  PARSE THE COMMAND.................................   8
;    8. VALCMD  VALID COMMAND PARSE ROUTINE.......................   9
;    9. PARRET  PARSER CODE TO RETURN TO CALLER...................  10
;   10. PARERR  COMND JSYS  ERROR ROUTINE.........................  11
;   11. CHKEOF  CHECK END OF TAKE FILE............................  12
;   12. CLSTAK  CLOSE THE TAKE FILE...............................  13
;   13. TAKCLR  CLEANUP AFTER TAKE FILE...........................  13
;   14. ERREXT  ERROR RETURN FROM PARSER..........................  14
;   15. INCORE  CHECK AND SETUP FOR INCORE PROCESSING.............  15
;   16. CMDMES  CHECK AND/OR SETUP THE COMMAND MESSAGE............  16
;   17. SETPMT  SETUP THE PROMPT POINTER..........................  17
;   18. RESCN	 Rescan routine to setup initial command.........  18
;   19. Dispatch for Parser Save Routines.........................  19
;   20. SAVE ROUTINES FOR COMND...................................  20
;   21. SAVE ROUTINE FOR FILE SPECS...............................  21
;   22. SAVE ROUTINE TO COPY VALUES FROM ATOM BUFFER..............  22
;   23. SAVE ROUTINE FOR COMMA, CONFRM..FUNCTION ONLY.............  22
;   24. SAVE ROUTINE FOR NUMBERS..................................  22
;   25. SAVUQS 	SAVE ROUTINE FOR UNQUOTED STRING...............  23
;   26. SAVE ROUTINE FOR SINGLE VALUE FUNCTIONS...................  24
;   27. SAVDEV 	SAVE ROUTINE FOR A DEVICE......................  25
;   28. SAVE ROUTINE TO SAVE A TOKEN..............................  26
;   29. SAVE NODE SPECIFICATION...................................  26
;   30. Initialization for Parser Save Routines...................  26
;   31. Routine to Set Up for COMND Reparse.......................  27
;   32. Routine To Fill in Defaults for COMND.....................  28
;   33. SWITCH TABLE PROCESSING ROUTINES..........................  29
;   34. STBDEL  SWITCH TABLE DELETE ROUTINE.......................  29
;   37. TAKE Command Table........................................  32
;   38. TAKDEF  TAKE DEFAULT SETTING..............................  32
;   39. TAKE    SPECIAL ROUTINES FOR TAKE COMMANDS................  33
;   40. TAKOPN  ROUTINE TO OPEN THE TAKE FILE.....................  33
;   44. P$CURR  GET THE ADDRESS OF THE CURRENT ENTRY..............  36
;   45. P$PREV  POSITION TO PREVIOUS PARSER ENTRY.................  36
;   46. P$NEXT  BUMP THE POINTER  TO NEXT FIELD...................  37
;   47. P$NFLD  TO GET HEADER AND DATA FOR A PARSER ELEMENT.......  37
;   48. P$CFM   CHECK FOR A CONFIRM IN NEXT BLOCK.................  38
;   49. P$COMMA CHECK FOR A COMMA IN NEXT BLOCK...................  39
;   50. P$KEYW  GET A KEYWORD FROM THE PARSED DATA................  40
;   51. P$SWIT  GET A SWITCH FROM THE PARSED DATA.................  41
;   52. P$USER  GET THE USER ID FIELD.............................  42
;   53. P$FLOT  GET THE FLOATING POINT NUMBER.....................  43
;   54. P$DIR   GET THE DIRECTORY FIELD...........................  44
;   55. P$TIME  GET THE TIME/DATE FIELD...........................  45
;   56. P$NUM   GET A NUMBER FROM THE PARSER BLOCK................  46
;   57. P$FILE  GET A FILESPEC FROM THE PARSER BLOCK..............  47
;   58. P$FLD   GET A TEXT FIELD FROM BLOCK.......................  48
;   59. P$NODE  GET A NODE FROM BLOCK.............................  49
;   60. P$SIXF  GET A SIXBIT FIELD TYPE...........................  50
;   61. P$RNGE  GET A RANGE BACK..................................  51
;   62. P$TEXT  GET A TEXT ADDRESS AND LENGTH.....................  52
;   63. P$DEV   GET A DEVICE ADDRESS AND LENGTH...................  53
;   64. P$QSTR  GET A QUOTED STRING...............................  54
;   65. P$UQSTR GET AN UNQUOTED STRING............................  55
;   66. P$STR	GET STRING OF SPEC TYPE (RET BP & LEN)............  56
;   67. P$ACCT  GET AN ACCOUNT STRING.............................  57
;   68. P$GPDB  GET THE PDB ADDRESS IF ANY DATA...................  58
;   69. P$PNXT  GET NEXT PDB GIVEN A PDB BLOCK....................  59
;   70. P$PERR  GET ERROR ROUTINE GIVEN A PDB BLOCK...............  60
;   71. P$PDEF  GET DEFAULT FILLER ROUTINE GIVEN A PDB BLOCK......  61
;   72. P$PACT  GET ACTION ROUTINE GIVEN A PDB BLOCK..............  62
SUBTTL	REVISION HISTORY

SUBTTL	PARSER ENTRY POINTS

	ENTRY	PARSE$		;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$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$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
	ENTRY	P$STR		;ARBIT STRING

	GLOB	<.TAKE>

	OPDEF	$RETIF	[JUMPF .POPJ]	;Return error on failure


SUBTTL	PARSER DATA BASE AND CONSTANTS

$IMPURE

.SWDSP==1			;/DISPLAY
.SWNDP==2			;/NODISP (THE DEFAULT)

$GDATA	.LGERR,1		;LAST CMDPAR ERROR PROCESSED VIA .RETE
$GDATA	.LGEPC,1		;PC (USUALLY) OF LAST $RETE
$GDATA	.NEXT,1			;IF NON-0, USE AS NEXT PDB

$DATA	ABSFLG,1		;SET IF FLD IS ABSENT
$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	PRMTSZ,1		;SIZE OF THE PROMPT
$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
$DATA	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
$GDATA	TEMFDB,PDB.SZ		;TEMP FDB AREA
$DATA	CMDERR,^D50		;SPACE FOR COMMAND ERROR TEXT
$DATA	CMDECT,1		;COMMAND ERROR MESSAGE COUNT
$DATA	CMDRET,CR.SIZ		;COMMAND RETURN DATA
$DATA	ARGSAV,PAR.SZ		;SAVE AREA FOR PARSER ARGUMENTS

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

;TAKE STORAGE
$DATA	CMDIFN,1		;STORAGE FOR COMMAND FILE IFN
$DATA	CMDJFN,1		;STORAGE FOR COMMAND FILE JFN
$DATA	LOGIFN,1		;STORAGE FOR LOG FILE IFN
$DATA	LOGJFN,1		;STORAGE FOR LOG FILE JFN

$DATA	TAKFLG,1		;FLAG TO INDICATE WE ARE IN TAKE COMMAND

$PURE

SUBTTL	P$INIT	PARSER INIT ROUTINE

	;THIS ROUTINE WILL INIT THE PARSER
	;CALL: NO ARGUMENTS


P$INIT:
	$CALL	S%INIT			;INIT SCANNER
	$CALL	K%INIT			;INIT KEYBRD
	$CALL	F%INIT			;INIT FILE MGR
	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
	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
	MOVEI	S1,CMDBLK		;GET THE COMMAND STATE BLOCK
	MOVEM	S1,CMDRET+CR.FLG	;SAVE IN FLAG WORD 
	SETZM	CMDBLK+CR.RES		;CLEAR RESULT FIELD
	SETZM	CMDBLK+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	PARSE$	PARSER ENTRY POINT

	;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


PARSE$:	$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
	MOVE	T1,[CM%XIF!REPARS]	;GET RE-PARSE ADDRESS & DISALLOW @
	MOVEM	T1,CMDBLK+.CMFLG	;PUT RE-PARSE ADDRESS AWAY
	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	P$INIT			;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
	PJRST	PARCMD			;PARSE THE COMMAND
SUBTTL	PARCMD	PARSE THE COMMAND

	;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
	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,CR.SIZ		;GET THE ARGUMENT BLOCK
	MOVEI	S2,CMDRET		;GET BLOCK ADDRESS
	PUSHJ	P,0(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	VALID COMMAND PARSE ROUTINE


	;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,CR.SIZ		;SIZE OF THE BLOCK
	MOVEI	S2,CMDRET		;COMMAND RETURN BLOCK
	PUSHJ	P,@PARTAB(T1)		;SAVE THE DATA FROM COMMAND
	SKIPGE	ABSFLG			;ABSENT FLD?
	JRST	ERREXT			;S2 PTS TO HELP TEXT
	LOAD	S1,CMDRET+CR.PDB,RHMASK	;GET THE USED PDB BYE COMMAND
	$CALL	P$PACT			;ANY ACTION ROUTINE
	JUMPF	VALC.1			;NO, CONTINUE ON
	MOVEI	S2,CMDRET		;COMMAND RETURN BLOCK
	TLNE	S1,-1			;INTERNAL ACTION (ANY FLAGS SET)?
	PJRST	VALACT			;YES (ARGS ARE S1/S2)
VACUSR:					;RET HERE IF AC%AAC SET & RH S1 NON-0
	HRRZ	T2,S1			;ISOL ROUTINE ADDR
	MOVX	S1,CR.SIZ		;SIZE OF THE BLOCK
	PUSHJ	P,0(T2)			;PROCESS THE ROUTINE
	JUMPF	VALC.3			;BAD RETURN..SET UP ERROR
VALC.1:
	$CALL	VALNXT			;GET NEXT PDB
	JUMPF	PARRET			;GIVE UP
VALC.2:
	MOVE	T1,0(S1)		;GET 1ST WORD OF BLOCK
	TLNN	T1,-1			;IS HDR WORD IF LEN INFO IN LH
	JRST	[MOVE	T2,SUB.RA(S1)	;NO, IS $SUB, GET RET ADDR
		 MOVEM	T2,@SUB.RV(S1)	;PUT RET ADDR AWAY
		 MOVEM	T1,S1		;MAKE S1 POINT AT 1ST PDB OF $SUB
		 JRST	.+1]		;EXIT IF
	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	VALID-TOKEN SUBROUTINES

VALACT:					;DO INTERNAL ACTIONS
;
; ARGUMENTS:
;	S1 = ACTION DATA
;	S2 = CMDRET PTR
; NOTES:
;	CALLED BY PJRST
	HRRZ	T2,S1			;SAVE ACTION DATA IN T2
	TXNN	S1,AC%NOI		;NOISE?
	JRST	VALAC1			;NO
	$CALL	VALNXT			;GET NEXT PDB (RET IN S1)
	JUMPF	PARRET			;NONE
	HRRZ	T1,0(T2)		;GET SIZ OF FDB  (INCL CNT WD)
	ADD	T1,T2			;ADDR OF NOISE'S NEXT FLD
	MOVEM	S1,0(T1)		;SET NEXT FLD IN NOISE PDB
	MOVE	S1,T2			;SET CURR PDB TO NOISE PDB IN ACT DATA
	JRST	VALC.2
VALAC1:
	TXNN	S1,AC%R0N		;MUST VAL BE 0 TO N?
	JRST	VALAC2			;NO
	SKIPGE	T1,CR.RES(S2)		;CHK IT
	JRST	VALAER			;LT 0
	JRST	VALRUP			;CHK UPPER RANGE
VALAC2:
	TXNN	S1,AC%R1N		;MUST VAL BE 1 TO N?
	JRST	VALAIE			;INVALID ACTION FLAG
	SKIPG	T1,CR.RES(S2)		;GTR 0?
	JRST	VALAER			;NO
VALRUP:
	JUMPE	T2,VALC.1		;UPPER RANGE SPEC? NO IF JUMP
	TXNE	S1,AC%AAC		;ACT ROUTINE RATHER THAN UPP BND?
	JRST	VACUSR			;YES, GO BACK AND CALL IT
	CAMG	T1,T2			;IS VAL LOW ENUFF?
	JRST	VALC.1			;YES

VALAER:
	MOVEI	S2,[ASCIZ/Number out of range/]
	PJRST	ERREXT			;MERGE ERR HANDLER
VALAIE:
	MOVEI	S2,[ASCIZ/Invalid action flag/]
	PJRST	ERREXT			;DITTO


VALNXT:					;DETS NEXT PDB
	MOVE	S1,.NEXT		;CHK GLOBAL NEXT PDB FLD
	SETZM	.NEXT			;INSURE OLD VAL NOT USED AGAIN
	JUMPN	S1,.RETT		;IS SET, GO USE IT
	LOAD	S1,CMDRET+CR.PDB,RHMASK	;GET THE USED PDB FROM PARSE
	$CALL	P$PNXT			;IS THERE A NEXT FIELD?
	JUMPT	.RETT			;GO USE IT
	MOVE	S1,CMDRET+CR.COD	;GET THE CODE FIELD
	CAXE	S1,.CMKEY		;YES, WAS IT A KEYWORD?
	CAXN	S1,.CMSWI		;OR A SWITCH?
	SKIPA				;YES,
	$RETF				;NO NEXT..RETURN
	MOVE	S1,CMDRET+CR.RES	;DATA FROM COMMAND PARSE
	HRRZ	S1,(S1)			;<R15>YES, GET NEXT PDB FROM DSPTAB
	MOVE	S1,(S1)			;<R15>NOT FROM PDB
	HRRZS	S1			;PASS ONLY THE RIGHT HALF
	JUMPE	S1,.RETF		;NONE..RETURN WITH MESSAGE
	$RETT				;YES
SUBTTL	PARRET	PARSER CODE TO RETURN TO CALLER
PARRET:	MOVE	T2,ARGFRE		;LAST FREE LOCATION
	MOVE	T3,PARDAT		;GET ADDRESS OF PARSER DATA MESSAGE
	MOVEM	T2,0(T3)		;POINTER FOR MESSAGE TEXT
	HRLI	T1,(POINT 7,0)		;SOURCE BYTE POINTER
	HRRI	T1,BUFFER		;SOURCE TEXT OF COMMAND
	HRLI	T2,(POINT 7,0)		;DESTINATION BYTE POINTER
PARR.0:	ILDB	S1,T1			;GET A BYTE
	IDPB	S1,T2			;SAVE A BYTE
	JUMPN	S1,PARR.0		;NON-ZERO..KEEP CHECKING
	SETZ	S1,			;CLEAR S1
	EXCH	S1,FLAGS		;GET THE CURRENT FLAGS AND RESET
	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
	MOVEI	S1,BUFFER		;RESET COMMAND POINTER TO STRING
	SKIPE	DSPTAK			;DISPLAY TAKE COMMANDS?
	$CALL	K%SOUT			;YES
	HRROM	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		;SAVE ADDRESS OF BUFFER
	MOVEM	S1,PARBLK+PRT.MS
	SETZM	S1			;IDENT BEGIN
	$CALL	P$SETU			;SETUP PTR TO 1ST TOKEN IN PARSER BLK
	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
	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/]
	PJRST	ERREXT			;EXIT
SUBTTL	CHKEOF	CHECK 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
	$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

ERREXT:	MOVE	T3,PARDAT		;GET PAGE ADDRESS
	HRLI	S2,(POINT 7,0)		;SETUP BYTE POINTER TO SRC
	MOVSI	T1,(POINT 7,0)		;SETUP BYTE POINTER TO DEST
	HRRI	T1,CMDERR		;BUFFER FOR DATA
ERRE3A:
	ILDB	T2,S2			;GET A CHAR
	JUMPE	T2,ERRE3B		;DONE
	IDPB	T2,T1			;STORE A CHAR
	JRST	ERRE3A
ERRE3B:
	SKIPL	ABSFLG			;ABSENT FLD ERR?
	JRST	ERRE.4			;NO
	SETZM	ABSFLG			;CLEAR IT
	MOVE	S2,[POINT 7,[ASCIZ/ absent/]]	;FINISH UP WITH THIS
	JRST	ERRE3A
ERRE.4:
	IDPB	T2,T1			;STORE A CHAR
	MOVEI	S2,CMDERR		;SETUP ERROR POINTER
	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
	$RETF				;RETURN FALSE



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
	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:	MOVE	T3,ARGSAV+PAR.CM	;ANY COMMAND MESSAGE SUPPLIED?
	MOVEM	T3,PARDAT		;SAVE ADDRESS OF PARSER DATA
	AOS	T3			;BUMP IT BY 1
	MOVEM	T3,ARGFRE		;SAVE AS POINTER TO FREE AREA
	$RET				;RETURN

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 SETUP THE CHARACTERS FROM THE RESCAN FOR PARSING
	;
	;RETURN	S1/	COUNT OF CHARACTERS

RESCN:

TOPS20 <
	MOVEI	S1,.RSINI		;Make characters available
	RSCAN%
	 ERJMP	[$FATAL <Rescan JSYS failed>]
	MOVEI	S1,.RSCNT		;Get the number of characters available
	RSCAN%
	 ERJMP	[$FATAL <Rescan JSYS failed>]
	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 <
	RESCAN
RESCN1:	SKPINC				;Character available?
	JRST	RESCN2			;NO, we are all done
	$CALL	K%BIN			;YES, get it
	IDPB	S1,T2			;Store it
	AOJA	T3,RESCN1		;BUMP COUNT AND TRY AGAIN
> ;End TOPS10 conditional

RESCN2:	SETZ	S1,			;Terminate buffer with a null
	IDPB	S1,T2
	MOVE	S1,T3			;GET THE 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)
	SAVFLD				;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	SAVE ROUTINES FOR COMND


	;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	SAVE ROUTINE FOR FILE SPECS

	;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	SAVE ROUTINE FOR NUMBERS

	;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	SAVE ROUTINE FOR COMMA, CONFRM..FUNCTION ONLY

	;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 ROUTINES FOR USER STRINGS

SAVUQS:	;THIS ROUTINE WILL BUILD BLOCK WITH TEXT FROM UNQUOTED STRING FUNCTION
	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

SAVFLD:	;COPY FIELD FROM ATOM BUFFER, MAP TO UPPER CASE & CHK FOR NUL FIELD
	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
	ILDB	T3,T1			;CHK IF NULL STRING
	JUMPN	T3,SAVF1A		;NO
	  HRRZ	T1,CR.PDB(S2)		;GET PTR TO FDB USED
	  HRRZ	S2,.CMHLP(T1)		;GET PTR TO HELP STRING FOR FLD
	  SETOM	ABSFLG			;SET FLD ABSENT FLAG
	  $RET				;RET TO CALLER
SAVF.1:	ILDB	T3,T1			;GET A CHARACTER FROM THE SOURCE
SAVF1A:	CAIG	T3,"z"			;LOW CASE UPP BND
	CAIGE	T3,"a"			;LOW CASE LOWER BND
	SKIPA				;OUTSIDE LOWER CASE BNDS
	SUBI	T3,40			;LOWER CASE LETTER, MAP TO UPPER CASE
	IDPB	T3,T2			;SAVE  IT IN THE DESTINATION
	JUMPN	T3,SAVF.1		;LOOP IF MORE ...NON-ZERO
	JRST	SAVA.2			;DO COMMON FINISH UP

SAVATM:	;COPY TEXT OR QUOTED STRING FROM ATOM BUFFER
	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	SAVE ROUTINE FOR SINGLE VALUE FUNCTIONS

	;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	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	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	Initialization for Parser Save Routines

;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
	MOVEI	T1,1(S1)		;ROOM FOR PTR TO CMD TEXT
	MOVEM	T1,ARGFRE		;SAVE AS START OF ARGUMENT AREA
	$RET				;AND RETURN
SUBTTL	Routine to 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:	PUSHJ	P,@.CMINI+PARTAB	;TELL SAVE ROUTINES TO FORGET 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
	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	Routine To 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,CR.SIZ		;SIZE OF THE BLOCK
	MOVEI	S2,CMDRET		;COMMAND RETURN BLOCK
	PUSHJ	P,0(T2)			;CALL THE DEFAULT FILLER
	JUMPT	FILD.2			;O.K..CONTINUE ON
	SKIPN	S2			;IF S2 HAS ERROR SET..SKIP
	MOVEI	S2,[ASCIZ/Error durring 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	STBDEL	SWITCH TABLE DELETE ROUTINE

	;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		;TURN ON IN TABLE
	JRST	STBD.1			;FINISH UP TABLE OPERATION

SUBTTL	TAKE Command Table

.TAKE: $NOISE(TAK001,<Commands From>)

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

TAK003:	$STAB
	DSPTAB	(TAK004,.SWDSP,DISPLAY)
	DSPTAB	(TAK004,.SWNDP,NODISPLAY)
	$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	TAKE	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
	SETZM	S1			;START AT 1ST PDB
	$CALL	P$SETU			;SETUP THE POINTER
	$CALL	P$KEYW			;GET THE NEXT FIELD
	JUMPF	TAKE.1			;ERROR..RETURN
	$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
	JUMPF	.POPJ			;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
	$RETF				;RETURN FALSE

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


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
	MOVEM	S1,CMDJFN		;Save proper file index
	TXO	S1,CO%NRJ+CZ%NUD	;Close but don't release JFN
	CLOSF%
	 JRST	[MOVX	S1,ERUSE$	;Should never happen
		 $RETF]
	MOVE	S1,CMDJFN		;Reclaim proper JFN
	MOVX	S2,FLD(7,OF%BSZ)+OF%RD	;Reopen in proper mode
	OPENF%
	 JRST	[MOVX	S1,ERUSE$	;Should never happen
		 $RETF]
	SKIPA				;Already saved JFN
> ;End TOPS20
	MOVEM	S1,CMDJFN		;Save the proper  file index
	MOVEI S1,.NULIO			;No LOGGING
	MOVEM S1,LOGIFN
	MOVEM S1,LOGJFN
P$TAK1:	MOVE	S1,CMDIFN		;Return command IFN
	MOVE	S2,LOGIFN		; and logging IFN
	$RETT
SUBTTL	P$SETU	SETUP THE PARSER BLOCK POINTER ADDRESS

;SET UP PTR TO CURR TOKEN
;THIS ROUTINE WILL USE PARDAT TO LOCATE 1ST TOKEN IN PARSER BLK
;
;CALL:	S1=0 SAYS PT TO 1ST TOKEN
;	S1 NOT 0 SAYS USE S1 AS PTR
;
;RETURN	TRUE:	ALWAYS

P$SETU::
	JUMPN	S1,SETCUR		;PUT INPUT VAL AWAY, IF ONE
	MOVE	S1,PARDAT		;GET PARDAT
	ADDI	S1,1			;HOP OVER TEXT PTR
SETCUR:
	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	TO 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
	$RETF				;NO, RETURN FALSE
	DMOVE	S1,PFD.D1(S2)		;PLACE NUMBER IN S1 AND
					;RADIX IN S2
	PJRST	P$NEXT			;ADVANCE TO NEXT FIELD



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
	JUMPF	.POPJ			;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
	JUMPF	.POPJ			;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$STR	GET A STRING OF SPECIFIED TYPE

	;ON INPUT:		S1/	-1 OR TYPE TO CHK FOR
	;ON RETURN TRUE:	S1/	BYTE PTR TO TEXT
	;			S2/	NUMBER OF CHARS
	;
	;ON RETURN FALSE:	S1/	DATA TYPE FOUND

P$STR:	
	PUSH	P,S1			;SAVE DESIRED TYPE
	$CALL	P$NARG			;GET THE TYPE ELEMENT
	POP	P,T1			;GET IT BACK
	CAME	T1,S1			;IS IT TEXT?
	JUMPGE	T1,.RETF		;NO, UNLESS TYPE CHK SUPPRESSED
	MOVEI	S1,1(S2)		;GET TO START OF TEXT
	LOAD	S2,PFD.HD(S2),PF.LEN	;GET THE LENGTH IN S2
	HRLI	S1,440700		;MAKE BP
	MOVEM	S1,T1			;DONT CLOB S1
	ADDI	T1,-2(S2)		;PT TO LAST WD OF TEXT
	SUBI	S2,1+1			;ELIM HDR & WD OF (PARTIALLY) NULS
	IMULI	S2,5			;CONV WDS TO CHARS
	ILDB	T2,T1			;CHK FOR NULL BYTE
	SKIPE	T2			;END YET?
	AOJA	S2,.-2			;NO, BUMP CNT
	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$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
	JUMPF	.POPJ			;ERROR..RETURN
	CAIG	S2,PB%NXT		;IS THERE A NEXT FIELD
	$RETF				;NO, RETURN FALSE
	MOVEI	S1,@PB%NXT(S1)		;GET THE VALUE (MVI @ ALLOWS VARIABLE)
	JUMPE	S1,.RETF		;NO "NEXT" VAL
	$RETT				;YES, O.K.
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
	JUMPF	.POPJ			;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
	JUMPF	.POPJ			;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/	FLAGS,,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
	JUMPF	.POPJ			;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	COMMON LOW-LEVEL ROUTINES

;I%NOW -- RET TIME OF DAY
;CALL IS:	No arguments
;TRUE RETURN:	S1/ Time and date in UDT format

ENTRY I%NOW

TOPS10 <
I%NOW:	MOVX	S1,%CNDTM		;GET TIME AND DATE FROM
	GETTAB	S1,			;THE MONITOR
	  $STOP(DTU,Date/Time unavailable)
	$RETT				;RETURN S1/HAS UDT
> ;END TOPS10 CONDITIONAL

TOPS20 <
I%NOW:	GTAD				;GET DATE AND TIME
	$RETT				;AND RETURN THEM
> ;END TOPS20 CONDITIONAL

; $RETE calls .RETE to set up the last GALAXY error and location
; then set TF = FALSE and return.

ENTRY .RETE,.RETT,.RETF,.POPJ
ENTRY .ZCHNK,.STKST,.STOP

.RETE:	HRRZM	TF,.LGEPC	;CALLED VIA JSP TF, SO SET UP PC OF LAST ERROR
	HRRZ	S1,@.LGEPC	;NOW FETCH ERROR CODE
	MOVEM	S1,.LGERR	;AND REMEMBER IT
				;FALL INTO .RETF

; .RETT AND .RETF are called via the $RETT and $RETF macros and can also
; be called directly.  They both set the value of TF, one to TRUE and the other
; to FALSE.  After doing this, they return via a POPJ P,

;The .POPJ  routine can be jumped
; to get a return, without changing the value in the TF register

.RETF:	TDZA	TF,TF		;ZEROS MEAN FALSE
.RETT:	SETO	TF,		;ONES MEAN TRUE
.POPJ:	POPJ	P,0		;RETURN

;.STOP - TERMINATES PROCESSING

.STOP:	$HALT
	JRST	.-1		;FORBID CONTINUE

; .ZCHNK 0'S A CHUNK WHOSE SIZE IS IN S1 AND STARTING POINT IN S2

.ZCHNK:	TRNN	S1,-1			;Anything to do?
	$RETT				;No..just return
	PUSH	P,S1			;SAVE CALLER'S SIZE
	PUSH	P,S2			;AND ADDRESS
ZCHN.1:	SETZM	0(S2)			;CLEAR FIRST WORD
	SOJE	S1,ZCHN.2		;COUNT OF 1,,JUST RETURN
	ADDI	S1,0(S2)		;COMPUTE END ADDRESS
	HRLS	S2			;GET ADDR,,ADDR OF CHUNK
	AOS	S2			;AND NOW ADDR,,ADDR+1
	BLT	S2,0(S1)		;NOW CLEAR THE CHUNK
ZCHN.2:	POP	P,S2			;RESTORE CALLER'S CHUNK ADDR
	POP	P,S1			;AND HIS SIZE
	$RETT				;AND RETURN

;COMMON ENTRY AND EXIT ROUTINE FOR STACK VARIABLE

.STKST::ADD P,@.SAC		;BUMP STACK FOR VARIABLES USED
	JUMPGE P,STKSOV		;TEST FOR STACK OVERFLOW
STKSE1:	PUSH P,@.SAC		;SAVE BLOCK SIZE FOR RETURN
	AOS .SAC		;BUMP PAST POINTER
	PUSHJ P,@.SAC		;CONTINUE ROUTINE, EXIT TO .+1
.STKRT::CAIA			;NON-SKIP RETURN
	AOS -1(P)		;SKIP RETURN
	SUB P,0(P)		;ADJUST PER COUNT OF VARIABLES
	SUB P,[1,,1]		;REMOVE COUNT FROM STACK
	POPJ P,0		;RETURN

STKSOV:	SUB P,@.SAC		;STACK OVERFLOW- UNDO ADD
	HLL .SAC,@.SAC	;SETUP TO DO MULTIPLE PUSH, GET COUNT
STKSO1:	PUSH P,[0]		;DO ONE PUSH AT A TIME, GET REGULAR
	SUB .SAC,[1,,0]		; ACTION ON OVERFLOW
	TLNE .SAC,777777	;COUNT DOWN TO 0?
	JRST STKSO1		;NO, KEEP PUSHING
	JRST STKSE1

SUBTTL SAVE AC CO-ROUTINES

;THESE ROUTINES ACT AS CO-ROUTINES WITH THE ROUTINES WHICH CALL THEM,
;	THEREFORE NO CORRESPONDING "RESTORE" ROUTINES ARE NEEDED. WHEN
;	THE CALLING ROUTINE RETURNS TO ITS CALLER, IT ACTUALLY RETURNS
;	VIA THE RESTORE ROUTINES AUTOMATICALLY.

ENTRY .SAVE1,.SAVE2,.SAVE3,.SAVE4,.SAVET,.SV13,.SV14,.SV15,.SV16

.SAVE1:	EXCH	P1,(P)		;SAVE P1 GET CALLERS ADDRESS
	PUSH	P,.+3		;SAVE RETURN ADDRESS FOR CALLER
	HRLI	P1,-1(P)	;MAKE IT LOOK LIKE RESULT OF JSA
	JRA	P1,(P1)		;CALL THE CALLER
	  CAIA	.		;NON-SKIP RETURN
	AOS	-1(P)		;SKIP RETURN
	JRST	RES1		;RESTORE P1

.SAVE2:	EXCH	P1,(P)		;SAVE P1 GET CALLERS ADDRESS
	PUSH	P,P2		;SAVE P2
	PUSH	P,.+3		;SAVE RETURN ADDRESS
	HRLI	P1,-2(P)	;SETUP FOR THE JRA
	JRA	P1,(P1)		;CALL THE CALLER
	  CAIA	.		;NON-SKIP RETURN
	AOS	-2(P)		;SKIP RETURN
	JRST	RES2		;RESTORE P2,P1

.SAVE3:	EXCH	P1,(P)		;SAVE P1 GET RETURN ADDRESS
	PUSH	P,P2		;SAVE P2
	PUSH	P,P3		;SAVE P3
	PUSH	P,.+3		;SAVE RETURN ADDRESS
	HRLI	P1,-3(P)	;SETUP FOR JRA
	JRA	P1,(P1)		;AND CALL THE CALLER
	  CAIA	.		;NON-SKIP
	AOS	-3(P)		;SKIP RETURN
	JRST	RES3		;AND RESTORE P3,P2,P1

.SAVE4:	EXCH	P1,(P)		;SAVE P1 GET RETURN ADDRESS
	PUSH	P,P2		;SAVE P2
	PUSH	P,P3		;SAVE P3
	PUSH	P,P4		;SAVE P4
	PUSH	P,.+3		;SAVE RETURN ADDRESS
	HRLI	P1,-4(P)	;SETUP FOR RETURN
	JRA	P1,(P1)		;AND RETURN
	  CAIA	.		;NON-SKIP RETURN
	AOS	-4(P)		;SKIP RETURN
RES4:	POP	P,P4		;RESTORE P4
RES3:	POP	P,P3		;RESTORE P3
RES2:	POP	P,P2		;RESTORE P2
RES1:	POP	P,P1		;RESTORE P1
	POPJ	P,		;AND RETURN

.SAVET:	EXCH	T1,(P)		;SAVE T1 AND GET RETURN ADDRESS
	PUSH	P,T2		;SAVE T2
	PUSH	P,T3		;SAVE T3
	PUSH	P,T4		;SAVE T4
	PUSH	P,.+3		;SAVE RETURN ADDRESS
	HRLI	T1,-4(P)	;SETUP FOR JRA
	JRA	T1,(T1)		;AND CALL THE CALLER
	  CAIA	.		;RETURN HERE ON NON-SKIP
	AOS	-4(P)		;RETURN HERE ON SKIP
	POP	P,T4		;RESTORE T4
	POP	P,T3		;RESTORE T3
	POP	P,T2		;RESTORE T2
	POP	P,T1		;RESTORE T1
	POPJ	P,		;RETURN

; THESE ROUTINES ARE CALLED BY THE SAVE MACRO FOR ABSOLUTE AC'S
;	13,14,15, & 16. THE MACRO FIGURES OUT WHICH ONE

.SV13:	EXCH	13,(P)		;SAVE 13 GET CALLERS ADDRESS
	PUSH	P,.+3		;SAVE RETURN ADDRESS FOR CALLER
	HRLI	13,-1(P)	;MAKE IT LOOK LIKE RESULT OF JSA
	JRA	13,(13)		;CALL THE CALLER
	  CAIA	.		;NON-SKIP RETURN
	AOS	-1(P)		;SKIP RETURN
	POP	P,13		;RESTORE 13
	POPJ	P,		;AND RETURN

.SV14:	EXCH	14,(P)		;SAVE 14 GET CALLERS ADDRESS
	PUSH	P,.+3		;SAVE RETURN ADDRESS FOR CALLER
	HRLI	14,-1(P)	;MAKE IT LOOK LIKE RESULT OF JSA
	JRA	14,(14)		;CALL THE CALLER
	  CAIA	.		;NON-SKIP RETURN
	AOS	-1(P)		;SKIP RETURN
	POP	P,14		;RESTORE 14
	POPJ	P,		;AND RETURN

.SV15:	EXCH	15,(P)		;SAVE 15 GET CALLERS ADDRESS
	PUSH	P,.+3		;SAVE RETURN ADDRESS FOR CALLER
	HRLI	15,-1(P)	;MAKE IT LOOK LIKE RESULT OF JSA
	JRA	15,(15)		;CALL THE CALLER
	  CAIA	.		;NON-SKIP RETURN
	AOS	-1(P)		;SKIP RETURN
	POP	P,15		;RESTORE 15
	POPJ	P,		;AND RETURN

.SV16:	EXCH	16,(P)		;SAVE 16 GET CALLERS ADDRESS
	PUSH	P,.+3		;SAVE RETURN ADDRESS FOR CALLER
	HRLI	16,-1(P)	;MAKE IT LOOK LIKE RESULT OF JSA
	JRA	16,(16)		;CALL THE CALLER
	  CAIA	.		;NON-SKIP RETURN
	AOS	-1(P)		;SKIP RETURN
	POP	P,16		;RESTORE 16
	POPJ	P,		;AND RETURN
	END