;***************************************************************************
;*              ************************************************************
;* SPOOL.M68    ************************************************************
;*              ************************************************************
;***************************************************************************
;
; Programmed by:        John Ryan
;                       Ryan & Vint Associates
;                       Santa Ana, CA
;                       (714)835-3073
;
; Replacement for AM's SPOOL.SBR 1.0(100)-1, which either causes parity errors
; or keeps hanging the system when called with more than one parameter.
;
;
       SEARCH  SYS
       SEARCH  SYSSYM
;
       ARGBLK=10.                      ; BASIC argument block size
;
       OBJNAM  0,0,[SBR]
       EXTERN  $GTARG
;
; Program variables - impure area allocated from free region @A1:
       .OFINI
       .OFDEF  SWITCH,2                ; Switches - see BASIC manual for list
       .OFDEF  PRINTR,4                ; Printer name packed RAD50
       .OFDEF  COPIES,2                ; Number of copies
       .OFDEF  BLOCKS,2                ; Number of blocks required
       .OFDEF  FORM,4                  ; Form name packed RAD50
       .OFDEF  WIDTH,1                 ; Header line width
       .OFDEF  LPP,1                   ; Lines per page
       .OFDEF  DDBBUF,512.             ; Buffer for DDB
       .OFDEF  DDB,D.DDB               ; DDB for file to spool
       EVEN
       .OFSIZ  IMPSIZ                  ; Size of impure area
;
; Line printer queue block offsets for elements within queue for a particular
; printer. LPTQUE => first queue element, which is a list of printers.  Each
; printer begins another queue of requests pending for that printer.
; These offsets are from start of the data area (after 1st longword pointer to
; next queue block or 0 if none) as deduced from disassembly of SPOOL).
; Names are my own of course.
       LP.FIL=0                        ; file name
       LP.EXT=LP.FIL+4                 ; extension
       LP.DEV=LP.EXT+2                 ; device name
       LP.PPN=LP.DEV+2                 ; PPN
       LP.UNI=LP.PPN+2                 ; device unit number
       LP.COP=LP.UNI+2                 ; copies
       LP.SWI=LP.COP+2                 ; switches
       LP.FRM=LP.SWI+2                 ; form name
       LP.LPP=LP.FRM+4                 ; lines per page
       LP.WID=LP.LPP+2                 ; width (also 1 word)
;
; Offsets for first printer queue, listing available printers
       LP.PTR=4                        ; addr of 1st element in queue this printer
       LP.NAM=10                       ; printer name word (RAD50)
       LP.BLK=20                       ; number of blocks pending for this printer
       LP.FLG=22                       ; flag word
       LP.JOB=24                       ; addr of spooler job using this printer
;
       LP.DEF=20                       ; bit pattern in flag word - if set,
                                       ; indicates this is the default printer
;
       VMAJOR=1.
       VMINOR=0.
       VSUB=1.
       VEDIT=1.
       PHDR    -1,0,PH$REE!PH$REU
;
; Setup code - use A1 to point to base of my impure area
SPOOL:: EVNA    A4                      ; ensure A4 is even
       MOV     A4,A1                   ; point to base
       ADD     #IMPSIZ,A4              ; add size - so later $GTARG calls ok
       CMP     A4,A5                   ; make sure there's room
       JHIS    ERR1
;
       CALL    CLRARG                  ; clear impure area
       CALL    GETARG                  ; get arguments and store
       JNE     BACK
;
       MOV     LPTQUE,A2               ; line printer queue head
       MOV     A2,D7                   ; copy so sets condition codes
       JEQ     NOPRT                   ; no printers set up for spooling
       TST     PRINTR(A1)              ; was the printer name passed?
       JEQ     FNDPRT                  ; no - find the default printer
10$:    MOV     PRINTR(A1),D7           ; yes - find specified printer
       CMP     D7,LP.NAM(A2)           ; right name?
       BEQ     HAVPRT                  ; match
       MOV     @A2,A2                  ; point to next element (& set Z bit)
       MOV     A2,D7                   ; copy to set condition codes
       JEQ     NOPRT                   ; no more to test?
       BR      10$                     ; test the next
