Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
5-galaxy/lsrspl.sierra-new
There are no other files named lsrspl.sierra-new in the archive.
;<5-1-GALAXY>LSRSPL.MAC.29, 13-Nov-85 13:43:03, Edit by WHP4
; Really keep MAKIMP/SAIL errors from hanging us. Send "X" *after*
; starting fork in separate SOUTR% so that it isn't discarded as part
; of the command line.
;<5-1-GALAXY>LSRSPL.MAC.28, 24-Jul-85 13:03:48, Edit by WHP4
;<5-1-GALAXY>LSRSPL.MAC.27, 24-Jul-85 12:12:50, Edit by WHP4
; This time for sure!
;<5-1-GALAXY>LSRSPL.MAC.26, 23-Jul-85 21:43:25, Edit by WHP4
;<5-1-GALAXY>LSRSPL.MAC.25, 23-Jul-85 13:13:50, Edit by WHP4
; Check files for $^L^] to detect TEKTRONIX files spooled without setting
;the bit and handle properly. Allows printing from remote sites.
;<5-1-GALAXY>LSRSPL.MAC.24, 22-May-85 16:28:08, Edit by LOUGHEED
; Drive four Imprint-10's at Sierra
; Fix banner page to be prettier on version 1.9 systems
;<5-GALAXY>LSRSPL.MAC.23, 23-Mar-85 13:33:46, Edit by LOUGHEED
; Fix bug in page accounting for old user Canons
; If we are not charging for pages on a unit, set 1B18 in the page count
; so that we can find out for users who is printing how much on a unit.
;<6-GALAXY-SOURCES>LSRSPL.MAC.22, 19-Oct-84 18:34:34, Edit by WHP4
; make DVINAM larger to avoid clobbering return address in CKDPST
;<6-GALAXY-SOURCES>LSRSPL.MAC.20, 19-Oct-84 18:13:33, Edit by WHP4
; change CALL CKDPST to $CALL CKDPST to try to eliminate IST stopcodes
;<6-GALAXY-SOURCES>LSRSPL.MAC.19, 16-Oct-84 15:19:47, Edit by WHP4
; simplify and hopefully fix CKDPST logic to work on files of any byte size
; (e.g. TEX78 output)
;<6-GALAXY-SOURCES>LSRSPL.MAC.18, 10-Oct-84 21:03:16, Edit by WHP4
; rework edit 14
;<6-GALAXY-SOURCES>LSRSPL.MAC.17, 10-Oct-84 20:38:53, Edit by WHP4
; To hell with SAVEAC. Just use a PUSH, POP pair since routine in
;question (CHKDVI) is only called once. Ugh.
;<6-GALAXY-SOURCES>LSRSPL.MAC.15, 10-Oct-84 20:25:07, Edit by WHP4
; Sigh, .REQUIRE SYS:MACREL for SAVEAC support. Grumble.
;<6-GALAXY-SOURCES>LSRSPL.MAC.14, 10-Oct-84 19:56:13, Edit by WHP4
; Shuffle assumptions around. Don't worry about byte size of file unless
; it is text. See large comments near MAKI.3 and MAKI.2
;<6-GALAXY-SOURCES>LSRSPL.MAC.13, 6-Oct-84 00:43:44, Edit by WHP4
; remove random trash accidentally inserted in file
;<6-GALAXY-SOURCES>LSRSPL.MAC.12, 6-Oct-84 00:40:20, Edit by WHP4
; if CHKSIZ claims file byte size is 36, ignore it; tex78 produces .dvi files
;like that and things break if you believe that you really want 36 bit bytes
;<6-GALAXY-SOURCES>LSRSPL.MAC.11, 4-Oct-84 04:04:07, Edit by WHP4
;<6-GALAXY-SOURCES>LSRSPL.MAC.10, 4-Oct-84 03:58:35, Edit by WHP4
;<6-GALAXY-SOURCES>LSRSPL.MAC.9, 4-Oct-84 03:41:56, Edit by WHP4
; Make CKDPST intelligent about byte sizes - SIZEF doesn't return byte count
; in terms of byte size file was opened in
;<6-GALAXY-SOURCES>LSRSPL.MAC.8, 4-Oct-84 03:08:54, Edit by WHP4
; fix bug in CHKDVI with mismatch between skip returns and $RETT/$RETF
;<6-GALAXY-SOURCES>LSRSPL.MAC.7, 2-Oct-84 11:50:04, Edit by SATZ
; CHKDVI should always return true unless the file is unprintable.
; Otherwise, S1 should contain 0 for non-dvi files and and non-zero
; for dvi files.
;<6-GALAXY-SOURCES>LSRSPL.MAC.6, 2-Oct-84 02:39:48, Edit by WHP4
; make sure we get at least one magic number found in CKDPST
;<6-GALAXY-SOURCES>LSRSPL.MAC.5, 2-Oct-84 01:57:09, Edit by WHP4
;<6-GALAXY-SOURCES>LSRSPL.MAC.4, 2-Oct-84 01:30:34, Edit by WHP4
; new CKDPST routine called by CHKDVI to look at file and see if DVI trailer
;exists for more robust DVI file checking.
;<6-GALAXY-SOURCES>LSRSPL.MAC.3, 30-Sep-84 17:32:27, Edit by WHP4
; use results from CHKSIZ at MAKIMP to open file in proper byte size to
;avoid bogus assumptions about text files at MAKI.3
;<6-GALAXY-SOURCES>LSRSPL.MAC.2, 10-Aug-84 17:49:50, Edit by LOUGHEED
; Set OFFLINE and try to continue IS fork if AC0 contains a positive quantity
; when IS terminates. Try not to restart the entire Canon job.
;SRA:<4-2-GALAXY>LSRSPL.MAC.120, 16-Jul-84 13:43:06, Edit by LOUGHEED
; Avoid printing files with zero or negative byte or page counts
;SRA:<4-2-GALAXY>LSRSPL.MAC.119, 13-Jun-84 18:02:43, Edit by LOUGHEED
; Always do accounting for CPU, regardless of ACCTF setting
; ACCTF set means do page usage accounting
; Reset accounting information for job if trying to reprint that job
;SRA:<4-2-GALAXY>LSRSPL.MAC.118, 20-May-84 19:52:36, Edit by WHP4
; Crap out gracefully with file unprintable error if byte size is horribly
; bogus (>36 or <7) instead of crashing with IBS stopcodes
;SRA:<WHP4.LSRSPL>LSRSPL.MAC.7, 11-May-84 03:18:06, Edit by WHP4
; More flexible accounting support:
; Forms type now not only controls old/new distinction, but also whether
; accounting is done on this printer
; 4 forms types currently supported: OLDUSR (old, no acct.), OLDSYS (old,
; but acct on), USER (new, no acct) and SYSTEM (new, acct on)
; ACCTF set if accounting on, default on
;SRA:<WHP4.LSRSPL>LSRSPL.MAC.6, 9-May-84 19:07:48, Edit by WHP4
;MOVE where there should have been a MOVEI in CHKSIZ
;SRA:<WHP4.LSRSPL>LSRSPL.MAC.5, 9-May-84 18:05:45, Edit by WHP4
;sigh, remember that GALAXY-style LOAD is different than MACSYM-style LOAD
;SRA:<WHP4.LSRSPL>LSRSPL.MAC.4, 9-May-84 17:55:57, Edit by WHP4
;first crack at CHKSIZ routine to find natural byte size of a file
;use in MAKTEK to see if we have right bytesize for file
;SRA:<WHP4.LSRSPL>LSRSPL.MAC.3, 8-May-84 18:29:42, Edit by WHP4
;flush PS:<SPOOL>%-CANON-TEMP.TMP if it exists in GENDEV
;<WHP4>LSRSPL.MAC.2, 8-May-84 02:07:25, Edit by WHP4
;oops, don't print two commas between fields in document language for text file
;on new canon/imagen
;<WHP4>LSRSPL.MAC.1, 8-May-84 01:14:53, Edit by WHP4
; add /REVERSAL support to reverse pages if .FPREV set. Note that
; with a lpt mode document, this results in pages coming out backwards.
;SRA:<4-2-GALAXY>LSRSPL.MAC.116, 7-May-84 23:37:00, Edit by LOUGHEED
; Don't hang if MAKIMP wants to put us into BAIL.
;SRA:<4-2-GALAXY>LSRSPL.MAC.115, 4-May-84 13:49:18, Edit by LOUGHEED
; At MAKIMP+1 use a CAIN instead of a TRNE. .FPTEK is a code, not a bit.
;SRA:<WHP4.TEK>LSRSPL.MAC.3, 4-May-84 02:36:46, Edit by WHP4
; Use 7-bit mode on files with 7-bit bytes (TEKTRONIX)
;SRA:<WHP4.TEK>LSRSPL.MAC.2, 4-May-84 01:16:24, Edit by WHP4
; Install Tektronix code to print in TEK4014 mode if .FPTEK set
;SRA:<4-2-GALAXY>LSRSPL.MAC.113, 29-Apr-84 14:57:09, Edit by LOUGHEED
; Release source JFN if MAKIMP pronounces file to be unprintable
;SRA:<4-2-GALAXY>LSRSPL.MAC.112, 6-Apr-84 13:35:04, Edit by LOUGHEED
; Fix bugs in CHKDOC
;SRA:<4-2-GALAXY>LSRSPL.MAC.111, 2-Feb-84 21:48:16, Edit by LOUGHEED
; Fix broken access checking
;SRA:<4-2-GALAXY>LSRSPL.MAC.110, 31-Jan-84 12:42:29, Edit by LOUGHEED
; Go back to flushing MAKIMP fork. It looks like we're having problems
; running out of JSB free space (too many JFN's, pipes, etc. at once).
;SRA:<4-2-GALAXY>LSRSPL.MAC.109, 29-Jan-84 17:34:58, Edit by LOUGHEED
;SRA:<4-2-GALAXY>LSRSPL.MAC.108, 29-Jan-84 15:27:22, Edit by LOUGHEED
; Fix problems associated with the BADHDR routine.
;<4-2-GALAXY>LSRSPL.MAC.107, 8-Jan-84 16:38:56, Edit by LOUGHEED
; MAKIMP has been fixed let go of its files when it shuts down. No longer
; need to automatically kill MAKIMP fork in RUNIMP.
;<4-2-GALAXY>LSRSPL.MAC.106, 5-Jan-84 17:25:45, Edit by LOUGHEED
;<4-2-GALAXY>LSRSPL.MAC.105, 5-Jan-84 16:36:28, Edit by LOUGHEED
; After running MAKIMP check for an .ERC file and abort the job
; if one is found (flush TMP, IMP, and ERC files)
;<4-2-GALAXY>LSRSPL.MAC.104, 14-Dec-83 17:25:33, Edit by LOUGHEED
; If MAKIMP arg is only a filename, add a trailing space.
;<4-2-GALAXY>LSRSPL.MAC.103, 14-Dec-83 12:40:39, Edit by LOUGHEED
; Arguments to new MAKIMP must begin with a "/" not a "-"
;<4-2-GALAXY>LSRSPL.MAC.102, 3-Dec-83 23:04:09, Edit by LOUGHEED
; MAKARG build command line for new MAKIMP programk
;<4-2-GALAXY>LSRSPL.MAC.101, 2-Dec-83 01:05:51, Edit by LOUGHEED
;<4-2-GALAXY>LSRSPL.MAC.100, 2-Dec-83 00:55:48, Edit by LOUGHEED
;<4-2-GALAXY>LSRSPL.MAC.99, 2-Dec-83 00:34:44, Edit by LOUGHEED
;<4-2-GALAXY>LSRSPL.MAC.98, 2-Dec-83 00:29:30, Edit by LOUGHEED
; Make /HEADER and /NOHEADER work
;<4-2-GALAXY>LSRSPL.MAC.97, 1-Dec-83 23:35:46, Edit by LOUGHEED
;<4-2-GALAXY>LSRSPL.MAC.96, 1-Dec-83 22:59:25, Edit by LOUGHEED
; Make MAKRCP work correctly.
;<4-2-GALAXY>LSRSPL.MAC.95, 1-Dec-83 00:30:22, Edit by LOUGHEED
; Fix problems in edits 92 and 93 with converting old imp to new Canon.
;<4-2-GALAXY>LSRSPL.MAC.94, 30-Nov-83 15:07:28, Edit by LOUGHEED
; Turn on page reversal for when Language is Printer
;<4-2-GALAXY>LSRSPL.MAC.93, 25-Nov-83 23:54:05, Edit by LOUGHEED
;<4-2-GALAXY>LSRSPL.MAC.92, 25-Nov-83 23:36:08, Edit by LOUGHEED
; MAKIMP handles all cases correctly for the new Canon
;<4-2-GALAXY>LSRSPL.MAC.91, 25-Nov-83 16:18:43, Edit by LOUGHEED
; Fix bad AC usage in FILE.X
;<4-2-GALAXY>LSRSPL.MAC.90, 24-Nov-83 13:40:51, Edit by LOUGHEED
; More fiddling with header page format
;<4-2-GALAXY>LSRSPL.MAC.89, 24-Nov-83 03:04:06, Edit by LOUGHEED
; Use I%SLP to block in FILE.X. Don't use PSF%DO (offline) as a reason
; to block in the main scheduler loop.
;<4-2-GALAXY>LSRSPL.MAC.88, 24-Nov-83 01:43:56, Edit by LOUGHEED
;<4-2-GALAXY>LSRSPL.MAC.87, 24-Nov-83 01:15:37, Edit by LOUGHEED
;<4-2-GALAXY>LSRSPL.MAC.85, 24-Nov-83 01:02:18, Edit by LOUGHEED
;<4-2-GALAXY>LSRSPL.MAC.83, 23-Nov-83 23:02:02, Edit by LOUGHEED
; Rework header page format
;<4-2-GALAXY>LSRSPL.MAC.82, 23-Nov-83 01:07:12, Edit by LOUGHEED
; /SPACING: doesn't work, fix /BEGIN: and /LIMIT: to interact properly
; Can now print DVI files correctly
;<4-2-GALAXY>LSRSPL.MAC.81, 23-Nov-83 00:19:17, Edit by LOUGHEED
;<4-2-GALAXY>LSRSPL.MAC.80, 22-Nov-83 23:47:07, Edit by LOUGHEED
; If MAKIMP is run, look at /BEGIN:, /LIMIT:, /FONT:, /SPACING: switches
;<4-2-GALAXY>LSRSPL.MAC.79, 22-Nov-83 21:29:57, Edit by LOUGHEED
; Accounting is always turned on.
; Use $DSCHD to block in FILE.X. Allows IPCF messages through.
;<4-2-GALAXY>LSRSPL.MAC.78, 20-Nov-83 19:18:37, Edit by LOUGHEED
;<4-2-GALAXY>LSRSPL.MAC.77, 20-Nov-83 19:02:19, Edit by LOUGHEED
; Set large number of PIDS allowed for job running LSRSPL
;<4-2-GALAXY>LSRSPL.MAC.76, 20-Nov-83 17:50:22, Edit by LOUGHEED
;<4-2-GALAXY>LSRSPL.MAC.75, 20-Nov-83 17:46:22, Edit by LOUGHEED
; Improve multi-forking code. Spawn three LSRSPL's on Sierra, one elsewhere
;<4-2-GALAXY>LSRSPL.MAC.74, 19-Nov-83 18:22:58, Edit by LOUGHEED
; Galaxy has been fixed. OLDF set if forms type is OLD
;<CANON.LSRSPL>LSRSPL.MAC.73, 18-Nov-83 00:27:31, Edit by LOUGHEED
; Document why .DVI files don't work (see monument near MAKDVI)
; Wakeup every 10 seconds instead of every 5 seconds
; Still need a way to set OLDF from OPR and friends
;<CANON.LSRSPL>LSRSPL.MAC.72, 17-Nov-83 01:38:10, Edit by LOUGHEED
; Reject .DVI files for the time being
;<CANON.LSRSPL>LSRSPL.MAC.71, 17-Nov-83 00:47:23, Edit by LOUGHEED
; Feed .DVI files to MAKIMP.EXE, reject .REL, .EXE, and .PRESS files
;<CANON.LSRSPL>LSRSPL.MAC.70, 16-Nov-83 23:33:46, Edit by LOUGHEED
; Fix some bugs
;<CANON.LSRSPL>LSRSPL.MAC.69, 16-Nov-83 19:15:24, Edit by LOUGHEED
; Do runtime and page accounting, turn on ACCTSW
;<CANON.LSRSPL>LSRSPL.MAC.68, 14-Nov-83 21:58:09, Edit by LOUGHEED
; Comment out edit 67. CLZFF% doesn't work as advertised.
;<CANON.LSRSPL>LSRSPL.MAC.67, 14-Nov-83 21:17:29, Edit by LOUGHEED
; Instead of killing fork, use CLZFF% to flush files left by MAKIMP
;<CANON.LSRSPL>LSRSPL.MAC.66, 14-Nov-83 20:10:32, Edit by LOUGHEED
; IS and LSRSPL conspire to distinguish between an offline Canon,
; bad arguments to IS, and a failure to create the IS fork
;<CANON.LSRSPL>LSRSPL.MAC.65, 14-Nov-83 00:05:59, Edit by LOUGHEED
; RUNIS doesn't crash if IS bombs
; Dismiss for 60 seconds if Canon is malfunctioning
;<CANON.LSRSPL>LSRSPL.MAC.63, 13-Nov-83 23:41:46, Edit by LOUGHEED
; Dismiss for a bit to allow fork deletion to take effect in RUNIMP
;<CANON.LSRSPL>LSRSPL.MAC.62, 13-Nov-83 23:22:22, Edit by LOUGHEED
; Some code clean ups. Make a few errors less hard.
;<CANON.LSRSPL>LSRSPL.MAC.61, 13-Nov-83 22:03:47, Edit by LOUGHEED
; Talk to IS using pipes
;<CANON.LSRSPL>LSRSPL.MAC.59, 13-Nov-83 19:41:12, Edit by LOUGHEED
; Fix renaming problem in MAKREN
; Don't delete source file if MAKIMP routine fails!
; Better error reporting of JSYS errors
;<CANON.LSRSPL>LSRSPL.MAC.58, 13-Nov-83 17:01:52, Edit by LOUGHEED
;<CANON.LSRSPL>LSRSPL.MAC.56, 13-Nov-83 15:43:12, Edit by LOUGHEED
; Must flush MAKIMP fork because it leaves stray JFN's around
;<CANON.LSRSPL>LSRSPL.MAC.53, 13-Nov-83 13:47:34, Edit by LOUGHEED
;<CANON.LSRSPL>LSRSPL.MAC.52, 13-Nov-83 11:51:19, Edit by LOUGHEED
; RUNIS looks at OLDF flag and runs different IS programs
;<CANON.LSRSPL>LSRSPL.MAC.51, 13-Nov-83 11:37:39, Edit by LOUGHEED
; Use FORMS-TYPE keyword to indicate an old Canon
;<CANON.LSRSPL>LSRSPL.MAC.50, 13-Nov-83 01:08:21, Edit by LOUGHEED
; MAKCPY buffers output (already buffered input)
; MAKIMP routine knows about old style Canon printers (OLDF flag)
;<CANON.LSRSPL>LSRSPL.MAC.48, 12-Nov-83 22:25:06, Edit by LOUGHEED
; Add code for running MAKIMP.EXE, uses Stanford I/O pipes
;<CANON.LSRSPL>LSRSPL.MAC.47, 3-Aug-83 02:01:04, Edit by LOUGHEED
; Fixes to the multi-forking code
;<CANON.LSRSPL>LSRSPL.MAC.46, 3-Aug-83 01:41:39, Edit by LOUGHEED
;<CANON.LSRSPL>LSRSPL.MAC.44, 3-Aug-83 01:07:54, Edit by LOUGHEED
;<CANON.LSRSPL>LSRSPL.MAC.43, 3-Aug-83 00:28:11, Edit by LOUGHEED
;<CANON.LSRSPL>LSRSPL.MAC.42, 3-Aug-83 00:17:19, Edit by LOUGHEED
; Naive me -- no headers, accept only old-style IMP files for input
;<CANON.LSRSPL>LSRSPL.MAC.40, 2-Aug-83 23:52:49, Edit by LOUGHEED
; Temporary - build header for old-style IMP files
;<CANON.LSRSPL>LSRSPL.MAC.39, 2-Aug-83 17:01:00, Edit by LOUGHEED
; Make GENDEV build correct RSBUF depending on RSCANF setting
;<CANON.LSRSPL>LSRSPL.MAC.36, 1-Aug-83 23:37:27, Edit by LOUGHEED
; Add mother fork support. Up to six inferior copies of LSRSPL!
;<CANON.LSRSPL>LSRSPL.MAC.35, 1-Aug-83 20:03:59, Edit by LOUGHEED
; Use either PRARG% or RSCAN% to pass arguments to IS.EXE
;<CANON.LSRSPL>LSRSPL.MAC.33, 1-Aug-83 18:14:12, Edit by LOUGHEED
;<CANON.LSRSPL>LSRSPL.MAC.29, 1-Aug-83 16:16:15, Edit by LOUGHEED
; SEARCH MACSYM added
;<CANON.LSRSPL>LSRSPL.MAC.28, 1-Aug-83 16:05:40, Edit by LOUGHEED
; Rewrite IS (now RUNIS) routine.
;<CANON.LSRSPL>LSRSPL.MAC.27, 1-Aug-83 14:02:27, Edit by LOUGHEED
;<CANON.LSRSPL>LSRSPL.MAC.24, 28-Jul-83 23:27:04, Edit by LOUGHEED
; Get device (TTY line) from QUASAR and friends
; Flush code related to hardwired TTY lines
;<CANON.LSRSPL>LSRSPL.MAC.23, 28-Jul-83 17:16:50, Edit by LOUGHEED
; Begin modifications for Stanford use
;<JQJOHNSON.NEWIS>LSRSPL.MAC.22, 6-Jun-83 15:22:06, Edit by JQJOHNSON
; different temporary files for different units
;<JQJOHNSON.NEWIS>LSRSPL.MAC.20, 30-May-83 08:34:39, Edit by JQJOHNSON
; minor changes to header (can't have 2 identical header lines)
; run SYS:IS.EXE
;<JQJOHNSON.NEWIS>LSRSPL.MAC.15, 19-May-83 13:13:29, Edit by JQJOHNSON
; no TTYSNM, TTYNUM. Cleaner terminal initialization
; print date on title page
; start writing code to handle unit 1 with a different TTY (see NDEV).
;<JQJOHNSON.NEWIS>LSRSPL.MAC.14, 18-May-83 13:24:30, Edit by JQJOHNSON
;general cleanup: eliminate most LOGX stuff, but include error message on
; file-not-found, etc.
;<JQJOHNSON.NEWIS>LSRSPL.MAC.13, 18-May-83 09:22:15, Edit by JQJOHNSON
;call it LSRSPL again, and fix residual formatting problems with header.
;flush initial 8 bytes of Impress.
;<JQJOHNSON.NEWIS>LSRSPX.MAC.13, 18-May-83 08:38:56, Edit by JQJOHNSON
;rework header page again for prettyness. Add proprietary notice
;<JQJOHNSON.NEWIS>LSRSPX.MAC.10, 16-May-83 08:38:45, Edit by JQJOHNSON
;rework MAKIMP routine to handle text files w/hdrs, etc.
;<JQJOHNSON.NEWIS>LSRSPX.MAC.2, 14-May-83 16:29:42, Edit by JQJOHNSON
;always create FOO-BAR.IMP, containing header information.
;<JQJOHNSON.NEWIS>LSRSPL.MAC.5, 13-May-83 17:07:32, Edit by JQJOHNSON
;fix some things
;<JQJOHNSON>LSRSPL.MAC.2, 12-May-83 12:44:38, Edit by JQJOHNSON
;run IS in a lower fork.
TITLE LSRSPL - TOPS-20 LASER PRINTER SPOOLER
SEARCH GLXMAC ;SEARCH GALAXY PARAMETERS
PROLOG (LSRSPL)
SEARCH QSRMAC ;SEARCH QUASAR PARAMETERS
SEARCH ORNMAC ;SEARCH ORION/OPR PARAMETERS
SEARCH ACTSYM ;SEARCH THE ACCOUNTING UNV
SEARCH MACSYM ;SEARCH STANDARD MACRO LIBRARY
INTERN JOBOBA, JOBWAC,JOBCHK ;VARIABLES NEEDED FOR WTO
.DIRECT FLBLST
IF2,<PRINTX BEGIN ASSEMBLER PASS # 2.>
SALL ;SUPPRESS MACRO EXPANSIONS
;VERSION INFORMATION
VMAJOR==3 ;MAJOR VERSION NUMBER
VMINOR==0 ;MINOR VERSION NUMBER
VEDIT==163 ;EDIT NUMBER
VWHO==4 ;1=Billy Brown UT-Austin (R20)
;2=J.Q. Johnson, Teknowledge
;4=Stanford University
%LSR==<BYTE (3)VWHO(9)VMAJOR(6)VMINOR(18)VEDIT>
;STORE VERSION NUMBER IN JOBVER
LOC 137
.JBVER::EXP %LSR
RELOC 0
SUBTTL AC and I/O Channel Definitions, Parameters, etc.
;ACCUMULATOR DEFINITIONS
M==12 ;IPCF MESSAGE ADDRESS
S==13 ;STATUS FLAGS
E==14 ;POINTS TO CURRENT FILE
J==15 ;JOB CONTEXT POINTER
PP==16 ;PACKET POINTER
;PARAMETERS
ND PDSIZE,100 ;SIZE OF PUSHDOWN LIST
ND SLEEP1,^D60 ;SECONDS TO SLEEP WHILE OFF LINE OR STOPPED
XP MSBSIZ,30 ;SIZE OF A MESSAGE BLOCK
;CHECKPOINT BLOCK OFFSETS
XP CKFIL,0 ;NUMBER OF FILES PRINTED
XP CKCOP,1 ;NUMBER OF COPIES OF LAST FILE
XP CKFLG,4 ;FLAGS
XP CKFREQ,1B0 ;JOB WAS REQUEUED BY OPR
XP CKFCHK,1B1 ;JOB WAS CHECKPOINTED
;FLAG DEFINITIONS
DSKOPN==1B2 ;DISK DATA READ GOING ON
RQB==1B3 ;JOB HAS BEEN REQUED
ABORT==1B5 ;THE SHIP IS SINKING
SKPFIL==1B8 ;SKIP FUTURE COPIES OF THIS FILE COMPLETELY
NOBANN==1B14 ;SUPPRESS BANNER ON NEW-STYLE CANON
OFFLINE==1B15 ;IS ERROR (SOFT) - CANON OFFLINE
ARGERR==1B16 ;IS ERROR (HARD) - PROBABLY BAD ARGUMENTS
OLDF==1B17 ;OLD STYLE IMPRINT-10 PRINTER
ACCTF==1B18 ;DO ACCOUNTING FOR PAGES ON THIS CANON
SUBTTL MACROS
DEFINE LP(SYM,VAL,FLAG),<
IF1,<
XLIST
IFNDEF J...X,<J...X==1000>
IFDEF SYM,<PRINTX ?PARAM SYM USED TWICE>
SYM==J...X
J...X==J...X+VAL
IFNDEF ...BP,<...BP==1B0>
IFNDEF ...WP,<...WP==0>
REPEAT VAL,<
IFIDN <FLAG><Z>,<LPZ(\...WP,...BP)>
...BP==...BP_<-1>
IFE ...BP,<
...BP==1B0
...WP==...WP+1
> ;;END IFE ...BP
> ;;END REPEAT VAL
LIST
SALL
> ;END IF1
IF2,<
.XCREF
J...X==SYM
.CREF
SYM==J...X
> ;END IF2
> ;END DEFINE LP
DEFINE LPZ(A,B),<
IFNDEF ...Z'A,<...Z'A==B>
IFDEF ...Z'A,<...Z'A==...Z'A!B>
> ;END DEFINE LPZ
SUBTTL Job Parameter Area
LP J$$BEG,0 ;BEGINNING OF PARAMETER AREA
;REQUEST PARAMETERS
LP J$DEV,1 ;SIXBIT DEVICE NAME
LP J$TTY,3 ;ASCII DEVICE (TTY) NAME
LP J$DESG,1 ;DEVICE DESIGNATOR
LP J$RFLN,1 ;NUMBER OF FILES IN REQUEST
LP J$RLIM,1,Z ;JOB LIMIT IN PAGES
LP J$RTIM,1 ;START TIME OF JOB
LP J$RNFP,1,Z ;NUMBER OF FILES PRINTED
LP J$RNCP,1,Z ;NUMBER OF COPIES OF CURRENT FILE
LP J$FORM,1 ;CURRENT FORMS TYPE
LP J$RACS,20 ;CONTEXT ACS
LP J$RPDL,^D100 ;CONTEXT PUSHDOWN LIST
LP J$RESP,2,Z ;OPERATOR RESPONSE BUFFER.
LP J$WTOR,^D50 ;WTOR MESSAGE BUFFER.
;ACCOUNTING PARAMETERS.
LP J$APRT,1,Z ;PAGE COUNT.
LP J$APRI,1,Z ;JOB'S PRIORITY
LP J$ARTM,1,Z ;JOB'S RUN TIME (CPU)
LP J$ART1,1,Z ;JOB'S RUN TIME DUE TO INFERIOR FORKS
LP J$ASEQ,1,Z ;JOB'S SEQUENCE NUMBER
LP J$AFXC,1,Z ;TOTAL FILES PRINTED (FILES*COPIES)
LP J$XFOB,FOB.SZ
LP J$TEMP,1 ;TEMPORARY COPY OF C(J$XFOB)
;DISK FILE PARAMETERS
LP J$DIFN,1 ;THE IFN
LP J$DFDA,1 ;THE FD ADDRESS
LP J$OJFN,1 ;OUTPUT JFN FOR TEMPORARY FILE
LP J$OBSZ,1 ;BYTE SIZE OF TEMPORARY FILE
LP J$DVIF,1 ;-1 IF DVI, 0 IF SOMETHING ELSE
LP J$$END,1 ;END OF PARAMETER AREA
J$$LEN==J$$END-J$$BEG ;LENGTH OF PARAMETER AREA
;NOW GENERATE A BIT TABLE OF WHICH WORDS IN THE 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
Z==0
REPEAT <J$$LEN+^D35>/^D36,<
XLIST
ZTAB(\Z)
Z==Z+1
LIST
> ;END REPEAT
SUBTTL Random Impure Storage
IFNDEF .NFORKS,<.NFORKS==1> ;NORMAL CASE IS ONE INFERIOR
IFDEF SIERSW,<IFN SIERSW,<.NFORKS==4>> ;MANY COPIES ON SIERRA
NFORKS: EXP .NFORKS ;MOTHER FORK HAS THIS MANY SUBFORKS
PDL: BLOCK PDSIZE ;PUSHDOWN LIST
FILPDL: BLOCK 100 ;FILE STACK
FRKACS: BLOCK 20 ;FORK AC'S
FILPTR: BLOCK 1 ;FILE STACK POINTER
IMPFIL: BLOCK 1 ;GALAXY DESCRIPTION OF TEMPORARY FILE
BLOCK 100 ;NAME OF TEMPORARY FILE
ERCFIL: BLOCK 1 ;NAME OF ERROR FILE PRODUCED BY MAKIMP PROGRAM
BLOCK 100
RSLEN==50 ;LENGTH OF IS ARGUMENT BUFFER
RSBUF: BLOCK RSLEN ;IS.EXE ARGUMENT BUFFER
MAXFRK==6 ;ALLOW UP TO SIX DIRECT INFERIORS
FRKTAB: BLOCK MAXFRK ;TABLE OF HANDLES OF INFERIOR FORKS
MESSAG: BLOCK 1 ;ADDRESS OF MESSAGE JUST RECEIVED
BLKADR: BLOCK 1 ;IPCF MSG BLK ADDR SAVE AREA
ISFRKH: BLOCK 1 ;FORK HANDLE FOR IS PROGRAM
ISIJFN: BLOCK 1 ;PIPE JFN FOR TALKING TO IS.EXE
ISOJFN: BLOCK 1 ; ...
SAB: BLOCK SAB.SZ ;A SEND ARGUMENT BLOCK
MSGBLK: BLOCK MSBSIZ ;A BLOCK TO BUILD MESSAGES IN.
FOB: BLOCK FOB.SZ ;A FILE OPEN BLOCK
ERRCNT: BLOCK 1 ;ERROR COUNT
XPTR: BLOCK 1 ;POINTER FOR $TEXT(TEXTX,...)
LOGPTR: BLOCK 1 ;POINTER INTO LOG FILE
LOGBUF: BLOCK 200 ;LOG BUFFER
JOBITS: BLOCK 1 ;SAVE JOB STATUS BITS FLAG.
STRSEQ: EXP 4000 ;STREAM SEQ #'S (START AT 4000)
SLEEPT: BLOCK 1 ;SLEEP TIM FOR SCHEDULING.
RUTINE: BLOCK 1 ;MESSAGE PROCESSING ROUTINE ADDRESS.
DMGNUM==^D223 ;MAGIC NUMBER IN DVI TRAILER
MAXDVR==^D3 ;MAXIMUM DVI VERSION (CURRENTLY MIGHT BE 2)
PSTBFL==50 ;LENGTH OF BUFFER FOR READING DVI TRAILER
PSTBUF: BLOCK PSTBFL ;BUFFER FOR READING DVI TRAILER
FILSIZ: BLOCK 1 ;"PROPER" BYTE SIZE OF FILE
SUBTTL Resident JOB Database
JOBPAG: BLOCK 1 ;ADDRESS OF A FOUR PAGE BLOCK
; ONE FOR REQUEST, ONE FOR JOB PARAMS
; ONE FOR LPT BUFFER, ONE FOR LOG BUFFER
JOBOBA: BLOCK 1 ;TABLE OF OBJECT BLOCK ADDRESSES
JOBSTW: BLOCK 1 ;JOB STATUS WORD
JOBACT: BLOCK 1 ;-1 IF STREAM IS ACTIVE, 0 OTHERWISE
JOBOBJ: BLOCK 3 ;LIST OF SETUP OBJECTS
JOBCHK: BLOCK 1 ;STREAM CHECKPOINT FLAG. (-1=YES,,0=NO)
JOBWAC: BLOCK 1 ;STREAM WTOR ACK CODE.
;SCHEDULER FLAGS
PSF%OB==1B1 ;OUTPUT BLOCKED
PSF%DO==1B2 ;DEVICE IS OFF-LINE
PSF%ST==1B3 ;STOPPED BY OPERATOR
PSF%OR==1B4 ;OPERATOR RESPONSE WAIT
DEFINE $DSCHD(FLAGS),<
PUSHJ P,DSCHD
XLIST
JUMP [EXP FLAGS]
LIST
SALL
> ;END DEFINE $DSCHD
SUBTTL 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
$EOB ;
PIB: $BUILD PB.MNS ;
$SET(PB.HDR,PB.LEN,PB.MNS) ;PIB LENGTH,,0
$EOB ;
HELLO: $BUILD HEL.SZ ;
$SET(.MSTYP,MS.TYP,.QOHEL) ;MESSAGE TYPE
$SET(.MSTYP,MS.CNT,HEL.SZ) ;MESSAGE LENGTH
$SET(HEL.NM,,<'LSRSPL'>) ;PROGRAM NAME
$SET(HEL.FL,HEFVER,%%.QSR) ;QUASAR VERSION
$SET(HEL.NO,HENNOT,1) ;NUMBER OF OBJ TYPES
$SET(HEL.NO,HENMAX,1) ;MAX NUMBER OF JOBS
$SET(HEL.OB,,.OTCDP) ;CARD-PUNCH IS CANON!
$EOB ;
SETMSG: [ASCIZ/Started/]
[ASCIZ/Not available right now/]
SUBTTL LSRSPL - Laser Printer Spooler.
;THE MOTHER FORK SETUP CODE FOR LSRSPL
START: RESET% ;CLEAN UP WORLD
MOVE P,[IOWD PDSIZE,PDL] ;SET UP A STACK.
MOVE J,NFORKS ;GET NUMBER OF INFERIORS
CAIN J,1 ;IF JUST ONE INFERIOR
JRST LSRSPL ;SKIP THE MOTHER FORK SETUP
MOVEI S1,.FHSLF ;FOR THIS PROCESS
RPCAP% ;READ CAPABILITIES WORD
MOVE T1,S2 ;SET MASK FOR ALL CAPS
EPCAP% ;ENABLE ALL CAPABILITIES
MOVEI S1,IB.SZ ;GET THE IB SIZE.
MOVEI S2,IB ;ADDRESS OF THE IB.
$CALL I%INIT ;SET UP GLXLIB
$CALL SETPID ;BUMP NUMBER OF ALLOWED PIDS
MOVE J,NFORKS ;GET NUMBER OF INFERIORS
CAILE J,MAXFRK ;WITHIN RANGE?
MOVEI J,MAXFRK ;NO, FORCE IT (STUPID PROGRAMMER)
MOVNI J,(J) ;GET NEGATIVE COUNT OF INFERIORS
MOVSI J,(J) ;SET UP AOBJN POINTER
START0: $CALL SPAWN ;CLONE OURSELF
AOBJN J,START0 ;MAKE MANY CLONES
START1: MOVX S1,.FHINF ;BLOCK HERE, AND WAIT
WFORK% ;FOR ANY INFERIOR TO TERMINATE
$CALL FNDLSR ;FIX UP ANY LOSING FORKS
JRST START1 ;KEEP ON WAITING
;SETPID - SET MAXIMUM NUMBER OF PIDS ALLOWED FOR THIS JOB
;THE TOPS-20 DEFAULT IS 5 PIDS PER JOB. TO THAT QUOTA WE ADD TWICE
; THE NUMBER OF FORKS THAT WE ARE GOING TO GENERATE.
;RETURNS TRUE ALWAYS
SETPID: STKVAR <<MUTARG,3>> ;DECLARE LOCAL STORAGE
GJINF% ;GET JOB INFORMATION
MOVEM T1,1+MUTARG ;STASH OUR JOB NUMBER
MOVX S1,.MUSPQ ;FUNCTION IS SET MAXIMUM NUMBER OF PIDS
MOVEM S1,0+MUTARG ;STASH FUNCTION
MOVE S1,NFORKS ;GET NUMBER OF FORKS
LSH S1,1 ;DOUBLE THAT NUMBER OF PIDS ALLOWED
ADDI S1,5 ;ADD NORMAL NUMBER THAT EXEC ALLOWS
MOVEM S1,2+MUTARG ;STASH NEW MAXIMUM
MOVEI S1,3 ;LENGTH OF ARGUMENT BLOCK
MOVEI S2,MUTARG ;ADDRESS OF ARGUMENT BLOCK
MUTIL% ;SET NEW QUOTA
ERCAL WARN ;PRINT WARNING IF WE FAIL
$RETT ;RETURN TO CALLER
;SPAWN - GENERATE AN INFERIOR FORK, MAPPING OUR IMAGE INTO ITS ADDRESS SPACE
;TAKES J/ SUBPROCESS NUMBER
;RETURNS +1 ALWAYS
SPAWN: SETZM FRKTAB(J) ;SAY NO FORK YET
MOVX S1,CR%CAP ;CREATE A FORK WITH OUR CAPS
SETZ S2, ;NO AC BLOCK
CFORK% ;CREATE A FORK
ERCAL SPAWNX ;SOME ERROR
MOVEM S1,FRKTAB(J) ;SAVE FORK HANDLE
MOVSI S1,.FHSLF ;OUR HANDLE,,FIRST SOURCE PAGE
MOVS S2,FRKTAB(J) ;DESTINATION HANDLE,,FIRST DEST PAGE
MOVE T1,[PM%CNT+PM%CPY+1000] ;COPY ENTIRE MAP, COPY ON WRITE ACCESS
PMAP% ;CREATE CLONE WITHOUT SHARED IMPURE STG
ERCAL SPAWNX ;SOME ERROR
MOVE S1,FRKTAB(J) ;GET BACK FORK HANDLE
MOVEI S2,LSRSPL ;STARTING ADDRESS
SFORK% ;START THE FORK
ERCAL SPAWNX ;SOME ERROR
$RETT ;GOOD RETURN
;HERE ON AN ERROR CREATING, LOADING, OR STARTING THE FORK
SPAWNX: $CALL TIMSMP ;FAILED, PRINT TIME STAMP
HRRZ T2,0(P) ;PC OF ERROR
$CALL LSTERR ;PRINT LAST ERROR
ADJSP P,-1 ;FIX UP STACK POINTER
SKIPE S1,FRKTAB(J) ;LOAD FORK HANDLE, SKIP IF NO FORK
KFORK% ;FLUSH ANY FORK
ERJMP .+1 ;IGNORE A FAILURE HERE
SETZM FRKTAB(J) ;SAY FORK SLOT UNOCCUPIED
$RETF ;TAKE FAILURE RETURN
;TIMSMP - PRINT A STANFORD-STYLE CTY TIMESTAMP
;RETURNS +1 ALWAYS
TIMSMP: MOVEI S1,.PRIOU ;OUR TTY
RFPOS% ;READ THE CURSOR POSTION
HRROI S1,[ASCIZ/
/]
TRNE S2,-1 ;AT LEFT MARGIN?
PSOUT% ;NO, PRINT THE CRLF
MOVX S1,.PRIOU ;TO THE TTY
SETO S2, ;NOW
SETZ T1, ;STANDARD FORMAT
ODTIM% ;TIMESTAMP
HRROI S1,[ASCIZ/ LSRSPL: /] ;OUR NAME
PSOUT% ;PRINT OUR NAME
$RETT ;RETURN TO CALLER
;LSTERR - PRINT LAST ERROR ON CTY
;TAKES T2/ PC (OR ZERO IF NONE)
;RETURNS +1 ALWAYS
LSTERR: MOVEI S1,.PRIOU
HRLOI S2,.FHSLF
SETZ T1,
ERSTR%
NOP
NOP
IFN. T2
HRROI S1,[ASCIZ/ at PC /]
PSOUT%
MOVEI S1,.PRIOU
HRRZ S2,T2
SUBI S2,2
MOVEI T1,^D8
NOUT%
NOP
ENDIF.
HRROI S1,[ASCIZ/
/]
PSOUT%
$RETT
;WARN - PRINT TIME STAMP AND LAST JSYS ERROR ON THE CTY AND RETURN
WARN: $CALL TIMSMP ;PRINT TIME STAMP
MOVE T2,(P) ;GET PC WE WERE CALLED FROM
$CALL LSTERR ;PRINT LAST JSYS ERROR
$RETT ;RETURN TO CALLER
;FNDLSR - FIND LUSING FORK
;WE RUN WHEN THE MOTHER FORK UNBLOCKS BECAUSE AN INFERIOR CRASHED.
; WE SCAN OUR FORK TABLE AND IF THE CRASH WAS IN ONE OF OUR DIRECT
; INFERIORS, WE REPORT THE CRASH AND RESTART THE FORK. HOPEFULLY THE
; GLXLIB CODE IN THE INFERIOR FORK WILL GIVE US MORE DETAILS OF WHAT
; WENT WRONG.
FNDLSR: MOVN J,NFORKS ;GET NEGATIVE COUNT OF SUBFORKS
MOVSI J,(J) ;MAKE AN AOBJN POIN.TER
SKIPN S1,FRKTAB(J) ;SKIP IF FORK EXISTS
FNDLS0: AOBJN J,.-1 ;LOOP OVER ALL FORKS
JUMPGE J,.RETT ;QUIT WHEN NO MORE FORKS
RFSTS% ;READ FORK STATUS
ERJMP FNDLS1 ;BAD HANDLE, GO FIX THINGS UP
TXZ S1,RF%FRZ ;CLEAR FROZEN BIT, IF ANY
HLRZS S1 ;SWAP SIDES
CAIE S1,.RFFPT ;FORCED TERMINATION?
CAIN S1,.RFHLT ;OR VOLUNTARY?
TRNA ;YES, REPORT LOSSAGE AND RESTART
JRST FNDLS0 ;FORK IS GOOD, KEEP LOOKING
FNDLS1: $CALL TIMSMP ;PRINT A TIMESTAMP
HRROI S1,[ASCIZ/Subfork /] ;START MESSAGE
PSOUT% ; ...
MOVX S1,.PRIOU
MOVEI S2,(J)
MOVEI T1,^D10
NOUT% ;PRINT SUBFORK NUMBER
NOP
HRROI S1,[ASCIZ/ crashed, restarting.
/]
PSOUT%
MOVE S1,FRKTAB(J) ;GET HANDLE OF LOSING FORK
KFORK% ;ZAP IT
ERJMP .+1 ;IGNORE AN ERROR
SETZM FRKTAB(J) ;CLEAR FORK TABLE ENTRY
$CALL SPAWN ;TRY TO CREATE A NEW SUBFORK
JRST FNDLS0 ;LOOP OVER OTHER ENTRIES
;LSRSPL - THE MAIN CODE FOR SPOOLING TO THE CANON
LSRSPL: RESET% ;AS USUAL.
MOVE P,[IOWD PDSIZE,PDL] ;SET UP THE STACK.
MOVEI S1,.FHSLF
SETO T1,
EPCAP%
MOVEI S1,IB.SZ ;GET THE IB SIZE.
MOVEI S2,IB ;ADDRESS OF THE IB.
$CALL I%INIT ;SET UP THE WORLD.
$CALL OPDINI ;GET OPERATING SYSTEM INFO.
MOVEI T1,HELLO ;GET ADDRESS OF HELLO MESSAGE.
$CALL SNDQSR ;SAY HI TO QUASAR.
MOVEI S1,^D10 ;START OUT WITH A TEN SECOND DISMISS
MOVEM S1,SLEEPT ;STORE IT
;FALL THROUGH TO MAIN LOOP.
SUBTTL Idle Loop
MAIN: SKIPN JOBACT ;IS THE STREAM ACTIVE?
JRST MAIN.2 ;NO
MOVE J,JOBPAG ;YES, GET JOB PAGE
SKIPN JOBCHK ;DO WE WANT TO UPDATE THE JOB STATUS?
JRST MAIN.0 ;NO, THEN SKIP THIS
PUSHJ P,UPDTST ;SEND A DEVICE STATUS MESSAGE
PUSHJ P,CHKPNT ;SEND A CHECKPOINT MESSAGE
MAIN.0: MOVE S1,JOBSTW ;GET STREAM STATUS WORD
TXZ S1,PSF%DO ;DON'T BLOCK HERE BECAUSE OF OFFLINE
JUMPN S1,MAIN.2 ;SOMETHING ELSE CAUSING US TO BLOCK
MOVSI 17,J$RACS(J) ;SETUP TO GET SOME ACS
BLT 17,17
POPJ P, ;AND RETURN
; TO HERE FROM DSCHD.
MAIN.1: SKIPN JOBCHK ;DO WE WANT TO UPDATE THE JOB STATUS?
JRST MAIN.2 ;NO, THEN SKIP THIS
$CALL UPDTST ;SEND A DEVICE STATUS MESSAGE
$CALL CHKPNT ;SEND A CHECKPOINT MESSAGE
MAIN.2: $CALL CHKQUE ;CHECK FOR INCOMMING MESSAGES
SKIPE MESSAGE ;DID WE PROCESS A MESSAGE?
JRST MAIN.3 ;YES,CONTINUE PROCESSING
MOVE S1,JOBSTW ;GET STATUS WORD
TXZ S1,PSF%DO ;DON'T CONSIDER OFFLINE HERE
SKIPE JOBACT ;BLOCK IF STREAM INACTIVE
JUMPE S1,MAIN.3 ;OR WAITING FOR A BAD STATUS BIT TO CLR
MOVEI S1,^D10 ;PICK UP SLEEP TIME
$CALL I%SLP ;YES, GO WAIT
MAIN.3: MOVE P,[IOWD PDSIZE,PDL] ;RESET THE STACK POINTER.
JRST MAIN ;KEEP ON PROCESSING.
SUBTTL Deschedule Process
;DSCHD is called by the $DSCHD macro to cause the "current" stream to
; be un-scheduled. The call is:
;
; $DSCHD(flags)
;
;which generates:
;
; PUSHJ P,DSCHD
; JUMP [EXP flags]
DSCHD: MOVEM 0,J$RACS(J) ;SAVE AC 0
MOVEI 0,J$RACS+1(J) ;PLACE TO PUT AC 1
HRLI 0,1 ;SETUP THE BLT POINTER
BLT 0,J$RACS+17(J) ;SAVE AWAY THE ACS
HRRZ S1,0(P) ;GET ADDRESS OF "JUMP [FLAGS]"
MOVE S1,@0(S1) ;GET THE FLAGS
IORM S1,JOBSTW ;SET THE FLAGS
MOVE P,[IOWD PDSIZE,PDL] ;RESET THE STACK POINTER.
JRST MAIN.1 ;AND CONTINUE SCHEDULING.
SUBTTL NEXTJOB Message from QUASAR
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
SETOM JOBACT ;MAKE THE STREAM ACTIVE
SETOM JOBCHK ;CHECKPOINT FIRST CHANCE WE GET
MOVX S2,PSF%OB+PSF%ST+PSF%OR ;GET LOTS OF BITS
ANDCAM S2,JOBSTW(S1) ;CLEAR THEM
MOVEI S1,J$RPDL-1(J) ;POINT TO CONTEXT PDL
HRLI S1,-^D100 ;AND THE LENGTH
PUSH S1,[EXP DOJOB] ;PUSH THE FIRST ADR ON THE STACK
MOVEM S1,J$RACS+P(J) ;AND STORE THE PDL
SETZB S,J$RACS+S(J) ;CLEAR FLAGS AC
LOAD S1,.EQSPC(J),EQ.NUM ;GET NUMBER OF FILES
MOVEM S1,J$RFLN(J) ;STORE IT
MOVEI S1,J$$BEG(J) ;ZERO SELECTED WORDS IN 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
MOVE T2,.EQCHK+CKFLG(J) ;GET THE CHECKPOINT FLAGS
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
$WTOJ (Begin,<^R/.EQJBB(J)/>,@JOBOBA)
$RETT ;AND RETURN
SUBTTL Do the Job
DOJOB:
;NOTE THAT WE HAVE 4 CASES HERE FOR FORMS TYPE
;1) OLDUSR OLD-STYLE FIRMWARE, NO ACCOUNTING (OLDF=1, ACCTF=0)
;2) OLDSYS OLD-STYLE FIRMWARE, ACCOUNTING ON (OLDF=1, ACCTF=1)
;3) USER NEW-STYLE FIRMWARE, NO ACCOUNTING (OLDF=0, ACCTF=0)
;4) SYSTEM NEW-STYLE FIRMWARE, ACCOUNTING ON (OLDF=0, ACCTF=1)
TXZ S,OLDF ;ASSUME NEW STYLE IMPRINT-10
TXO S,ACCTF ;ASSUME ACCOUNTING ON
GETLIM S2,.EQLIM(J),FORM ;GET FORMS TYPE
MOVEM S2,J$FORM(J) ;REMEMBER FORMS TYPE
HLRZS S2 ;GET LH INTO RH TO CHECK OLDNESS
CAIN S2,'OLD' ;OLD STYLE IMPRINT-10?
TXO S,OLDF ;YES, SET FLAG
MOVE S2,J$FORM(J) ;GET UNMUNGED FORMS TYPE BACK
CAME S2,[SIXBIT/OLDUSR/]
CAMN S2,[SIXBIT/USER /]
TXZ S,ACCTF ;USER CANON, NO ACCOUNTING
CAME S2,[SIXBIT/OLDSYS/]
CAMN S2,[SIXBIT/SYSTEM/]
TXO S,ACCTF ;SYSTEM CANON, DO ACCOUNTING
LOAD E,.EQLEN(J),EQ.LOH ;GET LENGTH OF HEADER
ADD E,J ;POINT TO FIRST FILE
PUSHJ P,REVFIL ;REVERSE THE FILE ORDER
SETZM J$RNFP(J) ;ZAP THE # OF FILES PRINTED
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.4 ;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.4: PUSHJ P,FILE ;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.
PUSHJ P,CHKPNT ;TAKE A CHECKPOINT
PUSHJ P,NXTFIL ;BUMP TO NEXT FILE
JUMPT DOJO.4 ;AND LOOP
DOJO.7: JRST ENDJOB ;FINISH JOB
MOVE S1,J$APRT(J) ;GET NUMBER OF PAGES PRINTED
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 NXTFIL - FIND AND RETURN THE NEXT FILE IN THE NEXTJOB MSG
NXTFIL: SETZM J$RNCP(J) ;CLEAR COPIES PRINTED
MOVE S1,FILPTR ;GET THE FILE POINTER
POP S1,E ;GO TO NEXT FILE
MOVEM S1,FILPTR ;SAVE UPDATED POINTER
SKIPE E ;ANYTHING THERE?
$RETT ;YES, RETURN TRUE
$RETF ;NO, RETURN FALSE
REVFIL: MOVE S1,[IOWD 100,FILPDL] ;SET UP THE STACK
PUSH S1,[0] ;SAVE A ZERO
REVFL1: PUSH S1,E ;SAVE THE NEXT ONE
SOSG J$RFLN(J) ;DECREMENT THE COUNT
JRST REVFL2 ;DONE
LOAD T1,.FPLEN(E),FP.LEN ;GET THE FP LENGTH
ADD E,T1 ;BUMP TO THE FD
LOAD T1,.FDLEN(E),FD.LEN ;GET THE FD LENGTH
ADD E,T1 ;BUMP TO THE NEXT FP
JRST REVFL1 ;LOOP BACK
REVFL2: POP S1,E ;GET THE FIRST FILE TO BE PRINTED
MOVEM S1,FILPTR ;SAVE THE POINTER
POPJ P, ;DONE
SUBTTL FILDIS - ROUTINE TO KEEP/DELETE PRINTED SPOOL 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: LOAD 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,.FPLEN(E),FD.LEN ;GET THE FD LENGTH.
ADD E,S2 ;POINT TO NEXT FILE.
FILD.2: MOVEI S1,FOB.SZ ;GET THE FOB LENGTH
MOVEI S2,J$XFOB(J) ;AND THE FOB ADDRESS
TXNN T2,FP.SPL ;SPOOL FILE?
IFSKP.
PUSHJ P,F%DEL
JRST FILD.3 ;YES, DELETE THE FILE.
ENDIF.
TXNE S,ABORT ;IS ABORT SET?
JRST FILD.3 ;YES DON'T DELETE
TXNE T2,FP.DEL ;/DELETE ???
PUSHJ P,F%DEL ;YES,,DELETE THE FILE.
FILD.3: SOJG T1,FILD.1 ;GO PROCESS THE NEXT FILE
$RETT ;RETURN.
SUBTTL PRINT A FILE
FILE: TXNE S,ABORT ;ARE WE IN TROUBLE ???
$RETT ;YES,,JUST RETURN.
TXZ S,NOBANN ;ASSUME USER WANTS BANNER PAGE
LOAD S1,.FPINF(E),FP.NFH ;GET FLAG FOR THIS FILE
SKIPE S1 ;SKIP IF BANNER IS OKAY
TXO S,NOBANN ;ELSE SET THE BIT
MOVE S1,[POINT 7,LOGBUF] ;SET UP ERROR LOG FOR THIS FILE
MOVEM S1,LOGPTR
MOVEI S1,8 ;USE 8-BIT BYTES
PUSHJ P,INPOPN ;OPEN THE INPUT FILE
JUMPF BADHDR ;LOSE, MAKE A BAD HEADER AND RETURN
PUSHJ P,MAKIMP ;PRODUCE THE TEMPORARY IMP FILE
JUMPF [ $WTOJ (<MAKIMP failed ^F/@J$DFDA(J)/>,<^R/.EQJBB(J)/>,@JOBOBA)
$TEXT (LOGX,<File is not printable, aborted>)
$CALL INPFEF ;FORCE EOF AND CLEAR BUFFERS
MOVE S1,J$DIFN(J)
$CALL F%REL ;CLOSE THE SOURCE FILE
$CALL BADHDR ;PRINT ERROR LOG, IF POSSIBLE
$RETT ] ;RETURN IF NO HEADER POSSIBLE
MOVE S1,J$DIFN(J)
PUSHJ P,F%REL ;CLOSE THE SOURCE FILE
MOVEI S2,IMPFIL
EXCH S2,J$XFOB(J) ;FAKE OUR FOB TO POINT TO TEMP FILE
MOVEM S2,J$TEMP(J) ;SAVE OLD FOB FOR LATER
$CALL INPO.T ;OPEN THE TEMPORARY FILE, NO ACCESS CHK
JUMPT FILE.1 ;JUMP TO IS CODE IF WE SUCCEEDED
MOVEI S1,1 ;SHORT FOB FOR THIS DELETE
MOVEI S2,J$XFOB(J) ;FOB ADDR
$CALL F%DEL ;DELETE THE TEMPORARY FILE
MOVE S2,J$TEMP(J) ;GET OLD FD ADDR
MOVEM S2,J$XFOB(J) ;FIX THINGS, JUST IN CASE
$CALL BADHDR ;PRINT A BAD HEADER PAGE
$RETF ;TAKE A FAILURE RETURN
;HERE TO START PRINTING THE FILE
FILE.1: $CALL CHKPNT
TXNE S,ABORT!SKPFIL!RQB ;DO WE REALLY WANT TO DO THIS?
JRST FILE.2 ;NO, CLEAN UP THE MESS
HRROI S1,RSBUF ;ARGUMENT LINE FOR IS.EXE PROGRAM
$CALL RUNIS ;PRINT THE FILE
JUMPF FILE.X
TXNE S,ABORT!SKPFIL!RQB ;ABORTED OR SKIPPED OR REQUEUED?
JRST FILE.2 ;YES, CONTINUE ON
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
CAMGE S1,S2 ;PRINTED ENOUGH?
JRST FILE.1 ;NO. LOOP
FILE.2: MOVE S1,J$DIFN(J) ;GET THE IFN
PUSHJ P,F%REL ;CLOSE IT
TXZ S,DSKOPN+SKPFIL ;CLEAR SOME BITS
MOVEI S1,1 ;SHORT FOB FOR THIS DELETE
MOVEI S2,J$XFOB(J) ;FOB ADDR
PUSHJ P,F%DEL ;DELETE THIS FILE
MOVE S2,J$TEMP(J) ;GET OLD FD ADDR
EXCH S2,J$XFOB(J) ;FIX THINGS
POPJ P,
;HERE IF IS.EXE BOMBED.
;IF ARGERR IS SET, IS.EXE ENCOUNTERED A FATAL ERROR AND WE SHOULD NOT TRY
; TO PRINT THE FILE AGAIN. IF OFFLINE IS SET, IS.EXE DISCOVERED THAT THE
; CANON WAS NOT RESPONDING; WE SHOULD TRY AGAIN. IF NEITHER ARGERR OR
; OFFLINE IS SET, LSRSPL BLEW UP TRYING TO CREATE THE IS.EXE FORK.
FILE.X: TXNE S,ABORT ;IS ABORT FLAG LIT?
JRST FILE.2 ;YES, GO FLUSH THE FILE
TXNN S,ARGERR!OFFLINE ;WAS ERROR FROM IS.EXE ITSELF?
$FATAL <Can't start IS program> ;NO, DIE HORRIBLY. WE CAN'T WIN.
TXNN S,ARGERR ;FATAL ERROR RETURNED BY IS.EXE?
IFSKP.
$WTO (<Bad IS arguments>,,@JOBOBA) ;TELL OPR FILE DIDN'T MAKE IT
JRST FILE.2 ;GO FLUSH FILE
ENDIF.
MOVE S1,JOBSTW ;GET THE STATUS BITS
TXO S1,PSF%DO ;SET OFF LINE
EXCH S1,JOBSTW ;STORE NEW STATUS
TXNN S1,PSF%DO ;WAS IT OFF LINE BEFORE?
$CALL UPDTST ;SEND A STATUS UPDATE
$WTO (<Canon offline>,,@JOBOBA) ;TELL OPR IT'S HUNG
MOVEI S1,SLEEP1 ;GET DISMISS TIME
$CALL I%SLP ;GO WAIT FOR A WHILE
$DSCHD (0) ;DESCHEDULE, CHECK FOR IPCF MESSAGES
MOVX S1,PSF%DO
ANDCAM S1,JOBSTW ;ASSUME WE'VE FIXED THE PROBLEM
SETOM JOBCHK ;INDICATE WE WANT ANOTHER WHEN WE CAN
$CALL ACTBEG ;DON'T CHARGE FOR CANON LOSSAGE
JRST FILE.1 ;TRY REPRINTING.
;MAKIMP - CHECK IF THIS FILE IS IMPRESS FORMAT, AND CONVERT TO AN IMP FILE AS
;NECESSARY. SEVERAL CASES:
; 0 OLD FORMAT IMP -- CONVERT TO NEW FORMAT BY CREATING NEW-FORMAT HDR
; 1 NEW FORMAT IMP -- INSERT HEADER ELEMENTS
; 3 TEXT -- COPY, INSERTING HEADER
; 4 TEXT W/ HEADER -- COPY, INSERTING HEADER ELEMENTS
; 5 BINARY -- BOMB. $RETF (not currently implemented)
; TEKTRONIX -- .FBTEK BIT SET IN REQUEST, GENERATE LANGUAGE FOR
; TEKTRONIX EMULATION MODE ON IMAGEN
MAKIMP: $CALL CHKSIZ ;CHECK IF FILE IS REALLY PRINTABLE
JUMPF .RETF ;BAD BYTE OR PAGE COUNT
MOVEM S1,FILSIZ ;SAVE "PROPER" BYTE SIZE
REPEAT 0,<
CAIN S1,^D8 ;WAS IT OPENED CORRECTLY?
IFSKP. ;NO, MAYBE DO SOMETHING ABOUT IT
CAIN S1,^D36 ;36 BIT MODE? IGNORE IT, USE 8
IFSKP. ;NOPE, USE WHATEVER IT CLAIMS
PUSH P,S1 ;SAVE S1
MOVE S1,J$DIFN(J) ;CLOSE 8-BIT OPENING
$CALL F%REL ; ...
POP P,S1 ;REOPEN IN PROPER MODE
$CALL INPOPN ; ...
ENDIF.
ENDIF.
>;REPEAT 0,
LOAD S1,.FPINF(E),FP.FFF ;GET FILE FORMAT (AKA /FILE:)
CAIN S1,.FPTEK ;IS THIS TEKTRONIX?
JRST MAKTEK ;GO JOIN TEKTRONIX CODE IF IT IS, ELSE
$CALL CHKTEK ;SEE IF IT IS TEKTRONIX FILE AND USER FORGOT
;/TEKTRONIX OR SPOOLED FROM REMOTE SITE
JRST MAKI.X ;SOME FAILURE
JUMPT MAKTEK ;IT WAS A TEKTRONIX FILE, GO JOIN THAT CODE
$CALL INPBYT ;GET THE FIRST BYTE
JUMPF MAKI.X ;EOF
CAIL S2,"0" ;IS IT A DIGIT?
CAILE S2,"5"
JRST MAKI.1 ;NO. CAN'T BE OLD-FORMAT
TXNN S,OLDF ;OLD-FORMAT IMP FILE. OLD STYLE IMPRINT-10?
IFSKP.
$CALL INPREW ;REWIND INPUT
$CALL MAKOPN ;OPEN TEMPORARY FILE
JRST MAKCPY ;COPY INTO TEMPORARY FILE
ENDIF.
DO.
$CALL INPBYT ;OLD-FORMAT ON A NEW CANON.
JUMPF MAKI.X ;EOF
JUMPN S2,TOP. ;FLUSH "2<filename>"
ENDDO.
MOVEI T1,^D8 ;WANT TO FLUSH 8 BYTES
$CALL INPBYT ;SNARF ONE
JUMPF MAKI.X ;EOF
SOJG T1,.-2 ;FLUSH "ImagImPr"
$CALL MAKHDR ;CREATE TEMPORARY FILE, ADD HEADER ELEMENTS
$TEXT (PUTCHR,<,Language Impress^A>) ;SPECIFY LANGUAGE
LOAD S1,.FPINF(E),FP.FFF ;GET FILE FORMAT (AKA /FILE:)
CAIE S1,.FPREV ;SHOULD WE REVERSE THE PAGES?
IFSKP.
$TEXT (PUTCHR,<,Pagereversal On)^A>) ;PUT REVERSAL IN DCL
ELSE.
$TEXT (PUTCHR,<)^A>) ;OR JUST TIE IT OFF
ENDIF.
$CALL MAKCPY ;COPY REST OF FILE
$RETT ;RETURN TO CALLER
;MAKIMP (CONT'D)
;THE FILE WAS NOT OLD-STYLE IMPRESS. CHECK FOR NEW-STYLE IMPRESS.
MAKI.1: $CALL CHKDOC ;DOES IT START WITH "@DOCUMENT("?
JUMPF MAKI.2 ;NO. NOT NEW-FORMAT EITHER
TXNE S,OLDF ;OLD IMPRINT-10?
$RETF ;YES, WE CAN'T DO THIS
$CALL MAKHDR ;MAKE A HEADER
MOVEI S1,"," ;PREPARE FOR ADDITIONAL ARGS
$CALL PUTCHR
LOAD S1,.FPINF(E),FP.FFF ;GET FILE FORMAT (AKA /FILE:)
CAIE S1,.FPREV ;SHOULD WE REVERSE THE PAGES?
IFSKP.
$TEXT (PUTCHR,<Pagereversal On,^A>) ;PUT REVERSAL IN DCL
ENDIF.
JRST MAKCPY ;ORIGINAL HDR MUST INCLUDE
;"LANGUAGE IMPRESS" OR SOMETHING
;MAKIMP (CONT'D)
;THE FILE IS NOT IMPRESS. CHECK FOR DVI OR TEXT FILE.
MAKI.2: PUSH P,S2 ;SAVE S2 SINCE IT HAS FIRST BYTE OF FILE
$CALL CHKDVI ;FILTER OUT JUNK FILES, CHECK FOR DVI FILES
POP P,S2 ;RESTORE S2
JUMPF .RETF ;BAD FILE, DON'T EVEN THINK ABOUT IT
JUMPE S1,MAKI.3 ;WE THINK IT'S TEXT, TRY 7-BIT OPENING
COMMENT ?
AT THIS POINT, WE CAN SAFELY (HA!) ASSUME THAT WE HAVE THE FILE OPENED
PROPERLY. DVI FILES ARE BY DEFINITION IN 8 BIT BYTES, REGARDLESS OF WHETHER
TEX78 OR TEX82 WROTE THEM. WE CAN IGNORE THE FACT THAT TEX78 SET THE FILE
BYTE SIZE TO 36.
?
$CALL INPREW ;MUST BE A .DVI FILE. RESET FILE POINTER
TXNE S,OLDF ;DO WE HAVE AN OLD CANON HERE?
JRST MAKDVI ;YES, GO DO OUR THING
JRST MAKDVI ;NO CODE FOR HEADER YET, PRETEND OLD CANON.
;MAKIMP (CONT'D)
;HERE IF THE FILE IS TEXT
COMMENT ?
HERE WE HAVE TO MAKE SURE WE HAVE OPENED THE FILE WITH THE PROPER BYTE SIZE.
1022 IS KNOWN TO WRITE FILES THAT CLAIM TO HAVE 36 BIT BYTES, BUT WE AREN'T
GOING TO LET THAT FOOL US. UNTIL WE FIND A DIFFERENT CULPRIT, USE 7 BIT BYTES
IF THE BYTE SIZE IS 36, OTHERWISE USE THE VALUE WE GOT FROM CHKSIZ LONG AGO.
? ;END COMMENT
MAKI.3: MOVE S1,FILSIZ
CAIN S1,^D8 ;WAS IT OPENED CORRECTLY?
IFSKP. ;NO, MAYBE DO SOMETHING ABOUT IT
CAIN S1,^D36 ;36 BIT MODE? IGNORE IT, USE 7
MOVEI S1,^D7
PUSH P,S1 ;SAVE S1
MOVE S1,J$DIFN(J) ;CLOSE 8-BIT OPENING
$CALL F%REL ; ...
POP P,S1 ;REOPEN IN PROPER MODE
$CALL INPOPN ; ...
ENDIF.
$CALL INPREW
$CALL INPBYT ;GET FIRST BYTE OF FILE FOR CHKDOC
TXNE S,OLDF ;IF OLD CANON, IGNORE POSSIBILILTY OF HEADER
IFSKP.
$CALL CHKDOC ;CHECK IF IT HAS A HEADER
JUMPT MAKI.4 ;HAS HEADER ALREADY.
ENDIF.
$CALL INPREW ;NO HDR, SO START AT BEGINNING
SKIPN .EQCST+1(J) ;USER WANTS A SPECICAL FONT?
TXNE S,OLDF ;OR OLD-STYLE IMPRINT-10?
JRST MAKTXT ;YES, USE MAKIMP PROGRAM ON A TEXT FILE
$CALL MAKHDR ;MAKE HEADER
LOAD S1,.FPINF(E),FP.FPF ;GET PAPER TYPE (AKA /MODE:)
CAIN S1,%FPCAS ;ASCII FORMAT
JFCL ;USE DEFAULTS
CAIN S1,%FPCBC ;BCD (??) FORMAT
JRST [ $TEXT (PUTCHR,<,Formwidth 132^A>)
JRST MAKI30 ] ;ROTATED, 1 FORM PER PAGE
CAIN S1,%FPCBI ;BINARY FORMAT
JRST [ $TEXT (PUTCHR,<,Formsperpage 2,Outlines^A>)
JRST MAKI30 ] ;ROTATED, 2 FORMS PER PAGE
CAIN S1,%FPCIM ;IMAGE FORMAT
JRST [ $TEXT (PUTCHR,<,Leftmargin 4^A>)
JRST MAKI30 ] ;A BIT OF MARGIN FOR PRINTING
MAKI30: $TEXT (PUTCHR,<,Language Printer,^A>)
;OKAY, IF USER SPECIFIED .FPREV WE
;*DON'T* REVERSE THE PAGES IN LPT MODE
;DEFAULT IS TO REVERSE PAGES IN LPT MODE
LOAD S1,.FPINF(E),FP.FFF ;GET FILE FORMAT (AKA /FILE:)
CAIE S1,.FPREV ;SHOULD WE LEAVE THE PAGES REVERSED?
IFSKP. ;NO, MAKE THEM BACKWARD
$TEXT (PUTCHR,<Pagereversal Off)^A>) ;PUT REVERSAL IN DCL
ELSE.
$TEXT (PUTCHR,<Pagereversal On)^A>) ;DO THE NORMAL THING
ENDIF.
JRST MAKCPY
;MAKIMP (CONT'D)
;HERE IF THE FILE IS TEXT AND HAS A HEADER AND THE CANON IS NEW
MAKI.4: $CALL MAKHDR ;MAKE HEADER
LOAD S1,.FPINF(E),FP.FFF ;GET FILE FORMAT (AKA /FILE:)
CAIE S1,.FPREV ;WANT PAGES REVERSED?
IFSKP.
$TEXT (PUTCHR,<,Pagereversal On,^A>) ;PUT REVERSAL IN DCL
ELSE.
MOVEI S1,"," ;PREPARE FOR ADDITIONAL ARGS
$CALL PUTCHR ; ... (CHEAPER THAN $TEXT)
ENDIF.
JRST MAKCPY ;COPY REST OF THING, INCLUDING HDR
;HERE ON PREMATURE EOF
MAKI.X: $CALL MAKHDR
$TEXT (PUTCHR,<ERROR END-OF-FILE)>)
JRST MAKC.X
;MAKTEK - MAKE TEKTRONIX EMULATION HEADER.
MAKTEK: STKVAR <BYTSIZ>
TXNE S,OLDF ;OLD IMPRINT-10?
$RETF ;YES, WE CAN'T DO THIS
$CALL CHKSIZ ;FIND REAL BYTE SIZE OF FILE
JUMPF .RETF ;PUNT IF BAD BYTE OR PAGE COUNT
CAIG S1,^D36
CAIGE S1,^D7
$RETF ;DIE HORRIBLY, BYTE SIZE ILLEGAL
CAIN S1,^D8 ;WAS IT OPENED CORRECTLY?
IFSKP. ;NO, DO SOMETHING ABOUT IT
MOVEM S1,BYTSIZ
MOVE S1,J$DIFN(J) ;CLOSE 8-BIT OPENING
$CALL F%REL ; ...
MOVE S1,BYTSIZ ;REOPEN IN PROPER MODE
$CALL INPOPN ; ...
ENDIF.
$CALL MAKHDR ;MAKE A HEADER
$TEXT (PUTCHR,<,Language Impress)^A>) ;SPECIFY LANGUAGE FOR HEADER
$TEXT (PUTCHR,<@DOCUMENT(LANGUAGE TEKTRONIX)^A>) ;TEK4014 MODE
;FOR THE ACTUAL GUTS OF THE PLOT FILE
JRST MAKCPY ;COPY REST OF FILE
;AND RETURN TO CALLER FROM THERE
;JUMP HERE FROM MAKIMP WHEN WE NEED TO RUN MAKIMP.EXE OVER THE FILE.
;ENTER AT MAKTXT FOR TEXT FILES, AT MAKDVI FOR DVI FILES
;RETURNS TO CALLER OF MAKIMP
MAKDVI: SETOM J$DVIF(J) ;SET FLAG THAT WE THINK THIS IS A DVI FILE
$CALL MAKOPN ;OPEN TEMPORARY FILE IN 8-BIT MODE
JRST MAKTX0 ;JOIN MAIN CODE
MAKTXT: SETZM J$DVIF(J) ;SAY A TEXT FILE
$CALL MAKOP7 ;OPEN THE TEMPORARY FILE IN 7 BIT BYTES
MAKTX0: $CALL MAKCPY ;DO THE COPY, CLOSE THE FILE
HRROI S1,IMPFIL+1 ;POINTER TO FILENAME
$CALL RUNIMP ;INVOKE MAKIMP TO PRODUCE AN IMP FILE
JUMPF .RETF
$CALL DELTMP ;FLUSH TEMPORARY FILE
JUMPF .RETF
MOVEI S1,MAKRCP ;NEW CANON - COPY IMP FILE TO TMP, ADD HEADER
TXNE S,OLDF ;WHAT TYPE OF CANON?
MOVEI S1,MAKREN ;OLD CANON - RENAME IMP TO TMP, NO HEADER
$CALL 0(S1) ;CALL APPROPRIATE ROUTINE
JUMPF .RETF ;IT BLEW UP
$RETT ;GOOD RETURN
;CHKDVI - FILTER OUT TEXT, DVI, AND BINARY FILES. NOT VERY SMART CODE.
;RETURNS TRUE IF PRINTABLE, S1/ ZERO IF SUSPECTED TEXT, .DVI OTHERWISE
;RETURNS FALSE IF WE SUSPECT SOME SORT OF NON-DVI, NON-IMP BINARY FILE.
CHKDVI: STKVAR <<DVISTR,10>> ;LOCAL STORAGE
SETZM DVISTR ;CLEAR FIRST WORD OF STKVAR
MOVE S1,J$DIFN(J) ;GET OUR IFN
MOVX S2,FI.CHN ;WANT THE TOPS-20 JFN
$CALL F%INFO ; ...
JUMPF .RETF ;PUNT IF SOME TYPE OF FAILURE HERE
MOVE S2,S1 ;GET JFN INTO PLACE
HRROI S1,DVISTR ;STRING POINTER
MOVX T1,FLD(.JSAOF,JS%TYP) ;WANT JUST THE EXTENSION
JFNS% ;GET THAT EXTENSION
ERJMP .RETF ;PUNT IF WE BOMB HERE
SETZ S1, ;ASSUME SOME SORT OF TEXT FILE
MOVE S2,DVISTR ;GET FIRST WORD OF EXTENSION
CAME S2,[ASCIZ/EXE/] ;REJECT EXECUTABLE FILES
CAMN S2,[ASCIZ/REL/] ;AND REL FILES
$RETF ; ...
CAMN S2,[ASCII/PRESS/] ;REJECT PRESS FILES FOR THE DOVER
$RETF ; ...
$CALL CKDPST ;CHECK DVI POSTAMBLE
SKIPT ;GOOD RETURN?
TDZA S1,S1 ;NOPE, NOT DVI, ASSUME TEXT
SETO S1, ;RETURN A -1 TO INDICATE DVI PROCESSING NEEDED
$RETT ; ...
;CHKTEK - CHECK FOR TEKTRONIX FILE
; RETURN FALSE, +1 IF SOME ERROR (EOF, ETC)
; RETURN TRUE, +2 IF TEKTRONIX FILE
; RETURN FALSE, +2 IF NON-TEKTRONIX FILE
;NOTE! Since the file has been opened in 8-bit mode, we don't use the
;normal values of $^L^] but instead the values that one gets by looking
;at that string using an 8-bit bytepointer. Be careful if you move the call
;to this routine or rework the file-opening logic in MAKIMP!
CHKTEK: $CALL INPBYT ;GET A BYTE
JUMPF .RETF ;ERROR
CAIE S2,66 ;IS IT AN <ESC>?
JRST CHKTKF ;NOPE, RETURN FALSE, +2
$CALL INPBYT ;GET ANOTHER BYTE
JUMPF .RETF ;ERROR
CAIE S2,60 ;IS IT A ^L?
JRST CHKTKF ;NOPE, RETURN FALSE, +2
$CALL INPBYT ;GET THIRD BYTE
JUMPF .RETF ;ERROR
CAIN S2,353 ;IS IT A ^]?
JRST CHKTKT ;YES, PASSED THE TEST
CHKTKF: $CALL INPREW ;PUT INPUT FILE POINTER BACK HOW WE GOT IT
AOS (P) ;SKIP RETURN
$RETF ;FALSE
CHKTKT: $CALL INPREW ;PUT INPUT FILE POINTER BACK HOW WE GOT IT
AOS (P) ;SKIP RETURN
$RETT ;TRUE
;CKDPST - CHECK FOR VALID DVI POSTAMBLE
; RETURN FALSE ($RETF) IF NOT VALID DVI POSTAMBLE
; RETURN TRUE ($RETT) IF VALID DVI POSTAMBLE
; DVI FILE SHOULD END WITH:
; <POSTAMBLE ADDR> n 223 ... 223 <eof>
; WHERE N <= MAXDVR
; TECHNIQUE FROM <CANON.MAKIMP>DVIINP.SAI
;NOTE THAT IF THIS TEST IS TOO LENIENT, MAKIMP WILL STILL CATCH BOGUS FILES
;AND REJECT THEM APPROPRIATELY
;ALSO NOTE THAT IF WE ARE TOO STRINGENT, PEOPLE COMPLAIN!
CKDPST: STKVAR <DVIJFN,<DVINAM,40>,NBYTES>
MOVE S1,J$DIFN(J) ;GET OUR IFN
MOVX S2,FI.CHN ;WANT THE TOPS-20 JFN
$CALL F%INFO ;ASK GLXFIL
JUMPF .RETF ;PUNT IF SOME FAILURE
MOVE S2,S1 ;JFN IN AC 1
HRROI S1,DVINAM ;POINTER TO DEST. IN AC 2
MOVX T1,<1B2!1B5!1B8!1B11!1B14!JS%PAF>
JFNS%
ERJMP CKPERR ;GO TO OUR ERROR HANDLER
MOVX S1,GJ%SHT!GJ%OLD ;SHORT FORM, OLD FILE
HRROI S2,DVINAM ;THIS IS FILE NAME
GTJFN%
ERJMP CKPERR
MOVEM S1,DVIJFN
MOVX S2,FLD(^D8,OF%BSZ)!OF%RD ;DVI FILES IN 8BIT (ALWAYS?)
OPENF% ;OPEN THE SUCKER
ERJMP CKPERR
SETOM S2 ;GO TO EOF
SFPTR%
ERJMP CKPERR
RFPTR% ;READ THAT POSITION
ERJMP CKPERR
SUBI S2,PSTBFL*4 ;BACK UP LENGTH OF OUR BUFFER
SFPTR% ;GO TO THAT POINT IN FILE
ERJMP CKPERR
MOVE S2,[POINT 8,PSTBUF] ;POINT AT OUR BUFFER
MOVNI T1,PSTBFL*4 ;READ AT MOST A BUFFER-FULL
SIN% ;READ THOSE CHARACTERS
IFJER.
MOVE T1,S2 ;SAVE S2
GTSTS%
TXNN S2,GS%EOF ;EOF? DON'T WORRY
JRST CKPERR ;SOMETHING ELSE, WORRY ABOUT IT
MOVE S2,T1 ;RESTORE S2
ENDIF.
MOVE S1,DVIJFN
CLOSF% ;NOW WE CAN FLUSH FILE
NOP
SETZM DVIJFN ;ZERO OUT JFN, JUST IN CASE
MOVE T1,S2 ;GET UPDATED BYTE POINTER TO T1
LDB S2,T1 ;GET LAST BYTE WE READ
CAIE S2,DMGNUM ;OUR MAGIC NUMBER
$RETF ;MUST NOT BE A DVI FILE, PUNT
DO.
LDB S2,T1
CAIE S2,DMGNUM ;DMGNUM==^D223
EXIT.
SETOM T2
ADJBP T2,T1 ;BUMP BYTEPOINTER BACK BY ONE
MOVE T1,T2
HRRZS T2 ;GET LOC POINTED AT BY BP
CAIGE T2,PSTBUF ;BEFORE BEGINNING OF OUR BUFFER?
$RETF ;YES, FAIL RETURN (MAYBE DO SOMETHING ELSE?)
LOOP.
ENDDO.
CAILE S2,MAXDVR ;BIGGER THAN MAX DVI VERSION?
$RETF
$RETT
;CKPERR - CKDPST ERRORS COME HERE
CKPERR: SKIPN S1,DVIJFN ;HAD A JFN ON FILE?
IFSKP.
CLOSF% ;TRY TO CLOSE IT
IFJER. ;IF FAILED, TRY TO FLUSH IT
MOVE S1,DVIJFN
RLJFN%
NOP ;DON'T WORRY TOO MUCH
ENDIF.
ENDIF.
$RETF ;PROPAGATE FAILURE RETURN
;MAKOPN - OPEN THE TEMPORARY FILE, TWO FLAVORS OF BYTE SIZES
MAKOP7: SKIPA T1,[^D7] ;ENTER HERE FOR TEXT FILE
MAKOPN: MOVEI T1,^D8 ;ENTER HERE FOR IMPRESS FILE
MOVEM T1,J$OBSZ(J) ;SAVE BYTE SIZE
MOVX S1,GJ%FOU!GJ%SHT
HRROI S2,IMPFIL+1
GTJFN% ;GET HANDLE ON FILE
ERCAL MAKOPX
MOVEM S1,J$OJFN(J)
DPB T1,[POINT 6,S2,5] ;SET BYTE SIZE
TXO S2,OF%WR ;WRITE ACCESS
OPENF% ;OPEN THE TEMPORARY (COPY) FILE
ERCAL MAKOPX
$RETT ;SUCCESS RETURN
MAKOPX: $CALL TIMSMP ;PRINT TIME STAMP
MOVE T2,0(P) ;WANT PC OF LOSSAGE
$CALL LSTERR ;PRINT LAST ERROR
$RETF ;GIVE BAD RETURN
;MAKCPY - COPY TO OUTPUT FILE.
;THIS IS QUICK, DIRTY, AND FAST. IDEALLY GLXLIB ROUTINES SHOULD BE USED
;FOR HANDLING THE OUTPUT FILE.
BUFSIZ==1000 ;SIZE OF COPY FILE BUFFER
MAKBUF: BLOCK BUFSIZ ;OUTPUT BUFFER FOR COPY FILE
BUFCNT: BLOCK 1 ;COUNT OF BYTES REMAINING IN BUFFER
BUFPTR: BLOCK 1 ;POINTER INTO COPY BUFFER
MAXBUF: BLOCK 1 ;MAXIMUM NUMBER OF BYTES IN BUFFER
MAKCPY: MOVEI S1,^D36 ;36 BITS IN A WORD
IDIV S1,J$OBSZ(J) ;COMPUTE BYTES PER WORD
IMULI S1,BUFSIZ ;COMPUTE TOTAL NUMBER OB YTES
MOVEM S1,MAXBUF ;REMEMBER LARGEST POSSIBLE BUFFER
CALL SETBUF ;SET UP THE OUTPUT BUFFER
MAKCP0: $CALL INPBYT ;READ IN A BYTE
JUMPF MAKC.X ;END OF FILE
MAKCP1: SOSGE BUFCNT ;DECREMENT BUFFER COUNT
JRST MAKCP2 ;GO DUMP BUFFER
IDPB S2,BUFPTR ;DEPOSIT BYTE IN BUFFER
JRST MAKCP0 ;SET IN A TIGHT LOOP
MAKCP2: PUSH P,S2 ;SAVE BYTE TO BE OUTPUT
CALL SETBYT ;RESET THE BYTE POINTER
MOVE S2,S1 ;S2/ BYTE POINTER
MOVE S1,J$OJFN(J) ;S1/ JFN OF OUTPUT FILE
MOVN T1,MAXBUF ;LARGEST POSSIBLE BUFFER
SOUT% ;OUTPUT THE BUFFER
CALL SETBUF ;RESET BUFFER VARIABLES
POP P,S2 ;RESTORE BYTE
JRST MAKCP1 ;REJOIN MAIN LOOP
MAKC.X: CALL SETBYT ;SET UP BYTE POINTER
MOVE S2,S1 ;S2/ BYTE POINTER
MOVE S1,J$OJFN(J) ;S1/ JFN OF OUTPUT FILE
MOVN T1,MAXBUF ;LARGEST POSSIBLE BUFFER
ADD T1,BUFCNT ;DISCOUNT REMAINING BYTES
SOUT% ;OUTPUT THE BUFFER
MOVE S1,J$OJFN(J) ;GET BACK OUTPUT JFN
CLOSF% ;CLOSE THE TEMPORARY FILE
$FATAL <CLOSF failed in MAKCPY> ;DIE HORRIBLY
$RETT ;RETURN GOOD
;SET UP BUFFER VARIABLES FOR MAKCPY
SETBUF: MOVE S1,MAXBUF ;GET MAXIMUM BUFFER SIZE
MOVEM S1,BUFCNT ;RESET BUFFER SIZE
SETBYT: MOVE S1,J$OBSZ(J) ;GET OUR BYTE SIZE
ROT S1,-^D12 ;GET S FIELD INTO PLACE
TLO S1,440000 ;SET P FIELD
HRRI S1,MAKBUF ;START OF BUFFER
MOVEM S1,BUFPTR ;STASH POINTER
$RETT ;RETURN
;ROUTINE CALLED TO OUTPUT FORMATTED BYTES
PUTCHR: MOVE S2,S1
MOVE S1,J$OJFN(J)
BOUT%
$RETT
;DELTMP - DELETE TEMPORARY FILE AFTER MAKIMP WAS RUN. SET UP .IMP FILENAME
IMPBUF: BLOCK 50 ;PUT .IMP FILENAME HERE IN FOB FORMAT
DELTMP: STKVAR <TMPJFN> ;DECLARE LOCAL STORAGE
MOVX S1,GJ%SHT!GJ%OLD
HRROI S2,IMPFIL+1
GTJFN% ;GET JFN ON .TMP FILENAME STRING
$RETF ;STRANGE FAILURE
MOVEM S1,TMPJFN ;SAVE JFN
;CREATE FOO.IMP FILESPEC
HRROI S1,IMPBUF+1
MOVE S2,TMPJFN
MOVX T1,1B8 ;OUTPUT FILENAME PORTION ONLY
JFNS% ;CREATE "DSK:FILNAME"
HRROI S2,[ASCIZ/.IMP.0/]
SETZB T1,T2
SOUT% ;CREATE "DSK:FILENAME.IMP.0"
IDPB T1,S1 ;TIE OFF STRING WITH A NULL
ADDI S1,2 ;ADVANCE WORD POINTER A BIT
SUBI S1,IMPBUF+1 ;COUNT NUMBER OF WORDS IN STRING
HRLZM S1,IMPBUF ;SET UP FOB FOR THE .IMP FILE
;NOW FLUSH THE TMP FILE WE FED TO MAKIMP
MOVE S1,TMPJFN
TXO S1,DF%EXP
DELF% ;EXPUNGE THE .TMP FILE
ERJMP DELTMX ;SOME ERROR
;IF AN ERC FILE EXISTS, MAKIMP FOUND ERRORS AND WE SHOULD ABORT EVERYTHING
MOVX S1,GJ%SHT!GJ%OLD ;WANT A FILE THAT EXISTS
HRROI S2,ERCFIL+1 ;POINTER TO FILENAME
GTJFN% ;GET A HANDLE ON IT
$RETT ;NO ERROR FILE, TAKE GOOD RETURN
MOVEM S1,TMPJFN ;SAVE A COPY OF JFN IN CASE THE DELDF% FAILS
TXO S1,DF%EXP
DELF% ;EXPUNGE THE .ERC FILE
ERJMP DELTMX ;SOME ERROR
MOVX S1,GJ%SHT!GJ%OLD
HRROI S2,IMPBUF+1
GTJFN% ;GET HANDLE ON THE .IMP FILE
$RETF ;HUH? STRANGE ERROR.
MOVEM S1,TMPJFN
TXO S1,DF%EXP
DELF% ;EXPUNGE THE .IMP FILE AS WELL
ERJMP DELTMX
$RETF ;TAKE ERROR RETURN AGAIN
;HERE ON AN ERROR WHILE DELETING A FILE. WE COMPLAIN AND RELEASE THE JFN
DELTMX: $CALL WARN ;NOT FATAL ERROR, JUST COMPLAIN
MOVE S1,TMPJFN ;GET BACK THAT JFN
RLJFN% ;RELEASE IT
ERCAL WARN ;COMPLAIN AGAIN
$RETF ;TAKE ERROR RETURN
;MAKREN - RENAME DSK:FOO.IMP TO BE PS:<SPOOL>FOO.TMP
;WE'VE JUST RUN MAKIMP ON PS:<SPOOL>FILE.TMP CREATING DSK:FILE.IMP.
;RENAME THE .IMP FILE INTO <SPOOL> AS THE NEW TEMPORARY FILE
MAKREN: STKVAR <RNIJFN,RNTJFN> ;DECLARE LOCAL STORAGE
MOVX S1,GJ%SHT!GJ%OLD
HRROI S2,IMPBUF+1
GTJFN% ;GET JFN ON THAT .IMP FILE
ERCAL MAKRNX
MOVEM S1,RNIJFN ;SAVE .IMP JFN
MOVX S1,GJ%FOU!GJ%SHT
HRROI S2,IMPFIL+1
GTJFN% ;GET A JFN ON THE .TMP FILE
ERCAL MAKRNX
MOVEM S1,RNTJFN
MOVE S1,RNIJFN ;EXISTING FILE
MOVE S2,RNTJFN ;NEW FILE
RNAMF% ;RENAME THE FILE
ERCAL MAKRNX ;SOME ERROR
MOVE S1,RNTJFN
RLJFN% ;FLUSH JFN ON THE .TMP FILE
ERCAL WARN
$RETT ;TAKE SUCCESS RETURN
MAKRNX: $CALL TIMSMP ;PRINT TIME STAMP
MOVE T2,0(P) ;GET PC OF LOSSAGE
$CALL LSTERR ;PRINT LAST ERROR
ADJSP P,-1 ;FIX UP STACK
SKIPE T1,RNIJFN
RLJFN% ;RELEASE .IMP JFN
ERCAL WARN
SKIPE T1,RNTJFN ;RELEASE .TMP JFN
RLJFN%
ERCAL WARN
$RETF ;TAKE FAILURE RETURN
;MAKRCP - CALL AFTER RUNNING MAKIMP.EXE TO COPY THE IMP FILE INTO A TEMPORARY
; FILE, ADDING A HEADER (MUST BE CALLED FOR A NEW CANON)
;THIS ROUTINE FIRST BUILDS AN FOB FOR THE IMP FILE PRODUCED BY RUNIMP.
;THE FD BLOCK WAS BUILT BY THE DELTMP ROUTINE. WE OPEN THE IMP FILE,
;SWAP THE IMP'S IFN FOR THE USER'S IFN, COPY THE IMP FILE INTO
;A TEMPORARY FILE, SWAP BACK THE IFNS, AND DELETE THE IMP FILE.
MAKRCP: STKVAR <TRUIFN,<IMPFOB,FOB.MZ>> ;DECLARE LOCAL STORAGE
MOVEI S1,FOB.MZ ;GET THE FOB SIZE
MOVEI S2,IMPFOB ;AND THE FOR ADDRESS
$CALL .ZCHNK ;ZERO IT OUT
MOVEI S1,IMPBUF ;GET ADDRESS OF FB
STORE S1,FOB.FD+IMPFOB ;SAVE IN THE FOB
MOVEI S1,^D8 ;AN IMP FILE IS ALWAYS 8-BIT
STORE S1,FOB.CW+IMPFOB,FB.BSZ ;SAVE THE BYTE SIZE
MOVEI S1,FOB.MZ ;SIZE OF FOB
MOVEI S2,IMPFOB ;ADDRESS OF FOB
$CALL F%IOPN ;OPEN IMP FILE FOR INPUT
JUMPF .RETF ;FAIL NOW IF CAN'T OPEN THE FILE
EXCH S1,J$DIFN(J) ;FAKE OUT OTHER LSRSPL ROUTINES
MOVEM S1,TRUIFN ;STASH TRUE IFN
$CALL INPBYT ;MAKIMP PRODUCES OLD-FORMAT IMP FILES
JUMPN S2,.-1 ;FLUSH "2<filename>"
MOVEI T1,^D8 ;WANT TO FLUSH 8 BYTES
$CALL INPBYT ;SNARF ONE
JUMPF MAKI.X ;EOF
SOJG T1,.-2 ;FLUSH "ImagImPr"
$CALL MAKHDR ;MAKE A HEADER
JUMPF MAKRCX ;SOME ERROR
$TEXT (PUTCHR,<,Language Impress^A>) ;ADD LANGUAGE SPECIFICATION
LOAD S1,.FPINF(E),FP.FFF ;GET FILE FORMAT (AKA /FILE:)
CAIE S1,.FPREV ;SHOULD WE REVERSE THE PAGES?
IFSKP.
$TEXT (PUTCHR,<,Pagereversal On)^A>) ;PUT REVERSAL IN DCL
ELSE.
$TEXT (PUTCHR,<)^A>) ;NO, JUST END DCL
ENDIF.
$CALL MAKCPY ;COPY INTO TEMPORARY FILE
JUMPF MAKRCX ;SOME ERROR
MOVE S1,J$DIFN(J) ;GET BACK IFN
$CALL F%REL ;RELEASE GALAXY STORAGE
MOVEI S1,FOB.MZ ;SIZE OF FOB
MOVEI S2,IMPFOB ;ADDRESS OF FOB
$CALL F%DEL ;DELETE THE IMP FILE
MOVE S1,TRUIFN ;GET BACK TRUE IFN
MOVEM S1,J$DIFN(J) ;RESTORE THE WORLD
$RETT ;GOOD RETURN TO CALLER
MAKRCX: MOVE S1,TRUIFN ;GET BACK TRUE IFN
MOVEM S1,J$DIFN(J) ;RESTORE THE WORLD
$RETF ;TAKE FAILURE RETURN TO CALLER
; CHKSIZ - LOOK AT FILE TO FIND ITS REAL BYTE SIZE
; RETURNS S1/ BYTE-SIZE
; RETURNS FALSE IF BAD PAGE OR BYTE ACCOUNT
CHKSIZ: STKVAR <SIZJFN>
MOVX S1,GJ%SHT+GJ%OLD
MOVE S2,J$DFDA(J) ;GET ADDRESS OF FD
MOVEI S2,.FDFIL(S2) ;GET ACTUAL ADDRESS OF FILENAME
HRROS S2 ;TURN INTO -1,,ADDR
GTJFN%
ERCAL CHKSZX
MOVEM S1,SIZJFN ;SAVE JFN
SIZEF% ;GET BYTE SIZE
ERCAL CHKSZX ;SOME ERROR
JUMPLE S2,CHKSZY ;PUNT IF BAD BYTE COUNT
JUMPLE T1,CHKSZY ;PUNT IF BAD PAGE COUNT
MOVE S1,SIZJFN
MOVE S2,[1,,.FBBYV] ;READ BYTE SIZE FROM FDB
MOVEI T1,T1 ;PUT IT IN T1 (NOTE THIS IS REALLY AC3, *NOT*
;AC1)
GTFDB%
ERCAL CHKSZX ;SOMETHING WENT WRONG
MOVE S1,SIZJFN
RLJFN% ;NOW FLUSH THE JFN
ERCAL CHKSZX
LOAD S1,T1,FB%BSZ ;GET BYTE SIZE INTO S1
$RETT
CHKSZX: $CALL TIMSMP ;PRINT TIMESTAMP
MOVE T2,0(P) ;GET ERRING PC
$CALL LSTERR
ADJSP P,-1
MOVX S1,7 ;JUST ASSUME 7-BIT FOR NOW
$RETF
CHKSZY: MOVE T1,SIZJFN ;GET BACK THE FILE JFN
RLJFN% ;RELEASE IT
ERCAL CHKSZX ;SOME ERROR
$RETF ;TAKE FAILURE RETURN
; LOOK AT FILE TO SEE IF IT STARTS WITH "@DOCUMENT(". IF SO, RETURN TRUE.
; CALL WITH S2/ FIRST BYTE OF FILE.
; IF TRUE, RETURN WITH FILE POINTER SCANNED PAST "("
CHKDOC: CAIE S2,"@"
JRST CHKD.X ;NOT NEW-FORMAT IMP EITHER
PUSH P,[POINT 7,T2] ;WELL, MAYBE...
MOVEI T1,5 ;GET NEXT 5 BYTES
SETZ T2, ;CLEAR RANDOM BITS
CHKD.1: PUSHJ P,INPBYT
JUMPF [POP P,(P) ;UNWIND STACK
$CALL INPREW
$RETF ] ;AND SAY IT DOESN'T START W/ HDR
ANDI S2,337 ;CONVERT TO UPPER CASE
IDPB S2,(P) ;BUILD A STRING OF 5 CHARS
SOJG T1,CHKD.1
POP P,T1
CAME T2,[ASCII/DOCUM/]
JRST CHKD.X ;NOT NEW-FORMAT IMP
CHKD.2: PUSHJ P,INPBYT ;NEW-FORMAT. SKIP "@DOCUMENT("
CAIE S2,"("
JRST CHKD.2 ;SCAN FOR "("
$RETT
CHKD.X: $RETF
;MAKHDR - BUILD A HEADER FOR THE NEW CANON LASERPRINTER
;
;THE FOLLOWING COMMENT REFERS TO TO VERSION 1.8 FIRMWARE. THE 1.9
; FIRMWARE IS MUCH MORE CIVILIZED, HOWEVER FOR COMPATIBILITY....
;
;IF YOU THINK THIS CODE LOOKS MESSY AND COMPLICATED AND THAT THE RESULT IS
;MODERATELY UGLY, YOU'RE RIGHT. IMPRINT-10 HEADER PAGES WERE NOT DESIGNED
;WITH CUSTOMER WRITTEN SOFTWARE IN MIND. THE FIRMWARE INSISTS ON PUTTING
;USER TEXT IN []'S UNLESS THE LINE IS LONGER THAN THE PAGE WIDTH. IT ALSO
;DOES NOT ALLOW TWO IDENTICAL LINES, HENCE THE RANDOM CHARS AT THE EXTREME
;RIGHT OF SOME OF THE LINES.
MAKHDR: TXNE S,OLDF ;OLD-STYLE IMPRINT-10?
$RETF ;YES, TAKE ERROR RETURN
$CALL MAKOPN ;OPEN THE COPY FILE
JUMPF .RETF ;SOME ERROR
$TEXT (PUTCHR,<@DOCUMENT(>)
$TEXT (PUTCHR,<"] ",>)
$TEXT (PUTCHR,<"] For: ^T/.EQOWN(J)/ ",>)
$TEXT (PUTCHR,<"] Jobname: ^W/.EQJOB(J)/ ",>)
$TEXT (PUTCHR,<"] Time: ^H/[-1]/ ",>)
$TEXT (PUTCHR,<"] ",>)
GETLIM T1,.EQLIM(J),NOT1 ;GET FIRST HALF OF NOTE STRING
JUMPE T1,MAKH.2 ;NO NOTE
GETLIM T2,.EQLIM(J),NOT2 ;GET SECOND HALF
$TEXT (PUTCHR,<"] Note: ^W6/T1/^W/T2/ ",>)
$TEXT (PUTCHR,<"] %",>)
MAKH.2: $TEXT (PUTCHR,<"] &",>)
$TEXT (PUTCHR,<"] *",>)
TXNN S,NOBANN ;WAS THE NO BANNER BIT LIT?
IFSKP.
$TEXT(PUTCHR,<JobHeader Off^A>) ;SUPPRESS THE HEADER PAGE
ELSE.
$TEXT(PUTCHR,<JobHeader On^A>) ;PRINT HEADER PAGE
ENDIF.
$RETT
;PRINT A HEADER PAGE INDICATING A BAD FILE
BADHDR: TXNE S,OLDF ;OLD-STYLE IMPRINT-10?
$RETF ;YES, DO NOTHING
$CALL MAKHDR ;PRINT THE INITIALIZATION
JUMPF .RETF ;MAKHDR FAILED, GO NO FURTHER
$TEXT (PUTCHR,<,Language Printer,ERROR)>)
MOVE T1,[POINT 7,LOGBUF] ;COPY THE LOG FILE
BADH.1: ILDB S1,T1
JUMPE S1,BADH.X
$CALL PUTCHR
JRST BADH.1
BADH.X: $CALL MAKC.X ;CLOSE THE FILE
HRROI S1,RSBUF
$CALL RUNIS ;SEND THE FILE
MOVX S1,GJ%SHT!GJ%OLD ;WANT A FILE THAT EXISTS
HRROI S2,IMPFIL+1 ;POINTER TO FILENAME
GTJFN% ;GET A HANDLE ON IT
$RETT ;NO ERROR FILE, TAKE GOOD RETURN
MOVE S2,S1 ;SAVE A COPY OF JFN IN S2
TXO S1,DF%EXP ;SET THE EXPUNGE BIT
DELF% ;EXPUNGE THE TEMPORARY FILE
ERJMP BADHX1 ;SOME ERROR
$RETT ;RETURN TO CALLER
;HERE IF THE EXPUNGE FAILS TO FLUSH THE JFN
BADHX1: MOVE S1,S2 ;GET BACK JFN
RLJFN% ;RELEASE IT
NOP ;IGNORE ANY ERROR
$RETT ;RETURN TO CALLER
;RUNIMP - RUN THE MAKIMP PROGRAM
;BECAUSE THE MAKIMP PROGRAM LEAVES JFNS AROUND OPEN FOR READ *AFTER* IT HAS
; SUCCESSFULLY RUN, WE MUST FLUSH THE MAKIMP FORK SO AS NOT TO RUN OUT OF
; JFNS AND OTHER TYPES OF LOSSAGE.
IMFRKH: BLOCK 1 ;FORK HANDLE FOR MAKIMP PROGRAM
MKRJFN: BLOCK 1 ;READ SIDE OF PIPE
MKWJFN: BLOCK 1 ;WRITE SIDE OF PIPE
RUNIMP: STKVAR <IMPRUN,MKFPTR> ;DECLARE LOCAL STORAGE
MOVEM S1,MKFPTR ;SAVE POINTER TO FILE NAME
SKIPE IMFRKH ;DO WE HAVE A MAKIMP FORK ALREADY?
JRST RUNIM0 ;YES, GO FOR IT
SETZM MKRJFN ;CLEAR JFN STORAGE
SETZM MKWJFN ; ...
MOVX S1,CR%CAP
CFORK% ;CREATE A FORK
ERCAL RUNIM1
HRRZM S1,IMFRKH ;SAVE FORK HANDLE
MOVX S1,GJ%OLD!GJ%SHT
HRROI S2,[ASCIZ/SYS:MAKIMP.EXE/]
GTJFN%
ERCAL RUNIM1 ;GTJFN% FAILED, GO FLUSH FORK
MOVEM S1,T2 ;SAVE JFN
HRL S1,IMFRKH
GET%
IFJER.
MOVE S1,T2
RLJFN% ;MAKE SURE THE JFN IS GONE
NOP
JRST RUNIM1 ;FLUSH FORK IF GET% FAILED
ENDIF.
CALL POPEN ;OPEN A PIPE
JUMPF RUNIM1 ;FLUSH FORK IF PIPE CAN'T BE CREATED
MOVEM S1,MKWJFN ;WRITE (INPUT) SIDE OF PIPE
MOVEM S2,MKRJFN ;READ (OUTPUT) SIDE OF PIPE
MOVE S1,IMFRKH ;PROCESS HANDLE
HRLZ S2,MKRJFN ;INPUT IS FROM THE PIPE
HRRI S2,.NULIO ;FLUSH THE OUTPUT
SPJFN% ;SET UP PRIMARY I/O FOR MAKIMP FORK
ERCAL RUNIM1 ;SOME FAILURE
;FALL THROUGH
;DROP IN
RUNIM0: MOVE S1,MKFPTR ;FILENAME TO GIVE TO MAKIMP
$CALL MAKARG ;BUILD A MAKIMP ARGUMENT LINE, S2/ PTR
MOVE S1,MKWJFN ;WRITE SIDE OF PIPE
SETZB T1,T2 ;END ON A NULL
SOUTR% ;SEND LINE TO OTHER SIDE
ERCAL RUNIM1 ;SOME ERROR
MOVE S1,IMFRKH ;GET FORK HANDLE
RUNTM% ;GET PRESENT RUNTIME
MOVNM S1,IMPRUN ;STORE NEGATIVE OF RUNTIME
MOVE S1,IMFRKH
SETZ S2, ;START FORK AT 1ST POSITION IN EV
SFRKV% ;RUN IT
PUSH P,S1 ;SAVE AC1
MOVE S1,MKWJFN ;WRITE SIDE OF PIPE
HRROI S2,[ASCIZ/X
/] ;IN CASE WE GET A SAIL ERROR FROM MAKIMP
SETZB T1,T2 ;END ON A NULL
SOUTR% ;STUFF OUR RESPONSE (QUIT) TO IT
ERCAL RUNIM1 ;SOME SCREWUP
POP P,S1 ;RESTORE FORK HANDLE
WFORK% ;TO TERMINATION
MOVE S1,IMFRKH ;GET FORK HANDLE
RUNTM% ;GET RUNTIME AFTER WE'VE RUN
ADDB S1,IMPRUN ;COMPUTE TOTAL RUNTIME TO CHARGE
ADDM S1,J$ART1(J) ;ADD TO RUNNING TOTAL
MOVE S1,IMFRKH ;GET FORK HANDLE
RFSTS% ;READ FORK STATUS
TXZ S1,RF%FRZ ;FLUSH FROZEN BIT
HLRZS S1 ;SWAP STATUS CODE AROUND
CAIE S1,.RFHLT ;NORMAL TERMINATION?
JRST RUNIM2 ;NO, TAKE ERROR RETURN
REPEAT 1,< ;;PUT THIS IN IF MAKIMP HASN'T BEEN FIXED TO FLUSH FILES.
$CALL RUNIMK ;FLUSH FORK
MOVEI S1,^D3000 ;THREE SECONDS
DISMS% ;WAIT FOR FORK TO FULLY VANISH
>;REPEAT 1
$RETT ;TAKE SUCCESS EXIT
;HERE IF WE GET AN ERROR SETTING UP THE MAKIMP FORK OR PIPES
RUNIM1: $CALL TIMSMP ;PRINT TIME STAMP
MOVE T2,0(P) ;GET PC OF LOSSAGE
$CALL LSTERR ;PRINT LAST ERROR AND PC
$CALL RUNIMK ;FLUSH FORK AND PIPE
ADJSP P,-1 ;TRIM STACK FOR PROPER RETURN
$RETF ;TAKE FAILURE RETURN
;HERE IF MAKIMP BOMBS FOR SOME REASON
RUNIM2: $CALL TIMSMP ;PRINT TIME STAMP
HRROI S1,[ASCIZ/MAKIMP terminated abnormally
/]
PSOUT% ;SAY WHAT HAPPENED
$CALL RUNIMK ;FLUSH THE MAKIMP SETUP
$RETF ;AND GIVE AN ERROR RETURN
;HERE TO FLUSH THE FORK AND ITS PIPES
RUNIMK: SKIPE S1,IMFRKH ;GET BACK FORK HANDLE
KFORK% ;FLUSH THE FORK
ERJMP .+1 ;DON'T DIE IF HANDLE IS BOGUS
SKIPE S1,MKRJFN
$CALL CLZJFN ;CLOSE READER'S SIDE FIRST
SKIPE S1,MKWJFN
$CALL CLZJFN ;CLOSE WRITER'S SIDE LAST
SETZM IMFRKH ;SAY NO FORK HANDLE
SETZM MKWJFN ;SAY NO JFN'S AS WELL
SETZM MKRJFN ; ...
$RETF ;TAKE ERROR RETURN
;MAKARG - BUILD AN ARGUMENT LINE FOR THE MAKIMP PROGRAM
;TAKES S1/ POINTER TO FILENAME
;RETURNS TRUE ALWAYS, S2/ POINTER TO ARGUMENT LINE
TMPBUF: BLOCK 30 ;STORAGE FOR MAKIMP COMMAND LINE
CRLF: ASCIZ/
/
;<CRLF> FILENAME /FONT:<FONT> PAGES:<PAGE>:<PAGE> SPACING:<SPACING><CRLF>
MAKARG: PUSH P,S1
MOVE S1,[POINT 7,TMPBUF] ;SET UP BYTE POINTER IN S1
HRROI S2,CRLF
$CALL CPYS1 ;START WITH A CRLF
POP P,S2
$CALL CPYS1 ;COPY FILENAME STRING
SKIPN .EQCST+1(J) ;WAS A FONT SPECIFIED?
JRST MAKAR0 ;NO, SEE IF SOMETHING ELSE IS WANTED
HRROI S2,[ASCIZ\ /font:\] ;LEADIN STRING
$CALL CPYS1 ;COPY THE STRING
MOVE T2,.EQCST+1(J) ;GET FIRST PART OF SIXBIT FONT NAME
$CALL SIXS1 ;WRITE IT OUT
MOVE T2,.EQCST+2(J) ;SET SECOND PART OF NAME
$CALL SIXS1 ;WRITE IT OUT
MAKAR0: LOAD S2,.FPFST(E) ;GET /BEGIN: PARAMETER.
JUMPE S2,MAKAR1 ;JUMP IF NONE
HRROI S2,[ASCIZ\ /pages:\]
$CALL CPYS1 ;START WITH PAGE PARAMETER
LOAD S2,.FPFST(E) ;GET THAT NUMBER AGAIN
$CALL NOUTS1 ;PRINT IT
LOAD T1,.FPFST(E) ;GET BACK FIRST PAGE
GETLIM T2,.EQLIM(J),OLIM ;GET PAGE LIMIT
ADDI T2,-1(T1) ;COMPUTE LAST PAGE
MOVEI S2,":"
IDPB S2,S1 ;PUT IN A SEPARATING COLON
MOVE S2,T2 ;GET LAST PAGE
$CALL NOUTS1 ;PRINT IT
MAKAR1: LOAD S2,.FPINF(E),FP.FSP ;GET THE SPACING CODE
JUMPE S2,MAKAR2 ;NONE SPECIFIED, FORGET IT
HRROI S2,[ASCIZ\ /spacing:\]
$CALL CPYS1 ;PRINT LEADIN CHARACTER
LOAD S2,.FPINF(E),FP.FSP ;GET THE SPACING CODE
$CALL NOUTS1 ;PRINT IT
MAKAR2: SKIPN J$DVIF(J) ;DVI FILE?
JRST MAKAR3 ;NO, DEFAULT IS TEXT (T:L)
HRROI S2,[ASCIZ\ /dvi\] ;FILE TYPE IS DVI
$CALL CPYS1 ;ADD IT
MAKAR3: HRROI S2,[ASCIZ/ /]
CALL CPYS1 ;ENSURE AT ONE CHAR AFTER FILENAME
SETZ S2, ;MAKE A NULL
IDPB S2,S1 ;TIE OFF STRING
MOVE S2,[POINT 7,TMPBUF] ;RETURN BYTE POINTER IN S1
$RETT ;RETURN TO CALLER
;SIXS1 - GIVEN SIXBIT IN T2, WRITE ASCII BYTES USING BYTE PTR S1
SIXS1: SETZ T1, ;CLEAR AC TO RECEIVE ASCII BYTE
LSHC T1,6 ;SHIFT SIX BITS FROM S2 INTO S1
ADDI T1,40 ;CONVERT TO ASCII
IDPB T1,S1 ;DEPOSIT IN CORRECT LOCATION
JUMPN T2,SIXS1 ;LOOP UNTIL DONE
$RETT ;RETURN TO CALLER
;CPYS1 - GIVEN STING/BYTE POINTER IN S2, COPY TO BYTE POINTER IN S1
CPYS1: TLC S2,-1 ;MAKE ASCII BYTE POINTER IF NEEDED
TLCN S2,-1 ; ...
HRLI S2,(POINT 7,) ; ...
CPYS11: ILDB T1,S2 ;LOAD BYTE
JUMPE T1,.RETT ;QUIT ON A NULL
IDPB T1,S1 ;DEPOSIT BYTE
JRST CPYS11 ;LOOP OVER STRING
;NOUTS1 - PRINT A NUMBER IN S2, GIVEN BYTE POINTER IN S1
NOUTS1: MOVEI T1,^D10 ;DECIMAL RADIX
NOUT% ;PRINT IT
JFCL ;IGNORE AN ERROR
$RETT ;RETURN GOOD
;POPEN - OPEN AN I/O PIPE (NEED STANFORD IMPLEMENTATION OF PIPES)
PIPSTR: BLOCK 10 ;TEMP BUFFER FOR BUILDING PIP: STRING
WRTJFN: BLOCK 1 ;JFN OF WRITE SIDE OF PIPE
REDJFN: BLOCK 1 ;JFN OF READ SIDE OF PIPE
POPEN: SETZM WRTJFN ;CLEAR JFN STORAGE
SETZM REDJFN ; ....
MOVX S1,GJ%SHT
HRROI S2,[ASCIZ/PIP:/]
GTJFN% ;CREATE AN INSTANCE OF A PIPE DEVICE
ERCAL POPENX
MOVEM S1,WRTJFN ;USE THAT JFN FOR THE WRITE SIDE
HRROI S1,PIPSTR
MOVE S2,WRTJFN
MOVE T1,[1B2!1B8!JS%PAF] ;OUTPUT DEVICE AND FILENAME W/PUNC
JFNS% ;BUILD A SECOND JFN
ERCAL POPENX
MOVEI T1,"."
IDPB T1,S1 ;TACK ON A "."
MOVE S2,WRTJFN
MOVX T1,1B8 ;OUTPUT FILENAME AGAIN, NO PUNC.
JFNS% ; ...
ERCAL POPENX
SETZ T1
IDPB T1,S1
MOVX S1,GJ%SHT
HRROI S2,PIPSTR
GTJFN% ;GET A JFN ON THE OTHER SIDE OF THE DEVICE
ERCAL POPENX
MOVEM S1,REDJFN ;USE THAT AS THE READ SIDE
MOVE S1,WRTJFN
MOVE S2,[FLD(7,OF%BSZ)!OF%WR]
OPENF% ;OPEN WRITE SIDE
ERCAL POPENX
MOVE S1,REDJFN
MOVE S2,[FLD(7,OF%BSZ)!OF%RD]
OPENF% ;OPEN READ SIDE
ERCAL POPENX
MOVE S1,WRTJFN ;GET JFNS INTO PLACE
MOVE S2,REDJFN ; ...
$RETT ;TAKE SUCCESS RETURN
;HERE ON AN ERROR TO FLUSH THE PIPE JFNS
POPENX: $CALL TIMSMP ;PRINT TIME STAMP
MOVE T2,0(P) ;GET PC OF LOSSAGE
$CALL LSTERR ;PRINT LAST ERROR
ADJSP P,-1 ;FIX UP STACK
SKIPE S1,REDJFN ;FLUSH READ SIDE FIRST
$CALL CLZJFN
SKIPE S1,WRTJFN ;THEN FLUSH WRITE SIDE
$CALL CLZJFN
$RETF ;TAKE FAILURE RETURN
;CLZJFN - FLUSH A JFN THAT MAY BE OPEN
CLZJFN: GTSTS% ;GET FILE STATUS
ERJMP .RETF ;JUST PUNT IF WE GET AN ERROR HERE
TXNE S2,GS%OPN ;IS IT OPEN?
IFSKP.
RLJFN% ;NO, JUST RELEASE JFN
NOP ;IGNORE AN ERROR
$RETT ;RETURN TO CALLER
ENDIF.
TXNE S2,GS%ERR ;OPEN, BUT IS THERE AN ERROR?
TXO S1,CZ%ABT ;YES, SET ABORT BIT
CLOSF% ;CLOSE THE JFN
NOP ;IGNORE AN ERROR
$RETT ;RETURN TO CALLER
;RUNIS: RUN THE IS PROGRAM
; CALL WITH S1/ POINTER TO IS COMMAND LINE
RUNIS: STKVAR <ISARGS,ISRNTM> ;DECLARE LOCAL STORAGE
MOVEM S1,ISARGS ;STASH BYTE POINTER
TXNE S,OFFLINE ;WAS THE OFFLINE FLAG LIT?
JRST RUNIS5 ;YES, SKIP THE SETUP CODE
TXZ S,ARGERR ;CLEAR ARGUMENT ERROR FLAG
SKIPE ISFRKH ;DO WE HAVE AN IS.EXE YET?
JRST RUNIS0 ;YES, SKIP FORK CREATION
MOVX S1,CR%CAP
CFORK% ;CREATE A FORK
ERCAL RUNIS1
HRRZM S1,ISFRKH ;SAVE FORK HANDLE
MOVX S1,GJ%OLD!GJ%SHT
HRROI S2,[ASCIZ/SYS:IS.EXE/] ;ASSUME USING A NEW IMPRINT-10
TXNE S,OLDF ;WELL?
HRROI S2,[ASCIZ/SYS:IS-OLD.EXE/] ;NO, USE OLD STYLE IS PROGRAM
GTJFN%
ERCAL RUNIS1 ;GTJFN% FAILED, GO FLUSH FORK
MOVEM S1,T2 ;SAVE JFN
HRL S1,ISFRKH
GET%
IFJER.
MOVE S1,T2
RLJFN% ;MAKE SURE THE JFN IS GONE
NOP
$CALL RUNIS1 ;FLUSH FORK IF GET% FAILED
ENDIF.
CALL POPEN ;OPEN A PIPE
JUMPF [$CALL RUNIS1] ;JUMP IF FAILURE
MOVEM S1,ISIJFN ;INPUT SIDE OF PIPE (WE WRITE)
MOVEM S2,ISOJFN ;OUTPUT SIDE OF PIPE (IS READS)
MOVE S1,ISFRKH ;GET FORK HANDLE
HRLZ S2,ISOJFN ;.PRIIN IS OUTPUT SIDE OF PIPE
HRRI S2,.NULIO ;.PRIOU IS NUL: DEVICE
SPJFN% ; ...
ERCAL RUNIS1 ;SOME ERROR, GO FLUSH THINGS
;FALL THROUGH TO NEXT PAGE
;HERE TO RUN THE IS PROGRAM TO COMPLETION (CONTINUED FROM ABOVE)
;WE DO RUNTIME AND PAGE ACCOUNTING AS WELL.
RUNIS0: MOVE S1,ISIJFN ;WRITE INTO PIPE
MOVE S2,ISARGS ;POINTER TO STRING
SETZB T1,T2 ;END ON A NULL
SOUTR% ;PUSH ARGUMENT STRING INTO IS'S .PRIIN
ERCAL RUNIS1 ;SOME ERROR
RUNIS5: MOVE S1,ISFRKH ;GET FORK HANDLE
RUNTM% ;GET PRESENT RUNTIME
MOVNM S1,ISRNTM ;REMEMBER NEGATIVE VALUE
MOVE S1,ISFRKH ;FORK HANDLE FOR IS.EXE
TXZE S,OFFLINE ;STARTING OR CONTINUING?
IFSKP.
SETZ S2, ;START FORK AT 1ST POSITION IN EV
SFRKV% ; ..
ELSE.
TXO S1,SF%CON ;CONTINUING, SET MAGIC BIT
SFORK% ;CONTINUE THE PROGRAM
ENDIF.
WFORK% ;TO TERMINATION
MOVE S1,ISFRKH ;GET IS FORK HANDLE
RUNTM% ;GET RUNTIME AFTER PROGRAM HAS RUN
ADDB S1,ISRNTM ;COMPUTE DELTA RUNTIME
ADDM S1,J$ART1(J) ;ADD TO RUNNING TOTAL OF INFERIOR'S RT
MOVE S1,ISFRKH ;GET FORK HANDLE FOR IS.EXE
MOVEI S2,FRKACS ;PUT AC'S HERE
RFACS% ;READ FORK AC'S INTO BUFFER
DMOVE S1,FRKACS+1 ;GET AC1 AND AC2
CAMN S1,[-1] ;PERFORM VALIDITY CHECK
CAME S2,[-1] ; ...
JRST RUNIS2 ;CALL IT A HARD ERROR FROM IS
SKIPE FRKACS+0 ;CHECK STATUS OF PROGRAM
JRST RUNIS4 ;ABNORMAL SHUTDOWN
SKIPGE T1,FRKACS+3 ;GET PAGE COUNT RETURNED BY IS
SETZ T1, ;A SLIGHT SANITY CHECK
ADDM T1,J$APRT(J) ;INCREMENT TOTAL PAGE COUNT
$RETT ;RETURN TO CALLER
;HERE ON AN ABNORMAL TERMINATION, I.E., AC0 IS NON-ZERO
;AC0 IS -1 IF WE NEED TO RESTART, +1 IF WE SHOULD CONTINUE THE PROGRAM.
RUNIS4: SKIPG FRKACS+0 ;GET IS ERROR STATUS
JRST RUNIS2 ;HARD ERROR FROM IS
TXO S,OFFLINE ;CANON IS OFFLINE (SOFT ERROR)
$RETF ;TAKE FAILURE RETURN
;HERE WHEN WE HAD A HARD ERROR USING IS.EXE
RUNIS2: TXO S,ARGERR ;SAY BAD ARGUMENT TO IS.EXE
$CALL TIMSMP ;TIME STAMP
HRROI S1,[ASCIZ/IS error on Imagen unit /] ;SAY WHAT
PSOUT%
MOVEI S1,.PRIOU
MOVE S2,JOBOBJ+OBJ.UN
MOVEI T1,^D8
NOUT% ;PRINT UNIT NUMBER
JFCL
HRROI S1,[ASCIZ/
/]
PSOUT% ;FINISH OFF LINE
JRST RUNIS3 ;GO FLUSH FORK AND PIPES JUST IN CASE
;HERE WHEN WE HAD AN ERROR CREATING THE IS.EXE FORK
RUNIS1: $CALL TIMSMP ;TIME STAMP
MOVE T2,0(P) ;PC OF ERROR
$CALL LSTERR ;PRINT LAST ERROR
ADJSP P,-1 ;ADJUST STACK
RUNIS3: MOVE S1,ISFRKH ;GET BACK FORK HANDLE
KFORK% ;FLUSH THE FORK
ERJMP .+1 ;DON'T DIE IF HANDLE IS BOGUS
SKIPE S1,ISOJFN ;CLOSE READ SIDE OF PIPE
CALL CLZJFN ; ...
SKIPE S1,ISIJFN ;CLOSE WRITE SIDE OF PIPE
CALL CLZJFN ; ...
SETZM ISFRKH ;SAY WE HAVE NO IS.EXE FORK
SETZM ISIJFN ;NO PIPE JFN'S
SETZM ISOJFN ; ...
$RETF ;TAKE ERROR RETURN
SUBTTL ENDJOB - END OF JOB PROCESSOR.
ENDJOB:
PUSHJ P,CHKPNT ;SEND A CHECKPOINT
TXNN S,OLDF ;UNLESS AN OLD-STYLE CANON
AOS J$APRT(J) ;WE CHARGE FOR THE HEADER PAGE
MOVX S1,.FHSLF ;LOAD FORK HANDLE
RUNTM ;GET RUNTIME
ADD S1,J$ARTM(J) ;GET CPU TIME USED
IDIVI S1,^D1000 ;CONVERT TO SECONDS
ENDREQ: PUSHJ P,QRELEASE ;GO SEND THE RELEASE/REQUEUE MSG.
SETZM J$RACS+S(J) ;CLEAR ALL THE STATUS BITS.
SETZM JOBACT ;NOT BUSY
JRST MAIN.3 ;RETURN TO THE SCHEDULER.
SUBTTL QRELEASE - ROUTINE TO SEND A REQUEUE/RELEASE MSG TO QUASAR.
QRELEA: $WTOJ (End,<^R/.EQJBB(J)/>,@JOBOBA) ;TELL THE OPERATOR.
$LOG (Printed ^D/J$APRT(J)/ Pages,,@JOBOBA) ;LOG # OF PAGES
MOVEI S1,MSBSIZ ;GET BLOCK LENGTH
MOVEI S2,MSGBLK ;AND THE ADDRESS
PUSHJ P,.ZCHNK ;ZERO THE BLOCK
TXNE S,RQB ;IS THIS A REQUEUE?
JRST RELE.1 ;YES
PUSHJ P,FILDIS ;GO CLEAN UP THE SPOOL FILES.
PUSHJ P,ACTEND ;GO DO THE ACCOUNTING
MOVEI T1,MSGBLK ;GET ADDRESS OF THE BLOCK
LOAD S1,.EQITN(J) ;GET THE ITN
STORE S1,REL.IT(T1) ;STORE IT
MOVX S1,REL.SZ ;GET RELEASE MESSAGE SIZE
MOVX S2,.QOREL ;AND FUNCTION
JRST RELE.2 ;AND MEET AT THE PASS
RELE.1: 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
MOVX S1,CKFREQ ;GET REQEUE BIT
STORE S1,REQ.IN+CKFLG(T1) ;STORE IT
MOVX S1,RQ.HBO ;GET HOLD BY OPERATOR
STORE S1,REQ.FL(T1) ;STORE IN FLAG WORD
MOVX S1,REQ.SZ ;GET SIZE
MOVX S2,.QOREQ ;AND FUNCTION
RELE.2: STORE S1,.MSTYP(T1),MS.CNT ;STORE SIZE
STORE S2,.MSTYP(T1),MS.TYP ;AND CODE
PUSHJ P,SNDQSR ;SEND IT TO QUASAR
$RETT ;AND RETURN.
SUBTTL CHKQUE - ROUTINE TO RECIEVE AND SCHEDULE IPCF MESSAGES
CHKQUE: SETZM MESSAG ;NO MESSAGE YET
PUSHJ P,C%RECV ;RECEIVE A MESSAGE
JUMPF .POPJ ;RETURN, NOTHING THERE
SETZM BLKADR ;CLEAR THE IPCF MSG BLK ADDR SAVE AREA
LOAD S2,MDB.SI(S1) ;GET SPECIAL INDEX WORD
TXNN S2,SI.FLG ;IS THERE AN INDEX THERE?
JRST CHKQ.1 ;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?
JRST CHKQ.2 ;YES, CONTINUE ON
CHKQ.1: PUSHJ P,C%REL ;RELEASE THE MESSAGE
POPJ P, ;RETURN TO THE SCHEDULER.
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
PJRST C%REL ;NO MATCHES, 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.1 ;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
PUSHJ P,C%REL ;RELEASE THE MESSAGE
POPJ P, ;RETURN TO THE SCHEDULER.
MSGTAB: XWD KILL,.QOABO ;ABORT MESSAGE
XWD CHKPNT,.QORCK ;REQUEST-FOR-CHECKPOINT
XWD NXTJOB,.QONEX ;NEXTJOB
XWD SETUP,.QOSUP ;SETUP/SHUTDOWN
XWD OACCON,.OMCON ;OPERATOR CONTINUE REQUEST.
XWD OACRSP,.OMRSP ;OPERATOR WTOR RESPONSE.
XWD OACREQ,.OMREQ ;OPERATOR REQUEUE REQUEST.
XWD OACCAN,.OMCAN ;OPERATOR CANCEL REQUEST.
XWD OACPAU,.OMPAU ;OPERATOR PAUSE/STOP REQUEST.
XWD OACFWS,.OMFWS ;OPERATOR FORWARD SPACE REQUEST.
XWD OACBKS,.OMBKS ;OPERATOR BACKSPACE REQUEST.
NMSGT==.-MSGTAB
SUBTTL - CHKOBJ - ROUTINE TO VALIDATE QUASAR/ORION/OPR MSG OBJ BLKS.
;CALL: S1/OFFSET INTO MSGTAB
; S2/MESSAGE TYPE
CHKOBJ: CAIE S2,.OMRSP ;IS THIS AN OPERATOR RESPONSE?
CAIN S2,.QOSUP ;IS THIS A SETUP/SHUTDOWN MESSAGE?
$RETT ;YES, JUST RETURN NOW
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 GETBLK - ROUTINE TO BREAK DOWN AN IPCF MSG INTO ITS DATA BLOCKS
;CALL: M/ MESSAGE ADDRESS
;
;RET: T1/ BLOCK TYPE
; T2/ BLOCK LENGTH
; T3/ BLOCK DATA ADDRESS
GETBLK: SOSGE .OARGC(M) ;SUBTRACT 1 FROM THE BLOCK COUNT
$RETF ;NO MORE,,RETURN
SKIPN S1,BLKADR ;GET THE PREVIOUS BLOCK ADDRESS
MOVEI S1,.OHDRS+ARG.HD(M) ;NONE THERE,,GET FIRST BLOCK ADDRESS
LOAD T1,ARG.HD(S1),AR.TYP ;GET THE BLOCK TYPE
LOAD T2,ARG.HD(S1),AR.LEN ;GET THE BLOCK LENGTH
MOVEI T3,ARG.DA(S1) ;GET THE BLOCK DATA ADDRESS
ADD S1,T2 ;POINT TO THE NEXT MESSAGE BLOCK
MOVEM S1,BLKADR ;SAVE IT FOR THE NEXT CALL
$RETT ;RETURN TO THE CALLER
SUBTTL User CANCEL Request
KILL: TXNE S,ABORT ;CHECK SOME BITS
$RETT ;IF WE LEAVING, IGNORE IT
MOVX S2,PSF%OR ;GET OPR RESP WAIT BIT
TDNE S2,JOBSTW ;ARE WE WAITING FOR THE OPERATOR?
$KWTOR (JOBWAC) ;YES, KILL THE WTOR
ANDCAM S2,JOBSTW ;ZAP THE OPR WAIT BIT
$WTOJ (<Canceled by User ^U/ABO.ID(M)/>,<^R/.EQJBB(J)/>,@JOBOBA)
TXO S,ABORT ;LITE THE ABORT BIT
PUSHJ P,INPFEF ;FORCE END OF FILE
$RETT ;RETURN
SUBTTL Request for Checkpoint
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
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,XPTR ;SAVE IT
$TEXT (TEXTX,<Started at ^C/J$RTIM(J)/, printing^0>)
HRRZ S1,XPTR ;GET THE ENDING ADDRESS
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 UPDTST - ROUTINE TO SEND STATUS UPDATES TO QUASAR
UPDTST: PUSHJ P,.SAVE1 ;SAVE P1
MOVE S2,JOBSTW ;GET THE JOBS STATUS WORD
SETZM JOBCHK ;CLEAR THE UPDATE FLAG
MOVX P1,%RESET ;DEFAULT TO RESET
TXNE S2,PSF%OR ;ARE WE WAITING FOR OPR RESPONSE?
MOVX P1,%OREWT ;YES, SAY SO
TXNE S2,PSF%ST ;ARE WE STOPPED?
MOVX P1,%STOPD ;YES, SAY SO
TXNE S2,PSF%DO ;ARE WE OFFLINE?
MOVX P1,%OFLNE ;YES, SAY SO
MOVEI T1,MSGBLK ;GET THE MESSAGE BLOCK ADDRESS
MOVEM P1,STU.CD(T1) ;SAVE THE STATUS
HRLZ P1,JOBOBA ;GET THE OBJECT BLOCK ADDRESS
HRRI P1,STU.RB(T1) ;GET DESTINATION ADDRESS
BLT P1,STU.RB+OBJ.SZ-1(T1) ;COPY THE OBJ BLK OVER TO THE MSG
MOVX S1,STU.SZ ;GET THE MESSAGE LENGTH
STORE S1,.MSTYP(T1),MS.CNT ;SAVE IT
MOVX S1,.QOSTU ;GET THE MESSAGE TYPE
STORE S1,.MSTYP(T1),MS.TYP ;SAVE IT
PUSHJ P,SNDQSR ;SEND IT OFF THE QUASAR
$RETT ;AND RETURN
SUBTTL SETUP/SHUTDOWN Message
SETUP: LOAD S1,SUP.FL(M) ;GET THE FLAGS
TXNE S1,SUFSHT ;IS IT A SHUTDOWN?
JRST SHUTDN ;YES, GO SHUT IT DOWN
SETU.1: SKIPN JOBPAG ;A FREE STREAM?
JRST SETU.2 ;YES
$STOP(TMS,Too many setups) ;OOPS
SETU.2: MOVEI S1,J$$END ;GET THE LPT DATA BASE LENGTH
ADDI S1,PAGSIZ-1 ;ROUND UP TO NEXT HIGHEST PAGE
IDIVI S1,PAGSIZ ;GET NUMBER OF PAGES IN S1
PUSHJ P,M%AQNP ;ALLOCATE THEM
PG2ADR S1 ;CONVERT TO AN ADDRESS
MOVEM S1,JOBPAG ;AND SAVE IT
MOVE J,S1 ;PUT IT IN J
SETZM JOBSTW ;CLEAR THE JOB STATUS WORD
MOVEM J,J$RACS+J(J) ;SAVE J AWAY
MOVEI T2,JOBOBJ ;GET TE OBJECT ADDRESS
MOVEM T2,JOBOBA ;STORE OBJECT ADDRESS
MOVE S2,T2 ;GET DESTINATION OF BLT INTO S2
HRLI S2,SUP.TY(M) ;MAKE A BLT POINTER
BLT S2,OBJ.SZ-1(T2) ;BLT THE OBJECT BLOCK
MOVE S1,SUP.ST(M) ;GET SIXBIT DEVICE NAME
MOVEM S1,J$DEV(J) ;SAVE THE DEVICE NAME
PUSHJ P,OUTGET ;GET THE OUTPUT DEVICE
PUSH P,S1 ;SAVE THE RESPONSE CODE
PUSHJ P,RSETUP ;SEND THE RESPONSE TO SETUP
POP P,T2 ;GET THE RESPONSE CODE BACK
AOS S2,STRSEQ ;ADD 1 TO THE STREAM SEQ #, PUT IN S2.
MOVEM S2,JOBWAC ;SAVE IT AS THE OPR WTOR ACK CODE.
$WTO (<^T/@SETMSG(T2)/>,,@JOBOBA) ;TELL THE OPR WHATS GOING ON.
SKIPE J$DEV(J) ;WAS A DEVICE SPECIFIED?
CAIE T2,%RSUOK ;ALL IS OK?
JRST SHUTDN ;NO, SHUT IT DOWN
$RETT ;RETURN
SUBTTL SHUTDN - ROUTINE TO SHUT DOWN THE 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
PUSHJ P,OUTREL ;RELEASE THE OBJECT
MOVE S1,J$DIFN(J) ;GET THE SPOOL FILE IFN
TXZE S,DSKOPN ;IS THERE A FILE OPEN?
PUSHJ P,F%REL ;YES, CLOSE IT
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
PUSHJ P,M%CLNC ;GET RID OF UNWANTED PAGES.
SETOM JOBITS ;SAY WE DONT WANT TO SAVE STATUS BITS.
SETZM JOBPAG ;CLEAR THE PAGE WORD
SETZM JOBACT ;AND THE ACTIVE WORD
JUMPE T4,.RETT ;'OUT OF STREAM',,JUST RETURN
JRST MAIN.3 ;'IN STREAM',,RETURN TO THE SCHEDULER
SUBTTL RSETUP - ROUTINE TO SEND A RESPONSE-TO-SETUP MSG 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
MOVS S1,JOBOBA ;GET OBJADR,,0
HRRI S1,RSU.TY(T1) ;AND PLACE TO MOVE IT TO
BLT S1,RSU.TY+OBJ.SZ-1(T1) ;AND MOVE THE OBJECT BLOCK
STORE T2,RSU.CO(T1) ;STORE THE RESPONSE CODE
MOVX S1,OBDLLC ;GET LOWER-CASE BIT
STORE S1,RSU.DA(T1) ;STORE THE DEVICE ATRRIBUTES
PUSHJ P,SNDQSR ;AND SEND THE MESSAGE
$RETT ;RETURN.
SUBTTL OACRSP - OPERATOR RESPONSE TO A WTOR PROCESSOR.
OACRSP: MOVE S2,.MSCOD(M) ;GET WTOR ACK CODE.
RESP.1: CAME S2,JOBWAC ;COMPARE ACK CODES..
$RETT ;NOT THERE, FLUSH THE MESSAGE
MOVX S2,PSF%OR ;GET "OPERATOR-RESPONSE" WAIT BIT
ANDCAM S2,JOBSTW ;AND CLEAR IT
SETOM JOBCHK ;CHECKPOINT NEXT SCHEDULING PASS
MOVE J,JOBPAG ;GET THE STREAM DB ADDRESS.
MOVE S,J$RACS+S(J) ;GET THE STREAM STATUS BITS.
DMOVE S1,.OHDRS+ARG.DA(M) ;GET THE OPERATORS RESPONSE.
DMOVEM S1,J$RESP(J) ;AND SAVE IT.
$RETT ;AND RETURN
SUBTTL OACCAN - Operator CANCEL request.
OACCAN: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
$ACK (Aborting,<^R/.EQJBB(J)/>,@JOBOBA,.MSCOD(M)) ;TELL THE OPR.
MOVX S1,PSF%OR ;GET OPR RESP WAIT BIT
TDNE S1,JOBSTW ;ARE WE WAITING FOR THE OPERATOR?
$KWTOR (JOBWAC) ;YES, KILL THE WTOR
ANDCAM S1,JOBSTW ;ZAP THE OPR WAIT BIT
OACC.0: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF OACC.2 ;NO MORE, FINISH UP
CAIE T1,.CANTY ;IS THIS THE CANCEL TYPE BLOCK?
JRST OACC.0 ;NO, SKIP IT AND GET NEXT BLOCK
MOVE S1,0(T3) ;LOAD THE CANCEL TYPE
CAIE S1,.CNPRG ;IS IT /PURGE?
JRST OACC.0 ;NO, PROCESS THE NEXT MSG BLK
MOVE S1,J$DIFN(J) ;GET THE FILE IFN
TXZE S,DSKOPN ;DONT CLOSE IF ITS NOT OPEN
PUSHJ P,F%REL ;CLOSE IT OUT
MOVEM S,J$RACS+S(J) ;SAVE THE 'S' AC WITH NEW DSKOPN BITS
JUMPF SHUTND ;CANT, SHUT IT DOWN
SETZM JOBACT ;STREAM IS NO LONGER ACTIVE
PUSHJ P,QRELEASE ;RELEASE THE REQUEST
$RETT ;AND RETURN
OACC.2: TXO S,ABORT ;SAY WE ARE LEAVING.
PUSHJ P,INPFEF ;FORCE SPOOL FILE EOF
$RETT ;YES, JUST RETURN
JUMPF SHUTND ;CANT, SHUT IT DOWN
$RETT ;RETURN
SUBTTL OACPAU - Operator PAUSE request.
OACPAU: MOVX S2,PSF%ST ;LOAD THE STOP BIT
IORM S2,JOBSTW ;SET IT
$ACK (Stopped,,@JOBOBA,.MSCOD(M)) ;TELL THE OPERATOR.
SETOM JOBCHK ;SAY WE WANT A CHECKPOINT TAKEN.
$RETT ;AND RETURN
SUBTTL OACCON - Operator CONTINUE request.
OACCON: MOVX S2,PSF%ST ;LOAD THE BITS
ANDCAM S2,JOBSTW ;CLEAR IT
$ACK (Continued,,@JOBOBA,.MSCOD(M)) ;TELL THE OPERATOR.
SETOM JOBCHK ;SAY WE WANT TO TAKE A CHECKPOINT.
$RETT ;AND RETURN
SUBTTL OACREQ - Operator REQUEUE request.
OACREQ: PUSHJ P,INPFEF ;FORCE AN INPUT EOF
TXO S,RQB+ABORT ;LITE THE REQUEUE+ABORT BITS
$ACK (Requeued,<^R/.EQJBB(J)/>,@JOBOBA,.MSCOD(M)) ;TELL OPR
MOVX S2,PSF%OR ;GET OPR RESP WAIT BIT
TDNE S2,JOBSTW ;ARE WE WAITING FOR THE OPERATOR?
$KWTOR (JOBWAC) ;YES, KILL THE WTOR
ANDCAM S2,JOBSTW ;ZAP THE OPR WAIT BIT
OACR.0: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF .RETT ;NO MORE, RETURN
CAIN T1,.REQTY ;IS THIS THE REQUEST TYPE BLOCK?
JRST OACR.1 ;YES, GO PROGESS IT
CAIN T1,.ORREA ;IS THIS THE REASON BLOCK?
JRST OACR.0 ;PROCESS THE NEXT MSG BLOCK
OACR.1: MOVE S1,0(T3) ;PICK UP THE REQUEUE CODE.
SETZ S2, ;ZERO AC 2
CAXN S1,.RQCUR ;/CURRENT?
JRST OACR.3 ;YES, SAME AS BEGINNING OF COPY
CAXN S1,.RQBCP ;BEGINNING OF COPY?
JRST S2,OACR.0 ;YES
SETZM J$RNCP(J) ;CLEAR CURRENT COPY NUMBER
CAXN S1,.RQBFL ;FROM BEGINING OF FILE?
JRST S2,OACR.0 ;YES
SETZM J$RNFP(J) ;CLEAR FILE COUNT
JRST OACR.0 ;GO PROCESS THE NEXT MSG BLOCK.
OACR.3: MOVNI S1,2 ;LOAD -2
ADDM S1,J$APRT(J) ;HERE ALSO
SKIPGE J$APRT(J) ;CHECK HERE ALSO
SETZM J$APRT(J) ;NO GOOD,,SET IT TO ZERO
JRST OACR.0 ;GO PROCESS THE NEXT MSG BLOCK
SUBTTL TOOBAD - RESPOND TO THE OPERATOR IF HIS REQUEST IS TOO LATE.
TOOBAD: $ACK (Print Request Completed,<^R/.EQJBB(J)/>,@JOBOBA,.MSCOD(M))
$RETT
SUBTTL OACFWS - OPERATOR FORWARD SPACE COMMAND PROCESSOR.
OACFWS: TXNE S,ABORT+RQB ;ARE WE ON OUR WAY OUT?
PJRST TOOBAD ;YES, SKIP THIS
SETOM JOBCHK ;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
CAIN T1,.SPCPY ;IS THIS FORWARD SPACE COPIES?
PJRST FCOPYS ;YES
CAIN T1,.SPFIL ;IS THIS FORWARD SPACE 1 FILE?
PJRST FFILES ;YES
JRST OACF.0 ;NONE OF THESE, TRY NEXT BLOCK
FSPACE: $ACK (<Forward Space Pages is not supported>,,@JOBOBA,.MSCOD(M))
$RETT ;RETURN
FCOPYS: MOVE S2,0(T3) ;PICK UP THE # OF COPIES TO FSPACE.
ADDM S2,J$RNCP(J) ;ADD TO # OF COPIES ALREADY PRINTED.
$ACK (<Forward Spaced ^D/S2/ Copies>,,@JOBOBA,.MSCOD(M))
PUSHJ P,INPFEF ;FORCE AN END-OF-FILE.
$RETT ;AND RETURN
FFILES: $ACK (Forward Spaced 1 File,,@JOBOBA,.MSCOD(M))
PUSHJ P,INPFEF ;FORCE AN END OF FILE
TXO S,SKPFIL ;TURN ON SKIP FILE FLAG
$RETT ;AND RETURN
SUBTTL - BACK SPACE operator action routine.
OACBKS: TXNE S,ABORT+RQB ;ARE WE ON OUR WAY OUT?
PJRST TOOBAD ;YES, SKIP THIS
SETOM JOBCHK ;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 ;BACKSPACE PAGES?
PJRST BSPACE ;YES
CAIN T1,.SPCPY ;BACKSPACE COPIES?
PJRST BCOPYS ;YES
CAIN T1,.SPFIL ;BACKSPACE FILES?
PJRST BFILES ;YES
JRST OACB.0 ;NONE OF THESE, TRY NEXT BLOCK
BSPACE: $ACK (<Backspace Pages is not supported >,,@JOBOBA,.MSCOD(M))
$RETT ;JUST RETURN.
SUBTTL BACKSPACE 'COPIES' AND 'FILES'
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
$ACK (<Backspaced ^D/T1/ Copies>,,@JOBOBA,.MSCOD(M))
PUSHJ P,INPFEF ;FORCE END OF FILE
$RETT ;RETURN
BFILES: PUSHJ P,INPFEF ;FORCE AN END-OF-FILE
SOS J$RNCP(J) ;ADD 1 COPY TO THE FILE COPY COUNT
$ACK (<Backspaced Current File>,,@JOBOBA,.MSCOD(M))
$RETT
SUBTTL FNDOBJ - ROUTINE TO FIND THE OBJ BLK IN THE DATA BASE.
FNDOBJ: MOVE T1,.ROBTY(S1) ;GET OBJECT TYPE
MOVE T2,.ROBAT(S1) ;GET UNIT NUMBER
MOVE T3,.ROBND(S1) ;AND NODE NUMBER
FNDO.1: CAMN T1,JOBOBJ+OBJ.TY ;COMPARE OBJECT TYPES
CAME T2,JOBOBJ+OBJ.UN ;COMPARE UNIT NUMBERS
JRST FNDO.2 ;NOPE
CAMN T3,JOBOBJ+OBJ.ND ;COMPARE NODES
JRST FNDO.3 ;WIN, SETUP THE CONTEXT
FNDO.2: $RETF ;OBJECT NOT THERE
FNDO.3: SKIPN J,JOBPAG ;GET ADDRESS OF DATA
$RETF ;NOT REALLY SETUP YET
MOVE S,J$RACS+S(J) ;GET THE S
$RETT ;RETURN
SUBTTL SNDQSR - ROUTINE TO 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 SYSTEM ACCOUNTING ROUTINES
ACTBEG: MOVX S1,.FHSLF ;GET FORK HANDLE
RUNTM ;GET MY RUNTIME
MOVNM S1,J$ARTM(J) ;REMEMBER IT NEGATED
SETZM J$ART1(J) ;RUNTIME OF ANY INFERIOR PROCESSES
LOAD S1,.EQSEQ(J),EQ.SEQ ;GET SEQUENCE NUMBER
STORE S1,J$ASEQ(J) ;STORE IT
LOAD S1,.EQSEQ(J),EQ.PRI ;GET EXTERNAL PRIORITY
STORE S1,J$APRI(J) ;STORE IT
$RETT ;RETURN
ACTEND: MOVX S1,.FHSLF ;LOAD FORK HANDLE
RUNTM ;GET RUNTIME
ADD S1,J$ART1(J) ;ADD RUNTIME OF INFERIOR PROCESSES
ADDM S1,J$ARTM(J) ;STORE IT
MOVEI S2,400000 ;GET 1B18 READY
TXNN S,ACCTF ;ARE WE CHARGING FOR THESE PAGES
IORM S2,J$APRT(J) ;NO, SET 1B18 AS A FLAG
SKIPE DEBUGW ;ARE WE DEBUGGING?
$RETT ;YES,,RETURN NOW.
LOAD S1,.EQSEQ(J),EQ.IAS ;GET THE INVALID ACCT STRING BIT
JUMPN S1,.RETT ;IF LIT,,THEN JUST RETURN
MOVX S1,.USENT ;WRITE AN ENTRY
MOVEI S2,ACTLST ;POINT TO THE LIST
USAGE ;DO THE JSYS
ERJMP ACTE.1 ;ON AN ERROR,,TELL THE OPERATOR
$RETT ;ELSE RETURN
ACTE.1: $WTO (System Accounting Failure,<^R/.EQJBB(J)/>,@JOBOBA)
$RETT ;RETURN
;ACCOUNT PARAMETER BLOCK DEFINED ON THE NEXT PAGE
ACTLST: USENT. (.UTOUT,1,1)
USJNO. (-1) ;JOB NUMBER
USTAD. (-1) ;CURRENT DATE/TIME
USTRM. (-1) ;TERMINAL DESIGNATOR
USLNO. (-1) ;TTY LINE NUMBER
USPNM. (<SIXBIT/LSRSPL/>,US%IMM) ;PROGRAM NAME
USPVR. (%LSR,US%IMM) ;PROGRAM VERSION
USAMV. (-1) ;ACCOUNTING MODULE VERSION
USNOD. (-1) ;NODE NAME
USACT. (<POINT 7,.EQACT(J) ;ACCOUNT STRING POINTER>)
USSRT. (J$ARTM(J)) ;RUN TIME
USSDR. (0,US%IMM) ;DISK READS
USSDW. (0,US%IMM) ;DISK WRITES
USJNM. (.EQJOB(J)) ;JOB NAME
USQNM. (<SIXBIT /LSR/>,US%IMM) ;QUEUE NAME
USSDV. (J$DEV(J)) ;DEVICE NAME
USSSN. (J$ASEQ(J)) ;JOB SEQUENCE NUMBER
USSUN. (J$APRT(J)) ;TOTAL PAGES PRINTED
USSNF. (J$AFXC(J)) ;TOTAL FILES PROCESSED
USCRT. (.EQAFT(J)) ;CREATION DATE/TIME OF REQUEST
USSCD. (J$RTIM(J)) ;SCHEDULED DATE/TIME
USFRM. (J$FORM(J)) ;FORMS TYPE
USDSP. (<SIXBIT/NORMAL/>,US%IMM) ;DISPOSITION
USTXT. (<-1,,[ASCIZ / /]>) ;SYSTEM TEXT
USPRI. (J$APRI(J)) ;JOB PRIORITY
USNM2. (<POINT 7,.EQOWN(J)>) ;USER NAME
0 ;END OF LIST
SUBTTL INPOPN -- Routine to open the input file
;INPOPN IS CALLED WITH AC "E" POINTING TO THE FP AREA FOR THE FILE
; TO BE OPENED.
INPOPN: PUSH P,S1 ;SAVE BYTE SIZE (NORMALLY 8)
MOVEI S1,FOB.SZ ;GET THE FOB SIZE
MOVEI S2,J$XFOB(J) ;AND THE FOR ADDRESS
PUSHJ P,.ZCHNK ;ZERO IT OUT
LOAD S1,.FPLEN(E),FP.LEN ;GET THE FP LENGTH
ADD S1,E ;GET THE FD ADDRESS
MOVEM S1,J$DFDA(J) ;SAVE THE ADDRESS
STORE S1,J$XFOB+FOB.FD(J) ;SAVE IN THE FOB
POP P,S1
STORE S1,J$XFOB+FOB.CW(J),FB.BSZ ;SAVE THE BYTE SIZE
LOAD S1,.EQSEQ(J),EQ.PRV ;GET THE USER'S PRIVILEGE BITS
JUMPN S1,INPO.1 ;IF SET, AVOID ACCESS CHECK
LOAD S1,.FPINF(E),FP.SPL ;LIKEWISE IF SPOOLED
JUMPN S1,INPO.1
HRROI S1,.EQOWN(J) ;GET THE OWNER'S 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
JRST INPO.1 ;JOIN REST OF CODE
INPO.T: SKIPA S1,[FOB.MZ] ;ENTER HERE FOR TEMP FILE OPENING
INPO.1: MOVEI S1,FOB.SZ ;GET THE FOB SIZE
MOVEI S2,J$XFOB(J) ;AND ADDRESS
PUSHJ P,F%IOPN ;OPEN THE FILE
JUMPF INPO.2 ;JUMP IF FAILED
MOVEM S1,J$DIFN(J) ;SAVE THE IFN
TXO S,DSKOPN ;INDICATE THE FILE IS OPEN.
$RETT ;AND RETURN
INPO.2: MOVE T1,S1 ;SAVE THE GALAXY ERROR CODE
$TEXT (LOGX,<^C/[-1]/ Can't access file ^F/@J$DFDA(J)/>)
$TEXT (LOGX,< ?^E/[-1]/>)
CAXN T1,ERNSD$ ;IS THE DEVICE GONE?
$CALL INER.1 ;YES, NOTIFY AND REQUEUE
ZERO .FPINF(E),FP.DEL ;CLEAR THE 'DELETE FILE' BIT
TXZ S,DSKOPN ;INDICATE THE FILE IS NOT OPEN.
$RETF ;AND RETURN
SUBTTL INPBYT -- Read a byte from the input file
INPBYT: MOVE S1,J$DIFN(J) ;GET THE IFN
PUSHJ P,F%IBYT ;READ NEXT BYTE
JUMPF INPERR ;FAILED
POPJ P, ;RETURN
INPERR: CAXN S1,EREOF$ ;WAS IT EOF?
$RETF ;YES, RETURN FALSE
MOVEI S1,.FHSLF ;GET PROCESS HANDLE
GETER ;GET LAST TOPS-20 ERROR
ERJMP .+1 ;IGNORE ANY ERROR
HRRZ S2,S2 ;CLEAR PROCESS HANDLE
CAXN S2,DESX10 ;WAS STRUCTURE DISMOUNTED
$CALL INER.1 ;YES,, NOTIFY AND REQUEUE
TXO S,SKPFIL ;SKIP THE REST OF THE FILE
$RETF ;AND RETURN
INER.1: $WTO (<^E/[-1]/>,<^F/@J$DFDA(J)/ Requeued.^M^J^R/.EQJBB(J)/>,@JOBOBA)
$CALL OACREQ ;REQUEUE JOB
$RETT
SUBTTL INPFEF -- Force end-of-file on next input
INPFEF: TXNN S,DSKOPN ;IS THE SPOOL FILE OPEN ???
$RETT ;NO,,JUST RETURN
MOVE S1,J$DIFN(J) ;GET THE IFN
SETO S2, ;SET EOF POS
PUSHJ P,F%POS ;AND POSITION IT
$RETT ;AND RETURN
SUBTTL INPREW -- Rewind the input file
INPREW: MOVE S1,J$DIFN(J) ;GET THE IFN
PUSHJ P,F%REW ;REWIND IT
POPJ P, ;RETURN
SUBTTL OUTGET Subroutines
OUTGET: MOVE T1,[POINT 7,J$TTY(J)] ;PUT ASCII DEVICE NAME HERE
MOVE S2,J$DEV(J) ;GET SIXBIT DEVICE NAME
OUTGE0: SETZ S1, ;CLEAR AC TO RECEIVE ASCII BYTE
LSHC S1,6 ;SHIFT SIX BITS FROM S2 INTO S1
ADDI S1,40 ;CONVERT TO ASCII
IDPB S1,T1 ;DEPOSIT IN CORRECT LOCATION
JUMPN S2,OUTGE0 ;LOOP UNTIL DONE
MOVEI S1,":" ;ADD A COLON FOR GTJFN% AND FRIENDS
IDPB S1,T1 ; ...
IDPB S2,T1 ;ENSURE NULL TERMINATION
HRROI S1,J$TTY(J)
STDEV% ;TRANSLATE NAME TO DEV.
ERJMP OUTG.2 ;OOPS
MOVEM S2,J$DESG(J) ;SAVE DEVICE DESIGNATOR
$CALL GENDEV ;GENERATE SOME STRINGS
JUMPF [ MOVEI S1,DEVX1 ;"INVALID DEVICE DESIGNATOR"
JRST OUTG.2 ]
MOVE S1,J$DESG(J) ;GET DEVICE DESIGNATOR
ASND% ;ASSIGN IT
ERJMP OUTG.2 ;ERROR, CAN'T
MOVX S1,%RSUOK ;LOAD RESPONSE CODE
$RETT ;AND RETURN
OUTG.2: $WTO (<Printer ^E/S1/>,,@JOBOBA) ;TELL THE OPERATOR
MOVX S1,%RSUNA ;NOT AVAILABLE RIGHT NOW
$RETF ;AND RETURN
;GENDEV: GET DEVICE NAME OF OUTPUT TERMINAL
GENDEV: HRROI S1,IMPFIL+1 ;BUILD NAME OF TEMP FILE
HRROI S2,[ASCIZ/PS:<SPOOL>/] ;FIRST PART OF NAME IS DIRECTORY
SETZB T1,T2
SOUT%
MOVE S2,JOBOBJ+OBJ.UN ;GET UNIT NUMBER
MOVEI T1,10 ;OCTAL
NOUT%
$RETF
HRROI S2,[ASCIZ/-CANON-TEMP.TMP/]
SETZB T1,T2
SOUT%
IDPB T1,S1 ;ENSURE NULL TERMINATION
ADDI S1,2 ;ENSURE ADEQUATE STRING LENGTH
SUBI S1,IMPFIL+1 ;COMPUTE WORD LENGTH OF STRING
HRLZM S1,IMPFIL ;SET UP FILE DESC WORD APPROPRIATELY
$CALL DELOLD ;DELETE OLD VERSION IF IT EXISTS
;BUILD THE ERC STRING FOR LOOKING FOR MAKIMP LOSSAGE
HRROI S1,ERCFIL+1 ;BUILD NAME OF TEMP FILE
HRROI S2,[ASCIZ/PS:<SPOOL>/] ;FIRST PART OF NAME IS DIRECTORY
SETZB T1,T2
SOUT%
MOVE S2,JOBOBJ+OBJ.UN ;GET UNIT NUMBER
MOVEI T1,10 ;OCTAL
NOUT%
$RETF
HRROI S2,[ASCIZ/-CANON-TEMP.ERC.0/]
SETZB T1,T2
SOUT%
IDPB T1,S1 ;ENSURE NULL TERMINATION
ADDI S1,2 ;ENSURE ADEQUATE STRING LENGTH
SUBI S1,ERCFIL+1 ;COMPUTE WORD LENGTH OF STRING
HRLZM S1,ERCFIL ;SET UP FILE DESC WORD APPROPRIATELY
;BUILD COMMAND LINE FOR IS PROGRAM
HRROI S1,RSBUF ;BUILD ARGUMENT LINE
HRROI S2,[ASCIZ/dummy -c /]
SETZB T1,T2
SOUT% ;PROGRAM NAME
MOVE S2,J$DESG(J)
DEVST% ;WRITE TTY NAME
ERJMP [$RETF]
MOVEI S2,":"
IDPB S2,S1 ;ADD A COLON
HRROI S2,[ASCIZ/ PS:<SPOOL>/]
SETZB T1,T2
SOUT%
MOVE S2,JOBOBJ+OBJ.UN ;GET UNIT NUMBER
MOVEI T1,10 ;OCTAL
NOUT%
$RETF
HRROI S2,[ASCIZ/-CANON-TEMP.TMP
/]
SETZB T1,T2
SOUT%
IDPB T1,S1 ;TIE OFF STRING WITH A NULL
$RETT
SUBTTL DELOLD -- Delete old %-CANON-TEMP.TMP file if it exists
DELOLD: STKVAR <TMPJFN> ;LOCAL STORAGE FOR .TMP FILE JFN
MOVX S1,GJ%SHT!GJ%OLD
HRROI S2,IMPFIL+1
GTJFN% ;GET JFN ON .TMP FILE
$RETF ;REALLY, IT WAS A GLOBAL SUCCESS
MOVEM S1,TMPJFN
TXO S1,DF%EXP ;MARK THIS GUY FOR DELETION
DELF%
ERJMP DELTMX ;SOME ERROR
$RETT
SUBTTL OUTREL -- Release device on SHUTDOWN
OUTREL: MOVE S1,J$DESG(J) ;GET DEVICE DESIGNATOR
RELD% ;RELEASE IT
NOP
$RETT ;DONE
SUBTTL TEXT PTR ROUTINE
TEXTX: IDPB S1,XPTR ;STORE IT
$RETT ;RETURN
LOGX: IDPB S1,LOGPTR
$RETT
SUBTTL SYSTEM INITIALIZATION FUNCTIONS
OPDINI: MOVX S1,.MSIIC ;GET 'IGNORE STR ACCTING' FUNCTION
MSTR ;WE WANT TO IGNORE STRUCTURE ACCOUNTING
ERJMP .+1 ;IGNORE ANY ERROR
$RETT ;AND RETURN
SUBTTL - INTERRUPT SYSTEM DATABASE
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
CHNTAB: BLOCK ^D36 ;WHOLE TABLE
LEV1PC: BLOCK 1 ;LEVEL 1 INTERRUPT PC STORED HERE
LEV2PC: BLOCK 1 ;LEVEL 2 INTERRUPT PC STORED HERE
LEV3PC: BLOCK 1 ;LEVEL 3 INTERRUPT PC STORED HERE
END START