Google
 

Trailing-Edge - PDP-10 Archives - bb-d868c-bm_tops20_v4_2020_distr - 4-sources/verify.mac
There are 21 other files named verify.mac in the archive. Click here to see a list.
;<4.UTILITIES>VERIFY.MAC.6,  3-Jan-80 15:27:57, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.UTILITIES>VERIFY.MAC.5, 22-Apr-79 18:51:46, Edit by REILLY
;Add new UETP-TALK.MAC and fix routine UETPER
;<4.UTILITIES>VERIFY.MAC.3, 14-Mar-79 11:20:43, Edit by REILLY
;Replace old routine to talk to the UETP with the new
;<4.UTILITIES>VERIFY.MAC.2, 12-Mar-79 14:26:32, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.UTILITIES>VERIFY.MAC.2, 23-Jan-79 10:41:59, Edit by KONEN
;UPDATE VERSION NUMBER FOR RELEASE 4


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	TITLE VERIFY - PROGRAM TO VERIFY FILE VERSIONS
	ENTRY VERIFY

	SEARCH MONSYM,MACSYM
	.REQUIRE SYS:MACREL

	SALL

	VMAJOR==4		;MAJOR VERSION #
	VMINOR==1		;MINOR VERSION #
	VEDIT==4		;EDIT NUMBER
	VWHO==0			;CUSTOMER EDIT

	VERVER==<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT

	T1=1
	T2=2
	T3=3
	T4=4
	Q1=5
	Q2=6
	Q3=7
	P1=10
	P2=11
	P3=12
	P4=13
	P5=14
	P6=15
	CX=16
	P=17

	.JBVER==137

	STRLEN==100		;LENGTH OF STRING SPACE
	STRLNC==STRLEN*5-1	;NUMBER OF CHARACTERS IN A STRING

	VERPGA==100		;WHERE TO MAP THE VERSION NUMBER PAGE
	VERPAG==VERPGA_11

	CHKPGA==101		;CHECKSUM PAGE
	CHKPAG==CHKPGA_11
DEFINE ERRMES (TEXT) <
	JSP [	HRROI T1,[ASCIZ\? TEXT\]
		PSOUT
		HALTF
		JRST START]>

DEFINE CHKTYP (TYP) <
	CAIE T1,.CM'TYP
	ERRMES (<UNEXPECTED TYPE CODE RETURNED FROM "PARSE">)>

DEFINE SAVEPQ <
	JSP CX,SAVPQ>

DEFINE SAVEP <
	JSP CX,SAVP>


DEFINE TYPMSG (TEXT) <
	HRROI T1,[ASCIZ/
? TEXT
/]
	PSOUT>
ENTVEC:	JRST START		;START ADR
	JRST START		;REENTER ADR
	EXP VERVER		;VERSION NUMBER

START:	RESET			;INIT THE WORLD
START1:	MOVE P,[IOWD PDLEN,PDL]	;SET UP A STACK
	HRROI T1,[ASCIZ/VERIFY> /]
	MOVEI T2,COMTAB		;GET ADR OF COMMAND TABLE
	MOVEI T3,ANSWER		;GET POINTER TO ANSWER AREA
	CALL PARSE		;GO PARSE THE NEXT COMMAND
	 ERRMES (<? INVALID COMMAND TABLE FORMAT>)
	MOVEI P1,ANSWER		;GET A POINTER TO THE ANSWER BLOCK
	HLRZ T1,(P1)		;GET THE TYPE CODE
	CHKTYP (KEY)		;MUST BE A KEY WORD
	HRRZ T1,(P1)		;GET ADR OF ROUTINE
	AOS P1			;SET UP POINTER
	CALL (T1)		;DISPATCH TO THE NEXT LEVEL
	JRST START1		;GO PROMPT AGAIN


;THE CONNECT COMMAND

CONN:	SETZM UETPF		;INIT UETP FLAG
	HLRZ T1,(P1)		;GET TYPE CODE
	CHKTYP (FLD)
	HRRZ T1,(P1)		;GET POINTER TO FIELD
	MOVEI T1,ANSWER(T1)	;GET ADR OF FIRST WORD
	HRLI T1,(POINT 7,0)
	MOVE T2,[POINT 7,NAME]	;GET POINTER TO NAME STRING
	MOVEI T3,6		;NAME IS LIMITED TO 6 CHARS
CONN1:	ILDB T4,T1		;GET NEXT CHAR IN NAME STRING
	IDPB T4,T2		;STORE THE CHAR
	JUMPE T4,CONN2		;IF NULL, THEN DONE
	SOJGE T3,CONN1		;LOOP BACK FOR NEXT CHAR
	TYPMSG <NAME MUST BE SIX CHARACTERS OR LESS>
	RET

CONN2:	CALL UETINI		;INIT UETP ROUTINES
	 JRST [	CALL UETPER	;FAILED
		RET]
	HRROI T1,NAME		;AND SEND THE MINOR MESSAGE
	HRROI T2,[ASCIZ/MINOR/]
	HRROI T3,[ASCIZ/Start of verification/]
	CALL UETSND
	 JRST [	CALL UETPER	;FAILED
		RET]
	SETOM UETPF		;MARK THAT UETP IS BEING USED
	RET
;THE VERIFY COMMAND

VERIFY:	STKVAR <LSTJFN,<CURLIN,STRLEN>,<TSTSTR,STRLEN>>
	HLRZ T1,(P1)		;GET THE NEXT TYPE CODE
	CHKTYP (FIL)		;INPUT FILE
	HRRZ T1,(P1)		;GET POINTER TO JFN
	MOVE T1,ANSWER(T1)	;GET THE JFN
	MOVEM T1,LSTJFN		;SAVE THE JFN
VER1:	HRRZ T1,LSTJFN		;GET THE JFN
	MOVE T2,[070000,,OF%RD]
	OPENF			;OPEN THE FILE FOR READ
	 JRST ERROR		;FAILED TO OPEN THE FILE
	CALL VFLMES		;TYPE OUT THE NAME OF THE LIST FILE
VER2:	HRRZ T1,LSTJFN		;GET THE JFN OF THE LIST
	HRROI T2,CURLIN		;GET POINTER TO THE CURRENT LINE
	MOVEI T3,STRLNC		;GET NUMBER OF CHARACTERS IN STRING
	MOVEI T4,12		;TERMINATE ON LINE FEED
	SIN			;READ IN THE NEXT LINE
	 ERJMP [HRRZ T1,LSTJFN	;END OF FILE REACHED
		CLOSF
		 JFCL
		MOVE T1,LSTJFN	;GET JFN AGAIN
		GNJFN		;STEP TO THE NEXT FILE LIST
		 ERJMP R	;DONE
		JRST VER1]	;LOOP BACK FOR ALL LIST FILES
	SETZ T3,		;FINISH WITH A NULL
	IDPB T3,T2
	HRROI T1,CURLIN		;GET A POINTER TO THIS LINE
	HRROI T2,TSTSTR		;GET A POINTER TO THE TEST STRING
	CALL BLDSTR		;GO BUILD THE TEST STRING
	 JRST VER2		;AN ERROR OCCURRED, SKIP THIS FILE
	HRROI T1,CURLIN		;NOW COMPARE THE STRINGS
	HRROI T2,TSTSTR
	STCMP
	JUMPE T1,VER3		;MATCHED
	HRROI T1,CURLIN		;DID NOT MATCH
	HRROI T2,TSTSTR		;GO TYPE OUT THE ERROR MESSAGE
	CALL VFMES
VER3:	JRST VER2		;LOOP BACK FOR ALL FILES
;ROUTINE TO BUILD THE TEST STRING
;ACCEPTS IN T1/	POINTER TO CURRENT LINE
;	    T2/	POINTER TO TEST STRING
;	CALL BLDSTR
;RETURNS +1:	FAILED
;	 +2:	SUCCESS, TEST STRING BUILT

BLDSTR:	ASUBR <BLDSTC,BLDSTT,BLDSTJ>
	CALL GETJFN		;GET A JFN ON THE TEST FILE
	 JRST [	MOVE T2,BLDSTC	;GET THE CURRENT LINE POINTER
		CALL NSFMES	;GO PRINT OUT THE ERROR MESSAGE
		RET]
	MOVEM T1,BLDSTJ		;SAVE THE JFN
	CALL CHKSUM		;GO CALCULATE THE CHECK SUM
	 JRST [	MOVE T2,BLDSTC	;GET POINTER TO CURRENT LINE
		CALL CHKMES	;OUTPUT THE ERROR MESSAGE
		RET]
	MOVE T1,BLDSTJ		;GET TEST JFN AGAIN
	CALL GETVER		;GET THE VERSION
	 JRST [	MOVE T2,BLDSTC	;GET POINTER TO CURRENT LINE
		CALL VERMES	;OUTPUT THE ERROR MESSAGE
		JRST BLDST1]
	MOVE T1,T2		;GET POINTER TO TEST STRING
	CALL CRLF		;APPEND A CRLF
	MOVE T2,T1		;GET UPDATED STRING POINTER
BLDST1:	HRRZ T1,BLDSTJ		;GET JFN
	CLOSF			;CLOSE IT
	 JFCL
	HRRZ T1,BLDSTJ
	RLJFN			;AND RELEASE IT
	 JFCL
	RETSKP			;DONE
;ROUTINE TO TYPE OUT FILE LIST BEING VERIFIED
;ACCEPTS IN T1/	JFN

VFLMES:	ASUBR <VFLMSJ>
	HRROI T1,USTRNG		;BUILD STRING
	HRROI T2,[ASCIZ/Verifying file: /]
	SETZ T3,
	SOUT
	HRRZ T2,VFLMSJ		;GET JFN OF THE FILE
	SETZ T3,		;USE DEFAULT FORM
	JFNS
	HRROI T2,[ASCIZ/
/]
	SOUT
	SKIPN UETPF		;SENDING TO UETP?
	JRST [	HRROI T1,USTRNG	;NO
		PSOUT
		RET]
	HRROI T1,NAME		;YES
	HRROI T2,[ASCIZ/MINOR/]	;SEND MESSAGE TO LOG FILE
	HRROI T3,USTRNG
	CALL UETSND
	 JRST [	CALL UETPER	;FAILED
		RET]
	RET


;ROUTINES TO TYPE OUT ERROR MESSAGES DURING BUILDING OF TEST STRING
;ACCEPTS IN T1/	ERROR CODE
;	    T2/	POINTER TO CURRENT LINE STRING