; A1 is my impure pointer
; A2 points to printer queue element to use
HAVPRT: LOOKUP  DDB(A1)                 ; setup D.WRK area
       JNE     BACK                    ; file not found
       JOBIDX  A6
       MOVW    JOBUSR(A6),D1           ; get current PPN
       CMPW    D1,DDB+D.PPN(A1)        ; compare to file's
       BEQ     CKQUE                   ; same - ok
       ANDW    #-5,SWITCH(A1)          ; reset deletion switch if PPNs
       ORW     #10,SWITCH(A1)          ;   differ
CKQUE:  CMP     QFREE ,#15.             ; at least 15 free queue blks remain?
       BLOS    WTQUE
       JLOCK                           ; no context switch while updating queue
       MOVW    COPIES(A1),D0           ; number copies requested
       MOV     DDB+D.WRK(A1),D2        ; number of blocks in file
       MUL     D0,D2                   ; total number blocks required in D0
       CMP     D0,#^H0FFFF             ; range check
       BLOS    20$                     ; use unsigned arithmetic
10$:    CALL    ERR5                    ; inform caller
       BR      DONE                    ; and return
20$:    MOVW    D0,BLOCKS(A1)           ; save number blocks required
       ADDW    LP.BLK(A2),D2           ; bump number pending
       BVS     10$                     ; too many?
       LEA     A3,LP.PTR(A2)           ; addr of start of queue for this printer
       QADD    A3                      ; add block to end of list
       BNE     DONE                    ; no block available
       MOVW    D2,LP.BLK(A2)           ; save total pending for printer
; fill in queue block
       MOV     DDB+D.FIL(A1),(A3)+     ; filename from DDB
       MOVW    DDB+D.EXT(A1),(A3)+     ; extension
       MOVW    DDB+D.DEV(A1),(A3)+     ; device
       MOVW    DDB+D.PPN(A1),(A3)+     ; PPN
       MOVW    DDB+D.DRV(A1),(A3)+     ; unit number
       MOVW    COPIES(A1),(A3)+        ; copies
       MOVW    SWITCH(A1),@A3          ; switches
       ANDW    #-401,(A3)+             ; clear extra bits
       MOV     FORM(A1),(A3)+          ; copy form
       MOVW    BLOCKS(A1),(A3)+        ; number of blocks
       MOVB    LPP(A1),(A3)+           ; lines per page
       MOVB    WIDTH(A1),(A3)+         ; page width
DONE:   JUNLOK                          ; permit context switching
       MOV     LP.JOB(A2),A0           ; point to spooler for this printer
       JRUN    40                      ; start up the spooler
       RTN                             ; to BASIC - normally
;
; **************************************************************************
; Extended mainline routines
; See if should wait for queue blocks or just return
WTQUE:  MOVW    SWITCH(A1),D7
       ANDW    #400,D7
       BEQ     10$
       MOV     #10000.,D6              ; 1 second wait
       SLEEP
       JMP     CKQUE
10$:    TYPECR  ?Not enough queue blocks for spooler request
       RTN                             ; to user - not enough queue space
NOPRT:  TYPECR  ?Unable to find specified printer
BACK:   RTN                             ; to user
; find the default printer to use - A2 points to head of line printer queue
FNDPRT: MOVW    LP.BLK(A2),D2           ; number of blocks
; use SP as save area for pointer to queue element chosen
       PUSH    A2                      ; first printer in queue
       MOVW    LP.FLG(A2),D7           ; test - is this the default printer?
       ANDW    #LP.DEF,D7              ; bit test
       BNE     GOTPRT                  ; yes
10$:    MOV     @A2,A2                  ; point to next element and repeat test
       MOV     A2,D7                   ; set condition codes
       BEQ     GOTPRT                  ; any more?
       MOVW    LP.FLG(A2),D7           ; get status
       ANDW    #LP.DEF,D7              ; bit test
       BNE     20$                     ; have printer => br
       CMPW    D2,LP.BLK(A2)           ; if none flagged, use printer with
       BLO     10$                     ;   fewest pending blocks
       MOVW    LP.BLK(A2),D2           ; D2 saves least number blocks
       MOV     A2,@SP                  ; (SP) saves ptr to queue w/ least blks
       BR      10$                     ; search next queue element
20$:    MOV     A2,@SP                  ; set up for next instruction
GOTPRT: POP     A2                      ; set A2 to queue element to use
       JMP     HAVPRT                  ; return
