;     FORMS.LIT 	Hash Code 720-147-113-744
;
;     Have you ever wanted to know what forms were 'SET' on a printer, but
;upon typing a 'PRINT' command were stumped by the fact the queue was empty?
;
;     Do you have a large variety of forms in frequent use or more than one
;printer?
;
;     If you answered yes to either of the above questions then here's a 
;short utility program for you. This program will display the forms currently
;'SET' on all printers in the line printer spooler queue. 
;     The procedure is simple, simply type 'FORMS' and the names of all 
;printers in the LPTSPL with their associated forms will be displayed. This
;program will work whether your system has just one printer or a dozen.
;
;
;     This program is written for the AMOS/L system.
;
;
;
;     The TCRT calls I have used work on the Televideo 925/950. I'm not
;familiar with other terminals, adjustments may have to be made to get
;the desired half/normal intensity printing.
;
;
;
;
; 2/27/84   Steven G. McNaughton     Quaker State Oil Refining Corp.
;                                    Research Center


; 04/11/86 - Modified for use with AMOS/L 1.3 and above when spoolers
;		run through task manager.  Also added convenient TCRT
;		macro.     Dale Eichbauer - MBS Data Systems - Merrill, MI.
;		(NOTE - Space could be conserved by making the display
;		routine a callable subroutine rather than duplicating
;		it all over the place.)

SEARCH SYS.UNV
SEARCH TRM.UNV
SEARCH SYSSYM.UNV

VMAJOR=1
VMINOR=1
VEDIT=100.

.OFINI					;DEFINE IMPURE SPACE 
.OFDEF	RADBUF,4			;RAD50 BUFFER SPACE
.OFDEF	ASCBUF,6			;ASCII STRING RESULT SPACE
.OFDEF	FLAG,2				;END OF QUEUE FLAG
.OFDEF	BLOCK,224			; STORAGE FOR RETURNED MESSAGES
.OFSIZ	IMPSIZ


; OFFSETS FOR ARGUMENT BLOCK USED BY THE OPEN MESSAGE SOCKET MONITOR CALL.
; ALL MAY BE SKIPPED FOR THOSE WITH AMOS/L 1.3 AND ABOVE.

	OM.FLG	=	0
	OM.LEN	=	2
	OM.MAX	=	4
	OM.MSR	=	6


; ERROR FLAG DEFINITIONS FOR MESSAGE SYSTEM FOR THOSE WITH EARLY AMOS/L.
; ALL MAY BE SKIPPED FOR THOSE WITH AMOS/L 1.3 AND ABOVE.

	M$EAOP	=	12
	M$EDNN	=	4
	M$EDSF	=	13
	M$EDSN	=	14
	M$EMTL	=	15
	M$ENMB	=	10
	M$ENMP	=	2
	M$ENMS	=	3
	M$ENNN	=	5
	M$ENQB	=	11
	M$ENSK	=	1
	M$ESAE	=	7
	M$ESNN	=	6


; FIELD DEFINITIONS FOR MESSAGE BLOCK FOR THOSE WITH EARLY AMOS/L.
; LAST TWO ARE NEEDED BY ALL DUE TO ERRORS AND OMISSIONS IN SYSSYM.UNV

	MS.FLG = 0
	MS.SRC = 2
	MS.DST = 10
	MS.SIZ = 16
	MS.PPN = 20
	MS.PRV = 22
	MS.COD = 24
	MS.SPR = 26		; CORRECTS OMISSION FROM SYSSYM.UNV
	MS.DAT = 36		; CORRECTS ERROR IN SYSSYM.UNV


DEFINE	XY	A,B		; A MACRO DEFINITION FOR X,Y CURSOR POSITIONING
	MOV	#^D<A_8.+B>,D1
	TCRT
	ENDM

START:	PHDR	-1,0,PH$REE!PH$REU	;program header

