Google
 

Trailing-Edge - PDP-10 Archives - BB-H311D-RM - swskit-tools/zsubs.mac
There are 3 other files named zsubs.mac in the archive. Click here to see a list.
IFNDEF REL,<REL==0>		;BUILD UNIVERSAL BY DEFAULT
   IFE REL,<	UNIVERSAL ZSUBS	SUBROUTINE/LUUO PACKAGE>
   IFN REL,<
	TITLE	ZSUBS	SUBROUTINE/LUUO PACKAGE
>
	SUBTTL	J. G. ZIMA/JGZ  MARCH 1981
	SEARCH	MACSYM,MONSYM,JOBDAT	;GET SYMBOLS
	SALL			;NICE LOOKING MACROS
	.DIRECT	FLBLST		;AND NICE LISTING

;VERSION INFORMATION:


	VMAJOR==1		;MAJOR VERSION LEVEL
	VMINOR==0		;MINOR VERSION LEVEL
	VEDIT==^D10		;EDIT LEVEL
	VWHO==0			;WHO LAST EDITED




;ZSUBS IS A PRODUCT OF THE TOPS-20 MONITOR SUPPORT GROUP OF SOFTWARE SERVICES,
;PRIMARILY FOR USE WITH PROGRAMS TO BE INCLUDED ON THE TOPS-20 MONITOR SWSKIT.
;ITS PURPOSE IS TO PROVIDE A "STANDARD" SET OF SUBROUTINE FUNCTIONS VIA THE
;LUUO MECHANISM, CONSISTING OF I/O, COMND, AND PSI BASIC LEVEL CODE USED IN
;MANY OF THE SWSKIT PROGRAMS.  IT IS SEPARATED TO ALLOW UPDATING OF ONLY A
;SINGLE COPY OF THE CODE.
;
;RELATED FILES:
;	ZSUBS.REL	THE SUPPORT CODE REL FILE
;	ZSUBS.UNV	THE UNIVERSAL GENERATED
;	ZSUBS.MAC	THIS FILE
;	ZSUBS.CTL	CONTROL FILE TO BUILD ZSUBS
	SUBTTL	TABLE OF CONTENTS


;	TABLE OF CONTENTS					  PAGE
;	-----------------					  ----
;
;  1. J. G. ZIMA/JGZ  MARCH 1981 . . . . . . . . . . . . . . . . .   1
;  2. TABLE OF CONTENTS. . . . . . . . . . . . . . . . . . . . . .   2
;  3. REVISION HISTORY . . . . . . . . . . . . . . . . . . . . . .   3
;  4. DEFINITIONS. . . . . . . . . . . . . . . . . . . . . . . . .   4
;  5. INITIALIZATION ROUTINE . . . . . . . . . . . . . . . . . . .   8
;  6. THE SIMPLE COMMANDS - EXIT . . . . . . . . . . . . . . . . .   9
;  7. PUSH COMMAND . . . . . . . . . . . . . . . . . . . . . . . .  10
;  8. TAKE COMMAND . . . . . . . . . . . . . . . . . . . . . . . .  11
;  9. LUUO HANDLER AND PROCESSING ROUTINES . . . . . . . . . . . .  13
; 10. ERROR AND NORMAL TEXT OUTPUT UUOS. . . . . . . . . . . . . .  14
; 11. NUMERIC OUTPUT UUOS. . . . . . . . . . . . . . . . . . . . .  15
; 12. FILESPEC OUTPUT UUO. . . . . . . . . . . . . . . . . . . . .  16
; 13. VERSION NUMBER OUTPUT UUO. . . . . . . . . . . . . . . . . .  17
; 14. PSI ROUTINE UUOS AND SUPPORT CODE. . . . . . . . . . . . . .  18
; 15. COMND JSYS LUUO ROUTINES . . . . . . . . . . . . . . . . . .  19
; 16. ERROR PROCESSING ROUTINES. . . . . . . . . . . . . . . . . .  20
; 17. THE DATA AREA. . . . . . . . . . . . . . . . . . . . . . . .  21
	SUBTTL	REVISION HISTORY

;REVISION HISTORY:
;
;   1	JGZ	23-MAR-81
;		START KEEPING THE REVISION HISTORY NOW THAT IT SORT OF WORKS.
;
;   2	JGZ	7-JAN-82
;		MOVE CLOSE OF OJFN LATER IN LOSE TO AVOID POSSIBLY CLOBBERING
;		THE ERROR WE WERE REALLY INTERESTED IN.
;
;   3	JGZ	15-JAN-82
;		USE THE STDAC. MACRO FROM MACSYM TO GET THE STANDARD AC DEFS.
;
;   4	JGZ	24-JAN-82
;		ADD LERROR UUO/MACRO TO DO SAME AS ERROR, BUT ALSO DO LOSE
;		PROCESSING FOR LAST PROCESS ERROR.
;
;   5	JGZ	28-JAN-82
;		ADD PRTJFN, TYPJFN UUO/MACRO TO DO JFNS FILESPEC OUTPUT OF A
;		GIVEN JFN.
;
;   6	JGZ	10-FEB-82
;		PUT IN THE MORE COMPLICATED FORM OF THE AA MACRO TO ALLOW
;		FLAG BITS LIKE CM%INV,...
;
;   7	JGZ	13-MAY-83
;		SET PC%USR IN ABTADR SO CAN ABORT OUT OF JSYSES ALSO
;		EVERY TIME...
;
;   8	JGZ	9-APR-84
;		HANDLE VI%DEC SET IN VERSION NUMBER UUO.
;
;   9	JGZ	23-JUL-84
;		CHANGE DOFORK CALLING SEQUENCE - RET ON FILE ERRORS,
;		LOSE ON FORK ERRORS, RETSKP ON SUCCESS.
;
;  10	JGZ	23-JUL-84
;		USE DEFAULT-EXEC: IN PUSH COMMAND FOR RELEASE 6 (IN A
;		BACKWARDS COMPATIBLE MANNER).
;
	SUBTTL	DEFINITIONS

