Trailing-Edge
-
PDP-10 Archives
-
tops20-v7-ft-dist2-clock
-
galaxy-sources/lptsub.mac
There are 8 other files named lptsub.mac in the archive. Click here to see a list.
TITLE LPTSUB - Subroutines for LPTSPL/LPTCLU/LPTDQS
SUBTTL Preliminaries
.DIRECTIVE FLBLST
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH GLXMAC ;Search GLXLIB's symbols
SEARCH LPTMAC ;Search LPTSPL's symbols
SEARCH QSRMAC ;Search QUASAR's symbols
SEARCH ORNMAC ;Search ORION's symbols
IFN FTACNT,<
SEARCH ACTSYM ;Search for accounting symbols
>
SEARCH MACSYM ;[7]Search monitor's macros
SALL ;Suppress macro expansion
RELOC ;Relocatable code follows
PROLOGUE(LPTSUB) ;Generate the necessary symbols
LSBMAN==:0 ;Maintenance edit number
LSBDEV==:7 ;Development edit number
VERSIN (LSB) ;Generate edit number
Subttl Table of Contents
; Table of Contents for LPTSUB
;
; Section Page
;
;
; 1. Revision history . . . . . . . . . . . . . . . . . . . 3
; 2. Global Symbols . . . . . . . . . . . . . . . . . . . . 4
; 3. Storage . . . . . . . . . . . . . . . . . . . . . . . 5
; 4. Read Print File
; 4.1 INPOPN - Routine to open the input file . . . 6
; 4.2 INPBUF - Read a buffer from the input file . . 8
; 4.3 INPBYT - Read a byte from the input file . . . 9
; 4.4 INPERR - Handle an input failure . . . . . . . 10
; 4.5 INPFEF - Force end-of-file on next input . . . 11
; 4.6 INPREW - Rewind the input file . . . . . . . . 12
; 4.7 INPCLS - Close the input file . . . . . . . . 13
; 5. DECnet Connections
; 5.1 GETLNK - Get DECnet JFN . . . . . . . . . . . 14
; 5.2 FNDCER - Find DECnet Error . . . . . . . . . . 15
; 5.3 DNERR - DECnet Disconnect Codes . . . . . . . 16
; 5.4 ABTLNK - Close DECnet Link . . . . . . . . . . 17
; 6. DECnet Inactivity
; 6.1 SETIM - Set the DECnet inactivity timer . . . 18
; 6.2 PROTIM - DECnet Inactivity Timer Processor . . 19
; 6.3 CLRTIM - Clear the DECnet inactivity timer . . 20
; 7. Logging Routines
; 7.1 Common Messages . . . . . . . . . . . . . . . 21
; 7.2 LOGCHR - Type a character in the log file . . 22
; 7.3 LOGBUF - Get a buffer page for LOG . . . . . . 23
; 8. Forms Routines
; 8.1 Format of LPFORM.INI . . . . . . . . . . . . . 24
; 8.2 Default Forms Switches . . . . . . . . . . . . 25
; 8.3 FORMS - Setup Forms For A Job . . . . . . . . 26
; 8.4 Read LPFORM.INI . . . . . . . . . . . . . . . 30
; 8.5 Forms Switch Subroutines . . . . . . . . . . . 33
; 8.6 I/O Subroutines for LPFORM.INI . . . . . . . . 37
; 8.7 OPNFRM - Routine to open LPFORM.INI . . . . . 39
; 9. VFU/RAM Routines
; 9.1 LODVFU - Load the Vertical Forms Unit . . . . 40
; 9.2 NOVFU - VFU File Not Found . . . . . . . . . . 41
; 9.3 LODRAM - Load The Translation RAM . . . . . . 42
; 9.4 NORAM - Process RAM Loading Errors . . . . . . 43
; 10. Accounting
; 10.1 ACTBEG - Accounting Initialization Routine . . 44
; 10.2 ACTEND - Accounting Summary Routine . . . . . 45
; 10.3 ACTLST - Spooler Accounting Record . . . . . . 46
; 11. End of LPTSUB . . . . . . . . . . . . . . . . . . . . 48
SUBTTL Revision history
COMMENT \
***** Release 6.0 -- begin development edits *****
1 6.1036 21-Oct-87
Add LPTSUB as the subroutine module for LPTSPL/LPTCLU/LPTDQS.
2 6.1063 8-Nov-87
Add a new entry point to routine GETLNK to indicate the call is
for a Cluster LPTSPL so as to be able to open the DECnet link with 36
bit bytes.
3 6.1064 8-Nov-87
Last edit broke LPTDQS.
4 6.1071 9-Nov-87
Move logging routines, forms routines, and other routines here
since they are called by LPTDQS as well as LPTSPL. The routines added
are LOGCHR, FORMS, LSTAF, LFINF, LODVFU, LODRAM, INPOPN, INPBUF,
INPBYT, INPERR, INPFEF, INPREW, INPCLS ACTBEG, and ACTEND along with
other symbols needed for this change to work
5 6.1153 30-Dec-87
In routine FRMIN4: check for 'LAT' as a valid indicator in LPFORM.INI.
6 6.1225 8-Mar-88
Update copyright notice.
7 6.1255 13-May-88
When displaying information about print requests that originated on a
remote node in the cluster, do not use the job information block to pick up
the user number to obtain the user name. Instead, use the user name that was
stored in .EQOWN by the remote QUASAR.
\
SUBTTL Global Symbols
;Global symbols defined in LPTSUB
INTERN ABTLNK,CASTIM,SETIM,GETLIK,GETLNK,FNDCER,PROTIM
INTERN LOGCHR,FORMS,LSTAF,LFINF,LODVFU,LODRAM ;[4]
INTERN D$ALSL,D$ALCN,D$TAPE,FMOPN,FILTYP ;[4]
INTERN LPMSG,LPDAT,LPOPR,LPEND,LPERR ;[4]
INTERN INPOPN,INPBUF,INPBYT,INPERR,INPFEF,INPREW,INPCLS ;[4]
INTERN ACTBEG,ACTEND ;[4]
;Global symbols defined in LPTSPL
EXTERN JOBACT,DEPBP,TEXTBP,JOBCHK,JOBOBA,JOBUPD,JOBWAC ;[4]
EXTERN CONANS,ENDRSP,OUTWON,OUTDMP,STREAM,ALISCD ;[4]
EXTERN LPTVNO,DSCHD,SENDFF,IB,$MTOPR ;[4]
EXTERN RMJOBI ;[7]
;Global symbols defined in LPTCLU
EXTERN SETFD ;[4]
SUBTTL Storage
;Storage used to read LPFORM.INI
FOB: BLOCK FOB.SZ ;[4] A file open block for LPFORM.INI
FMOPN: BLOCK 1 ;[4] Set to -1 when LPFORM.INI open
FMIFN: BLOCK 1 ;[4] The IFN for LPFORM.INI
SUBTTL Read Print File -- INPOPN - Routine to open the input file
;[4] INPOPN is called with ac "E" pointing to the FP area for the file
;[4] to be opened.
INPOPN: MOVEI S1,FOB.SZ ;Get the FOB size
MOVEI S2,J$XFOB(J) ;And the FOB address
$CALL .ZCHNK ;Zero it out
SETZM J$TFIL(J) ;Assume no temporary file
LOAD S1,.FPINF(E),FP.NRA ;Remote user access to the file?
JUMPN S1,INPO.5 ;If no, indicate in log
LOAD S1,.FPINF(E),FP.CPY ;Pick up if temporary file or not
MOVEM S1,J$TFIL(J) ;Save the file type
JUMPE S1,INPO.1 ;Not a temp file, pick up fd
$CALL SETFD ;Set up the temporary file's fd
JRST INPO.2 ;Go determine byte size
INPO.1: LOAD S1,.FPLEN(E),FP.LEN ;Get the fp length
ADD S1,E ;Get the fd address
MOVEM S1,J$DFDA(J) ;Save the address
STORE S1,J$XFOB+FOB.FD(J) ;Save in the fob
INPO.2: MOVEI S1,7 ;Load probable (7 bit) byte size
LOAD T1,.FPINF(E),FP.FFF ;Get /FILE:
LOAD T2,.FPINF(E),FP.FPF ;Get /PRINT:
CAXN T1,.FPF8B ;Was it /FILE:8-BIT?
MOVEI S1,^D8 ;Yes load 8 bit byte size
CAXN T1,.FPF11 ;Was it /FILE:ELEVEN?
MOVEI S1,^D36 ;Yes load 36 bit byte size
CAIE T1,.FPFCO ;/FILE:COBOL?
CAIN T2,%FPLOC ; or /PRINT:OCTAL?
MOVEI S1,^D36 ;Yes, use full words
STORE S1,J$XFOB+FOB.CW(J),FB.BSZ ;And save the byte size
SETZM J$XFOB+FOB.US(J) ;Default to no access checking
SETZM J$XFOB+FOB.CD(J) ;Here also
LOAD S1,.EQSEQ(J),EQ.PRV ;Get the users privilge bits
JUMPN S1,INPO.3 ;If set, avoid access check
LOAD S1,.FPINF(E),FP.SPL ;Likewise if spooled
JUMPN S1,INPO.3 ; ...
HRROI S1,.EQOWN(J) ;Get the owners name
STORE S1,J$XFOB+FOB.US(J) ;Save it
HRROI S1,.EQCON(J) ;Get connected directory
STORE S1,J$XFOB+FOB.CD(J) ;And save it
;Continued on next page
;Continued from previous page
;Ready to open file
INPO.3: MOVEI S1,FOB.SZ ;Get fob size
MOVEI S2,J$XFOB(J) ;And address
$CALL F%IOPN ;Open the file
JUMPF INPO.4 ;Jump if failed
MOVEM S1,J$DIFN(J) ;Else, save the ifn
$RETT ;And return
INPO.4: TXNE S,CLUSPL ;Is this a cluster LPTSPL?
$RETF ;Yes, return now
JRST INPO.6 ;Go indicate can't access file
INPO.5: LOAD S1,.FPLEN(E),FP.LEN ;Get the fp length
ADD S1,E ;Get the fd address
MOVEM S1,J$DFDA(J) ;Save the address
INPO.6: MOVE S1,J$TFIL(J) ;Pick up temporary file or not
$TEXT(LOGCHR,<^I/LPERR/Can't access file ^I/@FILTYP(S1)/, ^E/[-1]/>)
ZERO .FPINF(E),FP.DEL ;Clear the 'delete file' bit
$RETF ;And return
SUBTTL Read Print File -- INPBUF - Read a buffer from the input file
;[4] Here to get a buffer from the input file
INPBUF: MOVE S1,J$DIFN(J) ;Get the ifn
$CALL F%IBUF ;Get a bufferful
JUMPF INPERR ;Lose
MOVEM S1,J$DBCT(J) ;Save the byte count
MOVEM S2,J$DBPT(J) ;And the byte pointer
AOS J$ADRD(J) ;Add 1 to buffer read count.
EXCH S1,J$FCBC(J) ;Get old bufr byte cnt and save new
ADDM S1,J$FTBC(J) ;Bump total bytes processed
$RETT ;Then return
SUBTTL Read Print File -- INPBYT - Read a byte from the input file
;[4] Get a byte from the file in S1, returns FALSE if EOF.
INPBYT: SOSGE J$DBCT(J) ;Make sure there is data in the buffer.
JRST INPB.1 ;If not get another buffer
ILDB C,J$DBPT(J) ;Pick up a byte from the buffer.
$RETT ;And return.
INPB.1: $CALL INPBUF ;Read the next buffer
JUMPF .RETF ;No more return
JRST INPBYT ;Else get the next byte.
SUBTTL Read Print File -- INPERR - Handle an input failure
;[4] Here to handle input errors
INPERR: CAXN S1,EREOF$ ;Was it eof?
$RETF ;Was just return
$TEXT(LOGCHR,<^I/LPERR/Error reading input file - ^E/[-1]/>)
TXO S,SKPFIL ;Skip the rest of the file
$RETF ; and return
SUBTTL Read Print File -- INPFEF - Force end-of-file on next input
;[4] Here to force end of file on next input
INPFEF: SKIPN S1,J$DIFN(J) ;Is the spool file open?
$RETT ;No just return
SETOB S2,J$DBCT(J) ;Clear byte count and set eof pos
$CALL F%POS ;And position it
$RETT ;And return
SUBTTL Read Print File -- INPREW - Rewind the input file
;[4] Here to rewind input file
INPREW: MOVE S1,J$DIFN(J) ;Get the ifn
$CALL F%REW ;Rewind it
SETOM J$DBCT(J) ;And set the byte count
SETZM J$RNPP(J) ;And set page 0
MOVEI S1,J$FPAG(J) ;Get the page counter table address
MOVEM S1,J$FBPT(J) ;And save it
SETZM J$FCBC(J) ;Clear current input buffer byte count
SETZM J$FTBC(J) ;Clear total input byte count
TXZ S,FBPTOV ;Clear page table overflow bit
MOVX S1,PAGSIZ ;Get the table length.
MOVEI S2,J$FPAG(J) ;Get the start address.
PJRST .ZCHNK ;Return, zeroing the page table
SUBTTL Read Print File -- INPCLS - Close the input file
;[4] Here to close the input file if any.
INPCLS: SKIPE S1,J$DIFN(J) ;Get the IFN
$CALL F%REL ;Release it
SETZM J$DIFN(J) ;Clear the IFN
$RET ;Return
SUBTTL DECnet Connections -- GETLNK - Get DECnet JFN
;GETLNK is called by routine OPNLNK to obtain a DECnet JFN to the remote
;
;Call is: J/Job Context Pointer
;Returns true: The JFN has been obtained and opened
;Returns false: S1/Address of ASCIZ error text
; The JFN could not be obtained or opened
GETLNK: SKIPA S1,[FLD(^D8,OF%BSZ)!OF%WR!OF%RD] ;[3] Indicate from LPTDQS
GETLIK: MOVX S1,<FLD(^D36,OF%BSZ)!OF%WR!OF%RD> ;[3] Indicate from LPTCLU
$SAVE <T1,T2,T3> ;[2]SAVE THESE AC
MOVE T3,S1 ;[3] Save OPENF bits
;Get the JFN and open it
MOVX S1,GJ%SHT ;Short jfn
HRROI S2,J$CDCN(J) ;Pick up DECnet dcn: device name
GTJFN% ;Pick up the jfn
ERJMP SGTLN2 ;Return false if can't obtain jfn
MOVEM S1,J$LCHN(J) ;Save the jfn in sender block
MOVE S2,T3 ;[3] Reclaim the OPENF bits
OPENF% ;Open the jfn
ERJMP SGTLN2 ;Return false if can't obtain jfn
$RETT ;Return true on success
;An error occurred. Pick up the address of the error string.
SGTLN2: $CALL S%ERR ;Pick up error string address
SKIPT ;Unable to pick up error string adr?
MOVEI S1,[ASCIZ/Fatal error detected in opening DECnet link/]
MOVEM S1,J$ERRA(J) ;Save the error string address
SKIPGE J$LCHN(J) ;Is there a DECnet connection?
$RETF ;No, so return now
$CALL ABTLNK ;Close and release the DECnet dcn: jfn
MOVE S1,J$ERRA(J) ;Retrieve the error string address
$RETF ;Return false on a failure
SUBTTL DECnet Connections -- FNDCER - Find DECnet Error
;FNDCER is called when LPTSPL has not been able to make a DECnet connection to
;the DQS system. FNDCER finds the error text using the error code returned by
;the .MORLS function.
;
;Call is: J/Job Context Pointer
;Returns true: A known error occurred
; S1/Address of the error string
;Returns false: An unknown error occurred
; S1/Address of unknown error string
FNDCER: $SAVE <P1> ;SAVE THIS AC
;Pick up the error string using the error code returned by .MORLS
HRRZ S1,J$LSTS(J) ;Pick up the error code
MOVSI S2,-DNELEN ;Pick up negative length of table
FNDCE2: HLRZ P1,DNERR(S2) ;Pick up the error code
CAME S1,P1 ;Is this the error?
AOBJN S2,FNDCE2 ;No, check the next entry
SKIPL S2 ;Was the entry found?
JRST FNDCE3 ;No, make unknown error
HRRZ S1,DNERR(S2) ;Pick up address of error text
$RETT ;Indicate a known error
FNDCE3: MOVEI S1,[ASCIZ/Unknown error/] ;Pick up error address
$RETF ;Indicate an unknown error
SUBTTL DECnet Connections -- DNERR - DECnet Disconnect Codes
;The DECnet disconnect codes.
DNERR: .DCX0,,[ASCIZ/Reject or disconnect by object/]
.DCX1,,[ASCIZ/Resource allocation failure/]
.DCX2,,[ASCIZ/Destination node does not exist/]
.DCX3,,[ASCIZ/Remote node shutting down/]
.DCX4,,[ASCIZ/Destination process does not exist/]
.DCX5,,[ASCIZ/Invalid process name field/]
.DCX6,,[ASCIZ/Object is busy/]
.DCX7,,[ASCIZ/Unspecified error/]
.DCX8,,[ASCIZ/Third party aborted link/]
.DCX9,,[ASCIZ/User abort (asynchronous disconnect)/]
.DCX10,,[ASCIZ/Invalid node name/]
.DCX11,,[ASCIZ/Local node shut down/]
.DCX21,,[ASCIZ/Connect initiate with illegal destination address/]
.DCX22,,[ASCIZ/Connect confirm with illegal destination address/]
.DCX23,,[ASCIZ/Connect initiate or connect confirm with zero source address/]
.DCX24,,[ASCIZ/Flow control violation/]
.DCX32,,[ASCIZ/Too many connections to node/]
.DCX33,,[ASCIZ/Too many connections to destination process/]
.DCX34,,[ASCIZ/Access not permitted/]
.DCX35,,[ASCIZ/Logical link services mismatch/]
.DCX36,,[ASCIZ/Invalid account/]
.DCX37,,[ASCIZ/Segment size too small/]
.DCX38,,[ASCIZ/No response from destination, process aborted/]
.DCX39,,[ASCIZ/No path to destination node/]
.DCX40,,[ASCIZ/Link aborted due to data loss/]
.DCX41,,[ASCIZ/Destination process does not exist/]
.DCX42,,[ASCIZ/Confirmation of disconnect initiate/]
.DCX43,,[ASCIZ/Image data field too long/]
DNELEN==.-DNERR ;Length of error table
SUBTTL DECnet Connections -- ABTLNK - Close DECnet Link
;ABTLNK is called after Cluster LPTSPL detects that a fatal error has
;occurred. The DECnet DCN: DEVICE JFN is closed with abort and released
;ABTLNK ignores any errors in closing or releasing the JFN
;
;Call is: J/Job Context Pointer
;Returns: The link has been closed and the JFN released
ABTLNK: $SAVE <T1,T2> ;Save these ac, destroyed by JSYS
SKIPG S1,J$LCHN(J) ;Pick up the DECnet jfn
JRST ABTLN3 ;None there
TXO S1,CZ%ABT ;Close with abort
CLOSF% ;Close the DECnet link
ERJMP ABTLN2 ;Shouldn't happen
JRST ABTLN3 ;Go indicate no longer have a jfn
ABTLN2: MOVE S1,J$LCHN(J) ;Pick up the DECnet jfn again
RLJFN% ;Release the jfn
ERJMP .+1 ;Shouldn't happen
ABTLN3: SETOM J$LCHN(J) ;Indicate no longer have a jfn
PJRST CLRTIM ;Clear the DECnet timer
SUBTTL DECnet Inactivity -- SETIM - Set the DECnet inactivity timer
;CASTIM is called to clear and reset the DECnet inactivity timer. After
;a NEXTJOB request has been processed, the timer is set. If no other
;NEXTJOB request is processed during the time the timer is set, then
;the DECnet link is aborted.
;
;Call is: J/Job Context Pointer
;Returns: The DECnet inactivity timer has been cleared and reset
CASTIM: $CALL CLRTIM ;Clear the timer
SETIM: $CALL I%NOW ;Pick up the current time
ADDI S1,TIMITL ;Time the timer will go off
MOVEM S1,.TITIM+J$TEVT(J) ;Place in the time event block
MOVEI S1,.TIMDT ;Pick up the timer function
MOVEM S1,.TIFNC+J$TEVT(J) ;Place in the time event block
MOVEI S1,PROTIM ;Pick up the timer processing routine
MOVEM S1,.TIMPC+J$TEVT(J) ;Place in the time event block
MOVEI S1,.TIMPC+1 ;Pick up length of time event block
MOVEI S2,J$TEVT(J) ;Pick up address of time event block
$CALL I%TIMR ;Set the timer
$RET ;Return to the caller
SUBTTL DECnet Inactivity -- PROTIM - DECnet Inactivity Timer Processor
;PROTIM is the "interrupt handler" for the DECnet inactivity timer.
;PROTIM is invoked when the DECnet inactivity timer goes off.
;If there is an active job, then PROTIM resets the timer. If there
;is no active job, then PROTIM aborts the DECnet link.
;
;CALL is: No arguments
;Returns: The timer has been reset or the DECnet link is aborted
PROTIM: SKIPE JOBACT ;IS THERE AN ACTIVE STREAM?
$CALL SETIM ;YES, RESET THE TIMER
SKIPN JOBACT ;IS THERE AN ACTIVE STREAM?
$CALL ABTLNK ;NO, ABORT THE LINK
$RET ;RETURN TO I%SLP
SUBTTL DECnet Inactivity -- CLRTIM - Clear the DECnet inactivity timer
;CLRTIM is called to clear the DECnet inactivity timer.
;
;Call is: J/Job Context Pointer
;Returns: The DECnet inactivity timer has been cleared
CLRTIM: MOVEI S1,.TIMDD ;Pick up the function
MOVEM S1,.TIFNC+J$TEVT(J) ;Place in the time event block
MOVEI S1,.TITIM+1 ;Pick up length of time event block
MOVEI S2,J$TEVT(J) ;Pick up address of time event block
$CALL I%TIMR ;Clear the timer
$RET ;Return to the caller
SUBTTL Logging Routines -- Common Messages
;[4] Here are some common messages used throughout LPTSPL
LSTAF: MOVE S1,J$TFIL(J) ;[4] Pick up file is temporary or not
$TEXT(LOGCHR,<^I/LPMSG/Starting File ^I/@FILTYP(S1)/>) ;[4]
$RET ;[4] Return
;[4] Here to give the finished file message
LFINF: MOVE S1,J$TFIL(J) ;[4] Pick up file is temporary or not
$TEXT (LOGCHR,<^I/LPMSG/Finished File ^I/@FILTYP(S1)/>) ;[4]
$RET ;[4]
;[4] Log file stamps, used all over LPTSPL
LPMSG: ITEXT(<^C/[-1]/ LPMSG >)
LPDAT: ITEXT(<^C/[-1]/ LPDAT >)
LPOPR: ITEXT(<^C/[-1]/ LPOPR >)
LPEND: ITEXT(<^C/[-1]/ LPEND >)
LPERR: ITEXT(<^C/[-1]/ LPERR ? >)
;[4] Used to output the file name to the run log
FILTYP: [ITEXT(<^F/@J$DFDA(J)/>)] ;Temporary file's FD
[ITEXT(<^F/@J$ORFD(J)/>)] ;Original file's FD
SUBTTL Logging Routines -- LOGCHR - Type a character in the log file
;[4] LOGCHR is used in many $TEXTs.
LOGCHR: CAIE S1,.CHLFD ;Is it a line-feed
CAIN S1,23 ;Or a dc 3?
AOS J$GNLN(J) ;Yes, count another line
LOGC.1: SOSGE J$GIBC(J) ;Is there room?
JRST LOGC.2 ;No, get another page
IDPB S1,J$GIBP(J) ;Yes, deposit the character
$RETT ;And return
LOGC.2: PUSH P,S1 ;Save the character for a minute
$CALL LOGBUF ;Get another page
POP P,S1 ;Restore the character
JRST LOGC.1 ;And try again
SUBTTL Logging Routines -- LOGBUF - Get a buffer page for LOG
;[4] Here to get another buffer for the run log, the first one is preallocated.
LOGBUF: $CALL .SAVE1 ;Save P1
AOS P1,J$GINP(J) ;Increment buffer page count
CAIN P1,1 ;Is this the first page?
JRST [MOVE S1,J$GBUF(J) ;Yes, use the pre-allocated page
$CALL .ZPAGA ; Make sure page is zeroed of residue
JRST LOGB.1] ;And continue on
CAIL P1,^D10 ;No, within range?
$STOP(TML,Too many log buffers required) ;No, commit suicide
$CALL M%GPAG ;Get a page
ADDI P1,-1(J) ;Point to location in j$gbuf
MOVEM S1,J$GBUF(P1) ;Store the address
LOGB.1: HRLI S1,(POINT 7,0) ;Make a byte pointer
MOVEM S1,J$GIBP(J) ;And store it
MOVEI S1,<5*1000>-1 ;Get a count
MOVEM S1,J$GIBC(J) ;Store it
$RET ; and return
SUBTTL Forms Routines -- Format of LPFORM.INI
;FORMS SWITCHES:
; BANNER:NN Number of job headers
; TRAILER:NN Number of job trailers
; HEADER:NN Number of file headers (picture pages)
; LINES:NN Number of lines per page
; WIDTH:NN Number of characters per line
; ALIGN:SS Name of align file
; ALCNT:NN Number of times to print align file
; ALSLP:NN Number of secs to sleep between copies of align
; RIBBON:SS Ribbon type
; TAPE:SS VFU control tape or file
; VFU:SS (Same as /TAPE)
; RAM:SS Translation RAM to use
; DRUM:SS Drum type
; CHAIN:SS Chain type (drum and chain are the same)
; NOTE:AA Type note to the operator
; NUMBER:NN DQS forms number
;In the above and below explanations:
; NN is a decimal number
; SS is a 1-6 character string
; AA is a string of 1 to 50 characters
; OO is an octal number
;Location specifiers
; ALL All lineprinters
; CENTRAL All lineprinters at the central site
; REMOTE All remote lineprinters (except LAT and DQS)
; LPTn Lineprinter n only
; TTYn Terminal n only
; DQS DQS printers only
;NOTE: LPTSPL will use the first entry which meets the location
; specification for its lineprinter.
SUBTTL Forms Routines -- Default Forms Switches
;[4] Generate table of switch names
DEFINE FF(A,C),<
XLIST
<<SIXBIT /A/>&777777B17>+S$'A
LIST
SALL
>
FFNAMS: F
;[4] Generate table of default paramters
DEFINE FF(X,Y),<
XLIST
D$'X: EXP Y
LIST
SALL
>
FFDEFS: F
F$NSW==.-FFDEFS
PURGE D$VFU,D$CHAI
F$WCL1==^D60 ;WIDTH CLASS ONE IS 1 TO F$WCL1
F$WCL2==^D100 ;WIDTH CLASS TWO IS F$WCL1 TO F$WCL2
F$LCL1==^D41 ;Length class one is 1 to F$LCL1
F$LCL2==^D55 ;Length class two is F$LCL1 to F$LCL2
SUBTTL Forms Routines -- FORMS - Setup Forms For A Job
;Here to setup forms for a job.
FORMS: TXNE S,ABORT ;Are we aborting?
$RETF ;Yes, end the request
GETLIM S1,.EQLIM(J),FORM ;Get the forms type
CAMN S1,J$FORM(J) ;Or are forms exactly the same?
$RETT ;Yes, VFU and RAM must be same too
TXNN S,DQSSPL ;Don't send if DQS LPTSPL
SKIPN J$FORM(J) ;Any previous forms?
JRST FORM.1 ;No, don't try to send ff
$CALL OUTDMP ;Clear any previous output
$CALL SENDFF ;Send ff if needed
$CALL OUTDMP ;Clear it out
FORM.1: HRLZI S2,J$WTOR(J) ;Get start address of the buffer
HRRI S2,J$WTOR+1(J) ; And +1
SETZM J$WTOR(J) ;Want to zero it all
BLT S2,J$WTOR+^D50-1(J) ;Zap it
MOVE S2,[POINT 7,J$WTOR(J)] ;Get pointer to wtor buffer.
MOVEM S2,TEXTBP ;And save it for depbp.
SKIPN S2,J$FORM(J) ;Get forms type
MOVX S2,FRMNOR ;Use normal if null
GETLIM S1,.EQLIM(J),FORM ;Get forms type
TXNE S,DQSSPL ;Spooling DQS?
MOVE S2,S1 ;Yes, never ask for form change
XOR S1,S2 ;Get common part
AND S1,[EXP FRMSK1] ;And it with the important part
GETLIM S2,.EQLIM(J),FORM ;Get forms type
EXCH S2,J$FORM(J) ;Save it
MOVEM S2,J$FPFM(J) ;Save old ones
SKIPE S1 ;No need to change forms.
$TEXT (DEPBP,<Please load forms type '^W/J$FORM(J)/'>)
MOVE S1,J$FDRU(J) ;Get the current drum type
MOVEM S1,J$PDRU(J) ;And save it
MOVE S1,J$FRIB(J) ;Get the current ribbon type
MOVEM S1,J$PRIB(J) ;And save it
MOVE S1,J$FTAP(J) ;Get the current carriage control tape
MOVEM S1,J$PTAP(J) ;And save it
MOVE S1,J$LRAM(J) ;Get the default RAM file name
MOVEM S1,J$FRAM(J) ;And make it the current RAM type
HRLZI S1,-F$NSW ;Get negative switch table len
MOVEI T1,J$FCUR(J) ;Point to current forms params
FORM.2: MOVE S2,FFDEFS(S1) ;Get a default
CAME S2,[-1] ;Is this supposed to be defaulted?
MOVEM S2,(T1) ;Yes, save it
ADDI T1,1 ;Increment new param store ctr
AOBJN S1,FORM.2 ;And loop
GETLIM T1,.EQLIM(J),FORM ;Forms name
MOVEM T1,J$FALI(J) ;Save it as default align file name
;Continued on next page
;Continued from previous page
;Read the LPFORM.INI file to find the parameters associated with the form.
$CALL FRMINI ;Read the LPFORM.INI file
JUMPT FORM.3 ;Skip the message if ok
;Get operator to load forms.
FRM.2A: MOVE S1,STREAM ;Get the stream number
GETLIM S2,.EQLIM(J),FORM ;Get forms type
SETZM JOBCHK(S1) ;Say we want to take a checkpoint
SETOM JOBUPD(S1) ; and update status also
TXNE S,DQSSPL ;DQS spooler?
JRST FRM.2B ;Yes
$WTOR (<Form ^W/S2/ not found, defaults being used>,<^T/FORMSG/>,@JOBOBA(S1),JOBWAC(S1)) ;Tell the operator
SKIPLE J$LREM(J) ;Is this a DN60 lpt?
JRST [$DSCHD (PSF%OR!PSF%OO) ;Yes,
JRST .+2]
$DSCHD (PSF%OR) ;Wait for operator response
TXNE S,ABORT+RQB ;Have we been canceled or requeued?
JRST FORM.7 ;Yes, ignore the error
MOVEI S1,FRMANS ;Point to the limit answer block
HRROI S2,J$RESP(J) ;Point to the answer
$CALL S%TBLK ;Do we match?
TXNE S2,TL%NOM+TL%AMB ;Did we find it ok?
JRST FRM.2A ;No, stupid operator so try again
MOVE S2,STREAM ;Get the stream number
SETOM JOBUPD(S2) ;Yes, update the stream's status
HRRZ S1,0(S1) ;Get the routine address
JRST 0(S1) ;And process the response
;Here if DQS spooler and the form wasn't found. Use form number 0.
FRM.2B: $WTO (<Form Not Found>,<Form ^W/S2/ not found, default form being used>,@JOBOBA(S1)) ;
SETZM J$FNUM(J) ; Use form number 0 for DQS
; Fall through to FORM.3
;Continued on next page
;Continued from previous page
;Form is mounted, set up the width and length classes
FORM.3: MOVEI S1,3 ;Start at three for both
MOVEM S1,J$FWCL(J) ;Store it
MOVEM S1,J$FLCL(J) ;Store it again
MOVE S1,J$FWID(J) ;Get the width
CAIG S1,F$WCL2 ;LE class 2 limit?
SOS J$FWCL(J) ;Yes, sos once
CAIG S1,F$WCL1 ;LE class 1 limit
SOS J$FWCL(J) ;Yes, sos again
MOVE S1,J$FLIN(J) ;Get the length
CAIG S1,F$LCL2 ;LE class 2 limit?
SOS J$FLCL(J) ;Yes, sos once
CAIG S1,F$LCL1 ;LE class 1 limit?
SOS J$FLCL(J) ;Yes, sos again
SKIPE J$MTAP(J) ;Are we spooling to tape?
SKIPE J$TDEV(J) ;Output to TTY?
SKIPA ;No
$RETT ;Yes, just return now
MOVE S1,TEXTBP ;Get the WTOR byte pointer
TXNE S,FRMFND ;Were the forms found?
CAMN S1,[POINT 7,J$WTOR(J)] ;Is there a message for the operator?
JRST FORM.5 ;No, try loading VFU and RAM
;Continued on next page
;Continued from previous page
;Here to ask operator for something like forms.
$TEXT (DEPBP,<^T/ENDRSP/^0>) ;Add the response to the end
FORM.4: MOVE S1,STREAM ;Get stream number
$WTOR (,<^T/J$WTOR(J)/>,@JOBOBA(S1),JOBWAC(S1)) ;Send the wtor.
SETZM JOBCHK(S1) ;Say we want to take a checkpoint.
SETOM JOBUPD(S1) ;Update status also
SKIPLE J$LREM(J) ;Is this a dn60 lpt?
JRST [$DSCHD (PSF%OR!PSF%OO) ;Yes,
JRST .+2]
$DSCHD (PSF%OR) ;NO, wait for operator response.
TXNE S,ABORT+RQB ;Have we been canceled or requeued?
JRST FORM.7 ;Go replace the old forms
MOVEI S1,CONANS ;Point to the continue answer block
HRROI S2,J$RESP(J) ;Point to the answer
$CALL S%TBLK ;Do we match?
TXNE S2,TL%NOM+TL%AMB ;Did we find it ok?
JRST FORM.4 ;No stupid operator so try again
FORM.5: MOVE S1,STREAM ;Get the stream
SETOM JOBUPD(S1) ;Update the object status
$CALL LODRAM ;Try to load the RAM
TXNE S,ABORT+RQB ;Have we been canceled?
$RETF ;Yes, return now
$CALL LODVFU ;Try to load the VFU
TXNE S,ABORT+RQB ;Have we been canceled?
$RETF ;Yes, return now
$RETT ;No, he wins so far
FORM.6: TXO S,RQB ;Requeue the job
FORM.7: MOVE S1,J$FPFM(J) ;Get old forms
MOVEM S1,J$FORM(J) ;Restore it
$CALL FRMINI ;[3132] Reset the forms characteristics
$RETF ;And return
FRMANS: $STAB
KEYTAB (FORM.6,ABORT) ;ABORT
KEYTAB (FORM.3,PROCEED) ;PROCEED
$ETAB
FORMSG: ASCIZ /
Type 'RESPOND <number> ABORT' to terminate the forms change now
Type 'RESPOND <number> PROCEED' after mounting correct forms/
SUBTTL Forms Routines -- Read LPFORM.INI
;Here to read LPFORM.INI, return TRUE if form found, FALSE otherwise.
;Also returns bit FRMFND in S.
FRMINI: $CALL OPNFRM ;Reopen ini file
$RETIF ;Quit if none
TXZ S,FRMFND ;Clear the forms found flag
FRMIN1: $CALL FH$SIX ;Get the forms name
JUMPT FRMI1B ;Found something (No EOF)
TXNE S,FRMFND ;Have we found a match somewhere?
$RETT ;Yes, return good
$RETF ;No, do otherwise
FRMI1B: CAMN T1,J$FORM(J) ;[3132]Match against currect forms type
JRST FRMIN2 ;YES
FRMI1A: $CALL FH$EOL ;No, find next line
$RETIF ;EOF without finding the forms
JRST FRMIN1 ;And loop
FRMIN2: TXO S,FRMFND ;Remember we've found it
CAIN C," " ;Break on a space?
$CALL FH$GNB ;Allow spaces, get non-blank char.
CAIN C,"/" ;Beginning of switch?
JRST FRMIN5 ;Yes, locator is "all"
CAIN C,":" ;Beginning of locator?
JRST FRMIN3 ;Yes, go get it
CAIN C,.CHLFD ;Eol?
JRST FRMIN1 ;Yes, go the next line
$CALL FH$CHR ;Else, get a character
JUMPF .RETT ;Eof
JRST FRMIN2 ;And loop
FRMIN3: $CALL FH$SIX ;Get a locator
JUMPF .RETT ;EOF
JUMPE T1,FRMI3A ;Maybe paren?
JRST FRMIN4 ;Check for ALL, LOC, etc.
FRMI3A: CAIN C,"/" ;A switch?
JRST FRMIN5 ;Yes
CAIE C,"(" ;A list?
JRST FRMIN9 ;No, error
;Continued on next page
;Continued from previous page
;Here when a forms match has been found.
FRMIN4: HLRZ T2,T1 ;Get the first three chars
TXNE S,DQSSPL ;DQS spooling?
CAIE T2,'DQS' ; and DQS form number?
CAIA ;No, skip and check more
JRST FRMIN5 ;Yes
CAIN T2,'ALL' ;Is it "all"?
JRST FRMIN5 ;Yes, stop checking
CAIN T2,'LOC' ;Is it local?
SKIPE J$LREM(J) ;Yes, are we?
SKIPA ;No, no
JRST FRMIN5 ;Yes
CAIN T2,'REM' ;Does it say "remote"?
SKIPN J$LREM(J) ;Yes, are we remote
SKIPA ;No
JRST FRMIN5 ;Yes
TXNE S,LATSPL ;[5]LAT spooling?
CAIE T2,'LAT' ;[5]does it say "LAT"
SKIPA ;[5]No
JRST FRMIN5 ;[5]Yes
CAMN T1,J$LDEV(J) ;Compare to our devnam
JRST FRMIN5 ;Match
FRMI4B: CAIN C,.CHLFD ;Break on eol?
JRST FRMIN1 ;Yes, get next line
CAIE C,"/" ;Is it a slash?
CAIN C,")" ;No, close paren?
JRST FRMI1A ;Yes, get the next line
CAIN C," " ;Break on space?
JRST FRMI1A ;Yes, get the next line
$CALL FH$SIX ;Else, get the next locator
JUMPF .RETT ;Eof, return
JUMPE T1,FRMIN9 ;Bad format
JRST FRMIN4 ;And loop around
;Continued on next page
;Continued from previous page
;Here if not DQS and this line is for us
FRMIN5: CAIN C,.CHLFD ;Was the last character a linefeed?
$RET ;Yes, return
CAIN C,"/" ;Are we at the beginning of a switch?
JRST FRMI5A ;Yes, do it
$CALL FH$CHR ;No, get a character
JUMPF .RETT ;Eof
JRST FRMIN5 ;And loop around
FRMI5A: $CALL FH$SIX ;Get the switch
JUMPF .RETT ;Eof
JUMPN T1,FRMIN6 ;Jump if we've got something
CAIN C,.CHLFD ;Eol?
$RET ;Yes, return
JRST FRMIN5 ;Else, keep trying
FRMIN6: MOVE T4,T1 ;Save switch name for latter
HLLZS T1 ;Get first three characters of switch
MOVSI T2,-F$NSW ;Make aobjn pointer
FRMIN7: HLLZ T3,FFNAMS(t2) ;Get a switch name
CAMN T3,T1 ;Match?
JRST FRMIN8 ;Yes, dispatch
AOBJN T2,FRMIN7 ;No, loop
MOVE T4,T1 ;Get switch name
MOVE S1,STREAM ;Get the stream number.
$WTOJ (LPFORM.INI Error,<Unrecognized switch ^W/T1/ found.>,@JOBOBA(S1))
JRST FRMIN5 ;And loop
FRMIN8: HRRZ T3,FFNAMS(T2) ;Get dispatch address
$CALL (T3) ;Go
JRST FRMIN5 ;And loop
FRMIN9: MOVE S1,STREAM ;Get the stream number.
$WTOJ (Bad format in LPFORM.INI,,@JOBOBA(S1))
$RET ;And return
SUBTTL Forms Routines -- Forms Switch Subroutines
;/BANNERS:n switch
S$BANN: MOVE T1,D$BANN ;Get the default setting
CAIN C,":" ;Did he put a real arguement
$CALL FH$DEC ; Yes, get decimal argument
MOVEM T1,J$FBAN(J) ;Store it
$RET ;And return
;/TRAILERS:n switch
S$TRAI: MOVE T1,D$TRAI ;Get the default setting
CAIN C,":" ;Did he put a real arguement
$CALL FH$DEC ; Yes, get decimal argument
MOVEM T1,J$FTRA(J) ;Store it
$RET ;And return
;/HEADERS:n switch
S$HEAD: MOVE T1,D$HEAD ;Get the default setting
CAIN C,":" ;Did he put a real arguement
$CALL FH$DEC ; Yes, get decimal argument
MOVEM T1,J$FHEA(J) ;Store it
$RET ;And return
;/LINES:n switch
S$LINE: MOVE T1,D$LINE ;Get the default setting
CAIN C,":" ;Did he put a real arguement
$CALL FH$DEC ; Yes, get decimal argument
MOVEM T1,J$FLIN(J) ;Store it
$RET ;And return
;/WIDTH:n switch
S$WIDT: MOVE T1,D$WIDT ;Get the default setting
CAIN C,":" ;Did he put a real arguement
$CALL FH$DEC ; Yes, get decimal argument
MOVEM T1,J$FWID(J) ;Save it
$RET ;And return
;/RIBBON:s switch
S$RIBB: $CALL FH$SIX ;Get SIXBIT argument
JUMPF .RETT ;Eof
MOVEM T1,J$FRIB(J) ;Save it
CAME T1,J$PRIB(J) ;Skip if not changed
$TEXT (DEPBP,<Load Ribbon type '^W/J$FRIB(J)/'>)
$RET ;and return
;/DRUM:s and /CHAIN:s switch
S$DRUM:
S$CHAI: $CALL FH$SIX ;Get SIXBIT arg
JUMPF .RETT ;EOF
MOVEM T1,J$FDRU(J) ;Save it
CAME T1,J$PDRU(J) ;Skip if not changed
$TEXT (DEPBP,<Load DRUM (CHAIN) type '^W/J$FDRU(J)/'>) ;
$RET ; and return
;/NODE:text-to-slash-or-eol switch
S$NOTE: MOVE T1,[POINT 7,J$FNBK(J)] ;Make pointer to area
SETZ T2, ;Clear the counter
S$NOT1: $CALL FH$CHR ;Get a character
JUMPF S$NOT2 ;Eof, finish up
CAIGE C,40 ;Make sure its greater than space
JRST S$NOT2 ;Its not, finish up
CAIN C,"/" ;Also stop on slash
JRST S$NOT2 ;It is
IDPB C,T1 ;Deposit it
CAIGE T2,^D49 ;Loop for 50 characters
AOJA T2,S$NOT1 ;Incr and loop
S$NOT2: SETZM TF ;Get a null byte
IDPB TF,T1 ;Make the string asciz
$TEXT (DEPBP,<Note: ^T/J$FNBK(J)/>) ;Add the msg to WTOR
$RETT ;Return
;/ALCNT:n switch
S$ALCN: MOVE T1,D$ALCN ;Get the default setting
CAIN C,":" ;Did he put a real arguement
$CALL FH$DEC ; Yes, get decimal argument
MOVEM T1,J$FALC(J) ;Store It
$RET ;Return
;/ALSLP:n switch
S$ALSL: MOVE T1,D$ALSL ;Get the default setting
CAIN C,":" ;Did he put a real arguement
$CALL FH$DEC ; Yes, get decimal argument
MOVEM T1,J$FALS(J) ;Save it
$RET ;And return
;/ALIGN[:file] switch
S$ALIG: CAIN C,"/" ;Are we at the beginning of a switch?
PJRST ALISCD ;Yes, just use forms name as align file
$CALL FH$SIX ;Get the align filename argument
SKIPE T1 ;Skip if nothing there
MOVEM T1,J$FALI(J) ;Save the align filename
$CALL ALISCD ;Schedule the align
$RET ; and return
;/VFU:file and /TAPE:name switch
S$VFU:
S$TAPE: $CALL FH$SIX ;Get SIXBIT argument
JUMPF .RETT ;EOF
MOVEM T1,J$FTAP(J) ;Save it
CAME T1,J$PTAP(J) ;Are old and new the same?
SKIPE J$LDVF(J) ;Or does device have a davfu?
$RETT ;Old=new or software VFU, return
$TEXT (DEPBP,<Load CARRIAGE CONTROL TAPE '^W/J$FTAP(J)/'>)
$RETT
;/RAM:file switch
S$RAM: $CALL FH$SIX ;Get the SIXBIT argument
JUMPF .RETT ;EOF
MOVEM T1,J$FRAM(J) ;Save it
$RETT ;And return
;/NUMBER:n switch for DQS forms number
S$NUMB: MOVE T1,D$NUMB ;Get the default setting
CAIN C,":" ;Argument coming?
$CALL FH$DEC ;Yes, get decimal argument
MOVEM T1,J$FNUM(J) ;Save this as forms number
$RETT ;Return true
SUBTTL Forms Routines -- I/O Subroutines for LPFORM.INI
;[4] Routine to return a sixbit word in T1
;[4] Returns with word in T1. Skips normally, non-skip on EOF.
FH$SIX: CLEAR T1, ;Clear for result
MOVE T2,[POINT 6,T1] ;Pointer for result
FH$SX1: $CALL FH$CHR ;Get a character
JUMPF .RETF ;Fail if eof
CAIL C,"A" ;Check for alpha
CAILE C,"Z"
SKIPA ;Its not
JRST FH$SX2 ;It is, deposit it
CAIL C,"0" ;Check for number
CAILE C,"9"
$RETT ;Not SIXBIT, return
FH$SX2: SUBI C,40 ;Convert to SIXBIT
TLNE T2,770000 ;Get six yet?
IDPB C,T2 ;No, deposit another
JRST FH$SX1 ;And loop around
FH$GNB: $CALL FH$CHR ;Get a character
$RETIF ;Return if error
CAIN C," " ;A space?
JRST FH$GNB ;No, do it again
$RETT ;Return good
;[4] Routine to return 1 character in accumulator C
FH$CHR: MOVE S1,FMIFN ;Get IFN for LPFORM.INI
$CALL F%IBYT ;Get next character
JUMPF .RETF ;Quit if bad or done
MOVE C,S2 ;Move the character into C
CAIE C,.CHTAB ;Convert tabs
CAIN C,.CHCRT ;And carriage returns
MOVEI C,40 ;Into spaces
CAIE C,.CHFFD ;Convert form feeds
CAIN C,.CHVTB ;And vertical tabs
MOVEI C,.CHLFD ;Into linefeed
CAIL C,141 ;Check lower case
CAILE C,172 ;141-172
$RETT ;Its not
SUBI C,40 ;Yup, convert to upper
$RETT ;And skip back
;[4] Routine to search for eol in LPFORM.INI
FH$EOL: $CALL FH$CHR ;Get a character
JUMPF .RETF ;Fail if EOF
CAIE C,.CHLFD ;EOL?
JRST FH$EOL ;No, loop
$RETT ;Yes, return
;[4] Routine to pick up a decimal number
FH$DEC: CLEAR T1, ;Place to accumulate result
FH$DE1: $CALL FH$CHR ;Get a character
JUMPF .RETF ;Eof, return
CAIL C,"0" ;Check the range
CAILE C,"9" ;0-9
$RET ;Return
IMULI T1,12 ;Shift a place
ADDI T1,-"0"(C) ;Add in a digit
JRST FH$DE1 ;And loop around
SUBTTL Forms Routines -- OPNFRM - Routine to open LPFORM.INI
;[4] Open LPFORM.INI
OPNFRM: SKIPN FMOPN ;Open already?
JRST OPNF.1 ;No, continue on
MOVE S1,FMIFN ;Yes, get the ifn
$CALL F%REL ;And release it
SETZM FMOPN ;Clear "open"
OPNF.1: MOVEI S1,FOB.SZ ;FOB size
MOVEI S2,FOB ;FOB address
$CALL .ZCHNK ;Zero it
MOVEI S1,FMFD ;Get FD address
STORE S1,FOB+FOB.FD ;Store it
MOVX S1,FLD(7,FB.BSZ)+FLD(1,FB.LSN) ;Byte size and ignore line #'s
MOVEM S1,FOB+FOB.CW ;Save it
MOVEI S1,FOB.SZ ;Load the FOB size
MOVEI S2,FOB ;And the FOB address
$CALL F%IOPN ;And open the file
JUMPF .RETF ;Lose?
MOVEM S1,FMIFN ;Save the ifn
SETOM FMOPN ;Set "open"
$RETT ;And return
FMFD: XWD FMFDL,0 ;FD size
ASCIZ /SYS:LPFORM.INI/ ;And the string
FMFDL==.-FMFD ;The FD size
SUBTTL VFU/RAM Routines -- LODVFU - Load the Vertical Forms Unit
;[4] Here to load VFU as needed.
LODVFU: SKIPN J$MTAP(J) ;Are we spooling to tape?
SKIPN J$LDVF(J) ;Or does this printer have a VFU?
$RETT ;To tape or no VFU, just return.
MOVE S1,J$FTAP(J) ;Get necessary VFU type
CAMN S1,J$FLVT(J) ;Is it in there already?
$RETT ;Yes, return
MOVE S1,STREAM ;Get stream number
$WTO (Loading VFU with '^W/J$FTAP(J)/',,@JOBOBA(S1))
$TEXT(<-1,,J$XTBF(J)>,<SYS:^W/J$FTAP(J)/.VFU^0>)
LODV.2: MOVX S1,GJ%OLD+GJ%SHT ;Short, old file only
LOAD S2,IB+IB.FLG,IB.NAC ;Get the access bit value
SKIPE DEBUGW ;Debugging?
SETZ S2, ;Yes, do not restrict
STORE S2,S1,GJ%ACC ;Store as the value of the JFN access
HRROI S2,J$XTBF(J) ;Point to string
GTJFN ;Go get the JFN for the file
ERJMP NOVFU ;Error, let's try something else
LODV.3: MOVE T3,S1 ;Copy the jfn over
MOVE S1,J$LCHN(J) ;Get the lpt jfn
MOVX S2,.MOLVF ;Get load vfu function
MOVEI T1,T2 ;Address of arg block
MOVEI T2,2 ;Length of arg block
$CALL $MTOPR ;Load the VFU
MOVE S1,T3 ;Get the VFU JFN once more
RLJFN ;Release it
JFCL ;Ignore any errors
JUMPF LODV.4 ;Can't load VFU, go find out why
MOVE T1,J$FTAP(J) ;Get the VFU type
MOVEM T1,J$FLVT(J) ;Save as currently loaded
$RET ; and return
LODV.4: MOVX S1,.FHSLF ;Get my handle
GETER ;Get the last error code
HRRZS S2,S2 ;Get just the error code
CAXE S2,MTOX17 ;Is the error 'device offline'?
JRST NOVF.1 ;No, let's try some other
$CALL OUTWON ;Say 'device offline'
JRST LODV.2 ; and try again
SUBTTL VFU/RAM Routines -- NOVFU - VFU File Not Found
NOVFU: MOVE T1,J$FTAP(J) ;Type we tried to load
CAME T1,D$TAPE ;Is it the default
JRST NOVF.1 ;No, give up
NOVF.1: MOVE S1,STREAM ;Get stream number
$WTOR (,<^I/VFUI1/^J^M^T/VFUI2/>,@JOBOBA(S1),JOBWAC(S1)) ;Tell me
SETZM JOBCHK(S1) ;Say we want to take a checkpoint.
SETOM JOBUPD(S1) ;Update status also
$DSCHD (PSF%OR) ;Wait for the reply
TXNE S,ABORT+RQB ;Have we been canceled or requeued?
JRST [SETZM J$FORM(J) ;Yes, zap the loaded forms type
TXZ S,VFULOD ;Clear the vfu load flag
$RETT ] ;And return
MOVE S1,STREAM ;Get the stream number
SETOM JOBUPD(S1) ;Yes, update the stream's status
HRROI S1,J$RESP(J) ;Get the operators response
$CALL S%SIXB ;Convert it to SIXBIT
MOVEM S2,J$FTAP(J) ;Save the forms type
JRST LODVFU ;Try loading again
VFUI1: ITEXT (<VFU Error, can't load VFU '^W/J$FTAP(J)/'>)
VFUI2: ASCIZ /Respond with VFU type to continue/
SUBTTL VFU/RAM Routines -- LODRAM - Load The Translation RAM
;[4] Load the translation RAM into a LP20
LODRAM: SKIPN J$MTAP(J) ;Are we spooling to tape?
SKIPE J$LREM(J) ;Or is this a remote lpt?
$RETT ;Yes, return now
MOVE S1,J$FRAM(J) ;Get the ram we want
CAMN S1,J$FLRM(J) ;Is it in there already?
$RETT ;Yes, return now
MOVE S1,STREAM ;Get our stream number
$WTO (Loading RAM with '^W/J$FRAM(J)/',,@JOBOBA(S1))
$TEXT (<-1,,J$XTBF(J)>,<SYS:^W/J$FRAM(J)/.RAM^0>) ;Gen RAM file name
LODR.1: MOVX S1,GJ%OLD+GJ%SHT ;Short, old file only
LOAD S2,IB+IB.FLG,IB.NAC ;Get the access bit value
SKIPE DEBUGW ;Debugging?
SETZ S2, ;Yes, do not restrict
STORE S2,S1,GJ%ACC ;Store as the value of the JFN access
HRROI S2,J$XTBF(J) ;Point to file name
GTJFN ;Get a jfn for the translation ram
ERJMP NORAM ;Can't get a JFN, try something else
LODR.2: MOVE T3,S1 ;Save the jfn
MOVE S1,J$LCHN(J) ;Get the printer jfn
MOVX S2,.MOLTR ;Want 'load ram' mtopr function
MOVEI T1,T2 ;Get arg block address
MOVEI T2,2 ;Get arg block length
$CALL $MTOPR ;Go do the MTOPR
MOVE S1,T3 ;Get the jfn back
RLJFN ;Release it
JFCL ;Ignore any errors
JUMPF LODR.3 ;Could not load RAM, find out why
MOVE S1,J$FRAM(J) ;Get the ram type we loaded
MOVEM S1,J$FLRM(J) ;Save it
$RETT ;And return
LODR.3: MOVX S1,.FHSLF ;Get my handle
GETER ;Get the last error
HRRZS S2,S2 ;Get just the error code
CAXE S2,MTOX17 ;Is the error 'lpt offline'?
JRST NORAM ;No, try some other
$CALL OUTWON ;Wait for the LPT to come online
JRST LODR.1 ; and try again
SUBTTL VFU/RAM Routines -- NORAM - Process RAM Loading Errors
;[4] Here if error loading RAM
NORAM: MOVE S1,STREAM ;Get our stream number
$WTOR (,<^I/RAMI1/^J^M^T/RAMI2/>,@JOBOBA(S1),JOBWAC(S1))
SETZM JOBCHK(S1) ;We want a checkpoint taken
SETOM JOBUPD(S1) ;Update also
$DSCHD (PSF%OR) ;Wait for the operator response
TXNE S,ABORT+RQB ;Canceled or requeued?
JRST [SETZM J$FORM(J) ;Yes, zap the loaded forms type
$RETT ] ; and return
MOVE S1,STREAM ;Get the stream number
SETOM JOBUPD(S1) ;Yes, update the stream's status
HRROI S1,J$RESP(J) ;Get the response address
$CALL S%SIXB ;Convert it to SIXBIT
MOVEM S2,J$FRAM(J) ;Save the new RAM type
JRST LODRAM ; and try again
RAMI1: ITEXT (<RAM Error, Can't Load RAM '^W/J$FRAM(J)/'>)
RAMI2: ASCIZ /Respond With RAM Type to Continue/
SUBTTL Accounting -- ACTBEG - Accounting Initialization Routine
;[4] Here to save information needed for accounting
ACTBEG: LOAD S1,.EQSEQ(J),EQ.SEQ ;Get sequence number
STORE S1,J$ASEQ(J) ;Store it
LOAD S1,.EQSEQ(J),EQ.PRI ;Get external priority
STORE S1,J$APRI(J) ;Store it
MOVX S1,.FHSLF ;Get fork handle
RUNTM ;Get my runtime
MOVNM S1,J$ARTM(J) ;Remember it negated
$RETT ;Return
SUBTTL Accounting -- ACTEND - Accounting Summary Routine
;[4] Here to write the accounting data
ACTEND: SKIPN S1,DEBUGW ;Skip if debugging
LOAD S1,.EQSEQ(J),EQ.IAS ;Get the invalid acct string bit
JUMPN S1,.RETT ;If lit, then just return
IFN FTACNT,<
MOVX S1,.FHSLF ;Load fork handle
RUNTM ;Get runtime
ADDM S1,J$ARTM(J) ;Store it
MOVX S1,.USENT ;Write an entry
MOVEI S2,ACTLST ;Point to the list
USAGE ;Do the jsys
ERJMP ACTE.1 ;On an error tell the operator
$RETT ;If ok return
ACTE.1: MOVE S1,STREAM ;Get this stream number
SKIPL J$REMR(J) ;[7]Request originate remotely?
IFSKP. ;[7]
$WTO (System Accounting Failure,<^I/RMJOBI/>,@JOBOBA(S1)) ;[7]
ELSE. ;[7]
$WTO (System Accounting Failure,<^R/.EQJBB(J)/>,@JOBOBA(S1));[7]
ENDIF. ;[7]
>;END IFN FTACNT
$RETT ;Return
SUBTTL Accounting -- ACTLST - Spooler Accounting Record
;[4] Argument block used for USAGE JSYS.
IFN FTACNT,<
ACTLST: USENT. (.UTOUT,1,1,0) ;Output spooler
USTAD. (-1) ;Current date/time
USPNM. (<SIXBIT/LPTSPL/>,US%IMM) ;Program name
USPVR. (LPTVNO) ;Program version
USAMV. (-1) ;Accounting module version
USNOD. (.EQROB+.ROBND(J)) ;Node name
USSRT. (J$ARTM(J)) ;Run time
USSDR. (J$ADRD(J)) ;Disk reads
USSDW. (0,US%IMM) ;Disk writes
USJNM. (.EQJOB(J)) ;Job name
USQNM. (<SIXBIT/LPT/>,US%IMM) ;Queue name
USSDV. (J$LDEV(J)) ;Device name
USSSN. (J$ASEQ(J)) ;Job sequence number
USSUN. (J$APRT(J)) ;Total pages printed
USSNF. (J$AFXC(J)) ;Total files processed
USCRT. (.EQAFT(J)) ;Creation date/time of request
USSCD. (J$RTIM(J)) ;Scheduled date/time
USFRM. (J$FORM(J)) ;Forms type
USDSP. (<SIXBIT/NORMAL/>,US%IMM) ;Disposition
USPRI. (J$APRI(J)) ;Job priority
;Continued on next page
;Continued from previous page
USJNO. (-1) ;Job number
USTRM. (-1) ;Terminal designator
USLNO. (-1) ;Tty line number
USTXT. (<-1,,[ASCIZ / /]>) ;System text
USNM2. (<POINT 7,.EQOWN(J) >) ;User name
USACT. (<POINT 7,.EQACT(J) >) ;Account string pointer
0 ;End of list
ACTLEN==.-ACTLST ;Accounting block length
> ;END IFN FTACNT
SUBTTL End of LPTSUB
END
;;;Local modes:
;;;Mode: MACRO
;;;Comment begin: ";"
;;;Comment column: 40
;;;End: