;      PTR.SBR - SUBROUTINE TO SCAN SPOOLER QUEUE & FIND PRINTER NAMES
;
; PRTS   SBR   2     737-425-332-116   2.0A(101)          134027  DSK0:[7,6]
;
;      03/16/88 - Version 2.0A - check pointers to be sure that we
;			don't UNPACK into any sensitive areas (for
;			instance, a Basic Disk DDB or something)
;			Brad Horine, American Communications Inc.
;
;      11/15/85 - VERSION 2.0 - ADD INTER-TASK COMMUNICATIONS FOR
;              RETRIEVING SPOOLERS UNDER TASK MANAGER.  D. EICHBAUER
;      06/13/85 - D. EICHBAUER
;
;                      PROPRIETARY PROGRAM MATERIAL
;
;      THIS MATERIAL IS THE PROPERTY OF DALE A. EICHBAUER,
;      692 E. FREELAND ROAD, MERRILL, MICHIGAN, 48637.  PERMISSION
;      TO COPY & USE IS GRANTED FOR NON-PROFIT USES ONLY.
;
;
       SEARCH  SYS
       SEARCH  SYSSYM

;;;    AUTOEXTERN

       OBJNAM	.SBR

       VMAJOR=2.
       VMINOR=0.
;;;    VSUB=0.
       VSUB=1
       VEDIT=101.
;;;    VWHO=1.

; OFFSETS IN ARGUMENT BLOCK FOR MESSAGE SOCKET OPEN 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 (see text)
       MS.DAT = 36             ; CORRECTS ERROR IN SYSSYM.UNV (see text)

; OFFSETS FROM A3 FOR PARAMETERS PASSED FROM BASIC

	.OFINI			; parameter list definitions
	.OFDEF	PARMS,2
	.OFDEF	TYPE.1,2
	.OFDEF	ADD.1,4
	.OFDEF	SIZE.1,4

; OFSETS FROM A4 FOR IMPURE ARA

	.OFINI			; impure list definitions
	.OFDEF	AVAIL,4
	.OFDEF	COUNT,4
	.OFSIZ	IMPSIZ		; size of desired impure area


DEFINE	XY	XXX,YYY
	MOVW	#<'XXX'._8.+'YYY'.>,D1
	TCRT
ENDM

       PHDR    -1,PV$RPD,PH$REE!PH$REU

       BR      START
       ASCII   / COPYRIGHT (C) 1985 DALE A. EICHBAUER /
       EVEN
START: NOP		; for breakpoint

	MOV	A5,D1			; A5 -> 1st "reserved" word
	SUB	A4,D1			; A4 -> 1st "available" word
	CMP	D1,#IMPSIZ		; check avail room
	JLT	IMPERR			; bomb if no room

	CMPW	PARMS(A3),#1		; exactly one argument ?
	JNE	ARGERR			;   nope, so bomb out

	MOV	SIZE.1(A3),AVAIL(A4)	; initialize
	CLR	COUNT(A4)		;   impure area

       MOV     ADD.1(A3),A2            ; POINT TO ARRAY TO RETURN
       MOV     LPTQUE,D2               ; GET BEGINNING OF SPOOLERS
       BEQ     TASK                    ; IF NOT FOUND, THEN RUNNING
                                       ; UNDER TASK MANAGER FOR SPOOLERS
       MOV     D2,A1                   ; USE THIS AS AN INDEX
LOOP:
	SUB	#6.,AVAIL(A4)		; check avail room
	JMI	BUFFUL			;   and notify if full
	INC	COUNT(A4)		;   else bump printer count

       ADD     #10,A1                  ; POINT TO PRINTER NAME IN TABLE
       UNPACK                          ; GET THE PRINTER NAME
       UNPACK                          ; NOW GET THE SECOND HALF
       MOV     D2,A1                   ; RESTORE BEGINNING OF TABLE ENTRY
       MOV     @A1,A1                  ; POINT TO NEXT ENTRY
       MOV     A1,D2                   ; SEE IF END OF CHAIN
       BNE     LOOP                    ; IF NOT, KEEP GOING

;;; at this point, if you wish to stop after locating the interrrupt-driven
;;; printers without checking for Task Manager-controlled printers, remove
;;; the three semicolons infront of the RTN statement below

	RTN		; back to Basic

TASK:  PUSH                            ; USE THE STACK
       PUSH                            ; FOR THE ARGUMENT BLOCK
       PUSH                            ; FOR THE OPEN SOCKET CALL
       MOV     SP,A6                   ; POINT TO ARGUMENT BLOCK       
       MOVW    #-100000,OM.FLG(A6)     ; SET FLAGS TO ENABLE SOCKET
       MOVW    #2000,OM.LEN(A6)        ; SET MAXIMUM MESSAGE LENGTH TO 1024
       MOVW    #12,OM.MAX(A6)          ; SET MAX # OF PENDING MESSAGES TO 10
       CLR     OM.MSR(A6)              ; CLEAR MESSAGE SERVICE ROUTINE ADDRESS
       OPNMSG  @A6,D6                  ; OPEN MESSAGE SOCKET
       POP                             ; NOW CLEAR THE STACK
       POP                             ; BACK TO WHERE IT WAS
       POP
       TST     D6                      ; SEE WHAT STATUS WAS RETURNED
       BEQ     ITC.OK                  ; IF OK, THEN CONTINUE
       CMP     D6,#M$ENMS              ; SEE IF OLD VERSION OF AMOS/L
       JNE     ERROR                   ; IF NOT, ERROR, SO GO TO ERROR ROUTINE
       RTN                             ; ELSE JUST GO BACK TO BASIC
ITC.OK:
       MOV     A4,A1                   ; NOW POINT TO MESSAGE BLOCK (IMPURE)
       MOV     #45,D6                  ; LOOP COUNTER
NULLS: CLR     (A1)+                   ; CLEAR A WORD IN MESSAGE BLOCK
       SOB     D6,NULLS                ; AND LOOP BACK TILL DONE
       MOV     A4,A1                   ; POINT TO START OF MESSAGE BLOCK AGAIN
       MOVW    #-3,14(A1)              ; SET FOR LPTSPL SOCKET
       MOVW    #224,MS.SIZ(A1)         ; SET MESSAGE SIZE TO 148 BYTES TOTAL
       CLRW    MS.COD(A1)              ; CLEAR THE MESSAGE CODE
       MOVW    #"UU,MS.SPR(A1)         ; PUT UNIQUE ID ON MESSAGE (SAME AS AM)
       MOVW    #1,MS.SPR+2(A1)
       CLR     MS.SPR+6(A1)
       JOBIDX  A5
       MOV     JOBNAM(A5),MS.DAT+2(A1) ; SEND OUR JOB NAME
       TST     JOBTRM(A5)              ; SEE IF JOB HAS TRMDEF
       BEQ     NOTRM                   ; IF NOT, DON'T LOOK FOR IT
       MOV     JOBTRM(A5),A5           ; POINT TO TRMDEF
       SUB     #4,A5                   ; POINT TO TERMINAL NAME
       MOV     @A5,MS.SPR+6(A1)        ; SAVE IT IN SPARE AREA
NOTRM: CLRW    MS.FLG(A1)              ; CLEAR THE FLAGS WORD
       SNDMSG  @A1,D6,0                ; SEND THE MESSAGE TO THE SPOOLER
       TST     D6                      ; CHECK RETURN STATUS
       BEQ     CONT                    ; IF OK, GO AROUND
       CMP     D6,#M$EDSF              ; SEE IF SOCKET FULL
       BNE     EXIST                   ; IF NOT, SEE IF IT DOESN'T EXIST
       SLEEP   #1000.                  ; SLEEP FOR 1/10 SECOND
       BR      NOTRM                   ; AND TRY AGAIN
EXIST: CMP     D6,#M$ESNN              ; SEE IF LPTSPL EXISTS
       BNE     ERROR                   ; IF NOT, THEN ERROR
       BR      EXIT                    ; ELSE JUST GO BACK TO BASIC