;ACCUMULATORS:

	STDAC.			;STANDARD MACSYM ACS



;LUUO DEFINITIONS:

	DEFSTR	UUONUM,.JBUUO,8,9	;LUUO OPCODE FIELD
	DEFSTR	UUOAC,.JBUUO,12,4	;LUUO AC FIELD

	OPDEF	PRINT.	[1B8]		;PRINT LUUO
	OPDEF	TYPE.	[2B8]		;TYPE LUUO
	OPDEF	WARN.	[3B8]		;WARN LUUO
	OPDEF	ERROR.	[4B8]		;ERROR LUUO
	OPDEF	OCTOU.	[5B8]		;OCTAL OUTPUT LUUO
	OPDEF	DECOU.	[6B8]		;DECIMAL OUTPUT LUUO
	OPDEF	TOCT.	[7B8]		;OCTAL OUTPUT LUUO FOR .PRIOU
	OPDEF	TDEC.	[10B8]		;DECIMAL OUTPUT LUUO FOR .PRIOU
	OPDEF	TSPACE	[11B8]		;TYPE SPACES LUUO
	OPDEF	PSPACE	[12B8]		;PRINT SPACES LUUO
	OPDEF	PARSE	[13B8]		;PARSE COMND FIELD LUUO
	OPDEF	NOISE.	[14B8]		;GUIDEWORD COMND LUUO
	OPDEF	CONFRM	[15B8]		;CONFIRM COMND LUUO
	OPDEF	VERSIO	[16B8]		;VERSION NUMBER OUTPUT LUUO
	OPDEF	SETABT	[17B8]		;SET CONTROL-E ABORT ROUTINE ADDRESS
	OPDEF	CLRABT	[20B8]		;CLEAR CONTROL-E ABORT LUUO
	OPDEF	LERRO.	[21B8]		;ERROR + LAST ERROR LUUO
	OPDEF	PRTJF.	[22B8]		;PRINT JFNS INFO LUUO
	OPDEF	TYPJF.	[23B8]		;TYPE JFNS INFO LUUO
;MACROS USED TO CALL LUUOS:

	DEFINE	PRINT(STRING),<PRINT.	[ASCIZ\STRING\]> ;;MACRO FOR PRINT LUUO

	DEFINE	TYPE(STRING),<TYPE.	[ASCIZ\STRING\]> ;;MACRO FOR TYPE LUUO

	DEFINE	WARN(STRING),<WARN.	[ASCIZ\STRING\]> ;;MACRO FOR WARN LUUO

	DEFINE	ERROR(STRING),<ERROR.	[ASCIZ\STRING\]> ;;MACRO FOR ERROR LUUO

	DEFINE	LERROR(STRING),<LERRO.	[ASCIZ\STRING\]> ;;MACRO FOR LERROR LUUO

	DEFINE	OCTOUT(VALUE,SIZE),<	;;MACRO FOR CALLING OCTOUT LUUO
	IFB <SIZE>,<	OCTOU.	0,VALUE>
	IFNB <SIZE>,<	OCTOU.	SIZE,VALUE>
>
	DEFINE	DECOUT(VALUE,SIZE),<	;;MACRO FOR CALLING DECOUT LUUO
	IFB <SIZE>,<	DECOU.	0,VALUE>
	IFNB <SIZE>,<	DECOU.	SIZE,VALUE>
>
	DEFINE	TOCT(VALUE,SIZE),<	;;MACRO FOR CALLING TOCT LUUO
	IFB <SIZE>,<	TOCT.	0,VALUE>
	IFNB <SIZE>,<	TOCT.	SIZE,VALUE>
>
	DEFINE	TDEC(VALUE,SIZE),<	;;MACRO FOR CALLING TDEC LUUO
	IFB <SIZE>,<	TDEC.	0,VALUE>
	IFNB <SIZE>,<	TDEC.	SIZE,VALUE>
>

	DEFINE	PRTJFN(VALUE,MODE),<	;;MACRO FOR CALLING PRTJFN LUUO
	IFB <MODE>,<	PRTJF.	0,VALUE>
	IFNB <MODE>,<	PRTJF.	1,VALUE>
>
	DEFINE	TYPJFN(VALUE,MODE),<	;;MACRO FOR CALLING TYPJFN LUUO
	IFB <MODE>,<	TYPJF.	0,VALUE>
	IFNB <MODE>,<	TYPJF.	1,VALUE>
>
	DEFINE	NOISE(STRING),<NOISE.	[ASCIZ\STRING\]> ;;MACRO FOR NOISE. UUO

	DEFINE	AA(NAME,DATA,BITS),<		;;MACRO FOR COMMAND TABLES