;
; ***** Subroutines ********************************************************
;
; **************************************************************************
;       These were extracted from WLSRCH subroutine for speedy use, with
;       minor modifications - JRR.
; **************************************************************************
;
; Clear the impure area from (A1)
CLRARG: MOV     A1,A6
       MOV     #<IMPSIZ/2>-1,D7
1$:     CLRW    (A6)+
       DBF     D7,1$
       RTN
;
; Get the parameters passed:
; D0 = index to argument blocks
; D1, D2 = parameter passing registers
; D3, D4 = work registers
; A0 = BASIC impure area pointer
; A3 = BASIC argument pointer
; A4 = BASIC's free pointer
; A5 = BASIC's arithmetic stack
; A1 = my impure area pointer
; A2 = string pointer work register
; A6 = work register (not preserved across monitor calls)
GETARG: TSTW    (A3)                    ; see if at least 1 argument passed
       JEQ     ERR2                    ; nope
       CMPW    (A3),#7                 ; more than 7 arguments?
       JGT     ERR2                    ; yep - jump
       LEA     A4,DDB(A1)              ; Use A4 as DDB base register
       MOV     #2,D0                   ; initialize argument pointer
;
       MOVW    #1,COPIES(A1)           ; set copy default
       MOVW    #[NOR],FORM(A1)         ; set printer form default
       MOVW    #[MAL],FORM+2(A1)
;
       CALL    GTADDR                  ; get addr of filename parm
       JNE     110$                    ; error return
       LEA     A6,DDBBUF(A1)           ; point to buffer
       MOV     A6,DDB+D.BUF(A1)        ; save absolute buffer addr in DDB
       MOVB    #D$INI!D$ERC,DDB+D.FLG(A1) ; flag buffer inited, return on error
       MOV     D1,A2                   ; copy pointer to addr
       MOV     A2,A6                   ; another copy
       ADD     D2,A6                   ; add size
       MOV     A6,D4                   ; save end pointer
       MOVB    (A6),D3                 ; save last byte
       CLRB    (A6)                    ; clear the byte - ensure legal string
       FSPEC   DDB(A1),LST             ; set up DDB
       MOV     D4,A6                   ; restore end pointer
       MOVB    D3,(A6)                 ; restore former byte
       TSTB    DDB+D.ERR(A1)           ; check for errors
       JNE     110$                    ; return if so
;
; LOOKUP use 0 defaults - ok for INPUT, etc. but not printer spooler
; replace defaults with job's defaults
       JOBIDX  A6
       TSTW    DDB+D.PPN(A1)           ; PPN specified?
       BNE     10$
       MOVW    JOBUSR(A6),DDB+D.PPN(A1)
10$:    TSTW    DDB+D.DEV(A1)           ; device name
       BNE     20$
       MOVW    JOBDEV(A6),DDB+D.DEV(A1)
       MOVW    JOBDRV(A6),DDB+D.DRV(A1)
       BR      30$
20$:    CMPW    DDB+D.DRV(A1),#-1
       BNE     30$
       MOVW    JOBDRV(A6),DDB+D.DRV(A1)
30$:    CMPW    (A3),#1                 ; 1 argument?
       JEQ     100$                    ; yes - we are done
       CALL    GTADDR                  ; get addr of printer name string
       JNE     110$                    ; error
       MOV     A1,D3                   ; save my impure pointer
       LEA     A1,PRINTR(A1)           ; point A1 to buffer
       MOV     D1,A2                   ; A2 points to string to pack
       PACK
       PACK
       MOV     D3,A1                   ; restore impure pointer
;
       CMPW    (A3),#2                 ; 2 arguments?
       JEQ     100$                    ; yes => done
       CALL    GTNMBR                  ; get a number
       JNE     110$                    ; error?
       MOVW    D1,SWITCH(A1)           ; save switches
;
       CMPW    (A3),#3                 ; 3 arguments?
       JEQ     100$                    ; done?
       CALL    GTNMBR                  ; get number
       JNE     110$                    ; error?
       CMP     D1,#^H0FFFF             ; out of range?
       BLOS    40$                     ; use unsigned arithmetic
       CALL    ERR4                    ; inform caller
       JMP     110$                    ; and take error return
40$:    MOVW    D1,COPIES(A1)           ; save copies requested
       BNE     42$                     ; no - leave default
       MOVW    #1,COPIES(A1)           ; restore copy default