CONT:  WTMSG   #10000.                 ; WAIT FOR NO MORE THAN 1 SECOND
       BNE     EXIT                    ; IF NO RESPONSE, EXIT
       RCVMSG  @A1,D6,0                ; RECEIVE THE MESSAGE
       TST     D6                      ; TEST FOR VALID MESSAGE
       BNE     ERROR                   ; IF NOT, PROCESS ERROR
       CMPW    MS.SPR(A1),#"UU         ; CHECK FOR PROPER RESPONSE
       BNE     CONT                    ; IF NOT, WAIT FOR NEXT
       TSTW    30(A1)                  ; SEE IF END OF LIST
       BNE     EXIT                    ; IF SO, FINISH UP

	SUB	#6.,AVAIL(A4)		; check avail room
	JMI	BUFFUL			;   and notify if full
	INC	COUNT(A4)		;   else bump printer count

       PUSH    A1
       LEA     A1,32(A1)               ; POINT TO FIRST PRINTER NAME
       UNPACK                          ; GET FIRST HALF OF PRINTER NAME
       UNPACK                          ; AND SECOND HALF
       POP     A1
       TSTW    114(A1)                 ; SEE IF SECOND ONE
       BNE     EXIT
       PUSH    A1
       LEA     A1,116(A1)              ; POINT TO SECOND PRINTER NAME
       UNPACK
       UNPACK
       POP     A1
       BR      CONT                    ; AND WAIT FOR NEXT MESSAGE
EXIT:
       CLSMSG  D6                      ; CLOSE MESSAGE SOCKET
       RTN                             ; BACK TO BASIC

ERROR: 
       XY      24,1                    ; PUT MESSAGE AT BOTTOM OF SCREEN
       XY      -1,9
       XY      -2,4                    ; MAKE IT IN RED FOR COLOR TERMINALS
       TYPE    <Error in ITC While Reading Printer Names>
       XY      -2,1                    ; BACK TO WHITE
       TTYI                            ; RING BELL
       BYTE    7,0
       EVEN
       SLEEP   #30000.                 ; WAIT 3 SECONDS SO THEY CAN SEE MESSAGE
       JMP     EXIT                    ; THEN BACK TO BASIC

BUFFUL:				; buffer variable filled up !!
	XY	24,01
	XY	-1,09
	TYPESP	<%Buffer full,>
	MOV	COUNT(A4),D1		; see if any names got saved
	BEQ	10$
	TYPESP	<only>	
	DCVT	0,OT$TRM		; output count to CRT
	BR	20$
10$:	TYPE	<no>
20$:	TYPE	< printer>
	CMP	D1,#1
	BEQ	30$
	TYPE	<s>
30$:	TYPESP	< defined in PRTS.SBR>
	TTYI				; ding the terminal bell
	BYTE	7.,0
	EVEN
	SLEEP	#50000.			; snooze for 5 secs
	XY	24,01			; clear the message
	XY	-1,09
	RTN				; back to Basic

IMPERR:
	XY	23,80			; write "end reverse" attribute
	XY	-1,33	
	XY	22,80			; write "begin reverse" attribute
	XY	-1,32
	XY	23,01
	TYPESP	<?Insufficient memory to allocate impure area>
	TYPESP	<in PRTS.SBR>
	XY	23,80			; write "end reverse" attribute
	XY	-1,33	
	TTYI				; ding the terminal bell
	BYTE	7.,0
	EVEN
	EXIT				; and PLOP to the os prompt

ARGERR:
	XY	23,80			; write "end reverse" attribute
	XY	-1,33	
	XY	22,80			; write "begin reverse" attribute
	XY	-1,32
	XY	23,01
	TYPESP	<?Improper number of arguments in PRTS.SBR>
	XY	23,80			; write "end reverse" attribute
	XY	-1,33	
	TTYI				; ding the terminal bell
	BYTE	7.,0
	EVEN
	EXIT				; and PLOP to the os prompt

       ASCII   / COPYRIGHT (C) 1985 DALE A. EICHBAUER /
       EVEN

       END

.