IFB	<BITS>,<
	XWD	[ASCIZ/NAME/],DATA
>
IFNB	<BITS>,<
	XWD	[EXP	CM%FW!<BITS>
		 ASCIZ/NAME/],DATA
>
>

	DEFINE	TEXT(STRING),<		;;MACRO FOR ASCIZ TEXT, I.E. HELP TEXTS
	XLIST
	ASCIZ\STRING\
	LIST
>

;MACRO TO CALL INITIALIZATION ROUTINE:

	DEFINE	$INIT,<		;;MACRO FOR INITIALIZATION
	.REQUIRE ZSUBS		;;REQUIRE THE REL FILE
	EXTERN	$INIT.		;;INITIALIZATION ROUTINE
	EXTERN	CMDBLK,JFNBLK,TXTBUF,ATMBUF ;;COMND VARIABLES
	EXTERN	.EXIT,.PUSH,.TAKE	;;USABLE COMMAND ROUTINES
	EXTERN	LEVTAB,CHNTAB,SAVPSI	;;PSI SYSTEM VARIABLES
	EXTERN	LOSE		;;ERROR ROUTINE
	EXTERN	OJFN		;;OUTPUT JFN
	EXTERN	JFNTMP		;;ONE WORD "JFN STACK"
	EXTERN	PDL		;;STACK
	EXTERN	DOFORK		;;FORK RUNNER
	EXTERN	COMMND		;;MORE PRIMITIVE COMND ENTRY

	JSP	CX,$INIT.	;;CALL THE INITIALIZATION ROUTINE
>
;DEFAULT PARAMETERS:


	TXTLEN==:^D80*^D6	;SIZE OF COMMAND BUFFERS
	PDLSIZ==:100		;SIZE OF PUSHDOWN STACK



;CONSTANTS:

	INTCHN==:0		;CHANNEL FOR ^E INTERRUPT
	SUBTTL	INITIALIZATION ROUTINE

   IFN REL,<

;INITIALIZATION ROUTINE:

$INIT.::MOVE	P,[IOWD	PDLSIZ,PDL] ;SETUP A STACK
	MOVE	T1,[CALL LUUOH]	;SETUP THE
	MOVEM	T1,.JB41	; LUUO LOCATION
	SETZM	TAKJFN		;CLEAR TAKE FILE JFN/STATE
	SETZM	OJFN		;CLEAR OUTPUT JFN
	MOVX	T1,.FHSLF	;SETUP THE
	MOVE	T2,[LEVTAB,,CHNTAB] ; INTERRUPT SYSTEM
	SIR
	MOVX	T1,.FHSLF	;AND ACTIVATE
	MOVX	T2,1B<INTCHN>	;THE CHANNEL TO USE FOR ^E INTERRUPTS
	AIC			;SET THEM UP
	MOVX	T1,.FHSLF	;AND FINALLY
	EIR			; TURN PSI'S ON, WITH NOTHING ON THE CHANNEL
	JRST	0(CX)		;RETURN TO THE CALLER



;THE GENERIC SKIP AND NONSKIP RETURN INSTRUCTIONS

RSKP::	AOS	0(P)		;YE OLDE SKIP
R::	RET			; AND NONSKIP RETURNS
	SUBTTL	THE SIMPLE COMMANDS - EXIT

;EXIT FROM PROGRAM.  "EXIT" COMMAND.


.EXIT::	NOISE	(FROM PROGRAM)	;DO GUIDEWORDS
	CONFRM			;THEN CONFIRM THE COMMAND
	SKIPE	T1,OJFN		;CHECK AND
	CLOSF			; CLOSE ANY OUTPUT
	 ERJMP	.+1		; IGNORE
	SETZM	OJFN		;MARK CLOSED
	HALTF			;QUIT FOR THE NONCE
	RET			;AND RETURN TO DO ANOTHER COMMAND
				; IF CONTINUED
	SUBTTL	PUSH COMMAND

;PUSH COMMAND TO PUSH TO A NEW EXEC IN AN INFERIOR FORK

.PUSH::	NOISE	(COMMAND LEVEL)	;DO GUIDEWORDS
	CONFRM			;CONFIRM THE COMMAND
	HRROI	T2,[ASCIZ/DEFAULT-EXEC:/] ;THE V6 FORM...
	CALL	DOFORK		;TRY TO PUSH
	 SKIPA			; FAILED - TRY OTHER ALTERNATIVE
	RET			;DONE
	HRROI	T2,[ASCIZ/SYSTEM:EXEC.EXE/] ;FILENAME FOR EXEC
	CALL	DOFORK		;TRY OLD WAY
	 JRST	LOSE		; FAILED TOO...
	RET			;DONE OK




;COMMON CODE FOR HANDLING AN INFERIOR.  GET THE FILE, START IT UP
;IN AN INFERIOR FORK, AND WAIT FOR IT TO FINISH, THEN RETURN.
;RETURNS +1 ON FILE ERRORS, TO LOSE ON FORK ERRORS, +2 ON SUCCESS