VERMES:	JRST NSFMES
CHKMES:	TDZA T4,T4		;0 INDEX
NSFMES:	MOVEI T4,1		;1 INDEX
	ASUBR <NSFMSC,NSFMSP>
	HRROI T1,USTRNG		;SET UP TO BUILD STRING
	HRROI T2,[ASCIZ/? Verification error:
	Error "/]
	SETZ T3,
	SOUT
	MOVE T2,NSFMSC		;GET THE ERROR CODE
	HRLI T2,.FHSLF
	SETZ T3,
	ERSTR
	 JFCL
	 JRST [	HRLI T2,.FHSLF	;GET LAST ERROR CODE
		ERSTR
		 JFCL
		 JFCL
		JRST .+1]
	MOVE T2,MES1(T4)	;GET REMANIDER OF MESSAGE
	SOUT
	MOVE T2,NSFMSP		;GET POINTER TO THIS LINE
	SOUT
	HRROI T1,USTRNG
	CALL TYPERR		;GO OUTPUT THE ERROR MESSAGE
	RET

MES1:	-1,,[ASCIZ/" occurred during the check sum calculation on line:
		/]
	-1,,[ASCIZ/" occurred in line:
		/]
;ROUTINE TO TYPE THE VERIFICATION ERROR MESSAGE
;ACCEPTS IN T1/	CURRENT LINE
;	    T2/	TEST STRING

VFMES:	ASUBR <VFMSC,VFMST>
	HRROI T1,USTRNG		;BUILD THE STRING
	HRROI T2,[ASCIZ/? Mismatch occurred during verification:
	Currently installed file: /]
	SETZ T3,
	SOUT
	MOVE T2,VFMST		;GET TEST STRING
	SOUT
	HRROI T2,[ASCIZ/	Correct file:             /]
	SOUT
	MOVE T2,VFMSC		;GET CURRENT LINE
	SOUT
	HRROI T1,USTRNG
	CALL TYPERR		;GO TYPE THE ERROR MESSAGE
	RET


TYPERR:	SKIPN UETPF		;SENDING TO UETP?
	JRST [	PSOUT
		RET]
	MOVE T3,T1
	HRROI T1,NAME
	HRROI T2,[ASCIZ/ERROR/]
	CALL UETSND
	 JRST [	CALL UETPER
		RET]
	RET


;ROUTINE TO GET A JFN FOR THE FILE SPECIFIED IN THE CURRENT LINE
;ACCEPTS IN T1/	POINTER TO CURRENT LINE OF LIST
;	    T2/	POINTER TO OUTPUT STRING
;	CALL GETJFN
;RETURNS +1:	FAILED, T1/	ERROR CODE
;	 +2:	T1/	JFN
;		T2/	UPDATED STRING POINTER TO OUTPUT STRING

GETJFN:	TLC T1,-1		;CONVERT BYTE POINTERS
	TLCN T1,-1
	HRLI T1,(POINT 7,0)
	TLC T2,-1
	TLCN T2,-1
	HRLI T2,(POINT 7,0)
	ASUBR <GETJFI,GETJFO>
	MOVX T1,GJ%OLD!GJ%SHT	;GET A JFN ON THE FILE
	MOVE T2,GETJFI		;GET POINTER TO THE INPUT STRING
	GTJFN
	 RET			;FAILED
	SETZ T4,		;INIT COUNT OF CHARS IN FILE NAME
GETJF1:	ILDB T3,GETJFI		;COPY THE STRING TO THE OUTPUT STRING
	JUMPE T3,GETJF2		;IF NULL, THEN DONE
	CAIE T3,15		;CR?
	CAIN T3,12		;OR LF?
	JRST GETJF2		;YES, DONE
	CAMN T2,GETJFI		;STRING POINTER MATCH YET?
	JRST GETJF2		;YES, DONE
	IDPB T3,GETJFO		;STORE THIS CHAR
	AOJA T4,GETJF1		;COUNT UP THE CHARS IN THE FILE NAME

GETJF2:	MOVNS T4		;GET THE NUMBER OF SPACES TO OUTPUT
	ADDI T4,^D20
	MOVEI T3," "		;GET A SPACE
GETJF3:	IDPB T3,GETJFO		;PUT THE SP[ACE INTO THE OUTPUT STRING
	SOJG T4,GETJF3		;LOOP BACK FOR ALL SPACES
	MOVEI T3,0		;END THE STRING WITH A NULL
	MOVE T2,GETJFO		;RETURN THE UPDATED POINTER
	IDPB T3,GETJFO
	RETSKP
;ROUTINE TO CALCULATE THE CHECK SUM OF A FILE
;ACCEPTS IN T1/	JFN
;	    T2/	OUTPUT STRING POINTER
;	CALL CHKSUM
;RETURNS +1:	ERROR, ERROR CODE IS IN T1
;	 +2:	UPDATED STRING POINTER IN T2

CHKSUM:	STKVAR <CHKSMJ,CHKSMS,CHKSMP,CHKSME,CHKSMT,CHKSMA,CHKSMC>
	MOVEM T1,CHKSMJ		;SAVE THE JFN
	MOVEM T2,CHKSMS		;SAVE THE STRING POINTER
	SETZM CHKSMC		;INIT THE CHECK SUM
	SETZM CHKSME		;INIT ERROR CODE
	MOVE T2,[44B5!OF%RD]	;OPEN THE FILE
	OPENF
	 RET			;FAILED TO OPEN THE FILE
	HRLZ T1,CHKSMJ		;SET UP THE PMAP POINTER
CHKSM1:	HRRZM T1,CHKSMP		;SAVE THE PAGE NUMBER
	MOVE T2,[.FHSLF,,CHKPGA]
	FFUFP			;FIND THE NEXT USED PAGE
	 JRST [	CAIE T1,FFUFX3	;NO MORE?
		MOVEM T1,CHKSME	;SOME OTHER ERROR
		JRST CHKSM3]	;ALL DONE
	MOVEM T1,CHKSMA		;SAVE THE PAGE ADDRESS
	HRRZ T4,T1		;GET PAGE NUMBER
	SUB T4,CHKSMP		;HOLE?
	JUMPE T4,CHKSM2
	MOVNI T3,(T4)		;YES, GET SIZE OF THE HOLE
	HRL T3,T4		;# OF PAGES ,, - # OF PAGES
	MOVE T1,CHKSMC		;GET CHECK SUM VALUE
	MOVEM T3,CHKSMT		;SAVE THE PAGE COUNT ON THE STACK
	MOVSI T2,-1		;SET UP FOR ONE WORD OF CHECK SUM
	HRRI T2,CHKSMT		;ADD HOLE INTO THE CHECKSUM
	CALL CHKSOM		;UPDATE THE CHECKSUM
	MOVEM T1,CHKSMC		;SAVE NEW CHECKSUM
CHKSM2:	MOVX T3,PM%RD		;MAP IN THE NEXT PAGE
	MOVE T1,CHKSMA		;GET FILE PAGE NUMBER
	MOVE T2,[.FHSLF,,CHKPGA]
	PMAP
	MOVSI T2,-1000		;SET UP COUNT OF THE WORDS
	HRRI T2,CHKPAG		;AOBJN POINTER TO THE PAGE
	MOVE T1,CHKSMC		;GET THE CURRENT CHECKSUM
	CALL CHKSOM		;DO THE CHECKSUM
	MOVEM T1,CHKSMC		;SAVE THE UPDATED CHECKSUM
	MOVE T1,CHKSMA		;GET THE PAGE ADR AGAIN
	AOJA T1,CHKSM1		;STEP TO THE NEXT PAGE

CHKSM3:	SETO T1,		;UNMAP THE PAGE
	MOVE T2,[.FHSLF,,CHKPGA]
	SETZ T3,
	PMAP
	MOVX T1,CO%NRJ		;DO NOT RELEASE THE JFN
	HRR T1,CHKSMJ		;CLOSE THE JFN
	CLOSF
	 RET			;FAILED
	MOVE T1,CHKSMC		;GET THE CHECKSUM
	SKIPN CHKSME		;ANY ERRORS?
	JRST CHKSM4		;NO, GO COPY CHECK SUM TO OUTPUT STRING
	MOVE T1,CHKSME		;YES, GET THE ERROR CODE
	RET

CHKSM4:	HLRZ T2,CHKSMC		;MERGE THE CHECKSUM INTO 18 BITS
	HRRZ T3,CHKSMC		;GET THE OTHER HALF
	ADD T3,T2		;FOLD THE TWO HALVES TOGETHER
	HLRZ T2,T3		;HANDLE THE OVERFLOW
	ADDI T2,(T3)
	MOVE T3,[1B0+1B2+1B3+6B17+10]
	MOVE T1,CHKSMS		;GET STRING POINTER
	NOUT
	 JRST ERROR
	HRROI T2,[ASCIZ/ P    /]
	SETZ T3,
	SOUT
	MOVE T2,T1		;RETURN UPDATED STRING POINTER IN T2
	RETSKP
;ROUTINE TO UPDATE THE CHECKSUM VALUE
;ACCEPTS IN T1/	SEED
;	    T2/	AOBJN POINTER TO DATA TO BE CHECKSUMED

CHKSOM:	ROT T1,1
	ADD T1,(T2)		;ADD IN THE NEXT WORD
	AOBJN T2,CHKSOM		;LOOP BACK FOR ALL WORDS
	RET



;ROUTINE TO GET A VERSION NUMBER
;ACCEPTS IN T1/	JFN
;	    T2/	STRING POINTER TO OUTPUT STRING

GETVER:	STKVAR <GETVRJ,GETVRP,GETVRF,<GETVRS,8>>
	MOVEM T1,GETVRJ		;SAVE THE JFN
	MOVEM T2,GETVRP		;SAVE THE OUTPUT POINTER
	HRROI T1,GETVRS		;GET THE FILE TYPE
	HRRZ T2,GETVRJ		;FROM THE JFN
	MOVSI T3,(2B11)		;ONLY WANT THE FILE TYPE
	JFNS
	MOVE T1,GETVRS		;GET THE FIRST WORD
	TRZ T1,377		;MASK OFF THE LOW ORDER 8 BITS
	CAME T1,[ASCII/EXE/]	;IS THIS AN EXE FILE?
	JRST GETVR2		;NO, THEN NO VERSION NUMBER
	SETZ T1,		;GET A FORK FOR THE PROGRAM
	CFORK
	 RET			;COULD NOT GET A FORK
	MOVEM T1,GETVRF		;SAVE THE FORK HANDLE
	HRLZ T1,GETVRF		;NOW GET THE FILE INTO THE FORK
	HRR T1,GETVRJ
	GET
	 ERJMP GETVR1		;ERROR COULD MEAN NOT AN EXE FILE
	MOVE T1,GETVRF		;GET THE FORK HANDLE
	CALL GETVN		;GO GET THE VERSION NUMBER
	 JRST GETVR1		;NONE THERE
	MOVE T2,GETVRP		;GET POINTER TO THE OUTPUT STRING
	CALL VERPNT		;OUTPUT THE VERSION NUMBER
	MOVEM T2,GETVRP		;SAVE UPDATED STRING POINTER
GETVR1:	MOVE T1,GETVRF
	KFORK			;KILL THE LOWER FORK
GETVR2:	MOVE T2,GETVRP		;GET UPDATED POINTER
	RETSKP			;DONE
;ROUTINE TO OUTPUT THE VERSION NUMBER TO A STRING
;ACCEPTS IN T1/	VERSION #
;	    T2/	STRING POINTER

VERPNT:	ASUBR <VERPNV,VERPNP>
	MOVE T1,VERPNP		;GET OUTPUT POINTER
	LDB T2,[POINT 9,VERPNV,11] ;GET MAJOR VERSION
	JUMPE T2,VERPN1		;IF NONE, SKIP THIS
	MOVEI T3,8		;OCTAL
	NOUT
	 ERJMP ERROR
VERPN1:	LDB T2,[POINT 6,VERPNV,17] ;GET THE MINOR VERSION
	JUMPE T2,VERPN3		;IF NONE, SKIP THIS
	SUBI T2,1
	IDIVI T2,^D26		;GET LETTERS
	JUMPE T2,VERPN2		;IF NO FIRST LETTER...
	MOVEI T2,"A"-1(T2)	;GET LETTER TO TYPE
	BOUT
VERPN2:	MOVEI T2,"A"(T3)	;GET SECOND LETTER
	BOUT
VERPN3:	HRRZ T2,VERPNV		;GET THE EDIT NUMBER
	JUMPE T2,VERPN4
	MOVEI T2,"("
	BOUT
	HRRZ T2,VERPNV		;GET EDIT NUMBER AGAIN
	MOVEI T3,8		;OCTAL
	NOUT
	 ERJMP ERROR
	MOVEI T2,")"
	BOUT
VERPN4:	LDB T3,[POINT 3,VERPNV,2]
	JUMPE T3,VERPN5		;CUSTOMER VERSION?
	MOVEI T2,"-"
	BOUT
	MOVE T2,T3		;OUTPUT THE NUMBER
	MOVEI T3,8
	NOUT
	 ERJMP ERROR
VERPN5:	MOVE T2,T1		;GET UPDATED STRING POINTER
	RET
;ROUTINE TO GET A VERSION NUMBER FROM A FORK
;ACCEPTS IN T1/	FORK HANDLE
;RETURNS +1:	NO VERSION NUMBER
;	 +2:	T1/	VERSION NUMBER

GETVN:	ASUBR <GETVNF>
	GEVEC			;GET ENTRY VECTOR
	HLRZ T1,T2		;GET TYPE
	CAIE T1,(<JRST>)	;TOPS-10?
	JRST [	CAIGE T1,3	;NO, LONG ENOUGH?
		RET		;NO
		MOVEI T2,2(T2)	;GET ADR OF VERSION NUMBER
	JRST GETVN1]
	MOVEI T2,.JBVER
GETVN1:	MOVE T1,GETVNF
	CALL RDVER		;GO READ THAT ADDRESS
	 RET			;NO PAGE THERE
	RETSKP			;DONE



;ROUTINE TO READ A WORD FROM A FORK
;ACCEPTS IN T1/	FORK HANDLE
;RETURNS +1:	NO PAGE THERE
;	 +2:	T1/	ANSWER

RDVER:	ASUBR <RDVERF,RDVERA>
	HRLZ T1,RDVERF		;GET THE FORK HANDLE
	LSH T2,-11		;GET PAGE ADR
	HRR T1,T2
	RPACS			;SEE IF THE PAGE EXISTS
	TXNN T2,PA%PEX
	RET			;DOES NOT EXIST
	MOVE T2,[.FHSLF,,VERPGA]
	MOVX T3,PM%RD		;MAP THE PAGE IN
	PMAP
	MOVE T4,RDVERA		;GET ADR AGAIN
	ANDI T4,777		;JUST GET THE OFFSET
	MOVE T4,VERPAG(T4)	;GET THE WORD
	SETO T1,		;UNMAP THE PAGE
	PMAP
	SKIPN T1,T4		;IS THERE A VERSION NUMBER?
	RET			;NO
	RETSKP			;YES
;EXIT COMMAND

EXITC:	HRROI T1,NAME		;END OF TEST
	HRROI T2,[ASCIZ/END/]
	HRROI T3,[ASCIZ/End of verification/]
	CALL UETSND
	 JRST [	CALL UETPER
		JRST .+1]
	HALTF
	JRST START



;UPDATE COMMAND

UPDATE:	SAVEPQ
	STKVAR <INJFN,OUTJFN,<CURLIN,STRLEN>,<TSTSTR,STRLEN>>
	HLRZ T1,(P1)		;GET THE TYPE CODE
	CHKTYP (IFI)
	HRRZ T1,(P1)		;GET THE POINTER TO THE JFN
	MOVE T1,ANSWER(T1)	;GET THE JFN
	MOVEM T1,INJFN
	MOVE T2,[070000,,OF%RD]	;OPEN THE FILE
	OPENF
	 JRST ERROR
	CALL GETOJ		;GET THE OUTPUT JFN
	 JRST ERROR
	MOVEM T1,OUTJFN		;SAVE THE OUTPUT JFN
	MOVE T2,[070000,,OF%WR]
	OPENF
	 JRST ERROR
	SETZ Q1,		;INIT ERROR COUNTER
UPDAT1:	MOVE T1,INJFN		;GET THE INPUT JFN
	HRROI T2,CURLIN
	MOVEI T3,STRLNC
	MOVEI T4,12		;READ UNTIL A LINE FEED IS SEEN
	SIN
	 ERJMP UPDAT2		;DONE
	SETZ T3,		;FINISH WITH A NULL
	IDPB T3,T2
	HRROI T1,CURLIN		;NOW BUILD THE TEST STRING
	HRROI T2,TSTSTR
	CALL BLDSTR
	 AOJA Q1,UPDAT1		;ERROR WHILE BUILDING STRING
	HRROI T2,TSTSTR		;NOW OUTPUT THE TEST STRING
	SETZ T3,
	HRRZ T1,OUTJFN
	SOUT
	JRST UPDAT1		;LOOP BACK FOR OTHER FILES IN LIST

UPDAT2:	HRRZ T1,INJFN		;CLOSE THE JFNS
	CLOSF
	 JFCL
	HRRZ T1,OUTJFN
	SKIPE Q1		;ANY ERRORS?
	TXO T1,CZ%ABT		;YES, DO NOT OVERWRITE THE FILE
	CLOSF
	 JRST ERROR
	RET
;ROUTINE TO GET AN OUTPUT JFN
;ACCEPTS IN T1/	JFN
;RETURNS +1:	FAILED
;	 +2:	T1/	OUTPUT JFN

GETOJ:	STKVAR <<GETOJS,20>>
	HRRZ T2,T1		;GET JFN
	HRROI T1,GETOJS
	MOVE T3,[2B8!2B11!JS%PAF] ;GET NAME.TYP
	JFNS
	MOVX T1,GJ%FOU!GJ%SHT
	HRROI T2,GETOJS		;GET THE OUTPUT JFN
	GTJFN
	 RET			;FAILED
	RETSKP			;OK


;ROUTINE TO APPEND A CRLF ONTO A STRING
;ACCEPTS IN T1/	STRING POINTER

CRLF:	HRROI T2,[ASCIZ/
/]
	SETZ T3,
	SOUT
	RET




;ROUTINE TO TYPE OUT AN ERROR MESSAGE

ERROR:	MOVEI T1,.PRIOU
	HRLOI T2,.FHSLF
	SETZ T3,
	ERSTR
	 JFCL
	 JFCL
	JRST START


;ROUTINE TO TYPE OUT ERROR MESSAGE FROM UETP

UETPER:	CAMN T2,[-1]		;IS THIS AN ERROR CODE?
	RET			;NO, THEN MESSAGE WAS ALREADY OUTPUT
	HRROI T1,[ASCIZ/
? COMMUNICATION TO UETP FAILED BECAUSE: /]
	PSOUT
	MOVEI T1,.PRIOU		;OUTPUT MESSAGE TO TTY
	MOVE T2,[.FHSLF,,-1]	;[4] LAST ERROR FROM THIS FORK
	SETZ T3,
	ERSTR
	 JFCL
	 JFCL
	HRROI T1,[ASCIZ/
/]
	PSOUT
	RET
SUBTTL	Subroutine to communicate to the UETP

;[BEGIN OF UETP-TALK.MAC]
;
;	This program will communicate with the UETP, via
;  IPCF.  The use of  this program is intended to be for
;  those programs that want to talk directly with the UETP.
;  The usual means of communication with the UETP is through
;  the SENDER program.  Not all of the features of SENDER
;  are implemented.

;  There are two routines UETINI and UETSND. 
;
;   UETINI - UETINI takes no arguments and initializes the UETP interface.
;		(It gets the proper PID)
;	     RETURNS: +1,always

;   UETSND - UETSND take arguments and is used for sending that data to the 
;		UETP.
;ACCEPTS:	T1/ASCIZ POINTER TO NAME OF TEST (6 CHARACTERS MAX)
;		T2/ASCIZ POINTER TO TYPE OF MESSAGE (SUGGESTION 'MAJOR')
;		 TYPES ARE:
;			START - START OF TEST MESSAGE
;			END   - END OF TEST MESSAGE
;			ERROR - ERROR MESSAGE - CAUSES ERROR COUNT TO GO UP
;			MAJOR - GENERAL MESSAGE FOR LOG AND TTY
;			MINOR - GENERAL MESSAGE FOR LOG ONLY
;		T3/ASCIZ POINTER TO TEXT STRING TO BE SENT

;RETURNS:	+1,ERROR T2/<PROCESS ID,,ERROR CODE> IF MONITOR ERROR
;				-1 IF NON-JSYS ERROR
;			T4/ADDRESS OF ERROR
;
;		+2,OTHERWISE
	SEARCH MONSYM, MACSYM
	.REQUIRE SYS:MACREL
	SALL

	TSTFLG==0

; ACCUMULATOR DEFINITIONS

	T1=1		;TEMPORARY
	T2=2		;TEMPORARY
	T3=3		;TEMPORARY
	T4=4		;TEMPORARY
	Q1=5		;PRESERVED
	Q2=6		;PRESERVED
	Q3=7		;PRESERVED
	P1=10		;PRESERVED
	P2=11		;PRESERVED
	P3=12		;PRESERVED
	P4=13		;PRESERVED
	P5=14		;PRESERVED
	P6=15		;PRESERVED (CAUTION, USED BY SOME MACROS IN MACSYM)
	CX=16		;RESERVED FOR SUPPORT CODE
	P=17		;PUSH-DOWN POINTER

NCHPW==5		;NUMBER OF ASCIZ CHARACTERS PER WORD
BUFSIZ==200		;SIZE OF INPUT TEXT BUFFER
IFN TSTFLG,<
PDLEN==50		;PUSH-DOWN STACK LENGTH
>
RETRY==2000		;COUNT OF NUMBER OF MSEND RETRIES
SUBTTL TEST ROUTINE

IFN TSTFLG,<

START:	MOVE P,[IOWD PDLEN,PDL]	;SET UP STACK
	CALL UETINI
	HRROI T1,[ASCIZ/VERIFY/]
	HRROI T2,[ASCIZ/MAJOR/]
	HRROI T3,[ASCIZ/Testing of UETP macro interface/]
	CALL UETSND
	 JRST [ HRROI T1,[ASCIZ/Error has occured/]
		PSOUT
		HALTF]
	HALTF
>
SUBTTL	MAIN ENTRY POINT AND INITIALIZATION

UETINI:
;INITIALIZE OUR PID

	MOVEI	T1,.MUCRE	;PARM FOR THE PID CREATE
	MOVEM	T1,IPCOM	;PLACE IN CONTROL BLOCK
	MOVE	T1,[.FHSLF]	;MAKE OUT PID JOB WIDE
	MOVEM	T1,IPCOM+1		;PLACE IN CONTROL BLOCK
	MOVEI	T1,3			;TWO WORD PARM
	MOVEI	T2,IPCOM		;ADDR OF PARM CONTROL BLOCK
	MUTIL				; JSYS-IPCF UTILITY- UP PID
	 ERJMP	[JSP	T4,ERROUT	;GET ERRMSG AND RETURN
		 RET]
	MOVE	T1,IPCOM+2		;LOAD THE JUST CREATED PID
	MOVEM	T1,OURPID		;AND SAVE PERMANENTLY

;	GET <SYSTEM>INFO PID

	MOVEI	T1,.MUGTI		;FUNCTION TO GET <SYSTEM>INFO PID
	MOVEM	T1,IPCOM		;PLACE IN CONTROL BLOCK
	MOVE	T1,OURPID		;GET OUR PID FOR IDENTIFICATION
	MOVEM	T1,IPCOM+1
	MOVEI	T1,3			;TWO WORD PARM
	MOVEI	T2,IPCOM		;ADDRESS OF PARM CONTROL BLOCK
	MUTIL				;JSYS- GET <SYSTEM>INFO PID
	 ERJMP	[JSP	T4,ERROUT	;GET ERRMSG AND RETURN
		 RET]
	MOVE	T1,IPCOM+2		;LOAD THE <SYSTEM>INFO PID
	MOVEM	T1,SYSPID		;SAVE IN PERMANENT STORAGE

;	GET PID OF THE UETP ("UETP-DIRECTORY #")

	MOVEI	Q1,IPCOM		;POINT TO BASE IPCF BLOCK
	MOVE	T1,[1234,,.IPCIW]	;IDENTITY CODE,,GET PID CODE
	MOVEM	T1,.IPCI0(Q1)		;INTO IPCF COMMUNICATION BLOCK
	SETZM	.IPCI1(Q1)		;NO ONE ELSE TO GET THIS RESPONSE
	SETZM	.IPCI2(Q1)		;[4] CLEAR WORD BEFORE SOUT
	HRROI	T1,.IPCI2(Q1)		;PLACE STRING IN THERE
	HRROI	T2,[ASCIZ/UETP-/]	;NAME WE WANT PID FOR
	SETZ	T3,			;WRITE ASCIZ STRING
	SOUT
	MOVE	Q2,T1			;SAVE THE STRING POINTER
	HRROI	T1,-1			;NOW GET DIRECTORY NUMBER WHICH
	MOVE	T2,[-1,,4]		;WILL GIVE US THE DIRECTORY NAME
	MOVEI	T3,.JIDNO
	GETJI
	 ERJMP	[JSP	T4,ERROUT	;GET ERRMSG AND RETURN
		 RET]
	MOVE	T1,Q2			;POINTER FOR WHERE IT'S GOING IN MSGBUF
	MOVE	T2,T4			;T4 HAS DIRECTORY NUMBER IN IT
	MOVE	T3,[NO%MAG+^D8]		;No magnitude, octal number
	NOUT
	 ERJMP	[JSP	T4,ERROUT	;GET ERRMSG AND RETURN
		 RET]
	;...
	;...

	MOVE	T1,[IPCOML,,IPCOM]	;LENGTH,,ADDRESS TO SUBROUTINE
	CALL	SYSEND			;SEND REQUEST TO <SYSTEM>INFO
	CALL	SYSRCV			;GO GET REPLY
	MOVE	T1,PDB			;GET <SYSTEM>INFO RESPONSE FLAGS
	TXNE	T1,IP%CFE		;SKIP IF NO ERRORS
	 JRST	[JSP	T4,ERROUT	;GET ERRMSG AND RETURN
		 RET]
	MOVE	T1,IPCOM+.IPCI1		;GET THE PID
	MOVEM	T1,UETPID		;AND SAVE FOR LATER USE
	RETSKP				;AND RETURN
SUBTTL   <SYSTEM>INFO SERVICE ROUTINES
; ROUTINES TO SEND AND RECIEVE <SYSTEM>INFO MESSAGES

; SEND THE MESSAGE TO <SYSTEM>INFO

SYSEND:	MOVEM	T1,SYSPDB+.IPCFP		;PARM PASSED IS MESSAGE 
	MOVE	T1,OURPID			;TELL <SYSTEM>INFO WHO WE ARE
	MOVEM	T1,SYSPDB+.IPCFS		;INTO CONTROL BLOCK
	SETZM	SYSPDB+.IPCFR			;ZERO MEANS GO TO <SYSTEM>INFO
	SETZM	SYSPDB+.IPCFL			;WE HAVE NO FLAGS TO PASS
	MOVEI	T1,PDBLEN			;LENGTH OF PDB
	MOVEI	T2,SYSPDB			;ADDRESS OF CONTROL BLOCK
	MSEND					; SEND THE MESSAGE
	 ERJMP	[JSP	T4,ERROUT		;GET ERRMSG AND RETURN
		 RET]
	MOVE	T1,SYSPDB+.IPCFL		;GET ERROR FLAGS
	AND	T1,[IP%CFE]			;ISOLATE ERROR FLAGS
	SKIPE	T1				;ANY ERROR IS FATAL
	 JRST	[HRROI T1,[ASCIZ/ERROR RETURN FROM MSEND JSYS AT SYSEND:/]
		 PSOUT
		 SETOM	T2			;INDICATE NON-JSYS ERROR
		 RET]			;SEND MSG TO CTY AND ABORT
	POPJ	P,				;RETURN

; RECIEVE MESSAGES FROM <SYSTEM>INFO

SYSRCV:						;ERROR IF NO MESSAGES
	MOVEM	T1,PDB+.IPCFL			;NO FLAGS 
	SETZM	PDB+.IPCFS			;ZERO OUT SENDER'S PID
	MOVE	T1,OURPID			;GET OUR PID
	MOVEM	T1,PDB+.IPCFR			;      INTO RECIEVER'S WORD
	MOVE	T1,[IPCOML,,IPCOM]		;LENGTH AND PLACE FOR MESSAGE
	MOVEM	T1,PDB+.IPCFP			;INTO THE CONTROL BLOCK
	MOVEI	T1,PDBLEN				;LENGTH OF PDB
	MOVEI	T2,PDB				;ADDRESS OF PDB
	MRECV					;GET THE MESSAGE
	 ERJMP	[JSP	T4,ERROUT		;GET ERRMSG AND RETURN
		 RET]
	MOVE	T1,PDB+.IPCFL			;GET THE FLAGS
	AND	T1,[IP%CFC]			;ISOLATE THE SYSTEM FLAGS
	CAIN	T1,<.IPCCF>B32			;SKIP IF NOT <SYSTEM>INFO MSG
	 POPJ	P,				;RETURN WITH <SYSTEM>INFO MSG
	HRROI	T1,[ASCIZ/?ERROR AT SYSRCV:, GETTING UNKNOWN IPCF MSG'S/]
	PSOUT
	JRST	SYSRCV				;GET NEXT MESSAGE
SUBTTL	UETSND - ROUTINE TO SEND MESSAGES TO THE UETP

;ACCEPTS:	T1/POINTER TO NAME OF TEST (MAX 6 CHARACTERS)
;		T2/POINTER TO MESSAGE TYPE (MAX 6 CHARACTERS)
;		T3/POINTER TO STRING TO BE SENT

;CALL:		CALL UETSND
;RETURNS:	+1,ALWAYS
;

UETSND:	SAVEAC <Q1,P1,P2,P3,P4>
	SETZM	MSGREC			;ZERO OUT THE ASCIZ FIELDS
	MOVE	P4,[MSGREC,,MSGREC+1]	;FOR THE BLT
	BLT	P4,MSGREC+RECLEN-1	;ZERO IT ALL
	DMOVEM 	T1,P1			;SAVE THE LENGTHS
	MOVE	T2,T3			;POINTER TO SOURCE INTO PARM REG	
	MOVEI	T3,RECLEN		;MAX BYTES TO MOVE (ASCIZ STRING)
	HRROI	T1,MSGREC		;DESTINATION POINTER
	SETZ	T4,
	SOUT				;GO WRITE THE BYTES
	MOVEI	T2,15			;ADD END OF LINE CHARACTER
	DPB	T2,T1			;AND ADD TO FIELD
	MOVEI	T2,12			;ADD END OF LINE CHARACTER
	IDPB	T2,T1			;AND ADD TO FIELD
	SUBI	T3,RECLEN		;COMPUTE BYTES ADDED
	MOVN	P3,30(T3)			;SAVE POSITIVE LENGTH
	HRROI	T1,DEFTYP		;NOW MOVE THE MESSAGE TYPE
	MOVE	T2,P2
	MOVEI	T3,6			;MAX OF SIX CHARACTERS
	SETZ	T4,
	SOUT
	HRROI	T1,TNAME		;NOW MOVE THE NAME OF THE TEST
	MOVE	T2,P1
	SETZ	T4,
	MOVEI	T3,6
	SOUT
	HRROI	T1,DATE			;TIME STAMP ALL RECORDS
	HRREI	T2,-1			;CURRENT DATE AND TIME
	SETZ	T3,			;DEFAULT FORMAT
	ODTIM				;GET THE TIME AND DATE INTO RECORD
	HRROI	T1,-5			;GET CPU TIME USED FOR WHOLE JOB
	RUNTM				;GO GET IT
	PUSH	P,T2			;SAVE FOR LATER COMPUTE
	; ...
	; ...
	IDIV	T1,T2			;CONVERT TO SECONDS
	HRROI	T4,CPUTIM		;WHERE TO PUT CPU TIME USED
	CALL	TIMOUT			;OUTPUT STRING
	POP	P,T2			;RETURN CONVERSION FACTOR
	MOVE	T1,T3			;MOVE CONSOLE TIME INTO PARM REG
	IDIV	T1,T2			;CONVERT TO SECONDS
	HRROI	T4,CNSTIM		;WHERE TO PUT CONSOLE TIME
	CALL	TIMOUT			;CONVERT TO ASCIZ AND OUTPUT
	SETZM	PDB+.IPCFL		;NO BITS TO SET
	MOVEI	Q1,RETRY		;LOAD THE RETRY COUNT FOR ERROR SENDS
	MOVE	T1,OURPID		;PUT OUR PID IN 
	MOVEM	T1,PDB+.IPCFS		;PDB SENDER FIELD
	MOVE	T1,UETPID		;DO THE SAME 
	MOVEM	T1,PDB+.IPCFR		;  FOR THE RECIEVER
	MOVEM	T1,PDB+.IPCFP		;SAVE THE INFO IN PDB POINTER FIELD
	MOVE	T1,[BASERC,,IPCFPG]	;COPY PAGE TO BE IPCF'ED
	BLT	T1,IPCFPG+777		;MOVE WHOLE PAGE
	MOVEI	Q1,RETRY		;LOAD THE RETRY COUNT FOR ERROR SENDS
	MOVX	T1,IP%CFV		;FLAG INDICATES SHIPPING ONE PAGE
	MOVEM	T1,PDB+.IPCFL		;NO FLAGS TO SET
	MOVE	T1,[1000,,<IPCFPG/1000>]	;SHIPPING ONE PAGE AT IPCFPG
	MOVEM	T1,PDB+.IPCFP		;SAVE THE INFO IN PDB POINTER FIELD
SENDIT:	MOVEI	T1,PDBLEN		;LENGTH OF PDB
	MOVEI	T2,PDB			;ADDRESS OF PDB
	MSEND				;SEND THE STRING
	 JRST	.+2			;ERROR - HANDLE WITH RETRIES
	RETSKP				;NO ERROR - ALL OK - RETURN
	CAIN	T1,IPCFX6		;WAS IT SEND QUOTA EXCEEDED?
	JRST	TRYAGN			;YES - WELL SEND ANOTHER ONE
	CAIN	T1,IPCFX7		;WAS IT RECEIVER'S QUOTA EXCEEDED?
	JRST	TRYAGN			;YES - WELL SEND ANOTHER ONE
	CAIN	T1,IPCFX8		;WAS IT IPCF FREE SPACE EXHAUSTED?
	JRST	TRYAGN			;YES - WELL SEND ANOTHER ONE
	CAIN	T1,IPCFX5		;WAS IT RECEIVER'S PID DISABLED
	JRST	TRYAGN			;YES - WELL SEND ANOTHER ONE 
TYPER:	HRROI	T1,[ASCIZ/?ERROR IN SENDING IPCF MESSAGES, AT SENDIT: ./]
	PSOUT
	SETOM	T2			;INDICATE NON-JSYS ERROR
	RET				;SEND ERROR MESSAGES AND ABORT
TRYAGN:	MOVEI	T1,100			;WE'LL WAIT .1 SECONDS BEFORE WE RETRY
	DISMS				;GO WAIT FOR THAT .1 SECONDS
	SOJG	Q1,SENDIT		;RETRY SENDING "RETRY" TIMES
	JRST	TYPER			;RETRIES FAILED TELL USER
SUBTTL	TIMOUT -  SUBROUTINE TO OUTPUT TIME IN T1 IN HH:MM:SS FORMAT
;
;ACCEPTS:	T1/ TIME TO BE OUTPUT IN SECONDS
;		T4/ OUTPUT DESTINATION POINTER
;
;CALL:		CALL	TIMOUT
;RETURNS:	+1,ALWAYS
;
TIMOUT:	SAVEAC	<T1,T2,T3>		;SAVE THE FIRST 3 AC'S
	MOVE	T2,T1			;MOVE FOR JSYS SENDING
	MOVE	T1,T4			;GET THE OUTPUT DESIGNATOR
	IDIVI	T2,^D3600		;GET THE HOURS QUANTITY
	PUSH	P,T3			;SAVE REMAINDER FOR LATER OUTPUT
	MOVEI	T3,^D10			;OUTPUT IN BASE 10
	NOUT				;OUTPUT THE NUMBER
	 ERJMP	[JSP	T4,ERROUT	;GET ERRMSG AND RETURN
		 RET]
	MOVEI	T2,":"			;OUTPUT COLON SEPERATOR
	BOUT				;OUTPUT THE BYTE
	POP	P,T2			;GET BACK REMAINDER AND INTO AC 2
	IDIVI	T2,^D60			;MAKE INTO MINUTES
	PUSH	P,T3			;SAVE REMAINDER (SECONDS)
	MOVE	T3,[NO%LFL+NO%ZRO+<FLD (2,NO%COL)>!^D10] ;FILL WITH ZEROES,2 COLS WIDE,BASE 10
	NOUT				;AND OUTPUT
	 ERJMP	[JSP	T4,ERROUT	;GET ERRMSG AND RETURN
		 RET]
	MOVEI	T2,":"			;OUTPUT ANOTHER SEPERATOR
	BOUT				;AND OUTPUT IT
	POP	P,T2			;RETRIEVE THE REMAINDER (SECONDS)
	NOUT				;AND OUTPUT IT
	ERJMP	[JSP	T4,ERROUT	;GET ERRMSG AND RETURN
		 RET]
	RET				;NORMAL RETURN
SUBTTL	ERROUT - GET THE LAST JSYS ERROR CODE AND RETURN


;ACCEPTS:
;RETURNS:	+1,ALWAYS T2/PROCESS HANDLE,,ERROR CODE

ERROUT:	MOVEI	T1,.FHSLF
	GETER
	RET
IFN TSTFLG,<
PDL:	BLOCK PDLEN		;PUSH DOWN POINTER
>
	IPCOML=20		;LENGTH OF IPCF COMMUNCATION BLOCK
IPCOM:	BLOCK	IPCOML		;COMMUNICATION BLOCK
	BLOCK 12		;THIS SPACE MUST BE AFTER IPCOM
OURPID:	BLOCK	1		;HOLD AREA FOR OUR PID
SYSPID:	BLOCK	1		;HOLD AREA FOR <SYSTEM>INFO PID
	PDBLEN=6		;LENGTH OF PDB BLOCKS
SYSPDB:	BLOCK	PDBLEN		;SYSTEM PACKET DESCRIPTOR BLOCK
PDB:	BLOCK	PDBLEN		;REGULAR PACKET DESCRIPTOR BLOCK
UETPID:	BLOCK	1		;PID FOR "UETP-..."
;
; THIS NEXT  SECTION MUST REMAIN IN IT'S CURRENT ORDER. EACH ITEM IS
; A FIELD IN A LARGER RECORD.
;
BASERC::
DEFTYP:	ASCII/          /		;DEFAULT MESSAGE TYPE VALUE
TNAME:	ASCII/          /		;DEFAULT TEST NAME
DATE:	ASCII/          /		;DATE OF RECORD
TIME:	ASCII/          /		;TIME OF MESSAGE
TDEPTH:	ASCII/          /		;DEPTH OF TEST
TSTLBL:	ASCII/          /		;DEFAULT TEST LABEL
CPUTIM:	ASCII/          /		;CPU TIME USED IN THIS JOB
CNSTIM:	ASCII/          /		;TOTAL CONSOLE TIME (ELAPSED TIME)
	BLOCK	1			;SPACER FOR TOKENIZING
MESVER:	EXP	2			;Message version
	BASESZ=.-BASERC			;SIZE OF BASE RECORD
	RECLEN=1000-<.-BASERC>		;RECORD LENGTH
MSGREC:	BLOCK	RECLEN			;AREA FOR EXTRACTED RECORD
;
; END OF ORDERED SECTION FOR OUTPUT RECORDS
;
	RELOC .!777+1-140
IPCFPG:	BLOCK 1000
DUMMY:	EXP 0

IFN TSTFLG,<
	END	START
>
;
;[END OF UETP-TALK.MAC]
;
SUBTTL MACRO DEFINITIONS

COMMENT	$
DEFINE A MACRO TO GENERATE A COMND FUNCTION DESCRIPTOR BLOCK WITH
AN EXTRA WORD AT BLOCK-1 TO USE FOR FINDING NEXT FUNCTION DESCRIPTOR 
BLOCK LIST
THIS BLOCK IS TO BE CALLED A PARSER DESCRIPTOR BLOCK (PDB)
$


;	!=======================================================!
;	!  FUNCTION   !  FUNCTION   ! ADDRESS OF NEXT FUNCTION  !
;	!    CODE     !    FLAGS    !     DESCRIPTOR BLOCK      !
;	!-------------------------------------------------------!
;	!              DATA FOR SPECIFIC FUNCTION               !
;	!-------------------------------------------------------!
;	!            POINTER TO HELP TEXT FOR FIELD             !
;	!-------------------------------------------------------!
;	!          POINTER TO DEFAULT STRING FOR FIELD          !
;	+-------------------------------------------------------+
;	!          SPECIAL ACTION ROUTINE FOR THIS PDB          !
;	!-------------------------------------------------------!
;	!              PDB DEFAULT FILLING ROUTINE              !
;	!-------------------------------------------------------!
;	!                     ERROR ROUTINE                     !
;	!-------------------------------------------------------!
;	!             CHAIN POINTER TO LINKED PDB'S             !
;	!=======================================================!

COMMENT	\
ARGUMENTS TO THE PDBDEF MACRO ARE:
TYP	TYPE OF FDB, IE. .CMKEY
FLGS	FUNCTION SPECIFIC FLAGS
DATA	FUNCTION SPECIFIC DATA
HLPM	BYTE POINTER FOR HELP TEXT
DEFM	POINTER TO DEFAULT
LST	POINTER TO ALTERNATE FDB
NXT	PTR TO NEXT FDB (OPTIONAL FOR TYPE .CMKEY OR .CMSWI)
ERRTN	ROUTINE IF AN ERROR IS GOTTEN POINTING TO THIS PDB
RTN	SPECIAL ACTION ROUTINE FOR THIS PDB
DEFR	SPECIAL ROUTINE TO FILL IN DEFAULTS FOR THIS PDB
\
DEFINE PDBDEF(TYP,FLGS,DATA,HLPM,DEFM,LST,NXT,ERRTN,RTN,DEFR),<
	XLIST

;THE NEXT FEW LINES ARE COPIED FROM MONSYM FOR THE FLDDB. MACRO
	..XX==<FLD(TYP,CM%FNC)>+FLGS+<Z LST>
   IFNB <HLPM>,<..XX=..XX+CM%HPP>
   IFNB <DEFM>,<..XX=..XX+CM%DPP>
	..XX
   IFNB <DATA>,<DATA>
   IFB <DATA>,<0>
   IFNB <HLPM>,<POINT 7,[ASCIZ \HLPM\]>
   IFB <HLPM>,<0>
   IFNB <DEFM>,<POINT 7,[ASCIZ \DEFM\]>
   IFB <DEFM>,<0>
;THE REST OF THE DEFINITION IS NOT USED BY THE JSYS BUT ONLY BY THE PARSER

   IFB <RTN>,<0>
   IFNB <RTN>,<Z RTN>
   IFB <DEFR>,<0>
   IFNB <DEFR>,<Z DEFR>
   IFB <ERRTN>,<0>
   IFNB <ERRTN>,<Z ERRTN>
   IFB <NXT>,<0>
   IFNB<NXT><Z NXT>
	LIST
>;END OF DEFINITION OF PDBDEF MACRO
SUBTTL	PDB  --  PARSER DESCRIPTOR BLOCK

;THIS BLOCK IS DEFINED BY THE PDBDEF MACRO
;THE SYMBOLS HERE ARE FOR REFERENCING IT

	PHASE	0

PDB.FD:!	BLOCK	.CMDEF+1 ;ALLOCATE SPACE FOR AN FDB
PDB.RT:!	BLOCK	1	;SPECIAL ACTION ROUTINE ADDRESS
PDB.DF:!	BLOCK	1	;DEFAULT FILLING ROUTINE ADDRESS
PDB.ER:!	BLOCK	1	;ERROR MESSAGE ROUTINE ADDRESS
PDB.NX:!	BLOCK	1	;ADDRESS OF PDB TO USE NEXT
PDB.SZ:!			;SIZE OF A PDB

	DEPHASE
SUBTTL COMMAND FUNCTION MACROS

DEFINE $KEYDSP (TABLE) <
	PDBDEF (.CMKEY,,TABLE)>

DEFINE $KEY (NXT,TABLE) <
	PDBDEF (.CMKEY,,TABLE,,,,NXT)>

DEFINE $NUMBER (NXT,RADIX,HELP) <
IFB <HELP>,<PDBDEF (.CMNUM,,RADIX,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMNUM,CM%SDH,RADIX,<HELP>,,,NXT)>>

DEFINE $NOISE (NXT,TEXT) <
	PDBDEF (.CMNOI,,<POINT 7,[ASCIZ/TEXT/]>,,,,NXT)>

DEFINE $SWITCH (NXT,TABLE) <
	PDBDEF (.CMSWI,,TABLE,,,,,NXT)>

DEFINE $IFILE (NXT,HELP) <
IFB <HELP>,<PDBDEF (.CMIFI,,,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMIFI,CM%SDH,,<HELP>,,,NXT)>>

DEFINE $OFILE (NXT,HELP) <
IFB <HELP>,<PDBDEF (.CMOFI,,,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMOFI,CM%SDH,,<HELP>,,,NXT)>>

DEFINE $FIELD (NXT,HELP) <
IFB <HELP>,<PDBDEF (.CMFLD,,,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMFLD,CM%SDH,,<HELP>,,,NXT)>>

DEFINE $CRLF <
	PDBDEF (.CMCFM)>

DEFINE $DIR (NXT) <
	PDBDEF (.CMDIR,,,,,,NXT)>

DEFINE $USER (NXT) <
	PDBDEF (.CMUSR,,,,,,NXT)>

DEFINE $COMMA (NXT) <
	PDBDEF (.CMCMA,,,,,,NXT)>

DEFINE $INIT (NXT) <
	PDBDEF (.CMINI,,,,,,NXT)>

DEFINE $FLOAT (NXT,HELP) <
IFB <HELP>,<PDBDEF (.CMFLT,,,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMFLT,CM%SDH,,<HELP>,,,NXT)>>

DEFINE $DEV (NXT) <
	PDBDEF (.CMDEV,,,,,,NXT)>

DEFINE $TEXT (NXT,HELP) <
IFB <HELP>,<PDBDEF (.CMTXT,,,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMTXT,CM%SDH,,<HELP>,,,NXT)>>

DEFINE $DATE (NXT) <
	PDBDEF (.CMTAD,,CM%IDA,,,,NXT)>

DEFINE $TIME (NXT) <
	PDBDEF (.CMTAD,,CM%ITM,,,,NXT)>

DEFINE $TAD (NXT) <
	PDBDEF (.CMTAD,,<CM%IDA!CM%ITM>,,,,NXT)>

DEFINE $QUOTE (NXT,HELP) <
IFB <HELP>,<PDBDEF (.CMQST,,,,,,NXT)>
IFNB <HELP>,<PDBDEF (.CMQST,CM%SDH,,<HELP>,,,NXT)>>

DEFINE $TOKEN (NXT,CHAR) <
	PDBDEF (.CMTOK,,<CHAR>,,,,NXT)>

DEFINE DSPTAB (NXT,CODE,KEY) <
	XWD [ASCIZ\KEY\],[XWD CODE,NXT]>

DEFINE KEYTAB (CODE,KEY)	<
	XWD [ASCIZ\KEY\],CODE>

DEFINE $STAB (%X,%Y) <
	%X==.
	XWD %Y-1,%Y-1
	DEFINE $ETAB <
	%Y==.-%X>>
;PARSE DEFINITIONS

;DEFSTR DEFINITIONS

MSKSTR (CMFNC,.CMFNP,CM%FNC)	;COMMAND FUNCTION CODE
MSKSTR (CMLST,.CMFNP,CM%LST)	;ADR OF FUNCTION DESCRIPTOR BLOCK
DEFSTR (CMDAT,.CMDAT,35,36)	;COMMAND DATA

DEFSTR (PDBER,PDB.ER,35,36)	;ERROR MESSAGE ROUTINE ADDRESS
DEFSTR (PDBNX,PDB.NX,35,36)	;ADR OF NEXT PDB
DEFSTR (PDBDF,PDB.DF,35,36)	;ADR OF DEFAULT FILLING ROUTINE

	SUBTTL Constant Definitions

NCHPW==5			;NUMBER OF ASCII CHARACTERS PER WORD
BUFSIZ==200			;SIZE OF INPUT TEXT BUFFER
ATMSIZ==BUFSIZ			;SIZE OF ATOM BUFFER FOR COMND JSYS
GJFSIZ==.GJRTY+2		;SIZE OF GTJFN BLOCK USED BY COMND JSYS
FDBSIZ==.CMDEF+2		;SIZE OF FUNCTION DESCRIPTOR BLOCK
	SUBTTL Local Storage

;STORAGE FOR PARSER TO EVENT PROCESSOR COMMUNICATION

ZERBEG==.			;START OF AREA TO BE ZEROED

PARFRE:	BLOCK 1			;POINTER TO FIRST FREE IN COMM BLOCK
ARGFRE:	BLOCK 1			;POINTER TO FIRST FREE WORD IN ARG SPACE
JFNFRE:	BLOCK 1			;IOWD POINTER TO JFN STACK

	JFNSTL==40		;LENGTH OF JFNSTK
JFNSTK:	BLOCK JFNSTL		;LIST OF ALL STACKED JFNS

PARBLK:	BLOCK 50		;SPACE FOR COMM BLOCK
ARGBLK:	BLOCK 400		;SPACE FOR ARGUMENTS (ASCIZ, ETC.)
ARGEND==.-1			;WHERE TO STOP ZEROING

;STORAGE FOR THE PARSER

CMDBLK:	BLOCK .CMGJB+5		;COMMAND STATE BLOCK FOR COMND JSYS
BUFFER:	BLOCK BUFSIZ		;INPUT TEXT STORED HERE
ATMBFR:	BLOCK ATMSIZ		;ATOM BUFFER FOR COMND JSYS
GJFBLK:	BLOCK GJFSIZ		;GTJFN BLOCK FOR COMND JSYS

ZEREND==.			;END OF AREA TO BE ZEROED
	SUBTTL Main ROUTINE

;ROUTINE TO PARSE A COMMAND
;ACCEPTS IN T1/	STRING POINTER TO PROMPT
;	    T2/	POINTER TO THE COMMAND "PDB" CHAIN
;	    T3/	ADDRESS OF WHERE TO STORE THE PARSED COMMAND
;	CALL PARSE
;RETURNS +1:	FAILED - COMMAND "PDB" BLOCK DID NOT START WITH A .CMINI
;	 +2:	OK, PARSED COMMAND IS STORED IN BLOCK GIVEN IN T3
;		T1/	POINTER TO THE COMMAND STRING

PARSE::	SAVEPQ			;SAVE ALL PERMANENT ACS
	STKVAR <PARCMT,PARADR>
	MOVEM T2,PARCMT		;SAVE POINTER TO THE COMMAND TABLE
	MOVEM T3,PARADR		;SAVE POINTER TO WHERE TO BUILD THE PARAMETER BLOCK
	LOAD T4,CMFNC,(T2)	;GET THE FIRST FUNCTION CODE
	CAIE T4,.CMINI		;IT MUST BE AN INI FUNCTION
	RET			;IF NOT, THEN GIVE ERROR RETURN

;NOW SET UP THE COMMAND STATE BLOCK

	MOVE T4,[ZERBEG,,ZERBEG+1]
	SETZM ZERBEG		;FIRST ZERO ALL STORAGE USED
	BLT T4,ZEREND-1
	MOVEM T1,CMDBLK+.CMRTY	;PUT RE-TYPE PROMPT POINTER IN STATE BLOCK
	HRROI T1,BUFFER		;GET POINTER TO INPUT TEXT BUFFER
	MOVEM T1,CMDBLK+.CMPTR	;SAVE POINTER TO COMMAND STRING
	MOVEM T1,CMDBLK+.CMBFP	;SAVE POINTER TO START-OF-BUFFER
	MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,, OUTPUT JFN'S
	MOVEM T1,CMDBLK+.CMIOJ	;SAVE PRIMARY JFN'S
	MOVEI T1,REPARS		;GET RE-PARSE ADDRESS
	MOVEM T1,CMDBLK+.CMFLG	;SAVE RE-PARSE ADDRESS
	SETZM CMDBLK+.CMINC	;INITIALIZE # OF CHARACTERS AFTER POINTER
	MOVEI T1,BUFSIZ*NCHPW	;GET # OF CHARACTERS IN BUFFER AREA
	MOVEM T1,CMDBLK+.CMCNT	;SAVE INITIAL # OF FREE CHARACTER POSITIONS
	HRROI T1,ATMBFR		;GET POINTER TO ATOM BUFFER
	MOVEM T1,CMDBLK+.CMABP	;SAVE POINTER TO LAST ATOM INPUT
	MOVEI T1,ATMSIZ*NCHPW	;GET # OF CHARACTERS IN ATOM BUFFER
	MOVEM T1,CMDBLK+.CMABC	;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
	MOVEI T1,GJFBLK		;GET ADDRESS OF GTJFN BLOCK
	MOVEM T1,CMDBLK+.CMGJB	;SAVE IN COMMAND STATE BLOCK
	MOVE T1,[IOWD JFNSTL,JFNSTK]
	MOVEM T1,JFNFRE		;SET UP POINTER TO JFN STACK
PARSER:	MOVEI P1,CMDBLK		;COMND STATE BLOCK
	MOVE P2,PARCMT		;INITIAL PDB TO FEED TO COMND
	CALL RELJFN		;RELEASE ALL JFNS ON THE STACK
PARS.1:	DMOVE T1,P1		;COPY THE COMND ARGS
	COMND			;PARSE NEXT FIELD
	  ERJMP CMDERR		;ERROR, SEE WHY
	TXNN T1,CM%NOP		;VALID COMMAND ENTERED ?
	JRST PARS.3		;YES, GO DISPATCH TO PROCESSING ROUTINE
	LOAD P2,PDBER,(P2)	;GET ADDR OF SPECIAL ERROR ROUTINE
	JUMPE P2,PARS.2		;IF NO ROUTINE JUST TYPE COMMAND ERROR
	CALL (P2)		;CALL THE ROUTINE
	JRST PARSER		;GO TRY TO GET A COMMAND AGAIN
PARS.2:	HRROI T1,[ASCIZ/
?COMMAND ERROR: /]
	PSOUT
	MOVX T1,.PRIOU		;TO PRIMARY OUTPUT
	MOVE T2,[.FHSLF,,-1]	;OUR LAST ERROR
	ERSTR			;TYPE OUT THE ERROR STRING
	 JRST [	CALL ERRUEN	;UNDEFINED ERROR NUMBER
		JRST PARSER]
	 JRST [	CALL ERRBDD	;BAD DESTINATION DESIGNATOR
		JRST PARSER]
	JRST PARSER		;AND TRY AGAIN


;HERE ON SUCCESSFUL PARSE FROM COMMAND JSYS

PARS.3:	MOVE P2,T2		;COPY DATA TO P2
	MOVE P4,T3		;SAVE POINTER TO FUNCTION BLOCK
	LOAD P3,CMFNC,(P4)	;GET THE COMMAND FUNCTION CODE
	MOVE T1,P3		;COPY FUNCTION TO T1
	MOVE T2,P2		;AND DATA TO T2
	CALL @PARTAB(T1)	;DISPATCH OFF FUNCTION
	MOVE T1,P3		;COPY FUNCTION TO T1
	MOVE T2,P2		;AND DATA TO T2
	SKIPE T4,PDB.RT(P4)	;GET SPECIAL ROUTINE ADDRESS FROM PDB
	CALL (T4)		;CALL THE SPECIAL ROUTINE IF THERE
	HRRZ P2,(P2)		;GET CONTENTS OF RETURNED DATA
	LOAD T1,PDBNX,(P4)	;GET NEXT FDB IF ANY
	JUMPN T1,PARS.4		;USE IT IF ONE IS SPECIFIED
	CAIE P3,.CMKEY		;KEYWORD
	CAIN P3,.CMSWI		;OR SWITCH ?
	SKIPA T1,(P2)		;YES, USE DATA IN KEYTAB AS FDB ADR
	LOAD T1,PDBNX,(P4)	;NO, GET NEXT FDB FROM CURRENT
	JUMPE T1,PARS.5		;IF NO NEXT PDB, GO BUILD ANSWER
PARS.4:	HRRZS P2,T1		;PASS ONLY RIGHT HALF
	CALL FILDEF		;GO FILL IN ANY DEFAULTS NEEDED
	JRST PARS.1		;AND FINISH COMMAND
PARS.5:	MOVE T1,PARADR		;GET ADR OF WHERE TO BUILD BLOCK
	CALL BLDCOM		;GO BUILD A COMMAND MESSAGE
	MOVE T1,[POINT 7,BUFFER] ;RETURN POINTER TO THE COMMAND
	RETSKP			;DONE
	SUBTTL Routine to Take a Parser Block and Build a Command Message

;ROUTINE TO BUILD THE PARSED BLOCK
;ACCEPTS IN T1/	ADR OF WHERE TO PUT THE BUILT BLOCK
;	ASSMUES ALL DATA IS SET UP IN AGRBLK
;RETURNS +1:	ALWAYS

BLDCOM:	SAVEP			;SAVE NEEDED AC'S
	MOVE P1,PARFRE		;COMPUTE LENGTH OF
	SUBI P1,PARBLK		;PARSER BLOCK
	MOVE P2,ARGFRE		;GET END OF ARG SPACE
	SUBI P2,ARGBLK		;COMPUTE LENGTH
	MOVE P3,P1		;TAKE COPY OF PARSER BLOCK LENGTH
	MOVNS P1		;MAKE P1 NEGATIVE FOR AOBJN
	HRLS P1			;MAKE AOBJN POINTER
	HRRI P1,PARBLK		;POINT TO PARBLK (PARSER DATA BLOCK)
BLDC.1:	MOVE T4,(P1)		;GET DATA
	HLRZ Q1,T4		;GET CODE
	CAIE Q1,.CMSWI		;SWITCH?
	CAIN Q1,.CMKEY		;OR KEYWORD?
	JRST BLDC.2		;YES, NO OFFSET NEEDED
	CAIE Q1,.CMCFM		;CONFIRM?
	CAIN Q1,.CMCMA		;OR COMMA?
	JRST BLDC.2		;YES, NO OFFSET NEEDED
	ADD T4,P3		;ADD IN OFFSET
BLDC.2:	MOVEM T4,(T1)		;COPY TO IPCF PAGE
	ADDI T1,1		;INCREMENT IPCF PAGE POINTER
	AOBJN P1,BLDC.1		;LOOP FOR ALL
	MOVNS P2		;GET NEGATIVE LENGTH OF DATA AREA
	HRLZS P2		;MAKE AN AOBJN POINTER
BLDC.3:	MOVE T4,ARGBLK(P2)	;GET CURRENT WORD INTO T4
	MOVEM T4,(T1)		;SAVE IN MESSAGE BEING BUILT
	ADDI T1,1		;INCREMENT POINTER TO MESSAGE
	AOBJN P2,BLDC.3		;AND STEP THRU DATA 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:	CALL RELJFN		;RELEASE ALL JFNS SO FAR
	CALL @.CMINI+PARTAB	;TELL SAVE ROUTINES TO FORGET IT
	MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
	SETZM GJFBLK		;CLEAR FIRST WORD
	BLT T1,GJFBLK+GJFSIZ-1	;CLEAR THE BLOCK
	MOVEI P1,CMDBLK		;GET STATE BLOCK ADDRESS
	MOVE P2,PARCMT		;GET INITIAL COMMAND TABLE POINTER
	LOAD P2,PDBNX,(P2)	;STEP TO BLOCK AFTER .CMINI
	JRST PARS.1		;JUST RESTART PARSER


;ROUTINE TO RELEASE ALL JFNS STACKED SO FAR

RELJFN:	MOVSI T4,JFNSTL		;SET UP AN AOBJN POINTER TO JFN STACK
RELJFL:	SKIPE T1,JFNSTK(T4)	;IS THERE A JFN HERE?
	RLJFN			;YES, RELEASE IT
	 JFCL
	SETZM JFNSTK(T4)	;ZERO THE STACK
	AOBJN T4,RELJFL		;LOOP BACK FOR ALL OF THEM
	MOVE T1,[IOWD JFNSTL,JFNSTK]
	MOVEM T1,JFNFRE		;INIT STACK POINTER
	RET			;DONE
	SUBTTL Routine To Fill in Defaults for COMND

;ROUTINE TO FILL IN DEFAULTS IF NEEDED
;CALLED WITH P2 POINTING TO PDB ABOUT TO BE FED TO COMND
;FILLS IN ALL DEFAULTS FOR THE NEXT SET OF LINKED PDB'S

FILDEF:	MOVE T1,P2		;COPY THE PDB ADDRESS
FILD.1:	LOAD T2,PDBDF,(T1)	;GET THE ADDR OF THE DEFAULT FILLING ROUTINE
	JUMPE T2,FILD.2		;NONE THERE, LOOK FOR LINKED PDB'S
	PUSH P,T1		;SAVE ADR OF PDB
	MOVE T1,P1		;GET ADR OF COMND STATE BLOCK
	CALL (T2)		;CALL THE DEFAULT FILLER
	POP P,T1
FILD.2:	LOAD T1,CMLST,(T1)	;GET THE ADDR OF NEXT PDB IN LIST
	JUMPN T1,FILD.1		;LOOP IF THERE IS ONE
	RET			;AND RETURN
;CMDERR - ROUTINE TO PROCESS ERRORS ON EXECUTING A COMND JSYS
;	  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 CMDERR

CMDERR:	HRROI T1,[ASCIZ/
?COMMAND ERROR: /]
	PSOUT
	MOVX T1,.PRIOU		;TO PRIMARY OUTPUT
	MOVE T2,[.FHSLF,,-1]	;OUR LAST ERROR
	ERSTR			;TYPE OUT THE ERROR STRING
	 JRST [	CALL ERRUEN	;UNDEFINED ERROR NUMBER
		JRST PARSER]
	 JRST [	CALL ERRBDD	;BAD DESTINATION DESIGNATOR
		JRST PARSER]
	JRST PARSER		;GO START OVER AGAIN
	SUBTTL ERROR ROUTINES

BADCOM::	HRROI T1,[ASCIZ/
?INVALID COMMAND "/]
	PSOUT
	HRROI T1,ATMBFR
	PSOUT
	HRROI T1,[ASCIZ/" /]
	PSOUT
	RET
BADIFI:: MOVX T1,GJ%OFG		;PARSE-ONLY GTJFN
	MOVEM T1,GJFBLK+.GJGEN	;IN FLAGS WORD
	MOVE T1,[XWD .NULIO,.NULIO] ;SUPPLY NO JFNS
	MOVEM T1,GJFBLK+.GJSRC	;INTO BLOCK
	MOVEI T1,GJFBLK		;GTJFN BLOCK ADDRESS
	HRROI T2,ATMBFR		;STRING POINTER TO ATOM BUFFER
	GTJFN			;GET A JFN
	  JRST BADI.1		;JUST DO THE ERSTR
	HRROI T1,[ASCIZ/
?CAN'T FIND FILE "/]
	PSOUT
	HRRZ T2,T1		;MOVE JFN TO T2 FOR JFNS
	MOVEI T1,.PRIOU		;TO PRIMARY OUTPUT
	MOVE T3,[111100,,1]	;GET OUT EVERYTHING UP TO THE PROTECTION
	JFNS			;MAKE THE JFN INTO A STRING
	HRROI T1,[ASCIZ/"
	/]
	PSOUT
BADI.1:	MOVX T1,.PRIOU		;TO PRIMARY OUTPUT
	MOVE T2,[.FHSLF,,-1]	;OUR LAST ERROR
	ERSTR			;TYPE OUT THE ERROR STRING
	 CALLRET ERRUEN		;UNDEFINED ERROR NUMBER
	 CALLRET ERRBDD		;BAD DESTINATION DESIGNATOR
	RET

;ERSTR JSYS FAILURE ROUTINES

ERRBDD:	SKIPA T1,[-1,,[ASCIZ/ERSTR Jsys Failure, Bad Destination Designator/]]
ERRUEN:	HRROI T1,[ASCIZ/ERSTR Jsys Failure, Undefined Error Number/]
	PSOUT
	RET
	SUBTTL Dispatch for Parser Save Routines

COMMENT \

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 THESE ROUTINES ARE CALLED WITH T1 CONTAINING THE COMND FUNCTION CODE
;USED TO PARSE THE LAST FIELD AND T2 CONTAINING THE DATA RETURNED BY COMND
;T3 MUST CONTAIN THE ADDRESS OF THE FDB USED BY COMND TO PARSE THE FIELD

PARTAB:	SAVIND			;KEYWORD (.CMKEY)
	SAVNUM			;NUMBER  (.CMNUM)
	R			;NOISE WORD (.CMNOI) (NO PROCESSING)
	SAVIND			;SWITCH (.CMSWI)
	SAVJFN			;INPUT FILE SPEC (.CMIFI)
	SAVJFN			;OUTPUT FILE SPEC (.CMOFI)
	SAVJFN			;GENERAL FILE SPEC (.CMFIL)
	SAVATM			;ARBITRARY FIELD (.CMFLD)
	SAVZER			;CONFIRM (.CMCFM)
	SAVRSS			;DIRECTORY (.CMDIR)
	SAVRSS			;USER NAME (.CMUSR)
	SAVZER			;COMMA (.CMCMA)
	SAVINI			;INITIALIZATION (.CMINI)
				;THIS IS CALLED TO INITIALIZE SAVE STUFF
	SAVRES			;FLOATING POINT NUMBER (.CMFLT)
	SAVRES			;DEVICE NAME (.CMDEV)
	SAVATM			;TEXT TO CARRAIGE RETURN (.CMTXT)
	SAVRES			;DATE AND TIME (.CMTAD)
	SAVATM			;QUOTED STRING (.CMQST)
	R			;***RET FOR NOW***;UNQUOTED STRING (.CMUQS)
	SAVTOK			;TOKEN (.CMTOK)
	SAVNUM			;NUMBER (ARBITRARY TERMINATOR) (.CMNUX)
	R			;(.CMACT)
	SAVATM			;NODE NAME(.CMNOD)
	SUBTTL Save Routines

;DATA RETURNED IS A POINTER INTO A TABLE (SWITCH OR KEYWORD)
SAVIND:	HRRZ T2,(T2)		;GET INDIRECT ADDRESS
	LOAD T4,PDBNX,(T3)	;GET THE NEXT FDB FROM THIS ONE
	SKIPN T4		;IF ONE THERE, STORE ADDRESS INSTEAD
	HLRZ T2,(T2)		;FETCH CODE SET UP BY KEYTAB MACRO
	JRST MAKENT		;AND MAKE THE ENTRY

;SAVE ROUTINES FOR FUNCTIONS WHICH COPY VALUE TO ATOM BUFFER
;(.CMFLD, .CMTXT, .CMQST)
SAVATM:	SAVEP			;SAVE NEEDED REGS
	MOVE T2,ARGFRE		;GET FIRST FREE ARG LOCATION
	HRLI T2,(POINT 7,)	;MAKE T2 A BYTE POINTER
	MOVE P1,[POINT 7,ATMBFR] ;POINT AT THE ATOM BUFFER
SAVA.1:	ILDB P2,P1		;GET A CHARACTER FROM THE ATOM BUFFER
	IDPB P2,T2		;SAVE IT IN THE ARGUMENT SPACE
	JUMPN P2,SAVA.1		;AND LOOP IF MORE
	HRRZI T2,1(T2)		;STEP TO NEXT LOC AND CLEAR LH
	EXCH T2,ARGFRE		;STORE NEXT FREE AND GET FIRST USED
	SUBI T2,ARGBLK		;CONVERT TO RELATIVE ADDRESS
	JRST MAKENT		;AND MAKE THE ENTRY

;SAVE A ZERO (CONFIRM OR COMMA, FUNCTION TELLS ALL)
SAVZER:	SETZ T2,		;JUST A ZERO
	JRST MAKENT		;GO MAKE AN ENTRY

;SAVE ROUTINE FOR NUMBERS
SAVNUM:	SAVEP			;SAVE AN AC
	LOAD P1,CMDAT,(T3)	;GET THE RADIX USED
	DPB P1,[POINT 9,T1,26]	;SAVE IT WITH FUNCTION
;AND FALL INTO SAVRES

;ROUTINE TO STACK A JFN

SAVJFN:	MOVE T4,JFNFRE		;GET POINTER TO JFN STACK
	PUSH T4,T2		;STACK THE JFN
	MOVEM T4,JFNFRE		;STORE THE UPDATED STACK POINTER
	JRST SAVRES		;GO SAVE THE JFN IN THE ANSWER BLOCK

;SAVE ROUTINES WHICH SAVE A POINTER TO WHAT COMND RETURNS IN AC2
;(FLOATING NUMBER, DATE/TIME, DEVICE, FILE SPECS)
SAVRES:	SAVEP			;SAVE A WORKING REG
	MOVE P1,ARGFRE		;GET THE NEXT FREE ARG BLOCK WORD
	MOVEM T2,(P1)		;SAVE THE RESULT OF COMND THERE
	MOVE T2,P1		;GET ADDR USED INTO T2
	SUBI T2,ARGBLK		;MAKE IT THE OFFSET INTO ARGBLK
	AOS ARGFRE		;STEP FREE LOC UP ONE
	JRST MAKENT		;AND GO MAKE THE ENTRY

;ROUTINE TO SAVE ANSWER AND ATOM BUFFER
;(USER, DIRECTORY)
SAVRSS:	SAVEP			;SAVE A WORKING REG
	MOVE P1,ARGFRE		;GET THE NEXT FREE ARG BLOCK WORD
	MOVEM T2,(P1)		;SAVE THE RESULT OF COMND THERE
	AOS T2,ARGFRE		;STEP FREE LOC UP ONE
	HRLI T2,(POINT 7,)	;MAKE T2 A BYTE POINTER
	MOVE P1,[POINT 7,ATMBFR] ;POINT AT THE ATOM BUFFER
SAVR.1:	ILDB P2,P1		;GET A CHARACTER FROM THE ATOM BUFFER
	IDPB P2,T2		;SAVE IT IN THE ARGUMENT SPACE
	JUMPN P2,SAVR.1		;AND LOOP IF MORE
	HRRZI T2,1(T2)		;STEP TO NEXT LOC AND CLEAR LH
	EXCH T2,ARGFRE		;STORE NEXT FREE AND GET FIRST USED
	SUBI T2,ARGBLK+1	;CONVERT TO RELATIVE ADDRESS
	JRST MAKENT		;AND MAKE THE ENTRY

;SAVE A TOKEN
SAVTOK:	SAVEP			;SAVE SOME WORKING SPACE
	MOVE T2,ARGFRE		;GET SPACE TO STORE ARG TO T2
	HRLI T2,(POINT 7,)	;MAKE IT A BYTE POINTER
	LOAD P2,CMDAT,+PDB.FD(T2) ;GET THE DATA USED BY COMND
	HRLI P2,(POINT 7,)	;MAKE IT A BYTE POINTER
SAVT.1:	ILDB P1,P2		;GET A CHARACTER
	IDPB P1,T2		;AND SAVE IT AWAY
	JUMPN P1,SAVT.1		;LOOP IF NOT DONE
	HRRZI T2,1(T2)		;POINT T2 TO FIRST FREE LOC
	EXCH T2,ARGFRE		;AND CHANGE IT WITH FIRST USED
	SUBI T2,ARGBLK		;CONVERT TO RELATIVE ADDRESS
	JRST MAKENT		;AND GO MAKE ENTRY
	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:	MOVEI T1,ARGBLK		;GET THE ADDRESS OF THE ARGUMENT STORAGE
	MOVEM T1,ARGFRE		;SAVE AS FIRST FREE PLACE TO SAVE STUFF
	MOVEI T1,PARBLK		;GET ADDRESS OF PARSER COMMUNICATIONS BLOCK
	MOVEM T1,PARFRE		;SAVE AS FIRST FREE LOC IN THAT BLOCK
	MOVE T1,[PARBLK,,PARBLK+1] ;GET START OF BLOCK TO CLEAR
	SETZM (T1)		;CLEAR FIRST WORD
	BLT T1,ARGEND		;CLEAR TO END OF ARGUMENT SPACE
	RET			;AND RETURN
	SUBTTL MAKENT  --  Routine To Make an Entry for Parser Save Routines

;THIS ROUTINE IS CALLED WITH T2 CONTAINING WHAT WILL BE THE RIGHT HALF
;OF THE ENTRY AND T1 CONTAINING THE LEFT HALF.

MAKENT:	HRRZM T2,@PARFRE	;SAVE THE RIGHT HALF
	HRLM T1,@PARFRE		;SAVE THE LEFT HALF
	AOS PARFRE		;UPDATE THE FREE POINTER
	RET			;RETURN
;SUPPORT ROUTINES

SAVPQ:	PUSH P,Q1
	PUSH P,Q2
	PUSH P,Q3
	PUSH P,P1
	PUSH P,P2
	PUSH P,P3
	PUSH P,P4
	PUSH P,P5
	PUSH P,P6
	CALL 0(CX)
	 SKIPA
	AOS -11(P)
	POP P,P6
	POP P,P5
	POP P,P4
	POP P,P3
	POP P,P2
	POP P,P1
	POP P,Q3
	POP P,Q2
	POP P,Q1
	RET

SAVP:	PUSH P,P1
	PUSH P,P2
	PUSH P,P3
	PUSH P,P4
	PUSH P,P5
	PUSH P,P6
	CALL 0(CX)
	 SKIPA
	AOS -6(P)
	POP P,P6
	POP P,P5
	POP P,P4
	POP P,P3
	POP P,P2
	POP P,P1
	RET
;COMMAND TABLE

COMTAB:	$INIT (COMTB1)
COMTB1:	$KEYDSP (COMTB2)
COMTB2:	$STAB
	DSPTAB (COMTC1,CONN,<CONNECT>)
	DSPTAB (COMTE1,EXITC,<EXIT>)
	DSPTAB (COMTU1,UPDATE,<UPDATE>)
	DSPTAB (COMTV1,VERIFY,<VERIFY>)
	$ETAB


COMTC1:	$NOISE (COMTC2,<TO UETP USING NAME>)
COMTC2:	$FIELD (COMCR,<NAME WHICH UETP WILL USE TO REFERENCE THIS PROGRAM>)

COMTE1:	$NOISE (COMCR,<FROM VERIFY PROGRAM>)

COMTU1:	$NOISE (COMTU2,<FILE LIST>)
COMTU2:	$IFILE (COMCR)

COMTV1:	$NOISE (COMTV2,<FILE LISTS>)
COMTV2:	PDBDEF (.CMFIL,,,,,,COMCR,,,SETIFG)

COMCR:	$CRLF


;ROUTINE TO SET THE PROPER FLAGS IN THE GTJFN BLOCK
;ACCEPTS IN T1/	ADR OF THE COMND STATE BLOCK

SETIFG:	MOVE T1,.CMGJB(T1)	;GET THE ADR OF THE GTJFN BLOCK
	MOVX T2,GJ%OLD!GJ%IFG!GJ%FLG
	MOVEM T2,.GJGEN(T1)	;STORE THE GTJFN FLAGS
	RET			;DONE



;VARIABLES

	PDLEN==400
PDL:	BLOCK PDLEN

UETPF:	0			;FLAG TO CAUSE MESSAGES TO GO TO UETP
NAME:	BLOCK 2			;NAME STRING FOR UETP TO USE
USTRNG:	BLOCK 100		;MESSAGE STRING FOR UETP MESSAGES
ANSWER:	BLOCK 200		;ANSWER BLOCK

	END <3,,ENTVEC>