;     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

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.