DOFORK::MOVX	T1,GJ%PHY!GJ%OLD!GJ%SHT	;GTJFN BITS
	GTJFN			;GET A HANDLE ON THE FILE
	 ERJMP	R		;UNAVAILABLE???
	MOVEM	T1,JFNX		;SAVE JFN TO IT
	MOVX	T1,CR%CAP	;PRESERVE OUR CAPABILITIES
	CFORK			;BUILD A FORK
	 ERJMP	LOSE		;COULDN'T
	MOVEM	T1,HANDLE	;SAVE FORK HANDLE
	MOVSS	T1		;HANDLE TO LEFT HALF
	HRR	T1,JFNX		;JFN TO RIGHT
	GET			;GET THE FILE
	 ERJMP	LOSE		;COULDN'T
	MOVE	T1,HANDLE	;FETCH FORK HANDLE
	SETZ	T2,		;NORMAL START
	SFRKV			;START THE FORK UP
	 ERJMP	LOSE		;CAN'T
	WFORK			;WAIT FOR IT TO COME BACK
	 ERJMP	LOSE		;TROUBLE
	KFORK			;IS DONE, SO KILL IT
	 ERJMP	LOSE		;FAILED
	SETZM	HANDLE		;NO MORE FORK
	RETSKP			; AND COMMAND IS FINISHED
	SUBTTL	TAKE COMMAND


;TAKE COMMAND TO READ COMMAND FROM DESIGNATED FILE BY SETTING UP
;THE PRIMARY I/O JFNS TO POINT TO THE FILE.
;UNTAKE ROUTINE CALLED TO RESET THE STATE WHEN THE END OF THE TAKE
;FILE IS ENCOUNTERED.

.TAKE::	NOISE	(COMMANDS FROM FILE)	;DO GUIDEWORDS
	SETZM	JFNBLK+.GJNAM	;CLEAR ANYTHING THAT MAY HAVE BEEN HERE
	HRROI	T2,[ASCIZ/CMD/]	;DEFAULT EXTENSION FOR FILE
	MOVEM	T2,JFNBLK+.GJEXT ;TO JFN BLOCK FOR GTJFN
	MOVX	T2,GJ%OLD	;FILE MUST EXIST
	MOVEM	T2,JFNBLK+.GJGEN
	PARSE	[FLDDB. (.CMFIL)] ;ASK FOR A FILE
	MOVEM	T2,JFNTMP	;SAVE JFN FOR A MOMENT
	CONFRM			;CONFIRM THE COMMAND
	SKIPE	TAKJFN		;TEST--DON'T ALLOW NESTING
	JRST  [	TMSG	<
? Nesting of TAKE files is not allowed -- command file aborted
>
		CALL	UNTAKE	;CLEAR STATE AND
		JRST	REEN]	;DIE SOMEHOW
	HRRZ	T1,JFNTMP	;GET BACK JFN
	MOVEM	T1,TAKJFN	;SAVE THE JFN
	SETZM	JFNTMP		; AND CLEAR THE TEMP SLOT
	MOVX	T2,FLD(7,OF%BSZ)+OF%RD ;READ AS ASCII FILE
	OPENF			;OPEN IT
	 ERJMP	LOSE		;FAILED
	MOVEI	T1,.FHSLF	;OUR PROCESS
	GPJFN			;GET OLD PRIMARY I/O
	MOVEM	T2,OLDPRM	;SAVE FOR RESTORE
	HRL	T2,TAKJFN	;POINT TO TAKE FILE
	SPJFN			; AS PRIMARY INPUT
	 ERJMP	LOSE		;COULDN'T
	MOVX	T2,.NULIO	;MARK COMND BLOCK OUTPUT
	HRRM	T2,CMDBLK+.CMIOJ ; AS NUL SO DON'T GET PROMPTS
	RET			;AND DONE--RESET AT EOF BY UNTAKE
;UNTAKE - ROUTINE CALLED TO UNDO THE EFFECTS OF THE TAKE COMMAND
;RESETS THE PRIMARY I/O AND CLEANS UP THE JFN.

UNTAKE:	MOVEI	T1,.PRIOU	;RESET COMND BLOCK OUTPUT DESIGNATOR
	HRRM	T1,CMDBLK+.CMIOJ ;SO WE GET OUR PROMPTS,... BACK
	MOVEI	T1,.FHSLF	;OUR PROCESS
	SKIPE	T2,OLDPRM	;OLD DESIGNATORS
	SPJFN			;RESTORE
	SETZM	OLDPRM		;AND CLEAR
	SKIPE	T1,TAKJFN	;TAKE FILE JFN
	CLOSF			;CLOSE IT
	 ERJMP	.+1		;IGNORE ERRORS (AND POSSIBLE LOSE LOOP)
	SKIPE	T1,TAKJFN	;GET JFN AGAIN
	RLJFN			;RELEASE IT
	 ERJMP	.+1
	SETZM	TAKJFN		;RESET TAKE STATE
	RET			;DONE
	SUBTTL	LUUO HANDLER AND PROCESSING ROUTINES


;LUUOH - THIS IS THE UUO HANDLER
;CALLED BY A CALL LUUOH.  PRESERVES T1-T4 HERE ON THE STACK
;TO SAVE EFFORT FOR THE PROCESSING ROUTINES.  ALL PROCESSING
;ROUTINES SHOULD RETURN +1 FOR NOW, AND ALL UUOS.
;TO RETURN VALUES IN AC1-AC4, THE VALUES ON THE STACK MUST BE
;UPDATED.


LUUOH:	ADJSP	P,4		;ALLOCATE SPACE ON THE STACK
	DMOVEM	T1,-3(P)	;SAVE T1,T2
	DMOVEM	T3,-1(P)	;SAVE T3,T4
	PUSH	P,.JBUUO	;SAVE 40 TO ALLOW RECURSION
	LOAD	T1,UUONUM	;GET THE UUO NUMBER
	CAILE	T1,UUOMAX	;OUT OF RANGE?
	 ERROR	ZSUBS Internal Error - LUUO Out of Range
	PUSH	P,UUODSP(T1)	;DISPATCH TO PROPER ROUTINE
	MOVE	T1,-5(P)	; AFTER RESTORING T1
	CALL	@0(P)		;CALL THE ROUTINE
	ADJSP	P,-1		;BUMP PAST CALL ADDRESS
	POP	P,.JBUUO	;RESTORE LAST VALUE, SOMEONE MAY NEED IT
	DMOVE	T1,-3(P)	;RESTORE T1,T2
	DMOVE	T3,-1(P)	;RESTORE T3,T4
	ADJSP	P,-4		;DEALLOCATE STACK SPACE
	RET			;AND RETURN FROM LUUO

;THE UUO DISPATCH TABLE - INDEX IS BY UUO NUMBER

UUODSP:	EXP	LOSFIN		;IN CASE SOMEONE GETS HERE
	EXP	PRTUUO		;PRINT
	EXP	TYPUUO		;TYPE
	EXP	WRNUUO		;WARN
	EXP	ERRUUO		;ERROR
	EXP	OCTUUO		;OCTOUT
	EXP	DECUUO		;DECOUT
	EXP	TOCTUU		;TOCT
	EXP	TDECUU		;TDEC
	EXP	TSPUUO		;TSPACE
	EXP	PSPUUO		;PSPACE
	EXP	PARUUO		;PARSE
	EXP	NOIUUO		;NOISE
	EXP	CFMUUO		;CONFIRM
	EXP	VERUUO		;VERSIO
	EXP	ABTUUO		;SETABT
	EXP	CLAUUO		;CLRABT
	EXP	LERUUO		;LERROR
	EXP	PRJUUO		;PRTJFN
	EXP	TYJUUO		;TYPJFN
	UUOMAX==.-UUODSP-1	;COUNT
	SUBTTL	ERROR AND NORMAL TEXT OUTPUT UUOS

;LERUUO - ROUTINE TO PROCESS THE LERROR UUO
;ERRUUO - ROUTINE TO PROCESS THE ERROR UUO

LERUUO:	SKIPA	T1,[EXP	LOSE]	;TERMINATE AT LOSE FOR LERROR
ERRUUO:	MOVEI	T1,LOSFIN	;SETUP TO TRANSFER TO LOSFIN
	EXCH	T1,0(P)		;SET THE CLEANUP ROUTINE
	HRRO	T1,.JBUUO	;POINT TO THE STRING
	ESOUT			;OUTPUT IT ESOUT MANNER
	 ERJMP	.+1		;GET TO TERMINATING ROUTINE
	RET			;IN ANY CASE



;WRNUUO - ROUTINE TO PROCESS THE WARN UUO

WRNUUO:	MOVX	T1,.PRIOU	;SEE IF CRLF NEEDED
	DOBE			; BY WAITING FOR OUTPUT TO FINISH AND
	RFPOS			; BY GETTING POSITION
	TRNE	T2,-1		;AT LEFT?
	TYPE	<
>				;DO THE CRLF
	TYPE	<% >		;DO THE PERCENT
;	CALLRET	TYPUUO		;AND THEN SAME AS TYPE (FALL THROUGH)


;TYPUUO - ROUTINE TO PROCESS THE TYPE UUO

TYPUUO:	HRRO	T1,-2(P)	;POINT TO THE STRING (HAVE TO USE SAVED .JBUUO)
	PSOUT			;OUTPUT THE STRING
	 ERJMP	LOSE		;HANDLE BAD ERRORS
	RET			;AND RETURN TO CALLER



;PRTUUO - ROUTINE TO PROCESS THE PRINT UUO
;OUTPUTS TO THE JFN SET UP IN OJFN UNLESS IT IS ZERO, IN
;WHICH CASE .PRIOU IS USED

PRTUUO:	SKIPN	T1,OJFN		;GET THE OUTPUT JFN
	 MOVX	T1,.PRIOU	;EITHER FILE OR TERMINAL
	HRRO	T2,.JBUUO	;POINT TO THE STRING
	SETZ	T3,		;ASCIZ
	SOUT			;OUTPUT THE STRING
	 ERJMP	LOSE		;BLOW UP ON ERRORS
	RET			;AND RETURN TO THE CALLER
	SUBTTL	NUMERIC OUTPUT UUOS

;OCTUUO - ROUTINE TO PROCESS THE OCTOUT UUO
;DECUUO - ROUTINE TO PROCESS THE DECOUT UUO
;TOCTUU - ROUTINE TO PROCESS THE TOCT UUO
;TDECUU - ROUTINE TO PROCESS THE TDEC UUO


TOCTUU:				;SAME ENTRY POINT
OCTUUO:	MOVE	T2,@.JBUUO	;DO FETCH FIRST TO ALLOW USING ACS
	MOVX	T3,NO%MAG+^D8	;OCTAL RADIX ENTRY
	JRST	NUMUUO		;ENTER COMMON CODE