TOP:
	GETIMP	IMPSIZ,A5,EXIT		;GET AN IMPURE SPACE
	CTRLC	EXIT			;ON ABORT GO TO EXIT
	MOV	LPTQUE,D2		; GET BEGINNING OF SPOOLERS	[1.1]
	JEQ	TASK			; IF NOT FOUND, THEN RUNNING	[1.1]
					; UNDER TASK MANAGER FOR SPOOLERS [1.1]
					; OR NO SPOOLERS AT ALL		[1.1]
	MOV	LPTQUE,A0		;LOAD ADDRESS OF FIRST LP QUEUE BLOCK
	CRLF				; [1.1]
	XY	-1,11			;HALF INTENSITY	[1.1]
	TYPECR	<Printer         Form>
	TYPECR	<-------         ---->	; [1.1]
	XY	-1,12			;RETURN TO NORMAL VIDEO	[1.1]
LOOP:	MOV	(A0),D0			;GET ADDRESS OF NEXT LPTQUE BLOCK
	TST	D0			;IS IT A ZERO (NO MORE QUEUE BLOCKS)
	BNE	NZFLG			;NO KEEP FLAG NON-ZERO
ZFLG:	LEA	A1,FLAG(A5)
	MOVW	#0,(A1)			;NO MORE QUEUE'S ZEROIZE FLAG
	BR	CONTIN
NZFLG:
	LEA	A1,FLAG(A5)		;MORE LPTQUE'S SO MAKE FLAG NON-ZERO
	MOVW	#1,(A1)
CONTIN:
	CTRLC	EXIT
	LEA	A1,RADBUF(A5)		;UNPACK MACRO USES A1 AS THE RAD50 ADDRESS
	LEA	A2,ASCBUF(A5)		;AND A2 AS THE ASCII STRING ADDRESS
	CTRLC	EXIT
	MOV	10(A0),@A1		;MOVE THE PRINTER NAME TO UNPACKED
	UNPACK
	UNPACK
	CTRLC	EXIT
	LEA	A2,ASCBUF(A5)		;REPOSITION THE ASCII BUFFER
	CRLF
	CTRLC	EXIT
	TTYL	(A2)			;TYPE THE ASCII STRING
	LEA	A1,RADBUF(A5)		;RELOAD THE RAD50 BUFFER
	LEA	A2,ASCBUF(A5)		;RELOAD THE ASCII BUFFER
	MOV	14(A0),@A1		;MOVE THE FORMS NAME TO BE UNPACKED
	UNPACK
	UNPACK
	CTRLC	EXIT
	LEA	A2,ASCBUF(A5)		;REPOSITION THE ASCII BUFFER
	XY	-1,11			;HALF INTENSITY
	TYPESP	<........>
	XY 	-1,12			;NORMAL VIDEO
	CTRLC	EXIT
	TTYL	(A2)			;TYPE THE ASCII STRING
	CRLF
	LEA	A1,FLAG(A5)		;GET THE END OF QUEUE FLAG
	MOVW	(A1),D4			;PUT IN A REGISTER TO CHECK IT
	TST	D4			;IS IT ZERO?
	JEQ	EXIT			;IF SO ALL DONE - SO EXIT
	MOV	D0,A0			;NOT ZERO - MORE QUEUE BLOCKS -
	JMP	LOOP 			;GO GET THE NEXT ONE

;
;	ALL OF FOLLOWING ADDED FOR TASK MANAGER IN [1.1]
;

TASK:	PUSH				; USE THE STACK		[1.1]
	PUSH				; FOR THE ARGUMENT BLOCK	[1.1]
	PUSH				; FOR THE OPEN SOCKET CALL	[1.1]
	MOV	SP,A6			; POINT TO ARGUMENT BLOCK	[1.1]
	MOVW	#-100000,OM.FLG(A6)	; SET FLAGS TO ENABLE SOCKET	[1.1]
	MOVW	#2000,OM.LEN(A6)	; SET MAXIMUM MESSAGE LENGTH TO 1024	[1.1]
	MOVW	#12,OM.MAX(A6)		; SET MAX # OF PENDING MESSAGES TO 10	[1.1]
	CLR	OM.MSR(A6)		; CLEAR MESSAGE SERVICE ROUTINE ADDRESS [1.1]
	OPNMSG	@A6,D6			; OPEN MESSAGE SOCKET	[1.1]
	POP				; NOW CLEAR THE STACK	[1.1]
	POP				; BACK TO WHERE IT WAS	[1.1]
	POP				;			[1.1]
	TST	D6			; SEE WHAT STATUS WAS RETURNED	[1.1]
	BEQ	ITC.OK			; IF OK, THEN CONTINUE	[1.1]
	CMP	D6,#M$ENMS		; SEE IF OLD VERSION OF AMOS/L	[1.1]
	JEQ	EXIT			; IF SO, JUST GO BACK TO SYSTEM	[1.1]
	JMP	ERROR			; ELSE ERROR, SO DO ERROR ROUTINE [1.1]
