Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
5-galaxy/tcpspl.mac
There are no other files named tcpspl.mac in the archive.
;PS:<5-1-GALAXY>TCPSPL.MAC.24, 2-Oct-85 17:52:37, Edit by BILLW
;[wew] allow printers to have unit numbers greater than 9
;<5-1-GALAXY>TCPSPL.MAC.23, 21-Sep-85 12:21:34, Edit by WHP4
; in INPOPN, if file has byte size of 36, we use 7 instead since that is
;probably the right thing (famous last words)
;<5-1-GALAXY>TCPSPL.MAC.22, 17-Aug-85 13:07:14, Edit by WHP4
; use system-wide logical name since monitor seems to have broken things as
; of FT6 tape wrt job-wide logical names
;<5-1-GALAXY>TCPSPL.MAC.21, 16-Aug-85 16:13:56, Edit by WHP4
; SEARCH MACSYM
;<5-1-GALAXY>TCPSPL.MAC.20, 16-Aug-85 15:02:32, Edit by WHP4
; add CHKDVI routine to check for DVI postamble
; send DVI control card if file seems to be a DVI file
;<5-1-GALAXY>TCPSPL.MAC.19, 24-Jul-85 15:24:53, Edit by WHP4
; Use %RSUNA instead of %RSUDE in case of error
;<5-1-GALAXY>TCPSPL.MAC.18, 19-Jun-85 00:42:16, Edit by LOUGHEED
; More edit 14. Abort entire request if INPOPN failure. Don't get
; hung up sending trailers, banners, etc.
;<5-1-GALAXY>TCPSPL.MAC.17, 15-Jun-85 21:20:43, Edit by WHP4
;<5-1-GALAXY>TCPSPL.MAC.16, 15-Jun-85 20:27:33, Edit by WHP4
; More of edit 14
;<5-1-GALAXY>TCPSPL.MAC.15, 14-Jun-85 14:55:09, Edit by WHP4
; copy DDT's section for ease in debugging
;<5-1-GALAXY>TCPSPL.MAC.14, 14-Jun-85 14:10:14, Edit by WHP4
; if the file isn't there (failure in INPOPN) don't try to print it
;<5-1-GALAXY>TCPSPL.MAC.12, 12-Jun-85 00:38:05, Edit by WHP4
; in case remote host doesn't have a host name that we can get from GTHST,
; use dotted address and don't blow up
;<5-1-GALAXY>TCPSPL.MAC.11, 1-May-85 10:02:07, Edit by LOUGHEED
; Log, but do not treat as fatal, a byte count inconsistency before
; and after a transfer. These possibly happen because of an error
; in the TCP connection and should not shutdown the entire spooler.
;<5-1-GALAXY>TCPSPL.MAC.10, 26-Apr-85 18:44:44, Edit by LOUGHEED
; Change default settings to reflect use at Stanford
; Fix HEAD routine not to dump a bare CR into the data stream
;<5-1-GALAXY>TCPSPL.MAC.9, 26-Apr-85 17:10:08, Edit by LOUGHEED
; Change OPR message about "blocks" to say "files" and to count them correctly
; If LPFORM.TXT has /TYPE:RAW, do no preprocessing of the input data.
; This allows Impress files to pass through unmolested.
;<5-1-GALAXY>TCPSPL.MAC.8, 25-Apr-85 13:38:47, Edit by LOUGHEED
; Fix code to work correctly when you don't want trailers
;<5-1-GALAXY>TCPSPL.MAC.7, 23-Apr-85 20:41:23, Edit by LOUGHEED
; Revoke edit 4. Real problem was references to J$FBAN and J$FTRA that
; were missing index registers.
;<5-1-GALAXY>TCPSPL.MAC.6, 23-Apr-85 15:02:02, Edit by LOUGHEED
; Support 15. devices instead of just 6
;<5-1-GALAXY>TCPSPL.MAC.5, 23-Apr-85 13:40:50, Edit by LOUGHEED
; Make INPOPN smarter about figuring out the correct byte size for input files
; Add CHKSIZ routine from LSRSPL
;<5-1-GALAXY>TCPSPL.MAC.4, 22-Apr-85 18:48:39, Edit by LOUGHEED
; JOBTRL and JOBHDR return immediately if no trailers or headers desired.
; Those routines are currrently creating null print requests.
;[WASHINGTON]PS:<BJORN.SYSTEM>TCPSPL.MAC.458, 14-Dec-84 14:43:26, Edit by BJORN
TITLE TCPSPL - General Purpose Net LPT Spooler
comment \
This program replaces the standard LPTSPL as the lineprinter
spooler. It features a number of functions in addition to the
normal ones. It handles any number of devices (streams) up to
maximum NPRINT which may be changed. Each stream executes in its
own subfork. Also, by specifying TCP instead of a TTY as the
printing devices PLPTx:, files will be spooled over the
net using TCP. Currently only UNIX 4.2 protocol is supported.
Physical LPTs and spooling to mag tape are NOT supported.
The Forms parameter file SYS:LPFORM.TXT also has a different
format as compared to LPFORM.INI, see below.
This stuff was written in the Fall of 1984 by
Bjorn Lindskog, Computer Science Lab, U of W, Seattle
\
SEARCH GLXMAC ;Search GALAXY's symbols
PROLOGUE(TCPSPL)
SEARCH QSRMAC ;Search QUASAR's symbols
SEARCH ORNMAC ;And ORION's
SEARCH MACSYM
.DIRECT FLBLST
IF1,<PRINTX Assembling TCPSPL, Pass 1>
IF2,<PRINTX Starting Pass 2>
SALL ;SUPPRESS MACRO EXPANSIONS
;VERSION INFORMATION
LPTVER==1 ;MAJOR VERSION NUMBER
LPTMIN==1 ;MINOR VERSION NUMBER
LPTEDT==0 ;EDIT LEVEL
LPTWHO==0 ;WHO LAST PATCHED
%LPT==<BYTE (3)LPTWHO(9)LPTVER(6)LPTMIN(18)LPTEDT>
;STORE VERSION NUMBER IN JOBVER
LOC 137
.JBVER::EXP %LPT
RELOC
SUBTTL AC defs
;Accumulator definitions
M==13 ;IPCF message address, used by top fork only
S==13 ;Status flags, used by inferiors only
E==14 ;Points to current file
J==15 ;Stream context pointer
C==16 ;Holds a 'character' i.e. 7 to 36 bits
;Status Flags used in S reg of inferior process
ARROW==1B0 ;ARROW MODE IN EFFECT
SUPFIL==1B1 ;NO USER FORM CONTROL
ERRFIL==1B3 ;Error in file, skip it
CHRCNT==1B4 ;Dummy transfer to count characters.
TIMCKP==1B5 ;Timed checkpoints enabled
FCONV==1B6 ;THE NEXT CHAR IS FORTRAN FORMAT DATA
NEWLIN==1B7 ;FLAG FOR THE BEGINING OF LINE
FILXFR==1B9 ;Transferring a user file i.e. enable page skipping
FRMFND==1B10 ;Forms found in LPFORM.TXT
MINUS==1B11 ;Reading a neg. number from LPFORM.TXT
.DVTCP==25 ;What is DEC doing????
SUBTTL Parameters
;PARAMETERS WHICH MAY BE CHANGED AT ASSEMBLY TIME
ND CKPTIM,^D30 ;Seconds between checkpoints
ND DISTIM,^D300 ;Time-out in secs. when dismissed for I/O
ND OPBFSZ,^D2000 ;Size of output buffer in 8 bit bytes
ND IPBFSZ,^D2000 ;Size of input (file) buffer in 7 bit bytes
ND LGBFSZ,^D5000 ;Size of log buffer in 7 bit bytes
ND CTBFSZ,^D2000 ;Size of UNIX control file buffer, 7 bit bytes
ND NPRINT,^D15 ;Number of devices this spooler handles
ND FATERT,%RSUNA ;Bit to set if fatal error (formerly %RSUDE)
;CONSTANT PARAMETERS
XP MSBSIZ,30 ;SIZE OF A MESSAGE BLOCK
XP STKSIZ,^D100 ;Size of stacks
XP DDTSEC,37 ;section in which DDT resides
SUBTTL MACROS
;Macros to generate stream data area
DEFINE LP(SYM,VAL,FLAG),<
IF1,<
XLIST
IFNDEF J...X,<J...X==PAGSIZ>
IFDEF SYM,<PRINTX ?PARAM SYM USED TWICE>
SYM==J...X
J...X==J...X+VAL
IFNDEF ...BP,<...BP==1B0>
IFNDEF ...WP,<...WP==0>
REPEAT VAL,<
IFIDN <FLAG><Z>,<LPZ(\...WP,...BP)>
...BP==...BP_<-1>
IFE ...BP,<
...BP==1B0
...WP==...WP+1
> ;;END IFE ...BP
> ;;END REPEAT VAL
LIST
SALL
> ;END IF1
IF2,<
.XCREF
J...X==SYM
.CREF
SYM==J...X
> ;END IF2
> ;END DEFINE LP
DEFINE LPZ(A,B),<
IFNDEF ...Z'A,<...Z'A==B>
IFDEF ...Z'A,<...Z'A==...Z'A!B>
> ;END DEFINE LPZ
;Macros used to build dispatch tables
DEFINE BDTB,<
...ST==.
EXP 0 ;;We don't want to use the 0 entry
>
DEFINE DTE(ADDR,CONST),<
IF1,<IFDEF CONST,<PRINTX ?Constant used twice>>
CONST==.-...ST
EXP ADDR
>
DEFINE EDTB(LEN),<
LEN==.-...ST
>
;;;;;;;;;;;;;;;;;;;
;Macros used in inferiors's code
;The TXT macro is a poor man's implementation of the $TEXT macro. It is
;used by the inferiors since the original $TEXT in GLXLIB uses
;non reentrant code.
;This one uses the reentrant routines TXT.xx for the different functions.
;It takes three arguments: TXT(type,address,string)
;Type indicates whether address is the address of routine that outputs the
;char in C or the address of buffer. <> 0 is buffer.
;The string accepted has the following format:
;^<function character><argument>^<function character><argument>...^
;See macro TFUNC for a listing of the functions.
;The first function of the string is defaulted to ^! i.e. no function.
;Note that S1 and S2 are not preserved and cannot be referenced in the
;string.
;Macros used to build the argument strings
;Use CLSTR to init, APPSTR(TXT) to add TXT at the end and
;EXPSTR to get the string back.
DEFINE CLSTR <
DEFINE APPSTR (FTXT) <
DEFINE APPSTR (TXT) <
APP1 (<TXT>,<FTXT>)
>
DEFINE EXPSTR <FTXT>
>
DEFINE EXPSTR <>
> ;End def of CLSTR
DEFINE APP1 (NTXT,OTXT) <
DEFINE APPSTR (TXT) <
APP1 (<TXT>,<OTXT'NTXT>)
>
DEFINE EXPSTR <OTXT'NTXT>
> ;End def of APP1
;Macro used to build the definitions. Two macros TFBx and TFAx are
;created for each function character. TFBX is expanded when the
;function character is detected. It is used to init the argument
;string if necessary. TFAx is expanded when the
;argument has been collected i.e. at next ^ or at end of input.
DEFINE TF(FUNCT,BEFORE,AFTER) <
IFNB <BEFORE> <DEFINE TFB'FUNCT BEFORE>
IFNB <AFTER> <DEFINE TFA'FUNCT AFTER> > ;End of TF macro
;Macro to expand the collected argument into code
DEFINE EXPAND <MOVEI S2,EXPSTR>
;The following are definitions of the function characters
;accepted by the TXT macro.
DEFINE TFUNC <
TF(T, <APPSTR (<[ASCIZ ~>)>, ;;Insert string prefix
<APPSTR (<~]>) ;;Insert right delimiter
EXPAND ;;Make argument into code
$CALL TXT.AS>)
TF(A,, <EXPAND ;;Arg. points to ASCIZ string
$CALL TXT.AS>)
TF(D,, <EXPAND ;;Arg. points to decimal number
$CALL TXT.DN>)
TF(S,, <EXPAND ;;Arg. points to SIXBIT word
$CALL TXT.SX>)
TF(C,, <EXPAND ;;Arg points to int. time
$CALL TXT.DT>)
TF(H,, <$CALL TXT.TI>) ;;Time output as HH:MM:SS
TF(E,, <$CALL TXT.ER>) ;;Last error is output
TF(7,, <EXPAND ;;Arg. points to one char word
$CALL TXT.CH>)
TF(M, <APPSTR (<.CHCRT>) ;;Insert a ^M (CR)
EXPAND
$CALL TXT.CH>,)
TF(J, <APPSTR (<.CHLFD>) ;;Insert a ^J (LF)
EXPAND
$CALL TXT.CH>,)
TF(^, <APPSTR (<"^">) ;;Insert a ^
EXPAND
$CALL TXT.CH>,)
TF(0, <APPSTR (<0>) ;;Insert a NUL
EXPAND
$CALL TXT.CH>,)
TF(!,,) ;;No function
> ;End of TFUNC definition
TFUNC ;Generate them
;This macro does the work
DEFINE TX (C) <
TXF=="!" ;;Current function is 'no function'
TXD==0 ;;And no new function seen
CLSTR ;;Clear our argument string
IRPC C < ;;Parse the arg. one char at a time
IFE TXD <IFDIF <C><^> < ;;Nothing special, append char
APPSTR <C>>>
IFN TXD <CLSTR ;;We saw ^ prev. char, clear string
TXD==0 ;;No ^ seen anymore
TXF=="C" ;;Save current function
TPRE (\"TXF)> ;;Do pre-processing
IFIDN <C><^> <
TPST (\"TXF) ;;A ^: post process current function
IFDIF <TXF><^> <
TXD==1>> ;;Flag a ^ (unless funct was ^)
> ;;End of IRPC
TPST (\"TXF) ;;Post process last function
> ;;End of TX
;Macros to call appropr. handler. Doesn't call if not defined.
;TPRE calls pre-processor, TPST post-processor.
DEFINE TPRE (FUNCT) <
IFDEF TFB'FUNCT <TFB'FUNCT>>
DEFINE TPST (FUNCT) <
IFDEF TFA'FUNCT <TFA'FUNCT>>
;This is the macro that should be called to do all this stuff.
DEFINE TXT (TYPE,ADDR,STR) <
JRST [IFE TYPE,<MOVEI S1,ADDR> ;;Address of routine
IFN TYPE,<MOVE S1,[POINT 7,ADDR]> ;;Address of buffer
TX (<STR>)
JRST .+1]
> ;End of define TXT
;Slightly higher level string macros
;The text strings accepted are in TXT style
DEFINE OPRMSG (STR) <
JRST [MOVE S1,[POINT 7,J$SMOP(J)]
TX (<^T'STR'^0>) ;;Generate code for string (NUL at end)
MOVX S1,SIG.MS ;;Tell superior we have a message
$CALL SIGNAL
JRST .+1]
> ;End of define OPRMSG
DEFINE ERROR (STR) <
JRST [MOVE S1,[POINT 7,J$SMOP(J)]
TX (<^T'STR'^0>) ;;Generate code for string (NUL at end)
MOVX S1,SIG.ER ;;Tell superior we have a message
$CALL SIGNAL
JRST .+1]
> ;End of define ERROR
DEFINE FATAL (STR) <
JRST [MOVE S1,[POINT 7,J$SMOP(J)]
TX (<^T'STR'^0>) ;;Generate code for string (NUL at end)
MOVX S1,SIG.FT ;;Tell superior we have a message
$CALL SIGNAL
JRST .+1]
> ;End of define FATAL
DEFINE LOGMSG (STR) <
TXT (0,LOGCHR,<^H^T 'STR'^M^J>) ;;Generate code for string
> ;End of define LOGMSG
SUBTTL Special Forms Handling Parameters
; FORMS SWITCHES as used in LPFORM.TXT
; Note that the switches recognized are different from those used in
; the LPFORM.INI together with LPTSPL.
;
; BANNER:NN Number of job headers
; TRAILER:NN Number of job trailers
; A negative value gives that number of BANNER pages
; HEADER:NN Number of file headers (picture pages)
; LINES:NN Number of lines per page
; WIDTH:NN Number of characters per line
; FF:NN When to send FF. NN = <FF before banners> +
; 2*<FF before files> + 4*<FF before trailers> +
; 8*<FF after trailers> + 16*<FF for pagination>
; TABS:NN If 0, send TAB as is, else use spaces and NN
; between stops
; NAME:AA Name of printer on remote system
; TYPE:NORMAL/SCRZAP/8BIT/RAW Type of file being sent. SCRZAP and 8BIT
; overrides the switches given with PRINT
; Also tells UNIX which filter to use, see UXT.1
;
; What the abbreviations mean:
; NN is a decimal number
; AA is a string of 1 to 20 ASCII characters
; Location specifiers
; ALL all lineprinters
; LOCAL all lineprinters at the central site
; REMOTE all remote lineprinters
; LPTOOO lineprinter OOO only
;NOTE: TCPSPL will use the first entry which meets the location
; specification for its lineprinter.
DEFINE F,<
FS BANNER,0
FS TRAILER,0
FS HEADER,0
FS LINES,^D60
FS WIDTH,^D80
FS FF,^D16
FS NAME,0
FS TABS,0
FS TYPE,<SIXBIT /RAW/>
>
;GENERATE TABLE OF SWITCH NAMES
DEFINE FS(A,C),<
XLIST
<<SIXBIT /A/>&777777B17>+S$'A
LIST
SALL
>
FFNAMS: F
;GENERATE TABLE OF DEFAULT PARAMTERS
DEFINE FS(X,Y),<
XLIST
D$'X: EXP Y
LIST
SALL
>
FFDEFS: F
F$NSW==.-FFDEFS
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
;/FF switch bits
F$FFBB==1 ;FF before banner
F$FFBF==2 ;FF before file
F$FFBT==4 ;FF before trailer
F$FFAT==8 ;FF after trailer
F$FFPG==16 ;Do pagination
SUBTTL Stream Data Area
;The area between J$$BEG and J$$END is allocated when the stream is
;started and the inferior is spawned. Deallocated when shutdown and
;inferior killed.
;The LP macro will reserve one page right here to store the
;request (NEXTJB message)
LP J$$BEG,0 ;BEGINNING OF PARAMETER AREA
;General stream params
LP J$SSTK,STKSIZ ;Stack
LP J$SFRK,1 ;Handle on fork
LP J$SDPC,1 ;PC where last dismissed for I/O
LP J$SDTM,1 ;Time when last dismissed
LP J$SIST,1 ;Stream status, set by inferior before termination
; See ISTTAB for values.
LP J$SMOP,^D<15> ;Buffer for message passed to top fork
LP J$SICD,1 ;Stream command
;Right half is set when inf. is started
;See ICDTAB for values.
;Left half holds cancel command bits
ICD.AB==1B0 ;Abort bit
ICD.RQ==1B1 ;Requeue bit
LP J$SMLG,^D<15> ;Buffer for message when aborting inferior
LP J$SOBJ,OBJ.SZ ;Object (Printer) parameters
LP J$SCKP,1 ;Time for next checkpoint
LP J$SPTL,1 ;Protocol, see below in PTLTAB
LP J$SSTG,^D<15> ;Translated device name string
;Current request parameters
LP J$RFLN,1 ;NUMBER OF FILES IN REQUEST
LP J$RLIM,1 ;JOB LIMIT IN PAGES
LP J$RTIM,1 ;START TIME OF JOB
LP J$RLFS,1,Z ;ADR OF LOG FILE SPEC
LP J$RHNM,5,Z ;Name of remote host if used
LP J$RRST,1 ;Status of job in remote queue
LP J$RLPT,10 ;Name of remote printer
;Parameters saved in checkpoints.
;All protocols don't use all fields. PTLTTY uses all fields.
;PTLUNX ignores everything except the flags and device.
LP J$CBEG,0 ;Start of checkpoint params
LP J$CNFT,1,Z ;Number of files transferred
LP J$CNCT,1,Z ;Copies of last file transferred
LP J$CNPT,1,Z ;Pages of last copy transferred
LP J$CFLG,1,Z ;Status of checkpoint
CFGCKP==1B0 ;Checkpoint taken
CFGREM==1B1 ;Job sits in remote queue
CFGREQ==1B2 ;Job is requeued
LP J$CEND,1 ;End of checkpoint params
CHKLEN==J$CEND-J$CBEG ;Length of area
LP J$CMSG,1 ;Pointer to routine to generate CKP
; message output in queue listing
;Output parameters
LP J$OBFR,OPBFSZ/<36/8>+1 ;Output buffer
LP J$OBPT,1 ;Byte pointer
LP J$OBCT,1 ;Byte count
LP J$OBTZ,1 ;Output byte size
LP J$OJFN,1 ;JFN
;Current forms parameters
DEFINE FS(X,Y),<
LP J$F'X,1
>
LP J$FCUR,0 ;START OF FORMS PARAMS
F ;CURRENT FORMS PARAMS
LP J$LDEV,1 ;Actual output device name
LP J$FORM,1 ;CURRENT FORMS TYPE
LP J$FWCL,1 ;CURRENT WIDTH CLASS
LP J$FLCL,1 ;Current length class
LP J$FJFN,1 ;JFN of LPFORM.TXT
;Parameters related to currently printing file
LP J$ITNM,5 ;Temp file name used for UNIX
LP J$INAM,10 ;Filename in recognizable form
LP J$IEXT,10 ;Extension and version no
LP J$IIPG,1 ;Pages to skip if > 0, don't if <=0
LP J$IJFN,1 ;The JFN
LP J$IFNM,1 ;Points to 'real' filename string
LP J$IBFR,IPBFSZ/<36/7>+1 ;Input buffer
LP J$IBPT,1 ;Byte pointer
LP J$IBCT,1 ;Byte count
LP J$IICT,1 ;Max no of bytes in curr size in buffer
LP J$IIBP,1 ;Byte pointer to start of buffer
;Miscellaneous
LP J$XTOP,1 ;Set if at top of form
LP J$XVPS,1 ;Current vertical position
LP J$XHPS,1 ;Current horizontal pos
LP J$XHBF,^D<20> ;Buffer for banner/header/trailer line
LP J$XCOD,^D<55> ;/REPORT check routine
LP J$XFRC,1 ;FORTRAN CHARACTER REPEAT COUNT
LP J$XCNT,1 ;Count of chars output with OUTBUF
LP J$XTMP,^D<25> ;Temporary buffer (strings, param blks)
;Log file parameters
LP J$LBFR,LGBFSZ/<36/7>+1 ;Log buffer
LP J$LBPT,1 ;Byte pointer
LP J$LBCT,1 ;Byte count
;Accounting params
LP J$ANPT,1,Z ;Total no of pages printed
;Control file parameters (for UNIX)
LP J$TBFR,CTBFSZ/<36/7>+1 ;Buffer
LP J$TBPT,1 ;Byte pointer
LP J$TBCT,1 ;Byte count
;CHKDVI definitions and storage
DMGNUM==^D223 ;MAGIC NUMBER IN DVI TRAILER
MAXDVR==^D3 ;MAXIMUM DVI VERSION (CURRENTLY MIGHT BE 2)
PSTBFL==50 ;LENGTH OF BUFFER FOR READING DVI TRAILER
LP J$PSTB,PSTBFL ;BUFFER FOR READING DVI TRAILER
LP J$$END,1 ;END OF PARAMETER AREA
J$$LEN==J$$END-J$$BEG ;LENGTH OF PARAMETER AREA
;Now generate a bit table of which words in the stream data area to zero
;on a new job
ZTABLE: ;PUT TABLE HERE
DEFINE ZTAB(A),<
IFNDEF ...Z'A,<...Z'A==0>
EXP ...Z'A
> ;END DEFINE ZTAB
ZZ==0
REPEAT <J$$LEN+^D35>/^D36,<
XLIST
ZTAB(\ZZ)
ZZ==ZZ+1
LIST
> ;END REPEAT
SUBTTL Random Impure Storage used by top fork
STACK: BLOCK STKSIZ ;Top's stack
MESSAG: BLOCK 1 ;ADDRESS OF MESSAGE JUST RECEIVED
BLKADR: BLOCK 1 ;IPCF MSG BLK ADDR SAVE AREA
SAB: BLOCK SAB.SZ ;A SEND ARGUMENT BLOCK
MSGBLK: BLOCK 2*MSBSIZ ;A block to build long messages in
STREAM: BLOCK 1 ;Number of current stream, index in STRPAR
INTFLG: BLOCK 1 ;Set to -1 on interrupts, 0 before
RSTFLG: BLOCK 1 ;-1 if main loop may be restarted, 0 otherwise
TMPBUF: BLOCK ^D20 ;Temp. buffer
SYSNAM: BLOCK ^D15 ;Sysname
ME: BLOCK ^D30 ;Name of this host
FRMFIL: ASCIZ /SYS:LPFORM.TXT/ ;File with forms params
;Permanent stream parameters
STRPAR: BLOCK NPRINT ;Address of the stream's (inferior fork's)
; parameter Area. 0 if not allocated
SUBTTL Message blocks and other constants
INTVEC==:LEVTAB,,CHNTAB
IB: $BUILD IB.SZ
$SET(IB.PRG,,%%.MOD) ;PROGRAM NAME
$SET(IB.INT,,INTVEC) ;INTERRUPT VECTOR ADDRESS
$SET(IB.PIB,,PIB) ;PIB ADDRESS
$SET(IB.FLG,IP.STP,1) ;STOPCODES TO ORION
$EOB
PIB: $BUILD PB.MNS
$SET(PB.HDR,PB.LEN,PB.MNS) ;PIB LENGTH,,0
$SET(PB.FLG,IP.PSI,1) ;PSI ON
$SET(PB.INT,IP.CHN,1) ;Interrupt on channel 1
$EOB
HELLO: $BUILD HEL.SZ
$SET(.MSTYP,MS.TYP,.QOHEL) ;MESSAGE TYPE
$SET(.MSTYP,MS.CNT,HEL.SZ) ;MESSAGE LENGTH
$SET(HEL.NM,,<'TCPSPL'>) ;PROGRAM NAME
$SET(HEL.FL,HEFVER,%%.QSR) ;QUASAR VERSION
$SET(HEL.NO,HENNOT,1) ;NUMBER OF OBJ TYPES
$SET(HEL.NO,HENMAX,NPRINT) ;MAX NUMBER OF JOBS
$SET(HEL.OB,,.OTLPT) ;LPT OBJECT TYPE
$EOB
SUBTTL TCPSPL - Multiple Line Printer Spooler.
;All code between here and INFST is only executed by the top fork.
TCPSPL: RESET% ;AS USUAL.
MOVE P,[IOWD STKSIZ,STACK] ;SET UP THE STACK.
MOVEI S1,IB.SZ ;GET THE IB SIZE.
MOVEI S2,IB ;ADDRESS OF THE IB.
$CALL I%INIT ;SET UP GALAXY
$CALL INTINI ;SET UP THE INTERRUPT SYSTEM.
;Some system stuff
MOVX S1,.FHSLF ;Enable priv's
SETOM T1 ;All!
EPCAP%
ERJMP [$STOP (NEP,Could not enable priv's)]
MOVX S1,.MSIIC ;GET 'IGNORE STR ACCTING' FUNCTION
MSTR% ;WE WANT TO IGNORE STRUCTURE ACCOUNTING
ERJMP .+1 ;IGNORE ANY ERROR
MOVX S1,'SYSVER' ;NAME OF GETTAB FOR SYSNAME
SYSGT% ;GET IT
HRLZ T1,S2 ;GET TABLE#,,0
MOVEI T2,^D14 ;AND LOAD LOOP COUNTER
TCPS.1: MOVS S1,T1 ;GET N,,TABLE#
GETAB% ;GET THE ENTRY
MOVEI S1,0 ;USE ZERO IF LOSING
MOVEM S1,SYSNAM(T1) ;STORE THE RESULT
CAILE T2,(T1) ;DONE ENUF?
AOJA T1,TCPS.1 ;NO, LOOP
MOVEI S1,.GTHNS ;Get host name
HRROI S2,ME
SETO T1,
GTHST%
ERJMP .+1 ;Should add default
MOVEI T1,HELLO ;GET ADDRESS OF HELLO MESSAGE.
$CALL SNDQSR ;SAY HI TO QUASAR.
$CALL I%ION ;Turn on interrupts
;Fall through
SUBTTL Main Loop
;Restarted at MAIN on interrupts or after 30 secs
MAIN: SETZM RSTFLG ;Don't restart us now
SETZM INTFLG ;and no interrupts seen yet
MOVX P1,NPRINT-1 ;Max number of streams
MAI.1: SKIPN J,STRPAR(P1) ;Is data area allocated?
JRST MAI.9 ;No, nothing interesting
MOVEM P1,STREAM ;Set STREAM also
MOVE S1,J$SFRK(J) ;Get its fork handle
RFSTS% ;and its status
ERJMP [$STOP (NFS,Can't get fork status)]
HLRZ S1,S1 ;Get interesting part of status word
CAIN S1,.RFRUN ;Is it running?
JRST MAI.8 ;Yes, leave it alone
CAIN S1,.RFSLP ;Is it sleeping?
JRST MAI.8 ;Don't wake it
CAIE S1,.RFHLT ;Is it halted?
JRST MAI.2 ;No
SKIPE S1,J$SIST(J) ;Yes, did it signal?
$CALL INFTRM ;Yupp, go check the message
JRST MAI.8 ;No, I guess it's just idle
;Now check for hung streams
MAI.2: CAIE S1,.RFIO ;Dismissed for I/O?
JRST MAI.3 ;Nope, serious error
CAME S2,J$SDPC(J) ;Compare PCs
JRST MAI.21 ;Halted some place else this time
GTAD% ;Get time
SUBX S1,3*DISTIM ;Subtract max I/O wait time
CAMGE S1,J$SDTM(J) ;Compare with prev. check time
JRST MAI.9 ;No time-out yet
$WTO (TCPSPL - Stream I/O Wait Time-out,,J$SOBJ(J))
MOVX S1,%RSUNA ;Shut it down temporarily
$CALL SUPMSG
JRST MAI.9 ;Check next stream
MAI.21: MOVEM S2,J$SDPC(J) ;Save PC
GTAD%
MOVEM S1,J$SDTM(J) ;and time
JRST MAI.9 ;Check next stream
;Involuntary termination
MAI.3: HRRZ T2,S2 ;Save PC
MOVE S1,J$SFRK(J) ;Get handle on process
$CALL ERRSTR ;and get the error string
$WTO (TCPSPL - Inferior Terminated Involuntarily,^T/TMPBUF/ at ^O/T2/,J$SOBJ(J))
MOVX S1,FATERT ;Shut it down properly
$CALL SUPMSG
;Fall through
MAI.8: SETZM J$SDPC(J) ;Indicate no I/O wait
MAI.9: SOJGE P1,MAI.1 ;Loop over all streams
$CALL CHKQUE ;Take care of any messages
;Sleep for 30 secs unless interrupted
SKIPE INTFLG ;Have we been interrupted?
JRST MAIN ;Yes, do another pass
SETOM RSTFLG ;We allow restarts now
MOVX S1,^D30000 ;Sleep for 30 secs
DISMS% ;..or until restarted
JRST MAIN
;;;;;;;;;;;;;;;;;;;
;ERRSTR - Puts the errormessage for the most recent error
;into TMPBUF.
;S1 should contain the fork handle for the process.
ERRSTR: HRLO S2,S1 ;Get handle
HRROI S1,TMPBUF ;Point to the buffer
SETZM T1
ERSTR%
JFCL
JFCL
$RETT
SUBTTL Interrupt Routines
LEVTAB: EXP LEV1PC ;Where to store level 1 int PC
EXP LEV2PC ;Level 2 in case we need it
EXP LEV3PC ;and 3
CHNTAB: BLOCK 1 ;Don't use channel 0
XWD 1,INTIPC ;Chn 1, IPCF message - level 1
BLOCK ^D17 ;We don't use these
XWD 1,INTINF ;Chn 19, Inferior termination
BLOCK ^D17 ;Rest of the table
LEV1PC: BLOCK 1 ;Where to store the PCs
LEV2PC: BLOCK 1
LEV3PC: BLOCK 1
;;;;;;;;;;;;;;;;;;;;;;;;
;INTINI - Enable interrupts
;(Interrupt system is initialized in I%INIT and I%ION)
;Note that EIR% and DIR% cannot be used reliably because of
;GLXLIB.
INTINI: MOVX S1,.FHSLF ;Load my fork handle
MOVX S2,<1B1!1B19> ;1:IPCF, 19:Inf. term.
AIC% ;Activate the channels
$RETT
;;;;;;;;;;;;;;;;;;;;;;;;
;INTIPC - Interrupt routine for IPC message
INTIPC: $CALL C%INTR ;Flag the interrupt for GLXLIB
JRST INTALL ;Jump to common code
;;;;;;;;;;;;;;;;;;;;;;;;
;INTINF - Interrupt routine for Inferior termination
INTINF: JRST INTALL ;Jump to common code
;;;;;;;;;;;;;;;;;;;;;;;;
;INTALL - Common part of interrupt handlers
;Sets the interrupts flag INTFLG and restarts the main loop at MAIN
;if restarting is allowed.
INTALL: SETOM INTFLG ;Flag the interrupt
SKIPN RSTFLG ;Should we restart?
DEBRK% ;NO!!!
MOVEI S1,MAIN ;Restart at MAIN
IORX S1,1B5 ;Indicate user mode
MOVEM S1,LEV1PC
DEBRK% ;Return to MAIN
SUBTTL CHKQUE -- Routine to receive and process IPCF messages
CHKQUE: $SAVE <P1>
$CALL C%RECV ;RECEIVE A MESSAGE
JUMPF .POPJ ;RETURN,,NOTHING THERE.
SETZM BLKADR ;CLEAR THE IPCF MSG BLK ADDR SAVE AREA
LOAD S2,MDB.SI(S1) ;GET SPECIAL INDEX WORD
TXNN S2,SI.FLG ;IS THERE AN INDEX THERE?
JRST CHKQ.5 ;NO, IGNORE IT
ANDX S2,SI.IDX ;AND OUT THE INDEX
CAIE S2,SP.OPR ;IS IT FROM OPR?
CAIN S2,SP.QSR ;IS IT FROM QUASAR?
SKIPA ;Yes, continue on
JRST CHKQ.5 ;Go to release the message
CHKQ.2: LOAD M,MDB.MS(S1),MD.ADR ;GET THE MESSAGE ADDRESS
LOAD S2,.MSTYP(M),MS.TYP ;GET THE MESSAGE TYPE
MOVSI S1,-NMSGT ;MAKE AOBJN POINTER FOR MSG TYPES
CHKQ.3: HRRZ T1,MSGTAB(S1) ;GET A MESSAGE TYPE
CAMN S2,T1 ;MATCH?
JRST CHKQ.4 ;YES, WIN
AOBJN S1,CHKQ.3 ;NO, LOOP
JRST CHKQ.5 ;Go to release the message
CHKQ.4: HLRZ P1,MSGTAB(S1) ;Pick up the address
$CALL CHKOBJ ;Check if the printer exists
JUMPF CHKQ.5 ;It doesn't, forget all this
;STREAM and J are correctly set now. Dispatch.
$CALL @P1 ;All OK, dispatch
CHKQ.5: $CALL C%REL ;Release the message
JRST CHKQUE ;Check for more
MSGTAB: XWD KILL,.QOABO ;ABORT MESSAGE
XWD CHKPNT,.QORCK ;REQUEST-FOR-CHECKPOINT
XWD NXTJOB,.QONEX ;NEXTJOB
XWD SETUP,.QOSUP ;SETUP/SHUTDOWN
XWD OACCON,.OMCON ;OPERATOR CONTINUE REQUEST.
XWD OACRSP,.OMRSP ;OPERATOR WTOR RESPONSE.
XWD OACREQ,.OMREQ ;OPERATOR REQUEUE REQUEST.
XWD OACCAN,.OMCAN ;OPERATOR CANCEL REQUEST.
XWD OACPAU,.OMPAU ;OPERATOR PAUSE/STOP REQUEST.
XWD OACFWS,.OMFWS ;OPERATOR FORWARD SPACE REQUEST.
XWD OACALI,.OMALI ;OPERATOR ALIGN REQUEST.
XWD OACSUP,.OMSUP ;OPERATOR SUPPRESS REQUEST.
XWD OACBKS,.OMBKS ;OPERATOR BACKSPACE REQUEST.
XWD QSRNWA,.QONWA ;QUASAR NODE-WENT-AWAY MESSAGE
XWD OPRD60,.OMDSP ;DN60 OPERATOR RESPONSE MESSAGE
XWD FORFOR,.QOFCH ;Force forms message
NMSGT==.-MSGTAB
SUBTTL INFTRM - Called when inferior terminates
;Dispatch table for message (termination reason)
ITMTAB: BDTB
DTE (ITM.0,IST.DN) ;Processing completed
DTE (ITM.1,IST.ER) ;Error, message in J$SMOP
DTE (ITM.2,IST.FT) ;Fatal error, message in J$SMOP
DTE (ITM.3,IST.MS) ;Message, in J$SMOP
DTE (ITM.4,IST.CP) ;Request for checkpoint
DTE (ITM.5,IST.CR) ;Cancel request and get next
EDTB (ITMLEN)
;J and STREAM should be set properly before this routine is called.
INFTRM: MOVE S1,J$SIST(J) ;Get message type
CAILE S1,0 ;Make sure it's legal
CAIL S1,ITMLEN
$STOP (IMI,Illegal Message from Inferior)
PJRST @ITMTAB(S1) ;Dispatch
;No return
;;;;
;Processing done (SIG.DN)
ITM.0: HRRZ S2,J$SICD(J) ;Get last command
HLLZ S1,J$SICD(J) ;and abort flags
SETZM J$SICD(J) ;and indicate we're idle
CAXN S2,ICD.SU ;Was it a set up?
JRST ITM.01 ;Yes
CAXN S2,ICD.NJ ;Or a new job?
JRST ITM.02 ;Yes
CAXN S2,ICD.CF ;Or new forms?
JRST ITM.04
$RETT ;Neither, just return
ITM.01: $WTO (TCPSPL - Stream Started,,J$SOBJ(J))
MOVX S1,%RSUOK ;Send a response to setup message
PJRST SUPMSG
ITM.02: PUSH P,S1 ;Save the abort flags
ANDX S1,ICD.RQ ;Only keep requeue flag
$CALL QRELEA ;Release/requeue the job
POP P,S1 ;Restore flags
$CALL FILDIS ;and go clean up
$RETT
ITM.04: PJRST UPDATE ;Send a reset message to QUASAR
;;;;
;Error (SIG.ER)
ITM.1: $WTO (TCPSPL - Error in Stream:,^T/J$SMOP(J)/,J$SOBJ(J))
MOVX S1,%RSUNA ;Say device is temp. unavail
PJRST SUPMSG ;and shut it down
;;;;
;Fatal error (SIG.FT)
ITM.2: $WTO (TCPSPL - Fatal Error in Stream:,^T/J$SMOP(J)/,J$SOBJ(J))
MOVX S1,FATERT ;Say device perm. gone
PJRST SUPMSG ;and shut it down
;;;;
;Message to OPR (SIG.MS)
ITM.3: $WTO (TCPSPL - Message from Stream:,^T/J$SMOP(J)/,J$SOBJ(J))
JRST ITM.41 ;Continue inferior
;;;;
;Request for checkpoint (SIG.CP)
ITM.4: $CALL CHKPNT ;Take the checkpoint
ITM.41: MOVE S1,J$SFRK(J) ;Get inferior's fork handle
IORX S1,SF%CON ;Set continue bit
SFORK% ;and continue it
ERJMP [MOVX S1,.FHSLF
$CALL ERRSTR ;Get error string
$WTO (TCPSPL - Could not Continue Inferior,^T/TMPBUF/,J$SOBJ(J))
MOVX S1,%RSUNA ;Shut down for a while
PJRST SUPMSG]
$RETT
;;;;
;Cancel request and continue (SIG.CR)
; we got here because file was unprintable for some reason (did not exist)
ITM.5: SETZM S1 ;cancel request
$CALL QRELEA ;go do it
$CALL FILDIS ;go clean up any files
$RETT
SUBTTL Status and checkpoint routines
;CHKPNT -- Request for Checkpoint
;This routine is to checkpoint the job whose data area is pointed to by J.
;A stream should only be checkpointed when the inferior fork has requested
;it.
;Dispatch table for J$CMSG
CHKDTB: BDTB
DTE (CHK.0,MSG.NOR) ;Standard message
DTE (CHK.1,MSG.XFR) ;Message when transferring files
DTE (CHK.2,MSG.RQU) ;Message when in remote queue
EDTB (CKTLEN)
CHKPNT: $SAVE <P1> ;Save P1
MOVEI P1,MSGBLK ;and let it point to the block
MOVX S1,CH.FCH!CH.FST ;GET CHECKPOINT AND STATUS FLAGS
STORE S1,CHE.FL(P1) ;AND STORE THEM
LOAD S1,.EQITN(J) ;Get Jobs ITN
MOVEM S1,CHE.IT(P1) ;and store it
;Put our info into the CHE.IN field
MOVE S1,J$CFLG(J) ;Set checkpoint taken flag
TXO S1,CFGCKP
MOVEM S1,J$CFLG(J)
HRRI S1,CHE.IN(P1) ;set up for BLT, ?,,dest
HRLI S1,J$CBEG(J) ;source,,dest
BLT S1,J$CEND-J$CBEG+CHE.IN-1(P1) ;and move it
;Put a message string into the CHE.ST (status) field.
SKIPN S1,J$CMSG(J) ;Get message type
$RETT ;Hasn't been set yet, so forget it
CAILE S1,0 ;Make sure type is legal
CAIL S1,CKTLEN
$STOP (ICM,Illegal Checkpoint Message Specified)
$CALL @CHKDTB(S1) ;Dispatch
MOVE S1,[POINT 7,CHE.ST(P1)] ;Point to string just created
ILDB S2,S1 ;Get a byte
JUMPN S2,.-1 ;Get to last NUL
HRRZ S1,S1 ;Just keep address i.e. length
AOS S1 ;Add one word
STORE S1,.MSTYP(P1),MS.CNT ;and save it
MOVX S1,.QOCHE ;Set the function
STORE S1,.MSTYP(P1),MS.TYP
MOVE T1,P1 ;Point to the message
PJRST SNDQSR ;and send it
;;;;
;Standard checkpoint message
CHK.0: $TEXT (<-1,,CHE.ST(P1)>,<Started at ^C/J$RTIM(J)/, printed ^D/J$ANPT(J)/ of ^D/J$RLIM(J)/ pages^0>)
$RETT
;;;;
;Message when transferring files
CHK.1: LOAD T1,.EQSPC(J),EQ.NUM ;Get no of files in request
ADDI T1,1 ;Add one control file
SKIPE J$FBAN(J) ;Banner file?
ADDI T1,1 ;Yes, another file
SKIPE J$FTRA(J) ;Trailer file?
ADDI T1,1 ;Yes, another file
$TEXT (<-1,,CHE.ST(P1)>,<Started at ^C/J$RTIM(J)/, transferred ^D/J$CNFT(J)/ of ^D/T1/ files to ^T/J$RHNM(J)/^0>)
$RETT
;;;;
;Message when job is in queue on remote system
CHK.2: SKIPE T1,J$RRST(J) ;Get position in remote queue
JRST CHK.21 ;Still waiting
$TEXT (<-1,,CHE.ST(P1)>,<Now printing on ^T/J$RHNM(J)/^0>)
$RETT
CHK.21: $TEXT (<-1,,CHE.ST(P1)>,<Number ^D/J$RRST(J)/ in queue on ^T/J$RHNM(J)/^0>)
$RETT
;;;;;;;;;;;;;;;;;;
;UPDATE -- Routine to send status updates to QUASAR
;J points to the stream's data area
UPDATE: MOVX S1,%RESET ;DEFAULT TO RESET
; TXNE S2,PSF%ST ;ARE WE STOPPED ???
; MOVX S1,%STOPD ;YES,,SAY SO
UPDA.5: MOVEI T1,MSGBLK ;GET THE MESSAGE BLOCK ADDRESS
MOVEM S1,STU.CD(T1) ;SAVE THE STATUS
HRLI S1,J$SOBJ(J) ;GET THE OBJECT BLOCK ADDRESS
HRRI S1,STU.RB(T1) ;GET DESTINATION ADDRESS
BLT S1,STU.RB+OBJ.SZ-1(T1) ;COPY THE OBJ BLK OVER TO THE MSG
MOVX S1,STU.SZ ;GET THE MESSAGE LENGTH
STORE S1,.MSTYP(T1),MS.CNT ;SAVE IT
MOVX S1,.QOSTU ;GET THE MESSAGE TYPE
STORE S1,.MSTYP(T1),MS.TYP ;SAVE IT
PJRST SNDQSR ;SEND IT OFF TO QUASAR
SUBTTL Requeue/Release routines
;QRELEASE -- Routine to send a release/requeue msg to QUASAR.
;If S1 = 0 it's a release else a requeue.
QRELEA: PUSH P,S1 ;Save param for a while
$WTOJ (TCPSPL - End,<^R/.EQJBB(J)/>,J$SOBJ(J)) ;TELL THE OPERATOR.
$LOG (TCPSPL - Printed ^D/J$ANPT(J)/ pages,,J$SOBJ(J)) ; Log it
MOVEI S1,MSBSIZ ;GET BLOCK LENGTH
MOVEI S2,MSGBLK ;AND THE ADDRESS
$CALL .ZCHNK ;ZERO THE BLOCK
POP P,S1 ;Restore param
JUMPN S1,RELA.1 ;Jump if requeue
;Here if release
MOVEI T1,MSGBLK ;GET ADDRESS OF THE BLOCK
LOAD S1,.EQITN(J) ;GET THE ITN
STORE S1,REL.IT(T1) ;STORE IT
MOVX S1,REL.SZ ;GET RELEASE MESSAGE SIZE
MOVX S2,.QOREL ;AND FUNCTION
JRST RELA.2
;Here on requeue (Job always restarted from beginning)
RELA.1: MOVEI T1,MSGBLK ;Address of the block
LOAD S1,.EQITN(J) ;Get the ITN
STORE S1,REQ.IT(T1) ;and save it away
MOVE S1,J$CFLG(J) ;Set Requeue flag in checkpoint data
TXO S1,CFGREQ
MOVEM S1,J$CFLG(J)
SETZM J$CNFT(J) ;Say no files printed
SETZM J$CNCT(J) ;Say no copies of last one printed
SETZM J$CNPT(J) ;Say no pages of last copy printed
HRRI S1,REQ.IN(T1) ;set up for BLT, ?,,dest
HRLI S1,J$CBEG(J) ;source,,dest
BLT S1,J$CEND-J$CBEG+CHE.IN-1(T1) ;and move it
MOVX S1,RQ.HBO ;Set hold by operator
STORE S1,REQ.FL(T1)
MOVX S1,REQ.SZ ;Size
MOVX S2,.QOREQ ;and function
;Fall through
;Common code
RELA.2: STORE S1,.MSTYP(T1),MS.CNT ;STORE SIZE
STORE S2,.MSTYP(T1),MS.TYP ;AND CODE
PJRST SNDQSR ;SEND IT TO QUASAR
;;;;;;;;;
;FILDIS -- Routine to keep/delete printed files.
;Called when a job is released
;Whether the user has delete access or not to the file has
;already been checked in INPOPN.
;S1 is <> 0 if job was aborted, 0 if normal termination.
FILDIS: $SAVE <P1,P2>
MOVE P2,S1 ;Save the param
LOAD E,.EQLEN(J),EQ.LOH ;Get the header length
ADD E,J ;Point to first file
LOAD P1,.EQSPC(J),EQ.NUM ;Get the number of files
FILD.1: LOAD T1,.FPLEN(E),FP.LEN ;Get the FP length
ADD T1,E ;Compute the FD address
MOVEI S2,.FDSTG ;File name offset
ADD S2,T1 ;S2 points to file name string
MOVE T2,.FPINF(E) ;Get the file info word
LOAD E,.FPLEN(E),FD.LEN ;Get the FD length
ADD E,T1 ;Point E at next FP block
HRRO S2,S2 ;Make a pointer to file name
MOVX S1,<GJ%SHT!GJ%OLD> ;Short form and file must exist
GTJFN% ;Get a handle
ERJMP FILD.4 ;Oh, well
TXNE T2,FP.SPL ;Is this file spooled?
JRST FILD.2 ;Yes, always delete and expunge
SKIPE P2 ;Normal termination?
JRST FILD.4 ;No, don't delete
TXNN T2,FP.DEL ;Yes, do we want it deleted?
JRST FILD.4 ;Nope, try next
JRST FILD.3 ;Yes, delete but don't expunge
FILD.2: IORX S1,DF%EXP ;Delete and expunge
FILD.3: DELF% ;Delete it
ERJMP FILD.4
FILD.4: RLJFN% ;Release JFN (just to be sure)
ERJMP .+1 ;We get a lot of errors
SOJG P1,FILD.1 ;Go process the next file
$RETT
SUBTTL CHKOBJ -- Routine to validate QUASAR/ORION/OPR msg obj blks.
;CALL: S1/OFFSET INTO MSGTAB
; S2/MESSAGE TYPE
;
;RET: J/Points to stream's data area
; STREAM/Set to stream number
CHKOBJ: CAIE S2,.OMRSP ;IS THIS AN OPERATOR RESPONSE ???
CAIN S2,.QOSUP ;IS THIS A SETUP/SHUTDOWN MESSAGE ??
$RETT ;YES,,JUST RETURN NOW.
CAIN S2,.OMDSP ;IS THIS A DN60 OPERATOR RESPONSE ???
$RETT ;YES,,JUST RETURN NOW.
CAIE S2,.QOFCH ;Is it forms change message?
CAIL S2,.OMOFF ;IS THIS AN OPR/ORION MSG ??
JRST CHKO.1 ;YES,,GO SET UP THE OBJ SEARCH.
XCT MSGOBJ(S1) ;GET THE OBJ BLK ADDRESS.
JRST CHKO.2 ;LETS MEET AT THE PASS.
CHKO.1: $CALL GETBLK ;GET A MESSAGE BLOCK
JUMPF .RETF ;NO MORE,,THATS AN ERROR
CAIE T1,.OROBJ ;IS THIS THE OBJECT BLOCK ???
JRST CHKO.1 ;NO,,GET THE NEXT MSG BLOCK
MOVE S1,T3 ;GET THE BLOCK DATA ADDRESS IN S1.
CHKO.2: $CALL FNDOBJ ;GO FIND THE OBJECT BLOCK.
JUMPF .RETF ;NOT THERE,,THATS AN ERROR.
$RETT ;RETURN.
MSGOBJ: MOVEI S1,ABO.TY(M) ;GET ABORT MSG OBJ ADDRESS.
MOVEI S1,RCK.TY(M) ;GET CHECKPOINT MSG OBJ ADDRESS.
MOVEI S1,.EQROB(M) ;GET NEXTJOB MSG OBJ ADDRESS.
;GETBLK -- ROUTINE TO BREAK DOWN AN IPCF MSG INTO ITS DATA BLOCKS
;CALL: M/ MESSAGE ADDRESS
;
;RET: T1/ BLOCK TYPE
; T2/ BLOCK LENGTH
; T3/ BLOCK DATA ADDRESS
GETBLK: SOSGE .OARGC(M) ;SUBTRACT 1 FROM THE BLOCK COUNT
$RETF ;NO MORE,,RETURN
SKIPN S1,BLKADR ;GET THE PREVIOUS BLOCK ADDRESS
MOVEI S1,.OHDRS+ARG.HD(M) ;NONE THERE,,GET FIRST BLOCK ADDRESS
LOAD T1,ARG.HD(S1),AR.TYP ;GET THE BLOCK TYPE
LOAD T2,ARG.HD(S1),AR.LEN ;GET THE BLOCK LENGTH
MOVEI T3,ARG.DA(S1) ;GET THE BLOCK DATA ADDRESS
ADD S1,T2 ;POINT TO THE NEXT MESSAGE BLOCK
MOVEM S1,BLKADR ;SAVE IT FOR THE NEXT CALL
$RETT ;RETURN TO THE CALLER
;;;;;;;;;;;;;;;;;;;
;FNDOBJ -- Check if the specified object (printer) exists
;Returns true with J pointing to parameter area and STREAM set
;to stream number if it does. Otherwise false.
FNDOBJ: MOVE T1,.ROBTY(S1) ;GET OBJECT TYPE
MOVE T2,.ROBAT(S1) ;GET UNIT NUMBER
MOVE T3,.ROBND(S1) ;AND NODE NUMBER
SETZM T4 ;CLEAR AN INDEX REGISTER
FNDO.1: SKIPN S1,STRPAR(T4) ;Stream allocated?
JRST FNDO.2 ;Nope, try next
MOVEI S2,J$SOBJ(S1) ;Get address of object block
CAMN T1,OBJ.TY(S2) ;COMPARE
CAME T2,OBJ.UN(S2) ;COMPARE
JRST FNDO.2 ;NOPE
CAMN T3,OBJ.ND(S2) ;COMPARE
JRST FNDO.3 ;WIN, SETUP THE CONTEXT
FNDO.2: ADDI T4,1 ;INCREMENT
CAIL T4,NPRINT ;THE END OF THE LINE?
$RETF ;YES,,RETURN 'OBJECT NOT THERE'
JRST FNDO.1 ;OK, LOOP
FNDO.3: MOVE J,STRPAR(T4) ;Return pointer to param area
MOVEM T4,STREAM ;and which stream it is
$RETT
SUBTTL SNDQSR -- Routine to send a message to QUASAR.
;T1 should point to the message block
SNDQSR: MOVX S1,SP.QSR ;GET QUASAR FLAG
TXO S1,SI.FLG ;SET SPECIAL INDEX FLAG
STORE S1,SAB+SAB.SI ;AND STORE IT
SETZM SAB+SAB.PD ;CLEAR THE PID WORD
LOAD S1,.MSTYP(T1),MS.CNT ;GET THE MESSAGE LENGTH
STORE S1,SAB+SAB.LN ;SAVE IT
STORE T1,SAB+SAB.MS ;SAVE THE MESSAGE ADDRESS
MOVEI S1,SAB.SZ ;LOAD THE SIZE
MOVEI S2,SAB ;AND THE ADDRESS
$CALL C%SEND ;SEND THE MESSAGE
JUMPT .RETT ;AND RETURN
$STOP (QSF,Send to QUASAR FAILED)
SUBTTL SETUP/SHUTDOWN Message processing
;M contains a pointer to the message
;J is not defined yet
SETUP: $SAVE <P1,P2> ;Save temp regs
LOAD S1,SUP.FL(M) ;GET THE FLAGS
TXNE S1,SUFSHT ;IS IT A SHUTDOWN?
JRST SHUTDN ;IF SO,,SHUT IT DOWN !!!
SETZM T2 ;CLEAR A LOOP REG
SETU.1: SKIPN STRPAR(T2) ;A FREE STREAM?
JRST SETU.2 ;YES!!
CAIGE T2,NPRINT-1 ;NO, LOOP THRU THEM ALL?
AOJA T2,SETU.1 ;NO, KEEP GOING
$STOP (TMS,Too many setups)
;Allocate memory for stream
;J will point at stream's parameter area
;STREAM is also set here.
SETU.2: MOVEI S1,J$$END ;GET THE LPT DATA BASE LENGTH
ADDI S1,PAGSIZ-1 ;ROUND UP TO NEXT HIGHEST PAGE
IDIVI S1,PAGSIZ ;GET NUMBER OF PAGES IN S1
$CALL M%AQNP ;ALLOCATE THEM
PG2ADR S1 ;CONVERT TO AN ADDRESS
MOVEM S1,STRPAR(T2) ;AND SAVE IT
MOVE J,S1 ;PUT IT IN J
MOVEM T2,STREAM ;Set STREAM also
SETZM J$SFRK(J) ;We don't have the inferior yet
;Save object block in J$SOBJ
MOVEI S2,J$SOBJ(J) ;Point at dest
HRLI S2,SUP.TY(M) ;and source
BLT S2,OBJ.SZ+J$SOBJ-1(J) ;Get it
LOAD S2,SUP.FL(M),SPLTAP ;Are we trying to spool to tape?
JUMPN S2,[$WTO (TCPSPL - Not started,Spooling to Tape not Supported,J$SOBJ(J))
MOVX S1,FATERT ;Signal does not exist
JRST SUPMSG]
;Get the translation of PLPTx: into J$SSTG
MOVEI P1,J$SOBJ(J) ;GET OUR OBJECT BLOCK ADDRESS
MOVE S1,OBJ.UN(P1) ;Get unit number
IDIVI S1,^D10 ;[wew]
LSH S1,6 ;[wew] shift top digit one char
ADDI S1,(S2) ;[wew] add in lower digit
ADD S1,[SIXBIT/LPT000/] ;Create physical name
MOVEM S1,J$LDEV(J) ;Save it
$TEXT (<-1,,J$XTMP(J)>,<PLPT^D/OBJ.UN(P1)/^0>) ;create unit name
MOVX S1,.LNSSY ;Transl. from logical to physical
HRROI S2,J$XTMP(J) ;Point to logical name
HRROI T1,J$SSTG(J) ;and where to store translation
LNMST%
ERJMP [$TEXT (<-1,,J$SSTG(J)>,<PLPT^D/OBJ.UN(P1)/:^0>)
JRST .+1]
MOVX S1,GJ%SHT ;LOAD GTJFN FLAGS
HRROI S2,J$SSTG(J) ;POINT TO THE STRING
GTJFN% ;Get JFN of the device
ERJMP [$WTO (TCPSPL - Not Started,<Can't find device ^T/J$SSTG(J)/>,J$SOBJ(J))
MOVX S1,FATERT
JRST SUPMSG]
MOVEM S1,J$OJFN(J) ;Save JFN for a millisecond
;See what type of device we have and select protocol accordingly
DVCHR%
ERJMP [$STOP (IJS,Internal JFN Screwup)]
LOAD T1,S2,DV%TYP ;Get device type
MOVE S1,J$OJFN(J) ;Get JFN again (trashed by DVCHR%)
RLJFN% ;We don't need the JFN any more
ERJMP [$STOP (CRJ,Can't Release JFN)]
SETZM S1 ;Indicate no protocol yet
CAIN T1,.DVTTY ;TTY?
MOVX S1,PTLTTY ;Yes, say so
CAIN T1,.DVTCP ;TCP?
MOVX S1,PTLUNX ;Yes, say so
JUMPN S1,SETU.4 ;Protocol found
$WTO (TCPSPL - Not Started,No Protocol for Device ^T/J$SSTG(J)/,J$SOBJ(J))
MOVX S1,FATERT
JRST SUPMSG
SETU.4: MOVEM S1,J$SPTL(J) ;Save protocol
;Fall through
;Spawn inferior fork and start it
MOVX S1,CR%MAP!CR%CAP!CR%ACS ;Same address space and priv's
MOVEI S2,0 ;Let it have these ACs to start with
CFORK%
ERJMP [MOVX S1,.FHSLF ;Get handle on myself
$CALL ERRSTR ;Get error string
$WTO (TCPSPL - Not started,<Can't create inferior, ^T/TMPBUF/>,J$SOBJ(J))
MOVX S1,FATERT
JRST SUPMSG]
MOVEM S1,J$SFRK(J) ;Save fork handle
HRL S2,S1
HRRI S2,DDTSEC ;source
MOVSI S1,.FHSLF ;destination
MOVX T1,SM%RD!SM%WR!SM%EX!1 ;one section, full access
SMAP% ;copy DDT
ERJMP .+1
MOVE S1,J$SFRK(J) ;get fork handle back
MOVX S2,ICD.SU ;Tell her we're starting up
MOVEM S2,J$SICD(J)
MOVEI S2,INFST ;Get start address
SFORK% ;Here we go
ERJMP [MOVX S1,.FHSLF
$CALL ERRSTR
$WTO (TCPSPL - Not started,<Can't start inferior, ^T/TMPBUF/>,J$SOBJ(J))
MOVX S1,FATERT
JRST SUPMSG]
$RETT
SUBTTL Routines to signal startup OK and errors to QUASAR
;;;;;;;;;;;;;;;;;
;SUPMSG - Startup message. Sends a response to setup message to
;QUASAR. The message type is passed in S1 and is one of %RSUOK,
;%RSUDE or %RSUNA. It is also called on errors, in which case the
;stream is shut down.
SUPMSG: $CALL RSETUP ;Send the response to setup msg.
CAXE S1,%RSUOK ;Was it OK
PJRST SHUTIN ;No, restore everything
$RETT ;Yes, return
;;;;;;;;;;;;;;;;;;;;
;RSETUP -- Routine to send a response-to-setup msg to QUASAR
; S1 contains condition code
RSETUP: $SAVE S1 ;SAVE THE SETUP CONDITION CODE.
MOVE T2,S1
MOVEI S1,RSU.SZ ;GET MESSAGE LENGTH
MOVEI S2,MSGBLK ;AND THE ADDRESS OF THE BLOCK
$CALL .ZCHNK ;ZERO IT OUT
MOVEI T1,MSGBLK ;GET THE BLOCK ADDRESS
MOVX S1,RSU.SZ ;GET MESSAGE SIZE
STORE S1,.MSTYP(T1),MS.CNT ;STORE IT
MOVX S1,.QORSU ;GET FUNCTION CODE
STORE S1,.MSTYP(T1),MS.TYP ;STORE IT
HRLI S1,J$SOBJ(J) ;GET OBJADR,,0
HRRI S1,RSU.TY(T1) ;AND PLACE TO MOVE IT TO
BLT S1,RSU.TY+OBJ.SZ-1(T1) ;AND MOVE THE OBJECT BLOCK
STORE T2,RSU.CO(T1) ;STORE THE RESPONSE CODE
MOVX S1,%LOWER ;Some dev. attributes
STORE S1,RSU.DA(T1),RO.ATR ;STORE THE DEVICE ATRRIBUTES
PJRST SNDQSR ;AND SEND THE MESSAGE
SUBTTL SHUTDN -- Routine to shut down stream
;This routine has two entry points. SHUTDN is called when the QUASAR
;message is received and has FNDOBJ set the J reg and STREAM.
;SHUTIN is an internal shutdown and assumes that J and STREAM are already
;properly set.
SHUTDN: MOVEI S1,SUP.TY(M) ;GET THE OBJECT BLOCK ADDRESS
$CALL FNDOBJ ;FIND THE OBJECT BLOCK
JUMPF .RETT ;NO OBJECT,,THEN NOTHING TO SHUT DOWN
;Kill inferior process
SHUTIN: MOVE S1,J$SFRK(J) ;Get handle
JUMPE S1,SHUT.1 ;Zero, i.e. fork not spawned
KFORK% ;and kill it
ERJMP [$STOP (CKI,Could not kill inferior)]
SETOM S1 ;Release all loose handles
RFRKH%
ERJMP [$STOP (CRF,Could not release fork handle)]
;Deallocate Job Area
SHUT.1: MOVE S1,STREAM ;Get our stream number
SETZM STRPAR(S1) ;Indicate no allocated Job Area
MOVEI S1,J$$END ;GET THE LPT DATA BASE LENGTH
ADDI S1,PAGSIZ-1 ;ROUND UP TO NEXT HIGHEST PAGE
IDIVI S1,PAGSIZ ;GET NUMBER OF PAGES IN S1
MOVE S2,J ;GET THE STRPAR ADDRESS
ADR2PG S2 ;CONVERT TO A PAGE NUMBER
$CALL M%RLNP ;RETURN THEM
$CALL M%CLNC ;GET RID OF UNWANTED PAGES.
$WTO (TCPSPL - Stream Shutdown,,J$SOBJ(J))
$RETT
SUBTTL NXTJOB -- NEXTJOB Message from QUASAR
;J points to the stream data area
;M points to the message
NXTJOB: HRR S1,J ;Move the Request block into job area
HRL S1,M ;GET SOURCE,,DEST
LOAD S2,.MSTYP(M),MS.CNT ;GET LENGTH OF MESSAGE
ADDI S2,-1(J) ;GET ADR OF END OF BLT
BLT S1,(S2) ;BLT THE DATA
;Tell inferior a new job is in
SKIPE J$SICD(J) ;Is inferior idle?
JRST [$WTO (TCPSPL - QUASAR error,New job received for already busy stream,J$SOBJ(J))
MOVX S1,FATERT
JRST SUPMSG]
MOVX S1,ICD.NJ ;Tell her it's a new job
MOVEM S1,J$SICD(J)
MOVE S1,J$SFRK(J) ;Get process handle
MOVEI S2,INFST ;Get start address
SFORK% ;Here we go
ERJMP [MOVX S1,.FHSLF ;Get handle on myself
$CALL ERRSTR ;and error string
$WTO (TCPSPL - New request failed,<Can't restart inferior, ^T/TMPBUF/>,J$SOBJ(J))
MOVX S1,FATERT
JRST SUPMSG]
$WTOJ (TCPSPL - Start,<^R/.EQJBB(J)/>,J$SOBJ(J)) ;Tell OPR
$RETT
SUBTTL FORFOR -- Force Forms change mess.
; This routine causes a forms change to occur even if there is no
; job currently scheduled for the printer.
;
; Assumes J contains the pointer to the job data base
; M contains a pointer to the message
; The object block has already been parsed correctly
FORFOR: MOVE S1,.OFLAG(M) ;Get the forms type
MOVEM S1,.EQLIM(J) ;Save it where NXTJOB does
;Tell inferior a change form request is in
SKIPE J$SICD(J) ;Is inferior idle?
JRST [$WTO (TCPSPL - QUASAR error,Forms request received for already busy stream,J$SOBJ(J))
MOVX S1,%RSUNA
JRST SUPMSG]
MOVX S1,ICD.CF ;Tell her we want new forms
MOVEM S1,J$SICD(J)
MOVE S1,J$SFRK(J) ;Get process handle
MOVEI S2,INFST ;Get start address
SFORK% ;Here we go
ERJMP [MOVX S1,.FHSLF
$CALL ERRSTR
$WTO (TCPSPL - Setting forms failed,<Can't restart inferior, ^T/TMPBUF/>,J$SOBJ(J))
MOVX S1,FATERT
JRST SUPMSG]
$RETT
SUBTTL Job Cancel and Requeue requests
;;;;;;;;;;;;;;;;;;;;;;;;;
;KILL - User CANCEL Request
KILL: MOVE S1,J$SICD(J) ;Have we already told inf. to abort?
TXNE S1,ICD.AB
$RETT ;Yes, forget this
$TEXT(<-1,,J$SMLG(J)>,<Job canceled by user ^U/ABO.ID(M)/^0^A>)
TXO S1,ICD.AB ;Tell her it's time to stop
MOVEM S1,J$SICD(J)
$WTOJ (<Canceled by User ^U/ABO.ID(M)/>,<^R/.EQJBB(J)/>,J$SOBJ(J))
$RETT
;;;;;;;;;;;;;;;;;;;;;;;;;
;CANCEL - Operator Cancel request
OACCAN: $CALL GETBLK ;GET A MESSAGE BLOCK
JUMPF OACC.1 ;No more i.e. normal ABORT
CAIE T1,.CANTY ;IS THIS THE CANCEL TYPE BLOCK ???
JRST OACCAN ;NO,,SKIP IT AND GET NEXT BLOCK
;Cancel type block found
MOVE S1,0(T3) ;LOAD THE CANCEL TYPE.
CAIE S1,.CNPRG ;IS IT /PURGE ???
JRST OACCAN ;NO,,PROCESS THE NEXT MSG BLK
;Tough cancel
MOVE S1,J$SFRK(J) ;Get handle
HFORK% ;and stop it
ERJMP [$STOP (CKA,Could not halt inferior in purge request)]
MOVX S1,SIG.DN ;Fake a DONE message from inferior
MOVEM S1,J$SIST(J)
JRST OACC.2
;Normal, careful cancel
OACC.1: $TEXT(<-1,,J$SMLG(J)>,Job aborted by OPERATOR^0^A) ;Message for the log
MOVX S1,ICD.AB ;Tell her it's time to stop
IORM S1,J$SICD(J)
OACC.2: $ACK (TCPSPL - Aborting,<^R/.EQJBB(J)/>,J$SOBJ(J),.MSCOD(M))
$RETT
;;;;;;;;;;;;;;;;;;;;;;;;;
;OACREQ -- Operator REQUEUE request.
;Jobs are always requeued to start from the beginning.
OACREQ: $TEXT(<-1,,J$SMLG(J)>,Job requeued by OPERATOR^0^A) ;Log message
MOVX S1,ICD.RQ ;Tell her it's time to stop
IORM S1,J$SICD(J)
$ACK (TCPSPL - Requeued,<^R/.EQJBB(J)/>,J$SOBJ(J),.MSCOD(M))
$RETT
SUBTTL Dummy routines for not implemented OPR commands
OACPAU: $ACK (TCPSPL - Ignored,PAUSE not supported,J$SOBJ(J),.MSCOD(M))
$RETT
OACCON: $ACK (TCPSPL - Ignored,CONTINUE not supported,J$SOBJ(J),.MSCOD(M))
$RETT
OACSUP: $ACK (TCPSPL - Ignored,SUPPRESS not supported,J$SOBJ(J),.MSCOD(M))
$RETT
OACALI: $ACK (TCPSPL - Ignored,ALIGN not supported,J$SOBJ(J),.MSCOD(M))
$RETT
OACFWS: $ACK (TCPSPL - Ignored,<FORWARD not supported, use ABORT>,J$SOBJ(J),.MSCOD(M))
$RETT
OACBKS: $ACK (TCPSPL - Ignored,<BACKSPACE not supported, use REQUEUE>,J$SOBJ(J),.MSCOD(M))
$RETT
OACRSP: $RETT ;Simply return
QSRNWA: $RETT ;Not used here, just return
OPRD60: $RET ;SHOULD NOT HAPPEN
SUBTTL Code for inferior forks
PRINTX [Processing inferior's code]
;The following code is executed only by the inferior forks.
;It cannot use the GLXLIB since some parts of it are not reentrant.
;In particular, the $TEXT macro must not be used.
;
;The inferior is always started and restarted at INFST.
;The function depends on the value of the left half of J$SICD.
;The inferior always terminates with a HALTF% prior to which it
;puts the termination reason into J$SIST.
;The right half of J$SICD is used to pass commands while running such
;as abort and requeue.
;Dispatch table for the different functions
ICDTAB: BDTB
DTE (INF.0,ICD.SU) ;Inferior runs first time (Startup)
DTE (INF.1,ICD.NJ) ;New job present in message area
DTE (INF.2,ICD.CF) ;Change forms command
EDTB (ICDLEN)
INFST: RESET% ;Clean up
MOVX S1,<IOWD STKSIZ,J$SSTK> ;Set up the stack
ADD S1,J ;Add data area offset to stack pointer
MOVE P,S1 ;and init it
SETZM J$SIST(J) ;Reset termination status
HRRZ S1,J$SICD(J) ;Get command
CAILE S1,0 ;Make sure it's legal
CAIL S1,ICDLEN
FATAL (Illegal Command to Inferior)
JRST @ICDTAB(S1) ;Dispatch
;;;;
;Stream startup
INF.0: MOVX S1,SIG.DN ;Quit right away
PJRST SIGNAL
;;;;
;New job request in message area
INF.1: ;Zero words related to job in stream data area
MOVEI S1,J$$BEG(J) ;Start address
MOVSI S2,-<J$$LEN+^D35>/^D36 ;AOBJN POINTER TO BIT TABLE
INF.11: MOVEI T1,^D36 ;BIT COUNTER FOR THIS WORD
MOVE T2,ZTABLE(S2) ;GET A WORD FROM BIT TABLE
INF.12: JUMPE T2,INF.13 ;DONE IF REST OF WORD IS ZERO
JFFO T2,.+1 ;FIND THE FIRST 1 BIT
ADD S1,T3 ;MOVE UP TO THE CORRESPONDING WORD
SETZM 0(S1) ;AND ZERO IT
SUB T1,T3 ;REDUCE BITS LEFT IN THIS WORD
LSH T2,0(T3) ;SHIFT OFFENDING BIT TO BIT 0
TLZ T2,(1B0) ;AND GET RID OF IT
JRST INF.12 ;AND LOOP
INF.13: ADD S1,T1 ;ACCOUNT FOR THE REST OF THE WORD
AOBJN S2,INF.11 ;AND LOOP
LOAD S1,.EQSPC(J),EQ.NUM ;GET NUMBER OF FILES
MOVEM S1,J$RFLN(J) ;STORE IT
GETLIM T1,.EQLIM(J),OLIM ;GET PAGE LIMIT
MOVEM T1,J$RLIM(J) ;SAVE IT
GTAD% ;GET TIME OF DAY
MOVEM S1,J$RTIM(J) ;SAVE IT AWAY
;Initialize all buffers
;Input buffer is init when file is opened and UNIX control file
;buffer in UNXCTL.
MOVX S1,<POINT 8,0> ;Set byte pointer for output buffer
MOVEM S1,J$OBTZ(J)
$CALL OUTRES ;Init output buffer
MOVX S1,LGBFSZ ;Log buffer
MOVEM S1,J$LBCT(J)
MOVE S1,[POINT 7,J$LBFR(J)]
MOVEM S1,J$LBPT(J)
SETZM S ;Reset all flags
;Some log info
MOVEI T1,LPTVER ;Get version number
MOVEI T2,LPTMIN
LOGMSG (TCPSPL version ^DT1^T.^DT2^T on ^ASYSNAM)
LOAD T1,.EQSEQ(J),EQ.SEQ ;Get sequence number
MOVE T2,OBJ.UN+J$SOBJ(J) ;Get unit number
LOGMSG (Job ^S.EQJOB(J)^T sequence #^DT1^T on Printer ^DT2^T at ^AME)
;Restore checkpoint info
SKIPN T1,J$CFLG-J$CBEG+.EQCHK(J) ;Job previously checkpointed?
JRST INF.15 ;No, new job
HRRI S1,J$CBEG(J) ;Yes, get checkpoint info: ??,,dest
HRL S1,.EQCHK(J) ;source,,dest
BLT S1,J$CEND-1(J) ;get it
MOVE S1,J$CFLG(J) ;Get checkpoint flags
TXNE S1,CFGREQ ;Job requeued or crashed?
JRST INF.14 ;Requeued
LOGMSG (Job Restarted after Failure)
SKIPA
INF.14: LOGMSG (Job Restarted after Requeuing)
;Get protocol and dispatch to appropriate routine
INF.15: MOVE S1,J$SPTL(J)
$CALL @PTLTAB(S1) ;Go do it
MOVX S1,SIG.DN ;Tell superior we're done
PJRST SIGNAL
;PTLTAB, dispatch table for the different protocols
PTLTAB: BDTB
DTE (DONOR,PTLTTY) ;PTLTTY i.e. print on local TTY - LPT
DTE (DOUNX,PTLUNX) ;PTLUNX i.e. send to remote UNIX 4.2
EDTB (PTLEN)
;;;;
;Take care of change forms command
INF.2: SETZM S ;Reset all flags
$CALL FORMS ;Set the forms
MOVX S1,SIG.DN ;Tell superior we're done
PJRST SIGNAL
;;;;;;;;;;;;;;;;;;;;;;;;;
;SIGNAL -- Passes messages to superior by setting the J$SIST var
;and halting. Some of the messages expect the superior to continue
;this fork after processing, others generate error if continued.
;Dispatch table
;The .CC function only generates a signal if it's time to checkpoint, returns
;directly normally. .CP always requests a checkpoint
SIGTAB: BDTB
DTE (SIG.0,SIG.DN) ;Done with processing
DTE (SIG.1,SIG.ER) ;Error (called by ERROR macro)
DTE (SIG.2,SIG.FT) ;Fatal error (called by FATAL macro)
DTE (SIG.3,SIG.MS) ;Message (called by OPRMSG macro)
DTE (SIG.4,SIG.CP) ;Request for checkpoint
DTE (SIG.5,SIG.CC) ;Check if checkpoint needed
DTE (SIG.6,SIG.CR) ;Cancel request and go to nxt
EDTB (SIGLEN)
SIGNAL: CAILE S1,0 ;Make sure command is legal
CAIL S1,SIGLEN
FATAL (Illegal Signal Requested)
JRST @SIGTAB(S1) ;Dispatch
;;;;;
;Processing done
SIG.0: MOVX S1,IST.DN
JRST SIG.22
;;;;;
;Error
SIG.1: MOVX S1,IST.ER
JRST SIG.22
;;;;;
;Fatal Error
SIG.2: MOVX S1,IST.FT
SIG.22: SKIPE J$SIST(J) ;Must be reset
FATAL (Inferior's Status not Reset)
MOVEM S1,J$SIST(J) ;Set new value
HALTF% ;Stop and tell superior
FATAL (Illegal Attempt to Continue Inferior) ;Not continuable
;;;;;
;Message to OPR
SIG.3: MOVX S1,IST.MS
JRST SIG.42
;;;;;
;Request for checkpoint
SIG.4: GTAD% ;Get time
ADDX S1,3*CKPTIM ;Add time until next
HRRZM S1,J$SCKP(J) ;Out with it, without date
MOVX S1,IST.CP ;Checkpoint message
SIG.42: SKIPE J$SIST(J) ;No prev. status set, please
FATAL (Inferior's Status not Reset)
MOVEM S1,J$SIST(J)
HALTF% ;Stop and tell superior
SETZM J$SIST(J) ;We're continuable
$RETT
;;;;;
;Check if time for a timed checkpoint
SIG.5: TXNN S,TIMCKP ;Timed checkpoints enabled?
$RETT ;No, forget this
GTAD% ;Get time
HRRZ S1,S1 ;Remove date
SUB S1,J$SCKP(J) ;Subtract set time
JUMPGE S1,SIG.4 ;It's time: request one
$RETT ;Not time yet
;;;;
;Cancel request and get next (file unprintable or something)
SIG.6: MOVX S1,IST.CR
JRST SIG.22
;;;;;;;;;;;;;;;;;;;;;;;;;
;CHKABT -- Checks if superior wants to abort the processing.
;Returns true if time to abort, false otherwise.
CHKABT: MOVE S1,J$SICD(J) ;Get command word
TXNN S1,<ICD.AB!ICD.RQ> ;Abort or requeue
$RETF ;None, return false
$RETT ;Say it's time to quit
;;;;;;;;;;;;;;;;;;;;;;;;;
;The TXT.xx routines are called by code generated by the
;TXT macro.
;S1 contains a byte pointer which must be updated, or the
;address of routine which outputs one char from C.
;S2 points to the argument.
;All ACs are preserved (except S1 if byte pointer)
;;;;;;;;
;TXT.AS - S2 points to an ASCIZ string
TXT.AS: $SAVE <S2,T1> ;Save some regs
MOVE T1,S2 ;Get the address
ADD T1,[POINT 7,0] ;Make it a byte pointer
TXT.A1: ILDB S2,T1 ;Incr. the byte pointer
SKIPN S2 ;Check if end of string
$RETT ;Yupp, return
CAIE S2,^D22 ;Hairy patch to remove ctl-Vs
$CALL TXT.CH ;Output the char in S2
JRST TXT.A1
;;;;;;;;
;TXT.DN - S2 points to a word to be output as a decimal number
TXT.DN: $SAVE <S2,T1>
PUSH P,S1 ;Save S1 temporarily
MOVE S2,@S2 ;Get the number
HRROI S1,J$XTMP(J) ;Point to temp buffer
MOVX T1,<FLD ^D10,NO%RDX> ;Decimal radix
NOUT%
ERJMP .+1
TXT.D1: SETZM S2 ;Put a NUL last in buffer
IDPB S2,S1
POP P,S1 ;Get dest. back
MOVEI S2,J$XTMP(J) ;Point to buffer
$CALL TXT.AS ;And output string
$RETT
;;;;;;;;
;TXT.SX - S2 points to a SIXBIT word
TXT.SX: $SAVE <S2,T1,T2,T3>
MOVE T1,@S2 ;Get the word
MOVE T2,[POINT 6,T1] ;Make a byte pointer
MOVEI T3,^D6 ;Loop counter
TXT.S1: ILDB S2,T2 ;Get a byte
SKIPN S2 ;Is it zero (=space)?
$RETT ;Yes, return
ADDI S2,40 ;Make it ASCII
$CALL TXT.CH ;Out with it
SOJG T3,TXT.S1 ;Loop
$RETT ;All 6 chars translated
;;;;;;;;
;TXT.DT - S2 points to a word in internal time format
TXT.DT: $SAVE <S2,T1>
MOVE S2,@S2 ;Get the time
MOVX T1,0
JRST TXT.T1
;;;;;;;;
;TXT.TI - Outputs current time
TXT.TI: $SAVE <S2,T1>
SETOM S2
MOVX T1,<OT%NDA> ;Only time
TXT.T1: PUSH P,S1 ;Save dest for a while
HRROI S1,J$XTMP(J) ;Point to temp buffer
ODTIM%
PJRST TXT.D1 ;Finish up
;;;;;;;;
;TXT.ER - Outputs the most recent error
TXT.ER: $SAVE <S2,T1>
MOVX S2,<.FHSLF,,-1> ;Most recent error
MOVX T1,^D30 ;Max number of chars
PUSH P,S1 ;Save dest for a while
HRROI S1,J$XTMP(J) ;Point to temp buffer
ERSTR%
ERJMP .+1
JFCL
PJRST TXT.D1 ;Finish up
;;;;;;;;
;TXT.CH - Outputs the right adjusted char in S2
;Also handles the source designator in S1 properly.
TXT.CH: $SAVE <T1,C>
HLRZ T1,S1 ;Get left half of source design.
JUMPE T1,TXT.C1 ;Zero i.e. address of routine
;Left half of S1 is non-zero i.e. byte pointer
IDPB S2,S1 ;Out with it
$RETT
;Left half is zero i.e. address of routine
TXT.C1: PUSH P,S1 ;Save our address
MOVE C,S2 ;Get the char into right reg
$CALL @S1 ;Dispatch
POP P,S1 ;Restore address
$RETT
SUBTTL Common routines used by the different DOxxxx handlers
;;;;;;;;;;;;;;;;;;;;;
;FINISH -- Does the accounting and other misc stuff.
;Called immediately before outputting the trailer.
FINISH: MOVE S1,J$SICD(J) ;Were we aborted or requeued?
TXNE S1,<ICD.AB!ICD.RQ>
LOGMSG (^AJ$SMLG(J)) ;Yes, insert message into log
LOGMSG (Total ^DJ$ANPT(J)^T Pages of Output)
;;;Do a USAGE JSYS account update
$RETT
SUBTTL DONOR -- Print on a normal TTY-LPT
DONOR: $SAVE <P1>
$CALL FORMS ;GET FORMS MOUNTED
;Open the TTY
MOVX S1,GJ%SHT ;LOAD GTJFN FLAGS
HRROI S2,J$SSTG(J) ;POINT TO THE STRING
GTJFN% ;Get JFN of the device
ERJMP [FATAL (<GTJFN Failed Second Time on ^AJ$SSTG(J)^T, ^E>)]
MOVEM S1,J$OJFN(J) ;Save JFN
MOVX S2,<OF%WR!<FLD 8,OF%BSZ>> ;Write 8 bit bytes
OPENF%
ERJMP [ERROR (<Can't Open Device ^AJ$SSTG(J)^T, ^E>)]
;Set the device characteristics
MOVE S1,J$OJFN(J)
MOVX S2,<TT%LCA!TT%PGM> ;Set LC and ctl-S/ctl-Q
STPAR%
ERJMP [ERROR (<Can't Set Params for Device ^AJ$SSTG(J)^T, ^E>)]
MOVE S1,J$OJFN(J) ;and image mode
MOVX S2,<FLD .TTBIN,TT%DAM>
SFMOD%
ERJMP [ERROR (<Can't Set Params for Device ^AJ$SSTG(J)^T, ^E>)]
;Start printing stuff
LOGMSG (Printing to Local Device ^AJ$SSTG(J)^T, Protocol PTLTTY)
MOVX T1,MSG.NOR ;Normal checkpoint messages
MOVEM T1,J$CMSG(J)
MOVE P1,J$CFLG(J) ;Get old flags before they're changed
TXO S,TIMCKP ;Enable timed checkpoints
MOVX S1,SIG.CP ;We want a checkpoint now
$CALL SIGNAL
$CALL JOBHDR ;Print banners
;Process files
LOAD E,.EQLEN(J),EQ.LOH ;Point to first file in request
ADD E,J
TXNN P1,CFGCKP ;Job restarted?
JRST DONO.3 ;No, new job
;Restarted job, skip things already done
MOVE S2,J$CNFT(J) ;Get no of files prev. sent
DONO.1: SOJL S2,DONO.2 ;Skip already printed files
$CALL NXTFIL ;Bump E to next spec
JUMPF DONO.7 ;All already printed
JRST DONO.1
DONO.2: MOVE T1,J$CNPT(J) ;Get no of pages prev. printed
SUBI T1,3 ;We want some overlap
SKIPGE T1
SETZM T1 ;Lowest page no is zero
JRST DONO.4
;New job
DONO.3: LOAD T1,.FPFST(E) ;Get /START param
SOS T1 ;Subtract one
DONO.4: MOVEM T1,J$IIPG(J) ;save as initial page
$CALL NORFIL ;Print the file with all copies
$CALL NXTFIL ;Get next file
JUMPT DONO.3
;All files printed, finish up
DONO.7: SKIPE E,J$RLFS(J) ;Any log file to print?
$CALL NORFIL ;Yes, do it
$CALL FINISH ;Do the accounting etc
$CALL JOBTRL ;Print the trailer
MOVE S1,J$OJFN(J) ;Get JFN
CLOSF% ;and close down
ERJMP .+1
$RETT
;NORFIL -- Print a File on TTY-LPT
;This routine is always called for each of the files in the request even
;when the job has been canceled. (Although nothing is done in such case.)
NORFIL: $CALL CHKABT ;Are we canceled?
JUMPT .RETT ;Yes, return
$CALL LIMCHK ;Are we over limit?
$RETIF ;Yes, just return
$CALL INPOPN ;OPEN THE INPUT FILE UP
$RETIF ;Fail, return
LOGMSG (Starting File ^A@J$IFNM(J))
NORF.1: $CALL LIMCHK ;Check if we're over page limit
MOVX S1,SIG.CP ;Want a checkpoint now
$CALL SIGNAL
$CALL CHKABT ;Are we aborted?
JUMPT NORF.4 ;Yes
$CALL FILOUT ;PRINT THE FILE
TXNE S,ERRFIL ;Was there an error in the file?
JRST NORF.4 ;Yes, skip rest of it
$CALL CHKABT ;Are we aborted?
JUMPT NORF.4 ;Yes
LOAD T1,.FPFST(E) ;Get /START param
SOS T1 ;adjust it
MOVEM T1,J$IIPG(J) ;and save for next copy
AOS J$CNCT(J) ;Bump copy count
LOAD T1,.FPINF(E),FP.FCY
CAMLE T1,J$CNCT(J) ;All copies printed?
JRST NORF.1 ;No
AOS J$CNFT(J) ;Yes, bump file count
SETZM J$CNCT(J) ;and reset copy count
MOVX S1,SIG.CP ;Checkpoint now
$CALL SIGNAL
LOGMSG (Finished File ^A@J$IFNM(J)) ;Finished OK
NORF.4: $CALL INPCLS ;Close the file
TXNE S,SUPFIL ;Are we suppressing forms/file?
SETZM J$XTOP(J) ;Yes, set we are not at top of page.
TXZ S,SUPFIL+ERRFIL ;CLEAR LOTS OF BITS
$RET ;AND RETURN
SUBTTL DOUNX -- Transfer files to remote UNIX 4.2 spooler
;Everything is transferred twice. The first time is a dummy transfer to
;count the number of characters. The second time is the real transfer.
;Note that files/headers/banners etc must not change in size between
;the two events.
DOUNX: $CALL FORMS ;GET FORMS MOUNTED
LOGMSG (<Transfering to TCP Device ^AJ$SSTG(J)^T, Protocol PTLUNX>)
;Start printing stuff.
;The only checkpoint info used is whether restarted job sits in remote
;queue or not. However, checkpoints are taken to update the queue
;listing message. The J$CNFT var is used to make unique temp
;filenames for the remote machine.
MOVE T1,J$CFLG(J) ;Is job in remote queue?
TXNE T1,CFGREM
JRST DOUN.7 ;Yes, go monitor it
SETZM J$CNFT(J) ;No, reset temp name variable
MOVX S1,CT.INI ;Init control file
$CALL UNXCTL
MOVX S1,CD.PRI ;Open connnection and send 'Print' command
$CALL UNXCMD
MOVX S1,MSG.XFR ;'Transferring' messages
MOVEM S1,J$CMSG(J)
MOVX S1,SIG.CP ;Take a CKP to set message
$CALL SIGNAL
;Send the banner file
$CALL CHKABT ;Are we canceled?
JUMPT DOUN.9 ;Yes, go clean up
SKIPN J$FBAN(J) ;Do we want banners?
JRST DOUN.1 ;No, don't bother
SETZM J$XCNT(J) ;Reset character count
TXO S,CHRCNT ;count chars first time
$CALL JOBHDR
TXZ S,CHRCNT
MOVE S1,J$XCNT(J) ;Get the char count
PUSH P,S1 ;and save it for a while
LOGMSG (<Starting Transfer of Banner, Charcount ^DJ$XCNT(J)>)
MOVX S1,CD.DAT ;Say we're sending a data file
$CALL UNXCMD
SETZM J$XCNT(J) ;Reset char count again
$CALL JOBHDR ;Now send it
POP P,S1 ;Get prev count back
SUB S1,J$XCNT(J) ;Check if equal
SKIPE S1
LOGMSG (<Header Charcount Different Second Time - ^DS1>)
MOVX S1,CD.EOF ;Send an EOF and wait for acknowledge
$CALL UNXCMD
MOVX S1,CT.BAN ;Insert appropr cards in ctl file
$CALL UNXCTL
MOVX S1,SIG.CP ;Take a CKP to update message
$CALL SIGNAL
;Process files
DOUN.1: LOAD E,.EQLEN(J),EQ.LOH ;Point to first file in request
ADD E,J
DOUN.2: $CALL UNXFIL ;Send the file
JUMPF DOUN.9 ;Some error, abort transfer
$CALL NXTFIL ;Get next file
JUMPT DOUN.2
;All files sent, finish up
DOUN.3: SKIPE E,J$RLFS(J) ;Any log file to print?
$CALL UNXFIL ;Yes, do it
$CALL FINISH ;Do the accouting
;Send trailer file
$CALL CHKABT ;Are we canceled?
JUMPT DOUN.9 ;Yes, go clean up
SKIPN J$FTRA(J) ;Do we want trailers?
JRST DOUN.5 ;No, forget it
LOGMSG (<Starting Transfer of Trailer, Goodbye...>)
SETZM J$XCNT(J) ;Reset character count
TXO S,CHRCNT ;count chars first time
$CALL JOBTRL
TXZ S,CHRCNT
MOVE S1,J$XCNT(J) ;Save count for a while
PUSH P,S1
MOVX S1,CD.DAT ;Say we're sending a data file
$CALL UNXCMD
SETZM J$XCNT(J) ;Reset char count again
$CALL JOBTRL ;Now send it
POP P,S1 ;Check that we sent the same number
SUB S1,J$XCNT(J)
SKIPE S1
LOGMSG (<Trailer Charcount Different Second Time - ^DS1>)
MOVX S1,CD.EOF ;Send an EOF and get acknowledge
$CALL UNXCMD
MOVX S1,CT.BAN ;Insert appropr cards in ctl file
$CALL UNXCTL
MOVX S1,SIG.CP ;Take a CKP to update message
$CALL SIGNAL
;Send control file
DOUN.5: $CALL CHKABT ;Are we canceled?
JUMPT DOUN.9 ;Yes, go clean up
MOVX S1,CTBFSZ ;Comp. no of chars in buffer
SUB S1,J$TBCT(J)
MOVEM S1,J$XCNT(J) ;Store as char count
SETZM S1 ;Put a NUL last in buffer
$CALL CTLCHR
MOVX S1,CD.CTL ;Send a control file header
$CALL UNXCMD
TXT (0,OUTCHR,^AJ$TBFR(J)) ;Dump the buffer
MOVX S1,CD.EOF ;Send an EOF
$CALL UNXCMD
$CALL TCPCLS ;Close connection
AOS J$CNFT(J) ;One more file transferred
;Update status info
MOVE T1,J$CFLG(J) ;Get checkpoint flags
TXO T1,CFGREM ;Indicate in remote queue
MOVEM T1,J$CFLG(J)
MOVX S1,SIG.CP ;and take the checkpoint
$CALL SIGNAL
;Fall through
;;;;
;Monitor remote queue
DOUN.7: MOVX T1,MSG.RQU ;Use 'In remote queue' message
MOVEM T1,J$CMSG(J)
DOU.71: $CALL CHKABT ;Have we been canceled?
JUMPF DOU.72 ;No
MOVX S1,CD.RMV ;Yes, remove from remote queue
$CALL UNXCMD
$RETT ;All done
DOU.72: MOVX S1,CD.RQU ;Get info on remote queue
$CALL UNXCMD
SKIPGE J$RRST(J)
$RETT ;No longer in remote queue
MOVX S1,SIG.CP ;Update CKP message
$CALL SIGNAL
MOVX S1,^D20000 ;Sleep for 20 secs
DISMS%
JRST DOU.71 ;Then check again
;;;;
;Send a 'forget files transferred' message to remote, close down and
;tell superior all is done
DOUN.9: MOVX S1,CD.CNL
$CALL UNXCMD
$RETT
;;;;;;;;;;;;;
;UNXFIL -- Send a File to remote Host
;This routine is always called for each of the files in the request even
;when the job has been canceled. (Although nothing is done in such case.)
UNXFIL: $CALL CHKABT ;Are we canceled?
JUMPT .RETT ;Yes, return
$CALL LIMCHK ;Are we over limit?
$RETIF ;Yes, just return
$CALL INPOPN ;OPEN THE INPUT FILE UP
$RETIF ;Fail, return
TXO S,CHRCNT ;Count chars
SETZM J$XCNT(J) ;Reset counter
LOAD T1,.FPFST(E) ;Get /START param
SOS T1 ;Adjust it
MOVEM T1,J$IIPG(J) ;save as starting page
$CALL FILOUT ;Count it
TXZ S,CHRCNT ;No more counting
MOVE S1,J$XCNT(J) ;Get the count
PUSH P,S1 ;and save it temporarily
TXNE S,ERRFIL ;Error in file?
JRST UNXF.3 ;Yes, forget it
LOGMSG (<Starting Transfer of ^A@J$IFNM(J)^T, Charcount ^DJ$XCNT(J)>)
LOAD T1,.FPFST(E) ;Get /START param
SOS T1 ;Adjust it
MOVEM T1,J$IIPG(J) ;save as starting page
MOVX S1,CD.DAT ;Say we're sending a data file
$CALL UNXCMD
SETZM J$XCNT(J) ;Reset counter again
$CALL FILOUT ;Send it
POP P,S1 ;Get prev. count
SUB S1,J$XCNT(J) ;Check if same
SKIPE S1
LOGMSG (<File ^A@J$IFNM(J)^T or Header Changed Size - ^DS1>)
MOVX S1,CD.EOF ;Send EOF and get ackn.
$CALL UNXCMD
MOVX S1,CT.DAT ;Insert appropr cards in ctl file
LOAD S2,.FPINF(E),FP.FCY ;Number of copies
$CALL UNXCTL
UNXF.3: MOVX S1,SIG.CP ;Checkpoint to update message
$CALL SIGNAL
$CALL INPCLS ;Close input file
TXNE S,SUPFIL ;Are we suppressing forms/file?
SETZM J$XTOP(J) ;Yes, set we are not at top of page.
TXZ S,SUPFIL+ERRFIL ;CLEAR LOTS OF BITS
$RET ;AND RETURN
;;;;;;;;;;;;;;;;;;;
;UNXCMD -- Send commands to remote server
;S1 holds command type
;Other params are taken from global vars. See corresp. routine.
;Dispatch table
UXCDTB: BDTB
DTE (UXC.0,CD.ACK) ;Get an acknowledge
DTE (UXC.1,CD.DAT) ;Data file being sent
DTE (UXC.2,CD.CTL) ;Control file being sent
DTE (UXC.3,CD.EOF) ;Send an EOF and wait for ACK
DTE (UXC.4,CD.CNL) ;Cancel this print job
DTE (UXC.5,CD.PRI) ;Open + Print job command to server
DTE (UXC.6,CD.RQU) ;Return queue status command
DTE (UXC.7,CD.RMV) ;Remove entry from remote queue
EDTB (UXCLEN)
UNXCMD: CAILE S1,0 ;Make sure command is legal
CAIL S1,UXCLEN
FATAL (Illegal UNIX Command Type)
JRST @UXCDTB(S1) ;Dispatch
;;;;
;Get an acknowledge
UXC.0: $CALL OUTBUF ;Dump the buffer
$CALL INCHR ;Get a character
JUMPF [ERROR (Connection Closed when ACK Expected)] ;EOF, no good
CAIN S1,0 ;OK?
$RETT ;Yes, tell caller
CAIN S1,1 ;Unix protocol error?
ERROR (UNIX Signaled Protocol Error) ;Yes
;Fall through on skip
;No to both means a Unix fatal error message. Get it.
MOVE P1,[POINT 7,J$XTMP(J)] ;Get a temporary buffer
MOVX P2,^D120 ;Not more than 120 chars
UXC.01: SOSL P2 ;Not too many chars
IDPB S1,P1
$CALL INCHR ;Get next char from UNIX
JUMPT UXC.02 ;EOF
;Fall through
UXC.02: SETZM S1 ;Put a NUL last in buffer
IDPB S1,P1
ERROR (UNIX Signaled Fatal Error: ^AJ$XTMP(J))
;No return
;;;;
;Send a data file header
UXC.1: MOVEI C,3 ;Command character
$CALL OUTCHR ;Put it in the buffer
;command string is <SIZE> <NAME>
TXT (0,OUTCHR,<^DJ$XCNT(J)^T ^AJ$ITNM(J)^J>)
JRST UXC.0 ;Go get an ACK
;;;;
;Send the control file header
UXC.2: MOVEI C,2 ;Command character
$CALL OUTCHR ;Put it in the buffer
;Send size and filename
LOAD T1,.EQSEQ(J),EQ.SEQ ;Get sequence number
TXT (0,OUTCHR,<^DJ$XCNT(J)^T cfA^DT1^AME^J>)
JRST UXC.0 ;Go get an ACK
;;;;
;Send an EOF and wait for ACK
UXC.3: SETZM C ;Send an EOF (NUL)
$CALL OUTCHR
JRST UXC.0 ;Go get an ACK
;;;;
;Cancel job transfer
UXC.4: MOVEI C,1 ;Send a CHR(1)
$CALL OUTCHR
$CALL OUTBUF
$RETT
;;;;
;Open connection and send start of print job
;Also set up name of foreign host in J$RHNM
UXC.5: $CALL TCPOPN ;Open connection
MOVE S1,J$OJFN(J) ;Get JFN of connection
GDSTS% ;Get some status
ERJMP [FATAL (JFN lost)]
MOVX S1,.GTHNS ;We want name of remote host
HRROI S2,J$RHNM(J) ;...into J$RHNM
GTHST%
ERJMP UXC.51
JRST UXC.52
UXC.51: HRROI S1,J$RHNM(J) ;WRITE REMOTE HOST ADDR HERE
PUSH P,T2 ;SAVE T2
PUSH P,T3 ;SAVE T3
PUSH P,T4 ;SAVE T4
MOVEI T4,4 ;4 BYTES TO PRINT
MOVE T2,T1
MOVX T1,FLD(^D10,NO%RDX)!NO%MAG ;UNSIGNED DECIMAL OUTPUT
HRROI S1,J$RHNM(J) ;INTO THIS LOCATION
MOVE T3,[POINT 8,T2,3] ;POINT AT OCTETS
UXC.50: ILDB S2,T3 ;GET ONE
NOUT% ;WRITE IT OUT
ERJMP .+1
MOVEI S2,"." ;SEPARATE WITH A DOT
IDPB S2,S1
SOJG T4,UXC.50 ;DO IT 4 TIMES
MOVE S2,S1 ;ACT LIKE GTHST
POP P,T4 ;RESTORE THESE ACS (DO THEY NEED TO BE SAVED?)
POP P,T3
POP P,T2
UXC.52: SETZM S1 ;Put a zero last in name
IDPB S1,S2
MOVEI C,2 ;Command character
$CALL OUTCHR ;Put it in the buffer
;Remote printer is J$RLPT
TXT (0,OUTCHR,^AJ$RLPT(J)^J)
LOGMSG (<Connection Opened to Server on ^AJ$RHNM(J)^T, Printer "^AJ$RLPT(J)^T", Type "^SJ$FTYP(J)^T">)
JRST UXC.0 ;Go get an ACK
;;;;
;Get remote print queue
;Status of current job is put in J$RRST
;Opens the connection and Closes it when finished
UXC.6: $SAVE <P1,P2> ;Save P accs
$CALL TCPOPN ;Open a connection
MOVEI C,3 ;Command character
$CALL OUTCHR ;Put it in the buffer
;Remote printer is J$RLPT
TXT (0,OUTCHR,^AJ$RLPT(J)^J)
$CALL OUTBUF ;Send it
;Extract the info we're interested in
;(Why can't they use a decent protocol instead of dumping text)
UXC.61: $CALL INCHR ;Skip until LF i.e. UNIX \n
JUMPF UXC.69 ;Quit if we found EOF
CAIE S1,.CHLFD
JRST UXC.61
UXC.62: $CALL UXC.6A ;Get the position in queue
MOVEM P1,J$RRST(J) ;Save it
UXC.63: $CALL INCHR ;Skip up to next space
JUMPF UXC.69 ;Quit if EOF
CAIE S1," "
JRST UXC.63
UXC.64: $CALL INCHR ;Skip up to next NON space
CAIN S1," "
JRST UXC.64
MOVE T1,[POINT 7,.EQOWN(J)] ;Point to our user name
UXC.65: ILDB T2,T1 ;Get a byte from string
JUMPE T2,UXC.66 ;End of string
CAME T2,S1 ;Same char?
JRST UXC.61 ;No, try next line
$CALL INCHR ;Get next char
JRST UXC.65
UXC.66: CAIE S1," " ;Was the last char a space?
JRST UXC.61 ;No, try next line
;The User name matched, now go for job number
$CALL UXC.6A ;Get the number
LOAD T1,.EQSEQ(J),EQ.SEQ
CAME P1,T1 ;Compare them
JRST UXC.61 ;Nope, continue with next line
;User name and job number matched!!!
;Position in queue is in J$RRST already
UXC.68: $CALL INCHR ;Skip rest of text
JUMPT UXC.68
PJRST TCPCLS ;close connection and return
;EOF and not found
UXC.69: SETOM J$RRST(J) ;Say so
PJRST TCPCLS ;close connection and return
;Subroutine to read a number by INCHR.
;Skips blanks and returns the number in P1
UXC.6A: SETZM P1 ;Reset accumulated number
UXC.6B: $CALL INCHR
JUMPF .RETF ;EOF: return that
CAIN S1," " ;Skip spaces
JRST UXC.6B
CAIL S1,"0" ;Check if digit
CAILE S1,"9"
$RETT ;No more digits
SUBI S1,"0" ;Convert ASCII to binary
IMULI P1,^D10 ;New digit
ADD P1,S1
JRST UXC.6B ;Get next
;;;;
;Remove entry from remote queue
;Opens the connection and closes it when done
;The job is also removed from the local queue.
UXC.7: $CALL TCPOPN ;Open
MOVEI C,5 ;Command character
$CALL OUTCHR ;Put it in the buffer
;Send the printer, user name and sequence number
LOAD T1,.EQSEQ(J),EQ.SEQ
TXT (0,OUTCHR,^AJ$RLPT(J)^T ^A.EQOWN(J)^T ^DT1^J)
$CALL OUTBUF ;Send it
;Skip data received
UXC.71: $CALL INCHR ;Get a char
JUMPT UXC.71 ;Loop until EOF
$CALL TCPCLS ;Close connection
$RETT ;and return
;;;;;;;;;;;;;;;;;;
;TCPOPN -- Open the TCP connection
;Get the JFN again first!! (oh no, DEC)
;Failures don't return
TCPOPN: MOVEI T1,^D10 ;Number of times to try reopening
TCPO.1: MOVX S1,GJ%SHT ;LOAD GTJFN FLAGS
HRROI S2,J$SSTG(J) ;POINT TO THE STRING
GTJFN% ;Get JFN of the device
ERJMP [FATAL (<GTJFN Failed Second Time on ^AJ$SSTG(J)^T, ^E>)]
MOVEM S1,J$OJFN(J) ;Save JFN
MOVX S2,<OF%WR!OF%RD!<FLD 8,OF%BSZ>!<FLD .TCMWIB9,OF%MOD>> ;Send 8 bit bytes in interactive mode
OPENF%
ERJMP TCPO.2
$RETT ;We made it
;Here on OPEN failure. Often because old connection was not yet gone.
TCPO.2: MOVE S1,J$OJFN(J) ;Get JFN
CLOSF% ;Close (just in case)
ERJMP .+1 ;Oh, well
MOVE S1,J$OJFN(J)
RLJFN% ;Free JFN! (In case it wasn't open)
ERJMP .+1
MOVX S1,^D5000 ;Sleep for 5 secs
DISMS%
SOJGE T1,TCPO.1 ;Try more?
ERROR (<Can't Open Connection ^AJ$SSTG(J)^T, ^E>) ;No, that's it
;No return
;;;;;;;;;;;;;;;;;;
;TCPCLS - close connection
;Errors don't return
TCPCLS: MOVE S1,J$OJFN(J) ;Get JFN
CLOSF% ;close and release JFN
ERJMP [ERROR (<Can't Close Connection ^AJ$SSTG(J)^T, ^E>)]
$RETT
;;;;;;;;;;;;;;;;;;;;
;INCHR -- Input a char from TCP, returned in S1
;Returns true normally, false if EOF i.e. broken connection
INCHR: MOVE S1,J$OJFN(J) ;Get JFN
BIN% ;Get a char
ERJMP INC.1
MOVE S1,S2 ;All OK: return the char
$RETT
INC.1: GTSTS% ;EOF i.e. broken connection?
ERJMP [FATAL (<JFN Lost, ^E>)]
TXNE S2,GS%EOF
$RETF ;Yes, tell caller
ERROR (<BIN failure, ^E>)
;No return
;;;;;;;;;;;;;;;;;;;;
;UNXCTL -- Put a sequence of control 'cards' in the control file buffer
;S1 contains function.
;Dispatch table
UXCTTB: BDTB
DTE (UXT.0,CT.INI) ;Init things
DTE (UXT.1,CT.DAT) ;Print a data file, copies in S2
DTE (UXT.2,CT.BAN) ;Print a banner/trailer file
EDTB (UXTLEN)
UNXCTL: CAILE S1,0 ;Make sure command is legal
CAIL S1,UXTLEN
FATAL (Illegal Control File Card)
JRST @UXCTTB(S1) ;Dispatch
;;;;;;;;;
;Init control file buffer and insert some default cards
UXT.0: MOVEI T1,CTBFSZ ;GET CHARACTERS PER BUFFER
MOVEM T1,J$TBCT(J) ;SAVE AS BUFFER BYTE COUNT
MOVX T1,J$TBFR(J) ;GET THE BUFFER ADDRESS
ADD T1,[POINT 7,0] ;Make it a byte pointer
MOVEM T1,J$TBPT(J) ;SAVE AS BUFFER BYTE POINTER
TXT (0,CTLCHR,^TH^AME^J) ;Local host name
TXT (0,CTLCHR,^TP^A.EQOWN(J)^J) ;and local user name
$CALL DFUNIQ ;Create first unique file name
$RETT
;;;;;;;;;
;Insert 'print data file' cards. S2 determines no of copies
;Insert one 'print' card for each copy
;J$FTYP indicates type of file. Use "f" normally, "v" for .GSI
UXT.1: PUSH P,S2 ;Save S2 for a while
CALL CHKDVI ;See if it looks like a DVI file
SKIPT
IFSKP.
MOVEI T1,"d" ;DVI file
ELSE.
MOVEI T1,"f" ;normal file
ENDIF.
TXT (0,CTLCHR,^7(T1)^AJ$ITNM(J)^J)
POP P,S2
SOJG S2,UXT.1
;fall through
;Tell UNIX what WE call this file
TXT (0,CTLCHR,^TN^AJ$INAM(J)^T.^AJ$IEXT(J)^J) ;Make the card
JRST UXT.21 ;Finish up
;;;;;;;;;
;Insert 'print banner/trailer' cards
;These are always only one copy and print type 'f'
;Also we don't tell UNIX their name.
UXT.2: TXT (0,CTLCHR,^Tf^AJ$ITNM(J)^J) ;Only ONE copy
;;;;;
;Finally a 'delete file after printing' card
UXT.21: TXT (0,CTLCHR,^TU^AJ$ITNM(J)^J)
;Update transfer count
AOS J$CNFT(J) ;One more file transferred
$CALL DFUNIQ ;Set new unique file name
$RETT
;;;;;;;;;;;;;;;;;;;;;
;CTLCHR -- Puts the char in C in the control file buffer
CTLCHR: SOSGE J$TBCT(J) ;DECREMENT THE BYTE COUT
JRST [OPRMSG (Aborted - UNIX Control File too Big)
MOVX S1,SIG.DN ;Tell superior we're done
$CALL SIGNAL]
;No return
IDPB C,J$TBPT(J) ;DEPOSIT A BYTE
$RETT
;;;;;;;;;;;;;;;;;;;;;
;DFUNIQ -- Generates a unique data file name as expected by UNIX.
;Put as ASCIZ in J$ITNM.
;The name is modified by the J$CNFT var.
DFUNIQ: MOVE T1,J$CNFT(J) ;Get unique file no
ADDI T1,"A"
CAILE T1,"Z"
ADDI T1,"a"-"Z"+1
CAILE T1,"z"
FATAL (Too Many Files in Transfer)
LOAD T2,.EQSEQ(J),EQ.SEQ
TXT (1,J$ITNM(J),<^Tdf^7(T1)^DT2^AME^0>)
$RETT
SUBTTL CHKDVI -- Check if file is a valid DVI file
; RETURN FALSE ($RETF) IF NOT VALID DVI POSTAMBLE
; RETURN TRUE ($RETT) IF VALID DVI POSTAMBLE
; DVI FILE SHOULD END WITH:
; <POSTAMBLE ADDR> n 223 ... 223 <eof>
; WHERE N <= MAXDVR
; TECHNIQUE FROM <CANON.MAKIMP>DVIINP.SAI
CHKDVI: STKVAR <DVIJFN,NBYTES>
MOVX S1,GJ%SHT!GJ%OLD
HRRO S2,J$IFNM
GTJFN%
ERJMP CKPERR
MOVEM S1,DVIJFN
MOVX S2,FLD(^D8,OF%BSZ)!OF%RD ;DVI FILES IN 8BIT (ALWAYS?)
OPENF% ;OPEN THE SUCKER
ERJMP CKPERR
SETOM S2 ;GO TO EOF
SFPTR%
ERJMP CKPERR
RFPTR% ;READ THAT POSITION
ERJMP CKPERR
SUBI S2,PSTBFL*4 ;BACK UP LENGTH OF OUR BUFFER
SFPTR% ;GO TO THAT POINT IN FILE
ERJMP CKPERR
MOVE S2,[POINT 8,J$PSTB(J)] ;POINT AT OUR BUFFER
MOVNI T1,PSTBFL*4 ;READ AT MOST A BUFFER-FULL
SIN% ;READ THOSE CHARACTERS
IFJER.
MOVE T1,S2 ;SAVE S2
GTSTS%
TXNN S2,GS%EOF ;EOF? DON'T WORRY
JRST CKPERR ;SOMETHING ELSE, WORRY ABOUT IT
MOVE S2,T1 ;RESTORE S2
ENDIF.
MOVE S1,DVIJFN
CLOSF% ;NOW WE CAN FLUSH FILE
NOP
SETZM DVIJFN ;ZERO OUT JFN, JUST IN CASE
MOVE T1,S2 ;GET UPDATED BYTE POINTER TO T1
LDB S2,T1 ;GET LAST BYTE WE READ
CAIE S2,DMGNUM ;OUR MAGIC NUMBER
$RETF ;MUST NOT BE A DVI FILE, PUNT
DO.
LDB S2,T1
CAIE S2,DMGNUM ;DMGNUM==^D223
EXIT.
SETOM T2
ADJBP T2,T1 ;BUMP BYTEPOINTER BACK BY ONE
MOVE T1,T2
HRRZS T2 ;GET LOC POINTED AT BY BP
CAIGE T2,J$PSTB(J) ;BEFORE BEGINNING OF OUR BUFFER?
$RETF ;YES, FAIL RETURN (MAYBE DO SOMETHING ELSE?)
LOOP.
ENDDO.
CAILE S2,MAXDVR ;BIGGER THAN MAX DVI VERSION?
$RETF
$RETT
;CKPERR - CKDPST ERRORS COME HERE
CKPERR: SKIPN S1,DVIJFN ;HAD A JFN ON FILE?
IFSKP.
CLOSF% ;TRY TO CLOSE IT
IFJER. ;IF FAILED, TRY TO FLUSH IT
MOVE S1,DVIJFN
RLJFN%
NOP ;DON'T WORRY TOO MUCH
ENDIF.
ENDIF.
$RETF ;PROPAGATE FAILURE RETURN
SUBTTL NXTFIL -- Find and return the next file in the nextjob msg
;E points to current file descriptor
NXTFIL: SOSG J$RFLN(J) ;Decr. number of files in request
$RETF
LOAD T1,.FPLEN(E),FP.LEN ;GET THE FP LENGTH
ADD E,T1 ;BUMP TO THE FD
LOAD T1,.FDLEN(E),FD.LEN ;GET THE FD LENGTH
ADD E,T1 ;BUMP TO THE NEXT FP
LOAD T1,.FPINF(E),FP.FLG ;GET LOG FILE FLAG
JUMPE T1,.RETT ;RETURN IF NOT THE LOG FILE
MOVEM E,J$RLFS(J) ;SAVE ADDRESS OF LOG FILE SPEC
JRST NXTFIL ;AND LOOP
SUBTTL Routines to handle the input files
;;;;;;;;;;;;;;;;;;;;;;;;
;INPOPN -- Routine to open the input file
;Called with E pointing to the file parameter (FP) area for the file
;to be opened.
;J$IFNM is set to point to the file name string.
INPOPN: SETZM J$IJFN(J) ;No file opened yet
LOAD S2,.FPLEN(E),FP.LEN ;Get the FP length
ADD S2,E ;Compute the FD address
ADDI S2,.FDSTG ;Point to file name string
HRRZM S2,J$IFNM(J) ;Save the address
HRRO S2,S2 ;Make it a generic byte pointer
MOVX S1,<GJ%SHT!GJ%OLD> ;GTJFN flags: file must exist
GTJFN%
ERJMP INPO.9
MOVEM S1,J$IJFN(J) ;Success, save the JFN
;Do some access checking
;Also set bit to indicate if file should be deleted after processing.
LOAD S1,.EQSEQ(J),EQ.PRV ;Get the users priv's
JUMPN S1,INPO.4 ;Set, he can do everything
LOAD S1,.FPINF(E),FP.SPL ;Is the file spooled?
JUMPE S1,INPO.2 ;No, do normal access check
;File is always to be deleted (since it is spooled)
MOVE S1,.FPINF(E) ;Get the file info bits
TXO S1,FP.DEL ;Set the delete bit
MOVEM S1,.FPINF(E)
JRST INPO.4 ;Go open it
;Check if user has read access rights to this file
INPO.2: HRROI S1,.EQOWN(J) ;Point to owner's name
MOVEM S1,.CKALD+J$XTMP(J) ;Put it into arg block
HRROI S1,.EQCON(J) ;Point to connected directory
MOVEM S1,.CKACD+J$XTMP(J) ;and store it
SETZM .CKAEC+J$XTMP(J) ;Indicate no priv's (already checked)
MOVE S1,J$IJFN(J) ;JFN
MOVEM S1,.CKAUD+J$XTMP(J)
MOVX S1,.CKARD ;Only interested in read access
MOVEM S1,.CKAAC+J$XTMP(J)
MOVX S1,<CK%JFN!5> ;We pass JFN and 5 words of args
MOVEI S2,J$XTMP(J) ;Arg. block
CHKAC%
ERJMP INPO.9 ;Fail, deny access
JUMPE S1,INPO.9 ;Sorry
;Now check if he's allowed to delete this file
MOVX S1,.CKAWR ;Write access this time
MOVEM S1,.CKAAC+J$XTMP(J)
MOVX S1,<CK%JFN!5> ;JFN and 5 words of arg
CHKAC%
ERJMP .+2 ;Deny delete on failure
JUMPE S1,INPO.4 ;Delete according to bit
MOVE S1,.FPINF(E) ;Refuse to delete this file
TXZ S1,FP.DEL ;Reset the delete bit
MOVEM S1,.FPINF(E)
;Done with access checking. Set up for file opening.
;Get correct byte size into S2
INPO.4: MOVEI S2,7 ;Load probable (7 bit) byte size
MOVE S1,J$FTYP(J) ;See if special mode
CAXN S1,<SIXBIT /SCRZAP/> ;Scribe?
JRST INPO.5 ;Yes
MOVEI S2,^D8 ;Assume 8 bit bytes
CAXN S1,<SIXBIT /8BIT/> ;Do we want it?
JRST INPO.5 ;Yes
$CALL CHKSIZ ;Get FDB byte size into S2
JUMPF INPO.A ;Some failure
IFN STANSW,<
CAIN S2,^D36 ;36 bits?
MOVEI S2,^D7 ;Yes, probably mean 7 bits
>;IFN STANSW
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 S2,^D8 ;YES,,LOAD 8 BIT BYTE SIZE
CAXN T1,.FPF11 ;WAS IT /FILE:ELEVEN?
MOVEI S2,^D36 ;YES,,LOAD 36 BIT BYTE SIZE
CAIE T1,.FPFCO ;/FILE:COBOL?
CAIN T2,%FPLOC ;OR /PRINT:OCTAL?
MOVEI S2,^D36 ;YES, USE FULL WORDS
;Byte size in S2, see how many will fit in buffer
INPO.5: MOVX T1,^D36 ;Bits per word
IDIV T1,S2 ;Get number of bytes per word to T1
IMULI T1,IPBFSZ/<36/7> ;Multiply by # of words in buffer
MOVEM T1,J$IICT(J) ;Save count
MOVE T1,S2 ;Get bits per byte again
LSH T1,^D24 ;Build a byte pointer to start of buff.
IORX T1,<^D36>B5 ;Initial position
IORI T1,J$IBFR(J) ;address
MOVEM T1,J$IIBP(J) ;and save it
LSH S2,^D30 ;Get size into position
IORX S2,OF%RD ;Only read access
MOVE S1,J$IJFN(J)
OPENF%
ERJMP INPO.9
SETZM J$IBCT(J) ;Indicate input buffer is empty
$CALL GETNAM ;Get a recognizable file name
$RETT
INPO.9: LOGMSG (<Can't Access File ^A@J$IFNM(J)^T, ^E>)
ZERO .FPINF(E),FP.DEL ;CLEAR THE 'DELETE FILE' BIT
SETZM J$IJFN(J) ;and the JFN to indicate no file
$RETF ;AND RETURN
INPO.A: LOGMSG (<Failure finding byte size for File ^A@J$IFNM(J)^T, ^E>)
ZERO .FPINF(E),FP.DEL ;CLEAR THE 'DELETE FILE' BIT
SETZM J$IJFN(J) ;and the JFN to indicate no file
$RETF ;AND RETURN
; CHKSIZ - LOOK AT FILE TO FIND ITS REAL BYTE SIZE
; RETURNS S2/ BYTE-SIZE
; RETURNS FALSE IF BAD PAGE OR BYTE ACCOUNT
CHKSIZ: STKVAR <SIZJFN>
MOVX S1,GJ%SHT+GJ%OLD
HRRO S2,J$IFNM(J) ;FILENAME
GTJFN%
ERJMP .RETF
MOVEM S1,SIZJFN ;SAVE JFN
SIZEF% ;GET BYTE SIZE
ERJMP CHKSZY ;SOME ERROR
JUMPLE S2,CHKSZY ;PUNT IF BAD BYTE COUNT
JUMPLE T1,CHKSZY ;PUNT IF BAD PAGE COUNT
MOVE S1,SIZJFN
MOVE S2,[1,,.FBBYV] ;READ BYTE SIZE FROM FDB
MOVEI T1,T1 ;PUT IT IN T1 (NOTE THIS IS AC3, *NOT* AC1)
GTFDB%
ERJMP CHKSZY ;SOMETHING WENT WRONG
MOVE S1,SIZJFN
RLJFN% ;NOW FLUSH THE JFN
ERJMP .RETF
LOAD S2,T1,FB%BSZ ;GET BYTE SIZE INTO S2
$RETT
CHKSZY: MOVE T1,SIZJFN ;GET BACK THE FILE JFN
RLJFN% ;RELEASE IT
ERJMP .RETF ;SOME ERROR
$RETF ;TAKE FAILURE RETURN
;;;;;;;;;;;;;;;;;;;
;INPBYT -- Read a byte from the input buffer. Fills the
;buffer if necessary.
;Returns the character in C. Returns False on EOF.
INPBYT: $CALL CHKABT ;Are we canceled?
JUMPT .RETF ;Yes, signal EOF
SKIPLE J$IBCT(J) ;Any chars in buffer?
JRST INPB.2 ;Yes
INPB.1: $CALL INPBUF ;No, get a bufferful
JUMPF .RETF ;Return false if EOF
INPB.2: ILDB C,J$IBPT(J) ;Get the byte
SOS J$IBCT(J) ;and decrement count
$RETT
;;;;;;;;;;;;;;;;;;;
;INPBUF - Inputs a bufferful
;Returns false if attempt to read past EOF
INPBUF: MOVE S1,J$IJFN(J) ;JFN
MOVE S2,J$IIBP(J) ;Byte pointer to start of buffer
MOVEM S2,J$IBPT(J) ;Save as current pos too
MOVN T1,J$IICT(J) ;Max count
SIN%
ERJMP INPU.2 ;EOF or error?
INPU.1: ADD T1,J$IICT(J) ;Get total number read
MOVEM T1,J$IBCT(J) ;and save as current count
SKIPE T1 ;If 0 we have EOF
$RETT
$RETF
;Handle 'errors'
INPU.2: GTSTS% ;Get status
TXNE S2,GS%EOF ;Check if EOF
JRST INPU.1 ;Yupp, return
LOGMSG (<Error Reading Input File, ^E>)
TXO S,ERRFIL ;Skip the rest of the file
$RETF
;;;;;;;
;INPCLS -- Close the input file
INPCLS: MOVE S1,J$IJFN(J)
CLOSF%
ERJMP .+1 ;Forget errors
SETZM J$IJFN(J) ;Indicate file is closed
$RETT
;;;;;;;
;INPREW -- Rewind the input file
; I.e. position the file pointer at the beginning of the file
INPREW: SKIPN S1,J$IJFN(J)
$RETF ;Don't do it if file not open
SETZM S2
SFPTR%
ERJMP [FATAL (<Could not Rewind File, ^E>)]
SETZM J$IBCT(J) ;Indicate buffer empty
$RETT
;;;;;;;;;;;;;;;;;;;;;
;GETNAM -- Figures out a 'real' name for the just opened file
;E should point to the FP block and J$IFNM to the 'real' file name
;The name is put in J$INAM and extension + version in J$IEXT
GETNAM: SKIPN .FPFR1(E) ;IS THERE A /REPORT KEY?
JRST GETN.1 ;NO, CONTINUE ON
TXT (1,J$INAM(J),^TReport:^0) ;FIRST LINE
TXT (1,J$IEXT(J),^S.FPFR1(E)^S.FPFR2(E)^0)
$RETT
GETN.1: LOAD S1,.FPINF(E) ;GET FLAGS FOR FILE
TXNN S1,FP.SPL ;IS IT A SPOOLED FILE?
JRST GETN.2 ;NO, CONTINUE ON
TXNN S1,FP.FLG ;YES, IS IT ALSO THE LOG FILE?
JRST GETN.2 ;NO, JUST A PLAIN SPOOLED FILE
TXT (1,J$INAM(J),^TBatch^0) ;SPOOLED LOGS HAVE NO REASONABLE NAME
TXT (1,J$IEXT(J),^TLog File^0) ;SO USE SOMETHING DESCRIPTIVE
$RETT
;Get the open file's name
GETN.2: MOVE S2,J$IJFN(J) ;Get JFN
HRROI S1,J$INAM(J) ;Filename first
MOVX T1,<FLD .JSAOF,JS%NAM>
JFNS%
HRROI S1,J$IEXT(J) ;Now extension
MOVX T1,<FLD .JSAOF,JS%TYP>
JFNS%
MOVX T2,"." ;Insert a period
IDPB T2,S1
MOVX T1,<FLD .JSAOF,JS%GEN> ;and generation
JFNS%
LOAD S1,.FPINF(E),FP.SPL ;GET THE SPOOL BIT
JUMPE S1,.RETT ;Not spooled: we're done
;Strip off prefix from spooled files
MOVE T1,[POINT 7,J$INAM(J)] ;RESTORE THE FILENAME BYTE PTR.
MOVEI T2,3 ;HOW MANY DASHES TO LOOK FOR
MOVE T3,T1 ;AND AN INPUT POINTER
GETN.3: ILDB S1,T3 ;GET A CHARACTER
JUMPE S1,GETN.S ;NO, SPOOLED NAME IF NULL
CAIE S1,"-" ;A DASH?
JRST GETN.3 ;NO, LOOP
SOJG T2,GETN.3 ;YES, LOOP UNTIL 4TH FIELD
GETN.5: ILDB S1,T3 ;GET A CHARACTER
IDPB S1,T1 ;DEPOSIT IT
JUMPN S1,GETN.5 ;AND LOOP UNTIL A NULL
MOVEI T2,6 ;LOAD A COUNTER
IDPB S1,T1 ;AND DEPOSIT MORE NULLS
SOJG T2,.-1 ;FOR WIDTH CALCULATION
MOVE T1,J$INAM(J) ;GET THE FIRST WORD
TLNE T1,774000 ;IS THERE AT LEAST ONE CHARACTER?
$RETT ;Yes
;Fall through ;No, no name: make up one
;GETN.S is used to setup a non-descript name if we can't do any better
GETN.S: TXT (1,J$INAM(J),^TSpooled^0)
TXT (1,J$IEXT(J),^TPrinter File^0)
$RETT
SUBTTL FORMS change routines
;FORMS -- Setup Forms for a job
FORMS: GETLIM S1,.EQLIM(J),FORM ;GET THE FORMS TYPE
CAMN S1,J$FORM(J) ;ARE FORMS EXACTLY THE SAME?
$RETT ;YES,,return immediately
MOVE S2,J$FORM(J) ;Get current forms type
MOVEM S1,J$FORM(J) ;Save new form
XOR S1,S2 ;GET COMMON PART
AND S1,[EXP FRMSK1] ;AND IT WITH THE IMPORTANT PART
SKIPN S1
JRST FORM.1 ;No need to change forms
OPRMSG (Forms Changed to ^SJ$FORM(J)) ;Tell OPR
;Intialize with default params
FORM.1: HRLZI S1,-F$NSW ;GET NEGATIVE SWITCH TABLE LEN
MOVEI T1,J$FCUR(J) ;POINT TO CURR 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
SETZM J$RLPT(J) ;No name on remote printer yet
$CALL FRMINI ;READ THE LPFORM.TXT FILE.
JUMPT .+2 ;Skip the message if ok
OPRMSG (<Forms not Found in LPFORM.TXT, Defaults Being Used>)
MOVE S1,J$SPTL(J) ;Get protocol
CAIN S1,PTLTTY ;Local?
JRST FORM.4 ;Yes
SKIPN J$RLPT(J) ;Any name on remote printer?
FATAL (<LPFORM.TXT Error, No Name on Remote Printer Specified>)
;Set up the width and length classes
FORM.4: 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
$RETT
SUBTTL Search for form in LPFORM.TXT
FRMINI: MOVX S1,<GJ%OLD!GJ%SHT> ;Short form, file must exist
HRROI S2,FRMFIL ;Point to name string
GTJFN%
ERJMP .RETF ;Fail
MOVEM S1,J$FJFN(J) ;Save JFN
MOVX S2,<<FLD 7,OF%BSZ>!OF%RD!OF%THW> ;Flags for opening
OPENF%
ERJMP [MOVE S1,J$FJFN(J) ;Fail, clean up
CLOSF%
ERJMP .+1
JRST .RETF]
TXZ S,FRMFND ;Clear the forms found flag
$CALL FRMIN1 ;Parse the file
MOVE S1,J$FJFN(J) ;and close it
CLOSF%
ERJMP .+1 ;Ignore errors
TXNE S,FRMFND ;Did we find it?
$RETT ;Yes
$RETF ;Nope
;Routines to parse the open file
FRMIN1: $CALL FH$SIX ;GET THE FORMS NAME
JUMPT FRMI1B ;Found something (No EOF)
$RET ;Nope, return
FRMI1B: GETLIM T2,.EQLIM(J),FORM ;GET FORMS
CAMN T1,T2 ;MATCH??
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
FRMI3A: CAIN C,"/" ;A SWITCH?
JRST FRMIN5 ;YES!
CAIE C,"(" ;A LIST?
JRST FRMIN9 ;NO, ERROR
FRMIN4: HLRZ T2,T1 ;GET THE FIRST THREE CHARS
CAIN T2,'ALL' ;IS IT "ALL"?
JRST FRMIN5 ;YES, STOP CHECKING
MOVE S1,J$SPTL(J) ;Are we printing to remote?
CAIE S1,PTLTTY
JRST FRMI4A ;Yes, not 'Normal' protocol
CAIN T2,'LOC'
JRST FRMIN5 ;Local and LOC qualifier
JRST FRMI4B ;Local but not LOC qualifer, try dev.
FRMI4A: CAIN T2,'REM' ;DOES IT SAY "REMOTE"?
JRST FRMIN5 ;YES!!
FRMI4B: CAMN T1,J$LDEV(J) ;COMPARE TO OUR DEVNAM
JRST FRMIN5 ;MATCH!!
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
;GET HERE IF 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
OPRMSG (<LPFORM.TXT Error, Unrecognized Switch>)
JRST FRMIN5 ;AND LOOP
FRMIN8: HRRZ T3,FFNAMS(T2) ;GET DISPATCH ADDRESS
$CALL (T3) ;GO!!
JRST FRMIN5 ;AND LOOP
FRMIN9: OPRMSG (Bad Format in LPFORM.TXT)
$RET
SUBTTL Forms Switch Subroutines
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
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
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
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
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
S$FF: MOVE T1,D$FF ;Get default
CAIN C,":" ;Any argument?
$CALL FH$DEC ;Yes, get it
MOVEM T1,J$FFF(J) ;Save it
$RET
S$TABS: MOVE T1,D$TABS ; Get the default setting
CAIN C,":" ; Did he put a real arguement
$CALL FH$DEC ; Yes, GET DECIMAL ARGUMENT
MOVEM T1,J$FTAB(J) ;SAVE IT
$RET
S$TYPE: MOVE T1,D$TYPE ; Get the default setting
CAIN C,":" ; Did he put a real arguement
$CALL FH$SIX ; Yes, get a SIXBIT keyword
JUMPF .RETF ;Return if EOF
MOVEM T1,J$FTYP(J) ;Save it
$RET
S$NAME: MOVE T1,[POINT 7,J$RLPT(J)]
SETZM T2 ;CLEAR THE COUNTER
S$NAM1: $CALL FH$CHR ;GET A CHARACTER
JUMPF S$NAM2 ;EOF, FINISH UP!!
CAIG C,40 ;MAKE SURE ITS GREATER THAN SPACE
JRST S$NAM2 ;ITS NOT!, FINISH UP
CAIN C,"/" ;ALSO STOP ON SLASH
JRST S$NAM2 ;IT IS!!
IDPB C,T1 ;DEPOSIT IT
CAIGE T2,^D19 ;LOOP FOR 20 CHARACTERS
AOJA T2,S$NAM1 ;INCR AND LOOP
S$NAM2: SETZM S1 ;GET A NULL BYTE
IDPB S1,T1 ;MAKE THE STRING ASCIZ
$RETT
SUBTTL I/O Subroutines for LPFORM.TXT
;ROUTINE TO RETURN A SIXBIT WORD IN T1
;RETURNS WITH WORD IN T1. False return 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" ;LC char?
SUBI C,^O40 ;Make it UC
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 ;NO REASONALBE
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
;ROUTINE TO RETURN 1 CHARACTER IN ACCUMULATOR C
FH$CHR: MOVE S1,J$FJFN(J) ;Get JFN for LPFORM.TXT
BIN%
ERJMP .RETF ;Quit on error or EOF
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
$RETT
;ROUTINE TO SEARCH FOR EOL IN LPFORM.TXT
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!
;Routine to pick up a decimal number, a minus sign is accepted.
;Returned in T1
FH$DEC: CLEAR T1, ;PLACE TO ACCUMULATE RESULT
TXZ S,MINUS ;Not negative
$CALL FH$CHR ;Get a char
JUMPF FH$DE9 ;Return if EOF
CAIE C,"-" ;Minus sign?
JRST FH$DE2 ;No
TXO S,MINUS ;Yes, indicate that
FH$DE1: $CALL FH$CHR ;GET A CHARACTER
JUMPF FH$DE9 ;EOF, RETURN
FH$DE2: CAIL C,"0" ;CHECK THE RANGE
CAILE C,"9" ;0-9
JRST FH$DE9 ;RETURN
IMULI T1,12 ;SHIFT A PLACE
ADDI T1,-"0"(C) ;ADD IN A DIGIT
JRST FH$DE1 ;AND LOOP AROUND
FH$DE9: TXNE S,MINUS ;Did we have a minus sign?
MOVN T1,T1 ;Yes, negate
$RETT
SUBTTL Routines for the logging
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;LOGCHR - Puts the char in C in the log buffer
;No return if buffer overflows.
LOGCHR: SOSGE J$LBCT(J) ;DECREMENT THE BYTE COUT
JRST [OPRMSG (Aborted - Log File too Big)
MOVX S1,SIG.DN ;Tell superior we're done
$CALL SIGNAL]
;No return
IDPB C,J$LBPT(J) ;DEPOSIT A BYTE
$RETT
SUBTTL Routines to handle output
;;;;;;;
;OUTCHR puts the char in reg C in the outbuffer and dumps it if necessary
;It also keeps track of the horizontal position for simulated TABs and
;skips the output if we're skipping pages.
OUTCHR: TXNN S,FILXFR ;Transfering a file?
JRST OUTC.0 ;No
SKIPLE J$IIPG(J) ;Yes, Any pages to skip?
$RETT ;Yes, don't output anything
OUTC.0: CAIL C,40 ;Is it a printable char?
AOSA J$XHPS(J) ;Yes, increment horz counter
SETZM J$XHPS(J) ;No (probably CR or FF), zero counter
SETZM J$XTOP(J) ;CLEAR THE TOP-OF-FORM FLAG
CAIN C,.CHFFD ;IS IT A FORMFEED?
SETOM J$XTOP(J) ;YES, SET IT
OUTC.1: SOSGE J$OBCT(J) ;DECREMENT THE BYTE COUT
JRST OUTC.2 ;LOSE, GO DUMP THE BUFFER
IDPB C,J$OBPT(J) ;DEPOSIT A BYTE
$RETT ;AND RETURN
OUTC.2: $CALL OUTBUF ;DUMP THE BUFFER
JRST OUTC.1 ;AND TRY AGAIN
;;;;;;;;;;;;;;;;;;;;;;
;OUTBUF -- Routine to output a buffer
;Also checks if it's time for a checkpoint.
OUTBUF: $CALL .SAVET ;SAVE THE 'T' ACS
MOVX S1,SIG.CC ;Check if we need a timed CKP
$CALL SIGNAL
SKIPGE T1,J$OBCT(J) ;GET BYTES REMAINING IN BUFFER
SETZM T1 ;IF LESS,,MAKE IT ZERO
SUBI T1,OPBFSZ ;Chars in buffer negated
SKIPN T1 ;Is the buffer empty?
$RETT ;Yes, forget this
MOVN T2,T1 ;Incr char count
ADDM T2,J$XCNT(J)
TXNE S,CHRCNT ;Dummy output?
JRST OUTRES ;Yes
MOVE S1,J$OJFN(J) ;JFN
MOVEI S2,J$OBFR(J) ;Get address of buffer
ADD S2,J$OBTZ(J) ;and make it a byte pointer
SOUTR% ;Output it
ERJMP [ERROR (<SOUTR Failed, ^E>)]
;Fall through
; Routine to reset the buffer
OUTRES: MOVEI S1,OPBFSZ ;GET CHARACTERS PER BUFFER
MOVEM S1,J$OBCT(J) ;SAVE AS BUFFER BYTE COUNT
MOVEI S1,J$OBFR(J) ;GET THE BUFFER ADDRESS
ADD S1,J$OBTZ(J) ;ADD THE BYTE PTR (LEFT HALF)
MOVEM S1,J$OBPT(J) ;SAVE AS BUFFER BYTE POINTER
$RETT ;AND RETURN
SUBTTL LPT CONTROL ROUTINES
PRINTX [Processing LPT code]
;The following routines handle the device independant character
;translation and formatting of the output.
;All routines hereafter only use OUTCHR and OUTBUF to output stuff
;and the input file routines to input stuff.
;CONTROL CHARACTER TABLE
NCLRFF==1B0 ;DON'T CLEAR FORMFEED FLAG
SUPRCH==1B1 ;SUPPRESSABLE CHARACTER
EOLCHR==1B2 ;CHARACTER IS AN EOL (IN REPORT FILES)
CHTAB: EXP <NCLRFF+.POPJ> ;(00) NULL
EXP CHKARO ;(01) CONTROL-A
EXP CHKARO ;(02) CONTROL-B
EXP CHKARO ;(03) CONTROL-C
EXP CHKARO ;(04) CONTROL-D
EXP CHKARO ;(05) CONTROL-E
EXP CHKARO ;(06) CONTROL-F
EXP CHKARO ;(07) CONTROL-G
EXP CHKARO ;(10) CONTROL-H
EXP NCLRFF+DOTAB ;(11) THIS IS A TAB
EXP SUPRCH+EOLCHR+DOLF ;(12) THIS IS A LINE FEED
EXP CHKARO ;(13) Vert Tab
EXP SUPRCH+NCLRFF+EOLCHR+DOFORM ;(14) THIS IS A FORM-FEED
EXP NCLRFF+EOLCHR+OUTCHR ;(15) CARRIAGE RETURN
EXP CHKARO ;(16) CONTROL-N
EXP CHKARO ;(17) CONTROL-O
EXP CHKARO ;(20)
EXP CHKARO ;(21) DC1
EXP CHKARO ;(22) DC2
EXP SUPRCH+EOLCHR+DODC3 ;(23) DC3 SKIPS 1 LINE
EXP CHKARO ;(24) DC4
EXP CHKARO ;(25) CONTROL-U
EXP CHKARO ;(26) CONTROL-OL-V
EXP CHKARO ;(27) CONTROL-W
EXP CHKARO ;(30) CONTROL-X
EXP CHKARO ;(31) CONTROL-Y
EXP CHKARO ;(32) CONTROL-Z
EXP CHKARO ;(33) ESCAPE
EXP CHKARO ;(34) CONTROL-\
EXP CHKARO ;(35) CONTROL-]
EXP CHKARO ;(36) CONTROL-^
EXP CHKARO ;(37) CONTROL-
;FORTRAN CONTROL CHARACTOR TRANSLATION TABLE
DEFINE FORCHR(CHR,TRANS,N),<
EXP <CHR>B17+<N>B26+TRANS
> ;END DEFINE FORCHR
FORTAB: FORCHR " ",.CHLFD,1
FORCHR "0",.CHLFD,2
FORCHR "1",.CHFFD,1
FORCHR "2",20,1
FORCHR "3",13,1
FORCHR "/",24,1
FORCHR "*",23,1
FORCHR "+",.CHCRT,1
FORCHR 54,21,1
FORCHR "-",.CHLFD,3
FORCHR ".",22,1
NFORCH==.-FORTAB
SUBTTL Device independent routine to output a file
;Call with E pointing to the FP block for the open file
; J pointing to the Stream data area
FILOUT: $CALL HEAD ;PRINT THE HEADER and a FF
TXO S,FILXFR ;Say we're transferring a file
$CALL INPREW ;REWIND THE INPUT FILE
MOVE T1,J$FLIN(J) ;START AT TOP OF PAGE
MOVEM T1,J$XVPS(J) ;SAVE IT
$CALL SETLST ;Setup report code (if needed)
$CALL SETPFT ;Setup file type
$CALL (T1) ;DISPATCH
$CALL OUTBUF ;Empty buffer
TXZ S,FILXFR ;Finished with the file
SKIPE J$XTOP(J) ;Are we at TOF?
$RET ;Yes, just return
TXNN S,CHRCNT ;If dummy output, don't charge
AOS J$ANPT(J) ;No, charge him for rest of page
$RET
;SETLST -- Subroutine to compile code to test each line for a match against
; the /REPORT value.
SETLST: SETZM J$XCOD(J) ;CLEAR EXISTING REPORT CODE
MOVEI T2,J$XCOD-1(J) ;SET UP PDP TO COMPILED CODE
SKIPN .FPFR1(E) ;WAS /REPORT SPECIFIED?
$RETT ;NO, JUST RETURN
STLST1: MOVE T3,[POINT 6,.FPFR1(E)] ;POINTER TO LIST
MOVEI T4,^D12 ;ABSOLUTE LIMIT
STLST2: ILDB T1,T3 ;GET A CHAR
JUMPE T1,STLSC ;JUMP IF DONE
ADDI T1,"A"-'A' ;CONVERT TO ASCII
CAIN T4,^D12 ;1ST TIME THRU, WE'VE GOT A CHARACTER
JRST STLST4 ;YES--CHAR ALRADY IN C
PUSH T2,SETLSA ;COMPILE A PUSHJ
PUSH T2,SETLSB ;WE HAVE AN ERROR RETURN THEN
STLST4: HLL T1,SETLSC ;PLACE CHAR IN CAIE
PUSH T2,T1 ;COMPILE THE CAIE
PUSH T2,SETLSD ;COMPILE THE JRST TO FLUSH7
SOJG T4,STLST2 ;LOOP FOR WHOLE STRING
STLSC: PUSH T2,[POPJ P,] ;AND PROCESS THE CHARACTER
$RET
;THE INSTRUCTIONS WHICH ARE GENERATED:
SETLSA: $CALL INPBYT
SETLSB: JUMPF .RETT
SETLSC: CAIE C,0
SETLSD: JRST FLUSH7
SUBTTL SETPFT -- Setup file processing type
;Called to determine which type of processing should be done on the
;input file.
;
;Returns with T1 containing address of processing routine as follows:
;
; LPTRAW, 7 bit bytes <--> /TYPE:SCRZAP
; LPTRAW, 8 bit bytes <--> /TYPE:8BIT or /FILE:ASCII8
; LPTRAW, 7 or 8 bit bytes <--> /TYPE:RAW
; LPTOCT <--> /PRINT:OCTAL
; LPTCOB <--> /FILE:COBOL
; LPTFOR <--> /FILE:FORTRAN /PRINT:(ARROW,ASCII,SUPPRESS)
; LPTRPT <--> /FILE:ASCII7 /REPORT:XXX /PRINT:(ARROW,ASCII,SUP)
; LPTASC <--> /FILE:ASCII7 /PRINT:(ARROW,ASCII,SUPPRESS)
; LPTELV <--> /FILE:ELEVEN
;
;The determination is done in the above order
SETPFT: MOVE S1,J$FTYP(J) ;Get /TYPE switch (from LPFORM.TXT)
MOVEI T1,LPTRAW ;Assume special mode
CAME S1,[SIXBIT/RAW/]
CAMN S1,[SIXBIT/SCRZAP/] ;Special?
$RET ;Yes
CAMN S1,[SIXBIT/8BIT/] ;Always 8 bit ASCII?
$RET ;Yes
LOAD S1,.FPINF(E),FP.FFF ;GET /FILE
LOAD S2,.FPINF(E),FP.FPF ;GET /PRINT
TXZ S,ARROW ;CLEAR SOME INITIAL FLAGS
TXO S,NEWLIN!FCONV ;AND SET SOME OTHERS
CAIN S1,.FPF8B ;/FILE:ASCII8
$RET ;Yes
MOVEI T1,LPTOCT ;ASSUME /PRINT:OCTAL
CAIN S2,%FPLOC ;IS IT?
$RET ;YES, RETURN
MOVEI T1,LPTCOB ;NO, ASSUME /FILE:COBOL
CAIN S1,.FPFCO ;IS IT?
$RET ;YES, RETURN
CAIN S2,%FPLAR ;/PRINT:ARROW?
TXO S,ARROW ;YES, LIGHT A FLAG
CAIN S2,%FPLSU ;/PRINT:SUPPRESS?
TXO S,SUPFIL!ARROW ;YES, LIGHT A BIT, (for arrow mode too)
MOVEI T1,LPTFOR ;ASSUME /FILE:FORTRAN
CAIN S1,.FPFFO ;IS IT?
$RET ;YES, RETURN
MOVEI T1,LPTELV ;ASSUME /FILE:ELEVEN
CAIN S1,.FPF11 ;IS IT?
$RET ;YES, RETURN
MOVEI T1,LPTASC ;ASSUME STANDARD ASCII
SKIPE .FPFR1(E) ;UNLESS /REPORT WAS SPECIFIED
MOVEI T1,LPTRPT ;USE REPORT ROUTINE
$RET ;AND RETURN
SUBTTL LPTASC -- Print Regular ASCII on LPT
LPTASC: $CALL INPBYT ;Get a character
JUMPF .RETT ;If false, EOF
$CALL LPTOUT ;else go output it
JRST LPTASC ;Get the next char
SUBTTL LPTRAW -- Print the file verbatim
LPTRAW: $CALL INPBYT ;Get a char
JUMPF .RETT ;Return on EOF
$CALL OUTCHR ;Send the char as is
JRST LPTRAW
SUBTTL LPTELV -- Print MACY11 file as regular ASCII
LPTELV: $CALL INPBYT ;Get a byte (36 bit word)
JUMPF .RETT ;Return if EOF
MOVE T1,C ;Save the word
LDB C,[POINT 8,T1,17] ;GET THE FIRST BYTE
$CALL LPTOUT ;PRINT IT
LDB C,[POINT 8,T1,9] ;GET SECOND BYTE
$CALL LPTOUT ;PRINT IT
LDB C,[POINT 8,T1,35] ;GET THIRD BYTE
$CALL LPTOUT ;PRINT IT
LDB C,[POINT 8,T1,27] ;GET FOURTH BYTE
$CALL LPTOUT ;PRINT IT
JRST LPTELV ;GET THE NEXT FOUR BYTES
SUBTTL LPTFOR -- Process FORTRAN data files
LPTFOR: $CALL INPBYT ;Get a byte
JUMPF .RETT ;Return if EOF
JUMPE C,LPTFOR ;IGNORE NULLS
TXZE S,FCONV ;CHECK FOR CTL CHAR
JRST FORCNV ;GO DO IT
CAIN C,.CHLFD ;LINEFEED?
TXOA S,FCONV ;FLAG NEXT CHAR AS CTL CHAR
$CALL LPTOUT ;OTHERWISE PRINT IT
JRST LPTFOR ;AND LOOP AROUND AGAIN.
FORCNV: MOVSI T1,-NFORCH ;MAKE AN AOBJN POINTER
FORC.1: HLRZ T2,FORTAB(T1) ;GET CHAR FROM TABLE
CAMN C,T2 ;MATCH?
JRST FORC.2 ;YES, GO TRANSLATE
AOBJN T1,FORC.1 ;NO, LOOP
MOVEI C,.CHLFD ;DIDN'T FIND A MATCH, SO LOAD
$CALL LPTOUT ; A LINEFEED, SEND IT, AND
JRST LPTFOR ; CONTINUE ON
FORC.2: HRRZ C,FORTAB(T1) ;GET TRANS CHAR AND REPEAT COUNT
LDB T1,[POINT 9,C,26] ;GET REPEAT COUNT IN T1
MOVEM T1,J$XFRC(J) ;SAVE THE REPEAT COUNT
ANDI C,177 ;AND DOWN TO CHARACTER
FORC.3: $CALL LPTOUT ;SEND THE CHARACTER
SOSLE J$XFRC(J) ;COUNT DOWN THE REPEAT COUNTER
JRST FORC.3 ;AND LOOP
JRST LPTFOR ;AND CONTINUE
SUBTTL LPTRPT -- Process REPORT files
LPTRPT: $CALL INPBYT ;GET A BYTE FROM THE FILE
JUMPF .RETT ;AND RETURN WHEN DONE
$CALL LPTOUT ;DO ALL THE CHECKING
JRST LPTRPT ;AND GET ANOTHER
SUBTTL LPTOCT -- Give an Octal Dump
LPTOCT: $CALL .SAVE3 ;SAVE P1 -- P3
LOAD T1,.FPINF(E),FP.FSP ;GET THE SPACING CODE
CAIE T1,1 ;SINGLE SPACE?
SKIPA P2,[22,,1] ;NO--THEN TRIPLE SPACE, DOUBLE SPACE
;IS UGLY --DO NOT ALLOW IT
MOVE P2,[12,,3] ;SINGLE SPACE THE LISTING
OCT1: MOVEI T1,(P2) ;BLOCK PER PAGE
OCT2: MOVEI T2,^D16 ;LINES PER BLOCK
OCT3: MOVEI T3,^D8 ;WORDS PER LINE
MOVE P1,J$FWCL(J) ;GET THE WIDTH CLASS
CAIN P1,2 ;IS IT 2?
MOVEI T3,4 ;YES, USE 4 WORDS/LINE
CAIN P1,1 ;IS IT 1?
MOVEI T3,2 ;YES, USE 2 WORDS/LINE
OCT4: MOVEI T4,^D12 ;DIGITS PER WORD
MOVEI C," " ;EACH WORD BEGINS WITH 3 BLANKS
$CALL OUTCHR ;ONE
$CALL OUTCHR ;TWO
$CALL OUTCHR ;THREE
$CALL INPBYT ;GET A WORD
JUMPF .RETT ;DONE!!
MOVE P3,C ;COPY WORD
SETZM J$XTOP(J) ;FLAG MIDDLE OF FORM
MOVE P1,[POINT 3,P3] ;LOAD BYTE POINTER
OCT5: ILDB C,P1 ;GET NEXT DIGIT
MOVEI C,60(C) ;MAKE ASCII
$CALL OUTCHR ;PRINT CHAR
SOJG T4,OCT5 ;END OF WORD?
SOJG T3,OCT4 ;END OF LINE?
HLRZ C,P2 ;GET MOTION CHARACTER
$CALL OUTCHR
SOJG T2,OCT3 ;END OF BLOCK?
$CALL OUTCHR ;YES--2 EXTRA LINE FEEDS
$CALL OUTCHR
SOJG T1,OCT2 ;END OF PAGE?
MOVEI C,.CHFFD ;PRINT A FORM FEED
$CALL DOFORM ;AND ENFORCE QUOTA ETC.
JRST OCT1 ;PRINT NEXT PAGE
SUBTTL LPTCOB -- Process COBOL Sixbit Files
LPTCOB: $CALL .SAVE2 ;SAVE P1 AND P2
SETZM J$XTOP(J) ;CAUSE A FORM FEED AT END
$CALL INPBYT ;GET THE FIRST WORD OF THE FILE
JUMPF .RETT ;NULL FILE
HLRZ T1,C ;COPY THE FIRST 3 LETERS
CAIE T1,'HDR' ;IS IT A HDR
JRST COBOL2 ;NO--NORMAL INPUT
MOVEI T1,15 ;FLUSH TAPE HEADER
$CALL INPBYT ;GET A WORD
JUMPF COBOL5 ;EOF
SOJG T1,.-2 ;LOOP FOR MORE
COBOL1: $CALL INPBYT ;GET A WORD
JUMPF COBOL5 ;THE LAST WORD HAS COME
COBOL2: ANDI C,7777 ;MASK TO 12 BITS
JUMPLE C,COBOL1 ;IGNORE 0 COUNTS FOR OBVIOUS REASON
MOVEI P1,(C) ;COPY THE COUNT
MOVEI S1,-1(P1) ;GET COUNT-1 IN S1
SUB S1,J$FWID(J) ;ROUND DOWN TO A LINE
IDIV S1,J$FWID(J) ;CONVERT TO # LINES
MOVNS S1 ;NEGATE IT
ADDM S1,J$XVPS(J) ;AND DECREMENT POSITION
COBOL3: $CALL INPBYT ;GET A DATA WORD
JUMPF .RETT ;END OF FILE-- ACTUALY THIS SHOULD
; NEVER HAPPEN SINCE THE COUNT IS EXACT.
MOVEI T1,6 ;CHARS PER WORD.
CAIG P1,6 ;ARE WE DOWN TO LAST DREGS?
MOVEI T1,(P1) ;YES--USE EXACT COUNT TO AVOID FREE
; CRLF ON EXTRA BLANKS.
MOVE T2,C ;COPY WORD
MOVE P2,[POINT 6,T2] ;POINT TO WORD
COBOL4: ILDB C,P2 ;AND GET THE CHARACTER
MOVEI C,40(C) ;MAKE ASCII
$CALL OUTCHR ;PRINT
SOJG T1,COBOL4 ;LOOP FOR NEXT CHAR
SUBI P1,6 ;COUNT 6 MORE CHARS
JUMPG P1,COBOL3 ;GET MORE
MOVEI C,.CHCRT ;LOAD A CARRIAGE RETURN
$CALL OUTCHR ;PRINT IT
MOVEI C,.CHLFD ;LOAD A LINE FEED
$CALL DOLF ;AND SEND EOL
JRST COBOL1 ;LOOP FOR MORE.
COBOL5: MOVEI C,.CHFFD ;GET A FORM FEED.
$CALL OUTCHR ;PUT IT OUT.
$RETT ;AND RETURN.
SUBTTL Character Interrogation Routines
;Subroutine to place a char in the output buffer, possibly translated
;Call with the char in C
LPTOUT: CAIGE C,40 ;VISABLE ASCII
JRST CHKSP ;NO--SEE IF SPACE
LPTOU1: TXZE S,NEWLIN ;AND THIS IS A NEW LINE
SKIPN J$XCOD(J) ;LETS NOT DO A /REPORT IS THERE IS NO CODE.
SKIPA ;DONT GO DOWN THE TUBES.
JRST J$XCOD(J) ;SEE IF REPORT LINE MATCHES
SETZM J$XTOP(J) ;CLEAR FORM FEED FLAG
PJRST OUTCHR ;PRINT IT
CHKSP: MOVE S1,CHTAB(C) ;GET THE DISPATCH
TXNE S1,EOLCHR ;IS THIS AN END OF LINE CHARACTER?
TXO S,NEWLIN ;YES,,LITE NEW LINE BIT
TXNE S,SUPFIL ;IN SUPPRESS MODE?
TXNN S1,SUPRCH ;YES, IS THIS CHARACTER SUPPRESSABLE?
SKIPA ;Skip the suppress stuff
JRST DOSUP ;SUPPRESS THE CHARACTER
TXNN S1,NCLRFF ;CLEAR FORMFEED FLAG?
SETZM J$XTOP(J) ;YES
JRST (S1) ;Dispatch the character
;;;;;
;HERE TO THROW AWAY A LINE. Used with /REPORT code.
FLUSH7: $CALL INPBYT ;GET A BYTE
JUMPF .RETT ;RETURN ON EOF
$CALL ISEOL ;END OF LINE?
JUMPF FLUSH7 ;NO--LOOP FOR REST OF LINE
FLUSH8: $CALL INPBYT ;GET A BYTE
JUMPF .RETT ;RETURN ON EOF
$CALL ISEOL ;GOT EOL CHARACTER?
JUMPF LPTOUT ;NO, NEW LINE, DO THE MATCH
JRST FLUSH8 ;YES, LOOP AGAIN
ISEOL: CAIL C," " ;IS IT PRINTABLE?
$RETF ;YES, ITS NOT AN EOL
MOVE S1,CHTAB(C) ;NO, GET TABLE ENTRY
TXNN S1,EOLCHR ;IS IT AN EOL?
$RETF ;NO, JUST RETURN
TXO S,NEWLIN ;YES, SET NEW LINE
$RETT ;AND RETURN
;;;;;
;Here on a TAB
DOTAB: SKIPN S1,J$FTAB(J) ;Get TAB form data
JRST DOT.2 ;Zero: don't translate TAB
;Simulate TAB by spaces
MOVE T1,J$XHPS(J) ;Get horiz position
IDIV T1,S1 ;Get HPOS mod (stop distance) to T2
MOVN T2,T2 ;Negate it
ADD T2,J$FTAB(J) ;Comp. no of blanks to insert
DOT.1: MOVEI C," " ;Get a space
$CALL OUTCHR ;and output it
SOJG T2,DOT.1 ;loop
$RETT
DOT.2: MOVEI C,.CHTAB ;Don't translate the TAB
$CALL OUTCHR
$RETT
;;;;;
;HERE ON A LINE FEED
DOLF: LOAD T1,.FPINF(E),FP.FSP ;GET SPACING PARAMETER
SETO S1, ;START WITH 1 LINE
DOLF1: SOJLE T1,CNTDWN ;ANY MORE?
MOVEI C,.CHLFD ;LOAD A LINE-FEED
$CALL OUTCHR ;YES--GIVE IT
SOJA S1,DOLF1 ;AND SUBTRACT FROM QUOTA
;;;;;
;HERE TO PROCESS A FORM FEED
DOFORM: SKIPE J$XTOP(J) ;SKIP IF NOT AT TOP OF FORM
$RET ;DO NOT PRINT BLANK PAGES
MOVN S1,J$XVPS(J) ;THIS TAKES ALL WE HAVE ON PAGE
SKIPL S1 ;WAS VPOS NEGATIVE?
CLEAR S1, ;DONT CHARGE FOR ANYTHING THEN.
;THIS MIGHT GIVE THE USER A
;BONUS OF 1-3 FREE LINES.
JRST CNTDWN ;COUNT DOWN THE LIMIT
;;;;;
;HERE IF /PRINT:SUPPRESS
DOSUP: MOVEI C,.CHLFD ;MAKE IT A LINEFEED, REGARDLESS
SKIPE J$XTOP(J) ;SKIP IF NOT TOP
$RET ;ONLY 1 LINE FEED IN A ROW
SETOM J$XTOP(J) ;AND SET TOP
SETO S1,
JRST CNTDWN ;CHARGE FOR THE LINE
;;;;;
;HERE TO DO ARROW MODE STUFF IF NEEDED
CHKARO: TXNN S,ARROW ;ARROW MODE?
PJRST OUTCHR ;NO--JUST PRINT
DOARO: PUSH P,C ;SAVE C
MOVEI C,"^" ;LOAD A ^
$CALL OUTCHR ;PRINT THE ^
POP P,C ;RESTORE C
MOVEI C,100(C) ;MAKE INTO REAL LETTER
PJRST OUTCHR ;PRINT
;;;;;
;HERE ON A DC3
DODC3: SETOM S1 ;DC3 SKIPS 1 LINE
JRST CNTDWN ;AND COUNT DOWN
SUBTTL CNTDWN -- COUNT DOWN LINE FEEDS AND PAGE FEEDS
;CALL: S1/ Line Count Modifier
; C/ The Character Being Printed
;
;RET: TRUE ALWAYS
CNTDWN: CAIL C,12 ;MAKE SURE THIS IS A CARRIAGE CONTROL
CAILE C,24 ; CHARACTER.
PJRST OUTCHR ;IF NOT,,JUST DUMP IT OUT.
CAIN C,.CHFFD ;IS IT A FORM FEED?
JRST CNTDW1 ;YES,,SKIP THIS.
ADDB S1,J$XVPS(J) ;REDUCE VERTICAL POSITION
JUMPG S1,OUTCHR ;JUMP IF STILL ON PAGE
CAIN C,23 ;WAS IT A DC3?
CAMG S1,[-3] ;YES, GIVE HIM 3 EXTRA LINES
JRST CNTDW1 ;OFF PAGE ANYWAY
PJRST OUTCHR ;HE WINS!!
;Here when we are to start on next page
CNTDW1: MOVE S1,J$FLIN(J) ;BACK TO TOP OF PAGE
MOVEM S1,J$XVPS(J) ;SAVE POSITION
SOSL J$IIPG(J) ;Decr. page skip count
JRST CNTDW2 ;Still skipping, don't charge
TXNN S,CHRCNT ;If dummy output, don't charge
AOS J$ANPT(J) ;Incr. total number printed (but not skipped)
CNTDW2: AOS J$CNPT(J) ;ADD 1 TO PAGES PER COPY COUNTER
$CALL LIMCHK ;Check the page limit
CAIN C,23 ;Is the char a DC3?
JRST CNTDW3 ;Yes, special handling
SETZM J$XTOP(J) ;We always want the FF
MOVE S1,J$FFF(J) ;Get FF switch
TXNE S1,F$FFPG ;Skip if we don't want pagination
PJRST SENDFF ;FF to skip crease
PJRST OUTCHR ;Just output char
CNTDW3: MOVEI S1,3 ;Here if DC3
ADDM S1,J$XVPS(J) ;GIVE HIM 3 XTRA LINES
MOVEI C,.CHLFD ;Make it a LF
PJRST OUTCHR ;Output it and return
;;;;;;;;;
;SENDFF - Routine to send a FF if J$XTOP is cleared
SENDFF: MOVEI C,.CHFFD ;LOAD A FF
SKIPN J$XTOP(J) ;SKIP IF ALREADY AT TOP
$CALL OUTCHR ;NO, SEND IT
SETOM J$XTOP(J) ;Indicate we are at top of form
$RETT
SUBTTL LIMCHK -- Check on page limits
Comment\
The purpose of this routine is to check and see if the current page limit
for the job has been exceeded.
Not implemented since we use unlimited limits at UWCSL.\
LIMCHK: $RETT
SUBTTL Routines to generate headers and trailers
;;;;;;;;;;;;;;;;;;;;;
;JOBTRL - Generates trailer pages
JOBTRL: $SAVE <P1,P2,P3>
MOVEI T1,[ASCIZ /END/] ;ADDRESS OF END TEXT
$CALL GIVHDR ;GO SETUP THE LINE
TXNE S,SUPFIL ;Are we suppressing forms?
SETZM J$XTOP(J) ;Don't believe we are at top of forms.
MOVE S1,J$FFF(J) ;Get FF field
TXNE S1,F$FFBT ;No FF before trailer?
$CALL SENDFF
SKIPGE P3,J$FTRA(J) ;Get no of pages to print
JRST JOBT.1 ;Negative i.e. we want banner pages
$CALL TRAILR ;Print ordinary trailer pages
JRST JOBT.9
JOBT.1: MOVN P3,P3 ;We don't want neg. page count
$CALL BANNER ;but we do want banners!!!
JOBT.9: MOVE S1,J$FFF(J) ;Get FF field
TXNE S1,F$FFAT ;No FF after trailer?
$CALL SENDFF
PJRST OUTBUF ;Finish up
;;;;;;;;;;;;;;;;
;JOBHDR - Generates banner pages
JOBHDR: $SAVE <P1,P2,P3>
MOVEI T1,[ASCIZ /START/] ;ADDRESS OF START TEXT
$CALL GIVHDR ;GO SET THE LINE
MOVE S1,J$FFF(J) ;Do we want a FF?
TXNE S1,F$FFBB
$CALL SENDFF
MOVE P3,J$FBAN(J) ;Get number of pages
$CALL BANNER
PJRST OUTBUF ;Dump the buffer
;;;;;;;;;;;;;;;;;;;
;GIVHDR - Sets up the header line
GIVHDR: MOVEI T2,LPTVER ;Get version number
MOVEI T3,LPTMIN
LOAD T4,.EQSEQ(J),EQ.SEQ ;Get job sequence number
GTAD% ;Get current time
MOVE P1,S1
TXT (1,J$XHBF(J),<^T*** ^A0(T1)^T *** Job ^S.EQJOB(J)^T, Seq. #^DT4^T for ^A.EQOWN(J)^T at ^CP1^T TCPSPL version ^DT2^T.^DT3^T Running on ^ASYSNAM^T *** ^A(T1)^T ***^0>)
MOVE S1,J$FWID(J) ;GET THE PAGE WIDTH
IDIVI S1,5 ;GET WORDS/BYTES TO THE END OF THE LINE
ADDI S1,J$XHBF(J) ;POINT TO THE LOGICAL END OF THE LINE
LOAD S2,PTRS(S2) ;GET BYTE PTR FOR END OF LINE
SETZM T1 ;GET A NULL BYTE
IDPB T1,S2 ;CUT THE HEADER OFF HERE !!!
$RETT ;RETURN.
PTRS: POINT 7,0(S1)
POINT 7,0(S1),6
POINT 7,0(S1),13
POINT 7,0(S1),20
POINT 7,0(S1),27
POINT 7,0(S1),34
SUBTTL BANNER -- Routine to print a banner
;P3 should contain number of pages to print
BANNER: MOVEI C,.CHCRT ;Send a CR to stupid printer
$CALL OUTCHR
SKIPN P3 ;Get number of banner pages
$RETT ;Zero, forget this
TXT (1,J$XTMP(J),^A.EQOWN(J)^0) ;Get user name
SKIPA ;FF has already been sent
BANN.1: $CALL SENDFF ;SEND A FORM FEED
SETZM J$XVPS(J) ;AND SET 0 POSITION
MOVEI T1,4 ;LOAD AN OFFSET
CAIN P3,1 ;IS THIS THE LAST BANNER?
ADDM T1,J$XVPS(J) ;YES, DON'T PRINT OVER CREASE
$CALL BANN.2 ;PRINT A BANNER PAGE
SOJG P3,BANN.1 ;AND LOOP
$RETT ;Return
;Subroutine to output one banner page
BANN.2: $CALL PLPBUF ;PRINT A LINE
$CALL PLPBUF ;PRINT ANOTHER LINE
$CALL CRLF ;TYPE A CRLF
MOVEI S1,1 ;LOAD THE BLOCKSIZE
MOVEI S2,J$XTMP(J) ;AND THE STRING ADDRESS
$CALL PICTUR ;AND PRINT A PICTURE
MOVEI T1,^D12 ;COUNT'EM
ADDM T1,J$XVPS(J) ;...
$CALL PLPBUF ;PRINT A LINE
$CALL PLPBUF ;AND ANOTHER
$CALL PLPBUF ;AND A THIRD
MOVEI T1,0 ;LOAD A NULL.
MOVE S1,J$FWCL(J) ;GET THE WIDTH CLASS
CAIN S1,3 ;ROOM ENOUGH FOR THE TITLE?
MOVEI T1,[ASCIZ /Note:/] ;YES, LOAD IT
GETLIM T2,.EQLIM(J),NOT1 ;GET FIRST HALF OF NOTE
JUMPE T2,PLINES ;NO NOTE, FINISH THE PAGE
GETLIM T3,.EQLIM(J),NOT2 ;AND THE SECOND HALF
TXT (1,J$XTMP(J),^A0(T1)^ST2^ST3^0)
MOVEI S1,1 ;GET THE BLOCKSIZE
MOVEI S2,J$XTMP(J) ;GET THE ADDRESS
$CALL PICTUR ;AND SEND IT OUT
MOVEI S1,^D11 ;LOAD NUMBER OF LINES
ADDM S1,J$XVPS(J) ;AND MOVE DOWN THE PAGE
PJRST PLINES ;GO TO EOP AND RETURN
SUBTTL TRAILR -- Routine to Print a Trailer
;P3 should contain the number of pages to print
TRAILR: MOVEI C,.CHCRT ;Send a CR to stupid printer
$CALL OUTCHR
SKIPN P3 ;Get number of trailer pages
$RETT ;Zero, return now
SKIPA ;Already done the FF
TRAI.1: $CALL SENDFF ;SEND A FORMFEED
SETZM J$XVPS(J) ;CLEAR THE VERTICAL POSITION
$CALL TRAI.2 ;PRINT THE INTERNAL LOG
$CALL PLINES ;PRINT TILL END OF PAGE
SOJG P3,TRAI.1 ;LOOP UNTIL DONE
$RETT ;Return
;Here to print the internal log
TRAI.2: $CALL PLPBUF ;PRINT A LINE
$CALL PLPBUF ;AND ANOTHER LINE
MOVE T1,J$FWCL(J) ;GET THE WIDTH CLASS
TXT (0,OUTCHR,<^T >) ;Output a "TAB"
SOJG T1,.-1 ;PRINT N OF THEM
TXT (0,OUTCHR,<^T* * * T C P S P L R u n L o g * * *^M^J^J>)
MOVEI P1,2 ;Keep track of how many lines we print
;Output log buffer
TXT (0,LOGCHR,^0) ;Put a NUL last in buffer
TXT (0,OUTCHR,^AJ$LBFR(J)) ;and dump it
MOVE T1,[POINT 7,J$LBFR(J)] ;Now count the number of lines
TRAI.3: ILDB S1,T1
CAIN S1,.CHLFD
AOS P1 ;One more line
JUMPN S1,TRAI.3 ;Continue until NUL
$CALL CRLF ;Skip a couple of lines
$CALL CRLF
$CALL CRLF
ADDI P1,3 ;Incr. no of lines in log
ADD P1,J$XVPS(J) ;Compute vert. pos.
IDIV P1,J$FLIN(J) ;DID WE OVERFLOW A PAGE?
MOVEM P2,J$XVPS(J) ;SAVE CURRENT POSITION
SUB P3,P1 ;REDUCE PAGES TO PRINT
$RETT
SUBTTL Utility routines for header printing
PLPBUF: TXT (0,OUTCHR,^AJ$XHBF(J)^M^J^J^J^J) ;Dump line and skip 3 lines
MOVEI S1,4 ;We printed 4 lines
ADDM S1,J$XVPS(J) ;Add to count
$RET
PLINES: MOVE T2,J$FLIN(J) ;GET LINES/PAGE
ADDI T2,1 ;ACCOUNT FOR MARGIN
SUB T2,J$XVPS(J) ;SUBTRACT AMOUNT PRINTED
JUMPLE T2,PEOP ;JUMP IF DONE
IDIVI T2,4 ;ELSE GET NUMBER OF LINES TO PRINT
PLINE1: SOJL T2,PEOP ;JUMP IF DONE
$CALL PLPBUF ;PRINT A LINE (4 LINES)
JRST PLINE1 ;AND LOOP
PEOP: MOVE T2,J$FLIN(J) ;GET NUMBER OF LINES/PAGE
SUB T2,J$XVPS(J) ;SUBTRACT THOSE PRINTED
ADDI T2,1 ;COUNT THE MARGIN
PEOP1: JUMPLE T2,PEOP2 ;GO FINISH OFF
$CALL CRLF ;PRINT A CRLF
SOJA T2,PEOP1 ;AND LOOP
PEOP2: $SAVE <P1,P2,P3> ;SAVE SOME ACS
MOVSI P1,-3 ;GET COUNTER
PEOP3: MOVE P2,STARS(P1) ;GET ADDRESS OF TEXT STRING
MOVE P3,J$FWID(J) ;GET THE WIDTH
CAILE P3,^D130 ;IS IT REASONABLE?
MOVEI P3,^D130 ;NOW IT IS
PEOP4: ILDB C,P2 ;GET A CHARACTER
$CALL OUTCHR ;PUT A CHARACTER
SOJG P3,PEOP4 ;LOOP
$CALL CRLF ;SEND LF
AOBJN P1,PEOP3 ;LOOP FOR ALL RULER LINES
$RET ;AND RETURN
CRLF: TXT (0,OUTCHR,^M^J) ;Print CRLF
$RETT ;AND RETURN
SUBTTL HEAD -- Generate File-header pages
;E should point to the FP block and J$INAM, J$IEXT have correct contents
HEAD: $SAVE <P1,P2,P3> ;Save some ACs
TXNE S,SUPFIL ;Are we suppressing forms?
SETZM J$XTOP(J) ;Don't believe we are at top of forms.
MOVE S1,J$FFF(J) ;Get FF field
TXNE S1,F$FFBF ;No FF before file
$CALL SENDFF
REPEAT 0,< ;This louses things royally up at Stanford
MOVEI C,.CHCRT ;Send a CR for stupid printers
$CALL OUTCHR
>;REPEAT 0
LOAD S2,.FPINF(E),FP.NFH ;Get the no header bit
SKIPE S2 ;Skip if we want headers
JRST OUTBUF ;No header: Dump buffers and return
MOVE P3,J$FHEA(J) ;Get number of header pages
JUMPE P3,OUTBUF ;None wanted: Dump buffer and return
HEA.01: $CALL HEAD.1 ;Print one header page
$CALL SENDFF ;and a FF
SOJGE HEA.01 ;Loop until done
PJRST OUTBUF ;Force everything out and return
;Subroutine to print one header page
HEAD.1: MOVEI S1,1 ;Set blocksize
MOVEI S2,J$INAM(J) ;and address of first line
$CALL PICTUR ;PRINT THE LINE
MOVEI S1,1 ;Blocksize again
MOVEI S2,J$IEXT(J) ;AND ADDRESS OF SECOND LINE
$CALL PICTUR ;AND PRINT THE SECOND LINE
TXT (0,OUTCHR,^AJ$XHBF(J)) ;Output banner line
;Output some info on the file
MOVE S1,J$IJFN(J) ;Get JFN
MOVEI S2,J$XTMP(J) ;Arg block
MOVEI T1,.RSCRV+1 ;Only interested in creation time
RFTAD%
MOVE T1,.RSCRV+J$XTMP(J) ;Get creation time
GTAD% ;Get current time
MOVE T2,S1
TXT (0,OUTCHR,<^M^J^J^J^TFile ^A@J$IFNM(J)^T, Created: ^CT1^T, Printed: ^CT2>)
GETLIM T1,.EQLIM(J),FORM ;GET FORMS NAME
TXT (0,OUTCHR,<^M^J^TJob parameters: Request created: ^C.EQAFT(J)^T Page limit: ^DJ$RLIM(J)^T Forms: ^ST1^T Account: ^A.EQACT(J)>)
GETLIM T1,.EQLIM(J),NOT1 ;GET FIRST HALF OF NOTE
GETLIM T2,.EQLIM(J),NOT2 ;GET SECOND HALF OF NOTE
SKIPE T1 ;IS THERE A NOTE?
TXT (0,OUTCHR,<^M^J^T Note:^ST1^ST2^M^J>)
LOAD T1,.FPINF(E),FP.FSP ;GET /SPACING
LOAD T2,.FPINF(E),FP.FCY ;GET THE TOTAL COPY COUNT
LOAD T3,J$CNCT(J) ;GET THE COPIES DONE SO FAR
ADDI T3,1 ;MAKE THIS THE CURRENT COPY
TXT (0,OUTCHR,<^M^J^TFile parameters: Copy: ^DT3^T of ^DT2^T Spacing: ^SSPCTAB-1(T1)>)
LOAD T1,.FPINF(E),FP.FPF ;GET /PRINT
LOAD T2,.FPINF(E),FP.FFF ;GET /FILE
CAXN T2,.FPF8B ;/FILE:8-BIT?
MOVEI T2,4 ;YES, RECORD THE VALUE
CAXN T2,.FPF11 ;/FILE:ELEVEN?
MOVEI S2,5 ;YES,,RECODE THE VALUE
TXT (0,OUTCHR,<^M^J^T Format: ^SFFMTAB-1(T2)^T Print mode: ^SFMTAB-1(T1)>)
LOAD S1,.FPINF(E),FP.DEL ;GET /DELETE BIT
SKIPE S1 ;IS IT SET?
TXT (0,OUTCHR,<^T /DELETE>) ;YES,,SAY SO
MOVE S1,J$IIPG(J) ;GET STARTING PAGE
CAILE S1,1 ;SKIP IF 0 OR 1
JRST [TXT (0,OUTCHR,<^M^J^TPrinting will start at page ^DJ$IIPG(J)>)
JRST .+1] ;[3104] MORE HEADER LETS CONTINUE
$RETT
FMTAB: SIXBIT /ARROW/
SIXBIT /ASCII/
SIXBIT /OCTAL/
SIXBIT /SUPRES/
FFMTAB: SIXBIT /ASCII/
SIXBIT /FORT/
SIXBIT /COBOL/
SIXBIT /8-BIT/
SIXBIT /ELEVEN/
SPCTAB: SIXBIT /SINGLE/
SIXBIT /DOUBLE/
SIXBIT /TRIPLE/
SUBTTL PICTUR -- Routine to print block letters
;Call: S1/ blocksize of letters
; S2/ pointer to string (left half can be 0 or byte-pointer)
PICTUR: $CALL .SAVE3 ;SAVE P1 THRU P3
$CALL .SAVET ;AND SAVE T1 THRU T4
DMOVE P1,S1 ;SAVE THE INPUT ARGUMENTS
MOVNI P3,^D35 ;GET A BIT COUNTER
PICT.1: MOVE T4,P1 ;COPY OVER THE BLOCK SIZE
$CALL PICT.2 ;PRINT A LINE
SOJG T4,.-1 ;AND DO IT "BLOCKSIZE" TIMES
ADDI P3,5 ;BUMP TO NEXT SEGMENT OF CHARACTER
JUMPL P3,PICT.1 ;AND LOOP FOR NEXT SEGMENT
TXT (0,OUTCHR,^M^J^J^J^J) ;Print four blank lines
$RETT
;HERE TO PRINT ONE LINE OF THE CURRENT SEGMENT
PICT.2: $CALL .SAVE2 ;SAVE P1 AND P2
PUSH P,T4 ;SAVE T4
TLNN P2,-1 ;MAKE SURE ITS A BYTE POINTER
HRLI P2,(POINT 7,0) ;MAKE IT ONE
MOVE T2,J$FWID(J) ;GET LINEWIDTH
IDIV T2,[EXP 7,^D14,^D21]-1(P1) ;AND DIVIDE BY CHARACTER SIZE
MOVE T4,T2 ;SAVE MAX NUMBER OF CHARS/LINE
PICT.3: ILDB T2,P2 ;GET A CHARACTER
JUMPE T2,PICT.6 ;LAST CHARACTER, DONE
CAIGE T2,40 ;MUST BE GREATER THEN ' '
JRST PICT.3 ;ELSE GET THE NEXT CHAR
MOVE T1,CHRTAB-40(T2) ;GET THE WORD FROM THE TABLE
ROT T1,^D35(P3) ;POSITION TO CORRECT SEGMENT
TLZ T1,017777 ;ZERO BITS FOR SPACE BETWEEN CHARS
MOVEI T3,7 ;PRINT 5 CHARS + 2 SPACES
PICT.4: MOVEI C," " ;LOAD A SPACE
TLNE T1,(1B0) ;SEE IF HIGH BIT IS ONE
LDB C,P2 ;IT IS, GET THE CHARACTER
CAIN C,":" ;IS IT A COLON ???
MOVEI C,"#" ;MAKE IT A # SIGN.
$CALL PICT.5 ;PRINT IT THE CORRECT NUMBER OF TIMES
ROT T1,1 ;ROTATE WORD 1 BIT
SOJG T3,PICT.4 ;AND LOOP THE CORRECT NUMBER OF TIMES
SOJG T4,PICT.3 ;AND GET THE NEXT CHARACTER
JRST PICT.6 ;NO MORE ROOM, DONE
PICT.5: MOVE T2,P1 ;GET THE BLOCKSIZE
$CALL OUTCHR ;PRINT IT
SOJG T2,.-1 ;LOOP
$RET ;AND RETURN
PICT.6: POP P,T4 ;RESTORE T4
PJRST CRLF ;TYPE A CR AND RETURN
SUBTTL Tables for the block letters
CHRTAB: BYTE (5) 00,00,00,00,00,00,00 ;SP
BYTE (5) 04,04,04,04,04,00,04 ;!
BYTE (5) 12,12,00,00,00,00,00 ;"
BYTE (5) 12,12,37,12,37,12,12 ;#
BYTE (5) 04,37,24,37,05,37,04 ;$
BYTE (5) 31,31,02,04,10,23,23 ;%
BYTE (5) 10,24,10,24,23,22,15 ;&
BYTE (5) 06,02,00,00,00,00,00 ;'
BYTE (5) 04,10,20,20,20,10,04 ;(
BYTE (5) 04,02,01,01,01,02,04 ;)
BYTE (5) 00,25,16,33,16,25,00 ;*
BYTE (5) 00,04,04,37,04,04,00 ;+
BYTE (5) 00,00,00,00,00,06,02 ;,
BYTE (5) 00,00,00,37,00,00,00 ;-
BYTE (5) 00,00,00,00,00,06,06 ;.
BYTE (5) 00,00,01,02,04,10,20 ;/
BYTE (5) 16,21,23,25,31,21,16 ;0
BYTE (5) 04,14,04,04,04,04,16 ;1
BYTE (5) 16,21,01,02,04,10,37 ;2
BYTE (5) 16,21,01,02,01,21,16 ;3
BYTE (5) 22,22,22,37,02,02,02 ;4
BYTE (5) 37,20,34,02,01,21,16 ;5
BYTE (5) 16,20,20,36,21,21,16 ;6
BYTE (5) 37,01,01,02,04,10,20 ;7
BYTE (5) 16,21,21,16,21,21,16 ;8
BYTE (5) 16,21,21,17,01,01,16 ;9
BYTE (5) 00,00,06,06,00,06,06 ;:
BYTE (5) 00,06,06,00,06,06,02 ;;
BYTE (5) 02,04,10,20,10,04,02 ;<
BYTE (5) 00,00,37,00,37,00,00 ;=
BYTE (5) 10,04,02,01,02,04,10 ;>
BYTE (5) 16,21,01,02,04,00,04 ;?
BYTE (5) 16,21,21,27,25,25,07 ;@
BYTE (5) 16,21,21,21,37,21,21 ;A
BYTE (5) 36,21,21,36,21,21,36 ;B
BYTE (5) 17,20,20,20,20,20,17 ;C
BYTE (5) 36,21,21,21,21,21,36 ;D
BYTE (5) 37,20,20,36,20,20,37 ;E
BYTE (5) 37,20,20,36,20,20,20 ;F
BYTE (5) 17,20,20,20,27,21,16 ;G
BYTE (5) 21,21,21,37,21,21,21 ;H
BYTE (5) 16,04,04,04,04,04,16 ;I
BYTE (5) 01,01,01,01,21,21,16 ;J
BYTE (5) 21,21,22,34,22,21,21 ;K
BYTE (5) 20,20,20,20,20,20,37 ;L
BYTE (5) 21,33,25,21,21,21,21 ;M
BYTE (5) 21,21,31,25,23,21,21 ;N
BYTE (5) 16,21,21,21,21,21,16 ;O
BYTE (5) 36,21,21,36,20,20,20 ;P
BYTE (5) 16,21,21,21,25,22,15 ;Q
BYTE (5) 36,21,21,36,24,22,21 ;R
BYTE (5) 17,20,20,16,01,01,36 ;S
BYTE (5) 37,04,04,04,04,04,04 ;T
BYTE (5) 21,21,21,21,21,21,37 ;U
BYTE (5) 21,21,21,21,21,12,04 ;V
BYTE (5) 21,21,21,21,25,33,21 ;W
BYTE (5) 21,21,12,04,12,21,21 ;X
BYTE (5) 21,21,12,04,04,04,04 ;Y
BYTE (5) 37,01,02,04,10,20,37 ;Z
BYTE (5) 14,10,10,10,10,10,14 ;[
BYTE (5) 00,00,20,10,04,02,01 ;\
BYTE (5) 06,02,02,02,02,02,06 ;]
BYTE (5) 04,12,21,00,00,00,00 ;^
BYTE (5) 00,00,00,00,00,00,37 ;_
BYTE (5) 14,10,00,00,00,00,00 ;ACCENT GRAVE
BYTE (5) 00,00,36,01,17,21,17 ;LC A
BYTE (5) 20,20,20,36,21,21,36 ;LC B
BYTE (5) 00,00,17,20,20,20,17 ;LC C
BYTE (5) 01,01,01,17,21,21,17 ;LC D
BYTE (5) 00,00,16,21,36,20,17 ;LC E
BYTE (5) 16,21,20,34,20,20,20 ;LC F
BYTE (5) 00,00,16,21,17,01,37 ;LC G
BYTE (5) 20,20,20,36,21,21,21 ;LC H
BYTE (5) 00,04,00,04,04,04,04 ;LC I
BYTE (5) 00,04,00,04,04,24,10 ;LC J
BYTE (5) 20,22,22,24,30,24,22 ;LC K
BYTE (5) 04,04,04,04,04,04,04 ;LC L
BYTE (5) 00,00,24,37,25,25,25 ;LC M
BYTE (5) 00,00,20,36,21,21,21 ;LC N
BYTE (5) 00,00,16,21,21,21,16 ;LC O
BYTE (5) 00,00,36,21,36,20,20 ;LC P
BYTE (5) 00,00,17,21,17,01,01 ;LC Q
BYTE (5) 00,00,26,31,20,20,20 ;LC R
BYTE (5) 00,00,17,20,16,01,36 ;LC S
BYTE (5) 00,10,34,10,10,10,06 ;LC T
BYTE (5) 00,00,21,21,21,21,16 ;LC U
BYTE (5) 00,00,21,21,12,12,04 ;LC V
BYTE (5) 00,00,21,21,25,25,12 ;LC W
BYTE (5) 00,00,21,12,04,12,21 ;LC X
BYTE (5) 00,00,21,12,04,04,30 ;LC Y
BYTE (5) 00,00,37,02,04,10,37 ;LC Z
BYTE (5) 04,10,10,20,10,10,04 ;OPEN BRACE
BYTE (5) 04,04,04,00,04,04,04 ;VERTICAL BAR
BYTE (5) 04,02,02,01,02,02,04 ;CLOSE BRACE
BYTE (5) 00,10,25,02,00,00,00 ;TILDE
BYTE (5) 00,00,00,00,00,00,00 ;RUBOUT
SUBTTL STARS - Job definition/separation line definitions
STARS: POINT 7,STARS1 ;LINE 1
POINT 7,STARS2 ;LINE 2
POINT 7,STARS3 ;LINE 3
STARS1: ASCII /000000000000000000000000000000000000000000000000000000000000/
ASCII /000000000000000000000000000000000000000111111111111111111111/
ASCII /1111111111/
STARS2: ASCII /000000000111111111122222222223333333333444444444455555555556/
ASCII /666666666777777777788888888889999999999000000000011111111112/
ASCII /2222222223/
STARS3: ASCII /123456789012345678901234567890123456789012345678901234567890/
ASCII /123456789012345678901234567890123456789012345678901234567890/
ASCII /1234567890/
LPTEND::END TCPSPL