TDECUU:				;SHARED ENTRY POINT
DECUUO:	MOVE	T2,@.JBUUO	;FETCH THE VALUE TO BE OUTPUT
	MOVEI	T3,^D10		;DECIMAL RADIX ENTRY
NUMUUO:	LOAD	T1,UUOAC	;GET COLUMN SIZE, 0 TO 17
	STOR	T1,NO%COL,T3	;SET UP THE COLUMNS FIELD
	SKIPE	T1		;IF ZERO PASSED, NO FILL IS USED
	TXO	T3,NO%LFL	; ELSE ASK FOR LEADING SPACE FILL
	LOAD	T1,UUONUM	;GET THE UUO OPCODE
	CAIE	T1,<TOCT.>_<-^D27> ;TOCT OR
	CAIN	T1,<TDEC.>_<-^D27> ;TDEC?
	 SKIPA			;YES, USE .PRIOU
	SKIPN	T1,OJFN		;FETCH THE DESIRED
	 MOVX	T1,.PRIOU	; OUTPUT DESIGNATOR
	NOUT			;DO THE OUTPUT
	 ERJMP	LOSE
	HRRZS	T3		;JUST THE RADIX
	CAIE	T3,^D10		;DECIMAL?
	 RET			;NO, RETURN
	MOVEI	T2,"."		;YES, GET A DECIMAL POINT
	BOUT			; AND OUTPUT (T1 HAS CORRECT DESIGNATOR)
	 ERJMP	LOSE
	RET			;RETURN



;TSPUUO - ROUTINE TO PROCESS THE TSPACE UUO
;PSPUUO - ROUTINE TO PROCESS THE PSPACE UUO


PSPUUO:	SKIPN	T1,OJFN		;SELECT THE
TSPUUO:	 MOVX	T1,.PRIOU	; PROPER DESIGNATOR
	MOVX	T2," "		;SPACE
	HRRZ	T3,.JBUUO	;NUMBER TO DO
	JUMPE	T3,R		;IF ZERO, DO NONE
PSPUUL:	BOUT			;OUTPUT
	 ERJMP	LOSE
	SOJG	T3,PSPUUL	;LOOP FOR THAT NUMBER
	RET			;THEN RETURN
	SUBTTL	FILESPEC OUTPUT UUO

;TYJUUO - ROUTINE TO PROCESS THE TYPJFN UUO

TYJUUO:	HRRZ	T2,@.JBUUO	;DO ARGUMENT FETCH FIRST TO ALLOW ACS
	MOVX	T1,.PRIOU	;TYPE AT TERMINAL ONLY
	JRST	JFNUUO		; AND GO TO COMMON CODE


;PRJUUO - ROUTINE TO PROCESS THE PRTJFN UUO

PRJUUO:	HRRZ	T2,@.JBUUO	;FETCH ARGUMENT FIRST
	SKIPN	T1,OJFN		;LOAD UP PROPER
	 MOVX	T1,.PRIOU	; OUTPUT DESIGNATOR

JFNUUO:	LOAD	T3,UUOAC	;SEE IF WANT FULL OR DEFAULT OUTPUT
	SKIPE	T3		; BY TESTING AC FIELD
	MOVX	T3,JS%SPC!JS%OFL ;FULL SPECIFICATION WANTED
	JFNS			;DO THE OUTPUT
	 ERJMP	LOSE		;FAILED
	RET			;RETURN TO CALLER
	SUBTTL	VERSION NUMBER OUTPUT UUO


;VERUUO - ROUTINE TO PROCESS THE VERSIO UUO
;
;OUTPUTS A "STANDARD" VERSION NUMBER FROM THE ADDRESSED LOCATION IN THE
;FORM MAJOR.MINOR(EDIT)-WHO WITH ZERO SUPPRESSION ON MINOR AND WHO FIELDS.
;RECOGNIZES AND HANDLES VI%DEC VERSION NUMBERS


VERUUO:	MOVE	T4,@.JBUUO	;DO FETCH FIRST TO ALLOW ACS
	LOAD	T2,VI%MAJ,T4	;GET MAJOR VERSION LEVEL
	CALL	VN.OUT		;OUTPUT IN RIGHT RADIX
	LOAD	T2,VI%MIN,T4	;GET MINOR VERSION LEVEL
	JUMPE	T2,VERUU1	;DON'T BOTHER WITH IT IF ZERO
	PRINT	<.>		;TYPE THE DELIMITER
	CALL	VN.OUT		; AND THE MINOR VERSION IN RIGHT RADIX
VERUU1:	PRINT	<(>		;PRECEDER FOR THE EDIT NUMBER
	LOAD	T2,VI%EDN,T4	;FETCH EDIT NUMBER
	CALL	VN.OUT		;OUTPUT IN RIGHT RADIX
	PRINT	<)>		; AND CLOSE THE PARENS
	LOAD	T2,VI%WHO,T4	;FETCH THE WHO FIELD
	JUMPE	T2,R		;DONE IF ZERO
	PRINT	<->		;DELIMIT THE WHO FIELD
	CALL	VN.OUT		; AND TYPE IT OUT
	RET			; AND ALL DONE HERE



;VN.OUT -- OUTPUT THE VALUE IN T2 IN OCTAL OR DECIMAL ACCORDING
;TO THE SETTING OF VI%DEC IN T4.

