Trailing-Edge
-
PDP-10 Archives
-
bb-l014w-bm_tops20_v7_0_atpch_23
-
autopatch/lptspl.x23
There are no other files named lptspl.x23 in the archive.
TITLE LPTSPL - TOPS-20 Line Printer Driver
SUBTTL Preliminaries
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH LPTMAC ;SEARCH LPTSPL PARAMETERS
SEARCH GLXMAC ;SEARCH GALAXY PARAMETERS
PROLOGUE(LPTSPL)
SEARCH QSRMAC ;SEARCH QUASAR PARAMETERS
SEARCH ORNMAC ;SEARCH ORION/OPR PARAMETERS
IFN FTACNT,<
SEARCH ACTSYM ;[6000]SEARCH THE ACCOUNTING UNIVERSAL
>
SEARCH MACSYM ;[6044]
.DIRECT FLBLST
IF2,<
TOPS20 <PRINTX ASSEMBLING GALAXY-20 LPTSPL>
TOPS10 <PRINTX ASSEMBLING GALAXY-10 LPTSPL>
> ;END IF2
SALL ;SUPPRESS MACRO EXPANSIONS
SUBTTL Edit vector and Version numbers
LPTVEC: BLDVEC (LPTMAC,LMC,L) ;[6000]
BLDVEC (LPTCLU,CLU) ;[6000]
BLDVEC (LPTDQS,DQS) ;[6001]
BLDVEC (LPTUSR,USR) ;[6005]
BLDVEC (LPTSUB,LSB) ;[6007]
BLDVEC (GLXMAC,GMC,L)
BLDVEC (ORNMAC,OMC,L)
BLDVEC (QSRMAC,QMC,L)
BLDVEC (LPTSPL,LPT,L)
LPTMAN==:6050 ;Maintenance edit number
LPTDEV==:6045 ;Development edit number
VERSIN (LPT) ;Generate edit number
LPTWHO==0 ;WHO LAST PATCHED
LPTVER==6 ;MAJOR VERSION NUMBER
LPTMIN==0 ;MINOR VERSION NUMBER
LPTVRS==<VRSN.(LPT)>+LMCEDT+CLUEDT+DQSEDT+LSBEDT;+GMCEDT+OMCEDT+QMCEDT
LOC 137
LPTVNO: EXP LPTVRS
RELOC
Subttl Table of Contents
; Table of Contents for LPTSPL
;
; Section Page
;
;
; 1. Edit vector and Version numbers . . . . . . . . . . . 2
; 2. Revision history . . . . . . . . . . . . . . . . . . . 6
; 3. Definitions
; 3.1 Global Symbols . . . . . . . . . . . . . . . . 7
; 3.2 DN60 Support Definitions . . . . . . . . . . . 8
; 3.3 IB and HELLO message blocks . . . . . . . . . 9
; 3.4 Interrupt System Database . . . . . . . . . . 10
; 3.5 Words to Zero in Job Page . . . . . . . . . . 11
; 3.6 Random Impure Storage . . . . . . . . . . . . 12
; 3.7 Resident Job Database . . . . . . . . . . . . 13
; 4. Initialization . . . . . . . . . . . . . . . . . . . . 14
; 5. Idle Loop . . . . . . . . . . . . . . . . . . . . . . 15
; 6. Scheduler
; 6.1 CHKTIM - Check Stream Wakeup Time . . . . . . 16
; 6.2 DSCHD - Do Scheduler Pass . . . . . . . . . . 17
; 6.3 FIXPDL - Fix PDL routine . . . . . . . . . . . 20
; 6.4 FIXACT - Set Stream to Inactive . . . . . . . 21
; 7. Job Processing
; 7.1 DOJOB - Do the Job . . . . . . . . . . . . . . 22
; 7.2 NXTFIL - Find And Return The Next File . . . . 24
; 7.3 FILDIS - Keep or Delete Printed Files . . . . 25
; 7.4 DETDEL - Determine Is A File Is To Be Deleted 26
; 7.5 FILE - Print a File . . . . . . . . . . . . . 27
; 7.6 ENDJOB - End Of Job Processor . . . . . . . . 28
; 7.7 QRELEA - Send A Requeue/Release Message . . . 29
; 8. IPCF Interface
; 8.1 CHKQUE - Receive and Schedule IPCF Messages . 31
; 8.2 CHKOBJ - Validate Object Block . . . . . . . . 32
; 8.3 GETBLK - Break Down An IPCF Message . . . . . 33
; 8.4 FORFOR - Force Forms Change . . . . . . . . . 34
; 8.5 DOFFOR - Operator Set Forms . . . . . . . . . 35
; 8.6 KILL - User (or operator) CANCEL Request . . . 36
; 8.7 QSRNWA - Shutdown stream whose node dropped . 37
; 8.8 DSTATU - Send status info . . . . . . . . . . 38
; 8.9 CHKPNT - Request for Checkpoint . . . . . . . 39
; 8.10 UPDATE - Send Status Updates . . . . . . . . . 40
; 8.11 NXTJOB - Nextjob Message . . . . . . . . . . . 41
; 8.12 SETUP - Setup/Shutdown Message . . . . . . . . 43
; 8.13 SHUTDN - Shut Down A Printer . . . . . . . . . 48
; 8.14 RSETUP - Send A Response-To-Setup . . . . . . 49
; 8.15 OACRSP - Response to a WTOR . . . . . . . . . 50
; 8.16 OACCAN - Operator Abort Request . . . . . . . 51
; 8.17 OACSUP - Operator SUPPRESS Request . . . . . . 53
; 8.18 OACPAU - Operator STOP Request . . . . . . . . 54
; 8.19 OACCON - Operator CONTINUE request . . . . . . 55
; 8.20 OACREQ - Operator REQUEUE request . . . . . . 56
; 8.21 OACALI - Operator ALIGN request . . . . . . . 58
Subttl Table of Contents (page 2)
; Table of Contents for LPTSPL
;
; Section Page
;
;
; 8.22 OACFWS - Operator Forward Space Command . . . 60
; 8.23 OACBKS - BACKSPACE Operator Action . . . . . . 61
; 8.24 Backspace
; 8.24.1 BSPACE - Backspace Pages . . . . . . . . 62
; 8.24.2 BCOPYS - Backspace Copies . . . . . . . 64
; 8.24.3 BFILES - Backspace Files . . . . . . . . 65
; 8.25 OPRD60 - Receive DN60 OPR messages from QUASAR 66
; 8.26 OPRCHK - Check for and Send DN60 Messages . . 68
; 8.27 Subroutines
; 8.27.1 FNDOBJ - Find The Object Block . . . . . 71
; 8.27.2 TOOBAD - Operator Is Too Late . . . . . 72
; 8.27.3 SNDQSR - Send A Mesasge To QUASAR . . . 73
; 9. Align Processor
; 9.1 Align Forms on Printer . . . . . . . . . . . . 74
; 9.2 ALISCD - Schedule Align . . . . . . . . . . . 75
; 9.3 Create A 10/20 FD For The Align File . . . . . 76
; 10. Printer Output
; 10.1 CHKLPT - Make Sure The Device Is Online . . . 77
; 10.2 OUTGET - Open The Output Device . . . . . . . 78
; 10.3 OUTGET Exit Subroutines . . . . . . . . . . . 79
; 10.4 TAPGET - Setup A Magtape Device For Output . . 80
; 10.5 OUTOUT - Output A Buffer . . . . . . . . . . . 81
; 10.6 OUTERR - Handle Output Device Errors . . . . . 82
; 10.7 Tape Routines . . . . . . . . . . . . . . . . 87
; 10.8 OUTWON - Wait for on-line . . . . . . . . . . 88
; 10.9 OUTREL - Release Device On SHUTDOWN . . . . . 89
; 10.10 OUTEOF - Clear The LPT Output Buffers . . . . 90
; 10.11 OUTDMP - Dump Out Buffers and Wait . . . . . . 91
; 10.12 OUTFLS - Flush Already Buffered Output . . . . 92
; 10.13 LPT Control Routines . . . . . . . . . . . . . 93
; 10.14 FILOUT - Set Up For LPTIN and LPTOUT . . . . . 95
; 10.15 SETLST - Compile Code For /REPORT . . . . . . 96
; 10.16 SETPFT - Setup File Processing Type . . . . . 97
; 10.17 LPTASC - Print Regular ASCII on LPT . . . . . 98
; 10.18 LPTELV - Print MACY11 File as Regular ASCII . 99
; 10.19 LPTFOR - Process FORTRAN Data Files . . . . . 100
; 10.20 LPTRPT - Process REPORT Files . . . . . . . . 101
; 10.21 LPTOCT - Give an Octal Dump . . . . . . . . . 102
; 10.22 LPTCOB - Process COBOL Sixbit Files . . . . . 103
; 10.23 Character Interrogation Routines . . . . . . . 104
; 10.24 CNTDWN - Count Down Line Feeds and Page Feeds 106
; 10.25 LIMCHK - Check On Page Limits . . . . . . . . 108
; 10.26 Subroutines to Send Messages To Output Device 112
; 10.27 Generate Headers and Trailers . . . . . . . . 113
; 10.28 BANNER - Print A Banner . . . . . . . . . . . 114
; 10.29 TRAILR - Print a Trailer . . . . . . . . . . . 115
; 10.30 Utility Routines . . . . . . . . . . . . . . . 117
Subttl Table of Contents (page 3)
; Table of Contents for LPTSPL
;
; Section Page
;
;
; 10.31 STARS - Job Separation Lines . . . . . . . . . 118
; 10.32 HEAD - Generate File-Header Pages . . . . . . 119
; 10.33 SETHDR - Setup Header Name For File . . . . . 121
; 10.34 PICTUR - Print Block Letters . . . . . . . . . 125
; 11. Interrupt System
; 11.1 Initialization . . . . . . . . . . . . . . . . 128
; 11.2 Connect Lineprinter . . . . . . . . . . . . . 129
; 11.3 IPCF Interrupt . . . . . . . . . . . . . . . . 130
; 11.4 Device Interrupt . . . . . . . . . . . . . . . 131
; 12. DN60 Routines
; 12.1 Local/Remote I/O Subroutines . . . . . . . . . 132
; 12.2 DN60 I/O Support Routines . . . . . . . . . . 134
; 12.3 D60SU - DN60 Success Routine To Fix Counts . . 137
; 12.4 D60ER/D60OE - Process DN60 errors . . . . . . 138
; 12.5 IBMSTS - Send IBMCOM Statistics Message . . . 141
; 13. Terminal Spooling
; 13.1 TTYGET - Setup A Terminal Printer . . . . . . 143
; 13.2 TTYG - Setup the terminal for output . . . . . 144
; 13.3 TTYG.6 - error handler for TTYG. . . . . . . . 146
; 13.4 CHKTTY - Check TTY Status . . . . . . . . . . 147
; 13.5 LODTTY - Load TTY VFU . . . . . . . . . . . . 149
; 13.6 LATGET - Get LAT Printer . . . . . . . . . . . 150
; 13.7 LAT error handling routines . . . . . . . . . 152
; 13.8 Errors from the LAT BOX for the LATOP% JSYS. . 153
; 13.9 LATTHC - Terminate the LAT connection . . . . 154
; 14. End of LPTSPL . . . . . . . . . . . . . . . . . . . . 155
SUBTTL Revision history
COMMENT \
***** Release 4.2 - begin maintenance edits *****
3103 4.2.1528 9-Nov-82
Fix copyright and fix RELOC.
3104 4.2.1543 3-Mar-83
If needed, make sure we send a form feed after FORWARDSPACE, /BEGIN:xx
and RELEASEing a REQUEUEd print job. Forward space the total number of
pages in numerous FORWARDSPACE commands. Send a form feed if we have
forward space beyond the number of pages in a file so that the trailer
will begin on a new page.
3105 4.2.1562 1-Dec-83
Release the JFN if the device is not available and is not remote.
In either case, indicate no output channel. Also put the DN60 in
OUTDNA under DN60 conditionals.
3106 4.2.1565 22-Dec-83
In FRMIN4, correct the way locator switches are processed
to ensure that DN60 remote printers are processed correctly.
3107 4.2.1568 16-Feb-84
In FORMS, initialize the pointer TEXTBP after the call to
OUTDMP so as to prevent occasional BPN stop codes from occuring due
to TEXTBP being changed by OPRD60 which is called by OUTDMP if there
are any DN60 messages pending.
3111 4.2.1585 13-Aug-84
If end of line characters have not been found after a number of
characters have been analyzed, inform the operator and give the
option of either aborting the print request, continuing to print
the file with end of line checking or continuing to print the file
with no end of line checking.
3112 4.2.1587 13-Aug-84
Allow 2780/3780 type remote station to receive console messages
during forms change by setting PSF%OO at the $DSCHD in FORMS, and
clearing it when the forms change is completed. This is to prevent
an active stream awaiting forms change from blocking the remote
printer.
3113 4.2.1593 18-Sep-84
In FORMS, reload S1 with the forms type specified in the forms
change message prior to determining whether to send to OPR a
"load forms" message.
3114 2/28/85 SPR# 20-20303
In routine OACRSP: don't set the update status word until FORM.4
has confirmed that the response is valid. Also add some checks for DN60
printer when setting the update status bits.
GCO 4.2.1611
3115 4/22/85 In routine CHKM2: use index register S1 when updating the flag
word.
3116 4/29/85
Set the update status flag, JOBUPD, after a valid response is given to
a WTOR.
GCO 4.2.1616
3117 5/21/85
If a print job is canceled due to unprintable lines being detected,
indicate in the trailer page that the job was canceled by the operator.
GCO 4.2.1617
***** Release 5.0 - begin development edits *****
3120 5.1003 10-Jan-83
Move to new development area. Add version vector. Clean up
edit organization. Update TOC.
3121 5.1046 21-Oct-83
Change version number from 104 to 5.
3122 5.1092 13-Feb-84
Make system process by setting IB.SYS in IB.
3123 5.1197 5-Feb-85
Make an optional system process using GALGEN.
3124 5.1200 6-Feb-85
Do GTJFNs with bit GJ%ACC turned on to restrict access to the JFNs.
***** Release 5.0 - begin maintenance edits *****
3130 Increment maintenance edit level for version 5 of GALAXY.
3131 5.1226 16-Oct-85
Reset the EOL counter (J$PRNT) for each file in a print job
3132 5.1227 17-Oct-85
Reset the forms characteristics when a request is aborted
***** Release 6.0 - begin development edits *****
6000 6.1027 19-Oct-87
Add support for cluster printing.
6001 6.1036 24-Oct-87
Add support for DQS printing, update TOC and create LPTSUB.
6002 6.1049 31-Oct-87
If LPTSPL detects that it is to be started as a local printer,
cause it to open the LPT device before sending the RESPONSE TO SETUP
message to QUASAR.
6003 6.1050 3-Nov-87
Do not check for a Cluster LPTSPL type at routine ENDJOB since
Cluster LPTSPL does not go through this code. At routine ENDREQ, clear
all the status bits except the LPT type bit. At routine QRELEA, do
not allow a Cluster LPTSPL to clean up any spooled files or do accounting.
At routine INPOPN, first check if a remote user has access to the file.
6004 6.1056 4-Nov-87
Remove all references to the checksumming word CHECKS.
6005 6.1061 6-Nov-87
Add support for spooling to LAT and TTY line terminal printers.
Create the new module, LPTUSR, for terminal characteristic definitions. (User
modifications should be made in LPTUSR.)
6006 6.1062 7-Nov-87
Simplify LPTSPL's determination of LPT type during SETUP. Modify
routine FNDOBJ to only compare unit number instead of unit number and
attributes.
6007 6.1071 9-Nov-87
Move forms, logging, input file, and other routines to LPTSUB.
Fix references to FILTYP(J). Don't set hold bit when requeueing in
QRELEA unless the ABORT bit is also set for LPTDQS. Note that the
OPR REQUEUE command will light the ABORT bit. Remove a lot of TOPS-10
only code.
6010 6.1071 11-Nov-87
Fix some things from last edit.
6011 6.1072 12-Nov-87
In routine OUTSOK, check whether we have a connect ID for a LAT line
and skip trying to connect the LPT. In routine SETH.W, always use block size
of one when it is a TTY or a LAT printer. In routine TTYG.1, use AC j and not
T1. In routine TTYG.N, if the printer is a LAT call LATTHC to terminate the
connection. In routine LATGET, skip the LATOP% if we already have a
connection. In routine LATTHC, store the address of the LATOP arg block in AC
1 and clear J$CID(J).
6012 6.1074 13-Nov-87
Move some storage around, replace code lost at HEAD.2-2. Fix bugs in
trailer routine (LPTSPL should leave printer at TOF after a job because if
the system crashes and reloads, the paper position is assumed to be a TOF
when the VFU is loaded later). Also remove misguided code in BANNER.
6013 6.1079 16-Nov-87
Add code to handle LAT errors. Move label TTYG.2 up one instruction
so that the default TTY characteristic is remembered in J$TTYC. Add a delay
timer in routine LATTHC before we terminate the LAT connection. This is a
work around for a MONITOR bug in which the MONITOR is terminating the LAT
connection before the last buffer is outputted.
6014 6.1082 17-Nov-87
LPTSPL crashes with LTF. In routine LATTHC, call $CLOSF to close the
terminal before terminating the LAT connection.
6015 6.1082 18-Nov-87
In routine LATREP, check for greater or equal to .LAUNK and not just
greater.
6016 6.1086 18-Nov-87
In routine MXTJ.4:, if we can't get a LAT connect requeue the job.
Breakup TTYGET so that it will only handle the TTY case and have LATGET handle
the LAT case. TTYG will return true if the terminal printer is setup and false
if not. LATGET returns true if a LAT connection and the terminal printer is
setup. False if it is not.
6017 6.1086 19-Nov-87
If TTYG returns false S1 contains error status. S1=0 means operator
aborted the setting of the terminal characteristic . S1=TOPS-20 error code.
6020 6.1087 19-Nov-87
In routine OUTE.3:, line noise got merge with the code.
6021 6.1088 19-Nov-87
In routine LATTHC:, if the CLOSF fails do the LATOP% (.LATHC).
6022 6.1091 20-Nov-87
We didn't output 132 columns of forms ruler. Also fix location of
the *START* and **END** strings so that they are at the extreme right and left.
6023 6.1092 20-Nov-87
In routine NXTJ.4:, do not requeue the job if we can't get a LAT
connection. Instead, release the object and shut down the stream. In routine
LATREJ:, if the LAT error is .LASIU retry 5 times before we give up.
6024 6.1103 25-Nov-87
In routine TAPGET and LATGET: (LATGE2:+), do a MOVSI to get the pointer
instead of the HRLI because S1 might contain something in the right half. Also,
in routine LATTHC: after the CLOSF, do a LATHC.
6025 6.1104 27-Nov-87
In routine KILL: and OACCAN:, return if the job is a LAT printer job.
Don't flush the buffers. In routine SHUTDOWN:, Call LATTHC to shutdown a LAT
printer.
6026 6.1105 30-Nov-87
In routine OACR.2:, change the TXNE to TXNN, so that only DQS jobs
get the "DQS job requeued from beginning of job" and not for all jobs.
6027 6.1111 1-Dec-87
Make sure that AC S is saved in stream context after setup message.
6030 6.1130 7-Dec-87
In routine NXTJ.4: call SHUTIN to shut down the stream because we are
in stream context.
6031 6.1132 7-Dec-87
Do not specify an attribute for a cluster LPTSPL in the RESPONSE-TO-
SETUP message.
6032 6.1153 30-Dec-87
Let J$FHEA and J$FBAN determine how many header and banner pages to
print. Delete two lines at HEAD.1 and BANN.1.
6033 6.1163 6-Jan-88
Do not specify an attribute for DQS and LAT LPTSPLs in the RESPONSE-
TO-SETUP message.
6034 6.1171 22-Jan-88
Cause routine FORFOR to correctly check for a cluster printer or not.
This solves the problem of local printers stopping after a SET PRINTER FORMS
command.
6035 6.1225 8-Mar-88
Update copyright notice.
6036 6.1229 22-Mar-88
In routine LATREJ: check for error .LAIAR (Immediate Access Reject)
and treat it as a recoverable error.
6037 6.1232 1-Mar-88
In routine LATTHC: create new entry point, LATABT:, to lit CZ%ABT
for CLOSF if we are terminatung the LAT connection due to an error.
6040 6.1234 6-Apr-88
Upon receipt of an ALIGN, BACKSPACE, FORWARDSPACE or SUPPRESS message,
do not check if the LPT type if cluster or DQS since QUASAR only sends these
messages to local LPTs.
6041 6.1238 22-APR-88
No ERJMPs after JSYS calls in routine CHKTTY:.
6042 6.1249 6-May-88
In routine DOFFOR:, if we are a LATSPL call LATGET to make a connection
and call LATTHC when we are done. Also, in routine LATTER: clear J$LCHN.
6043 6.1251 9-May-88
Add a check for LAT error codes .LAIRS and .LASCS in routine LATREJ.
Also report any LAT errors that are not defined.
6044 6.1255 13-May-88
When displaying information about print requests that originated on a
remote node in the cluster, do not use the job information block to pick up
the user number to obtain the user name. Instead, use the user name that was
stored in .EQOWN by the remote QUASAR.
6045 6.1256 14-May-88
If a cancel request originated from a remote node in the cluster,
then indicate in the log and in the $WTO sent to ORION the user who canceled
the print request and the node that the request came from.
6046 6.1272 1-Jan-89
Pages printed is always zero when /MODE:SUPPRESS switch is used. This
is a day one bug. In routine DOSUP: don't set J$XTOP, let CNTDWN do it.
LAT connection is not release on a forms change if the print job is canceled.
Do not call LATGET in SETUP: (SETUP message) because NEXTJB: does it too.
6047 6.1274 24-Feb-89
Since TOPS-20 LPTSPL is a single stream process, process the forms
change command right away instead of doing it in stream context from the
scheduler.
6050 6.1278 9-May-89
Add support to print in portrait and landscape mode on a LN03.
In order for us to support landscape and portrait, they must be defined as:
@SET REMOTE-PRINTER CHARACTERISTIC LANDSCAPE 0 and @SET REMOTE-PRINTER
CHARACTERISTIC PORTRAIT 52.
\ ;End of Revision History
SUBTTL Definitions -- Global Symbols
;Global symbols in LPTSPL
INTERN CNTSTA,DETDEL,DIRNAM,DSCHD,ENDREQ,JOBACT,JOBOBA
INTERN LEV1PC,LPTSIZ,LPTVNO,NXTFIL,RSETUP,SHUTIN,SNDQSR
INTERN ENDREQ,ENDJOB,LPCNF,JOBCHK,IB,STREAM ;[6001][6007]
INTERN CONANS,DEPBP,TEXTBP,JOBUPD,JOBWAC,$MTOPR ;[6007]
INTERN ENDRSP,OUTWON,OUTDMP,SENDFF,ALISCD ;[6007]
INTERN RMJOBI ;[6044]
;Globular symbols for LPTCLU
EXTERN CLNCLU,CLUEDT,ENDFRK,FIXCLU,INILNK,INTDAV,REMREL,RCVINT
EXTERN CLJOB ;[6001]
;Globular symbols from LPTDQS
EXTERN DQSINI,DQSREL,DQSFIX,DQSLOG,DQSJOB,DQSEDT ;[6001][6007]
;Globular symbols from LPTSUB
EXTERN LOGCHR,FORMS,LODVFU,LODRAM,LSBEDT,FMOPN ;[6007]
EXTERN LSTAF,LFINF,D$ALCN,D$ALSL,D$TAPE,FILTYP ;[6007]
EXTERN LPMSG,LPDAT,LPOPR,LPEND,LPERR ;[6007]
EXTERN INPOPN,INPBUF,INPBYT,INPERR,INPFEF,INPREW,INPCLS ;[6007]
EXTERN ACTBEG,ACTEND ;[6007]
;Globular symbols from LPTUSR
EXTERN TTYTAB,DEFPRI,TABEND ;[6005]
;**;[6050]At EXTERNAL TTYTAB +1L add 1 line JYCW 5/8/89
EXTERN PORTFT,LANDFT ;[6050]Symbols in LPTUSR
SUBTTL Definitions -- DN60 Support Definitions
;IF WE HAVE DN60,,GET DN60 I/O PACKAGE
IFN FTDN60,<
SEARCH D60UNV ;GET UNIVERSAL
.Z.==$ER1ST ;SET STARTING VALUE
DEFINE ERRS(CODE,TEXT),<XLIST
CODE==.Z. ;;DEFINE THE ERROR CODE
EXP [ASCIZ\TEXT\] ;;DEFINE THE TEXT FOR IT
.Z.==.Z.+1 ;;BUMP ERROR CODE COUNTER
LIST>
D60TXT: D60ERR TEXT ;DEFINE THE ERROR TEXT
DEFINE X(ERR,TXT),<XLIST
ER'ERR: ASCIZ\TXT\
LIST>
X (FCC,<Failed to Close DN60 Console>)
X (FCO,<Failed to Close DN60 Output>)
X (DOE,<DN60 Output Error>)
X (COP,<Can't Open DN60 Printer>)
X (COC,<Can't Open DN60 Console>)
X (CRP,<Can't Release DN60 Printer>)
X (CRC,<Can't Release DN60 Console>)
X (COE,<DN60 Console Output Error>)
PHASE 0
OPRPTR:! BLOCK 1 ;OPR MESSAGE BYTE POINTER
OPRBCT:! BLOCK 1 ;OPR MESSAGE BYTE COUNT
OPRLEN:! ;OPR MESSAGE HEADER LENGTH
OPRTXT:! ;OPR MESSAGE TEXT
DEPHASE
> ;END FTDN60 CONDITIONAL
SUBTTL Definitions -- IB and HELLO message blocks
INTVEC==:LEVTAB,,CHNTAB
IB: $BUILD IB.SZ ;
$SET(IB.PRG,,%%.MOD) ;SET UP PROGRAM NAME
$SET(IB.INT,,INTVEC) ;SET UP INTERRUPT VECTOR ADDRESS
$SET(IB.PIB,,PIB) ;SET UP PIB ADDRESS
$SET(IB.FLG,IP.STP,1) ;STOPCODES TO ORION
$SET(IB.FLG,IB.SYS,LPT.JP) ;Set process type
$SET(IB.FLG,IB.NAC,1) ;Restrict access to JFNs
$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,0) ;INTERRUPT CHANNEL
$SET(PB.SYS,IP.BQT,-1) ;[6000]MAX SEND/RECEIVE IPCF QUOTA
$SET(PB.SYS,IP.MNP,^D2) ;[6000]NUMBER OF PIDS
$EOB ;
HELLO: $BUILD HEL.SZ ;
$SET(.MSTYP,MS.TYP,.QOHEL) ;MESSAGE TYPE
$SET(.MSTYP,MS.CNT,HEL.SZ) ;MESSAGE LENGTH
$SET(HEL.NM,,<'LPTSPL'>) ;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 ;
; The following is the message that is sent to QUASAR to indicate
; activity using the DN60-IBMCOM
IFN FTIBMS,<
IBMSTM: $BUILD (MSHSIZ+1) ;Header plus status
;word
$SET (.MSTYP,MS.CNT,MSHSIZ+1) ;Length of message
$SET (.MSTYP,MS.TYP,.QOIBM) ;IBMCOM statistics is
;message type
$EOB ;Everything else is
;zero
> ;End of FTIBMS
SUBTTL Definitions -- Interrupt System Database
;Level table
LEVTAB: EXP LEV1PC ;WHERE TO STORE LEVEL 1 INT PC
EXP LEV2PC ;WHERE TO STORE LEVEL 2 INT PC
EXP LEV3PC ;WHERE TO STORE LEVEL 3 INT PC
;Channel table
CHNTAB: XWD 1,INTIPC ;IPCF INT - LEVEL 1
XWD 1,INTDEV ;DEV OFF LINE INT - LEVEL 1
XWD 1,INTDAV ;[6000]DATA AVAILABLE OR DISCONNECT
XWD 1,RCVINT ;[6000]INTERRUPT MESSAGE AVAILABLE
BLOCK ^D32 ;[6000]RESTORE OF THE TABLE
LEV1PC: BLOCK 1 ;LVL 1 INTERRUPT PC STORED HERE
LEV2PC: BLOCK 1 ;LVL 2 INTERRUPT PC STORED HERE
LEV3PC: BLOCK 1 ;LVL 3 INTERRUPT PC STORED HERE
SUBTTL Definitions -- Words to Zero in Job Page
;NOW GENERATE A BIT TABLE OF WHICH WORDS IN THE JOB DATA PAGE 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 Definitions -- Random Impure Storage
PDL: BLOCK PDSIZE ;PUSHDOWN LIST
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 MSBSIZ ;A BLOCK TO BUILD MESSAGES IN.
IMESS: BLOCK 1 ;IPCF message -1=one to be released
LPCNF: BLOCK <LPCNFL==32> ;[6022] Sysname
LPJOB: BLOCK 1 ;LPTSPL'S JOB NUMBER
LPTRM: BLOCK 1 ;TERMINAL DESIGNATOR
LPCON: BLOCK 1 ;CONNECT TIME
LPLNO: BLOCK 1 ;LINE NUMBER
JOBITS: BLOCK 1 ;SAVE JOB STATUS BITS FLAG.
STRSEQ: EXP 4000 ;STREAM SEQ #'S (START AT 4000)
SCHEDL: -NPRINT,,0 ;STREAM SCHEDULING DATA
SLEEPT: BLOCK 1 ;SLEEP TIME FOR SCHEDULING.
;This is always the min. amount to sleep
;-1 if no sleep time specified
CNTSTA: BLOCK 1 ;NUMBER OF THE CENTRAL STATION
RUTINE: BLOCK 1 ;MESSAGE PROCESSING ROUTINE ADDRESS.
EMSG: BLOCK 1 ;Address of error message for D60ER
OPRERR: BLOCK 1 ;OPR error - Flag used to indicate source
; of DN60 error -1 - indicates opr cons. fail
DEFINE X(A),<ASCIZ/A/> ;[6000]MAKE LOGICAL NAME ASCIZ
DIRNAM: L$DIRN ;LOGICAL NAME OF SHARED DIRECTORY
LPTSIZ: BLOCK 1 ;[6000]SIZE OF LPTSPL IN PAGES
RSNFLG: BLOCK 1 ;[6012] Holds addr of ASCIZ abort reason
FDADDR: BLOCK 1 ;[6012] Alignment FD address
LATBLK: BLOCK 7 ;[6005] Argument block for LATOP%
;$TEXT utility used to store characters in a string
DEPBP: IDPB S1,TEXTBP ;DEPOSIT THE BYTE
$RETT ;AND RETURN
TEXTBP: BLOCK 1 ;BYTE POINTER FOR DEPBP
SUBTTL Definitions -- Resident Job Database
STREAM: BLOCK 1 ;CURRENT STREAM NUMBER
JOBPAG: BLOCK NPRINT ;ADDRESS OF A FOUR PAGE BLOCK
; ONE FOR REQUEST, ONE FOR JOB PARAMS
; ONE FOR LPT BUFFER, ONE FOR LOG BUFFER
JOBOBA: BLOCK NPRINT ;TABLE OF OBJECT BLOCK ADDRESSES
JOBSTW: BLOCK NPRINT ;JOB STATUS WORD
JOBACT: BLOCK NPRINT ;-1 IF STREAM IS ACTIVE, 0 OTHERWISE
JOBOBJ: BLOCK NPRINT*OBJ.SQ ;[6001] List of setup objects
JOBWKT: BLOCK NPRINT ;JOB WAKE TIME (FOR ALIGN)
JOBCHK: BLOCK NPRINT ;STREAM CHECKPOINT INDICATOR
;Contains the time for the next checkpoint
; or 0 if one is requested
JOBUPD: BLOCK NPRINT ;Stream update indicator
; if set, update is indicated for the stream
JOBWAC: BLOCK NPRINT ;STREAM WTOR ACK CODE.
RMJOBI: ITEXT(<Job ^W/.EQJBB+JIB.JN(J)/ Req #^D/.EQJBB+JIB.ID(J)/ for ^T/.EQOWN(J)/^A>) ;[6044]
SUBTTL Initialization
;Here to start LPTSPL
LPTSPL: RESET ;AS USUAL.
MOVE P,[IOWD PDSIZE,PDL] ;SET UP THE STACK.
MOVEI S1,IB.SZ ;GET THE IB SIZE.
MOVEI S2,IB ;ADDRESS OF THE IB.
PUSHJ P,I%INIT ;SET UP THE WORLD.
PUSHJ P,I%HOST ;[6012] Get the host name
MOVEM S1,CNTSTA ;[6012] Save it
MOVX S1,.MSIIC ;[6012] Get ignore str accounting bit
MSTR ;[6012] We don't want to mount things
ERJMP .+1 ;[6012] Ignore any error
MOVX S1,'SYSVER' ;[6012] Name of GETAB for system name
SYSGT ;[6012] Get it
MOVSI T2,-LPCNFL ;[6012] and load loop counter
GETSYN: HRRZ S1,S2 ;[6012] Get table number
HRLI S1,(T2) ;[6012] Get word,,table
GETAB ;[6012] Get the entry
MOVEI S1,0 ;[6012] Use zero if losing
MOVEM S1,LPCNF(T2) ;[6012] Store the result
AOBJN T2,GETSYN ;[6012] Loop for all words
IFN FTDN60,< ;[6012]
MOVEI S1,SERFLG ;[6012] Get SYSERR flag
PUSHJ P,D60INI## ;[6012] Init DN60 data base
> ; End of IFN FTDN60
SETZM FMOPN ;[6012] Clear LPFORM.INI open flag
PUSHJ P,INTINI ;SET UP THE INTERRUPT SYSTEM.
PUSHJ P,I%ION ;TURN ON INTERRUPTS.
MOVEI T1,HELLO ;GET ADDRESS OF HELLO MESSAGE.
PUSHJ P,SNDQSR ;SAY HI TO QUASAR.
MOVSI P1,-NPRINT ;SET UP STREAM COUNTER.
;FALL THROUGH TO MAIN LOOP.
SUBTTL Idle Loop
MAIN:
IFN FTDN60,<
SKIPE J,JOBPAG(P1) ;Stream setup?
$CALL OPRCHK ;Yes - do DN60 operator output stuff
> ;End of IFN FTDN60
SKIPN JOBACT(P1) ;IS THE STREAM ACTIVE?
JRST MAIN.2 ;NO,,GET THE NEXT STREAM.
HRRZM P1,STREAM ;RUNNABLE STREAM
MOVE J,JOBPAG(P1) ;YES, GET JOB PAGE
PUSHJ P,CHKTIM ;Adjust sleep time if needed
$CALL DSTATU ;Do any status stuff
SKIPE JOBSTW(P1) ;IS THE STREAM BLOCKED?
JRST MAIN.2 ;YES,,GET THE NEXT STREAM.
MOVEM P1,SCHEDL ;SAVE THE SCHEDULING STREAM.
MOVSI 0,J$RACS+1(J) ;Setup first source address for BLT
HRRI 0,1 ;Setup first destination address
BLT 0,17 ;GET SOME ACS
POPJ P, ;AND RETURN
MAIN.1: MOVE P1,SCHEDL ;GET THE LAST SCHEDULED STREAM.
$CALL DSTATU ;Do any status stuff
PUSHJ P,CHKTIM ;SET THE WAKEUP TIMER
MAIN.2: AOBJN P1,MAIN ;LOOP BACK FOR SOME MORE.
PUSHJ P,CHKQUE ;CHECK FOR INCOMMING MESSAGES.
SKIPE MESSAGE ;DID WE PROCESS A MESSAGE?
JRST MAIN.3 ;YES,,CONTINUE PROCESSING
MOVE S1,SLEEPT ;NO,,PICK UP SLEEP TIME.
JUMPE S1,MAIN.3 ;Don't sleep if 0 sleep specified
SKIPG S1 ;Any time specified?
SETZ S1, ;No, set to sleep forever
SKIPE JOBACT ;CHECK IF STREAM ACTIVE..
SKIPE JOBSTW ;ANY BLOCKING CONDITIONS
PUSHJ P,I%SLP ;ELSE,,GO WAIT
MAIN.3: MOVE P,[IOWD PDSIZE,PDL] ;RESET THE STACK POINTER.
SETOM SLEEPT ;Start fresh
MOVSI P1,-NPRINT ;GET LOOP AC.
JRST MAIN ;KEEP ON PROCESSING.
SUBTTL Scheduler -- CHKTIM - Check Stream Wakeup Time
; The purpose of this routine is to check and set the sleep time based
; on current conditions. The sleeptime is checked based on the stream's
; wakeup time and the console wakeup time (on DN60). Whoever wants to
; wakeup the earliest sets the sleeptime if the time is less than the
; current.
; Returns: False if it is not time to wake up this stream
; True if it is time to wakeup this stream
CHKTIM: PUSHJ P,I%NOW ;GET CURRENT TIME INTO S1
MOVE T1,STREAM ;Get our stream number
MOVE S2,JOBWKT(T1) ;Get wakeup time of job
SETZM TF ;Remember we are using the console
IFN FTDN60,<
SKIPN J$OMSG(J) ;Any console messages?
JRST CHKT.0 ;No
SKIPE S2 ;Any time set?
CAML S2,J$CWKT(J) ;Yes, console time sooner?
SKIPN J$CWKT(J) ;Yes, any console time set?
JRST CHKT.0 ;No, don't use console time
SETOM TF ;Remember we used console time
MOVE S2,J$CWKT(J) ;Yes
> ;End of IFN FTDN60
CHKT.0: JUMPE S2,.RETF ;No time set, this is irrelevant
SUB S2,S1 ;CALCULATE THE NUMBER
IDIVI S2,3 ; OF SECONDS TO WAKE-UP.
JUMPLE S2,CHKT.1 ;IF TIME IS UP,,WAKE UP STREAM.
CAILE S2,^D60 ;IF WAKE UP TIME IS GREATER THEN
MOVEI S2,^D60 ; 60 SECS,, THEN MAKE IT 60 SECS.
SKIPL SLEEPT ;If -1 then none set - go set
CAMGE S2,SLEEPT ;IF WAKE UP TIME IS LESS THEN
MOVEM S2,SLEEPT ;CURRENT WAKE UP TIME,,THEN RESET IT.
$RETF ;DO NOT WAKE UP THE JOB.
CHKT.1: SETZM SLEEPT ;No sleep time needed
MOVX S1,PSF%AL ;PICK UP ALIGN BLOCK BIT.
MOVE T1,STREAM ;Get stream number (Clobbered by IDIVI
; above)
SKIPLE J$LREM(J) ;IS THIS A DN60 LPT?
TXO S1,PSF%DO ;YES,,INCLUDE DEVICE OFFLINE
ANDCAM S1,JOBSTW(T1) ;TURN OFF STREAM WAIT STATE BIT.
IFN FTDN60<
SKIPE TF ;Did we have console time to get here?
JRST [SETZM J$CWKT(J) ;Yes, clear it
$RETT] ;And return
> ;End of FTDN60
MOVE T1,STREAM ;Get the stream number
SETZM JOBWKT(T1) ;Clear job wake time
$RETT ;WAKE UP THE STREAM.
SUBTTL Scheduler -- DSCHD - Do Scheduler Pass
; The purpose of this routine is to provide a generalized blocking
; mechanism. It differs from the old DSCHD in that it will block
; whether in stream context or not.
; DSCHD is called by the $DSCHD macro where the call is:
; $DSCHD (flags) where flags are flags and/or a number of seconds
; to sleep
; ASSUMPTIONS. . .
; 1. STREAM is assumed to be correct.
; 2. If not in stream context, it is assumed that J contains the
; address of the jobpage. This has a side problem. If J indicates
; a jobpage of an already existing stream with a context and
; the stream is in the overhead context, the old stream context
; will be destroyed which must be avoided by the caller.
; 3. If called with an IPCF message currently in use, it is assumed
; that the user has everything needed from the message and the
; message will be released. This assumption is necessary to
; prevent another message being received before the old message
; is released.
; All registers are preserved in the JOBPAG.
; Only AC's S1, S2 and T1 are touched before jumping to MAIN.
; parameters:
; J / Address of the current jobpage (if not, expect a stopcd)
;Save the AC's in any case
DSCHD: MOVEM 0,J$RACS(J) ;Save AC0
MOVEI 0,J$RACS+1(J) ;Place to put AC1
HRLI 0,1 ;Setup the BLT pointer
BLT 0,J$RACS+17(J) ;Save the AC's
MOVE T1,STREAM ;Get the current stream number
;Continued on next page
;Continued from previous page
;Take care of the flags passed
HRRZ S2,0(P) ;Get address of JUMP [FLAGS]
HLLZ S1,@0(S2) ;Get the flags
HRRZ S2,@0(S2) ;Get the sleep time
IORM S1,JOBSTW(T1) ;set only the flags
JUMPE S2,DSCH.D ;No sleep time to worry about
$CALL I%NOW ;Get the current time
IMULI S2,3 ;Seconds to jiffies
ADD S1,S2 ;Build wake-up time
MOVEM S1,JOBWKT(T1) ;Save the wake-up time
;Check to see our current context
DSCH.D: HRRZ S1,P ;Get current address of PDL
CAIL S1,J$RPDL(J) ;Less than beginning of current PDL
CAILE S1,PDSIZE+J$RPDL(J) ;or Greater than end?
SKIPA ;No not in stream context
JRST DSCH.Z ;Yes - already in stream context
;Continued on next page
;Continued from previous page
;Since we have to make a stream context, we must do the following:
; 1. Release any IPCF messages
; 2. Given then the stream number:
; Save JOBACT for this stream and info needed to restore JOBACT
; Set JOBACT for this stream so it can be selected to run
; 3. Save PDL and AC17
SKIPE IMESS ;Any IPCF messages?
$CALL C%REL ;Yes, release it
SETZM IMESS ;Set no IPCF messages
SKIPN JOBACT(T1) ;Stream already active?
PUSH P,[EXP FIXACT] ;no - remember to fix JOBACT
SETOM JOBACT(T1) ;pretend we are active now in any case
PUSH P,[EXP FIXPDL] ;Remember to fix up the stack later
MOVEI S1,J$RPDL(J) ;Get stream's PDL location
HRLI S1,PDL ;Get beginning of PDL
HRRZ T1,P ;Get current PDL pointer
SUBI T1,PDL ;Find current length
ADDI T1,J$RPDL(J) ;Add stream's base
HRR P,T1 ;Set new pointer
BLT S1,(T1) ;Save PDL
MOVEM P,J$RACS+P(J) ;Save new PDL pointer
JRST MAIN.3 ;Return to restart main loop
DSCH.Z: MOVE P,[IOWD PDSIZE,PDL] ;Reset stack pointer
JRST MAIN.1 ;Return to main loop
SUBTTL Scheduler -- FIXPDL - Fix PDL routine
;The purpose of this subroutine is to return the pseudo stream
;context back to overhead context. (See DSCHD)
FIXPDL: MOVEI S1,PDL ;Get overhead PDL
HRLI S1,J$RPDL(J) ;Get beginning of stream's PDL
HRRZ S2,P ;Get current pointer
SUBI S2,J$RPDL(J) ;Find the current length
ADDI S2,PDL ;Add the base of the PDL
HRR P,S2 ;Set the new pointer
BLT S1,(S2) ;Restore PDL
MOVE S1,J$RACS+S1 ;Restore S1
MOVE S2,J$RACS+S2 ;Restore S2
$RET ;Continue on
SUBTTL Scheduler -- FIXACT - Set Stream to Inactive
;This routine is use to return a stream to an inactive state when
;the stream was descheduled when not in stream context. It is
; "called" by DSCHD pushing FIXACT on the stack when the need is
;determined.
FIXACT: $SAVE <S1> ;Save a register
MOVE S1,STREAM ;Get the stream #
SETZM JOBACT(S1) ;Make it inactive
$RET ;Don't change anything
SUBTTL Job Processing -- DOJOB - Do the Job
DOJOB: PUSHJ P,FORMS ;GET FORMS MOUNTED
JUMPF ENDREQ ;CANT DO IT,,END THE REQUEST
;**;[6050]At DOJOB+2L add 2 lines JYCW 5/8/89
CALL SETPRT ;[6050Set printer to a known state
CALL PORLAN ;[6050]See if we want Landscape or
;[6050]portrait
MOVN S1,J$FWID(J) ;Pick up the form width value
IMULI S1,CHKWGT ;Multiply by weighting factor
MOVEM S1,J$WITH(J) ;Save value for later use
MOVEM S1,J$PRNT(J) ;Initialize the eol check counter
$CALL CHKALN ;Do an alignment if needed
LOAD S1,.EQSEQ(J),EQ.IAS ;GET INVALID ACCOUNT STRING BIT
STORE S1,S,ABORT ;SAVE IT AS THE ABORT BIT
TXO S,BANHDR ;LITE 'PRINTING BANNERS' FLAG
PUSHJ P,JOBHDR ;PRINT THE BANNER
TXZ S,BANHDR ;CLEAR 'PRINTING BANNERS' FLAG
LOAD E,.EQLEN(J),EQ.LOH ;GET LENGTH OF HEADER
ADD E,J ;POINT TO FIRST FILE
SETZM J$RNFP(J) ;ZAP THE # OF FILES PRINTED
TXO S,INJOB ;We are in a job now
SKIPN .EQCHK+CKFLG(J) ;IS THIS A RESTARTED JOB?
JRST DOJO.4 ;NO, SKIP ALL THIS STUFF
MOVE T1,.EQCHK+CKFIL(J) ;YES, GET NUMBER OF FILES DONE
MOVEM T1,J$RNFP(J) ;STORE FOR NEXT CHECKPOINT
DOJO.1: SOJL T1,DOJO.2 ;DECREMENT AND JUMP IF SKIPED ENUF
LOAD S1,.FPINF(E),FP.FCY ;GET THE COPIES IN THIS REQUEST
ADDM S1,J$AFXC(J) ;ADD TO THE TOTAL COUNT
PUSHJ P,NXTFIL ;BUMP E TO NEXT SPEC
JUMPF DOJO.7 ;FINISH OFF IF DONE
JRST DOJO.1 ;LOOP SOME MORE
DOJO.2: MOVE S1,.EQCHK+CKCOP(J) ;GET NUMBER OF COPIES PRINTED
MOVEM S1,J$RNCP(J) ;SAVE FOR NEXT CHECKPOINT
ADDM S1,J$AFXC(J) ;ADD TO THE TOTAL FILE COUNT
MOVE S1,.EQCHK+CKTPP(J) ;GET THE TOTAL PAGES PRINTED.
SUBI S1,5 ;MAKE SURE WE DONT SCREW THINGS UP
SKIPGE S1 ;ALSO MAKE SURE WE ARE NOT NEGATIVE
SETZM S1 ;YES,,MAKE IT 0
MOVEM S1,J$APRT(J) ;AND SAVE IT
MOVE S1,.EQCHK+CKPAG(J) ;GET CHKPNT'ED PAGE
SUBI S1,5 ;MAKE SURE WE DONT MISS ANYTHING
SKIPGE S1 ;ALSO MAKE SURE WE ARE NOT NEGATIVE
SETZM S1 ;YES,,MAKE IT 0
TXZE S,BCKFIL ;WERE WE BACKSPACED DURING HEADERS?
TXZ S,SKPFIL ;YES,,CLEAR THE SKIP FILE BIT
SKIPA ;Never use the /START param that follows
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
DOJO.4: LOAD S1,.FPFST(E) ;GET /START PARAMETER
MOVEM S1,J$FPIG(J) ;SAVE FOR FIRST COPY
PUSHJ P,FILE ;NO, PRINT THE FILE
TXNE S,RQB ;HAVE WE BEEN REQUEUED?
JRST ENDJOB ;YES, END NOW
AOS J$RNFP(J) ;BUMP THE FILE COUNT BY 1.
MOVE S1,STREAM ;Get the stream number
SETZM JOBCHK(S1) ;Want a checkpoint soon
TXZE S,BCKFIL ;BACKSPACING A FILE?
JRST DOJO.4 ;YES
PUSHJ P,NXTFIL ;BUMP TO NEXT FILE
JUMPT DOJO.4 ;AND LOOP
DOJO.7: SKIPN E,J$RLFS(J) ;GET ADR OF LOG-SPEC
JRST ENDJOB ;NO, FINISH JOB
MOVE S1,J$APRT(J) ;GET NUMBER OF PAGES PRINTED
ADDI S1,LOGPAG ;ADD IN GUARANTEED LOG LIMIT
CAMLE S1,J$RLIM(J) ;DOES HE HAVE AT LEAST THAT MANY?
MOVEM S1,J$RLIM(J) ;NO, GIVE HIM THAT MANY
TXZ S,ABORT ;CLEAR ABORT FLAG
PUSHJ P,FILE ;PRINT THE FILE
JRST ENDJOB ;AND FINISH UP
SUBTTL Job Processing -- NXTFIL - Find And Return The Next File
NXTFIL: SETZM J$RNCP(J) ;CLEAR COPIES PRINTED
SOSG J$RFLN(J) ;DECREMENT FILE COUNT
$RETF ;NO MORE, DONE
MOVE S1,J$WITH(J) ;[3131]Get the EOL counter value
MOVEM S1,J$PRNT(J) ;[3131]Reset the EOL counter
LOAD S1,.FPLEN(E),FP.LEN ;GET THE FP LENGTH
ADD E,S1 ;BUMP TO THE FD
LOAD S1,.FDLEN(E),FD.LEN ;GET THE FD LENGTH
ADD E,S1 ;BUMP TO THE NEXT FP
TXNE S,CLUSPL!DQSSPL ;[6007] Cluster or DQS?
$RETT ;[6000]YES, DON'T CARE ABOUT LOG FILES
LOAD S1,.FPINF(E),FP.FLG ;[6007] Get log file flag
JUMPE S1,.RETT ;RETURN IF NOT THE LOG FILE
MOVEM E,J$RLFS(J) ;SAVE ADDRESS OF LOG FILE SPEC
JRST NXTFIL ;AND LOOP
SUBTTL Job Processing -- FILDIS - Keep or Delete Printed Files
FILDIS: LOAD E,.EQLEN(J),EQ.LOH ;GET THE HEADER LENGTH.
ADD E,J ;POINT TO FIRST FILE .
LOAD T1,.EQSPC(J),EQ.NUM ;GET THE NUMBER OF FILES.
FILD.1: MOVE T2,.FPINF(E) ;GET THE FILE INFO BITS.
LOAD S2,.FPLEN(E),FP.LEN ;GET THE FILE INFO LENGTH.
ADD E,S2 ;POINT TO FILE SPEC.
MOVEM E,J$XFOB+FOB.FD(J) ;SAVE THE FD ADDRESS IN THE FOB
LOAD S2,.FDLEN(E),FD.LEN ;[6000]GET THE FD LENGTH.
ADD E,S2 ;POINT 'E' AT NEXT FILE.
SETZM J$XFOB+FOB.US(J) ;DEFAULT TO NO ACCESS CHECKING
SETZM J$XFOB+FOB.CD(J) ;HERE ALSO
LOAD S1,.EQSEQ(J),EQ.PRV ;GET THE USERS PRIVILGE BITS
JUMPN S1,FILD.2 ;IF SET, AVOID ACCESS CHECK
TXNE T2,FP.SPL ;WAS IT A SPOOLED FILE?
JRST FILD.2 ;YES,,THEN NO ACCESS CHECK
HRROI S1,.EQOWN(J) ;GET THE OWNERS NAME
STORE S1,J$XFOB+FOB.US(J) ;SAVE IT
HRROI S1,.EQCON(J) ;GET CONNECTED DIRECTORY
STORE S1,J$XFOB+FOB.CD(J) ;AND SAVE IT
FILD.2: MOVEI S1,FOB.SZ ;GET THE FOB LENGTH
MOVEI S2,J$XFOB(J) ;AND THE FOB ADDRESS
$CALL DETDEL ;[6000]DETERMINE IF FILE IS TO BE DELETED
SKIPF ;[6000]IF FALSE, DO NOT DELETE
$CALL F%DEL ;[6000]DELETE THE FILE
SOJG T1,FILD.1 ;[6000]GO PROCESS THE NEXT FILE.
$RETT ;RETURN.
SUBTTL Job Processing -- DETDEL - Determine Is A File Is To Be Deleted
;DETDEL is called during the creation of a RELEASE message.
;DETDEL determines if a file in the print request is to be deleted or not.
;
;Call is: T2/File's FP information word (.FPINF)
;Returns true: The file should be deleted
;Returns false: The file is not to be deleted
DETDEL: TXNE T2,FP.SPL ;[6000]IS THIS A SPOOLED FILE?
$RETT ;[6000]YES, INDICATE DELETE
TXNE S,ABORT ;[6000]IN AN ABORT STATE?
$RETF ;[6000]YES, INDICATE DO NOT DELETE
TXNN T2,FP.DEL ;[6000]USER SPECIFIED DELETE?
$RETF ;[6000]NO, INDICATE DO NOT DELETE
$RETT ;[6000]INDICATE DELETE
SUBTTL Job Processing -- FILE - Print a File
FILE: TXNE S,ABORT ;ARE WE IN TROUBLE?
$RET ;YES,,JUST RETURN.
$CALL LIMCHK ;Are we over limit?
$RETIF ;Yes, just return
$CALL INPOPN ;[6007] Open the input file up
JUMPF .POPJ ;LOSE, RETURN
MOVE S1,J$DFDA(J) ;GET FD ADDRESS
$CALL LSTAF ;[6007] Starting file mumble
FILE.1: PUSHJ P,INPREW ;REWIND THE INPUT FILE
MOVE S1,STREAM ;Get the stream number
SETZM JOBCHK(S1) ;Want a checkpoint
$CALL DSTATU ;Do the status
PUSHJ P,SETLST ;SETUP /REPORT CODE IF NECESSARY
TXZ S,FORWRD ;CLEAR FORWARD SPACE BIT
TXO S,BANHDR ;LITE 'PRINTING HEADERS' FLAG
PUSHJ P,HEAD ;PRINT THE HEADER
TXZ S,BANHDR ;CLEAR 'PRINTING HEADERS' FLAG
MOVEI S1,LPTERR ;GET NUMBER OF DEVICE ERRORS ALLOWED
MOVEM S1,J$LERR(J) ;AND SAVE IT
SOSLE J$FPIG(J) ;SUBTRACT 1 PAGE FROM STARTING PAGE #.
JRST [TXO S,FORWRD ;STILL POS,,TURN ON FORWARD BIT.
MOVE S1,J$FPIG(J) ;SAVE FORWARD SPACE PAGES
JRST .+1] ;AND CONTINUE
TXNE S,ABORT!SKPFIL!RQB ;DO WE REALLY WANT TO DO THIS?
JRST FILE.2 ;NO,,CLEAN UP THE MESS.
PUSHJ P,FILOUT ;PRINT THE FILE
TXNE S,ABORT!SKPFIL!RQB ;ABORTED OR SKIPPED OR REQUEUED?
JRST FILE.2 ;YES, CONTINUE ON
LOAD T1,.FPFST(E) ;GET /START PARAMETER.
MOVEM T1,J$FPIG(J) ;SAVE STARTING POINT FOR THIS COPY.
AOS S1,J$RNCP(J) ;INCREMENT AND LOAD COPIES WORD
AOS J$AFXC(J) ;ADD 1 TO THE TOTAL FILE COUNT
LOAD S2,.FPINF(E),FP.FCY ;GET TOTAL NUMBER TO PRINT
CAML S1,S2 ;PRINTED ENOUGH?
JRST FILE.2 ;Yes, go finish
$CALL LIMCHK ;Check to see if over limit
JUMPT FILE.1 ;If not, loop
FILE.2: $CALL INPCLS ;[6007] Close input file
$CALL LFINF ;[6007] Finished file
MOVE S1,J$DFDA(J) ;GET FD ADDRESS
TXNE S,SUPFIL ;Are we suppressing forms/file?
SETZM J$XTOP(J) ;Yes, set we are not at top of page.
TXZ S,SKPFIL+SUPFIL ;CLEAR LOTS OF BITS
POPJ P, ;AND RETURN
SUBTTL Job Processing -- ENDJOB - End Of Job Processor
ENDJOB: TXO S,GOODBY ;FLAG EOJ SEQUENCE
TXZ S,FORWRD ;TURN OFF THE FORWARD SPACING BIT.
MOVEI S1,[ASCIZ/ Pages of output/] ;[6012] Assume local spooler
TXNE S,DQSSPL ;[6003] If DQS
MOVEI S1,[ASCIZ/ Bytes transmitted/] ;[6012] then it is bytes
$TEXT (LOGCHR,<^I/LPEND/Summary:^D8/J$APRT(J)/^T/(S1)/>) ;[6012]
$TEXT (LOGCHR,<^I/LPEND/ ^D8/J$ADRD(J)/ Disk pages read>) ;[6001]
MOVX S1,.FHSLF ;LOAD FORK HANDLE
RUNTM ;GET RUNTIME
ADD S1,J$ARTM(J) ;GET CPU TIME USED
IDIVI S1,^D1000 ;CONVERT TO SECONDS
$TEXT (LOGCHR,<^I/LPEND/ ^D6R /S1/.^D3L0/S2/ Seconds CPU time used>) ;[6001]
TXNE S,DQSSPL ;[6001] DQS Spooling?
JRST DQSLOG ;[6001] Print log file
PUSHJ P,JOBTRL ;PRINT THE JOB TRAILERS.
PUSHJ P,OUTEOF ;FORCE ALL DATA OUT
; Call the IBMCOM stats routine if needed.
IFN FTIBMS,<
SKIPLE J$LREM(J) ;Is it IBMCOM job?
JRST [MOVEI S1,%TOUT ;Yes, get the STAT code
$CALL IBMSTS ;Send it off
JRST ENDREQ] ;Continue on
> ; End of FTIBMS
ENDREQ: PUSHJ P,QRELEA ;GO SEND THE RELEASE/REQUEUE MSG.
MOVX S1,LPTTYP ;[6003]PICK UP LPT TYPE MASK
ANDM S1,J$RACS+S(J) ;[6003]RESET THE STATUS
MOVE S1,STREAM ;GET STREAM NUMBER
SETZM JOBACT(S1) ;NOT BUSY
JRST MAIN.3 ;RETURN TO THE SCHEDULER.
SUBTTL Job Processing -- QRELEA - Send A Requeue/Release Message
;Here to send a release or requeue message to QUASAR. If RQB is set then we
;want to requeue. If ABORT is also set then we want to hold the job.
QRELEA: MOVE S1,STREAM ;GET THE STREAM NUMBER.
SKIPL J$REMR(J) ;[6044]REQUEST ORIGINATE REMOTELY?
IFSKP. ;[6044]
$WTOJ (End,<^I/RMJOBI/>,@JOBOBA(S1)) ;[6044]TELL THE OPERATOR.
ELSE. ;[6044]
$WTOJ (End,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;[6044]TELL THE OPERATOR.
ENDIF. ;[6044]
SKIPLE J$LREM(J) ;[6000]SKIP LOGGING IF NOT A DN60
$LOG (Printed ^D/J$APRT(J)/ Pages,,@JOBOBA(S1)) ;LOG # OF PAGES
MOVEI S1,MSBSIZ ;GET BLOCK LENGTH
MOVEI S2,MSGBLK ;AND THE ADDRESS
PUSHJ P,.ZCHNK ;ZERO THE BLOCK
TXNE S,LATSPL ;[6005]LAT spool?
$CALL LATTHC ;[6005]Yes, terminate the connection
TXNE S,RQB ;IS THIS A REQUEUE?
JRST RELE.4 ;[6000]YES, GO BUILD THE MESSAGE
TXNE S,CLUSPL ;[6003]IS THIS A CLUSTER LPTSPL?
JRST RELE.3 ;[6003]YES, SO SKIP THIS
;Here if Cluster LPTSPL to clean up files and create release message
SKIPL J$REMR(J) ;[6000]DID REQUEST ORIGINATE REMOTELY?
JRST RELE.2 ;[6000]NO, GO CLEAN UP SPOOL FILES
$CALL REMREL ;[6000]YES, CLEANUP/CREATE RELEASE MSG
JRST RELE.6 ;[6000]GO RETURN
;[6001] Here if not Cluster LPTSPL, request has gone fine, clean up and account
RELE.2: PUSHJ P,FILDIS ;GO CLEAN UP THE SPOOL FILES.
PUSHJ P,ACTEND ;GO DO THE ACCOUNTING
RELE.3: MOVEI T1,MSGBLK ;[6003]GET ADDRESS OF THE BLOCK
LOAD S1,.EQITN(J) ;GET THE ITN
STORE S1,REL.IT(T1) ;STORE IT
MOVX S1,REL.SZ ;NO, GET RELEASE MESSAGE SIZE
MOVX S2,.QOREL ;AND FUNCTION
JRST RELE.5 ;[6000]AND MEET AT THE PASS
;[6007] Here to requeue the job, set the hold bit if the ABORT bit in S is on.
RELE.4: MOVEI T1,MSGBLK ;GET ADDRESS OF THE BLOCK
LOAD S1,.EQITN(J) ;GET THE ITN
STORE S1,REQ.IT(T1) ;STORE IT
LOAD S1,J$RNFP(J) ;GET NUMBER OF FILES PRINTED
STORE S1,REQ.IN+CKFIL(T1) ;STORE IT
LOAD S1,J$RNCP(J) ;GET COPIES PRINTED
STORE S1,REQ.IN+CKCOP(T1) ;STORE IT
LOAD S1,J$RNPP(J) ;GET PAGES PRINTED
STORE S1,REQ.IN+CKPAG(T1) ;AND STORE IT
LOAD S1,J$APRT(J) ;GET TOTAL PAGES PRINTED.
STORE S1,REQ.IN+CKTPP(T1) ;STORE IT
MOVX S1,CKFREQ ;GET REQEUE BIT
STORE S1,REQ.IN+CKFLG(T1) ;STORE IT
TXNN S,ABORT ;[6007] Aborting as well as requeue?
SKIPA S1,[FLD(5,RQ.TIM)] ;[6007] No, requeue after 5 minutes
MOVX S1,RQ.HBO ;GET HOLD BY OPERATOR
MOVEM S1,REQ.FL(T1) ;[6007] Store in flag word
MOVX S1,REQ.SZ ;GET SIZE
MOVX S2,.QOREQ ;AND FUNCTION
;Message is all prepared, S1/ size, S2/ function, send it to QUASAR
RELE.5: STORE S1,.MSTYP(T1),MS.CNT ;[6000]STORE SIZE
STORE S2,.MSTYP(T1),MS.TYP ;AND CODE
PUSHJ P,SNDQSR ;SEND IT TO QUASAR
RELE.6: $RETT ;AND RETURN.
SUBTTL IPCF Interface -- CHKQUE - Receive and Schedule IPCF Messages
CHKQUE: SETZM MESSAG ;NO MESSAGE YET
PUSHJ P,C%RECV ;RECEIVE A MESSAGE
JUMPF .POPJ ;RETURN,,NOTHING THERE.
SETOM IMESS ;Have a message
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
MOVEM M,MESSAG ;SAVE IT AWAY
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 T2,MSGTAB(S1) ;PICK UP THE PROCESSING ROUTINE ADDRESS.
MOVEM T2,RUTINE ;SAVE THE ROUTINE ADDRESS.
PUSHJ P,CHKOBJ ;GO FIND THE OBJECT BLOCK.
JUMPF CHKQ.5 ;NOT THERE,,JUST DELETE IT
PUSHJ P,@RUTINE ;DISPATCH THE MESSAGE PROCESSOR.
SKIPN JOBITS ;DO WE WANT TO SAVE THE STATUS BITS?
MOVEM S,J$RACS+S(J) ;YES,,SAVE THE STATUS BITS.
SETZM JOBITS ;CLEAR THE FLAG (DEFAULT TO ALWAYS SAVE)
CHKQ.5: SKIPE IMESS ;Any IPCF messages?
$CALL C%REL ;Yes, release it
SETZM IMESS ;Remember we have released it
POPJ P, ;RETURN TO THE SCHEDULER.
MSGTAB: XWD KILL,.QOABO ;CANCEL MESSAGE
XWD DSTATU,.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 ABORT REQUEST.
XWD OACPAU,.OMPAU ;OPERATOR 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 IPCF Interface -- CHKOBJ - Validate Object Block
;CALL: S1/OFFSET INTO MSGTAB
; S2/MESSAGE TYPE
;
;RET: STREAM/STREAM NUMBER
; J/DATA BASE ADDRESS
; S/STATUS BITS
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: PUSHJ P,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: PUSHJ P,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.
SUBTTL IPCF Interface -- GETBLK - Break Down An IPCF Message
;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
SUBTTL IPCF Interface -- FORFOR - Force Forms Change
; 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: TXNN S,CLUSPL ;[6034]CLUSTER LPTSPL?
JRST FORFO2 ;[6000]NO, GO PICK UP THE FORMS TYPE
MOVE S1,STREAM ;[6000]PICK UP THE STREAM NUMBER
$ACK (Cluster printers have no forms,,@JOBOBA(S1),.MSCOD(M)) ;[6007]
$RET ;[6000]RETURN TO IPCF MESSAGE PROCESSOR
FORFO2: MOVE S1,.OFLAG(M) ;Get the forms type
MOVEM S1,.EQLIM(J) ;Save it where NXTJOB does
MOVE S1,STREAM ;Get the stream number
SETOM JOBACT(S1) ;Set the stream active
MOVX S2,PSF%OB+PSF%ST+PSF%OR+PSF%AL+PSF%OO
;Get a bunch of bits
ANDCAM S2,JOBSTW(S1) ;And clear them
;**;[6047]AT FORFO2:+5L Delete 4 lines JYCW Feb-23-89
$CALL TBFINI ;Init the buffer
$CALL CHKLPT ;Check for online
;**;[6047]AT FORFO2:+7L Delete 1 line JYCW Feb-23-89
;Since TOPS-20 LPTSPL is a single stream process we can fall down to
;DOFFOR to do the forms change right now instead of from the scheduler.
SUBTTL IPCF Interface -- DOFFOR - Operator Set Forms
; Simply calls the routine to set the forms, sends a reset status message
; to notify QUASAR that the forms change has been effected, and returns
; to the scheduler.
DOFFOR: TXNE S,LATSPL ;[6042]LAT PRINTER
$CALL LATGET ;[6042]Yes, get a LAT connection
JUMPF DOFFO1 ;[6042]No connection, skip match forms
$CALL FORMS ;Try to set the forms
SKIPF ;Did we succeed?
$CALL CHKALN ;Yes, do an alignment if needed
DOFFO1: MOVE S1,STREAM ;[6042]Get the stream number
SETOM JOBUPD(S1) ;Say we want an update message
SETZM JOBSTW(S1) ;Say we want reset message
; defaults since no bits set
$CALL DSTATU ;Tell QUASAR we are done
SKIPG J$LCHN(J) ;[6001] Open device?
SETZM J$RACS+S(J) ;[6001] No, clear status bits
MOVE S1,STREAM ;Get the stream number
SETZM JOBACT(S1) ;No longer active
TXNE S,LATSPL ;[6042]LAT printer?
$CALL LATTHC ;[6042]Yes, release the connect
;**;[6047]At DOFFO1:+10L Replace 1 line JYCW Feb-23-89
$RET ;[6047]Return
SUBTTL IPCF Interface -- KILL - User (or operator) CANCEL Request
KILL: TXNE S,GOODBY+ABORT ;CHECK SOME BITS
$RETT ;IF WE LEAVING, IGNORE IT ANYWAY
TXO S,ABORT ;[6000]LITE THE ABORT BIT
MOVE S1,STREAM ;[6000]GET THE STREAM NUMBER
MOVX S2,PSF%OR+PSF%OO ;[6000]GET OPR RESP WAIT BIT
TDNE S2,JOBSTW(S1) ;[6000]ARE WE WAITING FOR THE OPERATOR?
$KWTOR (JOBWAC(S1)) ;[6000]YES,,KILL THE WTOR
ANDCAM S2,JOBSTW(S1) ;[6000]ZAP THE OPR WAIT BIT
SKIPL J$OPRA(J) ;[6000]Canceled bacause of no eol
IFSKP. ;[6044]
SKIPL J$REMR(J) ;[6044]REQUEST ORIGINATE REMOTELY?
IFSKP. ;[6044]
$WTOJ(<Canceled by User OPERATOR>,<^I/RMJOBI/>,@JOBOBA(S1)) ;[6044]
ELSE. ;[6044]
$WTOJ(<Canceled by User OPERATOR>,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;[6044]
ENDIF. ;[6044]
ELSE. ;[6044]
SKIPL J$REMR(J) ;[6044]REQUEST ORIGINATE REMOTELY?
IFSKP. ;[6044]
MOVE S2,ABO.CD(M) ;[6045]PICK UP WHO CANCELLED THIS JOB
CAIE S2,ABORMU ;[6045]A REMOTE USER?
IFSKP. ;[6045]
$WTOJ(<Canceled by User ^T/ABO.RU(M)/ from node ^N/ABO.ND(M)/>,<^I/RMJOBI/>,@JOBOBA(S1)) ;[6045]
ELSE. ;[6045]
$WTOJ(<Canceled by User ^U/ABO.ID(M)/>,<^I/RMJOBI/>,@JOBOBA(S1)) ;[6044]
ENDIF. ;[6045]
ELSE. ;[6044]
$WTOJ(<Canceled by User ^U/ABO.ID(M)/>,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;[6044]
ENDIF. ;[6044]
ENDIF. ;[6044]
TXNE S,CLUSPL ;[6007] Cluster LPTSPL?
$RETT ;[6007] Yes, return to the caller
SKIPL J$OPRA(J) ;[6007] Canceled because of no eol
IFSKP. ;[6045]
$TEXT(LOGCHR,<^I/LPMSG/Job canceled by user OPERATOR>) ;[6045]
ELSE. ;[6045]
MOVE S2,ABO.CD(M) ;[6045]PICK UP WHO CANCELLED THIS JOB
CAIE S2,ABORMU ;[6045]A REMOTE USER?
IFSKP. ;[6045]
$TEXT(LOGCHR,<^I/LPMSG/Job canceled by user ^T/ABO.RU(M)/ from node ^N/ABO.ND(M)/>)
ELSE. ;[6045]
$TEXT(LOGCHR,<^I/LPMSG/Job canceled by user ^U/ABO.ID(M)/>)
ENDIF. ;[6045]
ENDIF. ;[6045]
SETZM J$OPRA(J) ;Reset the indicator
PUSHJ P,INPFEF ;FORCE END OF FILE
TXNN S,DQSSPL ;[6007] If DQS then return
TXNE S,BANHDR ;ARE WE PRINTING BANNER/HEADER PAGES?
$RETT ;YES,,JUST RETURN
TXNE S,LATSPL!TTYSPL ;[6025]LAT LPTSPL?
$RETT ;[6025]Yes,, just return
PUSHJ P,OUTFLS ;NO,,FLUSH THE OUTPUT BUFFERS
JUMPF SHUTND ;CANT,,SHUT IT DOWN
$RETT ;RETURN
SUBTTL IPCF Interface -- QSRNWA - Shutdown stream whose node dropped
QSRNWA: MOVE S1,STREAM ;GET OUR STREAM NUMBER
MOVX S2,PSF%OR ;GET OPR RESP WAIT BIT
TDNE S2,JOBSTW(S1) ;ARE WE WAITING FOR THE OPERATOR?
$KWTOR (JOBWAC(S1)) ;YES,,KILL THE WTOR
$CALL INPCLS ;[6007] Close input file if any
MOVX S1,%RSUNA ;GET NOT AVAILABLE RIGHT NOW BITS
PUSHJ P,RSETUP ;TELL QUASAR HE CAN HAVE THE OBJ BACK
PUSHJ P,SHUTND ;SHUT THE STREAM DOWN
$RETT ;AND RETURN
SUBTTL IPCF Interface -- DSTATU - Send status info
COMMENT \
The purpose of this routine is to provide a uniform means
of handling checkpointing within a stream. It decides whether to
send status messages.
There are 2 kinds of messages. UPDATE is an update status message
and is sent every time the actual status of the stream changes.
CHKPNT is a checkpoint message that describes the current state
of the job on the stream.
UPDATE is called based on JOBUPD.
CHKPNT is called based on JOBCHK or elapsed time since last CHKPNT. The
time till next checkpoint is set if called. If JOBCHK is 0, CHKPNT
is always called.
THIS IS THE ONLY ROUTINE THAT SHOULD CALL UPDATE OR CHKPNT
No parameters are passed.
Always returns $RET. (Cannot fail)
\ ;End of comment
DSTATU: $SAVE <P1,P2> ;Save 2 perm. registers
MOVE P1,STREAM ;Get the stream number
SKIPE JOBUPD(P1) ;Do we need status update?
$CALL UPDATE ;Do the status update
SETZM JOBUPD(P1) ;Turn flag off
TXNN S,CLUSPL ;[6001] Return if cluster LPTSPL
SKIPN JOBACT(P1) ;Nothing to checkpoint if not active
$RET
;See if it is time to checkpoint yet.
$CALL I%NOW ;Find the time
MOVE P2,S1 ;Save the time
SUB S1,JOBCHK(P1) ;current time - time to checkpoint
SKIPGE S1 ;Time to checkpoint yet?
$RET ;No.
TXNE S,INJOB ;Are we in a JOB?
$CALL CHKPNT ;Yes, do the checkpoint
ADDI P2,CKPTIM*3 ;Add number of 1/3s of seconds
; to the current time
MOVEM P2,JOBCHK(P1) ;Save the time to do next chkpoint
$RET
SUBTTL IPCF Interface -- CHKPNT - Request for Checkpoint
COMMENT \
This routine is to checkpoint the currently active job on the current stream.
It should only be called by DSTATU since that routine will verify that the
stream is currently active. DSTATU will also update the time for the next
checkpoint to occur.
\
CHKPNT: MOVEI T1,MSGBLK ;LOAD THE ADDRESS OF THE MESSAGE BLK.
MOVX S1,CH.FCH!CH.FST ;GET CHECKPOINT AND STATUS FLAGS
STORE S1,CHE.FL(T1) ;AND STORE THEM
MOVE S1,J$RNFP(J) ;GET NUMBER OF FILES
MOVEM S1,CHE.IN+CKFIL(T1) ;STORE IT
MOVE S1,J$RNCP(J) ;GET NUMBER OF COPIES
MOVEM S1,CHE.IN+CKCOP(T1) ;AND STORE IT
MOVE S1,J$RNPP(J) ;GET NUMBER OF PAGES
MOVEM S1,CHE.IN+CKPAG(T1) ;AND STORE IT
MOVE S1,J$APRT(J) ;NUMBER OF PAGES PRINTED
MOVEM S1,CHE.IN+CKTPP(T1) ;AND STORE IT
LOAD S1,.EQITN(J) ;GET JOBS ITN
MOVEM S1,MSGBLK+CHE.IT ;AND STORE IT
MOVX S1,CKFCHK ;CHKPOINT FLAG
MOVEM S1,CHE.IN+CKFLG(T1) ;STORE IT
MOVEI S1,CHE.ST(T1) ;GET ADDRESS OF STATUS AREA
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVEM S1,TEXTBP ;SAVE BYTE POINTER
TXNN S,DQSSPL ;[6001] Skip if DQS
$TEXT(DEPBP,<Started at ^C/J$RTIM(J)/, printed ^D/J$APRT(J)/ of ^D/J$RLIM(J)/ pages^0>)
TXNE S,DQSSPL ;Skip if not DQS
$TEXT(DEPBP,<Started at ^C/J$RTIM(J)/, transmitted ^D/J$APRT(J)/ bytes, ^D/J$RNFP(J)/ files^0>) ;[6001]
HRRZ S1,TEXTBP ;GET THE BYTE POINTER
SUBI S1,MSGBLK-1 ;SUBTRACT START POINT
STORE S1,.MSTYP(T1),MS.CNT ;SAVE THE LENGTH
MOVX S1,.QOCHE ;GET THE FUNCTION CODE
STORE S1,.MSTYP(T1),MS.TYP
PJRST SNDQSR ;AND SEND IT
SUBTTL IPCF Interface -- UPDATE - Send Status Updates
COMMENT \
This routine sends a status update message to QUASAR. It should only
be called by DSTATU since it depends on DSTATU to clear the status
request flag and P1 is set by DSTATU to contain the stream number.
\
UPDATE: MOVE S2,JOBPAG(P1) ;Get the jobpage
SKIPE J$OFLN(S2) ;DN60 offline?
JRST [MOVX S1,%OFLNE ;Yes, set offline
JRST UPDA.5] ;Go to send status
MOVE S2,JOBSTW(P1) ;GET THE JOBS STATUS WORD
MOVX S1,%RESET ;DEFAULT TO RESET
SKIPE J$APRG(J) ;ARE WE ALIGNING FORMS?
MOVX S1,%ALIGN ;YES,,SAY SO
TXNE S2,PSF%OR ;ARE WE WAITING FOR OPR RESPONSE?
MOVX S1,%OREWT ;YES,,SAY SO
TXNE S2,PSF%ST ;ARE WE STOPPED?
MOVX S1,%STOPD ;YES,,SAY SO
TXNE S2,PSF%DO ;ARE WE OFFLINE?
MOVX S1,%OFLNE ;YES,,SAY SO
TXNE S2,PSF%OO ;ARE WE WAITING FOR OPERATOR OUTPUT?
MOVX S1,%OPRWT ;YES,,SAY SO
UPDA.5: MOVEI T1,MSGBLK ;GET THE MESSAGE BLOCK ADDRESS
MOVEM S1,STU.CD(T1) ;SAVE THE STATUS
HRLZ S1,JOBOBA(P1) ;GET THE OBJECT BLOCK ADDRESS
HRRI S1,STU.RB(T1) ;GET DESTINATION ADDRESS
BLT S1,STU.RB+OBJ.SQ-1(T1) ;[6002] Copy the obj blk 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
PUSHJ P,SNDQSR ;SEND IT OFF TH QUASAR
$RETT ;AND RETURN
SUBTTL IPCF Interface -- NXTJOB - Nextjob Message
NXTJOB: HRR S1,J ;GET 0,,DEST
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
MOVE S1,STREAM ;GET STREAM NUMBER
SETOM JOBACT(S1) ;MAKE THE STREAM ACTIVE
SETZM JOBCHK(S1) ;CHECKPOINT FIRST CHANCE WE GET
SETOM JOBUPD(S1) ;Send update also.
SETZM J$REMR(J) ;[6000]ASSUME REQUEST ORIGINATED LOCALLY
LOAD S1,.EQSEQ(J),EQ.RLT ;[6000]PICK UP PRINT JOB ORIGIN
SKIPE S1 ;[6000]DID THE REQUEST ORIGINATE LOCALLY?
SETOM J$REMR(J) ;[6000]NO, INDICATE SO
MOVX S2,PSF%OB+PSF%ST+PSF%OR+PSF%AL+PSF%OO ;GET LOTS OF BITS
ANDCAM S2,JOBSTW(S1) ;CLEAR THEM
MOVEI S1,J$RPDL-1(J) ;POINT TO CONTEXT PDL
HRLI S1,-PDSIZE ;AND THE LENGTH
MOVEI S2,DOJOB ;[6001] Assume local job
TXNE S,CLUSPL ;[6001] Cluster spooler?
MOVEI S2,CLJOB ;[6001] Yes
TXNE S,DQSSPL ;[6001] DQS spooler?
MOVEI S2,DQSJOB ;[6001] Point to DQS place
PUSH S1,S2 ;[6001] Store new stream starting place
MOVEM S1,J$RACS+P(J) ;AND STORE THE PDL
LOAD S1,.EQSPC(J),EQ.NUM ;GET NUMBER OF FILES
MOVEM S1,J$RFLN(J) ;STORE IT
MOVEI S1,J$$BEG(J) ;PREPARE TO ZERO SELECTED WORDS JOB AREA
MOVSI S2,-<J$$LEN+^D35>/^D36 ;AOBJN POINTER TO BIT TABLE
NXTJ.2: MOVEI T1,^D36 ;BIT COUNTER FOR THIS WORD
MOVE T2,ZTABLE(S2) ;GET A WORD FROM BIT TABLE
NXTJ.3: JUMPE T2,NXTJ.4 ;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 NXTJ.3 ;AND LOOP
NXTJ.4: ADD S1,T1 ;ACCOUNT FOR THE REST OF THE WORD
AOBJN S2,NXTJ.2 ;AND LOOP
TXNE S,CLUSPL ;[6001] Cluster LPTSPL?
PJRST FIXCLU ;[6000] Yes, fixup some
TXNE S,DQSSPL ;[6001] DQS Printer?
$CALL DQSFIX ;[6001] Yes, perform NXTJOB functions
TXNN S,LATSPL ;[6005] LAT printer?
JRST NXTJ.5 ;[6016] No
$CALL LATGET ;[6005] Have to reconnect the LAT line
JUMPT NXTJ.5 ;[6023] Connect and setup successful
PUSHJ P,RSETUP ;[6023] Release the object
PUSHJ P,SHUTIN ;[6030] Shut the stream down
$RETT ;[6023] And return
;Continued on next page
;Continued from previous page
;[6001] Fill in the log
NXTJ.5: $TEXT(LOGCHR,<^M^J^I/LPDAT/LPTSPL version ^V/LPTVNO/ ^T93/LPCNF/>) ;[6022]
MOVE S1,STREAM ;GET THE STREAM NUMBER
$TEXT(LOGCHR,<^I/LPDAT/Job ^W/.EQJOB(J)/ sequence #^D/.EQSEQ(J),EQ.SEQ/ on ^B/@JOBOBA(S1)/ at ^H/[-1]/>)
SKIPN T2,.EQCHK+CKFLG(J) ;GET THE CHECKPOINT FLAGS
JRST NXTJ.6 ;[6000]AND JUMP IF NEW JOB
MOVEI T1,[ASCIZ /system failure/]
TXNE T2,CKFREQ ;WAS IT A REQUEUE
MOVEI T1,[ASCIZ /requeue by operator or spooler/] ;[6010]
$TEXT(LOGCHR,<^I/LPMSG/Job being restarted after ^T/0(T1)/>)
NXTJ.6: LOAD S1,.EQSEQ(J),EQ.IAS ;[6000]PICK UP INVALID ACCOUNT BIT
SKIPE S1 ;IS THIS AN INVALID REQUEST?
$TEXT (LOGCHR,<^I/LPERR/Invalid account string specified (^T/.EQACT(J)/)>) ;[6010]
GETLIM T1,.EQLIM(J),OLIM ;GET PAGE LIMIT
MOVEM T1,J$RLIM(J) ;SAVE IT
PUSHJ P,ACTBEG ;GO SETUP THE ACCOUNTING PARMS
PUSHJ P,I%NOW ;GET TIME OF DAY
MOVEM S1,J$RTIM(J) ;SAVE IT AWAY
MOVE S1,STREAM ;GET STREAM NUMBER.
SKIPL J$REMR(J) ;[6044]DID REQUEST ORIGINATE REMOTELY?
IFSKP. ;[6044]
$WTOJ (Begin,<^I/RMJOBI/>,@JOBOBA(S1)) ;[6044]
ELSE. ;[6044]
$WTOJ (Begin,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;[6044]
ENDIF. ;[6044]
SKIPGE J$LREM(J) ;[6001] Skip if local mode
$RETT ;[6001] Return
PUSHJ P,TBFINI ;INITIALIZE THE BUFFER
PUSHJ P,CHKLPT ;GO MAKE SURE THE DEVICE IS ONLINE
$RETT ;AND RETURN
SUBTTL IPCF Interface -- SETUP - Setup/Shutdown Message
;Here to process the SETUP message.
SETUP: LOAD S1,SUP.FL(M) ;GET THE FLAGS
TXNE S1,SUFSHT ;IS IT A SHUTDOWN?
JRST SHUTDN ;IF SO,,SHUT IT DOWN
SETZ T2, ;CLEAR A LOOP REG
SETU.1: SKIPN JOBPAG(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)
SETU.2: MOVEM T2,STREAM ;SAVE THE STREAM NUMBER
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
PUSHJ P,M%AQNP ;ALLOCATE THEM
PG2ADR S1 ;CONVERT TO AN ADDRESS
MOVEM S1,JOBPAG(T2) ;AND SAVE IT
MOVE J,S1 ;PUT IT IN J
SETZM JOBSTW(T2) ;CLEAR THE JOB STATUS WORD
MOVEM J,J$RACS+J(J) ;SAVE J AWAY
MOVEI S1,J$LBFR(J) ;LPT BUFFER ADDRESS
MOVEM S1,J$LBUF(J) ;STORE IT
MOVEI S1,J$GBFR(J) ;LOG FILE BUFFER PAGE (FIRST)
MOVEM S1,J$GBUF(J) ;SAVE IT AWAY
MOVE S2,T2 ;COPY OVER THE STREAM NUMBER
IMULI T2,OBJ.SQ ;[6002] Get offset of object block
ADDI T2,JOBOBJ ;ADD IN THE BASE
MOVEM T2,JOBOBA(S2) ;STORE OBJECT ADDRESS
MOVE S2,T2 ;GET DESTINATION OF BLT INTO S2
HRLI S2,SUP.TY(M) ;MAKE A BLT POINTER
BLT S2,OBJ.SQ-1(T2) ;[6002] BLT the object block
;Continued on next page
;Continued from previous page
;Check the setup message to determine what kind of spoooler we are today.
;
; LOCSPL local spooler
; LOCSPL!SPLTAP Spooling to a device (device will be TTY or MTA)
; CLUSPL cluster spooler
; DQSSPL DQS spooler
; (none) DN60 spooler (SUP.CN in setup message nonzero)
SETZB S2,J$LREM(J) ;[6001] Default to local LPT
MOVE S,SUP.FL(M) ;[6006] Pick up the LPT type
SETUP0: SKIPE SUP.CN(M) ;[6006] Is it a DN60?
MOVX S,D60SPL ;[6006] Yes, update the LPT type
;If we are a local/spooling to tape LPTSPL or DN60 LPTSPL, go off and handle.
TXNE S,D60SPL ;[6001] DN60?
JRST SETU.3 ;[6001] Yes
TXNE S,LOCSPL ;[6002] Local?
JRST SETU.4 ;[6002] Check for spooling to tape
;Continued on the next page
;Continued from the previous page
;Here to set the device name and J$LREM bits for cluster, DQS, LAT LPTSPL.
SETU.F: TXNN S,CLUSPL ;[6006] Is it a cluster LPT?
JRST SETU.A ;[6001] No
$CALL INILNK ;[6001] Init and open decnet link
MOVX S2,.JREML!.JLCLU ;[6001] Cluster LPT, indicate so
MOVX T1,'CLU' ;[6001] Indicate spooling type
JRST SETU.D ;[6001] Continue below
SETU.A: TXNN S,DQSSPL ;[6006] Is it a DQS LPT?
JRST SETU.C ;[6001] No
$CALL DQSINI ;[6001] Maybe open DECnet link
MOVX S2,.JREML!.JLDQS ;[6001] DQS LPT, indicate so
MOVX T1,'DQS' ;[6001] Indicate spooling type
JRST SETU.D ;[6001] Continue below
SETU.C: TXNN S,LATSPL ;[6006] LAT LPTSPL?
JRST SETU.E ;[6002] No, Unknow printer type
MOVE S1,SUP.CR(M) ;[6005] Get terminal characteristic
MOVEM S1,J$TTYC(J) ;[6005] Save it
;**;[6046]At SETU.C:+3L replace 1 line with 2 JYCW 1/16/89
TXO S,INTRPT ;[6046]Indicate we're connected
MOVX S1,%RSUOK ;[6046]Load the code
MOVX S2,.JREML!.JLLAT ;[6001] Set the flags
MOVX T1,'LAT' ;[6001] Indicate spooling type
JRST SETU.6 ;[6005] Continue below
;Here if a non-local non-TTY non-DN60 LPTSPL, with
; S1/ response to setup code
; S2/ remote spooler bits
; T1/setup with SIXBIT spooler (device) type
; S/ is setup with the spooler mode bits
; TF/ TRUE if the setup went OK or FALSE to shutdown
SETU.D: MOVEM S2,J$LREM(J) ;[6001] Remember type of printer we are
MOVEM T1,J$LDEV(J) ;[6001] Save device type (spooler mode)
TXNE S,CLUSPL ;[6001] Cluster LPTSPL?
JUMPF SETU.7 ;[6000] Yes, shutdown if fatal error
JRST SETU.6 ;[6000] No, send the setup response
SETU.E: MOVEI S1,%RSUDE ;[6002] Unknown printer type, shutdown
JRST SETU.6 ;[6002] Go send the RESPONSE message
;Continued on the next page
;Continued from the previous page
;Here on a setup of DN60 spooler
SETU.3: ;[6001] Here if DN60 LPT
IFN FTDN60,<
MOVX S1,.JDN60 ;[6000]INDICATE DN60 LPT
MOVEM S1,J$LREM(J) ;[6000]REMEMBER THAT DN60 LPT
HRLI S1,SUP.CN(M) ;DN60,,GET LINE CONDITIONING BLK ADDRESS
HRRI S1,J$DCND(J) ; AND WHERE TO PUT IT
BLT S1,J$DCND+CN$SIZ-1(J) ;COPY IT OVER
MOVE S1,SUP.ST(M) ;GET THE DN60 FLAG WORD
MOVEM S1,J$DFLG(J) ;SAVE IT FOR LATER
SETOM J$ENBR(J) ;We initally don't care about NBR errs.
> ;End IFN DN60
JRST SETU.5 ;[6000]GO SETUP OUTPUT DEVICE
;Here on setup of a local LPTSPL, check for spooling to tape
SETU.4: TXNN S,SPLTAP ;[6006] Spooling to tape or TTY?
JRST SETU.5 ;[6001] Nope
MOVE S2,SUP.ST(M) ;[6000] Get device name
MOVEM S2,J$MTAP(J) ;[6001] Save the device name
MOVEM S2,J$LDEV(J) ;[6001] Save device for accounting too
;Check to see in the device specified for spooling is a TTY
;*** Add code here to do this ***
TXC S,SPLTAP!LOCSPL!TTYSPL ;[6001] It is a TTY spooler now
;Continued on next page
;Continued from previous page
;Here to set up output device (DN60, local printer, tape, TTY)
SETU.5: ;[6000]
IFN FTDN60<
SETZM J$CWKT(J) ;Init this in any case
> ; End of IFN DN60
SETOM J$LCHN(J) ;INDICATE NO OUTPUT CHANNEL YET.
PUSHJ P,OUTGET ;GET THE OUTPUT DEVICE
;Here to send the response to setup message or the shutdown message if an
;error setting up.
SETU.6: PUSH P,S1 ;[6000]SAVE THE RESPONSE CODE
PUSHJ P,RSETUP ;SEND THE RESPONSE TO SETUP MSG.
POP P,T2 ;GET THE RESPONSE CODE BACK
MOVE S1,STREAM ;GET STREAM NUMBER
AOS S2,STRSEQ ;ADD 1 TO THE STREAM SEQ #, PUT IN S2.
MOVEM S2,JOBWAC(S1) ;SAVE IT AS THE OPR WTOR ACK CODE.
$WTO (<^T/@SETMSG(T2)/>,,@JOBOBA(S1)) ;TELL THE OPR WHATS GOING ON.
SETZM JOBITS ;[6027] Insure that S is stored
CAIE T2,%RSUOK ;ALL IS OK?
SETU.7: $CALL SHUTND ;[6000]NO, SHUT IT DOWN
$RETT ;RETURN
SETMSG: [ASCIZ/Started/] ;[6012] %RSUOK
[ASCIZ/Not available right now/] ;[6012] %RSUNA
[ASCIZ/Does not exist/] ;[6012] %RSUDE
SUBTTL IPCF Interface -- SHUTDN - Shut Down A Printer
SHUTDN: MOVEI S1,SUP.TY(M) ;GET THE OBJECT BLOCK ADDRESS
PUSHJ P,FNDOBJ ;FIND THE OBJECT BLOCK
JUMPF .RETT ;NO OBJECT,,THEN NOTHING TO SHUT DOWN
SHUTND: SKIPA T4,[EXP 0] ;INDICATE 'OUT OF STREAM' CONTEXT
SHUTIN: SETOM T4 ;INDICATE 'IN STREAM' CONTEXT
$CALL INPCLS ;[6007] Close input file if open
SKIPE T4 ;ARE WE IN STREAM CONTEXT?
MOVE P,[IOWD PDSIZE,PDL] ;YES,,GET A NEW STACK POINTER
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 JOBPAG ADDRESS
ADR2PG S2 ;CONVERT TO A PAGE NUMBER
PUSHJ P,M%RLNP ;RETURN THEM
SETOM JOBITS ;SAY WE DONT WANT TO SAVE STATUS BITS.
MOVE S1,STREAM ;GET OUR STREAM NUMBER
SETZM JOBPAG(S1) ;CLEAR THE PAGE WORD
SETZM JOBACT(S1) ;AND THE ACTIVE WORD
MOVX S2,PSF%OR ;GET OPR RESP WAIT BIT
TDNE S2,JOBSTW(S1) ;ARE WE WAITING FOR THE OPERATOR?
$KWTOR (JOBWAC(S1)) ;YES,,KILL THE WTOR
SETZM JOBWAC(S1) ;Clear it just in case
MOVEI S2,OUTREL ;[6001] Assume local release routine
TXNE S,LATSPL ;[6025] Is this a LAT LPTSPL?
MOVEI S2,LATABT ;[6037] LAT LPTSPL release
TXNE S,CLUSPL ;[6001] Is this a cluster LPTSPL?
MOVEI S2,CLNCLU ;[6001] Cluster LPTSPL release
TXNE S,DQSSPL ;[6001] Is this a DQS LPTSPL?
MOVEI S2,DQSREL ;[6001] No load local release routine
TXNN S,CLUSPL!DQSSPL ;[6001] Is this a DQS/cluster LPTSPL?
SKIPL J$LCHN(J) ;[6001] No, do we have an output ch?
PUSHJ P,(S2) ;[6001] Release the object
SKIPE S1,J$TDEV(J) ;[6005] Get device designator
RELD ;[6005] Release the TTY
JFCL ;[6005] Ignore error
; THIS IS FOR PROGRAMMABLE TERMINALS
; HRRZ S1,J$VJFN(J) ;[6005] Get JFN of TTY VFU
; SKIPE S1 ;[6005] None
; CLOSF ;[6005] Close the TTY VFU
; JFCL ;[6005] Ignore error
JUMPE T4,.RETT ;'OUT OF STREAM',,JUST RETURN
JRST MAIN.3 ;'IN STREAM',,RETURN TO THE SCHEDULER
SUBTTL IPCF Interface -- RSETUP - Send A Response-To-Setup
;Here to send the response to setup message back to QUASAR.
RSETUP: MOVE T2,S1 ;SAVE THE SETUP CONDITION CODE.
MOVEI S1,RSU.SZ ;GET MESSAGE LENGTH
MOVEI S2,MSGBLK ;AND THE ADDRESS OF THE BLOCK
PUSHJ P,.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
MOVE S1,STREAM ;GET STREAM NUMBER
MOVS S1,JOBOBA(S1) ;GET OBJADR,,0
HRRI S1,RSU.TY(T1) ;AND PLACE TO MOVE IT TO
BLT S1,RSU.TY+OBJ.SQ-1(T1) ;[6002] and move the object block
STORE T2,RSU.CO(T1) ;STORE THE RESPONSE CODE
MOVX S1,%LOWER ;GET LOWER-CASE BIT
SKIPL J$LLCL(J) ;IS PRINT LOWER CASE?
MOVX S1,%UPPER ;NO, LOAD THE UPPER CASE FLAG
TXNE S,CLUSPL!LATSPL!DQSSPL ;[6033]IS THIS A CLUSTER OR REMOTE LPT?
SETZ S1, ;[6031]YES, DON'T SET ANY ATTRIBUTES
STORE S1,RSU.DA(T1),RO.ATR ;STORE THE DEVICE ATTRIBUTES
TXNN S,LATSPL!TTYSPL ;[6005] LAT or TTY spooling?
JRST RSETU ;[6005] No need to add TTY charact
MOVE S2,J$TTYC(J) ;[6005] Get the terminal characteristic
MOVEM S2,RSU.CR(T1) ;[6005] Store it
RSETU: PUSHJ P,SNDQSR ;AND SEND THE MESSAGE
$RETT ;RETURN.
SUBTTL IPCF Interface -- OACRSP - Response to a WTOR
OACRSP: SETOM JOBITS ;DON'T UPDATE STATUS BITS
MOVE S2,.MSCOD(M) ;GET WTOR ACK CODE.
MOVSI S1,-NPRINT ;CREATE AOBJN AC.
RESP.1: CAME S2,JOBWAC(S1) ;COMPARE ACK CODES..
JRST [AOBJN S1,RESP.1 ;NOT EQUAL,,CHECK NEXT STREAM.
$RETT ] ;NOT THERE,,FLUSH THE MSG.
MOVX S2,PSF%OR+PSF%OO ;GET "OPERATOR-RESPONSE" WAIT BIT
ANDCAM S2,JOBSTW(S1) ;AND CLEAR IT
MOVE J,JOBPAG(S1) ;GET THE STREAM DB ADDRESS.
DMOVE S1,.OHDRS+ARG.DA(M) ;GET THE OPERATORS RESPONSE.
DMOVEM S1,J$RESP(J) ;AND SAVE IT.
$RETT ;AND RETURN
SUBTTL IPCF Interface -- OACCAN - Operator Abort Request
OACCAN: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVE P1,STREAM ;GET STREAM NUMBER.
SKIPL J$REMR(J) ;[6044]REQUEST ORIGINATE REMOTELY?
IFSKP. ;[6044]
$ACK(Aborting,<^I/RMJOBI/>,@JOBOBA(P1),.MSCOD(M)) ;[6044]TELL THE OPR
ELSE. ;[6044]
$ACK(Aborting,<^R/.EQJBB(J)/>,@JOBOBA(P1),.MSCOD(M)) ;[6044]TELL THE OPR
ENDIF. ;[6044]
SETZM J$APRG(J) ;ALIGNMENT NOT SCHEDULED,,NOT ACTIVE
SETZM JOBWKT(P1) ;SET WAKE UP TIME TO NOW.
SETZM RSNFLG ;SHOW NO REASON GIVEN.
MOVX S1,PSF%OR+PSF%OO ;GET OPR RESP WAIT BIT
TDNE S1,JOBSTW(P1) ;ARE WE WAITING FOR THE OPERATOR?
$KWTOR (JOBWAC(P1)) ;YES,,KILL THE WTOR
ANDCAM S1,JOBSTW(P1) ;ZAP THE OPR WAIT BIT
;Loop thru the message from ORION and pick it apart.
OACC.0: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF OACC.2 ;NO MORE,,FINISH UP
CAIN T1,.ORREA ;IS THIS THE REASON BLOCK?
MOVEM T3,RSNFLG ;YES,,SAVE THE REASON ADDRESS
CAIE T1,.CANTY ;IS THIS THE CANCEL TYPE BLOCK?
JRST OACC.0 ;NO,,SKIP IT AND GET NEXT BLOCK
;YES...
MOVE S1,0(T3) ;LOAD THE CANCEL TYPE.
CAIE S1,.CNPRG ;IS IT /PURGE?
JRST OACC.0 ;NO,,PROCESS THE NEXT MSG BLK
TXNE S,CLUSPL ;[6001] Is this a Cluster LPTSPL?
JRST OACC.4 ;[6000]GO LITE ABORT BIT AND RETURN
;Here to cancel the request when the cancel type block is seen
$CALL INPCLS ;[6007] Close the input file if any
MOVEM S,J$RACS+S(J) ;SAVE THE 'S' AC WITH NEW DSKOPN BITS
TXNE S,DQSSPL ;[6001] DQS spooler?
JRST OACC.1 ;[6001] Yes, skip flushing output
TXNE S,LATSPL!TTYSPL ;[6025]LAT or TTY spooler?
JRST OACC.1 ;[6025]Yes, skip flushing output
PUSHJ P,OUTFLS ;FLUSH THE OUTPUT BUFFERS
JUMPF SHUTND ;CANT,,SHUT IT DOWN
PUSHJ P,SENDFF ;OUTPUT A FORM FEED FOR NEXT JOB
OACC.1: SETZM JOBACT(P1) ;STREAM IS NO LONGER ACTIVE
PUSHJ P,QRELEA ;RELEASE THE REQUEST
PUSHJ P,OUTEOF ;OUTPUT AN EOF
$RETT ;AND RETURN
;Here when all message blocks read to abort the request
OACC.2: TXNE S,CLUSPL ;[6001] Cluster LPTSPL?
JRST OACC.4 ;[6000] Yes, lite ABORT bit and return
OACC.3: $TEXT(LOGCHR,<^I/LPOPR/Job Aborted by the Operator>)
SKIPE RSNFLG ;WAS A REASON GIVEN?
$TEXT (LOGCHR,<^I/LPOPR/ REASON: ^T/@RSNFLG/>) ;YES,,SAY SO
SKIPN RSNFLG ;WAS A REASON GIVEN?
$TEXT (LOGCHR,<^I/LPOPR/ No reason given>) ;NO,,SAY SO
TXO S,ABORT ;TELL LPTSPL WE ARE LEAVING.
TXNE S,GOODBY ;ARE WE ON OUR WAY OUT?
$RETT ;YES,,JUST RETURN
PUSHJ P,INPFEF ;FORCE SPOOL FILE EOF
TXNE S,BANHDR ;ARE WE PRINTING BANNER/HEADER PAGES?
$RETT ;YES,,JUST RETURN
TXNN S,LATSPL!TTYSPL ;[6025]LAT or TTY?
TXNE S,DQSSPL ;[6001] DQS spooler?
$RETT ;[6001] yes, return now
PUSHJ P,OUTFLS ;NO,,FLUSH THE OUTPUT BUFFERS
JUMPF SHUTND ;CANT,,SHUT IT DOWN
$RETT ;FUNCTION COMPLETE
OACC.4: TXO S,ABORT ;[6000]TELL LPTSPL WE ARE LEAVING.
$RETT ;[6000]RETURN TO THE IPCF PROCESSOR
SUBTTL IPCF Interface -- OACSUP - Operator SUPPRESS Request
OACSUP: TXNE S,ABORT+RQB+GOODBY ;ARE WE ON OUR WAY OUT?
PJRST TOOBAD ;YES,,SKIP THIS.
;Here to pick apart the suppress message to get the arguments.
OACS.0: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF .RETT ;NO MORE,,JUST RETURN
CAIN T1,.SUPFL ;IS IT SUPPRESS FILE?
PJRST OACS.1 ;YES,,THEN GO PROCESS IT AND RETURN
CAIN T1,.SUPJB ;IS IT SUPPRESS JOB?
JRST OACS.2 ;YES,,THEN GO PROCESS IT AND RETURN
CAIE T1,.SUPST ;IS IT STOP SUPPRESSION?
JRST OACS.0 ;NO,,GO PROCESS NEXT MSG BLOCK
TXZ S,SUPJOB!SUPFIL ;TURN OFF SUPPRESS FILE AND JOB BIT
$TEXT (LOGCHR,<^I/LPOPR/Operator stopped carriage control supression>)
MOVE S1,STREAM ;GET STREAM NUMBER.
SKIPL J$REMR(J) ;[6044]REQUEST ORIGINATE REMOTELY?
IFSKP. ;[6044]
$ACK (Carriage control activated,<^I/RMJOBI/>,@JOBOBA(S1),.MSCOD(M))
ELSE. ;[6044]
$ACK (Carriage control activated,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
ENDIF. ;[6044]
$RETT ;RETURN NOW
OACS.1: TXO S,SUPFIL ;TURN ON SUPPRESS FILE BIT.
TXZ S,SUPJOB ;TURN OFF SUPPRESS JOB BIT.
MOVEI S1,[ASCIZ/this file/] ;GET THIS FILE MSG.
JRST OACS.3 ;LETS MEET AT THE PASS
OACS.2: TXO S,SUPJOB ;TURN ON SUPPRESS JOB BIT.
TXZ S,SUPFIL ;TURN OFF SUPPRESS FILE BIT.
MOVEI S1,[ASCIZ/this job/] ;GET THIS JOB MSG.
OACS.3: $TEXT(LOGCHR,<^I/LPOPR/Operator suppressed carriage control for rest of
^T/0(S1)/>)
MOVE S1,STREAM ;GET STREAM NUMBER.
SKIPL J$REMR(J) ;[6044]REQUEST ORIGINATE REMOTELY?
IFSKP. ;[6044]
$ACK (Carriage control suppressed,<^I/RMJOBI/>,@JOBOBA(S1),.MSCOD(M))
ELSE. ;[6044]
$ACK (Carriage control suppressed,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
ENDIF. ;[6044]
$RETT ;RETURN NOW
SUBTTL IPCF Interface -- OACPAU - Operator STOP Request
OACPAU: MOVX S2,PSF%ST ;LOAD THE STOP BIT
MOVE S1,STREAM ;GET THE STREAM NUMBER
IORM S2,JOBSTW(S1) ;SET IT
$ACK (Stopped,,@JOBOBA(S1),.MSCOD(M)) ;TELL THE OPERATOR.
SETZM JOBCHK(S1) ;SAY WE WANT A CHECKPOINT TAKEN.
SETOM JOBUPD(S1) ;Update the status also.
$RETT ;AND RETURN
SUBTTL IPCF Interface -- OACCON - Operator CONTINUE request
OACCON: MOVE S1,STREAM ;GET THE STREAM NUMBER
MOVX S2,PSF%ST!PSF%DO ;LOAD THE BITS
ANDCAM S2,JOBSTW(S1) ;CLEAR IT
$ACK (Continued,,@JOBOBA(S1),.MSCOD(M)) ;TELL THE OPERATOR.
SETOM JOBUPD(S1) ;Do an update
; don't need checkpoint
; did one when we stopped
$RETT ;AND RETURN
SUBTTL IPCF Interface -- OACREQ - Operator REQUEUE request
OACREQ: TXNE S,GOODBY ;IS IT TOO LATE FOR THIS?
PJRST TOOBAD ;YES,,TOUGH LUCK
TXO S,RQB+ABORT ;LITE THE REQUEUE+ABORT BITS
MOVE S1,STREAM ;GET THE STREAM NUMBER
SKIPL J$REMR(J) ;[6044]REQUEST ORIGINATE REMOTELY?
IFSKP. ;[6044]
$ACK (Requeued,<^I/RMJOBI/>,@JOBOBA(S1),.MSCOD(M)) ;[6044]TELL OPR
ELSE. ;[6044]
$ACK (Requeued,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M)) ;[6044]TELL OPR
ENDIF. ;[6044]
MOVX S2,PSF%OR!PSF%OO ;GET OPR RESP WAIT BIT
TDNE S2,JOBSTW(S1) ;ARE WE WAITING FOR THE OPERATOR?
$KWTOR (JOBWAC(S1)) ;YES,,KILL THE WTOR
ANDCAM S2,JOBSTW(S1) ;ZAP THE OPR WAIT BIT
TXNE S,CLUSPL ;[6001] Yes, is this a cluster LPTSPL?
$RETT ;[6001] Yes, return to IPCF processor
PUSHJ P,INPFEF ;FORCE AN INPUT EOF
$TEXT(LOGCHR,<^I/LPOPR/Job requeued by the the operator>)
;Loop through the message to look for the request type and reason blocks.
OACR.1: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF .RETT ;NO MORE,,RETURN
CAIN T1,.REQTY ;IS THIS THE REQUEST TYPE BLOCK?
JRST OACR.2 ;YES,,GO PROGESS IT
CAIN T1,.ORREA ;IS THIS THE REASON BLOCK?
$TEXT (LOGCHR,<^I/LPOPR/Requeue reason is: ^T/0(T3)/.>)
JRST OACR.1 ;PROCESS THE NEXT MSG BLOCK
;Here when seeing the request type block
OACR.2: MOVE S1,0(T3) ;PICK UP THE REQUEUE CODE.
TXNN S,DQSSPL ;[6026] DQS reques from begin of job
JRST OACR.6 ;[6001] Check other requeue codes
CAXE S1,.RQBJB ;[6001] Beginning of job?
$WTO (DQS Requeue,<DQS job requeued from beginning of job>,@JOBOBA)
JRST OACR.1 ;[6001] Yes, all set
;Fetch requeue type and zero things based on requeue keyword, write to log.
OACR.6: SETZ S2, ;ZERO AC 2
CAXN S1,.RQCUR ;/CURRENT?
JRST OACR.4 ;YES, DO IT
SETZM J$RNPP(J) ;CLEAR CURRENT PAGE NUMBER
CAXN S1,.RQBCP ;BEGINNING OF COPY?
MOVEI S2,[ASCIZ /current copy/]
TXNN S,DQSSPL ;[6001] DQS reques from begin of job
JUMPN S2,OACR.3 ;AND CONTINUE ON
SETZM J$RNCP(J) ;CLEAR CURRENT COPY NUMBER
CAXN S1,.RQBFL ;FROM BEGINING OF FILE?
MOVEI S2,[ASCIZ /current file/]
TXNN S,DQSSPL ;[6001] DQS reques from begin of job
JUMPN S2,OACR.3 ;AND CONTINUE ON
OACR.5: SETZM J$RNFP(J) ;CLEAR FILE COUNT
MOVEI S2,[ASCIZ /job/] ;FROM BEGINNING OF JOB
OACR.3: $TEXT(LOGCHR,<^I/LPOPR/Job will restart at the beginning of the ^T/0(S2)/>)
JRST OACR.1 ;Go process the next msg block.
OACR.4: $TEXT(LOGCHR,<^I/LPOPR/Job will restart at the current position>)
MOVNI S1,2 ;LOAD -2
ADDM S1,J$RNPP(J) ;INSURE NO LOSSAGE OF DATA
ADDM S1,J$APRT(J) ;HERE ALSO
SKIPGE J$RNPP(J) ;MAKE SURE WE DIDN'T SCREW THINGS UP
SETZM J$RNPP(J) ;YES,,ZERO THE PAGES PER COPY
SKIPGE J$APRT(J) ;CHECK HERE ALSO
SETZM J$APRT(J) ;NO GOOD,,SET IT TO ZERO
JRST OACR.1 ;[6001] Go process the next msg block
SUBTTL IPCF Interface -- OACALI - Operator ALIGN request
; J$APRG(J) :: [?,,-1] = ALIGN IN PROGRESS.
; [-1,,?] = ALIGN NEEDS TO BE SCHEDULED.
OACALI: TXNE S,ABORT+RQB+GOODBY ;ARE WE ON OUR WAY OUT?
PJRST TOOBAD ;YES,,SKIP THIS.
SETZM FDADDR ;RESET ALIGN FD ADDRESS.
OALI.0: PUSHJ P,GETBLK ;GET A MESSAGE DATA BLOCK
JUMPF OALI.1 ;NO MORE,,CONTINUE PROCESSING
MOVE S1,0(T3) ;GET THE FIRST DATA WORD IN THE BLOCK
MOVEI T3,-1(T3) ;POINT TO THE BLOCK HEADER
CAIN T1,.ALPAU ;IS THIS THE /PAUSE BLOCK?
MOVEM S1,J$ASLP(J) ;YES,,SAVE THE SLEEP TIME
CAIN T1,.ALRPT ;IS THE THE /REPEAT-COUNT BLOCK?
MOVEM S1,J$ACNT(J) ;YES,,SAVE THE REPEAT-COUNT
CAIN T1,.CMIFI ;IS THIS THE FILE-SPEC BLOCK?
MOVEM T3,FDADDR ;SAVE THE FD ADDRESS
CAIN T1,.ALSTP ;IS THIS THE /STOP BLOCK?
PJRST OALI.6 ;YES,,GO PROCESS IT AND RETURN
JRST OALI.0 ;NONE OF THESE,,TRY NEXT BLOCK
OALI.1: SKIPN J$APRG(J) ;ARE WE ALREADY ALIGNING?
JRST ALISCD ;[6007] NO,,THEN WE'RE OK
MOVE S1,STREAM ;YES,,GET STREAM NUMBER.
$ACK (ALIGN already in progress,,@JOBOBA(S1),.MSCOD(M))
$RETT ;RETURN NOW.
;Continued on next page
;Continued from previous page
OALI.6: SKIPE J$APRG(J) ;ARE WE ALREADY ALIGNING?
JRST OALI.7 ;IF SO,,CONTINUE PROCESSING.
MOVE S1,STREAM ;GET STREAM NUMBER
$ACK (</STOP Illegal>,Alignment not in Progress,@JOBOBA(S1),.MSCOD(M))
$RETT
OALI.7: MOVE S1,J$AIFN(J) ;GET THE ALIGN IFN.
SETOB S2,J$ABYT(J) ;SET ALIGN FILE BYTE COUNT TO -1.
PUSHJ P,F%POS ;POSITION TO ALIGN EOF.
SETZM J$ACNT(J) ;SET REPEAT-COUNT TO 0.
MOVE S1,STREAM ;GET STREAM NUMBER
$ACK (Alignment Discontinued,,@JOBOBA(S1),.MSCOD(M))
$RETT ;AND RETURN
SUBTTL IPCF Interface -- OACFWS - Operator Forward Space Command
OACFWS: TXNE S,ABORT+RQB+GOODBY ;ARE WE ON OUR WAY OUT?
PJRST TOOBAD ;YES,,SKIP THIS.
MOVE S1,STREAM ;GET THE STREAM NUMBER.
SETZM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT.
OACF.0: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF .RETT ;NO MORE,,RETURN
CAIN T1,.SPPAG ;IS THIS FORWARD SPACE PAGES?
PJRST FSPACE ;YES,,DO IT
CAIN T1,.SPCPY ;IS THIS FORWARD SPACE COPIES?
PJRST FCOPYS ;YES,,DO IT
CAIN T1,.SPFIL ;IS THIS FORWARD SPACE 1 FILE?
PJRST FFILES ;YES,,DO IT
JRST OACF.0 ;NONE OF THESE,,TRY NEXT BLOCK
FSPACE: SKIPN J$DIFN(J) ;IS THERE A SPOOL FILE OPEN?
$RETT ;NO,,JUST IGNORE THIS
TXO S,FORWRD ;TURN ON FORWARD SPACE BIT.
MOVE S2,0(T3) ;PICK UP # OF PAGES TO FSPACE.
ADDM S2,J$FPIG(J) ;SAVE THE VALUE.
MOVE S1,STREAM ;PICK UP THE STREAM NUMBER.
$ACK (<Forward spaced ^D/S2/ Pages>,,@JOBOBA(S1),.MSCOD(M))
MOVE S1,J$TFIL(J) ;[6007] Load the file type
$TEXT (LOGCHR,<^I/LPMSG/File ^I/@FILTYP(S1)/ Forward spaced ^D/S2/ pages>) ;[6007]
$RETT ;AND RETURN
FCOPYS: MOVE S2,0(T3) ;PICK UP THE # OF COPIES TO FSPACE.
ADDM S2,J$RNCP(J) ;ADD TO # OF COPIES ALREADY PRINTED.
MOVE S1,J$TFIL(J) ;[6007] Pick up file type
$TEXT (LOGCHR,<^I/LPMSG/File ^I/@FILTYP(S1)/ Forward spaced ^D/S2/ copies>) ;[6007]
MOVE S1,STREAM ;PICK UP THE STREAM NUMBER.
$ACK (<Forward Spaced ^D/S2/ Copies>,,@JOBOBA(S1),.MSCOD(M))
PUSHJ P,INPFEF ;FORCE AN END-OF-FILE.
$RETT ;AND RETURN
FFILES: MOVE S1,STREAM ;PICK UP THE STREAM NUMBER
$ACK (Forward Spaced 1 File,,@JOBOBA(S1),.MSCOD(M))
MOVE S2,J$TFIL(J) ;[6007] Pick up file type
$TEXT (LOGCHR,<^I/LPMSG/File ^I/@FILTYP(S2)/ Skipped by Operator>) ;[6007]
PUSHJ P,INPFEF ;FORCE AN END OF FILE
TXO S,SKPFIL ;TURN ON SKIP FILE FLAG
$RETT ;AND RETURN
SUBTTL IPCF Interface -- OACBKS - BACKSPACE Operator Action
OACBKS: TXNE S,ABORT+RQB+GOODBY ;ARE WE ON OUR WAY OUT?
PJRST TOOBAD ;YES,,SKIP THIS.
MOVE S1,STREAM ;GET THE STREAM NUMBER.
SETZM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT.
OACB.0: PUSHJ P,GETBLK ;GET A MESSAGE DATA BLOCK
JUMPF .RETT ;NO MORE,,JUST RETURN
MOVE S1,T3 ;GET THE DATA ADDRESS IN S1.
CAIN T1,.SPPAG ;IS THIS BACKSPACE 'PAGES'?
PJRST BSPACE ;YES,,GO PROCESS IT
CAIN T1,.SPCPY ;IS IT BACKSPACE COPIES?
PJRST BCOPYS ;YES,,GO PROCESS IT
CAIN T1,.SPFIL ;IS IT BACKSPACE FILES?
PJRST BFILES ;YES,,GO PROCESS IT
JRST OACB.0 ;NONE OF THESE,,TRY NEXT BLOCK
SUBTTL IPCF Interface -- Backspace -- BSPACE - Backspace Pages
BSPACE: MOVE T1,0(S1) ;PICK UP THE NUMBER OF PAGES TO BSPACE.
MOVE S1,STREAM ;PICK UP STREAM NUMBER.
MOVE S2,J$TFIL(J) ;[6000]PICK UP FILE TYPE
$ACK (<Backspaced ^D/T1/ Pages>,,@JOBOBA(S1),.MSCOD(M))
$TEXT (LOGCHR,<^I/LPMSG/File ^I/@FILTYP(S2)/ Backspaced ^D/T1/ pages>)
SKIPN J$DIFN(J) ;IS THERE A SPOOL FILE OPEN?
$RETT ;NO,,JUST RETURN.
ADDM T1,J$RLIM(J) ;Up the limit to compensate for the
; backspace
TXO S,FCONV ;We will start next on new line
SETOM J$DBCT(J) ;RESET THE INPUT BYTE COUNT
SETZM J$FPIG(J) ;ZERO THE FORWARD SPACE PAGE COUNTER
SETZM J$FCBC(J) ;CLEAR THE CURRENT INPUT BUFFER BYTE CNT
MOVE S1,J$FLIN(J) ;GET LINES PER PAGE
MOVEM S1,J$XPOS(J) ;RESET THE PAGE POSITION TO TOP OF PAGE
MOVX S1,.CHFFD ;GET A FORM FEED
MOVEM S1,J$RACS+C(J) ;CONVERT NXT CHAR TO FORM FEED
MOVE S1,J$RNPP(J) ;GET THE # OF PAGES PRINTED SO FAR.
SUB S1,T1 ;CALC DESTINATION PAGE NUMBER
SKIPGE S1 ;CAN'T BE NEGATIVE
SETZM S1 ;IF SO,,MAKE IT ZERO
JUMPLE S1,BSPA.2 ;MORE THEN WE PRINTED,,JUST REWIND FILE
CAXLE T1,PAGSIZ ;REQUESTING MORE THEN WE'RE TRACKING?
JRST BSPA.2 ;YES,,REWIND THE FILE
MOVE S2,J$FBPT(J) ;GET THE PAGE TABLE ENTRY POINTER
SUBI S2,J$FPAG(J) ;CALC INDEX TO CURRENT PAGE
SUBI S2,1(T1) ;CALC INDEX TO NEW PAGE
JUMPGE S2,BSPA.1 ;IF POSITIVE,,THEN NO PROBLEM
TXNN S,FBPTOV ;ELSE CHECK FOR PAGE TABLE OVERFLOW
JRST BSPA.2 ;NO,,HMMMMM,,JUST REWIND THE FILE
ADDI S2,J$FPAG+PAGSIZ(J) ;GET TABLE ENTRY FROM THE TOP
SKIPA ;SKIP NON OVERFLOW PATH
BSPA.1: ADDI S2,J$FPAG(J) ;GET TABLE ENTRY FROM THE BOTTOM
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVEM S1,J$RNPP(J) ;RESET PAGE POINTER FOR THIS FILE
MOVEI S1,1(S2) ;POINT TO NEXT PAGE TBL ENTRY
CAIL S1,J$FPAG+PAGSIZ(J) ;Want to wrap around?
JRST [MOVEI S1,J$FPAG(J) ;Yes, start at the beginning
TXO S,FBPTOV ;Say we overflowed
JRST .+1] ;And continue
MOVEM S1,J$FBPT(J) ;AND MAKE THIS THE CUR TBL ENTRY ADDR
MOVE S2,0(S2) ;PICK UP THE LISTING PAGE ADDRESS
MOVEM S2,J$FTBC(J) ;AND MAKE THIS THE TOTAL BUFR BYTE COUNT
MOVE S1,J$DIFN(J) ;GET THE SPOOL FILE IFN
PUSHJ P,F%POS ;POSITION TO THAT PAGE IN THE FILE
$RETT ;AND RETURN
BSPA.2: PUSH P,S1 ;SAVE THE DESTINATION PAGE #
PUSHJ P,INPREW ;REWIND THE SPOOL FILE
POP P,S1 ;RESTORE DESTINATION PAGE NUMBER
JUMPLE S1,.RETT ;IF NO SLACK DATA,,SKIP FORWARD SPACE
MOVEM S1,J$FPIG(J) ;SAVE THE # OF PAGES TO FORWARD SPACE
TXO S,FORWRD ;LITE FORWARD SPACE BIT
$RETT ;RETURN
SUBTTL IPCF Interface -- Backspace -- BCOPYS - Backspace Copies
BCOPYS: MOVE S2,J$RNCP(J) ;PICK UP # OF COPIES ALREADY PRINTED.
MOVE T1,0(S1) ;PICK UP # OF COPIES TO BSPACE.
SUB S2,T1 ;SUBTRACT # OF COPIES TO BSPACE.
MOVEM S2,J$RNCP(J) ;SAVE THE NEW COPIES VALUE.
MOVE S2,J$TFIL(J) ;[6000]PICK UP THE FILE TYPE
$TEXT (LOGCHR,<^I/LPMSG/File ^I/@FILTYP(S2)/ Backspaced ^D/T1/ copies>)
MOVE S1,STREAM ;PICK UP STREAM NUMBER.
$ACK (<Backspaced ^D/T1/ Copies>,,@JOBOBA(S1),.MSCOD(M))
PUSHJ P,INPFEF ;FORCE END OF FILE.
$RETT ;RETURN.
SUBTTL IPCF Interface -- Backspace -- BFILES - Backspace Files
BFILES: PUSHJ P,INPFEF ;FORCE AN END-OF-FILE
TXO S,SKPFIL+BCKFIL ;LITE SKIP FILE AND BACKSPACE'ED BITS
SETOM J$RNFP(J) ;RESET THE FILE COUNTER
MOVE S1,J$RFLN(J) ;GET THE FILE COUNT
LOAD S2,.EQSPC(J),EQ.NUM ;GET THE NUMBER OF FILES
MOVEM S2,J$RFLN(J) ;SAVE IT
SUB S2,S1 ;CALC HOW FAR WE HAVE GONE SO FAR
LOAD E,.EQLEN(J),EQ.LOH ;GET THE HEADER LENGTH
ADD E,J ;POINT TO THE FIRST FP
BFIL.1: SOJLE S2,BFIL.2 ;LOOP THROUGH THE FP/FD'S TILL
PUSHJ P,NXTFIL ;WE GET TO THE CURRENT FILE
AOS J$RNFP(J) ;MINUS ONE
JRST BFIL.1 ;CONTINUE TILL DONE
BFIL.2: MOVE S1,STREAM ;GET OUR STREAM NUMBER
$ACK (<Backspaced 1 File>,,@JOBOBA(S1),.MSCOD(M))
LOAD S1,.FPLEN(E),FP.LEN ;GET THE FP LENGTH
ADD S1,E ;POINT TO THE FD
$TEXT (LOGCHR,<^I/LPMSG/Backspaced to Beginning of ^F/0(S1)/>)
MOVEM E,J$RACS+E(J) ;UPDATE AC 'E' IN STREAM DATA BASE
$RETT
SUBTTL IPCF Interface -- OPRD60 - Receive DN60 OPR messages from QUASAR
;CALL: M/ The Operator Message Address
;RET: True Always
IFE FTDN60,<
OPRD60: $RET ;SHOULD NOT HAPPEN
>
IFN FTDN60,<
OPRD60: SETOM JOBITS ;DONT SAVE THE STATUS BITS
MOVX T1,.OTLPT ;GET LINE PRINTER OBJECT TYPE
SETZM T2 ;GET UNIT 0
MOVE T3,.MSCOD(M) ;GET NODE NAME
MOVEI S1,T1 ;POINT TO THIS OBJECT BLOCK
PUSHJ P,FNDOBJ ;FIND IT IN OUR DATA BASE
JUMPT OPRD.2 ;ITS THERE,,CONTINUE ON
$WTO(<No Operator Console for IBM Remote '^N/.MSCOD(M)/'>,,,<$WTFLG(WT.SJI)>)
$RET ;NOT FOUND,,TELL LOCAL OPR AND EXIT
OPRD.2: PUSHJ P,.SAVE2 ;SAVE P1 AND P2 FOR A MINUTE
MOVE S1,J$LINK(J) ;GET THE OPR MSG LIST ID
PUSHJ P,L%LAST ;POSITION TO LAST ENTRY
LOAD S2,.MSTYP(M),MS.CNT ;GET THE MESSAGE LENGTH
SUBI S2,.OHDRS ;SUBTRACT ALL HEADER LENGTHS
ADDI S2,OPRLEN+2 ;ADD OUR HEADER+TIME STAMP LENGTH
MOVE S1,J$LINK(J) ;GET THE OPR MSG LIST ID
PUSHJ P,L%CENT ;CREATE AN ENTRY IN THE LIST
JUMPF OPRD.9 ;Shouldn't happen
MOVE P1,S2 ;SAVE THE ENTRY ADDRESS
MOVEI P2,.OHDRS(M) ;POINT TO THE FIRST MESSAGE BLOCK
LOAD T1,.OARGC(M) ;GET THE BLOCK COUNT
MOVEI S1,OPRTXT(P1) ;GET THE TEXT ADDRESS
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVEM S1,TEXTBP ;SAVE IT FOR $TEXT
;Continued on next page
;Continued from previous page
OPRD.3: LOAD S1,ARG.HD(P2),AR.TYP ;GET THE BLOCK TYPE
CAXN S1,.ORDSP ;IS IT A DISPLAY BLOCK?
$TEXT (DEPBP,<^C/ARG.DA(P2)/ ^T/ARG.DA+1(P2)/>) ;YES,,GEN THE DISPLAY
CAXN S1,.CMTXT ;IS IT A TEXT BLOCK?
$TEXT (DEPBP,<^T/ARG.DA(P2)/>) ;YES,,GEN THE DISPLAY
LOAD S1,ARG.HD(P2),AR.LEN ;GET THIS BLOCK LENGTH
ADD P2,S1 ;POINT TO THE NEXT BLOCK
SOJG T1,OPRD.3 ;PROCESS ALL MESSAGE BLOCKS
HRROI S1,OPRTXT(P1) ;GEN BYTE PTR TO MSG TEXT
MOVEM S1,OPRPTR(P1) ;SAVE IT IN THE LIST
HRRZ S1,TEXTBP ;GET THE LAST TEXT ADDRESS
SUBI S1,OPRTXT-1(P1) ;CALC THE TEXT LENGTH
IMULI S1,5 ;CALC THE NUMBER OF BYTES
MOVNM S1,OPRBCT(P1) ;SAVE THE -BYTE COUNT
SETOM J$OMSG(J) ;FLAG THAT THE STATION HAS A MESSAGE
$RET ;AND RETURN
OPRD.9: $WTO(<DN60 Operator Message Lost>,<Linked List Processor Failure -^E/S1/>)
$RET ;Complain and return
SUBTTL IPCF Interface -- OPRCHK - Check for and Send DN60 Messages
; The purpose of this routine is to perform stream-related DN60 operator
; functions that are separate from the normal print functions.
; This function sends operator messages between normal
; printouts. (on 2780/3780)
; Parameters: J / Address of job parameter area
; P1/ The stream being examined
; Returns: True always
OPRCHK: SKIPN J$OMSG(J) ;is there an operator message waiting?
$RETT ;no - just return
LOAD S1,J$DFLG(J),NT.TYP ;GET THE MODE
CAXN S1,DF.HSP ;IS IT HASP?
JRST OPRC.X ;YES,,OK TO OUTPUT...
MOVX S1,PSF%OO ;GET OPR MSG WAIT CODE
SKIPE JOBACT(P1) ;IF THE STREAM IS ACTIVE
TDNE S1,JOBSTW(P1) ; BUT WE ALREADY STARTED OPR MSGS
SKIPA ; THEN LETERRIP
$RETT ; ELSE RETURN
;Check to see if time to wake up
OPRC.X: SKIPN J$CWKT(J) ;Need to check time?
JRST OPRC.A ;No, Skip this
$CALL I%NOW ;Get the current time
SUB S1,J$CWKT(J) ;Subtract console wakeup time
SKIPGE S1 ;Time to wake up?
JRST [$CALL CHKTIM ;No, update sleept
$RETT] ;Quit
SETZM J$CWKT(J) ;Time to continue
OPRC.A: $SAVE <P1> ;Save P1
HRRZM P1,STREAM ;HERE ALSO
;Continued on next page
;Continued from previous page
;Loop on messages
OPRC.0: MOVE S1,J$LINK(J) ;GET THE OPR MSG LIST ID
PUSHJ P,L%FIRST ;GET THE FIRST MESSAGE ON THE CHAIN
JUMPF OPRC.3 ;NONE THERE,,CLEAN UP AND RETURN
MOVE P1,S2 ;SAVE THE MSG ADDRESS
MOVE S1,J$D6OP(J) ;GET THE OPR'S CONSOLE ID
MOVE S2,OPRPTR(P1) ;GET THE POINTER TO THE TEXT
MOVE T1,OPRBCT(P1) ;GET THE TEXT BYTE COUNT
PUSHJ P,D60SOUT## ;OUTPUT THE OPERATOR MESSAGE
JUMPT [$CALL D60SU ;Process good return
MOVE S1,J$LINK(J) ;Get OPR message list ID
$CALL L%DENT ;Delete current message
; Send a IBMCOM stats message if needed
IFN FTIBMS,<
MOVEI S1,%TCNO ;Get the stats code for
;console message
$CALL IBMSTS ;Tell QUASAR
> ; End of FTIBMS
JRST OPRC.0] ;Go try again
;Process error
$D60OE (ERCOE) ;Process the error
JUMPT OPRC.2 ;Good error - process it
;Bad error - Assume fatal for console
OPRC.1: MOVX S1,%RSUDE ;GET 'DOES NOT EXIST' SETUP CODE
PUSHJ P,RSETUP ;TELL QUASAR WHATS GOING ON
PUSHJ P,SHUTND ;SHUT EVERYTHING DOWN
$RETT ;AND RETURN
;Good error - Update pointers and flags
OPRC.2: MOVEM S2,OPRPTR(P1) ;SAVE THE NEW TEXT POINTER
MOVEM T1,OPRBCT(P1) ;SAVE THE NEW TEXT BYTE COUNT
$RETT ;And return OK
;Done with messages - Try to clean up
OPRC.3: MOVE S1,J$D6OP(J) ;GET THE OPERATOR CONSOLE ID
$CALL D60EOF## ;Try to EOF
JUMPT [$CALL D60SU ;Process good error
SETZM J$OMSG(J) ;Clear message waiting flag
$RETT] ;and return
$D60OE (ERFCC) ;Go process the error
JUMPF OPRC.1 ;Bad error
$RETT ;Good error, return
> ; End of IFN FTDN60
SUBTTL IPCF Interface -- Subroutines -- FNDOBJ - Find The Object Block
FNDOBJ: MOVE T1,.ROBTY(S1) ;GET OBJECT TYPE
LOAD T2,.ROBAT(S1),AR.TYP ;[6006]GET UNIT NUMBER
MOVE T3,.ROBND(S1) ;AND NODE NUMBER
SETZ T4, ;CLEAR AN INDEX REGISTER
FNDO.1: MOVE S2,T4 ;GET THE INDEX
IMULI S2,.OBJLN+LPTNLN ;[6000]MULTIPLY BY OBJECT BLK SIZE
CAMN T1,JOBOBJ+OBJ.TY(S2) ;COMPARE
CAME T2,JOBOBJ+OBJ.UN(S2) ;COMPARE
JRST FNDO.2 ;NOPE
CAMN T3,JOBOBJ+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: MOVEM T4,STREAM ;SAVE STREAM NUMBER
SKIPN J,JOBPAG(T4) ;GET ADDRESS OF DATA
$RETF ;UNLESS ITS NOT REALLY SETUP THEN RETURN
MOVE S,J$RACS+S(J) ;GET HIS 'S'
$RETT ;AND RETURN
SUBTTL IPCF Interface -- Subroutines -- TOOBAD - Operator Is Too Late
;Routine to respond to the operator if his command was too late.
TOOBAD: MOVE S1,STREAM ;GET THE STREAM NUMBER.
SKIPL J$REMR(J) ;[6044]REQUEST ORIGINATE REMOTELY?
IFSKP. ;[6044]
$ACK (Print Request Completed,<^I/RMJOBI/>,@JOBOBA(S1),.MSCOD(M))
ELSE. ;[6044]
$ACK (Print Request Completed,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
ENDIF. ;[6044]
$RETT
SUBTTL IPCF Interface -- Subroutines -- SNDQSR - Send A Mesasge To QUASAR
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
PUSHJ P,C%SEND ;SEND THE MESSAGE
JUMPT .RETT ;AND RETURN
$STOP(QSF,Send to QUASAR FAILED)
SUBTTL Align Processor -- Align Forms on Printer
ALIGN: TXNE S,GOODBY!ABORT ;ARE WE LEAVING?
JRST ALIG.5 ;RETURN.
MOVE S1,J$AIFN(J) ;GET THE IFN
PUSHJ P,F%REW ;REWIND THE FILE
SETZM J$XTOP(J) ;CLEAR TOP OF FORM FLAG
PUSHJ P,SENDFF ;SEND A FORM-FEED
ALIG.1: SOSGE J$ABYT(J) ;DECREMENT THE BYTE COUNT
JRST ALIG.3 ;IF BUFFER EMPTY,,GET NEXT BUFFER.
ILDB C,J$APTR(J) ;PICK UP THE ALIGN BYTE.
PUSHJ P,DEVOUT ;PUT IT OUT....
JRST ALIG.1 ;GO GET NEXT BYTE.
ALIG.2: PUSHJ P,OUTDMP ;FORCE OUT THE BUFFER
SOSLE J$ACNT(J) ;COUNT DOWN
JRST ALIG.4 ;IF AGAIN,,SET UP SLEEP TIME.
SETZM J$XTOP(J) ;CLEAR TOP OF FORM
PUSHJ P,SENDFF ;GO TO TOP OF FORM
ALIG.5: MOVE S1,J$AIFN(J) ;PICK UP ALIGN IFN.
PUSHJ P,F%REL ;CLOSE THE ALIGN FILE.
SETZM J$APRG(J) ;INDICATE NO ALIGN IN PROGRESS.
SETZM J$ASLP(J) ;CLEAR THIS SLEEP TIME
SETZM J$ACNT(J) ;AND THIS REPEAT COUNT
MOVE S1,STREAM ;GET THE STREAM NUMBER.
SETZM JOBCHK(S1) ;SAY WE WANT TO CHECKPOINT.
SETOM JOBUPD(S1) ; send update message also
$RETT ;AND RETURN
ALIG.3: MOVE S1,J$AIFN(J) ;GET ALIGN IFN.
PUSHJ P,F%IBUF ;GET AN ALIGN BUFFER.
JUMPF ALIG.2 ;IF NO MORE,,SLEEP A WHILE.
MOVEM S1,J$ABYT(J) ;SAVE THE # OF BYTES.
MOVEM S2,J$APTR(J) ;SAVE THE BYTE POINTER.
JRST ALIG.1 ;KEEP ON PROCESSING.
ALIG.4: MOVE S2,STREAM ;PICK UP STREAM NUMBER.
PUSHJ P,I%NOW ;GET CURRENT TIME.
ADD S1,J$ASLP(J) ;ADD /PAUSE VALUE.
MOVEM S1,JOBWKT(S2) ;SAVE WAKE UP TIME FOR STREAM.
$DSCHD (PSF%AL) ;SHOW STREAM BLOCKED FOR ALIGNMENT.
JRST ALIGN ;WHEN RETURN,,CONTINUE.
SUBTTL Align Processor -- ALISCD - Schedule Align
ALISCD: MOVEI S1,FOB.SZ ;PICK UP FOB SIZE.
MOVEI S2,J$XFOB(J) ;PICK UP FOB ADDRESS.
PUSHJ P,.ZCHNK ;ZERO OUT THE FOB BLOCK.
MOVEI S1,7 ;PICK UP ASCII BYTE SIZE
STORE S1,J$XFOB+FOB.CW(J),FB.BSZ ;AND SAVE IT IN FOB.
SKIPN S1,FDADDR ;SKIP FD GEN IF USER SPECIFIED.
PUSHJ P,BLDLFD ;GO BUILD THE ALIGN FD.
STORE S1,J$XFOB+FOB.FD(J) ;AND SAVE ITS ADDRESS IN FOB.
MOVEI S1,FOB.SZ ;PICK UP THE FOB SIZE.
MOVEI S2,J$XFOB(J) ;PICK UP THE FOB ADDRESS.
PUSHJ P,F%IOPN ;OPEN THE ALIGN FILE.
JUMPF ALIS.3 ;IF AN ERROR, RETURN WITH WTO.
MOVEM S1,J$AIFN(J) ;SAVE THE FILE ID.
SKIPG S1,J$ACNT(J) ;PICK UP USER DEFINED REPEAT-COUNT.
SKIPLE S1,J$FALC(J) ;ELSE PICK UP LPFORM.INI REPEAT-CNT.
SKIPA ;SKIP DEFAULT.
MOVE S1,D$ALCN ;PICK UP THE DEFAULT REPEAT COUNT.
MOVEM S1,J$ACNT(J) ;SAVE THE REPEAT-COUNT.
SKIPG S1,J$ASLP(J) ;PICK UP USER SLEEP TIME.
SKIPLE S1,J$FALS(J) ;ELSE, PICK UP LPFORM.INI SLEEP-TIME.
SKIPA ;SKIP THE DEFAULT.
MOVE S1,D$ALSL ;PICK UP THE DEFUALT SLEEP-TIME.
IMULI S1,3 ;CONVERT TO UNIVERSAL TIME.
MOVEM S1,J$ASLP(J) ;AND SAVE IT.
SETOM J$APRG(J) ;SHOW WE ARE DOING AN ALIGN,
; AND THAT IT NEEDS TO BE SCHEDULED.
MOVE S1,STREAM ;GET STREAM NUMBER
$WTO (Alignment Scheduled,,@JOBOBA(S1)) ;TELL THE OPERATOR.
SETOM JOBUPD(S1) ;Update the status
$RETT ;RETURN.
ALIS.3: MOVE S1,STREAM ;GET STREAM NUMBER
$WTO (<^E/[-1]/>,<Cannot read ALIGN file ^F/@J$XFOB+FOB.FD(J)/>,@JOBOBA(S1))
$RETT
SUBTTL Align Processor -- Create A 10/20 FD For The Align File
BLDLFD: MOVEI S1,AFDSIZ ;GET THE FD LENGTH
STORE S1,J$AFD+.FDLEN(J),FD.LEN ;SAVE IT
$TEXT (<-1,,J$AFD+.FDSTG(J)>,<SYS:^W/J$FALI(J)/.ALP^0>)
MOVEI S1,J$AFD(J) ;PICK UP FD ADDRESS.
$RETT ;RETURN. . . . . . . . . .
SUBTTL Printer Output -- CHKLPT - Make Sure The Device Is Online
CHKLPT: TXNE S,LATSPL!TTYSPL ;[6013] LAT or TTY
PJRST CHKTTY ;[6005] Yes check if we do polling
SKIPE S1,JOBSTW ;ARE ANY STATUS BITS SET?
TXNN S1,PSF%DO ;IF SO,,IS IT DEVICE OFFLINE?
$RETT ;NO TO EITHER,,JUST RETURN
$WTO (<^T/BELL/>,,@JOBOBA) ;TELL OPR DEVICE IS OFFLINE
MOVE S1,STREAM ;Get the stream number
SETOM JOBUPD(S1) ;Say we want a status update
$CALL DSTATU ;Do it
SETZM JOBCHK ;INDICATE WE WANT ANOTHER WHEN WE CAN
$RETT ;RETURN
SUBTTL Printer Output -- OUTGET - Open The Output Device
;This routine opens the LPT channel and sets up the LPT buffer ring.
GENDEV: SKIPE S1,J$MTAP(J) ;IS THERE A SPECIFIC DEVICE TO WRITE ON
JRST GEND.1 ;YES,,RETURN WITH DEVICE IN S1
MOVE T1,STREAM ;PICK UP STREAM NUMBER.
MOVE T1,JOBOBA(T1) ;PICK UP OBJECT BLOCK ADDRESS.
ADD S1,OBJ.UN(T1) ;ADD THE UNIT NUMBER.
ADD S1,[SIXBIT/LPT000/] ;CREATE THE PHYSICAL DEVICE NAME.
GEND.1: MOVEM S1,J$LDEV(J) ;AND SAVE IT
POPJ P, ;RETURN. . . . .
OUTGET: PUSHJ P,GENDEV ;CREATE THE PHYSICAL DEVICE NAME.
SKIPE J$MTAP(J) ;ARE WE SPOOLING TO TAPE?
PJRST TAPGET ;YES,,OPEN DIFFERENTLY
MOVSI S1,(POINT 8,0) ;GET 8 BIT BYTE POINTER
MOVEM S1,J$LBTZ(J) ;SAVE IT FOR LATER
MOVE S1,STREAM ;GET OUR STREAM NUMBER
MOVE S1,JOBOBA(S1) ;GET OUR OBJECT BLOCK ADDRESS
SKIPN J$LREM(J) ;IS THIS A LOCAL LPT?
$TEXT (<-1,,J$LSTG(J)>,<PLPT^O/OBJ.UN(S1)/:^0>) ;YES,,GEN UNIT NAME
SKIPGE J$LREM(J) ;IS THIS A REMOTE LPT?
$TEXT (<-1,,J$LSTG(J)>,<^W/OBJ.ND(S1)/::PLPT^O/OBJ.UN(S1)/:^0>)
MOVX S1,GJ%FOU!GJ%SHT ;LOAD GTJFN FLAGS
LOAD S2,IB+IB.FLG,IB.NAC ;Get the access bit value
SKIPE DEBUGW ;Debugging?
SETZ S2, ;Yes, do not restrict
STORE S2,S1,GJ%ACC ;Store as the value of the JFN access
HRROI S2,J$LSTG(J) ;POINT TO THE STRING
PUSHJ P,$GTJFN ;GET THE LPT JFN
JUMPF OUTDDE ;CANT,,FATAL ERROR
MOVEM S1,J$LCHN(J) ;WIN, SAVE THE JFN
MOVX S2,OF%WR+OF%OFL+8B5 ;OPEN FOR WRITING 8 BIT BYTES
PUSHJ P,$OPENF ;OPEN THE DEVICE
JUMPF OUTDNA ;CANT,,DEVICE NOT AVAILABLE NOW.
PUSHJ P,OUTRES ;SETUP/RESET THE OUTPUT BUFR POINTERS
SKIPLE J$LREM(J) ;IS THIS A DN60 (IBM) LPT?
JRST [MOVX S1,%RSUOK ;YES,,GET 'SETUP OK'
$RETT ] ; AND SKIP THE REST OF THIS
MOVE S1,J$LCHN(J) ;GET LPT JFN
MOVX S2,.MORST ;GET FUNCTION TO READ STATUS
MOVEI T1,T2 ;LOAD ADDRESS OF ARG BLOCK
MOVEI T2,3 ;LOAD LENGTH OF ARG BLOCK
PUSHJ P,$MTOPR ;GO GET THE DEVICE STATUS
JUMPF OUTSOK ;CANT,,IGNORE THE ERROR
TXNE T3,MO%FNX ;DOES THE LPT EXIST?
PJRST [PUSHJ P,OUTREL ;NO,,RELEASE JFN AND CLOSE THE LPT
PJRST OUTDDE ] ; AND RETURN THROUGH 'DOES NOT EXIST'
OUTG.1: TXNE T3,MO%LCP ;IS IT A LOWER CASE PRINTER?
SETOM J$LLCL(J) ;YES, SET THE FLAG
MOVE S1,[SIXBIT/LP64/] ;DEFAULT TO 64 CHARACTER RAM
SKIPE J$LLCL(J) ;UNLESS IT IS A LOWER CASE LPT,
MOVE S1,[SIXBIT/LP96/] ;THEN ITS A 96 CHARACTER RAM
MOVEM S1,J$LRAM(J) ;SAVE THE DEFAULT RAM FILE NAME
MOVE S1,D$TAPE ;GET THE DEFAULT VFU TYPE.
SKIPN J$FTAP(J) ;HAS THE VFU ALREADY BEEN DEFAULTED?
MOVEM S1,J$FTAP(J) ;NO,,SAVE AS THE VFU DEFAULT.
TXNN T3,MO%LVU ;IS IT NOT OPTICAL VFU
SETOM J$LDVF(J) ;YES, SET THAT
MOVX S1,PSF%DO ;DEVICE OFFLINE FLAG
ANDCAM S1,JOBSTW ;CLEAR THE VALUE
TXNE T3,MO%OL ;IS IT OFF-LINE?
IORM S1,JOBSTW ;YES, SET FLAG
JRST OUTSOK ;CONTINUE ON OK
SUBTTL Printer Output -- OUTGET Exit Subroutines
OUTSOK: SKIPE J$CID(J) ;[6011]LATSPL?
JRST OUTSO1 ;[6011]Yes, skip the connect stuff
PUSHJ P,INTCNL ;CONNECT UP THE LPT
JUMPF OUTDDE ;DID NOT SUCCEED,,DEVICE DOES NOT EXIST
OUTSO1: TXO S,INTRPT ;[6011]INDICATE WE'RE CONNECTED
MOVX S1,%RSUOK ;LOAD THE CODE
$RETT ;AND RETURN
OUTDNA: MOVE S1,J$LCHN(J) ;Get the failed PLPT JFN
SETOM J$LCHN(J) ;Indicate no output channel
IFN FTDN60,<
SKIPLE J$LREM(J) ; Is this a DN60?
JRST OUTDDE ;All errors fatal on DN60
; don't need to release, done already
> ;End of IFN FTDN60
RLJFN ;Release failed PLPT JFN
JFCL ;Don't care about any errors
MOVX S1,%RSUNA ;NOT AVAILABLE RIGHT NOW
$RETF ;AND RETURN
OUTDDE: MOVX S1,%RSUDE ;NEVER AVAILABLE
$RETF ;RETURN
SUBTTL Printer Output -- TAPGET - Setup A Magtape Device For Output
TAPGET: SKIPN J$LSTG(J) ;DO WE HAVE A DEVICE NAME YET?
$TEXT (<-1,,J$LSTG(J)>,<^W/J$MTAP(J)/:^0>) ;NO,,GEN THE DEVICE NAME
SETZM J$LREM(J) ;FORCE US TO BE LOCAL
MOVSI S1,(POINT 7,0) ;[6024]Get 7 bit byte pointer (output)
MOVEM S1,J$LBTZ(J) ;SAVE IT FOR LATER
MOVX S1,GJ%SHT+GJ%FOU ;GET GTJFN FLAG BITS
LOAD S2,IB+IB.FLG,IB.NAC ;Get the access bit value
SKIPE DEBUGW ;Debugging?
SETZ S2, ;Yes, do not restrict
STORE S2,S1,GJ%ACC ;Store as the value of the JFN access
HRROI S2,J$LSTG(J) ;POINT TO THE DEVICE NAME
GTJFN ;GET A JFN
JRST TAPG.2 ;CANT,,TOUGH BREAKEEE
MOVEM S1,J$LCHN(J) ;SAVE THE JFN
DVCHR ;GET THE DEVICE CHARACTERISTICS
ERJMP TAPG.1 ;SHOULD NOT HAPPEN
LOAD S2,S2,DV%TYP ;[6005] Get device type
CAIN S2,.DVTTY ;[6005] Is it a terminal ?
PJRST TTYGET ;[6005] Yes,setup proper TTY mode
CAXE S2,.DVMTA ;[6005] Magtape?
JRST TAPG.0 ;No, skip the check
MOVX S1,DEVX2 ;GET ALREADY ASSIGNED ERROR CODE
HLRZS T1 ;MOVE LEFT TO RIGHT,,ZERO LEFT
CAIE T1,-1 ;THE TAPE SHOULD NOT BE ASSIGNED
JRST TAPG.1 ;IT IS,,CAN THE REQUEST
TAPG.0: MOVE S1,J$LCHN(J) ;GET THE JFN BACK
MOVX S2,OF%WR+7B5 ;WRITE+7 BIT BYTES
OPENF ;OPEN THE MAG TAPE
JRST TAPG.1 ;CANT,,TOUGH
MOVE S1,J$LCHN(J) ;GET THE JFN
MOVX S2,.MONOP ;WAIT FOR I/O or SET TTY PAGE WIDTH
SETZM T1 ;NO ARGS or INFINITE PAGE WIDTH
MTOPR ;DO IT
ERJMP .+1 ;IGNORE THE ERROR
PUSHJ P,OUTRES ;SETUP THE OUTPUT POINTERS
PJRST OUTSOK ;SO FAR HE WINS...
TAPG.1: MOVE T1,S1 ;SAVE THE ERROR CODE
SKIPE S1,J$LCHN(J) ;[6013]GET THE JFN
RLJFN ;RELEASE IT
JFCL ;IGNORE THE ERROR
MOVE S1,T1 ;RESTORE THE ERROR CODE TO S1
TAPG.2: MOVE S2,STREAM ;GET OUR STREAM NUMBER
$WTO (<^T/J$LSTG(J)/ ^E/S1/>,,@JOBOBA(S2)) ;TELL THE OPERATOR
PJRST OUTDDE ;GIVE UP THE SHIP
SUBTTL Printer Output -- OUTOUT - Output A Buffer
OUTOUT: PUSHJ P,.SAVET ;SAVE THE 'T' ACS
OUTO.1: PUSHJ P,OUTWON ;CHECK OFFLINE STATUS
$DSCHD(0) ;FORCE A SCHEDULING PASS
SKIPGE T1,J$LBCT(J) ;GET BYTES REMAINING IN BUFFER
SETZM T1 ;IF LESS,,MAKE IT ZERO
SUB T1,J$LIBC(J) ;CALC -BYTE COUNT IN BUFFER
JUMPGE T1,OUTRES ;NOTHING TO PUT OUT,,RESET BUFR PTRS
MOVE S1,J$LCHN(J) ;GET THE LPT JFN
MOVE S2,J$LIBP(J) ;GET THE STARTING BYTE POINTER
PUSHJ P,$SOUT ;OUTPUT THE DATA
MOVEM S2,J$LIBP(J) ;SAVE THE BUFFER POINTER AND
MOVMM T1,J$LIBC(J) ; THE BYTE COUNT JUST IN CASE
SETZM J$LBCT(J) ;CLEAR BYTE COUNT FOR THE BUFFER
SKIPT ;SKIP IF SOUT WAS OK
PUSHJ P,OUTERR ;ELSE GO PROCESS THE ERROR
SKIPLE J$LIBC(J) ;ANY BYTES LEFT IN THE BUFFER?
JRST OUTO.1 ;YES,,GO PUT THEM OUT
OUTRES: MOVEI S1,BUFCHR ;GET CHARACTERS PER BUFFER
MOVEM S1,J$LBCT(J) ;SAVE AS BUFFER BYTE COUNT
MOVEM S1,J$LIBC(J) ;HERE ALSO
MOVE S1,J$LBUF(J) ;GET THE BUFFER ADDRESS
ADD S1,J$LBTZ(J) ;ADD THE BYTE PTR (LEFT HALF)
MOVEM S1,J$LBPT(J) ;SAVE AS BUFFER BYTE POINTER
MOVEM S1,J$LIBP(J) ;HERE ALSO
$RETT ;AND RETURN
SUBTTL Printer Output -- OUTERR - Handle Output Device Errors
OUTERR: MOVE T4,STREAM ;GET OUR STREAM NUMBER
PUSHJ P,$GDSTS ;GET THE DEVICE STATUS
MOVEM S1,J$LIOS(J) ;SAVE THE DEVICE STATUS
MOVE T1,S1 ;SAVE IT HERE ALSO
TXZ S1,MO%OL ;CLEAR THE OFFLINE BIT
PUSHJ P,$SDSTS ;RESET THE DEVICE STATUS
SKIPE J$MTAP(J) ;SPOOLING TO TAPE?
JRST OUTTPE ;YES, CHECK TAPE ERROR BITS
TXNE T1,MO%LVF ;NO, VFU ERR?
JRST OUTE.4 ;YES,,GO PROCESS IT
TXNE T1,MO%RPE ;WAS IT A RAM PARITY ERROR
JRST OUT.2A ;YES, GO PROCESS IT
JRST OUTE.2 ;NO,,PROCESS AS AN I/O ERROR
OUTTPE: TXNE T1,MT%EOT ;END OF TAPE?
JRST OUT.3A ;YES
TXNE T1,MT%ILW ;IS IT WRITE PROTECTED
JRST OUT.2B ;YES
JRST OUTE.2 ;NO,,PROCESS AS AN I/O ERROR
;RAM PARITY ERROR
OUT.2A: $WTO (RAM Parity Error,,@JOBOBA(T4)) ;YES,,TELL OPERATOR
PUSHJ P,OUTE.3 ;PERFORM SOME PRELIMINARY PROCESSING
SETZM J$FLRM(J) ;FORCE A RAM RELOAD
PUSHJ P,LODRAM ;GO DO IT
$RETT ;AND RETURN
;Continued on next page
;Continued from previous page
;Write ring missing
OUT.2B: $WTOR (MTA Write Protected,<Insert Write Ring And Put On Line^m^j^t/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4))
SETOM JOBCHK(T4) ;WE WANT A CHECKPOINT
$DSCHD(PSF%OR) ;WAIT FOR OPERATOR RESPONSE
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED
$RETT ;YES,, JUST RETURN
MOVEI S1,CONANS ;POINT TO THE CONTINUE ANSWER BLOCK
HRROI S2,J$RESP(J) ;POINT TO THE ANSWER
PUSHJ P,S%TBLK ;DO WE MATCH?
TXNE S2,TL%NOM+TL%AMB ;DID WE FIND IT OK
JRST OUT.2B ;NO, TRY AGAIN
MOVE S2,STREAM ;Get the stream number
SETOM JOBUPD(S2) ;Yes, update the stream's status
PUSHJ P,OUTE.3 ;GO PERFORM PRELIMINARY PROCESSING
$RETT ;AND RETURN
;Continued on next page
;Continued from previous page
;UNKNOWN TYPE I/O ERROR OCCURED
OUTE.2: $WTO (I/O Error,<Status is: ^O/J$LIOS(J)/>,@JOBOBA(T4))
;GENERAL I/O ERROR RECOVERY ROUTINE
OUTE.3: PUSHJ P,OUTDIE ;SEE IF TOO MANY ERRORS
PUSHJ P,OUTFLS ;RESET THE OUTPUT CHANNEL
JUMPF [MOVX S1,%RSUNA ;CAN'T,,GET 'DEVICE NOT AVAILABLE' ERROR
PUSHJ P,RSETUP ;TELL QUASAR TO RESET THE OBJECT
PJRST SHUTIN ] ;SHUT DOWN THE DEVICE
TXNN S,VFULOD+BANHDR ;[6020]IF LOADING VFU OR PRINTING HDRS
SKIPN J$DIFN(J) ; OR IF WE ARE NOT IN A FILE?
$RETT ;THEN JUST RETURN
MOVE S1,J$RNCP(J) ;GET NUMBER OF COPIES PRINTED
AOS S1 ;MAKE INTO CURRENCT COPY NUMBER
MOVE S2,J$TFIL(J) ;[6000]PICK UP IF TEMPORARY FILE OR NOT
$TEXT (LOGCHR,<^I/LPERR/LPT I/O Error occurred during ^I/@FILTYP(S1)/, Copy:^D/S1/, Page:^D/J$RNPP(J)/; Status is: ^O/J$LIOS(J)/>)
MOVEI S1,[EXP 5] ;PREPARE TO BACKSPACE 5 PAGES
PUSHJ P,BSPACE ;BACKSPACE 5 PAGES
$RETT ;RETURN
;EOT
OUT.3A: PUSHJ P,TAPMRK ;WRITE A TAPE MARK
PUSHJ P,TAPUNL ;UNLOAD THE TAPE
OUT.3B: $WTOR (<End of spooled output tape>,<Please mount next volume^M^J^T/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4)) ;NOTIFY OPERATOR
SETOM JOBCHK(T4) ;WE WANT A CHECKPOINT
$DSCHD(PSF%OR) ;WAIT FOR OPERATOR RESPONSE
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED
$RETT ;YES,, JUST RETURN
MOVEI S1,CONANS ;POINT TO THE CONTINUE ANSWER BLOCK
HRROI S2,J$RESP(J) ;POINT TO THE ANSWER
PUSHJ P,S%TBLK ;DO WE MATCH?
TXNE S2,TL%NOM+TL%AMB ;DID WE FIND IT OK
JRST OUT.3B ;NO, TRY AGAIN
MOVE S2,STREAM ;Get the stream number
SETOM JOBUPD(S2) ;Yes, update the stream's status
PUSHJ P,OUTE.3 ;GO PERFORM PRELIMINARY PROCESSING
$RETT ;AND RETURN
;Continued on next page
;Continued from previous page
;VFU ERROR OCCURED
OUTE.4: TXNE S,VFULOD ;Are we already loading VFU?
JRST [$WTO (VFU error while loading VFU,,@JOBOBA(T4)); Yes
JRST SHUTIN] ;Kill this stream
$WTOR (VFU error,<Re-align forms and put on-line^M^J^T/ENDRSP/>,@JOBOBA(T4),JOBWAC(T4))
SETZM JOBCHK(T4) ;SAY WE WANT A CHECKPOINT TAKEN
SETOM JOBUPD(T4) ; update the status also
$DSCHD(PSF%OR) ;WAIT FOR THE OPERATOR RESPONSE
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED OR REQUEUED?
$RETT ;YES,,JUST RETURN
MOVEI S1,CONANS ;POINT TO THE CONTINUE ANSWER BLOCK
HRROI S2,J$RESP(J) ;POINT TO THE ANSWER
PUSHJ P,S%TBLK ;DO WE MATCH?
TXNE S2,TL%NOM+TL%AMB ;DID WE FIND IT OK?
JRST OUTE.4 ;NO,,STUPID OPERATOR SO TRY AGAIN
MOVE S2,STREAM ;Get the stream number
SETOM JOBUPD(S2) ;Yes, update the stream's status
PUSHJ P,OUTE.3 ;GO PERFORM SOME PRELIMINARY PROCESSING
SETZM J$FLVT(J) ;FORCE A VFU RELOAD
PUSHJ P,LODVFU ;GO RELOAD THE VFU
$RETT ;AND RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CONANS: $STAB
KEYTAB (0,PROCEED)
$ETAB
ENDRSP: ASCIZ /Type 'RESPOND <number> PROCEED' when ready/ ;[6012]
OUTDIE: SOSL J$LERR(J) ;COUNT DOWN ERRORS
POPJ P, ;STILL ALIVE
MOVE S1,STREAM ;GET STREAM NUMBER
$WTO (Too Many Device Errors,,@JOBOBA(S1)) ;[6007]
DIE: MOVEI S1,%RSUDE ;GET DEVICE DOES NOT EXIST BIT.
PUSHJ P,RSETUP ;TELL QUASAR PRINTER IS OUT TO LUNCH.
PJRST SHUTIN ;AND SHUT IT DOWN
SUBTTL Printer Output -- Tape Routines
; Write a tape mark
; Call: PUSHJ P,TAPMRK
;
TAPMRK: SKIPN J$MTAP(J) ;SPOOLING TO TAPE?
POPJ P, ;NO
MOVE S1,J$LCHN(J) ;GET JFN
MOVEI S2,.MOEOF ;FUNCTION CODE
SETZ T1, ;NO SPECIAL ARGUMENTS
MTOPR ;WRITE A TAPE MARK
ERJMP .+1 ;IGNORE ERRORS
POPJ P, ;RETURN
; Unload a tape
; Call: PUSHJ P,TAPUNL
;
TAPUNL: SKIPN J$MTAP(J) ;SPOOLING TO TAPE?
POPJ P, ;NO
MOVE S1,J$LCHN(J) ;GET JFN
MOVEI S2,.MORUL ;FUNCTION CODE
SETZ T1, ;NO SPECIAL ARGUMENTS
MTOPR ;UNLOAD THE TAPE
ERJMP .+1 ;IGNORE ERRORS
POPJ P, ;RETURN
SUBTTL Printer Output -- OUTWON - Wait for on-line
;On the -10, this routine should only be gotten to by DEBRKing to it
; on a device off-line interrupt. On the -20, it can be called
; from anywhere.
; NOTE: The ONLINE/OFFLINE (PSF%DO) status bits are set and cleared
; at interrupt level. This pervents a race condition from
; occuring where the device comes online while we are still
; processing the device offline interrupt. In this case
; it was possible for LPTSPL to miss the on-line
; change-of-state, and sleep forever waiting for the
; online interrupt.
OUTWON: MOVX S2,PSF%DO ;DEVICE OFFLINE FLAG
MOVE S1,STREAM ;AND THE STREAM NUMBER
TDNN S2,JOBSTW(S1) ;IS IT OFF-LINE?
POPJ P, ;NO, JUST RETURN
$WTO (<^T/BELL/>,,@JOBOBA(S1)) ;TELL THE OPERATOR.
$DSCHD(0) ;BLOCK FOR DEVICE ONLINE
POPJ P, ;NO, RETURN
BELL: BYTE(7) 07,07,117,146,146
ASCIZ/line/
SUBTTL Printer Output -- OUTREL - Release Device On SHUTDOWN
OUTREL: MOVE S1,J$LCHN(J) ;GET THE CHANNEL(JFN)
MOVX S2,.MOFLO ;GET FLUSH BUFFERS CODE
SETZ T1, ;SET AC 3 TO 0
PUSHJ P,$MTOPR ;FLUSH THE BUFFERS
JUMPF .+1 ;IGNORE ANY ERRORS
SKIPE J$MTAP(J) ;ARE WE SPOOLING TO TAPE?
JRST OUTR.1 ;YES,,DO THINGS A LITTLE DIFFERENTLY
MOVE S1,J$LCHN(J) ;NO,,GET THE JFN AGAIN
TXO S1,CZ%ABT ;ABORT ALL OUTPUT OPERATIONS
PUSHJ P,$CLOSF ;CLOSE IT DOWN
$RETT ;NO,, RETURN
OUTR.1: MOVE S1,J$LCHN(J) ;GET THE JFN
DOBE ;[6005] Wait till TTY output empty
ERJMP .+1 ;[6005] Igonre error
MOVX S2,.MONOP ;WAIT FOR ALL OUTPUT TO STOP
SETZM T1 ;NO ARGS
MTOPR ;DO IT
ERJMP .+1 ;IGNORE THE ERROR
PUSHJ P,TAPMRK ;WRITE A TAPE MARK
PUSHJ P,TAPMRK ;WRITE ANOTHER
PUSHJ P,TAPMRK ;ONE MORE FOR GOOD LUCK
PUSHJ P,TAPUNL ;GO UNLOAD THE TAPE
TXO S1,CZ%ABT ;LITE THE ABORT BIT
CLOSF ;CLOSE DOWN THE MAG TAPE
JFCL ;IGNORE THE ERROR
$RETT ;AND RETURN
SUBTTL Printer Output -- OUTEOF - Clear The LPT Output Buffers
OUTEOF:
IFN FTDN60,<
SKIPLE J$LREM(J) ;DN60 printer?
JRST EOF.6 ;Yes, handle differently
> ; End of IFN FTDN60
MOVE S1,J$LCHN(J) ;GET THE LPT JFN
MOVX S2,.MOEOF ;GET THE FLUSH BUFFERS CODE
SETZM T1 ;NO ARGS
PUSHJ P,$MTOPR ;DO IT
$RETT ;AND RETURN
IFN FTDN60,<
; End of file for DN60
EOF.6: MOVE S1,J$LCHN(J) ;Get handle
$CALL D60EOF## ;Try to do EOF
$RETIT ;ok - return
$D60ER(ERFCO) ;Process the error
JUMPT EOF.6 ;Try again
$RETT ;Return but still in trouble
> ; End of IFN FTDN60
SUBTTL Printer Output -- OUTDMP - Dump Out Buffers and Wait
OUTDMP: PUSHJ P,OUTOUT ;DUMP THE INTERNAL BUFFERS
TXNE S,LATSPL!TTYSPL ;[6013] LAT or TTY
JRST OUTDM1 ;[6005] Yes so don't set width to inf
MOVE S1,J$LCHN(J) ;GET THE LPT JFN
MOVX S2,.MONOP ;AND NO-OP FUNCTION
SETZM T1 ;ZAP AC 3
PUSHJ P,$MTOPR ;DO IT
SKIPT ;OK,,CONTINUE
PUSHJ P,OUTERR ;ELSE GO PROCESS THE ERROR
OUTDM1: $RETT ;AND RETURN
SUBTTL Printer Output -- OUTFLS - Flush Already Buffered Output
;OUTFLS IS CALLED TO FLUSH OUTPUT TO THE PRINTER WHICH HAS ALREADY BEEN
; BUFFERED (AND POSSIBLE SENT TO THE PRINTER).
OUTFLS:
IFN FTDN60,<
MOVE S1,J$LREM(J) ;Get printer type
CAMN S1,[.JDN60] ;[6000]DN60 type?
JRST OUTF.2 ;Go and only reset buffers
> ;End of FTDN60
MOVE S1,J$LCHN(J) ;GET OUTPUT JFN
MOVX S2,.MOFLO ;LOAD FLUSH FUNCTION
MOVEI T1,0 ;AND ZERO ARGUMENTS
PUSHJ P,$MTOPR ;FLUSH THE BUFFERS
JUMPF OUTF.1 ;ON AN ERROR,,SHUT IT DOWN AND RESET IT
PUSHJ P,OUTRES ;RESET THE OUTPUT POINTERS
MOVX S1,%RSUOK ;RETURN 'FLUSH' OK
$RETT ;HEAD BACK
OUTF.1: MOVE S1,J$LCHN(J) ;GET THE LPT JFN
TXO S1,CZ%ABT ;LITE THE ABORT BIT
PUSHJ P,$CLOSF ;CLOSE IT DOWN
PJRST OUTGET ;AND SET THE DEVICE UP AGAIN
IFN FTDN60,<
OUTF.2: $CALL OUTRES ;Reset output buffers
$RETT ;All to do for DN60
> ;End of FTDN60
SUBTTL Printer Output -- LPT Control Routines
;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+DEVOUT ;(11) THIS IS A TAB
EXP SUPRCH+EOLCHR+DOLF ;(12) THIS IS A LINE FEED
EXP SUPRCH+EOLCHR+<3>B17+DOFRAC ;(13) THIS SKIPS 1/3 PAGE (VERT TAB)
EXP SUPRCH+NCLRFF+EOLCHR+DOFORM ;(14) THIS IS A FORM-FEED
EXP NCLRFF+EOLCHR+DEVOUT ;(15) CARRIAGE RETURN
EXP CHKARO ;(16) CONTROL-N
EXP CHKARO ;(17) CONTROL-O
EXP SUPRCH+EOLCHR+<2>B17+DOFRAC ;(20) THIS SKIPS 1/2 PAGE
EXP SUPRCH+EOLCHR+<30>B17+DOFRAC ;(21) THIS SKIPS 2 LINES (DC1)
EXP SUPRCH+EOLCHR+<20>B17+DOFRAC ;(22) THIS SKIPS 3 LINES (DC2)
EXP SUPRCH+EOLCHR+DODC3 ;(23) DC3 SKIPS 1 LINE
EXP SUPRCH+EOLCHR+<6>B17+DOFRAC ;(24) THIS SKIPS 1/6 OF A PAGE (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 Printer Output -- FILOUT - Set Up For LPTIN and LPTOUT
; CALL WITH:
; PUSHJ P,FILOUT
; RETURN HERE
;
FILOUT: MOVE T1,J$FLIN(J) ;START AT TOP OF PAGE
MOVEM T1,J$XPOS(J) ;SAVE IT
PUSHJ P,SETPFT ;SETUP FILE TYPE
PUSHJ P,(T1) ;DISPATCH
TXNN S,RQB ;HAVE WE BEEN REQUEUED?
SKIPE J$XTOP(J) ;OR ARE WE AT TOP-OF-FORM?
POPJ P, ;YES TO EITHER,,JUST RETURN
AOS J$APRT(J) ;NO, CHARGE HIM FOR THE REST
AOS J$RNPP(J) ;HERE ALSO
POPJ P, ;AND RETURN
SUBTTL Printer Output -- SETLST - Compile Code For /REPORT
; CALL WITH:
; PUSHJ P,SETLST
; RETURN HERE
;
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
POPJ P, ;RETURN
;THE INSTRUCTIONS WHICH ARE GENERATED:
SETLSA: PUSHJ P,INPBYT
SETLSB: JUMPF .RETT
SETLSC: CAIE C,0
SETLSD: JRST FLUSH7
SUBTTL Printer Output -- 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:
;
; LPTOCT <--> /PRINT:OCTAL
; LPTCOB <--> /FILE:COBOL
; LPTFOR <--> /FILE:FORTRAN /PRINT:(ARROW,ASCII,SUPPRESS)
; LPTRPT <--> /FILE:ASCII /REPORT:XXX /PRINT:(ARROW,ASCII,SUP)
; LPTASC <--> /FILE:ASCII /PRINT:(ARROW,ASCII,SUPPRESS)
; LPTELV <--> /FILE:ELEVEN
;THE DETERMINATION IS DONE IN THE ABOVE ORDER
SETPFT: 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
MOVEI T1,LPTOCT ;ASSUME /PRINT:OCTAL
CAIN S2,%FPLOC ;IS IT?
POPJ P, ;YES, RETURN
MOVEI T1,LPTCOB ;NO, ASSUME /FILE:COBOL
CAIN S1,.FPFCO ;IS IT?
POPJ P, ;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?
POPJ P, ;YES, RETURN
MOVEI T1,LPTELV ;ASSUME /FILE:ELEVEN
CAIN S1,.FPF11 ;IS IT?
POPJ P, ;YES, RETURN
MOVEI T1,LPTASC ;ASSUME STANDARD ASCII
SKIPE .FPFR1(E) ;UNLESS /REPORT WAS SPECIFIED
MOVEI T1,LPTRPT ;USE REPORT ROUTINE
POPJ P, ;AND RETURN
SUBTTL Printer Output -- LPTASC - Print Regular ASCII on LPT
LPTASC: SOSL J$DBCT(J) ;COUNT DOWN AND JUMP IF DATA IS THERE.
JRST LPTA.2 ;GO GET A DATA BYTE.
PUSHJ P,INPBUF ;ELSE, GET A BUFFER FULL
JUMPT LPTASC ;IF OK,,CONTINUE PROCESSING.
$RETT ;ELSE RETURN.
LPTA.2: AOSL J$PRNT(J) ;Add to the check for eol counter
$CALL CHKMOT ;Check if eol has been detected
ILDB C,J$DBPT(J) ;GET A CHARACTER
CAIGE C,40 ;PRINTABLE ASCII?
JRST LPTA.5 ;NO, GO HANDLE SPECIAL CHARS
TXNE S,FORWRD ;ARE WE FORWARD SPACING?
JRST LPTASC ;YES,,SKIP THIS.
SETZM J$XTOP(J) ;CLEAR TOF FLAG
LPTA.3: SOSGE J$LBCT(J) ;ANY ROOM IN BUFFER?
JRST LPTA.4 ;NO, FILL IT
IDPB C,J$LBPT(J) ;YES, DEPOSIT IN BUFFER
JRST LPTASC ;AND GET ANOTHER
LPTA.4: PUSHJ P,OUTOUT ;GET A BUFFER
JRST LPTA.3 ;AND LOOP
LPTA.5: PUSHJ P,CHKSP ;GO HANDLE SPECIAL CHARS
JRST LPTASC ;AND LOOP AROUND
SUBTTL Printer Output -- LPTELV - Print MACY11 File as Regular ASCII
LPTELV: PUSHJ P,.SAVE1 ;PRESERVE P1
LPTE.1: SOSL J$DBCT(J) ;COUNT DOWN AND JUMP IF DATA IS THERE.
JRST LPTE.2 ;GO GET A DATA BYTE.
PUSHJ P,INPBUF ;ELSE, GET A BUFFER FULL
JUMPT LPTE.1 ;IF OK,,GET NEXT FOUR BYTES
$RETT ;ELSE RETURN.
LPTE.2: ILDB P1,J$DBPT(J) ;GET 4 BYTES TO PRINT
LDB C,[POINT 8,P1,17] ;GET THE FIRST BYTE
PUSHJ P,LPTE.3 ;PRINT IT
LDB C,[POINT 8,P1,9] ;GET SECOND BYTE
PUSHJ P,LPTE.3 ;PRINT IT
LDB C,[POINT 8,P1,35] ;GET THIRD BYTE
PUSHJ P,LPTE.3 ;PRINT IT
LDB C,[POINT 8,P1,27] ;GET FOURTH BYTE
PUSHJ P,LPTE.3 ;PRINT IT
JRST LPTE.1 ;GET THE NEXT FOUR BYTES
LPTE.3: AOSL J$PRNT(J) ;Add to the check for eol counter
$CALL CHKMOT ;Check if eol has been detected
CAIGE C,40 ;PRINTABLE ASCII?
JRST LPTE.6 ;NO, GO HANDLE SPECIAL CHARS
TXNE S,FORWRD ;ARE WE FORWARD SPACING?
POPJ P, ;YES,,SKIP THIS.
SETZM J$XTOP(J) ;CLEAR TOF FLAG
LPTE.4: SOSGE J$LBCT(J) ;ANY ROOM IN BUFFER?
JRST LPTE.5 ;NO, FILL IT
IDPB C,J$LBPT(J) ;YES, DEPOSIT IN BUFFER
POPJ P, ;AND GET ANOTHER
LPTE.5: PUSHJ P,OUTOUT ;GET A BUFFER
JRST LPTE.4 ;AND LOOP
LPTE.6: PUSHJ P,CHKSP ;GO HANDLE SPECIAL CHARS
POPJ P, ;AND LOOP AROUND
SUBTTL Printer Output -- LPTFOR - Process FORTRAN Data Files
LPTFOR: SOSLE J$DBCT(J) ;AND CHARACTERS LEFT
JRST LPTF.1 ;YUP, GET THEM
PUSHJ P,INPBUF ;NO, GET MORE DATA
JUMPF .RETT ;RETURN AT EOF
LPTF.1: AOSL J$PRNT(J) ;Add to the check for eol counter
$CALL CHKMOT ;Check if eol has been detected
ILDB C,J$DBPT(J) ;GET ONE
JUMPE C,LPTFOR ;IGNORE NULLS
TXZE S,FCONV ;CHECK FOR CTL CHAR
JRST FORCNV ;GO DO IT
CAIN C,.CHLFD ;LINEFEED?
TXOA S,FCONV!LFTMAR ;FLAG NEXT CHAR AS CTL CHAR
PUSHJ P,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
PUSHJ P,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: PUSHJ P,LPTOUT ;SEND THE CHARACTER
SOSLE J$XFRC(J) ;COUNT DOWN THE REPEAT COUNTER
JRST FORC.3 ;AND LOOP
JRST LPTFOR ;AND CONTINUE
SUBTTL Printer Output -- LPTRPT - Process REPORT Files
LPTRPT: PUSHJ P,INPBYT ;GET A BYTE FROM THE FILE
JUMPF .RETT ;AND RETURN WHEN DONE
PUSHJ P,LPTOUT ;DO ALL THE CHECKING
JRST LPTRPT ;AND GET ANOTHER
SUBTTL Printer Output -- LPTOCT - Give an Octal Dump
LPTOCT: PUSHJ P,.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
PUSHJ P,DEVOUT ;ONE
PUSHJ P,DEVOUT ;TWO
PUSHJ P,DEVOUT ;THREE
PUSHJ P,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
PUSHJ P,DEVOUT ;PRINT CHAR
SOJG T4,OCT5 ;END OF WORD?
SOJG T3,OCT4 ;END OF LINE?
HLRZ C,P2 ;GET MOTION CHARACTER
PUSHJ P,DEVOUT ; ..
SOJG T2,OCT3 ;END OF BLOCK?
PUSHJ P,DEVOUT ;YES--2 EXTRA LINE FEEDS
PUSHJ P,DEVOUT ; ..
SOJG T1,OCT2 ;END OF PAGE?
MOVEI C,.CHFFD ;PRINT A FORM FEED
PUSHJ P,DOFORM ;AND ENFORCE QUOTA ETC.
JRST OCT1 ;PRINT NEXT PAGE
SUBTTL Printer Output -- LPTCOB - Process COBOL Sixbit Files
LPTCOB: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
SETZM J$XTOP(J) ;CAUSE A FORM FEED AT END
PUSHJ P,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
PUSHJ P,INPBYT ;GET A WORD
JUMPF COBOL5 ;EOF
SOJG T1,.-2 ;LOOP FOR MORE
COBOL1: PUSHJ P,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$XPOS(J) ;AND DECREMENT POSITION
COBOL3: PUSHJ P,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
PUSHJ P,DEVOUT ;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
PUSHJ P,DEVOUT ;PRINT IT
MOVEI C,.CHLFD ;LOAD A LINE FEED
PUSHJ P,DOLF ;AND SEND EOL
JRST COBOL1 ;LOOP FOR MORE.
COBOL5: MOVEI C,.CHFFD ;GET A FORM FEED.
PUSHJ P,DEVOUT ;PUT IT OUT.
$RETT ;AND RETURN.
SUBTTL Printer Output -- Character Interrogation Routines
;SUBROUTINE TO PLACE A CHAR ON THE LINE PRINTER
;CALL WITH:
; PUSHJ P,LPTOUT
; RETURN HERE (EOF SET IF OVER LIMIT)
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 DEVOUT ;PRINT IT
CHKSP: MOVE S1,CHTAB(C) ;GET THE DISPATCH
TXNE S1,EOLCHR ;IS THIS AN END OF LINE CHARACTER?
TXO S,NEWLIN!LFTMAR ;YES,,LITE NEW LINE BIT
TXNE S,SUPFIL!SUPJOB ;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
FLUSH7: PUSHJ P,INPBYT ;GET A BYTE
JUMPF .RETT ;RETURN ON EOF
PUSHJ P,ISEOL ;END OF LINE?
JUMPF FLUSH7 ;NO--LOOP FOR REST OF LINE
FLUSH8: PUSHJ P,INPBYT ;GET A BYTE
JUMPF .RETT ;RETURN ON EOF
PUSHJ P,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 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
PUSHJ P,DEVOUT ;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
TXNE S,LATSPL!TTYSPL ;[6013] LAT or TTY
SKIPA ;[6005] Not at top, or top and TTY
POPJ P, ;[6005] Do not print blank page on LPT
MOVN S1,J$XPOS(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
POPJ P, ;ONLY 1 LINE FEED IN A ROW
;**;[6046]At DOSUP:+3L delete 1 line JYCW 1/16/89
SETO S1,
JRST CNTDWN ;CHARGE FOR THE LINE
;HERE TO DO ARROW MODE STUFF IF NEEDED
CHKARO: TXNN S,ARROW!SUPJOB ;ARROW MODE (From OPR SUPPRESS comd
JRST DEVOUT ;NO--JUST PRINT
DOARO: PUSH P,C ;SAVE C
MOVEI C,"^" ;LOAD A ^
PUSHJ P,DEVOUT ;PRINT THE ^
POP P,C ;RESTORE C
MOVEI C,100(C) ;MAKE INTO REAL LETTER
PJRST DEVOUT ;PRINT
;HERE ON A DC3
DODC3: SETOM S1 ;DC3 SKIPS 1 LINE
JRST CNTDWN ;AND COUNT DOWN
;HERE IF SPECIAL CHARACTER SKIPS A FRACTION OF A PAGE
DOFRAC: HLRZS S1 ;GET 0,,FRACTION
ANDI S1,777 ;AND OUT FLAGS
MOVE T1,J$FLIN(J) ;GET CURRENT PAGE SIZE
IDIVI T1,(S1) ;FIND THE RIGHT PART
MOVE T2,J$XPOS(J) ;GET CURRENT POSITION
SOJL T2,[MOVN S1,J$XPOS(J) ;COPY VPOS
SUBI S1,3 ;SUBTRACT 3
JRST CNTDWN] ;AND CHARGE HIM
IDIVI T2,(T1) ;GET RESIDUE MOD SKIPSIZE
MOVNI S1,1(T3) ;AND MAKE IT NEGATIVE
JRST CNTDWN ;GO CHECK QUOTA
SUBTTL Printer Output -- 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 DEVOUT ;IF NOT,,JUST DUMP IT OUT.
CAIN C,.CHFFD ;IS IT A FORM FEED?
JRST CNTDW1 ;YES,,SKIP THIS.
ADDB S1,J$XPOS(J) ;REDUCE VERTICAL POSITION
JUMPG S1,DEVOUT ;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 DEVOUT ;HE WINS
CNTDW1: MOVE S1,J$FLIN(J) ;BACK TO TOP OF PAGE
MOVEM S1,J$XPOS(J) ;SAVE POSITION
SOSG J$FPIG(J) ;DECREMENT THE FORWARD SPACING COUNT.
JRST [TXZ S,FORWRD ;TURN OFF THE FORWARD SPACE BIT.
SKIPE J$FPIG(J) ;DID WE JUST FINISH FORWRD SPACE
JRST .+1 ;NO, CONTINUE
PUSHJ P,SENDFF ;JUST FINISH, SEND A FF
SETZM C ;ZAP THE CHARACTER
JRST .+1] ;AND CONTINUE
AOS J$RNPP(J) ;ADD 1 TO PAGES PER COPY COUNTER
TXNE S,FORWRD ;FORWARD SPACING?
JRST CNTDW2 ;Continue on
AOS J$APRT(J) ;NO,,ADD 1 TO TOTAL PAGES COUNTER
;Continued on next page
;Continued from previous page
;Here we keep track of where we are for backspaceing
CNTDW2: MOVE S1,J$FCBC(J) ;GET NUMBER OF BYTES IN THIS BUFFER
SUB S1,J$DBCT(J) ;CALC BYT POS OF THIS PAGE IN THIS BUFR
ADD S1,J$FTBC(J) ;CALC BYT POS OF THIS PAGE IN THIS FILE
MOVEM S1,@J$FBPT(J) ;SAVE THE PAGE ADDRESS IN THE PAGE TABLE
AOS S1,J$FBPT(J) ;BUMP TO NEXT PAGE TABLE ENTRY
CAIG S1,J$FPAG+PAGSIZ-1(J) ;ARE WE AT THE END OF THE PAGE TABLE?
JRST CNTDW3 ;NO,,CONTINUE ON
TXO S,FBPTOV ;YES,,LITE PAGE TABLE OVERFLOW FLAG
MOVEI S1,J$FPAG(J) ;AND WRAP THE
MOVEM S1,J$FBPT(J) ; PAGE TABLE AROUND ITSELF
CNTDW3: PUSH P,C ;SAVE THE CURRENT CHAR
PUSHJ P,CHKALN ;CHECK FOR ALIGNMENT
POP P,C ;RESTORE THE OLD CHARACTER
MOVEI S1,3 ;LOAD A 3
CAIN C,23 ;GET HERE VIA DC3?
ADDM S1,J$XPOS(J) ;YES, GIVE HIM 3 XTRA LINES
CAIE C,23 ;WAS IT A DC3
JRST [SKIPG J$FPIG(J) ;FORWARD SPACE?
SETOM J$XTOP(J) ;NO, SET TOP OF FORM
JRST .+1] ;CONTINUE
$CALL LIMCHK ;Go check the limit
JUMPT DEVOUT ;Output character and return (not here)
$CALL INPFEF ;Error - force an EOF
$RET
SUBTTL Printer Output -- 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. If so, then check with the operator to see
if the job should proceed. If ignore then set the bit and return. If the
jobe is to be aborted, then set that bit. In any case, if the job can be
continued, return true.
\
LIMCHK: MOVE S1,J$RLIM(J) ;GET LIMIT
SUB S1,J$APRT(J) ;GET AMOUNT PRINTED
SKIPGE J$FPIG(J) ;FORWARD SPACE?
SETZM J$FPIG(J) ;NO, ALWAYS ZERO
TXNN S,ABORT+GOODBY ;ARE WE ON OUR WAY OUT OR
SKIPL S1 ; STILL UNDER QUOTA?
JRST LIMC.5 ;Yes, return true
GETLIM S1,.EQLIM(J),FLEA ;GET FORMS-LIMIT-EXCEED ACTION
CAIN S1,.STCAN ;SEE IF CANCEL
JRST LIMC.4 ;IT WAS, DO IT
CAIN S1,.STIGN ;SEE IF IGNORE
JRST LIMC.5 ;Yes, return true
;DEFAULT TO ASK IF NOT IGNORE OR CANCEL
LIMC.1: MOVE S1,STREAM ;GET THE STREAM NUMBER
SETZM JOBCHK(S1) ;SAY WE WANT TO TAKE A CHECKPOINT
SETOM JOBUPD(S1) ;UPDATE THE STATUS ALSO
SKIPL J$REMR(J) ;[6044]REQUEST ORIGINATE REMOTELY?
IFSKP. ;[6044]
$WTOR (Page Limit Exceeded,<^I/RMJOBI/^T/LIMSG/>,@JOBOBA(S1),JOBWAC(S1))
ELSE. ;[6044]
$WTOR (Page Limit Exceeded,<^R/.EQJBB(J)/^T/LIMSG/>,@JOBOBA(S1),JOBWAC(S1))
ENDIF. ;[6044]
$DSCHD (PSF%OR) ;WAIT FOR OPERATOR RESPONSE
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED OR REQUEUED?
JRST LIMC.2 ;YES,,IGNORE THE ERROR
MOVEI S1,LIMANS ;POINT TO THE LIMIT ANSWER BLOCK
HRROI S2,J$RESP(J) ;POINT TO THE ANSWER
PUSHJ P,S%TBLK ;DO WE MATCH?
TXNE S2,TL%NOM+TL%AMB ;DID WE FIND IT OK?
JRST LIMC.1 ;NO,,STUPID OPERATOR SO TRY AGAIN
MOVE S2,STREAM ;Get the stream number
SETOM JOBUPD(S2) ;Yes, update the stream's status
HRRZ S1,0(S1) ;GET THE ROUTINE ADDRESS
JRST 0(S1) ;AND PROCESS THE RESPONSE
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
;IF ANSWER WAS 'PROCEED' COME HERE
LIMC.2: MOVX S1,.STIGN ;YES,,GET THE IGNORE BITS
STOLIM S1,.EQLIM(J),FLEA ;SAVE IT AS NEW LIMIT EX ACTION
JRST LIMC.5 ;Return true
;IF ANSWER WAS 'ABORT' COME HERE
LIMC.3: MOVE S1,STREAM ;GET THE STREAM NUMBER
SKIPL J$REMR(J) ;[6044]REQUEST ORIGINATE REMOTELY?
IFSKP. ;[6044]
$WTO (Aborting,<^I/RMJOBI/>,@JOBOBA(S1)) ;[6044]TELL THE OPERATOR
ELSE. ;[6044]
$WTO (Aborting,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;[6044]TELL THE OPERATOR
ENDIF. ;[6044]
LIMC.4: $TEXT(LOGCHR,<^I/LPERR/Page Limit Exceeded>)
SETZM J$XTOP(J) ;CLEAR TOP-OF-FORM FLAG
PUSHJ P,SENDFF ;SEND A FORM FEED
TXO S,ABORT ;LIGHT THE ABORT BIT
$RETF ;Limit exceeded, don't continue
LIMC.5: $RETT ;OK to proceed
LIMANS: $STAB
KEYTAB (LIMC.3,ABORT) ;ABORT
KEYTAB (LIMC.2,PROCEED) ;PROCEED
$ETAB
LIMSG: ASCIZ/
Type 'RESPOND <number> ABORT' to terminate the job now
Type 'RESPOND <number> PROCEED' to allow the job to continue printing/ ;[6012]
;SUBROUTINE TO DETERMINE IF EOL CHARACTER HAS BEEN DETECTED
CHKMOT: MOVE S1,J$WITH(J) ;Pick up the counter size
MOVEM S1,J$PRNT(J) ;Reset the eol counter
TXZE S,LFTMAR ;EOL character been detected?
$RET ;Yes
CHKM2: MOVE S1,STREAM ;Pick up the stream number
$WTOR(<Unprintable line detected>,<^T/CONMSG/>,@JOBOBA(S1),JOBWAC(S1))
SETZM JOBCHK(S1) ;Checkpoint
SETOM JOBUPD(S1) ;Send update also
$DSCHD (PSF%OR) ;Wait for OPERATOR respond
TXNE S,ABORT+RQB ;Canceled or requeued?
$RET ;Yes, so return
MOVEI S1,LONLIN ;Point to response possibilities
HRROI S2,J$RESP(J) ;Point to operator's response
$CALL S%TBLK ;See if have valid response
TXNE S2,TL%NOM+TL%AMB ;Match
JRST CHKM2 ;No, try again
MOVE S2,STREAM ;Get the stream number
SETOM JOBUPD(S2) ;Yes, update the stream's status
HRRZ S1,0(S1) ;Pick up processing routine adr
JRST 0(S1) ;Go do it
CHKM3: SETZM S1 ;Zero out
TLO S1,(1B0) ;Pick up a large negative number
MOVEM S1,J$PRNT(J) ;A very large file
CHKM4: $RET ;And return
CHKM5: SETOM J$OPRA(J) ;OPERATOR canceled this job
$CALL KILL ;This job is being aborted
SETZM JOBITS ;Turn off the Status bits
SKIPE IMESS ;Any messages?
$CALL C%REL ;Yes, so cancel
SETZM IMESS ;No outstanding messages
$RET ;And return
LONLIN: $STAB ;
KEYTAB (CHKM5,ABORT) ;
KEYTAB (CHKM4,ASK) ;
KEYTAB (CHKM3,PROCEED) ;
$ETAB ;
CONMSG: ASCIZ/
Type 'RESPOND <number> ABORT' to terminate printing of the job
Type 'RESPOND <number> ASK' to continue printing with checking
Type 'RESPOND <number> PROCEED' to continue printing with no checking
/
;SUBROUTINE TO OUTPUT ONE CHAR ON SELECTED DEVICE
;CALL WITH:
; PUSHJ P,DEVOUT
; RETURN HERE (HALTS IF ERROR)
;
DEVOUT: TXNE S,FORWRD ;ARE WE FORWRD SPACING?
POPJ P, ;YES,,RETURN.
DEVO.0: SOSGE J$LBCT(J) ;DECREMENT THE BYTE COUT
JRST DEVO.1 ;LOSE, GO DUMP THE BUFFER
IDPB C,J$LBPT(J) ;DEPOSIT A BYTE
POPJ P, ;AND RETURN
DEVO.1: PUSH P,S1 ;SAVE S1
PUSHJ P,OUTOUT ;DUMP THE BUFFER
POP P,S1 ;RESTORE S1
JRST DEVO.0 ;AND TRY AGAIN
;SENDFF - ROUTINE TO SEND A FF IF J$XTOP IS OFF
;
SENDFF: MOVEI C,.CHFFD ;LOAD A FF
SKIPN J$XTOP(J) ;SKIP IF ALREADY AT TOP
PUSHJ P,DEVOUT ;NO, SEND IT
SETOM J$XTOP(J) ;SET THE FLAG
POPJ P, ;RETURN
CHKALN: SKIPL J$APRG(J) ;IS AN ALIGNMENT SCHEDULED?
POPJ P, ;NO,,RETURN.
PUSHJ P,ALIGN ;YES,,THEN DO IT.
$RETT ;RETURN TO HIS CALLER.
SUBTTL Printer Output -- Subroutines to Send Messages To Output Device
;Since output to the output-device is interruptable $TEXT calls which
; send characters directly to the device cannot be done.
;
;A per-context buffer (J$XTBF) is defined to store $TEXT'ed characters
; in and the following set of subroutines exist to initialize,
; deposit characters in, and dump this buffer to the output device.
;TBFINI initializes the byte-pointer to J$XTBF
TBFINI: MOVEI S1,J$XTBF(J) ;GET THE ADDRESS OF THE BUFFER
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVEM S1,J$XTBP(J) ;STORE IT
MOVEI S2,0 ;LOAD A NULL
IDPB S2,S1 ;AND INITIALIZE THE BUFFER
$RETT ;AND RETURN
;TBFCHR is the $TEXT subroutine to deposit characters in the text buffer.
TBFCHR: IDPB S1,J$XTBP(J) ;DEPOSIT THE CHARACTER
$RETT ;RETURN
;TBFDMP dumps the text buffer to output device and re-initializes the buffer
TBFDMP: SETZ S1, ;CLEAR THE AC
IDPB S1,J$XTBP(J) ;DEPOSIT THE BYTE
MOVEI S1,J$XTBF(J) ;GET ADDRESS OF BUFFER
PUSHJ P,BFRDMP ;DUMP THE BUFFER
PJRST TBFINI ;RE-INIT THE BUFFER AND RETURN
;STGOUT is included to allow dumping of any arbitrary buffer of characters
; Call with S1 containing either a byte pointer or the address of the buffer
STGOUT: PUSH P,S1 ;SAVE S1
PUSHJ P,TBFDMP ;FORCE ANY BUFFERED STUFF OUT
POP P,S1 ;RESTORE S1
;AND FALL INTO BFRDMP
;BFRDMP to dump the buffer pointed to by S1
BFRDMP: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;PUT THE POINTER IN P1
TLNN P1,-1 ;IS LEFT HALF ZERO
HRLI P1,(POINT 7,0) ;YES, MAKE IT A BYTE POINTER
BFRD.1: ILDB C,P1 ;GET A CHARACTER
JUMPE C,.RETT ;RETURN WHEN DONE
SETZM J$XTOP(J) ;CLEAR THE TOP-OF-FORM FLAG
CAIN C,.CHFFD ;IS IT A FORMFEED?
SETOM J$XTOP(J) ;YES, SET IT
PUSHJ P,DEVOUT ;OUTPUT THE CHARACTER
JRST BFRD.1 ;AND LOOP
SUBTTL Printer Output -- Generate Headers and Trailers
;JOB HEADERS AND TRAILERS
JOBTRL: MOVEI T4,[ASCIZ /END/] ;ADDRESS OF END TEXT
TXNE S,RQB ;CLEAR REQUE AND SKIP IF NOT SET
MOVEI T4,[ASCIZ /REQUE/] ;SAY SO
PUSHJ P,GIVHDR ;GO SETUP THE LINE
JRST TRAILR ;AND NOW GO PRINT THE TRAILER
JOBHDR: MOVEI T4,LPTERR ;ALLOW FOR LPT ERRORS HERE
MOVEM T4,J$LERR(J) ;STORE COUNTER
MOVEI T4,[ASCIZ /START/] ;ADDRESS OF START TEXT
PUSHJ P,GIVHDR ;GO SET THE LINE
JRST BANNER ;AND GO PRINT THE BANNER PAGES
GIVHDR: SKIPL J$REMR(J) ;[6044]REQUEST ORIGINATE REMOTELY?
IFSKP. ;[6044]
$TEXT (<-1,,J$XHBF(J)>,<^T7C*/0(T4)/ ^I/RMJOBI/ Date ^H/[-1]/ Monitor ^T65L /LPCNF/^A>)
ELSE. ;[6044]
$TEXT (<-1,,J$XHBF(J)>,<^T7C*/0(T4)/ ^R/.EQJBB(J)/ Date ^H/[-1]/ Monitor ^T65L /LPCNF/^A>)
ENDIF. ;[6044]
MOVE S1,J$FWID(J) ;GET THE PAGE WIDTH
SUBI S1,10 ;[6022] Back over the *stuff*
MOVEI S2,J$XHBF(J) ;[6022] Point to start of string
HRLI S2,(Point 7) ;[6022] Make that a byte pointer
ADJBP S1,S2 ;[6022] Point to the last-7th column
MOVEM S1,TEXTBP ;[6022] Save it there
$TEXT (DEPBP,< ^T7C*/0(T4)/^0>) ;[6022] Put the *stuff* at end
$RETT ;RETURN.
SUBTTL Printer Output -- BANNER - Print A Banner
BANNER: PUSHJ P,.SAVE3 ;SAVE P1 THRU P3
SKIPN P3,J$FBAN(J) ;GET NUMBER OF BANNER PAGES
POPJ P, ;RETURN WHEN DONE
$TEXT(<-1,,J$PUSR(J)>,<^T/.EQOWN(J)/^0>) ;[6012] Copy user name over
BANN.1: PUSHJ P,SENDFF ;SEND A FORM FEED
SETZM J$XPOS(J) ;AND SET 0 POSITION
;[6012] MOVEI T1,4 ;LOAD AN OFFSET
;[6012] CAIN P3,1 ;IS THIS THE LAST BANNER?
;[6012] ADDM T1,J$XPOS(J) ;YES, DON'T PRINT OVER CREASE
PUSHJ P,BANN.2 ;PRINT A BANNER PAGE
SOJG P3,BANN.1 ;AND LOOP
POPJ P, ;RETURN
BANN.2: PUSHJ P,PLPBUF ;PRINT A LINE
MOVE S1,J$TCHR+$TDFLG(J) ;[6005] Get flag bits
TXNE S,LATSPL!TTYSPL ;[6013] LAT or TTY
TXNE S1,FL$FUL ;[6005] Full banner,header,trailer?
SKIPA ;[6005] Yes, full pages or real printer
JRST BANN.3 ;[6005] Yes, first line and note only
PUSHJ P,PLPBUF ;PRINT ANOTHER LINE
PUSHJ P,CRLF ;TYPE A CRLF
MOVEI S1,1 ;LOAD THE BLOCKSIZE
MOVEI S2,J$PUSR(J) ;AND THE STRING ADDRESS
PUSHJ P,PICTUR ;AND PRINT A PICTURE
MOVEI T1,^D12 ;COUNT'EM
ADDM T1,J$XPOS(J) ;...
PUSHJ P,PLPBUF ;PRINT A LINE
PUSHJ P,PLPBUF ;AND ANOTHER
PUSHJ P,PLPBUF ;AND A THIRD
BANN.3: MOVEI T1,[0,,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
$TEXT(<-1,,J$PNOT(J)>,<^T/0(T1)/^W6/T2/^W/T3/^0>)
MOVEI S1,1 ;GET THE BLOCKSIZE
MOVEI S2,J$PNOT(J) ;GET THE ADDRESS
PUSHJ P,PICTUR ;AND SEND IT OUT
MOVEI S1,^D11 ;LOAD NUMBER OF LINES
ADDM S1,J$XPOS(J) ;AND MOVE DOWN THE PAGE
PJRST PLINES ;GO TO EOP AND RETURN
SUBTTL Printer Output -- TRAILR - Print a Trailer
TRAILR: PUSHJ P,.SAVE3 ;SAVE P1 - P3
MOVE P3,J$FTRA(J) ;AND THE NUMBER OF TRAILERS
TXNE S,SUPFIL!SUPJOB ;Are we suppressing forms?
SETZM J$XTOP(J) ;Don't believe we are at top of forms.
PUSHJ P,SENDFF ;SEND A FORMFEED
JUMPE P3,OUTDMP ;RETURN IF ZERO
TRAI.1: SETZM J$XPOS(J) ;[6012] Clear the vertical position
PUSHJ P,TRAI.3 ;PRINT THE INTERNAL LOG
PUSHJ P,PLINES ;PRINT TILL END OF PAGE
$CALL SENDFF ;[6012] Send a final form feed
SOJG P3,TRAI.1 ;LOOP UNTIL DONE
PJRST OUTDMP ;AND DUMP BUFFERS AND RETURN
;HERE TO PRINT THE INTERNAL LOG
TRAI.3: SKIPN J$GNLN(J) ;ANYTHING IN THE INTERNAL LOG?
POPJ P, ;NO, RETURN
PUSHJ P,PLPBUF ;YES PRINT A LINE
MOVE S1,J$TCHR+$TDFLG(J) ;[6005] Get flag bits
TXNE S,LATSPL!TTYSPL ;[6013] LAT or TTY
TXNE S1,FL$FUL ;[6005] Full banner,header,trailer?
SKIPA ;[6005] Yes, full pages or real printer
PJRST SENDFF ;[6005] Yes, save paper on selected TTY
PUSHJ P,PLPBUF ;AND ANOTHER LINE
MOVEI C,.CHTAB ;LOAD A TAB
MOVE T1,J$FWCL(J) ;GET THE WIDTH CLASS
PUSHJ P,DEVOUT ;PRINT A TAB
SOJG T1,.-1 ;PRINT N OF THEM
MOVEI S1,[ASCIZ /* * * L P T S P L R u n L o g * * *
/]
PUSHJ P,STGOUT ;AND DUMP IT
MOVE T2,J ;COPY OVER J
MOVE T3,J$GINP(J) ;GET NUMBER OF PAGES
TRAI.4: MOVE S1,J$GBUF(T2) ;GET ADR OF BUFFER
PUSHJ P,STGOUT ;AND DUMP IT OUT
MOVE S1,J$GBUF(T2) ;GET THE PAGE ADDRESS
CAME T2,J ;SKIP IF THIS IS THE PRE-ALLOCATED PAGE
PUSHJ P,M%RPAG ;AND RELEASE IT
SOSLE T3 ;DECREMENT COUNT
AOJA T2,TRAI.4 ;AND LOOP IF NOT DONE
PUSHJ P,CRLF ;PRINT 1 CRLF
PUSHJ P,CRLF ;AND ANOTHER
PUSHJ P,CRLF ;AND ANOTHER
MOVE T1,J$GNLN(J) ;GET NUMBER OF LOG LINES
ADDI T1,5 ;ADD IN THE OVERHEAD
ADD T1,J$XPOS(J) ;AND ACCUMULATE VERTICAL POSITION
IDIV T1,J$FLIN(J) ;DID WE OVERFLW A PAGE?
MOVEM T2,J$XPOS(J) ;SAVE CURRENT POSITION
SETZM J$GNLN(J) ;AND DON'T PRINT IT AGAIN
SUB P3,T1 ;REDUCE PAGES TO PRINT
POPJ P, ;AND RETURN
SUBTTL Printer Output -- Utility Routines
PLPBUF: MOVEI S1,J$XHBF(J) ;GET ADDRESS OF THE LINE
PUSHJ P,STGOUT ;AND DUMP IT
PUSHJ P,CR23 ;END THE LINE WITH A CR23
PUSHJ P,CR23 ;PRINT A CR23
PUSHJ P,CR23 ;AND ANOTHER
PUSHJ P,CR23 ;AND ANOTHER
MOVEI S1,4 ;WE PRINT 4 LINES
ADDM S1,J$XPOS(J) ;ADD TO COUNT
POPJ P,
PLINES: TXNE S,LATSPL!TTYSPL ;[6013] LAT or TTY
POPJ P, ;[6005] YES, SAVE PAPER AND LAYOUT
MOVE T2,J$FLIN(J) ;GET LINES/PAGE
ADDI T2,1 ;ACCOUNT FOR MARGIN
SUB T2,J$XPOS(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
PUSHJ P,PLPBUF ;PRINT A LINE (4 LINES)
JRST PLINE1 ;AND LOOP
PEOP: MOVE T2,J$FLIN(J) ;GET NUMBER OF LINES/PAGE
SUB T2,J$XPOS(J) ;SUBTRACT THOSE PRINTED
ADDI T2,1 ;COUNT THE MARGIN
SKIPE J$LREM(J) ;[6005] IS THIS A REMOTE LPT ???
POPJ P, ;[6005] YES,,RETURN
PEOP1: JUMPLE T2,PEOP2 ;GO FINISH OFF
PUSHJ P,CR23 ;PRINT A CR23
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,^D132 ;[6022] Is it reasonable?
MOVEI P3,^D132 ;[6022] Now it is
PEOP4: ILDB C,P2 ;GET A CHARACTER
PUSHJ P,DEVOUT ;PUT A CHARACTER
SOJG P3,PEOP4 ;LOOP
PUSHJ P,CR23 ;SEND LF OR DC3
AOBJN P1,PEOP3 ;LOOP FOR ALL RULER LINES
POPJ P, ;AND RETURN
CR23: SKIPE J$MTAP(J) ;SPOOLING TO TAPE?
JRST CRLF ;YES,,JUST INSERT CRLF
MOVEI S1,[BYTE (7) 15,23,0,0,0] ;PRINT OUT CR23
SKIPA ;SKIP CRLF ENTRY POINT
CRLF: MOVEI S1,[BYTE (7) 15,12,0,0,0] ;PRINT AT CRLF
PUSHJ P,STGOUT ;PUT IT OUT
$RET ;AND RETURN
SUBTTL Printer Output -- STARS - Job Separation Lines
STARS: POINT 7,STARS1 ;LINE 1
POINT 7,STARS2 ;LINE 2
POINT 7,STARS3 ;LINE 3
STARS1: ASCII /000000000000000000000000000000000000000000000000000000000000/
ASCII /000000000000000000000000000000000000000111111111111111111111/
ASCIZ /111111111111/ ;[6022]
STARS2: ASCII /000000000111111111122222222223333333333444444444455555555556/
ASCII /666666666777777777788888888889999999999000000000011111111112/
ASCIZ /222222222333/ ;[6022]
STARS3: ASCII /123456789012345678901234567890123456789012345678901234567890/
ASCII /123456789012345678901234567890123456789012345678901234567890/
ASCIZ /123456789012/ ;[6022]
SUBTTL Printer Output -- HEAD - Generate File-Header Pages
HEAD: PUSHJ P,.SAVE3 ;SAVE SOME ACS
TXNE S,SUPFIL!SUPJOB ;Are we suppressing forms?
SETZM J$XTOP(J) ;Don't believe we are at top of forms.
LOAD P1,.FPINF(E),FP.NFH ;GET THE NO HEADER BIT
SKIPE P1 ;SKIP IF WE WANT HEADERS
JRST [MOVE S1,J$FPIG(J) ;GET THE /BEGIN:X PAGES
CAIG S1,1 ;NO PAGES
PUSHJ P,SENDFF ;SEND FORM FEED
PJRST OUTDMP] ;DUMP BUFFERS AND RETURN
PUSHJ P,SENDFF ;NOW SEND A FORM FEED
SKIPN P3,J$FHEA(J) ;GET NUMBER OF PICTURE PAGES
PJRST OUTDMP ;DUMP BUFFERS AND RETURN
PUSHJ P,SETHDR ;SETUP THE FILENAME FOR BLOCK LETTERS
PUSHJ P,HEAD.1 ;PRINT THE HEADER
SOJG P3,.-1 ;LOOP FOR THE WHOLE WORKS
PJRST OUTDMP ;FORCE EVERYTHING OUT, AND RETURN
HEAD.1: MOVE S1,J$TCHR+$TDFLG(J) ;[6005] Get flag bits
TXNE S,LATSPL!TTYSPL ;[6013] LAT or TTY
TXNE S1,FL$FUL ;[6005] Full banner,header,trailer?
SKIPA ;[6005] Yes, full pages or real printer
JRST HEAD.2 ;[6005] Yes, no block letters
MOVE S1,J$PFLS(J) ;GET BLOCKSIZE
MOVEI S2,J$PFL1(J) ;AND ADDRESS OF FIRST LINE
PUSHJ P,PICTUR ;PRINT THE LINE
MOVE S1,J$PFLS(J) ;[6012] Get blocksize
MOVEI S2,J$PFL2(J) ;[6012] and address of second line
PUSHJ P,PICTUR ;[6012] and print the second line
HEAD.2: MOVE P1,J$FWCL(J) ;LOAD THE WIDTH CLASS
MOVEI S1,J$XHBF(J) ;LOAD ADDRESS OF BANNER LINE
PUSHJ P,STGOUT ;AND SEND IT
MOVE S1,J$DIFN(J) ;GET THE IFN
MOVX S2,FI.CRE ;WANT CREATION TIME
PUSHJ P,F%INFO ;GET IT
MOVEI S2,[ASCIZ / /] ;GET A STRING
CAIE P1,3 ;WIDTH CLASS 3?
MOVEI S2,[BYTE (7) .CHCRT,.CHLFD,.CHTAB,0]
MOVE P1,S2 ;Remember for short or long lines
MOVE T1,J$TFIL(J) ;[6000]PICK UP IF TEMPORARY FILE OR NOT
$TEXT(TBFCHR,<^M^JFile ^I/@FILTYP(T1)/, created: ^H/S1/,^T/(P1)/printed: ^H/[-1]/>)
PUSHJ P,TBFDMP ;AND DUMP THE BUFFER
GETLIM S1,.EQLIM(J),FORM ;GET FORMS NAME
$TEXT(TBFCHR,<Job parameters: Request created:^H/.EQAFT(J)/ Page limit:^D/J$RLIM(J)/^T/(P1)/ Forms:^W/S1/ Account:^T/.EQACT(J)/^A>)
;Continued on next page
;Continued from previous page
GETLIM S1,.EQLIM(J),NOT1 ;GET FIRST HALF OF NOTE
GETLIM S2,.EQLIM(J),NOT2 ;GET SECOND HALF OF NOTE
SKIPE S1 ;IS THERE A NOTE?
$TEXT(TBFCHR,< Note:^W6/S1/^W/S2/^A>)
PUSHJ P,CRLF ;END THE LINE
PUSHJ P,TBFDMP ;AND DUMP IT
LOAD S1,.FPINF(E),FP.FSP ;GET /SPACING
LOAD S2,.FPINF(E),FP.FCY ;GET THE TOTAL COPY COUNT
LOAD T1,J$RNCP(J) ;GET THE COPIES DONE SO FAR
ADDI T1,1 ;MAKE THIS THE CURRENT COPY
$TEXT(TBFCHR,<File parameters: Copy: ^D/T1/ of ^D/S2/ Spacing:^W/SPCTAB-1(S1)/^A>)
PUSHJ P,TBFDMP ;SEND THE LINE
LOAD S1,.FPINF(E),FP.FPF ;GET /PRINT
LOAD S2,.FPINF(E),FP.FFF ;GET /FILE
CAXN S2,.FPF8B ;/FILE:8-BIT?
MOVEI S2,4 ;YES, RECORD THE VALUE
CAXN S2,.FPF11 ;/FILE:ELEVEN?
MOVEI S2,5 ;YES,,RECODE THE VALUE
$TEXT(TBFCHR,<^T/(P1)/ File format:^W/FFMTAB-1(S2)/ Print mode:^W/FMTAB-1(S1)/^A>)
LOAD S1,.FPINF(E),FP.DEL ;GET /DELETE BIT
SKIPE S1 ;IS IT SET?
$TEXT(TBFCHR,< /DELETE^A>) ;YES,,SAY SO
PUSHJ P,CRLF ;END THE LINE
MOVE S1,J$FPIG(J) ;GET STARTING PAGE
CAILE S1,1 ;SKIP IF 0 OR 1
JRST [$TEXT(TBFCHR,<^M^JPrinting will start at page ^D/J$FPIG(J)/>)
CAIN P3,1 ;LAST HEADER?
PJRST TBFDMP ;YES, DUMP BUFFERS AND RETURN
JRST .+1] ;MORE HEADER LETS CONTINUE
PUSHJ P,TBFDMP ;DUMP THE BUFFER
PJRST SENDFF ;SEND A FORM FEED
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 Printer Output -- SETHDR - Setup Header Name For File
;SETHDR is called to setup the strings to be used for the two lines of
; block letters on the file header pages.
;
;Call: E/ address of the file's FP
;
;T Ret: always
SETHDR: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
SETZM J$PFL1+1(J) ;CLEAR THE 2ND WORD OF FIRST BUFFER
SETZM J$PFL2+1(J) ; AND 2ND BUFFER, (SEE SETH.W)
SKIPN .FPFR1(E) ;IS THERE A /REPORT KEY?
JRST SETH.1 ;NO, CONTINUE ON
$TEXT(<-1,,J$PFL1(J)>,<Report:^0>) ;FIRST LINE
$TEXT(<-1,,J$PFL2(J)>,< ^W6/.FPFR1(E)/^W/.FPFR2(E)/^0>)
JRST SETH.W ;SET BLOCKSIZE AND RETURN
SETH.1: LOAD S1,.FPINF(E) ;GET FLAGS FOR FILE
TXNN S1,FP.SPL ;IS IT A SPOOLED FILE?
JRST SETH.3 ;NO, CONTINUE ON
TXNN S1,FP.FLG ;YES, IS IT ALSO THE LOG FILE?
JRST SETH.2 ;NO, JUST A PLAIN SPOOLED FILE
$TEXT(<-1,,J$PFL1(J)>,<Batch^0>) ;SPOOLED LOGS HAVE NO REASONABLE NAME
$TEXT(<-1,,J$PFL2(J)>,< Log File^0>) ;SO USE SOMETHING DESCRIPTIVE
JRST SETH.W ;AND FINISH UP
;Continued on next page
;Continued from previous page
;Here if not log file and not report
SETH.2:
SETH.3: MOVE P1,[POINT 7,J$PFL1(J)] ;GET THE FILENAME BYTE PTR
MOVE P2,[POINT 7,J$PFL2(J)] ;GET THE EXTEN BYTE PTR
MOVX S1,GJ%SHT!GJ%OFG ;PARSE-ONLY + SHORT-GTJFN
MOVE S2,J$DFDA(J) ;GET THE FD ADDRESS
SKIPE J$TFIL(J) ;[6000]IS THIS A TEMPORARY FILE?
MOVE S2,J$ORFD(J) ;[6000]YES, SO PICK UP ORIGINAL FD
HRROI S2,.FDFIL(S2) ;AND POINT TO THE FILESPEC
GTJFN ;GET A JFN FOR THE FILE
ERJMP SETH.S ;ERROR,,GIVE NON-DESCRIPT NAME
EXCH S1,P1 ;SAVE JFN IN P1, GET POINTER IN S1
MOVE S2,P1 ;GET JFN IN S2
MOVX T1,1B8 ;FILENAME ONLY
JFNS ;GET IT
MOVE S1,P2 ;GET THE 2ND LINE POINTER
MOVE S2,P1 ;GET THE JFN
MOVX T1,1B11 ;EXTENSION ONLY
JFNS ;GET THE EXTENSION
MOVEI T2,"." ;FIRST, LOAD A BLANK
IDPB T2,S1 ;AND DEPOSIT IT
MOVX T1,1B14 ;GET THE GENERATION NUMBER
JFNS ;DO IT
MOVE S1,P1 ;GET THE JFN
RLJFN ;RELEASE IT
ERJMP .+1 ;IGNORE THE ERROR
;Continued on next page
;Continued from previous page
;Check to see if this is a spooled printer file and if so repair the filename
;to remove the junk that makes it unique.
LOAD S1,.FPINF(E),FP.SPL ;GET THE SPOOL BIT
JUMPE S1,SETH.W ;IF NOT SPOOLED, THERE WE'RE DONE
MOVE P1,[POINT 7,J$PFL1(J)] ;RESTORE THE FILENAME BYTE PTR.
MOVEI S1,3 ;HOW MANY DASHES TO LOOK FOR
MOVE S2,P1 ;AND AN INPUT POINTER
SETH.4: ILDB T1,S2 ;GET A CHARACTER
JUMPE T1,SETH.S ;NO, SPOOLED NAME IF NULL
CAIE T1,"-" ;A DASH?
JRST SETH.4 ;NO, LOOP
SOJG S1,SETH.4 ;YES, LOOP UNTIL 4TH FIELD
MOVE S1,P1 ;GET A NEW POINTER TO SET DOWN CHARS
SETH.5: ILDB T1,S2 ;GET A CHARACTER
IDPB T1,S1 ;DEPOSIT IT
JUMPN T1,SETH.5 ;AND LOOP UNTIL A NULL
MOVEI S2,6 ;LOAD A COUNTER
IDPB T1,S1 ;AND DEPOSIT MORE NULLS
SOJG S2,.-1 ;FOR WIDTH CALCULATION
MOVE T1,J$PFL1(J) ;GET THE FIRST WORD ON 1ST LINE
TLNN T1,774000 ;IS THERE AT LEAST ONE CHARACTER?
JRST SETH.S ;NO, NO NAME
JRST SETH.W ;YES, FILL IN WIDTH AND RETURN
;Continued on the next page
;Continued from the previous page
;SETH.S is used to setup a non-descript name if we can't do any better
SETH.S: $TEXT(<-1,,J$PFL1(J)>,<Spooled^0>)
$TEXT(<-1,,J$PFL2(J)>,< Printer File^0>)
;AND FALL INTO SETH.W
;SETH.W is called to figure out the blocksize to use, set it, and return.
; If both lines are 6 characters or less, the current width-class is
; used as the blocksize, else, blocksize of 1 is used.
SETH.W: MOVE S1,J$FWCL(J) ;GET THE WIDTH CLASS
CAMLE S1,J$FLCL(J) ;Compare with the length class
MOVE S1,J$FLCL(J) ;Use the min. of the two.
MOVE S2,J$PFL1+1(J) ;GET 2ND WORD OF LINE 1
IOR S2,J$PFL2+1(J) ;OR IN SECOND WORD OF LINE 2
TLNN S2,003760 ;[6011]IS THE 7TH CHAR THERE IN EITHER?
TXNE S,TTYSPL!LATSPL ;[6012] No, is it a TTY?
MOVEI S1,1 ;YES, USE BLOCKSIZE 1
MOVEM S1,J$PFLS(J) ;SAVE IT
$RETT ;AND RETURN
SUBTTL Printer Output -- PICTUR - Print Block Letters
;Call: S1/ blocksize of letters
; S2/ pointer to string (left half can be 0 or byte-pointer)
PICTUR: PUSHJ P,.SAVE3 ;SAVE P1 THRU P3
PUSHJ P,.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
PUSHJ P,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
MOVEI S1,[BYTE (7) 15,12,12,12,12,0,0]
PJRST STGOUT ;SEND FOUR BLANK LINES AND RETURN
;HERE TO PRINT ONE LINE OF THE CURRENT SEGMENT
PICT.2: PUSHJ P,.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.
PUSHJ P,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
PUSHJ P,DEVOUT ;PRINT IT
SOJG T2,.-1 ;LOOP
POPJ P, ;AND RETURN
PICT.6: POP P,T4 ;RESTORE T4
PJRST CRLF ;TYPE A CR AND RETURN
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 Interrupt System -- Initialization
INTINI: MOVE S1,[1,,ENDFRK] ;[6000]INFERIOR FORK TERMINATION
MOVEM S1,CHNTAB+.ICIFT ;[6000]PLACE IN THE CHANNEL TABLE
MOVEI S1,.FHSLF ;[6000]PICK UP THE FORK HANDLE
MOVX S2,1B0!1B1!1B2!1B3!1B19 ;[6000]CHANNELS 0, 1, 2, 3 AND 19
AIC% ;[6000]ACTIVATE THE CHANNELS
ERJMP INII.1 ;[6001] Catch error
$RET ;[6000]AND RETURN
INII.1: $STOP(CAI,Can't activate the interrupt system) ;[6001]
SUBTTL Interrupt System -- Connect Lineprinter
INTCNL: MOVE S1,J$LCHN(J) ;GET THE LPT JFN
MOVX S2,.MOPSI ;GET MTOPR FUNCTION
MOVEI T1,T2 ;AND ADDRESS OF ARGS
MOVEI T2,3 ;1ST ARG IS # ARGS
MOVEI T3,1 ;2ND ARG IS INT CHANNEL NUMBER
MOVX T4,MO%MSG ;DON'T TYPE THE MESSAGE
PUSHJ P,$MTOPR ;CONNECT IT
JUMPF .RETF ;IF AN ERROR,,RETURN ERROR
$RETT ;ELSE RETURN OK
SUBTTL Interrupt System -- IPCF Interrupt
INTIPC: $BGINT 1, ;SETUP FOR THE INTERRUPT.
PUSHJ P,C%INTR ;FLAG THE INTERRUPT.
SKIPN J,JOBPAG ;DOES A STREAM EXIST?
$DEBRK ;NO,,JUST FINISH UP HERE.
JRST INTDON ;FINISH UP -20 INTERRUPT PROCESSING.
SUBTTL Interrupt System -- Device Interrupt
;Here on device interrupts on the -20. Since all i/o is done by calling a
;subroutine, if an interrupt occurs while we are i/o active, we don't want to
;just DEBRK back into the SOUT (unless we are processing a remote LPT). For
;local LPTs, we just want to return from the subroutine, with the updated byte
;pointer and byte count. This is why we alter the return PC for local LPTs if
;we are i/o active. In this case we just return to the calling routine
;(OUTOUT).
INTDEV: $BGINT 1, ;SETUP FOR INTERRUPT
SKIPN J,JOBPAG ;DOES A STREAM EXIST?
$DEBRK ;NO,,DEBREAK
SETZM JOBCHK ;SAY WE WANT A CHECKPOINT TAKEN
SETOM JOBUPD ; update the status also
MOVE S1,J$LCHN(J) ;GET THE LPT JFN
MOVX S2,.MORST ;READ-STATUS FUNCTION
MOVEI T1,T2 ;AND ADDRESS OF ARGS
MOVEI T2,3 ;LENGTH OF ARG BLOCK
PUSHJ P,$MTOPR ;GET THE LPT STATUS
MOVX S1,PSF%DO ;DEVICE OFFLINE FLAG
ANDCAM S1,JOBSTW ;CLEAR THE VALUE
TXNE T3,MO%OL ;IS IT OFF-LINE?
IORM S1,JOBSTW ;YES, SET FLAG
INTDON: SKIPE J$LREM(J) ;IS THIS A REMOTE PRINTER?
JRST INTD.1 ;YES,,SKIP THIS 'LOCAL' STUFF
MOVEI S1,.RETT ;YES,,POINT TO EXIT ADDRESS
SKIPE J$LIOA(J) ;WERE WE I/O ACTIVE?
MOVEM S1,LEV1PC ;DEBRK ADDRESS, SO SAVE IT.
INTD.1: SETZM J$LIOA(J) ;CLEAR I/O ACTIVE.
$DEBRK ;DISMISS THE INTERRUPT.
SUBTTL DN60 Routines -- Local/Remote I/O Subroutines
$SOUT: SETOM J$LIOA(J) ;INDICATE I/O IS ACTIVE
SKIPE JOBSTW ;ANY STATUS BITS SET?
JRST SOUT.T ;YES,,RETURN NOW
SKIPE J$LREM(J) ;IS THIS A REMOTE LPT?
JRST SOUT.6 ;[6001] Yes, must be a DN60
SOUT ;LOCAL,,ISSUE THE SOUT NORMALLY
ERJMP SOUT.F ;ON ERROR,,TAKE FAIL RETURN
SOUT.T: SETZM J$LIOA(J) ;CLEAR I/O ACTIVE
$RETT ;AND RETURN
SOUT.F: SETZM J$LIOA(J) ;CLEAR I/O ACTIVE
$RETF ;AND RETURN
$GTJFN: SKIPE J$LREM(J) ;IS THIS A REMOTE LPT?
JRST GTJF.6 ;[6001] Yes, must be DN60
GTJFN ;LOCAL,,ISSUE THE GTJFN NORMALLY
$RETF ;NO GOOD,,RETURN FALSE
$RETT ;ELSE RETURN OK
$OPENF: SKIPE J$LREM(J) ;IS THIS A REMOTE LPT?
JRST OPEN.6 ;[6001] Yes, must be DN60
OPENF ;LOCAL,,OPEN THE LPT NORMALLY
$RETF ;NO GOOD,,RETURN FALSE
$RETT ;ELSE RETURN OK
$CLOSF: SKIPE J$LREM(J) ;IS THIS A REMOTE LPT?
JRST CLOS.6 ;[6001] Yes, must be DN60
CLOSF ;LOCAL,,CLOSE IT DOWN NORMALLY
$RETF ;NO GOOD,,RETURN FALSE
$RETT ;ELSE RETURN OK
$MTOPR: SKIPE J$LREM(J) ;IS THIS A REMOTE LPT?
JRST MTOP.6 ;[6001] Yes, must be DN60
MTOPR ;LOCAL,,DO THE MTOPR NORMALLY
ERJMP .RETF ;ON AN ERROR,,RETURN NO GOOD
$RETT ;ELSE RETURN OK
;Continued on next page
;Continued from previous page
$GDSTS: SKIPE J$LREM(J) ;IS THIS A REMOTE LPT?
JRST .RETT ;[6000]YES, MUST BE DN60 (NO MTOPR)
MOVE S1,J$LCHN(J) ;LOCAL,,GET THE DEVICE JFN
GDSTS ;GET THE DEVICE STATUS
ERJMP .RETF ;ON AN ERROR,,RETURN NO GOOD
MOVE S1,S2 ;RETURN STATUS BITS IN S1
$RETT ;RETURN OK
$SDSTS: SKIPE J$LREM(J) ;IS THIS A REMOTE LPT?
$RETT ;YES,,CANT SET DEVICE STATUS
MOVE S2,S1 ;GET THE STATUS BITS IN S2
MOVE S1,J$LCHN(J) ;GET THE DEVICE JFN IN S1
SDSTS ;SET THE LPT STATUS
ERJMP .RETF ;ON AN ERROR,,RETURN NO GOOD
$RETT ;ELSE RETURN OK
SUBTTL DN60 Routines -- DN60 I/O Support Routines
IFN FTDN60,<
SOUT.6: SETZM J$LIOA(J) ;ZAP I/O ACTIVE (NONE FOR DN60)
PUSHJ P,D60SOUT## ;OUTPUT THE DATA
JUMPT [$CALL D60SU ;Process success
$RETT] ;Return
$D60ER(ERDOE) ;Process the error
$RETIT ;Return if good error
$CALL DIE ;One bad error is too many, and do not
; return
GTJF.6: SETOM S1 ;NO JFN HERE (MUST RETURN -1)
$RETT ;AND RETURN (NO JFN HERE)
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
OPEN.6: SETOM J$LINK(J) ;INDICATE NO OPR MSG LIST YET
SETZM J$OMSG(J) ;Indicate no operator messages either
MOVE S1,STREAM ;GET OUR STREAM NUMBER
MOVE S1,JOBOBA(S1) ;GET OUR OBJECT BLOCK ADDRESS
MOVE S1,OBJ.UN(S1) ;GET OUR UNIT NUMBER
STORE S1,J$D6OB(J),OP$UNT ;SAVE THE UNIT NUMBER IN OPEN BLOCK
MOVX S1,.OPLPT ;WANT 'LPT' DEVICE
STORE S1,J$D6OB(J),OP$TYP ;SAVE THE DEVICE TYPE IN THE OPEN BLOCK
LOAD S1,J$DCND(J),CN$PRT ;GET THE PORT NUMBER
STORE S1,J$D6OB(J),OP$PRT ;SAVE IT IN THE OPEN BLOCK
LOAD S1,J$DCND(J),CN$LIN ;GET THE LINE NUMBER
STORE S1,J$D6OB(J),OP$LIN ;SAVE IT IN THE OPEN BLOCK
LOAD S1,J$DCND(J),CN$SIG ;GET THE LINE SIGNATURE
STORE S1,J$D6OB(J),OP$SIG ;SAVE IT IN THE OPEN BLOCK
OPN6.1: HRROI S1,-OP$SIZ ;GET THE NEGATIVE BLOCK LENGTH
MOVEI S2,J$D6OB(J) ;GET THE PARM BLOCK ADDRESS
PUSHJ P,D60OPN## ;OPEN THE PRINTER
JUMPF [$D60ER(ERCOP) ;Process the error
$RETIF ;Return if bad error
JRST OPN6.1] ;Try again
$CALL D60SU ;Successful counters
MOVEM S1,J$LCHN(J) ;SAVE THE LPT HANDLE
HRLZI S1,.OPCOU ;WANT OUTPUT CONSOLE FOR REMOTE
MOVEM S1,J$D6OB(J) ;SAVE THE DEV-TYP,,UNIT NUMBER IN WORD 0
OPN6.2: HRROI S1,-OP$SIZ ;GET THE NEGATIVE PARM BLOCK LENGTH
MOVEI S2,J$D6OB(J) ;GET THE PARM BLOCK ADDRESS
PUSHJ P,D60OPN## ;OPEN THE OUTPUT CONSOLE
JUMPT OPN6.4 ;o.k. proceed
$D60ER(ERCOC) ;Process the error
JUMPT OPN6.2 ;Good error, try again
;Continued on next page
;Continued from previous page
; Need to release LPT since can't get console
OPN6.3: MOVE S1,J$LCHN(J) ;Get LPT id
$CALL D60RLS## ;Try to release it
JUMPF [$D60ER(ERCRP) ;Process the error
JUMPT OPN6.3 ;Try again
$RETF] ;Quit
$RETF ;Return false in any case
OPN6.4: $CALL D60SU ;Successful check counters
MOVEM S1,J$D6OP(J) ;SAVE THE OPERATORS CONSOLE ID
PUSHJ P,L%CLST ;CREATE A LIST FOR OPERATOR MESSAGES
MOVEM S1,J$LINK(J) ;SAVE THE LIST ID
$RETT ;AND RETURN
MTOP.6: CAXE S2,.MOEOF ;IS THIS END OF FILE?
$RETT ;NO,,JUST RETURN
$CALL EOF.6 ;Do the EOF
$RETT ;AND RETURN
CLOS.6: SETZM J$OMSG(J) ;No more operator msgs.
MOVEI S1,NENBR ;Want this to terminate
MOVEM S1,J$ENBR(J) ;Set a threshold
CLO6.1: MOVE S1,J$LCHN(J) ;MAKE SURE WE HAVE JUST THE HANDLE
PUSHJ P,D60RLS## ;CLOSE DOWN THE DN60
JUMPF [$D60ER(ERCRP) ;process error
JUMPT CLO6.1 ;Try again if approp.
JRST CLO6.2] ;Try to continue
CLO6.2: MOVE S1,J$D6OP(J) ;GET THE CONSOLE ID
PUSHJ P,D60RLS## ;CLOSE DOWN THE OPERATORS CONSOLE
JUMPF [$D60ER(ERCRC) ;process error
JUMPT CLO6.2 ;Try again if approp.
JRST CLO6.3] ;Try to continue
$CALL D60SU ;fix counts
CLO6.3: SKIPL S1,J$LINK(J) ;CHECK AND GET THE OPERATORS LIST ID
PUSHJ P,L%DLST ;DELETE THE LIST IF THERE IS ONE
$RETT ;AND RETURN (NO JFN HERE)
SUBTTL DN60 Routines -- D60SU - DN60 Success Routine To Fix Counts
;purpose: To maintain counters etc. relating to a successful
; DN60 return
; Parameters: J / Address of current jobpage
D60SU: $SAVE <S1,S2,T1> ;Save some registers
SKIPN J$OFLN(J) ;Were we offline before this?
$RETT ;No - just return
SETZM J$OFLN(J) ;Clear off-line flag
MOVE T1,STREAM ;Get current stream number
CAMN J,JOBPAG(T1) ;Are we setup?
SETOM JOBUPD(T1) ;Request status update
$RETT ;Return
SUBTTL DN60 Routines -- D60ER/D60OE - Process DN60 errors
; The purpose of D60ER is to process DN60 errors that deal with
; LPT device (operator console are processed as part of the routine
; OPRCHK). The following actions are taken:
; 1. Determine if error is "good" i.e. D6DOL or D6NBR
; 2. If good error has overflowed threshold, then it is a bad error
; 3. If good, DSCHD and then return true
; - Bad error --
; 4. Output error message if requested
; 5. Return false
; The purpose/use of D60OE is the same as D60ER except the DSCHD must
; not occur.
; Parameters:
; S1 / Last DN60 error
; (P) / Error message address
; Called by $D60ER macro
; $D60ER (msg)
; Where msg is either error message address or
; 0 for no error to be output
D60OE: SETOM OPRERR ;This is an operator error
SKIPA
D60ER: SETZM OPRERR ;This is the normal stream error
MOVEM S1,J$D6ER(J) ;Save the last DN60 error
;Continued on next page
;Continued from previous page
;NBR error?
CAIE S1,D6NBR ;Non-blocking return?
JRST D60E.1 ;no, go process other
SKIPGE J$ENBR(J) ;Do we care about errors?
JRST D60E.6 ;No, skip this
SOSG J$ENBR(J) ;Out of errors?
JRST D60E.3 ;Yes - process bad error
JRST D60E.6 ;No, go process good error
;OAB error?
D60E.1: CAIE S1,D6OAB ;Output abort error?
JRST D60E.2 ;No, go try for other
SKIPE OPRERR ;Is this during operator output?
$RETT ;Yes, ignore it
; Here when abort occurs in printer stream.
; Requeue current job and shutdown stream.
MOVE S1,STREAM ;Get the stream number
$WTO (<Job terminated due to IBMCOM output abort>,,@JOBOBA(S1))
MOVEI S1,%RSUNA ;Set the unit unavailable
$CALL RSETUP ;Cause the current job to be requeued
PJRST SHUTIN ;Shut the stream down till restarted
;DOL error?
D60E.2: MOVE TF,STREAM ;Get the stream number
SKIPL J$OFLN(J) ;Are we already off line?
SETOM JOBUPD(TF) ;No, indicate need for status message
SETOM J$OFLN(J) ;Indicate we are offline at least
CAIN S1,D6DOL ;Device off-line error?
JRST D60E.6 ;Yes, finish processing good error
;Else continue and process bad error
;Continued on next page
;Continued from previous page
;Bad error
D60E.3: MOVEM T1,EMSG ;Save T1 a second
HRRZ T1,@0(P) ;Get error message
SKIPN T1 ;Want error message output?
JRST [MOVE T1,EMSG ;No - Restore T1
JRST D60E.5] ;and return
EXCH T1,EMSG ;Save error message
$SAVE <T1,T2> ;Get a couple of free registers
MOVE T2,STREAM ;Get current stream
SUBI S1,$ER1ST ;Set DN60 error message
MOVE T1,EMSG ;Get error message again
$WTO (<^T/0(T1)/>,<^T/@D60TXT(S1)/>,@JOBOBA(T2)) ;Yes tell opr
D60E.5: $RETF
; Here on DOL or NBR error, set new sleeptime based on polling estimate
D60E.6: $SAVE <S1,S2,T1> ;Save some acs
$CALL I%NOW ;Get the current time
ADD S1,POLEST## ;Get wakeup time from D60JSY
SKIPE OPRERR ;Are we at a console error?
JRST [MOVEM S1,J$CWKT(J) ;Yes, set that wakeup time
$CALL CHKTIM ;Adjust sleeptime
JRST D60E.8] ;And rejoin common code
MOVE S2,STREAM ;Get the stream number
MOVEM S1,JOBWKT(S2) ;Save job wake time
$CALL CHKTIM ;Adjust sleep time
SKIPE S1,SLEEPT ;Get sleep time if any
$CALL I%SLP ;Have some, sleep
SETOM SLEEPT ;And reset sleep time
D60E.8: $RETT ;And quit good
> ;End of IFN FTDN60
IFE FTDN60,<
SOUT.6:
GTJF.6:
OPEN.6:
MTOP.6:
CLOS.6:
GDST.6:
MOVE S1,STREAM ;GET OUR STREAM NUMBER
$WTO (DN60 Type Remote not Supported,,@JOBOBA(S1))
$RETF ;RETURN
> ;End of IFE FTDN60
SUBTTL DN60 Routines -- IBMSTS - Send IBMCOM Statistics Message
; Given the statistics code in S1, this routine sends the message to
; QUASAR.
; Parameters:
; S1 / Code type
; Uses:
; S1 and any ACs used by the send to QUASAR routine.
; T1 is needed as a parameter and is restored.
; Returns after QUASAR send routine without changing TF
; Simply returns if statistics are not wanted.
IBMSTS:
IFN FTIBMS,<
$SAVE T1 ;Save T1
MOVEM S1,IBMSTM+MSHSIZ ;Save the statistics code in
;the message
MOVEI T1,IBMSTM ;Get the address of message
$CALL SNDQSR ;Send it off to QUASAR
> ;End of FTIBMS
$RET ;Pass any errors up
PRCHMS: ASCIZ /
Type 'RESPOND <number> NO' to terminate the START command
Type 'RESPOND <number> YES' to use default
Type 'RESPOND <number> terminal characteristic' to use specified
terminal characteristics/
PRCHAN: $STAB
KEYTAB (TTYG.N,NO)
KEYTAB (TTYG.Y,YES)
$ETAB
SUBTTL Terminal Spooling -- TTYGET - Setup A Terminal Printer
;TTYGET - Start a TTY printer.
;Accepts - S1/device designator
;Returns
TTYGET: SETZM J$TDEV(J) ;NO DEVICE DESIGNATOR YET
ASND ;TRY TO ASSIGN THE TERMINAL LINE
PJRST TTYERR ;[6016]Take error return if unavailable
MOVEM S1,J$TDEV(J) ;SAVE THE DEVICE DESIGNATOR
MOVE S1,SUP.CR(M) ;GET TERMINAL CHARACTERISTIC
MOVEM S1,J$TTYC(J) ;SAVE IT
$CALL TTYG ;[6016]Go setup the terminal printer
JUMPF TTYERR ;[6016]Something went wrong
PUSHJ P,OUTRES ;SETUP THE OUTPUT POINTERS
PJRST OUTG.1 ;NOW WE FAKE TO BE A LINE PRINTER
TTYERR: MOVE T1,S1 ;[6016]SAVE THE ERROR CODE
SKIPE S1,J$LCHN(J) ;[6016]GET THE JFN
RLJFN ;[6016]RELEASE IT
JFCL ;[6016]IGNORE THE ERROR
SKIPN S1,T1 ;[6017]Do we have a TOPS-20 error?
JRST TTYER1 ;[6017]No
MOVE S2,STREAM ;[6016]GET OUR STREAM NUMBER
$WTO (<^T/J$LSTG(J)/ ^E/S1/>,,@JOBOBA(S2)) ;[6016]TELL THE OPERATOR
TTYER1: PJRST OUTDDE ;[6016]GIVE UP THE SHIP
SUBTTL Terminal Spooling -- TTYG - Setup the terminal for output
;TTYG - Loop through terminal data base for correct terminal characteristic
;returns true if terminal printer is set up
;returns false if terminal printer is not set up
TTYG: SKIPE S2,J$TTYC(J) ;GET THE TERMINAL CHARACTERISTIC
JRST TTYG.2 ;GO FIND IT
;TTYG.0 - Will send a WTOR asking the operator to identify the terminal
;characteristics that we are trying to setup.
;Setup AC 2 before calling this routine
TTYG.0: MOVE S1,STREAM ;GET STREAM NUMBER
SETZM JOBCHK(S1) ;SAY WE WANT CHECKPOINT
SETOM JOBUPD(S1) ; AND UPDATE STATUS
MOVE T1,DEFPRI ;GET THE ASCIZ DEFAULT NAME
$WTOR (<^M^JTerminal characteristic not found ^W/S2/. Default ^W/T1/ being used>,<^T/PRCHMS/>,@JOBOBA(S1),JOBWAC(S1)) ;[6011]Tell the OPR
$DSCHD (PSF%OR) ;Wait for OPERATOR RESPONSE
TXNE S,ABORT+RQB ;HAVE WE BEEN CANCELED OR REQUEUED?
PJRST TTYG.N ;YES
MOVEI S1,PRCHAN ;POINT TO THE CONTINUE ANSWER BLOCK
HRROI S2,J$RESP(J) ;POINT TO THE ANSWER
PUSHJ P,S%TBLK ;DO THEY MATCH
TXNE S2,TL%NOM+TL%AMB ;DID WE FIND IT OK ???
JRST TTYG.1 ;NO, MUST HAVE TYPE IN ONE
MOVE S2,STREAM ;Get the stream number
SETOM JOBUPD(S2) ;Yes, update the stream's status
HRRZ S1,0(S1) ;GET THE ROUTINE ADDRESS
JRST 0(S1) ;AND PROCESS THE RESPONSE
TTYG.1: HRROI S1,J$RESP(J) ;POINT TO THE ANSWER
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
TTYG.2: MOVEM S2,J$TTYC(J) ;[6011][6013]Save The TTY charact
MOVEI S1,TABEND ;GET AOBJN POINTER
MOVEI T4,TTYTAB ;GET ADDRESS OF TERMINAL CHARACT
TTYG.3: CAMN S2,$TDCHR(T4) ;SAME?
JRST TTYG.8 ;YES
ADDI T4,$TDLEN ;NO, GO TO THE NEXT ONE
SOJG S1,TTYG.3 ;NEXT
JRST TTYG.0 ;NOT HERE, GO ASK THE OPERATOR
;Continued on next page
;Continued from previous page
;We have a match
TTYG.8: MOVEI S2,J$TCHR(J) ;GET DESTINATION OF BLT INTO S2
HRLI S2,(T4) ;MAKE A BLT POINTER
MOVEI S1,J$TCHR(J) ;[6011]GET START OF TTY CHARACT BLOCK
BLT S2,$TDLEN-1(S1) ;BLT THE TERMINAL BLOCK
MOVE S1,J$TDEV(J) ;GET DEVICE DESINGATOR
MOVE S2,J$TCHR+$TDTYP(J) ;GET THE TERMINAL TYPE
STTYP% ;SET THE TERMINAL TYPE
ERJMP TTYG.4 ;
JRST TTYG.5 ;
TTYG.4: JUMPL S2,TTYG.6 ;IF NEGATIVE, NOT A SPOOLER
MOVEI S2,.TTDEF ;NUMBER NOT DEFINED IN STG, USE DEFAULT
STTYP% ;
ERJMP .+1 ;SHOULDN'T FAILED
TTYG.5: MOVE S2,J$TCHR+$TDFLG(J) ;[6011]GET FLAG BITS
TXNN S2,FL$XOF+FL$POL ;POLLING NEEDED, OR XON/XOFF PROTOCOL ?
JRST TTYG.7 ;NO, OTHERS NOT SUPPORTED YET
SETZ T3, ;CLEAR PRINTER STATUS BITS
TXNN S2,FL$PGM+FL$VFU ;PROGRAMMABLE TERMINAL ?
TXO T3,MO%LVU ;NO, FAKE OPTICAL
MOVX S2,OF%WR+OF%RD+7B5 ;OPEN FOR R/W SEVEN BIT BYTES
MOVE S1,J$LCHN(J) ;GET JFN
OPENF ;OPEN THE TERMINAL
$RETF ;[6016]Error
MOVEI S2,.MOSNT ;DO WE WANT SYSTEM MESSAGES ?
MOVEI T1,.MOSMN ;NO
MTOPR ;SET SYSTEM MESSAGE FLAG
ERJMP .+1
MOVEI S2,.MOXOF ;DO WE WANT PAUSE-END-PAGE ?
MOVEI T1,.MOOFF ;NO
MTOPR ;SET PAUSE-END-PAGE FLAG
ERJMP .+1
DMOVE S2,J$TCHR+$TDCC1(J) ;[6011]GET THE TERMINAL CCOC WORDS
SKIPE S2 ;[6011]ANYTHING THERE ?
SFCOC ;YES, SET CONTROL CHAR OUTP CONT WORD
ERJMP .+1
SKIPE S2,J$TCHR+$TDMOD(J) ;[6011]GET THE MODE WORD (IF ANY)
STPAR ;SET TERMINAL DEVICE MODE
MOVX S2,FLD(.TTASC,TT%DAM) ;DISCARD SUPPLIED PROGRAM RELATED MODE
SFMOD ;
ERJMP .+1
RFMOD ;READ THE MODE WORD AGAIN
ERJMP .+1
TXNE S2,TT%LCA ;DOES TERMINAL HAVE LOWER CASE ?
TXO T3,MO%LCP ;YES
TXNE S2,TT%MFF ;DOES TERMINAL HAVE MECHANICAL FORMS ?
TXZ S2,TT%LEN ;YES, NO SIMULATED PAGING
TXO S2,TT%PGM ;ENABLE XON/XOFF
STPAR ;
ERJMP .+1
SFMOD ;MAKE LINE CHARACTERISTICS OK
ERJMP .+1
HRRZ S1,J$TDEV(J) ;GET DEVICE DESIGNATOR
ADDI S1,.TTDES ;MAKE TTY DESIGNATOR
TXO S1,TL%SAB!TL%STA ;SET RECEIVE ADVICE/LINK
TLINK ; TO REFUSE
ERJMP .+1 ;IGNORE ERRORS
$RETT ;[6016]Return success
SUBTTL Terminal Spooling -- TTYG.6 - error handler for TTYG.
; Error handling routines
TTYG.6: MOVX S1,.FHSLF ;
GETER ;GET MOST RECENT ERROR IN OUR PROCES
HRRZ T1,S2 ;REMEMBER ERROR CODE
MOVE S1,J$LCHN(J) ;NO,,GET THE JFN AGAIN
TXO S1,CZ%ABT ;ABORT ALL OUTPUT OPERATIONS
PUSHJ P,$CLOSF ;CLOSE IT DOWN
$RETT ;NO,, RETURN
MOVE S1,T1 ;RESTORE THE ERROR CODE TO S1
TTYG.7: MOVE S2,STREAM ;GET OUR STREAM NUMBER
$WTO (<Initialization failed for ^T/J$LSTG(J)/ ^E/S1/>,,@JOBOBA(S2))
$RETF ;[6016]GIVE UP THIS TERMINAL
;USE DEFAULT
TTYG.Y: MOVE S2,DEFPRI ;GET THE DEFAULT NAME
JRST TTYG.2 ;GO USE DEFAULT
;ABORT START COMMAND
TTYG.N: TXNE S,LATSPL ;[6011]LATSPL?
$CALL LATABT ;[6037]YES, RELEASE THE TTY
TXO S,RQB ;Requeue the job
SETZ S1, ;[6017]No errors
$RETF
SUBTTL Terminal Spooling -- CHKTTY - Check TTY Status
CHKTTY: SKIPN J$LCHN(J) ;[6041]Do we have a printer
$RETT ;[6041]No
MOVE S1,J$TCHR+$TDFLG(J) ;GET FLAG BITS
TXNN S1,FL$POL ;POLLING NEEDED ?
JRST CHKTT9 ;NO,GO SEE IF VFU SHOULD BE LOADED
MOVE S1,J$LCHN(J) ;GET THE JFN OF THE TERMINAL
DOBE ;MAKE SURE FINISHED OUTPUT
ERJMP .+1 ;[6041]Don't care about error
CFIBF ;CLEAR FILE INPUT BUFFER
ERJMP .+1 ;[6041]Don't care about error
MOVEI T1,^D5 ;LOOP FOR 5 PERIODS
CHKTT1: MOVE S1,J$LCHN(J) ;GET THE JFN OF THE TERMINAL
HLRZ S2,J$TCHR+$TDPOL(J) ;GET THE POLLING CHARACTER
BOUT ;SEND POLLING CHARACTER
ERJMP .+1 ;[6041]Don't care about error
MOVEI S1,^D1000 ;WAIT OFR A SECOND
DISMS
MOVE S1,J$LCHN(J) ;GET TTY JFN
SIBE ;ANY RESPONSE ?
JRST CHKTT3 ;YES, GO CHECK THE REPLY
CHKTT2: SOJG T1,CHKTT1 ;KEEP TRYING
JUMPE S2,.RETT ;[6011]NOT A TTY MUST BE A PRINTER
JRST TTYOFL ;AFTER 5 SECONDS COMPLAIN
CHKTT3: PUSHJ P,CHKTT6 ;CORRECT ANSWER ?
JRST CHKTT2 ; NO
CHKTT9: PUSHJ P,PGMTTY ; CHECK IF WE HAVE TO PROGRAM VFU
$RETT ;DEVICE IS ONLINE
;Continued on next page
;Continued from previous page
TTYOFL: MOVX S1,PSF%DO ;GET DEVICE OFFLINE BIT
ORM S1,JOBSTW ;ARE ANY STATUS BITS SET ???
$WTO (<^T/BELL/>,,@JOBOBA) ;TELL OPR DEVICE IS OFFLINE
SETZM JOBCHK(S1) ;TAKE A CHECKPOINT WHEN WE CAN
SETOM JOBUPD(S1) ; update status also
$CALL DSTATU ;SEND A STATUS UPDATE
CHKTT4: MOVE S1,J$LCHN(J) ;GET THE JFN OF THE TERMINAL
HLRZ S2,J$TCHR+$TDPOL(J) ;GET THE POLLING CHARACTER
BOUT ;SEND POLLING CHARACTER
MOVEI S1,^D1000 ;WAIT OFR A SECOND
DISMS
MOVE S1,J$LCHN(J) ;GET TTY JFN
SIBE ;ANY RESPONSE ?
JRST CHKTT5 ;YES, GO CHECK THE REPLY
MOVEI S1,^D10000 ;NO, TRY AGAIN
DISMS ;AFTER 10 SECOND
JRST CHKTT4 ;KEEP TRYING
CHKTT5: PUSHJ P,CHKTT6 ;CORRECT ANSWER ?
JRST CHKTT4 ; NO
PUSHJ P,PGMTTY ; CHECK IF WE HAVE TO PROGRAM VFU
JRST TTYONL ; YES
CHKTT6: MOVE S1,J$LCHN(J) ;GET THE JFN OF THE TERMINAL
BIN ;GET REPLY FROM TERMINAL
HRRZ S1,J$TCHR+$TDPOL(J) ;GET THE EXPECTED CHARACTER
SKIPE S1 ;IF NO EXPECTED DEFINED, ACCEPT ALL
CAMN S1,S2 ;REPLY EQUALS EXPECTED CHARACTER ?
AOS (P) ; YES, INCREMENT RETURN ADDRESS
POPJ P, ; NO, NON-SKIP RETURN
TTYONL: MOVX S1,PSF%DO ;GET DEVICE OFFLINE BIT
ANDCAM S1,JOBSTW ;ARE ANY STATUS BITS SET ???
SETZM JOBCHK(S1) ;TAKE A CHECKPOINT WHEN WE CAN
SETOM JOBUPD(S1) ; update status also
$CALL DSTATU ;SEND A STATUS UPDATE
$RETT ;RETURN IF FINALLY ONLINE
PGMTTY: MOVE S1,J$TCHR+$TDFLG(J) ;GET FLAG BITS
TXNE S1,FL$PGM ;PROGRAM TERMINAL AFTER EACH FILE?
PUSHJ P,LODTTY ; YES, REPROGRAM TERMINAL
$RETT
SUBTTL Terminal Spooling -- LODTTY - Load TTY VFU
LODTTY: HRRZ S1,J$VJFN(J) ;DO WE HAVE A "VFU" FILE OPEN ?
JUMPN S1,LODTT0 ; YES, USE IT
$TEXT(<-1,,J$XTBF(J)>,<SYS:^W/J$FTAP(J)/.VFU^0>)
MOVX S1,GJ%OLD+GJ%SHT ;SHORT, OLD FILE ONLY
HRROI S2,J$XTBF(J) ;POINT TO STRING
GTJFN ;GO GET THE JFN FOR THE FILE
ERJMP LODTT2 ;ERROR, IGNORE LOADING
MOVX S2,FLD(7,OF%BSZ)!OF%RD ;7-BIT READ
OPENF ;OPEN THE "VFU" FILE
JRST LODTT2 ;
HRRZM S1,J$VJFN(J) ;REMEMBER THE JFN
MOVE S2,[1,,.FBBYV] ;WE WANT TO KNOW BYTE SIZE
MOVEI T1,S2 ;STORE RESULT IN AC
GTFDB ;GET IT FROM FILE DESCRIPTOR BLOCK
LDB S2,[POINTR(S2,FB%BSZ)] ;GET THE BYTE SIZE
CAIE S2,^D7 ;SHOULD BE SEVEN BIT ASCII
JRST LODTT2 ;IGNORE FILE IF NOT 7-BIT
LODTT0: MOVE T3,S1 ;COPY THE JFN OVER
MOVEI S2,0 ;POINT TO FIRST BYTE IN FILE
SFPTR ;REWIND "VFU" FILE
JFCL ;
LODTT1: BIN ;GET "VFU" BYTE
ERJMP LODTT2 ;ON ERRRO ASSUME END OF FILE
MOVE S1,J$LCHN(J) ;GET THE JFN OF THE TERMINAL
BOUT ;SEND CHARACTER TO TERMINAL
MOVE S1,T3 ;GET THE VFU JFN ONCE MORE
JRST LODTT1 ;LOOP TILL END OF FILE
LODTT2: MOVE T1,J$FTAP(J) ;GET THE VFU TYPE
MOVEM T1,J$FLVT(J) ;SAVE AS CURRENTLY LOADED
POPJ P, ;AND RETURN
SUBTTL Terminal Spooling -- LATGET - Get LAT Printer
; USE THE LATOP% TO ASSIGN A TTY.
;ACCEPTS J OBJECT BLOCK
;RETURNS +1 TRUE if a LAT connection is made and the terminal printer is
;setup. FALSE if either a LAT connection is made or the terminal printer
;is not setup
LATGET: SKIPE J$CID(J) ;[6011]DO WE HAVE A CONNECTION?
$RETT ;[6011]YES
; Set up to do LATOP to assign a TTY line.
SETZ S1, ;
SETZ S2,
DMOVEM S1,LATBLK+.LASVC ;[6013]Clear port and service
HRR S2,JOBOBJ+OBJ.QN ;[6013]Get header
HRROI S1,JOBOBJ+OBJ.QN+1 ;POINT TO PORT/SERVICE NAME
CAIN S2,.KYPOR ;[6013]Port?
MOVEM S1,LATBLK+.LAPRT ;YES, USE PORT
CAIN S2,.KYSER ;[6013]Service?
MOVEM S1,LATBLK+.LASVC ;YES, USE SERVICE
$TEXT (<-1,,J$SERN(J)>,<^W/JOBOBJ+OBJ.ND/^0>) ;[6012]
HRROI S1,J$SERN(J)
MOVEM S1,LATBLK+.LASVR ;SAVE IT IN ARG BLK
MOVEI S1,7 ;GET THE LENGTH
MOVEM S1,LATBLK+.LAACT ;SAVE IT IN ARG BLK
MOVEI S1,.LARHC ;GET FUNCTION CODE
MOVEM S1,LATBLK+.LAFCN ;SAVE IT IN ARG BLK
SETZM LATBLK+.LAPRM ;NO PSI
SETZM LATBLK+.LAVAL ;NO PSI CHANNEL
MOVEI S1,LATBLK ;GET ADDRESS OF LATOP ARG BLOCK
LATOP%
ERJMP LATERR ;Bad setup. MONITOR reject call
MOVE S1,LATBLK+.LAVAL ;[6013]Get terminal designator
TXZN S1,.TTDES ;Do we have one?
JRST LATREJ ;NO, LAT BOX REJECT
;Continued on next page
;Continued from previous page
; We have a terminal designator. Now make it a device designation
; Make it an ASCIZ string and SIXBIT string. use like a terminal printer
LATGE2: HRLI S1,.DVDES+.DVTTY ;[6023]Make it device designator
MOVEM S1,J$TDEV(J) ;SAVE IT
MOVE S2,S1 ;GET THE DEVICE DESIGNATOR
HRROI S1,J$LSTG(J) ;DESTINATION DESIGNATOR
DEVST ;CONVERT IT TO ASCIZ STRING
ERJMP .+1 ;SHOULD NOT FAIL
HRROI S1,J$LSTG(J) ;POINT TO THE ACSIZ STRING
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
MOVEM S2,J$MTAP(J) ;SAVE IT
$TEXT (<-1,,J$LSTG(J)>,<^W/J$MTAP(J)/:^0>) ;[6011]GEN THE DEVICE NAME
HRRZ S1,LATBLK+.LAPRM ;GET THE CONNECT ID
MOVEM S1,J$CID(J) ;SAVE IT
; Get a JFN on the terminal.
SETZM J$LREM(J) ;FORCE US TO BE LOCAL
MOVSI S1,(POINT 7,0) ;[6024]Get 7 bit byte pointer (output)
MOVEM S1,J$LBTZ(J) ;SAVE IT FOR LATER
MOVX S1,GJ%SHT+GJ%FOU ;GET GTJFN FLAG BITS
LOAD S2,IB+IB.FLG,IB.NAC ;Get the access bit value
SKIPE DEBUGW ;Debugging?
SETZ S2, ;Yes, do not restrict
STORE S2,S1,GJ%ACC ;Store as the value of the JFN access
HRROI S2,J$LSTG(J) ;POINT TO THE DEVICE NAME
GTJFN ;GET A JFN
JRST LATERR ;[6013]Cant,,tough breakeee
MOVEM S1,J$LCHN(J) ;SAVE THE JFN
$CALL TTYG ;[6016]GO SETUP THE TERMINAL.
JUMPF LATGER ;[6017]Failed
$CALL OUTRES ;[6016]Setup the output pointer
PJRST OUTSOK ;[6016]Now we are a printer
SUBTTL Terminal Spooling -- LAT error handling routines
LATGER: $CALL TTYERR ;[6017]Report the error and fall down
;LATERR - LATOP JSYS FAILED. Terminate the START command and shut it down
LATERR: TXO S,RQB ;[6016]Requeue the job
$CALL LATABT ;[6037]Terminate the connection
MOVX S1,%RSUDE ;[6017]Shut it down
$RETF ;[6016]Error return
; LATREJ - The LAT box rejected the host connect. The recoverable errors are
; .LASIU (6), "Service is in use", and .LAIAR (13), "Immediate Acceess
; Rejected" . In these cases we should inform the operator, try 5 times to
; make the connection. If after 5 times we still get .LASIU shut the stream
; down, set the object unavailable and tell QUASAR. If the error is other
; then .LASIU, shut the device down.
; Accepts S1/LAT error code
; If success goto LATGE2: to continue with the setup procedure for a LAT
; If Fail return false.
LATREJ: CAIE S1,.LASIU ;[6013]Is the service in use?
CAIN S1,.LAIAR ;[6036]Is it Immediate Access Reject?
JRST LATRE0 ;[6036]Yes we can recover
CAIE S1,.LAIRS ;[6043]Is insufficient resource ?
CAIN S1,.LASCS ;[6043]Is start-slot can't be sent?
JRST LATRE0 ;[6043]Yes we can recover
$CALL LATREP ;[6036]No, report error
JRST LATERR ;[6036]and return failure
LATRE0: $CALL LATREP ;[6036]Report the error
MOVEI T1,5 ;[6024]Get LATOP% try counter
LATRY: MOVEI S1,^D15 ;[6023]Sleep for 15 sec
PUSHJ P,I%SLP ;[6023]Go wait
SETZM LATBLK+.LAVAL ;[6023]No PSI channel
MOVEI S1,LATBLK ;[6023]Get the address of LATBLK
LATOP% ;[6023]Ask for it
ERJMP LATCF ;[6023]Crash for now
MOVE S1,LATBLK+.LAVAL ;[6023]Get terminal designator
TXZE S1,.TTDES ;[6023]Do we have one?
JRST LATGE2 ;[6032]We have a TTY!
CAIE S1,.LASIU ;[6023]No, still in use
CAIN S1,.LAIAR ;[6036]or immediate access rejected
SOJG T1,LATRY ;[6024]Yes, try again
$CALL LATREP ;[6023]Report error and return false
MOVX S1,%RSUNA ;[6023]Not available right now.
$WTO (<^T/@SETMSG(S1)/>,,@JOBOBA) ;[6023]Tell OPR whats going on.
$RETF
; LATREP - Prints an error string which corresponds to the LAT error code
; Accept the LAT error in S1
; Always return +1
LATREP: $SAVE <S1> ;[6013]Save AC S1
CAIGE S1,.LAUNK ;[6015] Within LAT error range?
JRST LATRE2 ;[6043] No, report unknow LAT error
CAIG S1,.LAIRP ;[6013] Within LAT error range?
JRST LATRE1 ;[6013] Yes
CAIE S1,.LATMO ;[6013] Is it TOPS-20 time out?
JRST LATRE2 ;[6043] No, report unknow LAT error
MOVEI S1,.LAIRP+1 ;[6013] Yes, pickup error code
LATRE1: MOVE T1,LATETB(S1) ;[6013]Point to the LAT error table
MOVE S1,STREAM ;[6013]Get the stream number
$WTO (<LAT error>,<^T/(T1)/>,@JOBOBA(S1)) ;[6013]
$RETT
LATRE2: MOVE S2,STREAM ;[6043]Get the stream number
$WTO (<Unknow LAT error>,<^D/S1/>,@JOBOBA(S2)) ;[6043]
$RETT
SUBTTL Terminal Spooling -- Errors from the LAT BOX for the LATOP% JSYS.
; LATETB is in LAT error code order. the zeroth entry is .LAUNK and so on.
; The last error is the TOPS-20 timed out, since the error code for this is
; 37774, we index into this table with index of 20.
; The error numbers are in decimal
LATETB: [ASCIZ/Reason is unknown/] ;[6016] 0 .LAUNK
[ASCIZ/User requested disconnect/] ;[6016] 1 .LAURD
[ASCIZ/System shutdown in progress/] ;[6016] 2 .LASSP
[ASCIZ/Invalid slot received/] ;[6016] 3 .LAISR
[ASCIZ/Invalid service class/] ;[6016] 4 .LAISC
[ASCIZ/Insufficient resources to satisfy request/] ;[6016] 5 .LAIRS
[ASCIZ/Service in use/] ;[6016] 6 .LASIU
[ASCIZ/No such service/] ;[6016] 7 .LANSS
[ASCIZ/Service is disabled/] ;[6016] 8 .LASDI
[ASCIZ/Service is not offered by requested port/] ;[6016] 9 .LASNP
[ASCIZ/No such port/] ;[6016] 10 .LANSP
[ASCIZ/Invalid password/] ;[6016] 11 .LAIPW
[ASCIZ/Entry is not in the queue/] ;[6016] 12 .LAENQ
[ASCIZ/Immediate access rejected/] ;[6016] 13 .LAIAR
[ASCIZ/Access denied/] ;[6016] 14 .LAACD
[ASCIZ/Corrupted solicit request/] ;[6016] 15 .LACSR
[ASCIZ/Command message Type is illegal/] ;[6016] 16 .LACTI
[ASCIZ/Start-slot Can't be Sent/] ;[6016] 17 .LASCS
[ASCIZ/Queue entry Deleted by Local node/];[6016] 18 .LAQED
[ASCIZ/Inconsistant or illegal request parameters/];[6016] 19 .LAIRP
[ASCIZ/Request has timed out/] ;[6016] 37774 .LATMO
SUBTTL Terminal Spooling -- LATTHC - Terminate the LAT connection
;LATTHC - If we have a LAT connection then we must terminate the connection
;so that others can use the same service/port.
;LATABT - Terminate the LAT connection when we have an error, therefore abort
;all output first.
LATABT: TXO S1,CZ%ABT ;[6037]ABORT ALL OUTPUT OPERATIONS
LATTHC: HRR S1,J$LCHN(J) ;[6037]Get the JFN for $CLOSF
SKIPN J$CID(J) ;[6016]Do we have a connection?
JRST LATTER ;[6016]No just return
;**;[6050]At LATTHC+3L add 1 line JYCW 5/8/89
CALL SETPRT ;[6050]Set the printer back to its
;initial state
PUSHJ P,$CLOSF ;[6014]CLOSE IT DOWN
MOVEI S1,.LATHC ;GET TERMINATE FUNCTION
MOVEM S1,LATBLK+.LAFCN ;SAVE IT
MOVEI S1,LATBLK ;[6011]ARG BLOCK
LATOP%
ERJMP LATSTP ;[6013]Shouldn't fail
SETZM J$CID(J) ;[6011]CLEAR CONNECT ID
LATTER: SETZM J$LCHN(J) ;[6042]Clear JFN
$RETT ;[6013]NO,, RETURN
LATSTP: $STOP (LTF,LAT termination failed) ;[6023]Crash for now
LATCF: $STOP (LCF,LAT connection failed) ;[6023]Crash for now
SUBTTL LAT and TTY support -- SETPRT -- Set the Printer to its initial state
;**;[6050]At LATCF+1L add routines SETPRT and PORLAN.
;SETPRT - Set the printer to its initial state.
;Returns +1 always
SETPRT: MOVE S1,J$TCHR+$TDFLG(J) ;[6050] Get flag bits
TXNE S,LATSPL!TTYSPL ;[6050]LAT or TTY
TXNN S1,FL$RST ;[6050]Reset
RET ;[6050]No
HRROI S2,J$TCHR+$TDREP(J) ;[6050]Get the address of reset ESC seq
MOVE S1,J$LCHN(J) ;[6050]GET THE LPT JFN
SETZ T1, ;[6050]Terminate on null byte
SOUT ;[6050]Send the ESC seq characters
ERJMP .+1 ;[6050]Shouldn't fail
RET ;[6050]All done
;Set the printer to print Landscape or Portrait on a LN03.
;Returns +1 always
PORLAN: TXNN S,LATSPL!TTYSPL ;[6050]LAT or TTY
JRST PORLAX ;[6050]No
MOVE S2,[SIXBIT/LN03/] ;[6050]Load SIXBIT 'LN03'
CAME S2,J$TCHR+$TDCHR(J) ;[6050]Are we a LN03?
JRST PORLAX ;[6050]No, just return
MOVE S1,.EQCHR(J) ;[6050]Get the Characteristic switch
TXNN S1,FT%LND ;[6050]Landscape
JRST PORLA0 ;[6050]No, HAVE to be portrait
HRROI S2,LANDFT ;[6050]Yes, point to the ESC seq
MOVE S1,J$LCHN(J) ;[6050]GET THE LPT JFN
SETZ T1, ;[6050]Terminate on null byte
SOUT ;[6050]Send the ESC seq characters
ERJMP .+1 ;[6050]For Now
MOVEI S1,^D132 ;[6050]Landscape width is 132
MOVEM S1,J$FWID(J) ;[6050]Set new width
JRST PORLAX ;[6050]All done
PORLA0: HRROI S2,PORTFT ;[6050]Assume Portrait
MOVE S1,J$LCHN(J) ;[6050]GET THE LPT JFN
SETZ T1, ;[6050]Terminate on null byte
SOUT ;[6050]Send the ESC seq characters
ERJMP .+1 ;[6050]For Now
MOVEI S1,^D80 ;[6050]portrait width is 80
MOVEM S1,J$FWID(J) ;[6050]Set new width
PORLAX: RET ;[6050]
SUBTTL End of LPTSPL
LPTEND::END LPTSPL