ITC.OK:	CRLF				; [1.1]
	XY	-1,11			;HALF INTENSITY	[1.1]
	TYPECR	<Printer         Form>	; [1.1]
	TYPECR	<-------         ---->	; [1.1]
	XY	-1,12			;RETURN TO NORMAL VIDEO	[1.1]
	LEA	A1,BLOCK(A5)		; NOW POINT TO MESSAGE BLOCK (IMPURE)	[1.1]
	MOV	#45,D6			; LOOP COUNTER	[1.1]
NULLS:	CLR	(A1)+			; CLEAR A WORD IN MESSAGE BLOCK	[1.1]
	SOB	D6,NULLS		; AND LOOP BACK TILL DONE	[1.1]
	LEA	A1,BLOCK(A5)		; POINT TO START OF MESSAGE BLOCK AGAIN [1.1]
	MOVW	#-3,14(A1)		; SET FOR LPTSPL SOCKET	[1.1]
	MOVW	#224,MS.SIZ(A1)		; SET MESSAGE SIZE TO 148 BYTES TOTAL [1.1]
	CLRW	MS.COD(A1)		; CLEAR THE MESSAGE CODE	[1.1]
	MOVW	#"UU,MS.SPR(A1)		; PUT UNIQUE ID ON MESSAGE	[1.1]
	MOVW	#1,MS.SPR+2(A1)		; [1.1]
	CLR	MS.SPR+6(A1)		; [1.1]
	JOBIDX	A6			; [1.1]
	MOV	JOBNAM(A6),MS.DAT+2(A1)	; SEND OUR JOB NAME	[1.1]
	TST	JOBTRM(A6)		; SEE IF JOB HAS TRMDEF	[1.1]
	BEQ	NOTRM			; IF NOT, DON'T LOOK FOR IT	[1.1]
	MOV	JOBTRM(A6),A6		; POINT TO TRMDEF	[1.1]
	SUB	#4,A6			; POINT TO TERMINAL NAME	[1.1]
	MOV	@A6,MS.SPR+6(A1)	; SAVE IT IN SPARE AREA	[1.1]
NOTRM:	CLRW	MS.FLG(A1)		; CLEAR THE FLAGS WORD	[1.1]
	SNDMSG	@A1,D6,0		; SEND THE MESSAGE TO THE SPOOLER [1.1]
	TST	D6			; CHECK RETURN STATUS	[1.1]
	BEQ	CONT			; IF OK, GO AROUND	[1.1]
	CMP	D6,#M$EDSF		; SEE IF SOCKET FULL	[1.1]
	BNE	EXIST			; IF NOT, SEE IF IT DOESN'T EXIST [1.1]
	SLEEP	#1000.			; SLEEP FOR 1/10 SECOND	[1.1]
	BR	NOTRM			; AND TRY AGAIN	[1.1]
EXIST:	CMP	D6,#M$ESNN		; SEE IF LPTSPL EXISTS	[1.1]
	JEQ	EXIT			; IF NOT, FINISH UP	[1.1]
	JMP	ERROR			; ELSE DO ERROR ROUTINE	[1.1]
CONT:	WTMSG	#10000.			; WAIT FOR NO MORE THAN 1 SECOND [1.1]
	JNE	EXIT			; IF NO RESPONSE, EXIT	[1.1]
	RCVMSG	@A1,D6,0		; RECEIVE THE MESSAGE	[1.1]
	TST	D6			; TEST FOR VALID MESSAGE	[1.1]
	BEQ	C.1			; AROUND IF OK	[1.1]
	JMP	ERROR			; IF NOT, PROCESS ERROR	[1.1]