VN.OUT:	TXNN	T4,VI%DEC	;DECIMAL VERSION NUMBERS?
	 JRST [	OCTOUT	T2	;NO, OCTAL
		RET]		;DONE
	SKIPN	T1,OJFN		;FETCH THE DESIRED
	 MOVX	T1,.PRIOU	; OUTPUT DESIGNATOR
	MOVX	T3,^D10		;RADIX
	NOUT			;DO THE OUTPUT WITHOUT THE POINT
	 ERJMP	LOSE
	RET			; AND DONE
	SUBTTL	PSI ROUTINE UUOS AND SUPPORT CODE

;ABTUUO - ROUTINE TO PROCESS THE SETABT UUO
;SETS EFFECTIVE ADDRESS OF THE UUO AS THE CONTROL-E ABORT ROUTINE
;ADDRESS AND SAVES KNOWN STACK VALUE IN SAVPSI.

ABTUUO:	HRRZ	T1,.JBUUO	;GET DESIRED ADDRESS
	TXO	T1,PC%USR	; AND ALWAYS USER MODE
	MOVEM	T1,ABTADR	;SET THE ABORT HANDLER ADDRESS
	MOVE	T1,[.TICCE,,INTCHN] ;ACTIVATE INTCHN ON
	ATI			; CONTROL-E
	 ERJMP	LOSE
	MOVE	T1,P		;COPY THE STACK POINTER
	ADJSP	T1,-10		;CREATE A COPY OF IT BEFORE ALL THIS
	MOVEM	T1,SAVPSI	; TO SAVE A KNOWN STACK VALUE FOR CLEANUPS
	RET			; AND ALL DONE




;CLAUUO - ROUTINE TO PROCESS THE CLRABT UUO

CLAUUO:	MOVX	T1,.TICCE	;SETUP TO CLEAR THE CONTROL-E
	DTI			;DISABLE THE TERMINAL INTERRUPT
	 ERJMP	LOSE
	RET			; AND DONE




;ABTINT - HERE ON PSI INTERRUPT ON INTCHN FOR CONTROL-E ABORT.
;DEBREAK THROUGH ADDRESS IN ABTADR TO GET TO CLEANUP CODE.
;DISABLE THE CHARACTER INTERRUPT ON THE CHANNEL.

ABTINT:	PUSH	P,T1		;GET A TEMP AC
	SKIPN	T1,ABTADR	;ADDRESS OF WHERE TO GO
	 ERROR	PSI error - abort address not initialized
	MOVEM	T1,CHNPC1	; IN PLACE OF RETURNING
	MOVX	T1,.TICCE	;CONTROL-E CODE
	DTI			;DISABLE THE INTERRUPT NOW
	 ERJMP	LOSE
	POP	P,T1		;RESTORE TEMP AC
	SETZM	ABTADR		;INDICATE GOT THE INTERRUPT
	DEBRK			;TERMINATE THE INTERRUPT
	 ERJMP	LOSE		;FAILED
	SUBTTL	COMND JSYS LUUO ROUTINES

;PARUUO - ROUTINE TO PROCESS THE PARSE LUUO
;RETURNS VALUES IN T1-T3.

PARUUO:	HRRZ	T2,.JBUUO	;PICK UP THE ADDRESS OF THE DESCRIPTOR BLOCK
	CALL	DOPARS		;DO THE ACTUAL PARSE, HANDLE NOPARSE
	DMOVEM	T1,-6(P)	;SETUP TO RETURN T1,T2
	MOVEM	T3,-4(P)	; AND T3 TO CALLER
	RET			;AND DONE

;NOIUUO - ROUTINE TO PROCESS THE NOISE UUO.

NOIUUO:	HRRO	T2,.JBUUO	;BUILD A POINTER TO THE GUIDEWORD STRING
	MOVEM	T2,NOIBLK+.CMDAT ;SET IT IN THE COMND BLOCK
	MOVEI	T2,NOIBLK	;POINT TO THE BLOCK
	CALLRET	DOPARS		;AND GO DO THE COMND JSYS


;CFMUUO - ROUTINE TO PROCESS THE CONFRM UUO.

CFMUUO:	MOVEI	T2,[FLDDB. (.CMCFM)] ;GET THE CONFIRM FUNCTION
;	CALLRET	DOPARS		;AND DO THE PARSE (FALL THROUGH)


;DOPARS - INTERNAL ROUTINE TO DO COMND JSYS AND HANDLE NOPARSE CASE.
;  T2/	ADDRESS OF COMND DESCRIPTOR BLOCK
;
;	CALL	DOPARS
;
;RETURNS  +1:	ALWAYS ON SUCCESSFUL PARSE, OTHERWISE EXITS VIA LOSE

DOPARS:	CALL	COMMND		;MAKE THE COMND CALL
	 JRST	LOSE		;BLOW UP ON ERRORS
	RET			;AND RETURN +1 ON SUCCESS



;COMMND - CENTRAL ROUTINE TO PERFORM COMND JSYS CALL.
;  T2/	ADDRESS OF COMND DESCRIPTOR BLOCK TO USE
;
;	CALL	COMMND
;
;RETURNS  +1:	ON NOPARSE
;	  +2:	ON SUCCESSFUL PARSE