;
42$:    CMPW    (A3),#4                 ; 4 arguments?
       JEQ     100$                    ; done?
       CALL    GTADDR                  ; get addr of form string
       JNE     110$                    ; error?
       MOV     A1,D3                   ; save my impure pointer
       LEA     A1,FORM(A1)             ; point A1 to buffer
       MOV     D1,A2                   ; A2 points to string to pack
       PACK
       PACK
       MOV     D3,A1                   ; restore impure pointer
       TST     FORM(A1)
       BNE     44$
       MOVW    #[NOR],FORM(A1)         ; restore printer form default
       MOVW    #[MAL],FORM+2(A1)
;
44$:    CMPW    (A3),#5                 ; 5 arguments?
       JEQ     100$                    ; done?
       CALL    GTNMBR                  ; get number
       JNE     110$                    ; error?
       CMP     D1,#^H0FF               ; out of range?
       BLOS    50$                     ; use unsigned arithmetic
       CALL    ERR4                    ; inform caller
       JMP     110$                    ; and take error return
50$:    MOVB    D1,WIDTH(A1)            ; save line width for header
;
       CMPW    (A3),#6                 ; 6 arguments?
       JEQ     100$                    ; done?
       CALL    GTNMBR                  ; get number
       JNE     110$                    ; error?
       CMP     D1,#^H0FF               ; out of range?
       BLOS    60$                     ; use unsigned arithmetic
       CALL    ERR4                    ; inform caller
       JMP     110$                    ; and take error return
60$:    MOVB    D1,LPP(A1)              ; save lines per page
;
;
100$:   LCC     #4                      ; normal return
       RTN
110$:   LCC     #0                      ; error return
       RTN
;
; Return a numeric argument value into D1 (binary, fp or string)
; Address of argument returned in D2
; A3, A5 are as entered subroutine from BASIC - D0 has offset to argument blk
GTNMBR: MOV     D0,D1                   ; index to D1
       MOV     2(A3)[D1],D2            ; save address
       ANDW    #7,0(A3)[D1]            ; clear meaningless & subscript bit
       CMPW    0(A3)[D1],#0            ; unformatted variable?
       JEQ     ERR3                    ; yes - a no no
       CMPW    0(A3)[D1],#6            ; binary variable?
       BNE     1$                      ; nope
       CMP     6(A3)[D1],#4            ; 4 bytes or less?
       JGT     ERR3                    ; no => error
       MOV     2(A3)[D1],A6            ; addr to A6
       MOV     @A6,D1                  ; binary var to D1
       BR      NXTARG
1$:     CALL    $GTARG                  ; decode fp or string variable
       JNE     ERR3                    ; conversion error check
NXTARG: ADD     #ARGBLK,D0              ; bump argument index
       LCC     #4                      ; set Z bit
       RTN
;
; Return an address in D1, and size in D2 - strings or unformatted variables
; A3 = Basic argument pointer
; D0 = argument index
GTADDR: MOV     D0,D1                   ; put index into D1
       ANDW    #7,0(A3)[D1]            ; clear meaningless & subscript bit
       CMPW    0(A3)[D1],#4            ; fp?
       JEQ     ERR3
       CMPW    0(A3)[D1],#6            ; binary?
       JEQ     ERR3
; Don't check variable type
GTADR2: MOV     D0,D1                   ; set up index again
       MOV     6(A3)[D1],D2            ; size to D2
       MOV     2(A3)[D1],D1            ; addr to D1
       BR      NXTARG
;
; ***************************************************************************
; Error routines
ERR1:   TYPE <?Insufficient impure memory space>
       JMP     ERRMSG
ERR2:   TYPE <?Missing or excess arguments>
       JMP     ERRMSG
ERR3:   TYPE <?Bad argument #>
ERR31:  SUB     #2,D0                           ; subtract 1st word
       MOV     #1,D1                           ; counter for # arguments
1$:     TST     D0                              ; when 0, at the argument
       BLE     2$
       SUB     #ARGBLK,D0
       INC     D1
       BR      1$
2$:     DCVT    2,OT$TRM!OT$LSP!OT$TSP          ; decimal #, bracket w/ blanks
       BR      ERRMSG
ERR4:   TYPE <?Result too large for argument #>
       SUB     #ARGBLK,D0
       BR      ERR31
ERR5:   TYPE <?Too many blocks total pending to print>
ERRMSG: TYPECR < in XCALL SPOOL>
       LCC     #0                              ; clear Z bit
       RTN
;
       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.