C.1:	CMPW	MS.SPR(A1),#"UU		; CHECK FOR PROPER RESPONSE	[1.1]
	BNE	CONT			; IF NOT, WAIT FOR NEXT	[1.1]
	TSTW	30(A1)			; SEE IF END OF LIST	[1.1]
	JNE	EXIT			; IF SO, FINISH UP	[1.1]
	PUSH	A1			; [1.1]
	CTRLC	EXIT.1			; [1.1]
	LEA	A1,32(A1)		;UNPACK MACRO USES A1 AS THE RAD50 ADDRESS [1.1]
	LEA	A2,ASCBUF(A5)		;AND A2 AS THE ASCII STRING ADDRESS [1.1]
	CTRLC	EXIT.1			; [1.1]
	UNPACK				; [1.1]
	UNPACK				; [1.1]
	CTRLC	EXIT.1			; [1.1]
	LEA	A2,ASCBUF(A5)		;REPOSITION THE ASCII BUFFER	[1.1]
	CRLF				; [1.1]
	CTRLC	EXIT.1			; [1.1]
	TTYL	(A2)			;TYPE THE ASCII STRING	[1.1]
	ADD	#10,A1			; NOW POINT TO THE FORMS	[1.1]
	LEA	A2,ASCBUF(A5)		;RELOAD THE ASCII BUFFER	[1.1]
	UNPACK				; [1.1]
	UNPACK				; [1.1]
	CTRLC	EXIT.1			; [1.1]
	LEA	A2,ASCBUF(A5)		;REPOSITION THE ASCII BUFFER	[1.1]
	XY	-1,11			;HALF INTENSITY	[1.1]
	TYPESP	<........>		; [1.1]
	XY 	-1,12			;NORMAL VIDEO	[1.1]
	CTRLC	EXIT.1			; [1.1]
	TTYL	(A2)			;TYPE THE ASCII STRING	[1.1]
	CRLF				; [1.1]
	POP	A1			; [1.1]
	PUSH	A1			; [1.1]
	TSTW	114(A1)			; SEE IF SECOND ONE	[1.1]
	JNE	CONT			; [1.1]
	LEA	A1,116(A1)		; POINT TO SECOND PRINTER NAME	[1.1]
	LEA	A2,ASCBUF(A5)		;AND A2 AS THE ASCII STRING ADDRESS [1.1]
	CTRLC	EXIT.1			; [1.1]
	UNPACK				; [1.1]
	UNPACK				; [1.1]
	CTRLC	EXIT.1			; [1.1]
	LEA	A2,ASCBUF(A5)		;REPOSITION THE ASCII BUFFER	[1.1]
	CRLF				; [1.1]
	CTRLC	EXIT.1			; [1.1]
	TTYL	(A2)			;TYPE THE ASCII STRING	[1.1]
	ADD	#10,A1			; NOW POINT TO THE FORMS	[1.1]
	LEA	A2,ASCBUF(A5)		;RELOAD THE ASCII BUFFER	[1.1]
	UNPACK				; [1.1]
	UNPACK				; [1.1]
	CTRLC	EXIT.1			; [1.1]
	LEA	A2,ASCBUF(A5)		;REPOSITION THE ASCII BUFFER	[1.1]
	XY	-1,11			;HALF INTENSITY	[1.1]
	TYPESP	<........>		; [1.1]
	XY 	-1,12			;NORMAL VIDEO	[1.1]
	CTRLC	EXIT.1			; [1.1]
	TTYL	(A2)			;TYPE THE ASCII STRING	[1.1]
	CRLF				; [1.1]
	POP	A1			; [1.1]
	JMP	CONT			; AND WAIT FOR NEXT MESSAGE	[1.1]

EXIT.1:					; [1.1]
	POP	A1			; [1.1]
EXIT:
	CRLF
	EXIT


ERROR:	
	XY	24,1			; PUT MESSAGE AT BOTTOM OF SCREEN
	XY	-1,9
	XY	-2,4			; MAKE IT IN RED FOR COLOR TERMINALS
	TYPE	<No Spoolers Allocated or Error in ITC While Reading Printer Names>
	XY	-2,1			; BACK TO WHITE
	TTYI				; RING BELL
	BYTE	7,0
	EVEN
	EXIT

END