COMMND:: MOVEI	T1,CMDBLK	;POINT TO OUR (ONLY) COMMAND BLOCK
	COMND			;PARSE THE FUNCTION
	 ERJMP	LOSE		;ERROR, GO COMPLAIN
	TXNE	T1,CM%NOP	;DID IT PARSE?
	RET			;NO, COMPLAIN
	RETSKP			;YES, RETURN SUCCESSFULLY
	SUBTTL	ERROR PROCESSING ROUTINES

;LOSE - GENERAL ROUTINE TO JRST/ERJMP TO.  OUTPUTS ERSTR MESSAGE
;AND SIMULATES REENTER AT REPARSE ADDRESS -1.


LOSE::	SKIPE	T1,TAKJFN	;TAKE IN PROGRESS?
	JRST  [	GTSTS			;YES--SEE IF EOF
		TXNE	T2,GS%EOF	;TEST BIT
		 JRST	TAKEOF		;EOF
		JRST	.+1]		;OTHER ERROR, CONTINUE
	HRROI	T1,ERRBUF	;POINT TO ERROR BUFFER
	HRLOI	T2,.FHSLF	;LAST ERROR IN THIS FORK
	HRLI	T3,-TXTLEN	;MAX BYTES
	ERSTR			;GET THE ERROR
	 ERJMP	.+1		;FAILED
	 ERJMP	.+1		;FAILED
	HRROI	T1,ERRBUF	;POINT TO ERROR MESSAGE AGAIN
	ESOUT			;OUTPUT THE MESSAGE
	SKIPE	T1,OJFN		;TRY TO CLOSE OUTPUT IF
	CLOSF			; HAPPENED TO BE OPEN
	 ERJMP	.+1		;TOO BAD ON CLOSE ERRORS
	SKIPN	TAKJFN		;NEED TO ABORT TAKE?
	JRST	LOSFIN		;NO
	CALL	UNTAKE		;YES--SO DO IT
	TMSG	< -- command file aborted> ;AND SAY SO


LOSFIN:	TMSG	<

>				;FINAL STRING CRLF
	MOVX	T1,.PRIIN	;GET READY
	CFIBF			;CLEAR INPUT BUFFER
REEN:	HRRZ	T1,CMDBLK+.CMFLG ;GET REPARSE ADDRESS
	JRST	-1(T1)		;AND TRANSFER TO ONE LESS...


TAKEOF:	CALL	UNTAKE		;CLEAN UP TAKE STATE
	TYPE	<
[Command file completed]>	;SAY SO
	JRST	REEN		;AND REENTER COMMAND LOOP
	SUBTTL	THE DATA AREA

	XLIST			;DUMP THE LITERALS
DLITS:	LIT
	LIST


;COMND VARIABLES

CMDBLK::0			;ADDRESS OF REPARSE ROUTINE
	.PRIIN,,.PRIOU		;INPUT,,OUTPUT JFNS
	0			;CONTROL-R POINTER/PROMPT
	-1,,TXTBUF		;POINTER TO TEXT BUFFER
	-1,,TXTBUF		;POINTER TO CURRENT POSITION
	TXTLEN			;NUMBER OF CHARS IN BUFFER
	0			;NUMBER OF UNPARSED CHARACTERS
	-1,,ATMBUF		;POINTER TO ATOM BUFFER
	TXTLEN			;NUMBER OF CHARACTERS IN BUFFER
	EXP	JFNBLK		;POINTER TO GTJFN BLOCK

JFNBLK::GJ%OLD			;FLAGS,,GENERATION NUMBER
	.PRIIN,,.PRIOU		;INPUT,,OUTPUT JFNS
	BLOCK	20		;NO DEFAULTS

JFNTMP::BLOCK	1		;WORD FOR COMND'S JFNS RETURNED DURING PARSE
TXTBUF::BLOCK	TXTLEN/5+1	;BUFFER FOR COMMAND JSYS
ATMBUF::BLOCK	TXTLEN/5+1	;BUFFER FOR ATOM BUFFER
ERRBUF:	BLOCK	TXTLEN/5+1	;BUFFER FOR ERROR MESSAGES

;GUIDEWORD DESCRIPTOR BLOCK USED BY NOISE ROUTINE

NOIBLK:	FLDDB.	(.CMNOI)	;BLOCK FOR NOISE FUNCTION

;PSI SYSTEM VARIABLES

LEVTAB::EXP	CHNPC1		;WHERE TO STORE PC FOR LEVEL ONE INTERRUPT
	BLOCK	2		;OTHER LEVELS UNUSED
CHNTAB::XWD	1,ABTINT	;VECTOR FOR INTERRUPT ON THIS CHANNEL
	BLOCK	^D35		;OTHER CHANNELS UNUSED
CHNPC1:	BLOCK	1		;INTERRUPT PC STORED HERE
SAVPSI::BLOCK	1		;P SAVED HERE FOR ADJUST ON ^E
ABTADR:	BLOCK	1		;WHERE TO GO ON A ^E ABORT

JFNX:	BLOCK	1		;JFN ON EXEC TO PUSH TO
HANDLE:	BLOCK	1		;FORK HANDLE FOR INFERIOR EXEC
OLDPRM:	BLOCK	1		;STORAGE FOR OLD I/O DESIGNATORS DURING TAKE
TAKJFN:	BLOCK	1		;TAKE FILE JFN WHEN NONZERO

PDL::	BLOCK	PDLSIZ		;STACK ROOM

OJFN::	BLOCK	1		;OUTPUT FILE JFN

>				;END IFN REL

	END